9 val singleton : elt -> t
10 val cons : elt -> t -> t
11 val snoc : t -> elt -> t
12 val concat : t -> t -> t
13 val concat3 : t -> t -> t -> t
14 val concat4 : t -> t -> t -> t -> t
15 val conscat : elt -> t -> t -> t
16 val conscat3 : elt -> t -> t -> t -> t
17 val conscat4 : elt -> t -> t -> t -> t -> t
18 val subtree_tags : Tree.t -> elt -> Tag.t -> t
19 val subtree_elements : Tree.t -> elt -> t
20 val iter : ( elt -> unit) -> t -> unit
21 val fold : ( elt -> 'a -> 'a) -> t -> 'a -> 'a
23 val serialize : string -> Tree.t -> t -> unit
26 module Count : S with type t = int =
35 let concat x y = x + y
36 let concat3 x y z = x + y + z
37 let concat4 x y z t = x + y + z + t
38 let conscat _ x y = 1 + x + y
39 let conscat3 _ x y z = 1 + x + y + z
40 let conscat4 _ x y z t = 1 + x + y + z + t
41 let subtree_tags tree node tag = Tree.subtree_tags tree node tag
42 let subtree_elements tree node = Tree.subtree_elements tree node
43 let iter _ _ = failwith "iter not implemented"
44 let fold _ _ _ = failwith "fold not implemented"
45 let map _ _ = failwith "map not implemented"
47 let serialize _ _ _ = ()
52 | Cons of Tree.node * clist
53 | Concat of clist * clist
54 | ConsCat of Tree.node * clist * clist
55 | SubtreeTags of Tree.t * Tree.node * Tag.t
56 | SubtreeElts of Tree.t * Tree.node
59 type 'a mat = { mutable clist : clist;
60 mutable length : int }
62 module Mat : S with type t = Tree.node mat =
64 type t = Tree.node mat
67 let empty = { clist = Nil; length = 0 }
68 let singleton e = { clist = Cons(e, Nil) ; length = 1 }
69 let cons e l = { clist = Cons(e, l.clist); length = l.length + 1 }
71 let ll1 = l1.length in
72 if ll1 == 0 then l2 else
73 let ll2 = l2.length in if ll2 == 0 then l1 else
74 { clist = Concat(l1.clist, l2.clist); length = ll1 + ll2 }
76 let snoc l e = concat l (singleton e)
80 let () = at_exit (fun () -> Printf.eprintf "Dummy concatenations: %i/%i\n%!" !_empty !_total)
83 let l = concat l1 l2 in
84 if l.length == 0 then incr _empty;
88 let concat3 l1 l2 l3 = concat l1 (concat l2 l3)
89 let concat4 l1 l2 l3 l4 = concat (concat l1 l2) (concat l3 l4)
93 let ll1 = l1.length in
94 if ll1 == 0 then cons e l2 else
95 let ll2 = l2.length in if ll2 == 0 then cons e l1 else
96 { clist = ConsCat(e, l1.clist, l2.clist); length = 1 + ll1 + ll2 }
98 (* let conscat e l1 l2 = cons e (concat l1 l2) *)
100 let conscat3 e l1 l2 l3 = conscat e l1 (concat l2 l3)
101 let conscat4 e l1 l2 l3 l4 = conscat e l1 (concat l2 (concat l3 l4))
103 let subtree_tags tree node tag =
104 { clist = SubtreeTags(tree, node, tag);
105 length = Tree.subtree_tags tree node tag }
106 let subtree_elements tree node =
107 { clist = SubtreeElts(tree, node);
108 length = Tree.subtree_elements tree node }
110 let fst_tagged tree t tag =
111 if Tree.tag tree t == tag then t
112 else Tree.tagged_descendant tree t tag
114 let fst_element tree t =
115 let tag = Tree.tag tree t in
116 let t = if Ptset.Int.mem tag
117 (Ptset.Int.remove Tag.document_node (Tree.element_tags tree))
119 else Tree.first_element tree t
120 in Tree.first_element tree t
122 let element_fold f tree t acc =
123 let rec loop node acc =
124 if node == Tree.nil then acc
126 let acc = f node acc in
127 let acc' = loop (Tree.first_element tree node) acc in
128 loop (Tree.next_element tree node) acc'
130 loop (fst_element tree t) acc
132 let element_iter f tree t =
134 if node != Tree.nil then begin
136 loop (Tree.first_element tree node);
137 loop (Tree.next_element tree node)
140 let t' = fst_element tree t in loop t'
142 let tag_fold f tree t tag acc =
143 let rec loop close node acc =
144 if node > Tree.nil && node < close then acc
146 let acc = f node acc in
147 loop close (Tree.tagged_next tree node tag) acc
149 let t' = fst_tagged tree t tag in
150 loop (Tree.closing tree t) t' acc
152 let tag_iter f tree t tag =
153 let rec loop close node =
154 if node > Tree.nil && node < close then begin
156 loop close (Tree.tagged_next tree node tag);
159 let t' = fst_tagged tree t tag in
160 loop (Tree.closing tree t) t'
166 | Cons(e, ll) -> loop ll (f e acc)
167 | Concat(l1, l2) -> loop l2 (loop l1 acc)
168 | ConsCat(e, l1, l2) -> loop l2 (loop l1 (f e acc))
169 | SubtreeTags(tree, t, tag) -> tag_fold f tree t tag acc
170 | SubtreeElts(tree, t) -> element_fold f tree t acc
178 | Cons(e, l) -> f e; loop l
179 | Concat(l1, l2) -> loop l1; loop l2
180 | ConsCat(e, l1, l2) -> f e; loop l1; loop l2
181 | SubtreeTags(tree, t, tag) -> tag_iter f tree t tag
182 | SubtreeElts(tree, t) ->
183 element_iter f tree t
187 let length l = l.length
189 let serialize name v l =
191 if name = "-" then Unix.stdout, ignore
193 Unix.openfile name [ Unix.O_WRONLY; Unix.O_TRUNC; Unix.O_CREAT ] 0o666,
196 iter (fun node -> Tree.print_xml v node fd) l;
201 let rec debug_clist =
203 Nil -> Printf.eprintf "Nil"
205 Printf.eprintf "Cons(%i," (Obj.magic e);
208 | Concat(clist1, clist2) ->
209 Printf.eprintf "Concat(";
214 | ConsCat(_, clist1, clist2) ->
215 Printf.eprintf "Concat(";
221 | SubtreeTags(tree, node, tag) ->
222 Printf.eprintf "SubtreeTags(tree, %i, %s)"
225 | SubtreeElts(tree, node) ->
226 Printf.eprintf "SubtreeElts(tree, %i)"
229 let debug l = debug_clist l.clist