X-Git-Url: http://git.nguyen.vg/gitweb/?a=blobdiff_plain;f=src%2Fruntime.ml;h=98369523fd3d00deaecd2db18eb945341222d9fd;hb=1975eef2d0933da3c01faec1cd14bc8fbf6bf146;hp=e32812bbb9d3a17b0ec6a175205316dcf2813b1a;hpb=c0b6bf74a7df6f1c8951525cab015fda4c788a9d;p=SXSI%2Fxpathcomp.git

diff --git a/src/runtime.ml b/src/runtime.ml
index e32812b..9836952 100644
--- a/src/runtime.ml
+++ b/src/runtime.ml
@@ -1,4 +1,5 @@
 INCLUDE "debug.ml"
+INCLUDE "trace.ml"
 INCLUDE "utils.ml"
 
 open Format
@@ -7,6 +8,8 @@ module type S = sig
   type result_set
   val top_down_run : Ata.t -> Tree.t -> Tree.node -> result_set
   val bottom_up_run : Ata.t -> Tree.t -> Compile.text_query * string -> result_set
+  val grammar_run : Ata.t -> Grammar.t -> unit -> result_set
+
 end
 
 module Make (U : ResJIT.S) : S with type result_set = U.NS.t =
@@ -84,11 +87,12 @@ module Make (U : ResJIT.S) : S with type result_set = U.NS.t =
 	  in
 	  let lvl3 = Array.fold_left
 	    (fun acc a ->
-	       Array.fold_left (fun acc2 a2 ->
-				  Array.fold_left
-				    (fun acc3 a3 -> if a3 == dummy then acc3 else acc3+1) acc2 a2)
-		 acc a) 0 d
-      in
+	      Array.fold_left (fun acc2 a2 ->
+		Array.fold_left
+		  (fun acc3 a3 -> if a3 != dummy then acc3+1 else acc3)
+		  acc2 a2)
+		acc a) 0 d
+	  in
 	fprintf fmt "L3JIT Statistics:
 \t%i entries
 \t%i used L1 lines
@@ -115,7 +119,7 @@ module Make (U : ResJIT.S) : S with type result_set = U.NS.t =
 	    Translist.fold (fun t (a1, a2) ->
 			  let _, _, _, f = Transition.node t in
 			  let (_, _, fs1), (_, _, fs2) = Formula.st f in
-			    (StateSet.union s1 fs1, StateSet.union s2 fs2)
+			    (StateSet.union a1 fs1, StateSet.union a2 fs2)
 		       ) trl (StateSet.empty, StateSet.empty)
 	  in
 	  let ns1 = StateSet.inter s1 orig_s1
@@ -184,11 +188,19 @@ module Make (U : ResJIT.S) : S with type result_set = U.NS.t =
 
 	let cache_apply cache auto tlist s1 s2 =
 	  let f = gen_code auto tlist s1 s2 in
