diff --git a/src/ikarus.boot b/src/ikarus.boot index 7a5ac70..ab63a6f 100644 Binary files a/src/ikarus.boot and b/src/ikarus.boot differ diff --git a/src/libcompile.ss b/src/libcompile.ss index c00c65d..466089b 100644 --- a/src/libcompile.ss +++ b/src/libcompile.ss @@ -5313,6 +5313,5 @@ (error 'compile-time-core-eval "~s is not a procedure" f)) f))) - )) diff --git a/src/libtoplevel.ss b/src/libtoplevel.ss index bb784e4..a40845b 100644 --- a/src/libtoplevel.ss +++ b/src/libtoplevel.ss @@ -1,9 +1,14 @@ + + + + ;;; Finally, we're ready to evaluate the files and enter the cafe. + (library (ikarus interaction) (export foo) (import (scheme)) - (define foo 12) + (define foo 'i-am-an-exported-primitive-named-foo) (define sc-expand (lambda (x) (if (and (pair? x) (equal? (car x) "noexpand")) diff --git a/src/makefile.ss b/src/makefile.ss index 1f9fd90..888d5b3 100755 --- a/src/makefile.ss +++ b/src/makefile.ss @@ -53,35 +53,56 @@ (if (eof-object? x) '() (cons x (f)))))))) + + (define-record library (code env)) - (define (expand-file filename codes env) - (with-input-from-file filename - (lambda () - (let f () - (let ([x (read)]) - (cond - [(eof-object? x) (values codes env)] - [else - (let-values ([(code e) - (boot-library-expand x)]) - (let-values ([(codes e*) (f)]) - (values (cons code codes) (append e e*))))])))))) - (define (expand-files ls) - (cond - [(null? ls) (values '() '())] - [else - (let-values ([(codes env) (expand-files (cdr ls))]) - (expand-file (car ls) codes env))])) + (define (expand-file filename) + (map (lambda (x) + (let-values ([(code env) + (boot-library-expand x)]) + (make-library code env))) + (read-file filename))) + (define (make-primloc-library env) + `(library (ikarus primlocs) + (export) + (import (scheme)) + (primitive-set! 'primitive-location + (make-parameter + (lambda (x) + (cond + [(assq x ',env) => + (lambda (x) + (let ([type (caddr x)] [loc (cadddr x)]) + (case type + [(global) (cons type loc)] + [else #f])))] + [else #f])) + (lambda (x) + (if (procedure? x) x + (error 'primitive-location + "~s is not a procedure" x))))))) (define (expand-all ls) - (let-values ([(codes env) (expand-files ls)]) - codes)) + (define (insert x ls) + (cond ;;; insert before last library + [(null? (cdr ls)) + (list x (library-code (car ls)))] + [else + (cons (library-code (car ls)) + (insert x (cdr ls)))])) + (let ([libs (apply append (map expand-file ls))]) + (let ([env (apply append (map library-env libs))]) + (let-values ([(code _) + (boot-library-expand + (make-primloc-library env))]) + (printf "ENV=~s\n" env) + (values (insert code libs) env))))) (printf "expanding ...\n") - (let ([core* (expand-all scheme-library-files)]) + (let-values ([(core* env) (expand-all scheme-library-files)]) (printf "compiling ...\n") (let ([p (open-output-file "ikarus.boot" 'replace)]) (for-each