CMU Common Lisp メモ
目次
- バイナリデータを扱う
- 多重ループマクロ
- The Common Lisp Cookbook - Using Emacs as a Lisp IDE
- Osicat - POSIX ライクシステムとのインターフェース
- Multiprocessing メモ
- fare-matcher でパターンマッチ
- stumpwm - Common Lisp な Window Manager (2)
- stumpwm - Common Lisp な Window Manager
- cl-readline
- CMUCL のビルドについて
- Java ライクな try ... catch
- lambda 式を書きやすく
- 日本語シンボル
- LOOP いろいろ
- Hash テーブルをファイルに保存する
- List Comprehension - defmacro によるリストの内包表記
- IMHO (Internet Metahumble Object) - Common Lisp で Web システム
- CommonLisp を少し Python ライクに
- clocc + cmucl 18e
- clisp みたいに readline ライブラリの支援が欲しい
- Hemlock を使う
- 外部プロセスを呼ぶ
- プロファイルを取る
- 他の言語と仲良くする
- 考え中
バイナリデータを扱う
Lisp でバイナルデータを読み書きする都合があったので，こんなもの を作ってみた． アラインメントとかはまったく意識してないので他の言語とのやりとりにはイマイチ使えない…．
アラインメントを考えなくて良い↓例
>>> N = 13
>>> lst = [ random.random() for x in range(N) ]
>>> f = open("data", "w")
>>> f.write(struct.pack("l", N))
>>> for x in lst: f.write(struct.pack("f", x))
...
>>> f.close()
(defun try ()
(with-open-file (s "data" :direction :input)
(let ((N (first (struct:binary-unpack s "l"))))
(loop repeat N collect (struct:binary-unpack s "f")))))
多重ループマクロ
プログラムには多重のループが良くでてくる．こいつをマクロにしたら楽になるかも しれないと思い，マクロの練習にいくつか作ってみた．まず，多重の dolist．let と let* みたいな感じで仮に dolist* という名前にしてみた．
CL-USER> (let ((result nil))
(dolist* ((i '(1 2 3))
(j '(4 5 6))
(k '(A B C)))
(push (list i j k) result))
(nreverse result))
((1 4 a) (1 4 b) (1 4 c) (1 5 a) (1 5 b) (1 5 c) (1 6 a) (1 6 b) (1 6 c)
(2 4 a) (2 4 b) (2 4 c) (2 5 a) (2 5 b) (2 5 c) (2 6 a) (2 6 b) (2 6 c)
(3 4 a) (3 4 b) (3 4 c) (3 5 a) (3 5 b) (3 5 c) (3 6 a) (3 6 b) (3 6 c))
…これではリストしか使えないのでいまいち使いでがない．そこで，loop を拡張して loop* というのを作ってみた．(サンプル実装はこちら : for {in,across,from-to} と when, collect, count, do 節を実装．ついでに list, vector, hash に対応)
CL-USER> (loop* for i in '(1 2 3)
for j in '(4 5 6)
for k in '(A B C)
collect (list i j k))
((1 4 a) (1 4 b) (1 4 c) (1 5 a) (1 5 b) (1 5 c) (1 6 a) (1 6 b) (1 6 c)
(2 4 a) (2 4 b) (2 4 c) (2 5 a) (2 5 b) (2 5 c) (2 6 a) (2 6 b) (2 6 c)
(3 4 a) (3 4 b) (3 4 c) (3 5 a) (3 5 b) (3 5 c) (3 6 a) (3 6 b) (3 6 c))
というのはどうだろうか？なんとなくリストの内包表記にも似ているような気がするが．これは
CL-USER> (macroexpand '(loop* for i in '(1 2 3) for j in '(A B C) collect i))
(block nil
(let ((#:|acc5484| nil))
(let* ((#:in5482 '(1 2 3)) (i (car #:in5482)))
(block #:loop5485
(tagbody
#:begin5486
(if (null #:in5482) (go #:end5487))
(let* ((#:in5483 '(a b c)) (j (car #:in5483)))
(block #:loop5488
(tagbody
#:begin5489
(if (null #:in5483) (go #:end5490))
(push i #:|acc5484|)
(setq #:in5483 (cdr #:in5483))
(setq j (car #:in5483))
(go #:begin5489)
#:end5490
(return-from #:loop5488))))
(setq #:in5482 (cdr #:in5482))
(setq i (car #:in5482))
(go #:begin5486)
#:end5487
(return-from #:loop5485))))
(nreverse #:|acc5484|)))
というように展開されるため，手動でループを書くのとあまり効率的にはかわらない． 標準の loop とごっちゃになるのが欠点…．やはりこれはマクロの悪用例なのだろう か？なかなか難しいなぁ．
で，loop の復習のためにぼんやりと PAIP を読んでいたら，Scheme と Common Lisp の hoge! hoge? と n-hoge hoge-p の話が出ていた．首尾一貫という点からは Scheme の ! や ? のほうが優れているが，この Scheme 式の名前の問題点が一つ指 摘されていた．ズバリ，発音．equal? は "equal-question-mark" か "equal-q" か イントネーションをつけた "equal" か？なるほど，foodp のように p をつける昔な がらの lisp スタイルは発音では悩まなくてすむ（でも，ハイフネーションの規則は 恐しく不明瞭）．
追記:
え〜なかなか効率的な実装ができて面白いとは思うのですが，いかんせん名前が悪い ですね．効率的には，以前の List Comprehension で紹介した pyth や多言語と比較 するとかなり良いけど名前がなぁ…．結果のリストを必要とせずに副作用だけが欲し い場合とかは List Comprehension はもったいないような…．
CL-USER> (defun pyth (n)
(loop* for a from 1 below n
for b from a below n
for c from b below n
if (= (+ (* a a) (* b b)) (* c c))
collect (list a b c)))
CL-USER> (compile 'pyth)
CL-USER> (time (pyth 200))
; Evaluation took:
; 0.35 seconds of real time
; 0.308672 seconds of user run time
; 0.0 seconds of system run time
; 263,385,667 CPU cycles
; 0 page faults and
; 4,000 bytes consed.
CL-USER> (defun pyth (n)
(list-of (list a b c)
(a in (upto 1 n))
(b in (upto a n))
(c in (upto b n))
(= (+ (* a a) (* b b)) (* c c))))
CL-USER> (compile 'pyth)
CL-USER> (time (pyth 200))
;; ; Evaluation took:
;; ; 0.54 seconds of real time
;; ; 0.463479 seconds of user run time
;; ; 0.0 seconds of system run time
;; ; 400,120,170 CPU cycles
;; ; 0 page faults and
;; ; 11,318,480 bytes consed.
# python 2.3 # - 2.6 sec > [[a, b, c] for a in range(1,n) for b in range(a,n) for c in range(b,n) if c*c==(a*a)+(b*b)]
The Common Lisp Cookbook - Using Emacs as a Lisp IDE
ILC2003 での Bill Clementson の講演 を元に cl-cookbook に追加されたもの．Emacs を Lisp の統合開発環境として使うノウハウ．
http://cl-cookbook.sourceforge.net/emacs-ide.html
特に Working with Lisp Code は他人に lisp を勧めるときは是非見せておきたい． S 式支援のコマンド類の例が充実しているのが嬉しい．
Osicat - POSIX ライクシステムとのインターフェース
UFFI を使ったシステムとのインターフェース． http://common-lisp.net/project/osicat/ から入手可能．
- ディレクトリのイテレーションと削除
- 環境変数
- シンボリックリンク
- ファイルのパーミッション
- ファイルタイプの識別
といった機能を持ちます．
* (with-directory-iterator (next "/")
(loop for entry = (next)
while entry
when (member 'group-write (file-permissions entry))
collect entry))
(#P"/home" #P"/vmlinuz" #P"/tmp" #P"/initrd.img" #P"/initrd.img.old")
* (file-permissions "/initrd.img")
(USER-READ USER-WRITE
USER-EXEC
GROUP-READ
GROUP-WRITE
GROUP-EXEC
OTHER-READ
OTHER-WRITE
OTHER-EXEC)
* (file-kind "/initrd.img")
:SYMBOLIC-LINK
* (read-link "/initrd.img")
#P"boot/initrd.img-2.4.20-3-686"
*
Multiprocessing メモ
CMUCL for x86 にはマルチスレッドを実現するための Multiprocessing (MP) パッケー ジがあります．これは Lisp で実現されているため，x86 上の CMUCL なら環境を問 わず使える…ような気がしますが，念のため ∗features∗ を確認して ください．
で，注意すべきなのは mp::idle-process-loop のドキュメント部分にあるコレです．
"idle loop to be run by the initial process. The select based event server is called with a timeout calculated from the minimum of the idle-loop-timeout and the time to the next process wait timeout. To avoid this delay when there are runnable processes the idle-process should be setup to the initial-process. If one of the processes quits by throwing to %end-of-the-world then quitting-lisp will have been set to the exit value which is noted by the idle loop which tries to exit gracefully destroying all the processes and giving them a chance to unwind."
よーするに idle-process-loop は initial process によって実行されなきゃならん わけです．initial process を idle-process-loop で使っちゃったら操作できない じゃん!! というわけで，対話的に使いたい場合は top-level-loop を make-process して動かしておくわけですが，mp パッケージに入っている startup-idle-and-top-level-loops という関数を使えばこの辺が一発でできて便利 です．
* (mp::startup-idle-and-top-level-loops)
* (defun foo () (sleep 10) (print 'foo) (foo))
foo
* (defun bar () (sleep 20) (print 'bar) (foo))
bar
* (mp:make-process #'foo :name "foo-1")
#<Process foo-1 {48908825}>
* (mp:make-process #'bar :name "bar-1")
#<Process bar-1 {48912FED}>
*
foo
foo
bar
foo
foo
で，cmucl-user マニュアルを見たら…あら？記述がない？というわけで，どうやら ドキュメントは documentation で読める分とソースコードしかない模様． src/multi-proc.lisp から public となってるやるを↓にまとめてみました． 「wait する」っておかしいかな？
(* 関数 *)
process-whostate (process) - process の状態を返す
process-active-p (process) - process が Active かどうかを調べる
process-alive-p (process) - process が生きている（:active 又は :inactive）かどうかを調べる
current-process () - カレントプロセスを返す
all-processes () - 全てのプロセスのリストを返す
make-process (function &key (name "Anonymous") (run-reasons (list :enable)) (arrest-reasons nil) (initial-bindings nil))
- function を実行する process を作成する
process-interrupt (process function) - process に割り込んで function を評価する
destroy-process (process) - process を削除する
disable-process (process) - process を :inactive にする
enable-process (process) - process を :active にする
(process-wait (whostate predicate &rest args)
- process は predicate が真を返すまで wait する．
process-wait-with-timeout (whostate timeout predicate &rest args)
- process は predicate が真を返すか，timeout で
指定した秒数が過ぎるまで wait する．
process-yield () - 他のプロセスに実行を譲る
process-run-time (process) - プロセスの実行時間を返す
process-idle-time (process) - idle 時間を返す
process-wait-until-fd-usable (fd direction &optional timeout)
- FD が direction に対して利用可能になるまで wait して真を返す．
timeout 秒過ぎた場合は nil を返す．
sleep (n) - N 秒間サスペンドする．N は非負，非複素数の数．（つまり小数は OK）
show-processes (&optional verbose) - 全てのプロセスとその状態を表示する．
verbose が t ならさらに run, real, idle 時間を表示する．
(* マクロ *)
without-scheduling (&body body) - body を実行中はスケジューリングをしない
with-timeout ((timeout &body timeout-forms) &body body)
- body を実行し，body の最後のフォームの値を返す．
しかし，もし実行に timeout よりも長い時間がかかったら，
実行を中断して timeout-forms を評価し，その値を返す．
with-lock-held ((lock &optional (whostate "Lock Wait") &key (wait t) timeout) &body body)
- lock を保持したまま body を実行．もし，lock が他のプロセスによって
保持されていたなら lock が解放されるまで wait する．
timeout は process-wait-with-timeout と同じ秒を受けとり，
timeout に達っしたら nil が返る．
wait が nil ならば，ロックが他のプロセスに保持されていた場合は
body を処理せずに，すぐに nil が返る．
MP パッケージの API
さらに，CMUCL のランタイムがインタラプトセーフじゃないので危険ではあるが，
start-sigalrm-yield (&optional (sec 0) (usec 500000)) process-yield をコールする SIGALRM 割り込みを開始する
なんてのもあるみたい．ただし，MP パッケージからエクスポートされていない事からもわかるように， お勧めはできない．
fare-matcher でパターンマッチ
S 式ベースのパターンマッチを実現する http://www.cliki.net/fare-matcher ．まぁ， ML/ocaml/Haskell とかが持ってるやつと似たようなもんです．良く知らない人むけ にサンプルを書いてみました．
(use-package :fare-matcher)
(defparameter *table* #(:bell 7 :plum :cherry :bar))
(defun roll ()
(let ((len (length *table*)))
(aref *table* (random len))))
(defun show-and-check (x y z)
(format t "| ~6A | ~6A | ~6A |" x y z)
(ematch (list x y z)
((list 7 7 7) (format t "=> SEVEN !!~%") 100)
((list :cherry :cherry :cherry) (format t "=> CHERRY!!~%") 10)
((list :cherry :cherry _) (format t "=> CHERRY!!~%") 4)
((list :cherry _ _) (format t "=> CHERRY!!~%") 2)
(_
(cond ((and (eql x y) (eql x z))
(format t "=> ~A~%" x) 5)
(t
(format t "=> MISS~%") 0)))))
(defun game ()
(show-and-check (roll) (roll) (roll)))
(defun simulate ()
(let ((money 100))
(dotimes (i 30)
(if (> money 3)
(decf money 3)
(return))
(incf money (game)))
(format t "~%~%RESULT: ~A~%" money)))
こんな拡張ができちゃうから Lisp はやめられない…．
stumpwm - Common Lisp な Window Manager (2)
stumpwm は今のところ asdf のパッケージシステムに対応していないようだし，起動 するとその CMUCL プロセスが Window Manager 専用になてしまいもったいない．そ こで，asdf 対応 + Multiprocessing パッケージの機能を使って別スレッドで stumpwm を動かすことにしてみた．以下のパッチをどーぞ．
diff -crN stumpwm.orig/stumpwm-util.lisp stumpwm/stumpwm-util.lisp
*** stumpwm.orig/stumpwm-util.lisp Thu Jan 1 09:00:00 1970
--- stumpwm/stumpwm-util.lisp Sat Sep 20 16:55:40 2003
***************
*** 0 ****
--- 1,11 ----
+ (in-package #:stumpwm)
+
+ (defun xinit ()
+ (assert (eq mp::*current-process* mp::*initial-process*) ()
+ "Only the *initial-process* is intended to run the idle loop")
+ (mp::init-multi-processing) ; Initialise in case MP had been shutdown.
+ ;; Start a new Top Level loop.
+ (mp::make-process #'mp::top-level :name "Top Level Loop")
+ (mp::make-process #'(lambda () (stumpwm:stumpwm "" :display 0)) :name "The Stump Window Manager")
+ ;; Enter the idle loop.
+ (mp::idle-process-loop))
diff -crN stumpwm.orig/stumpwm.asd stumpwm/stumpwm.asd
*** stumpwm.orig/stumpwm.asd Thu Jan 1 09:00:00 1970
--- stumpwm/stumpwm.asd Sat Sep 20 13:50:41 2003
***************
*** 0 ****
--- 1,10 ----
+ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*-
+
+ (use-package :asdf)
+
+ (defsystem :stumpwm
+ :components ((:file "stumpwm")
+ (:file "stumpwm-user" :depends-on ("stumpwm"))
+ (:file "stumpwm-input" :depends-on ("stumpwm"))
+ (:file "stumpwm-util" :depends-on ("stumpwm"))))
+
~/.cmucl-init に
(load "~/commonlisp/stumpwm/stumpwm.asd") (asdf:oos 'asdf:load-op :stumpwm)
を追加し，
kterm -e lisp -eval '(stumpwm::xinit)'
で起動すれば OK.
stumpwm - Common Lisp な Window Manager
とうとうでました．Common Lisp で書かれた Window Manager です．その名も The Stump Window Manager 略して stumpwm !! 100% Common Lisp で書かれた Window Manager です．他にも eclipse なんてのもありますが，使ったことありません．
xinitrc に
exec lisp -load stumpwm.lisp -load stumpwm-user.lisp -load stumpwm-input.lisp -eval '(require :clx)' -eval '(stumpwm:stumpwm "" :display 0)'
とでも書いておけばおっけー．キーボード操作のみ，画面は常に最大化と ION みた いな使用感です．カスタマイズしまくれば使い易くなるのかなぁ．
cl-readline
cl-readline-0.3.0 を FreeBSD + cmucl 2003-09-05 CVS 版で動かすパッチ．
diff -crN cl-readline-0.3.0.orig/Makefile cl-readline-0.3.0/Makefile
*** cl-readline-0.3.0.orig/Makefile Sat May 17 06:00:00 2003
--- cl-readline-0.3.0/Makefile Fri Sep 5 21:13:55 2003
***************
*** 3,8 ****
--- 3,14 ----
all: cl-readline.o cl-termios.o
+ cl-readline.o: cl-readline.c
+ gcc -Wall -c cl-readline.c -I/usr/local/include
+
+ cl-termios.o: cl-termios.c
+ gcc -Wall -c cl-termios.c -I/usr/local/include
+
.PHONY: dist
dist:
mkdir $(NAME)
diff -crN cl-readline-0.3.0.orig/cl-readline.c cl-readline-0.3.0/cl-readline.c
*** cl-readline-0.3.0.orig/cl-readline.c Sat May 17 06:00:00 2003
--- cl-readline-0.3.0/cl-readline.c Fri Sep 5 21:12:05 2003
***************
*** 21,26 ****
--- 21,27 ----
* SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
*/
+ #include <stdio.h>
#include <string.h>
#include <stdlib.h>
#include <readline/readline.h>
***************
*** 77,84 ****
size_t len = strlen (str);
if (0 == target)
{
root = NULL;
- node_t * tmp = collection;
while (len && tmp)
{
if (0 == strncmp (str, tmp->str, len))
--- 78,85 ----
size_t len = strlen (str);
if (0 == target)
{
+ node_t *tmp = collection;
root = NULL;
while (len && tmp)
{
if (0 == strncmp (str, tmp->str, len))
***************
*** 118,128 ****
void
use_custom_complete (void)
{
! rl_completion_entry_function = custom_completer;
}
void
use_filename_complete (void)
{
! rl_completion_entry_function = rl_filename_completion_function;
}
--- 119,130 ----
void
use_custom_complete (void)
{
! rl_completion_entry_function = (Function*)custom_completer;
}
void
use_filename_complete (void)
{
! //rl_completion_entry_function = rl_filename_completion_function;
! rl_completion_entry_function = (Function*)custom_completer;
}
diff -crN cl-readline-0.3.0.orig/packages.lisp cl-readline-0.3.0/packages.lisp
*** cl-readline-0.3.0.orig/packages.lisp Sat May 17 06:00:00 2003
--- cl-readline-0.3.0/packages.lisp Fri Sep 5 21:23:46 2003
***************
*** 34,45 ****
without-echo
))
! (uffi:load-foreign-library "/lib/libreadline.so.4"
:module "readline")
! (uffi:load-foreign-library "cl-readline.o"
:module "cl-readline")
! (uffi:load-foreign-library "cl-termios.o"
:module "cl-termios")
--- 34,45 ----
without-echo
))
! (uffi:load-foreign-library "/usr/lib/libreadline.so"
:module "readline")
! (uffi:load-foreign-library "/home/lambda/commonlisp/cl-readline-0.3.0/cl-readline.o"
:module "cl-readline")
! (uffi:load-foreign-library "/home/lambda/commonlisp/cl-readline-0.3.0/cl-termios.o"
:module "cl-termios")
CMUCL のビルドについて
cmucl のビルド方法は ./configure; make といった形式とは異なっているので最初はちょっと戸惑う．
- CMUCL のソースを入手（http://www.cons.org/cmucl/download.html탋
- Pierre Mai 氏の build scripts を入手（http://www.pmsf.de/graphics/PMSF-prm-title-small.png탋
- 現在 build scripts が対応している OS (Linux, OpenBSD, Solaris) 以外の OS を使っている場合は create-target.sh に使用している OS のエントリを書き足す．
- CMUCL の src/bootfiles 以下にある bootfiles を CVS の日付や ChangeLog を辿って必要ならば src/bootstrap.lisp から読み込むようにする．（bootfile を使う必要がなければ bootstrap.lisp 自体作成しなくても OK）
あとは Pierre Mai 氏のサイトの手順にしたがってビルドできる．bootfiles のあたりはややこしい．
Java ライクな try ... catch
comp.lang.lisp の Kent.M.Pitman の記事
(defmacro try (code &rest catches)
(let* ((block-tag (gensym "TRY-BLOCK"))
(code-tag (gensym "DISPATCH"))
(tag-temp (gensym "TAG"))
(values-temp (gensym "VALUES"))
(code `(return-from ,block-tag ,code))
(dispatches '())
(cleanups '()))
(dolist (clause catches)
(case (car clause)
((:catching)
(destructuring-bind (catch-tag clause-bindings
&body clause-body)
(cdr clause)
(push `((,catch-tag)
(destructuring-bind ,clause-bindings ,values-temp
(return-from ,block-tag (progn ,@clause-body))))
dispatches)
(setf code
`(progn (setq ,values-temp
(multiple-value-list (catch ',catch-tag ,code)))
(setq ,tag-temp ',catch-tag)
(go ,code-tag)))))
((:finally)
(dolist (cleanup (cdr clause)) (push cleanup cleanups)))
(otherwise
(error "Bad clause keyword ~S in ~S clause ~S."
(car clause) 'try clause))))
(setq code
`(let ((,tag-temp) (,values-temp))
(block ,block-tag
(tagbody
,code
,code-tag
(ecase ,tag-temp
,@(reverse dispatches))))))
(if (not cleanups) code
`(unwind-protect ,code ,@(reverse cleanups)))))
Using a modified form of your tester:
Lisp> (defun trytest (&key throw-tag)
(handler-case
(try (progn
(print 11)
(when throw-tag (throw throw-tag (values 111 222)))
'finished)
(:catching yes (bind1 bind2)
(print (* 1000 bind1))
(print bind2)
'yes-thrown)
(:catching no (binda bindb)
(print binda)
(print (* 1000 bindb))
'no-thrown)
(:finally
(print 'done)))
(error (c)
(format t "~&Lossage: ~A~%" c)
'lossage)))
TRYTEST
Lisp> (trytest :throw-tag nil)
11
DONE
=> FINISHED
Lisp> (trytest :throw-tag 'yes)
11
111000
222
DONE
=> YES-THROWN
Lisp> (trytest :throw-tag 'no)
11
111
222000
DONE
=> NO-THROWN
Lisp> (trytest :throw-tag 'maybe)
11
DONE
Lossage: Uncaught throw to tag MAYBE.
=> LOSSAGE
lambda 式を書きやすく
最近さわっている Ruby のブロックを参考に，Common Lisp のリーダーマクロを使って
(mapcar (lambda (x) (* x x)) '(1 2 3 4 5))
を
(mapcar {|x| (* x x)} '(1 2 3 4 5))
と書けるようにしてみた．一応，タイプ数は節約できるが…．微妙だ…．
(make-dispatch-macro-character #\{)
(set-dispatch-macro-character #\{ #\|
#'(lambda (stream char1 char2)
(declare (ignore char1 char2))
(let ((bar (get-macro-character #\|))
(brace (get-macro-character #\})))
(set-macro-character #\| (get-macro-character #\)))
(set-macro-character #\} (get-macro-character #\)))
(let* ((args (read-delimited-list #\| stream t))
(body (read-delimited-list #\} stream t)))
(set-macro-character #\| bar)
(set-macro-character #\} brace)
`(lambda ,args ,@body)))))
日本語シンボル
標準状態の CMUCL では，日本語のシンボルは使えない．（reader-error になる） そこで 128 - 255 のコードを通すように reader を改造すればよい．
(loop for i from 128 to 255 do (set-syntax-from-char (code-char i) #\a))
Free Software 情報へのリンク より引用（code-char を使うように変更）
すると，
* (defun 合計 (&rest 引数リスト) (reduce #'+ 引数リスト)) |合計| * (合計 1 2 3) 6 * (eq 'これ 'これ) t * (eq 'これ 'あれ) nil
とできるようになる．
LOOP いろいろ
Common Lisp の反復といえば，do, dolist, dotimes といったあたりが有名だが，も う一つ，忘れちゃいけないのが loop である．一見複雑怪奇で機能の組み合わせは非 常に理解しにくいが，基本的な例をメモっておく．
;; (1 4 9 16 25) を返す
(loop for x in '(1 2 3 4 5)
collect (* x x))
;; リスト要素を変形したものを集積する
(loop with x = 1
for y in '(a b c d e)
collect (list x y))
;; 条件によって collect するかしないかを選択する
(loop for x '(1 2 3 4 5)
when (oddp x) collect x)
;; 連想リストからハッシュ表に変換
(defmacro alist->hash (lst &key (test #'equal) (size 64) (rehash-size 1.5))
(let ((h (gensym))
(e (gensym)))
`(let ((,h (make-hash-table :test ,test :size ,size :rehash-size ,rehash-size)))
(dolist (,e ,lst)
(setf (gethash (first ,e) ,h) (second ,e)))
,h)))
;; ハッシュ表から連想リストに変換
(defun hash->alist (hash)
(loop for k being the hash-key in hash
using (hash-value v)
collect (list k v)))
Hash テーブルをファイルに保存する
comp.lang.lisp で見かけたネタ．巨大なハッシュテーブルを毎回作成するのはもっ たいない．Lisp コンパイラにがんばってもらおうという話．
その方法は (dafparameter hoge #.hoge) というファイルを作成，コンパイルするこ とによりコンパイラにハッシュテーブルを書き出してもらおうというもの．
* (defvar *lang* (hash ("b" "basic") ("l" "ruby") ("p" "python") ("r" "ruby") ("s" "scheme")))
*lang*
* (gethash "l" *lang*)
"ruby"
t
* (with-open-file (s "data.lisp" :direction :output) (write-string "(defparameter *lang* #.*lang*)" s))
"(defparameter *lang* #.*lang*)"
* (compile-file "data.lisp")
; Byte Compiling Top-Level Form:
; Compiling Creation Form for #<EQUAL hash table, 5 entries {4919683D}>:
; Compiling Init Form for #<EQUAL hash table, 5 entries {4919683D}>:
; Byte Compiling Top-Level Form:
#p"/home/lambda/commonlisp/user/data.x86f"
nil
nil
ファイルに保存
ここで，いったん終了 or 別の Lisp プロセスを立ち上げて
* (load "data")
; Loading #p"/home/lambda/commonlisp/user/data.x86f".
t
* *lang*
#<EQUAL hash table, 3 entries {48BD78AD}>
* (gethash "l" *lang*)
"ruby"
t
ファイルからロード
とできる．
補足
(defmacro hash (&rest rest)
(let ((h (gensym))
(e (gensym)))
`(let ((,h (make-hash-table :test ,test)))
(dolist (,e ',rest)
(setf (gethash (first ,e) ,h) (second ,e)))
,h)))
hash テーブル作成用マクロ（自作）
(defun sharp-dot (stream sub-char numarg)
(ignore-numarg sub-char numarg)
(let ((token (read stream t nil t)))
(unless *read-suppress*
(unless *read-eval*
(%reader-error stream
"Attempt to read #. while *READ-EVAL* is bound to NIL."))
(eval token))))
#. マクロの定義（cmucl 18e のソースから）
List Comprehension - defmacro によるリストの内包表記の実装
Haskell とか Python とか，最近は Scheme 方面でもできるようになりつつある (ネタ元) list comprehension を Common Lisp のマクロでも実現してみました．
(defun upto (a b) (if (< b a) nil (cons a (upto (1+ a) b)))) (defun fold-left (f b l) (if (null l) b (fold-left f (funcall f b (car l)) (cdr l)))) (defmacro list-of (expr &rest rest) `(nreverse (list-of-tail nil ,expr ,@rest))) (defmacro list-of-tail (base expr &rest rest) (cond ((null rest) `(cons ,expr ,base)) ((equal (nth 1 (car rest)) 'in) (destructuring-bind (var in generator) (car rest) (declare (ignore in)) (let ((f (gensym)) (z (gensym))) `(labels ((,f (,z ,var) (list-of-tail ,z ,expr ,@(cdr rest)))) (fold-left #',f ,base ,generator) )))) (t `(if (funcall (lambda () ,(car rest))) (list-of-tail ,base ,expr ,@(cdr rest)) ,base)))) (defun pyth (n) (list-of (list a b c) (a in (upto 1 n)) (b in (upto a n)) (c in (upto b n)) (= (+ (* a a) (* b b)) (* c c))))
で，
* (pyth 20) ((3 4 5) (5 12 13) (6 8 10) (8 15 17) (9 12 15) (12 16 20))
IMHO (Internet Metahumble Object) - Common Lisp で Web システム
IMHO は Web アプリケーション作成のためのツールキットである．Apache と組み合 わせて使うことにより， Common Lisp でバリバリ Web 開発ができます．
インストール方法（asdf 使用）
まず，最低限必要なものは apache, cmucl, asdf, odcl, IMHO である．apache, cmucl, asdf は既にインストールされているということにして，IMHO 環境の構築方 法をメモっておく．
まず，onshored.com から odcl, imho を anoncvs 経由で入手する．~/commonlisp にパッケージを置いているので，その辺はてきとうに調整する事．
$ cd ~/commonlisp $ ls asdf $ cvs -d :pserver:anoncvs@aleph.onshored.com/cvs login password: ;; パスワードは anoncvs でおけ $ cvs -d :pserver:anoncvs@aleph.onshored.com/cvs checkout odcl $ cvs -d :pserver:anoncvs@aleph.onshored.com/cvs checkout imho $ ls asdf imho odcl
あとは，~/.cmucl-init に
(load "home:commonlisp/odcl/odcl.asd") (when (not (find-package "ODCL")) (asdf:oos 'asdf:load-op :odcl)) (load "home:commonlisp/imho/imho.asd") (when (not (find-package "IMHO")) (asdf:oos 'asdf:load-op :imho))
とでも書いておけばよい．これで Lisp 側の設定は完了．あとは apache に mod_webapp.so モジュールを組み込む．
$ cd ~/commonlisp/apache/ $ gmake $ cd apache-1.3 $ su password: # mv mod_webapp.so /usr/local/libexec/apache # cd /usr/local/etc/apache/ # vi httpd.conf
で，httpd.conf には
LoadModule webapp_module libexec/apache/mod_webapp.so AddModule mod_webapp.c <IfModule mod_webapp.c> WebAppConnection main warp 127.0.0.1:8007 ServerName 127.0.0.1 Port 80 WebAppMount testapp1 main /imho/ </IfModule>
を書き加える．これで設定は完了．あとは使うだけ． 使い方は附属のドキュメント，サンプルをどーぞ．
…となかなかおもしろいので別ページにする事にしてみた．IMHO - Lisp と Web
CommonLisp を少し Python ライクに
Python を使い始めた時は range にとても違和感があったが，慣れてしまえば全然気 にならない，どころかなかなか便利．そこで，Common Lisp 向けに range もどきを 作ってみた．
(defun range-very-slow (end &key (beg 0) (step 1))
"Python の range のようにリストを生成する（最適化用ヒント無し）"
(do ((acc nil)
(op (cond
((and (> end beg) (plusp step)) #'<)
((and (< end beg) (minusp step)) #'>)
(t #'(lambda (x y) (declare (ignore x y)) t))))
(now beg (+ now step)))
((funcall op end now) (nreverse acc))
(push now acc)))
(defun range (end &key (beg 0) (step 1))
"Python の range のようにリストを生成する（最適化有り）"
(declare (optimize (speed 3) (debug 0) (safety 0)))
(labels ((pred (now)
(declare (fixnum beg end now step))
(cond
((and (> end beg) (plusp step)) (<= end now))
((and (< end beg) (minusp step)) (>= end now))
(t t))))
(do ((acc nil)
(now beg (the fixnum (+ (the fixnum now) (the fixnum step)))))
((pred now) (nreverse acc))
(push now acc))))
実行例はこんな感じ．やはりコンパイルすると速い〜．
* (load "util.lisp") ; Loading #p"/home/lambda/commonlisp/user/util.lisp". t * (time (range-very-slow 100)) ; Compiling lambda nil: ; Compiling Top-Level Form: ; Evaluation took: ; 0.0 seconds of real time ; 0.001228 seconds of user run time ; 2.75e-4 seconds of system run time ; 1,496,712 CPU cycles ; 0 page faults and ; 12,560 bytes consed. ; (0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100) * (time (range 100)) ; Compiling lambda nil: ; Compiling Top-Level Form: ; Evaluation took: ; 0.01 seconds of real time ; 0.0 seconds of user run time ; 0.00533 seconds of system run time ; 5,318,601 CPU cycles ; 0 page faults and ; 95,088 bytes consed. ; (0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99) * (compile 'range-very-slow) ; Compiling lambda (end &key (beg 0) (step 1)): ; Compiling Top-Level Form: range-very-slow nil nil * (compile 'range) ; Compiling lambda (end &key (beg 0) (step 1)): ; Compiling Top-Level Form: range nil nil * (time (range-very-slow 100)) ; Compiling lambda nil: ; Compiling Top-Level Form: ; Evaluation took: ; 0.0 seconds of real time ; 2.6e-5 seconds of user run time ; 5.0e-6 seconds of system run time ; 26,487 CPU cycles ; 0 page faults and ; 1,688 bytes consed. ; (0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100) * (time (range 100)) ; Compiling lambda nil: ; Compiling Top-Level Form: ; Evaluation took: ; 0.0 seconds of real time ; 1.4e-5 seconds of user run time ; 3.0e-6 seconds of system run time ; 11,724 CPU cycles ; 0 page faults and ; 864 bytes consed. ; (0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99) *
まぁ，普通は fixnum の範囲しか作らないだろうという事で range を使ってます．
clocc + cmucl 18e
4 月 4 日版の clocc と cmucl 18e の組合せだと clocc のビルドに失敗する．signal 4 が来ているが，動作もみるとどーやら無限ループに陥いっている模様．で，原因を調べたところ 18d から 18e になるまでの間に cmucl 側の挙動がかわった（バグ修正？）模様．というわけで，clocc.lisp に
*** clocc.lisp.orig Sat Apr 5 17:53:44 2003
--- clocc.lisp Sat Apr 5 17:54:16 2003
***************
*** 81,87 ****
#+gcl (defmacro lambda (bvl &body forms) `#'(lambda ,bvl ,@forms))
! #-(or allegro clisp mcl)
(define-setf-expander values (&rest places &environment env)
(loop :for pl :in places :with te :and va :and ne :and se :and ge :do
(multiple-value-setq (te va ne se ge) (get-setf-expansion pl env))
--- 81,87 ----
#+gcl (defmacro lambda (bvl &body forms) `#'(lambda ,bvl ,@forms))
! #-(or allegro clisp mcl cmu)
(define-setf-expander values (&rest places &environment env)
(loop :for pl :in places :with te :and va :and ne :and se :and ge :do
(multiple-value-setq (te va ne se ge) (get-setf-expansion pl env))
とすればいいような気がする．
clisp みたいに readline ライブラリの支援が欲しい
ここ を参考に readline wrapper プログラムの rlwrap を使えばバッチリ．clisp ばりに括弧の対応（ただし，行内のみ…やっぱ ilisp モードが一番かも？）からキーワード補完までできます．インタラクティブに使う時はこれくらいは欲しい．
Hemlock を使う
(require 'hemlock) (ed)
とすれば，hemlock が起動する．
外部プロセスを呼ぶ
(extensions:run-program "ls" nil :output *standard-output*)
プロファイルを取る
(profile:profile-all) (ごにょごにょ) (profile:report-time)
プロファイルするコストもあるので (profile:profile function) で個々の関数をプ ロファイリングしたほーが良い？
他の言語と仲良くする
#include <stdio.h>
void hello(void)
{
printf("Hello, World!!\n");
return;
}
この hello って関数をど〜しても cmucl から呼びたくなったとする．そんな時は，
$ gcc -shared -o hello.so hello.c
とした後，できあがった hello.so がカレントディレクトリにある状態で
* (use-package "ALIEN") ;; いちいち alien:def-alien-routine とか書くのめんどい T * (use-package "C-CALL") ;; C の型を使うのに必要 T * (describe 'void) VOID is an external symbol in the C-CALL package. It names a type specifier. * (load-foreign "./hello.so") ;; ↓そっけないけどこれでちゃんとロードできてる ;;; Running /usr/bin/ld... ;;; Done. NIL * (def-alien-routine "hello" void) HELLO * (hello) Compiling LAMBDA (#:G845): Compiling Top-Level Form: Hello, World!! NIL *
基本的にはこんな感じ．正式にやると，(declaim (inline hello)) とかやって hello がインライン展開されるよーにしてみたりとか，使う前に (compile 'hello) とコンパイルしとくとか．
考え中
困った事をメモっておきます．誰か教えてください…．
* (defmacro meq (item lst) `(member ,item ,lst :test #'eq)) ;; meq だと上手くいく
MEQ
* (meq 2 '(1 2 3))
(2 3)
* (describe 'memq) ;; memq ってのは既に EXTENSIONS に存在するが，
MEMQ is an external symbol in the EXTENSIONS package.
Function: #
Function arguments:
(item list)
Function documentation:
Returns tail of list beginning with first element eq to item
Its declared argument types are:
(T LIST)
Its result type is:
LIST
On Saturday, 9/14/02 11:36:46 pm [-9] it was compiled from:
target:code/list.lisp
Created: Monday, 3/5/01 08:37:32 am [-9]
Comment: $Header: /home/emarsden/CVS-cmucl/src/code/list.lisp,v 1.26 2001/03/04 23:37:32 pw Exp $
* *package*
#
* (defmacro memq (item lst) `(member ,item ,lst :test #'eq)) ;; 別パッケージだし，いいや．と memq を定義
MEMQ
* (memq 2 '(1 2 3)) ;; エラー発生
Cannot funcall macro functions.
Restarts:
0: [ABORT] Return to Top-Level.
Debug (type H for help)
(# # #)[:OPTIONAL]
Source:
Unknown location: using block start.
Error finding source:
Error in function DEBUG::GET-FILE-TOP-LEVEL-FORM: Source file no longer exists:
target:code/eval.lisp.
0] PP
(# # #)[:OPTIONAL]
Source:
Unknown location: using block start.
Error finding source:
Error in function DEBUG::GET-FILE-TOP-LEVEL-FORM: Source file no longer exists:
target:code/eval.lisp.
0] backtrace
0: (# # #)[:OPTIONAL]
1: (# #)
2: (#)
3: (# # #)
4: (# # #
#)[:EXTERNAL]
5: (# # #)
6: (# #)
7: (# # #)
8: (# # #)
9: (# # #)
10: (# #)
11: (# #)
12: (#)
13: (#)
0]
名前が重要？
これは package が違っても Macro の場合は名前の衝突に気をつけろ，という事なのでしょうか？はてさて．