diff options
| -rw-r--r-- | bytecomp/translmod.ml | 15 | ||||
| -rw-r--r-- | bytecomp/translmod.mli | 1 | ||||
| -rw-r--r-- | toplevel/toploop.ml | 2 |
3 files changed, 15 insertions, 3 deletions
diff --git a/bytecomp/translmod.ml b/bytecomp/translmod.ml index 8d4f2fc030..1228f512f9 100644 --- a/bytecomp/translmod.ml +++ b/bytecomp/translmod.ml @@ -355,15 +355,23 @@ let toploop_ident = Ident.create_persistent "Toploop" let toploop_getvalue_pos = 0 (* position of getvalue in module Toploop *) let toploop_setvalue_pos = 1 (* position of setvalue in module Toploop *) +let aliased_idents = Hashtbl.create 17 + +let set_toplevel_name = Hashtbl.add aliased_idents + +let toplevel_name id = + try Hashtbl.find aliased_idents id + with Not_found -> Ident.name id + let toploop_getvalue id = Lapply(Lprim(Pfield toploop_getvalue_pos, [Lprim(Pgetglobal toploop_ident, [])]), - [Lconst(Const_base(Const_string (Ident.unique_name id)))]) + [Lconst(Const_base(Const_string (toplevel_name id)))]) let toploop_setvalue id lam = Lapply(Lprim(Pfield toploop_setvalue_pos, [Lprim(Pgetglobal toploop_ident, [])]), - [Lconst(Const_base(Const_string (Ident.unique_name id))); lam]) + [Lconst(Const_base(Const_string (toplevel_name id))); lam]) let toploop_setvalue_id id = toploop_setvalue id (Lvar id) @@ -395,6 +403,9 @@ let transl_toplevel_item = function lambda_unit | Tstr_class cl_list -> let ids = List.map (fun (i, _, _, _) -> i) cl_list in + List.iter + (fun id -> set_toplevel_name id (Ident.name id ^ "(c)")) + ids; Lletrec(List.map (fun (id, arity, meths, cl) -> (id, transl_class ids id arity meths cl)) diff --git a/bytecomp/translmod.mli b/bytecomp/translmod.mli index eff31a8625..ffcb0a7ebe 100644 --- a/bytecomp/translmod.mli +++ b/bytecomp/translmod.mli @@ -22,5 +22,6 @@ val transl_implementation: string -> structure * module_coercion -> lambda val transl_store_implementation: string -> structure * module_coercion -> int * lambda val transl_toplevel_definition: structure -> lambda +val toplevel_name: Ident.t -> string val primitive_declarations: string list ref diff --git a/toplevel/toploop.ml b/toplevel/toploop.ml index 5f7daf2886..5190d229f1 100644 --- a/toplevel/toploop.ml +++ b/toplevel/toploop.ml @@ -91,7 +91,7 @@ let pr_item env ppf = function | _ -> fprintf ppf "@[<2>%a =@ %a@]" (Printtyp.value_description id) decl - (print_value env (getvalue (Ident.unique_name id))) + (print_value env (getvalue (Translmod.toplevel_name id))) decl.val_type end; rem |