Implement the multiple-starters feature:

[tatoo.git] / src / xpath / compile.ml

diff --git a/src/xpath/compile.ml b/src/xpath/compile.ml
index 8ab26fb..cd887b7 100644 (file)
--- a/src/xpath/compile.ml
+++ b/src/xpath/compile.ml
@@ -39,11 +39,11 @@ 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
-  | _ -> phi %% F.mk_kind kind
+  | _ -> phi %% F.is kind
   in
   let phi', trans', states' =
     match axis with
@@ -210,30 +210,46 @@ 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 a = Ata.create states  mstates 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
+    (Ata.Builder.add_state builder) states;
   List.iter (fun (q, l) ->
     List.iter (fun (lab, phi) ->
-      Ata.add_trans a q lab phi
+      Ata.Builder.add_trans builder q lab phi
     ) l) trans;
-  Ata.complete_transitions a;
-  Ata.normalize_negations a;
-  a
+  Ata.Builder.finalize builder