使用视图模式和模式同义词来简化模式匹配

Question

假设我有一个这样的语言的GADT(我的实际语言要复杂得多，大约有50个构造函数，但这是一个简化的例子)：

data Expr t where
Add :: Expr t -> Expr t -> Expr t
Sub :: Expr t -> Expr t -> Expr t
Mult :: Expr t -> Expr t -> Expr t
Negate :: Expr t -> Expr t
Abs :: Expr t -> Expr t
Scalar :: t -> Expr t

现在让我们定义另一个数据类型，如下所示：

data BinOpT = AddOp | SubOp | MultOp

另外，假设我有以下功能：

stringBinOp :: BinOpT -> String
stringBinOp AddOp = "+"
stringBinOp SubOp = "-"
stringBinOp MultOp = "*"

另外，让我们定义以下类型：

data BinOp t = BinOp BinOpT (Expr t) (Expr t)

现在我想定义一个漂亮的打印函数，如下所示：

prettyPrint :: Show t => Expr t -> String
prettyPrint (BinOp op x y) = prettyPrint x ++ showOp op ++ prettyPrint y
prettyPrint (Negate x) = "-" ++ prettyPrint x
prettyPrint (Abs x) = "abs(" ++ prettyPrint x ++ ")"
prettyPrint (Scalar x) = show x

请注意，这是无效的，因为BinOp不是Expr t的构造函数。

当然，我可以像这样重新定义Expr t：

data Expr t where
BinOp :: BinOp -> Expr t -> Expr t -> Expr t
Negate :: Expr t -> Expr t
Abs :: Expr t -> Expr t
Scalar :: t -> Expr t

那会很好，但我宁愿不这样做。它使使用它的其他代码有点丑陋，而且我认为它在空间和时间方面的效率会稍微低一些，你必须匹配两个构造函数而不是一个，这意味着两个案例语句(因此跳转表)而不是一个。

我怀疑我可以使用以下两个 GHC 扩展的组合来实现我想要做的干净，即：

{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE PatternSynonyms #-}

但我不太确定如何最好地做到这一点。此代码的简单示例会有所帮助(然后我可以将其应用于我正在处理的更复杂的语言)。

如果解决方案在没有缺少模式匹配的警告的情况下编译，则将获得许多虚构的奖励积分。我知道 GHC 8.2 在这方面可能会有所帮助，因此 GHC 8.2 示例及其对详尽性检查的扩展会很好，尽管通过详尽性检查器的 GHC 8.2 之前的解决方案会更好。

澄清：

我实际上要问的是我怎么能做这样的事情：

prettyPrint :: Show t => Expr t -> String
prettyPrint (BinOp op x y) = prettyPrint x ++ showOp op ++ prettyPrint y
prettyPrint (Negate x) = "-" ++ prettyPrint x
prettyPrint (Abs x) = "abs(" ++ prettyPrint x ++ ")"
prettyPrint (Scalar x) = show x

同时保持Expr t的定义如下：

data Expr t where
Add :: Expr t -> Expr t -> Expr t
Sub :: Expr t -> Expr t -> Expr t
Mult :: Expr t -> Expr t -> Expr t
Negate :: Expr t -> Expr t
Abs :: Expr t -> Expr t
Scalar :: t -> Expr t

重要的一行是：

prettyPrint (BinOp op x y) = prettyPrint x ++ showOp op ++ prettyPrint y

它不会编译，因为BinOp不是Expr t的构造函数。我想要像这样编译的行，因为我不想到处都这样做：

prettyPrint (Add x y) = ...
prettyPrint (Sub x y) = ...
prettyPrint (Mult x y) = ...

因为这意味着大量的代码重复，因为很多函数将使用Expr t。

Answer 1

视图模式

asBinOp (Add a b) = Just (AddOp, a, b)
asBinOp (Sub a b) = Just (SubOp, a, b)
asBinOp (Mul a b) = Just (MulOp, a, b)
asBinOp _ = Nothing
prettyPrint (asBinOp -> Just (op, x, y)) = prettyPrint x ++ showOp op ++ prettyPrint y

... + 模式同义词

pattern BinOp :: BinOpT -> Expr t -> Expr t -> Expr t
pattern BinOp op a b <- (asBinOp -> Just (op, a, b)) where
BinOp AddOp a b = Add a b
BinOp SubOp a b = Sub a b
BinOp MulOp a b = Mul a b
prettyPrint (BinOp op x y) = prettyPrint x ++ showOp op ++ prettyPrint y

在 GHC 8.2 中，您可以使用以下编译指示满足详尽性检查器：

{-# COMPLETE BinOp, Negate, Abs, Scalar #-}