Fix bug in previous change.
authorChris Hanson <org/chris-hanson/cph>
Fri, 25 Feb 1994 20:35:03 +0000 (20:35 +0000)
committerChris Hanson <org/chris-hanson/cph>
Fri, 25 Feb 1994 20:35:03 +0000 (20:35 +0000)
v7/src/runtime/syntax.scm

index 92e56d2517aa6344b62cc50b19cbff6b0fdaa142..aaccef9a0715ee6bd42aae992ff550e9170c2ece 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: syntax.scm,v 14.24 1994/02/22 21:14:00 cph Exp $
+$Id: syntax.scm,v 14.25 1994/02/25 20:35:03 cph Exp $
 
 Copyright (c) 1988-1994 Massachusetts Institute of Technology
 
@@ -96,22 +96,25 @@ MIT in each case. |#
 ;;;; Top Level Syntaxers
 
 (define (syntax expression #!optional table)
-  (syntax* (list expression) (if (default-object? table) #f table)))
+  (syntax-top-level 'SYNTAX syntax-expression expression
+                   (if (default-object? table) #f table)))
 
 (define (syntax* expressions #!optional table)
+  (syntax-top-level 'SYNTAX* syntax-sequence expressions
+                   (if (default-object? table) #f table)))
+
+(define (syntax-top-level name syntaxer expression table)
   (fluid-let ((*syntax-table*
-              (cond ((or (default-object? table) (not table))
-                     (if (unassigned? *syntax-table*)
-                         (nearest-repl/syntax-table)
-                         *syntax-table*))
-                    ((syntax-table? table)
-                     table)
-                    (else
-                     (error:wrong-type-argument table
-                                                "syntax table"
-                                                'SYNTAX*))))
+              (if table
+                  (begin
+                    (if (not (syntax-table? table))
+                        (error:wrong-type-argument table "syntax table" name))
+                    table)
+                  (if (unassigned? *syntax-table*)
+                      (nearest-repl/syntax-table)
+                      *syntax-table*)))
              (*current-keyword* #f))
-    (syntax-sequence #t expressions)))
+    (syntaxer #t expression)))
 
 (define (syntax/top-level?)
   *syntax-top-level?*)
@@ -149,8 +152,7 @@ MIT in each case. |#
    ((pair? expression)
     (if (not (list? expression))
        (error "syntax-expression: not a valid expression" expression))
-    (let ((transform
-          (syntax-table-ref syntax-table (car expression))))
+    (let ((transform (syntax-table-ref syntax-table (car expression))))
       (if transform
          (if (primitive-syntaxer? transform)
              (transform-apply (primitive-syntaxer/transform transform)