*** empty log message ***

original commit: 16b637ba4c781337340da85ba9d34909ca59bbc6
tokens
Scott Owens 20 years ago
parent d380cff70b
commit 0a3b775e6d

@ -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?)

@ -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))))
)

Loading…
Cancel
Save