X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=ocaml%2Flambda4.ml;h=9ab675e6b95ab242efc8e138d3c62309a92328e7;hb=bd3a8ee424e495ab4003f6d4cb88579f29e3bc3a;hp=392784f31a982511be17c703d3e38e8d571cbade;hpb=dc829653c03f7bf0977addabe480e7c8b178bad1;p=fireball-separation.git

diff --git a/ocaml/lambda4.ml b/ocaml/lambda4.ml
index 392784f..9ab675e 100644
--- a/ocaml/lambda4.ml
+++ b/ocaml/lambda4.ml
@@ -58,7 +58,7 @@ let first bound p var f =
    with Backtrack s ->
 prerr_endline (">>>>>> BACKTRACK (reason: " ^ s ^") measure=$ ");
      List.iter (fun (r,l) -> r := l) (List.combine p.deltas (List.hd p.trail)) ;
-prerr_endline("Now trying var="^string_of_var p.var_names var^" i="^string_of_int i);
+prerr_endline("Now trying var="^string_of_var p.var_names var^" i="^string_of_int (i+1));
      aux (i+1)
  in
   aux 1
@@ -368,22 +368,22 @@ let rec edible ({div; conv; ps} as p) arities showstoppers =
            aux showstoppers xs
           with
            Dangerous ->
-            aux (sort_uniq (h::showstoppers)) ps
-  in
-    let showstoppers = sort_uniq (aux showstoppers ps) in
-    let dangerous_conv =
-     List.map (dangerous_conv p arities showstoppers) (conv :> nf_nob list) in
+            aux (sort_uniq (h::showstoppers)) ps in
+
+ let showstoppers = sort_uniq (aux showstoppers ps) in
+ let dangerous_conv =
+  List.map (dangerous_conv p arities showstoppers) (conv :> nf_nob list) in
 
 prerr_endline ("dangerous_conv lenght:" ^ string_of_int (List.length dangerous_conv));
 List.iter (fun l -> prerr_endline (String.concat " " (List.map (string_of_var p.var_names) l))) dangerous_conv;
 
-    let showstoppers' = showstoppers @ List.concat dangerous_conv in
-    let showstoppers' = sort_uniq (match div with
-     | None -> showstoppers'
-     | Some div ->
-       if List.exists ((=) (hd_of_i_var div)) showstoppers'
-       then showstoppers' @ free_vars (div :> nf) else showstoppers') in
-    if showstoppers <> showstoppers' then edible p arities showstoppers' else showstoppers', dangerous_conv
+ let showstoppers' = showstoppers @ List.concat dangerous_conv in
+ let showstoppers' = sort_uniq (match div with
+  | None -> showstoppers'
+  | Some div ->
+    if List.exists ((=) (hd_of_i_var div)) showstoppers'
+    then showstoppers' @ free_vars (div :> nf) else showstoppers') in
+ if showstoppers <> showstoppers' then edible p arities showstoppers' else showstoppers', dangerous_conv
 ;;
 
 let precompute_edible_data {ps; div} xs =
@@ -397,6 +397,11 @@ let precompute_edible_data {ps; div} xs =
    ) xs)
 ;;
 
+(** Returns (p, showstoppers_step, showstoppers_eat) where:
+    - showstoppers_step are the heads occurring twice
+      in the same discriminating set
+    - showstoppers_eat are the heads in ps having different number
+      of arguments *)
 let critical_showstoppers p =
   let p = super_simplify p in
   let hd_of_div = match p.div with None -> [] | Some t -> [hd_of_i_var t] in
@@ -426,8 +431,8 @@ let critical_showstoppers p =
   let showstoppers_eat = List.filter
     (fun x -> not (List.mem x showstoppers_step))
     showstoppers_eat in
-  List.iter (fun v -> prerr_endline ("DANGEROUS STEP: " ^ (string_of_var p.var_names) v)) showstoppers_step;
-  List.iter (fun v -> prerr_endline ("DANGEROUS EAT: " ^ (string_of_var p.var_names) v)) showstoppers_eat;
+List.iter (fun v -> prerr_endline ("DANGEROUS STEP: " ^ (string_of_var p.var_names) v)) showstoppers_step;
+List.iter (fun v -> prerr_endline ("DANGEROUS EAT: " ^ (string_of_var p.var_names) v)) showstoppers_eat;
   p, showstoppers_step, showstoppers_eat
   ;;
 
@@ -442,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
@@ -511,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 *)
@@ -540,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) *)
@@ -563,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 =
@@ -597,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 =