Create a "standard" library providing access to the library database.

This is useful for programs that want to work directly on libraries.

diff --git a/src/runtime/library-standard.scm b/src/runtime/library-standard.scm
index bf2c092dc71cf7d9260ed7b779e14f82f3bb4772..3259e415b8fd6574444851083f4cbaf3d685ca0f 100644 (file)
--- a/src/runtime/library-standard.scm
+++ b/src/runtime/library-standard.scm
@@ -975,28 +975,60 @@ USA.
 (define-standard-library '(srfi 131)
   '(define-record-type))
 \f
-;;;; Legacy packages
+;;;; Synthetic libraries
 
-(define (initialize-legacy-libraries! package-file)
-  (register-library! (make-library '(mit legacy runtime)
+;;; A synthetic library is one that's derived from legacy packages, much like a
+;;; standard library, with a little more flexibility in where the exports come
+;;; from.
+
+(define (define-synthetic-library name source-package package-pred)
+  (set! synthetic-libraries
+       (cons (list name source-package package-pred)
+             synthetic-libraries))
+  unspecific)
+
+(define synthetic-libraries '())
+
+(define (package-predicate:name-prefix prefix)
+  (lambda (pd)
+    (let ((name (package-description/name pd)))
+      (and (>= (length name) (length prefix))
+          (equal? (take name (length prefix)) prefix)))))
+
+(define-synthetic-library '(mit legacy runtime) '()
+  (package-predicate:name-prefix '(runtime)))
+
+(define-synthetic-library '(mit library) '(runtime)
+  (package-predicate:name-prefix '(runtime library)))
+
+(define (initialize-synthetic-libraries! package-file)
+  (for-each (lambda (p)
+             (let ((name (car p))
+                   (source-package (cadr p))
+                   (package-pred (caddr p)))
+               (make-synthetic-library name
+                 (get-exports package-file source-package package-pred)
+                 (->environment source-package))))
+           synthetic-libraries))
+
+(define (make-synthetic-library name exports environment)
+  (register-library! (make-library name
                                   'parsed-imports '()
-                                  'exports (runtime-exports package-file)
+                                  'exports exports
                                   'parsed-contents '()
                                   'filename #f
-                                  'environment system-global-environment)
+                                  'environment environment)
                     host-library-db))
 
-(define (runtime-exports package-file)
-  (append-map package-exports
-             (filter (lambda (pd)
-                       (let ((name (package-description/name pd)))
-                         (and (pair? name)
-                              (eq? (car name) 'runtime))))
+(define (get-exports package-file source-package package-pred)
+  (append-map (lambda (pd)
+               (package-exports pd source-package))
+             (filter package-pred
                      (vector->list (package-file/descriptions package-file)))))
 
-(define (package-exports pd)
+(define (package-exports pd source-package)
   (filter-map (lambda (link)
-               (and (null? (link-description/package link))
+               (and (equal? source-package (link-description/package link))
                     (not (link-description/status link))
                     (make-library-export (link-description/outer-name link))))
              (vector->list (package-description/exports pd))))
\ No newline at end of file

diff --git a/src/runtime/make.scm b/src/runtime/make.scm
index 143a0a54b27becf0581237efd1f93d345b946166..1dd45290b65c8d3bbef3f2432e42ada3d1ab3022 100644 (file)
--- a/src/runtime/make.scm
+++ b/src/runtime/make.scm
@@ -621,7 +621,7 @@ USA.
   (write-string "done" (console-i/o-port)))
 
 ((lexical-reference (->environment '(runtime library standard))
-                   'initialize-legacy-libraries!)
+                   'initialize-synthetic-libraries!)
  packages-file)
 
 )

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 6ef486df9cb1f9158e5e6a9b8d0642f181c0ccc6..9c9bfba31452c1e34ccd315f362a5f5d96e71aa7 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -6007,18 +6007,22 @@ USA.
          library-contents
          library-db?
          library-environment
-         library-imports-used
-         library-imports
-         library-name
          library-export-from
          library-export-to
          library-export=?
          library-export?
+         library-filename
          library-import-from
          library-import-from-library
          library-import-to
          library-import=?
          library-import?
+         library-imports
+         library-imports-environment
+         library-imports-used
+         library-name
+         library-parsed-contents
+         library-parsed-imports
          library?
          registered-libraries
          registered-library
@@ -6032,12 +6036,9 @@ USA.
          library-exporter
          library-export->list
          library-exports
-         library-filename
          library-imports-from
          library-import->list
          library-imports-environment
-         library-parsed-contents
-         library-parsed-imports
          library-preregistered?
          library-syntaxed-contents
          list->library-export