First lame stab at solving the diamond import problem

Author: pcwalton

src/boot/driver/lib.ml

@@ -125,6 +125,7 @@ let get_mod
     (use_id:node_id)
     (nref:node_id ref)
     (oref:opaque_id ref)
+    (crate_item_cache:(crate_id, Ast.mod_items) Hashtbl.t)
     : (filename * Ast.mod_items) =
   let found = Queue.create () in
   let suffix =
@@ -183,22 +184,24 @@ let get_mod
                   (file_matches file)
                 then
                   begin
-                    iflog sess
-                      begin
-                        fun _ ->
-                          log sess "matched against library %s" file;
-                          match get_meta sess file with
-                              None -> ()
-                            | Some meta ->
-                                if not (Hashtbl.mem
-                                    sess.Session.sess_crate_meta meta) then
-                                  Hashtbl.add sess.Session.sess_crate_meta
-                                    meta (Session.make_crate_id sess);
-                                Array.iter
-                                  (fun (k,v) -> log sess "%s = %S" k v)
-                                  meta;
-                      end;
-                    Queue.add file found;
+                    log sess "matched against library %s" file;
+
+                    let meta = get_meta sess file in
+                    let crate_id =
+                      match meta with
+                          None -> Session.make_crate_id sess
+                        | Some meta ->
+                            iflog sess begin fun _ ->
+                              Array.iter
+                                (fun (k, v) -> log sess "%s = %S" k v)
+                                meta
+                            end;
+                            htab_search_or_default
+                              sess.Session.sess_crate_meta
+                              meta
+                              (fun () -> Session.make_crate_id sess)
+                    in
+                    Queue.add (file, crate_id) found;
                   end;
                 scan()
             with
@@ -210,8 +213,11 @@ let get_mod
     match Queue.length found with
         0 -> Common.err (Some use_id) "unsatisfied 'use' clause"
       | 1 ->
-          let filename = Queue.pop found in
-          let items = get_file_mod sess abi filename nref oref in
+          let (filename, crate_id) = Queue.pop found in
+          let items =
+            htab_search_or_default crate_item_cache crate_id
+              (fun () -> get_file_mod sess abi filename nref oref)
+          in
             (filename, items)
       | _ -> Common.err (Some use_id) "multiple crates match 'use' clause"
 ;;

src/boot/driver/main.ml

@@ -239,7 +239,9 @@ let _ =
 ;;
 
 
-let parse_input_crate _ : Ast.crate =
+let parse_input_crate
+    (crate_cache:(crate_id, Ast.mod_items) Hashtbl.t)
+    : Ast.crate =
   Session.time_inner "parse" sess
     begin
       fun _ ->
@@ -250,12 +252,14 @@ let parse_input_crate _ : Ast.crate =
             Cexp.parse_crate_file sess
               (Lib.get_mod sess abi)
               (Lib.infer_lib_name sess)
+              crate_cache
           else
             if Filename.check_suffix infile ".rs"
             then
               Cexp.parse_src_file sess
                 (Lib.get_mod sess abi)
                 (Lib.infer_lib_name sess)
+                crate_cache
             else
               begin
                 Printf.fprintf stderr
@@ -295,7 +299,8 @@ let parse_input_crate _ : Ast.crate =
 
 let (crate:Ast.crate) =
   try
-    parse_input_crate()
+    let crate_cache = Hashtbl.create 1 in
+    parse_input_crate crate_cache
   with
       Not_implemented (ido, str) ->
         Session.report_err sess ido str;

src/boot/fe/cexp.ml

@@ -380,6 +380,7 @@ and eval_cexp (env:env) (exp:cexp) : cdir array =
             ps.pstate_temp_id
             ps.pstate_node_id
             ps.pstate_opaque_id
+            ps.pstate_crate_cache
             ps.pstate_sess
             ps.pstate_get_mod
             ps.pstate_get_cenv_tok
@@ -427,7 +428,12 @@ and eval_cexp (env:env) (exp:cexp) : cdir array =
               end
               u.use_meta
           in
