From dc2805cf48ce8cf6b334de2ae7ff34e1d76ccba5 Mon Sep 17 00:00:00 2001 From: Scott Owens Date: Mon, 22 Oct 2001 08:58:14 +0000 Subject: [PATCH] *** empty log message *** original commit: ca20d2a89326943989e4ae31bdd9a121eced73fa --- .../private-yacc/input-file-parser.ss | 2 + .../private-yacc/parser-builder.ss | 68 +++++++++++++++---- collects/parser-tools/yacc.ss | 4 +- 3 files changed, 61 insertions(+), 13 deletions(-) diff --git a/collects/parser-tools/private-yacc/input-file-parser.ss b/collects/parser-tools/private-yacc/input-file-parser.ss index bcb43e9..df053b8 100644 --- a/collects/parser-tools/private-yacc/input-file-parser.ss +++ b/collects/parser-tools/private-yacc/input-file-parser.ss @@ -116,6 +116,7 @@ (let* ((counter 0) (start-sym (syntax-object->datum start)) + (list-of-terms (syntax-case term-defs (tokens) @@ -224,6 +225,7 @@ type))) (syntax->list (syntax (type ...)))) (cdr (syntax-object->datum prec-decls)))))) + (#f null) (_ (raise-syntax-error 'parser-precedences diff --git a/collects/parser-tools/private-yacc/parser-builder.ss b/collects/parser-tools/private-yacc/parser-builder.ss index 4092ebc..e0ff87f 100644 --- a/collects/parser-tools/private-yacc/parser-builder.ss +++ b/collects/parser-tools/private-yacc/parser-builder.ss @@ -43,14 +43,58 @@ (parser-code `(letrec ((err ,error-expr) - (term-sym->index ,token-code) + (err-state 0) (table ,table-code) + (term-sym->index ,token-code) (actions ,actions-code) (reduce-stack (lambda (s n v) (if (> n 0) - (reduce-stack (cdr (cdr s)) (sub1 n) (cons (cadr s) v)) - (values s v))))) + (reduce-stack (cddr s) (sub1 n) (cons (cadr s) v)) + (values s v)))) + (fix-error + (lambda (stack ip get-token) + (let remove-states () + (let ((a (find-action stack 'error))) + (cond + ((shift? a) + (printf "shift:~a~n" (shift-state a)) + (set! stack (cons (shift-state a) (cons #f stack)))) + (else + (printf "discard-state:~a~n" (car stack)) + (cond + ((< (length stack) 3) + (printf "Unable to shift error token~n") + #f) + (else + (set! stack (cddr stack)) + (remove-states))))))) + (let remove-input () + (let ((a (find-action stack ip))) + (cond + ((shift? a) + (printf "shift:~a~n" (shift-state a)) + (cons (shift-state a) + (cons (if (token? ip) + (token-value ip) + #f) + stack))) + (else + (printf "discard-input:~a~n" (if (token? ip) + (token-name ip) + ip)) + (set! ip (get-token)) + (remove-input))))))) + + (find-action + (lambda (stack tok) + (array2d-ref table + (car stack) + (hash-table-get term-sym->index + (if (token? tok) + (token-name tok) + tok) + err))))) (lambda (get-token) (let loop ((stack (list 0)) (ip (get-token))) @@ -58,13 +102,7 @@ (newline) (display (if (token? ip) (token-name ip) ip)) (newline) - (let* ((s (car stack)) - (a (hash-table-get term-sym->index - (if (token? ip) - (token-name ip) - ip) - err)) - (action (array2d-ref table s a))) + (let ((action (find-action stack ip))) (cond ((shift? action) (printf "shift:~a~n" (shift-state action)) @@ -89,8 +127,14 @@ new-stack)) ip)))) ((accept? action) - (printf "accept~n")) - (else (err))))))))) + (printf "accept~n") + (cadr stack)) + (else + (err) + (let ((new-stack (fix-error stack ip get-token))) + (if new-stack + (loop new-stack (get-token)) + (void))))))))))) (datum->syntax-object runtime parser-code diff --git a/collects/parser-tools/yacc.ss b/collects/parser-tools/yacc.ss index 3fac187..262fd0a 100644 --- a/collects/parser-tools/yacc.ss +++ b/collects/parser-tools/yacc.ss @@ -79,8 +79,10 @@ (syntax->list (syntax (args ...)))) (if (not tokens) (raise-syntax-error #f "missing tokens declaration" stx)) - (if (not grammar) + (if (not error) (raise-syntax-error #f "missing error declaration" stx)) + (if (not grammar) + (raise-syntax-error #f "missing grammar declaration" stx)) (if (not end) (raise-syntax-error #f "missing end declaration" stx)) (build-parser (if debug debug "")