2008/01/14

Common Lisp : cl-win32ole 結局は

cl-win32ole で Ruby がメソッドミッシングで実現していることを、どう実装しようと悩んでいました。
よくよく考えると、そんなことより ie.document.all.Item("q").value = "aaa" 相当が簡単にできればいい、と思い関数を2つほど実装しました。
これで (setf (ole ie :document :all :item "q" :value) "aaa") と書けるようになりました。

(let ((ie (create-object "InternetExplorer.Application")))
(setf (ole ie :visible) t)
(ole ie :navigate "http://www.google.co.jp/")
(loop while (ole ie :busy) do (sleep 0.5))
(setf (ole ie :document :all :item "q" :value) "Common Lisp")
(ole ie :document :all :item "btnG" :click)
(sleep 3)
(ole ie :quit))

2008/01/13

www.yahoo.co.jp の charset が utf-8 になっている

(drakma:http-request "http://www.yahoo.co.jp") していま気づいた。

Factor だと
USING: http.client ; "http://www.yahoo.co.jp" http-get write

2008/01/12

今年の言語 : Factor

FAQ によると Factor は 関数型で、動的型付けで、オブジェクト指向で、スタックベースのプログラミング言語であり、Forth と Lisp を組合せたような言語だそうです。
設計者は Slava Pestov さん。
UI 系や Web 系のライブラリも充実しているようです。

公式サイト : Factor programming language
http://factorcode.org/

planet-factor
http://planet.factorcode.org/

まずはセットアップから

ダウンロードは http://factorcode.org/download.fhtml から。
Windows と Mac OS X は バイナリがあります。
Linux はソースからビルドする必要があります。

ソース Factor-0.91.tar.gz と ブートイメージ boot.x86.64.image をダウンロードします。
tar zxvf Factor-0.91.tar.gz
cd factor
make linux-x86-64
cp ../boot.x86.64.image .
./factor -i=boot.x86.64.image

しばらく待つと factor.image ができあがります。
このあたり Lisp っぽいですね。

いじってみる

./factor でいきなり GUI が起動します。
Windows でも factor-nt.exe をダブルクリックすると同じ GUI が起動します。
ただし、パス名に日本語含まれていると起動できないので注意してください。

Output のパネルに 「Factor cookbook」 から始めるようにとあるのでそれをクリックします。

「.s」 でスタックの中身を表示する。
「.」 でスタックの一番上のオブジェクトを表示する。
vacabularies のロードには 「require」 を使う。
「Vocabulary index」を見てみること(一覧が表示された。たくさんある)。
「"tetris" run」でテトリスが動く(うん、動いた)。
ソースファイルのロードには「run-file」を使う。
この UI の使い方は「UI development tools」を見る。
あとはクックブックのリストです。

次は Input のパネルに入力してみましょう。
! 以降はコメントです。入力しないでくださいね。
1 2 3 ! これで 1 2 3 がスタックにつまれます。
.s ! スタックの内容 1 2 3 が表示されます。でもスタックから取り除かれはしません。
. ! スタックの一番上にある 3 が表示されます。3 はスタックからなくなります。
.s ! スタックの内容 1 2 が表示されます。
1 2 + . ! 足し算。1 と 2 がスタックにつまれ + がスタックから 1 と 2 を取り出して 3 をスタックに詰む。. で 3 をスタックから取り出す。

数値や文字列などのリテラルは入力するとスタックにつまれます。
Read Eval Print に慣れ親しんだ身としては不思議な感じです。
word と言われるのは、他の言語で言うところの関数に相当するものです。
となると vocabulary はモジュールですね。

なじみのある quatation というのもあります。
quatation は [ と ] で囲みます。
Lisp と同じで評価されることはありません。評価されずにスタックにつまれます。
call でスタックから取り出されて評価されます。
[ 1 2 + . ]
call ! 3 が表示される。

quatation があれば if が可能となる。
ということで if は次のようになります。
1 2 = [ "then!" ] [ "else!" ] if . ! "else!" が返る。

word の定義は : で始まり ; で終ります。
Hello World を作ってみますかね。
: hello-world "Hello World!" print ;
hello-world ! "Hello World!" と表示される。

fib を定義してみると次のようになります。もっとエレガントな方法があるかもしれませんが。

: fib
dup 3 <
[ drop 1 ]
[ dup 1 - fib swap 2 - fib + ]
if ;

10 fib . ! 55 が返る。


あと UI の Input では TAB で word の補完が可能です。
Inspector もありソースコードにもすぐアクセスできるようになってます。
Lisp と同じ apropos word もありますね。

