[m-rev.] for review: deconstruct.named_arg for java
Peter Wang
novalazy at gmail.com
Fri Jul 2 12:37:25 AEST 2010
On 2010-07-02, Julien Fischer <juliensf at csse.unimelb.edu.au> wrote:
>
> On Wed, 30 Jun 2010, Peter Wang wrote:
>
> >Branches: main
>
> Is there any reason not to include this on the 10.04 branch?
Not really, I just forgot to update that part of the template.
> >library/deconstruct.m:
> >library/rtti_implementation.m:
> > Implement deconstruct.named_arg* predicates for Java backend.
> >
> > Reformat some of the code.
> >
> >tests/hard_coded/deconstruct_arg.m:
> >tests/hard_coded/deconstruct_arg.exp:
> >tests/hard_coded/deconstruct_arg.exp2:
> > Extend this test case to test named_arg_cc.
>
> That looks fine.
I committed it with these further changes.
Branches: main, 10.04
library/deconstruct.m:
library/rtti_implementation.m:
Implement deconstruct.named_arg* and deconstruct.functor_number*
predicates for Java backend.
Reformat some of the code.
tests/hard_coded/deconstruct_arg.m:
tests/hard_coded/deconstruct_arg.exp:
tests/hard_coded/deconstruct_arg.exp2:
Extend this test case to test named_arg_cc.
diff --git a/library/deconstruct.m b/library/deconstruct.m
index a3d188e..ca6b3d5 100644
--- a/library/deconstruct.m
+++ b/library/deconstruct.m
@@ -545,13 +545,13 @@ limited_deconstruct_cc(Term, MaxArity, MaybeResult) :-
}").
functor_dna(Term, Functor, Arity) :-
- local_deconstruct(Term, do_not_allow, Functor, Arity, _Arguments).
+ local_deconstruct(Term, do_not_allow, Functor, _, Arity, _Arguments).
functor_can(Term, Functor, Arity) :-
- local_deconstruct(Term, canonicalize, Functor, Arity, _Arguments).
+ local_deconstruct(Term, canonicalize, Functor, _, Arity, _Arguments).
functor_idcc(Term, Functor, Arity) :-
- local_deconstruct(Term, include_details_cc, Functor, Arity, _Arguments).
+ local_deconstruct(Term, include_details_cc, Functor, _, Arity, _Arguments).
%-----------------------------------------------------------------------------%
@@ -607,7 +607,7 @@ functor_number_cc(Term, FunctorNumber, Arity) :-
erlang_rtti_implementation.functor_number_cc(Term, FunctorNumber,
Arity)
;
- private_builtin.sorry("deconstruct.functor_number_cc")
+ rtti_implementation.functor_number_cc(Term, FunctorNumber, Arity)
).
%-----------------------------------------------------------------------------%
@@ -792,15 +792,15 @@ functor_number_cc(Term, FunctorNumber, Arity) :-
% just constructing one univ for the argument selected.
univ_arg_dna(Term, Index, Arg) :-
- local_deconstruct(Term, do_not_allow, _Functor, _Arity, Arguments),
+ local_deconstruct(Term, do_not_allow, _Functor, _, _Arity, Arguments),
list.index0(Arguments, Index, Arg).
univ_arg_can(Term, Index, Arg) :-
- local_deconstruct(Term, canonicalize, _Functor, _Arity, Arguments),
+ local_deconstruct(Term, canonicalize, _Functor, _, _Arity, Arguments),
list.index0(Arguments, Index, Arg).
univ_arg_idcc(Term, Index, DummyUniv, Argument, Success) :-
- local_deconstruct(Term, include_details_cc, _Functor, _Arity, Arguments),
+ local_deconstruct(Term, include_details_cc, _Functor, _, _Arity, Arguments),
( list.index0(Arguments, Index, Arg) ->
Argument = Arg,
Success = 1
@@ -1015,47 +1015,50 @@ univ_named_arg_idcc(Term, Name, DummyUniv, Argument, Success) :-
}").
deconstruct_dna(Term, Functor, FunctorNumber, Arity, Arguments) :-
- FunctorNumber = -1,
- local_deconstruct(Term, do_not_allow, Functor, Arity, Arguments).
+ local_deconstruct(Term, do_not_allow, Functor, FunctorNumber, Arity,
+ Arguments).
deconstruct_can(Term, Functor, Arity, Arguments) :-
- local_deconstruct(Term, canonicalize, Functor, Arity, Arguments).
+ local_deconstruct(Term, canonicalize, Functor, _, Arity, Arguments).
deconstruct_idcc(Term, Functor, FunctorNumber, Arity, Arguments) :-
- FunctorNumber = -1,
- local_deconstruct(Term, include_details_cc, Functor, Arity, Arguments).
+ local_deconstruct(Term, include_details_cc, Functor, FunctorNumber, Arity,
+ Arguments).
% XXX The Mercury implementations of all of these limited_* procedures
% are inefficient -- they construct Functor and Arguments even in the case
% when Arity > MaxArity.
limited_deconstruct_dna(Term, MaxArity, Functor, Arity, Arguments) :-
- local_deconstruct(Term, do_not_allow, Functor, Arity, Arguments),
+ local_deconstruct(Term, do_not_allow, Functor, _, Arity, Arguments),
Arity =< MaxArity.
limited_deconstruct_can(Term, MaxArity, Functor, Arity, Arguments) :-
- local_deconstruct(Term, canonicalize, Functor, Arity, Arguments),
+ local_deconstruct(Term, canonicalize, Functor, _, Arity, Arguments),
Arity =< MaxArity.
limited_deconstruct_idcc(Term, _MaxArity, Functor, Arity, Arguments) :-
% For this one, the caller checks Arity =< MaxArity.
- local_deconstruct(Term, include_details_cc, Functor, Arity, Arguments).
+ local_deconstruct(Term, include_details_cc, Functor, _, Arity, Arguments).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-:- 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.
+:- pred local_deconstruct(T, noncanon_handling, string, int, int, list(univ)).
+:- mode local_deconstruct(in, in(do_not_allow), out, out, out, out) is det.
+:- mode local_deconstruct(in, in(canonicalize), out, out, out, out) is det.
+:- mode local_deconstruct(in, in(include_details_cc), out, out, out, out)
+ is cc_multi.
+:- mode local_deconstruct(in, in, out, out, out, out) is cc_multi.
-local_deconstruct(Term, NonCanon, Functor, Arity, Arguments) :-
+local_deconstruct(Term, NonCanon, Functor, FunctorNumber, Arity, Arguments) :-
( erlang_rtti_implementation.is_erlang_backend ->
erlang_rtti_implementation.deconstruct(Term, NonCanon, Functor, Arity,
- Arguments)
+ Arguments),
+ % XXX incomplete
+ FunctorNumber = 0
;
- rtti_implementation.deconstruct(Term, NonCanon, Functor, Arity,
- Arguments)
+ rtti_implementation.deconstruct(Term, NonCanon, Functor, FunctorNumber,
+ Arity, Arguments)
).
:- pred local_univ_named_arg(T, noncanon_handling, string, univ).
diff --git a/library/rtti_implementation.m b/library/rtti_implementation.m
index d451689..d17f80f 100644
--- a/library/rtti_implementation.m
+++ b/library/rtti_implementation.m
@@ -75,11 +75,15 @@
:- func construct_tuple_2(list(univ), list(type_info), int) = univ.
-:- 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) is cc_multi.
+:- 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)
+ is cc_multi.
+:- mode deconstruct(in, in, out, out, out, out) is cc_multi.
+
+:- pred functor_number_cc(T::in, int::out, int::out)
+ is semidet. % conceptually committed-choice
:- pred univ_named_arg(T, noncanon_handling, string, univ).
:- mode univ_named_arg(in, in(do_not_allow), in, out) is semidet.
@@ -579,15 +583,7 @@ type_info_get_functor_ordinal(TypeInfo, FunctorNum, Ordinal) :-
type_info_get_functor_lex(TypeInfo0, Ordinal, FunctorNumber) :-
TypeInfo = collapse_equivalences(TypeInfo0),
TypeCtorInfo = get_type_ctor_info(TypeInfo),
- TypeCtorRep = get_type_ctor_rep(TypeCtorInfo),
- % XXX This special case seems like it should be not necessary.
- ( TypeCtorRep = tcr_tuple ->
- Ordinal = 0,
- FunctorNumber = 0
- ;
- type_ctor_search_functor_number_map(TypeCtorInfo, Ordinal,
- FunctorNumber)
- ).
+ type_ctor_search_functor_number_map(TypeCtorInfo, Ordinal, FunctorNumber).
%-----------------------------------------------------------------------------%
@@ -1740,20 +1736,42 @@ construct_tuple_2(_Args, _ArgTypes, _Arity) = _ :-
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-deconstruct(Term, NonCanon, Functor, Arity, Arguments) :-
+deconstruct(Term, NonCanon, Functor, FunctorNumber, Arity, Arguments) :-
TypeInfo = get_type_info(Term),
TypeCtorInfo = get_type_ctor_info(TypeInfo),
TypeCtorRep = get_type_ctor_rep(TypeCtorInfo),
deconstruct_2(Term, TypeInfo, TypeCtorInfo, TypeCtorRep, NonCanon,
- Functor, Arity, Arguments).
+ Functor, Ordinal, Arity, Arguments),
+ (
+ Ordinal >= 0,
+ type_ctor_search_functor_number_map(TypeCtorInfo, Ordinal,
+ FunctorNumber0)
+ ->
+ FunctorNumber = FunctorNumber0
+ ;
+ FunctorNumber = 0
+ ).
+
+functor_number_cc(Term, FunctorNumber, Arity) :-
+ TypeInfo = get_type_info(Term),
+ TypeCtorInfo = get_type_ctor_info(TypeInfo),
+ TypeCtorRep = get_type_ctor_rep(TypeCtorInfo),
+ promise_equivalent_solutions [Ordinal, Arity] (
+ deconstruct_2(Term, TypeInfo, TypeCtorInfo, TypeCtorRep,
+ include_details_cc, _Functor, Ordinal, Arity, _Arguments)
+ ),
+ Ordinal >= 0,
+ type_ctor_search_functor_number_map(TypeCtorInfo, Ordinal, FunctorNumber).
:- pred deconstruct_2(T, type_info, type_ctor_info, type_ctor_rep,
- noncanon_handling, string, int, list(univ)).
-:- mode deconstruct_2(in, in, in, in, in(do_not_allow), out, out, out) is det.
-:- mode deconstruct_2(in, in, in, in, in(canonicalize), out, out, out) is det.
-:- mode deconstruct_2(in, in, in, in, in(include_details_cc), out, out, out)
- is cc_multi.
-:- mode deconstruct_2(in, in, in, in, in, out, out, out) is cc_multi.
+ noncanon_handling, string, int, int, list(univ)).
+:- mode deconstruct_2(in, in, in, in, in(do_not_allow), out, out, out, out)
+ is det.
+:- mode deconstruct_2(in, in, in, in, in(canonicalize), out, out, out, out)
+ is det.
+:- mode deconstruct_2(in, in, in, in, in(include_details_cc), out, out, out,
+ out) is cc_multi.
+:- mode deconstruct_2(in, in, in, in, in, out, out, out, out) is cc_multi.
% Code to perform deconstructions (XXX not yet complete).
%
@@ -1762,17 +1780,18 @@ deconstruct(Term, NonCanon, Functor, Arity, Arguments) :-
% so far.
%
deconstruct_2(Term, TypeInfo, TypeCtorInfo, TypeCtorRep, NonCanon,
- Functor, Arity, Arguments) :-
+ Functor, Ordinal, Arity, Arguments) :-
(
TypeCtorRep = tcr_enum_usereq,
handle_usereq_type(Term, TypeInfo, TypeCtorInfo, TypeCtorRep,
- NonCanon, Functor, Arity, Arguments)
+ NonCanon, Functor, Ordinal, Arity, Arguments)
;
TypeCtorRep = tcr_enum,
TypeLayout = get_type_layout(TypeCtorInfo),
EnumFunctorDesc = get_enum_functor_desc_from_layout_enum(TypeCtorRep,
unsafe_get_enum_value(Term), TypeLayout),
Functor = enum_functor_name(EnumFunctorDesc),
+ Ordinal = enum_functor_ordinal(EnumFunctorDesc),
Arity = 0,
Arguments = []
;
@@ -1781,24 +1800,26 @@ deconstruct_2(Term, TypeInfo, TypeCtorInfo, TypeCtorRep, NonCanon,
ForeignEnumFunctorDesc = foreign_enum_functor_desc(TypeCtorRep,
unsafe_get_foreign_enum_value(Term), TypeFunctors),
Functor = foreign_enum_functor_name(ForeignEnumFunctorDesc),
+ Ordinal = -1,
Arity = 0,
Arguments = []
;
TypeCtorRep = tcr_foreign_enum_usereq,
handle_usereq_type(Term, TypeInfo, TypeCtorInfo, TypeCtorRep,
- NonCanon, Functor, Arity, Arguments)
+ NonCanon, Functor, Ordinal, Arity, Arguments)
;
TypeCtorRep = tcr_dummy,
TypeLayout = get_type_layout(TypeCtorInfo),
EnumFunctorDesc = get_enum_functor_desc_from_layout_enum(TypeCtorRep,
0, TypeLayout),
Functor = enum_functor_name(EnumFunctorDesc),
+ Ordinal = 0,
Arity = 0,
Arguments = []
;
TypeCtorRep = tcr_du_usereq,
handle_usereq_type(Term, TypeInfo, TypeCtorInfo, TypeCtorRep,
- NonCanon, Functor, Arity, Arguments)
+ NonCanon, Functor, Ordinal, Arity, Arguments)
;
TypeCtorRep = tcr_du,
@@ -1807,49 +1828,53 @@ deconstruct_2(Term, TypeInfo, TypeCtorInfo, TypeCtorRep, NonCanon,
PTagEntry = LayoutInfo ^ ptag_index(PTag),
SecTagLocn = PTagEntry ^ sectag_locn,
(
- SecTagLocn = stag_none,
- FunctorDesc = PTagEntry ^ du_sectag_alternatives(0),
+ (
+ SecTagLocn = stag_none,
+ FunctorDesc = PTagEntry ^ du_sectag_alternatives(0)
+ ;
+ SecTagLocn = stag_remote,
+ SecTag = get_remote_secondary_tag(Term),
+ FunctorDesc = PTagEntry ^ du_sectag_alternatives(SecTag)
+ ),
Functor = FunctorDesc ^ du_functor_name,
+ Ordinal = FunctorDesc ^ du_functor_ordinal,
Arity = FunctorDesc ^ du_functor_arity,
Arguments = iterate(0, Arity - 1,
get_arg_univ(Term, SecTagLocn, FunctorDesc, TypeInfo))
;
SecTagLocn = stag_local,
Functor = "some_du_local_sectag",
+ % XXX incomplete
+ Ordinal = -1,
Arity = 0,
Arguments = []
;
- SecTagLocn = stag_remote,
- SecTag = get_remote_secondary_tag(Term),
- FunctorDesc = PTagEntry ^ du_sectag_alternatives(SecTag),
- Functor = FunctorDesc ^ du_functor_name,
- Arity = FunctorDesc ^ du_functor_arity,
- Arguments = iterate(0, Arity - 1,
- get_arg_univ(Term, SecTagLocn, FunctorDesc, TypeInfo))
- ;
SecTagLocn = stag_variable,
Functor = "some_du_variable_sectag",
+ Ordinal = -1,
Arity = 0,
Arguments = []
)
;
TypeCtorRep = tcr_notag_usereq,
handle_usereq_type(Term, TypeInfo, TypeCtorInfo, TypeCtorRep, NonCanon,
- Functor, Arity, Arguments)
+ Functor, Ordinal, Arity, Arguments)
;
TypeCtorRep = tcr_notag,
% XXX incomplete
Functor = "some_notag",
+ Ordinal = -1,
Arity = 0,
Arguments = []
;
TypeCtorRep = tcr_notag_ground_usereq,
handle_usereq_type(Term, TypeInfo, TypeCtorInfo, TypeCtorRep, NonCanon,
- Functor, Arity, Arguments)
+ Functor, Ordinal, Arity, Arguments)
;
TypeCtorRep = tcr_notag_ground,
% XXX incomplete
Functor = "some_notag_ground",
+ Ordinal = -1,
Arity = 0,
Arguments = []
;
@@ -1858,41 +1883,47 @@ deconstruct_2(Term, TypeInfo, TypeCtorInfo, TypeCtorRep, NonCanon,
NewTypeCtorInfo = get_type_ctor_info(NewTypeInfo),
NewTypeCtorRep = get_type_ctor_rep(NewTypeCtorInfo),
deconstruct_2(Term, NewTypeInfo, NewTypeCtorInfo, NewTypeCtorRep,
- NonCanon, Functor, Arity, Arguments)
+ NonCanon, Functor, Ordinal, Arity, Arguments)
;
% XXX noncanonical term
TypeCtorRep = tcr_func,
Functor = "<<function>>",
+ Ordinal = -1,
Arity = 0,
Arguments = []
;
TypeCtorRep = tcr_equiv,
% XXX incomplete
Functor = "some_equiv",
+ Ordinal = -1,
Arity = 0,
Arguments = []
;
TypeCtorRep = tcr_int,
det_dynamic_cast(Term, Int),
Functor = string.int_to_string(Int),
+ Ordinal = -1,
Arity = 0,
Arguments = []
;
TypeCtorRep = tcr_char,
det_dynamic_cast(Term, Char),
Functor = string.from_char_list(['\'', Char, '\'']),
+ Ordinal = -1,
Arity = 0,
Arguments = []
;
TypeCtorRep = tcr_float,
det_dynamic_cast(Term, Float),
Functor = float_to_string(Float),
+ Ordinal = -1,
Arity = 0,
Arguments = []
;
TypeCtorRep = tcr_string,
det_dynamic_cast(Term, String),
Functor = string.append_list(["\"", String, "\""]),
+ Ordinal = -1,
Arity = 0,
Arguments = []
;
@@ -1900,18 +1931,21 @@ deconstruct_2(Term, TypeInfo, TypeCtorInfo, TypeCtorRep, NonCanon,
det_dynamic_cast(Term, Bitmap),
String = bitmap.to_string(Bitmap),
Functor = "\"" ++ String ++ "\"",
+ Ordinal = -1,
Arity = 0,
Arguments = []
;
% XXX noncanonical term
TypeCtorRep = tcr_pred,
Functor = "<<predicate>>",
+ Ordinal = -1,
Arity = 0,
Arguments = []
;
TypeCtorRep = tcr_tuple,
type_ctor_and_args(TypeInfo, _TypeCtorInfo, TypeArgs),
Functor = "{}",
+ Ordinal = 0,
Arity = get_var_arity_typeinfo_arity(TypeInfo),
list.map_foldl(
(pred(TI::in, U::out, Index::in, Next::out) is det :-
@@ -1923,6 +1957,7 @@ deconstruct_2(Term, TypeInfo, TypeCtorInfo, TypeCtorRep, NonCanon,
% XXX noncanonical term
TypeCtorRep = tcr_subgoal,
Functor = "<<subgoal>>",
+ Ordinal = -1,
Arity = 0,
Arguments = []
;
@@ -1934,24 +1969,28 @@ deconstruct_2(Term, TypeInfo, TypeCtorInfo, TypeCtorRep, NonCanon,
TypeCtorRep = tcr_c_pointer,
det_dynamic_cast(Term, CPtr),
Functor = string.c_pointer_to_string(CPtr),
+ Ordinal = -1,
Arity = 0,
Arguments = []
;
TypeCtorRep = tcr_stable_c_pointer,
det_dynamic_cast(Term, CPtr),
Functor = "stable_" ++ string.c_pointer_to_string(CPtr),
+ Ordinal = -1,
Arity = 0,
Arguments = []
;
% XXX noncanonical term
TypeCtorRep = tcr_typeinfo,
Functor = "some_typeinfo",
+ Ordinal = -1,
Arity = 0,
Arguments = []
;
% XXX noncanonical term
TypeCtorRep = tcr_typeclassinfo,
Functor = "<<typeclassinfo>>",
+ Ordinal = -1,
Arity = 0,
Arguments = []
;
@@ -1969,6 +2008,7 @@ deconstruct_2(Term, TypeInfo, TypeCtorInfo, TypeCtorRep, NonCanon,
det_dynamic_cast(Term, Array),
Functor = "<<array>>",
+ Ordinal = -1,
Arity = array.size(Array),
Arguments = array.foldr(
(func(Elem, List) = [univ(Elem) | List]),
@@ -1976,97 +2016,114 @@ deconstruct_2(Term, TypeInfo, TypeCtorInfo, TypeCtorRep, NonCanon,
;
TypeCtorRep = tcr_succip,
Functor = "<<succip>>",
+ Ordinal = -1,
Arity = 0,
Arguments = []
;
TypeCtorRep = tcr_hp,
Functor = "<<hp>>",
+ Ordinal = -1,
Arity = 0,
Arguments = []
;
TypeCtorRep = tcr_curfr,
Functor = "<<curfr>>",
+ Ordinal = -1,
Arity = 0,
Arguments = []
;
TypeCtorRep = tcr_maxfr,
Functor = "<<maxfr>>",
+ Ordinal = -1,
Arity = 0,
Arguments = []
;
TypeCtorRep = tcr_redofr,
Functor = "<<redofr>>",
+ Ordinal = -1,
Arity = 0,
Arguments = []
;
TypeCtorRep = tcr_redoip,
Functor = "<<redoip>>",
+ Ordinal = -1,
Arity = 0,
Arguments = []
;
TypeCtorRep = tcr_trail_ptr,
Functor = "<<trail_ptr>>",
+ Ordinal = -1,
Arity = 0,
Arguments = []
;
TypeCtorRep = tcr_ticket,
Functor = "<<ticket>>",
+ Ordinal = -1,
Arity = 0,
Arguments = []
;
% XXX FIXME!!!
TypeCtorRep = tcr_reserved_addr,
Functor = "some_reserved_addr",
+ Ordinal = -1,
Arity = 0,
Arguments = []
;
TypeCtorRep = tcr_reserved_addr_usereq,
handle_usereq_type(Term, TypeInfo, TypeCtorInfo, TypeCtorRep, NonCanon,
- Functor, Arity, Arguments)
+ Functor, Ordinal, Arity, Arguments)
;
% XXX noncanonical term
TypeCtorRep = tcr_type_ctor_info,
Functor = "some_typectorinfo",
+ Ordinal = -1,
Arity = 0,
Arguments = []
;
% XXX noncanonical term
TypeCtorRep = tcr_base_typeclass_info,
Functor = "<<basetypeclassinfo>>",
+ Ordinal = -1,
Arity = 0,
Arguments = []
;
% XXX noncanonical term
TypeCtorRep = tcr_type_desc,
Functor = "some_type_desc",
+ Ordinal = -1,
Arity = 0,
Arguments = []
;
% XXX noncanonical term
TypeCtorRep = tcr_pseudo_type_desc,
Functor = "some_pseudo_type_desc",
+ Ordinal = -1,
Arity = 0,
Arguments = []
;
% XXX noncanonical term
TypeCtorRep = tcr_type_ctor_desc,
Functor = "some_type_ctor_desc",
+ Ordinal = -1,
Arity = 0,
Arguments = []
;
TypeCtorRep = tcr_foreign,
Functor = "<<foreign>>",
+ Ordinal = -1,
Arity = 0,
Arguments = []
;
TypeCtorRep = tcr_stable_foreign,
Functor = "<<stable_foreign>>",
+ Ordinal = -1,
Arity = 0,
Arguments = []
;
% XXX noncanonical term
TypeCtorRep = tcr_reference,
Functor = "<<reference>>",
+ Ordinal = -1,
Arity = 0,
Arguments = []
;
@@ -2210,24 +2267,25 @@ same_array_elem_type(_, _).
; tcr_reserved_addr_usereq.
:- pred handle_usereq_type(T, type_info, type_ctor_info, type_ctor_rep,
- noncanon_handling, string, int, list(univ)).
+ noncanon_handling, string, int, int, list(univ)).
:- mode handle_usereq_type(in, in, in, in(usereq),
- in(do_not_allow), out, out, out) is erroneous.
+ in(do_not_allow), out, out, out, out) is erroneous.
:- mode handle_usereq_type(in, in, in, in(usereq),
- in(canonicalize), out, out, out) is det.
+ in(canonicalize), out, out, out, out) is det.
:- mode handle_usereq_type(in, in, in, in(usereq),
- in(include_details_cc), out, out, out) is cc_multi.
+ in(include_details_cc), out, out, out, out) is cc_multi.
:- mode handle_usereq_type(in, in, in, in(usereq),
- in, out, out, out) is cc_multi.
+ in, out, out, out, out) is cc_multi.
-handle_usereq_type(Term, TypeInfo, TypeCtorInfo,
- TypeCtorRep, NonCanon, Functor, Arity, Arguments) :-
+handle_usereq_type(Term, TypeInfo, TypeCtorInfo, TypeCtorRep, NonCanon,
+ Functor, Ordinal, Arity, Arguments) :-
(
NonCanon = do_not_allow,
error("attempt to deconstruct noncanonical term")
;
NonCanon = canonicalize,
Functor = expand_type_name(TypeCtorInfo, yes),
+ Ordinal = -1, % not supported anyway
Arity = 0,
Arguments = []
;
@@ -2252,7 +2310,7 @@ handle_usereq_type(Term, TypeInfo, TypeCtorInfo,
BaseTypeCtorRep = tcr_reserved_addr
),
deconstruct_2(Term, TypeInfo, TypeCtorInfo, BaseTypeCtorRep, NonCanon,
- Functor, Arity, Arguments)
+ Functor, Ordinal, Arity, Arguments)
).
% MR_expand_type_name from mercury_deconstruct.c
@@ -3525,6 +3583,10 @@ type_ctor_num_functors(_) = _ :-
if (Ordinal >= 0 && Ordinal < TypeCtorInfo.type_ctor_num_functors) {
FunctorNumber = TypeCtorInfo.type_functor_number_map[Ordinal];
SUCCESS_INDICATOR = true;
+ } else if (Ordinal == 0 && TypeCtorInfo.type_ctor_num_functors == -1) {
+ /* This is for tuples. */
+ FunctorNumber = 0;
+ SUCCESS_INDICATOR = true;
} else {
FunctorNumber = -1;
SUCCESS_INDICATOR = false;
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------
More information about the reviews
mailing list