Change to compute_special_k

Now the special_k taked into account the number or arguments (arity) of
terms. This solves problem "low special_k" in problems/w

diff --git a/ocaml/lambda4.ml b/ocaml/lambda4.ml
index 48262639dfbda9ea48b1d6dcf5ef384af93d39d8..9ab675e6b95ab242efc8e138d3c62309a92328e7 100644 (file)
--- a/ocaml/lambda4.ml
+++ b/ocaml/lambda4.ml
@@ -447,7 +447,7 @@ let eat p =
   List.fold_left (fun p (pos,hd,nargs) -> if pos = -1 then p else
    let v = `N pos in
    let inst = make_lams v nargs in
-prerr_endline ("# INST_IN_EAT: " ^ string_of_var p.var_names hd ^ " := " ^ string_of_term p inst);
+prerr_endline ("# [INST_IN_EAT] eating: " ^ string_of_var p.var_names hd ^ " := " ^ string_of_term p inst);
    { p with sigma = p.sigma @ [hd,inst] }
    ) p l in
   (* to avoid applied numbers in safe positions that
@@ -516,8 +516,8 @@ let safe_arity_of_var p x =
  List.fold_left (fun acc t -> Pervasives.min acc (aux t)) max_int tms
 ;;
 
-let instantiate p x perm n =
- let n = (prerr_endline "WARNING: using constant initialSpecialK"); p.initialSpecialK in
+let instantiate p x perm =
+ let n = (prerr_endline ("WARNING: using constant initialSpecialK=" ^ string_of_int p.initialSpecialK)); p.initialSpecialK in
  let arities = Array.to_list (Array.make (n+1) min_int) in
  let p,vars = make_fresh_vars p arities in
  (* manual lifting of vars by perm in next line *)
@@ -545,15 +545,28 @@ let compute_special_k tms =
  | `Bottom
  | `Pacman
  | `Var _ -> 0
- ) in Listx.max (Listx.map (aux 0) tms)
+ ) in
+ let rec aux' top t = match t with
+ | `Lam(_,t) -> aux' false t
+ | `I((_,ar), tms) -> max ar
+     (Listx.max (Listx.map (aux' false) (tms :> nf Listx.listx)))
+ | `Match(t, _, liftno, bs, args) ->
+     List.fold_left max 0 (List.map (aux' false) ((t :> nf)::(args :> nf list)@List.map snd !bs))
+ | `N _
+ | `Bottom
+ | `Pacman
+ | `Var _ -> 0 in
+ Listx.max (Listx.map (fun t -> max (aux 0 t) (aux' true t)) tms)
 ;;
 
-let choose_step (n,p) =
+let choose_step p =
  let p, showstoppers_step, showstoppers_eat = critical_showstoppers p in
  let x =
   match showstoppers_step, showstoppers_eat with
   | [], y::_ ->
-     prerr_endline ("INSTANTIATING CRITICAL TO EAT " ^ string_of_var p.var_names y); y
+     prerr_endline ("INSTANTIATING (critical eat) : " ^ string_of_var p.var_names y); y
+  | x::_, _ ->
+     prerr_endline ("INSTANTIATING (critical step): " ^ string_of_var p.var_names x); x
   | [], [] ->
      let heads =
       (* Choose only variables still alive (with arity > 0) *)
@@ -568,10 +581,7 @@ let choose_step (n,p) =
            Not_found -> assert false)
       | x::_ ->
          prerr_endline ("INSTANTIATING TO EAT " ^ string_of_var p.var_names x);
-         x)
-  | x::_, _ ->
-      prerr_endline ("INSTANTIATING " ^ string_of_var p.var_names x);
-      x in
+         x) in
 (* Strategy that  decreases the special_k to 0 first (round robin)
 1:11m42 2:14m5 3:11m16s 4:14m46s 5:12m7s 6:6m31s *)
  let x =
@@ -602,81 +612,39 @@ let x =
  with
   Not_found -> x
 in*)
- let special_k =
-     compute_special_k (Listx.from_list (all_terms p :> nf list) )in
- if special_k < n then
-  prerr_endline ("@@@@ NEW INSTANTIATE PHASE (" ^ string_of_int special_k ^ ") @@@@");
  let arity_of_x = Util.option_get (max_arity_tms x (all_terms p)) in
  let safe_arity_of_x = safe_arity_of_var p x in
- x, min arity_of_x safe_arity_of_x, special_k
+ x, min arity_of_x safe_arity_of_x
+;;
 
-let rec auto_eat (n,p) =
+let rec auto_eat p =
  prerr_endline "{{{{{{{{ Computing measure before auto_instantiate }}}}}}";
  let m = problem_measure p in
- let x, arity_of, n = choose_step (n,p) in
+ let x, arity_of = choose_step p in
  first arity_of p x (fun p j ->
-  let p' = instantiate p x j n in
+  let p' = instantiate p x j in
   match eat p' with
   | `Finished p -> p
   | `Continue p ->
       prerr_endline "{{{{{{{{ Computing measure inafter auto_instantiate }}}}}}";
       let delta = problem_measure p - m in
-      (* let delta = m - problem_measure p' in *)
       if delta >= 0
        then
         (failwith
         ("Measure did not decrease (+=" ^ string_of_int delta ^ ")"))
-       else prerr_endline ("$ Measure decreased of " ^ string_of_int delta);
-      auto_eat (n,p))
+       else prerr_endline ("$ Measure decreased: " ^ string_of_int delta);
+      auto_eat p)
 ;;
 
 let auto p n =
- prerr_endline ("@@@@ FIRST INSTANTIATE PHASE (" ^ string_of_int n ^ ") @@@@");
+prerr_endline ("@@@@ FIRST INSTANTIATE PHASE (" ^ string_of_int n ^ ") @@@@");
  match eat p with
  | `Finished p -> p
- | `Continue p -> auto_eat (n,p)
+ | `Continue p -> auto_eat p
 ;;
 
-(*
-0 = snd
-
-      x y = y 0    a y = k  k z = z 0  c y = k   y u = u h1 h2 0          h2 a = h3
-1 x a c    1 a 0 c  1 k c    1 c 0      1 k        1 k                     1 k
-2 x a y    2 a 0 y  2 k y    2 y 0      2 y 0      2 h2 0                  2 h3
-3 x b y    3 b 0 y  3 b 0 y  3 b 0 y    3 b 0 y    3 b 0 (\u. u h1 h2 0)   3 b 0 (\u. u h1 (\w.h3) 0)
-4 x b c    4 b 0 c  4 b 0 c  4 b 0 c    4 b 0 c    4 b 0 c                 4 b 0 c
-5 x (b e)  5 b e 0  5 b e 0  5 b e 0    5 b e 0    5 b e 0                 5 b e 0
-6 y y      6 y y    6 y y    6 y y      6 y y      6 h1 h1 h2 0 h2 0       6 h1 h1 (\w. h3) 0 (\w. h3) 0
-
-                                l2 _ = l3
-b u = u l1 l2 0                 e _ _ _ _ = f                         l3 n = n j 0
-1 k                             1 k                                  1 k
-2 h3                            2 h3                                 2 h3
-3 l2 0 (\u. u h1 (\w. h3) 0)    3 l3 (\u. u h1 (\w. h3) 0)           3 j h1 (\w. h3) 0 0
-4 l2 0 c                        4 l3 c                               4 c j 0
-5 e l1 l2 0 0                   5 f                                  5 f
-6 h1 h1 (\w. h3) 0 (\w. h3) 0   6 h1 h1 (\w. h3) 0 (\w. h3) 0        6 h1 h1 (\w. h3) 0 (\w. h3) 0
-*)
-
-(*
-                x n = n 0 ?
-x a (b (a c))   a 0 = 1 ? (b (a c))   8
-x a (b d')      a 0 = 1 ? (b d')      7
-x b (a c)       b 0 = 1 ? (a c)       4
-x b (a c')      b 0 = 1 ? (a c')      5
-
-c = 2
-c' = 3
-a 2 = 4  (* a c *)
-a 3 = 5  (* a c' *)
-d' = 6
-b 6 = 7  (* b d' *)
-b 4 = 8  (* b (a c) *)
-b 0 = 1
-a 0 = 1
-*)
 
-(************** Tests ************************)
+(******************************************************************************)
 
 let optimize_numerals p =
   let replace_in_sigma perm =