;;
+(* Old Machine
module CallByNameStrategy =
struct
type stack_term = Cic.term
let compute_to_env ~reduce ~unwind k e ens t = unwind k e ens t
end
;;
+*)
+
+module CallByNameStrategy =
+ struct
+ type config = int * env_term list * ens_term Cic.explicit_named_substitution * Cic.term * stack_term list
+ and stack_term = config
+ and env_term = config
+ and ens_term = config
+
+ let to_env c = c
+ let to_ens c = c
+ let from_stack config = config
+ let from_stack_list_for_unwind ~unwind l = List.map unwind l
+ let from_env c = c
+ let from_ens c = c
+ let from_env_for_unwind ~unwind c = unwind c
+ let from_ens_for_unwind ~unwind c = unwind c
+ let stack_to_env ~reduce ~unwind config = 0,[],[],unwind config,[]
+ let compute_to_env ~reduce ~unwind k e ens t = k,e,ens,t,[]
+ let compute_to_stack ~reduce ~unwind config = config
+ end
+;;
module CallByValueStrategy =
struct
module R = Reduction(ClosuresOnStackByValueFromEnvOrEnsStrategy);; OK 58.127s
*)
module R = Reduction(CallByValueByNameForUnwind);;
+(*module R = Reduction(CallByNameStrategy);;*)
(*module R = Reduction(ClosuresOnStackByValueFromEnvOrEnsStrategy);;*)
module U = UriManager;;
(* t1, t2 must be well-typed *)
let are_convertible whd ?(subst=[]) ?(metasenv=[]) =
+ let heuristic = ref true in
let rec aux test_equality_only context t1 t2 ugraph =
let aux2 test_equality_only t1 t2 ugraph =
if b2 then true,ugraph1 else false,ugraph
else
false,ugraph
+ | C.Meta (n1,l1), _ ->
+ (try
+ let _,term,_ = CicUtil.lookup_subst n1 subst in
+ let term' = CicSubstitution.subst_meta l1 term in
+(*
+prerr_endline ("%?: " ^ CicPp.ppterm t1 ^ " <==> " ^ CicPp.ppterm t2);
+prerr_endline ("%%%%%%: " ^ CicPp.ppterm term' ^ " <==> " ^ CicPp.ppterm t2);
+*)
+ aux test_equality_only context term' t2 ugraph
+ with CicUtil.Subst_not_found _ -> false,ugraph)
+ | _, C.Meta (n2,l2) ->
+ (try
+ let _,term,_ = CicUtil.lookup_subst n2 subst in
+ let term' = CicSubstitution.subst_meta l2 term in
+(*
+prerr_endline ("%?: " ^ CicPp.ppterm t1 ^ " <==> " ^ CicPp.ppterm t2);
+prerr_endline ("%%%%%%: " ^ CicPp.ppterm term' ^ " <==> " ^ CicPp.ppterm t1);
+*)
+ aux test_equality_only context t1 term' ugraph
+ with CicUtil.Subst_not_found _ -> false,ugraph)
(* TASSI: CONSTRAINTS *)
| (C.Sort (C.Type t1), C.Sort (C.Type t2)) when test_equality_only ->
true,(CicUniv.add_eq t2 t1 ugraph)
| (_,_) -> false,ugraph
end
in
+ let res =
+ if !heuristic then
+ aux2 test_equality_only t1 t2 ugraph
+ else
+ false,ugraph
+ in
+ if fst res = true then
+ res
+ else
+begin
+(*if !heuristic then prerr_endline ("NON FACILE: " ^ CicPp.ppterm t1 ^ " <===> " ^ CicPp.ppterm t2);*)
+ (* heuristic := false; *)
debug t1 [t2] "PREWHD";
+(*prerr_endline ("PREWHD: " ^ CicPp.ppterm t1 ^ " <===> " ^ CicPp.ppterm t2);*)
let t1' = whd ?delta:(Some true) ?subst:(Some subst) context t1 in
let t2' = whd ?delta:(Some true) ?subst:(Some subst) context t2 in
debug t1' [t2'] "POSTWHD";
+(*prerr_endline ("POSTWH: " ^ CicPp.ppterm t1' ^ " <===> " ^ CicPp.ppterm t2');*)
aux2 test_equality_only t1' t2' ugraph
+end
in
aux false (*c t1 t2 ugraph *)
;;
| Cic.Cast (te,_) -> head_beta_reduce te
| t -> t
-(*Debugging code
+(*
let are_convertible ?subst ?metasenv context t1 t2 ugraph =
let before = Unix.gettimeofday () in
let res = are_convertible ?subst ?metasenv context t1 t2 ugraph in