Есть ли что-то вроде cata, но где вы можете сопоставить внутреннюю структуру?

Question

У меня есть этот язык АСТ

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 Мне нужны скобки

(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 подход".

Большая идея не складывать синтаксическое дерево в 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.

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