How To Become A Hacker: 1月 2010

2010年1月26日火曜日

2010年1月25日月曜日

殆ど元祖オブジェクト指向言語と言えばSmalltalk(注1)。Smalltalkを知らずしてオブジェクト指向言語を語るなかれ(注2)。

とまあ、(一部識者には)言われているSmalltalkなんですが。
Ubuntu9.10でも、このSmalltalkの末裔が配布されています。

その名もSqueak。

このSmalltalk自体がLispとの関係も深いみたいで「いつかやってやろう」とか思ってたんですが、上の画面写真見れば分かる通り、殆どプログラミング言語の体裁を取っていないのです。
「何じゃこりゃ???」
と初見でビックリするのは間違いない。

実際問題、これって仮想マシンなんですよね。
インターフェース的に言うと、オリジナルのMacが影響受けた、ってのもなるほどね、ってくらい、Macintoshのインターフェースに酷似しています。クローズボタンが左にあったり(笑)。
いやいや、これはなかなか大変そうです。事実上OSのようなモンです(注3)。

さて、オブジェクト指向嫌いの僕だったんですけど、Squeakと仲良く出来るか否か。
激しく不安です(笑)。

注:

ホントは違います。

とか言うと、Javaユーザーがうるせえだろうなあ(苦笑)。

殆どOSです。Smalltalkを開発したXeroxは、この後、Interlisp-Dと言うLispマシンを作ったりしたんで、この辺、互いに影響があるのかもしれません。

2010年1月23日土曜日

マクローリン展開でsin関数

元ネタは上記リンクから。
Common Lispで、デフォルトで10項までの和、としています。
さすが収束率が良いのか、結構良い精度では、とか思います。


;; お馴染み階乗関数
(defun fact (x &optional (acc 1))
  (if (zerop x)
      acc
      (fact (1- x) (* x acc))))

(defun mc-sin (x &optional (n 10) (acc 0))
  ;; flet でローカル関数 rec を束縛
  (flet ((rec (n)
    (let ((m (+ 1 (* 2 n))))
      (/ (* (expt -1 n) (expt x m))
  (fact m)))))
    ;; 後は再帰
    (if (< n 0)
 acc
 (mc-sin x (1- n) (+ (rec n) acc)))))

実行結果は以下の通り。


CL-USER> (mc-sin 0)
0
CL-USER> (mc-sin (/ pi 6))
0.49999999999999994d0
CL-USER> (mc-sin (/ pi 2))
1.0d0
CL-USER>

Common Lispの組み込み関数のsinもこんな感じですからね。


CL-USER> (sin 0)
0.0
CL-USER> (sin (/ pi 6))
0.49999999999999994d0
CL-USER> (sin (/ pi 2))
1.0d0
CL-USER>

まあ、こんなモンでしょう。

Common Lisp でFizzBuzz

今更ながらFizzBuzzでも無いんですが、上記リンクで極短のRubyでのコードが紹介されていたんで、構造をCommon Lispでエミュレートしてみました。


