* added a primitive-location parameter.

src/libcompile.ss

@@ -5313,6 +5313,5 @@
         (error 'compile-time-core-eval "~s is not a procedure" f))
       f)))
 
-
 ))
 

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"))

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)
+  (define (expand-file filename)
-    (cond
+    (map (lambda (x)
-      [(null? ls) (values '() '())]
+           (let-values ([(code env) 
-      [else 
+                         (boot-library-expand x)])
-       (let-values ([(codes env) (expand-files (cdr ls))])
+             (make-library code env)))
-         (expand-file (car ls) codes 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)])
+    (define (insert x ls)
-      codes))
+      (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