X-Git-Url: http://git.nguyen.vg/gitweb/?a=blobdiff_plain;f=src%2Ftable.ml;h=15d39bcb712b6ae08870ad844bc302b2392ce678;hb=c7229e6e3c000938a74abeb52749f62a65c3bbfd;hp=7a49b75337bb38dcb0c19c1822a59015efc69639;hpb=cb10072a53278e0f5c6f6ddf9679dbd9643c7f7e;p=tatoo.git

diff --git a/src/table.ml b/src/table.ml
index 7a49b75..15d39bc 100644
--- a/src/table.ml
+++ b/src/table.ml
@@ -1,10 +1,4 @@
 
-type move = Self
-	    | Firstchild
-	    | Nextsibling
-	    | Revfirstchild
-	    | Prevsibling
-
 type query_tree_desc = Binop of op * query_tree * query_tree
 		       | Axis of Xpath.Ast.axis * query_tree
 		       | Start 
@@ -70,6 +64,14 @@ let rec union_list t l1 l2 =
       else if (comp_node t h1 h2) then h1::(union_list t ll1 l2)
       else h1 ::(union_list t ll1 ll2)
 
+let rec merge_list t l1 l2 =
+  match l1,l2 with
+    | [],l2 -> l2
+    | l1,[] -> l1
+    | h1::ll1, h2::ll2 -> if (comp_node t h2 h1) then h1:: (merge_list t ll1 l2)
+      else if (comp_node t h1 h2) then h2:: (merge_list t l1 ll2)
+      else h1::(merge_list t ll1 ll2)
+
 let rec inter_list t l1 l2 =
   match l1,l2 with
     | [],l2 -> []
@@ -111,59 +113,7 @@ and print_binop fmt o =
     | Inter -> Format.fprintf fmt "Inter"
     | Diff -> Format.fprintf fmt "Diff"
 
-let rec eval_relation tree m n =
-  match m with
-      Self -> n
-    | Firstchild ->  Naive_tree.first_child tree n
-    | Nextsibling -> Naive_tree.next_sibling tree n
-    | Revfirstchild -> Naive_tree.parent_of_first tree n
-    | Prevsibling -> Naive_tree.prev_sibling tree n
-
-(*28/01/2014  
-  parametres : tree  l'arbre xml
-               ls    l'ensemble de noeuds
-               m     move   
-  retour : l'ensemble de noeuds qui correspondent ॆ la relation r
-*)
-
-
- 
-
-let rec eval_move tree ls m =
-  match m with
-      Self -> ls
-    | r -> List.filter (fun n -> n != Naive_tree.nil)
-           (List.map (eval_relation tree r) ls) 
 	   
-
-(*28/01/2014  
-  parametres : tree  l'arbre xml
-               ls    l'ensemble de noeuds
-               m     move   
-  retour : l'ensemble de noeuds qui correspondent ॆ des relations lr
-*)
-
-and eval_star tree ls lr =
-  let h = Hashtbl.create 17 in
-  let q = Queue.create () in
-  List.iter ( fun e -> Queue.add e q ) ls;
-  while not (Queue.is_empty q ) do
-    let n = Queue.pop q in
-    if not (Hashtbl.mem h n) then begin
-      Hashtbl.add h n ();
-      List.iter ( fun r -> let m = eval_relation tree r n in
-			   if m != Naive_tree.nil && not (Hashtbl.mem h m ) then begin
-			     
-			     Queue.add m q; end
-      ) lr
-    end
-  done;
-  let l = Hashtbl.fold (fun k _ acc -> k::acc) h [] in
-  l
- (*  
- Tas.sort_of_list tree l 
-  List.sort (compare_node tree) l*)
-
 let rec compare_node_list tree l1 l2 =
   match l1,l2 with
       [],[] -> 0
@@ -172,7 +122,11 @@ let rec compare_node_list tree l1 l2 =
     | n1::ll1,n2::ll2 -> let b = compare_node tree n1 n2 in
 			 if b=0 then compare_node_list tree ll1 ll2 
 			 else b
-			   
+
+let get_list_ordred tree ll =
+  let l1 = List.fold_left (fun acc l -> merge_list tree acc l) [] ll in
+  List.rev l1
+
 let get_descendant tree ln =
   let rec aux n acc =
     if n == Naive_tree.nil then  acc
@@ -182,11 +136,10 @@ let get_descendant tree ln =
 	 let acc2 = aux n2 acc1 in
 	 acc2
   in
-  let l = List.fold_left (fun acc n -> if List.mem n acc then acc 
-    else let n1 = Naive_tree.first_child tree n in
-	 aux n1 acc) [] ln 
-  in
-  List.rev l 
+  let ll = List.map (fun n -> 
+    let n1 = Naive_tree.first_child tree n in
+    aux n1 [] ) ln in
+  get_list_ordred tree ll
 
 let get_child tree ln =
   let rec aux n acc =
@@ -197,10 +150,8 @@ let get_child tree ln =
   in
   let ll = List.map (fun  n->
     let n1 = Naive_tree.first_child tree n in
-    let res = aux n1 [] in
-    List.rev res
-  )  ln in
-  List.fold_left (fun acc l -> union_list tree acc l) [] ll
+    aux n1 [] )  ln in
+  get_list_ordred tree ll
 
   
 let get_followingSibling tree ln =
@@ -209,9 +160,8 @@ let get_followingSibling tree ln =
     if n1 == Naive_tree.nil then acc
     else aux n1 (n1::acc)
   in
-  let ll = List.map (fun n -> let res = aux n [] in
-			      List.rev res ) ln in
-  List.fold_left (fun acc l1 -> union_list tree acc l1) [] ll 
+  let ll = List.map (fun n -> aux n [] ) ln in
+  get_list_ordred tree ll
   
  
 let rec get_firstBling tree n pred =
@@ -219,16 +169,13 @@ let rec get_firstBling tree n pred =
   else get_firstBling tree (Naive_tree.prev_sibling tree n) n
     
 let get_parent tree ln =
-  let l = List.fold_left (fun acc n ->
+  List.fold_left (fun acc n ->
     let n1 = get_firstBling tree n Naive_tree.nil in
     let n2 = Naive_tree.parent_of_first tree n1 in
-    if n2 == Naive_tree.nil or List.mem n2 acc then acc
-    else union_list tree [n2] acc   
+    if n2 != Naive_tree.nil then union_list tree [n2] acc   
+    else acc
   ) [] ln
-  in
-  l
-
-  
+ 
 
 let get_ancestor tree ln =
   let rec aux tree l1 acc =