Refactoring and cosmetic changes

git-svn-id: svn+ssh://idea.nguyen.vg/svn/sxsi/trunk/xpathcomp@1130 3cdefd35-fc62-479d-8e8d-bae585ffb9ca

diff --git a/src/cache.ml b/src/cache.ml
index f4561af..ed8af8c 100644 (file)
--- a/src/cache.ml
+++ b/src/cache.ml
@@ -1,125 +1,118 @@
 let realloc l old_size new_size dummy =
   let l' = Array.create new_size dummy in
-    Array.blit l 0 l' 0 (min old_size new_size);
-    l'
+  Array.blit l 0 l' 0 (min old_size new_size);
+  l'
 
 module Lvl1 =
-  struct
+struct
 
-    type 'a t = { mutable line : 'a array;
-                dummy : 'a }
-    let create n a = { line = Array.create n a;
-                      dummy = a }
+  type 'a t = { mutable line : 'a array;
+               dummy : 'a }
 
-    let find c i =
-      let line = c.line in
-      let len = Array.length line in
-       if i >= len then c.dummy else line.(i)
+  let create n a = { line = Array.create n a;
+                    dummy = a }
 
+  let find c i =
+    let line = c.line in
+    let len = Array.length line in
+    if i >= len then c.dummy else line.(i)
 
-    let add c i v =
-      let line = c.line in
-      let len = Array.length line in
-       if i >= len then c.line <- realloc line len (i*2+1) c.dummy;
-       c.line.(i) <- v
+  let add c i v =
+    let line = c.line in
+    let len = Array.length line in
+    if i >= len then c.line <- realloc line len (i*2+1) c.dummy;
+    c.line.(i) <- v
 
-    let dummy c = c.dummy
+  let dummy c = c.dummy
 
-    let to_array c = c.line
-  end
+  let to_array c = c.line
+end
 
 include Lvl1
 
 module Lvl2 =
-  struct
-    type 'a t = { mutable line : 'a array array;
-                dummy : 'a;
-                l1_size : int;
-                dummy_line1 : 'a array
-              }
-
-    let dummy_line = [| |]
-
-    let create ?(l1_size=512) n a =
-      let dummy_line1 = Array.create l1_size a in
-      { line = Array.create n dummy_line1;
-       dummy = a;
-       l1_size = l1_size;
-       dummy_line1 = dummy_line1;
-      }
-    let find c i j = c.line.(i).(j)
-    let add c i j v =
-      let line = c.line in
-      let len = Array.length line in
-      if i >= len then c.line <- realloc line len (i*2 + 1) c.dummy_line1;
-      let line = c.line.(i) in
-      let line =
-       if line == c.dummy_line1 then
-           let nline = Array.copy line (*Array.create c.l1_size c.dummy*) in
-             c.line.(i) <- nline;
-             nline
-         else line
-       in
-         line.(j) <- v
-
-    let dummy c = c.dummy
-    let to_array c = c.line
-    let dummy_line c = c.dummy_line1
-  end
+struct
+  type 'a t = { mutable line : 'a array array;
+               dummy : 'a;
+               l1_size : int;
+               dummy_line1 : 'a array
+             }
+
+  let dummy_line = [| |]
+
+  let create ?(l1_size=512) n a =
+    let dummy_line1 = Array.create l1_size a in
+    { line = Array.create n dummy_line1;
+      dummy = a;
+      l1_size = l1_size;
+      dummy_line1 = dummy_line1;
+    }
+
+  let find c i j = c.line.(i).(j)
+
+  let add c i j v =
+    let line = c.line in
+    let len = Array.length line in
+    if i >= len then
+      c.line <- realloc line len (i*2 + 1) c.dummy_line1;
+    let line = c.line.(i) in
+    let line =
+      if line == c.dummy_line1 then
+       let nline = Array.copy line in
+       c.line.(i) <- nline;
+       nline
+      else line
+    in
+    line.(j) <- v
+
+  let dummy c = c.dummy
+  let to_array c = c.line
+  let dummy_line c = c.dummy_line1
+end
 
 module Lvl3 =
