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和我在评论中指出的那样，以结构递归的方式进行这种漂亮打印的方式是showsPrec方法＆＃34; @DanielWagner's linked answer方法＆＃34 ;

最大的想法是不要将语法树折叠成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的情况下，我们检查该参数。如果当前术语是应用程序的左侧部分，我们将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，可以将此方法推广到使用任意优先级的运算符括号，如{{3}}所述。

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

缺少案例的直接递归怎么样：

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

有什么像cata但你可以匹配内部结构？

3 个答案: