Only translate or dwarf-emit items or stubs locally defined or used. Avoids instantiating O(sizeof(standard-library)) worth of imports stubs on each 'use std'. Closes issue 13.

7 files changed, 269 insertions, 36 deletions

diff --git a/src/boot/fe/item.ml b/src/boot/fe/item.ml
index 031b9e49..a2763d96 100644
--- a/src/boot/fe/item.ml
+++ b/src/boot/fe/item.ml
@@ -876,17 +876,31 @@ and parse_mod_item (ps:pstate) : (Ast.ident * Ast.mod_item) =
 and parse_mod_items_from_signature
     (ps:pstate)
     : (Ast.mod_view * Ast.mod_items) =
-    let mis = Hashtbl.create 0 in
-      expect ps LBRACE;
-      while not (peek ps = RBRACE)
-      do
+  let exports = Hashtbl.create 0 in
+  let mis = Hashtbl.create 0 in
+  let in_view = ref true in
+    expect ps LBRACE;
+    while not (peek ps = RBRACE)
+    do
+      if !in_view
+      then
+        match peek ps with
+            EXPORT ->
+              bump ps;
+              parse_export ps exports;
+              expect ps SEMI;
+          | _ ->
+              in_view := false
+      else
         let (ident, mti) = ctxt "mod items from sig: mod item"
           parse_mod_item_from_signature ps
         in
           Hashtbl.add mis ident mti;
-      done;
-      expect ps RBRACE;
-      (empty_view, mis)
+    done;
+    if (Hashtbl.length exports) = 0
+    then Hashtbl.add exports Ast.EXPORT_all_decls ();
+    expect ps RBRACE;
+    ({empty_view with Ast.view_exports = exports}, mis)
 
 
 and parse_mod_item_from_signature (ps:pstate)
diff --git a/src/boot/me/dwarf.ml b/src/boot/me/dwarf.ml
index b3c66a87..910ef983 100644
--- a/src/boot/me/dwarf.ml
+++ b/src/boot/me/dwarf.ml
@@ -2517,11 +2517,12 @@ let process_crate
 
   let passes =
     [|
-      dwarf_visitor cx Walk.empty_visitor path
-        cx.ctxt_debug_info_fixup
-        cu_aranges cu_pubnames
-        cu_infos cu_abbrevs
-        cu_lines cu_frames
+      unreferenced_required_item_ignoring_visitor cx
+        (dwarf_visitor cx Walk.empty_visitor path
+           cx.ctxt_debug_info_fixup
+           cu_aranges cu_pubnames
+           cu_infos cu_abbrevs
+           cu_lines cu_frames)
     |];
   in
 
diff --git a/src/boot/me/resolve.ml b/src/boot/me/resolve.ml
index 6c481040..c0146c97 100644
--- a/src/boot/me/resolve.ml
+++ b/src/boot/me/resolve.ml
@@ -730,11 +730,33 @@ let lval_base_resolving_visitor
                           (int_of_node nb.id) (int_of_node referent_id));
               htab_put cx.ctxt_lval_to_referent nb.id referent_id
     in
+
+    (*
+     * The point here is just to tickle the reference-a-name machinery in
+     * lookup that makes sure that all and only those items referenced get
+     * processed by later stages. An lval that happens to be an item will
+     * mark the item in question here.
+     *)
+    let reference_any_name lv =
+      let rec lval_is_name lv =
+        match lv with
+            Ast.LVAL_base {node = Ast.BASE_ident _}
+          | Ast.LVAL_base {node = Ast.BASE_app _} -> true
+          | Ast.LVAL_ext (lv', Ast.COMP_named (Ast.COMP_ident _))
+          | Ast.LVAL_ext (lv', Ast.COMP_named (Ast.COMP_app _))
+            -> lval_is_name lv'
+          | _ -> false
+      in
+        if lval_is_name lv && lval_is_item cx lv
+        then ignore (lookup_by_name cx (!scopes) (lval_to_name lv))
+    in
+
       lookup_lval lv;
+      reference_any_name lv;
       inner.Walk.visit_lval_pre lv
   in
     { inner with
-        Walk.visit_lval_pre = visit_lval_pre }
+        Walk.visit_lval_pre = visit_lval_pre };
 ;;
 
 
@@ -868,7 +890,8 @@ let resolve_recursion
 
 let pattern_resolving_visitor
     (cx:ctxt)
-    (inner:Walk.visitor) : Walk.visitor =
+    (inner:Walk.visitor)
+    : Walk.visitor =
 
   let not_tag_ctor nm id : unit =
     err (Some id) "'%s' is not a tag constructor" (string_of_name nm)
@@ -934,6 +957,43 @@ let pattern_resolving_visitor
   { inner with Walk.visit_stmt_pre = visit_stmt_pre }
 ;;
 
+let export_referencing_visitor
+    (cx:ctxt)
+    (inner:Walk.visitor)
+    : Walk.visitor =
+    let visit_mod_item_pre id params item =
+      begin
+        match item.node.Ast.decl_item with
+            Ast.MOD_ITEM_mod (view, items) ->
+              let is_defining_mod =
+                (* auto-ref the default-export cases only if
+                 * the containing mod is 'defining', meaning
+                 * not-native / not-use
+                 *)
+                 not (Hashtbl.mem cx.ctxt_required_items item.id)
+              in
+              let reference _ item =
+                Hashtbl.replace cx.ctxt_node_referenced item.id ();
+              in
+              let reference_export e _ =
+                match e with
+                    Ast.EXPORT_ident ident ->
+                      let item = Hashtbl.find items ident in
+                        reference ident item
+                  | Ast.EXPORT_all_decls ->
+                      if is_defining_mod
+                      then Hashtbl.iter reference items
+              in
+                Hashtbl.iter reference_export view.Ast.view_exports
+          | _ -> ()
+      end;
+      inner.Walk.visit_mod_item_pre id params item
+    in
+      { inner with Walk.visit_mod_item_pre = visit_mod_item_pre }
+
+
+;;
+
 let process_crate
     (cx:ctxt)
     (crate:Ast.crate)
@@ -957,6 +1017,7 @@ let process_crate
             Walk.empty_visitor))
     |]
   in
+
   let passes_1 =
     [|
       (scope_stack_managing_visitor scopes
@@ -966,20 +1027,38 @@ let process_crate
                Walk.empty_visitor)));
     |]
   in
+
   let passes_2 =
     [|
       (scope_stack_managing_visitor scopes
          (pattern_resolving_visitor cx
-            Walk.empty_visitor))
+            Walk.empty_visitor));
+      export_referencing_visitor cx Walk.empty_visitor
     |]
   in
+
     log cx "running primary resolve passes";
     run_passes cx "resolve collect" path passes_0 (log cx "%s") crate;
     resolve_recursion cx node_to_references recursive_tag_groups;
     log cx "running secondary resolve passes";
     run_passes cx "resolve bind" path passes_1 (log cx "%s") crate;
     log cx "running tertiary resolve passes";
-    run_passes cx "resolve patterns" path passes_2 (log cx "%s") crate
+    run_passes cx "resolve patterns" path passes_2 (log cx "%s") crate;
+
+    iflog cx
+      begin
+        fun _ ->
+          Hashtbl.iter
+            begin
+              fun n _ ->
+                if referent_is_item cx n
+                then
+                  log cx "referenced: %a"
+                    Ast.sprintf_name
+                    (Hashtbl.find cx.ctxt_all_item_names n)
+            end
+            cx.ctxt_node_referenced;
+      end
 ;;
 
 (*
diff --git a/src/boot/me/semant.ml b/src/boot/me/semant.ml
index 08155ed3..40dd33bf 100644
--- a/src/boot/me/semant.ml
+++ b/src/boot/me/semant.ml
@@ -90,6 +90,7 @@ type ctxt =
       ctxt_block_items: block_items_table;
       ctxt_slot_is_arg: (node_id,unit) Hashtbl.t;
       ctxt_slot_keys: (node_id,Ast.slot_key) Hashtbl.t;
+      ctxt_node_referenced: (node_id, unit) Hashtbl.t;
       ctxt_all_item_names: (node_id,Ast.name) Hashtbl.t;
       ctxt_all_item_types: (node_id,Ast.ty) Hashtbl.t;
       ctxt_all_lval_types: (node_id,Ast.ty) Hashtbl.t;
@@ -179,6 +180,7 @@ let new_ctxt sess abi crate =
     ctxt_block_items = Hashtbl.create 0;
     ctxt_slot_is_arg = Hashtbl.create 0;
     ctxt_slot_keys = Hashtbl.create 0;
+    ctxt_node_referenced = Hashtbl.create 0;
     ctxt_all_item_names = Hashtbl.create 0;
     ctxt_all_item_types = Hashtbl.create 0;
     ctxt_all_lval_types = Hashtbl.create 0;
@@ -1330,6 +1332,114 @@ let scope_stack_managing_visitor
         Walk.visit_crate_post = visit_crate_post; }
 ;;
 
