call/ccの冒険～その1

プログラミング言語に於ける抽象化、と言うのはどう言う意味でしょうか。
抽象……。まあ、一般用語で言うと「ボンヤリとして良く分からない曖昧模糊」と言う印象があるのでは。
例えば、キャバ嬢が言う

「あのお客さんの話って抽象的で良く分かんないのよね～～。」

みたいな感じが用法でしょうか。まあ、確かにキャバ嬢相手に抽象論をするお客さんはサイテーだと思います(笑)。気をつけましょう(笑)。分かりやすい話をせんと。

とまあ、実際問題、一般生活の感覚で言うと、「抽象性＝難解」と言うニュアンスが含まれますね。「抽象的な話はどーでもいいんだ!具体的な話をしろ!」みたいに怒られる事もしばしばです。

それはさておき。

僕はフォーマルでは全くCS(Computer Science)を学んだ事が無いわけなんですけれども。
一応、僕の感覚から言うと「プログラミング言語の抽象化」と言うのは「プログラミング言語を分かりやすくする」と言うのと同義です。一般文脈の「抽象」とは丸で逆ですね。
この抽象、ってのはどのレベルから見て抽象なのか?と言うと、我々人間側から見て、ではないと思います。コンピュータハードウェアから見て、って事でしょう。逆に言うと、ハードウェアレベルでの「具体」と言うのは0と1とで構成されたバイナリ世界の事です。そして人間の思考様式に近いレベルになればなるほど「抽象」レベルが上がってくるわけです。

プログラミング言語の進化、と言うのは必ずしもCOBOL的な話ではなくって、「人間の思考形式に近づいてくる」と同義だと思います。如何に人間に分かりやすいレベルまであげてくるのか。当然ですよね。そうじゃないと「使い辛い」と言う事だから、です。
考えてみると、プログラミング言語ってのは元々「分かり辛い」ものなんです。いまだに人間が「使いやすい」ツールにはなってない。なってないからこそ他人が書いたコードは読みづらい(笑)。書くのも大変。だから色々な小手先の改良を加えられてきてる。それらはみんな「抽象化」です。

ところで、プログラミング言語設計上での色んな試み、つまり、「人間になるべく分かりやすい」設計をしよう、と頑張ってきた歴史があるわけですけど。当然人間が作るものなんで、抽象度が明後日の方向に行っちゃってるものがある。
こう言うのは「難解なものを理解したい」と言う挑戦欲は刺激しますが、一方、ツールの開発、って観点から見ると単に「失敗した」って場合もあるとは思うんですよね。「人間に分かりやすく」しようとして設計したのにそうじゃない。こう言う場合は責められるのは学んでる側じゃない。あくまで、「設計が」責められないとならないんです。本来ならね。

Schemeで悪名高いcall/cc。これは本当に悩ましいです。ある意味抽象化の失敗例としては顕著な例じゃないか、とも思えます。これを理解するのに非常に苦しみます。何だか良く分からん。
ここでは仕様書に明言されてる「脱出」に焦点を絞ってcall/ccに付いて考えてみたいと思います。

ではここで非常につまんない例題を考えてみます。

1からnまでのすべての整数を足し合わせる手続きsumを定義せよ。

多分Schemeを勉強した人では鼻歌まじりに次のようなコードを書き上げるでしょう。

(define (sum n)
  (let loop ((count 1) (result 0))
    (if (> count n)
 result
 (loop (+ 1 count) (+ count result)))))

letrec使う人もいるでしょうし、あるいはinternal defineを使う人もいるやもしれません。
いずれにせよ、基本的な繰り返しの問題ですし、Schemeでは当然の如く「再帰」で記述している筈です。基本、これ以外に手がない。
Schemeの場合は何でも再帰、って皮肉られてたりしますし、繰り返し構文であるdoで書いたとしても、結局内部では再帰に変換されてしまう。繰り返し専用の制御構造ってのが存在しないのです。

表向きは。

