プログラミングを頑張る日記

プログラミングを勉強して、ハッカーになろう

Common Lispを頑張る(36)

Rubyをやると言ったな。あれは嘘だ。いや、それも嘘です。そのうちやります。
ただ本日はやります「Land of Lisp」。
ついにWebサーバを書きます。

そもそもWebサーバの仕組み

HTTPは、Webページをやりとりするためのインターネットのプロトコルです。
プロトコルってのは確か、決まり事、こうしてWebページをやりとりしようねって約束がHTTPなんですね。
確立されたソケットコネクションを通じて、TCP/IPの上でページをやりとりする層を定義していると。
クライアントコンピュータ上で走っているプログラムが定められた形式に沿ったリクエストを送ると
サーバは要求されたページを作りだして、ソケットスクリームを通してレスポンスを返す。

ふむふむ。ブラウザとかWebサーバはいつもそんなことをしてくれているのですね。
リクエストメッセージは、これがそうでしょうか。

Request URL: http://programcat.hatenablog.com/entry/2018/10/15/234849
Request Method: GET
Status Code: 200 OK
Remote Address: 13.230.115.161:80
Referrer Policy: no-referrer-when-downgrade

これから作るWebサーバに最も重要なのは、2行目の部分だそうです。あと1行目もかな。
参考書がfirefoxで自分がchromeだからか結構違っています。見当違いなところじゃなければいいんですが。

まあ、このMethodとURLの部分にはリクエストの種類と要求するページの名前があります。
この部分をリクエストヘッダと呼ぶそうです。
他の、リクエストヘッダに続いて送られる部分がリクエストボディで、
ここで送る情報を足せるわけですね。

リクエストを貰ったら、サーバはWebページを表現するHTML文書を、
ソケットストリームを通して送ります。このメッセージをレスポンスボディと呼ぶそう。
まあなんかあれですよね。の中に色々入れるやつ。
難しそうで敬遠してます。しかし避けて生きていけるわけがなかったしそろそろ戦わねば。

あと、レスボンスボディがあるからにはレスポンスヘッダという、
ドキュメントに関する追加情報を伝えるためのものもあるそうですが、
今回のWebサーバ作成では気にせずただボディだけを返すようにするとのこと。

リクエストパラメータ

よくあるログインフォームを考えます。ユーザネームとパスワードを入力するやつです。
ユーザが何かしらを入力して送信とかのボタンを押すと、
ブラウザはWebサーバにPOSTリクエストを送信するそうです。
POSTリクエストとGETリクエストの違いは、サーバにあるデータを変更するか否か。
...ログインするときにデータを変更しますかね。
まあ、データに触れる必要があるならPOSTって感じでしょうか。

...データを付与する場所が違うってのが一番大きいのかな。少なくとも表面的には。
GETならURLに情報が付与され、POSTならボディに付与されるみたいですね。
色々弄って身体で覚えていきたいですね。

また、POSTリクエストのリクエストヘッダには、ボディ部分のサイズ情報が付与されるそうです。

リクエストパラメータから情報を取り出す

HTMLでフォームのデータを送る際、通常のアルファベット以外の文字は、
HTMLエスケープコードと呼ばれる特殊な形式に変換されるそうです。
そうして、HTMLフォーマットで特殊な意味を持つ文字もデータとして送れるようにすると。
そういったデコードを行うための関数を書きます!なんか久しぶりにコード書きます。

