[m-rev.] for review: rename long class names in java
Peter Wang
novalazy at gmail.com
Wed Jul 22 16:26:26 AEST 2009
Branches: main
compiler/mlds_to_java.m:
Add an extra pass to rename class names which are too long. Each class
results in a separate `.class' file, so a long class name may exceed
filesystem limits. This supercedes a previous workaround which
shortened the names of AddrOf wrapper classes. The problem occurs more
generally.
Change the access on AddrOf wrapper classes to `private'.
diff --git a/compiler/mlds_to_java.m b/compiler/mlds_to_java.m
index b69a97e..9da06a2 100644
--- a/compiler/mlds_to_java.m
+++ b/compiler/mlds_to_java.m
@@ -110,6 +110,7 @@
:- import_module assoc_list.
:- import_module bool.
+:- import_module char.
:- import_module int.
:- import_module library.
:- import_module list.
@@ -118,6 +119,7 @@
:- import_module pair.
:- import_module set.
:- import_module string.
+:- import_module svmap.
:- import_module term.
%-----------------------------------------------------------------------------%
@@ -331,7 +333,10 @@ output_java_src_file(ModuleInfo, Indent, MLDS, !IO) :-
% Create wrappers in MLDS for all pointer addressed methods.
generate_code_addr_wrappers(Indent + 1, CodeAddrs, [], WrapperDefns),
- Defns = WrapperDefns ++ Defns0,
+ Defns1 = WrapperDefns ++ Defns0,
+
+ % Rename classes with excessively long names.
+ shorten_long_class_names(MLDS_ModuleName, Defns1, Defns),
% Get the foreign code for Java
% XXX We should not ignore _RevImports.
@@ -814,7 +819,7 @@ generate_addr_wrapper_class(Interface, Context, CodeAddr, ClassDefn) :-
ClassCtors = [],
ClassName = entity_type(MangledClassEntityName, 0),
ClassContext = Context,
- ClassFlags = ml_gen_type_decl_flags,
+ ClassFlags = addr_wrapper_decl_flags,
ClassBodyDefn = mlds_class_defn(mlds_class, ClassImports,
ClassExtends, ClassImplements, ClassCtors, ClassMembers),
ClassBody = mlds_class(ClassBodyDefn),
@@ -840,7 +845,7 @@ create_addr_wrapper_name(CodeAddr, MangledClassEntityName) :-
mangle_sym_name_for_java(ModuleQualifierSym, convert_qual_kind(QualKind),
"__", ModuleNameStr),
ClassEntityName = "addrOf__" ++ ModuleNameStr ++ "__" ++ PredName,
- MangledClassEntityName = name_mangle_maybe_shorten(ClassEntityName).
+ MangledClassEntityName = name_mangle_no_leading_digit(ClassEntityName).
% Generates a call methods which calls the original method we have
% created the wrapper for.
@@ -1007,6 +1012,500 @@ pred_label_string(mlds_special_pred_label(PredName, MaybeTypeModule, TypeName,
PredLabelStr = PredLabelStr1 ++ MangledTypeName ++ "_" ++
string.int_to_string(TypeArity).
+:- func addr_wrapper_decl_flags = mlds_decl_flags.
+
+addr_wrapper_decl_flags = MLDS_DeclFlags :-
+ Access = acc_private,
+ PerInstance = one_copy,
+ Virtuality = non_virtual,
+ Finality = final,
+ Constness = const,
+ Abstractness = concrete,
+ MLDS_DeclFlags = init_decl_flags(Access, PerInstance,
+ Virtuality, Finality, Constness, Abstractness).
+
+%-----------------------------------------------------------------------------%
+%
+% Code to rename long class names.
+%
+
+:- type class_name_renaming
+ ---> class_name_renaming(
+ cnr_module :: mlds_module_name,
+ cnr_renaming :: map(mlds_class_name, mlds_class_name)
+ ).
+
+ % Rename class names which are too long. Each class results in a separate
+ % `.class' file, so a long class name may exceed filesystem limits.
+ % The long names tend to be automatically generated by the compiler.
+ %
+:- pred shorten_long_class_names(mlds_module_name::in,
+ list(mlds_defn)::in, list(mlds_defn)::out) is det.
+
+shorten_long_class_names(ModuleName, Defns0, Defns) :-
+ list.map_foldl(maybe_shorten_long_class_name, Defns0, Defns1,
+ map.init, RenamingMap),
+ ( map.is_empty(RenamingMap) ->
+ Defns = Defns1
+ ;
+ Renaming = class_name_renaming(ModuleName, RenamingMap),
+ list.map(rename_class_names_defn(Renaming), Defns1, Defns)
+ ).
+
+:- pred maybe_shorten_long_class_name(mlds_defn::in, mlds_defn::out,
+ map(mlds_class_name, mlds_class_name)::in,
+ map(mlds_class_name, mlds_class_name)::out) is det.
+
+maybe_shorten_long_class_name(!Defn, !Renaming) :-
+ Access = access(!.Defn ^ mlds_decl_flags),
+ (
+ % We only rename private classes for now.
+ Access = acc_private,
+ EntityName0 = !.Defn ^ mlds_entity_name,
+ (
+ EntityName0 = entity_type(ClassName0, Arity),
+ ClassName = shorten_class_name(ClassName0),
+ ( ClassName \= ClassName0 ->
+ EntityName = entity_type(ClassName, Arity),
+ !Defn ^ mlds_entity_name := EntityName,
+ svmap.det_insert(ClassName0, ClassName, !Renaming)
+ ;
+ true
+ )
+ ;
+ ( EntityName0 = entity_function(_, _, _, _)
+ ; EntityName0 = entity_data(_)
+ ; EntityName0 = entity_export(_)
+ )
+ )
+ ;
+ ( Access = acc_public
+ ; Access = acc_protected
+ ; Access = acc_default
+ ; Access = acc_local
+ )
+ ).
+
+:- func shorten_class_name(string) = string.
+
+shorten_class_name(ClassName0) = ClassName :-
+ MangledClassName0 = name_mangle_no_leading_digit(ClassName0),
+ ( string.length(MangledClassName0) < 100 ->
+ ClassName = ClassName0
+ ;
+ % The new name must not require name mangling, as then the name may
+ % again be too long. We replace all non-alphanumeric or underscore
+ % characters by underscores. The s_ prefix avoids having f_ as the
+ % prefix which is used to indicate a mangled name.
+ Left = string.left(ClassName0, 44),
+ Right = string.right(ClassName0, 44),
+ Hash = string.hash(ClassName0) /\ 0xffffffff,
+ GenName = string.format("s_%s_%08x_%s", [s(Left), i(Hash), s(Right)]),
+ GenList = string.to_char_list(GenName),
+ FilterList = list.map(replace_non_alphanum_underscore, GenList),
+ ClassName = string.from_char_list(FilterList)
+ ).
+
+:- func replace_non_alphanum_underscore(char) = char.
+
+replace_non_alphanum_underscore(Char) =
+ ( char.is_alnum_or_underscore(Char) ->
+ Char
+ ;
+ '_'
+ ).
+
+:- pred rename_class_names_defn(class_name_renaming::in,
+ mlds_defn::in, mlds_defn::out) is det.
+
+rename_class_names_defn(Renaming, !Defn) :-
+ EntityDefn0 = !.Defn ^ mlds_entity_defn,
+ (
+ EntityDefn0 = mlds_data(Type0, Initializer0, GCStatement),
+ rename_class_names_type(Renaming, Type0, Type),
+ rename_class_names_initializer(Renaming, Initializer0, Initializer),
+ EntityDefn = mlds_data(Type, Initializer, GCStatement)
+ ;
+ EntityDefn0 = mlds_function(MaybePPId, FuncParams0, FuncBody0,
+ Attributes, EnvVarNames),
+ rename_class_names_func_params(Renaming, FuncParams0, FuncParams),
+ (
+ FuncBody0 = body_defined_here(Statement0),
+ rename_class_names_statement(Renaming, Statement0, Statement),
+ FuncBody = body_defined_here(Statement)
+ ;
+ FuncBody0 = body_external,
+ FuncBody = body_external
+ ),
+ EntityDefn = mlds_function(MaybePPId, FuncParams, FuncBody,
+ Attributes, EnvVarNames)
+ ;
+ EntityDefn0 = mlds_class(mlds_class_defn(ClassKind, Imports, Inherits,
+ Implements, Ctors0, Members0)),
+ list.map(rename_class_names_defn(Renaming), Ctors0, Ctors),
+ list.map(rename_class_names_defn(Renaming), Members0, Members),
+ EntityDefn = mlds_class(mlds_class_defn(ClassKind, Imports, Inherits,
+ Implements, Ctors, Members))
+ ),
+ !Defn ^ mlds_entity_defn := EntityDefn.
+
+:- pred rename_class_names_type(class_name_renaming::in,
+ mlds_type::in, mlds_type::out) is det.
+
+rename_class_names_type(Renaming, !Type) :-
+ (
+ !.Type = mlds_mercury_array_type(Type0),
+ rename_class_names_type(Renaming, Type0, Type),
+ !:Type = mlds_mercury_array_type(Type)
+ ;
+ !.Type = mlds_cont_type(RetTypes0),
+ list.map(rename_class_names_type(Renaming), RetTypes0, RetTypes),
+ !:Type = mlds_cont_type(RetTypes)
+ ;
+ !.Type = mlds_class_type(Name0, Arity, ClassKind),
+ Name0 = qual(ModuleName, QualKind, UnqualName0),
+ (
+ Renaming = class_name_renaming(ModuleName, RenamingMap),
+ map.search(RenamingMap, UnqualName0, UnqualName)
+ ->
+ Name = qual(ModuleName, QualKind, UnqualName),
+ !:Type = mlds_class_type(Name, Arity, ClassKind)
+ ;
+ true
+ )
+ ;
+ !.Type = mlds_array_type(Type0),
+ rename_class_names_type(Renaming, Type0, Type),
+ !:Type = mlds_array_type(Type)
+ ;
+ !.Type = mlds_ptr_type(Type0),
+ rename_class_names_type(Renaming, Type0, Type),
+ !:Type = mlds_ptr_type(Type)
+ ;
+ !.Type = mlds_func_type(FuncParams0),
+ rename_class_names_func_params(Renaming, FuncParams0, FuncParams),
+ !:Type = mlds_func_type(FuncParams)
+ ;
+ ( !.Type = mercury_type(_, _, _)
+ ; !.Type = mlds_commit_type
+ ; !.Type = mlds_native_bool_type
+ ; !.Type = mlds_native_int_type
+ ; !.Type = mlds_native_float_type
+ ; !.Type = mlds_native_char_type
+ ; !.Type = mlds_foreign_type(_)
+ ; !.Type = mlds_generic_type
+ ; !.Type = mlds_generic_env_ptr_type
+ ; !.Type = mlds_type_info_type
+ ; !.Type = mlds_pseudo_type_info_type
+ ; !.Type = mlds_rtti_type(_)
+ ; !.Type = mlds_tabling_type(_)
+ ; !.Type = mlds_unknown_type
+ )
+ ).
+
+:- pred rename_class_names_initializer(class_name_renaming::in,
+ mlds_initializer::in, mlds_initializer::out) is det.
+
+rename_class_names_initializer(Renaming, !Initializer) :-
+ (
+ !.Initializer = init_obj(Rval0),
+ rename_class_names_rval(Renaming, Rval0, Rval),
+ !:Initializer = init_obj(Rval)
+ ;
+ !.Initializer = init_struct(Type0, Initializers0),
+ rename_class_names_type(Renaming, Type0, Type),
+ list.map(rename_class_names_initializer(Renaming), Initializers0,
+ Initializers),
+ !:Initializer = init_struct(Type, Initializers)
+ ;
+ !.Initializer = init_array(Initializers0),
+ list.map(rename_class_names_initializer(Renaming), Initializers0,
+ Initializers),
+ !:Initializer = init_array(Initializers)
+ ;
+ !.Initializer = no_initializer
+ ).
+
+:- pred rename_class_names_func_params(class_name_renaming::in,
+ mlds_func_params::in, mlds_func_params::out) is det.
+
+rename_class_names_func_params(Renaming, !FuncParams) :-
+ !.FuncParams = mlds_func_params(Arguments0, RetTypes0),
+ list.map(rename_class_names_argument(Renaming), Arguments0, Arguments),
+ list.map(rename_class_names_type(Renaming), RetTypes0, RetTypes),
+ !:FuncParams = mlds_func_params(Arguments, RetTypes).
+
+:- pred rename_class_names_argument(class_name_renaming::in,
+ mlds_argument::in, mlds_argument::out) is det.
+
+rename_class_names_argument(Renaming, !Argument) :-
+ !.Argument = mlds_argument(Name, Type0, GCStatement),
+ rename_class_names_type(Renaming, Type0, Type),
+ !:Argument = mlds_argument(Name, Type, GCStatement).
+
+:- pred rename_class_names_statement(class_name_renaming::in,
+ statement::in, statement::out) is det.
+
+rename_class_names_statement(Renaming, !Statement) :-
+ !.Statement = statement(Stmt0, Context),
+ rename_class_names_stmt(Renaming, Stmt0, Stmt),
+ !:Statement = statement(Stmt, Context).
+
+:- pred rename_class_names_stmt(class_name_renaming::in,
+ mlds_stmt::in, mlds_stmt::out) is det.
+
+rename_class_names_stmt(Renaming, !Stmt) :-
+ (
+ !.Stmt = ml_stmt_block(Defns0, Statements0),
+ list.map(rename_class_names_defn(Renaming), Defns0, Defns),
+ list.map(rename_class_names_statement(Renaming),
+ Statements0, Statements),
+ !:Stmt = ml_stmt_block(Defns, Statements)
+ ;
+ !.Stmt = ml_stmt_while(Rval0, Statement0, AtLeastOnce),
+ rename_class_names_rval(Renaming, Rval0, Rval),
+ rename_class_names_statement(Renaming, Statement0, Statement),
+ !:Stmt = ml_stmt_while(Rval, Statement, AtLeastOnce)
+ ;
+ !.Stmt = ml_stmt_if_then_else(Rval0, Statement0, MaybeElse0),
+ rename_class_names_rval(Renaming, Rval0, Rval),
+ rename_class_names_statement(Renaming, Statement0, Statement),
+ (
+ MaybeElse0 = yes(Else0),
+ rename_class_names_statement(Renaming, Else0, Else),
+ MaybeElse = yes(Else)
+ ;
+ MaybeElse0 = no,
+ MaybeElse = no
+ ),
+ !:Stmt = ml_stmt_if_then_else(Rval, Statement, MaybeElse)
+ ;
+ !.Stmt = ml_stmt_switch(Type0, Rval0, SwitchRange, Cases0, Default0),
+ rename_class_names_type(Renaming, Type0, Type),
+ rename_class_names_rval(Renaming, Rval0, Rval),
+ list.map(rename_class_names_switch_case(Renaming), Cases0, Cases),
+ rename_class_names_switch_default(Renaming, Default0, Default),
+ !:Stmt = ml_stmt_switch(Type, Rval, SwitchRange, Cases, Default)
+ ;
+ !.Stmt = ml_stmt_label(_)
+ ;
+ !.Stmt = ml_stmt_goto(_)
+ ;
+ !.Stmt = ml_stmt_computed_goto(Rval0, Labels),
+ rename_class_names_rval(Renaming, Rval0, Rval),
+ !:Stmt = ml_stmt_computed_goto(Rval, Labels)
+ ;
+ !.Stmt = ml_stmt_call(Signature0, Rval0, MaybeThis, Rvals0, RetLvals0,
+ CallKind),
+ Signature0 = mlds_func_signature(ArgTypes0, RetTypes0),
+ list.map(rename_class_names_type(Renaming), ArgTypes0, ArgTypes),
+ list.map(rename_class_names_type(Renaming), RetTypes0, RetTypes),
+ Signature = mlds_func_signature(ArgTypes, RetTypes),
+ rename_class_names_rval(Renaming, Rval0, Rval),
+ list.map(rename_class_names_rval(Renaming), Rvals0, Rvals),
+ list.map(rename_class_names_lval(Renaming), RetLvals0, RetLvals),
+ !:Stmt = ml_stmt_call(Signature, Rval, MaybeThis, Rvals, RetLvals,
+ CallKind)
+ ;
+ !.Stmt = ml_stmt_return(Rvals0),
+ list.map(rename_class_names_rval(Renaming), Rvals0, Rvals),
+ !:Stmt = ml_stmt_return(Rvals)
+ ;
+ !.Stmt = ml_stmt_try_commit(Lval0, StatementA0, StatementB0),
+ rename_class_names_lval(Renaming, Lval0, Lval),
+ rename_class_names_statement(Renaming, StatementA0, StatementA),
+ rename_class_names_statement(Renaming, StatementB0, StatementB),
+ !:Stmt = ml_stmt_try_commit(Lval, StatementA, StatementB)
+ ;
+ !.Stmt = ml_stmt_do_commit(Rval0),
+ rename_class_names_rval(Renaming, Rval0, Rval),
+ !:Stmt = ml_stmt_do_commit(Rval)
+ ;
+ !.Stmt = ml_stmt_atomic(AtomicStatement0),
+ rename_class_names_atomic(Renaming, AtomicStatement0, AtomicStatement),
+ !:Stmt = ml_stmt_atomic(AtomicStatement)
+ ).
+
+:- pred rename_class_names_switch_case(class_name_renaming::in,
+ mlds_switch_case::in, mlds_switch_case::out) is det.
+
+rename_class_names_switch_case(Renaming, !Case) :-
+ !.Case = mlds_switch_case(MatchConds, Statement0),
+ % The rvals in the match conditions shouldn't need renaming.
+ rename_class_names_statement(Renaming, Statement0, Statement),
+ !:Case = mlds_switch_case(MatchConds, Statement).
+
+:- pred rename_class_names_switch_default(class_name_renaming::in,
+ mlds_switch_default::in, mlds_switch_default::out) is det.
+
+rename_class_names_switch_default(Renaming, !Default) :-
+ (
+ !.Default = default_is_unreachable
+ ;
+ !.Default = default_do_nothing
+ ;
+ !.Default = default_case(Statement0),
+ rename_class_names_statement(Renaming, Statement0, Statement),
+ !:Default = default_case(Statement)
+ ).
+
+:- pred rename_class_names_atomic(class_name_renaming::in,
+ mlds_atomic_statement::in, mlds_atomic_statement::out) is det.
+
+rename_class_names_atomic(Renaming, !Statement) :-
+ (
+ !.Statement = assign(Lval0, Rval0),
+ rename_class_names_lval(Renaming, Lval0, Lval),
+ rename_class_names_rval(Renaming, Rval0, Rval),
+ !:Statement = assign(Lval, Rval)
+ ;
+ !.Statement = assign_if_in_heap(Lval0, Rval0),
+ rename_class_names_lval(Renaming, Lval0, Lval),
+ rename_class_names_rval(Renaming, Rval0, Rval),
+ !:Statement = assign_if_in_heap(Lval, Rval)
+ ;
+ !.Statement = delete_object(Rval0),
+ rename_class_names_rval(Renaming, Rval0, Rval),
+ !:Statement = delete_object(Rval)
+ ;
+ !.Statement = new_object(TargetLval0, MaybeTag, HasSecTag, Type0,
+ MaybeSize, MaybeCtorName, Args0, ArgTypes0, MayUseAtomic),
+ rename_class_names_lval(Renaming, TargetLval0, TargetLval),
+ rename_class_names_type(Renaming, Type0, Type),
+ list.map(rename_class_names_rval(Renaming), Args0, Args),
+ list.map(rename_class_names_type(Renaming), ArgTypes0, ArgTypes),
+ !:Statement = new_object(TargetLval, MaybeTag, HasSecTag, Type,
+ MaybeSize, MaybeCtorName, Args, ArgTypes, MayUseAtomic)
+ ;
+ ( !.Statement = comment(_)
+ ; !.Statement = gc_check
+ ; !.Statement = mark_hp(_)
+ ; !.Statement = restore_hp(_)
+ ; !.Statement = trail_op(_)
+ ; !.Statement = inline_target_code(_, _)
+ ; !.Statement = outline_foreign_proc(_, _, _, _)
+ )
+ ).
+
+:- pred rename_class_names_lval(class_name_renaming::in,
+ mlds_lval::in, mlds_lval::out) is det.
+
+rename_class_names_lval(Renaming, !Lval) :-
+ (
+ !.Lval = ml_field(Tag, Address0, FieldId0, FieldType0, PtrType0),
+ rename_class_names_rval(Renaming, Address0, Address),
+ rename_class_names_field_id(Renaming, FieldId0, FieldId),
+ rename_class_names_type(Renaming, FieldType0, FieldType),
+ rename_class_names_type(Renaming, PtrType0, PtrType),
+ !:Lval = ml_field(Tag, Address, FieldId, FieldType, PtrType)
+ ;
+ !.Lval = ml_mem_ref(Rval0, Type0),
+ rename_class_names_rval(Renaming, Rval0, Rval),
+ rename_class_names_type(Renaming, Type0, Type),
+ !:Lval = ml_mem_ref(Rval, Type)
+ ;
+ !.Lval = ml_global_var_ref(_)
+ ;
+ !.Lval = ml_var(Var, Type0),
+ rename_class_names_type(Renaming, Type0, Type),
+ !:Lval = ml_var(Var, Type)
+ ).
+
+:- pred rename_class_names_field_id(class_name_renaming::in,
+ mlds_field_id::in, mlds_field_id::out) is det.
+
+rename_class_names_field_id(Renaming, !FieldId) :-
+ (
+ !.FieldId = ml_field_offset(Rval0),
+ rename_class_names_rval(Renaming, Rval0, Rval),
+ !:FieldId = ml_field_offset(Rval)
+ ;
+ !.FieldId = ml_field_named(Name, Type0),
+ rename_class_names_type(Renaming, Type0, Type),
+ !:FieldId = ml_field_named(Name, Type)
+ ).
+
+:- pred rename_class_names_rval(class_name_renaming::in,
+ mlds_rval::in, mlds_rval::out) is det.
+
+rename_class_names_rval(Renaming, !Rval) :-
+ (
+ !.Rval = ml_lval(Lval0),
+ rename_class_names_lval(Renaming, Lval0, Lval),
+ !:Rval = ml_lval(Lval)
+ ;
+ !.Rval = ml_mkword(Tag, Rval0),
+ rename_class_names_rval(Renaming, Rval0, Rval),
+ !:Rval = ml_mkword(Tag, Rval)
+ ;
+ !.Rval = ml_const(RvalConst0),
+ rename_class_names_rval_const(Renaming, RvalConst0, RvalConst),
+ !:Rval = ml_const(RvalConst)
+ ;
+ !.Rval = ml_unop(Op0, Rval0),
+ rename_class_names_unary_op(Renaming, Op0, Op),
+ rename_class_names_rval(Renaming, Rval0, Rval),
+ !:Rval = ml_unop(Op, Rval)
+ ;
+ !.Rval = ml_binop(Op, RvalA0, RvalB0),
+ rename_class_names_rval(Renaming, RvalA0, RvalA),
+ rename_class_names_rval(Renaming, RvalB0, RvalB),
+ !:Rval = ml_binop(Op, RvalA, RvalB)
+ ;
+ !.Rval = ml_mem_addr(Lval0),
+ rename_class_names_lval(Renaming, Lval0, Lval),
+ !:Rval = ml_mem_addr(Lval)
+ ;
+ !.Rval = ml_self(Type0),
+ rename_class_names_type(Renaming, Type0, Type),
+ !:Rval = ml_self(Type)
+ ).
+
+:- pred rename_class_names_rval_const(class_name_renaming::in,
+ mlds_rval_const::in, mlds_rval_const::out) is det.
+
+rename_class_names_rval_const(Renaming, !Const) :-
+ (
+ !.Const = mlconst_foreign(Lang, String, Type0),
+ rename_class_names_type(Renaming, Type0, Type),
+ !:Const = mlconst_foreign(Lang, String, Type)
+ ;
+ !.Const = mlconst_null(Type0),
+ rename_class_names_type(Renaming, Type0, Type),
+ !:Const = mlconst_null(Type)
+ ;
+ ( !.Const = mlconst_true
+ ; !.Const = mlconst_false
+ ; !.Const = mlconst_int(_)
+ ; !.Const = mlconst_float(_)
+ ; !.Const = mlconst_string(_)
+ ; !.Const = mlconst_multi_string(_)
+ ; !.Const = mlconst_named_const(_)
+ ; !.Const = mlconst_code_addr(_)
+ ; !.Const = mlconst_data_addr(_)
+ )
+ ).
+
+:- pred rename_class_names_unary_op(class_name_renaming::in,
+ mlds_unary_op::in, mlds_unary_op::out) is det.
+
+rename_class_names_unary_op(Renaming, !Op) :-
+ (
+ !.Op = box(Type0),
+ rename_class_names_type(Renaming, Type0, Type),
+ !:Op = box(Type)
+ ;
+ !.Op = unbox(Type0),
+ rename_class_names_type(Renaming, Type0, Type),
+ !:Op = unbox(Type)
+ ;
+ !.Op = cast(Type0),
+ rename_class_names_type(Renaming, Type0, Type),
+ !:Op = cast(Type)
+ ;
+ !.Op = std_unop(_)
+ ).
+
%-----------------------------------------------------------------------------%
%
% Code to output calls to module initialisers.
@@ -2127,31 +2626,6 @@ output_mlds_var_name(mlds_var_name(Name, no), !IO) :-
output_mlds_var_name(mlds_var_name(Name, yes(Num)), !IO) :-
output_mangled_name(string.format("%s_%d", [s(Name), i(Num)]), !IO).
- % Long class names can cause problems as Java uses separate `.class' files
- % for nested classes, with file names derived from the class name. For
- % some reason javac considers file names greater than about 256 characters
- % to be too long and aborts.
- %
- % This workaround forces mangled names which are too long (by an arbitrary
- % limit) to be shortened (by an arbitrary method).
- %
- % Currently we only apply this workaround on the wrapper classes generated
- % for taking the address of a predicate, in order to build the standard
- % library, but it will probably be needed consistently.
- %
-:- func name_mangle_maybe_shorten(string) = string.
-
-name_mangle_maybe_shorten(Name) = MangledName :-
- MangledName0 = name_mangle_no_leading_digit(Name),
- ( string.length(MangledName0) < 100 ->
- MangledName = MangledName0
- ;
- Left = string.left(MangledName0, 50),
- Right = string.right(MangledName0, 25),
- Hash = string.hash(MangledName0),
- MangledName = string.format("%s_%x_%s", [s(Left), i(Hash), s(Right)])
- ).
-
%-----------------------------------------------------------------------------%
%
% Code to output types
@@ -3739,34 +4213,26 @@ output_int_const(N, !IO) :-
io::uo) is det.
mlds_output_code_addr(CodeAddr, IsCall, !IO) :-
- CodeAddr = code_addr_proc(Label, _Sig),
- (
- IsCall = no,
- % Not a function call, so we are taking the address of the
- % wrapper for that function (method).
- io.write_string("new ", !IO),
- create_addr_wrapper_name(CodeAddr, MangledClassEntityName),
- io.write_string(flip_initial_case(MangledClassEntityName), !IO),
- io.write_string("_0()", !IO)
- ;
- IsCall = yes,
- output_fully_qualified_proc_label(Label, !IO)
- ).
-mlds_output_code_addr(CodeAddr, IsCall, !IO) :-
- CodeAddr = code_addr_internal(Label, SeqNum, _Sig),
(
IsCall = no,
% Not a function call, so we are taking the address of the
% wrapper for that function (method).
io.write_string("new ", !IO),
- create_addr_wrapper_name(CodeAddr, MangledClassEntityName),
+ create_addr_wrapper_name(CodeAddr, MangledClassEntityName0),
+ MangledClassEntityName = shorten_class_name(MangledClassEntityName0),
io.write_string(flip_initial_case(MangledClassEntityName), !IO),
io.write_string("_0()", !IO)
;
IsCall = yes,
- output_fully_qualified_proc_label(Label, !IO),
- io.write_string("_", !IO),
- io.write_int(SeqNum, !IO)
+ (
+ CodeAddr = code_addr_proc(Label, _Sig),
+ output_fully_qualified_proc_label(Label, !IO)
+ ;
+ CodeAddr = code_addr_internal(Label, SeqNum, _Sig),
+ output_fully_qualified_proc_label(Label, !IO),
+ io.write_string("_", !IO),
+ io.write_int(SeqNum, !IO)
+ )
).
:- pred mlds_output_proc_label(mlds_proc_label::in, io::di, io::uo) is det.
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list