After fiddling around all day I came to the following conclusions:
The Ast presented in the question turned out not to be very flexible.
In later stages I want to annotate different nodes in a way that can't
be expressed by just parameterizing the original Ast.
So I changed the Ast in order to act as a base for writing new types:
Ast funcdef = Ast funcdef
deriving (Show)
Header id fpartype = Header id (Maybe Type) [fpartype]
deriving (Show)
FuncDef header block = FuncDef header block
deriving (Show)
Block stmt = Block [stmt]
deriving (Show)
Stmt lvalue expr funccall =
StmtAssign lvalue expr |
StmtFuncCall funccall |
..
Expr expr intConst lvalue funccall =
ExprIntConst intConst |
ExprLvalue lvalue |
ExprFuncCall funccall |
expr :+ expr |
expr :- expr |
..
Now I can simply define a chain of newtypes for each compiler stage.
The Ast at the stage of the renamer may be parameterized around the identifier type:
newtype RAst id = RAst { ast :: Ast (RFuncDef id) }
newtype RHeader id = RHeader { header :: Header id (RFparType id) }
newtype RFuncDef id = RFuncDef {
funcDef :: FuncDef (RHeader id) (RBlock id)
}
..
newtype RExpr id = RExpr {
expr :: Expr (RExpr id) RIntConst (RLvalue id) (RFuncCall id)
}
During the typechecking stage the Ast may be parameterized by
the different internal types used in the nodes.
This parameterization allows for constructing Asts with Maybe
wrapped
parameters in the middle of each stage.
If everything is ok we can use fmap
to remove the Maybe
s and prepare the tree for the next stage. There are other ways Functor, Foldable
and Traversable
are useful so these are a must to have.
At this point I figured that what I want is most likely not possible
without metaprogramming so I searched for a template haskell solution.
Sure enough there is the genifunctors library which implements generic
fmap, foldMap
and traverse
functions. Using these it's a simple matter
of writing a few newtype wrappers to make different instances of the required typeclasses around the appropriate parameters:
fmapGAst = $(genFmap Ast)
foldMapGAst = $(genFoldMap Ast)
traverseGast = $(genTraverse Ast)
newtype OverT1 t2 t3 t1 = OverT1 {unwrapT1 :: Ast t1 t2 t3 }
newtype OverT2 t1 t3 t2 = OverT2 {unwrapT2 :: Ast t1 t2 t3 }
newtype OverT3 t1 t2 t3 = OverT3 {unwrapT3 :: Ast t1 t2 t3 }
instance Functor (OverT1 a b) where
fmap f w = OverT1 $ fmapGAst f id id $ unwrapT1 w
instance Functor (OverT2 a b) where
fmap f w = OverT2 $ fmapGAst id f id $ unwrapT2 w
instance Functor (OverT3 a b) where
fmap f w = OverT3 $ fmapGAst id id f $ unwrapT3 w
..