From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 26 Jun 2001 23:46:41 +0000 (+0000)
Subject: Fix a couple of code-generation bugs.
X-Git-Tag: 20090517-FFI~2695
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=b7e6051938b16f8891c7829dc1ffe6865ec0f828;p=mit-scheme.git

Fix a couple of code-generation bugs.
---

diff --git a/v7/src/star-parser/parser.scm b/v7/src/star-parser/parser.scm
index eeca53774..7d832dad1 100644
--- a/v7/src/star-parser/parser.scm
+++ b/v7/src/star-parser/parser.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: parser.scm,v 1.6 2001/06/26 21:29:41 cph Exp $
+;;; $Id: parser.scm,v 1.7 2001/06/26 23:46:41 cph Exp $
 ;;;
 ;;; Copyright (c) 2001 Massachusetts Institute of Technology
 ;;;
@@ -219,7 +219,7 @@
 	  (with-current-pointer pointers
 	    (lambda (start-pointers)
 	      (let loop ((ps ps) (pointers start-pointers) (results '()))
-		(compile-parser-expression (car ps) start-pointers
+		(compile-parser-expression (car ps) pointers
 		  (lambda (pointers result)
 		    (let ((results (cons result results)))
 		      (if (pair? (cdr ps))
@@ -253,22 +253,23 @@
 (define-parser (* parser)
   (handle-pending-backtracking pointers
     (lambda (pointers)
-      (if-succeed
-       (unknown-location pointers)
-       (let ((loop (generate-uninterned-symbol))
-	     (elements (generate-uninterned-symbol)))
-	 `(LET ,loop ((,elements (VECTOR)))
-	    ,(compile-parser-expression parser (no-pointers)
-	       (lambda (pointers element)
-		 (handle-pending-backtracking pointers
-		   (lambda (pointers)
-		     pointers
-		     `(,loop (VECTOR-APPEND ,elements ,element)))))
-	       (lambda (pointers)
-		 (handle-pending-backtracking pointers
-		   (lambda (pointers)
-		     pointers
-		     elements))))))))))
+      (with-variable-binding
+	  (let ((loop (generate-uninterned-symbol))
+		(elements (generate-uninterned-symbol)))
+	    `(LET ,loop ((,elements (VECTOR)))
+	       ,(compile-parser-expression parser (no-pointers)
+		  (lambda (pointers element)
+		    (handle-pending-backtracking pointers
+		      (lambda (pointers)
+			pointers
+			`(,loop (VECTOR-APPEND ,elements ,element)))))
+		  (lambda (pointers)
+		    (handle-pending-backtracking pointers
+		      (lambda (pointers)
+			pointers
+			elements))))))
+	(lambda (elements)
+	  (if-succeed (unknown-location pointers) elements))))))
 
 ;;; Edwin Variables:
 ;;; Eval: (scheme-indent-method 'handle-pending-backtracking 1)