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.

diff --git a/v7/src/runtime/mit-syntax.scm b/v7/src/runtime/mit-syntax.scm
index 5ef79fb6d5db08243ae957ec9c3ba99c807f7be4..148ccba8e2d65713d50ffbcc870818f90d336224 100644 (file)
--- 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 2f00fb1c87ce3df9a55d4b568dde4782c4eb7daf..2baccb80c723122a2f8d563fa94cbd60711633c9 100644 (file)
--- 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 b796dc5aaba9e4f3c470c01b50add309f6400c2c..e653c351cdfc6445e8e2b76f8712f6d00ae22603 100644 (file)
--- 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))
 \f
 ;;;; 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 <expander-item> 'ENVIRONMENT))
 
 
-(define <transformer-item>
-  (make-keyword-type "transformer-item" '(EXPANDER EXPRESSION)))
+(define <keyword-value-item>
+  (make-keyword-type "keyword-value-item" '(ITEM EXPRESSION)))
+
+(define make-keyword-value-item
+  (keyword-constructor <keyword-value-item> '(ITEM EXPRESSION)))
 
-(define make-transformer-item
-  (keyword-constructor <transformer-item> '(EXPANDER EXPRESSION)))
+(define keyword-value-item?
+  (item-predicate <keyword-value-item>))
 
-(define transformer-item?
-  (item-predicate <transformer-item>))
+(define keyword-value-item/item
+  (item-accessor <keyword-value-item> 'ITEM))
 
-(define transformer-item/expander
-  (item-accessor <transformer-item> 'EXPANDER))
+(define keyword-value-item/expression
+  (item-accessor <keyword-value-item> 'EXPRESSION))
 
-(define transformer-item/expression
-  (item-accessor <transformer-item> '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))))))))
 \f
 ;;; 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 765638d6c9c2f363a86a6458ab615ad967ccf7b0..1f38d8f4042fc336c4790fa72acffd5ec9308708 100644 (file)
--- 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