* libcontrol is now a full library.

renamed:
  src/libcontrol.ss => src/ikarus.control.ss

src/ikarus.control.ss

@@ -1,27 +1,30 @@
 
 (library (ikarus control)
-  (export)
-  (import (scheme))
-;(let ()
+  (export call/cf call/cc dynamic-wind)
+  (import 
+    (only (scheme) $fp-at-base $current-frame $frame->continuation
+          $seal-frame-and-call)
+    (except (ikarus) call/cf call/cc dynamic-wind))
 
-(let ()
-  (define call-with-current-frame
+  (define primitive-call/cf
     (lambda (f)
       (if ($fp-at-base)
           (f ($current-frame))
           ($seal-frame-and-call f))))
-  (primitive-set! 'call/cf call-with-current-frame))
  
-(let () 
+  (define call/cf
+    (lambda (f)
+      (if (procedure? f)
+          (primitive-call/cf f)
+          (error 'call/cf "~s is not a procedure" f))))
+
   (define primitive-call/cc
     (lambda (f)
-      (call/cf
+      (primitive-call/cf
         (lambda (frm)
           (f ($frame->continuation frm))))))
-  (primitive-set! '$primitive-call/cc primitive-call/cc))
 
-
-(let ([winders '()])
+  (define winders '())
 
   (define len
     (lambda (ls n)
@@ -72,7 +75,7 @@
 
   (define call/cc
     (lambda (f)
-      ($primitive-call/cc
+      (primitive-call/cc
         (lambda (k)
           (let ([save winders])
             (f (case-lambda
@@ -94,9 +97,4 @@
           [(v1 v2 . v*)
            (set! winders (cdr winders))
            (out)
-           (apply values v1 v2 v*)]))))
-
-  (primitive-set! 'call/cc call/cc)
-  (primitive-set! 'dynamic-wind dynamic-wind)
-  (void))
-)
+           (apply values v1 v2 v*)])))))

src/makefile.ss

@@ -22,7 +22,7 @@
     ;;;  Error: Error: Error: Error: Error: Error: Error: ...).
     ;;;
     '("ikarus.handlers.ss"
-      "libcontrol.ss"
+      "ikarus.control.ss"
       "libcollect.ss"
       "librecord.ss"
       "libcxr.ss"
@@ -77,9 +77,6 @@
       [and               (macro . and)]
       [or                (macro . or)]))
 
-  (define ikarus-system-primitives
-    '(print-greeting))
-
   (define library-legend
     '([s   (ikarus system)]
       [i   (ikarus)]
@@ -517,7 +514,6 @@
       [fx+-types-error                   s]
       [fx+-overflow-error                s]
       [$do-event                         s]
-
       ))
 
 
@@ -1057,8 +1053,8 @@
                           [(assq x ',primlocs) => cdr]
                           [else #f])))
                     ,@(map build-library library-legend))])
-      (parameterize ([print-gensym #f])
-        (pretty-print code))
+      ;(parameterize ([print-gensym #f])
+      ;  (pretty-print code))
       (let-values ([(code empty-subst empty-env)
                     (boot-library-expand code)])
          code)))
@@ -1071,7 +1067,7 @@
         (lambda (file)
           (load file
             (lambda (x) 
-              (pretty-print x)
+          ;    (pretty-print x)
               (let-values ([(code export-subst export-env)
                             (boot-library-expand x)])
                  (set! code* (cons code code*))
@@ -1081,6 +1077,7 @@
       (printf "building system ...\n")
       (let-values ([(export-subst export-env export-locs)
                     (make-system-data subst env)])
+        (printf "export-subst=~s\n" export-locs)
         (let ([code (build-system-library export-subst export-env export-locs)])
           (values 
             (reverse (list* (car code*) code (cdr code*)))