library records now cache expanded code.

scheme/ikarus.fasl.ss

@@ -148,21 +148,22 @@
              [freevars (read-fixnum p)])
         (let ([code (make-code code-size freevars)])
           (when code-m (put-mark code-m code))
-          (let ([annotations (read)])
+          (let ([annotation (read)])
-            (let f ([i 0])
+            (set-code-annotation! code annotation))
-              (unless (fx= i code-size)
+          (let f ([i 0])
-                (code-set! code i (char->int (read-u8-as-char p)))
+            (unless (fx= i code-size)
-                (f (fxadd1 i))))
+              (code-set! code i (char->int (read-u8-as-char p)))
-            (cond
+              (f (fxadd1 i))))
-              [clos-m
+          (cond
-               (let ([clos ($code->closure code)])
+            [clos-m
-                 (put-mark clos-m clos)
+             (let ([clos ($code->closure code)])
-                 (set-code-reloc-vector! code (read))
+               (put-mark clos-m clos)
-                 code)]
-              [else
                (set-code-reloc-vector! code (read))
-               code])))))
+               code)]
-    (define (read-thunk m)
+            [else
+             (set-code-reloc-vector! code (read))
+             code]))))
+    (define (read-procedure m)
       (let ([c (read-u8-as-char p)])
         (case c
           [(#\x)
@@ -244,8 +245,8 @@
                v))]
           [(#\x) ;;; code
            (read-code m #f)]
-          [(#\Q) ;;; thunk
+          [(#\Q) ;;; procedure
-           (read-thunk m)]
+           (read-procedure m)]
           [(#\R)
            (let* ([rtd-name (read)]
                   [rtd-symbol (read)]
@@ -271,12 +272,8 @@
                      ($struct-set! x i (read))
                      (f (fxadd1 i))))
                  x)))]
-          ;[(#\C)
+          [(#\C) (integer->char (read-int p))]
-          ; (let ([c (read-u8-as-char p)])
+          [(#\c) (read-u8-as-char p)]
-          ;   (cond
-          ;     [(char? c) c]
-          ;     [else
-          ;      (die who "invalid eof inside a fasl object")]))]
           [(#\>)
            (let ([m (read-int p)])
              (read/mark m))]

scheme/ikarus.separate-compilation.ss

@@ -9,16 +9,17 @@
     (only (psyntax library-manager)
       install-library current-library-expander))
 
-  (define-struct library (id name ver imp* vis* inv* 
+  (define-struct library 
-    export-subst export-env visit-code invoke-code visible?))
+    (id name ver imp* vis* inv* export-subst export-env
+     visit-code invoke-code visible?))
 
   (define (install-library-from-file filename)
     (let ([p (open-file-input-port filename)])
       (let ([L (fasl-read p)])
         (unless (library? L) 
-          (error 'install-library "file does not contain a library"
+          (error 'install-library 
-                 filename))
+            "file does not contain a valid library"
-        (printf "L=~s\n" L)
+            filename))
         (install-library (library-id L) (library-name L) 
           (library-ver L) (library-imp* L) (library-vis* L)
           (library-inv* L) (library-export-subst L)
@@ -34,6 +35,5 @@
                   (compile-core-expr visit-code)
                   (compile-core-expr invoke-code)
                   #t)])
-        (printf "L=~s\n" L)
         (fasl-write L p)))))
 

scheme/last-revision

@@ -1 +1 @@
-1391
+1392

scheme/makefile.ss

@@ -1543,7 +1543,7 @@
                             '()))])
           `(install-library 
              ',id ',name ',version ',import-libs ',visit-libs ',invoke-libs
-             ',subst ',env void void ',visible?)))))
+             ',subst ',env void void '#f '#f ',visible?)))))
   (let ([code `(library (ikarus primlocs)
                   (export) ;;; must be empty
                   (import 

scheme/psyntax.expander.ss

@@ -3545,15 +3545,18 @@
             (ver ver)
             (imp* (map library-spec imp*))
             (vis* (map library-spec vis*))
-            (inv* (map library-spec inv*)))
+            (inv* (map library-spec inv*))
+            (visit-proc (lambda () (visit! macro*)))
+            (invoke-proc (lambda () (eval-core (expanded->core invoke-code))))
+            (visit-code (build-visit-code macro*))
+            (invoke-code invoke-code))
         (install-library id name ver
            imp* vis* inv* export-subst export-env
-           (lambda () (visit! macro*))
+           visit-proc invoke-proc
-           (lambda () (eval-core (expanded->core invoke-code)))
+           visit-code invoke-code
            #t)
         (values id name ver imp* vis* inv* 
-                invoke-code
+                invoke-code visit-code
-                (build-visit-code macro*)
                 export-subst export-env))))
 
   ;;; when bootstrapping the system, visit-code is not (and cannot

scheme/psyntax.library-manager.ss

@@ -23,8 +23,7 @@
     visit-library library-name library-version library-exists?
     find-library-by-name install-library library-spec invoke-library 
     extend-library-subst! extend-library-env! current-library-expander
-    current-library-collection library-path library-extensions
+    current-library-collection library-path library-extensions)
-    make-library)
   (import (rnrs) (psyntax compat) (rnrs r5rs))
 
   (define (make-collection)
@@ -49,7 +48,8 @@
         x)))
 
   (define-record library 
-    (id name version imp* vis* inv* subst env visit-state invoke-state visible?)
+    (id name version imp* vis* inv* subst env visit-state
+        invoke-state visit-code invoke-code visible?)
     (lambda (x p)
       (unless (library? x)
         (assertion-violation 'record-type-printer "not a library"))
@@ -241,7 +241,8 @@
     ((current-library-collection) lib))
 
   (define (install-library id name ver imp* vis* inv* 
-            exp-subst exp-env visit-code invoke-code visible?)
+            exp-subst exp-env visit-proc invoke-proc 
+            visit-code invoke-code visible?)
     (let ((imp-lib* (map find-library-by-spec/die imp*))
           (vis-lib* (map find-library-by-spec/die vis*))
           (inv-lib* (map find-library-by-spec/die inv*)))
@@ -252,8 +253,8 @@
         (assertion-violation 'install-library 
           "library is already installed" name))
       (let ((lib (make-library id name ver imp-lib* vis-lib* inv-lib* 
-                    exp-subst exp-env visit-code invoke-code 
+                    exp-subst exp-env visit-proc invoke-proc 
-                    visible?)))
+                    visit-code invoke-code visible?)))
         (install-library-record lib))))
 
   (define extend-library-subst!