Emacs からの利用は ~/.emacs に次を追加します。
;;;;Factor
(add-path "~/letter/factor/factor/misc")
(setq factor-binary (expand-file-name "~/letter/factor/factor/factor")
factor-image (expand-file-name "~/letter/factor/factor/factor.image"))
(autoload 'factor-mode "factor" "Factor mode" t)
(autoload 'run-factor "factor" "Start a Factor listener inside Emacs" t)
(add-to-list 'auto-mode-alist '("\\.factor\\'" . factor-mode))


ということで、なかなか面白い言語だと思います。
触っていて楽しいです。
基本がシンプルなところが好きです。
そして、去年の言語 Erlang にプロセスという新しい思考概念があったように、Factor にはスタックという新しい思考概念があります(新しいというのは私のとってのことですが)。
去年の言語は Erlang でしたが、今年の言語は Factor にしましょう。

Common Lisp : cl-win32ole を Google Code に登録

作りかけている cl-win32ole を Google Code に登録しました。
http://code.google.com/p/cl-win32ole/
最新ソースの取得は次のとおりです。
svn checkout http://cl-win32ole.googlecode.com/svn/trunk/ cl-win32ole-read-only

まだまだな感じですが、以下のコードくらいは動きます。
対象の処理系は SBCL です。
ちゃんとできあがってきたら common-lisp.net に登録したいな。

(defun ie-example ()
(let ((ie (create-object "InternetExplorer.Application")))
(with-slots (visible busy document) ie
(setf visible t)
(invoke ie :navigate "http://www.google.co.jp/")
(loop while busy do (sleep 0.5))
(with-slots (all) document
(let ((q (invoke all :item "q")))
(setf (slot-value q 'value) "Common Lisp"))
(let ((btnG (invoke all :item "btnG")))
(invoke btnG :click))))
(sleep 3)
(invoke ie :quit)))

2008/01/10

Common Lisp : funcallable-standard-class

Common Lisp の MOP の世界に funcallable-standard-class というものがあります。
その名のとおり関数として呼び出すことのできるオブジェクトを作るメタクラスです。
:metaclass で funcallable-standard-class を指定します。
set-funcallable-instance-function で実行する関数を指定します。
関数としての呼び出しは funcall と apply が使用可能ですが、(setf symbol-function) で任意のシンボルの関数にしてしまうこともできます。

(use-package :sb-mop)

(defclass adder ()
((n :initarg :n :initform 1))
(:metaclass funcallable-standard-class))

(defmethod initialize-instance :after ((adder adder) &rest args)
(declare (ignore args))
(set-funcallable-instance-function
adder
#'(lambda (n)
(+ n (slot-value adder 'n)))))

(defun add (n)
n)

(defparameter adder (make-instance 'adder))

(setf (symbol-function 'add) adder)

(add 1) ; => 2
(funcall adder 1) ; => 2
(setf (slot-value adder 'n) 10)
(add 1) ; => 11
(apply adder (list 1)) ; => 11

これを使えば (with-ole-object (ie "InternetExplorer.Application") (ie :visible t) (ie :navigate "http://...") なんてことができるかなと思ったのですが、(setf symbol-function) は影響がグローバルなので使うのがためらわれます。

2008/01/04

Lisp 生誕50周年

Happy New Year and Happy 50th Birthday to Lisp!
今年は Lisp が生まれて50年ですか。
私なんかまだまだ青二才ですね。精進しましょう。

Common Lisp : slot-missing と undefined-function

slot-missing は存在しないスロットにアクセスした場合に呼ばれるジェネリックファンクションで、error を投げるように定義されています。
これを使ってスロットがない場合の振舞いをプログラムできます。
1番目の引数がクラス。
2番目の引数がインスタンス(オブジェクト)。
3番目の引数がスロット名。
4番目の引数は参照の場合は slot-value、設定の場合は setf。
5番目の引数は setf の場合の設定値です。

次のコードでは、クラス a の slot-value は *value* の値を返し、クラス b の (setf slot-value) は *value* に値を設定しています。

(defvar *value* nil)

(defclass a ()
())

(defclass b (a)
())

(defmethod slot-missing ((class (eql (find-class 'a))) instance slot-name
(operation (eql 'slot-value)) &optional new-value)
*value*)

(defmethod slot-missing ((class (eql (find-class 'b))) instance slot-name
(operation (eql 'setf)) &optional new-value)
(setf *value* new-value))

(let ((a (make-instance 'a))
(b (make-instance 'b)))
(print *value*) ;nil
(print (setf (slot-value b 'スロット名) "値いち")) ;"値いち"
(print *value*) ;"値いち"
(print (slot-value a 'なまえ)) ;"値いち"
(print (ignore-errors (slot-value 'b 'なまえ))) ;nil
(print (ignore-errors (setf (slot-value a 'スロット名) "値に")))) ;nil

さて、スロットがない場合はこれでいいのですが、関数がない場合はどうすればいいのでしょう?
関数がない場合は undefined-function コンディションが error 関数により通知されるようです(SBCLでは)。
この undefined-function を補足することはできるのですが、それが通知された場所からリスタートする方法が分かりませんでした。
restart-bind と handler-bind でなんとかなるかなぁ、と思って次のようなコードでごにょごにょしてみたのですがうまくいきません。
foo が定義されていない状態で "a", "b", "c" と print したいのです。
error ではなく ceeror で undefined-function を通知してくれないものでしょうか。
(restart-bind ((ole-dispatch
#'(lambda (&optional x)
(p 'restart x)
(setf (symbol-function x) #'print)
(p (symbol-function x))
(symbol-function x))))
(handler-bind ((undefined-function
#'(lambda (c)
(p 'handler c (cell-error-name c))
(invoke-restart 'ole-dispatch (cell-error-name c)))))
(print "a")
(foo "b")
(print "c")))

うまくいけば OLE の invoke を隠蔽できるのにな。