2009年2月12日木曜日

【実践CL】20 特殊オペレータ

特殊オペレータは多少まじめにやってみた。
コンパイルはまったく理解していないので途中で力尽きた。


;;;
;;; 20 特殊オペレータ
;;;

;; 20章は例が少ない。即興で自分で例を作成していくことにする。
;; また自分なりのコメントもつける。

;; 何がspecial operatorかは、数学の公理のように選択である。
;; 言語を仕様化するには公理を選択するのが簡便である。


;; 20.1 評価を制御する。

(mapcar #'special-operator-p '(quote if progn))
; 3

;; quote
;; quoteはreaderが作ったLisp Objectを返す。
;; 別の言い方をすれば、evalを迂回する。

(car (quote (cdr nil))) ; CDR
(car (cdr nil)) ; NIL

;; if
;; ifはLispの基本評価ルールから逸脱する。


(defun if-func (condition true-clause false-clause)
(if condition
true-clause
false-clause))

(if-func nil
(car 10)
(cdr nil))
;; (car 10)が先に評価されるのでerrorになる。

(if nil
(car 10)
(cdr nil))
;; (car 10)が評価されるのは条件がnon-nilのときのみ。
;; よってerrorにならない。


;; progn
;; Lispの基本評価ルールから逸脱して、並列した式を評価する。
;; ある処理をprognで書くということはそれが副作用を目的としている
;; ということである。

;; 通常の評価は再帰的に単一のLisp formを評価するのみ。
(map 'vector #'1+
(append (cdr (list 1 2 3))
(car '((10 20) 30))))

;; prognは複数のLisp formを順次評価する。
(progn
(print 1)
(print 2)
(print 3))

;; ふと疑問。ファイルをloadすると文書内の文字列が
;; read evalされていくが、その順次処理はprognなのだ
;; ろうか。違うな。loadは関数で、ストリームのeofに
;; なるまで、read、evalを繰り返しているだけだろう。
;; 逆にprognというのが、prognの範囲において、そのよ
;; うな動作をする特殊オペレータということなのだろう。


;; 20.2 レキシカル環境を操作する

;; レキシカル環境が何かということを考える観点のひと
;; つにそれがevalの内部機構であるということがある。
;; Lispをしているとき、evalは2つある。1つはプログラ
;; マの頭の中。もうひとつは計算機の中だ。

;; 計算機でevalを実現するということは、ハードウエア
;; だけで組み立てるにせよ、ハードウエアとソフトウエ
;; アで組み立てるにせよ、ソフトウエアとしてどこから
;; Lisp自身で組み立てるかにせよ、いずれにせよ何か
;; Lisp以外のものも使いつつevalを作らなければいけな
;; い。

;; そのときのevalの構成物のひとつがレキシカル環境だ。

;; なので、レキシカル環境にプログラマがアクセスする
;; ことは、REPLでそれ以外のLisp formやLispオブジェ
;; クトを取り扱うのを越えた「意味」をもっている。


(mapcar #'special-operator-p '(let let* function setq flet labels macrolet symbol-macrolet))
; 8 3
(let ((v 1))
(incf v))
;; vは評価されず、レキシカル環境の変数名となる。vに
;; は1がbindされる。evalは、let式の中ではvという記
;; 号を変数名として取り扱い、vを評価すると変数に
;; bindされた値を返すように振る舞う。

(setq v 1) ;このsetqは特殊オペレータだがアクセスしているのはレキシカル環境ではない。
(let ((v 10)
(w (incf v)))
(incf w)) ; 3

(setq v 1)
(let* ((v 10)
(w (incf v)))
(incf w)) ; 12
;; letとlet*では、レキシカル変数を生成するときの評
;; 価ルールが異なる。


(flet ((add-10 (n)
(incf n 10)))
(add-10 100)) ; 110
;; fletはletの関数版。

(defun add-10 (n)
(incf n 2))
(add-10 1) ; 3
(flet ((add-10 (n)
(if (< n 10)
(add-10 (incf n))
n)))
(add-10 1)) ; 4
(labels ((add-10 (n)
(if (< n 10)
(add-10 (incf n))
n)))
(add-10 1)) ; 10
;; fletとflabelsの関係はletとlet*のごとし。

;; fletとflabelsはそれが置かれた場所(lexical)の環境
;; にアクセスできるので、top-levelで定義する関数と
;; 比べると、そこでの文脈に依存した簡潔な記述が可能
;; となる。

;; function
;; symbolまたはlambda expressionから関数オブジェクトを取り出す。

(function car) ; #
(function (lambda (x) x)) ; #

;; ところで関数って何だっけ?

;; 関数(関数オブジェクト)はLispオブジェクトであり、
;; 基本評価ルールとして、lisp formのcarに位置したと
;; きは、evalによって、cdrを情報として渡される。(こ
;; の処理を特殊オペレータにしたのがfunctionかなぁ)
;; 渡された情報とLispオブジェクト内の定義に従って処
;; 理を実行して値を返す。

;; 関数はclosureを成す場合と成さない場合がある。

(defun hoge (x) x)
(type-of #'hoge)
(symbol-function 'hoge) ; function
(type-of #'hoge) ; FUNCTION
(defun make-piyo ()
(let ((v 0))
#'(lambda (x) x)))
(setf (symbol-function 'piyo) (make-piyo))
(symbol-function 'piyo) ; interpreted closure
(type-of #'piyo) ; FUNCTION


;; macro

;; Common Lispにはmacroと名のつくものがたくさんある。
;; 代表的なものは次のとおり。
;;
;; - macro
;; - compiler macro
;; - reader macro
;; - dispatching macro
;; - symbol macro
;;
;; macroなんぞや、を書く気力は今はないので割愛。

;; macrolet
;; macroletは、defunに対するfletがごとく、defmacroに対する。

;; macroletの例は思いつかなかったのでCLtL2より。
(defun foo (x flag)
(macrolet ((fudge (z)
`(if flag
(* ,z ,z)
,z)))
(+ x
(fudge x)
(fudge (+ x 1)))))

(foo 2 nil) ; 7
(foo 2 t) ; 15


;; symbol-macroletは、同様に、define-symbol-macroに対する。

(symbol-macrolet ((hoge 'piyo)
(moge #'car))
(list hoge moge hoge moge)) ; (PIYO # PIYO #)


;; 20.3 ローカルなフローの制御

(mapcar #'special-operator-p '(block return-from tagbody go))
; 4 8 3

;; block, return-from
;;

(block outer
(print 'outer-1)
(block inner
(print 'inner-1)
(return-from inner)
(print 'inner-2)
)
(print 'outer-2))

(tagbody
(go bottom)
top
(print 'top)
(go out)
middle
(print 'middle)
(go top)
bottom
(print 'bottom)
(go middle)
out)


;; 20.4 スタックの巻き戻し
(mapcar #'special-operator-p '(catch throw unwind-protect))
; 3 4 8 3

(defun foo ()
(format t "Entering foo~%")
(block a
(format t " Entering BLOCK~%")
(bar #'(lambda () (return-from a)))
(format t " Leaving BLOCK~%"))
(format t "Leaving foo~%"))

(defun bar (fn)
(format t " Entering bar~%")
(baz fn)
(format t " Leaving bar~%"))

(defun baz (fn)
(format t " Entering baz~%")
(funcall fn)
(format t " Leaving baz~%"))

; CL-USER(58): (foo)
; Entering foo
; Entering BLOCK
; Entering bar
; Entering baz
; Leaving foo
; NIL
; CL-USER(59):

(defparameter *obj* (cons nil nil))
(defun foo ()
(format t "Entering foo~%")
(catch *obj*
(format t " Entering CATCH~%")
(bar #'(lambda () (return-from a)))
(format t " Leaving CATCH~%"))
(format t "Leaving foo~%"))

(defun bar (fn)
(format t " Entering bar~%")
(baz fn)
(format t " Leaving bar~%"))

(defun baz (fn)
(format t " Entering baz~%")
(throw *obj* nil)
(format t " Leaving baz~%"))

; CL-USER(62): (foo)
; Entering foo
; Entering CATCH
; Entering bar
; Entering baz
; Leaving foo
; NIL

;; unwind protect

(defun foo ()
(unwind-protect
(progn
(format t "Entering foo~%")
(block a
(format t " Entering BLOCK~%")
(bar #'(lambda () (return-from a)))
(format t " Leaving BLOCK~%"))
(format t "Leaving foo~%"))
(format t "Unwind-protect foo~%")))

(defun bar (fn)
(unwind-protect
(progn
(format t " Entering bar~%")
(baz fn)
(format t " Leaving bar~%"))
(format t "Unwind-protect bar~%")))

(defun baz (fn)
(unwind-protect
(progn
(format t " Entering baz~%")
(funcall fn)
(format t " Leaving baz~%"))
(format t "Unwind-protect baz~%")))

; CL-USER(64): (foo)
; Entering foo
; Entering BLOCK
; Entering bar
; Entering baz
; Unwind-protect baz
; Unwind-protect bar
; Leaving foo
; Unwind-protect foo
; NIL
; CL-USER(65):


;; 20.5 多値

(mapcar #'special-operator-p '(multiple-value-call multiple-value-prog1))
; 2 3 4 8 3

;; multiple-value-call
(funcall #'+ (values 1 2) (values 3 4)) ; 4
(multiple-value-call #'+ (values 1 2) (values 3 4)) ; 10

;; multiple-value-prog1
(prog1
(values 1 2)
(values 3 4)
(values 5 6)) ; 1

(multiple-value-prog1
(values 1 2)
(values 3 4)
(values 5 6)) ; 1 2



;; 20.6 EVAL-WHEN

(special-operator-p 'eval-when)
; 1 2 3 4 8 3

;; loadは、基本的にはtop-levelの表現を順次評価する。
;; compile-fileは、基本的には表現をcompiled code に
;; コンパイルするのみで評価はしない。
;;
;; ただしsymbol/package関係の表現やmacroなどの一部
;; の表現については、コンパイルの前作業として評価し
;; ないと正しくコンパイルできない。
;;
;; この問題を解決することを動機として、何を何時評価
;; するかを指定する方法がeval-whenである。


;; コンパイルのことを考えるには、まずトップレベルを
;; 明確にしなければならない。

;; トップレベルとは、処理系が持つREPLである。この
;; REPLを介してプログラマと処理系は対話する。もちろ
;; んそれはスタートポイントであり、プログラムを組ん
;; で別の方法(例えばHTTPとか)で対話するようにしても
;; よい。

;; トップレベルの表現として便利なように、いくつ
;; かの特殊オペレータは設計されている。

;; loadでソースファイルを読み込むのはソースファイル
;; の表現を順次手で入力していくのと似たようなもので
;; ある。違う点は、REPLじゃなくてRELであるというこ
;; とだ。

;; ではコンパイル。

;; まずcompileが何かを確認する。compileとは、関数ま
;; たはdefmacroのマクロを処理系においてより処理効率
;; がよい言語に翻訳する関数である。

(defun hoge (x) x)

(symbol-function 'hoge) ; interpreted function hoge
(compile 'hoge) ; HOGE nil nil
(symbol-function 'hoge) ; function hoge
(disassemble 'hoge)
; ;; disassembly of #
; ;; formals: X

; ;; code start: #x1000ec1328:
; 0: 48 83 f8 01 cmp rax,$1
; 4: 74 01 jz 7
; 6: 06 (push es) ; SYS::TRAP-ARGERR
; 7: 41 80 7f a7 00 cmpb [r15-89],$0 ; SYS::C_INTERRUPT-PENDING
; 12: 74 01 jz 15
; 14: 17 (pop ss) ; SYS::TRAP-SIGNAL-HIT
; 15: f8 clc
; 16: 4c 8b 74 24 10 movq r14,[rsp+16]
; 21: c3 ret
(function-lambda-expression #'hoge) ; (LAMBDA (X) (BLOCK HOGE X)) NIL HOGE


(defmacro piyo (x) x)
(symbol-function 'piyo) ; macro piyo
(macroexpand-1 '(piyo 3)) ; 3 T
(compile 'piyo) ; PIYO nil nil
(symbol-function 'piyo) ; macro piyo
(disassemble 'piyo)
; ;; disassembly of #
; ;; formals: EXCL::**MACROARG** EXCL::..ENVIRONMENT..
; ;; constant vector:
; 0: X
; 1: (X)

; ;; code start: #x1001256328:
; 0: 48 81 ec 98 00 subq rsp,$152 ; 19
; 00 00
; 7: 4c 89 74 24 08 movq [rsp+8],r14
; 12: 48 83 f8 02 cmp rax,$2
; 16: 74 01 jz 19
; 18: 06 (push es) ; SYS::TRAP-ARGERR
; 19: 41 80 7f a7 00 cmpb [r15-89],$0 ; SYS::C_INTERRUPT-PENDING
; 24: 74 01 jz 27
; 26: 17 (pop ss) ; SYS::TRAP-SIGNAL-HIT
; 27: 48 8b d7 movq rdx,rdi
; 30: 48 89 94 24 80 movq [rsp+128],rdx ; EXCL::**MACROARG**
; 00 00 00
; 38: 48 c7 c7 08 00 movq rdi,$8 ; 1
; 00 00
; 45: 48 c7 c6 08 00 movq rsi,$8 ; 1
; 00 00
; 52: 49 8b 8f 67 fd movq rcx,[r15-665] ; :MACRO
; ff ff
; 59: 49 8b af 77 fd movq rbp,[r15-649] ; EXCL::DT-MACRO-ARGUMENT-CHECK
; ff ff
; 66: b0 04 movb al,$4
; 68: ff d3 call *ebx
; 70: 48 8b bc 24 80 movq rdi,[rsp+128] ; EXCL::**MACROARG**
; 00 00 00
; 78: 41 ff 57 67 call *[r15+103] ; SYS::QCDR
; 82: 48 89 7c 24 78 movq [rsp+120],rdi ; #:|g47|
; 87: 49 8b 76 36 movq rsi,[r14+54] ; X
; 91: 49 8b af 5f fd movq rbp,[r15-673] ; EXCL::CAR-FUSSY
; ff ff
; 98: ff 53 d0 call *[rbx-48]
; 101: 48 89 bc 24 88 movq [rsp+136],rdi ; X
; 00 00 00
; 109: 48 8b 7c 24 78 movq rdi,[rsp+120] ; #:|g47|
; 114: 41 ff 57 67 call *[r15+103] ; SYS::QCDR
; 118: 48 8b f7 movq rsi,rdi
; 121: 49 8b 56 3e movq rdx,[r14+62] ; (X)
; 125: 33 ff xorl edi,edi
; 127: 49 8b af 57 fd movq rbp,[r15-681] ; EXCL::LAMBDASCAN-MAXARGS
; ff ff
; 134: b0 03 movb al,$3
; 136: ff d3 call *ebx
; 138: 48 8b bc 24 88 movq rdi,[rsp+136] ; X
; 00 00 00
; 146: f8 clc
; 147: 48 8d a4 24 98 leaq rsp,[rsp+152]
; 00 00 00
; 155: 4c 8b 74 24 10 movq r14,[rsp+16]
; 160: c3 ret
; 161: 90 nop

;; おあそびを少々
(compile 'foo '(lambda (x) x)) ; FOO NIL NIL
(symbol-function 'foo) ; function foo
(foo 3) ; 3
(compile nil '(lambda (x) x)) ; Function anonymous lambda NIL NIL
(setq foo (compile nil '(lambda (x) x)))
(funcall foo 3) ; 3
(setq bar #'(lambda (x) x))
(funcall bar 3) ; 3
(setf bar (compile nil (symbol-value 'bar)))
(funcall bar 3) ;3

;; compileしたcompiled functionはsymbolに格納される。
;; すなわちsymbolの中に関数本体が格納されているとい
;; うことはInterpreted functionだろうがCompiled
;; functionだろうが変わらない。いずれにしても
;; functionを使うということは、REPL上またはソースファ
;; イル上でその関数を呼び出すような表現を記述すると
;; いうことにすぎない。そして、その表現をLisp form
;; に変換した上で評価する際にいずれにしても関数コー
;; ドが参照されて、evalがそれを*利用して*評価を実行
;; するのだ。

;; このcompileがCommon Lispのコンパイルの基礎になる。

;; 続いてcompile-file。

;; あるソースファイルをそのままloadしたときと、
;; compile-file した上でloadしたときとで、処理スピー
;; ドに違いはあって欲しいが、処理内容に違いはあって
;; 欲しくない。

;; loadの仕様は、上記のようにトップレベルの表現を順
;; 次評価する、ということだ。二者で差異が発生しない
;; ようにするにはcompile-fileの仕様をどうすればよい
;; か。

;; まず*package*がソースをloadするときもCompile済み
;; のコードをloadするときも同じでなければならない。
;; ソースの中に*package*に係わる表現が存在しないな
;; らば、それはプログラマの手順の課題である。loadす
;; るときの*package*がずれないようにする。ソースの
;; 中で*package*に係わる記述がある場合は、それ以降
;; のソースにずれがないようにするにはソースのかきぶ
;; りの課題でありそれを実現するのがeval-whenだ。

;; また、compile-fileした時の処理系の状態とloadする
;; ときの処理系の状態も差異がないようにすべきである。
;; 具体的には、compile-fileするときに利用可能となっ
;; ている外部シンボルは、loadするときにも利用可能で
;; あるようにプログラマは手順を配慮すべきである。

;; 。。。 だめだ。途中で力つきた。

;; コンパイルはいつかちゃんとやろう。。。



;; 20.7 その他の特殊オペレータ

(mapcar #'special-operator-p '(locally the load-time-value progv))
; 4 2 1 3 4 8 3
; (+ 4 2 1 3 4 8 3)

;; locally
(defun sample-function (y) ; this y is regarded as special
(declare (special y))
(let ((y t)) ; this y is regarded as lexical
(list y
(locally (declare (special y))
;; this next y is regarded as special
y))))
(sample-function nil) ; (T NIL)


;; the

(the symbol 'a)
(the fixnum 1)
(the (values) (values 1 2))
(the (values integer) (values 1 2))
(the (values integer float symbol) (values 1 2.0 'a))
(the (values integer float symbol) (values 1 2 3)) ; error


;; load-time-value
(defvar *loaded-at* (get-universal-time))
(defun when-loaded () *loaded-at*)

(defun when-loaded () (load-time-value (get-universal-time)))
(when-loaded)

;; progv

(setq x 10
y 20)
(progv '(x y) '(1 2)
(list x y)) ; (1 2)
(list x y) ; (10 20)

(defun hoge ()
(+ nanja konja))
(progv '(nanja konja) '(1 2)
(hoge)) ; 3
(let ((nanja 1) (konja 2))
(hoge)) ; error

こつこつ。

0 件のコメント: