neat sxml

S-expressed XML

今やどこもかしこも XML ばかりです.
この XML ってのはタグで囲まれてますけど, 長文な文章があるようなものでない限り, データよりタグの方が多いことって結構ありますよね.
つまりデータがタグに埋もれているので非常に読みにくい, ということです.

んで, S 式な人から見ると, 閉じタグって邪魔じゃんって発想になるんですよね.
まあなぜ閉じタグがあるかというのは単純な検索でテキストを処理しやすいとか lisp みたくカッコだけだと対応をミスったときにエラー個所を特定するのが難しいとかいろいろあるみたいです. まあそれはしょうがない.

それなら, S 式で同等の内容を記述して, それを必要に応じて XML に展開するようにして普段は S 式の方をメンテナンスしようよ, という発想はとても自然だと思われます.
構文の定義の仕方はいろいろやり方がありそうですが, 以下では SXML というのを使わしてもらいます.
SXML はOleg Kiselyov さんの site で紹介されているものです.
この人の site にはコードサンプルが沢山あります.
XML の parser tool とか, 高度な話題で満載です.
ちなみにkawai さんの site では上記 Oleg さんのツールを Gauche で使えるようにする方法があります.

SXML は, 百聞は一見に如かず, 例を見ればすぐわかるでしょう.
以下は XML というか XHTML ですけど,

sxml	xml
(html (head (title "sxml")) (body (@ (bgcolor "blue") (text "white")) (center (b "Hello."))))	<html> <head><title>sxml</title></head> <body bgcolor="blue" text="white"> <center><b> Hello.</b></center> </body> </html>

sxml

xml

(html
 (head (title "sxml"))
 (body
  (@ (bgcolor "blue")
     (text    "white"))
  (center (b "Hello."))))

<html>
 <head><title>sxml</title></head>
 <body bgcolor="blue" text="white">
  <center><b> Hello.</b></center>
 </body>
</html>

左の SXML を変換すると右の XML になるということです.
要素は list の car, 内容は cdr, 属性は @ に続く cdr, という感じです.
閉じタグが無い分だけ, コード量も削減できますね.
SXML から XML を生成するコードも Oleg さんの site にありますけど, 結構いろいろ複雑なことやっている上に, 単純に変換したいだけでも沢山の関数を load しないといけません.
ということで, 自分の練習の意味も含めて, SXML から XML を吐くコードを scheme で書いてみました.

