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;
}
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 =
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
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 =
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;
{
id = next ();
states = StateSet.empty;
+ starting_states = StateSet.empty;
selecting_states = StateSet.empty;
transitions = Hashtbl.create MED_H_SIZE;
}
); *)
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 =
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 *)
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 *)
(Ata.TransList.print ~sep:"<br/>") 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 =
- let top_down node run =
+ let top_down run =
let tree = run.tree in
let auto = run.auto in
let status = run.status in
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 *)
unstable_self
end
in
- run.redo <- loop node;
+ run.redo <- loop (T.root tree);
run.pass <- run.pass + 1
(*
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
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
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 "<xml_result>\n";
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
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