4

我有这种语言 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, ")"]

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

(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 元组参数，我想它会更慢。

4

3 回答 3

8

正如@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是作为案例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 的链接答案中所述。

于 2016-08-23T20:37:12.027 回答
1

一种解决方案是使用{-# 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，我无法说服穷举检查器认为模式匹配是穷举的。

于 2016-08-23T19:55:04.547 回答
0

丢失案例的直接递归怎么样：

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
于 2016-08-23T17:31:45.083 回答