Reviewing 2014

I usually write this things in Japanese but I've heard couple of times that I'm writing cryptogram language so just decided to write in common language, in this case English (well writing in Dutch is still too hard for me...)

Describing 2014 in one word, then it would be change. It's not taken from what the US president said. I think I started taking challenges at some point, probably in March or April, then the changes started happen.

[Private]
I don't write a lot in this topic but just some for my memo.

• Things are moving forward (not sure if it's good way or not, yet).
• I've had my shoulder dislocated. It was my very first time in lifetime (ouch!)
• Leaving current job.
• Went to Japan twice a year. (Congrats my friend, be happy!)
• I need to send pics and videos. Oh gosh, totally forgot about it...
• Went to Washington D.C.
• Became level 8 Schemer. (See Scheme section)

[Scheme]
I've joined LISP Library 365 to introduce SRFIs.I wrote only 3 times a month so there was no way to write introduction for all SRFIs (in the end it ended up to SRFI-42 except the last one). Not sure if there is a person thought that's useful though...

I've submitted a paper for Scheme Workshop 2014 and accepted in October. So I went to Washington D.C. to make the presentation. I struggled writing the paper but it worth it. (thought I'm not sure if I want to do it again because I'm not good at writing...) Now, I'm a level 8 Schemer :) (although, I still think call/cc is difficult and avoid to use...)

