Reorganize cold-load for syntax.
authorChris Hanson <org/chris-hanson/cph>
Tue, 13 Feb 2018 05:24:32 +0000 (21:24 -0800)
committerChris Hanson <org/chris-hanson/cph>
Tue, 13 Feb 2018 05:24:32 +0000 (21:24 -0800)
* Rename syntax-transforms to syntax-low.
* Move expander-item to syntax-low.
* Don't load syntax-items early in cold load.
* Move compile-expr-item to syntax-items.

src/runtime/ed-ffi.scm
src/runtime/make.scm
src/runtime/runtime.pkg
src/runtime/syntax-items.scm
src/runtime/syntax-low.scm [moved from src/runtime/syntax-transforms.scm with 93% similarity]
src/runtime/syntax.scm

index e18c6ab482fe73cf553eb8149835b7036a541648..b165f4bc435b20a362aea9a5e7d6d32515f9946e 100644 (file)
@@ -163,9 +163,9 @@ USA.
     ("syntax-declaration" (runtime syntax declaration))
     ("syntax-environment" (runtime syntax environment))
     ("syntax-items" (runtime syntax items))
+    ("syntax-low" (runtime syntax low))
     ("syntax-output" (runtime syntax output))
     ("syntax-rules" (runtime syntax syntax-rules))
-    ("syntax-transforms" (runtime syntax transforms))
     ("sysclk"  (runtime system-clock))
     ("sysmac"  (runtime system-macros))
     ("system"  (runtime system))
index e04c35a50371be75bffcdeefd64d940a08e9de8f..abfa61f79208249edc996cdbe981a055a33cf1fd 100644 (file)
@@ -374,8 +374,7 @@ USA.
         ("record" . (RUNTIME RECORD))
         ("bundle" . (runtime bundle))))
       (files2
-       '(("syntax-items" . (RUNTIME SYNTAX ITEMS))
-        ("syntax-transforms" . (RUNTIME SYNTAX TRANSFORMS))
+       '(("syntax-low" . (runtime syntax low))
         ("thread" . (RUNTIME THREAD))
         ("wind" . (RUNTIME STATE-SPACE))
         ("prop1d" . (RUNTIME 1D-PROPERTY))
@@ -530,7 +529,7 @@ USA.
    (RUNTIME UNSYNTAXER)
    (RUNTIME PRETTY-PRINTER)
    (RUNTIME EXTENDED-SCODE-EVAL)
-   (runtime syntax top-level)
+   (runtime syntax items)
    (runtime syntax rename)
    ;; REP Loops
    (RUNTIME INTERRUPT-HANDLER)
index 3be7548c55487ad6d99fb09fc167a968106a0013..281df7bacfc5a08f0e6332b3d1576ab7b52cb745 100644 (file)
@@ -4424,8 +4424,6 @@ USA.
          classify-forms-cdr
          classify-forms-in-order-cddr
          classify-forms-in-order-cdr
-         compile-expr-item
-         define-item-compiler
          hist-caddr
          hist-cadr
          hist-car
@@ -4448,20 +4446,18 @@ USA.
          classifier-item-impl
          classifier-item?
          combination-item
+         compile-expr-item
          constant-item
          decl-item
          decl-item-text
          decl-item?
+         define-item-compiler
          defn-item
          defn-item-id
          defn-item-syntax?
          defn-item-value
          defn-item?
          delay-item
-         expander-item
-         expander-item-expr
-         expander-item-impl
-         expander-item?
          expr-item
          expr-item-compiler
          expr-item?
@@ -4486,6 +4482,20 @@ USA.
          var-item-id
          var-item?))
 
+(define-package (runtime syntax low)
+  (files "syntax-low")
+  (parent (runtime syntax))
+  (export ()
+         er-macro-transformer->expander
+         rsc-macro-transformer->expander
+         sc-macro-transformer->expander
+         syntactic-keyword->item)
+  (export (runtime syntax)
+         expander-item
+         expander-item-expr
+         expander-item-impl
+         expander-item?))
+
 (define-package (runtime syntax environment)
   (files "syntax-environment")
   (parent (runtime syntax))
@@ -4557,15 +4567,6 @@ USA.
   (export (runtime syntax)
          map-decl-ids))
 
-(define-package (runtime syntax transforms)
-  (files "syntax-transforms")
-  (parent (runtime syntax))
-  (export ()
-         er-macro-transformer->expander
-         rsc-macro-transformer->expander
-         sc-macro-transformer->expander
-         syntactic-keyword->item))
-
 (define-package (runtime syntax mit)
   (files "mit-syntax")
   (parent (runtime syntax))
index e48bc50e67f6ff8908afc7776903a4676494736d..56a0a8064e6693dede7dc4db3527aca9a7fe3956 100644 (file)
@@ -24,7 +24,7 @@ USA.
 
 |#
 
-;;;; Syntax Items
+;;;; Syntax items and compiler
 
 (declare (usual-integrations))
 \f
@@ -38,12 +38,6 @@ USA.
     classifier-item?
   (impl classifier-item-impl))
 
