2010/03/27

loop-finish

Common Lisp の loop からぬける loop-finish なんてのがあったのか。

(loop for i in '(1 3 5 4 8 7)
if (evenp i)
do (loop-finish)
collect i)
;;=> (1 3 5)

(loop for i in '(1 3 5 4 8 7)
if (evenp i)
do (loop-finish)
collect i
finally (print "hello"))
;;=> (1 3 5)
;; hello

いままで知らなかったから、こんなふうに書いてたよ。

(loop for i in '(1 3 5 4 8 7)
if (evenp i)
do (return x)
collect i into x)
;;=> (1 3 5)

2010/03/21

Clojure Leiningen @ Shibuya.lisp テクニカルトーク #5

Clojure の Leiningen で以前挫折をした。いやむしろ SLIME がちゃんと動かなくて嫌になった。

@making さんの LT "Clojure+Leiningenで3分Hadoop" で Clojure の Leiningen がちゃんと動いくことの確信を得たのでリトライする。

目標は

  • Leiningen でプロジェクトを作る。
  • Leiningen で swank server を起動して、SLIMEでインタラクティブ開発。
  • 単体実行 jar の作成。

シェルで次を実行。a はプロジェクト名。

lein new a

./a/project.clj を編集

  • lein swank で swank server を起動するために :dev-dependencies を追加
  • lein uberja で作る単体実行 jar のエントリポイントを指定する :main を追加
(defproject a "1.0.0-SNAPSHOT"
:description "FIXME: write"
:dependencies [[org.clojure/clojure "1.1.0"]
[org.clojure/clojure-contrib "1.1.0"]]
:dev-dependencies [[leiningen/lein-swank "1.1.0"]]
:main a.core)

シェルで次を実行し依存ライブラリの取得後、swank server を起動する。

lein deps
lein swank

Emacs から M-x slime-connect とすると、ちゃんと SLIME 動いた。補完もちゃんと動いた。別途、Emacs + SLIME まわりの設定は必要なので、それは後述する。

./a/src/a/core.clj を編集

  • :gen-class を追加
  • -main を追加
(ns a.core
(:gen-class))

(defn -main [& args]
(. javax.swing.JOptionPane (showMessageDialog nil "Hello World")))

シェルで

lein uberjar
chmod +x ./a-standalone.jar
./a-standalone.jar

以上、目標達成。

後述予定の Emacs + SLIME まわり。

github から swank-clojure と clojure-mode を git clone しておく。 ~/.emacs の設定は SBCL の最新 SLIME とかぶらないように無理をしている。うまく両立する方法はないものだろうか?おまけに Google App Engine を SLIME から起動しようとしたときの残骸も残ってる。

