読者です 読者をやめる 読者になる 読者になる

kb84tkhrのブログ

何を書こうか考え中です

Scheme修行(16) 第20章 店には何がある?(続きの続きの続き)

私の空気読みによると、なんかletやletrecは宿題ね、と言われているような気がする
lambdaができてるからきっと簡単にできるはず

えーとlambdaしてapplicationするということだから

(define binds-of (lambda (x) (car (cdr x))))
(define letbody-of (lambda (x) (cdr (cdr x))))

(define list-to-action
  (lambda (e)
    (cond ((atom? (car e))
           (cond ...
                 ((eq? (car e) (quote let)) *let)
                 ...
                 (else *application)))
          (else *application))))

(define let-formals-of
  (lambda (binds)
    (cond ((null? binds) (quote ()))
          (else (cons (car (car binds)) (let-formals-of (cdr binds)))))))
(define let-args-of
  (lambda (binds)
    (cond ((null? binds) (quote ()))
          (else (cons (car (cdr (car binds))) (let-args-of (cdr binds)))))))
(define *let
  (lambda (e table)
    ((lambda (args)
       (beglis (letbody-of e)
               (multi-extend (let-formals-of (binds-of e))
                             (box-all args)
                             table)))

こうかな

> (value '(let ((x (quote a)) (y (cons (quote b) (quote ())))) (cons x y)))
'(a b)

よし

こうじゃなくて、いったんeをlambdaに書き換えてやってからmeaningにかけるやりかただと

(let ((x a) (y b)) z1 z2)
↓
((lambda (x y) z1 z2) a b)

となるように書き換えるわけだから

(define let2lambda
  (lambda (e)
    (cons (cons (quote lambda)
                (cons (let-formals-of (binds-of e))
                      (letbody-of e)))
          (let-args-of (binds-of e)))))
(define *let
  (lambda (e table)
    (meaning (let2lambda e) table)))

ですかね
consで目が回りそうですが

> (value '(let ((x (quote a)) (y (cons (quote b) (quote ())))) (cons x y)))
'(a b)

うまくいきました

letrecはもうちょっとややこしかったですね

(letrec ((x1 a1) (x2 a2)) z1 z2)
=
((let ((x1 0) (x2 0))
   (let ((y1 a1) (y2 a2))
     (set! x1 y1) (set! x2 y2) z1 z2))

でしたから

えーと
あっ
y1とかy2とかが作れない

シンボル名をいじるどころか文字列も扱えないんだった
どうしよう
そこだけ文字列型使うか
セルフで実行できなくなるけど

(define temp-symbol
  (lambda (sym)
    (string->symbol (string-append "$$" (symbol->string sym)))))
(define letrec-formals
  (lambda (binds)
    (cond ((null? binds) (quote ()))
          (else (let ((fml (car (car binds))))
                  (cons (cons fml (cons 0 (quote ())))
                        (letrec-formals (cdr binds))))))))
(define letrec-vals
  (lambda (binds)
      (cond ((null? binds) (quote ()))
            (else (let ((fml (car (car binds)))
                        (val (car (cdr (car binds)))))
                    (cons (cons (temp-symbol fml)
                                (cons val (quote ())))
                          (letrec-vals (cdr binds))))))))
(define letrec-sets
  (lambda (binds)
      (cond ((null? binds) (quote ()))
            (else (let ((fml (car (car binds))))
                    (cons (cons (quote set!)
                                (cons fml
                                      (cons (temp-symbol fml)
                                            (quote ()))))
                          (letrec-sets (cdr binds))))))))
(define letrec2let
  (lambda (e)
    (let ((binds (binds-of e)))
      (cons (quote let)
            (cons (letrec-formals binds)
                  (cons (cons (quote let)
                              (cons (letrec-vals binds)
                                    (letrec-sets binds)))
                        (letbody-of e)))))))
(define *letrec
  (lambda (e table)
    (meaning (letrec2let e) table)))

なんか長いなあ
consがもうわけわからんし
でも動くことは動く

> (value '(define multirember
            (lambda (a lat)
              (letrec ((mr (lambda (lat)
                             (cond ((null? lat) (quote ()))
                                   ((eq? a (car lat)) (mr (cdr lat)))
                                   (else (cons (car lat) (mr (cdr lat))))))))
                (mr lat)))))
> (value '(multirember (quote a) (quote (a b a c))))
'(b c)

こういうのをソースに書いて後付けできるようにするとマクロになるわけですね
ここまでやったからには簡単でいいからマクロとして実装してみたいですね

scheme本来のマクロはけっこうややこしい感じだし原理を確認したいだけだから
うんと単純なやつで

*letと*letrecをじっと見ると、eを変換してからmeaningにかければいいっぽい

eを変換するのにもvalueのしくみ自身を使うわけですけど
今のまま(value '(lambda ...) e)とやっても望みの結果は得られません
*applicationに似てるけど、引数をevlisせずそのまま渡して、返された値をもう一度
評価する関数がいるはず
こういう感じ

(define *macro-application
  (lambda (e table)
    (meaning (expand e table) table)))
(define expand
  (lambda (e table)
    ((meaning (function-of e) table)
              (arguments-of e))))

関数をふたつに分けているのは、expandだけ呼んで正しくマクロが展開されているか
確認できるようにしたかっただけです

・・・ということは
式を見て*applicationを呼ぶか*macro-applicationを呼ぶか見分けがつかないといけません
どうやって区別しよう?

手習い式のクロージャだったらただのリストなのでnon-primitiveの代わりにmacroとか
書いてれば済んだんでしょうが今や本当のクロージャそのものだから・・・
うまい情報のもたせ方あるかなあ?

kons式にセレクタを作って、関数なのかマクロなのかを返してくれるようにする手はあるな
*lambdaと*applicationも修正しないといけないけど

と思って考えてみたけどあんまりいい感じじゃない

あーあれか?
種類を持たせるなんてけちくさいことを言わず、*applicationそのものを
覚えさせておけばいいか?できるか?
これができればかっこいい気がする
``先生の意図どおりかもしれない?

プリミティブなやつもこれに合わせないとなのか
a-primとかb-primとかに吸収できそうではあるけど
なんか大げさだなあ

なんかもっとこじんまりしないかな
難しいことせずにマクロ用のテーブルを作って分けちゃうか
マクロの名前のほうが優先して検索されちゃうけどscheme的にはどうなんだろうな

(define macro-table (lambda (name) #f))
(define macro?
  (lambda (e)
    (lookup macro-table e)))

見つからなかったら継続とかすごいことせずに#fを返すようにしておきます
見つかればマクロ(に相当するlambda)を返すはずなので区別はつくはず

マクロを定義するところ
構文は(defmacro <マクロ名> (lambda ...))と考えてます
マクロ定義に対してset!することはないことにしてboxは省略

(define value
  (lambda (e)
    (let/cc the-end
      (set! abort2 the-end)
      (cond ((define? e) (*define e))
            ((defmac? e) (*defmac e)) ; ここ追加
            (else (the-meaning e))))))

(define defmac?
  (lambda (e)
    (cond ((atom? e) #f)
          ((atom? (car e)) (eq? (car e) (quote defmac)))
          (else #f))))

(define *defmac
  (lambda (e)
    (set! macro-table
          (extend (name-of e)
                  (the-meaning (right-side-of e))
                  macro-table))))

式を見て関数かマクロか決めるところ

(define list-to-action
  (lambda (e)
    (cond ((atom? (car e))
           (cond ...
                 ((macro? (car e)) *macro-application) ; ここ追加
                 (else *application)))
          (else *application))))

それから、*identifierは両方のテーブルを探すようにします

(define *identifier
  (lambda (e table)
    (let ((m (lookup macro-table e)))
      (cond ((eq? m #f) (unbox (lookup table e)))
            (else m)))))

できたぽいです
まずは簡単なやつで試してみます

> (value '(defmac set1
            (lambda (name)
              (cons (quote set!)
                    (cons name
                          (cons 1 (quote ())))))))
> (expand '(set1 a) lookup-in-global-table)
'(set! a 1)
> (value '(define a 0))
> (value 'a)
0
> (value '(set1 a))
> (value 'a)
1

できました
ほんとはこんなにすんなりできたわけじゃありませんが

ではletやってみます

・・・

letって引数が可変長じゃないか
まあ可変長受け取れるように作ればいいんだけど
可変長なところはカッコでくくることにしちゃおう
束縛するところはカッコでくくるんだから本体をカッコでくくっちゃだめという法はない(開き直り
書く気になれば書けると思うから!

(value '(define let-formals-of
          (lambda (binds)
            (cond ((null? binds) (quote ()))
                  (else (cons (car (car binds))
                              (let-formals-of (cdr binds))))))))
(value '(define let-args-of
          (lambda (binds)
            (cond ((null? binds) (quote ()))
                  (else (cons (car (cdr (car binds)))
                              (let-args-of (cdr binds))))))))
(value '(defmac my-let
          (lambda (binds body)
            (cons (cons (quote lambda)
                        (cons (let-formals-of binds) body))
                  (let-args-of binds)))))

まずは正しく展開されるか確かめてみよう

> (expand '(my-let
             ((x (quote a))
              (y (cons (quote b) (quote ()))))
             ((cons x y))) ; ここのカッコがひとつ多い
          lookup-in-global-table)
'((lambda (x y) (cons x y)) 'a (cons 'b '()))

OK
では実行

> (value '(my-let
            ((x (quote a))
             (y (cons (quote b) (quote ()))))
            ((cons x y))))
'(a b)

おk
ふー終わり終わり
letrecは新しいシンボル作るところがめんどっちいからパス

あ、でも「普通の」defineも書けるようにしてみたかったんだった
(define (add2 x) (add1 (add1 x)))みたいに書くやつね
本体に複数の関数を書けるようにはしないよ!

> (value '(defmac my-define
            (lambda (form body)
              (cons 'define
                    (cons (car form)
                          (cons (cons 'lambda
                                      (cons (cdr form)
                                            (cons body (quote ()))))
                                (quote ())))))))
> (expand '(my-define (add2 x) (add1 (add1 x))) lookup-in-global-table)
'(define add2 (lambda (x) (add1 (add1 x))))

よしよし
では

> (value '(my-define (add2 x) (add1 (add1 x))))
'(no-answer define)

あり?

ああ、meaningにはdefineないもんね
マクロで変換するところはvalueを呼ぶほうがよかったのかな?
つまりこう?

(define *macro-application
  (lambda (e table)
    (value (expand e table))))

add2は動いた

> (value '(my-define (add2 x) (add1 (add1 x))))
> (value '(add2 1))
3

けどこれじゃ変換後の式の評価でtableに入ってる環境が使われないからおかしくない?
なんか沼にはまってる?

どんなときにおかしくなるかな
マクロ内で自由変数を参照してる時とかか

> (value '(my-let ((x (quote a)))
                  ((my-let ((y (cons (quote b) (quote ()))))
                            ((cons x y))))))
'(no-answer x)

ほらね
じゃねーよ

tableで環境を引き継がなきゃいけないとすると、*macro-applicationは元に戻すとして、
valueじゃなくてmeaningでdefineを扱えるようにする必要がある
これはまあやるだけっちゃあやるだけでできそうなんだけど
なぜdefineをvalueに置いておいたかっていうのが問題だ

とりあえずやるだけっていうのはこういうこと

(define value
  (lambda (e)
    (let/cc the-end
      (set! abort2 the-end)
      (the-meaning e))))

(define meaning
  (lambda (e table)
    (cond ((define? e) (*define e)) ; ここへ移動
          ((defmac? e) (*defmac e)) ; これも
          (else ((expression-to-action e) e table)))))

これでmy-defineもさっきのmy-letも両方動く
しかし意味もなくdefineをvalueで扱うようになっていたはずもない

valueで扱うようにしたということは、(value '(define ...))の形しか許さないということ
meaningでdefineを扱うようにしてしまうと式の途中のdefineまで処理しようとしてしまう

それで何がまずいのかというと
こんな感じで一見局所的な名前が定義できたように見えても

> (value '((lambda (x)
             (define temp 3)
             (eq? temp x))
           4))
#f

実は局所的じゃなかったとか

> (value 'temp)
3

そんなことかな
scheme準拠ならこういうこともできなきゃいけないはずなんだけど
これをなんとかするのはちょっと大変そうだ
冷静に考えるとmy-defineをあきらめるくらいが相場?
今回はこれで終わりにしておこう

またいつか

というわけでScheme修行も終わり!

Scheme修行(15) 第20章 店には何がある?(続きの続き)

lambdaは手習いのvalueにもありましたが、set!が出てきた関係で
複数の式を書けるようにする必要があります

(define *lambda
  (lambda (e table)
    (lambda (args)
      (beglis (body-of e)
              (multi-extend (formals-of e)
                            (box-all args)
                            table)))))

クロージャの作られ方が手習いの時とすこし違うかな?
手習いの時はこうでした

(define *lambda
  (lambda (e table)
    (build (quote non-primitive)
           (cons table (cdr e)))))

こちらは単純にテーブル・仮引数・関数本体をリストにして記憶してますね

今回は関数(クロージャ)を作って返し、あとでその関数を評価するようにしています
テーブル・仮引数・関数本体はクロージャに記憶されています
狙いはなんでしょうか

*applicationが出てきたらもう一度見てみます

あと、仮引数をboxに入れているのでdefineで作ったものと同じく
後から値を変更することが可能です

複数の式を処理するbeglisです
なんということはありません

(define beglis
  (lambda (es table)
    (cond ((null? (cdr? es)) (meaning (car es) table))
          (else ((lambda (val)
                   (beglis (cdr es) table))
                 (meaning (car es) table))))))

複数の式がある場合、途中の式の値は捨てられ、最後の式の値が返されます
なんか前の式の値が次の式に与えられるような雰囲気の書き方になってますが
捨てられるだけです
valに値を入れるけど実際には使わない、っていうちょっと変な書き方になってます
こういう書き方しかないのかな?

          (else (let ()
                   (meaning (car es) table)
                   (beglis (cdr es) table)))

とかさらに省いて

          (else
            (meaning (car es) table)
            (beglis (cdr es) table))

でもよさそうな気がしますけど

multi-extendはごく普通に書いてあるだけなので省略
lambdaを評価してみます

> (value '(lambda (x) x))
#<procedure:...hemer/chap20.rkt:254:4>

#<procedure:... というのは値が関数(クロージャ)ですよ、と言ってます
流れの確認

(value '(lambda (x) x))
(the-meaning '(lambda (x) x))
(meaning '(lambda (x) x) lookup-in-global-table)
((expression-to-action '(lambda (x) x)) '(lambda (x) x) lookup-in-global-table)
(*lambda  '(lambda (x) x) lookup-in-global-table)
(lambda (args)
  (beglis '(x)
    (multi-extend '(x) (box-all args) lookup-in-global-table)))

lambdaだけあってもしかたがないので*applicationを作ります

(define *application
  (lambda (e table)
    ((meaning (function-of e) table)
     (evlis (arguments-of e) table))))

ややこしいことやってるはずな割には短くて簡潔の見本みたいなコードですね
手習いだとここが相当しそうです

(define *application
  (lambda (e table)
    (apply (meaning (function-of e) table)
           (evlis (arguments-of e) table))))
           
(define apply
  (lambda (fun vals)
    (cond ((primitive? fun) (apply-primitive (second fun) vals))
          ((non-primitive? fun) (apply-closure (second fun) vals)))))

(define apply-closure
  (lambda (closure vals)
    (meaning (body-of closure)
             (extend-table (new-entry (formals-of closure) vals)
                           (table-of closure)))))

*lambdaと組み合わせて見てみると
applyやapply-closureがなくなってしまっていることがわかります
プリミティブとlambdaを区別せずに評価できるようになってるということですね

手習いの時は、lambdaを評価したときの値は
(non-primitive テーブル 仮引数 本体)というリストで、
これがクロージャを表していることになっていました
クロージャの内容も表示することができたので、クロージャの正体をつかみやすかった記憶があります
ただ、これはただのリストですのでそのまま評価することはできず、
apply-closureでリストを分解してあらためて評価してやる必要がありました

今回はクロージャを表すリストでなく、このようなlambdaといっしょにlambdaを評価した時点の
eとかtableとかを記憶している、クロージャそのものを持っています

(lambda (args)
  (beglis (body-of e)
          (multi-extend (formals-of e)
                        (box-all args)
                        table))

そのため、*applicationで引数を直接あたえて評価することができるようになったんですね
結局手習いの時と同じ動きになっています
プリミティブな関数も同様のしくみで実現するようになっているので
*application以下の関数に場合分けの必要もなくなり、今のようにシンプルにできた、と
*lambdaのところで気になった「狙い」はそういうことだったと思われます

evlisも普通っちゃあ普通

(define evlis
  (lambda (args table)
    (cond ((null? args) (quote ()))
          (else ((lambda (val)
                   (cons val (evlis (cdr args) table)))
                 (meaning (car args) table))))))

さっきの*lambdaにもほとんど同じような書き方が出てきましたが
今度はvalは捨てられずに使われています
健全

「ここでの定義がSchemeで常に動作するようにそうしています」という注がついています
ということは

          (else (let ()
                   (meaning (car es) table)
                   (beglis (cdr es) table)))

みたいな書き方を許さないSchemeがあるということかな?

あらためて考えてみると、(lambda () ...)の「...」に複数の式を並べて
書けなくてもlambdaの入れ子を増やしていけば同じ意味の式になるんですね
これもシンタックスシュガーだったのか

さて*lambda と *application が書けましたので関数を評価できるようになりました

> (value '((lambda (x) x) 1))
1

追います

global-table -> 空

(value '((lambda (x) x) 1))
(the-meaning '((lambda (x) x) 1))
(meaning '((lambda (x) x) 1) lookup-in-global-table)
((expression-to-action '((lambda (x) x) 1)) 
 '((lambda (x) x) 1) lookup-in-global-table)
(*application  '((lambda (x) x) 1) lookup-in-global-table)
((meaning  '(lambda (x) x) lookup-in-global-table)
 (evlis '(1) lookup-in-global-table))
((lambda (args)
   (beglis '(x)
     (multi-extend '(x) (box-all args) lookup-in-global-table)))
 '(1))
(beglis '(x)
     (multi-extend '(x) (box-all '(1)) lookup-in-global-table)))

global-table -> | x | 1 |

(meaning 'x lookup-in-global-table)
(*identifier 'x lookup-in-global-table)
1

defineと組み合わせることもできます

> (value '(define id (lambda (x) x)))
> (value '(id 2))
2

追います

global-table -> 空

(value '(define id (lambda (x) x)))
(*define '(define id (lambda (x) x)))
(set! global-table (extend 'id
                           (box (the-meaning (lambda (x) x)))
                           global-table))

global-table -> | id | (lambda (args) (beglis '(x) ...) |

(value '(id 2))
(meaning '(id 2) lookup-in-global-table)
(*application '(id 2) lookup-in-global-table)
((meaning 'id lookup-in-global-table) (evlis '(2) lookup-in-global-table))
((lambda (args)
   (beglis '(x)
     (multi-extend '(x) (box-all args) lookup-in-global-table)))
 '(2))

global-table -> | id | (lambda (args) (beglis '(x) ...) |
                | x  | 2                                |

(meaning 'x lookup-in-global-table)
(*identifier 'x lookup-in-global-table)
2

lambdaが評価できるようになったということはtrueとfalseとifが定義できるように
なったということですね!

> (value '(define otrue (lambda (x y) x)))
> (value '(define ofalse (lambda (x y) y)))
> (value '(define oif (lambda (cnd thn els) (cnd thn els))))
> (value '(oif otrue 1 2))
1
> (value '(oif ofalse 1 2))
2

これでcondは不要です(嘘とも言い切れない

先回りして書いてた*constについてはちょっとだけ
最初の*constの定義はこう

(define a-prim
  (lambda (p)
    (lambda (args-in-a-list)
      (p (car args-in-a-list)))))
(define b-prim
  (lambda (p)
    (lambda (args-in-a-list)
      (p (car args-in-a-list)
         (car (cdr args-in-a-list))))))

(define *const
  (lambda (e table)
    (cond ...
          ((eq? e (quote cons)) (b-prim cons))
          ((eq? e (quote car)) (a-prim car))
          ...)))

これでも動くんですが、carとかconsを評価するたびに(b-prim cons)や
(a-prim car)を評価することになります

こう書きなおしておけば

(define *const
  (let ((:cons (b-prim cons))
        (:car (a-prim cons)))
    (lambda (e table)
      (cond ...
            ((eq? e (quote cons)) :cons)
            ((eq? e (quote car)) :car)
            ...))))

(b-prim cons)や(a-prim car)を評価するのは
defineのときの1回だけで済みます
letがlambdaの外側にあることが大事です
letが先に評価されるので、:consや:carを含むクロージャができます
letがlambdaの中にあると、lambdaを評価するたびに:consや:carを
全部作るのでかえって非効率になります

第15の戒律(最終版)
関数定義において繰り返される式は、当の関数を1回使用するときに2回評価される
可能性があるなら、それらの値を名づくるに(let ...)を用うべし。また、関数が
用いられるごとに再評価される(set!のない)式の値には、(let ...)を用いて
名づくるべし。

順番が逆になりましたが
a-primやb-primは、普通の関数を、*application向けに変換するものです
普通の関数は(f 'a 'b 'c)のように引数を取りますが
*appliationには(f ('a 'b 'c))のように引数をリストにして渡す必要があるためです

condはほぼ手習いの時と同じなので省略して*letccです

(define *letcc
  (lambda (e table)
    (let/cc skip
      (beglis (ccbody-of e)
              (extend (name-of e)
                      (box (a-prim skip))
                      table)))))

*lambdaと似てますね
*lambdaでは引数の名前と値(のbox)を組みにしていましたが
こちらでは継続の名前と継続を組にしています
a-primしているのはリストに入った引数をskipに渡すため
あとで(e '(result))としてやるとあたかもlet/ccがresultを返したかのように
動作を継続します

処理してるコードの中のlet/ccと、インタプリタの処理をlet/ccするのが
本当に一致するのかというとちょっと心配です
雰囲気的に動いてくれそうな感じではあるんですが

> (value '(let/cc hop 1))
1
> (value '(let/cc hop (hop 1) 2))
1

動いてはいますね
こんなのうまく追いかけられるかな

(value '(let/cc hop (hop 1) 2))
(the-meaning '(let/cc hop (hop 1) 2))
(meaning '(let/cc hop (hop 1) 2) lookup-in-global-table)
(*letcc '(let/cc hop (hop 1) 2) lookup-in-global-table)

(let/cc skip (beglis '((hop 1) 2)
                     (extend 'hop <skipの入ったbox> lookup-in-global-table)))
skip <- (REPLに値を返すだけの)継続
(beglis '((hop 1) 2) (extend 'hop <skipの入ったbox> lookup-in-global-table))
global-table -> | hop | <skipの入ったbox> |
((lambda (val) (beglis '(2) lookup-in-global-table))
   (meaning '(hop 1) lookup-in-global-table))
※以下(lambda(val) ...)は省略
(*application '(hop 1) lookup-in-global-table)
(*application '(hop 1) lookup-in-global-table)
((meaning 'hop lookup-in-global-table) (evlis '(1) lookup-in-global-table))
((*identifier 'hop lookup-in-global-table) '(1))
((unbox <skipの入ったbox>) '(1))
((a-prim skip) '(1))
(skip 1)
1

ちょっと例が簡単すぎたかな・・・
でも続きを実行してくれそうな気がしてきたぞ
「(REPLに値を返すだけの)」が「回りの式に値を返す」になるだけだもんね?

(value '(zero? (let/cc hop (hop 1) 2)))

だったら、えーと
これはイメージトレーングだけにとどめよう
(hop 1)を評価すると(meaning '(let/cc hop (hop 1) 2))の値が1になって
引き続き(zero? 1)を評価する感じになるはずだ
大丈夫だ

最後の仕上げです
the-empty-tableが半端なままです
こうなります
abort2は脱出用の継続です

(define the-empty-table
  (lambda (name)
    (abort2 (cons (quote no-answer) (cons name (quote ()))))))

そこに処理を書くのか
なんかすごいな
ほとんどそこにしか書くところはないけど

このthe-empty-tableが使えるよう、valueに手を加えます

(define value
  (lambda (e)
    (let/cc the-end
      (set! abort2 the-end)
      (cond ((define? e) (*define e))
            (else (the-meaning e))))))
> (the-empty-table 'z)
'(no-answer z)
> (value 'z)
'(no-answer z)

ちゃんと例外的な状況も処理できるようになりましたよと

さてこれでdefineもできるvalueができました
ということは、自分自身を実行することもできるはず

こんな感じで、すべての関数をvalueの中で改めて定義してやります

(value '(define value
          (lambda (e)
            (let/cc the-end
              (set! abort2 the-end)
              (cond ((define? e) (*define e))
                    (else (the-meaning e)))))))

もはやglobal-tableがどんなクロージャになっているのか想像するのも困難なレベル

動くかな・・・

> (value '(value (quote
                  (define length
                    (lambda (lat)
                      (cond ((null? lat) 0)
                            (else (add1 (length (cdr lat))))))))))
> (value '(value (quote (length (quote (a b c))))))
3

動いたー!

第20章 店には何がある?(続き)

the-meaningです

(define the-meaning
  (lambda (e)
    (meaning e lookup-in-global-table)))

(define lookup-in-global-table
  (lambda (name)
    (lookup global-table name)))

global-tableにおけるmeaningは特別ということでtheがついてるんでしょうね

lookup-in-global-tableはテーブルと同じようなものというのは正しいですか。
はい。名前を引数として取り、その名前と組になっている値をglobal-tableの中で
探します。

何を言いたいのかわかるようなわからないような感じですが
言ってることはそのとおりです

つまり、lookup-in-global-tableはglobal-tableのようなものということですか。
はいでもあり、いいえでもあります。
*defineはglobal-tableを変更するので、lookup-in-global-tableは常に
最新のglobal-tableと同じようなものですが、現在のglobal-tableと同じ
ようなものではありません。

てどういうことですかね
lookup-in-global-tableが現在のglobal-tableを探してくれないなんてことあるんでしょうか

・・・

直接global-tableって書いちゃうと、書いた時点のglobal-tableが
使われてしまって、あとでset!とかした内容が反映されないってことか
lookup-in-global-tableにすることで、実際に中身が必要になるまでテーブルの評価を
遅延させてる働きがあるんですね
Yでやったアレと同じ

これを前に見たことがありますか?
16章のY!を思い出していますか?

いったんletで変数に割り当てた関数を変更してから呼ぶとき、
変更前の関数が呼ばれるのか変更後の関数が呼ばれるのかどっちなんだと思ってましたね
話の流れ上、変更後の関数が呼ばれるに違いないということで進みましたが
やはりそういうことだったぽいです

次はtheのないmeaning
こんどはtableを引数に取ります

(define meaning
  (lambda (e table)
    ((expression-to-action e) e table)))

「(expression-to-action e) e」てあたり、なんか回りくどくないですか
(action e table)みたいに作れないのかな
どっちみちeはactionに渡されるんだし

それだとactionが巨大なcondになってしまうからそれを避けてるんでしょうかね
ポリモーフィズムみたいなものですね
ていうかこっちのほうがポリモーフィズムの元かな

ひとつ「action」を作ってみます

(define *quote
  (lambda (e table)
    (text-of e)))

なんとなく通して実行できそうな部品が揃ってきました
ちょっとずつ動かしながら進みたいので、フライングして後ろの方に出てくる
text-ofとかexpression-to-actionあたりの関数を入れておきます
全部入れるとまたあれもこれも入れないと動かないので余計なところはコメントアウトしたり

> (value '(quote a))
'a

quoteだけ評価できるインタプリタの完成です

(value '(quote a))
(the-meaning '(quote a))
(meaning '(quote a) lookup-in-global-table)
((expression-to-action '(quote a)) '(quote a) lookup-in-global-table)
(*quote '(quote a) lookup-in-global-table)
(text-of '(quote a))
'a

というわけです
actionが変わってもこのへんの流れは同じようなものだと思われます

次は*identifer
テーブルから探してくるだけですが値はboxに入っているのでunboxする必要があります

(define *identifier
  (lambda (e table)
    (unbox (lookup table e))))

ええとこれは試す方法あるかな
テーブルに何か入っている必要がありますけど

ああ、今回はdefineがありますね
手習いの時は結局lambdaまで実装しないとテーブルに何も入らなくて
けっこう試しづらかった記憶が

> (value '(define a (quote aaa)))
> (value 'a)
'aaa

いけてるようです

続いてset!
目玉機能ですけどカンタン
ほとんどidentifierと同じ

(define *set
  (lambda (e table)
    (setbox (lookup table (name-of e))
            (meaning (right-side-of e) table))))

動きます

(上の続き)
> (value '(set! a (quote bbb)))
> (value 'a)
'bbb

動きはひとまとめにして追ってみます
defineとかset!とかが出てくると式だけ並べてもわかりません
boxとかテーブルのように式に式にかけないところの表現がなやましい
まあやってみます

global-table -> 空

(value '(define a (quote aaa)))
(*define '(define a (quote aaa)))
(set! global-table
  (extend (name-of '(define a (quote aaa)))
          (box (the-meaning (right-side-of '(define a (quote aaa)))))
          global-table))
(set! global-table (extend 'a 'aaa global-table))

global-table -> | a | 'aaa |

(value '(set! a (quote bbb)))
(the-meaning '(set! a (quote bbb)))
(meaning  '(set! a (quote bbb)) lookup-in-global-table)
((expression-to-action '(set! a (quote bbb)))
 '(set! a (quote bbb)) lookup-in-global-table))
(*set '(set! a (quote bbb)) lookup-in-global-table)
(setbox (lookup lookup-in-global-table 'a)
        (meaning '(quote bbb) lookup-in-global-table))
(setbox <aの指すbox> 'bbb)

global-table -> | a | 'bbb |

(value 'a)
(the-meaning 'a)
(meaning 'a lookup-in-global-table)
((expression-to-action 'a) 'a lookup-in-global-table)
(*identifier 'a lookup-in-global-table)
(unbox (lookup lookup-in-global-table 'a))
(unbox <aの指すbox>)
'bbb

てな感じです

set!はそのときのテーブルで、defineは常にglobal-tableで右辺を評価するところが違いますね
このへんがdefineを特別扱いする理由ぽい気がしてきました
the-meaning以下で呼ばれるとそのときのテーブルで評価されてしまいますので
(global-tableはグローバルなので使いたければいつでも使えますが自然に書けば)

defineが渡されたテーブル内で右辺を記録するようになっていたらどうなるでしょう
defineのあるスコープの範囲内でしか関数が呼び出せなくなってしまいますね
それはそれで使いみちがありそうな感じではありますが

Scheme修行(13) 第20章 店には何がある?

ついにScheme修行も最終章
あいかわらずよく意味の分からないタイトルで締めてくれます

第10章とおなじく、ここではschemeインタプリタを作ります
今回はdefineが(letccも)実装されますのでそのままセルフで自分自身を実行することができるはず

今回もなぜかテーブルの定義から入ります 好きですね
今回はリストではなく関数(というかクロージャ)でテーブルを作るそうです
関数でテーブルを作る利点は何でしょう?

まずは空っぽのテーブルを作ります

(define the-empty-table
  (lambda (name)
    (car (quote ()))))

↓のように書いてありますのでとりあえず版のようです

Scheme手習い」では次のようにしました。
(car (quote ()))

手習いの時はなんだろうこれと思ってたものですが
今回すっきり納得できるでしょうか
期待です

検索と追加です

(define lookup
  (lambda (table name)
    (table name)))

(define extend
  (lambda (name1 value table)
    (lambda (name2)
      (cond ((eq? name2 name1) value)
            (else (table name2))))))

面白いというか不思議というか新鮮な書き方ですが
なるほどなんか動きそうですね
使い方はこんな感じになるでしょうか

> (define test-table the-empty-table)
> (set! test-table (extend 'name 'taro test-table))
> (set! test-table (extend 'nationality 'japan test-table))
> (lookup test-table 'name)
'taro
> (lookup test-table 'nationality)
'japan
> (lookup test-table 'gender)
car: contract violation
  expected: pair?
  given: '()

このとき、test-tableはこんな風に育っています
変数名がかぶるのでちょっとわかりづらいですが

(lambda (name)
  (car (quote ())))
    ↓
(lambda (name2)
  (cond ((eq? name2 'name) 'taro)
        (else ((lambda (name)
                 (car (quote ()))) name2))))
    ↓
(lambda (name2)
  (cond ((eq? name2 'nationality) 'japan)
        (else ((lambda (name2)
                 (cond ((eq? name2 'name) 'taro)
                       (else ((lambda (name)
                                (car (quote ()))) name2)))) name2))))

確かに名前を与えると値を返す関数になっています

ところで(lookup table e)が(table e)と同じ意味なんであればlookupて必要なんですかね
何かと形がそろってる必要があるのかな?
必要はないけどそろえたい?
あとで何か気付きがあるでしょうか

テーブル作ったと思ったら今度は最上位のvalueを定義します ただし仮
ボトムアップだったりトップダウンだったり

(define value
  (lambda (e)
    (cond ((define? e) (*define e))
          (else (the-meaning e)))))

早速目玉機能であるdefineが現れました
完全に特別扱いです
the-meaningとやらの中では扱えないのかな?

defineです
どんな高尚なことをするのかと思ったら

(define *define
  (lambda (e)
    (set! global-table
          (extend (name-of e)
                  (box (the-meaning (right-side-of e)))
                  global-table))))

覚えておくだけかよ!
なぜ特別扱いなんだろう
the-meaningを呼んでいるとはいえthe-meaningの中で扱えないことはない気がしますが

覚えておく先はglobal-table決め打ちなんですね
ブロック構造なんかはこれでも実現できるんでしょうか
それとも実装しない?

それよりboxってなんでしょうか
入れものっぽい雰囲気は醸しだしてますが

*defineが名前と値でテーブルを拡張すると、その名前はいつも「同じ」値を
表すようになりますか。

いいえ。前に何回か見たように、名前が表すものは(set! ...)を使って変更できます。

*defineがテーブルを拡張する前に値をboxに入れるのは、それが理由ですか。

それが理由らしいです
set!するためのしくみのようです

boxを作り、値を設定し、値を取り出す関数です

(define box
  (lambda (it)
    (lambda (sel)
      (sel it (lambda (new) (set! it new))))))

(define setbox
  (lambda (box new)
    (box (lambda (it set) (set new)))))

(define unbox
  (lambda (box)
    (box (lambda (it set) it))))

短いですけど複雑ですね
まずは使ってみましょうか

> (define testbox (box 'a))
> (unbox testbox)
'a
> (setbox testbox 'b)
> (unbox testbox)
'b

いつものように追いかけてみましょう
defineあたりはてきとうにごまかしつつ

(define textbox (box 'a))
(define testbox (lambda (sel) (sel 'a (lambda (new) (set!

あれ?
(set! it new)のitってどうなるの?
今までそこはただ名前が書いてあるものだと思ってたけど、変数だったらどうなるの?
(set! 'a new)じゃ変だし・・・

そこはあくまでもitっていう名前で、変数じゃないってことかな?

> (let ((name 'aaa)) (define name 'bbb) name)
'bbb

ほんとに確かめになってるかどうか微妙ですけど
そんな感じなのでとりあえずそういうことにしておいて進みます

(define textbox (box 'a))
(define testbox (lambda (sel) (sel 'a (lambda (new) (set! it new)))))

(unbox testbox)
(unbox (lambda (sel) (sel 'a (lambda (new) (set! it new)))))
((lambda (sel) (sel 'a (lambda (new) (set! it new)))) (lambda (it set) it))
((lambda (it set) it) 'a (lambda (new) (set! it new)))
'a

ふむふむよい感じ
続いてsetbox

(setbox testbox 'b)
(setbox (lambda (sel) (sel 'a (lambda (new) (set! it new)))) 'b)
((lambda (sel) (sel 'a (lambda (new) (set! it new)))) (lambda (it set) (set 'b)))
((lambda (it set) (set 'b)) 'a (lambda (new) (set! it new)))
((lambda (new) (set! it new)) 'b)
(set! it 'b)

(unbox testbox)
(unbox (lambda (sel) (sel 'a 

・・・
ここの'a'aのままじゃ何にもなってませんね
ということはどうなんでしょう
結局itはitのままということでしょうか

仮引数のitと、boxに入ったitを区別するためにbox内のitは<it>と書くことにして
最初からやってみます

(define textbox (box 'a)) ; <it>は'aに
(define testbox (lambda (sel) (sel <it> (lambda (new) (set! <it> new)))))

(unbox testbox)
((lambda (sel) (sel <it> (lambda (new) (set! <it> new)))) (lambda (it set) it))
((lambda (it set) it) <it> (lambda (new) (set! <it> new)))
<it>
'a

(setbox testbox 'b)
((lambda (sel) (sel <it> (lambda (new) (set! <it> new)))) (lambda (it set) (set 'b)))
((lambda (it set) (set 'b)) <it> (lambda (new) (set! <it> new)))
((lambda (new) (set! <it> new)) 'b)
(set! <it> 'b)

(unbox testbox)
((lambda (sel) (sel <it> (lambda (new) (set! <it> new)))) (lambda (it set) it))
((lambda (it set) it) <it> (lambda (new) (set! <it> new)))
<it>
'b

いちおう動作を追うことができた感じです
itを単純に'aに置き換えるやり方はもはや無理ってかんじですね
の中身を覚えておく、というのはつまりクロージャを覚えておくってことなので
クロージャを思い浮かべながら追っていく必要がありそうです

ところでわざわざboxなんてものを使わなくても、直接set!してはいけないんでしょうか
上の例のようなことをするだけなら直接set!で十分です

> (define it 'a)
> it
'a
> (set! it 'b)
> it
'b

・・・

でも例えば(define it '(a b))としたときの'bのところ「だけ」を'cに置き換えたい、
ってときに困るか

まるごと(set! it '(a c))とはできても
(set! (cadr it) 'c)みたいなことはできないし書きようがありませんね
そういえばCommon Lispではそういうことができるsetfってのがあるらしいです
関係あるかな

boxを使えばそういうことができます

> (define it (cons (box 'a) (cons (box 'b) (quote ()))))
> (unbox (cadr it))
'b
> (setbox (cadr it) 'c)
> (unbox (cadr it))
'c

そういうことでしょう

Scheme修行(12) 第19章 宝石泥棒(続きの続き)

前回のwaddleはもともと再帰がややこしいところにlet/ccが入ったので

なんだかよくわからないことになってましたが
leaveとfillだけの話ならこんな感じでぴょんぴょんさせることができます

(define A
  (lambda ()
    (let/cc here (set! leave here)
      (display "A1") (newline)
      (B))
    (let/cc here (set! leave here)
      (display "A2") (newline)
      (fill))
    (let/cc here (set! leave here)
      (display "A3") (newline)
      (fill))
    (display "A4") (newline)))

(define B
  (lambda ()
    (let/cc here (set! fill here)
      (display "B1") (newline)
      (leave))
    (let/cc here (set! fill here)
      (display "B2") (newline)
      (leave))
    (let/cc here (set! fill here)
      (display "B3") (newline)
      (leave))))

get-firstの最後のleaveに相当するものはどこへ行ってしまったのか少し心配ですが
思った通りには動いてくれます

> (A)
A1
B1
A2
B2
A3
B3
A4

こういうのをたぶんコルーチンって言うんですよね

もっとよく理解するために、収集子を使った形に直してみます
忘れない関数を覚えおくべし、って言ってましたしね(意味がよくわかってないけど)

(define get-first&co
  (lambda (l)
    (let ((here (lambda (x) x)))
      (set! leave here)
      (waddle&co l here))))

(define get-next&co
  (lambda ()
    (let ((here-again (lambda (x) x)))
      (set! leave here-again)
      (fill (quote go)))))

(define waddle&co
  (lambda (l col)
    (cond ((null? l) (col (quote ())))
          ((atom? (car l))
           (let ((rest (lambda (x) (waddle&co (cdr l) col))))
             (set! fill rest)
             (leave (car l))))
          (else (waddle&co
                 (car l)
                 (lambda (x) (waddle&co (cdr l) col)))))))

なんとなくこんな感じかな、と思って書いてみたら動いてしまって
なぜちゃんと動くのかちっともわかりません
もしかしたらたまたまかも

さらに削って、途中で脱出しない版を作ってみます
これはScheme手習いの復習ですね

(define waddle&co
  (lambda (l col)
    (cond ((null? l) (col (quote ())))
          ((atom? (car l))
           (display (car l)) (newline)
           (waddle&co (cdr l) col))
          (else (waddle&co (car l) (lambda (x) (waddle&co (cdr l) col)))))))

何もしないと途中何が起こっているのかわからないのでdisplayを入れました
(((a)) b)に適用してみます

(waddle&co '(((a)) b) (lambda (x) x))
(waddle&co '((a)) (lambda (x) (waddle&co '(b) (lambda (x) x))))
(waddle&co '(a) (lambda (x) (waddle&co '()
                  (lambda (x) (waddle&co '(b) (lambda (x) x))))))
; (display 'a) (newline)
(waddle&co '() (lambda (x) (waddle&co '()
                 (lambda (x) (waddle&co '(b) (lambda (x) x))))))
((lambda (x) (waddle&co '()
   (lambda (x) (waddle&co '(b) (lambda (x) x))))) (quote ()))
(waddle&co '() (lambda (x) (waddle&co '(b) (lambda (x) x))))
((lambda (x) (waddle&co '(b) (lambda (x) x))) (quote ()))
(waddle&co '(b) (lambda (x) x))
; (display 'b) (newline)
(waddle&co '() (lambda (x) x))
((lambda (x) x) (quote ()))
(quote ())

colの値は捨てられるだけなのであまり複雑にならず多少追いかけやすいです

もとの定義では、この流れがところどころでぶったぎられる形になっているはず

(get-first&co '(((a)) b))
; (set leave (lambda (x) x))
(waddle&co '(((a)) b) (lambda (x) x))
(waddle&co '((a)) (lambda (x) (waddle&co '(b) (lambda (x) x))))
(waddle&co '(a) (lambda (x) (waddle&co '()
                  (lambda (x) (waddle&co '(b) (lambda (x) x))))))
; (set fill (lambda (x) (waddle&co '()
;             (lambda (x) (waddle&co '(b) (lambda (x) x))))))
(leave 'a)
((lambda (x) x) 'a)
'a

(get-next&co)
; (set leave (lambda (x) x))
(fill (quote go))
((lambda (x) (waddle&co '()
   (lambda (x) (waddle&co '(b) (lambda (x) x))))) (quote go))
(waddle&co '() (lambda (x) (waddle&co '(b) (lambda (x) x))))
((lambda (x) (waddle&co '(b) (lambda (x) x))) (quote ()))
(waddle&co '(b) (lambda (x) x))
; (set fill (lambda (x) (waddle&co '() (lambda (x) x))))
(leave 'b)
((lambda (x) x) 'b)
'b

(get-next&co)
; (set leave (lambda (x) x))
(fill (quote go))
((lambda (x) (waddle&co '() (lambda (x) x))) (quote go))
(waddle&co '() (lambda (x) x))
((lambda (x) x) (quote ()))
(quote ())
'()

ふむ
そんな感じですね

脱出のためのしくみは何も使っていないのに、同じことができてるのが面白いです
収集子を使う形にしたとき、全体が末尾再帰の形になったから、かなあ?
lambdaすげえ

ちゃんと動くし変なコードを書いてたりするわけでもなさそうです
でもまだ収集子が育って評価される様子がぱっとイメージできるところまではいってないんですよねー
半分機械的に書きなおしてみたら意外とうまくいった、て感じは拭えない

さてここまでわかればもう(やっと)two-in-a-row*?は目前です
ついでに第13の戒律を適用します

(define two-in-a-row*?
  (letrec
      ((T? (lambda (a)
             (let ((n (get-next (quote ()))))
               (if (atom? n)
                   (or (eq? n a) (T? n))
                   #f))))
       (get-next (lambda (x)
                   (let/cc here-again
                     (set! leave here-again)
                     (fill (quote go)))))
       (fill (lambda (x) x))
       (waddle (lambda (l)
                 (cond ((null? l) (quote ()))
                       ((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 (lambda (x) x)))
    (lambda (l)
      (let ((fst (let/cc here
                   (set! leave here)
                   (waddle l)
                   (leave (quote ())))))
        (if (atom? fst) (T? fst) #f)))))

本には(get-next 0)というのが1箇所だけ出てきますがなんですかね
たぶん書き間違いじゃないかと

さてこれって継続使わなかったらどう書けばいいんでしょうか
考えてみます

あれ?
なんか難しい?

...

骨組みはこんな感じでしょうね

(define two-in-a-row*?
  (lambda (l)
    (letrec ((T (lambda (l)
                  (cond ((null? l) #f)
                        ((atom? (car l))
                         ...
                         (T (cdr l)))
                        (else
                         (or (T (car l)) (T (cdr l)))))))
             (T l)))))

あとは、直前の値さえ覚えておいて比較すればいいはず
set!を使うのであれば

(define two-in-a-row*?
  (lambda (l)
    (let ((prv (quote ())))
      (letrec ((T (lambda (l)
                    (cond ((null? l) #f)
                          ((atom? (car l))
                           (cond ((eq? (car l) prv) #t)
                                 (else
                                  (set! prv (car l))
                                  (T (cdr l)))))
                          (else
                           (or (T (car l)) (T (cdr l))))))))
        (T l)))))

これでとりあえず動かすことはできます

難しい?と思ったのは
set!も使わないで書こうとするとどうなるかって話
イミュータブルとか関数型プログラミングとか言われてるご時世ですから

直前の値を引数に入れて渡してやれば、と思ったんですが
(T (car l))の最後に見つけた値を
(T (cdr l))に渡してあげる簡単な方法が思いつきません

関数がふたつの値を返せればいいのかな
第10の戒律は「同時に2つ以上の値を集めるには関数を作るべし」でした
これってけっきょく収集子を作るって話だったと思うんですけどそれじゃ同じ話になっちゃうし
まあリストを返せばいいか(リストを返しても同じ話かも)

(define pair
  (lambda (a b)
    (cons a (cons b (quote ())))))
(define val car)
(define prv cadr)

(define two-in-a-row*?
  (lambda (l)
    (letrec ((T (lambda (p l)
                  (cond ((null? l) (pair #f (quote())))
                        ((atom? (car l))
                         (cond ((eq? (car l) p) (pair #t (quote ())))
                               (else (T (car l) (cdr l)))))
                        (else (let ((vp (T p (car l))))
                                (cond ((val vp) (pair #t (quote ())))
                                      (else (T (prv vp) (cdr l))))))))))
      (val (T (quote ()) l)))))

悪くはないんですけどなんかごちゃごちゃしてる感じがしますね
ふたつの値を返すあたりの構文しだいかもしれませんが

リストを渡り歩くという樹状の構造と、アトムを先頭から順番に探してくるという線形の構造が
いっしょくたになっているのがいけないように思います
つまり、やっぱりget-firstとget-nextがほしいってことかなあ
イミュータブルな世界だったらどうやって作るんだろう

といったところで、以前「そこまですんのかHaskell」と思ったことがあるのを思い出しました
たしか、木の中を渡り歩くために今いるところの左側と右側の木を
常に覚えているみたいな感じ
この関数では戻る必要が無いので右側だけ覚えておけばよさそうです
つまり、先頭のアトムと、先頭のアトムよりも右側の木を返して
次はその返されたリストを渡してやれば次のアトムが取れると
なんていうか力技ですね

とにかく書いてみましたがあんまりわかりやすくはないです
Haskellのライブラリではもっとスマートに書いてあるんじゃないでしょうか

(define 1st car)
(define rest cadr)

(define 1st-and-rest
  (lambda (l)
    (cond ((null? l) (pair (quote ()) (quote())))
          ((atom? (car l)) (pair (car l) (cdr l)))
          (else (let ((a1r (1st-and-rest (car l))))
                  (let ((a1 (1st a1r))
                        (ar (rest a1r)))
                    (cond ((null? a1) (1st-and-rest (cdr l)))
                          (else (pair a1 (cons ar (cdr l)))))))))))

とりあえず動いている模様ではあります
カバー率?知りません

ということはtwo-in-a-row*?はすぐ書けますね
値の受け取り方にちょっと注意して

(define two-in-a-row*?
  (lambda (l)
    (letrec ((T (lambda (p l)
                  (let ((1r (1st-and-rest l)))
                    (cond ((null? (1st 1r)) #f)
                          ((eq? (1st 1r) p) #t)
                          (else (T (1st 1r) (rest 1r))))))))
      (T (quote ()) l))))

構造を分けることはできましたけどよくなったのかというと微妙な気分
もし仕事で書くとしたらどれで書くかなあ
普通にset!で前回の値を覚えてそうな気がします

Scheme修行(11) 第19章 宝石泥棒(続き)

two-in-a-row?です

(define two-in-a-row?
  (letrec ((W (lambda (a lat)
                (cond ((null? lat) #f)
                      (else (let ((nxt (car lat)))
                              (or (eq? nxt a)
                                  (W nxt (cdr lat)))))))))
    (lambda (lat)
      (cond ((null? lat) #f)
            (else (W (car lat) (cdr lat)))))))

two-in-a-row*?を作ります
latじゃなくて一般のリストを相手にするやつです

以前に出てきたleftmost内の補助関数lmを元にしてwalkという関数を作ります
これだと一番左のアトムしか見つけてくれませんがさらに改造してこうなります

(define leave #f)
(define fill #f)

(define waddle
  (lambda (l)
    (cond ((null? l) (quote ()))
          ((atom? (car l))
           (let ()
             (let/cc rest
               (set! fill rest)
               (leave (car l)))
             (waddle (cdr l))))
          (else (let ()
                  (waddle (car l))
                  (waddle (cdr l)))))))

(define start-it2
  (lambda (l)
    (let/cc here
      (set! leave here)
      (waddle l))))

(define get-next
  (lambda (x)
    (let/cc here-again
      (set! leave here-again)
      (fill (quote go)))))

なんでしょうかこれは
実行してみます

> (start-it2 '((donuts) (cheerios (cheerios (spaghettios))) donuts))
'donuts

> (get-next (quote go))
'cheerios

> (get-next (quote go))
'cheerios

> (get-next (quote go))
'spaghettios

> (get-next (quote go))
'donuts

> (get-next (quote go))
'()

どうやらリストの左から順にアトムを取り出してくれるようです
start-it2が最初のアトムを取り出し、get-nextで次々とアトムを取ってくる
実にいい感じです

どういうしくみなんでしょうか
leftmost的に一番左のアトムを取ってきますが、そのときにただ脱出するのではなく
続きを覚えてから脱出します
get-nextでは続きを呼び出します
すると、残りの中から一番左のアトムを取ってきます
これを繰り返すとひとつずつ取ってくることになる、ということぽいです

詳しく見ていきます
start-it2はこうです

  1. leaveに現在の継続をセットして
  2. ((donuts) (cheerios (cheerios (spaghettios))) donuts)にwaddleを適用する

waddleがdonutsに達するとこうなります

  1. restに現在の継続をセットして
  2. donutsにleaveを適用する

するとleaveがstart-it2の続きを実行しますのでstart-it2がdonutsを返すというわけですね

このときのrestはどんなものでしょうか

restに相当する関数を定義できますか。

問題ありません。

(define rest1 (lambda (x) (waddle l1)))

ここで

l1は(() (cheerios (cheerios (spaghettios))) donuts)です。

ここが評価される時点でのlは(donuts)ですが全体の流れの中で言うとそういうことになるんでしょうね
ひとつめのアトムの処理が済んだところ、ということですね
そのあともまだまだ仕事はありますよ、と

次にget-nextを呼ぶと

  1. leaveに現在の継続をセットして
  2. goにfillを適用する

leaveは後でここに戻ってくるために使われているっぽいですね

fillを呼ぶと、さきほど中断したところから実行が再開されます
渡された値(go)はlet/ccの値となりますが、何も使われずに捨てられています
上のrestが引数のxを使っていないことに対応します

waddleがcheeriosに達すると

  1. restに現在の継続をセットして
  2. donutsにleaveを適用する

するとleaveがget-nextの続きを実行しますのでget-nextがcheeriosを返してくれます
その調子でget-nextはcheerios、spaghettios、donutsを返してくれますが
最後にget-nextを呼ぶと

わお!

何がわおなんでしょうか

waddleはついに(null? l)にたどり着きます。

そうですね

ともあれ、最後の値は()です。

そうでした
何が問題なのでしょうか
いいじゃないですか()で

もし、しようとしていたことがすべて終わったのなら、最初に(start-it l)の
値を尋ねたところに戻るはずです。

・・・そうなんですか?

leaveとかfillで流れが分断されてはいるものの
leaveとかfillでジャンプする前には必ず現在の場所を覚えてて
後でその直後に戻ってくるようにはなっているので
いつかは元の場所に戻るんだよといわれればそのとおり

でも1行ずつ追うように読んでいくとかえってわかりにくくなります
順番に呼んでいくところはイメージしやすいですが戻るところはイメージしづらい

具体例でキッチリ読んでいってみます
元の引数だと大変そうなので簡単な引数で

(start-it2 '(a b))

このあとどう書くとすっきりするのか考えてみましたがいいアイデアがありません
だらだら書いていきます

これはこうなります

(letcc here
  (set! leave here)
  (waddle '(a b)))

そうするとまず「leaveに現在の継続をセットする」わけですが
「現在の継続」ってなんでしょうか
どこに戻るかってことを考えるには具体的にしておかなくてはなりません
関数の定義に遡ると(@はマークとして挿入)

(define start-it2
  (lambda (l)
    (let/cc here
      (set! leave here)
      (waddle l)))@)

leaveの引数を(let/cc ...)の値として、@のところから実行を再開する
というのがleaveの内容と言えそうです

今は終わり方を調べようとしてますので
実行を再開した後はどこまで実行されて終わるのかも気になります
この場合、すぐREPLに値を返してしまうのでそこで終わるしかありませんが
これ以外でもREPLに戻るまで実行が続くということでいいんでしょうか
そういうことにしておきます

  1. leaveの引数を(let/cc ...)の値として、@のところ(let/ccの直後)から実行を再開する
  2. (何もすることがないのでそのまま)REPLに値を返す(終了)

という理解です
leaveを関数の形で書けば(lambda (x) x)てことになるんですかね
いやここでは(lambda (x) (REPLの続き x))て感じに考えたほうがいいのかな?

次は(waddle '(a b))を評価します
(waddle '(a b))を評価し終えれば、その値が(start-it2 '(a b))の値にもなるはずですが
どうでしょうか

(waddle '(a b))はこうなります

(let ()
  (let/cc rest
    (set! fill rest)
    (leave 'a))
  (waddle '(b))))

さっきと同じように考えるとfillにはこんな継続が設定されるはず

  1. fillの引数を(let/cc ...)の値とするけれども誰も見ていないので捨てる
  2. (waddle '(b))から実行を再開する
  3. その値を(start-it2 '(a b))に返す
  4. (start-it2 '(a b))はその値をREPLに返す(終了)

そしてleaveです
さっき覚えた継続を実行しますので

(let/cc ...)の値がaとなり、それがREPLに返されて終了です
合ってます

次です

(get-next (quote go))

はこうです

(let/cc here-again
  (set! leave here-again)
  (fill (quote go)))

leaveはこういう継続

  1. leaveの引数を(let/cc ...)の値として、let/ccの直後から実行を再開する
  2. (何もすることがないのでそのまま)REPLに値を返す(終了)

そしてfillを実行
fillの引数は捨てて(waddle '(b))から実行を再開します

(waddle '(b))はこうなります

(let ()
  (let/cc rest
    (set! fill rest)
    (leave 'b))
  (waddle '())))

fillにはこんな継続が設定されます

  1. fillの引数を(let/cc ...)の値とするけれども誰も見ていないので捨てる
  2. (waddle '())から実行を再開する
  3. (waddle '(b))(waddle '())の値を(start-it2 '(a b))に返す
  4. (start-it2 '(a b))はその値をREPLに返す(終了)

そしてleaveです
さっき覚えた継続を実行しますので

(let/cc ...)の値が'bとなり、それがREPLに返されて終了です
合ってます

最後の(get-next (quote go))を実行します

(let/cc here-again
  (set! leave here-again)
  (fill (quote go)))

leaveは(略)

そしてfillを実行
fillの引数は捨てて(waddle '())から実行を再開します

(waddle '())はすぐに()を返します
すると2. 3. 4.を通って「start-it2が」()をREPLに返す、というわけですね
やっと納得できました

もうちょっとコンパクトに書けないものかなあ

で、()を返すなら何が問題なんでしょうか

ファイルに

(start-it2 '(a b))
(get-next (quote go))
(get-next (quote go))

と書いて実行しても

'a
'b
'()

という結果が表示されるだけでした
本当にstart-it2に戻っているのであれば、'()を返した後
無限ループになってもよさそうなものです

もしかして、ファイルに書いてあってもトップレベル(って言うんだっけ)まで
戻ったところで継続は止まってしまうのかな?
そうするとREPLと同じ
値が表示されるってことはそういうことかな
REPLに返すというよりトップレベルに返す、と書いたほうがよかったかもしれない

というわけで無理やりletでくるんでみました

> (let ()
    (start-it2 '(a b))
    (get-next (quote go))
    (get-next (quote go)))
 

固まってます!
もう少し様子がわかるようにしてみます

> (let ()
    (display "1 ") (display (start-it2 '(a b))) (newline)
    (display "2 ") (display (get-next (quote go))) (newline)
    (display "3 ") (display (get-next (quote go))) (newline))
1 a
2 b
3 ()
2 ()
2 ()
2 ()
 :
 :

letでくるんだことにより、fillの継続の最後が
「(start-it2 '(a b))はその値をREPLに返す(終了)」だったところが
「(start-it2 '(a b))の値を表示して次に(get-next ...)を評価する」に
なったというわけです

get-nextは同じfillを実行し続けるので最後の部分を繰り返し実行し続ける、と
ふー

やっと

では、リストが完全に消費されたあとで(leave (quote ()))を使うと
うまくいきそうだ、というのは正しいですか。

になるほど、とうなずくことができます

最後にstart-it2に戻ってきたあとleaveを呼ぶと、最後のget-nextでsetした
leaveが実行されるので、start-it2ではなくget-nextが()を返して終わってくれます

> (let ()
    (display "1 ") (display (get-first '(a b))) (newline)
    (display "2 ") (display (get-next (quote go))) (newline)
    (display "3 ") (display (get-next (quote go))) (newline))
1 a
2 b
3 ()

> 

結局、ジェネレータみたいなものを作ってみたということなんでしょうか
leaveがyield、fillがnextにあたりそうです
(使ったことないのでいいかげんなこと言ってますけどたぶん)

しかしleaveはなんとなくわかりますがfillってどういう意味でしょう
満たす、って感じじゃないんですが・・・

two-in-a-row*?の話はまたこんど

Scheme修行(10) 第19章 宝石泥棒

deepです

(define deep
  (lambda (m)
    (cond ((zero? m) (quote pizza))
          (else (cons (deep (sub1 m)) (quote ()))))))

(deep 6)としてやると((((((pizza))))))ができますが
((((((pizza))))))ではなく((((((mozzarella))))))を作るにはどうしたら
いいでしょうか

話の流れ上、引数にするだけじゃない?とは言ってはいけないようです
こうです

(define six-layers
  (lambda (p)
    (cons
     (cons
      (cons
       (cons
        (cons
         (cons p (quote ()))
         (quote ()))
        (quote ()))
       (quote ()))
      (quote ()))
     (quote ()))))

(deep 4)にあたるものはこれ

(define four-layers
  (lambda (p)
    (cons
     (cons
      (cons
       (cons p (quote ()))
       (quote ()))
      (quote ()))
     (quote ()))))

もっと簡単な方法はないですか。

そうですねえ

あります。

でも引数に持たせるだけではありません

13章の(letcc ...)を覚えていますか。
はい。
それが役に立ちます。
まだ(letcc ...)の全貌を見ていなかったという意味でしょうか。
半分も見ていません。

そうなんですか
こうです

(define toppings #f)
(define deepB
  (lambda (m)
    (cond ((zero? m)
           (let/cc jump
             (set! toppings jump)
             (quote pizza)))
          (else (cons (deepB (sub1 m)) (quote ()))))))

簡単なんでしょうか

let/ccを呼んでいますが、jumpは覚えておくだけで使われていません
実行してみましょう
toppings(つまりjump)を関数のように使います
(toppings A)を評価すると、あたかもlet/ccがAを返したかのような振りをして、
さらにlet/ccが評価された後の作業を繰り返します

> (deepB 6)
'((((((pizza))))))

> (toppings (quote mozzarella))
'((((((mozzarella))))))

> (toppings (quote cake))
'((((((cake))))))

> (toppings (quote pizza))
'((((((pizza))))))

こういうわけです
なるほど
簡単といえば簡単

では、

ケーキにもう一段を加えてみましょう。

> (cons (toppings (quote cake)) (quote ()))
'((((((cake))))))

きちんと動作しません。

そうですね

「(toppings m) を使うたびに、それは周りのすべてを忘れて、
ちょうど6段のカッコを加えます。

後でやろうとしていたこと(ここではcons)のことを完全に忘れて
let/ccが評価された後の作業(6段のカッコを加える)を始めてしまい、
その勢いでREPLにまで戻ってきてしまうということですね

うまく使えるんでしょうかこの機能・・・
心配になります
使えるんでしょうけど

第20の戒律
(letcc ...) を用いて作られた値を考えるに際しては、同等ではあるが
忘れない関数を書き記すべし。そのあと、それを使用する際には、
忘れることを覚えておくべし。

忘れない関数って何のことでしょうか
わかりません

ここで懐かしの&coの登場です

(define deep&co
  (lambda (m k)
    (cond ((zero? m) (k (quote pizza)))
          (else (deep&co (sub1 m)
                         (lambda (x) (k (cons x (quote ())))))))))

動きます

> (deep&co 0 (lambda (x) x))
'pizza

> (deep&co 6 (lambda (x) x))
'((((((pizza))))))

> (deep&co 2 (lambda (x) x))
'((pizza))

(deep&co 2 (lambda (x) x))を追いかけてみます

  (deep&co 2 (lambda (x) x))
= (deep&co 1 (lambda (x) (k (cons x (quote ())))))
   ※ kは(lambda (x) x)
= (deep&co 0 (lambda (x) (k (cons x (quote ())))))
   ※ kは(lambda (x) (k2 (cons x (quote ()))))
   ※ k2は(lambda (x) x)
= (deep&co 0 K) ※とおく
= (K (quote pizza))

式の置き換えがうまくいっているかどうかはこんな感じで確かめられます

> (let ((k2 (lambda (x) x)))
    (let ((k (lambda (x) (k2 (cons x (quote ()))))))
      (deep&co 0 (lambda (x) (k (cons x (quote ())))))))
'((pizza))

さらに続けると

k = (lambda (x) (k2 (cons x (quote ()))))
  = (lambda (x) ((lambda (x) x) (cons x (quote ()))))
  = (lambda (x) (cons x (quote ())))

K = (lambda (x) (k (cons x (quote ()))))
  = (lambda (x) ((lambda (x) (cons x (quote ()))) (cons x (quote ()))))
  = (lambda (x) (cons (cons x (quote ())) (quote ())))

(K (quote pizza)) = '((pizza))

となります
よく見るとKは次のtwo-layersと同じであることがわかります

(define two-layers
  (lambda (p)
    (cons
      (cons p (quote ()))
    (quote ()))))

deepからdeepBを作ったようにして、deep&coからdeep&coBを作ります

(define deep&coB
  (lambda (m k)
    (cond ((zero? m)
           (let ()
             (set! toppings k)
             (k (quote pizza))))
          (else
           (deep&coB (sub1 m)
                     (lambda (x) (k (cons x (quote ())))))))))

deepBと同じように使えます

> (deep&coB 2 (lambda (x) x))
'((pizza))

> (toppings (quote pizza))
'((pizza))

mが0のとき(set! toppings k)すること以外はdeep&coと同じです
(set! toppings k)するとtoppingsはさきほどのK、つまりtwo-layersになります
(deep&coB 6 (lambda (x) x))を評価すればsettingsはsix-layersに、
(deep&coB 4 (lambda (x) x))を評価すればsettingsはfour-layersになります

それはつまり、最後の収集子は、deepBの中で(letcc ...)によって作られたものと
同等な関数に関係しているということですか。

はい。最後の収集子は、(letcc ...)が作った値の影法師です。

手習いで収集子が出てきたとき、「継続」と呼ばれることもありますと書いてありましたが
実際どこまで同じなのか、ちょっともやっとした気分でした
基本的に同じものであることがわかってすっきりです

ただし今度はtoppingsの上にトッピングを積み重ねることができます

> (cons (toppings (quote cake)) (quote ()))
'(((cake)))

これが「忘れない関数」ということのようです
なぜこれを書き記すべきなのかは考えてもわかりませんでした