[m-rev.] for review: arrays and the debugger
Mark Brown
dougl at cs.mu.OZ.AU
Tue Jun 19 17:09:52 AEST 2001
I've reviewed most of this change, but I haven't gone through the new
file runtime/mercury_ml_expand_body.h in detail yet. I'll post the rest
of my review soon.
The new file appears to be mostly copied from code previously in
std_util.m, but with some changes made. However, since the code is in a
different file, cvs diff does not produce any useful output that
isolates the actual changes made, and this makes the change difficult to
review. In situations like this, I think it would be useful for the
person requesting the review to provide a supplementary diff that shows
the underlying changes more effectively. That is, first cut and paste
the code to the new file and save the file, then when the change is
complete create a diff between the first and final versions of the new
file, then attach this supplementary diff to the review. (I could do this
myself, and in this case I will, but in general I think that this will
be less error prone if the person making the change does it.)
On 15-Jun-2001, Zoltan Somogyi <zs at cs.mu.OZ.AU> wrote:
> For review by anyone.
>
You haven't estimated the number of hours taken.
> Allow the debugger to treat arrays as other types.
I would characterise this change as something like "make the RTTI treat
arrays mostly like they treat tuples", because it is designed to avoid
future performance problems, not just the problem with the browser.
This would better explain why you don't just use functor/3 as Fergus
suggested.
>
> The RTTI routines used to pretend that terms of array type had no arguments.
> This lead the browser to believe that their size was small, and handed them
s/lead/led/
> over to io__write, which then printed the entire array. For large arrays,
> this could take minutes. It also lead the browser to believe that you can't
Ditto.
> "cd" to an element of an array.
>
> The RTTI routines now treat arrays mostly like they treat tuples, which fixes
> both problems.
>
> The debugger's prettyprinters do not yet use limited_deconstruct; that is
> future work.
>
> library/std_util.m:
> Add a new predicate, limited_deconstruct, which usually does what
> deconstruct does, but fails (and does not allocate any memory) if
> the arity of the supplied term is beyond a given limit. With normal
> terms, the memory allocated by deconstruct to hold the typeinfos
> of the arguments is not a problem. However, arrays can have millions
> of elements, and for them this *is* a problem. Programmers can avoid
> this problem by using imited_deconstruct instead of deconstruct.
s/imited/limited/
>
> Make ML_arg (used by the arg and argument predicates) avoid the
> construction of a typeinfo vector for all the arguments, for the same
> reason.
>
> Since we now need more variants of ML_expand than ever, and we don't
> want the new, relatively rarely used functionality to slow down the old
> functionality, create several variants of ML_expand, each specialized
> to a given use, and choose between them at compile time, not run time.
It would be worth mentioning that the code for (variants of) ML_expand has
moved to the new file.
> This should actually speed up the old functionality.o
Remove the trailing "o".
>
> runtime/mercury_ml_expand_body.h:
> A new file which is included several times in library/std_util.m,
> containing the bodies of the several variants of the old ML_expand.
>
> runtime/Mmakefile:
> Mention the new file.
>
> browser/browse.m:
> Avoid unlimited deconstructions when checking whether the term fits
> within the size range we give to io__write.
>
> Special case path resolution on terms of type array, because while
> in the debugger we count arguments from one, array elements start at
> index zero, and any other behavior would be misleading.
>
> tests/hard_coded/deconstruct_arg.{m,exp}:
> A new test case to check the various variants of ML_expand through
> its callers, the predicates functor, argument, deconstruct and
> limited_deconstruct, on all kinds of data types.
>
> tests/hard_coded/Mmakefile:
> Enable the new test case.
>
> Zoltan.
>
> cvs diff: Diffing .
> cvs diff: Diffing bindist
> cvs diff: Diffing boehm_gc
> cvs diff: Diffing boehm_gc/Mac_files
> cvs diff: Diffing boehm_gc/cord
> cvs diff: Diffing boehm_gc/cord/private
> cvs diff: Diffing boehm_gc/doc
> cvs diff: Diffing boehm_gc/include
> cvs diff: Diffing boehm_gc/include/private
> cvs diff: Diffing boehm_gc/tests
> cvs diff: Diffing browser
> Index: browser/browse.m
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/browser/browse.m,v
> retrieving revision 1.19
> diff -u -b -r1.19 browse.m
> --- browser/browse.m 2001/04/23 16:26:26 1.19
> +++ browser/browse.m 2001/06/12 16:44:51
> @@ -456,15 +456,21 @@
> max_print_size(60).
>
> term_size_left_from_max(Univ, MaxSize, RemainingSize) :-
> - ( MaxSize < 0 ->
> + (
> + MaxSize < 0
> + ->
> RemainingSize = MaxSize
> ;
> - deconstruct(univ_value(Univ), Functor, Arity, Args),
> + limited_deconstruct(univ_value(Univ), MaxSize,
> + Functor, Arity, Args)
> + ->
> string__length(Functor, FunctorSize),
> PrincipalSize = FunctorSize + Arity * 2,
> MaxArgsSize = MaxSize - PrincipalSize,
> list__foldl(term_size_left_from_max,
> Args, MaxArgsSize, RemainingSize)
> + ;
> + RemainingSize = -1
> ).
>
> %---------------------------------------------------------------------------%
> @@ -720,8 +726,19 @@
> Univ = SubUniv
> ;
> Path = [N | Ns],
> - deconstruct(univ_value(Univ), _Functor, _Arity, Args),
> - list__index1(Args, N, ArgN),
> + (
> + TypeCtor = type_ctor(univ_type(Univ)),
> + type_ctor_name(TypeCtor) = "array",
> + type_ctor_module_name(TypeCtor) = "array"
> + ->
> + % The first element of an array is at index zero.
> + ArgN = argument(univ_value(Univ), N)
> + ;
> + % The first argument of a non-array is is numbered
s/is is/is/
> + % argument 1 by the user but argument 0 by
> + % std_util:argument.
> + ArgN = argument(univ_value(Univ), N - 1)
> + ),
> deref_subterm_2(ArgN, Ns, SubUniv)
> ).
>
> cvs diff: Diffing bytecode
> cvs diff: Diffing compiler
> cvs diff: Diffing compiler/notes
> cvs diff: Diffing debian
> cvs diff: Diffing deep_profiler
> cvs diff: Diffing deep_profiler/notes
> cvs diff: Diffing doc
> cvs diff: Diffing extras
> cvs diff: Diffing extras/aditi
> cvs diff: Diffing extras/cgi
> cvs diff: Diffing extras/complex_numbers
> cvs diff: Diffing extras/complex_numbers/samples
> cvs diff: Diffing extras/complex_numbers/tests
> cvs diff: Diffing extras/concurrency
> cvs diff: Diffing extras/curs
> cvs diff: Diffing extras/curs/samples
> cvs diff: Diffing extras/curses
> cvs diff: Diffing extras/curses/sample
> cvs diff: Diffing extras/dynamic_linking
> cvs diff: Diffing extras/graphics
> cvs diff: Diffing extras/graphics/mercury_opengl
> cvs diff: Diffing extras/graphics/mercury_tcltk
> cvs diff: Diffing extras/graphics/samples
> cvs diff: Diffing extras/graphics/samples/calc
> cvs diff: Diffing extras/graphics/samples/maze
> cvs diff: Diffing extras/graphics/samples/pent
> cvs diff: Diffing extras/lazy_evaluation
> cvs diff: Diffing extras/lex
> cvs diff: Diffing extras/lex/samples
> cvs diff: Diffing extras/logged_output
> cvs diff: Diffing extras/moose
> cvs diff: Diffing extras/moose/samples
> cvs diff: Diffing extras/morphine
> cvs diff: Diffing extras/morphine/non-regression-tests
> cvs diff: Diffing extras/morphine/scripts
> cvs diff: Diffing extras/morphine/source
> cvs diff: Diffing extras/odbc
> cvs diff: Diffing extras/posix
> cvs diff: Diffing extras/quickcheck
> cvs diff: Diffing extras/quickcheck/tutes
> cvs diff: Diffing extras/references
> cvs diff: Diffing extras/references/samples
> cvs diff: Diffing extras/references/tests
> cvs diff: Diffing extras/stream
> cvs diff: Diffing extras/trailed_update
> cvs diff: Diffing extras/trailed_update/samples
> cvs diff: Diffing extras/trailed_update/tests
> cvs diff: Diffing extras/xml
> cvs diff: Diffing extras/xml/samples
> cvs diff: Diffing java
> cvs diff: Diffing library
> Index: library/std_util.m
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/library/std_util.m,v
> retrieving revision 1.232
> diff -u -b -r1.232 std_util.m
> --- library/std_util.m 2001/06/04 13:39:15 1.232
> +++ library/std_util.m 2001/06/12 16:44:41
> @@ -566,6 +566,13 @@
> %
> :- pred deconstruct(T::in, string::out, int::out, list(univ)::out) is det.
>
> + % limited_deconstruct(Data, MaxArity, Functor, Arity, Arguments)
> + %
> + % limited_deconstruct works like deconstruct, but if the arity of T is
> + % greater than MaxArity, limited_deconstruct fails.
> +:- pred limited_deconstruct(T::in, int::in, string::out,
> + int::out, list(univ)::out) is semidet.
> +
For consistency, there should be an extra blank comment line before the
pred declaration.
> :- implementation.
> :- interface.
>
> @@ -2795,66 +2802,79 @@
> :- pragma foreign_decl("C", "
>
> #include <stdio.h>
> + #include ""mercury_library_types.h"" /* for MR_ArrayType */
>
> #ifdef MR_DEEP_PROFILING
> #include ""mercury_deep_profiling.h""
> #endif
>
> - /*
> - ** Code for functor, arg and deconstruct
> - **
> - ** This relies on some C primitives that take a type_info
> - ** and a data_word, and get a functor, arity, argument vector,
> - ** and argument type_info vector.
> - */
> -
> - /* Type definitions */
> -
> - /*
> - ** The last two fields, need_functor, and need_args, must
> - ** be set by the caller, to indicate whether ML_expand
> - ** should copy the functor (if need_functor is non-zero) or
> - ** the argument vector and arg_type_infos (if need_args is
> - ** non-zero). The arity will always be set.
> - **
> - ** ML_expand will fill in the other fields (functor, arity,
> - ** arg_values, arg_type_infos, and non_canonical_type) accordingly,
> - ** but the values of fields not asked for should be assumed to contain
> - ** random data when ML_expand returns (that is, they should not be
> - ** relied on to remain unchanged).
> - **
> - ** The arg_type_infos field will contain a pointer to an array of arity
> - ** MR_TypeInfos, one for each user-visible field of the cell. The
> - ** arg_values field will contain a pointer to an arity + num_extra_args
> - ** MR_Words, one for each field of the cell, whether user-visible or not.
> - ** The first num_extra_args words will be the type infos and/or typeclass
> - ** infos added by the implementation to describe the types of the
> - ** existentially typed fields, while the last arity words will be the
> - ** user-visible fields themselves.
> - */
> -
> /* The `#ifndef ... #define ... #endif' guards against multiple inclusion */
> #ifndef ML_EXPAND_INFO_GUARD
> #define ML_EXPAND_INFO_GUARD
>
> -typedef struct ML_Expand_Info_Struct {
> - MR_ConstString functor;
> - int arity;
> +typedef struct {
> int num_extra_args;
> MR_Word *arg_values;
> MR_TypeInfo *arg_type_infos;
> bool can_free_arg_type_infos;
> +} ML_Expand_Args_Fields;
> +
> +typedef struct {
> bool non_canonical_type;
> - bool need_functor;
> - bool need_args;
> -} ML_Expand_Info;
> + int arity;
> + MR_ConstString functor;
> + ML_Expand_Args_Fields args;
> +} ML_Expand_Functor_Args_Info;
>
> -#endif
> +typedef struct {
> + bool non_canonical_type;
> + int arity;
> + MR_ConstString functor;
> + ML_Expand_Args_Fields args;
> + bool limit_reached;
Does this indentation come out correctly when the tabsize is 8? Please
check this (and also below).
> +} ML_Expand_Functor_Args_Limit_Info;
> +
> +typedef struct {
> + bool non_canonical_type;
> + int arity;
> + MR_ConstString functor_only;
> +} ML_Expand_Functor_Only_Info;
>
> +typedef struct {
> + bool non_canonical_type;
> + int arity;
> + ML_Expand_Args_Fields args_only;
> +} ML_Expand_Args_Only_Info;
> +
> +typedef struct {
> + bool non_canonical_type;
> + int arity;
> + bool chosen_index_exists;
> + MR_Word *chosen_value_ptr;
> + MR_TypeInfo chosen_type_info;
> +} ML_Expand_Chosen_Arg_Only_Info;
> +
> /* Prototypes */
>
> -extern void ML_expand(MR_TypeInfo type_info, MR_Word *data_word_ptr,
> - ML_Expand_Info *expand_info);
> +extern void ML_expand_functor_args(MR_TypeInfo type_info,
> + MR_Word *data_word_ptr,
> + ML_Expand_Functor_Args_Info *expand_info);
> +
> +extern void ML_expand_functor_args_limit(MR_TypeInfo type_info,
> + MR_Word *data_word_ptr, int max_arity,
> + ML_Expand_Functor_Args_Limit_Info *expand_info);
> +
> +extern void ML_expand_functor_only(MR_TypeInfo type_info,
> + MR_Word *data_word_ptr,
> + ML_Expand_Functor_Only_Info *expand_info);
> +
> +extern void ML_expand_args_only(MR_TypeInfo type_info,
> + MR_Word *data_word_ptr,
> + ML_Expand_Args_Only_Info *expand_info);
> +
> +extern void ML_expand_chosen_arg_only(MR_TypeInfo type_info,
> + MR_Word *data_word_ptr, int chosen,
> + ML_Expand_Chosen_Arg_Only_Info *expand_info);
>
> /*
> ** NB. ML_arg() is also used by arg_ref and new_arg_ref
> @@ -2870,489 +2890,58 @@
> extern bool ML_named_arg_num(MR_TypeInfo type_info, MR_Word *term_ptr,
> const char *arg_name, int *arg_num_ptr);
>
> +#endif
> +
> ").
>
> :- pragma foreign_code("C", "
> -
> -/*
> -** Expand the given data using its type_info, find its
> -** functor, arity, argument vector and type_info vector.
> -**
> -** The expand_info.arg_type_infos is allocated using MR_GC_malloc().
> -** (We need to use MR_GC_malloc() rather than MR_malloc() or malloc(),
> -** since this vector may contain pointers into the Mercury heap, and
> -** memory allocated with MR_malloc() or malloc() will not be traced by the
> -** Boehm collector.)
> -** It is the responsibility of the caller to deallocate this
> -** memory (using MR_GC_free()), and to copy any fields of this vector to
> -** the Mercury heap. The type_infos that the elements of
> -** this vector point to are either
> -** - already allocated on the heap.
> -** - constants (eg type_ctor_infos)
> -**
> -** Please note:
> -** ML_expand increments the heap pointer, however, on
> -** some platforms the register windows mean that transient
> -** Mercury registers may be lost. Before calling ML_expand,
> -** call MR_save_transient_registers(), and afterwards, call
> -** MR_restore_transient_registers().
> -**
> -** If writing a C function that calls MR_deep_copy, make sure you
> -** document that around your function, MR_save_transient_registers()
> -** MR_restore_transient_registers() need to be used.
> -**
> -** If you change this code you will also have reflect any changes in
> -** runtime/mercury_deep_copy_body.h and runtime/mercury_tabling.c
> -**
> -** We use 4 space tabs here because of the level of indenting.
> -*/
> -
> -void
> -ML_expand(MR_TypeInfo type_info, MR_Word *data_word_ptr,
> - ML_Expand_Info *expand_info)
> -{
> - MR_TypeCtorInfo type_ctor_info;
> -
> - type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
> - expand_info->non_canonical_type = FALSE;
> - expand_info->can_free_arg_type_infos = FALSE;
> -
> - switch(type_ctor_info->type_ctor_rep) {
> -
> - case MR_TYPECTOR_REP_ENUM_USEREQ:
> - expand_info->non_canonical_type = TRUE;
> - /* fall through */
> -
> - case MR_TYPECTOR_REP_ENUM:
> - expand_info->functor = type_ctor_info->type_layout.layout_enum
> - [*data_word_ptr]->MR_enum_functor_name;
> - expand_info->arity = 0;
> - expand_info->num_extra_args = 0;
> - expand_info->arg_values = NULL;
> - expand_info->arg_type_infos = NULL;
> - break;
> -
> - case MR_TYPECTOR_REP_DU_USEREQ:
> - expand_info->non_canonical_type = TRUE;
> - /* fall through */
> -
> - case MR_TYPECTOR_REP_DU:
> - {
> - const MR_DuPtagLayout *ptag_layout;
> - const MR_DuFunctorDesc *functor_desc;
> - const MR_DuExistInfo *exist_info;
> - MR_Word data;
> - int ptag;
> - MR_Word sectag;
> - MR_Word *arg_vector;
> -
> - data = *data_word_ptr;
> - ptag = MR_tag(data);
> - ptag_layout = &type_ctor_info->type_layout.layout_du[ptag];
> -
> - switch (ptag_layout->MR_sectag_locn) {
> - case MR_SECTAG_NONE:
> - functor_desc = ptag_layout->MR_sectag_alternatives[0];
> - arg_vector = (MR_Word *) MR_body(data, ptag);
> - break;
> - case MR_SECTAG_LOCAL:
> - sectag = MR_unmkbody(data);
> - functor_desc =
> - ptag_layout->MR_sectag_alternatives[sectag];
> - arg_vector = NULL;
> - break;
> - case MR_SECTAG_REMOTE:
> - sectag = MR_field(ptag, data, 0);
> - functor_desc =
> - ptag_layout->MR_sectag_alternatives[sectag];
> - arg_vector = (MR_Word *) MR_body(data, ptag) + 1;
> - break;
> - case MR_SECTAG_VARIABLE:
> - MR_fatal_error(""ML_expand(): cannot expand variable"");
> - }
> -
> - expand_info->arity = functor_desc->MR_du_functor_orig_arity;
> -
> - exist_info = functor_desc->MR_du_functor_exist_info;
> - if (exist_info != NULL) {
> - expand_info->num_extra_args =
> - exist_info->MR_exist_typeinfos_plain
> - + exist_info->MR_exist_tcis;
> - } else {
> - expand_info->num_extra_args = 0;
> - }
> -
> - if (expand_info->need_functor) {
> - MR_make_aligned_string(expand_info->functor,
> - functor_desc->MR_du_functor_name);
> - }
> -
> - if (expand_info->need_args) {
> - int i;
> -
> - expand_info->arg_values = arg_vector;
> - expand_info->can_free_arg_type_infos = TRUE;
> - expand_info->arg_type_infos = MR_GC_NEW_ARRAY(MR_TypeInfo,
> - expand_info->arity);
> -
> - for (i = 0; i < expand_info->arity; i++) {
> - if (MR_arg_type_may_contain_var(functor_desc, i)) {
> - expand_info->arg_type_infos[i] =
> - MR_create_type_info_maybe_existq(
> - MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(
> - type_info),
> - functor_desc->MR_du_functor_arg_types[i],
> - arg_vector, functor_desc);
> - } else {
> - expand_info->arg_type_infos[i] =
> - MR_pseudo_type_info_is_ground(
> - functor_desc->MR_du_functor_arg_types[i]);
> - }
> - }
> - }
> - }
> - break;
> -
> - case MR_TYPECTOR_REP_NOTAG_USEREQ:
> - expand_info->non_canonical_type = TRUE;
> - /* fall through */
> -
> - case MR_TYPECTOR_REP_NOTAG:
> - expand_info->arity = 1;
> - expand_info->num_extra_args = 0;
> -
> - if (expand_info->need_functor) {
> - MR_make_aligned_string(expand_info->functor,
> - type_ctor_info->type_layout.layout_notag
> - ->MR_notag_functor_name);
> - }
> -
> - if (expand_info->need_args) {
> - expand_info->arg_values = data_word_ptr;
> - expand_info->can_free_arg_type_infos = TRUE;
> - expand_info->arg_type_infos = MR_GC_NEW_ARRAY(MR_TypeInfo, 1);
> - expand_info->arg_type_infos[0] = MR_create_type_info(
> - MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info),
> - type_ctor_info->type_layout.layout_notag->
> - MR_notag_functor_arg_type);
> - }
> - break;
> -
> - case MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ:
> - expand_info->non_canonical_type = TRUE;
> - /* fall through */
> -
> - case MR_TYPECTOR_REP_NOTAG_GROUND:
> - expand_info->arity = 1;
> - expand_info->num_extra_args = 0;
> -
> - if (expand_info->need_functor) {
> - MR_make_aligned_string(expand_info->functor,
> - type_ctor_info->type_layout.layout_notag
> - ->MR_notag_functor_name);
> - }
> -
> - if (expand_info->need_args) {
> - expand_info->arg_values = data_word_ptr;
> - expand_info->can_free_arg_type_infos = TRUE;
> - expand_info->arg_type_infos = MR_GC_NEW_ARRAY(MR_TypeInfo, 1);
> - expand_info->arg_type_infos[0] =
> - MR_pseudo_type_info_is_ground(type_ctor_info->
> - type_layout.layout_notag->MR_notag_functor_arg_type);
> - }
> - break;
> -
> - case MR_TYPECTOR_REP_EQUIV:
> - {
> - MR_TypeInfo eqv_type_info;
> -
> - eqv_type_info = MR_create_type_info(
> - MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info),
> - type_ctor_info->type_layout.layout_equiv);
> - ML_expand(eqv_type_info, data_word_ptr, expand_info);
> - }
> - break;
> -
> - case MR_TYPECTOR_REP_EQUIV_GROUND:
> - ML_expand(MR_pseudo_type_info_is_ground(
> - type_ctor_info->type_layout.layout_equiv),
> - data_word_ptr, expand_info);
> - break;
> -
> - case MR_TYPECTOR_REP_EQUIV_VAR:
> - /*
> - ** The current version of the RTTI gives all such equivalence types
> - ** the EQUIV type_ctor_rep, not EQUIV_VAR.
> - */
> - MR_fatal_error(""unexpected EQUIV_VAR type_ctor_rep"");
> - break;
> -
> - case MR_TYPECTOR_REP_INT:
> - if (expand_info->need_functor) {
> - MR_Word data_word;
> - char buf[500];
> - char *str;
> -
> - data_word = *data_word_ptr;
> - sprintf(buf, ""%ld"", (long) data_word);
> - MR_incr_saved_hp_atomic(MR_LVALUE_CAST(MR_Word, str),
> - (strlen(buf) + sizeof(MR_Word)) / sizeof(MR_Word));
> - strcpy(str, buf);
> - expand_info->functor = str;
> - }
> -
> - expand_info->arg_values = NULL;
> - expand_info->arg_type_infos = NULL;
> - expand_info->arity = 0;
> - expand_info->num_extra_args = 0;
> - break;
> -
> - case MR_TYPECTOR_REP_CHAR:
> - /* XXX should escape characters correctly */
> - if (expand_info->need_functor) {
> - MR_Word data_word;
> - char *str;
> -
> - data_word = *data_word_ptr;
> - MR_incr_saved_hp_atomic(MR_LVALUE_CAST(MR_Word, str),
> - (3 + sizeof(MR_Word)) / sizeof(MR_Word));
> - sprintf(str, ""\'%c\'"", (char) data_word);
> - expand_info->functor = str;
> - }
> - expand_info->arg_values = NULL;
> - expand_info->arg_type_infos = NULL;
> - expand_info->arity = 0;
> - expand_info->num_extra_args = 0;
> - break;
> -
> - case MR_TYPECTOR_REP_FLOAT:
> - if (expand_info->need_functor) {
> - MR_Word data_word;
> - char buf[500];
> - MR_Float f;
> - char *str;
> -
> - data_word = *data_word_ptr;
> - f = MR_word_to_float(data_word);
> - sprintf(buf, ""%#.15g"", f);
> - MR_incr_saved_hp_atomic(MR_LVALUE_CAST(MR_Word, str),
> - (strlen(buf) + sizeof(MR_Word)) / sizeof(MR_Word));
> - strcpy(str, buf);
> - expand_info->functor = str;
> - }
> - expand_info->arg_values = NULL;
> - expand_info->arg_type_infos = NULL;
> - expand_info->arity = 0;
> - expand_info->num_extra_args = 0;
> - break;
> -
> - case MR_TYPECTOR_REP_STRING:
> - /* XXX should escape characters correctly */
> - if (expand_info->need_functor) {
> - MR_Word data_word;
> - char *str;
> -
> - data_word = *data_word_ptr;
> - MR_incr_saved_hp_atomic(MR_LVALUE_CAST(MR_Word, str),
> - (strlen((MR_String) data_word) + 2 + sizeof(MR_Word))
> - / sizeof(MR_Word));
> - sprintf(str, ""%c%s%c"", '""', (MR_String) data_word, '""');
> - expand_info->functor = str;
> - }
> - expand_info->arg_values = NULL;
> - expand_info->arg_type_infos = NULL;
> - expand_info->arity = 0;
> - expand_info->num_extra_args = 0;
> - break;
>
> - case MR_TYPECTOR_REP_PRED:
> - /* XXX expand_info->non_canonical_type = TRUE; */
> - if (expand_info->need_functor) {
> - MR_make_aligned_string(expand_info->functor,
> - ""<<predicate>>"");
> - }
> - expand_info->arg_values = NULL;
> - expand_info->arg_type_infos = NULL;
> - expand_info->arity = 0;
> - expand_info->num_extra_args = 0;
> - break;
> -
> - case MR_TYPECTOR_REP_TUPLE:
> - expand_info->arity = MR_TYPEINFO_GET_TUPLE_ARITY(type_info);
> - expand_info->num_extra_args = 0;
> -
> - if (expand_info->need_functor) {
> - MR_make_aligned_string(expand_info->functor, ""{}"");
> - }
> - if (expand_info->need_args) {
> - expand_info->arg_values = (MR_Word *) *data_word_ptr;
> -
> - /*
> - ** Type-infos are normally counted from one, but
> - ** the users of this vector count from zero.
> - */
> - expand_info->arg_type_infos =
> - MR_TYPEINFO_GET_TUPLE_ARG_VECTOR(type_info) + 1;
> - }
> - break;
> -
> - case MR_TYPECTOR_REP_UNIV: {
> - MR_Word data_word;
> -
> - MR_TypeInfo univ_type_info;
> - MR_Word univ_data;
> - /*
> - * Univ is a two word structure, containing
> - * type_info and data.
> - */
> - data_word = *data_word_ptr;
> - MR_unravel_univ(data_word, univ_type_info, univ_data);
> - ML_expand(univ_type_info, &univ_data, expand_info);
> - break;
> - }
> -
> - case MR_TYPECTOR_REP_VOID:
> - /*
> - ** There's no way to create values of type `void',
> - ** so this should never happen.
> - */
> - MR_fatal_error(""ML_expand: cannot expand void types"");
> -
> - case MR_TYPECTOR_REP_C_POINTER:
> - /* XXX expand_info->non_canonical_type = TRUE; */
> - if (expand_info->need_functor) {
> - MR_make_aligned_string(expand_info->functor,
> - ""<<c_pointer>>"");
> - }
> - expand_info->arg_values = NULL;
> - expand_info->arg_type_infos = NULL;
> - expand_info->arity = 0;
> - expand_info->num_extra_args = 0;
> - break;
> -
> - case MR_TYPECTOR_REP_TYPEINFO:
> - /* XXX expand_info->non_canonical_type = TRUE; */
> - if (expand_info->need_functor) {
> - MR_make_aligned_string(expand_info->functor, ""<<typeinfo>>"");
> - }
> - /* XXX should we return the arguments here? */
> - expand_info->arg_values = NULL;
> - expand_info->arg_type_infos = NULL;
> - expand_info->arity = 0;
> - expand_info->num_extra_args = 0;
> - break;
> -
> - case MR_TYPECTOR_REP_TYPECLASSINFO:
> - /* XXX expand_info->non_canonical_type = TRUE; */
> - if (expand_info->need_functor) {
> - MR_make_aligned_string(expand_info->functor,
> - ""<<typeclassinfo>>"");
> - }
> - /* XXX should we return the arguments here? */
> - expand_info->arg_values = NULL;
> - expand_info->arg_type_infos = NULL;
> - expand_info->arity = 0;
> - expand_info->num_extra_args = 0;
> - break;
> -
> - case MR_TYPECTOR_REP_ARRAY:
> - if (expand_info->need_functor) {
> - MR_make_aligned_string(expand_info->functor, ""<<array>>"");
> - }
> - /* XXX should we return the arguments here? */
> - expand_info->arg_values = NULL;
> - expand_info->arg_type_infos = NULL;
> - expand_info->arity = 0;
> - expand_info->num_extra_args = 0;
> - break;
> -
> - case MR_TYPECTOR_REP_SUCCIP:
> - if (expand_info->need_functor) {
> - MR_make_aligned_string(expand_info->functor, ""<<succip>>"");
> - }
> - expand_info->arg_values = NULL;
> - expand_info->arg_type_infos = NULL;
> - expand_info->arity = 0;
> - expand_info->num_extra_args = 0;
> - break;
> +#define EXPAND_FUNCTION_NAME ML_expand_functor_args
> +#define EXPAND_TYPE_NAME ML_Expand_Functor_Args_Info
> +#define EXPAND_FUNCTOR_FIELD functor
> +#define EXPAND_ARGS_FIELD args
> +#include ""mercury_ml_expand_body.h""
> +#undef EXPAND_FUNCTION_NAME
> +#undef EXPAND_TYPE_NAME
> +#undef EXPAND_FUNCTOR_FIELD
> +#undef EXPAND_ARGS_FIELD
> +
> +#define EXPAND_FUNCTION_NAME ML_expand_functor_args_limit
> +#define EXPAND_TYPE_NAME ML_Expand_Functor_Args_Limit_Info
> +#define EXPAND_FUNCTOR_FIELD functor
> +#define EXPAND_ARGS_FIELD args
> +#define EXPAND_APPLY_LIMIT
> +#include ""mercury_ml_expand_body.h""
> +#undef EXPAND_FUNCTION_NAME
> +#undef EXPAND_TYPE_NAME
> +#undef EXPAND_FUNCTOR_FIELD
> +#undef EXPAND_ARGS_FIELD
> +#undef EXPAND_APPLY_LIMIT
> +
> +#define EXPAND_FUNCTION_NAME ML_expand_functor_only
> +#define EXPAND_TYPE_NAME ML_Expand_Functor_Only_Info
> +#define EXPAND_FUNCTOR_FIELD functor_only
> +#include ""mercury_ml_expand_body.h""
> +#undef EXPAND_FUNCTION_NAME
> +#undef EXPAND_TYPE_NAME
> +#undef EXPAND_FUNCTOR_FIELD
> +
> +#define EXPAND_FUNCTION_NAME ML_expand_args_only
> +#define EXPAND_TYPE_NAME ML_Expand_Args_Only_Info
> +#define EXPAND_ARGS_FIELD args_only
> +#include ""mercury_ml_expand_body.h""
> +#undef EXPAND_FUNCTION_NAME
> +#undef EXPAND_TYPE_NAME
> +#undef EXPAND_ARGS_FIELD
> +
> +#define EXPAND_FUNCTION_NAME ML_expand_chosen_arg_only
> +#define EXPAND_TYPE_NAME ML_Expand_Chosen_Arg_Only_Info
> +#define EXPAND_CHOSEN_ARG
> +#include ""mercury_ml_expand_body.h""
> +#undef EXPAND_FUNCTION_NAME
> +#undef EXPAND_TYPE_NAME
> +#undef EXPAND_CHOSEN_ARG
>
> - case MR_TYPECTOR_REP_HP:
> - if (expand_info->need_functor) {
> - MR_make_aligned_string(expand_info->functor, ""<<hp>>"");
> - }
> - expand_info->arg_values = NULL;
> - expand_info->arg_type_infos = NULL;
> - expand_info->arity = 0;
> - expand_info->num_extra_args = 0;
> - break;
> -
> - case MR_TYPECTOR_REP_CURFR:
> - if (expand_info->need_functor) {
> - MR_make_aligned_string(expand_info->functor, ""<<curfr>>"");
> - }
> - expand_info->arg_values = NULL;
> - expand_info->arg_type_infos = NULL;
> - expand_info->arity = 0;
> - expand_info->num_extra_args = 0;
> - break;
> -
> - case MR_TYPECTOR_REP_MAXFR:
> - if (expand_info->need_functor) {
> - MR_make_aligned_string(expand_info->functor, ""<<maxfr>>"");
> - }
> - expand_info->arg_values = NULL;
> - expand_info->arg_type_infos = NULL;
> - expand_info->arity = 0;
> - expand_info->num_extra_args = 0;
> - break;
> -
> - case MR_TYPECTOR_REP_REDOFR:
> - if (expand_info->need_functor) {
> - MR_make_aligned_string(expand_info->functor, ""<<redofr>>"");
> - }
> - expand_info->arg_values = NULL;
> - expand_info->arg_type_infos = NULL;
> - expand_info->arity = 0;
> - expand_info->num_extra_args = 0;
> - break;
> -
> - case MR_TYPECTOR_REP_REDOIP:
> - if (expand_info->need_functor) {
> - MR_make_aligned_string(expand_info->functor, ""<<redoip>>"");
> - }
> - expand_info->arg_values = NULL;
> - expand_info->arg_type_infos = NULL;
> - expand_info->arity = 0;
> - expand_info->num_extra_args = 0;
> - break;
> -
> - case MR_TYPECTOR_REP_TRAIL_PTR:
> - if (expand_info->need_functor) {
> - MR_make_aligned_string(expand_info->functor, ""<<trail_ptr>>"");
> - }
> - expand_info->arg_values = NULL;
> - expand_info->arg_type_infos = NULL;
> - expand_info->arity = 0;
> - expand_info->num_extra_args = 0;
> - break;
> -
> - case MR_TYPECTOR_REP_TICKET:
> - if (expand_info->need_functor) {
> - MR_make_aligned_string(expand_info->functor, ""<<ticket>>"");
> - }
> - expand_info->arg_values = NULL;
> - expand_info->arg_type_infos = NULL;
> - expand_info->arity = 0;
> - expand_info->num_extra_args = 0;
> - break;
> -
> - case MR_TYPECTOR_REP_UNKNOWN: /* fallthru */
> - default:
> - MR_fatal_error(""ML_expand: cannot expand -- unknown data type"");
> - break;
> - }
> -}
> -
> /*
> ** ML_arg() is a subroutine used to implement arg/2, argument/2,
> ** and also store__arg_ref/5 in store.m.
> @@ -3368,13 +2957,9 @@
> ML_arg(MR_TypeInfo type_info, MR_Word *term_ptr, int arg_index,
> MR_TypeInfo *arg_type_info_ptr, MR_Word **arg_ptr)
> {
> - ML_Expand_Info expand_info;
> - bool success;
> -
> - expand_info.need_functor = FALSE;
> - expand_info.need_args = TRUE;
> + ML_Expand_Chosen_Arg_Only_Info expand_info;
>
> - ML_expand(type_info, term_ptr, &expand_info);
> + ML_expand_chosen_arg_only(type_info, term_ptr, arg_index, &expand_info);
>
> /*
> ** Check for attempts to deconstruct a non-canonical type:
> @@ -3390,23 +2975,13 @@
> }
>
> /* Check range */
> - success = (arg_index >= 0 && arg_index < expand_info.arity);
> - if (success) {
> - *arg_type_info_ptr = expand_info.arg_type_infos[arg_index];
> - *arg_ptr = &expand_info.arg_values[
> - arg_index + expand_info.num_extra_args];
> - }
> -
> - /*
> - ** Free the allocated arg_type_infos, since we just copied
> - ** the stuff we want out of it.
> - */
> -
> - if (expand_info.can_free_arg_type_infos) {
> - MR_GC_free(expand_info.arg_type_infos);
> + if (expand_info.chosen_index_exists) {
> + *arg_type_info_ptr = expand_info.chosen_type_info;
> + *arg_ptr = expand_info.chosen_value_ptr;
> + return TRUE;
> }
>
> - return success;
> + return FALSE;
> }
>
> /*
> @@ -3526,15 +3101,12 @@
> will_not_call_mercury, "
> {
> MR_TypeInfo type_info;
> - ML_Expand_Info expand_info;
> + ML_Expand_Functor_Only_Info expand_info;
>
> type_info = (MR_TypeInfo) TypeInfo_for_T;
>
> - expand_info.need_functor = TRUE;
> - expand_info.need_args = FALSE;
> -
> MR_save_transient_registers();
> - ML_expand(type_info, &Term, &expand_info);
> + ML_expand_functor_only(type_info, &Term, &expand_info);
> MR_restore_transient_registers();
>
> /*
> @@ -3552,7 +3124,7 @@
>
> /* Copy functor onto the heap */
> MR_make_aligned_string(MR_LVALUE_CAST(MR_ConstString, Functor),
> - expand_info.functor);
> + expand_info.functor_only);
>
> Arity = expand_info.arity;
> }").
> @@ -3668,19 +3240,78 @@
> :- pragma foreign_proc("C",
> deconstruct(Term::in, Functor::out, Arity::out,
> Arguments::out), will_not_call_mercury, "
> +{
> + ML_Expand_Functor_Args_Info expand_info;
> + MR_TypeInfo type_info;
> + MR_Word Argument;
> + MR_Word tmp;
> + int i;
> +
> + type_info = (MR_TypeInfo) TypeInfo_for_T;
> +
> + MR_save_transient_registers();
> + ML_expand_functor_args(type_info, &Term, &expand_info);
> + MR_restore_transient_registers();
> +
> + /*
> + ** Check for attempts to deconstruct a non-canonical type:
> + ** such deconstructions must be cc_multi, and since
> + ** deconstruct/4 is det, we must treat violations of this
> + ** as runtime errors.
> + ** (There ought to be a cc_multi version of deconstruct/4
> + ** that allows this.)
> + */
> + if (expand_info.non_canonical_type) {
> + MR_fatal_error(""called deconstruct/4 for a type with a ""
> + ""user-defined equality predicate"");
> + }
> +
> + /* Get functor */
> + MR_make_aligned_string(MR_LVALUE_CAST(MR_ConstString, Functor),
> + expand_info.functor);
> +
> + /* Get arity */
> + Arity = expand_info.arity;
> +
> + /* Build argument list */
> + Arguments = MR_list_empty_msg(MR_PROC_LABEL);
> + i = expand_info.arity;
> +
> + while (--i >= 0) {
> +
> + /* Create an argument on the heap */
> + MR_new_univ_on_hp(Argument,
> + expand_info.args.arg_type_infos[i],
> + expand_info.args.arg_values[i + expand_info.args.num_extra_args]);
> +
> + /* Join the argument to the front of the list */
> + Arguments = MR_list_cons_msg(Argument, Arguments, MR_PROC_LABEL);
> + }
> +
> + /*
> + ** Free the allocated arg_type_infos, since we just copied
> + ** all its arguments onto the heap.
> + */
> +
> + if (expand_info.args.can_free_arg_type_infos) {
> + MR_GC_free(expand_info.args.arg_type_infos);
> + }
> +}").
It is a shame that this code is mostly duplicated for both deconstruct
and limited_deconstruct. I think it would be better if the code was
refactored to reduce this duplication, even at the expense of extra
calls being made. Is it too difficult/inefficient to do this?
> +
> +:- pragma foreign_proc("C",
> + limited_deconstruct(Term::in, MaxArity::in, Functor::out, Arity::out,
> + Arguments::out), will_not_call_mercury, "
> {
> - ML_Expand_Info expand_info;
> + ML_Expand_Functor_Args_Limit_Info expand_info;
> MR_TypeInfo type_info;
> MR_Word Argument;
> MR_Word tmp;
> int i;
>
> type_info = (MR_TypeInfo) TypeInfo_for_T;
> - expand_info.need_functor = TRUE;
> - expand_info.need_args = TRUE;
>
> MR_save_transient_registers();
> - ML_expand(type_info, &Term, &expand_info);
> + ML_expand_functor_args_limit(type_info, &Term, MaxArity, &expand_info);
> MR_restore_transient_registers();
>
> /*
> @@ -3696,6 +3327,11 @@
> ""user-defined equality predicate"");
> }
>
> + if (expand_info.limit_reached) {
> + SUCCESS_INDICATOR = FALSE;
> + } else {
> + SUCCESS_INDICATOR = TRUE;
> +
> /* Get functor */
> MR_make_aligned_string(MR_LVALUE_CAST(MR_ConstString, Functor),
> expand_info.functor);
> @@ -3711,8 +3347,8 @@
>
> /* Create an argument on the heap */
> MR_new_univ_on_hp(Argument,
> - expand_info.arg_type_infos[i],
> - expand_info.arg_values[i + expand_info.num_extra_args]);
> + expand_info.args.arg_type_infos[i],
> + expand_info.args.arg_values[i + expand_info.args.num_extra_args]);
>
> /* Join the argument to the front of the list */
> Arguments = MR_list_cons_msg(Argument, Arguments, MR_PROC_LABEL);
> @@ -3723,13 +3359,22 @@
> ** all its arguments onto the heap.
> */
>
> - if (expand_info.can_free_arg_type_infos) {
> - MR_GC_free(expand_info.arg_type_infos);
> + if (expand_info.args.can_free_arg_type_infos) {
> + MR_GC_free(expand_info.args.arg_type_infos);
> + }
> }
> }").
>
> :- pragma foreign_proc("MC++",
> deconstruct(_Term::in, _Functor::out, _Arity::out,
> + _Arguments::out), will_not_call_mercury, "
> +{
> + mercury::runtime::Errors::SORRY(""foreign code for this function"");
> +}
> +").
> +
> +:- pragma foreign_proc("MC++",
> + limited_deconstruct(_Term::in, _MaxArity::in, _Functor::out, _Arity::out,
> _Arguments::out), will_not_call_mercury, "
> {
> mercury::runtime::Errors::SORRY(""foreign code for this function"");
> cvs diff: Diffing profiler
> cvs diff: Diffing robdd
> cvs diff: Diffing runtime
> Index: runtime/Mmakefile
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/runtime/Mmakefile,v
> retrieving revision 1.72
> diff -u -b -r1.72 Mmakefile
> --- runtime/Mmakefile 2001/05/31 06:00:09 1.72
> +++ runtime/Mmakefile 2001/06/12 16:44:41
> @@ -101,13 +101,14 @@
> mercury_deep_call_port_body.h \
> mercury_deep_copy_body.h \
> mercury_deep_leave_port_body.h \
> - mercury_deep_redo_port_body.h \
> mercury_deep_rec_depth_actions.h \
> mercury_deep_rec_depth_body.h \
> + mercury_deep_redo_port_body.h \
> mercury_exception_catch_body.h \
> mercury_hand_compare_body.h \
> mercury_hand_unify_body.h \
> mercury_make_type_info_body.h \
> + mercury_ml_expand_body.h \
> mercury_unify_compare_body.h
>
> # Note that $(LIB_GLOBALS_H) cannot be part of $(HDRS), since it depends on
> Index: runtime/mercury_ml_expand_body.h
> ===================================================================
> RCS file: mercury_ml_expand_body.h
> diff -N mercury_ml_expand_body.h
> --- /dev/null Fri Dec 1 02:25:58 2000
> +++ mercury_ml_expand_body.h Wed Jun 13 02:44:41 2001
> @@ -0,0 +1,671 @@
> +/*
> +** Copyright (C) 2001 The University of Melbourne.
> +** This file may only be copied under the terms of the GNU Library General
> +** Public License - see the file COPYING.LIB in the Mercury distribution.
> +*/
> +
> +/*
> +** mercury_ml_expand_body.h
> +**
> +** This file is included several times in library/std_util.m. Each inclusion
> +** defines a function that the body of several variants of the old ML_expand
> +** function, which, given a data word and its type_info, returned its functor,
> +** arity, argument vector and a type_info vector describing its arguments.
> +** One variants still does all that. The others perform different subsets of
> +** this task. The reason for having those specialized variants is that
> +** executing the full task can be extremely time consuming, especially when
> +** large arrays are involved. (Simply allocating and filling in an array of
> +** a million typeinfos can cause a system to start paging.) Therefore we try to
> +** make sure that in every circumstance we perform the minimum work possible.
> +**
> +** The code including this file must define these macros:
> +**
> +** EXPAND_FUNCTION_NAME Gives the name of the function being defined.
> +**
> +** EXPAND_TYPE_NAME Gives the name of the type of the expand_info
> +** argument.
> +**
> +** The code including this file may define these macros:
> +**
> +** EXPAND_FUNCTOR_FIELD If defined, gives the name of the field in the
> +** expand_info structure that contains the name of the
> +** functor. This field should be of type
> +** MR_ConstString. The function will fill in this
> +** field.
> +**
> +** EXPAND_ARGS_FIELD If defined, gives the name of the field in the
> +** expand_info structure that contains information
> +** about all the functor's arguments. This field
> +** should be of type ML_Expand_Args_Fields. The
> +** function will fill in this field.
> +**
> +** EXPAND_CHOSEN_ARG If defined, the function will have an extra
> +** argument, chosen, and it will fill in the fields
> +** of the ML_Expand_Chosen_Arg_Only structure.
> +**
> +** EXPAND_APPLY_LIMIT If defined, the function will have an extra
> +** argument, max_arity. If the number of arguments
> +** exceeds this limit, the function will store FALSE
> +** in the limit_reached field of expand_info and will
> +** not fill in the other fields about the arguments.
> +**
> +** Most combinations are allowed, but
> +**
> +** - only one of EXPAND_ARGS_FIELD and EXPAND_CHOSEN_ARG may be defined at once
> +** - EXPAND_APPLY_LIMIT should be defined only if EXPAND_ARGS_FIELD is also
> +** defined.
> +**
> +** Each variant of the function will fill in all the fields of the expand_info
> +** structure passed to it, although the set of fields in that structure will
> +** be different for different variants. The type in EXPAND_TYPE_NAME must be
> +** consistent with the set of defined optional macros.
> +**
> +** All variants contain the boolean field non_canonical_type, which will be
> +** set to TRUE iff the type has user-defined equality, and the integer field
> +** arity, which will be set to the number of arguments the functor has.
> +**
> +** The variants that return all the arguments do so in a field of type
> +** ML_Expand_Args_Fields. Its arg_type_infos subfield will contain a pointer
> +** to an array of arity MR_TypeInfos, one for each user-visible field of the
> +** cell. The arg_values field will contain a pointer to a block of
> +** arity + num_extra_args MR_Words, one for each field of the cell,
> +** whether user-visible or not. The first num_extra_args words will be
> +** the type infos and/or typeclass infos added by the implementation to
> +** describe the types of the existentially typed fields, while the last
> +** arity words will be the user-visible fields themselves.
> +**
> +** If the can_free_arg_type_infos field is true, then the array returned
> +** in the arg_type_infos field was allocated by this function, and should be
> +** freed by the caller when it has finished using the information it contains.
> +** Since the array will have been allocated using MR_GC_malloc(), it should be
> +** freed with MR_GC_free. (We need to use MR_GC_malloc() rather than
> +** MR_malloc() or malloc(), since this vector may contain pointers into the
> +** Mercury heap, and memory allocated with MR_malloc() or malloc() will not be
> +** traced by the Boehm collector.) The elements of the array should not be
> +** freed, since they point either previously allocated data, which is either
> +** on the heap or is in constant storage (e.g. type_ctor_infos).
> +** If the can_free_arg_type_infos field is false, then the array returned in
> +** the arg_type_infos field was not allocated by the function (it came from the
> +** type_info argument passed to it) and must not be freed.
> +**
> +** Please note:
> +** These functions increment the heap pointer; however, on some platforms
> +** the register windows mean that transient Mercury registers may be lost.
> +** Before calling these functions, call MR_save_transient_registers(), and
> +** afterwards, call MR_restore_transient_registers().
> +**
> +** If you change this code, you may also have to reflect your changes
> +** in runtime/mercury_deep_copy_body.h and runtime/mercury_tabling.c
> +**
> +** We use 4 space tabs here (sw=4 ts=4) because of the level of indenting.
> +*/
> +
> +#include <stdio.h>
> +#include "mercury_library_types.h" /* for MR_ArrayType */
> +
> +#ifdef MR_DEEP_PROFILING
> + #include "mercury_deep_profiling.h"
> +#endif
> +
> +/* set up for recursive calls */
> +#ifdef EXPAND_APPLY_LIMIT
> + #define EXTRA_ARG1 max_arity,
> +#else
> + #define EXTRA_ARG1
> +#endif
> +#ifdef EXPAND_CHOSEN_ARG
> + #define EXTRA_ARG2 chosen,
> +#else
> + #define EXTRA_ARG2
> +#endif
> +#define EXTRA_ARGS EXTRA_ARG1 EXTRA_ARG2
> +
> +/* set up macro for setting field names without #ifdefs */
> +#ifdef EXPAND_FUNCTOR_FIELD
> + #define handle_functor_name(name) \
> + do { \
> + MR_make_aligned_string(expand_info->EXPAND_FUNCTOR_FIELD,\
> + name); \
> + } while (0)
> +#else /* EXPAND_FUNCTOR_FIELD */
> + #define handle_functor_name(name) \
> + ((void) 0)
> +#endif /* EXPAND_FUNCTOR_FIELD */
> +
> +/* set up macros for the common code handling zero arity terms */
> +
> +#ifdef EXPAND_ARGS_FIELD
> + #define handle_zero_arity_all_args() \
> + do { \
> + expand_info->EXPAND_ARGS_FIELD.arg_values = NULL; \
> + expand_info->EXPAND_ARGS_FIELD.arg_type_infos = NULL; \
> + expand_info->EXPAND_ARGS_FIELD.num_extra_args = 0; \
> + } while (0)
> +#else /* EXPAND_ARGS_FIELD */
> + #define handle_zero_arity_all_args() \
> + ((void) 0)
> +#endif /* EXPAND_ARGS_FIELD */
> +
> +#ifdef EXPAND_CHOSEN_ARG
> + #define handle_zero_arity_chosen_arg() \
> + do { \
> + expand_info->chosen_index_exists = FALSE; \
> + } while (0)
> +#else /* EXPAND_CHOSEN_ARG */
> + #define handle_zero_arity_chosen_arg() \
> + ((void) 0)
> +#endif /* EXPAND_CHOSEN_ARG */
> +
> +#define handle_zero_arity_args() \
> + do { \
> + expand_info->arity = 0; \
> + handle_zero_arity_all_args(); \
> + handle_zero_arity_chosen_arg(); \
> + } while (0)
> +
> +/***********************************************************************/
> +
> +void
> +EXPAND_FUNCTION_NAME(MR_TypeInfo type_info, MR_Word *data_word_ptr,
> +#ifdef EXPAND_APPLY_LIMIT
> + int max_arity,
> +#endif /* EXPAND_APPLY_LIMIT */
> +#ifdef EXPAND_CHOSEN_ARG
> + int chosen,
> +#endif /* CHOSEN_ARG */
> + EXPAND_TYPE_NAME *expand_info)
> +{
> + MR_TypeCtorInfo type_ctor_info;
> +
> + type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
> + expand_info->non_canonical_type = FALSE;
> +#ifdef EXPAND_ARGS_FIELD
> + expand_info->EXPAND_ARGS_FIELD.can_free_arg_type_infos = FALSE;
> +#endif /* EXPAND_ARGS_FIELD */
> +#ifdef EXPAND_APPLY_LIMIT
> + expand_info->limit_reached = FALSE;
> +#endif /* EXPAND_APPLY_LIMIT */
> +
> + switch(type_ctor_info->type_ctor_rep) {
> +
> + case MR_TYPECTOR_REP_ENUM_USEREQ:
> + expand_info->non_canonical_type = TRUE;
> + /* fall through */
> +
> + case MR_TYPECTOR_REP_ENUM:
> + handle_functor_name(type_ctor_info->type_layout.
> + layout_enum[*data_word_ptr]->MR_enum_functor_name);
> + handle_zero_arity_args();
> + break;
> +
> + case MR_TYPECTOR_REP_DU_USEREQ:
> + expand_info->non_canonical_type = TRUE;
> + /* fall through */
> +
> + case MR_TYPECTOR_REP_DU:
> + {
> + const MR_DuPtagLayout *ptag_layout;
> + const MR_DuFunctorDesc *functor_desc;
> + const MR_DuExistInfo *exist_info;
> + int extra_args;
> + MR_Word data;
> + int ptag;
> + MR_Word sectag;
> + MR_Word *arg_vector;
> +
> + data = *data_word_ptr;
> + ptag = MR_tag(data);
> + ptag_layout = &type_ctor_info->type_layout.layout_du[ptag];
> +
> + switch (ptag_layout->MR_sectag_locn) {
> + case MR_SECTAG_NONE:
> + functor_desc = ptag_layout->MR_sectag_alternatives[0];
> + arg_vector = (MR_Word *) MR_body(data, ptag);
> + break;
> + case MR_SECTAG_LOCAL:
> + sectag = MR_unmkbody(data);
> + functor_desc =
> + ptag_layout->MR_sectag_alternatives[sectag];
> + arg_vector = NULL;
> + break;
> + case MR_SECTAG_REMOTE:
> + sectag = MR_field(ptag, data, 0);
> + functor_desc =
> + ptag_layout->MR_sectag_alternatives[sectag];
> + arg_vector = (MR_Word *) MR_body(data, ptag) + 1;
> + break;
> + case MR_SECTAG_VARIABLE:
> + MR_fatal_error(MR_STRINGIFY(EXPAND_FUNCTION_NAME)
> + ": cannot expand variable");
> + }
> +
> + handle_functor_name(functor_desc->MR_du_functor_name);
> + expand_info->arity = functor_desc->MR_du_functor_orig_arity;
> +
> +#if defined(EXPAND_ARGS_FIELD) || defined(EXPAND_CHOSEN_ARG)
> + exist_info = functor_desc->MR_du_functor_exist_info;
> + if (exist_info != NULL) {
> + extra_args = exist_info->MR_exist_typeinfos_plain
> + + exist_info->MR_exist_tcis;
> + } else {
> + extra_args = 0;
> + }
> +#endif /* defined(EXPAND_ARGS_FIELD) || defined(EXPAND_CHOSEN_ARG) */
> +
> +#ifdef EXPAND_ARGS_FIELD
> + #ifdef EXPAND_APPLY_LIMIT
> + if (expand_info->arity > max_arity) {
> + expand_info->limit_reached = TRUE;
> + } else
> + #endif /* EXPAND_APPLY_LIMIT */
> + {
> + int i;
> + expand_info->EXPAND_ARGS_FIELD.num_extra_args = extra_args;
> + expand_info->EXPAND_ARGS_FIELD.arg_values = arg_vector;
> + expand_info->EXPAND_ARGS_FIELD.can_free_arg_type_infos =
> + TRUE;
> + expand_info->EXPAND_ARGS_FIELD.arg_type_infos =
> + MR_GC_NEW_ARRAY(MR_TypeInfo, expand_info->arity);
> +
> + for (i = 0; i < expand_info->arity; i++) {
> + if (MR_arg_type_may_contain_var(functor_desc, i)) {
> + expand_info->EXPAND_ARGS_FIELD.arg_type_infos[i] =
> + MR_create_type_info_maybe_existq(
> + MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(
> + type_info),
> + functor_desc->MR_du_functor_arg_types[i],
> + arg_vector, functor_desc);
> + } else {
> + expand_info->EXPAND_ARGS_FIELD.arg_type_infos[i] =
> + MR_pseudo_type_info_is_ground(
> + functor_desc->MR_du_functor_arg_types[i]);
> + }
> + }
> + }
> +#endif /* EXPAND_ARGS_FIELD */
> +#ifdef EXPAND_CHOSEN_ARG
> + if (0 <= chosen && chosen < expand_info->arity) {
> + expand_info->chosen_index_exists = TRUE;
> + expand_info->chosen_value_ptr =
> + &arg_vector[extra_args + chosen];
> + if (MR_arg_type_may_contain_var(functor_desc, chosen)) {
> + expand_info->chosen_type_info =
> + MR_create_type_info_maybe_existq(
> + MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(
> + type_info),
> + functor_desc->MR_du_functor_arg_types[chosen],
> + arg_vector, functor_desc);
> + } else {
> + expand_info->chosen_type_info =
> + MR_pseudo_type_info_is_ground(
> + functor_desc->MR_du_functor_arg_types[chosen]);
> + }
> + } else {
> + expand_info->chosen_index_exists = FALSE;
> + }
> +#endif /* EXPAND_CHOSEN_ARG */
> + }
> + break;
> +
> + case MR_TYPECTOR_REP_NOTAG_USEREQ:
> + expand_info->non_canonical_type = TRUE;
> + /* fall through */
> +
> + case MR_TYPECTOR_REP_NOTAG:
> + expand_info->arity = 1;
> + handle_functor_name(type_ctor_info->type_layout.layout_notag
> + ->MR_notag_functor_name);
> +
> +#ifdef EXPAND_ARGS_FIELD
> + expand_info->EXPAND_ARGS_FIELD.num_extra_args = 0;
> + expand_info->EXPAND_ARGS_FIELD.arg_values = data_word_ptr;
> + expand_info->EXPAND_ARGS_FIELD.can_free_arg_type_infos = TRUE;
> + expand_info->EXPAND_ARGS_FIELD.arg_type_infos =
> + MR_GC_NEW_ARRAY(MR_TypeInfo, 1);
> + expand_info->EXPAND_ARGS_FIELD.arg_type_infos[0] =
> + MR_create_type_info(
> + MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info),
> + type_ctor_info->type_layout.layout_notag->
> + MR_notag_functor_arg_type);
> +#endif /* EXPAND_ARGS_FIELD */
> +#ifdef EXPAND_CHOSEN_ARG
> + if (chosen == 0) {
> + expand_info->chosen_index_exists = TRUE;
> + expand_info->chosen_value_ptr = data_word_ptr;
> + expand_info->chosen_type_info =
> + MR_create_type_info(
> + MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info),
> + type_ctor_info->type_layout.layout_notag->
> + MR_notag_functor_arg_type);
> + } else {
> + expand_info->chosen_index_exists = FALSE;
> + }
> +#endif /* EXPAND_CHOSEN_ARG */
> + break;
> +
> + case MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ:
> + expand_info->non_canonical_type = TRUE;
> + /* fall through */
> +
> + case MR_TYPECTOR_REP_NOTAG_GROUND:
> + expand_info->arity = 1;
> + handle_functor_name(type_ctor_info->type_layout.layout_notag
> + ->MR_notag_functor_name);
> +
> +#ifdef EXPAND_ARGS_FIELD
> + expand_info->EXPAND_ARGS_FIELD.num_extra_args = 0;
> + expand_info->EXPAND_ARGS_FIELD.arg_values = data_word_ptr;
> + expand_info->EXPAND_ARGS_FIELD.can_free_arg_type_infos = TRUE;
> + expand_info->EXPAND_ARGS_FIELD.arg_type_infos =
> + MR_GC_NEW_ARRAY(MR_TypeInfo, 1);
> + expand_info->EXPAND_ARGS_FIELD.arg_type_infos[0] =
> + MR_pseudo_type_info_is_ground(type_ctor_info->
> + type_layout.layout_notag->MR_notag_functor_arg_type);
> +#endif /* EXPAND_ARGS_FIELD */
> +#ifdef EXPAND_CHOSEN_ARG
> + if (chosen == 0) {
> + expand_info->chosen_index_exists = TRUE;
> + expand_info->chosen_value_ptr = data_word_ptr;
> + expand_info->chosen_type_info =
> + MR_pseudo_type_info_is_ground(type_ctor_info->
> + type_layout.layout_notag->MR_notag_functor_arg_type);
> + } else {
> + expand_info->chosen_index_exists = FALSE;
> + }
> +#endif /* EXPAND_CHOSEN_ARG */
> + break;
> +
> + case MR_TYPECTOR_REP_EQUIV:
> + {
> + MR_TypeInfo eqv_type_info;
> +
> + eqv_type_info = MR_create_type_info(
> + MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info),
> + type_ctor_info->type_layout.layout_equiv);
> + EXPAND_FUNCTION_NAME(eqv_type_info, data_word_ptr,
> + EXTRA_ARGS expand_info);
> + }
> + break;
> +
> + case MR_TYPECTOR_REP_EQUIV_GROUND:
> + EXPAND_FUNCTION_NAME(MR_pseudo_type_info_is_ground(
> + type_ctor_info->type_layout.layout_equiv),
> + data_word_ptr, EXTRA_ARGS expand_info);
> + break;
> +
> + case MR_TYPECTOR_REP_EQUIV_VAR:
> + /*
> + ** The current version of the RTTI gives all such equivalence types
> + ** the EQUIV type_ctor_rep, not EQUIV_VAR.
> + */
> + MR_fatal_error("unexpected EQUIV_VAR type_ctor_rep");
> + break;
> +
> + case MR_TYPECTOR_REP_INT:
> +#ifdef EXPAND_FUNCTOR_FIELD
> + {
> + MR_Word data_word;
> + char buf[500];
> + char *str;
> +
> + data_word = *data_word_ptr;
> + sprintf(buf, "%ld", (long) data_word);
> + MR_incr_saved_hp_atomic(MR_LVALUE_CAST(MR_Word, str),
> + (strlen(buf) + sizeof(MR_Word)) / sizeof(MR_Word));
> + strcpy(str, buf);
> + expand_info->EXPAND_FUNCTOR_FIELD = str;
> + }
> +#endif /* EXPAND_FUNCTOR_FIELD */
> +
> + handle_zero_arity_args();
> + break;
> +
> + case MR_TYPECTOR_REP_CHAR:
> +#ifdef EXPAND_FUNCTOR_FIELD
> + {
> + /* XXX should escape characters correctly */
> + MR_Word data_word;
> + char *str;
> +
> + data_word = *data_word_ptr;
> + MR_incr_saved_hp_atomic(MR_LVALUE_CAST(MR_Word, str),
> + (3 + sizeof(MR_Word)) / sizeof(MR_Word));
> + sprintf(str, "\'%c\'", (char) data_word);
> + expand_info->EXPAND_FUNCTOR_FIELD = str;
> + }
> +#endif /* EXPAND_FUNCTOR_FIELD */
> +
> + handle_zero_arity_args();
> + break;
> +
> + case MR_TYPECTOR_REP_FLOAT:
> +#ifdef EXPAND_FUNCTOR_FIELD
> + {
> + MR_Word data_word;
> + char buf[500];
> + MR_Float f;
> + char *str;
> +
> + data_word = *data_word_ptr;
> + f = MR_word_to_float(data_word);
> + sprintf(buf, "%#.15g", f);
> + MR_incr_saved_hp_atomic(MR_LVALUE_CAST(MR_Word, str),
> + (strlen(buf) + sizeof(MR_Word)) / sizeof(MR_Word));
> + strcpy(str, buf);
> + expand_info->EXPAND_FUNCTOR_FIELD = str;
> + }
> +#endif /* EXPAND_FUNCTOR_FIELD */
> +
> + handle_zero_arity_args();
> + break;
> +
> + case MR_TYPECTOR_REP_STRING:
> +#ifdef EXPAND_FUNCTOR_FIELD
> + {
> + /* XXX should escape characters correctly */
> + MR_Word data_word;
> + char *str;
> +
> + data_word = *data_word_ptr;
> + MR_incr_saved_hp_atomic(MR_LVALUE_CAST(MR_Word, str),
> + (strlen((MR_String) data_word) + 2 + sizeof(MR_Word))
> + / sizeof(MR_Word));
> + sprintf(str, "%c%s%c", '"', (MR_String) data_word, '"');
> + expand_info->EXPAND_FUNCTOR_FIELD = str;
> + }
> +#endif /* EXPAND_FUNCTOR_FIELD */
> +
> + handle_zero_arity_args();
> + break;
> +
> + case MR_TYPECTOR_REP_PRED:
> + /* XXX expand_info->non_canonical_type = TRUE; */
> + handle_functor_name("<<predicate>>");
> + handle_zero_arity_args();
> + break;
> +
> + case MR_TYPECTOR_REP_TUPLE:
> + expand_info->arity = MR_TYPEINFO_GET_TUPLE_ARITY(type_info);
> + handle_functor_name("{}");
> +
> +#ifdef EXPAND_ARGS_FIELD
> + #ifdef EXPAND_APPLY_LIMIT
> + if (expand_info->arity > max_arity) {
> + expand_info->limit_reached = TRUE;
> + } else
> + #endif /* EXPAND_APPLY_LIMIT */
> + {
> + expand_info->EXPAND_ARGS_FIELD.num_extra_args = 0;
> + expand_info->EXPAND_ARGS_FIELD.arg_values =
> + (MR_Word *) *data_word_ptr;
> +
> + /*
> + ** Type-infos are normally counted from one, but
> + ** the users of this vector count from zero.
> + */
> + expand_info->EXPAND_ARGS_FIELD.arg_type_infos =
> + MR_TYPEINFO_GET_TUPLE_ARG_VECTOR(type_info) + 1;
> + }
> +#endif /* EXPAND_ARGS_FIELD */
> +#ifdef EXPAND_CHOSEN_ARG
> + if (0 <= chosen && chosen < expand_info->arity) {
> + MR_Word *arg_vector;
> +
> + arg_vector = (MR_Word *) *data_word_ptr;
> + expand_info->chosen_index_exists = TRUE;
> + expand_info->chosen_value_ptr = &arg_vector[chosen];
> + expand_info->chosen_type_info =
> + MR_TYPEINFO_GET_TUPLE_ARG_VECTOR(type_info)[chosen + 1];
> + } else {
> + expand_info->chosen_index_exists = FALSE;
> + }
> +#endif /* EXPAND_CHOSEN_ARG */
> + break;
> +
> + case MR_TYPECTOR_REP_UNIV: {
> + MR_Word data_word;
> +
> + MR_TypeInfo univ_type_info;
> + MR_Word univ_data;
> + /*
> + * Univ is a two word structure, containing
> + * type_info and data.
> + */
> + data_word = *data_word_ptr;
> + MR_unravel_univ(data_word, univ_type_info, univ_data);
> + EXPAND_FUNCTION_NAME(univ_type_info, &univ_data,
> + EXTRA_ARGS expand_info);
> + break;
> + }
> +
> + case MR_TYPECTOR_REP_VOID:
> + /*
> + ** There's no way to create values of type `void',
> + ** so this should never happen.
> + */
> + MR_fatal_error(MR_STRINGIFY(EXPAND_FUNCTION_NAME)
> + ": cannot expand void types");
> +
> + case MR_TYPECTOR_REP_C_POINTER:
> + /* XXX expand_info->non_canonical_type = TRUE; */
> + handle_functor_name("<<c_pointer>>");
> + handle_zero_arity_args();
> + break;
> +
> + case MR_TYPECTOR_REP_TYPEINFO:
> + /* XXX expand_info->non_canonical_type = TRUE; */
> + /* XXX should we return the arguments here? */
> + handle_functor_name("<<typeinfo>>");
> + handle_zero_arity_args();
> + break;
> +
> + case MR_TYPECTOR_REP_TYPECLASSINFO:
> + /* XXX expand_info->non_canonical_type = TRUE; */
> + /* XXX should we return the arguments here? */
> + handle_functor_name("<<typeclassinfo>>");
> + handle_zero_arity_args();
> + break;
> +
> + case MR_TYPECTOR_REP_ARRAY:
> + {
> + MR_ArrayType *array;
> +
> + array = (MR_ArrayType *) *data_word_ptr;
> + expand_info->arity = array->size;
> +
> + handle_functor_name("<<array>>");
> +
> +#ifdef EXPAND_ARGS_FIELD
> + #ifdef EXPAND_APPLY_LIMIT
> + if (expand_info->arity > max_arity) {
> + expand_info->limit_reached = TRUE;
> + } else
> + #endif /* EXPAND_APPLY_LIMIT */
> + {
> + MR_TypeInfoParams params;
> + int i;
> +
> + params = MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info);
> + expand_info->EXPAND_ARGS_FIELD.num_extra_args = 0;
> + expand_info->EXPAND_ARGS_FIELD.arg_values =
> + &array->elements[0];
> + expand_info->EXPAND_ARGS_FIELD.can_free_arg_type_infos =
> + TRUE;
> + expand_info->EXPAND_ARGS_FIELD.arg_type_infos =
> + MR_GC_NEW_ARRAY(MR_TypeInfo, array->size);
> + for (i = 0; i < array->size; i++) {
> + expand_info->EXPAND_ARGS_FIELD.arg_type_infos[i] =
> + params[1];
> + }
> + }
> +#endif /* EXPAND_ARGS_FIELD */
> +#ifdef EXPAND_CHOSEN_ARG
> + if (0 <= chosen && chosen < array->size) {
> + MR_TypeInfoParams params;
> +
> + params = MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info);
> + expand_info->chosen_value_ptr = &array->elements[chosen];
> + expand_info->chosen_type_info = params[1];
> + expand_info->chosen_index_exists = TRUE;
> + } else {
> + expand_info->chosen_index_exists = FALSE;
> + }
> +#endif /* EXPAND_CHOSEN_ARG */
> + }
> + break;
> +
> + case MR_TYPECTOR_REP_SUCCIP:
> + handle_functor_name("<<succip>>");
> + handle_zero_arity_args();
> + break;
> +
> + case MR_TYPECTOR_REP_HP:
> + handle_functor_name("<<hp>>");
> + handle_zero_arity_args();
> + break;
> +
> + case MR_TYPECTOR_REP_CURFR:
> + handle_functor_name("<<curfr>>");
> + handle_zero_arity_args();
> + break;
> +
> + case MR_TYPECTOR_REP_MAXFR:
> + handle_functor_name("<<maxfr>>");
> + handle_zero_arity_args();
> + break;
> +
> + case MR_TYPECTOR_REP_REDOFR:
> + handle_functor_name("<<redofr>>");
> + handle_zero_arity_args();
> + break;
> +
> + case MR_TYPECTOR_REP_REDOIP:
> + handle_functor_name("<<redoip>>");
> + handle_zero_arity_args();
> + break;
> +
> + case MR_TYPECTOR_REP_TRAIL_PTR:
> + handle_functor_name("<<trail_ptr>>");
> + handle_zero_arity_args();
> + break;
> +
> + case MR_TYPECTOR_REP_TICKET:
> + handle_functor_name("<<ticket>>");
> + handle_zero_arity_args();
> + break;
> +
> + case MR_TYPECTOR_REP_UNKNOWN: /* fallthru */
> + default:
> + MR_fatal_error(MR_STRINGIFY(EXPAND_FUNCTION_NAME)
> + ": cannot expand -- unknown data type");
> + break;
> + }
> +}
> +
> +#undef EXTRA_ARG1
> +#undef EXTRA_ARG2
> +#undef EXTRA_ARGS
> +#undef handle_functor_name
> +#undef handle_zero_arity_args
> +#undef handle_zero_arity_all_args
> +#undef handle_zero_arity_chosen_arg
> cvs diff: Diffing runtime/GETOPT
> cvs diff: Diffing runtime/machdeps
> cvs diff: Diffing samples
> cvs diff: Diffing samples/c_interface
> cvs diff: Diffing samples/c_interface/c_calls_mercury
> cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
> cvs diff: Diffing samples/c_interface/mercury_calls_c
> cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
> cvs diff: Diffing samples/c_interface/mercury_calls_fortran
> cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
> cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
> cvs diff: Diffing samples/diff
> cvs diff: Diffing samples/muz
> cvs diff: Diffing samples/rot13
> cvs diff: Diffing samples/solutions
> cvs diff: Diffing samples/tests
> cvs diff: Diffing samples/tests/c_interface
> cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
> cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
> cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
> cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
> cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
> cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
> cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
> cvs diff: Diffing samples/tests/diff
> cvs diff: Diffing samples/tests/muz
> cvs diff: Diffing samples/tests/rot13
> cvs diff: Diffing samples/tests/solutions
> cvs diff: Diffing samples/tests/toplevel
> cvs diff: Diffing scripts
> cvs diff: Diffing tests
> cvs diff: Diffing tests/benchmarks
> cvs diff: Diffing tests/debugger
> cvs diff: Diffing tests/debugger/declarative
> cvs diff: Diffing tests/dppd
> cvs diff: Diffing tests/general
> cvs diff: Diffing tests/general/accumulator
> cvs diff: Diffing tests/general/structure_reuse
> cvs diff: Diffing tests/hard_coded
> Index: tests/hard_coded/Mmakefile
> ===================================================================
> RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
> retrieving revision 1.120
> diff -u -b -r1.120 Mmakefile
> --- tests/hard_coded/Mmakefile 2001/05/31 09:11:29 1.120
> +++ tests/hard_coded/Mmakefile 2001/06/12 16:45:16
> @@ -28,6 +28,7 @@
> cut_test \
> cycles \
> cycles2 \
> + deconstruct_arg \
> deep_copy \
> deep_copy_bug \
> deep_copy_exist \
> Index: tests/hard_coded/deconstruct_arg.exp
> ===================================================================
> RCS file: deconstruct_arg.exp
> diff -N deconstruct_arg.exp
> --- /dev/null Fri Dec 1 02:25:58 2000
> +++ deconstruct_arg.exp Wed Jun 13 02:45:16 2001
> @@ -0,0 +1,162 @@
> +apple/1
> +argument 0 of apple([]) is []
> +argument 1 of apple([]) doesn't exist
> +argument 2 of apple([]) doesn't exist
> +deconstruct: functor apple arity 1
> +[[]]
> +limited deconstruct 3 of apple([])
> +functor apple arity 1 [[]]
> +
> +apple/1
> +argument 0 of apple([9, 5, 1]) is [9, 5, 1]
> +argument 1 of apple([9, 5, 1]) doesn't exist
> +argument 2 of apple([9, 5, 1]) doesn't exist
> +deconstruct: functor apple arity 1
> +[[9, 5, 1]]
> +limited deconstruct 3 of apple([9, 5, 1])
> +functor apple arity 1 [[9, 5, 1]]
> +
> +zop/2
> +argument 0 of zop(3.30000000000000, 2.03000000000000) is 3.30000000000000
> +argument 1 of zop(3.30000000000000, 2.03000000000000) is 2.03000000000000
> +argument 2 of zop(3.30000000000000, 2.03000000000000) doesn't exist
> +deconstruct: functor zop arity 2
> +[3.30000000000000, 2.03000000000000]
> +limited deconstruct 3 of zop(3.30000000000000, 2.03000000000000)
> +functor zop arity 2 [3.30000000000000, 2.03000000000000]
> +
> +zap/3
> +argument 0 of zap(50, 51.0000000000000, 52) is 50
> +argument 1 of zap(50, 51.0000000000000, 52) is 51.0000000000000
> +argument 2 of zap(50, 51.0000000000000, 52) is 52
> +deconstruct: functor zap arity 3
> +[50, 51.0000000000000, 52]
> +limited deconstruct 3 of zap(50, 51.0000000000000, 52)
> +functor zap arity 3 [50, 51.0000000000000, 52]
> +
> +zip/4
> +argument 0 of zip(50, 51, 52, 53) is 50
> +argument 1 of zip(50, 51, 52, 53) is 51
> +argument 2 of zip(50, 51, 52, 53) is 52
> +deconstruct: functor zip arity 4
> +[50, 51, 52, 53]
> +limited deconstruct 3 of zip(50, 51, 52, 53)
> +failed
> +
> +wombat/0
> +argument 0 of wombat doesn't exist
> +argument 1 of wombat doesn't exist
> +argument 2 of wombat doesn't exist
> +deconstruct: functor wombat arity 0
> +[]
> +limited deconstruct 3 of wombat
> +functor wombat arity 0 []
> +
> +qwerty/1
> +argument 0 of qwerty(5) is 5
> +argument 1 of qwerty(5) doesn't exist
> +argument 2 of qwerty(5) doesn't exist
> +deconstruct: functor qwerty arity 1
> +[5]
> +limited deconstruct 3 of qwerty(5)
> +functor qwerty arity 1 [5]
> +
> +'a'/0
> +argument 0 of a doesn't exist
> +argument 1 of a doesn't exist
> +argument 2 of a doesn't exist
> +deconstruct: functor 'a' arity 0
> +[]
> +limited deconstruct 3 of a
> +functor 'a' arity 0 []
> +
> +3.14159000000000/0
> +argument 0 of 3.14159000000000 doesn't exist
> +argument 1 of 3.14159000000000 doesn't exist
> +argument 2 of 3.14159000000000 doesn't exist
> +deconstruct: functor 3.14159000000000 arity 0
> +[]
> +limited deconstruct 3 of 3.14159000000000
> +functor 3.14159000000000 arity 0 []
> +
> +4/0
> +argument 0 of 4 doesn't exist
> +argument 1 of 4 doesn't exist
> +argument 2 of 4 doesn't exist
> +deconstruct: functor 4 arity 0
> +[]
> +limited deconstruct 3 of 4
> +functor 4 arity 0 []
> +
> +univ_cons/1
> +argument 0 of ["hi! I\'m a univ!"] is ["hi! I\'m a univ!"]
> +argument 1 of ["hi! I\'m a univ!"] doesn't exist
> +argument 2 of ["hi! I\'m a univ!"] doesn't exist
> +deconstruct: functor univ_cons arity 1
> +[["hi! I\'m a univ!"]]
> +limited deconstruct 3 of ["hi! I\'m a univ!"]
> +functor univ_cons arity 1 [["hi! I\'m a univ!"]]
> +
> +<<predicate>>/0
> +argument 0 of '<<predicate>>' doesn't exist
> +argument 1 of '<<predicate>>' doesn't exist
> +argument 2 of '<<predicate>>' doesn't exist
> +deconstruct: functor <<predicate>> arity 0
> +[]
> +limited deconstruct 3 of '<<predicate>>'
> +functor <<predicate>> arity 0 []
> +
> +{}/2
> +argument 0 of {1, 'b'} is 1
> +argument 1 of {1, 'b'} is 'b'
> +argument 2 of {1, 'b'} doesn't exist
> +deconstruct: functor {} arity 2
> +[1, 'b']
> +limited deconstruct 3 of {1, 'b'}
> +functor {} arity 2 [1, 'b']
> +
> +{}/3
> +argument 0 of {1, 'b', "third"} is 1
> +argument 1 of {1, 'b', "third"} is 'b'
> +argument 2 of {1, 'b', "third"} is "third"
> +deconstruct: functor {} arity 3
> +[1, 'b', "third"]
> +limited deconstruct 3 of {1, 'b', "third"}
> +functor {} arity 3 [1, 'b', "third"]
> +
> +{}/4
> +argument 0 of {1, 'b', "third", {1, 2, 3, 4}} is 1
> +argument 1 of {1, 'b', "third", {1, 2, 3, 4}} is 'b'
> +argument 2 of {1, 'b', "third", {1, 2, 3, 4}} is "third"
> +deconstruct: functor {} arity 4
> +[1, 'b', "third", {1, 2, 3, 4}]
> +limited deconstruct 3 of {1, 'b', "third", {1, 2, 3, 4}}
> +failed
> +
> +<<array>>/2
> +argument 0 of array([1000, 2000]) is 1000
> +argument 1 of array([1000, 2000]) is 2000
> +argument 2 of array([1000, 2000]) doesn't exist
> +deconstruct: functor <<array>> arity 2
> +[1000, 2000]
> +limited deconstruct 3 of array([1000, 2000])
> +functor <<array>> arity 2 [1000, 2000]
> +
> +<<array>>/3
> +argument 0 of array([100, 200, 300]) is 100
> +argument 1 of array([100, 200, 300]) is 200
> +argument 2 of array([100, 200, 300]) is 300
> +deconstruct: functor <<array>> arity 3
> +[100, 200, 300]
> +limited deconstruct 3 of array([100, 200, 300])
> +functor <<array>> arity 3 [100, 200, 300]
> +
> +<<array>>/4
> +argument 0 of array([10, 20, 30, 40]) is 10
> +argument 1 of array([10, 20, 30, 40]) is 20
> +argument 2 of array([10, 20, 30, 40]) is 30
> +deconstruct: functor <<array>> arity 4
> +[10, 20, 30, 40]
> +limited deconstruct 3 of array([10, 20, 30, 40])
> +failed
> +
> Index: tests/hard_coded/deconstruct_arg.m
> ===================================================================
> RCS file: deconstruct_arg.m
> diff -N deconstruct_arg.m
> --- /dev/null Fri Dec 1 02:25:58 2000
> +++ deconstruct_arg.m Wed Jun 13 02:45:16 2001
> @@ -0,0 +1,125 @@
> +% Test case for deconstruct and arg
> +%
> +% Author: zs
> +
> +:- module deconstruct_arg.
> +:- interface.
> +:- import_module io.
> +
> +:- pred main(io__state::di, io__state::uo) is det.
> +
> +:- implementation.
> +
> +:- import_module array, list, string, std_util.
> +
> +:- pred test_all(T::in, io__state::di, io__state::uo) is det.
> +:- pred test_functor(T::in, io__state::di, io__state::uo) is det.
> +:- pred test_arg(T::in, int::in, io__state::di, io__state::uo) is det.
> +:- pred test_deconstruct(T::in, io__state::di, io__state::uo) is det.
> +:- pred test_limited_deconstruct(T::in, int::in, io__state::di, io__state::uo)
> + is det.
> +:- pred newline(io__state::di, io__state::uo) is det.
> +
> +:- type enum ---> one ; two ; three.
> +
> +:- type fruit ---> apple(list(int))
> + ; banana(list(enum)).
> +
> +:- type thingie ---> foo ; bar(int) ; bar(int, int) ; qux(int) ;
> + quux(int) ; quuux(int, int) ; wombat ;
> + zoom(int) ; zap(int, float, int) ;
> + zip(int, int, int, int) ; zop(float, float).
> +
> +:- type poly(A, B) ---> poly_one(A) ; poly_two(B) ;
> + poly_three(B, A, poly(B, A)).
> +
> +:- type no_tag ---> qwerty(int).
> +
> +main -->
> + % test enumerations
> + % test_all(one), newline,
> + % test primary tags
> + test_all(apple([])), newline,
> + test_all(apple([9,5,1])), newline,
> + % test remote secondary tags
> + test_all(zop(3.3, 2.03)), newline,
> + test_all(zap(50, 51.0, 52)), newline,
> + test_all(zip(50, 51, 52, 53)), newline,
> + % test local secondary tags
> + test_all(wombat), newline,
> + % test notag
> + test_all(qwerty(5)), newline,
> + % test characters
> + test_all('a'), newline,
> + % test floats
> + test_all(3.14159), newline,
> + % test integers
> + test_all(4), newline,
> + % test univ.
> + { type_to_univ(["hi! I'm a univ!"], Univ) },
> + test_all(Univ), newline,
> + % test predicates
> + test_all(newline), newline,
> + % test tuples
> + test_all({1, 'b'}), newline,
> + test_all({1, 'b', "third"}), newline,
> + test_all({1, 'b', "third", {1,2,3,4}}), newline,
> + % test arrays
> + test_all(array([1000, 2000])), newline,
> + test_all(array([100, 200, 300])), newline,
> + test_all(array([10, 20, 30, 40])), newline.
> +
> +test_all(T) -->
> + test_functor(T),
> + test_arg(T, 0),
> + test_arg(T, 1),
> + test_arg(T, 2),
> + test_deconstruct(T),
> + test_limited_deconstruct(T, 3).
> +
> +test_functor(T) -->
> + { functor(T, Functor, Arity) },
> + io__write_string(Functor),
> + io__write_string("/"),
> + io__write_int(Arity),
> + io__write_string("\n").
> +
> +test_arg(T, ArgNum) -->
> + { string__format("argument %d of ", [i(ArgNum)], Str) },
> + io__write_string(Str),
> + io__print(T),
> + ( { Argument = argument(T, ArgNum) } ->
> + io__write_string(" is "),
> + io__write_univ(Argument),
> + io__write_string("\n")
> + ;
> + io__write_string(" doesn't exist\n")
> + ).
> +
> +test_deconstruct(T) -->
> + { deconstruct(T, Functor, Arity, Arguments) },
> + { string__format("deconstruct: functor %s arity %d\n",
> + [s(Functor), i(Arity)], Str) },
> + io__write_string(Str),
> + io__write_string("["),
> + io__write_list(Arguments, ", ", io__print),
> + io__write_string("]\n").
> +
> +test_limited_deconstruct(T, Limit) -->
> + { string__format("limited deconstruct %d of ", [i(Limit)], Str) },
> + io__write_string(Str),
> + io__print(T),
> + io__write_string("\n"),
> + ( { limited_deconstruct(T, Limit, Functor, Arity, Arguments) } ->
> + { string__format("functor %s arity %d ",
> + [s(Functor), i(Arity)], Str2) },
> + io__write_string(Str2),
> + io__write_string("["),
> + io__write_list(Arguments, ", ", io__print),
> + io__write_string("]\n")
> + ;
> + io__write_string("failed\n")
> + ).
> +
> +newline -->
> + io__write_char('\n').
> cvs diff: Diffing tests/hard_coded/exceptions
> cvs diff: Diffing tests/hard_coded/purity
> cvs diff: Diffing tests/hard_coded/sub-modules
> cvs diff: Diffing tests/hard_coded/typeclasses
> cvs diff: Diffing tests/invalid
> cvs diff: Diffing tests/invalid/purity
> cvs diff: Diffing tests/misc_tests
> cvs diff: Diffing tests/tabling
> cvs diff: Diffing tests/term
> cvs diff: Diffing tests/valid
> cvs diff: Diffing tests/warnings
> cvs diff: Diffing tools
> cvs diff: Diffing trace
> cvs diff: Diffing util
> --------------------------------------------------------------------------
> 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
> --------------------------------------------------------------------------
To be continued ...
Cheers,
Mark.
--------------------------------------------------------------------------
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