実は、call/ccを使うと、Schemeでも無理くり反復を行う事が出来るんです。極めて手続き型言語的発想で。
次がそのコードです。

(define (sum n)
  (let ((tag #f))
    (let ((count 1) (result 1))
      (call/cc
       (lambda (body)
  (set! tag body)))
      (call/cc
       (lambda (return)
  (and (= count n) (return result))
  (set! count (+ 1 count))
  (set! result (+ count result))
  (tag '()))))))

多分、これ見たとき

「何じゃこりゃ!汚ねえ!」

とか思うと思います(笑)。書いた僕でさえそう思うんですから(笑)。
しかし、これは手続き型言語で言う「反復」なんです。Schemeの繰り返しなのに全く再帰の「さ」の字も出てきてません。嘘みたいでしょうが、ホントです。
しかも、これはキチンと動きます。

> (sum 5)
15
> 

上記のコードは、ぶっちゃけた話、構造化プログラミング以前のgoto文での反復を行っています。つまり、call/ccは古典的なgoto文である、と言うのを、それこそ抽象論じゃなく、具体的に説明しているコードです。
なお、ポイントを二つ挙げると、

1. 一つの手続きに何個でもcall/ccはぶち込んでよい。


2. call/ccによる脱出とは単純にgotoの事である。

と言う事が見て取れます。

コメント付きで上のコードを再録してみますか。

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

一応コメントで解説試みてみたんですけど。詳細は次回(があれば)説明してみますか。
ただ、敢えて言うと、これは全く「関数型」のプログラミングではないです。
そして、call/ccの本質は「関数型言語の要素ではない」って部分なんです。Schemeの機能の中ではあらゆる意味で異質な存在だと思います。
上のコードを理解する為の一つヒントを言うと、(call/cc (lambda ...))と言う形式に惑わされない、って事でしょうかね。Fortran的な意味で言っても(もっとも僕はFortran知りませんが)、単なるgotoなんです。それがcall/ccの「正体」です。

再帰結果は束縛可能

あんま語られないんですけど、例えばこう言うコードがあるとします。

(define (multirember a lat)
  (cond ((null? lat) '())
        ((eq? a (car lat))(multirember a (cdr lat)))
        (else (cons (car lat)
                    (multirember a (cdr lat))))))

これは非常に綺麗なコードです。
実行結果は次のようになりますね。

> (multirember 'a '(a b c d a b c d))
(b c d b c d)
> 

ところで、もう一度上のコードを見てみます。

(define (multirember a lat)
  (cond ((null? lat) '())
        ((eq? a (car lat)) (multirember a (cdr lat))) ;1
        (else (cons (car lat)
                    (multirember a (cdr lat)))))) ;2

まず特徴として、

1. 分岐の木が

   cond

   により3本に分かれている。



2. (multirember a (cdr lat))

   と言うのは実は書くと長い。

の二つがあります。
実は、この2番目が再帰のポイントなんで、「記述を重複するな」と言う言い方には無理があるんですけど、要するに記述のショートカットが出来るか否か、ってのがポイントではあるんです。
んで、実は、あまり知られてないんですが、再帰結果ってのは変数に束縛出来て使いまわしが可能なんです。
コード的には次のようになりますね。

(define (multirember a lat)          
  (if (null? lat)           
      '()
      ;; (car lat)も二回出てくるんでショートフォームitとして束縛
      (let ((it (car lat))
     ;; 再帰部分もrecurと言う変数に束縛してしまう。
     (recur (multirember a (cdr lat))))
 (if (eq? a it)   ;itの使いまわし
     recur   ;recurの使いまわし
     (cons it recur)))))        ;itとrecurの使いまわし

これでも全く同じように動作します。

> (multirember 'a '(a b c d a b c d))
(b c d b c d)
> 

まあ、実際はあんま関係ないんですが、一応理論上は後者の方が若干効率が良い筈です。
と言うのも、Lisp系言語ほどコーディングスタイルが字面通り効率を表す言語は無いんじゃないか、と思われるから、です。
前者だと、例えば

(car lat)

が一々書かれていると、ホントにその場で計算される為、その計算が文字通り二回行われます。反面、2番目のコードだと、再帰に付き1回しか計算されず、その結果は即時、変数itに束縛され「使いまわされ」ます。従って若干効率が上がるんです。
再帰部分も同じですね。結局「結果」が欲しいだけですし、その計算自体は全く同じ、なんで、実はコード内に律儀に2回書く必要はないのです。

この様に、分岐が3段階以上に分かれて、かつ、再帰部分のコード自体は「全く同じ」場合は、試しに局所変数として束縛しちゃうのがお薦めです。

注:ちなみにcall/ccを用いて、

(define (multirember a lat)
  (call/cc
   (lambda (k)
     (let ((it (car (if (null? lat)
   (k '())
   lat)))
    (recur (multirember a (cdr lat))))
       (if (eq? a it)
    recur
    (cons it recur))))))

と言う書き方も可能です。
元々、'()的な記述が必要なのは、Schemeが述語に関して#t、#fを返す、と言うメンド臭い仕様になってるから、ですが、上記の方法だと、一応コード本体の分岐の木は二本で済みます。
ANSI Common Lispだと、

(defun multirember (a lat)
  (and lat
      (let ((it (car lat))
     (recur (multirember a (cdr lat))))
 (if (eq a it)
     recur
     (cons it recur)))))

ともうちょっとシンプルに書けますね。

幸せになれる結婚年齢が分かるプログラム

#! /usr/bin/env mzscheme
#lang scheme

(define (marrage-year)
  (display "貴女が幸せになれる結婚年齢を導き出すお手伝いをさせて頂きます\n")
  (first-step))

(define (first-step)
  (display "お好きな二桁の数字を入力してください : ")
  (let ((num (read)))
    (cond ((or (not (integer? num)) (< num 10) (> num 99))
    (display "入力値が違います。\n")
    (first-step))
   (else
    (second-step num)))))

(define (second-step num)
  (for-each display (list "入力された数値は " num " です。\n"))
  (let ((b (modulo num 10)))
    (let ((a (/ (- num b) 10)))
      (let ((ans (+ a b)))
 (display "一の位と十の位を足した数を入力してください : ")
 (let ((n (read)))
   (cond ((not (eqv? n ans))
   (display "計算が間違っています。\n")
   (second-step num))
  ((> n 9)
   (display "もう一度一の位と十の位を足します。\n")
   (second-step n))
  (else
   (third-step n))))))))

(define (third-step num)
  (for-each display (list "入力された数値は " num " です。\n"))
  (let ((ans (* num 9)))
    (display "出てきた答えに9をかけて入力してください。 : ")
    (let ((n (read)))
      (cond ((not (eqv? n ans))
      (display "入力値が間違っています。\n")
      (third-step num))
     (else
      (fourth-step n))))))

(define (fourth-step num)
  (for-each display (list "入力された数値は " num " です。\n"))
  (let ((b (modulo num 10)))
    (let ((a (/ (- num b) 10)))
      (let ((ans (+ a b)))
 (display "出てきた答えの一の位と十の位を足してください。 : ")
 (let ((n (read)))
   (cond ((not (eqv? n ans))
   (display "計算が間違っています。\n")
   (fourth-step num))
  (else
   (fifth-step n))))))))

(define (fifth-step num)
  (for-each display (list "入力された数値は " num " です。\n"))
  (display "出てきた答えに今までの男性経験人数を足して入力して下さい。 : ")
  (let ((n (read)))
    (cond ((or (not (integer? n)) (negative? n) (< n num))
    (display "入力値が間違っています。\n")
    (fifth-step num))
   (else
    (for-each display (list "貴女の男性経験数は " (- n 9) " 人です。\n"))))))

(marrage-year)

Project Lizardry ～その1～

#!/usr/bin/env mzscheme
#lang scheme/base

(require srfi/1)

;; データ
(define *gilgamesh-tavern-data* '())

(define *party* '())

;; キャラクター基本
(define *character-base*
  '(('foe . #f)
    ('level . #f)
    ('性格 . #f)
    ('職業 . #f)
    ('種族 . #f)
    ('E.P. . #f)
    ('Next . #f)
    ('Gold . #f)
    ('Marks . #f)
    ('Age . #f)
    ('A.C. . #f)
    ('Rip . #f)
    ('力 . #f)
    ('知恵 . #f)
    ('信仰心 . #f)
    ('生命力 . #f)
    ('素早さ . #f)
    ('運の強さ . #f)
    ('H.P.numerator . #f)
    ('H.P.denominator . #f)
    ('状態 . #f)
    ('Mage 0 0 0 0 0 0 0 0 0)
    ('Priest 0 0 0 0 0 0 0 0 0)
    ('持ち物 . '())))

(define *race* '((人間 ((力 . 8)
                        (知恵 . 8)
                        (信仰心 . 5)
                        (生命力 . 8)
                        (素早さ . 8)
                        (運の強さ . 9)))
                 (エルフ ((力 . 7)
                          (知恵 . 10)
                          (信仰心 . 10)
                          (生命力 . 6)
                          (素早さ . 9)
                          (運の強さ . 6)))
                 (ドワーフ ((力 . 10)
                            (知恵 . 7)
                            (信仰心 . 10)
                            (生命力 . 10)
                            (素早さ . 5)
                            (運の強さ . 6)))
                 (ノーム ((力 . 7)
                          (知恵 . 7)
                          (信仰心 . 10)
                          (生命力 . 8)
                          (素早さ . 10)
                          (運の強さ . 7)))
                 (ホビット ((力 . 5)
                            (知恵 . 7)
                            (信仰心 . 7)
                            (生命力 . 6)
                            (素早さ . 10)
                            (運の強さ . 15)))))

;; テキスト部分
(define *top-page-text*
  "\t Lizardry\n\n      Proving Grounds\n\t    of\n     the Let Over Lambda\n\n\tWelcome to\n  the world of Lizardry\n\n\t1. START\n\t2. READ STORY\n")

(define *story-text*
  '("昔々あるところにラムダ王国と言う平和な国があった。ラムダ王国の平和はラムダ騎士団によって守られていた。\n\nラムダ騎士団のリーダーは紫導師と呼ばれるハッカーだった。ラムダ騎士団は紫導師の指導の下、日々鍛錬を重ねていた。\n\nそんなある日、城壁のそばに転がっていた古びたSymbolicsの中に迷宮を作って住み着く邪悪なニシキヘビが、紫導師の寝室に忍び込み、熟睡中の紫導師の耳元で悪魔の言葉を大阪弁で囁いた。\n\n「今更マクロなんて流行りまへんがな。時代は豊富な組み込みライブラリでっせ、旦那。」\n\nこの言葉は呪詛となり、あろう事か紫導師はニシキヘビと共に電脳迷宮の奥深くへと消えて行った。\n\n"
    "紫導師の突然の失踪は即ラムダ騎士団の弱体化に繋がった。リーダーを失ったラムダ騎士団はもはや烏合の衆と成り果て、ラムダ王国は存亡の危機へと陥った。\n\n事態を重く見たラムダ国王はラムダ騎士団の立て直しを図り、世界に散らばった逸材を発掘するため、ある召集を行った。\n\n「我らが偉大な王、ラムダ国王の召集である。皆の者、心して聞くように。元主席ハッカー紫が、ニシキヘビの陰謀に嵌り連れ去られてしまった。ニシキヘビは勝手に町外れに転がっている中古のSymbolicsの電脳世界に迷宮を掘り、モンスターを離して立てこもっておるのだ。かの悪逆非道のニシキヘビを成敗し、紫導師を救い出すのだ!さすれば、ラムダの騎士の称号とラムダ騎士団への入隊、更には多額の賞金が贈られるであろう!ポール・グレアムも実はそうやって金を稼いだのだがそれは内緒にしててね!!」\n\nこの召集に、ラムダ王国だけではなく、各地からあらゆる種族のハッカー達が集まった。金に困る者、己の腕を磨こうとする者たちが次々に名乗りをあげる。ラムダの騎士の名誉と一攫千金を夢見て・・・。\n\n"))

(define *castle-text*
  "\t        キャッスル:\n\n\t1. ギルガメッシュないとの酒場\n\t2. ハッカーの宿\n\t3. ボッタクル商店\n\t4. カント寺院\n\t5. 街外れに行く\n")

(define *gilgamesh-tavern-text*
  "\t        キャッスル:\n\n\t1. 仲間に入れる\n\t2. 仲間から外す\n\t3. 調べる\n\t4. ゴールドの山分け\n\t5. 外へ出る\n")

(define *edge-of-town-text*
  "\t        街外れ:\n\n\t1. 迷宮に入る\n\t2. 冒険の再開\n\t3. 訓練場に行く\n\t4. ゲームの中断\n\t5. 城に戻る\n")

(define *leave-game-text*
  "\tお疲れ様でした。\nこの状態でゲームを終了します。\n\n\tAで冒険を再開します\n")

;; マクロ
(define-syntax character-making
  (syntax-rules ()
    ((_ name alist)
     (define name
       (alist-copy alist)))))

;; 実行部分

(define (top-page scenario)
  (display scenario)
  (newline)
  (display "コマンド? >> ")
  (let ((key (read)))
    (case key
      ((1) (castle *castle-text*))
      ((2) (story-reader *story-text*))
      (else (top-page scenario)))))

(define (story-reader scenario)
  (do ((ls scenario (cdr ls))
       (key #f (read)))
      ((null? ls) (top-page *top-page-text*))
    (display (car ls))))

(define (castle scenario)
  (display scenario)
  (newline)
  (display "コマンド? >> ")
  (let ((key (read)))
    (case key
      ((1) (gilgamesh-tavern *gilgamesh-tavern-text*))
      ((2) (adventurer-inn))
      ((3) (boltac-trading-post))
      ((4) (temple-of-cant))
      ((5) (edge-of-town *edge-of-town-text*))
      (else (castle scenario)))))

(define (gilgamesh-tavern scenario)
  (display scenario)
  (newline)
  (display "コマンド? >> ")
  (let ((key (read)))
    (case key
      ((1) (add-character))
      ((2) (remove-character))
      ((3) (inspect-character))
      ((4) (divvy-gold))
      ((5) (castle *castle-text*))
      (else (gilgamesh-tavern scenario)))))

(define (add-character) (display "工事中\n"))
(define (remove-character) (display "工事中\n"))
(define (inspect-character) (display "工事中\n"))
(define (divvy-gold) (display "工事中\n"))

(define (adventurer-inn)
  (display "工事中\n"))

(define (boltac-trading-post)
  (display "工事中\n"))

(define (temple-of-cant)
  (display "工事中"))

(define (edge-of-town scenario)
  (display scenario)
  (newline)
  (display "コマンド? >> ")
  (let ((key (read)))
    (case key
      ((1) (maze))
      ((2) (restart-an-out-party))
      ((3) (training-grounds))
      ((4) (leave-game *leave-game-text*))
      ((5) (castle *castle-text*))
      (else (edge-of-town scenario)))))

(define (maze) (display "工事中\n"))
(define (restart-an-out-party) (display "工事中\n"))
(define (training-grounds) (display "工事中\n"))

(define (leave-game scenario)
  (display scenario)
  (newline)
  (display "コマンド? >> ")
  (let ((key (read)))
    (if (eqv? key 'a)
        (edge-of-town *edge-of-town-text*)
        (exit))))

(define (inheritance key datum)
  (lambda (alist)
    (let ((ls (alist-delete key (alist-copy alist))))
      (alist-cons key datum alist))))

(top-page *top-page-text*)

MoeMacsってこう言う感じかこの野郎。

イメージとしてはこう言う感じなんですかね。イメージだけ、ですけれども。


Twittering-modeはこんな感じになっている。