*** empty log message ***

original commit: 16b637ba4c781337340da85ba9d34909ca59bbc6

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

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
-          (cond
+           ((< (prec-num shift-prec) (prec-num reduce-prec))
-            ((< (prec-num shift-prec) (prec-num reduce-prec))
+            (list reduce))
-             reduce)
+           ((> (prec-num shift-prec) (prec-num reduce-prec))
-            ((> (prec-num shift-prec) (prec-num reduce-prec))
+            (list shift))
-             shift)
+           ((eq? 'left (prec-assoc shift-prec))
-            ((eq? 'left (prec-assoc shift-prec))
+            (list reduce))
-             reduce)
+           ((eq? 'right (prec-assoc shift-prec))
-            ((eq? 'right (prec-assoc shift-prec))
+            (list shift))
-             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))))
   
   )