Non-functioning implementation of import and define-library.

diff --git a/src/runtime/mit-macros.scm b/src/runtime/mit-macros.scm
index e467696bb23cd8d1bab6e46dff39a32567639c3f..41dfb69de160af693cb7f2be93c28f8eef3ec67a 100644 (file)
--- a/src/runtime/mit-macros.scm
+++ b/src/runtime/mit-macros.scm
@@ -611,26 +611,88 @@ USA.
      (syntax-check '(_ expression) form)
      (descend (cadr form) 0 finalize))))
 \f
+;;;; R7RS: libraries
+
+(define $define-library
+  (spar-transformer->runtime
+   (delay
+     (scons-rule
+        `(,(library-name-pattern)
+          (* ,(library-declaration-pattern)))
+       (lambda (name declarations)
+        (scons-quote (cons name declarations))
+        )))))
+
+(define (library-declaration-pattern)
+  (spar-pattern-fixed-point
+   (lambda (library-declaration)
+     `(subform
+       (or (cons (keep-if id=? export)
+                (* (or id
+                       (subform (ignore-if id=? rename)
+                                (cons id id)))))
+          (cons (keep-if id=? import)
+                (* ,(import-set-pattern)))
+          (cons (keep-if id=? begin)
+                (* any))
+          (cons (or (keep-if id=? include)
+                    (keep-if id=? include-ci)
+                    (keep-if id=? include-library-declarations))
+                (+ ,string?))
+          (cons (keep-if id=? cond-expand)
+                (+ (subform
+                    (cons ,(feature-requirement-pattern)
+                          (* ,library-declaration))))))))))
+
+(define $import
+  (spar-transformer->runtime
+   (delay
+     (scons-rule `((* ,(import-set-pattern)))
+       (lambda (import-sets)
+        (scons-quote import-sets)
+        )))))
+
+(define (import-set-pattern)
+  (spar-pattern-fixed-point
+   (lambda (import-set)
+     `(or ,(library-name-pattern)
+         (subform
+          (or (cons* (or (keep-if id=? only)
+                         (keep-if id=? except))
+                     ,import-set
+                     (* id))
+              (list (keep-if id=? prefix)
+                    ,import-set
+                    id)
+              (cons* (keep-if id=? rename)
+                     ,import-set
+                     (* (subform (cons id id))))))))))
+
+(define (library-name-pattern)
+  `(subform (* (or symbol ,exact-nonnegative-integer?))))
+\f
 ;;;; SRFI 0 and R7RS: cond-expand
 
 (define $cond-expand
   (spar-transformer->runtime
    (delay
      (scons-rule `((value id=?)
-                  (+ ,(cond-expand-clause-pattern)))
+                  (+ (subform (cons ,(feature-requirement-pattern)
+                                    (* any)))))
        generate-cond-expand))))
 
-(define (cond-expand-clause-pattern)
-  `(subform (cons ,(spar-pattern-fixed-point
-                   (lambda (feature-requirement)
-                     `(or id
-                          (subform
-                           (or (cons (or (keep-if id=? or)
-                                         (keep-if id=? and))
-                                     (* ,feature-requirement))
-                               (list (keep-if id=? not)
-                                     ,feature-requirement))))))
-                 (* any))))
+(define (feature-requirement-pattern)
+  (spar-pattern-fixed-point
+   (lambda (feature-requirement)
+     `(or id
+         (subform
+          (or (cons (or (keep-if id=? or)
+                        (keep-if id=? and))
+                    (* ,feature-requirement))
+              (list (keep-if id=? not)
+                    ,feature-requirement)
+              (list (keep-if id=? library)
+                    ,(library-name-pattern))))))))
 
 (define (generate-cond-expand id=? clauses)
 

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index a01851012eed28ac3b8d33141d9492249af8dadd..f6a787a5e74a6d10130e124bc10beb6c7b709d65 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -4788,6 +4788,10 @@ USA.
          (unless $unless)              ;R7RS
          (when $when)                  ;R7RS
          features                      ;R7RS
+         )
+  (export (runtime)
+         (define-library $define-library) ;R7RS
+         (import $import)              ;R7RS
          ))
 
 (define-package (runtime syntax syntax-rules)