Improve logging in type.ml, give it indentation and per-statement context.

2 files changed, 25 insertions, 10 deletions

diff --git a/src/boot/fe/ast.ml b/src/boot/fe/ast.ml
index b33db3a7..21726234 100644
--- a/src/boot/fe/ast.ml
+++ b/src/boot/fe/ast.ml
@@ -1346,11 +1346,13 @@ let sprintf_effect = sprintf_fmt fmt_effect;;
 let sprintf_tag = sprintf_fmt fmt_tag;;
 let sprintf_carg = sprintf_fmt fmt_carg;;
 let sprintf_constr = sprintf_fmt fmt_constr;;
-let sprintf_stmt = sprintf_fmt fmt_stmt;;
 let sprintf_mod_items = sprintf_fmt fmt_mod_items;;
 let sprintf_decl_params = sprintf_fmt fmt_decl_params;;
 let sprintf_app_args = sprintf_fmt fmt_app_args;;
 
+(* You probably want this one; stmt has a leading \n *)
+let sprintf_stmt = sprintf_fmt fmt_stmt_body;;
+
 (*
  * Local Variables:
  * fill-column: 78;
diff --git a/src/boot/me/type.ml b/src/boot/me/type.ml
index 69010fdf..6a3ca920 100644
--- a/src/boot/me/type.ml
+++ b/src/boot/me/type.ml
@@ -167,6 +167,9 @@ let rec resolve_tyvar (tv:tyvar) : tyvar =
 ;;
 
 let process_crate (cx:ctxt) (crate:Ast.crate) : unit =
+
+  let depth = ref 0 in
+
   let log cx = Session.log "type"
     cx.ctxt_sess.Session.sess_log_type
     cx.ctxt_sess.Session.sess_log_out
@@ -221,20 +224,27 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit =
         | _ -> ()
 
     and unify_tyvars (auto_deref:bool) (av:tyvar) (bv:tyvar) : unit =
-      let dstr = if auto_deref then " w/ auto-deref" else "" in
-        iflog cx (fun _ ->
-                    log cx "unifying types%s:" dstr;
-                    log cx "input tyvar A: %s" (tyspec_to_str !av);
-                    log cx "input tyvar B: %s" (tyspec_to_str !bv));
+      let indent = String.make (4 * (!depth)) ' ' in
+        iflog cx
+          (fun _ ->
+             log cx "%s> unifying types:" indent;
+             if auto_deref
+             then
+               log cx "%s> (w/ auto-deref)" indent;
+             log cx "%s> input tyvar A:     %s" indent (tyspec_to_str !av);
+             log cx "%s> input tyvar B:     %s" indent (tyspec_to_str !bv));
         check_sane_tyvar av;
         check_sane_tyvar bv;
 
+        incr depth;
         unify_tyvars' auto_deref av bv;
+        decr depth;
 
-        iflog cx (fun _ ->
-                    log cx "unified types%s:" dstr;
-                    log cx "output tyvar A: %s" (tyspec_to_str !av);
-                    log cx "output tyvar B: %s" (tyspec_to_str !bv));
+        iflog cx
+          (fun _ ->
+             log cx "%s< unified types:" indent;
+             log cx "%s< output tyvar A:     %s" indent (tyspec_to_str !av);
+             log cx "%s< output tyvar B:     %s" indent (tyspec_to_str !bv));
         check_sane_tyvar av;
         check_sane_tyvar bv;
 
@@ -1207,6 +1217,9 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit =
 
     let visit_stmt_pre (stmt:Ast.stmt) : unit =
       try
+        log cx "";
+        log cx "typechecking stmt: %a" Ast.sprintf_stmt stmt;
+        log cx "";
         visit_stmt_pre_full stmt;
         (* 
          * Reset any item-parameters that were resolved to types