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がいろいろまとまっているので参照するとよいだろう。

S式SQL その2

ちょっと書き始めたらいきなり壁にぶち当たったのでSQL恐ろしい子という感じである。

SQLにはqualified identifierというものがある。何かといえば「.」で繋げられたあれである。例えば以下のSQLをS式にするとする：

select f.bar from foo f;

特に何も考えなければ以下のようになるだろう。

(select (f.bar) (from (as foo f)))

asをつけるかどうかは決めてない(SQL的には要らない子でもS式的にはあった方がいいような)。大抵の場合はこれで問題ないんだけど、SQLにはdelimited identifierというものがある。例えばこんなにも合法なSQL：

select f."bar" from foo f;

SchemeにはR7RSから「||」が入ったんだからdelimited identifierもそれでいいじゃん？と思わなくもない。S式からSQL文字列にした際にどうするとか考えなければだけど。

ここまではまだ序の口で、少なくともSQL2003からはユニコードが使えて、以下のようなのも合法：

select f.U&"\0062ar" from foo f;

大分怪しくなってきた。さらにエスケープ文字の変更も可能なので、以下のも合法：

select f.U&"$0062ar" uescape '$' from foo f;

誰が書くんだこんなのというレベルだが、テーブルやカラム名にASCII以外を使っているとありえるのかもしれない。さらに、U&"$0062ar" uescape '$'はunicode delimited identifierというトークンなので、単なる識別子として処理される。つまり、末尾である必要がなく、以下も合法：

select U&"$0066" uescape '$'.U&"$0062ar" uescape '$' from foo f;

涙出そう。ここまで行くと全てを捨ててシンボルでというわけにはいかないので、SQLの読み込みで作られるqualified identifierはリストにすることにした。こんな感じ：

(select ((@ (unicode (! "$0066") uescape "$") (unicode (! "$0062ar") uescape "$"))) 
 (from (as foo f)))

果てしなく冗長な気がする。連結を表すのに「@」を使うか悩み中。「.」が使えるといいんだけど、「|」でエスケープしたくない。ただ、「@」は別のところで使いたい場面が出てきそうな上に、今一連結(もしくは参照)というイメージが湧かない。「->」はSQLのキーワードの一つなのでできれば使いたくない。「=>」だと紛らわしいかなぁ？

パーサー自体はゴリゴリとBNFを書いていくだけなので作業量は多いけどそこまで大変ではない(大変だけど)。必要な部分だけ書いて後は必要に応じてということができそう。やはり問題になるのはこういう細かい表記の部分だろう。一度使い始めると変更できない(したくない)部分になるので可能な限り違和感のないものにしたいところである。

追記：qualified indentifierをスロットアクセスと考えれば「~」を使うのはありかもしれないなぁ。後は連結に何を割り当てるか考えないとなぁ。

S式SQL

ちょっと本格的に欲しくなってきたのでメモ兼考えをまとめる。

ことの発端は仕事でテーブルの変更を加えた際に200件を超えるINSERT文を修正しなければいけない可能性が出たこと。可能性で終わった(偶然僕は休みだったので)のだが、今後こういったケースが出ないとは限らない。というかDBを弄る必要がある以上起きる。毎回手作業で貴重な人生を浪費するのも馬鹿らしいので、プログラムにやらせてしまいたい。テキスト処理でやるには荷が重過ぎるのでAST(リストだけど)を操作したい。とここまでが動機。

SQLのBNFはここにあるのを使うとして(SQL2003と多少古いが問題ないだろう)、まずはどういう形にするかをまとめておきたい。これがまとまってないから頓挫してるリポジトリもあったりするし・・・

SQLをS式にするというのはいくつか既にあって、たとえばCL-SQLとかSxQLとかS-SQLとか、大体似てるんだけどちょっとずつ違う感じのS式を使用してる。例で挙げたのは全てCLなのでキーワードをSQLのキーワード、select等、に割り当ててるのもあるのだが、Schemeということでそれは避ける方向にする。キーワードでもいいんだけどリーダーのモードで読み込みが変わっちゃうので依存しないようにしたい。

いろいろ悩んだ結果こんな感じで割り付けることにする

• 予約語：シンボル
• テーブル名、カラム名(識別子)：シンボル
• 文字列：文字列
• 数値：数値
• ステートメント：リスト
• 式：前置リスト
• 関数呼び出し：前置リスト(式ではないもの)

いたって普通。単純なのはこんな感じに：

