kb84tkhrのブログ

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

Scheme修行(4) 第14章 名前をつけましょう

やっとletがでてきます
letをletrecよりletccより後でとりあげたのはどういうことなんでしょう?

leftmost

一番左のアトムを探すleftmostです

(define leftmost
  (lambda (l)
    (cond ((atom? (car l)) (car l))
          (else (leftmost (car l))))))

これは引数に空リストを含まないことが前提になっているので
空リストを含んでいてもよいようにしてやります

(define leftmost2
  (lambda (l)
    (cond ((null? l) (quote ()))
          ((atom? (car l)) (car l))
          (else (cond
                  ((atom? (leftmost2 (car l)))
                   (leftmost2 (car l)))
                  (else (leftmost2 (cdr l))))))))

ちょっと見慣れない形かと思いましたが
よくみると第4の戒律の、S式のリストを扱う形です
(car l)の一番左がアトムだったら(cdr l)を評価してやる必要は
ないのでcondが二重になってますがそこに惑わされました

(null? l)だったときに()を返しているのは
たとえば#fを返すようにすると一番左のアトムが#fだった場合と区別がつかないからです
ちょっと訳がわかりづらかった・・・

condの中の((atom? (leftmost2 (car l))) (leftmost2 (car l)))
(leftmost2 (car l))を2回評価しているのがもったいないですね

そのような望ましくない繰り返しを防ぐために、(letrec ...)を用いてみましょう。

はい。でも、(letrec ...)で好きなものに名前をつけるのですか?

代わりに(let ...)を使います。

こう

(define leftmost3
  (lambda (l)
    (cond
      ((null? l) (quote ()))
      ((atom? (car l)) (car l))
      (else
       (let ((a (leftmost3 (car l))))
         (cond
           ((atom? a) a)
           (else (leftmost3 (cdr l)))))))))

わからないのはこれ

(letrec ...)と見かけは同じですが、(let ...)は式の値に名前をつけるのです。

letrecだって式の値に名前をつけてるんじゃないかと思います先生!
違いは名前の見えてるスコープだけのような気がするんですが
どういうことでしょうか

次はS式から最初に見つかったアトムだけを削除するrember1*を作ります
これはまあ練習です
(eqlist? (R (car l)) (car l))という条件はなんだろうと思いましたが
言い換えると「carにaが含まれていなければ」という意味ですね

第15の戒律(仮)
繰り返される式の値に名づくるには(let ...)を用うべし。

depth*

リストの深さを求めるdepth*です

(define depth*
  (lambda (l)
    (cond ((null? l) 1)
          ((atom? (car l)) (depth* (cdr l)))
          (else (cond ((> (depth* (cdr l))
                          (add1 (depth* (car l))))
                       (depth* (cdr l)))
                      (else
                       (add1 (depth* (car l)))))))))

(depth* (cdr l))(add1 (depth* (car l)))が2回ずつ出てきます

letで書きます

(define depth*2
  (lambda (l)
    (cond
      ((null? l) 1)
      ((atom? (car l)) (depth*2 (cdr l)))
      (else
       (let ((a (add1 (depth*2 (car l))))
             (d (depth*2 (cdr l))))
         (cond ((> d a) d)
               (else a)))))))

よく見るとまだ(depth* (cdr l))が2回出てきてます
こうすべきでしょうか?

(define depth*3
  (lambda (l)
    (cond
      ((null? l) 1)
      (else
       (let ((d (depth*3 (cdr l))))
         (cond
           ((atom? (car l)) d)
           (else
            (let ((a (add1 (depth*3 (car l)))))
              (cond
                ((> d a) d)
                (else a))))))))))

こうすると確かに(depth* (cdr l))を繰り返し書かなくてすむようになりましたが
(depth* (cdr l))を評価する回数は実は変わっていません
そのわりに、コードの方はcondletの入れ子で読みづらくなっています
ちょっとこれはやり過ぎだったようです

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

コード上に何回出てくるかよりも、実際に評価される回数を重視しましょうってことみたいです
DRY原則とはバランスの問題になるのかな

あと今になってifを紹介したり

それは賢いですね。もっと前に知っておくべきでした。

何事にも、ふさわしい時と場所があるのです。

今がその時?
なんで?

さらに関数maxを導入すると

