👏

普段使いのマクロたち

2021/12/19に公開

Common Lisp

lisp

tech

(これは Lisp Advent Calendar 2021 19日目の記事です)

他の方のアドカレの記事で、溜めていたネタを供養するとか成仏させるとかいったものを幾つか目にして、自分にも2年以上放置プレイにしているLispのコードがあったことを思い出していました。ここに紹介されているLisp版StarTrekゲームをリファクタリングしていたのです(経緯は最終章に後述)。

それ自体はいわゆる習作なのですが、リファクタリングの際に使った 普段使いのマクロ などを気軽な読み物風に紹介してみるのはありかなと思い書いてみました。こういうマクロは今でこそ息をするように使っていますが、初心な頃にはどれも思いもつかなかったものです。
書いてみて技術情報がぜんぜん無いのに呆れましたが、Common Lispを使い出して日が浅い人とかのお役に立てば幸いに思います。

コードのありか等についてはやはり最終章に示しますが、以下ではリファクタリングしたコードのことをとりあえずRefactor版と呼ぶことにします。なお、記事中のコード片は説明との対応を分かりやすくするために実際のコードから変更している場合があります。

その1: aprog1

Refactor版では、aprog1を4箇所で使っています。
aprog1とは、anaphoric macro(前方照応マクロ)の一種で、つまり anaphoricな prog1というわけです。例で示すと、

  (aprog1 form-1 form-2 ... form-N)

と書くと、

  (let ((it form-1)) form-2 ... form-N it)

と書いたのと同じ意味になります。ここで、form-2 から form-N の中で、form-1の評価結果が束縛された $\textcolor{red}{it}$ という変数を使うことが想定されています。

anaphoric macro はどれも、マクロ展開前は見えていない主役の変数が水面下で束縛されるという気持ち悪さがありますが、使っていると意外に慣れます。「それ」が何を指すのかを分かりやすく表現できるかがキモみたいです。loopマクロで使っている例なんかは、普通の英語みたいですね。

Refactor版で使われているaprog1の場合、その意味するところは、

arrayやstructの初期化
契約プログラミングの事後条件

の2種類でした。

