Implement ERROR macros.

diff --git a/v7/src/star-parser/matcher.scm b/v7/src/star-parser/matcher.scm
index 7891dc6a4216d7844e036ed6f705a2335997a7ad..64d62dcb571001b30291296ce160cb0b7d4cd3a3 100644 (file)
--- a/v7/src/star-parser/matcher.scm
+++ b/v7/src/star-parser/matcher.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: matcher.scm,v 1.34 2005/06/04 03:42:28 cph Exp $
+$Id: matcher.scm,v 1.35 2006/06/10 04:12:32 cph Exp $
 
-Copyright 2001,2002,2004,2005 Massachusetts Institute of Technology
+Copyright 2001,2002,2004,2005,2006 Massachusetts Institute of Technology
 
 This file is part of MIT/GNU Scheme.
 
@@ -138,6 +138,13 @@ USA.
     `(SEQ (N*N ,n ,expression)
          (*N ,(- m n) ,expression))))
 
+(define-*matcher-expander 'ERROR
+  (lambda (ptr msg . irritants)
+    (let ((v (generate-uninterned-symbol)))
+      `(SEXP (LAMBDA (,v)
+              ,@(if ptr (list v) '())
+              (PARSER-BUFFER-ERROR ,(or ptr v) ,msg ,@irritants))))))
+
 (define-matcher-preprocessor '(ALT SEQ)
   (lambda (expression external-bindings internal-bindings)
     `(,(car expression)

diff --git a/v7/src/star-parser/parser.scm b/v7/src/star-parser/parser.scm
index 005bbfc79353efaf50a13ff71566cdf26835f34d..538b76de99b305e8c36c47803afe9554f7c8e909 100644 (file)
--- a/v7/src/star-parser/parser.scm
+++ b/v7/src/star-parser/parser.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: parser.scm,v 1.35 2003/02/14 18:28:35 cph Exp $
+$Id: parser.scm,v 1.36 2006/06/10 04:12:32 cph Exp $
 
-Copyright 2001,2002,2003 Massachusetts Institute of Technology
+Copyright 2001,2002,2003,2006 Massachusetts Institute of Technology
 
 This file is part of MIT/GNU Scheme.
 
@@ -125,6 +125,13 @@ USA.
   (lambda (expression)
     `(SEQ ,expression (DISCARD-MATCHED))))
 
+(define-*parser-expander 'ERROR
+  (lambda (ptr msg . irritants)
+    (let ((v (generate-uninterned-symbol)))
+      `(SEXP (LAMBDA (,v)
+              ,@(if ptr (list v) '())
+              (PARSER-BUFFER-ERROR ,(or ptr v) ,msg ,@irritants))))))
+
 (define-parser-preprocessor '(ALT SEQ)
   (lambda (expression external-bindings internal-bindings)
     `(,(car expression)