構文木にIdを振りたい。

構文木に情報を追加したいときにFix使うとちょっと楽だよっていう話。
例えば

data Term = Var String | Lam String Term | App Term Term

みたいなデータの各ノードにIdを振りたいとする。
ナイーブにやると

data ITerm = IVar Int String | ILam Int String ITerm | IApp Int ITerm ITerm

こんな感じになるだろうか。
コンストラクタの名前が変わって冗長だ。

これに対してFixを使うとこうなる。

newtype Fix f = In (f (Fix f))

data TermF a = Var String | Lam String a | App a a
newtype ITermF a = ITermF (Int, TermF a) 
newtype Term = Term (Fix TermF)
newtype ITerm = ITerm (Fix ITermF)

これなら他に型情報とかを追加したくなってもnewtypeで簡単に追加できる。
Idを振るサンプルは以下のとおり。

cata :: Functor f => (f a -> a) -> Fix f -> a
cata f (In t) = f (fmap (cata f) t)

incr :: State Int Int
incr = do
    i <- get
    put $! i + 1
    return i

assignId :: Term -> State Int ITerm
assignId (Term _t) = ITerm <$> cata f _t where
    f (Var s) = c $ pure $ Var s
    f (App t1 t2) = c $ App <$> t1 <*> t2
    f (Lam x t) = c $ Lam x <$> t
    c t = In . ITermF <$> ((,) <$> incr <*> t)

newtype同士のキャストがだいぶ煩雑になってしまうのが玉に瑕だ。

詳細なコードは以下のgistにある。
gist0b9f189fd5cf0550903e