X-Git-Url: http://git.nguyen.vg/gitweb/?p=tatoo.git;a=blobdiff_plain;f=src%2Fxpath%2Fcompile.ml;h=cd887b74970d5a07094fb927b58efcb34717ccf0;hp=c53057e6c5e2d69fabf102c43e4758c8c19baaed;hb=6ca42ffbd541cede6afcc473b563e54b848ee534;hpb=af9d790ca62e678e8e70ab8d8fa7f804985a75e0 diff --git a/src/xpath/compile.ml b/src/xpath/compile.ml index c53057e..cd887b7 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,40 @@ 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 + (** ensure that we have a single selecting state at the end *) + let phi_sel = StateSet.fold (fun q acc -> F.or_ (F.stay q) acc) mstates F.false_ in + let q_sel = State.make () in + let states = StateSet.add q_sel states in + let mstates = StateSet.singleton q_sel in + let trans = (q_sel, [QNameSet.any, phi_sel]) :: trans in + StateSet.iter + (Ata.Builder.add_state builder ~starting:true) sstates; StateSet.iter (Ata.Builder.add_state builder ~selecting:true) mstates; StateSet.iter