How to write portable code on R7RS

There was a discussion (or rather question about) 'cond-expand'. I was also wondering about 'cond-expand' why it has 'library' form even though it can't help to write portable script (not a library).

Since draft 8 (or 9?), R7RS dropped 'import' syntax from (scheme base) which means users can't write the code like following;

(import (scheme base) (scheme write))

(cond-expand
 ((library (srfi :1))
  (import (srfi :1)))
 ((library (srfi 1))
  (import (srfi 1))))

(define (print . args) (for-each display args) (newline))
(print (iota 10 1))

Interestingly, this works most of the R7RS implementation (well, I only know Chibi and Sagittarius :-P) and Gauche (probably next release supports R7RS). However it's still not portable since the *correct* behaviour should be an error.

Then what is the proper way to make this portable? The answer is simple, just write the stub library like this;

;; somewhere load path whare your favourite implementation can search.
(define-library (srfi-1)
  (export iota)
  (cond-expand
   ((library (srfi :1))
    (import (srfi :1)))
   ((library (srfi 1))
    (import (srfi 1)))
   (else
    ;; To make code absolutely portable
    ;; you need 'begin' :)
    (begin (define iota ...))
    ))
 )

For me, it's inconvenient so I will probably not write strictly portable code on R7RS. Even WG1 member is asking to implement it the way how Chibi is doing now (not sure if this is about what I'm talking about though);

> As far as I can tell, there is no way in a program to use cond-expand to
> control what libraries get imported.

