[m-rev.] for review: java rtti improvements
Peter Wang
novalazy at gmail.com
Wed Apr 29 17:17:10 AEST 2009
Branches: main
RTTI improvements for Java backend. io.write/3 work for some simple types
(builtin types and non-existential d.u. types).
compiler/mlds_to_java.m:
Fix problem with cyclic RTTI definitions. Initialisers could refer to
other RTTI structures which weren't yet allocated, leading to fields
being null. The fix is to allocate all top-level RTTI objects first
and initialise in a second phase.
java/runtime/DuExistInfo.java:
java/runtime/DuExistLocn.java:
java/runtime/DuFunctorDesc.java:
java/runtime/EnumFunctorDesc.java:
java/runtime/ForeignEnumFunctorDesc.java:
java/runtime/TypeClassConstraint.java:
java/runtime/TypeClassDeclStruct.java:
java/runtime/TypeClassId.java:
java/runtime/TypeCtorInfo_Struct.java:
java/runtime/TypeInfo_Struct.java:
Separate constructors into constructors for the initial allocation,
and an `init' method to fill in the fields.
java/runtime/MethodPtr.java:
Use variadic method support to simplify semidet_call_* and
result_call_* in rtti_implementation.m.
library/builtin.m:
Make Java definitions of builtin.unify/2 and builtin.compare/3 call
rtti_implementation.generic_unify and generic_compare.
library/private_builtin.m:
Add missing MR_TYPECTOR_REP_FOREIGN_ENUM{,_USEREQ} constants
for C# and Java.
library/rtti_implementation.m:
Fix and add missing Java versions of many foreign_procs.
Add more attributes to foreign_procs.
Clean up the code a bit (fewer casts and ^ field access functions).
diff --git a/compiler/mlds_to_java.m b/compiler/mlds_to_java.m
index 00b3284..d18de80 100644
--- a/compiler/mlds_to_java.m
+++ b/compiler/mlds_to_java.m
@@ -49,21 +49,6 @@
%
% - handle static ground terms(?)
%
-% - RTTI: XXX There are problems with the RTTI definitions for the Java
-% back-end. Under the current system, the definitions are output as static
-% variables with static initializers, ordered so that subdefinitions always
-% appear before the definition which uses them. This is necessary because
-% in Java, static initializers are performed at runtime in textual order,
-% and if a definition relies on another static variable for its constructor
-% but said variable has not been initialized, then it is treated as `null'
-% by the JVM with no warning. The problem with this approach is that it
-% won't work for cyclic definitions. e.g.:
-%
-% :- type foo ---> f(bar) ; g.
-% :- type bar ---> f2(foo) ; g2
-% At some point this should be changed so that initialization is performed
-% by 2 phases: first allocate all of the objects, then fill in the fields.
-%
% - support foreign_import_module for Java
%
% - handle foreign code written in C
@@ -485,15 +470,19 @@ output_java_src_file(ModuleInfo, Indent, MLDS, !IO) :-
% that will get used in the RTTI definitions.
output_src_start(Indent, ModuleName, Imports, ForeignDecls, Defns, !IO),
io.write_list(ForeignBodyCode, "\n", output_java_body_code(Indent), !IO),
- CtorData = none, % Not a constructor.
- % XXX do we need to split this into RTTI and non-RTTI defns???
list.filter(defn_is_rtti_data, Defns, RttiDefns, NonRttiDefns),
- output_defns(Indent + 1, ModuleInfo, MLDS_ModuleName, CtorData,
+ io.write_string("\n// RttiDefns\n", !IO),
+ output_defns(Indent + 1, ModuleInfo, MLDS_ModuleName, alloc_only,
+ RttiDefns, !IO),
+ output_rtti_assignments(Indent + 1, ModuleInfo, MLDS_ModuleName,
RttiDefns, !IO),
- output_defns(Indent + 1, ModuleInfo, MLDS_ModuleName, CtorData,
+ io.write_string("\n// NonRttiDefns\n", !IO),
+ output_defns(Indent + 1, ModuleInfo, MLDS_ModuleName, none,
NonRttiDefns, !IO),
- output_exports(Indent + 1, ModuleInfo, MLDS_ModuleName, CtorData,
+ io.write_string("\n// ExportDefns\n", !IO),
+ output_exports(Indent + 1, ModuleInfo, MLDS_ModuleName, none,
ExportDefns, !IO),
+ io.write_string("\n// InitPreds\n", !IO),
output_inits(Indent + 1, ModuleInfo, InitPreds, !IO),
output_src_end(Indent, ModuleName, !IO).
% XXX Need to handle non-Java foreign code at this point.
@@ -565,10 +554,10 @@ mlds_get_java_foreign_code(AllForeignCode) =
ForeignCode :-
% boundaries.
%
:- pred output_exports(indent::in, module_info::in, mlds_module_name::in,
- ctor_data::in, list(mlds_pragma_export)::in, io::di, io::uo) is det.
+ output_aux::in, list(mlds_pragma_export)::in, io::di, io::uo) is det.
output_exports(_, _, _, _, [], !IO).
-output_exports(Indent, ModuleInfo, MLDS_ModuleName, CtorData,
+output_exports(Indent, ModuleInfo, MLDS_ModuleName, OutputAux,
[Export | Exports], !IO) :-
Export = ml_pragma_export(Lang, ExportName, MLDS_Name, MLDS_Signature,
MLDS_Context),
@@ -582,7 +571,7 @@ output_exports(Indent, ModuleInfo,
MLDS_ModuleName, CtorData,
io.write_string("void", !IO)
;
ReturnTypes = [RetType],
- output_type(RetType, !IO)
+ output_type(normal_style, RetType, !IO)
;
ReturnTypes = [_, _ | _],
% For multiple outputs, we return an array of objects.
@@ -610,7 +599,7 @@ output_exports(Indent, ModuleInfo,
MLDS_ModuleName, CtorData,
io.write_string(");\n", !IO),
indent_line(Indent, !IO),
io.write_string("}\n", !IO),
- output_exports(Indent, ModuleInfo, MLDS_ModuleName, CtorData, Exports,
+ output_exports(Indent, ModuleInfo, MLDS_ModuleName, OutputAux, Exports,
!IO).
%-----------------------------------------------------------------------------%
@@ -1246,25 +1235,33 @@ output_auto_gen_comment(ModuleName, !IO) :-
% Code to output declarations and definitions.
%
- % Discriminated union which allows us to pass down the class name if
- % a definition is a constructor; this is needed since the class name
- % is not available for a constructor in the MLDS.
+ % Options to adjust the behaviour of the output predicates.
%
-:- type ctor_data
- ---> none % Not a constructor.
- ; cname(mlds_entity_name). % Constructor class name.
+:- type output_aux
+ ---> none
+ % Nothing special.
+
+ ; cname(mlds_entity_name)
+ % Pass down the class name if a definition is a constructor; this
+ % is needed since the class name is not available for a constructor
+ % in the MLDS.
+
+ ; alloc_only.
+ % When writing out RTTI structure definitions, initialise members
+ % with allocated top-level structures but don't fill in the fields
+ % yet.
:- pred output_defns(indent::in, module_info::in, mlds_module_name::in,
- ctor_data::in, list(mlds_defn)::in, io::di, io::uo) is det.
+ output_aux::in, list(mlds_defn)::in, io::di, io::uo) is det.
-output_defns(Indent, ModuleInfo, ModuleName, CtorData, Defns, !IO) :-
- OutputDefn = output_defn(Indent, ModuleInfo, ModuleName, CtorData),
+output_defns(Indent, ModuleInfo, ModuleName, OutputAux, Defns, !IO) :-
+ OutputDefn = output_defn(Indent, ModuleInfo, ModuleName, OutputAux),
list.foldl(OutputDefn, Defns, !IO).
:- pred output_defn(indent::in, module_info::in, mlds_module_name::in,
- ctor_data::in, mlds_defn::in, io::di, io::uo) is det.
+ output_aux::in, mlds_defn::in, io::di, io::uo) is det.
-output_defn(Indent, ModuleInfo, ModuleName, CtorData, Defn, !IO) :-
+output_defn(Indent, ModuleInfo, ModuleName, OutputAux, Defn, !IO) :-
Defn = mlds_defn(Name, Context, Flags, DefnBody),
indent_line(Context, Indent, !IO),
( DefnBody = mlds_function(_, _, body_external, _, _) ->
@@ -1274,35 +1271,35 @@ output_defn(Indent, ModuleInfo, ModuleName,
CtorData, Defn, !IO) :-
% (Note that the actual definition of an external procedure
% must be given in `pragma java_code' in the same module.)
io.write_string("/* external:\n", !IO),
- output_decl_flags(Flags, Name, !IO),
+ output_decl_flags(Flags, !IO),
output_defn_body(Indent, ModuleInfo,
- qual(ModuleName, module_qual, Name), CtorData, Context, DefnBody,
+ qual(ModuleName, module_qual, Name), OutputAux, Context, DefnBody,
!IO),
io.write_string("*/\n", !IO)
;
- output_decl_flags(Flags, Name, !IO),
+ output_decl_flags(Flags, !IO),
output_defn_body(Indent, ModuleInfo,
- qual(ModuleName, module_qual, Name), CtorData, Context, DefnBody,
+ qual(ModuleName, module_qual, Name), OutputAux, Context, DefnBody,
!IO)
).
:- pred output_defn_body(indent::in, module_info::in,
- mlds_qualified_entity_name::in, ctor_data::in, mlds_context::in,
- mlds_entity_defn::in, io::di, io::uo) is det.
+ mlds_qualified_entity_name::in, output_aux::in,
+ mlds_context::in, mlds_entity_defn::in, io::di, io::uo) is det.
-output_defn_body(_, ModuleInfo, Name, _, _, mlds_data(Type, Initializer, _),
- !IO) :-
- output_data_defn(ModuleInfo, Name, Type, Initializer, !IO).
-output_defn_body(Indent, ModuleInfo, Name, CtorData, Context,
+output_defn_body(_, ModuleInfo, Name, OutputAux, _,
+ mlds_data(Type, Initializer, _), !IO) :-
+ output_data_defn(ModuleInfo, Name, OutputAux, Type, Initializer, !IO).
+output_defn_body(Indent, ModuleInfo, Name, OutputAux, Context,
mlds_function(MaybePredProcId, Signature, MaybeBody,
_Attributes, EnvVarNames), !IO) :-
expect(set.empty(EnvVarNames), this_file,
"output_defn_body: EnvVarNames"),
output_maybe(MaybePredProcId, output_pred_proc_id, !IO),
- output_func(Indent, ModuleInfo, Name, CtorData, Context, Signature,
- MaybeBody, !IO).
-output_defn_body(Indent, ModuleInfo, Name, _, Context, mlds_class(ClassDefn),
- !IO) :-
+ output_func(Indent, ModuleInfo, Name, OutputAux, Context,
+ Signature, MaybeBody, !IO).
+output_defn_body(Indent, ModuleInfo, Name, _, Context,
+ mlds_class(ClassDefn), !IO) :-
output_class(Indent, ModuleInfo, Name, Context, ClassDefn, !IO).
%-----------------------------------------------------------------------------%
@@ -1364,7 +1361,7 @@ output_extends_list(_, [], !IO).
output_extends_list(Indent, [SuperClass], !IO) :-
indent_line(Indent, !IO),
io.write_string("extends ", !IO),
- output_type(SuperClass, !IO),
+ output_type(normal_style, SuperClass, !IO),
io.nl(!IO).
output_extends_list(_, [_, _ | _], _, _) :-
unexpected(this_file,
@@ -1416,16 +1413,14 @@ output_interface(Interface, !IO) :-
output_class_body(Indent, ModuleInfo, mlds_class, _, AllMembers, ModuleName,
!IO) :-
- CtorData = none, % Not a constructor.
- output_defns(Indent, ModuleInfo, ModuleName, CtorData, AllMembers, !IO).
+ output_defns(Indent, ModuleInfo, ModuleName, none, AllMembers, !IO).
output_class_body(_Indent, _, mlds_package, _Name, _AllMembers, _, _, _) :-
unexpected(this_file, "cannot use package as a type.").
output_class_body(Indent, ModuleInfo, mlds_interface, _, AllMembers,
ModuleName, !IO) :-
- CtorData = none, % Not a constructor.
- output_defns(Indent, ModuleInfo, ModuleName, CtorData, AllMembers, !IO).
+ output_defns(Indent, ModuleInfo, ModuleName, none, AllMembers, !IO).
output_class_body(_Indent, _, mlds_struct, _, _AllMembers, _, _, _) :-
unexpected(this_file, "output_class_body: structs not supported in Java.").
@@ -1492,7 +1487,8 @@ output_enum_constant(Indent, ModuleInfo,
EnumModuleName, Defn, !IO) :-
indent_line(Indent, !IO),
io.write_string("public static final int ", !IO),
output_name(Name, !IO),
- output_initializer(ModuleInfo, EnumModuleName, Type, Initializer, !IO),
+ output_initializer(ModuleInfo, EnumModuleName, none, Type,
+ Initializer, !IO),
io.write_char(';', !IO)
;
unexpected(this_file,
@@ -1508,16 +1504,17 @@ output_enum_constant(Indent, ModuleInfo,
EnumModuleName, Defn, !IO) :-
io::di, io::uo) is det.
output_data_decl(qual(_, _, Name), Type, !IO) :-
- output_type(Type, !IO),
+ output_type(normal_style, Type, !IO),
io.write_char(' ', !IO),
output_name(Name, !IO).
:- pred output_data_defn(module_info::in, mlds_qualified_entity_name::in,
- mlds_type::in, mlds_initializer::in, io::di, io::uo) is det.
+ output_aux::in, mlds_type::in, mlds_initializer::in, io::di,
io::uo) is det.
-output_data_defn(ModuleInfo, Name, Type, Initializer, !IO) :-
+output_data_defn(ModuleInfo, Name, OutputAux, Type, Initializer, !IO) :-
output_data_decl(Name, Type, !IO),
- output_initializer(ModuleInfo, Name ^ mod_name, Type, Initializer, !IO),
+ output_initializer(ModuleInfo, Name ^ mod_name, OutputAux, Type,
+ Initializer, !IO),
io.write_string(";\n", !IO).
% We need to provide initializers for local variables to avoid problems
@@ -1592,14 +1589,31 @@ output_maybe(MaybeValue, OutputAction, !IO) :-
).
:- pred output_initializer(module_info::in, mlds_module_name::in,
- mlds_type::in, mlds_initializer::in, io::di, io::uo) is det.
+ output_aux::in, mlds_type::in, mlds_initializer::in, io::di, io::uo)
+ is det.
-output_initializer(ModuleInfo, ModuleName, Type, Initializer, !IO) :-
+output_initializer(ModuleInfo, ModuleName, OutputAux, Type,
Initializer, !IO) :-
io.write_string(" = ", !IO),
- ( needs_initialization(Initializer) = yes ->
- output_initializer_body(ModuleInfo, Initializer, yes(Type), ModuleName,
- !IO)
+ NeedsInit = needs_initialization(Initializer),
+ (
+ NeedsInit = yes,
+ % Due to cyclic references, we need to separate the allocation and
+ % initialisation steps of RTTI structures. If InitStyle is alloc_only
+ % then we output an initializer to allocate a structure without filling
+ % in the fields.
+ (
+ ( OutputAux = none
+ ; OutputAux = cname(_)
+ ),
+ output_initializer_body(ModuleInfo, Initializer, yes(Type),
+ ModuleName, !IO)
+ ;
+ OutputAux = alloc_only,
+ output_initializer_alloc_only(ModuleInfo, Initializer, yes(Type),
+ ModuleName, !IO)
+ )
;
+ NeedsInit = no,
% If we are not provided with an initializer we just, supply the
% default java values -- note: this is strictly only necessary for
% local variables, but it's not going to hurt anything else.
@@ -1615,6 +1629,37 @@ needs_initialization(init_struct(_Type, [])) = no.
needs_initialization(init_struct(_Type, [_ | _])) = yes.
needs_initialization(init_array(_)) = yes.
+:- pred output_initializer_alloc_only(module_info::in, mlds_initializer::in,
+ maybe(mlds_type)::in, mlds_module_name::in, io::di, io::uo) is det.
+
+output_initializer_alloc_only(_ModuleInfo, Initializer, MaybeType, _ModuleName,
+ !IO) :-
+ (
+ Initializer = no_initializer,
+ unexpected(this_file, "output_initializer_alloc_only: no_initializer")
+ ;
+ Initializer = init_obj(_),
+ unexpected(this_file, "output_initializer_alloc_only: init_obj")
+ ;
+ Initializer = init_struct(StructType, _FieldInits),
+ io.write_string("new ", !IO),
+ output_type(normal_style, StructType, !IO),
+ io.write_string("()", !IO)
+ ;
+ Initializer = init_array(ElementInits),
+ Size = list.length(ElementInits),
+ io.write_string("new ", !IO),
+ (
+ MaybeType = yes(Type),
+ output_type(sized_array(Size), Type, !IO)
+ ;
+ MaybeType = no,
+ % XXX we need to know the type here
+ io.write_string("/* XXX init_array */ Object", !IO),
+ output_array_brackets(sized_array(Size), !IO)
+ )
+ ).
+
:- pred output_initializer_body(module_info::in, mlds_initializer::in,
maybe(mlds_type)::in, mlds_module_name::in, io::di, io::uo) is det.
@@ -1629,7 +1674,7 @@ output_initializer_body(ModuleInfo,
init_obj(Rval), MaybeType, ModuleName,
->
% If it is a enumeration object create new object.
io.write_string("new ", !IO),
- output_type(Type, !IO),
+ output_type(normal_style, Type, !IO),
io.write_char('(', !IO),
output_rval_maybe_with_enum(ModuleInfo, Rval, ModuleName, !IO),
io.write_char(')', !IO)
@@ -1640,7 +1685,7 @@ output_initializer_body(ModuleInfo,
init_obj(Rval), MaybeType, ModuleName,
% 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(Type, !IO),
+ output_type(normal_style, Type, !IO),
io.write_string(") ", !IO),
output_rval(ModuleInfo, Rval, ModuleName, !IO)
;
@@ -1650,33 +1695,122 @@ output_initializer_body(ModuleInfo,
init_obj(Rval), MaybeType, ModuleName,
output_initializer_body(ModuleInfo, init_struct(StructType, FieldInits),
_MaybeType, ModuleName, !IO) :-
io.write_string("new ", !IO),
- output_type(StructType, !IO),
+ output_type(normal_style, StructType, !IO),
IsArray = type_is_array(StructType),
io.write_string(if IsArray = is_array then " {" else "(", !IO),
- io.write_list(FieldInits, ",\n\t\t",
- (pred(FieldInit::in, !.IO::di, !:IO::uo) is det :-
- output_initializer_body(ModuleInfo, FieldInit, no, ModuleName, !IO)
- ), !IO),
+ output_initializer_body_list(ModuleInfo, ModuleName, FieldInits, !IO),
io.write_char(if IsArray = is_array then '}' else ')', !IO).
output_initializer_body(ModuleInfo, init_array(ElementInits), MaybeType,
ModuleName, !IO) :-
io.write_string("new ", !IO),
(
MaybeType = yes(Type),
- output_type(Type, !IO)
+ output_type(normal_style, Type, !IO)
;
MaybeType = no,
% XXX we need to know the type here
io.write_string("/* XXX init_array */ Object[]", !IO)
),
io.write_string(" {\n\t\t", !IO),
- io.write_list(ElementInits, ",\n\t\t",
- (pred(ElementInit::in, !.IO::di, !:IO::uo) is det :-
- output_initializer_body(ModuleInfo, ElementInit, no, ModuleName,
- !IO)),
- !IO),
+ output_initializer_body_list(ModuleInfo, ModuleName, ElementInits, !IO),
io.write_string("}", !IO).
+:- pred output_initializer_body_list(module_info::in, mlds_module_name::in,
+ list(mlds_initializer)::in, io::di, io::uo) is det.
+
+output_initializer_body_list(ModuleInfo, ModuleName, Inits, !IO) :-
+ io.write_list(Inits, ",\n\t\t",
+ (pred(Init::in, !.IO::di, !:IO::uo) is det :-
+ output_initializer_body(ModuleInfo, Init, no, ModuleName, !IO)),
+ !IO).
+
+%-----------------------------------------------------------------------------%
+%
+% Code to output RTTI data assignments
+%
+
+:- pred output_rtti_assignments(indent::in, module_info::in,
+ mlds_module_name::in, list(mlds_defn)::in, io::di, io::uo) is det.
+
+output_rtti_assignments(Indent, ModuleInfo, ModuleName, Defns, !IO) :-
+ (
+ Defns = []
+ ;
+ Defns = [_ | _],
+ indent_line(Indent, !IO),
+ io.write_string("static {\n", !IO),
+ list.foldl(
+ output_rtti_defn_assignments(Indent + 1, ModuleInfo, ModuleName),
+ Defns, !IO),
+ indent_line(Indent, !IO),
+ io.write_string("}\n", !IO)
+ ).
+
+:- pred output_rtti_defn_assignments(indent::in, module_info::in,
+ mlds_module_name::in, mlds_defn::in, io::di, io::uo) is det.
+
+output_rtti_defn_assignments(Indent, ModuleInfo, ModuleName, Defn, !IO) :-
+ Defn = mlds_defn(Name, _Context, _Flags, DefnBody),
+ (
+ DefnBody = mlds_data(Type, Initializer, _),
+ output_rtti_defn_assignments_2(Indent, ModuleInfo, ModuleName, Name,
+ Type, Initializer, !IO)
+ ;
+ ( DefnBody = mlds_function(_, _, _, _, _)
+ ; DefnBody = mlds_class(_)
+ ),
+ unexpected(this_file,
+ "output_rtti_defn_assignments: expected mlds_data")
+ ).
+
+:- pred output_rtti_defn_assignments_2(indent::in, module_info::in,
+ mlds_module_name::in, mlds_entity_name::in, mlds_type::in,
+ mlds_initializer::in, io::di, io::uo) is det.
+
+output_rtti_defn_assignments_2(Indent, ModuleInfo, ModuleName, Name, _Type,
+ Initializer, !IO) :-
+ (
+ Initializer = no_initializer
+ ;
+ Initializer = init_obj(_),
+ % Not encountered in practice.
+ unexpected(this_file, "output_rtti_defn_assignments_2: init_obj")
+ ;
+ Initializer = init_struct(StructType, FieldInits),
+ IsArray = type_is_array(StructType),
+ (
+ IsArray = not_array,
+ indent_line(Indent, !IO),
+ output_name(Name, !IO),
+ io.write_string(".init(", !IO),
+ output_initializer_body_list(ModuleInfo, ModuleName, FieldInits,
+ !IO),
+ io.write_string(");\n", !IO)
+ ;
+ IsArray = is_array,
+ % Not encountered in practice.
+ unexpected(this_file, "output_rtti_defn_assignments_2: is_array")
+ )
+ ;
+ Initializer = init_array(ElementInits),
+ list.foldl2(output_rtti_array_assignments(Indent, ModuleInfo,
+ ModuleName, Name), ElementInits, 0, _Index, !IO)
+ ).
+
+:- pred output_rtti_array_assignments(indent::in, module_info::in,
+ mlds_module_name::in, mlds_entity_name::in,
+ mlds_initializer::in, int::in, int::out, io::di, io::uo) is det.
+
+output_rtti_array_assignments(Indent, ModuleInfo, ModuleName, Name,
+ ElementInit, Index, Index + 1, !IO) :-
+ indent_line(Indent, !IO),
+ output_name(Name, !IO),
+ io.write_string("[", !IO),
+ io.write_int(Index, !IO),
+ io.write_string("] = ", !IO),
+ output_initializer_body(ModuleInfo, ElementInit, no, ModuleName, !IO),
+ io.write_string(";\n", !IO).
+
%-----------------------------------------------------------------------------%
%
% Code to output function declarations/definitions
@@ -1700,14 +1834,14 @@ output_pred_proc_id(proc(PredId, ProcId), !IO) :-
).
:- pred output_func(indent::in, module_info::in,
- mlds_qualified_entity_name::in, ctor_data::in, mlds_context::in,
+ mlds_qualified_entity_name::in, output_aux::in, mlds_context::in,
mlds_func_params::in, mlds_function_body::in, io::di, io::uo) is det.
-output_func(Indent, ModuleInfo, Name, CtorData, Context, Signature, MaybeBody,
+output_func(Indent, ModuleInfo, Name, OutputAux, Context, Signature, MaybeBody,
!IO) :-
(
MaybeBody = body_defined_here(Body),
- output_func_decl(Indent, Name, CtorData, Context, Signature, !IO),
+ output_func_decl(Indent, Name, OutputAux, Context, Signature, !IO),
io.write_string("\n", !IO),
indent_line(Context, Indent, !IO),
io.write_string("{\n", !IO),
@@ -1721,7 +1855,7 @@ output_func(Indent, ModuleInfo, Name, CtorData,
Context, Signature, MaybeBody,
).
:- pred output_func_decl(indent::in, mlds_qualified_entity_name::in,
- ctor_data::in, mlds_context::in, mlds_func_params::in, io::di, io::uo)
+ output_aux::in, mlds_context::in, mlds_func_params::in, io::di, io::uo)
is det.
output_func_decl(Indent, QualifiedName, cname(CtorName), Context, Signature,
@@ -1730,14 +1864,17 @@ output_func_decl(Indent, QualifiedName,
cname(CtorName), Context, Signature,
output_name(CtorName, !IO),
output_params(Indent, QualifiedName ^ mod_name, Context, Parameters, !IO).
-output_func_decl(Indent, QualifiedName, none, Context, Signature, !IO) :-
+output_func_decl(Indent, QualifiedName, OutputAux, Context, Signature, !IO) :-
+ ( OutputAux = none
+ ; OutputAux = alloc_only
+ ),
Signature = mlds_func_params(Parameters, RetTypes),
(
RetTypes = [],
io.write_string("void", !IO)
;
RetTypes = [RetType],
- output_type(RetType, !IO)
+ output_type(normal_style, RetType, !IO)
;
RetTypes = [_, _ | _],
% For multiple outputs, we return an array of objects.
@@ -1769,7 +1906,7 @@ output_params(Indent, ModuleName, Context,
Parameters, !IO) :-
output_param(Indent, _ModuleName, Context, Arg, !IO) :-
Arg = mlds_argument(Name, Type, _GCStatement),
indent_line(Context, Indent, !IO),
- output_type(Type, !IO),
+ output_type(normal_style, Type, !IO),
io.write_char(' ', !IO),
output_name(Name, !IO).
@@ -1987,9 +2124,15 @@ name_mangle_maybe_shorten(Name) = MangledName :-
% Code to output types
%
-:- pred output_type(mlds_type::in, io::di, io::uo) is det.
+:- type output_style
+ ---> normal_style
+ ; sized_array(int).
+ % If writing an array type, include the integer within the
+ % square brackets.
+
+:- pred output_type(output_style::in, mlds_type::in, io::di, io::uo) is det.
-output_type(mercury_type(Type, CtorCat, _), !IO) :-
+output_type(Style, mercury_type(Type, CtorCat, _), !IO) :-
( Type = c_pointer_type ->
% The c_pointer type is used in the c back-end as a generic way
% to pass foreign types to automatically generated Compare and Unify
@@ -2002,10 +2145,10 @@ output_type(mercury_type(Type, CtorCat, _), !IO) :-
->
io.write_string(SubstituteName, !IO)
;
- output_mercury_type(Type, CtorCat, !IO)
+ output_mercury_type(Style, Type, CtorCat, !IO)
).
-output_type(mlds_mercury_array_type(ElementType), !IO) :-
+output_type(Style, mlds_mercury_array_type(ElementType), !IO) :-
( ElementType = mercury_type(_, ctor_cat_variable, _) ->
% We can't use `java.lang.Object []', since we want a generic type
% that is capable of holding any kind of array, including e.g.
@@ -2013,18 +2156,18 @@
output_type(mlds_mercury_array_type(ElementType), !IO) :-
% class, so we just use the universal base `java.lang.Object'.
io.write_string("/* Array */ java.lang.Object", !IO)
;
- output_type(ElementType, !IO),
- io.write_string("[]", !IO)
+ output_type(Style, ElementType, !IO),
+ output_array_brackets(Style, !IO)
).
-output_type(mlds_native_int_type, !IO) :-
+output_type(_, mlds_native_int_type, !IO) :-
io.write_string("int", !IO).
-output_type(mlds_native_float_type, !IO) :-
+output_type(_, mlds_native_float_type, !IO) :-
io.write_string("double", !IO).
-output_type(mlds_native_bool_type, !IO) :-
+output_type(_, mlds_native_bool_type, !IO) :-
io.write_string("boolean", !IO).
-output_type(mlds_native_char_type, !IO) :-
+output_type(_, mlds_native_char_type, !IO) :-
io.write_string("char", !IO).
-output_type(mlds_foreign_type(ForeignType), !IO) :-
+output_type(_, mlds_foreign_type(ForeignType), !IO) :-
(
ForeignType = java(java_type(Name)),
maybe_output_comment("foreign_type", !IO),
@@ -2039,58 +2182,58 @@ output_type(mlds_foreign_type(ForeignType), !IO) :-
ForeignType = erlang(_),
unexpected(this_file, "output_type: erlang foreign_type")
).
-output_type(mlds_class_type(Name, Arity, _ClassKind), !IO) :-
+output_type(_, mlds_class_type(Name, Arity, _ClassKind), !IO) :-
% We used to treat enumerations specially here, outputting
% them as "int", but now we do the same for all classes.
output_fully_qualified_thing(Name, output_class_name, ".", !IO),
io.format("_%d", [i(Arity)], !IO).
-output_type(mlds_ptr_type(Type), !IO) :-
+output_type(Style, mlds_ptr_type(Type), !IO) :-
% XXX should we report an error here, if the type pointed to
% is not a class type?
- output_type(Type, !IO).
-output_type(mlds_array_type(Type), !IO) :-
- output_type(Type, !IO),
- io.write_string("[]", !IO).
-output_type(mlds_func_type(_FuncParams), !IO) :-
+ output_type(Style, Type, !IO).
+output_type(Style, mlds_array_type(Type), !IO) :-
+ output_type(Style, Type, !IO),
+ output_array_brackets(Style, !IO).
+output_type(_, mlds_func_type(_FuncParams), !IO) :-
io.write_string("mercury.runtime.MethodPtr", !IO).
-output_type(mlds_generic_type, !IO) :-
+output_type(_, mlds_generic_type, !IO) :-
io.write_string("java.lang.Object", !IO).
-output_type(mlds_generic_env_ptr_type, !IO) :-
+output_type(_, mlds_generic_env_ptr_type, !IO) :-
io.write_string("/* env_ptr */ java.lang.Object", !IO).
-output_type(mlds_type_info_type, !IO) :-
+output_type(_, mlds_type_info_type, !IO) :-
io.write_string("mercury.runtime.TypeInfo", !IO).
-output_type(mlds_pseudo_type_info_type, !IO) :-
+output_type(_, mlds_pseudo_type_info_type, !IO) :-
io.write_string("mercury.runtime.PseudoTypeInfo", !IO).
-output_type(mlds_cont_type(_), !IO) :-
+output_type(_, mlds_cont_type(_), !IO) :-
% XXX Should this actually be a class that extends MethodPtr?
io.write_string("mercury.runtime.MethodPtr", !IO).
-output_type(mlds_commit_type, !IO) :-
+output_type(_, mlds_commit_type, !IO) :-
io.write_string("mercury.runtime.Commit", !IO).
-output_type(mlds_rtti_type(RttiIdMaybeElement), !IO) :-
+output_type(Style, mlds_rtti_type(RttiIdMaybeElement), !IO) :-
rtti_id_maybe_element_java_type(RttiIdMaybeElement, JavaTypeName, IsArray),
io.write_string(JavaTypeName, !IO),
(
IsArray = is_array,
- io.write_string("[]", !IO)
+ output_array_brackets(Style, !IO)
;
IsArray = not_array
).
-output_type(mlds_tabling_type(TablingId), !IO) :-
+output_type(Style, mlds_tabling_type(TablingId), !IO) :-
tabling_id_java_type(TablingId, JavaTypeName, IsArray),
io.write_string(JavaTypeName, !IO),
(
IsArray = is_array,
- io.write_string("[]", !IO)
+ output_array_brackets(Style, !IO)
;
IsArray = not_array
).
-output_type(mlds_unknown_type, !IO) :-
+output_type(_, mlds_unknown_type, !IO) :-
unexpected(this_file, "output_type: unknown type").
-:- pred output_mercury_type(mer_type::in, type_ctor_category::in,
- io::di, io::uo) is det.
+:- pred output_mercury_type(output_style::in, mer_type::in,
+ type_ctor_category::in, io::di, io::uo) is det.
-output_mercury_type(Type, CtorCat, !IO) :-
+output_mercury_type(Style, Type, CtorCat, !IO) :-
(
CtorCat = ctor_cat_builtin(cat_builtin_char),
io.write_string("char", !IO)
@@ -2111,25 +2254,28 @@ output_mercury_type(Type, CtorCat, !IO) :-
io.write_string("java.lang.Object", !IO)
;
CtorCat = ctor_cat_tuple,
- io.write_string("/* tuple */ java.lang.Object[]", !IO)
+ io.write_string("/* tuple */ java.lang.Object", !IO),
+ output_array_brackets(Style, !IO)
;
CtorCat = ctor_cat_higher_order,
- io.write_string("/* closure */ java.lang.Object[]", !IO)
+ io.write_string("/* closure */ java.lang.Object", !IO),
+ output_array_brackets(Style, !IO)
;
CtorCat = ctor_cat_system(_),
- output_mercury_user_type(Type, ctor_cat_user(cat_user_general), !IO)
+ output_mercury_user_type(Style, Type, ctor_cat_user(cat_user_general),
+ !IO)
;
( CtorCat = ctor_cat_enum(_)
; CtorCat = ctor_cat_user(_)
; CtorCat = ctor_cat_builtin_dummy
),
- output_mercury_user_type(Type, CtorCat, !IO)
+ output_mercury_user_type(Style, Type, CtorCat, !IO)
).
-:- pred output_mercury_user_type(mer_type::in, type_ctor_category::in,
- io::di, io::uo) is det.
+:- pred output_mercury_user_type(output_style::in, mer_type::in,
+ type_ctor_category::in, io::di, io::uo) is det.
-output_mercury_user_type(Type, CtorCat, !IO) :-
+output_mercury_user_type(Style, Type, CtorCat, !IO) :-
( type_to_ctor_and_args(Type, TypeCtor, _ArgsTypes) ->
ml_gen_type_name(TypeCtor, ClassName, ClassArity),
( CtorCat = ctor_cat_enum(_) ->
@@ -2137,11 +2283,23 @@ output_mercury_user_type(Type, CtorCat, !IO) :-
;
MLDS_Type = mlds_class_type(ClassName, ClassArity, mlds_class)
),
- output_type(MLDS_Type, !IO)
+ output_type(Style, MLDS_Type, !IO)
;
unexpected(this_file, "output_mercury_user_type: not a user type")
).
+:- pred output_array_brackets(output_style::in, io::di, io::uo) is det.
+
+output_array_brackets(Style, !IO) :-
+ io.write_string("[", !IO),
+ (
+ Style = normal_style
+ ;
+ Style = sized_array(Size),
+ io.write_int(Size, !IO)
+ ),
+ io.write_string("]", !IO).
+
% Return is_array if the corresponding Java type is an array type.
%
:- func type_is_array(mlds_type) = is_array.
@@ -2212,10 +2370,9 @@ hand_defined_type(ctor_cat_system(Kind),
SubstituteName) :-
% Code to output declaration specifiers
%
-:- pred output_decl_flags(mlds_decl_flags::in, mlds_entity_name::in,
- io::di, io::uo) is det.
+:- pred output_decl_flags(mlds_decl_flags::in, io::di, io::uo) is det.
-output_decl_flags(Flags, _Name, !IO) :-
+output_decl_flags(Flags, !IO) :-
output_access(access(Flags), !IO),
output_per_instance(per_instance(Flags), !IO),
output_virtuality(virtuality(Flags), !IO),
@@ -2352,8 +2509,7 @@ output_stmt(Indent, ModuleInfo, FuncInfo,
ml_stmt_block(Defns, Statements),
(
Defns = [_ | _],
ModuleName = FuncInfo ^ func_info_name ^ mod_name,
- CtorData = none, % Not a constructor.
- output_defns(Indent + 1, ModuleInfo, ModuleName, CtorData, Defns, !IO),
+ output_defns(Indent + 1, ModuleInfo, ModuleName, none, Defns, !IO),
io.write_string("\n", !IO)
;
Defns = []
@@ -2547,7 +2703,7 @@ output_stmt(Indent, ModuleInfo, CallerFuncInfo,
Call, Context, ExitMethods,
io.write_string(") ", !IO)
;
io.write_string("((", !IO),
- output_type(RetType, !IO),
+ output_type(normal_style, RetType, !IO),
io.write_string(") ", !IO)
)
;
@@ -2826,7 +2982,7 @@ output_unboxed_result(Type, ResultIndex, !IO) :-
io.format("result[%d]).%s()", [i(ResultIndex), s(UnboxMethod)], !IO)
;
io.write_string("(", !IO),
- output_type(Type, !IO),
+ output_type(normal_style, Type, !IO),
io.write_string(") ", !IO),
io.format("result[%d]", [i(ResultIndex)], !IO)
).
@@ -2947,7 +3103,7 @@ output_atomic_stmt(Indent, ModuleInfo, FuncInfo,
assign(Lval, Rval), _, !IO) :-
% If the Lval is an object.
( rval_is_int_const(Rval) ->
io.write_string("new ", !IO),
- output_type(LvalType, !IO),
+ output_type(normal_style, LvalType, !IO),
io.write_string("(", !IO),
output_rval(ModuleInfo, Rval, ModuleName, !IO),
io.write_string(")", !IO)
@@ -2986,13 +3142,13 @@ output_atomic_stmt(Indent, ModuleInfo,
FuncInfo, NewObject, Context, !IO) :-
hand_defined_type(CtorCat, _)
)
->
- output_type(Type, !IO),
+ output_type(normal_style, Type, !IO),
io.write_char('.', !IO),
QualifiedCtorId = qual(_ModuleName, _QualKind, CtorDefn),
CtorDefn = ctor_id(CtorName, CtorArity),
output_class_name_and_arity(CtorName, CtorArity, !IO)
;
- output_type(Type, !IO)
+ output_type(normal_style, Type, !IO)
),
IsArray = type_is_array(Type),
(
@@ -3157,7 +3313,7 @@ output_lval(ModuleInfo,
% so we need to downcast to the derived class to access some fields.
%
io.write_string("((", !IO),
- output_type(CtorType, !IO),
+ output_type(normal_style, CtorType, !IO),
io.write_string(") ", !IO),
output_bracketed_rval(ModuleInfo, PtrRval, ModuleName, !IO),
% The actual variable.
@@ -3285,7 +3441,7 @@ output_unop(ModuleInfo, std_unop(Unop), Exprn,
ModuleName, !IO) :-
output_cast_rval(ModuleInfo, Type, Exprn, ModuleName, !IO) :-
io.write_string("(", !IO),
- output_type(Type, !IO),
+ output_type(normal_style, Type, !IO),
io.write_string(") ", !IO),
( java_builtin_type(Type, "int", _, _) ->
output_rval_maybe_with_enum(ModuleInfo, Exprn, ModuleName, !IO)
@@ -3323,7 +3479,7 @@ output_unboxed_rval(ModuleInfo, Type, Exprn,
ModuleName, !IO) :-
io.write_string("()", !IO)
;
io.write_string("((", !IO),
- output_type(Type, !IO),
+ output_type(normal_style, Type, !IO),
io.write_string(") ", !IO),
output_rval(ModuleInfo, Exprn, ModuleName, !IO),
io.write_string(")", !IO)
diff --git a/java/runtime/DuExistInfo.java b/java/runtime/DuExistInfo.java
index e4ae023..ba5e4d2 100644
--- a/java/runtime/DuExistInfo.java
+++ b/java/runtime/DuExistInfo.java
@@ -15,7 +15,11 @@ public class DuExistInfo {
public /* final */ mercury.runtime.TypeClassConstraint[]
exist_constraints;
- public DuExistInfo(int typeinfos_plain, int typeinfos_in_tci, int tcis,
+ public DuExistInfo()
+ {
+ }
+
+ public void init(int typeinfos_plain, int typeinfos_in_tci, int tcis,
mercury.runtime.DuExistLocn[] typeinfo_locns,
mercury.runtime.TypeClassConstraint constraints[])
{
diff --git a/java/runtime/DuExistLocn.java b/java/runtime/DuExistLocn.java
index 7514b82..3640ba0 100644
--- a/java/runtime/DuExistLocn.java
+++ b/java/runtime/DuExistLocn.java
@@ -11,6 +11,7 @@ package mercury.runtime;
public class DuExistLocn {
public int exist_arg_num;
public int exist_offset_in_tci;
+
public DuExistLocn(int arg_num, int offset_in_tci) {
exist_arg_num = arg_num;
exist_offset_in_tci = offset_in_tci;
diff --git a/java/runtime/DuFunctorDesc.java b/java/runtime/DuFunctorDesc.java
index 263c0d4..e8a2e47 100644
--- a/java/runtime/DuFunctorDesc.java
+++ b/java/runtime/DuFunctorDesc.java
@@ -21,7 +21,11 @@ public class DuFunctorDesc {
public /*final*/ java.lang.String[] du_functor_arg_names;
public /*final*/ mercury.runtime.DuExistInfo du_functor_exist_info;
- public DuFunctorDesc(java.lang.String functor_name, int orig_arity,
+ public DuFunctorDesc()
+ {
+ }
+
+ public void init(java.lang.String functor_name, int orig_arity,
int arg_type_contains_var, int sectag_locn, int primary,
int secondary, int ordinal,
// XXX why do we need to use Object here?
diff --git a/java/runtime/EnumFunctorDesc.java
b/java/runtime/EnumFunctorDesc.java
index e4d913d..5766226 100644
--- a/java/runtime/EnumFunctorDesc.java
+++ b/java/runtime/EnumFunctorDesc.java
@@ -11,7 +11,10 @@ public class EnumFunctorDesc {
public java.lang.String enum_functor_name;
public int enum_functor_ordinal;
- public EnumFunctorDesc(String name, int ordinal) {
+ public EnumFunctorDesc() {
+ }
+
+ public void init(String name, int ordinal) {
enum_functor_name = name;
enum_functor_ordinal = ordinal;
}
diff --git a/java/runtime/ForeignEnumFunctorDesc.java
b/java/runtime/ForeignEnumFunctorDesc.java
index 8f41dc9..cddd51b 100644
--- a/java/runtime/ForeignEnumFunctorDesc.java
+++ b/java/runtime/ForeignEnumFunctorDesc.java
@@ -12,7 +12,10 @@ public class ForeignEnumFunctorDesc {
public int foreign_enum_functor_ordinal;
public int foreign_enum_functor_value;
- public ForeignEnumFunctorDesc(String name, int ordinal, int value) {
+ public ForeignEnumFunctorDesc() {
+ }
+
+ public void init(String name, int ordinal, int value) {
foreign_enum_functor_name = name;
foreign_enum_functor_ordinal = ordinal;
foreign_enum_functor_value = value;
diff --git a/java/runtime/MethodPtr.java b/java/runtime/MethodPtr.java
index b406462..f490a19 100644
--- a/java/runtime/MethodPtr.java
+++ b/java/runtime/MethodPtr.java
@@ -10,6 +10,6 @@
package mercury.runtime;
public interface MethodPtr {
- public abstract java.lang.Object call___0_0(java.lang.Object[] args);
+ public abstract java.lang.Object call___0_0(java.lang.Object... args);
}
diff --git a/java/runtime/TypeClassConstraint.java
b/java/runtime/TypeClassConstraint.java
index 717cadb..473e43a 100644
--- a/java/runtime/TypeClassConstraint.java
+++ b/java/runtime/TypeClassConstraint.java
@@ -13,20 +13,11 @@ public class TypeClassConstraint {
public TypeClassDeclStruct tc_constr_type_class;
public PseudoTypeInfo tc_constr_arg_ptis[];
- public TypeClassConstraint(TypeClassDeclStruct type_class)
+ public TypeClassConstraint()
{
- tc_constr_type_class = type_class;
- tc_constr_arg_ptis = new PseudoTypeInfo[] {};
}
- public TypeClassConstraint(TypeClassDeclStruct type_class,
- PseudoTypeInfo[] ptis)
- {
- tc_constr_type_class = type_class;
- tc_constr_arg_ptis = ptis;
- }
-
- public TypeClassConstraint(TypeClassDeclStruct type_class,
+ public void init(TypeClassDeclStruct type_class,
// XXX Object[] should be mercury.runtime.PseudoTypeInfo[],
// but mlds_to_java.m generates Object[] since
// init_array/1 doesn't give type info
@@ -38,47 +29,4 @@ public class TypeClassConstraint {
tc_constr_arg_ptis[i] = (PseudoTypeInfo) ptis[i];
}
}
-
- public TypeClassConstraint(TypeClassDeclStruct type_class,
- PseudoTypeInfo pti1)
- {
- tc_constr_type_class = type_class;
- tc_constr_arg_ptis = new PseudoTypeInfo[] { pti1 };
- }
-
- public TypeClassConstraint(TypeClassDeclStruct type_class,
- PseudoTypeInfo pti1, PseudoTypeInfo pti2)
- {
- tc_constr_type_class = type_class;
- tc_constr_arg_ptis = new PseudoTypeInfo[] { pti1, pti2 };
- }
-
- public TypeClassConstraint(TypeClassDeclStruct type_class,
- PseudoTypeInfo pti1, PseudoTypeInfo pti2,
- PseudoTypeInfo pti3)
- {
- tc_constr_type_class = type_class;
- tc_constr_arg_ptis = new PseudoTypeInfo[] { pti1, pti2, pti3 };
- }
-
- public TypeClassConstraint(TypeClassDeclStruct type_class,
- PseudoTypeInfo pti1, PseudoTypeInfo pti2,
- PseudoTypeInfo pti3, PseudoTypeInfo pti4)
- {
- tc_constr_type_class = type_class;
- tc_constr_arg_ptis = new PseudoTypeInfo[]
- { pti1, pti2, pti3, pti4 };
- }
-
- public TypeClassConstraint(TypeClassDeclStruct type_class,
- PseudoTypeInfo pti1, PseudoTypeInfo pti2,
- PseudoTypeInfo pti3, PseudoTypeInfo pti4,
- PseudoTypeInfo pti5)
- {
- tc_constr_type_class = type_class;
- tc_constr_arg_ptis = new PseudoTypeInfo[] {
- pti1, pti2, pti3, pti4, pti5 };
- }
-
- // XXX type classes with arity > 5 not supported
}
diff --git a/java/runtime/TypeClassDeclStruct.java
b/java/runtime/TypeClassDeclStruct.java
index 9f147b4..cba08da 100644
--- a/java/runtime/TypeClassDeclStruct.java
+++ b/java/runtime/TypeClassDeclStruct.java
@@ -16,7 +16,11 @@ public class TypeClassDeclStruct {
public int tc_decl_num_supers; // redundant
public TypeClassConstraint tc_decl_supers;
- public TypeClassDeclStruct(TypeClassId id, int version_number,
+ public TypeClassDeclStruct()
+ {
+ }
+
+ public void init(TypeClassId id, int version_number,
int num_supers, TypeClassConstraint supers)
{
tc_decl_id = id;
diff --git a/java/runtime/TypeClassId.java b/java/runtime/TypeClassId.java
index 9985cab..032141e 100644
--- a/java/runtime/TypeClassId.java
+++ b/java/runtime/TypeClassId.java
@@ -18,7 +18,11 @@ public class TypeClassId {
public String[] tc_id_var_names;
public TypeClassMethod[] tc_id_methods;
- public TypeClassId(String module_name, String name, int arity,
+ public TypeClassId()
+ {
+ }
+
+ public void init(String module_name, String name, int arity,
int num_type_vars, int num_methods,
String[] var_names, TypeClassMethod[] methods)
{
diff --git a/java/runtime/TypeCtorInfo_Struct.java
b/java/runtime/TypeCtorInfo_Struct.java
index 5ff8df8..704d874 100644
--- a/java/runtime/TypeCtorInfo_Struct.java
+++ b/java/runtime/TypeCtorInfo_Struct.java
@@ -25,7 +25,11 @@ public class TypeCtorInfo_Struct extends PseudoTypeInfo {
public /* short */ int type_ctor_flags;
public int[] type_functor_number_map;
- public TypeCtorInfo_Struct(
+ public TypeCtorInfo_Struct()
+ {
+ }
+
+ public void init(
int type_arity, int version, int num_ptags, int rep,
Object unify_proc, Object compare_proc,
String module, String name,
diff --git a/java/runtime/TypeInfo_Struct.java
b/java/runtime/TypeInfo_Struct.java
index 9b0a873..6796ded 100644
--- a/java/runtime/TypeInfo_Struct.java
+++ b/java/runtime/TypeInfo_Struct.java
@@ -11,16 +11,13 @@ public class TypeInfo_Struct extends PseudoTypeInfo {
public TypeCtorInfo_Struct type_ctor;
public PseudoTypeInfo args[];
- public TypeInfo_Struct(TypeCtorInfo_Struct tc)
+ public TypeInfo_Struct()
{
- type_ctor = tc;
}
- // raw constructor
- public TypeInfo_Struct(TypeCtorInfo_Struct tc, PseudoTypeInfo... as)
+ public TypeInfo_Struct(TypeCtorInfo_Struct tc)
{
type_ctor = tc;
- args = as;
}
// copy constructor
@@ -33,42 +30,44 @@ public class TypeInfo_Struct extends PseudoTypeInfo {
args = ti.args;
}
+ public void init(TypeCtorInfo_Struct tc, PseudoTypeInfo[] as)
+ {
+ type_ctor = tc;
+ args = as;
+ }
+
// XXX "as" should have type PseudoTypeInfo[],
// but mlds_to_java.m uses Object[]
// because init_array/1 does not store the type.
- public TypeInfo_Struct(TypeCtorInfo_Struct tc, int arity, Object[] as)
+ public void init(TypeCtorInfo_Struct tc, int arity, Object[] as)
{
assert arity == as.length;
- type_ctor = tc;
- args = new PseudoTypeInfo[as.length];
- for (int i = 0; i < as.length; i++) {
- args[i] = (PseudoTypeInfo) as[i];
- }
+ init(tc, as);
}
// XXX "as" should have type PseudoTypeInfo[],
// but mlds_to_java.m uses Object[]
// because init_array/1 does not store the type.
- public TypeInfo_Struct(TypeCtorInfo_Struct tc, Object[] as)
+ public void init(TypeCtorInfo_Struct tc, Object[] as)
{
- type_ctor = tc;
- args = new PseudoTypeInfo[as.length];
+ PseudoTypeInfo[] ptis = new PseudoTypeInfo[as.length];
for (int i = 0; i < as.length; i++) {
- args[i] = (PseudoTypeInfo) as[i];
+ ptis[i] = (PseudoTypeInfo) as[i];
}
+ init(tc, ptis);
}
// XXX untested guess
public TypeInfo_Struct(TypeInfo_Struct ti, int arity, Object... as)
{
- this(ti.type_ctor, arity, as);
+ init(ti.type_ctor, arity, as);
}
// XXX untested guess
public TypeInfo_Struct(TypeInfo_Struct ti, Object... as)
{
- this(ti.type_ctor, as);
+ init(ti.type_ctor, as);
}
// XXX a temp hack just to get things to run
diff --git a/library/builtin.m b/library/builtin.m
index 5c1bf0f..91cb38f 100644
--- a/library/builtin.m
+++ b/library/builtin.m
@@ -1010,16 +1010,14 @@ namespace mercury.builtin {
unify_2_p_0 (mercury.runtime.TypeInfo_Struct ti,
java.lang.Object x, java.lang.Object y)
{
- // stub only
- throw new java.lang.Error (""unify/3 not implemented"");
+ return mercury.rtti_implementation.generic_unify_2_p_0(ti, x, y);
}
public static Comparison_result_0
compare_3_p_0 (mercury.runtime.TypeInfo_Struct ti,
java.lang.Object x, java.lang.Object y)
{
- // stub only
- throw new java.lang.Error (""compare/3 not implemented"");
+ return mercury.rtti_implementation.generic_compare_3_p_0(ti, x, y);
}
public static Comparison_result_0
diff --git a/library/private_builtin.m b/library/private_builtin.m
index 8894046..9d0f65d 100644
--- a/library/private_builtin.m
+++ b/library/private_builtin.m
@@ -540,7 +540,9 @@ public static int MR_TYPECTOR_REP_STABLE_FOREIGN =40;
public static int MR_TYPECTOR_REP_PSEUDOTYPEDESC =41;
public static int MR_TYPECTOR_REP_DUMMY =42;
public static int MR_TYPECTOR_REP_BITMAP =43;
-public static int MR_TYPECTOR_REP_UNKNOWN =44;
+public static int MR_TYPECTOR_REP_FOREIGN_ENUM =44;
+public static int MR_TYPECTOR_REP_FOREIGN_ENUM_USEREQ =45;
+public static int MR_TYPECTOR_REP_UNKNOWN =46;
public static int MR_SECTAG_NONE = 0;
public static int MR_SECTAG_LOCAL = 1;
@@ -1648,7 +1650,9 @@ no_clauses(PredName) :-
public static final int MR_TYPECTOR_REP_PSEUDOTYPEDESC = 41;
public static final int MR_TYPECTOR_REP_DUMMY = 42;
public static final int MR_TYPECTOR_REP_BITMAP = 43;
- public static final int MR_TYPECTOR_REP_UNKNOWN = 44;
+ public static final int MR_TYPECTOR_REP_FOREIGN_ENUM = 44;
+ public static final int MR_TYPECTOR_REP_FOREIGN_ENUM_USEREQ = 45;
+ public static final int MR_TYPECTOR_REP_UNKNOWN = 46;
public static final int MR_SECTAG_NONE = 0;
public static final int MR_SECTAG_LOCAL = 1;
diff --git a/library/rtti_implementation.m b/library/rtti_implementation.m
index 0e17266..44206a9 100644
--- a/library/rtti_implementation.m
+++ b/library/rtti_implementation.m
@@ -34,6 +34,8 @@
%
% XXX Also, the existing Java code needs to be reviewed.
%
+% XXX Also there are too many unsafe_casts.
+%
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -172,13 +174,12 @@
:- pragma foreign_type("Java", type_info,
"mercury.runtime.TypeInfo_Struct").
-:- type compare_pred ---> compare_pred(c_pointer).
-
:- type type_layout ---> type_layout(c_pointer).
:- pragma foreign_type("Java", type_layout, "mercury.runtime.TypeLayout").
-:- type pred_type ---> pred_type(c_pointer).
-:- type pseudo_type_info ---> pred_type(c_pointer).
+:- type pseudo_type_info ---> pseudo_type_info.
+:- pragma foreign_type("Java", pseudo_type_info,
+ "mercury.runtime.PseudoTypeInfo").
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -189,7 +190,7 @@
% See MR_get_num_functors in runtime/mercury_construct.c
num_functors(TypeDesc) = NumFunctors :-
TypeCtorInfo = get_type_ctor_info(unsafe_cast(TypeDesc)),
- TypeCtorRep = TypeCtorInfo ^ type_ctor_rep,
+ TypeCtorRep = get_type_ctor_rep(TypeCtorInfo),
(
( TypeCtorRep = tcr_du
; TypeCtorRep = tcr_du_usereq
@@ -271,7 +272,7 @@ get_functor_impl(TypeDesc, FunctorNumber,
FunctorNumber < TypeDesc ^ num_functors,
TypeInfo = unsafe_cast(TypeDesc),
TypeCtorInfo = get_type_ctor_info(TypeInfo),
- TypeCtorRep = TypeCtorInfo ^ type_ctor_rep,
+ TypeCtorRep = get_type_ctor_rep(TypeCtorInfo),
(
( TypeCtorRep = tcr_du
; TypeCtorRep = tcr_du_usereq
@@ -354,7 +355,7 @@ get_functor_impl(TypeDesc, FunctorNumber,
get_functor_du(TypeCtorRep, TypeInfo, TypeCtorInfo, FunctorNumber,
FunctorName, Arity, TypeDescList, Names) :-
- TypeFunctors = TypeCtorInfo ^ type_ctor_functors,
+ TypeFunctors = get_type_ctor_functors(TypeCtorInfo),
DuFunctorDesc = TypeFunctors ^ du_functor_desc(TypeCtorRep, FunctorNumber),
% XXX We don't handle functors with existentially quantified arguments.
@@ -387,9 +388,9 @@ get_functor_du(TypeCtorRep, TypeInfo,
TypeCtorInfo, FunctorNumber,
get_functor_enum(TypeCtorRep, TypeCtorInfo, FunctorNumber, FunctorName, Arity,
TypeDescList, Names) :-
- TypeFunctors = TypeCtorInfo ^ type_ctor_functors,
- EnumFunctorDesc = TypeFunctors ^
- enum_functor_desc(TypeCtorRep, FunctorNumber),
+ TypeLayout = get_type_layout(TypeCtorInfo),
+ EnumFunctorDesc = get_enum_functor_desc(TypeCtorRep, FunctorNumber,
+ TypeLayout),
FunctorName = EnumFunctorDesc ^ enum_functor_name,
Arity = 0,
@@ -402,7 +403,7 @@ get_functor_enum(TypeCtorRep, TypeCtorInfo,
FunctorNumber, FunctorName, Arity,
get_functor_notag(TypeCtorRep, TypeCtorInfo, FunctorNumber, FunctorName, Arity,
TypeDescList, Names) :-
- TypeFunctors = TypeCtorInfo ^ type_ctor_functors,
+ TypeFunctors = get_type_ctor_functors(TypeCtorInfo),
NoTagFunctorDesc = TypeFunctors ^
notag_functor_desc(TypeCtorRep, FunctorNumber),
@@ -451,7 +452,7 @@ get_type_info(_) = _ :-
get_var_arity_typeinfo_arity(TypeInfo::in) = (Arity::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
- Arity = ((TypeInfo_Struct) TypeInfo).args.length;
+ Arity = TypeInfo.args.length;
").
:- pragma foreign_proc("C#",
@@ -470,7 +471,7 @@ get_var_arity_typeinfo_arity(_) = _ :-
generic_compare(Res, X, Y) :-
TypeInfo = get_type_info(X),
TypeCtorInfo = get_type_ctor_info(TypeInfo),
- TypeCtorRep = TypeCtorInfo ^ type_ctor_rep,
+ TypeCtorRep = get_type_ctor_rep(TypeCtorInfo),
(
TypeCtorRep = tcr_tuple
->
@@ -521,7 +522,7 @@ generic_compare(Res, X, Y) :-
generic_unify(X, Y) :-
TypeInfo = get_type_info(X),
TypeCtorInfo = get_type_ctor_info(TypeInfo),
- TypeCtorRep = TypeCtorInfo ^ type_ctor_rep,
+ TypeCtorRep = get_type_ctor_rep(TypeCtorInfo),
(
TypeCtorRep = tcr_tuple
->
@@ -633,6 +634,12 @@ compare_tuple_pos(Loc, TupleArity, TypeInfo,
Result, TermA, TermB) :-
% We first give "unimplemented" definitions in Mercury, which will be
% used by default.
+:- type unify_or_compare_pred
+ ---> unify_or_compare_pred.
+
+:- pragma foreign_type("Java", unify_or_compare_pred,
+ "mercury.runtime.MethodPtr").
+
:- pred semidet_call_3(P::in, T::in, U::in) is semidet.
semidet_call_3(_::in, _::in, _::in) :-
semidet_unimplemented("semidet_call_3").
@@ -782,6 +789,105 @@ result_call_9(_::in, (=)::out, _::in, _::in,
_::in, _::in, _::in,
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
+ % We override the above definitions in the Java backend.
+
+:- pragma foreign_proc("Java",
+ semidet_call_3(Pred::in, X::in, Y::in),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ MethodPtr P = (MethodPtr) Pred;
+ Object res = P.call___0_0(X, Y);
+ succeeded = ((Boolean) res).booleanValue();
+").
+:- pragma foreign_proc("Java",
+ semidet_call_4(Pred::in, A::in, X::in, Y::in),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ MethodPtr P = (MethodPtr) Pred;
+ Object res = P.call___0_0(A, X, Y);
+ succeeded = ((Boolean) res).booleanValue();
+").
+:- pragma foreign_proc("Java",
+ semidet_call_5(Pred::in, A::in, B::in, X::in, Y::in),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ MethodPtr P = (MethodPtr) Pred;
+ Object res = P.call___0_0(A, B, X, Y);
+ succeeded = ((Boolean) res).booleanValue();
+").
+:- pragma foreign_proc("Java",
+ semidet_call_6(Pred::in, A::in, B::in, C::in, X::in, Y::in),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ MethodPtr P = (MethodPtr) Pred;
+ Object res = P.call___0_0(A, B, C, X, Y);
+ succeeded = ((Boolean) res).booleanValue();
+").
+:- pragma foreign_proc("Java",
+ semidet_call_7(Pred::in, A::in, B::in, C::in, D::in, X::in, Y::in),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ MethodPtr P = (MethodPtr) Pred;
+ Object res = P.call___0_0(A, B, C, D, X, Y);
+ succeeded = ((Boolean) res).booleanValue();
+").
+:- pragma foreign_proc("Java",
+ semidet_call_8(Pred::in, A::in, B::in, C::in, D::in, E::in, X::in, Y::in),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ MethodPtr P = (MethodPtr) Pred;
+ Object res = P.call___0_0(A, B, C, D, E, X, Y);
+ succeeded = ((Boolean) res).booleanValue();
+").
+
+:- pragma foreign_proc("Java",
+ result_call_4(Pred::in, Res::out, X::in, Y::in),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ MethodPtr P = (MethodPtr) Pred;
+ Res = P.call___0_0(X, Y);
+").
+
+:- pragma foreign_proc("Java",
+ result_call_5(Pred::in, Res::out, A::in, X::in, Y::in),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ MethodPtr P = (MethodPtr) Pred;
+ Res = P.call___0_0(A, X, Y);
+").
+:- pragma foreign_proc("Java",
+ result_call_6(Pred::in, Res::out, A::in, B::in, X::in, Y::in),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ MethodPtr P = (MethodPtr) Pred;
+ Res = P.call___0_0(A, B, X, Y);
+").
+:- pragma foreign_proc("Java",
+ result_call_7(Pred::in, Res::out, A::in, B::in, C::in, X::in, Y::in),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ MethodPtr P = (MethodPtr) Pred;
+ Res = P.call___0_0(A, B, C, X, Y);
+").
+:- pragma foreign_proc("Java",
+ result_call_8(Pred::in, Res::out, A::in, B::in, C::in, D::in,
X::in, Y::in),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ MethodPtr P = (MethodPtr) Pred;
+ Res = P.call___0_0(A, B, C, D, X, Y);
+").
+:- pragma foreign_proc("Java",
+ result_call_9(Pred::in, Res::out, A::in, B::in, C::in, D::in, E::in,
+ X::in, Y::in),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ MethodPtr P = (MethodPtr) Pred;
+ Res = P.call___0_0(A, B, C, D, E, X, Y);
+").
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
compare_type_infos(Res, TypeInfo1, TypeInfo2) :-
( same_pointer_value(TypeInfo1, TypeInfo2) ->
Res = (=)
@@ -869,9 +975,10 @@ compare_var_arity_typeinfos(Loc, Arity, Result,
TypeInfoA, TypeInfoB) :-
:- pred type_ctor_is_variable_arity(type_ctor_info::in) is semidet.
type_ctor_is_variable_arity(TypeCtorInfo) :-
- ( TypeCtorInfo ^ type_ctor_rep = tcr_pred
- ; TypeCtorInfo ^ type_ctor_rep = tcr_func
- ; TypeCtorInfo ^ type_ctor_rep = tcr_tuple
+ TypeCtorRep = get_type_ctor_rep(TypeCtorInfo),
+ ( TypeCtorRep = tcr_pred
+ ; TypeCtorRep = tcr_func
+ ; TypeCtorRep = tcr_tuple
).
%-----------------------------------------------------------------------------%
@@ -887,11 +994,12 @@ type_ctor_is_variable_arity(TypeCtorInfo) :-
collapse_equivalences(TypeInfo) = NewTypeInfo :-
TypeCtorInfo = get_type_ctor_info(TypeInfo),
+ TypeCtorRep = get_type_ctor_rep(TypeCtorInfo),
(
(
- TypeCtorInfo ^ type_ctor_rep = tcr_equiv_ground
+ TypeCtorRep = tcr_equiv_ground
;
- TypeCtorInfo ^ type_ctor_rep = tcr_equiv
+ TypeCtorRep = tcr_equiv
)
->
error("rtti_implementation.m: unimplemented: " ++
@@ -953,7 +1061,7 @@ iterate_foldl(Start, Max, Pred, !Acc) :-
deconstruct(Term, NonCanon, Functor, Arity, Arguments) :-
TypeInfo = get_type_info(Term),
TypeCtorInfo = get_type_ctor_info(TypeInfo),
- TypeCtorRep = type_ctor_rep(TypeCtorInfo),
+ TypeCtorRep = get_type_ctor_rep(TypeCtorInfo),
deconstruct_2(Term, TypeInfo, TypeCtorInfo, TypeCtorRep, NonCanon,
Functor, Arity, Arguments).
@@ -979,15 +1087,15 @@ deconstruct_2(Term, TypeInfo, TypeCtorInfo,
TypeCtorRep, NonCanon,
NonCanon, Functor, Arity, Arguments)
;
TypeCtorRep = tcr_enum,
- TypeFunctors = type_ctor_functors(TypeCtorInfo),
- EnumFunctorDesc = enum_functor_desc(TypeCtorRep,
- unsafe_get_enum_value(Term), TypeFunctors),
+ TypeLayout = get_type_layout(TypeCtorInfo),
+ EnumFunctorDesc = get_enum_functor_desc(TypeCtorRep,
+ unsafe_get_enum_value(Term), TypeLayout),
Functor = enum_functor_name(EnumFunctorDesc),
Arity = 0,
Arguments = []
;
TypeCtorRep = tcr_foreign_enum,
- TypeFunctors = type_ctor_functors(TypeCtorInfo),
+ TypeFunctors = get_type_ctor_functors(TypeCtorInfo),
ForeignEnumFunctorDesc = foreign_enum_functor_desc(TypeCtorRep,
unsafe_get_foreign_enum_value(Term), TypeFunctors),
Functor = foreign_enum_functor_name(ForeignEnumFunctorDesc),
@@ -999,8 +1107,8 @@ deconstruct_2(Term, TypeInfo, TypeCtorInfo,
TypeCtorRep, NonCanon,
NonCanon, Functor, Arity, Arguments)
;
TypeCtorRep = tcr_dummy,
- TypeFunctors = type_ctor_functors(TypeCtorInfo),
- EnumFunctorDesc = enum_functor_desc(TypeCtorRep, 0, TypeFunctors),
+ TypeLayout = get_type_layout(TypeCtorInfo),
+ EnumFunctorDesc = get_enum_functor_desc(TypeCtorRep, 0, TypeLayout),
Functor = enum_functor_name(EnumFunctorDesc),
Arity = 0,
Arguments = []
@@ -1011,7 +1119,7 @@ deconstruct_2(Term, TypeInfo, TypeCtorInfo,
TypeCtorRep, NonCanon,
;
TypeCtorRep = tcr_du,
- LayoutInfo = type_layout(TypeCtorInfo),
+ LayoutInfo = get_type_layout(TypeCtorInfo),
PTag = get_primary_tag(Term),
PTagEntry = LayoutInfo ^ ptag_index(PTag),
SecTagLocn = PTagEntry ^ sectag_locn,
@@ -1371,10 +1479,10 @@ expand_type_name(TypeCtorInfo, Wrap) = Name :-
%
:- some [T] func get_arg(U, int, sectag_locn, du_functor_desc, type_info) = T.
-get_arg(Term, Index, SecTagLocn, FunctorDesc, TypeInfo) = (Arg) :-
+get_arg(Term, Index, SecTagLocn, FunctorDesc, TypeInfo) = Arg :-
( ExistInfo = FunctorDesc ^ du_functor_exist_info ->
- ExtraArgs = (ExistInfo ^ exist_info_typeinfos_plain) +
- (ExistInfo ^ exist_info_tcis)
+ ExtraArgs = exist_info_typeinfos_plain(ExistInfo) +
+ exist_info_tcis(ExistInfo)
;
ExtraArgs = 0
),
@@ -1395,13 +1503,13 @@ get_arg(Term, Index, SecTagLocn, FunctorDesc,
TypeInfo) = (Arg) :-
:- pragma promise_pure(high_level_data/0).
:- pragma foreign_proc("Java",
high_level_data,
- [will_not_call_mercury, thread_safe],
+ [will_not_call_mercury, promise_pure, thread_safe],
"
succeeded = true;
").
:- pragma foreign_proc("C#",
high_level_data,
- [will_not_call_mercury, thread_safe],
+ [will_not_call_mercury, promise_pure, thread_safe],
"
#if MR_HIGHLEVEL_DATA
SUCCESS_INDICATOR = true;
@@ -1416,21 +1524,16 @@ high_level_data :-
semidet_succeed
).
-:- pred get_arg_type_info(type_info::in, P::in, T::in,
+:- pred get_arg_type_info(type_info::in, pseudo_type_info::in, T::in,
du_functor_desc::in, type_info::out) is det.
get_arg_type_info(TypeInfoParams, PseudoTypeInfo, Term, FunctorDesc,
ArgTypeInfo) :-
- ( typeinfo_is_variable(PseudoTypeInfo, VarNum) ->
+ ( pseudo_type_info_is_variable(PseudoTypeInfo, VarNum) ->
get_type_info_for_var(TypeInfoParams, VarNum, Term, FunctorDesc,
- ExpandedTypeInfo),
- ( typeinfo_is_variable(ExpandedTypeInfo, _) ->
- error("get_arg_type_info: unbound type variable")
- ;
- ArgTypeInfo = ExpandedTypeInfo
- )
+ ArgTypeInfo)
;
- CastTypeInfo = type_info_cast(PseudoTypeInfo),
+ CastTypeInfo = type_info_from_pseudo_type_info(PseudoTypeInfo),
TypeCtorInfo = get_type_ctor_info(CastTypeInfo),
( type_ctor_is_variable_arity(TypeCtorInfo) ->
Arity = pseudotypeinfo_get_higher_order_arity(CastTypeInfo),
@@ -1453,16 +1556,13 @@ get_arg_type_info(TypeInfoParams,
PseudoTypeInfo, Term, FunctorDesc,
(
TI0 = yes(TypeInfo0),
unsafe_promise_unique(TypeInfo0, TypeInfo1),
- update_type_info_index(I, ETypeInfo,
- TypeInfo1, TypeInfo),
- TI = yes(TypeInfo)
+ set_type_info_index(I, ETypeInfo, TypeInfo1, TypeInfo)
;
TI0 = no,
- NewTypeInfo0 = new_type_info(CastTypeInfo, UpperBound),
- update_type_info_index(I, ETypeInfo,
- NewTypeInfo0, NewTypeInfo),
- TI = yes(NewTypeInfo)
- )
+ TypeInfo0 = new_type_info(CastTypeInfo, UpperBound),
+ set_type_info_index(I, ETypeInfo, TypeInfo0, TypeInfo)
+ ),
+ TI = yes(TypeInfo)
)
),
iterate_foldl(StartRegionSize, UpperBound, ProcessArgTypeInfos,
@@ -1488,62 +1588,71 @@ pseudotypeinfo_get_higher_order_arity(_) = 1 :-
%
:- func new_type_info(type_info::in, int::in) = (type_info::uo) is det.
-new_type_info(TypeInfo::in, _::in) = (NewTypeInfo::uo) :-
+new_type_info(TypeInfo, _) = NewTypeInfo :-
unsafe_promise_unique(TypeInfo, NewTypeInfo),
det_unimplemented("new_type_info").
:- pragma foreign_proc("C#",
new_type_info(OldTypeInfo::in, Arity::in) = (NewTypeInfo::uo),
- [promise_pure],
+ [will_not_call_mercury, promise_pure, thread_safe],
"
NewTypeInfo = new object[Arity + 1];
System.Array.Copy(OldTypeInfo, NewTypeInfo, OldTypeInfo.Length);
").
+:- pragma foreign_proc("Java",
+ new_type_info(OldTypeInfo::in, Arity::in) = (NewTypeInfo::uo),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ NewTypeInfo = new TypeInfo_Struct();
+ PseudoTypeInfo[] args = new PseudoTypeInfo[Arity];
+ NewTypeInfo.init(OldTypeInfo.type_ctor, args);
+").
+
% Get the pseudo-typeinfo at the given index from the argument types.
%
-:- some [T] func get_pti_from_arg_types(arg_types, int) = T.
+:- func get_pti_from_arg_types(arg_types, int) = pseudo_type_info.
-get_pti_from_arg_types(_::in, _::in) = (42::out) :-
+get_pti_from_arg_types(_, _) = pseudo_type_info :-
det_unimplemented("get_pti_from_arg_types").
:- pragma foreign_proc("Java",
get_pti_from_arg_types(ArgTypes::in, Index::in) = (ArgTypeInfo::out),
- [will_not_call_mercury, promise_pure],
+ [will_not_call_mercury, promise_pure, thread_safe],
"
- // XXX This should be something else.
- TypeInfo_for_T = null;
-
ArgTypeInfo = ArgTypes[Index];
").
:- pragma foreign_proc("C#",
get_pti_from_arg_types(ArgTypes::in, Index::in) = (ArgTypeInfo::out),
- [promise_pure],
+ [will_not_call_mercury, promise_pure, thread_safe],
"
- // XXX This should be something else.
- // TypeInfo_for_T
-
ArgTypeInfo = ArgTypes[Index];
").
% Get the pseudo-typeinfo at the given index from a type-info.
%
-:- some [T] func get_pti_from_type_info(type_info, int) = T.
+:- func get_pti_from_type_info(type_info, int) = pseudo_type_info.
-get_pti_from_type_info(_::in, _::in) = (42::out) :-
- det_unimplemented("get_pti_from_type_info").
+get_pti_from_type_info(_, _) = _ :-
+ % det_unimplemented("get_pti_from_type_info").
+ private_builtin.sorry("get_pti_from_type_info").
:- pragma foreign_proc("C#",
get_pti_from_type_info(TypeInfo::in, Index::in) = (PTI::out),
- [promise_pure],
+ [will_not_call_mercury, promise_pure, thread_safe],
"
- // XXX This should be something else.
- TypeInfo_for_T = null;
-
PTI = TypeInfo[Index];
").
+:- pragma foreign_proc("Java",
+ get_pti_from_type_info(TypeInfo::in, Index::in) = (PTI::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ /* XXX I think the code assumes index 0 is the type_ctor? */
+ PTI = TypeInfo.args[Index - 1];
+").
+
% Get the type info for a particular type variable number
% (it might be in the type_info or in the term itself).
%
@@ -1577,21 +1686,32 @@ get_type_info_for_var(TypeInfo, VarNum, Term,
FunctorDesc, ArgTypeInfo) :-
% An unchecked cast to type_info (for pseudo-typeinfos).
%
-:- func type_info_cast(T) = type_info.
+:- func type_info_from_pseudo_type_info(pseudo_type_info) = type_info.
+
+type_info_from_pseudo_type_info(X) = unsafe_cast(X).
-type_info_cast(X) = unsafe_cast(X).
+:- pragma foreign_proc("Java",
+ type_info_from_pseudo_type_info(PseudoTypeInfo::in) = (TypeInfo::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ if (PseudoTypeInfo instanceof TypeCtorInfo_Struct) {
+ TypeInfo = new TypeInfo_Struct((TypeCtorInfo_Struct) PseudoTypeInfo);
+ } else {
+ TypeInfo = (TypeInfo_Struct) PseudoTypeInfo;
+ }
+").
- % Get a subterm term, given its type_info, the original term, its index
+ % Get a subterm T, given its type_info, the original term U, its index
% and the start region size.
%
:- some [T] func get_subterm(type_info, U, int, int) = T.
-get_subterm(_::in, _::in, _::in, _::in) = (42::out) :-
+get_subterm(_, _, _, _) = 42 :-
det_unimplemented("get_subterm").
:- pragma foreign_proc("C#",
get_subterm(TypeInfo::in, Term::in, Index::in, ExtraArgs::in) = (Arg::out),
- [promise_pure],
+ [will_not_call_mercury, promise_pure, thread_safe],
"
// Mention TypeInfo_for_U to avoid a warning.
@@ -1606,16 +1726,56 @@ get_subterm(_::in, _::in, _::in, _::in) = (42::out) :-
TypeInfo_for_T = TypeInfo;
").
- % Test whether a type info is variable.
+:- pragma foreign_decl("Java", local,
+"
+ import java.lang.reflect.Field;
+").
+
+:- pragma foreign_proc("Java",
+ get_subterm(TypeInfo::in, Term::in, Index::in, ExtraArgs::in) = (Arg::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ // Mention TypeInfo_for_U to avoid a warning.
+
+ // Currently we use reflection to extract the field.
+ // It probably would be more efficient to generate
+ // a method for each class to return its n'th field.
+
+ if (Term instanceof Object[]) {
+ int i = Index + ExtraArgs;
+ Arg = ((Object[]) Term)[i];
+ } else {
+ try {
+ // The F<i> field variables are numbered from 1.
+ int i = 1 + Index + ExtraArgs;
+ Field f = Term.getClass().getDeclaredField(""F"" + i);
+ Arg = f.get(Term);
+ } catch (IllegalAccessException e) {
+ throw new Error(e);
+ } catch (NoSuchFieldException e) {
+ throw new Error(e);
+ }
+ }
+
+ assert Arg != null;
+
+ TypeInfo_for_T = TypeInfo;
+").
+
+ % Test whether a (pseudo-) type info is variable.
+ % The argument type is pseudo_type_info because when we call this we have a
+ % pseudo_type_info but aren't sure if it's actually a variable or a
+ % type_info.
%
-:- pred typeinfo_is_variable(T::in, int::out) is semidet.
+:- pred pseudo_type_info_is_variable(pseudo_type_info::in, int::out)
+ is semidet.
-typeinfo_is_variable(_::in, 42::out) :-
- semidet_unimplemented("typeinfo_is_variable").
+pseudo_type_info_is_variable(_, 42) :-
+ semidet_unimplemented("pseudo_type_info_is_variable").
:- pragma foreign_proc("C#",
- typeinfo_is_variable(TypeInfo::in, VarNum::out),
- [promise_pure],
+ pseudo_type_info_is_variable(TypeInfo::in, VarNum::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
"
try {
VarNum = System.Convert.ToInt32(TypeInfo);
@@ -1627,8 +1787,8 @@ typeinfo_is_variable(_::in, 42::out) :-
").
:- pragma foreign_proc("Java",
- typeinfo_is_variable(TypeInfo::in, VarNum::out),
- [will_not_call_mercury, promise_pure],
+ pseudo_type_info_is_variable(TypeInfo::in, VarNum::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
"
succeeded = (TypeInfo.getClass() == mercury.runtime.PseudoTypeInfo.class);
if (succeeded) {
@@ -1741,7 +1901,7 @@ pseudotypeinfo_max_var = 1024.
get_type_ctor_info(TypeInfo::in) = (TypeCtorInfo::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
- TypeCtorInfo = ((mercury.runtime.TypeInfo_Struct) TypeInfo).type_ctor;
+ TypeCtorInfo = TypeInfo.type_ctor;
").
:- pragma foreign_proc("C",
@@ -1776,6 +1936,13 @@ same_pointer_value(X, Y) :-
same_pointer_value_untyped(X, Y).
SUCCESS_INDICATOR = (T1 == T2);
").
+:- pragma foreign_proc("Java",
+ same_pointer_value_untyped(T1::in, T2::in),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ succeeded = (T1 == T2);
+").
+
same_pointer_value_untyped(_, _) :-
% This version is only used for back-ends for which there is no
% matching foreign_proc version.
@@ -1795,7 +1962,7 @@ get_remote_secondary_tag(_::in) = (0::out) :-
:- pragma foreign_proc("C#",
get_primary_tag(X::in) = (Tag::out),
- [promise_pure],
+ [will_not_call_mercury, promise_pure, thread_safe],
"
// We don't look at X to find the tag, for .NET low-level data
// there is no primary tag, so we always return zero.
@@ -1804,7 +1971,7 @@ get_remote_secondary_tag(_::in) = (0::out) :-
:- pragma foreign_proc("C#",
get_remote_secondary_tag(X::in) = (Tag::out),
- [promise_pure],
+ [will_not_call_mercury, promise_pure, thread_safe],
"
try {
// try the low-level data representation
@@ -1818,7 +1985,7 @@ get_remote_secondary_tag(_::in) = (0::out) :-
:- pragma foreign_proc("Java",
get_primary_tag(_X::in) = (Tag::out),
- [promise_pure],
+ [will_not_call_mercury, promise_pure, thread_safe],
"
// For the Java back-end, there is no primary tag, so always return 0.
Tag = 0;
@@ -1826,7 +1993,7 @@ get_remote_secondary_tag(_::in) = (0::out) :-
:- pragma foreign_proc("Java",
get_remote_secondary_tag(X::in) = (Tag::out),
- [promise_pure],
+ [will_not_call_mercury, promise_pure, thread_safe],
"
// If there is a secondary tag, it will be in a member called
// `data_tag', which we obtain by reflection.
@@ -1878,14 +2045,14 @@ ptag_index(_::in, TypeLayout::in) =
(unsafe_cast(TypeLayout)::out) :-
:- pragma foreign_proc("C#",
ptag_index(X::in, TypeLayout::in) = (PtagEntry::out),
- [promise_pure],
+ [will_not_call_mercury, promise_pure, thread_safe],
"
PtagEntry = (object[]) TypeLayout[X];
").
:- pragma foreign_proc("Java",
ptag_index(X::in, TypeLayout::in) = (PtagEntry::out),
- [promise_pure],
+ [will_not_call_mercury, promise_pure, thread_safe],
"
PtagEntry = TypeLayout.layout_du()[X];
").
@@ -1897,7 +2064,7 @@ sectag_locn(PTagEntry::in) =
(unsafe_cast(PTagEntry)::out) :-
:- pragma foreign_proc("C#",
sectag_locn(PTagEntry::in) = (SectagLocn::out),
- [promise_pure],
+ [will_not_call_mercury, promise_pure, thread_safe],
"
SectagLocn = mercury.runtime.LowLevelData.make_enum((int)
PTagEntry[(int) ptag_layout_field_nums.sectag_locn]);
@@ -1905,7 +2072,7 @@ sectag_locn(PTagEntry::in) =
(unsafe_cast(PTagEntry)::out) :-
:- pragma foreign_proc("Java",
sectag_locn(PTagEntry::in) = (SectagLocn::out),
- [promise_pure],
+ [will_not_call_mercury, promise_pure, thread_safe],
"
mercury.runtime.Sectag_Locn SL_struct = PTagEntry.sectag_locn;
@@ -1920,7 +2087,7 @@ du_sectag_alternatives(_::in, PTagEntry::in) =
(unsafe_cast(PTagEntry)::out) :-
:- pragma foreign_proc("C#",
du_sectag_alternatives(X::in, PTagEntry::in) = (FunctorDescriptor::out),
- [promise_pure],
+ [will_not_call_mercury, promise_pure, thread_safe],
"
object[] sectag_alternatives;
sectag_alternatives = (object [])
@@ -1930,7 +2097,7 @@ du_sectag_alternatives(_::in, PTagEntry::in) =
(unsafe_cast(PTagEntry)::out) :-
:- pragma foreign_proc("Java",
du_sectag_alternatives(X::in, PTagEntry::in) = (FunctorDescriptor::out),
- [promise_pure],
+ [will_not_call_mercury, promise_pure, thread_safe],
"
FunctorDescriptor = PTagEntry.sectag_alternatives[X];
").
@@ -1942,7 +2109,7 @@ typeinfo_locns_index(X::in, _::in) =
(unsafe_cast(X)::out) :-
:- pragma foreign_proc("C#",
typeinfo_locns_index(X::in, ExistInfo::in) = (TypeInfoLocn::out),
- [promise_pure],
+ [will_not_call_mercury, promise_pure, thread_safe],
"
TypeInfoLocn = (object[]) ((object[]) ExistInfo[(int)
exist_info_field_nums.typeinfo_locns])[X];
@@ -1955,12 +2122,19 @@ exist_info_typeinfos_plain(X::in) =
(unsafe_cast(X)::out) :-
:- pragma foreign_proc("C#",
exist_info_typeinfos_plain(ExistInfo::in) = (TypeInfosPlain::out),
- [promise_pure],
+ [will_not_call_mercury, promise_pure, thread_safe],
"
TypeInfosPlain = (int)
ExistInfo[(int) exist_info_field_nums.typeinfos_plain];
").
+:- pragma foreign_proc("Java",
+ exist_info_typeinfos_plain(ExistInfo::in) = (TypeInfosPlain::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ TypeInfosPlain = ExistInfo.exist_typeinfos_plain;
+").
+
:- func exist_info_tcis(exist_info) = int.
exist_info_tcis(X::in) = (unsafe_cast(X)::out) :-
@@ -1968,11 +2142,18 @@ exist_info_tcis(X::in) = (unsafe_cast(X)::out) :-
:- pragma foreign_proc("C#",
exist_info_tcis(ExistInfo::in) = (TCIs::out),
- [promise_pure],
+ [will_not_call_mercury, promise_pure, thread_safe],
"
TCIs = (int) ExistInfo[(int) exist_info_field_nums.tcis];
").
+:- pragma foreign_proc("Java",
+ exist_info_tcis(ExistInfo::in) = (TCIs::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ TCIs = ExistInfo.exist_tcis;
+").
+
:- func exist_arg_num(typeinfo_locn) = int.
exist_arg_num(X::in) = (unsafe_cast(X)::out) :-
@@ -1980,10 +2161,9 @@ exist_arg_num(X::in) = (unsafe_cast(X)::out) :-
:- pragma foreign_proc("C#",
exist_arg_num(TypeInfoLocn::in) = (ArgNum::out),
- [promise_pure],
+ [will_not_call_mercury, promise_pure, thread_safe],
"
ArgNum = (int) TypeInfoLocn[(int) exist_locn_field_nums.exist_arg_num];
-
").
:- func exist_offset_in_tci(typeinfo_locn) = int.
@@ -1993,12 +2173,19 @@ exist_offset_in_tci(X::in) = (unsafe_cast(X)::out) :-
:- pragma foreign_proc("C#",
exist_offset_in_tci(TypeInfoLocn::in) = (ArgNum::out),
- [promise_pure],
+ [will_not_call_mercury, promise_pure, thread_safe],
"
ArgNum = (int)
TypeInfoLocn[(int) exist_locn_field_nums.exist_offset_in_tci];
").
+:- pragma foreign_proc("Java",
+ exist_offset_in_tci(TypeInfoLocn::in) = (ArgNum::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ ArgNum = TypeInfoLocn.exist_offset_in_tci;
+").
+
:- func get_typeinfo_from_term(U, int) = type_info.
get_typeinfo_from_term(_::in, X::in) = (unsafe_cast(X)::out) :-
@@ -2006,7 +2193,7 @@ get_typeinfo_from_term(_::in, X::in) =
(unsafe_cast(X)::out) :-
:- pragma foreign_proc("C#",
get_typeinfo_from_term(Term::in, Index::in) = (TypeInfo::out),
- [promise_pure],
+ [will_not_call_mercury, promise_pure, thread_safe],
"
try {
TypeInfo = (object[]) ((object[]) Term)[Index];
@@ -2029,7 +2216,19 @@ typeclass_info_type_info(TypeClassInfo, Index)
= unsafe_cast(TypeInfo) :-
:- func var_arity_type_info_index(int, type_info) = type_info.
var_arity_type_info_index(Index, TypeInfo) =
- TypeInfo ^ type_info_index(Index + 1).
+ type_info_index(Index + 1, TypeInfo).
+
+:- pragma foreign_proc("Java",
+ var_arity_type_info_index(Index::in, TypeInfo::in)
+ = (TypeInfoAtIndex::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ /* The generic definition of var_arity_type_info_index assumes that
+ * variable arity type_infos store the arity in the first word but that's
+ * not true for the TypeInfo_Struct in Java.
+ */
+ TypeInfoAtIndex = (TypeInfo_Struct) TypeInfo.args[Index];
+").
:- func type_info_index(int, type_info) = type_info.
@@ -2038,33 +2237,41 @@ type_info_index(_::in, TypeInfo::in) =
(TypeInfo::out) :-
% used by default.
det_unimplemented("type_info_index").
-:- pragma foreign_proc("Java",
- type_info_index(X::in, TypeInfo::in) = (TypeInfoAtIndex::out),
- [will_not_call_mercury, promise_pure],
+:- pragma foreign_proc("C#",
+ type_info_index(Index::in, TypeInfo::in) = (TypeInfoAtIndex::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
"
- TypeInfoAtIndex = (TypeInfo_Struct) ((TypeInfo_Struct) TypeInfo).args[X];
+ TypeInfoAtIndex = (object[]) TypeInfo[Index];
").
-:- pragma foreign_proc("C#",
- type_info_index(X::in, TypeInfo::in) = (TypeInfoAtIndex::out),
- [will_not_call_mercury, promise_pure],
+:- pragma foreign_proc("Java",
+ type_info_index(Index::in, TypeInfo::in) = (TypeInfoAtIndex::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
"
- TypeInfoAtIndex = (object[]) TypeInfo[X];
+ assert TypeInfo.args != null;
+ TypeInfoAtIndex = (TypeInfo_Struct) TypeInfo.args[Index];
").
-:- pred update_type_info_index(int::in, type_info::in, type_info::di,
- type_info::uo) is det.
+:- pred set_type_info_index(int::in, type_info::in,
+ type_info::di, type_info::uo) is det.
-update_type_info_index(_::in, _::in, X::di, X::uo) :-
+set_type_info_index(_, _, !TypeInfo) :-
det_unimplemented("type_info_index").
:- pragma foreign_proc("C#",
- update_type_info_index(X::in, NewValue::in,
- OldTypeInfo::di, NewTypeInfo::uo),
- [will_not_call_mercury, promise_pure],
+ set_type_info_index(Index::in, Value::in, TypeInfo0::di, TypeInfo::uo),
+ [will_not_call_mercury, promise_pure, thread_safe],
"
- OldTypeInfo[X] = NewValue;
- NewTypeInfo = OldTypeInfo;
+ TypeInfo0[Index] = Value;
+ TypeInfo = TypeInfo0;
+").
+
+:- pragma foreign_proc("Java",
+ set_type_info_index(Index::in, Value::in, TypeInfo0::di, TypeInfo::uo),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ TypeInfo0.args[Index - 1] = Value;
+ TypeInfo = TypeInfo0;
").
:- pred semidet_unimplemented(string::in) is semidet.
@@ -2100,7 +2307,7 @@ det_unimplemented(S) :-
type_ctor_arity(TypeCtorInfo::in) = (Arity::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
- Arity = ((TypeCtorInfo_Struct) TypeCtorInfo).arity;
+ Arity = TypeCtorInfo.arity;
").
:- pragma foreign_proc("C",
type_ctor_arity(TypeCtorInfo::in) = (Arity::out),
@@ -2114,14 +2321,11 @@ type_ctor_arity(_) = _ :-
% matching foreign_proc version.
private_builtin.sorry("type_ctor_arity").
-:- some [P] func type_ctor_unify_pred(type_ctor_info) = P.
+:- func type_ctor_unify_pred(type_ctor_info) = unify_or_compare_pred.
:- pragma foreign_proc("C#",
type_ctor_unify_pred(TypeCtorInfo::in) = (UnifyPred::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
- // XXX This should be something else.
- // TypeInfo_for_P
-
UnifyPred = TypeCtorInfo[
(int) type_ctor_info_field_nums.type_ctor_unify_pred];
").
@@ -2131,50 +2335,54 @@ type_ctor_arity(_) = _ :-
"
MR_TypeCtorInfo tci;
- /* XXX This should be something else. */
- TypeInfo_for_P = 0;
-
tci = (MR_TypeCtorInfo) TypeCtorInfo;
UnifyPred = (MR_Integer) tci->MR_type_ctor_unify_pred;
").
-type_ctor_unify_pred(_) = "dummy value" :-
+:- pragma foreign_proc("Java",
+ type_ctor_unify_pred(TypeCtorInfo::in) = (UnifyPred::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ UnifyPred = TypeCtorInfo.unify_pred;
+").
+type_ctor_unify_pred(_) = unify_or_compare_pred :-
% This version is only used for back-ends for which there is no
% matching foreign_proc version.
private_builtin.sorry("type_ctor_unify_pred").
-:- some [P] func type_ctor_compare_pred(type_ctor_info) = P.
+:- func type_ctor_compare_pred(type_ctor_info) = unify_or_compare_pred.
:- pragma foreign_proc("C#",
- type_ctor_compare_pred(TypeCtorInfo::in) = (UnifyPred::out),
+ type_ctor_compare_pred(TypeCtorInfo::in) = (ComparePred::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
- // XXX This should be something else.
- TypeInfo_for_P = null;
-
- UnifyPred = TypeCtorInfo[
+ ComparePred = TypeCtorInfo[
(int) type_ctor_info_field_nums.type_ctor_compare_pred];
").
:- pragma foreign_proc("C",
- type_ctor_compare_pred(TypeCtorInfo::in) = (UnifyPred::out),
+ type_ctor_compare_pred(TypeCtorInfo::in) = (ComparePred::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
MR_TypeCtorInfo tci;
- /* XXX This should be something else. */
- TypeInfo_for_P = 0;
-
tci = (MR_TypeCtorInfo) TypeCtorInfo;
- UnifyPred = (MR_Integer) tci->MR_type_ctor_compare_pred;
+ ComparePred = (MR_Integer) tci->MR_type_ctor_compare_pred;
").
-type_ctor_compare_pred(_) = "dummy value" :-
+:- pragma foreign_proc("Java",
+ type_ctor_compare_pred(TypeCtorInfo::in) = (ComparePred::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ ComparePred = TypeCtorInfo.compare_pred;
+").
+
+type_ctor_compare_pred(_) = unify_or_compare_pred :-
% This version is only used for back-ends for which there is no
% matching foreign_proc version.
private_builtin.sorry("type_ctor_compare_pred").
-:- func type_ctor_rep(type_ctor_info) = type_ctor_rep.
+:- func get_type_ctor_rep(type_ctor_info) = type_ctor_rep.
:- pragma foreign_proc("C#",
- type_ctor_rep(TypeCtorInfo::in) = (TypeCtorRep::out),
+ get_type_ctor_rep(TypeCtorInfo::in) = (TypeCtorRep::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
int rep;
@@ -2182,21 +2390,19 @@ type_ctor_compare_pred(_) = "dummy value" :-
TypeCtorRep = mercury.runtime.LowLevelData.make_enum(rep);
").
:- pragma foreign_proc("Java",
- type_ctor_rep(TypeCtorInfo::in) = (TypeCtorRep::out),
+ get_type_ctor_rep(TypeCtorInfo::in) = (TypeCtorRep::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
- TypeCtorRep = new Type_ctor_rep_0(
- ((mercury.runtime.TypeCtorInfo_Struct) TypeCtorInfo).
- type_ctor_rep.value);
+ TypeCtorRep = new Type_ctor_rep_0(TypeCtorInfo.type_ctor_rep.value);
").
:- pragma foreign_proc("C",
- type_ctor_rep(TypeCtorInfo::in) = (TypeCtorRep::out),
+ get_type_ctor_rep(TypeCtorInfo::in) = (TypeCtorRep::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
MR_TypeCtorInfo tci = (MR_TypeCtorInfo) TypeCtorInfo;
TypeCtorRep = MR_type_ctor_rep(tci);
").
-type_ctor_rep(_) = _ :-
+get_type_ctor_rep(_) = _ :-
% This version is only used for back-ends for which there is no
% matching foreign_proc version.
private_builtin.sorry("type_ctor_rep").
@@ -2259,10 +2465,10 @@ type_ctor_name(_) = _ :-
% matching foreign_proc version.
private_builtin.sorry("type_ctor_name").
-:- func type_ctor_functors(type_ctor_info) = type_functors.
+:- func get_type_ctor_functors(type_ctor_info) = type_functors.
:- pragma foreign_proc("C#",
- type_ctor_functors(TypeCtorInfo::in) = (Functors::out),
+ get_type_ctor_functors(TypeCtorInfo::in) = (Functors::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
Functors = (object[])
@@ -2270,44 +2476,44 @@ type_ctor_name(_) = _ :-
").
:- pragma foreign_proc("Java",
- type_ctor_functors(TypeCtorInfo::in) = (Functors::out),
+ get_type_ctor_functors(TypeCtorInfo::in) = (Functors::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
Functors = TypeCtorInfo.type_functors;
").
-type_ctor_functors(_) = _ :-
+get_type_ctor_functors(_) = _ :-
% This version is only used for back-ends for which there is no
% matching foreign_proc version.
- private_builtin.sorry("type_ctor_functors").
+ private_builtin.sorry("get_type_ctor_functors").
-:- func type_layout(type_ctor_info) = type_layout.
+:- func get_type_layout(type_ctor_info) = type_layout.
:- pragma foreign_proc("C#",
- type_layout(TypeCtorInfo::in) = (TypeLayout::out),
+ get_type_layout(TypeCtorInfo::in) = (TypeLayout::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
TypeLayout = (object[])
TypeCtorInfo[(int) type_ctor_info_field_nums.type_layout];
").
:- pragma foreign_proc("Java",
- type_layout(TypeCtorInfo::in) = (TypeLayout::out),
+ get_type_layout(TypeCtorInfo::in) = (TypeLayout::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
TypeLayout = TypeCtorInfo.type_layout;
").
:- pragma foreign_proc("C",
- type_layout(TypeCtorInfo::in) = (TypeLayout::out),
+ get_type_layout(TypeCtorInfo::in) = (TypeLayout::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
MR_TypeCtorInfo tci = (MR_TypeCtorInfo) TypeCtorInfo;
TypeLayout = (MR_Word) &(MR_type_ctor_layout(tci));
").
-type_layout(_) = _ :-
+get_type_layout(_) = _ :-
% This version is only used for back-ends for which there is no
% matching foreign_proc version.
- private_builtin.sorry("type_layout").
+ private_builtin.sorry("get_type_layout").
:- func type_ctor_num_functors(type_ctor_info) = int.
@@ -2359,6 +2565,7 @@ unsafe_cast(_) = _ :-
%
% TypeFunctors
%
+
:- type type_functors ---> type_functors(c_pointer).
:- pragma foreign_type("Java", type_functors,
"mercury.runtime.TypeFunctors").
@@ -2522,21 +2729,21 @@ du_functor_exist_info(DuFunctorDesc) = ExistInfo :-
succeeded = (ExistInfo != null);
").
-%--------------------------%
+%-----------------------------------------------------------------------------%
-:- func enum_functor_desc(type_ctor_rep, int, type_functors)
+:- func get_enum_functor_desc(type_ctor_rep, int, type_layout)
= enum_functor_desc.
-:- mode enum_functor_desc(in(enum), in, in) = out is det.
+:- mode get_enum_functor_desc(in(enum), in, in) = out is det.
-enum_functor_desc(_, Num, TypeFunctors) = EnumFunctorDesc :-
- EnumFunctorDesc = TypeFunctors ^ unsafe_index(Num).
+get_enum_functor_desc(_, Num, TypeLayout) = EnumFunctorDesc :-
+ EnumFunctorDesc = TypeLayout ^ unsafe_index(Num).
:- pragma foreign_proc("Java",
- enum_functor_desc(_TypeCtorRep::in(enum), X::in, TypeFunctors::in) =
+ get_enum_functor_desc(_TypeCtorRep::in(enum), X::in, TypeLayout::in) =
(EnumFunctorDesc::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
- EnumFunctorDesc = (TypeFunctors.functors_enum())[X];
+ EnumFunctorDesc = (TypeLayout.layout_enum())[X];
").
:- func enum_functor_name(enum_functor_desc) = string.
@@ -2561,7 +2768,7 @@ enum_functor_ordinal(EnumFunctorDesc) =
EnumFunctorDesc ^ unsafe_index(1).
Ordinal = EnumFunctorDesc.enum_functor_ordinal;
").
- %--------------------------%
+%-----------------------------------------------------------------------------%
:- func foreign_enum_functor_desc(type_ctor_rep, int, type_functors)
= foreign_enum_functor_desc.
@@ -2590,7 +2797,7 @@ foreign_enum_functor_name(ForeignEnumFunctorDesc) =
Name = ForeignEnumFunctorDesc.foreign_enum_functor_name;
").
- %--------------------------%
+%-----------------------------------------------------------------------------%
:- func notag_functor_desc(type_ctor_rep, int, type_functors)
= notag_functor_desc.
@@ -2657,7 +2864,7 @@ notag_functor_arg_name(NoTagFunctorDesc) =
NoTagFunctorDesc ^ unsafe_index(2).
unsafe_index(_, _) = _ :-
private_builtin.sorry("rtti_implementation.unsafe_index").
- %--------------------------%
+%-----------------------------------------------------------------------------%
:- func unsafe_make_enum(int) = T.
:- pragma foreign_proc("C#",
@@ -2669,7 +2876,7 @@ unsafe_index(_, _) = _ :-
unsafe_make_enum(_) = _ :-
private_builtin.sorry("rtti_implementation.unsafe_make_enum").
- %--------------------------%
+%-----------------------------------------------------------------------------%
:- pred null(T::in) is semidet.
:- pragma foreign_proc("C",
@@ -2695,7 +2902,7 @@ null(_) :-
% matching foreign_proc version.
private_builtin.sorry("rtti_implementation.null/1").
- %--------------------------%
+%-----------------------------------------------------------------------------%
:- func null_string = string.
:- pragma foreign_proc("C",
@@ -2721,7 +2928,7 @@ null_string = _ :-
% matching foreign_proc version.
private_builtin.sorry("rtti_implementation.null_string/0").
- %--------------------------%
+%-----------------------------------------------------------------------------%
:- func unsafe_get_enum_value(T) = int.
--------------------------------------------------------------------------
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