この記事は, Lisp Advent Calendar 2019の14日目の記事です.

この記事のライセンスはCC-BYとします.

また, 記事中のinfixプロジェクトに含まれるコードはMIT Licenseでライセンス付けされています.

この記事の概要

今年のアドベントカレンダーの中で,

Common Lispのプロジェクトを作ってパッケージ化する話 (defpackage, defsystem)
package間の依存性の記述と, 名前の衝突を避ける方法
簡単なマクロの書き方

について書いてきました.

今日の記事は, その総集編的な立ち位置として, 中置記法の簡単な数式を前置記法に変換する様なマクロを
一つのシステムとして作っていきながら, 流れを簡単におさらいしていきたいと思います.

今回, 題材とするコードはinfixで公開しています.

記事では上記のリポジトリと一部違う構成となりますが, ご了承ください.

開発環境は著者の手元のものを想定して書きます.

OS: Ubuntu 19.10 eoan
SBCL 1.5.9

プロジェクト用のディレクトリを作成する

まず, はじめにソースコードなどを配置するプロジェクト用のディレクトリを作成します.

$ cd ~/common-lisp/
$ mkdir infix

asdfが, 今から作るシステムを探すことの出来るように, ~/common-lisp/にディレクトリを配置します.

asdファイル書く

$ cd ~/common-lisp/infix
$ touch infix.asd

システム定義のためにasdファイルを用意します. infix.asdという名前でファイルを作成します.

infix.asd

(defsystem "infix"
  :depends-on ("infix/infix")
  :class :package-inferred-system
  :license "mit"
  :author "your name"
  :pathname "src/"
  :mailto "you@example.com")

システム名はinfixとしました. 第一引数に"infix"を指定します.

package inferred systemを使用するために, :classオプションに:package-inferred-systemを指定します.

~/common-lisp/infix/src/ディレクトリにソースコードを配置しようと思います. :pathnameにsrc/を指定します.

この後, メインのファイルとして, ~/common-lisp/infix/src/infix.lispを作ります.
package inferred systemを使うこと, :pathnameにsrc/を指定したことで, このファイルで定義されるシステム名はinfix/infixとなります. (パッケージ名も同じ.)

このファイルをシステムが見つけられるように, :depends-onオプションに("infix/infix")を指定します.

:licence, :author, :mailtoは, 仮に書いています. これらの情報は, Common Lispのプログラムで扱うことが出来ます.

srcディレクトリを作成する

ソースコードを配置するディレクトリを作成します. ~/common-lisp/infix/src/に配置するので,

$ mkdir ~/common-lisp/infix/src

と言った具合で作成します.

infix.lispを作成する

システムのメインとなるファイルinfix.lispを作成します.

$ touch ~/common-lisp/infix/src/infix.lisp

infix.lisp

(defpackage :infix/infix
  (:use :cl)
  (:export))
(in-package :infix/infix)

defpackageでパッケージを定義します.
package inferred systemの規約に従い, :infix/infixを第一引数に指定します.

Common Lispの組み込みの機能を使うので, (:use :cl)と指定します.

ファイル中のコードをパッケージ:infix/infixで使うために, defpackageの後に, (in-package :infix/infix)と書きます.

asdf:load-system 確認しておく

CL-USER> (asdf:load-system :infix)
T

asdf:load-systemでロード出来ることだけ確かめます.

この時点では, 何もエクスポートしていないので, 何か使えるようにはなりませんが,
SLIMEなどの高機能REPLでは, infix/infix:パッケージ修飾子などが, 補完されるようになると思います.

shunting-yard.lispを書く

infix.lispでは中置記法で簡単な計算が出来るマクロを定義します.

マクロが受け取った中置記法で書かれた数値と特定のシンボルのリストから, 前置記法のもの, Common Lispのコードを生成するということを行います.

このマクロでは, 数値と特定の数値のリストを操作して, 対応するCommon Lispのコードを表すリストに変換します.

一つのdefmacroの中に処理をすべて書いてしまうと長ったらしくなるので, 処理はいくつかの関数として定義します.

この関数群は別のパッケージ(ファイル)で定義しておいて, :infix/infixでそのパッケージをuseする形にします.

このファイルをshunting-yard.lispとして作成します.

$ touch ~/common-lisp/infix/src/shunting-yard.lisp

パッケージの定義

shunting-yard.lisp

(defpackage :infix/shunting-yard
  (:use :cl)
  (:shadow :step)
  (:export :shunting-yard))
(in-package :infix/shunting-yard)

shunting-yard.lispでは, infix/shunting-yardというパッケージを定義します.

infix/shunting-yardパッケージは, 操車場アルゴリズム¹を使って,
中置記法での計算式を表現した数字と特定のシンボルのリストから,
前置記法でのCommon Lispのコードを生成します. (一部シンボルの変換も行います.)

ただし関数呼び出しは実装せず, 計算順序を制御する中括弧については, 入れ子にしたリストを用います.

この関数をSHUNTING-YARDという名前で定義してパッケージ外に提供するので, (:export :shunting-yard)とします.

また, この関数が内部で使う関数として, STEPという名前の関数を定義します.

しかしSTEPという名前は, cl:stepとCommon Lispの組み込みマクロとして提供されているので, これと衝突しないように,
(:shadow :step)と指定します.

操車場アルゴリズムの実装

