Implement as-needed loading of libraries on import.

This does topological sorting to do the loads in the right order, but doesn't
handle dependency loops (yet).

diff --git a/src/runtime/library-loader.scm b/src/runtime/library-loader.scm
index 7f0d2197c2c57ba3c50d4474d6d956cb41a1f2ad..176a0ad42384c1ee408b631de4fdf0b96ebe70e2 100644 (file)
--- a/src/runtime/library-loader.scm
+++ b/src/runtime/library-loader.scm
@@ -35,7 +35,7 @@ USA.
   (register-r7rs-source! source (copy-library-db db))
   (r7rs-source->scode-file source))
 
-(define-automatic-property '(contents bound-names imports-used)
+(define-automatic-property '(contents imports-used)
     '(parsed-contents imports exports imports-environment)
   #f
   (lambda (contents imports exports env)
@@ -52,7 +52,6 @@ USA.
            (warn "Library has free references not provided by imports:"
                  (lset-difference eq? free imports-to))))
       (values body
-             bound
              (filter (lambda (import)
                        (memq (library-import-to import) free))
                      imports)))))
@@ -85,36 +84,45 @@ USA.
   (let ((env
         (make-root-top-level-environment
          (delete-duplicates (map library-import-to imports) eq?))))
-    (add-imports-to-env! imports env db)
+    (add-imports-to-env! imports env db #f)
     env))
 
-(define (add-imports-to-env! imports env db)
+(define (add-imports-to-env! imports env db allow-conflicts?)
   (for-each
    (lambda (group)
-     (for-each (let ((exporter
-                     (library-exporter
-                      (registered-library
-                       (library-import-from-library (car group))
-                       db))))
-                (lambda (import)
+     (let ((exporter
+           (library-exporter
+            (registered-library
+             (library-import-from-library (car group))
+             db))))
+       (if (not allow-conflicts?)
+          (let ((conflicts
+                 (let ((bindings (environment-bindings env)))
+                   (filter (lambda (import)
+                             (let ((value
+                                    (exporter (library-import-from import)))
+                                   (name (library-import-to import)))
+                               (let ((b (assq name bindings)))
+                                 (and b
+                                      (pair? (cdr b))
+                                      (not
+                                       (values-equivalent? value (cadr b)))))))
+                           group))))
+            (if (pair? conflicts)
+                (error "Conflcting imports:" conflicts))))
+       (for-each (lambda (import)
                   (let ((value (exporter (library-import-from import)))
                         (name (library-import-to import)))
-                    (if (or (not (environment-bound? env name))
-                            (let ((value* (environment-safe-lookup env name)))
-                              (and (not (values-equivalent? value value*))
-                                   (or (unassigned-reference-trap? value*)
-                                       (error "Conflicting imports:"
-                                              name value* value)))))
-                        (cond ((macro-reference-trap? value)
-                               (environment-define-macro
-                                env name
-                                (macro-reference-trap-transformer value)))
-                              ((unassigned-reference-trap? value)
-                               ;; nothing to do
-                               )
-                              (else
-                               (environment-define env name value)))))))
-              group))
+                    (cond ((macro-reference-trap? value)
+                           (environment-define-macro
+                            env name
+                            (macro-reference-trap-transformer value)))
+                          ((unassigned-reference-trap? value)
+                           ;; nothing to do
+                           )
+                          (else
+                           (environment-define env name value)))))
+                group)))
    (group-imports-by-source imports)))
 
 (define (group-imports-by-source imports)
@@ -156,10 +164,12 @@ USA.
                         (if (default-object? env)
                             (nearest-repl/environment)
                             (guarantee environment? env 'import!))
-                        db)))
+                        db
+                        #t)))
 
 (define (import-sets->imports import-sets db)
   (let ((imports (expand-parsed-imports (map parse-import-set import-sets) db)))
+    (maybe-load-libraries! imports db)
     (let ((unavailable
           (remove (lambda (import)
                     (import-environment-available? import db))
@@ -365,4 +375,42 @@ USA.
        (begin
          (if (not source)
              (error "No scheme files:" file-group))
-         (handle-source source)))))
\ No newline at end of file
+         (handle-source source)))))
+\f
+(define (maybe-load-libraries! imports db)
+  (let ((libraries (dependency-libraries imports db)))
+    (if (any library-preregistered? libraries)
+       (for-each (lambda (library)
+                   (load (library-filename library)))
+                 (reverse
+                  (filter library-preregistered?
+                          ((compute-dependency-graph libraries db)
+                           'topological-sort)))))))
+
+(define (dependency-libraries imports db)
+  (let ((names
+        (delete-duplicates! (map library-import-from-library imports)
+                            equal?)))
+    (let ((unregistered
+          (remove (lambda (name)
+                    (registered-library? name db))
+                  names)))
+      (if (pair? unregistered)
+         (error "Unknown libraries:" unregistered)))
+    (map (lambda (name) (registered-library name db))
+        names)))
+
+(define (compute-dependency-graph libraries db)
+  (let ((table (make-key-weak-eq-hash-table)))
+
+    (define (trace library)
+      (if (not (hash-table-exists? table library))
+         (let ((deps
+                (dependency-libraries (library-imports library)
+                                      db)))
+           (hash-table-set! table library deps)
+           (for-each trace deps))))
+
+    (for-each trace libraries)
+    (make-digraph (hash-table-keys table)
+                 (lambda (library) (hash-table-ref table library)))))
\ No newline at end of file

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index d08fba60779752f36d49d8b62d82d258ac703f6e..a32088b545607a2451174d2f4a37c3e22eecf6db 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -6004,7 +6004,6 @@ USA.
   (parent (runtime library))
   (export (runtime)
          copy-library-db
-         library-bound-names
          library-contents
          library-db?
          library-environment
@@ -6012,6 +6011,7 @@ USA.
          library-export-to
          library-export=?
          library-export?
+         library-exports
          library-filename
          library-import-from
          library-import-from-library
@@ -6036,10 +6036,8 @@ USA.
          library-eval-result
          library-exporter
          library-export->list
-         library-exports
          library-imports-from
          library-import->list
-         library-imports-environment
          library-preregistered?
          library-syntaxed-contents
          list->library-export