[m-rev.] for review: separate mlconst_int
Peter Wang
novalazy at gmail.com
Fri Oct 9 16:20:43 AEDT 2009
Branches: main
Add `mlconst_enum' and `mlconst_char' to handle constants currently
represented by `mlconst_int'. This should make the Java backend more robust,
where integers cannot (always) be used in place of characters or enumerations.
compiler/mlds.m:
Add `mlconst_enum' and `mlconst_char' functors to the `ml_const' type.
compiler/ml_switch_gen.m:
compiler/ml_unify_gen.m:
compiler/ml_util.m:
Generate `mlconst_char' or `mlconst_enum' from HLDS `int_tag' values.
compiler/ml_type_gen.m:
Generate `mlconst_enum's for enumeration constants.
compiler/ml_code_util.m:
Add predicate to return MLDS type for characters.
compiler/mlds_to_java.m:
Simplify the backend as allowed by the new functors.
compiler/ml_lookup_switch.m:
compiler/ml_tailcall.m:
compiler/mlds_to_c.m:
compiler/mlds_to_gcc.m:
compiler/mlds_to_il.m:
compiler/mlds_to_managed.m:
compiler/rtti_to_mlds.m:
Conform to changes.
diff --git a/compiler/ml_code_util.m b/compiler/ml_code_util.m
index 097a162..3967bff 100644
--- a/compiler/ml_code_util.m
+++ b/compiler/ml_code_util.m
@@ -129,6 +129,10 @@
%
:- func ml_int_type = mlds_type.
+ % Return the MLDS type corresponding to a Mercury char type.
+ %
+:- func ml_char_type = mlds_type.
+
% Allocate some fresh type variables, with kind `star', to use as
% the Mercury types of boxed objects (e.g. to get the argument types
% for tuple constructors or closure constructors). Note that this
@@ -800,6 +804,10 @@ ml_int_type =
mercury_type(int_type, ctor_cat_builtin(cat_builtin_int),
non_foreign_type(int_type)).
+ml_char_type =
+ mercury_type(char_type, ctor_cat_builtin(cat_builtin_char),
+ non_foreign_type(char_type)).
+
ml_make_boxed_types(Arity) = BoxedTypes :-
varset.init(TypeVarSet0),
varset.new_vars(TypeVarSet0, Arity, BoxedTypeVars, _TypeVarSet),
diff --git a/compiler/ml_lookup_switch.m b/compiler/ml_lookup_switch.m
index a8adb9b..27c9103 100644
--- a/compiler/ml_lookup_switch.m
+++ b/compiler/ml_lookup_switch.m
@@ -616,14 +616,16 @@ ml_default_value_for_type(MLDS_Type) = DefaultRval :-
MLDS_Type = mlds_native_int_type,
DefaultRval = ml_const(mlconst_int(0))
;
+ MLDS_Type = mlds_native_char_type,
+ DefaultRval = ml_const(mlconst_char(0))
+ ;
MLDS_Type = mlds_native_bool_type,
DefaultRval = ml_const(mlconst_false)
;
MLDS_Type = mlds_native_float_type,
DefaultRval = ml_const(mlconst_float(0.0))
;
- ( MLDS_Type = mlds_native_char_type
- ; MLDS_Type = mercury_type(_, _, _)
+ ( MLDS_Type = mercury_type(_, _, _)
; MLDS_Type = mlds_mercury_array_type(_)
; MLDS_Type = mlds_foreign_type(_)
; MLDS_Type = mlds_class_type(_, _, _)
diff --git a/compiler/ml_switch_gen.m b/compiler/ml_switch_gen.m
index ecfe4e6..cef55a5 100644
--- a/compiler/ml_switch_gen.m
+++ b/compiler/ml_switch_gen.m
@@ -494,7 +494,8 @@ ml_switch_generate_mlds_switch(Cases, Var, CodeModel, CanFail, Context,
ml_gen_var(!.Info, Var, Lval),
Rval = ml_lval(Lval),
ml_switch_gen_range(!.Info, MLDS_Type, Range),
- ml_switch_generate_mlds_cases(Cases, CodeModel, MLDS_Cases, !Info),
+ ml_switch_generate_mlds_cases(MLDS_Type, Cases, CodeModel, MLDS_Cases,
+ !Info),
ml_switch_generate_default(CanFail, CodeModel, Context, Default, !Info),
SwitchStmt0 = ml_stmt_switch(MLDS_Type, Rval, Range, MLDS_Cases, Default),
MLDS_Context = mlds_make_context(Context),
@@ -517,34 +518,45 @@ ml_switch_gen_range(Info, MLDS_Type, Range) :-
Range = mlds_switch_range_unknown
).
-:- pred ml_switch_generate_mlds_cases(list(tagged_case)::in,
+:- pred ml_switch_generate_mlds_cases(mlds_type::in, list(tagged_case)::in,
code_model::in, list(mlds_switch_case)::out,
ml_gen_info::in, ml_gen_info::out) is det.
-ml_switch_generate_mlds_cases([], _, [], !Info).
-ml_switch_generate_mlds_cases([TaggedCase | TaggedCases], CodeModel,
+ml_switch_generate_mlds_cases(_, [], _, [], !Info).
+ml_switch_generate_mlds_cases(MLDS_Type, [TaggedCase | TaggedCases], CodeModel,
[MLDS_Case | MLDS_Cases], !Info) :-
- ml_switch_generate_mlds_case(TaggedCase, CodeModel, MLDS_Case, !Info),
- ml_switch_generate_mlds_cases(TaggedCases, CodeModel, MLDS_Cases, !Info).
+ ml_switch_generate_mlds_case(MLDS_Type, TaggedCase, CodeModel,
+ MLDS_Case, !Info),
+ ml_switch_generate_mlds_cases(MLDS_Type, TaggedCases, CodeModel,
+ MLDS_Cases, !Info).
-:- pred ml_switch_generate_mlds_case(tagged_case::in, code_model::in,
- mlds_switch_case::out, ml_gen_info::in, ml_gen_info::out) is det.
+:- pred ml_switch_generate_mlds_case(mlds_type::in, tagged_case::in,
+ code_model::in, mlds_switch_case::out,
+ ml_gen_info::in, ml_gen_info::out) is det.
-ml_switch_generate_mlds_case(TaggedCase, CodeModel, MLDS_Case, !Info) :-
+ml_switch_generate_mlds_case(MLDS_Type, TaggedCase, CodeModel, MLDS_Case,
+ !Info) :-
TaggedCase = tagged_case(TaggedMainConsId, TaggedOtherConsIds, _, Goal),
- ml_tagged_cons_id_to_match_cond(TaggedMainConsId, MainCond),
- list.map(ml_tagged_cons_id_to_match_cond, TaggedOtherConsIds, OtherConds),
+ ml_tagged_cons_id_to_match_cond(MLDS_Type, TaggedMainConsId, MainCond),
+ list.map(ml_tagged_cons_id_to_match_cond(MLDS_Type), TaggedOtherConsIds,
+ OtherConds),
ml_gen_goal_as_branch_block(CodeModel, Goal, Statement, !Info),
MLDS_Case = mlds_switch_case(MainCond, OtherConds, Statement).
-:- pred ml_tagged_cons_id_to_match_cond(tagged_cons_id::in,
+:- pred ml_tagged_cons_id_to_match_cond(mlds_type::in, tagged_cons_id::in,
mlds_case_match_cond::out) is det.
-ml_tagged_cons_id_to_match_cond(TaggedConsId, MatchCond) :-
- TaggedConsId = tagged_cons_id(_ConsId, Tag),
+ml_tagged_cons_id_to_match_cond(MLDS_Type, TaggedConsId, MatchCond) :-
+ TaggedConsId = tagged_cons_id(ConsId, Tag),
(
Tag = int_tag(Int),
- Rval = ml_const(mlconst_int(Int))
+ ( ConsId = int_const(_) ->
+ Rval = ml_const(mlconst_int(Int))
+ ; ConsId = char_const(_) ->
+ Rval = ml_const(mlconst_char(Int))
+ ;
+ Rval = ml_const(mlconst_enum(Int, MLDS_Type))
+ )
;
Tag = string_tag(String),
Rval = ml_const(mlconst_string(String))
diff --git a/compiler/ml_tailcall.m b/compiler/ml_tailcall.m
index ef3b227..fe819dd 100644
--- a/compiler/ml_tailcall.m
+++ b/compiler/ml_tailcall.m
@@ -525,6 +525,8 @@ check_const(Const, Locals) = MayYieldDanglingStackRef :-
( Const = mlconst_true
; Const = mlconst_false
; Const = mlconst_int(_)
+ ; Const = mlconst_enum(_, _)
+ ; Const = mlconst_char(_)
; Const = mlconst_foreign(_, _, _)
; Const = mlconst_float(_)
; Const = mlconst_string(_)
diff --git a/compiler/ml_type_gen.m b/compiler/ml_type_gen.m
index 77fcbb9..36bde81 100644
--- a/compiler/ml_type_gen.m
+++ b/compiler/ml_type_gen.m
@@ -246,8 +246,10 @@ ml_gen_enum_type(Target, TypeCtor, TypeDefn, Ctors, TagValues,
% Generate the class members.
ValueMember = ml_gen_enum_value_member(Context),
+ MLDS_Type = mlds_class_type(QualifiedClassName, MLDS_ClassArity,
+ mlds_enum),
EnumConstMembers = list.map(
- ml_gen_enum_constant(Context, TypeCtor, TagValues),
+ ml_gen_enum_constant(Context, TypeCtor, TagValues, MLDS_Type),
Ctors),
Members = MaybeEqualityMembers ++
[ValueMember | EnumConstMembers],
@@ -297,16 +299,17 @@ ml_gen_enum_value_member(Context) =
mlds_data(mlds_native_int_type, no_initializer, gc_no_stmt)).
:- func ml_gen_enum_constant(prog_context, type_ctor, cons_tag_values,
- constructor) = mlds_defn.
+ mlds_type, constructor) = mlds_defn.
-ml_gen_enum_constant(Context, TypeCtor, ConsTagValues, Ctor) = Defn :-
+ml_gen_enum_constant(Context, TypeCtor, ConsTagValues, MLDS_Type, Ctor)
+ = Defn :-
% Figure out the value of this enumeration constant.
Ctor = ctor(_ExistQTVars, _Constraints, Name, Args, _Ctxt),
list.length(Args, Arity),
map.lookup(ConsTagValues, cons(Name, Arity, TypeCtor), TagVal),
(
TagVal = int_tag(Int),
- ConstValue = ml_const(mlconst_int(Int))
+ ConstValue = ml_const(mlconst_enum(Int, MLDS_Type))
;
TagVal = foreign_tag(ForeignLang, ForeignTagValue),
ConstValue = ml_const(mlconst_foreign(ForeignLang, ForeignTagValue,
@@ -1202,26 +1205,31 @@ ml_gen_exported_enum(_ModuleInfo, TypeTable, ExportedEnumInfo,
TypeBody = hlds_du_type(Ctors, TagValues, _CheaperTagTest,
_IsEnumOrDummy, _MaybeUserEq, _ReservedTag, _ReservedAddr,
_IsForeignType),
+ ml_gen_type_name(TypeCtor, QualifiedClassName, MLDS_ClassArity),
+ MLDS_Type = mlds_class_type(QualifiedClassName, MLDS_ClassArity,
+ mlds_enum),
list.foldl(
- generate_foreign_enum_constant(TypeCtor, Mapping, TagValues),
+ generate_foreign_enum_constant(TypeCtor, Mapping, TagValues,
+ MLDS_Type),
Ctors, [], ExportConstants),
MLDS_ExportedEnum = mlds_exported_enum(Lang, Context, TypeCtor,
ExportConstants)
).
:- pred generate_foreign_enum_constant(type_ctor::in,
- map(sym_name, string)::in, cons_tag_values::in, constructor::in,
+ map(sym_name, string)::in, cons_tag_values::in, mlds_type::in,
+ constructor::in,
list(mlds_exported_enum_constant)::in,
list(mlds_exported_enum_constant)::out) is det.
-generate_foreign_enum_constant(TypeCtor, Mapping, TagValues, Ctor,
+generate_foreign_enum_constant(TypeCtor, Mapping, TagValues, MLDS_Type, Ctor,
!ExportConstants) :-
Ctor = ctor(_, _, QualName, Args, _),
list.length(Args, Arity),
map.lookup(TagValues, cons(QualName, Arity, TypeCtor), TagVal),
(
TagVal = int_tag(Int),
- ConstValue = ml_const(mlconst_int(Int))
+ ConstValue = ml_const(mlconst_enum(Int, MLDS_Type))
;
TagVal = foreign_tag(Lang, String),
ConstValue = ml_const(mlconst_foreign(Lang, String,
diff --git a/compiler/ml_unify_gen.m b/compiler/ml_unify_gen.m
index e536adc..d2ef5fa 100644
--- a/compiler/ml_unify_gen.m
+++ b/compiler/ml_unify_gen.m
@@ -398,17 +398,12 @@ ml_gen_info_lookup_const_var_rval(Info, Var, Rval) :-
ml_gen_constant(Tag, VarType, MLDS_VarType, Rval, !Info) :-
(
Tag = int_tag(Int),
- IntRval = ml_const(mlconst_int(Int)),
- % Add an explicit cast if this is not an integer constant. Although we
- % can usually rely on implicit casts, if the char or enumeration
- % variable that the constant is assigned to is eliminated, we can end
- % up passing an int where a char or enumeration is expected. In Java,
- % and probably any language with overloading, the explicit cast is
- % required.
( VarType = int_type ->
- Rval = IntRval
+ Rval = ml_const(mlconst_int(Int))
+ ; VarType = char_type ->
+ Rval = ml_const(mlconst_char(Int))
;
- Rval = ml_unop(cast(MLDS_VarType), IntRval)
+ Rval = ml_const(mlconst_enum(Int, MLDS_VarType))
)
;
Tag = float_tag(Float),
@@ -1788,7 +1783,15 @@ ml_gen_tag_test_rval(Tag, Type, ModuleInfo, Rval) = TagTestRval :-
TagTestRval = ml_binop(float_eq, Rval, ml_const(mlconst_float(Float)))
;
Tag = int_tag(Int),
- TagTestRval = ml_binop(eq, Rval, ml_const(mlconst_int(Int)))
+ ( Type = int_type ->
+ ConstRval = ml_const(mlconst_int(Int))
+ ; Type = char_type ->
+ ConstRval = ml_const(mlconst_char(Int))
+ ;
+ MLDS_Type = mercury_type_to_mlds_type(ModuleInfo, Type),
+ ConstRval = ml_const(mlconst_enum(Int, MLDS_Type))
+ ),
+ TagTestRval = ml_binop(eq, Rval, ConstRval)
;
Tag = foreign_tag(ForeignLang, ForeignVal),
Const = ml_const(mlconst_foreign(ForeignLang, ForeignVal,
@@ -2078,14 +2081,12 @@ ml_gen_ground_term_conjunct_tag(ModuleInfo, Target, HighLevelData, VarTypes,
% Constants.
(
ConsTag = int_tag(Int),
- % We need explicit casts for enumerations so that the Java backend
- % knows to output an enumeration constant instead of a plain int.
- % See also the comment in ml_gen_constant.
- IntRval = ml_const(mlconst_int(Int)),
( VarType = int_type ->
- ConstRval = IntRval
+ ConstRval = ml_const(mlconst_int(Int))
+ ; VarType = char_type ->
+ ConstRval = ml_const(mlconst_char(Int))
;
- ConstRval = ml_unop(cast(MLDS_Type), IntRval)
+ ConstRval = ml_const(mlconst_enum(Int, MLDS_Type))
)
;
ConsTag = float_tag(Float),
diff --git a/compiler/ml_util.m b/compiler/ml_util.m
index 62913a1..c88391d 100644
--- a/compiler/ml_util.m
+++ b/compiler/ml_util.m
@@ -777,6 +777,8 @@ rval_contains_var(Rval, DataName) = ContainsVar :-
( Const = mlconst_true
; Const = mlconst_false
; Const = mlconst_int(_)
+ ; Const = mlconst_enum(_, _)
+ ; Const = mlconst_char(_)
; Const = mlconst_float(_)
; Const = mlconst_string(_)
; Const = mlconst_multi_string(_)
diff --git a/compiler/mlds.m b/compiler/mlds.m
index ddd87a5..b1e7f22 100644
--- a/compiler/mlds.m
+++ b/compiler/mlds.m
@@ -1666,6 +1666,8 @@
---> mlconst_true
; mlconst_false
; mlconst_int(int)
+ ; mlconst_enum(int, mlds_type)
+ ; mlconst_char(int)
; mlconst_float(float)
; mlconst_string(string)
; mlconst_multi_string(list(string))
diff --git a/compiler/mlds_to_c.m b/compiler/mlds_to_c.m
index 0949242..1462816 100644
--- a/compiler/mlds_to_c.m
+++ b/compiler/mlds_to_c.m
@@ -1369,7 +1369,7 @@ mlds_output_exported_enum_constant(ExportedConstant, !IO) :-
io.write_string(Name, !IO),
io.write_string(" ", !IO),
(
- Initializer = init_obj(ml_const(mlconst_int(Value)))
+ Initializer = init_obj(ml_const(mlconst_enum(Value, _)))
->
io.write_int(Value, !IO)
;
@@ -1381,7 +1381,7 @@ mlds_output_exported_enum_constant(ExportedConstant, !IO) :-
io.write_string(Value, !IO)
;
unexpected(this_file,
- "tag for export enumeration is not integer or foreign")
+ "tag for export enumeration is not enum or foreign")
),
io.nl(!IO).
@@ -4363,12 +4363,18 @@ mlds_output_rval_const(Opts, Const, !IO) :-
Const = mlconst_false,
io.write_string("MR_FALSE", !IO)
;
- Const = mlconst_int(N),
+ ( Const = mlconst_int(N)
+ ; Const = mlconst_enum(N, _)
+ ),
% We need to cast to (MR_Integer) to ensure things like 1 << 32 work
% when `Integer' is 64 bits but `int' is 32 bits.
io.write_string("(MR_Integer) ", !IO),
io.write_int(N, !IO)
;
+ Const = mlconst_char(C),
+ io.write_string("(MR_Char) ", !IO),
+ io.write_int(C, !IO)
+ ;
Const = mlconst_foreign(Lang, Value, Type),
expect(unify(Lang, lang_c), this_file,
"output_rval_const - mlconst_foreign for language other than C."),
diff --git a/compiler/mlds_to_gcc.m b/compiler/mlds_to_gcc.m
index bf66bf4..6d86a40 100644
--- a/compiler/mlds_to_gcc.m
+++ b/compiler/mlds_to_gcc.m
@@ -3663,6 +3663,10 @@ build_rval_const(mlconst_false, _, Expr) -->
gcc__build_int(0, Expr).
build_rval_const(mlconst_int(N), _, Expr) -->
gcc__build_int(N, Expr).
+build_rval_const(mlconst_enum(N, _), _, Expr) -->
+ gcc__build_int(N, Expr).
+build_rval_const(mlconst_char(N), _, Expr) -->
+ gcc__build_int(N, Expr).
build_rval_const(mlconst_foreign(_Lang, _Value, _Type), _, _) -->
{ sorry(this_file,
"foreign tags not yet supported with `--target asm'") }.
diff --git a/compiler/mlds_to_il.m b/compiler/mlds_to_il.m
index 4f06771..07016a6 100644
--- a/compiler/mlds_to_il.m
+++ b/compiler/mlds_to_il.m
@@ -577,6 +577,8 @@ rename_rval(ml_self(Type)) = ml_self(Type).
rename_const(mlconst_true) = mlconst_true.
rename_const(mlconst_false) = mlconst_false.
rename_const(mlconst_int(I)) = mlconst_int(I).
+rename_const(mlconst_enum(I, T)) = mlconst_enum(I, T).
+rename_const(mlconst_char(C)) = mlconst_char(C).
rename_const(mlconst_foreign(L, F, T)) = mlconst_foreign(L, F, T).
rename_const(mlconst_float(F)) = mlconst_float(F).
rename_const(mlconst_string(S)) = mlconst_string(S).
@@ -2362,7 +2364,10 @@ load(Rval, Instrs, !Info) :-
Const = mlconst_string(Str),
Instrs = singleton(ldstr(Str))
;
- Const = mlconst_int(Int),
+ ( Const = mlconst_int(Int)
+ ; Const = mlconst_enum(Int, _)
+ ; Const = mlconst_char(Int)
+ ),
Instrs = singleton(ldc(int32, i(Int)))
;
Const = mlconst_foreign(_Lang, _F, _T),
@@ -3730,10 +3735,9 @@ rval_to_type(ml_const(Const), Type) :-
rval_const_to_type(mlconst_data_addr(_)) = mlds_array_type(mlds_generic_type).
rval_const_to_type(mlconst_code_addr(_))
= mlds_func_type(mlds_func_params([], [])).
-rval_const_to_type(mlconst_int(_)) = MLDSType :-
- IntType = builtin_type(builtin_type_int),
- MLDSType = mercury_type(IntType, ctor_cat_builtin(cat_builtin_int),
- non_foreign_type(IntType)).
+rval_const_to_type(mlconst_int(_)) = ml_int_type.
+rval_const_to_type(mlconst_enum(_, MLDS_Type)) = MLDS_Type.
+rval_const_to_type(mlconst_char(_)) = ml_char_type.
rval_const_to_type(mlconst_foreign(_, _, _))
= sorry(this_file, "IL backend and foreign tag.").
rval_const_to_type(mlconst_float(_)) = MLDSType :-
@@ -3742,14 +3746,8 @@ rval_const_to_type(mlconst_float(_)) = MLDSType :-
non_foreign_type(FloatType)).
rval_const_to_type(mlconst_false) = mlds_native_bool_type.
rval_const_to_type(mlconst_true) = mlds_native_bool_type.
-rval_const_to_type(mlconst_string(_)) = MLDSType :-
- StrType = builtin_type(builtin_type_string),
- MLDSType = mercury_type(StrType, ctor_cat_builtin(cat_builtin_string),
- non_foreign_type(StrType)).
-rval_const_to_type(mlconst_multi_string(_)) = MLDSType :-
- StrType = builtin_type(builtin_type_string),
- MLDSType = mercury_type(StrType, ctor_cat_builtin(cat_builtin_string),
- non_foreign_type(StrType)).
+rval_const_to_type(mlconst_string(_)) = ml_string_type.
+rval_const_to_type(mlconst_multi_string(_)) = ml_string_type.
rval_const_to_type(mlconst_named_const(_))
= sorry(this_file, "IL backend and named const.").
rval_const_to_type(mlconst_null(MldsType)) = MldsType.
diff --git a/compiler/mlds_to_java.m b/compiler/mlds_to_java.m
index 6d0198f..669142c 100644
--- a/compiler/mlds_to_java.m
+++ b/compiler/mlds_to_java.m
@@ -203,13 +203,6 @@ mlds_lval_type(ml_mem_ref(_, PtrType)) =
mlds_lval_type(ml_global_var_ref(_)) = _ :-
sorry(this_file, "mlds_lval_type: global_var_ref NYI").
- % Succeeds iff the Rval represents an integer constant.
- %
-:- pred rval_is_int_const(mlds_rval::in) is semidet.
-
-rval_is_int_const(Rval) :-
- Rval = ml_const(mlconst_int(_)).
-
% Succeeds iff the Rval represents an enumeration object in the Java
% backend. We need to check both Rvals that are variables and Rvals
% that are casts. We need to know this in order to append the field name
@@ -566,9 +559,6 @@ output_exported_enum_constant(Indent, ModuleInfo, MLDS_ModuleName, MLDS_Type,
io.write_string(" ", !IO),
io.write_string(Name, !IO),
io.write_string(" = ", !IO),
- output_type(normal_style, MLDS_Type, !IO),
- io.write_string(".K", !IO),
- % XXX this will break with `:- pragma foreign_enum'
output_initializer_body(ModuleInfo, Initializer, no, MLDS_ModuleName, !IO),
io.write_string(";\n", !IO).
@@ -764,6 +754,8 @@ method_ptrs_in_rval(ml_const(RvalConst), !CodeAddrs) :-
( RvalConst = mlconst_true
; RvalConst = mlconst_false
; RvalConst = mlconst_int(_)
+ ; RvalConst = mlconst_enum(_, _)
+ ; RvalConst = mlconst_char(_)
; RvalConst = mlconst_foreign(_, _, _)
; RvalConst = mlconst_float(_)
; RvalConst = mlconst_string(_)
@@ -1547,6 +1539,8 @@ rename_class_names_rval_const(Renaming, !Const) :-
( !.Const = mlconst_true
; !.Const = mlconst_false
; !.Const = mlconst_int(_)
+ ; !.Const = mlconst_enum(_, _)
+ ; !.Const = mlconst_char(_)
; !.Const = mlconst_float(_)
; !.Const = mlconst_string(_)
; !.Const = mlconst_multi_string(_)
@@ -2010,11 +2004,10 @@ output_class_body(Indent, ModuleInfo, mlds_interface, _, AllMembers,
output_class_body(_Indent, _, mlds_struct, _, _AllMembers, _, _, _) :-
unexpected(this_file, "output_class_body: structs not supported in Java.").
-output_class_body(Indent, ModuleInfo, mlds_enum, Name, AllMembers, _, !IO) :-
+output_class_body(Indent, _ModuleInfo, mlds_enum, Name, AllMembers, _, !IO) :-
list.filter(defn_is_const, AllMembers, EnumConsts),
- Name = qual(ModuleName, _QualKind, UnqualName),
- output_enum_constants(Indent + 1, ModuleInfo, ModuleName, UnqualName,
- EnumConsts, !IO),
+ Name = qual(_ModuleName, _QualKind, UnqualName),
+ output_enum_constants(Indent + 1, UnqualName, EnumConsts, !IO),
io.nl(!IO),
output_enum_ctor(Indent + 1, UnqualName, !IO).
@@ -2049,47 +2042,49 @@ output_enum_ctor(Indent, UnqualName, !IO) :-
indent_line(Indent, !IO),
io.write_string("}\n", !IO).
-:- pred output_enum_constants(indent::in, module_info::in,
- mlds_module_name::in, mlds_entity_name::in, list(mlds_defn)::in,
- io::di, io::uo) is det.
+:- pred output_enum_constants(indent::in, mlds_entity_name::in,
+ list(mlds_defn)::in, io::di, io::uo) is det.
-output_enum_constants(Indent, ModuleInfo, EnumModuleName, EnumName,
- EnumConsts, !IO) :-
- io.write_list(EnumConsts, "\n",
- output_enum_constant(Indent, ModuleInfo, EnumModuleName, EnumName),
+output_enum_constants(Indent, EnumName, EnumConsts, !IO) :-
+ io.write_list(EnumConsts, "\n", output_enum_constant(Indent, EnumName),
!IO),
io.nl(!IO).
-:- pred output_enum_constant(indent::in, module_info::in,
- mlds_module_name::in, mlds_entity_name::in, mlds_defn::in,
+:- pred output_enum_constant(indent::in, mlds_entity_name::in, mlds_defn::in,
io::di, io::uo) is det.
-output_enum_constant(Indent, ModuleInfo, EnumModuleName, EnumName, Defn,
- !IO) :-
+output_enum_constant(Indent, EnumName, Defn, !IO) :-
Defn = mlds_defn(Name, _Context, _Flags, DefnBody),
(
DefnBody = mlds_data(_Type, Initializer, _GCStatement)
->
% Make a static instance of the constant. The MLDS doesn't retain enum
- % constructor names so it's easier to derive the name of the constant
- % later by naming them after the integer values.
- % XXX this will break with `:- pragma foreign_enum'
- indent_line(Indent, !IO),
- io.write_string("public static final ", !IO),
- output_name(EnumName, !IO),
- io.write_string(" K", !IO),
- output_initializer_body(ModuleInfo, Initializer, no, EnumModuleName,
- !IO),
- io.write_string(" = new ", !IO),
- output_name(EnumName, !IO),
- io.write_string("(", !IO),
- output_initializer_body(ModuleInfo, Initializer, no, EnumModuleName,
- !IO),
- io.write_string(");", !IO),
-
- io.write_string(" /* ", !IO),
- output_name(Name, !IO),
- io.write_string(" */", !IO)
+ % constructor names (that shouldn't be hard to change now) so it's
+ % easier to derive the name of the constant later by naming them after
+ % the integer values.
+ (
+ Initializer = init_obj(Rval),
+ ( Rval = ml_const(mlconst_enum(N, _)) ->
+ indent_line(Indent, !IO),
+ io.write_string("public static final ", !IO),
+ output_name(EnumName, !IO),
+ io.format(" K%d = new ", [i(N)], !IO),
+ output_name(EnumName, !IO),
+ io.format("(%d); ", [i(N)], !IO),
+
+ io.write_string(" /* ", !IO),
+ output_name(Name, !IO),
+ io.write_string(" */", !IO)
+ ;
+ unexpected(this_file, "output_enum_constant: not mlconst_enum")
+ )
+ ;
+ ( Initializer = no_initializer
+ ; Initializer = init_struct(_, _)
+ ; Initializer = init_array(_)
+ ),
+ unexpected(this_file, "output_enum_constant: not mlconst_enum")
+ )
;
unexpected(this_file,
"output_enum_constant: definition body was not data.")
@@ -2268,30 +2263,9 @@ output_initializer_alloc_only(_ModuleInfo, Initializer, MaybeType, _ModuleName,
output_initializer_body(_ModuleInfo, no_initializer, _, _, _, _) :-
unexpected(this_file, "output_initializer_body: no_initializer").
-output_initializer_body(ModuleInfo, init_obj(Rval), MaybeType, ModuleName,
+output_initializer_body(ModuleInfo, init_obj(Rval), _MaybeType, ModuleName,
!IO) :-
- (
- MaybeType = yes(Type),
- type_is_object(Type),
- rval_is_int_const(Rval)
- ->
- % If it is a enumeration object make a reference to a static instance.
- output_type(normal_style, Type, !IO),
- io.write_string(".K", !IO),
- output_rval_maybe_with_enum(ModuleInfo, Rval, ModuleName, !IO)
- ;
- MaybeType = yes(Type)
- ->
- % If it is an non-enumeration object, insert appropriate cast.
- % XXX The logic of this is a bit wrong. Fixing it would eliminate
- % some of the unecessary casting that happens.
- io.write_string("(", !IO),
- output_type(normal_style, Type, !IO),
- io.write_string(") ", !IO),
- output_rval(ModuleInfo, Rval, ModuleName, !IO)
- ;
- output_rval_maybe_with_enum(ModuleInfo, Rval, ModuleName, !IO)
- ).
+ output_rval(ModuleInfo, Rval, ModuleName, !IO).
output_initializer_body(ModuleInfo, init_struct(StructType, FieldInits),
_MaybeType, ModuleName, !IO) :-
@@ -3678,22 +3652,7 @@ output_atomic_stmt(Indent, ModuleInfo, FuncInfo, assign(Lval, Rval), _, !IO) :-
indent_line(Indent, !IO),
output_lval(ModuleInfo, Lval, ModuleName, !IO),
io.write_string(" = ", !IO),
- (
- LvalType = mlds_lval_type(Lval),
- type_is_object(LvalType)
- ->
- ( rval_is_int_const(Rval) ->
- % If it is a enumeration object make a reference to a static
- % instance.
- output_type(normal_style, LvalType, !IO),
- io.write_string(".K", !IO),
- output_rval(ModuleInfo, Rval, ModuleName, !IO)
- ;
- output_rval(ModuleInfo, Rval, ModuleName, !IO)
- )
- ;
- output_rval_maybe_with_enum(ModuleInfo, Rval, ModuleName, !IO)
- ),
+ output_rval(ModuleInfo, Rval, ModuleName, !IO),
io.write_string(";\n", !IO).
output_atomic_stmt(_, _, _, assign_if_in_heap(_, _), _, !IO) :-
@@ -4052,23 +4011,14 @@ output_cast_rval(ModuleInfo, Type, Expr, ModuleName, !IO) :-
!IO),
output_rval(ModuleInfo, Expr, ModuleName, !IO),
io.write_string(")", !IO)
- ;
- type_is_object(Type),
- Expr = ml_const(mlconst_int(N))
- ->
- % If it is a enumeration object make a reference to a static instance.
- output_type(normal_style, Type, !IO),
- io.write_string(".K", !IO),
- io.write_int(N, !IO)
+ ; java_builtin_type(Type, "int", _, _) ->
+ io.write_string("(int) ", !IO),
+ output_rval_maybe_with_enum(ModuleInfo, Expr, ModuleName, !IO)
;
io.write_string("(", !IO),
output_type(normal_style, Type, !IO),
io.write_string(") ", !IO),
- ( java_builtin_type(Type, "int", _, _) ->
- output_rval_maybe_with_enum(ModuleInfo, Expr, ModuleName, !IO)
- ;
- output_rval(ModuleInfo, Expr, ModuleName, !IO)
- )
+ output_rval(ModuleInfo, Expr, ModuleName, !IO)
).
:- pred have_preallocated_pseudo_type_var(int::in) is semidet.
@@ -4185,29 +4135,21 @@ output_binop(ModuleInfo, Op, X, Y, ModuleName, !IO) :-
io.write_string(") ", !IO),
io.write_string(OpStr, !IO),
io.write_string(" 0)", !IO)
- ;
- ( java_float_compare_op(Op, OpStr1) ->
- OpStr = OpStr1
- ; java_float_op(Op, OpStr2) ->
- OpStr = OpStr2
- ;
- fail
- )
- ->
+ ; rval_is_enum_object(X) ->
io.write_string("(", !IO),
- output_rval_maybe_with_enum(ModuleInfo, X, ModuleName, !IO),
- io.write_string(" ", !IO),
- io.write_string(OpStr, !IO),
+ output_rval(ModuleInfo, X, ModuleName, !IO),
+ io.write_string(".MR_value ", !IO),
+ output_binary_op(Op, !IO),
io.write_string(" ", !IO),
- output_rval_maybe_with_enum(ModuleInfo, Y, ModuleName, !IO),
- io.write_string(")", !IO)
+ output_rval(ModuleInfo, Y, ModuleName, !IO),
+ io.write_string(".MR_value)", !IO)
;
io.write_string("(", !IO),
- output_rval_maybe_with_enum(ModuleInfo, X, ModuleName, !IO),
+ output_rval(ModuleInfo, X, ModuleName, !IO),
io.write_string(" ", !IO),
output_binary_op(Op, !IO),
io.write_string(" ", !IO),
- output_rval_maybe_with_enum(ModuleInfo, Y, ModuleName, !IO),
+ output_rval(ModuleInfo, Y, ModuleName, !IO),
io.write_string(")", !IO)
).
@@ -4236,11 +4178,15 @@ output_rval_maybe_with_enum(ModuleInfo, Rval, ModuleName, !IO) :-
:- pred output_binary_op(binary_op::in, io::di, io::uo) is det.
output_binary_op(Op, !IO) :-
+ % XXX why are these separated into three predicates?
( java_binary_infix_op(Op, OpStr) ->
io.write_string(OpStr, !IO)
+ ; java_float_compare_op(Op, OpStr) ->
+ io.write_string(OpStr, !IO)
+ ; java_float_op(Op, OpStr) ->
+ io.write_string(OpStr, !IO)
;
- unexpected(this_file,
- "output_binary_op: invalid binary operator")
+ unexpected(this_file, "output_binary_op: invalid binary operator")
).
:- pred output_rval_const(mlds_rval_const::in, io::di, io::uo) is det.
@@ -4256,6 +4202,16 @@ output_rval_const(Const, !IO) :-
Const = mlconst_int(N),
output_int_const(N, !IO)
;
+ Const = mlconst_enum(N, EnumType),
+ output_type(normal_style, EnumType, !IO),
+ io.write_string(".K", !IO),
+ io.write_int(N, !IO)
+ ;
+ Const = mlconst_char(N),
+ io.write_string("((char) ", !IO),
+ io.write_int(N, !IO),
+ io.write_string(")", !IO)
+ ;
Const = mlconst_foreign(Lang, Value, _Type),
expect(unify(Lang, lang_java), this_file,
"output_rval_const: language other than Java."),
diff --git a/compiler/mlds_to_managed.m b/compiler/mlds_to_managed.m
index d4a81e5..a83659c 100644
--- a/compiler/mlds_to_managed.m
+++ b/compiler/mlds_to_managed.m
@@ -470,7 +470,11 @@ write_rval_const(mlconst_true, !IO) :-
io.write_string("1", !IO).
write_rval_const(mlconst_false, !IO) :-
io.write_string("0", !IO).
-write_rval_const(mlconst_int(I), !IO) :-
+write_rval_const(Const, !IO) :-
+ ( Const = mlconst_int(I)
+ ; Const = mlconst_enum(I, _)
+ ; Const = mlconst_char(I)
+ ),
io.write_int(I, !IO).
write_rval_const(mlconst_foreign(_Lang, _Value, _Type), !IO) :-
sorry(this_file, "mlconst_foreign for managed languages").
diff --git a/compiler/rtti_to_mlds.m b/compiler/rtti_to_mlds.m
index 2cb9b30..54233bd 100644
--- a/compiler/rtti_to_mlds.m
+++ b/compiler/rtti_to_mlds.m
@@ -1766,6 +1766,8 @@ add_rtti_defn_arcs_const(DefnDataName, Const, !Graph) :-
( Const = mlconst_true
; Const = mlconst_false
; Const = mlconst_int(_)
+ ; Const = mlconst_enum(_, _)
+ ; Const = mlconst_char(_)
; Const = mlconst_foreign(_, _, _)
; Const = mlconst_float(_)
; Const = mlconst_string(_)
--------------------------------------------------------------------------
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