DFA.hs

{- LANGUAGE  TupleSections -}
import Control.Monad
import qualified Data.Set as S

--type State  = String
type Symbol = Char
data DFA st = DFA { states   :: [st],
                    alphabet :: [Symbol],
                    delta    :: st -> Symbol -> st,
                    startSt  :: st
                    endSts   :: [st]              }


runDFA :: DFA st -> [Symbol] -> Either st st
runDFA dfa xs =
  let endSt = foldr (flip (delta dfa)) (startSt dfa) xs
  in if endSt `elem` (endSts dfa) then Right endSt else Left endSt

-- Closure under union
-- Parametrise state type so we can make fresh names for each state
unionDFA :: DFA st1 -> DFA st2 -> DFA (st1, st2)
unionDFA dfa1 dfa2 =
  let states'  = [(x,y) | x <- (states dfa1), y <- (states dfa2)]
      endSts'  = nub ([(x,y) | x <- (endSts dfa1), y <- (states dfa2)] ++
                      [(x,y) | x <- (states dfa1), y <- (endSts dfa2)])
      startSt'  = (startSt dfa1, startSt dfa2)
      delta' (s1,s2) c = (delta dfa1 s1 c, delta dfa2 s2 c)
  in DFA states' (alphabet dfa1) delta' startSt' endSts'


-- TODO: Make the transition function Total by lifting it into the Either monad.
sampleDFA :: DFA
sampleDFA = let states = ["A", "B"]
                symbs  = ['1','0']
                start  = "A"
                end    = ["A"]
                delta = \c s -> case (c,s) of
                           ("A",'1') -> "B"
                           ("A",'0') -> "A"
                           ("B",'1') -> "A"
                           ("B",'0') -> "B"
            in DFA states symbs delta start end

-- Infinite DFA prompt, type a string and hit enter.
-- to run: load into ghci and run main
-- > :l DFA.hs
-- > main
main :: IO ()
main = forever $ getLine >>= print . (runDFA sampleDFA)