Adapt nfaToDfa and dfaToNfa to new types

Also, the files updated so far compile with --pedantic now :)

src/Rextra/Automaton.hs

@@ -1,17 +1,19 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+
 module Rextra.Automaton
   ( dfaToNfa
   , nfaToDfa
   ) where
 
-import           Control.Monad.Trans.State
-import           Data.List
 import qualified Data.Map.Strict as Map
 import           Data.Maybe
 import qualified Data.Set as Set
 import           Data.Tuple
 
 import qualified Rextra.Dfa as Dfa
+import           Rextra.Fa
 import qualified Rextra.Nfa as Nfa
+import           Rextra.Util
 
 {-
  - Converting a DFA to a NFA
@@ -19,65 +21,68 @@ import qualified Rextra.Nfa as Nfa
 
 dfaStateToNfaState :: (Ord s, Ord t) => Dfa.State s t -> Nfa.State s t
 dfaStateToNfaState s =
-  let transitionMap = Dfa.transitions s
+  let specialTokens = Map.keysSet $ Dfa.transitions s
-      specialTokens = Map.keysSet transitionMap
       defaultTransition = (Nfa.AllExcept specialTokens, Dfa.defaultTransition s)
-      otherTransitions = map (\(tSet, s) -> (Nfa.Only tSet, s))
+      otherTransitions = map (\(tokenSet, state) -> (Nfa.Only tokenSet, state))
-                       . map swap
+                       $ map swap
-                       . Map.assocs
+                       $ Map.assocs
-                       $ Dfa.transitionsByState transitionMap
+                       $ Dfa.transitionsByState s
   in  Nfa.State { Nfa.transitions        = defaultTransition : otherTransitions
                 , Nfa.epsilonTransitions = Set.empty
                 }
 
 dfaToNfa :: (Ord s, Ord t) => Dfa.Dfa s t -> Nfa.Nfa s t
-dfaToNfa dfa =
+dfaToNfa a =
-  let stateMap = Dfa.stateMap dfa
+  let nfaStateMap = Map.map dfaStateToNfaState $ stateMap a
-      exitStates = Dfa.exitStates dfa
-      nfaStateMap = Map.map dfaStateToNfaState stateMap
   -- The NFA was created from a valid DFA, so it will be valid too.
-  in  fromJust $ Nfa.nfa nfaStateMap (Dfa.entryState dfa) exitStates
+  in  fromJust $ fa nfaStateMap (entryState a) (exitStates a)
 
 {-
  - Converting a NFA to a DFA
  -}
 
-allSpecialTokens :: (Ord t) => [Nfa.State s t] -> Set.Set t
+specialTokensOf :: Nfa.TransitionCondition t -> Set.Set t
-allSpecialTokens = foldMap (foldMap (Nfa.specialTokens . fst) . Nfa.transitions)
+specialTokensOf (Nfa.Only      t) = t
+specialTokensOf (Nfa.AllExcept t) = t
 
-allNextStates :: (Ord s) => Dfa.State s t -> Set.Set s
+-- | @'allSpecialTokens' a ns@ returns all tokens that behave
-allNextStates s =
+-- different from the default when when in state @ns@ of the automaton
-  let nextStates = Map.elems $ Dfa.transitions s
+-- @a@ (the default being an implicitly defined token that is not
-  in  Set.fromList (Dfa.defaultTransition s : nextStates)
+-- mentioned in any of the automaton's state transitions).
+specialTokensAt :: (Ord s, Ord t) => Nfa.Nfa s t -> Nfa.NdState s -> Set.Set t
+specialTokensAt a ns =
+  let ndStates = Nfa.getNdState a $ Nfa.epsilonStep a ns
+  in  foldMap (foldMap (specialTokensOf . fst) . Nfa.transitions) ndStates
+
+possibleTransitionsFrom :: (Ord s, Ord t)
+                        => Nfa.Nfa s t -> Nfa.NdState s -> Map.Map t (Nfa.NdState s)
+possibleTransitionsFrom a ns = Map.fromSet (transition a ns) (specialTokensAt a ns)
 
 ndStateToDfaState :: (Ord s, Ord t) => Nfa.Nfa s t -> Nfa.NdState s -> Dfa.State (Nfa.NdState s) t
-ndStateToDfaState nfa ns =
+ndStateToDfaState a ns =
-  let specialTokens = allSpecialTokens . Nfa.getNdState nfa $ Nfa.epsilonStep nfa ns
+  Dfa.State { Dfa.transitions       = possibleTransitionsFrom a ns
-  in  Dfa.State { Dfa.transitions       = Map.fromSet (\t -> Nfa.transition nfa t ns) specialTokens
+            , Dfa.defaultTransition = Nfa.defaultTransition a ns
-                , Dfa.defaultTransition = Nfa.defaultTransition nfa ns
+            }
-                , Dfa.accepting         = Nfa.accepting nfa ns
-                }
 
-type Visited s = Set.Set (Nfa.NdState s)
+nextStatesFrom :: (Ord s, Ord t) => Nfa.Nfa s t -> Nfa.NdState s -> Set.Set (Nfa.NdState s)
+nextStatesFrom a ns =
+  let tokenTransitioned   = Map.elems $ possibleTransitionsFrom a ns
+      defaultTransitioned = Nfa.defaultTransition a ns
+  in  Set.fromList $ defaultTransitioned : tokenTransitioned
 
-exploreState :: (Ord s, Ord t)
+-- This whole forall business is just so I can tell the Execute
-             => Nfa.Nfa s t
+-- typeclass that I mean Nfa.NdState when I say startState a.
-             -> Nfa.NdState s
+connectedStates :: forall s t. (Ord s, Ord t) => Nfa.Nfa s t -> Set.Set (Nfa.NdState s)
-             -> State (Visited s) (Dfa.StateMap (Nfa.NdState s) t)
+connectedStates a =
-exploreState nfa ns = do
+  let start = Set.singleton (startState a :: Nfa.NdState s)
-  visitedStates <- get
+  in  connectedElements (nextStatesFrom a) start
-  if ns `Set.member` visitedStates
-    then pure Map.empty
-    else do
-      modify (Set.insert ns) -- Adding this state to the visited states
-      let dfaState    = ndStateToDfaState nfa ns
-          ownStateMap = Map.singleton ns dfaState
-          nextStates  = Set.toList $ allNextStates dfaState
-      otherStateMaps <- mapM (exploreState nfa) nextStates
-      pure $ Map.unions (ownStateMap : otherStateMaps)
 
-dfaStateMap :: (Ord s, Ord t) => Nfa.Nfa s t -> Dfa.StateMap (Nfa.NdState s) t
+dfaStateMap :: (Ord s, Ord t)
-dfaStateMap nfa = evalState (exploreState nfa (Nfa.entryNdState nfa)) Set.empty
+            => Nfa.Nfa s t -> Map.Map (Nfa.NdState s) (Dfa.State (Nfa.NdState s) t)
+dfaStateMap a = Map.fromSet (ndStateToDfaState a) $ connectedStates a
 
 nfaToDfa :: (Ord s, Ord t) => Nfa.Nfa s t -> Dfa.Dfa (Nfa.NdState s) t
-nfaToDfa nfa = fromJust $ Dfa.dfa (dfaStateMap nfa) (Nfa.entryNdState nfa)
+nfaToDfa a =
+  let theStateMap     = dfaStateMap a
+      acceptingStates = Set.filter (Nfa.isAccepting a) $ Map.keysSet theStateMap
+  in  fromJust $ fa theStateMap (startState a) acceptingStates

src/Rextra/Dfa.hs

@@ -9,7 +9,6 @@ module Rextra.Dfa
   , transitionsByState
   ) where
 
-import           Data.List
 import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
 import           Data.Tuple
@@ -48,6 +47,6 @@ dfaTransition a s t =
         Nothing          -> defaultTransition state
 
 dfa :: (Ord s, Ord t) => [(s, [(t, s)], s)] -> s -> [s] -> Maybe (Dfa s t)
-dfa states entryState exitStates =
+dfa stateInfo entryState exitStates =
-  let stateList = map (\(s, ts, dt) -> (s, State (Map.fromList ts) dt)) states
+  let stateList = map (\(s, ts, dt) -> (s, State (Map.fromList ts) dt)) stateInfo
   in  fa (Map.fromList stateList) entryState (Set.fromList exitStates)

src/Rextra/Nfa.hs

@@ -14,6 +14,7 @@ module Rextra.Nfa
   , holdsTrueForDefault
   -- * Executing
   , NdState
+  , isAccepting
   , getNdState
   , epsilonStep
   , defaultTransition
@@ -61,10 +62,17 @@ instance FaState State where
 type Nfa s t = Fa State s t
 type NdState s = Set.Set s
 
+-- Not the most brilliant of names, very similar to Executable's
+-- 'accepts'. But I'd rather repeat myself in this way than
+-- reimplement this predicate everywhere I need it (e. g. in
+-- 'nfaToDfa' in Automaton.hs).
+isAccepting :: (Ord s) => Nfa s t -> NdState s -> Bool
+isAccepting a ns = not $ ns `Set.disjoint` exitStates a
+
 instance (Ord s) => Executable (Fa State s) (Set.Set s) where
   startState = Set.singleton . entryState
   transition = nfaTransition
-  accepts a s = not $ s `Set.disjoint` exitStates a
+  accepts    = isAccepting
 
 only :: (Ord t) => [t] -> TransitionCondition t
 only = Only . Set.fromList
@@ -77,8 +85,8 @@ nfa :: (Ord s)
      -> s
      -> [s]
      -> Maybe (Nfa s t)
-nfa states entryState exitStates =
+nfa stateInfo entryState exitStates =
-  let stateList = map (\(s, ts, et) -> (s, State ts (Set.fromList et))) states
+  let stateList = map (\(s, ts, et) -> (s, State ts (Set.fromList et))) stateInfo
   in  fa (Map.fromList stateList) entryState (Set.fromList exitStates)
 
 -- Transitions
@@ -93,9 +101,9 @@ tokenStep :: (Ord s, Ord t) => Nfa s t -> t -> NdState s -> NdState s
 tokenStep a t ns = foldMap (nextStates t) $ getNdState a ns
   where
     nextStates :: (Ord s, Ord t) => t -> State s t -> Set.Set s
-    nextStates t state = Set.fromList
+    nextStates token state = Set.fromList
                        $ map snd
-                       $ filter (\(cond, _) -> cond `holdsTrueFor` t)
+                       $ filter (\(cond, _) -> cond `holdsTrueFor` token)
                        $ transitions state
 
 defaultStep :: (Ord s) => Nfa s t -> NdState s -> NdState s