source: project/sxml-transforms/chicken/sxml-to-sxml.scm @ 4

Last change on this file since 4 was 4, checked in by felix winkelmann, 16 years ago

added missing files

File size: 6.2 KB
1;; This file has been modified for chicken: tests are deleted, and
2;; pre-post-order is renamed to pre-post-order-composable.
3(declare (export pre-post-order-composable))
5; Transforming SXML to SXML: Composing SXML transformations
7; The present code introduces and tests a version of pre-post-order
8; that transforms an SXML document into a _strictly conformant_ SXML
9; document. That is, the result of a pre-post-order transformation can
10; be queried with SXPath or transformed again with SXSLT.
12; Joerg-Cyril Hoehle wrote on the SSAX-SXML mailing list about
13; chaining of transformations on a SXML source:
14;       SXML --transform--> SXML1 --transform--> SXML2 ... --> XML
15; It's only the last transformation step that would produce XML.
16; We can use a pre-post-order traversal combinator with an appropriate
17; stylesheet to run each 'transform' step above. SRV:send-reply at the
18; end will write out the resulting XML document.
19; (see Joerg-Cyril Hoehle's messages on the SSAX-SXML list on Oct
20; 21 and 22, 2003).
22; Composing SXML transformations by feeding the result of one
23; pre-post-order traversal into another works. Still, the result of
24; pre-post-order is merely a tree of fragments, which is generally not
25; a strictly valid SXML.  Joerg-Cyril Hoehle pointed out that, for
26; example, given an SXML document
27;       '(Data (repeat 3 (random-Header 3))))
28; a sample transformation
29; (pre-post-order-composable sxml
30;   `((repeat *macro*
31;      . ,(lambda (tag count . elems)
32;         (apply make-list count elems)))
33;      (random-Header *preorder*
34;        . ,(lambda (tag elems)
35;           `(Header ,(gensym))))
36;      (*text* . ,(lambda (trigger x) x))
37;      (*default* . ,(lambda x x))))
39; yields the following.
40; (Data
41;  ((Header VOTj)
42;   (Header 0qel)
43;   (Header bA97)))
45; All (Header ...) elements are enclosed in an extra pair of
46; parentheses. In general, pre-post-order may add extra nesting levels
47; and insert empty lists. Both these features break the strict SXML
48; specification compliance of the transformation result. Still,
49; pre-post-order itself can process such a tree correctly. Therefore,
50; if we use only pre-post-order for our multi-stage SXML
51; transformations, no problems occur. However, if we wish to employ
52; SXPath to select parts from a pre-post-order-transformed SXML
53; document, we get a problem. SXPath, unlike pre-post-order, insists
54; on its source document being fully SXML compliant.
56; The problem can be rectified, by changing pre-post-order as shown in
57; the code below. The only change is replacing the two occurrences of
58; 'map' (there are only two such occurrences) with
59; map-node-concat. Justification for the change: a pre-post-order
60; handler can yield either a node, or a nodelist. Now, if the handler
61; returns a nodelist, we _splice_ it in in the result tree. This
62; operation seems to make sure that each node of a tree is a valid
63; SXML node.
65; For a pure SXML-to-XML conversion, the splicing-in seems to be an
66; overkill. Therefore, it may make sense to keep both versions of
67; pre-post-order. Personally I have no problem with proliferation of
68; pre-post-order-like functions. I believe that it is the data
69; structure/protocols that should be standardized and
70; parsimonious. Each user may write processing code in his own way. Of
71; course some of the processing code turns out more general than the
72; other, and can be shared. Nevertheless, it's the common data
73; structure, the common format that guarantees interoperability --
74; rather than the common library. Code should be tailored (or even
75; automatically generated) to suit circumstances.
78; The following is a Bigloo-specific module declaration.
79; Other Scheme systems have something similar.
80; (module sxml-to-sxml
81;   (include "myenv-bigloo.scm")
82;   (include "srfi-13-local.scm") ; or import from SRFI-13 if available
83;   (include "util.scm")
84;   )
86; $Id: sxml-to-sxml.scm,v 1.2 2004/07/07 16:02:30 sperber Exp $
88; map-node-concat FN NODELIST -> NODELIST
89; Map FN to each element of NODELIST where FN is a function
90;       NODE -> NODE or NODELIST
91; If an application of FN yields a NODELIST (including the empty list),
92; we _splice_ it in into the result. Essentially,
93;       (map-node-concat fn nodelist)
94; is equivalent to
95; (apply append
96;   (map (lambda (node)
97;        (let ((result (fn node)))
98;          (if (nodelist? result) result (list result))))
99;     nodelist))
101(define (map-node-concat fn lst)
102  (if (null? lst) '()
103    (let ((result (fn (car lst))))
104      (cond
105        ((null? result)                 ; It's a null node-list, splice it in
106          (map-node-concat fn (cdr lst)))
107        ((and (pair? result) (not (symbol? (car result))))
108                ;  it's a non-null node-list
109          (append result (map-node-concat fn (cdr lst))))
110        (else
111          (cons   result (map-node-concat fn (cdr lst))))))))
113; The following is almost identical to pre-post-order
114; from ../lib/SXML-tree-trans.scm
115; except that the two occurrences of 'map' in that pre-post-order
116; (there are only two such occurrences) are replaced with map-node-concat
117; in the code below.
119(define (pre-post-order-composable tree bindings)
120  (let* ((default-binding (assq '*default* bindings))
121         (text-binding (or (assq '*text* bindings) default-binding))
122         (text-handler                  ; Cache default and text bindings
123           (and text-binding
124             (if (procedure? (cdr text-binding))
125                 (cdr text-binding) (cddr text-binding)))))
126    (let loop ((tree tree))
127      (cond
128        ((null? tree) '())
129        ((not (pair? tree))
130          (let ((trigger '*text*))
131            (if text-handler (text-handler trigger tree)
132              (error "Unknown binding for " trigger " and no default"))))
133                                        ; tree is a nodelist
134        ((not (symbol? (car tree))) (map-node-concat loop tree))
135        (else                           ; tree is an SXML node
136          (let* ((trigger (car tree))
137                 (binding (or (assq trigger bindings) default-binding)))
138            (cond
139              ((not binding) 
140                (error "Unknown binding for " trigger " and no default"))
141              ((not (pair? (cdr binding)))  ; must be a procedure: handler
142                (apply (cdr binding) trigger
143                  (map-node-concat loop (cdr tree))))
144              ((eq? '*preorder* (cadr binding))
145                (apply (cddr binding) tree))
146              ((eq? '*macro* (cadr binding))
147                (loop (apply (cddr binding) tree)))
148              (else                         ; (cadr binding) is a local binding
149                (apply (cddr binding) trigger 
150                  (pre-post-order-composable (cdr tree) (append (cadr binding) bindings)))
151                ))))))))
Note: See TracBrowser for help on using the repository browser.