概要
基本的に Emacs Lisp (または、Lisp 自体)をあまり知らない方向けです。
Emacs Lisp でどんなコードが書けるのかを知って、興味を持ってもらえればと書きました。
さて、Lisp はマクロで構文を拡張出来る事が特徴ですが、もちろん Emacs Lisp も例外ではなく、フィボナッチ関数を色々な書き方で実装する事が出来ます。
今回は、それ以外にも、ジェネレータ版、遅延評価版、果てはスタックマシーンのコードを直接記述する方法まで、取り揃えました。
(それぞれの関数は、簡単の為、引数に負の値が指定されない事を前提にしています。)
内訳は以下の通りです。
-
再帰呼び出し系
-
fib-tail-recursion -
fib-double-recursion -
ループ系 (マクロを展開すると結局は同じ様なコードになるけど、色々な書き方が出来る)
-
fib-while -
fib-dotimes -
fib-cl-loop -
fib-cl-do -
無限リスト系
-
fib-generator -
fib-stream -
スタックマシーン系
-
fib-lapcode
コードはここにありますが、記事内にほとんどが記載されているので、特に取得する必要は無いです。
それでは、コードをご覧ください。
コード
1. 末尾再帰版
(defun fib-tail-recursion (n)
"末尾再帰版"
(cl-labels ((rec (a b n)
(if (zerop n)
a
(rec b (+ a b) (1- n))))) ; (1- n) は (- n 1) と同じ
(rec 0 1 n)))
関数型言語では明示的なループ命令を使わず、再帰呼び出しでループを行います。
再帰呼び出しであれば、変数への再代入も少なく出来ます。
上記のコードでは、ループ毎に関数の引数に一度だけバインドされるのみです。
なので、このコードが最も良いコードになるでしょう。
しかしながら、Emacs Lisp では末尾呼び出しの最適化(TCO: Tail Call Optimization)がされず、nが大き過ぎるとスタックが溢れてエラーで終了します…残念。
2. 二重再帰版
(defun fib-double-recursion (n)
"二重再帰版"
(if (< n 2)
n
(+ (fib-double-recursion (1- n)) (fib-double-recursion (- n 2)))))
滅茶苦茶重くて、ベンチマークで使われるのは大体これです。
末尾再帰版と比べて補助関数が無く、変数もnしか使ってないので綺麗なコードです。
ただ、1回の再帰呼び出しが2回の再帰呼び出しを引き起こすので、関数呼び出し回数がねずみ算式に増えます。
(fib-double-recursion 30) => 832040 の場合で、2,692,537回(！)も呼び出されています。
3. while 版
(defun fib-while (n)
"while 版"
(let ((a 0)
(b 1))
(while (/= n 0)
(cl-psetq a b
b (+ a b))
(cl-decf n))
a))
whileを使うと一気に Emacs Lisp らしくなります(笑)。
変数への再代入も沢山行われています。
パッと見で、バグが多くなりそうなコードをしています。
しかし、Emacs Lisp では、これが一番実行速度が速くなります。
cl-psetqはマクロですが、パラレルsetqと言って、b (+ a b)のaはbを代入する前の値になります。
(defun fib-while (n)
"while 版 (マクロ展開後)"
(let ((a 0)
(b 1))
(while (/= n 0)
(setq a (prog1 b (setq b (+ a b))))
(setq n (1- n)))
a))
4. dotimes 版
(defun fib-dotimes (n)
"dotimes 版"
(let ((a 0)
(b 1))
(dotimes (_ n) ; ループ変数は使わないので`_'にして未使用の警告を抑制する
(cl-psetq a b
b (+ a b)))
a))
while 版とほぼ一緒ですが、単純なループはwhileよりdotimesを使います。
これにより、nに関する処理を書かなくて済む分、よりバグが発生しにくいコードになります。
マクロは、このように典型的な処理を隠蔽する事が、主な役割になります。
マクロ展開後はどうしても冗長な記述が増えてしまいますが、バイトコンパイラの最適化で削除される事もあるので、それほど気にする必要はありません。
(defun fib-dotimes (n)
"dotimes 版 (マクロ展開後)"
(let ((a 0)
(b 1))
(let ((--dotimes-limit-- n)
(--dotimes-counter-- 0))
(while (< --dotimes-counter-- --dotimes-limit--)
(let ((_ --dotimes-counter--))
(progn
(setq a (prog1 b (setq b (+ a b))))
nil))
(setq --dotimes-counter-- (1+ --dotimes-counter--))))
a))
5. cl-loop 版
(defun fib-cl-loop (n)
"cl-loop 版"
(cl-loop repeat n
for a = 0 then b
and b = 1 then (+ a b)
finally (return a)))
cl-loopは、それ自体が別の言語と言われる、とても多機能なマクロです。
上記のコードの様に、構文が全く Lisp らしくないので、直感的に書けず学習コストが高いのですが、覚えれば非常に便利なツールになります。
自分も好んで使っています。
可読性が高くなる事もメリットでしょう。
マクロ展開後のコードと見比べてみてください。
C 言語のマクロとは次元の違うコードに変形出来る事が、Lisp のマクロが強力と言われるゆえんです。
(defun fib-cl-loop (n)
"cl-loop 版 (マクロ展開後)"
(let* ((#:--cl-var-- n))
(let ((a nil)
(b nil))
(let* ((#:--cl-var-- t))
(while (>= (setq #:--cl-var-- (1- #:--cl-var--)) 0)
(progn
(setq a (if #:--cl-var-- 0 a)
b (if #:--cl-var-- 1 b))
nil)
(progn
(setq a (prog1 b (setq b (+ a b))))
nil)
(setq #:--cl-var-- nil))
a))))
6. cl-do 版
(defun fib-cl-do (n)
"cl-do 版"
(cl-do ((a 0 b)
(b 1 (+ a b)))
((zerop n) a)
(cl-decf n)))
(defun fib-cl-do (n)
"cl-do 版 (n を初期化フォームに書くやり方)"
(cl-do ((a 0 b)
(b 1 (+ a b))
(n n (1- n)))
((zerop n) a)))
Emacs Lisper は、あまりcl-doを使わないですが、こちらはcl-loopと違い Lisp っぽい見た目になっています。
こちらを好んで使う人もいるでしょう。
今回に関しては、かなり綺麗に書けてます。
ちなみに、(zerop n)は終了条件ですが、これが「真」になった時点で終了します。
whileが真の間ループが回るのとは逆なので、ハマりどころでもあります…。
nを初期化フォームに書くやり方もあります。
(defun fib-cl-do (n)
"cl-do 版 (マクロ展開後)"
(let ((a 0)
(b 1))
(while (not (= 0 n))
(setq n (1- n))
(progn
(setq a (prog1 b (setq b (+ a b))))
nil))
a))
(defun fib-cl-do (n)
"cl-do 版 (n を初期化フォームに書くやり方) (マクロ展開後)"
(let ((a 0)
(b 1)
(n n))
(while (not (= 0 n))
(progn
(setq a (prog1 b (setq b (prog1 (+ a b)
(setq n (1- n))))))
nil))
a))
7. generator 版
(require 'generator)
(iter-defun fib-generator ()
"generator 版"
(let ((a 0)
(b 1))
(while t
(iter-yield a)
(cl-psetq a b
b (+ a b)))))
Emacs 25 から標準添付されるようになった、ジェネレータ(generator.el)を使ったコードです。
他の言語のジェネレータと同様に(iter-yield a)で値を返して関数を抜けますが、次に呼び出した時はその直後から再開出来ます。
fib-generator自体はイテレータを返すだけで、(iter-next iter)を使って値を取得します。
しかしながら、generator.el はイテレータがiter-end-of-sequenceという例外を投げるので、必ずこれをハンドリングしておかなければならず、若干手間が掛かります。(fib-generatorは終了しないので不要)
なので、cl-loopを使った方が簡単にイテレート出来て良いです。
イテレートの例
(let ((iter (fib-generator)))
(print (iter-next iter))
(print (iter-next iter))
(print (iter-next iter))
(print (iter-next iter)))
0
1
1
2
(cl-loop repeat 20
for i iter-by (fib-generator)
collect i)
=> (0 1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181)
さて、ジェネレータはどのように実装されているかというと、これもマクロの妙技を使用してCPS(Continuation Passing Style)変換を行い実現しています。
CPS 変換については検索すると沢山出てきます。
早い話が、コードを実行順に切り出して、ちょっとずつ実行出来るようにする事です。
ちなみに、継続(1引数関数)を呼び出すようなコードになってないじゃないかと思うかもしれませんが、そうすると、途中で止める事が出来なくなるので、いったん変数に代入する形になります。
current-stateが継続、current-valueが引数に相当します。
以下はfib-generatorをマクロ展開した内容ですが、残念ながら generator.el は非常に冗長なコードを出力するので、自分でコードを整形し無駄な部分を削除しています。
いじってはいますが、ちゃんと動くコードですし、処理内容もほぼ一緒です。
iter2という代替パッケージが MELPA にあります。こちらを使えばより最適化されたコードを生成出来ます。
(defun fib-generator ()
"generator 版 (マクロ展開後)"
(let ((a 0)
(b 1)
current-state
current-value
state-terminal
state-atom-1
state-atom-2
state-iter-yield
state-atom-3
state-while)
(setq state-terminal (lambda ()
(signal 'iter-end-of-sequence current-value)))
(setq state-atom-1 (lambda ()
(setq current-value (prog1 t
(setq current-state state-while)))))
(setq state-atom-2 (lambda ()
(setq current-value (prog1 (cl-psetq a b
b (+ a b))
(setq current-state state-atom-1)))))
(setq state-iter-yield (lambda ()
(setq current-state state-atom-2)
(throw 'yield current-value)))
(setq state-atom-3 (lambda ()
(setq current-value (prog1 a
(setq current-state state-iter-yield)))))
(setq state-while (lambda ()
(setq current-state (if current-value
state-atom-3
state-terminal))))
(setq current-state state-atom-1)
(let ((iterator (lambda (op value)
(cond
((eq op :close)
(setq current-state state-terminal)
(setq current-value nil))
((eq op :next)
(setq current-value value)
(let ((yielded nil))
(unwind-protect
(prog1 (catch 'yield
(while t
(funcall current-state)))
(setq yielded t))
(if yielded
nil
(setq current-state state-terminal)
(setq current-value nil)))))
(t (error "unknown iterator operation %S" op))))))
iterator)))
8. 遅延評価(stream)版
(require 'stream)
(defun fib-stream ()
"遅延評価(stream)版"
(cl-labels ((rec (a b)
(stream-cons (+ a b)
(rec b (+ a b)))))
(stream-cons 0 (stream-cons 1 (rec 0 1)))))
遅延評価版はfib-tail-recursionに似てますが、終了判定を書く必要がありません。
概念的には無限リストを生成している事になります。(遅延評価イコール無限リストでは無いですが)
seq.el は Emacs Lisp 用のシーケンス(リストやベクター等)を統一的に扱う関数群ですが、cl-defgenericを使って定義されているので、stream.el が無限リスト用に各関数をオーバーロードしています。
なので、無限リストもseq-take等で扱う事が出来ます。
stream.el は MELPA からインストール出来ます。
ちなみに、無限リストを生成して嬉しい事例があるかというと、正直全然思いつきません(汗)。
一応用途としては、リストを生成したいが事前に生成するには重過ぎるもの、という事になります。
しかし、いったん無限リストを生成出来れば、seq-mapやseq-reduce,seq-filter等を駆使して関数プログラミングを行えるので、非常に信頼性の高いコードになるはずです。
以下、使い方。
2つ目の例は、偶数のフィルターを通してから10個を取得してますが、何という美しいコードなのでしょうか！
常にこんなコードを書いていたいものです。(書いてないですが…(滝汗))
(seq-into (seq-take (fib-stream) 20) 'list)
=> (0 1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181)
(seq-into (seq-take (seq-filter #'cl-evenp (fib-stream)) 10) 'list)
=> (0 2 8 34 144 610 2584 10946 46368 196418)
9. lapcode 版
(defalias 'fib-lapcode
(make-byte-code
#x101 ;; 必須引数1つ
(let ((tag1 (byte-compile-make-tag))
(tag2 (byte-compile-make-tag)))
;; tag1 は (TAG 1) というただのリストだが、lapcode に直接書いてはいけない！
;; tag の比較には eq が使われているので、このようにする必要がある。
(byte-compile-lapcode
;; lapcode
`((byte-constant . 0) ;; この 0 は定数のゼロではなくて定数ベクターのインデックス
(byte-constant . 1)
,tag1
(byte-stack-ref . 2) ;; スタックトップ(以下 TOP) + 2 にある値をスタックに積む
(byte-constant . 0)
(byte-eqlsign . 0) ;; TOP から2つの値を = で比較して結果をスタックに積む
(byte-goto-if-not-nil . ,tag2) ;; TOP の値が nil で無い場合はタグへジャンプする
(byte-dup . 0) ;; TOP の値をスタックに積む (複製する)
(byte-stack-ref . 2)
(byte-stack-ref . 2)
(byte-plus . 0) ;; TOP から2つの値を + で計算して結果をスタックに積む
(byte-stack-set . 2) ;; TOP の値を TOP + 2 の位置に書き込む
(byte-stack-set . 2)
(byte-stack-ref . 2)
(byte-sub1 . 0) ;; TOP の値から 1 を引いて結果をスタックに積む
(byte-stack-set . 3)
(byte-goto . ,tag1) ;; 指定のタグへジャンプする
,tag2
(byte-stack-ref . 1)
(byte-return . 0)))) ;; TOP の値を戻り値として関数から抜ける
[0 1] ;; 定数ベクター
6) ;; 最大スタック使用量
"lapcode 版")
lapcode(LAP: Lisp Assembly Program)を使用して、スタックマシーンである Emacs のバイトコードインタプリタのコードを直接書き、それをbyte-compile-lapcodeでバイトコード(バイナリが含まれる文字列)に変換します。
make-byte-codeがバイトコード文字列と幾つかの引数を使って、バイトコードオブジェクトを生成します。
アルゴリズムは while 版をマクロ展開したものと同等です。
まず、以下の様にfib-whileをバイトコンパイルしてディスアセンブルすると、
(disassemble (byte-compile '(defun fib-while (n)
"while 版 (マクロ展開後)"
(let ((a 0)
(b 1))
(while (/= n 0)
(setq a (prog1 b (setq b (+ a b))))
(setq n (1- n)))
a))))
以下の結果を得ます。
byte code:
args: nil
0 constant defalias
1 constant fib-while
2 constant <compiled-function>
doc: while 版 (マクロ展開後) ...
args: (arg1)
0 constant 0
1 constant 1
2:1 stack-ref 2
3 constant 0
4 eqlsign
5 goto-if-not-nil 2
8 dup
9 stack-ref 2
10 stack-ref 2
11 plus
12 stack-set 2
14 stack-set 2
16 stack-ref 2
17 sub1
18 stack-set 3
20 goto 1
23:2 stack-ref 1
24 return
3 call 2
4 return
これを元にlapcode版を構築すると上記fib-lapcodeの様になります。
せっかくなのでハンドオプティマイズしようと思いましたが、自分の力量では最適化する事が出来ませんでした(笑)。
悔しいですが、そのままにしておきます。
ちなみに、実行中のスタックの状態は以下の様になります。
下の数字は上のディスアセンブルの左側の数字(アドレス)になります。
その命令が実行された後のスタックの状態です。
1ループ目は分かり難くかったので、4ループ目からの状態です。
最後はスタックに値が残ってますが、Emacs の場合はそれで良い事になってます。
呼び出し側でスタックポインタを呼び出し前の状態に戻します。
3
0 3 2 5
85 85 nil 3 3 3 3 3 85 84 1100087778366101931 <- return value
1 3 3 3 3 3 3 3 3 5 5 5 5 5 5 1779979416004714189
0 0 2 2 2 2 2 2 2 2 2 3 3 3 3 3 1100087778366101931
88 88 88 ... 85 85 85 85 85 85 85 85 85 85 85 85 84 84 ... 0
----------------------------------------------------------------------------------
0 1 2 3 4 5 8 9 10 11 12 14 16 17 18 20 23 24
0 constant 0
1 constant 1
2:1 stack-ref 2
3 constant 0
4 eqlsign
5 goto-if-not-nil 2 ← この 2 は 23:2 の 2
8 dup
9 stack-ref 2
10 stack-ref 2
11 plus
12 stack-set 2
14 stack-set 2
16 stack-ref 2
17 sub1
18 stack-set 3
20 goto 1 ← この 1 は 2:1 の 1
23:2 stack-ref 1
24 return
テスト
一応テストを書いていますが、流し読みしてください。
ちなみに、一部のテスト以外は、マクロを使って「実行時」に生成しています。
そういう事が簡単に出来るのも、Lisp ならではでしょう。
(defconst fibonacci-numbers
'(0 1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181
6765 10946 17711 28657 46368 75025 121393 196418 317811 514229
832040 1346269 2178309 3524578 5702887 9227465 14930352 24157817
39088169 63245986 102334155 165580141 267914296 433494437
701408733 1134903170 1836311903 2971215073 4807526976 7778742049
12586269025 20365011074 32951280099 53316291173 86267571272
139583862445 225851433717 365435296162 591286729879 956722026041
1548008755920 2504730781961 4052739537881 6557470319842
10610209857723 17167680177565 27777890035288 44945570212853
72723460248141 117669030460994 190392490709135 308061521170129
498454011879264 806515533049393 1304969544928657
2111485077978050 3416454622906707 5527939700884757
8944394323791464 14472334024676221 23416728348467685
37889062373143906 61305790721611591 99194853094755497
160500643816367088 259695496911122585 420196140727489673
679891637638612258 1100087778366101931 1779979416004714189)
"0〜89項まで (https://fibonnacci.aimary.com/) から取得。
89項は most-positive-fixnum 以下の最大値。")
;; 使う値を予め保存しておく
(defconst fibonacci-20 (nth 20 fibonacci-numbers) "=> 6765")
(defconst fibonacci-0-19 (seq-subseq fibonacci-numbers 0 20)
"=> '(0 1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181)")
(defconst fibonacci-88 (nth 88 fibonacci-numbers) "=> 1100087778366101931")
;; fib-* 関数を集める
(let (result)
(mapatoms (lambda (sym)
(let ((name (symbol-name sym)))
(when (and (< 4 (length name))
(string= (substring name 0 4) "fib-"))
(push sym result)))))
(defconst fibs result))
;; バイトコンパイルしておく (fib-lapcode は既にバイトコードなのでスキップされる)
(mapc #'byte-compile fibs)
;; 二重再帰版は重いので小さい数値でテスト
(ert-deftest test-fib-double-recursion ()
(should (= (fib-double-recursion 20) fibonacci-20)))
;; generator 版は途中の値を取得出来るのでテスト方法を変える
(ert-deftest test-fib-generator ()
(should (equal (cl-loop repeat 20
for i iter-by (fib-generator)
collect i)
fibonacci-0-19)))
;; 遅延評価(stream)版も同様に無限リストを取得出来るのでテスト方法を変える
(ert-deftest test-fib-stream ()
(should (equal (seq-into (seq-take (fib-stream) 20) 'list)
fibonacci-0-19)))
;; それ以外は、同じテストを定義する
(defmacro make-test ()
`(progn
,@(cl-mapcan (lambda (fib)
(let ((test-fib (concat "test-" (symbol-name fib))))
(unless (intern-soft test-fib)
(list `(ert-deftest ,(intern test-fib) ()
(should (= (,fib 88) ,fibonacci-88)))))))
fibs)))
(make-test)
(ert-run-tests-batch-and-exit)
;; $ emacs --batch -f package-initialize -l fibs.el
;; Function fib-lapcode is already compiled
;; Running 9 tests (2021-02-12 16:38:34+0900, selector `t')
;; passed 1/9 test-fib-cl-do (0.000116 sec)
;; passed 2/9 test-fib-cl-loop (0.000083 sec)
;; passed 3/9 test-fib-dotimes (0.000065 sec)
;; passed 4/9 test-fib-double-recursion (0.001994 sec)
;; passed 5/9 test-fib-generator (0.000210 sec)
;; passed 6/9 test-fib-lapcode (0.000063 sec)
;; passed 7/9 test-fib-stream (0.000209 sec)
;; passed 8/9 test-fib-tail-recursion (0.000084 sec)
;; passed 9/9 test-fib-while (0.000064 sec)
;;
;; Ran 9 tests, 9 results as expected, 0 unexpected (2021-02-12 16:38:34+0900, 0.003326 sec)
結論
Lisp は面白いですねぇ！
以上になります。
編集履歴
2021/02/12 cl-loop 版を修正