From fb2fabf6c94d6a2f930b7a84673c90af32c48803 Mon Sep 17 00:00:00 2001
From: Claudio Sacerdoti Coen <claudio.sacerdoticoen@unibo.it>
Date: Fri, 30 Oct 2009 10:21:00 +0000
Subject: [PATCH] New style debugging/profiling for NCicMetaSubst.

---
 .../components/ng_refiner/nCicMetaSubst.ml    | 48 +++++++++++++++----
 .../components/ng_refiner/nCicMetaSubst.mli   |  2 +
 helm/software/matita/matita.ml                |  4 +-
 3 files changed, 44 insertions(+), 10 deletions(-)

diff --git a/helm/software/components/ng_refiner/nCicMetaSubst.ml b/helm/software/components/ng_refiner/nCicMetaSubst.ml
index 6deaaf572..b69984f3d 100644
--- a/helm/software/components/ng_refiner/nCicMetaSubst.ml
+++ b/helm/software/components/ng_refiner/nCicMetaSubst.ml
@@ -11,6 +11,39 @@
 
 (* $Id$ *)
 
+let debug = ref false;;
+let indent = ref "";;
+let times = ref [];;
+let pp s =
+ if !debug then
+  prerr_endline (Printf.sprintf "%-20s" !indent ^ " " ^ Lazy.force s)
+;;
+let inside c =
+ if !debug then
+  begin
+   let time1 = Unix.gettimeofday () in
+   indent := !indent ^ String.make 1 c;
+   times := time1 :: !times;
+   prerr_endline ("{{{" ^ !indent ^ " ")
+  end
+;;
+let outside exc_opt =
+ if !debug 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));
+   (match exc_opt with
+   | Some e ->  prerr_endline ("exception raised: " ^ Printexc.to_string e)
+   | None -> ());
+   try
+    indent := String.sub !indent 0 (String.length !indent -1)
+   with
+    Invalid_argument _ -> indent := "??"; ()
+  end
+;;
+
 exception MetaSubstFailure of string Lazy.t
 exception Uncertain of string Lazy.t
 
@@ -255,6 +288,7 @@ exception Found;;
    otherwise the occur check does not make sense in case of unification
    of ?n with ?n *)
 let delift ~unify metasenv subst context n l t =
+  (*D*)  inside 'D'; try let rc =  
   let is_in_scope_meta subst = function
     | NCic.Meta (i,_) ->
         (try 
@@ -407,15 +441,12 @@ let delift ~unify metasenv subst context n l t =
                         | NotInTheList | MetaSubstFailure _ -> ms, j::tbr, tl
                   in
                   let (metasenv, subst), to_be_r, lc1' = deliftl [] 1 ms lc1 in
-(*
-                  prerr_endline ("TO BE RESTRICTED: " ^ 
-                   (String.concat "," (List.map string_of_int to_be_r)));
-*)
+                  pp (lazy ("TO BE RESTRICTED: " ^ 
+                   (String.concat "," (List.map string_of_int to_be_r))));
                   let l1 = pack_lc (0, NCic.Ctx lc1') in
-(*
-                  prerr_endline ("newmeta:" ^ NCicPp.ppterm
-                   ~metasenv ~subst ~context (NCic.Meta (999,l1)));
-*)
+                  pp (lazy ("newmeta:" ^ NCicPp.ppterm
+                   ~metasenv ~subst ~context (NCic.Meta (999,l1))));
+                  pp (lazy (NCicPp.ppmetasenv ~subst metasenv));
                   if to_be_r = [] then
                     (metasenv, subst), 
                     (if lc1' = lc1 then orig else NCic.Meta (i,l1))
@@ -459,6 +490,7 @@ let delift ~unify metasenv subst context n l t =
         raise (Uncertain msg)
        else
         raise (MetaSubstFailure msg)
+ (*D*)  in outside None; rc with exn -> outside (Some exn); raise exn 
 ;;
 
 let mk_meta ?(attrs=[]) metasenv context ?with_type kind = 
diff --git a/helm/software/components/ng_refiner/nCicMetaSubst.mli b/helm/software/components/ng_refiner/nCicMetaSubst.mli
index 0cedc5258..94a77f287 100644
--- a/helm/software/components/ng_refiner/nCicMetaSubst.mli
+++ b/helm/software/components/ng_refiner/nCicMetaSubst.mli
@@ -14,6 +14,8 @@
 exception MetaSubstFailure of string Lazy.t
 exception Uncertain of string Lazy.t
 
+val debug: bool ref
+
 (* the index of the last created meta *)
 val maxmeta: unit -> int
 
diff --git a/helm/software/matita/matita.ml b/helm/software/matita/matita.ml
index 9699bdaa2..4fdc704e2 100644
--- a/helm/software/matita/matita.ml
+++ b/helm/software/matita/matita.ml
@@ -213,9 +213,9 @@ let _ =
       (fun mi () -> NTacStatus.debug := mi#active);
     addDebugCheckbox "auto logging"
       (fun mi () -> NAuto.debug := mi#active);
-    addDebugCheckbox "disambiguation/refiner/unification logging"
+    addDebugCheckbox "disambiguation/refiner/unification/metasubst logging"
       (fun mi () -> NCicRefiner.debug := mi#active; NCicUnification.debug :=
-              mi#active; MultiPassDisambiguator.debug := mi#active);
+              mi#active; MultiPassDisambiguator.debug := mi#active; NCicMetaSubst.debug := mi#active);
     addDebugCheckbox "reduction logging"
       (fun mi () -> NCicReduction.debug := mi#active; CicReduction.ndebug := mi#active);
     addDebugSeparator ();
-- 
2.39.2