[Java] Web フレームワーク何がいい？

SAStruts でいいよね？

使いたいオブジェクトが DI される。これに慣れるともうやめられないね。とっても楽。getter と setter 書かなくていい。あの大量の setter getter は意味ないよ。Struts と S2Cantainer を知っていれば学習コストはとても低く、いくらでも手を入れて改造できる。

S2JDBC も簡単でいい。

ね。SAStruts にしましょう。

[Commo Lisp] (require :mcclim-truetype) でエラー

SBCL をアップデートしたら（タイプチェックが厳しくなったのかしら？）、(require :mcclim-truetype) でエラーが発生するようになった。

zpb-ttf の cmap.lisp でのタイプ宣言がまずいらしい。次のように id-deltas を declare からとるとうまくいく。

作者の方にメールを出した。拙い英語が通じるであろうか。。。

diff --git a/cmap.lisp b/cmap.lisp
index 36ff366..85d6e95 100644
--- a/cmap.lisp
+++ b/cmap.lisp
@@ -122,7 +122,7 @@ FONT-LOADER, if present, otherwise NIL.")
           cmap
         (declare (type cmap-value-table
                        end-codes start-codes
-                       id-deltas id-range-offsets
+                       id-range-offsets
                        glyph-indexes))
         (dotimes (i (segment-count cmap) 1)
           (when (<= code-point (aref end-codes i))

[Common Lisp] (require :mcclim-truetype)

McCLIM の日本語表示 (require :mcclim-freetype) ではなく(require :mcclim-truetype) でも可能。

mcclim-freetype の方は libfreetype を使うが、mcclim-truetype の方は C のライブラリ等をつかわず 100% Common Lisp でフォントのレンダリングを行っているらしい。

あと、コメントに次のようにして読み込めると書いてあった。asdf もいろいろ使えるんだね。

 (defmethod asdf:perform :after ((o asdf:load-op)
                                 (s (eql (asdf:find-system :clim-clx))))
   (asdf:oos 'asdf:load-op :mcclim-freetype))

[Common Lisp] McCLIM で日本語入力

Common Lisp の GUI といえば CLIM で、その open source implementation である McCLIM がある。ただ残念ながら McCLIM では現状日本語入力ができない。そこでなんとか日本語入力できないものかと、もがいてみた。 Factor のときみたに XOpenIM とかすればいいかと思ったが、McCLIM では Xlib は使われていない。 Xlib の Common Lisp 版といえる clx が使われている。それじゃどうすりゃいいのと、適当に悩んだあげく uim(libuim)を CFFI で呼ぶことにした。

で、まあなんとか日本語が入力できるようになった。

# 試してみたいという方は次のように darcs で取得してみてください。 (require :mcclim-uim) すれば ok です。それとは別に McCLIM で日本語表示するためには (require :mcclim-freetype) も必要です。

git clone git://github.com/quek/mcclim-uim.git

https://github.com/quek/mcclim-uim

[Common Lisp] [*scratch*] Erlang のまねっこ

[*scratch*] と題して、適当なコードをはりつける試み（笑）

ハードと OS の進歩によって、そのうち普通のスレッドでも Erlang なみの並列処理ができるようになることを期待しつつ。

(in-package :quek)

(import 'sb-thread:*current-thread*)

(export '(spawn ! @ *exit* *current-thread*))

(defvar *processes* (make-hash-table :weakness :key))

(defvar *processes-mutex* (sb-thread:make-mutex))

(defvar *exit* (gensym "*exit*"))

(defclass process ()
  ((name :initarg :name :accessor name-of)
   (mbox :initform nil :accessor mbox-of)
   (waitqueue :initform (sb-thread:make-waitqueue) :accessor waitqueue-of)
   (mutex :initform (sb-thread:make-mutex) :accessor mutex-of)
   (childrent :initform nil :accessor children-of)))

(defgeneric kill-children (process)
  (:method ((process process))
    (loop for i in (children-of process)
          do (! i *exit*))))

(defun get-process (&optional (thread sb-thread:*current-thread*))
  (sb-thread:with-mutex (*processes-mutex*)
    (sif (gethash thread *processes*)
         it
         (setf it (make-instance 'process
                                 :name (sb-thread:thread-name thread))))))

(defun spawn% (function)
  (let* ((thread (sb-thread:make-thread
                  function
                  :name (symbol-name (gensym "quek.pid"))))
         (current-process (get-process sb-thread:*current-thread*)))
    (push thread (children-of current-process))
    thread))

(defmacro spawn (&body body)
  `(spawn% (lambda ()
             ,@body)))

(defgeneric ! (reciever message))

(defmethod ! ((thread sb-thread:thread) message)
  (! (get-process thread) message))

(defmethod ! ((process process) message)
  (if (eq message *exit*)
      (progn
        (kill-children process)
        (sb-thread:with-mutex (*processes-mutex*)
          (maphash (_ (when (and (eq _v process)
                                 (sb-thread:thread-alive-p _k))
                        (sb-thread:terminate-thread _k)))
                   *processes*)))
      (sb-thread:with-mutex ((mutex-of process))
        (setf (mbox-of process)
              (append (mbox-of process) (list message)))
        (sb-thread:condition-notify (waitqueue-of process)))))

(defun @ (&key timeout timeout-value)
    (with-accessors ((waitqueue waitqueue-of)
                     (mutex mutex-of)
                     (mbox mbox-of)) (get-process)
      (let (timeout-p)
        (when timeout
          (spawn (sleep timeout)
                 (sb-thread:with-mutex (mutex)
                   (setf timeout-p t)
                   (sb-thread:condition-notify waitqueue))))
        (sb-thread:with-mutex (mutex)
          (unless (or mbox timeout-p)
            (sb-thread:condition-wait waitqueue mutex))
          (if mbox
              (pop mbox)
              timeout-value)))))


#+test
(let ((thread (spawn (labels ((f (rev)
                                (case rev
                                  ('quit
                                     (print "quit!"))
                                  (t (print rev)
                                     (force-output)
                                     (f (@))))))
                       (f (@))))))
  (! thread 'hello)
  (sleep 1)
  (! thread 'world)
  (sleep 1)
  (! thread 'quit))

#+test
(let ((th (spawn
            (print "start...")
            (print (@ :timeout 0.1 :timeout-value "タイムアウトした"))
            (print "end...")
            (force-output))))
  (sleep 1)
  (! th "おわり"))
;;(@ :timeout 0 :timeout-value "タイムアウトした")

Shibuya.lisp テクニカルトーク #1

Shibuya.lisp テクニカルトーク #1 に参加してきた。個人的には JLUG Meeting 2000 以来だ。

JLUG は Franz 社がいてアカデミックな雰囲気だったが、Shibuya.lisp は完全にユーザの手作りのイベントだった。それにもかかわらず、いいかげんな感じなところはなく、くだけた話あり、とても深くテクニカルな話ありと、いいベントだった。みなさんありがとうございました。

本、イベント、オンラインと Lisp 的にいい流れになっているのを感じる。

[Commo Lisp] mapf

わだばLisperになる(g000001さん)のお題 【どう書く】MDL/Muddleのmapfを作る をやってみた。

ちなみに g000001 さんの回答と、onjo さんの回答が公開されてる。そっか、throw catch を使うのね。思いつかなかった。prog* がいかにも g000001 さんらしい。onjo さんのリストが省略された場合循環リストを使うのはエレガントだ。効率もちゃんと考えられているし。

throw catch は思いつかなかった結果、defvar したものをループの度に cond で判定してる。日頃からあまりにもエラーハンドリングを無視しすぎかな。

(defvar *mapleave* nil)
(defvar *mapret*   nil)
(defvar *mapstop*  nil)

(defun mapf (final-function loop-function &rest lists)
  (let (collect)
    (if lists
        ;; lists 指定あり
        (loop for i in (apply #'mapcar #'list lists)
              do (let (*mapleave* *mapret* *mapstop*)
                   (let ((ret (apply loop-function i)))
                     #1=(cond (*mapleave*
                               (return-from mapf (car *mapleave*)))
                              (*mapret*
                               (loop for i in (car *mapret*)
                                     do (push i collect)))
                              (*mapstop*
                               (push (car *mapstop*) collect)
                               (return-from mapf (nreverse collect)))
                              (t
                               (push ret collect))))))
        ;; lists 指定なし
        (loop (let (*mapleave* *mapret* *mapstop*)
                (let ((ret (funcall loop-function)))
                  #1#))))
    (if final-function
        (apply final-function (nreverse collect))
        (car lists))))

(defun mapleave (x)
  (setf *mapleave* (list x)))

(defun mapret (&rest args)
  (setf *mapret* (list args)))

(defun mapstop (x)
  (setf *mapstop* (list x)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; 以下テスト
(assert (equal (mapf #'list #'identity '(1 2 3 4))
               '(1 2 3 4)))

(defun mappend (fn &rest lists)
  (apply #'mapf #'append fn lists))

(assert (equal (mappend #'list
                        '(1 2 3 4 5)
                        '(a b c d e))
               '(1 A 2 B 3 C 4 D 5 E)))

(defun first-nonzero (list)
  (mapf ()
        (lambda (x)
          (when (not (zerop x)) (mapleave x)))
        list))

(assert (= (first-nonzero '(0 0 0 0 9 0 0))
           9))

(defun odd-list (list)
  (mapf #'list
        (lambda (x) (if (oddp x)
                        x
                        (mapret)))
        list))

(assert (equal (odd-list '(1 2 3 4 5))
               '(1 3 5)))

(defun odd-list2 (list)
  (mapf #'list
        (lambda (x) (if (oddp x)
                        x
                        (mapret 'e 'ven)))
        list))

(assert (equal (odd-list2 '(1 2 3 4 5))
               '(1 E VEN 3 E VEN 5)))

(defun first-ten (list)
  (let ((cnt 10))
    (mapf #'list
          (lambda (x)
            (when (zerop (decf cnt)) (mapstop 10))
            x)
          list)))

(assert (equal (first-ten '(1 2 3 4 5 6 7 8 9 10 11 12))
               '(1 2 3 4 5 6 7 8 9 10)))

(defun lnum (n &aux (cnt 0))
  (mapf #'list
        (lambda ()
          (if (<= n (incf cnt))
              (mapstop n)
              cnt))))

(assert (equal (lnum 10)
               '(1 2 3 4 5 6 7 8 9 10)))