[m-rev.] diff: erlang list deconstruct code

[Peter Ross]

Hi,


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


Estimated hours taken: 2
Branches: main

Get deconstruct working on list's for the erlang backend.

compiler/erlang_rtti.m:
	Remove the rtti_maybe_pseudo_type_info from erlang_list
	as it isn't needed.
	
compiler/erl_rtti.m:
	Handle the new type of erlang_list.
	
library/erlang_rtti_implementation.m:
	The code for handling deconstruct of a list.
	Plus add some more debugging printfs.


Index: compiler/erl_rtti.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/erl_rtti.m,v
retrieving revision 1.8
diff -u -r1.8 erl_rtti.m
--- compiler/erl_rtti.m	4 Jun 2007 07:46:09 -0000	1.8
+++ compiler/erl_rtti.m	4 Jun 2007 09:02:36 -0000
@@ -111,45 +111,11 @@
         TypeName = "list",
         Arity = 1
     ->
-        ( list_argument_type(Details, Type) ->
-            D = erlang_list(Type)
-        ;
-            unexpected(this_file, "erlang_type_ctor_details: " ++
-                "unable to determine type of list argument")
-        )
+        D = erlang_list
     ;
         D = erlang_type_ctor_details_2(Details)
     ).
 
-    %
-    % Given a type_ctor_detail which represents a list,
-    % determine the type of the argument to the list.
-    %
-:- pred list_argument_type(type_ctor_details::in,
-    rtti_maybe_pseudo_type_info::out) is semidet.
-
-list_argument_type(Details, Type) :-
-    Functors = Details ^ du_functors,
-    list_argument_type_2(Functors, Type).
-    
-:- pred list_argument_type_2(list(du_functor)::in,
-    rtti_maybe_pseudo_type_info::out) is semidet.
-
-list_argument_type_2([Functor | Functors], Type) :-
-    ( Functor ^ du_name = "[|]" ->
-        Functor ^ du_arg_infos = [du_arg_info(_, Type0), _],
-        convert_to_rtti_maybe_pseudo_type_info(Type0, Type)
-    ;
-        list_argument_type_2(Functors, Type)
-    ).
-        
-:- pred convert_to_rtti_maybe_pseudo_type_info(
-    rtti_maybe_pseudo_type_info_or_self::in,
-    rtti_maybe_pseudo_type_info::out) is semidet.
-
-convert_to_rtti_maybe_pseudo_type_info(plain(P), plain(P)).
-convert_to_rtti_maybe_pseudo_type_info(pseudo(P), pseudo(P)).
-
 :- func erlang_type_ctor_details_2(type_ctor_details) =
     erlang_type_ctor_details.
 
@@ -581,7 +547,7 @@
 
 erlang_type_ctor_rep(erlang_du(_)) =
     elds_term(make_enum_alternative("etcr_du")).
-erlang_type_ctor_rep(erlang_list(_)) =
+erlang_type_ctor_rep(erlang_list) =
     elds_term(make_enum_alternative("etcr_list")).
 erlang_type_ctor_rep(erlang_eqv(_)) =
     elds_term(make_enum_alternative("etcr_eqv")).
@@ -729,7 +695,7 @@
         Term = elds_rtti_ref(RttiId)
     ;
             % The types don't require any extra information
-        ( Details = erlang_list(_)
+        ( Details = erlang_list
         ; Details = erlang_builtin(_)
         ; Details = erlang_impl_artifact(_)
         ; Details = erlang_foreign
Index: compiler/erlang_rtti.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/erlang_rtti.m,v
retrieving revision 1.2
diff -u -r1.2 erlang_rtti.m
--- compiler/erlang_rtti.m	4 Jun 2007 07:46:09 -0000	1.2
+++ compiler/erlang_rtti.m	4 Jun 2007 09:02:36 -0000
@@ -77,9 +77,7 @@
             )
                 
                 % Mercury lists are represented as erlang lists
-    ;       erlang_list(
-                elist               :: rtti_maybe_pseudo_type_info
-            )
+    ;       erlang_list
 
     ;       erlang_eqv(
                                     % XXX why is it a pseudo type info
Index: library/erlang_rtti_implementation.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/erlang_rtti_implementation.m,v
retrieving revision 1.5
diff -u -r1.5 erlang_rtti_implementation.m
--- library/erlang_rtti_implementation.m	4 Jun 2007 07:55:37 -0000	1.5
+++ library/erlang_rtti_implementation.m	4 Jun 2007 09:02:36 -0000
@@ -349,7 +349,16 @@
             get_du_functor_arg(TypeInfo, FunctorRep, Term), 1 .. Arity)
     ;
         TypeCtorRep = etcr_list,
-        Functor = "XXX", Arity = 0, Arguments = []
+        ArgTypeInfo = TypeInfo ^ type_info_index(1),
+        ( is_non_empty_list(TypeInfo, ArgTypeInfo, Term, H, T) ->
+            Functor = "[|]",
+            Arity = 2,
+            Arguments = [univ(H), univ(T)]
+        ;
+            Functor = "[]",
+            Arity = 0,
+            Arguments = []
+        )
     ;
         TypeCtorRep = etcr_eqv,
         Functor = "XXX", Arity = 0, Arguments = []
@@ -485,12 +494,39 @@
 :- pred check_functor(T::in, erlang_atom::in, int::out) is semidet.
 :- pragma foreign_proc("Erlang", check_functor(Term::in, Atom::in, Size::out),
         [will_not_call_mercury, promise_pure, thread_safe], "
+    % io:format(""check_functor(~p, ~p)~n"", [Term, Atom]),
     Functor = element(1, Term),
     Size = size(Term),
+    % io:format(""check_functor(~p, ~p, ~p)~n"", [Term, Atom, Size]),
     SUCCESS_INDICATOR = Functor =:= Atom
 ").
 check_functor(_, _, 0) :-
     semidet_unimplemented("check_functor/3").
+
+
+:- some [H, T] pred is_non_empty_list(type_info::in, type_info::in,
+    L::in, H::out, T::out) is semidet.
+
+:- pragma foreign_proc("Erlang",
+        is_non_empty_list(ListTI::in, ElemTI::in, L::in, H::out, T::out),
+        [promise_pure, will_not_call_mercury, thread_safe], "
+    % TypeInfo_for_L
+    TypeInfo_for_H = ElemTI,
+    TypeInfo_for_T = ListTI,
+    case L of
+        [] ->
+            SUCCESS_INDICATOR = false,
+            H = void,
+            T = void;
+        [Head | Tail] ->
+            SUCCESS_INDICATOR = true,
+            H = Head,
+            T = Tail
+    end
+").
+
+is_non_empty_list(_, _, _, "dummy value", "dummy value") :-
+    semidet_unimplemented("is_non_empty_list/5").
     
     %
     % Calculate the number of type_info and type_class_infos which 

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