(select ((count *)) (from foo) (where (and (< 1 id) (< id 10)))
;; = select count(*) from foo where (1 < id and id < 10); 

他の文は適宜考えることにする。IS NOT NULLみたいなのはどうしようかなぁと悩み中。多分(not (null? ...))みたいにする。

パーサは軽く書いたけどずっと大変なんだよなぁ。BNFがあるのでpackratを使ってゴリゴリ書いていくつもりではあるが。とりあえず全く必要なさそうなEmbedded SQLとかはばっさり切ってしまって問題ないだろう。後は適当に何とかするしかないかなぁ。

割とすぐ欲しいけど時間がかかりそうだ。頑張ろう・・・

R7RSのライブラリに関する疑問

R7RSを実装する際に、ライブラリ周りはR6RSを使いまわしにできたのであまりその仕様について深く考察したことがなかったのだが、最近ちょっと考えることがあり疑問というか不明瞭な点がいくつかあることに気付いた。具体的にはライブラリは複数回読み込まれる可能性があるというこの仕様が不明瞭な点を作っている。仕様から用意に読み取れる点から、ちょっと突っ込んだ(ら直ぐに不明瞭になる)点をだらだらと書いてみようと思う。

明示的に書いてある点

ライブラリAは複数のプログラム、ライブラリから読み込まれた際には読み込みが複数回に渡ることがある。

これは非常に簡単で、以下のようなものになる。

(define-library (A)
  (export inc!)
  (import (scheme base) (scheme write))
  (begin 
    (define inc! 
      (let ((count 0)) 
        (lambda () 
          (set! count (+ count 1))
          count)))
   )
)

(define-library (B)
  (export count-B)
  (import (scheme base) (A))
  (begin (define count-B (inc!)))
)

(define-library (C)
  (export count-C)
  (import (scheme base) (A))
  (begin (define count-C (inc!)))
)

(import (B) (C))

count-B
;; -> 1

count-C
;; -> 1 or 2

ライブラリBがインポートされるのが先と仮定すると、count-Cの値は未定義である。これはライブラリAが複数回評価される可能性があるからであり、これは明示的に書いてある。

書いてない点

いっぱいあるんだけど、とりあえず以下。

(import (scheme eval))

;; library (A) is the same as above
(eval '(inc!) (environment '(A)))
;; -> 1

(eval '(inc!) (environment '(A)))
;; -> ???

これ微妙に書いてない気がする。これは多分、2を返すのが正しい(はず)。根拠としては§5.6.1の最後にあるこれ：

Regardless of the number of times that a library is loaded, each program or library that imports bindings from a library must do so from a single loading of that library, regardless of the number of import declarations in which it appears. That is, (import (only (foo) a)) followed by (import (only (foo) b)) has the same effect as (import (only (foo) a b)).

environmentの引数はimport specである必要があるので、無理やり読めば上記に該当するような気がする。ついでに、プログラムの定義が一つ以上のimport句と式と定義されてる、かつライブラリが複数回読まれる可能性は、読み込みが複数のプログラムもしくはライブラリからなので。

気にしてるのはこれ

(import (scheme base) (prefix (scheme base) scheme:))

一つのプログラム内だから一回のみかなぁとは思うんだけど、微妙に読み取り辛い気がする。

これはどうなるんだろう？

;; a.scm
(import (A))
(inc!)

;; other file
(import (scheme load))
(load "a.scm")
(load "a.scm")

loadは同一の環境で評価するけど、二つのプログラムになるから、両方とも1を返してもいいのかな？それとも、loadで読み込まれたファイルは呼び出し元と同じプログラムということになるのだろうか？

まぁ、こんなことを考えているんだけど、実際の処理系で複数回ライブラリを評価するのは見たことがないので「完全処理系依存フリー」とかいうことをしなければ気にすることはないのではあるが。

Defined or undefined?

R7RS doesn't mandate implementations to load a library only once, unlike R6RS. I believe, the reason why is that letting implementators to have variety of options such as without creating/storing library definition anywhere but each time it'd be evaluated. Understandable, just rather inefficient to me. Also it defines the behaviour of multiple import clauses of the same library.

Now, I've got a question. What should happen if there are 2 the same libraries import in the same import clause and one (or more) of the identifier(s) is(are) renamed like this?

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

;; are car and kar required to be the same binding?

Honestly, I couldn't read if it's required to be the same in such case from R7RS. Though my guess is the followings:

