使用多参数类型派生扩展

时间:2017-06-05 10:06:01

标签: haskell types deriving language-extension

我有一个Ast类型的构造函数,由标识符类型参数化。 使用DeriveFunctor,DeriveFoldable和DeriveTraversable扩展 可以自动创建适当的实例。

现在我发现引入更多类型参数很有用但不幸的是 上述方法无法扩展。理想情况下,我希望能够 将我的Ast类型包装在允许我fmap到的选择类型中 适当的类型参数。有没有办法实现类似的 效果,而不必自己定义实例?

编辑:

以下是原始Ast看起来像的一个小例子:

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)

..

1 个答案:

答案 0 :(得分:1)

在整天摆弄后,我得出以下结论:

问题中提出的Ast结果不是很灵活。 在后面的阶段,我想以一种不可能的方式注释不同的节点 通过参数化原始的Ast来表达。

所以我改变了Ast,以便成为编写新类型的基础:

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 |
    ..

现在我可以简单地为每个编译器阶段定义一个newtypes链。 重命名阶段的Ast可以围绕标识符类型进行参数化:

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) 
}

在类型检查阶段,Ast可以参数化 节点中使用的不同内部类型。

此参数化允许构建包含Maybe的Asts 每个阶段中间的参数。

如果一切正常,我们可以使用fmap删除Maybe并为下一阶段准备树。还有其他方式Functor, FoldableTraversable是有用的,所以这些是必须拥有的。

此时我认为我想要的东西很可能不可能 没有元编程,所以我搜索了模板haskell解决方案。 果然有 genifunctors 库实现了泛型 fmap, foldMaptraverse函数。使用这些只是一件简单的事情 编写一些newtype包装器来围绕相应的参数创建所需类型类的不同实例:

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

..