[m-rev.] for review: deconstruct.named_arg for java

Peter Wang novalazy at gmail.com
Wed Jun 30 14:48:09 AEST 2010


Branches: main

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.

diff --git a/library/deconstruct.m b/library/deconstruct.m
index 4a7d095..a3d188e 100644
--- a/library/deconstruct.m
+++ b/library/deconstruct.m
@@ -544,15 +544,14 @@ limited_deconstruct_cc(Term, MaxArity, MaybeResult) :-
 #undef  NONCANON
 }").
 
-functor_dna(Term::in, Functor::out, Arity::out) :-
-    local_deconstruct(Term,
-        do_not_allow, Functor, Arity, _Arguments).
-functor_can(Term::in, Functor::out, Arity::out) :-
-    local_deconstruct(Term,
-        canonicalize, Functor, Arity, _Arguments).
-functor_idcc(Term::in, Functor::out, Arity::out) :-
-    local_deconstruct(Term,
-        include_details_cc, Functor, Arity, _Arguments).
+functor_dna(Term, Functor, Arity) :-
+    local_deconstruct(Term, do_not_allow, Functor, Arity, _Arguments).
+
+functor_can(Term, Functor, Arity) :-
+    local_deconstruct(Term, canonicalize, Functor, Arity, _Arguments).
+
+functor_idcc(Term, Functor, Arity) :-
+    local_deconstruct(Term, include_details_cc, Functor, Arity, _Arguments).
 
 %-----------------------------------------------------------------------------%
 
@@ -596,14 +595,14 @@ SUCCESS_INDICATOR = (FunctorNumber >= 0);
 SUCCESS_INDICATOR = (FunctorNumber >= 0);
 }").
 
-functor_number(Term::in, FunctorNumber::out, Arity::out) :-
+functor_number(Term, FunctorNumber, Arity) :-
     ( erlang_rtti_implementation.is_erlang_backend ->
         erlang_rtti_implementation.functor_number(Term, FunctorNumber, Arity)
     ;
         private_builtin.sorry("deconstruct.functor_number")
     ).
 
-functor_number_cc(Term::in, FunctorNumber::out, Arity::out) :-
+functor_number_cc(Term, FunctorNumber, Arity) :-
     ( erlang_rtti_implementation.is_erlang_backend ->
         erlang_rtti_implementation.functor_number_cc(Term, FunctorNumber,
             Arity)
@@ -792,18 +791,16 @@ functor_number_cc(Term::in, FunctorNumber::out, Arity::out) :-
 % unnecessarily construct the list of univs for all the arguments, rather than
 % just constructing one univ for the argument selected.
 
-univ_arg_dna(Term::in, Index::in, Arg::out) :-
-    local_deconstruct(Term, do_not_allow,
-        _Functor, _Arity, Arguments),
+univ_arg_dna(Term, Index, Arg) :-
+    local_deconstruct(Term, do_not_allow, _Functor, _Arity, Arguments),
     list.index0(Arguments, Index, Arg).
-univ_arg_can(Term::in, Index::in, Arg::out) :-
-    local_deconstruct(Term, canonicalize,
-        _Functor, _Arity, Arguments),
+
+univ_arg_can(Term, Index, Arg) :-
+    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) :-
-    local_deconstruct(Term, include_details_cc,
-        _Functor, _Arity, Arguments),
+
+univ_arg_idcc(Term, Index, DummyUniv, Argument, Success) :-
+    local_deconstruct(Term, include_details_cc, _Functor, _Arity, Arguments),
     ( list.index0(Arguments, Index, Arg) ->
         Argument = Arg,
         Success = 1
@@ -812,6 +809,25 @@ univ_arg_idcc(Term::in, Index::in, DummyUniv::in, Argument::out,
         Success = 0
     ).
 
+univ_named_arg_dna(Term, Name, Argument) :-
+    local_univ_named_arg(Term, do_not_allow, Name, Argument).
+
+univ_named_arg_can(Term, Name, Argument) :-
+    local_univ_named_arg(Term, canonicalize, Name, Argument).
+
+univ_named_arg_idcc(Term, Name, DummyUniv, Argument, Success) :-
+    ( local_univ_named_arg(Term, include_details_cc, Name, Arg) ->
+        Argument = Arg,
+        Success = 1
+    ;
+        Argument = DummyUniv,
+        Success = 0
+    ;
+        % Force cc_multi.
+        Argument = DummyUniv,
+        Success = 0
+    ).
+
 %-----------------------------------------------------------------------------%
 
 :- pred deconstruct_dna(T::in, string::out,
@@ -828,8 +844,8 @@ univ_arg_idcc(Term::in, Index::in, DummyUniv::in, Argument::out,
     string::out, int::out, list(univ)::out) is cc_multi.
 
 :- pragma foreign_proc("C",
-    deconstruct_dna(Term::in, Functor::out, FunctorNumber::out,
-            Arity::out, Arguments::out),
+    deconstruct_dna(Term::in, Functor::out, FunctorNumber::out, Arity::out,
+        Arguments::out),
     [will_not_call_mercury, thread_safe, promise_pure],
 "{
 #define EXPAND_INFO_TYPE        MR_Expand_Functor_Args_Info
@@ -998,38 +1014,31 @@ univ_arg_idcc(Term::in, Index::in, DummyUniv::in, Argument::out,
     }
 }").
 
-deconstruct_dna(Term::in, Functor::out, FunctorNumber::out,
-        Arity::out, Arguments::out) :-
+deconstruct_dna(Term, Functor, FunctorNumber, Arity, Arguments) :-
     FunctorNumber = -1,
-    local_deconstruct(Term, do_not_allow,
-        Functor, Arity, Arguments).
-deconstruct_can(Term::in, Functor::out, Arity::out, Arguments::out) :-
-    local_deconstruct(Term, canonicalize,
-        Functor, Arity, Arguments).
-deconstruct_idcc(Term::in, Functor::out, FunctorNumber::out,
-        Arity::out, Arguments::out) :-
+    local_deconstruct(Term, do_not_allow, Functor, Arity, Arguments).
+
+deconstruct_can(Term, 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, 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::in, MaxArity::in,
-        Functor::out, Arity::out, Arguments::out) :-
-    local_deconstruct(Term, do_not_allow,
-        Functor, Arity, Arguments),
+limited_deconstruct_dna(Term, MaxArity, Functor, Arity, Arguments) :-
+    local_deconstruct(Term, do_not_allow, Functor, Arity, Arguments),
     Arity =< MaxArity.
-limited_deconstruct_can(Term::in, MaxArity::in,
-        Functor::out, Arity::out, Arguments::out) :-
-    local_deconstruct(Term, canonicalize,
-        Functor, Arity, Arguments),
+
+limited_deconstruct_can(Term, MaxArity, Functor, Arity, Arguments) :-
+    local_deconstruct(Term, canonicalize, Functor, Arity, Arguments),
     Arity =< MaxArity.
-limited_deconstruct_idcc(Term::in, _MaxArity::in,
-        Functor::out, Arity::out, Arguments::out) :-
+
+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).
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
@@ -1040,11 +1049,26 @@ limited_deconstruct_idcc(Term::in, _MaxArity::in,
 :- 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) :-
+local_deconstruct(Term, NonCanon, Functor, Arity, Arguments) :-
+    ( erlang_rtti_implementation.is_erlang_backend ->
+        erlang_rtti_implementation.deconstruct(Term, NonCanon, Functor, Arity,
+            Arguments)
+    ;
+        rtti_implementation.deconstruct(Term, NonCanon, Functor, Arity,
+            Arguments)
+    ).
+
+:- pred local_univ_named_arg(T, noncanon_handling, string, univ).
+:- mode local_univ_named_arg(in, in(do_not_allow), in, out) is semidet.
+:- mode local_univ_named_arg(in, in(canonicalize), in, out) is semidet.
+:- mode local_univ_named_arg(in, in(include_details_cc), in, out)
+    is semidet. % conceptually committed-choice
+
+local_univ_named_arg(Term, NonCanon, Name, Argument) :-
     ( erlang_rtti_implementation.is_erlang_backend ->
-        erlang_rtti_implementation.deconstruct(T, H, F, A, As)
+        private_builtin.sorry("local_univ_named_arg")
     ;
-        rtti_implementation.deconstruct(T, H, F, A, As)
+        rtti_implementation.univ_named_arg(Term, NonCanon, Name, Argument)
     ).
 
 %-----------------------------------------------------------------------------%
diff --git a/library/rtti_implementation.m b/library/rtti_implementation.m
index 794bc99..d451689 100644
--- a/library/rtti_implementation.m
+++ b/library/rtti_implementation.m
@@ -81,6 +81,12 @@
 :- mode deconstruct(in, in(include_details_cc), out, out, out) is cc_multi.
 :- mode deconstruct(in, in, out, out, out) is cc_multi.
 
+:- pred univ_named_arg(T, noncanon_handling, string, univ).
+:- mode univ_named_arg(in, in(do_not_allow), in, out) is semidet.
+:- mode univ_named_arg(in, in(canonicalize), in, out) is semidet.
+:- mode univ_named_arg(in, in(include_details_cc), in, out)
+    is semidet. % conceptually committed-choice
+
 %-----------------------------------------------------------------------------%
 %
 % Implementations for use from construct.
@@ -1745,8 +1751,8 @@ deconstruct(Term, NonCanon, Functor, Arity, Arguments) :-
     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(include_details_cc), out, out, out)
