有没有像数据一样的东西，但是你可以匹配内部结构

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)

但是我不能用数据

匹配内部结构

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, ")"]

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

Answer 1

正如@chi， @DanielWagner和我在评论中指出的那样，以结构递归的方式完成这种带有括号的漂亮打印的方法是"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的唯一地方是在Apply案例的主体中作为fun的参数。然后，在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的链接答案所述。

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