From 4168c1dcdaf4cdde860633ea95e0d92d8e116128 Mon Sep 17 00:00:00 2001
From: Graydon Hoare <graydon@mozilla.com>
Date: Tue, 5 Oct 2010 18:10:33 -0700
Subject: [PATCH] Add -lpasses for logging just the progress of passes.

---
 src/boot/driver/main.ml    |  3 +++
 src/boot/driver/session.ml |  1 +
 src/boot/me/semant.ml      | 25 ++++++++++++++++++++++++-
 3 files changed, 28 insertions(+), 1 deletion(-)

diff --git a/src/boot/driver/main.ml b/src/boot/driver/main.ml
index b46963b28ad..3c37a03250a 100644
--- a/src/boot/driver/main.ml
+++ b/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)
diff --git a/src/boot/driver/session.ml b/src/boot/driver/session.ml
index 06fcacb2fda..ae16c1395bc 100644
--- a/src/boot/driver/session.ml
+++ b/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;
diff --git a/src/boot/me/semant.ml b/src/boot/me/semant.ml
index 27524573379..d692f334a0c 100644
--- a/src/boot/me/semant.ml
+++ b/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