使用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

这样可以正常工作,但我宁愿不这样做.它使得使用它的其他代码变得更加丑陋,而且我认为它在空间和时间方面会稍微低效,并且你必须匹配两个构造函数而不是一个,这意味着两个case语句(因此跳转)表)而不是一个.

我怀疑我可以使用以下两个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 #-}