[m-rev.] diff: use the erlang rtti primitives on the erlang backend

[Peter Ross]

Hi,


===================================================================


Estimated hours taken: 2
Branches: main

Switch to using the erlang_rtti_implementation for all the
RTTI operations on the erlang backend.

library/deconstruct.m:
	Call the erlang version of deconstruct, if we are on the
	erlang backend.

library/erlang_rtti_implementation.m:
	Make the interface of erlang_rtti_implementation contain
	exactly the same predicates as rtti_implementation.
	Implement get_type_info, type_ctor_and_args, and
	type_ctor_name_and_arity.
	Abort for compare_type_infos.
	
library/type_desc.m:
	Call the erlang versions of type_ctor_and_args
	and type_ctor_name_and_arity.


Index: library/deconstruct.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/deconstruct.m,v
retrieving revision 1.44
diff -u -r1.44 deconstruct.m
--- library/deconstruct.m	21 Mar 2007 22:30:23 -0000	1.44
+++ library/deconstruct.m	4 Jun 2007 07:51:56 -0000
@@ -276,6 +276,10 @@
 :- import_module require.
 :- import_module type_desc.
 
+% For use by the Erlang backends.
+%
+:- use_module erlang_rtti_implementation.
+
 % For use by the Java and IL backends.
 %
 :- use_module rtti_implementation.
@@ -526,13 +530,13 @@
 }").
 
 functor_dna(Term::in, Functor::out, Arity::out) :-
