Last active
August 29, 2015 14:20
-
-
Save cryptica/e788cfe6cdf29b090813 to your computer and use it in GitHub Desktop.
Haskell program defining tree automata, trees and an eval function
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
import qualified Data.Map as M | |
type State = String | |
type Symbol = (String, Int) | |
data TreeAutomaton = TreeAutomaton | |
{ symbols :: [Symbol] | |
, states :: [State] | |
, finalStates :: [State] | |
, delta :: M.Map (Symbol, [State]) State | |
} deriving Show | |
data Tree = Tree (Symbol, [Tree]) deriving Show | |
evalTree :: TreeAutomaton -> Tree -> State | |
evalTree a (Tree (sym@(_, n), children)) = | |
if n /= length children then error "Symbol arity of " ++ show sym ++ | |
" does not match number of children" | |
else | |
let childStates = map (evalTree a) children | |
in case M.lookup (sym, childStates) (delta a) of | |
Just x -> x | |
Nothing -> error ("No applicable rule for " ++ show sym) | |
trueSymb = ("True", 0) | |
falseSymb = ("False", 0) | |
andSymb = ("And", 2) | |
orSymb = ("Or", 2) | |
notSymb = ("Not", 1) | |
mySymbols = [trueSymb, falseSymb, andSymb, orSymb, notSymb] | |
trueState = "t" | |
falseState = "f" | |
myAutomaton = TreeAutomaton | |
{ symbols = mySymbols | |
, states = [trueState, falseState] | |
, finalStates = [trueState] | |
, delta = M.fromList | |
[ ((trueSymb, []), trueState) | |
, ((falseSymb, []), falseState) | |
, ((andSymb, [trueState, trueState]), trueState) | |
, ((andSymb, [trueState, falseState]), falseState) | |
, ((andSymb, [falseState, trueState]), falseState) | |
, ((andSymb, [falseState, falseState]), falseState) | |
, ((orSymb, [trueState, trueState]), trueState) | |
, ((orSymb, [trueState, falseState]), trueState) | |
, ((orSymb, [falseState, trueState]), trueState) | |
, ((orSymb, [falseState, falseState]), falseState) | |
, ((notSymb, [falseState]), trueState) | |
, ((notSymb, [trueState]), falseState) | |
] | |
} | |
myTree = Tree (andSymb, | |
[ Tree (notSymb, | |
[ Tree (falseSymb, []) ]) | |
, Tree (orSymb, | |
[ Tree (falseSymb, []) | |
, Tree (trueSymb, []) ]) | |
]) | |
main :: IO () | |
main = do | |
putStrLn "myTree:" | |
print myTree | |
putStrLn "myAutomaton:" | |
print myAutomaton | |
putStrLn "eval result:" | |
print (evalTree myAutomaton myTree) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment