Commit before changing Tree.ml interface

[SXSI/xpathcomp.git] / ata.ml

diff --git a/ata.ml b/ata.ml
index 79ffe6c..e06ac04 100644 (file)
--- a/ata.ml
+++ b/ata.ml
@@ -525,7 +525,6 @@ THEN
 INCLUDE "html_trace.ml"
              
 END            
-
       let mk_fun f s = D_IGNORE_(register_funname f s,f)
       let mk_app_fun f arg s = let g = f arg in 
        D_IGNORE_(register_funname g ((get_funname f) ^ " " ^ s), g) 
@@ -555,22 +554,22 @@ END
       let choose_jump_down a b c d =
        choose_jump a b c d
          (mk_fun (Tree.mk_nil) "Tree.mk_nil")
-         (mk_fun (Tree.text_below) "Tree.text_below")
-         (mk_fun (fun _ -> Tree.node_child) "[TaggedChild]Tree.node_child") (* !! no tagged_child in Tree.ml *)
-         (mk_fun (fun _ -> Tree.node_child) "[SelectChild]Tree.node_child") (* !! no select_child in Tree.ml *)
+         (mk_fun (Tree.first_child) "Tree.text_below")
+         (mk_fun (Tree.tagged_child) "Tree.tagged_child") 
+         (mk_fun (Tree.select_child) "Tree.select_child") (* !! no select_child in Tree.ml *)
          (mk_fun (Tree.tagged_desc) "Tree.tagged_desc")
-         (mk_fun (fun _ -> Tree.node_child ) "[SelectDesc]Tree.node_child") (* !! no select_desc *)
-         (mk_fun (Tree.node_child) "Tree.node_child")
+         (mk_fun (Tree.select_desc) "Tree.select_desc") (* !! no select_desc *)
+         (mk_fun (Tree.first_child) "Tree.first_child")
 
       let choose_jump_next a b c d = 
        choose_jump a b c d
          (mk_fun (fun t _ -> Tree.mk_nil t) "Tree.mk_nil2")
-         (mk_fun (Tree.text_next) "Tree.text_next")
-         (mk_fun (fun _ -> Tree.node_sibling_ctx) "[TaggedSibling]Tree.node_sibling_ctx")(* !! no tagged_sibling in Tree.ml *)
-         (mk_fun (fun _ -> Tree.node_sibling_ctx) "[SelectSibling]Tree.node_sibling_ctx")(* !! no select_sibling in Tree.ml *)
+         (mk_fun (Tree.next_sibling_ctx) "Tree.text_next")
+         (mk_fun (Tree.tagged_sibling_ctx) "Tree.tagged_sibling_ctx")(* !! no tagged_sibling in Tree.ml *)
+         (mk_fun (Tree.select_sibling_ctx) "Tree.select_sibling_ctx")(* !! no select_sibling in Tree.ml *)
          (mk_fun (Tree.tagged_foll_ctx) "Tree.tagged_foll_ctx")
-         (mk_fun (fun _ -> Tree.node_sibling_ctx) "[SelectFoll]Tree.node_sibling_ctx")(* !! no select_foll *)
-         (mk_fun (Tree.node_sibling_ctx) "Tree.node_sibling_ctx")        
+         (mk_fun (Tree.select_foll_ctx) "Tree.select_foll_ctx")(* !! no select_foll *)
+         (mk_fun (Tree.next_sibling_ctx) "Tree.node_sibling_ctx")        
          
 
          module SetTagKey =
@@ -621,7 +620,7 @@ END
        in
        let null_result() = (pempty,Array.make slot_size RS.empty) in
 
-       let rec loop t slist ctx = 
+       let rec loop t slist ctx =
          if Tree.is_nil t then null_result() else get_trans t slist (Tree.tag t) ctx
 
        and loop_tag tag t slist ctx =
@@ -673,7 +672,8 @@ END
                    let empty_res = null_result() in
                    let cont = 
                      match f_kind,n_kind with
-                       | `NIL,`NIL -> (fun _ _ -> null_result())
+                       | `NIL,`NIL -> 
+                           (fun _ _ -> eval_fold2_slist fl_list t empty_res empty_res )
                        |  _,`NIL -> (
                             match f_kind with
                               |`TAG(tag) -> 
@@ -682,12 +682,12 @@ END
                               | `ANY -> 
                                   (fun t _ -> eval_fold2_slist fl_list t empty_res
                                      (loop (first t) llist t))
-                              | _ -> assert false)
+                              | _ -> assert false)                          
 
                        | `NIL,_ -> (
                            match n_kind with
                              |`TAG(tag) ->  
-                                (fun t ctx ->  eval_fold2_slist fl_list t 
+                                (fun t ctx -> eval_fold2_slist fl_list t 
                                    (loop_tag tag (next t ctx) rlist ctx) empty_res)
 
                              | `ANY -> 
@@ -717,6 +717,12 @@ END
                                 (loop (next t ctx) rlist ctx)
                                 (loop (first t) llist t) )
                        | _ -> assert false
+                   in
+                   let cont = D_IF_( (fun t ctx ->
+                                        let a,b = cont t ctx in
+                                          register_trace t (slist,a,fl_list,first,next,ctx);
+                                          (a,b)
+                                     ) ,cont) 
                    in
                      (CachedTransTable.add td_trans (tag,slist) cont;cont)
          in cont t ctx
@@ -934,7 +940,7 @@ END
              | `TAG (tag) -> 
                  (*Tree.tagged_lowest t tag, fun tree -> Tree.tagged_next tree tag*)
                  (Tree.tagged_desc tag t, fun tree -> Tree.tagged_foll_ctx tag tree t)
-             | `CONTAINS(_) -> (Tree.text_below t,fun tree -> Tree.text_next tree t)
+             | `CONTAINS(_) -> (Tree.first_child t,fun tree -> Tree.next_sibling_ctx tree t)
              | _ -> assert false
          in
          let tree2 = jump_fun tree1 in