2008/05/30

[Common Lisp] Twitter というよりむしろ CL-JSON

以前、Common Lisp で Twitter API をたたいて妙なアクセサを作ったりしたけど、CL-JSON にはもっと便利な機能があった。

  • *json-symbols-package*
  • *json-object-factory*
  • *json-object-factory-add-key-value*
  • *json-object-factory-return*

などを上手に設定してやれば、ちゃんと Lisp のオブジェクトを構築してくれる。下のコードの twitter-status は user スロットに twitter-user を持つが、そのへんもきちんとめんどうみてくれる。CL-JSON かしこい。

まだきちんと把握してないが、以下コードの断片。

(in-package :twittcl)
;; 文字コードは UTF-8 で
(setf drakma:*drakma-default-external-format* :utf-8)

;; ボディを文字列で取得するために、テキストとして判定される Content-Type を追加
(pushnew '("application" . "json") drakma:*text-content-types* :test #'equal)


(defclass* twitter-api ()
((user)
(passwd)))

(defun authorization (twitter-api)
(list (user-of twitter-api)
(passwd-of twitter-api)))

(defun friends-timeline (twitter-api)
"friends_timeline を取得する。"
(multiple-value-bind (json http-status)
(drakma:http-request "http://twitter.com/statuses/friends_timeline.json"
:basic-authorization (authorization twitter-api))
(when (= 200 http-status)
(decode-twitter-status json))))

(defun public-timeline (twitter-api)
"public_timeline を取得する。"
(json:decode-json-from-string
(drakma:http-request "http://twitter.com/statuses/public_timeline.json"
:basic-authorization (authorization twitter-api))))


(defclass* twitter-user ()
((name)
(screen-name)
(description)
(location)
(profile-image-url)
(url)
(id)
(followers-count)))

(defclass* twitter-status ()
((created-at)
(id)
(user)
(text)
(in-reply-to-status-id)
(source)))

