使用 ViewPatterns 和 PatternSynonyms 进行简单的模式匹配

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

那会很好，但我不想这样做。它使其他使用它的代码变得有点丑陋，而且我认为它在 space 和时间方面会稍微低效，你必须匹配两个构造函数而不是一个，这意味着两种情况语句（因此跳转表）而不是一个。

我怀疑我可以使用以下两个 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 中，您可以使用以下 pragma 来满足详尽性检查器的要求：

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

使用 ViewPatterns 和 PatternSynonyms 进行简单的模式匹配

Using ViewPatterns and PatternSynonyms to simply pattern matches

haskell

pattern-synonyms

查看模式

... + 模式同义词