* added an load-handler procedure that defaults to calling

chi-library-top.
* changed definition of load to use load-handler

src/libcompile.ss

@@ -5192,12 +5192,84 @@
     (parameterize ([assembler-output #f])
       (expand x))))
 
+(define compile-core-expr-to-port
+  (lambda (expr port)
+    (fasl-write (compile-core-expr->code expr) port)))
+
+(define (compile-core-expr x)
+  (let ([code (compile-core-expr->code x)])
+    ($code->closure code)))
+
+(primitive-set! 'compile-core-expr-to-port compile-core-expr-to-port)
+
+(primitive-set! 'assembler-output (make-parameter #f))
+(primitive-set! 'compile
+  (lambda (x)
+    (let ([code 
+           (if (code? x)
+               x
+               (compile-expr->code x))])
+      (let ([proc ($code->closure code)])
+        (proc)))))
+
+
+(primitive-set! 'eval-core
+  (lambda (x) ((compile-core-expr x))))
+
+(primitive-set! 'eval
+  (lambda (x)
+    (compile x)))
+
+(primitive-set! 'load-handler
+  (lambda (x)
+    (chi-top-library x)
+    (void)))
+
+))
+
+#!eof junk
+
+(define compile-file
+  (lambda (input-file output-file . rest)
+    (let ([ip (open-input-file input-file)]
+          [op (apply open-output-file output-file rest)])
+      (let f ()
+        (let ([x (read ip)])
+          (unless (eof-object? x)
+            (fasl-write (compile-expr->code x) op)
+            (f))))
+      (close-input-port ip)
+      (close-output-port op))))
+(primitive-set! 'compile-file compile-file)
 
 ;(include "libaltcogen.ss")
 (define alt-cogen
   (lambda args
     (error 'alt-cogen "disabled for now")))
 
+(define alt-compile-file
+  (lambda (input-file output-file . rest)
+    (let ([ip (open-input-file input-file)]
+          [op (apply open-output-file output-file rest)])
+      (let f ()
+        (let ([x (read ip)])
+          (unless (eof-object? x)
+            (fasl-write (alt-compile-expr x) op)
+            (f))))
+      (close-input-port ip)
+      (close-output-port op))))
+
+
+(primitive-set! 'alt-compile-file alt-compile-file)
+
+(primitive-set! 'alt-compile
+  (lambda (x)
+    (let ([code 
+           (if (code? x)
+               x
+               (alt-compile-expr x))])
+      (let ([proc ($code->closure code)])
+        (proc)))))
 
 (define (alt-compile-expr expr)
   (let* ([p (parameterize ([assembler-output #f])
@@ -5231,70 +5303,3 @@
                      #f))
                ls*)])
         (car code*)))))
-
-
-(define compile-core-expr-to-port
-  (lambda (expr port)
-    (fasl-write (compile-core-expr->code expr) port)))
-
-(define compile-file
-  (lambda (input-file output-file . rest)
-    (let ([ip (open-input-file input-file)]
-          [op (apply open-output-file output-file rest)])
-      (let f ()
-        (let ([x (read ip)])
-          (unless (eof-object? x)
-            (fasl-write (compile-expr->code x) op)
-            (f))))
-      (close-input-port ip)
-      (close-output-port op))))
-
-(define alt-compile-file
-  (lambda (input-file output-file . rest)
-    (let ([ip (open-input-file input-file)]
-          [op (apply open-output-file output-file rest)])
-      (let f ()
-        (let ([x (read ip)])
-          (unless (eof-object? x)
-            (fasl-write (alt-compile-expr x) op)
-            (f))))
-      (close-input-port ip)
-      (close-output-port op))))
-
-(define (compile-core-expr x)
-  (let ([code (compile-core-expr->code x)])
-    ($code->closure code)))
-
-(primitive-set! 'compile-core-expr-to-port compile-core-expr-to-port)
-
-(primitive-set! 'compile-file compile-file)
-(primitive-set! 'alt-compile-file alt-compile-file)
-(primitive-set! 'assembler-output (make-parameter #f))
-(primitive-set! 'compile
-  (lambda (x)
-    (let ([code 
-           (if (code? x)
-               x
-               (compile-expr->code x))])
-      (let ([proc ($code->closure code)])
-        (proc)))))
-
-(primitive-set! 'alt-compile
-  (lambda (x)
-    (let ([code 
-           (if (code? x)
-               x
-               (alt-compile-expr x))])
-      (let ([proc ($code->closure code)])
-        (proc)))))
-
-(primitive-set! 'eval-core
-  (lambda (x) ((compile-core-expr x))))
-
-(primitive-set! 'eval
-  (lambda (x)
-    (compile x)))
-
-
-))
-

src/library-manager.ss

@@ -405,6 +405,7 @@
       [eval       eval-label       (core-prim . eval)]
       [eval-core  eval-core-label  (core-prim . eval-core)]
       [load       load-label       (core-prim . load)]
+      [load-handler       load-handler-label       (core-prim . load-handler)]
       [assembler-output       assembler-output-label       (core-prim . assembler-output)]
       [expand       expand-label       (core-prim . expand)]
       [fasl-write       fasl-write-label       (core-prim . fasl-write)]

src/libtokenizer.ss

@@ -790,24 +790,24 @@
         x)))
   (let ()
     (define read-and-eval
-      (lambda (p eval)
+      (lambda (p eval-proc)
         (let ([x (my-read p)])
           (unless (eof-object? x)
-            (eval x)
+            (eval-proc x)
-            (read-and-eval p eval)))))
+            (read-and-eval p eval-proc)))))
     (primitive-set! 'load
       (case-lambda
-        [(x) (load x eval)]
+        [(x) (load x load-handler)]
-        [(x eval)
+        [(x eval-proc)
          (unless (string? x)
            (error 'load "~s is not a string" x))
-         (unless (procedure? eval)
+         (unless (procedure? eval-proc)
-           (error 'load "~s is not a procedure" eval))
+           (error 'load "~s is not a procedure" eval-proc))
          (let ([p (open-input-file x)])
            (let ([x (read-initial p)])
              (unless (eof-object? x)
-               (eval x)
+               (eval-proc x)
-               (read-and-eval p eval)))
+               (read-and-eval p eval-proc)))
            (close-input-port p))])))
   )