2008/02/23

春一番

春一番がふきました。すごい砂埃(?)で、窓から見える風景は雨の日のような視界でした。

さて、言語作りは順調に進んでいます。かなり Factor ライクになってしまいました。
スタックベースでパターンマッチング。
こんな感じです。ちなみに .) はドットリストを作る関数です。で ) はリストを作る関数です。

: each # seq quot --
| ( x xs .) quot | x quot call xs quot each ;
2dorp .

( 1 2 3 ) [ p ] each # 1 2 3 を表示

: map # seq quot -- newseq
nil (map) .

: (map) # seq quot acc -- newseq
| ( x xs .) quot acc | xs quot ( x quot call acc .) (map) ;
| _ _ acc | acc reverse .

( 1 2 3 ) [ dup * ] map # ( 1 4 9 ) を返す

なんで私の興味はこうマイナーな方向に進んでいくんだろう、とすこし悩んだりもしましたが、自分が楽しければそれでいいや、とこれからも好きなようにやっていこうと思います。
JavaScript にしても Ruby にしてもあまり好きになれないんだもん。
コードを書いていて爽快感が感じられないのです。
Common Lisp や Erlang はささいなコードでも爽快感が感じられます。

2008/02/17

Forth 系の言語を作ってる

Forth 系の言語ってかなり好きです。
The Log of the No22 さんところの「それは逆ポーランドじゃない」を読んで感動しました。
全てがスタックに対する関数であり、プログラムは関数の連結からなるという concatenative 言語。
すばらしい。
ということで、Forth 系の言語を作っています。
楽しいです。

2008/02/09

Common Lisp : Weblocks がいい感じに仕上がってきています。

Common Lisp の継続ベース Web フレームワークである Weblocks がいい感じに仕上がってきています。
CLSQL を永続化のバックエンドとして使えるようになり、(簡単なものは)かなり簡単に書けるようになりました。
例のごとく簡単な TODO アプリケーションを作ってみます。

データベースは PostgreSQL を使います。あらかじめ PostgreSQL のユーザとデータベースを作成しておきます。テーブルの作成は必要ありません。
sudo -u postgres createuser -s -P ancient
CREATE DATABASE junk WITH ENCODING='UTF8' OWNER=ancient;

Weblocks 自体のインストールは依存するライブラリがたくさんあって大変ですが、がんばってインストールします。asdf-install を使うのが一番簡単だと思います。こちらのページを参考に。

TODO アプリケーションのコードは下に示しますが、だいたい次のような感じです。


  1. CLSQL でテーブルに対応するクラス todo を定義。

  2. todo クラスのグリッドビューとフォームビューを定義。scaffold というキーワードが出てきてますね。

  3. PostgreSQL への接続定義。

  4. Weblocks のアプリケーション定義。

  5. エントリーポイントとなる init-user-session の定義。継続ベースだと入口が必要です。

  6. Web サーバの開始と、テーブルの作成


やはり Common Lisp だとテーブルからクラスではなく、クラスからテーブルですね ;)
;;;;-*- mode: lisp; syntax: common-lisp; -*-
(eval-when (:compile-toplevel :load-toplevel :execute)
(require :weblocks)
(require :clsql))

