Initial support for a global crate metadata cache

src/boot/driver/lib.ml

@@ -59,7 +59,7 @@ let get_sects
 let get_meta
     (sess:Session.sess)
     (filename:filename)
-    : Ast.meta option =
+    : Session.meta option =
   htab_search_or_add meta_cache filename
     begin
       fun _ ->
@@ -190,6 +190,10 @@ let get_mod
                           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;

src/boot/driver/main.ml

@@ -58,8 +58,10 @@ let (sess:Session.sess) =
     Session.sess_report_timing = false;
     Session.sess_report_gc = false;
     Session.sess_report_deps = false;
+    Session.sess_next_crate_id = 0;
     Session.sess_timings = Hashtbl.create 0;
     Session.sess_lib_dirs = Queue.create ();
+    Session.sess_crate_meta = Hashtbl.create 0;
   }
 ;;
 

src/boot/driver/session.ml

@@ -5,6 +5,8 @@
 
 open Common;;
 
+type meta = (string * string) array;;
+
 type sess =
 {
   mutable sess_in: filename option;
@@ -41,9 +43,11 @@ type sess =
   mutable sess_report_timing: bool;
   mutable sess_report_gc: bool;
   mutable sess_report_deps: bool;
+  mutable sess_next_crate_id: int;
   sess_timings: (string, float) Hashtbl.t;
   sess_spans: (node_id,span) Hashtbl.t;
   sess_lib_dirs: filename Queue.t;
+  sess_crate_meta: (meta, crate_id) Hashtbl.t;
 }
 ;;
 
@@ -115,6 +119,12 @@ let report_err sess ido str =
             (string_of_span span) str
 ;;
 
+let make_crate_id (sess:sess) : crate_id =
+  let crate_id = Crate sess.sess_next_crate_id in
+  sess.sess_next_crate_id <- sess.sess_next_crate_id + 1;
+  crate_id
+;;
+
 (*
  * Local Variables:
  * fill-column: 78;

src/boot/fe/ast.ml

@@ -452,14 +452,12 @@ and mod_view =
       view_exports: (export, unit) Hashtbl.t;
     }
 
-and meta = (ident * string) array
-
-and meta_pat = (ident * string option) array
+and meta_pat = (string * string option) array
 
 and crate' =
     {
       crate_items: (mod_view * mod_items);
-      crate_meta: meta;
+      crate_meta: Session.meta;
       crate_auth: (name, effect) Hashtbl.t;
       crate_required: (node_id, (required_lib * nabi_conv)) Hashtbl.t;
       crate_required_syms: (node_id, string) Hashtbl.t;

src/boot/fe/item.ml

@@ -758,7 +758,7 @@ and parse_meta_pat (ps:pstate) : Ast.meta_pat =
   bracketed_zero_or_more LPAREN RPAREN
     (Some COMMA) parse_meta_input ps
 
-and parse_meta (ps:pstate) : Ast.meta =
+and parse_meta (ps:pstate) : Session.meta =
   Array.map
     begin
       fun (id,v) ->

src/boot/util/common.ml

@@ -13,11 +13,13 @@ type node_id = Node of int
 type temp_id = Temp of int
 type opaque_id = Opaque of int
 type constr_id = Constr of int
+type crate_id = Crate of int
 
 let int_of_node (Node i) = i
 let int_of_temp (Temp i) = i
 let int_of_opaque (Opaque i) = i
 let int_of_constr (Constr i) = i
+let int_of_common (Crate i) = i
 
 type 'a identified = { node: 'a; id: node_id }
 ;;