[haskell] Printing lambda expressions with minimal parenthesization

久しぶりに programming ネタ。

必要に迫られてλ算法 (+α) の interpreter を作ってるんですが、それの
pretty-print で、えらいてこずったんですよ。Pretty-print と言っても括弧
を可能な限り少なく入れて出力するだけです。Indent とかしません。もっと
具体的にいうと、

data Exp = Sym String | Abs [String] Exp | App Exp Exp

注: Abs は、例えば "\x y. \z. foo" と打ったものを、可能な限り "\x y. \z. foo" のままで (i.e. "\x.\y.\z. foo" に展開しないように) 出力したいので、formals の部分は [String] にしてます。最初は手違いで String になってました。混乱させたようですみません。

という型の抽象構文木 a が与えられたとき、これを次の規則にしたがって、
parse すると a を復元できるような文字列を求める関数 show_parens を書き
ます。

  • 関数適用は juxtaposition・左結合
  • "λx." の body 部分は括弧か EOF に当たるまで伸びる

例えば (x λy. z a λb. c) = (x (λy. ((z a) (λb. c)))) ってことです。

show_parens x を `x と略記する事にします。それで、App e1 e2 という
node を見て、再帰的に `e1, `e2 を求めたとします。このとき、

  • juxtapose した文字列を生成する前に `e1 は括弧で括らないといけない

if and only if

  • `e1 を scan すると、括弧の外に λ という token が現れる。

このλは、e1 の子 node のλかも知れないので、例えば単に e1 が Abs _ _
に match するか見ただけでは、"(x \x. x) y" に相当する AST を処理できな
い。(y が引数になってる application の operator は (x \x. x) だけど、
これは Abs _ _ ではなく、App _ _ の形。)

とりあえず、関数が再帰する度に、subexpression を文字列化したものに加え
て「この文字列は括弧に囲まれてないλを含む/含まない」という情報を返さ
せることにしました。

-- 再帰構造は fold として factor out.  各 subexpression を leaf とみなして
-- 畳む。
fold_exp :: (Exp -> a) -> (Exp -> a -> a) -> (Exp -> a -> a -> a) -> Exp -> a
fold_exp f0 f1 f2 x =
    case x of
      Sym _ -> nullary
      Abs _ e -> unary e
      App e1 e2 -> binary e1 e2
    where nullary = f0 x
          unary e = f1 x (recurse e)
          binary e1 e2 = f2 x (recurse e1) (recurse e2)
          recurse = fold_exp f0 f1 f2

-- 括弧を追加するロジックだけを書いた関数群。文字列化そのものは
-- show_flat のために書いた関数群 (show_*ary) に委託
data ExpSummary = BareAbs | AtomApp deriving Show
paren s = "(" ++ s ++ ")"
paren_binary node@(App _ term) (lsummary, e1) (rsummary, e2) =
    (summary, show_binary node e1' e2')
    where
      e1' = case lsummary of
              BareAbs -> paren e1
              AtomApp -> e1
      (summary, e2') = case term of
                         App _ _ -> (AtomApp, paren e2)
                         _ -> (rsummary, e2)
paren_unary node@(Abs _ _) (_, e) =
    (BareAbs, show_unary node e)
paren_nullary node = (AtomApp, show_nullary node)

show_parens = snd . fold_exp paren_nullary paren_unary paren_binary

-- 再帰でない部分。show_*ary は、単に与えられた node を文字列化する。
-- 括弧は一切つけない。
show_nullary (Sym name) = name
show_unary (Abs formals _) body = "\\" ++ (concat $ intersperse " " formals)
                                  ++ "." ++ body
show_binary (App _ _) e1 e2 = e1 ++ " " ++ e2

show_flat = fold_exp show_nullary show_unary show_binary

見ての通り、label を貼ったり剥がしたり、pair を作ったり壊したりで忙し
くて汚い code になりました。今は Exp の引数二つの constructor は App
だけですが、整数演算とかを追加すると他にも増えることになります (仮に
BinOp とする)。これってどうすればうまく refactor できるんでしょうか。

何かの monad で encapsulate したらいいかとも思ったんですが、そうすると
m Exp は Exp + (ExpSummary に相当する情報) を含む monad ってことになり
ます。

とまで書いたあたりで眠くて眠くて何が言いたかったのかわからなくなってき
たので、終了。

UUAG 使ってみると面白いかもしれない。後でやってみようか。属性文法、concoqtion 研究と関係あるんだよね…