a binary tree automaton

Bush.hs

data Bush n l b = Bsh (l -> b) (n -> Bush n l (Bush n l b))

-- polymorphic recursion
mapb :: (b -> c) -> Bush n l b -> Bush n l c
mapb f (Bsh g k) = Bsh (f . g) (\a -> mapb (mapb f) (k a))

data BT n l = L l | Sp (BT n l) n (BT n l)

lamBT :: (BT n l -> b) -> Bush n l b
lamBT f = Bsh (f . L) (\a -> lamBT (\t -> lamBT (\u -> f (Sp t a u))))

appBT :: Bush n l b -> BT n l -> b
appBT (Bsh f _) (L l)      = f l
appBT (Bsh _ k) (Sp l a r) = appBT (appBT (k a) l) r

-- eval

data Op = Plus | Mul

eval :: Bush Op Int Int
eval = Bsh id go
  where
  go :: Op -> Bush Op Int (Bush Op Int Int)
  go Plus = mapb (\a -> mapb (\b -> a + b) eval) eval
  go Mul  = mapb (\a -> mapb (\b -> a * b) eval) eval

prnt :: Bush Op Int String
prnt = Bsh show go
  where
  go :: Op -> Bush Op Int (Bush Op Int String)
  go Plus = mapb (\a -> mapb (\b -> "(" ++ a ++ "+" ++ b ++ ")") prnt) prnt
  go Mul  = mapb (\a -> mapb (\b -> "(" ++ a ++ "*" ++ b ++ ")") prnt) prnt

test :: BT Op Int
test = Sp (Sp (L 3) Plus (L 8)) Mul (L 5)

main :: IO ()
main = do print $ appBT eval test
          print $ appBT prnt test