From cc0a2b715ac16099573271c6935a8831a3c46ba7 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Sun, 18 Feb 2018 22:32:39 -0800 Subject: [PATCH] Implement spar-macro-transformer. --- src/runtime/mit-syntax.scm | 6 ++++ src/runtime/runtime.pkg | 5 ++- src/runtime/syntax-low.scm | 59 ++++++++++++++++++++++------------- src/runtime/syntax-parser.scm | 23 +++++++------- 4 files changed, 58 insertions(+), 35 deletions(-) diff --git a/src/runtime/mit-syntax.scm b/src/runtime/mit-syntax.scm index 19fc2ef03..b4e69ab0b 100644 --- a/src/runtime/mit-syntax.scm +++ b/src/runtime/mit-syntax.scm @@ -61,6 +61,12 @@ USA. (classifier->runtime (transformer-classifier er-macro-transformer->keyword-item 'er-macro-transformer->expander))) + +(define :spar-macro-transformer + ;; "Syntax PARser" transformer + (classifier->runtime + (transformer-classifier spar-macro-transformer->keyword-item + 'spar-macro-transformer->expander))) ;;;; Core primitives diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg index e9f1b80c5..edfa5e368 100644 --- a/src/runtime/runtime.pkg +++ b/src/runtime/runtime.pkg @@ -4452,6 +4452,7 @@ USA. er-macro-transformer->expander rsc-macro-transformer->expander sc-macro-transformer->expander + spar-macro-transformer->expander syntactic-keyword->item) (export (runtime syntax) classifier->runtime @@ -4462,7 +4463,8 @@ USA. keyword-item-impl keyword-item? rsc-macro-transformer->keyword-item - sc-macro-transformer->keyword-item)) + sc-macro-transformer->keyword-item + spar-macro-transformer->keyword-item)) (define-package (runtime syntax items) (files "syntax-items") @@ -4639,6 +4641,7 @@ USA. (rsc-macro-transformer :rsc-macro-transformer) (sc-macro-transformer :sc-macro-transformer) (set! :set!) + (spar-macro-transformer :spar-macro-transformer) (the-environment :the-environment)) (export (runtime mit-macros) keyword:access diff --git a/src/runtime/syntax-low.scm b/src/runtime/syntax-low.scm index 17d12348c..c05c9d809 100644 --- a/src/runtime/syntax-low.scm +++ b/src/runtime/syntax-low.scm @@ -38,44 +38,40 @@ USA. (expander-item (sc-wrapper transformer (runtime-getter env)) expr)) -(define (rsc-macro-transformer->expander transformer env #!optional expr) - (expander-item (rsc-wrapper transformer (runtime-getter env)) - expr)) - -(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-macro-transformer->expander transformer env #!optional expr) + (expander-item (rsc-wrapper transformer (runtime-getter env)) + expr)) + +(define (rsc-macro-transformer->keyword-item transformer closing-senv expr) + (expander-item (rsc-wrapper transformer (lambda () closing-senv)) + expr)) + (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) +(define (er-macro-transformer->expander transformer env #!optional expr) + (expander-item (er-wrapper transformer (runtime-getter env)) + expr)) + +(define (er-macro-transformer->keyword-item transformer closing-senv expr) + (expander-item (er-wrapper transformer (lambda () closing-senv)) + expr)) + +(define (er-wrapper transformer get-closing-senv) (lambda (form use-senv) (close-syntax (transformer form - (make-er-rename (get-closing-env)) + (make-er-rename (get-closing-senv)) (make-er-compare use-senv)) use-senv))) @@ -86,6 +82,25 @@ USA. (define (make-er-compare use-senv) (lambda (x y) (identifier=? use-senv x use-senv y))) + +(define (spar-macro-transformer->expander spar env expr) + (keyword-item (spar-wrapper spar (runtime-getter env)) + expr)) + +(define (spar-macro-transformer->keyword-item spar closing-senv expr) + (keyword-item (spar-wrapper spar (lambda () closing-senv)) + expr)) + +(define (spar-wrapper spar get-closing-senv) + (lambda (form senv hist) + (reclassify (close-syntax ((spar->classifier spar) form senv hist) + (get-closing-senv)) + senv + hist))) + +(define (runtime-getter env) + (lambda () + (runtime-environment->syntactic env))) ;;; Keyword items represent syntactic keywords. diff --git a/src/runtime/syntax-parser.scm b/src/runtime/syntax-parser.scm index a8d98d037..4da6494eb 100644 --- a/src/runtime/syntax-parser.scm +++ b/src/runtime/syntax-parser.scm @@ -65,18 +65,17 @@ USA. ;;; (failure) (define (spar->classifier spar) - (keyword-item - (lambda (form senv hist) - (spar (%new-input form hist) - senv - (%new-output) - (lambda (input senv output failure) - (declare (ignore senv failure)) - (if (%input-null? input) - (error "Rule failed to match entire form.")) - (output 'get-only)) - (lambda () - (serror form senv hist "Ill-formed syntax:" form)))))) + (lambda (form senv hist) + (spar (%new-input form hist) + senv + (%new-output) + (lambda (input senv output failure) + (declare (ignore senv failure)) + (if (%input-null? input) + (error "Rule failed to match entire form.")) + (output 'get-only)) + (lambda () + (serror form senv hist "Ill-formed syntax:" form))))) ;;;; Inputs and outputs -- 2.25.1