[m-rev.] for review: std_util__arg_name
Fergus Henderson
fjh at cs.mu.OZ.AU
Thu Sep 27 21:01:27 AEST 2001
On 27-Sep-2001, Michael Day <mikeday at bigpond.net.au> wrote:
>
> > > Adding std_util__arg_name for retrieving the field name (if any) of a
> > > functor argument.
>
> I realised that actually this isn't what I want, as it requires a term
> rather than just a type_desc. So I'm trying to write a variant of
> get_functor that returns a list(maybe(string)) in addition to a
> list(type_desc) for the functor arguments. I've managed to compile it, but
> I can't install the compiler and library as it fails with seemingly
> arbitrary link errors in the trace directory.
>
> Can anyone offer feedback while I try and rebuild everything from scratch
> again?
That diff looks good.
> Michael
>
> Index: std_util.m
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/library/std_util.m,v
> retrieving revision 1.242
> diff -u -r1.242 std_util.m
> --- std_util.m 2001/09/25 09:37:04 1.242
> +++ std_util.m 2001/09/27 08:18:23
> @@ -482,6 +482,17 @@
> :- pred get_functor(type_desc::in, int::in, string::out, int::out,
> list(type_desc)::out) is semidet.
>
> + % get_functor(Type, I, Functor, Arity, ArgTypes, ArgNames)
> + %
> + % Binds Functor and Arity to the name and arity of functor number I
> + % for the specified type, ArgTypes to the type_descs for the types
> + % of the arguments of that functor, and ArgNames to the field name
> + % of each functor argument, if any. Fails if the type is not a
> + % discriminated union type, or if I is out of range.
> + %
> +:- pred get_functor(type_desc::in, int::in, string::out, int::out,
> + list(type_desc)::out, list(maybe(string))::out) is semidet.
> +
> % get_functor_ordinal(Type, I, Ordinal)
> %
> % Returns Ordinal, where Ordinal is the position in declaration order
> @@ -1610,6 +1621,7 @@
> MR_ConstString functor_name;
> MR_Integer arity;
> const MR_PseudoTypeInfo *arg_pseudo_type_infos;
> + MR_ConstString *arg_names;
> MR_TypeCtorRep type_ctor_rep;
> union {
> const MR_EnumFunctorDesc *enum_functor_desc;
> @@ -1627,6 +1639,8 @@
> extern int ML_get_num_functors(MR_TypeInfo type_info);
> extern MR_Word ML_type_params_vector_to_list(int arity,
> MR_TypeInfoParams type_params);
> +extern MR_Word ML_arg_name_vector_to_list(int arity,
> + MR_ConstString *arg_names);
> extern MR_Word ML_pseudo_type_info_vector_to_type_info_list(int arity,
> MR_TypeInfoParams type_params,
> const MR_PseudoTypeInfo *arg_pseudo_type_infos);
> @@ -2076,6 +2090,81 @@
> }
> ").
>
> +get_functor(TypeDesc, I, Functor, Arity, TypeInfoList, ArgNameList) :-
> + get_functor_2(TypeDesc, I, Functor, Arity, TypeInfoList, ArgNameList0),
> + ArgNameList = map(null_to_no, ArgNameList0).
> +
> +:- func null_to_no(string) = maybe(string).
> +
> +null_to_no(S) = ( if null(S) then no else yes(S) ).
> +
> +:- pred null(string).
> +:- mode null(in) is semidet.
> +
> +:- pragma foreign_proc("C", null(S::in), will_not_call_mercury, "
> + SUCCESS_INDICATOR = (S == NULL);
> +").
> +
> +:- pred get_functor_2(type_desc::in, int::in, string::out, int::out,
> + list(type_desc)::out, list(string)::out) is semidet.
> +
> +:- pragma foreign_proc("C", get_functor_2(TypeDesc::in, FunctorNumber::in,
> + FunctorName::out, Arity::out, TypeInfoList::out, ArgNameList::out),
> + will_not_call_mercury, "
> +{
> + MR_TypeInfo type_info;
> + int arity;
> + ML_Construct_Info construct_info;
> + bool success;
> +
> + type_info = (MR_TypeInfo) TypeDesc;
> +
> + /*
> + ** Get information for this functor number and
> + ** store in construct_info. If this is a discriminated union
> + ** type and if the functor number is in range, we
> + ** succeed.
> + */
> + MR_save_transient_registers();
> + success = ML_get_functors_check_range(FunctorNumber,
> + type_info, &construct_info);
> + MR_restore_transient_registers();
> +
> + /*
> + ** Get the functor name and arity, construct the list
> + ** of type_infos for arguments.
> + */
> +
> + if (success) {
> + MR_make_aligned_string(FunctorName, (MR_String) (MR_Word)
> + construct_info.functor_name);
> + arity = construct_info.arity;
> + Arity = arity;
> +
> + if (MR_TYPE_CTOR_INFO_IS_TUPLE(
> + MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info)))
> + {
> + MR_save_transient_registers();
> + TypeInfoList = ML_type_params_vector_to_list(Arity,
> + MR_TYPEINFO_GET_TUPLE_ARG_VECTOR(type_info));
> + ArgNameList = MR_list_empty();
> + MR_restore_transient_registers();
> + } else {
> + MR_save_transient_registers();
> + TypeInfoList = ML_pseudo_type_info_vector_to_type_info_list(
> + arity,
> + MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info),
> + construct_info.arg_pseudo_type_infos);
> + ArgNameList = ML_arg_name_vector_to_list(
> + arity,
> + construct_info.arg_names);
> + MR_restore_transient_registers();
> + }
> + }
> + SUCCESS_INDICATOR = success;
> +}
> +").
> +
> :- pragma foreign_proc("C",
> get_functor_ordinal(TypeDesc::in, FunctorNumber::in,
> Ordinal::out), will_not_call_mercury, "
> @@ -2460,6 +2549,8 @@
> construct_info->arity = functor_desc->MR_du_functor_orig_arity;
> construct_info->arg_pseudo_type_infos =
> functor_desc->MR_du_functor_arg_types;
> + construct_info->arg_names =
> + functor_desc->MR_du_functor_arg_names;
> }
> break;
>
> @@ -2481,6 +2572,7 @@
> construct_info->functor_name = functor_desc->MR_enum_functor_name;
> construct_info->arity = 0;
> construct_info->arg_pseudo_type_infos = NULL;
> + construct_info->arg_names = NULL;
> }
> break;
>
> @@ -2502,6 +2594,8 @@
> construct_info->arity = 1;
> construct_info->arg_pseudo_type_infos =
> &functor_desc->MR_notag_functor_arg_type;
> + construct_info->arg_names =
> + &functor_desc->MR_notag_functor_arg_name;
> }
> break;
>
> @@ -2527,6 +2621,7 @@
>
> /* Tuple types don't have pseudo-type_infos for the functors. */
> construct_info->arg_pseudo_type_infos = NULL;
> + construct_info->arg_names = NULL;
> break;
>
> case MR_TYPECTOR_REP_INT:
> @@ -2750,6 +2845,35 @@
> MR_save_transient_registers();
>
> return type_info_list;
> +}
> +
> + /*
> + ** ML_arg_name_vector_to_list:
> + **
> + ** Copy `arity' argument names from the `arg_names' vector, which starts
> + ** at index 0, onto the Mercury heap in a list.
> + **
> + ** You need to save and restore transient registers around
> + ** calls to this function.
> + */
> +
> +MR_Word
> +ML_arg_name_vector_to_list(int arity, MR_ConstString *arg_names)
> +{
> + MR_TypeInfo arg_type;
> + MR_Word arg_names_list;
> +
> + MR_restore_transient_registers();
> + arg_names_list = MR_list_empty();
> +
> + while (arity > 0) {
> + --arity;
> + arg_names_list = MR_list_cons((MR_Word) arg_names[arity],
> + arg_names_list);
> + }
> + MR_save_transient_registers();
> +
> + return arg_names_list;
> }
>
> /*
>
> --------------------------------------------------------------------------
> 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
> --------------------------------------------------------------------------
--
Fergus Henderson <fjh at cs.mu.oz.au> | "I have always known that the pursuit
The University of Melbourne | of excellence is a lethal habit"
WWW: <http://www.cs.mu.oz.au/~fjh> | -- the last words of T. S. Garp.
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------
More information about the reviews
mailing list