Move the friendly-names table to semant, reuse it in the name mangler.

3 files changed, 19 insertions, 16 deletions

diff --git a/src/boot/me/resolve.ml b/src/boot/me/resolve.ml
index 78d372d508d..8372b64a3e3 100644
--- a/src/boot/me/resolve.ml
+++ b/src/boot/me/resolve.ml
@@ -877,6 +877,18 @@ let process_crate
     (* Post-resolve, we can establish a tag cache. *)
     cx.ctxt_tag_cache <- Some (Hashtbl.create 0);
     cx.ctxt_rebuild_cache <- Some (Hashtbl.create 0);
+
+    (* Also index all the type names for future error messages. *)
+    Hashtbl.iter
+      begin
+        fun item_id ty ->
+          let item_names = cx.Semant.ctxt_all_item_names in
+            if Hashtbl.mem item_names item_id then
+              Hashtbl.add cx.Semant.ctxt_user_type_names ty
+                (Hashtbl.find item_names item_id)
+      end
+      cx.Semant.ctxt_all_type_items;
+
 ;;
 
 (*
diff --git a/src/boot/me/semant.ml b/src/boot/me/semant.ml
index 8ff439e8b65..010494b4d14 100644
--- a/src/boot/me/semant.ml
+++ b/src/boot/me/semant.ml
@@ -115,6 +115,7 @@ type ctxt =
       ctxt_item_files: (node_id,filename) Hashtbl.t;
       ctxt_all_lvals: (node_id,Ast.lval) Hashtbl.t;
       ctxt_call_lval_params: (node_id,Ast.ty array) Hashtbl.t;
+      ctxt_user_type_names: (Ast.ty,Ast.name) Hashtbl.t;
 
       (* A directed graph that encodes the containment relation among tags. *)
       ctxt_tag_containment: (opaque_id, tag_graph_node) Hashtbl.t;
@@ -227,6 +228,7 @@ let new_ctxt sess abi crate =
     ctxt_all_lvals = Hashtbl.create 0;
     ctxt_all_defns = Hashtbl.create 0;
     ctxt_call_lval_params = Hashtbl.create 0;
+    ctxt_user_type_names = Hashtbl.create 0;
 
     ctxt_tag_containment = Hashtbl.create 0;
 
@@ -2624,7 +2626,10 @@ let ty_str (cx:ctxt) (ty:Ast.ty) : string =
          ty_fold_constrained = (fun (t,_)-> t) }
   in
     htab_search_or_add cx.ctxt_type_str_cache ty
-      (fun _ -> fold_ty cx fold ty)
+      (fun _ ->
+         match htab_search cx.ctxt_user_type_names ty with
+             None -> "$" ^ (fold_ty cx fold ty)
+           | Some name -> string_of_name name)
 ;;
 
 let glue_str (cx:ctxt) (g:glue) : string =
diff --git a/src/boot/me/type.ml b/src/boot/me/type.ml
index e93c8fc42c1..66dd240efa9 100644
--- a/src/boot/me/type.ml
+++ b/src/boot/me/type.ml
@@ -38,23 +38,9 @@ let iflog cx thunk =
 ;;
 
 (* Pretty-printing of type names *)
-let type_name_cache = ref None
-let get_type_name_cache cx =
-  match !type_name_cache with
-      None ->
-        let cache = Hashtbl.create 0 in
-        let add item_id ty =
-          let item_names = cx.Semant.ctxt_all_item_names in
-          if Hashtbl.mem item_names item_id then
-            Hashtbl.add cache ty (Hashtbl.find item_names item_id)
-        in
-        Hashtbl.iter add cx.Semant.ctxt_all_type_items;
-        type_name_cache := Some cache;
-        cache
-    | Some cache -> cache
 
 let rec friendly_stringify cx fallback ty =
-  let cache = get_type_name_cache cx in
+  let cache = cx.Semant.ctxt_user_type_names in
   if Hashtbl.mem cache ty then
     let names = List.map (Ast.sprintf_name ()) (Hashtbl.find_all cache ty) in
     String.concat " = " names