(define depth*6
  (lambda (l)
    (cond
      ((null? l) 1)
      ((atom? (car l)) (depth*6 (cdr l)))
      (else
       (max (add1 (depth*6 (car l)))
            (depth*6 (cdr l)))))))

letが消えてしまいました
letでローカル変数を導入する代わりに関数の引数でも同じ働きができるわけですね
もともとlambdaですもんね

ついでにifも消えてぐっと見通しが良くなりました
ぱっと見でS式の再帰の形に見えますし
リファクタリング終了、って気分です
○○なら関数にする、みたいな戒律があってもよさそうな気分

leftmost(再)

leftmostではletを使うことにより同じ式を2回評価するという無駄を減らしましたが
まだ無駄があります

簡単なケースとして(leftmost '(((s))))を評価する場合
再帰を繰り返して'sにたどり着いた後、それにaという名前をつけ
aつまり'sはアトムなので'sを返す、ということを繰り返して値が求まります

1ステップずつ追うとこうです
関数名はlmと略記しました

(lm '(((s))))
(let ((a (lm '((s))))) (cond ...))
(let ((a (let ((a (lm '(s)))) (cond ...)))) (cond ...))
(let ((a (let ((a 's)) (cond ...)))) (cond ...))
(let ((a 's)) (cond ...))
's

答えは'sだとわかっているのにひとつずつ戻っていくのは無駄ですね
そこで、答えが求まったらすぐに値を返すようにします
letccを使います

こっちがこの章の本題なのかな?
いやでも「名前をつけましょう」だしなあ

こうかな・・・

(define leftmost5
  (lambda (l)
    (let/cc skip
      (letrec
          ((lm (lambda (l)
                 (cond
                   ((null? l) (quote ()))
                   ((atom? (car l)) (skip (car l)))
                   (else
                    (let ((a (lm (car l))))
                      (cond
                        ((atom? a) a)
                        (else (lm (cdr l))))))))))
        (lm l)))))

追うとこんな感じ

(leftmost5 '(((s))))
(let/cc skip (lm '(((s)))))
(let/cc skip (let ((a (lm '((s))))) (cond ...)))
(let/cc skip (let ((a (let ((a (lm '(s)))) (cond ...)))) (cond ...)))
(let/cc skip (let ((a (let ((a (skip 's))) (cond ...)))) (cond ...)))
's

終わりが速くなりました

・・・と思ったら、正解は違ってました!
そもそもaと名前を付ける必要もありませんでした
確かに

(define leftmost7
  (lambda (l)
    (let/cc skip
      (letrec
          ((lm (lambda (l)
                 (cond ((null? l) (quote ()))
                       ((atom? (car l)) (skip (car l)))
                       (else (let ()
                               (lm (car l))
                               (lm (cdr l))))))))
        (lm l)))))

動き方は同じようなものですがすっきりしました

(leftmost7 '(((s))))
(let/cc skip (lm '(((s)))))
(let/cc skip (let () (lm '((s))) (lm '())))
(let/cc skip (let () (let () (lm '(s)) (lm '())) (lm '())))
(let/cc skip (let () (let () (skip 's) (lm '())) (lm '())))
's

ループを途中で打ち切るような感じです
あ、letccをCで言うところのbreakみたいに使ったということですね

ところでletの中に複数の式が出てきました
Scheme手習いでは初

純粋に関数型のプログラムなら、複数の式を順番に実行する機能は必要ない
そんな風に考えていた時期が俺にもありました

じゃなくてそうですよね?
副作用がないということは関数の値しか使えるものがないのに
それを捨ててしまうということですから

ところがletccを使うと順番に実行する機能の使いでが発生する
letccを使ったプログラムは(いわゆる)関数型の範疇を飛び出してるってことになるんでしょうか
それまでにやろうとしてたことを忘れてしまうというのは副作用といえばこの上ない副作用ですしね
letccで得た継続の値を持ち出さない限り影響が外に及ぶことはなさそうですが

でも、手習いで出てた式の継続ならすっかり関数型の範疇内なはず
どういうことになるのかな

さてテキストの注にはlet ()の代わりにbeginとも書けるよ、と書いてありますが
実はそれも不要で、これで動きます

                       (else 
                        (lm (car l))
                        (lm (cdr l)))))))

condの後ろにはひとつしか式が書けないということにしておきたいんでしょうか
こだわりポイントが何なのかちょっとわかりません
動き方を同じように書こうとするとこんな風になると思いますが、正しさに少々不安が

(leftmost8 '(((s))))
(let/cc skip (lm '(((s)))) (lm '()))
(let/cc skip (lm '((s))) (lm '()) (lm '()))
(let/cc skip (lm '(s)) (lm '()) (lm '()) (lm '()))
(let/cc skip (skip 's) (lm '()) (lm '()) (lm '())))
's

そういう不安を起こさないように、ということかもしれません

Scheme修行(3) 第13章

第13章 ホップ、スキップ、ジャンプ

継続が出てきます

intersectall

題材はintersectallです

まずはintersectから

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

第12の戒律を使って書き換えます

(define intersect
  (lambda (set1 set2)
    (letrec
        ((I (lambda (set)
              (cond ((null? set) (quote ()))
                    ((member? (car set) set2)
                     (cons (car set) (I (cdr set))))
                    (else (I (cdr set)))))))
      (I set1))))

以前に書いたintersectallです

(define intersectall
  (lambda (lset)
    (cond ((null? (cdr lset)) (car lset))
          (else (intersect (car lset)
                           (intersectall (cdr lset)))))))

このバージョンは、lsetnull?でないという前提がありました
null?でもよいように書き換えます

(define intersectall
  (lambda (lset)
    (letrec
        ((A (lambda (lset)
              (cond ((null? (cdr lset)) (car lset))
                    (else (intersect (car lset)
                                     (A (cdr lset))))))))
      (cond ((null? lset) (quote ()))
            (else (A lset))))))

大したことをしたわけじゃないんですがね

lambdaとletrecの違い

これ(letrecのこと)は(lambda (x y) M)と似ていますよね。

はい、そうです。名前xyは、Mが何であろうと、Mの内部でのみ有効です。そして

(letrec ((x F) (y G)) M)

では、名前xyは、FGMが何であろうと、FGMの内部でのみ有効です。

FとかGの中でxやyが呼べるってのが大事なわけですから
lambdaやletではできません

letcc

(inersectall '((3 mangoes and) () (3 diet hamburgers))の値は
()になります
()との共通部分を取っているので当然ですが、intersectallは正直に全部を
intersectし続けます
()と出会ったらすぐ、今までやってきたことを放棄して()を返すようにします

というところでletccの登場です
ただし、Racketではletccではなくlet/ccになっています

(define intersectall
  (lambda (lset)
    (let/cc hop
      (letrec
          ((A (lambda (lset)
                (cond ((null? (car lset))
                       (hop (quote ())))
                      ((null? (cdr lset)) (car lset))
                      (else (intersect (car lset)
                                       (A (cdr lset))))))))
        (cond ((null? lset) (quote()))
              (else (A lset)))))))

Aの中で(null? (car lset))だった場合に(hop (quote ())を評価します
このとき何が起こるかというと

(letcc hopを通り過ぎた後、(hop M)に遭遇する前にすべきだったことを忘れなさい。そして、Mが何であっても、まるで(letcc hop M)の値を求めたかのようにふるまいなさい。

ということだそうです
この文章がいまひとつ飲み込めてなかったりします

  • (hop M)M(letcc hop M)Mは同じなの?
    コードと対応付けてみると(hop M)M(quote ())
    (letcc hop M)M(letrec ...)に見えます
    そうじゃないとすれば両方(quote ())ってことなんでしょうけど
  • (letcc hop M)の値を求めたかのようにふるまいなさいと言われても?
    値は何なんですか?
    Mなんでしょうけど
    それなら「まるで(letcc hop M)の値はMであるかのように」と書けば
    よさそうなものですが・・・

引っ掛かりはするものの、(letcc hop M)の値はMという理解で進みます
この評価が、実際に関数と同じ仕組みで行われているかはわかりませんが
同じように考えても問題はなさそうです

ひさしぶりに1ステップずつ評価を追ってみます
上の規則を踏まえるとこんな感じでしょうか

  (intersectall-c '((a b c) () (b e c)))
= (let/cc hop (A '((a b c) () (b e c))))
= (let/cc hop (intersect '(a b c) (A '(() (b e c)))))
= (let/cc hop (intersect '(a b c) (hop (quote ()))))
= (let/cc hop (quote ()))
= (quote ())

すぐに終わりました

Alonzo Church (1903-1995) ならこう書いたでしょう。

  :
  (call-with-current-continuation
    (lambda (hop)
  :

だそうですが
Churchさんはコンピュータもない時代に継続まで考えてたってことでしょうか?
どういう思考回路?と思いましたが
さらっと検索した感じだと別にChurchが継続を発明したというわけではなさそうです

とすると何が言いたかったのか?

第14の戒律
(letcc ...)を用いて、値を直ちに、すばやく返すべし。

ふむ

lset()が含まれていなくても、intersectした結果が()であれば
intersectallの結果も()になります
その場合もすぐに結果を返すようにしたいものです
intersectを内部関数にしてhopを共有できるようにし
intersectの処理から直接intersectallの結果を返すようにします

(define intersectall
  (lambda (lset)
    (let/cc hop
      (letrec
          ((A (lambda (lset)
                (cond ((null? (car lset))
                       (hop (quote ())))
                      ((null? (cdr lset)) (car lset))
                      (else (I (car lset) (A (cdr lset)))))))
           (I (lambda (set1 set2)
                (letrec
                    ((J (lambda (set1)
                          (cond ((null? set1) (quote ()))
                                ((member? (car set1) set2)
                                 (cons (car set1) (J (cdr set1))))
                                (else (J (cdr set1)))))))
                  (cond ((null? set2) (hop (quote ())))
                        (else (J set1)))))))
        (cond ((null? lset) (quote()))
              (else (A lset)))))))

実行の様子

  (intersectall '((a b) (c d) (e f) (g h)))
= (let/cc hop (A '((a b) (c d) (e f) (g h))))
= (let/cc hop (I '(a b) (A '((c d) (e f) (g h)))))
= (let/cc hop (I '(a b) (I '(c d) (A '((e f) (g h))))))
= (let/cc hop (I '(a b) (I '(c d) (I '(e f) (A '((g h)))))))
= (let/cc hop (I '(a b) (I '(c d) (I '(e f) '(g h)))))
= (let/cc hop (I '(a b) (I '(c d) '())))
= (let/cc hop (I '(a b) (hop (quote ()))))
= (let/cc hop (quote ()))
= (quote ())

こういうのが思ったとおりに動いているかどうかは、こういうテストではわかりませんね

(check-equal? (intersectall '((a b) (c d) (e f) (g h))) '())

なにかいい方法はあるんでしょうか

ファーストクラスの継続、と言うくらいですから内部関数にする代わりに
hopを渡すようにしても動くでしょうか?

(define intersect2
  (lambda (set1 set2 hop)
    (letrec
        ((I (lambda (set)
              (cond ((null? set) (quote ()))
                    ((member? (car set) set2)
                     (cons (car set) (I (cdr set))))
                    (else (I (cdr set)))))))
      (cond ((null? set2) (hop (quote ())))
            (else (I set1))))))

(define intersectall2
  (lambda (lset)
    (let/cc hop
      (letrec
          ((A (lambda (lset)
                (cond ((null? (car lset))
                       (hop (quote ())))
                      ((null? (cdr lset)) (car lset))
                      (else (intersect2 (car lset) (A (cdr lset)) hop))))))
        (cond ((null? lset) (quote()))
              (else (A lset)))))))

動きました

rember-beyond-first

つぎはremberをネタにします

remberletrecを使って書き換えます
次に、最初に見つけたアトムだけでなく、それ以降のアトムをすべて削除する、
rember-beyond-firstを作ります
これはremberを1行書き換えるだけで、letccは使わずに書くことができます
わざわざ取り上げることもなかったような気がしますが何か裏があるのでしょうか
5回読めばわかると思うので今は気にせずに進みます

my-rember-upto-last

こんどは最後に見つかるアトムとそれ以降のアトムのみを残す
rember-upto-lastを作ります
まずは自分で作ってみます
これはぱっと考えてもremberrember-beyond-firstよりも
複雑なやり方が必要そうです
普通に作るなら後ろから見ていくんでしょうかね
配列ならいいんですけどリストは後ろからたどるのってちょっと苦手なんですよね
ひっくり返して前から見ますか

(define reverse
  (letrec
      ((R (lambda (lat rev)
            (cond ((null? lat) rev)
                  (else (R (cdr lat) (cons (car lat) rev)))))))
    (lambda (lat) (R lat (quote ())))))

(define my-rember-upto-last
  (lambda (a lat)
    (letrec
        ((R (lambda (rlat result)
              (cond ((null? rlat) result)
                    ((eq? (car rlat) a) result)
                    (else (R (cdr rlat) (cons (car rlat) result)))))))
    (R (reverse lat) (quote ())))))

そういえばこのシリーズではこうやって結果を変数に蓄積していくやり方って出てきませんね
なにか邪道っぽいことなんでしょうか
この技なしでひっくり返そうとするとけっこうめんどくさそうなんですが

remember-upto-last

こんどはletccを使います
使うんだろうなあと思いつつも自力ではどう使うのかわかりませんでした

新しい版では、アトムaを見つけると、latの要素をみるのは止めませんが、そこまでに見たすべてのものを捨ててしまいます。

忘れるためにletccを使うんだろうということはわかるんですが

探し続けるけれども、結果にconsしようと舞っているアトムを無視するにはどうすればよいですか。

そうそう、アトムを見つけても「あとでconsする」が残ってると
multiremberになってしまうんですよねえ
というわけで答えです

(define rember-upto-last
  (lambda (a lat)
    (let/cc skip
      (letrec
          ((R (lambda (lat)
                (cond
                  ((null? lat) (quote ()))
                  ((eq? (car lat) a) (skip (R (cdr lat))))
                  (else (cons (car lat) (R (cdr lat))))))))
        (R lat)))))

なるほど
そうか脱出するだけじゃないんだ

追ってみます

  (rember-upto-last 'a '(b a c a d))
= (let/cc skip (R '(b a c a d)))
= (let/cc skip (cons 'b (R '(a c a d))))
= (let/cc skip (cons 'b (skip (R '(c a d)))))
= (let/cc skip (cons 'b (skip (cons 'c (R '(a d))))))
= (let/cc skip (cons 'b (skip (cons 'c (skip (R '(d)))))))
= (let/cc skip (cons 'b (skip (cons 'c (skip (cons 'd (R '())))))))
= (let/cc skip (cons 'b (skip (cons 'c (skip (cons 'd '()))))))
= (let/cc skip (cons 'b (skip (cons 'c (skip '(d))))))
= (let/cc skip '(d))
= '(d)

見事に忘れていますね

手習いで出てきた継続との関係

そういえばこの本では訳者まえがき以降「継続」っていう言葉は出てきてない気がしますが
(letcc hophopが「継続」のはず
手習いで出てきた「継続」(収集子とも言ってましたが)との関係が気になります
同じもののことを言ってるんでしょうか?

手習い風の継続を使ってrember-upto-lastを書いてみます

(define rember-upto-last&co
  (lambda (a lat)
    (letrec
        ((R (lambda (lat col)
              (cond
                ((null? lat) (col (quote ())))
                ((eq? (car lat) a)
                 (R (cdr lat) (lambda (x) x)))
                (else
                 (R (cdr lat) (lambda (x) (col (cons (car lat) x)))))))))
      (R lat (lambda (x) x)))))

ぴったり同じかというと微妙ですが、全体としては同じ構造で書けました
お前の仕事が終わったらこれやっとけよ、というのをcolに貯めていくわけですが
aが見つかった時、それまでに貯めたcolを一度忘れて
(lambda (x) x)にリセットしてしまうというのが(skip ...)に対応しています

今はそれだけですが、きっと先まで読めばわかるんじゃないでしょうか
13章はここでおしまい

Scheme修行(2) 第12章

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)))))))

multiremberlatを横断すると、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-f2eq?を渡してやります

(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))

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

(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-feq?を渡すと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-prefixscrambleはただの練習です

(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章

はじめに

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

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

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

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

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

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

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

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

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

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

そうですね

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

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

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

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

two-in-a-row?

ラットの中に同じ要素が続けて2回出てきたら#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?alatの先頭にあるかどうかを返す関数です
たぶんこれが、素直に書くとこうなるよねっていう例なのかと思われます

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

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

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

is-first-btwo-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)

普通のソースを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)))

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

関数の隠蔽

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

修正前

(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)))))

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

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

修正前

(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階層にすることにしました

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

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

終わり

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

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

でも、(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-DEFINEvalue上で動かします
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にバッククォートの処理が入ってないとダメかな?

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