X-Git-Url: http://git.nguyen.vg/gitweb/?a=blobdiff_plain;f=ata.ml;h=fa44fd621851f5dc5c77d9eab2af8d07b4651eb0;hb=f0557f21878be17ddc75b1bc8f4f86da68c8e604;hp=c3dbc47d685296f18a3d55efe8cbed15ccc75db0;hpb=d550133ad7afdf65c5e284c2bcf67a5bdde6faa7;p=SXSI%2Fxpathcomp.git

diff --git a/ata.ml b/ata.ml
index c3dbc47..fa44fd6 100644
--- a/ata.ml
+++ b/ata.ml
@@ -455,7 +455,7 @@ let tags_of_state a q =
       let merge (rb,rb1,rb2,mark) t res1 res2 = 
 	if rb then
 	  let res1 = if rb1 then res1 else empty
-	  and res2 = if rb2 then res2 else empty
+ 	  and res2 = if rb2 then res2 else empty
 	  in
 	    if mark then { node = Cons(t,(Concat(res1.node,res2.node)));
 			   length = res1.length + res2.length + 1;}
@@ -466,7 +466,32 @@ let tags_of_state a q =
 
 	   
     end
-
+    module GResult = struct
+      type t
+      type elt = [` Tree] Tree.node
+      external create_empty : int -> t = "caml_result_set_create"
+      external set : t -> int -> t = "caml_result_set_set"
+      external next : t -> int -> int = "caml_result_set_next"
+      external clear : t -> int -> int -> unit = "caml_result_set_clear"
+      let empty = create_empty 100000000
+	
+      let cons e t = set t (Obj.magic e)
+      let concat _ t = t
+      let iter f t =
+	let rec loop i = 
+	  if i == -1 then ()
+	  else (f (Obj.magic i);loop (next t i))
+	in loop 0
+	  
+      let fold _ _ _ = failwith "noop"
+      let map _ _ = failwith "noop"
+      let length t = let cpt = ref ~-1 in
+      iter (fun _ -> incr cpt) t; !cpt
+      
+      let merge (rb,rb1,rb2,mark) elt t1 t2 =
+	if mark then (set t1 (Obj.magic elt) ; t1) else t1
+	  
+    end
     module Run (RS : ResultSet) =
     struct
 
@@ -876,12 +901,12 @@ END
 	      in
 		(Hashtbl.add h_trans key res;res) 
 		  
+
 	      
 	let h_tdconf = Hashtbl.create 511 
 	let rec bottom_up a tree t conf next jump_fun root dotd init accu = 
 	  if (not dotd) && (Configuration.is_empty conf ) then
-
-	    accu,conf,next 
+	  accu,conf,next 
 	  else
 
 	  let below_right = Tree.is_below_right tree t next in 
@@ -900,7 +925,7 @@ END
 	  let conf,next =
 	    (Configuration.merge rightconf sub, next_of_next)
 	  in
-	  if t == root then  accu,conf,next else	      
+	  if t == root then  accu,conf,next else
 	  let parent = Tree.binary_parent tree t in
 	  let ptag = Tree.tag tree parent in
 	  let dir = Tree.is_left tree t in
@@ -919,8 +944,6 @@ END
 	      
 	and prepare_topdown a tree t noright =
 	  let tag = Tree.tag tree t in
-(*	  pr "Going top down on tree with tag %s = %s "  
-	    (if Tree.is_nil t then "###" else (Tag.to_string(Tree.tag t))) (Tree.dump_node t); *)
  	  let r = 
 	    try
 	      Hashtbl.find h_tdconf tag
@@ -941,24 +964,21 @@ END
 	  let set = match SList.node set with
 	    | SList.Cons(x,_) ->x
 	    | _ -> assert false 
-	  in 
-(*	    pr "Result of topdown run is %!";
-	    StateSet.print fmt (Ptset.Int.elements set);
-	    pr ", number is %i\n%!" (RS.length res.(0));  *)
-	    Configuration.add Configuration.empty set res.(0) 
+	  in
+	  Configuration.add Configuration.empty set res.(0) 
 
 
 
 	let run_bottom_up a tree k =
 	  let t = Tree.root in
-	  let trlist = Hashtbl.find a.trans (Ptset.Int.choose a.init)
+	  let trlist = Hashtbl.find a.trans (StateSet.choose a.init)
 	  in
 	  let init = List.fold_left 
 	    (fun acc (_,t) ->
 	       let _,_,f,_ = Transition.node t in 
 	       let _,_,l = fst ( Formula.st f ) in
-		 Ptset.Int.union acc l)
-	    Ptset.Int.empty trlist
+		 StateSet.union acc l)
+	    StateSet.empty trlist
 	  in
 	  let tree1,jump_fun =
 	    match k with
@@ -966,22 +986,17 @@ END
 		  (*Tree.tagged_lowest t tag, fun tree -> Tree.tagged_next tree tag*)
 		  (Tree.tagged_desc tree tag t, let jump = Tree.tagged_foll_ctx tree tag
 		  in fun n -> jump n t )
-	      | `CONTAINS(_) -> (Tree.first_child tree t,let jump = Tree.next_sibling_ctx tree 
+	      | `CONTAINS(_) -> (Tree.text_below tree t,let jump = Tree.text_next tree 
 				 in fun n -> jump n t)
 	      | _ -> assert false
 	  in
 	  let tree2 = jump_fun tree1 in
 	  let rec loop t next acc = 
-(*	    let _ = pr "\n_________________________\nNew iteration\n" in 
-	    let _ = pr "Jumping to %s\n%!" (Tree.dump_node tree) in  *)
 	    let acc,conf,next_of_next = bottom_up a tree t
 	      Configuration.empty next jump_fun (Tree.root) true init acc
 	    in 
-	      (*	    let _ = pr "End of first iteration, conf is:\n%!";
-			    Configuration.pr fmt conf 
-			    in *)	      
 	    let acc = Configuration.IMap.fold 
-	      ( fun s res acc -> if Ptset.Int.intersect init s
+	      ( fun s res acc -> if StateSet.intersect init s
 		then RS.concat res acc else acc) conf.Configuration.results acc
 	    in
 	      if Tree.is_nil next_of_next  (*|| Tree.equal next next_of_next *)then
@@ -994,7 +1009,7 @@ END
     end
           
     let top_down_count a t = let module RI = Run(Integer) in Integer.length (RI.run_top_down a t)
-    let top_down a t = let module RI = Run(IdSet) in (RI.run_top_down a t)
+    let top_down a t = let module RI = Run(GResult) in (RI.run_top_down a t)
     let bottom_up_count a t k = let module RI = Run(Integer) in Integer.length (RI.run_bottom_up a t k)