齊藤


趣味プログラマ。 気の向くままに思い付きのままにコードをいじって遊んでます。

関連リンク

私の今迄の疑問。

そして要望。(解決済み)

混ぜるな危険

数値文字参照の扱いが htmlprag と ssax で違ってた。

htmlprag ではこんな感じ。

(html->sxml "<html><body><div>&#12940;</div></body></html>")
=> (*TOP* (html (body (div (& 12940)))))

ssax ではこんな感じ。

(ssax:xml->sxml
 (open-input-string "<html><body><div>&#12940;</div></body></html>")
 '())
=> (*TOP* (html (body (div "㊌"))))
;; gauche-charactor-encoding が utf-8 以外のときはどうなるんだろう?

htmlprag で作った sxml を sxml:sxml->xml で変換しようとするとエラーになってしまう。 shtml->html を使えばいいだけの話ではあるけど、同じ sxml 関連だからと思ってこういう風に出自の違うライブラリを混ぜて使ってると予想外のところで躓いてしまうこともあるという教訓。

(2011/02/11 07:39:49 PST)

文字列ポート

http://practical-scheme.net/chaton/gauche/a/2011/02/10#entry-4d542b4d-9493d

齊藤 2011/02/10 10:15:41 PST ところで話は変わりますが、 output string port に蓄積したものを今度は input string port として読み出したいってケースは珍しくないと思うんですが、 get-output-string で取り出して open-input-string するしか無いですか? なんとなく非効率な気がするんですが、内部的には共有されてたりするのかな。

shiro 2011/02/10 10:53:36 PST ああ、get-output-stringはコピーが発生しちゃいますね。output string portは最終的な長さがわからないのでチャンクのリストの形でデータを保持してるので。今のところその蓄積されたデータを得る方法はget-output-stringだけです。

procedural buffered portを使ったらパイプのような対のポートを作れるんじゃないかな。

齊藤 2011/02/10 11:15:24 PST <buffered-output-port> を使えば案外簡単に出来そうな予感。

と言うわけでやってみた。

まずは出力ポートから。

(use gauche.vport)
(use gauche.uvector)

(define-class <ostring> (<buffered-output-port>)
  ((chunks :init-keyword :chunks)
   (last-chunk :init-keyword :last-chunk)))

(define-method initialize ((obj <ostring>) initargs)
  (let1 chunks (cons #f '())
    (next-method obj
      (list*
       :chunks chunks
       :last-chunk chunks
       :flush (lambda (buffer flag)
                (let1 lc (~ obj 'last-chunk)
                  (set-cdr! lc (cons (u8vector-copy buffer) '()))
                  (set! (~ obj 'last-chunk) (cdr lc))
                  (u8vector-length buffer)))
       initargs
       ))))

(define (make-open-ostring . opt) (apply make <ostring> opt))

試しに動作させてみると…

(define a (make-open-ostring :buffer-size 2)) ;; ←効果を見易くするためバッファを小さく
(write '(hoge huga hige) a)
(flush a)

このとき a に蓄積されているデータの様子は

(~ a 'chunks)
;; => (#f #u8(40 104) #u8(111 103) #u8(101 32) #u8(104 117) #u8(103 97) #u8(32 104) #u8(105 103) #u8(101 41))

入力ポートを作るコードはこんな感じ。

(define-class <istring> (<buffered-input-port>)
  ((chunks :init-keyword :chunks)))

(define-method get-input-port ((obj <ostring>))
  (let1 x (make <istring> :chunks (cdr (~ obj 'chunks)))
    (set! (~ obj 'chunks) (cons #f '()))
    x))

(define-method initialize ((obj <istring>) initargs)
  (next-method obj
    (list* :fill
           (lambda(buffer)
             (let* ((obl (u8vector-length buffer))
                    (chunks (~ obj 'chunks))
                    (ib (if (null? chunks) #f (car chunks))))
               (if (not ib)
                   0
                   (let ((ibl (u8vector-length ib)))
                     (cond ((= ibl obl)
                            (u8vector-copy! buffer ib)
                            (set! (~ obj 'chunks) (cdr chunks))
                            ibl)
                           ((< ibl obl)
                            (u8vector-copy! buffer ib)
                            (set! (~ obj 'chunks) (cdr chunks))
                            ibl)
                           ((> ibl obl)
                            (u8vector-copy! buffer ib)
                            (set-car! (chunks (u8vector-copy ib obl)))
                            obl))))))
           initargs
           )))

先程の出力ポートから入力ポートを作って入力してみる。

(define b (get-input-port a))
(read b) ;; => (hoge huga hige)

入力ポート内での状態管理が手抜きなので無駄にコピーしちゃってるけど、とりあえずは機能してるみたいなので良しとしよう。

(2011/02/10 13:12:25 PST)

モジュールとメソッド

curl バインディングを使ってみた。

<curl> は url というスロットがあり、そのアクセサは url-of なのだけれど、 url-of は export されていないせいか curl モジュールを use しただけでは見えない。 (define-generic url-of) (use curl) としてみても url-of ⇒ #<generic url-of (0)> だった。

curl モジュールの中では initialize メソッドを定義しているようで、これも export はされていないのに curl モジュールを use しただけでちゃんと機能しているようだ。 initialize は特別扱いなんだろうか。

メソッドとモジュールの関係がよくわからない感じ。

 (2010/01/23 08:48:23 PST)

ユニークなシンボル

CommonLisp には gensym があって、gensym は Gauche でも使える。 r6rs の範囲内で gensym を書くことは出来るだろうかということを考えた。

本来の gensym は intern されないシンボルを作るものだ。 さすがに言語組込の拡張機能として用意しなければ書けないだろうとは思ったのだが、色々と考えている内にこんなものが出来上がった。

(define (my-gensym)
  (car (syntax->datum
        ((lambda(x)
           (syntax-case x ()
             ((_ a)
              (generate-temporaries (syntax (a))))))
         #'(_ _)))))

これが gensym として使えるとは思ってない。 しかし、遊んでいる内に気付いたことがある。

(define g (my-gensym))
(define h (string->symbol (symbol->string g)))
(write (eq? g h))

r6rs 的にはスペルが同じシンボルを比較すれば eq? になるはず。 なので、ここでは #t が返るのが正当だと私は思う。 実際、Mosh, plt-scheme, petite-chez-scheme ではそうなる。 でも、 Ypsilon では #f だった。

 (2009/12/08 03:10:48 PST)

contextual information

schemeのマクロは難しい。datum->syntaxの第一引数の意味がまだ良くわからない。文脈情報ってなんやねんという感じ。今は名前解決の起点と理解しているけれど、これでいいのだろうか。 (2008/04/08 07:07:16 PDT)

define-macro

syntax-caseマクロはハイジニックなマクロもそうでないマクロも書けるということで、そんならsyntax-caseでdefine-macroを模倣できるんではないかとふと意味も無く思いついて書いてみた。

(define-syntax define-macro
  (lambda(x)
    (syntax-case x ()
      ((_ name body)
       (with-syntax ((syntax-body
                      (datum->syntax-object
                       (syntax k)
                       (syntax-object->datum (syntax body)))))
         (syntax
          (define-syntax name
            (lambda(y)
              (syntax-case y ()
                ((name a (... ...))
                 (let* ((m (syntax-object->datum (syntax (a (... ...)))))
                        (n (eval `(syntax-body ,@m) (interaction-environment))))
                   (with-syntax ((r (datum->syntax-object (syntax k) n)))
                     (syntax r))))))
            )))))))

なにやらあまりにもごちゃっとしているし、途中でevalしてるどころか(r6rsでは廃止されたはずの)interaction-environmentを使ってるしで無様なものになってしまった。既存の似たようなことをしたコードが無いものかと"(define-syntax (define-macro"を検索ワードとしてぐぐってみると、まさに同じことをやろうとしているコードが見つかった。

http://c2.com/cgi/wiki?DefineSyntax

こういう書き方もあるんだなぁ。 datum->syntax-objectの第一引数の意味をさっぱり理解できてなくてSchemeを使用したメタプログラミングの記事にある「ちょっとした魔法の式です」をとりあえず鵜呑みにして(syntax k)と書いているので、まじめに理解に努める必要アリと思われる。(2008/01/09 07:13:40 PST)

グタ

閉じ括弧をコッカと呼ぶのがアリならXMLの閉じタグはグタと読んでもよさそうなもんだ。

(2006/11/02 21:57:20 PST)


Last modified : 2023/12/15 07:59:16 UTC