TLSライブラリのバグ

WebSocketをTLSで使うためにSNIがサポートされてないといけないという話からバグを発見。元々は、wssでアクセスするとフリーズするという話だったのだが、これSNIが問題ではなく単にバグを踏んでいただけだったという話。

問題はTLSのレコードが複数のハンドシェイクメッセージを持つことが可能であることに起因する。現状の実装では1レコード1メッセージを期待していて、複数のメッセージが乗っていた場合2レコード目以降を捨ててしまうというバグである。(単にRFCの読みが甘かったという話でもある。)

これ結構大きめな問題で、設計からやり直しかねぇと思いながら15分くらい考えたらなんとなく隙間を縫っていけそうな解決案が思い浮んだのでメモ。現状レコードで運ばれてきたメッセージはとりあえず一度に全部取得し、その後先頭バイトを見てメッセージの振り分けをしている。ここで、アプリケーションメッセージ以外のメッセージは取得した内容をバイナリポートに変換して扱いやすくしている。

問題になるのは、変換したポートが空になるまで読んでいないことなのだ。1メッセージ読んだ後に1バイト先を見てやりEOFでないならセッションオブジェクトにでも保存しておけば次に読むのはメッセージであるということが分かるのでソケットにアクセスしにいって無限に待つということもなくなるのではないか、という案。レコードを読む部分の処理とセッションオブジェクトの変更のみで残りの部分は特に問題なくいける気がする。

とりあえず、明日試してみることにする。 しかし、原因を追究するためにRFCを読み直したり、パケットログを取ったりといろいろやったが、ほぼ空回りというのが自分らしいというか・・・

SchemeでJSON-RPC

SchemeでRAM over Httpだとさすがに誰得すぎるというのがあったので、まだ需要がありそうなJSON-RPCにw (どちらも仕事で使っているという点は一緒)

最近自社プロダクトでJSON-RPCを使っている外部インターフェースがあることに気づいた。ついでにその機能をテストする必要も出てきて、毎回SoapUIで作られたテスト用のスクリプトを数個走らせるのはたるいので、えいやっと作った。最新のHEADに入ってる。

JSON-RPC自体は仕様がネットで公開されているので、それを参照してもらうとして、実際にSagittarius上で使うと以下のような感じになる。

(import (rpc json) (rpc transport http))

