XMLっぽい構造をパースする

指定した範囲の内側でだけ、テキストのパターン置換をしたい。つまり、こういうことがしたい。

gosh> str
"<title>
  <en>Introduction</en>
  <ja>は じ め に</ja>
</title>
<p>
  <en>
    Here we'll discuss about english
      <footnote>
        <p class="footnote">
          Or, any language you speak as a native tongue.
        </p>
      </footnote>
    .
  </en>
  <ja>
    ここでは日本語
      <footnote>
        <p class="footnote">
          で な く て も、母 国 語 な ら な ん で も い い。
        </p>
      </footnote>
    について説明しよう。
  </ja>
</p>"

gosh> (regexp-replace-all-among-all 'ja #/\b\s\b/ str "")
"<title>
  <en>Introduction</en>
  <ja>はじめに</ja>
</title>
<p>
  <en>
    Here we'll discuss about english
      <footnote>
        <p class="footnote">
          Or, any language you speak as a native tongue.
        </p>
      </footnote>
    .
  </en>
  <ja>
    ここでは日本語
      <footnote>
        <p class="footnote">
          でなくても、母国語ならなんでもいい。
        </p>
      </footnote>
    について説明しよう。
  </ja>
</p>"

先日のような邪道な試行錯誤をしたり、再帰下降パーザについて少し勉強したりした結果、地道にパーズするのがいちばんだということがよく分かった。PerlやJaveなら優れたXML処理のライブラリを使うべきなのかもしれないね。

置換をほどこしたい領域（上の例では<ja>...</ja>の部分）を取り出すことから考えよう。その前に、XMLっぽいテキストを構成するパーツを先頭から順番に取り出してくれるプロシージャ read-xml があると仮定する。read-xml を一回呼ぶと、「<title>」や「<p class="footnote">」のようなタグ、もしくは、タグの前後の本文を、テキストの先頭から順番にゲットできる。こんな感じ。

(with-input-from-string "aaa<p>bbb</p>ccc"
  (lambda ()
    (read-xml) ; ⇒ aaa
    (read-xml) ; ⇒ <p>
    (read-xml) ; ⇒ bbb
    (read-xml) ; ⇒ </p>
    (read-xml) ; ⇒ ccc
  ))

この read-xml でひとつずつパーツを取り出してチェックしていく。探している領域を開始するタグ（いまの例では<ja>）が取り出せたら、終了を表すタグ（いまの例では</ja>）が現れるまで次々にパーツをつないでいくことで、ほしい領域が取り出せる。領域がネストしている可能性もあるので、開始タグの数もチェックしておくようにする。ざっくり書くとこんな感じ。利便性を考えて、領域の前後の文字列も返すようにした。

(define (xml-maximal-region tagname)
  (define (xmltag? e)
    (and (> (string-length e) 1)
         (char=? #\< (string-ref e 0))))
  (define (tag->name e)
      (string-trim-right
       (x->string (string-drop e 1))
       #\>))
  (define (start-tag? e)
    (and (xmltag? e)
         (equal? (x->string tagname)
                 (tag->name e))))
  (define (end-tag? e)
    (and (xmltag? e)
         (equal? (x->string tagname)
                 (string-drop (tag->name e) 1))))
  (define (rest-xml)
    (let R ((next (read-xml)))
      (if (string-null? next)
          ""
          (string-append next (R (read-xml))))))
  (define (in-region e body c before)
    (cond ((string-null? e)
           (error "Premature end of input -- GET-XMLTAGGED-MAXIMAL-REGION"))
          ((end-tag? e)
           (if (= 0 c)
               (values before (string-append body e) (rest-xml))
               (in-region (read-xml) (string-append body e) (- c 1) before)))
          ((start-tag? e)
           (in-region (read-xml) (string-append body e) (+ c 1) before))
          (else
           (in-region (read-xml) (string-append body e) c before))))
  (define (out-region e body before)
    (cond ((string-null? e)
           (values before "" ""))
          ((start-tag? e)
           (in-region (read-xml) e 0 before))
          (else
           (out-region (read-xml) body (string-append before e)))))
  (out-region (read-xml) "" ""))

この xml-maximal-region を使えば、求めるプロシージャ regexp-replace-all-among-all が簡単に定義できる。

(define (regexp-replace-all-among-all region-declaration rx str sub)
  (with-input-from-string str
    (lambda ()
      (receive (before region after)
           (xml-maximal-region region-declaration)
        (string-append before
                       (regexp-replace-all rx region sub)
                       (if (string-null? after)
                           after
                           (regexp-replace-all-among-all region-declaration rx after sub)))))))

あとは read-xml を書けばいい。むずかしいところはないけど面倒。長いので、全体とあわせて下記を参照。

replace-among.scm


References

---

「なんでも再帰」Shiro Kawai（2003/1）
http://www.shiro.dreamhost.com/scheme/docs/tailcall-j.html

『Perl & XML』：Erik T. Ray,Jason McIntosh（2002/11）
http://www.amazon.co.jp/dp/4873111064