Skip to content

Instantly share code, notes, and snippets.

@cryptica
Last active August 29, 2015 14:20
Show Gist options
  • Save cryptica/e788cfe6cdf29b090813 to your computer and use it in GitHub Desktop.
Save cryptica/e788cfe6cdf29b090813 to your computer and use it in GitHub Desktop.
Haskell program defining tree automata, trees and an eval function
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