(define (sxml->xml sxml)
  (define (make-attr l ac)
    (if (null? l) ac
        (make-attr
         (cdr l) (string-append ac " " (symbol->string (caar l))
                                "=\"" (cadar l) "\""))))
  (define (make-xml x bef aft)
    (cond ((string? x) (append bef (list x) aft))
          ((and (pair? x) (symbol? (car x)))
           (let ((tag (symbol->string (car x))))
             (if (and (not   (null? (cdr x)))
                      (pair? (cadr x))
                      (eq? (caadr  x) '@))
                 (make-xml (cddr x)
                           (append bef (list 'BO tag (make-attr (cdadr x) "") 'BC))
                           (append     (list 'EO tag 'EC) aft))
                 (make-xml (cdr x)
                           (append bef (list 'BO tag 'BC))
                           (append     (list 'EO tag 'EC) aft)))))
          ((pair? x) (make-xml ()
                               (make-xml (car x) bef ())
                               (make-xml (cdr x) () aft)))
          (else (append bef aft))))
  ;; main
  (make-xml sxml () ()))
;; utility
(define (cat-normal l s)
  (cond ((null? l) s)
        ((string? (car l))
         (cat-normal (cdr l) (string-append s (car l))))
        (else (cat-normal (cdr l)
                          (string-append s (case (car l)
                                             ((BO)    "<")
                                             ((EO)    "</")
                                             ((BC EC) ">\n")))))))
;; utility
(define (cat-clark l s i)
  (cond ((null? l) s)
        ((string? (car l))
         (cat-clark (cdr l) (string-append s (car l)) i))
        (else
         (case (car l)
           ((BO)    (cat-clark (cdr l) (string-append s "<" ) (+ i 1)))
           ((EO)    (cat-clark (cdr l) (string-append s "</") (- i 1)))
           ((BC EC) (cat-clark (cdr l)
                               (string-append s "\n" (make-string i #\ ) ">") i))))))

ちゃんと末尾再帰になってるのかな?
とりあえずこれを定義して,

;; data difinition
(define data
  `("<!DOCTYPE etc...>\n"
    (html
     (head (title "sxml"))
     (body
      (@ (bgcolor "blue")
         (text    "white"))
      (center (b "Hello."))))))

;; output!
(display (cat-normal
           (sxml->xml data) ""))

こうすると, 標準出力には

<!DOCTYPE etc...>
<html>
<head>
<title>
sxml</title>
</head>
<body bgcolor="blue" text="white">
<center>
<b>
Hello.</b>
</center>
</body>
</html>

こんな風に出力できます.
ちなみに

;; output!
(display (cat-clark
          (sxml->xml data)
          "" 0))

とすると,

<!DOCTYPE etc...>
<html
 ><head
  ><title
   >sxml</title
  ></head
 ><body bgcolor="blue" text="white"
  ><center
   ><b
    >Hello.</b
   ></center
  ></body
></html
>

という出力にもできます.
Clark 式っていうんですかね, こういうの.
見易いかどうかは微妙なような気がしないでもない... まあいいや

Neat SXML

てことでいくらか見易くなったのですが, ある種の構造ではまだ冗長な部分が見られることがあります.
ちょっと下のやつを眺めてみてください.

'(table
  (@ (border "1"))
  (tr (td "1") (td "2") (td "3") (td "4") (td "5")
      (td "6") (td "7") (td "8") (td "9") (td "0"))
  (tr (td "q") (td "w") (td "e") (td "r") (td "t")
      (td "y") (td "u") (td "i") (td "o") (td "p"))
  (tr (td "a") (td "s") (td "d") (td "f") (td "g")
      (td "h") (td "j") (td "k") (td "l") (td ";"))
  (tr (td "z") (td "x") (td "c") (td "v") (td "b")
      (td "n") (td "m") (td ",") (td ".") (td "/")))

こいつの html 的な見た目はこうなります.

1	2	3	4	5	6	7	8	9	0
q	w	e	r	t	y	u	i	o	p
a	s	d	f	g	h	j	k	l	;
z	x	c	v	b	n	m	,	.	/

これは qwerty 配列ですけど, 上の list は td とかが沢山あってなんか勿体ないような気がしませんか?
少くとも私はもっと「圧縮」できるように見えたのです.
んで, 折角 lisp なんだから macro を使えばええやんかということで, 考えたのが次のやつ.

;; utility
(define (for-each-tree f g n tree r)
  (cond ((null? tree) r)
        ((not (pair? tree)) (f tree))
        (else (for-each-tree
               f g n (cdr tree)
               (g (for-each-tree f g n (car tree) n) r)))))
;; utility
(define (r-cons x y)    (append y (list x)))

(define (nsx->sxml nsx)
  (let ((head (car  nsx))
        (body (cadr nsx)))
    (map (lambda (data)
           (for-each-tree
            (lambda (x) (if (integer? x) (list-ref data x) x))
            r-cons '() head '()))
         body)))

上の 2 つの関数は, こちらで解説されている tail recursive な for-each-tree を有難く使わせてもらってます.
nsx は Neat SXml の略で, 私が勝手につけました. なので他所では通じないでしょう（笑）.

nsx->sxml はたとえば以下(左)のような形式の list を引数にとります.

nsx	sxml
(nsx->sxml '((tr (td 0) (td 1)) (("1" "2") ("q" "w"))))	((tr (td "1") (td "2")) (tr (td "q") (td "w")))

左を評価すると右のようになるわけです.
ちなみにやろうと思えばタグも展開できます.

nsx	sxml
(nsx->sxml '((tr (td (0 1))) ((em "more") (strong "most")))))	((tr (td (em "more"))) (tr (td (strong "most"))))

テンプレートとデータから list に展開するようなイメージですか.
数字の添字に相当する list の中のデータがそこに展開されるということです.

なのでこれを splice してもっとデカい list に埋めこんでやることができるわですよ.

`(table
  (@ (border "1"))
  ,@(nsx->sxml
     '((tr (td 0)(td 1)(td 2)(td 3)(td 4)
           (td 5)(td 6)(td 7)(td 8)(td 9))
       (("1" "2" "3" "4" "5" "6" "7" "8" "9" "0")
        ("q" "w" "e" "r" "t" "y" "u" "i" "o" "p")
        ("a" "s" "d" "f" "g" "h" "j" "k" "l" ";")
        ("z" "x" "c" "v" "b" "n" "m" "," "." "/")))))

これを評価すると上で書いた SXML の qwerty のテーブルと同一になります.
実際, 上のやつはこれを評価したのですから.
どうでしょう. そこそこ見易いんじゃないですかね.
まあ sxml の attribute である @ と macro の splicing である ,@ とが視覚的にごっちゃになりそうではありますが, neat sxml に利点があるとすれば,

データと構造を分離できる
字数が減るので全体の俯瞰がしやすい
scheme code として valid なので扱いが楽

ってところでしょうか.
分離できるわけですから,

(define qwerty-list
  '(("1" "2" "3" "4" "5" "6" "7" "8" "9" "0")
    ("q" "w" "e" "r" "t" "y" "u" "i" "o" "p")
    ("a" "s" "d" "f" "g" "h" "j" "k" "l" ";")
    ("z" "x" "c" "v" "b" "n" "m" "," "." "/")))

`(table
  (@ (border "1"))
  ,@(nsx->sxml
     `((tr (td 0)(td 1)(td 2)(td 3)(td 4)
           (td 5)(td 6)(td 7)(td 8)(td 9))
       ,qwerty-list)))

みたいにしてもいいわけですね. back quote や comma に注意してください.
もちろん要素の数とかは一致してなきゃダメですけど.

逆に欠点としては, こういう固定的な構造の繰り返しでなければその利点を発揮できない, ということがあると思います.
データとして偏っていなければ file の圧縮に意味がないのと同じです.

ちなみにこれを更に html にすると以下になります.

<table border="1">
  <tr>
    <td>1</td><td>2</td><td>3</td><td>4</td><td>5</td>
    <td>6</td><td>7</td><td>8</td><td>9</td><td>0</td>
  </tr>
  <tr>
    <td>q</td><td>w</td><td>e</td><td>r</td><td>t</td>
    <td>y</td><td>u</td><td>i</td><td>o</td><td>p</td>
  </tr>
  <tr>
    <td>a</td><td>s</td><td>d</td><td>f</td><td>g</td>
    <td>h</td><td>j</td><td>k</td><td>l</td><td>;</td>
  </tr>
  <tr>
    <td>z</td><td>x</td><td>c</td><td>v</td><td>b</td>
    <td>n</td><td>m</td><td>,</td><td>.</td><td>/</td>
  </tr>
</table>

単純な変換だけではこんな綺麗に indent しませんけど, 一応同じ土俵ということで html も見易くしてます.
データはだいぶタグに埋もれちゃいますねー.

ただ, 昨今では大抵は既に XML があってそれをメンテするっていう形でしょう.
こういう手法が威力を発揮するのはゼロから書き上げるときでしょうから, やりようによってはイロイロ面白いことができそうではありますが, 実際どれだけ使いみちがあるかっていうとこれまたビミョーかもなあ...

役に立たないので戻る