两个 AST 之间的简单编译器，公开相同的语言类型和操作

Question

我正在寻找一种优雅的方法来解决以下问题。欢迎所有选项，尤其是类型类和 GADT :-)

场景是这样的：存在一种具有类型（字符串和整数）和操作（+、-、++ 和拆分）的小型语言。该语言有两种语法，每种都有自己的解析器。我想编写一个编译器，它可以从语言 X 到语言 Y，或从 Y 到 X。从一个编译到另一个编译是使用其中之一对表达式列表的直接映射：

xToY :: ExpX -> ExpY
yToX :: ExpY -> ExpX

.. 后跟 show，而不是 [ExpY] 或 [ExpX]。这是这两个编译器函数的简单实现，使用普通数据定义和构造函数上的模式匹配：

{-# LANGUAGE LambdaCase #-} 模块编译器在哪里 数据 ExpX = StringX 字符串 | IntX 诠释 | ArithOpX ArithExpX | StringOpX StringExpX deriving (显示) 数据 ArithExpX = EAddX ExpX ExpX | EMinusX ExpX ExpX 导出 (显示) 数据 StringExpX = EAppendX ExpX ExpX | ESplitX ExpX ExpX 导出 (显示) 数据 ExpY = StringY 字符串 |整数 整数 | ArithOpY ArithExpY | StringOpY StringExpY deriving (显示) 数据 ArithExpY = EAddY ExpY ExpY | EMinusY ExpY ExpY deriving (显示) 数据 StringExpY = EAppendY ExpY ExpY | ESplitY ExpY ExpY 导出 (显示) xToY :: ExpX -> ExpY xToY = \案子 StringX s -> StringY s IntX i -> IntY i ArithOpX (EAddX a b) -> ArithOpY (EAddY (xToY a) (xToY b)) ArithOpX (EMinusX a b) -> ArithOpY (EMinusY (xToY a) (xToY b)) StringOpX (EAppendX a b) -> StringOpY (EAppendY (xToY a) (xToY b)) StringOpX (ESplitX a b) -> StringOpY (ESplitY (xToY a) (xToY b)) yToX :: ExpY -> ExpX yToX = \案子 StringY s -> StringX s IntY i -> IntX i ArithOpY (EAddY a b) -> ArithOpX (EAddX (yToX a) (yToX b)) ArithOpY (EMinusY a b) -> ArithOpX (EMinusX (yToX a) (yToX b)) StringOpY (EAppendY a b) -> StringOpX (EAppendX (yToX a) (yToX b)) StringOpY (ESplitY a b) -> StringOpX (ESplitX (yToX a) (yToX b))

测试 noddy 编译器：

*编译器> xToY (ArithOpX (EAddX (IntX 2) (IntX 5))) ArithOpY (EAddY (IntY 2) (IntY 5)) *编译器> yToX (StringOpY (ESplitY (StringY "foo") (StringY "bar"))) StringOpX (ESplitX (StringX "foo") (StringX "bar"))

所以它起作用了。不幸的是，有很多代码重复，并且明显出现了一种模式。我想采用 Haskell 的一个更优雅的特性来实现 xToY 和 yToX 给出的相同结果。特别是，我正在寻找一种方法来定义构造函数之间的对偶性，例如StringX s 被编译为StringY s，而StringY s 被编译回StringX s。当然有一个很好的方式来表达这一点？此外，案例匹配右侧的嵌套 xToY 和 yToX 调用看起来很脏，例如ArithOpX (EAddX (yToX a) (yToX b))。一定有更好的办法吗？

Answer 1

尝试将ExpX 和ExpY 替换为以下单一类型Exp t。 t 是一个标签，它被某种类型替换以将其标记为用于特定目的：

data Exp t = String String | Int Int | ArithOp (ArithExp t) | StringOp (StringExp t) deriving (Show)
data ArithExp t = EAdd (Exp t) (Exp t) | EMinus (Exp t) (Exp t) deriving (Show)
data StringExp t = EAppend (Exp t) (Exp t) | ESplit (Exp t) (Exp t) deriving (Show)

data ForX = ForX
data ForY = ForY

然后在您关心差异的任何地方使用Exp ForX 代替ExpX 和Exp ForY 代替ExpY。

然后，您可以编写适用于forall 标记的函数。例如，我们可以将xToY 和yToX 替换为单个函数retag：

retag:: Exp t1 -> Exp t2
retag =
    \case
    String s -> String s
    Int i -> Int i
    ArithOp (EAdd a b) -> ArithOp (EAdd (retag a) (retag b))
    ArithOp (EMinus a b) -> ArithOp (EMinus (retag a) (retag b))
    StringOp (EAppend a b) -> StringOp (EAppend (retag a) (retag b))
    StringOp (ESplit a b) -> StringOp (ESplit (retag a) (retag b))

这种类型t 是“幻像类型”的一个示例。 “幻像类型”是一种从未出现在任何构造函数中的类型。