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

Using ViewPatterns and PatternSynonyms to simply pattern matches

假设我有一个像这样的语言的 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

查看模式

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