• The last paragraph of section 5.6.1 only specifies the case of 2 import clauses importing the same libraries
• This type of import can't be merged into one import in sense of R7RS import definition (or can it be?)
• Thus this can be multiple import of the same library.
• The third last paragraph of section 5.6.1 suggesting the possibility of multiple load when there's multiple import of the same library (can be interpreted as multiple evaluation of library).

The point that I'm not totally sure is that the paragraph which suggest the possibility of multiple load says that this would happen when the library is imported more than one program or library. This would also be interpreted if a library imported twice in the same script or library, then it should only be loaded once. If this interpretation is correct, then above car and kar must be the same bindings. Otherwise, can be different.

Why this matters? Generally, it doesn't. Just wondering if the last case of this Gist is required to print #t by R7RS.

I've also posted this question to comp.lang.scheme: this

Explicit Renamingが解るかもしれない解説

R7RS-largeではExplicit Renaming(以下ER)が入ると噂されている。まだSRFIすら出ていないのでいつになるのか全く不明ではあるのだが、それがどのように動くかを理解しておけば近い将来(と信じたい)ERが入った際に慌てふためくこともないだろう。といってもsyntax-caseより遥かに簡単なので身構える必要もないのではあるが。

簡単な使い方

まずは簡単な使い方を見てみよう。例としてletをERで書いてみることにする。名前付letは考えないことにするのでマクロの名前はmy-letとしよう。また、簡便にするため既存のletを使うことにする。

(import (scheme base))
;; import er-macro-transformer
(cond-expand
  (gauche (import (gauche base)))
  (sagittarius (import (sagittarius)))
  (chibi (import (chibi)))
  (else (error "sorry")))

