未束縛エクスポートのチェック

R6RS及びR7RSではexport句に未束縛なシンボルを書くとエラーになるとある。しかし、Sagittariusでは実装上の手抜きでチェックをしていない(やれば実はできるんだけど、コンパイル時間の増大を防ぎたいとか、メモリ使用率を減らしたいとか、まぁいろいろ言い訳をつけてやってない)。

っで、近頃（昨日）R7RSのドラフト7が出て、結構な数の手続きが追加または削除になったのがあり、実際に手続き及びマクロが定義されているかのチェックを目視とかテストケース書いてたらやってられないなぁと思ったのでこんなスクリプトを書いた。

(import (rnrs) (util file)
        (sagittarius vm) (match)
        (srfi :26) (srfi :64))
;; この部分を適当に変える。
;; R7RSだけ調べたいなら"./sitelib/scheme/*"とか
(define files (glob "./lib/**/*"))

(test-begin "bound check")
(define (check-exports file)
  (define (do-check name exports)
    (guard (e (#t 
               (when (message-condition? e)
                 (print (condition-message e)))
               (print "failed to find library: " name)))
      (let ((lib (find-library name #f)))
        (define (check orig export)
          (unless (keyword? export)
            (test-assert (format "~a:~a" name orig)
                         (let ((gloc (find-binding lib export #f)))
                           (and gloc (gloc-bound? gloc))))))
        (for-each
         (lambda (export)
           (match export
             (('rename renames ...)
              (for-each (lambda (rename)
                          (check rename (car rename))) renames))
             (_ (check export export))))
         exports))))
  (guard (e (#t (print "failed to read: " file)))
    (when (file-regular? file)
      (let ((expr (file->sexp-list file)))
        (match expr
          ((('library name ('export exports ...) rest ...))
           (do-check name exports))
          (_ #f)))
      )))
  

(for-each (cut check-exports <>) files)

(test-end)

やっていることは至極単純で、見つけたファイルを読み取って、中からlibraryで始まるS式見つけて、ライブラリ見つけて、exportしているものが存在するか調べる。それだけ。
なぜか、||なシンボルを読まなかったり、キーワードをキーワードとして読み取らなかったりと、変な挙動があるけど、それなりに便利。 既存のライブラリで未束縛なエクスポートを含んでいたのものさえ発見できたし・・・orz

R7RSの7thドラフト

ようやく出た。正直、出る出る詐欺じゃないかと心配していたｗ

Ballotの結果なんかは追っているので、もしR7RSで検索してたどり着いたのであればそちらを見ていただきたい。

• 時の羅針盤＠blog - R7RS 7th mini ballot result
• 時の羅針盤＠blog - R7RSの6th Ballot

Sagittariusは6thドラフトに追従していないので5thドラフトから変更となるが、まぁ問題はないだろう。7thドラフトは個人的に割りとインパクトが大きくて、ライブラリの修正だけではなく、コンパイラもいじらないといけない。以下に自分用のメモも兼ねて修正ポイントを記載する。

【コンパイラ】

include-library-declarations

define-library構文に追加になった。include先のライブラリのexport句のみを対象に持ってくる。単なる便利構文。正直、いるかこれ？と思っている。

【ライブラリ】

(scheme base)

いろいろな手続きが削除、移動になった。

(scheme cxr)

cxxr以上の手続きが(scheme base)から取り除かれてこっちに移動。

(scheme char normalization)

Unicodeサポートが必須じゃなくなったので削除。

(scheme division)

たしか6thドラフトの段階で消えてた気がする。

(scheme r5rs)

R5RSコンパチライブラリ。（7thからだったかな？記憶あいまい）

(scheme lazy)

delay-forceが追加になった。

ライブラリの修正は、面倒なだけで特にインパクトは小さいんだけど、コンパイラは面倒だ。まぁ、そこまで面倒でもないんだけど。include-library-declarationsは個人的に非常に醜いと思うのでできれば入れたくないが、たぶんファイルに残るだろうなぁ。

【文字と文字列】
勘違いしていたことと、やはり納得がいかないので一応。
7thドラフトで文字列がサポートしなければならない範囲が明確に定義された。処理系は最低でも「NULLを除いたASCII文字の文字列」のサポートしなければならない。 まぁ、ここまではいいだろう。ただ、「文字列を文字の集合」として捉えた際に現状のドラフトでは不整合がでる。なぜか？問題はこの一文；

All Scheme implementations must support at least the ASCII character repertoire: that is, Unicode characters U+0000 through U+007F.

 7thドラフトでは明確に文字がサポートしなければならない範囲にNULLが含まれているが、文字列ではNULLを省いていいよって言ってるのだ。まぁ、文字列 != 文字の集合なら何の問題もないけど。R7RSに明確に文字列は文字の並び（sequenceってどう訳すの？）と書いてあるね。

curly-infix (SRFI-105)

I have merged my SRFI-105 implementation on Github to Sagittarius itself. So it can be used from version 0.3.8.
I haven't follow all the discussions nor read all specification (WTF?!), so I'm not sure if the following code is too much #\{ and #\} or it's supposed to be like this;

;; Sagittarius need this line
#!read-macro=curly-infix
;; For portability with other implementations.
#!curly-infix

(import (rnrs))

(define (fact n)
  (if {n = 0}
      1
      ;; Here, it seems too much. If I could write
      ;; fact(n - 1), it seems way better. But my
      ;; implementation (mostly taken from reference
      ;; implementation) doesn't allow me.
      {n * fact({n - 1})}))

{print fact(5)} ;; -> 120

As far as I understood, inside of #\( must be treated the same as usual Scheme way. So if I want to pass calculated argument(s) with infix style, then I need to wrap with extra pair of #\{ and #\}. If I'm not understanding correctly, please let me know :-)

Some part such as {n = 0} might be easier to understand for people who are not so familier with polish notation. However for people who already wrote a lot of Lisp programme, this might make them confused (or maybe not?).

Anyway, providing choices to users is a good thing, I believe.

SQLiteをODBCで使う

せっかくODBCをサポートしてるんだし（WindowsとCygwinだけだが）、SQLiteでも使ってみるかと思いちょっといじってみた。目的としてはdbi-preparedでバイトベクタとポートを受け付けるようにしたかっただけなのだが・・・

結論を言うと、SQLiteでは（というか、SQLite ODBC Driverでは）BLOBを扱うのが無理。正確には巨大なBLOBを扱うのが不可能くさい。

なぜか？SQLGetDataがここに書かれている動作をしない。（おそらく）呼び出すたびに先頭からデータを取ってくる。もしくは、一度の呼び出しで全部取得できてしまったら二度目の呼び出しでまた全部データを取ってくるため。なので、以下のコードが無限ループに陥った。

(import (rnrs) (dbi))

(define conn (dbi-connect "dbi:odbc:server=SG"))
(define sql "insert into test (id, data) values (?, ?)")

(let ((query (dbi-prepare conn sql 1 "ok")))
  (dbi-execute! query))
(define sql "select * from test")
(let ((query (dbi-prepare conn sql)))
  (print (dbi-execute! query))
  (print (dbi-columns query))
  (let loop ((col (dbi-fetch! query)))
    (when col
      (vector-for-each (lambda (v)
                         (if (binary-port? v)
                             (let loop ((bv (get-bytevector-n v 20)))
                               (unless (eof-object? bv)
                                  (print bv)
                                  (loop (get-bytevector-n v 20))))
                             (display v))) col)
      (newline)
      (loop (dbi-fetch! query)))))
(dbi-close conn)

dataカラムはblobになっている。問題になった、get-bytevector-nの部分。ポートになっているが、中身はSQLGetDataを呼び出して必要なだけ取り出すというもの。ただ、ポートの部分は普通のファイルと共通になっているので（昨日そうした）、まずバッファに溜め込もうとする。問題は、SQLGetDataが常に先頭からデータを読み出すので、EOFが返ることがないこと。

これが、get-bytevector-allだと予定通りに動くのだが、今度はデータが空のblobが半端なくでかいサイズを要求するのでメモリが足りないといわれる。データ空なのに・・・

SQLiteを仕事で使うことはないので、割とどうでもいいのではあるが、解決するため（結局できなかった）に２時間は無駄にしたのでせっかくだしと思い書いた。

should of and whilst

最近イングランド在住のJKとチャットをしている。普通ならありえるはずもないことなので、ネットとは恐ろしいものだ。

それはさておき、会話の中で結構見慣れない単語、表現が出てきたりする。さすがはネイティブ、いろんな表現を知っているなぁと思い勉強させてもらっている。その中で出てきたので、「should of」というのかあった。こんな感じで使われている。

I should of been there.

こんなのがあったかは覚えがないが、要するにhaveの代わりにofを使っているのだ。方言かな？と思いググッて見た。(Google便利だよGoogle)
っで、最初に得られた結果が以下

This is one of those errors typically made by a person more familiar with the spoken than the written form of English. A sentence like “I would have gone if anyone had given me free tickets” is normally spoken in a slurred way so that the two words “would have” are not distinctly separated, but blended together into what is properly rendered “would’ve.” Seeing that “V” tips you off right away that “would’ve” is a contraction of “would have.” But many people hear “would of” and that’s how they write it. Wrong.
COULD OF, SHOULD OF, WOULD OF より

単なる間違いらしい。日本語の「ら」抜き言葉とか「全然～ない」みたいなものか(多少違うか)。口語表現をそのまま文語(まで堅苦しくはないか)に持ってきたもののようだ。

ついでに、よく見る単語で「whilst」というのがある。こんな感じで使われていた。

Whilst I'm lying on the sofa.

意味は「while」だと推測可能ではあるのだが、なんだこれ？ということでGoogle先生に尋ねる。っで以下がヒット。

Both while and whilst are ancient, though while is older. There’s no difference in meaning between them. For reasons that aren’t clear, whilst has survived in British English but has died out in the US. However, in Britain it is considered to be a more formal and literary word than its counterpart. I have a small weakness for it, for which I’ve been gently teased in the past.
World Wide Words: While versus whilst より

意味に違いはないけど、アメリカでは死語で、イギリスでは形式ばった表現らしい。 多分使うことはないけど、いろいろ面白い。

SchemeでClojure風構文

お昼ごはんを食べながら適当に書いてみた。Clojureの構文はちょっと見ただけなので違うかもしれない。

((import (rnrs))

(define-syntax fn
  (lambda (x)
    (define (parse-args args acc)
      (define (finish opt)
        (if (null? acc)
            opt
            (append (reverse acc) opt)))
      (syntax-case args (&)
        (() (finish '()))
        ((& rest) (finish #'rest))
        ((a . d)
         (parse-args #'d (cons #'a acc)))))

    (define (parse-body body acc)
      (syntax-case body ()
        (() (reverse acc))
        (((#(args ...) exprs ...) . rest)
         (with-syntax ((formals (parse-args #'(args ...) '())))
           (parse-body #'rest 
                       (cons #'(formals exprs ...) acc))))))
    (syntax-case x ()
      ((_ #(args ...) exprs ...)
       #'(fn dummy #(args ...) exprs ...))
      ((_ name #(args ...) exprs ...)
       (identifier? #'name)
       #'(fn name (#(args ...) exprs ...)))
      ((_ (#(args ...) exprs ...) ...)
       #'(fn dummy (#(args ...) exprs ...) ...))
      ((_ name (#(args ...) exprs ...) ...)
       (identifier? #'name)
       (with-syntax ((((formals body ...) rest ...)
                      (parse-body #'((#(args ...) exprs ...) ...) '())))
         #'(letrec ((name (case-lambda 
                           (formals body ...)
                           rest ...)))
             name))))))

(define-syntax def
  (syntax-rules ()
    ((_ name expr) (define name expr))))

(define-syntax defn
  (syntax-rules ()
    ((_ name #(args ...) body ...)
     (defn name (#(args ...) body ...)))
    ((_ name (#(args ...) body ...) ...)
     (define name
       (fn name (#(args ...) body ...) ...)))))

(defn print #(& args) (for-each display args) (newline))

(defn t1 #(a b) (print a b))
(t1 1 2)

(defn t2 
  (#(x) (print x))
  (#(x y) (print x y)))

(t2 1)
(t2 1 2)
(t2 2 1)

(def mult
  (fn this
      (#() 1)
      (#(x) x)
      (#(x y) (* x y))
      (#(x y & more) (apply this (this x y) more))))

(print (mult 1 2 3 4 5))

Clojureでは[]がベクタになるけど、Schemeでは#()にしないといけないのでむしろうっとおしい感じがする。

動作確認はいつものR6RS処理系でやった。

なんでこんなものを書いたかと言えば、パターンマッチ部分でベクタにもマッチできるよなぁと思ったから。本当にただそれだけ。

Should NULL be allow to be in string?

R7RS working group likes discussion, I guess.

The most recent topic is about string containing #\x0 (or #\null).

poll: invalid item #315 from 5th ballot

The #315 is about the following code won't raise any error.

(string-set! s i #\null)

For me, it seems totally fine. But for them, or even Unicode world, it's not fine. Really?

Well, either way the above expression on Sagittarius will be totally fine for any time. So, I don't have any intension to change current behaviour.

The reason I'm writing this article is I found a curious experience in the topic. How does the following code work on R6RS implementations? Original was about Chicken and Gambit.

(import (rnrs))
(define file (string #\a #\x0 #\b))
(when (file-exists? file) (delete-file file))

(let ((o (open-file-output-port file)))
  (put-bytevector o (string->utf8 "hello"))
  (close-port o))

The file is definitely invalid file path.

The results are like this;

Implementation	Result
Chez	Made 'a' file
Larceny	Made 'a' file
Mosh	Made 'a' file
Racket	Raised an error
Sagittarius	Made 'a' file
Ypsilon	Made 'a' file

I can't say which way should implementations behave.

Sagittarius 0.3.7リリース

Sagittarius Scheme 0.3.7がリリースされました。ダウンロード。

今回のリリースから、リーダの置き換えが可能になります。詳しくはドキュメントを参照してください。

修正された不具合

• append!がリテラルリストを破壊的に変更可能だった不具合が修正されました
• (cond-features)がmutable listを返す不具合が修正されました。
• vector-reverse!がリテラルベクタを破壊的に変更する不具合が修正されました
• 組込みリーダを意図的に呼び出した際に、Schemeオブジェクト以外の不正なオブジェクトが返される不具合が修正されました
•  file-symbolic-link?手続きがシンボリックリンクに対して#tを返さない不具合が修正されました
• with-libraryマクロがキャッシュファイルを壊す可能性がある不具合が修正されました
• delete-directoryがWindows環境でいかなるフォルダも削除できない不具合が修正されました

新たに追加された機能

• リーダの置き換え機能が追加されました
• create-directory*, delete-directory*,  copy-directory及びbuid-path*手続きが(util file)ライブラリに追加されました
• socket-recv及びsocket-sendのflags引数がオプショナルになりました。ドラフトSRFI-106への追従です。

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

• SRFI-49がサポートされました。#!reader=srfi/:49の宣言をつけることでリーダが置き換えられます。

改善点

•  values手続きが第一級オブジェクトを返さなくなりました。また、32個までの引数ならVMはメモリの割り当てをしません。
• Windows環境での安定性が向上しました

非互換な変更

• (rsa pkcs :5)で定義されているderive-key&ivメソッドが2つの多値を返す必要があるように変更されました

ファイルの末尾に追加したい

ふと、R6RSの範囲でシェルで言う「>>」みたいなことができるのかなぁ？ということが気になった。

R6RSの範囲でファイルの末尾位置を取得する方法な無い(はずな)ので、outputポートのみを使うという方法は不可能である。となれば、input/outputポートを使用して、ポートを開いた直後に全部読み取ればポートの位置が末尾になるはず。ということで、こんなスクリプトで実験。

(import (rnrs))
(define out-file "out.txt")

(unless (file-exists? out-file)
  (call-with-output-file out-file
    (lambda (p) (put-string p "hello\n"))))

(let ((in/out (open-file-input/output-port
               out-file (file-options no-fail no-truncate))))
  (display (utf8->string (get-bytevector-all in/out)))
  (put-bytevector in/out (string->utf8 "hello\n"))
  (close-port in/out)) ;; これを忘れていた
#|
期待される出力結果。
1. 
 hello
2.
 hello
 hello

so on
|#

予定通りなら、期待される出力結果になって、末尾に追加されていることになる。とりあえず、Ypsilon、Mosh、Sagittarius、Chez、LarcenyとRacketで試してみた。

予定通りに動いた処理系：Sagittarius、Chez、Racket
全て上書き(helloを常に一個だけ出力)した処理系：Ypsilon、Mosh、Larceny

ふむ、ちょっとR6RSを読み返す必要があるらしい(またかよ・・・)。ということで、セクション8を読み返す。っで、面白いことに気づいた。以下面白い文章

(get-bytevector-all binary-input-port)    procedure 

Attempts to read all bytes until the next end of file, blocking as necessary. If one or more bytes are read, get-bytevector-all returns a bytevector containing all bytes up to the next end of file. Otherwise, get-bytevector-all returns the end-of-file object. The operation may block indefinitely waiting to see if more bytes will become available, even if some bytes are already available.

何が面白いか、どこにもポートポジションを更新すると書いてない＼(^O^)／
他のget-bytevector関連は更新すると書いてあるのになぁ・・・ということで、スクリプトのget-bytevector-allの部分をget-bytevector-nに変更して512バイト読み取るようにした。
しかし、結果は変わらず。う～ん、これってYpsilonとMoshのバグなのか、R6RS的には未定義なのかどっちなんだろう？でも、input/outputポートってこういう用途に使うんじゃないのか？

上記の検証は嘘であることが発覚した。単にポートの閉じ忘れで、ポートを閉じないと、Ypsilon、MoshとLarcenyでは溜め込んだバッファをflushしないだけだった。逆にいうと、Chez、RacketとSagittariusではその辺に寛容でプログラム終了時(だと思う、SagittariusではGC時)にポートのflushを行っているというだけだろう。
恥ずかしい検証をしたけど、自分への戒めとして残しておくことにしよう・・・

Portは閉じられるべきか？

デバッグをしている最中に「随分dynamic-winderがあるなぁ」ということに気づいた。スクリプトを眺めると、特にdynamic-windもguardも使われていない。あるのは、call-with-output-bytevector-portのみ。

そういえば、この辺の手続きはなぜかdynamic-windを使ってportを閉じているなぁと言うことを思い出し、R6RSではどう規定されてたっけと仕様書を眺める。あれ？何も書いてない。 call-with-portでは明示的にportは閉じられないと書いてあるが、勝手に作られる、しかも中身をR6RSの範囲では取り出しようがないものは手を抜かれたのだろうか？

じゃあ、別に閉じる必要ないよね。とは言っても、他の処理系の挙動と一応整合性を取っておきたい、ということで簡易テスト。

(import (rnrs))
(define p #f)

(guard (e (else (put-bytevector p #vu8(1 2))))
  (call-with-bytevector-output-port
   (lambda (port)
     (set! p port)
     (error 'ghehe "gehehe"))))

こんなの書いて、エラー投げなかったら閉じてない、投げたら閉じてるという感じで。

【結果】
閉じてる処理系：Ypsilon
閉じてない処理系：Chez、Racket(plt-r6rs)、Larceny、Mosh

閉じない方がメジャーな振る舞いっぽいし、call-with-portとの一貫性も取れるので閉じない方向で。

Monad on Scheme

Twitterでちらほら動的型付けでMonadなんてのが賑わっていたので、追随してみた。
CLで書かれていたのをScheme (Sagittarius)に書き直しただけなので非常に簡単ではあったが・・・
こんな感じ。

(import (rnrs) (clos user))

;; From following URLs
;; http://d.hatena.ne.jp/wasabiz/20121014/1350174261
;; http://basking-cat.blogspot.jp/2012/10/clojurestate.html
(define-syntax perform
  (syntax-rules ()
    ((_ ((name value)) expr ...)
     (fmap value (lambda (name) expr ...)))
    ((_ ((name value) . rest) expr ...)
     (bind value (lambda (name) (perform rest expr ...))))))

(define-generic bind)
(define-generic fmap)

;; List Monad
(define-method bind ((m <list>) f) (apply append (map f m)))
(define-method fmap ((m <list>) f) (map f m))

;; State Monad
(import (sagittarius object) (match))
(define-class <state> () ((run :init-keyword :run :reader state-run)))
(define (run-state m v) ((state-run m) v))
(define (eval-state m v) (car (run-state m v)))
(define (exec-state m v) (cadr (run-state m v)))

(define (make-state f) (make <state> :run f))

(define (get-state) (make-state (lambda (s) (list s s))))
(define (put-state) (make-state (lambda (_) (list '() x))))

(define-method bind ((m <state>) f)
  (make-state (lambda (s)
                (match (run-state m s)
                  ((a ss)
                   (run-state (f a) ss))))))

(define-method fmap ((m <state>) f)
  (make-state (lambda (s)
                (match (run-state m s)
                  ((a ss)
                   (list (f a) ss))))))

;; cursor
(define-class <cursor> ()
  ((x :init-keyword :x)
   (y :init-keyword :y)))
(define-method write-object ((c <cursor>) p)
  (format p "#<cursor (x ~a) (y ~a)>" (~ c 'x) (~ c 'y)))
(define (make-cursor x y) (make <cursor> :x x :y y))
(define (right n)
  (make-state (lambda (cursor)
                (let ((x (+ (~ cursor 'x) n)))
                  (list x (make-cursor x (~ cursor 'y)))))))
(define (down n)
  (make-state (lambda (cursor)
                (let ((y (+ (~ cursor 'y) n)))
                  (list y (make-cursor (~ cursor 'x) y))))))

(define (square n)
  (perform ((x (right n))
            (s (down x)))
    s))

(let* ((c (make-cursor 0 0))
       (es (exec-state (square 10) c)))
  (print c)
  (print es))

;; seqM and mapM
;; from https://gist.github.com/3889104
(define (seqM ms)
  (define (rec ms)
    (match ms
      ((m . ms)
       (if (null? ms)
           (fmap m (lambda (x) (cons x '())))
           (bind m (lambda (x) (fmap (rec ms) (lambda (y) (cons x y)))))))
      (_ '())))
  (if (null? ms)
      '()
      (rec ms)))

(define (mapM f ms) (seqM (map f ms)))

(define-class <maybe> () ((x :init-keyword :x :reader maybe-x)))
(define-method write-object ((m <maybe>) p)
  (format p "#<maybe ~s>" (maybe-x m)))
(define (make-maybe x) (make <maybe> :x x))
(define-method bind ((m <maybe>) f)
  (match (maybe-x m)
    ((:just . x) (f x))
    (:nothing (make-maybe :nothing))))

(define-method fmap ((m <maybe>) f)
  (make-maybe (match (maybe-x m)
                ((:just . x) (cons :just (f x)))
                (:nothing :nothing))))

;; Test
(define (buz xs)
  (define (bar x)
    (if (negative? x)
        (make-maybe :nothing)
        (make-maybe (cons :just (sqrt x)))))
  (mapM bar xs))

(print (buz '(1 4 9)))
(print (buz '(1 -4 9)))

Gaucheなら多分あまり手を入れなくても動くはず。TinyCLOSを持ってる処理系はキーワードの処理だけ何とかすれば、多少手を入れればいけるはず。
問題は、僕はMonadをよく分かっていないし、そのありがたみを享受したこともないので、こで何がうれしいのかいまいち分からない。Haskelやれってことか？

低レベルのソケットAPI

将来的なことを考えると低レベルのソケットAPIがあった方がいい気がしてきたのでちょっとメモ。(僕自身がソケットプログラミングに明るくないので、間違いがある可能性が大いにあります)

現在主流になっているソケットAPIはBSDスタイルだと思う。というか、他を知らない。恐らく、このAPIの本質はUNIXの「全てはファイルである」だと思う。なのでソケット自体がファイルディスクリプタだし、わざわざrecv/sendとか使わなくても、read/writeで読めたりする。

Wikipediaを見ると、オリジナルのAPI自体は7つしかない。どの段階で物事が簡単じゃなくなったのか分からないけど(多分IPv6だと思う)、 現在ではいろいろ解決しなければいけないものがありそう。とりあえずのメモとして、どれくらい自分がサポートしたいかを考えることにする。

思いつくままに箇条書き

• Wikipediaの7つのAPIの内、gethostbynameとgethostbyaddrを除く5つはサポート
• ソケットのみノンブロッキングI/Oをサポート
• select相当のAPI
• fdsetがいるけど、どうするべ？
• addrinfoは便利そうなのでうまいこと扱えるように
• Unix domain socketはサポートしない
• Windowsで提供できない(ことはないけど、面倒な)のでカット
• JavaみたいにServerSocketとClientSocketを分けた方がいいかな？
• IPアドレスの扱いはどうする？

う～ん、これさらに実装時には疑問が増えそうだなぁ。CLのusocketみたいに可能な限り隠蔽してしまった方がスマートだろうか？usocketが低レベルかと言われると、よく分からないけど・・・

Socket in other words SRFI-106

I'm currently working on SRFI-106 which I proposed (wow, sounds like i'm doing something cool, haha).

Now, I'm wondering if it's possible to make extensible APIs for future socket changes. The trigger to think is this message;

However, an API that is designed so that implementations can extend it to support things like Unix domain sockets, etc. without changing the basic design of the API might be better.
From SRFI-106 mailing list

 I super agree with it. But is it possible? To make this simple, let me target only Unix domain socket.

As far as I understand, Unix domain socket means file system socket like /tmp/socket1.s or something like this (, isn't it?). To create this, create a socket FD passing AF_UNIX (or AF_LOCAL) flag to socket(2), set filesystem path string to struct sockaddr_un's sun_path member, then call bind(2) with socket FD and sockaddr_un set before. This is UNIX (or POSIX) way to create local socket.
Now, let's see how it goes with Windows. Well, unfortunately Windows doesn't have this type of socket. If you want to do sort of the same thing, you need to do either creating a local address socket or using PIPE. Creating a local address socket would be portable way but occupies a port. Using pipe provides the same thing as UNIX but code won't be portable.

Yes, implementation can wrap those ugly part with beautifully abstracted API (if i can...). Or if AF_UNIX equivalent flag is passed on Windows environment, implementation can just raise an error.
Well, then here comes my next question. Is it basic? I might stick too much with this word. But I would rather make small world than bigger and lower layer world with this SRFI. Flexisibility is important. I believe simplicity is also important. I think I'm too lazy to introduce a lot of features such as addrinfo data type or other procedures. And it might be from my ignorance of socket programming.

Sort of brain storming. I'm still thinking if there is a nicer way to keep both flexibility and simplicity as much as possible.

中置記法

CourseraのScalaコースでScalaで中置記法が書けるということを知った。
こんな感じ

class Foo(x: Int) {
  val v = x
  def +(y: Foo) = new Foo(v + y.v)
  def less(y: Foo) = v < y.v
}

new Foo(1) + new Foo(2)

C++の演算子のオーバーロードに似ているけど、イメージとしては単に関数定義。Scalaは割りと自由にシンボルが定義できる。Schemer好みともいえる。のだが、多分演算子だけを特別視したくなかったんだろうなぁと思うのが、以下の記法。

new Foo(1) less new Foo(2)

SRFI-105でも感じた「うわぁ・・・」感漂う何か。何故かはいまいち分からないけど、どうも読みにくいと感じる。僕の主観だと思うんだけど、これが読みにくいと思うのはあまりにも自然言語に近いからだと思う。僕はあまり国語が得意ではなかったところに起因があるのかもしれないが・・・

それに加えて、中置き記法は評価の優先順位が問題になってくる。まぁ、常識人なら()で囲って優先順位を明確にするだろうけど、なんでそんなことを人間が考えなくてはいけないんだろう？と思ってしまう程度にはLisp脳になっているのかもしれない。(いや、単にものぐさなだけだろう)

コンパイルしてしまえばJavaからでも使えるし、REPLもあって開発効率は高そうなイメージなんだけど、じゃあ仕事で使いたいか？といわれると今のところ微妙な感じ。(でも、Scalaでやるよ～って言われたら喜んで飛びつきそうなくらいにはJavaに飽きている・・・)

必要ドリブン

泥縄とも言うのだが・・・(しかも、絶対的に必要というわけでもない・・・)

SOAPリクエストを投げる必要が出てきた。まぁ、ぶっちゃけSoapUI使っておけよという話になるのだが、いろいろなことを自動化するのにGUIを使うのは都合が悪い。1ヵ月後の自分が楽できるように今のうちに仕込んでおくのが怠け者の鑑というものだろう。

ということでSOAP的な何かができるライブラリを作った。タイトルはあんまり関係なく、どちらかというとどんな風に設計したのかという覚書。

実はSOAPを扱うライブラリはほしいなぁとずっと思っていて(まぁ、仕事で使うからなのだが)、3ヶ月くらいどうしようかなぁともやもやしていた。理由はJavaとかC++とか見たいにWSDLからクラスを自動生成してとかってやるのがかったるいとずっと思っていたから。そもそもScheme(というかLisp系言語)はS式というこの上なくXMLと親和性の高いデータ構造を息をするように扱うことができる。じゃあ、他の言語が必要とするXML→マッピング→オブジェクトなんていらんじゃん、と思っていたからだ。

もやもやすること3ヶ月、とりあえず動くものが欲しい(というか要る)と思い、適当に使いやすいと思うものを作ってみた。ポイントとしたのは、

• オブジェクトマッピングみたいなことはしない
• そこそこ柔軟に書ける
• リクエストを送ってレスポンスを返す

出来上がったのが、これ

自分で使った感想としては、まぁ悪くないんだけど、一々手書きでタグの定義を書くのは面倒だなぁとは思った。なので、改善点としては、WSDL解析してdefine-soap-type定義を自動で作ることかなぁ。

職業プログラマ

ふとこんな記事を見つけた。

[徒然]そろそろ潮時? - Kazzzの日記

何時からだろうか、職業プログラマとして生業を全うしたいと思いながら仕事をしていたのだが、今の職場ではもうそれを許してはくれなさそうだ。 許してくれないというよりは正確には「認めて貰えない」と言った方が良いだろうか。

プログラマのコストと会社の利益について書かれていた。僕が日本でかつプログラマとして働いた期間は2年と短い(オランダでのプログラマ歴の方が長くなってしまった)のだが、その短い期間でも同様の不満というか「それおかしくね？」という疑問を持った記憶がある。

なぜ、単価はPG < SE < PMなの？
PMは顧客と交渉するから(これ営業の仕事ちゃう？)？人的リソースとスケジュールの管理をするから？
SEは仕様書を書くから？見積もりだすから？(これも営業の仕事ちゃう？)
でもものを作るのはPGだよね？安い労働力に見合った品質で十分ということなのだろうか？年功序列で給料が決まるなら、年功序列でPG->SE->PMでいいと思うけど、本人の能力に対しての対価として給料が決まるなら、原価が安い＝品質が落ちるに繋がる気がするんだけど、違うのかな？

その昔、営業が1億で取ってきたけどSEが見積もったら赤字になる案件で、営業は高評価、SEは遂行できなかったから低評価というようなのを見たことがある(実際体験もした、金額は違うけど)。これって、無能な営業が安請け合いをして結果的に営業の責任で会社に損害を出したんだけど、全部SEに擦り付けられてるよね？っで、そのSEの下でものを必死になって作ったPGはさらに納期が守れなかったって非難される・・・おかしくないかなぁ？

優秀なプログラマは希少価値が高いと思うのだが、どうも十把一絡げ的に扱われている気がしてならない。僕も職業プログラマとして生涯現役でありたいと願う身なので、この手の話はいつもやりきれない思いが付きまとう。(自分が優秀どうかは知らんが・・・)

幸い、現在の職場は、PM、TM(テクニカルマネージャ)、PGと分かれていてそれなりに分業が出来てるし、PGだから給料が安いということもない(と思う。他人の給料知らん)。

絶対に明文化されないライブラリのメモ

Sagittariusには開発者が既存の機能のバグをビルドすることなくテストするライブラリがあったりする。(実際はライブラリという形式を取っているだけで、そういう機能があるのだが)。
この機能は僕が(主にマクロ展開器の)バグ取りように使うだけという位置づけにしてあるものの、普通にライブラリとして提供されている。ドキュメント化は絶対されないし、するつもりもない。っが、遊びとして使う分には面白い機能なので、興味がある人は触ってもいいかなぁと思いメモ。(と将来の自分への備忘録)

ライブラリは(現状では)(sagittarius aspect)という名前で提供されていて、このライブラリは(Again現状では)point-cutというマクロを提供している。名前付けは正直微妙だなぁと思っているので、将来のバージョンでは変更になるかもしれない。まぁ、でも使用頻度はそうないしこのままかもしれない。
使い方は以下のようになる。

(import (sagittarius aspect))
(point-cut
  (core syntax-case)
  expand-syntax
  (lambda (vars template ranks id-lexname lexname-check-list p1env)
     (let ((r (proceed)))
        (print r)
        r)))

マクロがproceedという手続きを提供するので、単に結果を覗きたいだけならこんな感じで書ける。結果が意にそぐわないものであれば変更も出来る。また、オリジナルの処理をせずに(proceedを呼ばずに)自分で再実装しても構わない。
気をつける点は、そのライブラリで定義された手続き自体を変更するということ。この変更がどこかのライブラリの挙動を変更するのである。例としては、

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

(library (hoge)
    (export fuga)
    (import (rnrs) (foo))
  (define (fuga) (display (bar)) (newline) 'fuga))

(import (hoge))
(fuga)     ; prints bar and returns fuga

(import (sagittarius aspect))
(point-cut (foo) bar (lambda () 'gehehe))
(fuga)     ; prints gehehe and returns fuga

上記の例では、手続きfugaは一切変更されていないが、依存するライブラリ(foo)内で定義された手続きbarが変更されているので、fugaに影響が起きている。モジュールシステムそのものを破壊する禁じ手ではあるのだが、使い方によっては便利に使えるので入れてある(自分用)。

そういえば、似たような機能で明文化されているのはwith-libraryマクロだろう。あっちはオリジナルを実行して値を覗くということは出来ないが。

R7RS 7th mini ballot result

I can't believe it's October. The time flies like an arrow, indeed (T_T)

Super postponed ballot result has been revealed. How long did they postpone? 3 weeks? I remember they said it's a small one so only a week. Liar!

Anyway, let me check what is the impact of it. I remember they were discussing how expt should behave.

#121
Now R7RS requires to signal error with the expression (expt 0 z) when z is negative. I believe this is incompatible change since I haven't seen any implementation raises error with this case. (Ypsilon, Sagittarius, Mosh, Gauche and Chibi(?!)). I agree with that the specification should not allow implementations to choose either unspecified value or error but hmm, is this nicer than R6RS?

#472
For me it's trivial, because I don't have intention to change current implementation of cond-expand, include and include-ci. But I think it's better if I can write like this;

(import (scheme base))
(cond-expand
  (sagittarius (import (srfi :1)))
  (else (import (srfi 1))))
;; bla bla

Does the result allow us to this? I actually couldn't understand properly:P

#473
I'm really disappointed with this decision. I think R6RS's toplevel restriction was too strict and it's better to be able to write import clause everywhere for small scripts. But they decided only beginning. It might be much better because now we can write the code above officially but hmm... No, we can't write the above code on toplevel according to the result. If we want to write the compatibility layer, we need to write it in a library then import it. Shit!!

#405
They have decided to keep compatibility with R6RS. (force 2) can raise error.

Only 4 items! But they needed 3 weeks?! I wish draft 7 will be released in this week...

BTW, why did I write this in English?

多値を考える

ずっと放置していた問題の一つ。

最近2chのLisp Schemeスレッドで多値が話題に上がっていて、せっかくだし便乗して考えることにした。(意味不明)

Sagittariusでは多値は第1級オブジェクトになっていて、valuesを呼ぶたびにメモリのアロケーションが走る。これは実は実装の手抜きで、

(apply values (iota 10000 1))

のようなコードをとりあえず走らせるための妥協の産物となっている。ちなみに、Gauche 0.9.3とMosh0.2.7ではこのコードはエラーになる。多分Gaucheは0.9.4辺りできっと直されるだろう(希望的観測)

valuesに期待したいことの一つとして、「これ使っておけば処理系はconsicingしない」というのがある(と思う)。そういう意味ではSagittariusはプログラマの期待を裏切っているわけだ。

自分自身、せっかくvalues使うんだしという感もあるので、現状の上限なしを維持しつつある程度は期待を裏切らない実装にしたい。案としては以下のようになるだろう。

• ある程度割り付けておいて、あふれた分は都度割付
• 必要になったら割付してそのバッファを再利用。足りなかったら再度割り付け(Racket方式)

一つ目と二つ目のどこに違いがあるのか？というレベルだが、実装レベルでは多少違うはず。一つ目は上限超えた際に常にメモリ割付が発生するが、そもそもvaluesに(こちらが考えた)上限を超える値は渡されないだろうという楽観的な実装になる。二つ目はユーザは常にこちらの想像を超えるものだが、それを見越してある程度の性能を出しておきたいという悲観的実装になる。
正直、一長一短ではあると思うが、二つ目の実装で困りそうなのが、上記の例みたいなことをされた際に10000個のバッファを常に保持する羽目になることだろう。多分、どこかの段階でGCされるような仕組みにしておかないと、不必要なバッファがメモリを食いつぶすなんて事になる。

さて、どうしたものかな。

括弧ゴルフ再び

リードマクロを実装したときに書いたネタ再び。(書いたよね？)
ちなみに、元ネタはこちら

本当にLispはカッコが多い？ - 八発白中 

今回はSRFI-49という最強の武器(w を持ったのでこんな風に書ける(0.3.7)

#!reader=srfi/:49
import
  srfi :1

define
  fact x
  if
    = x 0
    1
    * x
      fact
        - x 1

define
  printer i
  print i " ! = "
    fact i

define
  main args
  for-each
    printer
    iota
      if
        null? args
        1
        string->number
          cadr args
      1

Readerの切り替えに#!を使うので括弧0を実現可能！！！wwww
SRFI-49をサポートしている処理系(今のところSagittariusだけっぽい) ならSchemeで括弧ゴルフに勝利することができる。
なんだか、行き着くところまで来てしまったか感がする。

ユーザー定義のReader

こんな意見をいただいた。

@tk_riple R6RSでは#!で始まる識別子をフラグにできると書かれています。 r6rs.org/final/html/r6r… 汎用的にするなら例えば #!reader=srfi-49 みたいな書き方で任意のリーダを設定できるとかどうでしょう。 ファイル内での混在もできるかも。
— (32) 齊藤敦志さん (@SaitoAtsushi) 9月 21, 2012

これはいい！ということで、こっちにしてみた。

多少そのままではまずいので、定義を以下のように変更。

#!reader=srfi/:49

これで、今回ならSRFI-49を読み込むようになる。見ればすぐ分かると思うけど、(srfi :49)がsrfi/:49と変更されている。多少以上に醜いのはこの際目をつぶらないといけない。「.」とかだとライブラリ名が含んでいる可能性があるので「絶対含めることが出来ない文字」にする必要があったのだ。これならファイルシステムがエラー出すので、「実用上ありえない」が少なくとも保障される(少なくともWindowsとUNIX系OSなら)。

それに伴って一つ前の使用例を修正。この形式ならリーダマクロもいけるよなぁ、ポータビリティのために追加しようかな。

SRFI-49をまじめに検討してみる

きっかけはこの一言

@tk_riple srfi-49を標準サポートしてる処理系を自分は知らないんですが、遂に標準搭載の処理系が現われるのでしょうかｗ
— ⠗⠐⠥ ⠵⠱⠊⠷さん (@g000001) 9月 20, 2012

ないのか？ならば最初の処理系になってみようではないか！おぉぉ、燃え上がれ俺の小宇宙！

と、ここまで意気込むのはいいんだけど、このSRFI先頭にマークがあるわけではないし、105のように{}で囲まれているわけでもないのでreader(日本語で書くとleaderと混同しそう)そのものを置き換える必要がある。
確かに、参照実装のGuileではオリジナルのreadをこれように上書きしていたが、Sagittariusではファイルから起動する際はCで書かれたread相当の関数を直接読んでいるので上書きしても嬉しい結果にはならない。むしろ悲しくなる。
また、この面白SRFIを適用したした結果他のファイルに影響があっても嫌だ。となると、リードマクロと同様、適用したファイルのみに働くことが絶対条件かつなんらか既存のreaderを置き換える仕組みが必要になる。

実は腹案が既にあって(朝起きてシャワー浴びてたら思いついた)、ライブラリ自体に一つだけreaderを持たせることを許せば、持っていない場合はデフォルトで持ってる場合はユーザ定義という形で振り分けができそう。多少のオーバヘッドがかかるが、これを入れれば単に面白SRFIのサポートのみではなく、Cで書いたと思ったのにSchemeで実行されているでござる！ということが可能になるかもしれない。(結局ネタだな)
暇なので(これがいけない、ネタがあると飛びついてしまう)、この方針でとりあえず実装してみることにする。

Sagittarius 0.3.6 リリース

今回のリリースはメンテナンスリリースです。
ダウンロード: Sagittarius Scheme

修正された不具合

• SOBER-128がpseudo-random手続きで初期化不可能だった不具合が修正されました。
• read-delimited-listがcustom textual portに対してCレベルのアサーションで落ちる不具合が修正されました。
• リードテーブルが#!r7rs及び#!compatibleでリセットされない不具合が修正されました。
• import句のprefix が正しく動作しない不具合が修正されました。
• (syntax bar)が正しいライブラリを参照していない不具合が修正されました。

新しく追加された機能

• mod-expt及びmod-inverseがCでより高速に書き直されました。
• syntax-case及びsyntax-rules(R6RS版)がシンボルのリネームを行うようになりました。
• path-for-each、path-map、delete-directory*及びcreate-directory*が(util file)ライブラリに追加されました。
• copy-file手続きが追加されました。この手続きはOSの機能を使ってファイルをコピーするので、高速に動作することが期待できます。
• list->stringがオプショナル引数startとendを取るようになりました。
• read-random-bytes!手続きが(math random)に追加されました。

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

• SRFI-86、SRFI-31、SRFI-29及びSRFI-43がサポートされました。

改善された機能

• split-at手続きが末尾再帰になるように書き直されました。
• condがSRFI-61スタイルをサポートするようになりました。

互換性のない変更

• カスタムハッシュのread-randomスロットの名前及びセットされるべき手続きが取る引数が変更になりました。詳しくはドキュメントを参照してください。

マクロ戦争ひとまず終結

マクロの不具合に出会うたびに戦争だといっているだけ。それくらいR6RSのマクロ周りは複雑怪奇だと僕は思っている。

一つ前と二つ前の記事でマクロ周りの不具合が(まだまだたくさん)残っていることを書いたが、黒魔術的な処方を用いて直すことに成功したのでちょっと備忘録。

何が問題だったか？
2つの問題があって、1つはマクロを生成するマクロが生成した識別子の問題。もう一つはリネームの問題。

識別子の問題
問題点は2つ前の記事に書いたので、どう解決したかだけ。問題になるのはsyntax-caseのテンプレート部分のみだったので、どこにも束縛されていない識別子のライブラリを展開されているライブラリに置き換えるようにした。記事のコードで言えばdummyがあたかも(test-lib)内で定義されるかのように振舞うよう変更した。(本来はそうあるべきだった)。
ただ、これだけのことでも一筋縄ではいかず、結局コンパイラに手を入れたりと結構な量の修正が入った。問題だったのは、ライブラリ内で展開されるマクロがそのライブラリで定義された値を知っている必要があって、Sagittariusではその情報はコンパイラのみが知ることができるもの (マクロ展開器は構文について一切知らない)なので。これを入れたので、恐らくやろうと思えば未定義の値の参照を検出したり、未定義なexportを検出したり出来るはず。(まだやらない)

リネームの問題
これは本当に苦労した。一つ前の記事で書いた動作の修正になる。これについてはあほみたいな黒魔術を使って直した感があるが、そのうちリファクタリングしてやるという意思表示のためにどう直したかという恥をさらす。
Sagittariusにはgensymがあるのだけど、それを少し拡張して、与えられたシンボルに戻すことが出来るreversible-gensymという手続きを導入した。なぜこんなものが必要だったかと言えば、syntax-rulesやsyntax-caseにあるリテラル(キーワード？)の処理に必要だったから。単純にリネームしただけではこれらのキーワードが比較不可能なシンボルに変換されてしまうが、それはマッチする際に比較できずパターンエラーになる。なので、マッチする際にリテラルを強引に元に戻すという荒業を使っている。スマートな解決策がほしいところだが、僕の頭ではいい案が出なかった。

 問題になるかもしれない変更点
 リネーム問題の解決するに伴い、「それどうよ？」的な変更が入っている。それは、syntax-rulesもしくはsyntax-caseで定義されたリテラルが暗黙の内にマクロとして定義される。まぁ、大きな問題としては、unboundだと思って&assertionを期待していると&syntaxが飛んでくるようになった程度か？

とりあえず、0.3.6でマクロ周りが多少改善されるはず。小宇宙が少し高まっただろうか？

syntax-rules

マクロ周りは非常に奥が深くて僕では溺れてしまうという話。
昨日の記事を書いた後(しばらくは冪剰余やってたけど)気づいた。そういえば、Sagittariusではsyntax-rulesを使ってdummyみたいなことは出来ないと。
ということで、テスト。

;;(import (rnrs))
;;(import (scheme))
(define-syntax test
  (syntax-rules ()
    ((_ var val)
     (begin
       (define dummy val)
       (define (var) dummy)))))

(test a 'a)
(test b 'b)
(display (a)) (newline)
(display (b)) (newline)

最初のコメントは処理系に応じて入れたり消したり。試した処理系。

• R5RS Gauche、Racket(plt-r5rs)
• R6RS Ypsilon、Mosh、Petite Chez Scheme、Sagittarius(R6RS?)
• R7RS Chibi-Scheme(一応そう謳ってるし)

とりあえず、ほしい結果は多分以下。

#| R6RS的にはこうだよね？
a
b
|#
#| 字面的にはこうでもよさげ？(2)
b
b
|#

dummyというシンボルを使いまわしているように見えるので、(2)でもいいような気がしないでもない。(R6RSまじめに読んでない、R5RSは目を通したことすらない気がする・・・)
結論を言えば、Racket、Ypsilon、Mosh、Petite Chez Schemeは最初の結果、残り(Gauche、Chibi及びSagittarius)は2番目になった。

分かっていたんだけどね、こうなるって(Sagittariusの話)。そして、これは現状のつくりを維持するなら正直直しようがない。原因は2番目の結果になった処理系は、dummyを参照することができるということ。Sagittariusは確定なんだけど、恐らく残りの2つもマクロ展開時にシンタックスの情報を持っていない。なので、dummyとdefineの区別がつけられず、シンボルのrename(もしくはunintern)を行えない。

単純な話、上記の例で言えば、2つのdummyは同じrenameされたシンボルに変換できる。そうすると、トップレベルではdummyというシンボルは何かしらにrenameされているので見えないが、varが束縛(捕捉？)したdummyは同一のものにrenameされているのでそこからは見える。

これ多分、明示的にマクロ展開のフェーズを持たないと無理じゃないかな？もしくは、マクロ展開器がもっといろいろ知っている必要がある。あぁ、でもそれくらいならいけるかな？

結局、テンプレートをre-writeする際に、それがグローバルに束縛されているならそのままで、そうじゃないものならrenameとかすればいいかも。(でも、やるなら0.3.7以降だな。0.3.6はリリースが近いから無理だ)

これって、R5RSとR6RSで明確に定義されている非互換な動作なのだろうか？

マクロ、マクロ、マクロ

Sagittariusを試してもらえているというのは非常にありがたいし、嬉しいことである。それがたとえ動かない動作であっても(T_T)

動かない動作は以下のサイトより

衝突回避と暗黙のimport - 主題のない日記 

id:SaitoAtsushさん(こう書くのがHatena流だっけ？)は僕が絶対書かないタイプのマクロをガンガン書かれて、しかもそのテストにSagittariusも使ってくださっていてなんともありがたい。

ただ、まともに動いたことがない感じがするのがとても心苦しかったりもするだけれど・・・(R6RS名乗るの無理になってきたか・・・？)

さて、今回の不具合はパッと見、恐らく現状のマクロ展開の仕組みを使っていると直すのがかなり厳しい気がする。問題なのは、define-settable内で定義される識別子(ここではset-dummy!)は自身の定義されているライブラリの参照としてオリジナルのライブラリ(settable-variable)を持つ(はず)。そうすると、(test-lib)内で定義されているにも関わらず、参照を解決する際にオリジナルを見に行く。っで、unbound variableが投げられて悲しい思いをする。というのがパッと見た感じのエラーの原因と思う。
(あれ？でもこんな感じのマクロはdefine-record-typeとかでも普通に使われているはずだから、そんなはずないよなぁ？)

見た感じ、このマクロは結構コーナーエッジっぽいみたいで、意図どおりに動く処理系はRacketとYpsilonのみっぽい。実際手元のnmoshで試したらエラー投げた。
ちょっとpriority低めでIssue上げとくか・・・

冪剰余

まだ実装中なんだけど、必要な部分は出来て動いたのでちょっとベンチマークを取ってみた。

(import (rnrs) (crypto) (math) (time))
(time (generate-key-pair RSA :size 1024 :prng (pseudo-random RC4)))

自宅のX60で2048bitの鍵を作るのは自殺行為なので1024bitで。っで、以下が結果。

$ sash test.scm

;;  (generate-key-pair RSA :size 1024 :prng (pseudo-random RC4))
;;  4.265625 real    4.188000 user    0.078000 sys

$ ./build/sash.exe -Llib -Lsitelib -Lext/crypto test.scm

;;  (generate-key-pair RSA :size 1024 :prng (pseudo-random RC4))
;;  0.953125 real    0.890000 user    0.046000 sys

下が開発版。4倍程度高速になっているのが分かる。これくらい高速なら実用に耐えるだろうか？まだJavaと比較すると2倍から3倍遅いが・・・(比較する対象が間違っているのかもしれないと思い始めてもいる。)

Javaの実装に習って、Miller Rabinテストの試行回数を1024bit以上の時は2回にしてメルセンヌ数をチェックする処理を試したんだけど、結果が返ってこなかった。多分ヤコビシンボルを探すのが遅いのだろう。さすがにそこまでC側で実装するべきか悩むところだ。(Lucus Lehmer法自体がBignumを直接操作しないと遅いのかもしれない。まぁ、後の課題にする。)

mod-exptの動作としては、まだ対称の数(x ^ e mod mのx)が偶数の場合の処理が未テストかつ多分動きがおかしいはず。テストを書きつつ動作を検証していかないと。

Open Monumentendag@Haarlem

I actually didn't know what open monumentendag was. But I went there.

This was meetup stuff and originally it was Utrecht however organiser had just heard that most of the monuments were closed on Saturday so he changed it to Haarlem. Well, I've never been to Haarlem before (even though I've been living here for 3 and half years already!) so there was no reason not to go;)

 Central square? I don't know the place name. The sun glasses guy was the organiser.

 Inside of the city hall (if I following the explanation correctly...)

 They have a huge draw.

 Inside of the church which was on the first photo. Male choir was there. They were pretty good.

Should be a pipe organ. But I also saw a much smaller one, so this might not be the one.

Yes, as you already know I'm not a good photographer, so the photos are that's it.

Then we went through the city and into some museums. It was quit interesting to me. The city itself was totally different from other cities such as Leiden, Amsterdam or the Hague. (I don't know much about Rotterdam even though I work there:P)

冪剰余実装中

単にメモリ割り当てを減らしただけでは鍵対生成に対して実用的なパフォーマンスが得られないことが分かったので(2048bitで5秒からかかる)、どこが遅いかを調査した。結果、素数テストを行っている手続きで使用されている冪剰余の計算が遅いことが判明。x^e mod mを計算する際のx, e, m全ての数が2048bitあった際に20秒かかるという脅威の遅さだった。(3GHz Core i7)

Javaは2048bitの鍵対生成でも同マシンで1秒以下の時間で作ってくる。篩とかあるけど、何より素数チェック、その中で使われている冪剰余が高速なのだと仮定して実装をチェック。素数チェックはTwitterでも呟いたけど、Miller Rabinテストが1024bitを超えると試行回数が2回で、その代わりメルセンヌ数のチェックが入っていた。冪剰余についてはColin PlumbのBignumライブラリを元にした高速な実装になっている。

現状Sagittariusでは冪剰余を求める際に単純なバイナリ法を使っている。普通に

(mod (expt x e) m)

とするよりは遥かに高速なのだが、数値がBignumになってくると計算の度にメモリ割り当てが入りあまり嬉しくない。(eは1bitずつ右シフトされるので、2048bitあると、32bit環境では単純計算で2000回以上の割り当てがexponent部分だけで発生する)。
上記の実装(とりあえずはJavaの)ではメモリ割り当てがかなり削られている。正確には数えていないが、最大でも20回行かない程度に抑えられそうである。

ならばやらないわけには行くまいと、とりあえずJavaから実装を移植したら嵌った。

問題になったのはJavaのBigIntegerは内部で持っているintの配列のオーダーがSagittariusとは逆順になっているのだ。理由は知らないんだけど、きっとその方が効率がいい場面が多いのだろう。もしくはPrimitiveな配列でさえサイズを取ることができるからなのかもしれない。なので、単純にJavaから実装を持ってくるのは失敗に終わった。

恐らく中で何をやっているのか理解してやれば逆順に対応するのも難しくはないのだろうが、高速なモントゴメリ法の実装自体に興味があるわけではないので、可能な限りその労力は避けたい(ものぐさ)。ということでオリジナルの実装を当たってみることにした。←いまここ

マクロ展開時のライブラリ

以下のツイートを発見。

文字列補間マクロ書いたけど Sagittarius で動かない。
— (32) 齊藤敦志さん (@SaitoAtsushi) 9月 5, 2012

動かないのは許せない(というか、バグだし)ので、原因を探る。元コードはきっとこれだろう。

文字列補間 - 主題のない日記 

とりあえず、走らせる。&assertionか。なんとなく既に嫌な予感がしている。 いろいろ省略して原因箇所：

(datum->syntax #'string-interpolate 'x->string)

これ。全体というよりも、#'string-interpolateの部分のみ。

何故か？これ多分マクロ展開器の根幹の問題で、(syntax foo)という構文は定義されたライブラリ内ではなくimportされた先のライブラリで解決される。つまり、識別子が所属するライブラリがおかしいのである。なので、datum->syntax手続きが、#'string-interpolateからx->stringを作る際に本来ならば定義されたライブラリの情報を付加しないといけないんだけど、importしたライブラリの情報を付加する。結果、unbound variableといって怒られる。

とりあえず、一時的なしのぎとしてx->stringもexportしてしまうのが最も簡単な解決方法であろう。0.3.6以降のどこかで頑張って直そう。ちょっと(かなり？)大き目のバグが2つになった。燃える(φΛφ)

やはりいろいろな人に検証してもらうのは非常にありがたい。僕一人では恐らく未来永劫気づかなかったバグだ。

相手の言いたいことを想像する

こっそり転職活動をしていて、ふと思ったこと。ちなみに、行間を読むのではなく、もっと物理的な話。

こっちでは(僕があんまり熱心に転職活動をしていないからなのか)、エージェントが電話もしくはメールを送ってきて求職条件にマッチしたら先に進めるという、どちらかといえば受動的な感じでことが進む。もちろん、自分から応募した場合は向こうの条件に職歴等がマッチした場合のみ先に進む。この辺はどこでも一緒だろう。

さて、現在僕は1件面接が予定されていて今日の午後にそれに行く予定である。っが、それは別の話。今回はその面接をアレンジしたエージェントの話である。

よく、「オランダ人では話しかけた言語で会話を進められる」といわれるくらい言語能力が高いと信じられている。まぁ、ヨーロッパ内の言語なら概ねそうと言えるが、もちろん例外もいる。件のエージェントはどちらかと言えばその例外に当てはまる方のタイプで、ちょっと英語能力が怪しい。そうすると、たまに「何が言いたいのかいまいち分からない表現」というのが出てきて、多分これかなぁと想像することがある。正直なところこれが結構きつい。

何故きついか？普通に日本語を勉強している外国人と会話する際のことを思い浮かべればいいだろう。途切れ途切れで話すとか、言い回しがなんだかわけの分からないものだったりとか、そんな感じ。そうすると、多分こういいたいのかな？と推測をするわけだ。問題は、母語であればその推測が大抵当たるし、そんなに大変じゃないんだけど、第二外国語以降の言語だと習熟度に応じて難易度が変動する。僕の英語はリーズナブル(なんて訳すといいんだろう？)レベルだと思っていて、その手のことをするのは結構しんどいのである。特に、つっかえつっかえだと1秒前に言われた言葉が頭から抜けるのだ。

理解できなかった部分はどうするのか？聞きなおしても同じことが起きるので、「とりあえず最後にメール送ってくれるように聞いてみるか」となって理解を放棄する傾向にある。水は低い方に流れるのだ。あまり、相手の言いたいことを想像しない。よくない傾向である。

ちなみに、この現象は人ごみの中で電話をとったときとか、バスの中、電車の中でも起きる。雑音の中から向こう側の声を拾えないのである。(取りこぼすといった方がいいか？)。これは単純に言語能力の問題なのでヒアリング能力を上げるしかないのだが。

こういう細かい部分ってどうやって鍛えればいいのだろう？なにかいい方法があれば是非教えて欲しいです。

メモリ使用量

Sagittariusは割りと富豪的にメモリを喰う傾向にある。理由はいたって単純で、いろんなところで利便性のため冗長な情報を持たせているからである。

っが、それでは困ることが出てきた。テストを走らせるとかなりのメモリを消費し、Cygwin上でメモリ不足で落ちることがあるのである。地道に不要なオブジェクトをGCフレンドリにしたりして、50MB程度使用量を削ったのだが、焼け石に水感が拭えない。結局後100とかテストファイルが増えれば元の木阿弥な気がするからだ。

実は何が冗長な情報を持っているかは分かっている。ライブラリだ。どこかで書いたがSagittariusではライブラリもオブジェクトでその中にいくつかのメタ情報を持たせてある。importやexportの情報だ。 この二つは必須なので削りようがないのだが、もう一つ、そして恐らく大量にメモリを消費している情報で、親ライブラリ情報がある。これは何をしているのかと言えば、どのライブラリから何がimportされたかという情報である。たとえば以下のコード；

(library (lib1) (export v1) (import (rnrs)) (define v1 1))
(library (lib2) (export v1 v2) (import (rnrs) (lib1)) (define v2 2))

(lib2)は(rnrs)と(lib1)を親ライブラリとして持ち、(lib1)からv1を(rnrs)からは全てのシンボルをimportしているという感じである。

これが、かなり冗長(無駄ともいう)情報を持っていて、たとえば、(rnrs)は親に(rnrs base)とか持っていて、(lib2)はそれが何をexportしているという情報を全て持っている。なんでそんな冗長にしてあるかと言えば、ライブラリから値を引っ張り出してくる際に、その方が楽だからなのだが、はっきり言えば無駄である。実際、import情報だけあれば、全て解決するものであるのだからだ。

このライブラリの実装は複雑怪奇になっていて、正直自分でも必要がなければ構いたくないレベルになっている。(キャッシュもそうだが・・・)。っが今回必要が出てきてしまったので、頑張ってリファクタリングすることにする。とりあえず、意思表示だけ。

RSA key generation

I wasn't satisfied with the performance of RSA key pair generation at all since Sagittarius supported cryptographic operations. So I've done a lot of performance tuning such as bytevector->integer, integer->bytevector procedures. These changes, however, did not make that much difference even it's been improved 100 times faster than previous implementation.

Why? Actually I knew why. The prime number generation was really slow. It reads random number each time and checks if the number is prime or not with Millar Rabin test. In this prime number generation procedure, bytevector->integer is used so I thought if I improve the performance it would be changed dramatically. I've bet on the wrong horse, unfortunately.

Then I let it be for long time (I guess 3 month or so?) and I've got an idea today. The random number generation creates fresh bytevector each time, what if I modified it to read destructively. So I have introduced read-random-bytes! procedure and modified random-prime to use it. Now it's benchmark time. I used following code which generates 1024 bits RSA key pair.

(import (crypto) (math) (time))
(generate-key-pair RSA :prng (pseudo-random RC4))

To make sure the key generation procedure uses the same random generator, I specified :PRNG keyword. The result is below;

% sash test2.scm

;;  (generate-key-pair RSA :prng (pseudo-random RC4))
;;  1.7565269470214844 real    1.826000 user    0.047000 sys

% ./build/sash.exe -Llib -Lsitelib -Dbuild -L./ext/crypto -Lext/time test2.scm

;;  (generate-key-pair RSA :prng (pseudo-random RC4))
;;  0.769230 real    0.749000 user    0.031000 sys

Yes! It's improved as twice fast as before. The problem is, however, this change, more specificaly read-random-bytes!, introduced imcompatiblity of 0.3.5. Well, the change only affects custom pseudo random generator and I guess it's used by only me. So just wrote note on the document.

続 exportされた変数

一つ前の記事で、実行時エラーにしていたがえいやっとコンパイル時エラーにすることにした。

Sagittariusではライブラリも(実は)First class object(訳語忘れた)で、普通のR6RS処理系がするようなライブラリをrenameしてごにょごにょということは(いい悪いは別にして)行わない。 マクロ展開フェーズというものもなく、全てコンパイル時に解決している。これは、マクロ展開器とコンパイラで定義が被るのが嫌だったので。似たようなコードがそこかしこに出てくるのが我慢ならなかった。

本題に戻る。なので、ライブラリが別であれば、識別子は被っても問題ない。lookup(訳語知らない)時にimportされているものを調べて合致したものを返しているだけなので。なので再定義されても、参照される先が変わるだけ。正直特に必要性を感じていなかったし、今では面倒になっただけかも感があるのだが、規格に準拠するのもポータブルなコードを書くのには欠かせない部分だろうと重い腰を上げた感じ。

どう実装したか？
実は非常に簡単で、グローバルに値を定義できる構文と値を変更できる構文ってSchemeでは合計で3つしかない(よね？)。つまり、define、define-syntaxとset!の3つ。前2つは定義された値が同じライブラリ外で既に定義されていればエラーを投げる。set!は先に局所変数を探して、違ったら大域変数なので、その際にチェック。
問題だったのは、bootコードを生成するSchemeコードが再定義を前提で書かれていること。全部ライブラリ形式に書き換えてすっきりさせるというのもありだったのだが、面倒だったのでとりあえず再定義可能なモードを急遽入れて対応。ごにょごにょ黒魔法的な何かを使うよりはいいだろうと思う。そのうち書き直そう。

ちょっとした課題？
正直デフォルトで書き換え不可はあまりに面倒だなぁと思っているので、R6RSもしくはR7RSモードの際だけにするかもしれない。テストケースをコンバートしている際に思った。どうも僕はゆるい開発スタイルの方が好きらしい。

Shiroさんのコメントで何故R6RSが再定義を許さないかというのが非常に面白かった。既存の名前空間(モジュールシステム？)を実装していない処理系でもライブラリが持てるような考慮なんだろうか？psyntaxとか他の展開器(Andre van Tonderのしか知らないけど)ではlibraryも展開するようになってるし。

exportされた変数

一つ前の記事に言及していた記事の著者さんからコメントが付いてた。っで、自分の書いたコメントに疑問が(ぉぃ

set!で変更可能となると、「取り扱い注意」のラベルが必要かもしれませんが。

よく考えてみると、Sagittariusでは以下のようなことができる。

(library (test)
    (export variable)
    (import (rnrs))
  (define variable 1))

(import (test))
(set! variable 2)
(print variable)
#|
;; Output
2
|#

これはR6RS的にはエラーにならないとまずい。記憶が正しかったら、R7RS的にもエラーだったはず。
Sagittariusではデフォルト(というか、現状だと必ず)「取り扱い注意」のラベルが要ることになる。直すかなぁ。変更できた方が便利だろうかと思ったんだけど、変更されない方が便利だよなぁ。

でも、Ypsilonでも#!r6rsをつけないとエラーにならないなぁ。 どうしよう？

パラメタ

Schemeのparameterはわざわざ評価してやらないと値が取れないから使うのが面倒だ、と常々思っていたのだが、

識別子マクロとパラメタによる大域変数エミュレート

にそれを解消するマクロが紹介されていた。確かに、ぱっと見よさげだなぁと思ったのだが、これってSRFI-39が提供するparameterizeマクロと相性最悪じゃね？と思ってちょっと実験してみた。

(import (rnrs) (srfi :39))
(define-syntax define-identifier-parameter
  (syntax-rules ()
    ((_ var val)
     (begin
       (define t (make-parameter val))
       (define-syntax var
         (make-variable-transformer
          (lambda(x)
            (syntax-case x (set!)
              ((set! _ a) #'(t a))
              (_ #'(t))))))))))
(define-identifier-parameter *variable* 1)
(display *variable*) (newline)
(parameterize ((*variable* 2)) (display *variable*) (newline))
(display *variable*) (newline)

検証はいつもどおり、Sagittarius、YpsilonにMosh。
っで結果：

Sagittarius

Ypsilon

1を3回出力。(parameterizeされてない)

Mosh

&assertion: (1)は関数じゃないと怒られた

ふむ、パラメタはparameterizeと一緒に使われること(というか、僕は常にそれを想定)が多いと思うので、これだと、値が変更できるライブラリ変数という位置づけでしか使えないということだろうか？
面白いけど、使いどころが限定されそうだ。

{}の扱い

SRFI-105関連なのか、R7RSのGoogle Groupsに以下の投稿があった。

From   John Cowan

I know it's the last minute, but I've just a filed a ticket to add [ ] { }
to the list of delimiters, along  with ( ) " ; | and whitespace.
Implementations do use them for various things (R6RS systems of course
treat brackets as equivalent to parens), but I can't see people using them as
parts of identifiers (though some Schemes do allow it).

R6RSでは「[]」は使われているけど、「{}」ってそうでもないよなぁと思いちょっとテスト。試した処理系はYpsilon、Mosh、Petite Chez SchemeとSagittarius。(なんで自分の処理系もかって？忘れてるからだよ、言わせんな恥ずかしい///)
単発の「{」と「}」に加えて「{-reader」と「}-reader」というシンボルを読ませる。っで、結果。

処理系	{	}	{-reader	}-reader
Ypsilon	reader error
Mosh	reader error
Petite	\x7B;	\x7D;	unbound variable \x2D;reader
Sagittarius	|{|	|}|	|{-reader|	|}-reader|

R6RSのリーダの定義(読めよ)を忘れたのでどれが正しい動作かはよく分からないけど、Ypsilon、Moshはシンボルに「{}」は使えない。Petiteは「{}」はデリミタになるので、事実上使えないっぽい。Sagittariusは特別視していないらしい。
ちなみに、Gaucheでは「{}」もリストを読むのに使えるので、エスケープなしではシンボルとして読まない。

これをシンボルとして読み込んでうれしいことはあまり無い気もするのだが、R7RSの精神がミニマリズムなのであれば、実装者から自由を奪うのは多少その精神から外れる気がする。

追記：
Sagittariusでも#!r6rsをつけるとYpsilon、Moshと同じ動作になる。
R6RS的には「{}」はシンボルに使ってはいけない文字である。(調べた)

SRFI-105を試してみる。

リーダをいじる系のSRFIを割りと簡単に試すことが出来るのもSagittariusの特徴の一つだと信じているので、早速新SRFIを試してみる。
(自分でも使い方忘れてて、ドキュメントを探したのは内緒だ)

;; From reference implementation

;; Return true if lyst has an even # of parameters, and the (alternating)
;; first parameters are "op".  Used to determine if a longer lyst is infix.
;; If passed empty list, returns true (so recursion works correctly).
(define (even-and-op-prefix? op lyst)
  (cond
   ((null? lyst) #t)
   ((not (pair? lyst)) #f)
   ((not (eq? op (car lyst))) #f) ; fail - operators not the same
   ((not (pair? (cdr lyst)))  #f) ; Wrong # of parameters or improper
   (else (even-and-op-prefix? op (cddr lyst))))) ; recurse.

;; Return true if the lyst is in simple infix format
;; (and thus should be reordered at read time).
(define (simple-infix-list? lyst)
  (and
   (pair? lyst)           ; Must have list;  '() doesn't count.
   (pair? (cdr lyst))     ; Must have a second argument.
   (pair? (cddr lyst))    ; Must have a third argument (we check it
                    ; this way for performance)
   (symbol? (cadr lyst))  ; 2nd parameter must be a symbol.
   (even-and-op-prefix? (cadr lyst) (cdr lyst)))) ; true if rest is simple

;; Return alternating parameters in a list (1st, 3rd, 5th, etc.)
(define (alternating-parameters lyst)
  (if (or (null? lyst) (null? (cdr lyst)))
      lyst
      (cons (car lyst) (alternating-parameters (cddr lyst)))))

;; Not a simple infix list - transform it.  Written as a separate procedure
;; so that future experiments or SRFIs can easily replace just this piece.
(define (transform-mixed-infix lyst)
  (cons 'nfx lyst))

;; Given curly-infix lyst, map it to its final internal format.
(define (process-curly lyst)
  (cond
   ((not (pair? lyst)) lyst) ; E.G., map {} to ().
   ((null? (cdr lyst)) ; Map {a} to a.
    (car lyst))
   ((and (pair? (cdr lyst)) (null? (cddr lyst))) ; Map {a b} to (a b).
    lyst)
   ((simple-infix-list? lyst) ; Map {a OP b [OP c...]} to (OP a b [c...])
    (cons (cadr lyst) (alternating-parameters lyst)))
   (else  (transform-mixed-infix lyst))))

;; set macro characters
(set-macro-character 
 #\{ (lambda (p c) (process-curly (read-delimited-list #\} p))))
(set-macro-character 
 #\} (lambda (p c) (error '|}-reader| "unexpected #\\}")))

;; test
(print '{a + b})
(print '{a * {b + c}})

#|
;; output
(+ a b)
(* a (+ b c))
|#

なんとお手軽。
ポイントは、閉じ括弧もリードマクロとしてマークすること。じゃないとread-delimited-listがnon-termな文字として識別しちゃうので、意味不明のエラーが出て悩む。(ってか、3分くらい悩んだ・・・orz)

これくらいお手軽に試せるからいいけど、そうじゃない処理系はこれを入れる気になるんだろうか？そこまで中置記法にこだわる理由が(もはや)分からない。

Libraryのルックアップ

ずっと悩んでいる問題の一つ。
SagittariusではR6RSが禁止しているexportされたシンボルの上書きを許している。理由はその方が便利だから。

ただ、これ便利なんだけど、プログラマが重複するシンボルを含むライブラリをimportした際にどちらが使われるのか意識できないと拙い。Sagittariusでは「後からimportしたものが使用される」というルールを作っている。もちろん明にexceptとか使えば問題ない。ただ、スクリプトとして走らせた際がちょっと困って、既にimportされているライブラリがトップレベルにある。

直接exportされているものなら別に問題ないんだけど、問題になるのは間接的にexportされているもの。SRFIライブラリなんかはもろにこれで、

(import (srfi :1))

とかってやると全部間接的に解決される。っで、上記の例でトップレベルでは既に(rnrs)がimportされているので、removeとか使うと、SRFI-1の方を使って欲しいのに、R6RS定義の方が使われて悲しい思いをする。

原因は0.3.5までは、間接解決されたものは解決リストの末尾に追加されているため。これではいろいろまずいので修正した。
修正方法は非常に単純な発想で、直接importの次に間接importを追加してから既にある解決リストを追加するというもの。
今まで不便だなぁと思いつつ放っておいたのだが、重い腰をよっこらせっとあげた。これで今まで明示的に

(import (srfi :1 lists))

と上記の問題を回避するために書いていたのをやらなくても済む、はず。

スライドを作ってみた

別にどこかで発表するわけでもないのに、スライドを作ってみた。

Sagittarius 0.3.5リリース

Sagittarius Scheme 0.3.5がリリースされました。今回のリリースはメンテナンスリリースです。

修正された不具合

• format関数が長さを指定した際に空文字を返す不具合が修正されました。
• EMSA-PSSを用いた検証がときどき失敗する不具合が修正されました。
• SRFI-13ライブラリにあるxsubstringが&assertionを投げる不具合が修正されました。

新たに追加された機能

• ライブラリ名に負の数でない正確数が使用可能になりました。R7RS 6th ballot
• vector-append、bytevector-append (R7RS 6th ballot)、vector-concatenate及びbytevector-concatenateが追加されました。
• 即値な浮動小数点数がサポートされました。(現状では5の倍数以外には適用されません)
• (eqv? 0.0 -0.0)が#fを返すように修正されました。(R6RS及びR7RS 6th ballot)
• port-for-each、port-mapが(util port)に追加されました。
• drop*が(util list)に追加されました。

改善点

• utf8->string、string->utf8、bytevector->string及びstring->bytevectorがオプショナル引数startとendを受け取るようになりました。
• equal?がレコードの中を再帰的に調べるようになりました。
• (exit #t)が(exit)または(exit 0)と同様の振る舞いをするようになりました。(R7RS 6th ballot)
• Windows版のバイナリがMSVD*.dllを必要としなくなりました。
• 正規表現の速度が改善されました。
• list-sortの速度が改善されました。

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

• RFC 4122 ライブラリ(rfc uuid)が追加されました。
• RFC 1421 ライブラリ(rfc pem)が追加されました。

新たに追加されたドキュメント

• (util list)がドキュメント化されました。
• (sagittarius io)がドキュメント化されました。

続 正規表現エンジンのチューニング

とりあえず、昨日のコードがGauche(0.9.3)と同程度の速度が出るように改善できた。

やったこと

1. 疎な配列をエミュレートしていたのだけれど、それに付随していたイテレータの削除
• 10%程度
2. 地味にコードのリファクタリング
• 10%程度
3. インストラクションコードの2番目がアトムチェックのコードならマッチする場所までチェックする
• これが効いた、900% 

もともと昨日のコードでは、1000個の'a'と'01:23'という文字列が1000回繰り返して最後に':45'とつくのだけれど、途中の'a'の部分は絶対にマッチしないくせにわざわざキュー操作していたのがまずかったのだ。なら、最初にマッチする場所まで先読みしてやれよかったという話。

現状ではものすごく手抜きな先読みなので、#/(\d\d):\d\d:\d\d/と変更されるだけで遅くなるんだけど。また気になったら直すことにしよう。

正規表現エンジンのチューニング

SagittariusではRE2(Pike VM?)ベースの正規表現エンジンを積んでいて(実際にはハイブリッドなのだが、今回はこっちのエンジンが対象)、基本的な正規表現ならO(n)で走る。実際にはO(n+α)だったりするが、O(n)でいいだろう。リニアに走るなら速度はそんなに気にしなくてもいいんじゃないかと思うのだが、以下のようなコードを走らせると不満が出るほど遅い。

#< (sagittarius regex) >
(import (time) (srfi :1)
 (text tree)
 (sagittarius control)
 (sagittarius regex)
 (only (sagittarius regex impl) dump-regex))

(define s
  (tree->string `(,(make-list 1000 `(,(make-string 1000 #\a) "01:23")) ":45")))

(define (time-this count thunk)
  (time (dotimes (i count) (thunk))))

(print (time-this 10 (^[] (#/\d\d:\d\d:\d\d/ s))))

以下が実行結果(Cygwin on Windows XP CoreDuo 1.6GHz)

$ sash reg.scm

;;  (dotimes (i count) (thunk))
;;  2.921875 real    2.969000 user    0.000000 sys
#t

ちょっとねぇ・・・とりあえず、本質的な問題を脇に置いておいて、不必要な計算を減らして400ms程度速くしたのだが、やはり枝葉の最適かなので2割程度にしかならない。

何が問題か？エンジンの走り方以外の何者でもないのだが・・・
 PikeVMはバックトラックをしないNFAなエンジンである。っで、バックトラックさせない為に、内部で仮想スレッドとスレッドキューを持っていて、一文字チェックする毎にスレッドキューに次に実行させるインストラクションとマッチした状態を保存したスレッドを溜め込む。文字がマッチしなければキューにあるスレッドは1個なんだけど、例えば4文字までマッチしたスレッドがあるとすると、他にも3スレッド脇で走っていたりする。
以上を踏まえて、上記のコードを見ると、途中で「01:23」と4文字マッチして、捨てられるという処理が1000回ほど必要になる。そのため、内部で回すスレッドの関係でガッツリ遅くなる。のではないかと結論付けている。
現実的にこれほどベンチマークに特化したかのような入力文字列の処理が必要になるかどうかは別にしても、遅いというのは悪であるのでなんとかしたい。しかし、問題の幹の部分はそれこそ正規表現エンジン自体を改善(可能ならDFAにするとか)しないと無理なので、そこまで大掛かりにしたくない(ものぐさ)。
とりあえず、やってみて効果のあったもの。

• 不要コードの削除
• キューをクリアするに最小限の要素のみクリア

無駄だったもの

• 急場のダイレクトスレッドコード

枝葉のチューニングではこの程度が限界だろうか？せめて倍速まで持っていきたいのだが、う～ん。

Lisp啓蒙活動(?)

自動SQL生成スクリプトを書いているときに、同僚がふと作業風景を覗き込んできた際に発生した会話から。

Colleague: You like Emacs, don't you?
Me: I do.
Colleague: Is it Lisp?
Me: Sort of. (It's Scheme but I think Sagittarius is already sort of 'MY LISP' now...)
Colleague: It's one of the languages I can't understand?
Me: It's not so difficult, you know?
Colleague: It is. I don't think I can accept the parenthesis.
Me: (I wish I could show this site : 本当にLispはカッコが多い？)

これ以外にも、なんだか毛嫌いというか、Lispは近寄りがたいみたいな雰囲気で話すので、なんでだろうなぁ？と思い考えてみた。
そういえば僕も昔はLispを避けていたのだから、似たような考えがあって、何かがきっかけで考えが変わったはずである。っで、避けていた理由を探してみた。

1. Lisp入門のサイトとかで必ずある「consとリスト」の解説。
•  正直読んでも、だから何ができるの？という気になった。
•  更に、なんか面倒だなぁという気にさせられた。
2. How to become a hackerの悟り体験の話。
• なんだか小難しい言語ではないのかという錯覚を起こさせた。
3. 関数型言語と再帰。
• 手続き型言語から始めると再帰の概念は分かりにくい。(少なくとも僕はそうだった)
4. 無名関数、クロージャ、高階関数。
• 手続き型、以下略。
• これに関しては、言語ごとに(特にクロージャ)定義が違うのも問題な気がする。
5. lambdaという言葉。 
• boost::lambdaでlambda = 無名関数 = クロージャみたいな理解したなぁ。(遠い目)

とりあえず、思いついただけではこんな感じ。じゃあ、何がこのとっつきにくさを変えたかという点だけど、これは正直よくわからない・・・SICP読み始めて、処理系作り出して、折角作ってるんだし使い倒さないとと言うのが最初のモチベーションだった気がする。

それではあまりにもと思うので、啓蒙するにはどうすればいいか。
※僕が考える最強の啓蒙活動的な感じです。当てにしないでください

1. 可能な限りシンプルに、かつC言語とかの最初のステップに合わせる。
• Hello Worldでもいいし、ファイルを一行処理してとかでもいいと思う。
• いきなり、consとリストではひく。
2. エディタの支援を当てにしてもいいということを教える。
• 括弧の対応とか目視では無理。
• Emacs最強(これも啓蒙してしまえ！)
• S式一個切り取って貼り付けとか知ると、Javaとか面倒すぎて編集する気になれなくなるはず。
3. 再帰を可能な限り隠す。
• CLならloopで大抵いけると思う。
• Schemeならnamed letで。
4. クロージャは単なる関数だとしておく。
• 名前に臆することもあるよね？
5. でも、処理系がたくさんあってどれ使えばいいのさ？
• 入門レベルのCLならどれでもいいはず。
• Schemeは、Gaucheかなぁ。実績あるし。(自分の処理系を推したいが、名前を横に並べるのもおこがましい気になる・・・)

う～ん、いまいちだな。多分、こんなことしなくてもプログラムが好きな人は自分の好きな言語を見つけるし、いろんな言語を書けるんだよね。毛嫌いする人はどちらかと言えば「ぷろじぇくとまね～じゃ～」とかあんまり自分ではコードを書かない人たちなイメージ。実際、職場の開発者で数人は関数型言語やってる。(ClojureだったりHaskellだったりするけど)
とりあえずリスト作って、後はfor-eachでもmapでもfoldでも使えばいいじゃん、見たいな感覚になると早いと思うんだけど、そこまでが遠いなぁ・・・

list-sortを書き換え

ふとTwitterで以下のページを言及しているツイートを見つけた。

ソート済みのリストに対する破壊的マージソートの改良

これはlist-sortのパフォーマンス改善に使えると思い、早速実装。この記事書く前に全部置き換えてコミットしてしまったのと元々Sagittariusのlist-sortはYpsilonのものを使っていたので、以下のコード(速度計測)はYpsilonで確認。

(import (rnrs)
        (time)
        (srfi :8)
        (srfi :27)
        (srfi :42))

(define sorted-list (list-ec (: x 100000) x))
(define reverse-sorted-list (reverse sorted-list))
(define nearly-sorted-list1 (list-ec (: x  100000)
                                     (if (zero? (random-integer 1000))
                                         (random-integer 100000)
                                         x)))
(define random-list (list-ec (: x 100000)
                             (random-integer 100000)))

(time (list-sort < sorted-list))
(time (list-sort < reverse-sorted-list))
(time (list-sort < nearly-sorted-list1))
(time (list-sort < random-list))

(define (list-sort2 proc lst)
  (define (merge-list! proc head lst1 lst2 tail)
    (let loop ()
      (cond ((proc (car lst2) (car lst1))
             (set-cdr! tail lst2)
             (set! tail lst2)
             (let ((rest (cdr lst2)))
               (cond ((null? rest)
                      (set-cdr! lst2 lst1)
                      (cdr head))
                     (else
                      (set! lst2 rest)
                      (loop)))))
            (else
             (set-cdr! tail lst1)
             (set! tail lst1)
             (let ((rest (cdr lst1)))
               (cond ((null? rest)
                      (set-cdr! lst1 lst2)
                      (cdr head))
                     (else
                      (set! lst1 rest)
                      (loop))))))))
  (define (fast-merge-list! proc try? head lst1 tail1 lst2 tail2 rest)
    (if try?
        (cond ((not (proc (car lst2) (car tail1)))
               (set-cdr! tail1 lst2)
               (values lst1 tail2 rest))
              ((proc (car tail2) (car lst1))
               (set-cdr! tail2 lst1)
               (values lst2 tail1 rest))
              (else 
               (values (merge-list! proc head lst1 lst2 head)
                       (if (null? (cdr tail1))
                           tail1
                           tail2)
                       rest)))
        (values (merge-list! proc head lst1 lst2 head)
                (if (null? (cdr tail1))
                    tail1
                    tail2)
                rest)))
  (define (do-sort lst size head)
    (define (recur lst size)
      (cond ((= size 1)
             (let ((h (list (car lst))))
               (values h h (cdr lst))))
            ((= size 2)
             (let* ((a (car lst))
                    (ad (cadr lst))
                    (h (if (proc ad a)
                           (list ad a)
                           (list a ad))))
               (values h (cdr h) (cddr lst))))
            (else
             (let ((half (div size 2)))
               (receive (lst1 tail1 rest) (recur lst half)
                 (receive (lst2 tail2 rest) (recur rest (- size half))
                   (fast-merge-list! proc (>= size 8) head
                                           lst1 tail1
                                           lst2 tail2
                                           rest)))))))
      (receive (lst tail size) (recur lst size)
        lst))
    (define (divide lst)
      (let loop ((acc 1) (lst lst))
        (cond ((null? (cdr lst)) (values acc '()))
              (else
               (if (proc (car lst) (cadr lst))
                   (loop (+ acc 1) (cdr lst))
                   (values acc (cdr lst)))))))
    (receive (n lst2) (divide lst)
      (if (null? lst2)
          lst
          (let* ((head (cons '() '()))
                 (r (do-sort lst2 (length lst2) head)))
            (merge-list! proc head (list-head lst n) r head))))))

(newline)
(display 'list-sort2) (newline)
(time (list-sort2 < sorted-list))
(time (list-sort2 < reverse-sorted-list))
(time (list-sort2 < nearly-sorted-list1))
(time (list-sort2 < random-list))

オリジナル(SBCL)のコードはdevide相当のものはないのだけれど、これがあるのと無いのではソート済みのリストが渡された際のパフォーマンスが全然違う(10倍程度)ので入っている。
以下が結果。

% Ypsilon test2.scm

;;  0.006001 real    0.0 user    0.0 sys

;;  0.16501 real    0.327602 user    0.0 sys

;;  0.194012 real    0.374402 user    0.0 sys

;;  0.302017 real    0.624004 user    0.0 sys

list-sort2

;;  0.007 real    0.0 user    0.0 sys

;;  0.116007 real    0.202801 user    0.0 sys

;;  0.16201 real    0.249602 user    0.0 sys

;;  0.254015 real    0.343202 user    0.0 sys

ソート済以外は高速になっているのが分かる。(ソート済みは一緒のはず)。
Sagittariusで検証した際はreversed-sorted-listで倍速、nearly-sorted-list1ではほぼ倍速。random-listは2割程度とYpsilonと同程度の速度改善であった。

どうでもいいのだが、 moshで上記のコードを走らせる(list-headをtakeにする等の変更が必要だが)と劇的に遅くなる。どの処理系でも速度改善になるというわけではないらしい。

どうでもいい追記その２。
moshのlist-sortはスタックを激しく使用するらしく、reversed-sorted-listで45回のスタック拡張が発生した。(ちょっと手を入れて、スタックの拡張が起きるとwarningメッセージ出すようにしてある。)

どうでもいい追記その３．
Ypsilonでもリストの要素数を200万個以上にするとメモリが足らなくなった。オリジナルは末尾再帰じゃないのでしょうがないのか。改善されたのは速度だけではないのもいい感じである。

Bug of EMSA-PSS

I have just fixed the bug in EMSA-PSS verify. It has been there since version 0.2.x.

The problem was test case for EMSA-PSS verify failed *sometimes*, like once in 100 times or once in a month. It was really annoying and made this procedure unreliable.

Because of this random frequency, I suspected it was random number generator. In the test case, it uses secure random number generator so that it generate different number each time. (well, thank god I used secure random, otherwise I would never notice this bug.)

So first step to fix this bug was create a proper (improper?) state of PRNG. To create it, I made this code;

(import (crypto) (math) (getopt))

(define key-pair (generate-key-pair RSA :size 512 :prng (pseudo-random RC4)))
(define valid-rsa-message (string->utf8 "test message"))

(define prng (pseudo-random RC4))
(with-args (command-line)
    ((c (#\c "count") #t "1"))
  (let ((count (string->number c)))
    (do ((i 0 (+ i 1))
  (r (read-random-bytes prng 100) (read-random-bytes prng 100)))
 ((= i count) r))))

(let* ((rsa-sign-cipher (cipher RSA (keypair-private key-pair)))
       (rsa-verify-cipher (cipher RSA (keypair-public key-pair)))
       (em (sign rsa-sign-cipher valid-rsa-message :prng prng)))
  (verify rsa-verify-cipher valid-rsa-message em))

And this shell script;

#!/bin/sh

for i in `seq 1 $1`
do
    count=`expr $i + 100`
    echo $count
    `sash -Lext/crypto crypto.scm -c $count`
done

Then ran the script and check which number was the key number! After the inspection, the number was 181.

Now, it's time for debug. once I could find the PRNG state, it was really simple to fix. The problem was the signed message's first 2 bytes. RSA operation deletes left most 0's so verify procedure needs to add removed 0's in front of the message. However previous implementation did not add more than 2 zeros. That was the problem.
So I modified to add propert 0's in front of the message, and now it works!

I hope Sagittarius is now a bit more reliable. Even though I have no idea if it was the only problem that causes test case failed.

Haskell風の$マクロ その２

さすがに前回のはあんまりだよなぁと思い、もう少しだけR6RSっぽくしてみた。

(import (rnrs))
(define-syntax $
  (lambda (x)
    (define (build es)
      (let loop ((es es) (r '()))
        (syntax-case es ($)
          (() (reverse r))
          (($ es ...)
           (append (reverse r) (list (loop #'(es ...) '()))))
          ((e . es)
           (loop #'es (cons #'e r))))))
    (syntax-case x ()
      ((k es ...)
       (build #'(es ...))))))
 
(define (print . args)
  ($ for-each display args) (newline))
 
($ newline)
 
($ for-each print
   $ list 1 2 3)

($ for-each print
   $ map cons '(1 2 3) $ list 4 5 6)

単に自前で分解するのをやめてsyntax-caseに頼っただけとも言う。前回同様、mosh、Ypsilon、Sagittariusで確認。 reverseをreverse!にappendをappend!するときっとメモリ節約。処理系が対応していればだけど。

Haskell風の$マクロをR6RSで

ChatonのGauche部屋を見ていて、Shiroさんが$を多用しているなぁと思い、流行は$なのだろうかと勘違いして書いてみた。R5RSで動くやつはGaucheにあるので、R6RSのsyntax-caseを使って。

(import (rnrs))
(define-syntax $
  (lambda (x)
    (define (build k es)
      (define $ (datum->syntax k '$))
      (define (build-es es)
 (let loop ((es es) (r '()))
   (cond ((null? es) (reverse r))
  ((and (identifier? (car es))
        (free-identifier=? $ (car es)))
   (append (reverse r) (list (loop (cdr es) '()))))
  (else
   (loop (cdr es) (cons (car es) r))))))
      #`(#,@(build-es es)))
    (syntax-case x ()
      ((k es ...)
       (build #'k #'(es ...))))))

(define (print . args)
  ($ for-each display args) (newline))

($ newline)

($ for-each print
   $ list 1 2 3)

なんというか、syntax-caseを使っているのは単にS式を直接扱いたかっただけという・・・僕の頭ではマクロ展開中に値を貯めてとか、分解してとかが無理だった・・・
動作はmosh、Ypsilon、Sagittariusで確認。恐らく、syntax-caseの動作としては信頼が出来る順に確認してるはず(moshはpsyntax使っているので多分マクロ周りの信頼が高い、はず・・・)

マクロ展開中に式を分解したりするのってどうやって考えれば身につくのだろうか？低レベルのマクロが書けると面倒になってS式そのままいじってしまう・・・

sxpathメモ その2

XSDをサポートするモジュールを書いていて、名前空間付きのsxmlをsxpathでいじる必要があった。すっかりどうやっているのかを忘れてググッたら自分のページが出てきた。っが、いまいち何がどうなっているのか詳しくなかったので、もう一回書くことにする。
ちなみに、これがその1

以下のコードを実行する。(sample.xsdはXSDで記述されたXMLファイルである)

(import (rnrs)
 (text sxml ssax)
 (text sxml sxpath)
 (sagittarius control)
 (pp))

(define-constant namespace '((xsd . "http://www.w3.org/2001/XMLSchema")))
(call-with-input-file "sample.xsd"
  (^p 
   (and-let* ((sxml (ssax:xml->sxml p namespace))
       (path (sxpath "//xsd:schema" namespace))
       (doc  (path sxml)))
     (pp sxml)
     (pp doc))))
#|
Output:
(*TOP* (@ (*NAMESPACES*
            (xsd "http://www.w3.org/2001/XMLSchema")))
       (*PI* xml
             "version=\"1.0\" encoding=\"ISO-8859-1\" ")
       (xsd:schema
         (xsd:element
           (@ (name "shiporder"))
           (xsd:complexType
             (xsd:sequence
               (xsd:element
                 (@ (type "xs:string") (name "orderperson")))
               (xsd:element
                 (@ (name "shipto"))
                 (xsd:complexType
                   (xsd:sequence
                     (xsd:element
                       (@ (type "xs:string") (name "name")))
                     (xsd:element
                       (@ (type "xs:string") (name "address")))
                     (xsd:element
                       (@ (type "xs:string") (name "city")))
                     (xsd:element
                       (@ (type "xs:string") (name "country"))))))
               (xsd:element
                 (@ (name "item") (maxOccurs "unbounded"))
                 (xsd:complexType
                   (xsd:sequence
                     (xsd:element
                       (@ (type "xs:string") (name "title")))
                     (xsd:element
                       (@ (type "xs:string")
                          (name "note")
                          (minOccurs "0")))
                     (xsd:element
                       (@ (type "xs:positiveInteger") (name "quantity")))
                     (xsd:element
                       (@ (type "xs:decimal") (name "price")))))))
             (xsd:attribute
               (@ (use "required")
                  (type "xs:string")
                  (name "orderid")))))))
()
|#

sxpathに名前空間を渡しているのに、何も返してこない。これに昨日30分くらいはまった。これは指定している名前空間がまずくて、正しくは以下のものを渡さないといけない。

'((xsd . "xsd"))

sxpathに渡される名前空間は、ssaxのそれとは違い、「XPath内にある名前空間の解決」に使われる。つまり、上記のコードで言えば、"//xsd:schema"の部分の"xsd:"である。この部分が、「渡された名前空間のcar部」で、「cdr部は操作するSXMLのエレメントの名前空間」になる。
なので、渡されたSXMLがフルネーム(ここではURIを指す)で修飾されていれば、上記のコードのような名前空間を渡しても問題ない。
この仕様のいいところは、名前空間さえ正しく指定してやればXPathを変更せずに異なる名前空間プリフィックスが処理できること。たとえば、上記のSXMLのプリフィックスがxsとかでも、'((xsd . "xs"))を渡してやれば、XPathの修正は要らない。
嫌なところは、ssaxに名前空間を渡してでパースされたSXMLと非常に相性が悪いこと。
これは、挙動からの推測だが、この名前空間の解決はXPathでのみ発生していて、SXPathでは起きないみたい。なので、"//xsd:schema"の部分を'(// xsd:schema)とすると名前空間なしでも値が返ってくる。この奇妙なチグハグ感もなかなか「トリッキーなライブラリを使ってるぜ！」的な陶酔感をかもし出していていい感じではある。(正直勘弁してほしいが・・・)

その1のページで言及されているメールのリプライに答えというかsxpathにおける名前空間の扱いが書いてあるので、単に蛇足ではあるが。

R7RSの6th Ballot

ザーッと目を通した。

とりあえず、この辺は変更されないだろうと当たりをつけたもの、もしくは変更されてもあればあった出便利なものを実装。
実装したものは以下：

• ライブラリ名に数字を使用可能にする
• ドラフトの6には符号なし正確な整数とあったので、一応Bignumも入れてある
• (exit #t)でEXIT_SUCCESSを返す。
• (exit 0)と書くよりは確かに分かりやすい
• vector-appendを追加
• bytevector-appendを追加
• レコード型のequal?
• 再帰的に中身を見るように変更
• それに伴ってeqv?もちょっと変更
• utf8->stringとstring->utf8のオプショナル引数
• ついでに、string->bytevectorとbytevector->stringにも追加
• UNICODEを6.1.0にアップデート
• string->vectorとvector->stringのオプショナル引数

とりあえず、残りというか、include-library-declarationsとかは後回し。正直残り数日の間で消えてほしいなと思ったり・・・

Racketが異様に速い

Sagittariusはfibを走らせる程度ならGaucheやYpsilonと同じくらいの速度で走るのだが、Racketはさらにその倍くらいの速度が出る。
正直、なにこれ？状態なのだが、ちょっとテストコードを書いてみてなんとなくどうやっているのかが分かった。(追いつけるという意味ではない)。
以下がテストコード。

#include 

SgObject fib(SgObject n)
{
  if (Sg_NumLt(n, SG_MAKE_INT(2)))
    return SG_MAKE_INT(1);
  return Sg_Add(fib(Sg_Sub(n, SG_MAKE_INT(1))),
  fib(Sg_Sub(n, SG_MAKE_INT(2))));
}

int main(int argc, char **argv)
{
  int n = atoi(argv[1]);
  GC_INIT();
  printf("%d\n", SG_INT_VALUE(fib(SG_MAKE_INT(n))));
  return 0;
}

Schemeじゃないじゃん！イメージとしては、SchemeのコードをCにしただけ。ちなみに、以下のコマンドで実際に動くバイナリが出る。(メモリアロケートしてないからGC_INIT()は要らないんだけど)

% gcc -O3 test.c -o fib `sagittarius-config -I` -DHAVE_CONFIG_H -lsagittarius `sagittarius-config -L` -lgc

-DHAVE_CONFIG_Hとかちょっとダサいが、まぁそれは置いておく。(0.3.3辺りからいけるはず、ただ明文化はあえてしてない)
これでできた実行ファイルを実行するとRacketより多少速く動いた。ということは、Racketはこれに+α程度の処理をくっつけた何かしらで動いているということなのだろう。バイトコード動かすVMだと思っていたのだが、違うのだろうか？

さて、ここからは考察。
JITを実装していて気づいたことがあって、

1. VMオプコードのディスパッチは処理時間をそんなに悪化させていないということ
2. FRAMEとRETインストラクションで起きる継続フレームのPUSHとPOPがやたら遅いということ

2番目は現状のVMを貫くならどうしようもなくて、やれそうなこととしては継続フレームのサイズを減らすことくらいなのだが(現状では6ワード)、正直現状では削れて1ワードかなぁといったところ。しかも、その1ワードはfibを走らせるだけなら使われることはない部分だったりする。
ものすごく気合を入れて頑張るなら、上記のプログラムは末尾再帰に置き換えることができるので、コンパイラがそんな雰囲気を感じたら、置き換えるようにするとかだろうか？そうすればFRAME命令はなくなるし、速度も改善されるが、そうするとプログラムが書いてある通りにコンパイルされてないよな？(やれるやれないは別にして)
(どうでもいいのだが、Racketでfibを末尾再帰で書いても速度が2倍弱程度しか改善されない。Sagittariusでは50倍くらい。いろいろ不思議な処理系だ)

Cygwinのmprotect

mprotectだけではなくposix_memalignもなのか、さらにこれがCygwin限定なのか他のUnix系環境もなのか調査してない。
(少なくともCygwinのposix_memalignはあるサイズを境に同一のアドレスを返すっぽいが)

何が問題か？とりあえず2つほど見つかっていて、

• mprotectが失敗する
• posix_memalignがなぜか重複したアドレスを返す

1つ目はページ境界の問題かなぁとおも思っていたりするので(でもposix_memalignでページサイズ割り当ててるよなぁ？)ちょっと保留。
2つ目は正直意味不明だが、10回くらい4096バイトを割り付けると9回目と10回目が同一のアドレスを返す。Cygwin環境だとヒープサイズが著しく少ないのでそれがあるのかもしれないが。

とりあえず、2つ目を考える。(もし最大４Mくらいしか使えないって言われると後々問題になるが、)現在１つのクロージャに1つのページを割り付けている。実際に使用されるサイズとしては10分の1程度に収まることが多いのにも関わらずだ。(デバッグ用のトレースとかつけると10倍に膨れ上がるけど。)
なので、とりあえずメモリの管理をもう少し切り詰めてやる必要がある。おそらく8バイト境界に開始位置をそろえてやればいいと思うので、割り付けたメモリを細切れに使うようにしたい。JITコンパイルに使用しているXbyakはその辺も可能みたいなので、メモリ管理を自前でやるように修正する。

速度面でだんだん不満になってきているのだが(JITしてもあんまり改善していないので)、最適化をかける前にきっちり動くようにしておきたいというのもある。我慢我慢。

JIT苦戦中

正直これだけ苦労してまで入れる意味はあるのだろうかと思い始めていたりはする。他の処理系に速度で差をつけるという意味では重要なのかもしれないけど、いまいち速度も出てないし・・・

とりあえず、現状では末尾再帰が上手いこと動かない場合がある。理由もある程度分かっていて、RETが一回足りてない(もしくは多すぎる)。 ただ、いまいち解決方法が分からない。う～ん。

ネイティブ内でVMのスタックの状態を保つようにしたらべらぼうに遅くなった。一応やらないよりは速いかくらい。あまりに切ないなぁとは思いつつ。なぜスタックの状態を保つようにしたか？これはcall/ccとかdynamic-windとかのVMのスタックと(現状)切っても切れない関係の機能をなんとかするため。でも逆に言えば、JITコンパイル時にこれらの呼び出しが無ければCスタックだけ使ってもOKなんだよねぇ？と思っているので(ちょっと自信ない)、その辺は頑張れば最適化できそう。

以下はとりあえずメモ。(一応ソースのコメントにも書いてるけど、頭の中を整理する意味合いも含めて)
【X86】(以外はまだ手をつけてない)

• レジスタは通常のeax、ecx、edx以外にebx、esi、ediも使う。
• eaxは基本的にVMのacレジスタをエミュレート。
• ecxとedxは汎用的に基本的にいつでも使用可能(なはず)。
• ebxは引数で渡されてくるVMのインスタンスを保持
• esiはargc引数、ediはargs引数を保持。
• ただ、ediに関しては別の用途に使った方がいいかもしれない。現状ではあんまり効率よく使われていない。
• 書けるところはアドレスべた書き。
• GREF_CALLとか
• Scheme手続きの呼び出しにはVMのスタックを使用。
• 遅い(VMのスタックを整備する必要がある)
• フレームを入れたり出したりするのが致命的
• スタックに直接関係ない普通の手続きはVMのスタックを使わないべき。
• 組み込みインストラクション(CARとかCDRとか)がまだ手抜き実装。
• インライン展開して無い。Cの関数呼んでる。
• これは後回しでもいいだろう。

まだ、ソース上にeaxとedxべた書きなので、X64対応するまでにはもう少し抽象度を上げておきたい。(楽したいという)
なんだかランタイムさえあればアセンブラ書ける気がしてきた。(気がしてるだけ)。

JITアイデアメモ

そんなにナイーブな実装ではないとは思いたいのだが、速度が出ない。多分いたるところでVMのレジスタを参照したり書き換えたりしているからだろう。(主にスタックポインタなんだけど)
GaucheのJIT予備実験を見る限り、(多分)似たような壁にぶち当たっていると思われる。
Gauche:VMの最適化:JIT:予備実験

とりあえず、現在のところJITコンパイルには2パス使っていて、最初にVMインストラクションを舐めて最適化できそうな情報を集めてから実際にコンパイルしている。というか、これやらないとJUMP命令の飛び先が取得できないので(+方向だけなら問題ないんだけど、-方向があるので)。
この1パス目をうまく使えば、どのPUSH命令が実際にCのスタックが必要かどうかがわかる(はず)。これが分かれば、末尾呼び出しの際に、現在与えられている引数フレームを再利用可能になる。であれば、わざわざVMのスタックをいじる必要がなくなるのではないだろうか？問題はどのPUSH命令がどの位置をいじる必要があるのかということさえも引っ張り出さないといけない点ではあるのだが・・・

とりあえずfibとtak程度が5から10倍程度高速になるように頑張ってみてから実際にJITを入れるか考えよう。上記の方法だと継続をどうするとかの問題が出てくるわけだし・・・でも、Racket並みの速度を出すには必須だろうし・・・


それにしても、汎用レジスタ6本て・・・せめてもう3本あればなぁ・・・(x86の話)

JIT実装中

目指せRacketの速度ということでJITを実装中。とりあえず、X86でfibとtakが動くようにしてみた。(どうでもいいが、X86はレジスタの本数が少なすぎて辛い。やりくりを考える主婦の気分を味わえる)。

とりあえず方針として、

• Xbyakを使ってC側で実装する。
• コンパイル中に見つかったクロージャーもコンパイルして呼び出しは可能な限りネイティブにする。(これの恩恵はでかい、実装がかなり楽）
• 他の手続き呼び出し用引数フレームはVMのスタックを使う。

こんな感じでやっている。末尾再帰をどう実装しようとか(クロージャーはいいけど、問題は組み込み手続き)、スタックオーバーフローとかまったく考えてない状態ではある。

まぁ、気になるのはパフォーマンスだろう。以下のコードでベンチマークを取ってみた。

(add-load-path "sitelib")
(add-load-path "lib")
(import (sagittarius vm) (time))
(define (fib n)
  (if (<= n 2)
      1
      (+ (fib (- n 1)) (fib (- n 2)))))
(print "vm")
(time (fib 35))
(newline)
(jit-compile-closure! fib)
(print "native")
(time (fib 35))
(newline)

(define (tak x y z)
  (if (not (< y x))
      z
      (tak (tak (- x 1) y z)
           (tak (- y 1) z x)
           (tak (- z 1) x y))))
(define (run-tak count)
  (do ((i 0 (+ i 1)) 
       (r (tak 18 12 6) (tak 18 12 6)))
      ((= i count) r)))

(define count 200)
(print "vm")
(time (run-tak count))
(newline)
(jit-compile-closure! run-tak)
(print "native")
(time (run-tak count))
(newline)

JITという割りに、VMは現状では勝手にコンパイルしないので手動でコンパイル。テストだけならこの方が便利。っで、結果は以下(CoreDuo 1.6Ghz, Cygwin on Windows XP)

$ ./build/sash.exe test.scm
vm
;; (fib 35)
;;  3.093750 real    2.797000 user    0.000000 sys

native
;; (fib 35)
;;  1.875000 real    1.859000 user    0.000000 sys

vm
;; (run-tak count)
;;  2.015625 real    1.875000 user    0.000000 sys

native
;; (run-tak count)
;;  1.312500 real    1.187000 user    0.000000 sys

速くはなっているんだけど、驚くほどということも無く。なんか、頑張ればVMとコンパイラの最適化で叩きだせるんじゃね？というくらいの速度改善なのがなんとも悲しい。問答無用で5倍くらい速くなるならやる気も格段に違うんだけど・・・
ベンチマークのコードを多少修正。(Gambitベンチのと同じ回数まわすようにした)

Muiden and Pampus

Be activeの第２弾。(要はmeetupに行っただけとも言うが)、Daytripに行ってきた。
場所はAmsterdamからバスで２０分くらいのMuidenとそこから更にボートに乗って１５分くらいのところにある要塞跡地Pampus。

Muidenは古い感じのオランダの町並みを残した港町ちっくな場所。要塞跡地Pampusは元はアムステルダムに運河が開通する前に物資を経由させるための人工島だったらしい(ガイドの兄ちゃんは英語が堪能じゃなかったのでちと理解できなんだ)。

以下は写真。

旅の始まりは、アヒルの親子から(関係はない）

Pampusに行くためのボートを待つ

 船乗り場の近くにあった城。待ち時間３０分を潰すために17.50ユーロ払う気にはなれず、中には入っていない。

目的地のPampus。iPhoneのカメラでは・・・

門構え？

この辺りで僕の写真を撮ろうという情熱が尽きた(早

夕食もMuidenで食べて帰る。レストランはいいけど選ぶものがなかった感じ。

どうでもいい話。
同じ英語でもスコットランドとイングランドではアクセントが違うのだが、発声の仕方まで違うとは知らなかった。(聞いたわけではないのだが)。イングランド出身の女声はすごく鼻に息が通っていた感じ。合唱で言えばこもる声ってやつ？よく言えば響きがあるけど、芯がない感じのあれ。逆にスコットランド出身の人は通る声というか、そんな感じ。

どうでもいい話その２。
スウェーデン出身の人がいたのだが、スウェーデンをスイスと勘違いしてドイツ語を話す国だと思っていた自分。意味不明である。どっちもSWで始まるからきっとそんな勘違い(恥

どうでもいい話その３。
日本人名前は聞き取り難いらしい。きっと音が３つもあるからだろうけど。自己紹介をするたびに聞きなおされた。

BoehmGCとCMakeとMSVC

あんまりCMakeは関係ないかも。

BoehmGCをMSVC上のマルチスレッドでコンパイルしようとすると/MDオプションによって暗黙的に定義される「_DLL」というマクロを期待している。困る。という話。

事の発端はMSVCR100.dllを依存関係に入れたくないために/MTオプションを指定したのが始まり。とりあえず、コンパイルするとビルドの途中で0xc000007bといって落ちる。いろいろ調べた結果(たどり着くまでに2時間くらいかかった)、gc.dllが何もエクスポートしていないことに問題があった。
っで、gc_common_macros.hを覗いてみると、上記の「_DLL」というのが定義されていないとGC_DLLが定義されずおかしなことになる。じゃあ、面倒なので外部から「GC_DLL」を定義しちゃえってやったら、今度はBoehmGC内のテストのビルドでリンカーエラーが起きる。もうね、いたちごっこだね。

とりあえず、どうしたか。CMakeLists.txtの最終行にあるADD_SUBDIRECTORYをコメントアウト。 BoehmGCのテストなんて走らせたこと無いから問題ないだろう。信用する。
しかし、基本フルオートでビルドしてたのにMSVCのみ手を入れるのは嫌だなぁ。どうしよう。ビルド時に作り直すようにしろということか？面倒くさい・・・

逆FizzBuzz問題

逆FizzBuzz問題なるものを発見した。元ネタ５月だから遅れること２ヶ月くらいか。
逆FizzBuzz問題をTrieでトライ - athosの日記

とりあえず、Schemeで解いてみた。(#0=記法をサポートしてれば、どの処理系でも動くはず・・・)

#!/bin/env sash
(import (rnrs) (srfi :2 and-let*))

(define (inverse-fizzbuzz ls)
  (define one-cycle-count 7)
  (define inverse-fizzbuzz-list
    '#0=((fizz . 3) (buzz . 5)  (fizz . 6)
  (fizz . 9) (buzz . 10) (fizz . 12)
  (fizzbuzz . 15) . #0#))
  (define (check-input ls)
    (let* ((len (length ls)) (max-try (ceiling (/ len one-cycle-count))))
      (define (count-up s c) (if (eq? (car s) 'fizzbuzz) (+ c 1) c))
      (let loop2 ((in ls) (tmpl inverse-fizzbuzz-list)
    (r '()) (times 0)
    (matched? #f) (tried 0))
 (cond ((null? in) (reverse! r))
       ((eq? (car in) (caar tmpl))
        (loop2 (cdr in) (cdr tmpl)
        (cons (+ (cdar tmpl) (* 15 times)) r)
        (count-up (car tmpl) times)
        #t
        (count-up (car tmpl) tried)))
       ((> tried max-try) #f)
       (else (loop2 ls 
      (if matched? tmpl (cdr tmpl))
      '() 0 #f
      (count-up (car tmpl) tried)))))))
  (and-let* ((r (check-input ls)))
    (cons (car r) (last-pair r))))

(print (inverse-fizzbuzz '(fizz)))
(print (inverse-fizzbuzz '(buzz)))
(print (inverse-fizzbuzz '(fizz buzz)))
(print (inverse-fizzbuzz '(buzz fizz fizz)))
(print (inverse-fizzbuzz '(fizz fizz buzz)))
(print (inverse-fizzbuzz '(fizz buzz fizz fizzbuzz)))
(print (inverse-fizzbuzz '(fizz fizzbuzz fizz)))
(print (inverse-fizzbuzz '(fizz fizzbuzz fizz fizz)))

reverse!はSRFI-1だったかな？まぁいいか。
あんまり美しくないなぁ。最初はSRFI-41使ってパターンマッチ的に解こうかなぁとも思ったんだけど、不正なリストを渡された際にどうしようかなぁとか思ってやめた。

家事と家事の合間に解いたのにしては上出来だと思う・・・

なんとなく、REPLに色をつけてみた。

別に0.3.4固有のものでもないのだけど、なんとなくREPLの画面に色をつけてみた。
WindowsのDOS窓は無理だけど。

(import (sagittarius vm)
 (sagittarius vm debug)
 (sagittarius interactive))
(cond-expand
 ((not windows)
  ;; colouring
  (define-syntax with-color
    (lambda (x)
      (syntax-case x ()
 ((_ color expr more ...)
  ;; on emacs it's useless.
  (if (getenv "EMACS")
      #'(begin expr more ...)
      #'(dynamic-wind
     (lambda () (display color))
     (lambda () expr more ...)
     (lambda () (display "\x1b;[m"))))))))
  (define-syntax with-color-red
    (lambda (x)
      (syntax-case x ()
 ((_ expr more ...)
  #'(with-color "\x1b;[1;31m" expr more ...)))))
  (define-syntax with-bold
    (lambda (x)
      (syntax-case x ()
 ((_ expr more ...)
  #'(with-color "\x1b;[1m" expr more ...)))))
  (define (printw . args) (for-each write/ss args) (newline))
  (current-printer (lambda args
       (with-bold
        (for-each printw args))))
  (current-exception-printer
   (lambda (c)
     (define (print-stack-trace)
       (let* ((stack (get-stack-trace-object))
       ;; skip the first get-stack-trace-object itself
       ;; and print-stack-trace
       ;; the last 2 are always evel and #f so skipt it as well
       (interesting (if (null? stack) stack (cddr (reverse! (cddr stack))))))
  (unless (null? interesting)
    (print "stack trace:")
    (do ((i 0 (+ i 1))
  (stack interesting (cdr stack)))
        ((or (= i 20) (null? stack)))
      (let* ((record (car stack))
      (index (- (car record) 2))
      (proc  (caddr record))
      (tmp   (cadddr record)))
        (format #t "  [~a] ~a~%" index proc)
        (when (and tmp (not (null? tmp)))
   (let* ((src (last-pair tmp))
   (info (source-info (cdar src))))
     (display "    src: ")
     (let ((s (call-with-string-output-port
        (lambda (o)
          (write/ss (unwrap-syntax (cdar src)) o)))))
       (if (> (string-length s) 50)
    (print (substring s 0 50) " ...")
    (print s)))
     (when info
       (format #t "    ~s:~a~%" (car info) (cdr info))))))))))
     (with-color-red
      (print (describe-condition c)))
     (print-stack-trace)))
  (current-prompter (lambda () (with-color "\x1b;[32m" (display "sash> "))))
  )
 (else #f))

ソース情報とか取得できないけど、いいかという感じでは動く。ソースもとるようにした。
これだけだとつまらないので、一応0.3.4から入った機能。「.sashrc」というファイルを$HOMEに置いて上記のソースを書いておけばREPL起動時に勝手に読み込んでくれる。このファイルはREPLだけが読み込むので、スクリプトでは無駄なライブラリのロードは起きない。

Sagittarius 0.3.4リリース

Sagittarius Scheme 0.3.4がリリースされました。
今回のリリースはメンテナンスリリースです。

修正された不具合

• bytevector-***-set! (*** はs32、s64)にfixnumのマイナス値を与えるとエラーを投げる不具合が修正されました。
• (lambda ())及び(begin)が不正なクロージャを返す不具合が修正されました。現在は未定義値を返します。
• スタックサイズを超える引数をapplyするとSEGVする不具合が修正されました。
• bytevector->integerがオプショナル引数を無視する不具合が修正されました。
• (net oauth)ライブラリでエラーレポート手続きが不正な例外を投げる不具合が修正されました。
• SEFI-1ライブラリがeveryをエクスポートしていない不具合が修正されました。

新たに追加された機能

• SRFI-17 一般化されたset!がサポートされました。
• 64ビット環境でのビルドがサポートされました(Windows 7、及びUbuntu 64bitで動作確認)

改善点

• コンパイル済みキャッシュのディレクトリ構造が32ビットと64ビット混在環境を許可するように変更されました。
• SRFI-1ライブラリの多くの手続きがimproper listを与えると例外を投げるように修正されました。(SRFI-1に準拠した形になります)
• fold-right及びunfoldが末尾再帰するように書き直されました。

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

• Gaucheライクなrefや変換を提供する(sagittarius object)が追加されました。
• REPL内でドキュメントを参照可能にする(sagittarius interactive support)が追加されました。
• eql specializerライブラリ(sagittarius mop eql)が追加されました。

新たに追加されたドキュメント

• (text sxml sxpath)がドキュメント化されました
• (rfc uri)がドキュメント化されました
• (util bytevector)がドキュメント化されました

マクロ、マクロ、マクロ・・・

マクロの不具合を少しでも潰していこうと思っているのだが、いろいろげんなりしてきた。

とりあえず、現状でもっとも問題になっているのは、free-identifier=?とbound-identifier=?が正しく動いていないこと。後者はあんまり気にしていないんだけど、前者がまずい。(どうでもいいけど、この2つの手続きは、手続き名から何をするのかあんまり想像できない気がする)。

free-identifier=?は(理解が間違っていなければ)、引数としてとった2つの識別子が同一のオブジェクトを指していれば#tを返す手続き。基本的にグローバルなオブジェクトなら単に名前が一緒とかで十分なんだけど、ローカルに束縛されたものの解決が現状うまくいっていない。

マクロ内で束縛した環境はとりあえず放っておいて、コンパイル時環境だけ探せばいいだろうか？とりあえずやってみることにしよう。

構造体のアライメント

X86_64な環境で構造体のアライメントが不思議な現象を起こしている気がする。
(そういえば、以前FFIをサポートした際に問題になるかも的なことを書いたような・・・)

以下のコードが予想と違う。

#include <stddef.h>
#include <stdio.h>

struct align_struct
{
  int value1;
  struct {
    int value2;
    char *str;
  } inner;
};

int main (int argc, char **argv)
{
  printf("offsetof: %d\n", offsetof(struct align_struct, inner));
  return 0;
}

結果が、32bitのCygwin(多分32bitならどれでも同じ、と信じる)では、4。これは期待通り。で、X86_64では8。これが8になられると大問題で、なぜかといえば、以下のコードはどちらの環境でも4を返すから。

#include <stddef.h>
#include <stdio.h>

struct align_struct
{
  char c;
  int  x;
};

int main (int argc, char **argv)
{
  printf("offsetof: %d\n", offsetof(struct align_struct, x));
  return 0;
}

何か勘違いしているのかもしれないのだが、FFIのサポートにlibffiを使っていて、アライメントの計算はそこにどっぷり依存している。

中身を展開してやったら期待通りの値になった。構造体のアライメントが変わってくるのかなぁ？単にフラットにしてくれれば問題ないのに。libffiをもう一回見直すか・・・

64bit environment

I have received an email that said Sagittarius build process crashed on Open SUSE 64 bit. This is the first email I've got, yes, I was really excited! And at the same time, I felt the time had come at last.

I was maybe avoiding to apply 64 bit environment, the reason why is my main environment is Cygwin and I don't know if it can be 64 bit or only 32 bit. (As far as I know, it's only for 32 bit). So I didn't have it until now. (even thought my computer at my work is 64 bit hehe).

So I installed Open SUSE 64 bit into my VM (at my work), and build version 0.3.3. Yes, it broke as I expected. It seems cache problems. So I have checked the both writing and reading cache, then I saw the problem. The cache must be read as intptr_t or word size, but it used int (on 64 bit environment this is somehow not the size of pointer). So it read something weird value and SEGV. I thought if it was just this easy, then I can send a patch. Of course it wasn't this much easy. After I fixed it and ran the test, a lot of things complaining, and one of the test caused SEGV as well.

Well, most of the failed tests were related fixnum operation which I used int instead of long. So I fixed it, but I gave up to send a patch because the procedures are generated from stub files and if I make a patch, it would be huge.

I have also noticed that on 64 bit environment, cache files are huge. How huge? It's as twice as bigger than 32 bit environment. Why? It's because the word(pointer, not a document) size, even though most of the serialized values need only 32 bit length. Hmm, I guess I need to reduce the size.

The next release 0.3.4 should be run on 64 bit. (I still need to fix some bugs, though...)

3,2,1,0 バグッてハニー

コンパイラに少し手を入れたらなんだかSEGVが起きるようになった。
まぁ、普通はいじった部分がおかしいだろうということになるのだが、どうも様子がおかしい。

Cygwinではいまいちなにが起こっているのかわからなかったのでUbuntuで走らせてみてなんとなく見えてきた。(CygwinだとSEGVが起きてもSEGVだと知らせなかったり、意味不明に突然死ぬので)。

とりあえず、再現する方法と、回避できる方法がある。
再現する方法は非常に簡単で、make testをマルチスレッドバージョン(デフォルト)で２回走らせること。２回目はキャッシュを使うのだが、キャッシュを使うとなぜかアウト。
回避するには、test/tests.scmに手を入れてテストをマルチスレッドで行わないこと。こうするとなぜかコンパイルされたキャッシュが正しく作られるっぽい。(複数回走らせてもOKな上に、マルチスレッドで走らせてもOKになる)。

正直意味不明ではあるのだが、とりあえず仮説を立てる。マルチスレッドにしなければ動くということは、コンパイル結果自体には問題はなくて、(実際、キャッシュ読み込みで死んでるわけだし)、キャッシュ作成時に問題が起きている、はず。
ぱっと考え付いたのは以下の３点。

• コンパイラをいじったために速度が改善されて今まであまり起きなかったロック取得部分の競合でおかしくなった。
• コンパイル時間が増大したためロック取得で競合が起きるようになった。
• コンパイルをいじったためGCのタイミングが変わり、今までは起きなかったメモリエラーが起きるようになった。

ロック周りが問題になっているなら、多分２番目・・・。ただ、起きているライブラリはテストケース内では１ファイルででしか使われていないので、読み書きは同一のスレッドで行われているはず。
３つ目はありえそうで、実際つい最近８要素いるはずの配列が７要素しかメモリを割り付けてなかったというのを発見した。同様のことが起きてて、シングルなら回収されないけどマルチだと回収されちゃったっていうのはあるかも。
さて、どうしたものか・・・

解決した。