From: Chris Hanson Date: Mon, 19 Feb 2018 06:01:22 +0000 (-0800) Subject: Split transformer->expander procedures into internal and external. X-Git-Tag: mit-scheme-pucked-x11-0.3.1~7^2~237 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=512c2c5c3c6bb019bae7caac274fcff206e8aff4;p=mit-scheme.git Split transformer->expander procedures into internal and external. The external version takes a runtime environment as its closing env, while the internal version takes a syntactic environment. --- diff --git a/src/runtime/mit-syntax.scm b/src/runtime/mit-syntax.scm index 14d13f3d8..19fc2ef03 100644 --- a/src/runtime/mit-syntax.scm +++ b/src/runtime/mit-syntax.scm @@ -31,34 +31,36 @@ USA. ;;;; Macro transformers -(define (transformer-classifier procedure-name transformer->expander) +(define (transformer-classifier transformer->keyword-item + transformer->expander-name) (lambda (form senv hist) (scheck '(_ expression) form senv hist) (let ((transformer (compile-expr-item (classify-form-cadr form senv hist)))) - (transformer->expander (transformer-eval transformer senv) - senv - (expr-item - (lambda () - (output/top-level-syntax-expander - procedure-name transformer))))))) + (transformer->keyword-item + (transformer-eval transformer senv) + senv + (expr-item + (lambda () + (output/top-level-syntax-expander transformer->expander-name + transformer))))))) (define :sc-macro-transformer ;; "Syntactic Closures" transformer (classifier->runtime - (transformer-classifier 'sc-macro-transformer->expander - sc-macro-transformer->expander))) + (transformer-classifier sc-macro-transformer->keyword-item + 'sc-macro-transformer->expander))) (define :rsc-macro-transformer ;; "Reversed Syntactic Closures" transformer (classifier->runtime - (transformer-classifier 'rsc-macro-transformer->expander - rsc-macro-transformer->expander))) + (transformer-classifier rsc-macro-transformer->keyword-item + 'rsc-macro-transformer->expander))) (define :er-macro-transformer ;; "Explicit Renaming" transformer (classifier->runtime - (transformer-classifier 'er-macro-transformer->expander - er-macro-transformer->expander))) + (transformer-classifier er-macro-transformer->keyword-item + 'er-macro-transformer->expander))) ;;;; Core primitives diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg index bdeff62bf..e9f1b80c5 100644 --- a/src/runtime/runtime.pkg +++ b/src/runtime/runtime.pkg @@ -4455,11 +4455,14 @@ USA. syntactic-keyword->item) (export (runtime syntax) classifier->runtime + er-macro-transformer->keyword-item keyword-item keyword-item-expr keyword-item-has-expr? keyword-item-impl - keyword-item?)) + keyword-item? + rsc-macro-transformer->keyword-item + sc-macro-transformer->keyword-item)) (define-package (runtime syntax items) (files "syntax-items") diff --git a/src/runtime/syntax-low.scm b/src/runtime/syntax-low.scm index 3a2de40ea..17d12348c 100644 --- a/src/runtime/syntax-low.scm +++ b/src/runtime/syntax-low.scm @@ -34,35 +34,72 @@ USA. ;;; These optional arguments are needed for cross-compiling 9.2->9.3. ;;; They can become required after 9.3 release. -(define (sc-macro-transformer->expander transformer closing-env #!optional expr) - (expander-item (lambda (form use-senv) - (close-syntax (transformer form use-senv) - (->senv closing-env))) +(define (sc-macro-transformer->expander transformer env #!optional expr) + (expander-item (sc-wrapper transformer (runtime-getter env)) expr)) -(define (rsc-macro-transformer->expander transformer closing-env - #!optional expr) - (expander-item (lambda (form use-senv) - (close-syntax (transformer form (->senv closing-env)) - use-senv)) +(define (rsc-macro-transformer->expander transformer env #!optional expr) + (expander-item (rsc-wrapper transformer (runtime-getter env)) expr)) -(define (er-macro-transformer->expander transformer closing-env #!optional expr) - (expander-item (lambda (form use-senv) - (close-syntax (transformer form - (make-er-rename - (->senv closing-env)) - (make-er-compare use-senv)) - use-senv)) +(define (er-macro-transformer->expander transformer env #!optional expr) + (expander-item (er-wrapper transformer (runtime-getter env)) expr)) +(define (sc-macro-transformer->keyword-item transformer closing-senv expr) + (expander-item (sc-wrapper transformer (lambda () closing-senv)) + expr)) + +(define (rsc-macro-transformer->keyword-item transformer closing-senv expr) + (expander-item (rsc-wrapper transformer (lambda () closing-senv)) + expr)) + +(define (er-macro-transformer->keyword-item transformer closing-senv expr) + (expander-item (er-wrapper transformer (lambda () closing-senv)) + expr)) + +(define (runtime-getter env) + (lambda () + (runtime-environment->syntactic env))) + +(define (sc-wrapper transformer get-closing-senv) + (lambda (form use-senv) + (close-syntax (transformer form use-senv) + (get-closing-senv)))) + +(define (rsc-wrapper transformer get-closing-senv) + (lambda (form use-senv) + (close-syntax (transformer form (get-closing-senv)) + use-senv))) + +(define (er-wrapper transformer get-closing-env) + (lambda (form use-senv) + (close-syntax (transformer form + (make-er-rename (get-closing-env)) + (make-er-compare use-senv)) + use-senv))) + +(define (make-er-rename closing-senv) + (lambda (identifier) + (close-syntax identifier closing-senv))) + +(define (make-er-compare use-senv) + (lambda (x y) + (identifier=? use-senv x use-senv y))) + ;;; Keyword items represent syntactic keywords. (define (keyword-item impl #!optional expr) (%keyword-item impl expr)) -(define (keyword-item-has-expr? item) - (not (default-object? (keyword-item-expr item)))) +(define (expander-item impl expr) + (%keyword-item (lambda (form senv hist) + (reclassify (with-error-context form senv hist + (lambda () + (impl form senv))) + senv + hist)) + expr)) (define-record-type (%keyword-item impl expr) @@ -70,31 +107,12 @@ USA. (impl keyword-item-impl) (expr keyword-item-expr)) -(define (expander-item impl expr) - (keyword-item (lambda (form senv hist) - (reclassify (with-error-context form senv hist - (lambda () - (impl form senv))) - senv - hist)) - expr)) +(define (keyword-item-has-expr? item) + (not (default-object? (keyword-item-expr item)))) (define (classifier->runtime classifier) (make-unmapped-macro-reference-trap (keyword-item classifier))) -(define (->senv env) - (if (syntactic-environment? env) - env - (runtime-environment->syntactic env))) - -(define (make-er-rename closing-senv) - (lambda (identifier) - (close-syntax identifier closing-senv))) - -(define (make-er-compare use-senv) - (lambda (x y) - (identifier=? use-senv x use-senv y))) - (define (syntactic-keyword->item keyword environment) (let ((item (environment-lookup-macro environment keyword))) (if (not item)