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を紹介しました。