+    is cc_multi.
 :- mode deconstruct_2(in, in, in, in, in, out, out, out) is cc_multi.
 
     % Code to perform deconstructions (XXX not yet complete).
@@ -1806,9 +1812,7 @@ deconstruct_2(Term, TypeInfo, TypeCtorInfo, TypeCtorRep, NonCanon,
             Functor = FunctorDesc ^ du_functor_name,
             Arity = FunctorDesc ^ du_functor_arity,
             Arguments = iterate(0, Arity - 1,
-                (func(X) = univ(
-                    get_arg(Term, X, SecTagLocn, FunctorDesc, TypeInfo))
-                ))
+                get_arg_univ(Term, SecTagLocn, FunctorDesc, TypeInfo))
         ;
             SecTagLocn = stag_local,
             Functor = "some_du_local_sectag",
@@ -1821,9 +1825,7 @@ deconstruct_2(Term, TypeInfo, TypeCtorInfo, TypeCtorRep, NonCanon,
             Functor = FunctorDesc ^ du_functor_name,
             Arity = FunctorDesc ^ du_functor_arity,
             Arguments = iterate(0, Arity - 1,
-                (func(X) = univ(
-                    get_arg(Term, X, SecTagLocn, FunctorDesc, TypeInfo))
-                ))
+                get_arg_univ(Term, SecTagLocn, FunctorDesc, TypeInfo))
         ;
             SecTagLocn = stag_variable,
             Functor = "some_du_variable_sectag",
@@ -2072,6 +2074,123 @@ deconstruct_2(Term, TypeInfo, TypeCtorInfo, TypeCtorRep, NonCanon,
         error("rtti_implementation: unknown type_ctor rep in deconstruct")
     ).
 
