align

うーん、問答についていけなくなった。

順を追っていこう。
まずは関数 shift。これは、ペアのペアを引数にとって、ペアの第1要素の第2要素を、ペアの第2要素に移し変える(ややこしいな)。

(use mymodule)

(define shift
  (lambda (pair)
    (build (first (first pair)) (build (second (first pair)) (second pair)))))

(print (shift '((a b) c)))
(print (shift '((a b) (c d))))
^o^ > gosh -I. shift.scm
(a (b c))
(a (b (c d)))

うん、ここまではOK。
次、align。この関数は、

  1. 引数がアトムならそのまま返す。
  2. 引数の第1要素がペアなら、shift して再帰する。
  3. そうでなければ、第1要素と、第2要素について再帰したものでペアを作る。
(use mymodule)

(define shift
  (lambda (pair)
    (build (first (first pair)) (build (second (first pair)) (second pair)))))

(define align
  (lambda (para)
    (cond
      ((atom? para) para)
      ((a-pair? (first para))
        (align (shift para)))
      (else
        (build (first para) (align (second para)))))))

(print (align 'a))
(print (align '(a (b c d))))
(print (align '((a b) (c d))))
(print (align '((a b c) (d e f))))
^o^ > gosh -I. align.scm
a
(a (b c))
(a (b (c d)))
((a b c) (d e))

まだ大丈夫、これもわかる。
この align は前回のエントリに出てきた keep-looking と共通するところがあって、それはどちらの関数も引数を変更して再帰するけど、その変更によってゴールに近づいている保証がないことだそう。
ここで問答は aling の cond の2つ目の行に注目する。(arign (shift para)) というふうに再帰しているけど、その引数はもとの引数の一部ではなく、第7の戒律に反しているという。確かに shift はペアの要素を並べ替えるだけなので、一部ではない。言い換えると新たな引数にはもとの引数と同じ数のアトムが含まれている。

(use mymodule)

(define shift
  (lambda (pair)
    (build (first (first pair)) (build (second (first pair)) (second pair)))))

(define length*
  (lambda (para)
    (cond
      ((atom? para) 1)
      (else (o+ (length* (first para)) (length* (second para)))))))

(print (length* '((a b) c)))
(print (length* (shift '((a b) c))))
^o^ > gosh -I. length_star.scm
3
3

まあ、確かめるまでもなく同じになる。

さて、わからなくなるのはここからだ。align を再帰する際に、ペアの第1要素はより簡単になっているけど第2要素はより複雑になっているという。確かに shift によってそうなっている。だけど、「引数の長さを決めるのに length* は間違った関数ではないでしょうか。」「もっとよい関数では、第1要素にもっと注意を払わなければいけません。」とはどういうことだろう。「少なくとも2ばいは必要です。」とは?
もっとよい関数として weight* が出てくる。

(use mymodule)

(define shift
  (lambda (pair)
    (build (first (first pair)) (build (second (first pair)) (second pair)))))

(define weight*
  (lambda (pora)
    (cond
      ((atom? pora) 1)
      (else (o+ (o* (weight* (first pora)) 2) (weight* (second pora)))))))

(print (weight* '((a b) c)))
(print (weight* (shift '((a b) c))))
^o^ > gosh -I. weight_star.scm
7
5

weight* の動作自体はわかる。第1要素の数に2を書けることによって重み付けをしている。結果、shift するとアトムが第1要素から第2要素に移動する分だけ値が小さくなるわけだ。
で、これがなぜ次の問答につながるのかがわからない。
「align は部分関数ですか。」「いいえ。すべての引数に対して値を持ちます。」

うーん、誰か解説してほしい・・・・・・

全関数と部分関数

今日から9章。
次のような関数 looking が出てきた。

(use mymodule)

(define pick
  (lambda (n lat)
    (cond
      ((zero? (sub1 n)) (car lat))
      (else (pick (sub1 n) (cdr lat))))))

(define keep-looking
  (lambda (a sorn lat)
    (cond
      ((number? sorn) (keep-looking a (pick sorn lat) lat))
      (else (eq? sorn a)))))

(define looking
  (lambda (a lat)
    (keep-looking a (pick 1 lat) lat)))

(print (looking 'caviar '(6 2 4 caviar 5 7 3)))
(print (looking 'caviar '(6 2 grits caviar 5 7 3)))

この関数 looking は次のように動作する。まず、引数 lat の1番目の要素を見て、それが数 n なら今度はn番目の要素を見る。そしてそれが数ならまた同じように繰り返す。最終的に数でないアトムに行き当たったとき、それが引数 a と eq? なら #t、そうでないなら #f を返す。
実行してみよう。

^o^ > gosh -I. looking.scm
#t
#f

最初の例では、6 → 7 → 3 → 4 → caviar となって無事 caviar が見つかるので #t が返っている。一方、2つ目の例では、6 → 7 → 3 → grits となって caviar が見つからないので #f が返っている。
動作そのもの以外に注目するところがある。今まで出てきた関数はすべて lat の部分に対して再帰してきた。ところが looking は lat そのものに対して再帰している。これを不自然な再帰というらしい。

さて、この looking はどんなときにも答を返すだろうか。上の2つの例ではどちらも答が返っているが、たとえば、(looking 'caviar '(7 1 2 caviar 5 6 3)) がどうやって動くか見てみると、
7 → 3 → 2 → 1 → 7 → 3 → 2 → 1 → 7 → … となって数でないアトムにたどり着かない。言い換えると looking は停止しない。これはプログラムの停止性の問題だ。どうやら9章のテーマはこれらしい。

さて、この looking のような関数を「部分関数」、今まで出てきたような関数を「全関数」というらしい。
次に eternity という関数が出てきた。

(define eternity
  (lambda (x)
    (eternity x)))

この関数はどんな引数が与えられても停止しない。eternity は最も部分的な関数だと書いてある。

うーん、9章にはいって難しげになってきた。

継続(continuation)の練習

8章では収集子関数といっていたけど、「継続(continuation)」というほうが一般的みたいだ。この、継続を関数として再帰するスタイルを「継続渡しスタイル(Continuation Passing Style、CPS)と呼ぶみたい。
で、簡単な例で練習。この関数 evens-and-odds は、与えられた数のリストから、偶数だけのリストと奇数だけのリストを作る。最後に friend がリストのペアにして返している。

(define evens-and-odds
  (lambda (l co)
    (cond
      ((null? l) (co (quote ()) (quote ())))
      ((even? (car l)) (evens-and-odds (cdr l)
        (lambda (e o) (co (cons (car l) e) o))))
      (else (evens-and-odds (cdr l) (lambda (e o) (co e (cons (car l) o))))))))

(define friend
  (lambda (x y)
    (cons x (cons y (quote ())))))

(print (evens-and-odds '(1 2 3 4 5 6 7 8 9 10) friend))
^o^ > gosh evens-and-odds.scm
((2 4 6 8 10) (1 3 5 7 9))

うん、うまくいった。

evens-only*&co

evens-only*

関数 evens-only* は入れ子になった数のリストからすべての奇数を削除する。「簡単な練習でしょう」なんて書いてあるので、今度も答を見ないで書いてみる。ちなみに、偶数であることを判定する even? の定義は質問の中で提示されている。

(use mymodule)

(define even?
  (lambda (n)
    (o= (o* (o/ n 2) 2) n)))

(define evens-only*
  (lambda (l)
    (cond
      ((null? l) (quote ()))
      ((atom? (car l))
        (cond
          ((even? (car l)) (cons (car l) (evens-only* (cdr l))))
          (else (evens-only* (cdr l)))))
      (else
        (cons (evens-only* (car l)) (evens-only* (cdr l)))))))

(print (evens-only* '((9 1 2 8) 3 10 ((9 9) 7 6) 2)))
^o^ > gosh -I. evens-only_star.scm
((2 8) 10 (() 6) 2)

うん、簡単。

evens-only*&co

こっちが本題。関数 evens-only*&co は、引数から奇数を削除して偶数だけの入れ子のリストを作る一方、同時に引数中の偶数の積と奇数の和を計算する関数。概要が示されているので、それをもとに書いてみよう・・・・・・と思ったけど、最後の else の再帰をどうすればわからなくて、結局答を見て写経した。

(use mymodule)

(define even?
  (lambda (n)
    (o= (o* (o/ n 2) 2) n)))

(define evens-only*&co
  (lambda (l col)
    (cond
      ((null? l) (col (quote ()) 1 0))
      ((atom? (car l))
        (cond
          ((even? (car l)) (evens-only*&co (cdr l)
            (lambda (newl p s) (col (cons (car l) newl) (o* (car l) p) s))))
          (else (evens-only*&co (cdr l)
            (lambda (newl p s) (col newl p (o+ (car l) s)))))))
      (else
        (evens-only*&co (car l)
          (lambda (al ap as)
            (evens-only*&co (cdr l)
              (lambda (dl dp ds)
                (col (cons al dl) (o* ap dp) (o+ as ds))))))))))

(define the-last-friend
  (lambda (newl product sum)
  (cons sum (cons product newl))))

(print (evens-only*&co '((9 1 2 8) 3 10 ((9 9) 7 6) 2) the-last-friend))

最後の else の再帰は、まず (car l) について evens-only*&co を再帰してその収集子の中でさらに (cdr l) について再帰している。(car l) についての収集子の引数 al、ap、ps は (car l) のなかの偶数のリスト、偶数の積、奇数の和。それから (cdr l) についての収集子の引数 dl、dp、ds は (cdr l) のなかの偶数のリスト、偶数の積、奇数の和だ。そして最後にリストは cons、積は o*、和は o+ をそれぞれ適用しているわけだ。ああ、なんてややこしいんだ。

実行結果:

^o^ > gosh -I. evens-only_star_and_co.scm
(38 1920 (2 8) 10 (() 6) 2)

はあ、なんとかできた。
これで8章も終わり。

multiinsertLR&co

multiinsertLR

関数 multiinsertLR は lat の中の oldL の左と oldR の右に new を挿入する。

(define multiinsertLR
  (lambda (new oldL oldR lat)
    (cond
      ((null? lat) (quote ()))
      ((eq? (car lat) oldL)
        (cons new (cons oldL (multiinsertLR new oldL oldR (cdr lat)))))
      ((eq? (car lat) oldR)
        (cons oldR (cons new (multiinsertLR new oldL oldR (cdr lat)))))
      (else
        (cons (car lat) (multiinsertLR new oldL oldR (cdr lat)))))))

(print (multiinsertLR 'salty 'fish 'chips '(chips and fish or fish and chips)))
^o^ > gosh multiinsertLR.scm
(chips salty and salty fish or salty fish and chips salty)

うん、うまくいってる。

multiinsertLR&co

さて、ここからが本題。multirember に対応する multirember&co のように、multiinsertLR に対応する multiinsertLR&co を書け、ときた。ようするに、引数を1つ多くとり、それは収集子(関数)だってことだ。で、multiinsertLR&co が実行されると、新たなラット、左挿入の回数、右挿入の回数を引数として収集子 col を呼び出す。
よし、挑戦してみよう。

(use mymodule)

(define multiinsertLR&co
  (lambda (new oldL oldR lat col)
    (cond
      ((null? lat) (col (quote ()) 0 0))
      ((eq? (car lat) oldL)
        (multiinsertLR&co new oldL oldR (cdr lat)
          (lambda (newlat l r) (col (cons new (cons oldL newlat)) (add1 l) r))))
      ((eq? (car lat) oldR)
        (multiinsertLR&co new oldL oldR (cdr lat)
          (lambda (newlat l r) (col (cons oldR (cons new newlat)) l (add1 r)))))
      (else
        (multiinsertLR&co new oldL oldR (cdr lat)
          (lambda (newlat l r) (col (cons (car lat) newlat) l r)))))))

(define result
  (lambda (lat l r)
    (list lat l r)))

(print (multiinsertLR&co 'salty 'fish 'chips '(chips and fish or fish and chips) result))

今回、col の具体的な実装は出てこないので、収集した結果(新しいラット、左挿入の回数、右挿入の回数)をリストにして返す result を収集子にしてみた。

^o^ > gosh -I. multiinsertLR_and_co.scm
((chips salty and salty fish or salty fish and chips salty) 2 2)

うまくいった!

multirember&co

こんな関数が出てきた。

(define multirember&co
  (lambda (a lat col)
    (cond
      ((null? lat) (col (quote ()) (quote ())))
      ((eq? (car lat) a)
        (multirember&co a (cdr lat)
          (lambda (newlat seen) (col newlat (cons (car lat) seen)))))
      (else
        (multirember&co a (cdr lat)
          (lambda (newlat seen) (col (cons (car lat) newlat) seen)))))))

これはかなり複雑だ。
基本的には multirember と同じような形をしているけど、引数がひとつ多い。 a はアトム、lat はラット、で、col は何かの関数らしい。
それから、(eq? (car lat) a) のときも else のときも (cdr lat) で再帰している。しかもそれぞれ新しい関数を作っている。

じっくりいこう。

col の簡単な例が出てきた。

(define a-friend
  (lambda (x y)
    (null? y)))

2つの引数をとり、1つ目は単に無視して2つ目が null? かどうかを返している。

で、この関数を使ってまずは簡単な例、(multirember&co 'tuna '() a-friend) の値を求めてみよう。この場合、lat が空リストなので、cond の最初の条件に当てはまる。ということはその値は (col (quote ()) (quote ())) で、いま col は a-friend なので値は #t になる。

次は、もうちょっと難しい例、(multirember&co 'tuna '(tuna) a-friend) の値を求めてみよう。今度は、(eq? (car lat) a) (ここで a は tuna、lat は (tuna))なので、cond の2番目の値になる。そして (cdr lat) と新しい関数 (lambda (newlat seen) (col newlat (cons (car lat) seen))) に対して再帰している。この関数は multirember&co の引数 col に当たるもので、col とは collector (収集子)の短縮形だそうだ(収集子は「continuation(継続)」とも呼ばれる)。
この新しい関数(収集子)に名前をつけてやったほうがわかり易い。new-friend としよう。このとき col は a-friend、(car lat) は tuna なので、new-friend は次のようになる。

(define new-friend
  (lambda (newlat seen)
    (a-frined newlat (cons 'tuna seen))))

この関数を使って、multirember&co の再帰部分を書くと、(multirember&co 'tuna '() new-friend) となる。
そうすると今度は (null? lat) (ここで lat は ‘())なので、値は (new-friend (quote ()) (quote ())) となり、new-friend の定義より (a-friend (quote ()) (cons 'tuna (quote ())))、つまり #f だ(2番目の引数が空リストじゃないから)。

さらに難しい例、(multirember&co 'tuna '(and tuna) a-friend) の値を求めてみよう。今度は、cond の3番目の条件に当てはまり、また別の収集子で再帰する。この収集子の名前を latest-friend とすれば次のようになる。

(define latest-friend
  (lambda (newlat seen)
    (a-friend (cons 'and newlat) seen))))

すると、再帰は (multirember&co 'tuna '(tuna) latest-friend) となり、cond の2番目の条件でさらに (multirember&co 'tuna '() (lambda (newlat seen) (latest-friend newlat (cons 'tuna seen)))) で再帰する。
最後は cond の最初の条件の値 ((lambda (newlat seen) (latest-friend newlat (cons 'tuna seen))) (quote ()) (quote ())) に行き当たる。
さあ、今度は逆にさかのぼろう。最後の関数適用の値は (latest-friend (quote ()) ‘(tuna)) だ。さらにさかのぼると (a-friend ‘(and) ‘(tuna)) となり、最終的な値は #f になる。

結局、(multirember&co a lat col) がどんな関数かというと、lat をすべて検索して、a と eq? であるアトムを最初のリスト l1 に、eq? でないアトムを2番目のリスト l2 に収集子、最後に (col l1 l2) の値を返す関数、ということができる。

試してみよう。

(define multirember&co
  (lambda (a lat col)
    (cond
      ((null? lat) (col (quote ()) (quote ())))
      ((eq? (car lat) a)
        (multirember&co a (cdr lat)
          (lambda (newlat seen) (col newlat (cons (car lat) seen)))))
      (else
        (multirember&co a (cdr lat)
          (lambda (newlat seen) (col (cons (car lat) newlat) seen)))))))

(define a-friend
  (lambda (x y)
    (null? y)))

(print (multirember&co 'tuna '() a-friend))
(print (multirember&co 'tuna '(tuna) a-friend))
(print (multirember&co 'tuna '(and tuna) a-friend))
^o^ > gosh multirember_and_co.scm
#t
#f
#f

OKのようだ。

最後に、次の関数 last-friend を col とした場合を求めてみよう。

(define multirember&co
  (lambda (a lat col)
    (cond
      ((null? lat) (col (quote ()) (quote ())))
      ((eq? (car lat) a)
        (multirember&co a (cdr lat)
          (lambda (newlat seen) (col newlat (cons (car lat) seen)))))
      (else
        (multirember&co a (cdr lat)
          (lambda (newlat seen) (col (cons (car lat) newlat) seen)))))))

(define last-friend
  (lambda (x y)
    (length x)))

(print (multirember&co 'tuna '(strawberries tuna and swordfish) last-friend))
^o^ > gosh multirember_and_co2.scm
3

last-friend は tuna 以外のアトムを集めたリストの長さを求めている。だから答は3になるわけだ。

第10の戒律
同時に2つ以上の値を集める際には関数を作るべし。

multiremver-fとmultiremverT

multirember-f

multiremver の定義は次のとおりだった。

(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-f を書いてください、ときた。簡単だ。test? を引数にとって、上の定義の中の eq? を test? に、multirember を (multirember test?) に置き換えたものを返してやればいい。

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

(print ((multirember-f eq?) 'tuna '(shrimp salad tuna salad and tuna)))
^o^ > gosh multirember-f.scm
(shrimp salad salad and)

multiremberT

ここで eq?-c が再登場する。この関数はアトム a を引数にとって「アトム x を引数にとって a 比較する関数」を返す関数だった。x を tuna と比較する関数 eq?-tuna は次のように書ける。

(define eq?-tuna (eq?-c 'tuna))

さて、今度は、この eq?-tuna のような関数とラットを引数にとって multirember と同じように動作する multiremberT を書け、ときた。大丈夫、たぶん書けるだろう。

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

(define eq?-tuna (eq?-c 'tuna))

(define multiremberT
  (lambda (test? lat)
    (cond
      ((null? lat) (quote ()))
      ((test? (car lat)) (multiremberT test? (cdr lat)))
      (else (cons (car lat) (multiremberT test? (cdr lat)))))))

(print (multiremberT eq?-tuna '(shrimp salad tuna salad and tuna)))

実行結果:

^o^ > gosh multiremberT.scm
(shrimp salad salad and)

よかった、OKのようだ。

valueとatom-to-function

6章に出てきた value が再登場だ。value の定義は次のとおりだった(補助関数の定義は省略している)。

(define value
  (lambda (nexp)
    (cond
      ((atom? nexp) nexp)
      ((eq? (operator nexp) (quote e+))
        (o+ (value (1st-sub-exp nexp)) (value (2nd-sub-exp nexp))))
      ((eq? (operator nexp) (quote e*))
        (o* (value (1st-sub-exp nexp)) (value (2nd-sub-exp nexp))))
      (else
        (o^ (value (1st-sub-exp nexp)) (value (2nd-sub-exp nexp)))))))

4つある cond の質問と値のうち、最初のを別にすれば3つともよく似ている。違うのは演算子とそれに対応する関数だけだ。そこで、演算子(演算子はアトムであることに注意)から関数に変換する関数を書いてやれば、上の定義を簡単化することができる。
変換する関数 atom-to-function はこうだ。

(define atom-to-function
  (lambda (o)
    (cond
      ((eq? o (quote e+)) o+)
      ((eq? o (quote e*)) o*)
      (else o^))))

これを使って、簡単化した value はこうなる。補助関数も含めて全体を示す。

(use mymodule)

(define 1st-sub-exp
  (lambda (aexp)
    (car (cdr aexp))))

(define 2nd-sub-exp
  (lambda (aexp)
    (car (cdr (cdr aexp)))))

(define operator
  (lambda (aexp)
    (car aexp)))

(define atom-to-function
  (lambda (o)
    (cond
      ((eq? o (quote e+)) o+)
      ((eq? o (quote e*)) o*)
      (else o^))))

(define value
  (lambda (nexp)
    (cond
      ((atom? nexp) nexp)
      (else
        ((atom-to-function (operator nexp)) (value (1st-sub-exp nexp)) (value (2nd-sub-exp nexp)))))))

(print (value '(e+ 3 8)))
(print (value '(e+ (e* 3 6) (e^ 8 2))))

実行結果:

^o^ > gosh -I. value4.scm
11
82

うまくいった!

insert-g(つづき)

subst

リストの中の old を new に置き換える subst は次のような定義だった。

(define subst
  (lambda (new old l)
    (cond
      ((null? l) (quote ()))
      ((eq? (car l) old) (cons new (cdr l)))
      (else (cons (car l) (subst new old (cdr l)))))))

これもやっぱり、前回の insertL や insertR とよく似ている。違うのは cond の2行目、((eq? …) の行だけだ。というわけで、subst のための関数 seqS を作り、insert-g を使って subst を定義せよ、と。
こんなんでどうだ。(ちなみに insert-g の定義は本のとおり test? を引数にとらずに eq? を使うようにした)

(define insert-g
  (lambda (seq)
    (lambda (new old l)
      (cond
        ((null? l) (quote ()))
        ((eq? (car l) old) (seq new old (cdr l)))
        (else (cons (car l) ((insert-g seq) new old (cdr l))))))))

(define seqS
  (lambda (new old l)
    (cons new l)))

(define subst (insert-g seqS))

(print (subst 'topping 'fudge '(ice cream with fudge for dessert)))
^o^ > gosh subst2.scm
(ice cream with topping for dessert)

OKだ。

yyy

今度は次のような関数 yyy が出てきた。

(define insert-g
  (lambda (seq)
    (lambda (new old l)
      (cond
        ((null? l) (quote ()))
        ((eq? (car l) old) (seq new old (cdr l)))
        (else (cons (car l) ((insert-g seq) new old (cdr l))))))))

(define seqrem
  (lambda (new old l)
    l))

(define yyy
  (lambda (a l)
    ((insert-g seqrem) #f a l)))

(print (yyy 'sausage '(pizza with sausage and bacon)))

関数 yyy の定義で insert-g に渡している関数 seqrem は、new や old を cons せずに l だけを返している。ということは、(eq? (car l)) だったとき、new も old も cons されないわけで、つまり yyy は old を削除する関数 rember だってことだ。

^o^ > gosh yyy.scm
(pizza with and bacon)

本では、「#f はどんな役割を果たしていますか。」と書いてあるけど、#f は seqrem の引数 new に当たるので、関数の中では何の役目も果たしていない。実際、#f を #t やほかのアトムに変えても yyy の動作は変わらない。ただの数合わせのためだけにあるわけだ。

前回と今回のまとめ

前回と今回で insertL、insertR、subst、rember という4つの関数が、insert-g とそれぞれの補助関数で定義できることを見てきた。全体的によく似た関数は、同じ部分は共通の関数を使い、違う部分だけをそれぞれの補助関数にして定義できる。これが抽象化というものの力だそうだ。

第9の戒律
新しき関数においては共通のパターンを抽象化すべし。

insert-g

insertL-f と insertR-f

rember を rember-f に変形したように、insertL を insertL-f に変形してください、ときた。といってもすぐに答が書いてあるので、ここは逆らわずに写経。

(define insertL-f
  (lambda (test?)
    (lambda (new old l)
      (cond
        ((null? l) (quote ()))
        ((test? (car l) old) (cons new (cons old (cdr l))))
        (else (cons (car l) ((insertL-f test?) new old (cdr l))))))))

同様に、insertR を insertR-f に。

(define insertR-f
  (lambda (test?)
    (lambda (new old l)
      (cond
        ((null? l) (quote ()))
        ((test? (car l) old) (cons old (cons new (cdr l))))
        (else (cons (car l) ((insertR-f test?) new old (cdr l))))))))

見比べればわかるように、insertL-f と insertR-f はよく似ている。実際、関数名を別にすれば違うのは6行目の new を old を cons する順番だけだ。
というわけで、次の課題はこの部分を関数として渡してやれるようにすることだ。

insert-g

まずは、上の6行目の部分だけを行う関数、seqL と seqR を書こう。といってもほとんど自明だ。

(define seqL
  (lambda (new old l)
    (cons new (cons old l))))

(define seqR
  (lambda (new old l)
    (cons old (cons new l))))

さあ、これで insert-g が書ける。全体を示そう。

(define insert-g
  (lambda (test? seq)
    (lambda (new old l)
      (cond
        ((null? l) (quote ()))
        ((test? (car l) old) (seq new old (cdr l)))
        (else (cons (car l) ((insert-g test? seq) new old (cdr l))))))))

(define seqL
  (lambda (new old l)
    (cons new (cons old l))))

(define seqR
  (lambda (new old l)
    (cons old (cons new l))))

(define insertL (insert-g eq? seqL))

(define insertR (insert-g eq? seqR))

(print (insertL 'topping 'fudge '(ice cream with fudge for dessert)))
(print (insertR 'jalapeno 'and '(tacos tamales and salsa)))

実行結果:

^o^ > gosh insert-g.scm
(ice cream with topping fudge for dessert)
(tacos tamales and jalapeno salsa)

うまくいった!
と思って答を見たら、こんな定義になってるじゃないか。

(define insert-g
  (lambda (seq)
    (lambda (new old l)
      (cond
        ((null? l) (quote ()))
        ((eq? (car l) old) (seq new old (cdr l)))
        (else (cons (car l) ((insert-g seq) new old (cdr l))))))))

test? はどこへいったんだよ!
まあいい、このままいこう。最後に、seqL を使わずに insertL を定義してください、ときた。前のエントリで書いたように、lambda で作った関数には必ずしも名前をつけなくてもかまわない。ということは、seqL という関数名じゃなくてその定義を渡してやればいいわけだ。

(define insert-g
  (lambda (test? seq)
    (lambda (new old l)
      (cond
        ((null? l) (quote ()))
        ((test? (car l) old) (seq new old (cdr l)))
        (else (cons (car l) ((insert-g test? seq) new old (cdr l))))))))

(define insertL
  (insert-g eq?
    (lambda (new old l)
      (cons new (cons old l)))))

(print (insertL 'topping 'fudge '(ice cream with fudge for dessert)))
^o^ > gosh insert-g2.scm
(ice cream with topping fudge for dessert)

OKのようだ。よかった。