To good to be true?

No, it wasn't!

I've wrote about implementing Karatsuba multiplication in previous post (sorry it's in Japanese). So I wanted to make all internal bignum multiplication to use it. Now I've modified expt to use it. Then next step is of course benchmark :)

Actually, it didn't make any performance better and it's quite difficult to compare because of the bug. So I've decided to compare with Mosh and Ypsilon, especially Mosh which is using GMP internally. So I wrote this piece of code;

(import (rnrs) (time))
(define-syntax dotimes
  (syntax-rules ()
    ((_ (var i res) . body)
     (do ((limit i)
          (var 0 (+ var 1)))
         ((>= var limit) res)
       . body))
    ((_ (var i) . body)
     (do ((limit i)
          (var 0 (+ var 1)))
         ((>= var limit))
       . body))
    ((_ . other)
     (syntax-violation 'dotimes
                       "malformed dotimes"
                       '(dotimes . other)))))

;; To avoid compile time constant folding
;; Sagittarius' compiler is a bit smarter than
;; the others :)
(define v (make-vector 1 512))

(time (dotimes (i 5000) 
        (let ((e (vector-ref v 0)))
          (expt #x123456789ABCDEF12 e))))

(display 'done) (newline)

And for Mosh, this was also required;

;; file name time.mosh.sls
(library (time)
    (export time)
    (import (mosh)))

Now, it's good to go. It took a bit time to figure out that Sagittarius compiler computes constant variable in compile time even though I implemented it. (That causes benchmark time always 0.00ms, so it was indeed 'too good to be true'. well but true though :-P)

The result was like this;

% ./build/sash.exe num.scm

;;  (dotimes (i 5000) (let ((e (vector-ref v 0))) (expt 20988295479420645138 e)))
;;  3.160898 real    3.2290000915527344 user    0.000000 sys
done

% ypsilon num.scm

;;  4.47794 real    4.524029 user    0.0 sys
done

% mosh num.scm

;;4.463438034057617 real 4.18 user 0.234 sys
done

As usual, I was very surprised with Ypsilon. It doesn't use GMP but the same time as Mosh. Anyway, Sagittarius' expt is faster than any others now. (could be before as well but incorrectly.)

カラツバ法

CourseraのAlgorithm Part1で出てきてふと実装熱が再燃した。

カラツバ法はかなり面白い乗算のアルゴリズム(と個人的に思っている)で、最初見たときはいきなり意味不明なことしてるぞ、とか思ったりした。アルゴリズムの肝は以下のような感じ。

;; multiplicands, x y
(define x #x123456789)
(define y #x908765432)

(define B 16) ;; radix
(define n 9)  ;; n digits

#|
x = a*B^(n/2) + b
y = c*B^(n/2) + d
|#
(define a #x12345) ;; most significant part of x
(define b #x6789)
(define c #x90876) ;; most significant part of y
(define d #x5432)

#|
x*y = (a*B^(n/2) + b) * (c*B^(n/2) + d)
    = B^n*ac + B^(n/2)*(ad + bc) + bd
    = 16^n*ac + 16^(n/2)*(ad + bc) + bd
|#
(let ((ac (* a c))
      (bd (* b d))
      (xx (+ (* a d) (* b c))))
  (+ (* (expt B (* (div n 2) 2)) ac) 
     (* (expt B (div n 2)) xx)
     bd))

以前実装を諦めた理由を覚えていないのだが、なんとなく実装できたのでベンチマークをとってみた。ベンチマークには以下のコードとスクリプトを仕様。

(import (time) (sagittarius control))
(define ex 2048)
(define ey 2048)
(define x (expt 2 ex))
(define y (expt 2 ey))
(define count 50000)

(time (dotimes (i count) (* x y)))

#!/bin/sh
echo Non karatsuba
time sash multi.scm
echo Karatsuba
time ./build/sash multi.scm

何のことは単なるスクリプト。シェルでtimeコマンド使う必要は無かったかもしれない。っで、以下が結果。

$ ./time.sh
Non karatsuba

;;  (dotimes (i count) (* x y))
;;  2.238128 real    2.215000 user    0.000000 sys

real    0m2.771s
user    0m2.449s
sys     0m0.296s
Karatsuba

;;  (dotimes (i count) (* x y))
;;  1.882108 real    1.872000 user    0.000000 sys

real    0m2.387s
user    0m2.090s
sys     0m0.296s

400msほど高速に計算する。まぁ、5万回まわしてこの程度とも言える。

カラツバ法のアルゴリズムだからなのか実装が悪いのか分からないが、乗算の数値のサイズが違いすぎると逆に遅くなる。適当に計測した結果、Sagittariusの実装だとおよそ10ワードが境界となった。なのでそれ以上の差がある場合は従来の乗算を使う。(この辺例えばToom-3とか実装すると解決するのかも、とか思いながら腰は重い。)

SRFI-11の紹介

(LISP Library 365参加エントリ)

SRFI-11は多値を扱う構文です。このSRFIではlet-valuesとlet*-valuesという構文を提供します。多値を扱う構文といえばすでにSRFI-8を紹介していますが、こちらは構文の名前がもう少しだけ直感的です。

R6RS/R7RSに慣れ親しんだ方なら既に知っているかと思いますが、以下のように使います。

(import (rnrs))
;; or (import (scheme base))
;; or (import (srfi :11))
;; if you want to use it on Gauche, then (use srfi-11)

(let-values (((a b c) (values 1 2 3)))
  (+ a b c))
;; -> 6

(let*-values (((a b c) (values 1 2 3))
              ((d e)   (values a (+ b c))))
  (+ a b c d e))
;; -> 12

(let-values (((a b . c) (values 1 2 3 4 5)))
  (list a b c))
;; -> (1 2 (3 4 5))

(let-values ((v (values 1 2 3)))
  v)
;; -> (1 2 3)

letのように直感的に多値の束縛が可能になります。

これはreceiveにもいえるのですが、処理系によっては多値の実装をこれらの構文で行いcall-wit-valuesを単なる手続きにしているものもあります。そのような処理系では構文で束縛する方がコストが安いことが多いです*1。

今回はSRFI-11を紹介しました。

*1:例えばSagittariusでcall-with-valuesを使うと必ずconsumer手続きに渡される引数がパックされるのでメモリの消費が多少大きくなります。またprocedureもしくはconsumer手続きがlambdaを使って書かれている場合インライン展開されずに手続きが必ず生成されます。多値を多用する際に性能を出すにはlet-valuesもしくはreceiveを使う必要があります。

厄介めなバグ

「厄介め」という言葉があるかどうかは別にして、そこそこどうしようかなぁと思わせるバグを発見してしまった。

端的には以下のようなコードが問題になる。

(read (open-string-input-port "#!r6rs #t"))
(call-with-string-output-port
  (lambda (out)
   (write '|\|| out)))
;; expect: "|\\||"
;; actual: "\x7c;"

要するにreadが読み込んだ#!がVM全体に影響を与えるという問題である。リードテーブルはポート単位なのだが、#!はファイル単位で管理されているのが大元の問題といえばそうなる。

ではどうするか？とりあえず思いつく解決案としては、loadで読まれたのかread(もしくはそれに準じる手続き)で読まれたのかが分かればVMのフラグを立てる立てないのチェックが出来そうである。(そもそも、#!がリーダー以外に影響を与えるというのがよくないというのもあると言えばあるのだが、それを直すのはちと大変なのだ。)

上記の解決案で問題になることがあるとすれば、ユーザーがreadとevalを用いて自作loadを作った場合だろう。そこまで考慮にいれるべきなのかという話でもあるのだが、Scheme精神としてはYesで個人的にはNoだったりする。ただ、既に見えている問題というのは大抵「後で自分が踏む可能性が高い問題」と言い換えることができるので、ここで手抜きして後で苦労するか、ここで苦労して後で楽をするかである。怠惰なプログラマを目指す僕としては「未来の自分が楽をするために努力する」べきだと思うのでもう少し抜本的な解決策を模索するべきだろう・・・

プログラミングスタイル

多少時期を逃した感はあるが、最近「オブジェクト指向 v.s. 関数型プログラミング」というHaskel最高っていってる記事を読んだ*1。僕はオブジェクト指向も関数型プログラミングも中の中くらいの凡々プログラマなのだが、ふと10年くらい前に「これからはオブジェクト指向、手続き型は古い」みたいなのが流行していたのを思い出した。

当時はJavaが(まだ)新興言語に近くオブジェクト指向とはなんぞやみたいな感じだった(気がする)。それに便乗したのか、雑誌の多くは「これからはオブジェクト指向」みたいな感じで、ちょうど上記の記事みたいなことを列挙していた。以下は記憶にある項目

• コードの再利用
• 疎結合
• トップダウンスタイル開発
• 可読性
• メンテナンスの容易さ

等々だった気がする。これ見て当時まだまだ若造(今でもだが)だった僕は「オブジェクト指向ってすごいんだねぇ」と思った記憶がある。

そう思った矢先というわけでもなかったかもしれないが、この風潮に批判的な記事ももちろんあって、その一つで鮮明に覚えているのがC言語でも昔からオブジェクト指向がされてきたみたいなことを言っているものだったと思う。具体的にはlibcにあるFILE構造体はそれだというようなことを指して、gtkとかもCだがオブジェクト指向してるという話をしていた気がする。そこから、プログラミングで重要な要素の一つは抽象化であって、オブジェクト指向言語でなければそれが出来ないというわけではない(が面倒)、というのを学んだ気がする。

さて、そんな猫も杓子もオブジェクト指向な時代は(多分)5年くらい前に終わって、企業が使う言語と言えばJavaな時代が来たわけだ。大勢の人が使うということは、Javaが求めるスタイルに合わない人が多数出てくるということでもある。自分もどちらかと言えば合わない方だろう。そうすると時代は繰り返すのか、今はまだメインストリームではないスタイルを引っ張り出してきてこっちの方がいいから皆も使うべき、見たいなのが出てくる。っで、どの辺が優れているかというので、大体上記の項目が挙げられるわけだ。最近の動向だと、関数型プログラミングがその矢面に立ってる気がする。

それ自体は別に悪いことではない、と思う。ただ、10年前も思ったんだけど、これがすごいからこれをやるべきって声高に叫んでる人はその本質をあまり理解していないんじゃないかなぁと思うことが割りとあるということ。当時Javaと比較されていたC言語のサンプルは大体目も当てられないくらいひどいコードで、こんなひどいコードがJavaを使えばこんなにすっきり書けます、みたいな煽動していた気がする。最近の煽り記事もそんな感じの部分が見えなくもない。相手方が嫌いだからわざわざ不利になるような局面だけを選ぶとか。

結局全てはコードを書く人の技量によるわけで、関数型だからいいとか、オブジェクト指向だからいいということはないと思う。ただ、言語がサポートしていないから書き辛いというのがあるだけで。そうすると求められるのはつまるところ、マルチパラダイムな言語でいざとなればユーザーが言語自体を拡張できる言語ということになるんじゃないかな？*2

どうでもいいのだけど、こういう比較で必ずといっていいほど出てくる、LISPは関数型というの。 いくつか突っ込みどころがあるけど、とりあえず3大方言に限ればLISPは関数型ではないので引き合いに出すのを止めてほしいなぁ*3。関数型、オブジェクト指向、手続き型どれでもいけるマルチパラダイムなんだし、関数型って言われるとそんな風に使っていない自分の心が非常に痛むので。

*1: もし記事を読んで感銘を受けてしまったらこちらも読んでおいてほしい。http://anond.hatelabo.jp/20140410134501
*2: Common Lispはそんな言語なのに不思議と人気がない件
*3: これが言いたかっただけ

SRFI-10の紹介

(LISP Library 365参加エントリ)

SRFI-10は読み込み時にオブジェクトの構築を行う仕組みを提供するSRFIです。 Common Lispでいうところの#.を提供するものです。比較の項目を見るとCLとの違いが書いてあります。端的に言えばdefine-reader-ctorで登録しないと意味を成さないのでより粒度の高いコントロールが可能といった感じです。

使い方を見てみましょう。

;; Sagittarius doesn't support this SRFI
;; so the example code is for Gauche
(use srfi-10)
(define-reader-ctor 'cons cons)
'#,(cons 1 2)
;; -> (1 . 2)

これだけだと普通に(cons 1 2)と書くのと変わらないのですが、SRFIの例にあるように文字列から読み込む等の処理を書いたり、定数/リテラルのように扱うことができます。

さて、このSRFI結構便利そうに見えるのですがサポートしている処理系は以外にも少なそうです(参照)。 個人的にはR6RS以降のライブラリとの相性が悪いからだとも思うのですが、理由のところは定かではありません。(そもそもR6RSでは#,は別の意味があるので実装不可能ですが・・・) リーダーマクロをサポートしている処理系であればこれは要らないというのもあるかもしれません。Sagittariusでサポートしていない理由は後者が大きいです。

今回はSRFI-10を紹介しました。

Set, bag and comparator

I've implemented new final SRFI 114 (not sure if this is really final state since there was no call for final from author...). You may already know this SRFI is used in SRFI-113. it's like the relationship between SRFI-13 and SRFI-14. If this is related to other SRFI then next step would be implementing SRFI-113 (needs to be finalised first though).

So I've read a bit of SRFI-113 specification and realised that this is very generic and can be applied existing charset. However if I apply it to charset, it would be a big internal change. Even though there is still some time to be finalised, it's better to think about how I should implement.

The very first consition is this;

• Charset can't be moved to Scheme world

This is because it's used for builtin regular expression and moving it to Scheme world would be serious performance issue. Then implementing strategy would be like this;

• Make <set> class in C as base clasts
• <char-set> extends it
• Implement <set> constructor and some procedures in C
• Rewrite SRFI-14 implementation

Now there is already a problem with this strategy and which is comparator needs to be implemented in C. As I mentioned above I've already implemented SRFI-114 in Scheme. Implementing in Scheme was really easy but moving to C would be a bit hard. There are 2 considerations;

1. Performance
2. Co-operate with Scheme world

#1 is the biggest. The constructor of comparator takes 4 procedures, though 2 of them can be omitted, and created comparator is used for sets to determine whether or not the given elements are in the set. Thus, for charset I need to implement this behaviour in C. It's not possible of course but naive implementation causes performance issue since calling Scheme procedure from C costs a lot. There are at least 2 solution for this; one is calling procedure directly if it's subr (which is C world procedure). the other one is make comparator be able to have both C functions and Scheme procedures. The first one is used for hashtable and the latter one is used for ports. For builtin charset, the first one would be sufficient but not sure if anyone wants to extend it.

#2 is a bit less serious. It's related to class hierarchy. How should class hierarchy of <set> look like? The very naive but safe way would be like this;

• <abstract-set>
• <charset>
• <set>
• <integer-set>

So <charset> and <set> share the super class but it's not in direct relation. This is more like implementing the same interface. The other one would be like this;

• <set>
• <charset>
• <integer-set>

<set> is the base class of all set related classes. This is more direct. The class hierarchy affects the implementation. If I take the first one, then comparator doesn't have to be in C but second one. However for the first one, it would be very inconvenient/indirect to implement common set APIs. The goal for this merging is sharing the APIs. It doesn't have to support all SRFI-114 APIs but should be able to provide it with common APIs and can be applied for both sets.

Fortunately, there is still time to think about it but not much I think...

SRFI-9の紹介

(LISP Library 365参加エントリ)

SRFI-9はレコードの定義を行う最初のSRFIです。最初といったのはSRFIでのレコード型の導入は4つあり、SRFI-9はその最初のものだからです。

では使い方を見てみましょう。

(import (srfi :9))
(define-record-type <pare> (kons x y) pare?
  (x kar set-kar!)
  (y kdr))

(define p (kons 'a 'b))
;; for convenience, put like this but it's implementation dependent.
;; -> <kons 'a 'b> 

(kar p)
;; -> 'a

(kdr p)
;; -> 'b

(set-kar! p 'c)
;; unspecified

(kar p)
;; -> 'c

(set-kdr! p 'd)
;; -> unbound variable error

これで新しい型<pare>を定義可能します。この定義ではは2引数取るkonsを構築手続きとし、pare?を述語、kar及びkdrをアクセサ、set-kar!をフィールドxの変更手続きとして定義します。ちなみにフィールドyは変更不可能です。

LISP Library 365で到達するか分からないので、他のレコードSRFIを以下の列挙します。

• SRFI-57: Records
• SRFI-9で足りていない機能追加版です。SRFI-9とは上位互換になるはずです(未確認)
• SRFI-76: R6RS Records
• R6RSに入っているレコードです。SRFI自体は棄却されています。
• SRFI-99: ERR5RS Records
• R6RSのレコードは不満が多かったので、それを解消するために作られたSRFIです。R6RSのレコード機能はそのままにSRFI-9ともコンパチになっています。

ちなみに、R7RSに入ったレコードはSRFI-9のものそのままなので、このSRFIもそのまま標準に昇格されたSRFIの一つといえるかもしれません。

SRFI-8の紹介

(LISP Library 365参加エントリ)

 SRFI-8は多値の束縛を扱う構文receiveを提供します。R5RSでは多値はcall-with-valuesでのみ規定されています*1。

まずは、call-with-valuesで書いたものを見てみましょう。

(call-with-values (lambda () (values 1 2 3))
  (lambda (a b c) (+ a b c)))
;; => 6

個人的にcall-with-valuesの可読性*2は低いと思っているのですが、receiveを使うと以下のように書けます。

(receive (a b c) (values 1 2 3)
  (+ a b c))
;; => 6

同様の処理が多少見やすく書けます。もちろん好みによりますが。記述量の面で見てもlambdaを書かない分少なくなります。

今回はSRFI-8を紹介しました。

*1:逆にR6RS以降ではlet-values及びlet*-valuesが標準で入ったのでこのSRFIの出番は終わったともいえるかもしれません。
*2:thunkとクロージャの両方を必要とする手続きなので、処理系によっては性能も落ちます。

マクロ展開器

最近R6RS/R7RSのマクロのエッジケースを攻め込むような呟きをTwitterで目にして、ちと本格的になんとかしないとなぁという気持ちに駆り立てられている。Sagittariusのマクロ展開器は(恐らく*1)R6RSが要求しているものに完全には準拠していない。

現状でRacket(多分)、SagittariusとYpsilonを除くR6RS処理系はpsyntaxもしくはAndre van Tonderの展開器を使っていると思われる*2。どちらもR5RSの処理系にR6RSの要求するライブラリとsyntax-caseを追加するものである。一時期、Andre van Tonderの展開器をフロントエンドにしようかなぁと思ったりもしたのだが、自前でライブラリシステムを持っていると非常に相性が悪いので止めた経緯もあったりする。(R5RSでポータブルに作られている性質上、処理系が用意しているモジュールシステムのことは考えず、単一の名前空間上にリネームして全てを定義しているため)

 現状の実装で何が一番問題かと言えば、自分が今一理解していないとい点は除いて、マクロ展開とコンパイルが同時に行われているために展開時もしくはマクロコンパイル時に識別子とシンボルが混在していることだろう。これによって環境を参照する際に余計なことをしていて今一よく分からない状態になっている。二つの処理を一つのパスで行うことに利点もあるのだが、現状だと今一利点を享受できてない上に欠点の方が目立っている感がある。

とりあえず、利点と欠点をまとめて今後の方針を考えることにする。

【現状の方針】
<<利点>>

• オーバーヘッドが少ない(はず)
• syntax-caseは完全に分けて考えられているのでブートコードの生成時に依存が少ない

 <<欠点>>

• マクロ展開の結果が見辛い
• これはIFormからS式に戻すのを作ればいいだけだが
• マクロ展開時に識別子とシンボルが混在する

【マクロ展開フェーズを作る】
<<利点>>

• (うまくやれば)展開後の結果に識別子が減る
• 仕組み上無くせるわけではない
• ある程度マクロ展開が楽になる(はず)

<<欠点>>

• 展開器とコンパイラの二重実装
• オーバーヘッドが大きい(気がする)

どっこいどっこいな気がしないでもないし、展開フェーズを設けたからといって実装が完璧になる補償もない。う～ん、やはり当面は現状の方針でいった方がいい気がするな。

*1 エッジケースなのでこれが仕様の範囲なのか未定義なのかよく分かっていない
*2 Vicare/Ikarus/Iron Schemeはpsyntax、LarcenyはAndre van Tonder、Moshは両方。Guileは知らない。Biwa Schemeはsyntax-caseをサポートしてない。Chezはpsyntaxに近い何かじゃないかな。

SRFI-6の紹介

(LISP Library 365参加エントリ)

SRFI-6は基本的な文字列ポートを定義したものです。Ratinaleには1986年から使われているAPIとかかれているので歴史のあるものをSRFI化したものといえるかもしれません。

このSRFIで提供される機能は2つで、文字列をポートとして扱えるようにするものとポートを文字列バッファとして扱えるようにするものです。では基本的な使い方を見てみましょう。

(import (rnrs) (srfi :6))

;; string input port
(define in (open-input-string "SRFI-6 test :)"))
(get-string-all in)
;; -> "SRFI-6 test :)"

(define out (open-output-string))
(put-string out "Hello")
(get-output-string out)
;; -> "Hello"

(put-string out " SRFI-6!")
(get-output-string out)
;; -> "Hello SRFI-6!"

注意が必要なのはget-output-stringでしょう。この手続きは出力ポートに呼び出し時点までに溜め込まれた文字列を返しますが、溜め込まれた文字列をクリアしません。上記の例のように複数回の呼び出しでも同一の文字列が取得可能です。これはR6RSで既定されているopen-string-output-portが返す第2値とは異なる振る舞いをします。

ちなみに、このSRFIで定義されているAPIは全てそのままR7RSでも定義されているので、SRFIが標準に取り込まれた例の一つといえるかもしれません。

今回はSRFI-6を紹介しました。

偏見

TLCでAll-American Muslimという番組を見たのだが、これをみて自分の中にものすごい偏見があることに気付かされた。宗教的な偏見を持っているのというは自覚してたんだけど、今回発見したのは言語的な部分。

それは、アラビックな人たちが喋る英語は訛っているという偏見。

実はアラビックである必要はなくて、英語以外の言語を母語もしくはバイリンガルとして持っている人の英語は訛っているという感じ。理由はいうまでもないと思うんだけど、一応経験則から。例えばBBCの料理番組に出てくる中国系イギリス人とかインド系イギリス人はほぼ大抵訛っている。それ以外にも、アメリカ映画に出てくるアメリカ人ラビも訛ってるし、そんな感じ。

ちなみに、上記のTV番組はイスラム系アメリカ人生活のドキュメンタリーなんだけど、その中に出てくる典型的なイスラム系の女性がアメリカ英語を普通に喋ってて、なんか微妙な違和感を覚えてしまった。

json-toolsの紹介

(LISP Library 365参加エントリ)

今回は拙作json-toolsの紹介です。json-toolsはR6RSといくつかのSRFIのみで書かれたJSONを扱うためのライブラリです。SSAX及びJSONSelectの影響を受けて作られています。

インストール

R6RSの処理系でSRFI-1、13及び14をサポートしていれば何でもいいのですが、宣伝も兼ねてPegasusを使ってインストールしてみます。最新のHEADではURL指定でもインストール可能になっているので、その機能を使います。

% pegasus install json-install \
  -u https://raw.github.com/ktakashi/json-tools/master/formula/json-select.scm
-- Retrieving: https://github.com/ktakashi/json-tools/archive/master.zip
-- Extracting: json-tools-master/
-- Extracting: json-tools-master/README.md
-- Extracting: json-tools-master/ext/
-- Extracting: json-tools-master/ext/json.scm
-- Extracting: json-tools-master/ext/packrat.scm
-- Extracting: json-tools-master/ext/srfi/
-- Extracting: json-tools-master/ext/srfi/%3a64.sls
-- Extracting: json-tools-master/ext/srfi/%3a64/
-- Extracting: json-tools-master/ext/srfi/%3a64/testing.sls
-- Extracting: json-tools-master/formula/
-- Extracting: json-tools-master/formula/json-select.scm
-- Extracting: json-tools-master/src/
-- Extracting: json-tools-master/src/text/
-- Extracting: json-tools-master/src/text/json/
-- Extracting: json-tools-master/src/text/json/select.scm
-- Extracting: json-tools-master/src/text/json/select/
-- Extracting: json-tools-master/src/text/json/select/parser.scm
-- Extracting: json-tools-master/src/text/json/tools.scm
-- Extracting: json-tools-master/tests/
-- Extracting: json-tools-master/tests/parser.scm
-- Extracting: json-tools-master/tests/select.scm
-- Extracting: json-tools-master/tests/tools.scm
-- Installing: /usr/local/share/sagittarius/sitelib/src
-- Deleting working directory: json-install-HEAD/json-tools-master

インストールできました。他の処理系で使いたい場合は、Githubから直接クローンするかアーカイブをダウンロードするかしてください。

使ってみる

ここではメインであるJSONSelectを紹介します。JSONSelceとはCSSセレクタ風のクエリを用いてJSONから特定のノードを取り出すためのものです。

#!r6rs
(import (rnrs)
        (text json tools) 
        (text json select))

(define json '#(("name" . #(("first" . "Lloyd") ("last" . "Hilaiel")))
                ("favoriteColor" . "yellow")
                ("languagesSpoken"
                 #(("lang" . "Bulgarian") ("level" . "advanced"))
                 #(("lang" . "English")
                   ("level" . "native")
                   ("preferred" . #t))
                 #(("lang" . "Spanish") ("level" . "beginner")))
                ("seatingPreference" "window" "aisle")
                ("drinkPreference" "whiskey" "beer" "wine")
                ("weight" . 156)))

(json:nodeset->list ((json:select ".languagesSpoken") json))
#|
(("languagesSpoken"
  #(("lang" . "Bulgarian") ("level" . "advanced"))
  #(("lang" . "English")
    ("level" . "native")
    ("preferred" . #t))
  #(("lang" . "Spanish") ("level" . "beginner"))))
|#

(json:nodeset->list ((json:select ".languagesSpoken > .level") json))
#|
(("level" . "advanced")
 ("level" . "native")
 ("level" . "beginner"))
|#

json-toolsはChicken Scheme由来のjsonライブラリのJSONオブジェクト表現を使っています。ただ、そのままだと配列と連想配列を区別し辛かったりと不便な点もあるので、APIは渡されたオブジェクトを<json-node>に変換します。また、json-toolsでサポートしていAPIは基本ノードセットと呼ばれるオブジェクトを返します。そのため、実際に取り出されたS式JSONを得るにはjson:nodeset->list手続きを呼び出す必要があります。

さて、ここまで見て「あれ？」と思った方もいるのではないでしょうか？はい、json-toolsではオリジナルのJSONSelectとは多少違う結果を返します。具体的には連想配列のキーと値のペアもノードとしてカウントされるのでオリジナルでは値のみを返すようなクエリでも、ペアの方を返すようになっています。

今回は拙作のjson-toolsを紹介しました。このツールを使えばJOSN表現の直接リストやベクタを操作するということはなくなりそうです。

続々 コンパイラのバグ

いろいろ考えていたら、破壊的に環境を変更するものの今よりもはるかにすっきり書けることに気づいた。(ってか既に書き換えた)っで、次の一手として局所マクロを何とかしてしまおうという話。

とりあえず何をしたか。
問題になっていたのは内部defineとdefine-syntaxそれにlet(rec)-syntaxの3つを解決するために非常にややこしい方法でやっていたのだが、ざくっと以下のように変更した。

• bodyを解決するためにコンパイル時環境を2本用意。
• 初期値は同値
• 内部defineを見つけたらlvarを作って環境に放り込む(まだ値の初期化はしない)
• define-syntaxを見つけたらマクロにコンパイルして環境に放り込む
• let(rec)-syntaxを見つけたらマクロに変更してメタ環境のほうに放り込む

define-syntaxの解決がちとまずくて、相互参照があったり定義位置が下にあるものを上にあるものが参照していたりすると、マクロコンパイル時に展開してくれない。まぁ、マクロ展開時に普通に展開するだけなので今のところ特に問題にはしていない。

これは第一段階の変更として施したもので、処理の単純化と次への準備である。

次の一手として以下のことを考えている

• let(rec)-syntaxを見つけたらメタ環境を利用してbody部分を展開もしくは内部表現まで落とし込む
• その途中で見つけた内部define及びdefine-syntaxは位置が正しければもう一本の環境に破壊的に追加する
• 最終的に展開もしくは内部表現まで落としたものをマージする

問題になっているのはlet(rec)-syntaxで作られる仮想スコープが範囲を超えて参照可能になっているのがまずいのだからそれを何とかしてやろうという話。あまりひどいコードにするとメンテが大変なので(大変だった・・・)、綺麗に書いておきたいところ。

続 コンパイラのバグ

一つ前の投稿でコンパイラのバグについて書いた。週末を利用して先に展開するのを試してみたのだが見事に穴にはまったので記録しておく。

問題になったのは、マクロの展開とコンパイラの環境が密な関係にあることである。マクロ展開時にはコンパイラが集めた環境フレームを利用しているのだが、局所マクロを先に展開してしまうとそれを当てにした変数参照が動かなくなる。端的なコードしては以下のものがだめになる。

(define (bar)
  (let-syntax ((foo (syntax-rules () ((_ b) (when (< b 10) (bar))))))
    (define (buz b) (foo b))
    (buz 10)))

これが展開後には以下のようになる。

(define (bar)
  (define (buz b) (when (< #<id b> 10) (bar)))
  (buz 10))

問題になるのは識別子#<id b>で現在のマクロ展開器ならば識別子が持つ環境フレームに変数bが入って変数参照手続きがたどれるようになっている。しかし、ナイーブな実装で先にマクロだけを展開してしまうと生成された識別子は局所変数の参照を持たないフレームを持つことになり変数参照がうまくいかない。

これを解決するとすれば以下の2通りだろう。

1. 識別子が持つフレームが参照する変数を含んでいない場合には共有している環境以前のみを探してみつける
2. マクロ展開器が変数束縛を検知する

1は無駄に複雑になるだけなのでやるつもりはない。複雑なコードは理解を阻害しバグを混入させるだけなのだ。(既に複雑怪奇になっていて自分でも全てのパターンを列挙できないようになっている・・・orz)
2は環境フレームの同値性に頼っているコードが山ほどあるので事実上不可能。やれなくはないが、複雑怪奇に(ry
となるとこの方向性で解決するには、全てのマクロをあらかじめ展開してしまうというR6RSが要求している方針を採らざるを得なくなる。マクロの展開とコンパイルを同時にやるというのは不可能ではない(はずな)のだが、現状のコンパイラは中間表現にGauche由来のIFormを使っているためS式との混在がきつい。

となるともう一つの方法である現状のコードを拡張する方向だが、これはこれでまたバグの温床になりそうな雰囲気が既に漂っているのでうれしくない。ちょっと方針に以下の項目も入れる方向で検討することにする。

• IFormを捨てる
• 大幅なコンパイラの変更が必要
• マクロ展開フェーズを設ける
• 重複コードをどうするか？

場当たり的な対応ではバグを埋め込むだけなので根本から解決する必要がありそうではある。

コンパイラのバグ

マクロのバグを直していて以下のようなコンパイラのバグにぶち当たった。

(let ()
  (letrec-syntax ((a (syntax-rules () ((_) 'foo)))))
  (print (a)))
;; -> prints 'foo

火を見るよりも明らかなバグである。なぜこんな挙動になるかといえば、let(rec)-syntaxはマクロ展開後にbeginになるというのに起因している。Sagittariusではマクロ展開フェーズを内部的に持っていないので、コンパイラがマクロを見つけると展開するという仕組みになっている。そして、それを実現するためにlet(rec)-syntaxで束縛されたマクロはコンパイル時環境を破壊的に拡張するという方法をとっている。これが問題なのだ。

上記の場合コンパイル時環境は以下のように推移する

(let () ...)         ;; (()) empty
(letrec-syntax ...)  ;; ((a . <macro>)) *1
(print (a))          ;; ((a . <macro>)) *2

本来であれば*1で足されたマクロは*2の段階では見えなくなっていなければならないが、そんなこともないのが問題になっている。解決方法はいくつかあると思っていて、ぱっと思いつくだけで以下のものがある。

1.  let(rec)-syntaxで束縛したマクロを先に展開してしまう
2. define-syntaxのみを特別視してlet(rec)-syntaxでは破壊的に環境を変更しないようにする

1は効率がかなり落ち、2はかなりトリッキーなコードになるとどちらも一長一短である。ただ、2は現状の延長線上にあるので実装としては楽かもしれない。

読書感想文(All You Need Is Kill)

となりのヤングジャンプとヤングジャンプで連載されてる漫画の原作。漫画読んで原作を読みたくなったのはかなり久しぶりである。５月に日本に帰るのでそのときに買えばよかったような気もするが、はやる気持ちは１年前にもらったギフトカードを使ってAmazon.deでの英語版の購入を後押しした形になる。

核心には触れない形で書くつもりだが、うっかりネタ晴らししてしまっていてもご容赦いただきたい。

とりあえず読んだ感想としては買って損はなかったになる。 日本なら書籍でも600円で買えるのだが、英語版は€10とほぼ2倍の値段である。日本で買える環境にあるなら日本語版をお勧めする。英語の勉強用？多分やめた方がいい。Yonabaruの会話文がえらく訛っているし、そこそこ難しい単語(1ページに1は知らん単語があった)が出てくるので楽しめないと思う。ただ、訳者がよかったのか、元がいいのか、はたまた両方なのかは分からないが個人的には読みやすかったという印象ではある。多分、SiFi系の小説にありがちなこてこての背景説明が少なかったというのもあるのだろう。


Wikipediaのページにある登場人物の項目でShastaがでかでかと載っているのだが、出番は少なめ。眼鏡オタク娘好きにはものたりないかもしれない。ShastaよりYonabaruの方がよっぽど登場回数多いのに載っていないのは何故だ？

Rita Vrataskiという名前からロシア系なのかなと勝手に思っていたのだが実はアメリカ、イリノイ州出身という。Ritaって名前にアメリカ人という印象がないのでいろいろやられた感はある。このページによると0.204%程度らしいのでそもそも珍しいのだろう。読み飛ばしたのかもしれないのだが、Ritaの本当の苗字ってなんだったんだろう？

ギタイ(Mimic)の命名由来も出てこなかった気がする。作中では膨らんだ蛙(bloated frog)と表現されていたが、漫画版ではそんな風には見えない。彼らが人間と戦争している理由に関しては、個人的にだが、ちょっとチープな感じがした。SiFiなのでまぁありなんだろうけど、唐突だなぁ感が拭えなかった。

今年の6月に映画がでる。題はEdge of Tomorrow。なぜ変えたし？Tom CruiseがKiriya Keiji役(役名William "Bill" Cage) なのだがどう見ても20台前半の新兵に見えない件。Rita Vrataski役のEmily Bluntもどう見ても22歳(実際には多分2つか3つ若い設定)に見えない件。原作は舞台日本で主人公日本人なんだけど、そこはアメリカ映画(Warner Brosってハリウッド？)、全部アメリカになってる。Trailer見ると面白そうではあるので見に行くかもしれない。

あまり書くとネタ晴らししそうなのでこれくらいにしておく。

R6RSのマクロ展開フェーズ

日本語で解説してる記事があまりにも少ないのと、これを毛嫌いしてる人が多いので何か書いてみる。随分前にチラッと書いてたりするが、単なる調査用の記事だったのである程度まじめに解説する。英語だとこれが詳しい。

はじめに、なぜフェーズなどというものが必要か？
R6RSでは低レベルマクロであるsyntax-caseがある。これはdefine-syntax内で内部定義を可能にする。マクロとはコンパイラがコンパイル時に(もしくはそれ以前)に定義に従って式を別の式に展開するのだが、以下のようにマクロ定義内に別のマクロ定義があるとそのマクロは何時展開するのかということが問題になる。

#!r6rs
(import (for (rnrs) run expand))

(define-syntax foo
  (lambda (x)
    (define-syntax bar
      (syntax-rules ()
        ((_) #''foofoo)))
    (syntax-case x ()
      ((_)
       (with-syntax ((name (bar)))
         #'name)))))
(foo) ;; -> foofoo

これを解決するのがフェーズというわけである。マクロbarはマクロfooが展開される前に展開される必要がある。ではbar内で使われているsyntax-rules等の名前を解決する必要がある。フェーズとはその名前解決が行われる段階を明示的に指定したものと思えばよい。runとexpandが名前つきで提供されているが、これらは(meta 0)と(meta 1)の別名である。

フェーズとはマクロ内マクロで使われるものである
間違いを恐れずに言い切ってしまえば、フェーズとは上記の場合にのみ考慮に入れる必要があるものだ。もちろん他のライブラリで定義されたマクロもこれに含まれる。

メタレベルの必要性
R6RSのマクロフェーズにはメタレベルなるものがある。デフォルトのrunとexpandで足りない場合はユーザが(meta 2)等適当に指定することができる。 これは本当に必要なのか？結論を言えば必要である。メタレベルはマクロ内マクロが多段になると必要になる。以下のコードがそうだ。

#!r6rs
(import (for (rnrs) run expand (meta 2)))

(define-syntax meta0
  (lambda (x)
    (define-syntax meta1
      (lambda (x)
        (define-syntax meta2
          (lambda (x)
            (syntax-case x ()
              ((_) #'(generate-temporaries '(a))))))
        (syntax-case x ()
          ((_) 
           (with-syntax (((name) (meta2)))
             #'#'name)))))
    (define (gen-name) (meta1))
    (syntax-case x ()
      ((_)
       (with-syntax ((name (gen-name)))
         #'(display 'name))))))


(meta0) ;; -> prints temporary symbol

見た目に分かりやすいようにマクロの名前は各メタレベルにしてある。こんなコード書くやついねぇよ！と思うかもしれないが、例示できるコードレベルで出るということは必ず誰かは使うということである。明示的か暗黙的にかは別にしてもだ。

R7RSではどうなるか？
R7RSもlargeではexplicit renamingが取り込まれる方向に進むと思われるのだが、まだ議論すら始まっていない状態なのでなんとも言えない。ただ、フェーズは毛嫌いしてる人が多い(自分含む、要出展)のとR7RSが提供するdefine-libraryにはフェーズ指定をするキーワードは提供されていないので、暗黙の内に解決する方向に行くのではないかと思っている。

SRFI-5の紹介

(LISP Library 365参加エントリ)

SRFI-5はletの拡張SRFIです。正直使ったことない上に、Sagittariusでは0.5.2になって(ほぼこの紹介記事を書くためだけに)サポートされたものだったりします。なので、ちょっと触ってみたレベルで紹介記事を書きます。

このSRFIは既存のlet、特に名前つきletの拡張を行います。具体的には新しいフォームとオプショナル引数を受け付けるようになります。具体的には名前付きletが以下のよう

(import (srfi :5))

(let (loop (i 0))
  (when (< i 10)
    (display i) (newline)
    (loop (+ i 1))))

loopの位置が束縛の先頭にはいるという感じです。(正直、僕にはエディタの恩恵が受けづらくなるだけに見えるのですが・・・)

オプショナル引数は以下のようにして受け取ります。

(import (srfi :5))

(let (loop (x 0) (y 1) . (z 2 3 4))
  (if (list? x) 
      (list x y z)
      (loop z x y)))

オプショナル引数は複数個の値がリストにパックされます。また通常のletフォームもサポートされるので、通常の名前付きlet+オプショナル引数という感じでも書くことができます。

実際にどういう仕組みで動いているかというのは、マクロの展開形を見ると分かります。

((letrec ((loop (lambda (x y . z) 
                  (if (list? x) 
                      (list x y z) 
                      (loop z x y))))) 
   loop) 0 1 2 3 4)

納得の展開結果ではないでしょうか？

とりあえず触った感想なのですが、名前付きletにオプショナル引数がほしいという場合は使えるのではないでしょうか。個人的にはそういったケースは非常に少ない(もしくはない)ので多少適当な紹介になってしまった感があります。

Sagittarius Scheme 0.5.1リリース

Sagittarius Scheme 0.5.1がリリースされました。今回のリリースはメンテナンスリリースです。

修正された不具合

• マクロの可視性に関する不具合が修正されました
• datum->syntaxによって生成されたシンボルが非可視になる不具合が修正されました
• いくつかのポートに対する手続きに閉じたポートを与えるとSEGVは発生する不具合が修正されました
• 不正なdefineが例外を挙げない不具合が修正されました
• (tlv)ライブラリで長さのエンコーディングに対する不具合が修正されました
• コンパイラにcircular listを渡すと無限ループに陥る不具合が修正されました
• formatにカスタム文字ポートを渡すとSEGVが発生する不具合が修正されました

新たに追加された機能

• R7RSスタイルのSRFIライブラリがサポートされました。例：(srfi 1)
• SRFI-5が追加されました
• 局所メソッドフォームlet-methodが追加されました
• R6RSのレコードが組込みCLOSに統合されました

改善点

• quasiquoteが可能であれば定数を生成するようになりました
• コンパイラが可能であればコンパイル時に手続きの呼び出しをするようになりました

新たにサポートされた環境

• OpenBSDでのビルドが可能になりました

Introduction of JSON tools for Scheme

I'm writing a library which can query JSON. It's still under development state but a bit of sample code wouldn't hurt so let me introduce it.

The repository is here, json-tools and handling JSON structure must be one of the Chicken Scheme egg's library json format. (I've ported it for R6RS Scheme implementations, it's in the repository as well.)

The library consists 2 parts one is JSON tools and the other one is JSON query which is based on the JSONSelect.

JSON Tools

This part of the library is highly inspired by SXPath. There are bunch of basic selectors which can be used by querying libraries. Following piece of code describe the flavour of this part.

(import (rnrs) (text json tools))

(define json '#(("name" . #(("first" . "Lloyd") ("last" . "Hilaiel")))
                ("favoriteColor" . "yellow")
                ("languagesSpoken"
                 #(("lang" . "Bulgarian") ("level" . "advanced"))
                 #(("lang" . "English")
                   ("level" . "native")
                   ("preferred" . #t))
                 #(("lang" . "Spanish") ("level" . "beginner")))
                ("seatingPreference" "window" "aisle")
                ("drinkPreference" "whiskey" "beer" "wine")
                ("weight" . 156)))

((json:filter (lambda (node)
  ;; The given node can be other type and
  ;; this piece of code may raise an error
  ;; but for above structure this works :)
  (equal? "name" (json:map-entry-key node))))
 (json:child-nodes json))
;; -> <json:nodeset>

All JSON selectors return JSON nodeset type which contains sets of JSON node. Followings are the JSON node types;

• JSON map
• JSON map entry
• JSON array
• JSON string
• JSON number
• JSON boolean
• JSON null

All types are sub type of JSON node. The reason why I introduced them is that there was no way to tell the difference between array and map entry which contains array. To avoid ambiguous results, I needed to do it.

To retrieve the result set as S-expression, you can simply call the `json:nodeset->list` procedure like this;

(json:nodeset->list ((json:filter (lambda (node)
                                    (equal? "name" (json:map-entry-key node))))
                     (json:child-nodes json1)))
;; --> (("name" . #(("first" . "Lloyd") ("last" . "Hilaiel"))))

Not sure if the procedure name is proper. (I also though `json:nodeset->sexp`.) To casual use, `json:filter`, `json:child-nodes`, `json:child-nodes-as-list`, `json:child` or `json:child-as-list` are easy to use. The rest of selectors are a bit tricky.

JSON Select

This part of the library is for usability. You can use query language to select  particular nodes from JSON. The example use is like this;

(import (text json select))

;; use the same JSON structure defined above
((json:select ".languagesSpoken") json)
;; --> <json:nodeset>

(json:nodeset->list ((json:select ".languagesSpoken") json))
;; --> '(("languagesSpoken"
;;        #(("lang" . "Bulgarian") ("level" . "advanced"))
;;        #(("lang" . "English")
;;          ("level" . "native")
;;          ("preferred" . #t))
;;        #(("lang" . "Spanish") ("level" . "beginner"))))

The returning value is JSON nodeset the same as tools. So again to retrieve the S-exp result, you need to call the procedure `json:nodeset->list`. Currently, not all query language are implemented but it would be a matter of time.

As I mentioned before, the state is still under development so your opinions or testing results are very welcome :) Of course, your pull requests are much appreciated :)

Integrated R6RS record to CLOS

I have made a sort of huge change for Sagittarius in these couple of days and that is now R6RS record can be used with generic functions. So let me show what's the exact change for this.

Sagittarius had 2 type systems, one is CLOS and other one is R6RS record and these didn't have any compatibility. So following code were invalid.

(import (rnrs) (clos user))
(define-record-type (pare kons pare?)
  (fields (mutable x kar set-kar!)
          (immutable y kdr)))

(define-method write-object ((p pare) out) 
  (format out "#<pare ~s:~s>" (kar p) (kdr p)))

(print (kons 1 2))

This was because R6RS record didn't create CLOS class but own record type. I was thinking this is very inconvenient and made me not to use R6RS record. So I have made the change and now above code works as I expect.

Followings are what I've changed internally so may not be so interesting.

[Slot ordering and shadowing]
I needed to change computed slot order of a class from subclass slots followed by super-class slots to super-class slots followed by subclass slots. And to make R6RS record spec satisfied, made not to shadow any duplicated slots. Following code describes a lot;

(import (rnrs) (clos user) (clos core))

(define-class <a> () (a b))
(define-class <b> (<a>) (c d))
(define-class <c> (<a>) (a c d))

(print (class-slots <b>))
;; ((c) (d) (a) (b)) : 0.5.0 or before
;; ((a) (b) (c) (d)) : current

(print (class-slots <c>))
;; ((a) (c) (d) (b))     : 0.5.0 or before
;; ((a) (b) (a) (c) (d)) :current

So basically no eliminating slots and different order. Then I had immediately noticed the problem that this breaks slot accessing. For example, refering <c>'s slot 'a' may return <b>'s 'a' slot value. The solution was very easy. The bottom most class's slots need to be shown first this means searching reverse order was sufficient.

The benefit of this change is big. Accessing slot with class is now always returns proper position of slot. Slot accessor contains index of the slot position and the change made this position always the same no matter how many you extend classes. For above example, position of class <a>'s slot 'a' is always 0 and before this wasn't always 0 (obviously...). Additionally, slot accessor also contains the class information that indicates on which class it's defined.

[Defining procedual layer in Scheme]
I have made a small footprint for this integration with CLOS. And based on this code, I've implemented procedural layer in Scheme world so that those ugly C code for record could be removed.

The Scheme implementation creates a CLOS class per record type descriptor(RTD) and set it to RTD and visa versa. This could save me from a lot of troubles such as refering record constructor descriptor (RCD) from record type. (I think there is a better solution but I was lazy.) There is a small problem with current Scheme code, that is it is impossible to create more than 1 record constructor descriptor from one record type descriptor. I may fix this if it will be a problem but highly doubt it.

[Record type meta class]
To distinguish between normal CLOS instance and record instance, I needed to create an additional meta class for it. However, it was pain in the ass to create meta class in C level so I decided to extend current class structure to have RTD and RCD fields and not to show the slot in but . This makes memory efficiency slightly bad (2 words) but I don't think it's a big deal.

SRFI-4の紹介

(LISP Library 365参加エントリ)

SRFI-4はSchemeで整数データ、及び浮動小数点専用ベクタを扱うSRFIです。 用意されているデータ型としては、u8、s8、u16、s16、u32、s32、u64、s64、f32及びf64です。最後二つ以外は数値の整数ビット＋符号を表し、f32とf64は浮動小数点数のビット数を表します。

それぞれのデータ型に対して以下の処理が定義されています。(SRFIに習ってデータ型をTAGと表示しています。)

• (TAGvector? o)
• (make-TAGvector n [ TAGvalue ])
• (TAGvector TAGvalue ...)
• (TAGvector-length TAGvect)
• (TAGvector-ref TAGvect i)
• (TAGvector-set! TAGvect i TAGvalue)
• (TAGvector->list TAGvect)
• (list->TAGvector TAGlist)

また、それぞれのデータ型に対してのリーダマクロも定義されています。

具体的な使用例を見てみましょう。動作確認処理系はSagittarius 0.5.0です。

#!read-macro=srfi/:4
(import (srfi :4))

(define s8 #s8(0 -1 2 -3 4))

(s8vector-ref s8 1)           ;; => -1
(s8vector-set! s8 0 5)        ;; => unspecified
(list->s8vector '(1 2 3 4 5)) ;; => #s8(1 2 3 4 5)
(s8vector->list s8)           ;; => #s8(5 -1 2 -3 4)

R6RS以降バイトベクタが基本データ型に入ったのでこのSRFIの存在意義が薄れた感はありますが、R5RSで書かれたスクリプト等に使われている場合があるので知っておいても損はないかと思います。

こんなSRFIないの？的なリクエストをお待ちしてます。(順番どおりにやると使用頻度低めのSRFIが続くのでｗ)

マクロのバグを非常にひどい方法で解決したのでメモ

どこかにメモしておかないと忘れるｗ

一つ前の記事でaifのitがマクロにくるまれるとうまく参照できないというバグの話をしたが、一応直したのでメモ(というか、FIXME的な何か・・・)。

どうしたか。
問題はマクロ展開時に生成される識別子の環境が不十分なために参照する際に大雑把にしか(というと語弊があるが)識別ができなかったこと。ただ根本を解決せず搦め手で直してしまった。
このit識別子を参照可能にすると、syntax-rules内でネストした識別子の誤参照が置き、不可能にすると、まぁitが見えないという状況に置かれたので、とりあえずコンパイル時環境に何が入っていて何を見つけないといけないかを大まかに見てみたら、参照可能にした場合は同一の識別子が後ろにあるにもかかわらず一つ二つ前のものを誤参照していた。そこで、一度全部環境を舐めてから見つからなかった場合にそれっぽいものを返すという荒業を使うことにしている。もちろんバグの匂いしかしないｗ

根本的には全く解決されていないので、正しくは環境(恐らく)テンプレート変数のコピーをする際にオリジナルの環境をそのまま使うのではなく、何かしらマークを入れてやり識別可能にするという方法を取るべきなのだろう。ただ、何をどうすればいいのかさっぱり分かっていないので、どうしたものかという感じ。

Schemeのマクロにおける変数参照についてのメモ

自分の考えをまとめるためのメモ。主にSagittariusでの実装の話。

Schemeは変数のシャドウイングがある。そのためコンパイラが適切に変数を参照するためにはそれがどこで束縛されたかを知っている必要がある。これだけなら環境はスタックのように束縛された変数を持っておき、上から順に探索すればいいだけなのだが、問題になるのはhygenic macroで束縛された変数(便宜上テンプレート変数と呼ぶ)である。

例えば以下のケース

(define-syntax test
  (syntax-rules ()
    ((_ a b)
     (let ((a a))
       (+ a b)))))
(let ((a 1) (b 2)) (test b a))

というのは、3を返す必要がある。(今一いい例ではないかもしれないが)上記の例ではaがテンプレート変数ということになる。Sagittariusではテンプレート変数は基本的にリネームされ、実際に渡される式とは別の扱いになっている。リネームの再に現在のマクロ環境が用いられてリネームされるので生成される識別子aはこの場合は空の環境を持ったものになる。(実際にはマクロであることを識別するためのマークと定義されたライブラリの情報が入る)

この辺りまでならまだ混乱は少ないのだがR6RSにはdatum->syntaxがある。これが頭の痛い問題で、syntax-rulesでは不可能な「識別子が定義される環境を任意の場所に指定する」ことができる。例えば、CLで有名なaifは以下のようになる。

(define-syntax aif
  (lambda (x)
    (syntax-case x ()
      ((aif expr then else)
       (with-syntax ((it (datum->syntax #'aif 'it)))
         #'(let ((it expr))
             (if it then else)))))))
(aif (car '(a)) it #f) ;; => a

上記の例ではitはマクロaifが定義された環境(つまり空)を持つ識別子となる。そうすることでaif式内で参照されるitはあたかもグローバルに束縛された変数を参照するような挙動をする。しかし、現状の実装では以下のような場合に上手く動かない。

(define-syntax wrap
  (syntax-rules ()
    ((_)
     (aif 'ok it #f))))
(wrap) ;;=> should return ok but raises an error

一段マクロをかますことで、itがテンプレート変数に変更され環境が変わるからである。本来であればitは大域で定義された変数と同様な動きをするべきだが、そうなっていない。(wrapが局所で定義されたらどうするんだという話もあるがとりあえず放置・・・)

細かいケースを上げたらきりがないのだが、本題としてはどの場合にどの識別子を同一のものとみなすかということである。例えば同じ環境を保持しているのか、コンパイラ環境に格納された変数が、ターゲットの変数と環境を共有していればいいのか、とかそんな感じである。現状の実装ではマクロの定義時と展開時にリネームが走るのだが、その部分もおそらく見直す必要がある。余計な情報を付加しているか、または逆に情報の欠落が起きている可能性があり変数参照時に正しく参照できていないからである。

マクロのバグを踏むたびに既存の展開器を使っておけばよかったなぁと思ったりもするが、それだと面白くないというのもあったりで複雑な気分である。

SRFI-2の紹介

(LISP Library 365参加エントリ)

SRFI-2はand-let*と呼ばれるマクロを提供する。例えば以下のようなコードを書いたことはないだろうか？

;; make upcase symbol of car part if it's symbol
(and (pair? o)
     (let ((a (car o)))
       (and (symbol? a)
         (let ((s (symbol->string a)))
           (cons (string->symbol (string-upcase s)) (cdr o))))))

andとletがネストして非常に読みにくい素敵コードだ。こんな不快深い階層のネストを解消してくれる構文がand-let*である。これを使うと上記のようなコードは以下のようにすっきりと書ける。

(and-let* (( (pair? o))
           (a (car o))
           ( (symbol? a) )
           (s (symbol->string a)))
  (cons (string->symbol (string-upcase s)) (cdr o)))

あまり変わらない？それはあなたの心が澱んでいる可能性が高いのでリフレッシュさせることをお勧めする。

オリジナルの実装はdefine-macroで作られているのでCLに移植するのも難しくないはずだ。実際既に作られている。

風車の中

ライデンにはオランダ最古(だったはず)の風車があるのだが、長年外から眺めるだけで中に入ったことはなかった。先日偶然にも開いていたので(もちろん有料だけど)、せっかくだと思い中に入ってみた。

とりあえず、写真

展望台(？)から臨むライデンの街並み(一眼レフとかだともう少しワイドに取れて様になった気はするが気にしないｗ)

展望台から取った風車部分。

今は使われていない粉引き(？)

その２

信じられるか？これ風車の中なんだぜ？

立派なもんだろう？

正直自分のアパートよりはるかに豪華で泣けるｗ

 さすがにキッチンは時代を感じさせる。

ちなみに、風車自体は1802年に建築されたものらしいく、結構オーナーが転々と(多分子孫だと思うけど)していた。内装はおそらく当時、もしくは最終所有者が手放した状態のままだと思われる。まぁ、さすがに電気と水道は近年のものだと思うけど。写真は一階部分の居住区で２階以降は博物館になっていた。まぁ、これ自体が博物館みたいなものだが。

大人４ユーロと多少高めな入場料ではあったが、割と満足できると思う。機会があればぜひその目で確かめてほしい。

Sagittarius Scheme 0.5.0 リリース

今回のリリースはマイナーバージョンアップデートリリースです。また、リポジトリ及びダウンロードの場所が変更されたので注意して下さい。ダウンロード

修正された不具合

• importがcond-expand内でR7RSが要求するように動かなかった不具合が修正されました
• Linux上でプロセスを継続的に起動するとクラッシュする不具合が修正されました

新たに追加された機能

• change-classが追加されました

改善点

• ライブラリファイルの拡張子を追加する-Sオプションが追加されました
• クラスがdirect-subclassesスロットを持つようになりました
• R7RSスタイルのSRFIライブラリ名がサポートされました
• コンパイラがいくつかの参照透過かつ末尾位置にない式を削除するようになりました

内部的な変更

• 完全なセルフホスティングになりました

よろしいならば戦争だ(マクロ編)

もう何度目の戦だか覚えてもいない。

CLOS周りで微妙なkludgeを使っているのが嫌になって、えいやっと書き換えてやれと思ったらバグを発見したという話。

再現コードとしては以下のようなの。

(import (rnrs))

(define-syntax aif
  (lambda (x)
    (syntax-case x ()
      ((aif expr then else)
       (with-syntax ((it (datum->syntax #'aif 'it)))
  #'(let ((it expr))
      (if it then else)))))))
(define-syntax wrap
  (syntax-rules ()
    ((_)
     (aif 'ok it #f))))


(wrap) ;; => error

(wrap)はokを返さないといけないんだけど、itがないって怒る。まぁ、原因も実は分かっていて、wrap内でitはテンプレート変数に変換されるんだけど、これに変換されるとコンパイラがうまいこと局所変数を参照できないという問題だったりする。

正直現在の実装は中身がぐちゃぐちゃになりすぎてて、何をやっているのかがコメントと記憶を頼りにするしかないのだが、このパターンは単純にもれている気がする。ただ、どうすればいいのかというのが今一分かっていない。例えば、上記の場合ならコンパイラが参照する環境に含まれる局所変数は識別子になっているので、識別子＋テンプレート変数の組み合わせを参照する際に何かすればいいような気がするが、これが何かを壊すのではないかという不安もあって、う～んといった感じである。

まぁ、一つ分かっているのは、これは多分明日のリリースには間に合わないということかｗ

日本語 vs English

先日一年ぶりくらいに日本語を話す機会があったのだが、その際に不思議な感覚を覚えたので書いて見る。はっきり言って個人の日記レベルである(ちょっと前にTwitterで流行ってたので使ってみるｗ)

不思議な感覚というのは、日本語を喋っているときに英単語を言おうとするとカタカナ発音に敢えて変換していたこと。敢えてというのは、無意識にカタカナの発音を検索してから発音していたという感じ。検索してること自体はなんか意識下にあったんだけど、検索する作業が無意識に発生していた。これ、逆のパターンのときの実はあって、英語話してるときに日本語の単語を言えといわれるとなんか片言みたいな発音になっていたりする。

言語別のコンテキストがはっきりと分かれてきたのかなぁと思わなくもない。が、そう入っても普段の頭の中は基本日本語だし、スイッチ入れ替えるのも特にストレス感じることなく行えるので、わざわざ検索しているという感覚がなんとなく奇妙で不思議だったりしたわけだ。

言語別のコンテキストといえば、混ぜるな危険ではないが、英語話してるときに日本語で考えていないし、逆も(というか逆はある意味当たり前だが)然りな感じである。その昔、後天的バイリンガル(という言葉が正しいかは知らない)は母語が複数ある人と比べると同じ言語でも使っている脳の位置が違うなんてのをテレビか雑誌で見た記憶があって、なんとなくそんな感じになってきたのかなぁと思ったりもした。

特にオチもなく終了。こういう現象に名前付いてないのかね？

SRFI-1の紹介

(LISP Library 365参加エントリ)

SRFI-1の紹介。このSRFIを使ってないSchemerはいないんじゃないかなぁと思われるくらい有名なSRFI。内容は便利なリスト操作手続きをまとめたもの。

今回は、便利だけどあまり日の目を見ない手続きに焦点を当てて紹介する。題はSRFIの目次に対応している。

Constructors

list-tabulate
iotaを知っている人は多いと思うが、list-tabulateも同様にリストを構築する手続き。以下のように使える。

(list-tabulate 5 values) ;; => (0 1 2 3 4)

第一引数にリストの要素数を受け取り、第二引数にリストのn番目の要素を構築する手続きを受け取る。上記の例だとiotaの方が短い記述でかけるが、数値以外の要素を作りたい場合には便利になる。

Miscellaneous

append-reverse
append-reverse!
見れば分かるような気がするが、(append (reverse lis) tail)のシノニム。後者reverse!を使うので、注意が必要。

(append-reverse (list 1 2 3) 4) ;; => (3 2 1 . 4)

Fold, unfold & map

append-map
append-map!
append-reverseと似たようなのだが、(apply append (map f lis1 ...))をするもの。リスト内リストを操作しつつフラットにするのに便利。

(append-map values '((1) (2) (3))) ;; => (1 2 3)

filter-map
(filter values (map f lis ...))をするもの。fが#fを返すような場合に返されるリスト内から#fを取り除く。

(filter-map (lambda (n) (and (number? n) n)) '(1 a 2 b 3 c)) ;; => (1 2 3)

注意が必要なのは、fの戻り値がリストの要素になるということ、なので以下のようなものは悲しい結果になる。

(filter-map even? '(1 2 3 4 5 6)) ;; => (#t #t #t)

Deletion

delete-duplicates
delete-duplicates!
リスト内から重複するリストを削除する。

(delete-duplicates '(a a b b c c)) ;; => (a b c)
(delete-duplicates '((a b) (c d) (a b) (e f) (c d)) equal?) ;; => ((a b) (c d) (e f))

ここに列挙したのは僕が便利だと思うものだけである。他にも便利そうな手続きがあるので気になったら眺めて使ってみるといいかもしれない。

SBCLのPCLを読む

クラス再定義を実装するべPCLを参考にすることにした。ので、真面目に全部を読むわけではなく、defclassから下に続く処理を読むだけ。また、断定系で書いてあるけど、動作確認までしてるわけではないので、全ての断定系には「と思う」を付与して読むこと。上から順番に何をしているか書いてるので、読み終わるころにはPCLのdefclassが何をしているのか分かる(と思う、補足して読むことｗ)。

defclass
単なるマクロ。一応defstructで定義されたものも裁けるようになってるらしい。展開後はload-defclassを呼ぶ式になる。

load-defclass
defclassは単なるマクロなので、マクロ内で何かをするか、展開結果がクラスを作ることは容易に想像できると思う。じゃあ、その下請けの関数は何か？という話。
2種類あって、単にコンパイラに知らせる用のものと、実際にensure-classを呼ぶreal-load-defclassがある。PCLをブートする再には前者を使って、ブート後は後者を使う。

ensure-class
ロックをかけて渡されたクラスの名前からクラスを検索、ensure-class-using-classを呼ぶ

ensure-class-using-class
メソッド。ensure-classでクラスが見つかった場合と見つからなかった場合の2種類が定義されている。
前者はfrob-ensure-class-argsを呼んで見つかったメタクラスが再定義されるクラスを同じならchange-classを呼ぶ、違えば呼ばない。その後、reinitialize-instanceを呼んでインスタンスを更新する。メタクラスが違った場合はどうなるんだろう？
後者は単に普通の定義。(以下では言及されない)

change-class
メソッド。いくつか定義されてるけど、基本的にはCPLを調べて変更可能かのチェックをしたのち%change-classを呼ぶだけ。

%change-class
古いインスタンスと新しいインスタンス、このケースでは元クラスと新クラス、を受け取ってメモリ割付、スロットとメタクラスの交換をした後、update-instance-for-different-classを呼ぶ。

update-instance-for-different-class
基本的には何もせずshared-initializeに処理を委譲

shared-initialize
メソッド。プライマリのメソッドは一個なんだけど、クラス用に:beforeと:afterが定義されてる。(それ以外にもあるが。) 中身は後で読む。っが、見た感じ、クラスのスロットを詰めてるだけに見える。まぁ、initializeからも呼ばれるメソッドなので、ある意味当たり前か。

reinitialize-instance
メソッド。 プライマリはcheck-initargs-1呼んで何かしらチェックした後、shared-initializeを呼ぶ。
クラス用の:beforeではダイレクトサブクラスを除去したのちスロットの除去をしてる。
:afterではmap-dependentにupdate-dependentを呼ぶ手続きを渡している。何するかは今一不明。多分依存関係の解決。

基本的にはほぼ全ての手続きがメソッドなので、頑張ればいろいろ手を加えられそう。Sagittariusに組み込む場合ここまでは要らないので、下請け手続きは単なるlambdaにする気がする。

Scheme処理系の選び方

世の中に星の数ほどSchemeの処理系はあれど、その選び方についてはあまり言及されていない気がするので、目的、環境別くらいの処理系の選び方を書いてみようと思う。僕の知っている処理系の話になるのでかなり限定されたものになることには目をつぶってほしい。また、基本リリースされているバージョンについてのみ言及なので、この処理系の開発版はサポートしているというのは割愛されている可能性があることにも注意してほしい。さらには、少なくともRnRS(R5RS以降)に準拠している処理系のみの言及であることも留意してほしい。

目的別

【SICP用】

 どれでもいいｗ 環境別辺りを参照して適当に選んでｗ

【R7RS準拠の処理系を使いたい】

現状でChibi SchemeとSagittariusのみがほぼ完全にサポートしている。
うわさに寄るとChicken Schemeもサポートしているらしいのだが、最新バージョン(4.8.0.5)ではされていなかった。
Gaucheは0.9.4でサポートされる予定。
Kawaが意欲的にサポートしているらしい。

【R6RS準拠の処理系を使いたい】

この辺参照。ただし、Biwa SchemeはR6RSのサポートが弱いので(syntax-caseとか)注意が必要。

【とにかく高速な処理系】

Vicare、Larcenyが機械語にコンパイルする(はず、未使用、未確認)
(ただし、VicareはLinuxじゃないと処理系自体がインストールできない)
RacketはJITがあるので特定の環境(x86等)では高速
ChickenはCへのトランスレータがあるのでCコンパイラの最適化による
Chezも商用版は機械語にコンパイルするらしい

LarcenyはCへのトランスレータもあるらしい

【FFIが使える処理系】

Chez、Chicken、Racket、Vicare、Mosh、Ypsilon、Sagittarius。そこそこ実用的な処理系はほぼ持っているはず。
Mosh、Ypsilonはx86、x64限定。SagittariusはlibFFIを使っているのでかなりのCPUでFFIが使える。
(自分の処理系の宣伝ｗ)

【ライブラリが豊富な処理系】

RacketのPLT、ChickenのEgg等

【ドキュメントが充実してる処理系】

Racket、Chicken、Gaucheはドキュメントが充実している。
Sagittariusもまぁまぁ。
(あまり他の処理系のドキュメントを参照しないのでこの項目は弱いｗ)

【いざというときに日本語で質問できる処理系】

Gauche、Mosh、Sagittarius、Ypsilon、Schluesselは開発者が日本人。
多分他にもあるがよく知らない。

環境別

【Windowsでインストーラ一発インストールしたい】

Chez、Racket、Sagittarius、YpsilonはWindows用のインストーラがある

【Mac OSで使いたい】

Chicken、Racket、Mosh、Chibi、Gauche、Sagittarius等結構ある、がBrewに登録されてるのはどれかは知らない。

【Linuxで使いたい】

自前でビルドすればほぼどれでもいけるんじゃね？(適当)

【JVMで使いたい】

Kawa一択 かと
SchluesselもJVMで動く

【開発環境が充実してる】

RacketがDr RacketというIDEを持っている
Emacsが使えるならschemeモード使えばいい気がする。
Gaucheならgauche-modeがある。(つかったことないけど便利らしい)

注意事項

Larceny、Mosh、Ypsilonはリリースが年単位で出ていないので、不具合の発見をしても修正される可能性が低め
ChezはCiscoに買収されてから更新が停まっている感じ


他にほしい項目とか、この処理系もお勧めだという突込み歓迎。


追記 2014年1月11日
Larcenyタイポ修正
Schluesselを追加
FFIの項目を多少追加(Sagittariusの宣伝ｗ)

追記 2014年1月13日
Chez Schemeの買収関連のリンクを追加

ビットフィールドがほしい

実は役に立たないことが判明してしまったMQTTの実装を書いてるのだが、仕様書を読んでいる段階からビットフィールドが(binary data)にあるといいなぁということを思っていた。なんとなく腹案もあって、こんな風に書けるといいかなぁというのが以下、

;; assume define-mqtt-type is defined as composite data
(define-mqtt-type <fixed-header> ()
  ((:bit-field :byte
     (type   :bits 4)
     (dup    :bits 1)
     (qos    :bits 2)
     (retain :bits 1))
   (remaining-length :length)))

うっかりスロット名とかぶるとまずいのでキーワードを使う必要がある（？）。

とりあえず現状ではデフォルトのデータ読み取りなどはないので(多分将来にわたって入れるつもりもない)、:byteが返す値は数値であることをチェックする必要がある。まぁ、しなくてもビット操作したさいに死ぬのでいいといえばいいのだが。いや、読み取った数値が合計ビット数より大きかった場合の処理はいるなぁ。後、読み取るビット数を明示して未使用ビットは暗黙に計算する方がスマートかな？もしくは暗黙に8の倍数を取るか？どっちも一長一短な感じはするなぁ。

この辺を入れだすと、じゃあユニオンもほしい状況が出てくるんじゃないのか？と思っていたりはするのだが、まぁそれは必要になったら考えるとする。

追記
よく考えればsimple datumの定義でなんとかできなくもない気がしてきたなぁ。1バイト読み取ってビットで適当にやればいいのか。無くてもいいかな？ちょっと考えるか・・・

SRFI-0の紹介

(LISP Library 365参加エントリ)

SRFIとはScheme Requests For Implementationの略。これがライブラリかどうかという議論は置いておくことにする。(8割はPure Schemeで実装可能なので、まぁOKということで。)

一応昇順に紹介していくつもりだが、そうすると最新のものは年の最後の方になるので、適当に「このSRFIが知りたい」とかのコメントなりメンションなり投げてもらえれば適宜対応する予定。

さて、一発目は0番目のSRFI、cond-expandの紹介。

これは何？
処理系毎の差異を吸収するためのマクロです。C言語で言えば#ifdefとかのプリプロセッサみたいなの。

どう使うの？
こんな感じで処理系とか、仕様とかを指定します。

;; want to use record
(cond-expand
  ;; or/and can be used to expand/narrow the condition
  ((or sagittarius r7rs)
    (import (scheme base)))
  (gauche
    (use gauche.record)))
  (else
    ;; define own record
   ))

実はこのSRFIはすでにR7RSに組み込まれています。また、R7RSではR6RS同様モジュールの定義がされたので、cond-expandにlibraryの識別子が入っています。オリジナルのSRFIではsyntax-rules内のキーワードにsrfi-1やsrfi-5などのサポートしているSRFIを入れていますが、library識別子は処理系が持っているライブラリを探して、存在するかしないかをチェック可能です。

さて、これで処理系の切り分けをしてみたくなりましたね？

謹賀新年

あけましておめでとうございます。旧年は大変お世話になりました、本年もよろしくお願いいたします。

時候の挨拶ここまで。

新年が始まると浮かれて何かしら決意したりするのが恒例なので今年も何かしら決意しようと思う。

私生活
2012年から言ってるけど、ギターの練習をもう少し真面目にやりたい。弾きたい曲が少ないのがモチベーションを上げれない理由かも。(弾きたいのは難易度高すぎてやる前からしり込みしてるってのもあるが・・・)
昨年末はちょっと忙しくてサボったけど、週1ではジムにいっていたのでこれを継続したい。(平日にいけれないのは痛いが、まぁ家トレで頑張るということで。)
オランダ語をいい加減話せるようにならないと、といい続けて早2年。まだ喋れない・・・今年は頑張る。

Sagittarius
BlackBerryで動くようになってたｗ
今年はライブラリの充実とMOP周りを頑張ろうかなぁと。まぁ、ここで言っても大抵年末までにはいろいろ予定が変わるので2014年開始2,3ヶ月の予定ということでｗ
月一リリースでやってるけど、どこまでこれを継続するか悩み中。個人的には小出しにしていけばいろいろ楽だと思ってるんだけど、大掛かりな変更をしづらいというのもあってどうしようかなぁと。
Google Codeから逃げた。ダウンロード機能があるから使っていたのでなくなるなら特に魅力ないし・・・移り先
長期というか、永遠の課題だけど、パフォーマンスの改善とデバッグ機能の強化。特にパフォーマンス。ちょいちょいベンチマークに使ってもらえるようになったけど、結果が散々なのでなんとかしたい。

その他
Lisp Library 365に参加したので、継続的に月３くらいでSRFIの紹介をする。(Sagittariusのライブラリを紹介してほしいという要望があれば応えますｗ)
R7RSとSRFI縛りで何かを作る過程を綴ってみたいなぁと思いつつ、こいつは未定(ネタ募集) 。

こんなところかなぁ。

それでもLispを使う - 2013年を振り返って

今年も残すところわずかになった。ここで一度一年を振り返ることにする。表題*1で謳っているLispとはSchemeのことである。SchemeがLispであるか否かという疑問については一切触れない。

Lispは万能ではない
プログラマであれば誰しも「Lispは神の言語」であるというジョークをしばしば目にすることがあるだろう。もしLispが神の言語であれば、それは万能のツールとなり多くのプログラマが救いを求めて使用しているだろうが、現実はそれとは大きく異なる。人工知能と深いかかわりがある、LispでLispを書いて実行することができる、そういった歴史的または稀有な言語の特徴を指して人が神の言語と呼ぶのであればそうなのかもしれない、しかし、現実の問題を解く際の最適解に常になり得るかといえばそんなことはない。どちらかといえばLispはLispが得意とする分野が限定的であるとさえいえる。

Lispは悟りを開くためのものでもない
Eric Raymondは「How To Become A Hacker」で次のように述べている；

LISP is worth learning for a different reason — the profound enlightenment experience you will have when you finally get it. That experience will make you a better programmer for the rest of your days, even if you never actually use LISP itself a lot.

しかしながら、Lispを使い始めて4年になるが悟りといったものを開けたと思ったことは一度たりともない。むしろ使えば使うほどに目の前に聳え立つ大きな壁のようなものがLispの限界を知らしめてくる、そんな気にさえなる。全く異なるパラダイムの言語を複数習得する過程で悟りが開けるのかもしれないが、それであればCとC++を学べば悟りを開けることになる。

プログラマは強力な言語を使うべきである
現実の問題は数学のそれとは違い公式があるわけではない*2。正しい答えというものも存在しないかもしれない。その際に使うツールは思考の疎外をしない柔軟でかつあらゆる局面に対して対応可能なものであるべきだ。プログラミング言語はそれぞれに得意とする分野があり、銀の弾などありはしない。であれば、最も手になじむものを複数個選び局面に合わせて使い分ける他に最適な手はないだろう。
私自身の問としては、Lispはどうか？ではなく、Sagittariusはどうか？にならざるを得ない。この一年で果たしてて最も手になじむツールになりえただろうか？答えはYesでもありNoでもある。Sagittariusはこの一年で大きく向上した。ライブラリも充実し、現実の問題に立ち向かえる程度には手になじむようになった。だがここはまだゴールではない。時としてそれがもつ制約や利便性の欠如によって思考が疎外されることがある。いかなる時でも最適解でありえるというのがゴールであれば、ゴールなどありはしないのかもしれない。

一年は長いようで短く、短いようで長い。Sagittariusが今年の初めにどのような姿をしていたのか思い出せない。来年もこの感じがまた味わえるような一年にするとしよう。

*1Lisp AC用に考えていた題ともいうｗ
*2ここでは高校数学を対象としている。

change-class

MOP ACに参加してしまったのでMOPサポートを手厚くしたいなぁという欲求が勝手に高まってきている。サポートしていない機能のもっとも大きなものとしてchange-classとクラスの再定義がある。個人的にどちらもあまり(サポートしてないのだから当然だが)使わない機能で今一どういうものかよく分かっていない。とりあえず、オリジナルのAMOPを当たってみることにした。

AMOPで使われているソースはclossette.lispと呼ばれるものらしく、ググって見るとまぁ簡単に見つかった。これとか。

っで、とりあえず、change-classの骸骨だけ作ってみたのが以下。

(import (rnrs) (clos user) (clos core)
        (sagittarius)
        (sagittarius control))

(define (slot-exists? obj slot)
  (slot-exists-using-class? (class-of obj) obj slot))

(define-method slot-exists-using-class? (class obj slot)
  (not (not (assq slot (class-slots class)))))

(define-method change-class ((old <object>) (new-class <class>) :rest initargs)
  (let ((new (allocate-instance new-class initargs)))
    (dolist (slot-name (map slot-definition-name (class-slots new-class)))
      (when (and (slot-exists? old slot-name)
                 (slot-bound? old slot-name))
        (slot-set! new slot-name (slot-ref old slot-name))))
    ;; TODO
    ;;(%swap-slots new old)
    ;;(%swap-class new old)
    (apply update-instance-for-different-class new old initargs)
    old))

(define-method update-instance-for-different-class
  ((old <object>) (new <object>) :rest initargs)
  (let ((added-slots (remove (lambda (slot-name)
                               (slot-exists? old slot-name))
                             (map slot-definition-name 
                                  (class-slots (class-of new))))))
    (apply shared-initialize new added-slots initargs)))

(define-method shared-initialize ((instance <object>) slot-names :rest all-keys)
  (dolist (slot (class-slots (class-of instance)))
    (let ((slot-name (slot-definition-name slot))
          (init-key   (slot-definition-option slot :init-keyword #f))
          (init-value (slot-definition-option slot :init-value #f))
          (init-thunk (slot-definition-option slot :init-thunk #f)))
      ;; init-keyword is the strongest
      (cond ((and init-key (get-keyword init-key all-keys #f))
             => (lambda (v) (slot-set! instance slot-name v)))
            ((and init-value (get-keyword init-value all-keys #f))
             => (lambda (v) (slot-set! instance slot-name v)))
            ((and init-thunk (get-keyword init-thunk all-keys #f))
             => (lambda (v) (slot-set! instance slot-name (v)))))))
  instance)

ほぼオリジナルのコピー。違いはオリジナルはrotatefでスロットとクラスも変更できるがSagittariusではそんなことできないので本体に何かしら手を入れる必要があるといった点と、shared-initializeが美しくない点か。(普通にinitialize呼び出せばいいじゃん、と思ったのだが、そうすると引数チェックとかがユーザーによって定義されていると嬉しくないのだろう。実際多分嬉しくない)

っで多分以下のように使える(予定)。

(define-class <member> ()
  ((name       :init-keyword :name)
   (occupation :init-keyword :occupation)))

(define-class <member2> ()
  ((first-name :init-keyword :first-name)
   (last-name  :init-keyword :last-name)
   (occupation :init-keyword :occupation)
   ))

(define m (make <member> :name "Takashi" :occupation "Programmer"))

(change-class m <member2> :last-name "Kato" :first-name "Takashi")

CLHSのchange-classにある例では明示的に呼んでいるのでこうあるべきなのだろう。

closseteではクラスの再定義は禁止してるみたいなんだけど、CL、Gaucheともに同名のクラスが既にあった場合クラスの再定義プロセスが走るみたいだが、これどうしたものかな。

XSDを扱いたい

仕事柄SOAPを頻繁に使う。現状ではSOAP-UIを使ってリクエストを投げているのだが、これがまどろっこしくなってきた。SchemeにはSXMLがあるので気合を入れれば何とでもなるのだが(大抵のことは気合を入れれば何とかなるが・・・)、せっかくなので何かしらフレームワーク的なものがあってもいいのではと思ってきた。

0.4.12から入った(binary data)ライブラリの便利さに驚いているので、同様な感じで定義一発でmarshalとunmarshalも可能になるといいかなぁと思っている。例えばこんな感じで定義して

;; Pseudo code
(define-define-xml-schema define-xml-type reader writer)
(define-xml-type <customer> ()
  ((name :type xs:string :element Name :min 1 :max 1)
   (birth-of-country :type xs:string :element BirthOfCountry :min 0 :max 1))
  :namespace "http://example.com"
  :element Customer)

こんな感じで使えるとか

(let ((x (call-with-input-file "sample.xml" reader))
  (writer x (current-output-port)))
#|
<Customer xmlns="http://example.com">
  <Name>read from sample.xml</Name>
</Customer>
|#

ぱっと思いついた感が強いな。

っで、この定義も手で書くのはあほらしいので、XSDをパースして適当に自動生成されるとうれしい気がする。(実際Githubに上げてるSOAPライブラリはその辺が面倒であまり使ってなかったりする・・・)

もう少し案を練ってから実装してみるか。

Sagittarius Scheme 0.4.12リリース

Sagittarius Scheme 0.4.12がリリースされました。今回のリリースはメンテナンスリリースです。

修正された不具合

• CLOSのメソッドを使用したマクロを定義するマクロがエラーになる不具合が修正されました
• bytevector->integerが負の整数に対して正しい値を返さない不具合が修正されました
• mod-inverseがランダムで正しい値を返さない不具合が修正されました
• Windows上でgetenvが正しく値を返さない不具合が修正されました
• get-output-bytevector及びextract-output-bytevectorがSEGVを起こす不具合が修正されました
• R6RSモードでエスケープされたシンボルを読み込むと&lexicalが投げられる不具合が修正されました
• CBCモードで作成された暗号器が初回以降の暗号/復号で正しいIVを使用しない不具合が修正されました
• (rfc mime)がマルチパートデータを正しく処理しない不具合が修正されました

改善点

• cipher-block-sizeが暗号器の名前でも使用可能になりました
• next-method?がメソッド内で使用可能になりました
• is-prime?が巨大数に対してLucas-Lehmer法を使用するようになりました
• スタックトレースが継続をまたいでも表示されるようになりました
• access-protected-resourceでマルチパートデータが使用可能になりました
• inflating-input-portが実際に使用したバイト数のみ元ポートの位置を進めるようになりました
• mime-compose-message-stringがバイナリデータを扱えるようになりました
• open-bytevector-output-portのextraction手続きがtranscoded-portで元ポートが閉じられた後でも使用可能になりました

新たに追加された機能

•  socket-recv!が追加されました
• (binary data)ライブラリが追加されました
• DSAの署名及び検証機能が追加されました
• bytevector->sinteger及びbytevector->uintegerが追加されました
• sinteger->bytevector及びuinteger->bytevectorが追加されました
• (rfc ssh)が追加されました(ドキュメントはまだありません)
• compute-getter-n-setterが追加されました
• slot-ref-using-class、slot-set-using-class!及びslot-bound-using-class?が追加されました

非互換な変更

• nullライブラリが廃止されました

Edge case?

I've just found an interesting behaviour of R6RS implementation about bytevector output port. First of all, look at this piece of code;

(import (rnrs))

(let*-values (((port extract) (open-bytevector-output-port))
              ((out) (transcoded-port port (native-transcoder))))
  (put-string out "hello")
  (display (extract)))

What do you think the (extract) should do? According to the R6RS spec of transcoded-port the port must be closed by special way so that other string operations can be done.

As a side effect, however, transcoded-port closes binary-port in a special way that allows the new textual port to continue to use the byte source or sink represented by binary-port, even though binary-port itself is closed and cannot be used by the input and output operations described in this chapter.
-- R6RS Standard libraries 8.2.6 Input and output ports

I know open-bytevector-output-port can take a transcoder as its optional argument, however I think there is needs that the created bytevector output port needs to be converted later for some reason or user wants to store first pure binary data then some text data.

Now I've tried what the implementations would return, the result was rather interesting. Followings are the tested implementations and its result;

[Implementations that raised an error]

• Larceny 0.97
• Racket 5.2.1
• Sagittarius 0.4.11
• Ypsilon 0.9.6-update3

[Implementations that returned a bytevector]

• Mosh 0.2.7
• Petite Chez Scheme 8.4

The majority is raising an error, but interestingly Chez Scheme which I think the reference implementation of R6RS returned a value. For me, it is convenient the latter behaviour and the specification (as far as I searched) doesn't specify how it should be. The above quotation is only specifying the input/output operation not extracting.

Hmmmm, what should I do?

Mooseのaugment/innerをMOPで

この記事はMetaobject Protocol(MOP) Advent Calendar 2013 17日目の記事として書かれました。

PerlにはMooseというMOPをサポートしたオブジェクト指向モジュールがあります*1。その中にaugment/innerという一風変わったメソッドモディファイアがあったのでこれをMOPで実現してみようと思います。

実装するためにはそれがいったいどのように動作するのかを知る必要があります。PerldocのMoose::Manual::MethodModifiersにaugment/innerの項目があるのでそちらを見てみましょう。

…

見ましたね？どうやら動作の肝はinner手続きが下位の実装を呼び出す点にありそうです。これは通常のMOPで実現されるメソッドチェインとは逆です。以下の図は通常とaugment/innerが要求するメソッドチェインを表したものです。

* as-xml is the method
* income-and-expenses is too long so now combined :)
+-------------------+                       +-----------------+                       +-------------------+
| as-xml (combined) | - call-next-method -> | as-xml (report) | - call-next-method -> | as-xml (document) |
+-------------------+                       +-----------------+                       +-------------------+

+-------------------+            +-----------------+            +-------------------+
| as-xml (document) | - inner -> | as-xml (report) | - inner -> | as-xml (combined) |
+-------------------+            +-----------------+            +-------------------+

既に答えは見えている気がしますが、肝はcompute-applicable-methodsです。以下が今回の肝になるコード片です。

(import (rnrs) (clos user) (clos core) (srfi :39))

(define-class <augment-generic> (<generic>) ())

(define *default-inner-value* (make-parameter ""))

(define-method compute-applicable-methods ((gf <augment-generic>) args)
  `(,@(reverse! (call-next-method))
    ;; add very bottom one
    ,(make-method (list <top>)
                  (lambda (call-next-method o) (*default-inner-value*)))))

5日目の記事では与えられたメソッドから特定のqualifierを取り除いて等の複雑なことをしましたが、今回は単に逆順にするだけです。最後にデフォルトの値を返すメソッドを追加しているのがトリックです。Gaucheの<bottom>のようなクラスがあればこのトリックは要らないのですが、*2Sagittariusではサポートしていないので明示的に追加してやる必要があります。

さて肝はできたので後はお化粧です。 このままではinnerをcall-next-methodとして呼ばなければならないのであまりaugment/innerっぽくありません。そこで以下のようにマクロを定義します。

(define-syntax define-augment
  (syntax-rules ()
    ((_ name)
     (define-generic name :class <augment-generic>))))

(define-syntax augment
  (lambda (x)
    (define (analyse args)
      (let loop ((ss args) (rs '()))
        (cond ((null? ss)          (values (reverse! rs) '() #f))
              ((not (pair? ss))    (values (reverse! rs) ss #f))
              ((keyword? (car ss)) (values (reverse! rs) (gensym) ss))
              (else (loop (cdr ss) (cons (car ss) rs))))))
    (define (build k generic qargs rest opts body)
      (define (parse-specializer s)
        (syntax-case s (eqv?)
          ((_ class) (identifier? #'class) #'class)
          ((_ (eqv? v)) #'(eql v))
          ((_ v) #'v)
          (_ #'<top>)))
      (define (->s d) (datum->syntax k d))
      (with-syntax (((specializers ...) (->s (map parse-specializer qargs)))
                    ((reqargs ...)
                     (->s (map (lambda (s) (if (pair? s) (car s) s)) qargs)))
                    (rest       (->s rest))
                    (option     (->s opts))
                    ((body ...) (->s body))
                    (generic    (->s generic))
                    (inner      (->s 'inner)))
        (with-syntax ((real-body (if opts
                                     #'(lambda (inner reqargs ... . rest)
                                         (apply (lambda option body ...) rest))
                                     #'(lambda (inner reqargs ... . rest)
                                         body ...))))
          #'(begin
              (add-method generic
                          (make-method
                           (list specializers ...)
                           real-body))
              generic))))
    (syntax-case x ()
      ((k ?generic ?args . ?body)
       (let-values (((qargs rest opt) (analyse #'?args)))
         (build #'k #'?generic qargs rest opt #'?body))))))

実際に使うには以下のようにします。

(define-class <document> () ())
(define-class <report>  (<document>) ())
(define-class <combine> (<report>) ())

(define-augment xml)
(augment xml ((o <document>))
  (string-append "<doc>" (inner) "</doc>"))

(augment xml ((o <report>))
  (string-append "<title>foo</title>"
                 "<summary>bar</summary>" 
                 "<body>"
                 (inner)
                 "</body>"))
(augment xml ((o <combine>)) "hello")

(xml (make <document>))
;; => <doc></doc>

(xml (make <report>))
;; => <doc><title>foo</title><summary>bar</summary><body></body></doc>

(xml (make <combine>))
;; => <doc><title>foo</title><summary>bar</summary><body>hello</body></doc>

上記のコードの動作には今週末にリリースされる予定の0.4.12が必要なので注意してください*3。ちゃんと下位実装の値がinner呼び出しの部分に埋め込まれているのが確認できます。

MOPを使えば一見処理系でサポートしないといけないような処理でもお手軽にサポートできる可能性を示せていれば幸いです。

*1実際に使ったことはないですｗ
*2どうやら予定通りには動かないようです。勘違いでした。参照
*3make-methodを使わなければ0.4.11でも動作するはず。

明日使える総称関数(3)

この記事はMetaobject Protocol(MOP) Advent Calendar 2013 11日目の記事として書かれました。

MOPはメタクラス上に構築されます。今回はそのクラスそのものを使って総称関数を使ってみます*1。

MOP ACのこれまでの記事を読まれた方なら既にご存知かと思いますが、 まずはメタクラスとはのおさらいです。MOPをMOP足らしめる大きな存在の一つとしてメタクラスがあります。例えばJavaであれば全てのクラスはjava.lang.Classのサブクラスになるといったように、CLOSでも大元のクラスがあります。CLならばstandard-class、Gauche及びSagittarius*2ならば<class>がデフォルトでクラスのメタクラスになります。ここでデフォルトでと言ったのは(CLOSベースの)MOPではこの階層を変更することができるからです。図で表すと以下のようになります。

+---------+            +-------+        +-----------------+
| <class> | <--------- | <top> | <<-+-- | builtin classes |
+----+----+            +-------+    |   +-----------------+
     ^                              |
     ^                              |   +----------+       +---------------+
     |                              +-- | <object> | <<+-- | <user-class1> |
     |                                  +----+-----+   |   +---------------+
     |                                       ^         |
     |                                       ^         |   +---------------+
     |                                       |         +-- | <user-class2> |
     |                          +------------+             +---------------+
     |                          |
+----+--------+       +---------+----------+
| <metaclass> | <---- | <meta-user-class1> |
+-------------+       +--------------------+

ASCII記号の関係上^及び<をインスタンス作成時に使用されるクラス、縦に並んだ^及び<<を継承関係として使っています。この図では<class>は独立した位置にありますが、実際のCLOSでは<object>のサブクラスになっています。つまり、CLOSのMOPにおいてはメタクラスも単なるオブジェクトに過ぎないということです。しかし、ここでは図を簡略にするため独立したものとして描いています。

CLOSではこのメタクラスのサブクラスを使ってオブジェクト構築の振る舞いをユーザがコントロールできるようにしています*3*4。

ではこれが「明日使える総称関数」とどう関係してくるのでしょうか？ここでは実際に使われている例を見ながらその便利さを体感していきます。拙作Sagittarius Schemeでは最近(binary data)というライブラリが追加されました*5。このライブラリではメタクラスを使用したバイナリデータの読み書きとCLOSでの抽象化を行っています。

実際のコードはユーザの負担を減らすためにマクロでコードの自動生成をしていますが、肝になる部分は以下です。ここではユーザが<；sample>という複合データクラスを:parent-metaclassキーワード引数に<sample-meta-parent>を指定したとします。*1*6

;; This meta class will be generated automatically
(define-class <sample-meta> (<sample-meta-parent>) ())

;; main class
;; suppose user didn't specify the parent class
(define-class <sample> ()
  ((a :init-keyword :a :init-value #f))
  :metaclass <sample-meta>)

;; binary reader
(define-method sample-read ((t <sample-meta>) in . ignore)
　　(let ((o (make t)) ;; !!! POINT !!!
    ;; read structured binary data and set it to the slot(s)
    o))

sample-readはdefine-composite-data-defineマクロに渡されたreaderパラメタです。実際にはマクロによって暗黙的に定義されるので、<sample-meta>はユーザに見えることはありません。

sample-readがこのように定義されてうれしい理由はなんでしょうか？一つの答えとして以下のように書くことができます。

(sample-read <sample> binary-input-port)
;; => instance of <sample>

コードの中でPOINTと書かれている部分がまさに肝です。CLOSではオブジェクトの構築はMOPを使っていると書きましたが、makeも例に漏れず総称関数を<class>で特殊化したものです。つまり、<class>を継承したクラスを渡してやればそのインスタンスを作ることができます。また、総称関数の引数型に指定すればそのクラスで特殊化することが可能です。

このライブラリの例では、バイナリという低レベルの操作をメタクラスによる総称関数のメソッドディスパッチでCLOSのインスタンスにマッピングするため、データの抽象度及びコードの可読性が格段にあがります*7。

今回紹介した例はCLやGaucheと他のCLOSベースのMOPでも応用可能です。贔屓の処理系で実際に動かしてみて理解を深めてみてはいかがでしょうか？

*1この記事が書かれた経緯。
*2Tiny CLOSベースなら恐らくどの処理系でも
*3参考例：Metaobjectでオブジェクト指向プログラミング
*4参考例：コンポジションに便利なpropagatedスロット
*5記事のサンプルコードと現在の実装では仕様が違うので注意
*6大したものじゃないって言ったじゃないですかｗ
*7体感には個人差があります。単なる宣伝です。

Windowsは悪なのか？

多くのハッカーと呼ばれる人、それを目指す人、はたまた凄腕ITエンジニアはWindowsではなくLinuxもしくはUNIXライクOSを使っているし、Windowsを良しとはしない傾向になる。How To Become A HackerでEric Raymondは以下のようにその理由を述べている。

Yes, there are other operating systems in the world besides Unix. But they're distributed in binary — you can't read the code, and you can't modify it. Trying to learn to hack on a Microsoft Windows machine or under any other closed-source system is like trying to learn to dance while wearing a body cast.

確かにそのとおりだ。WindowsはプロプライエタリなOSでそのソースを読むには莫大な金額のライセンス料をMicrosoftに支払ってソースコードを入手する以外にはない。では、LinuxやBSD系UNIXを使っている人たちはそのOSのコードを読むためにそれらを使っているのだろうか？いざというときソースを解析して問題を回避するのだろうか？

そのような統計を見たことはないので憶測でしかないのだが答えはNoではないだろうか？仮に多くの非Windowsユーザーがカーネルのソースコードを読むことはないとしたら、いったい何が彼らをそのOSを使うように仕向けたのだろう？

Windowsは良くも悪くも万人向けである。システムの根幹にかかわる部分に直接手を入れる手段はほぼない。全ての操作はGUIを使って行われる前提で設計されている。万人向けであるがゆえにプログラミングに関係するツールは初期状態では付随していなし、そのシェルはあまりにも貧弱だ。逆にUNIXライクOSでは全ての設定は単にファイルであることが多い。また、プログラマが必要とするツールの多くは初期状態で使用可能であることが多い。さらにOSのシステムコールはWindowsのそれに比べてはるかに簡潔であり、manでそれらの使い方を容易く調べることが可能である。

これだけ比べるとプログラマとしてはWindowsではない方が楽なのではないだろうか？ 既にある開発環境、整備されたドキュメント、簡潔なAPIどれを見てもWindowsにはない。彼らはWindowsから逃げたのではないだろうか？

それは悪いことではない。僕自身Windowsでの開発はCygwin上で行っている。可能な限り楽をしたいからだ。だが、SagittariusはWindowsでの動作も常に確認している。楽をしたいからだ。そして、僕以外の誰かが同じように楽ができることを願っているからだ。OSのインストールは楽ではない。また、量販店で買うコンピュータには基本Windowsが入っている。Windowsを諦めるということは楽ではない作業をしなければならないということだ。僕は心が弱い。目の前に高い壁と通り抜けられそうな茨の道があれば後者を選ぶ。楽がしたいからだ。

Windowsを諦めない*1。

*1これが言いたかっただけｗ

明日使える総称関数(2)

この記事はMetaobject Protocol(MOP) Advent Calendar 2013 5日目の記事として書かれました。

前回はビルトインでサポートされているqualifierの使い方を紹介しました。今回は自前のqualifierを作ってみましょう。問題になるのはSagittariusでは基本のqualifier以外のものはエラーになるという部分ですが、そこをMOPを使って何とかしてしまおうという算段です。

注意
前回の続きなのでタイトルは「明日使える総称関数(2)」となっていますが、このレベルだと明日使える保障はありません。また、使いどころを間違えると大変なことになる可能性があります。使用は自己責任でお願いします。

ここでは:collectというqualifierを導入することにしましょう。要求としてこのqualifierが付いたメソッドの戻り値をリストにパックするものとします。また話を簡単にするために、:primaryメソッドの戻り値は捨てられるものとします。では、コードを見てみましょう。

(import (rnrs) (clos user) (clos core) (srfi :1) (srfi :26))
(define-class <collect-qualifier-generic> (<generic>) ())
(define-method compute-applicable-methods ((gf <collect-qualifier-generic>)
                                           args)
  (let* ((methods (generic-methods gf))
         (appends (filter-map (lambda (m)
                                (and (eq? (method-qualifier m) :collect)
                                     m)) methods)))
    (for-each (cut remove-method gf <>) appends)
    (let ((r (call-next-method)))
      (for-each (cut add-method gf <>) appends)
      ;; make method which collects all result of methods which have
      ;; :collect qualifier
      (list (make <method>
              :generic gf
              :specializers (list)
              :lambda-list 'args
              :procedure (lambda (call-next-method . args)
                           ;; discards other result
                           (compute-apply-methods gf r args)
                           (map (lambda (m) 
                                  (compute-apply-methods gf (list m) args))
                                appends)))))))

(define-generic foo :class <collect-qualifier-generic>)
(define-method foo :collect ((a <symbol>)) 'symbol)
(define-method foo :collect (a) 'top)
(define-method foo ((a <symbol>)) (print a) 'b)

(print (foo 'a))
;;> a
;;=>(top symbol)

順番に見ていきましょう。

まず、:collect qualifierをサポートするための総称関数クラスをのサブクラスとして作ります。これにより、MOP用総称関数の一つであるcompute-applicable-methodsの特殊化を可能にします。
次にcompute-applicable-methodsを先ほど作ったクラスで特殊化します。処理の中身は以下のフローです。

1. 総称関数fooに登録されている全てのメソッドから:collect qualifierを持つものを除く
2. 親クラスの処理を呼び出し、戻り値を保存する
3. 取り除いたメソッドを戻す
4. 処理に使われるメソッドを作成する*1

#4で作られたメソッドは以下の処理を行います。

1. 上記#2で作られたメソッドチェインを実行する
2. :collect qualifierの付いたメソッドを全て実行する*2

上記の振る舞いを適用するために

(define-generic foo :class <collect-qualifier-generic>)

のように生成される総称関数のクラスを指定します。

たったこれだけです。Sagittariusではメソッドを作る構文がdefine-methodしかないので、フロー1の#4が多少煩雑な感じがしますが、やっていることは非常に単純です。

MOPとか、オブジェクト構築の振る舞いを変えるとか言われると非常に難しいことをしている気がしますが、たったこれだけで面白いことができるわけですから遊んでみない手はないでしょう。

*1 束縛されないのでspecializerを真面目に指定する必要はありません。
*2 真面目にやるならメソッドのソートや受け取った引数の型を調べてメソッドの選別をする必要がありますが、この例では簡便にするために省いています。

明日使える総称関数(1)

この記事はMetaobject Protocol(MOP) Advent Calendar 2013 2日目の記事として書かれました。

実は今日が誕生日の筆者です。適当に何かを送りつけてくれたり、お祝いの言葉をもらえたりすると喜ぶかもしれません。

さて、MOPと言えばCLOSがまず浮かぶのではないでしょうか。Metaobject Protocolなのでオブジェクトのクラス定義の方をさすのかもしれないのですが、CLOSといえば総称関数が便利です。そこで今回は「明日使える総称関数」と題しまして、qualifierを便利に使いつつMOP的にも満足いくようにしてみたいと思います。

とりあえず前提としてコードは拙作Sagittarius Scheme(0.4.11)で動作確認しています。またGaucheはメソッドのqualifierをサポートしていないので移植は(現状では)不可能ですが、本稿で紹介するqualifierはCLにも同様のものがあるので、そちらへの移植は難しくないかと思います。

まずはメソッドqualifierのおさらいをしましょう。Sagittariusではデフォルトで:primary, :before, :afterそして:aroundの4つのqualifierを実装しています。特に何も指定しない場合は:primaryが暗黙のうちに使用されます。イメージをつかむために簡単な例を見てみます。

(import (rnrs) (clos user))
(define-method print :around args
  (display "around:before") (newline)
  (call-next-method)
  (display "around:after") (newline))

(define-method print :before args
  (display ":before") (display args) (newline))
(define-method print :after args
  (display ":after") (display args) (newline))

(define-method print args (call-next-method))
(print 'a 'b 'c)
#|
around:before
:before(a b c)
abc
:after(a b c)
around:after
|#

:aroundは一番外側を包み、call-next-methodが呼ばれた際のみに続くメソッドチェインを起動します。また、チェイン全体の戻り値は:aroundメソッドが返した値になります。
:beforeはメソッド本体が呼ばれる手前で呼び出されます。戻り値は捨てられます。
:primaryはメソッド本体です。:aroundが上書きしない限りこのメソッドの戻り値がメソッドチェインの全体の戻り値として使用されます。
:afterはメソッド本体が呼ばれた直後に呼ばれます。:before同様戻り値は捨てられます。
ちなみに、この動作はCLでも同様です。

では、これが使えると何が嬉しいのでしょう？

例えば、 DB接続を考えて見ます。DBの実装によってクエリ発行などは別にする必要があるけど、コネクションが生きているかチェックするのは共通でやりたい、なんてこと考えたことありませんか？素直に考えれば、以下のようになるでしょう。

;; super class method
(define-method select ((c <connection>) query)
  (check-connection c))

;; Database dependent layer
(define-method select ((c <oracle-connection) query)
  (call-next-method)
  (oracle-select c query))

DBの種類が増えた場合でもcall-next-methodを呼べば共通の処理はしてくれるという寸法です。でも毎回書くのはだるいですよね？そこでメソッドqualifierです。この場合なら事前処理に:beforeを使って以下のように書くことができます。

;; super class method
;; implementation limitation. Sagittarius needs primary method
(define-method select ((c <connection>) query))
(define-method select :before ((c <connection>) query)
  (check-connection c))

;; Database dependent layer
(define-method select ((c <oracle-connection) query)
  (oracle-select c query))

これでDBの実装が増えてもselectメソッドではコネクションが生きているかを自動で判別してくれます。(もちろん、check-connectionがエラーを投げなければ意味はありませんが・・・)

もう一例見てみましょう。JavaでAspectJを使っている方なら馴染み深いと思いますが、既存のメソッドの前後に事前と事後処理を入れたい場合というのがあるかと思います。例えばあるメソッドがエンティティの状態を変更します、ユーザーはその状態の変化を捉えて何かしらの通知を行うというのを考えて見ます。以下は簡単なコード例です。

;; pseudo method
;; This is in somewhere the library so users can't
;; change.
;; do something useful and return the new entity
(define (fire-event entity event) 'new-entity)

;; wrap it with qualifier
;; just stub to call original
(define-method fire-event args (call-next-method))

(define-method fire-event :around args
  ;; check args length and get the entity's state
  (print args)
  ;;
  (let ((r (call-next-method)))
    ;; check the result of the entity and notify
    (print r)
    r))
#|
(fire-event 'entity 'event)
;;> (entity event)
;;> new-entity
;;=> new-entity
|#

この例では:aroundが実際のメソッドを呼び出していますが、引数が不正であったりする場合は呼ばないことも可能です。Lisp:よくある正解で上げられているToo dynamicはこの機能を使えば実現できそうです*1。

次回*2はMOPを使って総称関数にユーザー定義のqualifierを足してみます。

*1コンパイラが手続きの呼び出しをインライン展開している場合等全てに対応できるわけではありません。
*2紹介部分が予定したよりかなり長くなってしまったので分割しました。

SSHクライアントを実装したった

そろそろ(自分のために)要るなぁと思っていたので「えいや！」と作った。と書くとちょっと自分がすごいことしてる感じが出るが、要するにRFCに書かれていることを地道に実装しただけである。ちなみに全ての要求はまだ満たしていない。

以下のように使える。

(import (rfc ssh))

(define transport (make-client-ssh-transport "localhost" "22"))
(define user "guest1")
(define pass "pass1")

(ssh-authenticate transport +ssh-auth-method-password+ user pass)
(let-values (((status response) (ssh-execute-command transport "ls -l")))
  (print (utf8->string response)))

ssh-execute-commandはコマンドの戻り値と出力を受け取る。出力はバイナリなので適当に変換する必要がある。他にもShellを起動したりチャンネルを自前で開いたりするAPIがある。

まだまだおもちゃ程度の処理しかできない(ので、しばらくはドキュメントに載らないｗ)。そして、本当にほしいのはSFTPだったりするので次はsubsystemセッションの確立とSFTPの実装かね。

以下は適当な情報
ソースはsitelib/rfc/sshディレクトリ以下。あまりの汚さに精神汚染を起こしても当方は責任を取らない(多分未来の自分に対する警告・・・)。これを実装するために以下の機能及びライブラリが追加された。

• (binary data)ライブラリ(自分で言うのもなんだけど、すごく便利ｗ)
• DSA鍵署名及び検証

Binary data structure read/write library

Currently I'm implementing SSH (for now client only) on Sagittarius and have noticed it would be convenient to have a library which handles binary data structure read/write. So I've written (binary data) library. (not sure if the name should be '(binary structure)' or '(binary io)', or something else).

Here is the simple example;

;; The definition is from RFC 4250-4254
;; atom datum
(define-simple-datum-define define-ssh-type read-message write-message)
(define-ssh-type <name-list> (<ssh-type>)
  names '()
  (lambda (in)
    (let* ((len (get-unpack in "!L"))
           (names (get-bytevector-n in len)))
      (string-split (utf8->string names) #/,/)))
  (lambda (out names)
    (let ((names (string->utf8 (string-join names ","))))
      (put-bytevector out (pack "!L" (bytevector-length names)))
      (put-bytevector out names)))
  :parent-metaclass <ssh-type-meta>)

;; composite data
(define-composite-data-define define-ssh-message read-message write-message)
(define-ssh-message <ssh-msg-keyinit> (<ssh-message>)
  ((type   :byte +ssh-msg-kexinit+)
   (cookie (:byte 16)) ;; array of byte
   (kex-algorithms <name-list>)
   (server-host-key-algorithms <name-list>)
   (encryption-algorithms-client-to-server <name-list>)
   (encryption-algorithms-server-to-client <name-list>)
   (mac-algorithms-client-to-server <name-list>)
   (mac-algorithms-server-to-client <name-list>)
   (compression-algorithms-client-to-server <name-list> (name-list "none"))
   (compression-algorithms-server-to-client <name-list> (name-list "none"))
   (language-client-to-server <name-list> (name-list))
   (language-server-to-client <name-list> (name-list))
   (first-kex-packat-follows :boolean #f)
   (reserved :uint32 0)))

So the idea of the library is that structured data are either simple datum or composite of simple datum. Thus if we define how to read/write the simple datum, then composite data's read/write are already decided. This might not be always true but as far as I know most of the case.

BTW, I think the naming of the macro is ugly so if you have a better suggestion it's very welcome :)

マクロバグリターンズ

えらく久しぶりに発見した気分ではある。二つあって、一つは(とりあえずやっつけで)片付けたのだが、もう一つに苦戦している。

問題となるのは以下のようなコード。

(import (rnrs))
(define-syntax renaming-test
  (syntax-rules ()
    ((_ var val)
     (begin
       (define dummy val)
       (define (var) dummy)))))
(define dummy #f)
(renaming-test a 'a)
(print (a))
(print dummy)

まぁ、見れば分かるとおり、最後のdummyは#fを返してほしいのだがaを返してくるというバグである。要するにリネームが上手いこといっていないのである。

現状ではリネームは展開時にのみ行われているのだが、パターンのコンパイル時にどこにも束縛されていない識別子はリネームしてしまっていいのではないか？という気がしている。上記の例なら、パターン変数であるvarとval、束縛されている_、begin及びdefineはリネームするとまずいのだが、残り(dummy)はリネームしてもマクロ外にもれることはないわけなのだから(むしろ漏れるとまずい)。ちょっとそんな感じでやってみるかね。 あぁ、だめだ。それだと以下のようなパターンで困る。

(let ((dummy #f)
      (hoge #t))
  (define (print . args) (for-each display args) (newline))
  (let-syntax
      ((renaming-test (lambda (x)
                        (syntax-case x ()
                          ((_ var val)
                           #'(begin
                               (define dummy val)
                               (define (var) dummy)
                               (display hoge) (newline)))))))
    (renaming-test a 'a))
  (print (a))
  (print dummy))

これだと、dummyはリネームされてほしいけど、hogeは変更されたくない。ただ、このパターンってマクロが構文を知ってないとどうしようもないような。違うかな？dummyとhogeが意味的に違うってのを構文の情報なしにどう知ればいいんだ？

セルフホスティング

現状でもSagittariusはほぼセルフホスティングしているのだが、もう少し発展させたものにしたいなぁと思ってきたのと、微妙な問題点に気づいたのでメモ。

0.4.11までは(実は0.4.11は試験的に違うが)Schemeで書かれたVM上でコンパイラをコンパイルしてCのコードを生成していたのだが、これだとVMのコードを変更するたびにC側とScheme側の両方を変更しなければならなくて正直面倒だった。そこで、とりあえずの下地として、コンパイルされたコードをCに変換するライブラリを0.4.11では導入した。

とまぁ、Sagittariusが変なことをしていない処理系だったらこれで話は終わるんだけど、実は変なことをしている処理系なのでここで話が終わらないことに気づいたのだ。SagittariusのコンパイラはVMが使用するフレームのワード数を知っていて(VMから取るんだけど)、コンパイル時に余計な環境の束縛を行わないようにしている(多分以前そうしたっていう記事書いた)。これが問題になる。ちょっといい例が思いつかなかったので微妙な例だが、こんなの。

(disasm (lambda (x)
          (let ((y (get x z))) 
            (print (let ((w (get y z)))
                     (get w (let ((e (get x)))
                              (get e x))))))))
;; size: 40
;;    0: FRAME 6
;;    2: LREF_PUSH(0)
;;    3: GREF_PUSH #<identifier z#user (0x80501990)>; z
;;    5: GREF_CALL(2) #<identifier get#user (x805019d8)>; (get x z)
;;    7: PUSH
;;    8: FRAME 6
;;   10: LREF_PUSH(1)
;;   11: GREF_PUSH #<identifier z#user (0x805018b8)>; z
;;   13: GREF_CALL(2) #<identifier get#user (0x80501900)>; (get y z)
;;   15: PUSH
;;   16: FRAME 18
;;   18: LREF_PUSH(2)
;;   19: FRAME 4
;;   21: LREF_PUSH(0)
;;   22: GREF_CALL(1) #<identifier get#user (0x80501810)>; (get x)
;;   24: PUSH
;;   25: FRAME 5
;;   27: LREF_PUSH(10) <-- !!! this !!!
;;   28: LREF_PUSH(0)
;;   29: GREF_CALL(2) #<identifier get#user (0x805017b0)>; (get e x)
;;   31: LEAVE(1)
;;   32: PUSH
;;   33: GREF_CALL(2) #<identifier get#user (0x80501870)>; (get w (let ((e (get x))) (get ...
;;   35: LEAVE(1)
;;   36: PUSH
;;   37: GREF_TAIL_CALL(1) #<identifier print#user (0x80501948)>; (print (let ((w (get y z))) (g ...
;;   39: RET

普通ならLREF_PUSH(10)というのはスタックに詰まれた変数の10番目をスタックに積むという意味なのだが、この場合は途中にあるフレームを考慮したら10番目になった変数の参照を意味している。なんでこんな風になっているかと言えば、まぁ歴史的理由が大きいのだが、Sagittariusには一つ外側の環境という概念が存在しないからである(その方がパフォーマンス的に有利だったから)。VMのスタックはプッシュとポップ以外では基本変更されないので、そこを(個人的には)上手く使った(と思っている)トリックである。

では、普通のセルフホスティングでは何が嬉しくないかといえば、コンパイラやビルトインライブラリにこういったケースが無いとは言い切れないため、先に計算されたオフセットがずれる可能性があるからである。となれば、解決策は一つで、ホストはまずターゲットコンパイラAをコンパイルしてそのコンパイラでもう一回コンパイルするというものだろう。Aは一つ前のVMインストラクションで構成されるが、吐き出すインストラクションはターゲットが必要とするものになるといった寸法である。多少回りくどいなぁとは思うが、仕組み上回避不可っぽいので諦めるしかないだろう。

とりあえず、メモとして記録。

コンパイラマクロ

実は材料は最初からあったんだけど、気が向かなかったのと必要に迫られるほどタイトな性能を要求してなかったので放置してたものの一つ。っが、気が向いたのでえいや！っと作ることにした。まぁ、気が向いた理由は2chでRacketとChickenはあるという話を見たからなのだが・・・

とりあえず、以下の様に使える。

(import (rnrs) (core inline))
;; map is defined in (core base)
(define-inliner map (core base)
  ((_ p arg)
   (let ((proc p))
     (let loop ((l arg) (r '()))
       (if (null? l)
           (reverse! r)
           (loop (cdr l) (cons (proc (car l)) r)))))))

手続き名とそれが定義されているライブラリを指定し、実際の展開部分はsyntax-rulesのようなパターンマッチで記述する。っで、比較のためにある版とない版のコンパイル結果がこれ。

;; あり
(disasm (lambda (x) (map values '(1 2 3 4 5))))
;; size: 26
;;    0: GREF_PUSH #<identifier user#values x80414678>; values
;;    2: CONST_PUSH (1 2 3 4 5)
;;    4: CONST_PUSH ()
;;    6: LREF(2)
;;    7: BNNULL 5                  ; (if (null? l) (reverse! r) (lo ...
;;    9: LREF_PUSH(3)
;;   10: GREF_TAIL_CALL(1) #<identifier reverse!#user x804146d8>; (reverse! r)
;;   12: RET
;;   13: LREF_CDR_PUSH(2)
;;   14: FRAME 4
;;   16: LREF_CAR_PUSH(2)
;;   17: LREF(1)
;;   18: CALL(1)
;;   19: PUSH
;;   20: LREF(3)
;;   21: CONS_PUSH
;;   22: SHIFTJ(2 2)
;;   23: JUMP -18
;;   25: RET

;; なし
;; size: 7
;;    0: GREF_PUSH #<identifier values#user x802ba300>; values
;;    2: CONST_PUSH (1 2 3 4 5)
;;    4: GREF_TAIL_CALL(2) #<identifier map#user x802ba330>; (map values '(1 2 3 4 5))
;;    6: RET

インライン展開されていることが分かる。実際に効果があるか、といわれるとなくは無いがベンチマークレベルで多用しないと目に見えないレベル、の効果だったりする。

これだと高階関数を使用する手続きのインライン展開にしか使えず、定数畳込みはできない。実はもう一段低レベルのマクロがあってdefine-inlinerはそれのラッパーなのだけど、外に見えるようにはしていない。理由は今一APIが気に入らないからだったりする。低レベルのAPIの方が設計が難しい気がしないでもない・・・