From 28a7fc60c9d1f0bc4eb567a684767467568a3aaf Mon Sep 17 00:00:00 2001 From: Scott Owens Date: Wed, 17 Oct 2001 19:57:49 +0000 Subject: [PATCH] *** empty log message *** original commit: fd6994ff1f843f794b3491d338db4bfc8afb6329 --- .../private-yacc/parser-builder.ss | 31 +++++++++++++------ 1 file changed, 22 insertions(+), 9 deletions(-) diff --git a/collects/parser-tools/private-yacc/parser-builder.ss b/collects/parser-tools/private-yacc/parser-builder.ss index cf27547..344a124 100644 --- a/collects/parser-tools/private-yacc/parser-builder.ss +++ b/collects/parser-tools/private-yacc/parser-builder.ss @@ -45,11 +45,11 @@ `(letrec ((term-sym->index ,token-code) (table ,table-code) (actions ,actions-code) - (pop-x - (lambda (s n) + (reduce-stack + (lambda (s n v) (if (> n 0) - (pop-x (cdr s) (sub1 n)) - s)))) + (reduce-stack (cdr (cdr s)) (sub1 n) (cons (cadr s) v)) + (values s v))))) (lambda (get-token) (let loop ((stack (list 0)) (ip (get-token))) @@ -66,13 +66,26 @@ (cond ((shift? action) (printf "shift:~a~n" (shift-state action)) - (loop (cons (shift-state action) stack) (get-token))) + (let ((val (if (token? ip) + (token-value ip) + #f))) + (loop (cons (shift-state action) (cons val stack)) + (get-token)))) ((reduce? action) (printf "reduce:~a~n" (reduce-prod-num action)) - (let* ((A (reduce-lhs-num action)) - (new-stack (pop-x stack (reduce-rhs-length action))) - (goto (array2d-ref table (car new-stack) A))) - (loop (cons goto new-stack) ip))) + (let-values (((new-stack args) + (reduce-stack stack + (reduce-rhs-length action) + null))) + (let* ((A (reduce-lhs-num action)) + (goto (array2d-ref table (car new-stack) A))) + (loop (cons goto + (cons (apply + (vector-ref actions + (reduce-prod-num action)) + args) + new-stack)) + ip)))) ((accept? action) (printf "accept~n")) (else (error 'parser)))))))))