kiyoka.2008_01_09 RSSPLAIN

Related pages: !kiyoka.blog.list !kiyoka.blog.2008_01
55555555555555555555555555555555555555555555555555555555
5

[OldType]Kahua対応の続き

5

結局、OldTypeのSXMLライクな中間コードを高階タグ関数に変換するコードはこうなった。

5

中間コードはdivタグとaタグの属性がalistになっているという変則的な形を取った。

5

また、p-normalや pre-quoteなど、OldType専用のタグを用意している。

5

そうすれば、この関数での変形処理がやりやすくなる。

5

マクロを使えばコード全体が少し短くなるとは思うが、これ以上変換プロセスを複雑にしたく無いので、quasi-quoteを多用する形にした。

5

これでやっとKahua上でアプリケーション開発する足場が固まった。

5
;; utility : internal sxml format to highger-order-tag
5
(define (sxml->higher-order-tag sxmls)
5
  (div/
5
   (node-set
5
    (let rec
5
        ((sxmls sxmls))
5
      (match sxmls
5
             (()  '())
5
             (((and (name . _) sxml) . rest) ;; generic node
5
              (let1 arg (cdr sxml)
5
                    (cons
5
                     (case name
5
                       ((div)
5
                        (let1 param (car arg) ;; param is assoc-list
5
                              `(,@(div/
5
                                   (@/
5
                                    (id (assq-ref param 'lineno))
5
                                    (class (format "new~d" (assq-ref param 'latest-rate))))
5
                                   (node-set (rec (cdr arg)))))))
5
                       ((a)   
5
                        (let1 param (car arg) ;; param is assoc-list
5
                              `(,@(a/
5
                                   (@/
5
                                    (href (assq-ref param 'href)))
5
                                   (node-set (rec (cdr arg)))))))
5
                       ((p-normal)    `(,@(p/   (@/ (class "oldtype"))    (node-set (rec arg)))))
5
                       ((pre-quote)   `(,@(pre/ (@/ (class "quote"))      (node-set (rec arg)))))
5
                       ((pre-verb)    `(,@(pre/ (@/ (class "verb"))       (node-set (rec arg)))))
5
                       ((pre-ul1)     `(,@(pre/ (@/ (class "ul1"))        (node-set (rec arg)))))
5
                       ((pre-ul2)     `(,@(pre/ (@/ (class "ul2"))        (node-set (rec arg)))))
5
                       ((pre-ul3)     `(,@(pre/ (@/ (class "ul3"))        (node-set (rec arg)))))
5
                       ((pre-ol1)     `(,@(pre/ (@/ (class "ol1"))        (node-set (rec arg)))))
5
                       ((pre-ol2)     `(,@(pre/ (@/ (class "ol2"))        (node-set (rec arg)))))
5
                       ((pre-ol3)     `(,@(pre/ (@/ (class "ol3"))        (node-set (rec arg)))))
5
                       ((h1)          `(,@(h1/  (@/ (id "h1"))            (node-set (rec arg)))))
5
                       ((h2)          `(,@(h2/  (@/ (id "h2"))            (node-set (rec arg)))))
5
                       ((h3)          `(,@(h3/  (@/ (id "h3"))            (node-set (rec arg)))))
5
                       ((h4)          `(,@(h4/  (@/ (id "h4"))            (node-set (rec arg)))))
5
                       ((h5)          `(,@(h5/  (@/ (id "h5"))            (node-set (rec arg)))))
5
                       ((h6)          `(,@(h6/  (@/ (id "h6"))            (node-set (rec arg)))))
5
                       ((wiki-macro)  `(,@(oldtype:format-macro (car arg))))
5
                       ((wiki-name)   `(,@(oldtype:expand-wiki-name (car arg))))
5
                       ((hr)          (hr/))
5
                       (else
5
                        `(p/ ,(format "!!Error : no such tag \"~a\"!!" name))))
5
                     (rec rest))))
5
             ((other . rest)
5
              (cons other (rec rest))))))))
5