Last active
November 8, 2016 16:53
-
-
Save fero23/f094edcab6c4ebbc3b362ef142cf37ad to your computer and use it in GitHub Desktop.
Pushdown automaton computation in Haskell
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| data PushdownAutomaton a b = | |
| Automaton { currentState :: Int | |
| , stack :: [b] | |
| , transitions :: [((Int, Maybe a, Maybe b), [(Int, Maybe b)])] | |
| , acceptStates :: [Int] | |
| } | |
| checkMaybe m h = if m == Nothing then True else m == Just h | |
| eval :: (Eq a, Show a, Eq b) => PushdownAutomaton a b -> [a] -> Bool | |
| eval (Automaton state stack transitions acceptStates) [] = | |
| any (\s -> elem s acceptStates) $ traverseEmptyStringTransitions [state] | |
| where | |
| traverseEmptyStringTransitions states = | |
| let states' = foldl (\acc s -> | |
| (acc ++) . concatMap (\(_, n) -> | |
| filter (\nextState -> not $ elem nextState (acc ++ states)) | |
| $ map (\(nextState, _) -> nextState) n | |
| ) $ filter (\((state', input, sHead), _) -> | |
| state' == s && input == Nothing | |
| && (if null stack then True else checkMaybe sHead $ head stack) | |
| ) transitions | |
| ) [] states | |
| in if null states' then states else traverseEmptyStringTransitions $ states ++ states' | |
| eval (Automaton state stkxs transitions acceptStates) (input:inputxs) = | |
| let next = concatMap (\((_, input', sHead'), next) -> | |
| map (\(nextState, nextHead) -> | |
| let input'' = if input' == Nothing then input:inputxs else inputxs | |
| stack = if null stkxs then | |
| case nextHead of | |
| Just nextHead -> nextHead:stkxs | |
| Nothing -> stkxs | |
| else case (sHead', nextHead) of | |
| (Just _, Just nextHead) -> nextHead : tail stkxs | |
| (Nothing, Just nextHead) -> nextHead : stkxs | |
| (Just _, Nothing) -> tail stkxs | |
| (Nothing, Nothing) -> stkxs | |
| in | |
| eval (Automaton nextState stack transitions acceptStates) input'' | |
| ) next | |
| ) | |
| $ filter | |
| (\((state', input', sHead'), _) -> | |
| state == state' && checkMaybe input' input | |
| && (if null stkxs then True else checkMaybe sHead' (head stkxs))) | |
| transitions | |
| in | |
| elem True next | |
| testPushdownMachine = | |
| eval | |
| (Automaton 1 [] | |
| [ ((1, Nothing, Nothing), [(2, Just "$")]) | |
| , ((2, Just 0, Nothing), [(2, Just "0")]) | |
| , ((2, Just 1, Just "0"), [(3, Nothing)]) | |
| , ((3, Just 1, Just "0"), [(3, Nothing)]) | |
| , ((3, Nothing, Just "$"), [(4, Nothing)]) | |
| ] | |
| [1, 4]) [0, 0, 0, 1, 1, 1] | |
| {- | |
| *Main> testPushdownMachine | |
| True | |
| -} |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment