10 val var : (int*State.t) -> t
11 val close : ((int*State.t), t) Hashtbl.t -> t -> t
12 val is_open : t -> bool
13 val singleton : elt -> t
14 val cons : elt -> t -> t
15 val snoc : t -> elt -> t
16 val concat : t -> t -> t
17 val concat3 : t -> t -> t -> t
18 val concat4 : t -> t -> t -> t -> t
19 val conscat : elt -> t -> t -> t
20 val conscat3 : elt -> t -> t -> t -> t
21 val conscat4 : elt -> t -> t -> t -> t -> t
22 val subtree_tags : Tree.t -> elt -> Tag.t -> t
23 val subtree_elements : Tree.t -> elt -> t
24 val iter : ( elt -> unit) -> t -> unit
25 val fold : ( elt -> 'a -> 'a) -> t -> 'a -> 'a
27 val serialize : string -> Tree.t -> t -> unit
31 module Count : S with type t = int =
43 let concat x y = x + y
44 let concat3 x y z = x + y + z
45 let concat4 x y z t = x + y + z + t
46 let conscat _ x y = 1 + x + y
47 let conscat3 _ x y z = 1 + x + y + z
48 let conscat4 _ x y z t = 1 + x + y + z + t
49 let subtree_tags tree node tag = Tree.subtree_tags tree node tag
50 let subtree_elements tree node = Tree.subtree_elements tree node
51 let iter _ _ = failwith "iter not implemented"
52 let fold _ _ _ = failwith "fold not implemented"
53 let map _ _ = failwith "map not implemented"
57 output_string o "<xml_result>\n";
58 output_string o (string_of_int x);
59 output_string o "\n</xml_result>\n";
65 | Cons of Tree.node * clist
66 | Concat of clist * clist
67 | ConsCat of Tree.node * clist * clist
68 | SubtreeTags of Tree.t * Tree.node * Tag.t
69 | SubtreeElts of Tree.t * Tree.node
72 type 'a mat = { mutable clist : clist;
73 mutable length : int }
75 module Mat : S with type t = Tree.node mat =
77 type t = Tree.node mat
80 let empty = { clist = Nil; length = 0 }
81 let singleton e = { clist = Cons(e, Nil) ; length = 1 }
82 let cons e l = { clist = Cons(e, l.clist); length = l.length + 1 }
84 let ll1 = l1.length in
85 if ll1 == 0 then l2 else
86 let ll2 = l2.length in if ll2 == 0 then l1 else
87 { clist = Concat(l1.clist, l2.clist); length = ll1 + ll2 }
89 let snoc l e = concat l (singleton e)
90 let concat3 l1 l2 l3 = concat l1 (concat l2 l3)
91 let concat4 l1 l2 l3 l4 = concat (concat l1 l2) (concat l3 l4)
97 let ll1 = l1.length in
98 if ll1 == 0 then cons e l2 else
99 let ll2 = l2.length in if ll2 == 0 then cons e l1 else
100 { clist = ConsCat(e, l1.clist, l2.clist); length = 1 + ll1 + ll2 }
102 (* let conscat e l1 l2 = cons e (concat l1 l2) *)
104 let conscat3 e l1 l2 l3 = conscat e l1 (concat l2 l3)
105 let conscat4 e l1 l2 l3 l4 = conscat e l1 (concat l2 (concat l3 l4))
107 let subtree_tags tree node tag =
108 let len = Tree.subtree_tags tree node tag in
109 if len == 0 then empty
111 { clist = SubtreeTags(tree, node, tag);
114 let subtree_elements tree node =
115 let len = Tree.subtree_elements tree node in
116 if len == 0 then empty
118 { clist = SubtreeElts(tree, node);
121 let fst_tagged tree t tag =
122 if Tree.tag tree t == tag then t
123 else Tree.tagged_descendant tree t tag
125 let fst_element tree t =
126 let tag = Tree.tag tree t in
127 let t = if Ptset.Int.mem tag
128 (Ptset.Int.remove Tag.document_node (Tree.element_tags tree))
130 else Tree.first_element tree t
131 in Tree.first_element tree t
133 let element_fold f tree t acc =
134 let rec loop node acc =
135 if node == Tree.nil then acc
137 let acc = f node acc in
138 let acc' = loop (Tree.first_element tree node) acc in
139 loop (Tree.next_element tree node) acc'
141 loop (fst_element tree t) acc
143 let element_iter f tree t =
145 if node != Tree.nil then begin
147 loop (Tree.first_element tree node);
148 loop (Tree.next_element tree node)
151 let t' = fst_element tree t in loop t'
153 let tag_fold f tree t tag acc =
154 let rec loop close node acc =
155 if node > Tree.nil && node < close then acc
157 let acc = f node acc in
158 loop close (Tree.tagged_next tree node tag) acc
160 let t' = fst_tagged tree t tag in
161 loop (Tree.closing tree t) t' acc
163 let tag_iter f tree t tag =
164 let rec loop close node =
165 if node > Tree.nil && node < close then begin
167 loop close (Tree.tagged_next tree node tag);
170 let t' = fst_tagged tree t tag in
171 loop (Tree.closing tree t) t'
177 | Cons(e, ll) -> loop ll (f e acc)
178 | Concat(l1, l2) -> loop l2 (loop l1 acc)
179 | ConsCat(e, l1, l2) -> loop l2 (loop l1 (f e acc))
180 | SubtreeTags(tree, t, tag) -> tag_fold f tree t tag acc
181 | SubtreeElts(tree, t) -> element_fold f tree t acc
189 | Cons(e, l) -> f e; loop l
190 | Concat(l1, l2) -> loop l1; loop l2
191 | ConsCat(e, l1, l2) -> f e; loop l1; loop l2
192 | SubtreeTags(tree, t, tag) -> tag_iter f tree t tag
193 | SubtreeElts(tree, t) ->
194 element_iter f tree t
198 let length l = l.length
200 let serialize name v l =
202 if name = "-" then Unix.stdout, ignore
204 Unix.openfile name [ Unix.O_WRONLY; Unix.O_TRUNC; Unix.O_CREAT ] 0o666,
207 ignore (Unix.write fd "<xml_result>\n" 0 13);
208 if l.length > 0 then begin
209 iter (fun node -> Tree.print_xml v node fd) l;
212 ignore (Unix.write fd "</xml_result>\n" 0 14);
216 let rec debug_clist =
218 Nil -> Printf.eprintf "Nil"
220 Printf.eprintf "Cons(%i," (Obj.magic e);
223 | Concat(clist1, clist2) ->
224 Printf.eprintf "Concat(";
229 | ConsCat(_, clist1, clist2) ->
230 Printf.eprintf "Concat(";
236 | SubtreeTags(tree, node, tag) ->
237 Printf.eprintf "SubtreeTags(tree, %i, %s)"
240 | SubtreeElts(tree, node) ->
241 Printf.eprintf "SubtreeElts(tree, %i)"
244 let debug l = debug_clist l.clist
248 module Partial(N : S) : S =
252 type t = { env : ((int*State.t), t) Hashtbl.t;
257 | Var of (int * State.t)
260 | Concat of list * list
263 let dummy = Hashtbl.create 0
264 let empty = { env = dummy;
267 let is_open t = t.opened
272 Lambda { t with env = h; opened = false } }
274 let singleton i = { empty with elem = Cons(i, Nil) }
275 let cons e t = { t with elem = Cons(e, t.elem) }
277 { t1 with elem = Concat (t1.elem, t2.elem) }
279 let snoc t e = concat t (singleton e)
280 let concat3 t1 t2 t3 = concat t1 (concat t2 t3)
281 let concat4 t1 t2 t3 t4 = concat (concat t1 t2) (concat t3 t4)
282 let conscat e t1 t2 = cons e (concat t1 t2)
283 let conscat3 e t1 t2 t3 = cons e (concat3 t1 t2 t3)
284 let conscat4 e t1 t2 t3 t4 = cons e (concat4 t1 t2 t3 t4)
285 let subtree_tags _ = failwith "not implemented"
286 let subtree_elements _ = failwith "not_implemented"
290 loop_list t.env t.elem
291 and loop_list h = function
293 | Var i -> loop (Hashtbl.find h i)
294 | Cons (e, l) -> f e; loop_list h l
295 | Concat (l1, l2) -> loop_list h l1; loop_list h l2
302 loop_list t.env acc t.elem
303 and loop_list h acc = function
305 | Var i -> loop (try Hashtbl.find h i with Not_found -> let a,b = i in Printf.eprintf "%i,%i not found\n%!" a b; empty) acc
306 | Cons (e, l) -> loop_list h (f e acc) l
307 | Concat (l1, l2) -> loop_list h (loop_list h acc l1) l2
308 | Lambda t -> loop t acc
314 Hashtbl.iter (fun (i,j) t ->
315 Format.eprintf "%i, %a ->" i State.print j;
317 Format.eprintf "----------------\n%!";
320 and dump_list = function
322 | Var (i,j) -> Format.eprintf "Var(%i, %a) " i State.print j;
323 | Cons (e, l) -> Format.eprintf "%i " (Node.to_int e); dump_list l
324 | Concat (l1, l2) -> dump_list l1 ; dump_list l2
328 let length t = fold (fun _ acc -> 1 + acc) t 0
332 { empty with elem = Var i; opened = true }
334 let serialize _ = failwith "not implemented"