Reading a smart card with Sagittarius

If you are a lisp user (whichever your preference is), you would already know S-expression is the best way to write DSL. I have been writing a library which allows you to read (in future write) a smart card via winscard or PCSC (it's not tested, though). You can download it from here. It's still under development state so be aware the APIs or commands might be changed in future.

The simple use of this library is really simple, you only need to write a Scheme script and run it with load.scm contained in the library. Let me introduce a simple script.

(import (rnrs)
        (pcsc operations control) ;; for apdu-pretty-print
        (pcsc shell commands)
        (pcsc dictionary gp)
        (srfi :39))

(establish-context)
(card-connect)
;; transmit a select command without any parameter
(select)

(define key #xFFFFFFFFFFFFFFFFFFFFFF) ;; your key must be here
(channel :security *security-level-mac* 
         :option #x55
         :enc-key key
         :mac-key key
         :dek-key key)

(parameterize ((*tag-dictionary* *gp-dictionary*))
  (print "applications")
  (apdu-pretty-print (strip-return-code
                      (invoke-command get-status applications))))

(card-disconnect)
(release-context)

Looks really a Scheme code right? The commands are influenced by GPShell, so if you know it, it would be familiar for you. The result would be like this;

$ sash.exe -Lsrc -Lcontrib load.scm -f status.scm
applications
[Tag] E3: GlobalPlatform Registry related data
  [Tag] 4F: AID
    [Data] �0��: A0 00 00 00 30 80 00 00 00 04 A6 00 01
  [Tag] 9F70: Life Cycle State
    [Data] 07 01
  [Tag] C5: Privileges
    [Data] 00 00 00
  [Tag] EA: TS 102 226 specific template
    [Tag] 80
      [Data]
  [Tag] C4: Application's Executable Load File AID
    [Data] A0 00 00 00 30 80 00 00 00 04 A6 00
  [Tag] CC: Associated Security Domain AID
    [Data] A0 00 00 01 51 00 00 00

... so on if you've got any result

The Sagittarius version must be 0.4.2 (current HEAD version) otherwise apdu-pretty-print raises an error. The document is not really done yet. There are 2 ways to refer which command does what, 1 is looking up the code, the other one is starting the REPL and type (help 'command) like this;

$ sash.exe -Lsrc -Lcontrib start.scm
pcsc> (help 'select)
select :key aid

Sends select command.
;; If you evaluate (help), the it will show all defined commands.
pcsc> (help)
help [command]
Show help message.
When [command] option is given, show the help of given command.
Following commands are defined:
    card-connect
    card-disconnect
    card-readers
    card-status
    channel
    close-channel
    establish-context
    exit
    get-status
    help
    load-script
    release-context
    select
    send-apdu
    set-keys!
    trace-off
    trace-on

Note: even though it shows the help string, it is better to look up the code when you really want to understand for now. I will write the document later.

There are a lot of missing features such as DELETE commands or LOAD, INSTALL etc. I will add those eventually.

Again, it's still under development state, so your feedback and contribution are always welcome :-)

evalとdatum->syntax

packとunpackの実装をしていて、実行時にbytevector-**-native-ref/set!系の手続きを生成してごにょごにょしようかなぁと思ってこんなのが有効かちょっと試してみた。別にR6RSな処理系コンパチにする必要はないだけど、なんとなく。以下がちょっとしたテスト用スクリプト：

(import (except (rnrs) string-copy) (rnrs eval)
        (for (only (rnrs) bytevector-u16-native-ref) (meta -1))
        (only (srfi :13) string-index-right))

(define (->native sym)
  (define (finish sym) (datum->syntax #'->native sym))
  (let* ((s (symbol->string sym))
         (i (string-index-right s #\-)))
    (finish
     (string->symbol
      (string-append (substring s 0 i) "-native" 
                     (substring s i (string-length s)))))))

(display (eval `(,(->native 'bytevector-u16-ref) #vu8(1 0) 0)
               (environment)))
(newline)

動作確認はいつもの処理系、Chez、Mosh、NMosh、Racket、Ypsilon。Sagittariusはenvironment手続きにバグがあって、0.4.1までは0引数を受け付けなかった。HEADでは修正済み。後、ChezはSRFIが(恐らく)一切使えないので、実行する際は、string-index-right周りをごっそり削って、datum->syntaxの第二引数にbytevector-u8-native-refを直接渡すようにした。

以下は結果
予定通り動いた処理系：NMosh、Racket、Sagittarius
何かしらエラーな処理系：Chez、Mosh、Ypsilon

正直なところ上記のスクリプトがR6RS的にValidなのかすら自信がないのは確かなのだが、 psyntax的にはアウトみたいである。Ypsilonはなんでだろう？NMoshとRacketはフェーズを明に指定してやる必要がある処理系なのだが、それらではOKだった。関係があるかは謎(多分あるはず)。SagittariusがOKなのは分かっていたことなので省略。

この手ではコンパチにできないっぽいので、まぁやるならどうせその辺りの手続きは(rnrs)にあると割り切ってenvironment手続きに明に指定してやるというものになるだろう。

pack for Sagittarius

I have committed the pack library. The implementation is influenced Industria's (weinholt struct pack) library. The string format, procedure/macro names and idea for optimisation during macro expansion are taken from it. And I have added indefinite length argument format. But don't look at the code ;-)

The basic use is like this;

(import (binary pack))
;; pack makes bytetevector
;; Fixed length
(pack "4C" 1 2 3 4)  ;; => #vu8(1 2 3 4)
;; (pack "4C" 1 2)   ;; => &syntax

;; Indefinite length
(pack "*C" 1 2 3 4)  ;; => #vu8(1 2 3 4)
(pack "*C" 1 2)      ;; => #vu8(1 2)
;; It can only be allowed for the format position.
;; (pack "*C*S" 1 2) ;; => &syntax

;; pack! sets destructively
(let ((bv (make-bytevector 8)))
  (pack! "*C" bv 0 #xFF #xFF #xFF) ;; => #vu8(255 255 255 0 0 0 0 0)
  ;; the third argument is the offset
  (pack! "*S" bv 4 1 2)            ;; => #vu8(255 255 255 0 1 0 2 0)
  ;; #\x is padding, #\! put next data as big endian
  (pack! "6x!S" bv 0 3)            ;; => #vu8(0 0 0 0 0 0 0 3)
)

Both pack and pack! are macro however it can be passed to apply. (Thanks to R6RS).

I still need to make unpack though...

補助構文の挙動

バグの調査を兼ねていろいろな処理系の補助構文を調べている。といってもmosh、nmosh、Ypsilon、Chezの4種類だけだけど。とりあえず、以下のようなファイルを用意する。ライブラリの名前が変なのは気にしない。

;; named prob.scm or so.
(library (prob)
    (export printer this) ;; this line might be modified for testing
    (import (rnrs))
  (define-syntax this (syntax-rules ())) ;; here as well.
  (define-syntax printer
    (syntax-rules (this)
      ;;((_ bit x) (display (list 'this x))) ;; 間違ってた
      ((_ this x) (display (list 'this x)))
      ((_ x)     (display x))))

  (display 'loaded) (newline)
  )

次に、以下のようなスクリプトを用意する。

(import (prefix (rnrs) rnrs.) (prefix (prob) prob:))
(rnrs.define (print . args) (rnrs.for-each rnrs.display args) (rnrs.newline))
;; should this work?
(prob:printer this      123)
(prob:printer prob:this 456)

(rnrs.define-record-type (pare kons pare?)
  (rnrs.fields 
   (rnrs.mutable a kar set-kar!)
   (rnrs.mutable d kdr ser-kdr!)))
;; somehow nmosh doesn't allow me to call this. why?
(print (kons 1 2))

準備完了。とりあえず、この状態なら全ての処理系で動作する。(Ypsilon除く、多分HEADは動作する)。気になっているのは(prob)からexportされているthisは名前が変わっているはずだが全ての処理系で動く。いいのか？

次に、最初の(prob)ライブラリのexport句のthisをコメントアウトする。 やはり全ての処理系で動く。

さらにthisの定義をコメントアウトする。全ての処理系で動く。ということは、補助構文(というか、syntax-caseもしくはsyntax-rulesのリテラル)はその辺関係ないのかなぁ？と結論付けたいところだが、define-record-typeの中の(なんでもいいんだけど)、rnrs.mutableをmutableに変更するとmosh、Chezが怒る。意味不明である。psyntax組みか？nmoshはOKだった。

さて、どの挙動が正しいのだろうか？
指摘が入ってテストスクリプトを修正。上記のコメントは全部無効になりました。つまり、全処理系(除Sagittarius)予定通りに動く。

pack

Sagittarius currently doesn't have pack procedure (or macro). That's simply because I wrote specific procedures to handle binary packing each time. However it's better to have generic one.

Then I need to consider its interface. I was thinking something similar with Industrial's pack however I have re-read this tweet (it's in Japanese):

Sagittarius scheme には pack ないのか。 サイズが一定ならバイトベクタを確保して並べるのも手間っていう程ではないのだが、不定長になると一気に面倒くさくなるんだよなぁ。
— (32) 齊藤敦志さん (@SaitoAtsushi) 1月 22, 2013

Does it handle indefinte size?

I actually have 2 problems to implement: Firstly, I'm not good with pack stuff. Even when I was still using Perl, pack is only for hex to ascii or other way around (you can easily guess what is for :-) ). Secondly, if we support indefinate length, what would be the better solution?

The first thing, I just need to learn so it just takes fine time. The second one, I don't have much use cases so all what I can is guessing. There are, I think, 2 ways to implement indefinate length. One is like Perl way using some keyword inside of the format string (* or +?). The other one is providing a procedure to pre-compute the given data and generate format string. So it must be like this;

;; #\C is u8
(let ((fmt (generate-format-string #\C indefinite-bv)))
  (pack fmt indefinte-bv))
#|
Let's say indefinite-bv has 8 bytes then format string would be "CCCCCCCC".
Or if we use #\L as a bace character then format string would be "LL"
|#

The problem of this is that we can't optimise it in macro. So it always needs to be computed in runtime. I don't think this will be a big problem, though.

Ah, wait, format string can have indefinite marker if I check it macro expansion time. Hmm, which way is better?

デバッグしづらいバグ

(多分)マクロ周りの識別子問題なのだが、非常にデバッグしづらいバグの報告を受けた。とりあえず、考えうる限りもっとも小さいと思われる再現コードは以下

(import (rnrs))
(define-syntax foo
  (lambda (x)
    (syntax-case x ()
      ((_)
       (let ()
         ;; こいつが問題。syntax-rulesでも起きるけど
         ;; syntax-caseの方が通常はデバッグが楽なので
         (define-syntax prob
           (lambda (x)
             (syntax-case x ()
               ((_) #'ok))))
         #t)))))

要するにsyntax-caseのテンプレート部分で局所的マクロを定義すると&compileが投げられるという不具合。

エラーのメッセージは局所変数.varが参照されているけど、その定義がIForm上で見つからないというもの。 .varはマクロ展開器がパターン変数等を参照するために自動でつけられるものなのだが、この場合だとfooとprobの両方が持っている。

何がこの不具合をデバッグしづらくしているかというと、(デバッガがないというのは置いておいて)probがコンパイル時にコンパイルされるのでどんな感じの中間コードになっているかというのが出力できないこと。コンパイラはいくつかのステップを踏んでVMコードを出力するのだが、このパターンはどのステップで不具合が入るのかとか、なんで入るのかというのを全て推測するしかないのが辛い。

なんとなく推測としてある不具合の原因としては、prob側で参照されている.varがfoo側で定義されたものになってるんだろうなぁ、くらいのものである。(恐らく正しいはず)

さて、なんでこんなことが起きるんだ？

なんとなく分かってきた(昨日の続き)

いろいろ動作確認をChezでしているうちになんとなくどうあるべきかが分かってきた。

基本的にはマクロが定義されたライブラリ内にあるシンボルはそこで、展開時のライブラリにあるシンボルはそこでという感じで定義時のコンテキストを使って識別子を変換すればいいような気がする。

問題になるのは、シンボル自体はなんの情報も持たないのでそのシンボルが実際にどこで出現したかを確認する術がないことだろう。Sagittariusではマクロ展開時にsyntax構文の展開が行われるのでどちらの場合も補足している環境的には同じものに見えるのだ。

こうなってくると展開時ではなく、syntax構文のコンパイル時にシンボルから識別子に変換してしまった方がいいような気がする。そうすれば、少なくとも補足時には識別子になっているので、このような混乱が起きることもない。ちょっとこの方法を試してみるか。

マクロがスコープを壊していた

まぁ、マクロ周りは完全とは言いがたいと分かってはいたのだがこうも立て続けに不具合が出てくるとは・・・

Google code上でIssueを発行したのだけど、まぁ前回のマクロの不具合とばっちり関連している、というかそれの延長線上である。

Vicareの中の人が報告してくれたIssue 84と今発行したIssue 85はちょうど真逆の動作をするのだけど、原因する場所及びその原因は全く一緒。どちらもシンボルから識別子へ変換する部分の処理が正しいライブラリを見つけることができていないのが問題になっている。怪しいなぁとは思っていたのだけどこんなにも怪しかったとは思っていなかった。完全にその部分の理解が間違っていたということになる。

どうあるべきなのか？
問題はこれである。今のところ考えがまとまっていないので、どうあるべきかすらわかっていない。一番大元で(たぶん正しく)理解しているのは、基本的に字面上参照できないものは参照できない、ということ。その逆もしかり。84の方は後者になり、85の方は前者になる。ここで、字面上というのは、コードから読み取れる情報上という意味。(蛇足)
この大元だけが分かっていても、いくつかの要因が複雑に絡み合うと全く分からなくなる。だれだよ、こんな複雑な仕組み作ったの！正直な話、あまり複雑に考えなくてもいいはずなのだ。

ふと、後者の問題はVMをいじれば解決できることに気づいた。マクロ展開の問題なんだけど、解決をランタイム(しかもVMレベル)まで遅らせれば解決できる。ただ、これは本質的な解決じゃないので、どこかで破綻する気がしているのと、本質的な解決じゃないのはあまり入れたくない。

あぁ、待てよ、マクロ展開時とマクロ補足時の環境は取れてるんだからVMレベルまで遅らせる必要はなく分かってるよな？となると、問題となるのはIssue 25のパターンを無理やり何とかしようとしているところか。具体的には以下ようなコード：

(library (foo)
  (export bar)
  (import (rnrs))

  (define (problem) (display 'ok) (newline))

  (define-syntax bar
    (lambda (x)
      (define (dummy)
        `(,(datum->syntax #'bar 'problem)))
      (syntax-case x ()
        ((k) (dummy)))))
  )

(import (rnrs) (foo))
(bar)

barがへんてこな風に解決しないと&assertionを投げるのだけど、これ何とかならないかな？ちょっと考えよう。

Sagittarius 0.4.1リリース

Sagittarius Scheme 0.4.1がリリースされました。今回のリリースはメンテナンスリリースです。ダウンロード

修正された不具合

• 同名の内部defineが存在した場合にASSERTで落ちる不具合が修正されました
• sqrt手続きにBignumを渡すとASSERTで落ちる不具合が修正されました
•  bitwise-bit-count及びfxbit-countに0を渡すと不正な値を返す不具合が修正されました

改善点

• ODBCライブラリを探すプロセスがiODBCにも対応するようになりました(Linux)
• SRFI42がR6RSモードでも動くように改善されました

新たに追加された機能

• pointer->bytevector手続きが(sagittarius ffi)に追加されました
• import、library及びdefine-libraryのみがデフォルトで使用可能になる起動オプション-tが追加されました

新たに追加されたライブラリ

• TLVデータライブラリ(tlv)が追加されました

winscardを使ってみる

仕事柄最近UICC(SIM)を扱うことが多い。まぁ、基本的には中にインストールされているアプリケーションを覗いたり、APDUを実行したりするだけではあるのだが。

こういった作業をするツールとしてGPShellというものがあるのだが、いかんせんドキュメントが少ない上に今一使い勝手が悪い。内製のツールもあるのだがドキュメントが無いためAPDUのショートカットコマンドがよく分からない。

ということで、簡単に作れそうなら作ってしまおうかなぁと思いちょっと実験してみた。まぁ、FFIの実験ということでもあるのだが。とりあえずインストールされているカードリーダの一覧を取得するところから始めてみた。以下がコード。

#!read-macro=sagittarius/regex
(import (rnrs) (sagittarius ffi) (sagittarius control) (sagittarius regex)
        (srfi :13))

(define win-scard-library (open-shared-library "winscard.dll"))
(define-syntax define-c-function
  (lambda (x)
    (define (scheme-name->c-name name suffix)
      (let1 items (string-split (symbol->string name) #/-/)
        (string->symbol
         (string-append
          (string-concatenate (map (^s (string-titlecase s)) items))
          suffix))))
    (syntax-case x ()
      ((_ ret-value name arguments ...)
       (symbol? (syntax->datum #'ret-value))
       #'(define-c-function "" ret-value name arguments ...))
      ((_ suffix ret-value name arguments ...)
       (and (symbol? (syntax->datum #'name))
            (symbol? (syntax->datum #'ret-value))
            (string? (syntax->datum #'suffix)))
       (with-syntax ((c-name (scheme-name->c-name (syntax->datum #'name)
                                                  (syntax->datum #'suffix))))
         #'(define name (c-function win-scard-library ret-value c-name
                                    (arguments ...))))))))

(define-c-typedef void* SCARDCONTEXT)

(define-c-function long s-card-establish-context short void* void* void*)
(define-c-function long s-card-release-context SCARDCONTEXT)

(define-c-function "A" long s-card-list-readers SCARDCONTEXT char* char* void*)
(define-c-function long s-card-free-memory SCARDCONTEXT char*)

(let* ((hSC (empty-pointer))
       (r   (s-card-establish-context 0 null-pointer null-pointer hSC))
       (readers (empty-pointer))
       (cch (integer->pointer -1)))
  (s-card-list-readers hSC "" (address readers) (address cch))
  (for-each print (string-split (utf8->string (pointer->bytevector 
                                               readers 
                                               (pointer->integer cch)))
                                #/\x00/))
  (s-card-free-memory hSC readers)
  (s-card-release-context hSC)
)

pointer->bytevectorは割りと汎用的かなと思い追加(0.4.1から使用可能)。とりあえずこれを実行するとなんとなく登録されているカードリーダが列挙される。ある程度満足のいくものになったら別モジュールとしてGitHubに登録するかもしれない。

マクロ(戦争)は続くよどこまでも

Vicareの中の人からバグ報告があって、まぁマクロ周りだろうということまで判明していた。っで、実際に問題が起きるコードを見てみると、「あぁ、やっぱりこのコードはバグを含んでいたか」というまさにドンピシャの部分のバグであった。実際のコード(Sagittariusのマクロ展開器側)に多分これはおかしくてバグの匂いがするってコメントまで書いてある。学習した自分を見ている感じだ(以前はこんなの残さなかった)。

件のコード片は以下の感じ。

(define expand-syntax
  (lambda (vars template ranks p1env)
    ...
    ;; wrap the given symbol with current usage env frame.
    (define (wrap-symbol sym)
      (define (finish new) (add-to-transformer-env! sym new))
      ;; To handle this case we need to check with p1env
      ;; other wise mac-env is still the same as use-env
      ;; (define-syntax foo
      ;;  (let ()
      ;;    (define bar #'bzz)
      ;;    ...
      ;;    ))
      (let* ((mac-lib (vector-ref p1env 0))
             (use-lib (vector-ref use-env 0))
             (g (find-binding mac-lib sym #f))
             ;; if the symbol is binded locally it must not be
             ;; wrapped with macro environment.
             (lv (p1env-lookup use-env sym LEXICAL)))
        ;; Issue 25.
        ;; if the binding found in macro env, then it must be wrap with
        ;; macro env.
        ;; FIXME: it seems working but I smell something wrong with
        ;;        this solution. The point of the issue was inside
        ;;        of the macro it refers to the macro itself but the
        ;;        expansion did not occure until it really called.
        ;;        that causes library difference even though it's in
        ;;        the macro defined library.
        (if (and (identifier? lv)
                 (not (eq? mac-lib use-lib))
                 g (eq? (gloc-library g) mac-lib))
            (let ((t (make-identifier sym '() mac-lib)))
              (finish (make-identifier t (vector-ref mac-env 1) mac-lib)))
            (let ((t (make-identifier sym '() use-lib)))
              (finish (make-identifier t (vector-ref use-env 1) use-lib))))))
    ...
  ))

まぁ、見事にFIXMEなんて書いてある部分がそれにあたる。問題になったコードは以下で見える。
https://github.com/marcomaggi/r6rs-sofa/blob/master/lib/sofa/compat.sagittarius.sls
同様にFIXMEと書いてある部分が問題になる。多分、問題は2つあって、c-functionが何かしらおかしなことになっているのと、define-c-functionの展開系からはffi.int等が見えなくなる問題である。

後者の問題がコメントに書いてある部分の不具合に当たる(はず)。出力されるエラーを見ると、ffi.intがuserライブラリの識別子となっているが、これは誤りで、正しくは(sofa compat)にならなければならない。上記のコード片はその辺りの変換を行っているのである。

なぜ起きるか？
もちろん書いてあるコードがおかしいので起きるのだが、シンボルから識別子に変換する際のマクロ展開時とマクロ捕捉時の環境の選別がうまく出来ていないことに起因している。上記のコードではどうも厳しすぎるみたいである。

とりあえず、現在の識別子変換の考え方を整理する。
マクロ展開時に生のシンボルが表れた際、識別子へと変換する。その際に使われる環境の選別は以下のように行われる。

• シンボルはマクロ捕捉時環境で束縛されている
• シンボルはマクロ展開時環境で未束縛である
• マクロ捕捉時とマクロ展開時ではライブラリが異なる
• 束縛されているシンボルはマクロが捕捉されたライブラリで束縛されている

上記全てを満たした場合のみマクロ捕捉時環境を使って識別子へと変換される。今回問題になっているのは最後の項目である。ただ、このチェックを外すと全く動かなくなる。

ちょっと難航しそうな感があるので、0.4.2以降で直すことにする。

2013年始動

あけましておめでとうございます(遅

日本にいた3週間はブログ、コードともにほとんど何もしないという快挙(？)を達成したのでそろそろ始動しないと鈍るなぁと思い開始します。

About Sagittarius
直近は今週か、来週末当たりに0.4.1をリリースする予定。前回のEnbug修正とTLVライブラリの追加しかないです。(微妙に起動オプションが足されてたりするけど)
R6RS、R7RSともにかなり準拠度が上がったのと、仕事で使う範囲だと結構カバーされているので開発状況が多少倦怠期的なものに入ったかなぁとも思っているので、(もしあれば)要望などを受付中です。(使ってくれている人いるのかなぁ・・・)
MoshがAndroidで動くなんてのを見てちょっと触発されつつあるので、(現在仕事で使っている)BlackBerryで動くようにするなんてのを目指すかもしれません(超未定)。
なんにしろ、今年は緩やかに進行するような気がしてます。月一でリリースするつもりでは一応いるけど・・・

その他
鋭意転職活動中です、興味があれば連絡ください。勤務地がオランダかイギリスあたりだとフットワーク軽めです。
6月にスペインでELSがあるらしいけど、行こうか迷い中。

今年こそ腹筋を6つに割りたい。
ギターの練習をもう少し頻度を上げる。

2012年を振り返って

今年はなんだかいろいろ激変した感じがある年ではあるが、プライベートなことを振り返ると気分がへこむのでとりあえずはSagittarius周りのことだけで。

【達成したこと】

• R6RSマクロ展開器が標準により準拠した
• R7RS対応がほぼ終わった
• 月1リリースの継続

あまり目標を立ててないので、自分の中で達成したというのはないなぁ。自分がほしい機能をいっぱい詰め込んだ「俺々処理系」度がえらく進んだ感があるが(リーダの置き換えとか)。


【来年やりたいこと】

• ドキュメント
• ライブラリの充実
• 使い勝手が悪い(と個人的に思っている)部分の改善

ドキュメントは書いてないというのもあるのだが、1個の巨大なファイルになっているのが気になってきたのでその辺も直したい。
ライブラリは仕事で使う分でも足りないなぁと思う部分が出てきたので(主にバイナリいじるようなの)その辺を充実させていきたい。industriaのpackみたいなのがあると汎用的に使えるか？
使い勝手は、僕個人の感想なのだが、使い捨てのスクリプトを書く際にいちいちimportを書くのがさすがに面倒だなぁと思ってきたので、その辺を何とかしたい。
処理系本体に大きな変更を加える気は今のところないのだが、0.5.0か0.6.0あたりでビルド時のオプションで自前のGCを選択できるようにしたいと思っている。ただ、そこまで個人的にやれるかというのはかなり疑問なのであくまで「やりたい」程度ではあるが。

基本的に「必要ドリブン」(泥縄とも言う)開発スタイルなので、来年やりたいことというのは、現状で改善したいことでしかなく、下手をすれば1月中に終わるというものだったりもするのだが。

何はともあれ、来年もよろしくお願いいたします。

TLVパーサがほしい

最近仕事でAPDUをいじる必要があるのだが(正確には眺めてるだけなんだけど・・・)、中に入ってるデータとかSIMが返すデータとかがTLV形式であることが多い。っで、TLV自体は別に何か特別な仕様というわけでもないのでこのパーサがあってもいいかなぁと思っていたりする。

問題は、現在既にあるASN.1パーサは基本的にはTLVパーサの上にASN.1のオブジェクトを被せるという形になっている点だろう。TLVだけに特化したのを別に作るのは馬鹿らしいのでこれを分離する方向にしたい。ということでちょっと実装方針を考えることにする。

現状のASN.1パーサはDERとBERに特化した形になっているので不定長のバイト列を処理することができるのだが、TLV形式だけならこれは不要になる。っが、これを外すことは当然だができない。また、DER、BERだとタグ部分が1バイトを超えることがあるが、他の形式だとたいてい1バイトである。(この辺ちょっと自信ない。現状の実装が一般的な気もする。)

となると、タグを読む、長さを読む、値を読む手続きとそれらから得られたデータから最終的なオブジェクトを構築する手続きを渡して、TLVパーサを作るような形にするといいだろうか？ でも、そこまでやるなら分離する必要ないよな？オブジェクトの構築だけを外出しにすると、今度は不定長データの処理に困るし、どうしようかな。

Enbug

かなり大きめなバグを0.4.0で埋め込んだみたいである。問題になるのは以下のコード。

(define (foo)
  (define (bar n) (print n))
  (bar 1)
  (let ()
    (define (bar n) (print 'hoge))
    (bar 1)))

何の変哲もないコードだが、0.4.0では「CレベルのASSERTで落ちる」という脅威の振る舞いをしてくれる。

マクロ直しの一環でのEnbugなのだが、正直全く気づかなかった。久しぶりにベンチマークでも取るかとGambitベンチマークを走らせてはじめて発覚。この問題の面白い(いやな)ところは、実行されたインストラクションから見ると問題の箇所はラムダリフティングに見えた点。実はそこではなく、barが2箇所で使われている点にある。

なぜこんなバグを混入することになったかといえば、R6RS及びR7RSではdefine-syntaxが内部defineと同様に書けることに起因する。たとえば以下のコード。

(let ()
  (define even?
    (lambda (x)
      (or (= x 0) (odd? (- x 1)))))
  (define-syntax odd?
    (syntax-rules ()
      ((odd?  x) (not (even? x)))))
  (even? 10))

こんなコードがあった際に、コンパイラはまずマクロのコンパイルをする。その後、内部defineのコンパイルをする。っが、実は一箇所大きめの落とし穴があって、どちらのコンパイルの際でも内部defineの名前を局所変数として登録する。つまり2重登録が発生する。っで、これの解決の方法がまずかった。

2重で登録されているのなら、2つ目に来るものは無視すればいいのだろうと安易に考えたのだが、そのをしたら最初のコードが動かなくなった。ある意味当たり前である。同名がくることは一切考えていなかったのだから。

リリース直後に気づいた不具合の致命的度としては最大級な気がする・・・orz

Sagittarius 0.4.0リリース

Sagittarius Scheme 0.4.0がリリースされました。ダウンロード。
今回のリリースはマイナーバージョンアップリリースです。大きな変更点は以下、

• R6RS準拠度(マクロ周り)の改善
• R7RS small (draft 8)の要求仕様への準拠

修正された不具合

• datum->syntaxが与えられたテンプレート識別子を解決しない不具合が修正されました。
• 深くネストしたリストを出力するとSEGVを起こしていた不具合が修正されました。
• import句でのforキーワードが無視されていた不具合が修正されました。
• ただし、run、expandなどのフェーズ指定句は従来どおり無視されます。
• let-syntax及びletrec-syntaxがR6RSモードでスコープを作っていた不具合が修正されました。
• カスタムコーデックがtranscoded-portで使用できない不具合が修正されました。
• path-map及びpath-for-eachに:all #fを渡した際に処理が終わらない不具合が修正されました。
• bytevector-u64-set!及びbytevector-s64-set!が値を正しくセットしない不具合が修正されました。
• port-eof?がカスタムポートに対して使用できない不具合が修正されました。
• random-integerが与えられたサイズと同じ値を返すことがある不具合が修正されました。
• (eqv? 0.0+0.0i 0.0-0.0i)が#tを返す不具合が修正されました。

改善点

• マクロのR6RS準拠度が大幅に改善されました。
• リーダマクロがファイル単位からポート単位に変更になりました。
• 4096文字を超える文字列の読み取りが可能になりました。
• Debian Linuxがサポートされました。

新たに追加されたライブラリ

• SRFI-25及びSRFI-78が追加されました。
• ただしSRFI-78はcheck-ecがR6RSモードでは動きません。

パターン変数

リリース直前にバグに気づいた。もちろんマクロ周り・・・
問題となるのは以下のようなコード。

(define-syntax loop
  (lambda (x)
    (syntax-case x ()
      [(k e ...)
       (with-syntax
           ([?break (datum->syntax #'k 'break)])
         #'(call-with-current-continuation
            (lambda (?break)
              (let f () e ... (f)))))])))
(let ((n 3) (ls '()))
  (loop
   (if (= n 0) (break ls))
   (set! ls (cons 'a ls))
   (set! n (- n 1))))

R6RSテストスイーツでは?breakの部分はbreakになっている。これがすごく長い間誤解を招いていた。何が問題かといえばコードではなく、(もちろん)実装の方で、現状の実装ではマクロ展開後の式をもう一回総舐めするのだが、その際に上記のbreakを正しいものに置き換える処理をしている。ただ、その際にパターン変数の中身ではなく、パターン変数そのものを見て置き換えるので上記のコードだと?breakが対象になる。

もちろん、よく考えればそれはおかしいと気づくのだが、なぜかずっと現状の実装が正しいと思い込んでいた。っで、R6RSへの準拠度を高めようとマクロの書き直しを終えた後に、いろいろなマクロを試していて気づいたと・・・orz

気づいたからには直さないと気が済まないので現在修正中なのだが、ほぼ全てのテストは通るのに、SRFI-86のテスト1個だけが通らない。他のテストは勘所などが分かったのだが、こいつは長巨大マクロライブラリなので全く分からん。まず間違いなく誤参照をしているのだけど、どこがそれを引き起こしているのかが分からない。

リリースを引き伸ばすか、こいつは次のリリースで直すか悩むところである。R7RSのドラフト8対応と称して出してしまおうか・・・(悪魔の囁き

R7RS 8thドラフト斜め読み

7thドラフトから1ヶ月しか経っていないのにもう8thが出るとは。ちょっと油断していた。

今回のドラフトは7thのtypoと非正確数のeqv?あたりぐらいだろうと思っているので軽く斜め読み。Chibi-Schemeもこれにあわせてか、0.6.1とバグフィックス版を出してきている。

前回からの変更点

• (eqv? 0.0 -0.0)が処理系が負の0.0を識別するなら#fと明示された
• read-bytevector!の引数順が変更になり、それに伴ってオプショナル引数が4つに増えた

これくらいしか見つけられなかった。さすがに斜め読みすぎたか。eqv?の変更はメーリングリストでかなり険悪な状態までいっていたりしてどう落ち着くのか不安ではあったが、R6RSとの整合性が保たれていたのでちょっと安心。でも、未だに(eqv? 0.0 -0.0)が#fでなければならないプログラムを見たことないが、atanとかバリバリ使う人だと問題になるんだろうか？

やべ、こんなに変更点がないとは思っていなかった。書くことがないw

とりあえず、宣伝。
0.3.8でドラフト7に対応したんだけど、Chibiのテストが結構こけてたりしてたんだけど、次のリリースでは全て問題なく通る。それにプラスして、Chibiでは(たぶん、まだ)サポートされていないinclude-library-declarationsもサポートされているので、現状ではR7RS Smallをフルサポートしている処理系ということになる。今週末リリースする予定(あくまで予定)。

Rewrote case-lambda

Sometimes it's good to review what I've done so far. Yes, I've found something not efficient and it can be more efficient. This time it was case-lambda.

The original was SRFI-19 and since R6RS it's a standard macro (or syntax) for Scheme. However neither of implementations is efficient. At least it can be written better in R6RS. The problem of the reference implementation is it creates closures per lambda formals and apply it with given arguments. If the implementation is smart enough, the apply could be inlined however Sagittarius is not so smart (unfortunately).

If the implementation is not smart enough, then programmers need to be smart to let compiler emit efficient codes. So I rewrote it. This is what I think at least better than the references.

;; this is almost only R6RS except reverse!
(define-syntax case-lambda-aux
  (lambda (x)
    (define (construct args formals clause*)
      (define _car #'car)
      (define _cdr #'cdr)
      (define (parse-formals formal args inits)
        (syntax-case formal ()
          (() (reverse! inits))
          ((a . d)
           (with-syntax ((arg `(,_car ,args))
                         (args `(,_cdr ,args)))
             (parse-formals #'d #'args
                            (cons (list #'a #'arg) inits))))
          (v
           (reverse! (cons (list #'v args) inits)))))
      (with-syntax ((((var init) ...) (parse-formals formals args'()))
                    ((clause ...) clause*))
        #'(let ((var init) ...) clause ...)))
    (syntax-case x ()
      ((_ args n)
       #'(assertion-violation #f "unexpected number of arguments" args))
      ((_ args n ((x ...) b ...) more ...)
       (with-syntax ((let-clause (construct #'args #'(x ...) #'(b ...)))
                     (expect-length (length #'(x ...))))
         #'(if (= n expect-length)
               let-clause
               (case-lambda-aux args n more ...))))
      ((_ args n ((x1 x2 ... . r) b ...) more ...)
       (with-syntax ((let-clause (construct #'args #'(x1 x2 ... . r) 
                                            #'(b ...)))
                     (expect-length (length #'(x1 x2 ...))))
         #'(if (>= n expect-length)
               let-clause
               (case-lambda-aux args n more ...))))
      ((_ args n (r b ...) more ...)
       #'(let ((r args)) b ...)))))

(define-syntax case-lambda
  (syntax-rules ()
    ((_ (fmls b1 b2 ...))
     (lambda fmls b1 b2 ...))
    ((_ (fmls b1 b2 ...) ...)
     (lambda args
       (let ((n (length args)))
         (case-lambda-aux args n (fmls b1 b2 ...) ...))))))

The trick is really simple. Just let macro compute the given arguments. Even length is called only once.

With this code, at least on Sagittarius, the compiler emits better code than references (there is no extra closure created).

最後の砦

マクロの書き換えを始めて1週間(以上か？)、大詰めまで来ている気がする。美しくなかった機能をばっさりと切り捨て、マクロ展開器は(個人的に)かなりシンプルになったと思う。既存のテストが全て通るようになり、いよいよ本丸のindustriaを走らせて見たら、以前と同じエラーで落ちる。これは何かを見落としているなと思い、落ちている原因のdo/unrollマクロを眺めることにした。

正直、中で何をしているのか理解するのに時間がかかるくらいでかく複雑(に僕には見える)マクロだが、本質的な原因は以下のマクロが動かないことにあることが分かった。

(import (rnrs))
(define-syntax expand-it
  (lambda (x)
    (define (gen-return var) (with-syntax ((v var)) #'v))
    (syntax-case x ()
      ((_ (v init) expr ...)
       (with-syntax ((r (gen-return #'v)))
         #'(let ((v init))
             (when (= v r)
               expr ...)))))))

(expand-it (v 1) (display 'ok) (newline)) 

Chezで試したが当然動く。正直、何がいけないのかすでに分かっていて、以前あったパターン変数の問題の展開された識別子版である。
入力として与えられてvが二箇所のsyntaxで展開されているためにそれぞれ別の識別子として出力されるのが問題なのである。

それこそ、マクロ展開器との格闘を始めて結構長いと思うが、このパターンは完全に見落としていた。こんなマクロ書いたことないし、見たこともないからである。パターン変数の問題はいくらか書いたし、見たことがあったので何が原因かも分かっていたのだが、これは思いもよらなかった。なんというか、目の前に大穴が空いているのに全く気づかなかった気分である。

パターン変数の際と同様の方法で解決するとするか。

しかし、この1週間でマクロ展開の実装は所詮環境の参照と識別子のリネームだけなんだと痛感させられた。ただ、それが異様に面倒なだけで・・・