+univ_named_arg(Term, NonCanon, Name, Argument) :-
+    TypeInfo = get_type_info(Term),
+    TypeCtorInfo = get_type_ctor_info(TypeInfo),
+    TypeCtorRep = get_type_ctor_rep(TypeCtorInfo),
+    univ_named_arg_2(Term, TypeInfo, TypeCtorInfo, TypeCtorRep, NonCanon, Name,
+        MaybeArgument),
+    MaybeArgument = yes(Argument).
+
+:- pred univ_named_arg_2(T, type_info, type_ctor_info, type_ctor_rep,
+    noncanon_handling, string, maybe(univ)).
+:- mode univ_named_arg_2(in, in, in, in, in(do_not_allow), in, out) is det.
+:- mode univ_named_arg_2(in, in, in, in, in(canonicalize), in, out) is det.
+:- mode univ_named_arg_2(in, in, in, in, in(include_details_cc), in, out)
+    is det.
+
+univ_named_arg_2(Term, TypeInfo, TypeCtorInfo, TypeCtorRep, NonCanon, Name,
+        MaybeArgument) :-
+    (
+        TypeCtorRep = tcr_du_usereq,
+        (
+            NonCanon = do_not_allow,
+            error("attempt to deconstruct noncanonical term")
+        ;
+            NonCanon = canonicalize,
+            MaybeArgument = no
+        ;
+            NonCanon = include_details_cc,
+            univ_named_arg_2(Term, TypeInfo, TypeCtorInfo, tcr_du, NonCanon,
+                Name, MaybeArgument)
+        )
+    ;
+        TypeCtorRep = tcr_du,
+        LayoutInfo = get_type_layout(TypeCtorInfo),
+        PTag = get_primary_tag(Term),
+        PTagEntry = LayoutInfo ^ ptag_index(PTag),
+        SecTagLocn = PTagEntry ^ sectag_locn,
+        (
+            (
+                SecTagLocn = stag_none,
+                SecTag = 0
+            ;
+                SecTagLocn = stag_remote,
+                SecTag = get_remote_secondary_tag(Term)
+            ),
+            FunctorDesc = PTagEntry ^ du_sectag_alternatives(SecTag),
+            Arity = FunctorDesc ^ du_functor_arity,
+            (
+                get_du_functor_arg_names(FunctorDesc, Names),
+                search_arg_names(Names, 0, Arity, Name, Index)
+            ->
+                ArgUniv = get_arg_univ(Term, SecTagLocn, FunctorDesc, TypeInfo,
+                    Index),
+                MaybeArgument = yes(ArgUniv)
+            ;
+                MaybeArgument = no
+            )
+        ;
+            SecTagLocn = stag_local,
+            MaybeArgument = no
+        ;
+            SecTagLocn = stag_variable,
+            MaybeArgument = no
+        )
+    ;
+        ( TypeCtorRep = tcr_enum
+        ; TypeCtorRep = tcr_enum_usereq
+        ; TypeCtorRep = tcr_notag
+        ; TypeCtorRep = tcr_notag_usereq
+        ; TypeCtorRep = tcr_equiv
+        ; TypeCtorRep = tcr_func
+        ; TypeCtorRep = tcr_int
+        ; TypeCtorRep = tcr_char
+        ; TypeCtorRep = tcr_float
+        ; TypeCtorRep = tcr_string
+        ; TypeCtorRep = tcr_pred
+        ; TypeCtorRep = tcr_subgoal
+        ; TypeCtorRep = tcr_c_pointer
+        ; TypeCtorRep = tcr_typeinfo
+        ; TypeCtorRep = tcr_typeclassinfo
+        ; TypeCtorRep = tcr_array
+        ; TypeCtorRep = tcr_succip
+        ; TypeCtorRep = tcr_hp
+        ; TypeCtorRep = tcr_curfr
+        ; TypeCtorRep = tcr_maxfr
+        ; TypeCtorRep = tcr_redofr
+        ; TypeCtorRep = tcr_redoip
+        ; TypeCtorRep = tcr_trail_ptr
+        ; TypeCtorRep = tcr_ticket
+        ; TypeCtorRep = tcr_notag_ground
+        ; TypeCtorRep = tcr_notag_ground_usereq
+        ; TypeCtorRep = tcr_equiv_ground
+        ; TypeCtorRep = tcr_tuple
+        ; TypeCtorRep = tcr_reserved_addr
+        ; TypeCtorRep = tcr_reserved_addr_usereq
+        ; TypeCtorRep = tcr_type_ctor_info
+        ; TypeCtorRep = tcr_base_typeclass_info
+        ; TypeCtorRep = tcr_type_desc
+        ; TypeCtorRep = tcr_type_ctor_desc
+        ; TypeCtorRep = tcr_foreign
+        ; TypeCtorRep = tcr_reference
+        ; TypeCtorRep = tcr_stable_c_pointer
+        ; TypeCtorRep = tcr_stable_foreign
+        ; TypeCtorRep = tcr_pseudo_type_desc
+        ; TypeCtorRep = tcr_dummy
+        ; TypeCtorRep = tcr_bitmap
+        ; TypeCtorRep = tcr_foreign_enum
+        ; TypeCtorRep = tcr_foreign_enum_usereq
+        ),
+        MaybeArgument = no
+    ;
+        TypeCtorRep = tcr_void,
+        error("rtti_implementation.m: cannot deconstruct void types")
+    ;
+        TypeCtorRep = tcr_unknown,
+        error("rtti_implementation: unknown type_ctor rep in deconstruct")
+    ).
+
 :- pred det_dynamic_cast(T::in, U::out) is det.
 
 det_dynamic_cast(Term, Actual) :-
@@ -2159,9 +2278,10 @@ expand_type_name(TypeCtorInfo, Wrap) = Name :-
 
     % Retrieve an argument number from a term, given the functor descriptor.
     %
-:- some [T] func get_arg(U, int, sectag_locn, du_functor_desc, type_info) = T.
+:- some [T] pred get_arg(U::in, sectag_locn::in, du_functor_desc::in,
+    type_info::in, int::in, T::out) is det.
 
