コンディション
Common Lisp の「コンディション (condition)」は、ほかのプログラミング言語では「例外 (exception)」と呼ばれている機能です。例外はエラー処理で使われることがほとんどなので、「例外＝エラー処理」と考えてもらってもかまいません。最近では、例外処理機能を持っているプログラミング言語が多くなりました。今回はコンディションの基本的な使い方を簡単に説明します。
●例外処理
たとえば、1 から 100 までの 2 乗と 3 乗の値をファイルに書き込む処理を考えてみましょう。Ｃ言語でプログラムすると、次のようになります。
リスト : データの出力 (Ｃ言語)
#include <stdio.h>
#include <stdlib.h>
int main()
{
int i;
FILE *fp = fopen("test.dat", "w");
if (fp == NULL) {
fprintf(stderr, "test.dat をライトオープンできません\n");
exit(EXIT_FAILURE);
}
for (i = 1; i <= 100; i++) {
if(fprintf(fp, "%d, %d, %d\n", i, i * i, i * i * i ) < 0) {
fprintf(stderr, "データをライトできません\n");
exit(EXIT_FAILURE);
}
}
if (fclose( fp )) {
fprintf(stderr, "test.dat をクローズできません\n");
exit(EXIT_FAILURE);
}
return EXIT_SUCCESS;
}
Ｃ言語には例外処理がありません。このため、Ｃ言語では標準ライブライ関数を実行したときにエラーが発生した場合、エラーを表す値を返すようになっています。このプログラムでは、fopen でファイルをオープンするとき、fprintf でデータをファイルに書き込むとき、ファイルをクローズするときの 3 か所でエラーチェックを行っています。データを書き込む処理は簡単なのですが、エラーチェックが入っているためプログラムが読みにくくなっていますね。また、エラーチェックを忘れると、エラーが発生したときにプログラムは正常に動作しません。
このプログラムを Common Lisp で書くと次のようになります。
リスト : データの出力 (Common Lisp)
(defun main ()
(with-open-file (out "test.dat" :direction :output)
(do ((i 1 (1+ i)))
((> i 100))
(format out "~d, ~d, ~d~%" i (* i i) (* i i i)))))
エラーをチェックする処理がありませんね。これは例外処理が働いて、エラーが発生したらプログラムの実行が中断されるからです。例外処理のおかげで、プログラムをすっきりと書くことができます。
●コンディションの捕捉
しかしながら、エラーが発生するたびに実行を中断するのではなく、致命的なエラーでなければプログラムの実行を継続したい場合もあるでしょう。このような場合にこそ、例外処理が役に立つのです。Common Lisp では、発生したエラーを捕まえるマクロ handler-case が用意されています。
handler-case expression (type (var) forms) (type1 (var1) forms1) .....
handler-case は expression を実行し、その評価結果を返します。もし、expression の実行中にエラーが発生した場合、expression の実行は中断され、そのエラーが handler-case で指定したデータ型 (type) であれば、その節の forms を実行します。
Common Lisp の場合、エラーは「コンディション」というデータ型として定義されています。コンディションはプログラムの状態を表すデータ型で、エラーもその中のひとつなのです。また、Common Lisp では「エラーが発生した」とは言わないで、「コンディションが通知された」という表現をします。Common Lisp のコンディションは CLOS (Common Lisp Object System) のクラスを使って実装されています。
コンディションは Lisp システムからだけではなく、プログラムでコンディションを生成してそれを通知することができます。もちろん、通知されたコンディションは handler-case で捕まえることができます。つまり、コンディションはエラー処理以外にも活用することができるのです。基本的には catch & throw の大域脱出と同じなのですが、Lisp システムのエラーを処理できるように、便利な機能が組み込まれているわけです。
コンディションは階層構造になっています。その一部を 参考文献 2 より引用します。
コンディションはオブジェクト指向でいう「継承関係」になっています。handler-case に error を指定すれば、error 以下に定義されているコンディションをすべて捕まえることができます。
たとえば、0 で割ったときには division-by-zero が通知されますが、これは error や arithmetic-error で捕まえることができます。逆に、handler-case に divsion-by-zero を指定すれば、それ以外のエラーは捕捉されません。
●簡単な使用例
handler-case の使い方は簡単です。次の例を見てください。
* (handler-case (/ 10 0) (division-by-zero (c) c))
; in: HANDLER-CASE (/ 10 0)
; (/ 10 0)
;
; caught STYLE-WARNING:
; Lisp error during constant folding:
; arithmetic error DIVISION-BY-ZERO signalled
; Operation was (/ 10 0).
;
; compilation unit finished
; caught 1 STYLE-WARNING condition
#<DIVISION-BY-ZERO {1001BF39D3}>
0 で除算したので division-by-zero が通知され、それを handler-case で捕捉しています。変数 C にはコンディションがセットされ、その節の S 式が評価されます。この場合は変数 C にセットされたコンディションを返しているだけです。コンディションにはスロットが定義されていて、そこにエラー情報がセットされます。arithmetic-error の場合、次の関数でその値を取得することができます。
arithmetic-error-operation condition => symbol arithmetic-error-operands condition => list
* (handler-case (/ 10 0) (division-by-zero (c) (format t "~a, ~a~%" (arithmetic-error-operation c) (arithmetic-error-operands c)))) ; 省略 /, (10 0) NIL
その値から関数 / を評価したときに 0 で除算したことがわかります。ここで、(/ 10 0) の代わりに (/ 10 nil) を実行してください。
* (handler-case (/ 10 nil) (division-by-zero (c) c)) ; 省略 => エラー "Value of NIL in (/ 10 NIL) is NIL, not a NUMBER."
この場合、type-error が通知されますが、これは handler-case に設定されていないので、捕捉されずにエラーが表示されてデバッガが起動します。両方とも捕捉したい場合は、次のようにします。
* (handler-case (/ 10 nil) (division-by-zero (c) c) (type-error (c) c)) ; 省略 #<SIMPLE-TYPE-ERROR expected-type: NUMBER datum: NIL>
捕捉したいコンディションが複数ある場合は、それを続けて書けばいいわけです。まあ、個々にコンディションを設定するのは大変ですから、コンディションの継承関係を上手に活用してください。
●コンディションの通知
コンディションを通知する場合は関数 error を使うと簡単です。
error datum &rest args
error の一般的な使い方は引数 datum に書式文字列、args にその引数を渡します。
* (error "oops!! ~d~%" 123)
debugger invoked on a SIMPLE-ERROR in thread
#<THREAD "main thread" RUNNING {10005E85B3}>:
oops!! 123
・・・省略・・・
error によりデバッガが起動して、simple-error が通知されていることがわかります。このとき、引数 datum の書式文字列がエラーメッセージとして表示されます。また、引数 datum にコンディションを渡して呼び出すこともできます。次の例を見てください。
* (handler-case (error 'division-by-zero) (error (c) c))
#<DIVISION-BY-ZERO {1001FCC893}>
error の第 1 引数にコンディションを表す型指定子を与えると、そのコンディションを通知することができます。
コンディションのスロットに値をセットするときはキーワード引数を使います。
* (handler-case (error 'division-by-zero :operation '/ :operands '(100 0)) (division-by-zero (c) c))
#<DIVISION-BY-ZERO {1001F23213}>
関数 make-condition でコンディションを生成して error に渡すこともできす。
make-condition type &rest slot-initializations
* (make-condition 'division-by-zero :operation '/ :operands '(100 0))
#<DIVISION-BY-ZERO {100201F5F3}>
(handler-case (error (make-condition 'division-by-zero
:operation '/
:operands '(100 0)))
(error (c) c))
#<DIVISION-BY-ZERO {1002075463}>
make-condition はコンディションを生成するだけです。これを error に渡せばいいわけです。
関数 warn はデフォルトで simple-warning 型のコンディションを通知します。関数 signal はデフォルトで simple-condition 型のコンディションを通知します。
warn datum &rest args signal datum &rest args
warn はワーニング (警告) を表示して処理を続行します。signal はコンディションを通知するだけです。どちらの関数も返り値は NIL で、handler-case などでコンディションを捕捉することができます。
簡単な使用例を示します。
* (warn "oops")
WARNING: oops
NIL
* (handler-case (warn "oops") (warning (c) c))
#<SIMPLE-WARNING "oops" {1001DA1793}>
* (signal "oops")
NIL
* (handler-case (signal "oops") (condition (c) c))
#<SIMPLE-CONDITION "oops" {1001DF7A43}>
どちらの関数もデバッガは起動されません。引数 datum にはコンディションを渡すことができますが、warn の場合、warning 型以外のコンディションを渡すとエラーになります。
●コンディションの定義
コンディションはマクロ define-condition を使って、ユーザーが独自に定義することができます。
(define-condition name (parent-type) (slot-name ...) (option ...))
define-condition は CLOS でクラスを定義するマクロ defclass とよく似ています。name にはコンディションの名前、parent-type には上位のコンディション（いわゆるスーバークラス）、slot-name にはコンディション内のスロットを指定します。詳しい説明は お気楽 CLOS プログラミング入門 をお読みくださいませ。
option はいくつかありますが、その中で :report が重要です。handler-case でコンディションを捕捉しない場合、SBCL はエラーメッセージを表示してデバッガを起動します。オプション :report には、エラーメッセージを作成する関数を指定します。
それでは、簡単な使用例を示します。simple-error の下にコンディション foo-error を作りましょう。
リスト : コンディションの生成
(define-condition foo-error (simple-error)
((foo :initarg :foo :reader foo))
(:report (lambda (c s)
(format s "foo error: ~A" (foo c)))))
foo-error にはスロット foo を用意します。:report に設定された関数が呼び出される場合、第 1 引数にコンディションが、第 2 引数にストリームが渡されます。コンディションからデータを読み取って表示するメッセージを作成し、それをストリームに出力します。また、:report には単なる文字列を指定してもかまいません。その場合、エラーメッセージには指定した文字列が表示されます。
それでは実行してみましょう。
* (error (make-condition 'foo-error :foo "Oops!"))
debugger invoked on a FOO-ERROR in thread
#<THREAD "main thread" RUNNING {10005E85B3}>:
foo error: Oops!
・・・省略・・・
0]
きちんとエラーメッセージが表示されていますね。
●ignore-errors
マクロ ignore-errors はコンディション error を捕捉します。
ignore-errors form ...
ignore-errors は form を順番に評価し、途中でコンディション error が通知された場合は NIL と通知されたコンディションを返します。正常に終了した場合は、最後に評価した form の結果を返します。簡単な例を示しましょう。
* (ignore-errors (/ 10 2))
5
* (ignore-errors (/ 10 0))
; 省略
NIL
#<DIVISION-BY-ZERO {1001BF7ED3}>
* (ignore-errors (/ 10 nil))
; 省略
NIL
#<SIMPLE-TYPE-ERROR expected-type: NUMBER datum: NIL>
●handler-bind
コンディションの捕捉はマクロ handler-bind でも行うことができます。
handler-bind ((type (var) forms) (type1 (var1) forms1) ...) form ...
handler-bind は form を順番に実行し、最後に評価した form の結果を返します。もしも、form ... の実行中にエラーが発生した場合、form の実行は中断され、そのエラーが handler-bind で指定したデータ型 (type) であれば、その節の forms を実行します。
handler-case は forms の評価結果を返しますが、handler-bind は forms の評価が終了してもその結果を返しません。該当する type が複数ある場合、その節を順番に実行します。そして、さらに上位の handler-bind に制御が移るのです。最終的にはデバッガに制御が移ります。この連鎖を止めるには tagbody & go, block & return-from (return), catch & throw のどれかで handler-bind から脱出する必要があります。
簡単な例を示しましょう。
* (handler-bind ((error (lambda (c) (print c)))) (/ 10 0))
; 省略
#<DIVISION-BY-ZERO {1001CF6543}>
debugger invoked on a DIVISION-BY-ZERO in thread
#<THREAD "main thread" RUNNING {10005E85B3}>:
arithmetic error DIVISION-BY-ZERO signalled
Operation was (/ 10 0).
Type HELP for debugger help, or (SB-EXT:EXIT) to exit from SBCL.
restarts (invokable by number or by possibly-abbreviated name):
0: [ABORT] Exit debugger, returning to top level.
(SB-KERNEL::INTEGER-/-INTEGER 10 0)
0] a
* (block nil (handler-bind ((error (lambda (c) (print c) (return)))) (/ 10 0)))
; 省略
#<DIVISION-BY-ZERO {1001D41DB3}>
NIL
最初の例は handler-case から脱出していないのでデバッガが起動されます。次の例では、return で handler-case から脱出しているので、デバッガは起動されずに block の返り値 NIL が表示されます。
●再開
Common Lisp のコンディションには、エラーで中断した処理を再開 (再起動) する仕組みが用意されています。いろいろな方法があるようですが、プログラムの実行を継続する一番簡単な方法は関数 cerror を使うことでしょう。
cerror continue-format-string datum &rest args
cerror はデフォルトで simple-error を生成します。引数 datum と args は関数 error と同じです。cerror の場合、デバッガが起動されると再起動の選択欄に CONTINUE が表示されます。このとき、再起動の説明欄に第 1 引数の文字列が表示されます。そして、CONTIUNE を選択すると処理を継続することができます。
簡単な実行例を示します。
* (progn 1 (cerror "continue" "oops!!") 3)
debugger invoked on a SIMPLE-ERROR in thread
#<THREAD "main thread" RUNNING {10005E85B3}>:
oops!!
Type HELP for debugger help, or (SB-EXT:EXIT) to exit from SBCL.
restarts (invokable by number or by possibly-abbreviated name):
0: [CONTINUE] continue
1: [ABORT ] Exit debugger, returning to top level.
(SB-INT:SIMPLE-EVAL-IN-LEXENV (CERROR "continue" "oops!!") #<NULL-LEXENV>)
0] 0
3
progn の途中で cerror を評価します。すると、デバッガが起動されて再起動の選択肢に CONTINUE が追加されます。これを選ぶと progn の処理を継続して 3 を返します。また、handler-bind などで cerror が通知したコンディションを捕捉した場合、関数 contiune で処理を継続することができます。次の例を見てください。
* (handler-bind ((error (lambda (x) (continue x)))) 1 (cerror "continue" "oops!!") 3) 3
handler-case の本体は 1, (cerror ...), 3 で、cerror でエラーを通知しています。ここで、エラーを捕捉して関数 continue を評価します。すると、本体の処理が継続されて 3 を返すことができます。
●restart-case
もう一つ、マクロ restart-case を使う方法を紹介しましょう。
restart-case expression ((case-name arglist (keyword value) form ...) ...)
restart-case は expression を評価し、その結果を返します。途中でエラーが通知されて handler-bind などがそれを捕捉したとき、またはデバッガが起動したとき、restart-case で指定した再起動処理を呼び出すことができます。
case-name は再起動処理を表すシンボルです。デバッガが起動すると、再起動の選択欄に case-name が表示されます。arglist はラムダリストで、そのあとに特別なキーワード引数を指定することができます。再起動処理は form を順番に評価し、最後の評価結果が restart-case の返り値になります。
再起動処理は関数 invoke-restart で呼び出すことができます。
invoke-restart case-name args ...
invoke-restart の引数 args ... が再起動処理のラムダリスト arglist に渡されます。case-name はダイナミックスコープで管理されることに注意してください。
簡単な使用例を示します。
リスト : restart-case の使用例
(defun foo ()
(restart-case
(error "oops! foo error")
(use-new-value
(a)
:report "use new value"
:interactive (lambda ()
(format t "New value: ")
(finish-output)
(list (read)))
a)
(use-value-1
(&optional (a 1))
:report "use value 1"
a)))
(defun bar ()
(handler-bind
((error (lambda (c)
(declare (ignore c))
(invoke-restart 'use-new-value 123))))
(foo)))
(defun baz ()
(handler-bind
((error (lambda (c)
(declare (ignore c))
(invoke-restart 'use-value-1))))
(foo)))
use-new-value は引数 a をそのまま返します。キーワード引数 :report はデバッガが起動したとき再起動処理の説明文になります。:interactive にはユーザーの入力を受け付ける関数を指定します。デバッガで use-new-value を選択すると、:interactive で指定した関数が呼び出され、データを入力することができます。入力されたデータは use-new-value の引数 A に渡されます。
なお、:interactive の指定がない再起動処理をデバッガで選択すると、引数無しで再起動処理を呼び出します。たとえば、use-value-1 でラムダリストに (a) を指定した場合、デバッガで use-value-1 を選択すると引数の個数が合わずにエラーとなります。ご注意ください。
関数 bar と baz は foo を呼び出して、エラーを handler-bind で捕捉します。その中で invoke-restart を使って再起動処理を呼び出します。ラムダ式の引数 C は使わないので、(ignore c) で C を使用しないことを宣言しています。この宣言がないとワーニングが表示されます。
それでは実行してみましょう。
* (foo)
debugger invoked on a SIMPLE-ERROR in thread
#<THREAD "main thread" RUNNING {10005E85B3}>:
oops! foo error
Type HELP for debugger help, or (SB-EXT:EXIT) to exit from SBCL.
restarts (invokable by number or by possibly-abbreviated name):
0: [USE-NEW-VALUE] use new value
1: [USE-VALUE-1 ] use value 1
2: [ABORT ] Exit debugger, returning to top level.
(FOO)
source: (RESTART-CASE (ERROR "oops! foo error")
(USE-NEW-VALUE (A) :REPORT "use new value" :INTERACTIVE
(LAMBDA ()
(FORMAT T "New value: ")
(FINISH-OUTPUT)
(LIST (READ)))
A)
(USE-VALUE-1 (&OPTIONAL (A 1)) :REPORT "use value 1" A))
0] 0
New value: 1234
1234
* (bar)
123
* (baz)
1
●パズル Four Four's
それでは簡単な例題として、Puzzle DE Programming で取り上げた 数字のパズル : Four Four's を Common Lisp で解いてみましょう。
数字 4 を 4 つと＋,－,×,÷,( ,) を使って、答えが 1 から 10 になる式を作りなさい。数字は4 だけではなく、44 や 444 のように合体させてもよい。また、－を符号として使うことは禁止する。
●数式のパターン
Four Four's の場合、4 つの数値に 3 つの演算子しかありませんから、数式のパターンは簡単に求めることができます。数式を二分木で表すと、次に示す 5 つのパターンになります。
X, Y, Z が演算子を表します。これを式で表すと、次のようになります。
(1) (4 Y 4) X (4 Z 4) (2) 4 X (4 Y (4 Z 4)) (3) ((4 Z 4) Y 4) X 4 (4) 4 X ((4 Z 4) Y 4) (5) (4 Y (4 Z 4)) X 4
あとは、X, Y, Z に演算子 +, -, *, / を入れて数式を計算すればいいわけです。
Four Four's は数字を合体できるので、数字が 3 つで演算子が 2 つ、数字が 2 つで演算子がひとつ、というパターンもあります。演算子がひとつの場合は簡単ですね。演算子が 2 つの場合は、次の式になります。
(A) (a Y b) X c (B) a X (b Y c)
a, b, c が数字で X, Y が演算子を表しています。数字は 4 か 44 になります。この場合、a, b, c の組み合わせを生成する必要があります。組み合わせを (a, b, c) で表すと、(4, 4, 44), (4, 44, 4), (44, 4, 4) の 3 通りとなります。これと演算子の組み合わせにより数式を生成して、答えを求めてチェックします。
●プログラムの作成
数式の組み立てはバッククオートを使えば簡単です。プログラムは次のようになります。
リスト : 4 が 4 つの場合
(defun search-four ()
(let ((op '(+ - * /)))
(dolist (x op)
(dolist (y op)
(dolist (z op)
(dolist (expr `(((4 ,y 4) ,x (4 ,z 4))
(4 ,x (4 ,y (4 ,z 4)))
(((4 ,z 4) ,y 4) ,x 4)
(4 ,x ((4 ,z 4) ,y 4))
((4 ,y (4 ,z 4)) ,x 4)))
(eval-expr expr)))))))
演算子は変数 x, y, z にセットされているので、バッククオートの中ではコンマ ( , ) を使って変数を評価していることに注意してください。組み立てた数式の計算は関数 eval-expr で行います。
リスト : 数式の評価
(defun calc-expr (expr)
(cond
((numberp expr) expr)
((consp expr)
(funcall (second expr) (calc-expr (first expr)) (calc-expr (third expr))))
(t (error "invalid expression ~a" expr))))
(defun eval-expr (expr)
(let ((n (handler-case (calc-expr expr) (division-by-zero () 0))))
(when (and (integerp n) (<= 1 n 10))
(push expr (aref *table* n)))))
実際の計算は関数 calc-expr で行います。今回の数式はリスト (expr1 op expr2) で表されているので、再帰定義を使うと簡単に式を計算することができます。まず最初に、引数 EXPR が数値かチェックします。そうであれば、EXPR をそのまま返します。
次に、EXPR がリストの場合、第 1 要素が数式 expr1、第 2 要素が演算子 op 、第 3 要素が数式 expr2 になります。cacl-expr を再帰呼び出しして expr1 と expr2 を計算し、その値を演算子 op に渡して計算します。それ以外の場合は error でエラーを通知します。
数式を計算する場合、0 で除算するとエラーが発生します。そこで、eval-expr で calc-expr を呼び出すとき、handler-case で division-by-zero を捕捉したら 0 を返すようにします。結果は配列 *table* に格納します。これはスペシャル変数として定義します。
Common Lisp の場合、除算で割り切れない場合は分数になるので、述語 integerp で結果が整数値であることを確認します。あとは、結果が 1 以上 10 以下であれば、数式 expr を *table* に格納します。
あとは簡単なので説明は割愛させていただきます。詳細は プログラムリスト１ をお読みくださいませ。
●実行結果
プログラムを実行すると、全部で 100 通りの式が出力されます。このプログラムでは重複解のチェックを行っていないので、多数の式が出力されることに注意してください。1 から 10 までの数式をひとつずつ示しましょう。
((4 - 4) + (4 / 4)) = 1 ((4 / 4) + (4 / 4)) = 2 (((4 + 4) + 4) / 4) = 3 (4 + (4 * (4 - 4))) = 4 (((4 * 4) + 4) / 4) = 5 (((4 + 4) / 4) + 4) = 6 (4 + (4 - (4 / 4))) = 7 ((4 + 4) + (4 - 4)) = 8 ((4 + 4) + (4 / 4)) = 9 ((44 - 4) / 4) = 10
この中で、10 になる式は (44 - 4) / 4 しかありません。数字 4 を 4 つと＋, －, ×, ÷, ( , ) だけでは、10 になる式を作ることはできないのですね。
●前置記法と eval
Puzzle DE Programming では Perl を使いました。このときは文字列で数式を作成し、それを eval で評価しました。Common Lisp でも数式を S 式で組み立てれば、それを関数 eval で評価することができます。
私達がふつうに式を書く場合、1 + 2 のように演算子を真ん中に置きます。この書き方を「中置記法」といいます。Lisp の場合、演算子を前に置く「前置記法」で数式を表しています。これらの数式を前置記法で表すと、次のようになります。
(1) (4 Y 4) X (4 Z 4) => (X (Y 4 4) (Z 4 4)) (2) 4 X (4 Y (4 Z 4)) => (X 4 (Y 4 (Z 4 4))) (3) ((4 Z 4) Y 4) X 4 => (X (Y (Z 4 4) 4) 4) (4) 4 X ((4 Z 4) Y 4) => (X 4 (Y (Z 4 4) 4)) (5) (4 Y (4 Z 4)) X 4 => (X (Y 4 (Z 4 4)) 4)
演算子が 2 つの場合は、次の式になります。
(A) (a Y b) X c => (X (Y a b) c) (B) a X (b Y c) => (X a (Y b c))
このように数式を S 式で表すと、calc-expr のかわりに eval で数式を評価することができます。プログラムの説明は割愛するので、詳細は プログラムリスト２ をお読みください。数式の一例を示します。
(+ (- 4 4) (/ 4 4)) = 1 (+ (/ 4 4) (/ 4 4)) = 2 (/ (+ (+ 4 4) 4) 4) = 3 (+ 4 (* 4 (- 4 4))) = 4 (/ (+ (* 4 4) 4) 4) = 5 (+ (/ (+ 4 4) 4) 4) = 6 (+ 4 (- 4 (/ 4 4))) = 7 (+ (+ 4 4) (- 4 4)) = 8 (+ (+ 4 4) (/ 4 4)) = 9 (/ (- 44 4) 4) = 10 NIL
S 式をそのまま出力しているので、ちょっと読みにくいかもしれませんね。前置記法を中置記法に変換するプログラムは難しくないので、興味のある方は挑戦してみてください。
●プログラムリスト１
;;;
;;; fourfours1.lisp : Four Four's の解法
;;;
;;; Copyright (C) 2020 Makoto Hiroi
;;;
;;; 解を格納するテーブル
(defvar *table*)
;;; 式の評価
(defun calc-expr (expr)
(cond
((numberp expr) expr)
((consp expr)
(funcall (second expr) (calc-expr (first expr)) (calc-expr (third expr))))
(t (error "invalid expression ~a" expr))))
(defun eval-expr (expr)
(let ((n (handler-case (calc-expr expr) (division-by-zero () 0))))
(when (and (integerp n) (<= 1 n 10))
(push expr (aref *table* n)))))
;;; ４が４つある場合
(defun search-four ()
(let ((op '(+ - * /)))
(dolist (x op)
(dolist (y op)
(dolist (z op)
(dolist (expr `(((4 ,y 4) ,x (4 ,z 4))
(4 ,x (4 ,y (4 ,z 4)))
(((4 ,z 4) ,y 4) ,x 4)
(4 ,x ((4 ,z 4) ,y 4))
((4 ,y (4 ,z 4)) ,x 4)))
(eval-expr expr)))))))
;;; 数字が３つある場合
(defun search-three (a b c)
(let ((op '(+ - * /)))
(dolist (x op)
(dolist (y op)
(dolist (expr `(((,a ,y ,b) ,x ,c)
(,a ,x (,b ,y ,c))))
(eval-expr expr))))))
;;; 数字が２つある場合
(defun search-two (a b)
(let ((op '(+ - * /)))
(dolist (x op)
(eval-expr `(,a ,x ,b)))))
; 出力
(defun print-answer ()
(dotimes (x 11)
(dolist (expr (aref *table* x))
(format t "~s = ~d~%" expr x))))
;;; Four Four's の解法
(defun solver ()
(setq *table* (make-array 11 :initial-element nil))
(search-four)
(search-three 4 4 44)
(search-three 4 44 4)
(search-three 44 4 4)
(search-two 4 444)
(search-two 444 4)
(search-two 44 44)
(print-answer))
●プログラムリスト２
;;;
;;; fourfours2.lisp : Four Four's の解法
;;;
;;; Copyright (C) 2020 Makoto Hiroi
;;;
;;; 解を格納するテーブル
(defvar *table*)
;;; 式の評価
(defun eval-expr (expr)
(let ((n (handler-case (eval expr) (division-by-zero () 0))))
(when (and (integerp n) (<= 1 n 10))
(push expr (aref *table* n)))))
;;; ４が４つある場合
(defun search-four ()
(let ((op '(+ - * /)))
(dolist (x op)
(dolist (y op)
(dolist (z op)
(dolist (expr `((,x (,y 4 4) (,z 4 4))
(,x 4 (,y 4 (,z 4 4)))
(,x (,y (,z 4 4) 4) 4)
(,x 4 (,y (,z 4 4) 4))
(,x (,y 4 (,z 4 4)) 4)))
(eval-expr expr)))))))
;;; 数字が３つある場合
(defun search-three (a b c)
(let ((op '(+ - * /)))
(dolist (x op)
(dolist (y op)
(dolist (expr `((,x (,y ,a ,b) ,c)
(,x ,a (,y ,b ,c))))
(eval-expr expr))))))
;;; 数字が２つある場合
(defun search-two (a b)
(let ((op '(+ - * /)))
(dolist (x op)
(dolist (expr `((,x ,a ,b)))
(eval-expr expr)))))
; 出力
(defun print-answer ()
(dotimes (x 11)
(dolist (expr (aref *table* x))
(format t "~s = ~d~%" expr x))))
;;; Four Four's の解法
(defun solver ()
(setq *table* (make-array 11 :initial-element nil))
(search-four)
(search-three 4 4 44)
(search-three 4 44 4)
(search-three 44 4 4)
(search-two 4 444)
(search-two 444 4)
(search-two 44 44)
(print-answer))