[m-rev.] for review: std_util__arg_name

[Michael Day]

Estimated hours taken: 1
Branches: main

Adding std_util__arg_name for retrieving the field name (if any) of a
functor argument.

(I haven't been able to actually compile this as I haven't been able to
install a recent enough version of the compiler, so anyone who feels like
looking at it please look carefully... sorry)

Michael


Index: library/std_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/std_util.m,v
retrieving revision 1.240
diff -u -r1.240 std_util.m
--- library/std_util.m	2001/08/24 09:31:25	1.240
+++ library/std_util.m	2001/09/24 01:50:45
@@ -581,6 +581,20 @@
 :- func det_arg(T::in, int::in) = (ArgT::out) is det.
 :- func det_argument(T::in, int::in) = (univ::out) is det.

+	% arg_name(Data, ArgumentIndex) = MaybeFieldName
+	%
+	% Given a data item (Data) and an argument index
+	% (ArgumentIndex), starting at 0 for the first argument, binds
+	% MaybeFieldName to yes(FieldName) if that argument of the functor
+	% of the data item has a field name, or no otherwise. If
+	% the argument index is out of range -- that is, greater than or
+	% equal to the arity of the functor or lower than 0 -- then
+	% the call fails. (arg_name aborts if the type of Data is a type with
+	% a non-canonical representation, i.e. one for which there is a
+	% user-defined equality predicate.)
+	%
+:- func arg_name(T::in, int::in) = (maybe(string)::out) is semidet.
+
 	% deconstruct(Data, Functor, Arity, Arguments)
 	%
 	% Given a data item (Data), binds Functor to a string
@@ -2933,6 +2947,7 @@
     bool                    chosen_index_exists;
     MR_Word                 *chosen_value_ptr;
     MR_TypeInfo             chosen_type_info;
+    MR_String               chosen_arg_name;
 } ML_Expand_Chosen_Arg_Only_Info;

     /* Prototypes */
@@ -2965,6 +2980,9 @@
 extern  bool    ML_arg(MR_TypeInfo type_info, MR_Word *term, int arg_index,
                     MR_TypeInfo *arg_type_info_ptr, MR_Word **argument_ptr);

+extern  bool    ML_arg_name(MR_TypeInfo type_info, MR_Word *term, int arg_index,
+                    MR_String *arg_name);
+
     /*
     ** NB. ML_named_arg_num() is used in mercury_trace_vars.c.
     */
@@ -3117,6 +3135,35 @@
 }

 /*
+** ML_arg_name() is a subroutine used to implement arg_name/2.
+** It takes the address of a term, its type, and an argument index.
+** If the selected argument exists, it succeeds and returns the field name
+** of the argument (or NULL if it doesn't have one); if it doesn't, it fails
+** (i.e. returns FALSE).
+**
+** You need to wrap MR_{save/restore}_transient_hp() around
+** calls to this function.
+*/
+
+bool
+ML_arg_name(MR_TypeInfo type_info, MR_Word *term_ptr, int arg_index,
+    MR_String *arg_name)
+{
+    ML_Expand_Chosen_Arg_Only_Info	expand_info;
+
+    ML_expand_chosen_arg_only(type_info, term_ptr, arg_index, &expand_info);
+    ML_abort_if_type_is_noncanonical(expand_info, ""argument/2"");
+
+        /* Check range */
+    if (expand_info.chosen_index_exists) {
+        *arg_name = expand_info.chosen_arg_name;
+		return TRUE;
+    }
+
+    return FALSE;
+}
+
+/*
 ** ML_named_arg_num() takes the address of a term, its type, and an argument
 ** name. If the given term has an argument with the given name, it succeeds and
 ** returns the argument number (counted starting from 0) of the argument;
@@ -3277,6 +3324,31 @@
         if (success) {
             Argument = *argument_ptr;
         }
+    }
+
+    MR_restore_transient_registers();
+    SUCCESS_INDICATOR = success;
+}").
+
+arg_name(T, ArgIndex) =
+    ( if Res = 0 then no else yes(Name) ) :- arg_name0(T, ArgIndex, Name, Res).
+
+:- pred arg_name0(T, int, string, int).
+:- mode arg_name0(in, in, out, out) is semidet.
+
+:- pragma foreign_proc("C",
+	arg_name0(Term::in, ArgIndex::in, Name::out, Res::out),
+        will_not_call_mercury, "
+{
+    MR_String   argument_name;
+    bool        success;
+
+    MR_save_transient_registers();
+    success = ML_arg_name(type_info, &Term, ArgumentIndex, argument_name);
+
+    if (success) {
+	Name = argument_name;
+	Res = (Name != NULL);
     }

     MR_restore_transient_registers();

Index: runtime/mercury_ml_expand_body.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_ml_expand_body.h,v
retrieving revision 1.2
diff -u -r1.2 mercury_ml_expand_body.h
--- runtime/mercury_ml_expand_body.h	2001/07/12 01:30:30	1.2
+++ runtime/mercury_ml_expand_body.h	2001/09/24 01:50:46
@@ -310,6 +310,12 @@
                             MR_pseudo_type_info_is_ground(
                                 functor_desc->MR_du_functor_arg_types[chosen]);
                     }
+		    if (functor_desc->MR_du_functor_arg_names != NULL) {
+			expand_info->chosen_arg_name =
+			    functor_desc->MR_du_functor_arg_names[chosen];
+		    } else {
+			expand_info->chosen_arg_name = NULL;
+		    }
                 } else {
                     expand_info->chosen_index_exists = FALSE;
                 }

--------------------------------------------------------------------------
mercury-reviews mailing list
post:  mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe:   Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------