* makefile now uses the export-locs for compiling the newly-built

system.

src/makefile.ss

@@ -46,7 +46,7 @@
       "library-manager.ss"
       "libtoplevel.ss"))
 
-  (define ikarus-environment-map
+  (define ikarus-system-macros
     '([define            (define)]
       [define-syntax     (define-syntax)]
       [module            (module)]
@@ -77,23 +77,52 @@
       [and               (macro . and)]
       [or                (macro . or)]))
 
+  (define ikarus-system-primitives
+    '())
+
+  (define (make-collection)
+    (let ([set '()])
+      (define (set-cons x ls)
+        (cond
+          [(memq x ls) ls]
+          [else (cons x ls)]))
+      (case-lambda
+        [() set]
+        [(x) (set! set (set-cons x set))])))
+
   (define (make-system-data subst env)
-    (define (add x s r l)
+    (let ([export-subst    (make-collection)] 
-      (let ([name (car x)] [binding (cadr x)])
+          [export-env      (make-collection)]
-        (case (car binding)
+          [export-primlocs (make-collection)])
-          [(core-prim) 
+      (for-each
-           (error 'make-system-subst/env "cannot handle ~s" x)]
+        (lambda (x)
-          [else 
+          (let ([name (car x)] [binding (cadr x)])
-           (let ([label (gensym)])
+            (let ([label (gensym)])
-             (values (cons (cons name label) s)
+              (export-subst (cons name label))
-                     (cons (cons label binding) r)
+              (export-env   (cons label binding)))))
-                     l))])))
+        ikarus-system-macros)
-    (let f ([ls ikarus-environment-map])
+      (for-each
-      (cond
+        (lambda (x)
-        [(null? ls) (values '() '() '())]
+          (cond
-        [else
+            [(assq x subst) =>
-         (let-values ([(subst env primlocs) (f (cdr ls))])
+             (lambda (p)
-           (add (car ls) subst env primlocs))])))
+               (let ([label (cdr p)])
+                 (cond
+                   [(assq label env) =>
+                    (lambda (p)
+                      (let ([binding (cdr p)])
+                        (case (car binding)
+                          [(global) 
+                           (export-subst (cons x label))
+                           (export-env   (cons label (cons 'core-prim x)))
+                           (export-primlocs (cons x (cdr binding)))]
+                          [else 
+                           (error #f "invalid binding ~s for ~s" p x)])))]
+                   [else (error #f "cannot find binding for ~s" x)])))]
+            [else (error #f "cannot find export for ~s" x)]))
+        ikarus-system-primitives)
+      (values (export-subst) (export-env) (export-primlocs))))
+
 
   (define (build-system-library export-subst export-env primlocs)
     (let-values ([(code empty-subst empty-env)
@@ -120,16 +149,15 @@
        (pretty-print code)
        code))
 
-;  (define (env->primlocs env)
+ ; (define (env->primlocs env)
-;    (let f ([ls env])
+ ;   (let ([locs (make-collection)])
-;      (cond
+ ;     (for-each 
-;        [(null? ls) '()]
+ ;       (lambda (x)
-;        [else
+ ;         (let ([label (car x)] [binding (cdr x)])
-;         (let ([x (car ls)])
+ ;           (let ([type (car binding)] [value (cdr binding)])
-;           (let ([label (car x)] [binding (cdr x)])
+ ;             (case type
-;             (let ([type (car binding)] [value (cdr binding)])
+ ;               [(global) (locs (cons 
-;               (case type
+
-;                 [(global) 
 
   (define (expand-all files)
     (let ([code* '()]