kb84tkhrのブログ

何を書こうか考え中です

(妄想)「ならば」の教え方

数学ガール ゲーデル不完全性定理」で「僕」がユーリに「ならば」を教える場面があります

「ねえ、馬鹿にしてない?たとえば一番上の行は《Aが偽で、Bが偽だったら、A⇛Bは真》という意味でしょ」

うんうん
そこで「僕」が真理値表を使って教えてあげるんだけれども
どうもユーリはしぶしぶ納得、といった感じ
どうしてユーリに「わかった!」と言わせるまで書いてないんだろう

自分ならこうかなあ(おこがましMAX


ん?ああ「AならばB」ね
ちょっとわかりづらいよね
自分も最初意味わかんなかったよ
真理値表で書くとこうだね

A B AならばB

Aが真ならば、のほうはいいとして、偽ならば、ってほうがわかりづらいんだよね
でもいろいろ例を考えてみたら、どういうことかわかったよ

まずタネ明かししちゃうね
数学のひとは簡潔に書くのが好きだから「AならばB」とか「A⇛B」とか書いちゃうけど
すこし言葉を補ってみるよ
「AならばB」っていうのは「もしAが真ならばB」ってことだよね
Aが偽のときについては何も言ってないね
何も言ってないけど実はこういうことなんだよ

もしAが真ならばB
そうでなければ (Bが何だろうと気にしないで)真

どうだろう?
まだピンとこないかな?
そうだろうね

じゃあ、例を挙げて考えてみよう
「(Bが何だろうと気にしないで)真」の意味がわかると思うよ

じゃあまず、「x>3ならばx+2>3」っていうのを考えてみて
これは真?偽?
もちろん真だよね

この式は「xがいくつのときでも」成り立ってほしいと思うんだけどどうかな?
そうだよね

じゃあxに具体的な数字を入れてみるよ
たとえばx=4ならx+2=6>3で成り立つね
つまり真

これを「AならばB」と見てみよう
つまり、Aがx>3で、Bがx+2>3ってこと
x=4のときで考えると、Aは真、Bも真、「AならばB」も真になる
さっきの真理値表のとおりだね

今度は、x=0のときを考えてみよう
Aは偽、Bも偽だね
さてさっき、この式は「xがいくつのときでも」成り立ってほしい、って話したよね
つまりx=0のときでも「x>3ならばx+2>3」は真であってほしい、ってことだ
ということは
Aが偽、Bも偽のときも「AならばB」が真と決めたほうが都合がいいんだね

そんな都合で決めちゃっていいのかって?
それはどっちかというと反対だね
考えるやすくて便利なようにいろんな記号や考え方を作っちゃうのが数学では大事なんだよ

同じようなことだけど、つぎにx=2のときを考えてみよう
今度はAは偽だけどBは真だね
同じように考えて、Aが偽でBは真っていうときも「AならばB」は真とするのが自然だ

どうだろう?
Aが偽のとき、っていうのがイメージしづらかったと思うんだけど
具体的な例で考えてみたらイメージがつかめたんじゃないかな?

雰囲気で言っちゃうと
Aが偽ならBのことなんか気にしない(気にしないで真にしちゃう)
ってことなんだね

「AならばB」とまったく同じ意味を持つ式で
「AでないかまたはB」っていうのがある
こっちのほうが「Aが偽ならBのことなんか気にしない」っていう雰囲気が出てるかもね
同じ意味かどうかは真理値表書いてみればわかるから試してみて



わかった!と言ってもらえるかなあ

「Intro to App Development with Swift」

iBookに「Intro to App Development with Swift」という本があります
日本語版は「Swiftによるアプリケーション開発:入門編」です

Appleが自ら書いたSwiftによるiOSアプリ開発の入門書です
まったくプログラミングしたことのない中学生あたりがターゲットだと思われます

が、ただのプログラミング入門ではありません
やってることは簡単だけど教えようとしていることはけっこうまじめ

各章についてる「アプリ開発日誌」っていうコーナーを読むと
アプリ開発者の育成に対する本気度を感じます
製品をどうやって売ろうか、と思って考える範囲がそこまで広いことに驚き

日本語版も出たことだし無料ですのですぐ見てみることができます
ただし要Mac・要Xcode

さらに下の年齢層にはiPadアプリのSwift Playgroundがいいかも
こちらも日本語になりました
娘といっしょにちょっとやってみましたがなかなか食いつきがいいです
コードはやっぱり英語なんでちょっと親のサポートが必要な感じ
ところどころ関数名を入力するところがあって特に

#下の年齢層から始められるというだけで、上の年齢層にはつまらないと
#いうことはないかと

まじめ・本気を感じるなーってあたりのメモです
英語の方を読んでるので日本語版とは用語が合わないかも

内容 アプリ開発日誌
はじめに
  • テクノロジーは言語を持ち、それはコードと呼ばれる
  • コーディングは欠くことのできないスキルであり、創造的に問題を解決するのに役立つ
  • 誰にでも世界を変える何かを作る機会がある
  • アプリ開発日誌を書こう
  • この本を読み終わる頃にはあなたの作りたいアプリのプロトタイプができているはず
Lesson 1 Playground Basics
  • 今使っているアプリについて、どうしてそれを使っているのか考えてみよう
Lesson 2 Naming and Identifiers
  • プログラマーは問題を解決するために使える道具はなんでも使う
  • 定数
  • 上手に名前をつけることが大事
  • こんなアプリがあったらいいな、というリストを作ってみよう
  • 馬鹿げたアイデアでも書いておこう
  • 何度も見直そう
Lesson 3 Strings  
  • あなたが作ったアプリを使うのは誰?
  • App Storeを見て、どんな人向けのアプリなのか考えてみよう
Lesson 4 Hello, World!
  • 言語を学ぶときは世界にあいさつするのが伝統の儀式
  • ログはプログラムの動作を記録するもの
  • 「コンソール」アプリでほかのアプリが出力しているログを見てみよう
  • よいUXにはよいUIが必要
  • あなたの好きなアプリのUIについて考えてみよう
Lesson 5 First App
  • iOSアプリを作ってみる
  • Lesson 2でつくったリストを見直してみよう
  • どんな目的で、どんな問題を解決する?
  • アプリはInnovativeでDisruptiveでないといけない
Lesson 6 Functions
  • 関数はプログラムを形作るブロック
  • 複雑なことを単純に参照できるようにすることを抽象化という
  • プログラマーは同じことを繰り返し書かない
  • プログラマーは仕事のリストを短い複数のリストに分割する
  • 意味がある最小のかたまりを考える
  • 関数が何をするかわかっていれば、どうやってそれを行うかは知らなくてもよくなる
  • 共通の仕事を関数にしておけば、関数を修正するだけですべての呼び出しに反映される
  • アプリ宣言を書いてみよう
  • 私のアプリは○○します、なぜなら○○だからです
Lesson 7 Boogiebot
  • ある目的を果たすために誰かが作ってくれた関数の集まりをAPIという
  • 実行するステップを定めたものをアルゴリズムという
  • iPhoneiPadにはいろんな機能があるから、創造的な使い方を考えよう
  • Apple Developerのウェブサイトで調べてみよう
Lesson 8 Constants and Variables
  • 変数
  • 名前には、値が変わらないものと変わるものがある
  • 値が変わらないものは定数にしておけば安全
  • 今度は、アプリの機能を考えつくだけ挙げてみよう
  • 変なアイデアだと思っても全部書いておこう
Lesson 9 Types
  • 型をうまくつかうとプログラムの読み書きが容易になる
  • App Storeで似たアプリを探してみよう
  • 似たアプリのうちよいものを観察したり、レビューを読んだりしてヒントを探そう
Lesson 10 Parameters and Results
  • 複雑さを隠せることが関数のひとつの利点
  • Swiftでは、関数の名前はセンテンスになるようにつけることになっている
  • Human Interface Guidelineを読んで、アプリのUIについて考えてみよう
  • Keep it simple.
  • Be consistent.
Lesson 11 Making Decisions
  • if(やっと!)
  • 複雑な条件は関数にして名前をつけると理解しやすくなる
  • 第一印象は大事
  • どんなにすばらしいアプリも、アイコンがダサいとダウンロードしてもらえない
  • 起動したらログイン画面など出さずに即やりたいことができるように
  • はじめてのユーザにはチュートリアルでアプリのクールなところを見せる
Lesson 12 Instances, Methods and Properties
  • 型がメソッドとプロパティをまとめて複雑さを分割してくれる
  • ドキュメントを探して理解することはもっとも重要な技術のひとつ
  • あなたが考えたアプリの画面をいくつかノートに描いてみよう
  • 最初の画面は?どんなボタンが見えている?アイコンは?
  • やりたいことにたどりつくまでに何タップ必要?
  • 説明なしで機能を理解してもらうには?
Lesson 13 QuestionBot
  • できかけのアプリにコードを追加する形で、質問に答えるBotを作る
  • チームで開発していると思ってやってみよう
  • コメントやコードの構造、プロジェクトの構成が重要だということがわかるだろう
  • 関数が必要最小限のインタフェースを持ち、ひとつの機能だけを実行するようになっているのがよい
  • 関数をPlaygroundで試して、うまくいってからプロジェクトに追加してみよう
  • あなたのアプリを使うユーザをさらに具体化して考えてみよう
  • 何をしている人?何歳くらい?どうしてそのアプリを使っている?絵と文字、どちらが好き?
Lesson 14 Arrays and Loops
  • 配列にもミュータブルとイミュータブルがある
  • あなたのユーザに合うひとを探してプロトタイプを人に見せてみよう
  • 画面をカードに描き直して、アプリを使う代わりにカードをめくってもらう
  • フィードバックをもらって記録しよう
Lesson 15 Defining Structures
  • 必要なデータに合った構造を設計すれば、アプリを作るための部品が手に入る
  • アプリが扱う型の集まりをモデルという
  • Structを使ってデータに合った新しい型を自分で定義しよう
  • Structにもミュータブルとイミュータブルがある
  • あなたのアプリは開発する価値があるだろうか
  • 価値ありと思ったらフィードバックをもとに改善を考えよう
  • 残念ながら価値なしと思ったらアイデアリストに戻ろう
Lesson 16 Questionbot 2
  • Model, View, Controller
  • 本物のデバイス上でプロトタイプを作ろう
  • Keynoteを使えばモックアップが作れる
  • ユーザの使い方を観察して改善を繰り返そう
  • 指で隠れるとか、ボタンが小さすぎるとか
Lesson 17 Actions and Outlets
  • Color Pickerのアプリを一から作る
  • Interface Builderを使ってUIを作りコードと結びつける
  • UIを改善する
  • 今度は、ユーザに質問するのではなくユーザを観察してみよう
  • どこで混乱して、どこを楽しんでいる?
Lesson 18 Adaptive User Interface
  • デザインして、フィードバックをもらい、改善するというサイクルを繰り返す
Lesson 19 Enumerations and Switch
  • Enumをうまく使えばコードは読みやすく書きやすくなる
  • iOSには障害を持つひとのために多くのアクセシビリティ機能を持つ
  • より多くのユーザに使ってもらえるよう、これらの機能をうまく組み込もう
Lesson 20 Final Project
  • 最後のプロジェクト
  • 完成が近づいたら、アプリのアイコンとタイトルを考えよう
  • 日誌を読み返し、キーワードやビジュアルを手がかりにしよう
  • UIと同じように、アイコンやタイトルもほかの人に見てもらってフィードバック・改善を繰り返そう
Lesson 21 What's Next?
  • どんなアプリなら今のスキルで作れるだろうか?
  • この本を見ないで同じアプリを作ってみよう
  • これまでに作ったアプリを改造してみよう
  • すぐに始めて、アプリを作り続けよう
  • 学び続けよう

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!で前回の値を覚えてそうな気がします