(defun decode-twitter-status-status (obj key value)
(let ((slot (json::json-intern (substitute #\- #\_ key))))
(when (null obj)
(setf obj (if (eq 'name slot)
(make-instance 'twitter-user)
(make-instance 'twitter-status))))
(when (slot-exists-p obj slot)
(setf (slot-value obj slot) value)))
obj)

(defun decode-twitter-status (json)
(let ((json:*json-symbols-package* (find-package :twittcl))
(json:*json-object-factory* #'(lambda () (list)))
(json:*json-object-factory-add-key-value*
'decode-twitter-status-status)
(json:*json-object-factory-return* #'identity))
(json:decode-json-from-string json)))

2008/05/28

[アセンブラ] アセンブラで Brainf*ck のコア部分のみ

Brainf*ck の Hello, world! を アセンブラで実装してみた。コア部分のみ。Hello, world! のハードコーディング。

Direct threaded code になっているはず。

bits 64

section .text

%macro next 0
lodsq
jmp rax
%endmacro

;;; >
g:
inc r12
next
;;; <
l:
dec r12
next
;;; +
p:
inc byte [r12]
next
;;; -
m:
dec byte [r12]
next
;;; .
d:
mov r13, rsi
mov rax, 1
mov rdi, 1
push qword [r12]
mov rsi, rsp
mov rdx, 1
syscall
pop rax
mov rsi, r13
next
;;; ,
c:
mov r13, rsi
mov rax, 0
mov rdi, 0
push rax
mov rsi, rsp
mov rdx, 1
syscall
pop rax
mov [r12], rax
mov rsi, r13
next
;;; [
w:
mov rax, [r12]
and rax, 0x00000000000000ff
jnz .next
mov rsi, [rsi]
next
.next:
add rsi, 8
next
;;; ]
e:
mov rsi, [rsi]
next


global _start
_start:
mov r12, memory

baha:
mov rsi, .main
next
align 8
.main:
dq p
dq p
dq p
dq p
dq p
dq p
dq p
dq p
dq p
begin1:
dq w
dq end1
dq g
dq p
dq p
dq p
dq p
dq p
dq p
dq p
dq p
dq g
dq p
dq p
dq p
dq p
dq p
dq p
dq p
dq p
dq p
dq p
dq p
dq g
dq p
dq p
dq p
dq p
dq p
dq l
dq l
dq l
dq m
dq e
dq begin1
end1:
dq g
dq d
dq g
dq p
dq p
dq d
dq p
dq p
dq p
dq p
dq p
dq p
dq p
dq d
dq d
dq p
dq p
dq p
dq d
dq g
dq m
dq d
dq m
dq m
dq m
dq m
dq m
dq m
dq m
dq m
dq m
dq m
dq m
dq m
dq d
dq l
dq p
dq p
dq p
dq p
dq p
dq p
dq p
dq p
dq d
dq m
dq m
dq m
dq m
dq m
dq m
dq m
dq m
dq d
dq p
dq p
dq p
dq d
dq m
dq m
dq m
dq m
dq m
dq m
dq d
dq m
dq m
dq m
dq m
dq m
dq m
dq m
dq m
dq d
dq g
dq p
dq d
dq exit

exit:
mov rax, 60
xor rdi, rdi
syscall

section .bss
memory resq 1024 * 1024

2008/05/25

[Forth] Threaded Code

Threaded Code. マルチスレッドではない。コードの実行方法か。http://en.wikipedia.org/wiki/Forth_virtual_machine

言語を作るのなら重要項目の一つだね。

Threaded Code
このサイトが有名らしい。各種 threaded code を説明している。
Moving Forth: Part 1
図つきて各種 threaded code の説明がある。
Speed of various interpreter dispatch techniques V2
各 threaded code の性能比較。やはり DTC が速いのかな。repl-switch.c と switch.c の違いがよくわからん。make 一発で実行できるのが嬉しい。

Forth では次のような感じの実装になる。64bit アセンブラで。NASM ね。

rsi レジスタがバイトコードのアドレス。loadsq で rax に次に実行するバイトコードのアドレスをロードして(rsi はインクリメントされる)、ジャンプする。

Indirect threaded code

        lodsq
jmp qword [rax]

Direct threaded code

        lodsq
jmp rax

Token threaded code

        lodsq
jmp [token_table + rax * 8]

2008/05/22

[assembler] 64bit アセンブラで Hello World! こっちかな

どうやら 64bit だとシステムコールに syscall を使い、システムコールの番号も使うレジスタも違うみたい。

http://www.milw0rm.com/papers/110

        ;; -*- mode: asm; coding: utf-8; -*-
;; nasm -f elf64 nasm.asm
;; ld -s -o nasm nasm.o
;; ./nasm

section .text

global _start

_start:
mov rax, 1 ; 出力システムコール
mov rdi, 1 ; 標準出力
mov rsi, msg ; 文字列のアドレス
mov rdx, len ; 文字列の長さ
syscall ; システムコール実行

mov rax, 60 ; exit システムコール
mov rdi, 0 ; exit コード
syscall ; システムコール実行

section .data

msg db 'Hello World!', 0ah, 'まみむめも♪', 0ah
len equ $ -msg

2008/05/20

[assembler] 64bit アセンブラで Hello World!

Gas

Forth をいじってるとどんどん低レベルの領域に興味が移っていく。gas を使って Hello World! 64bit バージョン。.code64 で 64bit 指定だと思う。。。32bit だと %eax とか書くレジスタを %rax と書く。

/* -*- mode: asm; coding: utf-8; -*-
as -o hello64.o hello64.s
ld -o hello64 hello64.o
./hello64
*/

.code64
.text

.global _start

_start:
mov $4, %rax # 出力システムコール
mov $1, %rbx # 標準出力
mov $msg, %rcx # 文字列のアドレス
mov $len, %rdx # 文字列の長さ
int $0x80 # システムコール実行

mov $1, %rax # exit システムコール
mov $0, %rbx # exit コード
int $0x80 # システムコール実行

.data

msg: .ascii "Hello World!\nまみむめも♪\n"
msgend: len = msgend - msg

NASM でも

;; -*- mode: asm; coding: utf-8; -*-
;; nasm -f elf64 nasm.asm
;; ld -s -o nasm nasm.o
;; ./nasm

section .text

global _start

_start:
mov rax, 4 ; 出力システムコール
mov rbx, 1 ; 標準出力
mov rcx, msg ; 文字列のアドレス
mov rdx, len ; 文字列の長さ
int 80h ; システムコール実行

mov rax, 1 ; exit システムコール
mov rbx, 0 ; exit コード
int 80h ; システムコール実行

section .data

msg db 'Hello World!', 0ah, 'まみむめも♪', 0ah
len equ $ -msg

2008/05/11

タイフェスティバル

タイフェスティバルに行ってきた。ココナッツと香草の香でいっぱい。いっぱい美味しかった。

2008/05/08

[Common Lisp] Climacs のメモ

Climacs で日本語が表示できる、ということで Climacs のメモ。

まずは

command は eval-last-expression のようなシンボルではなくEval Last Expression のような英語表記で入力する。

キー

だいたい Emacs と同じ。一番重要なのは C-h b の Describe Bindings. キーバインドの説明を表示してくれる。

C-x C-c
Climacs を終了する。
C-h a
Apropos Command: コマンドを検索する。
C-h f
Describe command: コマンドの説明を表示する。
C-h w
Where is command: これでコマンドがどのキーに割り付けられているか調べられる。
C-x u
Undo.
C-c C-e
Eval Last Expression. カーソル直前の式を評価する。
C-c C-k
Compile And Load File. コンパイルしてロードする。Slime と同じ。
C-c C-c
カーソル位置の式をコンパイルする。

12文字消すような場合は C-u 1 2 C-dM-1 M-2 C-d とする。C-u - 3 C-d あるいは M-- M-3 C-d で3文字バックスペースになる。

Climacs Commands Comparison このサイトの一覧が便利。

ドキュメントの作成方法

(defvar *output-dir* #p"$DOCSTRINGDIR") これは McCLIM のドキュメントだった。

climacs/Doc ディレクトリで make すれば生成される。

グループ(Groups)

バッファやファイルをグルーピングする機能がある。文字の置き換え等をそのグループに対して行うことができる。

カスタマイズ

climacs-rv で背景色黒で起動できる。:width と :height で起動時の画面の多きさの指定ができる。:new-process t で別スレッドで起動する。

あとキーアサインを少々カスタマイズ。

ということで ~/.sbclrc に次のように書いておく。

(defun climacs ()
"Climacs を起動する。"
(load (merge-pathnames ".climacs.lisp" (user-homedir-pathname))))

そして、~/.climacs.lisp

(eval-when (:compile-toplevel :load-toplevel :execute)
(require :mcclim)
(require :mcclim-freetype)
(require :climacs))

;; C-h をバックスペースにするために、C-h のキーストロークを削除。
(clim:remove-keystroke-from-command-table 'esa:help-table
'(:keyboard #\h 512)
:errorp nil)
;; C-h でバックスペース
(esa:set-key `(drei-commands::com-backward-delete-object
,clim:*numeric-argument-marker*
,clim:*numeric-argument-marker*)
'drei:deletion-table
'((#\h :control)))
;; C-m newline and indent
(esa:set-key 'drei-lisp-syntax::com-newline-indent-then-arglist
'drei-lisp-syntax:lisp-table
'((#\m :control)))
;; C-/ undo
(esa:set-key 'drei-commands::com-undo
'drei:editing-table
'((#\/ :control)))
;; C-i で補完
(esa:set-key 'drei-lisp-syntax::com-indent-line-and-complete-symbol
'drei-lisp-syntax:lisp-table
'((#\i :control)))

;; Climacs 起動
(climacs:climacs-rv :width 900 :height 1000 :new-process t)

欲しい機能

ファイルを開くときの ~/ をホームに展開と /usr//tmp/a.lisp を /tmp/a.lisp に展開。

Tab でコマンドやファイル名が補完できるが、候補の一覧は表示しない。一覧がほしい。

困ったとき

カーソルが青くなったら、どうすればいいんだろう?
C-x 0フォーカスのないバッファではカーソルが青くなるらしい。さらにリードオンリーのバッファではカーソルが表示されない。ということで C-x 0 で復帰するはず。
固まった?
Emacs の Slime から起動していれば、Slime のデバッガバッファが Emacs に表示されているはず。Restarts から [RETURN-TO-ESA] を選択する。

[Common Lisp] clouseau:inspector

McCLIM に GUI のインスペクタが付いている。

(clouseau:inspector clim-internals::*command-tables* :new-process t)

使い方がよく分からないが、値の変更やメソッドの削除なんかもできそう。

2008/05/06

[Common Lisp] Climacs も日本語表示できた

Climacs も (require :mcclim-freetype) で日本語表示できた。UTF-8 で書いた日本語を含むファイルのオープン、セーブできた。カーソル移動や C-t もちゃんと動作する。XIM は未サポートのよう。XIM をなんとかするか、SKK を移植すれば Climacs の中で生きていけるかも。

ちゃんと Lisp コードにも色が付く。まだ使い方が全然分からないけど Climacs おもしろい♪

(eval-when (:compile-toplevel :load-toplevel :execute)
(require :mcclim)
(require :mcclim-freetype)
(require :climacs))

(climacs:climacs :new-process t)

[Common Lisp] McCLIM で日本語表示できた

mcclim/Experimental/freetype/mcclim-freetype.asd を require したら日本語表示できた♪

(eval-when (:compile-toplevel :load-toplevel :execute)
(require :mcclim)
(require :mcclim-freetype))

(in-package :clim-user)

(define-application-frame hello-frame ()
()
(:pane (make-pane 'application-pane :display-function #'display-hello))
(:geometry :width 400 :height 200))

(defmethod display-hello ((hello-frame hello-frame) stream)
(format stream "こんにちは! Hello World! 日本語だ!"))

(defun run ()
(run-frame-top-level (make-application-frame 'hello-frame)))

;;(run)

2008/05/04

お祝いの日

今日はみんなまとめてお祝いの日。メインは姪っ子の1歳の誕生日。とてもよく意思疎通ができて、よく笑うこだ。うちのこは小さいころは全然笑わなかったな。

家に帰って娘はプレゼントの絵本を黙読。5歳で黙読できるのか。そのあとどんな話だった? ときいたら、ちゃんと始めから要約してくれた。このこはえらいよ。

2008/05/03

[Common Lisp] SBCL 環境 ライブラリ ~/.sbclrc

Common Lisp のライブラリ環境をそろえるのに幾つか方法があると思うが、私がどうしているかを書いておく。

Debian を使用。基本的に Debian のパッケージがあるものは Debian のパッケージを使う。

パッケージのないもの、あっても最新バージョンが欲しいものは~/letter/lisp/lib の下に各リポジトリからチェックアウトしている。Common Lisp 界は darcs が多かったけど git が主流になりつつある気がする。それらを asdf:*central-registry* に登録するために下記のようにcl-fad を使っている。

Debian パッケージもリポジトリの公開もないものは asdf-insatll している。

あとライブラリを探すときは CLikiThe Common Lisp Directory を参照する。

~/.sbclrc はこうなっている。

;;;;; -*-lisp-*-

;;デバッグ用セッティング
(declaim (optimize debug safety))

;; for debug
(defmacro p (&body body)
`(progn ,@(mapcar #'(lambda (arg)
`(format t "~30a ; => ~a~%" ',arg ,arg))
body)))

(setf (logical-pathname-translations "ancient")
`(("**;*.*" "/home/ancient/letter/lisp/**/*.*")))

;; for tama
(pushnew (translate-logical-pathname "ancient:web;tama;")
asdf:*central-registry* :test 'equal)

;; ~/letter/lib 以下の asd を登録する。
(require :cl-fad)
(cl-fad:walk-directory
(translate-logical-pathname "ancient:lib;")
#'(lambda (path)
(let ((pd (pathname-directory path)))
(unless (member "_darcs" pd :test #'equal)
(pushnew
(make-pathname :directory pd)
asdf:*central-registry*
:test #'equal))))
:test #'(lambda (path)
(string-equal "asd" (pathname-type path))))

;;; If the first user-processable command-line argument is a filename,
;;; disable the debugger, load the file handling shebang-line and quit.
(let ((script (and (second *posix-argv*)
(probe-file (second *posix-argv*)))))
(when script
;; Handle shebang-line
(set-dispatch-macro-character #\# #\!
(lambda (stream char arg)
(declare (ignore char arg))
(read-line stream)))
;; Disable debugger
(setf *invoke-debugger-hook*
(lambda (condition hook)
(declare (ignore hook))
;; Uncomment to get backtraces on errors
;; (sb-debug:backtrace 20)
(format *error-output* "Error: ~A~%" condition)
(quit)))
(load script)
(quit)))

他の人たちはどうしてるんだろう?

[Common Lisp] asdf-install を使って Drakma 等をインストールする

処理系は SBCL とします。Drakma等は asdf-install を使って次のようにインストールするのが簡単だと思います。asdf-install は SBCL に付属しています。他には clbuild を使う方法もあります。

CL-USER> (require :asdf-install)
("ASDF-INSTALL")
CL-USER> (asdf-install:install :drakma)
Install where?
1) System-wide install:
System in /usr/lib/sbcl/site-systems/
Files in /usr/lib/sbcl/site/
2) Personal installation:
System in /home/ancient/.sbcl/systems/
Files in /home/ancient/.sbcl/site/
--> 2

ここで 2 を入力してください。

No key found for key id 0x#1=595FF045057958C6.  Try some command like
gpg --recv-keys 0x#1#
[Condition of type ASDF-INSTALL::KEY-NOT-FOUND]

Restarts:
0: [SKIP-GPG-CHECK] Don't check GPG signature for this package
1: [ABORT] Return to SLIME's top level.
2: [TERMINATE-THREAD] Terminate this thread (#<THREAD "repl-thread" {10034FE621}>)

みたいなのが表示されたら 0 を入力してください。あと同様に cl-ppcre 等をインストールしてください。

(asdf-install:install :cl-ppcre)
(asdf-install:install :cl-interpol)
(asdf-install:install :s-xml)

各ライブラリのサイトはこちら

2008/05/02

cl-win32ole を CodeRepos に移動しました。

cl-win32ole を CodeRepos に移動しました。もしよかったらいじってやってください。

svn checkout http://svn.coderepos.org/share/lang/commonlisp/cl-win32ole/trunk cl-win32ole