Expose the internal structure of Hconsed value

[SXSI/xpathcomp.git] / ata.ml

diff --git a/ata.ml b/ata.ml
index 4ef9ccf..7a5a64d 100644 (file)
--- 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)