clispはANSI Common Lisp(以下Common Lispと略す。)だ。 jpnslisp(jpnslisp日本語Lisp、jpnslisp日本語Lisp for Linux)は Common Lispのサブセットだ。サブセットだからCommon Lispの全ての 機能を実現しているわけではない。例えばjpnslispではローカル関数を 使えない。つまりFLET、LABELSを使えない。組み込み関数もCommon Lisp ほど豊富ではない。これらはLAMBDA式を使ったり関数をLispプログラムとして 自作することで解決することが多い。
この稿では一例として書籍「Land of Lisp」に載っているテキストゲームを
jpnslispで動かす場合の変更点のみについて述べる。このテキストゲームは
clispを使うことを念頭に入れて書かれたものだがjpnslispでも、わずかな
変更で動かせる。
変更を受けたプログラムはもちろんclispでも動く(重複する関数はSKIPされたい。)。
(「Land of Lisp」はオライリー・ジャパンから発行されオーム社から出版
されている。Conrad Barski,M.D.著、川合志朗訳。)(ここではjpnslisp
日本語Lisp3.08またはjpnslisp日本語Lisp for Linux2.08を使っている。)
テキストゲーム(アドベンチャーゲーム)は「Land of Lisp」の第5章、第6章、
第17章に載っている。(コードはインターネットからダウンロードできるようだ。
どちらにしろコードを試すにはインタープリタに直接打ち込まず、テキスト
エディタでファイルを編集すべきだ。)
まずは68ページの関数object-atだ。LABELSは使えないから次のように変更する。
(defun objects-at (loc objs obj-locs)
(let ((at-loc-p (coerce `(lambda (obj)
(eq (cadr (assoc obj ',obj-locs)) ',loc) ) 'function)))
(remove-if-not at-loc-p objs) ) )
remove-if-notの第1引数の#'も落としておく。また関数remove-if-notも未実装 だから次のように記述しておく。
(defun remove-if-not (test lst)
(let ((ans nil))
(loop
(if (atom lst) (return ans))
(if (funcall test (car lst)) (setq ans (append ans (list (car lst)))))
(setq lst (cdr lst)) ) ) )
次は69ページの関数describe-objectsだ。LABELSが使えないが、この中の ローカル関数describe-objは外に出してもよい。次のように記述する。
(defun describe-obj (obj) `(you see a ,obj on the floor.))
したがって関数describe-objectsはつぎのようになる。
(defun describe-objects (loc objs obj-loc)
(apply #'append (mapcar #'describe-obj (objects-at loc objs obj-loc))) )
次は72ページの関数walk。findが未実装だからmy-findを次のように定義する。
(defun my-find (x lst)
(let ((y (member x lst :test #'(lambda (x y) (equal x (cadr y))))))
(if (null y) nil (car y)) ) )
そして関数walkは次のようになる。
(defun walk (direction)
(let ((next (my-find direction (cdr (assoc *location* *edges*)))))
(if next
(progn (setf *location* (car next))
(look))
'(you cannot go that way.))))
73ページの関数pichupで使われるマクロpushを次のように記述する。
(defmacro push (x y)
`(setq ,y (cons ,x ,y)))
85ページの関数game-replで使われるunlessは未定義だから次のように 定義する(もし変更プログラムをclispで走らせようとするのならその 時にはunlessの定義ははずしたほうがいいかもしれない。)。
(defmacro unless (test &rest b)
`(if (not ,test) (progn ,@b)) )
86ページのgame-readだが、この関数内のread-from-stringは現在のところ jpnslispに無い。代わりの定義も不可能だ。したがって関数quote-itを ローカルからグローバルにし(次)、
(defun quote-it (x)
(list 'quote x) )
関数game-readを次のように定義する。
(defun game-read ()
(let ((cmd (read)))
(if (listp cmd)
(cons (car cmd) (mapcar #'quote-it (cdr cmd)))
'(dummy) ) ) )
ゲームをする時、我々は例えば
walk east
と入力する代わり
(walk east)
と左右にカッコをつけて入力しなければならないがこれは
ご容赦願いたい。
89ページの関数tweak-textは使わない。代わりに次のように関数
tweakを定義し、
(defun tweak (lst caps)
(if (atom lst) nil
(let* ((word (symbol-name (car lst)))
(letters (mapcar #'char-downcase (coerce word 'list))) )
(cond
(caps
(princ (coerce (cons (char-upcase (car letters)) (cdr letters)) 'string))
(princ #\ )
(if (member (car (last letters)) '(#\. #\! #\?))
(tweak (cdr lst) t)
(tweak (cdr lst) nil) ) )
(t
(princ (coerce letters 'string))
(princ #\ )
(if (member (car (last letters)) '(#\. #\! #\?))
(tweak (cdr lst) t)
(tweak (cdr lst) nil) ) ) ) ) ) )
関数game-printを次のように書き換える。
(defun game-print (lst)
(tweak lst t) (terpri) )
これはprin1-to-stringが使えないことによる。
またchar-upcase、char-downcaseは未実装だから次のように定義する。
(defun char-upcase (c)
(if (and (<= (char-code #\a) (char-code c)) (<= (char-code c) (char-code #\z)))
(code-char (- (char-code c) (- (char-code #\a) (char-code #\A))))
c ) )
(defun char-downcase (c)
(if (and (<= (char-code #\A) (char-code c)) (<= (char-code c) (char-code #\Z)))
(code-char (+ (char-code c) (- (char-code #\a) (char-code #\A))))
c ) )
pushnewは未定義だから次のようにマクロ定義する。
(defmacro pushnew (obj lst)
`(if (member ,obj ,lst) nil (push ,obj ,lst)) )
変更点は以上だ。jpnslispを立ち上げたら
>(load "ファイル名")
とし、
>(game-repl)
と入力してゲームを始められる。始めたら
(look)
(quit)
(weld chain bucket)
などのコマンドが全て使える。