[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)))

[アセンブラ] アセンブラで 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

[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]

[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

[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

タイフェスティバル

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

[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-d か M-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)

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

[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)

お祝いの日

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

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

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

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

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

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

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

あとライブラリを探すときは CLiki と The 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)

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

• Drakma
• CL-PPCRE
• CL-INTERPOL
• S-XML

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

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

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