From 70cc112710ead7f39d0740900b41f5c3190dddd9 Mon Sep 17 00:00:00 2001
From: Andreas Abel <andreas.abel@ifi.lmu.de>
Date: Wed, 22 Jan 2020 22:17:30 +0100
Subject: [PATCH] [ #71 ] Fixed crash in DFAMin

DFA minimization used to crash on tokens of the form c* which produce
automata with only accepting states.  Considering the empty set of
non-accepting states as an equivalence class caused minimization to
crash with exception

  Prelude.head: empty list

Now, DFA minimization succeeds.

There is still a problem with nullable tokens like c*.  Alex produces an
infinite token sequence at the end of the input.
---
 alex.cabal       |  1 +
 src/DFAMin.hs    |  5 ++++-
 tests/Makefile   |  1 +
 tests/issue_71.x | 49 ++++++++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 55 insertions(+), 1 deletion(-)
 create mode 100644 tests/issue_71.x

diff --git a/alex.cabal b/alex.cabal
index 6cfbd353..feee1bbb 100644
--- a/alex.cabal
+++ b/alex.cabal
@@ -108,6 +108,7 @@ extra-source-files:
         tests/posn_typeclass_bytestring.x
         tests/strict_typeclass.x
         tests/unicode.x
+        tests/issue_71.x
 
 source-repository head
     type:     git
diff --git a/src/DFAMin.hs b/src/DFAMin.hs
index 7e80f873..dc63ddd9 100644
--- a/src/DFAMin.hs
+++ b/src/DFAMin.hs
@@ -116,7 +116,10 @@ groupEquivStates DFA { dfa_states = statemap }
     accept_groups :: [EquivalenceClass]
     accept_groups = map IS.fromList (Map.elems accept_map)
 
-    init_p = nonaccepting_states : accept_groups
+    init_p, init_q :: [EquivalenceClass]
+    init_p  -- Issue #71: each EquivalenceClass needs to be a non-empty set
+      | IS.null nonaccepting_states = accept_groups
+      | otherwise                   = nonaccepting_states : accept_groups
     init_q = accept_groups
 
     -- map token T to
diff --git a/tests/Makefile b/tests/Makefile
index 51b4b224..71384495 100644
--- a/tests/Makefile
+++ b/tests/Makefile
@@ -28,6 +28,7 @@ TESTS = \
         basic_typeclass_bytestring.x \
         default_typeclass.x \
         gscan_typeclass.x \
+        issue_71.x \
         monad_typeclass.x \
         monad_typeclass_bytestring.x \
         monadUserState_typeclass.x \
diff --git a/tests/issue_71.x b/tests/issue_71.x
new file mode 100644
index 00000000..c36b3675
--- /dev/null
+++ b/tests/issue_71.x
@@ -0,0 +1,49 @@
+{
+-- Issue #71
+-- reported 2015-10-20 by Ian Duncan
+-- fixed 2020-01-22 by Andreas Abel
+--
+-- Problem was:
+-- DFA minimization crashed with "Prelude head: empty list" because
+-- empty set of non-accepting states was treated as empty equivalence
+-- class of states.
+
+module Main (main) where
+
+import System.Exit
+}
+
+%wrapper "posn"
+%token   "Token"
+
+$whitespace  = [\ \n\t]
+@whitespaces = $whitespace*
+
+:-
+
+@whitespaces { \ _ _ -> Whitespaces }
+"a"          { \ _ _ -> A           }
+
+{
+data Token = Whitespaces | A
+  deriving (Eq, Show)
+
+input           = "aa    \n\taa   \t  \n  a"
+expected_result = [A,A,Whitespaces,A,A,Whitespaces,A]
+
+main :: IO ()
+main
+    -- Since the whitespaces token is nullable, Alex
+    -- will recognize an infinite number of those
+    -- at the end of file.  This behavior is problematic,
+    -- but we don't fix it here.
+    -- We just test here whether the expected result
+    -- is a prefix of the produced result.
+  | take (length expected_result) result == expected_result = do
+      exitWith ExitSuccess
+  | otherwise = do
+      print $ take 20 result
+      exitFailure
+  where
+  result = alexScanTokens input
+}