-  struct
-    type 'a t = { mutable line : 'a array array array;
-                dummy : 'a;
-                l1_size : int;
-                l2_size : int;
-                dummy_line1 : 'a array array;
-                dummy_line2 : 'a array
-              }
-    let dummy_line2 = [| |]
-    let dummy_line1 = [| |]
-
-
-
-    let create ?(l1_size=512) ?(l2_size=512) n a =
-      let dummy_line2 = Array.create l2_size a in
-      let dummy_line1 = Array.create l1_size dummy_line2 in
-      { line = Array.create n dummy_line1;
-       dummy = a;
-       l1_size = l1_size;
-       l2_size = l2_size;
-       dummy_line1 = dummy_line1;
-       dummy_line2 = dummy_line2
-      }
-    let find t i j k = t.line.(i).(j).(k)
-(*
-    let find t i j k =
-      let line = t.line in
-      let line1 = line.(i) in
-       if line1 == dummy_line1 then t.dummy else
-         let line2 = line1.(j) in
-           if line2 == dummy_line2 then t.dummy else line2.(k)
-*)
-
-    let add t i j k v =
-      let line = t.line in
-      let line1 =
-       let l1 = line.(i) in
-         if l1 == t.dummy_line1 then
-           let l1' = Array.copy l1 in
-             line.(i) <- l1'; l1'
-         else l1
-      in
-      let line2 =
-       let l2 = line1.(j) in
-         if l2 == t.dummy_line2 then
-           let l2' = Array.copy l2 in
-             line1.(j) <- l2'; l2'
-         else l2
-      in
-       line2.(k) <- v
-
-
-    let dummy a = a.dummy
-    let to_array a = a.line
-  end
+struct
+  type 'a t =
+      { mutable line : 'a array array array;
+       dummy : 'a;
+       l1_size : int;
+       l2_size : int;
+       dummy_line1 : 'a array array;
+       dummy_line2 : 'a array }
+
+  let dummy_line2 = [| |]
+  let dummy_line1 = [| |]
+
+  let create ?(l1_size=512) ?(l2_size=512) n a =
+    let dummy_line2 = Array.create l2_size a in
+    let dummy_line1 = Array.create l1_size dummy_line2 in
+    { line = Array.create n dummy_line1;
+      dummy = a;
+      l1_size = l1_size;
+      l2_size = l2_size;
+      dummy_line1 = dummy_line1;
+      dummy_line2 = dummy_line2
+    }
+  let find t i j k = t.line.(i).(j).(k)
+
+  let add t i j k v =
+    let line = t.line in
+    let line1 =
+      let l1 = line.(i) in
+      if l1 == t.dummy_line1 then
+       let l1' = Array.copy l1 in
+       line.(i) <- l1'; l1'
+      else l1
+    in
+    let line2 =
+      let l2 = line1.(j) in
+      if l2 == t.dummy_line2 then
+       let l2' = Array.copy l2 in
+       line1.(j) <- l2'; l2'
+      else l2
+    in
+    line2.(k) <- v
+
+  let dummy a = a.dummy
+  let to_array a = a.line
+end

diff --git a/src/cache.mli b/src/cache.mli
index 87ddfd9..2d52dc7 100644 (file)
--- a/src/cache.mli
+++ b/src/cache.mli
@@ -1,17 +1,27 @@
 type 'a t
 
 val create : int -> 'a -> 'a t
-
 val find : 'a t -> int -> 'a
-
 val add : 'a t -> int -> 'a -> unit
-
 val dummy : 'a t -> 'a
-
 val to_array : 'a t -> 'a array
 
-module Lvl2 :
-  sig
+
+module Lvl1 :
+sig
+
+  type 'a t
+
+  val create : int -> 'a -> 'a t
+  val find : 'a t -> int -> 'a
+  val add : 'a t -> int -> 'a -> unit
+  val dummy : 'a t -> 'a
+  val to_array : 'a t -> 'a array
+
+end
+
+module Lvl2:
+sig
 
     type 'a t
 
@@ -22,7 +32,7 @@ module Lvl2 :
     val dummy_line :  'a t -> 'a array
     val to_array : 'a t -> 'a array array
 
-  end
+end
 
 module Lvl3 :
   sig
@@ -34,4 +44,5 @@ module Lvl3 :
     val add : 'a t -> int -> int -> int -> 'a -> unit
     val dummy : 'a t -> 'a
     val to_array : 'a t -> 'a array array array
+
   end

diff --git a/src/compile.ml b/src/compile.ml
index 4212798..04fa7f1 100644 (file)
--- a/src/compile.ml
+++ b/src/compile.ml
@@ -1,4 +1,3 @@
-
 open Ata
 open XPath.Ast
 
@@ -22,8 +21,7 @@ type info = {
   bottom_states : StateSet.t;
   last : State.t;
   bottom_up : tri_state;
-  text_pred : (text_query * string) list
-}
+  text_pred : (text_query * string) list }
 
 let empty_info =
   { trans = [];
@@ -32,195 +30,183 @@ let empty_info =
     bottom_states = StateSet.empty;
     last = State.dummy;
     bottom_up = `Unknown;
-    text_pred = []
-  }
+    text_pred = [] }
 
 open Formula.Infix
 
 let mk_phi top phi loop = if top then phi *& loop else phi
 
-let log msg v1 v2 =
-  let () = Format.eprintf "%a -> %a in %s\n%!"
-     pr_tri_state v1
-     pr_tri_state v2
-     msg
-  in v2
-
-let log _ _ v = v
 
-let rec compile_step toplevel ((axis, test, _) as _step) state cont conf last =
-  let test, cont = match test with
+let rec compile_step toplevel (axis, test, _) state cont conf last =
+  let test, cont =
+    match test with
     | Simple t -> t, cont
     | Complex (t, p) -> t, Formula.and_ (Formula.pred_ p) cont
   in
   let marking = toplevel && last in
   let trans, new_cont =
     match axis with
-      | Child ->
-         let loop = `Right *+ state in
-         let phi = mk_phi toplevel cont loop in
-          ( [ (Transition.make (state, test, marking, phi));
-              (Transition.make (state, TagSet.any, false, loop))],
-            (`Left *+ state))
-
-      | FollowingSibling ->
-         let loop = `Right *+ state in
-         let phi = mk_phi toplevel cont loop in
-           ( [ (Transition.make (state, test, marking, phi));
-              (Transition.make (state, TagSet.any, false, loop))],
-             (`Right *+ state))
-
-      | Descendant ->
-         let loopfun = if toplevel then Formula.and_ else Formula.or_ in
-         let loop =  loopfun (`Left *+ state) (`Right *+ state) in
-         let phi = mk_phi toplevel cont loop in
-           ( [ (Transition.make (state, test, marking, phi));
-               (Transition.make (state, TagSet.any, false, loop));
-               (*(Transition.make (state, TagSet.any, false, `Right *+ state)) *)
-             ],
-            (`Left *+ state))
-
-      | _ -> assert false
+    | Child ->
+      let loop = `Right *+ state in
+      let phi = mk_phi toplevel cont loop in
+      ( [ (Transition.make (state, test, marking, phi));
+         (Transition.make (state, TagSet.any, false, loop))],
+       (`Left *+ state))
+
+    | FollowingSibling ->
+      let loop = `Right *+ state in
+      let phi = mk_phi toplevel cont loop in
+      ( [ (Transition.make (state, test, marking, phi));
+         (Transition.make (state, TagSet.any, false, loop))],
+       (`Right *+ state))
+
+    | Descendant ->
+      let loopfun = if toplevel then Formula.and_ else Formula.or_ in
+      let loop =  loopfun (`Left *+ state) (`Right *+ state) in
+      let phi = mk_phi toplevel cont loop in
+      ( [ (Transition.make (state, test, marking, phi));
+         (Transition.make (state, TagSet.any, false, loop));
+             (*(Transition.make (state, TagSet.any, false, `Right *+ state)) *)
+       ],
+       (`Left *+ state))
+
+    | _ -> assert false
   in
-    { conf with
-      trans = trans@conf.trans;
-      states = StateSet.add state conf.states;
-      marking_states =
-       if toplevel
-       then StateSet.add state conf.marking_states
-       else conf.marking_states
-    }, new_cont
+  { conf with
+    trans = trans@conf.trans;
+    states = StateSet.add state conf.states;
+    marking_states =
+      if toplevel
+      then StateSet.add state conf.marking_states
+      else conf.marking_states }, new_cont
 
 and compile_step_list toplevel sl conf =
   match sl with
-      [] ->
-       let state = State.make () in
-       let phi = `Left *+ state in
-       let loop = (`Left *+ state) *& (`Right *+ state) in
-         ( true,
-           phi,
-             { conf with
-                 states = StateSet.add state conf.states;
-                 bottom_states = StateSet.add state conf.bottom_states;
-                 trans = (Transition.make (state, TagSet.any, false, loop)) :: conf.trans;
-             } )
-    | (_, _, pred) as step :: sll ->
-       let state = State.make () in
-       let pred, conf = compile_predicate pred conf in
-       let last, cont, conf = compile_step_list toplevel sll conf in
-       let conf, new_cont = compile_step toplevel step state (pred *& cont) conf last in
-       let conf = if toplevel && last then {conf with last = state} else conf in
-         false, new_cont, conf
+    [] ->
+      let state = State.make () in
+      let phi = `Left *+ state in
+      let loop = (`Left *+ state) *& (`Right *+ state) in
+      true,
+      phi,
+      { conf with
+       states = StateSet.add state conf.states;
+       bottom_states = StateSet.add state conf.bottom_states;
+       trans =
+         let trans =
+           Transition.make (state, TagSet.any, false, loop)
+         in
+         trans :: conf.trans }
+
+  | (_, _, pred) as step :: sll ->
+    let state = State.make () in
+    let pred, conf = compile_predicate pred conf in
+    let last, cont, conf = compile_step_list toplevel sll conf in
+    let conf, new_cont =
+      compile_step toplevel step state (pred *& cont) conf last
+    in
+    let conf =
+      if toplevel && last then
+       { conf with last = state }
+      else
+       conf
+    in false, new_cont, conf
 
 and compile_predicate predicate conf =
   match predicate with
-    | Or(p1, p2) ->
-
-       let cont1, conf1 = compile_predicate p1 conf in
-       let cont2, conf2 = compile_predicate p2 conf1 in
-         cont1 +| cont2, { conf2 with bottom_up = `No
-                         }
-    | And(p1, p2) ->
-       let cont1, conf1 = compile_predicate p1 conf in
-       let cont2, conf2 = compile_predicate p2 conf1 in
-         cont1 *& cont2, { conf2 with bottom_up = `No
-                         }
-    | Not p ->
-       let cont, conf = compile_predicate p conf in
-         Formula.not_ cont, { conf with bottom_up = `No
-                            }
-    | Expr e ->
-         compile_expr e conf
+  | Or(p1, p2) ->
+
+    let cont1, conf1 = compile_predicate p1 conf in
+    let cont2, conf2 = compile_predicate p2 conf1 in
+    cont1 +| cont2, { conf2 with bottom_up = `No }
+
+  | And(p1, p2) ->
+    let cont1, conf1 = compile_predicate p1 conf in
+    let cont2, conf2 = compile_predicate p2 conf1 in
+    cont1 *& cont2, { conf2 with bottom_up = `No }
+
+  | Not p ->
+    let cont, conf = compile_predicate p conf in
+    Formula.not_ cont, { conf with bottom_up = `No  }
+
+  | Expr e -> compile_expr e conf
+
 and append_path p s =
   match p with
-    | Relative sl -> Relative (sl @ [s])
-    | Absolute sl -> Absolute (sl @ [s])
-    | AbsoluteDoS sl -> AbsoluteDoS (sl @ [s])
+  | Relative sl -> Relative (sl @ [s])
+  | Absolute sl -> Absolute (sl @ [s])
+  | AbsoluteDoS sl -> AbsoluteDoS (sl @ [s])
 
 and compile_expr expr conf =
   match expr with
-    | True -> Formula.true_, conf
-    | False -> Formula.false_, conf
-    | Path p ->
-      let phi, conf = compile_path false p conf in
-      phi, { conf with
-       bottom_up = let v =
-                   match conf.bottom_up with
-                     | `Yes -> `Yes
-                     | _ -> `No
-                   in v
-      }
-    | Function(fn,
-              [ Path(Relative
-                       [(Self, Simple (n), Expr True)]) ; String s ]) when n == TagSet.node ->
-
-      let f =
-       match fn with
-         | "contains" -> `Contains
-           | "equals" -> `Equals
-           | "starts-with" -> `Prefix
-           | "ends-with" -> `Suffix
-           | _ -> failwith ("Unknown function : " ^ fn)
-      in
-      let pred = Tree.mk_pred f s in
-      let phi, conf' =
-       compile_expr (Path (Relative [(Child, Complex(TagSet.pcdata, pred), Expr True)])) conf
-      in
-      phi,
-      { conf' with
-       text_pred = (f,s) :: conf'.text_pred;
-       bottom_up =
-         let v =
-           match conf.bottom_up with
-             | `Unknown -> `Yes
-             | _ -> `No
-         in v
-      }
-    | _ -> assert false
+  | True -> Formula.true_, conf
+  | False -> Formula.false_, conf
+  | Path p ->
+    let phi, conf = compile_path false p conf in
+    phi, { conf with
+      bottom_up =
+       match conf.bottom_up with
+       | `Yes -> `Yes
+       | _ -> `No }
+
+  | Function(fn,
+            [ Path(Relative [(Self, Simple (n), Expr True)]);
+              String s ]) when n == TagSet.node ->
+
+    let f =
+      match fn with
+      | "contains" -> `Contains
+      | "equals" -> `Equals
+      | "starts-with" -> `Prefix
+      | "ends-with" -> `Suffix
+      | _ -> failwith ("Unknown function : " ^ fn)
+    in
+    let pred = Tree.mk_pred f s in
+    let phi, conf' =
+      compile_expr
+       (Path (Relative [(Child,
+                         Complex(TagSet.pcdata, pred),
+                         Expr True)]))
+       conf
+    in
+    phi,
+    { conf' with
+      text_pred = (f,s) :: conf'.text_pred;
+      bottom_up =
+       match conf.bottom_up with
+       | `Unknown -> `Yes
+       | _ -> `No }
+
+  | _ -> assert false
 
 and compile_path toplevel p conf =
   let sl =
     match p with
-      | Relative sl -> sl
-      | Absolute sl -> (Child, Simple (TagSet.singleton Tag.document_node), Expr True)::sl
-      | AbsoluteDoS sl ->
-         (Descendant, (Simple TagSet.node), Expr True)::sl
+    | Relative sl -> sl
+    | Absolute sl ->
+      let prefix = Child,
+       Simple (TagSet.singleton Tag.document_node),
+       Expr True
+      in prefix :: sl
+
+    | AbsoluteDoS sl ->
+      (Descendant, (Simple TagSet.node), Expr True)::sl
   in
   let _, cont, conf = compile_step_list toplevel sl conf in
-    cont, conf
-
-let is_topdown_loop q s =
-  StateSet.cardinal (StateSet.remove q s) <= 1
-let rec remove_topdown_marking trans l last =
-  match l with
-    | [] -> last :: l
-    | q :: ll ->
-       let tr_list = Hashtbl.find trans q in
-         if List.for_all
-           (fun (_, t) ->
-              let _, _, m, f = Transition.node t in
-              let (_, _, stl), (_, _, str) = Formula.st f in
-                not m && is_topdown_loop q stl && is_topdown_loop q str) tr_list
-         then remove_topdown_marking trans ll q
-         else last :: l
-
+  cont, conf
 
 let compile path =
   let cont, conf = compile_path true path empty_info in
   let (_, _, init), _ = Formula.st cont in
   let get t s =
-    try
-      Hashtbl.find t s
-    with
-      | Not_found -> []
+    try Hashtbl.find t s with Not_found -> []
   in
   let table = Hashtbl.create 13 in
-  let () =
-    List.iter (fun tr ->
-                let q, ts, _, _ = Transition.node tr in
-                let l = get table q in
-                  Hashtbl.replace table q ((ts, tr)::l)) conf.trans
-  in
+  List.iter
+    (fun tr ->
+      let q, ts, _, _ = Transition.node tr in
+      let l = get table q in
+      Hashtbl.replace table q ((ts, tr)::l))
+    conf.trans;
   let auto = {
     id = Oo.id (object end);
     Ata.states = conf.states;
@@ -229,12 +215,9 @@ let compile path =
     trans = table;
     Ata.marking_states = conf.marking_states;
     Ata.topdown_marking_states = conf.marking_states;
-      (* StateSet.from_list (
-        remove_topdown_marking table
-           (StateSet.elements conf.marking_states)
-        (StateSet.min_elt init)
-        ); *)
-    Ata.bottom_states = StateSet.union conf.bottom_states conf.marking_states;
-      Ata.true_states = conf.bottom_states;
-  }
-  in auto, (if conf.bottom_up = `Yes then Some conf.text_pred else None)
+    Ata.bottom_states =
+      StateSet.union conf.bottom_states conf.marking_states;
+    Ata.true_states = conf.bottom_states }
+  in
+  auto,
+  (if conf.bottom_up = `Yes then Some conf.text_pred else None)

diff --git a/src/compile.mli b/src/compile.mli
index a5f3beb..d999492 100644 (file)
--- a/src/compile.mli
+++ b/src/compile.mli
@@ -1,3 +1,2 @@
-
 type text_query = [ `Prefix | `Suffix | `Equals | `Contains ]
 val compile : XPath.Ast.t -> Ata.t * (text_query * string) list option