Change the loader so that it can load R7RS source files.

Now to make compiled files work.  :)

diff --git a/src/runtime/library-database.scm b/src/runtime/library-database.scm
index 2b43e94041346cc4ce4082000df0ce1e5eeb823f..ff26459c9c152676fe9ee879a7d6208ccac6dd7b 100644 (file)
--- a/src/runtime/library-database.scm
+++ b/src/runtime/library-database.scm
@@ -72,9 +72,6 @@ USA.
 
 (define library-db?
   (make-bundle-predicate 'library-database))
-
-(define-deferred host-library-db
-  (make-library-db 'host))
 \f
 (define (make-library name . keylist)
   (if name

diff --git a/src/runtime/library-loader.scm b/src/runtime/library-loader.scm
index 19413bdd09bc0ae6bc40f8b86f69e29cc6f3d707..69b7dd7330d9f7f1b69c38dc994576b4155f2ea7 100644 (file)
--- a/src/runtime/library-loader.scm
+++ b/src/runtime/library-loader.scm
@@ -31,7 +31,7 @@ USA.
 \f
 ;;;; Syntax
 
-(define-automatic-property '->scode '(name imports exports syntaxed-contents)
+(define-automatic-property 'scode '(name imports exports contents)
   #f
   (lambda (name imports exports contents)
     (make-scode-declaration
@@ -41,6 +41,12 @@ USA.
                (exports ,(map library-export->list exports))))
      (make-scode-quotation contents))))
 
+(define (eval-r7rs-source source db)
+  (let ((program (register-r7rs-source! source db)))
+    (if program
+       (scode-eval (library-contents program)
+                   (library-environment program)))))
+
 (define-automatic-property 'contents
     '(parsed-contents imports exports imports-environment)
   #f

diff --git a/src/runtime/library-standard.scm b/src/runtime/library-standard.scm
index f15501806a4c7d33f618f5575e69e4cc0c49c2cc..976fb08a651db8d3a8024f85278a47bd047e02a3 100644 (file)
--- a/src/runtime/library-standard.scm
+++ b/src/runtime/library-standard.scm
@@ -29,6 +29,12 @@ USA.
 
 (declare (usual-integrations))
 \f
+(define-deferred host-library-db
+  (make-library-db 'host))
+
+(define (finish-host-library-db!)
+  (add-standard-libraries! host-library-db))
+
 (define (add-standard-libraries! db)
   (register-libraries! (make-standard-libraries) db))
 

diff --git a/src/runtime/load.scm b/src/runtime/load.scm
index a9ed8a812b03dbe3d61ab90ebd8d9b921be26103..8c1d14f13def14901301a943d1927e5afd9c34db 100644 (file)
--- a/src/runtime/load.scm
+++ b/src/runtime/load.scm
@@ -52,6 +52,9 @@ USA.
                                value))
                          #f))
 
+(define-deferred current-load-library-db
+  (make-unsettable-parameter host-library-db))
+
 (define-deferred param:eval-unit
   (make-unsettable-parameter #f
     (lambda (value)
@@ -86,7 +89,7 @@ USA.
       load/suppress-loading-message?))
 \f
 (define (load pathname #!optional environment syntax-table purify?)
-  syntax-table                         ;ignored
+  (declare (ignore syntax-table))
   (let ((environment
         (if (default-object? environment)
             (current-load-environment)
@@ -113,7 +116,7 @@ USA.
 
 (define (file-loadable? pathname)
   (receive (pathname* loader notifier) (choose-load-method pathname)
-    loader notifier
+    (declare (ignore loader notifier))
     (if pathname* #t #f)))
 
 (define (choose-load-method pathname)
@@ -143,14 +146,17 @@ USA.
 
 (define (source-loader pathname)
   (lambda (environment purify?)
-    purify?
-    (call-with-input-file pathname
-      (lambda (port)
-       (let loop ((value unspecific))
-         (let ((sexp (read port)))
-           (if (eof-object? sexp)
-               value
-               (loop (repl-eval sexp environment)))))))))
+    (declare (ignore purify?))
+    (let ((source (read-r7rs-source pathname)))
+      (if source
+         (eval-r7rs-source source (current-load-library-db))
+         (call-with-input-file pathname
+           (lambda (port)
+             (let loop ((value unspecific))
+               (let ((sexp (read port)))
+                 (if (eof-object? sexp)
+                     value
+                     (loop (repl-eval sexp environment)))))))))))
 
 (define (wrap-loader pathname loader)
   (lambda (environment purify?)

diff --git a/src/runtime/make.scm b/src/runtime/make.scm
index 82c4cc10b17a9601ef4ffa7cab207b33ba2a0c3f..c76c91dfe65014c0dd0faa8e1b67bded262f0558 100644 (file)
--- a/src/runtime/make.scm
+++ b/src/runtime/make.scm
@@ -475,7 +475,7 @@ USA.
    (runtime hash)
    (runtime dynamic)
    (runtime regular-sexpression)
-   (runtime library database)
+   (runtime library standard)
    ;; Microcode data structures
    (runtime history)
    (runtime scode)
@@ -560,6 +560,8 @@ USA.
    (runtime structure-parser)
    (runtime swank)
    (runtime stack-sampler)
+   ;; Done very late since it will look up lots of global variables.
+   ((runtime library standard) finish-host-library-db!)
    ;; Last since it turns on runtime handling of microcode errors.
    ((runtime microcode-errors) initialize-error-hooks!)))
 \f

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 16bc6ec0c07a17710741beb6b761773e080f8990..dee2664fc20af7c3bec598467966b36a3d639d6c 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -3160,6 +3160,7 @@ USA.
          built-in-object-file
          condition-type:not-loading
          current-load-environment
+         current-load-library-db
          current-load-pathname
          fasl-file?
          fasload
@@ -5838,7 +5839,6 @@ USA.
   (parent (runtime library))
   (export (runtime library)
          define-automatic-property
-         host-library-db
          library-contents
          library-db?
          library-environment
@@ -5879,6 +5879,8 @@ USA.
 (define-package (runtime library parser)
   (files "library-parser")
   (parent (runtime library))
+  (export (runtime)
+         read-r7rs-source)
   (export (runtime library)
          library-name=?
          library-name?
@@ -5889,12 +5891,13 @@ USA.
          r7rs-source-program
          r7rs-source-libraries
          r7rs-source?
-         read-r7rs-source
          register-r7rs-source!))
 
 (define-package (runtime library standard)
   (files "library-standard")
   (parent (runtime library))
+  (export (runtime)
+         host-library-db)
   (export (runtime library)
          add-standard-libraries!
          check-standard-libraries!
@@ -5916,5 +5919,5 @@ USA.
   (export ()
          environment                   ;R7RS
          )
-  (export (runtime library)
-         imports->environment))
\ No newline at end of file
+  (export (runtime)
+         eval-r7rs-source))
\ No newline at end of file