+let unreferenced_required_item_ignoring_visitor
+    (cx:ctxt)
+    (inner:Walk.visitor)
+    : Walk.visitor =
+
+  let inhibition = ref 0 in
+
+  let directly_inhibited i =
+    (Hashtbl.mem cx.ctxt_required_items i.id) &&
+      (not (Hashtbl.mem cx.ctxt_node_referenced i.id))
+  in
+
+  let indirectly_inhibited _ =
+    (!inhibition) <> 0
+  in
+
+  let should_visit i =
+    not ((directly_inhibited i) || (indirectly_inhibited()))
+  in
+
+  let inhibit_pre i =
+    if directly_inhibited i
+    then incr inhibition
+  in
+
+  let inhibit_post i =
+    if directly_inhibited i
+    then decr inhibition
+  in
+
+  let visit_mod_item_pre n p i =
+    if should_visit i
+    then inner.Walk.visit_mod_item_pre n p i;
+    inhibit_pre i
+  in
+
+  let visit_mod_item_post n p i =
+    if should_visit i
+    then inner.Walk.visit_mod_item_post n p i;
+    inhibit_post i
+  in
+
+  let visit_obj_fn_pre oid ident fn =
+    if not (indirectly_inhibited())
+    then inner.Walk.visit_obj_fn_pre oid ident fn;
+  in
+
+  let visit_obj_fn_post oid ident fn =
+    if not (indirectly_inhibited())
+    then inner.Walk.visit_obj_fn_post oid ident fn;
+  in
+
+  let visit_obj_drop_pre oid d =
+    if not (indirectly_inhibited())
+    then inner.Walk.visit_obj_drop_pre oid d;
+  in
+
+  let visit_obj_drop_post oid d =
+    if not (indirectly_inhibited())
+    then inner.Walk.visit_obj_drop_post oid d;
+  in
+
+  let visit_constr_pre n c =
+    if not (indirectly_inhibited())
+    then inner.Walk.visit_constr_pre n c;
+  in
+
+  let visit_constr_post n c =
+    if not (indirectly_inhibited())
+    then inner.Walk.visit_constr_post n c;
+  in
+
+  let wrap1 fn =
+    fun x ->
+      if not (indirectly_inhibited())
+      then fn x
+  in
+
+    { inner with
+        Walk.visit_stmt_pre = wrap1 inner.Walk.visit_stmt_pre;
+        Walk.visit_stmt_post = wrap1 inner.Walk.visit_stmt_post;
+        Walk.visit_slot_identified_pre =
+        wrap1 inner.Walk.visit_slot_identified_pre;
+        Walk.visit_slot_identified_post =
+        wrap1 inner.Walk.visit_slot_identified_post;
+        Walk.visit_expr_pre = wrap1 inner.Walk.visit_expr_pre;
+        Walk.visit_expr_post = wrap1 inner.Walk.visit_expr_post;
+        Walk.visit_ty_pre = wrap1 inner.Walk.visit_ty_pre;
+        Walk.visit_ty_post = wrap1 inner.Walk.visit_ty_post;
+        Walk.visit_constr_pre = visit_constr_pre;
+        Walk.visit_constr_post = visit_constr_post;
+        Walk.visit_pat_pre = wrap1 inner.Walk.visit_pat_pre;
+        Walk.visit_pat_post = wrap1 inner.Walk.visit_pat_post;
+        Walk.visit_block_pre = wrap1 inner.Walk.visit_block_pre;
+        Walk.visit_block_post = wrap1 inner.Walk.visit_block_post;
+        Walk.visit_lit_pre = wrap1 inner.Walk.visit_lit_pre;
+        Walk.visit_lit_post = wrap1 inner.Walk.visit_lit_post;
+        Walk.visit_lval_pre = wrap1 inner.Walk.visit_lval_pre;
+        Walk.visit_lval_post = wrap1 inner.Walk.visit_lval_post;
+        Walk.visit_mod_item_pre = visit_mod_item_pre;
+        Walk.visit_mod_item_post = visit_mod_item_post;
+        Walk.visit_obj_fn_pre = visit_obj_fn_pre;
+        Walk.visit_obj_fn_post = visit_obj_fn_post;
+        Walk.visit_obj_drop_pre = visit_obj_drop_pre;
+        Walk.visit_obj_drop_post = visit_obj_drop_post; }
+;;
+
+
 (* Generic lookup, used for slots, items, types, etc. *)
 
 type resolved = ((scope list * node_id) option) ;;
