Add -lpath mechanism for logging only a subset of a pass (by module-path prefix)

15 files changed, 142 insertions, 103 deletions

diff --git a/src/boot/driver/main.ml b/src/boot/driver/main.ml
index eacecc2d..0024f2fd 100644
--- a/src/boot/driver/main.ml
+++ b/src/boot/driver/main.ml
@@ -51,6 +51,7 @@ let (sess:Session.sess) =
     Session.sess_log_asm = false;
     Session.sess_log_obj = false;
     Session.sess_log_lib = false;
+    Session.sess_log_path = None;
     Session.sess_log_out = stdout;
     Session.sess_log_err = stderr;
     Session.sess_trace_block = false;
@@ -199,6 +200,10 @@ let argspecs =
     (flag (fun _ -> sess.Session.sess_log_lib <- true)
        "-llib"        "log library search");
 
+    ("-lpath", Arg.String
+       (fun s -> sess.Session.sess_log_path <- Some (split_string '.' s)),
+     "module path to restrict logging to");
+
     (flag (fun _ -> sess.Session.sess_trace_block <- true)
        "-tblock"      "emit block-boundary tracing code");
     (flag (fun _ -> sess.Session.sess_trace_drop <- true)
diff --git a/src/boot/driver/session.ml b/src/boot/driver/session.ml
index 8d7c3319..d9317a6c 100644
--- a/src/boot/driver/session.ml
+++ b/src/boot/driver/session.ml
@@ -37,6 +37,7 @@ type sess =
   mutable sess_log_asm: bool;
   mutable sess_log_obj: bool;
   mutable sess_log_lib: bool;
+  mutable sess_log_path: (string list) option;
   mutable sess_log_out: out_channel;
   mutable sess_log_err: out_channel;
   mutable sess_trace_block: bool;
diff --git a/src/boot/me/alias.ml b/src/boot/me/alias.ml
index 27575324..e109f82b 100644
--- a/src/boot/me/alias.ml
+++ b/src/boot/me/alias.ml
@@ -2,7 +2,7 @@ open Semant;;
 open Common;;
 
 let log cx = Session.log "alias"
-  cx.ctxt_sess.Session.sess_log_alias
+  (should_log cx cx.ctxt_sess.Session.sess_log_alias)
   cx.ctxt_sess.Session.sess_log_out
 ;;
 
@@ -110,14 +110,13 @@ let process_crate
     (cx:ctxt)
     (crate:Ast.crate)
     : unit =
-  let path = Stack.create () in
   let passes =
     [|
       (alias_analysis_visitor cx
          Walk.empty_visitor);
     |]
   in
-    run_passes cx "alias" path passes
+    run_passes cx "alias" passes
       cx.ctxt_sess.Session.sess_log_alias log crate
 ;;
 
diff --git a/src/boot/me/dead.ml b/src/boot/me/dead.ml
index a0b666b3..29a8d86b 100644
--- a/src/boot/me/dead.ml
+++ b/src/boot/me/dead.ml
@@ -7,7 +7,7 @@ open Semant;;
 open Common;;
 
 let log cx = Session.log "dead"
-  cx.ctxt_sess.Session.sess_log_dead
+  (should_log cx cx.ctxt_sess.Session.sess_log_dead)
   cx.ctxt_sess.Session.sess_log_out
 ;;
 
@@ -99,7 +99,6 @@ let process_crate
     (cx:ctxt)
     (crate:Ast.crate)
     : unit =
-  let path = Stack.create () in
   let passes =
     [|
       (dead_code_visitor cx
@@ -107,7 +106,7 @@ let process_crate
     |]
   in
 
-    run_passes cx "dead" path passes
+    run_passes cx "dead" passes
       cx.ctxt_sess.Session.sess_log_dead log crate;
     ()
 ;;
diff --git a/src/boot/me/dwarf.ml b/src/boot/me/dwarf.ml
index c1bde8f1..e8b3a3a9 100644
--- a/src/boot/me/dwarf.ml
+++ b/src/boot/me/dwarf.ml
@@ -66,7 +66,7 @@ open Common;;
 open Asm;;
 
 let log cx = Session.log "dwarf"
-  cx.ctxt_sess.Session.sess_log_dwarf
+  (should_log cx cx.ctxt_sess.Session.sess_log_dwarf)
   cx.ctxt_sess.Session.sess_log_out
 ;;
 
@@ -1425,7 +1425,6 @@ let prepend lref x = lref := x :: (!lref)
 let dwarf_visitor
     (cx:ctxt)
     (inner:Walk.visitor)
-    (path:Ast.name_component Stack.t)
     (cu_info_section_fixup:fixup)
     (cu_aranges:(frag list) ref)
     (cu_pubnames:(frag list) ref)
@@ -1454,7 +1453,9 @@ let dwarf_visitor
       | Il.Bits64 -> TY_i64
   in
 
-  let path_name _ = Fmt.fmt_to_str Ast.fmt_name (path_to_name path) in
+  let path_name _ =
+    Fmt.fmt_to_str Ast.fmt_name (path_to_name cx.ctxt_curr_path)
+  in
 
   let (abbrev_table:(abbrev, int) Hashtbl.t) = Hashtbl.create 0 in
 
@@ -2485,12 +2486,10 @@ let process_crate
   let cu_lines = ref [] in
   let cu_frames = ref [] in
 
-  let path = Stack.create () in
-
   let passes =
     [|
       unreferenced_required_item_ignoring_visitor cx
-        (dwarf_visitor cx Walk.empty_visitor path
+        (dwarf_visitor cx Walk.empty_visitor
            cx.ctxt_debug_info_fixup
            cu_aranges cu_pubnames
            cu_infos cu_abbrevs
@@ -2499,7 +2498,7 @@ let process_crate
   in
 
     log cx "emitting DWARF records";
-    run_passes cx "dwarf" path passes
+    run_passes cx "dwarf" passes
       cx.ctxt_sess.Session.sess_log_dwarf log crate;
 
     (* Terminate the tables. *)
diff --git a/src/boot/me/effect.ml b/src/boot/me/effect.ml
index d6cfefb8..8a8292d9 100644
--- a/src/boot/me/effect.ml
+++ b/src/boot/me/effect.ml
@@ -2,12 +2,12 @@ open Semant;;
 open Common;;
 
 let log cx = Session.log "effect"
-  cx.ctxt_sess.Session.sess_log_effect
+  (should_log cx cx.ctxt_sess.Session.sess_log_effect)
   cx.ctxt_sess.Session.sess_log_out
 ;;
 
 let iflog cx thunk =
-  if cx.ctxt_sess.Session.sess_log_effect
+  if (should_log cx cx.ctxt_sess.Session.sess_log_effect)
   then thunk ()
   else ()
 ;;
@@ -315,7 +315,6 @@ let process_crate
     (cx:ctxt)
     (crate:Ast.crate)
     : unit =
-  let path = Stack.create () in
   let item_auth = Hashtbl.create 0 in
   let item_effect = Hashtbl.create 0 in
   let passes =
@@ -340,7 +339,7 @@ let process_crate
           else err (Some id) "auth clause in crate refers to non-item"
   in
     Hashtbl.iter auth_effect crate.node.Ast.crate_auth;
-    run_passes cx "effect" path passes
+    run_passes cx "effect" passes
       cx.ctxt_sess.Session.sess_log_effect log crate
 ;;
 
diff --git a/src/boot/me/layout.ml b/src/boot/me/layout.ml
index 0b994145..870e7a51 100644
--- a/src/boot/me/layout.ml
+++ b/src/boot/me/layout.ml
@@ -2,7 +2,7 @@ open Semant;;
 open Common;;
 
 let log cx = Session.log "layout"
-  cx.ctxt_sess.Session.sess_log_layout
+  (should_log cx cx.ctxt_sess.Session.sess_log_layout)
   cx.ctxt_sess.Session.sess_log_out
 ;;
 
@@ -128,7 +128,7 @@ let layout_visitor
   in
 
   let iflog thunk =
-    if cx.ctxt_sess.Session.sess_log_layout
+    if (should_log cx cx.ctxt_sess.Session.sess_log_layout)
     then thunk ()
     else ()
   in
@@ -453,14 +453,13 @@ let process_crate
     (cx:ctxt)
     (crate:Ast.crate)
     : unit =
-  let path = Stack.create () in
   let passes =
     [|
       (layout_visitor cx
          Walk.empty_visitor)
     |];
   in
-    run_passes cx "layout" path passes
+    run_passes cx "layout" passes
       cx.ctxt_sess.Session.sess_log_layout log crate
 ;;
 
diff --git a/src/boot/me/loop.ml b/src/boot/me/loop.ml
index b5548e2c..478ae6f9 100644
--- a/src/boot/me/loop.ml
+++ b/src/boot/me/loop.ml
@@ -6,7 +6,7 @@ open Semant;;
 open Common;;
 
 let log cx = Session.log "loop"
-  cx.ctxt_sess.Session.sess_log_loop
+  (should_log cx cx.ctxt_sess.Session.sess_log_loop)
   cx.ctxt_sess.Session.sess_log_out
 ;;
 
@@ -142,7 +142,6 @@ let process_crate
     (cx:ctxt)
     (crate:Ast.crate)
     : unit =
-  let path = Stack.create () in
   let passes =
     [|
       (loop_depth_visitor cx
@@ -150,7 +149,7 @@ let process_crate
     |]
   in
 
-    run_passes cx "loop" path passes
+    run_passes cx "loop" passes
       cx.ctxt_sess.Session.sess_log_loop log crate
 ;;
 
diff --git a/src/boot/me/resolve.ml b/src/boot/me/resolve.ml
index b5d7d65f..118e5b49 100644
--- a/src/boot/me/resolve.ml
+++ b/src/boot/me/resolve.ml
@@ -16,12 +16,12 @@ open Common;;
 
 
 let log cx = Session.log "resolve"
-  cx.ctxt_sess.Session.sess_log_resolve
+  (should_log cx cx.ctxt_sess.Session.sess_log_resolve)
   cx.ctxt_sess.Session.sess_log_out
 ;;
 
 let iflog cx thunk =
-  if cx.ctxt_sess.Session.sess_log_resolve
+  if (should_log cx cx.ctxt_sess.Session.sess_log_resolve)
   then thunk ()
   else ()
 ;;
@@ -139,7 +139,6 @@ let stmt_collecting_visitor
 
 let all_item_collecting_visitor
     (cx:ctxt)
-    (path:Ast.name_component Stack.t)
     (inner:Walk.visitor)
     : Walk.visitor =
 
@@ -169,7 +168,7 @@ let all_item_collecting_visitor
     Array.iter (fun p -> htab_put cx.ctxt_all_defns p.id
                   (DEFN_ty_param p.node)) p;
     htab_put cx.ctxt_all_defns i.id (DEFN_item i.node);
-    htab_put cx.ctxt_all_item_names i.id (path_to_name path);
+    htab_put cx.ctxt_all_item_names i.id (path_to_name cx.ctxt_curr_path);
     log cx "collected item #%d: %s" (int_of_node i.id) n;
     begin
       match i.node.Ast.decl_item with
@@ -191,14 +190,14 @@ let all_item_collecting_visitor
 
   let visit_obj_fn_pre obj ident fn =
     htab_put cx.ctxt_all_defns fn.id (DEFN_obj_fn (obj.id, fn.node));
-    htab_put cx.ctxt_all_item_names fn.id (path_to_name path);
+    htab_put cx.ctxt_all_item_names fn.id (path_to_name cx.ctxt_curr_path);
     note_header fn.id fn.node.Ast.fn_input_slots;
     inner.Walk.visit_obj_fn_pre obj ident fn
   in
 
   let visit_obj_drop_pre obj b =
     htab_put cx.ctxt_all_defns b.id (DEFN_obj_drop obj.id);
-    htab_put cx.ctxt_all_item_names b.id (path_to_name path);
+    htab_put cx.ctxt_all_item_names b.id (path_to_name cx.ctxt_curr_path);
     inner.Walk.visit_obj_drop_pre obj b
   in
 
@@ -210,7 +209,7 @@ let all_item_collecting_visitor
               htab_put cx.ctxt_all_defns id
                 (DEFN_loop_body (Stack.top items));
               htab_put cx.ctxt_all_item_names id
-                (path_to_name path);
+                (path_to_name cx.ctxt_curr_path);
         | _ -> ()
     end;
     inner.Walk.visit_stmt_pre s;
@@ -822,13 +821,12 @@ let process_crate
     (crate:Ast.crate)
     : unit =
   let (scopes:(scope list) ref) = ref [] in
-  let path = Stack.create () in
 
   let passes_0 =
     [|
       (block_scope_forming_visitor cx Walk.empty_visitor);
       (stmt_collecting_visitor cx
-         (all_item_collecting_visitor cx path
+         (all_item_collecting_visitor cx
             Walk.empty_visitor));
     |]
   in
@@ -852,11 +850,11 @@ let process_crate
   in
   let log_flag = cx.ctxt_sess.Session.sess_log_resolve in
     log cx "running primary resolve passes";
-    run_passes cx "resolve collect" path passes_0 log_flag log crate;
+    run_passes cx "resolve collect" passes_0 log_flag log crate;
     log cx "running secondary resolve passes";
-    run_passes cx "resolve bind" path passes_1 log_flag log crate;
+    run_passes cx "resolve bind" passes_1 log_flag log crate;
     log cx "running tertiary resolve passes";
-    run_passes cx "resolve patterns" path passes_2 log_flag log crate;
+    run_passes cx "resolve patterns" passes_2 log_flag log crate;
 
     iflog cx
       begin
diff --git a/src/boot/me/semant.ml b/src/boot/me/semant.ml
index d692f334..4c437aa1 100644
--- a/src/boot/me/semant.ml
+++ b/src/boot/me/semant.ml
@@ -183,6 +183,9 @@ type ctxt =
 
       ctxt_main_fn_fixup: fixup option;
       ctxt_main_name: Ast.name option;
+
+      (* Dynamically changes while walking. See path_managing_visitor. *)
+      ctxt_curr_path: Ast.name_component Stack.t;
     }
 ;;
 
@@ -270,9 +273,47 @@ let new_ctxt sess abi crate =
          | Some n -> Some (new_fixup (string_of_name n)));
 
     ctxt_main_name = crate.Ast.crate_main;
+
+    ctxt_curr_path = Stack.create ();
   }
 ;;
 
+let rec name_of ncs =
+  match ncs with
+      [] -> bug () "Walk.name_of_ncs: empty path"
+    | [(Ast.COMP_ident i)] -> Ast.NAME_base (Ast.BASE_ident i)
+    | [(Ast.COMP_app x)] -> Ast.NAME_base (Ast.BASE_app x)
+    | [(Ast.COMP_idx _)] ->
+        bug () "Walk.name_of_ncs: path-name contains COMP_idx"
+    | nc::ncs -> Ast.NAME_ext (name_of ncs, nc)
+;;
+
+let path_to_name
+    (path:Ast.name_component Stack.t)
+    : Ast.name =
+  name_of (stk_elts_from_top path)
+;;
+
+let should_log cx flag =
+  if flag
+  then
+    match cx.ctxt_sess.Session.sess_log_path with
+        None -> false
+      | Some mask ->
+          let curr = stk_elts_from_bot cx.ctxt_curr_path in
+          let rec permitted ncs strs =
+            match (ncs, strs) with
+                ((Ast.COMP_ident s) :: ncs, str :: strs)
+              | ((Ast.COMP_app (s, _)) :: ncs, str :: strs)
+                  when s = str ->
+                    permitted ncs strs
+              | (_, []) -> true
+              | _ -> false
+          in
+            (permitted curr mask)
+  else
+    false
+;;
 
 let bugi (cx:ctxt) (i:node_id) =
   let k s =
@@ -1693,74 +1734,57 @@ let unreferenced_required_item_ignoring_visitor
         Walk.visit_obj_drop_post = visit_obj_drop_post; }
 ;;
 
-let rec name_of ncs =
-  match ncs with
-      [] -> bug () "Walk.name_of_ncs: empty path"
-    | [(Ast.COMP_ident i)] -> Ast.NAME_base (Ast.BASE_ident i)
-    | [(Ast.COMP_app x)] -> Ast.NAME_base (Ast.BASE_app x)
-    | [(Ast.COMP_idx _)] ->
-        bug () "Walk.name_of_ncs: path-name contains COMP_idx"
-    | nc::ncs -> Ast.NAME_ext (name_of ncs, nc)
-;;
-
-let path_to_name
-    (path:Ast.name_component Stack.t)
-    : Ast.name =
-  name_of (stk_elts_from_top path)
-;;
-
 let mod_item_logging_visitor
     (cx:ctxt)
     (log_flag:bool)
     (log:ctxt -> ('a, unit, string, unit) format4 -> 'a)
     (pass:int)
-    (path:Ast.name_component Stack.t)
     (inner:Walk.visitor)
     : Walk.
 visitor =
   let entering _ =
-    if cx.ctxt_sess.Session.sess_log_passes
+    if (should_log cx 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);
+        pass Ast.sprintf_name (path_to_name cx.ctxt_curr_path);
     if log_flag
     then
       log cx "pass %d: entering %a"
-        pass Ast.sprintf_name (path_to_name path)
+        pass Ast.sprintf_name (path_to_name cx.ctxt_curr_path)
   in
   let entered _ =
-    if cx.ctxt_sess.Session.sess_log_passes
+    if (should_log cx 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);
+        pass Ast.sprintf_name (path_to_name cx.ctxt_curr_path);
     if log_flag
     then
       log cx "pass %d: entered %a"
-        pass Ast.sprintf_name (path_to_name path)
+        pass Ast.sprintf_name (path_to_name cx.ctxt_curr_path)
   in
   let leaving _ =
-    if cx.ctxt_sess.Session.sess_log_passes
+    if (should_log cx 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);
+        pass Ast.sprintf_name (path_to_name cx.ctxt_curr_path);
     if log_flag
     then
       log cx "pass %d: leaving %a"
-        pass Ast.sprintf_name (path_to_name path)
+        pass Ast.sprintf_name (path_to_name cx.ctxt_curr_path)
   in
   let left _ =
-    if cx.ctxt_sess.Session.sess_log_passes
+    if (should_log cx 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);
+        pass Ast.sprintf_name (path_to_name cx.ctxt_curr_path);
     if log_flag
     then
       log cx "pass %d: left %a"
-        pass Ast.sprintf_name (path_to_name path)
+        pass Ast.sprintf_name (path_to_name cx.ctxt_curr_path)
   in
 
   let visit_mod_item_pre name params item =
@@ -2044,7 +2068,6 @@ let lookup
 let run_passes
     (cx:ctxt)
     (name:string)
-    (path:Ast.name_component Stack.t)
     (passes:Walk.visitor array)
     (log_flag:bool)
     (log:ctxt -> ('a, unit, string, unit) format4 -> 'a)
@@ -2055,8 +2078,8 @@ let run_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))
+        (Walk.path_managing_visitor cx.ctxt_curr_path
+           (mod_item_logging_visitor cx log_flag log i pass))
         crate
   in
   let sess = cx.ctxt_sess in
diff --git a/src/boot/me/simplify.ml b/src/boot/me/simplify.ml
index ddc17e92..97af539f 100644
--- a/src/boot/me/simplify.ml
+++ b/src/boot/me/simplify.ml
@@ -4,11 +4,11 @@ open Semant;;
 let log cx =
   Session.log
     "simplify"
-    cx.Semant.ctxt_sess.Session.sess_log_simplify
+    (should_log cx cx.Semant.ctxt_sess.Session.sess_log_simplify)
     cx.Semant.ctxt_sess.Session.sess_log_out
 
 let iflog cx thunk =
-  if cx.Semant.ctxt_sess.Session.sess_log_simplify
+  if (should_log cx cx.Semant.ctxt_sess.Session.sess_log_simplify)
   then thunk ()
   else ()
 ;;
@@ -87,7 +87,6 @@ let pexp_simplifying_visitor
 
 
 let process_crate (cx:Semant.ctxt) (crate:Ast.crate) : unit =
-  let path = Stack.create () in
 
   let passes =
     [|
@@ -96,7 +95,7 @@ let process_crate (cx:Semant.ctxt) (crate:Ast.crate) : unit =
     |]
   in
   let log_flag = cx.Semant.ctxt_sess.Session.sess_log_simplify in
-    Semant.run_passes cx "simplify" path passes log_flag log crate
+    Semant.run_passes cx "simplify" passes log_flag log crate
 ;;
 
 (*
diff --git a/src/boot/me/trans.ml b/src/boot/me/trans.ml
index 83c67579..e1388e08 100644
--- a/src/boot/me/trans.ml
+++ b/src/boot/me/trans.ml
@@ -5,7 +5,7 @@ open Common;;
 open Transutil;;
 
 let log cx = Session.log "trans"
-  cx.ctxt_sess.Session.sess_log_trans
+  (should_log cx cx.ctxt_sess.Session.sess_log_trans)
   cx.ctxt_sess.Session.sess_log_out
 ;;
 
@@ -45,12 +45,11 @@ type const =
 
 let trans_visitor
     (cx:ctxt)
-    (path:Ast.name_component Stack.t)
     (inner:Walk.visitor)
     : Walk.visitor =
 
   let iflog thunk =
-    if cx.ctxt_sess.Session.sess_log_trans
+    if (should_log cx cx.ctxt_sess.Session.sess_log_trans)
     then thunk ()
     else ()
   in
@@ -237,7 +236,7 @@ let trans_visitor
   let simple_break_jumps = Stack.create() in (* not used for for-each *)
 
   let path_name (_:unit) : string =
-    string_of_name (path_to_name path)
+    string_of_name (path_to_name cx.ctxt_curr_path)
   in
 
   let based (reg:Il.reg) : Il.mem =
@@ -3416,8 +3415,8 @@ let trans_visitor
           drop_ty ty_params cell (slot_ty slot)
 
   and note_drop_step ty step =
-    if cx.ctxt_sess.Session.sess_trace_drop ||
-      cx.ctxt_sess.Session.sess_log_trans
+    if (should_log cx (cx.ctxt_sess.Session.sess_trace_drop ||
+                         cx.ctxt_sess.Session.sess_log_trans))
     then
       let mctrl_str =
         match ty_mem_ctrl cx ty with
@@ -3434,8 +3433,8 @@ let trans_visitor
         end
 
   and note_gc_step ty step =
-    if cx.ctxt_sess.Session.sess_trace_gc ||
-      cx.ctxt_sess.Session.sess_log_trans
+    if (should_log cx (cx.ctxt_sess.Session.sess_trace_gc ||
+                         cx.ctxt_sess.Session.sess_log_trans))
     then
       let mctrl_str =
         match ty_mem_ctrl cx ty with
@@ -5561,7 +5560,7 @@ let trans_visitor
                   htab_search_or_add cx.ctxt_required_rust_sym_num fnid
                     (fun _ -> Hashtbl.length cx.ctxt_required_rust_sym_num)
                 in
-                let path_elts = stk_elts_from_bot path in
+                let path_elts = stk_elts_from_bot cx.ctxt_curr_path in
                 let _ =
                   assert (ls.required_prefix < (List.length path_elts))
                 in
@@ -5591,7 +5590,8 @@ let trans_visitor
                   match htab_search cx.ctxt_required_syms fnid with
                       Some s -> s
                     | None ->
-                        string_of_name_component (Stack.top path)
+                        string_of_name_component
+                          (Stack.top cx.ctxt_curr_path)
                 in
                 let c_sym_num =
                   (* FIXME: permit remapping symbol names to handle
@@ -5935,12 +5935,11 @@ let trans_visitor
 
 let fixup_assigning_visitor
     (cx:ctxt)
-    (path:Ast.name_component Stack.t)
     (inner:Walk.visitor)
     : Walk.visitor =
 
   let path_name (_:unit) : string =
-    Fmt.fmt_to_str Ast.fmt_name (path_to_name path)
+    Fmt.fmt_to_str Ast.fmt_name (path_to_name cx.ctxt_curr_path)
   in
 
   let enter_file_for id =
@@ -5948,7 +5947,7 @@ let fixup_assigning_visitor
     then
       begin
         let name =
-          if Stack.is_empty path
+          if Stack.is_empty cx.ctxt_curr_path
           then "crate root"
           else path_name()
         in
@@ -5969,7 +5968,7 @@ let fixup_assigning_visitor
 
         | Ast.MOD_ITEM_fn _ ->
             begin
-              let path = path_to_name path in
+              let path = path_to_name cx.ctxt_curr_path in
               let fixup =
                 if (not cx.ctxt_sess.Session.sess_library_mode)
                   && (Some path) = cx.ctxt_main_name
@@ -6031,15 +6030,12 @@ let process_crate
     (cx:ctxt)
     (crate:Ast.crate)
     : unit =
-  let path = Stack.create () in
   let passes =
     [|
       (unreferenced_required_item_ignoring_visitor cx
-         (fixup_assigning_visitor cx path
-            Walk.empty_visitor));
+         (fixup_assigning_visitor cx Walk.empty_visitor));
       (unreferenced_required_item_ignoring_visitor cx
-         (trans_visitor cx path
-            Walk.empty_visitor))
+         (trans_visitor cx Walk.empty_visitor))
     |];
   in
     log cx "translating crate";
@@ -6050,7 +6046,7 @@ let process_crate
             log cx "with main fn %a"
               Ast.sprintf_name m
     end;
-    run_passes cx "trans" path passes
+    run_passes cx "trans" passes
       cx.ctxt_sess.Session.sess_log_trans log crate;
 ;;
 
diff --git a/src/boot/me/type.ml b/src/boot/me/type.ml
index d2d01f0a..a47850fe 100644
--- a/src/boot/me/type.ml
+++ b/src/boot/me/type.ml
@@ -28,11 +28,11 @@ exception Type_error of string * string
 let log cx =
   Session.log
     "type"
-    cx.Semant.ctxt_sess.Session.sess_log_type
+    (Semant.should_log cx cx.Semant.ctxt_sess.Session.sess_log_type)
     cx.Semant.ctxt_sess.Session.sess_log_out
 
 let iflog cx thunk =
-  if cx.Semant.ctxt_sess.Session.sess_log_type
+  if (Semant.should_log cx cx.Semant.ctxt_sess.Session.sess_log_type)
   then thunk ()
   else ()
 ;;
@@ -1253,7 +1253,6 @@ let check_for_tag_cycles (cx:Semant.ctxt) =
   Hashtbl.iter check_node cx.Semant.ctxt_tag_containment
 
 let process_crate (cx:Semant.ctxt) (crate:Ast.crate) : unit =
-  let path = Stack.create () in
   let fn_ctx_stack = Stack.create () in
 
   (* Verify that, if main is present, it has the right form. *)
@@ -1393,7 +1392,7 @@ let process_crate (cx:Semant.ctxt) (crate:Ast.crate) : unit =
     |]
   in
   let log_flag = cx.Semant.ctxt_sess.Session.sess_log_type in
-    Semant.run_passes cx "type" path passes log_flag log crate
+    Semant.run_passes cx "type" passes log_flag log crate
 ;;
 
 (*
diff --git a/src/boot/me/typestate.ml b/src/boot/me/typestate.ml
index 81781d34..e3c9974a 100644
--- a/src/boot/me/typestate.ml
+++ b/src/boot/me/typestate.ml
@@ -3,12 +3,12 @@ open Common;;
 
 
 let log cx = Session.log "typestate"
-  cx.ctxt_sess.Session.sess_log_typestate
+  (should_log cx cx.ctxt_sess.Session.sess_log_typestate)
   cx.ctxt_sess.Session.sess_log_out
 ;;
 
 let iflog cx thunk =
-  if cx.ctxt_sess.Session.sess_log_typestate
+  if (should_log cx cx.ctxt_sess.Session.sess_log_typestate)
   then thunk ()
   else ()
 ;;
@@ -1590,7 +1590,6 @@ let process_crate
     (cx:ctxt)
     (crate:Ast.crate)
     : unit =
-  let path = Stack.create () in
   let (scopes:(scope list) ref) = ref [] in
   let (tables_stack:typestate_tables Stack.t) = Stack.create () in
   let (all_tables:item_tables) = Hashtbl.create 0 in
@@ -1641,11 +1640,11 @@ let process_crate
     |]
   in
   let log_flag = cx.ctxt_sess.Session.sess_log_typestate in
-    run_passes cx "typestate setup" path setup_passes log_flag log crate;
+    run_passes cx "typestate setup" setup_passes log_flag log crate;
     run_passes cx
-      "typestate dataflow" path dataflow_passes log_flag log crate;
-    run_passes cx "typestate verify" path verify_passes log_flag log crate;
-    run_passes cx "typestate aux" path aux_passes log_flag log crate
+      "typestate dataflow" dataflow_passes log_flag log crate;
+    run_passes cx "typestate verify" verify_passes log_flag log crate;
+    run_passes cx "typestate aux" aux_passes log_flag log crate
 ;;
 
 
diff --git a/src/boot/util/common.ml b/src/boot/util/common.ml
index f51d818e..838caa73 100644
--- a/src/boot/util/common.ml
+++ b/src/boot/util/common.ml
@@ -180,6 +180,31 @@ let new_fixup (s:string)
 
 
 (*
+ * Auxiliary string functions.
+ *)
+
+let split_string (c:char) (s:string) : string list =
+  let ls = ref [] in
+  let b = Buffer.create (String.length s) in
+  let flush _ =
+    if Buffer.length b <> 0
+    then
+      begin
+        ls := (Buffer.contents b) :: (!ls);
+        Buffer.clear b
+      end
+  in
+  let f ch =
+    if c = ch
+    then flush()
+    else Buffer.add_char b ch
+  in
+    String.iter f s;
+    flush();
+    List.rev (!ls)
+;;
+
+(*
  * Auxiliary hashtable functions.
  *)