Gonna try rewrite this again, hopefully it will be faster.

alpacc.cabal

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

shell.nix

@@ -1,6 +1,5 @@
 let
   pkgs = import <nixpkgs> { config.allowUnfree = true; };
-  unstable = import <nixos-unstable> { };
   compilerVersion = "ghc96"; 
   compiler = pkgs.haskell.packages."${compilerVersion}";
 in
@@ -31,10 +30,8 @@ let pkg =
                 ocl-icd
                 rustc
                 cargo
-              ]) ++
-            (with unstable;
-              [ futhark
                 mkjson
+                futhark
               ]));
       };
 in pkg.overrideAttrs (attrs: {

src/Alpacc/Generator/Futhark/Lexer.hs

@@ -1,11 +1,10 @@
-{-# LANGUAGE TemplateHaskell #-}
-
 module Alpacc.Generator.Futhark.Lexer
   ( generateLexer )
  where
 
 import Alpacc.Grammar
 import Alpacc.Lexer.DFA
+import Alpacc.Lexer.Encode
 import Data.Map (Map)
 import Data.Map qualified as Map
 import Data.String.Interpolate (i)
@@ -65,16 +64,6 @@ compositionsArray int parallel_lexer = do
       let result = List.intercalate ", " vals
       return result
 
-endomorphismIntegral ::
-  IntParallelLexer t ->
-  Either String UInt
-endomorphismIntegral =
-  maybeToEither "Error: There are too many endomorphisms to create a Lexer."
-  . toIntType
-  . fromIntegral
-  . pred
-  . endoSize
-
 ignoreFunction :: Map T Int -> String
 ignoreFunction terminal_index_map = 
   case T "ignore" `Map.lookup` terminal_index_map of
@@ -87,15 +76,18 @@ generateLexer ::
   IInt ->
   Either String String
 generateLexer lexer terminal_index_map terminal_type = do
-  int_parallel_lexer <-
-    intParallelLexer new_token_map lexer
-  let (token_mask, token_offset) = tokenMask int_parallel_lexer
-  let (endo_mask, endo_offset) = endoMask int_parallel_lexer
-  let (accept_mask, accept_offset) = acceptMask int_parallel_lexer
-  let (produce_mask, produce_offset) = produceMask int_parallel_lexer
+  int_parallel_lexer <- intParallelLexer new_token_map lexer
+  let ParallelLexerMasks
+        { tokenMask = token_mask
+        , tokenOffset = token_offset
+        , indexMask = index_mask
+        , indexOffset = index_offset
+        , producingMask = produce_mask
+        , producingOffset = produce_offset
+        } = parMasks int_parallel_lexer
   let parallel_lexer = parLexer int_parallel_lexer
   let _identity = identity parallel_lexer
-  endomorphism_type <- endomorphismIntegral int_parallel_lexer
+  endomorphism_type <- extEndoType parallel_lexer
   transitions_to_endo <- transitionsToEndomorphismsArray parallel_lexer
   compositions_table <- compositionsArray endomorphism_type parallel_lexer
   Right $
@@ -110,12 +102,10 @@ module lexer = mk_lexer {
 
   def identity_endomorphism: endomorphism = #{_identity}
   def dead_terminal: terminal = #{dead_token}
-  def endo_mask: endomorphism = #{endo_mask}
-  def endo_offset: endomorphism = #{endo_offset}
+  def endo_mask: endomorphism = #{index_mask}
+  def endo_offset: endomorphism = #{index_offset}
   def terminal_mask: endomorphism = #{token_mask}
   def terminal_offset: endomorphism = #{token_offset}
-  def accept_mask: endomorphism = #{accept_mask}
-  def accept_offset: endomorphism = #{accept_offset}
   def produce_mask: endomorphism = #{produce_mask}
   def produce_offset: endomorphism = #{produce_offset}
 

src/Alpacc/Lexer/DFA.hs

@@ -8,6 +8,7 @@ module Alpacc.Lexer.DFA
   , transitions'
   , ParallelDFALexer (parDFALexer, producesToken, deadState)
   , parallelLexerDFA
+  , enumerateParLexer
   )
 where
 
@@ -38,13 +39,13 @@ data ParallelDFALexer t s k = ParallelDFALexer
     , deadState :: s
     } deriving (Eq, Ord, Show)
 
-transitions' :: (IsState s, IsTransition t) => DFA t s -> Map (s, t) s
+transitions' :: (Ord s, Ord t) => DFA t s -> Map (s, t) s
 transitions' = Map.mapKeys (second runIdentity) . fmap runIdentity . transitions
 
-addIdentity :: (IsState s, IsTransition t) => Map (s, t) s -> Map (s, Identity t) (Identity s)
+addIdentity :: (Ord s, Ord t) => Map (s, t) s -> Map (s, Identity t) (Identity s)
 addIdentity = Map.mapKeys (second Identity) . fmap Identity
 
-stateTransitions :: (IsState s, IsTransition t) => Transition t -> s -> State (NFA t s) (Set s)
+stateTransitions :: (Ord s, Ord t) => Transition t -> s -> State (NFA t s) (Set s)
 stateTransitions c s = do
   nfa <- get
   let trans = transitions nfa
@@ -53,13 +54,13 @@ stateTransitions c s = do
   where
     isSymbolTransition (s', c') = s == s' && c == c'
 
-epsilonTransitions :: (IsState s, IsTransition t) => s -> State (NFA t s) (Set s)
+epsilonTransitions :: (Ord s, Ord t) => s -> State (NFA t s) (Set s)
 epsilonTransitions = stateTransitions Eps
 
-statesTransitions :: (IsState s, IsTransition t) => Set s -> Transition t -> State (NFA t s) (Set s)
+statesTransitions :: (Ord s, Ord t) => Set s -> Transition t -> State (NFA t s) (Set s)
 statesTransitions set c = Set.unions <$> mapM (stateTransitions c) (toList set)
 
-epsilonClosure :: (IsState s, IsTransition t) => Set s -> State (NFA t s) (Set s)
+epsilonClosure :: (Ord s, Ord t) => Set s -> State (NFA t s) (Set s)
 epsilonClosure set = do
   new_set <- Set.unions <$> mapM epsilonTransitions (toList set)
   let set' = new_set `Set.union` set
@@ -68,7 +69,7 @@ epsilonClosure set = do
     else epsilonClosure set'
 
 mkDFATransitionEntry ::
-  (IsState s, IsTransition t) =>
+  (Ord s, Ord t) =>
   Set s ->
   t ->
   State (NFA t s) (Map (Set s, t) (Set s))
@@ -78,7 +79,7 @@ mkDFATransitionEntry set t = do
   return $ Map.singleton (set, t) eps_states
 
 mkDFATransitionEntries ::
-  (IsState s, IsTransition t) =>
+  (Ord s, Ord t) =>
   Set s ->
   State (NFA t s) (Map (Set s, t) (Set s))
 mkDFATransitionEntries set = do
@@ -87,7 +88,7 @@ mkDFATransitionEntries set = do
   return $ Map.unionsWith Set.union new_table_entry
 
 mkDFATransitions ::
-  (IsState s, IsTransition t) =>
+  (Ord s, Ord t) =>
   Set (Set s) ->
   Map (Set s, t) (Set s) ->
   [Set s] ->
@@ -116,7 +117,7 @@ dfaFilter p dfa =
         then initial dfa
         else error "Can not filter states since the initial state is removed."
 
-fromNFAtoDFAState :: (IsState s, IsTransition t) => State (NFA t s) (DFA t (Set s))
+fromNFAtoDFAState :: (Ord s, Ord t) => State (NFA t s) (DFA t (Set s))
 fromNFAtoDFAState = do
   nfa <- get
   new_initial <- epsilonClosure . Set.singleton $ initial nfa
@@ -147,13 +148,13 @@ fromNFAtoDFAState = do
   where
     newStates new_states' set = Set.filter (any (`Set.member` set)) new_states'
 
-fromNFAtoDFA :: (IsState s, IsTransition t) => NFA t s -> DFA t (Set s)
+fromNFAtoDFA :: (Ord s, Ord t) => NFA t s -> DFA t (Set s)
 fromNFAtoDFA = evalState fromNFAtoDFAState
 
-fromRegExToDFA :: (IsState s, IsTransition t, Enum s) => s -> RegEx (NonEmpty t) -> DFA t (Set s)
+fromRegExToDFA :: (Ord s, Ord t, Enum s) => s -> RegEx (NonEmpty t) -> DFA t (Set s)
 fromRegExToDFA s = fromNFAtoDFA . fromRegExToNFA s
 
-isMatch :: (IsState s) => DFA Char s -> Text -> Bool
+isMatch :: (Ord s) => DFA Char s -> Text -> Bool
 isMatch dfa = runDFA' start_state
   where
     start_state = initial dfa
@@ -180,7 +181,7 @@ invertSetMap mapping = Map.fromList $ setMap <$> codomain
           filter ((s `Set.member`) . (mapping Map.!)) domain
 
 -- | http://www.cs.um.edu.mt/gordon.pace/Research/Software/Relic/Transformations/FSA/remove-useless.html
-removeUselessStates :: (IsState s, IsTransition t) => DFA t s -> DFA t s
+removeUselessStates :: (Ord s, Ord t) => DFA t s -> DFA t s
 removeUselessStates dfa = dfaFilter (`Set.member` useful_states) dfa
   where
     initial_useful = accepting dfa
@@ -197,7 +198,7 @@ removeUselessStates dfa = dfaFilter (`Set.member` useful_states) dfa
     useful_states = fixedPointIterate (/=) usefulStates initial_useful
 
 -- | http://www.cs.um.edu.mt/gordon.pace/Research/Software/Relic/Transformations/FSA/to-total.html
-mkDFATotal :: (IsState s, IsTransition t, Enum s) => DFA t s -> (DFA t s, Maybe s)
+mkDFATotal :: (Ord s, Ord t, Enum s) => DFA t s -> (DFA t s, Maybe s)
 mkDFATotal dfa'
   | null $ states dfa' = (dfa', Nothing)
   | otherwise = (new_dfa, Just dead_state)
@@ -221,8 +222,23 @@ mkDFATotal dfa'
         (`Map.notMember` _transitions)
         ((s,) <$> toList _alphabet)
 
+enumerateParLexer ::
+  (Ord t, Ord s, Ord s', Enum s') =>
+  s' ->
+  ParallelDFALexer t s k ->
+  ParallelDFALexer t s' k
+enumerateParLexer s lexer =
+  ParallelDFALexer
+  { parDFALexer = fsaLexerSecond toPrime $ parDFALexer lexer
+  , producesToken = Set.map (first toPrime) $ producesToken lexer
+  , deadState = toPrime $ deadState lexer
+  }
+  where
+    toPrime = (mapping Map.!)
+    mapping = Map.fromList $ flip zip [s..] $ Set.toList $ states $ fsa $ parDFALexer lexer
+
 -- | http://www.cs.um.edu.mt/gordon.pace/Research/Software/Relic/Transformations/FSA/minimise.html
-minimize :: (IsState s, IsTransition t, Enum s) => DFA t s -> DFA t (Set s)
+minimize :: (Ord s, Ord t, Enum s) => DFA t s -> DFA t (Set s)
 minimize dfa' = removeUselessStates new_dfa
   where
     new_dfa = fsaSecond (state_map Map.!) dfa
@@ -264,15 +280,15 @@ minimize dfa' = removeUselessStates new_dfa
     newMatrix matrix = Map.mapWithKey (\k _ -> newMatrixValue matrix k) matrix
     newMatrixValue matrix st@(s, s') = matrix Map.! st || isDistinguishable matrix s s'
 
-dfaToNFA :: (IsState s, IsTransition t) => DFA t s -> NFA t s
+dfaToNFA :: (Ord s, Ord t) => DFA t s -> NFA t s
 dfaToNFA dfa = dfa { transitions = new_transitions }
   where
     new_transitions =
       Map.mapKeys (second Trans)
       $ Set.singleton <$> transitions' dfa
 
 tokenProducingTransitions ::
-  (IsState s, IsTransition t) =>
+  (Ord s, Ord t) =>
   DFA t s ->
   Map (s, t) s
 tokenProducingTransitions dfa = new_transitions
@@ -298,7 +314,7 @@ tokenProducingTransitions dfa = new_transitions
           return ((q, t), q') 
 
 toParallelDFALexer ::
-  (Enum s, IsState s, IsTransition t) =>
+  (Enum s, Ord s, Ord t) =>
   DFALexer t s k ->
   Either String (ParallelDFALexer t s k)
 toParallelDFALexer lexer = do
@@ -323,7 +339,7 @@ toParallelDFALexer lexer = do
     new_lexer = lexer { fsa = new_dfa }
 
 parallelLexerDFA ::
-  (Show k, IsTransition t, IsState s, Enum s, Ord k, Ord o) =>
+  (Show k, Ord t, Ord s, Enum s, Ord k, Ord o) =>
   Map k o ->
   s ->
   Map k (RegEx (NonEmpty t)) ->
@@ -333,7 +349,7 @@ parallelLexerDFA terminal_to_order start_state regex_map =
   $ lexerDFA terminal_to_order start_state regex_map
 
 lexerDFA ::
-  (Show k, IsTransition t, IsState s, Enum s, Ord k, Ord o) =>
+  (Show k, Ord t, Ord s, Enum s, Ord k, Ord o) =>
   Map k o ->
   s ->
   Map k (RegEx (NonEmpty t)) ->