diff --git a/src/boot/fe/ast.ml b/src/boot/fe/ast.ml index b33db3a737a..2172623491b 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 69010fdf7a2..6a3ca920cdd 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