---

yaml
---
r: 752
b: refs/heads/master
c: 5f24591
h: refs/heads/master
v: v3

Author: graydon

[refs]

@@ -1,2 +1,2 @@
 ---
-refs/heads/master: e3758fe321725bec4707e1b7d4fff333ba915905
+refs/heads/master: 5f2459145cb90d7d52cfde1d4ed7719dde1dfdc0

trunk/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)

trunk/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;

trunk/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
 ;;
 

trunk/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,15 +99,14 @@ let process_crate
     (cx:ctxt)
     (crate:Ast.crate)
     : unit =
-  let path = Stack.create () in
   let passes =
     [|
       (dead_code_visitor cx
          Walk.empty_visitor)
     |]
   in
 
-    run_passes cx "dead" path passes
+    run_passes cx "dead" passes
       cx.ctxt_sess.Session.sess_log_dead log crate;
     ()
 ;;

trunk/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. *)

trunk/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
 ;;
 

trunk/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
 ;;
 

trunk/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,15 +142,14 @@ let process_crate
     (cx:ctxt)
     (crate:Ast.crate)
     : unit =
-  let path = Stack.create () in
   let passes =
     [|
       (loop_depth_visitor cx
          Walk.empty_visitor)
     |]
   in
 
-    run_passes cx "loop" path passes
+    run_passes cx "loop" passes
       cx.ctxt_sess.Session.sess_log_loop log crate
 ;;
 

trunk/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