X-Git-Url: http://git.nguyen.vg/gitweb/?p=tatoo.git;a=blobdiff_plain;f=src%2Fxpath%2Fcompile.ml;fp=src%2Fxpath%2Fcompile.ml;h=b22a74b6024263a9527fe51bba53ca1cbd56a542;hp=783d7f182f449b3fafbdafd90d3f7c4c000c9ea2;hb=f49a93deba13602e16a3923695281e9a20215ac8;hpb=e13f5deae217f945b44fa345ef4f0008e1780787

diff --git a/src/xpath/compile.ml b/src/xpath/compile.ml
index 783d7f1..b22a74b 100644
--- a/src/xpath/compile.ml
+++ b/src/xpath/compile.ml
@@ -14,7 +14,7 @@
 (***********************************************************************)
 
 (*
-  Time-stamp: <Last modified on 2013-02-14 17:15:58 CET by Kim Nguyen>
+  Time-stamp: <Last modified on 2013-03-04 17:55:28 CET by Kim Nguyen>
 *)
 
 open Ast
@@ -40,7 +40,7 @@ let ( @: ) a b = StateSet.add a b
 
 let compile_axis_test axis test phi trans states =
   let q = State.make () in
-  let phi, trans, states =
+  let phi', trans', states' =
     match axis with
     | Self ->
           (`Epsilon ** q),
@@ -90,7 +90,8 @@ let compile_axis_test axis test phi trans states =
     | Attribute ->
         let q' = State.make () in
         let test = if QNameSet.is_finite test then
-            QNameSet.fold (fun tag acc -> QNameSet.add (QName.add_attribute_prefix tag) acc)
+            QNameSet.fold (fun tag acc ->
+              QNameSet.add (QName.add_attribute_prefix tag) acc)
               test QNameSet.empty
           else test
         in
@@ -102,8 +103,17 @@ let compile_axis_test axis test phi trans states =
     | _ -> assert false
 
   in
-  phi, trans, q @: states
+  phi', trans', q @: states'
+
+
+let compile_rev_axis_test axis test phi trans states =
+  match axis with
+  | Attribute -> assert false
+  | _ -> compile_axis_test (invert_axis axis) test phi trans states
 ;;
+
+
+
 let rec compile_expr e trans states =
   match e with
   | Binop (e1, (And|Or as op), e2) ->
@@ -135,9 +145,10 @@ and compile_single_path p trans states =
     | Relative steps -> steps
   in
   compile_step_list steps trans states
+
 and compile_step_list l trans states =
   match l with
-    [] -> Ata.SFormula.true_, trans, states
+  | [] -> Ata.SFormula.true_, trans, states
   | (axis, test, elist) :: ll ->
       let phi0, trans0, states0 = compile_step_list ll trans states in
       let phi1, trans1, states1 =
@@ -146,3 +157,68 @@ and compile_step_list l trans states =
       List.fold_left (fun (aphi, atrans, astates) e ->
         let ephi, etrans, estates = compile_expr e atrans astates in
         aphi %% ephi, etrans, estates) (phi1, trans1, states1) elist
+
+let compile_top_level_step_list l trans states =
+  let rec loop l trans states phi_above =
+    match l with
+    | (axis, test, elist) :: [] ->
+        let phi0, trans0, states0 =
+          compile_rev_axis_test axis QNameSet.any phi_above trans states
+        in
+        let phi1, trans1, states1 =
+          List.fold_left (fun (aphi, atrans, astates) e ->
+            let ephi, etrans, estates = compile_expr e atrans astates in
+            aphi %% ephi, etrans, estates) (phi0, trans0, states0) elist
+        in
+        let _, trans2, states2 =
+          compile_axis_test Self test phi1 trans1 states1
+          in
+        let marking_state =
+          StateSet.choose (StateSet.diff states2 states1)
+        in
+        marking_state, trans2, states2
+    | (axis, test, elist) :: ll ->
+        let phi0, trans0, states0 =
+          compile_rev_axis_test axis QNameSet.any phi_above trans states
+        in
+        let phi1, trans1, states1 =
+          compile_axis_test Self test phi0 trans0 states0
+        in
+          let phi2, trans2, states2 =
+            List.fold_left (fun (aphi, atrans, astates) e ->
+              let ephi, etrans, estates = compile_expr e atrans astates in
+              aphi %% ephi, etrans, estates) (phi1, trans1, states1) elist
+          in
+          loop ll trans2 states2 phi2
+    | _ -> assert false
+  in
+  let phi0, trans0, states0 =
+    compile_axis_test
+      Self
+      (QNameSet.singleton QName.document)
+      Ata.SFormula.true_
+      trans
+      states
+  in
+  loop l trans0 states0 phi0
+;;
+
+
+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
+  in
+  let a = Ata.create () in
+  a.Ata.states <- states;
+  a.Ata.selection_states <- mstates;
+  List.iter (fun (q, l) ->
+    List.iter (fun (lab, phi) ->
+      Ata.add_trans a q lab phi
+    ) l) trans;
+  Ata.complete_transitions a;
+  Ata.normalize_negations a;
+  a