kb84tkhrのブログ

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

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

動いたー!