有没有像猫一样的东西，但你可以匹配内部结构？

Question

我有这种语言 AST

data ExprF r = Const Int
              | Var   String
              | Lambda String r
              | EList [r]
              | Apply r r
 deriving ( Show, Eq, Ord, Functor, Foldable )

我想把它转换成字符串

toString = cata $ \case
  Const x -> show x
  Var x -> x
  EList x -> unwords x
  Lambda x y -> unwords [x, "=>", y]
  Apply x y -> unwords [x, "(", y, ")"]

但是当 Apply 中使用 lambda 时，我需要括号

(x => x)(1)

但我无法将内部结构与 cata 匹配

toString :: Fix ExprF -> String
toString = cata $ \case
  Const x -> show x
  Var x -> x
  Lambda x y -> unwords [x, "=>", y]
  Apply (Lambda{}) y -> unwords ["(", x, ")", "(", y, ")"]
  Apply x y -> unwords [x, "(", y, ")"]

还有比para更好的解决方案吗？

toString2 :: Fix ExprF -> String
toString2 = para $ \case
  Const x -> show x
  Var x -> x
  Lambda x (_,y) -> unwords [x, "=>", y]
  EList x -> unwords (snd <$> x)
  Apply ((Fix Lambda {}),x) (_,y) -> unwords ["(", x, ")", "(", y, ")"]
  Apply (_,x) (_,y) -> unwords [x, "(", y, ")"]

看起来更丑。即使只在一个地方需要它，我也需要在所有地方删除 fst 元组参数，我想它会更慢。

Answer 1

正如@chi、@DanielWagner 和我在 cmets 中指出的那样，以结构递归方式进行这种带括号的漂亮打印的方法是“showsPrec 方法”。

最大的想法不是将语法树折叠成String，而是折叠成一个函数 Bool -> String。这使我们在折叠中具有一定程度的上下文敏感性：我们将使用额外的Bool 参数来跟踪我们当前是否处于应用程序左侧的上下文中。

parens x = "(" ++ x ++ ")"

ppAlg :: ExprF (Bool -> String) -> (Bool -> String)
ppAlg (Const x) isBeingApplied = show x
ppAlg (Var x) isBeingApplied = x
ppAlg (Lambda name body) isBeingApplied = p ("\\" ++ name ++ " -> " ++ body False)
    where p = if isBeingApplied then parens else id
ppAlg (EList es) isBeingApplied = unwords (sequenceA es False)
ppAlg (Apply fun arg) isBeingApplied = fun True ++ " " ++ arg False

我们将isBeingApplied 的值传递给递归调用，具体取决于我们现在在语法树中的位置。请注意，我们传递True 的唯一地方是作为fun 的参数在Apply 案例的主体中。然后，在Lambda 的情况下，我们检查该论点。如果当前项是应用程序的左侧部分，我们将括号括起来；如果不是，我们不这样做。

在顶层，将整个树折叠成一个函数Bool -> String，我们将参数False 传递给它——我们目前不在应用程序的上下文中——得到一个String .

pp :: Expr -> String
pp ex = cata ppAlg ex False

ghci> pp $ app (lam "x" (var "x")) (cnst 2)
"(\\x -> x) 2"

通过将Bool 替换为Int，此方法可以推广到具有任意优先级的括号运算符，如@DanielWagner's linked answer 所述。

Answer 2

一种解决方案是使用{-# LANGUAGE PatternSynonyms #-} 扩展并定义单向模式，例如：

pattern Apply' r1 r2 <- Apply (_,r1) (_,r2)

然后你可以像这样在你的定义中使用：

toString2 :: Fix ExprF -> String
toString2 = para $ \case
  Const x -> show x
  Var x -> x
  Lambda x (_,y) -> unwords [x, "=>", y]
  EList x -> unwords (snd <$> x)
  Apply ((Fix Lambda {}),x) (_,y) -> unwords ["(", x, ")", "(", y, ")"]
  Apply' x y -> unwords [x, "(", y, ")"]

由于ExprF 是一个函子，另一种选择是简单地写：

toString2' :: Fix ExprF -> String
toString2' = para $ \case
  Apply ((Fix Lambda {}),x) (_,y) -> unwords ["(", x, ")", "(", y, ")"]
  other -> case fmap snd other of
      Const x -> show x
      Var x -> x
      Lambda x y -> unwords [x, "=>", y]
      Apply x y -> unwords [x, "(", y, ")"]

使用模式同义词并使用-Wall 进行编译时，我无法让穷举检查器相信模式匹配是穷举的。

Answer 3

对于丢失的情况如何直接递归：

toString :: Fix ExprF -> String
toString (Fix (Apply (Fix (Lambda _ x)) y)) = "(" ++ toString x ++ ")(" ++ toString y ++ ")"
toString z = (cata $ \case
  Const x -> show x
  Var x -> x
  EList x -> unwords x
  Lambda x y -> unwords [x, "=>", y]
  Apply x y -> unwords [x, "(", y, ")"]) z