使用多参数类型派生扩展

Question

I have an Ast type constructor, parameterized by the identifier type. Using the DeriveFunctor, DeriveFoldable and DeriveTraversable extensions it is possible to automatically create the appropriate instances.

Now I find it useful to introduce more type parameters but unfortunately the above method doesn't scale. Ideally I would like to be able to wrap my Ast type in selection types which would allow me to fmap to the appropriate type parameters. Is there some way to achieve a similar effect without having to define the instances myself?

edit:

Here is a small example of what the original Ast looked like:

Ast id = Ast (FuncDef id)
    deriving (Show, Functor, Foldable, Traversable)

FuncDef id = FuncDef id [Fparam id] (Block id)
    deriving (Show, Functor, Foldable, Traversable)

Block id = Block [Stmt id]
    deriving (Show, Functor, Foldable, Traversable)

..

Answer 1

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

..