kb84tkhrのブログ

何を書こうか考え中です あ、あと組織とは関係ないってやつです 個人的なやつ

Scheme修行(2) 第12章

seasonedschemer

multirember

第12章「避難しましょう」ではまずmultiremberを題材にします

(define multirember
  (lambda (a lat)
    (cond ((null? lat) (quote ()))
          ((eq? (car lat) a) (multirember a (cdr lat)))
          (else (cons (car lat) (multirember a (cdr lat)))))))

multiremberがlatを横断すると、aは変わりますか。

いいえ、aはいつもtunaを表しています。

それなら、aがずっとtunaを表していることを、自然な再帰のたびにmultiremberに思い出させる必要はないですよね。

はい。このような関数を読むときは、そのほうがとても助かります。

一理あると思いますが、助かるっていうのは人間が助かる話なんでしょうか
それともCPUが助かる？

Yを使って書くとこのようになります

(define multirember
  (lambda (a lat)
    ((Y
      (lambda (mr)
        (lambda (lat)
          (cond ((null? lat) (quote ()))
                ((eq? (car lat) a) (mr (cdr lat)))
                (else (cons (car lat) (mr (cdr lat))))))))
     lat)))

これを以下のように書くことができます

(define multirember-r
  (lambda (a lat)
    ((letrec
         ((mr (lambda (lat)
                (cond ((null? lat) (quote ()))
                      ((eq? (car lat) a) (mr (cdr lat)))
                      (else (cons (car lat) (mr (cdr lat))))))))
       mr)
     lat)))

(letrec ((mr ...)) mr)はmrという名前の再帰関数を定義して、その再帰関数を返しています
なんとなく冗長なことをやってる気がしないでもないですが
mrの定義の中でmr自身を呼べてしかもYと同等のことがわかりやすく書けます、といったところ

でも、欲しいのが再帰関数mrなら、なぜこうしないのですか。

(define mr
  (lambda (lat)
    (cond ((null? lat) (quote ()))
          ((eq? a (car lat)) (mr (cdr lat)))
          (else (cons (car lat) (mr (cdr lat)))))))

(define multirember-d
  (lambda (a lat) (mr lat)))

まあ普通にダメって感覚なんですが
聞きかじりの知識からすると、動的スコープな言語ならこれでも動いたりするんでしたっけ
Schemeは静的スコープの言語だから、ってことを言おうとしている？

こういう書き方もできます

(define multirember-r2
  (lambda (a lat)
    (letrec
        ((mr (lambda (lat)
               (cond ((null? lat) (quote ()))
                     ((eq? (car lat) a) (mr (cdr lat)))
                     (else (cons (car lat) (mr (cdr lat))))))))
      (mr lat))))

Scheme修行には出てこない書き方ですがこう書くこともできます

(define multirember-d
  (lambda (a lat)
    (define mr
      (lambda (lat)
        (cond ((null? lat) (quote ()))
              ((eq? a (car lat)) (mr (cdr lat)))
              (else (cons (car lat) (mr (cdr lat)))))))
    (mr lat)))

ほとんど同じなんですが
こちらではなくてletrecを使っているのは
コンピュータサイエンス的にletrecのほうが由緒正しい書き方とか？

Yよりはましです。

はげしく同意です

第12の戒律
再帰を適用している間に変化せぬ引数を除くにはletrecを用いるべし。

確かにaを渡さなくて済むようになりましたが、カッコが増えました
ムダが減っていることは確かなんですが、読みやすくなったんでしょうか？
戒律は、「変化せぬ引数を除け」とは言ってないので、読みやすくなるときだけ除けばいい？

これも「計算の性質」なのかなあ？

さらにmultirember

同一性判定の関数を引数に取るmultiremberを作ります

(define multirember-f
  (lambda (test?)
    (lambda (a l)
      (cond ((null? l) (quote ()))
            ((test? (car l) a) ((multirember-f test?) a (cdr l)))
            (else (cons (car l) ((multirember-f test?) a (cdr l))))))))

(multirember-f test?)の値は繰り返しの間変化しないので、letrecを使います

(define multirember-f2
  (lambda (test?)
    (letrec
        ((m-f
          (lambda (a l)
            (cond ((null? l) (quote ()))
                  ((test? (car l) a) (m-f a (cdr l)))
                  (else (cons (car l) (m-f a (cdr l))))))))
      m-f)))

multirember-f2にeq?を渡してやります

(define multirember-f3
  (letrec
      ((mr (lambda (a lat)
             (cond ((null? lat) (quote ()))
                   ((eq? (car lat) a) (mr a (cdr lat)))
                   (else (cons (car lat) (mr a (cdr lat))))))))
    mr))

さらにmrをmultiremberに変えます
いったい何をやっているんでしょうか

(define multirember-f4
  (letrec
      ((multirember
        (lambda (a lat)
          (cond ((null? lat) (quote ()))
                ((eq? (car lat) a) (multirember a (cdr lat)))
                (else (cons (car lat) (multirember a (cdr lat))))))))
    multirember))

このletrecは定義した関数をそのまま返しているだけですので取り除くことができます

(define multirember-f5
  (lambda (a lat)
    (cond ((null? lat) (quote ()))
          ((eq? (car lat) a) (multirember-f5 a (cdr lat)))
          (else (cons (car lat) (multirember-f5 a (cdr lat)))))))

おなじみのmultiremberに戻るでしょう。

multirember-fにeq?を渡すとmultiremberになることを論証してたということ？

rember-eq?は本当にremberですか。
そうです。でもちょっと待って下さい。あとでもう少し考えます。

の答えだった？
multiremberになってますが
謎

union

unionをいじります
これが原型

