Hatena::Groupcadr

わだばLisperになる このページをアンテナに追加 RSSフィード

2004 | 12 |
2005 | 01 | 02 | 07 | 10 | 11 |
2006 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2007 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2008 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2009 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2010 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2011 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 11 |

2011-01-26

C.I.CLを眺める(7) HASHED-REMOVE-DUPLICATES

| 20:23 | C.I.CLを眺める(7) HASHED-REMOVE-DUPLICATES - わだばLisperになる を含むブックマーク はてなブックマーク - C.I.CLを眺める(7) HASHED-REMOVE-DUPLICATES - わだばLisperになる

今回は、C.I.CLのlist.lispから HASHED-REMOVE-DUPLICATES です。

前回のものは、セットを作るものでリストとは違い順番等は無視できましたが、今回は、リストを対象にするもののようです。

定義は、

(DEFUN HASHED-REMOVE-DUPLICATES (SEQUENCE &KEY (TEST (FUNCTION EQL))
                                 TEST-NOT
                                 (START 0) (END (LENGTH SEQUENCE))
                                 (KEY (FUNCTION IDENTITY))
                                 (FROM-END NIL))
  (WHEN TEST-NOT
    (WARN ":TEST-NOT is deprecated.")
    (SETF TEST (COMPLEMENT TEST-NOT)))
  (LET ((TABLE (MAKE-HASH-TABLE :TEST TEST :SIZE (- END START))))
    (MAP NIL (IF FROM-END
                 (LAMBDA (ITEM)
                   (LET ((ITEM-KEY (FUNCALL KEY ITEM)))
                     (MULTIPLE-VALUE-BIND (VAL PRE) (GETHASH ITEM-KEY TABLE)
                       (DECLARE (IGNORE VAL))
                       (UNLESS PRE (SETF (GETHASH ITEM-KEY TABLE) ITEM)))))
                 (LAMBDA (ITEM) (SETF (GETHASH (FUNCALL KEY ITEM) TABLE) ITEM)))
         (IF (OR (/= START 0) (/= END (LENGTH SEQUENCE)))
             (SUBSEQ SEQUENCE START END) SEQUENCE))
    (IF (EQ (TYPE-OF SEQUENCE) 'CONS)
        (LET ((RESULT '()))
          (MAPHASH (LAMBDA (KEY VALUE) (DECLARE (IGNORE KEY)) (PUSH VALUE RESULT))
                   TABLE)
          (IF (OR (/= START 0) (/= END (LENGTH SEQUENCE)))
              (NCONC (SUBSEQ SEQUENCE 0 START) RESULT (SUBSEQ SEQUENCE END))
              RESULT))
        (IF (OR (/= START 0) (/= END (LENGTH SEQUENCE)))
            (LET ((RESULT (MAKE-SEQUENCE (TYPE-OF SEQUENCE)
                                         (+ START (HASH-TABLE-COUNT TABLE)
                                            (- (LENGTH SEQUENCE) END))))
                  (I START))
              (REPLACE RESULT SEQUENCE :END2 START)
              (MAPHASH (LAMBDA (KEY VALUE) (DECLARE (IGNORE KEY))
                               (SETF (AREF RESULT I) VALUE) (INCF I)) TABLE)
              (REPLACE RESULT SEQUENCE :START2 END :START1 I)
              RESULT)
            (LET ((RESULT (MAKE-SEQUENCE (TYPE-OF SEQUENCE)
                                         (HASH-TABLE-COUNT TABLE)))
                  (I 0))
              (MAPHASH (LAMBDA (KEY VALUE) (DECLARE (IGNORE KEY))
                               (SETF (AREF RESULT I) VALUE) (INCF I)) TABLE)
              RESULT)))))

となっています。

随分長いですが、シーケンス全般に対応していること、:test、:key、:start、:end、:from-end等CL標準の関数の作法に準拠して沢山のパラメータを取れるようにしてあるので長くなっているようです。

test-notが使われた時には、"
TEST-NOT is deprecated."と警告が出るという細かさ。

(EQ (TYPE-OF SEQUENCE) 'CONS)は、(CONSP SEQUENCE)でも良さそうですが、飽くまでSEQUENCEである、ということなのでしょうか。

大まかな処理の流れとしては、前回と同様、ハッシュ表で要素を記録することによって重複を排除しています。:from-endの場合は、後ろから見るわけではなくて、既出のものを優先。しかし、CLのMAPHASHは結果は入力の順序を保持しなかったと思うので、この辺りどういうことなのか少し分かりません(KEY次第で変ってくる?)

(hashed-remove-duplicates "41234321" :key (constantly #\x))
;=> "1"

(hashed-remove-duplicates "41234321" :key (constantly #\x) :from-end T)
;=> "4"

そして、:startと:endが取れるので、指定してあった場合は、重複を削除した結果とサンドイッチ。挟む方法としては、リストの場合は、NCONC、ベクター系の場合は、REPLACEを利用しています。

さて、上記の関数ですが、リスト系は問題なく動きますが、ベクター系がSBCLだとエラーになってしまうようです。

原因を追い掛けてみましたが、どうも、TYPE-OFで取れる情報だと、要素の数まで指定された型になってしまうようで、今回の様に結果の長さがオリジナルと違ってしまうと都合が悪いようです。

(type-of "ooo")
;=> (SIMPLE-ARRAY CHARACTER (3))

(make-sequence (type-of "ooo") 1)
;The length requested (1) does not match the type restriction in (SIMPLE-ARRAY CHARACTER (3))

ということで、TYPE-OFの箇所をCLASS-OFにしてみたところ問題ないようです。

HyperSpecによれば、

(subtypep (type-of object) (class-of object)) =>  true, true

が常に成り立つそうなので問題なさそうではあります。

動作は、

(import 'com.informatimago.common-lisp.list::hashed-remove-duplicates)

(hashed-remove-duplicates "1234321")
;=> "1234"

というところ。

2011-01-23

C.I.CLを眺める(6) HASHED-SET-REMOVE-DUPLICATES

| 23:30 | C.I.CLを眺める(6) HASHED-SET-REMOVE-DUPLICATES - わだばLisperになる を含むブックマーク はてなブックマーク - C.I.CLを眺める(6) HASHED-SET-REMOVE-DUPLICATES - わだばLisperになる

今回は、C.I.CLのlist.lispから HASHED-SET-REMOVE-DUPLICATES です。

定義は、

(DEFUN HASHED-SET-REMOVE-DUPLICATES (SEQUENCE &KEY (TEST (FUNCTION EQL))
                                     (KEY (FUNCTION IDENTITY)))
  (LET ((TABLE (MAKE-HASH-TABLE :TEST TEST :SIZE (LENGTH SEQUENCE)))
        (RESULT '()))
    (MAP NIL (LAMBDA (ITEM) (SETF (GETHASH (FUNCALL KEY ITEM) TABLE) ITEM)) SEQUENCE)
    (MAPHASH (LAMBDA (KEY VALUE) (DECLARE (IGNORE KEY)) (PUSH VALUE RESULT)) TABLE)
    RESULT))

となっています。

LISTをSETにするには、REMOVE-DUPLICATESすることになると思うのですが、一旦ハッシュテーブルに登録して読み出すことにより重複を削除しています。

シンボルはEXPORTされていない様子。

何故か#'ではなくFUNCTIONと書かれていますが、PJBさんは割とリーダーマクロを使わずFUNCTIONをそのまま書いたりするようです。

動作は、

(import 'com.informatimago.common-lisp.list::hashed-set-remove-duplicates)

(hashed-set-remove-duplicates "あかまきがみあおまきがみきまきがみ")
;=> (#\HIRAGANA_LETTER_O #\HIRAGANA_LETTER_MI #\HIRAGANA_LETTER_GA
;    #\HIRAGANA_LETTER_KI #\HIRAGANA_LETTER_MA #\HIRAGANA_LETTER_KA
;    #\HIRAGANA_LETTER_A)

(COERCE (nreverse
         (hashed-set-remove-duplicates "あかまきがみあおまきがみきまきがみ"))
        'STRING)
;=> "あかまきがみお"

というところ

2011-01-21

ILC日本開催についてのアンケート

| 00:05 | ILC日本開催についてのアンケート - わだばLisperになる を含むブックマーク はてなブックマーク - ILC日本開催についてのアンケート - わだばLisperになる

ILCというLISPの国際会議がありますが、ILCを日本で開催したらどうだろうか、という話がじんわりとあります。

自分はShibuya.lispの運営などをやっている関係からか、実際に潜在的な参加希望者がどれだけいるのかShibuya.lisp内でアンケートを取れないか、というお話を頂いたりしたのですが、googleフォームを使えばShibuya.lispに限らずアンケートを取れることを思い出したのでフォームを作成してみました。

良かったら回答頂ければと思います!

よろしくお願いします!

2011-01-19

C.I.CLを眺める(5) CIRCULAR-LENGTH

| 20:30 | C.I.CLを眺める(5) CIRCULAR-LENGTH - わだばLisperになる を含むブックマーク はてなブックマーク - C.I.CLを眺める(5) CIRCULAR-LENGTH - わだばLisperになる

今回は、C.I.CLのlist.lispから CIRCULAR-LENGTH です。

名前のとおり循環リストの長さ(というか要素数)を数えるものです.

定義は、

(defun circular-length (list)
  "LIST must be either a proper-list or a circular-list, not a dotted-list.
RETURN: the total length ; the length of the stem ; the length of the circle.
"
  (let ((indexes (make-hash-table)))
    (loop
       :for i :from 0
       :for current :on list
       :do (let ((index (gethash current indexes)))
             (if index
                 ;; found loop
                 (return (values i index (- i index)))
                 (setf (gethash current indexes) i)))
       :finally (return (values i)))))

となっていて、コンスセルを先頭から一つずつ位置と一緒に記録しておいて、同じものが現われたら結果を返す、というようになっています。

結果は多値で返して、1値目は、全体の長さ、2値目は、循環が始まるところまでの長さ、3値目は、循環しているリストの長さです。

動作は、

(import 'com.informatimago.common-lisp.list:circular-length)

(circular-length '(1 2 3 4))
;=> 4

(circular-length '#0=(1 2 3 . #0#))
;=> 3
;   0
;   3

(circular-length '(1 . #0=(2 3 . #0#)))
;=> 3
;   1
;   2

というところ

2011-01-18

マクロ 99問 P02

| 21:31 | マクロ 99問 P02 - わだばLisperになる を含むブックマーク はてなブックマーク - マクロ 99問 P02 - わだばLisperになる

P01に引き続いてやってみました。M-99 P02

INC1を作成せよ
テーマ:変数の補足

(let ((x 0))
  (inc1 x)
  x)
≡ (let ((x 0))
     (setq x (+ x 1)))
;=> 1

inc1(x)というのを、x = x + 1という風に展開しろというお題です。

inc1のようなものは、CLでは、関数ではできないことの1つで、マクロにする必要がありますが、他の言語も大体同じかなと思います。

早速チャレンジ。まずは、CL

Common Lisp
(defmacro inc1 (var)
  `(setq ,var (1+ ,var)))

(let ((x 0))
  (inc1 x)
  x)
;=> 1

31秒でした。

次にGauche(Scheme)

Scheme (Gauche)
(define-syntax inc1
  (syntax-rules ()
    ((_ var) (set! var (+ 1 var)))))

(let ((x 0))
  (inc1 x)
  x)

こちらは57秒。

今回のお題ならば、Dylanでも可能なので、Gwydion Dylanで

Dylan
module: p02
synopsis:
author:
copyright:

define macro inc1
 { inc1(?var:expression) }
    => { ?var := ?var + 1 }
end macro inc1;

define function main(name, arguments)
  let var = 1;
  format-out("var => %=\n", var);
  inc1(var);
  format-out("var => %=\n", var);
  exit-application(0);
end function main;

// Invoke our main() function.
main(application-name(), application-arguments());
var => 1
var => 2

4分かかりました。

REPLがないとなかなか辛いです。今後問題は、複雑になりますが、Dylanではマクロ展開とかどうやって確認するのやら…。

GOO
(ds inc1 (,arg)
  `(set ,arg (+ 1 ,arg)))

goo/user 0<=  (let ((x 0))(inc1 x)x)
goo/user 0=> 1

30秒。

Arc
(mac inc1 (arg)
  `(= ,arg (+ 1 ,arg)))

arc> (let x 0 (inc1 x) x)
1

32秒

GOOもArcも似たようなものです。

どうもinc1一番簡単で無難な問題に思えてきました。

2011-01-16

マクロ 99問 P01 補足

| 14:02 | マクロ 99問 P01 補足 - わだばLisperになる を含むブックマーク はてなブックマーク - マクロ 99問 P01 補足 - わだばLisperになる

M-99の前回の回答ですが、コメント欄にて色々と教えて頂きました。ありがとうございます!

lkozima2011/01/15 23:31
こんな書き方もできますね。慣れてないと読めなそうですが。
(defmacro listq (&rest args) `',args)

なるほど!、確かにこちらの方が簡潔です。

解釈としては、

`(quote ,'(a b c d))

となっていて、quoteされた式をunquoteした中身でquote式を作成する、という感じです。

前回の自分の回答は、

`(list ,@(mapcar (lambda (x) `(quote ,x)) '(a b c d))))

というような感じで、(list 'a 'b 'c 'd)を作成しています。

defmacroの&restが毎回新規にリストを作成するならばどちらも同じことな気もしますが、ちょっと追い切れていません。

SaitoAtsushi2011/01/16 09:17
syntax-rules だと再帰的にしなくても出来ますよ。
(define-syntax listq
  (syntax-rules ()
    ((_ arg ...) (list 'arg ...))))

なるほど、パターンマッチで全部解決できるのですね!。これは勉強になります。

ついでなので他のLISP方言でもやってみました。

Dylan

DylanのシンボルのLISP風解釈が良く分からず挫折。

具体的には、変数の名前をシンボルに変換することが可能なのかどうか分かりませんでした。

また、Dylanでは、シンボルは、foo:や、#"foo"と表記できますが、quoteは必要なかったりします。

しかし、実はできたりするのかもしれません。

GOO
(ds listq (,@args) `',args)

(ds listq (,@args)
  `(list ,@(map (op list 'quote _)
                args)))
Arc
(mac listq args `',args)

(mac listq args
  `(list ,@(map [list 'quote _] args)))

GOOもArcも伝統マクロなのでCLと同じになります。

色々試してみるとシンボルの扱いがからんできていて割とLISPのマクロを前提とした問題な気がしてきました。

第1問目としてはあまり良くないかもしれないですね。

Gwydion Dylanのインストール (x86 linux)

| 13:45 | Gwydion Dylanのインストール (x86 linux) - わだばLisperになる を含むブックマーク はてなブックマーク - Gwydion Dylanのインストール (x86 linux) - わだばLisperになる

自分にとってDylanはたまに動かしてみる言語なのですが、何ヶ月かぶりにちょっと試してみようと思うと動かないことが多いため導入方法をメモっておくことにしました。

たまにしか動かさない環境は、VirtualBox上に温存してみているので、VirtualBox上のDebian GNU/Linux x86 sidの上に導入します。

注意点

Dylanの実装には色々あるのですが、現在ダウンロードして入手できるのは、Gwydion DylanとOpen Dylanです。

Open Dylanの方が充実していて良いのですが環境によっては、導入に難儀するので、今回は、Gwydion Dylanにします。

ダウンロード
wget http://www.opendylan.org/downloads/binaries/linux/x86/gwydion-dylan-2.4.0-x86-linux-glibc23.tar.gz
設置

落したファイルをものを標準の場所以外に展開すると、

File does not exist: "/usr/local/share/dylan/platforms.descr"
アボートしました

のように怒られるので、/usr/local以下に展開

$ cd /usr/local/
$ sudo tar xvf /tmp/gydion-dylan-2.4.0-x86-linux-glibc23.tar.gz

ライブラリのパスの設定

$ cat /etc/ld.conf.d/gwidion-dylan.conf
/usr/local/lib/dylan/2.4.0/x86-linux-gcc33

$ sudo ldconfig -v
...

動作確認

$ make-dylan-app p01
# p01の中にp01.dylanや、Makefile等一式できる。雛形としてHello, Worldプログラムができる。
$ make
$ ./p01
Hello, World!

2011-01-15

マクロ 99問 P01

| 19:44 | マクロ 99問 P01 - わだばLisperになる を含むブックマーク はてなブックマーク - マクロ 99問 P01 - わだばLisperになる

思い付きで作ってみたM-99ですが、果して役に立つのかまったく分からないので自分で問いてみることにしました。

時間を計測したら燃えるかと思い時間を測ってみましたが、結果は、52秒。

多分、マクロを書いたことがある方なら1分以内で解けるんじゃないでしょうか。

引数をクォートについてがテーマなのですが、1問目にしては難しいテーマなのかもしれません。

(let ((ut 0))
  (defun start ()
    (setq ut (get-universal-time)))
  (defun check ()
    (- (get-universal-time) ut)))

(start)
;=> 3504076885

;; 与えられた引数を全てQUOTEしてリストとして返すLISTQを作成せよ
;; テーマ:引数のクォート

(listq a b c d e)
≡ (list 'a 'b 'c 'd 'e)
;=> (A B C D E)

(defmacro listq (&rest args)
  `(list ,@(mapcar (lambda (x)
                     `(quote ,x))
                   args)))

(check)
;=> 41
;; テストするの忘れてた…

(listq a b c d)
;=> (A B C D)

(check)
;=> 52

ついでにGaucheでも

;; gauche
(use srfi-19)

(define *ct* 0)

(define (start)
  (set! *ct* (current-time))
  (time-second *ct*))
(define (check)
  (time-second (time-difference (current-time) *ct*)))

(start)
;=> 1295090821

(define-syntax listq
  (syntax-rules ()
    ((_) (list))
    ((_ arg rest ...)
     (cons (quote arg)
           (listq rest ...)))))

(listq a b c d e)
;=> (a b c d e)

(check)
223

(listq)
;=> ()

define-syntaxに慣れてないので使い方間違ったりして223秒かかりました。

ちなみに、Dylanもやってみようかなと思ったのですが、手元の開発環境が動かなくなっておりました…。

McCLIMのインスペクタとデバッガ

| 15:19 | McCLIMのインスペクタとデバッガ - わだばLisperになる を含むブックマーク はてなブックマーク - McCLIMのインスペクタとデバッガ - わだばLisperになる

Climacsやclim-listenerで遊んでいるとちょくちょくデバッガに落ちてしまいます。

SLIMEから起動の場合は、SLIMEに落ちるのですが、SLIME経由で起動していない場合は、デフォルトのどこかに落ちてしまい厄介なのですが、McCLIMのディレクトリを眺めていたらデバッガがあるようなので試してみました。

このデバッガは同じくCLIMのインスペクタに依存していたりするのですが、asdファイルがないのでとりあえず手動でロードすることにしました。

(ignore-errors
  (progn
    (let ((*default-pathname-defaults*
           (merge-pathnames "dists/quicklisp/software/mcclim-20101006-cvs/Apps/Inspector/"
                            ql:*quicklisp-home*)))
      (load "package")
      (load "disassembly")
      (load "inspector"))

    (let ((*default-pathname-defaults*
           (merge-pathnames "dists/quicklisp/software/mcclim-20101006-cvs/Apps/Debugger/"
                            ql:*quicklisp-home*)))
      (load "clim-debugger")))
  #+sbcl (setf (symbol-global-value '*debugger-hook*)
               #'clim-debugger:debugger)
  )

使用例では、

(let ((*debugger-hook* #'clim-debugger:debugger))
  (clim-listener:run-listener :new-process t))

のようにLETで束縛すればOKと書いてありますが、どうも別スレッドにすると違うデバッガが登録されてしまったりするようです。

しょうがなく(setf (symbol-global-value '*debugger-hook*) #'clim-debugger:debugger)して場当たり的な対処(SBCLの場合)

単体の実行ファイルを作成してそこから起動したり、StumpWMから起動する場合は落ちる場所がまちまちになるので*debugger-hook*にclim-debuggerを登録してから起動すると便利かなと思います。

clim-listener素晴らしい!

| 10:44 | clim-listener素晴らしい! - わだばLisperになる を含むブックマーク はてなブックマーク - clim-listener素晴らしい! - わだばLisperになる

すっかりCLIMづいている年始ですが、quicklispで、(QL-DIST:SYSTEM-APROPOS "clim")してみるとclim-listenerというのがあるので試してみました。

(ql:quickload :mcclim-uim) ;uimで日本語入力したい場合
(ql:quickload :clim-listener)

(clim-listener:run-listener :new-process 'T)

位で起動できると思います。

動作としては、CLのREPLとシェル的な機能が一緒になった感じで、LispマシンのListerの様な感じです、例えば、

,Show Directory

というコマンドでディレクトリの一覧を見ることができ、しかもファイルはクリッカブルだったりします。

コマンドを拡張したり、色々遊べそうです。

2011-01-13

Climacsでのrun-or-raise

| 19:38 | Climacsでのrun-or-raise - わだばLisperになる を含むブックマーク はてなブックマーク - Climacsでのrun-or-raise - わだばLisperになる

前回重要なことを書くのを忘れていたので追記的エントリーなのですが、Climacsのように処理系内部から別スレッドで立ち上げる場合、StumpWMのrun-or-raiseをどういう風に処理するかが問題になります。

raiseの方は既に立ち上がっているものにフォーカスすれば良いだけなのでそのままでOKなのですが、runの方は起動していない場合は通常実行可能ファイルを実行するのでここを少し書き換える必要があります。

ということで、run-or-raiseを改造してfun-run-or-raiseというのをでっち上げて使ってみています。

(in-package :stumpwm)

(defun fun-run-or-raise (fun props &optional (all-groups *run-or-raise-all-groups*) (all-screens *run-or-raise-all-screens*))
  (labels
      ;; Raise the window win and select its frame.  For now, it
      ;; does not select the screen.
      ((goto-win (win)
         (let* ((group (window-group win))
                (frame (window-frame win))
                (old-frame (tile-group-current-frame group)))
           (frame-raise-window group frame win)
           (focus-all win)
           (unless (eq frame old-frame)
             (show-frame-indicator group)))))
    (let* ((matches (find-matching-windows props all-groups all-screens))
           ;; other-matches is list of matches "after" the current
           ;; win, if current win matches. getting 2nd element means
           ;; skipping over the current win, to cycle through matches
           (other-matches (member (current-window) matches))
           (win (if (> (length other-matches) 1)
                    (second other-matches)
                    (first matches))))
      (if win
          (goto-win win)
          #+sbcl (sb-thread:make-thread fun
                                        :name (format nil "~A" fun))))))

(defcommand climacs () ()
   ""
   (fun-run-or-raise (lambda ()
                       (climacs:climacs :new-process "climacs"))
                     '(:class "Climacs")))

これで起動していない場合は、処理系内から別スレッドで起動できるようになりました。

2011-01-12

climacs-client

| 21:54 | climacs-client - わだばLisperになる を含むブックマーク はてなブックマーク - climacs-client - わだばLisperになる

今年は、EmacsからClimacsというCommon Lisp+CLIM(Common Lisp Interface Manager)で実装されたEmacs系エディタに乗り換えようとあがいているのですが、なかなか機能が充実しているGNU Emacsの環境から移行するのは難しいです。

しかし、CLでなんでも書けるのは楽しいところ。このブログもClimacsからDrakma経由で投稿してみたりしています。

プログラミング用のエディタとしては、エディタの足りない機能を実装していたら本来作りたかったもののプログラミングに辿り着かないですが、それもまた楽しいです。

随時、設定などもこのブログに書いて行きたいと思っていますが、今回は、シェルからClimacsを呼ぶ方法を考えてみました。

Climacsは、シェルから通常のエディタのように起動させるには一捻り必要なようです。

イメージを実行可能なものとしてダンプしたり何通りかあると思いますが、今回は、StumpWMとClimacsを同一のイメージから起動させて、StumpWMのstumpishから起動する方法を書いてみます。

結構適当ですが、下のスクリプトのような感じになりました。with-climacsは@quekさんの作でClimacs外からclimacsの関数を呼び出す時に便利なマクロです。

climacs-client

#!/bin/sh

FILE=$1

stumpish eval "(progn (esa-io::with-climacs (esa-io:com-find-file \"$FILE\"))(stumpwm::climacs))"

stumpishはevalでCLの式を評価できるので文字列として実行したい式を渡します。

式の内容ですが、

  1. esa-io::com-find-fileでファイルを開き
  2. stumpwm::climacsで画面をClimacsに遷移させる

という感じになっています。Climacsへの画面遷移は、StumpWMお馴染みのrun-or-raisです。

これをclimacs-clientのような名前にしてスクリプトにすれば、

$ climacs-client /tmp/foo.lisp

のように開けます。

2011-01-11

パッケージとファイルの構成を考える

| 19:41 | パッケージとファイルの構成を考える - わだばLisperになる を含むブックマーク はてなブックマーク - パッケージとファイルの構成を考える - わだばLisperになる

あるときぼんやりとsb-sequenceを眺めていて、sb-sequenceでは、メソッドが、

(defmethod sequence:count ...)

のように定義されていることをみつけました。

何故、パッケージ付きの名前で定義されているかのは、はっきりとした記述はみつけられず不明ですが、こういう記述方法も特定の状況では便利なのかもしれないと思い、色々考えてみました。

例えば、あまりこういう状況もないかと思いますが、

(defpackage :foo 
  ....
  (:export :foo))

(in-package :foo)

(defun foo (n)
  (foo-bar-baz:frobozz-a
   (foo-bar-baz:frobozz-b n) ))

のように内部シンボルより外部パッケージのシンボルを呼ぶ方が多かったりする場合は、

(in-package :foo-bar-baz)

(defun foo:foo (n)
  (frobozz-a
   (frobozz-b n) ))

のように書いた方が楽といえば楽です。

この辺りをぼんやりと考えていたのですが、この方式を整理してもう少し実用的にならないものかと規約的なものを考えてみました。

  1. 内部用のパッケージを作成し、ごちゃごちゃしたものは全部ここに取り込む(なんならテストも)。名前は、主パッケージ名がfooならば、foo-internalsでnicknameは、fooiなどにしておく。
  2. 主となるパッケージは基本的にuse-packageせずexportするのみ
  3. 定義で使うパッケージは、foo-internals
  4. fooからエクスポートされるものは、foo-internalsの中で、(defun foo:fctn-a (...のようにパッケージ名付きで定義を書く

という感じです。

(require :kmrcl)
(require :fiveam)

(defpackage :foo-internals
  (:use :cl
        :kmrcl
        :fiveam ;テストライブラリ
        )
  (:nicknames :fooi))

(defpackage :foo
  (:export :fctn-a
           :fctn-b
           :fctn-c
           :fctn-d))

(def-suite :foo)

(in-package :fooi)
(in-suite :foo)

(defun foo:fctn-a (n)
  (* n 1))

(test foo:fctn-a
  (is (= (foo:fctn-a 3)
         3)))

(defun fctn-b-1 (n)
  (* n n))

(test fctn-b-1
  (is (= (fctn-b-1 3)
         9)))

(defun foo:fctn-b (n)
  (fctn-b-1 n))

(test fctn-b-1
  (is (= (fctn-b-1 3)
         9)))
...

(run!)
;-> ..
;    Did 2 checks.
;       Pass: 2 (100%)
;       Skip: 0 ( 0%)
;       Fail: 0 ( 0%)
;
;=> NIL

上の例では、テストと実装が一緒になっていますが、CLではパッケージの単位とファイルの単位は無関係なので分けるのもOKだと思います。

先にエクスポートするものが決まっている場合には、この方式は割と有効かなとも思えました。

例えば、他の言語のライブラリ(SRFIの関数など)をCLに移植する場合等は、シンボルの定義/方針を先に決めてしまってから実装する、というのも結構良いかなと思います。

等々、なにかアイデア/問題点等ありましたら教えてください!

2011-01-09

M-99(マクロ99問)を作成してみました

| 10:29 | M-99(マクロ99問)を作成してみました - わだばLisperになる を含むブックマーク はてなブックマーク - M-99(マクロ99問)を作成してみました - わだばLisperになる

L-99が大好きな自分ですが、マクロにもそういう問題集があれば暇潰しに良いだろうということで問題集を作ってみることにしました。

今のところCommon Lispがベースですが、マクロを持つ言語で共通で使えるようにしたら面白いかなと考えています(Common Lisp/Emacs Lisp/Scheme/Dylanなど)

現状99問揃ってないですし、解答もなし、問題の難易度がばらばらなのと出題の意図が割といい加減、という感じになっていますが徐々に改善して行きたいところです。

WiLiKiですので興味のある方は是非問題を登録してみてください!

現在特にコードウォーカーが必要なマクロの問題を募集しています。

2011-01-08

KMRCLを眺める(234) repl.lisp

| 21:39 | KMRCLを眺める(234) repl.lisp - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(234) repl.lisp - わだばLisperになる

今回はKMRCLのrepl.lispまるごとです。

一つ一つの関数をばらして解説というのがちょっと難しそうなのと、それ程長くもない、ということでファイル全体を眺めます。

まず、名前からしてREPLを実現するファイルだろうなということは分かります。

とりあえず上からつらつらと眺めつつ実際に動かしてみます。

定数などの定義

(in-package #:kmrcl)

(defconstant +default-repl-server-port+ 4000)

デフォルトの接続ポートを4000番にしていますが、どうやら外部と通信できるようです。

REPLクラス

(defclass repl ()
  ((listener :initarg :listener :accessor listener
             :initform nil)))

REPLクラスを定義しています。

MAKE-REPL

(defun make-repl (&key (port +default-repl-server-port+)
                       announce user-checker remote-host-checker)
  (make-instance 'listener
    :port port
    :base-name "repl"
    :function 'repl-worker
    :function-args (list user-checker announce)
    :format :text
    :wait nil
    :remote-host-checker remote-host-checker
    :catch-errors nil))

MAKE-REPLというLISTNERのインスタンスを生成するユーティリティを定義していますが、LISTERクラスは、KMRCLのlistener.lispで定義されています。こちらもいつか眺めます。

LISTNERはどうやら通信できることを前提に設定されている様子。

INIT/REPL

(defun init/repl (repl state)
  (init/listener repl state))

INIT/REPLは名前の通りREPLを初期化するものだろうと思われます。

INIT/LISTENERもlistener.lispで定義されています。state引数が謎ですが、定義を辿ってみると、:start、:stop、:restartという引数を取り状態を遷移させるもののようです。

REPL-WORKER

(defun repl-worker (conn user-checker announce)
  (when announce
    (format conn "~A~%" announce)
    (force-output conn))
  (when user-checker
    (let (login password)
      (format conn "login: ")
      (finish-output conn)
      (setq login (read-socket-line conn))
      (format conn "password: ")
      (finish-output conn)
      (setq password (read-socket-line conn))
      (unless (funcall user-checker login password)
        (format conn "Invalid login~%")
        (finish-output conn)
        (return-from repl-worker))))
  #+allegro
  (tpl::start-interactive-top-level
   conn
   #'tpl::top-level-read-eval-print-loop
   nil)
  #-allegro
  (repl-on-stream conn)
  )

REPL-WORKERはLISTENERのFUNCTIONに登録されるものです。接続と、ユーザーチェック(パスワードの確認)の有無、接続時に表示させるアナウンスの内容を取り、一連の処理をした後、REPL-ON-STREAMを呼びます。

READ-SOCKET-LINE

(defun read-socket-line (stream)
  (string-right-trim-one-char #\return
                              (read-line stream nil nil)))

READ-SOCKET-LINEは、REPL-WORKERの中でユーザー名とパスワードを読み取るのに使われています。

STRING-RIGHT-TRIM-ONE-CHARはKMRCLのユーティリティ関数です。

PRINT-PROMPT

(defun print-prompt (stream)
  (format stream "~&~A> " (package-name *package*))
  (force-output stream))

名前の通りプロンプトを表示させるもの。パッケージも表示されるようです。

REPL-ON-STREAM

(defun repl-on-stream (stream)
  (let ((*standard-input* stream)
        (*standard-output* stream)
        (*terminal-io* stream)
        (*debug-io* stream))
    #|
    #+sbcl
    (if (and (find-package 'sb-aclrepl)
             (fboundp (intern "REPL-FUN" "SB-ACLREPL")))
        (sb-aclrepl::repl-fun)
        (%repl))
    #-sbcl
    |#
    (%repl)))

REPL-ON-STREAMは、*standard-input/output*等をストリームに束縛して%REPLを呼ぶというもの。

SBCLの場合は、SB-ACLREPL(SBCLで、Allegro CL風のREPLを実現するもの)を使おうとしたりしているようですが、コメントアウトされています。

%REPL

(defun %repl ()
  (loop
    (print-prompt *standard-output*)
    (let ((form (read *standard-input*)))
      (format *standard-output* "~&~S~%" (eval form)))))

%REPLが実質の本体で、Read-Eval-Print-Loopそのままに、read->eval->format->loopとなっています。

内容は以上ですが、実際に使ってみます。

(require :kmrcl)

(defvar *repl*)

;; REPLインスタンスを生成
(setq *repl* (kl:make-repl :announce "hello!" :port 4001
                           :user-checker (lambda (user pass)
                                           (find (cons user pass)
                                                 '(("g000001" . "g000001"))
                                                 :test #'equal))))
;; 起動
(kl:init/repl *repl* :start)

telnetで接続

setq% rlwrap telnet localhost 4001
Trying ::1...
Trying 127.0.0.1...
Connected to localhost.
Escape character is '^]'.
hello!
login: g000001
password: g000001

COMMON-LISP-USER> (+ 3 3 3 3 )

12
COMMON-LISP-USER>

という感じになります。

2011-01-07

KMRCLを眺める(233) REMOVE-SIGNAL-HANDLER

| 19:58 | KMRCLを眺める(233) REMOVE-SIGNAL-HANDLER - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(233) REMOVE-SIGNAL-HANDLER - わだばLisperになる

今回はKMRCLのsignals.lispから、REMOVE-SIGNAL-HANDLERです。

前回はハンドラを設定する方でしたが今回は削除する方です。

定義は、

(defun remove-signal-handler (sig &optional old-handler)
  "Removes a handler from signal. Tries, when possible, to restore old-handler."
  (let ((signum (etypecase sig
                  (integer sig)
                  (keyword (signal-key-to-number sig)))))
    ;; allegro automatically restores old handler, because set-signal-handler above
    ;; actually pushes the new handler onto a list of handlers
    #+allegro (declare (ignore old-handler))
    #+allegro (excl:remove-signal-handler signum)
    #+cmu (system:enable-interrupt signum (or old-handler :default))
    ;; lispworks removes handler if old-handler is nil
    #+(and lispworks unix) (system:set-signal-handler signum old-handler)
    #+sbcl (sb-sys:enable-interrupt signum (or old-handler :default))
    #-(or allegro cmu (and lispworks unix) sbcl)
    (declare (ignore sig handler))
    #-(or allegro cmu (and lispworks unix) sbcl)
    (warn "Signal setting not supported on this platform.")))

となっています。

動作は、

;; USR1へのハンドラを設定
(kl:set-signal-handler :usr1
                       (lambda (&rest args)
                         (declare (ignore args))
                         (princ "Hello USR1 !")
                         (terpri)
                         (force-output)))

:DEFAULT
* (sb-posix:getpid)
9776

;; 他のシェルから
$ kill -USR1 9776

* Hello USR1 !
;; USR1のハンドラを削除
(kl:remove-signal-handler :usr1)
#<CLOSURE (FLET SB-UNIX::RUN-HANDLER) {1003B40C89}>
T

;; 他のシェルから
$ kill -USR1 9776
* User defined signal 1

というところ

2011-01-05

KMRCLを眺める(232) SET-SIGNAL-HANDLER

| 19:54 | KMRCLを眺める(232) SET-SIGNAL-HANDLER - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(232) SET-SIGNAL-HANDLER - わだばLisperになる

今回はKMRCLのsignals.lispから、SET-SIGNAL-HANDLERです。

処理系依存で処理系に送られたシグナルをハンドリングする機能があるようですが、それをポータブルに書けるようにしたもののようです。

定義は、

(defun set-signal-handler (sig handler)
  "Sets the handler for a signal to a function. Where possible, returns
the old handler for the function for later restoration with remove-signal-handler
below.

To be portable, signal handlers should use (&rest dummy) function signatures
and ignore the value. They should return T to tell some Lisp implementations (Allegro)
that the signal was successfully handled."
  (let ((signum (etypecase sig
                  (integer sig)
                  (keyword (signal-key-to-number sig)))))
    #+allegro (excl:add-signal-handler signum handler)
    #+cmu (system:enable-interrupt signum handler)
    #+(and lispworks unix)
    ;; non-documented method to get old handler, works in lispworks 5
    (let ((old-handler (when (and (boundp 'system::*signal-handler-functions*)
                                  (typep system::*signal-handler-functions* 'array))
                         (aref system::*signal-handler-functions* signum))))
      (system:set-signal-handler signum handler)
      old-handler)
    #+sbcl (sb-sys:enable-interrupt signum handler)
    #-(or allegro cmu (and lispworks unix) sbcl)
    (declare (ignore sig handler))
    #-(or allegro cmu (and lispworks unix) sbcl)
    (warn "Signal setting not supported on this platform.")))

となっていて前回のSIGNAL-KEY-TO-NUMBERが内部で使われています。

長いですが、それぞれの処理系で実質2、3行といったところです。

動作は、

;; USR1へのハンドラを設定
(kl:set-signal-handler :usr1 
                       (lambda (&rest args)
                         (declare (ignore args))
                         (princ "Hello USR1 !")
                         (terpri)
                         (force-output)))
;; プロセスIDを確認
(kl:getpid)
;=> 6269

他のシェル等から
$ kill -USR1 6269

;; 処理系が起動しているターミナル等に表示される筈
* Hello USR1 !

というところ

2011-01-03

KMRCLを眺める(231) SIGNAL-KEY-TO-NUMBER

| 21:58 | KMRCLを眺める(231) SIGNAL-KEY-TO-NUMBER - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(231) SIGNAL-KEY-TO-NUMBER - わだばLisperになる

strmatch.lispも眺め終えたので、今回はKMRCLのsignals.lispから、SIGNAL-KEY-TO-NUMBERです。

signals.lispはPOSIXのシグナル関係の処理系依存のところを纏めたもののようです。

SIGNAL-KEY-TO-NUMBERは、名前のとおりシグナルの名前から番号に変換するもので定義は、

(defun signal-key-to-number (sig)
  "These signals and numbers are only valid on POSIX systems, perhaps
some are Linux-specific."
  (case sig
    (:hup 1)
    (:int 2)
    (:quit 3)
    (:kill 9)
    (:usr1 10)
    (:usr2 12)
    (:pipe 13)
    (:alrm 14)
    (:term 15)
    (t
     (error "Signal ~A not known." sig))))

となっています。

動作は、

(kl::signal-key-to-number :usr1)
;=> 10

というところ

C.I.CLを眺める(4) MAKE-CIRCULAR-LIST

| 01:50 | C.I.CLを眺める(4) MAKE-CIRCULAR-LIST - わだばLisperになる を含むブックマーク はてなブックマーク - C.I.CLを眺める(4) MAKE-CIRCULAR-LIST - わだばLisperになる

今回は、C.I.CLのlist.lispから MAKE-CIRCULAR-LIST です。

前回の ENSURE-CIRCULAR との違いは、こちらの方はMAKE-LISTの様に新しくリストを指定した個数の要素で作成するというところです。

(defun make-circular-list (size &key initial-element)
  "
RETURN: a new circular list of length SIZE.
POST: (circular-length (make-circular-list size)) == (values size 0 size)
"
  (let ((list (make-list size :initial-element initial-element)))
    (setf (cdr (last list)) list)
    list))

動作は、

(import 'com.informatimago.common-lisp.list:make-circular-list)

(setq *print-circle* 'T)
;=> T
(make-circular-list 5)
;=> #1=(NIL NIL NIL NIL NIL . #1#)

というところ

2011-01-01

ASDF2メモ

| 20:25 | ASDF2メモ - わだばLisperになる を含むブックマーク はてなブックマーク - ASDF2メモ - わだばLisperになる

年も明けたということで、自分もライブラリ管理はQuicklispメインにし、ASDFからASDF2に乗り換えてみることにしました。

今のところQuicklisp(ver. 2010121400)は自前のライブラリの登録の方法はASDF1風に*centeral-registry*に登録させるようですが、ASDF2の方法で登録してもql:QUICKLOADできるようです。

ASDF2については自分は曖昧な知識で書いていますので詳しくは、ASDF Manualを参照のこと。

間違いがあったら教えて頂けると嬉しいです。

ASDF2に.asdファイルを登録する

まず、ASDF2は、後方互換でasdf:*central-registry*を使うことができるようですが、ややこしい気がするので自分は、新しいASDF2方式に統一することにしました。

新しい方式は、マニュアルの7 Controlling where ASDF searches for systemsに詳しく書いてありますが、UNIXのシェルのように設定ファイルをシステム全体で定義したものからユーザー定義のものへと段階的に読み込むような仕様になっているようです。

色々ありますが、とりあえず、ユーザーが定義するファイルは、"ホームディレクトリ/.config/common-lisp/source-registry.conf"となる様子。

もう一つの形式として、ファイルではなくディレクトリを設定し、てその下の.confという名のファイルを名前順に読み込んで行く、という方式があるようです。

自分は、特に理由はありませんが、なんとなくで後者の方式で行くことにしました。利用しているOSは、Ubuntu 10.10です。

~/.config/common-lisp/source-registry.conf.d/setq-asd.conf

というファイルに

;; -*- mode:lisp; -*-

;; MCCLIM-UIM
(:directory "/share/sys/cl/src/mcclim-uim/")

;; EXECUTOR
(:directory "/share/sys/cl/src/executor_latest/")

;; PERGAMUM
(:directory "/share/sys/cl/src/pergamum/")

;; XYZZY-COMPAT
(:directory (:home "lisp/src/repos/CodeRepos/commonlisp/xyzzy-compat/"))

;; ZETALISP-COMPAT
(:directory (:home "lisp/work/zl/"))

;; JP
(:directory "/share/sys/cl/src/jp_0.1.0/")

;; SERIES-EXT (series jp)
(:directory (:home "lisp/work/series-ext/"))

;; SHIBUYA.LISP (trivial-utf-8 drakma cl-ppcre)
(:directory (:home "lisp/work/shibuya.lisp/"))

;; CLAP (closer-mop :osicat)
(:directory (:home "lisp/work/clap/"))

;; G000001 (series-ext series executor)
(:directory (:home "lisp/work/g000001/"))

;; from github
(:tree "/share/sys/cl/src/github/")

;; STARLISP-SIMULATOR
(:directory (:home "lisp/work/Starlisp-simulator/"))

;; COM.INFORMATIMAGO.COMMON-LISP
(:directory "/share/sys/cl/src/com/informatimago/common-lisp/")

のように書いています。

Quicklispに登録されているものは当然ながら書く必要はないため、登録されていないものを記述します。

:directoryと:treeの違いですが、treeは再帰的にディレクトリを下降して.asdファイルを探し出し、登録します。

:homeというのはホームディレクトリ以下ということを表わします。

登録したら、(asdf:INITIALIZE-SOURCE-REGISTRY)を実行し、登録一覧を更新します。

あとは、(ql:QUICKLOAD :foo)でも、(REQUIRE :foo)でもライブラリを読み込むことができるようになると思います。

REQUIREは、モジュールを読み込むための機能としてCLtL1で定義されましたが色々機能が曖昧だとかでANSIでは、非推奨(deprecated)になってしまいました。

各処理系によってまちまちですが、このREQUIREに自前のライブラリをロードする仕組みを当てている処理系が多いようですが、SBCLなどは、REQUIREでASDFが機能します。

これまで自分は、非推奨なのでREQUIREを使うのもちょっと嫌だなと思っていたのですが、見た目もすっきりするのでREQUIREも積極的に使ってみることにします。

ちなみに、CL/Emacs lisp共にREQUIRE、PROVIDEがありますが動作としては別物です。