From facf53edf81e7e60ce5b908721a2c9ee3d0c2ce8 Mon Sep 17 00:00:00 2001 From: Scott Owens Date: Mon, 22 Jul 2002 21:06:25 +0000 Subject: [PATCH] *** empty log message *** original commit: 2bb8faea6977540b956037dedd6773a717f6674d --- .../private-yacc/input-file-parser.ss | 1 + collects/parser-tools/yacc.ss | 50 +++++++++---------- 2 files changed, 25 insertions(+), 26 deletions(-) diff --git a/collects/parser-tools/private-yacc/input-file-parser.ss b/collects/parser-tools/private-yacc/input-file-parser.ss index 49e38e1..d0fa35f 100644 --- a/collects/parser-tools/private-yacc/input-file-parser.ss +++ b/collects/parser-tools/private-yacc/input-file-parser.ss @@ -17,6 +17,7 @@ ;; get-args: int * syntax-object list * syntax-object -> syntax-object list (define (get-args i rhs act src-pos term-defs) (let ((empty-table (make-hash-table))) + (hash-table-put! empty-table 'error #t) (for-each (lambda (td) (let ((v (syntax-local-value td))) (if (e-terminals-def? v) diff --git a/collects/parser-tools/yacc.ss b/collects/parser-tools/yacc.ss index 3b80c74..abe19e6 100644 --- a/collects/parser-tools/yacc.ss +++ b/collects/parser-tools/yacc.ss @@ -177,7 +177,7 @@ (reduce-stack (cdr stack) (sub1 num) ret-vals src-pos))) (else (values stack ret-vals)))) - (define-struct stack-frame (state value start-pos end-pos)) + (define-struct stack-frame (state value start-pos end-pos) (make-inspector)) (define empty-stack (list (make-stack-frame 0 #f #f #f))) @@ -214,26 +214,28 @@ (fix-error (lambda (stack tok ip get-token) + (printf "stack: ~a~n" stack) (letrec ((remove-input (lambda () (if (memq (token-name tok) ends) - #f + (raise-read-error "parser: Cannot continue after error" + #f #f #f #f #f) (let ((a (find-action stack tok ip))) (cond ((shift? a) - ;; (printf "shift:~a~n" (shift-state a)) + (printf "shift:~a~n" (shift-state a)) (cons (if src-pos (make-stack-frame (shift-state a) - (if (token? ip) (token-value ip) #f) + (token-value tok) (cadr ip) (caddr ip)) (make-stack-frame (shift-state a) - (if (token? ip) (token-value ip) #f) + (token-value tok) #f #f)) stack)) (else - ;; (printf "discard input:~a~n" tok) + (printf "discard input:~a~n" tok) (set! ip (get-token)) (set! tok (input->token ip)) (remove-input))))))) @@ -242,28 +244,29 @@ (let ((a (find-action stack (make-token 'error #f) ip))) (cond ((shift? a) - ;; (printf "shift:~a~n" (shift-state a)) + (printf "shift:~a~n" (shift-state a)) (set! stack (cons (if src-pos - (make-stack-frame (shift-state a) - #f - (cadr ip) - (caddr ip)) - (make-stack-frame (shift-state a) - #f - #f - #f)) + (make-stack-frame (shift-state a) + #f + (cadr ip) + (caddr ip)) + (make-stack-frame (shift-state a) + #f + #f + #f)) stack)) (remove-input)) (else - ;; (printf "discard state:~a~n" (car stack)) + (printf "discard state:~a~n" (car stack)) (cond ((< (length stack) 2) - (printf "Unable to shift error token~n") - #f) + (raise-read-error "parser: Cannot continue after error" + #f #f #f #f #f)) (else - (set! stack (cdr stack)))))))))) + (set! stack (cdr stack)) + (remove-states))))))))) (remove-states)))) (find-action @@ -331,13 +334,8 @@ (if src-pos (err #t (token-name tok) (token-value tok) (cadr ip) (caddr ip)) (err #t (token-name tok) (token-value tok))) - (let ((new-stack (fix-error stack tok ip get-token))) - (if new-stack - (parsing-loop new-stack (get-token)) - (raise-read-error - "parser: Could not parse input" - #f #f #f #f #f)))))))))) - + (parsing-loop (fix-error stack tok ip get-token) (get-token))))))))) + ) \ No newline at end of file