Syntax parameters (aka SRFI-139)

Marc Nieper-Wißkirchen submitted an interesting SRFI. The SRFI was based on the paper 'Keeping it Clean with Syntax Parameters'. The paper mentioned some corner case of breaking hygiene with datum->syntax, which I faced before (if I knew this paper at that moment!).

In 'Implementation' section, the SRFI mentions that this is implemented on 'Rapid Scheme', Guile and Racket. Unfortunately there's no portable implementation. In my very prejudiced perspective, Guile isn't so fascinated by macro, so the syntax parameters is probably implemented on top of existing macro expander (I haven't check since Guile is released under GPL, and if I see the code it may violates the license). If so, it might be able to be implemented on syntax-case.

Without any deep thinking, I've written the very sloppy implementation like this:

#!r6rs
(library (srfi :139 syntax-parameters)
  (export define-syntax-parameter
          syntax-parameterize)
  (import (rnrs))

(define-syntax define-syntax-parameter
  (syntax-rules ()
    ((_ keyword transformer)
     (define-syntax keyword transformer))))

(define-syntax syntax-parameterize
  (lambda (x)
    (define (rewrite k body keys)
      (syntax-case body ()
        (() '())
        ((a . d)
         #`(#,(rewrite k #'a keys). #,(rewrite k #'d keys)))
        (#(e ...)
         #`#(#,@(rewrite k #'(e ...) keys)))
        (e
         (and (identifier? #'e)
              (exists (lambda (o) (free-identifier=? #'e o)) keys))
         (datum->syntax k (syntax->datum #'e)))
        (e #'e)))
      
    (syntax-case x ()
      ((k ((keyword spec) ...) body1 body* ...)
       (with-syntax (((n* ...)
                      (map (lambda (n) (datum->syntax #'k (syntax->datum n)))
                           #'(keyword ...)))
                     ((nb1 nb* ...)
                      (rewrite #'k #'(body1 body* ...) #'(keyword ...))))
         #'(letrec-syntax ((n* spec) ...) nb1 nb* ...))))))
)

And this can be used like this (taken from example of the SRFI):

#!r6rs
(import (rnrs) (srfi :139 syntax-parameters))

(define-syntax-parameter abort
  (syntax-rules ()
    ((_ . _)
     (syntax-error "abort used outside of a loop"))))

(define-syntax forever
  (syntax-rules ()
    ((forever body1 body2 ...)
     (call-with-current-continuation
      (lambda (escape) 
 (syntax-parameterize
  ((abort
    (syntax-rules ()
      ((abort value (... ...))
       (escape value (... ...))))))
  (let loop ()
    body1 body2 ... (loop))))))))

(define i 0)
(forever
 (display i)
 (newline)
 (set! i (+ 1 i))
 (when (= i 10)
   (abort)))

(define-syntax-parameter return
  (syntax-rules ()
    ((_ . _)
     (syntax-error "return used outside of a lambda^"))))

(define-syntax lambda^
  (syntax-rules ()
    ((lambda^ formals body1 body2 ...)
     (lambda formals
       (call-with-current-continuation
 (lambda (escape)
          (syntax-parameterize
    ((return
      (syntax-rules ()
        ((return value (... ...))
  (escape value (... ...))))))
    body1 body2 ...)))))))

(define product
  (lambda^ (list)
    (fold-left (lambda (n o)
   (if (zero? n)
       (return 0)
       (* n o)))
        1 list)))

(display (product '(1 2 3 4 5))) (newline)

I've tested on Chez, Larceny, Mosh and Sagittarius.

This implementation violates some of 'MUST' specified in the SRFI.

1. keyword bound on syntax-parameterize doesn't have to be syntax parameter. (on the SRFI it MUST be)
2. keyword on syntax-parameterize doesn't have to have binding.

And these are the sloppy part:

1. define-syntax-parameter does nothing
2. syntax-parameterize traverses the given expression.

If there's concrete test cases and the above implementation passes all, I might send it as a sample implementation for R6RS.

Weirdness of self evaluating vector

Scheme's vector has a history of being non-self evaluating datum and self evaluating datum. The first one is on R6RS, and the latter one is R7RS (not sure about R5RS). Most of the time, you don't really care about the difference other than it requires ' (quote) or not. However, you may need to think about the difference and maybe also think self evaluating causes more trouble. One of the particular case (and this is the only case I think self evaluating vector is evil) is when vector is used in macro.

Have a look at this case:

(import (rnrs))

(define-syntax foo
  (syntax-case ()
    ((_ e) e)))

(foo #(a b c))

What do you think how it behaves? The answer is depending on the standard. On R6RS, vectors are not self evaluating data so this should be an error. So you can't complain if you'd get a daemon from your nose. On R7RS (of course you should change the importing library name to (scheme base)), on the other hand, vectors are self evaluating data so this should return the input vector.

Now, how about this case?

(import (scheme base) (scheme write))

(define-syntax foo
  (syntax-rules ()
    ((_ "go" (v ...) ())         #(v ...))
    ((_ "go" (v ...) (e e* ...)) (foo "go" (v ... t) (e* ...)))
    ((_ e ...)                   (foo "go" () (e ...)))))

(foo a b c d e)

What would be the expansion result of macro foo? I think this is totally up to implementations (if it's not please let me know). For example, Chibi returns vector of something like {Sc #22 #<Environment 4365836288> () t} (syntactic closure, I think), Sagittarius returns vector of identifier, and Larceny returns vector of symbol t. If you put ' (quote) to the result template then the expansion result should be the same as Larceny returns (though, Chibi still returned a vector of syntactic closure, so this might not be defined, either).

Back to the first case. The first case sometimes bites me when I write/use R6RS macro in R7RS context. For example, SRFI-64 is implemented in R6RS macro and using it like this:

(import (scheme base) (srfi 64))

(test-begin "foo")

(test-equal "boom!" #(a b) (vector 'a 'b))
;; FAIL!!

(test-end)

On Sagittarius, R6RS macro transformer first converts all symbols into identifiers, then syntax information will be stripped only if expressions have quote. Now, SRFI-64 is implemented on the R6RS macro transformer and the vector doesn't have quote. Thus, symbols inside of the vector are converted to identifiers. If it's R6RS, then it's an error. But if it's R7RS, it should be a valid script.

I have sort of solution (not sure if I do it or not): Internally, symbol and the identifiers converted from symbols without any context (c.f. not using datum->syntax) are theoretically the same. So if compiler sees such an identifier, then it should be able to unwrap it safely.

I haven't decided how it should be. So for now, just a memo and let it sleep.

価値観の違い

立場が違えば価値観は当然違う。良い悪いという話ではなく、そういうものだと思っている。一時間半に及ぶ最終面接(といって良いのかあれ？)でふと思ったこととをつらつら書いてみる。

現在絶賛転職活動中の僕は今週に1回(今日終わった)、来週に2回とえらい密度で面接が組まれている。別にここまで積極的にするつもりはなかったんだけどタイミング的にこうなった、正直辛い。っで、今日あった最終面接はその会社のオーナーとだったんだけど、なかなか面白い意見だなぁと思った。曰く

• その会社で絶対働きたいという熱意がいる
• 会社名のタトゥーをいれるくらいとか
• 40時間越えて働いても残業代請求しないとか
• 金が欲しい開発者ならGoogleにでも行け
• 熱意があるやつが欲しいそうな
• 給料が高すぎるとよくないから(全社員共通の)上限がある
• ちなみに上限はAmazonのオファーより1万5千ユーロほど低かった
• そして上限を上げるつもりはないらしい(といわれた)
• オファーを比較して自分の市場価値を探るのは好きではない
• 自分もやってたけど意味無いってさ
• 比較せずさっさと受けろという意味だとは思うけど

経営者の視点というか、これだけ見るとブラック企業(違法企業)にしか見えないが、条件自体はそこまで悪くない。ただ、3年で給料の上限にぶちあたる可能性(4%の昇給があったとして)があるのでよくもない。面白い話として、その会社の社員の一人は週末にプログラミングの講師をしているそうだ。っで、もし給料が今の倍、もしくはGoogleに準ずるレベルだったらその彼は週末を遊んで過ごすだろう、とも。個人的にこの話で何を説得したかはさっぱり分からないけど、僕の意見としては：

• 副業をしなければいけないほど給料が安い
• そうでないのなら、Google並みの給料もらってもやってると思う

というもの。言わなかったけど。面白い意見だなぁと思ったけど、個人的には萎える意見の類ではある。

もう一つ別に引っかかったのは、「半年もすれば会社で一番の開発者になれる可能性がある」というもの。職場で勉強しようとかそういう気持ちはないんだけど、お山の大将になるつもりもなくて、「全力で追いかけても追いつけない」くらいの人がいる職場の方がいいんだけどなぁ、とか。たった一文の中で矛盾する二つの意見があるというのは置いておいて。同じ条件なら後者を選ぶという程度ではあるが。最先端を常に追いかけてるテック企業といってる割には、僕程度が半年で頂点に立てるレベルというのも今一矛盾しているような。

ここからは個人的な被雇用者としてあり方なんだけど：

• 労働を提供する対価を雇用者に求めている
• 仕事のやりがいと称して対価を下げる行為を嫌っている
• 対価に勝る評価方法はない
• 僕の労働をより評価してくれる雇用者に容易に移る

要するに、金ですよ。日本で働くことはすごく辛かったけど、一つだけ同意した言葉が今でもある。それが「金に勝る評価方法ない」というもの。どれだけ口で感謝されてもそれでは生きていけないのですよ、ワ○ミの社員ではないんで。もちろん、僕は僕とて市場価値を上げるように努力しているつもりではいるが。まぁ、プログラム書くこと(もしくはそれに関わること、論文読むとか)＝趣味なので努力とは違う気もしないでもないが(それだけでは年齢的にも頭打ちな感じがしないでもないところが辛いところ、かといってこれという何かもないけど)。

会社自体は創業20何年だけどオーナーが変わったのが去年らしく、どうにもスタートアップ的なのか体育会系的なのか分からないが妙にこう会社に尽くす人が欲しい的な雰囲気を前面に押し出す感があった(体育会系じゃないスタートアップに失礼か？)。来週までに辞意を今の会社に告げないと開始時期が9月になるという時期でもあるので、オファー出したら即日もしくは週末を挟んでの月曜日に返事が欲しいとか(流石にもう少し待ってもらうことになったけど)すごい勢いで急かされた感もある。

来週の面接の出来次第かなぁ。条件自体は今より多少上がるし。

絶賛転職活動中なので興味があれば声をかけていただけると嬉しいです。オランダでの勤務もしくは完全リモートが絶対条件だけど。

R7RSレコード

WG2の議論でレコードの健全性について出てる(c.f. record types)。個人的にレコードが暗黙的にアクセサを作るかどうかというのはとりあえずどうでもよくて(R6RSでは明示されなければ暗黙的に作るってなってるし)、健全性のテストコードが問題だった。

R7RS-smallのレコードは基本SRFI-9なのだが、SRFI-9ではコンストラクタタグとフィールドが同一の識別子でないとエラーとなっている。SagittariusのSRFI-9の実装はこの条件をbound-identifier=?でチェックしているので、テストコードもまぁ問題なく動くだろうなぁと思っていた。のだが、そうもいかなかった。

テストコードではtmpという識別子がコンストラクタタグとフィールドに並ぶ形になる。これらはfree-identifier=?を満たすが、bound-identifier=?は満たさない(識別子の挿入されるタイミングが違うため)。そのためSRFI-9の実装的には問題ない。何が問題か？R6RS版のdefine-record-typeとrecord-accessorの実装が問題だった。

R6RS版のdefine-record-typeは構文情報を引き剥がして下請けのレコード手続きに定義されたレコードの情報を渡すため、テストコードが生成するレコードが持つフィールド名は全てtmpになる(これはR6RS的には許容されている)。っで、record-accessorは与えられたレコードのk番目のフィールドの値を返す手続きを返すんだけど、このk番目にアクセスするためにスロット名でアクセスしていたのがまずかった。構文情報の引き剥がされてるので、単なるシンボルの比較になるんだけど、全部同じ名前なので常に最初にヒットしたスロットの値を返す。

どうしたか？普通にk番目でアクセスするように変更した。昔レコードをCLOSと統合した際に既にあった機能な気がしないでもないんだけど、なんでスロット名で引くようにしたんだろう？当時は気付いていなかったか、実はこの機能は後から外に出されたかのどっちかだろう。

一見するとマクロのバグのようで実は違ったという話。

Because it's fun

Couple of days ago, I've had a job interview, and one of the interviewer said something very interesting. I don't remember exact sentence but something like this: If I make a framework for hobby, it's okay. I didn't understand what the purpose of this comment, so I said "if there's no framework then no choice, right?" Then, he said "if you need to use this framework for work, then you need to consider a lot of things such as buffer overflow.".  Well, sort of agree and sort of disagree.

The reason why I needed to make loads of framework is basically because nobody would make other than me. If it's major language such as Java, then you just need to google it and find something. But I'm using Scheme, more specifically Sagittarius. Sagittarius, unfortunately, doesn't have many libraries. Of course, I'm trying to write something useful, but there's only one resource so it doesn't increase the number drastically. And even more unfortunate thing is that it's not so popular so there's not many users. If number of users is small, then not many libraries are written. (It's rather my fault because I still think it only needs to fit my hand and didn't advertise much...) Then if you need something, you gotta write it.

The part I agree with the opinion is the cost of coding. If there are well maintained libraries for you purpose, using them would reduce some time to redevelop the same functionality. Especially if the library is mature enough, then it takes a lot of resource to make your own implementation such level. (e.g. Spring Framework or so)

But should it only be like this? If you are a programmer, you want to write something from scratch because it's fun, don't you? I hear almost every year new trend framework. Not sure the actual motivations are, might be unmatched framework, might be just for fun, etc. And most of the time, it has some bugs. What I want to say is not something like new frameworks are buggy, but they can be famous even the initial version is buggy. So it's pity if you don't write/show something useful because it might not be perfect.

The very first version may only confirm your own requirement. I usually write such libraries and just put it on GitHub (you'll find loads of junks on my GitHub repository). After using it, I usually notice what's missing or not considered. If you have choice to write whatever you want to, then don't hesitate to write especially under the reason of  "buffer overflow". (It's more for me, though)

生産性

ツイッターでも呟いたのだが、体力系と瞬発力系の二つのコーディングテストを最近受けた。体力系は現在進行形だが、コーディング自体は要求された機能を最低限満たしたのでよしとしてしまった。(ネタは面白いんだけど、プライベートでJavaを長時間書く気になれんのよ…)

先週の週末から時間が取れるときにやってたんだけど、途中でJavaに嫌気が差してSchemeで書いてその後Javaに戻ったりしたので、この2言語間(正確にはSagittariusとJavaだが)の生産性の違いが書けそうだなぁと思い、愚痴をこめつつ書くことにした。

先に結論を書くと、Javaは極めて冗長に書く必要があるのでプロトタイプ的なものを作るには向かない。(ので、体力勝負系のコーディングテストに持ってこられると非常に面倒。) 成果はGithubかBitbucketに置けと言われたので、晒しても問題ないと判断して晒す(まさかプライベートリポジトリに置けって意味ではないと思うし)。とりあえず以下はなんとなくな比較

	Scheme	Java
実装時間	6時間	16時間
ファイル数	6(自動生成含む)	61(テストファイル含む)
開発環境	Emacs	Eclipse

Schemeの実装時間にはテーブル構成の考案にHTML(+Javascript)の時間も含むので多少多めではある(Scheme書いてた時間は3時間くらいかなぁ)。Javaの16時間のうち少なくない時間を割いたのがMavanリポジトリを探す作業。2年近く触ってなかったからいろいろ忘れていた。後はSpring、Hibernateの初期設定とか。一回書くと忘れる系のものは都度Google先生にお伺いを立ててたので。

そうは言っても割と大きめな時間の差があると個人的には思う。言語の習熟度とか、ライブラリ習熟度の差なのかもしれないけど、一応これでも職業Java屋歴10年以上あるのでそこまでの差はないとしたいところ(むしろScheme歴は6-7年なのでJava歴より短い)。個人的に最も生産性(ここでは時間のことを指す)に響いたのはREPLの存在だったと思う。SchemeではリモートREPLを使ってサーバに変更を即時反映させて挙動を確認していたのに対し、Javaでは毎回ビルドするという切ない状況だったのは大きい。対話的に確認できることの偉大さというのを改めて実感した気がする。次いで大きかったのはデザインパターンの有無。JavaだとなんとなくGeneric DAOパターンを使わないといけないかなぁという脅迫観念に襲われたので、とりあえずそれを使ったんだけど、このパターンは恐ろしく生産性が低い。あらかじめあるものを使うのならばいいのだが、エンティティ毎にDAO書いてサービス書いてとかやってるもんだから、非常に面倒だった。(この辺IDEがワンクリックでやってくれると違うのかもしれない。)細かくボディーブローのように効いたのはJavaの1クラス1ファイルの仕様や、キーボードから指が離れる瞬間が多いこと。別にEmacs最高とかいうつもりはないけど、こういうところで地味に時間を取られた気がする。

こういう体力勝負のコーディングテストは最低でも自分が好きな言語でやらせてくれないと途中で息切れするなぁと思った。問題は、僕が好きな言語でやると9割方読めないということだろうか。Schemeいい言語だと思うのだが、なんでこうも人気がないのだろう？

File monitoring on OS X using FSEvents

(sagittarius filewatch) on OS X is using kqueue (2) currently. Using kqueue isn't bad just having couple of limitation such as no capability of directory monitoring (due to my laziness). It is OK on BSD environment since this is the only choice to do it. However, on OS X, there are FSEvents APIs which allow users to monitor filesystem. When I research it, it doesn't require loads of file descriptors nor limit file/directory only monitoring. So I thought this might be a good underlying implementation for OS X and implemented like this.

If it ends without any problem, as usual, I don't write any blog post. Yes, there's a huge problem. It doesn't allow me to write tail emulator. I first thought my implementation has an issue. So I've written this small piece of code to check if it works as my expect.

#include <CoreServices/CoreServices.h>
#include <string.h>
#include <stdio.h>
#include <stdlib.h>

static void callback(ConstFSEventStreamRef stream,
                     void *callbackInfo,
                     size_t numEvents,
                     void *evPaths,
                     const FSEventStreamEventFlags evFlags[],
                     const FSEventStreamEventId evIds[])
{
  FILE *fp = (FILE *)callbackInfo;
  char buf[1024];
  const char **paths = (const char **)evPaths;
  for (int i = 0; i < numEvents; i++) {
    while (1) {
      int n = fread(buf, 1, sizeof(buf), fp);
      fwrite(buf, 1, n, stdout);
      if (feof(fp)) break;
    }
    fflush(stdout);
  }
}

int main(int argc, char **args)
{
  if (argc != 2) {
    fputs("fstail file", stderr);
    exit(-1);
  }
  FILE *fp = fopen(args[1], "r");
  fseek(fp, 0, SEEK_END);
  
  CFStringRef s = CFStringCreateWithCString(kCFAllocatorDefault, args[1],
                                            kCFStringEncodingUTF8);
  CFArrayRef ar = CFArrayCreate(NULL, (const void **)&s, 1, NULL);
  FSEventStreamContext ctx = {0, fp, NULL, NULL, NULL};
  int flags = kFSEventStreamCreateFlagFileEvents;
  FSEventStreamRef stream = FSEventStreamCreate(NULL, &callback, &ctx, ar,
                                                kFSEventStreamEventIdSinceNow,
                                                0, flags);
  FSEventStreamScheduleWithRunLoop(stream, CFRunLoopGetCurrent(),
                                   kCFRunLoopDefaultMode);
  FSEventStreamStart(stream);
  CFRunLoopRun();
  return 0;
}

This didn't work like tail command, unfortunately. It didn't receive any event after it got first event. If you get a technical problem, you probably search Google or Stack Overflow. Yes, I've found the very similar issue: No callback get called from FSEventStreamCreate with modifications created by self in watched file. It seems the question didn't get any useful answer. Feeling like I'm missing something, but I don't know what. I've also changed latency argument to non zero value but got no luck.

As long as this problem is not solved, I can't use FSEvents. So for now, I use kqueue, which works perfectly fine for my purpose, on OS X...

equal?の挙動

二週間前くらいにバグの報告を受けた(それ自体は修正済み)。バグの原因を突き詰めた際に「これはブログのネタになる」と思っていたのだが、それから随分時間が経ってしまった。多少賞味期限が切れてしまった気がしないでもないが、ちょっとした後方互換を壊す修正でもあるし、適当に記録に残しておく。ちなみにバグの報告はこれ。

バグの原因を要約すると以下の二つ：

1. eqv?が循環構造のあるレコードを受け取るとSEGVを起こす。
2. equal?がレコードの中身を比較する(R6RS的には規格違反)

随分前に(R7RSがまだドラフトだったときじゃないかなぁ)、レコードの中身をチェックするようにしていたのだが、それが噛み付いてきた感じである。eqv?がレコードの中身をチェックするのは、実はR6RS、R7RS両方で規格違反なのだが(明確にアドレス比較のみと書いてある)、equal?を変更した際にR6RSのテストスイートを通すために必要だったという経緯がある。(テストケースの意味もよく分からないんだけど、フィールドの存在しないレコードはコンストラクタが同一のオブジェクトを返してもいいってことなのかなぁ？)

1.に関してはレコード周りを取り除いてしまえば直るのは明白だったのだが、2.との兼ね合いでどうしようかなぁとい感じになるもの。そもそも、eqv?が中身を見るというのはいろいろおかしい感じがするので(リストの中身とか見ないわけだし)、取り除いてしまいたい感はあった。となると2.との兼ね合いだけなんだけど、これ自体はもともと便利だからという理由で入れてあっただけなので、正直取り除いてもそんなに影響ないだろうと思っていた。実際R7RS的には未規定なわけだし。が、SRFI-116に落とし穴が潜んでいた。

SRFI-116はイミュータブルなリストを定義しているんだけど、その参照実装のテストケースがequal?にレコードの中身を検査することを要求するコードになっていた。参照実装はChibiとChickenの2つの処理系で動くように実装されているのだが、どうもこの2つはレコードの中身を見るみたいである。新しいSRFIだからまだ使ってる人は少ないだろうし、暗黙的な要求なので無視しても問題ない気はしたのだが、人気処理系のうちの二つでやられているのなるとなぁという気持ちの方が大きかった。

じゃあどうしたか？実装をR6RSのequal?とそれ以外という風に分けた。ポータブルなコードを書くという上ではR6RSの方がより細かく規定してあるのでいいのだろうけど、これくらいの処理系拡張は許して欲しいという気持ちもある。そうすると実装を二つにする以外に方法が思いつかなかったのだ。ということで、(rnrs base)と(scheme base)で定義されているequal?は別物になった。この動作に依存したコードを書くというのはあんまりないと思うけど、ハッシュテーブルをequal?で作ってキーにレコードを使用している場合は影響がでるという話。

肉体改造部 第十七週

ほぼ月一になっている気がする。

計量結果：

• 体重： 70.4kg (-0.5kg)
• 体脂肪率： 21.6% (-0.8%)
• 筋肉率：43.3% (+0.1%)

間で増減していたのは観測しているのだが、増えるときは筋トレサボったりしているのが主な原因な気がする(大体サボっていたので)。このくらいの体重を維持しつつ体脂肪率を15%以下くらいにしたいところである。

言語レベル

(年に一回くらいこの手のことを書いてる気がしないでもないなぁ)

ある言語を話すことができるという理由で与えられるチャンスはそんなに多くないが、話せないから逃すチャンスというのは多々ある。これは英語に限ったことではなく、例えばここオランダでは募集要項にネイティブもしくはそれに準ずるオランダ語が話せること、ということが明確に書かれていることがある。逆に言うと、英語が話せればいいという職も多数ある。これが日本だと日本語は大前提になるのでExpatの多い国の特徴とも言えるのだろう。自分自身がどれくらい話せるのかとかを客観的に見たことがあまりないので、多少いろいろな角度からどの言語がどれくらいできるのか分析してみたくなった。

分析するにはある程度の基準がいる。とりあえず大きく5つのレベルに分けることにした。ただし、中間を表すために総数を20段階とし、5段階で区切るというようにする。例えば、日常会話はレベル5だが、ビジネスレベル(レベル10)に達していないが日常会話以上というのはレベル6から9の間といった具合である。以下はレベル：

• レベル0：その言語を全く話せない
• レベル5：日常会話レベル、かなり大変だがその言語で生活できる
• レベル10：ビジネスレベル、職場でコミュニケーションができる
• レベル15：高等教育レベル、日本なら高校卒業時の国語
• レベル20：専門家レベル、この言語に関する知識で飯が食える

レベルの付け方に異論はあるかもしれないが、日本語だとTPOに関する場合分けが多いのである程度専門的な教育を受けていないとTPOにあった言葉遣い、例えば敬語等、ができないとしている。また、ビジネスレベルが低めなのは、少なくともオランダでは、仕事で使うツールとしての言語ではコミュニケーションができることが、当然だが、重要視され文法等の細かいことは必要以上に重要視されないというところからきている(もちろん文書などを書く際は別だが)。

さて、上記のレベルに自分の言語を当てはめてみる。何かしらのテストを受けて計測したというわけではないので、感覚的にという単なる目安である。

• 日本語：レベル15(多分もう少し低いが、敬語とか忘れたし、日本の高校卒業してるということで)
• 英語：レベル13 - 14(多少色眼鏡付きな気もするけど)
• オランダ語：レベル4 - 6(一応生きていけるが辛い。仕事では使えない)

こんな感じだろう。言語の能力を語る上で語彙数も重要になる。ここによると、日本語の語彙は大学生レベルで4万5千～5万語らしい。一応大学出ているのでそれくらいとしておこう(正確に測るの怖い)。英語の語彙は数年前に測った時に1万2千～1万5千だったのでそうしておく(新聞を辞書なしで読めるレベル)。ちなみに、オランダに来た時点では5000程度だったので、そこから見ると随分増えたともいえる。オランダ語の語彙は知らない。2000ないかも。

全体の習熟度とすればこんな感じなんだろうけど、個別にみると意外と面白いことが分かる。例えばくしゃみをした人にかける言葉として英語では「Bless you」、オランダ語では「Gezondheid」がある。オランダに長く住んでいるので誰かがくしゃみをすると、たとえくしゃみをした人がオランダ語を話せなくても、「Gezondheid」というようになった。同様なものに「Alstublieft」もしくは「Alsjeblieft」がある。もう少し込み入った例だと、「Kan ik pinnen?」ある。これは「Can I use debit?」のオランダ語バージョンと思ってもらえばいいのだが、アメリカに行ったときとか、店員さんがオランダ語喋れない場合でもこれが勝手に出てくる(アメリカで出た際は流石に、「Kan ik,,, can I use credit card?」になったが)。特定のシチュエーションに於いてはアウトプットが最も多いものが勝手に口をついてくるみたいである。

言語の習熟度があがると、言語間の壁のようなものが薄くなる気がする。最近は日本語のやたらいっぱい母音を喋らないといけないというのが面倒に感じるのだが、これが時として悪い方向に働く。例えば日本人と話しているのに、ふっと英語になるとか。これが起きるときは大体分かってて、

1. グループ内に日本人以外がいる
2. カタカナ語を英語の発音で喋ってしまう

この二つが主な原因である。1は非常に簡単で、通訳してると出力方面がごちゃごちゃするという単なる混乱。2は、個人的には面白いと思っているのだが、英語の発音で自分の中のコンテキストが切り替わるというもの(これを回避するために日本語喋ってるときは頑なにカタカナ語で喋るのだが)。どうも、英語方面へのスイッチは緩いらしい。英語→日本語にシフトしたことはないのでそういうことだと思っている。母語が日英両方だった場合には起きないんだろうか？不思議である。

とりとめなく終わり。

Inter-operable hidden binding

The subject might sound weird, but I couldn't find any better name. So please bare with it.

Problem

Suppose you have a situation that 2 macros need to refer the same implicitly bound variable. For example, consider define-generic and define-method; the declaration of generic function is done by define-generic, and adding definition to it is done by define-method. Now, you want to write it as simple as possible, so you've decided to use implicitly bound hashtable.

;; naive definition of define-generic (doesn't work)
(define-syntax define-generic-naive
  (syntax-rules ()
    ((_ name)
     (begin 
       (define implicit (make-eq-hashtable))
       (define (name . args)
          ;; lookup and execute
          )))))

(define-syntax define-method-naive
  (syntax-rules ()
    ((_ name formals body ...)
     (begin
       (define (real-proc . formals) body ...)
       (define dummy
         ;; oops, implicit can't be referred here!
         (hashtable-set! implicit 'name real-proc))))))

Now, your task is make this happen somewhat.

Passing explicitly

Taking this path isn't really what I want, but it's the only way to do it on R7RS.

(define-syntax define-generic-explicit
  (syntax-rules ()
    ((_ name table)
     (begin 
       (define table (make-eq-hashtable))
       (define (name . args)
          ;; lookup and execute
          )))))

(define-syntax define-method-naive
  (syntax-rules ()
    ((_ name table formals body ...)
     (begin
       (define (real-proc . formals) body ...)
       (define dummy
         (hashtable-set! table 'name real-proc))))))

The problem with this implementation is that you need to know the name of the shared bindings. It might be good for debugging or breaking, but you probably don't want to care about something only used internally.

Macro generating macro

If 2 macros cannot refer the variable defined in one of the macro, then make it in the one macro like this:

(define-syntax define-generic/defmethod
  (syntax-rules ()
    ((_ name method-name)
     (begin
       (define shared (make-eq-hashtable))
       (define (name . args) 
         ;; lookup and execute
         )
       (define-syntax method-name
         (syntax-rules ()
           ((_ name shared formals body (... ...))
            (begin
              (define (real-proc . formals) body (... ...))
              (define dummy 
                (hashtable-set! shared 'name real-proc))))))))))

It's probably better than explicitly passing, but it's rather ugly. The method definition should be more generic. In this implementation, the method definition belongs to specific generic function definition.

Identifier macro

If you are using R6RS, then syntax-case can handle non list macro (not sure how it should be called, but I say identifier macro). So if the name of generic function itself can be evaluated to implicit definition name, then we can share the binding by referring the name.

(define-syntax define-generic
  (syntax-rules ()
    ((_ name shared)
     (begin
       (define shared (make-eq-hashtable))
       (define (real-proc . args)
         ;; lookup
         )
       (define-syntax name
         (lambda (x)
           (syntax-case x ()
             ((_ args (... ...)) #'(real-proc args (... ...)))
             (k (identifier? #'k) #'shared))))))))

(define-syntax define-method
  (syntax-rules ()
    ((_ name formals body ...)
     (begin
       (define (real . formals) body ...)
       ;; method name should generic function name;
       ;; thus, it's an identifier macro to return
       ;; implicit table name.
       (define dummy (hashtable-set! name 'name real))))))

Better, at least for me. If I see it with half eye closed, then it looks like fake LISP-2.

Pitfalls I've got

I first thought that maybe I can use datum->syntax to create the same name; however, this wasn't a good idea. It is okay to if both generic function declaration and method definitions are in the same library; otherwise, you'd get a problem. Suppose you have a library (a) contains only define-generic and other library (b) contains define-method. Now, which template identifier you should use to generate the same name of the implicit binding? You need to use the identifier define-generic in the library (a), and it's impossible to use it in library (b). (This is the reason why I needed to write the version 2, macro generating macro.)

Conclusion

I don't have any intention to say, macro is the best, or something like that, but if something beyond procedure (in this case, emulating LISP-2, kind of), then it is rather necessary feature.

Generic record copy

I've found a tweet that says R7RS define-record-type doesn't create copier (or copy constructor) by default. Well, I can imagine why it doesn't if I think of C++'s copy constructor (which I think very confusing and causing unexpected behaviour). And it's also context dependent what exactly copy means.

Now, if I just say like this, then it's not so fun. So let's write kind of generic copy procedure. Before that, here our definition of copy is deep copy. So it creates a new object without having the same object inside. So more like cloning.

Preparation

If it's generic, then it should work also builtin types. Generally, Scheme chose to have distinct procedures per types and what we want is one generic procedure. The very simple strategy would be dispatching. It might be convenient if users can specify how copy works per types. So the interface of copy procedure would look like this:

(define *copier-table* '())

(define (generic-copy obj)
  (cond ((assoc obj *copier-table* (lambda (x p) (p x))) =>
         (lambda (s) ((cdr s) obj)))
        ;; shallow copy, sort of
        (else obj)))

(define (register-copier! pred copier)
  (set! *copier-table* (cons (cons pred copier) *copier-table*)))

To register built-in types, we can do like this:

(register-copier! pair? list-copy)
(register-copier! vector? vector-copy)
(register-copier! string? string-copy)
(register-copier! bytevector? bytevector-copy)

Now, we have generic copy procedure for built-in types.

NB: list-copy and vector-copy doesn't consider the elements of copying object. If you want to follow the definition of copy here, you need to create own copy procedure.

Syntax

You know how define-record-type works, right? It needs to be fed name of constructors, predicate procedures. So doing the same for copy procedure. Let's call our brand new record definition syntax define-record-type/copy. It would look like this:

(define-record-type/copy pare (kons a d) pare? pare-copy
   (a kar)
   (d kdr))

The extra argument pare-copy is the procedure automatically generated by the macro.

Implementation strategy

Now, how can we implement it? The strategy I chose (and probably this is the only way to do it portably) is that:

• Collect field value and order it by constructor tag
• Create object by passing above value with specified constructor
• Set field values of fields which are not listed on constructor

So my implementation is like this:

(define-syntax define-record-copier
  (syntax-rules ()
    ((define-record-copier "emit" name (ctr f ...) (acc ...) ((a m) ...))
     ;; now we have all information
     (define (name obj)
       (let ((c (ctr (acc obj) ...)))
         ;; mutate if mutators are defined, then we use it.
         ;; to make it simple, we do for all mutator. so some
         ;; of them are just useless.
         ;; FIXME this is not efficient.
         (m c (a obj)) ...
         c)))
    ((_ "mutator" name ctr accessor mutator ())
     (define-record-copier "emit" name ctr accessor mutator))
    ((_ "mutator" name ctr accessor (mutator* ...) ((f a) rest ...))
     (define-record-copier "mutator" name ctr accessor
       (mutator* ...) (rest ...)))
    ((_ "mutator" name ctr accessor (mutator* ...) ((f a m) rest ...))
     (define-record-copier "mutator" name ctr accessor
       (mutator* ... (a m)) (rest ...)))
    ((_ "collect" name ctr (acc ...) () (def* ...))
     (define-record-copier "mutator" name ctr (acc ...) ()(def* ...)))
    ((_ "collect" name ctr (acc ...) (field field* ...) (def* ...))
     (begin
       ;; this part is not R7RS portable since 'foo' doesn't have to be
       ;; renamed (right?). so some of implementation may raise an error
       ;; of redefinition (e.g. Foment)
       ;; however we can't use letrec-syntax because it creates a scope.
       ;; sucks...
       (define-syntax foo
         (syntax-rules (field)
           ((_ ?n ?c
               ((field ac . ignore) rest (... ...))
               (next (... ...))
               (src  (... ...)))
            (define-record-copier "collect" ?n ?c (acc ... ac)
              (next (... ...)) (src (... ...))))
           ((_ ?n ?c (_ rest (... ...)) (next (... ...)) (src (... ...)))
            (foo ?n ?c (rest (... ...)) (next (... ...)) (src (... ...))))))
       (foo name ctr (def* ...) (field* ...) (def* ...))))
    ((_ name ctr (ctr-field* ...) (field-def* ...))
     (define-record-copier "collect" name ctr
       () ;; accessor
       (ctr-field* ...)
       (field-def* ...)))))

(define-syntax define-record-type/copy
  (syntax-rules ()
    ((_ name (ctr field* ...) pred copier field-def* ...)
     (begin
       (define-record-type name (ctr field* ...) pred
         field-def* ...)
       (define-record-copier copier (ctr field* ...)
         (field* ...) (field-def* ...))))))

I usually use letrec-syntax to detect free identifier (well, it should be bound identifier but I don't think there's no way to do it in range of R7RS). But needed to use define-syntax (see comment).

Then you can use it like this:

(define-record-type/copy pare (kons a d) pare? pare-copy
   (a kar)
   (d kdr)
   (s pare-src pare-src-set!))

(register-copier! pare? pare-copy)
(let ((p (kons 'a 'b)))
  (pare-src-set! p '(src))
  (let ((c (generic-copy p)))
    (print (kar c))
    (print (kdr c))
    (print (pare-src c))))

(Write your own print procedure :P). The implementation is not efficient since we call mutator procedure no matter what. To make it efficient, you need to get mutators of which are not listed on constructor tags.

The whole scripts are here:

Conclusion

Use R6RS or SRFI-99.

肉体改造部 第十四週

先週は何故か忘れた。

計量結果：

• 体重： 70.9kg (-0.3kg)
• 体脂肪率： 22.4% (+0.3%)
• 筋肉率：43.2% (±0.0%)

最近胃袋が小くなったのか、一回に食べる量が減ったのだが、食べる回数(間食)が増えている気がする。Courseraのコースを取ったので(言い訳)筋トレをさぼりがちになっているというのもよろしくない。

mod-exptの高速化

タイトルは大分嘘です。

Linux上での暗号ライブラリテストが以上に遅かった。他のOSでは問題ないのだが、Linuxだけ10倍以上遅い。何が遅いのかなぁと調べてみると、鍵対の生成が1024ビット程度でも3秒くらいかかっているというものだった。これはおかしいなぁと思っておもむろに鍵対生成をプロファイラにかけてみるとmod-exptが遅い。120回程度呼ばれて1500ms消費という感じであった。

この手続き自体は確かに重いものなのだが、どうもおかしい。以前(多分0.5.x辺り)ではそんなに時間がかかった記憶がない。つまりその辺から今までで入れた変更でLinuxのみが遅くなった可能性がある。記憶を辿ってみると確かにBignumの演算に手を入れた記憶があったので、とりあえずソースを覗いてみる。っが、特に不審な部分も見当たらない。Linux固有の何かを使ったものはないという意味でではあるが。

疑問を疑問のままにしておくのは今一気持ちが悪いので、Valgrindについてるcallgrindを使ってCレベルのプロファイルを取る。すると、mod-exptの処理自体は高速に終わっているという結果が取れた。っで、コールグラフのその下を見ると、スタック領域の割り出しの処理が異常に重たい。そういえば、Bignumの計算でスタックが溢れる不具合を直した際にそんな処理入れたなぁと思い、ダミーの値を返すようにしてSchemeのプロファイルを取る。3秒が30msになった。お前か・・・

具体的にはスタックベースを取得するのが異常に遅いっぽかった。そもそもスタックベースなど一回取得してしまえば変更されることはないはずなので毎回値を律儀に取得しにいくこともないよなぁと思いスレッドローカルな静的領域に格納するように変更。これだけで100倍の高速化に成功した。(実際は100倍の低速化が行われているので、元に戻っただけだが・・・)

ここからは(も？)与太話。
スタックベースの取得にはBoehmGCのGC_get_stack_baseを使っているのだが、LinuxとCygwinで100倍以上の差が付くのはなぜだろうと思いちょっと実装を覗いてみた。Linux(x86_64)では以下の処理を行う：

1. pthread_getattr_npの呼び出し
2. pthread_attr_getstackの呼び出し
3. pthread_attr_destroyの呼び出し

それぞれの関数の呼び出しがどれくらい重いかはよく知らないが、1万回以上の呼び出しがあったのでそれなりにはかかるだろう。(Bignumの処理は大抵再帰なので再帰的にスタック領域の確認をするのだ。)

っで、Cygwinの実装を見てみた。

    GC_API int GC_CALL GC_get_stack_base(struct GC_stack_base *sb)
    {
      void * _tlsbase;

      __asm__ ("movl %%fs:4, %0"
               : "=r" (_tlsbase));
      sb -> mem_base = _tlsbase;
      return GC_SUCCESS;
    }

以上！そら速いわ。。。1万回呼び出されても誤差の範囲に収まるだろうなぁというのは想像に難くない。

特に何もなく、callgrindが便利だったというだけの話だったりはする。他のプロファイラと違いランタイムにリンクさせる必要ないというのはとてもありがたい。その分処理は劇的に遅くなるけど、的が絞れているならこれほど便利なものはないなぁと思ったのでした。

プロセスとI/O

サーバーが正常に立ち上がったかどうかを確認するのに起動ログを見るか、実際にアクセスして動かないことを確認するしかないというのがだるくなった。なので、ファイルを監視しつつ失敗のキーワードがあれば通知するものを作ったのだが、どうもプロセスをデタッチすると何も出力されないことに気付いた。Sagittarius 0.7.2までは子プロセスの標準入出力は常にパイプが割り当てられるのだが、親プロセスが終了するとパイプから出力を読み取るプロセスがなくなるので何も出力されないという話だった。これでは不便だなぁと思い、えいや！っと出力先を制御できるようにしてみた。

こんな感じで使う。

(import (rnrs) (sagittarius process))
(let ((proc (make-process "foo" '("process")))
      (outfile "pout"))
  (process-call proc :output outfile))

これで、プロセスの標準出力はpoutというファイルになる。出力先を標準出力にしたいときは:stdoutを使う。もちろん、入力(:inputキーワード引数)とエラー出力(:errorキーワード引数)もサポートしている。便利手続きのcreate-processもこれを考慮するように変更したいが、まだしてない(こっちはパイプでも問題ないようにしか使ってないとも言う)。今のところ出力先ファイルは上書きででしか開けないが、必要があれば追記できるようにするかもしれない。

これ変更したのはいいけど、実際に通知を行うのにコンソールに垂れ流すと見落とすということで、notify-sendコマンド使ってデスクトップに通知するようにしたら、パイプ使ってても問題ないなくなった。変更自体は有用だと思うけど、最優先で変更したのはいいが必要なくなった子になってしまった。

Ellipses expansion of syntax-rules

An interesting post was posted on c.l.s. (c.f. Nested ellipses) It's about how ellipses of syntax-rules should be expanded. The code is as follows:

(define-syntax test
  (syntax-rules ()
    ((test (x ...) ((y ...) ...) )
     '((x (x y) ...) ...) ) ) )
(test (a b c)
      ((1 2 3) (4 5 6) (7 8 9)) )

I'm not sure if this is an error since (x (x y) ...) contains 2 times x followed by an ellipsis. (I think it is, and SRFI-72 expander, a.k.a Van Tonder expander, signals an error.) So I've removed the first x and tested on couple of R6RS and R7RS implementations.

;; Removed the first x
(define-syntax test
  (syntax-rules ()
    ((test (x ...) ((y ...) ...) )
     '(((x y) ...) ...) ) ) )
(test (a b c)
      ((1 2 3) (4 5 6) (7 8 9)) )
#|
Either:
#1
(((a 1) (b 2) (c 3))
 ((a 4) (b 5) (c 6))
 ((a 7) (b 8) (c 9)))
Or
#2
(((a 1) (a 2) (a 3))
 ((b 4) (b 5) (b 6))
 ((c 7) (c 8) (c 9))) 
|#

Implementations emit the #1 are the following:

• All R6RS implementations
• Foment

Implementations emit the #2 are the following:

• Chibi
• Sagittarius using (scheme base) library
• Gauche
• Picrin

To me, if I modify the template like above, it should emit the #1 result. Both R6RS and R7RS have some kind of specification of this pattern:

Pattern variables that occur in subpatterns followed by one or more ellipses may occur only in subtemplates that are followed by (at least) as many ellipses. These pattern variables are replaced in the output by the input subforms to which they are bound, distributed as specified.
R6RS: 11.19 - Macro transformers

Pattern variables that occur in subpatterns followed by one or more instances of the identifier ellipsis are allowed only in subtemplates that are followed by as many instances of ellipsis . They are replaced in the output by all of the elements they match in the input, distributed as indicated.
R7RS: 4.3.2 - Pattern language

I think the difference between R6RS and R7RS is matched ellipses consuming part. R6RS also requires the following:

The subtemplate must contain at least one pattern variable from a subpattern followed by an ellipsis, and for at least one such pattern variable, the subtemplate must be followed by exactly as many ellipses as the subpattern in which the pattern variable appears. (Otherwise, the expander would not be able to determine how many times the subform should be repeated in the output.)

This, I believe, restricts that input expressions of the multiple ellipses have the same length of input. In above example, x and y should have the same length. R7RS, on the other hand, requires to consume all input. Thus, x and y may have different length of inputs (e.g. (test (a b c) ((1 2 3 10) (4 5 6) (7 8 9))) should be valid on above example). In such cases, the expander can't determine how it should be expanded if it needs to expand like R6RS does (as R6RS mentioned).

Maybe there's more direct statement which specifies the behaviour of this case.

肉体改造部 第十二週

風邪ひいて一週間マルッと寝込んでいたりして二週飛ばし。こんなんばっかだな。。。

計量結果：

• 体重： 71,2kg (+1.7kg)
• 体脂肪率： 22.1% (+1.6%)
• 筋肉率：43.2% (+0.6%)

体重が落ちたのはまず間違いなく風邪のせいだと思われる。まぁ、落とすことも目標ではあるので、問題はないのだが。

なんだかんだで食べ過ぎるなぁという感じがあるので、頑張って食欲に負けないようにしないといけないのだが、「ダイエットは明日から」という言葉を使う人の気持ちが分かるレベルで誘惑に負けそうになる(というか負けてる)。

ファイルシステムの監視 実装編

とりあえず、inotify、kqueueとReadDirectoryChangesWの3つで大体同じように動くものができた。例えばtailコマンドっぽい何かは以下のように書くことができる。

;; tail.scm
(import (rnrs) (getopt) (sagittarius filewatch) (binary io))

(define (tail file offset)
  (define watcher (make-filesystem-watcher))
  (define in (open-file-input-port file))
  ;; dump contents to stdout
  (define (dump)
    (let loop ()
      (let ((line (get-line in)))
        (unless (eof-object? line) 
          (put-bytevector (standard-output-port) line)
          (put-bytevector (standard-output-port) #vu8(10))
          (loop)))))
  (define size (file-size-in-bytes file))
  ;; move port position if the size if more than offset
  (when (> size offset) (set-port-position! in (- size offset)))
  ;; dump first
  (dump)
  ;; add path to file watcher
  (filesystem-watcher-add-path! watcher file '(modify) 
                                (lambda (path event) (dump)))
  ;; monitor on foreground.
  (filesystem-watcher-start-monitoring! watcher :background #f))

;; this tail is not line oriented
;; it shows tail of the file from the given offset.
(define (main args)
  (with-args (cdr args)
      ((offset (#\o "offset") #t "1024")
       . rest)
    (tail (car rest) (string->number offset))))
#|
sash tail.scm foo
|#

これで延々とファイルに追加されたものを標準出力に吐き出していく。まだドキュメント化していないが、捻りを加える必要もないだろうし、多分これが最終形になると思われる。

実装に関して
前回も書いたが三者三様なのでそれぞれ苦労した。inotifyは素直にできているのでLinuxのinotify(7)にあるサンプルを参考にしながらで十分だった。思ったとおりこれが一番楽だった。次いでkqueueなのだが、こいつは例があまりなかったのと、kqueue自体が非常に総称的にできているので理解するまでに苦労した。理解してしまえばまぁそれほどという感じではある。ReadDirectoryChangesWはこれ自体はそんなに複雑じゃないんだけど、どちらかというとそれ以外の部分(OVERLAPPEDとかFILE_NOTIFY_INFORMATIONとか)が多少面倒だった感じ。動いてるけど正しく実装したのか自信ない。

実装間に於ける制限
意外だったのはkqueueが制限が一番大きくなったこと。kqueueはファイルの監視はできるけど、ディレクトリの監視をした際にどのファイルが変更されたとか追加されたとかを知る術がない。ものすごく頑張ればやれなくないんだけど、監視対象毎にファイルディスクリプタが必要になるので、万を超えるファイルとかがあるディレクトリの監視とかすると普通に死にそう。(ものすごく頑張る必要性を今のところ感じていないので頑張っていないが・・・)
次いでinotify。ディレクトリの再帰的監視は頑張らないと無理(kqueueも無理だけど)。まぁ、再帰的に監視したいかと言われるとよく分からないが。とりあえず他の実装もこれにあわせるようにしてお茶を濁した。
Windowsはファイルの監視ができないんだけど、ディレクトリの監視をすればどのファイルが変更されたかの情報が取れるので特に問題なかった。ありそうなのは、Windows Vista以降ではデフォルトでアクセス時間の変更がされないので、それの監視をしたい場合はシステムを弄らないといけないことか(実装とは関係ない) 。

落とし穴
Cygwinが実は落とし穴だった。CygwinはPOSIX環境を提供してくれるんだけど、inotifyもkqueueもPOSIXじゃないので存在しない。そしてCygwin自体にファイル等を監視するようなAPIもない。どうしたかといえば、Windowsの実装の上にパス変換(cygwin_conv_path)を噛ませるようにした。また、監視を止めるのに他の環境だとスレッドに割り込みをかけるようにしているが、Windowsのコードを流用しなければならないのでそれができない(Cygwinはスレッドの割り込みにシグナルを使うがWindowsはSetEventを使っている)。しょうがないので泥臭い方法で回避している。

所感
疲れた。後は使いつついじっていく感じかな。

ファイルシステムの監視

最近ファイルの変更を検知したいという要望が僕の中であがってきている。追記型のログファイルを調べるとかそんなちょっとしたことからなんだけど、あると便利かなぁと思い始めてきた。っで、いろいろ調べてみた結果OS毎に作法が全然違うという悲しい事実が判明。Linuxはinotify、WindowsはReadDirectoryChangesW、*BSDはkqueue、OSXはFSEvents(だけど、kqueueも使えるっぽいのでそっち使う予定。手元にOSないし)みたいである。

ちらっと調べてみた感じでは、それぞれに一長一短あるんだけど、個人的にはinotifyが一番楽っぽいイメージ。次いでkqueue。Windowsはやりたいことはやれなくないけど結構大変っぽい。Windowsの問題はファイルシステムの監視がフォルダのみというところで、ファイル自体の変更を検知する直接的な方法はないっぽい。パスを分解、フォルダを監視、その上でターゲットのファイルが変更されたかどうかをチェックするという方法になりそう。

一番楽っぽいかなと思われるLinuxの実装は既にリポジトリに入れた。どのイベントを取るかとか、ディレクトリが指定された際はどうするかとかまだ考えないといけないけど、単純なファイルの監視というところは動いている。次はWindows＋Cygwinを何とかしつつ、kqueueは最後にやる感じ。一番問題になるのは、動作をそろえるところだろうなぁ。こればっかりは地道にやるしかないので、ある程度作ったら使いながら調節するという感じになるような気がする。

ズンドコキヨシ

風邪(と思われる)で1週間寝込んでいたのだが、体調がほぼ戻ってきた。Twitter等でズンドコキヨシなるものを見かけたので、1週間ぶりにリハビリを兼ねて書いてみた。(1週間もコード書かないと鈍るよね？)

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

(define zun "ズン")
(define doko "ドコ")
(define kiyoshi "キ・ヨ・シ！")

(define (zun? o) (string=? zun o))
(define (doko? o) (string=? doko o))
(define (kiyoshi! o) (display o) (display kiyoshi) (exit 0))

(define zun&doko (vector zun doko))
(define (zundoko-generator) (vector-ref zun&doko (random-integer 2)))

(define init-state 0)
(define (gen-next n) (lambda (o) (display o) n))
(define ->init (gen-next init-state))
(define states
  `#((,zun?  ,(gen-next 1) ,->init)
     (,zun?  ,(gen-next 2) ,->init)
     (,zun?  ,(gen-next 3) ,->init)
     (,zun?  ,(gen-next 4) ,->init)
     (,doko? ,kiyoshi! ,(gen-next 4)) ;; more than 4 zun, loop it
     ))

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

(let loop ((ns init-state))
  (let ((token (zundoko-generator))
        (state (vector-ref states ns)))
    (if ((car state) token)
        (loop ((cadr state) token))
        (loop ((caddr state) token)))))

普通に4回と1回を数えた方がすっきりするような気もしないでもない。

オランダの転職エージェント

Amazonのオファーを蹴ってしまった＋収入を増やしたい(いろいろ要りようなのですよ)という思いから転職活動をしている。なんだかんだ(いろいろリスクはあるが)で手っ取り早く収入を増やすならよりよい条件の職場に行くのが早い。そうはいっても、あまりがつがつ転職活動をするというつもりもなく、いい条件の職があったらという感じでゆる～くやっているのではあるが。

オランダに限らず転職は3種類くらいパターンがあると思う。

• 自分で探す
• 向こうから声をかけられる
• エージェント経由

二つ目と三つ目は同じかもしれないが、あえて分けている。正直エージェントを使うのは好きではないのだが(理由は後述する)、今回は会社がLeidenにあるということでなんとなく面接することにした。オランダで転職エージェント経由で転職活動するのは大体以下のような流れになる。

1. エージェントから連絡がくる
2. 先方との面接日時を決める
1. 面接
3. エージェント経由でフィードバックを受け取る
4. 採用、不採用が決まるまで2-3までを繰り返す

2-3のループは大体2回、多くても3回という感じ。その合間辺りで希望する年収(もしくは月収)を聞かれる。

さて、これだけならわざわざブログの記事にすることもないのだが、ちょっと頭にきたことがあったりして吐き出しを兼ねて適当にエージェントを使うのが嫌いな理由を書いていく。

【転職理由】
大抵のエージェントは、なんでこの会社にいきたいか、みたいな事を質問してくる。ついでになんで転職するのかとか。一度素直に「金」と答えたら、「それじゃだめだ」みたいなことを言われたことがある。仕事内容なんてお前らが言ってることと一致したことねえんだよ！転職理由なんて金払いがよければそれで十分だ！僕にとって「やりがい」とかは副次的であって、主目的は「金」だよ！「やりがい」で腹は膨れないっつーの！

【希望収入】
少なくともオランダでこれを聞かれるときには、セットで現在の収入も答える必要がある。ここで、現在の収入を真面目に答えると損をするので必ず月収なら500ユーロは多く答えておくとよい(経験談)。
転職するのであれば、よほど今の会社から逃げたいとかを除いて、収入が上がることを期待したいものである。よくも悪くも転職にはリスクが伴うし(ペンションとか、職歴とか)。っで、現在の収入より月500ユーロ多くもらえるのを希望すると、「500ユーロも増やせると思うの？」とか「現在の収入からみて妥当なところを探す」とか言われることがある(3分の2のの確立)。ぶっちゃけ、これを言われたら萎える(萎えた、今日)。Nettで300ユーロ増やすのがそんなに悪ですか？あの手この手使って最低ラインを下げようとしてますよね？ぶっちゃっけ月100ユーロ増える程度では職変えないぜ、普通。お前らの交渉能力の低さを棚に上げてこっちにばかり妥協点を押し付けんな！あんまり声を荒げるとか、大人気なく喧嘩する気もないので、希望額に届かなかったら容赦なく辞退するだけですよ。

【自己矛盾】
今の会社もエージェント経由だったんだけど、どうも同じ会社っぽいんだよね。当時(一年前だが)の担当(今の担当の上司らしい)は、この会社に採用された人は長く続けてるからこの会社はいい会社だ、みたいなこと言ってたんだけどねぇ。まぁ、人売り人買いの会社なんて早々に転職させて金儲けしてるんだから当然なのかもしれないけど、この節操のなさにはこっちもびっくりですよ。

【恩着せがましい】
「この会社に他の人を送るのストップしてる」というのは彼らの殺し文句である。そっちの事情は知ったことではないのだよ。それで恩を売って、決まった際に「これだけやったんだから給料が低くても転職しろ」みたいな態度に出られてはたまらない。お前らは仕事、こっちはリスクを負う、恩も義理もない。ビジネスでやってるのに、人情を人質に取ろうとするのに反吐がでる。多少の害には目をつぶれってか？ふざけんな！

適当に書きなぐってしまった。使えそうなら使うくらいの立場でいた方がいいということ。変に義理立てしたり、向こうの意味不明な言論に左右されないというのが大事である。あぁ、腹立った。

肉体改造部 第九週

なんかいろいろあって2週ほど飛ばしてしまった。

計量結果：

• 体重： 72.9kg (+0.1kg)
• 体脂肪率： 23.7% (+0.1%)
• 筋肉率：42.6% (±0.0%)

先々週のことはあんまり覚えていないんだけど、先週は油断してちと食べ過ぎたのとあんまり筋トレに時間が割けなかった(筋トレの消費カロリーがどれくらいかは知らないけど…)ことを考えると順当に増えたといえるか？

最近懸垂が普通に10回x4セットくらいできるようになってきたのでちょいちょい筋肉が付いてきたのではと思っているのだが、数字には表れていない様子(当てになるかもよく分からんけど)。懸垂しても上腕二頭筋にあまり負荷がかかっていない感じがするということは、自重トレーニングする分には十分ということなのだろうか？ジムに行きたいところではあるが、時間が取れないんだよなぁ。

Cache

I'm currently working on ORM library (this) and have figured out that creating prepared statement is more expensive than I expected. You might be curious  how much more expensive? Here is the simple benchmark script I've used.

(import (rnrs)
        (time)
        (sagittarius control)
        (postgresql))

(define conn (make-postgresql-connection
              "localhost" "5432" #f "postgres" "postgres"))
;; prepare the environment
(postgresql-open-connection! conn)
(postgresql-login! conn)
(guard (e (else #t)) (postgresql-execute-sql! conn "drop table test"))
(guard (e (else #t))
  (postgresql-execute-sql! conn "create table test (data bytea)"))

(postgresql-terminate! conn)

;; let's do some benchmark
(postgresql-open-connection! conn)
(postgresql-login! conn)

(define data
  (call-with-input-file "bench.scm" get-bytevector-all :transcoder #f))

(define (insert-it p)
  (postgresql-bind-parameters! p data)
  (postgresql-execute! p))

;; Re-using prepared statement
(let ((p (postgresql-prepared-statement
          conn "insert into test (data) values ($1)")))
  (time (dotimes (i 10) (insert-it p)))
  (postgresql-close-prepared-statement! p))

(define (create-it)
  (let ((p (postgresql-prepared-statement
            conn "insert into test (data) values ($1)")))
    (insert-it p)
    (postgresql-close-prepared-statement! p)))
;; Creating prepared statement each time
(time (dotimes (i 10) (create-it)))

;; bye bye
(postgresql-terminate! conn)

I'm using (postgresql) library.  <ad>BTW, I think this is the only portable library that can access database. So you gotta check it out. </ad> It's simply inserting the same binary data (in this case the script file itself) 10 times. One is re-using prepared statement, the other one is creating it each time. The difference is the following:

$ sash bench.scm

;;  (dotimes (i 10) (insert-it p))
;;  0.760319 real    0.008487 user    3.34e-40 sys

;;  (dotimes (i 10) (create-it))
;;  1.597769 real    0.014841 user    5.76e-40 sys

More than double. It's just doing 10 iterations but this much difference. (Please ignore the fact that the library itself is already slow.) There are probably couple of reasons including PostgreSQL itself but from the library perspective, sending messages to the server would be slow. Wherever a DB server is, even localhost, communication between script and the server is done via socket. And calling postgresql-prepared-statement does at least 7 times of I/O (and 5 times for postgresql-close-prepared-statement!). So if I re-use it, then in total 120 times (12 x 10, of course) of I/O can be saved.

Now, my ORM library hides low level operations such as creating prepared statement, connection management, etc. (that's what ORM should do, isn't it?). So keeping prepared statement in users' script isn't an option. Especially, there's no guarantee that users woudl get the same connection each time they do some operation. So it's better to manage it on the framework.

Sagittarius has (cache lru) library, undocumented though, so first I thought I could use this. After modifying couple of lines and found out, no this isn't enough. The library only provides very simple cache mechanism. It even doesn't provide a way to get all objects inside the cache. It's okay if the object doesn't need any resource management, however prepared statements must be closed when it's no longer used. Plus, LRU may not be good enough for all situations so it might be better if users can specify which cache algorithm should be used.

There are variety of cache algorithms. Implementing all of them would take a bit time. So it's better to make a framework or interface of cache. The framework/interface should have the following properties:

• Auto eviction and evict event handler
• Limitation of storage size (unlimited as well)
• A way to get all cached objects
• Implementation independent interface

Now, make myself busy.

Server performance 2

So (net server) itself wasn't too bad performance, then there must be other culprit. To find out it, I usually use profiler however it can only work on single thread environment. That means it's impossible to use it on the server program written on top of (net server) library.

Just giving up would be very easy way out but my consciousness doesn't allow me to do it (please let me go...). Thinking current HTTP server implementation uses 2 layers, Paella and Plato. The first one is the basic, then web framework. At least I can see which one would be slow. So I've just tried with bare Paella server. Copy&pasting the example and modify a bit like this:

(import (rnrs)
        (net server)
        (paella))

(define config (make-http-server-config :max-thread 10))

(define http-dispatcher
  (make-http-server-dispatcher
    (GET "/benchmark" (http-file-handler "index.html" "text/html"))))

(define server 
  (make-simple-server "8500" (http-server-handler http-dispatcher)
                      :config config))

(server-start! server)

Then uses the same script as before.The result is this:

$ time ./benchmark.sh
./benchmark.sh  4.66s user 3.76s system 335% cpu 2.507 total

Hmmm, bare server is already slow. So I can assume most of the time are consumed by the server, not the framework.

Listing up what's actually done by server would help:

1. Converting socket to buffered port
2. Parsing HTTP header
3. Parsing request path.
4. Parsing query string (if there is)
5. Parsing mime (if there is)
6. Parsing cookie (if there is)
7. Calling handler
8. Writing response
9. Cleaning up

So I've started with the second item (port conversion actually improves performance so can't be removed, unless I write everything from scratch using socket but that sound too much pain in the ass). Conclusion first, I've improved header parsing almost 100% (mostly reducing memory allocation) but it didn't affect the performance of the server at all. Parsing header occurs once per request, so I've dumped headers what cURL sends and carefully diagnosed which procedure takes time. As the result, SRFI-13 related procedures consuming a lot of times because it has rich interface but requires packing rest arguments. So I've replaced them with no rest argument version. Then in the same library, the procedure rfc5322-header-ref which is for referring header value called string-ci=? which calls string-foldcase internally. So changed it to call case folding once. And couple of more improvements. All of them, ideed, improved performance however calling header parser only 1000 times took 30ms from the beginning. So make it 15ms doesn't make that much change.

Then I've started doubting that the benchmark script itself is actually slow. I'm not sure how fast cURL itself is but forking it 1000 times and wait for them didn't sound fast. So I've written the following script:

#!read-macro=sagittarius/bv-string
(import (rnrs)
        (sagittarius socket)
        (sagittarius control)
        (time)
        (util concurrent)
        (getopt))

(define header
  #*"GET /benchmark HTTP/1.1\r\n\
     User-Agent: curl/7.35.0\r\n\
     Host: localhost:8500\r\n\
     Accept: */*\r\n\r\n")

(define (poke)
  (define sock (make-client-socket "localhost" "8500"))
  (socket-send sock header)
  ;; just poking
  (socket-recv sock 256)
  (socket-close sock))

(define (main args)
  (with-args (cdr args)
      ((threads (#\t "threads") #t "10")
       (unit    (#\u "unit")    #t "1000"))
    (let* ((c (string->number unit))
           (t (string->number threads))
          (thread-pool (make-thread-pool t raise)))
      (time (thread-pool-wait-all!
             (dotimes (i (* c t) thread-pool)
               (thread-pool-push-task! thread-pool poke))))
      (thread-pool-release! thread-pool))))

Send fixed HTTP request and recieve the response (could be partially). -t option specifies how many threads should used and -u option specifies how many request should be done per thread. So if this ideed takes time, then my assumption is not correct. Lemme do it with bare HTTP server:

$ sash bench.scm -t 100 -u 100

;;  (thread-pool-wait-all! (dotimes (i (* c t) thread-pool) (thread-pool-push-task! thread-pool poke)))
;;  4.052414 real    0.670089 user    1.255910 sys

100 threads and 100 request per thread so in total 10000 request were send. Then it took 4 seconds, so 2500 req/s. It's faster than cURL version.

2500 req/s isn't fast but for my purpose it's good enough for now. So I'll put this aside for now.

肉体改造部 第六週

今週(先週？)は風邪ひいてダウンしていた日が2日あったりした。月曜の夜にベッドの中で寒くて震えていたのはいい思い出である。普段は冬でも布団を蹴っ飛ばしてるのに・・・

計量結果：

• 体重： 72.8kg (-0.3kg)
• 体脂肪率： 23.6% (±0.0%)
• 筋肉率：42.6% (±0.0%)

体重は減ったのにそれ以外が変わっていないというのはいったいどういうことなのだろう？骨か、骨が減ったのか？単純に誤差の範囲で見かけ上動いていないだけだとは思うけど、不安な結果ではある。

Server performance

Sagittarius has server framework library (net server) and on top of this library I've written simple HTTP server and web framework, Paella. I don't use it in tight situation so performance isn't really matter for now. However if you write something you want to check how good or bad it is, don't you? And yes I've done simple benchmark and figured out it's horrible.

I've created a very simple static page with Plato which is a web application framework bundled to Paella. It just return a HTML file. (although it does have some overhead...) It looks like this:

(library (plato webapp benchmark)
    (export entry-point support-methods)
    (import (rnrs) (paella) (plato) (util file))

  (define (support-methods) '(GET))
  (define (entry-point req)
    (values 200 'file (build-path (plato-current-path (*plato-current-context*))
                                  "index.html")
            '("content-type" "text/html")))
)

The index.html has 200B data.
I don't have modern nice HTTP benchmark software like ApatchBench (because I'm lazy) so just used cURL and shell. The script looks like this:

#!/bin/sh

invoke () {
    curl http://localhost:8500/benchmark > /dev/null 2>&1
}

call () {
    for i in `seq 1 1000`;
    do
        invoke &
    done
}

call
wait

It's just create 1000 processes background and wait them.

The benchmark is done on default starting script which Plato generates. So number of threads are 10. Then this is the result:

$ time ./benchmark.sh
./benchmark.sh  4.89s user 3.77s system 313% cpu 2.764 total

So, I've done couple of times and average is approx 3 seconds per 1000 requests. So 300 Req/S. It's slow.

If I run the above benchmark with 10 requests, then the result was like this:

$ time ./benchmark.sh
./benchmark.sh  0.05s user 0.05s system 249% cpu 0.040 total

And 1 request is like this:

$ time ./benchmark.sh
./benchmark.sh  0.01s user 0.01s system 77% cpu 0.025 total

So up to thread number, I can assume it does better, at least it's not increased 10 times. But if it's 100, then it's about 7 times more.

$ time ./benchmark.sh
./benchmark.sh  0.49s user 0.35s system 285% cpu 0.293 total

1 to 10 is twice, but 10 to 100 is 7 times. Then 100 to 1000 is 10 times. Something isn't right to me.

Why it's so slow and gets slow when number of requests is increased? I think there are couple of reasons. The (net server) uses combination of select (2) and multithreading. When the server accepts the connection, then it tries to find least used thread. After that it pushes the socket to the found thread. The thread calls select if there's something to read. Then invokes user defined procedure. After the invocation, it checks if there's closed socket or not and waits input by select again. So flow is like this (n = number of thread, m = number of socket per thread):

1. Find least used thread. O(nm) (best case O(1) if none of the threads are used)
2. Push socket to the thread. O(1)
3. Handling request. O(m)
4. Cleaning up sockets. O(m)

I think dispatching socket smells slow. So I've made some changes like the followings:

• Adding load balancing thread which simply manage priority queue
• Just asking the queue which thread is least loaded
• Code cleaning up
• Using (util concurrent shared-queue) instead of manually managing sockets and locks
• Don't assume write side shutdowned socket is not used.
• more...

With these changes, the first step only takes O(1).  Now benchmark! This is the result:

$ time ./benchmark.sh
./benchmark.sh  4.61s user 3.76s system 317% cpu 2.633 total

YAHOOOOO!!!! 100ms faster!!! ... WHAAAATTTT!???

Well in average it's 2.6sec per 1000 request so it is a bit faster like 300ms - 400ms. And using (util concurrent) made the server itself more robust (it sometimes hanged before). I think the server framework itself is not too bad but HTTP server. So that'd be the next step.

肉体改造部 第五週

先週はなぜか書く機会を失った。

計量結果：

• 体重： 73.1kg (-0.6kg)
• 体脂肪率： 23.6% (-0.4%)
• 筋肉率：42.6% (+0.2%)

見た目ほとんど変化なし。流石に後5キロは落とさないとというところだろう。しかし、一ヶ月の成果が1キロ減というのは真剣さが足りないということなのだろうか。

筋トレの負荷が足りない気がしているので、回数を倍にしているのだが、それでも足りない気がする(筋肉痛にすらならない)。ジムに行くべきなのだろうが、時間が取れないんだよなぁ。重り背負って腕立てとかかなぁ。

Shadowing pattern identifier (macro bug)

I've been adding SRFIs, 57, 61, 87 and 99, to Sagittarius these days (means I just lost short term goal...). And found the bug (resolved). The bug was one of the longest lasting ones since I've re-written the macro expander. So it might be useful to share for someone who wants to write one macro expander from scratch.

The bug was about renaming pattern identifier. Well, more precisely, not renaming pattern identifier. On Sagittarius, pattern identifiers are preserved means they aren't renamed when syntax-case is compiled. I don't remember why I needed to do this (should've written some comment but at that moment it was as clear as day, of course not anymore...) but if I change to rename it, then test cases, or even test itself, would run. Now, the bug was relating this non-renamed pattern identifier. You can see the issue but I also write the reproducible code here:

(import (rnrs))

(define-syntax foo
  (lambda (x)
    (define (derive-it k s)
      (let loop ((r '()) (s s))
        (syntax-case s ()
          (() (datum->syntax k r))
          (((f a b) rest ...)
           (loop (cons #'(f a b) (cons #'(f a b) r)) #'(rest ...))))))
    (syntax-case x ()
      ((k (foo . bar) ...)
       (with-syntax ((((foo a b) ...)
                      (derive-it #'k #'((foo . bar) ...))))
         #''((foo a b)  ...))))))

(foo (f a b)) ;; -> shoulr return ((foo a b) (foo a b))

The problem is macro expander picked up not only foo of with-syntax but also foo of syntax-case. And bound input forms of these variables don't have the same length so macro expander signaled an error.

There would be 2 solution for this bug.

1. Rename pattern identifier (not even an option for me since it requires tacking macro expander again...)
2. Consider shadowing of pattern identifiers.

with-syntax binds pattern identifiers and hides the same identifiers outside of the expression. So it can be considered creating a scope like let or so. Then taking only the top most binding (bound variables are like in environment, so I call it top) wouldn't be a problem, would it? So I took the easy path (#2).

If it's just like this, probably I wouldn't write a blog post. The actual reason why is that how I found this bug. The bug was buried for a long time. I would say it's from the beginning (so ancient) but could also say since 0.5.0 (2 years). It's because the style of writing macros. I usually don't use the same name for pattern identifiers especially if ellipsis is involved. This is easier to debug. Now, when I was porting SRFI-57, I've noticed reference implementation was considerably slow. I think it's because the implementation uses macro generation macro generation macro generation... so on macro (not sure how much macro would be generated though). Unfortunately, Sagittarius' macro expander isn't so fast. Then I've found syntax-case implementation on discussion archive. It was written for MzScheme but not so difficult to port for R6RS. Then faced the bug.

Initially, I've thought this was implementation bug because the syntax-case used at that moment could be different. So I've tested with other implementations and it worked. The error message said pretty close where it happened and dumped most of the information I needed, but just I couldn't see it in first glance. Maybe I don't want to see the fact that there's still macro related bugs...

What I want to say or put a note here is that bugs are found when you step out from your usual way. It'd be there, if I didn't port SRFI-57.It's worth to take a different way to do it.

syntax-case ポコ・ア・ポコ

syntax-caseを解説した日本語の文章というのは極端に少ないらしい。実際Googleで「syntax-case は」(日本語のみを検索する方法を知らないw)と検索しても、(オランダからだからかもしれないが)日本語の解説ページは自分が書いたものが一番上にヒットする。ここは一つ知ったかぶりをしてもう一つ検索結果を汚してもいいだろうと思ったので、syntax-caseの使い方を解説することにした(ここまで前置き)。想定読者はマクロはしってるけどSchemeのマクロはよく分からないという人としている。つまりsyntax-rulesを知らなくてもよい。ただ、マクロ自体は解説しないので、マクロとはなんぞやという疑問はこの記事を読んでも解決しないのであしからず。

初めの一歩

Schemeの最新規格はR7RSだが、一つ前の規格R6RSで標準化されたsyntax-caseの使い方を解説する。まずは簡単な例を見てみよう。ここではwhenを定義することにする。

#!r6rs
(import (except (rnrs) when))

(define-syntax when
  (lambda (x)
    (syntax-case x ()
      ((_ test body1 body* ...)
       #'(if test
             (begin body1 body* ...))))))

(when 'a 'b) ;; -> b
(when #f #f) ;; -> unspecified
(when #f)    ;; -> &syntax

最初のimportは知らなければおまじないと思ってくれればいい。次のwhenでマクロを定義している。

syntax-caseは第一引数に構文オブジェクト、第二引数にリテラルリスト、それ以降にパターンと出力式のリストもしくは、パターン、フェンダー及び出力式のリストを受け取る。ここでは言葉を覚える必要はなく、そういうものだと思ってもらえればいい。

(define-syntax when
  (lambda (x) ;; <- define-syntaxが受け取る手続きが受け取る引数が構文オブジェクト
    (syntax-case x #| <- 第一引数：構文オブジェクト |# () #| >- 第二引数：リテラルリスト |#
      ;; パターンと出力式のリスト
      ;; (パターン 出力式)
      ;; もしくは
      ;; (パターン フェンダー 出力式) [フェンダーについては後述参照]
      ((_ test body1 body* ...)
       #'(if test
             (begin body1 body* ...))))))

出力式は基本構文オブジェクトを返す必要がある。#'を式につけると構文オブジェクトを返すようになる。#'はsyntaxの省略なので、上記のテンプレート部分は以下のようにも書ける：

(syntax (if test (begin body1 body* ...)))

どちらを使うかは好みだが、筆者は#'を使う方が見た目にも構文オブジェクトを返すことが分かりやすいのでこちらを使う。

設問：
上記のwhenを参考にしてunlessを書いてみよ。
ヒント： unlessの展開形は(if (not test) (begin body1 body* ...)) のようになるはずである。

パターンマッチ

パターンマッチとはなんぞやという人はあまりいないだろう。パターンを書くということは、入力式がそのパターンにマッチする必要がある。syntax-caseではリストもしくはベクタを入力式として分解することができる。基本的には識別子(*1)一つが要素一つに、可変長の入力を扱いたい場合は...(ellipsisと呼ばれる)を使う。例えば一つ以上の要素を持つリストにマッチさせるには以下のように書く：
*1: コード上に現れるシンボルのこと。ここではクオートされたシンボルと区別するためにこう呼ぶ

(e e* ...)
#|
(1 2 3) ;; OK (これ以上でももちろんよい)
(1)     ;; OK
()      ;; NG
|#

一つのパターンに出てくる識別子は重複してはならないので、それぞれに別名をつける必要がある。筆者はよく可変長の入力にマッチするパターンの末尾に*をつける。また、作法としてパターン識別子の先頭に?をつけてパターン識別子であることを分かりやすくするものもある。気をつけたいのは、...(ellipsis)は0個以上の入力にマッチするという点である。なので、以下のように書くと空リストにもマッチする：

(e* ...)

ネストしたパターンを書くこともできる。例えば、要素の先頭がリスト(空リスト含む)であるリストにマッチするパターンは以下のように書ける：

((e1* ...) e2* ...)
#|
((1 2 3) 4 5 6) ;; OK
(() 4 5 6)      ;; OK
(())            ;; OK
()              ;; NG
|#

上記のパターンはリスト、ベクタ両方(ベクタの場合は#をつけてベクタにする必要がある)に使える。

ドット対のcdr部分にマッチさせることもできる。そのためには以下のように書く：

(a . d)
#|
(1 . 2) ;; OK
(1 2 3) ;; OK (1 2 3) = (1 . (2 . (3 . ())))
(1)     ;; OK
()      ;; NG
|#

ドット対のマッチと...(ellipsis)を使うと、連想リストのキーと値にマッチすることも可能である。以下のように書く：

((a . d) ...)
#|
((1 . 2))         ;; OK
(1 2 3)           ;; NG
((1 . 2) (3 . 4)) ;; OK
()                ;; OK
|#

組み合わせ次第で複雑な入力式にマッチさせることができる。

厳密な定義としてのパターンは以下のようになる：

• 識別子
• 定数 (文字、文字列、数値及びバイトベクタ)
• (<パターン> ...)
• (<パターン> <パターン> ... . <パターン>)
• (<パターン> ... <パターン> <ellipsis> <パターン> ...)
• (<パターン> ... <パターン> <ellipsis> <パターン> ... . <パターン>)
• #(<パターン> ...)
• #(<パターン> ... <パターン> <ellipsis> <パターン> ...)

<パターン>は再帰的に定義されるので、リストパターンの中にベクタがあっても問題ない。また、定義で使われている...はパターンではなくパターンが複数あるという意味である。パターンの...は<ellipsis>となっているので注意されたい。

ちなみに、パターンの定義はsyntax-rulesとほぼ同じなので、パターンマッチに関してはsyntax-caseを覚えればsyntax-rulesのものも使えるようになる(はずである)。

出力式

出力式は基本的に構文オブジェクトを返す必要がある。大事なことなので二度目である。構文オブジェクトの生成にはsyntax (#')構文とquasisyntax (#`)構文の2種類ある。quasisyntaxはquasiquoteのsyntax版だと思えばよい。使い方は(あれば)次回やることにする(もしくはこちらを参照：Yet Another Syntax-case Explanation )。

syntax構文が受け取る引数はテンプレートと呼ばる。テンプレートに指定できるのは、quoteと同じものが指定できる。quoteと違う点としてテンプレート内に現れてパターン変数(パターン内に現れた識別子のこと)がマッチした式に展開されるという点である。最初のwhenの例を見てみよう。whenのパターンは以下：

(_ test body1 body* ...)

そして出力式は以下：

#'(if test (begin body1 body* ...)

ここで、入力式として以下を受け取ったとしよう：

(when (zero? a) (display a) (newline) (do-with-a a))

この入力式とパターンを対応づけると以下のようになる：

_     = when
test  = (zero? a)
body1 = (display a)
body* = ((newline) (do-with-a a))

body*は...(ellipsis)が付いているので可変長の入力を受け付けるが、ここでは便宜上複数要素を持つ一つのリストとしておく。パターンマッチでは言及していないが、_はプレースホルダーになるので、なんにでもマッチしかつ出力式では使用できないことに留意したい(*2)。
*2: 要らない入力に名前を付けたくない場合に重宝する

ここまでくれば後は出力式に当てはめていくだけである。...(ellipsis)を持つパターン変数はマッチした要素が一つずつ置換される、一つのリストではくなる、ので展開結果は以下のようになる。

(if (zero? a) (begin (zero? a) (display a) (newline) (do-with-a a)))

とても簡単である。気をつけたい点としては...(ellipsis)が付いているパターン変数はこれをつけないとマクロ展開器がエラーを投げることだろうか。マッチした入力式を展開する際は全ての入力式が消費される必要がある。もちろん、出力式に現れなかったパターン変数についてはその限りではない。

フェンダー

用語として出してしまったので解説をしておく。フェンダーはパターンと出力式の間に入れることができるチェック用の式である。これが入っている場合はこの式が真の値を返した場合のみパターンにマッチしたと判定される。例えば以下のように使う：

(define-syntax when
  (lambda (x)
    (syntax-case x ()
      ((_ test body1 body* ...)
       (and (boolean? #'test) #'test) ;; testが#tであれば、if式は要らない
       #'(begin body1 body* ...))
      ((_ test body1 body* ...)
       #'(if test
             (begin body1 body* ...))))))

フェンダー内で入力式を参照するにはsyntax構文を使ってパターン変数を展開してやる必要があることに注意したい。これ以外にも入力が識別子かどうか等のチェックなど用途はさまざまであるが、基本的にはパターンマッチ以外にチェックが必要な際に使う。ちなみに、パターンマッチは上から順に行われるため、上記のwhenの定義を逆にすると、フェンダーは評価されない。

設問：
フェンダーを用いてunlessを書いてみよ。

長くなったのと「ポコ・ア・ポコ」なので今回はこれくらいにしておく。(要望があれば)次回はsyntax-caseが低レベル健全マクロと呼ばれる理由について書くことにする。

肉体改造部 第三週

先週はルクセンブルグに行っていたので量れなかった。

計量結果：

• 体重： 73.7kg (-0.4kg)
• 体脂肪率： 24.0% (+0.1%)
• 筋肉率：42.4% (+0.1%)

誤差の範囲といえなくもないが、体重は着実に落ちている感じである(二週間の結果としてはいまいちだが)。なるべく控えめに食べているのが功を奏していると思たい。体組成計の結果は誤差があるとしても、脂肪も筋肉も増えて体重が減っているというのは意味が不明である。何が減ったんだ？脳みそとか骨とかかな・・・

二週間前に懸垂バーを買ったので、トレーニングに懸垂を追加している。合計で20回くらいしかやれないので(連続では最大で7回)、まぁいろいろ鈍っておる。導入初日は筋肉痛になったんだけど、2日目からはならない。やはり運動負荷が足りていないのだろうか？とりあえずは体重を落とす方を優先しているので、様子見かなぁ。

Dynamic compilation 2

Almost a year ago, I've wrote a post about compiling Scheme code to C. (See: Dynamic compilation (failure)) In the article, I've conclude that Sagittarius' VM is turned like crazy so ordinal C code wasn't match at all or something like that. After a year, I've noticed that there's a possibility that the compiler eliminated the expression and the VM just did some loop.

I'm not totally sure since when I've add code elimination and right now I don't have the version 0.6.2 (I think that's the version I've used) in my environment. So this might be totally bogus. Anyway, back then I used the following code:

(define (fact n)
  (let loop ((m 1) (r 1))
    (if (= m n)
        (* m r)
        (loop (+ m 1) (* m r)))))

(time (dotimes (i 10000) (fact 1000)))

Now, the fact can be marked as transparent or no side effect because it seems it doesn't have any side effect nor consicing. Let me check.

(procedure-transparent? fact)
;; -> #t

The procedure-transparent? is an internal procedure which is used by the compiler to eliminate dead code. So possibility is very high now. OK, let's check the VM instructions of the expression.

(disasm (lambda () (dotimes (i 10000) (fact 1000))))
;; size: 15
;;    0: CONSTI_PUSH(10000)
;;    1: CONSTI_PUSH(0)
;;    2: LREF_PUSH(1)
;;    3: LREF(0)
;;    4: BNGE 2
;;    6: RET
;;    7: LREF_PUSH(0)
;;    8: LREF(1)
;;    9: ADDI(1)
;;   10: PUSH
;;   11: SHIFTJ(2 0)
;;   12: JUMP -11
;;   14: RET

Bingo! There is no procedure call!

Now, I might have some hope to turn up the VM. So prepare the shared object which provides fact. The C code is the following:

#include <sagittarius.h>
#define LIBSAGITTARIUS_BODY
#include <sagittarius/extend.h>

static SgObject fact(SgObject *SG_FP, int SG_ARGC, void *data_)
{
  SgObject m = SG_MAKE_INT(1), r = SG_MAKE_INT(1);
  SgObject n = SG_FP[0];

  while (TRUE) {
    if (Sg_NumEq(m, SG_FP[0])) {
      return Sg_Mul(m, r);
    } else {
      SgObject t1 = Sg_Add(m, SG_MAKE_INT(1));
      SgObject t2 = Sg_Mul(m, r);
      m = t1;
      r = t2;
    }
  }
  return SG_UNDEF;  /* dummy */
}

static SG_DEFINE_SUBR(fact__STUB, 1, 0, fact, SG_FALSE, NULL);

SG_EXTENSION_ENTRY void CDECL Sg_Init_fact()
{
  SgLibrary *lib = Sg_FindLibrary(SG_INTERN("(fact)"), TRUE);
  SG_PROCEDURE_NAME(&fact__STUB) = SG_INTERN("fact");
  Sg_InsertBinding(lib, SG_INTERN("fact"), &fact__STUB);
}
/*
gcc -lsagittarius fact.c -shared -o fact.so -fPIC -O3
 */

Now, benchmark. I've added set! to prevent the compiler optimisation.

(load-dynamic-library "fact")
(import (time) (sagittarius control) (fact))

(define dummy)

;; Load C implementation first
(print fact)
(time (dotimes (i 10000) (set! dummy (fact 1000))))

;; Scheme implementation
(define (fact n)
  (let loop ((m 1) (r 1))
    (if (= m n)
        (* m r)
        (loop (+ m 1) (* m r)))))

(print fact)
(time (dotimes (i 10000) (set! dummy (fact 1000))))
#|
#<subr fact 1:0>

;;  (dotimes (i 10000) (set! dummy (fact 1000)))
;;  6.604181 real    14.084392 user    0.174243 sys
#<closure fact 1:0>

;;  (dotimes (i 10000) (set! dummy (fact 1000)))
;;  6.698120 real    14.32880 user    0.132117 sys
|#

Well, almost the same. C version is slightly faster. This is, I believe, because it doesn't have VM dispatch. But this is more or less error range.

Even if this had siginificant improvement, I still need to resolve loads of things to native shared object from Scheme code. Such as:

• Mapping of Scheme procedure and C function
• Calling Scheme procedure from C
• Error handling especially unbound variables
• C compiler detection
• Etc. (macro, location so on)

In my experience, calling Scheme procedure from C is really slow and it's not call/cc friendly. There's a way to avoid some overhead, such as using CPS, however it'd be still the same or even slower then just running on VM (this is really proven by previous experience, unfortunately). On possible good future would be less consicing similar with the one mentioned unboxing in guile -- wingolog. Though, as long as I need to use CPS, it would most likely no more than trivial improvement.

It seems there's no easy way out for performance improvement. Maybe it's time to give up looking for this path.

肉体改造部 第一週

今週の結果

• 体重： 74.1kg (-0.6kg)
• 体脂肪率： 23.9% (-0.4%)
• 筋肉率： 42.3% (+ 0.1%)

誤差の範囲とも取れなくないが、順調っぽいスタートである。

見た目の変化はない感じである。
負荷が足りてないのか、プロテインを飲んでいるからなのか分からないが筋肉痛にならなかったので、もう少し回数を増やすか何か背負って腕立てするかしてもいいかもしれない。

FFI improvements

I wish I could live only in Scheme world when I'm writing Scheme code. The world is not really kind to me so I often need to write C binding with FFI library.

Currently I'm aiming to write a very simple IDE for Windows using the FFI library. Personally, I use Emacs but it's rather not friendly if I'd just say 'install Emacs' for newbies. It might be better to have very first step IDE bundled especially for Windows users. (POSIX like OS users? They aren't really newbie more or less :P)

Writing it using Win32 API basically means bunch of FFI calls or emulating C structure. The latter part is crucial. I need to do load of things what C compiler does, such as byte padding, offset calculation, etc. I think I've done most of them however there were (yet are...) still more to do. One of the missing features was bit field.

I don't remember exactly why I put this aside for such a long time. Most likely I just didn't need it, though. Now it's time to implement (yes I needed it). So define-c-struct can now take bit-field clause like this:

(define-c-struct foo
  (bit-field unsigned-short (a 4) (b 4) (c 4) (d 4)))

Unlike actual C compilers, the bit-clause must have less than or equal to the specified C type. If it overflowed (not sure if I can call it overflow, though), then &assertion is raised. I know this is sometimes very inconvenient and I've already faced the inconvenience. It's more pain in the ass to do like C compilers do than restricting because I don't have the specification of C. So I wasn't sure how I can increase the storage size (well it's guessable).

The bit-field clause can also take endianness like this:

;; big endian
(define-c-struct foo-b
  (bit-field (unsigned-short big) (a 4) (b 4) (c 4) (d 4)))

;; little endian
(define-c-struct foo-l
  (bit-field (unsigned-short little) (a 4) (b 4) (c 4) (d 4)))

This might be convenient if you want to write like this:

;; use big endian structure
(let ((p (allocate-c-struct foo-b))
  (pointer-set-c-uint16! p #x1234)
  (list (foo-a-ref p) (foo-b-ref p) (foo-c-ref p) (foo-d-ref p)))
;; -> (1 2 3 4)

;; use little endian structure
(let ((p (allocate-c-struct foo-l))
  (pointer-set-c-uint16! p #x1234)
  (list (foo-a-ref p) (foo-b-ref p) (foo-c-ref p) (foo-d-ref p)))
;; -> (4 3 2 1)

I haven't tested on real big endian environment, so not sure if the actual pointer values are correct. (Feeling like something is wrong since pointer-set-c-uint16! sets the given value with little endian on my enviromnet. So I need to get big endian environment...)

I've also noticed that it's annoying to define pointer type each time. Say a C function has like this signature:

int foo (const char *s, int *i);

Now, I want to write FFI binding for this. It'd look like this:

(define so (open-shared-library "foo.so"))
;; Can you remember what the second argument's type is after 3 months?
(define foo (c-function so int foo (char* void*)))

I don't like to convert all pointer type except char and wchar_t to void* because of my short memory. So I often do like this:

(define-c-typedef int (* int*))
(define foo (c-function so int foo (char* int*)))

Better, at least I can see what kind of pointer type foo requires. But writing typedef each time is rather annoying. So I changed to accept (type *) style type specifier. Now we can write above like this:

;; char* is predefined so doesn't matter to change, though
(define foo (c-function so int foo ((char *) (int *))))

It's just matter of style how you write it. I thought it's convenient especially if C function requires pointer of structure.

It's not really big changes (or rather trivial) but I believe these small changes would make it better.

Schemeで部分適用

Twitterでカリー化マクロを書いたブログ記事を見かけたので部分適用の方も書いてみた。ネタ元はこちら：define-curryを書いてみた
真面目に読んでなかった＋カリー化を複数手続きを取る手続きを１引数を取る手続きを返す手続きにするみたいな理解していたので完全ネタが被ってた。別解ということでひとつ・・・

部分適用に関して厳密な定義を実は知らないのだが、複数引数を取る手続きに要求する引数より少ない数の引数を与えた際に残りの引数を受け取る手続きを返すもの、という理解でいる。コードで書くとこんな理解：

(define (foo a b c) (+ a b c))

(foo 1) ;; -> (lambda (b c) (+ 1 b c)) ;; ≶ 1 is given by caller

これがカリー化だと返された手続きの呼び出しが以下のようになる。

(let ((foo1 (foo 1))
  ;; foo1 = (lambda (b) (lambda (c) (+ 1 b c)))
  ((foo1 2) 3))

いいけど、面倒。ということで部分適用っぽく見えるようなマクロを書いてみた。

(import (rnrs))

(define-syntax lambda-partial-applicable
  (syntax-rules ()
    ((_ "case" () (arity ...) ((args body) ...) fun)
     (case-lambda (args body) ...))
    ((_ "case" (a arg ...) (arity ...) ((args body) ...) fun)
     (lambda-partial-applicable "case" 
                                (arg ...)
                                (arity ... a)
                                ((args body) ... ((arity ... a) (fun a)))
                                (fun a)))
    ((_ "partial" (arg ...) body)
     (let ((fun body))
       (lambda-partial-applicable "case" (arg ...) () ((() fun)) fun)))

    ((_ "curry" () (arg ...) body)
     (lambda-partial-applicable "partial" (arg ...) body))
    ((_ "curry" (a arg ...) (back ...)  body)
     (lambda-partial-applicable "curry" (arg ...) (a back ...)
                                (lambda (a) body)))

    ((_ "reverse" () (arg ...) (body ...))
     (lambda-partial-applicable "curry" (arg ...) () (begin body ...)))
    ((_ "reverse" (a rest ...) (arg ...) (body ...))
     (lambda-partial-applicable "reverse" (rest ...) (a arg ...) (body ...)))

    ((_ (args ...) body ...)
     (lambda-partial-applicable "reverse" (args ...) () (body ...)))))
    

(define-syntax define-partial-applicable
  (syntax-rules ()
    ((_ (name args ...) body ...)
     (define name (lambda-partial-applicable (args ...) body ...)))))

こんな感じで使う。

(define (print . args) (for-each display args) (newline))
(define-partial-applicable (foo a b) (+ a b))

(let ((&2+ (foo 2)))
   (&2+ 3))
;; -> 5

(define-partial-applicable (bar a b c) (+ a b c))

(bar 2 3 4)
;; -> 9

(let* ((&2+ (bar 2))
       (&2+3+ (&2+ 3)))
  (&2+3+ 4))
;; -> 9

いろいろやり方はあると思うけど、考えるのが面倒なのでカリー化の先に部分適用を持ってくることにした。さらにいろいろ面倒なのでオプショナル引数については全く考慮してない。

朝の15分くらいで書いたものなので変なことをすると変な挙動をするかもしれないが、そこはご愛嬌ということで…

オリボルンの作り方

毎年大晦日になるとNaverから昔オランダに来る前に書いたレシピにいくらかアクセスがある。このレシピ間違ってはいないんだけど正確にはオリボルンではないので(appelbollenという亜種)、もう一回書いておくことにする。オランダではオリボレン用の粉があって、混ぜて寝かせて揚げるだけなんだけど(ホットケーキミックスみたいなもんだ)それだと日本では作れないので、インスタント粉は使わない方向で。

材料(20個分)

• 小麦粉 300g
• 牛乳 250ml
• ドライイースト 7g
• 砂糖 1tbsp (15g)
• 卵 1個

作り方

• 上記の材料を混ぜる
• しっかり混ぜると、出来上がりがもちもちする
• 軽く混ぜるとさくっとする
• 生地を1時間寝かせる(2倍程度に膨らむまで待つ)
• 油(材料外)を180度に熱する
•  スプーン(大)を二つ使って一口大程度の生地を掬い上げ、丸めてから揚げる。
• イーストが入っているので膨らむ
• あまり大きくするとできあがりが巨大になるので注意
• 焦げないように注意しつつ、全体的にこんがり揚げる。
• 竹串をさして何も付かなければ出来上がり

食べ方
出来立てが一番美味しいのは基本。どんな風に食べてもいいけど、オランダでは大量の粉砂糖をまぶして食べるのが一般的。オリボルン自体はあまり甘くないので粉砂糖等で甘さを補う感じ。オランダでは年越しの際に食べられることもあり、冬のお菓子的な扱いになっている。実際、夏が終わるとオリボルンの屋台(？)がそこかしこに現れる。

慣れてきたら砂糖を増やしたり、レーズンを入れたりしても(krentenbollenと呼ばれる)よい。

肉体改造部 入部

今年の抱負の一つが「ガチムチマッチョに俺はなる！」なのと、恥は晒した方が退路を断つ＋モチベーション維持になると思うので記録がてらブログにも書くことにした。

とりあえず、スタート地点としては以下

• 体重：74.7kg
• 体脂肪率：24.3% (俺の1/4は脂肪でできている・・・)
• 筋肉率：42.2% (どれくらい正確なのかは知らん)

身長は悲しいことに固定値なので記載しない。後5～10cmほしかったが、伸びなかったので仕方ない。現状の見た目は以下(見苦しいの注意)

腹回りが悲しいことになっている・・・

目標は体脂肪率-10%で体重は維持。トレーニング内容は以下

• 腕立て 合計50回程度(潰れるまで)
• 腹筋 適当に15分くらい
• スクワット 合計100回くらい
• その他適当

あんまりきつすぎると日々の生活に支障をきたすのでこれくらい。真面目にやると、それでも筋肉痛になるのでまぁ問題ないだろう。今回はプロテインも導入してみることにした。うわさによるとまずくて飲めないものらしいので多少躊躇した部分もあるが、飲んでみると普通に飲めた。ソイプロテインだからかもしれない。豆乳の濃いの飲んでる感じ。一回で17gのプロテインが摂取できるっぽい。一日2回飲みたいところだが、平日の朝作ってる時間はないので、平日は夜、休日は朝と夜とすることにする。

週一で経過報告する予定。恥になるか、自信になるかは自分次第。

Or, and-let* and tail position

It's about I was stupid enough not to think where actually tail position is.

Let's see the following expression:

(or (returns-false)
    (returns-true))

The first returns-false wouldn't be tail position unless implementation does some magic. It's easy to explain why not only it's explicitly written in R7RS. If you write or with macro, the it'd look like this:

(define-syntax or
  (syntax-rules ()
    ((_ expr) expr)
    ((_ expr expr* ...)
     (let ((t expr)) ;; this is why it's not tail position
       (if t t (or expr* ...))))))

I'm not that stupid just in case you'd think like that.

Now, there's a SRFI which defines and-let*. Using this, you can write nested and and let very simply like this:

(and-let* ((a (returns-something))
           ( (symbol? a) )
           (b (returns-other-thing))
           ( (string? b) ))
  (do-something a b))
#|
would be expanded like this:
(let ((a (returns-something)))
  (and a
       (symbol? a)
       (let ((b (returns-other-thing)))
         (and b
              (string? b)
              (do-something a b))))) ;; this is tail position
|#

You'd probably know what I want to say. Yes, combination like this made me lost...

(or (and-let* (...) body ...)
    (other))

For some reason, I was thinking the last expression in the body would be tail position. Well, doesn't it look like it? And my defence, might make me look more stupid, is that the place where it happened was rather deeply nested (at least for me) and kinda long process. So I couldn't see or in a glance.

Although, it wouldn't hurt that much if you aren't doing recursion. You know what? Yes, I did... on the compiler. If you make a huge expression with internal define, then stack overflow happened because of this mistake. It can happen when the internal define is more than 100 or so (if not, it just consume large stack). Who would write more than 100 internal define? Me, of course.

Don't get me wrong, I don't write by hand (well, rarely maybe) but with macro. Recently, I'm writing SQL parser with (packrat) library and the packrat-parser macro converts the BNF looks like definition into bunch of internal define expressions. If you have never seen how BNF of SQL looks like, then just look this. Even though, it's not completed yet however the parser definition is already close to 2000 LoC. Haven't counted the number of internal definition but at least more than 100. If there's such numbers of internal definition, then stack overflow would happen.

When I fix this problem on compiler, I would expect that it'd also improve the performance. Because of the occupation of the stack area, it'd have impacted some GC performance. The result was not that much. The simple benchmark (just loading sitelib/text/sql/parser.scm) showed 300ms improvement from 7700ms. Well, it's more like an error range.

Anyway, this improvement, at least, save my sanity a bit.

S式SQL その3

なんとなく必要そうな部分が動くようになってきた。SQL 2003のBNFをほぼそのままSchemeにした形なので無駄に冗長かつ、こんなのいつ使うんだ？的な構文までサポートされている。ほとんどyak shavingに近いような感じで時間だけ取られ、モチベーションを保つのが大変だった。おかげで役に立たなさそうなSQLの構文的な知識が増えた気もする。まぁ、すぐに忘れるだろうけど。

とりあえず、こんな感じで使える。

(import (rnrs) (text sql))

(define sql "select * from t")

(sql->ssql (open-string-input-port sql))
;; -> (select * (from t))

これくらいだとCLにあるSQL扱うのとそんなに変わらない形式のS式なのだが(あれらは基本マクロなので、こんな風に取り出せないけど)、いくらか直感的ではない感じのものがある。例えば以下：

(import (rnrs) (text sql))

(define sql "select * from t inner join a using (id)")

(sql->ssql (open-string-input-port sql))
;; -> (select * (from (t (inner-join a (using id)))))

SxQLだと上記のは

(select :* (from :t) (inner-join :a :on (:= :t.id a.id))) 

見たいな風に書ける(はず、README.markdownから推測しただけなので自信ない)。これは理由があって、FROM句の中にJOIN句を入れた方がSQLのBNF的には楽にパースできたのと、こんなのも有効なSQLだったから:

select * 
from t inner join a using (id)
   , b /* who the heck would write like this? */

SxQL的な記法だと上記が書けないなぁと思ったので、涙を飲んだ。この辺は用途の違いなんだけど、既存のS式SQLはS式からSQLを出力できればよいというものであるのに対して、僕のは既存のSQLをS式に変換するという用途が必要だったから。理由はS式SQLにあるのでそっち参照。単に全てをS式のみで終わらせられる世界の住人ではないというだけだが。INSERT節のVALUES句もそんな感じで直感的ではないものになってる。

パーサがSELECT、INSERT、UPDATEとDELETEをサポートした段階でS式SQLからSQL文字列を取り出すようなのも作った。こっちはかなり簡単で、パターンマッチとマクロを駆使してひたすらゴリゴリ書くだけ。大変なのはSQLに定義されてるほぼ全ての演算子を書かないといけない点。まだ全部は終わってないけど、必要な分からやれるのでそんなに大変でもない。(逆に漏れが出る可能性がパーサより高い・・・)


いくつか宣伝できそうなところ

これが宣伝になるとも思えないけど、パースしたS式SQLはかなり冗長になっているので多少の簡素化を行うようにしている。

• 識別子の連結
• Unicode文字列のデコード
• likeやsimilar toのESCAPE演算子

最初のはパースしただけの状態だとa.b.cが(~ a b c)となるので、これをa.b.cというシンボルにする。これはUnicodeやdelimited識別子もいい感じに扱ってくれる。ただ、書き出す際に大文字小文字の情報を失うので、delimitedな識別子はちょっと考える必要があるかもしれない。
二つ目のはU&で始まる識別子もしくは文字列に含まれるUnicodeエスケープをいい感じに文字にするもの。現状surrogate pairとかは全く考慮しない(integer->charするだけな)ので際どい系の文字は危ないかもしれないが。
三つ目のはあんまり使われることがなさそうなESCAPE演算子の除去。

もう少し何かできそうな気がするけど、思いつかなかったのでこれだけ。

ここまでできたので後は使いながら調整していく感じになりそう。0.7.0辺りでドキュメント化できたら嬉しいが、もう少し後になる気がしないでもない。

syntax-rulesで中級以上のマクロを書く手引き

この記事はLisp Advent Calendar 2015 の二日目として書かれました。

R7RS-smallでは低レベル健全マクロが定義されなかったため SchemerはR5RSから続くsyntax-rulesを使ってマクロを書くことを強いられることになった。syntax-rulesはよくできた健全マクロシステムではあるが、書き方を知らなければ複雑なマクロを書くことができない。ここでは中級程度のマクロを書くために必要な手法を紹介することとする。特に要求するレベルというものを設けることはしないが、想定する読者はここ(秘伝のタレマクロができるまで)に書かれているレベルのマクロは書けるがそれ以上のことがしたい方としている。

紹介する手法

どの程度を中級とするかというのは個人個人で違うだろうが、ここでは以下の手法を用いたマクロを中級とすることとする。

• 識別子比較
• CPSマクロ

上記二つを解説した後、この二つを組み合わせたマクロでできることを紹介する。

識別子比較

syntax-rulesを用いたマクロに於ける識別子の比較とは、その識別子に束縛されているものの比較と言い換えることができる。これはR7RSの4.3.2 パターン言語にあるマッチングルール第3項に定義されている。

P is a literal identifier and E is an identifier with the same binding;
(訳)Pがリテラル識別子かつEが同一束縛を持つ識別子である
R7RS 4.3.2 Pattern Language

ここでいうリテラル識別子とはsyntax-rulesに渡す第一引数(ユーザーellipsisを使用する場合は第二引数)のことである。これらの識別子はマクロ展開時に同一の束縛を指す識別子と比較した際にマッチしなければならない。ここで注意したいのは、未束縛の識別子同士の比較は単なる名前の比較になるが、束縛が同一である場合は別名でもマッチするという点である。例えばcondにおける補助構文elseを考えてみる。R7RSでは以下のように書いても正しく動くことが要求されている。

(import (rename (scheme base) (else scheme:else)))

(define else #f)

(cond (else 'ng)
      (scheme:else 'ok))
;; -> ok

(cond (scheme:else 'ng)
      (else 'ng))
;; syntax error

R6RSにはfree-identifier=?と呼ばれる識別子同士が同一の束縛を指すかどうかを調べる手続きがあるが、この性質を使うとR7RS-smallでも同様の機能を持つマクロを書くことができる。例えば以下のように：

(import (scheme base))

(define-syntax free-identifier=??
  (syntax-rules ()
    ((_ a b)
     (let-syntax ((foo (syntax-rules (a)
                         ((_ a) #t)
                         ((_ _) #f))))
       (foo b)))))

(free-identifier=?? a a)
;; -> #t

(free-identifier=?? a b)
;; -> #f

R7RS-smallでは識別子を直接扱うこと、ここでは手続き等の引数にするという意味、はできないのでマクロで書いてやる必要がある点に注意されたい。このようにリテラルに比較したい識別子を与え、それにマッチするかどうかをチェックすることで識別子の比較が可能である。ちなみに、fooという名前に特に意味はない。単にこのマクロ内で使われていない識別子を取っているに過ぎない。意味がないことに意味があるともいえるのかも知れないが、哲学的になるので深くは掘り下げないことにする。

ここで識別子の比較は束縛の比較と書いたがそれが端的に現れている例を提示しよう。

(import (scheme base) (rename (only (scheme base) car) (car scheme:car)))

;; definition of free-identifier=??

(free-identifier=?? car scheme:car)
;; -> #t

上記のスクリプトに於いてcarもscheme:carも同一の手続きを指すのでfree-identifier=??が#tを返す。

注意：このケースではライブラリのインポートがたかだか一回であることが保障されているはずだが、この解釈は多少自信がない部分がある。解釈が揺れていることに関してはこちらの記事を参照されたい：
Defined or undefined?(英語)
R7RSのライブラリに関する疑問

識別子の比較で注意したいのは一時変数として生成された同名のテンプレート変数の比較は常に真になるということだろう。

(import (scheme base))

(define-syntax foo
  (syntax-rules ()
    ((_ a b)
     (let-syntax ((bar (syntax-rules (a)
                         ((_ a) #t)
                         ((_ _) #f))))
       (bar b)))
    ((_ t* ...)
     (foo t t* ...))))
(foo)
;; -> #t

一時識別子を、マクロ展開器がテンプレート変数をリネームするという性質を用いて、生成するというのはしばしば用いられるテクニックなのだが、これで生成された識別子は同一ではないが同一の束縛を持つ(ここでは未束縛)同名の識別子になるため、syntax-rulesのリテラルと必ずマッチする。こういったケースの識別子を比較した場合はR6RSで定義されているbound-identifier=?を使用する以外にはなく、R7RS-smallの範囲では行えないはずである。(少なくとも筆者が知る限りでは。)

CPSマクロ

CPSマクロとはCPS(Continuation Passing Style)で書かれたマクロのことである。この名称が一般的かどうかというのはここでは議論しないこととする。

Schemeに於いてマクロは必ず式の先頭から評価される。手続きでは引数が評価された後に手続き自体が評価されるが、マクロにおいてはこれが逆になる。これは、あるマクロの展開結果を別のマクロで使いたい場合に手続きのように書くことができない、ということを意味する。例えば以下：

(define-syntax foo
  (syntax-rules ()
    ((_ (a b)) 'ok)))

(define-syntax bar
  (syntax-rules ()
    ((_) (a b))))

(foo (bar))
;; -> syntax error

これは多少例が極端すぎるかもしれないが、いくつかのマクロを組み合わせたい場合というのは少なからずある。その際にあるマクロを展開結果を意図して別のマクロの引数に渡すというミスはままある(体験談)。これを解決する唯一の方法がCPSマクロである。

CPSという名が示すとおり、CPSマクロは次に展開されるマクロをマクロの引数として渡してやる。上記の例であれば、fooはbarが先に展開されることを期待しているので、以下のようにbarにfooを渡すように書き換える。

(define-syntax foo
  (syntax-rules ()
    ((_ (a b)) 'ok)))

(define-syntax bar
  (syntax-rules ()
    ((_ k) (k (a b)))))

(bar foo)
;; -> ok

次に展開するマクロが期待する式をあらかじめ知っておく必要があることと、それに合わせて式を展開する必要がある以外は何も難しいことはない。

組み合わせる

これら二つのテクニック、特に識別子の比較、は単体ではあまり意味を持たせて使うことはないが組み合わせるととても強力なマクロを書くことができる。ここでは極単純だがある程度汎用性のある例を紹介しよう。

マクロは、とりあえずベクタのことは忘れるとして、言ってしまえばリスト操作である。リスト操作といえばassq、ということでassqのマクロ版を作ってみる(強引)。

注意：このネタは既に書いてるので、これを読んだ方には退屈かもしれない。新しいネタを考えてると期日に間に合わなさそうだったので焼き増しである。正直スマン

assocなので、取り出した式を使えるようにしたい。そのためにはCPSマクロを使う必要がある。そうすると一番上の定義は以下のようになるだろう。

(define-syntax massq
  (syntax-rules ()
    ((_ k id alist)
     ...)))

kは次に展開されるマクロの識別子である。後はassqと一緒だ。次にidがalistの中にあるかを調べる必要がある。idは識別子であることを期待するので、syntax-rulesのリテラルを使って以下のように書ける。

(letrec-syntax ((foo (syntax-rules (id)
                       ((_ ((id . d) rest ...)) (k (id . d))
                       ((_ ((a . d) rest ...))  (foo (rest ...))))))
  (foo alist))

後はこれを組み合わせてやればよい。

(define-syntax massq
  (syntax-rules ()
    ((_ k id (alist ...))
     (letrec-syntax ((foo (syntax-rules (id)
                            ((_ ((id . d) rest (... ...))) (k (id . d))
                            ((_ ((a . d) rest (... ...)))  (foo (rest (... ...)))))))
       (foo alist)))))

実はこのマクロには少なくとも一つ問題がある。多くの場合では問題にならないことの方が多いのだが、このマクロは入力式をそのまま返さない。具体的にはidがリネームされてしまうのである。これを回避するためには、マッチさせる式と出力する式を分ける必要がある。こんな感じでalistを2回渡してやるだけなので難しい話ではない。

(define-syntax massq
  (syntax-rules ()
    ((_ k id alist)
     (letrec-syntax ((foo (syntax-rules (id)
                            ((_ ((id . d1) rest (... ...)) 
                                ((a . d2) rest2 (... ...)))
                             (k (a . d2)))
                            ((_ ((a1 . d1) rest (... ...))
                                ((a2 . d2) rest2 (... ...)))
                             (foo (rest (... ...)) (rest2 (... ...)))))))
       (foo alist alist)))))

kに渡しているのがaというのが肝である。これによって入力式の識別子が展開された式で使用されることを保障している。ここまでやる必要のあるマクロを書く機会は少ないかも知れないが、識別子のリネームによる予期しない動作を回避するための一つの方法として覚えておいても損はないだろう。

まとめ

中級以上のマクロを書くために必要になる手法を紹介した。識別子の比較を用いればsyntax-rulesのリテラルに依存しないマクロキーワードを作ることができ、CPSマクロを用いればマクロの展開結果を受け取るマクロを作ることができる。どちらも複雑なマクロを書く際の強力なツールとなる。

なおこの記事はこれらの手法を使って複雑怪奇なマクロを書くことを推奨するものではないが、言語を拡張するレベルのマクロを書く際には必要になる(かもしれない)ものではある。更なるマクロの深淵を覗きたい方はOleg氏のLow- and high-level macro programming in Schemeがいろいろまとまっているので参照するとよいだろう。