This hopefully works.

diku-dk · Mar 27, 2024 · 272203b · 272203b
1 parent 58a7362
commit 272203b
Show file tree

Hide file tree

Showing 7 changed files with 106 additions and 91 deletions.
diff --git a/futhark/lexer.fut b/futhark/lexer.fut
@@ -14,7 +14,7 @@ module type lexer_context = {
   val state_size : i64
   val is_ignore : terminal_module.t -> bool
   val is_accepting : [state_size]bool
-  val is_producing : [endomorphism_size]bool
+  val is_producing : [256][state_size]bool
   val transitions_to_endomorphisms : [256]endomorphism_module.t
   val compositions : [endomorphism_size][endomorphism_size]endomorphism_module.t
   val states_to_terminals : [state_size]terminal_module.t
@@ -35,8 +35,8 @@ module mk_lexer(L: lexer_context) = {
   def is_accept (a : state) : bool =
     L.is_accepting[L.state_module.to_i64 a]
 
-  def is_producing (a : endomorphism) : bool =
-    L.is_producing[L.endomorphism_module.to_i64 a]
+  def is_producing (a : state) (c : u8) : bool =
+    L.is_producing[u8.to_i64 c, L.state_module.to_i64 a]
 
   def trans_to_endo (c : u8) : endomorphism =
     copy L.transitions_to_endomorphisms[u8.to_i64 c]
@@ -49,14 +49,21 @@ module mk_lexer(L: lexer_context) = {
     let s' = L.state_module.to_i64 s
     in copy L.states_to_terminals[s']
 
-  def traverse [n] (str : [n]u8) : [n](bool, state) =
-    map trans_to_endo str
-    |> scan compose L.identity_endomorphism
-    |> map (\e -> (is_producing e, endo_to_state e))
+  def traverse [n] (str : [n]u8) : *[n](bool, state) =
+    let states =
+      map trans_to_endo str
+      |> scan compose L.identity_endomorphism
+      |> map endo_to_state
+    let produces = map2 is_producing (rotate 1 states) str
+    in zip produces states
 
   def lex [n'] (str : [n']u8) : opt ([](terminal, (i32, i32))) =
     let n = i32.i64 n'
-    let ends_states = if n == 0 then [] else traverse str
+    let ends_states =
+      if n == 0
+      then []
+      else let temp = traverse str
+           in temp with [n' - 1] = (true, copy temp[n' - 1].1)
     let is = filter (\i -> ends_states[i].0) (0i32..<n)
     let is_valid =
       if n == 0 then false else last ends_states |> (.1) |> is_accept
@@ -79,6 +86,10 @@ module mk_lexer(L: lexer_context) = {
     let substr = str[i64.i32 offset:i64.i32 (i32.min n (offset + size))]
     let m = length substr |> i32.i64
     let ends_states = if m == 0 then [] else traverse substr
+    let ends_states =
+      if m < size
+      then ends_states with [m - 1] = (true, copy ends_states[m - 1].1)
+      else ends_states
     let is = filter (\i -> ends_states[i].0) (0i32..<m)
     let new_size = length is
     let lexed' =

diff --git a/haskell-tests/LL.hs b/haskell-tests/LL.hs
@@ -6,15 +6,12 @@ import Alpacc.Grammar
 import Alpacc.LL
 import Alpacc.LLP hiding ( LlpContext(..) )
 import Test.HUnit
-import Debug.Trace (traceShow)
 import Text.ParserCombinators.ReadP (string)
 import Data.String.Interpolate (i)
 import Data.Sequence (Seq (..), (<|), (><), (|>))
 import qualified Data.Sequence as Seq hiding (Seq (..), (<|), (><), (|>))
 import Data.Maybe
 
-debug x = traceShow x x
-
 grammar =
   Grammar
     { start = "T",

diff --git a/haskell-tests/LLP.hs b/haskell-tests/LLP.hs
@@ -10,11 +10,8 @@ import Alpacc.LLP
 import Alpacc.LL
 import Test.HUnit
 import Data.String.Interpolate (i)
-import Debug.Trace (traceShow)
 import Data.Either
 
-debug x = traceShow x x
-
 grammar :: Grammar String String
 grammar =
   Grammar

diff --git a/src/Alpacc/CFG.hs b/src/Alpacc/CFG.hs
@@ -28,7 +28,6 @@ import Data.Word (Word8)
 import Data.List.NonEmpty (NonEmpty)
 import Data.List.NonEmpty qualified as NonEmpty hiding (NonEmpty)
 import Data.String.Interpolate (i)
-import Alpacc.Debug
 
 -- | Terminal formation rule.
 data TRule = TRule

diff --git a/src/Alpacc/Generator/Futhark/Lexer.hs b/src/Alpacc/Generator/Futhark/Lexer.hs
@@ -50,15 +50,24 @@ isAcceptingArray parallel_lexer =
 
 isProducingArray :: ParallelLexer Word8 Int -> String
 isProducingArray parallel_lexer =
-  ([i|def is_producing : [endomorphism_size]bool = sized endomorphism_size |]++)
-  $ (++"]")
+  ("def is_producing : [256][state_size]bool = "++)
+  $ (++"] :> [256][state_size]bool")
   $ ("["++)
-  $ List.intercalate ", "
-  $ [if j `Set.member` token_endos then "true" else "false" | j <- [0..endo_size - 1]]
+  $ List.intercalate ",\n"
+  $ map row [0..255]
   where
-    endo_size = endomorphismsSize parallel_lexer
-    token_endos = tokenEndomorphism parallel_lexer
-
+    token_set = tokenEndomorphism parallel_lexer
+    state_size = stateSize parallel_lexer
+    lookup' c s =
+      if (s, c) `Set.member` token_set
+      then "true"
+      else "false"
+    row j =
+      (++"]")
+      $ ("["++)
+      $ List.intercalate ", "
+      $ map (lookup' j) [0..state_size - 1]
+
 endomorphismsToStateArray ::
   ParallelLexer Word8 Int ->
   Either String String

diff --git a/src/Alpacc/Lexer/DFA.hs b/src/Alpacc/Lexer/DFA.hs
@@ -27,7 +27,6 @@ import Data.Text (Text)
 import Data.Text qualified as Text
 import Data.Foldable
 import Data.Either.Extra
-import Alpacc.Debug (debug)
 import Data.Maybe (mapMaybe)
 
 type DFA t s = FSA Identity Identity t s
@@ -330,8 +329,7 @@ parallelLexerDFA ::
   Map k (RegEx (NonEmpty t)) ->
   Either String (ParallelDFALexer t s k)
 parallelLexerDFA terminal_to_order start_state regex_map =
-  debug
-  $ toParallelDFALexer
+  toParallelDFALexer
   $ lexerDFA terminal_to_order start_state regex_map
 
 lexerDFA ::

diff --git a/src/Alpacc/Lexer/ParallelLexing.hs b/src/Alpacc/Lexer/ParallelLexing.hs
@@ -18,7 +18,6 @@ import Data.Array qualified as Array hiding (Array)
 import Data.Bifunctor (Bifunctor (..))
 import Data.Tuple (swap)
 import Data.Tuple.Extra (both)
-import Alpacc.Debug (debug)
 
 type State = Int
 type Endo = Int
@@ -28,7 +27,7 @@ data ParallelLexer t k =
   ParallelLexer
   { compositions :: Map (Endo, Endo) Endo
   , endomorphisms :: Map t Endo
-  , tokenEndomorphism :: Set Endo 
+  , tokenEndomorphism :: Set (State, t) 
   , endomorphismsToStates :: Map Endo State
   , tokenMap :: Map State k
   , identity :: Endo
@@ -44,16 +43,10 @@ compose a b =
   where
     auxiliary i = (i, b Array.! (a Array.! i))
 
-composeTrans ::
-  (Endomorphism, t) ->
-  (Endomorphism, t) ->
-  (Endomorphism, t)
-composeTrans (a, _) (b, t) = (a `compose` b, t)
-
 endomorphismTable ::
   (Enum t, Bounded t, IsTransition t, Ord k) =>
   ParallelDFALexer t State k ->
-  Map t (Endomorphism, t)
+  Map t Endomorphism
 endomorphismTable lexer =
   Map.fromList
   $ map statesFromChar [minBound..maxBound]
@@ -73,7 +66,6 @@ endomorphismTable lexer =
       $ Map.lookup key _transitions
     statesFromChar t =
       (t,)
-      $ (,t)
       $ toArray
       $ map (tableLookUp . (, t))
       $ Set.toAscList _states
@@ -116,7 +108,7 @@ invertMap mapping =
 initConnected ::
   (Enum t, Bounded t, IsTransition t, Ord k) =>
   ParallelDFALexer t State k ->
-  Map (Endomorphism, t) (Set (Endomorphism, t))
+  Map Endomorphism (Set Endomorphism)
 initConnected lexer =
   Map.unionWith Set.union temp
   $ Map.unionsWith Set.union
@@ -142,76 +134,76 @@ initConnected lexer =
     toEndo t = Map.lookup t endomorphism_table    
 
 newEndoConn ::
-  (IsTransition t) =>
-  Map (Endomorphism, t) (Set (Endomorphism, t)) ->
-  (Endomorphism, t) ->
-  Set (Endomorphism, t) ->
-  Map (Endomorphism, t) (Set (Endomorphism, t))
+  Map Endomorphism (Set Endomorphism) ->
+  Endomorphism ->
+  Set Endomorphism ->
+  Map Endomorphism (Set Endomorphism)
 newEndoConn conn_endos endo endo_set =
   Map.unionsWith Set.union
   $ Set.map toMap endo_set
   where
     toConn = (conn_endos Map.!)
-    toMap endo' = Map.singleton comp (toConn endo')
+    toMap endo' =
+      Map.unionWith Set.union new_map
+      $ Map.singleton comp (toConn endo')
       where
-        comp = endo `composeTrans` endo'
+        comp = endo `compose` endo'
+        set = Set.singleton comp
+        new_map =
+          Map.unions
+          $ fmap (`Map.singleton` set)
+          $ Map.keys
+          $ Map.filter (endo `Set.member`) conn_endos
 
 newEndoConns ::
-  (IsTransition t) =>
-  Map (Endomorphism, t) (Set (Endomorphism, t)) ->
-  Map (Endomorphism, t) (Set (Endomorphism, t))
+  Map Endomorphism (Set Endomorphism) ->
+  Map Endomorphism (Set Endomorphism)
 newEndoConns conn_endos =
   Map.unionWith Set.union conn_endos
   $ Map.unionsWith Set.union
   $ Map.mapWithKey (newEndoConn conn_endos) conn_endos
 
 connected ::
-  (IsTransition t) =>
-  Map (Endomorphism, t) (Set (Endomorphism, t)) ->
-  Map (Endomorphism, t) (Set (Endomorphism, t))
+  Map Endomorphism (Set Endomorphism) ->
+  Map Endomorphism (Set Endomorphism)
 connected = fixedPointIterate (/=) newEndoConns
 
 compositionsTable ::
-  IsTransition t =>
-  Map (Endomorphism, t) (Set (Endomorphism, t)) ->
-  Map ((Endomorphism, t), (Endomorphism, t)) (Endomorphism, t)
+  Map Endomorphism (Set Endomorphism) ->
+  Map (Endomorphism, Endomorphism) Endomorphism
 compositionsTable _connected =
   Map.fromList
   $ concat
   $ Map.mapWithKey auxiliary _connected
   where
-    toMap e e' = ((e, e'), e `composeTrans` e')
+    toMap e e' = ((e, e'), e `compose` e')
     auxiliary e = Set.toList . Set.map (toMap e)
 
 endomorphismSet ::
-  IsTransition t =>
-  Map (Endomorphism, t) (Set (Endomorphism, t)) ->
-  Set (Endomorphism, t)
+  Map Endomorphism (Set Endomorphism) ->
+  Set Endomorphism
 endomorphismSet _connected =
-  debug
-  $ Set.union (Map.keysSet _connected)
+  Set.union (Map.keysSet _connected)
   $ Set.unions _connected
 
 enumerateEndomorphisms ::
-  IsTransition t =>
-  Map (Endomorphism, t) (Set (Endomorphism, t)) ->
-  Map (Endomorphism, t) Endo
+  Map Endomorphism (Set Endomorphism) ->
+  Map Endomorphism Endo
 enumerateEndomorphisms =
   Map.fromList
   . flip zip [0..]
   . Set.toList
   . endomorphismSet
 
-toStateMap :: State -> Map (Endomorphism, t) Endo -> Map Endo State
+toStateMap :: State -> Map Endomorphism Endo -> Map Endo State
 toStateMap initial_state =
   Map.fromList
-  . fmap (swap . first ((Array.! initial_state) . fst))
+  . fmap (swap . first (Array.! initial_state))
   . Map.toList
 
 endoCompositions ::
-  IsTransition t =>
-  ((Endomorphism, t) -> Endo) ->
-  Map ((Endomorphism, t), (Endomorphism, t)) (Endomorphism, t) ->
+  (Endomorphism -> Endo) ->
+  Map (Endomorphism, Endomorphism) Endomorphism ->
   Map (Endo, Endo) Endo
 endoCompositions toEndo comps =
   Map.mapKeys (both toEndo)
@@ -257,24 +249,32 @@ addDead dead_endo table =
       $ Set.insert dead_endo
       $ endosInTable table
 
-producesTokenEndo :: 
+deadEndomorphism ::
+  (IsTransition t, Enum t, Bounded t, Ord k) =>
+  ParallelDFALexer t State k ->
+  Endomorphism
+deadEndomorphism lexer =
+  Array.array (first_state, last_state)
+  $ (,dead_state) <$> [first_state..last_state]
+  where
+    _states = states $ fsa $ parDFALexer lexer
+    first_state = minimum _states
+    last_state = maximum _states
+    dead_state = deadState lexer
+
+identityEndomorphism ::
   (IsTransition t, Enum t, Bounded t, Ord k) =>
   ParallelDFALexer t State k ->
-  Map (Endomorphism, t) (Set (Endomorphism, t)) ->
-  Set (Endomorphism, t)
-producesTokenEndo lexer connected_set =
-  Set.filter (
-    \(e, t) ->
-      let s = e Array.! _initial
-      in (s, t) `Set.member` produces
-  ) set
+  Endomorphism
+identityEndomorphism lexer =
+  Array.array (first_state, last_state)
+  $ zip [first_state..last_state] [first_state..last_state]
   where
-    produces = producesToken lexer
-    _initial = initial $ fsa $ parDFALexer lexer
-    set =
-      Set.union (Map.keysSet connected_set)
-      $ Set.unions connected_set
-
+    _states = states $ fsa $ parDFALexer lexer
+    first_state = minimum _states
+    last_state = maximum _states
+
+
 parallelLexer ::
   (IsTransition t, Enum t, Bounded t, Ord k) =>
   ParallelDFALexer t State k ->
@@ -289,17 +289,23 @@ parallelLexer lexer =
   , stateSize = state_size
   , endomorphismsSize = endo_size
   , acceptingStates = accept_states
-  , tokenEndomorphism = produces_token
+  , tokenEndomorphism = producesToken lexer
   }
   where
     accept_states = accepting $ fsa $ parDFALexer lexer
-    endo_size = 2 + Map.size to_endo
+    endo_size = Map.size to_endo
     state_size = Set.size $ states $ fsa $ parDFALexer lexer
     _connected = connected $ initConnected lexer
-    to_endo = enumerateEndomorphisms _connected
-    _identity = succ $ maximum to_endo
-    _dead = succ $ succ $ maximum to_endo
-    toEndo = (to_endo Map.!)
+    to_endo' = enumerateEndomorphisms _connected
+    to_endo =
+      Map.insert (deadEndomorphism lexer) _dead
+      $ Map.insert (identityEndomorphism lexer) _identity to_endo'
+    _identity = succ $ maximum to_endo'
+    _dead = succ $ succ $ maximum to_endo'
+    toEndo x =
+      case Map.lookup x to_endo of
+           Nothing -> error (show x)
+           Just a -> a
     _compositions =
       addDead _dead
       $ addIdentity _identity
@@ -312,13 +318,11 @@ parallelLexer lexer =
       $ map (,_dead) [minBound..maxBound]
     _transitions_to_endo =
       flip Map.union _dead_transitions
-      $ Map.mapKeys snd to_endo
+      $ toEndo
+      <$> endomorphismTable lexer
     initial_state = initial $ fsa $ parDFALexer lexer
     dead_state = deadState lexer
     to_state =
       Map.insert _dead dead_state
       $ Map.insert _identity initial_state
       $ toStateMap initial_state to_endo
-    produces_token =
-      Set.map toEndo
-      $ producesTokenEndo lexer _connected