From 8213921214699553fcf3db8d2a179579acb96693 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Mon, 12 Feb 2018 21:24:32 -0800 Subject: [PATCH] Reorganize cold-load for syntax. * 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 | 2 +- src/runtime/make.scm | 5 +- src/runtime/runtime.pkg | 31 ++++----- src/runtime/syntax-items.scm | 63 ++++++++++++++++--- .../{syntax-transforms.scm => syntax-low.scm} | 8 ++- src/runtime/syntax.scm | 53 ---------------- 6 files changed, 81 insertions(+), 81 deletions(-) rename src/runtime/{syntax-transforms.scm => syntax-low.scm} (93%) diff --git a/src/runtime/ed-ffi.scm b/src/runtime/ed-ffi.scm index e18c6ab48..b165f4bc4 100644 --- a/src/runtime/ed-ffi.scm +++ b/src/runtime/ed-ffi.scm @@ -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)) diff --git a/src/runtime/make.scm b/src/runtime/make.scm index e04c35a50..abfa61f79 100644 --- a/src/runtime/make.scm +++ b/src/runtime/make.scm @@ -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) diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg index 3be7548c5..281df7bac 100644 --- a/src/runtime/runtime.pkg +++ b/src/runtime/runtime.pkg @@ -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)) diff --git a/src/runtime/syntax-items.scm b/src/runtime/syntax-items.scm index e48bc50e6..56a0a8064 100644 --- a/src/runtime/syntax-items.scm +++ b/src/runtime/syntax-items.scm @@ -24,7 +24,7 @@ USA. |# -;;;; Syntax Items +;;;; Syntax items and compiler (declare (usual-integrations)) @@ -38,12 +38,6 @@ USA. classifier-item? (impl classifier-item-impl)) -(define-record-type - (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)) + +;;;; 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 diff --git a/src/runtime/syntax-transforms.scm b/src/runtime/syntax-low.scm similarity index 93% rename from src/runtime/syntax-transforms.scm rename to src/runtime/syntax-low.scm index d0837ca6d..7e72af09f 100644 --- a/src/runtime/syntax-transforms.scm +++ b/src/runtime/syntax-low.scm @@ -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 impl expr) + expander-item? + (impl expander-item-impl) + (expr expander-item-expr)) + (define (->senv env) (if (syntactic-environment? env) env diff --git a/src/runtime/syntax.scm b/src/runtime/syntax.scm index 3bfa73b75..ddbcc57d2 100644 --- a/src/runtime/syntax.scm +++ b/src/runtime/syntax.scm @@ -123,59 +123,6 @@ USA. (define (classify-forms-in-order-cddr form senv hist) (classify-forms-in-order (cddr form) senv (hist-cddr hist))) -;;;; 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")) - ;;;; Syntactic closures (define (close-syntax form senv) -- 2.25.1