X-Git-Url: http://git.nguyen.vg/gitweb/?a=blobdiff_plain;f=ata.ml;h=e383e527c18ff46a7d067a333923703c68aaee58;hb=9df4d963bf2a5a405aca2831c8acd88e85bb0c7b;hp=ca137a705a767ea55bfe8c6e7a249695d9bf6ffa;hpb=99ac0ee0d0f85549a19b5e96442caa5a56f95a78;p=SXSI%2Fxpathcomp.git

diff --git a/ata.ml b/ata.ml
index ca137a7..e383e52 100644
--- a/ata.ml
+++ b/ata.ml
@@ -280,44 +280,6 @@ module FormTable = Hashtbl.Make(struct
 				  let hash (f,s,t) = 
 				    HASHINT3(Formula.uid f ,StateSet.uid s,StateSet.uid t)
 				end)
-(* Too slow  
-module MemoForm = Memoizer.Make(
-
-module F = Formula
-(*
-let eval_form_bool = 
-  MemoForm.make_rec( 
-    fun eval (f, ((s1,s2) as sets)) ->
-      match F.expr f with
-	| F.True -> true,true,true
-	| F.False -> false,false,false
-	| F.Atom((`Left|`LLeft),b,q) ->
-	    if b == (StateSet.mem q s1) 
-	    then (true,true,false) 
-	    else false,false,false
-	| F.Atom(_,b,q) -> 
-	    if b == (StateSet.mem q s2) 
-	    then (true,false,true)
-	    else false,false,false			
-	| F.Or(f1,f2) ->	    
-	    let b1,rl1,rr1 = eval (f1,sets)
-	    in
-	      if b1 && rl1 && rr1 then (true,true,true)  else
-		let b2,rl2,rr2 = eval (f2,sets)  in
-		let rl1,rr1 = if b1 then rl1,rr1 else false,false
-		and rl2,rr2 = if b2 then rl2,rr2 else false,false
-		in (b1 || b2, rl1||rl2,rr1||rr2)
-		     
-	| F.And(f1,f2) -> 
-	    let b1,rl1,rr1 = eval (f1,sets) in
-	      if b1 && rl1 && rr1 then (true,true,true) else
-		if b1 then 
-		  let b2,rl2,rr2 = eval (f2,sets) in
-		    if b2 then (true,rl1||rl2,rr1||rr2) else (false,false,false)
-		else (false,false,false) 	    
-  )
-
-*) *)
 module F = Formula
 
 let eval_form_bool = 
@@ -529,6 +491,67 @@ END
       let string_of_ts tags = (Ptset.Int.fold (fun t a -> a ^ " " ^ (Tag.to_string t) ) tags "{")^ " }"
 
 
+
+      module Algebra =
+	struct
+	  type jump = [ `LONG | `CLOSE | `NIL ]
+	  type t = jump*Ptset.Int.t
+	      
+	  let merge_jump (j1,l1) (j2,l2) = 
+	    match j1,j2 with
+	      | _ when j1 = j2 -> (j1,Ptset.Int.union l1 l2)
+	      | _,`NIL -> j1,l1
+	      | `NIL,_ -> j2,l2
+	      | _,_ -> (`CLOSE, Ptset.Int.union l1 l2)
+
+	  let merge_jump_list = function 
+	    | [] -> `NIL,Ptset.Int.empty
+	    | p::r -> List.fold_left (merge_jump) p r
+	      
+	  let labels a s = 
+	    Hashtbl.fold 
+	    (
+	      fun q l acc -> 
+		if (q == s)
+		then 
+
+		  (List.fold_left 
+		      (fun acc (ts,f) ->
+			let _,_,_,bur = Transition.node f in
+			if bur then acc else TagSet.cup acc ts) 
+		    acc l)
+		else acc ) a.trans TagSet.empty
+	  exception Found
+	    
+	  let is_rec a s access = 
+	    List.exists
+	      (fun (_,t) -> let _,_,f,_ = Transition.node t in
+	      StateSet.mem s (access f)) (Hashtbl.find a.trans s) 
+		     
+
+	  let decide a c_label l_label dir_states access =
+			
+	    let l = StateSet.fold 
+	      (fun s l -> 
+		 let s_rec= is_rec a s access in
+		 let tlabels,jmp = 
+		   if s_rec then l_label,`LONG 
+		   else c_label,`CLOSE in			      
+		 let slabels = TagSet.positive ((TagSet.cap (labels a s) tlabels))
+		 in
+		   (if Ptset.Int.is_empty slabels
+		    then `NIL,Ptset.Int.empty
+		    else  jmp,slabels)::l) dir_states []
+	    in merge_jump_list l
+		 
+
+	    
+	    
+	      
+	end 
+
+
+
       let choose_jump tagset qtags1 qtagsn a f_nil  f_t1 f_s1 f_tn f_sn f_notext f_maytext =
 	let tags1,hastext1,fin1 = inter_text tagset (tags a qtags1) in
 	let tagsn,hastextn,finn = inter_text tagset (tags a qtagsn) in