From b7e6051938b16f8891c7829dc1ffe6865ec0f828 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Tue, 26 Jun 2001 23:46:41 +0000 Subject: [PATCH] Fix a couple of code-generation bugs. --- v7/src/star-parser/parser.scm | 37 ++++++++++++++++++----------------- 1 file changed, 19 insertions(+), 18 deletions(-) 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) -- 2.25.1