+	  TRACE("grammar", 2, __ "Inserting: %i, %a, %a\n%!"
+	    (Uid.to_int tlist.Translist.Node.id) StateSet.print s1 StateSet.print s2);
 	  add cache tlist s1 s2 f; f
       end
 
 DEFINE LOOP (t, states, ctx) = (
   let _t = (t) in
+  TRACE("top-down-run", 3,
+	__ "Entering node %i with loop (tag %s, context %i) with states %a\n%!"
+	  (Node.to_int _t)
+	  (Tag.to_string (Tree.tag tree _t))
+	  (Node.to_int (ctx))
+	  (StateSet.print) (states));
   if _t == Tree.nil then nil_res
   else
     let tag = Tree.tag tree _t in
@@ -198,6 +210,12 @@ DEFINE LOOP (t, states, ctx) = (
 
 DEFINE LOOP_TAG (t, states, tag, ctx) = (
   let _t = (t) in (* to avoid duplicating expression t *)
+  TRACE("top-down-run", 3,
+	__ "Entering node %i with loop_tag (tag %s, context %i) with states %a\n%!"
+	  (Node.to_int _t)
+	  (Tag.to_string (tag))
+	  (Node.to_int (ctx))
+	  (StateSet.print) (states));
   if _t == Tree.nil then nil_res
   else
     l2jit_dispatch
@@ -248,9 +266,11 @@ DEFINE LOOP_TAG (t, states, tag, ctx) = (
 	| L2JIT.NOP () -> nil_res
 	| L2JIT.FIRST_CHILD s -> LOOP ((Tree.first_child tree t), s, ctx)
 	| L2JIT.NEXT_SIBLING s -> LOOP ((Tree.next_sibling tree t), s, ctx)
+(*	| L2JIT.NEXT_SIBLING s -> LOOP ((Tree.next_node_before tree t ctx), s, ctx) *)
 
 	| L2JIT.FIRST_ELEMENT s -> LOOP ((Tree.first_element tree t), s, ctx)
 	| L2JIT.NEXT_ELEMENT s -> LOOP ((Tree.next_element tree t), s, ctx)
+(*	| L2JIT.NEXT_ELEMENT s -> LOOP ((Tree.next_node_before tree t ctx), s, ctx) *)
 
 	| L2JIT.TAGGED_DESCENDANT (s, tag) ->
 	    LOOP_TAG ((Tree.tagged_descendant tree t tag), s, tag, ctx)
@@ -279,25 +299,27 @@ DEFINE LOOP_TAG (t, states, tag, ctx) = (
 	| L2JIT.TAGGED_SUBTREE(s, tag) ->
 
 	  let count = U.NS.subtree_tags tree t tag in
-		if count != U.NS.empty then
-		  let r = Array.copy empty_slot in
-		    r.(auto.last) <- count;
-		    s,r
-		else
-		  s,empty_slot
+	  if count != U.NS.empty then
+	    let r = Array.copy empty_slot in
+	    r.(auto.last) <- count;
+	    s,r
+	  else
+	    s,empty_slot
 
 	| L2JIT.ELEMENT_SUBTREE(s) ->
 
-	      let count = U.NS.subtree_elements tree t in
-		if count != U.NS.empty then
-		  let r = Array.copy empty_slot in
-		    r.(auto.last) <- count;
-		    s,r
-		else
-		  s,empty_slot
+	  let count = U.NS.subtree_elements tree t in
+	  if count != U.NS.empty then
+	    let r = Array.copy empty_slot in
+	    r.(auto.last) <- count;
+	    s,r
+	  else
+	    s,empty_slot
 
-    in
-      LOOP (root, states, ctx)
+      in
+      let r = LOOP (root, states, ctx) in
+      (*L3JIT.stats err_formatter cache3; *)
+      r
 
     let full_top_down_run auto states tree root =
       (*Ata.init (); *)
@@ -306,6 +328,7 @@ DEFINE LOOP_TAG (t, states, tag, ctx) = (
     let top_down_run auto tree root =
       (*Ata.init (); *)
       let res, slot = full_top_down_run auto auto.init tree root in
+
       slot.(StateSet.min_elt auto.topdown_marking_states)
 
 
@@ -401,5 +424,166 @@ DEFINE LOOP_TAG (t, states, tag, ctx) = (
       slot.(StateSet.min_elt auto.topdown_marking_states)
 
 
+(*  Grammar run *)
+    external is_young : 'a array -> bool = "caml_custom_is_young" "noalloc"
+    external blit : 'a array -> int -> 'a array -> int -> int -> unit = "caml_custom_array_blit"
+    module M = Map.Make(struct type t = Grammar.n_symbol let compare = compare end)
+    let log = ref M.empty
+    let log_symbol s =
+      let c = try M.find s !log with _ -> 0 in
+      log:= M.add s (c+1) !log
+    ;;
+    let () = at_exit (fun () -> M.iter (fun i j ->
+      if j > 0 then
+      Printf.eprintf "%i->%i\n%!"
+	(Grammar.symbol i) j) !log )
+    ;;
+    let blit a1 o1 a2 o2 l = if l != 0 then
+      for i = 0 to l - 1 do
+	a2.(o2 + i) <- a1.(o1 + i);
+      done
+
+
+    let grammar_run auto g () =
+
+      let start_symbol = Node.of_int 0 in
+      let dummy_leaf = Grammar.Leaf (Node.nil) in
+      let nil_symbol = Grammar.nil_symbol g in
+      let res_len = (StateSet.max_elt auto.states) + 1 in
+      let empty_slot = Array.create res_len U.NS.empty in
+      let nil_res = auto.bottom_states, empty_slot in
+      let empty_res = StateSet.empty, empty_slot in
+      let cache3 = L3JIT.create () in
+      let dummy2 = (StateSet.empty, StateSet.empty, Translist.nil) in
+      let cache2 = Cache.Lvl2.create 512 dummy2 in
+      let parameters = Array.create 2 dummy_leaf in
+      let parameters_tmp = Array.create 2 dummy_leaf in
+      let rule_counter = ref 0 in
+      let start_counter = ref 0 in
+      let () = at_exit (fun () -> Printf.eprintf "start_couter=%i, rule_counter=%i\n%!"
+	!start_counter !rule_counter) in
+      let get_trans tag states =
+	let c = Cache.Lvl2.find cache2 tag (Uid.to_int states.StateSet.Node.id) in
+	if c == dummy2 then
+	  let c =
+	    StateSet.fold (fun q tr_acc ->
+              List.fold_left
+                (fun ((lstates, rstates, tacc) as acc) (ts, trs) ->
+                  if TagSet.mem (Tag.translate tag) ts then
+                    let _, _, _, phi = Transition.node trs in
+                    let (_,_,l),(_,_,r) = Formula.st phi in
+                    (StateSet.union l lstates,
+                     StateSet.union r rstates,
+                     Translist.cons trs tacc)
+                  else acc)
+                tr_acc (Hashtbl.find auto.trans q)
+            ) states (StateSet.empty, StateSet.empty, Translist.nil)
+	  in
+	  begin
+	    Cache.Lvl2.add cache2 tag (Uid.to_int states.StateSet.Node.id) c;
+	    c
+	  end
+	else c
+      in
+      let rec start_loop idx states =
+	incr (start_counter);
+	TRACE("grammar", 2, __ "Node %i\n%!" (Node.to_int idx));
+	if idx < Node.null then nil_res
+	else if StateSet.is_empty states then empty_res
+	else begin
+	  let symbol = Grammar.get_symbol_at g start_symbol idx in
+	  if Grammar.is_terminal symbol then
+	    let symbol = Grammar.terminal symbol in
+	    if symbol == nil_symbol then nil_res else
+	      let tag = Grammar.tag symbol in
+	      let lst, rst, trans = get_trans tag states in
+	      let fs = Grammar.start_first_child g idx in
+	      let s1, slot1 = start_loop fs lst in
+	      let s2, slot2 = start_loop (Grammar.start_next_sibling g fs) rst in
+	      let opcode = L3JIT.find cache3 trans s1 s2 in
+	      if opcode == L3JIT.dummy then
+		(L3JIT.cache_apply cache3 auto trans s1 s2) empty_slot slot1 slot2 (Obj.magic ()) (Obj.magic ())
+	      else opcode empty_slot slot1 slot2 (Obj.magic ()) (Obj.magic())
+	  else
+	    let nt = Grammar.non_terminal symbol in
+	    let nparam = Grammar.num_params nt in
+	    let child = ref (Grammar.first_child g start_symbol idx) in
+	    for i = 0 to nparam - 1 do
+	      let c = !child in
+	      parameters.(i) <- Grammar.Leaf c;
+	      child := Grammar.next_sibling g start_symbol c;
+	    done;
+	    rule_loop nt states parameters
+
+	end
+      and rule_loop (t : Grammar.n_symbol) states a_param =
+	incr rule_counter;
+(*	log_symbol (t); *)
+	if !rule_counter land (4095) == 0 then begin Gc.minor() end;
+	let id1 = Grammar.get_id1 g t in
+	let id2 = Grammar.get_id2 g t in
+	let param_pos = Grammar.get_param_pos t in
+	let nparam1 = Grammar.num_children id1 in
+	let nparam2 =
+	  if Grammar.is_terminal id2 && nil_symbol == (Grammar.terminal id2) then 0
+	  else Grammar.num_children id2
+	in
+	let a_param2 = if nparam2 == 0 then [||] else Array.create nparam2 dummy_leaf in
+	let i = param_pos - 2 in
+	let ip1 = i + 1 in
+	let offset2d = i+2 in
+	let offset2s = i+nparam2 + 1 in
+	blit a_param 0 parameters_tmp 0 (i+1);
+	parameters_tmp.(ip1) <- Grammar.Node(id2, a_param2);  (* id2( ... ) *)
+	blit a_param offset2s parameters_tmp offset2d (nparam1 - i - 2);
+	blit a_param ip1 a_param2 0 nparam2;
+
+	blit parameters_tmp 0 parameters 0 nparam1;
+	if Grammar.is_non_terminal id1 then
+	  let id1 = Grammar.non_terminal id1 in
+	  rule_loop id1 states parameters
+	else
+	  let id1 = Grammar.terminal id1 in
+	  terminal_loop id1 states parameters
+
+      and terminal_loop (symbol : Grammar.t_symbol) states a_param =
+	if symbol == nil_symbol then nil_res else begin
+	  (* todo factor in from start_loop *)
+	  let tag = Grammar.tag symbol in
+	  let lst, rst, trans = get_trans tag states in
+	  let next = a_param.(1) in
+	  let s1, slot1 = partial_loop a_param.(0) lst in
+	  let s2, slot2 = partial_loop next rst in
+	  let opcode = L3JIT.find cache3 trans s1 s2 in
+	  if opcode == L3JIT.dummy then
+	    (L3JIT.cache_apply cache3 auto trans s1 s2) empty_slot slot1 slot2 (Obj.magic ()) (Obj.magic ())
+	  else
+	    opcode empty_slot slot1 slot2 (Obj.magic())  (Obj.magic())
+
+	    (* End: TODO refactor *)
+
+	end
+
+      and partial_loop l states =
+	match l with
+	| Grammar.Leaf id -> start_loop id states
+	| Grammar.Node (id, a_param) ->
+	  let is_term = Grammar.is_terminal id in
+	  if is_term then
+	    terminal_loop (Grammar.terminal id) states a_param
+	  else
+	    rule_loop (Grammar.non_terminal id) states a_param
+      in
+
+      let _, slot = start_loop (Node.null) auto.init in
+      slot.(StateSet.min_elt auto.topdown_marking_states)
+    ;;
+
+
+
+
+
+
+
   end