*** empty log message ***

original commit: 38301a75406f2f13453ccfc0a2e3b6d6314ed822

collects/parser-tools/private-yacc/input-file-parser.ss

@@ -384,18 +384,18 @@
 		       start-sym)
 	       start))
                  
-          (printf "nullable: {~a}~n~n"
+;;           (printf "nullable: {~a}~n~n"
-                  (apply string-append
+;;                   (apply string-append
-                         (let loop ((i 0))
+;;                          (let loop ((i 0))
-                           (cond
+;;                            (cond
-                             ((>= i (vector-length nulls)) null)
+;;                              ((>= i (vector-length nulls)) null)
-                             ((vector-ref nulls i)
+;;                              ((vector-ref nulls i)
-                              (cons
+;;                               (cons
-                               (format "~a " 
+;;                                (format "~a " 
-                                       (gram-sym-symbol
+;;                                        (gram-sym-symbol
-                                        (list-ref (cons start (cons end-non-term non-terms)) i)))
+;;                                         (list-ref (cons start (cons end-non-term non-terms)) i)))
-                               (loop (add1 i))))
+;;                                (loop (add1 i))))
-                             (else (loop (add1 i)))))))
+;;                              (else (loop (add1 i)))))))
           (make-grammar
            (list->vector prods)
            (apply append prods)

collects/parser-tools/private-yacc/lalr.ss

@@ -117,8 +117,6 @@
   (define (compute-LA a g)
     (let-values (((includes lookback) (compute-includes-and-lookback a g)))
       (let ((follow (compute-follow a g includes)))
-        (print-lookback lookback a g)
-        (print-follow follow a g)
 	(lambda (k p)
 	  (let* ((l (lookback k p))
 		 (f (map follow l)))

collects/parser-tools/private-yacc/lr0.ss

@@ -8,7 +8,8 @@
 	   (lib "list.ss"))
   
   (provide union build-lr0-automaton run-automaton (struct trans-key (st gs))
-	   lr0-transitions lr0-states kernel-items kernel-index for-each-state)
+	   lr0-transitions lr0-states lr0-epsilon-trans
+	   kernel-items kernel-index for-each-state)
 
   (define (union comp<?)
     (letrec ((union
@@ -29,23 +30,21 @@
   ;; kernel = (make-kernel (LR1-item list) index)
   ;;   the list must be kept sorted according to item<? so that equal? can
   ;;   be used to compare kernels
-  ;; LR0-automaton = (make-lr0 (trans-key kernel hash-table) (kernel vector))
+  ;; LR0-automaton = (make-lr0 (trans-key kernel hash-table) (kernel vector) (kernel item hashtable))
   ;; trans-key = (make-trans-key kernel gram-sym)
   (define-struct kernel (items index) (make-inspector))
   (define-struct trans-key (st gs) (make-inspector))
-  (define-struct lr0 (transitions states) (make-inspector))
+  (define-struct lr0 (transitions states epsilon-trans) (make-inspector))
 
-  ;; A macro to allow easy iteration over the states in an automaton
+  ;; Iteration over the states in an automaton
-  (define-syntax for-each-state
+  (define (for-each-state f a)
-    (syntax-rules ()
+    (let* ((states (lr0-states a))
-      ((_ function automaton)
-       (let* ((states (lr0-states automaton))
 	   (num-states (vector-length states)))
       (let loop ((i 0))
 	(if (< i num-states)
 	    (begin
-                 (function (vector-ref states i))
+	      (f (vector-ref states i))
-                 (loop (add1 i)))))))))
+	      (loop (add1 i)))))))
  
   ;; The kernels in the automaton are represented cannonically.
   ;; That is (equal? a b) <=> (eq? a b)
@@ -71,7 +70,7 @@
 	     (non-terms (list->vector (grammar-non-terms grammar)))
 	     (num-non-terms (vector-length non-terms))
 	     (num-gram-syms (+ num-non-terms (vector-length terms)))
-					 
+	     (epsilons (make-hash-table 'equal))
 	     
 	     ;; first-non-term: non-term -> non-term list
 	     ;; given a non-terminal symbol C, return those non-terminal 
@@ -136,6 +135,7 @@
 		      ;; maps each gram-syms to a list of items
 
 		      (table (make-vector num-gram-syms null))
+		      (epsilons (make-hash-table 'equal))
 
 		      ;; add-item!: 
 		      ;;   (item list) vector * item ->
@@ -144,7 +144,8 @@
 		      (add-item!
 		       (lambda (table i)
 			 (let ((gs (sym-at-dot i)))
-			   (if gs
+			   (cond
+			    (gs
 			     (let* ((add (if (term? gs)
 					     num-non-terms
 					     0))
@@ -155,7 +156,14 @@
 			       (if (not (member i already))
 				   (vector-set! table 
 						(+ add (gram-sym-index gs))
-						  (cons i already)))))))))
+						(cons i already)))))
+			    ((= 0 (vector-length (prod-rhs (item-prod i))))
+			     (let ((current (hash-table-get epsilons
+							    kernel
+							    (lambda () null))))
+			       (hash-table-put! epsilons
+						kernel
+						(cons i current)))))))))
 		  
 		  ;; Group the items of the LR0 closure of the kernel
 		  ;; by the character after the dot
@@ -231,7 +239,7 @@
 		 (seen-kernels null))
 	(cond
 	 ((and (empty-queue? new-kernels) (null? old-kernels))
-	  (make-lr0 automaton (list->vector (reverse! seen-kernels))))
+	  (make-lr0 automaton (list->vector (reverse! seen-kernels)) epsilons))
 	 ((null? old-kernels)
 	  (loop (deq! new-kernels) seen-kernels))
 	 (else 

collects/parser-tools/private-yacc/table.ss

@@ -204,13 +204,11 @@
   ;; buile-table: grammar * string -> action2d-array
   (define (build-table g file)
     (let* ((a (build-lr0-automaton g))
-	   (get-state (lr0-states a))
 	   (terms (grammar-terms g))
 	   (non-terms (grammar-non-terms g))
 	   (get-term (list->vector terms))
 	   (get-non-term (list->vector non-terms))
 	   (get-prod (list->vector (grammar-prods g)))
-	   (num-states (vector-length get-state))
 	   (num-terms (vector-length get-term))
 	   (num-non-terms (vector-length get-non-term))
            (end-term-indexes 
@@ -219,7 +217,7 @@
                (+ num-non-terms (gram-sym-index term)))
              (grammar-end-terms g)))
 	   (num-gram-syms (+ num-terms num-non-terms))
-	   (table (make-array2d num-states num-gram-syms #f))
+	   (table (make-array2d (vector-length (lr0-states a)) num-gram-syms #f))
 	   (array2d-add!
 	    (lambda (v i1 i2 a)
 	      (let ((old (array2d-ref v i1 i2)))
@@ -240,9 +238,7 @@
                                (vector-ref get-non-term i)
                                (vector-ref get-term (- i num-non-terms))))
                         (goto
-                         (run-automaton (vector-ref get-state (kernel-index state))
+                         (run-automaton state s a)))
-                                        s
-                                        a)))
                    (if goto
                        (array2d-set! table 
                                      (kernel-index state) 
@@ -256,6 +252,7 @@
                                         (make-shift 
                                          (kernel-index goto)))))))
                  (loop (add1 i)))))
+
          (for-each
           (lambda (item)
             (for-each 
@@ -269,12 +266,12 @@
                                  (item-prod-index item)
                                  (gram-sym-index (prod-lhs (item-prod item)))
                                  (vector-length (prod-rhs (item-prod item))))))))
-             (get-lookahead (vector-ref get-state (kernel-index state))
+             (get-lookahead state (item-prod item))))
-                            (item-prod item))))
+	  
+          (append (hash-table-get (lr0-epsilon-trans a) state (lambda () null))
 		  (filter (lambda (item)
 			    (not (move-dot-right item)))
-                  (kernel-items
+			  (kernel-items state)))))
-                   (vector-ref get-state (kernel-index state))))))
        a)
       (resolve-prec-conflicts a table get-term get-prod num-terms
                               num-non-terms)
@@ -294,3 +291,4 @@
       table))
 )
 
+