最初の例について見てみます:

  (setq *klingons*
        (aprog1 (make-array +max-n-klingon+)
          (map-into it #'make-klingon))))

  (setq *quadrants*
        (aprog1 (make-array '(8 8))
          (loop for i from 0 below 8 do
            (loop for j from 0 below 8
                  ...
                  do (setf (aref it i j) (make-quadrant :n-klingon k ...))))))

  (setq *sec*
        (aprog1 (make-sector :smap (make-array '(8 8) :initial-element nil) ...)
          ...
          (init-sec-klingons it k)
          (init-sec-bases it b)
          (init-sec-stars it s)))

どれも同じようなパターンですね。

この例で何が嬉しいかというと、生成したarrayやstructを変数に代入する、という幹になる処理が最初にデンと配置されて、それからarrayやstructの内容の初期化処理が奥ゆかしく一段下げて配置されることによって、後者の処理が従属的なものであることが分かりやすく表現されることです。it のスコープも、この一段下がっているところに限定されているのがよろしい。
もしaprog1を使わずに、上例の3つの式に現れる処理を同じようなインデントレベルで書かれると、個々の処理の影響範囲がどこからどこまであるのか少し目を凝らしてみないと分かりづらくなる場合もありそうです。

なので、aprog1のフォーム全体はここで挙げたような感じのインデントにすべきですが、これはprog1の標準的なインデントと同じです。
emacsをお使いの方は、cl-indent.elの定義にhookか何かで

  (cl-indent 'aprog1 'prog1)

という定義を加えておきましょう。
Lispプログラマたるもの、手作業でコードのインデントを調整したりはしません(筈なんですが )。

arrayやstructの初期化でこういう事例が現れやすいのは、make-arrayやmake-structには make-instanceのinitformキーワードに相当するものが無くて、CLOSのobjectを生成するときのような自由度の高い初期化ができないからでしょう。

次に事後条件の例について見てみます:

  (defun input-course (crew)
    (flet ((input-course-1 ()   ; ユーザのキー入力に応じて実数を返す内部関数の定義
             ...))
      ;; input-course-1 の返り値が input-courseの返り値になる
      (aprog1 (input-course-1)
        ;; 事後条件として、返り値はnullか 0以上8未満であることを示す
        (assert (or (null it) (and (<= 0 it) (< it 8)))))))))

ここでも主役の内部関数の呼び出しが目立っていて、事後条件は奥ゆかしく字下げされています。事後条件の記述には返り値自体が必要になることが多いため、関数の返り値を表す最後の式が関数呼び出しである場合は aprog1 が役に立ちそうです。

aprog1は機能的にはたいして新しいものを提供しておらず、毒にも薬にもならないマクロといえますが、カッコだらけで見づらいと言われるLispのコードの中にあって、ある種の認知負荷を下げる効果があるのだと思います。

何を隠そう Common Lispのオペレータの中で私が一番好きなものは aprog1 です。
この記事のタイトルも、最初

$\textcolor{red}{諸君、私はaprog1が好きだ!}$

にしたかったのですが、それでは何のことだか分からないので、泣く泣く現在のタイトルにしました。

aprog1という名前も少しヘンテコリンですが、Lispプログラミングに親しんでprog1の仕様に馴染み、いくつかある anaphoric macro のどれか1つでも知ったなら、誰でもaprog1という名前に対して

  (defmacro aprog1 (f &body fs) `(let ((it ,f)) ,@fs it))

のような定義が思い浮かぶことでしょう。今でこそ著名なLispのパッケージ(Anaphora)にも含まれている aprog1ですが、自分も aif や awhen を知った頃から、思いつきで自作して使っていました。

その2: and-let*

anaphoric macroの1つとして、aand (anaphoric and)というものを考えることができますが、aandの名前から思い浮かぶ仕様は、実はaprog1ほど自明ではありません。

実際、前述のOnLispと Anaphoraとでは定義が異なっています。なんてこった。

例えば、以下のようなaand式があったとしますと:

  (aand form1 form2 form3 ...)

OnLispのaandでは、form1とform2の値がいずれもnon-nilとなってform3を実行しているときは、最後にテストが成功したform2の値がitに束縛されているのに対して、Anaphoraのaandでは常に最初のテスト式であるform1の結果がitに束縛されているのです。

個人的にはどちらの立場も分かるのですが、どっちなのか分かりにくいのは困ります。また、2つ以上のテスト式の結果を束縛しておきたいこともあります。それなら最初からそういう機能をもったマクロがあれば良いわけで、それが and-let* です。

and-let* の説明は、gaucheのマニュアルが詳しくて、かつ分かりやすいです。

Refactor版の中では、and-let*を1個所だけ使っています。

  ;; 元のコードは、だいたいこんな感じ
  (defun nav()
    (let (c1 n w1)
      (when (not (setq c1 (input-course "LT. SULU"))) (return-from nav))
      (when (not (setq w1 (input-nav-factor)))        (return-from nav))
      (when (not (setq n  (determine-nav-energy w1))) (return-from nav))
      (klingon-attack-at-warp)
      (repair-for-warp w1)
      (damage-by-warp)
      (when (not (nav4 c1 n w1)) (return-from nav))
      (warp-time w1)))

  ;; 対応する Refactor版のコード
  (defun nav ()
    (and-let* ((c1 (input-course "LT. SULU"))
               (w1 (input-nav-factor))
               (n  (determine-nav-energy w1)))
      (klingon-attack-at-warp)
      (repair-for-warp w1)
      (damage-by-warp)
      (when (nav4 c1 n w1)
        (warp-time w1))))

ここで示した and-let*フォームは、c1, w1, n に順に束縛される値がどれか一つでもnil になると、その時点で残りの束縛部や本体部分の実行はせずにnilを返します。記述がスッキリして小さくまとまった結果、分かりやすくなっている... それでこそマクロを使う価値があるというものでしょう。

and-let* の定義は、自分が書いたものをRefactor版の冒頭に置いて使っています。

その3: with-accessors+

with-accessors+ は標準のビルトインマクロwith-accessorsに少しだけ毛が生えたようなマクロで、私の思いつきで定義して使っているものです。
やっていることは非常に単純で、

  ;; 展開前
  (with-accessors+ (hoge (fuga piya)) expr
    body-expr ...)

  ;; macroexpand-1後
  (with-accessors ((hoge hoge) (fuga piyo)) expr
    body-expr ...)

ということです。つまり、with-accessorsの束縛部に現れる slot-entry は

  (variable-name accessor-function-name)

という形式でなくてはいけませんが、with-accessors+のslot-entryは accessor-function-nameだけの単一シンボルでも構いません。with-accessors+ のマクロフォームを展開する際、単一シンボルのslot-entryが現れると「同じ名前の」variable-nameを補ってwith-accessorsの形式に変換します。

さて、with-accessors+ は Refactor版で多用していますが、具体的には、

  (with-accessor+ (<使用するスロット名> ...) <defstructオブジェクト>
    <本体部分>
    )

という形で、<本体部分> にオブジェクト指向言語のメソッドっぽいものを書くような使い方をしています。
例を示しましょう:

  (defstruct (enterprise (:conc-name ep-))
    qcoord spos condi docked-p torpedo energy shield damage-arr ...)

  (defun dec-energy (n)
    (with-accessors+ (ep-energy ep-shield) *ep*
      (when (minusp (decf ep-energy (+ n 10)))
        (msg "SHIELD CONTROL SUPPLIES ENERGY TO COMPLETE THE MANEUVER.~%")
        (setf ep-shield (max 0 (+ ep-shield ep-energy))
              ep-energy 0))))

with-accessors+ や with-accessors を使わなければ、最後のsetfのところは

  (setf (ep-shield *ep*) (max 0 (ep-shield *ep*) (ep-energy *ep*))
        (ep-energy *ep*) 0)

のように少しゴテゴテと書くことになります。また、with-accessors+ を使うことによって、dec-energyの2行目を

  (with-accessors ((ep-energy ep-energy) (ep-shield ep-shield)) *ep*

のように書かなくて良くなっています。
なお、Common Lispの標準仕様では with-accessorsはCLOSの章で定義されていますが、定義の内容から defstructオブジェクトにwith-accessorsを使えない理由は無さそうですし、SBCLではちゃんと使えています。

オブジェクト指向のメソッドを書くのに、使用するスロット名を毎回書かなければいけないのは面倒くさいと感じる方もいるでしょうが、そのようにした方が <本体部分> のコードで参照したり変更したりするスロットが判って良いという考え方もあります。例えば、最初からそのようにメソッドの構文を規定しているLisp系言語もあります。

その4: with-simple-restart

Lisp版StarTrekの元の版では、2次元座標の値をユーザに入力させる場合、X座標とY座標をそれぞれ入力させていましたが、Refactor版では(X座標 Y座標)というリスト形式で、一まとまりの値として入力させるようにしました。内部の処理でもできるだけ一まとまりの値として扱うように変更したからです。
入力処理の最深部では標準のS式入力関数 READ を無引数で使っていましたが、この関数はリストの構文を間違えるとエラーを通知することがあり、ミスタイプなどによるエラーが元の版以上に発生しやすくなっていました。

元の版のままの作りだと、エラーが通知されるとデバッガに入って以下のような表示が行われることでしょう。この例では、Restartsと書かれたところに書いてある番号(0-2)のいずれかをタイプすることで、対応する位置まで戻って処理を再開してくれます。問題は再び座標値の入力処理に戻れるのではなく、もっと前のところ(REPLとか)しか戻り先の選択肢が無いことです。
はるばる宇宙を旅してきたのに最初からやり直せだと〜 (ﾉ`□´)ﾉ⌒┻━┻

  The value
    T
  is not of type
    STREAM
  when binding STREAM
     [Condition of type TYPE-ERROR]

  Restarts:
   0: [RETRY] Retry SLIME REPL evaluation request.
   1: [*ABORT] Return to SLIME's top level.
   2: [ABORT] abort thread (#<THREAD "repl-thread" RUNNING {10016A9DE3}>)

  Backtrace:
    0: (SB-INT:SIMPLE-READER-ERROR T "dot context error") [more]
    1: (SB-IMPL::READ-TOKEN T #\.)
    2: (SB-IMPL::READ-MAYBE-NOTHING T #\.)
    3: (SB-IMPL::READ-AFTER-DOT T #\. -1)
    4: (SB-IMPL::READ-LIST T #<unused argument>)
    5: (SB-IMPL::READ-MAYBE-NOTHING T #\()
    6: (SB-IMPL::%READ-PRESERVING-WHITESPACE T T (NIL) T)
    7: (SB-IMPL::%READ-PRESERVING-WHITESPACE T T (NIL) NIL)
    8: (READ T T NIL NIL)
    9: (COMP-CALC)
   10: (COMPUTER)
   11: (MISSION-LOOP)
   12: (CARRY-OUT-MISSION)
   13: (TREK NIL)
   14: (SB-INT:SIMPLE-EVAL-IN-LEXENV (TREK) #<NULL-LEXENV>)
   15: (EVAL (TREK))
   --more--

こういう場合のために、Common LispにはアプリケーションにRestartポイントを追加する機能が備わっています。Restartの追加には簡易な方法と本格的な方法とがあり、簡易な方法は標準のビルトインマクロwith-simple-restartを使うことです。

Refactor版では、関数READの代わりに以下のwrapper(関数READ-INPUT)を使っています:

  (defun read-input (prompt &key (restart-format "Input again") checker)
    (flet ((fn (x) (if (funcall (or checker #'identity) x) x)))
      (loop
        (with-simple-restart (try-again restart-format)
          (awhen (funcall #'fn (read-with-prompt prompt))
            (return it))))))

READ-INPUTの中で呼び出している関数READ-WITH-PROMPTは、引数promptで指定された文字列を出力することを除いてほぼ関数READと同じです。キーワード引数checkerは、READ-WITH-PROMPTが返した値に対して、更にアプリケーション依存のチェックを行ってダメならnilを返す関数です。

READ-INPUTを使うと、エラーが起こった場合のデバッガのRestarts部分の表示が以下のように変わります:

  Restarts:
   0: [TRY-AGAIN] Input again
   1: [RETRY] Retry SLIME REPL evaluation request.
   2: [*ABORT] Return to SLIME's top level.
   3: [ABORT] abort thread (#<THREAD "repl-thread" RUNNING {10016A9DE3}>)

一番上に再入力のエントリが追加されていますね。これが with-simple-restart の効果です。
ここで 0番を選ぶと、READ-INPUTのwith-simple-restartから制御が返ってきますので、その周りに配置されたloopにしたがって、再度の入力処理を行うことができます。

Restartは、Common Lispの特徴的な機能の一つである condition system の一部として規定されています。condition system の他の部分も参照しながら、with-simple-restart周りの動作をもう少し説明してみます:

with-simple-restartフォームを実行すると、Restartポイントを生成して実行時の動的環境に加えてから、本体部分にあたるサブフォーム(上例ではawhenフォーム)を実行します。
生成されたRestartポイントはサブフォームの実行の間だけ有効です(これが動的環境の意味です)。
デバッガの助けを借りずに、加えられたRestartポイント(つまりwith-simple-restartの続き)からプログラムによって再実行をさせたければ、通知されるエラーのハンドラを定義すればできます。そのハンドラに、生成されたRestartからの再実行指示を記述すればよいのです。
上例ではハンドラを定義していないので、condition system はエラーに対応するハンドラを見つけることができません。この場合、エラーの通知処理はデバッガを起動するので、起動されたデバッガから現在の動的環境で利用可能なRestartが選択できるようになったというわけです。

今回はターミナルI/Fを使ったCLIのゲームだし「これくらいにしといたろ」といったところですが、こんな感じで滅多に起こらないエラーにはとりあえず簡易なRestart処理を加えておくという対応(またの名を手抜き)はお手軽で重宝することがあります。

その5(番外): format関数

マクロではないですし、息をするように使っているわけでもないのですが、Refactor版の作成過程では FORMAT関数の仕様を久しぶりにあれこれ眺めて楽しんだ気がします。CLHSやCLtL2はもちろんですが、ここの日本語サイトには大変お世話になりました。

本格的なアプリケーションはともかく、普段はあんまり見ないよなぁという感じの例を一つ挙げてみましょう:

  (format t " ~a~:* KLINGON~:@(~p~) LEFT.~%" *klingon-total*)

ここで最初の~a は引数 *klingon-total* で与えられる整数を表示する意味ですが、~:* は消費したばかりの引数を一つ戻す意味、~:@(...) は、... の文字列をupcaseにする意味、そして ~p は引数が1以外なら複数形の "s" を出す意味です。引数が 0 のとき複数形の扱いになるのは非英語圏生活者には味わい深い。

複数形を出す機能は頭の片隅にはありましたが、今回初めて使うことができました。長生きはしてみるものです。

おわりに

本記事に関連するコードは、このgistエントリにあります。

また、ここに挙げたものを含む個人的なCommon Lispのtiny utilitiesを束ねたものが、このgistエントリにあります。

Refactor版を作り始めたきっかけは、実はFORTH言語を使って、ほどほどに本格的でありながら短く書けるターミナル版ゲームの事例を探していたことでした。

今からでもRefactor版をFORTHに移植すると、オーバーレイは要るかもしれないが、FORTH処理系込みでもRAM 16KB程度あれば Single Board Computerで動かせるのではないでしょうか。私はやっていることの割に簡潔で、かつ(ゴルフ的な意味でなく)短いコードが好きなのです。
題材としてStarTrekが良い気がして、まずここのFORTHのコードを見つけたのですが、読み易さや簡潔さといった自分の観点からは少し残念感がありました。

その後に着目したのがtakeokaさんのLisp版でした。最初はFORTHに移植する気でいたのだが、グローバル変数が多くて内容を理解しづらいところがあったため(行番号BASICのプログラムを元に作られ始めたものなので不思議ではない)、理解することを目的に自分風に書き換え始めました。
しかし、6〜7割ほど書いて理解が進むと、コードサイズに占める割合はストーリーを示すテキスト部分が大きいことに加えて、コード部分をFORTHにすることよる妙味をさほど出せないと悟り、熱が冷めてお蔵入りになっていました。

今回、残作業を仕上げるためにtakeoka版を久しぶりに眺めると、非常に直截的で持って回ったところが無く、理解は容易でした。事前情報の有無の差は大きいですね。初見だとまた違うのだろうか。

Refactor版と元のコードの違いとしては、見かけのグローバル変数の数を減らしたことのほかに、個々のtop-level formが完全にボトムアップになっていることを挙げられます。
後者はFORTHへの移植を指向して書かれたことの副作用です。
つまり、Refactor版ではtop-level formを上から順に一つずつREPLに与えた場合でも、前方参照のWarningやErrorが一つも出ないようになっているのです。Common Lispではファイル等の一緒にコンパイルする単位内では前方参照の制限が緩められているので、普通はそこまではしなくてもよいのですね。

ボトムアップというと、Lispプログラマはこの文書に思いあたる人も多いと思います。
今回は最初からボトムアップにデザインをしたわけではないですし、テキストのアドベンチャゲームという性質上、汎用と専用が多少は混濁するのはしかたないかもしれませんが、それでも今回の記事に挙げたマクロ等の他にいくつかの汎用オペレータを冒頭のutilities辺りに切り出すこととなりました。

本稿が皆様のLisp Lifeにどこかでお役に立てば幸いです。