(define request (make-json-request 'someMethod :params #((p1 . 1) (p2 . 2)))

(let-values (((status header response)
       (rpc-http-request "http://somewhere.com/jsonrpc-service" request)))
  (json-response-result response))

たったこれだけ！

JSON-RPC自体は非常に簡単な仕様なので、JSONを読み書きできるライブラリがあれば実装可能。 HTTPはSRFI-106で頑張ればいけるので、その気になればそこそこポータブルな実装でもいけるかもしれない(やる気はない)。

実装した際に一応気にしたのは、トランスポートとメッセージは可能な限り分離するということ。これは(今のところ予定はないが)他のRPC(Message PackとかXML-RPCとか)をサポートする際に自分が楽をしたいため。ただ、現状どちらの実装も一個しかないので上手いこと分離できてるかは多少不安。ついでに、JSONの読み書きに使っているChicken Schemeからの移植JSONライブラリはベクタをマップとして扱うので多少使い勝手が悪い部分もある(主にレスポンスデータの探索等)。まぁmatchが使えたり、メモリ気にしなくていいなら手間がかかる程度ではあるが・・・

実際のコードは実に合計で500行以下くらいなので、こういうのがサクッと作れる位には下地になるライブラリが揃っているということになる。多分に偏りがあるというか、一転集中型で揃っているだけだが・・・

Sagittarius 0.4.8 リリース

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

修正された不具合

• bytevector-u8-set!が負のインデックスを受付けかつデータを破壊する不具合が修正されました
• マクロ展開でlambdaが未束縛エラーになる不具合が修正されました
• cond-expandがネストした条件を処理できない不具合が修正されました
• bitwise-ior、bitwise-xor及びbitwise-andが0引数を受け付けない不具合が修正されました
• write-emv-tlvが長さバイトを正しくエンコードしない不具合が修正されました

改善点

• bitwise-ior、bitwise-xor、bitwise-and、fxior、fxxor及びfxandのパフォーマンスが改善されました

新たに追加された機能

• bytevector-split-at*及びbytevector-splicesが(util bytevector)に追加されました
• SRFI-106がサポートされました
• CMACライブラリ(rfc cmac)が追加されました
• c-variableマクロが(sagittarius ffi)に追加されました
• QNX (BlackBerry 10)環境でのビルドがサポートされました(x86のみ)
• socket-sendto及びsocket-recvfromが(sagittarius socket)に追加されました

非互換な変更

• let-syntax及びletrec-syntaxの既定の振る舞いがR6RSのものになりました。R5RS/R7RSの振る舞いにするには#!r7rsをつける必要があります。

速度改善

Pure SchemeでCRC32のベンチマークを取った方がいて、ありがたいことにSagittariusも結果に入っていた。

Scheme で CRC 計算の件について、いくつかの処理系で動かして時間を計ってみた。 表の数値は 200MB のデータを対象にしたときにかかった時間。 CRC32 改は値を 16bit ずつに分けて計算するバージョン。 pic.twitter.com/COhgUkOYWv
— (32) 齊藤敦志 (@SaitoAtsushi) August 16, 2013

問題は結果のほうである。後ろから数えた方が早い位置にいる。Sagittariusは最速を目指しているわけではないのだが、(明示してないけど)高速であることも売りにしている。幸いにもソースは公開されていらしたのでプロファイルを取って速度改善に望むことにした。

Fixnumは30ビット幅しかないので(32ビット環境)CRCテーブルの要素ほぼ全てはBignumになると思っていい。これは避けようがないので放置。ざっとソースを見ると(当たり前だが)ビット演算が多用されているので実装を眺める。Fixnum-Bignumの組み合わせの場合にFixnumをBignumに変換してBignum同士で演算するようにしていたので、とりあえずこいつのメモリ割り当てをやめるようにする(ちょこっと改善された)。

次にプロファイルを取る。するとbitwise-xorやたら遅い。実装もまぁ、そりゃ遅いわという感じだったので、ゴリゴリ書き直し。(15%くらい改善)。次いで気になったのでbytevector-u8-refがやたらサンプリングされていた。こんなの単なる配列アクセスだからどれだけ呼ばれてもそんなにあるわけ無いだろうと思ったら実装があほなことをしていたので直す(微々たる改善)。

とりあえず、この段階で既存のものと比較してみた。結果は以下。

$ sash crc.scm

;;  (crc32 data)
;;  121.992214 real    124.3640 user    6.130000 sys

$ ./build/sash.exe crc.scm

;;  (crc32 data)
;;  100.720778 real    101.5090 user    3.6040000915527344 sys

うむむ、まだ遅い。bitwise-xorが処理時間の半分を占めているのでそこの改善がほぼダイレクトに効くのだが、どうやら効かせ方が足りないらしい。

Boehm GCとQNXとBB10と

いろいろ動くようになってきたので多少のメモを含めて。

BB10(Blackberry 10)上でSagittariusを動かせないだろうかというのはそれこそ発売当初くらいから考えていたりする(2月か？)。BB10はQNXをベース(というかOSはQNX)にしたデバイスなのでPOSIX準拠(なはず)。POSIXをサポートしてるんだし、いけるだろう程度にしか考えてなかったのだが、Boehm GCが鬼門であった。

Twitterでも呟いたのだが、Boehm GCの環境依存コードはよく言えば歴史を感じさせる継ぎ足しっぷり、悪く言えば全くもって嫌気がするレベルのコードである。QNX自体は結構歴史あるUNIX系OS(らしい)ので当然サポートされてるだろうなぁ、なんてあまっちょろいことを考えていたのだが、世の中そううまくいくわけはなかった。がっつりパッチを書きました。幸いだったのは、FreeBSD依存のコードとか、OpenBSD依存のコードが結構流用できたので最低限サポートしなければならない部分だけ書けばよかった点かな。最新のHEADはQNX用のBoehm GCのパッチが入ってたりする。できに自身はないので、本家に取り込んでもらおうということは考えていない。

元々はSagittariusのC APIを使って実装しようと思ったんだけど、RIMが提供するIDEでの設定が分からなかったのでbarファイルにsashごと全部放り込んでリモートREPLを立ち上げるというかなり強引な手を使って実現してたりする。ソケット通信なのでセキュリティ等々をもう少し考えないとまずいのだが(俺々証明書作ってTLSで通信するか？)、まぁそれはもう少し後にする。GUIのデザインは正直苦手なのと今一Widgetの融通が利かないのとで多少異常に満足のいかないものになっているのも愛嬌だろう・・・

とりあえず、実装詳細的なもの。

• sashプロセスが立ち上がってもREPLサーバは立ち上がっていない
• 回避するためにサーバが立ち上がったらマークファイル作るようにした
• (exit)を実行するとプロセスごと死ぬ問題
• 死んだことを検地して再起動を促すように
• Qt側のソケットとプロセスの状態をQtのシグナル/スロットで監視
• これ、便利なんだけど、スロット内で他のシグナルを起動するようなことすると意味不明のバグになる
• 既に悩んだ
• しかも、どれがシグナルを送るのか今一わからなかったりするしｗ

ふと思ったのだが、この手法(リモートREPL)で行けば他のモバイルで動かすのも簡単にいけるのではないかと妄想。

以下はTODO

• 起動ポートを設定可能にしたい
• 既に準備はしてある
• 実行履歴があると便利だと思う
• 外部に出す？
• 実機で動かしてみたい
• Blackberry Worldに登録

仕事で山ほどBB7(一つ前のモデル郡の総称)の実機を使ってるのに、BB10の実機はない現実。ここではまだ売ってないので買うという選択肢もないという(まだ北米だけか？もう欧州でも売ってる？買うつもりはないんだけどｗ)。ストレステストみたいなことはしてないので、Boehm GCがまともに動いてるのかは微妙なんだけど(多分動いてると思う)、気になってるのはシミュレータと実機ではCPUが違うこと。実機はARMなんだよね。CPU依存の部分は特に変更なかったと思うから大丈夫だとは思うけど・・・


ということで、だれかBB10ください(違

Porting to BB10

A lot of Scheme implementations are ported to mobile device such as Gambit (iPhone), Mosh(Android), Gauche(iPhone, developing state though). Well, I'm feeling like it's time for me to ride the wave! Unfortunately, I have no developing environment neither iPhone nor Android but Blackberry. So I've so far decided to do with BB10 environment.

First of all, I needed to build Sagittarius on BB10 environment. This wasn't so difficult actually, I just needed to provide proper CMake tool chain configuration and some patches for Boehm GC (which only makes compiler satisfied currently though).

After that, I was trying to use Sagittarius as a library so that the application only needs to do eval and outputs the result. However this wasn't easy for me to handle standard I/Os. On BB10 environment, as far as I know, it is impossible to redirect keyboard input and standard output to GUI panels. So I thought I needed to create custom port to handle these things but I was too lazy to do it. So I've decided to use remote REPL which is already in library.

The basic idea I'm trying to do is really simple. Put all Sagittarius component into bar (Blackbarry ARchive, I guess) file and run the remote REPL as a child process. So what I need to implement is only send user input and receive the result. Then I'm facing a problem that for some reason sash is not executable. So I wrapped with shell which add permission of execution then run it. Now I've got core dump.

What am I missing?

Why I think macro is necessary for programming language!

DRUNKEN ARTICLE CAUTION: the article might not make any sense!

Macro, that is the last resort for all programmers. Macro, it's a sweet temptation. Macro...

Well, if you are familiar with macros and doing job with Java (or any other languages don't have macro), you must be really frustrated like me. I was thinking why I've got so irritated without macros and got a conclusion.

I assume all programmers want to write clean, fast and maintainable code without any inconsistency. Suppose you are a Java programmer and need to write really similar code multiple times and all of the classes are not the same region. In this case, I would create an abstract class or utility class to put all common process in. However I think it's ugly because the abstract class is not the behaviour of the derived class and utility class is not object oriented. Then what is the cleanest and consist way to resolve it? Copy&Paste? I have yet no solution.

If I'm using C++ then I could use template for that situation. It allow me to write common process without creating super class and inject dependency. If I can use Lisp for this situation, this is, I think, the best situation to use macro to avoid code duplication or writing ugly code.

What makes macro so powerful? Well, after writing this I felt I'm so stupid to write such obvious question. If you have written any code, then you must know how powerful modifying source code before it's compiled is. You can feel you became a god or so (not really). So far, I only know the language which allows you to do such free things is only Lisp. It has macro, read macro, reflection, aspect oriented and so on. (Well, even though I listed some other stuff but I'll focus on only macro.) Which other language can make own *syntax* within its language specification?

I know it has also some crappy things like it doesn't allow me to do much things within the specification (Scheme), not so portable between implementations (CL, Scheme) and all. And I think each language needed to decide not to have all *nice to have* features. So everything is trade off but if that's so, I would rather go more comfortable one and to me comfortable means freedom. More precisely, the language which can extend itself if I needed.

Yes, as I expect there is no conclusion nor sense in this article. Don't write something in drunk.

引数の上限

引数の上限を超えるとどうなるだろうと以下の記事を読んで気になった。

Chibi schemeの多値は単に多値オブジェクトで、call-with-values等で明示的に受け取らないと悲しいことになる。もっともChibi schemeのような実装にも、多値の長さに制限がないというメリットがある。nmoshは多値の長さ(= 事実上手続き引数の個数制限)が100程度に制限されている。現状のSchemeではこの制限をクエリする良い方法が無い。

引数個数制限はご無体な気もするが、Cの呼び出し規約のように関数呼び出しをスタック経由で行う規約は基本的にヒープサイズ制限よりもスタック長制限が先に来る。常識的に考えて固定arityの引数が100を越えることは無いので、可変arityの手続きの呼び出し規約をスタック渡しとオブジェクト渡しに分けるのは効果的かもしれない。
[scheme][nmosh] Unspecifiedの数とarity - .mjtの日記復帰計画

まぁスタックサイズに限界はあるわけだし、SEGVのが普通かなぁと思いつつ、以下のスクリプトを用意。

(import (rnrs) (only (srfi :1) iota))

(define-syntax apply-100000-values
  (lambda (x)
    (syntax-case x ()
      ((k)
       (with-syntax (((v ...) (datum->syntax #'k (iota 100000))))
         #'(list v ...))))))

(apply-100000-values)
(display 'ok) (newline)

以下はGauche用

(define-macro (apply-100000-values)
  `(list ,@(iota 100000)))
(apply-100000-values)
(apply-100000-values)
(print 'ok)

でっ、結果。(Chezはiotaを自前実装した。Chibiは低レベルマクロの使い方が分からないので割愛。)

Chez - ok
Gauche - SEGV
Mosh - ok
Sagittarius - 返ってこない(マクロの展開が終わらなかった)
Ypsilon - ok

意外だなぁと思ったのはMoshで、以前valuesに10000以上の個数をapplyするとSEGVるというバグを報告している経験からこけるものだと思っていた。(スタックを壊してる可能性があるので、他の操作をしたら予期しない場所でこける可能性はあるが。)

Chez及びYpsilonはどうして動いているのかは分からない。

Why does this call/cc go into infinite loop?

I've found interesting call/cc stuff in Chaton's Gauche room (this)

The code is this one;

(let ((x 0) (cc '())) 
  (set! x (+ x (call/cc (lambda (c) (set! cc c) (c 1)))))
  (if (< x 4) (cc 2) x))

As far as I investigate, Chez, Chicken, Mosh, Sagittarius and Ypsilon went infinite loop. Chibi and Gauche returned 5. Well I'm not a guy from continuation world so I can't say which is correct. However if the call/cc is located to left hand side, then it won't be infinite loop.

;; This returns 5
(let ((x 0) (cc '())) 
  (set! x (+ (call/cc (lambda (c) (set! cc c) (c 1))) x))
  (if (< x 4) (cc 2) x))

It seems the order of evaluation so I can probably get the answer.

I don't know about other implementations but Sagittarius so following guess is based on its call/cc implementation.

On Sagittarius, continuation is stack and it contains return address. So call/cc captures arguments and return address. Following is the image;

#first one
before call/cc
 +----------+
 |   cont   |
 +----------+ <- captured
 |   pc(+)  |
 +----------+
 |    x=1   | *1
 +----------+
 | pc(set!) |
 +----------+

#second one
before call/cc           after call/cc
 +----------+             +----------+
 |   cont   |             |    x     |   
 +----------+ <- captured +----------+
 |   pc(+)  |             |   c(1)   |
 +----------+             +----------+
 | pc(set!) |             |   pc(+)  |
 +----------+             +----------+
                          | pc(set!) |
                          +----------+

NOTE: pc is return address, cont is call/cc's argument. 
      Stack is growing upwards.

Well it's already obvious but I will describe just in case.The point is *1. The first one, the x is not a box means it's mere value (in this case 1). Then call/cc will capture the stack with the value. So the second call of (cc 2) will always be addition of 1 and 2. Thus it will never be greater than 4. On the other hand, the second case, stack doesn't have x yet so that VM will always compute what is inside of the box (x). Then (cc 2) will always compute the value of x and 2.

I think implementations caused infinite loop are using the similar method to implement call/cc as Sagittarius and Chibi and Gauche use something different. And again, I'm not the those guys from continuation world, so can't say which is correct or not but as my understanding both can be correct and this case is sort of edge case of call/cc.

Bignumの速度改善(調査編)

SBCLがGMPを使うようになったらしく、こんなツイートをもらった。

これで @tk_riple さんの第二次VS SBCL Bignum戦争開幕？
— llibra (@l_libra) July 5, 2013

期待されているなぁ・・・相手GMPだけど・・・

期待されると応えようともがく性分なので、とりあえず現状でどれくらいGMPと差があるのか適当にテストしてみることにした。GMPと言えばMoshが使っているのでここと比較。なぜか？機械語吐き出すSBCLと戦う前に同じバイトコードなScheme処理系のMoshを倒さないとオーバーヘッドの部分で確実に負けることが確定しているから。

テストコードは以下(ここのPython用のをSchemeに移植)：

(import (rnrs) (time))

(define (factorial n stop)
  (let loop ((n n) (o 1))
    (if (> n stop)
        (loop (- n 1) (* o n))
        o)))

(define (choose n k)
  (/ (factorial n k) (factorial (- n k) 0)))

(time (choose 50000 50))
#|
;; Mosh用timeライブラリ
;; time.scm
(library (time) (export time) (import (mosh)))
|#

以下が結果。

% time sash test.scm

;;  (choose 50000 50)
;;  6.536399841308594 real    11.13800 user    1.669000 sys
sash test.scm  11.17s user 1.76s system 194% cpu 6.661 total

% time mosh --loadpath=. test.scm

;;1.4351999759674072 real 1.264 user 0.172 sys
mosh --loadpath=. test.scm  1.28s user 0.20s system 99% cpu 1.482 total

まぁ、分かってはいたのだがここまで差があるのか・・・
SagittariusはBoehmGCがGC用スレッドを持ってるからRealとUser時間が倍違うのか？とりあえずReal時間だけ気にすることにする。

このベンチだと単純に乗算だけなんだけど、とりあえずそこからか・・・先は長そうである・・・

Loop macro for Scheme

The inspiration came from this article's comment: 10.times - Island Life

I'm not a CL user but I sometimes think CL's loop macro is really convenient if I want to write something really small. (I don't think I want to write big stuff with it. It's too complicated to me.) So why don't I write something looks like it?

Here is that something. It doesn't cover whole loop macro but some.

#!r6rs
(import (except (rnrs) for-each map) (only (srfi :1) iota for-each map))

(define-syntax %loop
  (syntax-rules (:for :in :do :repeat :collect)
    ((_ (vars ...) (body ...) op :for var :in l rest ...)
     (%loop ((var l) vars ...) (body ...) op rest ...))
    ((_ (vars ...) (body ...) op :repeat n rest ...)
     (%loop ((tmp (iota n)) vars ...) (body ...) op rest ...))
    ((_ (vars ...) (body ...) op :do expr rest ...)
     (%loop (vars ...) (expr body ...) for-each rest ...))
    ((_ (vars ...) (body ...) op :collect expr rest ...)
     (%loop (vars ...) (expr body ...) map rest ...))
    ;; last
    ;; do trivial case first
    ((_ () (body ...) op)
     ;; infinite loop
     (do () (#f) body ...))
    ((_ ((var init) ...) (body ...) op)
     (op (lambda (var ...) body ...) init ...))))

(define-syntax loop
  (syntax-rules ()
    ((_ clause ...)
     (%loop () () #f clause ...))))

#|
(loop :for i :in '(1 2 3 10) 
      :for j :in '(4 5 6)
      :do (begin (display i) (display j) (newline)))

(loop :repeat 10 :do (begin (display 'ok) (newline)))

(display
 (loop :for i :in '(1 2 3 10) 
       :for j :in '(4 5 6)
       :collect (+ i j))) (newline)
;; (loop :do (begin (display 'ok) (newline)))
|#

I'm not sure if this is useful or not and I don't want to go deep inside of the crucial loop macro specification either, though :-)

NOTE: I've tested above code Racket (plt-r6rs), Mosh, Ypsilon and Sagittarius but Ypsilon raises an exception when the given list length are not the same.

TLSとFTPと

FTPライブラリを書いてたらTLSにバグが混入しているのを発見。しかも、0.4.4から紛れ込んでいたものだったという切ないものだった。まぁ、TLS周りはテストを書いていないので発見しようが無かったという話ではあるのだが、あんまり使わないんだなぁ自分でも・・・テスト大事だよ！(どうテスト書こう、テスト用にサードパーティの何かを入れるのは嫌だが、セキュリティ周りのテストを自家製だけで書くのはまずいし、さてさて・・・)

まぁ、原因はSRFI-6の挙動をポートから取り出してもポートを空にしないように直した際のバグなのだが、何しろ3ヶ月前のこととあまり直接的な原因ではないこともあいまって最初はどこが悪いのかさっぱり分からんかったりした。っで、どう見つけたか？もうね、ローラー作戦ですよ。0.4.3までソースを巻き戻してどこで起きるかというのを一個ずつ潰していくという何とも地味な作戦。0.4.3から0.4.4の間ではBignumのパフォーマンス改善してたのでそこかなと当たりをつけてたらまんまと外れたという、思い込みもよくないという話。

原因が分かれば直すのは簡単で、さくっと直してFTPの実装を再開。データコネクション周りが実は面倒だということが発覚して、どうしようというのが現在直面している課題。

問題になるのはアクティブモードなのだが、クライアント側がサーバソケットを作ってFTPサーバからの接続を待つ必要があるのだが、現状のソケットライブラリでサーバソケットを作るとgetsocketnameで取れるアドレスがループバックアドレス(0.0.0.0)になってしまう。じゃあと思ってAI_PASSIVEを外してやると今度は127.0.0.1が取れるのだが、これって他のサーバとやり取りできないよなぁという感じでごにょごにょしている。(どうでもいいのだが、socket-nameというAPIがあるんだけど、こいつが非常に紛らわしくなっているので変更してやろうと思っていたりする。) 普通にNICに割り付けられたIPアドレスを取る方法ってないのだろうか？

どうでもいいのだが、職場のFTPはFTPSは受け付けていないという事実が分かって驚愕している・・・SFTPじゃないとだめなのかよ・・・orz

ほしいライブラリ

ちょっと開発意欲が低下気味な6月、ほしいものはあるんだけどモチベーションが高まらないというなんともだめな感じである。

とりあえず、何がほしいかをメモっておいて後で頑張ろうという先送り作戦を展開してみんとす。といっても、今のところは2つしかないんだけどね。

【Lexer】
CのヘッダをパースしてFFIのバインディングを吐き出すような何かを作ろうとしているんだけど、Packratという強力なパーサジェネレータはあるくせにLexerは毎回手書きという切ない状態にある。 ということで、Packratで使えるLexerを生成する何かしらがほしい。妄想的に以下のように書けると嬉しいかもしれない。

(define generator
  (lexer
    (D #("0-9"))    ;; vector indicates a charset?
    (L #("a-zA-Z_"))
    ...
    ("/*" comment)  ;; here comment is a procedure takes one argument which is a port?
    ("auto" 'AUTO)  ;; returns token kind?
    ...
    ((/ "[" "<:") '#\[)
    ...))

細かいことは全然考えてないのだけど、とりあえずこんな感じでルールを書いたら適当にLexerを作ってくれる何かしらな感じ。RacketにLexerジェネレータなライブラリがあるから参考にしようかと考えている。(Pure Schemeな実装があったら是非教えてほしいなぁ)

【FTP】
仕事でちょいちょいFTPでwarを上げてJBossにデプロイなんてことがあるんだけど、現状でMavenをSchemeで叩いているのだから出来上がったwarもSchemeで上げてしまえたら一手間減るよなぁと考えている。FTPなんて実装はどこにでもあるわけだし移植するだけなんだけど割りと億劫になっているのと、APIをどうしようとか、TLSなソケットも使えるようにしてFTPSもサポートしないと使い物にならんとか考えていて手が動いていない状態。まぁ、なんとなく構想ができてきている段階ではあるので、テスト用の環境をでっち上げて作るだけではあるのだが・・・

個人的にはIMAPとかあるとiPhoneで音が鳴ったら適当にシェルからメールがチェックできたりして便利かもとか考えていたりはする。まぁ、これは必要に迫られていないので妄想すらないが・・・

Sagittarius 0.4.6リリース

Sagittarius Scheme 0.4.6がリリースされました。今回のリリースはメンテナンスリリースです。ダウンロード。

修正された不具合

•  parameterize内でcall/ccを使うとパラメタの値が正しく復帰しない不具合が修正されました
• パラメタの束縛を変更しても変更が反映されない不具合が修正されました
• define-libraryで(scheme base)をインポートしないとcond-expandが使えない不具合が修正されました
• define-classが他のライブラリに依存している不具合が修正されました
• #x800000がマイナスの値を返す不具合が修正されました
• (sagittarius mop validator)のobservevrがエラーを投げる不具合が修正されました
• 組込み総称関数がSEGVを起こす不具合が修正されました
• current-jiffyが正確な整数を返さない不具合が修正されました
• ((and and))がREPL上でSEGVを起こす不具合が修正されました
• datum->syntaxが正しく構文オブジェクトを作成しない不具合が修正されました
• importがexcept句を無視する不具合が修正されました
• 組込み総称関数が:primary以外のqualifierを持てない不具合が修正されました
• list-sortが第一引数をチェックしない不具合が修正されました
• make-bytevectorの第一引数にマイナスの値を渡すとSEGVを起こす不具合が修正されました
• (clos user)をprefixインポートした際にunbound variable例外が投げられる不具合が修正されました

改善点

• define-c-structが局所的に扱えるようになりました
• FFIがwchar_t*を扱えるようになりました
• c-functionが可変長引数を扱えるようになりました
• MOPがより柔軟になりました
• コンパイラが使用されていないインストラクションを生成しないようになりました

新たに追加された機能

• object->pointer及びpointer->objectが(sagittarius ffi)に追加されました

CLライクな未定義シンボルハンドリング

正直あってもあまり使いどころは無いのだが、面白いことに使えるかなと思い実装してみた。

仕組みはいたって簡単で、総称関数unbound-variableを追加して、VMが未定義シンボルを検出したらそれを呼び出すだけ。デフォルトでは普通に&undefinedを投げるんだけど、たとえばこんなメソッドを追加してやるとCLっぽく動くようになる。

(import (rnrs)
        (sagittarius debug)
        (sagittarius vm)
        (clos user))

(define-method unbound-variable ((name <symbol>) lib)
  (format (current-error-port) "**** unbound variable ~s~%" name)
  (format (current-error-port)
          "use-value   :r1 Input a value to be used instead of ~s~%" name)
  (format (current-error-port)
          "store-value :r2 Input a new value for ~s~%" name)
  (format (current-error-port)
          "abort       :r3 Abort (raise unbound variable error)~%")
  (let loop ()
    (format (current-error-port) "break >")
    (case (read)
      ((:r1) 
       (format (current-error-port) "Use instead of ~a:" name)
       (read))
      ((:r2)
       (format (current-error-port) "New ~a:" name)
       (let ((e (read)))
         (%insert-binding lib name e)
         e))
      ((:r3) (call-next-method))
      (else (newline (current-error-port)) (loop)))))

(print test)
(print test)
(print test)

正直、これがうれしいかといわれると、微妙なところではあるが。使いどころは無いんだけど、REPL上でデバッグするときに便利だろうか？(ただ、あんまり何も考えてないので、この中で例外投げたらどうなるとか全く気にしてなかったりする・・・HEADにあるけど消すかも・・・)

How should include work?

There was a post which asked the behaviour of the include syntax in R7RS. This is the post;

Dybvig's paper about syntax-case, I'm unsure abouttherequirements
of R7RS regarding the use of `include' within macros:

(define-syntax m
   (syntax-rules ()
     ((_) (lambda (a) (include "some/file.sch")))))

where the file "some/file.sch" contains, say,

(+ a 1)

Is the symbol `a' in "some/file.sch" supposed to match the
lambda's argument?

[Scheme-reports] file inclusion (section 4.1.7 of draft 9)

Then R7RS draft 9 says like this;

Both include and include-ci take one or more names expressed as string literals, apply an implementation-specifi c algorithm to find corresponding files, read the contents of the files in the specified order as if by repeated applications of read, and e ffectively replace the include or include-ci expression with a begin expression containing what was read from the files.

So in R7RS include reads from the specified file with read without any syntax information. So, in above case it shouldn't refer the lambda's argument.

Now, John Cowan responded a lot of implementation could see the variable a. Well, yes, this is odd. However I think I know why (only R6RS implementation wise).

Following is the (naive) implementation of the include with R6RS syntax-case

(import (rnrs))
(define-syntax include
  (lambda (x)
    (define (do-include k name)
      (call-with-input-file name
        (lambda (in)
          (do ((e (read in) (read in)) (r '() (cons (datum->syntax k e) r)))
              ((eof-object? e) (reverse r))))))
    (syntax-case x ()
      ((k name)
       (string? (syntax->datum #'name))
       (with-syntax (((expr ...) (do-include #'k (syntax->datum #'name))))
         #'(begin expr ...))))))

The point in R6RS is that syntax-case must always return syntax object so with this implementation, the included expressions wrapped (or converted) by syntax object so that a contains some syntactic information to refer the lambda's argument. (Unfortunately, Sagittarius raises an error with unbound variable. Well, I know it's a bug...)

Then we need to come back to what R7RS says. Yes, it actually doesn't specify but read the file content by read and replace it. Thus, both behaviours can be valid as my understanding.

Now, my big problem is that I need to fix the macro's bug... I thought it could see it but it didn't...

FFIとcallback

最近FFI周りばかり弄っている気がする。取り立てて必要というわけではないのだが、バグが目に付くというか、一貫性の無さが気に入らないというかそんな感じ。

っで、ふとcallbackの実装がメモリ使用量的に嬉しくないことに気づいた。

現状の実装ではcallbackは作られるとSagittariusの静的領域に保存される。これは「呼び出したC関数内でcallback関数が保存された後にGCが走ってcallbackは回収されちゃったけどCから呼び出されちゃった、てへっ♪」って言うのを防ぐためだったりする。FFIで開いた共有オブジェクト内のことはGCは気にしてくれないし、ついでにそこに渡されるcallbackはlibffiが割り付けたメモリなのでそもそもGCはたどることすらできない。

まぁ、callbackなんてそんなに使わないからいいかと言えばいいのだが、たとえばうっかり100万回回るループの中で10個ずつ作成しました！なんてことが起きる可能性が無いわけではない。実際、書く方としてはわざわざ開放してやるなんてことをしたくはないだろう。(推奨してはいないが・・・)

ただ、そうするとどうにかして自動で開放してやる仕組みが必要になるのだが、 どこか見知らぬアドレスに格納されたGC管理外メモリのことなんて知る由もないわけで、いい案どころか無理ゲーな感じが否めない。

なにかしら、適当な落としどころがほしい感じである。

FFIの可変長引数

必要がないのでサボっていたのだがGTKのバインディングをまじめに考えるなら必要になることがわかったのでちょっと頑張って実装してみた。

こんな感じで使える

(import (rnrs) (sagittarius ffi))

(define libc (open-shared-library "msvcrt.dll" #t))

(define snprintf (c-function libc int _snprintf (char* ___)))

(let ((buf (make-bytevector 10)))
  (snprintf buf 10"%d:%s\n" 100 "test")
  (print (utf8->string buf)))

(snprintf) ;; error

まだ実装が適当(与えられる引数の制限が多い)なのと、libffiのバージョンによっては正式にサポートされていないので警告文が出たりする(ぱっとソース見た感じだと特殊な処理が必要なアーキテクチャの方が少ないみたいだし、メジャーどころは要らなさそうなので、デフォルトで警告を出す必要は無いかもしれないが・・・)。

libffiで可変長の引数を扱うのは結構泥臭くて、呼び出し側は全ての引数を把握していないといけないのと、*残り*みたいな引数型はないのでffi_storageを引数個確保しておく必要がある。この制約のせいで通常の関数とは違って多少オーバーヘッドがかかるようになってしまった。

通常はC関数オブジェクトの作成時に必要な領域(引数型情報の配列)を確保しているのだが、可変長の場合は呼び出しごとに作成する必要がある。利便性を取るか速度を取るかといった感じである(ベンチマークとってないのでどれくらい性能に影響を与えるかは分かっていなかったりするが)。

あと、コールバックは可変長に対応していなかったりする。今のところ必要な場面が思いつかないのと、可変長引数を受け付けるコールバックを見たことがないというのが理由。まぁ、単なる手抜きである。

MOP improvement(?)

On Sagittarius,  MOP was not totally compatible with Tiny CLOS's MOP. That's because of my laziness. However I have noticed that once I use non builtin generic class, then it's not possible to use method qualifiers. This is not good to me. So I have improved some stuff.

The problem was that it was only implemented in C code and not in Scheme code so once I used custom generic class then it won't check those qualifiers. So I have removed builtin compute-applicable-method and moved to Scheme. Then implemented all required procedures and duplicated the logic in Scheme. (I actually don't want to do this but so far I couldn't find any better way.)

Now, I can do something like this;

(import (rnrs) (clos user) (clos core) (srfi :1))
 
(define-class <my-generic> (<generic>) ())
(define-generic foo :class <my-generic>)

(define-method compute-applicable-methods ((gf <my-generic>) args)
  (let ((m* (generic-methods gf)))
    (let-values (((supported others)
                  (partition (lambda (m) 
                               (memq (method-qualifier m)
                                     '(:before :after :around :primary)))
                             m*)))
      (for-each (lambda (m) (remove-method gf m)) others)
      (let ((methods (call-next-method)))
        (for-each (lambda (m) (add-method gf m)) others)
        (append others methods)))))

(define-class <human> ()())
(define-class <businessman> (<human>) ())
(define-method foo :append ((h <human>))
  (print "something else")
  (call-next-method))

(define-method foo :around ((h <human>))
  (print "human around before")
  (call-next-method)
  (print "human around after"))

(define-method foo :before ((h <human>))
  (print "human before"))
(define-method foo :before ((b <businessman>))
  (print "businessman before"))
 
(define-method foo ((h <human>))
  (print "human body"))
(define-method foo ((b <businessman>))
  (print "businessman body"))
 
(foo (make <businessman>))
#|
something else
human around before
businessman before
human before
businessman body
human around after
|#

I have no idea what I'm doing in above code!! Well, default implementation of method qualifier refuses non supported keywords so first remove other keywords from generic function then compute builtin qualifiers and adds the removed ones. At last append the non supported qualifier methods in front of the computed ones. The result is the other qualifier one is called first then the rest. If you put this append after the around method then all methods need to call call-next-method otherwise it won't reach there.

I have no idea if I will use this or not but at least I have something if I want to change the behaviour!

総称関数の:beforeとか

ほぼ初めて実用でこの辺の機能を使おうとしてふと不満に思ったこと。

SagittariusのCLOSはXeroxのTiny CLOSの動作を基本にして作られていて、:beforeとかもその動作を元にしている(たぶんこれは以前にも書いた気がする)。っで、ふとそれだとまずいというか、嬉しくないなぁというパターンが出てきて、ちょっと動作のおさらいをしている。

とりあえずは、以下のコード

(import (rnrs) 
        (rename (clos user)
                (define-class %define-class)
                (define-method %define-method))
        (srfi :0))

(define-generic foo)
(define (print . args) (for-each display args) (newline))
(cond-expand
 (mosh
  (define-syntax define-class
    (syntax-rules ()
      ((_ name parents (slots ...))
       (%define-class name parents slots ...))))
  (define-syntax define-method
    (syntax-rules (:before :after :around)
      ((_ name :before (specifiers ...) body ...)
       (%define-method name 'before (specifiers ...) body ...))
      ((_ name :after (specifiers ...) body ...)
       (%define-method name 'after (specifiers ...) body ...))
      ((_ name :around (specifiers ...) body ...)
       (%define-method name 'around (specifiers ...) body ...))
      ((_ name (specifiers ...) body ...)
       (%define-method name (specifiers ...) body ...)))))
 (sagittarius
  (define-syntax define-class (identifier-syntax %define-class))
  (define-syntax define-method (identifier-syntax %define-method))))

(define-class <human> ()())
(define-class <businessman> (<human>) ())
(define-method foo :before ((h <human>)) 
  (print "human before"))
(define-method foo :before ((b <businessman>)) 
  (print "businessman before"))

(define-method foo ((h <human>)) 
  (print "human body"))
(define-method foo ((b <businessman>)) 
  (print "businessman body"))

(foo (make <businessman>))
#|
businessman before
human before
businessman body
|#

まじめに書いてないのでまともに動きはしないのだが、Moshとの互換レイヤが入っている。気になるのは出力結果。動作を合わせてあるので現状は同じ出力を返すのだが、「human before」はcall-next-methodがあった場合にのみに出力されてほしい気がする。というか、そうじゃないと綺麗に書けないコードを書いていて、もにょっている感じ。

本家のCLではどうなっているのかもついでに試してみた(これも以前試したっけ？)

(defclass human () ())
(defclass businessmane (human) ())

(defmethod foo :before ((h human)) (print "before human"))
(defmethod foo :before ((h businessmane)) (print "before businessmane"))

(defmethod foo ((h human)) (print "body human"))
(defmethod foo ((h businessmane)) (print "body businessmane"))

(foo (make-instance 'businessmane))
#|
"before businessmane"
"before human"
"body businessmane"
|#

あぁ、本家もそうなのか。そうなると逸脱するのも微妙だなぁ・・・