@@ -1337,15 +1447,15 @@ type resolved = ((scope list * node_id) option) ;;
 let get_item (cx:ctxt) (node:node_id) : Ast.mod_item_decl =
   match htab_search cx.ctxt_all_defns node with
       Some (DEFN_item item) -> item
-    | Some _ -> err (Some node) "defn is not an item"
-    | None -> bug () "missing defn"
+    | Some _ -> bugi cx node "defn is not an item"
+    | None -> bugi cx node "missing defn"
 ;;
 
 let get_slot (cx:ctxt) (node:node_id) : Ast.slot =
   match htab_search cx.ctxt_all_defns node with
       Some (DEFN_slot slot) -> slot
-    | Some _ -> err (Some node) "defn is not a slot"
-    | None -> bug () "missing defn"
+    | Some _ -> bugi cx node "defn is not a slot"
+    | None -> bugi cx node "missing defn"
 ;;
 
 let get_mod_item
@@ -1354,7 +1464,7 @@ let get_mod_item
     : (Ast.mod_view * Ast.mod_items) =
   match get_item cx node with
       { Ast.decl_item = Ast.MOD_ITEM_mod md } -> md
-    | _ -> err (Some node) "defn is not a mod"
+    | _ -> bugi cx node "defn is not a mod"
 ;;
 
 let get_name_comp_ident
@@ -1387,12 +1497,17 @@ let rec project_ident_from_items
   then None
   else
     match htab_search items ident with
-        Some i -> Some (scopes, i.id)
+        Some i ->
+          found cx scopes i.id
       | None ->
           match htab_search view.Ast.view_imports ident with
               None -> None
             | Some name -> lookup_by_name cx scopes name
 
+and found cx scopes id =
+  Hashtbl.replace cx.ctxt_node_referenced id ();
+  Some (scopes, id)
+
 and project_name_comp_from_resolved
     (cx:ctxt)
     (mod_res:resolved)
@@ -1405,6 +1520,7 @@ and project_name_comp_from_resolved
         let scopes = scope :: scopes in
         let ident = get_name_comp_ident ext in
         let md = get_mod_item cx id in
+          Hashtbl.replace cx.ctxt_node_referenced id ();
           project_ident_from_items cx scopes md ident false
 
 and lookup_by_name
@@ -1426,19 +1542,25 @@ and lookup_by_ident
     (scopes:scope list)
     (ident:Ast.ident)
     : resolved =
