Let's start Scheme

2015-05-23

互換レイヤを書く

R6RS処理系の過半数(6個)についてFFIの互換レイヤを書いたので(Larcenyはまだテストが通らないけど)、今後のためにどういうことを気をつければいいかを記しておく。要するに愚痴である。

ドキュメントを当たる


まぁ、超基本である。ここだけで済むのであれば優秀なドキュメントを持っていると言える。互換レイヤを書くということは、言い換えると処理系依存の機能を同一APIに落とし込むということなので、まずはターゲットとしている処理系がほしい機能を備えているかを調べる。ここで見つけられなかったら諦めるという手もある。

ちなみに、今回ここだけで済んだ処理系はRacketとGuileのみである。この2つはドキュメントがかなり優秀といえる。(GuileはどうやってFFIのライブラリをロードするのかがドキュメントに書いてなかったけど・・・)

Schemeで書かれたソースを当たる


Schemeで書かれたソースは大体どこかに付属しているものである。たとえバイナリ配布されているものであったとしてもである(例:Sagittarius、Larceny)。明文化されていないとはいえ機能自体を持っているということは割りとよくある話で、そういう場合は今後後方互換性が損なわれる可能性があることを考慮にいれつつ書く必要がある。まぁ、変わったら泣く覚悟が必要という話である。

Schemeで書かれたソースも処理系によって大分違う。例えば、Mosh、Vicare、Sagittariusは基本的にライブラリ形式なので見つけてしまえばそのままライブラリを呼ぶことができる。Larcenyは多少違って、ライブラリ外の手続き・マクロは(primitives foo ...)のようにしてやる必要がある。これはvan Tonderのマクロで共通なのでNMoshもこの形式である。

今回ここまでで済んだ処理系はVicareであった。まぁ、VicareはFFIの機能的に多少物足りなかったのでなんとかならんかなぁとCソースまで覗いたが。

Cで書かれたソースを当たる


正直ここまで来たら諦めた方がいいレベルである。処理系によっては全くどこにも書かれていないが利用できる機能というものがある。具体的にはMoshのbytevector-pointerである。まともな感覚で書かれたものであれば、大体機能ごとにまとまっているものなので適当にファイル名からあさるという手がある。Mosh的にはFFIProcedures.cppという名前がずばりという感じであったので覗いたら見つけた。ファイル名から見つけるのはソースが一箇所に固まっているとやりやすいがそうではない場合もある(具体的にはLarceny)。そういう場合は以下のような古典的な方法を使ったりする。
find . -name '*.c' | xargs grep 'keyword'
探したいファイルの拡張子は適当に変える必要があるかもしれない。今回はFFI関連だったので、pointerとか
ffiとかがよく使われた。
Larcenyはソースがいろいろなところに配置されていたり、ドキュメントではなくREADMEにAPIの使い方が書いてあったり(具体的にはlib/Ffi/README)と手当たり次第当たる必要があった。

Schemeオブジェクトのメモリ配置に依存したコードを書く


ここまでやりだしたら正直いろいろ考え直した方がいいレベルである。Larcenyにはバイトベクタからポインタを作る手段がない。Vicareはバイトベクタをコピーする不便は振る舞いをするがそれでも存在したのであるが、Larcenyでは存在すら確認できなかった。偶然にもffi/handle->addressというものを発見したのでその振る舞いを確認。こいつは最終的にsrc/Rts/Sys/primitives.cに定義されているprimitive_object_to_addressが呼ばれることを確認し、この関数は与えられたオブジェクトからタグを取り除いたものを返すという振る舞いをすることが分かった。そうすると、バイトベクタの構造を知ってしまえばその要素がどのように配置されているかが分かる。いくつかのソースを覗いてbytevector_refというものが多用されているのを見つけて、その定義まで飛ぶ。include/Sys/macros.hで定義されているのだが、ここからLarcenyは構造体などという優男が使うようなものは使用しておらず、メモリのオフセットを直接弄るという男らしい方法をとっていたことを知る。最初の1ワードはサイズを格納して、残りは要素という感じになっているので、上記のScheme手続きで得られるアドレスにポインタのサイズを足した分をポインタとすることにした。

いい悪いは別にして、こんな超が付くレベルの危険な操作も可能にしているのは「何かしら打つ手がある」という希望があるので個人的には好きである。(この機能は必要だったのでSagittariusにもあったりはするが。)

