X-Git-Url: http://git.nguyen.vg/gitweb/?a=blobdiff_plain;f=ata.ml;h=7a5a64d7087f78edb2f54960752f67f226b2f15c;hb=c5f06d325240c808a9be4d71e20fc01969420bb3;hp=4ef9ccf5dd116dbd61e086f5e4d3829ac1d34b0a;hpb=645b7263119a1262cbb442a3166783ad372becef;p=SXSI%2Fxpathcomp.git

diff --git a/ata.ml b/ata.ml
index 4ef9ccf..7a5a64d 100644
--- a/ata.ml
+++ b/ata.ml
@@ -220,13 +220,10 @@ end
 module TransTable = Hashtbl
  
 module Formlist = struct 
-  include Hlist.Make(Transition) 
-  type data = t node
-  let make _ = failwith "make"
+  include Hlist.Make(Transition)
   let print ppf fl = 
     iter (fun t -> Transition.print ppf t; Format.pp_print_newline ppf ()) fl
 end
-
   
 type 'a t = { 
     id : int;
@@ -495,11 +492,7 @@ let tags_of_state a q =
     module Run (RS : ResultSet) =
     struct
 
-      module SList = struct 
-	include Hlist.Make (StateSet)
-	type data = t node
-	let make _ = failwith "make"
-      end
+      module SList = Hlist.Make (StateSet)
 
 
 
@@ -644,32 +637,34 @@ END
 	    else RS.concat res1 res2
 	else RS.empty 	  
       
-     
       let top_down ?(noright=false) a tree t slist ctx slot_size =	
 	let pempty = empty_size slot_size in	
-	  (* evaluation starts from the right so we put sl1,res1 at the end *)
+	(* evaluation starts from the right so we put sl1,res1 at the end *)
 	let eval_fold2_slist fll t (sl2,res2) (sl1,res1) =
 	  let res = Array.copy res1 in
 	  let rec fold l1 l2 fll i aq = 
-	    match SList.node l1,SList.node l2, fll with
-	      | SList.Cons(s1,ll1), 
-		SList.Cons(s2,ll2),
-		fl::fll -> 
-		let r',flags = eval_formlist s1 s2 fl in
- 		let _ = res.(i) <- RS.merge flags t res1.(i) res2.(i)
-		in		  
+	    match fll with
+	       [fl] -> (* inline for speed *)
+		 let s1 = SList.hd l1
+		 and s2 = SList.hd l2 in
+		 let r',flags = eval_formlist s1 s2 fl in
+ 		 let _ = res.(i) <- RS.merge flags t res1.(i) res2.(i) in
+		 (SList.cons r' aq),res
+	      | fl::fll ->
+		  let SList.Cons(s1,ll1) = l1.SList.Node.node
+		  and SList.Cons(s2,ll2) = l2.SList.Node.node in
+		  let r',flags = eval_formlist s1 s2 fl in
+ 		  let _ = res.(i) <- RS.merge flags t res1.(i) res2.(i)
+		  in	  
 		  fold ll1 ll2 fll (i+1) (SList.cons r' aq)
-	    
-	      | SList.Nil, SList.Nil,[] -> aq,res
-	      | _ -> assert false
+	      | _ -> aq,res
 	  in
-	    fold sl1 sl2 fll 0 SList.nil
+	  fold sl1 sl2 fll 0 SList.nil
 	in
 	let null_result() = (pempty,Array.make slot_size RS.empty) in
 
 	let rec loop t slist ctx =
 	  if t == Tree.nil then null_result() else get_trans t slist (Tree.tag tree t) ctx
-
 	and loop_tag tag t slist ctx =
 	  if t == Tree.nil then null_result() else get_trans t slist tag ctx
 	and loop_no_right t slist ctx = 
@@ -713,6 +708,9 @@ END
 		  in			
 		    (* Logic to chose the first and next function *)
 		  let _,tags_below,_,tags_after = Tree.tags tree tag in
+(*		  let _ = Printf.eprintf "Tags below %s are : \n" (Tag.to_string tag) in
+		  let _ = Ptset.Int.iter (fun i -> Printf.eprintf "%s " (Tag.to_string i)) tags_below in
+		  let _ = Printf.eprintf "\n%!" in *)
 		  let f_kind,first = choose_jump_down tree tags_below ca da a
 		  and n_kind,next = if noright then (`NIL, fun _ _ -> Tree.nil )
 		  else choose_jump_next tree tags_after sa fa a in
@@ -1009,7 +1007,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(GResult) in (RI.run_top_down a t)
+    let top_down a t = let module RI = Run(IdSet) 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)