I've made R6RS portable library json-tools and R7RS portable PostgreSQL binding. I thought json-tools was made last year (2013) but it was this year. At some point, time doesn't fly. Unfortunately, they are not needed by anybody (even including me by now but I can't predict the future). Writing portable libraries actually doesn't make my day but sometimes it's good to do it to see how much Scheme can do. Some people say it's only for educational purpose which I totally disagree. It just doesn't have enough of useful portable libraries.

I could release Sagittarius monthly this year (except December, I was a bit too busy). As always, I can't remember how it was in the beginning of the year. I'm not yet satisfied it so it will evolve next year. These are the things I want:

• Better performance
• It's not slow but not fast enough for me
• Debugging utilities
• I want to stop doing print debug
• More libraries
• It even doesn't have a library handling cookies, geez
• R7RS-large support
• Currently all R7RS-large libraries are supported

It's all basic things but no priority nor promise. Unfortunately, Sagittarius is not a popular Scheme implementation so I hardly get any feedback. So it's hard to see what's missing for other users. Above items are just what I want and may not for what users want. Plus, I often change my mind :)

In these couple of years, it feels one year is forever long. This is probably because I'm doing a lot of things. I wish 2015 will also be forever long year.

datum->syntaxに潜む罠

マクロ関連のバグの話(もう何度目だろう・・・)

R6RSにはdatum->syntaxという手続きがある。あるデータ(シンボル、リスト何でも可)を構文オブジェクトに変換するというものである。基本的な考え方は非常に簡単で、第一引数で受け取った構文情報を第二引数で受け取った値に付与して返すと思えばよい。これを使うことでスコープを捻じ曲げることが可能になる。

さて、本題はここから。端的なバグは以下のコード：

(import (rnrs))

(define-syntax let-it
  (lambda (x)
    (define (bind-it k binding)
      (syntax-case binding ()
        ((var . val) 
         (let ((name (syntax->datum #'var)))
           #`(#,(datum->syntax k name) val)))
        (_ (error 'let-it "invalid form"))))
    (syntax-case x ()
      ((k ((var . val) rest ...) body ...)
       (with-syntax (((var1 val1) (bind-it #'k #'(var . val))))
         #'(let ((var1 val1))
            (let-it (rest ...) body ...))))
      ((_ () body ...)
       #'(begin body ...)))))

(let-it ((name . 'name)) name)

まぁ、特に何もない単にlet*を使いにくくしただけのコードなのだが、Sagittariusではこれがエラーになる。バグは敢えてdatum->syntaxで変換している箇所にある。一言で言えば、kの構文情報では変数の参照が出来ないというものである。実はこのケースのみだけで言えば直すのは簡単なのだが、let-itが局所マクロで定義された際等がうまくいかない。

自分の頭を整理するために多少問題を詳しく書くことにする。このケースでは最初のnameはlet-itが使用された際の構文情報を持つが、二つ目のnameとはeq?での比較において別の識別子となる(ちなみにdatum->syntaxを使わなかった場合においてはマクロ展開器は同一オブジェクトにする)。この場合に環境の参照が同一の環境を持つ識別子を同一識別子と見なさないのでエラーとなる。なお、この挙動は歴史的理由(主に僕の無知)によるところが多い・・・

ここで、同一環境を含む識別子を同一オブジェクトとした場合に起きる問題を見る。マクロ展開器は以下の場合において識別子の書き換えを行わない：

• 識別子がパターン変数の場合
• 識別子がテンプレート変数の場合
• 識別子が既に局所的に束縛されている場合

上記二つは特に問題にならないのだが、3つ目が以下のコードにおいて問題になる：

(let ()
  (define-syntax let/scope
    (lambda(x)
      (syntax-case x ()
        ((k scope-name body ...)
         #'(let-syntax
               ((scope-name
                 (lambda(x)
                   (syntax-case x ()
                     ((_ b (... ...))
                      #`(begin
                          #,@(datum->syntax #'k
                                (syntax->datum #'(b (... ...))))))))))
             body ...)))))

  (let ((xxx 1))
    (let/scope d1
      (let ((xxx 2))
        (let/scope d2
          (let ((xxx 3))
            (list (d1 xxx) ;; *1
                  (d2 xxx)
                  xxx      ;; *2
                  ))))))
)

同一環境を持つ識別子を同一識別子とみなすと、上記の印をつけた変数が両方とも3
を返す。マクロ展開器が識別子の書き換えを行わないため、全てのxxxが同一環境を持つからである。
これだけ原因がはっきりしているのだからマクロ展開器が展開するごとに識別子を生成しなおせばいいような気がしないでもないのだが、上記の歴史的理由により環境を参照するコードが自分でも理解不能な複雑怪奇なことになっているためなかなか手が出せないでいる。ここは一発腹を決めるしかないか。

追記：
上記のletで束縛されるxxxは最初のもの以外は全て同一の環境を持つ識別子に変換される。っで、(d1 xxx)は正しく最初のxxxのみをもつ、つまり変換された識別子と同一の環境をもつ、識別子に変換されるので環境の頭にある3が束縛されたxxxにヒットする。

問題はどうこれを解決するかなんだけど、ぱっと思いつく解決方法としては、束縛が発生するたびに識別子の書き換えを行い適切な環境に変更してやるというものだろうか。それをやることのデメリットとしては：

• 式一つコンパイルするのにO(n^2)のコストがかかる
• コンパイラが持つ構文全てをいじる必要がある

あたりだろうか。最初のはライブラリになっていればキャッシュが効くので初回のみと割り切れなくもないのだが、二つ目のが辛い。バグを埋め込まない自信がないという話ではあるのだが、コンパイラはかなりの数(10以上)の束縛構文を知っているので全て書き換える必要がある。ものぐさな僕には辛い話である。マクロ展開器の方でやれないか考えてみたのだが、それ自体は束縛構文が何かということを知らないのでどの識別子を書き換える必要があるのかが分からないという問題がある。とりあえず直せる部分だけ直して寝かせる方針かなぁ、いつもどおり・・・

SRFI-117の紹介

(LISP Library 365参加エントリ)

今回は最新のドラフトSRFI-117を紹介します。今年一年SRFIの紹介をしてきましたが、今回が最終回になります。そこで現在SRFIのMLで議論されている最新のSRFIを紹介してみたいと思います。

SRFI-117はR7RS-largeにも提案されているSRFIです。このSRFIではリストを用いたキューを定義します。もともとはQueueという名前をそのまま使っていたのですが、議論の中でAPIの説明が実装に踏み込みすぎているという指摘から最近名前をリストキューに変更しました。

まだ最終ではないのでAPIは変わるかもしれませんが、以下のように使うことが可能です。

(import (srfi 117))

(define q (make-list-queue '(1 2 3)))
;; -> queue

(list-queue-front q)
;; -> 1

(list-queue-remove-front! q)
;; -> 1
;; queue will contain only 2 and 3 after this

実装が見えるといったのは、このSRFIではAPIの説明ほぼ全てにオーダーが指定されています。例えば、list-queue-remove-front!はO(1)で終了しなければならず、またlist-queue-remove-backはO(n)で終了する必要があります。

議論の中で話題になったのはコンストラクタAPIで、make-list-queue(元はmake-queue-from-list)がO(1)を指定しかつ与えられたリストが共有されなければならないというもので、これだと処理系が提供するキューがこのSRFIをサポートできないというものです。これにより、キューという一般的な名前からリストキューというより実装を表して名前に変更になりました。もしかしたら将来のSRFIで下請けのデータ構造に依存しないキューのインターフェース的なものが出てくるかもしれません。

ここでSRFIのプロセスとR7RS-largeへの提案のプロセスを簡単に説明します。R7RS-largeはSRFI上で議論されたものがscheme-report.orgのML上で決を採られます。有効票のうち半数以上が賛成であればR7RS-largeに取り入れられます。流れとしては

1. SRFIに提案する
2. scheme-report.orgのMLに上記のSRFIをR7RS-largeに提案すると宣言する
3. SRFIのML上で議論する
4. 最終SRFIになる
5. scheme-report.orgで決を採る

というものになります。現状R7RS-largeに提案されたSRFIは111、112、113、114、115、116で、111と112が正式に採用されています。(残りは決を取っていないはずですが、ひょっとしたら見落としているかもしれません。)これらのSRFIはSagittariusでサポートされているので(113、114及び116
は0.6.0以降)興味があれば試してみると面白いかもしれません。

今回はドラフトSRFI-117を紹介しました。

SRFI-42の紹介

(LISP Library 365参加エントリ)

SRFI-42は先行内包(訳:Scheme 翻訳規約)を定めたSRFIです。CLのloopのScheme版と思えばいいかと思います。このSRFIができることはかなり多く全てを紹介するのは難しいので触りだけみてみましょう。

(import (srfi :42))

(list-ec (: i 5) i)
;; -> (0 1 2 3 4)

(list-ec (: n 2) (: m 3) (cons n m))
;; -> ((0 . 0) (0 . 1) (0 . 2) (1 . 0) (1 . 1) (1 . 2))

(list-ec (:parallel (: n 3) (: m 3)) (cons n m))
;; -> ((0 . 0) (1 . 1) (2 . 2))

こんな感じで任意個数要素を持つリストを作ることが可能です。list-ec等のマクロは最後の式が評価結果として帰り(do-ecを除く)、それ以前の式で量子を指定します。量子はデフォルトでは入れ子になるので、同時に行う場合には:parallelで囲う必要があります。

SRFIで定義されている名前がSchemeの型から始まる場合は(例：list, vector)は最後の式が返した値の要素で満たされたものが返ります。戻り値が必要ない場合はdo-ecを使います。

(do-ec (: i 5) (print i))
;; prints: 
;; 0 
;; 1
;; 2
;; 3
;; 4
;; -> unspecified value

C等にあるwhileのようなことも以下のようにできます。

(string-ec (:while (: i 10) (< i 10)) #\a)
;; -> "aaaaaaaaaa"

:whileは最初の式で値を生成し、二つ目の式で終了条件を指定します。whileというよりはforに近いかもしれません。

これ以外の機能やジェネレータの拡張などScheme版loopと呼ぶにふさわしくいろいろ盛りだくさんなSRFIです。(正直なところかなり限られた機能しか使っていないのでよく分かっていないというのが・・・求む詳細な解説)

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

SRFI-41の紹介

(LISP Library 365参加エントリ)

SRFI-41はストリームを扱いSRFIです。 元々はSRFI-40があってそれが廃止になり、初のR6RS用SRFIとして決定されたという経緯があるみたいです。MLからは時系列が今一把握できないのでどういう風に遷移したのかは単なる推測です。どうでもいいのですが、SRFI-40は2004年8月22日に最終になり、SRFI-41は2007年10月21日に最初のドラフトが出ているのですが、後続のSRFI-42が2003年2月20日に最初のドラフトが出ていて、どういう経緯で番号をねじ込んだのかとかが気になってたりします。当時を知っている方がいらっしゃれば是非うかがいたいところです。

ストリーム自体はよく知られた概念かと思いますので、詳しい説明は省くことにします。このSRFIではストリームをリストとみなして扱えるようなAPIを提供しています。使い方は以下。

(import (rnrs) (srfi :41))

(define strm123 
  (stream-cons 1 
    (stream-cons 2 
      (stream-cons 3 stream-nil))))
#|
;; above can be written like this as well.
(stream 1 2 3)
|#
;; -> stream

(stream-car strm123)
;; -> 1

(stream-car (stream-cdr strm123))
;; -> 2

(stream-map (lambda (v) (* v v)) strm123)
;; -> stream

(stream-car (stream-map (lambda (v) (* v v)) strm123))
;; -> 1

(stream-car (stream-cdr (stream-map (lambda (v) (* v v)) strm123)))
;; -> 4

正直この例だと特に恩恵はありません。むしろ、いろいろ面倒なだけです。

例えばOCamlではファイルの読み込みを行うストリームがあります。このSRFIでも似たようなことが可能です。こんな感じ(SRFI本文から拝借)。

(define-stream (file->stream filename)
 (let ((p (open-input-file filename)))
    (stream-let loop ((c (read-char p)))
      (if (eof-object? c)
          (begin (close-input-port p)
                 stream-null)
          (stream-cons c
            (loop (read-char p)))))))

(define file-stream (file->stream "test.scm"))

(stream-car file-stream)
;; -> the first character of the file.

ファイルサイズが大きいと最後まで読み込んだ後にメモリの使用量が大変なことになるという難点があったりしますが(しかも束縛されているとGCもされないという二重苦)、必要になるまで読み込みは行わずまた、読み込んだ文字は常に再利用可能というメリットがあります。また、このSRFIはport->streamというAPIも用意していて、ポート位置の指定が不可能なポート等には便利に使えそうです(ただし文字ポートにしか使えないので、バイナリがいる場合は自作する必要があります)。

参照実装ではストリームは伝統的なthunkで表現されていますが、処理系によってはもう少し賢く実装しているかもしれません(見たことはないですが・・・)。

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

R7RSポータブルライブラリを書く際の落とし穴

この記事はLisp Advent Calendar 2014の2日目として投稿されました。

R7RSでは処理系毎の差異を吸収可能な構文cond-expandが採用されポータブルなコードが書きやすくなった。では実際のところどれくらい書きやすくなったかという話は寡聞にして聞かないので、ある程度実用的なライブラリを書いて検証してみた。結論から先に書くと、R6RS時代とそこまで変わっていないか、多少不利というのが僕個人の感想である。その理由を一つずつ見ていくことにしよう。

【ライブラリ拡張子】
可搬性の高いライブラリを書くのであれば、外せないポイントの一つである。R7RSでは既定されていない部分であるため、最大公約数を選ぶしかない。知る限りではSagittariusとGaucheは拡張可能である。参照実装であるChibi Schemeが.sldを採用したのでそれに追従する処理系が多い(例：Foment)。再度R7RSでは既定されていないので、処理系依存になる。例えばpicrinは.sldをサポートしていないし、しばらくサポートされなさそうである。これも踏まえてポータブルに書くとなると、実装とライブラリ定義は完全に切り離す必要がある(Chibiは常にこの方式を採用している)。しかしなが、それでは実装者の負担が大きくなるので線引きをする必要はある。現状であれば.sldを採用するのが妥当なところであろう。

余談ではあるのだが、Gaucheでライブラリ拡張子を追加するのは-eオプションを使う必要がある。具体的には-e '(set! *load-suffixes* (cons ".sld" *load-suffixes*))'のようなものが必要になる。append!でもいいのだが、そうすると.scmの方が優先順位が高くなるので嵌ることがある。(嵌った)

【サポートされてるSRFI】
R7RSの範囲だけでもある程度のことはできるのだが、SRFIくらいは許容範囲に入れないとある程度の範囲が狭い。例えばマルチスレッドやソケット等はSRFIを使わないと完全に処理系依存になる。
しかし、これがポータブルなライブラリを書く際の落とし穴になる。 例えば僕が書いたライブラリは以下のSRFIを要求する：

• SRFI-33(withdrawn)/SRFI-60もしくは(rnrs)
• SRFI-106
• SRFI-19(サポートされていれば)

この中に文字列を扱うSRFI-13がないのには理由がある。Chibiがサポートしていないからである。(ちなみにFomentもサポートしていない。) 参照実装から持ってくるという方法もあるといえばあるのだが、ロードパスの問題も出てくる。例えばFomentはSRFI-1もサポートしていないがChibiはしているので、サポートしていないSRFIだけを入れるというのは困難である。特に組み込みでサポートしている場合は参照実装に置き換えると性能が落ちる可能性が出てくる。

ここでは問題としてChibiを指しているが、SagittariusにもあってSRFI-60をサポートしていないのである。理由は面倒だからの1点なのだが、流石にちょっと無視できなくなってきたかもしれない。自分で自分の足を打ち抜いてる感がすごいので*1・・・

余談だが、ChibiはSRFI-106をサポートしていない。なので処理系依存のコードが貼り付けてある。

【R6RSにあってR7RSにない手続き】
R7RSはR6RSで定義された手続きの大部分を提供しない。 特にバイトベクタ周りの手続きがごっそり抜けている。例えばbytevector-u32-refとかである。単に互換手続きをScheme側で実装してやればいいだけなのでそこまで問題にならないが、これがbytevector-ieee-double-refとかだと骨が折れること間違いなしだろう。(今回は16ビット整数と32ビット整数だけだったのでそこまででもなかったが。)

R6RSに限った話ではないが、処理系によってはライブラリもしくは組み込みで提供されている手続き等があり、それらは性能を出す上で重要になってくるかもしれない。例えば上記のバイトベクタ周りの手続きはSchemeで実装した場合複数回のメモリ割付が必要とされる可能性があるが(bytevector-u64-ref等)、処理系が組み込みでサポートしていた場合にはメモリ割付は１回に抑えられるかもしれない。タイトなループで呼ばれる際には無視できない要素になる可能性がある。

【ポータブルなライブラリを書くにあたって】
ではどうするか？というのはライブラリを書く上で重要になるだろう。残念ながら、これといった指標のようなものは今のところ僕個人の中にはない。そして、残念ながらR7RSポータブルなライブラリの絶対数も少ないこと等、既存のものから学ぶという方法もとりづらい。今後の参考になるよう今回書いたライブラリから学んだ点を列挙する。

1. R7RS外の機能の分離
2. サポートする処理系の具体的イメージ
3. 習熟度の低い処理系の性能はあきらめる

#1はサポートされていないSRFIの救済を含む。ライブラリの要件に必要なSRFIを列挙すればいいのだが、多くの処理系で使えるようにするにはそれすらも最小限に抑えた方がよい。例えば今回の例ではSRFI-13があるが、必要だった部分は非常に小さかったのでライブラリ側で実装し依存度を減らした。

#2は対象とする処理系をある程度列挙することである。今回のライブラリではスタートポイントとしてSagittarius、GaucheそしてChibiを選択した。それぞれの処理系に癖があり、細かい点で嵌ったものもある。例えばGaucheのソケットポートはバッファを確保するのでコマンドを任意のタイミングでサーバに送る際にはバッファをフラッシュする必要があった。(他にもwith-exception-handlerがSEGVるとかあるが、それはバグを踏み抜いただけということで。) 複数の処理系で走らせることができれば処理系が許容する未定義動作をある程度意識して回避することが可能である。R7RSでは未定義動作の範囲が広く、また処理系の拡張をかなり許しているため、ポータブルなコードを書く際にはこれを踏まないようにするのが鉄則になるだろう。(今回の動作はSRFI-106なので、自分で足を打ち抜いたのではあるが・・・)

#3は性能を出すポイントというのは処理系ごとに違うので習熟度が低い処理系であれば、ポータブルに書くことを優先すべきである。今回は重たい処理(MD5ハッシュやバイナリ変換)に関してSagittariusでのみ処理系が用意している(バイナリ変換はR6RS由来だが)手続きを用いた。GaucheにもMD5ハッシュはあるが、R7RS+SRFIの範囲で書かれているものを流用することにした*2。当然だが、サポートする全ての処理系に依存するコードで書いたとしても可能な限りポータブルなコードは残さなければならない。仮にR7RSやSRFIで既定されていないものであっても、既定の動作としてエラーを投げるものを組み込んでおくだけでライブラリの一部が使えたり、後のサポートを容易にすることが可能である。

上記のポイントに加えて、ある機能を処理系依存で切り分ける際に必ず一つはR7RS+SRFIの範囲に動くようにした。それぞれの処理系の癖やバグを回避する際に必ず一つはポータブルなパスを通るようにすることで、可能な限りポータブルに出来たと思う。(スペックだけを見るのであれば、Fomentでも何の変更もなく動くはずである。 )

【結論】
R7RSに限ったことではないが、ポータブルなライブラリを書くことは非常に大変である。以前にR6RSポータブルなライブラリを書いた際にも同様な感想を持ったが、R7RSは決定からの時間が浅いからか、カバーする範囲が狭いからか、処理系ごとの癖が強いからなのか分からないがR6RSのときよりもライブラリ本体ではない部分のコードを書く量が多かった気がする。R6RSポータブルなライブラリはJSONを扱うものなのでその差かもしれないが(サポートした処理系全てがかなりの数のSRFIをサポートしていたというのも大きな要因かもしれない)。しかしながら、ある程度の制限はあるもののポータブルなライブラリを書く手段が言語レベルで既定されているというのはやはり大きな利点であると思われる。

長々と書いたが一言でまとめれば、もっとR7RSなSchemeを使おうということになる。もちろんR6RSでも構わない。

*1: 入れた。次のリリースからは使えるようになる。
*2: 正直なところ、GaucheやChibiをタイトに使うことはほとんどないので、Sagittariusで性能が出ればいいというのもある。他の処理系で性能がいる場合はPull Reqを送っていただけるとありがたい。

SRFI-39の紹介

(LISP Library 365参加エントリ)

SRFI-39はパラメタです。CLで言うところのスペシャル変数と同様のもので、Schemeでダイナミックスコープを可能にするものです。R7RSで標準にも採用されているので特にこれといった説明も必要ない気がしないでもないですが、簡単な使い方を見てみましょう。

(import (rnrs) (srfi :39))

(define *foo* (make-parameter 10))

(define (foo) (display (*foo*)) (newline))

(parameterize ((*foo* 100)) (foo))
;; prints 100

マクロparameterizeは変数部分が定義されたパラメタであることを除けばletと同じ構文です。また、make-parameterはオプション引数としてconverterを取ることが可能です。こんな感じ。

(define *foo* (make-parameter 10　(lambda (x) (* x x))))

(*foo*)
;; -> 100

(*foo* 20)

(*foo*)
;; -> 400

converterは設定された値を変換します。与えられなければ設定された値がそのまま使われます。上記のように使う場合は少なくとも型チェックを入れるべきですが、ここでは手を抜いてます。

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

Concurrent processing on Scheme

I'm trying to write concurrent library on Scheme, well more precisely aming to make a SRFI for this if I can. There are 2 reasons for doing this: one is because of handling shared memory manually is not something ordinally human being like me can do. The other one is not all implementation support SRFI-18/21. So my first thing to be resolved is checking which implementation supports which concurrency model. There are literally tons of implementations and my life time is not long enough to check all of them so I've check the ones listed on R6RS.org, known R7RS Scheme implementations and some of 'can't ignore them' R5RS implementations.

Starting with implementations which support SRFI-18:

• Guile
• Chicken (via Egg)
• Sagittarius
• Gambit
• Gauche
• Chibi Scheme

POSIX looks like thread model:

•  Chez (not SRFI but very similar with POSIX)
•  Racket (can be similar with POSIX but not quite)
•  Scheme 48 (not SRFI but looks similar with POSIX) 
•  Foment (not SRFI but looks similar with POSIX)

Message passing style concurrency model:

• Racket (also supports message passing style)
• Scheme 48 (can also be here I think)
• Mosh
• Ypsilon

Others:

• Kawa (future? delay/force looks like syntax)
• Racket (future, places so on... Racket is huge men!)

No builtin concurrency supported (I simply couldn't find so correct me):

• Vicare (Ikarus as well I believe)
• Larceny
• IronScheme (at least not on Scheme, maybe possible on .NET?)
• Picrin

I think this is pretty much enough. To check how much difference between these models, well more like between POSIX style and message passing style though, I've wrote couple of bank accounts. Let's start with SRFI-18:

#!r6rs
(import (rnrs) (srfi :18))

(define (open-account initial-amount)
  (let ((lock (make-mutex))
        (balance initial-amount))
    (lambda (operation amount)
      (dynamic-wind
          (lambda () (mutex-lock! lock))
          (lambda ()
            (case operation
              ((withdrow)
               (if (< balance amount)
                   (error 'withdrow "invalid amount")
                   (begin
                     (set! balance (- balance amount))
                     (values amount balance))))
              ((deposit)
               (if (negative? amount)
                   (error 'deposit "invalid amount")
                   (begin
                     (set! balance (+ balance amount))
                     (values 0 balance))))
              (else (error 'acount "invalid message"))))
          (lambda () (mutex-unlock! lock))))))

(define (print . args) (for-each display args) (newline))

(define client (open-account 1000))

(let-values (((money balance) (client 'withdrow 100)))
  (print money ":" balance))
(let-values (((money balance) (client 'deposit 100)))
  (print money ":" balance))

(print "do in parallel")

(let ((ts (map (lambda (msg amount)
                 (make-thread
                  (lambda ()
                    (thread-sleep! (inexact (/ amount 1000)))
                    (let-values (((money balance) (client msg amount)))
                      (print money ":" balance)))))
               '(withdrow deposit withdrow) '(1000 500 500))))
  (for-each thread-start! ts)
  (for-each thread-join! ts))

Next one is Racket. Racket has quite a lot of concurrent functionalities but for now I only used thread and asynchronous channel, and no semaphore. Thread mailbox can be used but it would be hard for me to integrate later.

#lang racket
(require racket/base)
(require racket/match)
(require racket/async-channel)

(define (open-account inital-amount out)
  (let ((mbox (make-async-channel)))
    (thread
     (lambda ()
       (define balance inital-amount)
       (let loop ()
         (match (async-channel-get mbox)
           ((list 'withdrow how-much)
            (if (< balance how-much)
                (begin (async-channel-put out "invalid amount") (loop))
                (begin
                  (set! balance (- balance how-much))
                  (async-channel-put out (cons how-much balance))
                  (loop))))
           ((list 'deposit a)
            (if (negative? a)
                (begin (async-channel-put out "invalid amount") (loop))
                (begin
                  (set! balance (+ balance a))
                  (async-channel-put out (cons 0 balance))
                  (loop))))
           ((list 'close) #t)
           (else "invalid message")))))
    mbox))

(define receipt (make-async-channel))
(define client (open-account 1000 receipt))

(async-channel-put client '(withdrow 100))
(async-channel-put client '(deposit 100))
(displayln (async-channel-get receipt))
(displayln (async-channel-get receipt))

(displayln "do in parallel")

(thread
 (lambda ()
   (sleep .2)
   (async-channel-put client '(withdrow 1000))
   (displayln (async-channel-get receipt))))

(thread
 (lambda ()
   (async-channel-put client '(deposit 500))
   (displayln (async-channel-get receipt))))

(thread
 (lambda ()
   (sleep .1)
   (async-channel-put client '(withdrow 500))
   (displayln (async-channel-get receipt))))

(sleep .5)
(async-channel-put client '(close))

Then Ypsilon. Ypsilon has almost subset of the one Racket has. I might need to use its shared queue/bag feature which I have no idea how to use...

(import (rnrs) (concurrent) (match) (only (core) format usleep))

(define (open-account inital-amount out)
  (let ((mbox (make-mailbox)))
    ;; This call-with-spawn is renamed to spawn* in trunk code.
    ;; So if you are using trunk version, make sure you are using
    ;; spawn* which does the same as call-with-spawn.
    (call-with-spawn
     (lambda ()
       (define balance inital-amount)
       (let loop ()
         (match (recv mbox)
           (('withdrow how-much)
            (if (< balance how-much)
                (begin (send out "invalid amount") (loop))
                (begin
                  (set! balance (- balance how-much))
                  (send out (cons how-much balance))
                  (loop))))
           (('deposit a)
            (if (negative? a)
                (begin (send out "invalid amount") (loop))
                (begin
                  (set! balance (+ balance a))
                  (send out (cons 0 balance))
                  (loop))))
           (('close) #t)
           (else "invalid message"))))
     (lambda (retval)
       (shutdown-mailbox out)
       (shutdown-mailbox mbox)
       (format (current-error-port) "## acount closed~%")))
    mbox))

(define receipt (make-mailbox))
(define client (open-account 1000 receipt))

(define (print . args) (for-each display args) (newline))

(send client '(withdrow 100))
(print (recv receipt))
(send client '(deposit 100))
(print (recv receipt))

(print "do in parallel")

(define count 100000)
(future
 ;; for some reason the thread didn't sleep with usleep...
 (let loop ((i 0) (r '()))
   (unless (= i count)
     (set! r (list i))
     (loop (+ i 1) r)))
 (send client '(withdrow 1000))
 (print (recv receipt)))
(future
 (send client '(deposit 500))
 (print (recv receipt)))
(future
 (send client '(withdrow 500))
 (print (recv receipt)))

(usleep 100000)
(send client '(close))

Tha last one is Mosh. The Mosh one is really not my cupa tea... Maybe it's only for me but feels too much restricted. In the thunk passed to spawn it can't refer any free variables or even global variable defined in the toplevel. But anyway this is the bank account.

(import (rnrs) (mosh concurrent) (match))

(define (open-account initial-amount)
  (let ((pid (spawn (lambda (x)
                      (define balance (car x))
                      (let loop ()
                        (receive
                            (('withdrow from amount)
                             (if (< balance amount)
                                 (! from "invalid amount")
                                 (begin
                                   (set! balance (- balance amount))
                                   (! from (cons amount balance))))
                             (loop))
                            (('deposit from amount)
                             (if (negative? amount)
                                 (! from "invalid amount")
                                 (begin
                                   (set! balance (+ balance amount))
                                   (! from (cons 0 balance))))
                             (loop))
                          (('close from) (! from "closed"))
                          (else (error 'acount "invalid message")))))
                    (list initial-amount)
                    '((rnrs) (mosh concurrent) (rnrs mutable-pairs)))))
    pid))

(define client (open-account 1000))
(define (print . args) (for-each display args) (newline))

(link client)

(! client `(withdrow ,(self) 100))
(receive ((money . balance) (print money ":" balance)))
(! client `(deposit ,(self) 100))
(receive ((money . balance) (print money ":" balance)))

(! client `(withdrow ,(self) 1500))
(receive ((money . balance) (print money ":" balance))
    (other (print other)))

In these small pieces of code, there is no big difference but message passing style always creates a thread when users open a new account. All message passing style concurrent functionalities hide resource synchronisation known as mutex/semaphore which I think what I want so that I can avoid handling lock/unlock manually. (I have no idea how many times I needed to cry because of deadlock or incorrect state...)


I believe as long as implementations support POSIX style thread model, it's not so difficult to implement this message passing style. However if I want to build a different concurrent model on top of other models, how much capability do those non POSIX models have? Can we implement Disruptor model on top of Ypsilon's concurrent library? (though, I didn't understand how disruptor works thoroughly...) Ultimately, which model would *the* next model?

Due to the lack of my knowledge, I don't have any conclusion yet. If you have any suggestion/good to read papers, please let me know.

行列計算の提案について思うこと

comp.lang.schemeに行列計算についての提案が投下されてた。投稿者はNormal Schemeの笹川氏のようである。この提案についてのc.l.sの反応に氏は納得していないようではあるが*1、個人的にはまだ未成熟ではあるものの、SRFIとして提案されてもいいのではないかと思うのでちょっとコメントを残しておこうかなぁと思った次第。ちなみに、行列計算に関して僕は全然明るくないので計算アルゴリズム等については言及しない。APIというか設計というか、c.l.sの反応の裏側にあるSchemer的な思考についてである。(全ての項目に、僕が考える、という接頭辞をつけて読むこと。)

c.l.sの反応について

「標記の拡張についてリードマクロで実装可能にした方がいいから、言語標準にするよりはリードマクロをSchemeに足してその上でこの表記を入れた方がいいのでは？」という意見がでている。氏は「またマクロか」と呆れておられるようだが、Schemer的にc.l.sのこの反応は妥当だと思う。ただ、これについてはこの提案に対してのカウンターというよりは、別にリードマクロ入れようぜ、という話なので落胆するポイントが多少違う気がする。じゃあ、だれがリードマクロの提案するんだよ？という話になる気はするが、それは別の話。(個人的にリードマクロの提案は合意が取れる形式がしばらく出てこない気がしている。処理系互換とか、まぁいろいろ。実装した経験からというのもある。)

APIについて

「オブジェクト指向は標準じゃないじゃん」的なことを氏は呟いておられるが、R6RS以降のSchemeであればレコードが標準であるのでそれが使えるはず。例えば行列型は以下のように書ける。

;; R7RS style record
;; its instance is immutable (no setter)
(define-record-type <matrix> (%make-matrix elements) matrix?
  (elements matrix-elements))

これがあるので、c.l.sではライブラリで実装できるからプリミティブにする必要なくね？という意見が出ているのである。それについては僕も同意見。
また、計算用の手続きがそのまま数値計算と被っているのも多分受けは悪いと思う。理由としては：

• Scheme的ではない。Scheme標準的には一つの手続きは一つの型を処理するのが推奨っぽいに。
• 数値計算と混ぜると、じゃあ数値が渡ったらどうするの？というのが出てきて設計的に美しくない気がする。

一つ目はScheme WorkshopでAndy Wingoが「面倒だろう、JK」と言っていたのもあり、人による部分はあると思うが、現状では受けは悪いだろう。二つ目は行列と数値の両方が渡った場合の処理等を考えると別にしておいた方が面倒が少ない気がする。エラーにしてもいいのかもしれないが、それならなおさら別でいいだろうという話になると思われる。
行列計算の手続きでいきなりベクタ型が出てくるのだが、これはSchemeのベクタなのか数学的ベクタなのかの説明がないので混乱する気がする。後者であれば、それを生成するための手続きが抜けているし、前者であれば中身は数値であることを明記した方がいい気がする。あと、*が行列とベクタで別の意味を持つようになっているが、上記の理由2から分けた方がよいと思われる。
個人的にはlist->matrixのような変換手続きがあるといいのではないかと思う。matrix->listもあってもいいかもしれない。
option-baseは行列とは別の提案に見えるので入れるとすれば、SRFI-25が採用しているように行列単位にした方がいい。これは間違いなく断言できて、これがvector全体に影響を及ぼすと既存のプログラムが壊れるからである。

その他

c.l.sで氏は

Don't you interested in Mathematics?

と煽っておられたが、これは多分心象を悪くするだけである。返信にもあったが、こう書いてしまうと次に帰ってくるのは「嫌ならMathematica使えよ」とかになるからである(それでも返信した方は煽りとは捕らえてないように見えたので、僕よりずっと人間ができているのだろう)。提案に対してのフィードバックがほしいのであれば、別の聞き方をした方がいい。ついでに言えば、数学に興味があってもこの分野の数学には興味がないかもしれないので、いろんな意味で失礼な気がする。
参照実装があるが、算術手続きがすっぽり抜けているのでそれも入れるといいと思う。また可能であればR7RS(もしくはR6RS)ライブラリ形式で可能な限りポータブルに書くと受けがいいと思うし、他の処理系にも取り入れられる可能性があがると思う。行列表記についてはオプションにしておくといいかもしれない。
辛辣な物言いがあるかもしれないが、この提案自体はいいものだと思うし、もう少し煮詰めてSRFIになればいいなぁとも思うので、氏にはもう少し頑張っていただきたいところである。後、c.l.sでコメントが着いたということは、少なくともいくらかの人の興味を引いたということなので(僕のPostgreSQLバインディングは反応0だった)、Schemerは数学に興味がないとか、c.l.sは2ch並みだとか言うのは他のSchemerの心象を悪くする可能性があるので控えた方がよろしいかと思う。

追記：
c.l.sにShiroさんのコメントが来てた。option-baseはやっぱりその心配をするよなぁという感じ。書いてて思ったが、これは効率悪いけど実装がパラメタ使ってaccessorに下駄履かせればいいのかとも思った。

*1Twitterアカウントが氏のものであるかは自信がないが、Normal Schemeについての言及があるし多分そうだろう。

Washington D.C. 四日目

四日目も観光。

なぜかiPhoneの写真用ディレクトリがWindowsから見えないので写真はなし・・・なんだこれ？

2日目にワシントンモニュメント＋ダウンタウンを攻めたので、4日目はペンタゴン方面を攻めてみようという感じで移動。基本的に徒歩でいける圏内なので歩いて。

途中でNational Cemeteryがあり中に入れるっぽかったので入ってみる。墓場だけで観光地でもあるらしい。よく分からん。中にはArlington Houseなるものがあり市民戦争辺りの歴史等があったりした。

さらに墓場の奥地にすすむと、無名兵士の墓(Tomb of the Unknown Soldier)があり交代時間なのか墓守の兵士の儀式みたいなのが見えた。聖堂みたいなものもあり、中には各国からの贈呈品が展示されていた。なんか見たことある菊の紋があるなぁと思ったら、日本からのものであった。2013年に安倍総理から送られたものみたいである。

墓場からでると割と目の前くらいにペンタゴンがあった。まぁ、ぶっちゃけあるだけで中に入れるわけでもないし、写真撮影すら許可されていないので特に何もなく終了・・・

ここからなら向こう岸(ワシントンDC)に行くための橋が近いので頑張って歩いてみることにした。メトロ使ってもよかったんだけど、歩いた方がいろいろ見えるから好きなのである。ちなみにここまででおよそ4時間くらい経っていて足がかなり痛かったということは記しておくw

橋を渡るとリンカーンの記念講堂(？)に着く。2日目にも来ているので適当に流しておしまい。その後US Capitalまで歩きつつ、途中の博物館に寄ったりしてみた。

ここまでで8時間くらい歩き詰めだったのでそろそろ足が限界になりホテルに帰る。ホテルに戻ったら部屋にクッキーモンスターが来たらしく、クッキーが置いてあった。やつはクッキーを食べる方じゃなかったかなぁ？という疑問はとりあえず置いておくことにし、紅茶とともにクッキーを食べる。サイズがデカイ上にチョコレートが甘ったるかったので、一枚食べるのが限界であった。

Washington D.C. 三日目(Scheme Workshop2014)

ワシントン三日目はScheme Workshop2014。このためにワシントンに来たので外すわけには行かないw 招待講演とキーノート以外の論文はサイトからダウンロードできる。


最初はJohn CowanのR7RS-largeの近況。R7RSとR6RSの違い、R7RS-smallで決まったこと等から始まり、R7RS-largeのプロセス等が報告される。

二番手は自分。発表資料は以下。

Implementing R7RS on R6RS Scheme from Kato Takashi

その後休憩を挟んで次のセッションへ。

Code Versioning and Extremely Lazy Compilation of Schemeはベンチマークの結果がまだないので実際にこれが高速になるのか分からないというところが多少残念だったが、面白い内容だった(記憶)。

Microscheme: Functional programming for the ArduinoはSchemeでマイコンを動かす発表。なぜか発表者が論文著者ではなかった。前日にデモ用に実機を弄ったという話で、実際にデモがあった。Scheme(のサブセット)で制御されてるロボットがフラクタル書いたりして面白かった。

Structure Vectors and their ImplementationはGambitに型情報を持たせたベクタを組み込むという話。Gambit内部のタグ情報とかがちょいちょい出てきて発表を聞いててもすんなり頭に入ってこなかったのだが(論文読め)、要するに通常のベクタで管理するよりも高速かつ効率よくできるという話。

ここでお昼。ぼ～っとどうしようかと悩んでいたら、John CowanとJason Hemann(開催者)が会話しているのが見えて、聞き入っていたらそのまま一緒にお昼を食べることになった。ここでJohnがかなり面白い人だということを知る。

第三セッションは静的解析。

A Linear Encoding of Pushdown Control-Flow Analysisはほとんど頭に入らず宇宙語喋られた感じであった。前提知識が足りな過ぎた。

Concrete and Abstract Interpretation: Better Togetherは発表の範囲では整数の範囲を静的に解析して、配列のUnderflowチェックを除去できるようになるよという風に締めくくられていた。ガロア結合とか出てきてどうしろと状態になっていた。発表自体は簡潔にまとめられていて、まぁ大体何を意味するのかは分かったのだが、どうも数式アレルギーが・・・

第四セッションはDSL。

Little Languages for Relational ProgrammingはminiKanrenのエラーメッセージをホスト言語(Racket)から切り離して分かりやすくしましょう、という話。miniKanrenの説明に時間を割きすぎてて、僕の隣で担当教官(?)が時間が巻いてるとか後五分とか支持してた。

Meta-Meta-Programming: Generating C++ Template Metaprograms with Racket Macrosはまさにそのまま。NeboというアプリケーションをRacketを用いて生成しているという話。

最後はキーノートのAndy WingoのWhat Scheme Can Learn from Javascript。Javascriptで行われているJITからSchemeで最適化をかけた際に起きる問題、Guileの未来等の面白い話を聞けた。


感想

自分の発表がどうだったかというのは客観的にいえないのだが、無難にこなしたのではないだろうか？二番手だったので残りの発表が余裕を持って聞けたのはよかった気がする。静的解析のセッション以外は特に前提知識なしでも理解できるかなぁという感じであった。面白い話を聞けたしいい経験だったと思うが、今回だけで十分かなという感じではある。来年はICFPとの併設を試みているという話なので、もう少しアカデミックなものになるかもしれないという噂も出ていた。

Washington D.C.二日目

2日目は観光。(Clojure/conjには出ないので4日目も観光の予定)

オランダのATMカードが使えなかったり、クレジットカードのPINコードを覚えていなかったりといろいろトラブルがある中とりあえず観光を決行。滞在先ホテルがあるArlingtonからダウンタウンまでは徒歩でいける距離なんだけど明日のことを考えてメトロを使ってみることにした。野生の勘でRosslyn駅までたどり着き(よく行けたなぁ自分とマジで感心)、farecardという使い捨てチャージ切符をとりあえず片道でMetroCentreまでいければいいかなぁと思い$3分だけ購入。ワシントンのメトロは面白いことに時間帯によって料金が変わるらしい。通勤ラッシュ時のようなピーク時の方が料金が高くなるというのはなかなか面白いなぁと思う。

MetroCentre駅で降りて、とりあえず映画で有名なあの塔に向かおうと駅前にあった地図を覗き込む。手元に地図は一応あるのだが、習慣的にベストエフォート方式を採用しているので。そうしたら、駅にいた観光ガイド(？)のお姉ちゃんにどこに行きたいのか聞かれて、「映画で有名な塔」と言ってみたら「ワシントンモニュメント」という名前が判明した。名前あるんだ。

ワシントンの街並みはそんなに人ごみも多くなく、こまごまとしてもいず、なんというか個人的には好きな街並みである。

特に何も考えずワシントンモニュメントまで歩き、到着。この塔がある公園がまた広い。いくつかの角度から写真を撮ったのだが、プールが写ってるやつと池が移ってるやつがお気に入り。

 この公園には￠1コインにあるあの建物もある。

ちなみに、リンカーンの像の前に立っている人は知らない人である。どくのを待つのも面倒だったのでそのまま写真に撮ってやったｗ 全くの偶然だがそれなりに絵になっているのでまぁいいや。

その後ぐるっとまたモニュメントまで戻りホワイトハウスを眺める。(先に行けばいいものを的なあれをやらかしたともいう。)

オバマ大統領は残念ながら見えなかったｗ ただ今日はやたらパトカーが政府高官か他国外交官かの車を先導していたので、ひょっとしたらチャンスがマジであったかもしれない。(どうでもいいが、そういう人たちはパトカーによる交通ルール無視が行われるということを知った今日)

旅の醍醐味といえばその土地のB級グルメだと勝手に思っているので、ストリートフードを食べてみた。いくつか種類があったが、米が食べたかったのでチキンビルヤーニにしてみた。

ほうれん草とチーズ(モッツァレラに近いチーズだった)にヒヨコマメの何かしらが付いてる。レンテ豆(和名知らん)、ほうれん草とヒヨコマメの3つのうちから2つ選べといわれたので選んだのだが、正直ほうれん草はあまり美味しくなかった。っというか、味がなかった。塩くらい振ってほしい・・・

この後中華街を軽く見て、ダウンタウンの南端くらいを歩きホテルに戻った。

明日のリハーサルを軽くしてみたら10分で終わってしまう内容だということに気づいてあわててスライドを足しているところだったりする・・・

Washington D.C.初日

Scheme Workshop2014に出るためにワシントンDCに来ているのだが、せっかくなのでブログに何か残しておくことにする。

初日はSchiphol空港から始まる。飛行機に乗る際は大体前日にチェックインしているのだが、今回はなぜかネットでチェックインができなかった。仕方がないので3時間前に空港に到着してチェックインを試みる。っが、なぜか拒否られる。E-ticketに記載されている航空会社はLufthansaなので当然そこの窓口にあるマシンで行っていた。数回試しても怒られるので、仕方なくその辺にいた係りのお姉ちゃんに聞いてみることに。以下は大体の会話(原文オランダ語)

僕「チェックインできないんだけと？」
お姉ちゃん「パスポート見せて。最初の乗り継ぎはどこ？」
僕「ワシントン」
お姉ちゃん「だから、最初の乗り継ぎ空港は？」
僕「直行便なんだけど」
お姉ちゃん「直行便？ちょっと待って」

その結果、チケットはLufthansaなんだけどUnitedに行けといわれる。正直意味不明であった。正直フライトそのものがキャンセルされたのかなぁと不安になっていたので多少安堵した部分もあるはあった。しかし、意味不明なチケットを売るのはやめてほしいところである。帰りが不安だなぁ・・・

その後米国に行くのに必須な異様に厳しいセキュリティ等を終えて無事に飛行機に乗る。飛行機の中で3列シート独占だったのがアメリカサイズのおっさんが移動してきてがっかりしたとか、アメリカ国籍なんだけどえらく英語に不自由なおばさんとかに話しかけられたとかは別の話。

Dulles国際空港について入国した後(まぁここもいろいろあったが割愛)ホテルまで移動。ちょっとしたミスで手元のiPhoneがスタンドアローンになってしまったので(SIMロックされた・・・)バス等が調べられずShared vanで移動になってしまった。$29はちと高い気もするが、ホテルの目の前まで送ってくれたのでよしとしよう。

ホテルは4泊で$900近く取られることもあり(狙っていたホテルはクレジットカードが間に合わず予約できなかった・・・半額くらいだったのに・・・)、かなりいい感じである。リビング、キッチンがありベッドルームもかなり広め。こんな感じ。

iPhone6のパノラマ機能で撮影したやつ。これがリビングルーム。左奥がキッチンで右奥がベッドルーム。

これはアメリカだからなのかワシントンだからなのかそれともこのホテル特有なのかは分からないのだが、水が臭う。カルキ臭いようななんかそんな感じ。水道水は飲まない方がいいかもしれない。

初日は特になんの散策もせず終了。軽く時差ぼけになっているのが辛いところである。

SRFI-38の紹介

(LISP Library 365参加エントリ)

SRFI-38は共有データの外部表現を定義したSRFIです。まずはどういうものか見てみましょう。

;; make a circular list
(define a (cons 'val1 'val2))
(set-cdr! a a)

(write-with-shared-structure a)
;; writes #1=(val1 . #1#)

(read-with-shared-structure (open-string-input-port "#1=(val1 . #1#)"))
;; -> #1=(val1 . #1#)

CLでおなじみの共有構造にラベルが付いた表現ですね。write-with-shared-structureではデータが循環せず単に共有していた場合でもラベル付きで表示します。

実はこれ以外には何もなかったりするので、以下は与太話。上記の表現はR7RSで正式に採用されたのですが、スクリプト内で使うとエラーだったりします。また通常のwriteも共有構造を検知しなければなりません。面白いのは通常のwriteは共有構造を検知してもそれが循環構造でなければ普通に表示するようになっている点です。例えば以下。

(import (scheme write))

;; This script is actually invalid, so not portable.
(write '#1=#(1 2 3 #1#))
;; writes #1=#(1 2 3 #1#)

;; ditto
(write '#(#1=(1 2 3) #1#))
;; writes #((1 2 3) (1 2 3))

どういった経緯でこうなったかは議論を追ってないので憶測ですが、R5RSとの互換性かなぁと思います。これがありがたいかといわれると、今のところ恩恵にあずかったことはなかったりします。

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

デザインミスとI/Oパフォーマンス

最近サポート業務が多く、ログファイルを眺めて原因を探るという作業が非常に多い。毎回lessで開いて特定の情報のみを目grepするのは馬鹿らしいが、覚えにくいシェルコマンドを複数回叩くとかもやりたくないなぁと思いSchemeでログ解析するスクリプトを書いた。ここまでが導入。

っで、今更になって文字列の内部表現をUTF-8にしておけばよかったなぁということを後悔している。問題になっているのはメモリ使用量で、上記のログは一行10万文字とか普通にあってこういうのを複数回読み込むとGCが警告メッセージを大量に吐き出してくる。ちなみにBoehm GCは内部的に巨大なメモリ割付の閾値を持っていて、LARGE_CONFIGだと64(係数) * 4098(ページサイズ)となっている。ログファイルのテキストは全部ASCIIなのでUTF-8であれば10万バイト(100KB)で済むのにUCS32にするから400KB持って行かれる。このサイズが数回でてくる程度であれば問題ないんだけど、ログファイルは70MBくらいあって、20～30行に一回くらいの頻度で巨大な一行がでてくる。そうするとCygwinの初期ヒープサイズだとメモリが足りなくて死ぬ(ので、初期ヒープを2GBに拡張している)。これだけならいいんだけど、ログファイルにはバイナリも吐き出されてて、こいつを文字にするとバイナリの情報が落ちる(これはUTF-8に変換する際にも同様のことが起きる可能性があるのでどっこいかな？)。

今更こいつらを変更するとなるとかなり大変だし、一文字＝一要素を想定して最適化してある部分もあるのでパフォーマンスの劣化も気になる。作った当初はこんな巨大な文字列扱う予定なかったからアクセス速度の方を優先してしまったが、ちと失敗だったかもしれない。

上記のログファイルの読み取りに関連するのだが、get-lineが遅い。例えばGaucheと比べるとおよそ5倍から遅い。理由は実にはっきりしていて、文字ポートとバイナリポートが分かれているのと、一文字読むのにコーデックによる変換が入ること。これはR6RSが要求していることなのでどうしようもないのではあるが、それでもなぁというレベルで遅い。ちらっとGaucheのread-lineの実装をみたのだが、Gaucheでは'\n'が出るまで1バイトずつ読むという方針で、あぁそりゃ速いわという感じであった。ちなみに、この方針は使えないので(バイトベクタを読むならいいけど、文字では・・・)どうしようもない。

こうなってくると文字ポートの使用をやめてバイナリを直接扱うようにしていかないととなる。そうなると問題は正規表現で、現状では文字列しか受け付けない(バイトベクタを扱うユーティリティはかなりそろえた)。ASCII限定にしてバイトベクタ対応させると多少嬉しいだろうか？(文字にするとオーバヘッドが大きすぎる気がする)

さて、どうしたものかね・・・

PostgreSQL for R7RS Scheme

I've been writing the library for PostgreSQL and it seems very basic things are working. So let me introduce it.

The repository is here: PostgreSQL binding for R7RS Scheme

Currently, it supports following R7RS implementations;

• Sagittarius 0.5.9 or later
• Gauche 0.9.4 or later
• Chibi Scheme 0.7 or later

The library is written as portable as possible so if other implementations support required SRFIs, then they should also be able to use it. I'm assuming implementations support all R7RS standard library, though.

The library consists 2 parts; one is API layer and the other one is PostgreSQL frontend commands layer. The latter one is not documented so it is your own risk to use it and might be changed in the future. Following example shows how to use the high level APIs;

(import (scheme base) (postgresql))

;; for convenience
(define (print . args) (for-each display args) (newline))

;; user: postgres
;; pass: postgres
;; use default datebase
;; The connection is *not* opened yet.
(define conn (make-postgresql-connection 
       "localhost" "5432" #f "postgres" "postgres"))

;; open connection.
(postgresql-open-connection! conn)

;; inserts a record
;; this returns an affected row number
(postgresql-execute-sql! conn 
  "insert into test (id, name) values (1, 'name')")

;; execute a SQL directly. This stores all record in
;; the query object. So it is not a good idea to use
;; this to a table contains more than 10000 record.
(let ((r (postgresql-execute-sql! conn "select * from test")))
  ;; fetching the result. returning value could be either
  ;; a vector or #f
  (print (postgresql-fetch-query! r)))

;; Using prepared statement
(let ((p (postgresql-prepared-statement 
   conn "select * from test where name = $1")))
  ;; binds a parameter. it can take variable length
  ;; arguments
  (postgresql-bind-parameters! p "name")
  (let ((q (postgresql-execute! p)))
    ;; same as direct execution
    (print (postgresql-fetch-query! q)))
  ;; prepared statement must be closed.
  (postgresql-close-prepared-statement! p))

;; terminate session and close connection.
(postgresql-terminate! conn)

There are still bunch of functionalities missing, for example, it doesn't have transaction API, nor proper data conversion for insert/update statements. But I think it's a good start point.

To run above script, there is a bit complicated way to do it. Assume you're runnig the script in the project directory.

# for Sagittarius
sash -Llib -S.sld example.scm

# for Gauche
gosh -r7 -Ilib -e '(set! *load-suffixes* (cons ".sld" *load-suffixes*))' example.scm

# for Chibi
chibi-scheme -Ilib example.scm

Gauche is the trickiest one, there is no explicit command line option to prepend/append library suffixes.

Your opinions or pull requests are always welcome :)

SRFI-37の紹介

(LISP Library 365参加エントリ)

SRFI-37はargs-fold: プログラム引数処理器です。 何をするかといえば、プログラムに渡された引数をいい感じに処理してくれます。使い方は以下。

(import (rnrs) (srfi :37))

(define options
  (list (option '(#\l "long-display") #f #f
                (lambda (option name arg seed1 seed2)
                  (values (cons 'l seed1) seed2)))
        (option '(#\o "output-file") #t #f
                (lambda (option name arg seed1 seed2)
                  (values (acons 'o arg seed1) seed2)))
        (option '(#\d "debug") #f #t
                (lambda (option name arg seed1 seed2)
                  (values (acons 'd arg seed1) seed2)))
        (option '(#\b "batch") #f #f
                (lambda (option name arg seed1 seed2)
                  (values (cons 'b seed1) seed2)))
        (option '(#\i "interactive") #f #f
                (lambda (option name arg seed1 seed2)
                  (values (cons 'i seed1) seed2)))))

(let-values (((opts operands) (args-fold (command-line) options
                                         (lambda (option name arg seed1 seed2)
                                           (values (acons '? name seed1) seed2))
                                         (lambda (arg seed1 seed2)
                                           (values seed1 (cons arg seed2)))
                                         '() '())))
  (write opts) (newline)
  (write operands) (newline))

上記を例えば以下のように実行すると、

% sash test.scm -l --output-file=a.out -d the rest of argument

こんな感じの出力が得られます。

((d . #f) (o . "a.out") l)
("argument" "of" "rest" "the" "test.scm")

このSRFIはかなり柔軟に作られていて、引数の順番は定義順である必要がありません。また、短いオプションではスペースを挟んでも挟まなくてもよく、長いオプションでは=の変わりにスペースが使えます。

肝になる点は以下の3点です。

• option手続きによる引数が何をとるかの指定
• args-foldの第3引数の定義外オプションの扱い手続き
• args-foldの第4引数のオプション以外の引数の扱い

args-foldという名の通り引数を畳み込んでいくイメージで使います。

正直このままでは使いにくいなぁと思ったので、Sagittariusではこれを薄いマクロで包んだ(getopt)というライブラリを提供しています。

今回はSRF-37を紹介しました。

ふと思い出した話

僕がまだ日本で働いていたときのことである。当時働いていたのは町工場がそのまま世界規模の会社になったような体制の会社であった。それがいい悪いは置いておいて、そういう会社であった。僕が入社した少し前から年功序列ではなく成果主義へという暗黙のスローガンを掲げているという話でもあった。年功序列がいい、成果主義がいいという話でもないので、その辺を期待しているの荒期待はずれになると思われる。

その会社では成果主義を達成するため(かどうかはしらないが)として総合職、一般職の2種類の給与体系(名目上は違うが、ほぼ給与体系だった)の他に役職のようなものがあった。部長、課長のような大まかなものではなく、ランク付けのようなものである。よく覚えていないのだが、最初がBで次がGとかだった記憶である。またBのランクでも1~5まで格付けがあって格によって給料が違ってきた。僕は転職組みであったが、経験年数が2年(前職を二年で辞めたのだよ)と短かったのでほぼ新卒と同じ扱いだった記憶である。

生ぬるい仕事と、募集要項に記載されていた仕事内容との剥離に嫌気がさして辞めようとしていた矢先に格付けを上げる研修なるものに行かされた。研修用に論文と呼ばれる職務感想文を書かされ、研修施設に週末1泊2日で送られた。その間の給料はでないけど、ほぼ強制だった記憶である。(1ヶ月後には辞めるのに出る必要がるのか？と上司に聞いたら、「出ろ」という話だった記憶。) 研修内容は、2日に渡る各自が書いた論文の内容に関しての質疑応答及び議論であった。

研修施設に行くと監督者から夕食後は各自の自由だが、これを気に先輩社員や同期との交流を深めるといいというようなアドバイスがあった。要するに適当な時間まで飲み会やるから参加しろよという意味である。僕はといえば、体調が優れなかったこともありさっさと寝てしまった。話によると飲み会は日付が変わっても続いていたようである。

あまりやる気のないなか2日目の研修が始まり、自分の感想文を発表する順番が来た。まぁ特に何かがあるわけでもなく、概ね無難に終わったような気がする。その後昼食時に同じグループの参加者と話をしたのだが、その際今でも理解できない面白いことを言われた。要約すると以下の3つである。

• 会社に不満があるならもっと人と話をするべきだ
• 昨日の飲み会はその一つのチャンスだったはずだ
• そういうのに積極的に参加しないのが問題ではないか？

僕が体調が優れなかったから寝たのだと言うと、それならしょうがない、みたいな風になったのだが、個人的には今でも理解できない面白い意見だと思っている。言った人の名前すら覚えていないのだが、悪い奴ではなく会ったのが辞める直前の職場でなかったら友人になれていたのではないかなぁと思うくらいにはいい奴だった記憶である。彼の言わんとしていたことは分からなくもない。特に最初の項目はその通りだと思う。2つ目以降は正直理解できない。個人的には飲み会みたいな場で会社の不満を吐くのが好きではないのと、その場で成された議論を職場でもう一回するのは労力の無駄だと思っている。

例えば今の職場では夏にBBQ、冬にクリスマスパーティ等あり、毎週金曜日はBeer o'clockと呼ばれる会社の金でビール飲み放題な日がある。参加するも自由、しないも自由で、参加しなかったら次の日からバツの悪い雰囲気になるわけでもない。逆に言うと、参加したからといって職場環境がよくなるわけでもない。あくまで経費会社負担の単なるイベントである。同僚との関係も悪くないし、自分の財布を痛めるわけでもないので割りと積極的に参加しているが、娯楽の一環に過ぎない。(そういえば、最初の会社のときは新入社員歓迎会と称した飲み会があったけど、あれ自腹だったなぁ。さすがに新入社員は払ってなかったけど。)

特に何か言いたいわけではないのだが、ふと思い出した話。

SRFI-35/36の紹介

(LISP Library 365参加エントリ)

SRFI-35は例外を、SRFI-36はI/O例外を規定するSRFIです。ここで言う例外とは例外オブジェクトのことです。例外はR6RSに取り入れられ、R7RSで取り除かれたという悲しい歴史を持ちます。
R6RSで定めている例外とほぼ同じなのですが、conditionがマクロだったり検査用の手続きがあったりと多少趣が違います。以下はSRFI-35で定められているものの一部です。

(define c (condition (&serious)
                     (&message (message "message of this condition"))))

(condition? c)
;; -> #t

(condition-ref c 'message)
;; -> "message of this condition"

(extract-condition c &serious)
;; -> instance of serious condition

(condition-has-type? c &message)
;; -> #t

SRFI-36はSRFI-35を元にしてI/O例外を定めています。R6RSに慣れ親しんでいる方であればいくつかの例外には見覚えがあるでしょう。&i/o-malformed-filename-errorなどR6RSには採用されなかった例外もあります。

また、SRFI-36では標準の手続きがどの例外を投げるべきかということも定めています。例えば、call-with-input-fileは&i/o-filename-errorもしくはそのサブタイプの例外を投げなければならないとしています。

ちなみに、これらのSRFIはSRFI-34と同時に例外に関するSRFIとして出されたみたいです(参考)。さらにSRFI-35の議論で慣例的に例外型の名前に付けられる&の説明もあったりと、歴史的経緯を眺めるのも面白いです。

個人的にはこれらのSRFIはR7RSに入るべきだったと思うのですが、まぁ、世の中そう上手く行かないものです。(R7RSをR5RS処理系がR8RSに移行する際の緩衝材的な位置づけとみれば*1納得できなくもないのですが、それはそれでどうかなぁとも思ったり…)

今回はSRFI-35/36を紹介しました。

*1: R7RSにそれとなくそんな感じの文言があったりします(深読みしすぎ)

However, most existing R5RS implementations (even excluding those which are essentially unmaintained) did not adopt R6RS, or adopted only selected parts of it.

Weak hashtable

確かにこういうケースを考えるとシンボルとキーワードはGCされた方がありがたいな。実際シンボルを作っては捨てるみたいなのを書いたらメモリーが大変なことになったし。 https://t.co/Ft64oBlIDb
— Kei (@tk_riple) October 17, 2014

こういったいきさつがあって、シンボル(とその他2つ)をGC対象にしたのだが、どうもweak hashtableの実装がまずいらしく、多少改善された程度のメモリー消費量にしかなっていない。とりあえず実装を見直してみると、weah hashtableとhashtableの実装上にweak boxを載せてそれっぽく見せているのだが、どうもこのweak boxが消えないのでエントリー数が増え続けるという感じみたいである。一応キーが回収された際にエントリーを消すような小細工がされてはいるのだが、なぜか上手く動いていない感じである。

どうするか？というのがあるのだが、解決方法は2つくらい案があって、

1. Weak hashtableを別実装にしてしまう。
   hashtable-ref等の手続きを共有して使えないのだからコードを共有する必要があまりなくね？という発想。
2. Hashtable側のAPIをリッチにする
   バケツの割り当て等を外部から操作できるようにしてしまえば何とかなりそうじゃね？という発想。

1は多分楽なんだけど、後々のことを考えると(主にメンテ)ある程度のコードは共有しておきたい気もする。2は茨の道なんだけど(パフォーマンスとか)、上手く作ればメンテが楽になりそう。

どちらの道をとったとしても、weak boxの扱いをどうするかという問題は残るのでこれはちと考える必要がある。

追記(2014年10月18日)
よく考えてみればエントリー数が減らないのはweak hashtableの値がGCされた際に対象のエントリーを削除しないのが問題なので、値がGCされた際に対象のエントリーを削除するように変更した(後方互換を保つためにフラグを一個追加した)。なんとなく、動いているっぽいので当面はこれでよしとしよう。

R5RS auxiliary syntaxes

Recently, there was the post which introduced SCLINT on reddit/lisp_ja: #:g1: SCLINTの紹介. SCLINT is a lint-like program for Scheme written in R4RS Scheme. (Interestingly, Sagittarius could run this without any modification :) but it's not the topic for now.). So for some reason, I've tried to run on R7RS implementations using (scheme r5rs) library. I don't know how this idea came up, but the result was rather interesting.

So I've prepared the following script;

(import (only (scheme base) error cond-expand include)
        (scheme process-context) 
        (scheme r5rs))

(cond-expand
 (foment
  (include "\\cygwin\\tmp\\sclint09\\pexpr.scm"
           "\\cygwin\\tmp\\sclint09\\read.scm"
           "\\cygwin\\tmp\\sclint09\\environ.scm"
           "\\cygwin\\tmp\\sclint09\\special.scm"
           "\\cygwin\\tmp\\sclint09\\procs.scm"
           "\\cygwin\\tmp\\sclint09\\top-level.scm"
           "\\cygwin\\tmp\\sclint09\\checkarg.scm"
           "\\cygwin\\tmp\\sclint09\\sclint.scm"
           "\\cygwin\\tmp\\sclint09\\match.scm"
           "\\cygwin\\tmp\\sclint09\\indent.scm"))
 (else
  (include "/tmp/sclint09/pexpr.scm"
           "/tmp/sclint09/read.scm"
           "/tmp/sclint09/environ.scm"
           "/tmp/sclint09/special.scm"
           "/tmp/sclint09/procs.scm"
           "/tmp/sclint09/top-level.scm"
           "/tmp/sclint09/checkarg.scm"
           "/tmp/sclint09/sclint.scm"
           "/tmp/sclint09/match.scm"
           "/tmp/sclint09/indent.scm")))

(sclint (cdr (command-line)))

The original article is using load but foment complained that scling is not defined. So above is using include instead (even though I've used include yet Foment raised errors...). And execute it with 4 implementations, Chibi, Foment, Gauche and Sagittarius (both 0.5.8 and HEAD). The result was only Gauche could execute as I expected. Foment raised 2 errors (I don't know why), Chibi and Sagittarius raised an error with unbound variable else.

Apparently, the (scheme r5rs) library does't export 4 auxiliary syntaxes; =>, else, unquote and unquote-splicing; and one syntax (or macro transfomer) syntax-rules. I believe the last one is just missing but the others are bit more complicated.

The only purpose of (scheme r5rs) is to provide an easy way to import the identifiers defined by R5RS; it does not give you an R5RS emulator.
http://lists.scheme-reports.org/pipermail/scheme-reports/2014-October/004267.html

I thought the purpose is making sure R5RS scripts can be executed on R7RS implementations but seems not. Then question is that if the 4 auxiliary syntaxes are bound in R5RS. If I see R5RS then indeed it doesn't define them explicitly, however this post indicates they are;

R5RS 3.1.
> An identifier that names a type of syntax is called
> a syntactic keyword and is said to be bound to that syntax.

R5RS 7.1.
> <syntactic keyword> -> <expression keyword>
> | else | => | define
> | unquote | unquote-splicing

"else" is syntactic keyword, and syntactic keyword is bound to syntax.
Therefore, "else" is bound.
http://lists.scheme-reports.org/pipermail/scheme-reports/2014-October/004265.html

I think this interpretation is rather rational so I've added those auxiliary syntaxes to export clause of (scheme r5rs). However, I can also think of the objection that could be something like this; being bound to a syntax doesn't mean they were bound in R5RS (or its environment).

Well, I've already decided to add them so I don't have much option about this anymore but it would be convenient if legacy R5RS scripts can be executed on R7RS implementations with just importing
(scheme r5rs).

SRFI-34の紹介

(LISP Library 365参加エントリ)

SRFI-34はプログラムのための例外ハンドリングです。具体的にはwith-exception-handler、guardとraiseです。

使い方はSRFIに山ほどあるのと、R6RS以降のSchemeでは標準になっているので、このSRFIと標準との定義の違いをあげます。

(call-with-current-continuation
 (lambda (k)
   (with-exception-handler (lambda (x)
                             (display "something went wrong")
                             (newline)
                             'dont-care)
     (lambda ()
       (+ 1 (raise 'an-error))))))

上記の動作はR6RSではエラーとして定義されていますが、このSRFIでは未定義です。これは例外が継続可能かどうかという部分に関わってきます。参照：Is the condition continuable?

SRFIの紹介から多少逸脱するのですが、R6RS及びR7RSではguardがelseを持っていなかった場合にraise-continuableで例外を伝播させると定義されています。どういったいきさつがあったのかはR6RSのMLを探っていないので分からないのですが、これは以下のような場合に困ることになるかと思います。

(import (rnrs))

(define-condition-type &connection &error
  make-connection connection-error?)
  
(with-exception-handler
 ;; maybe you want to return if the condition is
 ;; warning
 (lambda (e) (display "condition is &error") (newline))
 (lambda ()
   (let retry () 
     ;; if it's connection error, then retry at this point.
     ;; if other point, it must be a fatal error.
     (guard (e ((connection-error? e)
                (display "connection error! retry") (newline)
                (retry)))
       ;; assume this is fatal
       (error 'connection "connection error")))))

コーディングバグといえばそれまでなのですが、投げられた例外が継続可能かどうかというのは例外を投げた手続きによって決定されるといのは一見スマートな解決案に見えて実際にはそうでもないという一例になるかと思います*1。

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

*1: 例えば投げられた例外が&seriousを含む&warningのようなものだとwarning?でチェックすると嵌ります。逆に&seriousを含むものでもraise-continuableで投げられた場合は継続可能になる等。個人的には筋が悪いなぁと思っています。

SRFI-31の紹介

(LISP Library 365参加エントリ)


SRFI-31は再帰的評価のための特殊フォームrecです。正直それが何を意味しているのかよく分からないのですが、Rationaleにはこんなことが書いてあります。

• 単純で直感的かつ数学的記述に近い表記
• 一般的な再帰の許可
• 手続き的にならない

このSRFIは上記を満たすものみたいです。

使い方は以下のようです。

(define F (rec (F N)
              ((rec (G K L)
                 (if (zero? K) L
                   (G (- K 1) (* K L)))) N 1)))

上記はfactを定義しています。これがどれくらい数学的記法に近いかは門外漢の僕には分かりかねるのですが、見たところ単に名前付きlambdaを作っているようです。(実際named-lambdaという言葉がRationaleに出てきます。)

定義を見ればrecは単にletrecに変換するマクロであることが分かります。

;; from reference implementation of this SRFI
(define-syntax rec
  (syntax-rules ()
    ((rec (NAME . VARIABLES) . BODY)
     (letrec ( (NAME (lambda VARIABLES . BODY)) ) NAME))
    ((rec NAME EXPRESSION)
     (letrec ( (NAME EXPRESSION) ) NAME))))

自分自身を参照するlambdaを束縛を作ることなく書く必要がある場合には便利かもしれません。

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

MQTT client and broker

I've implemented MQTT client and broker on Sagittarius. Now feeling like the broker implementation is compliant the specification (as far as I can see, there is probably a bug(s) though), so let me introduce a bit. APIs would be changed in 0.5.9 and probably I wouldn't write document until I think it can be fixed (nearest would be after 0.5.10).

If you don't need anything, even authentication, then the broker can be written like this;

(import (rnrs) (net mq mqtt broker))

(define broker (make-mqtt-broker "5000"))

(mqtt-broker-start! broker)

With this, broker runs on port 5000. When broker is ready then next step is client.

The basic functions for client are subscribing and publishing. Subscribing would be like this;

(import (rnrs) (net mq mqtt client))

(let ((conn (open-mqtt-connection "localhost" "5000")))
  (mqtt-subscribe conn "topic" +qos-exactly-once+
                  (lambda (topic payload)
                    (get-bytevector-all payload)))
  (let loop ()
    (let ((r (mqtt-receive-message conn)))
      (display r) (newline)
      (unless (eof-object? r)
        (loop))))
  (mqtt-unsubscribe conn "topic")
  (close-mqtt-connection! conn))

Subscribe procedure, currently, takes 4 arguments, MQTT connection, topic filter, QoS level and callback procedure. The callback procedure takes 2 arguments, topic name and payload. Payload is a binary input port. For now, we don't provide daemon thread for callback so users need to explicitly receive messages.

Publishing messages would be like this;

(import (rnrs) (net mq mqtt client))

(let ((conn (open-mqtt-connection "localhost" "5000")))
  (mqtt-publish conn "topic" (string->utf8 "Hello MQTT")
  :qos +qos-at-least-once+)
  (mqtt-publish conn "topic" #vu8())
  (close-mqtt-connection! conn))

Publish procedure, currently, requires 3 arguments and also can take some keyword arguments to specify how to publish such as QoS and retain. The application message must be a bytevector so that MQTT requires it to be binary data. Publishing empty bytevector would send empty payload.

Followings are some of design rationale (please add 'currently' before read).

[Socket connection]
Broker creates a thread per connection instead of dispatching with select (this is sort of limitation of underlying (net server) library). By default, max connection number is 10. If this is 2 then you can do private conversation and if it's 1 then you can be alone...

[Session control]
Managing session is done by one daemon thread which is created when broker is created. Default interval period it 10 second. So even if client keep-alive is 5 seconds and it idled for 6 seconds then send something, it can still be treated as a live session. Session could have had own timer however I don't have any lightweight timer implementation other then using thread and making thread is sort of expensive on Sagittarius. So I've decided to manage it by one thread.

[Client packet control]
Even though client needs to receive message explicitly however there is an exception. That is when server published a message to client and right after that client send control packet like subscribe. In that case client first consume the published message handling with given callback then sends control packet.

[QoS control for exactly once]
Broker publishes received message after PUBCOMP is sent. MQTT spec says it can initiate delivering after receiving PUBLISH.

[Miscellaneous]
When client subscribes a topic and publishes a message to the same topic, then it would receive own message. Not sure if this is correct behaviour...

Pointing a bug/posting an opinion would be grateful!

Timer

When I write asynchronous script, sometimes I want to a timer so that I can invoke some procedure periodically or so. So I've looked at POSIX's timer_create and Windows' CreateWaitableTimer. Then found out both needs some special treatment. For example, POSIX timer_create requires signal handling which is lacking on Sagittarius. (Honestly, I've never properly understood how signal masking works...)

So I've wrote sort of mimic code with thread.

(import (rnrs) (srfi :18))

;; simple timer
(define-record-type ( make-timer timer?)
  (fields (immutable thread timer-thread))
  (protocol (lambda (p)
              (lambda (interval thunk)
                (p (make-thread 
                    (lambda ()
                      (let loop ()
                        (thread-sleep! interval)
                        (thunk)
                        (loop)))))))))

(define (timer-start! timer) (thread-start! (timer-thread timer)) timer)
(define (timer-cancel! timer) (thread-terminate! (timer-thread timer)))

;; use it
(define t (timer-start! (make-timer 2 (lambda () (print "It's time!!")))))

(define (heavy-to-do)
  (thread-sleep! 5)
  (print "It was heavy!"))
(heavy-to-do)

Above prints It's time!! twice then finish heavy-to-do. Now I'm wondering if this is enough or not. Without deep consideration, I've got couple of pros and cons with this implementation.

[Pros]

• Easy to implement and could be portable.
• Asynchronous.

[Cons]

• Could be expensive. (Making thread is not cheap on Sagittarius)
• Timer can't change parameters which is thread local.

I think above points are more like how we want it to be but it seems better that timer runs the same thread for me. Now, look at both Windows and POSIX timer APIs. Seems both can take callback function. However on POSIX, if I use SIGEV_THREAD then it would create a new thread (it only says "as if" so may not). And not sure if Sagittarius can call a procedure using parent thread's VM without breaking something. So, it's most likely not an option...

Then Windows. SetWaitableTimer can also take a callback function. And according to MSDN, the callback function will be executed on the same thread.

The completion routine will be executed by the same thread that called SetWaitableTimer. This thread must be in an alertable state to execute the completion routine. It accomplishes this by calling the SleepEx function, which is an alertable function.
Using Waitable Timers with an Asynchronous Procedure Call

Now, I'm not sure what's alertable state exactly means. Seems the target thread should be sleeping and if so, sucks...

Hmmmm, it may not an easy thing to do.

SRFI-30の紹介

(LISP Library 365参加エントリ)

SRFI-30は複数行のコメントを扱うためのSRFIです。説明するよりコードを見た方が早いので、まずはコードです。

#|
This is the SRFI
  #|
    Nested comment is also okay (unlike C)
  |#
|#

この形式のコメントはR6RS以降のSchemeからサポートされています。SRFIが標準に格上げされたものの一つともいえます。(逆に言うとR5RS以前は複数行コメントは標準ではなかったという・・・)

実はこのSRFIで定義されているBNFをよくみると入れ子のコメントは扱えないようになっています。これはSRFIが決定されてからの議論で修正案が出ていて、参照実装をBNFにするとこうなるみたいです。

<comment> ---> ; <all subsequent characters up to a line break>
             | <srfi-30-comment>

<srfi-30-comment> ---> #| <srfi-30-comment-constituent>* |* |#

<srfi-30-comment-constituent> ---> #* <srfi-30-ordinary-char>
                                 | |* <srfi-30-ordinary-char>
                                 | #* <srfi-30-comment>

<srfi-30-ordinary-char> ---> <any character but # or |>

どうでもいい小話なのですが、この形式のコメントを使うとたまにEmacsがおかしなシンタックスハイライトをするようになるので個人的には多用していないです。求む回避方法。

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

簡単なサーバプログラム用フレームワーク

フレームワークというほどたいそうなものでもないのだが、何かしらサーバを書く際に唱えるおまじない部分を勝手にやってしまおうというもの。そろそろちょっとしたサーバがあると便利だよなぁという願望のもとえいや！っと書いてみた。

とりえあず、エコーサーバはこんな感じで書ける。

(import (sagittarius socket) (net server))

(define (handler socket)
  (let ((bv (socket-recv socket 255)))
    (socket-send socket bv)))

;; creates server object
(define server (make-simple-server "5000" handler))

;; start!
(start-server! server)

handlerはsocket-acceptで作られたソケットを受け取る。ちなみにフレームワーク側でソケットは閉じてくれるので明示的に閉じる必要はない。(閉じても特に痛くはないが)

これだけだと特にありがたみもないのだが、オプション引数で設定を取ることができる。こんな感じ。

(import (sagittarius socket) (net server))

(define (handler socket)
  (let ((bv (socket-recv socket 255)))
    (socket-send socket bv)))

;; server has daemon thread which watches :shutdown-port
;; for shutdown the server.
;; exception handler will be invoked when handler
;; raises an error.
;; given max-thread > 1 makes the server creates a
;; thread for each request. using (util concurrent)
(define config (make-server-config :shutdown-port "8888"
                                   :exception-handler (lambda (e s) (print e))
                                   :max-thread 10))

(define server (make-simple-server "5000" handler config))

(start-server! server)

上記の設定だと、最大スレッド数10、サーバを閉じる用のポート8888(この設定だとつないだ瞬間落とす)に例外ハンドラという感じになる。これ以外にもTLSソケットとかある。

(どうでもいいdesign rationale) なんでキーワード引数じゃなくconfigオブジェクトにしたかというと、こうしておくと拡張が楽かなぁという希望的観測があったからだったりする。例えばHTTPサーバを書こうと思った場合に継承してなんとかできないかぁという。どうなるかは実際に拡張を書いて見ないと分からないという・・・

ついでといっては何ではあるのだが、これを書くために(util concurrent)というJavaのjava.lang.concurrentにインスパイアされたライブラリを書いたりした(ぶっちゃけ名前だけ・・・中身は性質上にても似つかないという・・・)。中身はSRFI-18があれば限りなくR6RSポータルになっているが、SRFI-18をサポートしてる処理系の方が少ないという罠もある。

SRFI-29の紹介

、(LISP Library 365参加エントリ)

SRFI-29は名前の通りローカライズ(localiseのいい訳募集)のためのSRFIです。世の中英語で書いておけば大体OKな風潮ではありますが、エラーメッセージ等の言語を変更したい場合などに使える(かもしれない)ものです。

言語や地域の設定は以下のようにします。

(import (srfi :29))

(current-language)
;; returns current language (e.g. en)

(current-language 'fr)
;; sets language to French

(current-country)
;; returns current country (e.g. us)

(current-country 'nl)
;; sets country to Netherlands

(current-locale-details)
;; returns list of details (e.g. (utf-8))

(current-locale-details '(utf-8))
;; sets details

処理系によってはこの辺の情報を環境変数からとってきたりもします。(e.g. Gauche、Sagittarius)

言語ごとにメッセージを設定するにはdeclare-bundle!を使います。store-bundle!及びload-bundleは可能であればメッセージの設定を永続化及び読み込みを行います。

(let ((translations
       '(((en) . ((time . "Its ~a, ~a.")
                (goodbye . "Goodbye, ~a.")))
         ((fr) . ((time . "~1@*~a, c'est ~a.")
                (goodbye . "Au revoir, ~a."))))))
  (for-each (lambda (translation)
              (let ((bundle-name (cons 'hello-program (car translation))))
                (if (not (load-bundle! bundle-name))
                    (begin
                     (declare-bundle! bundle-name (cdr translation))
                     (store-bundle! bundle-name)))))
             translations))

上記はSRFIの例からですが、load-bundleでbundle-name(この場合はhello-program)の読み込みを試み、失敗すればdeclare-bundle!で設定、store-bundle!で永続化を試みます。実際に設定されたメッセージを取得するにはlocalized-templateを使います。

このSRFIではformatの拡張も定義されていて、~[n]@*でn番目に与えられた引数を参照します。例えば以下のような手続きを定義します(SRFIの例です)

(define localized-message
  (lambda (message-name . args)
    (apply format (cons (localized-template 'hello-program
                                            message-name)
                        args))))

(let ((myname "Fred"))
  (display (localized-message 'time "12:00" myname))
  (display #\newline)

  (display (localized-message 'goodbye myname))
  (display #\newline))
;; If current language is 'fr' then
;; prints 'Fred, c'est 12:00.'
;; and    'Au revoir, Fred.'

多少端折った説明になったのは僕自身はこのSRFIを使っていないので、今一使いどころを把握していないからなのですが、まぁ、こういうものだという部分は伝えられたかと思います。

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

SRFI-28の紹介

(LISP Library 365参加エントリ)

SRFI-28は基本な整形文字列です(訳難あり)。CLでおなじみのformat手続きをSRFIで提供するというものです。ただし、使用できる置換文字は~aと~sのみの非常に基本的なものです。(名前どおりですね)

使い方は以下の通り。

(format "~a~%" Hello world)
;; -> "Hello world"

CLと違い、format文字列の前に#tを入れてもエラーになります。~aでdisplay、~sでwriteが使われます。

参照実装では与えられたformat-stringをリストにしていますが、処理系によっては文字列の参照はO(1)で行われるのでstring-refで行った方が高速になるかもしれません。メモリスペースも多少節約できます。ひょっとしたら処理系によっては文字列は文字のリストでstring->listが時間、空間ともにO(1)で終わるものもあるかもしれません(少なくともR5RS以降では規格違反ではありますが)。
 
今回はSRFI-28を紹介しました。

Is the condition continuable?

Since R6RS, Scheme has continuable exception which I think a good thing so that libraries may choose its behaviour when warning happened. R6RS has even the condition type &warning to let users know this. A bad thing is that, there is no way to know how the condition is raised. Think about this piece of code.

(import (scheme base) (scheme write))

(define-syntax safe-execute
  (syntax-rules ()
    ((_ expr ...)
     (with-exception-handler
      (lambda (e) #t)
      (lambda () expr ...)))))

(guard (e (else (display e) (newline) (raise e)))
  (safe-execute (raise "error huh?")))

The safe-execute just wraps given expression with with-exception-handler so that it can propagate non continuable condition to caller but can continue the process if the condition is just an warning. Now the problem is that, it doesn't propagate the raised condition as it is but modifies to something &non-continuable. For example, if you write the same code in R6RS and run it on Chez Scheme then the original condition's information disappears. (not sure if this is a bug of Chez though.)

So to keep my mind calm and mental health as healthy as possible, it is better to detect if the given condition is raised by raise or raise-continuable. However there is no way to do it with portable way. If you are an R6RS user, you may have slight hope, which is checking &warning or &non-continuable. If a script just wants to tell you an warning, then it usually raises an &warning condition. Thus checking this would make you a bit happy. Although, raise can take any Scheme object including &warning so this solution depends on the behaviour or philosophy of libraries. Moreover, guard without else needs to re-raise the caught condition with raise-continuable. This may cause something unexpected result if such a guard expression is wrapped by with-exception-handler.

Now, look at R7RS. It becomes totally hopeless. It doesn't have condition type, so the only hope that R6RS has is gone. The behaviour of all of related procedures and macro are the same as R6RS and it doesn't provide a procedures which can check if the condition is continuable or not, either. So this is totally depends on implementations.

If this is the case, then how the implementations behave. I've tested above piece of code with 4 implementations, Sagittarius, Chibi, Gauche and Foment. The results are followings;

• Sagittarius - compounded the condition with &non-continuable
• Chibi - changed condition with "exception handler returned" message (I guess)
• Gauche - didn't print message at all (bug?)
• Foment - propagated original condition.

For Gauche, if I changed raise to error it did print an error object. So it may not allow user to raise non condition object.

I'm not yet sure how important handling runtime exception is on Scheme. I've never written code that considers error other than just catching and logging. So this may be a trivial case.

FFIバインディングは人間が手で書くものではない

というのを1年前に掲げて絶賛放置していたプロジェクトを何とか動くところまで持っていった。

https://github.com/ktakashi/sagittarius-ffi-helper

前は確かGTkか何かのバインディングを書くのが嫌でこれ作ったんだけど、GTkのバインディングを書く方を放置プレイに追い込んでしまったので同じく放置されていた。っで、最近DB2を扱う必要が出てきて、わざわざSQL走らせるのにGUI起動視するとか馬鹿らしいのでDBDが要るということから、あれよあれよと動くまで持っていった。

0.5.7で動くんだけど、生成されるコードは0.5.8用という仕様。理由は0.5.7のFFIは共用体のサポートがないからだったりする。逆に言えば、共用体がないのであれば、0.5.7でも動く(はず)。

簡単な仕様としては、マクロで定義された定数、typedef、構造体、共用体、列挙子なんかはそれなりに出力される。関数は可変引数にまだ対応してないのでそれがあると死ぬ。genbindが生成用のスクリプトで、合計で4つのファイルが生成される。構造体、共用体、列挙子とtypedefは定義と同名で、定数と関数はScheme的な名前に変更される。オプションで制御可能。

中身が非常に汚いので、綺麗にリファクタリングしてくれる奇特な方がいたら大歓迎。

これからはFFIバインディング書くのが楽になりそうな雰囲気が出てきた。(っが何時までたっても必要ドリブンなので、気の向くまま何かを書くということはないが・・・)

syntax-caseで嵌った話

前にも似たような経験をしてTwitterに投げただけでまとめてない気がしたので書いておく。

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

(import (rnrs))

(define-syntax define-foo
  (syntax-rules ()
    ((_ name)
     (begin
       (define name 'foo)
       (letrec-syntax
           ((gen (lambda (x)
                   (syntax-case x ()
                     ((k proc)
                      (with-syntax ((bar (datum->syntax #'k 'bar)))
                        #'(define bar proc))))))
            (get (syntax-rules ()
                   ((_) (gen (lambda (o) o))))))
         (get))))))

(let ()
  (define-foo name)
  (bar 'a))

期待するのはlet内のbarが参照可能であることなのだが、実際にはこれは見えない。Sagittarius類似コードを書いていたので「またマクロのバグか」と思っていたのだが、他の処理系でもエラーになる。自分の処理系ほど信じていないという切ない話ではあるのだが、よくよく考えればエラーになるのが筋なのである。

R6RSの構文オブジェクト周りを理解するのは骨が折れるのだが、今回の話はdatum->syntaxなのでその定義を見てみよう。

Template-id must be a template identifier and datum should be a datum value. The datum->syntax procedure returns a syntax-object representation of datum that contains the same contextual information as template-id, with the effect that the syntax object behaves as if it were introduced into the code when template-id was introduced.

 datum->syntaxによって生成される構文オブジェクトはtemplate-idと同じコンテキストの構文オブジェクトになる。これを踏まえて上記のコードをかなり目を凝らして見てみると、datum->syntaxのコンテキストとlet内のbarのコンテキストは違うように見える。letで作成されるコンテキストA、define-foo内のマクロ作成されるコンテキストBという風に見る(のだと思う)。AはBの外側のコンテキストと取れる。これと健全性の定義を照らし合わせてみる。

A binding for an identifier introduced into the output of a transformer call from the expander must capture only references to the identifier introduced into the output of the same transformer call. A reference to an identifier introduced into the output of a transformer refers to the closest enclosing binding for the introduced identifier or, if it appears outside of any enclosing binding for the introduced identifier, the closest enclosing lexical binding where the identifier appears (within a syntax <template>) inside the transformer body or one of the helpers it calls.

 これが今一理解できてないのではあるが、外側のコンテキストは内側のコンテキストを参照できないと読めなくもない。(内側のコンテキストが先に作られるので、先にできた束縛を後から作られたものが参照可能だと健全性が壊れるような気がする。) コードをこう書き換えると分かりやすいかもしれない。

(import (rnrs))

(define-syntax define-foo
  (syntax-rules ()
    ((_ name)
     (begin
       (define name 'foo)
       (define-syntax gen 
         (lambda (x)
           (syntax-case x ()
             ((k proc)
              (with-syntax ((bar (datum->syntax #'k 'bar)))
                #'(define bar proc))))))
       (define-syntax get
         (syntax-rules ()
           ((_) (gen (lambda (o) o)))))
       (get)))))

(let ()
  (define-foo name)
  (bar 'a))

これなら、上記の解釈が正しいと仮定すると、getとgenによって作られたbarがlet内にあるbarとは別物に見える。

この辺に詳しい人の突込みが待たれるところである。

捕捉
ちなみに、Sagittariusではletを取り除いてやると動いてしまうのだが、これは上記の解釈によればバグである。 っが、今のところ直す気はない。(MPが足りてない)

Resolving let-method (2)

I've got sharp comment on previous article. Apart from the comment, I've found sort of critical issue on thread local storage solution. That is evaluating library form in eval won't add method to generic function. Well library form is not allowed to evaluate with eval on both R6RS and R7RS however Sagittarius allows it. (And I might have already written such code ...)

So forget about thread local storage. For now add-method checks current environment whether or not it's a child environment which is created by either environment procedure or a thread. The name child environment may confuse you but I just don't have any good name for this, so bare with it :) If add-method is called in child environment then it adds method to only in that context. If not, then adds globally.

Difference? Well sort of the same but it has now a way to affect changes globally. In the remote REPL situation discussed in previous article comment, it can be done with with-library macro. Other changes are only in the child context.

;; in remote REPL and we want to apply a patch
(import (sagittarius control))

(with-library (foo)
  ;; fix it
  (define-method bar ...))

This is just a fix before I forget, so it's time to read the paper.

Resolving let-method

The previous article showed that there is a multi threading issue on let-method. In general, current Sagittarius adds generic method globally even whenever it's defined. So if the load loads a script with define-method then the generic method is added to the global binding. Thus the effect is globally done even though it's loaded in child thread.

This is not a good behaviour I believe so I've changed it. Current head has following behaviour;

• If a method is defined in main thread - adds method globally
• If a method is defined during importing a library - ditto
• If a method is defined in child thread and not library importing period - adds thread local storage.
• Generic functions are inherited from parent thread but child thread can't contaminate parent.

The thread local storage is VM's register I've added, generics (not sure if the name is proper but reasonable isn't it?). The changes are done in three places, add-method, remove-method and compute-methods. There are slight change of slot accessor of generic function as well but this is trivial.

The change of compute-methods is not a big one. It now just considers generic methods of current thread. Like I mentioned above, generic methods are located two places, one is generic function's methods slot and the other one is thread local storage. Thus compute-methods needs to get all methods both the slot and storage.

add-method and remove-method are a bit more tricky. First it needs to detect whether or not it's running on main thread or during library importing period. If the definition is executed on that term then it adds the methods to generic function's slot. If not, then it adds thread local storage with some more information. (currently maximum required argument number.)

Now following piece of code runs as I expected.

(import (rnrs) (clos user) (srfi :1) (srfi :18) (srfi :26))
 
(define-generic local)
 
(define (thunk)
  (thread-sleep! 1)
  (let-method ((local (a b c) (print a b c)))
    (thread-sleep! 1)
    (local 1 2 3))
  (local "a" "b" "c"))
 
(let ((ts (map thread-start! (map (cut make-thread thunk <>) (iota 10)))))
  (for-each thread-join! ts))
;; may prints some of the value
;; then raises an error.

The solution itself might be a bit ugly (treating generic function specially) but behaving properly is more important.

let-method

Sagittariusはlet-methodという総称関数のスコープを限定する構文をもっているのだが、これとマルチスレッドが絡むとうまく動かないという話。

例えば以下のようなのを考えてみる。

(import (rnrs) (clos user) (srfi :1) (srfi :18) (srfi :26))

(define-generic local)

(define (thunk)
  (thread-sleep! 1)
  (let-method ((local (a b c) (print a b c)))
    (thread-sleep! 1)
    (local 1 2 3))
  (local "a" "b" "c"))

(let ((ts (map thread-start! (map (cut make-thread thunk <>) (iota 10)))))
  (for-each thread-join! ts))

let-methodの外側で呼ばれるlocalメソッドはどのような場合でもエラーを投げることが期待されるのだが、実はこれが期待通りには動かない。理由はいたって簡単で、スレッドAが二度目のlocal呼び出しをする際にスレッドBがlet-method内であればlocal自体は特殊化されたメソッドを持っていることになる。あまり使わない構文な上に、マルチスレッド環境のことなど頭から抜け落ちていたのでこういうことに気付かなかった。

では、どうするかということもついでに考えてみる。現状では総称関数はスレッド関係なくグローバルに影響を与えるのだが、こいつをスレッド毎にしてしまえばいいだけの話ではある。総称関数だけを特別視するというのは多少気持ち悪い部分もあるのだが、パラメタと同じでVMにそれ様のレジスタを追加しスレッドが作成されたらコピーすればいいという話になる。そうすることで大元の総称関数は変更されない。

問題はdefine-genericもdefine-methodも単なるマクロで、内部的には総称関数を作ってdefineで定義しているだけという部分と、VMは識別子を一度参照するとGLOCに置き換えるという点である。最初の問題は実はそんなに大きくなく、束縛を作成する際に値が総称関数であれば現在のVMに追加してやればいい。(そもそも子スレッドで束縛を作るというのはいかがなものかという話もあるのだが。) GLOCの問題はGLOCがコンパイルされたコードに埋め込まれつつ、この中身が基本変更されないという前提があることに起因する。GLOCがあるとコピーされた総称関数が参照できないということになる。

とりあえず思いつく限りでは2つ解決策がある。

• 総称関数の参照はGLOCにしない
• 総称関数の呼び出し時にうまいこと解決する

一つ目は全体のパフォーマンスに影響を与えそうではあるが、常に参照を解決するようにして束縛を探す際にコピーされた総称関数を返してやればよさそうである。
二つ目はVMのレジスタが大元の総称関数とコピーされたものの紐付けを持っておき、呼び出し時にコピー側に解決するというもの。単なる参照として別の手続きに渡された際にどう解決するかというもの。GREFが走るたびにチェックを設けていてはGLOCの意味がない気がするが、総称関数を扱う手続き全てにコピーを探す何かを入れるのはだるい。(本質的にはadd-methodとremove-methodだけを特別視すればいいような気がしないでもないが、ちと自信がない。)

あまり使わない機能な上に直すとパフォーマンスに影響がでるから割と腰が重めである・・・

追記
add-methodがスレッドローカルなストレージにメソッドを格納してcompute-methodsがその辺をうまいこと何とかすればいけそうな気がしないでもない気がしてきた。 add-methodにオプション引数としてスレッドローカルか判別するフラグつけて、let-methodが呼び出すadd-methodはそのオプションを受け付けるようにしてやればよさそう。(もしくはadd-method-localを作るか。) remove-methodも同様にしてやる必要があるが、変に上記のようにごにょごにょするよりはすっきりしているかもしれない。

Ambiguous WSDL behaviour?

I haven't read WSDL 1.1 specification thoroughly yet but it seems there is an ambiguous behaviour to create a XML message.

I've prepared following files (it's extremely simplified to make this article short).
example.wsdl

<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<definitions targetNamespace="http://example.com/" name="ExampleService" xmlns="http://schemas.xmlsoap.org/wsdl/" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:tns="http://example.com/" xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/">
  <types>
    <xsd:schema>
      <xsd:import namespace="http://example.com/" schemaLocation="schema1.xsd"/>
    </xsd:schema>
    <xsd:schema>
      <xsd:import namespace="com.example" schemaLocation="schema2.xsd"/>
    </xsd:schema>
  </types>
  <message name="create">
    <part name="parameters" element="tns:create"/>
  </message>
  <message name="createResponse">
    <part name="parameters" element="tns:createResponse"/>
  </message>
  <message name="ExampleServiceException">
    <part name="fault" element="tns:ExampleServiceException"/>
  </message>
  <portType name="Interface">
    <operation name="create">
      <input message="tns:create"/>
      <output message="tns:createResponse"/>
      <fault message="tns:ExampleServiceException" name="ExampleServiceException"/>
    </operation>
  </portType>
  <binding name="ExampleInterfacePortBinding" type="tns:Interface">
    <soap:binding transport="http://schemas.xmlsoap.org/soap/http" style="document"/>
    <operation name="create">
      <soap:operation soapAction=""/>
      <input>
        <soap:body use="literal"/>
      </input>
      <output>
        <soap:body use="literal"/>
      </output>
      <fault name="ExampleServiceException">
        <soap:fault name="ExampleServiceException" use="literal"/>
      </fault>
    </operation>
  </binding>
  <service name="ExampleService">
    <port name="ExampleInterfacePort" binding="tns:ExampleInterfacePortBinding">
      <soap:address location="REPLACE_WITH_ACTUAL_URL"/>
    </port>
  </service>
</definitions>

schema1.xsd

<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<xs:schema version="1.0" targetNamespace="http://example.com/" xmlns:tns="http://example.com/" xmlns:xs="http://www.w3.org/2001/XMLSchema" xmlns:ns1="com.example">

  <xs:import namespace="com.example" schemaLocation="schema2.xsd"/>

  <xs:element name="ExampleServiceException" type="tns:ExampleServiceException"/>

  <xs:element name="create" type="tns:create"/>

  <xs:element name="createResponse" type="tns:createResponse"/>

  <xs:complexType name="create">
    <xs:sequence>
      <xs:element name="request" type="ns1:Request" minOccurs="0"/>
    </xs:sequence>
  </xs:complexType>

  <xs:complexType name="createResponse">
    <xs:sequence>
      <xs:element name="response" type="ns1:Response" minOccurs="0"/>
    </xs:sequence>
  </xs:complexType>

  <xs:complexType name="ExampleServiceException">
    <xs:sequence>
      <xs:element name="message" type="xs:string" minOccurs="0"/>
    </xs:sequence>
  </xs:complexType>

</xs:schema>

schema2.xsd

<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<xs:schema version="1.0" targetNamespace="com.example" xmlns:xs="http://www.w3.org/2001/XMLSchema" xmlns:ns2="com.example">

  <xs:import namespace="http://example.com/" schemaLocation="schema1.xsd"/>

  <xs:complexType name="Request">
    <xs:sequence>
      <xs:element name="id" type="xs:string" minOccurs="0"/>
    </xs:sequence>
  </xs:complexType>

  <xs:complexType name="Response">
    <xs:sequence>
      <xs:element name="id" type="xs:string" minOccurs="0"/>
    </xs:sequence>
  </xs:complexType>

</xs:schema>

Now, I've created a sample message on Soap UI and online WSDL analyser. The result of create messages are followings;

<soapenv:Envelope xmlns:soapenv="http://schemas.xmlsoap.org/soap/envelope/" xmlns:exam="http://example.com/">
   <soapenv:Header/>
   <soapenv:Body>
      <exam:create>
         <!--Optional:-->
         <request>
            <!--Optional:-->
            <id>?</id>
         </request>
      </exam:create>
   </soapenv:Body>
</soapenv:Envelope>

<ns1:create xmlns:ns1='http://example.com/'>
<!-- optional -->
  <request>
<!-- optional -->
    <ns2:id xmlns:ns2='com.example'>?XXX?</ns2:id>
  </request>
</ns1:create>

The point is that online WSDL analyser's one has namespace com.example and Soap UI one doesn't. Well, from the beginning, I don't understand why both request element doesn't have namespace at all.

As far as I know, JAX-WS requires Soap UI format so this is written some where in spec?

SRFI-27の紹介

(LISP Library 365参加エントリ)

SRFI-27は乱数ビットのソースです。 名前で分かるとおり、乱数の生成及びその生成源を扱うSRFIです。最も簡単な使い方は以下。

(import (srfi :27))

(random-integer 100)
;; -> random integer up to 100

(random-real)
;; -> random flonum range between 0 < x < 1

このスクリプトを複数回流した際に返される値がランダムになるかは実装依存です。例えば、Sagittariusでは最初の1回目は常に1が返ります。

さすがにそれは嬉しくないので、以下の結果を毎回ランダムにする方法が用意されています。

(random-source-randomize! default-random-source)

(random-integer 100)

default-random-sourceはrandom-integerとrandom-realで使用される乱数ソースです。それをrandom-source-randomize!でいい感じにシャッフルします。

デフォルトを変更したくないという我侭な要望にも柔軟に対応可能です。 以下のようにします。

(define my-random-integer
  (let ((s (make-random-source)))
    (random-source-randomize! s)
    (random-source-make-integers s)))

(my-random-integer 100)
;; random number

(random-integer 100)
;; 1 (on Sagittarius)

random-source-state-ref及びrandom-source-state-set!で乱数ソースの状態を取得、設定することも可能です。乱数ソースが何であるかは言及されていないのですが、書き出し可能なオブジェクトである必要があります。例えば、Sagittariusではバイトベクタ、Gaucheではu32ベクタ、Chibiは数値、Mosh及びYpsilon(ポータブルSRFI)ではリスト、Racketはベクタになっています。

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

最適化

ちょっとした最適化をコンパイルに入れた。具体的にはインポートした束縛でキャッシュ可能なものは定数展開してしまうというもの。以下がその例。

(library (foo)
    (export a)
    (import (rnrs))
  (define a 'a))
(import (rnrs) (foo))
;;(set! a 'b) ;; uncomment this would also work...
(disasm (lambda () (print a)))

こんな感じのライブラリをインポートすると

;; size: 5
;;    0: CONST_PUSH a
;;    2: GREF_TAIL_CALL(1) #<identifier print#user (0x80402708):0>; (print a)
;;    4: RET

こんな感じで、GREF_PUSHの変わりにCONST_PUSHが使われるというもの。これだけだと、実はあんまり嬉しくないんだけど、これにコンパイル時の手続き呼び出しが加わるとかなり最適化ができる。例えばaが文字列"1234"で、スクリプトが(print (string->number a))だとすると、string->numberがコンパイル時に解決されて数値1234が直接VMインストラクションとして出される。まぁ、そんなに上手いことはまるケースは少ないだろうけど、こういうのは入れておくと後で効いてくるというのが経験側から学んだことなので入れておいて損はないだろう。

現状で気に入らないのはset!の挙動なのだが、再定義と代入は別ものとしてエラーにした方が精神衛生上いいような気がする。スクリプト上の環境(+evalの環境)は再定義+代入可能にしているのでこれが可能なのだが(#!compatibleをつけても同様)、禁止するとREPL上でも禁止になるという弊害もある。そうは入ってもREPL上で(set! + 'hoge)とかやるかという話にもなるのだが、例えばMoshとChezはこれを禁止している(psyntaxがかね？)。ちなみに、NMoshとYpsilonは許容している(NMoshは奇妙な挙動をするけど)。

ちなみに、再定義もしくは代入された後は定数展開されない。というか、同一ライブラリで定義された場合はされないという話。これは、例えばGambit benchmarkのcompilerみたいなの対策だったりする(展開されると正しい結果が出ない場合)。ただし、library及びdefine-libraryフォーム内では別のロジックが走るので、展開される可能性はある。でも、よく考えれば、定数しかやらないので展開してしまってもいいかもしれない。後で考えよう。

追記
いや、やっぱり同一ライブラリ内では駄目だな。以下のようなのが困る。

(define b 'b)
(define (foo) (print b))
(foo)
(set! b 'c)
(foo)

これを定数展開してしまうと、二度目のfooが正しく動かない。

追記2
インポートされた束縛に対するset!は禁止することにした。再定義はOK。そういえばこの変更でR6RS/R7RS準拠のevalが書けなくもないのだが(定義禁止等)、まぁそこまでする必要は今のところないかなぁ。

SRFI-26の紹介

(LISP Library 365参加エントリ)

SRFI-26はカリー化を除いたパラメタの特殊化表記です。日本語にすると意味が分かりませんが(正しく訳せているのかすら疑問) 、要するにcutとcuteです。どちらも手続きを作成するマクロです。使い方は以下：

(cut cons a <>)
;; -> (lambda (tmp) (cons a tmp))

(cut list a <> <>)
;; -> (lambda (tmp1 tmp2) (list a tmp1 tmp2))

(cut list a <> <...>)
;; -> (lambda (tmp1 . xs) (apply list a tmp1 xs))

(cute cons (+ a 1) <>)
;; -> (let ((a1 (+ a 1))) (lambda (tmp) (cons a1 tmp)))

どちらのマクロも第一引数を手続きとみなし、残りをその手続きの引数とします。<>及び<...>はプレースホルダーで、作成された手続きに渡される引数に置換されます。出現する順番どおりに引数に展開されます。cutは引数をそのままlambdaに展開し、cuteの方はプレースホルダーである<>以外の引数を評価を一度だけ行うことを保障します。

プレースホルダーの使い方ではまるのが以下の例です。

(cut cons a (list b <>))
;; -> (lambda () (cons a (list b <>)))

プレースホルダーはcutもしくはcuteと同じ深さにいないといけません。個人的にこれは不便だなぁと思う点ではあるのですが、ネストを考慮するとsyntax-rulesで書けない(もしくはものすごく頑張らないといけない)ので、まぁしょうがないのではないでしょうか。

今回はSRF-26を紹介しました。

Performance turning - I/O

The R7RS benchmark showed that I/O was slow in Sagittarius. Well not quite, in R7RS library read-line is defined in Scheme whilst get-line is defined in C.This is one of the reason why it's slow. There is another reason that makes I/O slow which is port locking.

Sagittarius guarantees that passing a object to the port then it writes it in order even it's in multi threading script. For example;

(import (rnrs) (srfi :18) (sagittarius threads))

(let-values (((out extract) (open-string-output-port)))
  (let ((threads (map (lambda (v) 
   (make-thread (lambda ()
           (sys-nanosleep 3)
           (put-string out v)
           (newline out))))
        '("hello world"
   "bye bye world"
   "the red fox bla bla"
   "now what?"))))
    (for-each thread-start! threads)
    (for-each thread-join! threads)
    (display (extract))))

This script won't have shuffled values but (maybe random order) whole sentence.

To make this, each I/O call from Scheme locks the given port. However if the reading/writing value is a byte then the locking is not needed. Now we need to consider 2 things, one is a character and the other one is custom ports. Reading/writing a character may have multiple I/O because we need to handle Unicode. And we can't know what custom port would do ahead. Thus for binary port, we don't have to lock unless it's a custom port. And for textual port, we can use string port without lock.

Now how much performance impact with this change? Following is the result of current version and HEAD version:

% ./bench sagittarius tail
Testing tail under Sagittarius
Compiling...
Running...
Running tail:10

real    0m26.155s
user    0m25.568s
sys     0m0.936s

% env SAGITTARIUS=../../build/sagittarius ./bench sagittarius tail

Testing tail under Sagittarius
Compiling...
Running...
Running tail:10

real    0m19.417s
user    0m18.703s
sys     0m0.904s

Well not too bad. Plus this change is not for this particular benchmarking which uses read-line but for generic performance improvements. Now we can finally change the subjective procedures implementation. The difference between get-line and read-line is that handling end of line. R7RS decided to handle '\r', '\n' and '\r\n' as end of line for convenience whilst R6RS only needs to handle '\n'. Following is the result of implementing read-line in C.

% env SAGITTARIUS="../../build/sagittarius" ./bench -o -L../../sitelib sagittarius tail

Testing tail under Sagittarius
Compiling...
Running...
Running tail:10

real    0m5.031s
user    0m4.492s
sys     0m0.795s

Well it's as I expected so no surprise.