From 49f5a2e0b36aeba966395b3024259e03d6a74e96 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Thu, 17 Apr 2003 02:52:20 +0000 Subject: [PATCH] Change DEFINE-SYNTAX so that the right-hand side can be an identifier that is bound to a keyword. This makes (define-syntax sequence begin) possible. Also, remove old kludge to allow (define-syntax foo (lambda ...)) as acceptable syntax. --- v7/src/runtime/mit-syntax.scm | 49 +++++++++----------- v7/src/runtime/runtime.pkg | 3 +- v7/src/runtime/syntactic-closures.scm | 65 +++++++++++++++++---------- v7/src/runtime/syntax-transforms.scm | 10 ++++- 4 files changed, 71 insertions(+), 56 deletions(-) diff --git a/v7/src/runtime/mit-syntax.scm b/v7/src/runtime/mit-syntax.scm index 5ef79fb6d..148ccba8e 100644 --- a/v7/src/runtime/mit-syntax.scm +++ b/v7/src/runtime/mit-syntax.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: mit-syntax.scm,v 14.18 2003/03/14 01:11:36 cph Exp $ +$Id: mit-syntax.scm,v 14.19 2003/04/17 02:52:08 cph Exp $ Copyright 1989,1990,1991,2001,2002,2003 Massachusetts Institute of Technology @@ -37,19 +37,19 @@ USA. (lambda (form environment definition-environment history) definition-environment ;ignore (syntax-check '(KEYWORD EXPRESSION) form history) - (expression->transformer-item (classify/subexpression (cadr form) - environment - history - select-cadr) - environment - history - transformer->expander-name - transformer->expander))) - -(define (expression->transformer-item item environment history - transformer->expander-name - transformer->expander) - (make-transformer-item + (expression->keyword-value-item (classify/subexpression (cadr form) + environment + history + select-cadr) + environment + history + transformer->expander-name + transformer->expander))) + +(define (expression->keyword-value-item item environment history + transformer->expander-name + transformer->expander) + (make-keyword-value-item (transformer->expander (transformer-eval (compile-item/expression item) (syntactic-environment->environment environment)) @@ -257,20 +257,11 @@ USA. history)) (define (syntactic-binding-theory environment name item history) - (let ((item - (if (expression-item? item) - ;; Kludge to support old syntax -- treat procedure - ;; argument as non-hygienic transformer. - (expression->transformer-item - item environment history - 'NON-HYGIENIC-MACRO-TRANSFORMER->EXPANDER - non-hygienic-macro-transformer->expander) - item))) - (if (not (keyword-item? item)) - (let ((history (item/history item))) - (syntax-error history "Syntactic binding value must be a keyword:" - (history/original-form history)))) - (overloaded-binding-theory environment name item history))) + (if (not (keyword-item? item)) + (let ((history (item/history item))) + (syntax-error history "Syntactic binding value must be a keyword:" + (history/original-form history)))) + (overloaded-binding-theory environment name item history)) (define (variable-binding-theory environment name item history) (if (keyword-item? item) @@ -286,7 +277,7 @@ USA. name (item/new-history item #f)) ;; User-defined macros at top level are preserved in the output. - (if (and (transformer-item? item) + (if (and (keyword-value-item? item) (syntactic-environment/top-level? environment)) (make-binding-item history name item) (make-null-binding-item history))) diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg index 2f00fb1c8..2baccb80c 100644 --- a/v7/src/runtime/runtime.pkg +++ b/v7/src/runtime/runtime.pkg @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: runtime.pkg,v 14.444 2003/04/14 19:56:21 cph Exp $ +$Id: runtime.pkg,v 14.445 2003/04/17 02:52:12 cph Exp $ Copyright 1988,1989,1990,1991,1992,1993 Massachusetts Institute of Technology Copyright 1994,1995,1996,1997,1998,1999 Massachusetts Institute of Technology @@ -3843,6 +3843,7 @@ USA. syntactic-environment/lookup syntactic-environment/top-level? syntactic-environment? + syntactic-keyword->item syntax syntax* syntax-match? diff --git a/v7/src/runtime/syntactic-closures.scm b/v7/src/runtime/syntactic-closures.scm index b796dc5aa..e653c351c 100644 --- a/v7/src/runtime/syntactic-closures.scm +++ b/v7/src/runtime/syntactic-closures.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: syntactic-closures.scm,v 14.15 2003/03/08 02:07:18 cph Exp $ +$Id: syntactic-closures.scm,v 14.16 2003/04/17 02:52:16 cph Exp $ Copyright 1989,1990,1991,2001,2002,2003 Massachusetts Institute of Technology @@ -69,10 +69,10 @@ USA. (if (binding-item? item) (let ((name (binding-item/name item)) (value (binding-item/value item))) - (if (transformer-item? value) + (if (keyword-value-item? value) (output/top-level-syntax-definition name - (compile-item/expression (transformer-item/expression value))) + (compile-item/expression (keyword-value-item/expression value))) (output/top-level-definition name (compile-item/expression value)))) @@ -132,7 +132,14 @@ USA. (define (classify/form form environment definition-environment history) (cond ((identifier? form) - (item/new-history (lookup-identifier environment form) history)) + (let ((item + (item/new-history (lookup-identifier environment form) + history))) + (if (keyword-item? item) + (make-keyword-ref-item (strip-keyword-value-item item) + form + history) + item))) ((syntactic-closure? form) (let ((form (syntactic-closure/form form)) (environment @@ -148,8 +155,9 @@ USA. history)))) ((pair? form) (let ((item - (classify/subexpression (car form) environment history - select-car))) + (strip-keyword-value-item + (classify/subexpression (car form) environment history + select-car)))) (cond ((classifier-item? item) ((classifier-item/classifier item) form environment @@ -163,12 +171,6 @@ USA. environment definition-environment history)) - ((transformer-item? item) - (classify/expander (transformer-item/expander item) - form - environment - definition-environment - history)) (else (if (not (list? (cdr form))) (syntax-error history @@ -275,6 +277,11 @@ USA. declarations (cons (car items) items*))) (values (reverse! declarations) (reverse! items*))))) + +(define (strip-keyword-value-item item) + (if (keyword-value-item? item) + (keyword-value-item/item item) + item)) ;;;; Syntactic Closures @@ -710,7 +717,7 @@ USA. (or (classifier-item? item) (compiler-item? item) (expander-item? item) - (transformer-item? item))) + (keyword-value-item? item))) (define (make-keyword-type name fields) (make-item-type name fields keyword-item-compiler)) @@ -758,20 +765,30 @@ USA. (item-accessor 'ENVIRONMENT)) -(define - (make-keyword-type "transformer-item" '(EXPANDER EXPRESSION))) +(define + (make-keyword-type "keyword-value-item" '(ITEM EXPRESSION))) + +(define make-keyword-value-item + (keyword-constructor '(ITEM EXPRESSION))) -(define make-transformer-item - (keyword-constructor '(EXPANDER EXPRESSION))) +(define keyword-value-item? + (item-predicate )) -(define transformer-item? - (item-predicate )) +(define keyword-value-item/item + (item-accessor 'ITEM)) -(define transformer-item/expander - (item-accessor 'EXPANDER)) +(define keyword-value-item/expression + (item-accessor 'EXPRESSION)) -(define transformer-item/expression - (item-accessor 'EXPRESSION)) +(define (make-keyword-ref-item item identifier history) + (make-keyword-value-item item + (make-expression-item history + (let ((name (identifier->symbol identifier))) + (lambda () + (output/combination + (output/access-reference 'SYNTACTIC-KEYWORD->ITEM + system-global-environment) + (list name (output/the-environment)))))))) ;;; Variable items represent run-time variables. @@ -865,7 +882,7 @@ USA. (map (lambda (item) (if (binding-item? item) (let ((value (binding-item/value item))) - (if (transformer-item? value) + (if (keyword-value-item? value) (output/sequence '()) (output/definition (binding-item/name item) (compile-item/expression value)))) diff --git a/v7/src/runtime/syntax-transforms.scm b/v7/src/runtime/syntax-transforms.scm index 765638d6c..1f38d8f40 100644 --- a/v7/src/runtime/syntax-transforms.scm +++ b/v7/src/runtime/syntax-transforms.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: syntax-transforms.scm,v 14.6 2003/03/08 02:07:26 cph Exp $ +$Id: syntax-transforms.scm,v 14.7 2003/04/17 02:52:20 cph Exp $ Copyright 1989-1991, 2001, 2002 Massachusetts Institute of Technology @@ -96,4 +96,10 @@ USA. closing-environment (make-syntactic-closure environment '() (apply transformer (cdr form)))) - closing-environment)) \ No newline at end of file + closing-environment)) + +(define (syntactic-keyword->item keyword environment) + (let ((item (environment-lookup-macro environment keyword))) + (if (not item) + (error:bad-range-argument keyword 'SYNTACTIC-KEYWORD->ITEM)) + item)) \ No newline at end of file -- 2.25.1