[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