backquoteは結構難しいみたいなので、その3までいくかもしれません。
;;;;
;;;; Lisp Quote Backquote
;;;;
;; Common Lispのquoteとbackquoteを理解しようという
;; 試みです。
;; 前半は、基本的な動作を確認しています。振舞の確認
;; は、stefilによるテストとして記述しています。ただ
;; し、the reader の内部動作についてはテストとして
;; 書けないものもありました。それらはコメントに振舞
;; を記述しています。
;; 後半はbackquoteをちゃんと理解するために、CLtL2の
;; 付録Cをやっています。ちなみに付録Cにはバグという
;; かタイポがあります。ここに掲載しているのは修正版
;; です。
;; Steeleも書いているとおり、backquoteの理解は簡単
;; ではありません。
;; 特にbackquoteのsemanticsが、本質的には、readerと
;; evaluatorに跨っているところだと思います。すなわ
;; ち、backquoteが無くなるまで評価しきったところで、
;; 意味が定義されているのですが、マクロなどで
;; backquoteが残った状態で使われたりするのですね。
;; より根源的に言うと、入れ子になったbackquoteの仕
;; 様について、ANSI CLはほとんど定義していません。
;; これは大変残念なことです。
;;;; test facility
(asdf:operate 'asdf:load-op :stefil)
(use-package :stefil)
;;(in-root-suite)
;;(defsuite* test-for-understanding)
;;;; quote basics
(is (eq (quote 1)
1))
(is (eq (quote nil)
nil))
(is (eq (quote t)
t))
(is (not (eq (quote #\A)
(quote a))))
(is (not (eq (quote #\A)
(intern "#\A"))))
(is (eql (quote #\A)
#\A))
(is (equal (quote "ab")
"ab"))
(is (eq (quote a)
(intern "A")))
(is (not (eq (quote (quote a))
(quote a))))
(is (equal (quote (quote a))
(list (quote quote) (quote a))))
;;;; quote (standard macro character)
(is (eq 'a
(quote a)))
(is (equal '(a)
(quote (a))))
(is (equal (read-from-string "'a")
''a ))
(is (eq (read-from-string "a")
'a ))
(signals end-of-file (read-from-string "'"))
(signals end-of-file (read-from-string "' "))
(is (equal (read-from-string "' a")
''a))
(is (equal (list ' a 'b)
'(a b)))
(is (eq (car (read-from-string "'a"))
'quote))
;;;; quote and conses
(is (eq 'nil
nil))
(is (eq '()
nil))
(is (equal '(a . b)
(cons 'a 'b)))
(is (equal '(a b . c)
(cons 'a (cons 'b 'c))))
(is (equal '(a)
(cons 'a 'nil)))
(is (equal '(a)
(list 'a)))
(is (equal ''(a)
(cons 'quote
(cons
(cons 'a 'nil)
nil))))
(is (equal ''(a)
(quote (quote (a)))))
(is (equal ''(a)
(list 'quote '(a))))
(is (equal ''(a)
(list 'quote (list 'a))))
(is (equal '('a)
(quote ((quote a)))))
(is (equal '('a)
(list ''a)))
(is (equal '('a)
(list (list 'quote 'a))))
;;;; backquote and quote
(is (eq `nil
'nil))
(is (eq `a
'a))
(is (equal `(a . b)
'(a . b)))
(is (equal `(a)
'(a)))
(signals end-of-file (read-from-string "`"))
(signals end-of-file (read-from-string "` "))
(is (equal (read-from-string "` a")
'`a))
(is (equal (list ` a ' b)
'(a b)))
(is (not (equal ``a
''a)))
(is (not (equal '`a
`'a)))
(is (equal `'a
''a))
(is (eq (eval ``a)
(eval ''a)))
(is (eq (eval '`a)
(eval ''a)))
;;;; backquote and comma
(setf a 1
b 2
c 3
x 'y
(symbol-function 'x) #'identity
y 'z
(symbol-function 'y) #'identity
z 9
(symbol-function 'z) #'identity
m '(p q r)
n '(10 20 30))
(is (eq `,a
a))
(is (eq `,x
x))
(is (eq `,m
m))
(is (equal `,m
'(p q r)))
(is (equal `(a . b)
(append (list `a) 'b)))
(is (equal `(a b . c)
(append (list `a) (list `b) 'c)))
(is (equal `(,a . b)
(append (list `,a) 'b)))
(is (equal `(,a . b)
(append (list a) 'b)))
(is (equal `(,a . ,b)
(append (list a) b)))
(is (equal `(,a ,b)
(append (list a) (list b) 'nil)))
(is (equal `(,@m)
(append m 'nil)))
(is (equal `(,@m ,@n)
(append m n 'nil)))
(is (equal `(a ,b ,m ,@n)
(append (list `a) (list b) (list m) n 'nil)))
(is (equal `((,a b) ,c ,@m)
;; (append (list `(,a b)) (list c) m)
;; (append (list (append (list a) (list `b))) (list c) m)
(list (list a 'b) c 'p 'q 'r)
))
(signals reader-error (read-from-string ","))
(signals end-of-file (read-from-string "`,"))
(signals end-of-file (read-from-string "`, "))
(is (equal (read-from-string "`, a")
'`,a))
(is (eq (eval '`,a)
a))
(is (equal (read-from-string "``,a")
'``,a))
(is (eq (eval '``,a)
'a))
(is (eq (eval (eval '``,a))
a))
(signals reader-error (read-from-string "`,,a"))
(is (equal (read-from-string "``,,a")
'``,,a))
(is (eq (eval '``,,a)
a))
(is (equal (read-from-string "`,`,a")
'`,`,a))
(is (eq (eval '`,`,a)
a))
(is (equal `````,,,,,a
a))
(is (eq ``````,,,,,a
'a))
(is (equal `,`,`,`,`,a
a))
(is (eq `,`,`,`,`,`a
'a))
;; nested backquotes and commas [the reader internal]
;; (The reader's behavior is implementation dependent.
;; Here we use the allegro.)
(is (equal (read-from-string "`a")
'(excl::backquote a)))
(is (equal (read-from-string "``a")
'(excl::backquote (excl::backquote a))))
(is (equal (read-from-string "`,a")
'(excl::backquote (excl::bq-comma a))))
(is (equal (read-from-string "``,,a")
'(excl::backquote
(excl::backquote
(excl::bq-comma
(excl::bq-comma a))))))
(is (equal (read-from-string "`,(+ 1 2)")
'(excl::backquote
(excl::bq-comma
(+ 1 2)))))
(is (equal (eval
(read-from-string "`,(+ 1 2)"))
3))
(is (equal (read-from-string "``,(+ 1 2)")
'(excl::backquote
(excl::backquote
(excl::bq-comma
(+ 1 2))))))
(is (equal (eval
(read-from-string "``,(+ 1 2)"))
(excl::backquote (+ 1 2))))
(is (equal (eval
(eval
(read-from-string "``,(+ 1 2)")))
(+ 1 2)))
(is (equal (read-from-string "``,,(list '+ 1 2)")
'(excl::backquote
(excl::backquote
(excl::bq-comma
(excl::bq-comma
(list (quote +) 1 2)))))))
(is (equal (eval
(read-from-string "``,,(list '+ 1 2)"))
(list (quote +) 1 2)))
(is (equal (eval
(eval
(read-from-string "``,,(list '+ 1 2)")))
(+ 1 2)))
(is (equal (read-from-string "`(,x `(,x `(,x)))")
'(excl::backquote
((excl::bq-comma x)
(excl::backquote
((excl::bq-comma x)
(excl::backquote
((excl::bq-comma x)))))))))
(eval
(read-from-string "`(,x `(,x `(,x)))"))
;; => (Y (EXCL::BQ-CONS X `((EXCL::BQ-LIST X))))
(eval
(eval
(read-from-string "`(,x `(,x `(,x)))")))
;; => (Y (EXCL::BQ-LIST X))
(eval
(eval
(eval
(read-from-string "`(,x `(,x `(,x)))"))))
;; => (Y) ; fully evaluated. implementation independent.
(is (equal
(read-from-string "`(1 `( 2 `( 3,,,x)))")
'(EXCL::BACKQUOTE
(1 (EXCL::BACKQUOTE
(2 (EXCL::BACKQUOTE
(3 (EXCL::BQ-COMMA
(EXCL::BQ-COMMA
(EXCL::BQ-COMMA X)))))))))))
(is (equal
(read-from-string "`(x `(y `(z,,,x)))")
'(EXCL::BACKQUOTE
(x (EXCL::BACKQUOTE
(y (EXCL::BACKQUOTE
(z (EXCL::BQ-COMMA
(EXCL::BQ-COMMA
(EXCL::BQ-COMMA X)))))))))))
(eval
(read-from-string "`(x `(y `(z,,,x)))"))
;; =>
;; (X (EXCL::BQ-LIST
;; (EXCL::BQ-QUOTE Y)
;; (EXCL::BQ-LIST (EXCL::BQ-QUOTE EXCL::BQ-LIST)
;; (EXCL::BQ-QUOTE
;; (EXCL::BQ-QUOTE Z))
;; Y)))
(eval
(eval
(read-from-string "`(x `(y `(z,,,x)))")))
;; => (Y (EXCL::BQ-LIST (EXCL::BQ-QUOTE Z) Z))
(eval
(eval
(eval
(read-from-string "`(x `(y `(z,,,x)))"))))
;; => (Z 9)
(eval
(eval
(eval
(eval
(read-from-string "`(x `(y `(z,,,x)))")))))
;; => 9 ; fully evaluated. implementation independent.
次回は、Steeleの、
;;; Common Lisp backquote implementation, written in Common Lisp.
;;; Author: Guy L. Steele Jr. Date: 27 December 1985
です。まだまだ精査中。。。これは楽しめる！！
こつこつ。
0 件のコメント:
コメントを投稿