-    rtti_implementation.deconstruct(Term,
+    local_deconstruct(Term,
         do_not_allow, Functor, Arity, _Arguments).
 functor_can(Term::in, Functor::out, Arity::out) :-
-    rtti_implementation.deconstruct(Term,
+    local_deconstruct(Term,
         canonicalize, Functor, Arity, _Arguments).
 functor_idcc(Term::in, Functor::out, Arity::out) :-
-    rtti_implementation.deconstruct(Term,
+    local_deconstruct(Term,
         include_details_cc, Functor, Arity, _Arguments).
 
 %-----------------------------------------------------------------------------%
@@ -764,16 +768,16 @@
 % just constructing one univ for the argument selected.
 
 univ_arg_dna(Term::in, Index::in, Arg::out) :-
-    rtti_implementation.deconstruct(Term, do_not_allow,
+    local_deconstruct(Term, do_not_allow,
         _Functor, _Arity, Arguments),
     list.index0(Arguments, Index, Arg).
 univ_arg_can(Term::in, Index::in, Arg::out) :-
-    rtti_implementation.deconstruct(Term, canonicalize,
+    local_deconstruct(Term, canonicalize,
         _Functor, _Arity, Arguments),
     list.index0(Arguments, Index, Arg).
 univ_arg_idcc(Term::in, Index::in, DummyUniv::in, Argument::out,
         Success::out) :-
-    rtti_implementation.deconstruct(Term, include_details_cc,
+    local_deconstruct(Term, include_details_cc,
         _Functor, _Arity, Arguments),
     ( list.index0(Arguments, Index, Arg) ->
         Argument = Arg,
@@ -972,15 +976,15 @@
 deconstruct_dna(Term::in, Functor::out, FunctorNumber::out,
         Arity::out, Arguments::out) :-
     FunctorNumber = -1,
-    rtti_implementation.deconstruct(Term, do_not_allow,
+    local_deconstruct(Term, do_not_allow,
         Functor, Arity, Arguments).
 deconstruct_can(Term::in, Functor::out, Arity::out, Arguments::out) :-
-    rtti_implementation.deconstruct(Term, canonicalize,
+    local_deconstruct(Term, canonicalize,
         Functor, Arity, Arguments).
 deconstruct_idcc(Term::in, Functor::out, FunctorNumber::out,
         Arity::out, Arguments::out) :-
     FunctorNumber = -1,
-    rtti_implementation.deconstruct(Term, include_details_cc,
+    local_deconstruct(Term, include_details_cc,
         Functor, Arity, Arguments).
 
     % XXX The Mercury implementations of all of these limited_* procedures
@@ -988,18 +992,45 @@
     % when Arity > MaxArity.
 limited_deconstruct_dna(Term::in, MaxArity::in,
         Functor::out, Arity::out, Arguments::out) :-
-    rtti_implementation.deconstruct(Term, do_not_allow,
+    local_deconstruct(Term, do_not_allow,
         Functor, Arity, Arguments),
     Arity =< MaxArity.
 limited_deconstruct_can(Term::in, MaxArity::in,
         Functor::out, Arity::out, Arguments::out) :-
-    rtti_implementation.deconstruct(Term, canonicalize,
+    local_deconstruct(Term, canonicalize,
         Functor, Arity, Arguments),
     Arity =< MaxArity.
 limited_deconstruct_idcc(Term::in, _MaxArity::in,
         Functor::out, Arity::out, Arguments::out) :-
     % For this one, the caller checks Arity =< MaxArity.
-    rtti_implementation.deconstruct(Term, include_details_cc,
+    local_deconstruct(Term, include_details_cc,
         Functor, Arity, Arguments).
 
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- pred is_erlang_backend is semidet.
+
+:- pragma foreign_proc("Erlang", is_erlang_backend,
+        [will_not_call_mercury, thread_safe, promise_pure], "
+    SUCCESS_INDICATOR = true
+").
+
+is_erlang_backend :-
+    semidet_fail.
+
+:- pred local_deconstruct(T, noncanon_handling, string, int, list(univ)).
+:- mode local_deconstruct(in, in(do_not_allow), out, out, out) is det.
+:- mode local_deconstruct(in, in(canonicalize), out, out, out) is det.
+:- mode local_deconstruct(in, in(include_details_cc), out, out, out) is cc_multi.
+:- mode local_deconstruct(in, in, out, out, out) is cc_multi.
+
+local_deconstruct(T, H, F, A, As) :-
+    ( is_erlang_backend ->
+        erlang_rtti_implementation.deconstruct(T, H, F, A, As)
+    ;
+        rtti_implementation.deconstruct(T, H, F, A, As)
+    ).
+
+%-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
Index: library/erlang_rtti_implementation.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/erlang_rtti_implementation.m,v
retrieving revision 1.4
diff -u -r1.4 erlang_rtti_implementation.m
--- library/erlang_rtti_implementation.m	4 Jun 2007 07:46:09 -0000	1.4
+++ library/erlang_rtti_implementation.m	4 Jun 2007 07:51:56 -0000
@@ -23,6 +23,11 @@
 :- import_module list.
 :- import_module univ.
 
+:- type type_info.
+:- type type_ctor_info.
+
+:- func get_type_info(T::unused) = (type_info::out) is det.
+
     %
     % Check if two values are equal.
     % Note this is not structural equality because a type
@@ -32,6 +37,15 @@
 
 :- pred generic_compare(comparison_result::out, T::in, T::in) is det.
 
+:- pred compare_type_infos(comparison_result::out,
+    type_info::in, type_info::in) is det.
+
+:- pred type_ctor_and_args(type_info::in, type_ctor_info::out,
+    list(type_info)::out) is det.
+
+:- pred type_ctor_name_and_arity(type_ctor_info::in,
+    string::out, string::out, int::out) is det.
+
 :- pred deconstruct(T, noncanon_handling, string, int, list(univ)).
 :- mode deconstruct(in, in(do_not_allow), out, out, out) is det.
 :- mode deconstruct(in, in(canonicalize), out, out, out) is det.
@@ -57,7 +71,6 @@
     % a type with variable arity of size N
     %   { TypeCtorInfo, N, TypeCtorInfo0, ..., TypeCtorInfoN }
     %   
-:- type type_info.
 :- pragma foreign_type("Erlang", type_info, "").
 :- type type_info ---> type_info.
 
@@ -65,7 +78,6 @@
     % For the representation of a type_ctor_info
     % see erlang_rtti:type_ctor_data_to_elds
     %
-:- type type_ctor_info.
 :- pragma foreign_type("Erlang", type_ctor_info, "").
 :- type type_ctor_info ---> type_ctor_info.
 
@@ -107,6 +119,11 @@
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
+get_type_info(T) = T ^ type_info.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
 generic_unify(X, Y) :-
     TypeInfo = X ^ type_info,
     TypeCtorInfo = TypeInfo ^ type_ctor_info,
@@ -266,6 +283,45 @@
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
+compare_type_infos(Res, _, _) :-
+    Res = (=),
+    det_unimplemented("compare_type_infos/3").
+    
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+type_ctor_and_args(TypeInfo0, TypeCtorInfo, Args) :-
+    TypeInfo = collapse_equivalences(TypeInfo0),
+    TypeCtorInfo = TypeInfo ^ type_ctor_info,
+    ( type_ctor_is_variable_arity(TypeCtorInfo) ->
+        Arity = TypeInfo ^ var_arity_type_info_arity,
+        Args = list.map(
+            func(L) = TypeInfo ^ var_arity_type_info_index(L), 1 .. Arity)
+    ;
+        Arity = TypeCtorInfo ^ type_ctor_arity,
+        Args = list.map(func(L) = TypeInfo ^ type_info_index(L), 1 .. Arity)
+    ).
+    
+:- pred type_ctor_is_variable_arity(type_ctor_info::in) is semidet.
+
+type_ctor_is_variable_arity(TypeCtorInfo) :-
+    TypeCtorRep = TypeCtorInfo ^ type_ctor_rep,
+    ( TypeCtorRep = etcr_tuple
+    ; TypeCtorRep = etcr_pred
+    ; TypeCtorRep = etcr_func
+    ).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+type_ctor_name_and_arity(TypeCtorInfo, ModuleName, Name, Arity) :-
+    ModuleName = TypeCtorInfo ^ type_ctor_module_name,
+    Name = TypeCtorInfo ^ type_ctor_type_name,
+    Arity = TypeCtorInfo ^ type_ctor_arity.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
 deconstruct(Term, NonCanon, Functor, Arity, Arguments) :-
     TypeInfo = Term ^ type_info,
     TypeCtorInfo = TypeInfo ^ type_ctor_info,
@@ -535,6 +591,21 @@
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
+:- func collapse_equivalences(type_info) = type_info.
+
+collapse_equivalences(TypeInfo0) = TypeInfo :-
+    TypeCtorInfo0 = TypeInfo0 ^ type_ctor_info,
+    TypeCtorRep = TypeCtorInfo0 ^ type_ctor_rep,
+    ( TypeCtorRep = etcr_eqv ->
+        TypeInfo = TypeInfo0,
+        det_unimplemented("collapse_equivalences/1")
+    ;
+        TypeInfo = TypeInfo0
+    ).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
 :- pragma foreign_code("Erlang", "
         % Location of element in a type_info
     ti_type_ctor_info() -> 1.
@@ -686,6 +757,30 @@
 
 type_ctor_compare_pred(_) = "dummy value" :-
     det_unimplemented("type_ctor_compare_pred").
+
+:- func type_ctor_module_name(type_ctor_info) = string.
+
+:- pragma foreign_proc("Erlang",
+    type_ctor_module_name(TypeCtorInfo::in) = (ModuleName::out),
+    [will_not_call_mercury, promise_pure, thread_safe],
+"
+    ModuleName = element(tci_module_name(), TypeCtorInfo)
+").
+
+type_ctor_module_name(_) = "dummy value" :-
+    det_unimplemented("type_ctor_module_name").
+
+:- func type_ctor_type_name(type_ctor_info) = string.
+
+:- pragma foreign_proc("Erlang",
+    type_ctor_type_name(TypeCtorInfo::in) = (TypeName::out),
+    [will_not_call_mercury, promise_pure, thread_safe],
+"
+    TypeName = element(tci_type_name(), TypeCtorInfo)
+").
+
+type_ctor_type_name(_) = "dummy value" :-
+    det_unimplemented("type_ctor_type_name").
 
 :- func type_ctor_arity(type_ctor_info) = int.
 
Index: library/type_desc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/type_desc.m,v
retrieving revision 1.46
diff -u -r1.46 type_desc.m
--- library/type_desc.m	30 May 2007 08:16:09 -0000	1.46
+++ library/type_desc.m	4 Jun 2007 07:51:56 -0000
@@ -641,6 +641,14 @@
     }
 ").
 
+:- pragma foreign_proc("Erlang",
+    type_ctor_and_args(TypeDesc::in, TypeCtorDesc::out, ArgTypes::out),
+    [may_call_mercury, thread_safe, promise_pure, terminates],
+"
+    {TypeCtorDesc, ArgTypes} =
+        mercury__erlang_rtti_implementation:type_ctor_and_args_3_p_0(TypeDesc)
+").
+
 type_ctor_and_args(TypeDesc::in, TypeCtorDesc::out, ArgTypes::out) :-
     rtti_implementation.type_ctor_and_args(
         rtti_implementation.unsafe_cast(TypeDesc),
@@ -779,6 +787,16 @@
     TypeCtorModuleName = (java.lang.String) result[0];
     TypeCtorName = (java.lang.String) result[1];
     TypeCtorArity = ((java.lang.Integer) result[2]).intValue();
+").
+
+:- pragma foreign_proc("Erlang",
+    type_ctor_name_and_arity(TypeCtorDesc::in, TypeCtorModuleName::out,
+        TypeCtorName::out, TypeCtorArity::out),
+    [will_not_call_mercury, thread_safe, promise_pure],
+"
+    {TypeCtorModuleName, TypeCtorName, TypeCtorArity} =
+        mercury__erlang_rtti_implementation:
+            type_ctor_name_and_arity_4_p_0(TypeCtorDesc)
 ").
 
 type_ctor_name_and_arity(TypeCtorDesc::in, ModuleName::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
--------------------------------------------------------------------------