Lots of hair to allow explicit character-set specifications to be

compiled at load time rather than at run time.

diff --git a/v7/src/star-parser/matcher.scm b/v7/src/star-parser/matcher.scm
index aa91bb11de21c5f7cf53c0d7b2ed283d479e7e1e..b29b94fa48d88df7a8f8b84311f0ff6dbc40fa83 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.3 2001/06/26 21:02:04 cph Exp $
+;;; $Id: matcher.scm,v 1.4 2001/06/26 21:16:44 cph Exp $
 ;;;
 ;;; Copyright (c) 2001 Massachusetts Institute of Technology
 ;;;
@@ -40,13 +40,11 @@
 (define (generate-matcher-code expression)
   (with-canonical-matcher-expression expression
     (lambda (expression)
-      (with-buffer-name
-       (lambda ()
-         (compile-matcher-expression
-          expression
-          (no-pointers)
-          (simple-backtracking-continuation `#T)
-          (simple-backtracking-continuation `#F)))))))
+      (compile-matcher-expression
+       expression
+       (no-pointers)
+       (simple-backtracking-continuation `#T)
+       (simple-backtracking-continuation `#F)))))
 
 (define (compile-matcher-expression expression pointers if-succeed if-fail)
   (cond ((and (pair? expression)
@@ -82,10 +80,11 @@
                                            internal-bindings)))
       (maybe-make-let (map (lambda (b) (list (cdr b) (car b)))
                           (cdr external-bindings))
-                     (receiver
-                      (maybe-make-let (map (lambda (b) (list (cdr b) (car b)))
-                                           (cdr internal-bindings))
-                                      expression))))))
+       (with-buffer-name
+         (lambda ()
+           (maybe-make-let (map (lambda (b) (list (cdr b) (car b)))
+                                (cdr internal-bindings))
+             (receiver expression))))))))
 
 (define (canonicalize-matcher-expression expression
                                         external-bindings internal-bindings)

diff --git a/v7/src/star-parser/parser.scm b/v7/src/star-parser/parser.scm
index 9c5c3bc895d19566f974d592e0f678b3c8d91e4c..07d61e8ec7df6d6f65a594b9b836faa0ed879285 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.3 2001/06/26 21:02:06 cph Exp $
+;;; $Id: parser.scm,v 1.4 2001/06/26 21:16:46 cph Exp $
 ;;;
 ;;; Copyright (c) 2001 Massachusetts Institute of Technology
 ;;;
@@ -40,17 +40,15 @@
 (define (generate-parser-code expression)
   (with-canonical-parser-expression expression
     (lambda (expression)
-      (with-buffer-name
-       (lambda ()
-         (compile-parser-expression
-          expression
-          (no-pointers)
-          (lambda (pointers result)
-            (handle-pending-backtracking pointers
-              (lambda (pointers)
-                pointers
-                result)))
-          (simple-backtracking-continuation `#F)))))))
+      (compile-parser-expression
+       expression
+       (no-pointers)
+       (lambda (pointers result)
+        (handle-pending-backtracking pointers
+          (lambda (pointers)
+            pointers
+            result)))
+       (simple-backtracking-continuation `#F)))))
 
 (define (compile-parser-expression expression pointers if-succeed if-fail)
   (cond ((and (pair? expression)
@@ -122,10 +120,11 @@
     (let ((expression (do-expression expression)))
       (maybe-make-let (map (lambda (b) (list (cdr b) (car b)))
                           (cdr external-bindings))
-                     (receiver
-                      (maybe-make-let (map (lambda (b) (list (cdr b) (car b)))
-                                           (cdr internal-bindings))
-                                      expression))))))
+       (with-buffer-name
+         (lambda ()
+           (maybe-make-let (map (lambda (b) (list (cdr b) (car b)))
+                                (cdr internal-bindings))
+             (receiver expression))))))))
 \f
 ;;;; Parsers