That appears to be correct. I consider that an oversight on the WG's part.
Chibi actually supports this, and I would urge you to support it too.
(from http://lists.scheme-reports.org/pipermail/scheme-reports/2013-October/003802.html)

Even though it's inconvenient, however, R7RS at least provides a way to write portable library which R6RS doesn't. For this perspective, it's not so bad (well, still I don't understand why it dropped 'import' and asking to go non-standard way even if it would be de-facto. If they think it's an oversight then they should put it on errata).

Port position for transcoded port

I'm planing to support port-position and set-port-position! for transcoded textual ports and checked some major R6RS implementation how they act. The result was rather interesting.

First of all, I write the implementations I checked and its result. (I don't put Sagittarius because it's obviously not supporting it yet :-P)

Petite Chez 8.4

#t
#t
3
�

Larceny 0.9.7

#t
#t
1

Error: no handler for exception #<record &compound-condition>
Compound condition has these components:
#<record &assertion>
#<record &who>
    who : set-port-position!
#<record &message>
    message : "position not obtained from port-position"
#<record &irritants>
    irritants : (#<INPUT PORT test.txt> 2)

Terminating program execution.

Mosh 0.2.7

#f
#f

Ypsilon 0.9.6-update3

#t
#t
3
�

Racket 5.2.1

#t
#t
3
�

The test code;

(import (rnrs))

(call-with-input-file "test.txt"
  (lambda (p)
    (display (port-has-port-position? p)) (newline)
    (display (port-has-set-port-position!? p)) (newline)
    (when (port-has-port-position? p)
      (get-char p)
      (display (port-position p)) (newline)
      (set-port-position! p 2)
      (display (get-char p)) (newline))))
#|
test.txt (UTF-8)
あいうえおかきくけこ
|#

Mosh doesn't support the port-position so test was skipped.Except Larceny, the other implementations simply set the position of underlying binary port. So it returned the invalid character. On the other hand, Larceny is checking the position of textual port and if it mismatches then raises an error. (although, if I change the setting position to 0, then it reads an invalid character, so seems not really working.)

I'm not sure which is the expected behaviour but at least the way Chez, Ypsilon and Racket are doing is easy enough to implement.

DBM用インターフェース

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

個人的には Sagittarius に欲しいライブラリは gdbm とかかな。 リレーショナルデータベースはちょっとしたスクリプトには豪華すぎる。 sqlite があるから気軽な用途にも使えるんだろうけど私は SQL とかようわからんし。
— (32) 齊藤敦志 (@SaitoAtsushi) October 18, 2013

GDBMは外部ライブラリが必要なのでWindows対応しづらいという点から直接のサポートは別の方法を取るとして、とりあえずインターフェースを作った。APIはGauche互換(というかほぼ流用)で、こんな感じで使える。

(import (rnrs) (dbm) (clos user))

(define-constant +dumb-db-file+ "dumb.db")

(define dumb-class (dbm-type->class 'dumb))

(let ((dumb-dbm (dbm-open dumb-class :path +dumb-db-file+
                          :key-convert #t :value-convert #t)))
  (dbm-put! dumb-dbm 'key1 #t)
  (dbm-get dumb-dbm 'key1)
  (dbm-close dumb-dbm))

Sagittarius本体でサポートするのはPythonのdbm.dumbに影響を受けた(dbm dumb)。ひょっとしたらGaucheのfsdbmみたいなのも入れるかもしれないが、当面は予定がない(訳：自分が使わない)

どうでもいい情報としては、DBMが開いてるかとかのチェックをCLOSの:beforeでやってること辺りか。わざわざcall-next-method呼ばなくてもいいので便利である。

Enbug

Even though 0.4.10 has just been released today I found a critical (caused SEGV) bug.... ;-(

The code is like this;

(import (rnrs))
(define save #f)
(let* ([p (make-custom-binary-input/output-port
    "custom in"
    (lambda (bv start end)
      (bytevector-u8-set! bv start 7)
      (set! save bv)
      1)
    (lambda (bv start end)
      1)
    #f #f #f)])
  (put-u8 p 10)
  (flush-output-port p)
  (get-u8 p)
  (close-port p))
(print "SEGV!!")
(print save)

I've never seen such use case however SEGV is worse than unexpected result (it is unexpected but you know...).  I know exactly why this happens and how to resolve this. The reason why I'm writing this is making this for my admonition.

The reason why this happens is because it's using stack allocated bytevector for *invalid* performance optimisation. I was so eager to make Sagittarius uses less memory so did this. However once C code calls Scheme code then there are always possibilities that the passed value would be saved out side of the scope. This is the typical case.

I just need to say this to myself, DON'T BE LESS CONSIDERED!!!

Sagittarius Scheme 0.4.10 リリース

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

修正された不具合

•  set-port-position!がファイルポートに対して正しく動作しない不具合が修正されました
• (- 0 )が常に負の整数を返す不具合が修正されました
• (least-fixnum)が返す値をリーダーが巨大数読む不具合が修正されました
• -8388609が8388607として読まれる不具合が修正されました
• bitwise-xorに負数を与えると不正な結果を返す不具合が修正されました
• (bitwise-arithmetic-shift 0 65)が巨大数の0を返す不具合が修正されました
• bitwise-arithmetic-shift-rightに64ビット環境で巨大な32ビットに収まらない値を渡した際に不正な値を返す不具合が修正されました
• fxdiv0-and-mod0が特定の値に対して不正な値を返す不具合が修正されました
• fxbit-set?がR6RSの正誤表にある動作をするように修正されました
• open-inflating-input-portに小さなバッファを指定して展開を行うとエラーが投げられる不具合が修正されました
• file-executable?がWindows環境でSEGVを起こす不具合が修正されました
• file-stat-atime、 file-stat-ctime及びfile-stat-mtimeがWindows環境でPOSIX時間のナノ秒を返さない不具合が修正されました
• copy-directory*がトップディレクトリにあるファイルを正しく処理しない不具合が修正されました
• url-server&pathが返すパスの先頭に//がつけられている不具合が修正されました

改善点

• メモリ使用量が少なくなりました
• ビルドプロセス時のBoehm GC及びlibffi探索に可能であればpkg-configを使用するようになりました
• RSA鍵の比較が可能になりました
• RSA鍵のimport-public-key及びimport-private-keyがバイトベクタを受け付けるようになりました
• parse-pemにユーザがオブジェクトの構築を指定可能にする:builderキーワードが追加されました
• with-argsマクロにオプショナル変数を指定した際に、リストにない引数が渡されてもエラーを投げずにその変数にパックするようになりました

新たに追加された機能

• file->bytevectorが(util file)に追加されました
• ジェネリックな書庫ライブラリ(archive)が追加されました
• Zipファイルを操作するライブラリ(archive core zip)が追加されました
• TARファイルを操作するライブラリ(archive core tar)が追加されました
• GZIPライブラリ(rfc gzip)が追加されました

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

• (getopt)のドキュメントが追加されました

ジェネリックな書庫ライブラリ

一つ前の投稿のやつだけど、早速作ってみた。どうせ作るような気がしたので、なら早い方がいいだろうというだけの理由。

とりあえずこんな感じで使える。

(import (rnrs)
        (srfi :26)
        (archive))

;; for this example it's tar
(define-constant file "test.tar")
(when (file-exists? file)
  (delete-file file))

;; use tar. for zip then 'zip.
(define type 'tar)

(call-with-output-file file
  (lambda (out)
    (call-with-archive-output type out
      (lambda (zip-out)
        (append-entry! zip-out (create-entry zip-out "test.scm"))
        (append-entry! zip-out (create-entry zip-out "test-lib/bar.scm")))))
  :transcoder #f)
        

(call-with-input-file file
  (lambda (in)
    (call-with-archive-input type in
      (lambda (zip-in)
        (do ((e (next-entry! zip-in) (next-entry! zip-in)))
            ((not e) #t)
          (print (archive-entry-name e))
          (unless (string=? "test.scm" (archive-entry-name e))
            (print (utf8->string 
                    (call-with-bytevector-output-port
                     (cut extract-entry e <>)))))))))
  :transcoder #f)

書庫を作る際は現在のところファイル名を受け付けるが、展開する際はポートに吐き出すようになっている。これは、書庫のフォーマットによって必要な情報が異なるので。実際に使い出して必要そうなら多分キーワード引数で指定するとかするようにするかもしれない。当面要りそうなのは展開部分なので、とりあえずといった感じ。next-entry!が末尾に来た際に#fを返すべきかEOFを返す返すべきかは悩みどころではあるが、#fの方が後々楽じゃないかなぁとは思っている。まぁ、好みだろう。

仕組みはDBIと似ていて、書庫のタイプごとに（archive $type)ライブラリが定義されている。現状ではtarとzipのみ(RARとかLZHとか誰か書いてくれないかなぁ・・・)。後はテストとドキュメントの整備か。 テストとか使用感の関係でひょっとしたら次のバージョンでは明文化しないかもしれないが・・・リリース来週だし・・・

書庫と圧縮ライブラリ

日本語で書くとちょっとかっこいいｗ

一つ前の記事で書いたけど、パッケージシステムがあるといいよなぁと思い始めたのでその準備段階として書庫と圧縮展開ライブラリの増強をすることにした。とりあえずzip、tarとgzipを追加。それぞれ、(archive core zip)、(archive core tar)と(rfc gzip)という感じになっている。書庫ライブラリにcoreと付いているのはこの上にジェネリックなインターフェースを構築してやろうかなぁと目論んでいるため。っが、書いてて要らないかもと思っていたりもしているので、実装されるかは目下のところ微妙(多分する)。

とりあえず、以下は簡単な使い方。
まずはtarとgzip

(import (rnrs)
        (srfi :26)
        (archive core tar)
        (rfc gzip))

(define-constant gzip-file "test.tar.gz")
(when (file-exists? gzip-file)
  (delete-file gzip-file))

;; archive and compress
(call-with-output-file gzip-file
  (lambda (out)
    (let ((h (make-gzip-header-from-file gzip-file :comment "comment")))
      (call-with-port (open-gzip-output-port out :header h)
        (lambda (gout)
          (append-file gout "test.scm")
          (append-file gout "dir/test.zip")))))
  :transcoder #f)

;; expand
(call-with-input-file gzip-file
  (lambda (in)
    (call-with-port (open-gzip-input-port in)
      (cut extract-all-files <> :overwrite #t)))
  :transcoder #f)

gzipな出力ポートを開いてそこに追加していくという方式でtar.gzができる。tarはシーケンシャルアクセスなので割りと直感的な操作でかなり楽に行ける。make-gzip-header-from-fileは特に呼ばなくてもよくて、その際はheaderキーワードを削除すればよい。指定しない場合はzlibのウィンドウビット16以上(31を使用)のオプションを利用して空のGZIPヘッダが付くようになる。

tarは現状のところUSTARフォーマットのみをサポートしているので、ファイル名は最大で255バイトまでになる。(prefixフィールドを使用している。コマンドでも展開できるから正しいよね、多分。)

次はzip

(import (rnrs)
        (srfi :26)
        (archive core zip))

(define-constant zip-file "test.zip")
(when (file-exists? zip-file)
  (delete-file zip-file))

;; archive
(call-with-output-file zip-file
  (lambda (out)
    (let ((centrals (map (cut append-file out <>)
                         '("test.scm" "dir/test.zip"))))
      (append-central-directory out centrals)))
  :transcoder #f)

;; expand
(call-with-input-file zip-file
  (cut extract-all-files <> :overwrite #t)
  :transcoder #f)

zipはランダムアクセス可能という特性があるのだが、それを可能にしているのは末尾に付いた情報なので、ファイルを追加するたびに生成される情報を保持して最後に足してやる必要がある。tarとの違いを意識しなくてもいいようにジェネリックなインターフェースを作って操作を統一したいというのがあるので、多分作られる。

 あとRAR辺りを作ったら何でも来いになる感じがある。あぁ、LZHとかもあったな。多分サポートされないけど・・・(^^;

Archive APIs

I'm thinking to make a package system for Sagittarius. For this, I first need archive APIs such as zip and tar. To make things easy for later, I want interface and implementation separated like DBI.

I'm more like go and getter type so making flexible interface from the beginning is not my strong point. So I've checking the other archive library implementations. So far, I've found Java's ZipInputStream/ZipOutputStream seems fine. So current idea would be like this;

;; Interface
(define-class <archive-entry> ()
  ;; might need more
  ((name)
   (size)
   (type)))
;; might not needed
(define-class <archive-input> ()
   ((port)))

(define-class <archive-output> ()
   ((port)))
;; for input
(define-generic next-entry) ;; get entry
;; this should be default method implementation
;; so that subclass can extend.
(define (read-contents input entry)
  ;; returns bytevector read from port.
  ...)

;; for output
(define-generic add-entry) 

If it's possible then it's better to dispatch port type however right now the only way to make custom port is R6RS way and it's always makes the same class object which can't be used for CLOS method dispatcher.

Right now, I need only expander so first try to implement both tar and zip expander I guess.