3 -- Haskell implementation of a `same-fringe' solver.
9 -----------------------------------------------------------------------------
12 data Tree a = Leaf | Node (Tree a, a, Tree a) deriving (Show)
14 -- Return the elements inorder, as a list.
15 fringe t = gather t [] where
17 gather (Node (l, x, r)) ns = gather l (x : gather r ns)
19 -- Answer whether two trees have the same fringe.
20 sameFringe t tt = fringe t == fringe tt -- trivial!
22 -----------------------------------------------------------------------------
25 -- Turn Either String a into a monad expressing computatations which can fail
26 -- with a useful error message.
27 instance Monad (Either String) where
33 -- Parse a tree from the description in CS. The syntax is:
35 -- tree ::= empty | `(' tree char tree `)'
37 -- disambiguated by deciding that `(' starts a tree wherever a tree is
41 if cs == [] then return t else fail "trailing junk"
44 (left, cs) <- parse cs
48 (right, cs) <- parse cs
50 (')':cs) -> return (Node (left, c, right), cs)
52 parse cs = return (Leaf, cs)
54 -----------------------------------------------------------------------------
57 -- Report MSG as an error and quit.
60 hPutStrLn stderr (prog ++ ": " ++ msg)
67 [arg] -> case parseTree arg of
69 mapM_ putChar (fringe t)
72 [a, b] -> case (parseTree a, parseTree b) of
73 (Right t, Right tt) ->
74 if sameFringe t tt then
78 (Left err, _) -> bail err
79 (_, Left err) -> bail err
82 ----- That's all, folks -----------------------------------------------------