diff --git a/collects/parser-tools/private-yacc/parser-actions.ss b/collects/parser-tools/private-yacc/parser-actions.ss index b05b901..b06a4e4 100644 --- a/collects/parser-tools/private-yacc/parser-actions.ss +++ b/collects/parser-tools/private-yacc/parser-actions.ss @@ -8,6 +8,7 @@ ;; - (make-reduce prod runtime-action) ;; - (make-accept) ;; - (make-goto int) + ;; - (no-action) ;; A reduce contains a runtime-reduce so that sharing of the reduces can ;; be easily transferred to sharing of runtime-reduces. @@ -16,6 +17,7 @@ (define-struct (reduce action) (prod runtime-reduce) (make-inspector)) (define-struct (accept action) () (make-inspector)) (define-struct (goto action) (state) (make-inspector)) + (define-struct (no-action action) () (make-inspector)) (define (make-reduce* p) (make-reduce p @@ -28,13 +30,15 @@ ;; (vector int symbol int) (reduce) ;; 'accept (accept) ;; negative-int (goto) - + ;; #f (no-action) + (define (action->runtime-action a) (cond ((shift? a) (shift-state a)) ((reduce? a) (reduce-runtime-reduce a)) ((accept? a) 'accept) - ((goto? a) (- (+ (goto-state a) 1))))) + ((goto? a) (- (+ (goto-state a) 1))) + ((no-action? a) #f))) (define (runtime-shift? x) (and (integer? x) (>= x 0))) (define runtime-reduce? vector?) diff --git a/collects/parser-tools/private-yacc/table.ss b/collects/parser-tools/private-yacc/table.ss index fa1aa76..dde2864 100644 --- a/collects/parser-tools/private-yacc/table.ss +++ b/collects/parser-tools/private-yacc/table.ss @@ -135,6 +135,7 @@ ;; resolve-conflict : (listof action?) -> action? bool bool (define (resolve-conflict actions) (cond + ((null? actions) (values (make-no-action) #f #f)) ((null? (cdr actions)) (values (car actions) #f #f)) (else @@ -195,16 +196,16 @@ (reduce-prec (prod-prec (reduce-prod reduce)))) (cond ((and shift-prec reduce-prec) - (list - (cond - ((< (prec-num shift-prec) (prec-num reduce-prec)) - reduce) - ((> (prec-num shift-prec) (prec-num reduce-prec)) - shift) - ((eq? 'left (prec-assoc shift-prec)) - reduce) - ((eq? 'right (prec-assoc shift-prec)) - shift)))) + (cond + ((< (prec-num shift-prec) (prec-num reduce-prec)) + (list reduce)) + ((> (prec-num shift-prec) (prec-num reduce-prec)) + (list shift)) + ((eq? 'left (prec-assoc shift-prec)) + (list reduce)) + ((eq? 'right (prec-assoc shift-prec)) + (list shift)) + (else null))) (else actions)))) @@ -280,7 +281,6 @@ (call-with-output-file file (lambda (port) (display-parser a grouped-table (send g get-prods) port))))) - (resolve-conflicts grouped-table suppress)))) )