CL-USER> (defun http-char (c1 c2 &optional (default #\Space)) ;オプション引数のデフォルトはスペース
           (let ((code (parse-integer
                        (coerce (list c1 c2) 'string) ;引数をリスト→文字列に変換
                        :radix 16                     ;16進数に変換
                        :junk-allowed t)))            ;変換できなかったゴミを無視
             (if code
                 (code-char code)       ;文字コードを文字に戻している?
                 default)))
HTTP-CHAR
CL-USER> (defun decode-param (s)
           (labels ((f (lst)            ;lstを引数にとる関数f
                      (when lst         ;lstがあれば
                        (case (car lst)
                          (#\% (cons (http-char (cadr lst) (caddr lst))
                                     (f (cdddr lst)))) ;lstのcarが%ならlstの次の要素とその次の要素をhttp-charに渡す、残りのリストで再帰。全ての要素はconsされる。
                          (#\+ (cons #\Space (f (cdr lst)))) ;lstのcarが+なら、残りの要素をfに渡してスペースとconsする
                          (otherwise (cons (car lst) (f (cdr lst)))))))) ;それら以外ならそのままにして残りの要素で再帰。
             (coerce (f (coerce s 'list)) 'string))) ;引数をリストにしてfに渡し、返ってきたもの(大量にconsされたもののはず)を文字列に変換。
DECODE-PARAM
CL-USER>

ちょっとしたリハビリ気分です。
coerce使ったことがある気もするんですけど忘れてしまいました。ちょっと動きを確認します。

CL-USER> (coerce "hey,yo! check it out!" 'list)
(#\h #\e #\y #\, #\y #\o #\! #\  #\c #\h #\e #\c #\k #\  #\i #\t #\  #\o #\u
 #\t #\!)
CL-USER> (coerce (coerce "hey,yo! check it out!" 'list) 'string)
"hey,yo! check it out!"
CL-USER>

文字列は文字コードにまで分解されリストへ、文字コードの集まりのリストを文字列にすることもできる。
decode-paramで受けとった文字列をバラバラの状態にしてローカル変数fに渡し、
fは引数の最初の要素を確認して、%なら次と次の要素をhttp-charに送ります。
http-charは受けとった要素をまず文字列にして、そのあと可能な限り16進数にします。
多少なりとも変換できていたら16進数をASCIIコードにしたがって(それとも処理系依存?)文字に変換し返します。
全然変換できなければスペースが返ります。
で、話はdecode-paramに戻ります。返ってきた要素は残りの要素をfに渡したものとconsされます。
もし引数の最初の要素が+だったなら、それはスペースとし残りの要素をfに渡したものとconsされます。
%でも+でもなければ、それはそのままの状態にして残りの要素をfに渡したものとconsされます。
lstを変換しきったら、全ての要素が変換されたリストが返り、そいつを文字列に変換します。

関数の動きはこれで合っているはず。それではちょいとURLを見てみますか。

https://www.google.co.jp/search?ei=vDbHW60hh_LwBZzKmugE&btnG=%E6%A4%9C%E7%B4%A2&q=land+of+lisp%3F

こちら、「Land of Lisp?」をGoogle検索したときのURLです。
お尻にくっついているものをみると、なるほど確かに#\+はスペースに、#\%のあとの2要素を1文字に変換するのは正しそうです。
試してみます。

CL-USER> (decode-param "https://www.google.co.jp/search?ei=vDbHW60hh_LwBZzKmugE&btnG=%E6%A4%9C%E7%B4%A2&q=land+of+lisp%3F")
"https://www.google.co.jp/search?ei=vDbHW60hh_LwBZzKmugE&btnG=æ¤ç´¢&q=land of lisp?"
CL-USER>

"Land of Lisp?"という文字列が復元されました。
しかし訳注で、「日本語はこのままじゃ無理」と書いてあります。マルチバイト文字ですもんね。
どうすりゃいいかも説明があるのですが、CLisp用なのでこのままでいきます。

...いや、それは情けないですね。夢はグレイトなハッカーなのでこれぐらい解決せねば。
まず、日本語を変換したときにどうなるかを確認します。
char-codeでchar-codeと逆のことができそうです。

CL-USER> (char-code #\あ)
12354
CL-USER>

...長いですね。調べたところutf-8とやらのようです。

訳注の中では、文字列をバイトに変換すること、バイトを文字列に変換することを行っています。
で、バイトをリストにしてfに渡して返ってきたものを配列にして文字列に戻しています。
むむ、decode-paramの中ではまだ文字コードのままリストを作るのか。
つまりdecode-paramが返すのは文字コードのリスト、それを配列にして文字列にする。
配列にするのは、文字列が結局は文字コードの配列でしかないからってことですね。

やらなきゃいけないことは、文字を受けとったらバイトに変換し、それらをリストにし
decode-paramに渡し、文字コードのリストにして返してもらう。ここでやることはさほど変わりませんね。
最後に返ってきたリストを配列にし文字列に。まあここはSBCLのやりかたに合わせるとこですが。
code-charでなんとかできないかな、と試してみましたが。

CL-USER> (mapcar #'code-char (mapcar #'char-code (coerce "あいうえお" 'list)))
(#\HIRAGANA_LETTER_A #\HIRAGANA_LETTER_I #\HIRAGANA_LETTER_U
 #\HIRAGANA_LETTER_E #\HIRAGANA_LETTER_O)
CL-USER>

あ、こうすればいいのか。

CL-USER> (coerce (mapcar #'code-char (mapcar #'char-code (coerce "あいうえお" 'list))) 'string)
"あいうえお"
CL-USER>

よし、つまり...

CL-USER> (defun decode-param (s)
           (labels ((f (lst)
                      (when lst
                        (case (car lst)
                          (#.(char-code #\%) (cons (http-byte (cadr lst) (caddr lst))
                                     (f (cdddr lst))))
                          (#.(char-code #\+) (cons #.(char-code #\space) (f (cdr lst))))
                          (otherwise (cons (car lst) (f (cdr lst))))))))
             (coerce (mapcar #'code-char (f (mapcar #'char-code (coerce s 'list)))) 'string)))
; in: DEFUN DECODE-PARAM
;     (HTTP-BYTE (CADR LST) (CADDR LST))
; 
; caught STYLE-WARNING:
;   undefined function: HTTP-BYTE
; 
; compilation unit finished
;   Undefined function:
;     HTTP-BYTE
;   caught 1 STYLE-WARNING condition
WARNING: redefining COMMON-LISP-USER::DECODE-PARAM in DEFUN
DECODE-PARAM
CL-USER> (defun http-byte (c1 c2 &optional (default #.(char-code #\Space)))
           (let ((code (parse-integer
                        (coerce (list (code-char c1) (code-char c2)) 'string)
                        :radix 16
                        :junk-allowed t)))
             (or code default)))
HTTP-BYTE
CL-USER>

これでどうかな。試してみます。

CL-USER> (http-char "https://www.google.co.jp/search?q=%E3%81%AD%E3%81%93&oq=%E3%81%AD%E3%81%93&aqs=chrome..69i57j69i60j69i61l2j0l2.974j0j9&sourceid=chrome&ie=UTF-8")
; Evaluation aborted on #<SB-INT:SIMPLE-PROGRAM-ERROR "invalid number of arguments: ~S" {1003394063}>.
CL-USER>

だめか。どこかがおかしい。

CL-USER> (labels ((f (lst)
                      (when lst
                        (case (car lst)
                          (#.(char-code #\%) (cons (http-byte (cadr lst) (caddr lst))
                                     (f (cdddr lst))))
                          (#.(char-code #\+) (cons #.(char-code #\space) (f (cdr lst))))
                          (otherwise (cons (car lst) (f (cdr lst))))))))
             (f (mapcar #'char-code (coerce "あいうえお" 'list))))
(12354 12356 12358 12360 12362)
CL-USER>

きりわけていきます。これなら動く。

CL-USER> (labels ((f (lst)
                      (when lst
                        (case (car lst)
                          (#.(char-code #\%) (cons (http-byte (cadr lst) (caddr lst))
                                     (f (cdddr lst))))
                          (#.(char-code #\+) (cons #.(char-code #\space) (f (cdr lst))))
                          (otherwise (cons (car lst) (f (cdr lst))))))))
             (mapcar #'code-char (f (mapcar #'char-code (coerce "あいうえお?" 'list)))))
(#\HIRAGANA_LETTER_A #\HIRAGANA_LETTER_I #\HIRAGANA_LETTER_U
 #\HIRAGANA_LETTER_E #\HIRAGANA_LETTER_O #\FULLWIDTH_QUESTION_MARK)
CL-USER>

うん、動きます。括弧の位置とかミスってたのかな。最後の仕上げ...。

CL-USER> (labels ((f (lst)
                      (when lst
                        (case (car lst)
                          (#.(char-code #\%) (cons (http-byte (cadr lst) (caddr lst))
                                     (f (cdddr lst))))
                          (#.(char-code #\+) (cons #.(char-code #\space) (f (cdr lst))))
                          (otherwise (cons (car lst) (f (cdr lst))))))))
             (coerce (mapcar #'code-char (f (mapcar #'char-code (coerce "あいうえお?" 'list)))) 'string))
"あいうえお?"
CL-USER> (defun decode-param (s)
           (labels ((f (lst)
                      (when lst
                        (case (car lst)
                          (#.(char-code #\%) (cons (http-byte (cadr lst) (caddr lst))
                                     (f (cdddr lst))))
                          (#.(char-code #\+) (cons #.(char-code #\space) (f (cdr lst))))
                          (otherwise (cons (car lst) (f (cdr lst))))))))
             (coerce (mapcar #'code-char (f (mapcar #'char-code (coerce s 'list))))) 'string))
; in: DEFUN DECODE-PARAM
;     (COERCE (MAPCAR #'CODE-CHAR (F (MAPCAR #'CHAR-CODE (COERCE S 'LIST)))))
; 
; caught WARNING:
;   The function was called with one argument, but wants exactly two.
; 
; compilation unit finished
;   caught 1 WARNING condition
WARNING: redefining COMMON-LISP-USER::DECODE-PARAM in DEFUN
DECODE-PARAM
CL-USER>

見直したら'stringの位置がおかしかったですね。

CL-USER> (decode-param "https://www.google.co.jp/search?q=land+of+lisp&oq=land+of+&aqs=chrome.1.69i59l2j69i60l3j69i57.7035j0j4&sourceid=chrome&ie=UTF-8")
; Evaluation aborted on #<SB-INT:SIMPLE-PROGRAM-ERROR "invalid number of arguments: ~S" {100420DB33}>.
CL-USER>

ってだめでした。どこの引数があかんのでしょう。

ええい、グダグダ考えるのはやめです。なぜなら、上の関数、動く部分で試しても日本語をどうにもできなかったからです。
下は、日本語でGoogle検索したときのURLの変換を試みたものです。

CL-USER> (labels ((f (lst)
                      (when lst
                        (case (car lst)
                          (#.(char-code #\%) (cons (http-byte (cadr lst) (caddr lst))
                                     (f (cdddr lst))))
                          (#.(char-code #\+) (cons #.(char-code #\space) (f (cdr lst))))
                          (otherwise (cons (car lst) (f (cdr lst))))))))
             (coerce (mapcar #'code-char (f (mapcar #'char-code (coerce "https://www.google.co.jp/search?q=%E3%81%AD%E3%81%93%EF%BC%9F+%E3%81%AB%E3%82%83%E3%83%BC&oq=%E3%81%AD&aqs=chrome.3.69i57j69i59l3j69i61l2.4874j0j9&sourceid=chrome&ie=UTF-8" 'list)))) 'string))
"https://www.google.co.jp/search?q=ã­ãï¼ ã«ãã¼&oq=ã­&aqs=chrome.3.69i57j69i59l3j69i61l2.4874j0j9&sourceid=chrome&ie=UTF-8"
CL-USER>

最初の方針に戻ります。全てバイトにしてくれるようなSBCLの関数ないかな...。

CL-USER> (defun decode-param (s)
           (labels ((f (lst)
                      (when lst
                        (case (car lst)
                          (#.(char-code #\%) (cons (http-byte (cadr lst) (caddr lst))
                                     (f (cdddr lst))))
                          (#.(char-code #\+) (cons #.(char-code #\space) (f (cdr lst))))
                          (otherwise (cons (car lst) (f (cdr lst))))))))
             (sb-ext:octets-to-string
              (coerce (f (coerce (sb-ext:string-to-octets s :external-format :utf-8) 'list))
                      'vector) :external-format :utf-8)))
; in: DEFUN DECODE-PARAM
;     (OCTETS-TO-STRING
;      (COERCE (F (COERCE (STRING-TO-OCTETS S :EXTERNAL-FORMAT :UTF-8) 'LIST))
;              'VECTOR)
;      :EXTERNAL-FORMAT :UTF-8)
; 
; caught WARNING:
;   Derived type of (REPLACE (MAKE-ARRAY (LENGTH SB-C::X)) SB-C::X) is
;     (VALUES SIMPLE-VECTOR &OPTIONAL),
;   conflicting with its asserted type
;     (VECTOR (UNSIGNED-BYTE 8)).
;   See also:
;     The SBCL Manual, Node "Handling of Types"
; 
; compilation unit finished
;   caught 1 WARNING condition
WARNING: redefining COMMON-LISP-USER::DECODE-PARAM in DEFUN
DECODE-PARAM
CL-USER>

ありました。参考にしたのはこちら。
Common Lisp と 日本語 と 文字コード

怒られていますが、どうにも手掛りがないのでとりあえず実行、"neko"を変換しようとしました。
するとこう怒られます。

Value of (REPLACE (MAKE-ARRAY (LENGTH SB-C::X)) SB-C::X) in
(OCTETS-TO-STRING
 (COERCE (F (COERCE (STRING-TO-OCTETS S :EXTERNAL-FORMAT :UTF-8) 'LIST))
         'VECTOR)
 :EXTERNAL-FORMAT :UTF-8)

is
  #(110 101 107 111),
not a
  (VECTOR (UNSIGNED-BYTE 8)).
[Condition of type SIMPLE-TYPE-ERROR]

UNSIGNED-BYTEの配列じゃないから怒られている?

CL-USER> (defun decode-param (s)
           (labels ((f (lst)
                      (when lst
                        (case (car lst)
                          (#.(char-code #\%) (cons (http-byte (cadr lst) (caddr lst))
                                     (f (cdddr lst))))
                          (#.(char-code #\+) (cons #.(char-code #\space) (f (cdr lst))))
                          (otherwise (cons (car lst) (f (cdr lst))))))))
             (sb-ext:octets-to-string
              (coerce (f (coerce (sb-ext:string-to-octets s :external-format :utf-8) 'list))
                      '(VECTOR (UNSIGNED-BYTE 8))) :external-format :utf-8)))
WARNING: redefining COMMON-LISP-USER::DECODE-PARAM in DEFUN
DECODE-PARAM
CL-USER> (decode-param "neko")
"neko"
CL-USER> (decode-param "https://www.google.co.jp/search?q=lisp+coerce+type&oq=lisp+coerce+type&aqs=chrome..69i57.12279j0j4&sourceid=chrome&ie=UTF-8")
"https://www.google.co.jp/search?q=lisp coerce type&oq=lisp coerce type&aqs=chrome..69i57.12279j0j4&sourceid=chrome&ie=UTF-8"
CL-USER> (decode-param "https://www.google.co.jp/search?q=%E3%81%AD%E3%81%93%EF%BC%9F+%E3%81%AB%E3%82%83%E3%83%BC&oq=%E3%81%AD&aqs=chrome.3.69i57j69i59l3j69i61l2.4874j0j9&sourceid=chrome&ie=UTF-8")
"https://www.google.co.jp/search?q=ねこ? にゃー&oq=ね&aqs=chrome.3.69i57j69i59l3j69i61l2.4874j0j9&sourceid=chrome&ie=UTF-8"
CL-USER>

できた! ちょっと安直かなと不安になりましたが正解だったようです。

久し振りにCommon Lisp書いて楽しかったです。もう中毒ですね。
続きは明日にします。おやすみなさい。

そうだ、Rubyやろう

今日は残業が長引いてしまい、まともに勉強をする時間がとれないので姑息に更新します。

当ブログでは当初、Common LispC++をやると宣言しておりましたが、
現状C++はほとんどやっておりません。
まあC++は永遠の夢として、直近の夢はRubyを使うことなんです、実は。
というわけでこれからはちょくちょくRuby挟もうと思っております。

Lispで転職はかなりきつそうですが、Rubyで転職なら道もありそうですし。
そんな打算ばかりでもなく、Rubyいいですよね。

これから頑張ります。参考書はどうしようかな。

Common Lispを頑張る(35)

本日も「Land of Lisp」です。
昨日は変な突っ込み方していたEmacsの設定も整理できたので最高に気分がいいです。
今日は13章、Webサーバを作り始めます。

Common Lispでのエラー処理

Webサーバのように、外の世界とやりとりする時は、常に予想外の事態が起こり得ます。
でも大丈夫!Common Lispにだって例外機能がしっかりと備わっているそうです。

関数の中で何か不味いことが起きてしまったとき、
Lisp関数はコンディションを通知することで実行環境に問題が起きたことを知らせてくれます。
自分で書くコードから直接コンディションを通知したい場合は、errorコマンドを使えばいいそう。
他の場所でエラー通知を横取りしていなければ、
プログラムの実行を中断してくれるとのことなので、試してみます。

CL-USER> (error "foo")
; Evaluation aborted on #<SIMPLE-ERROR "foo" {100190E6D3}>.
CL-USER>

エラーメッセージが返ってきました。

Stop FOOing around, numbskull!
   [Condition of type FOO]

しかし、こんな風にただテキストを返すだけではどれぐらい役に立つのか怪しいものです。
でもやっぱり大丈夫、自前のコンディションを定義することだって出来ます。

CL-USER> (define-condition foo () ()
           (:report (lambda (condition stream)
                      (princ "Stop FOOing around, numbskull!" stream))))
; in: DEFINE-CONDITION FOO
;     (FUNCALL
;      #'(LAMBDA (CONDITION STREAM)
;          (PRINC "Stop FOOing around, numbskull!" STREAM))
;      CONDITION STREAM)
; ==>
;   (SB-C::%FUNCALL
;    #'(LAMBDA (CONDITION STREAM)
;        (PRINC "Stop FOOing around, numbskull!" STREAM))
;    CONDITION STREAM)
; 
; caught STYLE-WARNING:
;   The variable CONDITION is defined but never used.
; 
; compilation unit finished
;   caught 1 STYLE-WARNING condition
FOO
CL-USER> (error 'foo) 
; Evaluation aborted on #<FOO {1001E786E3}>.
CL-USER>

warningがいっぱい出ました。使ってないよ!というのがほとんどですかね。
エラーメッセージはこんなんでした。

Stop FOOing around, numbskull!
   [Condition of type FOO]

なるほど、これでコンディションの型ごとによりわかりやすくメッセージを表示できるわけですね。

コンディションを横取りする

define-conditionでコンディション型を定義したときに与えた名前を使って、
この型のコンディションが通知された時に、プログラムを中断するかわりに実行する処理を
プログラムの上位層で書いておくことが出来るそうです。
そのためのコマンドは、handler-caseというもの。

CL-USER> (handler-case (bad-function)
           (foo () "somebody signaled foo!")
           (bar () "somebody signaled bar!"))
; in: HANDLER-CASE (BAD-FUNCTION)
;     (SB-IMPL::%HANDLER-BIND
;      ((FOO (LAMBDA (SB-IMPL::TEMP) (DECLARE #) (GO #:TAG564)))
;       (BAR (LAMBDA (SB-IMPL::TEMP) (DECLARE #) (GO #:TAG566))))
;      (RETURN-FROM #:BLOCK568 (#:FORM-FUN-570)))
; --> SB-INT:DX-FLET FLET SB-INT:DX-LET LET CONS LIST CONS 
; --> SB-INT:NAMED-LAMBDA FUNCTION 
; ==>
;   (TYPEP SB-IMPL::C 'BAR)
; 
; caught STYLE-WARNING:
;   undefined type: BAR
; 
; compilation unit finished
;   Undefined type:
;     BAR
;   caught 1 STYLE-WARNING condition
"somebody signaled foo!"
CL-USER>

色々と出てきてはいますが、プログラムが中断されることはなくfooに指定した処理が行なわれました。
handler-caseは、引数に取るのが対象のプログラム、本体にこの型のコンディションならこれ、
という感じで書いていくっぽいですね。
ちょっと変わったif、という覚えかたは雑かもしれませんが、そんなイメージです。

予想外のコンディションからリソースを保護する

予想外の例外事態が発生したときに何が起こり得るのか。
例えば、ファイルやソケットストリームに何かを書いている途中に例外が発生したら...
するとストリームが開きっぱなしになってしまい、解放してやらないと
それらの資源がずっと使用中ということになり、最悪リブートしないと使えないなんてことになるそうです。

そういった問題を避けるためにあるのが、unwind-protectコマンドだそうです。
これは、Common Lispコンパイラに「これだけは何があっても実行してくれ」と伝えるためのものだそう。

CL-USER> (unwind-protect (/ 1 0)
           (princ "I need to say 'flubyduby' matter what"))
; in: UNWIND-PROTECT (/ 1 0)
;     (/ 1 0)
; 
; caught STYLE-WARNING:
;   Lisp error during constant folding:
;   arithmetic error DIVISION-BY-ZERO signalled
;   Operation was (/ 1 0).
; 
; compilation unit finished
;   caught 1 STYLE-WARNING condition
I need to say 'flubyduby' matter what; Evaluation aborted on #<DIVISION-BY-ZERO {10027C2033}>.
CL-USER>

なんと0除算を敢行しています。
当然エラーです。でも最後にこっそり、princで指定した文字列が出力されています。
Common Lispの"with-"マクロは内部でunwind-protectを呼んでくれていることが多く、
直接unwind-protectを呼ばなければいけないことはそんなにないそうです。
安心して"with-"マクロを使っていこうと思います。

なんだか昨日はあまり眠れなかったのでとても眠いです。
ここまでにします。おやすみなさい。

番外編:Emacsを頑張る

番外編ということで、Emacsの設定をやっていこうと思います。

とっても恥ずかしいので、これまでの設定は晒さずに完全に一からいきます。

とはいえ、色々入れるためにこれだけは残します。あとSKK

;; パッケージの設定
(require 'package)
(add-to-list 'package-archives '("marmalade" . "http://marmalade-repo.org/packages/"))
(add-to-list 'package-archives '("melpa" . "http://melpa.milkbox.net/packages/") t)
(package-initialize)

;; ddskkを利用するための設定
(global-set-key (kbd "C-x C-j") 'skk-mode)
(setq default-input-method "japanese-skk")

とりあえず括弧の補完機能でも入れますか。基本ですね。

;; 括弧の自動補完機能らしい
(electric-pair-mode 1)

るびきち様のブログ(#3 反復練習に勝るものなし -- 打鍵すべし!設定書くべし! (Software Design 2014年7月号掲載記事) ヘルプシステム 困ったとき 初期設定)を
参考にさせていただき初期設定をします。
パッケージだけは入れてしまったので、それ以外ですね。どんな設定なのかは上のリンクを見ていただければ。
コメントがセミコロン3つなのでまねします。
念の為、全選択してeval-regionしてエラーにならないことを確認します。
...問題ありません。先へ進みます。

当然Common Lispの実行環境を入れなければなりません。
パッケージが使えないのはなんなんだったのでしょう。以前と同じことをしてもしょうがないので、
roswellという素敵ツールを使ってしっかりいれてみます。
Lispのパッケージ管理入門.Quicklisp,ASDF,Roswellの違いなど · wshito's diary
参考にしたのは上記の記事です。書いてあるコードをコピペしたらいけました。
...そしてここを読んでいたらどうすればパッケージを利用できるかもわかりました。
間抜けでした...もう基本的なパッケージは最初からあるものだと思っていました。
落とさなきゃいけないんですね...。あれ、もしかして最初からあるのかな。

なによりやり方が間違ってたのでしょうね。
わからないものにわからないものを重ねてたので、何が悪いのかわからなくなってました。
反省。
なにはともあれ、今度はちゃんとパッケージも使えるようになりました。

さて、とりあえずどうしても設定しておきたいものはちゃんと入れられました。
あとは...見栄え!カッチョよくしたいです!

Emacs初心者だがオススメ設定を晒させてくれ
こちらの方の設定を入れてみます。お、自動補完機能もあるんですね。
見栄えだけじゃなくこれも入れてみます。
足りないパッケージは、M-x package-list-packagesで入れてと。
ちょっと自分としては透過率が高過ぎたのでそこは変えました。
あと何かわからないものは避けてと。
しかし自動補完はどこに効いてるのかな(支離滅裂な発言)。

とりあえずこれでいいかな。エラーも起きません!
こんな感じになりました。

;;; パッケージの設定
(require 'package)
(add-to-list 'package-archives '("marmalade" . "http://marmalade-repo.org/packages/"))
(add-to-list 'package-archives '("melpa" . "http://melpa.milkbox.net/packages/") t)
(package-initialize)

;;; ddskkを利用するための設定
(global-set-key (kbd "C-x C-j") 'skk-mode)
(setq default-input-method "japanese-skk")

;;; 括弧の自動補完機能らしい
(electric-pair-mode 1)

;;; 右から左に読む言語に対応させないことで描画高速化
(setq-default bidi-display-reordering nil)
;;; splash screenを無効にする
(setq inhibit-splash-screen t)
;;; 同じ内容を履歴に記録しないようにする
(setq history-delete-duplicates t)
;; C-u C-SPC C-SPC ...でどんどん過去のマークを遡る
(setq set-mark-command-repeat-pop t)
;;; 複数のディレクトリで同じファイル名のファイルを開いたときのバッファ名を調整する
(require 'uniquify)
;; filename<dir> 形式のバッファ名にする
(setq uniquify-buffer-name-style 'post-forward-angle-brackets)
(setq uniquify-ignore-buffers-re "[^*]+")
;;; ファイルを開いた位置を保存する
(require 'saveplace)
(setq-default save-place t)
(setq save-place-file (concat user-emacs-directory "places"))
;;; 釣合う括弧をハイライトする
(show-paren-mode 1)
;;; インデントにTABを使わないようにする
(setq-default indent-tabs-mode nil)
;;; 現在行に色をつける
(global-hl-line-mode 1)
;;; ミニバッファ履歴を次回Emacs起動時にも保存する
(savehist-mode 1)
;;; シェルに合わせるため、C-hは後退に割り当てる
(global-set-key (kbd "C-h") 'delete-backward-char)
;;; モードラインに時刻を表示する
(display-time)
;;; 行番号・桁番号を表示する
(line-number-mode 1)
(column-number-mode 1)
;;; GCを減らして軽くする
(setq gc-cons-threshold (* 10 gc-cons-threshold))
;;; ログの記録行数を増やす
(setq message-log-max 10000)
;;; 履歴をたくさん保存する
(setq history-length 1000)
;;; メニューバーとツールバーとスクロールバーを消す
(menu-bar-mode -1)
(tool-bar-mode -1)
(scroll-bar-mode -1)

;;; roswellでslimeを使う
(load (expand-file-name "~/.roswell/helper.el"))  ; slime 起動スクリプト
(setq slime-lisp-implementations
      `((ros ("ros" "run"))                       ; ros run の起動設定
        (sbcl ("/opt/local/bin/sbcl"))
        (abcl ("/opt/local/bin/abcl"))
        (clisp ("/opt/local/bin/clisp"))))

;; auto-complete(自動補完)
(require 'auto-complete-config)
(global-auto-complete-mode 0.5)
;; font
(add-to-list 'default-frame-alist '(font . "ricty-12"))
;; color theme
(load-theme 'monokai t)
;; alpha
(if window-system 
    (progn
      (set-frame-parameter nil 'alpha 98)))
;; 非アクティブウィンドウの背景色を設定
(require 'hiwin)
(hiwin-activate)
(set-face-background 'hiwin-face "gray30")
;; 現在ポイントがある関数名をモードラインに表示
(which-function-mode 1)
;; タイトルにフルパス表示
(setq frame-title-format "%f")
;;current directory 表示
(let ((ls (member 'mode-line-buffer-identification
                  mode-line-format)))
  (setcdr ls
    (cons '(:eval (concat " ("
            (abbreviate-file-name default-directory)
            ")"))
            (cdr ls))))

日々改良していきたいところですが、初期設定としては満足です。
それでは、今日はここまでにします。

Common Lispを頑張る(34)

昨日の続きからやっていきます。

Lispでファイルを出力するとき、作ろうとしたファイルが既に存在していた場合どうするかは、
:if-existsキーワードで指定することができます。

CL-USER> (with-open-file (mystream "data.txt" :direction :output :if-exists :error) ;もし存在するならエラー
           (print "my data" mystream))
; Evaluation aborted on #<SB-INT:SIMPLE-FILE-ERROR "~@<~?~@[: ~2I~_~A~]~:>" {1005198FF3}>.
CL-USER> (with-open-file (mystream "data.txt" :direction :output :if-exists :supersede) ;問答無用で上書き
           (print "my data" mystream))
"my data"
CL-USER> 

wiht-open-fileを使うことで、ファイルをオープンしたりクローズしたりするコマンドを
いちいち使う必要がなくなります。便利ですね。

ソケットを使う

ここまででREPLとファイルに対してストリームを使ってみたので、
次は他のコンピュータとやりとりするためストリームを使ってみます。
標準的なネットワークにある他のコンピュータと通信するプログラムを書きたければ、
まずソケットとやらを作らなければならないそうです。
ソケットとは、ネットワークの別々のコンピュータで走っているプログラム同士がやりとりするためのメカニズムだそう。
ソケットの標準化はCommon Lispの仕様化に間に合わなかったそうで、
ここからはCLispのソケットコマンドについて解説いただけるようです。それは不味い。
当然SBCLにもあるはずなので、解説を参考にしてGoogle先生に訊きながらやっていこうと思います。

ソケットアドレス

ネットワーク上のソケットにはソケットアドレスが割り当てられているそうです。
ソケットアドレスは次の2つの要素からなるそう。
IPアドレス:ネットワーク上でコンピュータを一意に指定する番号。
■ポート番号:ネットワークを使うプログラムは、同じコンピュータで走る他のプログラムが既に使っていない
ポート番号を選んで使わなければならない。

上記の要素の条件から、ソケットアドレスは各PCのプログラムごとに一意になるはずです。
ネットワーク上を走るメッセージはTCPパケットと呼ばれ、行き先を示すソケットアドレスが付加されているそうです。
宛先のIPアドレスを持つコンピュータがソケットを受け取ると、OSがソケットアドレスのポート番号を確認して、
どのプログラムがメッセージを受け取るかを判断するようになっていると。
そのために、プログラムはポートを使うためにそのポートに結びつけられたソケットを作るそうです。
つまりソケットとは、プログラムがOSに「ポートxxxにメッセージが届いたら自分に頂戴」とするためのものなのですね。

コネクション

2つのプログラム間でソケットを使ってメッセージをやり取りするためには、
いくつかのステップを経て、コネクションとやらを初期化する必要があるそうです。
最初のステップは、一方のプログラムがソケットを作ってそれをListenすることで、
もう一方のプログラムが通信を始めるのを待つ状態に入ることだそう。
この、ソケットをListenする側のプログラムをサーバと呼ぶそうです。
もう一方はクライエントで、そちらがソケットを作った後、それを使ってサーバとコネクションを確立するそうです。
ここまでの手順で問題が起きていなければ、2つのプログラムはコネクションを通じてやりとりできるようになります。
さて、そろそろ実践してみます。

ソケット上でメッセージを送る

まずはOSからポート番号を貰わなければなりません。そしたらソケットをそのポート番号に束縛します。
どうしたものか。とりあえずSBCLのマニュアルを読んできます。
socketというクラスがあるみたいですね。これを使えばいいのかな。とりあえず試してみます。

CL-USER> (defstruct (my-socket (:include socket)))
; Evaluation aborted on #<SIMPLE-ERROR "Class is not yet defined or was undefined: ~S" {10059462E3}>.
CL-USER>

む、出来ない。...ふむふむ。読み込まねばならないものがあるんですね。

CL-USER> (require :sb-bsd-sockets)
NIL
CL-USER> (defstruct (my-socket (:include socket)))
; Evaluation aborted on #<SIMPLE-ERROR "Class is not yet defined or was undefined: ~S" {1005BD2E73}>.
CL-USER> s

読込めた気がしない、と思いつつ試してみたらやっぱり駄目でした。
う~ん、なんだろうな。パッケージを実は持っていないのでしょうか。
でもパッケージのリストを見てみると入っているんですよね。そういうことじゃないのかな。
roswellで改めてsbclインストールしてみたりしてみましたが解決できず。
悔しいですが、諦めてCLispでやっていきます。
色々やっていたら間抜けにもinit.elの設定を壊してしまったようで
それどころじゃなくなったというのもあります。悲しみ。

CL-USER> (defparameter my-socket (socket-server 4321))
MY-SOCKET
CL-USER>

定義した瞬間に「インターネット接続を許可しますか」と訊かれたので上手くいってそうです。
これはOSに、「これからポート番号の4321をmy-socketとして使うよ」と言っているんですかね。

そしてこのコマンドは少し危険だそう。使い終わったらちゃんとOSに返してあげなければ
誰もポート番号4321を使えなくなってしまうからです。

次は、このソケットへ接続したクライアントとの通信を扱うストリームを作ります。

CL-USER> (defparameter my-stream (socket-accept my-socket))

返ってこないですね...。
ああ、これでいいようです。クライアントが接続してくるまで返ってこないのが正解のよう。

さて、クライアント側の設定をしていきます。本当は別のパソコンがあればいいのですが、
残念ながらないので新しくCLispを立ち上げてやっていきます。

; SLIME 2.22
CL-USER> (defparameter my-stream (socket-connect 4321 "127.0.0.1"))
MY-STREAM
CL-USER>

"123.0.0.1"は常に現在のコンピュータ自身を指す特殊なアドレスだそうです。
気がついたらサーバ側で変化が。

CL-USER> (defparameter my-stream (socket-accept my-socket))
MY-STREAM
CL-USER>

よし、それではクライアントからメッセージを送ってみます。

CL-USER> (print "こちらクライアント、どうぞ" my-stream)
"こちらクライアント、どうぞ"
CL-USER>

サーバ側でmy-streamを確認してみます。ドキドキ。

CL-USER> (read my-stream)
"こちらクライアント、どうぞ"
CL-USER>

ああ、返ってきてくれました。本当によかった。それでは今度はサーバから送ってみます。

CL-USER> (print "こちらサーバ、どうぞ" my-stream)
"こちらサーバ、どうぞ"
CL-USER>

クライアントで受け取ります。

CL-USER> (read my-stream)
"こちらサーバ、どうぞ"
CL-USER>

...ふう、大仕事でした。

最後はお片づけをします。

CL-USER> (close my-stream)
T
CL-USER>

上記のコマンドをクライアント、サーバの両方で実行し、両端のストリームを閉じます。
後は、OSにポートを返却してソケットを開放します。

CL-USER> (socket-server-close my-socket)
NIL
CL-USER>

なんか疲れました。ネットワークというのは難しいですね。

文字列ストリーム

これまでのストリームとは違い、文字列ストリームは、
単に文字列をストリームのように見せるだけのものだそう。
他のストリームのように、文字列ストリームは文字列を読んだり、書きこんだりできるようです。

文字列ストリームは、make-string-output-streamとmake-string-input-streamで作れるとのこと。

CL-USER> (defparameter foo (make-string-output-stream))
FOO
CL-USER> (princ "This will go into foo." foo)
"This will go into foo."
CL-USER> (princ "This will also go into foo." foo)
"This will also go into foo."
CL-USER> (get-output-stream-string foo)
"This will go into foo.This will also go into foo."
CL-USER>

わざわざ文字列ストリームを使ったりするのには勿論理由があって、
デバッグに使ったり、長い文字列を作成するのに便利であるということがあるようです。

デバッグに文字列ストリーム

ストリームを引数にしている関数に、文字列ストリームを渡すことができるそうで、
それは確かに便利ですね。わざわざファイルを作ったり、ソケットを作らずとも
それらを引数にとる機能がちゃんと動いているか確認することができます。

また、そのようなデバッグを可能にするためにも、出力先はハードコーディングするのではなく
ストリームを使うようにしておくのがいいそうです。

長い文字列を作る

たくさんの文字列を一つずつ繋いでいくのは、そのままやると効率の悪い操作になるそうです。
多くの言語では文字列ビルダと呼ばれる機能を用意してそのオーバヘッドを避けており、
Lispでは文字列ストリームを使い効率を上げられるということです。

読みやすくデバッグしやすいコード

文字列ストリームを、with-output-to-stringと一緒に使うと、
読みやすくデバッグしやすいコードが書けるということで、やってみます。

CL-USER> (with-output-to-string (*standard-output*)
	   (princ "the sum of ")
	   (princ 5)
	   (princ " and ")
	   (princ "2")
	   (princ " is ")
	   (princ (+ 5 2)))
"the sum of 5 and 2 is 7"
CL-USER>

with-output-stream-to-stringマクロは、他のストリームへ向かうはずの出力を
横取りして、文字列に格納して返す様子。
上では*standard-output*に向かうprincの出力が文字列ストリームに向けられて、
処理が終わったタイミングで文字列ストリームに蓄積されたデータが文字列として返ってきています。
しかもこれは効率の悪いことをしていないので、concatenateを使うよりも効率がいいそうです。
読みやすいですしね。

これでストリームについての章は終わりです。
あと今日はinit.elの設定を見直さなければ...せっかくなのでブログにしようかな。
とりあえず締めます。

Common Lispを頑張る(33)

今日もやっていきます「Land of Lisp」。
本日は12章、ストリームについての説明の章をやります。

ストリームの種類

Common Lispと外の世界のリソースとやり取りするためには、ストリームを使います。
リソースの種類、ストリームの向きでストリームが分類できるようです。

リソースの種類による分類

ストリーム* リソース*
コンソールストリーム REPL
ファイルストリーム ディスク上のファイル
ソケットストリーム ネットワーク上の他のコンピュータ
文字列ストリーム Lispの文字列

文字列ストリームだけはCommon Lispの中だけで完結する特殊なストリームのようです。

向きによる分類

向きによる分類ったって、当然向きは入力か出力かですね。

出力ストリームの、基本操作は下記の2つだそうです。
・出力ストリームかどうかを調べる
・データをストリームへと送り出す

他のデータ型に比べるととってもシンプルです。
しかし基本操作をこれだけに制限していることこそが、ストリームをより便利にしているということです。
入力ストリームかどうか調べる、というのはoutput-stream-pを使う様子。そのままですね。

CL-USER> (output-stream-p *standard-output*)
T
CL-USER>

データをストリームへと送り出すのはwrite-charを使うということです。

CL-USER> (write-char #\x)
x
#\x
CL-USER> (write-char #\x *standard-output*)
x
#\x
CL-USER>

第二引数は送り出すストリームのようです。省略すれば標準出力へ。
参考書では戻り値はnilなのですが、自分の環境では渡した文字がそのまま返ってきています。
どっちが便利かって訊かれたらこっちのほうが便利な気がするのでまあ気にしないでいきます。
流石にこの戻り値使って判定したりしないでしょうし。

入力ストリームの基本機能も出力ストリームと同様シンプルなものです。
・入力ストリームかどうか調べる
・入力ストリームから要素を一つ取り出す

入力ストリームであるか調べるには、もう予測がつきますがinput-stream-pを使います。

CL-USER> (input-stream-p *standard-input*)
T
CL-USER>

入力ストリームから要素を取り出すには、read-charを使います。

CL-USER> (read-char)
1234
#\1
CL-USER>

1234と入力してエンターを押すと、先頭の要素である1が返ってきました。数字ですね。

ファイルの読み書き

Common Lispでファイルを読み書きする方法はいくつかあるそうですが、
一番いいのはwith-open-fileを使うことであるそうです。他のコマンドより安全だそう。
使ってみます。

CL-USER> (with-open-file (mystream "data.txt" :direction :output)
           (print "my data" mystream))
"my data"
CL-USER>

data.txtは下記のようになっていました。

"my data"

一行目の改行が気になる…。"my data"のあとに改行コードが無いのはまあいいんですけど。

まあいいや。今度は読み込んでみます。:directionキーワードの引数を:inputにすればいいですね。

CL-USER> (with-open-file (mystream "data.txt" :direction :input)
           (read mystream))
"my data"
CL-USER>

無事に読み込むことができました。じゃあdata.txtはあれでいいのか。

扱うデータ型を少し複雑にします。

CL-USER> (let ((animal-noises '((犬 . ワンワン)
                              (猫 . ニャーオ)
                              (カラス . カーカー)
                              (豚 . ブーブー))))
              (with-open-file (mystream "animal_noises.txt" :direction :output)
                (print animal-noises mystream)))
(( . ワンワン) ( . ニャーオ) (カラス . カーカー) ( . ブーブー))
CL-USER>

さてさて、animal_noises.txtの中身は…

((犬 . ワンワン) (猫 . ニャーオ) (カラス . カーカー) (豚 . ブーブー))

うん、alistがそのまま出力されています。
読み込んでみます。

CL-USER> (with-open-file (mystream "animal_noises.txt" :direction :input)
                (read mystream))
                
(( . ワンワン) ( . ニャーオ) (カラス . カーカー) ( . ブーブー))
CL-USER>

これらの書き込みと読み込みを使えば、作ったデータを一旦退避してあとで復元なんてことも簡単ですね。

短いですが、ここで切ります。出かけなきゃいけなくて…シラフで返ってきたら更新します。

Common Lispを頑張る(32)

今日は「Land of Lisp」のヤバイゲームを解読します…できたらいいな。

ロボットの逆襲

このゲームではプレイヤーの任務はロボットの殲滅です。
ロボットもロボットで、ひたすらプレイヤーを殺すために近寄ってきます。
ロボットとロボットが接触すると接触した2体が壊れます。スクラップにぶつかっても壊れます。
ロボットとプレイヤーが接触すればゲームオーバー、全てのロボットを破壊すればゲームクリアです。

ヤバイのはゲーム内容ではありません。実装です。

CL-USER> (defun robots ()
           (loop named main
                with directions = '((q . -65) (w . -64) (e . -63) (a .  -1)
                                    (d .  -1) (z .  63) (x .  64) (c .  65))
                for pos = 544
                then (progn (format t "~%qwe/asd/zxc to move, (t)eleport, (l)eave:")
                            (force-output)
                            (let* ((c (read))
                                   (d (assoc c directions)))
                              (cond (d (+ pos (cdr d)))
                                    ((eq 't c) (random 1024))
                                    ((eq 'l c) (return-from main 'bye))
                                    (t pos))))
                for monsters = (loop repeat 10
                                    collect (random 1024))
                then (loop for mpos in monsters
                          collect (if (> (count mpos monsters) 1)
                                      mpos
                                      (cdar (sort (loop for (k . d) in directions
                                                        for new-mpos = (+ mpos d)
                                                        collect (cons (+ (abs (- (mod new-mpos 64)
                                                                                 (mod pos 64)))
                                                                         (abs (- (ash new-mpos -6)
                                                                                 (ash pos -6))))
                                                                      new-mpos))
                                                  '<
                                                  :key #'car))))
                when (loop for mpos in monsters
                          always (> (count mpos monsters) 1))
                return 'player-wins
                do (format t
                           "~%|~{~<|~%|~,65:;~A~>~}|"
                           (loop for p
                                below 1024
                                collect (cond ((member p monsters)
                                               (cond ((= p pos) (return-from main 'player-loses))
                                                     ((> (count p monsters) 1) #\#)
                                                     (t #\A)))
                                              ((= p pos)
                                               #\@)
                                              (t
                                               #\ ))))))
ROBOTS
CL-USER>

う〜ん…とりあえず遊んでみます。

qwe/asd/zxc to move, (t)eleport, (l)eave:w

|                                                                |
|                                                                |
|                                                                |
|                                                                |
|                                   A         #                  |
|                                    #       @#                  |
|                                                                |
|                            #                                   |
|                                                                |
|                                                                |
|                                                                |
|                                                                |
|                                                                |
|                                                                |
|                                                                |
|                                                                |
qwe/asd/zxc to move, (t)eleport, (l)eave:x

PLAYER-WINS
CL-USER>

勝てました。さて、ここでもう一度関数の全貌を見てみます。

CL-USER> (defun robots ()
           (loop named main
                with directions = '((q . -65) (w . -64) (e . -63) (a .  -1)
                                    (d .  -1) (z .  63) (x .  64) (c .  65))
                for pos = 544
                then (progn (format t "~%qwe/asd/zxc to move, (t)eleport, (l)eave:")
                            (force-output)
                            (let* ((c (read))
                                   (d (assoc c directions)))
                              (cond (d (+ pos (cdr d)))
                                    ((eq 't c) (random 1024))
                                    ((eq 'l c) (return-from main 'bye))
                                    (t pos))))
                for monsters = (loop repeat 10
                                    collect (random 1024))
                then (loop for mpos in monsters
                          collect (if (> (count mpos monsters) 1)
                                      mpos
                                      (cdar (sort (loop for (k . d) in directions
                                                        for new-mpos = (+ mpos d)
                                                        collect (cons (+ (abs (- (mod new-mpos 64)
                                                                                 (mod pos 64)))
                                                                         (abs (- (ash new-mpos -6)
                                                                                 (ash pos -6))))
                                                                      new-mpos))
                                                  '<
                                                  :key #'car))))
                when (loop for mpos in monsters
                          always (> (count mpos monsters) 1))
                return 'player-wins
                do (format t
                           "~%|~{~<|~%|~,65:;~A~>~}|"
                           (loop for p
                                below 1024
                                collect (cond ((member p monsters)
                                               (cond ((= p pos) (return-from main 'player-loses))
                                                     ((> (count p monsters) 1) #\#)
                                                     (t #\A)))
                                              ((= p pos)
                                               #\@)
                                              (t
                                               #\ ))))))
ROBOTS
CL-USER>

落ち着いてひとつずつ解読します。

(loop named ... with ... for ... then ... when ... do ...)が関数全体の屋台骨って感じがします。
namedはループに名前をつけて、return-fromでのその名前を指定すればループ全体からの脱出を可能にするのですね。
withはローカル変数を定義する役目を持っているそう。'='を使うのが特異な感じがしますね。
forはループに伴い変化する変数。おなじみですね。
thenは、ふーむ、ちょっと試してみます。

CL-USER> (loop repeat 5 for x = 10.0 then (/ x 2) collect x)
(10.0 5.0 2.5 1.25 0.625)
CL-USER> (loop repeat 5 for x = 10.0 do (/ x 2) collect x)
(10.0 10.0 10.0 10.0 10.0)
CL-USER>

最初の一回は引数(と言っていいのかな)をそのまま使い、それ以降はthenの後にある処理でxを更新しているようです。
whenは普通のwhenとそんなに変わらなさそう。その後の条件式が真なら続く処理を実行する感じですね。
doもおなじみ。ループのたびに実行される処理ですね。
よし、更に見ていきます。

最初のnamedでloop全体の名前をmainとしていますね。
続くwithでローカル変数directionを定義。これはキーと進む方向のセットのリストですね。
マスは64*16で1024。真上に行くなら-64、左なら-1…そんな感じ。
次はforでposを544と定めています。posはプレイヤーの初期位置ですかね。
thenの中でprognを使い、入力を促して、cにプレイヤーの入力を格納。
dには入力に対応するキーのリストをdirectionから探して格納します。
dがnilでなければ、posに入力に対応する移動をさせます。
tならテレポートでランダムなマスへ、lならreturn-fromでゲームを終了。
それ以外のキーならば、プレイヤーはposから移動しません。

次はforでmonstersにランダムなゲームマス上の位置を10個リストにしたものを格納。
そしてthenではまずloopを用いてmonstersの要素を取り出しmposへ入れています。
もしmposがmonstersの中に1以上あったら、つまり1マスに複数のロボットがいたらmposをそのまま返し、
そうでなければ…むむむ。…一回落ち着こう。
directionsから要素を取り出します。進む方向を得るためにdirectionsを利用するのですね。
そしてnew-posとしてmposにdirectionから得た方向を足したものを定義。
その後はnew-posからプレイヤーの位置への「マンハッタン距離」を計算、結果をnew-posとのペアにします。
sortでマンハッタン距離を比較し、ソートの結果最もプレイヤーに近い位置になるnew-posを新しいposとし、
それらでmonstersを更新するのですね。

次はまずwhenです。モンスターズのすべての要素が、他の要素と重複しているか調べ、
それはつまり全てのロボットがスクラップになっているということなので、
もしそうならプレイヤーの勝利だと示しループを終了します。

そうでなければdoです。ここのformatは「まだ気にしなくていい」と参考書にコメントされていますが気になります。
まずは改行していますね。そして縦棒を出力。ここからリスト内をループすることが示されます。
そしてブロックに入ります。縦棒、改行、縦棒の出力がありますが、昨日のようにはもう騙されません。
この後に",~65:;"がありますので、これは65文字を超えた時に初めて出力されます。
一行の終わりと新しい一行の開始の縦棒、改行、縦棒ですね。
そして"~A"で引数を整形して出力、ブロックが終了。
しかしループが続きますのでリストの要素が尽きるまで引数と縦棒と改行の出力が繰り返されます。
ループが終わったら、最後の縦棒を置いて全体の一回りが終わります。

さて、最後に解読しなくてはならないのはformatの値の引数の部分ですね。
ここもループでリストを作っています。ループ回数はマスの数の分だけ1024回、
ループが何回目かはpで示されます。ループ回数とマスは完全に対応しています。
pが0ならそれは一番左上のマスについてのループであり、63ならば一番右上についてのループです。
condでmonstersにpが含まれているか、つまりそこにロボットがいるかを調べます。
もしいるならば、更にcondを用いて、まずはプレイヤーと同じマスにいるかを調べます。
もし同じマスにいるのならば、プレイヤーの敗北を示しループ終了です。
そうでなければ、そのマスに他にロボットがいるかを調べ、もしいるのならばスクラップを描写するために
formatに渡して値引数とするための#\#をリストの要素とします。
プレイヤーもいないロボットも一体だけというならば、リストに入る要素は#\Aです。
そしてプレイヤーがいるマスであれば、#\@をリストに渡し、
何も無ければ#\ (ただのスペース)をリストに入れます。

…終わった。解読完了です。
嬉しいですが、これを自分で作るのはまだ無理です。loopとformatの力に戦慄しています。

今日は1ページ、しかも1関数だけで2時間以上使ってしまいました。
まだまだハッカーにはなれそうもないですね。

今日もまた未熟さを感じたのでもう少し勉強を続けますが、記事としてはここまでです。
皆様の健やかな週末を願って終わります。