writeがスタックを食いつぶす

Gaucheのソースツリーを眺めていて、writeがCのスタックを食いつぶすのを直したというようなコミットを見つけた。同じことが起きるよなぁと思いつつ、とりあえずテスト。以下は使用したコード(R7RS形式なのは最後にチェックしたのがChibiだから。当然Sagittariusでも動く)

(import (scheme base) (scheme write))
(define (call-with-string-output-port proc)
  (call-with-port (open-output-string)
    (lambda (p) 
      (proc p)
      (get-output-string p))))

(display
 (let loop ((cnt 0) (ls '()))
   (if (< cnt 1000000)
       (loop (+ cnt 1) (list ls))
       (string-length (call-with-string-output-port
                       (lambda (p) (display ls p))))))) 
(newline)

とりあえず、どのくらいの処理系がこれをSEGVを起こさず処理するのかチェック。以下は結果。

200002を正しく返した処理系

Chez Scheme, Racket (plt-r6rs), Larceny (R6RS)

SEGVもしくは処理が終わらなかった処理系

Sagittarius, Chibi, Mosh, Ypsilon

動く処理系で、ソースを確認できるのはRacketとLarcenyだけなので、とりあえず確認してみた。

Larcenyはなぜ動いているのか正直分からなかった。コードがSchemeで書かれているので、ひょっとしたら最適化でうまいこと動いているのか、Cで書いていない分スタックの消費が少なくなっているのかは不明。

Racketはスタックの底にたどり着いたらlongjmpするという荒業だった。たしかに、ありだよね。

Gaucheは0.9.4は再帰呼び出しをせず、gotoで済ますという方法。ただ、そのためにメモリを結構使用するんじゃないかなぁと思ったり。

Sagittariusは(ユニットテストの)メモリの使用量が半端ないので、可能な限り省エネで行きたいところ。なので、やるならRacket方式か、気合でなにか良い案思いつく必要がある。longjmpのオーバーヘッドってどれくらいなんだろう？

Sagittarius 0.3.8 リリース

Sagittarius Scheme 0.3.8がリリースされました。今回のリリースからR7RSドラフト7がサポートされます。ダウンロード。

修正された不具合

• ローカルマクロをマクロ内で定義した際にSEGVが起きる不具合が修正されました。
• (dbd odbc)を用いて存在しないレコードを更新しようとした際にエラーが投げられる不具合が修正されました。
• get-bytevector-allがソケットポートからデータを全て読み込まない不具合が修正されました。
• binary-port?及びtextual-port?がカスタムポートに対して適切に動作しない不具合が修正されました。
• #n=をリーダが適切に読み込まない不具合が修正されました。
• remainderの第一引数に浮動小数点数を与えるとSEGVが起きる不具合が修正されました。
• (sqrt -1)が非正確数を返す不具合が修正されました。
• (zero? 0.0+0.0i)が#fを返す不具合が修正されました。
• -1iのような形式の複素数が正しくない符号を返す不具合が修正されました。
• ライブラリのバージョンに0が使えない不具合が修正されました。
• ライブラリバージョンリファレンスの形式がエラーを投げる不具合が修正されました。
• appendが引数1つで呼び出された場合に()を返す不具合が修正されました。
• 全ての未束縛exportが束縛された値を持つよう修正されました。

改善点

• (cond ((assq a b) => cdr))の形式をコンパイラが可能であれば組込みインストラクションを使うように改善されました。
• ビルドプロセスが改善されました。
• 多くの依存ライブラリがFIND_PACKAGEを用いて検索されるようになりました。
• libffiが見つからなかった際にLinuxでもバンドルされたlibffiが使用可能になりました。（Ubuntu 32 bitでのみテストされています)
• ODBCライブラリのblob型ポートが作成時に全てのデータを読み取らないように変更されました。

新たに追加された機能

• リーダーマクロの有効範囲がファイル単位からポート単位に変更になりました。
• R7RSドラフト7がサポートされました。
• glob手続きが追加されました。
• sashの-Lオプションが-L'*'形式をサポートするようになりました。これはglobで見つかった全てのディレクトリをロードパスに追加します。

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

• SRFI-105が追加されました。#!read-macro=curly-infixで有効になります。#!curly-infixではないことに注意してください。

非互換な変更

• R7RSのライブラリが大幅に変更になりました。これらはドラフト5からの変更で、後方互換性はありません。

ブレインストーミング

考えをまとめるのに紙に書くのが面倒なのと、記録を残しておいた方がいい類のものなのでメモ。

以下のコードを考える。

(read (open-string-input-port "#!fold-case ABC"))
(read (open-string-input-port "ABC")) ;; こいつは何を返すか

恐らく書いている方の期待する結果はABCというシンボルだろう。だが、これは予想に反してabcを返す。(Sagittariusでは#!fold-caseは全部小文字にして返す) 。こんなの書くやついないよ！と思っていたのだが、意外なことに自分がこれではまったのでやはり問題かなと思うようになってきた。

何が問題か？

現状ではSagittariusはファイル単位でリードテーブルの切り替えを行う。っが、上記のようなものだと同一ファイル上でreadが走るのでファイル単位で行うと残念な結果になる。つまり、ファイルではなくポート単位で行う必要があるということになる。

どう直すか？

ポート単位にするというのは結構大掛かりな変更になる。現状の実装では、VMが現在のリードテーブルを保持して、loadが走る際にポートに保存、loadが終わったら保存したテーブルをVMに戻すという割と回りくどいことをしている。
これをポート単位にするにはどうすればいいのか？とりあえず簡単に思いつくのはVMが現在loadしているポートを保存するというもの。loadは必ずファイル単位で行われるので、現在のloadingポートが分かれば何とかなりそうである。となると問題になってくるのは、どの段階でポートにリードテーブルを持たせるかというもの。可能性としてあるのは、

1. ポート作成時。（全てのポートはリードテーブルを持つ）
2. リードテーブルを変更するようなものを検出したとき。（オンデマンド）

上記のようなコードだと、2つ目のポートに持たせるのは無駄以外のなんでもないような気がするので、やるならオンデマンドだろうか。

方針は決まったので実装するか。

この発想はなかった

Chibi-SchemeのIssue 149にあった面白い発想のdefineをsyntax-caseで実装してみた。

(import (rnrs))
#|
;; ※１
;; 投稿した2分後にsyntax-case一回だけでいけることに気づいた。
;; なので、コード直下のぼやきはこのコードに対してのもの。
(define-syntax define-function
  (lambda (x)
    (define (compose expr)
      (let loop ((expr expr))
        (syntax-case expr ()
          (((name . formals) body ...)
           (identifier? #'name)
           #'(define name (lambda formals body ...)))
          (((name&formals . rest) body ...)
           (not (identifier? #'name&formals))
           (loop #'(name&formals (lambda rest body ...)))))))
    (syntax-case x ()
      ((_ exprs ...)
       (compose #'(exprs ...))))))
|#
;; すっきしたバージョン。これなら処理系関係ない。
(define-syntax define-function
  (lambda (x)
    (syntax-case x ()
      ((k (name . formals) body ...)
       (identifier? #'name)
       #'(define name (lambda formals body ...)))
      ((k (name&formals . rest) body ...)
       ;;(not (identifier? #'name&formals)) ;; この行要らない
       #'(define-function name&formals (lambda rest body ...))))))

(define-function ((f x) y) (+ x y))

(print ((f 1) 2))

多少以上に余計な手間をかけているのだが、マクロ周りがR6RS準拠な処理系と違ってSagittariusでは識別子のリネームに制限がある。それは、同一のsyntax構文内でリネームを行わないと識別子が同じにならず、unbound variableエラーを投げるというもの。なので、上記は本来ならquasisyntaxを使ってもう少し分かりやすく書けるのだが（まぁ、どちらが分かりやすいかは人によるが）、Sagittariusで動かすために式を全部一緒に処理してやる必要がある。（※1のコード)

この制限はずっと気づいているし、問題だと思っているのだが、いかんせんスマートな解決方法が思い浮かばないのと、慣れてしまえば別に気にならないので放置してある。0.4.0辺りまでに直したいという思いはあるが、あるだけともいえる・・・（マクロ周りは本当に鬼やぜ）

さて、ようやく本題。上記のマクロがどのように展開されるかというのが個人的には面白いなぁと思ったという話。Chibiのissue見れば答えは載っているのだが、引数の個数にも寄るが、この構文簡易カリー化と取れなくもない。上記の手続きfは以下のように展開される。

(define f (lambda (x) (lambda (y) (+ x y))))

たとえば、SXPathはこんな感じの手続きをころころ作るのだが、実装を見てみると（当然なんだけど）明示的にlambdaをいっぱい書いている。でも、これ使えばそのわずらわしさから開放される！というわけだ。

僕自身、あまりそんな使い方しないんだけど、マクロ使えばこんなこともできちゃう！というちょっとした例。

R7RS対応

ドラフト7の範囲の実装が大体終わった。Chibi SchemeのR7RSテストケースもほぼ通るようになっている。（通らないのは、R6RSと競合する部分とFlonumの精度が決め打ちになっている部分と、R7RS上では不明瞭に見えてかつ僕がChibiの挙動の方がおかしいと思う部分）

他の人が仕様書に対して書いたテストというのは意外と自分ではチェックしない部分の挙動があったりしてバグ潰しに役立つということが分かった。実際、Chibiのテストケースを通るようにした際に6個くらいバグをつぶした。中にはSEGVを起こすようなのもあって、普段使わない、書かない系のコードというのの中にこそバグが含まれているというのがよく分かった。

現状でR7RS準拠度はevalが環境を破壊的に変更するのと（問題だとすら思っていない）、R6RSなのでbinary、textualポートの区切りがはっきりしている点を除けば全て準拠していると思う。Chibiですら対応していないinclude-library-declarationsも入っているｗ

今週末にリリース予定の0.3.8からR7RSドラフト7に対応しているという宣伝。

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

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定義を自動で作ることかなぁ。