From 6bf09b30d2ad1abaf00a3700b8684c648afaa7be Mon Sep 17 00:00:00 2001
From: Scott Owens <sowens@cs.utah.edu>
Date: Thu, 20 Jan 2005 21:50:45 +0000
Subject: [PATCH] *** empty log message ***

original commit: f5d64303412eabad88212c75c028fa7ea8b8f1f4
---
 collects/parser-tools/lex.ss               | 19 +++++++++++++++++--
 collects/parser-tools/private-lex/front.ss |  2 +-
 collects/parser-tools/private-lex/re.ss    |  2 --
 collects/parser-tools/private-lex/util.ss  |  2 ++
 4 files changed, 20 insertions(+), 5 deletions(-)

diff --git a/collects/parser-tools/lex.ss b/collects/parser-tools/lex.ss
index 32a3b46..6e89783 100644
--- a/collects/parser-tools/lex.ss
+++ b/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)
-                 (printf "Warning: lexer might accept the empty string ~a.~n" stx))
+               (when (vector-ref action-names start) ;; Start state is final
+                 (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)
diff --git a/collects/parser-tools/private-lex/front.ss b/collects/parser-tools/private-lex/front.ss
index 1b2903d..4029e92 100644
--- a/collects/parser-tools/private-lex/front.ss
+++ b/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)
   
diff --git a/collects/parser-tools/private-lex/re.ss b/collects/parser-tools/private-lex/re.ss
index 3e1eea0..2da8e3d 100644
--- a/collects/parser-tools/private-lex/re.ss
+++ b/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))
 
diff --git a/collects/parser-tools/private-lex/util.ss b/collects/parser-tools/private-lex/util.ss
index 0448ca3..739f436 100644
--- a/collects/parser-tools/private-lex/util.ss
+++ b/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))