(defun clojure ()
(interactive)
(add-path "~/letter/clojure/lib/clojure-mode")
(add-path "~/letter/clojure/lib/slime")
(add-path "~/letter/clojure/lib/slime/contrib")
(eval-after-load "slime"
'(progn
(slime-setup '(slime-repl
slime-fuzzy
slime-banner))
(setq slime-complete-symbol*-fancy t)
(setq slime-complete-symbol-function 'slime-fuzzy-complete-symbol)
(global-set-key [(control ?\;)] 'slime-selector)
(loop for (key command) in
'(([(control ?c) ?\;] slime-insert-balanced-comments)
([(control ?u) (control ?c) ?\;] slime-remove-balanced-comments)
([(control ?c) ?\;] slime-insert-balanced-comments)
("\C-j" slime-eval-print-last-expression)
("\C-m" newline-and-indent)
("\C-i" slime-indent-and-complete-symbol))
do (define-key slime-mode-map key command))))
(setq swank-clojure-classpath
'("~/letter/java/eclipse-workspace/moeopa-clj/src"
"~/letter/java/eclipse-workspace/moeopa-clj/war/WEB-INF/classes"
"~/letter/clojure/lib/swank-clojure/src"
"~/letter/clojure/lib/clojure/clojure.jar"
"~/letter/clojure/lib/clojure-contrib/clojure-contrib.jar"
"~/letter/clojure/lib/appengine-clj/appengine-clj.jar"
"~/letter/clojure/lib/compojure/compojure.jar"
"~/letter/clojure/lib/compojure/deps/commons-codec-1.3.jar"
"~/letter/clojure/lib/compojure/deps/commons-fileupload-1.2.1.jar"
"~/letter/clojure/lib/compojure/deps/commons-io-1.4.jar"
"~/letter/clojure/lib/compojure/deps/jetty-6.1.15.jar"
"~/letter/clojure/lib/compojure/deps/jetty-util-6.1.15.jar"
"~/letter/clojure/lib/compojure/deps/servlet-api-2.5-20081211.jar"
"~/local/opt/appengine-java-sdk/lib/appengine-tools-api.jar"
"~/local/opt/appengine-java-sdk/lib/shared/appengine-local-runtime-shared.jar"
"~/local/opt/appengine-java-sdk/lib/shared/geronimo-el_1.0_spec-1.0.1.jar"
"~/local/opt/appengine-java-sdk/lib/shared/geronimo-jsp_2.1_spec-1.0.1.jar"
"~/local/opt/appengine-java-sdk/lib/shared/geronimo-servlet_2.5_spec-1.2.jar"
"~/local/opt/appengine-java-sdk/lib/shared/jsp/repackaged-appengine-ant-1.6.5.jar"
"~/local/opt/appengine-java-sdk/lib/shared/jsp/repackaged-appengine-ant-launcher-1.6.5.jar"
"~/local/opt/appengine-java-sdk/lib/shared/jsp/repackaged-appengine-commons-el-1.0.jar"
"~/local/opt/appengine-java-sdk/lib/shared/jsp/repackaged-appengine-commons-logging-1.1.1.jar"
"~/local/opt/appengine-java-sdk/lib/shared/jsp/repackaged-appengine-jasper-compiler-5.0.28.jar"
"~/local/opt/appengine-java-sdk/lib/shared/jsp/repackaged-appengine-jasper-runtime-5.0.28.jar"
"~/local/opt/appengine-java-sdk/lib/impl/appengine-api-labs.jar"
"~/local/opt/appengine-java-sdk/lib/impl/appengine-api-stubs.jar"
"~/local/opt/appengine-java-sdk/lib/impl/appengine-api.jar"
"~/local/opt/appengine-java-sdk/lib/impl/appengine-local-runtime.jar"
"~/local/opt/appengine-java-sdk/lib/impl/agent/appengine-agentruntime.jar"
"~/letter/clojure/lib/programming-clojure/lib/ant.jar"
"~/letter/clojure/lib/programming-clojure/lib/ant-launcher.jar"))
(setq slime-lisp-implementations
`((clojure
("java"
"-classpath"
,(concat ".:classes:"
(mapconcat 'identity
(mapcar 'expand-file-name
swank-clojure-classpath)
":"))
"clojure.main"
"--repl")
:init swank-clojure-init)))
(load
(expand-file-name "~/.emacs.d/elpa/package.el"))
(package-initialize)
(require 'clojure-mode)
(require 'slime-autoloads)
(slime)
)

Leiningen からコマンド一発で Google App Engine の雛形プロジェクトが作成できたらいいのにな。

ということで making さんありがとうございました。

今回の Shibuya.lisp もよかったです。みなさんありがとうございました。

Common Lisp 的にはちょっとさびしかったな。

2010/02/13

compute-effective-slot-definition の第三引数がリストであることの理由

どうして compute-effective-slot-definition の第三引数が direct-slot-definition ではなく direct-slot-definition のリストなんだろう? と不思議に思っていた。リストだとディスパッチできないじゃないか、って。

Elephant のソースにこんなコメントを見つけた。

    ;; Effective slots are indexed only if the most recent slot definition
;; is indexed. NOTE: Need to think more about inherited indexed slots

なるほど、継承関係で同じスロット名が複数あったときのためにリストなんだ。

(defclass a ()
((s1 :initarg :s1 :initform "a" :accessor s1)))

(defclass b ()
((s1 :initarg :s1 :initform "b" :accessor s1)))

(defmethod sb-mop:compute-effective-slot-definition :before
((class standard-class)
slot-name
direct-slot-definitions)
(print "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%")
(mapc #'describe direct-slot-definitions)
(print "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"))

(defclass c (b a)
())

(make-instance 'c)

#|
"%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
#<SB-MOP:STANDARD-DIRECT-SLOT-DEFINITION S1>
[standard-object]

Slots with :INSTANCE allocation:
NAME = S1
INITFORM = "b"
INITFUNCTION = #<FUNCTION (LAMBDA ()) {1004B24749}>
READERS = (S1)
WRITERS = ((SETF S1))
INITARGS = (:S1)
%TYPE = T
%TYPE-CHECK-FUNCTION = NIL
%DOCUMENTATION = NIL
%CLASS = #<STANDARD-CLASS B>
ALLOCATION = :INSTANCE
ALLOCATION-CLASS = NIL
#<SB-MOP:STANDARD-DIRECT-SLOT-DEFINITION S1>
[standard-object]

Slots with :INSTANCE allocation:
NAME = S1
INITFORM = "a"
INITFUNCTION = #<FUNCTION (LAMBDA ()) {1004B18B99}>
READERS = (S1)
WRITERS = ((SETF S1))
INITARGS = (:S1)
%TYPE = T
%TYPE-CHECK-FUNCTION = NIL
%DOCUMENTATION = NIL
%CLASS = #<STANDARD-CLASS A>
ALLOCATION = :INSTANCE
ALLOCATION-CLASS = NIL

"~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"
|#

リストであることの理由は納得できたけど、どうにもスロットのクラスによってディスパッチしにくいことについては、納得いかない。

manardb でも苦肉のスペシャル変数で回避しているようだし。どうにかならないものでしょうか。

(defvar *mop-hack-effective-slot-definition-class* nil) ;; as compute-effective-slot-definition-initargs is not available portably

といいつつも、manardb でやっているように、なんとか回避できる手段があるところが Common Lisp のいいところだよね。

2010/02/04

X Server DPI

X Server DPI に書かれている。

~/.Xresources に Xft.dpi: 96 を追加する。

Emacs*useXIM: false
Xft.dpi: 96

しかし↓の 132 はどこからきているんだろう?

~% xdpyinfo | grep reso
resolution: 131x132 dots per inch

/var/log/Xorg.0.log に↓とあった。

(--) Feb 04 23:34:48 NVIDIA(0): DPI set to (131, 132); computed from "UseEdidDpi" X config

UseEdidDpi って何だろう?

2010/02/03

allocate-instance と class-prototype

Common Lisp でのクラスメソッド にかんして Jianshi Huang さんに allocate-instance を使うというのを教えてもらった。ありがとうございます。

make-instance を使うと、initialize-instance :after あるいは shared-initialize が呼ばされるので、よくない気がします。 (allocate-instance (find-class 'foo)) を使った方がいいと思います。

そういえば class-prototype なんてのもあった。 http://www.gigamonkeys.com/book/object-reorientation-classes.html には次のように書かれていた。

class-prototype, that returns an instance of a class that can be used to access class slots.

そうか :allocation :class したスロットについても一緒に考えなきゃいけないんだ。

curl で BASIC 認証で POST

curl --basic --user user:password --form-string 'experience[title]=aaa' --form-string 'experience[content]=bbb' 'http://www.example.com/spots/961/experiences.xml'

ポストデータをファイルから読み込む方法もあるらしい。

2010/02/02

Common Lisp でのクラスメソッド

#|
Common Lisp でのクラスメソッド。
Common Lisp は (defclass foo ... のようにしても foo には何も束縛されない。
そうするとクラスメソッドを実装するにあたって困ってしまう。
|#


(defclass foo () ())
;; #<STANDARD-CLASS FOO>

(defclass bar (foo) ())
;; #<STANDARD-CLASS BAR>


#|
eql スペシャライザを使ってクラスメソッドを定義する。
|#

(defmethod f1 ((x (eql (find-class 'foo))))
(class-name x))
;; #<STANDARD-METHOD F1 ((EQL #<STANDARD-CLASS FOO>)) {1005489BA1}>

(f1 (find-class 'foo))
;; FOO

(f1 (find-class 'bar))
;; bar クラスを渡してもエラー

(f1 (make-instance 'foo))
;; インスタンスを渡してもエラー

(f1 (class-of (make-instance 'foo)))
;; FOO

#|
eql スペシャライザを使うのは find-class がめんどうだ。
そういえば make-instance はシンボルを引数にとる。
|#


(defmethod f2 ((x (eql 'foo)))
(class-name x))
;; #<STANDARD-METHOD F1 ((EQL #<STANDARD-CLASS FOO>)) {1005489BA1}>

(f2 'foo)
;; エラー

#|
シンボルだから class-name は適用できない。
あくまでもシンボルとして扱わなければならない。

それじゃ defclass の戻り値はクラス自身だから、それを defparameter で束縛してしまおう。
これで find-class は必要なくなる。
|#


(defparameter baz (defclass baz () ()))
;; BAZ

baz
;; #<STANDARD-CLASS BAZ>

(defmethod f3 ((x (eql baz)))
(class-name x))
;; #<STANDARD-METHOD F3 ((EQL #<STANDARD-CLASS BAZ>)) {1003E08771}>

(f3 baz)
;; BAZ

#|
これでもまだ eql がわずらわしい。

こうなったらメタクラスを使ってみよう。
|#


(defclass my-class (standard-class) ())
;; #<STANDARD-CLASS MY-CLASS>

(defmethod sb-mop:validate-superclass ((class my-class) (super standard-class))
t)
;; #<STANDARD-METHOD SB-MOP:VALIDATE-SUPERCLASS (MY-CLASS STANDARD-CLASS) {10039FC841}>

(defparameter hoge (defclass hoge ()
()
(:metaclass my-class)))
;; HOGE

hoge
;; #<MY-CLASS HOGE>

(defparameter huga (defclass huga ()
()
(:metaclass my-class)))
;; HUGA

huga
;; #<MY-CLASS HUGA>

(defmethod que ((x my-class))
(class-name x))
;; #<STANDARD-METHOD QUE (MY-CLASS) {1004B746D1}>

(que hoge)
;; HOGE

(que huga)
;; HUGA

#|
あるいは
|#


(defmethod que ((x symbol))
(que (find-class x)))
;; #<STANDARD-METHOD QUE (SYMBOL) {1004AA3471}>

(que 'hoge)
;; HOGE

(que 'huga)
;; HUGA

#|
どれもいまいち。すっきりしない。
Common Lisp でのクラスメソッドはどう定義したらいいのだろう?
|#