[m-rev.] diff: fill in more rtti routines for java

[Peter Wang]

Branches: main

library/rtti_implementation.m:
        Implement collapse_equivalences for Java.  Use it for a case in
        deconstruct_2.

library/type_desc.m:
        Implement unify/compare on type_descs for Java.

diff --git a/library/rtti_implementation.m b/library/rtti_implementation.m
index 826eae0..9ca284b 100644
--- a/library/rtti_implementation.m
+++ b/library/rtti_implementation.m
@@ -887,6 +887,9 @@ result_call_9(_::in, (=)::out, _::in, _::in,
_::in, _::in, _::in,
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%

+:- pragma foreign_export("Java", compare_type_infos(out, in, in),
+    "ML_compare_type_infos").
+
 compare_type_infos(Res, TypeInfo1, TypeInfo2) :-
     ( same_pointer_value(TypeInfo1, TypeInfo2) ->
         Res = (=)
@@ -983,30 +986,39 @@ type_ctor_is_variable_arity(TypeCtorInfo) :-
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%

-    % In the .NET backend, we don't generally have to collapse equivalences
-    % because they are already collapsed (il grades require
-    % intermodule optimization, which will collapse them for us).
-    %
-    % XXX For other backends this code may have to be completed.
-    %
 :- func collapse_equivalences(type_info) = type_info.

 collapse_equivalences(TypeInfo) = NewTypeInfo :-
     TypeCtorInfo = get_type_ctor_info(TypeInfo),
     TypeCtorRep = get_type_ctor_rep(TypeCtorInfo),
     (
+        % Look past equivalences.
         (
             TypeCtorRep = tcr_equiv_ground
         ;
             TypeCtorRep = tcr_equiv
         )
     ->
-        error("rtti_implementation.m: unimplemented: " ++
-            "collapsing equivalence types")
+        TypeLayout = get_type_layout(TypeCtorInfo),
+        EquivTypeInfo = get_layout_equiv(TypeLayout),
+        NewTypeInfo = collapse_equivalences(EquivTypeInfo)
     ;
         NewTypeInfo = TypeInfo
     ).

+:- func get_layout_equiv(type_layout) = type_info.
+
+:- pragma foreign_proc("Java",
+    get_layout_equiv(TypeLayout::in) = (TypeInfo::out),
+    [will_not_call_mercury, promise_pure, thread_safe],
+"
+    jmercury.runtime.PseudoTypeInfo pti = TypeLayout.layout_equiv();
+    TypeInfo = jmercury.runtime.TypeInfo_Struct.maybe_new(pti);
+").
+
+get_layout_equiv(_) = _ :-
+    private_builtin.sorry("get_layout_equiv").
+
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%

@@ -1142,6 +1154,7 @@ deconstruct_2(Term, TypeInfo, TypeCtorInfo,
TypeCtorRep, NonCanon,
             Functor, Arity, Arguments)
     ;
         TypeCtorRep = tcr_notag,
+        % XXX incomplete
         Functor = "some_notag",
         Arity = 0,
         Arguments = []
@@ -1151,14 +1164,17 @@ deconstruct_2(Term, TypeInfo, TypeCtorInfo,
TypeCtorRep, NonCanon,
             Functor, Arity, Arguments)
     ;
         TypeCtorRep = tcr_notag_ground,
+        % XXX incomplete
         Functor = "some_notag_ground",
         Arity = 0,
         Arguments = []
     ;
         TypeCtorRep = tcr_equiv_ground,
-        Functor = "some_equiv_ground",
-        Arity = 0,
-        Arguments = []
+        NewTypeInfo = collapse_equivalences(TypeInfo),
+        NewTypeCtorInfo = get_type_ctor_info(NewTypeInfo),
+        NewTypeCtorRep = get_type_ctor_rep(NewTypeCtorInfo),
+        deconstruct_2(Term, TypeInfo, NewTypeCtorInfo, NewTypeCtorRep,
+            NonCanon, Functor, Arity, Arguments)
     ;
         % XXX noncanonical term
         TypeCtorRep = tcr_func,
@@ -1167,6 +1183,7 @@ deconstruct_2(Term, TypeInfo, TypeCtorInfo,
TypeCtorRep, NonCanon,
         Arguments = []
     ;
         TypeCtorRep = tcr_equiv,
+        % XXX incomplete
         Functor = "some_equiv",
         Arity = 0,
         Arguments = []
diff --git a/library/type_desc.m b/library/type_desc.m
index 307634b..a1cbf61 100644
--- a/library/type_desc.m
+++ b/library/type_desc.m
@@ -1017,18 +1017,14 @@ get_type_info_for_type_info = TypeDesc :-
     __Unify____type_ctor_desc_0_0(type_desc.Type_ctor_desc_0 x,
         type_desc.Type_ctor_desc_0 y)
     {
-        // stub only
-        throw new java.lang.Error
-            (""unify/2 for type_ctor_desc type not implemented"");
+        return x.struct.unify(y.struct);
     }

     public static builtin.Comparison_result_0
     __Compare____type_desc_0_0(type_desc.Type_desc_0 x,
         type_desc.Type_desc_0 y)
     {
-        // stub only
-        throw new java.lang.Error
-            (""compare/3 for type_desc type implemented"");
+        return rtti_implementation.ML_compare_type_infos(x.struct, y.struct);
     }

     public static builtin.Comparison_result_0
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------