(defpackage #:todo
(:use #:common-lisp #:weblocks #:clsql)
(:export #:start))

(in-package :todo)

;;; CLSQL のビュークラス定義。モデル定義。
(def-view-class todo ()
((id :accessor id :db-kind :key :db-constraints (:not-null :unique)
:type integer)
(content :initarg :content :accessor content :db-constraints :not-null
:type (varchar 80))
(done :initarg :done :accessor done-p :type boolean)))

;;; Weblocks の Grid ビュー定義。
(defview todo-grid-view (:type grid :inherit-from '(:scaffold todo))
(id :hidep t))

;;; Weblocks の Form ビュー定義。
(defview todo-form-view (:type form :inherit-from '(:scaffold todo))
(id :hidep t))

;;; CLSQL への接続定義。Postgresql に接続する。
(defstore *sql-store* :clsql '("localhost" "junk" "ancient" "password")
:database-type :postgresql)

;;; Weblocks のアプリケーション定義。
(defwebapp 'todo-application
:description "簡単な TODO アプリケーションです。")

;;; Weblocks のいわばエントリポイント。
(defun init-user-session (comp)
(setf (weblocks:composite-widgets comp)
(make-instance 'gridedit
:name 'todo-grid
:data-class 'todo
:sort '(id . :asc)
:view 'todo-grid-view
:item-form-view 'todo-form-view)))

;;; Weblocks を開始して、TODO テーブルを作成する。
(defun start ()
;; Weblocks の開始。
(start-weblocks :port 8080)
(setf hunchentoot:*catch-errors-p* nil) ; エラー時はデバッガが起動するように
;; TODO テーブルの作成
(ignore-errors (create-view-from-class 'todo)))

;;; TODO テーブルの削除
;;(drop-view-from-class 'todo)

2008/02/06

Common Lisp : cl-win32ole Excel UsedRange

Excel に書かれたテーブル仕様書から clsql:def-view-class でテーブルクラスを作り、clsql-sys:create-view-from-class で Postgresql 上にテーブルを作成しました。
Excel から clsql:def-view-class 定義を作るのにはもちろん cl-win32ole を使いました。
最初は Excel のセルを1つずつ見ていかないとだめかな、めんどうだなぁ、と思っていたのですが。
値の入っているセルの範囲を取得できる UsedRange という便利なメソッドを見つけました。
これで、Excel シート上のデータを一括で Lisp のリストとして取得できます。
あとは、Lisp でのリスト操作なので楽々でした♪
UsedRange とっても便利です。

(eval-when (:compile-toplevel :load-toplevel :execute)
(require :cl-win32ole)
(use-package :cl-win32ole))

(defun excel-contents (path)
(let ((excel (create-object "Excel.Application")))
(unwind-protect
(ole excel :workbooks :open path
:worksheets :item 1
:usedRange :value)
(ole excel :quit))))

2008/02/01

Factor : 日本語入力の調査 -- **とり**あえずまとめ

Linux 環境で Factor UI での日本語入力ですが、なんとか次のようなパッチで可能となります。
64bit 環境だと XwcLookupString がうまく動いていなかったのでその辺も対応しています。
できたらフォントまわりも設定可能にしたかったのですが、フォントをコピーすれば表示可能なのでやめました。

diff -ur factor-org/extra/x11/xim/xim.factor factor/extra/x11/xim/xim.factor
--- factor-org/extra/x11/xim/xim.factor 2007-12-13 08:58:21.000000000 +0900
+++
factor/extra/x11/xim/xim.factor 2008-02-01 22:09:28.000000000 +0900
@@ -7,9 +7,15 @@

SYMBOL: xim

+: (init-xim) ( classname medifier -- im )
+ XSetLocaleModifiers [ "XSetLocaleModifiers() failed" throw ] unless
+ dpy get f rot dup XOpenIM ;
+
: init-xim ( classname -- )
- dpy get f rot dup XOpenIM
- [ "XOpenIM() failed" throw ] unless* xim set-global ;
+ dup "" (init-xim)
+ [ nip ]
+ [ "@im=none" (init-xim) [ "XOpenIM() failed" throw ] unless* ] if*
+ xim set-global ;

: close-xim ( -- )
xim get-global XCloseIM drop f xim set-global ;
@@ -32,11 +38,11 @@
SYMBOL: keysym

: prepare-lookup ( -- )
- buf-size "ulong" <c-array> keybuf set
+ buf-size "uint" <c-array> keybuf set
0 <KeySym> keysym set ;

: finish-lookup ( len -- string keysym )
- keybuf get swap c-ulong-array> >string
+ keybuf get swap c-uint-array> >string
keysym get *KeySym ;

: lookup-string ( event xic -- string keysym )
diff -ur factor-org/extra/x11/xlib/xlib.factor factor/extra/x11/xlib/xlib.factor
--- factor-org/extra/x11/xlib/xlib.factor 2007-12-13 08:58:21.000000000 +0900
+++
factor/extra/x11/xlib/xlib.factor 2008-02-01 21:53:44.000000000 +0900
@@ -1339,10 +1339,28 @@

FUNCTION: int Xutf8LookupString ( XIC ic, XKeyPressedEvent* event, char* buffer_return, int bytes_buffer, KeySym* keysym_return, Status* status_return ) ;

+! !!! category of setlocale
+: LC_ALL 0 ; inline
+: LC_COLLATE 1 ; inline
+: LC_CTYPE 2 ; inline
+: LC_MONETARY 3 ; inline
+: LC_NUMERIC 4 ; inline
+: LC_TIME 5 ; inline
+
+FUNCTION: char* setlocale ( int category, char* name ) ;
+
+FUNCTION: Bool XSupportsLocale ( ) ;
+
+FUNCTION: char* XSetLocaleModifiers ( char* modifier_list ) ;
+
SYMBOL: dpy
SYMBOL: scr
SYMBOL: root

+: init-locale ( -- )
+ LC_ALL "" setlocale [ "setlocale() failed" throw ] unless
+ XSupportsLocale [ "XSupportsLocale() failed" throw ] unless ;
+
: flush-dpy ( -- ) dpy get XFlush drop ;

: x-atom ( string -- atom ) dpy get swap 0 XInternAtom ;
@@ -1353,6 +1371,7 @@
] unless* ;

: initialize-x ( display-string -- )
+ init-locale
dup [ string>char-alien ] when
XOpenDisplay check-display dpy set-global
dpy get XDefaultScreen scr set-global


factor/fonts/Makefile
MONO=/usr/share/fonts/truetype/vlgothic/VL-Gothic-Regular.ttf
PRO=/usr/share/fonts/truetype/vlgothic/VL-PGothic-Regular.ttf


all :
ln -fs $(PRO) Vera.ttf
ln -fs $(PRO) VeraBI.ttf
ln -fs $(PRO) VeraBd.ttf
ln -fs $(PRO) VeraIt.ttf
ln -fs $(MONO) VeraMoBI.ttf
ln -fs $(MONO) VeraMoBd.ttf
ln -fs $(MONO) VeraMoIt.ttf
ln -fs $(MONO) VeraMono.ttf
ln -fs $(PRO) VeraSe.ttf
ln -fs $(PRO) VeraSeBd.ttf
ls -l