@@ -116,6 +116,7 @@ type ctxt =
116
116
ctxt_all_lvals : (node_id ,Ast .lval ) Hashtbl .t ;
117
117
ctxt_call_lval_params : (node_id ,Ast .ty array ) Hashtbl .t ;
118
118
ctxt_user_type_names : (Ast .ty ,Ast .name ) Hashtbl .t ;
119
+ ctxt_user_tag_names : (opaque_id ,Ast .name ) Hashtbl .t ;
119
120
120
121
(* A directed graph that encodes the containment relation among tags. *)
121
122
ctxt_tag_containment : (opaque_id , tag_graph_node ) Hashtbl .t ;
@@ -229,6 +230,7 @@ let new_ctxt sess abi crate =
229
230
ctxt_all_defns = Hashtbl. create 0 ;
230
231
ctxt_call_lval_params = Hashtbl. create 0 ;
231
232
ctxt_user_type_names = Hashtbl. create 0 ;
233
+ ctxt_user_tag_names = Hashtbl. create 0 ;
232
234
233
235
ctxt_tag_containment = Hashtbl. create 0 ;
234
236
@@ -1005,40 +1007,10 @@ let rec pretty_ty_str (cx:ctxt) (fallback:(Ast.ty -> string)) (ty:Ast.ty) =
1005
1007
let fn_args_str = String. concat " , " (Array. to_list fn_args) in
1006
1008
let fn_rv_str = format_slot fnsig.Ast. sig_output_slot in
1007
1009
Printf. sprintf " fn(%s) -> %s" fn_args_str fn_rv_str
1008
- | Ast. TY_tag { Ast. tag_id = tag_id; Ast. tag_args = args }
1009
- when Hashtbl. mem cx.ctxt_all_tag_info tag_id ->
1010
- let tag_info = Hashtbl. find cx.ctxt_all_tag_info tag_id in
1011
- let tag_idents = tag_info.tag_idents in
1012
- let item_id = ref None in
1013
- (* Ugly hack ahead... *)
1014
- begin
1015
- try
1016
- Hashtbl. iter
1017
- begin
1018
- fun _ (_ , item_id' , _ ) ->
1019
- item_id := Some item_id'; raise Exit
1020
- end
1021
- tag_idents
1022
- with Exit -> () ;
1023
- end;
1024
- begin
1025
- match ! item_id with
1026
- None -> fallback ty
1027
- | Some item_id ->
1028
- let item_types = cx.ctxt_all_item_types in
1029
- let ty = Hashtbl. find item_types item_id in
1030
- let args_suffix =
1031
- if Array. length args == 0 then " "
1032
- else
1033
- Printf. sprintf " [%s]"
1034
- (String. concat " ,"
1035
- (Array. to_list
1036
- (Array. map
1037
- (pretty_ty_str cx fallback)
1038
- args)))
1039
- in
1040
- (pretty_ty_str cx fallback ty) ^ args_suffix
1041
- end
1010
+ | Ast. TY_tag { Ast. tag_id = tag_id; Ast. tag_args = _ }
1011
+ when Hashtbl. mem cx.ctxt_user_tag_names tag_id ->
1012
+ let name = Hashtbl. find cx.ctxt_user_tag_names tag_id in
1013
+ Ast. sprintf_name () name
1042
1014
1043
1015
| _ -> fallback ty (* TODO: we can do better for objects *)
1044
1016
;;
0 commit comments