From 7e3c662b4f52aa7b35ba5e0ce5d09154687a9140 Mon Sep 17 00:00:00 2001
From: Patrick Walton <pcwalton@mimiga.net>
Date: Tue, 26 Oct 2010 14:51:32 -0700
Subject: [PATCH] rustboot: Use a less hacky method to report tag names in
 error messages, which works for resolve errors as well

---
 src/boot/me/resolve.ml |  6 ++++--
 src/boot/me/semant.ml  | 40 ++++++----------------------------------
 2 files changed, 10 insertions(+), 36 deletions(-)

diff --git a/src/boot/me/resolve.ml b/src/boot/me/resolve.ml
index 9574f0c157b..afc329d8641 100644
--- a/src/boot/me/resolve.ml
+++ b/src/boot/me/resolve.ml
@@ -178,8 +178,10 @@ let all_item_collecting_visitor
             note_header i.id f.Ast.fn_input_slots;
         | Ast.MOD_ITEM_obj ob ->
             note_header i.id ob.Ast.obj_state;
-        | Ast.MOD_ITEM_tag (hdr, _, _) ->
-            note_header i.id hdr
+        | Ast.MOD_ITEM_tag (hdr, oid, _) ->
+            note_header i.id hdr;
+            Hashtbl.replace cx.ctxt_user_tag_names oid
+              (path_to_name cx.ctxt_curr_path);
         | _ -> ()
     end;
       inner.Walk.visit_mod_item_pre n p i
diff --git a/src/boot/me/semant.ml b/src/boot/me/semant.ml
index 6fb6a5807b3..e77f97547e5 100644
--- a/src/boot/me/semant.ml
+++ b/src/boot/me/semant.ml
@@ -116,6 +116,7 @@ type ctxt =
       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;
+      ctxt_user_tag_names: (opaque_id,Ast.name) Hashtbl.t;
 
       (* A directed graph that encodes the containment relation among tags. *)
       ctxt_tag_containment: (opaque_id, tag_graph_node) Hashtbl.t;
@@ -229,6 +230,7 @@ let new_ctxt sess abi crate =
     ctxt_all_defns = Hashtbl.create 0;
     ctxt_call_lval_params = Hashtbl.create 0;
     ctxt_user_type_names = Hashtbl.create 0;
+    ctxt_user_tag_names = Hashtbl.create 0;
 
     ctxt_tag_containment = Hashtbl.create 0;
 
@@ -1005,40 +1007,10 @@ let rec pretty_ty_str (cx:ctxt) (fallback:(Ast.ty -> string)) (ty:Ast.ty) =
           let fn_args_str = String.concat ", " (Array.to_list fn_args) in
           let fn_rv_str = format_slot fnsig.Ast.sig_output_slot in
           Printf.sprintf "fn(%s) -> %s" fn_args_str fn_rv_str
-      | Ast.TY_tag { Ast.tag_id = tag_id; Ast.tag_args = args }
-              when Hashtbl.mem cx.ctxt_all_tag_info tag_id ->
-          let tag_info = Hashtbl.find cx.ctxt_all_tag_info tag_id in
-          let tag_idents = tag_info.tag_idents in
-          let item_id = ref None in
-          (* Ugly hack ahead... *)
-          begin
-            try
-              Hashtbl.iter
-                begin
-                  fun _ (_, item_id', _) ->
-                    item_id := Some item_id'; raise Exit
-                end
-                tag_idents
-            with Exit -> ();
-          end;
-          begin
-            match !item_id with
-                None -> fallback ty
-              | Some item_id ->
-                  let item_types = cx.ctxt_all_item_types in
-                  let ty = Hashtbl.find item_types item_id in
-                  let args_suffix =
-                    if Array.length args == 0 then ""
-                    else
-                      Printf.sprintf "[%s]"
-                        (String.concat ","
-                          (Array.to_list
-                            (Array.map
-                              (pretty_ty_str cx fallback)
-                              args)))
-                  in
-                  (pretty_ty_str cx fallback ty) ^ args_suffix
-          end
+      | Ast.TY_tag { Ast.tag_id = tag_id; Ast.tag_args = _ }
+              when Hashtbl.mem cx.ctxt_user_tag_names tag_id ->
+          let name = Hashtbl.find cx.ctxt_user_tag_names tag_id in
+          Ast.sprintf_name () name
 
       | _ -> fallback ty (* TODO: we can do better for objects *)
 ;;