LISPで中置記法を書くマクロ作ってみた

中置記法もありじゃないかな

LISPといえば前置記法。前置記法といえばLISP。曖昧さのない前置記法+カッコという形式は、わかりやすいし生成しやすいし、大変便利です。LISPファンのかたの中には、中置記法なんていらねえよ! という方もおられるでしょうが、時には中置記法のほうがスッキリ書ける場合もあるでしょう。

て言うのもですね、Twitter中置記法マクロを見たんですよ。

infixing
https://github.com/pasberth/infixing

あー確かに中置記法マクロを定義するマクロあったら便利かもわからんね、と思って、じゃあちょっとコードを読んでみましょう、と思ったんですが。

                /|:::::::::::::::::::::ヽ.:.:.:.:、:.:.:.:、:.:.:.、.:.、.:.:.:.:.:.::`゛>
           /{::|:\:::::::\.:.:.:\.:.:.ヽ::.::.ヽ:.:.ヽ::::::::::.:.`゛ー- ..,__
: 何 :    /:|::',:ト、::::::ヽ、:.\:.:.:.\:.:.ヽ:.:.:\.:.:.:.:.:::.:.:.:.:::.::::_;:-'´   : : :
: が :   //:/:::|::',|::'、:::::::::\:.:\.:.:.ヽ:.:.:\:.:..\::::::::::::\、::::\    : : :
: 何 :  /!::|::l::::/|:::l:ヽ:\::ヽ:.:\:.:\.:::ヽ:.:.:ヽ:.:.:.:\::::::::::::\ ̄   : : :
: だ :   |/l::|::|::|:ト、:::::::::、、:ヽ、:.:.:.:::::::::::::::ヽ::::.:ヽ:.:.:.:.\:.:.:.ヽ:::\.   : : :
: か :   |::|::/l::|::|r‐ヽ:::::ヽ(ヽー,―\::::::、::::::::::ヽ::.:.::::::.:::::::ヾ. ̄   : : :
:    :   }//l::|:::|{(:::)ヾ、:::ヽ \!(:::) ヽ,:::ヽ:::::::::::::::::::::::::::::::::::ヾ、   : : :
: わ :.  |/l::|::|:::|ヽ==''" \:ヽ、ヽ=='" |:::::::::::::::::::::::::::::::::::ヽ、::::\
  か     / ',|::|:::|   /   `゛       |!::::::::::::::::::::::::::::ト、::ト、_` ゛`
  ら      l::!::::ト、  '、 _         ||::::::::::::::::::::::::ト:ヽヾ| | ̄ ̄ ̄`ヽ、
  な     r'"´||',::::',                 |:::::/l:::::|\:::ト、ヾ | |     / / \
  い   /   ll ',::', 、 ーこニ=-       /!::/ ヽ:::|  ヾ、  ノ ノ  /  ,イ   ヽ、
       ,'    |  '、:, \ --       ,. '´ |;'  l ヾ、.   //     / |    l: l
      |   |!  ヽ;  ヽ       /.:    i!  /   ゛// |l      / |      | |


ちょっと私のLISP*1が足りなくてわけがわからなかったので、勉強しようと思って自分で書くことにしました。

操車場アルゴリズム

わたくし、Racc*2は使ったことがあるのですが、恥ずかしながら中置記法の優先度を考慮して正しい構文木に直す方法が分からなくて……

ぐぐってみたら見つかりました。

操車場アルゴリズム(そうしゃじょうあるごりずむ)は、計算機科学において、中置記法の数式を構文解析する技法である。逆ポーランド記法 (RPN) または抽象構文木 (AST) の形式で出力を生成するのに使える。このアルゴリズムエドガー・ダイクストラが考案したもので、鉄道の操車場に似た操作をするため、このような名称がつけられた。
http://ja.wikipedia.org/wiki/操車場アルゴリズム

