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

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

缺失情况的直接递归如何：

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

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 是一个 Functor，另一种选择是简单地写成：

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

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

主要的想法不是将语法树折叠成 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 的唯一地方是在 Apply 案例的主体中作为 fun 的参数。然后，在 Lambda 的情况下，我们检查该参数。如果当前项是应用程序的左侧部分，我们将 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.

中所述

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

Is there something like cata but where you can match inner structure?

recursion

haskell

abstract-syntax-tree

catamorphism

recursion-schemes