From 92e6cc9537b4751588ecb93c99685bc91d6797a0 Mon Sep 17 00:00:00 2001
From: kim <kim@3cdefd35-fc62-479d-8e8d-bae585ffb9ca>
Date: Mon, 12 Sep 2011 06:21:44 +0000
Subject: [PATCH] Refactoring and cosmetic changes

git-svn-id: svn+ssh://idea.nguyen.vg/svn/sxsi/trunk/xpathcomp@1130 3cdefd35-fc62-479d-8e8d-bae585ffb9ca
---
 src/cache.ml    | 211 ++++++++++++++++----------------
 src/cache.mli   |  25 ++--
 src/compile.ml  | 311 +++++++++++++++++++++++-------------------------
 src/compile.mli |   1 -
 4 files changed, 267 insertions(+), 281 deletions(-)

diff --git a/src/cache.ml b/src/cache.ml
index f4561af..ed8af8c 100644
--- 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
--- 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
--- 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
--- 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
-- 
2.17.1