(define member?
  (lambda (a lat)
    (cond ((null? lat) #f)
          ((eq? (car lat) a) #t)
          (else (member? a (cdr lat))))))

(define union
  (lambda (set1 set2)
    (cond ((null? set1) set2)
          ((member? (car set1) set2) (union (cdr set1) set2))
          (else (cons (car set1) (union (cdr set1) set2))))))

繰り返しの間set2は変化しないのでletrecに入れます

(define union-r
  (lambda (set1 set2)
    (letrec
        ((U (lambda (set)
              (cond ((null? set) set2)
                    ((member? (car set) set2) (U (cdr set)))
                    (else (cons (car set) (U (cdr set))))))))
      (U set1))))

もしかしてmember?を誰かが変にいじってしまっても動くように、
自前でmember?を持つことにします
そんなの気にしないとか言わない

(define union-m
  (lambda (set1 set2)
    (letrec
        ((U (lambda (set)
              (cond ((null? set) set2)
                    ((M? (car set) set2) (U (cdr set)))
                    (else (cons (car set) (U (cdr set)))))))
         (M? (lambda (a lat)
               (cond ((null? lat) #f)
                     ((eq? (car lat) a) #t)
                     (else (M? a (cdr lat)))))))
      (U set1))))

これで終わりではありません
M?が変化しない引数を持っているので、letrecに入れてやります

(define union-m2
  (lambda (set1 set2)
    (letrec
        ((U (lambda (set)
              (cond ((null? set) set2)
                    ((M? (car set) set2) (U (cdr set)))
                    (else (cons (car set) (U (cdr set)))))))
         (M? (lambda (a lat)
               (letrec
                   ((N? (lambda (lat)
                          (cond ((null? lat) #f)
                                ((eq? (car lat) a) #t)
                                (else (N? (cdr lat)))))))
                 (N? lat)))))
      (U set1))))

ここまでやるかなあ？という気もしますが・・・
原型の方が読みやすい気がするし
チームで書くなら原型くらいにしておくかな、という気分
戒律が共有できていればいいですけど

DRY原則を崩してる気がするのもちょっと

第13の戒律
関数を隠し、守るには、(letrec ...)を用いるべし。

その関数からしか呼ばれない関数は隠すようにします
member?みたいなのは標準のライブラリ関数みたいなものなので
やっぱり別扱いなんだろうなあ

two-in-a-row?

さっきまでの調子でletrecを使うとこのようになります

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

しかし、よく見るとtwo-in-a-row-r?の変数をWで共有する必要はありません
ということでこうも書けます

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

不必要に変数が見えないので、こっちのほうがよりよい書き方なんでしょうね

もうあとのsum-of-prefixやscrambleはただの練習です

(define scramble-r
  (letrec
      ((P (lambda (tup rp)
            (cond ((null? tup) (quote ()))
                  (else (cons (pick (car tup)
                                    (cons (car tup) rp))
                              (P (cdr tup)
                                 (cons (car tup) rp))))))))
    (lambda (tup)
      (P tup (quote ())))))

12章のまとめ

  • 繰り返しの間変わらない変数はローカルな関数を定義して渡さないようにすることを覚えました
  • ローカルに関数を定義し、外部から隠すことを覚えました
  • 「避難しましょう」って何？

Scheme修行(1) はじめに ＆ 第11章

seasonedschemer book scheme

はじめに

「訳者まえがき」や「はじめに」はだいたいScheme手習いと似たようなことが書いてあるので
さらっといきます

継続(continuation)と代入(set!)という新たな概念を使用してプログラミングの幅を広げている

継続はともかくとして、代入なんて、と思ってると足元をすくわれそうな予感がします

リストはLispの心臓であるが、関数は魂

心臓と魂とではどっちが重要なんでしょうね

この本の目的は、読者に計算の性質について考えることを教えることにある

手習いでは「この本の目的は、読者に再帰的に考えることを教えることにある」と書いてありました
「計算の性質」とはなんでしょうか

この本を5回未満で読み切ろうとしないこと

手習いでは「この本を2回以下で読み切ろうとしないこと」
最後まで読むのを５回繰り返せと言っているんでしょうか
4回挫折してもいいから5回目まであきらめずに読め、って言っているんでしょうか

前の本からの繰り返しになるが、多くの例に食べ物が現れる。

そうですね

食べ物がちょっとした気晴らしになって、この本を一度にあまりたくさん読まないで済むことを願っている。

ちょっとずつ読んだほうがいいようです

第11章 おかえりなさい、ようこそショーへ

Scheme手習いが10章で終わっているので続きということですね

two-in-a-row?

ラットの中に同じ要素が続けて２回出てきたら#tを返す、two-in-a-row?を作ります

(define two-in-a-row?
  (lambda (lat)
    (cond ((null? lat) #f)
          ((is-first? (car lat) (cdr lat)) #t)
          (else (two-in-a-row? (cdr lat))))))

(define is-first?
  (lambda (a lat)
    (cond ((null? lat) #f)
          ((eq? (car lat) a) #t)
          (else #f))))

is-first?はaがlatの先頭にあるかどうかを返す関数です
たぶんこれが、素直に書くとこうなるよねっていう例なのかと思われます

(is-first?)が#fと答える場合が2通りあるのは本当ですか。
はい。latが空の時、または、リストの最初の要素がaではないときに#fを返します。

(null? lat)がtwo-in-a-row?とis-firstの両方で行われています
(cdr lat)がnull?でないことを確認した後、
(two-in-a-row? (cdr lat))の中でまた(cdr lat)がnull?でないことを
確認しますのでもったいないですね

(cdr lat)を2回やってるのももったいないです

テキストにはまずこういう修正版が出てきます

(define two-in-a-row?
  (lambda (lat)
    (cond ((null? lat) #f)
          (else (is-first-b? (car lat) (cdr lat))))))

(define is-first-b?
  (lambda (a lat)
    (cond ((null? lat) #f)
          (else (or (eq? (car lat) a)
                    (two-in-a-row? lat))))))

is-first-b?の意味合いが変わってしまいました
aがlatの先頭にあるかどうかだけでなく
こんどはtwo-in-a-row?を呼び出してlatの中にaが続けて現れるかも判定しています
ちょっと継続呼び出しみたいな雰囲気も漂わせます

これも動きますがlatが空であるというチェックは相変わらず重複しています
two-in-a-row?とis-firstが相互に再帰するようになったというところが
ちょっとおもしろいところではありますが、具体的に何かよくなったのかというと
そんな気はしません

ただの中間生成物なんでしょうか

is-first-bがtwo-in-a-row?を呼んだ後two-in-a-row?が何をするかといえば
無駄にlatが空かどうかをチェックしてis-first-bを呼んでいるだけです
ということは、is-first-b自身がis-first-bを呼べばいいんですね

(define two-in-a-row?
  (lambda (lat)
    (cond ((null? lat) #f)
          (else (is-first-b? (car lat) (cdr lat))))))

(define is-first-b?
  (lambda (a lat)
    (cond ((null? lat) #f)
          (else (or (eq? (car lat) a)
                    (is-first-b? (car lat) (cdr lat)))))))

しかしここで
is-first-b?がもはやis-first?よりもtwo-in-a-rowに近いことに気がついたので
名前を変えることにします

(define two-in-a-row?
  (lambda (lat)
    (cond ((null? lat) #f)
          (else (two-in-a-row-b? (car lat) (cdr lat))))))

(define two-in-a-row-b?
  (lambda (preceeding lat)
    (cond ((null? lat) #f)
          (else (or (eq? (car lat) preceeding)
                    (two-in-a-row-b? (car lat) (cdr lat)))))))

無駄なnull?やcdrがなくなりました
構造も最初の要素だけ特別扱いだよ、っていうことが素直にあらわれた感じです

two-in-a-row-b?の自然な再帰は何ですか。
自然な再帰は(two-in-a-row-b? (car lat) (cdr lat))です。
ちょっと変わっていますね。
はい。関数では第2の引数についてのみ質問しているのに、両方の引数が変わりますから。

あんまり意識してませんでしたが言われてみるとそういうのはなかったかもしれません

sum-of-prefixes

タップを引数に取り、タップの各要素までの和をリストにして返す関数sum-of-prefixesを作ります

(define sum-of-prefixes
  (lambda (tup)
    (cond ((null? tup) (quote ()))
          (else (sum-of-prefixes-b 0 tup)))))

;+はあることにする
(define sum-of-prefixes-b
  (lambda (sonssf tup)
    (cond ((null? tup) (quote ()))
          (else (cons (+ sonssf (car tup))
                      (sum-of-prefixes-b (+ sonssf (car tup))
                                         (cdr tup)))))))

どうやらこの章のテーマは過去の情報を引数で渡すということのようです
それは大事な概念なんでしょうか？
何かの前振り？

第11の戒律
ある関数が、その関数に対する他の引数がいかなるものか知る必要があるときは、付加的な引数を用いるべし。

おお、なるほど！という感じはあまりしません
理解が足りないんでしょうか
5回読んだらおおなるほどってなる？
訳がこなれてない感じもします
名訳だったらなるほどかっていうとそんな気もしませんが

scramble

次はscarambleという関数を作ります
自分では説明できないので引用します

関数scrambleは、どの数も自分の位置を示す番号より大きくない空でないタップを取って、同じ長さのタップを返します。
引数の中のそれぞれの数は、自分を起点としてタップを逆方向にさかのぼる数として扱われます。
各位置の結果は、その数のぶんだけ現在の位置から逆向きにたどることで見つけられます。

これはコード見たほうがわかりやすいかも・・・

(define scramble
  (lambda (tup)
    (scramble-b tup (quote ()))))

(define scramble-b
  (lambda (tup rev-pre)
    (cond ((null? tup) (quote ()))
          (else (cons (pick (car tup) (cons (car tup) rev-pre))
                      (scramble-b (cdr tup)
                                  (cons (car tup) rev-pre)))))))

戒律通りですね、という以外にあまり書くことがありません・・・

この章で著者は何を伝えたかったんでしょうか
「計算の性質」は出てきたんでしょうか
ちょっと変わった自然な再帰つまり第11の戒律のことを言えれば満足なのでしょうか
大事な技だとは思いますが

わかりません
タイトルを付けることができません

Scheme手習い(24) eval、またはvalue、またはmeaning(5)

littleschemer

普通のソースをdefineを使わないソースに変換する手法は
様々なシーンで役立つノウハウですのでまとめておきましょう（嘘

lambdaによる名前付け

defineによる定義は、lambdaによる名前付けに書き換えることができます

修正前

(define A (lambda (a) (aaaaa)))
(A aaa)

修正後

((lambda (A)
   (A aaa))
 ;Aの本体
 (lambda (a) (aaaaa)))

一律名前付けして使うより、適宜インライン展開して使った方がかえって見やすい場合も
あるかもしれませんが今回は全て元のまま名前付けしました

複数の関数

複数の関数を同時に名前付けすることが可能です
適宜グループにして同一の階層で定義し、階層が深くなり過ぎないようにします
ただし、互いに呼び出し関係にない場合に限ります
同時に定義すると、相手の関数がスコープにはいらないためです

修正前

(define A (lambda (a) (aaaaa)))
(define B (lambda (b) (bbbbb)))
(A (B bbb))

修正後

(lambda (A B)
  (A (B bbb))
  ;Aの本体
  (lambda (a) (aaaaa))
  ;Bの本体
  (lambda (b) (bbbbb)))

呼び出しの入れ子

呼び出し関係のある関数は、呼び出される関数が呼び出す関数のスコープ内に入るよう
呼び出される関数の名前付けを外側にし、呼び出す側の関数を内側で名前付けします

修正前

(define A (lambda (a) (B aaaaa)))
(define B (lambda (b) (bbbbb)))
(A aaa)

修正後

((lambda (B)
   ((lambda (A)
      (A aaa))
    ;Aの本体
    (lambda (a) (B aaaaa))))
   ;Bの本体
 (lambda (b) (bbbbb)))

原理上は呼び出し関係がない場合でも全て１関数ごとに入れ子にして問題ないはずですが
モニタの横幅と頭がついていけないものと思われます

関数の隠蔽

ある関数からのみ呼び出される関数は
呼び出す関数だけを囲むように名前付けしてやることにより
他の関数から隠ぺいすることができます。

修正前

(define A (lambda (a) (B aaaaa)))
(define B (lambda (b) (C bbbbb)))
(define C (lambda (c) (ccccc)))
(A (B bbb))

修正後

((lambda (B)
   ((lambda (A)
      (A aaa))
    ;Aの本体
    (lambda (a) (B aaaaa))))
 ;Bの本体
 ((lambda (C)
    (lambda (b) (C bbbbb)))
  ;Cの本体 B以外からは見えない
  (lambda (c) (ccccc))))

Bの本体は、Cを引数にとってBという関数を返す関数になっています
この技を使うと、全体の入れ子の深さを浅くできます。呼び出し関係を思い浮かべつつ階層を考えます
一般的なモジュール化やカプセル化と違って外に見せられる関数はひとつだけです
（何かいい工夫はないかな）

再帰する関数

再帰する関数はYを使って定義します

修正前

(define A (lambda (a) (A aaaaa)))
(A aaa)

修正後

((lambda (A)
   (A aaa))
 ;Aの本体
 (Y (lambda (A)
      (lambda (a) (A aaaaa)))))

複数の引数を持つ再帰関数

複数の引数を持つ再帰関数は１引数＋残りにカリー化します
呼び出し側もカリー化した呼び出し方にする必要があるので注意が必要です

修正前

(define A (lambda (a1 a2) (A aaaaa)))
(A aaa1 aaa2)

修正後

((lambda (A)
   ((A aaa1) aaa2))
 ;Aの本体
 (Y (lambda (A)
      (lambda (aaa1)
        (lambda (aaa2) (A aaaaa))))))

関数のラッピング

いちいちカリー化した形で呼び出すのが面倒な場合は
Yによる定義を直接使うのではなく、呼び出しやすい形式でラッピングすることも可能です

修正前

(define A (lambda (a1 a2) (A aaaaa)))
(A aaa1 aaa2)

修正後

((lambda (A)
   (A aaa1 aaa2))
 ;Aの本体
 ((lambda (A)
    (lambda (aaa1 aaa2) ((A aaa1) aaa2)))
  (Y (lambda (A)
       (lambda (aaa1)
         (lambda (aaa2) (A aaaaa)))))))

関数を返す関数を書くという点で、関数の隠蔽でやったことと似ています
valueの書き直しではlookup-in-tableでやってみました
修正前と同じ形で呼び出すことができるようになりますが
その分本体の定義部分が面倒になります
効果は正直微妙です

他の関数を経由した再帰

いくつかの関数を経由して再起する場合は、Yの本体の内側に、経由する関数を定義します
Yの外側で定義した関数からはYによって定義される関数を呼び出すことはできませんので

修正前

(define A (lambda (a) (B aaaaa)))
(define B (lambda (b) (C bbbbb)))
(define C (lambda (c) (A ccccc)))
(A aaa)

修正後

((lambda (A)
   (A aaa))
 ;Aの本体
 (Y (lambda (A)
      ((lambda (C)
         ((lambda (B)
            ;Aの本当の本体
            (lambda (a) (B aaaaa)))
          ;Bの本体
          (lambda (b) (C bbbbb))))
       ;Cの本体
       (lambda (c) (A ccccc))))))

valueの書き換え

valueの書き換えでは、呼び出し関係の図を見ながら末端の関数から定義していきました
始める前はどれだけ入れ子が深くなるかビビリ入ってましたが
やってみると関数のグループ化や隠蔽により心配するほどの入れ子にはなりませんでした
以下の4階層にすることにしました

  • 汎用ユーティリティ
    first、second、Yなど、valueに限らず利用される関数
  • value内で利用するユーティリティ
    text-of、lookup-in-tableなど、主にvalueで使うデータ構造にアクセスするための関数
  • 本体
    meaningの再帰に含まれる関数
  • value
    meaningを呼び出す関数を返すだけの関数

最大の難関はカッコの対応を合わせることだったりしました
最後の方では少し慣れましたが

終わり

これでscheme手習いが終わりました
次は何にするか少々迷うところではありましたが
自然なところで続編の「scheme修行」に進もうと思います

Scheme手習い(23) eval、またはvalue、またはmeaning(4)

littleschemer

でも、(define ...)はどうなのでしょう。

再帰はYコンビネータによって得られるので、必要はありません。

Yコンビネータによる変形を行うと、インタプリタ上でインタプリタを走らせることが可能であるということですか。

はい。でもそんなに悩まないでください。

やれっていってるんでしょうか。

むしゃくしゃしてやった
反省はしていない

defineなし版のvalueです

;value
((lambda (meaning) (lambda (e) ((meaning e) (quote ()))))
 ;meaning
 ((lambda (first second third build Y)
    ((lambda (text-of
              cond-lines-of question-of answer-of
              function-of arguments-of
              table-of formals-of body-of new-entry extend-table
              lookup-in-table)
       ;meaningの本体
       (Y (lambda (meaning)
            (lambda (e)
              (lambda (table)
                ((lambda (*const *quote *cond *identifier *lambda *application)
                   ((lambda (expression-to-action)
                      ((expression-to-action e) e table))
                    ;expression-to-action
                    ((lambda (atom-to-action list-to-action)
                       (lambda (e)
                         (cond ((atom? e) (atom-to-action e))
                               (else (list-to-action e)))))
                     ;atom-to-action
                     (lambda (e)
                       (cond ((number? e) *const)
                             ((eq? e #t) *const)
                             ((eq? e #f) *const)
                             ((eq? e (quote cons)) *const)
                             ((eq? e (quote car)) *const)
                             ((eq? e (quote cdr)) *const)
                             ((eq? e (quote null?)) *const)
                             ((eq? e (quote eq?)) *const)
                             ((eq? e (quote atom?)) *const)
                             ((eq? e (quote zero?)) *const)
                             ((eq? e (quote add1)) *const)
                             ((eq? e (quote sub1)) *const)
                             ((eq? e (quote number?)) *const)
                             (else *identifier)))
                     ;list-to-action
                     (lambda (e)
                       (cond ((atom? (car e))
                              (cond ((eq? (car e) (quote quote)) *quote)
                                    ((eq? (car e) (quote lambda)) *lambda)
                                    ((eq? (car e) (quote cond)) *cond)
                                    (else *application)))
                             (else *application))))))
                 ;*const
                 (lambda (e table)
                   (cond ((number? e) e)
                         ((eq? e #t) #t)
                         ((eq? e #f) #f)
                         (else (build (quote primitive) e))))
                 ;*quote
                 (lambda (e table) (text-of e))
                 
                 ;*cond
                 ((lambda (else?)
                    ((lambda (evcon)
                       (lambda (e table)
                         ((evcon (cond-lines-of e)) table)))
                     ;evcon
                     (Y (lambda (evcon)
                          (lambda (lines)
                            (lambda (table)
                              (cond
                                ((else? (question-of (car lines)))
                                 ((meaning (answer-of (car lines))) table))
                                (((meaning (question-of (car lines))) table)
                                 ((meaning (answer-of (car lines))) table))
                                (else ((evcon (cdr lines)) table)))))))))
                  ;else?
                  (lambda (x)
                    (cond ((atom? x) (eq? x (quote else)))
                          (else #f))))
                 
                 ;*identifier
                 ((lambda (initial-table)
                    (lambda (e table)
                      (lookup-in-table e table initial-table)))
                  (lambda (name) (car (quote ()))))
                 
                 ;*lambda
                 (lambda (e table)
                   (build (quote non-primitive) (cons table (cdr e))))
                 
                 ;*application
                 ((lambda (evlis ls-apply)
                    (lambda (e table)
                      (ls-apply ((meaning (function-of e)) table)
                                ((evlis (arguments-of e)) table))))
                  ;evlis
                  (Y (lambda (evlis)
                       (lambda (args)
                         (lambda (table)
                           (cond ((null? args) (quote ()))
                                 (else (cons ((meaning (car args)) table) 
                                             ((evlis (cdr args)) table))))))))
                  ;ls-apply
                  ((lambda (primitive? non-primitive? apply-primitive apply-closure)
                     (lambda (fun vals)
                       (cond ((primitive? fun) (apply-primitive (second fun) vals))
                             ((non-primitive? fun) (apply-closure (second fun) vals)))))
                   ;primitive? non-primitive?
                   (lambda (l) (eq? (first l) (quote primitive)))
                   (lambda (l) (eq? (first l) (quote non-primitive)))
                   ;apply-primitive
                   ((lambda (:atom?)
                      (lambda (name vals)
                        (cond ((eq? name (quote cons)) (cons (first vals) (second vals)))
                              ((eq? name (quote car)) (car (first vals)))
                              ((eq? name (quote cdr)) (cdr (first vals)))
                              ((eq? name (quote null?)) (null? (first vals)))
                              ((eq? name (quote eq?)) (eq? (first vals) (second vals)))
                              ((eq? name (quote atom?)) (:atom? (first vals)))
                              ((eq? name (quote zero?)) (zero? (first vals)))
                              ((eq? name (quote add1)) (add1 (first vals)))
                              ((eq? name (quote sub1)) (sub1 (first vals)))
                              ((eq? name (quote number?)) (number? (first vals))))))
                    ;:atom?
                    (lambda (x)
                      (cond
                        ((atom? x) #t)
                        ((null? x) #f)
                        ((eq? (car x) (quote primitive)) #t)
                        ((eq? (car x) (quote non-primitive)) #f)
                        (else #f))))
                   ;apply-closure
                   (lambda (closure vals)
                     ((meaning (body-of closure))
                      (extend-table (new-entry (formals-of closure) vals)
                                    (table-of closure))))))))))))
     ;text-of
     second
     
     ;cond-lines-of question-of answer-of
     cdr first second
     
     ;function-of arguments-of
     car cdr
     
     ;table-of formals-of body-of new-entry extend-table
     first second third build cons
     ;lookup-in-table
     ((lambda (lookup-in-entry-help)
        ((lambda (lookup-in-entry)
           ((lambda (lookup-in-table)
              (lambda (name table table-f) ((lookup-in-table name) table table-f)))
            ;lookup-in-table
            (Y (lambda (lookup-in-table)
                 (lambda (name)
                   (lambda (table table-f)
                     (cond ((null? table) (table-f name))
                           (else (lookup-in-entry 
                                  name (car table) 
                                  (lambda (name) 
                                    ((lookup-in-table name) (cdr table) table-f)))))))))))
         ;lookup-in-entry
         (lambda (name entry entry-f)
           ((lookup-in-entry-help name) (first entry) (second entry) entry-f))))
      ;lookup-in-entry-help
      (Y (lambda (lookup-in-entry-help)
           (lambda (name)
             (lambda (names values entry-f)
               (cond ((null? names) (entry-f name))
                     ((eq? (car names) name) (car values))
                     (else ((lookup-in-entry-help name) (cdr names) (cdr values) entry-f))))))))))
  
  ;first second third build
  (lambda (p) (car p))
  (lambda (p) (car (cdr p)))
  (lambda (p) (car (cdr (cdr p))))
  (lambda (a1 a2) (cons a1 (cons a2 (quote ()))))
  
  ;Y
  (lambda (le)
    ((lambda (f) (f f))
     (lambda (f) (le (lambda (x) ((f f) x))))))))

何度も書くのは長すぎるのでこの文字列をVALUE-NO-DEFINEと書くことにします
defineしたという意味ではなくて単なる文字列の置き換えです
実際動かすときには、長々と元のコードを書いています
まずは普通に動かします

(VALUE-NO-DEFINE
 ;(length '(a b c)
 (quote (((lambda (le)
           ((lambda (f) (f f))
            (lambda (f) (le (lambda (x) ((f f) x))))))
         (lambda (length)
           (lambda (l)
             (cond ((null? l) 0)
                   (else (add1 (length (cdr l))))))))
        (quote (a b c)))))
⇛ 3

動きました

次はVALUE-NO-DEFINEをvalue上で動かします
quoteの中に入ってますがVALUE-NO-DEFINEは上のコードに置き換えられるものと思ってください

(value
 (quote 
  (VALUE-NO-DEFINE
   ;(length '(a b c)
   (quote (((lambda (le)
              ((lambda (f) (f f))
               (lambda (f) (le (lambda (x) ((f f) x))))))
            (lambda (length)
              (lambda (l)
                (cond ((null? l) 0)
                      (else (add1 (length (cdr l))))))))
           (quote (a b c)))))))
⇛ 3

これも動きました

最後に、VALUE-NO-DEFINEの上でVALUE-NO-DEFINEを動かします
(valueの上で)

(value
 (quote 
  (VALUE-NO-DEFINE
   (quote 
    (VALUE-NO-DEFINE
     ;(length '(a b c)
     (quote (((lambda (le)
                ((lambda (f) (f f))
                 (lambda (f) (le (lambda (x) ((f f) x))))))
              (lambda (length)
                (lambda (l)
                  (cond ((null? l) 0)
                        (else (add1 (length (cdr l))))))))
             (quote (a b c)))))))))
⇛ 3

動きましたー

※ VALUE-NO-DEFINEが使ってあるコードは、実際に動くコードからココに書く用に
※ 手で修正したものなのでどこか間違ってるかもしれません

ほんとは「単なる文字列の置き換え」じゃなくて
quoteの代わりにバッククォートを使えば動くコードにできる気もしたんですけど
うまくいきませんでした
VALUE-NO-RETURNにバッククォートの処理が入ってないとダメかな？

バッククォートがよくわかってないのと
動かせただけでびっくりしてるくらいでデバッグとか不可能なレベルなんで
ちょっとあきらめ気味です

Scheme手習い(21) eval、またはvalue、またはmeaning(2)

littleschemer

いよいよ関数適用に入ります

(define function-of car)
(define arguments-of cdr)
(define *application
  (lambda (e table)
    (ls-apply (meaning (function-of e) table)
           (evlis (arguments-of e) table))))

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

リストのcarを評価して返された関数を、リストのcdrを評価して返された引数リストに適用します
applyという関数はすでに存在してて定義できないのでls-applyという名前にしてます

(define primitive?
  (lambda (l) (eq? (first l) (quote primitive))))
(define non-primitive?
  (lambda (l) (eq? (first l) (quote non-primitive))))
(define ls-apply
  (lambda (fun vals)
    (cond ((primitive? fun) (apply-primitive (second fun) vals))
          ((non-primitive? fun) (apply-closure (second fun) vals)))))

primitiveな関数だったらapply-primitiveを、
non-primitiveな関数であればapply-closureを呼びます
(second fun)は適用しようとしている関数、valsは引数リストです

まずはprimitiveな関数の処理から

(define apply-primitive
  (lambda (name vals)
    (cond ((eq? name (quote cons)) (cons (first vals) (second vals)))
          ((eq? name (quote car)) (car (first vals)))
          ((eq? name (quote cdr)) (cdr (first vals)))
          ((eq? name (quote null?)) (null? (first vals)))
          ((eq? name (quote eq?)) (eq? (first vals) (second vals)))
          ((eq? name (quote atom?)) (:atom? (first vals)))
          ((eq? name (quote zero?)) (zero? (first vals)))
          ((eq? name (quote add1)) (add1 (first vals)))
          ((eq? name (quote sub1)) (sub1 (first vals)))
          ((eq? name (quote number?)) (number? (first vals))))))

ほとんどの関数は対応する関数を呼んでいるだけです
atom?の処理だけ別の関数を呼んでいます

(define :atom?
  (lambda (x)
    (cond ((atom? x) #t)
          ((null? x) #f)
          ((eq? (car x) (quote primitive)) #t)
          ((eq? (car x) (quote non-primitive)) #f)
          (else #f))))

atomなはずのprimitiveな関数は、*constで(primitive <関数>)というリストに
置き換えられてしまっているためその場合分けをしています
non-primitiveな関数の判定はどう見ても不要ですがなにかを暗示しているんでしょうか
primitiveを判定したんだからnon-primitiveも、くらいの話？

> (value '(cons 1 (quote ())))
(1)
> (value '(add1 1))
2

動きました
condの例ももうちょっとそれっぽくすることができます

> (value '(cond ((null? (quote (a))) #f)
                (else #t)))
#t

ここからが本丸（自分がやりたい順に進めてます）
変数とλ式とクロージャを一気に導入します
ほぼ三位一体
まずは*lambdaから

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

なにかごたいそうなことをするのかと思ったらこれだけ
現時点のテーブルとλ式のcdrをリストにして取っておくだけです

だから(mk-length mk-length)を評価すると無限に評価が終わらないときでも
(lambda (x) ((mk-length mk-length) x))はすぐに評価が終わる、というわけです

> (value '(lambda (n) (add1 n)))
(non-primitive (() (n) (add1 n)))
> (value '(lambda (hoge) (hage hige)))
(non-primitive (() (hoge) (hage hige)))
> (value '(lambda (x) ((mk-length mk-length) x)))
(non-primitive (() (x) ((mk-length mk-length) x)))

mk-lengthが定義されている必要すらありません

ここで保存した、現時点のテーブルとλ式のcdr、つまり引数リストと関数本体を
まとめてクロージャと呼びます
(lambda ...)を評価するとクロージャが返されることになります

クロージャからテーブル、引数リスト、関数本体を取り出す関数を定義します

(define table-of first)
(define formals-of second)
(define body-of third)

（ここで使うためにthirdを定義してたのか）

次に、クロージャを評価する関数を用意します

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

クロージャを評価するには、以下のような処理を行います

  1. クロージャの引数リストと、引数の値のリストからエントリを作る
  2. 作ったエントリをクロージャのテーブルに追加する
  3. 追加してできたテーブルを利用してクロージャの本体部分を評価する

これでやっと識別子と値が結び付けられるようになりました
なぜテーブルでは名前と値のペアのリストを持つのではなく
名前のリストと値のリストのペアを持つようにするのか少し疑問でしたが
引数リストをそのまま使いたいからということのようです

識別子を評価するには単にテーブルを名前で検索するだけ
lookup-in-tableの出番です

(define *identifier
  (lambda (e table)
    (lookup-in-table e table initial-table)))

initial-tableは次のとおりです。

(define initial-table
  (lambda (name)
    (car (quote ()))))

どう見てもエラーです
ありがとうございました

いつ、これは使われますか。

テーブルを最後まで検索したけれども名前が見つからなかったときですね

使われないことを祈りましょう。どうしてだと思いますか？

valueで評価している式が誤っているから、ってことでいいんでしょうか

あえてエラーを起こすくらいしか評価を途中で止める方法がないので
何かエラーを起こす式を書いただけで
式には別に意味はない？

> (value '((lambda (n) (add1 x)) 1))
mcar: contract violation

たぶんエラーメッセージはRacket特有

さてそれはともかく、これで関数適用も動くようになりました
動きを追ってみます

  (value '((lambda (n) (add1 n)) 1))
= (meaning '((lambda (n) (add1 n)) 1) '())
= (*application '((lambda (n) (add1 n)) 1) '())
= (ls-apply (meaning '(lambda (n) (add1 n)) '()) (evlis '(1) '()))
= (ls-apply (meaning '(lambda (n) (add1 n)) '()) '(1))
= (ls-apply (*lambda '(lambda (n) (add1 n)) '()) '(1))
= (ls-apply '(non-primitive (() (n) (add1 n))) '(1))
= (apply-closure '(() (n) (add1 n)) '(1))
= (meaning '(add1 n) (extend-table '((n) (1)) '()))
= (meaning '(add1 n) '(((n) (1))))
= (*application '(add1 n) '(((n) (1))))
= (ls-apply (meaning 'add1 '(((n) (1)))) (evlis '(n) '(((n) (1)))))
= (ls-apply '(primitive add1) (evlis '(n) '(((n) (1)))))
= (ls-apply '(primitive add1) (cons (meaning 'n '(((n) (1)))) '()))
= (ls-apply '(primitive add1) (cons (*identifier 'n '(((n) (1)))) '()))
= (ls-apply '(primitive add1) (cons (lookup-in-table 'n '(((n) (1))) initial-table) '()))
= (ls-apply '(primitive add1) '(1))
= (apply-primitive 'add1 '(1))
= 2

もう少しテーブルを育ててみます

  (value '((lambda (x) ((lambda (y) (cons x y)) (quote ()))) 1))
= (meaning '((lambda (x) ((lambda (y) (cons x y)) (quote ()))) 1) '())
= (ls-apply (meaning '(lambda (x) ((lambda (y) (cons x y)) (quote ()))) '())
            (evlis '(1) '()))
= (ls-apply '(non-primitive (() (x) ((lambda (y) (cons x y)) (quote ()))))
            '(1))
= (meaning '((lambda (y) (cons x y)) (quote ())) '(((x) (1))))
= (ls-apply (meaning '(lambda (y) (cons x y)) '(((x) (1))))
            (evlis '((quote ())) '(((x) (1)))))
= (ls-apply '(non-primitive ((((x) (1))) (y) (cons x y))) '(()))
= (meaning '(cons x y) '(((y) (())) ((x) (1))))
= (ls-apply (meaning 'cons '(((y) (())) ((x) (1))))
            (evlis '(x y) '(((y) (())) ((x) (1)))))
= (ls-apply '(primitive cons) '(1 ()))
= (cons 1 '())
= '(1)

クロージャの説明抜きで出てきたコレも今なら説明がつくでしょうか

(define eq?-c
  (lambda (a)
    (lambda (x)
      (eq? x a))))
(define eq?-salad (eq?-c 'salad))

> (eq?-salad 'salad)
#t
> ((eq?-c 'salad) 'salad)
#t

ただしdefineがないので例によってlambdaで名前をつけます
eq-2?というのは、ふたつの要素が等しいかどうかを返す関数の引数のひとつに2を入れたもの
つまり引数が2と等しいかどうかを返す関数です

((lambda (eq-c?)
   ((lambda (eq-2?) 
     (eq-2? 2))
   (eq-c? 2)))
 (lambda (a)
   (lambda (x)
     (eq? x a))))

追いかけます

  (value '((lambda (eq-c?) ((lambda (eq-2?) (eq-2? 2)) (eq-c? 2)))
           (lambda (a) (lambda (x) (eq? x a)))))
= (meaning '((lambda (eq-c?) ((lambda (eq-2?) (eq-2? 2)) (eq-c? 2)))
             (lambda (a) (lambda (x) (eq? x a))))
           '())
= (meaning '((lambda (eq-2?) (eq-2? 2)) (eq-c? 2))
           '(((eq-c?) ((non-primitive (() (a) (lambda (x) (eq? x a))))))))
= (meaning '(eq-2? 2)
           '(((eq-2?) ((non-primitive ((((a) (2))) (x) (eq? x a)))))
             ((eq-c?) ((non-primitive (() (a) (lambda (x) (eq? x a))))))))
= (meaning '(eq? x a) '(((x) (2)) ((a) (2))))
= #t

eq-2?は(eq? x a)のaに2を入れたものであるということがそのまま表現されています
defineでいったんひとくぎり付くところはちょっと表現できてません
説明がついたかというと微妙

これで終わりですか。

はい。疲れました。

疲れました

でも、(define ...)はどうなのでしょう。

再帰はYコンビネータによって得られるので、必要はありません。

> (value
   '(((lambda (le)
        ((lambda (mk-length)
           (mk-length mk-length))
         (lambda (mk-length)
           (le (lambda (x)
                 ((mk-length mk-length) x))))))
      (lambda (length)
        (lambda (l)
          (cond ((null? l) 0)
                (else (add1 (length (cdr l))))))))
     '(1 2 3)))
⇛ 3

Yコンビネータによる変形を行うと、インタプリタ上でインタプリタを走らせることが可能であるということですか。

はい。でもそんなに悩まないでください。

やれっていってるんでしょうか

else

はい。もう宴会の時間です。

Scheme手習い(20) eval、またはvalue、またはmeaning

littleschemer

ついに最終章、ラスボス2です
小さいschemeの核にあたるもの、いわゆる？evalを作ります
でもこの本ではvalueっていう名前になってます
でもvalueは空っぽの環境を作るだけで実際の仕事の中心はmeaningという関数がやってます

ラスボス2と言っても、Yコンビネータみたいに何がなんだかわからないようなものではなく
ひとつひとつの関数はとてもシンプルで難しくはありません
そのかわり、たくさんの関数があるのでそれらの関連を理解する必要があります
あと、環境と呼ばれるデータ構造も

この本ではこれまでクロージャとか関数の評価方法とか説明が省かれていた部分がありますが
この章を理解すればあそこはそういうことだったのか、と納得できます
「この本では形式的な定義はしない」ので代わりにソース見ろということですね
「この本を2回以下で読み切ろうとしないこと」というのは
この章をクリアしたら２周目に突入してもう１回読め、ということを言っているのではないかと

いつもどおりなんの説明もなく始まります

エントリ(entry)とはリストのペアであり、その第1のリストが集合であるものです。

これがインタプリタの作り始めだと誰が思うでしょうかいや思いません
（知ってる人は別として）

エントリを扱うための関数を定義します

(define new-entry build)
(define lookup-in-entry
  (lambda (name entry entry-f)
    (lookup-in-entry-help name (first entry) (second entry) entry-f)))
(define lookup-in-entry-help
  (lambda (name names values entry-f)
    (cond ((null? names) (entry-f name))
          ((eq? (car names) name) (car values))
          (else (lookup-in-entry-help name (cdr names) (cdr values) entry-f)))))

buildは名前の集合と値のリストからエントリを作る関数、
lookup-in-entryはエントリ内で名前に対応する値を得る関数です
entry-fは名前を引数に取る関数で、名前が見つからない場合に呼ばれます
こういうのも継続っていうんでしょうか
違う気がしますけど何が違うかというとわかりません
やっぱり継続かもしれません

名前と値の対応をつけるなら、名前と値のペアを作ってそれをリストにするほうが
自然な気がしますが理由はあとでわかります
そもそもまだ何を作っているのかわかってませんし

テーブル（table、環境ともいう）とはエントリのリストだとします。

テーブルを扱うための関数を定義します

(define extend-table cons)
(define lookup-in-table
  (lambda (name table table-f)
    (cond ((null? table) (table-f name))
          (else (lookup-in-entry 
                 name (car table) 
                 (lambda (name) 
                   (lookup-in-table name (cdr table) table-f)))))))

extend-tableはテーブルにエントリを追加する関数、
lookup-in-tableはテーブルから名前に対応する値を得る関数です

extend-tableのシンプルさには度肝を抜かれる思いです
本気で言語書くときはもっといろいろくっつくのかな
エラー処理とか

table-fはやはり名前を引数に取る関数で、名前が見つからない場合に呼ばれます
entry-fはここで、テーブル内の次のエントリから名前を探すために使われています
そうやって使うのかー

知らないで「テーブルから値を探す関数を書け」と言われたら
そこをパラメータにしようとは考えず直接書いてしまいそうですけど

(define lookup-in-table2
  (lambda (name table)
    (cond ((null? table) #f)
          ((lookup-in-entry2 name (car table)))
          (else (lookup-in-table2 name (cdr table))))))
(define lookup-in-entry2
  (lambda (name entry)
    (lookup-in-entry-help2 name (first entry) (second entry))))
(define lookup-in-entry-help2
  (lambda (name names values)
    (cond ((null? names) #f)
          ((eq? (car names) name) (car values))
          (else (lookup-in-entry-help2 name (cdr names) (cdr values))))))

実は大きなごまかしをしてて、失敗すると#fを返すんですが、
ということは値が#fの場合と区別がつかなくなっています
見つかった値と成功／失敗と両方返せるとか、
例外があるとかならちゃんとしたものにできるんですけど

そういう方法がないから仕方なく失敗したときに呼ぶ関数を渡してます、ってことでしょうか？
それだけではなくて、何かもっといいことがあるような気がするんですが
パラメータにしておくと柔軟ではありそうですが柔軟性が役に立っているかな？

しばらくの間、ゴシック体で書いてあるところはプログラムそっくりだけど
valueという関数が扱うデータだよっていう話
ゲーデルの証明みたい

続いて、式のタイプを考えます。

  • 定数 *const ※組み込みの関数も含まれます
  • quote *quote
  • 識別子 *identifier
  • ラムダ式 *lambda
  • cond *cond
  • 関数適用 *application

式のタイプを返すexpression-to-actionを作ります
単にcondが並んでいるだけで難しくはありません
consとかcarとかの組み込み関数が*constとして扱われるのがちょっと意外でした
関数というくくりで見れば*lambdaにも近いような気がするんですが
関数へのポインタみたいなものと思えば確かに定数

タイプはそのタイプの式を評価する関数を兼ねていますので
式をexpression-to-actionに渡せば評価できます
(quote ())というのは環境です
最初はまだ覚えておくべき変数がないので環境はからっぽです

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

環境を扱う関数を定義して、
タイプを判別する関数を定義して、
式を評価する関数を定義するというトップダウンともボトムアップともとれない
不思議な順番には何か意味があるんでしょうか
わかりません

とりあえずガワができたので、少しずつ作っては動かすことができます
定義してない関数があっても、呼び出すまではエラーになりません
こういうときはありがたいです

(define *const
  (lambda (e table)
    (cond ((number? e) e)
          ((eq? e #t) #t)
          ((eq? e #f) #f)
          (else (build (quote primitive) e)))))

さっき気になった組み込み関数はここで(primitive hoge)という形になって
ちょっと別扱いになります
じゃあ*primitiveみたいなタイプ作ってもいいんじゃないかと

さて

> (value 1)
1
> (value #t)
#t
> (value 'cons)
(primitive cons)

やったー！
・・・という感じはまだしませんけどとりあえずインタプリタ動きました

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

eを見てほげほげすればいいんだな、ということがちょっと見えてきました

> (value '(quote abc))
abc

本文だとこの後*identifierと*lambdaを定義してから*condなんですが
*identifierと*lambdaだけあってもつまらないので先に*condやります

これまでより複雑ですが、ただリストをいじってるだけです

(define else?
  (lambda (x)
    (cond ((atom? x) (eq? x (quote else)))
          (else #f))))
(define question-of first)
(define answer-of second)
(define evcon
  (lambda (lines table)
    (cond
      ((else? (question-of (car lines)))
       (meaning (answer-of (car lines)) table))
      ((meaning (question-of (car lines)) table)
       (meaning (answer-of (car lines)) table))
      (else (evcon (cdr lines) table)))))
(define cond-lines-of cdr)
(define *cond
  (lambda (e table)
    (evcon (cond-lines-of e) table)))

(else #f)あたりにちょっと不自然さを感じます
(and (atom? x) (eq? x (quote else)))で済むはずですが
セルフで実行できるようにってことかな
（ここで定義するインタプリタはandを実装していないことからして）

> (value '(cond (#t 1)))
1
> (value '(cond (#f 1) (#t 2)))
2
> (value '(cond (#f 1) (else 2)))
2

動いてます
変数も関数もないのでかなり不自然なcondですが