X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fcic_proof_checking%2FcicReduction.ml;h=5c5db75b4bb88f93ef54640b0952e77067338567;hb=5780119aea0a20e74f7c153add432f5d491ee2a5;hp=311d1880b149a4f9afcfd481e8fd4d123e237a54;hpb=887916a4791bba656b1dec730d3315239d3c1f21;p=helm.git diff --git a/helm/software/components/cic_proof_checking/cicReduction.ml b/helm/software/components/cic_proof_checking/cicReduction.ml index 311d1880b..5c5db75b4 100644 --- a/helm/software/components/cic_proof_checking/cicReduction.ml +++ b/helm/software/components/cic_proof_checking/cicReduction.ml @@ -34,6 +34,37 @@ exception ReferenceToVariable;; exception ReferenceToCurrentProof;; exception ReferenceToInductiveDefinition;; +let ndebug = ref false;; +let indent = ref "";; +let times = ref [];; +let pp s = + if !ndebug then + prerr_endline (Printf.sprintf "%-20s" !indent ^ " " ^ Lazy.force s) +;; +let inside c = + if !ndebug then + begin + let time1 = Unix.gettimeofday () in + indent := !indent ^ String.make 1 c; + times := time1 :: !times; + prerr_endline ("{{{" ^ !indent ^ " ") + end +;; +let outside ok = + if !ndebug then + begin + let time2 = Unix.gettimeofday () in + let time1 = + match !times with time1::tl -> times := tl; time1 | [] -> assert false in + prerr_endline ("}}} " ^ string_of_float (time2 -. time1)); + if not ok then prerr_endline "exception raised!"; + try + indent := String.sub !indent 0 (String.length !indent -1) + with + Invalid_argument _ -> indent := "??"; () + end +;; + let debug = false let profile = false let debug_print s = if debug then prerr_endline (Lazy.force s) @@ -805,6 +836,8 @@ let (===) x y = let are_convertible whd ?(subst=[]) ?(metasenv=[]) = let heuristic = ref true in let rec aux test_equality_only context t1 t2 ugraph = + (*D*)inside 'B'; try let rc = + pp (lazy (CicPp.ppterm t1 ^ " vs " ^ CicPp.ppterm t2)); let rec aux2 test_equality_only t1 t2 ugraph = (* this trivial euristic cuts down the total time of about five times ;-) *) @@ -980,7 +1013,7 @@ prerr_endline ("%%%%%%: " ^ CicPp.ppterm term' ^ " <==> " ^ CicPp.ppterm t1); let b'',ugraph''=aux test_equality_only context outtype1 outtype2 ugraph in if b'' then - let b''',ugraph'''= aux test_equality_only context + let b''',ugraph'''= aux true context term1 term2 ugraph'' in List.fold_right2 (fun x y (b,ugraph) -> @@ -1102,6 +1135,7 @@ in aux2 test_equality_only t1' t2' ugraph *) end + (*D*)in outside true; rc with exc -> outside false; raise exc in aux false (*c t1 t2 ugraph *) ;;