kou

GaUnit（GaucheのためのUnit Testing Framework）（また、久しぶりに）はじめました．

• 最新版: 0.1.6|変更点: Gauche 0.8.13で動作確認。Gauche 0.8.8でも動くっぽい。
  • 簡単なものならgauche.test形式のテストでも実行できるようになった。（例: string.scm）

• API変更 (since 0.1.4): 独自の構文を使うよりもいつも通りの書き方が書けた方が嬉しいから。

旧（一応、まだ使える）:

(use test.unit)

(define-test-case "Test case name"
  ("Test name"
    (assert-equal ...)
    ...)
  ("More test"
    ...))

...

新:

(define-module test-your-module
  (use test.unit.test-case) ;; 0.1.5まではuseじゃなくてextendじゃないとダメ
  (use your-module))
(select-module your-module)

(define (test-your-function1) ;; test-はじまりの関数がひとつのテスト
  (assert-equal 29 (your-function1 2 9))
  ...
  #f) ;; スタックトレースを最適化で落とさないようにするため

(define (test-your-function2)
  ...
  #f)

(provide "test-your-module")

• 数年前の自分のコードが思った以上にひどくてショックだった。

• Scheme:テストファーストってので、各種ツールの議論はどうでしょう。

benchmarkはじめました．

• 最新版: 0.0.1

tsm（Gaucheのためのタプルスペースライブラリ）はじめました．

• 最新版: 0.0.1

xsm（GaucheのためのXML関連ライブラリ（現在はXML-RPCライブラリしかないけど））はじめました．

• 最新版: 0.0.3

だいぶ使いやすくなって(慣れて)きた気がします．

なにか

socket-status

0.8.6から，返されるシンボルの値が大文字から小文字に変更されていてはまった．

CGI経由でファイルアップロードされたファイル名

IEからアップロードすると，filename中のパス区切り「\」が全部消えてしまう．．．うーん．

• Shiro(2005/07/25 02:50:31 PDT): あらほんとだ。うーんどこで消えてるんだろ。

pair-attribute-get

0.8.4からは無くなっていたのか．

GaUnitでスタックトレースが表示できなくなっちゃった． うーん，どうしよう．

• Shiro: gauche.internalモジュールにあります。非公式ですが 当面 (with-module gauche.internal pair-attribute-get)で対応願います。 必要な情報が全部入ったスタックトレースを一発で取れるAPIを公式に 作る方向でいきたいと思っています。
• 了解しました．期待しています．

file->string

バイナリファイルも扱えるfile->stringがあると便利なのになぁ．

(use file.util)

(define tmp-path "/tmp/a")

(with-output-to-file tmp-path
  (lambda ()
    (display #*"\x89PNG\r\n\x1a\n\0\0\0\rIHDR\0\0\0\xf0")))

(file->string tmp-path)

*** IO-READ-ERROR: encountered EOF in middle of a multibyte character from port #<iport /tmp/a 0x80852e0>
Stack Trace:
_______________________________________
  0  (let loop ((ch (read-char port))) (unless (eof-object? ch) (write- ...
        At line 50 of "/usr/share/gauche/0.8.3/lib/gauche/portutil.scm"
  1  (proc port)
        At line 60 of "/usr/share/gauche/0.8.3/lib/gauche/with.scm"

read-required-block

こんなのもあると嬉しいな．

(define (read-required-block input size timeout eof-handler timeout-handler)
  (define return #f)

  (define (make-reader size)
    (lambda (in)
      (read-block size in)))

  (define (more-read size)
    (read-with-timeout input (make-reader size) timeout
                       (lambda ()
                         (return (timeout-handler)))))
  
  (define (read-more-if-need block)
    (cond ((eof-object? block) (eof-handler))
          ((< (string-size block) size)
           (read-more-if-need
            (string-append block
                           (more-read (- size (string-size block))))))
          (else block)))
    
  (call/cc
   (lambda (cont)
     (set! return cont)
     (read-more-if-need (more-read size)))))

read-with-timeout

こんなのがあると嬉しいな．

(define (read-with-timeout input reader timeout timeout-handler)
  (if (char-ready? input)
    (reader input)
    (let ((result #f)
          (selector (make <selector>)))
      (selector-add! selector
                     input
                     (lambda (in . args)
                       (selector-delete! selector input #f #f)
                       (set! result (reader in)))
                     '(r))
      (if (zero? (selector-select selector timeout))
        (timeout-handler)
        result))))

Gaucheとネットワーク

TCPより上の層のライブラリが少ないような．．．

GaucheとDebian

独り言．．．

GaucheのDebianパッケージがもっと充実すると嬉しいなぁ．

• おぉ，8/3くらいから（changelog.Debian.gz調べ）Gauche-gtkとGauche-gtkglが（オフィシャルパッケージとして？）インストールできるようになっていたみたい．GaUnitのGTK+インターフェイスも動くし，いい感じ．嬉しいな．gniibeさんがやってくれていたみたい．助かります．

Debianパッケージのgoshのバージョンがあがると嬉しいなぁ．

S式とプレゼンテーション

あとで，何か書こう．

関連: 大学生日誌(2004-07-23)とか

parse-uri

ついでにこんなのも組込みであると便利な気がします．

URIを分割して多値で返します．指定されていないものは#fになります（schemeがsymbolで返るのは私の好みです）．

(define (parse-uri uri)
  (define (filter-non-empty-string str)
    (and (string? str)
         (not (string-null? str))
         str))

  (define (convert-if-not-false obj converter)
    (and obj (converter obj)))
  
  (receive (scheme specific)
      (uri-scheme&specific uri)
    (receive (authority path query fragment)
        (uri-decompose-hierarchical specific)
      (receive (user-info host port)
          (uri-decompose-authority authority)
        (values (convert-if-not-false scheme string->symbol)
                user-info
                (filter-non-empty-string host)
                (convert-if-not-false port string->number)
                (filter-non-empty-string path)
                query
                fragment)))))

• Shiro (2004/07/13 03:45:44 PDT): 便利そうなので追加しました (uri-parse)。 但しschemeは文字列で返しています。 ここでシンボルのgcに関して興味深い議論になったので、 それはGauche:シンボルのgcに移動します。

mutex-syncronize

組込みでこんなのがあると便利な気がします．

(define (mutex-synchronize mutex thunk)
  (dynamic-wind
    (lambda () (mutex-lock! mutex))
    thunk
    (lambda () (mutex-unlock! mutex))))

• Shiro(2004/07/09 20:27:47 PDT): そうだなあと思ってこれを足そうとしたら、 既にwith-locking-mutexという関数が作ってありました。 しかしundocumentedでしたし、mutex-synchronizeの方が 名前がよさげなので変えてしまいましょうか。
• Shiro (2004/07/09 22:03:52 PDT): ああでも、CLの伝統ではこういうスコープマクロ の名前ってwith + 〜ing が多いんだなあ。CLの場合マクロにしてthunkじゃなく bodyを取るのが普通だけど。
• 名前はwith-なんとかでもよいですが，マクロよりも手続きの方が（apply出来るので）嬉しいです．それに，マクロにする理由がない気がしますし（thunkの中でmutexを使いたい時はマクロの方がよいのかしら）．
• Shiro (2004/07/10 02:29:48 PDT): いえ、既に存在するwith-locking-mutexは 手続きです。

letrec

(letrec ((x 3)
         (y (+ x 1)))
  y)
;; => 4

(letrec ((y (+ x 1))
         (x 3))
  y)
;;  => *** ERROR: operation + is not defined between 1 and #<undef>

どちらも同じ結果(エラー)になって欲しい気がするんですが，こんなものなのでしょうか．

• Scheme:内部defineの評価順の「Gaucheの実装」と同じ話ではないかと。
• つまり，Gaucheではこんなものだということですね．

マクロとdefine

0.8だと以下のコードがエラーになるんですが，こういうものですか？

(define-macro (a)
  '(define b #f))

(define (c)
  (a))

Shiro: これは、「マクロ展開後に出現するinternal defineが認識されない」 というバグです。このバグは前からあったのですが、 別のバグによりいままではエラーになっていませんでした。 (トップレベルの環境が置き換わってしまっていました)。

• ということは，しばらくするとエラーにならなくなるということですね．うーん，0.8は導入しない方がいいかなぁ．

Shiro: そもそも0.8以前でも正しく動いてないので、たとえ直ったとしても 現在の動作と同じにはなりません。 もし現在と同じ動作(トップレベル環境を変更する)をさせたいのなら、 evalを使えば可能です。

 (define-macro (a)
   '(eval '(define b #f) (current-module)))

Shiro(2004/07/13 14:27:33 PDT): マクロ展開後に現れるinternal defineが 正しくinternal defineとして認識されるようになりました　(compile.c,v 1.114)。 但し、最初のコードはやはりエラーになります。(c)の展開後のフォームには internal defineしか含まれませんが、空のbodyはR5RSでは許されてないからです。

parameter.c (Scm_ParameterRef)

SCM_ASSERT(0 <= index && index < p->numParameters);

じゃなくて

if (!(0 <= index && index < p->numParameters))
        Scm_Error("bad index: %d", index);

じゃだめですか？

以下のようなthreadとparameterとloadを使うようなときに復帰できないんですけど．．．

para.scm

(define para (make-parameter 1))

(use gauche.threads)
(use gauche.parameter)

(thread-join!
 (thread-start!
  (make-thread
   (lambda ()
     (load "para")
     (print (para))))))
;; => 1

(thread-join!
 (thread-start!
  (make-thread
   (lambda ()
     (print (para))))))
;; => "parameter.c", line 113 (Scm_ParameterRef): Assertion failed: 0 <= index && index < p->numParameters

• Shiro(2004/02/20 23:02:13 PST): なるほど…。問題の所在はわかりましたが、上のパッチは 本質的な解決ではないですね。本来はparaが最初に作られたスレッド内でしか 有効でないので、primordial threadや2番目に作られたスレッドで使われたら エラーにすべきですが、今のままだと2番目に作られたスレッドで 新たにパラメータを作った場合は、paraでそれにアクセスできてしまいます。 (パラメータオブジェクト内にはindexしか保存してないためです)。 うーん、どうしようかな…

• Shiro(2004/07/15 16:49:10 PDT): 遅くなりましたが、この問題をfixしました。 (parameter.c,v 1.6 etc.)。各パラメータにユニークなidをつけて、 スレッド内での相対indexが同じでも区別できるようにしています。

スタックトレースの伝搬

以下のa, b, c, dが全部同じスタックトレースを出力して欲しいです．ちなみにdだけ異なります．

(define (a)
  (error "error in a") #f)

(define (b)
  (a))

(define (c)
  (with-error-handler report-error a))


(define (d)
  (report-error (with-error-handler identity a))
  #f)

errorオブジェクトにスタックトレース情報はついていなくてスタックトレースはvmに問い合わせているのでこうなるのだと思いますが，errorオブジェクトにスタックトレースを持たせる予定はありますか？

例外クラスの階層化

優先順位は高いですか？低いですか？

• Shiro: わりと高いです。できれば次のリリースに入れたいと思っています (と、ここ2リリースくらい言い続けているのですが)。 階層化は難しくはないんですが、with-exception-handler (srfi-18, srfi-34)と with-error-handlerをconsistentに実装するところをちゃんと考えなくちゃ ならないので、延び延びになっています。

マクロとスタックトレースとquote

`だとスタックトレースの情報が失われるけどそういうもの？

(define-macro (a)
  '(begin (error "hoge") #f))

(define (b)
  (a) #f)

(b)

だと2行目でエラーが起きたのがわかる．

(define-macro (a)
  `(begin (error "hoge") #f))

(define (b)
  (a) #f)

(b)

だと[unknown location]

マクロとスタックトレース

マクロ展開後のコードの中で発生したエラーのスタックトレースにマクロを呼び出している場所の情報も含んでいると嬉しいです．

(define-macro (a)
  '(begin (error "hoge") #f))

(define (b)
  (a) #f)

(b)

が

(define (a)
  (error "hoge") #f)

(define (b)
  (a) #f)

(b)

と同じようなスタックトレースを持つ感じ．もしかして，マクロにそんなことを期待しちゃいけないのかしら．

• Shiro (2003/12/30 04:24:42 PST): いえ、いずれはサポートしたいですね。 ソースコード情報は、S式をreadした時に作られるpairにくっついています。 マクロは、入力S式をトラバースしながら新しいS式を組み立てるので、 今はその時点で情報が失われています。ここで、入力S式にソースコード情報が くっついていたらそれを組み立てたS式の方にもくっつけてやるようにすれば いいはずです。純粋に優先順位の問題で後回しになっています。
• backquoteに関してはもう少し難しいです。backquote式は、 「そのようなS式を組み立てるコード列」へとコンパイルされるためです。 つまり、

  `(foo (bar ,baz))
  

  と書くことは、実質的にこう書いているのと同じです:

  (list 'foo (list 'bar baz))
  

  今のようにpairにソース情報をつける方式では、ちょいと難しいですね。 「内部に一切unquoteを含まないbackquote」をquoteのようにコンパイルすることは 可能ですが、2パス必要になりますね…

generic function & import

(define-module a
  (export x)
  (define-method x ((y <list>)) #f))

(define-module b
  (export x)
  (define-method x ((y <string>)) #f))

(import b)
x ; => #<generic x (1)> for (<string>)

となるのはわかりますが，

(define-module a
  (export x)
  (define-method x ((y <list>)) #f))

(define-module b
  (import a)
  (export x)
  (define-method x ((y <string>)) #f))

(import b)
x ; => *** ERROR: unbound variable: x
(import a)
x ; => #<generic x (2)>

というのは使いづらくないですか？

まぁ，

(define-module c
  (extend a b))

(import c)
x ; => #<generic x (2)>

とでもすればいいんでしょうけど．

• Shiro: はい。だいぶ前から問題視しているのですが、綺麗な 解決法が思い付きません。この特定の問題に関しては、define-method 時にそのモジュールにbindingを追加するようにするという逃げ道は ありますが、根本的な解決にならないので思案しています。

あぁ，Gauche:GenericFunctionとModuleに書いていましたね．gauche.gfでいい気がしますが，exportしなくても見えてしまうのは嫌ですね．

gauche.gfではgeneric functionの実体だけをもっていて，名前はつけない．各モジュールではdefine-methodしたりimportしたら名前を付けると．．．いいのかな？あと(春かなぁ．．．)でやってみようかなぁ．

evalの代わりにマクロ

ファイルを読み込んでその内容を評価したい．

evalを使う:

(define (eval-file filename)
  (eval (read (open-input-file filename))
        (current-module)))

マクロを使う:

(define-macro (eval-file* filename)
  (read (open-input-file filename)))

違いはこんな感じ．

(eval-file "test.scm")   ; => OK
(eval-file* "test.scm")  ; => OK
(eval-file (string-append "test" ".scm"))  ; => OK
(eval-file* (string-append "test" ".scm")) ; => NG

ここで，

(eval-file* (string-append "test" ".scm"))

を出来るようにしたい場合はどうするんですかねぇ．

1. 引数をstring-appendしてeval-file*をよびだすマクロを書く

   (define-macro (eval-file** . strings)
     `(eval-file* ,(apply string-append strings)))
   

   を作って

   (eval-file** "test.scm")     ; => OK
   (eval-file** "test" ".scm")  ; => OK
   

   というように使ってもらう．
   • 結局引数には文字列リテラルしか書けないままなので，解決になっていない．
2. だまってevalする．

   (define-macro (eval-file* filename)
     (read (open-input-file (eval filename (current-module)))))
   

   • first class environmentがないのでletの中とかだとうまくない．
3. 問題を考え直す．
4. あきらめる

• Shiro (2003/12/18 16:25:01 PST) : R5RS Schemeでは、トップレベル式を単位として、 「プログラムの構造」は静的なもので、その意味が静的に解析可能である というのが大前提です。first class environmentを使ってローカル環境で evalを許すことは、その前提に穴をあけることになります。
• 逆に考えると、実行時にしかわからない式をローカル環境で評価したい、 というのは、「あるプログラム片に、実行時に得られるコード片を組み込んだ ものを評価(＝静的解析＋実行)したい」ということですから、 テンプレートとなるプログラムそのものもデータとして持っておいて、 そこにreadした式を組み込んでから、全体を評価すればいいんじゃないでしょうか。
• ポイントは、プログラムの意味の決定は、常に実行に先立って行われる ということです。
• マクロは、プログラムの意味の決定の前に、プログラムソース自身を Schemeもしくはテンプレート言語で操作することを可能にする仕組みです。 但し、マクロが操作するものはプログラムそのものであって、 プログラムが操作するものとはフェーズが違います。
• evalした時点でプログラムの構造は静的に解析されるため、 ローカルで評価すべき式が刻々と変化すような場合には使えません。 でも、そういうプログラムはもはや上の意味でSchemeからは外れた 別の言語なのです。Schemerはそう考えて、そのような別言語をSchemeを 使って実装する戦略を取るでしょう。
• 色々書きましたが、何を以って「プログラムの意味」を決定するのか、 ということを中心に問題を設定すると、戦略が見えて来るのではないでしょうか。

current-environment

(define x 10)
(let ((x 1))
  (eval 'x (current-environment)))
;; => 1

とするようなcurrent-environmentみたいなのはないのかなぁ．

• Shiro: ないです。これはfirst class environmentと呼ばれるもので、 処理系によっては用意されていますが、Gaucheでは環境をfirst classで 取り出すのにかなりのオーバーヘッドがあります。 また、このようなローカル環境の中でevalを許すと、コンパイラによる 最適化手法の多くが使えなくなります。これらの理由から、Gaucheが first class environmentをサポートする可能性は低いです。 が、first class envionmentがないとできない、という事例があれば 教えて下さい。

まぁ、上記の例では

(eval '(let ((x 1)) x) (current-module))

とでもすればいいので、なければなくて大丈夫ですね。

first class environmentがなければ出来ないというわけではないのですが、使用例ということで一つあげておきます。

例えば、

(define (dispatch sym . args)
  (define (foo) ...)
  (define (bar baz) ...)
  ...

  (case sym
   ((foo) (apply foo args))
   ((bar) (apply bar args))
   ...))

というのを

(define (dispatch sym . args)
  (define (foo) ...)
  (define (bar baz) ...)

  (apply (eval sym (current-environment)) args))

と書きたいことがあります。

ま、これもシンボルから手続きが引ければそれでいいわけなので、他に手がありそうなんですけど(わからないんですよねぇ、私には)。

• Shiro: それなら、私はマクロにするかなあ。evalは最後の手段というか、裏口というか、そういう感覚があります。evalのセマンティクスを正しく定義するのって難しいんですよ。

Scm_RegisterFinalizer

Schemeレベルでは使えない？

• Shiro: finalizerから安全にSchemeをコールバックする方法が無いので 使えないです。

report-errorの出力形式

ファイル名:行: 何か

という形式になっているとEmacsでエラー箇所にジャンプしやすいのでうれしいです．

Schemeレベルでreport-errorを再定義してもいいんですけど，なんか，スタックトレース出力以外のこともやっていそうなので，Cレベルで．

RCS file: /cvsroot/gauche/Gauche/src/error.c,v
retrieving revision 1.41
diff -u -r1.41 error.c
--- src/error.c 5 Jul 2003 03:29:12 -0000       1.41
+++ src/error.c 20 Nov 2003 03:53:08 -0000
@@ -282,19 +282,19 @@
     SCM_PUTZ("Stack Trace:\n", -1, err);
     SCM_PUTZ("_______________________________________\n", -1, err);
     SCM_FOR_EACH(cp, stack) {
-        Scm_Printf(SCM_PORT(err), "%3d  %66.1S\n", depth++, SCM_CAR(cp));
         if (SCM_PAIRP(SCM_CAR(cp))) {
             ScmObj srci = Scm_PairAttrGet(SCM_PAIR(SCM_CAR(cp)),
                                           SCM_SYM_SOURCE_INFO, SCM_FALSE);
             if (SCM_PAIRP(srci) && SCM_PAIRP(SCM_CDR(srci))) {
-                Scm_Printf(SCM_PORT(err), "        At line %S of %S\n",
-                           SCM_CADR(srci), SCM_CAR(srci));
+                Scm_Printf(SCM_PORT(err), "%A:%S:\n",
+                           SCM_CAR(srci), SCM_CADR(srci));
             } else {
-                Scm_Printf(SCM_PORT(err), "        [unknown location]\n");
+                Scm_Printf(SCM_PORT(err), "[unknown location]:\n");
             }
         } else {
             Scm_Printf(SCM_PORT(err), "\n");
         }
+        Scm_Printf(SCM_PORT(err), " %3d %66.1S\n", depth++, SCM_CAR(cp));
         if (depth >= STACK_DEPTH_LIMIT) {
             Scm_Printf(SCM_PORT(err), "... (more stack dump truncated)\n");
             break;

• Shiro: なるほど。将来はBiglooみたいな、Emacsとの統合環境を 作ることを考えていて、その時にスタックトレースをパーズするようにすれば 良いかと思っていたのですが、こうすれば既存のメカニズムでジャンプできる わけですね。手元でしばらく使って試してみます。

• Shiro(2004/07/31 11:27:51 PDT): これ、ちょっと試しているんですが、 *compilation*バッファだけでなく、インタラクティブに使っている場合にも ジャンプできるような設定ってどうされてますか? 使用感ですが、慣れの問題とはいえ、ソース情報がうるさい感じなので、 変更するなら便利さを実感したいところです。

• kou: インタラクティブに使うときはC-xC-eとかばかり使っているのでジャンプする設定はしていませんでした（C-cC-lはほとんど使わない．なんでだろう，なんか好きじゃないなぁ）．M-xC-iでそれっぽいのがないかみてみたらcompilation-shell-minor-modeというのがありました．ということで，こんなふうにしてみてはどうでしょうか．

  (add-hook 'inferior-scheme-mode-hook
            '(lambda ()
               (compilation-shell-minor-mode 1)))
  

object-hashのデフォルト動作

以下の様になっているとhash-tableを使うのが楽になると思うんですけどねぇ．

(define-method object-hash (obj)
  (address-of obj))

• Shiro: これはできないんです。hashは、マシン環境に依存しない ハッシュ値を返すことになっているので (Common Lispのsxhashと同等)。 なお、0.7.3では内部のeq?-やeqv?-hash-tableで使っているハッシュ関数を Schemeからアクセス可能にする予定です。アプリケーション側で、 ハッシュ値がマシン環境に依存しても良い、という場合は次のように書けるように なるでしょう:

  (define-method object-hash (obj)
    (eqv-hash obj))
  

• (なお、address-ofはハッシュ値としてはかなり悪い分布になるので、 その意味でも避けるべきだと思います）。

オブジェクトをアドレスで指定

gosh> (lambda () #f)
#<closure 0x80fbc18()>

の

0x80fbc18

はオブジェクトのアドレスですよね？

このアドレスを用いてオブジェクトを指定することは出来ませんか？

gosh> (id-ref #x80fbc18)
#<closure 0x80fbc18()>

みたいに．

• Shiro 何に使いたいですか? この操作を安全に行うのは不可能なので、これが絶対に必要な場面がなければ 実装しないと思いますが、そういう場面があるのなら知りたいです。

オブジェクトの転送に使おうと思っていました．

シリアライズできない(writeしたものをreadできない)オブジェクトを転送するのは面倒なので，オブジェクトの参照だけを転送しようと思いました．で，これだけならオブジェクトを一意に特定することが出来るキーがあればいいだけなので，ハッシュでもよさそうですが，

(define-method object-hash (obj)
  ...)

というのが実装されていないので全てのオブジェクトに実装しなければいけません．で，これも面倒だと．

ということで，

(define-method object-hash (obj)
  (address-of obj))

というのはどうですか？

これがあれば，weak-vectorとobject-hashで，同じ様なことが出来そうなのでid-refみたいなのはいりません．

ところで，weak-vectorも(gcされると言う意味では)安全ではないですよね？id-refみたいなものを使ったときの安全ではないという意味には別のことも含まれているのですか？良く分からないですけど，継続がらみとか，スレッドがらみとか．．．

• ちなみに、例えばid-getみたいなものでアドレス値を取得して、 後でその値をid-refに渡したとしても、その間にオブジェクトがgcされている 可能性があります。確実にもとのオブジェクトを得たいのなら、 そういうオブジェクトを何らかのテーブルに登録してgcされるのを 防ぐしかありません。でもテーブルに登録するなら、自分でidをつけて管理 できますよね?

別にgcされてもいいや，と思っていたので，gcされちゃったよという例外を投げてくれれば，問題ないです，私は．

• Shiro: いや、安全ではないというのは、Schemeシステムに矛盾をきたし、 最悪クラッシュさせる可能性があるということです。 アドレス値からだけでは、それが指しているメモリが一回gcされて 別の目的に再利用されていてもシステムには判断できません。 一方、weak-vectorは、何をしようがScheme的に矛盾が生じることはありません。
• weakでなくてよいのなら、object-hashを使う必要はなくて、 eq?なhash tableが直接使えます。

       (define-values (id-get id-ref)
          (let ((obj->id (make-hash-table 'eq?))
                (id->obj (make-hash-table 'eqv?))
                (cnt 0))
            (values (lambda (obj)
                      (or (hash-table-get obj->id obj #f)
                          (begin (inc! cnt)
                                 (hash-table-put! obj->id obj cnt)
                                 (hash-table-put! id->obj cnt obj)
                                 cnt)))
                    (lambda (id)
                      (or (hash-table-get id->obj id #f)
                          (error "no object with id: " id))))))
  

  • kou: define-valuesってこういうときに使うんですね．これだと，(id-ref (id-get #f))が使えませんが，イメージは掴めました．
• weakにしたいなら、今のところ可能なのは、上のコードで、 objectの参照に一段噛ませる(1要素のweak vectorを作ってobjへの参照を 格納する)という方法でしょうか。それなら、gcされてしまった ことも検出できます。
  • Shiro: しまった。weak vectorを使うと、obj->idへのマップが作れませんね。 やっぱりweak hash tableもライブラリで用意したほうが便利そうですね。

sendto(2), recvfrom(2)

欲しいなぁ．

WiLiKiの出力するRSSにdescriptionを加える

Index: src/wiliki.scm
===================================================================
RCS file: /cvsroot/wiliki/WiLiKi/src/wiliki.scm,v
retrieving revision 1.94
diff -u -r1.94 wiliki.scm
--- src/wiliki.scm      1 Sep 2003 04:57:49 -0000       1.94
+++ src/wiliki.scm      28 Oct 2003 02:01:39 -0000
@@ -59,7 +59,8 @@
 (autoload wiliki.pasttime how-long-since)
 (autoload wiliki.format  format-page format-footer format-content
                          format-time format-colored-box format-wikiname-anchor
-                         format-wiki-name format-diff-pre format-diff-line)
+                         format-wiki-name format-diff-pre format-diff-line
+                         format-description)
 (autoload wiliki.log     wiliki-log-create wiliki-log-pick
                          wiliki-log-pick-from-file
                          wiliki-log-parse-entry wiliki-log-entries-after
@@ -84,6 +85,7 @@
 (define *recent-changes* " %recent-changes")
 (define *lwp-version* "1.0")            ;''lightweight protocol'' version
 (define $$ gettext)
+(define *description-length* 120)
 
 ;; Parameters
 (define page-format-history (make-parameter '()))
@@ -337,10 +339,14 @@
    (string-append (title-of (wiliki))": "($$ "Recent Changes"))
    (html:table
     (map (lambda (p)
-           (html:tr
-            (html:td (format-time (cdr p)))
-            (html:td "(" (how-long-since (cdr p)) " ago)")
-            (html:td (format-wikiname-anchor (car p)))))
+           ;; for backward compatibility
+           (let ((modified-time (if (pair? (cdr p))
+                                    (cadr p)
+                                    (cdr p))))
+             (html:tr
+              (html:td (format-time modified-time))
+              (html:td "(" (how-long-since modified-time) " ago)")
+              (html:td (format-wikiname-anchor (car p))))))
          (wdb-recent-changes (db))))
    :page-id "c=r"
    :show-edit? #f
Index: src/wiliki/db.scm
===================================================================
RCS file: /cvsroot/wiliki/WiLiKi/src/wiliki/db.scm,v
retrieving revision 1.6
diff -u -r1.6 db.scm
--- src/wiliki/db.scm   1 Sep 2003 04:57:49 -0000       1.6
+++ src/wiliki/db.scm   28 Oct 2003 02:01:39 -0000
@@ -124,8 +124,11 @@
                              (dbm-get db *recent-changes* "()")))
         (dbm-put! db *recent-changes*
                   (write-to-string
-                   (acons key (mtime-of page) (take* r 49))))))
+                   (acons key
+                          (list (mtime-of page)
+                                (format-description page))
+                          (take* r 49))))))
     ))
 
 ;; WDB-DELETE! db key
Index: src/wiliki/format.scm
===================================================================
RCS file: /cvsroot/wiliki/WiLiKi/src/wiliki/format.scm,v
retrieving revision 1.15
diff -u -r1.15 format.scm
--- src/wiliki/format.scm       8 Oct 2003 07:28:26 -0000       1.15
+++ src/wiliki/format.scm       28 Oct 2003 02:01:39 -0000
@@ -48,8 +48,9 @@
           format-wikiname-anchor
           format-wiki-name
           format-diff-pre
-          format-diff-line)
+          format-diff-line
+          format-description)
   )
 (select-module wiliki.format)
 
@@ -553,5 +556,19 @@
        (html:hr)
        content)))
   )
+
+(define (format-description content)
+  (let* ((extracted-string (regexp-replace-all
+                            #/([^<]*)(<[^>]*>)?/
+                            (tree->string (format-content content))
+                            "\\1")))
+    (string-shorten extracted-string *description-length*)))
+
+(define (string-shorten string length)
+  (if (< (string-length string) length)
+      string
+      (tree->string (list (substring string 0 length)
+                          "..."))))
 
 (provide "wiliki/format")
Index: src/wiliki/rss.scm
===================================================================
RCS file: /cvsroot/wiliki/WiLiKi/src/wiliki/rss.scm,v
retrieving revision 1.5
diff -u -r1.5 rss.scm
--- src/wiliki/rss.scm  30 Aug 2003 12:28:00 -0000      1.5
+++ src/wiliki/rss.scm  28 Oct 2003 02:01:40 -0000
@@ -61,10 +61,18 @@
               entries)))
       ,(map (lambda (entry)
               (let1 url (url-full "~a" (cv-out (car entry)))
-                (rdf-item url
-                          (rdf-title (car entry))
-                          (rdf-link url)
-                          (dc-date  (cdr entry)))))
+                    (let* ((new-style (pair? (cdr entry)))
+                           (date (if new-style
+                                     (cadr entry)
+                                     (cdr entry)))
+                           (description (if new-style
+                                            (caddr entry)
+                                            "")))
+                      (rdf-item url
+                                (rdf-title (car entry))
+                                (rdf-link url)
+                                (rdf-description description)
+                                (dc-date date)))))
             entries)
       "</rdf:RDF>\n")))

if

  (if "a" (begin)) ; => "a"

は仕様ですか？

• Shiro (2003/07/31 07:43:10 PDT): これはifの問題じゃなくて、(begin)が「全く何もしない」 コードに展開されるために、値レジスタに残っていた"a"が洩れ出てくるためです。 (begin)はR5RSでは定義されていません。ただ、マクロ展開などで使えると便利なので Gaucheではエラーにしていません。また、(begin)を例えば「#<undef>を値とする」 というようにすると、ちょっと不便なことがあります(internal defineとの 絡み)。SCMのディストリビューションについてくるテストスイートr4rstest.scmの中で beginのヘンな使い方が出て来ます。

add-load-path

(add-load-path (sys-normalize-pathname "~/local/share/gauche/site/lib"
                                       :expand #t))

ということは出来ないのかなぁ．

• Shiro (2003/07/29 10:13:38 PDT): ああ、add-load-pathはマクロですからね。 引数をevalするようにしてしまおうかな。

• kou (2003/08/02 05:30:08 PDT): どうすればできるのですか？

string-case

eqv?の代わりにstring=?で比較するcaseがマクロで書けない．

• Shiro (2003/07/29 10:13:38 PDT): これでどうっすか。 string-case-subを別にするか string-caseの中で展開してしまうかは好みの問題ですが。

  (use srfi-1) ;; for extended member
  
  (define-syntax string-case-sub
    (syntax-rules (else)
      ((_ obj)  #f)
      ((_ obj (else expr ...)) (begin expr ...))
      ((_ obj ((str ...) expr ...) clause ...)
       (if (member obj '(str ...) string=?)
         (begin expr ...)
         (string-case obj clause ...)))
      ((_ obj other . more) (syntax-error "bad clause in string-case" other))))
  
  (define-syntax string-case
    (syntax-rules (else)
      ((_ obj clause ...)
       (let ((tmp obj))
         (string-case-sub tmp clause ...)))))
  

• kou (2003/07/30 02:17:28 PDT): あまりGaucheの構文(useとか)を使いたくないのでこんな感じ．

(define (include? key sequence predicate)
  (and (not (null? sequence))
       (if (predicate key (car sequence))
           #t
           (include? key (cdr sequence) predicate))))

(define-syntax string-case
  (syntax-rules (else)
    ((_ key) #f)
    ((_ key (else expr ...)) (begin expr ...))
    ((_ key ((str ...) expr ...))
     (if (include? key '(str ...) string=?)
         (begin expr ...)))
    ((_ key ((str ...) expr ...) clause ...)
     (if (include? key '(str ...) string=?)
         (begin expr ...)
         (string-case key clause ...)))
    ((_ other . more)
     (syntax-error "bad clause in string-case" other))))

• Shiro (2003/07/30 08:19:57 PDT): これだとkeyが最悪clauseの数だけ評価されて しまいませんか。

• kou (2003/07/31 03:37:54 PDT): なるほど，だからlet使ってたんですね．でも，letを使うのはなんか気持ち悪いなぁ．他に方法は無いのかなぁ．

とりあえず，

    ((_ key ((str ...) expr ...))
     (if (include? key '(str ...) string=?)
         (begin expr ...)))

はいらないことに気付いたので新版．ついでにexpr ...が無いときはエラーにするようにした．

foo ...というのはfooの0回以上の繰り返しなのか．1回以上だと思っていた．

(define (include? key sequence predicate)
  (and (not (null? sequence))
       (if (predicate key (car sequence))
           #t
           (include? key (cdr sequence) predicate))))

(define-syntax string-case
  (syntax-rules (else)
    ((_ key) #f)
    ((_ key (else expr ...)) (begin expr ...))
    ((_ key ((str ...)) clause ...)
     (syntax-error "expressions are not found in string-case" ((str ...))))
    ((_ key ((str ...) expr ...) clause ...)
     (let ((evaled-key key))
       (if (include? evaled-key '(str ...) string=?)
           (begin expr ...)
           (string-case evaled-key clause ...))))
    ((_ other . more)
     (syntax-error "bad clause in string-case" other))))

• Shiro: これだと確かにletがたくさん入っちゃうので気持悪いかも。 なお、現在計画中の次期コンパイラでは、(let ((a expr)) (let ((b a)) (let ((c b)) ...) みたいな式はオプティマイズされるようにする予定です。 でもいつ出来るかはわかりません。

• あれ？先日私も case の比較対象に文字列を使いたくてやったけど、 r5rs の後ろの方に case を拡張マクロで書くとこうだよってのがあって、そいつの eqv? を equal? に置き換えてやったんですが、それではダメなんですか？cut-sea:2003/10/22 23:49:15 PDT

• kou(2003/10/23 01:58:28 PDT):"Derived expression types"ってとこですか？そこにのっているcaseだとmemvを使っていますね．string=?で比較するには結局srfi-1のmemberとか上にあるinclude?とかを使わなくてはいけないのではないでしょうか？ってそういうことではないのかしら．．．

• 失礼！そうです。今帰宅して確認してるんですが、member でした。 member って srfi レベルの実装でしたっけ。 ん〜、それなら case の memv を member 置き換えして member 自身はそんなに複雑じゃないはずと思ったのでそれを define したら・・・イマイチですか ? cut-sea:2003/10/23 02:27:38 PDT

なにかだったもの

classに対してmap

classに対してmapとかfoldとか使いたいなら<collection>のサブクラスを作れ

www/cgi.scm

queryの区切り文字として&だけではなくて;も認識される．

Note:

• http://www.w3.org/TR/html4/appendix/notes.html#h-B.2.2

スタックトレース

• エラーハンドラ中でスタック情報を得るにはvm-get-stack-trace{,-lite}

ということでこんなのを使うようにした．

  (define (print-error e mark)
    (print mark)
    (print (slot-ref e 'message))
    (with-module gauche.vm.debugger
                 (debug-print-stack
                  (cddr (vm-get-stack-trace))
                  *stack-show-depth*))
    (print mark))

Note:

• トレース情報がデフォルトで作られないのは、スタック上の情報をfirst classなオブジェクトに変換するのが重いから
• エラー出力のデフォルトはreport-errorを用いている
• エラーは例外の一種

NULL文字にマッチする正規表現を書く

  (string->regexp "\0")

or

  (string->regexp "\x00")

or

  (#/\x00/ "\0")

and so on.

Note:

• \uNNNN や \UNNNNNNNN で unicode表記が可能

• \x, \u, \Uは文字列中でも有効

• "\0" という書き方はイレギュラー

リストの要素を連結して文字列を返す

• 文字列のリストなら、string-join
• 最初に(map x->string lst)してしまうのも手

Note:

• リストの各要素間に新しく要素を埋め込むにはintersperse in util.list

datatype.ss

http://www.cs.indiana.edu/~jsobel/Recycling/datatype.ss をGaucheで実行するにはloadする前に以下を評価しておく．でも，完全にうまくいくわけではない．Cf. SchemeCrossReference:andmap, SchemeCrossReference:error

  (use slib)
  (use srfi-1)
  (define andmap every)
  
  (define char-ready? 
    (let ((bad-char-ready? (with-module gauche char-ready?))) 
      (lambda args 
        (if (null? args) 
            (bad-char-ready? (current-input-port)) 
            (bad-char-ready? (car args))))))
  
  (define (slib:eval-load <pathname> evl)

    (if (not (file-exists? <pathname>))
        (set! <pathname> (string-append <pathname> (scheme-file-suffix))))
    (call-with-input-file <pathname>
      (lambda (port)
        (let ((old-load-pathname *load-pathname*))
          (set! *load-pathname* <pathname>)
          (do ((o (read port) (read port)))
              ((eof-object? o))
            (evl o))
          (set! *load-pathname* old-load-pathname)))))
  
  (require 'syntax-case)
  (require 'repl)
  (repl:top-level macro:eval)