Edit: Add an example of a function for ProgramF
s with generic annotations.
Yes, at least in the case of toANF
, you're using it wrong.
In toANF
, note that your Let bindingANF nbody
and the companion definitions of bindingANF
and nbody
are just a reimplementation of fmap toANF
for the specific constructor Let
.
That is, if you derive a Functor
instance for your ProgramF
, then you can re-write your toANF
snippet as:
toANF :: LabelProgram -> Program
toANF (Fix (Ann label l@(Let _ _))) = Fix (fmap toANF l)
If toANF
is just stripping labels, then this definition works for all constructors and not just Let
, so you can drop the pattern:
toANF :: LabelProgram -> Program
toANF (Fix (Ann label l)) = Fix (fmap toANF l)
and now, as per @Regis_Kuckaertz's comment, you've just re-implemented forget
which is defined as:
forget = Fix . fmap forget . unAnn . unFix
With respect to writing functions that work generically on Program
, LabelProgram
, etc., I think it makes more sense to write functions generic in a (single) annotation:
foo :: Attr ProgramF a -> Attr ProgramF a
and, if you really need to apply them to the unannotated program, define:
type ProgramU = Attr ProgramF ()
where the "U" in ProgramU
stands for "unit". Obviously, you can easily write translators to work with Program
s as ProgramU
s if really needed:
toU :: Functor f => Mu f -> Attr f ()
toU = synthetise (const ())
fromU :: Functor f => Attr f () -> Mu f
fromU = forget
mapU :: (Functor f) => (Attr f () -> Attr f ()) -> Mu f -> Mu f
mapU f = fromU . f . toU
foo' :: Mu ProgramF -> Mu ProgramF
foo' = mapU foo
As a concrete -- if stupid -- example, here's a function that separates Let
s with multiple bindings into nested Let
s with singleton bindings (and so breaks mutually recursive bindings in the Program
language). It assumes that the annotation on a multi-binding Let
will be copied to each of the resulting singleton Let
s:
splitBindings :: Attr ProgramF a -> Attr ProgramF a
splitBindings (Fix (Ann a (Let (x:y:xs) e)))
= Fix (Ann a (Let [x] (splitBindings (Fix (Ann a (Let (y:xs) e))))))
splitBindings (Fix e) = Fix (fmap splitBindings e)
It can be applied to an example Program
:
testprog :: Program
testprog = Fix $ Unary (Fix $ Let [(Identifier "x", Fix $ Number 1),
(Identifier "y", Fix $ Number 2)]
(Fix $ Unary (Fix $ Number 3) NegOp))
NegOp
like so:
> mapU splitBindings testprog
Fix (Unary (Fix (Let {bindings = [(Identifier "x",Fix (Number 1))],
body = Fix (Let {bindings = [(Identifier "y",Fix (Number 2))],
body = Fix (Unary (Fix (Number 3)) NegOp)})})) NegOp)
>
Here's my full working example:
{-# LANGUAGE DeriveFunctor #-}
{-# OPTIONS_GHC -Wall #-}
import Data.Generics.Fixplate
data Identifier = Identifier String deriving (Show)
data PLabel = PLabel deriving (Show)
data Operator = NegOp deriving (Show)
data ProgramF a
= Unary a
Operator
| Number Int
| Let { bindings :: [(Identifier, a)]
, body :: a }
deriving (Show, Functor)
instance ShowF ProgramF where showsPrecF = showsPrec
type Program = Mu ProgramF
type LabelProgram = Attr ProgramF PLabel
splitBindings :: Attr ProgramF a -> Attr ProgramF a
splitBindings (Fix (Ann a (Let (x:y:xs) e)))
= Fix (Ann a (Let [x] (splitBindings (Fix (Ann a (Let (y:xs) e))))))
splitBindings (Fix e) = Fix (fmap splitBindings e)
toU :: Functor f => Mu f -> Attr f ()
toU = synthetise (const ())
fromU :: Functor f => Attr f () -> Mu f
fromU = forget
mapU :: (Functor f) => (Attr f () -> Attr f ()) -> Mu f -> Mu f
mapU f = fromU . f . toU
testprog :: Program
testprog = Fix $ Unary (Fix $ Let [(Identifier "x", Fix $ Number 1),
(Identifier "y", Fix $ Number 2)]
(Fix $ Unary (Fix $ Number 3) NegOp))
NegOp
main :: IO ()
main = print $ mapU splitBindings testprog