LISPマクロにするにあたっての簡略化

  • 括弧による優先順位は無視します。カッコがあったらそれはS式です
  • 指定された演算子以外は全部数値とみなします。S式も数値です
  • エラーチェックはしません(値と演算子が交互に来ることを確認しないといけないはず)

というわけで実装

(defvar *op-list*
  '(
    (^ :right 10)
    (* :right 5)
    (/ :right 5)
    (+ :right 1)
    (- :right 1)
    )
  "演算子の定義。演算子に続くのは、結合の方向と優先度。優先度は大きいほど高い")

(defun op-p (op? op-list)
  "あるオブジェクトがシンボルであるかを試す述語"
  (assoc op? op-list))

(defun get-weight (op op-list)
  "ある演算子の優先度を取得するための関数"
  (third (assoc op op-list)))

(defun get-assoc (op op-list)
  "ある演算子の結合の方向を取得するための関数"
  (second (assoc op op-list)))

(defun op-comp (comp op another-op op-list)
  "演算子同士の大小を comp によって比較する"
  (let ((op-weight      (third (assoc op         op-list)))
        (another-weight (third (assoc another-op op-list))))
    (funcall comp op-weight another-weight)))

(defun op< (op another-op op-list)
  "演算子opの優先度が、別の演算子another-opのそれより小さければ真を返す"
  (when (null another-op) (return-from op< t))
  (op-comp #'< op another-op op-list))

(defun op<= (op another-op op-list)
  "演算子opの優先度が、別の演算子another-opのそれと等しいか、より小さければ真を返す"
  (when (null another-op) (return-from op<= t))
  (op-comp #'<= op another-op op-list))

(defun left-associative-p (op op-list)
  "演算子opが左結合ならば真を返す"
  (eq :left (get-assoc op op-list)))


(defun soshajo (source op-list &optional stack q)
  "操車場アルゴリズム。sourceに中置記法で書かれた式を、op-listに演算子の定義を渡す"
  (if (null source) ; 式が終わった場合
      (nconc (nreverse stack) q) ; スタックが空になるまで中身をキューにプッシュ
      (let ((new-op      (car source))
            (op-in-stack (car stack)))
        (cond ((not (op-p (car source) op-list))
               ;; sourceの先頭が演算子でないなら、それをすぐ出力キューに入れる
               (soshajo (cdr source) op-list stack (cons new-op q)))
              ((and op-in-stack
                    (or (and (left-associative-p new-op op-list)
                             (op<= new-op op-in-stack op-list))
                        (op< new-op op-in-stack op-list)))
               ;; sourceの先頭にある演算子が左結合でスタックの一番上のものより優先度が等しいか低い場合
               ;; あるいはスタックの一番上のものより優先度が低い場合
               ;; スタック上の演算子をポップし、キューに入れる
               (soshajo source op-list (cdr stack) (cons op-in-stack q)))
              (t
               ;; いずれでもなければ、演算子をスタックに入れる
               (soshajo (cdr source) op-list (cons new-op stack) q))))))


(defun rpn->sexp (rpn-lst stack op-list)
  "逆ポーランド記法をS式に直す処理"
  (if (null rpn-lst)
      (car stack)
      (let ((elem (car rpn-lst)))
        (if (op-p elem op-list)
            (let ((arg1 (first  stack))
                  (arg2 (second stack)))
              (rpn->sexp (cdr rpn-lst) (cons (list elem arg2 arg1) (cddr stack)) op-list))
            (rpn->sexp (cdr rpn-lst) (cons elem stack) op-list)))))

(defmacro infixing (rule sexp)
  (rpn->sexp (nreverse (soshajo sexp NIL NIL rule)) NIL rule))

(macroexpand-1 `(infixing ,*op-list* (1 + 2 ^ 3 ^ 4))) ;=> (+ 1 (^ 2 (^ 3 4)))

ね? 簡単でしょ?

まとめ

*1:LISPを読み書きする力。私のLISP力はせいぜい5といったところかな

*2:スゴイ級ハッカー青木氏によって書かれたRubyのパーサジェネレータ