R6RS で SRFI-6 を実装する

R6RS のカスタムポートでは SRFI-6 を実装できないとする記事を見た。

例えばこのカスタムポートを使ってSRFI-6(open-output-stringとget-output-string)を実装することはできない。

そんなはずはないだろうと私には思えたので実際に書いてみた。

#!r6rs
(library (srfi :6)
  (export get-output-string
          open-output-string
          open-input-string)
  (import (rnrs)
          (rnrs mutable-pairs))

  (define output-string-port-table
    (make-eqv-hashtable))

  (define (get-output-string port)
    (flush-output-port port)
    (let ((chunks (car (hashtable-ref output-string-port-table port '(#f)))))
      (if chunks
          (apply string-append (reverse chunks))
          (error 'get-output-string "fail get string"))))

  (define (open-output-string)
    (define buffer (cons '() #f))
    
    (define (str-close)
      (when port (hashtable-delete! output-string-port-table port)))

    (define (str-write! str start count)
      (unless (zero? count)
        (set-car! buffer
              (cons (substring str start (+ start count)) (car buffer))))
      count)

    (define port
      (make-custom-textual-output-port
       "output-string"
       str-write!
       #f
       #f
       str-close))

    (hashtable-set! output-string-port-table port buffer)
    port)

  (define open-input-string open-string-input-port)
)

ポートを作成するときにその種類をテーブルに記憶しておけば、ポートの種類を判別することにも応用できると思う。

陽にクローズしないとストレージが破棄されないのでその点は SRFI-6 を満してないと言えるかもしれないのだが、いずれにしても R6RS 的には call-with-port を使うのが行儀がよいプログラムだろう。

Ypsilon や Mosh 、そして Sagittarius では動くことが確認できたが、 Petite Chez Scheme や Larceny では動かない (というより動くが何故か書込み手続きが呼出されていない) のでもしかすると上記のコードは R6RS ポータブルになってないかもしれない。 [追記]フラッシュしてなかったからでした。[/追記]

Document ID: 507453124dfece7b211dd3cf49f92ea4