Added debugging messages

[SXSI/xpathcomp.git] / ata.ml

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