From be588f7af67f6b24aa423ff374c0f1c058e64951 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Kim=20Nguy=E1=BB=85n?= Date: Fri, 19 Jul 2013 17:02:10 +0200 Subject: [PATCH] Preliminary work for multiple starters evaluation. --- src/ata.ml | 37 ++++++++++++++++++++----------- src/ata.mli | 12 ++++++---- src/run.ml | 52 +++++++++++++++++++++++++++++++++++++++----- src/run.mli | 2 +- src/tatoo.ml | 2 +- src/xpath/compile.ml | 28 +++++++++++++++--------- 6 files changed, 99 insertions(+), 34 deletions(-) diff --git a/src/ata.ml b/src/ata.ml index 7310839..79d47a9 100644 --- a/src/ata.ml +++ b/src/ata.ml @@ -142,6 +142,7 @@ end = type t = { id : Uid.t; mutable states : StateSet.t; + mutable starting_states : StateSet.t; mutable selecting_states: StateSet.t; transitions: (State.t, (QNameSet.t*Formula.t) list) Hashtbl.t; } @@ -149,6 +150,7 @@ type t = { let get_states a = a.states +let get_starting_states a = a.starting_states let get_selecting_states a = a.selecting_states let get_trans a tag states = @@ -174,10 +176,12 @@ let print fmt a = fprintf fmt "Internal UID: %i@\n\ States: %a@\n\ + Starting states: %a@\n\ Selection states: %a@\n\ Alternating transitions:@\n" (a.id :> int) StateSet.print a.states + StateSet.print a.starting_states StateSet.print a.selecting_states; let trs = Hashtbl.fold @@ -219,19 +223,24 @@ let print fmt a = let complete_transitions a = StateSet.iter (fun q -> - let qtrans = Hashtbl.find a.transitions q in - let rem = - List.fold_left (fun rem (labels, _) -> - QNameSet.diff rem labels) QNameSet.any qtrans - in - let nqtrans = - if QNameSet.is_empty rem then qtrans - else - (rem, Formula.false_) :: qtrans - in - Hashtbl.replace a.transitions q nqtrans + if StateSet.mem q a.starting_states then () + else + let qtrans = try Hashtbl.find a.transitions q with Not_found -> eprintf "Not found here 226\n%!"; raise Not_found in + let rem = + List.fold_left (fun rem (labels, _) -> + QNameSet.diff rem labels) QNameSet.any qtrans + in + let nqtrans = + if QNameSet.is_empty rem then qtrans + else + (rem, Formula.false_) :: qtrans + in + Hashtbl.replace a.transitions q nqtrans ) a.states +(* [cleanup_states] remove states that do not lead to a + selecting states *) + let cleanup_states a = let memo = ref StateSet.empty in let rec loop q = @@ -308,7 +317,7 @@ let normalize_negations auto = in Hashtbl.add memo_state key nq; nq in - let trans = Hashtbl.find auto.transitions q in + let trans = try Hashtbl.find auto.transitions q with Not_found -> eprintf "Not_found here 318\n%!"; [] in let trans' = List.map (fun (lab, f) -> lab, flip b f) trans in Hashtbl.replace auto.transitions q' trans'; done; @@ -326,6 +335,7 @@ module Builder = { id = next (); states = StateSet.empty; + starting_states = StateSet.empty; selecting_states = StateSet.empty; transitions = Hashtbl.create MED_H_SIZE; } @@ -350,8 +360,9 @@ module Builder = ); *) auto - let add_state a ?(selecting=false) q = + let add_state a ?(starting=false) ?(selecting=false) q = a.states <- StateSet.add q a.states; + if starting then a.starting_states <- StateSet.add q a.starting_states; if selecting then a.selecting_states <- StateSet.add q a.selecting_states let add_trans a q s f = diff --git a/src/ata.mli b/src/ata.mli index 8b7851b..2676923 100644 --- a/src/ata.mli +++ b/src/ata.mli @@ -85,6 +85,9 @@ type t val get_states : t -> StateSet.t (** return the set of states of the automaton *) +val get_starting_states : t -> StateSet.t +(** return the set of starting states of the automaton *) + val get_selecting_states : t -> StateSet.t (** return the set of selecting states of the automaton *) @@ -109,10 +112,11 @@ sig val make : unit -> t (** Create a fresh builder *) - val add_state : t -> ?selecting:bool -> State.t -> unit - (** Add a state to the set of states of the automaton. The optional argument - [?selecting] (defaulting to [false]) allows to specify whether the state is - selecting. *) + val add_state : t -> ?starting:bool -> ?selecting:bool -> State.t -> unit + (** Add a state to the set of states of the automaton. The + optional arguments [?starting] and [?selecting] (defaulting + to [false]) allow one to specify whether the state is + starting/selecting. *) val add_trans : t -> State.t -> QNameSet.t -> Formula.t -> unit (** Add a transition to the automaton *) diff --git a/src/run.ml b/src/run.ml index 38b7e45..d7d5177 100644 --- a/src/run.ml +++ b/src/run.ml @@ -159,6 +159,16 @@ END (Ata.TransList.print ~sep:"
") config.todo i + let debug msg tree node i config = + let config = config.NodeStatus.node in + eprintf + "DEBUG:%s node: %i\nsat: %a\nunsat: %a\ntodo: %around: %i\n" + msg + (T.preorder tree node) + StateSet.print config.sat + StateSet.print config.unsat + (Ata.TransList.print ~sep:"\n") config.todo i + let get_trans cache2 auto tag states = let trs = @@ -262,7 +272,7 @@ END - let top_down node run = + let top_down run = let tree = run.tree in let auto = run.auto in let status = run.status in @@ -285,7 +295,8 @@ END if c == dummy_status then (* first time we visit the node *) NodeStatus.make - { c.NodeStatus.node with + { sat = StateSet.empty; + unsat = Ata.get_starting_states auto; todo = get_trans cache2 auto tag (Ata.get_states auto); summary = NodeSummary.make (node == T.first_child tree parent) (* is_left *) @@ -346,7 +357,7 @@ END unstable_self end in - run.redo <- loop node; + run.redo <- loop (T.root tree); run.pass <- run.pass + 1 (* @@ -405,9 +416,40 @@ END in loop (T.root tree) [] + let prepare_run run list = + let tree = run.tree in + let auto = run.auto in + let status = run.status in + let cache2 = run.cache2 in + List.iter (fun node -> + let parent = T.parent tree node in + let fc = T.first_child tree node in + let ns = T.next_sibling tree node in + let tag = T.tag tree node in + + let status0 = + NodeStatus.make + { sat = Ata.get_starting_states auto; + unsat = StateSet.empty; + todo = get_trans cache2 auto tag (Ata.get_states auto); + summary = NodeSummary.make + (node == T.first_child tree parent) (* is_left *) + (node == T.next_sibling tree parent) (* is_right *) + (fc != T.nil) (* has_left *) + (ns != T.nil) (* has_right *) + (T.kind tree node) (* kind *) + } + in + let node_id = T.preorder tree node in + status.(node_id) <- status0) list + - let eval auto tree node = + + let eval auto tree nodes = let run = make auto tree in - while run.redo do top_down node run done; + prepare_run run nodes; + while run.redo do + top_down run; + done; get_results run end diff --git a/src/run.mli b/src/run.mli index 8476326..d57f6c9 100644 --- a/src/run.mli +++ b/src/run.mli @@ -15,5 +15,5 @@ module Make (T : Tree.S) : sig - val eval : Ata.t -> T.t -> T.node -> T.node list + val eval : Ata.t -> T.t -> T.node list -> T.node list end diff --git a/src/tatoo.ml b/src/tatoo.ml index c3cddfe..362c4fb 100644 --- a/src/tatoo.ml +++ b/src/tatoo.ml @@ -52,7 +52,7 @@ let main () = let module Naive = Run.Make(Naive_tree) in let results = - time (Naive.eval auto doc) (Naive_tree.root doc) "evaluating query" + time (Naive.eval auto doc) ([Naive_tree.root doc]) "evaluating query" in time (fun () -> output_string output "\n"; diff --git a/src/xpath/compile.ml b/src/xpath/compile.ml index c53057e..6987b4c 100644 --- a/src/xpath/compile.ml +++ b/src/xpath/compile.ml @@ -39,7 +39,7 @@ let root_set = QNameSet.singleton QName.document holds. *) -let compile_axis_test axis (test,kind) phi trans states = +let compile_axis_test axis (test,kind) phi trans states= let q = State.make () in let phi = match kind with Tree.NodeKind.Node -> phi @@ -210,26 +210,34 @@ let compile_top_level_step_list l trans states = in loop ll trans2 states2 phi2 in + let starting = State.make () in let phi0, trans0, states0 = compile_axis_test Self - (QNameSet.singleton QName.document, Tree.NodeKind.Node) - F.true_ + (QNameSet.any, Tree.NodeKind.Node) + (F.stay starting) trans states in - loop l trans0 states0 phi0 + let mstates, trans, states = loop l trans0 states0 phi0 in + starting, mstates, trans, states ;; let path p = - let mstates, trans, states = List.fold_left (fun (ams, atrs, asts) p -> - let ms, natrs, nasts = - match p with - | Absolute l | Relative l -> compile_top_level_step_list l atrs asts - in - (StateSet.add ms ams), natrs, nasts) (StateSet.empty, [], StateSet.empty) p + let sstates, mstates, trans, states = + List.fold_left (fun (ass, ams, atrs, asts) p -> + let ss, ms, natrs, nasts = + match p with + | Absolute l | Relative l -> compile_top_level_step_list l atrs asts + in + (StateSet.add ss ass), + (StateSet.add ms ams), + natrs, + nasts) (StateSet.empty, StateSet.empty, [], StateSet.empty) p in let builder = Ata.Builder.make () in + StateSet.iter + (Ata.Builder.add_state builder ~starting:true) sstates; StateSet.iter (Ata.Builder.add_state builder ~selecting:true) mstates; StateSet.iter -- 2.17.1