X-Git-Url: http://git.nguyen.vg/gitweb/?a=blobdiff_plain;f=src%2FnodeSet.ml;fp=src%2FnodeSet.ml;h=2716d61fe683161899be31e06b4b2b6bacf47897;hb=4b52da1a20a4fe031930bb96d2ca46bec06dc529;hp=0000000000000000000000000000000000000000;hpb=a223af3254fb51c279cfbccdc18c59484fdca74e;p=SXSI%2Fxpathcomp.git

diff --git a/src/nodeSet.ml b/src/nodeSet.ml
new file mode 100644
index 0000000..2716d61
--- /dev/null
+++ b/src/nodeSet.ml
@@ -0,0 +1,231 @@
+INCLUDE "debug.ml"
+INCLUDE "utils.ml"
+
+module type S =
+  sig
+    type t
+    type elt = Tree.node
+    val empty : t
+    val singleton : elt -> t
+    val cons : elt -> t -> t
+    val snoc : t -> elt -> t
+    val concat : t -> t -> t
+    val concat3 : t -> t -> t -> t
+    val concat4 : t -> t -> t -> t -> t
+    val conscat : elt -> t -> t -> t
+    val conscat3 : elt -> t -> t -> t -> t
+    val conscat4 : elt -> t -> t -> t -> t -> t
+    val subtree_tags : Tree.t -> elt -> Tag.t -> t
+    val subtree_elements : Tree.t -> elt -> t
+    val iter : ( elt -> unit) -> t -> unit
+    val fold : ( elt -> 'a -> 'a) -> t -> 'a -> 'a
+    val length : t -> int
+    val serialize : string -> Tree.t -> t -> unit
+  end
+
+module Count : S with type t = int =
+  struct
+    type t = int
+    type elt = Tree.node
+
+    let empty = 0
+    let singleton _ = 1
+    let cons _ x = x+1
+    let snoc x _ = x+1
+    let concat x y = x + y
+    let concat3 x y z = x + y + z
+    let concat4 x y z t = x + y + z + t
+    let conscat _ x y = 1 + x + y
+    let conscat3 _ x y z = 1 + x + y + z
+    let conscat4 _ x y z t = 1 + x + y + z + t
+    let subtree_tags tree node tag = Tree.subtree_tags tree node tag
+    let subtree_elements tree node = Tree.subtree_elements tree node
+    let iter _ _ = failwith "iter not implemented"
+    let fold _ _ _ = failwith "fold not implemented"
+    let map _ _ = failwith "map not implemented"
+    let length x = x
+    let serialize _ _ _ = ()
+  end
+
+type  clist =
+  | Nil
+  | Cons of Tree.node * clist
+  | Concat of clist * clist
+  | ConsCat of Tree.node * clist * clist
+  | SubtreeTags of Tree.t * Tree.node * Tag.t
+  | SubtreeElts of Tree.t * Tree.node
+
+
+type 'a mat = { mutable clist : clist;
+	        mutable length : int }
+
+module Mat : S with type t = Tree.node mat =
+  struct
+    type t = Tree.node mat
+    type elt = Tree.node
+
+    let empty = { clist = Nil; length = 0 }
+    let singleton e = { clist = Cons(e, Nil) ; length = 1 }
+    let cons e l = { clist = Cons(e, l.clist); length = l.length + 1 }
+    let concat l1 l2 =
+      let ll1 = l1.length in
+      if ll1 == 0 then l2 else
+	let ll2 = l2.length in if ll2 == 0 then l1 else
+	    { clist = Concat(l1.clist, l2.clist); length = ll1 + ll2 }
+
+    let snoc l e = concat l (singleton e)
+(*
+    let _total = ref 0
+    let _empty = ref 0
+    let () = at_exit (fun () -> Printf.eprintf "Dummy concatenations: %i/%i\n%!" !_empty !_total)
+
+    let concat l1 l2 =
+      let l = concat l1 l2 in
+      if l.length == 0 then incr _empty;
+      incr _total;
+      l
+*)
+    let concat3 l1 l2 l3 = concat l1 (concat l2 l3)
+    let concat4 l1 l2 l3 l4 = concat (concat l1 l2) (concat l3 l4)
+
+
+    let conscat e l1 l2 =
+      let ll1 = l1.length in
+      if ll1 == 0 then cons e l2 else
+	let ll2 = l2.length in if ll2 == 0 then cons e l1 else
+	    { clist = ConsCat(e, l1.clist, l2.clist); length = 1 + ll1 + ll2 }
+
+(*    let conscat e l1 l2 = cons e (concat l1 l2) *)
+
+    let conscat3 e l1 l2 l3 = conscat e l1 (concat l2 l3)
+    let conscat4 e l1 l2 l3 l4 = conscat e l1 (concat l2 (concat l3 l4))
+
+    let subtree_tags tree node tag =
+      { clist = SubtreeTags(tree, node, tag);
+	length = Tree.subtree_tags tree node tag }
+    let subtree_elements tree node =
+      { clist = SubtreeElts(tree, node);
+	length = Tree.subtree_elements tree node }
+
+    let fst_tagged tree t tag =
+      if Tree.tag tree t == tag then t
+      else Tree.tagged_descendant tree t tag
+
+    let fst_element tree t =
+      let tag = Tree.tag tree t in
+      let t = if Ptset.Int.mem tag
+	  (Ptset.Int.remove Tag.document_node (Tree.element_tags tree))
+	then t
+	else Tree.first_element tree t
+      in Tree.first_element tree t
+
+    let element_fold f tree t acc =
+      let rec loop node acc =
+	if node == Tree.nil then acc
+	else
+	  let acc = f node acc in
+	  let acc' = loop (Tree.first_element tree node) acc in
+	    loop (Tree.next_element tree node) acc'
+      in
+	loop (fst_element tree t) acc
+
+    let element_iter f tree t =
+      let rec loop node =
+	if node != Tree.nil then begin
+	  f node;
+	  loop (Tree.first_element tree node);
+	  loop (Tree.next_element tree node)
+	end
+      in
+      let t' = fst_element tree t in loop t'
+
+    let tag_fold f tree t tag acc =
+      let rec loop close node acc =
+	if node == Tree.nil then acc
+	else
+	  let acc = f node acc in
+	  let acc' = loop close (Tree.tagged_descendant tree node tag) acc in
+	    loop close (Tree.tagged_following_before tree node tag close) acc'
+      in
+      let t = fst_tagged tree t tag in
+	loop (Tree.closing tree t) t acc
+
+    let tag_iter f tree t tag =
+      let rec loop close node =
+	if node != Tree.nil then begin
+	  f node;
+	  loop close (Tree.tagged_descendant tree node tag);
+	  loop close (Tree.tagged_following_before tree node tag close);
+	end
+      in
+      let t' = fst_tagged tree t tag in
+	loop (Tree.closing tree t) t'
+
+    let fold f l acc =
+      let rec loop l acc =
+	match l with
+	  | Nil -> acc
+	  | Cons(e, ll) -> loop ll (f e acc)
+	  | Concat(l1, l2) -> loop l2 (loop l1 acc)
+	  | ConsCat(e, l1, l2) -> loop l2 (loop l1 (f e acc))
+	  | SubtreeTags(tree, t, tag) -> tag_fold f tree t tag acc
+	  | SubtreeElts(tree, t) -> element_fold f tree t acc
+      in
+	loop l.clist acc
+
+    let iter f l =
+      let rec loop l =
+	match l with
+	  | Nil -> ()
+	  | Cons(e, l) -> f e; loop l
+	  | Concat(l1, l2) -> loop l1; loop l2
+	  | ConsCat(e, l1, l2) -> f e; loop l1; loop l2
+	  | SubtreeTags(tree, t, tag) -> tag_iter f tree t tag
+	  | SubtreeElts(tree, t) ->
+	      element_iter f tree t
+      in
+	loop l.clist
+
+    let length l = l.length
+
+    let serialize name v l =
+      let fd, finish =
+	if name = "-" then Unix.stdout, ignore
+	else
+	  Unix.openfile name [ Unix.O_WRONLY; Unix.O_TRUNC; Unix.O_CREAT ] 0o666,
+	  Unix.close
+      in
+      iter (fun node -> Tree.print_xml v node fd) l;
+      Tree.flush v fd;
+      finish fd
+
+  end
+let rec debug_clist =
+  function
+      Nil -> Printf.eprintf "Nil"
+    | Cons(e, clist) ->
+	Printf.eprintf "Cons(%i," (Obj.magic e);
+	debug_clist clist;
+	Printf.eprintf ")";
+    | Concat(clist1, clist2) ->
+	    Printf.eprintf "Concat(";
+	debug_clist clist1;
+	Printf.eprintf ",";
+	    debug_clist clist2;
+	    Printf.eprintf ")";
+    | ConsCat(_, clist1, clist2) ->
+	    Printf.eprintf "Concat(";
+	debug_clist clist1;
+	Printf.eprintf ",";
+	    debug_clist clist2;
+	    Printf.eprintf ")";
+
+    | SubtreeTags(tree, node, tag) ->
+	Printf.eprintf "SubtreeTags(tree, %i, %s)"
+	  (Obj.magic node)
+	  (Tag.to_string tag);
+    | SubtreeElts(tree, node) ->
+	Printf.eprintf "SubtreeElts(tree, %i)"
+	  (Obj.magic node)
+
+let debug l = debug_clist l.clist