-(define-record-type <expander-item>
-    (expander-item impl expr)
-    expander-item?
-  (impl expander-item-impl)
-  (expr expander-item-expr))
-
 (define (keyword-item? object)
   (or (classifier-item? object)
       (expander-item? object)))
@@ -223,4 +217,57 @@ USA.
   (expr-item output/unspecific))
 
 (define (unassigned-item)
-  (expr-item output/unassigned))
\ No newline at end of file
+  (expr-item output/unassigned))
+\f
+;;;; Compiler
+
+(define compile-expr-item)
+(add-boot-init!
+ (lambda ()
+   (set! compile-expr-item
+        (standard-predicate-dispatcher 'compile-expr-item 1))
+   (run-deferred-boot-actions 'define-item-compiler)))
+
+(define (define-item-compiler predicate compiler)
+  (defer-boot-action 'define-item-compiler
+    (lambda ()
+      (define-predicate-dispatch-handler compile-expr-item
+       (list predicate)
+       compiler))))
+
+(define-item-compiler var-item?
+  (lambda (item)
+    (output/variable (var-item-id item))))
+
+(define-item-compiler expr-item?
+  (lambda (item)
+    ((expr-item-compiler item))))
+
+(define-item-compiler seq-item?
+  (lambda (item)
+    (output/sequence (map compile-expr-item (seq-item-elements item)))))
+
+(define-item-compiler decl-item?
+  (lambda (item)
+    (output/declaration (decl-item-text item))))
+
+(define-item-compiler defn-item?
+  (lambda (item)
+    (if (defn-item? item)
+       (let ((name (defn-item-id item))
+             (value (compile-expr-item (defn-item-value item))))
+         (if (defn-item-syntax? item)
+             (output/syntax-definition name value)
+             (output/definition name value)))
+       (compile-expr-item item))))
+
+(define (illegal-expression-compiler description)
+  (let ((message (string description " may not be used as an expression:")))
+    (lambda (item)
+      (syntax-error message item))))
+
+(define-item-compiler reserved-name-item?
+  (illegal-expression-compiler "Reserved name"))
+
+(define-item-compiler keyword-item?
+  (illegal-expression-compiler "Syntactic keyword"))
\ No newline at end of file
similarity index 93%
rename from src/runtime/syntax-transforms.scm
rename to src/runtime/syntax-low.scm
index d0837ca6d9a6d4ca586284faf1b3479510517a64..7e72af09f68405eaf559edd07ad8f15a455fbbd1 100644 (file)
@@ -24,7 +24,7 @@ USA.
 
 |#
 
-;;;; MIT/GNU Scheme syntax
+;;;; Syntax -- cold-load support
 
 ;;; Procedures to convert transformers to internal form.  Required
 ;;; during cold load, so must be loaded very early in the sequence.
@@ -56,6 +56,12 @@ USA.
                                 use-senv))
                 expr))
 
+(define-record-type <expander-item>
+    (expander-item impl expr)
+    expander-item?
+  (impl expander-item-impl)
+  (expr expander-item-expr))
+
 (define (->senv env)
   (if (syntactic-environment? env)
       env
index 3bfa73b75e5d6a070f1b823caccb10a631fdaf05..ddbcc57d2c14149311e8989e04e68b4e72242f9d 100644 (file)
@@ -123,59 +123,6 @@ USA.
 (define (classify-forms-in-order-cddr form senv hist)
   (classify-forms-in-order (cddr form) senv (hist-cddr hist)))
 \f
-;;;; Compiler
-
-(define compile-expr-item)
-(add-boot-init!
- (lambda ()
-   (set! compile-expr-item
-        (standard-predicate-dispatcher 'compile-expr-item 1))
-   (run-deferred-boot-actions 'define-item-compiler)))
-
-(define (define-item-compiler predicate compiler)
-  (defer-boot-action 'define-item-compiler
-    (lambda ()
-      (define-predicate-dispatch-handler compile-expr-item
-       (list predicate)
-       compiler))))
-
-(define-item-compiler var-item?
-  (lambda (item)
-    (output/variable (var-item-id item))))
-
-(define-item-compiler expr-item?
-  (lambda (item)
-    ((expr-item-compiler item))))
-
-(define-item-compiler seq-item?
-  (lambda (item)
-    (output/sequence (map compile-expr-item (seq-item-elements item)))))
-
-(define-item-compiler decl-item?
-  (lambda (item)
-    (output/declaration (decl-item-text item))))
-
-(define-item-compiler defn-item?
-  (lambda (item)
-    (if (defn-item? item)
-       (let ((name (defn-item-id item))
-             (value (compile-expr-item (defn-item-value item))))
-         (if (defn-item-syntax? item)
-             (output/syntax-definition name value)
-             (output/definition name value)))
-       (compile-expr-item item))))
-
-(define (illegal-expression-compiler description)
-  (let ((message (string description " may not be used as an expression:")))
-    (lambda (item)
-      (syntax-error message item))))
-
-(define-item-compiler reserved-name-item?
-  (illegal-expression-compiler "Reserved name"))
-
-(define-item-compiler keyword-item?
-  (illegal-expression-compiler "Syntactic keyword"))
-\f
 ;;;; Syntactic closures
 
 (define (close-syntax form senv)