alambda

R5RS Schemeの衛生的マクロでアナフォリックマクロは書けません。
色んな意見があるとは思いますが、アナフォリックマクロが書けない時点でSchemeの衛生的マクロは設計としては失敗してる、と思います。
実際、R6RSの衛生的マクロ、syntax-caseでは書けるようになっている、と言う話なんですが、相当ややこしくなってる、との事です。またsyntax-caseに関してのまとまった文献なり入門、ってのも見たことないです(ビューティフルコードには載ってるっぽいんですが、どっちかと言うと論文っぽいんで、実用的にどうする、って話を読み取るのは難しいでしょう)。従って今のところ、syntax-caseは使いようがない。

ポール・グレアムのOn Lispにalambdaと呼ばれるアナフォリックマクロが紹介されています。これはLET OVER LAMBDA Edition 1.0でも使われまくってるアナフォリックマクロの代表格です。定義は以下のようなものです。

CL-USER> (defmacro alambda (parms &body body)
    `(labels ((self ,parms ,@body))
       #'self))
ALAMBDA
CL-USER> 

同書には次のような例が掲載されています。

CL-USER> (alambda (x) (if (zerop x) 1 (* x (self (1- x)))))
#<FUNCTION (LABELS SELF) {BB55A75}>
CL-USER> 

ご覧の通り、alambdaは代名詞selfで束縛されたクロージャを返す。上のワンライナーは階乗の定義なんで、階乗を計算するクロージャですね。
続けてインタプリタに次のように入力します。

CL-USER> (funcall * 10)
3628800
CL-USER> 

10の階乗がキチンと返ってきます。ちなみに、上の*は「掛け算」の意味ではなくって、CLのインタプリタ上では、その前の計算結果を参照する場合、*で参照出来ます。つまり、関数としての役割ではなくって、大域変数なんです。詳しくはこちらをご覧下さい。*を掛け算と解釈すると、上の入力は意味不明になります。
話を元に戻すと、最初の定義、

CL-USER> (defmacro alambda (parms &body body)
    `(labels ((self ,parms ,@body))
       #'self))
ALAMBDA
CL-USER> 

に於いて、一見不用意にselfと言う変数名が挿入されているように見えます。これはマクロが展開される場所の外側からselfが指示されていたらそれを参照してもおかしくないんです。と言うか、前の例示の通り、明らかに参照している。
そのお陰で代名詞として役割を果たしてるんですね。上手い手です。そしてこれはSchemeで実現するのが難しい。と言うよりR5RSでは出来ません。

一見、R5RSマクロで次のような定義方法に翻訳出来て、それで良さそうに見えます。

;; この定義方法じゃ実はダメ。
(define-syntax alambda
  (syntax-rules ()
    ((_ params body ...)
     (letrec ((self
        (lambda params
   body ...)))
       self))))

Schemeインタプリタで次のように走らせてみても、一見上手く動きそうに見えるのです。

> (alambda (n)
      (if (zero? n)
   '()
   (cons
    n
    (self (- n 1)))))
#<procedure:self>
> 

確かに手続きのクロージャselfが返ってるように見える。
ところが、これに実値を与えてみると、破綻している事が分かる。

> ((alambda (n)
      (if (zero? n)
   '()
   (cons
    n
    (self (- n 1))))) 10)
reference to undefined identifier: self

 === context ===
/usr/lib/plt/collects/scheme/private/misc.ss:74:7

> 

つまり、alambdaを用いたクロージャの定義で現れるselfは、alambda自体の定義で使われているselfとは別物だ、と認識されるのです。CLでのalambdaでは同一と見なされるものがR5RSでは同一と見做されない。変数衝突が起きない。これが衛生的と言われる所以です。

R5RSマクロは「letが変数束縛をする」ということを知っており、マクロが挿入する束縛変数とマクロの「外から来た」変数とを区別するのです。

-----<中略>-----

Schemeは、レキシカルクロージャを導入したのと同じ発想を、一段メタな領域に適用しようとしています。そこではもはやプログラムはS式そのものではありません。一度読み込まれて構文解析されたプログラムは「S式+環境」となり、マクロは「S式+環境」に対して作用します。

Scheme:マクロ:CommonLispとの比較

つまり、Schemeで翻訳を試みたalambdaの定義で使われているselfはクロージャによって守られていて、外側から中を参照する事が出来ません。コンテクストが外部定義からは切り離されているのです。故にアナフォリックマクロが定義出来ない。

Schemeではむしろ、束縛する変数を呼び出し環境から与えてやる書き方が推奨されます。

プログラミングGauche

プログラミングGaucheの流儀に従うと、Schemeでのalambdaは次のように定義した方が無難だと言うことです。

(define-syntax alambda
  (syntax-rules ()
    ((_ self params body ...)
     (letrec ((self
        (lambda params
   body ...)))
       self))))

つまり、外部からselfを与えてやるようにする。そうすると、

> (alambda self (n)
    (if (zero? n)
        '()
        (cons
  n
  (self (- n 1)))))
#<procedure:self>
> 

とクロージャselfが返るのは同じですが、引数を与えてやると、

> ((alambda self (n)
     (if (zero? n)
  '()
  (cons
   n
   (self (- n 1))))) 10)
(10 9 8 7 6 5 4 3 2 1)
> 

となります。
しかし、こうなると実際、アナフォリックマクロと言うよりクロージャを返すnamed-letの変種ですね。

こんな感じで、CLのマクロをSchemeに移植しようとすると、色んな障害が立ちはだかります。また、外部から変数を与えてPseudoなアナフォリックを狙っても、CLと違い、手続き定義に於いては味方の筈のクロージャが敵にまわり、同じ効果を出すには大きな障害として立ちふさがるのです。

コーディング・スタイル

ちょっとしたツマラン話を。

On Lispに次のようなコードが紹介されてるんですよね。

CL-USER> (defun group (source n)
    (if (zerop n) (error "zero length")) ;ここで暗黙のprognを利用している
    (labels ((rec (source acc)
        (let ((rest (nthcdr n source)))
   (if (consp rest)
       (rec rest (cons
           (subseq source 0 n)
           acc))
       (nreverse
        (cons source acc))))))
      (if source (rec source nil) nil)))
GROUP
CL-USER> (group '(a b c d e f g) 2)
((A B) (C D) (E F) (G))

うん、まあ問題がない。当然動きます。
しかし、Scheme勉強している人は二行目が気にくわないのでは、と思います。

マクロdefunは暗黙のprognが含まれていて、defunの内部に記述されたS式は逐次実行され、最後のS式の評価値が返り値として返されます。それが故に2行目に

(if (zerop n) (error "zero length"))

なんて書き方が可能なんですよね。ここで(zerop n) => NILだとしても、この返り値はここでは無視されて、次のlabelsからの部分が実行されて関数groupは問題なく動くのです。

この暗黙のprognを利用した関数定義って良く見かけるんですよ。CLのコードやあるいはEmacs Lispのコードでは良くあります。Scheme弄ってる時間が長いと「何々なに?」とか思っちゃうんですが(笑)。と言うのも、論理的な話すると、

CL-USER> (defun group (source n)
    (if (zerop n)
        (error "zero length") ;論理的にはこれで良い
        (labels ((rec (source acc)
     (let ((rest (nthcdr n source)))
       (if (consp rest)
    (rec rest (cons
        (subseq source 0 n)
        acc))
    (nreverse
     (cons source acc))))))
   (if source (rec source nil) nil))))
STYLE-WARNING: redefining GROUP in DEFUN
GROUP
CL-USER> (group '(a b c d e f g) 2)
((A B) (C D) (E F) (G))

上のように書いてもいっこうに構わないのです。ここではlabels以降は(zerop n) => Tの場合処理されないので、結局局所関数は作成されません。そして(zerop n) => NILの場合はじめて再帰関数が生成されるので、ifの第1引数、第2引数はほっぽったままです。多分こう言う書き方の方がSchemerの好みであって、また、Schemeではifの第3引数が省略された場合の返り値が未定義な以上、こっちの書き方の方が望ましいでしょうね。

第1の書き方はCLやEmacs Lispのコードだと本当に良く見かけます。恐らく、C言語でああ言う書き方で脱出試みる場合があるんで、その影響もあるんでしょうね。が、Schemerはそう言うスタイルは好まないとは思います。
あるいは、ifに全てを包めば、インデントが凄く深くなるのが嫌われている原因かもしれません。Schemerの方がCLerやEmacs Lisperほどインデントが深くなるのをさほど問題視していないのかもしれません。

ちなみに、あくまで論理的な話をすると、こう言う書き方の方がなおスッキリするやもしれません。

CL-USER> (defun group (source n)
    (labels ((rec (source acc)
        (let ((rest (nthcdr n source)))
   (if (consp rest)
       (rec rest (cons
           (subseq source 0 n)
           acc))
       (nreverse
        (cons source acc))))))
      (cond ((zerop n) (error "zero length"))
     (source (rec source nil))
     (t nil))))
STYLE-WARNING: redefining GROUP in DEFUN
GROUP
CL-USER> (group '(a b c d e f g) 2)
((A B) (C D) (E F) (G))

このように、実行形態を最後にまとめちゃっても、結果は同じですよね。
ただ、このスタイルの場合、最初に局所関数を作っちゃうでしょうから、その辺をCLerの人たちは「メモリの無駄」ってんで嫌ってるのかもしれません。

竹内関数と遅延評価

竹内関数ってご存知でしょうか?
ベンチマークテストに使われる関数なんだそうですが、シンプルな外見に似合わず、計算に無茶苦茶時間がかかる関数だそうです。
Schemeでの定義は以下の通りです。

(define (tak x y z)
  (if (<= x y)
      y
      (tak (tak (- x 1) y z)
    (tak (- y 1) z x)
    (tak (- z 1) x y))))

環境にもよるんですが、あまり大きな実引数を与えると計算がなかなか終わりません。PLT Scheme依存のtime手続きで時間を計ってみます。なお、CPUはCore2DuoのT7500の2.2GHz、メモリは2GBです。

> (time (tak 10 5 0))
cpu time: 20 real time: 21 gc time: 0
10
> (time (tak 12 6 0))
cpu time: 388 real time: 388 gc time: 0
12
> (time (tak 18 12 6))
cpu time: 376 real time: 379 gc time: 0
18
> 

まあ、実際各自マシンで試してみてください。「意外と計算に時間がかかる」と思うでしょう。

ところで、風の噂で聞くには、この竹内関数、Haskellと言うプログラミング言語ではちょっぱやで計算終了しちゃうそうです。へえへえへえ。どうやら、Haskellの伝家の宝刀、遅延評価は竹内関数の天敵らしい。

遅延評価、と言えばSchemeも遅延評価を備えています。しかし今まで使い勝手が良く分からなかったんでマトモに触った事がありませんでした。
曰く、

評価しなければならない値が存在するとき、実際の計算を値が必要になるまで行わないことをいう。

………。
な～んか、日常生活的な感覚から言うとあまりに当たり前のような気もしますがねえ……。あまりにも当たり前の事が出来ないのが前提なら、コンピュータってメンド臭えな。マジな話、実感としてはそんな感じですよ。プログラミング言語の世界って日常生活的には当たり前の事を大げさに言ってる、ってたまに感じます。

脱線しますが、例えば、

彼女になりそうな女性が存在するとき、彼女が必要になるまで口説かない。

とか言われると当たり前でしょ(笑)?彼女がいるのに別の女性を口説いたりしたらそれは人非人と後ろ指さされる世の中です(笑)。僕がプライベートでどう言う行動を取ろうが関係なく、まあ、そうですよね(笑)。プログラミング言語で「遅延評価」とか言ってますが、人間の行動なんて多かれ少なかれ遅延評価、です。別に特別な話じゃない。
実際問題、コンピュータの世界では人間の「常識」がいまだ通用しない世界なんですね。前にも書きましたが、プログラミング言語に於ける「抽象性」と言うのは、人間の常識に近づいてる事だ、と言うのはこう言う事なんです。竹内関数がコンピュータでクソみたいに計算に時間がかかるのは、女と見れば見境なしに手を出してるロクデナシみたいな事をプログラミング言語が行っているから、です。そう言う評価形式を先行評価と呼ぶらしい。そして竹内関数はそう言う女ったらしに鉄槌を下す。
いずれにせよ、我々の世界では、遅延評価が当たり前で先行評価が「異常」です。しかし、プログラミング言語の世界では、まだまだ「我々の行動原理で言う異常」が当たり前ならしい。そしてプログラマはその世界にどっぷりと浸かってなれざるを得ない。

そんな中でHaskellとSchemeは「ちょっとだけ」僕等の常識に近いトコにいるんですよね。Haskellは遅延評価がデフォですが、Schemeではちょっと工夫しないとならない。いずれにせよ、早いトコ、もっと人間側の常識に従っているプログラミング言語が普及して欲しいものです。

さて、Schemeでのその「工夫」ですけど。マクロを使って次のようなifの亜種を作ります。名づけてlif(lazy-ifの意)です。

(define-syntax lif
  (syntax-rules ()
    ((_ _cond _then _else)
     (force (if (delay _cond)
  (delay _then)
  (delay _else))))))

ここでdelayはS式の評価を遅延させるための特殊形式です(出来たものをプロミスと呼びます)。そしてforceはプロミスを強制評価する為の手続きです。
このforceとdelayを同じマクロ内に書いても意味が無い、と思われるかもしれませんが、さにあらず。特殊形式ifは述語判定が行われないと第二引数ないしは第三引数が評価されません。しかしながら条件節自体がプロミスなので、評価ははじまりません。故にifが形作るS式は全体として評価が遅延されている。
また、マクロ自体もマクロ展開が行われないと評価が開始されません。そしてdelayのせいでどう言う展開形に落ち着くのか、はこのlifはまだ知らないのです。従って、forceも発動しようがないのです。
このマクロlifを使えば、ltak(lazy-takeuchi)手続きは次のようにオリジナルのtak手続きと殆ど同様に定義可能です。

(define (ltak x y z)
  (lif (<= x y)
       y
       (tak (tak (- x 1) y z)
     (tak (- y 1) z x)
     (tak (- z 1) x y))))

実際、インタプリタで計測してみましょう。恐ろしい程の竹内関数のベンチマークを叩き出します。

> (time (ltak 10 5 0))
cpu time: 0 real time: 0 gc time: 0
5
> (time (ltak 12 6 0))
cpu time: 0 real time: 0 gc time: 0
6
> (time (ltak 18 12 6))
cpu time: 0 real time: 0 gc time: 0
12
> 

全く計算時間がかかってない事が分かるでしょう。すげえ、ブラボー！！！Viva!遅延評価(笑)！！！
それどころか、マトモな竹内関数だったらいつ計算が終わるか分からない次のような大きな引数を与えても難なくltakは結果を返してくれます。

> (time (ltak 100 50 0))
cpu time: 0 real time: 0 gc time: 0
50
> 

すっごいですね～～。一瞬で答えを返してくれます。これも「値が必要になるまで評価しない」遅延評価版の竹内関数ならでは、の仕事です。オリジナルはよっぽど無駄な計算をしてるんでしょうね。こちらは不必要な計算は全く行わないので、迅速に計算結果が返ってくるのです。

面白いですね、遅延評価。また何かあったら使ってみたいな、と思います。

なぜマクロの使いどころは分かり辛いのか

9LISPでもマクロに入るらしいんで、ちょこっとしたメモを書いておこうと思います。何故マクロの学習が難しいのか、と言う一つの答えですね。

LISP入門と言う超古い本に紹介されてるんですが、大昔のLISP(それこそMacLispやInterlispより歴史が古いLisp1.5の流れ)だと関数定義ってもっと種類があったんです。下にそれを抜書してみます。

関数の種類

	実引数を評価する (eval)	実引数はそのまま (quote)
実引数は仮引数にそのまま渡す (spread)	EXPR型 (ARRAY)	NEXPR型
実引数はひとまとめ (non-spread)	LEXPR型	FEXPR型
関数と実引数をまとめる	---	MACRO型

実は超古典的なLispの文脈に於いては、関数定義の種類と言うのは4種類くらいあったんです。
このうち、可変長引数を用いる関数に関しては、現代のLispでは関数定義で方法を変える代わりにレストパラメータで解決するようになりました。問題は、古典的Lispでは引数を評価しない関数が存在した、と言う辺りです。
同書からちょっと引用してみましょうか。

EXPR型の関数は、定義した引数(仮引数)の個数と実際の引数(実引数)の個数が一致して、しかも実引数の値を求めるために評価(evaluation)が行われます。本書で扱ったプログラムはほとんど全部EXPR型で定義されています。最も常識的な関数型です。
しかし、EXPR型ではうまく定義されない関数もあります。これらを定義するにはEXPR型以外の型が必要となります。

そして、同書では関数QUOTEの定義を紹介しています(ここに注目!QUOTEは関数なんです!)。

(DN QUOTE (X) X)

これビックリなんですよね。少なくとも現代的なLispではこんなQUOTEはマクロを使っても定義出来ません。まさしく引数を評価しないため「だけの」目的の為に存在してる関数定義方法があったわけです。

実はSchemeが登場する前後辺りで、ミニマリスティックな観点でLispの大刷新が起こりました。「引数を評価しない」のはマクロも同じなんで、「引数を評価しない関数」群がマクロに統合されたんです。システム的には当然の考え方ですよね。
一方、マクロは必ず展開が行われます。つまり、一種マクロは二段階評価になっていて、まずは展開(引数をそのままコードのテンプレートに挿入)して、最終的には「評価」されます。つまり、使いどころが異なるモノ同士がシステム的観点で統合されちゃった。これがマクロ学習の困難な面を露にしたのです。
加えると、「Schemeにはマクロが無い」と言うCLerの言い分も歴史的なちょっとしたアヤが原因だ、と言うのも分かると思います。マクロは展開を伴うので「いつ展開されるのか?」と言うのが重要なポイントで、CLでは「コンパイル時」と規程されている模様です。一方、Schemeはマクロ展開時がいつになるかR5RSに正確な規程が存在しません。Scheme登場時には多くのLisp方言が今よりもバラバラに存在してたんで、「展開時」をどこにするのかまだ考える猶予があったのでしょう。かつ、その言い方を借りるとLispには「引数を評価しない」関数があって良いのです。Schemeが持ってるのはもっと緩やかな、むしろ古典的なNEXPR型やFEXPR型の関数定義だ、と言う言い方も出来るのです。

多変数のSETQ

変数に値を代入するSETQという関数があります。プログラム中では、変数値の変更は1個だけでなく複数の変数について行いたい場合がよくあります。このようなときに(SETQ … ) (SETQ … ) … (SETQ … )と書くのは面倒なので、(MSETQ x1 v1 x2 v2 … xn vn)としたいと思います。ここでx_i、v_iはi番目の変数名とその代入値を指します。
このMSETQの定義を与えてください。

同書にはFEXPR型関数定義の例として上のような問題を掲載しています。「関数定義」の問題として、ですよ。マクロじゃないんです。現代的なLispを扱ってると信じられない状況です(笑)。つまり、大昔のLispだと、この程度だとわざわざマクロを持ち込まなくても良かった、と言う事でしょう。
回答例は以下のようになっています。

(DF MSETQ (L)
    (PROG (X V)
       (COND [(GREATERP 2 (LENGTH L))
       (ERROR "ARGUMENTS LESS THAN 2!")])
       (LOOP () (SETQ X (CAR L)) ;MSETQが使えれば、
   (SETQ V (CADR L))  ;(MSETQ X (CAR L) V (CADR L) L (CDDR L))
   (SETQ L (CDDR L))  ;と書けたはず。
   (SET X (EVAL V))
   (COND [(NULL L) (RETURN (EVAL X))]
  [(NULL (CDR L))
   (ERROR "ODD NUMBER OF ARGS!")]
  ))))

Schemeの衛生的マクロで書くとこうですかね。

(define-syntax mset!
  (syntax-rules ()
    ((_ x)
     (error "arguments less than 2!"))
    ((_ x v)
     (set! x v))
    ((_ x v y)
     (error "odd number of args!"))
    ((_ x v y ...)
     (begin (set! x v)
     (mset! y ...)))))

他にもこんな例題が掲載されています。

構造化構文

いわゆる構造化プログラミング(Structured Programming)では、goto文(PROG内のGOなど)を廃して、構造化構文を推奨しています。LOOPもその一例ですが、ほかにWHILEとREPEATと言う構造化構文がよく用いられます。
WHILEは(WHILE <条件> DO <実行文1>　… <実行文n>)と言う形式で、<条件>が成立している間は実行文を繰り返し実行します。
一方REPEATは(REPEAT <実行文1>　… <実行文n> UNTIL <条件>)という形式で、<条件>が成立するまで、実行を繰返します。
このWHILEとREPEATという二つの構造的繰返し実行関数を定義してください。

これもマクロ例題としては良くある問題なんですが、やっぱり注目してください。当時はこれらは関数として定義出来た、んです。
当時の解法だと次のような感じですね。

(DF WHILE (L)
    (PROG (PRED EXEC)
       (SETQ PRED (CAR L))
       (SETQ EXEC (CDDR L))  ;DO のチェックは省きました。
       (LOOP ()
   (COND [(NULL? (EVAL PRED))
   (RETURN 'END-OF-WHILE)])
   (MAPC 'EVAL EXEC)  ;MAPC を使って実行します。
   )))

(DF REPEAT (L)
    (PROG (PRED EXEC)
       (SETQ L (REVERSE L))  ;逆転して処理しました。
       (SETQ PRED (CAR L))
       (SETQ EXEC (REVERSE (CDDR L)))
       (LOOP ()
   (MAPC 'EVAL EXEC)
   (COND [(EVAL PRED) (RETURN 'END-OF-REPEAT)])
   )))

これも今風にSchemeの衛生的マクロで書けば以下のようになりますかね。

(define-syntax while
  (syntax-rules ()
    ((_ (pred exec ...))  ;do の省略
     (do ()
  ((not pred) 'end-of-while)
       (begin exec ...)))))

(define-syntax repeat
  (syntax-rules ()
    ((_ (pred exec ...))
     (do ()
  (pred 'end-of-repeat)
       (begin exec ...)))))

いずれにせよ、当時はこの範疇の「構文」でさえ、マクロで書くような事はなかったんです。もっとも、そのせいでコード中にevalを挿入して醜くなったりしてますが。
そして、マクロに「引数を評価しない」関数の役割が統合された為、マクロの「役割」が膨大になっちゃった、という副作用が出てきたのです。

TSS scramble は末尾再帰可能

valvallowさんのブログ見てたんですけど、The Seasoned Schemerのscrambleって全然意味不明ですな～～。困ったもんだ。
valvallowさんが抜粋したscrambleのコードですが、ちょっと見てみますか。

(define sub1
  (lambda (n)
    (- n 1)))

(define pick
  (lambda (n lat)
    (list-ref lat (sub1 n))))

(define scramble
  (lambda (tup)
    (letrec ((iter (lambda (t rev-pre)
                     (if (null? t)
                         '()
                         (let* ((n (car t))
                                (rev (cons n rev-pre)))
                           (cons (pick n rev)
                                 (iter (cdr t) rev)))))))
      (iter tup '()))))

ふ～む。何やってんだかサッパリです(苦笑)。
基本的にletrecがいけねえんだな(苦笑)。見づらい。
と言うわけでnamed-letに書き換えてみます。そして個人的にはあまりlet*が好きじゃないんで(何故、って訊かないで・笑)、そこも直して、pickも敢えて解体して書き直してみます。

(define (scramble tup)
  (let iter ((t tup) (rev-pre '()))
    (if (null? t)
 '()
 (let ((n (car t)))
   (let ((rev (cons n rev-pre)))
     (cons (list-ref rev (- n 1))
    (iter (cdr t) rev)))))))

ふ～～～む。まだ何やってるか分かり辛いですよね。しかも、このスタイルは末尾再帰じゃない。何か末尾再帰出来そうな気がするんですよね～～。
コードの意味が分からん、かつ末尾再帰になりそう、と思った時どうすっか。一番簡単なのは継続渡し方式に取りあえず書き直してみる事です。ひょっとしたら、これで何か見えてくるかもしれません。やってみます。

(define (scramble tup)
  (let iter ((t tup) (rev-pre '()) (k values))
    (if (null? t)
 (k '())
 (let ((n (car t)))
   (let ((rev (cons n rev-pre)))
     (iter (cdr t) rev
    (lambda (u)
      (k (cons (list-ref rev (- n 1)) u)))))))))

んで、詳しい論理の流れはこのページを参考にして欲しいんですけど、上のコードは次のように書き換えられて、

(define (scramble tup)
  (let iter ((t tup) (rev-pre '()) (acc '()) (k values))
    (if (null? t)
 (k (reverse acc))
 (let ((n (car t)))
   (let ((rev (cons n rev-pre)))
     (iter (cdr t) rev (cons (list-ref rev (- n 1)) acc)
    (lambda (u) (k u))))))))

ついでに次のように書き換えられます。

(define (scramble tup)
  (let iter ((t tup) (rev-pre '()) (acc '()) (k values))
    (if (null? t)
 (k (reverse acc))
 (let ((n (car t)))
   (let ((rev (cons n rev-pre)))
     (iter (cdr t) rev (cons (list-ref rev (- n 1)) acc) k))))))

ここまで来ると、もはやローカル手続きのkが要らなくなります。事実上、全く仕事をしてないから、です。
従って、題意のコードは、

(define (scramble tup)
  (let iter ((t tup) (rev-pre '()) (acc '()))
    (if (null? t)
 (reverse acc)
 (let ((n (car t)))
   (let ((rev (cons n rev-pre)))
     (iter (cdr t) rev (cons (list-ref rev (- n 1)) acc)))))))

となりますね。末尾再帰になりました。
末尾再帰の方が若干何やってるか分かりやすいかもしれません。

1. n番目の指定はリストtの先頭の数字によって決定される。


2. リストrevは(cons n rev)で生成される。また、このリストは常にリストtに対しては部分的に逆順となっている。


3. リストaccはリストrevのn番目の要素をconsしていって生成される。


4. tは(cdr t)となり(null? t) => #tとなるまで1番から作業を繰り返す。


5. 返り値はaccを逆順にしたものである。

まだ、ちょっと分かり辛いかもしれませんね。例えば、

1. tは(1 1 1 3 4 2 1 1 9 2)、revは空リスト、accも空リストとする。


2. nは1となり、revは(1)となる。


3. revのn = 1番目の要素は1なので、accは(1)となる。


4. tは(1 1 3 4 2 1 1 9 2)となり、以下繰り返し。

つまり、キーポイントとしては「常にtに対して部分的には逆順のリストであるrevのn番目の要素を問題にしている」と言う事なんです。
まだ分かり辛いかもしれないんで、valvallowさんの真似をして出力部分を組み合わせてみます。

(define (scramble tup)
  (let iter ((t tup) (rev-pre '()) (acc '()))
    (if (null? t)
 (reverse acc)
 (let ((n (car t)))
   (let ((rev (cons n rev-pre)))
     (for-each (lambda (x) ; ここは出力
   (display x))
        (list "t = " t ", n = " n ", rev = " rev ", acc = " acc))
     (newline)   ; 改行
     (iter (cdr t) rev (cons (list-ref rev (- n 1)) acc)))))))

出力結果は以下の通りです。

> (scramble '(1 1 1 3 4 2 1 1 9 2))
t = (1 1 1 3 4 2 1 1 9 2), n = 1, rev = (1), acc = ()
t = (1 1 3 4 2 1 1 9 2), n = 1, rev = (1 1), acc = (1)
t = (1 3 4 2 1 1 9 2), n = 1, rev = (1 1 1), acc = (1 1)
t = (3 4 2 1 1 9 2), n = 3, rev = (3 1 1 1), acc = (1 1 1)
t = (4 2 1 1 9 2), n = 4, rev = (4 3 1 1 1), acc = (1 1 1 1)
t = (2 1 1 9 2), n = 2, rev = (2 4 3 1 1 1), acc = (1 1 1 1 1)
t = (1 1 9 2), n = 1, rev = (1 2 4 3 1 1 1), acc = (4 1 1 1 1 1)
t = (1 9 2), n = 1, rev = (1 1 2 4 3 1 1 1), acc = (1 4 1 1 1 1 1)
t = (9 2), n = 9, rev = (9 1 1 2 4 3 1 1 1), acc = (1 1 4 1 1 1 1 1)
t = (2), n = 2, rev = (2 9 1 1 2 4 3 1 1 1), acc = (1 1 1 4 1 1 1 1 1)
(1 1 1 1 1 4 1 1 1 9)
> (scramble '(1 2 3 4 5 6 7 8 9))
t = (1 2 3 4 5 6 7 8 9), n = 1, rev = (1), acc = ()
t = (2 3 4 5 6 7 8 9), n = 2, rev = (2 1), acc = (1)
t = (3 4 5 6 7 8 9), n = 3, rev = (3 2 1), acc = (1 1)
t = (4 5 6 7 8 9), n = 4, rev = (4 3 2 1), acc = (1 1 1)
t = (5 6 7 8 9), n = 5, rev = (5 4 3 2 1), acc = (1 1 1 1)
t = (6 7 8 9), n = 6, rev = (6 5 4 3 2 1), acc = (1 1 1 1 1)
t = (7 8 9), n = 7, rev = (7 6 5 4 3 2 1), acc = (1 1 1 1 1 1)
t = (8 9), n = 8, rev = (8 7 6 5 4 3 2 1), acc = (1 1 1 1 1 1 1)
t = (9), n = 9, rev = (9 8 7 6 5 4 3 2 1), acc = (1 1 1 1 1 1 1 1)
(1 1 1 1 1 1 1 1 1)
> (scramble '(1 2 3 1 2 3 4 1 8 2 10))
t = (1 2 3 1 2 3 4 1 8 2 10), n = 1, rev = (1), acc = ()
t = (2 3 1 2 3 4 1 8 2 10), n = 2, rev = (2 1), acc = (1)
t = (3 1 2 3 4 1 8 2 10), n = 3, rev = (3 2 1), acc = (1 1)
t = (1 2 3 4 1 8 2 10), n = 1, rev = (1 3 2 1), acc = (1 1 1)
t = (2 3 4 1 8 2 10), n = 2, rev = (2 1 3 2 1), acc = (1 1 1 1)
t = (3 4 1 8 2 10), n = 3, rev = (3 2 1 3 2 1), acc = (1 1 1 1 1)
t = (4 1 8 2 10), n = 4, rev = (4 3 2 1 3 2 1), acc = (1 1 1 1 1 1)
t = (1 8 2 10), n = 1, rev = (1 4 3 2 1 3 2 1), acc = (1 1 1 1 1 1 1)
t = (8 2 10), n = 8, rev = (8 1 4 3 2 1 3 2 1), acc = (1 1 1 1 1 1 1 1)
t = (2 10), n = 2, rev = (2 8 1 4 3 2 1 3 2 1), acc = (2 1 1 1 1 1 1 1 1)
t = (10), n = 10, rev = (10 2 8 1 4 3 2 1 3 2 1), acc = (8 2 1 1 1 1 1 1 1 1)
(1 1 1 1 1 1 1 1 2 8 2)
> 

TSS rember1*

ネストした cond とか読みづらいですねー。

読みづらい、どころの問題じゃないです(苦笑)。
問題のコードはこれなんですけど。中でも「一番マシ」なのをピックアップしました。

; The Seasoned Schemer letrec, let
(define rember1*
  (lambda (a l)
    (letrec
        ((R (lambda (l)
              (cond
               ((null? l)(quote ()))
               ((atom? (car l))
                (cond
                 ((eq? (car l) a)(cdr l))
                 (else (cons (car l)
                             (R (cdr l))))))
               (else (let ((av (R (car l))))
                       (cond
                        ((eqlist? (car l) av)
                         (cons (car l)(R (cdr l))))
                        (else (cons av (cdr l))))))))))
      (R l))))
 
(rember1* 'salad '((Swedish rye)
                   (French (mustard salad turkey))
                   salad))
; -> ((Swedish rye) (French (mustard turkey)) salad)

もうあったまクラクラしてきますね(笑)。Schemeにある程度慣れていてもクラクラしてくるコードです。
The Little SchemerやThe Seasoned Schemerは「名著」の誉れが高いんですが「ホンマか?」と頭の中が疑念の嵐です、しょーじきなトコロ。ひっどいコードの垂れ流しとしか見えません。
僕は両書とも持ってないんで、意図がどこにあるのか、あるいは何か目的があってそこへ誘おうとしてるのか分からないんですが、いずれにせよ、このコードを見る以上「酷いコードが書かれてあるテキスト」だとしか思えません。

「リファクタリングせねば!」

とか思ったんですが、これがなかなか(苦笑)。一筋縄ではいかない。
valvallowさんが記述している通り、

ネストした list 内から最初に見つかったものを一つだけ取り除くって、一つだけって逆に難しいですね。

なんです。全くです(苦笑)。

しかしながら、テキストを鵜呑みにするんじゃなくって

「何とかリファクタリングして短いコードが書けないか?」

と考えるのは良い練習だと思います。
と言うのも、Schemeで実用的なプログラムを書くのは難しいですし、もしある目的を達成するコードが「短く書けない」のなら、そもそもSchemeなんて勉強する必要なんて無いんです。

コードを極限まで短くする方法を考える

のがSchemeの学習の唯一の価値です。ホントですよ。
(大体、短く書けなきゃSchemeはやたら括弧が多い妙ちきりんな言語なだけ、です。)

まず、例示のコードを見て気になるのは、letrecを用いている意味が全くない、って辺りです。
と言うのも、このコードは全く末尾再帰してないので、ローカル手続きを使ってる意味が無いんです。従って、まずはletrecを消去しちゃいましょう。ここは無駄な部分です。

(define (rember1* a l)
  (cond
   ((null? l) '())
   ;; atom? は標準手続きじゃないので、not pair? に置き換える。
   ((not (pair? (car l)))
    (cond
     ((eq? (car l) a) (cdr l))
     (else (cons (car l) (rember1* a (cdr l))))))
   (else (let ((av (rember1* a (car l))))
    (cond
     ;; eqlist?も標準手続きではない。
     ;; リスト同士の等価判定はequal?で充分。
     ((equal? (car l) av)
      (cons (car l) (rember1* a (cdr l))))
     (else (cons av (cdr l))))))))

それで、このコードを扱ってる章では、valvallowさんの記述によると、

letを使って局所変数を纏めよう

と言うのが狙いのようなんですが、だったらどうしてこんなに中途半端なのか。コード中に現れる(car l)や(cdr l)こそ局所変数で纏めるべきなんですよ。これが素のままで記述されているので、ネストだらけになって見づらいんです。

(define (rember1* a l)
  (if (null? l)
      '()
      (let ((x (car l)) (y (cdr l)))
 (if (not (pair? x))
     (if (eq? x a)
  y
  (cons x (rember1* a y)))
     (let ((av (rember1* a x)))
       (if (equal? x av)
    (cons x (rember1* a y))
    (cons av y)))))))

valvallowさんが仰ってる通り、

分岐が2つなら if 使おうよ。

って事なんで、condも全部ifに置き換えます。
ちょっとは見通し良くなったかな?

次は個人的趣味なんですが、あんまnot～ってのは好きじゃないんですよね。元々分岐が二つである以上、論理的には「pair?であるか、そうじゃないか」ってだけです。つまり、分岐二つの枝の順序は取り替えて良い。

(define (rember1* a l)
  (if (null? l)
      '()
      (let ((x (car l)) (y (cdr l)))
 (if (pair? x)
     (let ((av (rember1* a x)))
       (if (equal? x av)
    (cons x (rember1* a y))
    (cons av y)))
     (if (eq? x a)
  y
  (cons x (rember1* a y)))))))

だいぶ整理されて見やすくなっては来ました。だけど依然としてifのネストはウザいです。ウザいですね。
一つの考え方ですが、例えば(pair? x)以降のifのカタマリに着目してみましょうか。
Lisp系言語の素晴らしいトコは、文がないと言う辺りです。実際文がある言語ではif～then～elseは制御構文なんで、基本的に手続きの引数につっこめません。必ず手続きの外側に置く必然性が出てきます。
一方、全てが式であるLispではその辺融通無碍です。
どう言う事かと言うと、この部分ではどっちにせよ動作は

(cons 何とか1 何とか2)

が求められてるんですね。フォーマットとしては特に差異がないんです。
つまり、次のように書き換えてしまう事が可能です。

(define (rember1* a l)
  (if (null? l)
      '()
      (let ((x (car l)) (y (cdr l)))
 (if (pair? x)
     (let ((av (rember1* a x)))
       ;; 述語の判定結果を it に束縛してしまう。
       (let ((it (equal? x av)))
  ;; it を利用して cons の引数を交換してしまう。
  (cons (if it x av) (if it (rember1* a y) y))))
     (if (eq? x a)
  y
  (cons x (rember1* a y)))))))

これは荒技に見えるかもしれませんが、結構Lisp系ではオーソドックスな手だと思います。これでネストが減ったように見えて(実際見えるだけ、ですが)若干コードがフラットになった印象を受けます。
そして、

(cons 何とか1 何とか2)

が(let ((x (car l)) (y (cdr l)))...以下の主作業であり、また「引数交換」だけで書けるのなら、最後の枝も纏めてしまえるのでは、と言う野望が生まれますね。そして恐らくそれは正しいんです。
ちょっと整理してみましょうか。

1. (eq? x a)が成り立った時点で、xは(Schemeの仕様上そう言う定義は無いが)アトムである事が決定している。-> つまりこれは独立して括り出せる。


2. 残りはpair? => #tかアトムであるけどeq? => #fじゃないか、の二つの枝である。


3. (cons 何とか1 何とか2)の中身が部分的に重複しているパターンが多い

の3点が分かりますね。実際そうなんです。
1番目を考慮すると、コードは取りあえず次のように書けば良いのが分かります。

(define (rember1* a l)
  (if (null? l)
      '()
      (let ((x (car l)) (y (cdr l)))
 (if (eq? x a)
     y
     ...)

これで1番目は綺麗に処理されます。あとはpair?の中身のパターンわけをどうするのか、って事なんですけど……。並べて見てみますか。

(cons (if it x av) (if it (rember1* a y) y))
(cons x (rember1* a y))

第一引数に着目します。候補の引数の中身はxかavの二種類の可能性しかない、って事がお分かりでしょう。当たり前ですよね。
そして、もう一つ重要なのは、xがpair? => #t「だからこそ」再帰でrember1*を噛ます必要性があるのであって、そうじゃなければそんな事する必要がない、のです。そして、再帰噛ました結果とxが等価であるかどうかは第一引数に付いてはロジック上丸っきり関係がありません。その判定が必要なのは第二引数の方なのです。
従って、第一引数は一つのシンボルavで表現して、avはSchemeの有難いif式を利用して束縛します。

(define (rember1* a l)
  (if (null? l)
      '()
      (let ((x (car l)) (y (cdr l)))
 (if (eq? x a)
     y
     ;; av を次のような条件式で束縛する。
     (let ((av (if (pair? x) (rember1* a x) x)))
       ...)

これでxがpair? => #tだったらavは(rember1* a x)に束縛されるし、そうじゃなかったらxに束縛されます。
これにより、ここのletの本体は

(cons av ...)

と書ける事が決定しました。他に何も必要がないのです。こう言う大技が繰り出せるのも、Schemeが文を持たないお陰です。有難や有難や。
ではconsの第二引数はどうなんでしょうか?これは(equal? x av) => #fの「時だけ」yである必要があり、デフォルトでは(rember1* a y)である、ってのが条件なんです。
従って、完成コードは、

(define (rember1* a l)
  (if (null? l)
      '()
      (let ((x (car l)) (y (cdr l)))
 (if (eq? x a)
     y
     (let ((av (if (pair? x) (rember1* a x) x)))
       (cons av (if (equal? x av) (rember1* a y) y)))))))

となりました。随分とスッキリしたでしょ?ネストが減ったように見えて、結構フラットな印象になったと思います。また、コードの「意味」も追いやすくなったんじゃないかな、と思います。

call/ccの冒険～その2

call/ccの意味の分からないトコは、「無くてもいいじゃん?」って思えるケースがしばしば見受けられるトコです。
この原因の主たるところは、Schemeは明示的にreturnを使うようにはなっていない為じゃないのか、とかちょっと思うんです。
割に、C言語や、その派生モデルの言語の方がcall/ccの意図がつかみ易いのでは、と時々思います。
いずれにせよ、R5RSに以下のように記述されている通り、

call-with-current-continuation の平凡な用途は，ループまたは手続き本体からの構造化された非局所的脱出である。

call/ccの取りあえずの目的は脱出なんです。いわゆるcall/ccの「すげえ機能」と言う一種の誤解は、この「脱出をどう実現してるのか」から出てきた言わば副産物なんですよね。
従って、call/ccで脱出にこだわるのは、call/ccの機能を知る為の第一歩なんじゃないか、と思います。

ところで。ANSI Common LispとSchemeには次のような違いがあります。
ANSI Common Lispの場合、

CL-USER> (car '())
NIL
CL-USER> (cdr '())
NIL
CL-USER> 

となります。
これは、たまにプログラミングに於いてバグになるんですが、上手くすれば非常に便利なんですよね。コードを書く量が劇的に減ります。
実はこれはInterlispと言うLispから受け継いだらしいんですが、はじめは「何て手抜きな事を」と感じる事もなきにしもあらず。しかし、数学的には正しい結果でもあるんです。

空集合の部分集合は空集合自身のみである。

いいですね。魅力的です。
ただし、Schemeは数学的に見てヘンな結果になります。端的に言うとエラーを返す。

> (car '())
car: expects argument of type ; given ()

 === context ===
/usr/lib/plt/collects/scheme/private/misc.ss:74:7

> (cdr '())
cdr: expects argument of type ; given ()

 === context ===
/usr/lib/plt/collects/scheme/private/misc.ss:74:7

> 

ここで、Scheme上でANSI Common Lispのような働きをするextended-carとextended-cdrを書いてみましょう。それぞれxcar、xcdrとします。
恐らく、オーソドックスにSchemeでこれらを書くと、次のようなコードになるでしょう。

(define (xcar lst)
  (if (null? lst)
      lst
      (car lst)))

(define (xcdr lst)
  (if (null? lst)
      lst
      (cdr lst)))

何にも問題ありませんね。至極単純なコードです。実行結果は以下の通り。

> (xcar '())
()
> (xcar '(1 2 3 4 5))
1
> (xcdr '())
()
> (xcdr '(1 2 3 4 5))
(2 3 4 5)
> 

敢えてこれをcall/ccを用いて記述してみましょう。コードは次のようになります。

(define (xcar lst)
  (call/cc
   (lambda (return)
     (car (if (null? lst)
       (return lst)
       lst)))))

(define (xcdr lst)
  (call/cc
   (lambda (return)
     (cdr (if (null? lst)
       (return lst)
       lst)))))

これが脱出です。
考え方としては、要するに普通のcar/cdrなんですが、lstが空リストだった場合エラーになるんで、その条件の場合、car/cdrが作り出す筈の「計算結果を捨てて」空リストを持って脱出するわけです。
これは普通の手続き型言語で考えたらお馴染みでしょう。簡単です。
ただし、

1. call/ccを使わないでも書けるコードなのに、call/ccを使う必然性が見当たらない。


2. 単に構文的にはreturnがあれば済む話なんじゃないか。


3. そもそも、単に脱出する為だけに(call/cc (lambda (hoge) ...))って大掛かりさは何なんだ。

と言う不満があるでしょう。全くもってその通りです。
僕は1番目にずーっと引っかかってたんですよね。call/ccを使わなくても記述可能な場合が多い、んです。他でもっと簡易な代替手段があるのに、それでも敢えてcall/ccを使わなきゃならない理由は何なんだ、と。全くもって意味不明でした。
手続き型言語をやってる人は2番3番は思うでしょう。実際ANSI Common Lispにはreturnとかreturn-fromと言う構文があるんで、call/ccの煩雑さは際立ちます。単に脱出するだけだったらもっと簡易な脱出構文を用意しとけばいいのです。抽象化の失敗の薫りがしますね。
しかし、call/ccの練習、つまり、「慣れ」を考えるなら、敢えて上記のように「call/ccを使わなくても」書ける手続きをcall/ccを使って記述しなおすのは良いと思います。少なくと上の例のように「括弧の中と外が」ひっくり返るような形になるでしょう。文字通りひっくり返るんです。ここ、重要ですよ。

実は、この手の処理の場合、独立した手続きにするより、何かの組み込みとしてcall/ccを使った方が有用性が際立ちます。特に空リストのcarを取ったり、とかcdrを取ってエラーになる、と言うのは、ロジック自体は間違ってないトコでの「Scheme特有の性質」に足を掬われたりするんで、効果は絶大です。

ところで、ANSI Common Lispにはeveryと言う関数が定義されています。述語とシーケンスを引数に取り、シーケンスの全要素が述語を満たすかどうか判定します。
使用例は以下の通り。

CL-USER> (every #'characterp "abc")
T
CL-USER> (every #'oddp '(1 3 5))
T
CL-USER> (every #'> '(1 3 5) '(0 2 4))
T
CL-USER> 

これをSchemeで定義してみます。もちろんオーソドックスには再帰で繰り返し構造を記述して…と言うのが手の一つですが、メンド臭いんで、高階手続きを使って以下のようなコードをでっち上げます。

(define (every pred . arg)
  (not (member #f
        (apply map pred
        (map (lambda (x)
        (cond ((string? x) (string->list x))
       ((vector? x) (vector->list x))
       (else x))) arg)))))

ポイントがいくつかあります。

1. レストパラメータ以降の引数は全て一つのリストに纏められる。


2. Schemeでリストに変換可能なデータ型(シーケンス)はR5RS範疇では文字列とベクタである。


3. 写像手続きmapは結果をリストとして返す。


4. 高階手続きapplyは最後の引数がリストであれば、何を適用しても良い。


5. 手続きmemberは第一引数が第二引数のリストに含まれてるか調べる。


6. Schemeでは空リストも含み、論理的にはリストは#tである。

繰り返しを地道に書くのはメンド臭いです。メンド臭いからこそ写像手続き、あるいは高階手続きが存在します。
論理的には上のような流れで、極めて簡単にSchemeでeveryが実装出来ます。動作も完璧ですよね。

> (every char? "abc")
#t
> (every odd? '(1 3 5))
#t
> (every > '(1 3 5) '(0 2 4))
#t
> 

ってなワケで完成しました。ロジックも穴がありません。
「動けば良い」のならこれでよい。でも、この富豪の時代ではあまり気にならないんですが(正直気にならない)このコードは実は「効率性」から言うと問題があるんです。
上のコードでは手続きmemberを用いて与えられたリスト(apply以降の計算結果)に#fが含まれるかどうか見ています。問題は「1個でも#fが見つかれば、everyと言う定義に反する」って部分なんです。
つまり、計算途中に#fが見つかればそれで既に論理的には結果は明らかに#fなんです。そして、それ以降が#tだろうが#fだろうがどーでも良いのです。しかし、上のコードは律儀に最後までリストを走査します。
もうちょっと細かくapply以降の動作を見てみましょう。

(define (engine-of-every pred . arg)
  (apply map pred
  (map (lambda (x)
  (cond ((string? x) (string->list x))
        ((vector? x) (vector->list x))
        (else x))) arg)))

;; 実行例
> (engine-of-every odd? '(1 2 3 4 5))
(#t #f #t #f #t)
> (engine-of-every > '(1 2 5) '(0 3 4))
(#t #f #t)
> 

上の実行例を見ても分かると思いますが、1つ目の例で言うとリストの2個目の要素が#fだと分かった以上、それ以降の計算は無意味です。2つ目の例でもそうですね。その時点で計算を終わらせればそれでいいのです。
こう言う場合、強制的に計算を終了させるのがcall/ccの役目で、それこそが「脱出」です。call/ccを用いればもうちょっと計算効率が上がります。

(define (engine-of-every pred . arg)
  (call/cc
   (lambda (return)
     (apply map
     (lambda x   ;ここはR5RS参照
       (or (apply pred x)
    (return #f)))  ;脱出
     (map (lambda (y)
     (cond ((string? y) (string->list y))
    ((vector? y) (vector->list y))
    (else y))) arg)))))

;; 実行例
> (engine-of-every char? "abc")
(#t #t #t)
> (engine-of-every odd? '(1 2 3 4 5))
#f
> (engine-of-every > '(1 3 5) '(0 2 4))
(#t #t #t)
> (engine-of-every > '(1 2 5) '(0 3 4))
#f
> 

実はもう殆ど完成してますね。論理的には(#t #t #t)だろうと他のリストだろうと#tです。そして、一個でも#fが見つかった時には即座に計算を終了して#fを持って脱出してます。
このように、結構高階手続きとcall/ccは相性が良いです。高階手続きを設計する際は「call/ccを使う余地が無いか?」考えてみるのが一興でしょう。
なお、上のengine-of-everyで唯一注釈が必要なのは、R5RSに記述されている次のラムダ式の記法でしょう。

<変数>: 手続きは任意個数の引数をとる。手続きが呼び出される時には，実引数の列が，一つの新しく割り付けられたリストへと変換され，そしてそのリストが<変数> の束縛に格納される。

((lambda x x) 3 4 5 6) =⇒ (3 4 5 6)

一種、ラムダ式のレストパラメータと言っても良いのですが、ラムダ式の仮引数が括弧で囲まれてない場合、与えられた引数はリストとして纏められる、と言うルールがあります。あまり有名ではないのですが、覚えておいて損はないでしょう。

実は前回のコードの継続2と言うのは単にこの脱出を行っています。
もう一回コードを再録してみます。見比べてみてください。

(define (sum n)
  (let ((tag #f))   ;タグを設定
    (let ((count 1) (result 1))  ;初期条件
      (call/cc
       (lambda (body)
  ;; 継続1。bodyはここのcall/ccの「外側」をクロージャとして表現したもの。
  ;; 具体的には上部のletから末尾までが範囲となっている。
  ;; (正確にはλ式。つまり、letの束縛された数値は捕捉対象外である。)
  ;; tagはそのまた外側なので継続1には捕捉されない。
  (set! tag body)))   ;そのbodyをtagに代入している。
      (call/cc
       (lambda (return)
  ;; 継続2。ここの継続は継続1内に捕捉されている事に注意。
  ;; 継続1の「外側」に存在しているからである。
  ;; 条件を満たした場合、継続2はresultを持って計算を脱出する。
  (and (= count n) (return result)) 
  (set! count (+ 1 count)) ;手続的計算
  (set! result (+ count result))
  ;; tagへ飛ぶ。tagは事実上一引数関数になってるのでダミー引数'()を渡してる。
  (tag '()))))))