Add ability to specify macros that are symbols rather than forms.

These expand to fixed parser sequences.

diff --git a/v7/src/star-parser/load.scm b/v7/src/star-parser/load.scm
index c1b925ec39aaeca43e36e9937924dc9f29704dee..150e24aa18cf9e60cc07892fa650fe8651ef3d4c 100644 (file)
--- a/v7/src/star-parser/load.scm
+++ b/v7/src/star-parser/load.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: load.scm,v 1.2 2001/06/30 03:23:59 cph Exp $
+;;; $Id: load.scm,v 1.3 2001/06/30 06:05:35 cph Exp $
 ;;;
 ;;; Copyright (c) 2001 Massachusetts Institute of Technology
 ;;;
@@ -24,4 +24,4 @@
   (lambda ()
     (fluid-let ((*allow-package-redefinition?* #t))
       (package/system-loader "parser" '() 'QUERY))))
-(add-subsystem-identification! "*Parser" '(0 2))
\ No newline at end of file
+(add-subsystem-identification! "*Parser" '(0 3))
\ No newline at end of file

diff --git a/v7/src/star-parser/matcher.scm b/v7/src/star-parser/matcher.scm
index 68e92bd14598057ae41e1e57eaf58f5b41ab4d6a..f1681bfa00a94cdb72a056dc21f2830da5370d9e 100644 (file)
--- a/v7/src/star-parser/matcher.scm
+++ b/v7/src/star-parser/matcher.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: matcher.scm,v 1.6 2001/06/30 03:23:34 cph Exp $
+;;; $Id: matcher.scm,v 1.7 2001/06/30 06:05:19 cph Exp $
 ;;;
 ;;; Copyright (c) 2001 Massachusetts Institute of Technology
 ;;;
@@ -37,14 +37,6 @@
   (lambda (expression)
     (optimize-expression (generate-matcher-code expression))))
 
-(syntax-table/define system-global-syntax-table 'DEFINE-*MATCHER-MACRO
-  (lambda (bvl expression)
-    (if (not (named-lambda-bvl? bvl))
-       (error "Malformed bound-variable list:" bvl))
-    `(DEFINE-*MATCHER-MACRO* ',(car bvl)
-       (LAMBDA ,(cdr bvl)
-        ,expression))))
-
 (define (generate-matcher-code expression)
   (let ((external-bindings (list 'BINDINGS))
        (internal-bindings (list 'BINDINGS)))
@@ -86,6 +78,29 @@
                  ,(if-fail pointers)))))
        (else
         (error "Malformed matcher:" expression))))
+
+(syntax-table/define system-global-syntax-table 'DEFINE-*MATCHER-MACRO
+  (lambda (bvl expression)
+    (cond ((symbol? bvl)
+          `(DEFINE-*MATCHER-MACRO* ',bvl
+             (LAMBDA ()
+               ,expression)))
+         ((named-lambda-bvl? bvl)
+          `(DEFINE-*MATCHER-MACRO* ',(car bvl)
+             (LAMBDA ,(cdr bvl)
+               ,expression)))
+         (else
+          (error "Malformed bound-variable list:" bvl)))))
+
+(define (define-*matcher-macro* name procedure)
+  (hash-table/put! *matcher-macros name procedure)
+  name)
+
+(define (*matcher-expander name)
+  (hash-table/get *matcher-macros name #f))
+
+(define *matcher-macros
+  (make-eq-hash-table))
 \f
 ;;;; Canonicalization
 
@@ -148,23 +163,18 @@
              (handle-complex-expression (check-1-arg expression)
                                         internal-bindings))
             (else
-             (let ((expander
-                    (hash-table/get *matcher-macros (car expression) #f)))
+             (let ((expander (*matcher-expander (car expression))))
                (if expander
                    (do-expression (apply expander (cdr expression)))
                    (error "Unknown matcher expression:" expression))))))
          ((symbol? expression)
-          expression)
+          (let ((expander (*matcher-expander expression)))
+            (if expander
+                (do-expression (expander))
+                expression)))
          (else
           (error "Unknown matcher expression:" expression))))
   (do-expression expression))
-
-(define (define-*matcher-macro* name procedure)
-  (hash-table/put! *matcher-macros name procedure)
-  name)
-
-(define *matcher-macros
-  (make-eq-hash-table))
 \f
 ;;;; Matchers
 

diff --git a/v7/src/star-parser/parser.scm b/v7/src/star-parser/parser.scm
index 30c9dda91ab7f7355436fc9d2a4f6e78117fadb7..26e777f1dd99fbc3fbf4c0862b4c34ae59a98d18 100644 (file)
--- a/v7/src/star-parser/parser.scm
+++ b/v7/src/star-parser/parser.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: parser.scm,v 1.10 2001/06/30 03:23:41 cph Exp $
+;;; $Id: parser.scm,v 1.11 2001/06/30 06:05:09 cph Exp $
 ;;;
 ;;; Copyright (c) 2001 Massachusetts Institute of Technology
 ;;;
@@ -37,14 +37,6 @@
   (lambda (expression)
     (optimize-expression (generate-parser-code expression))))
 
-(syntax-table/define system-global-syntax-table 'DEFINE-*PARSER-MACRO
-  (lambda (bvl expression)
-    (if (not (named-lambda-bvl? bvl))
-       (error "Malformed bound-variable list:" bvl))
-    `(DEFINE-*PARSER-MACRO* ',(car bvl)
-       (LAMBDA ,(cdr bvl)
-        ,expression))))
-
 (define (generate-parser-code expression)
   (with-canonical-parser-expression expression
     (lambda (expression)
@@ -82,6 +74,29 @@
                      ,(if-fail pointers)))))))
        (else
         (error "Malformed matcher:" expression))))
+
+(syntax-table/define system-global-syntax-table 'DEFINE-*PARSER-MACRO
+  (lambda (bvl expression)
+    (cond ((symbol? bvl)
+          `(DEFINE-*PARSER-MACRO* ',bvl
+             (LAMBDA ()
+               ,expression)))
+         ((named-lambda-bvl? bvl)
+          `(DEFINE-*PARSER-MACRO* ',(car bvl)
+             (LAMBDA ,(cdr bvl)
+               ,expression)))
+         (else
+          (error "Malformed bound-variable list:" bvl)))))
+
+(define (define-*parser-macro* name procedure)
+  (hash-table/put! *parser-macros name procedure)
+  name)
+
+(define (*parser-expander name)
+  (hash-table/get *parser-macros name #f))
+
+(define *parser-macros
+  (make-eq-hash-table))
 \f
 ;;;; Canonicalization
 
@@ -127,13 +142,15 @@
                (handle-complex-expression (check-1-arg expression)
                                           internal-bindings))
               (else
-               (let ((expander
-                      (hash-table/get *parser-macros (car expression) #f)))
+               (let ((expander (*parser-expander (car expression))))
                  (if expander
                      (do-expression (apply expander (cdr expression)))
                      (error "Unknown parser expression:" expression))))))
            ((symbol? expression)
-            expression)
+            (let ((expander (*parser-expander expression)))
+              (if expander
+                  (do-expression (expander))
+                  expression)))
            (else
             (error "Unknown parser expression:" expression))))
     (let ((expression (do-expression expression)))
@@ -144,13 +161,6 @@
            (maybe-make-let (map (lambda (b) (list (cdr b) (car b)))
                                 (cdr internal-bindings))
              (receiver expression))))))))
-
-(define (define-*parser-macro* name procedure)
-  (hash-table/put! *parser-macros name procedure)
-  name)
-
-(define *parser-macros
-  (make-eq-hash-table))
 \f
 ;;;; Parsers