Add -lpasses for logging just the progress of passes.

Author: graydon

src/boot/driver/main.ml

@@ -32,6 +32,7 @@ let (sess:Session.sess) =
     Session.sess_log_lex = false;
     Session.sess_log_parse = false;
     Session.sess_log_ast = false;
+    Session.sess_log_passes = false;
     Session.sess_log_resolve = false;
     Session.sess_log_type = false;
     Session.sess_log_simplify = false;
@@ -162,6 +163,8 @@ let argspecs =
        "-lparse"    "log parsing");
     (flag (fun _ -> sess.Session.sess_log_ast <- true)
        "-last"      "log AST");
+    (flag (fun _ -> sess.Session.sess_log_passes <- true)
+       "-lpasses"  "log passes at high-level");
     (flag (fun _ -> sess.Session.sess_log_resolve <- true)
        "-lresolve"  "log resolution");
     (flag (fun _ -> sess.Session.sess_log_type <- true)

src/boot/driver/session.ml

@@ -18,6 +18,7 @@ type sess =
   mutable sess_log_lex: bool;
   mutable sess_log_parse: bool;
   mutable sess_log_ast: bool;
+  mutable sess_log_passes: bool;
   mutable sess_log_resolve: bool;
   mutable sess_log_type: bool;
   mutable sess_log_simplify: bool;

src/boot/me/semant.ml

@@ -1719,24 +1719,44 @@ let mod_item_logging_visitor
     : Walk.
 visitor =
   let entering _ =
+    if cx.ctxt_sess.Session.sess_log_passes
+    then
+      Session.log "pass" true cx.ctxt_sess.Session.sess_log_out
+        "pass %d: entering %a"
+        pass Ast.sprintf_name (path_to_name path);
     if log_flag
     then
       log cx "pass %d: entering %a"
         pass Ast.sprintf_name (path_to_name path)
   in
   let entered _ =
+    if cx.ctxt_sess.Session.sess_log_passes
+    then
+      Session.log "pass" true cx.ctxt_sess.Session.sess_log_out
+        "pass %d: entered %a"
+        pass Ast.sprintf_name (path_to_name path);
     if log_flag
     then
       log cx "pass %d: entered %a"
         pass Ast.sprintf_name (path_to_name path)
   in
   let leaving _ =
+    if cx.ctxt_sess.Session.sess_log_passes
+    then
+      Session.log "pass" true cx.ctxt_sess.Session.sess_log_out
+        "pass %d: leaving %a"
+        pass Ast.sprintf_name (path_to_name path);
     if log_flag
     then
       log cx "pass %d: leaving %a"
         pass Ast.sprintf_name (path_to_name path)
   in
   let left _ =
+    if cx.ctxt_sess.Session.sess_log_passes
+    then
+      Session.log "pass" true cx.ctxt_sess.Session.sess_log_out
+        "pass %d: left %a"
+        pass Ast.sprintf_name (path_to_name path);
     if log_flag
     then
       log cx "pass %d: left %a"
@@ -2031,7 +2051,10 @@ let run_passes
     (crate:Ast.crate)
     : unit =
   let do_pass i pass =
-      Walk.walk_crate
+    if cx.ctxt_sess.Session.sess_log_passes
+    then Session.log "pass" true cx.ctxt_sess.Session.sess_log_out
+      "starting pass %s # %d" name i;
+    Walk.walk_crate
         (Walk.path_managing_visitor path
            (mod_item_logging_visitor cx log_flag log i path pass))
         crate