Gaucheライクな文字セットリーダをサポートしてみた

事の発端は(text parse)のテストケースがなかったこと。

この数日バイナリの扱いを楽にするためのライブラリを書いていたのだが、(text parse)と対になる(binary parse)を格段になってテストケースがないことに気付いた。っで、Gaucheからテストケースを拝借しようと思ったら、文字セットのところで躓いたという話。Sagittariusはリーダーマクロをサポートしているのでさくっと書いてしまえばいい話ではあるのだが、この形式の読み取りで躓いたのはこれで何度目か分からないので。

以下のように使える。

#!read-macro=char-set
#[a-zA-Z]
;; => #<char-set ...>

あくまで読み取りで、書き出しの方は何もしてない。(pp)は変更してあるのでそれを使うということで。

実装は以下。

(library (char-set)
    (export :export-reader-macro)
    (import (rnrs)
            (sagittarius reader)
            ;; we don't want to export regex reader macro with this
            (only (sagittarius regex) parse-char-set-string))

  ;; Gauche compatible charset
  (define-dispatch-macro #\# #\[ (char-set-reader port subchar param)
    (define (read-string in out)
      (let loop ((depth 0))
        (let ((c (get-char in)))
          ;; we just need to put all chars until we got #\]
          ;; c could be eof so check
          (when (char? c) (put-char out c))
          (cond ((eof-object? c) 
                 (raise (condition
                         (make-lexical-violation)
                         (make-who-condition 'char-set-reader)
                         (make-message-condition "unexpected EOF"))))
                ((char=? c #\[) (loop (+ depth 1)))
                ((char=? c #\])
                 ;; done?
                 (unless (zero? depth) (loop (- depth 1))))
                (else (loop depth))))))
    (let-values (((out extract) (open-string-output-port)))
      ;; need this unfortunately
      (put-char out #\[)
      (read-string port out)
      (parse-char-set-string (extract))))
)

parse-char-set-stringは新たに足された手続き。インポートの際に問答無用でインポートしたライブラリのリーダーマクロを引き継ぐようになっていたのを修正。

スクリプト内で使う分にはこれで十分なはず。