*** empty log message ***

original commit: f5d64303412eabad88212c75c028fa7ea8b8f1f4

collects/parser-tools/lex.ss

@@ -96,8 +96,23 @@
 				       name-lst)))
              (let-values (((trans start action-names no-look disappeared-uses)
                            (build-lexer re-actname-lst)))
-               (when (vector-ref action-names start)
+               (when (vector-ref action-names start) ;; Start state is final
-                 (printf "Warning: lexer might accept the empty string ~a.~n" stx))
+                 (unless (and 
+                          ;; All the successor states are final
+                          (andmap (lambda (x) (vector-ref action-names (vector-ref x 2)))
+                                      (vector->list (vector-ref trans start)))
+                          ;; Each character has a successor state
+                          (let loop ((check 0)
+                                     (nexts (vector->list (vector-ref trans start))))
+                            (cond
+                              ((null? nexts) #f)
+                              (else
+                               (let ((next (car nexts)))
+                                 (and (= (vector-ref next 0) check)
+                                      (let ((next-check (vector-ref next 1)))
+                                        (or (>= next-check max-char-num)
+                                            (loop (add1 next-check) (cdr nexts))))))))))
+                   (printf "Warning: lexer at ~a can accept the empty string.~n" stx)))
                (with-syntax ((start-state-stx start)
                              (trans-table-stx trans)
                              (no-lookahead-stx no-look)

collects/parser-tools/private-lex/front.ss

@@ -18,7 +18,7 @@
   
   ;; A table is either
   ;; - (vector-of (union #f nat))
-  ;; - (vector-of (vector-of (cons (cons nat nat) nat)))
+  ;; - (vector-of (vector-of (vector nat nat nat)))
   
   (define loc:integer-set-contents is:integer-set-contents)
   

collects/parser-tools/private-lex/re.ss

@@ -11,8 +11,6 @@
            orR-res andR-res negR-re
            re-nullable? re-index)
   
-  (define max-char-num #x10FFFF)
-  
   ;; get-index : -> nat
   (define get-index (make-counter))
 

collects/parser-tools/private-lex/util.ss

@@ -2,6 +2,8 @@
   (require (lib "list.ss"))
   
   (provide (all-defined))
+
+  (define max-char-num #x10FFFF)
   
   (define-struct lex-abbrev (abbrev))
   (define-struct lex-trans (f))