+
   let check_slots scopes islots =
     arr_search islots
       (fun _ (sloti,ident') ->
          if ident = ident'
-         then Some (scopes, sloti.id)
+         then found cx scopes sloti.id
          else None)
   in
+
   let check_params scopes params =
     arr_search params
       (fun _ {node=(i,_); id=id} ->
-         if i = ident then Some (scopes, id) else None)
+         if i = ident
+         then found cx scopes id
+         else None)
   in
+
   let passed_capture_scope = ref false in
+
   let would_capture r =
     match r with
         None -> None
@@ -1447,6 +1569,7 @@ and lookup_by_ident
           then err None "attempted dynamic environment-capture"
           else r
   in
+
   let check_scope scopes scope =
     match scope with
         SCOPE_block block_id ->
@@ -1454,10 +1577,10 @@ and lookup_by_ident
           let block_items = Hashtbl.find cx.ctxt_block_items block_id in
             begin
               match htab_search block_slots (Ast.KEY_ident ident) with
-                  Some id -> would_capture (Some (scopes, id))
+                  Some id -> would_capture (found cx scopes id)
                 | None ->
                     match htab_search block_items ident with
-                        Some id -> Some (scopes, id)
+                        Some id -> found cx scopes id
                       | None -> None
             end
 
@@ -1478,7 +1601,7 @@ and lookup_by_ident
                 | Ast.MOD_ITEM_obj obj ->
                     begin
                       match htab_search obj.Ast.obj_fns ident with
-                          Some fn -> Some (scopes, fn.id)
+                          Some fn -> found cx scopes fn.id
                         | None -> check_slots scopes obj.Ast.obj_state
                     end
 
diff --git a/src/boot/me/trans.ml b/src/boot/me/trans.ml
index 229395c2..4b7c5b17 100644
--- a/src/boot/me/trans.ml
+++ b/src/boot/me/trans.ml
@@ -5094,7 +5094,8 @@ let fixup_assigning_visitor
   in
 
   let visit_block_pre b =
-    htab_put cx.ctxt_block_fixups b.id (new_fixup "lexical block");
+    htab_put cx.ctxt_block_fixups b.id
+      (new_fixup ("lexical block in " ^ (path_name())));
     inner.Walk.visit_block_pre b
   in
 
@@ -5118,13 +5119,15 @@ let process_crate
   let path = Stack.create () in
   let passes =
     [|
-      (fixup_assigning_visitor cx path
-         Walk.empty_visitor);
-      (Walk.mod_item_logging_visitor
-         (log cx "translation pass: %s")
-         path
-         (trans_visitor cx path
-            Walk.empty_visitor))
+      (unreferenced_required_item_ignoring_visitor cx
+         (fixup_assigning_visitor cx path
+            Walk.empty_visitor));
+      (unreferenced_required_item_ignoring_visitor cx
+         (Walk.mod_item_logging_visitor
+            (log cx "translation pass: %s")
+            path
+            (trans_visitor cx path
+               Walk.empty_visitor)))
     |];
   in
     log cx "translating crate";
diff --git a/src/lib/sys.rs b/src/lib/sys.rs
index 3d858413..0eafc5ee 100644
--- a/src/lib/sys.rs
+++ b/src/lib/sys.rs
@@ -1,4 +1,17 @@
+export rustrt;
+
 native "rust" mod rustrt {
+
+  // Explicitly re-export native stuff we want to be made
+  // available outside this crate. Otherwise it's
+  // visible-in-crate, but not re-exported.
+
+  export last_os_error;
+  export size_of;
+  export align_of;
+  export refcount;
+  export gc;
+
   fn last_os_error() -> str;
   fn size_of[T]() -> uint;
   fn align_of[T]() -> uint;
diff --git a/src/test/compile-fail/direct-obj-fn-call.rs b/src/test/compile-fail/direct-obj-fn-call.rs
index e13db876..fa067725 100644
--- a/src/test/compile-fail/direct-obj-fn-call.rs
+++ b/src/test/compile-fail/direct-obj-fn-call.rs
@@ -1,5 +1,5 @@
 
-// error-pattern: mismatched types
+// error-pattern: is not a mod
 
 obj x() {
   fn hello() {