(define-syntax my-let
  (er-macro-transformer
    (lambda (form rename compare)
      ;; form = (let bindings body ...)
      ;; bindings = ((var val) ...)
      (let ((bindings (cadr form))
            (body (cddr form)))
 `((,(rename 'lambda) ,(map car bindings) ,@body)
   ,@(map cadr bindings))))))

ER展開器は３つの引数を取る手続きを受取りマクロ展開器を返す。それぞれ入力式、リネーム手続、比較手続の３つである。ERで最も重要なのは二つめのリネーム手続で、この手続きによってマクロの健全性を保証することができる。上記の例ではマクロ内でlambdaをリネームすることによって、以下のような場合でも正く動作することを保証することができる。

(let ((lambda 'boo))
  (my-let ((a 1) (b 2)) (+ a b)))
;; -> 3

ERでは健全性、入力式のチェック等は全てユーザに委ねられる。syntax-caseと異りデフォルト(リネーム手続きを呼ばない単なる式変形)では非健全である。

どうやって動いてるの？

ERの動作原理は実に単純である。リネーム手続きはシンボルをマクロ定義時の環境から見える識別子にして返す。例えば上記の例ではmy-letが定義された際に見える識別子というのは(scheme base)からエクスポートされているものになる。これはlambdaを含むのでリネーム手続きにシンボルlambdaを渡すと(scheme base)からエクスポートされているlambdaを指す識別子を返してくる。

;; very naive/simple image

;; environment when my-let is bound
;; ((exporting-name . actual-binding-name) ...)
'((lambda . |lambda@(scheme base)|)
  ... ;; so on
  )

;; very naive implementation of rename procedure
(define (rename s)
  ;; (macro-environment) returns the above environment
  (cond ((assq s (macro-environment)) => cdr)
        (else
   ;; convert to identifier which is bound in macro-environment
   #;(implementation-dependent-procedure s)
   )))

ここではリネーム手続きはシンボルのみを受け取ると仮定しているが、処理系によってはフォームを受け取ることも可能である。特に仕様が決っていないので処理系独自に拡張されているが、ERをサポートしている多くの処理系ではフォームを受け取ることが可能である。

追記：
リネーム手続きに同名のシンボル又は識別子を渡すと常に同一の識別子が返って来る。同一のオブジェクト(eq?で比較した際に#t)ではない可能性に注意してほしい。R6RSの語彙を借ればbound-identifier=?で#tを返す識別子である。

(define-syntax foo
  (er-macro-transformer
    (lambda (form rename compare)
      (list (rename 'a) (rename 'a)))))
(foo)
;; -> list of the same identifiers in sense of bound-identifier=?

(let () (foo))
;; -> list of the same identifiers as above macro expansion
;;    because input of rename is always 'a

「Hygienic Macros Through Explicit Renaming」によればリネーム手続きの呼出毎にeqv?で#tを返す識別子が新に作られるが、多くのR7RS処理系(Gauche、Chibi、Sagittarius)では同一のオブジェクトを返すようになっている。もちろんそれに依存したコードを書くと後で痛い目にあうかもしれない。

比較手続き

ERが受け取る３つ目の手続きは比較用手続きは渡された２つの入力式が同一であるかを比較する。ここでいう同一とは、同一の束縛を指す。言葉で説明するよりも例を見た方が早いので先ずは例を見てみよう。

(define-syntax bar (syntax-rules ()))
(define-syntax foo
  (er-macro-transformer
    (lambda (form rename compare)
      (define (print . args) (for-each display args) (newline))
      (print (compare (cadr form) (rename 'bar))))))

(foo bar)
;; -> #t

(foo foo)
;; -> #f

(let ((bar 1))
  (foo bar))
;; -> #f

barは束縛されている必要はないのだが(なければ未束縛として比較される)、ここでは話を簡単にするために敢えて束縛を作っている。fooは一つ目のフォームとリネームされたbarが同一の束縛を指すかをチェックするだけのマクロである。 
一つ目の(foo bar)では与えられたbarは大域に束縛されたbarと同一の束縛を指すので#tが返る。これは以下のようにした際に参照される束縛と同一のものと考えれば自明である。

bar
;; -> syntax error

二つ目の(foo foo)はbarではないので#fが返る。
三つ目の(foo bar)は引数barがマクロ展開時に見える束縛と異る為に、この場合は局所変数barが見える、#fを返す。
R6RSの語彙を借て説明すれば、比較手続きはfree-identifier=?とほぼ同義である。(処理系の拡張によってフォームを受け取れる可能性があるため「ほぼ」としている。)
比較手続きを用いることでcondのelseなどの補助構文の導入が可能になる。

まとめ

非常に簡潔にだがERの使い方及び動作モデルの説明をした。syntax-caseでもそうだが、ERも付き詰めればマクロ定義時と展開時の識別子が何を指すのかというところに落ち着き、ERではこれを非常に明示的に記述することができる。

参照

William D Clinger - Hygienic Macros Through Explicit Renaming
https://groups.csail.mit.edu/mac/ftpdir/users/cph/macros/exrename.ps.gz

er-macro-transformer on top of syntax-case

There are numbers of low level hygienic macros in Scheme world. The most famous ones are probably the followings:

• explicit renaming
• syntax-case
• syntactic closure

Of course there are more (e.g. ir, reverse syntactic) but if you discuss low level hygienic macros, then above would usual be the ones.

R6RS has syntax-case and rumour says R7RS would have explicit renaming. According to this article, if implementations have one of them, then the rest can be implemented atop it. I'm wondering is it really true? Very lame conclusion is true. Because Sagittarius uses kind of syntactic closure and implements both explicit renaming and syntax-case. Now, can it be done in a portable way?

So I've wrote this. It seems this can work most of R6RS implementations except Racket. Though I haven't tested on Larceny, Guile and Vicare yet, they are using either Psyntax or van Tonder expander such as Mosh and IronScheme (Psyntax) or NMosh (van Tonder). So should work.

The basic idea of the implementation is very simple. rename procedure is a simple wrapper of datum->syntax. compare is free-identifier=?. Then wrap the returning form with datum->syntax*.

The initial revision of the Gist used mere datum->syntax. This wasn't good enough because the procedure should only accept datum not syntax object. The error was raised by Psyntax implementations and Racket. Then I've been suggested to walk thought the returning form.

@tk_riple (1)renameはマクロ定義環境を参照すると理解してます。で、最初の例でもマクロ定義環境のfooはローカルのfooですよね? (2)erマクロ展開手続きから帰ってきたフォームをwalkして生シンボルをマクロ使用環境のsyntaxに置換するんじゃだめですか?

— Kilo Kawai (@anohana) October 24, 2015

I first thought this won't work because traversing and constructing a new form would return a list not a syntax object. However I was just didn't consider thoroughly. If I use syntax-case and quasisyntax (with-syntax could also be), then I can construct syntax object containing syntax object renamed by er-macro-transformer. So I've rewrite the code. Then most of the R6RS implementation seem working. Even Racket seems working if the macro is very simple like the one on the comment.

Now, my question is 'Is this R6RS portable?'. R6RS standard libraries 12.2 says:

The distinction between the terms “syntax object” and “wrapped syntax object” is important. For example, when invoked by the expander, a transformer (section 12.3) must accept a wrapped syntax object but may return any syntax object, including an unwrapped syntax object.

So transformer *MAY* return unwrapped syntax object. Though what I'm doing is returning wrapped syntax object so should be fine. What I couldn't read is whether or not a syntax object can contain syntax object(s) inserted by other transformer. If this is required feature, then this might be a bug of Racket. Otherwise this is not portable.

I hope it's a bug of Racket, then you (not me) can write an explicit renaming SRFI with sample implementation.

For convenience, embedded source.

カスタムポートとソケットとバッファポート

「と」で繋げるとなんとなくアニメとかのタイトルっぽい感じがするなぁ。

Sagittariusは0.6.9でポート周りにかなりバグを混入した(弄った)のだが、頭を悩ませるバグが顕在化した。それが表題のポートである。どこで使われているかといえばTLSである。

何が問題か？いくつかの問題が合わさってるのではあるんだが、一つはget-bytevector-nとカスタムポートの相性。カスタムポートは要求されたバイト(文字数)を返す必要はないので、例えば1バイトずつ返して呼び出し元に判断させるということができる。例えば以下のようなの

(import (rnrs))

(let* ([pos 0]
       [p (make-custom-binary-input-port
           "custom in"
           (lambda (bv start count)
             (if (= pos 16)
                 0
                 (begin
                   (set! pos (+ 1 pos))
                   (bytevector-u8-set! bv start pos)
                   1)))
           (lambda () pos)
           (lambda (p) (set! pos p))
           (lambda () 'ok))])
  (get-bytevector-n p 3))
;;-> #vu8(1 2 3)

R6RSテストスイーツからの抜粋なのだが、read!手続きは1バイトずつ処理しget-bytevector-nが最終的に何を返すか決定するという形である。カスタムポートが扱うのが有限のデータなら特に問題ないのだが、ソケットのようにいつEOFがくるか分からないものだと割と困るのである。例えばread!の部分がrecvを使っていたとして、あるソケットは要求の半分のデータを受信したする。そうするとget-bytevector-nは残りの半分を取得するためにもう一回read!を呼び、処理はブロックされる。

不定長のデータを扱うのにget-bytevector-nなんて使うなという話なのだが、本当の問題は別のところにある。0.6.9からバッファポートを導入したのだが、こいつとカスタムポートの相性が悪い。何が悪いかと言えば、バッファを埋めるのにget-bytevector-n相当のことがされているのである。カスタムポートを実装したときに、あまり何も考えずにポート側でバイト数を数えるようにしてしまったので複数回の呼び出しが起きるという話なのではある。

解決方法は多分2つくらいあって、

1. バッファを埋める処理を別枠にする
2. 現状ポート側でやってることをget-bytevector-nに移す

1.はそこそこadhocな感じがして嫌だなぁ。2.は(99.99%ないけど)別のところに影響が出る可能性がある(もしくは考慮漏れによるバグの混入)。でも2かなぁ、どう考えても。それでとりあえずはバッファの問題は解決するし。

CPSマクロ

assocをマクロで書いたらどうなるか、ということを考えた。これくらいならそんなに難しい話ではなく、以下のように書けるだろう。

(import (scheme base) (scheme write))

(define-syntax assocm
  (syntax-rules ()
    ((_ key (alist ...))
     (letrec-syntax ((foo (syntax-rules (key)
                            ((_ (key . e) res (... ...)) (key . e))
                            ((_ (a . d) res (... ...)) (foo res (... ...))))))
       (foo alist ...)))))

;; a bit of trick to avoid unbound variable
(define (c d) (list 'c d))
(define d 1)

(assocm c ((a b) (b d) (c d) (d d)))
;; -> (c 1)

取り出せるのであれば、その中身も欲しい。つまり、carやcdrだ。これも同じ要領でやればこんな感じで書けるだろう。

(define-syntax cdrm
  (syntax-rules ()
    ((_ (a . d)) d)))

(cdrm (c . d))
;; -> 1

だが、これら二つのマクロはこんな感じでは組み合わせられない。

(cdrm (assocm c ((a b) (b d) (c d) (d d))))
;; -> error

これはcdrmがassocmより先に展開されるからである。あるマクロの展開結果を別のマクロで使いたい状況というのはしばしばある。そういうときにはCPSでマクロを書く。最初のassocmをCPSで書いてみよう。

(define-syntax assocm/cps
  (syntax-rules ()
    ((_ k key (alist ...))
     (letrec-syntax ((foo (syntax-rules (key)
                            ((_ (key . e) res (... ...)) (k (key . e)))
                            ((_ (a . d) res (... ...)) (foo res (... ...))))))
       (foo alist ...)))))

(assocm/cps cdrm c ((a . b) (b . d) (c . d) (d . d)))
;; -> 1

このassocm/cpsは最初の引数に次に展開するマクロを受け取ることで、マクロの展開が終わった際に展開結果(この場合は(key . e))を引数kに渡すことを可能としている。要するに単なるCPSであるがこの状態では割と致命的な欠点がある。それは複数のマクロを組み合わせることができないということである。

例えば上記の例でcadrmはどう書くだろうか？普通に考えれば、carmを定義したのち、cdrmを組み合わせて書きたいところであろう。(もちろんゴリゴリ書いてもいいんだけど。) そう(compose f g)みたいなことがしたわけである。

;; I want to write like this!
(assocm/cps (composem cdrm/cps carm) c ((a . b) (b . d) (c . d) (d . d)))

こうなると、単にマクロを受け取って結果を渡すだけではなく、次のマクロが複合マクロかどうかを判別して上手いことやってくれる何かがほしい。こんな感じだろう。

(define-syntax composem (syntax-rules ()))

;; assume k is CPS macro
(define-syntax extract/cps
  ;; it's a bit awkward to have own name in literals
  ;; but this saves me a lot
  (syntax-rules (composem extract/cps)
    ((_ (composem k) args ...) (k args ...))
    ((_ (composem k ...) args ...)
     (extract/cps "flatten" () (k ...) (args ...)))
    ;; flatten nested composem
    ((_ "flatten" (cps ...) ((composem k ...) k* ...) args)
     (extract/cps "flatten" (cps ... k ...) (k* ...) args))
    ((_ "flatten" (cps ...) (k k* ...) args)
     (extract/cps "flatten" (cps ... k) (k* ...) args))
    ((_ "flatten" (cps ...) () (args ...))
     (extract/cps (extract/cps cps ...) args ...))
    ;; extract/cps keyword
    ((_ (extract/cps (composem k)) args ...) (k args ...))
    ((_ (extract/cps (composem k k* ...)) args ...)
     (k (extract/cps (composem k* ...)) args ...))

    ((_ (extract/cps k) args ...) (k args ...))
    ((_ (extract/cps k k* ...) args ...)
     (k (extract/cps (composem k* ...)) args ...))
    ;; short cut
    ((_ k args ...) (k args ...))))

多少無理やり感があるので(extract/cpsリテラルとか)もう少し綺麗にならないかと思ったりはするのだが、まぁとりあえずこんな感じでいいだろう。これを使って上記のassocm/cpsは以下のように書き換える。

(define-syntax assocm/cps
  (syntax-rules ()
    ((_ k key (alist ...))
     (letrec-syntax ((foo (syntax-rules (key)
                            ((_ (key . e) res (... ...)) 
                             (extract/cps k (key . e)))
                            ((_ (a . d) res (... ...)) (foo res (... ...))))))
       (foo alist ...)))))

さらにcarm/cpsとcdrm/cpsをこんな感じで定義して、最後のkをvaluesmとして定義しよう。CPSマクロの最後に展開されるマクロはCPSではないことに注意しよう。

(define-syntax cdrm/cps
  (syntax-rules ()
    ((_ k (a . d)) (extract/cps k d))))

(define-syntax carm/cps
  (syntax-rules ()
    ((_ k (a . d)) (extract/cps k a))))

(define-syntax valuesm
  (syntax-rules ()
    ((_ args) args)
    ;; this isn't really values...
    ((_ args ...) (args ...))))

こうするとassocmから見つかった値のcadr部分をとるマクロは以下のように書ける。

(assocm/cps (composem cdrm/cps carm/cps valuesm) c ((a b) (b d) (c d) (d d)))
;; -> 1

ちなみに、このコードGaucheでは(まだ)動かないので(すぐ直されると思うけど)、実際に動かしてみたい場合はSagittarius、Chibi、Larcenyのいずれかを使うといいだろう。

ちなみに、この手のコードは3日もすると自分でも理解不能になる危険を孕んでいるので使用する際は十分に留意した方がいいだろう。こういったマクロはだいたOleg氏がまとめているので、メタプログラミングの深淵を覗きたい方はそちらを参照されたい。この辺とか。