From hira ＠ verysoft.jp Sun Aug 1 09:56:28 2004 From: hira ＠ verysoft.jp (HIRAUCHI Hideyuki) Date: Sun, 01 Aug 2004 09:56:28 +0900 Subject: [Kisp-dev 14] =?iso-2022-jp?b?UmU6IBskQkZ8S1w4bCVXJW0lOCUnGyhC?= =?iso-2022-jp?b?GyRCJS8lSExkQmobKEI=?= In-Reply-To: <20040728120604.11DE.HIRA@verysoft.jp> References: <20040728120604.11DE.HIRA@verysoft.jp> Message-ID: <20040801095535.FAE0.HIRA@verysoft.jp> * 日本語プロジェクト問題(解決編) プロジェクトの文字コードはEUC-JPに変更することにした。ただし、開発者が普段 使っているgoshの文字コードがEUC-JPでない場合、日本語混じりのソースが実行でき ない。その対策として次の二つが考えられる。 A案: ソースをネイティブの文字コードに変換する ○ 普段使っているgoshがそのまま使える × checkout/commitするときの文字コード変換が面倒 × ソースのエディタ用文字コード指定が邪魔になる → エディタ用文字コード指定は、文字化け時に役立つので消したくない B案: Kisp開発用のgoshを用意し、shebangではそれを指すようにする ○ 普段使っているgoshを潰さずに済む → 私の場合、Windows上で使用するgoshをEUC-JPにしてしまうと日本語ファイ ル名で落ちるので、sjis版goshは捨てたくない × ネイティブがEUC-JPの人はshebang対策(symlinkを貼るか、Kisp用にビルドする か)が面倒。 私にとってA案の短所が致命的なので、今回はB案を採用することにした。以下のよう にgoshをビルドすればtools/gauche配下にEUC-JP版のgoshがインストールされる。 $ ./configure --enable-multibyte=euc-jp --prefix=$KISP_HOME/tools/gauche $ make $ make install --hira From hira ＠ verysoft.jp Sun Aug 1 10:24:08 2004 From: hira ＠ verysoft.jp (HIRAUCHI Hideyuki) Date: Sun, 01 Aug 2004 10:24:08 +0900 Subject: [Kisp-dev 15] =?iso-2022-jp?b?UmU6IBskQkxaJE4lUCVqJUchPCU/GyhC?= In-Reply-To: <20040730203912.11FA.HIRA@verysoft.jp> References: <20040730.002935.1057426603.shiro@lava.net> <20040730203912.11FA.HIRA@verysoft.jp> Message-ID: <20040801101528.FAE6.HIRA@verysoft.jp> これ↓書いてて思ったのは、 http://lists.sourceforge.jp/mailman/archives/gauche-devel-jp/2004-July/001046.html * 木のバリデータ(RELAX NG風)を実装してみた × サポートしなかった機能 - 途中要素の繰り返し - interleave (elementの出現順序を規定しない) - その他難しそうな機能 ていうのはやっぱり駄目だろうと。 でもutil.matchだとnull遷移がどうにも表現できないし。 というわけで、やっぱり木のバリデータはふつーに再帰で書くことにしました。 --hira From hira ＠ verysoft.jp Sun Aug 1 22:21:36 2004 From: hira ＠ verysoft.jp (HIRAUCHI Hideyuki) Date: Sun, 01 Aug 2004 22:21:36 +0900 Subject: [Kisp-dev 16] =?iso-2022-jp?b?UmU6IBskQkxaJE4lUCVqJUchPCU/GyhC?= In-Reply-To: <20040730183111.11F2.HIRA@verysoft.jp> References: <20040729170547.11E2.HIRA@verysoft.jp> <20040730183111.11F2.HIRA@verysoft.jp> Message-ID: <20040801220624.FAEC.HIRA@verysoft.jp> 実装メモ。 Notes on implementing RELAX NG http://www.thaiopensource.com/relaxng/implement.html ここの「how to implement validation」に従って実装してみようと思う。 これを「XMLの検証器」ではなく、より抽象的な「S式の検証器」として提供した い。 その前にHaskell入門。 http://www.sampou.org/haskell/tutorial-j/ --hira From hira ＠ verysoft.jp Mon Aug 2 16:05:45 2004 From: hira ＠ verysoft.jp (HIRAUCHI Hideyuki) Date: Mon, 02 Aug 2004 16:05:45 +0900 Subject: [Kisp-dev 17] =?iso-2022-jp?b?UmU6IBskQkxaJE4lUCVqJUchPCU/GyhC?= In-Reply-To: <20040801220624.FAEC.HIRA@verysoft.jp> References: <20040730183111.11F2.HIRA@verysoft.jp> <20040801220624.FAEC.HIRA@verysoft.jp> Message-ID: <20040802155131.9A44.HIRA@verysoft.jp> An algorithm for RELAX NG validation http://www.thaiopensource.com/relaxng/derivative.html これはutil.matchを使えばHaskell風に書けるじゃないか。 楽に移植できるじゃないか。 エレガントじゃないか。 と思ったのだけど、マクロの展開にとんでもなく時間が掛かることが判明。 で、どうするか。 1. あらかじめ展開しておく △ macroexpandがちゃんと実行できるように展開してくれるか？ × 読めないソースになる 2. util.matchを調査して早く展開できるパターンを見つける 3. ごりごり書く とりあえず、util.matchを調査してみるか。 --hira #| このコードを展開するのに10秒近く掛かる。clauseを減らしていけば、その分早 く展開が終わる。 |# (use util.match) (define-syntax defmatch (syntax-rules () ((_ name clauses ...) (define (name . args) ((match-lambda clauses ...) args))))) (defmatch nullable (((:group p1 p2)) (and (nullable p1) (nullable p2))) (((:interleave p1 p2)) (and (nullable p1) (nullable p2))) (((:choice p1 p2)) (or (nullable p1) (nullable p2))) (((:one-or-more p)) (nullable p)) (((:element _ _)) #f) (((:attribute _ _)) #f) (((:list _)) #f) (((:value _ _ _)) #f) (((:data _ _)) #f) (((:data-except _ _ _)) #f) ((:not-allowed) #f) ((:empty) #t) ((:text) #t) (((:after _ _)) #f) ) From hira ＠ verysoft.jp Mon Aug 2 16:19:54 2004 From: hira ＠ verysoft.jp (HIRAUCHI Hideyuki) Date: Mon, 02 Aug 2004 16:19:54 +0900 Subject: [Kisp-dev 18] =?iso-2022-jp?b?UmU6IBskQkxaJE4lUCVqJUchPCU/GyhC?= In-Reply-To: <20040802155131.9A44.HIRA@verysoft.jp> References: <20040801220624.FAEC.HIRA@verysoft.jp> <20040802155131.9A44.HIRA@verysoft.jp> Message-ID: <20040802161721.9A47.HIRA@verysoft.jp> > とりあえず、util.matchを調査してみるか。 いきなり自己解決。 (define-syntax defmatch (syntax-rules () ((_ name clause ...) (define (name . args) (let/cc return (let1 x ((match-lambda clause (_ :unmatch)) args) (unless (eq? :unmatch x) (return x))) ... :unmatch))))) こうするとサクッと展開される。 clausesの数は少なくしないと駄目だってことか。 --hira From shiro ＠ lava.net Mon Aug 2 16:37:35 2004 From: shiro ＠ lava.net (Shiro Kawai) Date: Sun, 01 Aug 2004 21:37:35 -1000 (HST) Subject: [Kisp-dev 19] =?iso-2022-jp?b?UmU6IBskQkxaJE4lUCVqJUchPCU/GyhC?= In-Reply-To: <20040802161721.9A47.HIRA@verysoft.jp> References: <20040801220624.FAEC.HIRA@verysoft.jp> <20040802155131.9A44.HIRA@verysoft.jp> <20040802161721.9A47.HIRA@verysoft.jp> Message-ID: <20040801.213735.785299288.shiro@lava.net> util.matchは、マクロ展開時間よりもマッチの実行時間を最適化 しようとします。例えば次のようなマッチでは： (match '(a b d) (('a 'b 'c) 1) (('a 'b 'd) 2)) 単純にclauseをひとつづつマッチさせてゆくやり方だと、最初のclause で先頭のa, b はマッチしてcでfailしますが、次のclauseでまた先頭 からa, bとマッチさせてゆくことになります。その時点で既に最初の2項目は a, bであることが分かっているのですから、それは無駄になります。 util.matchではこのような共通部分項を認識して、重複した検査を しないようにしています。 で、ここからは推測ですが、共通部分項の認識は、たぶんclauseの数N、 clauseの平均の木の大きさMとして O((M*N)^2) くらいかかってて、 MやNが大きくなると極端に展開時間が長くなるんではないでしょうか。 1 clauseごとにマッチさせるようにすれば、それが無くなるので展開時間 は速くなりますが、上記のようにランタイムで同じ検査を何度もやるという ペナルティがあります。 妥協案としては、共通部分項を手で括り出してやる方法があるかも しれません。例えば例に使っていたやつですと、carがリストの場合と キーワードの場合でまず分割でき、次に頭のキーワードでディスパッチ できますよね。まあ、人間がコンパイラの最適化を肩代りしている ことになるんですが。 コンパイルする処理系では、マクロ展開はコンパイル時にやるのが 普通なので、そこで時間をかけても実行時の負担を減らすようにする 方が主流だと思います。 --shiro From hira ＠ verysoft.jp Mon Aug 2 17:02:22 2004 From: hira ＠ verysoft.jp (HIRAUCHI Hideyuki) Date: Mon, 02 Aug 2004 17:02:22 +0900 Subject: [Kisp-dev 20] =?iso-2022-jp?b?UmU6IBskQkxaJE4lUCVqJUchPCU/GyhC?= In-Reply-To: <20040801.213735.785299288.shiro@lava.net> References: <20040802161721.9A47.HIRA@verysoft.jp> <20040801.213735.785299288.shiro@lava.net> Message-ID: <20040802164659.9A4D.HIRA@verysoft.jp> On Sun, 01 Aug 2004 21:37:35 -1000 (HST) Shiro Kawai wrote: > util.matchではこのような共通部分項を認識して、重複した検査を > しないようにしています。 えー。そんな凄いことやってたんですか。気づきませんでした。ソース読みなが ら「共通部分の扱いは非効率そうだなぁ」と思ってたんです(←ロクに読めてな い)。 > 1 clauseごとにマッチさせるようにすれば、それが無くなるので展開時間 > は速くなりますが、上記のようにランタイムで同じ検査を何度もやるという > ペナルティがあります。 > > 妥協案としては、共通部分項を手で括り出してやる方法があるかも > しれません。例えば例に使っていたやつですと、carがリストの場合と > キーワードの場合でまず分割でき、次に頭のキーワードでディスパッチ > できますよね。まあ、人間がコンパイラの最適化を肩代りしている > ことになるんですが。 なるほど。とりあえず、バージョン1.0までは開発効率を優先するというポリシー でやってますので、このへんのチューニングはだいぶ先になりそうです。 解説ありがとうございました。 --hira From hira ＠ verysoft.jp Wed Aug 4 22:13:06 2004 From: hira ＠ verysoft.jp (HIRAUCHI Hideyuki) Date: Wed, 04 Aug 2004 22:13:06 +0900 Subject: [Kisp-dev 21] =?iso-2022-jp?b?UmU6IBskQkxaJE4lUCVqJUchPCU/GyhC?= In-Reply-To: <20040801220624.FAEC.HIRA@verysoft.jp> References: <20040730183111.11F2.HIRA@verysoft.jp> <20040801220624.FAEC.HIRA@verysoft.jp> Message-ID: <20040804214551.F9B4.HIRA@verysoft.jp> バージョン0(丸写し版)完了。 child-derivがメインで、データやパターンの内部表現はこんな感じらしい。 :emptyが返れば成功。 ;;;実行例 (define data '(:element-node (:q-name "adressBook" "") (:context "") ((:attribute-node (:q-name "name" "") "my-addr1")) ((:element-node (:q-name "card" "") (:context "") ((:attribute-node (:q-name "name" "") "Foo") (:attribute-node (:q-name "email" "") "foo ＠ ex.com")) ()) (:element-node (:q-name "card" "") (:context "") ((:attribute-node (:q-name "name" "") "Bar") (:attribute-node (:q-name "email" "") "bar ＠ ex.com")) ()) ) )) (define pattern '(:element (:ns-name "adressBook") (:group (:attribute (:ns-name "name") :text) (:one-or-more (:element (:ns-name "card") (:group (:attribute (:ns-name "name") :text) (:attribute (:ns-name "email") :text))) )) )) (child-deriv '(:context "") pattern data) ;=> :empty あとはSXMLをこの内部表現にコンパイルする部分を作ればXML,SXMLのバリデータ として使えそう。 最適化のポイントは山ほどあるけど、時間が無いので後回し。 --hira ;;;relax-ng0.scm #!../tools/gauche//bin/gosh -I../src (use srfi-1) (use srfi-2) (use srfi-13) (use util.match) (define uid (let1 id 0 (lambda () (format #f "id-~2,'0d" (inc! id))))) (define-macro (pr . args) `(format (standard-error-port) "~a\n" (list , ＠ args))) (define (pr . args) '()) (define-syntax defmatch (syntax-rules () ((_ name clause ...) (define (name . args) (let/cc return (let1 id (uid) (pr 'START id 'name "\n" (print-tree " " args)) (let1 x ((match-lambda clause (_ :unmatch)) args) (unless (eq? :unmatch x) ;(pr 'name 'clause x args) (pr 'END-O id 'name "\n" (print-tree "" x)) (return x))) ... (pr 'END-X id 'name :unmatch) :unmatch)))))) (defmatch contains ((:any-name _) #t) (((:any-name-except nc) n) (not (contains nc n))) (((:ns-name ns1) (:q-name ns2 _)) (equal? ns1 ns2)) (((:ns-name-except ns1 nc) (:q-name ns2 ln)) (and (equal? ns1 ns2) (not (contains nc (q-name ns2 ln))))) (((:name ns1 ln1) (:q-name ns2 ln2)) (and (equal? ns1 ns2) (equal? ln1 ln2))) (((:name-class-choice nc1 nc2) n) (or (contains nc1 n) (contains nc2 n))) ) (defmatch nullable (((:group p1 p2)) (and (nullable p1) (nullable p2))) (((:interleave p1 p2)) (and (nullable p1) (nullable p2))) (((:choice p1 p2)) (or (nullable p1) (nullable p2))) (((:one-or-more p)) (nullable p)) (((:element _ _)) #f) (((:attribute _ _)) #f) (((:list _)) #f) (((:value _ _ _)) #f) (((:data _ _)) #f) (((:data-except _ _ _)) #f) ((:not-allowed) #f) ((:empty) #t) ((:text) #t) (((:after _ _)) #f) ) (defmatch text-deriv ((cx (:choice p1 p2) s) (choice (text-deriv cx p1 s) (text-deriv cx p2 s))) ((cx (:interleave p1 p2) s) (choice (interleave (text-deriv cx p1 s) p2) (interleave p1 (text-deriv cx p2 s)))) ((cx (:group p1 p2) s) (let1 p (group (text-deriv cx p1 s) p2) (if (nullable p1) (choice p (text-deriv cx p2 s)) p))) ((cx (:after p1 p2) s) (after (text-deriv cx p1 s) p2)) ((cx (:one-or-more p) s) (group (text-deriv cx p s) (choice (one-or-more p) :empty))) ((cx :text _) :text) ((cx (:value dt value cx2) s) (if (datatype-equal dt value cx2 s cx1) :empty :not-allowed)) ((cx (:data dt params) s) (if (datatype-equal dt params s cx) :empty :not-allowed)) ((cx (:data-except dt params p) s) (if (and (datatype-allows dt params s cx) (not (nullable (text-deriv cx p s)))) :empty :not-allowed)) ((cx (:list p) s) (if (nullable (list-deriv cx p (words s))) :empty :not-allowed)) ((_ _ _) :not-allowed) ) (defmatch child-deriv ((cx p (:text-node s)) (text-deriv cx p s)) ((_ p (:element-node qn cx atts children)) (let* ((p1 (start-tag-open-deriv p qn)) (p2 (atts-deriv cx p1 atts)) (p3 (start-tag-close-deriv p2)) (p4 (children-deriv cx p3 children))) (end-tag-deriv p4))) ) (defmatch list-deriv ((cx p ()) p) ((cx p (h . t)) (list-deriv cx (text-deriv cx p h) t)) ) (defmatch choice ((p :not-allowed) p) ((:not-allowed p) p) ((p1 p2) (list :choice p1 p2)) ) (defmatch group ((p :not-allowed) :not-allowed) ((:not-allowed p) :not-allowed) ((p :empty) p) ((:empty p) p) ((p1 p2) (list :group p1 p2)) ) (defmatch interleave ((p :not-allowed) :not-allowed) ((:not-allowed p) :not-allowed) ((p :empty) p) ((:empty p) p) ((p1 p2) (list :interleave p1 p2)) ) (defmatch after ((p :not-allowed) :not-allowed) ((:not-allowed p) :not-allowed) ((p1 p2) (list :after p1 p2)) ) (defmatch datatype-allows ((("" "string") () _ _) #t) ((("" "token") () _ _) #t) ) (defmatch datatype-equal ((("" "string") s1 _ s2 _) (equal? s1 s2)) ((("" "token") s1 _ s2 _) (equal? (normalize-whitespace s1) (normalize-whitespace s2))) ) (define (normalize-whitespace s) (unwords (words s))) (defmatch apply-after ((f (:after p1 p2)) (after p1 (f p2))) ((f (:choice p1 p2)) (choice (apply-after f p1) (apply-after f p2))) ((f :not-allowed) :not-allowed) ) (defmatch start-tag-open-deriv (((:choice p1 p2) qn) (choice (start-tag-open-deriv p1 qn) (start-tag-open-deriv p2 qn))) (((:element nc p) qn) (if (contains nc qn) (after p :empty) :not-allowed)) (((:interleave p1 p2) qn) (choice (apply-after (flip interleave p2) (start-tag-open-deriv p2 qn)) (apply-after (interleave p1) (start-tag-open-deriv p2 qn)))) (((:one-or-more p) qn) (apply-after (flip group (choice (one-or-more p) :empty)) (start-tag-open-deriv p qn))) (((:group p1 p2) qn) (let1 x (apply-after (flip group p2) (start-tag-open-deriv p1 qn)) (if (nullable p1) (choice x (start-tag-open-deriv p2 qn)) x))) (((:after p1 p2) qn) (apply-after (flip after p2) (start-tag-open-deriv p1 qn))) ((_ qn) :not-allowed) ) (defmatch atts-deriv ((cx p ()) p) ((cx p ((:attribute-node qn s) . t)) (atts-deriv cx (att-deriv cx p (list :attribute-node qn s)) t)) ) (defmatch att-deriv ((cx (:after p1 p2) att) (after (att-deriv cx p1 att) p2)) ((cx (:choice p1 p2) att) (choice (att-deriv cx p1 att) (att-deriv cx p2 att))) ((cx (:group p1 p2) att) (choice (group (att-deriv cx p1 att) p2) (group p1 (att-deriv cx p2 att)))) ((cx (:interleave p1 p2) att) (choice (interleave (att-deriv cx p1 att) p2) (interleave p1 (att-deriv cx p2 att)))) ((cx (:one-or-more p) att) (group (att-deriv cx p att) (choice (one-or-more p) :empty))) ((cx (:attribute nc p) (:attribute-node qn s)) (if (and (contains nc qn) (value-match cx p s)) :empty :not-allowed)) ((_ _ _) :not-allowed) ) (defmatch value-match ((cx p s) (or (and (nullable p) (whitespace s)) (nullable (text-deriv cx p s))))) (defmatch start-tag-close-deriv (((:after p1 p2)) (after (start-tag-close-deriv p1) p2)) (((:choice p1 p2)) (choice (start-tag-close-deriv p1) (start-tag-close-deriv p2))) (((:group p1 p2)) (group (start-tag-close-deriv p1) (start-tag-close-deriv p2))) (((:interleave p1 p2)) (interleave (start-tag-close-deriv p1) (start-tag-close-deriv p2))) (((:one-or-more p)) (one-or-more (start-tag-close-deriv p))) (((:attribute _ _)) :not-allowed) ((p) p) ) (defmatch one-or-more ((:not-allowed) :not-allowed) ((p) (list :one-or-more p)) ) (defmatch children-deriv ((cx p ()) (children-deriv cx p '((:text-node "")))) ((cx p ((:text-node s))) (let1 p1 (child-deriv cx p (list :text-node s)) (if (whitespace s) (choice p p1) p1))) ((cx p children) (strip-children-deriv cx p children)) ) (defmatch strip-children-deriv ((_ p ()) p) ((cx p (h . t)) (strip-children-deriv cx (if (strip h) p (child-deriv cx p h)) t)) ) (defmatch strip (((:text-node s)) (whitespace s)) ((_) #f) ) ;(define (whitespace s) (all is-space s)) (defmatch whitespace ((s) (or (string-null? s) (#/ +/ s)))) (defmatch end-tag-deriv (((:choice p1 p2)) (choice (end-tag-deriv p1) (end-tag-deriv p2))) (((:after p1 p2)) (if (nullable p1) p2 :not-allowed)) ((_) :not-allowed) ) (define (flip m arg2 ) (lambda (arg1) (m arg1 arg2))) ;; vim:set fenc=utf-8 nowrap ts=2 sts=2 sw=2 tw=0 et foldmethod=marker foldmarker=#\|,\|#: From hira ＠ verysoft.jp Thu Aug 19 10:37:05 2004 From: hira ＠ verysoft.jp (HIRAUCHI Hideyuki) Date: Thu, 19 Aug 2004 10:37:05 +0900 Subject: [Kisp-dev 22] =?iso-2022-jp?b?UmU6IBskQkxaJE4lUCVqJUchPCU/GyhC?= In-Reply-To: <20040801220624.FAEC.HIRA@verysoft.jp> References: <20040730183111.11F2.HIRA@verysoft.jp> <20040801220624.FAEC.HIRA@verysoft.jp> Message-ID: <20040819103346.AF2B.HIRA@verysoft.jp> 木のバリデータの目標について、改めて考えてみた。 - MUST RelaxNGを全てサポートするのは難しいが、最低限ここまでやらなければならな い。でないと役に立たない、というぎりぎりの線。2月末までの目標。 - エラーハンドリング →Kispアプリ開発者は構文木エラーの分かりやすい出力が標準で欲しい。そのた めに木のバリデータが存在するので、これは必須。 - コンパイラ(簡易S式→内部表現) →ナマの内部表現なんて書けたもんじゃない - 内部表現の整形出力 - SHOULD RelaxNGの仕様は全てサポートすべきだろう。 - 名前付パターン(:grammar,:start,:define,:ref) →これがないと再帰定義できない - データ型 - 列挙型(:value) - リスト型(:list) - 順序なし内容モデル(:interleave,:mixed) →(これは済んでいるのか？) - 外部のパターンの参照(:externalRef) - パターンの結合(:combine) - 文法のマージ(:include,:notAllowed) - パターンの上書き(:includeによるオーバーライド) - 名前空間 →(これはコンパイラの問題かも) - 名前クラス(:anyName,:nsName,:except) - コメント(:comment) →名前空間は関係なし。手っ取り早いコメント機能。 - 名前空間によるコメント機能 - :div - 文法の入れ子(:paternRef) - COULD できればこんな機能も提供したい。 - コンパイラ(RELAX NG Compact Syntax→簡易S式) http://www.thaiopensource.com/relaxng/compact/ →こっちのほうが既存のRelaxNGユーザに優しいから - ユニークな要素(:unique) 要素に対して、次の(XML属性のような)制限を持たせたい。 1. 出現順序を問わない 2. 出現回数は1回(:optionalをつけて「0か1回」にすることも可能) 「XMLの検証器」ではなく、より抽象的な「S式の検証器」として使用するために は、この機能を加えれば充分ぽい。 ※:interleaveは出現回数を任意にしているのでちょっと違う。 --hira From hira ＠ verysoft.jp Tue Aug 31 23:46:22 2004 From: hira ＠ verysoft.jp (HIRAUCHI Hideyuki) Date: Tue, 31 Aug 2004 23:46:22 +0900 Subject: [Kisp-dev 23] =?iso-2022-jp?b?UmU6IBskQkxaJE4lUCVqJUchPCU/GyhC?= =?iso-2022-jp?b?ICh2ZXIuMSk=?= In-Reply-To: <20040801220624.FAEC.HIRA@verysoft.jp> References: <20040730183111.11F2.HIRA@verysoft.jp> <20040801220624.FAEC.HIRA@verysoft.jp> Message-ID: <20040831234536.A9DE.HIRA@verysoft.jp> バージョン1(エラーメッセージ無し版)完了。 http://cvs.sourceforge.jp/cgi-bin/viewcvs.cgi/kisp/Kisp/src/kisp/kival.scm?rev=1.4&content-type=text/vnd.viewcvs-markup Choiceの定義が変だったのでこんな風に修正した。 (defmatch choice ((p :not-allowed) p) ((:not-allowed p) p) ((p1 p2) (if (eq? p1 p2) p1 (list :choice p1 p2))) ;<-ここのif文に注目 ) 「まったく同じものを選べ」なんてナンセンスだから、片方を返すようにしている。 でないとこんなパターンが結果として返ってくる。 (:choice (:choice :empty :empty) (:choice :empty :empty)))) もともとはこう定義されていた。 choice :: Pattern -> Pattern -> Pattern choice p NotAllowed = p choice NotAllowed p = p choice p1 p2 = Choice p1 p2 Haskellだとこれでもちゃんと動くのだろうか。 --hira