[r2006-05-30 08:24:14 by afrisch] Empty log message

Original author: afrisch
Date: 2006-05-30 08:24:14+00:00

types/patterns.ml

@@ -990,8 +990,6 @@ module Compile = struct
       incr cur_id;
       Hashtbl.add dispatcher_of_state state.uid disp;
       dispatchers := DispMap.add (t,pl) disp !dispatchers;
-(*      dump_disp disp;  
-      Format.fprintf Format.std_formatter "IFACE=%a@." print_iface iface; *)
       !compute_actions disp;
       disp
     
@@ -1193,12 +1191,14 @@ module Compile = struct
       let nnf = (Normal.NodeSet.singleton p, Types.cap !t0 tp, xs) in
       t0 := Types.diff !t0 tp;
       [(nnf, (xs, e))] in
+    let has_facto = ref false in
     let res _ _ pl =
       let aux r = function 
 	| [((var,nil,res), (xs,e))] -> assert (r == Fail); 
 	    let i = ref 0 in
 	    List.iter (fun x -> 
-			 if IdSet.mem var x || IdSet.mem nil x then ()
+			 if IdSet.mem var x || IdSet.mem nil x 
+			 then has_facto := true
 			 else (assert (IdMap.assoc x res = !i); incr i)) xs;
 	    Match (List.length xs, (var,nil,xs,e))
 	| [] -> r | _ -> assert false in
@@ -1207,11 +1207,10 @@ module Compile = struct
       "make_branches t=%a   #branches=%i@." Types.Print.print t (List.length brs);  *)
     let pl = Array.map aux (Array.of_list brs) in
     let disp,rhs = get_tests true pl (fun x -> x) t res (fun x -> x) in
-    let state = add_factorized disp rhs in 
-    state, 
-    (Array.map 
-       (function Match (n,(_,_,_,e)) -> Match (n,e) | Fail -> Fail) rhs)
-
+    let state = if !has_facto then add_factorized disp rhs else disp.state in
+    state,
+    Array.map 
+      (function Match (n,(_,_,_,e)) -> Match (n,e) | Fail -> Fail) rhs
 
   let rec dispatch_prod0 disp t pl =
     get_tests true pl

types/types.ml

@@ -1307,13 +1307,10 @@ module Cache = struct
     | Type of t * 'a
     | Split of Witness.witness * 'a cache * 'a cache
 
-  let steps = ref 0
-
   let rec find f t = function
     | Empty -> 
 	let r = f t in Type (t,r), r
     | Split (w,yes,no) ->
-	incr steps;
 	if Witness.type_has t w 
 	then let yes,r = find f t yes in Split (w,yes,no), r
 	else let no,r = find f t no in Split (w,yes,no), r
@@ -1332,13 +1329,6 @@ module Cache = struct
 	else
 	  try f2 () with Not_found -> try f1 () with Not_found -> c, rs
 
-  let find f t c =
-    steps := 0;
-(*    Format.fprintf Format.std_formatter "begin find@."; *)
-    let r = find f t c in
-(*    Format.fprintf Format.std_formatter "steps:%i@." !steps; *)
-    r
-
   let emp = Empty
 
 
@@ -1354,6 +1344,7 @@ module Cache = struct
       let c',r = find f t !c in
       c := c';
       r
+
 end