[m-rev.] diff: make some erlang deconstruct routines fail on non-du types

[Peter Wang]

Branches: main

library/deconstruct.m:
library/erlang_rtti_implementation.m:
	Make the Erlang implementations of deconstruct_du, functor_number,
	functor_number_cc, fail as required on non-d.u. types.

	Replace int by functor_number_lex and functor_number_ordinal types
	where appropriate.


About the "% XXX force cc_multi" part, which is a workaround for a
problem I only noticed I added after I committed an earlier version of
this.  The C implementation of `functor_number_cc' passes
MR_NONCANON_ALLOW to mercury_ml_functor_body.h.  As far as I can tell,
MR_NONCANON_ALLOW corresponds to the functor `canonicalize' in the type
`noncanon_handling'.  For all routines in deconstruct.m, `canonicalize'
implies determinism `det', not `cc_multi'.  Should the C implementation
of functor_number_cc be passing MR_NONCANON_CC instead, or should
functor_number_cc not be cc_multi?


Index: library/deconstruct.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/deconstruct.m,v
retrieving revision 1.48
retrieving revision 1.49
diff -u -r1.48 -r1.49
--- library/deconstruct.m	30 Aug 2007 06:56:37 -0000	1.48
+++ library/deconstruct.m	4 Sep 2007 03:10:50 -0000	1.49
@@ -433,7 +433,7 @@
 
 deconstruct_du(Term, NonCanon, FunctorNumber, Arity, Arguments) :-
     ( erlang_rtti_implementation.is_erlang_backend ->
-        erlang_rtti_implementation.deconstruct(Term, NonCanon, _Functor,
+        erlang_rtti_implementation.deconstruct_du(Term, NonCanon,
             FunctorNumber, Arity, Arguments)
     ;
         deconstruct_du_2(Term, NonCanon, FunctorNumber, Arity, Arguments)
@@ -598,20 +598,15 @@
 
 functor_number(Term::in, FunctorNumber::out, Arity::out) :-
     ( erlang_rtti_implementation.is_erlang_backend ->
-        % XXX should fail for non-du types
-        semidet_succeed,
-        erlang_rtti_implementation.deconstruct(Term, do_not_allow,
-            _Functor, FunctorNumber, Arity, _Args)
+        erlang_rtti_implementation.functor_number(Term, FunctorNumber, Arity)
     ;
         private_builtin.sorry("deconstruct.functor_number")
     ).
 
 functor_number_cc(Term::in, FunctorNumber::out, Arity::out) :-
     ( erlang_rtti_implementation.is_erlang_backend ->
-        % XXX should fail for non-du types
-        semidet_succeed,
-        erlang_rtti_implementation.deconstruct(Term, include_details_cc,
-            _Functor, FunctorNumber, Arity, _Args)
+        erlang_rtti_implementation.functor_number_cc(Term, FunctorNumber,
+            Arity)
     ;
         private_builtin.sorry("deconstruct.functor_number_cc")
     ).
@@ -1047,7 +1042,7 @@
 
 local_deconstruct(T, H, F, A, As) :-
     ( erlang_rtti_implementation.is_erlang_backend ->
-        erlang_rtti_implementation.deconstruct(T, H, F, _FN, A, As)
+        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/mercury/mercury1/repository/mercury/library/erlang_rtti_implementation.m,v
retrieving revision 1.18
retrieving revision 1.20
diff -u -r1.18 -r1.20
--- library/erlang_rtti_implementation.m	30 Aug 2007 14:03:48 -0000	1.18
+++ library/erlang_rtti_implementation.m	4 Sep 2007 03:47:54 -0000	1.20
@@ -19,11 +19,14 @@
 :- module erlang_rtti_implementation.
 :- interface.
 
+:- import_module construct.
 :- import_module deconstruct.
 :- import_module list.
 :- import_module type_desc.
 :- import_module univ.
 
+%-----------------------------------------------------------------------------%
+
 :- type type_info.
 :- type type_ctor_info.
 :- type type_ctor_info_evaled.
@@ -56,34 +59,51 @@
 :- pred type_ctor_desc_name_and_arity(type_ctor_desc::in,
     string::out, string::out, int::out) is det.
 
-:- pred deconstruct(T, noncanon_handling, string, int, int, list(univ)).
-:- mode deconstruct(in, in(do_not_allow), out, out, out, out) is det.
-:- mode deconstruct(in, in(canonicalize), out, out, out, out) is det.
-:- mode deconstruct(in, in(include_details_cc), out, out, out, out)
+%-----------------------------------------------------------------------------%
+%
+% Implementations for use from deconstruct
+%
+
+:- pred functor_number(T::in, functor_number_lex::out, int::out) is semidet.
+
+:- pred functor_number_cc(T::in, functor_number_lex::out,
+    int::out) is cc_nondet. 
+
+:- 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.
+:- mode deconstruct(in, in(include_details_cc), out, out, out)
     is cc_multi.
-:- mode deconstruct(in, in, out, out, out, out) is cc_multi.
+:- mode deconstruct(in, in, out, out, out) is cc_multi.
+
+:- pred deconstruct_du(T, noncanon_handling, functor_number_lex,
+    int, list(univ)).
+:- mode deconstruct_du(in, in(do_not_allow), out, out, out) is semidet.
+:- mode deconstruct_du(in, in(include_details_cc), out, out, out) is cc_nondet.
+:- mode deconstruct_du(in, in, out, out, out) is cc_nondet.
 
 %-----------------------------------------------------------------------------%
 %
-% Implementations for use from construct.
+% Implementations for use from construct
+%
 
 :- func num_functors(type_desc.type_desc) = int is semidet.
 
-:- pred get_functor(type_desc.type_desc::in, int::in, string::out, int::out,
-    list(type_desc.type_desc)::out) is semidet.
+:- pred get_functor(type_desc.type_desc::in, functor_number_lex::in,
+    string::out, int::out, list(type_desc.type_desc)::out) is semidet.
 
-:- pred get_functor_with_names(type_desc.type_desc::in, int::in, string::out,
-    int::out, list(type_desc.type_desc)::out, list(string)::out)
+:- pred get_functor_with_names(type_desc.type_desc::in, functor_number_lex::in,
+    string::out, int::out, list(type_desc.type_desc)::out, list(string)::out)
     is semidet.
 
-:- pred get_functor_ordinal(type_desc.type_desc::in, int::in, int::out)
-    is semidet.
+:- pred get_functor_ordinal(type_desc.type_desc::in, functor_number_lex::in,
+    functor_number_ordinal::out) is semidet.
 
-:- pred get_functor_lex(type_desc.type_desc::in, int::in, int::out)
-    is semidet.
+:- pred get_functor_lex(type_desc.type_desc::in, functor_number_ordinal::in,
+    functor_number_lex::out) is semidet.
 
-:- func construct(type_desc::in, int::in, list(univ)::in) = (univ::out)
-    is semidet.
+:- func construct(type_desc::in, functor_number_lex::in, list(univ)::in)
+    = (univ::out) is semidet.
 
 :- func construct_tuple_2(list(univ), list(type_desc), int) = univ.
 
@@ -650,12 +670,50 @@
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
-deconstruct(Term, NonCanon, Functor, FunctorNumber, Arity, Arguments) :-
+functor_number(Term, FunctorNumber, Arity) :-
+    TypeInfo = Term ^ type_info,
+    TypeCtorInfo = TypeInfo ^ type_ctor_info_evaled,
+    TypeCtorRep = TypeCtorInfo ^ type_ctor_rep,
+    is_du_type(TypeCtorRep),
+    NonCanon = do_not_allow,
+    deconstruct_2(Term, TypeInfo, TypeCtorInfo, TypeCtorRep, NonCanon,
+        _Functor, FunctorNumber, Arity, _Arguments).
+
+functor_number_cc(Term, FunctorNumber, Arity) :-
+    TypeInfo = Term ^ type_info,
+    TypeCtorInfo = TypeInfo ^ type_ctor_info_evaled,
+    TypeCtorRep = TypeCtorInfo ^ type_ctor_rep,
+    is_du_type(TypeCtorRep),
+    NonCanon = canonicalize,
+    deconstruct_2(Term, TypeInfo, TypeCtorInfo, TypeCtorRep, NonCanon,
+        _Functor, FunctorNumber, Arity0, _Arguments),
+    % XXX force cc_multi as required by the interface for functor_number_cc.
+    % It seems wrong since deconstruct(canonicalize) is det.
+    ( Arity = Arity0
+    ; Arity = Arity0
+    ).
+
+deconstruct(Term, NonCanon, Functor, Arity, Arguments) :-
     TypeInfo = Term ^ type_info,
     TypeCtorInfo = TypeInfo ^ type_ctor_info_evaled,
     TypeCtorRep = TypeCtorInfo ^ type_ctor_rep,
     deconstruct_2(Term, TypeInfo, TypeCtorInfo, TypeCtorRep, NonCanon,
-        Functor, FunctorNumber, Arity, Arguments).
+        Functor, _FunctorNumber, Arity, Arguments).
+
+deconstruct_du(Term, NonCanon, FunctorNumber, Arity, Arguments) :-
+    TypeInfo = Term ^ type_info,
+    TypeCtorInfo = TypeInfo ^ type_ctor_info_evaled,
+    TypeCtorRep = TypeCtorInfo ^ type_ctor_rep,
+    is_du_type(TypeCtorRep),
+    deconstruct_2(Term, TypeInfo, TypeCtorInfo, TypeCtorRep, NonCanon,
+        _Functor, FunctorNumber, Arity, Arguments).
+
+:- pred is_du_type(erlang_type_ctor_rep::in) is semidet.
+
+is_du_type(etcr_du).
+is_du_type(etcr_dummy).
+is_du_type(etcr_list).
+is_du_type(etcr_tuple).
 
 :- pred deconstruct_2(T, type_info, type_ctor_info_evaled,
     erlang_type_ctor_rep, noncanon_handling, string, int, int, list(univ)).
@@ -672,8 +730,9 @@
     (
         TypeCtorRep = etcr_du,
         FunctorReps = TypeCtorInfo ^ type_ctor_functors,
-        matching_du_functor(FunctorReps, 0, Term, FunctorRep, FunctorNumber),
+        matching_du_functor(FunctorReps, Term, FunctorRep),
         Functor = string.from_char_list(FunctorRep ^ edu_name),
+        FunctorNumber = FunctorRep ^ edu_lex,
         Arity = FunctorRep ^ edu_orig_arity,
         Arguments = list.map(
             get_du_functor_arg(TypeInfo, FunctorRep, Term), 1 .. Arity)
@@ -754,7 +813,7 @@
     ;
         TypeCtorRep = etcr_string,
         det_dynamic_cast(Term, String),
-        Functor = term_io.quoted_string(String),
+        Functor = "\"" ++ String ++ "\"",
         FunctorNumber = 0,
         Arity = 0,
         Arguments = []
@@ -836,22 +895,21 @@
     ).
 
     %
-    % matching_du_functor(FunctorReps, Index, Term, FunctorRep, FunctorNumber)
+    % matching_du_functor(FunctorReps, Term, FunctorRep)
     %
     % finds the erlang_du_functor in the list Functors which describes
     % the given Term.
     %
-:- pred matching_du_functor(list(erlang_du_functor)::in, int::in, T::in,
-    erlang_du_functor::out, int::out) is det.
+:- pred matching_du_functor(list(erlang_du_functor)::in, T::in,
+    erlang_du_functor::out) is det.
 
-matching_du_functor([], _, _, _, _) :-
+matching_du_functor([], _, _) :-
     error(this_file ++ " matching_du_functor/2").
-matching_du_functor([F | Fs], Index, T, Functor, FunctorNumber) :-
+matching_du_functor([F | Fs], T, Functor) :-
     ( matches_du_functor(T, F) ->
-        Functor = F,
-        FunctorNumber = Index
+        Functor = F
     ;
-        matching_du_functor(Fs, Index + 1, T, Functor, FunctorNumber)
+        matching_du_functor(Fs, T, Functor)
     ).
 
     %
@@ -1228,8 +1286,8 @@
         FunctorNum = 0
     ).
 
-:- pred matching_du_ordinal(list(erlang_du_functor)::in, int::in,
-    erlang_du_functor::out) is semidet.
+:- pred matching_du_ordinal(list(erlang_du_functor)::in,
+    functor_number_ordinal::in, erlang_du_functor::out) is semidet.
 
 matching_du_ordinal(Fs, Ordinal, Functor) :-
     list.index0(Fs, Ordinal, Functor),
@@ -1240,8 +1298,8 @@
         error(this_file ++ " matching_du_ordinal/3")
     ).
 
-:- pred matching_du_functor_number(list(erlang_du_functor)::in, int::in,
-    erlang_du_functor::out) is semidet.
+:- pred matching_du_functor_number(list(erlang_du_functor)::in,
+    functor_number_lex::in, erlang_du_functor::out) is semidet.
 
 matching_du_functor_number([F | Fs], FunctorNum, Functor) :-
     ( F ^ edu_lex = FunctorNum ->

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