まとめ


月並みな言葉になるが、ドキュメントは重要である。今回分かったのはユーザー視点で見ればRacketレベルのドキュメントはとてもありがたく、Mosh、Larcenyレベルのドキュメントは涙が出るということであった。VicareはなぜかFFIの項目だけやる気がないのでそれもどうかと思ったが。

後は、Chez、IronSchemeとYpsilonをやればR6RS処理系を網羅したライブラリになるのだが、正直もうやりたくないです感が自分の中に漂っている。

2015-05-20

Introduction of Portable Foreign Function Interface (pffi) library

I think it has kinda fixed for API wise, so let me introduce Portable Foreign Function Interface (pffi)

The library is written mostly R6RS portable. Of course, it's impossible to write FFI without implementations' support so it just provides some of greatest common interfaces. One of the purpose is that if you want to write bindings written in C for R6RS Scheme, you always need to refer FFI APIs per implementations. This is pain in the ass. Most of the R6RS implementations provide the way to write compatible layer, so if there is an abstraction layer then users can write portable code without the pain. (don't ask me, how many people want to write portable code.) Currently the following implementations are supported:

  • Sagittarius (0.6.4)
  • Mosh (0.2.7, only SRFI Mosh, so called NMosh)
  • Vicare (0.3d7)
  • Racket (6.1.1, plt-r6rs)
  • Guile (2.0.11)
This is more than 50% of R6RS implementations which support FFI, so I think I'm allowed to call it portable.

How to use


Suppose you have the following useful function written in C.
int plus(int a, int b)
{
  return a+b;
}
Very useful isn't it? Now it's compiled to libtest.so. Then the Scheme code which uses this C function would look like this:
#!r6rs
(import (rnrs) (pffi))

;; load C library
(define lib (open-shared-object "libtest.so"))

;; load C function
(define plus (foreign-procedure lib int plus (int int)))

;; loaded C function can be called as if it's Scheme procedure.
(plus 1 2) ;; => 3
This code works for all implementations listed above. Simple, easy, isn't it?

Callback


If a C function requires function pointer such as quicksort, then you want to write it in Scheme. Suppose our quicksort has the following signature:
int quicksort(void *base, const size_t num, const size_t size,
              int (*compare)(const void *, const void *));
The first one is the array of elements you don't know the size, the second one is the number of the elements, the third one is the size of an element, then the last one is comparison function. To use this in Scheme, then you can write like this:
;; suppose this is in libtest.so
(define qsort
  (foreign-procedure lib int quicksort
     (pointer unsigned-long unsigned-long (callback int (pointer pointer)))))

(let ((callback (c-callback int
                            ((pointer a) (pointer b))
                            (lambda (a b)
                              (let ((ia (pointer-ref-c-uint8 a 0))
                                    (ib (pointer-ref-c-uint8 b 0)))
                                (- ia ib)))))
      (bv (u8-list->bytevector '(9 1 2 8 3 7 4 6 5))))
  (qsort (bytevector->pointer bv) (bytevector-length bv) 1 callback)
  (free-c-callback callback)
  (bytevector->u8-list bv));; => (1 2 3 4 5 6 7 8 9)
It's slightly uglier than the plus since you need to specify the callback procedure's types twice (if you want to write portable thing, sometimes this kind of things are inevitable). Some implementations doesn't free callback either, so you need to release it explicitly with free-c-callback procedure (of course, if the callback is created globally, then you don't have to since it's bound forever).

Global variables


I'm not sure if you want to handle this kind of code, but sometimes it's inevitable. Suppose your C library exports the following variable:
int externed_variable = 10;
Now, you need to get this value and modify this value from Scheme world. You can do like this:
(define-foreign-variable lib int externed_variable)
;; can also be written to specify the binding name
;; the name is converted to Scheme way if the macro is only given 3 arguments.
(define-foreign-variable lib int externed_variable global-variable)

externed-variable ;; => 10
global-variable   ;; => 10

;; this overwrites the value of C world
(set! global-variable (* global-variable 10)) ;; unspecified
global-variable   ;; => 100

;; so if the address is shared, then it's got affected.
externed-variable ;; => 100
I hope there is no actual use case for this but it's always good to have some workaround.

C Structure


Most of C functions requires pointer(s) of structure. C's structure is mere chunk of memory so you can simply pass a bytevector and get its value calculating offset/padding of the structure. But this is kinda pain in the ass. This library provides define-foreign-structure macro which is pretty much similar with define-record-type and calculates padding/offset for you.

Suppose you have the following C structure and its operations:
struct st1
{
  int count;
  void *elements;
};

struct st2
{
  struct st1 p;
  short attr;
};

static int values[] = {0,1,2,3,4,5,6,7,8,9};

#define CONST 1L
#define INT_ARRAY 1L<<1;

void fill_struct(struct st2 *s)
{
  s->p.count = sizeof(values)/sizeof(values[0]);
  s->p.elements = (void *)values;
  s->attr = CONST | INT_ARRAY;
}
To use this, you can write like this:
(let ()
  (define-foreign-struct st
    (fields (int count)
            (pointer elements)))
  ;; either way is fine
  (define-foreign-struct st2
    (fields (st p)
            (short attr)))
  ;; if the first member of struct is a struct
  ;; then you can also use 'parent' clause
  (define-foreign-struct st2*
    (fields (short attr))
    (parent st))

  (let ((st  (make-st2 (make-st 0 (integer->pointer 0)) 0))
        (st* (make-st2* 0 (integer->pointer 0) 0))
        (fillter (foreign-procedure lib void fill_struct (pointer))))
    ;; created struct is mere bytevector
    (fillter (bytevector->pointer st))
    (fillter (bytevector->pointer st*))
    ;; accessors are just accessing calculated offset
    (st-count st) ;; => 10
    ;; so this is also fine
    (st-count (st2-p st)) ;; => 10
    (st2-attr st) ;; => 3
    ;; this can also work. NB different accessor
    (st2-attr st*) ;; => 3
    (st2-p st) ;; => bytevector
    ))
parent might look weird since there is no hierarchy mechanism on C struct. But in practice, you see a lot of code which uses this kind of technique to emulate sub class thing. So I thought it might be useful. If you don't want to use it, you don't have to. You can also specify the struct member.

You might not want initial value for structures, then you can also use protocol like this:
(let ()
  (define-foreign-struct st
    (fields (int count)
            (pointer elements))
    (protocol
     (lambda (p)
       (lambda (size)
         (p size (integer->pointer 0))))))
  ;; either way is fine
  (define-foreign-struct st2
    (fields (short attr))
    (parent st)
    ;; child must have protocol if the parent has it
    (protocol
     (lambda (p)
       (lambda ()
         ((p 0) 0)))))

  (let ((st  (make-st2))
        (fillter (foreign-procedure lib void fill_struct (pointer))))
    (fillter (bytevector->pointer st))
    ;; accessors are just accessing calculated offset
    (st-count st) ;; => 10
    (st2-attr st) ;; => 3
    ))
The protocol is just the same as define-record-type's one. So the same rules are applied.

The define-foreign-struct also creates size-of-struct-name variable which contains the size of the structure. So you don't have to allocate memory to know the size.

What can't do


  • Currently, there is no way to pass address of pointers.
  • Union is not supported.
  • Bit field is not supported.
Probably many more, but I think it can still cover basic usages.

As usual, your pull requests / feedbacks are always welcome.

2015-05-18

FFI library comparison for R6RS implementations

I'm writing Portable Foreign Function Interface for R6RS and have found some interesting things to share. Currently the library supports the following implementations and this article mentions them mainly:
  • Sagittarius (0.6.4)
  • Vicare (0.3d7)
  • Mosh (0.2.7)
  • Racket (plt-r6rs 6.1.1)
  • Guile (2.0.11)

API wise


Most of the implementations supports common procedures with different names. Only Mosh, Sagittarius and Vicare provide similar APIs. (Well, at least Sagittarius took some of the API names from Mosh, I don't know about Vicare.) Unfortunately, Mosh has much less APIs and seems incomplete. For example, Mosh doesn't have any API to convert bytevectors to pointers or APIs to set unsigned char/short/int/long to pointer. This might be critical in some cases. Vicare and Sagittarius have enough APIs to do almost everything.

Racket has interesting APIs. Almost all foreign variable need to have types.  For example, it distinguish char * and void * whilst above 3 not really do.

Guile has limited pointer operation procedure. It seems users always convert pointers to bytevectors, I think this is pretty inconvenient though. And it doesn't accept bytevector as pointer directly. So it needs to be converted by bytevector->pointer procedure.

Documentation wise


Racket provides excellent documents so I could write the library without referring its source code.

Guile provides good documents it's not so user friendly means I needed to do some try and errors to figure out how it works (especially, document doesn't provide library name. It took me some time to figure it out).

Mosh is OK document, though I also referred the source code. (because of lack of APIs, I hoped there is hidden ones).

Sagittarius is also OK document. Though, some of APIs documents are missing so it would be hard to write this library without referring the source code.

Vicare has poor document for FFI (unlikely the other documents). It just have shallow intruductions. This basically means there might be a chance that APIs would be changed. To write the library, I needed to refer the source code.

Other implementations


There are 4 more R6RS implementations which support FFI, Chez, Ypsilon, IronScheme and Larceny. These are the reasons why I didn't do it in first place:

Chez: I can only use Petite Chez Scheme but this doesn't support FFI. So to make it I need the comercial one which is not available anymore.

Ypsilon: Released version of Ypsilon has very limited APIs to create foreign functions/variables. And no document. Trunk version is far more APIs but not maintained nor released (I think it's sad but I can't help it). Just gave up.

IronScheme: .NET ... well simply not familiar to use it

Larceny: I might support, even it has good document. But there is no proper install script. So it's kinda hard to run/test.

Conclusion



I don't mean which APIs are the best or worst. Just figured out that if I want to write a portable library, then it might be better to have rather low level APIs exposed. And if low level APIs are there, then most of the concepts can be shared even they look completely different. (In this sense, Ypsilon's APIs are too high level to handle, unfortunately.)

2015-05-14

オランダで働くということ

妹からWhat's Appでオランダの労働環境的なものの質問が来て、「これはブログのネタになる」と思ったのでまとめてみることにする。法律的なことは詳しくないし、あくまで僕の経験+聞いた内容なので正確性は低いと思ってもらえるとありがたい。断定的な言葉を使っているが後ろに「と思う」とか「のはず」とかを捕捉してもらいたい。

雇用形態


オランダでは基本的に「無期限契約」か「期限付き契約」しかない。どちらも扱いは正社員という扱いになるが、後者は期限がくると契約更新がある。僕は最初の会社は「一年契約」の後に「無期限契約」になった。当然だが、ずっと「一年契約」が続くかもしれないし、契約を打ち切られるかもしれない。また、オランダでは基本的によほどのことがない限り解雇はない(あるけど、かなりの金額を労働者に払う)ので、「無期限契約」であれば懲戒免職を除き職にあぶれる心配はないとも言える。

労働時間も変更できる。基本的には週40時間だが、働き方によっては週36時間とかも可能。もちろん減らした時間分の給料は減額され、有給の日数は減ることになるがペンションプランとかに変更はない。

ちなみに、日本で言うアルバイトは存在せず、学生が行う仕事も普通に有給及びペンションプラン(25歳以上は加入必須)とかあるらしい。こういった仕事は大抵「0時間契約」になり、働いた時間分だけ給料が支払われるそうだ。

待遇


上でも述べたが、雇用契約の違いによる待遇の差というのはない。日本のパートやアルバイトのように福利厚生が一切ない雇用契約というものも基本的にはない。ただし、家族手当等の基本給を上げずに額面を挙げるとうの小細工も存在しないので、下記に述べる理由もあり、契約で決まった給料以上の給料はもらえない。ベースアップは会社にもよるが、基本は年に一回。当然だが業績の悪い年はない。

手当てではないが、交通費は基本出る。会社によっては健康保険料も出る。月に€150くらいかかるので出ると結構でかい。コーヒー、お茶は基本無料。昼食もある場合もあるが、こちらは有料になる(今の会社は仕組みがよく分からないので払ってるかは疑問だが・・・)。当然だが外に食べに行ってもよいし、弁当持参してもよい。

ちなみに、高い高いといわれている税金だが、引かれる額は大体3割である。Expatだと30%ルールというのがある。これは額面の30%には税金がかからない(丸々もらえる)というもの。残念ながら僕には適用されないので縁のない話。国外からの優秀な労働者に与えるものなので、パートナービザには適用されないのである。

働き方


基本残業はない。有給は3週間まとめて取るとか普通。戻ってきたときに仕事が山積みということも基本ない。その人のポジションによるが。2社しか働いたことないので、一般的ではないかもしれないが、金曜の夜は会社がビールを振舞ったりする(ただ酒が飲める)。

所謂「上司と飲みに行く」とか「強制参加慰安旅行」とかもない。あるけど、当然自由意志で断ることもできる。別に断ったからといって雰囲気が悪くなることもない。

人によっては副業を持つことも可能。例えば本業で8時-17時まで働いて19時-21時まで別の仕事とかもある。会社既定で禁止していることもあるので注意が必要ではある。僕の場合は決められた8時間を会社のフルにコミットできれば別に副業してもいいという話だったので、雇用契約を結ぶ前に確認した方がいい。

個人的な意見だが、日本で働いていたときより100倍は楽である。いろんな面で。

転職


これは僕自身も日本で経験したことはないのだが、職場を変えると「昨日の味方は今日の敵」になることが日本ではあるらしい。そんなものはない。そもそも、職を転々とする人が多いので(コの業界だからかもしれないが)毎回敵を作っていては身が持たないし、次は顧客として会う可能性もかなりあるのでそんなあほなことはしない。

転職自体は「新卒主義」とか全然ないのでいろいろ楽。周りを見渡しても大体転職組。


隣の芝なので青く見えるかもしれないが、個人的な意見としては労働環境だけを見れば青いと思う。まぁ、僕が日本で働いた会社がそんなによくなかっただけという話もあるかもしれないが。

2015-05-13

Breaking privacy

R6RS has a record which is much more flexible than the one R7RS provides. You can consider the R7RS one is a subset of R6RS record. One of the differences between R6RS record and R7RS record is that R6RS provides inspection layer. Using this makes us having sort of peeping Tom ability.

Scenario


Suppose you want to have a record type which is only used in the library defines the record type. Later on, you notice that it might be convenient if users can pass the record so you decided to export its constructor.
#!r6rs
(library (private-record)
    (export make-private2)
    (import (rnrs))

  (define-record-type private
    (fields field1))
  (define-record-type private2
    (fields field2)
    (parent private))

  ;; you may want to do some
  ;; private operation here 
  
  )
So far so good. It seems no one can access the record fields except the library itself. So you can have some privacy here.

Is that really so?


Actually not. You would still have peeping Tom. Let's see how we can do it.
#!r6rs
(import (rnrs)
 (private-record))

(define private2 (make-private2 1 2))
(define private2-rtd (record-rtd private2))

;; predicate
(define private? (record-predicate (record-type-parent private2-rtd)))
(define private2? (record-predicate private2-rtd))

;; get field accessors
(define (find-accessor rtd field)
  (let loop ((rtd rtd))
    (if rtd
        (let ((fields (record-type-field-names rtd)))
          (let lp ((i 0))
            (cond ((= i (vector-length fields)) (loop (record-type-parent rtd)))
                  ((eq? (vector-ref fields i) field)
                   (record-accessor rtd i))
                  (else (lp (+ i 1))))))
        (lambda (o) (error 'find-accessor "no such field" field)))))

;; parent field
(define private2-field1 (find-accessor private2-rtd 'field1))
;; record field
(define private2-field2 (find-accessor private2-rtd 'field2))

(display (private2? private2)) (newline)
(display (private? private2)) (newline)

(display (private2-field1 private2)) (newline)
(display (private2-field2 private2)) (newline)
#|
#t
#t
1
2
|#
Even though the library only exports constructor, we can still access to the fields including parent's one and checks if the object is the particular record.

The inspection layer is really convenient in some cases. Suppose you want to write a destructuring matcher which can also handle records. The essence of this kind of macro would be like the following:
(define-syntax destructuring-record
  ;; actually we don't need to put 'record' keyword at all
  ;; to show only this...
  (syntax-rules (record)
    ((_ (record r field ...) body ...)
     (let ((tmp r))
       (when (record? tmp)
         (let* ((rtd (record-rtd tmp))
                ;; definition of find-accessor is above
                (field ((find-accessor rtd 'field) tmp))
                ...)
           body ...))))))

;; use it
(destructuring-record (record private2 field2) (display field2) (newline))
If you know the field names of records, then you can write without calling predefined accessors. (Though, this would cost a bit of performance since it creates closures each time.)

How to prevent it?


If you are treating something you really don't want to show such as password (I don't argue holding password here), you just need to specify (opaque #f) in the record definition.

Caveat


R7RS or SRFI-9 define-record-type can be implemented by R6RS's one. Since R7RS's one doesn't specify record inspection, there is no way to prevent this as long as wrapper doesn't specify (opaque #f). One of the implementations made by Derick Eddington allowed to be inspected. Should this behaviour be the case for R7RS one?

2015-05-12

秘伝のタレマクロができるまで

Schemeでこのマクロ便利なんだけど、どうやったらこんな複雑なマクロ書けるんだ?と疑問に思ったことはないだろうか?ふと自分が書いているマクロが機能追加とともに巨大に(まだ小さいけど)になっていっているの(成長途中)をみて答えの一つを見た気がしたので駄文として残すことにした。

最初は小さいものだった


僕はテストはSRFI-64を使って書くことが多い。というかほぼ100%である。SRFI-64は便利なのだが、多値を扱うテストを書くAPIを標準で提供していない(と思う、真面目に仕様眺めてない、でかいし)。毎回let-valuesを書くのは馬鹿らしいので以下のようなマクロを書いた。
;; version 1
(define-syntax test-values
  (syntax-rules ()
    ((_ (expected ...) expr)
     (test-values 'expr (expected ...) expr))
    ((_ name (expected ...) expr)
     (test-equal 'expr (expected ...) (let-values ((results expr)) results)))))
非常に単純に多値をリストで受け取ってequal?で比較するだけだが、最初のうちはこれで十分だった。しかも、let-valuesを毎回書く必要もない上に、何のテストをしているのか(この場合は多値)というのが一目で分かるし、やっぱりマクロは便利だなぁ、程度で済んでいた。

リスト内の値を一つずつ比較したくなった


多値を返す手続きのテストを行っていると、どの値が失敗しているのかということが知りたくなる。そうするとリストにまとめて比較するのでは辛い部分が出てきたので以下のように変更した。
;; version 2
(define-syntax test-values
  (syntax-rules ()
    ((_ "tmp" name (e e* ...) (expected ...) (var ...) expr)
     (test-values "tmp" name (e* ...) (expected ... e) (var ... t) expr))
    ((_ "tmp" name () (expected ...) (var ...) expr)
     (let-values (((var ...) expr))
       (test-equal '(name expected) 'expected var)
       ...))
    ((_ (expected ...) expr)
     (test-values expr (expected ...) expr))
    ((_ name (expected ...) expr)
     (test-values "tmp" name (expected ...) () () expr))))
これなら返ってくる値を一つずつ比較するので、どの値が失敗するのかということが分かりやすくなった。マクロの量は2倍程度に膨らんだが、毎回test-equalを書く必要もないし楽だという感じであった。

予想される結果が複数ある場合が出てきた


このマクロはSASMを書いているときに使っているのだが、x86の一貫性のなさから返し得る値が複数ある場合が出てきた(例: ADD)。そうすると、何かを弄った拍子に結果が入れ替わるとかが起きると毎回テストを書き換えなければならない。それではテストを書いてる意味が薄れると思ったので、こういった場合にも対応できるようにした。
;; version 3
(define-syntax test-values
  (syntax-rules (or)
    ((_ "tmp" name (e e* ...) (expected ...) (var ...) (var2 ... ) expr)
     (test-values "tmp" name (e* ...) (expected ... e) 
                  (var ... t) (var2 ... t2)
                  expr))
    ((_ "tmp" name () (expected ...) (var ...) (var2 ...) expr)
     (let ((var #f) ...)
       (test-assert 'expr
                    (let-values (((var2 ...) expr))
                      (set! var var2) ...
                      #t))
       (test-values "equal" name (expected ...) (var ...))))
    ;; compare
    ((_ "equal" name () ()) (values))
    ((_ "equal" name ((or e ...) e* ...) (v1 v* ...))
     (begin
       (test-assert '(name (or e ...)) (member v1 '(e ...)))
       (test-values "equal" name (e* ...) (v* ...))))
    ((_ "equal" name (e e* ...) (v1 v* ...))
     (begin
       (test-equal '(name e) e v1)
       (test-values "equal" name (e* ...) (v* ...))))
    ((_ (expected ...) expr)
     (test-values expr (expected ...) expr))
    ((_ name (expected ...) expr)
     (test-values "tmp" name (expected ...) () () () expr))))
正直自分が書いたものじゃなければ見ただけでは理解できないレベルになりつつあるが、複数ある場合用のマクロ(test-values/altとか?)を作るのも嫌だなぁという気がしたのでこれはこれでいいかということになった。

単純なequal?では比較できない場合が出てきた


返ってくる値がequal?で比較できない、具体的には述語でテストしたい場合が出てきた。既にorで場合分けされているので同様にキーワードを追加すればいいだけだしということで追加した。
;; version 4
(define-syntax test-values
  (syntax-rules (or ?)
    ((_ "tmp" name (e e* ...) (expected ...) (var ...) (var2 ... ) expr)
     (test-values "tmp" name (e* ...) (expected ... e) 
                  (var ... t) (var2 ... t2)
                  expr))
    ((_ "tmp" name () (expected ...) (var ...) (var2 ...) expr)
     (let ((var #f) ...)
       (test-assert 'expr
                    (let-values (((var2 ...) expr))
                      (set! var var2) ...
                      #t))
       (test-values "equal" name (expected ...) (var ...))))
    ;; compare
    ((_ "equal" name () ()) (values))
    ((_ "equal" name ((? pred) e* ...) (v1 v* ...))
     (begin
       (test-assert '(name pred) (pred v1))
       (test-values "equal" name (e* ...) (v* ...))))
    ((_ "equal" name ((or e ...) e* ...) (v1 v* ...))
     (begin
       (test-assert '(name (or e ...)) (member v1 '(e ...)))
       (test-values "equal" name (e* ...) (v* ...))))
    ((_ "equal" name (e e* ...) (v1 v* ...))
     (begin
       (test-equal '(name e) e v1)
       (test-values "equal" name (e* ...) (v* ...))))
    ((_ (expected ...) expr)
     (test-values expr (expected ...) expr))
    ((_ name (expected ...) expr)
     (test-values "tmp" name (expected ...) () () () expr))))
最初は6行のマクロだったのに、現状では30行までに膨れ上がった。多分そのうち、返ってくるレコードの中身を調べる必要がある、ということが発生するのでまだ大きくなる予感がしている。

結局何が言いたいのか?


複雑怪奇なマクロというのは時として秘伝のタレ的に継ぎ足し継ぎ足しで大きくなっていく場合があるということである。今回はテストケース用APIの薄いラッパーなので、都度変えていくという選択肢もあったのだが、既に公開されているマクロを後方互換性を保ったまま拡張する必要がある場合などいかんともしがたい場面もあるのではないだろうか?

特になにという結論は用意していないのだが、巨大なマクロを見たら「お前にも歴史があったかもしれないんだねぇ」という目で見てみるのも面白いかもしれない。

2015-05-11

R6RS小ネタ

最近ブログを書く際に、この程度のこととか、こんな文量だと読み応えがないとか、実際の問題に即した話題じゃないとというようなことが頭をよぎり自分自身のハードルを上げているような気がしたので、しょうもないことを書いて多少ハードルを下げようといういう試みを始めてみることにした。(純粋に時間がないというのもあるのだが。)

世間(少なくとも僕の観測範囲)ではR6RSはオワコン的な風潮が多少出ていてさびしい感じがするので、R6RS処理系製作者の一人(と名乗ってもいいよね?)としては多少なりとも流行らせる努力をしたいところ。(ひいては自分の処理系の宣・・・げふんげふん)

リハビリを兼ねているので今回は簡単な小ネタを一つ。R6RSにはトランスコーダという概念がある。これを使うと、例えばUTF-8のファイルをUTF-16に変換して書き出すということが可能になる。例えば以下のようにする:
#!r6rs
(import (rnrs))

(define (convert-port input file transcoder)
  (call-with-port (open-file-output-port file (file-options no-fail) 
                                         (buffer-mode block)
                                         transcoder)
    (lambda (out)
      (put-string out (get-string-all input)))))

(call-with-input-file "utf-8.txt"
  (lambda (in)
    (convert-port in "utf-16.txt" 
     (make-transcoder (utf-16-codec) (eol-style crlf)
                      (error-handling-mode raise)))))
R6RS的には書き出し時のBOMの有無は必須ではないので、実はこれはポータブルな処理ではない点を念頭にいれていただきたい。Sagittariusは0.6.4でBOMを出力するように変更した。(BOMを書き出さないことに依存したコードは書いてないはず)。ちなみに同様の処理であるstring->utf16はBOMを出さないことが既定されている。

R6RSの範疇ではUTF-8⇔UTF-16しかできないが、Sagittariusを使うとSJISとEUCも入れることができるので多少便利(宣伝)。