数式パーサその2

中置演算子とHaskell風の関数呼び出しをパースする処理をSchemeで書いてみた。
例えば以下のサンプルを実行すると11と6を表示する。

(
~ a = 2 
~ b = a + 1
~ print (a + b * 3)

~ fact n = n == 0 and 1
                  or  n * fact (n - 1) 
~ print (fact b)
)

実際には、先頭の「~」がパーサを呼び出すマクロで、2つめ以降の「~」は中置演算子版のbeginになっている。

(print (macroexpand '(~ a = 2 ~ b = a + 1 ~ print (a + b * 3) 
                      ~ fact n = n == 0 and 1 or n * fact (n - 1) 
                      ~ print (fact b))))

マクロの展開結果は以下の通り。

(begin (define a 2)
(begin (define b (+ a 1))
(begin (print (+ a (* b 3)))
(begin (define (fact n) (or (and (eq? n 0) 1) (* n (fact (- n 1)))))
(print (fact b))))))

パーサのコード
rule：演算子の優先順位(数が大きいほど優先順位が高い)と、左結合(l)か右結合(r)かを指定する。
op?：opが演算子なら真。ruleに登録されているシンボルなら演算子と認識する。
reduce?：還元すべきかの判定。演算子o1とo2の優先順位が同じで左結合か、o1の方が優先順位が高かったら真。
parse：パース処理本体。stがスタックで、inが入力。
o2f：パース後の演算子をSchemeの関数に置換する。

(use util.match)

(define rule '((^ 8 r) (* 7 l) (/ 7 l) (+ 6 l) (- 6 l) (== 5 l)
               (and 4 r) (or 3 r) (= 2 r) (~ 1 r)))

(define (op? op) (assoc op rule))

(define (reduce? o2)
  (lambda (o1) (match `(,@(op? o1) ,@(op? o2))
    ((_ n1 d1 _ n2 d2) (if (eq? n1 n2) (eq? d1 'l) (> n1 n2))))))

(define (parse st in)
  (match in (()
    (match st ((e)                    e)
              ((e2 (? op? o) e1 . es) (parse `((,o ,e1 ,e2) ,@es) ()))))
            (((? op? o2) . is) (let1 p? (reduce? o2)
    (match st ((e2 (? p? o1) e1 . es) (parse `((,o1 ,e1 ,e2) ,@es) in))
              (_                      (parse `(,o2 ,@st) is)))))
            ((i . is)          (let1 e1 (if (pair? i) (parse () i) i)
    (match st ((or () ((? op?) . _))  (parse `(,e1 ,@st) is))
              (((? pair? e2) . es)    (parse `((,@e2 ,e1) ,@es) is))
              ((e2 . es)              (parse `((,e2 ,e1) ,@es) is)))))))

(define (o2f ls) (map (match-lambda 
  ((? pair? x) (o2f x))
  ('= 'define) ('~ 'begin) ('== 'eq?) (x x)) ls))

(define-macro (~ . exp) (o2f (parse () exp)))