From: Claudio Sacerdoti Coen <claudio.sacerdoticoen@unibo.it>
Date: Wed, 28 Oct 2009 15:38:20 +0000 (+0000)
Subject: 1) new-style debugging/profiling code for old reduction
X-Git-Tag: make_still_working~3236
X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=commitdiff_plain;h=440dece50deaf24f3e5216cf14cac5eca00fda85;p=helm.git

1) new-style debugging/profiling code for old reduction
2) aliases are now dumped to stderr
---

diff --git a/helm/software/components/cic_proof_checking/cicReduction.ml b/helm/software/components/cic_proof_checking/cicReduction.ml
index 6e3436085..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 ;-) *)
@@ -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 *)
 ;;
diff --git a/helm/software/components/cic_proof_checking/cicReduction.mli b/helm/software/components/cic_proof_checking/cicReduction.mli
index 82be7fd3f..fd98c4c0b 100644
--- a/helm/software/components/cic_proof_checking/cicReduction.mli
+++ b/helm/software/components/cic_proof_checking/cicReduction.mli
@@ -28,6 +28,7 @@ exception ReferenceToConstant
 exception ReferenceToVariable
 exception ReferenceToCurrentProof
 exception ReferenceToInductiveDefinition
+val ndebug : bool ref
 val fdebug : int ref
 val whd : 
   ?delta:bool -> ?subst:Cic.substitution -> Cic.context -> Cic.term -> Cic.term
diff --git a/helm/software/matita/matita.ml b/helm/software/matita/matita.ml
index dfb4e8ebd..9699bdaa2 100644
--- a/helm/software/matita/matita.ml
+++ b/helm/software/matita/matita.ml
@@ -150,7 +150,7 @@ let _ =
     in
     addDebugItem "dump aliases" (fun _ ->
       let status = script#grafite_status in
-      LexiconEngine.dump_aliases HLog.debug "" status);
+      LexiconEngine.dump_aliases prerr_endline "" status);
 (* FG: DEBUGGING   
     addDebugItem "dump interpretations" (fun _ ->
       let status = script#lexicon_status in
@@ -217,7 +217,7 @@ let _ =
       (fun mi () -> NCicRefiner.debug := mi#active; NCicUnification.debug :=
               mi#active; MultiPassDisambiguator.debug := mi#active);
     addDebugCheckbox "reduction logging"
-      (fun mi () -> NCicReduction.debug := mi#active);
+      (fun mi () -> NCicReduction.debug := mi#active; CicReduction.ndebug := mi#active);
     addDebugSeparator ();
     addDebugItem "Expand virtuals"
     (fun _ -> (MatitaScript.current ())#expandAllVirtuals);