I have broken something and I need to get an overview.

alpacc.cabal

@@ -72,6 +72,7 @@ library
     Alpacc.Lexer.DFA
     Alpacc.Lexer.FSA
     Alpacc.Lexer.ParallelLexing
+    Alpacc.Lexer.DFAParallelLexer
     Alpacc.Lexer.Encode
 
   hs-source-dirs:     src

src/Alpacc/CFG.hs

@@ -104,7 +104,7 @@ cfgToDFALexer cfg@(CFG {tRules}) = do
   let x = find (producesEpsilon . snd) t_rule_tuples
   case x of
     Just (t, _) -> Left [i|Error: #{t} may not produce empty strings.|]
-    Nothing -> parallelLexerDFA order_map (0 :: Int) terminal_map
+    Nothing -> Right $ parallelLexerDFA order_map (0 :: Int) terminal_map
 
 type Parser = Parsec Void Text
 

src/Alpacc/Generator/Futhark/Lexer.hs

@@ -4,13 +4,14 @@ module Alpacc.Generator.Futhark.Lexer
 
 import Alpacc.Grammar
 import Alpacc.Lexer.DFA
+import Alpacc.Lexer.ParallelLexing
 import Alpacc.Lexer.Encode
+import Alpacc.Lexer.DFAParallelLexer
 import Data.Map (Map)
 import Data.Map qualified as Map
 import Data.String.Interpolate (i)
 import Data.FileEmbed
 import Data.Word (Word8)
-import Alpacc.Lexer.ParallelLexing
 import Data.List qualified as List
 import Data.Either.Extra
 import Alpacc.Types
@@ -64,7 +65,7 @@ generateLexer ::
   IInt ->
   Either String String
 generateLexer lexer terminal_index_map terminal_type = do
-  int_parallel_lexer <- intParallelLexer new_token_map lexer
+  int_parallel_lexer <- intDfaParallelLexer new_token_map lexer
   let ParallelLexerMasks
         { tokenMask = token_mask
         , tokenOffset = token_offset

src/Alpacc/Lexer/DFA.hs

@@ -6,7 +6,7 @@ module Alpacc.Lexer.DFA
   , DFALexer
   , fromRegExToDFA
   , transitions'
-  , ParallelDFALexer (parDFALexer, producesToken, deadState)
+  , ParallelDFALexer (parDFALexer, producesToken)
   , parallelLexerDFA
   , enumerateParLexer
   )
@@ -27,7 +27,6 @@ import Data.Set qualified as Set hiding (Set)
 import Data.Text (Text)
 import Data.Text qualified as Text
 import Data.Foldable
-import Data.Either.Extra
 import Data.Maybe (mapMaybe)
 
 type DFA t s = FSA Identity Identity t s
@@ -36,7 +35,6 @@ type DFALexer t s k = Lexer Identity Identity t s k
 data ParallelDFALexer t s k = ParallelDFALexer
     { parDFALexer :: DFALexer t s k
     , producesToken :: Set (s, t)
-    , deadState :: s
     } deriving (Eq, Ord, Show)
 
 transitions' :: (Ord s, Ord t) => DFA t s -> Map (s, t) s
@@ -231,7 +229,6 @@ enumerateParLexer s lexer =
   ParallelDFALexer
   { parDFALexer = fsaLexerSecond toPrime $ parDFALexer lexer
   , producesToken = Set.map (first toPrime) $ producesToken lexer
-  , deadState = toPrime $ deadState lexer
   }
   where
     toPrime = (mapping Map.!)
@@ -316,34 +313,27 @@ tokenProducingTransitions dfa = new_transitions
 toParallelDFALexer ::
   (Enum s, Ord s, Ord t) =>
   DFALexer t s k ->
-  Either String (ParallelDFALexer t s k)
-toParallelDFALexer lexer = do
-  dead_state <-
-    maybeToEither "Error: Can not add a dead state to an empty DFA."
-    maybe_dead_state
-  return $
-    ParallelDFALexer
-    { parDFALexer = new_lexer
-    , producesToken = produces_token
-    , deadState = dead_state
-    }
+  ParallelDFALexer t s k
+toParallelDFALexer lexer =
+  ParallelDFALexer
+  { parDFALexer = new_lexer
+  , producesToken = produces_token
+  }
   where
     dfa = fsa lexer
     token_producing_trans = tokenProducingTransitions dfa
     _transitions = transitions' dfa
     produces_token = Map.keysSet token_producing_trans
     new_trans = Map.union _transitions token_producing_trans
-    (new_dfa, maybe_dead_state) =
-      mkDFATotal
-      $ dfa { transitions = addIdentity new_trans }
+    new_dfa = dfa { transitions = addIdentity new_trans }
     new_lexer = lexer { fsa = new_dfa }
 
 parallelLexerDFA ::
   (Show k, Ord t, Ord s, Enum s, Ord k, Ord o) =>
   Map k o ->
   s ->
   Map k (RegEx (NonEmpty t)) ->
-  Either String (ParallelDFALexer t s k)
+  ParallelDFALexer t s k
 parallelLexerDFA terminal_to_order start_state regex_map =
   toParallelDFALexer
   $ lexerDFA terminal_to_order start_state regex_map
@@ -358,7 +348,7 @@ lexerDFA terminal_to_order start_state regex_map =
   reenumerateLexer start_state $
     Lexer
     { fsa = dfa
-    , terminalMap = dfa_terminal_map
+    , tokenMap = dfa_token_map
     }
   where
     auxiliary =
@@ -383,7 +373,7 @@ lexerDFA terminal_to_order start_state regex_map =
 
     minimumSet = minimumBy (on compare (terminal_to_order Map.!))
 
-    dfa_terminal_map =
+    dfa_token_map =
       fmap minimumSet
       . Map.unionsWith Set.union
       . concat

src/Alpacc/Lexer/DFAParallelLexer.hs

@@ -0,0 +1,100 @@
+module Alpacc.Lexer.DFAParallelLexer
+  (dfaParallelLexer
+  ,intDfaParallelLexer)
+where
+
+import Alpacc.Lexer.FSA
+import Alpacc.Lexer.DFA
+import Alpacc.Lexer.Encode
+import Alpacc.Lexer.ParallelLexing
+import Data.Map.Strict (Map)
+import Data.Map.Strict qualified as Map hiding (Map)
+import Data.Set qualified as Set hiding (Set)
+import Data.Maybe
+import Data.Array.Base (IArray (..))
+import Data.Array.Unboxed (UArray)
+import Data.Array.Unboxed qualified as UArray hiding (UArray)
+
+errorMessage :: String
+errorMessage = "Error: Happend during Parallel Lexing genration, contact a maintainer."
+
+data Endomorphism =
+  Endomorphism
+  {-# UNPACK #-} !(UArray S S)
+  {-# UNPACK #-} !(UArray S Bool) deriving (Eq, Ord, Show)
+
+type S = Int
+
+deadState :: S
+deadState = 0
+
+initState :: S
+initState = 1
+
+endomorphismTable ::
+  (Enum t, Bounded t, Ord t, Ord k) =>
+  ParallelDFALexer t S k ->
+  Map t Endomorphism
+endomorphismTable lexer =
+  Map.fromList
+  $ map statesFromChar
+  $ Set.toList _alphabet
+  where
+    dfa = fsa $ parDFALexer lexer
+    produces_set = producesToken lexer
+    _transitions = transitions' dfa
+    _states = states dfa
+    _alphabet = alphabet dfa
+    first_index = deadState
+    last_index = maximum _states
+    tableLookUp key =
+      fromMaybe deadState
+      $ Map.lookup key _transitions
+    statesFromChar t = (t, Endomorphism ss bs)
+      where
+        ss =
+          UArray.array (first_index, last_index)
+          $ zip [first_index..last_index]
+          $ map (tableLookUp . (, t))
+          $ Set.toAscList _states
+        bs =
+          UArray.array (first_index, last_index)
+          $ zip [first_index..last_index]
+          $ map ((`Set.member` produces_set) . (, t))
+          $ Set.toAscList _states
+
+instance Semigroup Endomorphism where
+  (Endomorphism a a') <> (Endomorphism b b') = Endomorphism c c'
+    where
+      c = UArray.array (0, numElements a - 1)
+        $ map auxiliary [0..(numElements a - 1)]
+      c' = UArray.array (0, numElements a' - 1)
+        $ map auxiliary' [0..(numElements a' - 1)]
+      auxiliary i = (i, b UArray.! (a UArray.! i))
+      auxiliary' i = (i, b' UArray.! (a UArray.! i))
+
+instance Sim Endomorphism S where
+  toState s endo =
+    if a <= s && s <= b then
+      (producing UArray.! s, endo' UArray.! s)
+    else
+      error errorMessage
+    where
+      (Endomorphism endo' producing) = endo
+      (a, b) = bounds endo'
+
+dfaParallelLexer ::
+  (Ord t, Ord s, Enum t, Bounded t, Ord k) =>
+  ParallelDFALexer t s k ->
+  ParallelLexer t (EndoData k)
+dfaParallelLexer lexer' = parallelLexer lexer endo_table 
+  where
+    lexer = enumerateParLexer initState lexer'
+    endo_table = endomorphismTable lexer
+
+intDfaParallelLexer ::
+  (Ord t, Ord s, Enum t, Bounded t, Ord k) =>
+  Map (Maybe k) Int ->
+  ParallelDFALexer t s k ->
+  Either String (IntParallelLexer t)
+intDfaParallelLexer m = intParallelLexer m . dfaParallelLexer

src/Alpacc/Lexer/Encode.hs

@@ -6,7 +6,6 @@ module Alpacc.Lexer.Encode
   )
 where
 
-import Alpacc.Lexer.DFA
 import Alpacc.Types
 import Alpacc.Lexer.ParallelLexing
 import Data.Map.Strict (Map)
@@ -144,12 +143,11 @@ data IntParallelLexer t =
 
 
 intParallelLexer ::
-  (Enum t, Bounded t, Ord t, Ord s, Ord k) =>
+  (Ord t, Ord k) =>
   Map (Maybe k) Int ->
-  ParallelDFALexer t s k ->
+  ParallelLexer t (EndoData k) ->
   Either String (IntParallelLexer t)
-intParallelLexer to_int lexer = do
-  let parallel_lexer = parallelLexer lexer
+intParallelLexer to_int parallel_lexer = do
   ms <- lexerMasks parallel_lexer
   let encode = encodeEndoData ms to_int
   let new_compositions = fmap encode <$> compositions parallel_lexer

src/Alpacc/Lexer/FSA.hs

@@ -32,7 +32,7 @@ data FSA f f' t s = FSA
 
 data Lexer f f' t s k = Lexer
   { fsa :: FSA f f' t s,
-    terminalMap :: Map s k
+    tokenMap :: Map s k
   }
   deriving (Ord, Eq, Show)
 
@@ -81,10 +81,10 @@ instance LexerMap Lexer where
   fsaLexerMap g f fsa_lexer =
     fsa_lexer
       { fsa = fsaMap g f $ fsa fsa_lexer,
-        terminalMap = Map.mapKeys f terminal_map
+        tokenMap = Map.mapKeys f token_map
       }
     where
-      terminal_map = terminalMap fsa_lexer
+      token_map = tokenMap fsa_lexer
 
 reenumerateFSA ::
   (FSAMappable FSA f f' t s', FSAMappable FSA f f' t s, Enum s) =>

src/Alpacc/Lexer/NFA.hs

@@ -113,7 +113,6 @@ mkNFA regex = do
   let accept_list = toList s'
   mapM_ (\_s -> mkNFA' s _s regex) accept_list
 
-
 fromRegExToNFA :: (Ord s, Ord t, Enum s) => s -> RegEx (NonEmpty t) -> NFA t s
 fromRegExToNFA start_state regex = execState (mkNFA regex) init_nfa
   where