-get_arg(Term, Index, SecTagLocn, FunctorDesc, TypeInfo) = Arg :-
+get_arg(Term, SecTagLocn, FunctorDesc, TypeInfo, Index, Arg) :-
     ( get_du_functor_exist_info(FunctorDesc, ExistInfo) ->
         ExtraArgs = exist_info_typeinfos_plain(ExistInfo) +
             exist_info_tcis(ExistInfo)
@@ -2181,6 +2301,12 @@ get_arg(Term, Index, SecTagLocn, FunctorDesc, TypeInfo) = Arg :-
     RealArgsOffset = TagOffset + ExtraArgs,
     Arg = get_subterm(FunctorDesc, ArgTypeInfo, Term, Index, RealArgsOffset).
 
+:- func get_arg_univ(U, sectag_locn, du_functor_desc, type_info, int) = univ.
+
+get_arg_univ(Term, SecTagLocn, FunctorDesc, TypeInfo, Index) = Univ :-
+    get_arg(Term, SecTagLocn, FunctorDesc, TypeInfo, Index, Arg),
+    type_to_univ(Arg, Univ).
+
 :- pred high_level_data is semidet.
 :- pragma promise_pure(high_level_data/0).
 :- pragma foreign_proc("Java",
@@ -3551,6 +3677,15 @@ get_du_functor_arg_names(DuFunctorDesc, ArgNames) :-
     ArgNames = DuFunctorDesc ^ unsafe_index(8),
     not null(ArgNames).
 
+:- pragma foreign_proc("Java",
+    get_du_functor_arg_names(DuFunctorDesc::in, ArgNames::out),
+    [will_not_call_mercury, promise_pure, thread_safe],
+"
+    ArgNames = DuFunctorDesc.du_functor_arg_names;
+
+    SUCCESS_INDICATOR = (ArgNames != null);
+").
+
 :- func arg_names_index(arg_names, int) = string.
 
 :- pragma foreign_proc("Java",
@@ -3563,14 +3698,16 @@ get_du_functor_arg_names(DuFunctorDesc, ArgNames) :-
 arg_names_index(_, _) = _ :-
     private_builtin.sorry("arg_names_index/2").
 
-:- pragma foreign_proc("Java",
-    get_du_functor_arg_names(DuFunctorDesc::in, ArgNames::out),
-    [will_not_call_mercury, promise_pure, thread_safe],
-"
-    ArgNames = DuFunctorDesc.du_functor_arg_names;
+:- pred search_arg_names(arg_names::in, int::in, int::in, string::in, int::out)
+    is semidet.
 
-    SUCCESS_INDICATOR = (ArgNames != null);
-").
+search_arg_names(ArgNames, I, Arity, Name, Index) :-
+    I < Arity,
+    ( arg_names_index(ArgNames, I) = Name ->
+        Index = I
+    ;
+        search_arg_names(ArgNames, I + 1, Arity, Name, Index)
+    ).
 
 :- pred get_du_functor_exist_info(du_functor_desc::in, exist_info::out)
     is semidet.
diff --git a/tests/hard_coded/deconstruct_arg.exp b/tests/hard_coded/deconstruct_arg.exp
index f20511e..afaea87 100644
--- a/tests/hard_coded/deconstruct_arg.exp
+++ b/tests/hard_coded/deconstruct_arg.exp
@@ -2,6 +2,8 @@ deconstruct functor: apple/1
 deconstruct argument 0 of apple([]) is []
 deconstruct argument 1 of apple([]) doesn't exist
 deconstruct argument 2 of apple([]) doesn't exist
+deconstruct argument 'moo' doesn't exist
+deconstruct argument 'mooo!' doesn't exist
 deconstruct deconstruct: functor apple arity 1
 [[]]
 deconstruct limited deconstruct 3 of apple([])
@@ -11,6 +13,8 @@ deconstruct functor: apple/1
 deconstruct argument 0 of apple([9, 5, 1]) is [9, 5, 1]
 deconstruct argument 1 of apple([9, 5, 1]) doesn't exist
 deconstruct argument 2 of apple([9, 5, 1]) doesn't exist
+deconstruct argument 'moo' doesn't exist
+deconstruct argument 'mooo!' doesn't exist
 deconstruct deconstruct: functor apple arity 1
 [[9, 5, 1]]
 deconstruct limited deconstruct 3 of apple([9, 5, 1])
@@ -20,6 +24,8 @@ deconstruct functor: zop/2
 deconstruct argument 0 of zop(3.3, 2.03) is 3.3
 deconstruct argument 1 of zop(3.3, 2.03) is 2.03
 deconstruct argument 2 of zop(3.3, 2.03) doesn't exist
+deconstruct argument 'moo' doesn't exist
+deconstruct argument 'mooo!' doesn't exist
 deconstruct deconstruct: functor zop arity 2
 [3.3, 2.03]
 deconstruct limited deconstruct 3 of zop(3.3, 2.03)
@@ -29,6 +35,8 @@ deconstruct functor: zap/3
 deconstruct argument 0 of zap(50, 51.0, 52) is 50
 deconstruct argument 1 of zap(50, 51.0, 52) is 51.0
 deconstruct argument 2 of zap(50, 51.0, 52) is 52
+deconstruct argument 'moo' doesn't exist
+deconstruct argument 'mooo!' doesn't exist
 deconstruct deconstruct: functor zap arity 3
 [50, 51.0, 52]
 deconstruct limited deconstruct 3 of zap(50, 51.0, 52)
@@ -38,6 +46,8 @@ deconstruct functor: zip/4
 deconstruct argument 0 of zip(50, 51, 52, 53) is 50
 deconstruct argument 1 of zip(50, 51, 52, 53) is 51
 deconstruct argument 2 of zip(50, 51, 52, 53) is 52
+deconstruct argument 'moo' doesn't exist
+deconstruct argument 'mooo!' doesn't exist
 deconstruct deconstruct: functor zip arity 4
 [50, 51, 52, 53]
 deconstruct limited deconstruct 3 of zip(50, 51, 52, 53)
@@ -47,6 +57,8 @@ deconstruct functor: wombat/0
 deconstruct argument 0 of wombat doesn't exist
 deconstruct argument 1 of wombat doesn't exist
 deconstruct argument 2 of wombat doesn't exist
+deconstruct argument 'moo' doesn't exist
+deconstruct argument 'mooo!' doesn't exist
 deconstruct deconstruct: functor wombat arity 0
 []
 deconstruct limited deconstruct 3 of wombat
@@ -56,15 +68,30 @@ deconstruct functor: qwerty/1
 deconstruct argument 0 of qwerty(5) is 5
 deconstruct argument 1 of qwerty(5) doesn't exist
 deconstruct argument 2 of qwerty(5) doesn't exist
+deconstruct argument 'moo' doesn't exist
+deconstruct argument 'mooo!' doesn't exist
 deconstruct deconstruct: functor qwerty arity 1
 [5]
 deconstruct limited deconstruct 3 of qwerty(5)
 functor qwerty arity 1 [5]
 
+deconstruct functor: moomoo/2
+deconstruct argument 0 of moomoo(50, "moo.") is 50
+deconstruct argument 1 of moomoo(50, "moo.") is "moo."
+deconstruct argument 2 of moomoo(50, "moo.") doesn't exist
+deconstruct argument 'moo' is 50
+deconstruct argument 'mooo!' is "moo."
+deconstruct deconstruct: functor moomoo arity 2
+[50, "moo."]
+deconstruct limited deconstruct 3 of moomoo(50, "moo.")
+functor moomoo arity 2 [50, "moo."]
+
 deconstruct functor: 'a'/0
 deconstruct argument 0 of a doesn't exist
 deconstruct argument 1 of a doesn't exist
 deconstruct argument 2 of a doesn't exist
+deconstruct argument 'moo' doesn't exist
+deconstruct argument 'mooo!' doesn't exist
 deconstruct deconstruct: functor 'a' arity 0
 []
 deconstruct limited deconstruct 3 of a
@@ -74,6 +101,8 @@ deconstruct functor: 0.12345678901234566/0
 deconstruct argument 0 of 0.12345678901234566 doesn't exist
 deconstruct argument 1 of 0.12345678901234566 doesn't exist
 deconstruct argument 2 of 0.12345678901234566 doesn't exist
+deconstruct argument 'moo' doesn't exist
+deconstruct argument 'mooo!' doesn't exist
 deconstruct deconstruct: functor 0.12345678901234566 arity 0
 []
 deconstruct limited deconstruct 3 of 0.12345678901234566
@@ -83,6 +112,8 @@ deconstruct functor: 4/0
 deconstruct argument 0 of 4 doesn't exist
 deconstruct argument 1 of 4 doesn't exist
 deconstruct argument 2 of 4 doesn't exist
+deconstruct argument 'moo' doesn't exist
+deconstruct argument 'mooo!' doesn't exist
 deconstruct deconstruct: functor 4 arity 0
 []
 deconstruct limited deconstruct 3 of 4
@@ -92,6 +123,8 @@ deconstruct functor: univ_cons/1
 deconstruct argument 0 of ["hi! I\'m a univ!"] is ["hi! I\'m a univ!"]
 deconstruct argument 1 of ["hi! I\'m a univ!"] doesn't exist
 deconstruct argument 2 of ["hi! I\'m a univ!"] doesn't exist
+deconstruct argument 'moo' doesn't exist
+deconstruct argument 'mooo!' doesn't exist
 deconstruct deconstruct: functor univ_cons arity 1
 [["hi! I\'m a univ!"]]
 deconstruct limited deconstruct 3 of ["hi! I\'m a univ!"]
@@ -101,6 +134,8 @@ deconstruct functor: set_rep/1
 deconstruct argument 0 of '<<deconstruct_arg.set/1>>' is [1, 2, 3, 3]
 deconstruct argument 1 of '<<deconstruct_arg.set/1>>' doesn't exist
 deconstruct argument 2 of '<<deconstruct_arg.set/1>>' doesn't exist
+deconstruct argument 'moo' doesn't exist
+deconstruct argument 'mooo!' doesn't exist
 deconstruct deconstruct: functor set_rep arity 1
 [[1, 2, 3, 3]]
 deconstruct limited deconstruct 3 of '<<deconstruct_arg.set/1>>'
@@ -110,24 +145,30 @@ deconstruct functor: newline/0
 deconstruct argument 0 of '<<predicate>>' doesn't exist
 deconstruct argument 1 of '<<predicate>>' doesn't exist
 deconstruct argument 2 of '<<predicate>>' doesn't exist
+deconstruct argument 'moo' doesn't exist
+deconstruct argument 'mooo!' doesn't exist
 deconstruct deconstruct: functor newline arity 0
 []
 deconstruct limited deconstruct 3 of '<<predicate>>'
 functor newline arity 0 []
 
-deconstruct functor: lambda_deconstruct_arg_m_108/1
+deconstruct functor: lambda_deconstruct_arg_m_114/1
 deconstruct argument 0 of '<<predicate>>' is [1, 2]
 deconstruct argument 1 of '<<predicate>>' doesn't exist
 deconstruct argument 2 of '<<predicate>>' doesn't exist
-deconstruct deconstruct: functor lambda_deconstruct_arg_m_108 arity 1
+deconstruct argument 'moo' doesn't exist
+deconstruct argument 'mooo!' doesn't exist
+deconstruct deconstruct: functor lambda_deconstruct_arg_m_114 arity 1
 [[1, 2]]
 deconstruct limited deconstruct 3 of '<<predicate>>'
-functor lambda_deconstruct_arg_m_108 arity 1 [[1, 2]]
+functor lambda_deconstruct_arg_m_114 arity 1 [[1, 2]]
 
 deconstruct functor: {}/2
 deconstruct argument 0 of {1, 'b'} is 1
 deconstruct argument 1 of {1, 'b'} is 'b'
 deconstruct argument 2 of {1, 'b'} doesn't exist
+deconstruct argument 'moo' doesn't exist
+deconstruct argument 'mooo!' doesn't exist
 deconstruct deconstruct: functor {} arity 2
 [1, 'b']
 deconstruct limited deconstruct 3 of {1, 'b'}
@@ -137,6 +178,8 @@ deconstruct functor: {}/3
 deconstruct argument 0 of {1, 'b', "third"} is 1
 deconstruct argument 1 of {1, 'b', "third"} is 'b'
 deconstruct argument 2 of {1, 'b', "third"} is "third"
+deconstruct argument 'moo' doesn't exist
+deconstruct argument 'mooo!' doesn't exist
 deconstruct deconstruct: functor {} arity 3
 [1, 'b', "third"]
 deconstruct limited deconstruct 3 of {1, 'b', "third"}
@@ -146,6 +189,8 @@ deconstruct functor: {}/4
 deconstruct argument 0 of {1, 'b', "third", {1, 2, 3, 4}} is 1
 deconstruct argument 1 of {1, 'b', "third", {1, 2, 3, 4}} is 'b'
 deconstruct argument 2 of {1, 'b', "third", {1, 2, 3, 4}} is "third"
+deconstruct argument 'moo' doesn't exist
+deconstruct argument 'mooo!' doesn't exist
 deconstruct deconstruct: functor {} arity 4
 [1, 'b', "third", {1, 2, 3, 4}]
 deconstruct limited deconstruct 3 of {1, 'b', "third", {1, 2, 3, 4}}
@@ -155,6 +200,8 @@ deconstruct functor: <<array>>/2
 deconstruct argument 0 of array([1000, 2000]) is 1000
 deconstruct argument 1 of array([1000, 2000]) is 2000
 deconstruct argument 2 of array([1000, 2000]) doesn't exist
+deconstruct argument 'moo' doesn't exist
+deconstruct argument 'mooo!' doesn't exist
 deconstruct deconstruct: functor <<array>> arity 2
 [1000, 2000]
 deconstruct limited deconstruct 3 of array([1000, 2000])
@@ -164,6 +211,8 @@ deconstruct functor: <<array>>/3
 deconstruct argument 0 of array([100, 200, 300]) is 100
 deconstruct argument 1 of array([100, 200, 300]) is 200
 deconstruct argument 2 of array([100, 200, 300]) is 300
+deconstruct argument 'moo' doesn't exist
+deconstruct argument 'mooo!' doesn't exist
 deconstruct deconstruct: functor <<array>> arity 3
 [100, 200, 300]
 deconstruct limited deconstruct 3 of array([100, 200, 300])
@@ -173,6 +222,8 @@ deconstruct functor: <<array>>/4
 deconstruct argument 0 of array([10, 20, 30, 40]) is 10
 deconstruct argument 1 of array([10, 20, 30, 40]) is 20
 deconstruct argument 2 of array([10, 20, 30, 40]) is 30
+deconstruct argument 'moo' doesn't exist
+deconstruct argument 'mooo!' doesn't exist
 deconstruct deconstruct: functor <<array>> arity 4
 [10, 20, 30, 40]
 deconstruct limited deconstruct 3 of array([10, 20, 30, 40])
diff --git a/tests/hard_coded/deconstruct_arg.exp2 b/tests/hard_coded/deconstruct_arg.exp2
index fc76956..a925d24 100644
--- a/tests/hard_coded/deconstruct_arg.exp2
+++ b/tests/hard_coded/deconstruct_arg.exp2
@@ -2,6 +2,8 @@ deconstruct functor: apple/1
 deconstruct argument 0 of apple([]) is []
 deconstruct argument 1 of apple([]) doesn't exist
 deconstruct argument 2 of apple([]) doesn't exist
+deconstruct argument 'moo' doesn't exist
+deconstruct argument 'mooo!' doesn't exist
 deconstruct deconstruct: functor apple arity 1
 [[]]
 deconstruct limited deconstruct 3 of apple([])
@@ -11,6 +13,8 @@ deconstruct functor: apple/1
 deconstruct argument 0 of apple([9, 5, 1]) is [9, 5, 1]
 deconstruct argument 1 of apple([9, 5, 1]) doesn't exist
 deconstruct argument 2 of apple([9, 5, 1]) doesn't exist
+deconstruct argument 'moo' doesn't exist
+deconstruct argument 'mooo!' doesn't exist
 deconstruct deconstruct: functor apple arity 1
 [[9, 5, 1]]
 deconstruct limited deconstruct 3 of apple([9, 5, 1])
@@ -20,6 +24,8 @@ deconstruct functor: zop/2
 deconstruct argument 0 of zop(3.3, 2.03) is 3.3
 deconstruct argument 1 of zop(3.3, 2.03) is 2.03
 deconstruct argument 2 of zop(3.3, 2.03) doesn't exist
+deconstruct argument 'moo' doesn't exist
+deconstruct argument 'mooo!' doesn't exist
 deconstruct deconstruct: functor zop arity 2
 [3.3, 2.03]
 deconstruct limited deconstruct 3 of zop(3.3, 2.03)
@@ -29,6 +35,8 @@ deconstruct functor: zap/3
 deconstruct argument 0 of zap(50, 51.0, 52) is 50
 deconstruct argument 1 of zap(50, 51.0, 52) is 51.0
 deconstruct argument 2 of zap(50, 51.0, 52) is 52
+deconstruct argument 'moo' doesn't exist
+deconstruct argument 'mooo!' doesn't exist
 deconstruct deconstruct: functor zap arity 3
 [50, 51.0, 52]
 deconstruct limited deconstruct 3 of zap(50, 51.0, 52)
@@ -38,6 +46,8 @@ deconstruct functor: zip/4
 deconstruct argument 0 of zip(50, 51, 52, 53) is 50
 deconstruct argument 1 of zip(50, 51, 52, 53) is 51
 deconstruct argument 2 of zip(50, 51, 52, 53) is 52
+deconstruct argument 'moo' doesn't exist
+deconstruct argument 'mooo!' doesn't exist
 deconstruct deconstruct: functor zip arity 4
 [50, 51, 52, 53]
 deconstruct limited deconstruct 3 of zip(50, 51, 52, 53)
@@ -47,6 +57,8 @@ deconstruct functor: wombat/0
 deconstruct argument 0 of wombat doesn't exist
 deconstruct argument 1 of wombat doesn't exist
 deconstruct argument 2 of wombat doesn't exist
+deconstruct argument 'moo' doesn't exist
+deconstruct argument 'mooo!' doesn't exist
 deconstruct deconstruct: functor wombat arity 0
 []
 deconstruct limited deconstruct 3 of wombat
@@ -56,15 +68,30 @@ deconstruct functor: qwerty/1
 deconstruct argument 0 of qwerty(5) is 5
 deconstruct argument 1 of qwerty(5) doesn't exist
 deconstruct argument 2 of qwerty(5) doesn't exist
+deconstruct argument 'moo' doesn't exist
+deconstruct argument 'mooo!' doesn't exist
 deconstruct deconstruct: functor qwerty arity 1
 [5]
 deconstruct limited deconstruct 3 of qwerty(5)
 functor qwerty arity 1 [5]
 
+deconstruct functor: moomoo/2
+deconstruct argument 0 of moomoo(50, "moo.") is 50
+deconstruct argument 1 of moomoo(50, "moo.") is "moo."
+deconstruct argument 2 of moomoo(50, "moo.") doesn't exist
+deconstruct argument 'moo' is 50
+deconstruct argument 'mooo!' is "moo."
+deconstruct deconstruct: functor moomoo arity 2
+[50, "moo."]
+deconstruct limited deconstruct 3 of moomoo(50, "moo.")
+functor moomoo arity 2 [50, "moo."]
+
 deconstruct functor: 'a'/0
 deconstruct argument 0 of a doesn't exist
 deconstruct argument 1 of a doesn't exist
 deconstruct argument 2 of a doesn't exist
+deconstruct argument 'moo' doesn't exist
+deconstruct argument 'mooo!' doesn't exist
 deconstruct deconstruct: functor 'a' arity 0
 []
 deconstruct limited deconstruct 3 of a
@@ -74,6 +101,8 @@ deconstruct functor: 0.12345678901234566/0
 deconstruct argument 0 of 0.12345678901234566 doesn't exist
 deconstruct argument 1 of 0.12345678901234566 doesn't exist
 deconstruct argument 2 of 0.12345678901234566 doesn't exist
+deconstruct argument 'moo' doesn't exist
+deconstruct argument 'mooo!' doesn't exist
 deconstruct deconstruct: functor 0.12345678901234566 arity 0
 []
 deconstruct limited deconstruct 3 of 0.12345678901234566
@@ -83,6 +112,8 @@ deconstruct functor: 4/0
 deconstruct argument 0 of 4 doesn't exist
 deconstruct argument 1 of 4 doesn't exist
 deconstruct argument 2 of 4 doesn't exist
+deconstruct argument 'moo' doesn't exist
+deconstruct argument 'mooo!' doesn't exist
 deconstruct deconstruct: functor 4 arity 0
 []
 deconstruct limited deconstruct 3 of 4
@@ -92,6 +123,8 @@ deconstruct functor: univ_cons/1
 deconstruct argument 0 of ["hi! I\'m a univ!"] is ["hi! I\'m a univ!"]
 deconstruct argument 1 of ["hi! I\'m a univ!"] doesn't exist
 deconstruct argument 2 of ["hi! I\'m a univ!"] doesn't exist
+deconstruct argument 'moo' doesn't exist
+deconstruct argument 'mooo!' doesn't exist
 deconstruct deconstruct: functor univ_cons arity 1
 [["hi! I\'m a univ!"]]
 deconstruct limited deconstruct 3 of ["hi! I\'m a univ!"]
@@ -101,6 +134,8 @@ deconstruct functor: set_rep/1
 deconstruct argument 0 of '<<deconstruct_arg.set/1>>' is [1, 2, 3, 3]
 deconstruct argument 1 of '<<deconstruct_arg.set/1>>' doesn't exist
 deconstruct argument 2 of '<<deconstruct_arg.set/1>>' doesn't exist
+deconstruct argument 'moo' doesn't exist
+deconstruct argument 'mooo!' doesn't exist
 deconstruct deconstruct: functor set_rep arity 1
 [[1, 2, 3, 3]]
 deconstruct limited deconstruct 3 of '<<deconstruct_arg.set/1>>'
@@ -110,6 +145,8 @@ deconstruct functor: <<predicate>>/0
 deconstruct argument 0 of '<<predicate>>' doesn't exist
 deconstruct argument 1 of '<<predicate>>' doesn't exist
 deconstruct argument 2 of '<<predicate>>' doesn't exist
+deconstruct argument 'moo' doesn't exist
+deconstruct argument 'mooo!' doesn't exist
 deconstruct deconstruct: functor <<predicate>> arity 0
 []
 deconstruct limited deconstruct 3 of '<<predicate>>'
@@ -119,6 +156,8 @@ deconstruct functor: <<predicate>>/0
 deconstruct argument 0 of '<<predicate>>' doesn't exist
 deconstruct argument 1 of '<<predicate>>' doesn't exist
 deconstruct argument 2 of '<<predicate>>' doesn't exist
+deconstruct argument 'moo' doesn't exist
+deconstruct argument 'mooo!' doesn't exist
 deconstruct deconstruct: functor <<predicate>> arity 0
 []
 deconstruct limited deconstruct 3 of '<<predicate>>'
@@ -128,6 +167,8 @@ deconstruct functor: {}/2
 deconstruct argument 0 of {1, 'b'} is 1
 deconstruct argument 1 of {1, 'b'} is 'b'
 deconstruct argument 2 of {1, 'b'} doesn't exist
+deconstruct argument 'moo' doesn't exist
+deconstruct argument 'mooo!' doesn't exist
 deconstruct deconstruct: functor {} arity 2
 [1, 'b']
 deconstruct limited deconstruct 3 of {1, 'b'}
@@ -137,6 +178,8 @@ deconstruct functor: {}/3
 deconstruct argument 0 of {1, 'b', "third"} is 1
 deconstruct argument 1 of {1, 'b', "third"} is 'b'
 deconstruct argument 2 of {1, 'b', "third"} is "third"
+deconstruct argument 'moo' doesn't exist
+deconstruct argument 'mooo!' doesn't exist
 deconstruct deconstruct: functor {} arity 3
 [1, 'b', "third"]
 deconstruct limited deconstruct 3 of {1, 'b', "third"}
@@ -146,6 +189,8 @@ deconstruct functor: {}/4
 deconstruct argument 0 of {1, 'b', "third", {1, 2, 3, 4}} is 1
 deconstruct argument 1 of {1, 'b', "third", {1, 2, 3, 4}} is 'b'
 deconstruct argument 2 of {1, 'b', "third", {1, 2, 3, 4}} is "third"
+deconstruct argument 'moo' doesn't exist
+deconstruct argument 'mooo!' doesn't exist
 deconstruct deconstruct: functor {} arity 4
 [1, 'b', "third", {1, 2, 3, 4}]
 deconstruct limited deconstruct 3 of {1, 'b', "third", {1, 2, 3, 4}}
@@ -155,6 +200,8 @@ deconstruct functor: <<array>>/2
 deconstruct argument 0 of array([1000, 2000]) is 1000
 deconstruct argument 1 of array([1000, 2000]) is 2000
 deconstruct argument 2 of array([1000, 2000]) doesn't exist
+deconstruct argument 'moo' doesn't exist
+deconstruct argument 'mooo!' doesn't exist
 deconstruct deconstruct: functor <<array>> arity 2
 [1000, 2000]
 deconstruct limited deconstruct 3 of array([1000, 2000])
@@ -164,6 +211,8 @@ deconstruct functor: <<array>>/3
 deconstruct argument 0 of array([100, 200, 300]) is 100
 deconstruct argument 1 of array([100, 200, 300]) is 200
 deconstruct argument 2 of array([100, 200, 300]) is 300
+deconstruct argument 'moo' doesn't exist
+deconstruct argument 'mooo!' doesn't exist
 deconstruct deconstruct: functor <<array>> arity 3
 [100, 200, 300]
 deconstruct limited deconstruct 3 of array([100, 200, 300])
@@ -173,6 +222,8 @@ deconstruct functor: <<array>>/4
 deconstruct argument 0 of array([10, 20, 30, 40]) is 10
 deconstruct argument 1 of array([10, 20, 30, 40]) is 20
 deconstruct argument 2 of array([10, 20, 30, 40]) is 30
+deconstruct argument 'moo' doesn't exist
+deconstruct argument 'mooo!' doesn't exist
 deconstruct deconstruct: functor <<array>> arity 4
 [10, 20, 30, 40]
 deconstruct limited deconstruct 3 of array([10, 20, 30, 40])
diff --git a/tests/hard_coded/deconstruct_arg.m b/tests/hard_coded/deconstruct_arg.m
index 48f7816..7977528 100644
--- a/tests/hard_coded/deconstruct_arg.m
+++ b/tests/hard_coded/deconstruct_arg.m
@@ -41,7 +41,11 @@
 	;	zoom(int) 
 	;	zap(int, float, int) 
 	;	zip(int, int, int, int) 
-	;	zop(float, float).
+	;	zop(float, float)
+	;	moomoo(
+			moo	:: int,
+			'mooo!'	:: string
+		).
 
 :- type poly(A, B)
 	--->	poly_one(A)
@@ -92,6 +96,8 @@ main -->
 	test_all(wombat), newline,
 		% test notag
 	test_all(qwerty(5)), newline,
+		% test named arguments
+	test_all(moomoo(50, "moo.")), newline,
 		% test characters
 	test_all('a'), newline,
 		% test a float which requires 17 digits of precision
@@ -124,6 +130,8 @@ test_all(T) -->
 	test_deconstruct_arg(T, 0),
 	test_deconstruct_arg(T, 1),
 	test_deconstruct_arg(T, 2),
+	test_deconstruct_named_arg(T, "moo"),
+	test_deconstruct_named_arg(T, "mooo!"),
 	test_deconstruct_deconstruct(T),
 	test_deconstruct_limited_deconstruct(T, 3).
 
@@ -158,6 +166,22 @@ test_deconstruct_arg(T, ArgNum) -->
 		io.write_string(" doesn't exist\n")
 	).
 
+:- pred test_deconstruct_named_arg(T::in, string::in, io::di, io::uo)
+	is cc_multi.
+
+test_deconstruct_named_arg(T, Name, !IO) :-
+	io.format("deconstruct argument '%s'", [s(Name)], !IO),
+	deconstruct.named_arg_cc(T, Name, MaybeArg),
+	(
+		MaybeArg = arg(Arg),
+		io.write_string(" is ", !IO),
+		io.write(Arg, !IO),
+		io.nl(!IO)
+	;
+		MaybeArg = no_arg,
+		io.write_string(" doesn't exist\n", !IO)
+	).
+
 :- pred test_deconstruct_deconstruct(T::in, io.state::di, io.state::uo)
 	is cc_multi.
 

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