taggedTree.hs

{-# language DeriveFunctor #-}
import Data.Functor.Fixedpoint

data E r =
  Block [r] |
  Define String (DefExpr r)
    deriving (Functor, Show)
data DefExpr r =
  Function [String] r
    deriving (Functor, Show)

data T' tag =
    T' (tag, E (T' tag))
    deriving (Functor, Show)

bottomUp' f tast@(T' (tag, expr))
    = f tag $ bottomUp' f <$> expr

ts' = T' (1,
    Block [
        T' (2, Block []),
        T' (3, Define "myfunc" $ Function ["arg1"] $
            T' (4,
            Block [
                T' (5, Block [])
            ]))
    ])

f' tag expr = T' (show tag, expr)

tt' = bottomUp' f' ts'

data T_ tag r =
    T_ (tag, E r)
    deriving (Functor, Show)
type T t = Fix (T_ t)
t_ t = Fix (T_ t)

bottomUp = cata :: (T_ t (T s) -> T s) -> T t -> T s

ts = t_ (1,
    Block [
        t_ (2, Block []),
        t_ (3, Define "myfunc" $ Function ["arg1"] $
            t_ (4,
            Block [
                t_ (5, Block [])
            ]))
    ])
f (T_(t, expr)) = Fix $ T_ (show t, expr)
tt = cata f ts