(loop for i from 1 to 30
     do (format t "~A~%"
  (let ((s (concatenate
     'string
     (nth (mod i 3)
          '("Fizz"))
     (nth (mod i 5)
          '("Buzz")))))
    (if (zerop (length s))
        i
        s))))

ただ、正直な感想を言えば、ある意味これは文字通りハックだな、と思いました。
そもそも、配列(あるいはリスト)の要素数を越えたトコでアクセサが作用するとnilが返る、と言う仕様じゃないと書き得ないコードです。
Schemeなんかではエラー扱いになりますが、Cだったらどうなるでしょうね。考え出すと恐ろしくて夜も眠れません。
ある意味、Rubyの仕様が良く分かってる、と言う意味では素晴らしいとは思いましたが、同時に普遍的に使えるテクニックではない辺りが残念ではあります。

2010年1月21日木曜日

規約分数クイズ

元ネタは上記リンクから。
Common Lispで実装してみます。


(defun irreduciblefracs (n)
  (labels ((iter (p q lst)
      (if (= p q n)
   (mapcar #'(lambda (x)
        (apply #'/ x))
    (reverse lst))
   (iter (if (= p q)
      0
      (1+ p))
         (if (= p q)
      (1+ q)
      q)
         (if (= (gcd p q) 1)
      (cons `(,p ,q) lst)
      lst)))))
    (iter 0 1 nil)))

これはScheme臭くて嫌だ、って場合は次のようにしても良いかも。


(defun irreduciblefracs (n)
  (do ((p 0 (if (= p q)
  0
  (1+ p)))
       (q 1 (if (= p q)
  (1+ q)
  q))
       (lst nil (if (= (gcd p q) 1)
      (cons `(,p ,q) lst)
      lst)))
      ((= p q n)
       (mapcar #'(lambda (x)
     (apply #'/ x))
        (reverse lst)))))

いずれにしても、動作は次のようになります。


CL-USER> (irreduciblefracs 4)
(0 1 1/2 1/3 2/3 1/4 3/4)
CL-USER>

平均値順にソート

元ネタは上記リンクから。
Common Lispで書いてみる。


(defmacro avg (lst)
  `(/ (apply #'+ ,lst)
      (length ,lst)))

(defun avg-sort (lst)
  (let ((a (avg lst)))
    (sort (copy-list lst)
   #'(lambda (x y)
       (or 
        (< (abs (- x a))
    (abs (- y a)))
        (< x y))))))

平均を計算する関数はANSI Common Lispには何故か存在しないので、ポール・グレアム的示唆により、マクロとして定義します。
後は、インチキっぽいんですが、Perlよりも短く仕上がってるとは思います。本当にズルいんだけどね!!!
実行例は以下の通り。


CL-USER> (avg-sort '(4 2 1 3))
(2 3 1 4)
CL-USER>

2010年1月17日日曜日

PLT で macroexpand


(module macroexpand scheme
  
  (provide (all-defined-out))

  (define (macroexpand arg)
    (syntax->datum (expand arg)))

  (define (macroexpand-1 arg)
    (syntax->datum (expand-once arg)))

  )

2010年1月16日土曜日

言語仕様の基礎を覚える

さて、やさしいEmacs‐Lisp講座の第2講、です。
章末には前回の記事で扱ったコードの改訂版が紹介されています。


;; -*- Emacs-Lisp -*-
;; るねきちモード Version 1 by りう, fixed by lune
(defvar lune-mode-map (make-keymap))
(let ((key ?a))
  (while (<= key ?z)
    (define-key lune-mode-map (char-to-string key) 'i-am-lune)
    (setq key (+ 1 key))))

(defun lune-mode ()
  "るねきちモードだよー!"
  (interactive)
  (setq major-mode 'lune-mode)
  (setq mode-name " るねきちモード ")
  (use-local-map lune-mode-map))

(defun i-am-lune ()
  (interactive)
  (insert " 僕るねきちナリ "))

同書には次のようなポイントが示されていました。

文字指定にはアスキーでの番号を直接指定するよりは?<任意のアルファベット>と言う形で文字コードを指定した方が良い。

keyと言う形でいきなり変数指定をすると、それは大域変数として解釈されてしまうので名前空間を汚してしまう。letを使って局所変数として宣言した方が良い。

との事です。

ただ、上のコードはちょっと気になる点があるんですよね。
それはこの部分です。


(let ((key ?a))
  (while (<= key ?z)
    (define-key lune-mode-map (char-to-string key) 'i-am-lune)
    (setq key (+ 1 key))))

こんなトコでむき出しのletなんて使うだろうか・・・?
いや、やってる事は分かりますし、理論的な問題はありません。要するに単に「スタイルとしての」問題なんですよね。CLerもSchemerもこんな形でむき出しの局所変数宣言なんてしないのでは・・・?
これは、恐らく、C言語とかやってきた人の「手癖」なんですよね。Cでソース内で変数宣言する場合、スタイル的にはこう言う形にならざるを得ないでしょうから。C的には分かる。そして、だからこそ、このスタイルで変数宣言を行うとネストが深くなってしまわざるを得ない辺りでLispが嫌われるのでしょう。

CLerもSchemerも同様の事をやりたい場合は、恐らく高階関数なり手続きなりを用いると思います。
それでここで注釈。
関数define-keyは本当に関数です。
つまり、冒頭にdefineなんて付いてる為、ついつい脊髄反射的に「マクロ」であるとか、「特殊形式」っぽく捉えちゃいそうになりますが、そーじゃなくって、単なる関数です。
従って、基本的に高階関数で適用されるべきものはdefine-keyです。変なカンジが拭えませんが、そう言う事です。紛らわしいですね(笑)。

(require 'cl)を用いてもうちょっとCLerなりSchemerが納得しやすいコードは以下のようになるでしょう。


;; -*- Emacs-Lisp -*-
;; cametan-mode Version 1
(require 'cl)

(defvar *cametan-mode-map* (make-keymap))

(mapcar #'(lambda (x)
     (define-key *cametan-mode-map*
  (char-to-string x) 'i-am-cametan))
 (loop for key from ?a to ?z collect key))

(defun cametan-mode ()
  "This is cametan-mode!"
  (interactive)
  (setf major-mode 'cametan-mode
 mode-name "cametan-mode")
  (use-local-map *cametan-mode-map*))

(defun i-am-cametan ()
  (interactive)
  (insert " I am cametan "))

剥き出しのletを使うより、こっちの方がCLerやSchemerは納得しやすいでしょう。
ポイントは

写像関数mapcarを用いて

無名関数ラムダ式を

loop ～ collectで作り出した文字コードのリストへ写像する

です。
前回ではSRFI-1のiotaみたいな機能をわざわざ書きたくない、メンド臭い、ってバッサリ切り捨てましたが(笑)、今回は文字コードのリストを使う為、collectキーワードを使っています。
まあ、こう言う使い方をする以上は悪名高いloop構文も大した事ないわけですよ。むしろ、Pythonのリスト内包表記程度、には軟弱に使えます(笑)。

っつーわけで、第2講章末問題のお題。

【問】前問「るねきちモード」を以下のように改良した「るねきちモードII」を作成せよ。

a～zの押すキーに対応して「るねきちAナリ」～「るねきちZナリ」を挿入するように変更せよ。

さらに、a～zどれか1つのキーを押すと画面を3回フラッシュし、「自爆」というメッセージを表示して、バッファの内容を消去する機能を付け加えよ。バッファ内容を消去する関数は(erace-buffer)である。

やさしいEmacs‐Lisp講座の模範回答は以下の通りです。


;; -*- Emacs-Lisp -*-
;; るねきちモード Version 2 by lune
(defvar lune-mode-map (make-keymap) " るねきちモードのキーマップ ")
;; とりあえず a ～ z までのキーマップ
(let ((key ?a))
  (while (<= key ?z)
    (define-key lune-mode-map (char-to-string key) 'lune-i-am)
    (setq key (+ 1 key))))

;; 乱数で自爆キーを決めるぞー
(let* ((jibaku (random 26))  ;0～25の乱数
       (key (char-to-string (+ ?a jibaku))))
  (define-key lune-mode-map key 'lune-jibaku))

;; ここから本体
(defun lune-mode ()
  "るねきちモードだよー!"
  (interactive)
  (setq major-mode 'lune-mode
 mode-name " るねきちモード ")
  (use-local-map lune-mode-map))

(defun lune-i-am ()   ;パッケージ共通の接頭辞を持つように
  (interactive)    ;変えてみた
  (insert (format " るねきち%sナリ "(this-command-keys))))

(defun lune-jibaku ()
  "自爆関数"
  (interactive)
  (let ((visible-bell t))
    (ding)
    (sleep-for 1)
    (ding)
    (sleep-for 1)
    (ding)
    (sleep-for 1)
    (erase-buffer)
    (message "自爆!")))

見慣れない関数等は以下の通り。

format(関数:ANSI Common Lispのそれとちょっと違う。)

visible-bell(ユーザ・オプション)

ding(関数)

sleep-for(関数)

やっぱコーディングスタイルが見慣れないので、(require 'cl)組み入れて書き直してみたいと思います。
(それはそれで問題発覚。後述。)


;; -*- Emacs-Lisp -*-
;; cametan-mode Version 2
(require 'cl)

(defvar *cametan-mode-map* (make-keymap) "keymap of cametan-mode")

;; 自爆キーの設定
(defvar *jibaku* nil)   ;大域変数 *jibaku* の初期値
;; setf で *jibaku* を乱数を使って再定義しなおすと
;; バッファが評価される度に値が更新される
(setf *jibaku* (+ ?a (random 26)))

;; a ～ z　までdefine-key
(mapcar #'(lambda (x)
     (define-key *cametan-mode-map*
  (char-to-string x)
       (if (char-equal x *jibaku*)
    'cametan-jibaku
    'cametan-i-am)))
 (loop for key from ?a to ?z collect key))

;; ここから本体
(defun cametan-mode ()
  "This is cametan-mode!"
  (interactive)
  (setf major-mode 'cametan-mode
 mode-name "cametan-mode")
  (use-local-map *cametan-mode-map*))

(defun cametan-i-am ()   ;パッケージ共通の接頭辞を持つように
  (interactive)    ;変更
  (insert (format " I am cametan %s " (this-command-keys))))

(defun cametan-jibaku ()
  "自爆関数"
  (interactive)
  (dotimes (n 3 (progn (erase-buffer)
         (message "自爆!")))
    (let ((visible-bell t))
      (ding)
      (sleep-for 1))))

修正ポイントは以下の通りです。

自爆キーが何になるか、は大域変数として決めた方がスッキリとするのでは?

これはまあ、そのまんま、です。
オリジナルのコードで変数jibakuをローカル変数として定義したのは、恐らく、変数名とするkeyが被らないようにする為だけではないか、と。
それだけに見えますね。let*なんて持ち出さなくても、大域変数として*jibaku*を定義しちゃった方が、構造的には簡単に思えます。

define-keyを二度も使ってkey-mapを一々変更するのはムダ

基本構造的には、改良版のmapを使ったヴァージョンと同じです。
ただし、束縛されるべき関数名を大域変数*jibaku*を利用した条件分岐で分けています。それだけ。
この手の処理は一回で済ませられるのなら済ましてしまえ、って事ですね。

繰り返し回数が分かっていて、副作用を利用する場合はdotimesが便利

Schemeやってると何でもかんでも再帰で書きたくなりますが、一方、例えば入出力系なんかの副作用が絡むと、意外と再帰ではコードが「汚れて」しまいます。
適材適所の発想で、こう言う場合はdo系の構文に切り替えた方が得策だと思います。doの本体部は暗黙のprogn(あるいはbegin)がありますし、副作用系は特に無造作に放り込んでおけます。
この例のように、繰り返し回数があらかじめ分かってる場合、dotimesが便利です。
また、実際、これは(僕の基準では)ちょっと複雑なので、loop構文だと大掛かりになって適さないのでは、とか思います。
```
;; loop を使って書き直してみた自爆関数の例
;; コード的には dotimes に比べると
;; 大げさに見える
(defun cametan-jibaku ()
  "自爆関数"
  (interactive)
  (loop repeat 3
     do (let ((visible-bell t))
   (ding)
   (sleep-for 1))
     finally (progn (erase-buffer)
      (message "自爆!"))))
```

Emacs Lispのding関数の動きが良く分からん

もうそのまんま、です。
そもそもvisible-bellってのが変数っぽい辺りが良く分からず、それが成立しているスコープの範囲内じゃないと(ding)が動かない、と言う良く分からん仕様になってるんですね。
オリジナルのコードは同じ関数を3回も記述していて、感覚的には非常に見づらいんですが、こう言う厄介な仕様を含んでいる為、敢えてああ言う書き方を選んだのでしょう。多分。

とまあ、今回はこんなカンジですかね。

2010年1月15日金曜日

メジャーモードを作ろう!

以前からEmacs Lispに興味があったわけですけど、やっと勉強をはじめたい、と思います。

Lispで実用的なプログラムを書くのは、識者の意見はともかくとして、非常に難しい、と言う事が分かってきました。
現時点では、一般的な感覚で言うと、

実用的なプログラム＝GUIでのプログラム

って事なのです。
はいそこ。逆らわない。識者、あるいはハッカーの「極端な」意見なんてどーでも良い、のです。
如何に素晴らしいプログラムが書けようと、コマンドラインのプログラムだったら

「何じゃこりゃ?」

って言われるのがオチ、です。
そして、プログラムは「広く使ってもらわなければ」意味が無いのです。

一般に、マジメなプログラミングの勉強として考えると、Emacs Lispは避けられる傾向があります。
と言うのも、現代的なLispではないので、動的スコープしか持ってません。
しかし、GUIがどーの、って話で考えてみると、既にEmacsは「膨大な」フレームワークを内包している。自分で一から作らなくて良い。
本来の「Emacs拡張用言語」の枠組みを超えて、古き良きBASIC的プログラミング言語として楽しむのなら、依然としてEmacs Lispは強力でしょう。何せ、元々、OSから浮きまくってるEmacsは、まさしく「環境」として捉えられるので、一種の仮想マシンとして考えられるから、です。
ゲームなんかでも、GUIをLispで一から組み上げるのは大変そうですが、一方、Emacs上なら実現は簡単ぽく思えます。
この際、出来たものがショボくてもそれは問題じゃあないのです。昔のApple II的なプログラミングは、Emacs上でこそ実現すべきじゃないのか。そんな事を思っている、のです。
Emacsは21世紀のApple IIになるべきだ、とさえ思っています。

と言うわけで、やさしいEmacs‐Lisp講座の章末問題を中心にしてメモって行きたいと思います。

【問】a～zのどのキーを押しても"僕るねきちナリ"が挿入される「るねきちモード」を作成せよ。

やさしいEmacs‐Lisp講座で紹介されている模範回答例は以下のものです。


;; -*- Emacs-Lisp -*-
;; るねきちモード Version 0 by ゆう
(defvar lune-mode-map (make-keymap))

(defun lune-mode ()
  "るねきちモードだよー!"
  (interactive)
  (setq major-mode 'lune-mode)
  (setq mode-name " るねきちモード ")
  (setq key 97)
  (while (<= key 122)
    (define-key lune-mode-map (char-to-string key) 'i-am-lune)
    (setq key (+ 1 key)))
  (use-local-map lune-mode-map))

(defun i-am-lune ()
  (interactive)
  (insert " 僕るねきちなり "))

多分、Schemeやってる人は相当違和感覚えるコーディングスタイルなんですよね、これは(笑)。
最近では、S式でのプログラミング＝関数型プログラミング、って解釈される傾向があるんで、かなり違和感を覚えるスタイルです。基本S式を並べただけで、やってることはC言語的な「手続き型」のプログラミングです。
ただ、いわゆるScheme型のプログラミングとは違い、ネストが浅いんで、「見やすい」とは言えますね。この辺敷居が高くないんで、Emacs Lispプログラミングを愛好する人が多いのでしょうか(一般に、関数型プログラミングスタイルを徹底すればするほど、ネストが深くなっていく傾向がアリ)。
また、結構馴染みが無い関数名も多いです。この辺はEmacsと言うテキストエディタと「密接な」関係にあるEmacsならでは、ですよね。
馴染みが無い関数をリファレンスにリンク貼っておきましょうか。

make-keymap(関数)

interactive(特殊形式)

while(特殊形式)

define-key(関数)

char-to-string(関数)

use-local-map(関数)

insert(関数)

ブログって便利だな(笑)。メモ取るのにリンクするだけで済むし。
何で今までこう言うのを効率的に使わなかったのかしら。

ソースコードを見ると、どれが大域変数でどれが局所変数なのか、つい考え込んでしまいます。
でもダイナミックスコープのLispなんで関係無いんですがね(爆)。
しかし、どれが既存の変数でどれが新規に作った変数なのか分かり辛いのは確か、です。
*scratch*バッファで調べた結果、major-modeとmode-nameってのが既存の変数ですよね。よって、これらは特に名前自体を変更する事は出来ないでしょう。
しかしながら、mode-map関連のはいわゆる自由な大域変数なのかな?CLでは明示的な大域変数宣言では、*(スター)で変数名を挟む、と言う命名規約があります。

ところで、最近のelispファイルを見ると、冒頭で(require 'cl)と書いているケースが多い、です。
これはEmacs Lispでもうちょっと現代的なCommon Lispの機能を使える為のオマジナイです。
これを使ってお題のコードをもうちょっと現代的に書き直してみたいと思います。


;; -*- Emacs-Lisp -*-
;; cametan-mode Version 0
(require 'cl)

(defvar *cametan-mode-map* (make-keymap))

(defun cametan-mode ()
  "This is cametan-mode!"
  (interactive)
  (setf major-mode 'cametan-mode
 mode-name "cametan-mode")
  (loop for key from 97 to 122
       do (define-key *cametan-mode-map* (char-to-string key) 'i-am-cametan)) 
  (use-local-map *cametan-mode-map*))

(defun i-am-cametan ()
  (interactive)
  (insert "I am cametan"))

大分現代的なCLっぽいコードになったと思うんですけど。

第一に、そもそも、古いLispと違って、Emacs Lispでもsetq一つで複数の変数をバインドできると思うんですけど。
複数setqを書きまくるのもアレなんで、纏めた方が良い、と思いました。
ここでは、(require 'cl)を用いて、setqの代わりにsetfを用いています。

第二に、原版のコードでは(setq key 97)としてからwhile使ってdefine-keyでキーを定義、(setq key (+ 1 key))してバインドしてますが、CLerだったらloop使って済ます気がします。
ここ、ですよね。


  (loop for key from 97 to 122
       do (define-key *cametan-mode-map* (char-to-string key) 'i-am-cametan))

Schemerだったら高階手続きであるmapで同様の処理をしたいトコでしょうけど、そもそもSRFI-1のiota辺りが無いと辛い。最初に転写されるリストを生成しなきゃなりませんので。
また、キーに機能を保持させる以上、要請は「破壊的作用」を伴います。その要点を最初からクリアするなら、CL的な「破壊的な繰り返し」を用いた方がベターだ、と言う判断ですね。
こう言う場合、意外とCLのloopは短く書けて便利です。

バッファを評価したあと、M-x cametan-modeで動作を確認する事が出来ます。

2010年1月12日火曜日

Ubuntu9.10はスリープから復帰すると音が出ない

Ubuntu9.10は一旦スリープして、それを解除して使い始めると、音が出ない、と言うバグがあります。
いっつも思うんですが「今まで問題が生じなかった」のに、ヴァージョン上がって問題が出ると腹が立つものです。
僕の場合は、OS「自体」にさほど興味が無いんで、どっちかというとLTSが良けりゃあ、LTSを二年間くらい使いつづけたいタイプなんです。ホントUbuntuのLTSには「安定した」OSになって欲しいものですね。

Ubuntuの本家コミュニティでは、このバグに対して、次のような解決策を提示していました。

sudo gedit /etc/init.d/alsa-utilsとしてalsaの設定ファイルを開く。


f a card identifier is provided in $2 then regard it as an error
# if that card is not present; otherwise don't regard it as an error.

case "$1" in
  start)
 EXITSTATUS=0
 TARGET_CARD="$2"
 case "$TARGET_CARD" in
   ""|all) TARGET_CARD=all ; log_action_begin_msg "Setting up ALSA" ;;
 esac
 if ! card_OK "$TARGET_CARD"; then
  [ "$TARGET_CARD" = "all" ] && log_action_end_msg "$( [ ! "$2" ] ; echo $? ; )" "none loaded"
  exit $?
 fi
 preinit_levels "$TARGET_CARD" || EXITSTATUS=1
 if ! restore_levels "$TARGET_CARD" ; then
  sanify_levels "$TARGET_CARD" || EXITSTATUS=1
  restore_levels "$TARGET_CARD" >/dev/null 2>&1 || :
 fi
 [ "$TARGET_CARD" = "all" ] && log_action_end_msg_and_exit "$EXITSTATUS"
 exit $EXITSTATUS
 ;;
  stop)
 EXITSTATUS=0
 TARGET_CARD="$2"
 case "$TARGET_CARD" in
   ""|all) TARGET_CARD=all ; log_action_begin_msg "Shutting down ALSA" ;;
   *) log_action_begin_msg "Shutting down ALSA card ${TARGET_CARD}" ;;
 esac
 card_OK "$TARGET_CARD" || log_action_end_msg_and_exit "$( [ ! "$2" ] ; echo $? ; )" "none loaded"
 store_levels "$TARGET_CARD" || EXITSTATUS=1
 mute_and_zero_levels "$TARGET_CARD" || EXITSTATUS=1
 log_action_end_msg_and_exit "$EXITSTATUS"
 ;;
  restart|force-reload)
 EXITSTATUS=0
 $0 stop || EXITSTATUS=1
 $0 start || EXITSTATUS=1
 exit $EXITSTATUS
 ;;
  reset)
 TARGET_CARD="$2"
 case "$TARGET_CARD" in
   ""|all) TARGET_CARD=all ; log_action_begin_msg "Resetting ALSA" ;;
   *) log_action_begin_msg "Resetting ALSA card ${TARGET_CARD}" ;;
 esac
 card_OK "$TARGET_CARD" || log_action_end_msg_and_exit "$( [ ! "$2" ] ; echo $? ; )" "none loaded"
 preinit_levels "$TARGET_CARD"
 sanify_levels "$TARGET_CARD"
 log_action_end_msg_and_exit "$?"
 ;;
  *)
 echo "Usage: $MYNAME {start [CARD]|stop [CARD]|restart [CARD]|reset [CARD]}" >&2
 exit 3
 ;;
esac

の32行目の


mute_and_zero_levels "$TARGET_CARD" || EXITSTATUS=1

をコメントアウトして


#mute_and_zero_levels "$TARGET_CARD" || EXITSTATUS=1

とする。

ファイルを保存する。

本家フォーラムではこれで問題が解決する、と言ってましたが・・・。
果たして!?

2010年1月11日月曜日

Decorating With Style!

私たちのアプリは機能的には完璧なんですが、見た目がショボいです。そこで外観を改良しましょう。一つの方法はキャスケーディング・スタイル・シートを使う事です。スタイル・シートはwebページの見た目を良くします。例えば、段落全てを緑色にしたい場合、レスポンスを変更する為に以下のスタイル宣言を追加します。


'(style ((type "text/css")) "p { color: green }")

html-responseにこのスタイル情報を直接埋め込んでも結構です。しかしながら、ソースファイルは既にかなりゴチャゴチャしてきています。そこでしばしば、アプリの論理表現を表示部分から切り離すことをします。HTMLレスポンス部分に.cssを直接埋め込む代わりに、分離した.cssファイルへとリンク指定を行うのです。

今までは、webアプリのコンテンツの全ては、レスポンス生成ハンドラによって生成されてきました。もちろん、全てが動的に生成される必要はありません:変更の必要がないファイル内の共通部分がある筈です。つまり、これら静的リソース(写真、文章、.cssファイルなど)をwebアプリとはまた別に提供すべきなんです。

そのために、これらのファイルを保存したパスを指定し、ウェブサーバーにディレクトリがどこにあるか教えます。static-files-path


static-files-path : (path-string? -> void)

はウェブサーバが静的リソースへのリクエストがあるURLを受け取った時、指定されたパスを覗く機能です。

Exercise.以下のコンテンツを含む"test-static.ss"と名づけられた簡単なwebアプリを書いてください。


  #lang web-server/insta
  (define (start request)
    '(html (head (title "Testing"))
           (link ((rel "stylesheet")
                  (href "/test-static.css")
                  (type "text/css")))
           (body (h1 "Testing")
                 (h2 "This is a header")
                 (p "This is " (span ((class "hot")) "hot") "."))))
  
  (static-files-path "htdocs")

"test-static.ss"ソースファイルが置いてあるディレクトリをルートとして、"htdocs"と名づけたサブディレクトリを作成してください。最後に、この.cssページを表示する為に、"htdocs/"内に以下の内容を持つ"test-static.css"と言う簡単な.cssファイルを作成してください。


body {
  margin-left: 10%;
  margin-right: 10%;
}
p { font-family: sans-serif }
h1 { color: green }
h2 { font-size: small }
span.hot { color: red }

この時点で、アプリを走らせてブラウザの出力を見てください。質素なWebページでしょうが、ほんのりと色が付いています。

Exercise.あなたの趣味に見合った外部スタイルシートを記述し、ブログアプリの表示を改善してみましょう。スタイルシートへのリンクを含むように全てのHTMLレスポンスハンドラを調整してみましょう。

Adding a Back Button

ここに、私たちのWebアプリの改良版ページフローのダイアグラムがあります。render-post-detail-pageからブログのトップレベルに戻るバックリンクを足すだけです。

Exercise.render-post-detail-pageにrender-blog-pageへ戻る別リンクを含むように調整してください。

もっと面白くするには、フローをもうちょっとだけ豪華にしてみましょう。ユーザにコメントを投稿する直前に選択肢を与えるのです。ひょっとしたらひょっとするでしょう。投稿前に投稿を止めたい、って思うかもしれませんので。

複雑に見えますが、ハンドラの全体像は以前とさほど変わりません。これらハンドラを全て追加すると、webアプリはかなり機能的になります。


  #lang web-server/insta
  
  ; ブログは (make-blog posts)
  ; 投稿リストは (listof post)
  (define-struct blog (posts) #:mutable)
  
  ; 投稿は (make-post title body comments)
  ; タイトルは文字列、本体も文字列
  ; コメントは (listof string)
  (define-struct post (title body comments) #:mutable)
  
  ; BLOG: blog
  ; ブログの初期状態
  (define BLOG
    (make-blog
     (list (make-post "First Post"
                      "This is my first post"
                      (list "First comment!"))
           (make-post "Second Post"
                      "This is another post"
                      (list)))))
  
  ; blog-insert-post!: blog post -> void
  ; ブログと投稿を受け取り、ブログの頭に投稿を加える
  (define (blog-insert-post! a-blog a-post)
    (set-blog-posts! a-blog
                     (cons a-post (blog-posts a-blog))))
  
  
  ; post-insert-comment!: post string -> void
  ; 投稿とコメント文字列を受け取る。副作用として投稿の
  ; コメントリストの最後にコメントを追加する。
  (define (post-insert-comment! a-post a-comment)
    (set-post-comments!
     a-post
     (append (post-comments a-post) (list a-comment))))
  
  ; start: request -> html-response
  ; リクエストを受け取り、webコンテンツ全てを表示する
  ; ページを生成する
  (define (start request)
    (render-blog-page request))
  
  ; render-blog-page: request -> html-response
  ; ブログの中身のhtml-responseページを
  ; 生成する
  (define (render-blog-page request)
    (local [(define (response-generator make-url)
              `(html (head (title "My Blog"))
                     (body
                      (h1 "My Blog")
                      ,(render-posts make-url)
                      (form ((action
                              ,(make-url insert-post-handler)))
                       (input ((name "title")))
                       (input ((name "body")))
                       (input ((type "submit")))))))
  
            ; parse-post: bindings -> post
            ; 束縛から投稿を抽出する
            (define (parse-post bindings)
              (make-post (extract-binding/single 'title bindings)
                         (extract-binding/single 'body bindings)
                         (list)))
  
            (define (insert-post-handler request)
              (blog-insert-post!
               BLOG (parse-post (request-bindings request)))
              (render-blog-page request))]
  
      (send/suspend/dispatch response-generator)))
  
  ; render-post-detail-page: post request -> html-response
  ; 投稿を受け取り、投稿の詳細ページを生成する
  ; ユーザは新規コメントを挿入できる
  ; また、render-blog-pageに戻る事が出来る
  (define (render-post-detail-page a-post request)
    (local [(define (response-generator make-url)
              `(html (head (title "Post Details"))
                     (body
                      (h1 "Post Details")
                      (h2 ,(post-title a-post))
                      (p ,(post-body a-post))
                      ,(render-as-itemized-list
                        (post-comments a-post))
                      (form ((action
                              ,(make-url insert-comment-handler)))
                            (input ((name "comment")))
                            (input ((type "submit"))))
                      (a ((href ,(make-url back-handler)))
                         "Back to the blog"))))
  
            (define (parse-comment bindings)
              (extract-binding/single 'comment bindings))
  
            (define (insert-comment-handler request)
              (render-confirm-add-comment-page
               (parse-comment (request-bindings request))
               a-post
               request))
  
            (define (back-handler request)
              (render-blog-page request))]
  
      (send/suspend/dispatch response-generator)))
  
  ; render-confirm-add-comment-page :
  ; comment post request -> html-response
  ; リクエストと共に投稿予定のコメントを受け取る
  ; ユーザはコメントを投稿し、表示ページに戻れるようにする
  ; もしくは投稿の詳細ページへと戻る
  ; 
  (define (render-confirm-add-comment-page a-comment a-post request)
    (local [(define (response-generator make-url)
              `(html (head (title "Add a Comment"))
                     (body
                      (h1 "Add a Comment")
                      "The comment: " (div (p ,a-comment))
                      "will be added to "
                      (div ,(post-title a-post))
  
                      (p (a ((href ,(make-url yes-handler)))
                            "Yes, add the comment."))
                      (p (a ((href ,(make-url cancel-handler)))
                            "No, I changed my mind!")))))
  
            (define (yes-handler request)
              (post-insert-comment! a-post a-comment)
              (render-post-detail-page a-post request))
  
            (define (cancel-handler request)
              (render-post-detail-page a-post request))]
  
      (send/suspend/dispatch response-generator)))
  
  ; render-post: post (handler -> string) -> html-response
  ; 投稿を受け取り、投稿のhtml-response要素を生成する
  ; 要素は投稿詳細ページへのリンクを含む
  (define (render-post a-post make-url)
    (local [(define (view-post-handler request)
              (render-post-detail-page a-post request))]
      `(div ((class "post"))
            (a ((href ,(make-url view-post-handler)))
               ,(post-title a-post))
            (p ,(post-body a-post))
            (div ,(number->string (length (post-comments a-post)))
                 " comment(s)"))))
  
  ; render-posts: (handler -> string) -> html-response
  ; make-urlをつけトリ、全投稿のhtml-response
  ; 要素を生成する
  (define (render-posts make-url)
    (local [(define (render-post/make-url a-post)
              (render-post a-post make-url))]
      `(div ((class "posts"))
            ,@(map render-post/make-url (blog-posts BLOG)))))
  
  ; render-as-itemized-list: (listof html-response) -> html-response
  ; アイテムのリストを受け取り、未整列のリストとして
  ; レンダリングを生成する
  (define (render-as-itemized-list fragments)
    `(ul ,@(map render-as-item fragments)))
  
  ; render-as-item: html-response -> html-response
  ; html-responseを受け取り、リストアイテムとして
  ; レンダリングを生成する
  (define (render-as-item a-fragment)
    `(li ,a-fragment))

2010年1月10日日曜日

Breaking Up the Display

コメントをユーザのweb体験ともっと統合するにはどうすれば良いのでしょう?投稿全部とコメント全部がページに全部表示されている、ってのはちょっと大げさでしょう。多分、ブログのメインページとコメント表示は別々にした方が良いでしょう。投稿の見え方の補助的な「ディティール」と、そこでのコメントのあり方を提案してみましょう。

さて、ブログのトップレベルの見え方はブログのタイトルと本体とします。ついでに、投稿に関係したコメントが何個付いたのか、カウンターも表示しましょう。

そうすると、投稿の詳細ページに到達する何らかの方法が必要となります。一つの手は、各投稿のタイトルにハイパーリンクを貼る事です:ユーザが投稿の詳細ページを見たければ、そこへ行くためタイトルをクリックすれば良い。投稿の詳細ページに、ユーザが新規のコメントを追加出来るフォームを追加すれば良いでしょう。

以下はwebアプリにコメントを追加する簡単なページフローのダイアグラムです。

ダイアグラムの各場所はリクエストを受け取るハンドラに対応しています。予想どおり、もうちょっとsend/suspend/dispatchを使いましょう。ダイアグラム中の矢印はembed/urlで生成されたURLを表しています。

これはちょっとだけ複雑な結果をもたらします:以前は、ハイパーリンクなしの投稿リストをレンダリングしてました。しかし、全ての特殊な移動用URLを生成する機能がembed/urlを使う以上、ハイパーリンクタイトルを作るときembed/urlを使って受け取るrender-postsとrender-postを調整する必要があります。

Webアプリは、現時点、次のようになります:


  #lang web-server/insta
  
  ; ブログは (make-blog posts)
  ; 投稿リストは (listof post)
  (define-struct blog (posts) #:mutable)
  
  ; 投稿は (make-post title body comments)
  ; タイトルは文字列で本体も文字列
  ; コメントは (listof string)
  (define-struct post (title body comments) #:mutable)
  
  ; BLOG: blog
  ; ブログの初期値
  (define BLOG
    (make-blog
     (list (make-post "First Post"
                      "This is my first post"
                      (list "First comment!"))
           (make-post "Second Post"
                      "This is another post"
                      (list)))))
  
  ; blog-insert-post!: blog post -> void
  ; ブログと投稿を受け取り、ブログの頭に投稿を付け加える
  (define (blog-insert-post! a-blog a-post)
    (set-blog-posts! a-blog
                     (cons a-post (blog-posts a-blog))))
  
  
  ; post-insert-comment!: post string -> void
  ; 投稿とコメント文字列を受け取る。副作用として投稿の
  ; コメントリストの一番下にコメントを付け加える
  (define (post-insert-comment! a-post a-comment)
    (set-post-comments!
     a-post
     (append (post-comments a-post) (list a-comment))))
  
  ; start: request -> html-response
  ; リクエストを受け取り、webコンテンツの全てを表示する
  ; ページを生成する
  (define (start request)
    (render-blog-page request))
  
  ; render-blog-page: request -> html-response
  ; ブログの内容のhtml-responseページを
  ; 生成する
  (define (render-blog-page request)
    (local [(define (response-generator make-url)
              `(html (head (title "My Blog"))
                     (body
                      (h1 "My Blog")
                      ,(render-posts make-url)
                      (form ((action
                              ,(make-url insert-post-handler)))
                       (input ((name "title")))
                       (input ((name "body")))
                       (input ((type "submit")))))))
  
            ; parse-post: bindings -> post
            ; 束縛から投稿を抽出する
            (define (parse-post bindings)
              (make-post (extract-binding/single 'title bindings)
                         (extract-binding/single 'body bindings)
                         (list)))
  
            (define (insert-post-handler request)
              (blog-insert-post!
               BLOG (parse-post (request-bindings request)))
              (render-blog-page request))]
  
      (send/suspend/dispatch response-generator)))
  
  ; render-post-detail-page: post request -> html-response
  ; 投稿とリクエストを受け取り投稿の詳細ページを生成する
  ; ユーザは新規コメントを挿入可能
  (define (render-post-detail-page a-post request)
    (local [(define (response-generator make-url)
              `(html (head (title "Post Details"))
                     (body
                      (h1 "Post Details")
                      (h2 ,(post-title a-post))
                      (p ,(post-body a-post))
                      ,(render-as-itemized-list
                        (post-comments a-post))
                      (form ((action
                              ,(make-url insert-comment-handler)))
                            (input ((name "comment")))
                            (input ((type "submit")))))))
  
            (define (parse-comment bindings)
              (extract-binding/single 'comment bindings))
  
            (define (insert-comment-handler a-request)
              (post-insert-comment!
               a-post (parse-comment (request-bindings a-request)))
              (render-post-detail-page a-post a-request))]
  
  
      (send/suspend/dispatch response-generator)))
  
  
  ; render-post: post (handler -> string) -> html-response
  ; 投稿を受け取り、投稿のhtml-response要素を生成する
  ; 要素は投稿の詳細ページを示すリンクを含む
  (define (render-post a-post make-url)
    (local [(define (view-post-handler request)
              (render-post-detail-page a-post request))]
      `(div ((class "post"))
            (a ((href ,(make-url view-post-handler)))
               ,(post-title a-post))
            (p ,(post-body a-post))
            (div ,(number->string (length (post-comments a-post)))
                 " comment(s)"))))
  
  ; render-posts: (handler -> string) -> html-response
  ; make-urlを受け取り、全投稿のhtml-response
  ; 要素を生成する
  (define (render-posts make-url)
    (local [(define (render-post/make-url a-post)
              (render-post a-post make-url))]
      `(div ((class "posts"))
            ,@(map render-post/make-url (blog-posts BLOG)))))
  
  ; render-as-itemized-list: (listof html-response) -> html-response
  ; アイテムのリストを受け取り未整列のリストとして
  ; レンダリングを生成する
  (define (render-as-itemized-list fragments)
    `(ul ,@(map render-as-item fragments)))
  
  ; render-as-item: html-response -> html-response
  ; html-responseを受け取り、リストアイテムとして
  ; レンダリングを生成する
  (define (render-as-item a-fragment)
    `(li ,a-fragment))

私たちは極めて洗練されたアプリを手に入れました:今は投稿も出来るしコメントも書けます。しかしながら、まだこの問題があります:ユーザがpost-detail-pageにいるとブラウザの戻るボタンを押すことなくブログに戻る事が出来ないのです!これじゃあ混乱します。ユーザがwebアプリの片隅で立ち往生せず、ブログのメインページへと戻れるようなページフローを提供しなければなりません。

Extending the Model

次に、投稿毎にコメントのリストを保持出来るようにアプリを拡張しましょう。ブログのデータ定義を次のように改良します:


(struct   post   (title body comments)
    #:mutable)
  title : string?
  body : string?
  comments : (listof string?)

Exercise.改良した投稿のデータストラクチャを書いてみてください。投稿にコメントを加える事を意図して、ストラクチャは変更可能にしてください。

Exercise.いくつか投稿の例を作ってみてください。

Exercise.post-add-comment!機能を定義してください。


post-add-comment! : (post? string? . -> . void)

意図的な副作用は、投稿のコメントリストの最後に新しいコメントを追加するものとします。

Exercise.render-postを生成された要素が項目別リストでコメントを含むように調整してみてください。

Exercise.投稿がコメントを含むように拡張したので、アプリの他の投稿操作部分、例えばmake-postの用途など、も調整が必要となります。投稿の新しいストラクチャへの適応が必要なアプリの他の部分を見分けて修正してください。

投稿のデータストラクチャを変更して、改良したストラクチャを扱う機能を調整すると、webアプリは実行可能となります。ユーザは労力の成果が分かるでしょう:BLOGの初期値がコメント付きの投稿であれば、ユーザは現時点でコメントを見る事が出来るでしょう。しかし明らかに足りないものがあります:ユーザ向けの、投稿にコメントを追加するユーザーインターフェースが無いのです!

Share and Share Alike

私たちのアプリは新たな問題に出くわします:別々のブラウザウィンドウそれぞれに独自のブログが保持されたままです。これだと、殆どの人の為のブログの利点、つまり他人との共有が出来ません!新規投稿を挿入すると、新しいブログ値を生成するより、既存のブログを構造的に変更したほうが良いに決まっています。(HTDP41章)。そこで、構成に変更機能を追加しましょう。

ちょっとした詳細に目を向けましょう:web-server言語では、デフォルトではストラクチャは変更不可なのです。このデフォルトを無効にして、ストラクチャ変更子へのアクセスが欲しいのです。そうするにはストラクチャ定義に#:mutableを付け加えます。

初めに、blogはpostのリストだ、としましたが、ブログの変更を許可し、ブログを変更可能なストラクチャとする為、定義に戻りたいと思います。


(define-struct blog (posts) #:mutable)


(struct blog (posts))
  posts : (listof post?)

変更可能なストラクチャはストラクチャのフィールドを変更する為の機能を提供します;この場合、set-blog-posts!と呼ばれるストラクチャ変更子を手にします。


set-blog-posts! : (blog? (listof post?) . -> . void)

これでブログの投稿が変更可能になります。

Exercise.blog-insert-post!機能を書いてみましょう。


blog-insert-post! : (blog? post? . -> . void)

この機能の意図的な副作用はブログの投稿を拡張します。

ブログのデータ表現を変更したので、それを用いてwebアプリを改良します。また、注意しなければならない事は、webアプリ内部では同じブログ値を共有しているので、もはやハンドラを用いてそれをたらい回しにする必要がなくなりました:現時点のブログはBLOG変数を通して与えられます。

insert-blog-post!を加えた調整と変数の整理を経過して、私たちのwebアプリは今はこのようになります:


  #lang web-server/insta
  
  ; ブログは a (make-blog posts)
  ; 投稿リストは (listof post)
  (define-struct blog (posts) #:mutable)
  
  ; 投稿は (make-post title body)
  ; タイトルは文字列、本体も文字列
  (define-struct post (title body))
  
  ; BLOG: blog
  ; 初期状態のブログ
  (define BLOG
    (make-blog
     (list (make-post "First Post" "This is my first post")
           (make-post "Second Post" "This is another post"))))
  
  ; blog-insert-post!: blog post -> void
  ; ブログと投稿を受け取り、ブログの頭に投稿を加える
  (define (blog-insert-post! a-blog a-post)
    (set-blog-posts! a-blog
                     (cons a-post (blog-posts a-blog))))
  
  ; start: request -> html-response
  ; リクエストを受け取り、webコンテンツ全てを
  ; 表示するページを生成する
  (define (start request)
    (render-blog-page request))
  
  ; parse-post: bindings -> post
  ; 束縛から投稿を抽出する
  (define (parse-post bindings)
    (make-post (extract-binding/single 'title bindings)
               (extract-binding/single 'body bindings)))
  
  ; render-blog-page: request -> html-response
  ; BLOGの中身のhtml-responseページを生成する
  (define (render-blog-page request)
    (local [(define (response-generator make-url)
              `(html (head (title "My Blog"))
                     (body
                      (h1 "My Blog")
                      ,(render-posts)
                      (form ((action
                              ,(make-url insert-post-handler)))
                       (input ((name "title")))
                       (input ((name "body")))
                       (input ((type "submit")))))))
  
            (define (insert-post-handler request)
              (blog-insert-post!
               BLOG (parse-post (request-bindings request)))
              (render-blog-page request))]
  
      (send/suspend/dispatch response-generator)))
  
  ; render-post: post -> html-response
  ; 投稿を受け取り、投稿のhtml-response要素を生成する
  (define (render-post a-post)
    `(div ((class "post"))
          ,(post-title a-post)
          (p ,(post-body a-post))))
  
  ; render-posts: -> html-response
  ; ブログを受け取り、全投稿のhtml-response
  ; 要素を生成する
  (define (render-posts)
    `(div ((class "posts"))
          ,@(map render-post (blog-posts BLOG))))

webアプリを訪ねた二つのウィンドウを開いて、両方のウィンドウから投稿してみてください。両方のブラウザが同じブログを共有していることが分かるでしょう。

Advanced Control Flow

暫くの間、ブログがたった一つしか新規投稿を受け付けない、と言う明らかに大きな問題は無視しましょう。心配しないで!これは後で直します。

しかしながら、私たちのプログラムにはもっと高度な問題があります:と言うのも、startはアプリのURLにリクエストを送る機能なんですが、あまりにも多くの役割がありすぎて負荷がかかってきています。概念的には、startは現時点、二つの種類のリクエストを処理しています:ブログを表示するリクエストとブログへの新規投稿を加えるリクエストと、です。

一体、startが、私たちのWebアプリの全ての振る舞いを、お巡りさんのように --- dispatcherと呼びますが --- 交通整理をするようになったらどうなるのでしょうか?想像してみると、アプリに機能を追加するたび、startは制御方法を知らなくてはなりません。果たして、違う種類のリクエストがある度に、自動的に違う機能へと振り分ける方法なんてあるんでしょうか?

web serber ライブラリにはURLを生成して、アプリの別々のパーツへと振り分けるsend/suspend/dispatchと言う機能が用意されています。素敵なデモを紹介しましょう。新規ファイルを立ち上げて、以下のコードを定義ウィンドウに入力してください。


  #lang web-server/insta
  ; start: request -> html-response
  (define (start request)
    (phase-1 request))
  
  ; phase-1: request -> html-response
  (define (phase-1 request)
    (local [(define (response-generator embed/url)
              `(html
                (body (h1 "Phase 1")
                      (a ((href ,(embed/url phase-2)))
                         "click me!"))))]
      (send/suspend/dispatch response-generator)))
  
  ; phase-2: request -> html-response
  (define (phase-2 request)
    (local [(define (response-generator embed/url)
              `(html
                (body (h1 "Phase 2")
                      (a ((href ,(embed/url phase-1)))
                         "click me!"))))]
      (send/suspend/dispatch response-generator)))

これはグルグル回るwebアプリです。ユーザがアプリを最初に訪れると、phase-1が始まります。そのページはハイパーリンクを生成し、クリックするとphase-2へ飛びます。ユーザがクリックするとまたphase-1へと戻り、これが延々と繰り返されます。

もうちょっと丁寧にsend/suspend/dispatchのメカニズムを見てみましょう。send/suspend/dispatchはレスポンス生成機能を受け取り、そして特殊なURLを作るembed/urlと呼ばれるレスポンス生成機能を返します。このURLが特殊なのは次のような意味です:ウェブブラウザがこれらのURLを訪ねると、webアプリが再起動しますが、それはstartからではなく、このURLに関連したハンドラから立ち上がる、と言う意味です。Phase-1ではembed/urlの用途はPhase-2に関連してて、逆もまた同じ、と言う事です。

embed/url絡みのハンドラをもっと綺麗にしてみましょう。ハンドラは単にリクエストを受け取る機能なので、localで定義可能です。結局、ローカル定義のハンドラは定義のスコープ内に存在する全ての変数を捕捉します。もう一つ、ループ的な例を見てみます。


  #lang web-server/insta
  ; start: request -> html-response
  (define (start request)
    (show-counter 0 request))
  
  ; show-counter: number request -> html-response
  ; ハイパーリンクで数値を表示し、リンクがクリックされると
  ; 数値が増えた新しいページを生成する
  (define (show-counter n request)
    (local [(define (response-generator embed/url)
              `(html (head (title "Counting example"))
                     (body
                      (a ((href ,(embed/url next-number-handler)))
                         ,(number->string n)))))
  
            (define (next-number-handler request)
              (show-counter (+ n 1) request))]
  
      (send/suspend/dispatch response-generator)))

この例は、対話的結果が累積可能である、と言う事を示しています。ユーザがページを訪問し、ページを生成してゼロを目にしたとしても、ハンドラは対話を介して次の数値へ続くハンドラを生成し、値はどんどん累積されていくのです。

ちょっと寄り道し過ぎたので、ブログアプリへと戻りましょう。フォームの動作を別のハンドラに関連したURLと結びつけるように調整します。


  #lang web-server/insta
  
  ; ブログは (listof post) で
  ; 投稿は (make-post title body)
  (define-struct post (title body))
  
  ; BLOG: blog
  ; 静的ブログ
  (define BLOG
    (list (make-post "First Post" "This is my first post")
          (make-post "Second Post" "This is another post")))
  
  ; start: request -> html-response
  ; リクエストを受け取り、全てのwebコンテンツを
  ; 表示するページを生成する
  (define (start request)
    (render-blog-page BLOG request))
  
  ; parse-post: bindings -> post
  ; 束縛から投稿を抽出する
  (define (parse-post bindings)
    (make-post (extract-binding/single 'title bindings)
               (extract-binding/single 'body bindings)))
  
  ; render-blog-page: blog request -> html-response
  ; ブログとリクエストを受け取り、ブログのコンテンツの
  ; html-responseを生成する
  (define (render-blog-page a-blog request)
    (local [(define (response-generator make-url)
              `(html (head (title "My Blog"))
                     (body
                      (h1 "My Blog")
                      ,(render-posts a-blog)
                      (form ((action
                              ,(make-url insert-post-handler)))
                       (input ((name "title")))
                       (input ((name "body")))
                       (input ((type "submit")))))))
  
            (define (insert-post-handler request)
              (render-blog-page
               (cons (parse-post (request-bindings request))
                     a-blog)
               request))]
  
      (send/suspend/dispatch response-generator)))
  
  ; render-post: post -> html-response
  ; 投稿を受け取り、投稿の要素のhtml-responseを生成する
  (define (render-post a-post)
    `(div ((class "post"))
          ,(post-title a-post)
          (p ,(post-body a-post))))
  
  ; render-posts: blog -> html-response
  ; ブログを受け取り、全投稿の要素の
  ; html-responseを生成する
  (define (render-posts a-blog)
    `(div ((class "posts"))
          ,@(map render-post a-blog)))

render-blog-page機能の構造は、前のshow-counterの例と極めて似ているところに注目してください。最終的に、ユーザはブログに複数の投稿が可能になり、それを読む事が出来るようになりました。

残念ながら、まだ問題があります。問題を見るには次のようにしてみてください:システムにいくつか投稿して、新しいウィンドウでブラウザを開きます。新しいブラウザでwebアプリのURLを開きます。一体何が起きるでしょう?

2010年1月8日金曜日

Inspecting Requests

我々のアプリは、いまだちょっと静的に見えます。と言うのも、ページを動的に生成してはいるのですが、外部ユーザに新しい投稿を許すような設計にまだなっていないから、です。ここをやっつけてしまいましょう。ユーザに新しいブログエントリ用のフォームを提供しましょう。ユーザが実行ボタンを押すと、ページの頭に新しい投稿が現れるようにするのです。

今まではrequestオブジェクトで何かをする、と言う事を避けてきました。しかし、requestオブジェクトは避けるべきものではありません!ユーザがwebフォームに何か入力して投稿すると、ユーザのブラウザはフォームの値を保持した新しいrequestを生成します。ここでは、ユーザが入力した値を受け取るrequest-bindings機能を使います。request-bindingsの型は:


request-bindings : (request? . -> . bindings?)

です。
request-bindingsに加えて、名前を受け取り、その名前に関連した値を返すextract-binding/single機能と言うものもあります。


extract-binding/single : (symbol? bindings? . -> . string?)

最後に、exists-binging?で束縛に名前があるかどうかチェックします。


exists-binding? : (symbol? bindings? . -> . boolean?)

これらの機能を使って、requestを受け取り、何か役立つ事を行う機能を実装しましょう。

Exercise.bingings?を受け取るcan-parse-post?と言う機能を書いてみましょう。'titleと'bodyと二つのシンボルに束縛されたものがあれば#tを返し、そうじゃなければ#fを返します。


can-parse-post? : (bindings? . -> . boolean?)

Exercise.束縛を受け取るcan-parse-post?と言う機能を書いてみましょう。ここではでは'titleと'bodyと言うシンボルに値が束縛されている構造とします。parse-postはこれらの値を含む投稿を生成します。


parse-post : (bindings? . -> . post?)

さて、これらの補助機能を用いて、入力フォームを操れるようにwebアプリを拡張します。ページの最後に小さな入力フォームを付け加えて、新規投稿を加えられるようにプログラムを変更してみましょう。そして、startメソッドは、最初にリクエストがパース可能であるかどうか調べ、そうであるならば、投稿セットを拡大し、最終的にこれらのブログ投稿を表示するようにします。


  #lang web-server/insta
  
  ; ブログは (listof post) で
  ; 投稿は (make-post title body)
  (define-struct post (title body))
  
  ; BLOG: blog
  ; 静的ブログ
  (define BLOG
    (list (make-post "First Post" "This is my first post")
          (make-post "Second Post" "This is another post")))
  
  ; start: request -> html-response
  ; リクエストを受け取り全てのwebコンテンツを
  ; 表示するページを生成する
  (define (start request)
    (local [(define a-blog
              (cond [(can-parse-post? (request-bindings request))
                     (cons (parse-post (request-bindings request))
                           BLOG)]
                    [else
                     BLOG]))]
      (render-blog-page a-blog request)))
  
  
  ; can-parse-post?: bindings -> boolean
  ; 束縛が 'title と 'body を含む値がある場合、真を返す
  (define (can-parse-post? bindings)
    (and (exists-binding? 'title bindings)
         (exists-binding? 'body bindings)))
  
  
  ; parse-post: bindings -> post
  ; 束縛を受け取り、取り出した投稿を返す
  (define (parse-post bindings)
    (make-post (extract-binding/single 'title bindings)
               (extract-binding/single 'body bindings)))
  
  ; render-blog-page: blog request -> html-response
  ; ブログをリクエストを受け取り、ブログコンテンツである
  ; html-response ページを生成する
  (define (render-blog-page a-blog request)
    `(html (head (title "My Blog"))
           (body
            (h1 "My Blog")
            ,(render-posts a-blog)
            (form
             (input ((name "title")))
             (input ((name "body")))
             (input ((type "submit")))))))
  
  
  
  ; render-post: post -> html-response
  ; 投稿を受け取り、html-response 要素を生成する
  (define (render-post a-post)
    `(div ((class "post"))
          ,(post-title a-post)
          (p ,(post-body a-post))))
  
  
  ; render-posts: blog -> html-response
  ; ブログを受け取り、全投稿の html-response
  ; 要素を生成する
  (define (render-posts a-blog)
    `(div ((class "posts"))
          ,@(map render-post a-blog)))

これは動くように見えますが・・・一つ問題があります!二つの新規投稿をしてみてください。一体、何が起きるでしょうか?

2010年1月7日木曜日

Rendering HTML

webブラウザがアプリのURLを訪ねると、ブラウザはリクエスト構造を造って、webアプリにそれを送ります。手始めに、リクエストを受け取り、レスポンスを生成する機能を作りましょう。レスポンスの基本はHTMLページを表示する事です。


  (define html-response/c
    (or/c string?
          (or/c (cons/c symbol? (listof html-response/c))
                (cons/c symbol?
                        (cons/c (listof (list/c symbol? string?))
                                (listof html-response/c))))))

例:

"hello"はHTMLではhelloと表示されます。

<p>This is an example</p>は


'(p "This is an example")

で生成されます。

<a href="link.html">Past</a>は


'(a ((href "link.html")) "Past")

で生成されます。

<p>This is <div class="emph">another</div> example.</p>は


'(p "This is " (div ((class "emph")) "another") " example.")

で生成されます。

これらhtml-responseは直接consやlistで作成できます。しかしながら、それでは厳しい表記となるでしょう。比較してみてください:


  (list 'html (list 'head (list 'title "Some title"))
         (list 'body (list 'p "This is a simple static page.")))

対:


  '(html (head (title "Some title"))
         (body (p "This is a simple static page.")))

両者とも同じhtml-responseを生成しますが、後者の方が記述も解読もはるかに簡単です。ここでは、How to Design Program:13章で解説された拡張リスト省略表記を使っています。先頭の引用符はリスト構造を表していて、これを使えば自信を持って静的なhtmlレスポンスを作る事が出来るのです。

しかしながら、動的コンテンツでは、単純なリスト省略表記を使うと問題が生じます。html-response構造に式を挿し入れたい場合、単純なリスト省略表記のアプローチは使えません。と言うのも、それらはリテラルなリスト構造の一部として扱われてしまうからです!

欲しいのは、構造の一部だけは普通の式として扱えるオプション付きの、クオートされたリスト省略記法の簡易性を備えた表記法、です。つまり、簡易表記可能な、動的に埋め込めるプレースホルダー付きのテンプレートを定義したいわけです。

Schemeはこのテンプレート機能を逆引用符として提供しています。逆引用とは、全体構造の直前にバッククオートを使う事です。普通のクオートされたリスト省略記法のように、殆どのリスト構造はネストされていてもリテラルに保護されます。一部の式の評価値を挿入したい場所で、その式の直前にクオート解除の為のコンマを挿し入れます。例えば:


  ; render-greeting: string -> html-response
  ; name を受け取り、動的 html-response を生成する。
  (define (render-greeting a-name)
    `(html (head (title "Welcome"))
           (body (p ,(string-append "Hello " a-name)))))

Exercise.(listof post?)を受け取り、そのコンテンツのhtml-responseを生成する機能、render-postsを書いてください。


render-posts : ((listof post?) . -> . html-response/c)

例えば:


(render-posts empty)

は次を生成します:


'(div ((class "posts")))

一方、


  (render-posts (list (make-post "Post 1" "Body 1")
                      (make-post "Post 2" "Body 2")))

は次を生成します:


  '(div ((class "posts"))
        (div ((class "post")) "Post 1" "Body 1")
        (div ((class "post")) "Post 2" "Body 2"))

render-posts機能を入手したので、webアプリに戻ってhtml-responseを返すstart機能を実装しましょう。


  #lang web-server/insta
  
  ; ブログは (listof post)
  ; 投稿は (make-post title body)
  (define-struct post (title body))
  
  ; BLOG: blog
  ; 静的ブログ
  (define BLOG
    (list (make-post "First Post" "This is my first post")
          (make-post "Second Post" "This is another post")))
  
  ; start: request -> html-response
  ; リクエストを受け取り、webコンテンツの全てを
  ; 表示するページを生成する
  (define (start request)
    (render-blog-page BLOG request))
  
  ; render-blog-page: blog request -> html-response
  ; ブログとリクエストを受け取り、ブログのコンテンツの
  ; html-response を生成する
  (define (render-blog-page a-blog request)
    `(html (head (title "My Blog"))
           (body (h1 "My Blog")
                 ,(render-posts a-blog))))
  
  ; render-post: post -> html-response
  ; 投稿を受け取り、投稿のhtml-response要素を生成する
  (define (render-post a-post)
    `(div ((class "post"))
          ,(post-title a-post)
          (p ,(post-body a-post))))
  
  ; render-posts: blog -> html-response
  ; ブログを受け取り、全投稿のhtml-response要素を
  ; 生成する
  (define (render-posts a-blog)
    `(div ((class "posts"))
          ,@(map render-post a-blog)))

Runを押せば、webブラウザがブログの投稿を表示します。

Basic Blog

データ定義を考えるところからはじめましょう。投稿のリストを提供したい。投稿を次のように定義します。:


(define-struct post (title body))


(struct post (title body))
  title : string?
  body : string?

Exersise. 投稿の例をつくろう。

そうすると、ブログとは投稿のリストになります:


blog : (listof post?)

結果、もっとも単純なブログの例は以下のようになります:


  (define BLOG (list (make-post "First Post!"
                                "Hey, this is my first post!")))

さて、サンプルブログの構造ができたので、webアプリとしてこれを表示しましょう。

The Application

この入門では、ブログを作り上げる事によって進んでいきたいと思います。
ユーザは投稿ができ、投稿にはコメントする事ができます。
ここでは対話的アプローチを採用し、道程にはいくつかの落とし穴を設けています。ゲームの方針は、大体において以下の通りです:

静的な投稿を見せる。

ユーザにシステムへの新しい投稿を許す。

投稿にコメントを加えられるようにモデルを拡張する。

全てのユーザに同じ投稿セットを共有させる。

データ構造をディスク上にシリアライズする。

この入門の最後には、簡単なブログアプリを手にしている事でしょう。

Getting Started

この入門で必要な事全てはPLT Schemeで提供されています。DrScheme モジュール言語を使いましょう(注)。定義ウィンドウに次の入力をします。


  #lang web-server/insta
  (define (start request)
   '(html
     (head (title "My Blog"))
     (body (h1 "Under construction"))))

Runボタンを押してください。Webブラウザが"Under Construction"ページで開いたら「最初のwebアプリを作ったんだ!」と手を叩いて喜びましょう。複雑な事はやってませんが、とにかく作ったのです。取りあえず今はStopボタンを押してサーバをシャットダウンしましょう。

注:Emacs + Quack + mzscheme の環境の場合は、トップに次の一文を入れます。


#!/usr/bin/env mzscheme

つまり、全体的なコードは次のようになります。


#!/usr/bin/env mzscheme

#lang web-server/insta
(define (start request)
  '(html
    (head (title "俺のブログ"))
    (body (h1 "工事中"))))

ファイルを一旦保存し、Emacsのeshell上ででもchmod +xとして実行権限を与え、続いてeshell上で実行します。

inferior-schemeプロセスではブラウザは起動しないので気をつけて下さい。

Web Applications in PLT Scheme

どうやって動的Webアプリを作ろう?この入門では、PLT Schemeを使ってwebアプリを作る方法を紹介します。例として、簡単なWebジャーナル(ブログ)を作ってみましょう。Webサーバのスタートアップの仕方、動的Webコンテンツの作成法、ユーザとの対話の仕方もカバーします。

この入門の対象者はHow to Design Programsでストラクチャの使い方、デザインの仕方、高階関数、localの使い方、ミューテーションの考え方を学んだ人たちです。

2010年1月4日月曜日

問題1.6

Alyssa P. Hacker は if が特殊形式である理由が分からない。「condを利用し、普通の手続きとして定義してはいけないの?」と聞いた。Alyssa の友人の Eva Lu Ator はそうすることはもちろん出来るといって、if の新版を定義した:


(define (new-if predicate then-clause else-clause)
  (cond (predicate then-clause)
 (else else-clause)))

Eva は Alyssa にプログラムを見せた:


> (new-if (= 2 3) 0 5)
5
> (new-if (= 1 1) 0 5)
0
>

Alyssa は喜び、平方根のプログラムを書き直すのにnew-ifを使った:


(define (sqrt-iter guess x)
  (new-if (good-enough? guess x)
   guess
   (sqrt-iter (improve-guess x)
       x)))

Alyssa が平方根を計算するのにこれを使おうとすると、何が起きるか、説明せよ。

無限ループに陥ります。
問題はnew-ifが手続きであるから、です。ボディ部の評価に入る前に与えられた引数が全部評価されないとなりません。
Eva の例の場合は、再帰定義ではないので問題が生じないのですが、Alyssa が用いようとした手続きは再帰構造を持っています。従って、再帰部分であるnew-ifの第3引数を評価するとまたもや引数の展開が生じて、終了地点が無いまま無限ループに入ってしまうのです。
new-ifも本来はマクロを使って定義するべき、でしょう。これはSchemeの衛生的マクロで簡単に書くことが可能です。


(define-syntax new-if
  (syntax-rules ()
    ((_ predicate then-clause else-clause)
     (cond (predicate then-clause)
    (else else-clause)))))

2010年1月3日日曜日

問題1.5

Ben Bitdiddleは、彼の対面している解釈系が、作用的順序の評価を使っているか、正規順序の評価を使っているか決定するテストを発明した。次の二つの手続きを定義した:


(define (p) (p))

(define (test x y)
  (if (= x 0)
      0
      y))

彼は次に式


(test1 0 (p))

を評価してみた。作用的順序の評価を使う解釈系で、Benはどういう振舞いを見るか。正規順序を使う解釈系で、彼どういう振舞いを見るか。説明せよ。(特殊形式ifの評価規則は、解釈系が正規順序と作用的順序のどちらを使うかに無関係に同じとする: 述語式を最初に評価し、その結果が帰結式と代替式のいずれを評価するかを決める。)

作用的順序の評価を使うインタプリタだと、(test1 0 (p))は無限ループに陥ります。
何故なら、testのボディが評価される前に引数が評価され、(p)が評価されて(p)となり、また(p)が評価され・・・と、引数の展開がどこまでも終わりません。結果、引数yの実引数の無限評価が引き起こり、永久にボディ部に入らないのです。
一方、正規順序を使うインタプリタだと、「必要になるまで」引数が評価されないので、(test1 0 (p))は0を返して終了します。何故なら正規評価では(p)が評価される事自体が無いから、です。
例示のコードの「正規順序」のエミュレートだと、マクロで記述して動作を見てみた方が良いでしょう。マクロはコードの展開前に引数を評価する事がありません。
とは言っても、Schemeの衛生的マクロだと記述出来そうにないんで、仕様範囲外の伝統的マクロ(レガシーマクロやコードタイプのマクロ等としばしば呼ばれる)で記述してみた方が良いでしょう。
PLT Schemeの場合は、次のようにして書いてみれば良いでしょう。


(require mzlib/defmacro)  ;実装依存のdefine-macro使用を宣言

(define-macro (test-macro x y)
  (if (zero? x)
      0
      y))

実行結果は以下の通りです。


> (test-macro 0 (p))
0
>

ちなみに旧いLispなんかの場合は、マクロを使うまでも無く、処理系のNEXPR型やFEXPR型の関数で簡単に確かめる事が出来たかもしれません。
そう言う意味では、問題の質としては旧いのかもな、とも思います。

問題1.4

われわれの評価モデルは、演算子が合成式である組合せでも使えることを観察せよ。それに従って、次の手続きの振舞いを述べよ。


(define (a-plus-abs-b a b)
  ((if (> b 0) + -) a b))

bが0よりも大きい場合、if式は+を返し、その場合評価対象は


(+ a b)

となる。それ以外の場合、


(- a b)

が評価される。
結果、手続き名通り、aとbの絶対値が加算されるのと同じ結果となる。

問題1.3

三つの数を引数としてとり、大きい二つの数の二乗の和を返す手続きを定義せよ。


(define (Q1.3 x y z)
  (let ((w (min x y z))
 (x2 (* x x))
 (y2 (* y y))
 (z2 (* z z)))
    (cond ((= x w) (+ y2 z2))
   ((= y w) (+ z2 x2))
   (else (+ x2 y2)))))

問題1.2

次の式を前置記法に翻訳せよ。
$\frac{5 + 4 + (2 - (3 - (6 + \frac{4}{5})))}{3(6 - 2)(2 - 7)}$


(/ (+ 5 4 (- 2 (- 3 (+ 6 4/5)))) (* 3 (- 6 2) (- 2 7)))

問題1.1


Welcome to MzScheme v4.2.3 [3m], Copyright (c) 2004-2009 PLT Scheme Inc.
> 9
9
> (+ 5 3 4)
12
> (- 9 1)
8
> (/ 6 2)
3
> (+ (* 2 4) (- 4 6))
6
> (define a 3)
> (define b (+ a 1))
> (+ a b (* a b))
19
> (= a b)
#f
> (if (and (> b a) (< b (* a b)))
      b
      a)
4
> (cond ((= a 4) 6)
 ((= b 4) (+ 6 7 a))
 (else 25))
16
> (+ 2 (if (> b a) b a))
6
> (* (cond ((> a b) a)
    ((< a b) b)
    (else -1))
     (+ a 1))
16
>

登録: 投稿 (Atom)

2010年1月26日火曜日

2010年1月25日月曜日

2010年1月23日土曜日

2010年1月21日木曜日

2010年1月17日日曜日

2010年1月16日土曜日

自爆キーが何になるか、は大域変数として決めた方がスッキリとするのでは?

define-keyを二度も使ってkey-mapを一々変更するのはムダ

繰り返し回数が分かっていて、副作用を利用する場合はdotimesが便利

Emacs Lispのding関数の動きが良く分からん

2010年1月15日金曜日

2010年1月12日火曜日

2010年1月11日月曜日

2010年1月10日日曜日

2010年1月8日金曜日

2010年1月7日木曜日

2010年1月4日月曜日

2010年1月3日日曜日

Twitter

Apprentice Hackers

リンクリスト

ブログ アーカイブ

Tag Cloud

Recent Comments

登録

ブログアーカイブ