ここでの(簡易版)操車場アルゴリズムの実装は, 以下のとおりになります.

入力と出力と演算子スタックをそれぞれリストで表現し, in, out, opsという変数名で管理しています.
入力のcar部の値によって分岐して処理を進めます.

前置記法に変換されたものは値として, 出力に追加していくことで, 数値と同様に扱うことが出来ます.

入力が妥当で, うまく最後まで処理が進んだら, 出力に一つの値(あるいは前置記法に変換された式)が残るので, outからcar部を取り出して終了となります.

入力のバリデーションは行わず, 処理が進められなくなったらエラーを発生させます.

shunting-yard.lisp

(defun shunting-yard (in)
  (step in nil nil))

(defun step (in out ops)
  (cond (in
         (cond ((numberp (car in)) (output-number in out ops))
               ((listp (car in)) (step (cdr in) (cons (step (car in) nil nil) out) ops))
               ((is-op (car in))
                (if (and ops (or (and (is-left-associative (car in))
                                      (priority<= (car in) (car ops)))
                                 (priority< (car in) (car ops))))
                    ;; 左結合で優先順位がスタックトップと等しいか低い,
                    ;; あるいはスタックトップと優先順位が低い.
                    (pop-operator in out ops)
                    (push-operator in out ops)))
               (t (error "Error ~A ~A ~A" in out ops))))
        (ops (pop-operator in out ops))
        (t (car out)))) ;; 最後は数値か式が一つ積まれてる

(defun is-op (op?)
  (cond ((string= "+" (symbol-name op?)) '+)
        ((string= "-" (symbol-name op?)) '-)
        ((string= "*" (symbol-name op?)) '*)
        ((string= "/" (symbol-name op?)) '/)
        ((string= "^" (symbol-name op?)) 'expt)
        (t nil)))

(defun get-op (op)
  (let ((sym (is-op op)))
    (if sym
        sym
        (error "Error ~A" op))))

(defun priority< (op1 op2)
  (let ((sym1 (get-op op1))
        (sym2 (get-op op2)))
    (or (and (eq sym1 '+) (eq sym2 '*))
        (and (eq sym1 '+) (eq sym2 '/))
        (and (eq sym1 '-) (eq sym2 '*))
        (and (eq sym1 '-) (eq sym2 '/))
        (and (eq sym1 '+) (eq sym2 'expt))
        (and (eq sym1 '-) (eq sym2 'expt))
        (and (eq sym1 '*) (eq sym2 'expt))
        (and (eq sym1 '/) (eq sym2 'expt)))))

(defun priority= (op1 op2)
  (let ((sym1 (get-op op1))
        (sym2 (get-op op2)))
    (or (and (eq sym1 '+) (eq sym2 '+))
        (and (eq sym1 '+) (eq sym2 '-))
        (and (eq sym1 '-) (eq sym2 '+))
        (and (eq sym1 '-) (eq sym2 '-))
        (and (eq sym1 '*) (eq sym2 '*))
        (and (eq sym1 '*) (eq sym2 '/))
        (and (eq sym1 '/) (eq sym2 '*))
        (and (eq sym1 '/) (eq sym2 '/))
        (and (eq sym1 'expt) (eq sym2 'expt)))))

(defun priority<= (op1 op2)
  (or (priority< op1 op2) (priority= op1 op2)))

(defun is-left-associative (op)
  (let ((sym (get-op op)))
    (or (eq sym '+)
        (eq sym '-)
        (eq sym '*)
        (eq sym '/))))

(defun output-number (in out ops)
  (step (cdr in) (cons (car in) out) ops))

(defun pop-operator (in out ops)
  (step in
        (cons (list (get-op (car ops)) (cadr out) (car out)) (cddr out))
        (cdr ops)))

(defun push-operator (in out ops)
  (step (cdr in)
        out
        (cons (car in) ops)))

infixマクロを定義する

infix/shunting-yard:shunting-yardを使って, マクロinfixを定義します.

infix/shunting-yard:shunting-yardを使うために, defpackageの部分を書き直します.

infix.lisp

(defpackage :infix/infix
  (:use :cl :infix/shunting-yard)
  (:export :shunting-yard :infix))
(in-package :infix/infix)

せっかくですので? infixマクロ以外に, shunting-yard関数も提供しておきます.

マクロでは, リストを組み立てて返す関数のように,
Common Lispの式(複数可)から, 展開後のCommon Lispの式の組み立て方を定義するということを10日目の記事で書きました.

今, すでに中置記法の入力(入れ子を許した, 数値と特定のシンボルのリスト)をリストとして渡せば,
同じ計算をするCommon Lispの式を返す関数infix/shunting-yard:shunting-yardがあるので,
展開時に行うことは, これを呼び出すだけです.

infix.lisp

(defmacro infix (&body body)
  (shunting-yard body))

これでシステムinfixをロードすると, infix/infix:infixマクロが使えます.

使う

使い方は, こんな感じです.

CL-USER> (infix/infix:infix  3 + 4 * 2 / ( 1 - 5 ) ^ 2 ^ 3)
24577/8192

まとめ

今年のアドベントカレンダーで触れたいくつかの内容の実践編の一つとして, 中置記法で簡単な計算式を書けるマクロを提供するシステムを作りました.

皆さんのLisp生活に幸あれ.

操車場アルゴリズム - Wikipedia - ↩