-          ps.pstate_get_mod meta_pat id ps.pstate_node_id ps.pstate_opaque_id
+          ps.pstate_get_mod
+            meta_pat
+            id
+            ps.pstate_node_id
+            ps.pstate_opaque_id
+            ps.pstate_crate_cache
         in
           iflog ps
             begin
@@ -618,6 +624,7 @@ let parse_crate_file
     (sess:Session.sess)
     (get_mod:get_mod_fn)
     (infer_lib_name:(Ast.ident -> filename))
+    (crate_cache:(crate_id, Ast.mod_items) Hashtbl.t)
     : Ast.crate =
   let fname = Session.filename_of sess.Session.sess_in in
   let tref = ref (Temp 0) in
@@ -659,7 +666,7 @@ let parse_crate_file
         | Some (PVAL_num n) -> LIT_INT n
   in
   let ps =
-    make_parser tref nref oref sess get_mod get_cenv_tok
+    make_parser tref nref oref crate_cache sess get_mod get_cenv_tok
       infer_lib_name required required_syms fname
   in
   let env = { env_bindings = bindings;
@@ -723,6 +730,7 @@ let parse_src_file
     (sess:Session.sess)
     (get_mod:get_mod_fn)
     (infer_lib_name:(Ast.ident -> filename))
+    (crate_cache:(crate_id, Ast.mod_items) Hashtbl.t)
     : Ast.crate =
   let fname = Session.filename_of sess.Session.sess_in in
   let tref = ref (Temp 0) in
@@ -735,7 +743,7 @@ let parse_src_file
                   ident) ps)
   in
   let ps =
-    make_parser tref nref oref sess get_mod get_cenv_tok
+    make_parser tref nref oref crate_cache sess get_mod get_cenv_tok
       infer_lib_name required required_syms fname
   in
     with_err_handling sess

src/boot/fe/item.ml

@@ -1159,7 +1159,12 @@ and parse_use
   let bpos = lexpos ps in
   let id = (span ps apos bpos ()).id in
   let (path, items) =
-    ps.pstate_get_mod meta id ps.pstate_node_id ps.pstate_opaque_id
+    ps.pstate_get_mod
+      meta
+      id
+      ps.pstate_node_id
+      ps.pstate_opaque_id
+      ps.pstate_crate_cache
   in
   let bpos = lexpos ps in
     expect ps SEMI;

src/boot/fe/parser.ml

@@ -8,7 +8,8 @@ type get_mod_fn = (Ast.meta_pat
                    -> node_id
                      -> (node_id ref)
                        -> (opaque_id ref)
-                         -> (filename * Ast.mod_items))
+                         -> (crate_id, Ast.mod_items) Hashtbl.t
+                           -> (filename * Ast.mod_items))
 ;;
 
 type pstate =
@@ -22,6 +23,7 @@ type pstate =
       pstate_temp_id      : temp_id ref;
       pstate_node_id      : node_id ref;
       pstate_opaque_id    : opaque_id ref;
+      pstate_crate_cache  : (crate_id, Ast.mod_items) Hashtbl.t;
       pstate_get_mod      : get_mod_fn;
       pstate_get_cenv_tok : pstate -> Ast.ident -> token;
       pstate_infer_lib_name : (Ast.ident -> filename);
@@ -44,6 +46,7 @@ let make_parser
     (tref:temp_id ref)
     (nref:node_id ref)
     (oref:opaque_id ref)
+    (crate_cache:(crate_id, Ast.mod_items) Hashtbl.t)
     (sess:Session.sess)
     (get_mod:get_mod_fn)
     (get_cenv_tok:pstate -> Ast.ident -> token)
@@ -69,6 +72,7 @@ let make_parser
         pstate_temp_id = tref;
         pstate_node_id = nref;
         pstate_opaque_id = oref;
+        pstate_crate_cache = crate_cache;
         pstate_get_mod = get_mod;
         pstate_get_cenv_tok = get_cenv_tok;
         pstate_infer_lib_name = infer_lib_name;