“Introduction to Lambda Calculus” メモ(その4)
感想としては外に当たらないと解答できないような問題は解けるわけがないよ、というところでした…
問題2.9
$MNL$ は（特に次の問題との対比で）どうやら、 free な variable を含む λ-term であるかもしれない、ということになると考えられます。つまり、$F$ を λ-term で素直に abstraction にすることができない。
例えば、 $F = λmn.m(nm)n$ とすると、 $n$ に $m$ が free な variable を含む λ-term だった場合。 closed λ-term と陽に closed であることを問題にしているのだろうと考えました。
これの Completeness of the S-K basis の所。任意の λ-term は、$S$ と $K$ の組み合わせで表現することができる、ということで、以下が示されています。
以下が示される例。
$S,K,I$ で示すことができたので、これに今度は $x, y$ を適用しています。
というわけで、問題 $\mbox{(i) }F ≡ λmn.m(nm)n$ 。
今度はこの結果に $m,n$ を適用します。
“Introduction to Lambda Calculus” メモ(その3)
2章の練習問題。
問題2.1(i)
$M_{1} ≡ y(λx.xy(λzw.yz))$
$w,x,y,z$ が出現しているので、$w \to v, x \to v', y \to v'', z \to v'''$とするとして、
$M_{1} ≡ (v''(λv'(v'(v''(λv'''(λv(v''v'''))))))).$
問題2.1(ii)
$M_{2} ≡ λv'(λv''((((λvv)v')v'')((v''(λv'''(v'v''')))v'')))$
同様に、 $w \gets v, x \gets v', y \gets v'', z \gets v'''$ とするとして、
$M_{2} ≡ λxy.((λw.w)xy(y(λz.xz)y)).$
問題2.2
まず何が問題なのか、つまり、どのように証明するのかよくわからない。そこで以下を参考にします。
考え方は、 substitution の定義から、構造的帰納法で証明する、ということらしい。解答そのものも記述があるので、それを写経します。
基底ケースの variable について左辺と右辺が等しいことを導いた後、 application と abstraction について帰納法で証明しています。これが、この問題の証明となります。再帰関数の定義と同様な方法を用いていて証明する、ということを考えれば納得できます。この場合、どこが基底で、どこが帰納（関数でいう再帰呼び出しするところという程度の認識です）を見出すことができなかったということをもって、何が問題なのかが理解できなかったということです。
以下写経します。
まず、 $M=x$ を考えます。
次に、 $M=y.$
次に考えるのが、 $M=z, z ≠ x \land z ≠ y.$これを示す必要があります。
ここまで、基底ケースの variable について左辺と右辺が等しいことは導かれました。あとは、 application と abstraction を帰納法で導いていくことになります。
$M = (M_{1}M_{2})$、 application について。
ここで帰納法により、 $X[x:=N][y:=L] \; = \; X[y:=L][x:=N[y:=L]]$ が正しいと仮定して、以下を導きます。
これは右辺と等しい。
$M = λz.M'$ つまり abstraction について。ここで、$z$ の条件として $z ≠ x \land z ≠ y$を挙げています。
ここで帰納法により、 $X[x:=N][y:=L] \; = \; X[y:=L][x:=N[y:=L]]$ が正しいと仮定して、以下を導きます。
これは右辺と等しい。
以上により $M[x:=N][y:=L] \; ≡ \; M[y:=L][x:=N[y:=L]]$ が証明されました。もう一度書くと、 substitution の定義から、 variable, application, と abstraction についてそれぞれ証明されたわけです。
問題2.3
(i) 2.2を用いて、と書いてある、ということは取り合えず脇に置いておいて、問うていることを自分なりに冗長に記述していきます。
これが意味しているのは、例で示されているものを見ると、 ある式$M$について、式$M$中に現れる$M_{1}$を$M_{2}$で置き換えても、置き換えられたそれぞれの式は=の関係になる、ということのようなので、$(λx.M)M_{1} = (λx.M)M_{2}$ つまり、
が成り立つ、ということのようなのだけれども、ここで言っている $λ\vdash$ や $=$ が意味している所が今の所の説明では厳密ではないと思うので、後続の章の後に考えることにします。！
問題2.4
こちらは 前回の記事で。
問題2.5
これ S を使えそうな気がします。 S を使って表すことを simplify と呼ぶのだろうか？という疑問はありまけれども…
$S$ で、この $x$ に渡る所の $z$ をどうにかできれば、 $B$ は $S$ で表すことができます、ということらしい。
$K$ を上手に使って、いわゆる二つ目の引数となる項を無視しています。成程、よく思い付くなこれ。
※ここで $λ\vdash$ と $=$ は、 application や abstraction を書き換えていくと、結局、 $M = X(YZ) = N$ という、字面が同じ λ-term になる、という程の意味で使っています。
問題2.6
ここでも simplify というのだけれども、この意味がいまいちわからない…
問題2.7
$\mbox{(i) } λ\vdash KI = K_{*}$
左辺を考えると、
$\mbox{(ii) } λ\vdash SKK = I$
左辺を考えると、
“Introduction to Lambda Calculus” メモ(その2)
2章の練習問題の前にある証明の問題の二つです。自分なりに解いてみたものです。
$A_{+} ≡ λmnfx.mf(nfx)$ のとき $A_{+}C_{m}C_{n} = C_{m+n}$ の証明
$\mbox{(1) } m=1$ のとき
$\mbox{(2) } m=k$ のとき命題が成り立つと仮定すると $A_{+}C_{k}C_{n} = C_{k+n}.$
ここで $m=k+1$ を考えます。 $A_{+}C_{k+1}C_{n} = A_{+}(A_{+}C_{1}C_{k})C_{n}$から
$A_{*} ≡ λxyz.x(yz)$ のとき $A_{*}C_{m}C_{n} = C_{m*n}$ の証明
$(a)$ 右辺は $C_{m*n} = λfx.f^{m*n}(x)$.
左辺を考えると、
“Introduction to Lambda Calculus” メモ
著者はこちらと同じ、 “L.i.S.P” では The “bible” of λ-calculus begins with として示されています、 The Lambda Calculus: Its Syntax and Semantics - Hendrik Pieter Barendregt - Google Books — https://books.google.co.jp/books?id=KbZFAAAAYAAJ&dq=editions:ISBN0444875085
自分なりの注釈を入れてみています。
2.3 CONVENTION.
(i) x, y, z, ... denote arbitrary variables; M, N, L, ... denote arbitrary λ-terms. Outermost parentheses are not written.
(ii) M ≡ N denotes that M and N are the same term or can be obtained from each other by remaning bound variables. E. g.
...
(iii) We use the abbreviations
…
定義が非常にシンプルなので、この入門で説明される中の慣習を陽に記述してくれているのが非常に助かります。
2.4 VARIABLE CONVENTION.
If M₁, ... ,Mₙ occur in a certain mathmatical context (e.g. definition, proof), then in these terms all bound variables are chosen to be different from the free variables.
一見、定義の裏返しのように見えるのだけれども、 … and y ∉ FV(N) をも考慮するようになっているのが注意する所でしょうか。ここでは x が free variable である、とあらかじめ先に言及していたとしても無理が起きないようにしている、とも考えられます。
2.13 EXAMPLE. (i)
$f x = x$ となる $x$ を関数 $f$ の不動点という。ここで関数 $f$ を入力として取って、その不動点を返す関数 $Y$ があるとすると、関数 $f$ の不動点は $Yf$ と表現できます。これをそのまま $G = (λgx.Sgx)G$ に当てはめています。
(ii)
さらっと $Y$ を使った $G$ の式として書かれているのだけれども、 $GX = GG$ から $G$ の式にするのを目指してみます。
ここでも不動点が出てきた。
$FX = X$ となる $X$ は関数 $F$ の不動点である。$F = YF.$
ここで、
$(λgx.gg)G = G$ となる $G$ はある関数 $(λgx.gg)$ の不動点である。ゆえに
$G ≡ Y(λgx.gg)$
これを、 $Y$ を使わずに表現するとすると。
検算するとすると、
$IGG$ が $(IG)G$ という評価されることが最初はピンと来ないのだけれども、 Functions of more arguments の所の説明で納得できた後に見返すと腑に落ちます。複数の引数がある関数の評価は、繰り返し一引数の関数を評価することで値を得ることができるというもの、 currying です。
Functions of more arguments の所では、括弧を使って複数引数を表現されているものを、使わない形へと変形していきます。一見括弧を使った方がより自然なもののような気もするのですけれども、一旦腑に落ちると、どちらも不自然でもないと感じられるようになりました。括弧を使わない場合には当然、テキストに現れる要素は少なくて済みます（少しですが）。
最初に一見したところ、言い替えると過去の自分は、括弧を使って表現した方が見慣れているからか、より自然な気がしていた、ということです。
$f(x,y)$ を例に以下のように説明されています。
... If $f(x,y)$ depends on two arguments, one can define:
そして、一般に、 application と abstraction はそれぞれ次のように説明されます。
...
it is convenient to use association to the left for iterated application:
$FM_{1}…M_{n}$ denotes $(…((FM_{1})M_{2})…M_{n})$
...
Dually, iterated abstraction uses association to the right:
$λx_{1}…x_{n}.f(x_{1},…,x_{n})$ denotes $λx_{1}.(λx_{2}.(…(λx_{n}.f(x_{1},…,x_{n}))))$
これは 2.3 CONVENTION の (iii) に挙げられている所のものでもあります。(iii) では括弧を使用しないものなので、それぞれ以下のように。
(iii) We use the abbreviations
L.i.S.P 写経(その4)、5章
自分にとって新たに接する用語や概念が出てくるので落ち着いて整理していきます、章のタイトルからしてだけれども。
プログラムって何？、意味って何？という問いに答えながら、今から話題にすることをだんだん厳密にしていきます。
The proplem is thus to associate a programming language with a method that gives meaning to every program written in that language. In that sense, we speak of the semantics of a programming language.
で、 semantics に種々の方法がある、と続いていきます。プログラムに意味を結び付けるには、そのプログラミング言語の成分(特徴？プロパティ？)を知る必要があって…というのがこの前段にあって、上記の文がくる。自分なりに日本語にするとすると、
プログラミング言語に、その言語で書かれたどのプログラムにも意味を与える方法を結び付けることが問題となります。その意味で、プログラミング言語の semantics のことを話して行きます。
in that sense としてここで mean(ing) という語を使っていないことに注目するんだろうけれども、日本語にしようとして その意味で となってしまっている所でこの日本語は原文を台無しにしてしまっています…
意味って何？という問いに対して、「意味を与える方法（を結び付けること）」から深堀りするというのは納得いかないような気もします。この「方法」はその言語処理系を実装する際に必要となるはずの厳密な標準となるもの、から始まって、他にも色々と利用することができるものです、とあります。この「意味を与える方法」によって表現されるものが意味そのものということになるのだろう。「意味って何？」というともすれば哲学的な問いは普段意識することが無いからか、言葉にされると面喰らってしまいます。結局この問いに対する答えは、以下の文で表されるようなものということになります。特に最後のカンマ以降です。シンプルです。
In fact, the meaning of a program is a much more fundamental property, its very essence.
方法が主に三つ operational semantics, denotational semantics, そして axiomatic semantics が挙げられます。それ以外にも natural semantics や algebraic semantics 等があるということも示されます。その中で operational semantics ではなく、という件から、言語の実装にも使える方法としてここでは denotational semantics を利用します、という話の流れで denotational semantics とは何かが示されます。
…
only a few centuries of mathematical practice and culture are sufficient "to apply" it. The idea is thus to transform a program into a function (from an appropriate space of functions). We call that function its denotation. The remaining problem is then to understand the space of denotations.
…
but the structure that we’ve just explained is what we conventionally call denotational semantics.
L.i.S.P 写経(その3)、4章
L.i.S.P 4章、疑問が残ってしまった、というのが一言感想です。
これまでの実装と大きく異なるのが、副作用を使わないということです。例えば set! の実装は以下のようになっています。
(define (evaluate-variable n r s k) (k (s (r n)) s)) ... (define (evaluate-set! n e r s k) (evaluate e r s (lambda (v ss) (k v (update ss (r n) v)))))
r は変更されていないことに注目することができます。そのかわりに、 ss が update されています。というわけで、メモリの実装を見ます。
(define (update s a v) (lambda (aa) (if (eqv? a aa) v (s aa)))) (define (update* s a* v*) (if (pair? a*) (update* (update s (car a*) (car v*)) (cdr a*) (cdr v*)) s)) (define (allocate n s q) (if (> n 0) (let ((a (new-location s))) (allocate (- n 1) (expand-store a s) (lambda (a* ss) (q (cons a a*) ss)))) (q '() s))) (define (expand-store high-location s) (update s 0 high-location)) (define (new-location s) (+ 1 (s 0))) (define s.init (expand-store 0 (lambda (a) (wrong "No such address" a))))
ここの最初に出てくる update がクロージャを連ねてゆくことで、新たに確保されたアドレス a へ値 v が保持されます。同じアドレスに対してもクロージャが連ねられる、つまり、メモリへの変更が全て保持されていることになるので、本文中でも、明らかに過度なやり方だけれども、という記述があります。メモリというからには、例えば同じアドレスの中身は書き換えられそうな気がします。ただ、ここでは副作用をとことん避けるとしたらば、ということで話が進められているので、変更が全て保持されるというのが自然なこと（というかそれ以外にやりようが無いと思う）、ということになります。ということで納得します。
defprimitive で作った関数と、 definitial + set! で作った関数の扱いが微妙に異なってしまうけれども…そこが疑問です。
(begin (definitial ttmp (create-boolean #f)) (evaluate '(begin (set! ttmp (lambda ()))) r.global s.global (lambda (v ss) (let* ((cons1 (r.global 'cons)) (cons2 ((ss cons1) 'tag)) (ttmp1 (r.global 'ttmp)) (ttmp2 ((ss ttmp1) 'tag))) (values (list cons1 cons2) (list ttmp1 ttmp2)))))) ;;=> (12 12), (50 51)
definitial + set! の場合、名前と関数に一つずつアドレスが確保されるのだけれども、 defprimitive では同じアドレスが使い回されています。なんでそうなるかは、 defprimitive も、 definitial も (allocate 1 s.global ...) として、どちも書き換えられる前の s.global を引数にアドレスを確保しているためと考えられます。それと、 defprimitive で (set! s.global (expand-store ...)) している所、どんな意図があるのか疑問です。
(define-syntax definitial (syntax-rules () ((definitial name value) (allocate 1 s.global ;; XXX: defprimitive にも注目 (lambda (a* ss) (set! r.global (update r.global 'name (car a*))) (set! s.global (update ss (car a*) value))))))) (define-syntax defprimitive (syntax-rules () ((defprimitive name value arity) (definitial name (allocate 1 s.global ;; XXX: definitial が展開するコードが s.global を ;; 更新する前に呼び出されるので definitial と同じ ;; アドレスが使い回されることになる (lambda (a* ss) (set! s.global (expand-store (car a*) ss)) ;; XXX: 必要？… allocate が s.global を引数に既に ;; 呼び出されている、というコードに展開されること ;; になるけれども… (create-function (car a*) (lambda (v* s k) (if (= arity (length v*)) (value v* s k) (wrong "Incorrect arity" 'name))))))))))
束縛自体のアドレスを陽に利用することがないので問題とならない、と考えられますけれども、見落としがあるかもしれない…疑問です。
evaluate-quote もそうだけれども、実装に使用している処理系の関数を呼び出す時（その逆も然り）、値のやり取りに注意する必要があるのも、これまでの実装と特に異なる部分です。例えば apply を実装するとすると。
(definitial list (create-function -12 allocate-list)) (definitial apply (create-function -11 (lambda (v* s k) (if (>= (length v*) 2) (let ((fn (car v*)) (args (cdr v*))) (if (eq? (fn 'type) 'function) ((fn 'behavior) (let flat ((args args)) (if (null? (cdr args)) (let loop ((cell (car args))) (cond ((eq? cell the-empty-list) '()) ((eq? (cell 'type) 'pair) (cons (s (cell 'car)) (loop (s (cell 'cdr))))) (else (wrong "Improper list not allowed" 'apply)))) (cons (car args) (flat (cdr args))))) s k) (wrong "Must be a function" 'apply))) (wrong "Incorrect arity" 'apply))))) (is '(1 2) (evaluate1 '(list 1 2))) (is 3 (evaluate1 '(apply + '(1 2)))) (is '(1 2 3 4 5) (evaluate1 '(apply list 1 2 3 '(4 5)))) (test* "" "error" (evaluate1 '(apply 1 2)) (lambda (_e r) (string-prefix? "Must be a function" (~ r 'message)))) (test* "" "error" (evaluate1 '(apply list 1 2)) (lambda (_e r) (string-prefix? "Improper list not allowed" (~ r 'message)))) ...
apply へ渡される最後の引数はリストなのだけれども、そのままでは (fn 'behavior) へ直接渡すことはできないことに注目します。
一方、 lambda list にドット対を指定することができるようにすると、今度は逆に、最後の引数となる名前を、そのまま環境へ v* を値に取ることはできません。値がメモリに保持される所で allcoate-list を呼びます。
(define (arity-compatible? n* v*) (cond ((pair? n*) (and (pair? v*) (arity-compatible? (cdr n*) (cdr v*)))) ((null? n*) (null? v*)) ((symbol? n*) #t))) (is #t (arity-compatible? '(a) '(a))) (is #f (arity-compatible? '(a) '(a b))) (is #f (arity-compatible? '(a) '(a b c))) (is #t (arity-compatible? '(a . c) '(a b))) (is #t (arity-compatible? '(a . c) '(a))) (define (arityn n*) (cond ((pair? n*) (+ 1 (arityn (cdr n*)))) ((null? n*) 0) (else 1))) (is 1 (arityn '(a))) (is 2 (arityn '(a b))) (is 2 (arityn '(a . b))) (define (evaluate-nlambda n* e* r s k) (define (update-environment r n* a*) (cond ((pair? n*) (update-environment (update r (car n*) (car a*)) (cdr n*) (cdr a*))) ((null? n*) r) (else (update r n* (car a*) )))) (define (update-store s a* v* n*) (cond ((pair? n*) (update-store (update s (car a*) (car v*)) (cdr a*) (cdr v*) (cdr n*))) ((null? n*) s) (else (allocate-list v* s (lambda (v ss) (update ss (car a*) v)))))) (allocate 1 s (lambda (a* ss) (k (create-function (car a*) (lambda (v* s k) (if (arity-compatible? n* v*) (allocate (arityn n*) s (lambda (a* ss) (evaluate-begin e* (update-environment r n* a*) (update-store ss a* v* n*) k))) (wrong "Incorrect arity")))) ss)))) (set! evaluate-lambda evaluate-nlambda) (is '(a b (c d)) (evaluate1 '((lambda (a b . c) (list a b c)) 'a 'b 'c 'd))) (is '((a b) (a b ())) (evaluate1 '((lambda (a b . c) (list (apply list a b c) (list a b c))) 'a 'b)))
Clojure のスレッディングマクロを Scheme で。
入門が https://t.laafc.net/tags/syntax-rules-primer.html 終わったので、実際に何か書いてみることにします。ここで Clojure のスレッディングマクロを題材にします。
- Clojure のスレッディングマクロ
手始めに thread-first と thread-last から。
(define-syntax thread-first (syntax-rules () ((_ e) e) ((_ e (x . xs) . more) (thread-first (x e . xs) . more)) ((_ e x . more) (thread-first (x e) . more)))) (thread-first a b c d) ;;-> (d (c (b a))) (thread-first a (b argb) (c argc) (d argd argd1)) ;;-> (d (c (b a argb) argc) argd argd1) (define-syntax thread-last (syntax-rules () ((_ e) e) ((_ e (xs ...) . more) (thread-last (xs ... e) . more)) ((_ e x . more) (thread-last (x e) . more)))) (thread-last a b c d) ;;-> (d (c (b a))) (thread-last a (b argb) (c argc) (d argd argd1)) ;;-> (d argd argd1 (c argc (b argb a)))
これには問題があって (-> a ()) の挙動が一定しないので修正します。 thread-last の方を修正。 syntax-error を呼ぶのが良いような気がするけれども…
(thread-first a ()) ;;-> (() a) ;; こちらが Clojure の挙動のようです。 ;; ここで `()` に対しては syntax-error を呼ぶのも考えられます。 (thread-last a ()) ;;-> (a) (define-syntax thread-last (syntax-rules () ((_ e) e) ((_ e (x xs ...) . more) (thread-last (x xs ... e) . more)) ((_ e x . more) (thread-last (x e) . more)))) (thread-last a ()) ;;-> (() a) (thread-last a b c d) ;;-> (d (c (b a))) (thread-last a (b argb) (c argc) (d argd argd1)) ;;-> (d argd argd1 (c argc (b argb a)))
... をパターンに使っている所で、最低一つは要素があるようにパターンを変更しました。
さて、ここからアレンジを加えます。任意の位置にフォームをねじ込むものを考えます。ここで、位置の指定が無かった場合には thread-first と同じ挙動となる thread-first-% を考えます。まず、 % を一つだけ考慮する、という手抜き実装をしてみて様子を見ます。
(define-syntax thread-first-% (syntax-rules () ((_ e) e) ((_ e0 e1 . more) (thread-first-%-aux e0 e1 () . more)))) ;; 段々整理して行って形にした後にこのコメントの文章を書いているのだけれども、このコードを書いた当時は色々と考えるのがわずらわしくて、相互再帰すれば多分都合良く行くだろう、と軽く考えていました。 (define-syntax thread-first-%-aux (syntax-rules (%) ((_ e () (x . xs) . more) (thread-first-% (x e . xs) . more)) ((_ e (% . xs) (acc ...) . more) (thread-first-% (acc ... e . xs) . more)) ((_ e (x . xs) (acc ...) . more) (thread-first-%-aux e xs (acc ... x) . more)) ((_ e x _ . more) (thread-first-% (x e) . more)))) (thread-first-% a b c d) ;;-> (d (c (b a))) (thread-first-% a (b argb) (c argc) (d argd argd1)) ;;-> (d (c (b a argb) argc) argd argd1) (thread-first-% a (b % argb) (c argc %) (d argd % argd1)) ;;-> (d argd (c argc (b a argb)) argd1) (thread-first-% (values 1 2) (receive (x y) % (list x y))) ;;-> (receive (x y) (values 1 2) (list x y))
見通しが悪いので、 thread-first-%-aux から thread-first-% を呼び出している部分を、呼び出し元に移動します。 thread-first-%-aux では e0 と e1 を展開することのみに変更してみます。
(define-syntax thread-first-% (syntax-rules () ((_ e) e) ((_ e0 e1 . more) (thread-first-% (thread-first-%-aux e0 e1 ()) . more)))) (define-syntax thread-first-%-aux (syntax-rules (%) ((_ e () (x . xs)) (x e . xs)) ((_ e () xs) xs) ((_ e (% . xs) (acc ...)) (acc ... e . xs)) ((_ e (x . xs) (acc ...)) (thread-first-%-aux e xs (acc ... x))) ((_ e x _xs) (x e))))
次に % を複数処理できるようにします。補助マクロへ引数を追加、リテラル % を見たかどうかのフラグを追加します。複数指定することが必要かどうかは脇へ置いておきます…
(define-syntax thread-first-% (syntax-rules () ((_ e) e) ((_ e0 e1 . more) (thread-first-% (thread-first-%-aux e0 e1 () (#f)) . more)))) (define-syntax thread-first-%-aux (syntax-rules (%) ((_ e () (x . xs) (#f)) (x e . xs)) ((_ e () xs (%)) xs) ((_ e (% . xs) (acc ...) _l) (thread-first-%-aux e xs (acc ... e) (%))) ((_ e (x . xs) (acc ...) l) (thread-first-%-aux e xs (acc ... x) l)) ((_ e x _xs _l) (x e)))) (thread-first-% a b c d) ;;-> (d (c (b a))) (thread-first-% a (b argb) (c argc) (d argd argd1)) ;;-> (d (c (b a argb) argc) argd argd1) (thread-first-% a (b % argb) (c argc %) (d argd % argd1)) ;;-> (d argd (c argc (b a argb)) argd1) (thread-first-% (values 1 2) (receive (x y) % (list x y))) ;;-> (receive (x y) (values 1 2) (list x y)) (thread-first-% 1 print (list % %)) ;;-> (list (print 1) (print 1)) (thread-first-% 1 (rlet1 r % (print r)) (list %)) ;;-> (list (let ((r 1)) (print r) r))
更にアレンジを加えることを考えてみます。上のやつは式をそのまま次の式へねじ込んでいますが、一旦評価した値を束縛して渡していくようにします。
(define-syntax thread-first-%-1 (syntax-rules () ((_ e) e) ((_ e0 e1 . more) (thread-first-%-1 (thread-first-%-aux e0 e1 () (#f)) . more)))) (define-syntax thread-first-% (syntax-rules () ((_ e) e) ((_ e0 e1 . more) (let1 ret e0 (thread-first-% (thread-first-%-aux ret e1 () (#f)) . more))))) (thread-first-%-1 1 print (list % %)) ;;-> (list (print 1) (print 1)) (thread-first-% 1 print (list % %)) ;;-> (let1 ret 1 (let1 ret (print ret) (list ret ret)))
引数を評価しないバージョンを thread-first-%-1 としました。
さて気分を変えて、次は some-> を考えます。 (some-> は引数を評価して束縛して渡して行くことが期待されると考えます。また some-thread-first-% を考えるとして、これとの対比で、引数を評価しないバージョンは thread-first-%-1 としました。)
(define-syntax some-thread-first (syntax-rules () ((_ e) e) ((_ e0 e1 . more) (and-let1 ret e0 (some-thread-first (some-thread-first-aux ret e1) . more))))) (define-syntax some-thread-first-aux (syntax-rules () ((_ e (x . xs)) (x e . xs)) ((_ e x) (x e)))) (some-thread-first a b c d) ;;-> (and-let1 ret a (and-let1 ret (b ret) (and-let1 ret (c ret) (d ret)))) (some-thread-first a (b argb) (c argc) (d argd argd1)) ;;-> (and-let1 ret a (and-let1 ret (b ret argb) (and-let1 ret (c ret argc) (d ret argd argd1)))) (define-syntax some-thread-first-% (syntax-rules () ((_ e) e) ((_ e0 e1 . more) (and-let1 ret e0 (some-thread-first-% (thread-first-%-aux ret e1 () (#f)) . more))))) (some-thread-first-% a b c d) ;;-> (and-let1 ret a (and-let1 ret (b ret) (and-let1 ret (c ret) (d ret)))) (some-thread-first-% a (b % argb) (c argc %) (d argd % argd1)) ;;-> (and-let1 ret a (and-let1 ret (b ret argb) (and-let1 ret (c argc ret) (d argd ret argd1))))
次は as-> です。
(define-syntax as-thread (syntax-rules () ((_ val _var) val) ((_ val var x . xs) (let1 var val (as-thread x var . xs))))) (as-thread a v (b v) (c v) (d v)) ;;-> (let1 v a (let1 v (b v) (let1 v (c v) (d v)))) ;; -> 等の間に狭み込んで使うことを考えられているんだろうか。 (some-thread-first-% #t (as-thread v (begin0 v (display v) (newline))) x->string) ;;>> #t ;;=> "#t"
最後は cond-> です。括孤が多いけれども。
(define-syntax cond-thread-first (syntax-rules () ((_ e) e) ((_ e (test form) . more) (let1 var e (if test (cond-thread-first (thread-first-% var form) . more) (cond-thread-first var . more)))))) (let () (use srfi-1 :only (xcons)) (define (describe-number n) (define blob (pa$ cons n)) (cond-thread-first '() (#t blob) ((odd? n) (cons 'odd %)) ((even? n) (cons 'even %)) ((positive? n) (xcons 'positive)) ((negative? n) (xcons 'negative)))) (list (describe-number 3) (describe-number 4))) ;;=> ((positive odd 3) (positive even 4))
全体像がこちらです。
(define-module t.clojure.threading-macros (export % thread-first ;;thread-first-aux thread-last ;;thread-last-aux thread-first-%-1 thread-first-% ;;thread-first-%-aux thread-last-%-1 thread-last-% ;;thread-last-%-aux some-thread-first some-thread-last some-thread-first-% some-thread-last-% as-thread cond-thread-first cond-thread-first-% cond-thread-last cond-thread-last-% )) (select-module t.clojure.threading-macros) (define-syntax % (syntax-rules ())) (define-syntax thread-first (syntax-rules () ((_ e) e) ((_ e x . more) (thread-first (thread-first-aux e x) . more)))) (define-syntax thread-first-aux (syntax-rules () ((_ e (x . xs)) (x e . xs)) ((_ e x) (x e)))) (define-syntax thread-last (syntax-rules () ((_ e) e) ((_ e x . more) (thread-last (thread-last-aux e x) . more)))) (define-syntax thread-last-aux (syntax-rules () ((_ e (x xs ...)) (x xs ... e)) ((_ e x) (x e)))) (define-syntax thread-first-%-1 (syntax-rules () ((_ e) e) ((_ e0 e1 . more) (thread-first-%-1 (thread-first-%-aux e0 e1 () (#f)) . more)))) (define-syntax thread-first-% (syntax-rules () ((_ e) e) ((_ e0 e1 . more) (let1 ret e0 (thread-first-% (thread-first-%-aux ret e1 () (#f)) . more))))) (define-syntax thread-first-%-aux (syntax-rules (%) ((_ e () (x . xs) (#f)) (x e . xs)) ((_ e () xs (%)) xs) ((_ e (% . xs) (acc ...) _l) (thread-first-%-aux e xs (acc ... e) (%))) ((_ e (x . xs) (acc ...) l) (thread-first-%-aux e xs (acc ... x) l)) ((_ e x _xs _l) (x e)))) (define-syntax thread-last-%-1 (syntax-rules () ((_ e) e) ((_ e0 e1 . more) (thread-last-%-1 (thread-last-%-aux e0 e1 () (#f)) . more)))) (define-syntax thread-last-% (syntax-rules () ((_ e) e) ((_ e0 e1 . more) (let1 ret e0 (thread-last-% (thread-last-%-aux ret e1 () (#f)) . more))))) (define-syntax thread-last-%-aux (syntax-rules (%) ((_ e () (x xs ...) (#f)) (x xs ... e)) ((_ e () xs (%)) xs) ((_ e (% . xs) (acc ...) _l) (thread-last-%-aux e xs (acc ... e) (%))) ((_ e (x . xs) (acc ...) l) (thread-last-%-aux e xs (acc ... x) l)) ((_ e x _xs _l) (x e)))) (define-syntax some-thread-first (syntax-rules () ((_ e) e) ((_ e0 e1 . more) (and-let1 ret e0 (some-thread-first (thread-first-aux ret e1) . more))))) (define-syntax some-thread-last (syntax-rules () ((_ e) e) ((_ e0 e1 . more) (and-let1 ret e0 (some-thread-last (thread-last-aux ret e1) . more))))) (define-syntax some-thread-first-% (syntax-rules () ((_ e) e) ((_ e0 e1 . more) (and-let1 ret e0 (some-thread-first-% (thread-first-%-aux ret e1 () (#f)) . more))))) (define-syntax some-thread-last-% (syntax-rules () ((_ e) e) ((_ e0 e1 . more) (and-let1 ret e0 (some-thread-last-% (thread-last-%-aux ret e1 () (#f)) . more))))) (define-syntax as-thread (syntax-rules () ((_ val _var) val) ((_ val var x . xs) (let1 var val (as-thread x var . xs))))) (define-syntax cond-thread-first (syntax-rules () ((_ e) e) ((_ e (test form) . more) (let1 var e (if test (cond-thread-first (thread-first var form) . more) (cond-thread-first var . more)))))) (define-syntax cond-thread-first-% (syntax-rules () ((_ e) e) ((_ e (test form) . more) (let1 var e (if test (cond-thread-first-% (thread-first-% var form) . more) (cond-thread-first-% var . more)))))) (define-syntax cond-thread-last (syntax-rules () ((_ e) e) ((_ e (test form) . more) (let1 var e (if test (cond-thread-last (thread-last var form) . more) (cond-thread-last var . more)))))) (define-syntax cond-thread-last-% (syntax-rules () ((_ e) e) ((_ e (test form) . more) (let1 var e (if test (cond-thread-last-% (thread-last-% var form) . more) (cond-thread-last-% var . more))))))
% は cut が <> 等を探すのと同様で、木を探索しません。Clojureで "% を探す"という役割からすると直観的ではない挙動なのかもしれません。そんな時には as-thread を使うということで割り切ります、という名の手抜きです。
“JRM’s Syntax-rules Primer for the Merely Eccentric” メモ(その7) scheme-eval
続きです。最後の scheme-eval 、
The obligatory hack.
The following is a small scheme interpreter written as a syntax-rules macro. It is incredibly slow.
いつものやつ、とか、いつものやんなきゃなんないやつ、といったところでしょうか。
(scheme-eval ((Y (lambda (fac) (lambda (n) (if (sero? n) '(()) (mulz n (fac (zub1 n))))))) '(() () ()))) ;;-> (quote (() () () () () ()))
“The Little Schemer” に出てくる 6. Shadows の章の関数群と Y 関数を使って階乗が動いたところ。すごい動いた、というシンプルすぎる正直な感想です。
initial-environment に sero? 等の関数を置いておきたいので、 lambda form が動くようにしました。
... (define-syntax meval (syntax-rules (if lambda quote) ((meval k () env) (return k ())) ((meval k (if pred cons alt) env) (macro-if (meval pred env) (meval k cons env) (meval k alt env))) ((meval k (lambda names body) env) (return k (closure names body env))) ((meval k (quote object) env) (return k object)) ((meval k (operator . operands) env) (meval-list ((mapply k env)) () (operator . operands) env)) ((meval k whatever env) (macro-if (is-symbol? whatever) (mlookup k whatever env) (return k whatever))))) ... (define-syntax mapply (syntax-rules (closure lambda) ((mapply k _env ((closure names body env) . operands)) (macro-call k (! (meval body (! (extend-environment env names operands)))))) ((mapply k env ((lambda names body) . operands)) (macro-call k (! (meval body (! (extend-environment env names operands)))))) ((mapply k _env (operator . operands)) (macro-if (is-symbol? operator) (operator k . operands) '(non symbol application: operator))))) ...
“JRM’s Syntax-rules Primer for the Merely Eccentric” メモ(その6) macro-call から
続きます、 macro-call から。
キーワード ! を目印に、そこはマクロ呼び出しをして展開するマクロ、と考えればよいだろうか。
(define-syntax macro-call (syntax-rules (!) ;; "タグ付き"マクロ用と考えられます。 ;; 今の所使われていないと思うのでコメントアウト ;; ((macro-call k (! ((function ...) . arguments))) ;; (function ... k . arguments)) ((macro-call k (! (function . arguments))) (macro-call ((macro-apply k function)) arguments)) ((macro-call k (a . b)) (macro-call ((macro-descend-right k) b) a)) ((macro-call k whatever) (return k whatever)))) (define-syntax macro-apply (syntax-rules () ((macro-apply k function arguments) (function k . arguments)))) (define-syntax macro-descend-right (syntax-rules () ((macro-descend-right k evaled b) (macro-call ((macro-cons k evaled)) b))))
相互再帰する関数（これはマクロだけれども）、特にグローバルな束縛同士のもの、を見ると途端に迷子になってしまう。この感覚は https://t.laafc.net/2018/04/28/L.i.S.P-chapter3f.html#_functions ここで迷子になっていた感覚に近かったので忘れないようにメモ。
単純な例で様子を見ます。
(macro-call () (a . b)) ;;-> (macro-call ((macro-descend-right ()) b) a) ;;-> (return ((macro-descend-right ()) b) a) ;;-> (macro-descend-right () a b) ;;-> (macro-call ((macro-cons () a)) b) ;;-> (return ((macro-cons () a)) b) ;;-> (macro-cons () a b) ;;-> (return () (a . b)) ;;-> (a . b)
まず、 macro-call 内で (macro-call ((macro-descend-right k) b) a) に展開される時を考えます。パターン変数 b は入力されたS式の"cdr"部で置き換えられます。 return を経由して"car"部が渡されて、再帰的に (macro-call ((macro-cons k "car"部)) "cdr"部) が呼び出されます。言い替えると、"car"部を評価して、今評価した"car"部をconsする継続を伴って再帰的に"cdr"部を評価する、と考えることができると思います。
どうだろう、少しだけ複雑なものでイメージ通りになっているのかどうか、再度様子を見ます。
(macro-call () (a b)) ;;-> (macro-call ((macro-descend-right ()) (b)) a) ;;-> (return ((macro-descend-right ()) (b)) a) ;;-> (macro-descend-right () a (b)) ;;-> (macro-call ((macro-cons () a)) (b)) ;;-> (macro-call ((macro-descend-right ((macro-cons () a))) ()) b) ;;-> (return ((macro-descend-right ((macro-cons () a))) ()) b) ;;-> (macro-descend-right ((macro-cons () a)) b ()) ;;-> (macro-call ((macro-cons ((macro-cons () a)) b)) ()) ;;-> (return ((macro-cons ((macro-cons () a)) b)) ()) ;;-> (macro-cons ((macro-cons () a)) b ()) ;;-> (return ((macro-cons () a)) (b)) ;;-> (macro-cons () a (b)) ;;-> (return () (a b)) ;;-> (a b)
さて、 (macro-call ((macro-apply k function)) arguments) へ展開される方の節を考えます。文字通り、 (! (function ...)) の function をそのまま入力部で置き換えて作った継続を伴って、 (macro-call 継続 arguments) として macro-call を再帰的に呼び出します。そしてこの継続が、 arguments 部分が再帰的に呼び出されて最終的に return を経由してconsされた結果を伴って呼び出されます。結果、 (function k . arguments) として呼び出されます。つまりこの形式のマクロを埋め込むことができる、ということになります。
(let-syntax ((nth2 (syntax-rules () ((_ k _e0 _e1 e2 _e ...) (return k e2))))) (macro-call () (A B (! (nth2 0 1 C 3 4)) D (! (return E))))) ;;-> (A B C D E)
継続を作りながら文中で言うところの “last-in, first-out” していくさまを見ると、この入門の最後に示されるのが評価器そのものというのも頷けてきます。
“JRM’s Syntax-rules Primer for the Merely Eccentric” メモ(その5) return から
続きます、 return から。
まず sreverse マクロの中身を見てゆくことになります。例えば after-head の所を考えます。
((srev "after-tail" new-tail head kont)
(srev "top" head ("after-head" new-tail kont)))
((srev "after-head" new-head (new-tail ...) (tag . more))
(srev tag (new-tail ... new-head) . more))最初の節で、 head を処理するところ、 "after-head" 継続を作ります、これが ("after-head" new-tail kont) の箇所。で head を再帰的に処理して、今作った "after-head" 継続が呼び出されます、二番目のパターン。ここで同時に、後続の継続を (tag . more) で取り出して呼び出します、最後の (〜 . more) の所です。
ここで言われている継続はリストで、 tag を取り出して呼び出し、パターンマッチで継続を作成した時の任意の値を取り出しています。 (マクロ名 タグ 引数 . 継続) として呼び出して、 (マクロ名 タグ 引数 任意の値 継続) としてパターンマッチして受け取る、と。
特に、この"任意の値"が複数になるかもしれないとしたら (sreverse ではないこと)、パターンマッチで後続の継続を取り出すことがわずらわしくなりそうです。一方で、継続が呼び出される際には、"引数"として常に一つの値のみが渡される、ということになると考えられます。
出てくるのが return マクロ。
(define-syntax return (syntax-rules () ;; Continuation goes first. Location of return value is indicated ;; by end of first list. ((return ((kbefore ...) . kafter) value) (kbefore ... value . kafter)) ;; Special case to just return value from the null continuation. ((return () value) value))) ;; 動作を確認するためマクロ集 (define-syntax macro-null? (syntax-rules () ((macro-null? k ()) (return k #t)) ((macro-null? k otherwise) (return k #f)))) (define-syntax macro-car (syntax-rules () ((macro-car k (car . cdr)) (return k car)) ((macro-car k otherwise) (syntax-error "Not a list")))) (define-syntax macro-cdr (syntax-rules () ((macro-cdr k (car . cdr)) (return k cdr)) ((macro-cdr k otherwise) (syntax-error "Not a list")))) (define-syntax macro-pair? (syntax-rules () ((macro-pair? k (a . b)) (return k #t)) ((macro-pair? k otherwise) (return k #f)))) (define-syntax macro-list? (syntax-rules () ((macro-list? k (elements ...)) (return k #t)) ((macro-list? k otherwise) (return k #f)))) (define-syntax macro-cons (syntax-rules () ((macro-cons k ca cd) (return k (ca . cd))))) (define-syntax macro-append (syntax-rules () ((macro-append k (e1 ...) (e2 ...)) (return k (e1 ... e2 ...)))))
触って様子を見ます。
(macro-cons () a b) ;;-> (a . b) (macro-cons ((macro-list? ())) a b) ;;-> #f (macro-cons ((macro-list? ((macro-cons () #t)))) a b) ;;-> (#t . #f) (let-syntax ((my-macro-list (syntax-rules () ((_ k e ...) (return k (e ...)))))) (macro-cdr ((my-macro-list () a b c)) (_ . CDR))) ;;-> (a b c CDR)
まず先程挙げた、任意の値として任意の数の値を取り出すマクロを組み合わせるのが容易になっていることがポイントかなと考えられます。ここで、普通の関数呼び出しに近い見た目になって欲しいかもしれません。ということで示されるのが macro-subproblem です。
(define-syntax macro-subproblem (syntax-rules () ;; "タグ付き"マクロ用の節 ((macro-subproblem before ((macro-function ...) . args) . after) (macro-function ... (before . after) . args)) ((macro-subproblem before (macro-function . args) . after) (macro-function (before . after) . args )))) ;; (list 'a 'b 'c (cdr '(_ . CDR))) ;; これを念頭にして… ;;; => (a b c CDR) (macro-subproblem (my-macro-list () a b c) (macro-cdr (_ . CDR))) ;;-> (macro-cdr ((my-macro-list () a b c)) (_ . CDR)) ;;-> (a b c CDR) (macro-subproblem (macro-list? ()) (macro-cons a b)) ;;-> (macro-cons ((macro-list? ())) a b) ;;-> #f
ただこれ直観的なのだろうか、という疑問が残ってしまいます…。上で「触ってみます」、と書いた所で継続を直接書き下ろして色々試行錯誤していたのが影響しているのか、この macro-subproblem を使用してみると、かえって違和感を憶えてしまいます…でも後々になって見返すとそうでもないのかもしれない、とも思います…
そして macro-if です。
(define-syntax macro-if (syntax-rules () ((macro-if (pred . args) if-true if-false) (pred ((if-decide) if-true if-false) . args)))) (define-syntax if-decide (syntax-rules () ((if-decide #f if-true if-false) if-false) ((if-decide otherwise if-true if-false) if-true))) (macro-if (macro-list? ()) onsequent alternative) ;;-> (macro-list? ((if-decide) onsequent alternative) (())) ;;-> (return ((if-decide) onsequent alternative) #t) ;;-> (if-decide #t onsequent alternative) ;;-> consequent
if-decide 継続を作って pred の結果が渡るようにしています。 macro-subproblem と比較すると今度は解り易いような気がします。 if-decide マクロは (if-decide 引数 true節 false節) で呼び出されていて、これは (マクロ名 引数 任意の値 ...) の形です。"任意の値"の方が継続なのが先述のマクロ( macro-null? 等)とは対照的です。
“JRM’s Syntax-rules Primer for the Merely Eccentric” メモ(番外その3) id-eq??, id-eqv?? について
ここでおまけとし出てくるものです。
どちらも説明とコードが非常に興味深いです。今感じているおもしろポイントを忘れないように、考えを整理するためにも読み解くメモ。
まず、 id-eq?? から。
(define-syntax id-eq?? (syntax-rules () ((id-eq?? id b kt kf) (let-syntax ((id (syntax-rules () ((id) kf))) (ok (syntax-rules () ((ok) kt)))) (let-syntax ((test (syntax-rules () ((_ b) (id))))) (test ok))))))
マクロ展開して様子を見ます。
(id-eq?? A B #t #f) ;;-> (let-syntax ((A (syntax-rules () ((A) #f))) (ok (syntax-rules () ((ok) #t)))) (let-syntax ((test (syntax-rules () ((_ B) (A))))) (test ok))) ;;=> #f (id-eq?? A A #t #f) ;;-> (let-syntax ((A (syntax-rules () ((A) #f))) (ok (syntax-rules () ((ok) #t)))) (let-syntax ((test (syntax-rules () ((_ A) (A))))) (test ok))) ;;=> #t
一見なぜ ok が呼び出されるのか納得がいきません。マクロ展開の形を見るに、テンプレート部には、 (A) というマクロ呼び出しが見えるから、常に A マクロが呼び出されるように感じられます。（展開形ではなく、元々のやつでも id と見えているマクロ呼び出しに、常に展開されるのでは？と思ってしまう。）
注目しなければならないのは、パターン変数がテンプレート部に現れたらば入力内容の部分形式で置き換えられる、ということです。これが意識できると、 #t に展開される下の場合、 A マクロは呼び出されない、替わりに ok が呼び出されるのが納得できます。
元々のマクロで言うところの、 id と b はパターン変数で、テンプレート部に現れた場合には入力内容の部分形式で置き換えられる、ということです。
...
(let-syntax
((test (syntax-rules ()
((_ b) (id)))))
(test ok))
...仮に b と id が字面上同じだったとしても、パターン変数に現れた識別子がテンプレート部にも現れたことにならない限り、 ok マクロの呼び出しに展開されません。その意味で b と id が同じ場合に限り kt へ展開されます。
ここが私には特におもしろく感じたポイントです。二つの識別子がこの意味で同じかどうかをテストするのに、文字通りパターン変数としてテンプレート部にも現れたかどうかで判断しようとしていて、それをそのままマクロでそのようなコードにして処理系に丸投げしている所です。
では id-eqv?? を見ます。（展開形も同時に挙げます。）
(define-syntax id-eqv?? (syntax-rules () ((id-eqv?? a b kt kf) (let-syntax ((test (syntax-rules (a) ((test a) kt) ((test x) kf)))) (test b))))) (id-eqv?? A B #t #f) ;;-> (let-syntax ((test (syntax-rules (A) ((test A) #t) ((test x) #f)))) (test B)) ;;=> #f (id-eqv?? A A #t #f) ;;-> (let-syntax ((test (syntax-rules (A) ((test A) #t) ((test x) #f)))) (test A)) ;;=> #t
こちらは展開形を素直に見ると、それぞれの識別子は、一方がリテラル部に現れる意味で同じ場合に #t に展開されます。
ここも同様なおもしろポイントです。 syntax-rules へリテラル部が渡されてマッチしたのかどうかということを、そのままマクロでそのようなコードにしている、ということです。
示されるテストコードはこちらです。
(define-syntax mfoo (syntax-rules () ((mfoo tester a) (tester foo a 'yes 'no)))) (begin ;; expected answer: (id-eq??: no no) (display (list "id-eq??: " (mfoo id-eq?? foo) (let ((foo 1)) (mfoo id-eq?? foo)))) (newline)) (begin ;; expected answer: (id-eqv??: yes no) (display (list "id-eqv??: " (mfoo id-eqv?? foo) (let ((foo 1)) (mfoo id-eqv?? foo)))) (newline))
自分なりに注釈を入れるとしたら以下のようなことになります。
(mfoo id-eq?? foo) ;;=> 'no ;; 字面は `foo` だけれども異なる展開ステップで現れた識別子の比較なので `'no` (let ((foo 1)) (mfoo id-eq?? foo)) ;;=> 'no ;; 上と同様 (mfoo id-eqv?? foo) ;; 字面が `foo` でどちらも未束縛の識別子の比較なので `'yes` ;; 仮に `foo` が `mfoo` から見えている場合、グローバルな束縛であると考えれば、 ;; 例えばあらかじめ `(define foo ...)` されているとすれば `'yes`。 ;; `syntax-rules` のリテラル部の扱いを考えると納得できます。 (let ((foo 1)) (mfoo id-eqv?? foo)) ;;=> 'no ;; 字面が `foo` ですが、`mfoo` マクロ呼び出し元は `let` で、束縛がある識別子、 ;; `mfoo` マクロ内では未束縛（もしくは、マクロ呼び出し元の `foo` とは異なる ;; 場所に束縛されている）となる識別子なので '`no`
ただ私の感覚では、典型的な syntax-rules のマクロのコードとは言えないんじゃないかと感じられるためか（あくまでも私の感覚ではです。何というか foo が唐突に出て来るところが典型的でないように感じられてしまいました）かえってピンときませんでした。（同じことなのだけれども） multiple-value-set! でやっていたように (https://t.laafc.net/2018/05/24/syntax-rules-primer.html) 展開ステップ毎に識別子を累積するようなコードで再確認します。
(let-syntax ((eq?? (syntax-rules () ((eq?? a b) (id-eq?? a b #t #f)))) (eqv?? (syntax-rules () ((eqv?? a b) (id-eqv?? a b #t #f))))) (letrec-syntax ((test (syntax-rules () ((test (t0 t1) (tt0 tt1)) ;; t0, t1, tt0, そして tt1 いずれも字面は `tmp` (list ;; 異なる展開ステップで作られた識別子を比較 (eq?? t0 t1) ;; #f (eqv?? t0 t1) ;; #t ;; 同じ展開ステップで作られた識別子を比較 ;; 正確には別の展開ステップでコピーした識別子 (eq?? t1 tt1) (eqv?? t1 tt1))) ((test (tmp0 tmp1) ()) (test (tmp0 tmp1) (tmp0 tmp1))) ((test (e ...) a) (test (e ... tmp) a))))) (test () ()))) ;;=> (#f #t #t #t)
結局 tmp が唐突に出現するので自分でも何を問題として典型的かどうかを考えているのかよくわかりません。私が読んで/書いている量が少ないので慣れていない、ということなのだろう…
“JRM’s Syntax-rules Primer for the Merely Eccentric” メモ(その4) is-symbol? について
続きです、 is-symbol? について let の変種…というか let を再実装するということで my-let を書きます。
(define-syntax my-let (syntax-rules () ((my-let first-subform . other-subforms) (macro-if (is-symbol? first-subform) (expand-named-let () first-subform other-subforms) (expand-standard-let () first-subform other-subforms))))) ;; XXX: ここではクォートするだけにとどめます (define-syntax expand-named-let (syntax-rules () ((expand-named-let . e) '(expand-named-let . e)))) (define-syntax expand-standard-let (syntax-rules () ((expand-standard-let . e) '(expand-standard-let . e))))
is-symbol? の定義があって、その後に注意を促す一文があります。
(define-syntax is-symbol? (syntax-rules () ((is-symbol? k (form ...)) (return k #f)) ((is-symbol? k #(form ...)) (return k #f)) ((is-symbol? k atom) (letrec-syntax ((test-yes (syntax-rules () ((test-yes) (return k #t)))) (test-no (syntax-rules () ((test-no) (return k #f)))) (test-rule (syntax-rules () ((test-rule atom) (test-yes)) ((test-rule . whatever) (test-no))))) (test-rule (#f))))))
We need to use LETREC-SYNTAX here because we do not want our continuation forms to be in the template of the test-rule; if the test rule matches, the atom we just tested would be rewritten!
これがピンと来ません。整理するために、 is-symbol? を元々の形にします。お手本はこれ。
(define-syntax symbol?? (syntax-rules () ((symbol?? (x ...) kt kf) kf) ; It's a pair, not a symbol ((symbol?? #(x ...) kt kf) kf) ; It's a vector, not a symbol ((symbol?? maybe-symbol kt kf) (let-syntax ((test (syntax-rules () ((test maybe-symbol t f) t) ((test x t f) f)))) (test abracadabra kt kf)))))
これをもとにして、 test のテンプレート部分へ継続フォームを直接展開するようなコードを考えます。
(define-syntax is-symbol? (syntax-rules () ((is-symbol? k (form ...)) (return k #f)) ((is-symbol? k #(form ...)) (return k #f)) ((is-symbol? k maybe-symbol) (let-syntax ((test (syntax-rules () ((test maybe-symbol) (return k #t)) ((test x) (return k #f))))) (test abracadabra))))) ;; (my-let foo ((name value)) body) ;;=> (expand-named-let () abracadabra (((name value)) body))
脱線だけれども、 is-symbol? 内で、 test-rule マクロの呼び出しを (#f) を使っているのは、あえておかしな展開形になるフォームを渡すことで、不意にそのまま展開されたとしても、そこでエラーになるようにしようとしているのかな、と考えられます。シンボルそのままだと下手をしたら気付かない可能性があります。
さて、ここで test マクロの maybe-symbol は is-symbol? マクロのパターン変数なので、入力内容の部分形式で置き換えられます。 (my-let foo ((name value)) body) を例として考えます。
(let-syntax ((test (syntax-rules () ((test foo) ...) ...))) (test abracadabra))
(test foo) のテンプレート部を考えると、
(letrec-syntax ((test (syntax-rules () ((test foo) (return ((if-decide) (expand-named-let . (() foo (((name value)) body))) (expand-standard-let . (() foo (((name value)) body)))) #t)) ...))) (test abracadabra))
識別子 foo が含まれています。これはパターン変数です。 is-symbol? マクロに渡した継続フォーム内の foo も test マクロ呼び出し時の部分形式で置き換えられてしまいます。
test マクロのテンプレート部分に継続フォームが現れないようにすれば上の問題は回避できます。というわけで下のようになる、と。
(define-syntax is-symbol? (syntax-rules () ((is-symbol? k (form ...)) (return k #f)) ((is-symbol? k #(form ...)) (return k #f)) ((is-symbol? k maybe-symbol) (let-syntax ((test-sk (syntax-rules () ((test-sk) (return k #t)))) (test-fk (syntax-rules () ((test-fk) (return k #f))))) (let-syntax ((test (syntax-rules () ((test maybe-symbol) (test-sk)) ((test . x) (test-fk))))) (test (#f)))))))
最初にピンと来なかったと書いたのは、一見大丈夫そうだな、と思ったということで、もっというと手を動かすまでは注意書きを読んでも、その意味するところがわからなかった、というのが正確です。つまり、マクロに現れる k は任意のフォームで、パターン変数となるものが含まれることがある、というのに気付かなかったということなのだけれども、これあらかじめ気付くことができる、もしくはできるようになるだろうか…
“JRM’s Syntax-rules Primer for the Merely Eccentric” メモ(番外その2) symbol?? について
“Syntax-rules Primer for the Merely Eccentric” では is-symbol? として出てくるものです。
(define-syntax symbol?? (syntax-rules () ((symbol?? (x . y) kt kf) kf) ; It's a pair, not a symbol ((symbol?? #(x ...) kt kf) kf) ; It's a vector, not a symbol ((symbol?? maybe-symbol kt kf) (let-syntax ((test (syntax-rules () ((test maybe-symbol t f) t) ((test x t f) f)))) (test abracadabra kt kf)))))
マクロの中で、もう一段補助マクロが定義されて、そのマクロが仕事をしています。この maybe-symbol の扱いが功妙です。補助マクロの方でテンプレート部分に使用されています。
4.3.2 Pattern language
...
pattern variables that occur in the template are replaced by the subforms they match in the input.
— Richard Kelsey, William Clinger, And Jonathan Rees (Editors)
5.3.2 パターン言語
...
テンプレート内に現れるパターン変数は入力内の一致する部分形式で置き換えられる。
— RICHARD KELSEY、WILLIAM CLINGER、JONATHAN REES (編集)…20 february 1998 (犬飼 大訳: 7 May 1999)
とあるので、 symbol?? マクロへシンボル、例えば symbol が渡された場合には、 (test symbol t f) というパターン部が定義されるのに対して、数値や文字列の場合には、例えば "string" が渡された場合 (test "string" t f) というパターン部が定義されます。その上で、この補助マクロへ abracadabra というシンボルが渡されて、パターンマッチが試みられるので、 symbol?? マクロへシンボルが渡された場合には t が返されます。一方、数値や文字列の場合には (test x t f) の方がマッチして f が返されます。
(symbol?? symbol #t #f) ;;-> (let-syntax ((test (syntax-rules () ((test symbol t f) t) ((test x t f) f)))) (test abracadabra #t #f)) ;;=> #t (symbol?? "string" #t #f) ;;-> (let-syntax ((test (syntax-rules () ((test "string" t f) t) ((test x t f) f)))) (test abracadabra #t #f)) ;;=> #f
唐突な abracadabra が何かモヤモヤしてしまいます。任意のシンボルであれば動作する、ということを示しているのだと思うのだけれども、使い捨てのシンボルがいきなり現れているところがモヤっと感じてしまいます。
Identifiers that appear in <literals> .. とは？
<リテラル>の扱いがいまいちわからない部分があったので整理します。
4.3 Macros
...
4.3.2 Pattern language
A <transformer spec> has the following form:
syntax: syntax-rules <literals> <syntax rule> …
...
Identifiers that appear in <literals> are interpreted as literal identifiers to be matched against corresponding subforms of the input. A subform in the input matches a literal identifier if and only if it is an identifier and either both its occurrence in the macro expression and its occurrence in the macro definition have the same lexical binding, or the two identifiers are equal and both have no lexical binding.
— Richard Kelsey, William Clinger, And Jonathan Rees (Editors)
後者（or〜以降）は、二つの識別子が同じで、両方とも字句的束縛がされていない、ということは、例えば、 yelse の束縛が無い場合に以下のような結果になる、ということだと考えられます。
(let-syntax ((test (syntax-rules (yelse) ((_ yelse) 'ok) ((_ x) 'no)))) (test yelse)) ;;=> ok
前者がどんな例があるかを考えます。素直に考えると以下のものが思い付くのだけれども、上の例との違いがほとんど無いので、いまいちはっきりとしません。これをもってして、“扱いがいまいちわからない”、と考えています。
(the macro expression って？というのもあるのですが、以下の場合では、多分、 (test yelse) の式のことだと思うのですが自信無いです…）
(let ((yelse '(value))) (let-syntax ((test (syntax-rules (yelse) ((_ yelse) 'ok) ((_ x) 'no)))) (test yelse))) ;;=> ok
自分なりに考えを整理すると、見た目・字面が同じなので、単に字面で <literals> を比較しているのでは？という疑問が残る、ということです。
この疑問を解消するには、(1)それぞれ異なる場所に束縛されている識別子を比べてみる、(2)どちらか一方のみが、ある場所に束縛されている識別子を比べてみる、その結果、リテラルのパターンにマッチしないということを確認すれば納得できると考えたので、やってみました。
例えば、マクロの使用している外側で <literals> に現れる識別子を別の場所に束縛して試すことはよくあります。仕様にものっている例だと以下のように。
(let ((=> #f)) (cond (#t => 'ok))) ;;=> ok
ただ、 => を評価すると、シンタックスが返ってくるので特別扱いなのか？とか別の疑問が出てきてしまう…
話を戻して。以下の２つ、 'no が返ってくることが期待されていると考えます。
「それぞれ異なる場所に束縛されている識別子を比べてみる」もの: 'no が返ってくると考えます。
(let ((yelse '(value))) (let-syntax ((test (syntax-rules (yelse) ((_ yelse) 'ok) ((_ x) 'no)))) (let ((yelse #f)) (test yelse)))) ;;=> no ;; 正しい結果だと考えられます
この場合、どうやら単に字面を比べているのではない、ということがわかります。次に。
「どちらか一方のみが、ある場所に束縛されている識別子を比べてみる」もの: まず、マクロを呼び出している所では、ある場所に束縛されている場合。やっぱり 'no が返ってくると考えます。
(let-syntax ((test (syntax-rules (yelse) ((_ yelse) 'ok) ((_ x) 'no)))) (let ((yelse '(value))) (test yelse))) ;;=> no ;; 正しい結果だと考えられます
一方、マクロ定義で <literals> に現れる識別子が、ある場所に束縛されている場合、というのが簡単には書き下ろしずらいです。以下のような、別のモジュールから呼び出すという方法を思い付きました。
Gauche の場合では別のモジュールから字面を変えて呼び出せば納得できる結果を得ることができると考えられます。
(select-module user) (define-module t.syntax-rules-test (export-all)) (select-module t.syntax-rules-test) (define yelse '(value)) (define-syntax test-literal-bound (syntax-rules (yelse) ((_ yelse) 'ok) ((_ _) 'no))) (test-literal-bound yelse) ;;=> ok ;; これだけだと字面で比較しているかもしれないという疑問が残ります (define-syntax test-literal-unbound (syntax-rules (zelse) ((_ zelse) 'ok) ((_ _) 'no))) (test-literal-unbound zelse) ;;=> ok (let ((zelse '(value))) (test-literal-unbound zelse)) ;;=> no ;; これは仕様にもあるものによく似ています: ;; (let ((=> #f)) ;; (cond (#t => 'ok))) ;; => ok (select-module user) (import (t.syntax-rules-test :prefix t:)) (t:test-literal-bound t:yelse) ;;=> ok ;; 同じ場所に束縛されている識別子なので 'ok が返る（字面が違うのに注目します） ;; ただし、インポートを上記のように使うとこの結果が*たまたま* 'ok が返るよう ;; に識別子がインポートされる、ということの裏返し、とも考えられます。 ;; つまり、これは実装に依存する動作かもしれない、と。 (let ((yelse t:yelse)) (t:test-literal-bound yelse)) ;;=> no ;; 異なる場所に束縛されている識別子なので 'no が返る（字面は同じ） ;; XXX: これがわからない (t:test-literal-bound yelse) ;;=> ok ;; マクロ呼び出しの `yelse` はどの場所にも束縛されていない。 一方で、 ;; マクロ定義の `yelse` は束縛されているので 'no だと考えられるけれども…
マクロ定義の <literals> に現れる識別子が束縛されている場合で、マクロを呼び出す時には束縛が見えない場合、というのは思い付いた。
(let-syntax ((test (syntax-rules () ((_ arg) (let ((yelse '(value))) (let-syntax ((test-aux (syntax-rules (yelse) ((_ yelse) 'ok) ((_ x) 'no)))) (test-aux arg))))))) (test yelse)) ;; ここでは `yelse` は束縛されていない ;;=> ok ;; 正しい?
わからないので質問してみよう。
“JRM’s Syntax-rules Primer for the Merely Eccentric” メモ(番外)
読んでいるだけではつまらないので、 syntax-rules を実際に使ってみます。
単純な例で、“L.i.S.P”のサンプルに現れる define-class を考えます。
(define-class <name-of-the-class> <name-of-the-superclass>
( <name-of-a-Mono-Field> |
(= <name-of-a-Mono-Field>) |
(* <name-of-a-Poly-Field>)
... ) )
これをさらに単純化します。
(defclass <name-of-the-class> (<name-of-the-superclass> ...) (<name-of-slot> ...)) ;; 例えば以下のように書くことができるようにします。 (defclass <continuation> () (k)) ;;-> 展開形は Gauche の `define-class` に展開される以下を目指します。 (define-class <continuation> () ((k :init-keyword (make-keyword (quote k)))))
最初に考えたのがこちら。省略記号の使い方が中途半端なもの。
(define-syntax defclass (syntax-rules () ((_ e1 e2 slots) (%defclass-expand-slot slots () (e1 e2))))) (define-syntax %defclass-expand-slot (syntax-rules () ((_ () (xs ...) (e1 e2)) (define-class e1 e2 (xs ...))) ((_ (x xs ...) (ys ...) e) (%defclass-expand-slot (xs ...) (ys ... (x :init-keyword (make-keyword 'x))) e))))
slots を一つずつ処理して ys にコードを貯めていく、ということです。
省略記号の使い方がわかっていなかった、ということがわかるコードになってしまっています。では、省略記号を使わなかったとしたら、ということを考えます。
(define-syntax defclass (syntax-rules () ((_ e1 e2 slots) (%defclass-expand-slot slots () (e1 e2))))) (define-syntax %defclass-expand-slot (syntax-rules () ((_ () () ks (e1 e2)) (define-class e1 e2 ks)) ((_ () (y . ys) ks e) (%defclass-expand-slot () ys (y . ks) e)) ;; 上は４つ ;; 下は３つ ((_ () () e) (%defclass-expand-slot () () () e)) ((_ () (y . ys) e) (%defclass-expand-slot () ys (y) e)) ((_ (x . xs) ys e) (%defclass-expand-slot xs ((x :init-keyword (make-keyword 'x)) . ys) e))))
slots を一旦全て処理します。 (slotname :init-keyword :slotname) というコードを貯めて行く、これが“下は３つ”の所でやっていることです。 slots の処理を終えたら、“上は４つ”に処理を移して、 ys を反転して ks を作ります。ここで、 ys の処理を終えたら (define-class ..) へ展開して終了します。
似たようなことを label をパターンに置く手法を使ってみます。
(define-syntax defclass (syntax-rules () ((_ e1 e2 slots) (%defclass-expand-slot "collect" slots () (e1 e2))))) (define-syntax %defclass-expand-slot (syntax-rules () ((_ "emit" ks (e1 e2)) (define-class e1 e2 ks)) ((_ "reverse" () ks e) (%defclass-expand-slot "emit" ks e)) ((_ "reverse" (y . ys) ks e) (%defclass-expand-slot "reverse" ys (y . ks) e)) ((_ "collect" () () e) (%defclass-expand-slot "emit" () e)) ((_ "collect" () ys e) (%defclass-expand-slot "reverse" ys () e)) ((_ "collect" (x . xs) ys e) (%defclass-expand-slot "collect" xs ((x :init-keyword (make-keyword 'x)) . ys) e))))
やりたいことは、 slots を map したいだけなのにひどくめんどうなことになってしまっています。実はこれは省略記号を使うことで簡単、簡潔に実現できることがわかります。
(define-syntax defclass (syntax-rules () ((_ e1 e2 (slot-name ...)) (define-class e1 e2 ((slot-name :init-keyword (make-keyword 'slot-name)) ...)))))
“JRM’s Syntax-rules Primer for the Merely Eccentric” のおかげで syntax-rules の使い方が少しずつですけれどもわかってきているような気がしています。
“JRM’s Syntax-rules Primer for the Merely Eccentric” メモ(その3)
続きです、 sreverse 辺りから。メモっていきます。
(define-syntax sreverse (syntax-rules () ((sreverse thing) (sreverse "top" thing ("done"))) ((sreverse "top" () (tag . more)) (sreverse tag () . more)) ((sreverse "top" ((headcar . headcdr) . tail) kont) (sreverse "top" tail ("after-tail" (headcar . headcdr) kont))) ((sreverse "after-tail" new-tail head kont) (sreverse "top" head ("after-head" new-tail kont))) ((sreverse "after-head" () new-tail (tag . more)) (sreverse tag new-tail . more)) ((sreverse "after-head" new-head (new-tail ...) (tag . more)) (sreverse tag (new-tail ... new-head) . more)) ((sreverse "top" (head . tail) kont) (sreverse "top" tail ("after-tail2" head kont))) ((sreverse "after-tail2" () head (tag . more)) (sreverse tag (head) . more)) ((sreverse "after-tail2" (new-tail ...) head (tag . more)) (sreverse tag (new-tail ... head) . more)) ((sreverse "done" value) 'value )))
空行を消しました。
まず、 car 部がペアの場合が以下で、そこは取り合えず置いておきます。
...
((sreverse "top" ((headcar . headcdr) . tail) kont)
(sreverse "top" tail ("after-tail" (headcar . headcdr) kont)))
((sreverse "after-tail" new-tail head kont)
(sreverse "top" head ("after-head" new-tail kont)))
((sreverse "after-head" () new-tail (tag . more))
(sreverse tag new-tail . more))
((sreverse "after-head" new-head (new-tail ...) (tag . more))
(sreverse tag (new-tail ... new-head) . more))
...ペアでなかった場合が以下、 cdr 部を "after-tail2"という"継続"を作って辿って行きます。ここで、継続と呼んでいるものが"起動"された時に渡される形、パターンは、 (sreverse tag 新しい引数 継続作成時の任意の値 残りの継続) ということになります。
...
((sreverse "top" () (tag . more))
(sreverse tag () . more))
...
((sreverse "top" (head . tail) kont)
(sreverse "top" tail ("after-tail2" head kont)))
((sreverse "after-tail2" () head (tag . more)) ;; この部分は、一つ下で
(sreverse tag (head) . more)) ;; 表現できるので不用な
;; 気もします
((sreverse "after-tail2" (new-tail ...) head (tag . more))
(sreverse tag (new-tail ... head) . more))
...
;; マクロエクスパンドを一ステップずつ
(srverse (a b))
(sreverse "top" (a b) ("done"))
(sreverse "top" (b) ("after-tail2" a ("done")))
(sreverse "top" () ("after-tail2" b ("after-tail2" a ("done"))))
(sreverse "after-tail2" () b ("after-tail2" a ("done")))
(sreverse "after-tail2" (b) a ("done"))
(sreverse "done" (b a))
(quote (b a))話を戻して car 部がペアの場合。
...
((sreverse "top" ((headcar . headcdr) . tail) kont)
(sreverse "top" tail ("after-tail" (headcar . headcdr) kont)))
((sreverse "after-tail" new-tail head kont)
(sreverse "top" head ("after-head" new-tail kont)))
((sreverse "after-head" () new-tail (tag . more)) ;; この部分は通らない
(sreverse tag new-tail . more)) ;; ので不用な気もします
((sreverse "after-head" new-head (new-tail ...) (tag . more))
(sreverse tag (new-tail ... new-head) . more))
...ここでは、コメントにある、通らないパターンじゃないかな、と思うのはなぜかを書きます。
もう一度継続が起動されるパターンを示しておきます。
(sreverse tag "新しい引数" "継続作成時の任意の値" "残りの継続")
さて、 (sreverse "after-head" () new-tail (tag . more)) として"after-head"が起動されるかどうかを考えます。"新しい引数"の部分に渡されるものは、 "after-head"作成時に辿っていた値を処理した後のものです。つまり (sreverse "after-tail" new-tail head kont) でパターンマッチした"head"の値の処理後のもの。もう一つ処理を振り返って、もともとは"after-tail"作成時の"継続作成時の任意の値"の部分のもので、
((sreverse "top" ((headcar . headcdr) . tail) kont)
(sreverse "top" tail ("after-tail" (headcar . headcdr) kont)))この (headcar . headcdr) つまり、 car 部がペアの場合のパターンとしていた値そのものです。これが () になることはないので、通らないパターンじゃないかな、と考えられます。
というわけで、自分なりに整理したのが以下。
(define-syntax srev (syntax-rules () ((srev s) (srev "top" s ("done"))) ((srev "top" () (tag . more)) (srev tag () . more)) ((srev "top" ((headcar . headcdr) . tail) kont) (srev "top" tail ("after-tail" (headcar . headcdr) kont))) ((srev "after-tail" new-tail head kont) (srev "top" head ("after-head" new-tail kont))) ((srev "after-head" new-head (new-tail ...) (tag . more)) (srev tag (new-tail ... new-head) . more)) ((srev "top" (head . tail) kont) (srev "top" tail ("after-tail2" head kont))) ((srev "after-tail2" (new-tail ...) head (tag . more)) (srev tag (new-tail ... head) . more)) ((srev "done" value) 'value)))
Schemeの関数でやっていることを直接表現するとしたらこんな具合だろうか、というのが以下のようなものです。
(let () (define (rev s k) (cond ((null? s) (k '())) ((pair? (car s)) (rev (cdr s) (lambda (r) (rev (car s) (lambda (l) (k (append r (list l)))))))) (else (rev (cdr s) (lambda (l) (k (append l (list (car s))))))))) (rev '(a (1 (11 (111) 22) 2 3) (A B C) b) values)) ;;=> (b (C B A) (3 2 (22 (111) 11) 1) a)
話が逸れるけれどもツリーを反転する、というコードを何個か書き下ろします。
(use srfi-1 :only (list=)) (let () (define (rev-recur s) (define (recur s) (cond ((null? s) '()) ((pair? (car s)) `(,@(recur (cdr s)) ,(recur (car s)))) (else `(,@(recur (cdr s)) ,(car s))))) (recur s)) (define (rev-accum s) (define (recur s a) (cond ((null? s) a) ((pair? (car s)) (recur (cdr s) (cons (recur (car s) '()) a))) (else (recur (cdr s) (cons (car s) a))))) (recur s '())) (define (rev-kont s) (define (recur s k) (cond ((null? s) (k '())) ((pair? (car s)) (recur (cdr s) (lambda (r) (cons (recur (car s) values) (k r))))) (else (recur (cdr s) (lambda (r) (cons (car s) (k r))))))) (recur s values)) (let ((s '(1 (A B C (a b)) 2)) (r '(2 ((b a) C B A) 1))) (list= equal? r (rev-recur s) (rev-accum s) (rev-kont s)))) ;;=> #t
“JRM’s Syntax-rules Primer for the Merely Eccentric” メモ(その2)
続き、Ellipses から。メモっていきます。
*** Ellipses must be last in a list or vector pattern. The list or vector must have at least one initial pattern.
*** Ellipses is a postfix operator that operates on the pattern before it.
*** Ellipses allows the containing list or vector pattern to match provided that the head elements of the pattern match the head elements of the list or vector up to (but not including) the pattern before the ellipses, and zero or more copies of that pattern match each and all of the remaining elements.
*** Remember that zero occurrance of the pattern can ‘match’.
この辺は直観的に解る気がします。この辺というのは、はっきり書くと、パターン部に記述する分には、ということです。これを踏まえてじゃあテンプレート部ではどうなるか、ということについてはその次です。
When a pattern has an ellipses, the pattern variables within the clause prior to the ellipses work differently from normal. When you use one of these pattern variables in the template, it must be suffixed with an ellipses, or it must be contained in a template subform that is suffixed with an ellipses. In the template, anything suffixed with an ellipses will be repeated as many times as the enclosed pattern variables matched.
これ以下のように、日本語の文章にしてみます。
パターンに略記号があった場合、略記号の前にあるパターン変数の働きが普段と違ってきます。そのような略記号の前にあるパターン変数を、テンプレート部に使う時には、パターン変数それ自体に略記号が続いている、もしくは、略記号が続いているサブフォームの中にパターン変数がある、ということが必須となります。テンプレート部で、略記号が続いているものは全て、そのパターン変数がマッチしたと同じ回数分、繰り返されるということになります。
実際に動かしてみます。
;; ((a ...) (b ...) var (c ...)) (let-syntax ((foo (syntax-rules () ((foo var #t ((a . b) c) ...) '((a ...) (b ...) var (c ...)))))) (foo 11 #t ((moe larry curly) stooges) ((carthago delendum est) cato) ((egad) (mild oath)))) ;;=> ;; ((moe carthago egad) ;; ((larry curly) (delendum est) ()) ;; 11 ;; (stooges cato (mild oath))) ;; ((a b c) ... var) (let-syntax ((foo (syntax-rules () ((foo var #t ((a . b) c) ...) '((a b c) ... var))))) (foo 11 #t ((moe larry curly) stooges) ((carthago delendum est) cato) ((egad) (mild oath)))) ;;=> ;; ((moe (larry curly) stooges) ;; (carthago (delendum est) cato) ;; (egad () (mild oath)) ;; 11) ;; ((c . b) ... a ...) (let-syntax ((foo (syntax-rules () ((foo var #t ((a . b) c) ...) '((c . b) ... a ...))))) (foo 11 #t ((moe larry curly) stooges) ((carthago delendum est) cato) ((egad) (mild oath)))) ;;=> ;; ((stooges larry curly) ;; (cato delendum est) ;; ((mild oath)) ;; moe carthago egad) ;; (let ((c 'b) ...) (a 'x var c) ...) (let-syntax ((foo (syntax-rules () ((foo var #t ((a . b) c) ...) '(let ((c 'b) ...) (a 'x var c) ...))))) (foo 11 #t ((moe larry curly) stooges) ((carthago delendum est) cato) ((egad) (mild oath)))) ;;=> ;; (let ((stooges (quote (larry curly))) ;; (cato (quote (delendum est))) ;; (#0=(mild oath) (quote ()))) ;; (moe (quote x) 11 stooges) ;; (carthago (quote x) 11 cato) ;; (egad (quote x) 11 #0#))
実際動かしてみると、ざっくりだけれども略記号の働きをより深く再確認できたんじゃないかなと。というわけで、前回の multiple-value-set! を考えます。
;; 再掲: ;; これが (multiple-value-set! (a b c) (values 1 2 3)) ;; こう展開されるのを目指します (call-with-values (lambda () (values 1 2 3)) (lambda (tmp1 tmp2 tmp3) (set! a tmp1) (set! b tmp2) (set! c tmp3))) ;; 再掲おわり ;; ... を使う例 (define-syntax multiple-value-set! (syntax-rules () ((_ vars values-form) (gen-tmps-and-sets vars () () values-form)))) (define-syntax emit-cwv-form (syntax-rules () ((_ tmps assignments values-form) (call-with-values (lambda () values-form) (lambda tmps . assignments))))) (define-syntax gen-tmps-and-sets (syntax-rules () ((_ () tmps sets values-form) (emit-cwv-form tmps sets values-form)) ((_ (var . vars) (tmps ...) (sets ...) values-form) (gen-tmps-and-sets vars (tmps ... tmp) (sets ... (set! var tmp)) values-form)))) (let ((a #f) (b #f) (c #f)) (multiple-value-set! (a b c) (values 1 2 3)) (list a b c)) ;;=> (1 2 3) ;;-> ;; (call-with-values ;; (lambda () (values 1 2 3)) ;; (lambda (tmp tmp tmp) ;; (set! a tmp) ;; (set! b tmp) ;; (set! c tmp)))
(var . vars) の所で再帰的に gen-tmps-and-sets を呼び出すのだけれども、累積する所それぞれに略記号 ... を使い、末尾に値が追加されて貯まっていくようにしています。
コード片がもう少し込み入ったものを写経します。
(define-syntax trace-subforms (syntax-rules () ((_ form) (trace-expand form ())))) (define-syntax trace-expand (syntax-rules () ((_ () traced) (trace-emit . traced)) ((_ (form . forms) traced) (trace-expand forms ((begin (newline) (display "Evaluating ") (display 'form) (flush) (let ((result form)) (display " => ") (display result) (flush) result)) . traced))))) (define-syntax trace-emit (syntax-rules () ((_ function . arguments) (begin (newline) (let ((f function) (a (list . arguments))) (newline) (display "Now applying function.") (flush) (apply f a)))))) (trace-subforms (+ 2 3)) ;;=> *** ERROR: invalid application: (3 2 #<subr (+ :rest args)>) ;;>> Evaluating 3 => 3 ;;>> Evaluating 2 => 2 ;;>> Evaluating + => #<subr (+ :rest args)> ;;>> Now applying function.
(この例はエラーとなるのだけれども、エラーを解消したものはすぐ後に示します。)
traced にコードを蓄積していくわけだけれども、 (trace-emit . traced) でつまづいたので、自分なりに解説してみます。なぜここで、 . を使うのかな、という疑問です。
traced には ((begin ..) (begin ..) (begin ..) ..) のように、 begin にくるまれたコード片が蓄積されています。一方、 trace-emit で、 (trace-emit function . arguments) というパターンを指定しているのは恐らく、普段のSchemeコード上の関数定義に似た形であることを重視しているのかな、と考えられます。そこで、 trace-emit マクロを呼び出す箇所では、 (trace-emit traced) ではなく (trace-emit . traced) とすることで trace-emit マクロで指定しているパターンに合わせている、と考えます。
trace-emit を、 (trace-emit traced) として呼び出すとすると、 trace-emit 側で指定されているパターンは (trace-emit (function . arguments)) となっている必要があります。
自分はつまずいたので、どちらが後で眺めた時に意図したことが伝わるかな、と考えてみます。普段のSchemeの関数呼び出しでは (func a b c) の形をしているから、 trace-emit マクロ内で指定している (trace-emit function . argumets) というパターンは自然な気がします。それに合わせるように呼び出し側で工夫している、ということになるのだろうか。 N-ary マクロを取り扱うので、そこも注意点というのもあります。といったことが合わさってつまずいたのだろうと考えています。
エラーを解消するにはリストを反転するマクロを間に狭むことも考えられるけれども、略記号を使うと良い結果が得られるということで以下。
(define-syntax trace-subforms (syntax-rules () ((_ (form ...)) (trace-emit (begin (newline) (display "Evaluating ") (display 'form) (flush) (let ((result form)) (display " => ") (display result) (flush) result)) ...)))) (define-syntax trace-emit (syntax-rules () ((_ function . arguments) (begin (newline) (let ((f function) (a (list . arguments))) (newline) (display "Now applying function.") (flush) (apply f a)))))) (trace-subforms (+ 2 3)) ;;=> 5 ;;>> Evaluating + => #<subr (+ :rest args)> ;;>> Evaluating 2 => 2 ;;>> Evaluating 3 => 3 ;;>> Now applying function.
前の例では、 trace-expand を再帰的に呼び出してコード片を蓄積していったのだけれども（そして最後に反転すれば完成だった）、 ... 記号を使うことでやりたかったことは再帰的な呼び出し抜きにして達成できました。これ実は map 的なことをして、 trace-emit に与えているのだけれども、略記号を使うと簡潔に済ますことができました。
さてここでは上では触れなかった (list . arguments) の部分に注目します。その前の (let ((f function) ..)) は、 function にはコード片そのものがある、というか、パターン変数（の参照というか…）が表れている、と。テンプレートに表れるパターン変数は入力内の一致する部分形式に置き換えられる、ので展開系は以下のようになります。
(let ((f (begin ..)) ..) ..)
コード片を評価して f に束縛される、というコードに展開されます。 (list . arguments) も考えると、
(let ((f (begin ..)) (a (list (begin ..) (begin ..) ..))) ..)
こうなるわけで、ある意味、実行している Scheme 処理系がどのように let や (list ..) を評価するかを見ているとも考えられます。なんで let* へ展開しなかったんだろう、とか、 (list ..) の部分の評価順を考慮していたんだろうか、とか考えてしまうけれどもここで止めておきます。
末尾再帰で書く必要があるなら、リスト等の要素を先頭から見ていく時に、コンスして蓄積して行くとすると最後には反転する必要がある、これを避けるには、蓄積する時に、略記号で要素を (append temps (list temps)) すると都合が良い、ただし、実行時のコードでは避けるイディオムだけれども、マクロ展開時には普通に使われる手法である、と。“On Lisp”か何かでも目にしたような気がする。
*** Use ellipses to extend lists while retaining the order.
*** Use ellipses to ‘flatten’ output.
flatten の例を実際に試してみます。
(let-syntax ((foo (syntax-rules () ((foo (f1 ...) (f2 ...) . forms) '(f1 ... f2 ... . forms))))) (foo (a b c d) (1 2 3 4) moe larry curly)) ;;=> (a b c d 1 2 3 4 moe larry curly)
最後。補助マクロをグローバルに定義するのに気が引ける場合には、 label をパターンに置いてローカルマクロっぽくするという手があります、と。
(define-syntax multiple-vaule-set! (syntax-rules () ((_ vars values-form) (mvs-aux "gen-code" vars () () values-form)))) (define-syntax mvs-aux (syntax-rules () ((_ "gen-code" () tmps sets values-form) (mvs-aux "emit" tmps sets values-form)) ((_ "gen-code" (var . vars) (tmps ...) (sets ...) values-form) (mvs-aux "gen-code" vars (tmps ... tmp) (sets ... (set! var tmp)) values-form)) ((_ "emit" tmps sets values-form) (call-with-values (lambda () values-form) (lambda tmps . sets))))) (let ((a #f) (b #f) (c #f)) (multiple-vaule-set! (a b c) (values 1 2 3)) (list a b c)) ;;=> (1 2 3) ;;-> ;; (call-with-values ;; (lambda () (values 1 2 3)) ;; (lambda (tmp tmp tmp) ;; (set! a tmp) ;; (set! b tmp) ;; (set! c tmp)))
“JRM’s Syntax-rules Primer for the Merely Eccentric” メモ(その1)
sreverse マクロまで読んだのでそこまで復習で、メモっていきます。
こちらの筆者は、混乱のもとになるから、マクロ名を書くのが好み、とのことです。まだ混乱するくらいの量を書いたことがないので、今のところ _ にした方が楽な気がするけれど、という感触です。
You may find macros written using the token “_” rather than repeating the name of the macro:
…
I personally find this to be confusing and would rather duplicate the macro name.
(define-syntax nth-value (syntax-rules () ((nth-value n value-producing-form) (call-with-values (lambda () value-producing-form) (lambda all-values (list-ref all-values n)))))) (define-syntax nth-value (syntax-rules () ((_ n values-producing-form) (call-with-values (lambda () values-producing-form) (lambda all-values (list-ref all-values n))))))
*** Macro `rest args’ get bound to a list of forms, so remember to `unlist’ them at some point.
…
*** Implicit Begin idiom
…
N-ary macro 、これが"だいたい"動いてしまってやっかいなことになることがあります、と。マクロあるあるなのかな。正しく動くやつが上、やっかいな形になるのが下。
(define-syntax when (syntax-rules () ((when condition . body) (if condition (begin . body) #f)))) (define-syntax when (syntax-rules () ((when condition . body) (if condition (begin body) #f))))
下の例だと、展開形は (begin ((body …)) の形になってしまうこともあり、まず (body …) の部分が評価されて、更にその結果を関数呼び出しに試みるので、 (body …) のコードが評価されてから、関数として評価できない、というエラーが起こる。 (body …) が評価されていることと、その後にエラーが起きるため何が悪かったのかわかりにくく、 (when …) の後にエラーが起こったのものと誤解してしまいやすい、ということらしいです。こうすれば回避できる、という一般的な解答は無いので気を付けましょう、という。
これふわっと、例えば unlist と呼んでいるのですけれども、 unquote-splicing とはここでは呼ばないんですよね。 (begin . body) は `(begin ,@(body …)) のように見えます、と言ってしまえばわかり良いように思うのだけれども。
更に一歩進めて、最低一つは必ずフォームがあって欲しい場合がよくあるけれど、そんな時に。
The pattern should end in “FORM . FORMS)” to ensure a minimum of one subform.
(define-syntax when (syntax-rules () ((when condition form . forms) (if condition (begin form . forms) #f))))
少なくとも一つは form が無い場合、パターンにマッチしないのでエラーになります。成程。
‘Accidental’ matching
一見正しそうに見えるパターンだけれども、シンボルは何にでもマッチする、ということを忘れるとおかしなことになるケースがあるので気を付けましょう、というやつです。
;; このパターンは一見、的確なように見える。ただこれだけだとマズい… (my-named-let name (binding . more-bindings) . body) ;; 以下の一見それっぽいコードで意図と違うことが起きることが解る (my-named-let ((x 22) (y "computing square root")) (display y) (display (sqrt x)))
シンボルは何にでもマッチするのでこれを防ぐようにするには？ということで示されるのが以下。
(define-syntax my-named-let (syntax-rules () ((my-named-let () . ignore) (syntax-error "NAME must not be the empty list.")) ((my-named-let (car . cdr) . ignore) (syntax-error "NAME must be a symbol." (car . cdr))) ((my-named-let name bindings form . forms) ;; implicit begin (let name bindings form . forms))))
空リストと、 (car . cdr) と陽にペアのパターンを指定しています、 Accidental matching を防ぐ。成程、固いマクロを書くむつかしさですかね。
Recursive expansion
…
*** Introduce associated code fragments in a single expansion step.
*** Introduce duplicated, but unassociated fragments in different expansion steps.
Common Lisp の multiple-value-setq のようなマクロを作ってみましょう、というもの。
それはそうと“Too Many Daves”だけれども、こちらの書評がとても助かる。
さて本題。
;; これが (multiple-value-set! (a b c) (values 1 2 3)) ;; こう展開されるのを目指します (call-with-values (lambda () (values 1 2 3)) (lambda (tmp1 tmp2 tmp3) (set! a tmp1) (set! b tmp2) (set! c tmp3)))
第一弾、まだまだまずい形なのだけれども。 emit-cwv-form が最終的にコードに落とし込みます。
(define-syntax multiple-value-set! (syntax-rules () ((_ vars values-form) (gen-tmps-and-sets () () vars values-form)))) (define-syntax emit-cwv-form (syntax-rules () ((_ tmps assignments values-form) (call-with-values (lambda () values-form) (lambda tmps . assignments))))) (define-syntax gen-tmps-and-sets (syntax-rules () ((_ tmps sets () values-form) (emit-cwv-form tmps sets values-form)) ((_ tmps sets (var . vars) values-form) (gen-tmps-and-sets (tmp . tmps) ((set! var tmp) . sets) vars values-form)))) (let ((a #f) (b #f) (c #f)) (multiple-value-set! (a b c) (values 1 2 3)) (list a b c)) ;;=> (3 2 1) (multiple-value-set! (a b c) (values 1 2 3)) ;;-> ;; (call-with-values ;; (lambda () (values 1 2 3)) ;; (lambda (tmp tmp tmp) ;; (set! c tmp) ;; (set! b tmp) ;; (set! a tmp)))
gen-tmps-and-set のパラメータにそれぞれ tmp と (set! var tmp) をコンスしてゆきます。ここで (var . vars) の部分が空になったら emit-cwv-form が呼ばれます。
マクロ展開後のフォームが unwrap-syntax してある結果、 tmp が三つあるように見えますが、 lambda 式に現れる tmp と set! に表れる tmp とは、同じ展開ステップで作られたシンタックスオブジェクトは同じものを指し、違う展開ステップで作られたものと異なる、ということが説明されます。ステップ毎に 1,2… と勝手に名前を付けるとすると、展開形は以下のような具合になると考えられます:
(multiple-value-set! (a b c) (values 1 2 3)) ;;-> ;; (call-with-values ;; (lambda () (values 1 2 3)) ;; (lambda (tmp3 tmp2 tmp1) ;; (set! c tmp3) ;; (set! b tmp2) ;; (set! a tmp1)))
第二弾。これは第一弾の展開形をふわっと受けての話だと思うのだけれども。実行するとエラーとなるものです。
(define-syntax multiple-value-set! (syntax-rules () ((_ vars values-form) (gen-tmps vars () vars values-form)))) (define-syntax gen-tmps (syntax-rules () ((_ () tmps sets values-form) (gen-sets tmps sets () values-form)) ((_ (var . vars) tmps sets values-form) (gen-tmps vars (tmp . tmps) sets values-form)))) (define-syntax gen-sets (syntax-rules () ((_ tmps () sets values-form) (emit-cwv-form tmps sets values-form)) ((_ tmps (var . vars) sets values-form) (gen-sets tmps vars ((set! var tmp) . sets) values-form)))) (let ((a #f) (b #f) (c #f)) (multiple-value-set! (a b c) (values 1 2 3)) (list a b c)) ;;!> *** ERROR: unbound variable: #<identifier user#tmp.2002300> (multiple-value-set! (a b c) (values 1 2 3)) ;;-> ;; (call-with-values ;; (lambda () (values 1 2 3)) ;; (lambda (tmp tmp tmp) ;; (set! c tmp) ;; (set! b tmp) ;; (set! a tmp)))
gen-sets の中で、 ((set! var tmp) ...) としているけれども、この tmp が unbound だということだと考えられます。 tmp が現れるのは、 gen-tmps と gen-sets なので、それぞれ別モノになるのがわかります。特に gen-set の中で tmp が出てくるのだけれども、卒直に言うと、何の脈絡もなく急に tmp が出てきたような感じがあります。展開形を見ると確かに、 (set! c tmp) のようになるので適切かのように考えても無理は無い、ということかもしれないけれども、この展開形に出てくる tmp は全て異なるシンタックスオブジェクトになってしまいます、と。
第三弾。一旦 tmp のリストを作ってそのリストを分解して set! 用のリストを作ると意図通りの動作となります。
(define-syntax multiple-value-set! (syntax-rules () ((_ vars values-form) (gen-tmps vars () vars values-form)))) (define-syntax gen-tmps (syntax-rules () ((_ () tmps sets values-form) (gen-sets tmps tmps sets () values-form)) ((_ (var . vars) tmps sets values-form) (gen-tmps vars (tmp . tmps) sets values-form)))) (define-syntax gen-sets (syntax-rules () ((_ tmps0 _ () sets values-form) (emit-cwv-form tmps0 sets values-form)) ((_ tmps0 (tmp . tmps) (var . vars) sets values-form) (gen-sets tmps0 tmps vars ((set! var tmp) . sets) values-form)))) (let ((a #f) (b #f) (c #f)) (multiple-value-set! (a b c) (values 1 2 3)) (list a b c)) ;;=> (1 2 3) (multiple-value-set! (a b c) (values 1 2 3)) ;;-> ;; (call-with-values ;; (lambda () (values 1 2 3)) ;; (lambda (tmp tmp tmp) ;; (set! c tmp) ;; (set! b tmp) ;; (set! a tmp)))
L.i.S.P 写経(番外)、3章
前回、バックトレース用に、こんな関数を示したのだけれども。この章のコードに対しては、いかにも違和感がある気がしますので、ジェネリック関数を使った版も書いてみました。
(define (%backtrace k) (for-each (let1 level 0 (lambda (k) (with-input-from-string (with-output-to-string (cut gosh:d k)) (lambda () (let loop ((line (read-line))) (unless (eof-object? line) (dotimes (level) (display " ")) (print (if (> (string-length line) #0=(- 66 level)) (string-take line #0#) line)) (loop (read-line)))))) (update! level (pa$ + 2)))) (let recur ((k k) (c values)) (if (is-a? k <bottom-cont>) (cons k (c '())) (recur (~ k 'k) (lambda (r) (cons k (c r))))))))
我ながらパーっと書いた感が拭えません。特に、せっかくオブジェクト指向に書いているのにもかかわらず、陽にループしながら (is-a? k <bottom-cont>) のところがイケていない気がします。
というわけで以下。
(define-method trace-print ((k <continuation>) level) (with-input-from-string (with-output-to-string (cut gosh:d k)) (lambda () (let loop ((line (read-line))) (unless (eof-object? line) (dotimes (level) (display " ")) (print (if (> (string-length line) #0=(- 66 level)) (string-take line #0#) line)) (loop (read-line))))))) (define-constant +indent+ 2) (define-method trace ((k <continuation>) cont) (trace (~ k 'k) (lambda (n) (trace-print k n) (cont (+ n +indent+))))) (define-method trace ((k <bottom-cont>) cont) (trace-print k 0) (cont +indent+) #t) (define (backtrace k) (trace k values))
ただし、これでも trace メソッドの中身をもう一つどうにかできるのではないかという気もします。
L.i.S.P 写経(その2)、3章
<full-env> はスロットだけ定義されているクラスなのだろうと考えられます。（メソッドを定義する意味が良くわからない。）インスタンスを作られないことにするという方法がありそうだけれど。
と書いたけれども、 block/return-from は <block-env> を使ってアドホックに実現しようとしているので必要になる、ということなのでした。 evaluate に渡される r はレキシカルな環境の（言い方が悪いが）ごった煮で、値に使われるし、 block name にも使われます。
The block named name has lexical scope and dynamic extent.
前の章までのインタープリタでは、新たな環境を実現するのに、例えば fenv を evaluate の引数に追加する、の方法が用いたのだけれども、今回はそうでは無いということ。ジェネリック関数 block-lookup では <block-env> に実装しておいて、他の <full-env> では 'others を辿るだけの実装にしてあって。 lookup の <full-env> にも同様に実装しておいてある、と。
block は name は評価しないのだけれども、これが特徴かしら。 catch と比較するために引用します。
tag---a catch tag; evaluated.
name---a symbol.
evaluated とわざわざ書いてあります、対して block の方に置けるのはシンボルのみ、比較してみると興味深いです。
block-lookup は ;** Modified ** と記述があるけれども、変更されていないように見えるけれども、どうなのだろう。動いているところは確認できます。
(is '("foocleanup" . bar) (let1 r #f (cons (with-output-to-string (lambda () (set! r (eval~ '(block bar (unwind-protect (begin (display "foo") (return-from bar 'bar) (display "more-foo")) (display "cleanup"))))))) r))) ;;>> test `is', expects ("foocleanup" . bar) ==> ok
以下は本文では error! ということなのだけれども、確かにこれどうするんだ？、という気がします。
(catch 1 (catch 2 (unwind-protect (throw 1 'foo) (throw 2 'bar))))
CLHS には undefined consequences という記述があります。
;;; The following has undefined consequences because the catch of B is ;;; passed over by the first THROW, hence portable programs must assume ;;; its dynamic extent is terminated. The binding of the catch tag is not ;;; yet disestablished and therefore it is the target of the second throw. (catch 'a (catch 'b (unwind-protect (throw 'a 1) (throw 'b 2))))
Exercise 3.6の解答の evaluate-lambda が 3.4 で使ったやつそのままなので動かない、あと invoke も extend-env をローカルに定義しなくても良い気がする。 names と values どちらも null? になることがないから、ということかな。それを言ってしまうと、exercise 3.4 の時にも、 シンボルになることはなかったはずで…と思うのだけれども。
両方とも invoke メソッドの中に定義してしまえ、というわけで以下。
(define-method invoke ((f <function-with-arity>) v* r k) (define (%extend-env env names values) (if (pair? names) (make <variable-env> :name (car names) :value (car values) :others (%extend-env env (cdr names) (cdr names))) env)) (if (= (~ f 'arity) (length v*)) (let ((env (%extend-env (~ f 'env) (~ f 'variables) v*))) (evaluate-begin (~ f 'body) env k)) (wrong "Incorrect arity" (~ f 'variables) v*))) ... (define-method invoke ((f <function-nadic>) v* r k) (define (%extend-env env names values) (if (pair? names) (make <variable-env> :name (car names) :value (car values) :others (%extend-env env (cdr names) (cdr values))) (make <variable-env> :name names :value values :others env))) (if (>= (length v*) (~ f 'arity)) (let ((env (%extend-env (~ f 'env) (~ f 'variables) v*))) (evaluate-begin (~ f 'body) env k)) (wrong "Incorrect arity" (~ f 'variables) v*)))
シンボルで終わっているかを見て分岐するのが以下のコード。 <formals> (lambda-list) がシンボルの時にも対応するので常に cons した上で last-pair の cdr を見ている。成程なあ。
話を戻して。こうするので、上で見たように、 %extend-env はそれぞれのメソッド内に定義できる、と考えました。
(define (evaluate-lambda n* e* r k) (define (len n*) (if (pair? n*) (+ 1 (len (cdr n*))) 0)) (define (make-function class) (make class :variables n* :body e* :env r :arity (len n*))) (resume k (if (null? (cdr (last-pair (cons 'n n*)))) (make-function <function-with-arity>) (make-function <function-nadic>))))
前回は call/cc の実装に、 <continuation> に直接メソッドを追加したけれども、これに対して、 <reified-continuation> を作ってそこにメソッドを足すというのはどうか、というのが Exercise 3.8。
(defclass <reified-continuation> (<value>) (k)) (definitial call/cc (make <primitive> :name 'call/cc :address (lambda (v* r k) (if (= (length v*) 1) (invoke (car v*) (list (make <reified-continuation> :k k)) r k))))) (define-method invoke ((f <reified-continuation>) v* r k) (if (= (length v*) 1) (resume (~ f 'k) (car v*)) (wrong "Continuations expect one argument" v* r k)))
<continuation> に直接メソッドを足すわけではなく、それ用のクラスを作ります。実装の内部で使っているクラスを生々しく晒すのを避けることができる、という感触で、後続の章でも使うことができるような手法なのかな、と考えられます。
L.i.S.P 写経(その1)、3章
L.i.S.P 3章のインタープリタで継続とは何かを考えます。まずは自分の頭の中を整理します。
(begin (display "Hello,") (display _(call/cc (lambda (k) (k " world") "Hi!"))_) (display "!") (newline))
いつも通りここで、 k に束縛される継続を関数で表現しようとしてみます。
(lambda (x) ((lambda (v) (PRINT-THEN-REPL v)) ((lambda (v) (display v) (display "!") (newline)) x)))
このような関数で表すことができると考えられます。ただ、この例で行くと、テキストで上の方の部分。
((lambda (v) (PRINT-THEN-REPL v)) ((lambda (v) (display v) ... ... ) ... ))
ここまでは納得できます。というのは、 call/cc を評価しようとする時には既に"見て"いるから、と考えるからです。
((lambda (v) (PRINT-THEN-REPL v)) ((lambda (v) (display v) (display "!") ;; ここからは `k` が束縛された時には、まだ (newline)) ;; 見ていなかったように思える x))
わかっていないのはこのコメントで書いた部分です。まだ見ていなかったように思える式を、関数で表現しようとした時に書き下ろすことができてしまっている、これが納得できない、ということをもって、わからない、と考えています。今注目しているフォーム _(call/cc ...)_ の先にある式をなぜ書き下ろすことができるのか？という。
ここで、一歩引いて、 (begin ...) の方へ注目します。これは一つずつ式を次々に評価していくわけです。つまり、次の式を評価していく、という継続がそこにあるわけで、 _(call/cc ...)_ を待ち構えているのは (display ...) で、更に、次の式を評価していく継続が続く、と。言い替えると、このタイミングで既に見ていた。
こう考えると納得できます、また、継続とは必ずしも評価する式をそのまま書き下ろす、というような直接的な表現方法を使わなくても、同等のことを実現できそうな気もしてきます。
While the immediate goal is to evaluate the expression in the environment, the long term goal is to return a value to the continuation.
Quoting
式を評価してその結果の値を継続へ渡す、ということで、最もシンプルな例から。
(define (evaluate e r k) ... (if (atom? e) (cond ((symbol? e) (evaluate-variable e r k)) (else ...)) ...)) (define (evaluate-quote v r k) (resume k v))
もう一度書くと、式を評価して値が定まったら継続へ渡す。理に適っています。
最小で動かしたいので、試しに。
(define-class <testing-cont> (<continuation>) ()) (define-method resume ((k <testing-cont>) v) ((~ k 'k) v)) (evaluate '"100" #f (make <testing-cont> :k values)) ;;=> "100" (evaluate '100 #f (make <testing-cont> :k values)) ;;=> 100 ;; 何回も試したい気がするのでショートカット用に。 (define eval-testing (cut evaluate <> #f (make <testing-cont> :k values))) (test* 'tiral '("100" 100 symbol-100) (list (eval-testing "100") (eval-testing '100) (eval-testing '(quote symbol-100)))) ;; 更に短く。 (define-syntax is (syntax-rules () ((_ e ...) (test* "`is'" e ...)))) (is '("100" 100 symbol-100) (list (eval-testing "100") (eval-testing '100) (eval-testing '(quote symbol-100)))) ;;>> test `is', expects ("100" 100 symbol-100) ==> ok
Alteratives
if 式。 if 式を評価する、ということは、まず条件の式 (cadr e) を評価して、その値が定まったら、その値によって true 部か false 部の式で評価を続けていきます。条件部を再帰的に evaluate に渡し、その時に true/false 部をそのまま保持する継続を作っている、環境は if を評価しようとしているもの、継続も同様。言い替えると true/false 部を評価した結果の値は、 if 式そのものを待ち構えている継続に渡されるということ。なるほど。
(define (evaluate e r k) ... (case (car e) ... ((if) (evaluate-if (cadr e) (caddr e) (cadddr e) r k)) ... ... )) (defclass <if-cont> (<continuation>) et ef r) (define (evaluate-if ec et ef r k) (evaluate ec r (make <if-cont> :k k :et et :ef ef :r r))) (define-method resume ((k <if-cont>) v) (evaluate (if v (~ k 'et) (~ k 'ef)) (~ k 'r) (~ k 'k)))
動かしてみます、待ち構える継続オブジェクトを直接 make してみると継続に値が次々に渡されていく理解の助けになります。
(is 'te (eval-testing '(if #t 'te 'ef))) (is 'ef (eval-testing '(if (if #t #f #f) 'te 'ef))) (is 'ef (resume (make <if-cont> :et ''te :ef ''ef :r #f :k (make <testing-cont> :k values)) #f)) (is 'ef (eval-testing '(if (if #t #f #f) (if #t 'te #t) (if #t 'ef #t)))) (is 'ef (let* ((k0 (make <testing-cont> :k values)) (k1 (make <if-cont> :k k0 :et '(if 'te #t) :ef '(if #t 'ef #t) :r #f)) (k2 (make <if-cont> :k k1 :et #f :ef #f :r #f))) (resume k2 ;; この下の部分が最初の (if _#t_ #f #f) に対応します。 ;; evaluate-quote が (resume k2 #t) )))
evaluate と resume それぞれが呼び出し会う格好です。前章までの evaluate だけを再帰的に呼び出すインタープリタと違って、どこへ処理を続けていくか、ということを制御できる余地がありそうな所が、大きく違うところでしょうか。
Sequence
順次評価です、値が定まることがあるのが注意点。
(define (evaluate e r k) ... (case (car e) ... ((begin) (evaluate-begin (cdr e) r k)) ... ... )) (defclass <begin-cont> (<continuation>) e* r k) (define (evaluate-begin e* r k) (if (pair? e*) (if (pair? (cdr e*)) (evaluate (car e*) r (make <begin-cont> :e* e* :r r :k k)) (evaluate (car e*) r k)) (resume k +empty-begin-value+))) (define-method resume ((k <begin-cont>) _v) (evaluate-begin (cdr (~ k 'e*)) (~ k 'r) (~ k 'k))) (is +empty-begin-value+ (eval-testing '(begin))) (is 'symbol-begin (eval-testing '(begin 'symbol-begin))) (is 'symbol-begin ;; 途中が評価されているかは resume に #?=_v する？ (eval-testing '(begin (begin 'a 'b) 'symbol-begin)))
begin-cont の resume では、 begin を評価中なので、 evaluate ではなく evaluate-begin を呼び出しています。
Variable Environment
<full-env> はスロットだけ定義されているクラスなのだろうと考えられます。（メソッドを定義する意味が良くわからない。）インスタンスを作られないことにするという方法がありそうだけれど。
Functions
関数について。
<apply-cont> を作った後 evaluate-arguments を経由して <apply-cont> が resume する、という所で迷子になったので復習します。
(define (evaluate-application e e* r k) (evaluate e r (make <evfun-cont> :e* e* :r r :k k))) (define-method resume ((k <evfun-cont>) f) (evaluate-arguments (~ k 'e*) (~ k 'r) (make <apply-cont> :f f :r (~ k 'r) :k (~ k 'k)))) (define (evaluate-arguments e* r k) (if (pair? e*) (evaluate (car e*) r (make <argument-cont> :e* e* :r r :k k)) (resume k '()))) (define-method resume ((k <argument-cont>) v) (evaluate-arguments (cdr (~ k 'e*)) (~ k 'r) (make <gather-cont> :k (~ k 'k) :v v))) (define-method resume ((k <gather-cont>) v*) (resume (~ k 'k) (cons (~ k 'v) v*))) (define-method resume ((k <apply-cont>) v*) (invoke (~ k 'f) v* (~ k 'r) (~ k 'k))) (is 'a (evaluate-application '(lambda (a b) 'a) '('a 'b) (make <null-env>) (make <testing-cont> :k values))) ;; evaluate-arguments: '(a b) <apply> ;; evaluate: 'a <argument> '(a b) <apply> ;; resume <argument> 'a: ;; evaluate-arguments: '(b) <gather> 'a <apply> ;; evaluate: 'b <argument> '(b) <gather> 'a <apply> ;; resume <argument> 'b: ;; evaluate-arguments: '() <gather> 'b <gather> 'a <apply> ;; resume <gather> '(): ;; (cons 'b '()) <gather> 'a <apply> ;; (cons 'a (b)) <apply> ;; invoke <apply> '(a b)
<argument-cont> が resume すると、再帰的に evaluate-argument を呼び出します。ただ、 <argument-cont> ではなく <gather-cont> に入れ替えた形になり、この <gather-cont> を次に待ち構える継続にして <argument-cont> を作って評価します。（この段落の最初に戻る）そして、最終的に、 <gather-cont> を待ち構える継続 <apply-cont> に評価された引数が渡される、と。
call/cc
本題。 call/cc 関数は、 <primitive> として定義します、渡された関数を、 k を引数に呼び出します。すごい、そのまんまです。更に、継続オブジェクトは呼び出すことができるので、 invoke に反応するようにします。
(definitial call/cc (make <primitive> :name 'call/cc :address (lambda (v* r k) (if (= (length v*) 1) (invoke (car v*) (list k) r k) (wrong "Incorrect arity" 'call/cc v*))))) (define-method invoke ((f <continuation>) v* r k) (if (= (length v*) 1) (resume f (car v*)) (wrong "Continuations expect one argument" v* r k))) (is "Hello, world!\n" (with-output-to-string (lambda () (eval~ '(begin (display "Hello,") (display (call/cc (lambda (k) (k " world") "Hi!"))) (display "!") (newline)))))) (definitial k #f) (is '((car . cdr) (car . cdr)) (begin (eval~ '(begin (set! k (cons 'car (call/cc call/cc))) k)) (list (eval~ '((cdr k) 'cdr)) (eval~ 'k))))
継続を陽に作るインタープリタでは、このようにどこを取っても resume で切り出して呼び出すことができる、というのを確認しました。評価する時に、待ち受ける継続を作り評価した値を継続に渡していく、というのを再帰的に行っていくことで、計算が進んでいきます。
継続オブジェクトが評価する部分式そのものを保持しているので、書き下ろすということに近いと感じられます。一方、部分式そのものを持っているナイーブな実装であると言うことができます。
(select-module user) (define-module t.LiSP.chapter3f.stuff (use gauche.interactive :prefix gosh:) (use srfi-13)) (select-module t.LiSP.chapter3f.stuff) (define-values (eval~ <bottom-cont>) (with-module t.LiSP.chapter3f (values eval~ <bottom-cont>))) ;; (definitial k #f) しています (let1 k (begin (eval~ '(begin (display "Hello,") ((lambda (_ v) (display v)) 'dummy-arg (call/cc (lambda (kk) (set! k kk) (kk " world") "Hi!"))) (display "!") (newline))) (eval~ 'k)) (for-each (let1 level 0 (lambda (k) (with-input-from-string (with-output-to-string (cut gosh:d k)) (lambda () (let loop ((line (read-line))) (unless (eof-object? line) (dotimes (level) (display " ")) (print (if (> (string-length line) #0=(- 66 level)) (string-take line #0#) line)) (loop (read-line)))))) (update! level (pa$ + 2)))) (let recur ((k k) (c values)) (if (is-a? k <bottom-cont>) (cons k (c '())) (recur (~ k 'k) (lambda (r) (cons k (c r)))))))) ;;>> Hello, world! ;;>> #<<bottom-cont> 0x2e594f0> is an instance of class <bottom-cont> ;;>> slots: ;;>> f : #<subr (values :rest args)> ;;>> k : #<unbound> ;;>> #<<begin-cont> 0x2e78a90> is an instance of class <begin-cont> ;;>> slots: ;;>> e* : (((lambda (_ v) (display v)) 'dummy-arg (call/cc ( ;;>> r : #<<variable-env> 0x3903890> ;;>> k : #<<bottom-cont> 0x2e594f0> ;;>> #<<apply-cont> 0x2e7aa40> is an instance of class <apply-cont> ;;>> slots: ;;>> f : #<<function> 0x2e78270> ;;>> r : #<<variable-env> 0x3903890> ;;>> k : #<<begin-cont> 0x2e78a90> ;;>> #<<gather-cont> 0x2e7a2c0> is an instance of class <gather-c ;;>> slots: ;;>> v : dummy-arg ;;>> k : #<<apply-cont> 0x2e7aa40> ;;>> #<<argument-cont> 0x2e7cfc0> is an instance of class <argu ;;>> slots: ;;>> e* : ((call/cc (lambda (kk) (set! k kk) (kk " wor ;;>> r : #<<variable-env> 0x3903890> ;;>> k : #<<gather-cont> 0x2e7a2c0>
traverse puzzle とは？
こちらで触れられている “Olivier Danvy’s puzzle” なのですけれども、なぜそうなるのか全くわからない。
元ネタとして挙げられているコードはこちら。 Continuations and delimited control, How to remove a dynamic prompt: static and dynamic delimited continuation operators are equally expressible — http://okmij.org/ftp/continuations/#impromptu-shift
;; racket (require racket/control) (let () (define (traverse xs) (define (visit xs) (if (null? xs) '() (visit (shift k (cons (car xs) (k (cdr xs))))))) (reset (visit xs))) (traverse '(a b c))) ;;=> '(a b c) (let () (define (traverse xs) (define (visit xs) (if (null? xs) '() (visit (control k (cons (car xs) (k (cdr xs))))))) (prompt (visit xs))) (traverse '(a b c))) ;;=> '(c b a)
これらを見るとようやく、何がわからなかったのか、というのが把握できました。そもそも reset/shift と prompt/control はどういうもので何が違うのかを全く理解していなかった、というオチでした。限定継続オペレータを俯瞰できるので、それぞれどんな違いがあるのかを一望できます。（レポートのリファレンスを更に辿るのも良い）
というわけで、一歩一歩トレースしてみます。
shift や control が来たら、継続を関数で表現しようとしてみて、続くフォームの評価をどんな継続へ渡してゆくのかを考えてゆく、ということにしました。
まずは、 reset/shift について。
(reset (shift k (cons 1 (k #f))) (shift k (cons 2 (k #f))) '()) ;; 評価 (reset _(shift k (cons 1 (k #f)))_ (shift k (cons 2 (k #f))) '()) ;; 継続 #0# (lambda (x) ((lambda (v) ;; shift は reset を付ける #0# (reset v)) ((lambda (v) v (shift k (cons 2 (k #f))) '()) x))) ;; 評価 shift の継続 ((lambda (v) (reset v)) _(cons 1 (#0# #f))_) ;; 評価 ((lambda (v) (reset v)) ((lambda (v) (cons 1 v)) _(#0# #f)_)) ;; 評価 #0# 展開 ((lambda (v) (reset v)) ((lambda (v) (cons 1 v)) _((lambda (x) ((lambda (v) ;; shift は reset を付ける #0# (reset v)) ((lambda (v) v (shift k (cons 2 (k #f))) '()) x))) #f)_)) ;; 評価 ((lambda (v) (reset v)) ((lambda (v) (cons 1 v)) ((lambda (v) ;; shift は reset を付ける #0# (reset v)) ((lambda (v) v _(shift k (cons 2 (k #f)))_ '()) #f)))) ;; 継続 #1# (lambda (x) ((lambda (v) ;; shift は reset を付ける #1# (reset v)) ((lambda (v) v '()) x))) ;; 評価 shift の継続 ((lambda (v) (reset v)) ((lambda (v) (cons 1 v)) ((lambda (v) ;; shift は reset を付ける #0# (reset v)) _(cons 2 (#1# #f))_))) ;; 評価 ((lambda (v) (reset v)) ((lambda (v) (cons 1 v)) ((lambda (v) ;; shift は reset を付ける #0# (reset v)) ((lambda (v) (cons 2 v)) _(#1# #f)_)))) ;; 評価 #1# 展開 ((lambda (v) (reset v)) ((lambda (v) (cons 1 v)) ((lambda (v) ;; shift は reset を付ける #0# (reset v)) ((lambda (v) (cons 2 v)) _((lambda (x) ((lambda (v) ;; shift は reset を付ける #1# (reset v)) ((lambda (v) v '()) x))) #f)_)))) ;; 評価 ((lambda (v) (reset v)) ((lambda (v) (cons 1 v)) ((lambda (v) ;; shift は reset を付ける #0# (reset v)) ((lambda (v) (cons 2 v)) ((lambda (v) ;; shift は reset を付ける #1# (reset v)) ((lambda (v) v '()) #f)))))) ;;=> '(1 2)
次に、 prompt/control について。
(prompt (control k (cons 1 (k #f))) (control k (cons 2 (k #f))) '()) ;; 評価 (prompt _(control k (cons 1 (k #f))_) (control k (cons 2 (k #f))) '()) ;; 継続 #0# (lambda (x) ((lambda (v) ;; control は prompt を付けない #0# v (control k (cons 2 (k #f))) '()) x)) ;; 評価 control の継続 ((lambda (v) (prompt v)) _(cons 1 (#0# #f))_) ;; 評価 ((lambda (v) (prompt v)) ((lambda (v) (cons 1 v)) _(#0# #f)_)) ;; 評価 #0# 展開 ((lambda (v) (prompt v)) ((lambda (v) (cons 1 v)) _((lambda (x) ((lambda (v) ;; control は prompt を付けない #0# v (control k (cons 2 (k #f))) '()) x)) #f)_)) ;; 評価 ((lambda (v) (prompt v)) ((lambda (v) (cons 1 v)) ((lambda (v) ;; control は prompt を付けない #0# v _(control k (cons 2 (k #f)))_ '()) #f))) ;; 継続 #1# (lambda (x) ;; control は prompt を付けない #1# ((lambda (v) (cons 1 v)) ((lambda (v) v '()) x))) ;; 評価 control の継続 ((lambda (v) (prompt v)) _(cons 2 (#1# #f))_) ;; 評価 ((lambda (v) (prompt v)) ((lambda (v) (cons 2 v)) _(#1# #f)_)) ;; 継続 #1# 展開 ((lambda (v) (prompt v)) ((lambda (v) (cons 2 v)) _((lambda (x) ;; control は prompt を付けない #1# ((lambda (v) (cons 1 v)) ((lambda (v) v '()) x))) #f)_)) ;; 評価 ((lambda (v) (prompt v)) ((lambda (v) (cons 2 v)) ((lambda (v) (cons 1 v)) ((lambda (v) v '()) #f)))) ;;=> '(2 1)
このように、 shift では reset を付けるので、この調子で継続を表現しようとしていくと、関数がどんどん深くなっていきます。これに対して control では prompt を付けないので、継続を表す関数はその都度再計算されます（いや、継続は、その都度計算される、というのは共通しているので、表現が何かおかしいのだけれども（ prompt までの継続が毎度 k に束縛されるので当然なのだけれども））。
字面が継続渡し形式に似ているのに気付いた。ので、まとめてみます。(継続渡し形式についてのメモはこちら 直観に反する？ — https://t.laafc.net/2018/04/19/counterintuitivep.html)
(require racket/control srfi/1) (let () (define (dup xs) (fold-right cons '() xs)) (define (rev xs) (fold cons '() xs)) (define (dup-k xs) (define (recur xs k) (if (null? xs) (k '()) (recur (cdr xs) (lambda (r) (k (cons (car xs) r)))))) (recur xs values)) (define (rev-k xs) (define (recur xs k) (if (null? xs) (k '()) (recur (cdr xs) (lambda (r) (cons (car xs) (k r)))))) (recur xs values)) (define (dup-c xs) (define (visit xs) (if (null? xs) '() (visit (shift k (cons (car xs) (k (cdr xs))))))) (reset (visit xs))) (define (rev-c xs) (define (visit xs) (if (null? xs) '() (visit (control k (cons (car xs) (k (cdr xs))))))) (prompt (visit xs))) (let* ((xs '(a b c)) (ys (reverse xs))) (values (list= equal? xs (dup xs) (dup-k xs) (dup-c xs)) (list= equal? ys (rev xs) (rev-k xs) (rev-c xs))))) ;;=> #t, #t
“LETREC + CALL/CC = SET! even in a limited setting” とは？
“L.i.S.P”より (C. Queinnec’s L.i.S.P book and code — https://pages.lip6.fr/Christian.Queinnec/WWW/LiSP.html) 第３章の問題、の元ネタ。
LETREC + CALL/CC = SET! even in a limited setting — https://groups.google.com/d/msg/comp.lang.scheme/cxbti-YRs7U/gDGTpkpROgYJ を読み解いてみたいと思います。
シンプルな一番下から。
(define (test) (letrec ((x (call-with-current-continuation (lambda (c) (list #T c))))) (if (car x) ((cadr x) (list #F (lambda () x))) (eq? x ((cadr x))))))
letrec で評価される c には letrec を待ち構えている継続が束縛されています。さてこれを呼び出した時に、 x の束縛はどうなっているのか？特に、 (lambda () x) で捕捉したものは？というのがポイントだと考えられます。 letrec の場合、結果 #t になります。
まず、 letrec の所がもし let だったら何が起こるかを確認します。
(let ((x (call/cc (lambda (c) (list #T c))))) (if (car x) ((cadr x) (list #F (lambda () x))) (eq? x ((cadr x))))) ;; 継続 #0# ;; PRINT-THEN-REPL は省略します (lambda (a) (let ((x a)) (if (car x) ((cadr x) (list #F (lambda () x))) (eq? x ((cadr x)))))) ;; 評価 (let ((x '(#T #0#))) (if (car x) _((cadr x) (list #F (lambda () x)))_ (eq? x (cadr x)))) ;; 評価 継続 #0# 呼び出し _(#0# (list #F (lambda () x)))_ ;; 評価 継続 (#0# (list ...)) ((lambda (a) (let ((x a)) (if (car x) ((cadr x) (list #F (lambda () x))) (eq? x ((cadr x)))))) (list #F (lambda () x))) ;; ここで、 x は #0# で見えていた束縛
継続 #0# へ渡されるリストの無名関数内の x は、継続 #0# で見えていた束縛です。一方、 (#0# ...) の評価の最初で、 (let ((x a)) ...) で新たな束縛が導入されるので、この二つを eq? すると、 #f となります。これはわかります。
では本題、 letrec の場合。 letrec が let と set! で実現されているとしたらば、と考えてみます。
(letrec ((x (call/cc (lambda (c) (list #T c))))) (if (car x) ((cadr x) (list #F (lambda () x))) (eq? x ((cadr x))))) ;; letrec を set! で表現しようとしてみます。 (let ((x #f)) (let ((xtmp (call/cc (lambda (c) (list #T c))))) (set! x xtmp) (if (car x) ((cadr x) (list #F (lambda () x))) (eq? x ((cadr x)))))) ;; 継続 #0# (let ((x #f)) ;; こんな具合に let ((x #f)) は終わっていると考えられます、 ;; 言い替えると、継続に含まれていない、と。 (lambda (a) (let ((xtmp a)) (set! x xtmp) (if (car x) ((cadr x) (list #F (lambda () x))) (eq? x ((cadr x))))))) ;; (let ((x #f)) (let ((xtmp '(#T #0#))) (set! x xtmp) (if (car x) _((cadr x) (list #F (lambda () x))_) (eq? x ((cadr x)))))) ;; 評価 継続 #0# 呼び出し _(#0# (list #F (lambda () x)))_ ;; 評価 継続 ;; x の束縛は eq? => #t なものを見ている。 ((lambda (a) (let ((xtmp a)) (set! x xtmp) (if (car x) ((cadr x) (list #F (lambda () x))) (eq? x ((cadr x)))))) (list (#F (lambda () x))))
継続 #0# 評価中でも x の束縛は eq? ⇒ #t となります。言い替えると x の束縛は継続の評価中に作られるわけではなく、というのが透けて見えます。
次はメールの二番目の例の make-cell 。 'set で呼ぶと、一旦無名関数を返す、というのが興味深いです。無名関数の呼び出しを待ち構えている継続が、最後に呼び出される、と。
(let () (define (make-cell initial-value) (letrec ((state (call-with-current-continuation (lambda (return-new-state) (list initial-value return-new-state #F))))) (if (caddr state) ((caddr state) 'done) (lambda (op) (case op ((get) (car state)) ((set) (lambda (new-value) (call-with-current-continuation (lambda (return-from-set) ((cadr state) (list new-value (cadr state) return-from-set))))))))))) (let ((cell (make-cell 44)) (set #f)) (values cell (cell 'get) (begin (set! set (cell 'set)) set) (set 33) (cell 'get)))) ;;=>#<closure (make-cell op)>, 44, #<closure ((make-cell make-cell) new-value)>, done, 33
練習として、無名関数を返さないバージョンを考えてみます。
(let () (define (make-cell value) (letrec ((state (call/cc (lambda (store) (list value store #f))))) (if (caddr state) ((caddr state) 'done) (lambda (op . args) (case op ((get) (car state)) ((set) (call/cc (lambda (caller) (let1 store (cadr state) (store (list (car args) store caller))))))))))) (let1 cell (make-cell 44) (values cell (cell 'get) (cell 'set 33) (cell 'get)))) ;;=> #<closure (make-cell op . args)>, 44, done, 33
store を呼んで、そのまま caller を呼んでもらう形です。
最後、“L.i.S.P”の問題に出てくるものの写経。
(let () (define (make-box value) (let ((box (call/cc (lambda (exit) (letrec ((behavior (call/cc (lambda (store) (exit (lambda (msg . new) (call/cc (lambda (caller) (case msg ((get) (store (cons (car behavior) caller))) ((set) (store (cons (car new) caller)))))))))))) ((cdr behavior) (car behavior))))))) (box 'set value) box)) (let1 box1 (make-box 33) (values box1 (box1 'get) (box1 'set 44) (box1 'get)))) ;;=> #<closure ((#f #f #f) msg . new)>, 33, 44, 44
あらためて、こうやって比較して眺めてみると、 letrec の EXPR 部分に VAR が出て来ないもの（上の方の例）は、確かに不自然です。動かすにはそうする必要があるのだけれども。
直観に反する？
継続渡し形式が腑に落ちたので復習。
まず、直観的なのが、下の例のように k に渡される場合。“The Little Schemer”や“The Seasoned Schemer”ではコレクターとか 〜&co とかで憶えています。
(define (dup-k xs) (define (recur xs k) (if (null? xs) (k '()) (recur (cdr xs) (lambda (r) (k (cons (car xs) r)))))) (recur xs values)) (dup-k '(a b c)) ;;=> (a b c)
一方、 k に渡さない…というか、 k が末尾呼び出しではない場合、途端になんだこれ？となる。コレクター、 〜&co にはあんまり無かったパターンです。(もしかしたらあったのかも。ローカルに写経したコードからは見つからなかったという)
(define (rev-k xs) (define (recur xs k) (if (null? xs) (k '()) (recur (cdr xs) (lambda (r) (cons (car xs) (k r)))))) (recur xs values)) (rev-k '(a b c)) ;;=> (c b a)
上の方はさんざん動きを一歩ずつトレースしたから見慣れただけのかもしれない。というわけで、下の方を一歩一歩トレースします。
;; (rev-k '()) (rev-k '()) (recur '() values) (recur '() (lambda (r) ;; そろえるために (values r))) ((lambda (r) (values r)) '()) ;;=> () ;; (rev-k '(a)) (rev-k '(a)) (recur '(a) values) (recur '(a) (lambda (r) (values r))) (recur '() (lambda (r) (cons 'a ((lambda (r) (values r)) r)))) ((lambda (r) (cons 'a ((lambda (r) (values r)) r))) '()) ;;=> (a) ;; (rev-k '(a b)) (rev-k '(a b)) (recur '(a b) values) (recur '(a b) (lambda (r) (values r))) (recur '(b) (lambda (r) (cons 'a ((lambda (r) (values r)) r)))) (recur '() (lambda (r) (cons 'b ((lambda (r) (cons 'a ((lambda (r) (values r)) r))) r)))) ((lambda (r) (cons 'b ((lambda (r) (cons 'a ((lambda (r) (values r)) r))) r))) '()) ;;=> (b a) ;; (rev-k '(a b c)) (rev-k '(a b c)) (recur '(a b c) values) (recur '(a b c) (lambda (r) (values r))) (recur '(b c) (lambda (r) (cons 'a ((lambda (r) (values r)) r)))) (recur '(c) (lambda (r) (cons 'b ((lambda (r) (cons 'a ((lambda (r) (values r)) r))) r)))) (recur '() (lambda (r) (cons 'c ((lambda (r) (cons 'b ((lambda (r) (cons 'a ((lambda (r) (values r)) r))) r))) r)))) ((lambda (r) (cons 'c ((lambda (r) (cons 'b ((lambda (r) (cons 'a ((lambda (r) (values r)) r))) r))) r))) '()) ;;=> (c b a)
このパターン、というか形状というかは、よくよく観察すると見覚えがある、 fold-right/fold-left です。
(use srfi-1 :only (xcons)) ;; xcons (define dup (pa$ fold-right cons '())) ;; fold-right$ あるけれどそろえる (define rev (pa$ fold-left xcons '())) (let1 xs '(a b c) (values #0=(dup xs) (equal? (dup-k xs) #0#) #1=(rev xs) (equal? (rev-k xs) #1#))) ;;=> (a b c), #t, (c b a), #t
- foldr
- foldl
http://foldl.com/ は見られなくなっちゃっているようなので、とりあえずどちらも書いておきます。
どちらも直観的で納得できるようになったと思いたい。
\((call/cc call/cc) (call/cc call/cc)) とは？
“L.i.S.P”より (C. Queinnec’s L.i.S.P book and code — https://pages.lip6.fr/Christian.Queinnec/WWW/LiSP.html) 第３章の問題。後続の文 Does 〜 は直前の問題からこちらに移動して足しました。
Exercise 3.2: What’s the value of ((call/cc call/cc) (call/cc call/cc))? Does the evaluation order influence your answer?
単に ((call/cc call/cc) (call/cc call/cc)) だけだとよくわからないので、出力を挟むようにします。
参考にさせて頂くのは、
こちらのデバッグ手法を利用させて頂きます。というわけで以下のようにして考えます。
(((lambda (k) (newline) k) (call/cc call/cc)) ((lambda (k) (write-char #\*) k) (call/cc call/cc)))
call/ccパズルというものがある。 以前comp.lang.schemeというニュースグループで話題になったプログラムだ。
ところで、この元ネタってどこなのかしらん、と思ったのだけれども:
さて、ほとんどこのパズルと同じですけれども、違いはあります。手続き呼び出しの評価順序によっては出力が異なりそうだな、ということ。(Scheme言語の手続き呼び出し、評価順序 — https://t.laafc.net/2018/04/14/rnrs-procedure-calls.html)
というわけで、まず、オペレータが先に評価される場合を考えます。 racket(v6.12) や csi(chicken Version 4.12.0 (rev 6ea24b6)) で確認しました。
_ で狭まれた式の評価をしようとして、 (call/cc <arg>) だったら、式の評価を待ち構えている継続がどんなものかを考えて書き落ろしてゆきます。
;; 評価 (((lambda (k) (newline) k) _(call/cc call/cc)_) ((lambda (k) (write-char #\*) k) (call/cc call/cc))) ;; 継続 #0# (lambda (x) ((lambda (v) (PRINT-THEN-REPL v)) ((lambda (v) (((lambda (k) (newline) k) v) ((lambda (k) (write-char #\*) k) (call/cc call/cc)))) x))) ;; 評価 (((lambda (k) (newline) k) _(call/cc #0#)_) ((lambda (k) (write-char #\*) k) (call/cc call/cc))) ;; 継続 これは #0# と同じ。次からは省略します。 (lambda (x) ((lambda (v) (PRINT-THEN-REPL v)) ((lambda (v) (((lambda (k) (newline) k) v) ((lambda (k) (write-char #\*) k) (call/cc call/cc)))) x))) ;; 評価 続継 #0# 呼び出し (((lambda (k) (newline) k) _(#0# #0#)_) ((lambda (k) (write-char #\*) k) (call/cc call/cc))) ;; 評価 継続 (#0# #0#) (lambda (x) ((lambda (v) (PRINT-THEN-REPL v)) ((lambda (v) (((lambda (k) (newline) k) v) ((lambda (k) (write-char #\*) k) (call/cc call/cc)))) _ #0#_))) ;; 出力 改行 ;; 評価 (継続 #0# 内の評価が続くわけだけれども必要な所だけ) (#0# ((lambda (k) (write-char #\*) k) _(call/cc call/cc)_)) ;; 継続 #1# (lambda (x) ((lambda (v) (PRINT-THEN-REPL v)) ((lambda (v) (#0# ((lambda (k) (write-char #\*) k) v))) x))) ;; 評価 (#0# ((lambda (k) (write-char #\*) k) _(call/cc #1#)_)) ;; 継続は #1# と同じ ;; 評価 継続 #1# 呼び出し (#0# ((lambda (k) (write-char #\*) k) _(#1# #1#)_)) ;; 評価 継続 (#1# #1#) (lambda (x) ((lambda (v) (PRINT-THEN-REPL v)) ((lambda (v) (#0# ((lambda (k) (write-char #\*) k) v))) _ #1#_))) ;; 出力 * ;; 評価 (続継 #1# 内の評価が続くわけだけれども必要な所だけ) (#0# #1#) ;; 評価 継続 (#0# #1#) (lambda (x) ((lambda (v) (PRINT-THEN-REPL v)) ((lambda (v) (((lambda (k) (newline) k) v) ((lambda (k) (write-char #\*) k) (call/cc call/cc)))) _ #1#_))) ;; 出力 改行 ;; 評価 (継続 #0# 内の評価が続くわけだけれども必要な所だけ) (#1# ((lambda (k) (write-char #\*) k) _(call/cc call/cc)_)) ;; 継続 #2# (lambda (x) ((lambda (v) (PRINT-THEN-REPL v)) ((lambda (v) (#1# ((lambda (k) (write-char #\*) k) v))) x))) ;; 評価 (#1# ((lambda (k) (write-char #\*) k) _(call/cc #2#)_)) ;; 継続は #2# と同じ ;; 評価 継続 #2# 呼び出し (#1# ((lambda (k) (write-char #\*) k) _(#2# #2#)_)) ;; 評価 継続 (#2# #2#) (lambda (x) ((lambda (v) (PRINT-THEN-REPL v)) ((lambda (v) (#1# ((lambda (k) (write-char #\*) k) v))) _ #2#_))) ;; 出力 * ;; 評価 (継続 #2# 内の評価が続くわけだけれども必要な所だけ) (#1# #2#) ;; 評価 継続 (#1# #2#) (lambda (x) ((lambda (v) (PRINT-THEN-REPL v)) ((lambda (v) (#0# ((lambda (k) (write-char #\*) k) v))) _ #2#_))) ;; 出力 * (#0# #2#) ;; 評価 継続 (#0# #2#) (lambda (x) ((lambda (v) (PRINT-THEN-REPL v)) ((lambda (v) (((lambda (k) (newline) k) v) ((lambda (k) (write-char #\*) k) (call/cc call/cc)))) _ #2#_))) ;; 出力 改行 ;; 評価 (継続 #0# 内の評価が続くわけだけれども必要な所だけ) (#2# ((lambda (k) (write-char #\*) k) _(call/cc call/cc)_)) ;; 継続 #3# (lambda (x) ((lambda (v) (PRINT-THEN-REPL v)) ((lambda (v) (#2# ((lambda (k) (write-char #\*) k) v))) x))) ;; 評価 (#2# ((lambda (k) (write-char #\*) k) _(call/cc #3#)_)) ;; 継続は #3# と同じ ;; 評価 継続 #3# 呼び出し (#2# ((lambda (k) (write-char #\*) k) _(#3# #3#)_)) ;; :'m,.g/出力/p ;; 出力 改行 ;; 出力 * ;; 出力 改行 ;; 出力 * ;; 出力 * ;; 出力 改行
call/ccパズルと同じ出力です。違いは let* で継続を束縛しない替わりに (call/cc call/cc) で呼び出す継続を作って、手前の継続の呼び出しを数珠つなぎに、今作った呼び出す継続が渡されていく、という巧妙な構造になっています。すごいなこれ。
さて。今度はオペランドが先に評価される場合を考えます。chibi-scheme(0.7.3-566-g10759e8b), mit-scheme(Release 9.1.1 || Microcode 15.3 || Runtime 15.7 || SF 4.41 LIAR/x86-64 4.118 || Edwin 3.116) で確認しました。
Gauche(version 0.9.5) の場合 -fno-post-inline-pss を付けると確認できました。(付ける/付けないでどうして変わるのかはわかりません！)
;; 評価 (((lambda (k) (newline) k) (call/cc call/cc)) ((lambda (k) (write-char #\*) k) _(call/cc call/cc)_)) ;; 継続 #0# (lambda (x) ((lambda (v) (PRINT-THEN-REPL v)) ((lambda (v) (((lambda (k) (newline) k) (call/cc call/cc)) ((lambda (k) (write-char #\*) k) v))) x))) ;; 評価 (((lambda (k) (newline) k) (call/cc call/cc)) ((lambda (k) (write-char #\*) k) _(call/cc #0#)_)) ;; 継続は #0# と同じ ;; 評価 継続 #0# 呼び出し (((lambda (k) (newline) k) (call/cc call/cc)) ((lambda (k) (write-char #\*) k) _(#0# #0#)_)) ;; 評価 継続 (#0# #0#) (lambda (x) ((lambda (v) (PRINT-THEN-REPL v)) ((lambda (v) (((lambda (k) (newline) k) (call/cc call/cc)) ((lambda (k) (write-char #\*) k) v))) _ #0#_))) ;; 出力 * ;; 評価 (継続 #0# 内の評価が続くわけだけれども必要な所だけ) (((lambda (k) (newline) k) _(call/cc call/cc)_) #0#) ;; 継続 #1# (lambda (x) ((lambda (v) (PRINT-THEN-REPL v)) ((lambda (v) (((lambda (k) (newline) k) v) #0#)) x))) ;; 評価 (((lambda (k) (newline) k) _(call/cc #1#)_) #0#) ;; 継続は #1# と同じ ;; 評価 継続 #1# 呼び出し (((lambda (k) (newline) k) _(#1# #1#)_) #0#) ;; 評価 継続 (#1# #1#) (lambda (x) ((lambda (v) (PRINT-THEN-REPL v)) ((lambda (v) (((lambda (k) (newline) k) v) #0#)) _ #1#_))) ;; 出力 改行 ;; 評価 (続継 #1# 内の評価が続くわけだけれども必要な所だけ) (#1# #0#) ;; 評価 継続 (#1# #0#) (lambda (x) ((lambda (v) (PRINT-THEN-REPL v)) ((lambda (v) (((lambda (k) (newline) k) v) #0#)) _ #0#_))) ;; 出力 改行 ;; 評価 (続継 #1# 内の評価が続くわけだけれども必要な所だけ) (#0# #0#) ;; :'m,.g/出力/p ;; 出力 * ;; 出力 改行 ;; 出力 改行
このように、がむしゃらに継続を関数で表現しようとすることを繰り返すことで、動作をトレースすることはできます。
継続が以前よりも恐くなくなった気がしますけれども、使いこなすことができるかと問われると…
Scheme言語の手続き呼び出し、評価順序
Scheme言語では手続き呼び出しの評価順序は決まっていません。それがどのように仕様に表現されているのかを確認してみます。
正直右からでも左からでもどちらからでも評価して構わない、というようなフワっとしたことが記述されているのかな、と想像していたのだけれども、それでは仕様として役に立ちませんね。
ただ実際読んだ時、その意味するところがよくわかりませんでした。自分の思考を整理するために、何がわからなかったかというのをよくよく考えてみると、なぜ仕様で順序が不定であるとするのか？がわからない、ということだったのだと思います。
以下に引用します。
4.1.3. Procedure calls
...
The operator and operand expressions are evaluated (in an unspecified order) and the resulting procedure is passed the resulting arguments.
...
Note: In contrast to other dialects of Lisp, the order of evaluation is unspecified, and the operator expression and the operand expressions are always evaluated with the same evaluation rules.
Note: Although the order of evaluation is otherwise unspecified, the effect of any concurrent evaluation of the operator and operand expressions is constrained to be consistent with some sequential order of evaluation. The order of evaluation may be chosen differently for each procedure call.
— Richard Kelsey, William Clinger, And Jonathan Rees (Editors)
日本語訳、助かります！
手続き呼び出し
...
オペレータの式とオペランドの式は(不定の順序で)評価され、評価結果の手続きに評価結果の引数が渡される。
...
注: その他のLisp方言とは対照的に評価の順序は不定であり、オペレータ式とオペランド式は、必ず同一評価規則で評価される。
注: 一般には評価の順序は不定であるが、オペレータ式とオペランド式のいかなる同時並行的評価の結果も、一定の順次的評価と一致しなければならない。評価の順序は手続きの呼び出しごとに選択できる。
— RICHARD KELSEY、WILLIAM CLINGER、JONATHAN REES (編集)…20 february 1998 (犬飼 大訳: 7 May 1999)
このように、不定である、ということしか書いてありません。順序くらい書いておいてくれても、とか、右からでも左かもでも良い、くらいは具体的に記述があるかしらん、と思っていた向きには、びっくりして立ち往生してしまいます。
で、このメールを見て、納得しました。つまり、例えばテスト中にヒューリスティックに評価順序を探るってことすらオッケー、それくらい手続き呼び出しのオペレータ、オペランドの評価順序は不定であって、最適化を妨げるものではない、ということなのだろう、と。
Way back when there was a test system that I used that used a random number generator to choose execution order at every call. The idea was to help one heuristically find unintended order of execution dependences during testing.
納得した上で立ち返ってみると、そもそも評価の順序に関しての注記に書いてあります。
同時並列に評価しても良いし、はたまた、呼び出し毎に評価の順序を変えても良い、それくらいに順序は不定です、ただし。順序付けて評価した結果と一致しなければならない。
あらためて読み返してみると、Scheme言語処理系を実装する向きには挑戦的な記述ですらあるのではないのかな、というのが感想。
Re: two-in-a-row*? 写経、つれづれ
Updated 2018-04-16T12:52:26+09:00まずは、再掲します。
(define (atom? x) (and (not (pair? x)) (not (null? x)))) (define two-in-a-row*? (letrec ((T? (lambda (a) (let ((n (get-next 'go))) (and (atom? n) (or (eq? n a) (T? n)))))) (get-next (lambda (x) (let/cc here-again (set! leave here-again) (fill 'go)))) (fill values) (waddle (lambda (l) (cond ((null? l) '()) ((atom? (car l)) (let () (let/cc rest (set! fill rest) (leave (car l))) (waddle (cdr l)))) (else (let () (waddle (car l)) (waddle (cdr l))))))) (leave values)) (lambda (l) (let ((fst (let/cc here (set! leave here) (waddle l) (leave '())))) (and (atom? fst) (T? fst)))))) (values (two-in-a-row*? '(((food) ()) (((food))))) (two-in-a-row*? '(((food) (a)) (((food))))) (two-in-a-row*? '(((food) (a b (c) c)) (((food)))))) ;=> #t, #f, #t
呼ぶ毎に次の要素が取って来られればよい、ということは、あらかじめ木からリストに変換してしまい、そのリストを辿ることにすればよい気もします。というわけで以下。
あらかじめリストにするというのは気が引けますが…
(define (my-two-in-a-row*? tree) (define (flatten tree acc) (cond ((null? tree) acc) ((atom? tree) (cons tree acc)) (else (flatten (car tree) (flatten (cdr tree) acc))))) (let ((xs (flatten tree '()))) (and (not (null? xs)) (let T? ((a (car xs)) (xs (cdr xs))) (and (not (null? xs)) (or (eq? (car xs) a) (T? (car xs) (cdr xs))))))))
リストではなくてストリームへの変換にするとすると。
(define (my-two-in-a-row*? tree) (define (streamify tree) (stream-delay (cond ((null? tree) stream-null) ((atom? (car tree)) (stream-cons (car tree) (streamify (cdr tree)))) (else (stream-append (streamify (car tree)) (streamify (cdr tree))))))) (let ((s (streamify tree))) (and (not (stream-null? s)) (let T? ((a (stream-car s)) (s (stream-cdr s))) (and (not (stream-null? s)) (or (eq? (stream-car s) a) (T? (stream-car s) (stream-cdr s))))))))
最初に立ち返って、ジェネレータで。Scheme では SRFI にあり、すぐに利用することができる場合があるので、助かります。
(define (my-two-in-a-row*? tree) (define gen (make-coroutine-generator (lambda (yield) (let recur ((tree tree)) (cond ((null? tree) (eof-object)) ((atom? (car tree)) (yield (car tree)) (recur (cdr tree))) (else (recur (car tree)) (recur (cdr tree)))))))) (let1 fst (gen) (and (not (eof-object? fst)) (let T? ((a fst) (n (gen))) (and (not (eof-object? n)) (or (eq? n a) (T? n (gen))))))))
これは冒頭の写経したコードから、継続のやり取りの部分が抽象化されたもの、と考えることができます。
;; generate :: ((a -> ()) -> ()) -> Generator a (define (generate proc) (define (cont) (reset (proc (^[value] (shift k (set! cont k) value))) (set! cont null-generator) (eof-object))) (^[] (cont))) ... (define (make-coroutine-generator proc) (generate proc))
たったこれだけで冒頭の写経したコードから継続のやり取りの部分がうまいこと抽象化されています、すごいなこれ。
何が起きているのか単純な例をもって自分の言葉で反芻します。
(let () (define gen (generate (lambda (yield) (yield 1) (yield 2)))) (values (gen) (gen) (gen) (gen)))
一回目の (gen) の評価は、 generate 内の cont を通して、 yield が呼び出されます(簡便のために、 cont 内で proc に渡される無名関数を yield と呼びます)。 (yield 1) で、 (shift k ...) が評価されるので、 k に束縛される継続を関数で表現してみます。
ここで shift により k に束縛されるのは reset までの部分継続なのでこんな具合だろうと考えられます。
(lambda (x) ((lambda (v) (reset v)) ((lambda (_v) (set! cont null-generator) ;; cont は generate 内の束縛 (eof-object)) ((lambda (_v) (yield 2)) x))))
ここで、 shift と control の対比で、 control の場合は reset までなのですが、 reset 自体は含まれません。
最初、後で出てくるように、文字通り reset が無いとどこが reset なのかわからなくなるはず、と考えていたので入れていました。 control と shift を対比すると、 reset が入ることが確認できると思います。
で、これが (set! cont k) として cont に束縛されます。 (yield 1) での (shift k ...) 評価に話を進めます。
(shift k ...) の評価では、この (shift k ...) を待ち構えている継続も特別で、 reset を待っている継続を伴って ... を評価する、ということなので、結果は、 reset を待っている継続を通して渡される、文字通り、 reset までの分がごっそり削られて以下のような様子だと考えられます。
;; (yield 1) の評価を考えます ((lambda (x) ((lambda (v) (PRINT-THEN-REPL v)) ((lambda (v) (values v (gen) (gen) (gen))) x))) ((lambda (v) (reset v)) ((lambda (_v) (set! cont null-generator) ;; cont は generate 内の束縛 (eof-object)) ((lambda (yield) _(yield 1)_ (yield 2))))) ) ;; 結局 (yield 1) は (shift k ... 1) なので reset までの分はごっそり削られる ;; つまり、 reset を待ち構えている継続を通して渡される ((lambda (x) ((lambda (v) (PRINT-THEN-REPL v)) ((lambda (v) (values v (gen) (gen) (gen))) x))) 1)
次に、二回目の (gen) の評価です。パラメータはここでは置いておくとします。固定で、 #f を渡すこととします。(引数が苦しいなあ…後々よく考えます！)
((lambda (x) ((lambda (v) (PRINT-THEN-REPL v)) ((lambda (v) (values 1 v (gen) (gen))) x))) ((lambda (x) ((lambda (v) (reset v)) ((lambda (_v) (set! cont null-generator) ;; cont は generate 内の束縛 (eof-object)) ((lambda (_v) (yield 2)) x)))) #f))
(yield 2) で (shift k ...) が評価されるので、先程と同様に、 k に束縛される部分継続を関数で表現することを考えます。先程と同様 shift が k に束縛するのは、 reset までの部分継続なので、文字通り reset のところまで、ということになります。
(lambda (x) ((lambda (v) (reset v)) ((lambda (_v) (set! cont null-generator) ;; cont は generate 内の束縛 (eof-object)) ((lambda (v) v) x))))
(shift k ...) の評価では、結果は、 reset を待っている継続を通して渡される。
((lambda (x) ((lambda (v) (PRINT-THEN-REPL v)) ((lambda (v) (values 1 v (gen) (gen))) x))) 2)
(gen) 三回目。
((lambda (x) ((lambda (v) (PRINT-THEN-REPL v)) ((lambda (v) (values 1 2 v (gen))) x))) ((lambda (x) ((lambda (v) (reset v)) ((lambda (_v) (set! cont null-generator) ;; cont は generate 内の束縛 (eof-object)) x))) #f))
(yield 2) の呼び出しの後なので、ここでは yield は呼ばれません。
ここで、“The Seasoned Schemer”でのことを思い出すと、継続の呼び出しで、 waddle から返ってしまったとしたら、"Wow" と言ってしまうような、神のみぞ知る状態になってしまう、ということがありました。そこで、意図した継続へ処理を移していくように、言い替えると、 get-next から"返る"ようにするために、 (leave '()) が必要になるわけでした。
それに対してここでは、そもそも、呼び出しているのは部分継続なので、処理を移す先は reset を待っている継続、ということになるのが大きな違いです。
今回、継続がどんな様子になるのかを関数で表現しようとして確認してみると、この違いが把握できました。
話を戻して。 cont には null-generator が束縛されて、 (eof-object) の結果が評価されます。
最後、 (gen) 四回目。
((lambda (x) ((lambda (v) (PRINT-THEN-REPL v)) ((lambda (v) (values 1 2 #<eof> (gen))) x))) ((lambda (_v) (cont)) #f)) ;;=> 1, 2, #<eof>, #<eof>;
ここで、 cont は null-generator なので、 #<eof> が返されています。
two-in-a-row*? 写経、つれづれ
two-in-a-row*? 関数を写経したり他の実装を考えたりしてみたいと思います。
(define (atom? x) (and (not (pair? x)) (not (null? x))))
準備で、 “The Little Schemer” でも使う atom? 関数です。
まずは写経から。最終的な実装は以下のもの。木を辿って隣り合っている要素があるかどうかをテストする関数です。
(define two-in-a-row*? (letrec ((T? (lambda (a) (let ((n (get-next 'go))) (and (atom? n) (or (eq? n a) (T? n)))))) (get-next (lambda (x) (let/cc here-again (set! leave here-again) (fill 'go)))) (fill values) (waddle (lambda (l) (cond ((null? l) '()) ((atom? (car l)) (let () (let/cc rest (set! fill rest) (leave (car l))) (waddle (cdr l)))) (else (let () (waddle (car l)) (waddle (cdr l))))))) (leave values)) (lambda (l) (let ((fst (let/cc here (set! leave here) (waddle l) (leave '())))) (and (atom? fst) (T? fst)))))) (values (two-in-a-row*? '(((food) ()) (((food))))) (two-in-a-row*? '(((food) (a)) (((food))))) (two-in-a-row*? '(((food) (a b (c) c)) (((food)))))) ;=> #t, #f, #t
木を car から辿り続けて、今注目している要素の値を渡して行く、末尾再帰で書きたくなります。
(define (my-two-in-a-row*? tree) (define (loop v tree k) (cond ((null? tree) (k v)) ((atom? (car tree)) (or (eq? (car tree) v) (loop (car tree) (cdr tree) k))) (else (loop v (car tree) (lambda (v) (loop v (cdr tree) k)))))) (loop '() tree (lambda _ #f)))
隣り合っていた要素があった場合に or でショートカットして、今注目している要素の値を木の cdr へ渡して行く所に手続きを使っています。見つかると or で #t が返されるのに対して、見つからなかったら #f を常に返す手続きを最初に渡して、最終的にそれが呼び出されます。
コレクターなのだけれども何も集めていかないもので、また or でショートカットするという所も “The {Little,Seasoned} Schemer”からすると変則的な形になっています。今注目している要素の値を受け取り続ける、というのがコレクターの役割です。
別の実装も考えてみます。
やっていることは今注目している要素の値を保持して、木を辿っていくことなので、破壊的に書くとしたらこんな具合と思って書いてみます。
(define (my-two-in-a-row*? tree) (let1 a '() (let recur ((tree tree)) (cond ((null? tree) #f) ((atom? (car tree)) (or (eq? (car tree) a) (begin (set! a (car tree)) (recur (cdr tree))))) (else (or (recur (car tree)) (recur (cdr tree))))))))
Scheme のリスト操作関数を組み合わせられる気がする、という感触はあります。ただ、思い付かない…
さらに次。
今注目している要素の値に加えて、 car 部と cdr 部も渡してしまえ、というので考えてみたもの。
(define (my-two-in-a-row*? tree) (define (iter v l r) (cond ((and (null? l) (null? r)) #f) ((null? l) (iter v (car r) (cdr r))) ((atom? l) (or (eq? l v) (iter l r '()))) (else (iter v (car l) (cons (cdr l) r))))) (and (not (null? tree)) (iter '() (car tree) (cdr tree))))
さて。
普通に再帰で書こうとすると、どんなものが自然なのだろうか考えてみます。(個人的な感覚として、末尾再帰で書くということがセミ(準)破壊的、みたいなイメージを持ってます)
木を辿るんだけれども、今注目している要素の値を cdr を辿る節に受け渡す良い方法が思い付かない。たいがいこんな風なコードが else 節には来ると思う:
;; v を今注目している要素の値だとして (or (recur v (car tree)) (recur ??? (cdr tree))) ;; 上をちょっと変えて、そして `#t` の時、見つかったということとすれば。 (let1 r (recur v (car tree)) (or (eq? #t r) (recur r (cdr tree))))
このパターンは、まず、見つかったかどうかというのと、今注目している要素の値を一緒くたにしているのはよくないと思います。二つの値が必要だからコレクターを使う？
(define (my-two-in-a-row*? tree) (define (loop v tree k) (cond ((null? tree) (k v #f)) ((atom? (car tree)) (or (eq? (car tree) v) (loop (car tree) (cdr tree) (lambda (v _found?) (k v #f))))) (else (loop v (car tree) (lambda (v _found?) (loop v (cdr tree) (lambda (v _found?) (k v #f)))))))) (loop '() tree (lambda (_v _found?) #f)))
末尾再帰版と同じですね。コレクターは二つの引数を取るのだけれども、 or でショートカットされるので、見つかったかどうかは意味が無くなる、という。これをちょっともじったやつが最初に挙げたやつです。
二つの値の受け渡しに多値を使ったもの。
(define (my-two-in-a-row*? tree) (define (recur v tree) (cond ((null? tree) (values v #f)) ((atom? (car tree)) (if (eq? (car tree) v) (values v #t) (recur (car tree) (cdr tree)))) (else (receive (newv found?) (recur v (car tree)) (if found? (values newv #t) (recur newv (cdr tree))))))) (values-ref (recur '() tree) 1))
ここまで書いてきたものをみていると、後々見返した時にどうなのだろう？という気もしてきます。
比較すると、一番上の、 two-in-a-row*? の T? 関数と、本体とを取り出すと、
...(T?
(lambda (a)
(let ((n (get-next 'go)))
(and (atom? n)
(or (eq? n a)
(T? n))))))
...
(lambda (l)
(let ((fst (let/cc here
(set! leave here)
(waddle l)
(leave '()))))
(and (atom? fst)
(T? fst))))
...「 get-next で次に注目するべき値を取ってきて、それが今注目している要素の値と同じだったら」。言ってみれば、次を取ってくる部分と、本体部分がある、ということが言えるのかなと思います。他は両方が同居している感じがあるような気がして、どちらも一長一短。
次を取ってきて、というのを次に注目するべき値と部分木を返すようにしてみます。
(define (my-two-in-a-row*? tree) (define (next tree) (cond ((null? tree) (values '() '())) ((atom? (car tree)) (values (car tree) (cdr tree))) (else (receive (v r) (next (car tree)) (if (null? v) (next (cdr tree)) (values v (cons r (cdr tree)))))))) (receive (fst newtree) (next tree) (and (atom? fst) (let T? ((a fst) (newtree newtree)) (receive (n r) (next newtree) (and (atom? n) (or (eq? n a) (T? n r))))))))
(call/cc call/cc) とは？
“L.i.S.P”より (C. Queinnec’s L.i.S.P book and code — https://pages.lip6.fr/Christian.Queinnec/WWW/LiSP.html) 第３章の問題。引数の評価順に依存しそうなのは次の問題と思ったのでその部分はカット。
Exercise 3.1: What is the value of (call/cc call/cc)?
単に (call/cc call/cc) だけだとよくわからないので、 (cons 'car (call/cc call/cc)) について考えます。
gosh> (cons 'car (call/cc call/cc)) (car . #<subr "continuation">) gosh>
とりあえず動かしてみると、 REPL の表示から、何かしら継続が返されていそうだ、ということは解ります。
まず、ここで (call/cc call/cc) を待ち構えている継続、これをどうにか関数で表現しようとしてみます:
(lambda (x) ((lambda (v) (PRINT-THEN-REPL v)) ((lambda (v) (cons 'car v)) x)))
REPL の print から次のループへという意味で PRINT-THEN-REPL にしました。
この継続は、 x として値を受け取って、次々と関数へ適用してゆく、 (cons 'car v) → (PRINT-THEN-REPL v) これで表示されてプロンプトが出る、というものです。
次に、 (cons 'car (call/cc call/cc)) の評価を順に追ってみます。まず、この (call/cc call/cc) の評価から。
一般に、 (call/cc proc) の評価は、渡された関数 proc を、 (call/cc proc) 自身を待ち構えている継続を引数にして呼び出すことなので、 (proc 継続) が評価されます。
問題の (cons 'car (call/cc call/cc)) での (call/cc call/cc) の評価は、渡された関数 call/cc を、 (call/cc call/cc) 自身を待ち構えている継続（これを継続その一とおく）を引数にして呼び出すので、 (call/cc 継続その一) が評価されます。
すると次は、渡された関数 継続その一 を、 (call/cc 継続その一) 自身を待ち構えている継続（これを継続その二とおく）を引数にして (継続その一 継続その二) が呼び出されます。
ここで、 継続その一 とは (call/cc cal/cc) を待ち構えている継続で、その継続の呼び出しが起こる。(この 継続その一 とは、最初に関数で疑似的に表現しようとした継続のことです。)すなわち、 継続その一 が呼び出されて cons を経て、 PRINT-THEN-REPL が評価されて入力待ちになります。この REPL に表示されている結果の cdr 部の #<subr "continuation"> は、 継続その一 を呼び出した時の引数なので、 継続その二 のことで、プロンプトに表示されているのは (car . 継続その二) なのだということになります。
では、 継続その二 とは？これは (call/cc 継続その一) を待ち構えている継続のことで、すなわちそれは (call/cc call/cc) を待ち構えている継続と同じということになります。( (call/cc call/cc) → (call/cc 継続その一) は評価した結果、そのまま末尾呼び出しなので)
というわけで、 (call/cc call/cc) の結果は、自身を待ち構えている継続が返される(返されると表現していいのかな…REPL から入力していたら REPL の P に渡される、ということなんだろうと思う)、になります。
この挙動は、結果の継続を呼び出してみると確認できます。
gosh> (cons 'car (call/cc call/cc)) (car . #<subr "continuation">) gosh> ((cdr *1) 'cdr) (car . cdr) gosh>
さて、冒頭に、 (call/cc call/cc) だけだとよくわからない 、と考えたのはなぜなのかを書いてみます。何が よくわからない と考えたのか、自分の思考を整理できるかなと。
トップレベルから (call/cc call/cc) とだけ打ち込んだ時に、返された継続を呼び出しても単に PRINT-THEN-REPL に値が渡されるわけで、どの時点の PRINT-THEN-REPL なのかをはっきり知覚することができない、ということを指して、よくわからない、と表現していたのだと考えています。
gosh> (call/cc call/cc) #<subr "continuation"> gosh> (*1 'call/cc) call/cc gosh>
(*1 'call/cc) から単に返っているようにも見えてしまう(言い替えると、 (*1 'call/cc) を待ち構えている継続が呼び出されているようにも見えてしまう(、とここまで考えると、継続の呼び出しなので 単に返っている と表現するのは適切ではないのかもしれないぞと気付くと考えられますし))、ということ。
pattern match vs subscript マイロクベンチマーク
ある値が ~[ で始まっているかをテストしたい時に、 zsh では、
$string == '~['* vs $string[1,2] == '~[' どっちが速い…もとい、“軽い”のか？
後者の方がコードのテキストの量は多いものの実際にはどうなのか、というところ。パターンマッチと、文字列を array subscript して切り出して比較するのとを比較してみたいです。
以下、ここで試してみたコード。
# > zsh --version # zsh 5.4.2 (x86_64-debian-linux-gnu) string="~[test test]" f () { [[ "$string" = '~['* ]] } g () { [[ "$string" = \~\[* ]] } h () { [[ "$string[1,2]" = '~[' ]] } # okp () { "$1" && echo ok } # okp f # okp g # okp h perf () { repeat 65535 "$1" } #perf "$1" ;# # > valgrind zsh -f perfmatchsubscript.zsh f 2>&1 |grep 'total heap' # ==767== total heap usage: 460,135 allocs, 459,063 frees, 20,618,468 bytes allocated # > valgrind zsh -f perfmatchsubscript.zsh g 2>&1 |grep 'total heap' # ==792== total heap usage: 460,135 allocs, 459,063 frees, 20,618,468 bytes allocated # > valgrind zsh -f perfmatchsubscript.zsh h 2>&1 |grep 'total heap' # ==810== total heap usage: 591,206 allocs, 590,133 frees, 58,366,788 bytes allocated #time (perf "$1") ;# # > repeat 10 zsh -f perfmatchsubscript.zsh f # ( perf "$1"; ) 0.86s user 0.30s system 107% cpu 1.083 total # ( perf "$1"; ) 0.86s user 0.25s system 108% cpu 1.028 total # ( perf "$1"; ) 0.76s user 0.33s system 109% cpu 0.999 total # ( perf "$1"; ) 0.77s user 0.33s system 108% cpu 1.012 total # ( perf "$1"; ) 0.78s user 0.27s system 111% cpu 0.945 total # ( perf "$1"; ) 0.82s user 0.30s system 108% cpu 1.029 total # ( perf "$1"; ) 0.80s user 0.32s system 107% cpu 1.034 total # ( perf "$1"; ) 0.80s user 0.28s system 108% cpu 0.991 total # ( perf "$1"; ) 0.77s user 0.30s system 107% cpu 0.998 total # ( perf "$1"; ) 0.78s user 0.26s system 106% cpu 0.972 total # > repeat 10 zsh -f perfmatchsubscript.zsh g # ( perf "$1"; ) 0.92s user 0.24s system 108% cpu 1.075 total # ( perf "$1"; ) 0.85s user 0.28s system 106% cpu 1.060 total # ( perf "$1"; ) 0.80s user 0.28s system 108% cpu 0.986 total # ( perf "$1"; ) 0.80s user 0.25s system 106% cpu 0.978 total # ( perf "$1"; ) 0.84s user 0.29s system 107% cpu 1.051 total # ( perf "$1"; ) 0.82s user 0.24s system 107% cpu 0.997 total # ( perf "$1"; ) 0.81s user 0.25s system 110% cpu 0.957 total # ( perf "$1"; ) 0.77s user 0.28s system 107% cpu 0.973 total # ( perf "$1"; ) 0.86s user 0.26s system 107% cpu 1.041 total # ( perf "$1"; ) 0.86s user 0.24s system 107% cpu 1.016 total # > repeat 10 zsh -f perfmatchsubscript.zsh h # ( perf "$1"; ) 1.02s user 0.31s system 108% cpu 1.231 total # ( perf "$1"; ) 0.99s user 0.24s system 109% cpu 1.121 total # ( perf "$1"; ) 0.92s user 0.23s system 109% cpu 1.053 total # ( perf "$1"; ) 0.96s user 0.28s system 111% cpu 1.111 total # ( perf "$1"; ) 0.93s user 0.27s system 107% cpu 1.102 total # ( perf "$1"; ) 0.95s user 0.28s system 107% cpu 1.143 total # ( perf "$1"; ) 0.94s user 0.22s system 106% cpu 1.090 total # ( perf "$1"; ) 0.97s user 0.22s system 108% cpu 1.089 total # ( perf "$1"; ) 0.98s user 0.34s system 107% cpu 1.225 total # ( perf "$1"; ) 0.83s user 0.31s system 107% cpu 1.065 total
この場合、パターンマッチの方が、メモリアロケーションも少なくて済み、速度も速いという結果になりました。微妙な差だけれども。（それも、実際にはありえないような repeat 65535 … です、あしからずという。）
このコードは、ファイルの入力補完に使われるコードの中、多分一回は呼ばれるようになる箇所で使いたいと思っていて、両者の違いはそんなに問題にならないと思っています。
“The Seasoned Schemer”メモ
こちらもメモを取っていく。
Guy L. Steel Jr. の {Fore,After}word が見られる。これ Lisp っぽいなと思う。
以下、ネタバレ注意！
この格言って起源がはっきりしてないのですね。ちょっと検索しただけなのだけれども、よくわからない。
If you give someone a fish, he can eat for a day.
If you teach someone to fish, he can eat for a lifetime.
他にも思い付くかしらん？今のところこれで快適だよ。というようなお互い軽い感じのやり取りだと思う。（答えなさいみたいに堅い感じがない） ‘old-shoe’ 履き慣れた靴や、気楽につきあえる人という意味があるらしい。
Can you think of a better name for U
This should be an old shoe by now.
ちょっと休憩しなよ、ということなのだろう、食べ物ブレイクじゃないのは何でだろう、とどうでも良い疑問も湧く。それと、 Duane さんは挿し絵の作者です。
きっちり理解できたかを確認して欲しいタイミングだよ、というようなことなんだろうなと思う、話も切り替わるし。
(This would be a good time to count Duane’s elephants.)
"The only difference between men and boys is the cost of their toys."
set! という新しいおもちゃの紹介、というのが自分なりの解釈。プロペラ機というおもちゃ。
15. The Difference Between Men and Boys…
食べる人・もの的な単語がぽんぽん出てきます。
最後に (glutton 'garlic) を評価していて、その上で、もうガーリックはいらないよ、といっているのに、わざわざskordaliaというやつをオススメしてくる。そして、最後にしれっとレシピを引用してくるあたり、この本ならではのらしさが発揮されていると思います。
(define gourmet …) ;;グルメ、美食家
(define gourmand …) ;;大食漢
(define omnivore …) ;;雑食動物
(define gobbler …) ;;ガツガツ食べるもの
(define nibbler …) ;;かじるもの
(define glutton …) ;;大食家、とにかく熱中する人
この歌。
私の適当な解釈だけれども、以下のような筋なんだろうと。
象を欲しい貧しい人がいて、王様は、象を与えた。象は日がな一日食べ続ける…もっと干し草を。と、その人は泣き叫ぶ。
羨望の眼差しを受けて象に乗って町を歩きたかったのだけれども、象を食わせなきゃあならない。稼ぎはエサにどんどん費やされていく…
ある日、王様に、象を引き取ってくれるなら奴隷にでもなる、と訴えて、ようやく象を持っていることから逃れることができた。
さて、この悲しい歌の教訓はなんだろうか？お金が無いなりに充足しておけ？違う。これは君にも関係あることだよ。例えパイが飛んで来たとしても、冷静に対処しよう。食べちゃいけないものかもしれないし。
言い訳抜きに、幸運はつかみ取るんだ。言い訳抜きに、運命を受け入れるんだ。かの不幸な人のようになってはならない。
最後の言いまわし、 take と comply は、単語だけを見るとどちらも、苦労無く取ること従うこと、と解釈できるものの、後に続いている without 〜 を受けて、言い訳できないくらいにやること。自分の方から進んで徹底的にやる、というニュアンスが感じられた。
パイの件りは、 take a pie when pie is passed 、幸運をつかめ、というやつだろうと思う、パイ＝幸運の比喩。 And a steady diet Even of pie, Pall on one’s pal-ate may! というのは、隣りの芝が青く見えたとしても、それは普通なんだよ、ということかな。ただここは、 〜Even of pie だけで見ることもできて、例えパイが飛んできたとしても普通に対処しようよ、と。で更に続けて、たとえそれが他の人に渡っても気にすることはない、というようにも解釈できると思います。
せっかく象をもらったのに、というのと、とにかく象をもらった・象のせいにして、という両方を悪い方に働かせてしまって、身を持ち崩してしまった、かの人のようになってはならない。というようなこと、というのが私の解釈。（象をもらう、というのを宝くじに当たる、として読み替えられるかな）
この歌がここに出てくる理由は、せっかく Y! を知ったのだから、 Y との違いを知ることで、更に両方の理解が深まる、というようなこと、と解釈しました。ちゃんと自分のものにすれば、当然どちらも使いこなせるようになるだろう。ここで自分のモノにしなかったとしたらば、両方とも使いこなせなくなっちゃうかもよと言っている、と。
あと歌詞の中に this sad song って出てくるのが、自分を参照する、という意味の共通点があるのも印象的でした。
For that elephant ate all night,
And that elephant ate all day;
Do what he could to furnish him food,
The cry was still more hay.
— John Cheever Goodwin
この章でやっている cons の評価回数を調べようとしたりで、コストは知ろうとしているよ、ということを言いたいのかなと思う、逆説的に。で、この一ページで、 Rs に保持したり、それを検索したりしていることにもコストがかかっていることを読者に認識させようとしている、というのが私の解釈。
But we know the value of food!
it が何を指すのか？ピザはもう沢山だから麺類にしよう、ということだと思う…。
Find a good restaurant that specializes in it and dine there tonight.
これは Scheme 言語を指していて、ここでは特に静的スコープ、のおかげでここで挙げた same? で説明できるってことになるのかな。 bons の中で作っている kdr を操作しているわけで、静的スコープのおかげ、というのを表しているというのが私の解釈。
Thank you, Gerald J. Sussman and Guy L. Steele Jr.
この qk と sl 、まさかとは思ったのだけれども、 quick と slow じゃないかな。というのも kdr をそれぞれ二回・一回だけ、と評価するから。
(qk (lambda (x) (kdr (kdr x)))) (sl (lambda (x) (kdr x))) )
この Wow! から以降の問答の意味わからなかったので、私なりの解釈や補足を入れながら問答の流れを追ってみたいと思います。
Last time: (get-next (quote go))
Wow!
What is so bad about that?
If we had done all of what we intended to do, we would be back where we originally asked what the value of (start-it2 l) would be where
l was …
ちゃんと手順通りにやることをやったとしたら、 (start-it2 l) の値を尋ねた所に戻るはずだったよね。→ じゃあそれから？ → 神のみぞ知る。
ここで、"Perhaps 〜"の、何が多分良かったのか、がはっきりわからない。これは、問答する中で動きを確認することに対して、実行はしていなかったのがかえって良かったのかもしれない、と言っていると考えればいいのかな。確認というか、実行したとしたらどうなっただろうかを考えてみましょう、という問だったので良かった、と。(ここで何が良かったのかというのも疑問なのだけれども。)
私なりに解釈したところは、 (start-it2 l) から返っているのか、それとも、 (get-next 'go) から返っているのかは、逐一 REPL から実行していたとしたら違いがわかりずらかったから、というもの。その上で、問答の流れで、それまで fill を呼び出すことで、意図した通りの動きをし続けただろうものが、最後に一転、 (start-it2 l) の所に返ってしまっていただろうことになったのを受けてのことなのかなと考えます。
“The Twentieth Commandment”の、 Then, when you use it, remember to forget. のことがこの問答の言わんとしていることで、 "forget" ってどういうことなのかを説明している、と考えられます。 forget しなかったとしたら、ここで言う (start-it2 l) の方へ返ってしまうことになって、その後は神のみぞ知る状態になっちゃうよ、と。
神のみぞ知るなどと有耶無耶にしてしまうのも納得が行かないので、次のように自分なりの考えを捕足しながら読みました。
six-layers とか four-layers とか、それまでの問答の流れを見るに、関数から値が返ることを、値が定まった後、と、その値を待ちかまえてその後に続くやらなければならないことに渡すということ、に分離しようとしているのではないかな、と考えることができます。待ち構えている継続へ定まった値を渡すということですね。以下のような問答もあることですし。
What would be the value of leave
It would be a function that does whatever is left to do after the value of (start-it2 l) is determined.
(start-it2 l) を呼び出すと (start-it2 l) を待っている継続が leave に保存されます。(この時点で、 leave を呼ぶことと、 (start-it2 l) から返ること、とが等価です。)
その後、 (get-next 'go) を呼び出すと今度は (get-next 'go) を待っている継続が leave に上書きされます。(今度は、 leave を呼ぶことと、 (get-next 'go) から返ること、とが等価です。)
これまでも、継続を呼び出すことはforgetすることと表現している一方で、継続を呼び出さなかった時、言い替えるとforgetしなかった場合、どの継続へ処理が移っていくのかということを、この問答で気付いてもらおうというのもねらいなのかな、というのが私なりの解釈です。
というわけで、 (get-next 'go) を呼んだ後で leave を呼ばないという、問答と同様なことをホントにやったとしたら実際に何が起こるのかを自分なりに考えてみたいと思います。
まず、 start-it2 を呼ぶ。
gosh> (start-it2 '(foo)) foo gosh>
ここで、 fill には、 waddle を呼んで (start-it2 '(foo)) を待っている以下のような継続が保存されていると考えられます。
(lambda (x) ((lambda (v) (PRINT-THEN-REPL v)) ((lambda (_v) (waddle '())) x)))
REPL の print から次のループへという意味で PRINT-THEN-REPL にしました。
gosh> (cons 'discard (get-next 'go)) () gosh>
これは the final value is () ということを言っていることなのだと考えます。( (start-it2 '(foo)) がもともと作っていた継続に処理が移っていく。つまり、 get という名に値しない、ということを言っていると考えられます)。
何が起きているのか自分なりに納得するために、説明を加えてみます。 REPL へ入力した (cons 'discard (get-next 'go)) の、 (get-next 'go) の箇所での継続は以下のようなものだと考えられます。
(lambda (x) ((lambda (v) (PRINT-THEN-REPL v)) ((lambda (v) (cons 'discard v)) x)))
ここに (get-next 'go) の結果が渡されるので、わざとらしくそのまま埋め込んだとすると以下のようになります。
((lambda (x) ((lambda (v) (PRINT-THEN-REPL v)) ((lambda (v) (cons 'discard v)) x))) (get-next 'go)) ;; (get-next 'go) は fill の呼び出しなのでその内容を埋め込むと↓ ((lambda (x) ((lambda (v) (PRINT-THEN-REPL v)) ((lambda (v) (cons 'discard v)) x))) ((lambda (x) ((lambda (v) (PRINT-THEN-REPL v)) ((lambda (_v) (waddle '())) x))) 'go)) ;; さらに、これ↑はよく見ると、関数呼び出しの連なりの↓と等価 ((lambda (x) ((lambda (v) (PRINT-THEN-REPL v)) ((lambda (v) (cons 'discard v)) ((lambda (v) (PRINT-THEN-REPL v)) ((lambda (_v) (waddle '())) x))))) 'go)
順に、 waddle → PRINT-THEN-REPL 呼び出されています。 (cons discard v) は呼び出されていないので、 "()" が表示されて REPL のプロンプトが表示される、ということになります。
さて試しに、最初に REPL から gosh> (cons 'start-it2 (start-it2 '(foo))) と入力した場合には、以下のような結果となります。
gosh> (cons 'start-it2 (start-it2 '(foo))) ;; (1) (start-it2 . foo) gosh> (cons 'discard (get-next 'go)) (start-it2) gosh>
ここでも REPL から gosh> (start-it2 '(foo)) と入力したのと同様、 fill には、 waddle を呼んで (start-it2 '(foo)) を待っている以下のような継続が保存されていると考えられます。違いは、 (PRINT-THEN-REPL v) の前に (cons 'start-it2 v) がある点です。
(lambda (x) ((lambda (v) (PRINT-THEN-REPL v)) ((lambda (v) (cons 'start-it2 v)) ;;<- (1) の時点で、 (start-it2 '(foo)) ((lambda (_v) (waddle '())) ;; を待ち構えている継続と同じ。 x))))
(1)の時点で (start-it2 '(foo)) を待ち構えている継続は以下。
(lambda (x) ((lambda (v) (PRINT-THEN-REPL v)) ((lambda (v) (cons 'start-it2 v)) x)))
上の(1)からの REPL での実行例ではどちらも最終的に、この(1)の時点で (start-it2 '(foo)) を待ち構えている継続が呼び出されている、ということがわかります。
the final value is () と言っているように、最終的にどの PRINT-THEN-REPL が値を印字して次の入力を評価しようとしているか、を探っていくことで、一見、不可解に思えるような挙動も自分なりに納得できるようになりました。
さて、ここで問答は、 (get-next 'go) を待っている継続の方( get-next の呼び出しにより、 leave に保存される継続)を呼び出したいとすると、 (leave '()) をどこかで呼ぶ必要があるということになる。そこで、 get-first を以下のように定義してこれを使えば良い。という問答が続いていきます。
(define (get-first l) (let/cc here (set! leave here) (waddle l) (leave '())))
先程の start-it2 で見たのと同様に、 fill に保存される継続を考えてみます。
gosh> (get-first '(foo)) foo gosh>
この時点で、 fill には、 leave の呼び出しを含む継続が保存されていると考えられます。
(lambda (x) ((lambda (v) (PRINT-THEN-REPL v)) ((lambda (_v) (leave '())) ((lambda (_v) (waddle '())) x))))
(waddle '()) の結果を捨てて、 (leave '()) を呼んでトップレべル( (get-first '(foo)) を待っていたもともとの継続)へ、というような継続が保存されている。この中の leave は get-next を呼び出した時点で、今度は get-next の結果を待ちかまえる継続に書き換えられる。こんな風に。
gosh> (cons 'ok (get-next 'go)) (ok) gosh>
leave には次のような継続が保存されていると考えられます。
(lambda (x) ((lambda (v) (PRINT-THEN-REPL v)) ((lambda (v) (cons 'ok v)) x)))
直接 leave を評価してみるとこのことを確認することができます。
gosh> (leave '()) (ok) gosh> (leave 'cdr) (ok . cdr)
継続の呼び出しを使って、所謂、 "get-next から返る" といういかにも get の名にふさわしい挙動をさせようとすると、掟20の to forget が重要となります。この挙動に限らずなのだけれども、どの継続に処理を移して行くことになるのか特に注意を払う必要がある、ということもこの問答の言わんとしていることなのかな、というのが私なりの解釈です。
let を消す、二回目。一回目は、 beglis の所で出てきて、その時はやり方はもう知っているから、だったけれども、今回は、 Thank you, John Reynolds 。
ここで注記に、これなら Scheme で動くよって書いてあって、なぜあえて書いてあるのかはっきりわからない。一回目との対比で言うと、ここで言う Scheme は現に今実装しようとしている Scheme でも動く、ということを言っているのかな。
Do we need ((lambda (val) ...) ...) here too?
Yes,¹ here and in beglis.
Thank you, john Reynolds.
----
¹ S: So that our definitions always work in Scheme.
最後。これはピザを模した奴のとは異なり形は関係ありません、といったとこかしらん？
†No, you don’t have to eat parentheses.
“The Little Schemer”メモ
Updated 2018-01-05T14:18:41+09:00この本おもしろいので、色々と気になった、もしくはつまずいた箇所のメモを取っておこうと思います。
メモしていて気づいたんだけれども。こんなふうにメモって公開することは、著者さんからしたら、野暮なことはやってくれるな、と思われるかなと考えた。否、やってるやってる、と笑い飛ばしてくれるんじゃないかとも思う。
以下、ネタバレ注意！
For the student of Lisp programming, The Little LISPer can perform the same service that Hanon’s finger excercises or Czerny’s piano studies perform for the student piano.
— Gerald J. Sussman
さらっとこんな問答がある。
What is (cons s l)
where s is a
and l is b
No answer.
Why?
これ、何かしら意味があるのではないかと疑っている。というのは、 Harry って何やねん Oscar やろと突っ込むところだろと考えられるからなんだけれども。誰か教えてもらいたいです。
…
where
s is (Harry had a heap of apples)
ブラックなものが感じられる箇所、間違いなく狙っているんだろう。メリーさん…？
…
where
l is (Mary had a little lamb chop)
これはあまり自信が無い。 cup ばかりで不自然に感じられたのと hick cup の意味が取れなかった。（…もしかして、韻を踏みたかっただけってことはないだろうか？ hiccup ってことで…？）
…
and
lat is (coffee cup tea cup and hick cup)
かと思うと、直球の格言。
Who knows? But the proof of the pudding is in the eating, so let’s try another example.
星といってもこれ→ * のことだけれどもね。
*Oh My Gawd*: It’s Full of Stars
それ saucer ！
…というつっこみを期待されているんですよね…
…
and
l is
(((tomato sauce)) ((bean) sauce) (and ((flying)) sauce))
"An apple a day keeps the doctor away."
Time for an apple?
One a day keeps the doctor away
苺とメカジキ（strawberries swordfish）で画像検索してみるとわりと（かどうかは微妙なような気が…と個人的には思ってしまうのだけれども、）普通なレシピのようですね。苺サルサソースというとびっくりするようなものでもないのかな。
It’s a strange meal, but we have seen foreign foods before.
相手は答えられないと解っているはずなのにもかかわらず、わざとらしく声をかけるというようなこと。応えることすらできない原因もそちらにあるのに。"わかるでしょ？"のニュアンスがあってこの引用があるんだろうと思う。
実際、この計算終わらないよ…
But answer come there none —
And this was scarcely odd, because
They’d eaten every one
— Luis Carrol
"またかよ…もういい加減にしてよ"、というようなことかな。
twitter で検索してみるとニュアンスをとらえることができるような気がします。私が見たのは、あるお偉いさんが無責任に見えるような放言をした時に、その反応として、"こいつまた言ってるのかよ…"、というような。
Stop the World — I Want to Get Off.