[m-rev.] diff: rtti_implementation.compare_type_infos

[Peter Wang]

Branches: main

library/rtti_implementation.m:
        Make `compare_type_infos' compare type_info arguments for
        non-variable arity type_infos.

        Make `type_ctor_name' return "{}" as the functor for tuples,
        instead of "tuple".

library/erlang_rtti_implementation.m:
        Make `compare_type_infos' in Erlang grades compare module
        names first, in line with other implementations.

diff --git a/library/erlang_rtti_implementation.m b/library/erlang_rtti_implementation.m
index 6e6f197..5137937 100644
--- a/library/erlang_rtti_implementation.m
+++ b/library/erlang_rtti_implementation.m
@@ -380,13 +380,13 @@ compare_type_infos(Res, TypeInfoA, TypeInfoB) :-
     TCA = TA ^ type_ctor_info_evaled,
     TCB = TB ^ type_ctor_info_evaled,
 
-    compare(NameRes, TCA ^ type_ctor_type_name, TCB ^ type_ctor_type_name),
+    compare(ModuleRes,
+        TCA ^ type_ctor_module_name, TCB ^ type_ctor_module_name),
     (
-        NameRes = (=),
-        compare(ModuleRes,
-            TCA ^ type_ctor_module_name, TCB ^ type_ctor_module_name),
+        ModuleRes = (=),
+        compare(NameRes, TCA ^ type_ctor_type_name, TCB ^ type_ctor_type_name),
         (
-            ModuleRes = (=),
+            NameRes = (=),
             ( type_ctor_is_variable_arity(TCA) ->
                 ArityA = TA ^ var_arity_type_info_arity,
                 ArityB = TB ^ var_arity_type_info_arity,
@@ -415,16 +415,16 @@ compare_type_infos(Res, TypeInfoA, TypeInfoB) :-
                 )
             )
         ;
-            ( ModuleRes = (<)
-            ; ModuleRes = (>)
+            ( NameRes = (<)
+            ; NameRes = (>)
             ),
-            Res = ModuleRes
+            Res = NameRes
         )
     ;
-        ( NameRes = (<)
-        ; NameRes = (>)
+        ( ModuleRes = (<)
+        ; ModuleRes = (>)
         ),
-        Res = NameRes
+        Res = ModuleRes
     ).
 
 :- pred compare_sub_typeinfos(int::in, int::in,
diff --git a/library/rtti_implementation.m b/library/rtti_implementation.m
index ce1c58f..96b4916 100644
--- a/library/rtti_implementation.m
+++ b/library/rtti_implementation.m
@@ -1160,7 +1160,7 @@ compare_collapsed_type_infos(Res, TypeInfo1, TypeInfo2) :-
                 compare(ArityRes, Arity1, Arity2),
                 (
                     ArityRes = (=),
-                    compare_var_arity_typeinfos(1, Arity1, Res,
+                    compare_var_arity_type_info_args(1, Arity1, Res,
                         TypeInfo1, TypeInfo2)
                 ;
                     ( ArityRes = (<)
@@ -1169,7 +1169,19 @@ compare_collapsed_type_infos(Res, TypeInfo1, TypeInfo2) :-
                     Res = ArityRes
                 )
             ;
-                Res = (=)
+                Arity1 = type_ctor_arity(TypeCtorInfo1),
+                Arity2 = type_ctor_arity(TypeCtorInfo2),
+                compare(ArityRes, Arity1, Arity2),
+                (
+                    ArityRes = (=),
+                    compare_type_info_args(1, Arity1, Res,
+                        TypeInfo1, TypeInfo2)
+                ;
+                    ( ArityRes = (<)
+                    ; ArityRes = (>)
+                    ),
+                    Res = ArityRes
+                )
             )
         ;
             ( NameRes = (<)
@@ -1220,10 +1232,33 @@ compare_type_ctor_infos(Res, TypeCtorInfo1, TypeCtorInfo2) :-
         Res = ModNameRes
     ).
 
-:- pred compare_var_arity_typeinfos(int::in, int::in,
+:- pred compare_type_info_args(int::in, int::in, comparison_result::out,
+    type_info::in, type_info::in) is det.
+
+compare_type_info_args(Loc, Arity, Result, TypeInfoA, TypeInfoB) :-
+    ( Loc > Arity ->
+        Result = (=)
+    ;
+        SubTypeInfoA = type_info_index_as_ti(TypeInfoA, Loc),
+        SubTypeInfoB = type_info_index_as_ti(TypeInfoB, Loc),
+
+        compare_collapsed_type_infos(SubResult, SubTypeInfoA, SubTypeInfoB),
+        (
+            SubResult = (=),
+            compare_type_info_args(Loc + 1, Arity, Result,
+                TypeInfoA, TypeInfoB)
+        ;
+            ( SubResult = (<)
+            ; SubResult = (>)
+            ),
+            Result = SubResult
+        )
+    ).
+
+:- pred compare_var_arity_type_info_args(int::in, int::in,
     comparison_result::out, type_info::in, type_info::in) is det.
 
-compare_var_arity_typeinfos(Loc, Arity, Result, TypeInfoA, TypeInfoB) :-
+compare_var_arity_type_info_args(Loc, Arity, Result, TypeInfoA, TypeInfoB) :-
     ( Loc > Arity ->
         Result = (=)
     ;
@@ -1233,7 +1268,7 @@ compare_var_arity_typeinfos(Loc, Arity, Result, TypeInfoA, TypeInfoB) :-
         compare_collapsed_type_infos(SubResult, SubTypeInfoA, SubTypeInfoB),
         (
             SubResult = (=),
-            compare_var_arity_typeinfos(Loc + 1, Arity, Result,
+            compare_var_arity_type_info_args(Loc + 1, Arity, Result,
                 TypeInfoA, TypeInfoB)
         ;
             ( SubResult = (<)
@@ -4330,7 +4365,12 @@ type_ctor_module_name(_) = _ :-
     [will_not_call_mercury, promise_pure, thread_safe],
 "
 #if MR_HIGHLEVEL_DATA
-    Name = TypeCtorInfo.type_ctor_name;
+    if (TypeCtorInfo.type_ctor_rep
+            == runtime.TypeCtorRep.MR_TYPECTOR_REP_TUPLE) {
+        Name = ""{}"";
+    } else {
+        Name = TypeCtorInfo.type_ctor_name;
+    }
 #else
     Name = (string)
         TypeCtorInfo[(int) type_ctor_info_field_nums.type_ctor_name];
@@ -4340,7 +4380,12 @@ type_ctor_module_name(_) = _ :-
     type_ctor_name(TypeCtorInfo::in) = (Name::out),
     [will_not_call_mercury, promise_pure, thread_safe],
 "
-    Name = TypeCtorInfo.type_ctor_name;
+    if (TypeCtorInfo.type_ctor_rep.value
+            == private_builtin.MR_TYPECTOR_REP_TUPLE) {
+        Name = ""{}"";
+    } else {
+        Name = TypeCtorInfo.type_ctor_name;
+    }
 ").
 :- pragma foreign_proc("C",
     type_ctor_name(TypeCtorInfo::in) = (Name::out),

--------------------------------------------------------------------------
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
--------------------------------------------------------------------------