[m-rev.] for review: field names and higher order values in the debugger
Zoltan Somogyi
zs at cs.mu.OZ.AU
Wed Dec 19 17:41:18 AEDT 2001
On 19-Dec-2001, Fergus Henderson <fjh at cs.mu.OZ.AU> wrote:
> It would be better to handle those as two separate changes.
Here is the log message and diff on the field names part of the change.
I'll commit this now.
Estimated hours taken: 8
Branches: main
Allow the browser to refer to fields by name.
browser/browser_info.m:
Generalize the data structure for recording paths within terms to allow
navigation by field names.
browser/browse.m:
browser/program_representation.m:
Update the algorithms for navigation in terms accordingly.
browser/parse.m:
Update the algorithm for reading in navigation terms.
Allow digits as well as letters and underscores in "names", since
field names may contain digits as well. This should not impact
other uses of names by the other parts of the debugger.
library/std_util.m:
Add new predicates named_argument and det_named_argument. They are
implemented using ML_named_arg, a new C function which is the same
as ML_arg except that it specifies the selected argument by name.
NEWS:
Mention the new predicates.
runtime/mercury_ml_expand_body.h:
Add a new alternative, EXPAND_NAMED_ARG, for use in implementing
ML_named_arg.
tests/debugger/field_names.{m,inp,exp,exp2}:
Expand this test case to exercise the browser.
tests/hard_coded/deconstruct_arg.exp:
tests/hard_coded/existential_float.exp:
tests/hard_coded/expand.exp:
tests/hard_coded/write.exp:
tests/hard_coded/write_reg1.exp:
Update the expected output to reflect that we now get more information
from deconstructing higher order values.
Zoltan.
cvs diff: Diffing .
Index: NEWS
===================================================================
RCS file: /home/mercury1/repository/mercury/NEWS,v
retrieving revision 1.232
diff -u -b -r1.232 NEWS
--- NEWS 2001/12/19 02:54:13 1.232
+++ NEWS 2001/12/19 04:46:54
@@ -125,6 +125,10 @@
`std_util__map_maybe/2' to apply a predicate or a function to
a value stored in a term of type `std_util__maybe'.
+* We've added two predicates, named_argument and det_named_argument, to
+ std_util.m. These are analogous to argument and det_argument, but specify
+ the desired argument by its name, not its position.
+
* We've added a predicate version of `set__fold'.
* We've added function versions of `builtin__unsafe_promise_unique',
@@ -145,16 +149,19 @@
Changes to the Mercury implementation:
-* We've added a 'view' command to `mdb', which opens a `vim' window and
- in it displays the current source location, updated at each event. This
- requires X11 and a version of `vim' with the `clientserver' feature
- enabled.
+* You can now navigate terms in the debugger by argument name as well as by
+ argument number.
* The Mercury compiler can now perform smart recompilation, enabled by the
`--smart-recompilation' option. With smart recompilation, when the
interface of a module changes, only modules which use the changed
declarations are recompiled. Smart recompilation does not yet work
with `--intermodule-optimization'.
+
+* We've added a 'view' command to `mdb', which opens a `vim' window and
+ in it displays the current source location, updated at each event. This
+ requires X11 and a version of `vim' with the `clientserver' feature
+ enabled.
* We've fixed a long-standing bug in the handling of module imports.
Previously, if `module1' imported `module2' which imported `module3' in
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.21
diff -u -b -r1.21 browse.m
--- browser/browse.m 2001/06/22 08:28:55 1.21
+++ browser/browse.m 2001/12/19 04:15:16
@@ -671,9 +671,13 @@
{ Dir = parent },
write_string_debugger(Debugger, "/")
;
- { Dir = child(N) },
+ { Dir = child_num(N) },
write_string_debugger(Debugger, "/"),
write_int_debugger(Debugger, N)
+ ;
+ { Dir = child_name(Name) },
+ write_string_debugger(Debugger, "/"),
+ write_string_debugger(Debugger, Name)
).
write_path(Debugger, [Dir, Dir2 | Dirs]) -->
write_path_2(Debugger, [Dir, Dir2 | Dirs]).
@@ -688,9 +692,13 @@
{ Dir = parent },
write_string_debugger(Debugger, "/..")
;
- { Dir = child(N) },
+ { Dir = child_num(N) },
write_string_debugger(Debugger, "/"),
write_int_debugger(Debugger, N)
+ ;
+ { Dir = child_name(Name) },
+ write_string_debugger(Debugger, "/"),
+ write_string_debugger(Debugger, Name)
).
write_path_2(Debugger, [Dir, Dir2 | Dirs]) -->
(
@@ -698,10 +706,15 @@
write_string_debugger(Debugger, "/.."),
write_path_2(Debugger, [Dir2 | Dirs])
;
- { Dir = child(N) },
+ { Dir = child_num(N) },
write_string_debugger(Debugger, "/"),
write_int_debugger(Debugger, N),
write_path_2(Debugger, [Dir2 | Dirs])
+ ;
+ { Dir = child_name(Name) },
+ write_string_debugger(Debugger, "/"),
+ write_string_debugger(Debugger, Name),
+ write_path_2(Debugger, [Dir2 | Dirs])
).
% We assume a root-relative path. We assume Term is the entire term
@@ -709,44 +722,41 @@
:- pred deref_subterm(univ, list(dir), univ) is semidet.
:- mode deref_subterm(in, in, out) is semidet.
deref_subterm(Univ, Path, SubUniv) :-
- path_to_int_list(Path, PathN),
- deref_subterm_2(Univ, PathN, SubUniv).
-
-:- pred path_to_int_list(list(dir), list(int)).
-:- mode path_to_int_list(in, out) is semidet.
-path_to_int_list(Path, Ints) :-
- simplify_dirs(Path, NewPath),
- dirs_to_ints(NewPath, Ints).
-
-:- pred dirs_to_ints(list(dir), list(int)).
-:- mode dirs_to_ints(in, out) is semidet.
-dirs_to_ints([], []).
-dirs_to_ints([child(N) | Dirs], [N | Ns]) :-
- dirs_to_ints(Dirs, Ns).
-dirs_to_ints([parent | _], _) :-
- error("dirs_to_ints: software error").
+ simplify_dirs(Path, SimplifiedPath),
+ deref_subterm_2(Univ, SimplifiedPath, SubUniv).
-:- pred deref_subterm_2(univ, list(int), univ) is semidet.
+:- pred deref_subterm_2(univ, list(dir), univ) is semidet.
:- mode deref_subterm_2(in, in, out) is semidet.
deref_subterm_2(Univ, Path, SubUniv) :-
- ( Path = [] ->
+ (
+ Path = [],
Univ = SubUniv
;
- Path = [N | Ns],
+ Path = [Dir | Dirs],
+ (
+ Dir = child_num(N),
(
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.
+ % The first element of an array is at
+ % index zero.
ArgN = argument(univ_value(Univ), N)
;
% The first argument of a non-array is numbered
% argument 1 by the user but argument 0 by
% std_util:argument.
ArgN = argument(univ_value(Univ), N - 1)
+ )
+ ;
+ Dir = child_name(Name),
+ ArgN = named_argument(univ_value(Univ), Name)
+ ;
+ Dir = parent,
+ error("deref_subterm_2: found parent")
),
- deref_subterm_2(ArgN, Ns, SubUniv)
+ deref_subterm_2(ArgN, Dirs, SubUniv)
).
%---------------------------------------------------------------------------%
@@ -854,9 +864,11 @@
names_to_dirs(Names, RestDirs)
; Name = "." ->
names_to_dirs(Names, Dirs)
+ ; string__to_int(Name, Num) ->
+ Dirs = [child_num(Num) | RestDirs],
+ names_to_dirs(Names, RestDirs)
;
- string__to_int(Name, Num),
- Dirs = [child(Num) | RestDirs],
+ Dirs = [child_name(Name) | RestDirs],
names_to_dirs(Names, RestDirs)
).
@@ -901,11 +913,17 @@
:- pred simplify(list(dir), list(dir)).
:- mode simplify(in, out) is det.
simplify([], []).
-simplify([parent | Dirs], Dirs).
-simplify([child(Dir)], [child(Dir)]).
-simplify([child(_Dir), parent | Dirs], Dirs).
-simplify([child(Dir1), child(Dir2) | Dirs], [child(Dir1) | Rest]) :-
- simplify([child(Dir2) | Dirs], Rest).
+simplify([First | Rest], Simplified) :-
+ ( First = parent ->
+ Simplified = Rest
+ ; Rest = [] ->
+ Simplified = [First]
+ ; Rest = [parent | Tail] ->
+ Simplified = Tail
+ ;
+ simplify(Rest, SimplifiedRest),
+ Simplified = [First | SimplifiedRest]
+ ).
%---------------------------------------------------------------------------%
Index: browser/browser_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/browser_info.m,v
retrieving revision 1.4
diff -u -b -r1.4 browser_info.m
--- browser/browser_info.m 2001/05/29 17:23:50 1.4
+++ browser/browser_info.m 2001/12/19 04:15:16
@@ -39,7 +39,8 @@
:- type dir
---> parent
- ; child(int).
+ ; child_num(int)
+ ; child_name(string).
% The browser is required to behave differently for different
% caller circumstances. The following type enumerates the
Index: browser/parse.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/parse.m,v
retrieving revision 1.12
diff -u -b -r1.12 parse.m
--- browser/parse.m 2001/12/17 06:14:46 1.12
+++ browser/parse.m 2001/12/19 04:15:16
@@ -133,9 +133,7 @@
parse__read_command_external(Comm) -->
io__read(Result),
- (
- { Result = ok(external_request(StringToParse)) }
- ->
+ ( { Result = ok(external_request(StringToParse)) } ->
{ string__to_char_list(StringToParse, Cs) },
{ lexer(Cs, Tokens) },
( { parse(Tokens, Comm2) } ->
@@ -221,7 +219,7 @@
:- pred lexer_name(char, list(char), list(token)).
:- mode lexer_name(in, in, out) is det.
lexer_name(C, Cs, Toks) :-
- list__takewhile(char__is_alpha_or_underscore, Cs, Letters, Rest),
+ list__takewhile(char__is_alnum_or_underscore, Cs, Letters, Rest),
string__from_char_list([C | Letters], Name),
lexer(Rest, Toks2),
Toks = [name(Name) | Toks2].
@@ -306,7 +304,11 @@
parse_dirs([Tok | Toks], Dirs) :-
(
Tok = num(Subdir),
- Dirs = [child(Subdir) | RestDirs],
+ Dirs = [child_num(Subdir) | RestDirs],
+ parse_dirs(Toks, RestDirs)
+ ;
+ Tok = name(NamedSubdir),
+ Dirs = [child_name(NamedSubdir) | RestDirs],
parse_dirs(Toks, RestDirs)
;
Tok = (..),
@@ -410,8 +412,12 @@
:- mode show_dirs(in, di, uo) is det.
show_dirs([]) -->
io__nl.
-show_dirs([child(Num) | Dirs]) -->
+show_dirs([child_num(Num) | Dirs]) -->
io__write_int(Num),
+ io__write_string("/"),
+ show_dirs(Dirs).
+show_dirs([child_name(Name) | Dirs]) -->
+ io__write_string(Name),
io__write_string("/"),
show_dirs(Dirs).
show_dirs([parent | Dirs]) -->
Index: browser/program_representation.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/program_representation.m,v
retrieving revision 1.5
diff -u -b -r1.5 program_representation.m
--- browser/program_representation.m 2001/04/23 16:26:27 1.5
+++ browser/program_representation.m 2001/12/19 04:15:16
@@ -208,8 +208,10 @@
path_step_from_string_2('l', "", later).
convert_dirs_to_term_path([], []).
-convert_dirs_to_term_path([child(N) | Dirs], [N | TermPath]) :-
+convert_dirs_to_term_path([child_num(N) | Dirs], [N | TermPath]) :-
convert_dirs_to_term_path(Dirs, TermPath).
+convert_dirs_to_term_path([child_name(_) | _], _) :-
+ error("convert_dirs_to_term_path: not in canonical form").
convert_dirs_to_term_path([parent | _], _) :-
error("convert_dirs_to_term_path: not in canonical form").
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.249
diff -u -b -r1.249 std_util.m
--- library/std_util.m 2001/12/19 04:04:19 1.249
+++ library/std_util.m 2001/12/19 04:15:16
@@ -582,6 +582,14 @@
:- func arg(T::in, int::in) = (ArgT::out) is semidet.
:- func argument(T::in, int::in) = (univ::out) is semidet.
+ % named_argument(Data, ArgumentName) = ArgumentUniv
+ %
+ % Same as argument/2, except the chosen argument is specified by giving
+ % its name rather than its position. If Data has no argument with that
+ % name, named_argument fails.
+ %
+:- func named_argument(T::in, string::in) = (univ::out) is semidet.
+
% det_arg(Data, ArgumentIndex) = Argument
% det_argument(Data, ArgumentIndex) = ArgumentUniv
%
@@ -592,6 +600,13 @@
:- func det_arg(T::in, int::in) = (ArgT::out) is det.
:- func det_argument(T::in, int::in) = (univ::out) is det.
+ % det_named_argument(Data, ArgumentName) = ArgumentUniv
+ %
+ % Same as named_argument/2, except that for cases where
+ % named_argument/2 would fail, det_named_argument/2 will abort.
+ %
+:- func det_named_argument(T::in, string::in) = (univ::out) is det.
+
% deconstruct(Data, Functor, Arity, Arguments)
%
% Given a data item (Data), binds Functor to a string
@@ -3133,6 +3148,10 @@
MR_Word *data_word_ptr, int chosen,
ML_Expand_Chosen_Arg_Only_Info *expand_info);
+extern void ML_expand_named_arg_only(MR_TypeInfo type_info,
+ MR_Word *data_word_ptr, MR_ConstString chosen_name,
+ ML_Expand_Chosen_Arg_Only_Info *expand_info);
+
/*
** NB. ML_arg() is also used by arg_ref and new_arg_ref
** in store.m, in trace/mercury_trace_vars.m, and in
@@ -3141,6 +3160,10 @@
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_named_arg(MR_TypeInfo type_info, MR_Word *term,
+ MR_ConstString arg_name, MR_TypeInfo *arg_type_info_ptr,
+ MR_Word **argument_ptr);
+
/*
** NB. ML_named_arg_num() is used in mercury_trace_vars.c.
*/
@@ -3262,6 +3285,14 @@
#undef EXPAND_TYPE_NAME
#undef EXPAND_CHOSEN_ARG
+#define EXPAND_FUNCTION_NAME ML_expand_named_arg_only
+#define EXPAND_TYPE_NAME ML_Expand_Chosen_Arg_Only_Info
+#define EXPAND_NAMED_ARG
+#include ""mercury_ml_expand_body.h""
+#undef EXPAND_FUNCTION_NAME
+#undef EXPAND_TYPE_NAME
+#undef EXPAND_NAMED_ARG
+
/*
** ML_arg() is a subroutine used to implement arg/2, argument/2,
** and also store__arg_ref/5 in store.m.
@@ -3293,6 +3324,35 @@
}
/*
+** ML_named_arg() is a subroutine used to implement named_arg/2.
+** It takes the address of a term, its type, and an argument name.
+** If an argument with that name exists, it succeeds and returns the address
+** of the argument, and its type; 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_named_arg(MR_TypeInfo type_info, MR_Word *term_ptr, MR_ConstString arg_name,
+ MR_TypeInfo *arg_type_info_ptr, MR_Word **arg_ptr)
+{
+ ML_Expand_Chosen_Arg_Only_Info expand_info;
+
+ ML_expand_named_arg_only(type_info, term_ptr, arg_name, &expand_info);
+ ML_abort_if_type_is_noncanonical(expand_info, ""named_argument/2"");
+
+ /* Check range */
+ 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 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;
@@ -3536,6 +3596,30 @@
SUCCESS_INDICATOR = success;
}").
+:- pragma foreign_proc("C",
+ named_argument(Term::in, ArgumentName::in) = (ArgumentUniv::out),
+ [will_not_call_mercury], "
+{
+ MR_TypeInfo type_info;
+ MR_TypeInfo arg_type_info;
+ MR_Word *argument_ptr;
+ bool success;
+
+ type_info = (MR_TypeInfo) TypeInfo_for_T;
+
+ MR_save_transient_registers();
+ success = ML_named_arg(type_info, &Term, (MR_ConstString) ArgumentName,
+ &arg_type_info, &argument_ptr);
+ MR_restore_transient_registers();
+
+ if (success) {
+ /* Allocate enough room for a univ */
+ MR_new_univ_on_hp(ArgumentUniv, arg_type_info, *argument_ptr);
+ }
+
+ SUCCESS_INDICATOR = success;
+}").
+
:- pragma foreign_proc("MC++", functor(_Term::in, _Functor::out, _Arity::out),
will_not_call_mercury, "
{
@@ -3565,10 +3649,17 @@
SUCCESS_INDICATOR = false;
}").
+:- pragma foreign_proc("C#",
+ named_argument(_Term::in, _ArgumentName::in) = (_ArgumentUniv::out),
+ [will_not_call_mercury], "
+{
+ mercury.runtime.Errors.SORRY(""foreign code for argument"");
+ // XXX this is required to keep the C# compiler quiet
+ SUCCESS_INDICATOR = false;
+}").
+
det_arg(Type, ArgumentIndex) = Argument :-
- (
- arg(Type, ArgumentIndex) = Argument0
- ->
+ ( arg(Type, ArgumentIndex) = Argument0 ->
Argument = Argument0
;
( argument(Type, ArgumentIndex) = _ArgumentUniv ->
@@ -3579,12 +3670,17 @@
).
det_argument(Type, ArgumentIndex) = Argument :-
- (
- argument(Type, ArgumentIndex) = Argument0
- ->
+ ( argument(Type, ArgumentIndex) = Argument0 ->
Argument = Argument0
;
error("det_argument: argument out of range")
+ ).
+
+det_named_argument(Type, ArgumentName) = Argument :-
+ ( named_argument(Type, ArgumentName) = Argument0 ->
+ Argument = Argument0
+ ;
+ error("det_named_argument: no argument with that name")
).
:- pragma foreign_proc("C",
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
Index: runtime/mercury_ml_expand_body.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_ml_expand_body.h,v
retrieving revision 1.3
diff -u -b -r1.3 mercury_ml_expand_body.h
--- runtime/mercury_ml_expand_body.h 2001/10/24 07:43:24 1.3
+++ runtime/mercury_ml_expand_body.h 2001/12/19 06:37:55
@@ -40,9 +40,18 @@
** 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.
+** argument, chosen, which specifies the position of
+** the one desired argument (with the first argument
+** having position 0), and the function will fill in
+** the fields of the ML_Expand_Chosen_Arg_Only
+** structure.
**
+** EXPAND_NAMED_ARG If defined, the function will have an extra
+** argument, chosen_name, which specifies the name
+** of the one desired argument, and the function 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
@@ -51,7 +60,8 @@
**
** Most combinations are allowed, but
**
-** - only one of EXPAND_ARGS_FIELD and EXPAND_CHOSEN_ARG may be defined at once
+** - only one of EXPAND_ARGS_FIELD, EXPAND_CHOSEN_ARG and EXPAND_NAMED_ARG
+** may be defined at once, and
** - EXPAND_APPLY_LIMIT should be defined only if EXPAND_ARGS_FIELD is also
** defined.
**
@@ -82,7 +92,7 @@
** 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
+** freed, since they point to 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
@@ -95,7 +105,7 @@
** 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
+** 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.
*/
@@ -117,9 +127,20 @@
#define EXTRA_ARG2 chosen,
#else
#define EXTRA_ARG2
+#endif
+#ifdef EXPAND_NAMED_ARG
+ #define EXTRA_ARG3 chosen_name,
+#else
+ #define EXTRA_ARG3
#endif
-#define EXTRA_ARGS EXTRA_ARG1 EXTRA_ARG2
+#define EXTRA_ARGS EXTRA_ARG1 EXTRA_ARG2 EXTRA_ARG3
+#if defined(EXPAND_CHOSEN_ARG) || defined(EXPAND_NAMED_ARG)
+ #define EXPAND_ONE_ARG
+#else /* defined(EXPAND_CHOSEN_ARG) || defined(EXPAND_NAMED_ARG) */
+ #undef EXPAND_ONE_ARG
+#endif /* defined(EXPAND_CHOSEN_ARG) || defined(EXPAND_NAMED_ARG) */
+
/* set up macro for setting field names without #ifdefs */
#ifdef EXPAND_FUNCTOR_FIELD
#define handle_functor_name(name) \
@@ -146,21 +167,21 @@
((void) 0)
#endif /* EXPAND_ARGS_FIELD */
-#ifdef EXPAND_CHOSEN_ARG
- #define handle_zero_arity_chosen_arg() \
+#ifdef EXPAND_ONE_ARG
+ #define handle_zero_arity_one_arg() \
do { \
expand_info->chosen_index_exists = FALSE; \
} while (0)
-#else /* EXPAND_CHOSEN_ARG */
- #define handle_zero_arity_chosen_arg() \
+#else /* EXPAND_ONE_ARG */
+ #define handle_zero_arity_one_arg() \
((void) 0)
-#endif /* EXPAND_CHOSEN_ARG */
+#endif /* EXPAND_ONE_ARG */
#define handle_zero_arity_args() \
do { \
expand_info->arity = 0; \
handle_zero_arity_all_args(); \
- handle_zero_arity_chosen_arg(); \
+ handle_zero_arity_one_arg(); \
} while (0)
/***********************************************************************/
@@ -173,10 +194,22 @@
#ifdef EXPAND_CHOSEN_ARG
int chosen,
#endif /* EXPAND_CHOSEN_ARG */
+#ifdef EXPAND_NAMED_ARG
+ MR_ConstString chosen_name,
+#endif /* EXPAND_NAMED_ARG */
EXPAND_TYPE_NAME *expand_info)
{
MR_TypeCtorInfo type_ctor_info;
MR_DuTypeLayout du_type_layout;
+#ifdef EXPAND_NAMED_ARG
+ /*
+ ** No arm of the switch on type_ctor_rep handles named arguments by
+ ** default. Only those type_ctor_reps that support named arguments
+ ** need have code for searching for argument names. For the rest,
+ ** initializing chosen to -1 ensures that no argument will be returned.
+ */
+ int chosen = -1;
+#endif /* EXPAND_NAMED_ARG */
type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
expand_info->non_canonical_type = FALSE;
@@ -230,10 +263,13 @@
** the symbolic reserved addresses.
*/
for (i = 0; i < ra_layout->MR_ra_num_res_symbolic_addrs; i++) {
- if (data == (MR_Word) ra_layout->MR_ra_res_symbolic_addrs[i]) {
- int offset = i + ra_layout->MR_ra_num_res_numeric_addrs;
- handle_functor_name(ra_layout->MR_ra_constants[offset]->
- MR_ra_functor_name);
+ if (data == (MR_Word) ra_layout->
+ MR_ra_res_symbolic_addrs[i])
+ {
+ int offset;
+ offset = i + ra_layout->MR_ra_num_res_numeric_addrs;
+ handle_functor_name(ra_layout->
+ MR_ra_constants[offset]->MR_ra_functor_name);
handle_zero_arity_args();
/* "break" here would just exit the "for" loop */
return;
@@ -311,7 +347,7 @@
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)
+#if defined(EXPAND_ARGS_FIELD) || defined(EXPAND_ONE_ARG)
exist_info = functor_desc->MR_du_functor_exist_info;
if (exist_info != NULL) {
extra_args = exist_info->MR_exist_typeinfos_plain
@@ -319,7 +355,7 @@
} else {
extra_args = 0;
}
-#endif /* defined(EXPAND_ARGS_FIELD) || defined(EXPAND_CHOSEN_ARG) */
+#endif /* defined(EXPAND_ARGS_FIELD) || defined(EXPAND_ONE_ARG) */
#ifdef EXPAND_ARGS_FIELD
#ifdef EXPAND_APPLY_LIMIT
@@ -352,7 +388,24 @@
}
}
#endif /* EXPAND_ARGS_FIELD */
-#ifdef EXPAND_CHOSEN_ARG
+
+#ifdef EXPAND_ONE_ARG
+ #ifdef EXPAND_NAMED_ARG
+ {
+ int i;
+
+ for (i = 0; i < expand_info->arity; i++) {
+ if (functor_desc->MR_du_functor_arg_names[i] != NULL
+ && streq(functor_desc->MR_du_functor_arg_names[i],
+ chosen_name))
+ {
+ chosen = i;
+ break;
+ }
+ }
+ }
+ #endif /* EXPAND_NAMED_ARG */
+
if (0 <= chosen && chosen < expand_info->arity) {
expand_info->chosen_index_exists = TRUE;
expand_info->chosen_value_ptr =
@@ -372,7 +425,7 @@
} else {
expand_info->chosen_index_exists = FALSE;
}
-#endif /* EXPAND_CHOSEN_ARG */
+#endif /* EXPAND_ONE_ARG */
}
break;
@@ -397,7 +450,18 @@
type_ctor_info->type_layout.layout_notag->
MR_notag_functor_arg_type);
#endif /* EXPAND_ARGS_FIELD */
-#ifdef EXPAND_CHOSEN_ARG
+
+#ifdef EXPAND_ONE_ARG
+ #ifdef EXPAND_NAMED_ARG
+ if (type_ctor_info->type_layout.layout_notag
+ ->MR_notag_functor_arg_name != NULL
+ && streq(chosen_name, type_ctor_info->type_layout.layout_notag
+ ->MR_notag_functor_arg_name))
+ {
+ chosen = 0;
+ }
+ #endif /* EXPAND_NAMED_ARG */
+
if (chosen == 0) {
expand_info->chosen_index_exists = TRUE;
expand_info->chosen_value_ptr = data_word_ptr;
@@ -409,7 +473,7 @@
} else {
expand_info->chosen_index_exists = FALSE;
}
-#endif /* EXPAND_CHOSEN_ARG */
+#endif /* EXPAND_ONE_ARG */
break;
case MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ:
@@ -431,7 +495,18 @@
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
+
+#ifdef EXPAND_ONE_ARG
+ #ifdef EXPAND_NAMED_ARG
+ if (type_ctor_info->type_layout.layout_notag
+ ->MR_notag_functor_arg_name != NULL
+ && streq(chosen_name, type_ctor_info->type_layout.layout_notag
+ ->MR_notag_functor_arg_name))
+ {
+ chosen = 0;
+ }
+ #endif /* EXPAND_NAMED_ARG */
+
if (chosen == 0) {
expand_info->chosen_index_exists = TRUE;
expand_info->chosen_value_ptr = data_word_ptr;
@@ -441,7 +516,7 @@
} else {
expand_info->chosen_index_exists = FALSE;
}
-#endif /* EXPAND_CHOSEN_ARG */
+#endif /* EXPAND_ONE_ARG */
break;
case MR_TYPECTOR_REP_EQUIV:
@@ -576,7 +651,8 @@
MR_TYPEINFO_GET_TUPLE_ARG_VECTOR(type_info) + 1;
}
#endif /* EXPAND_ARGS_FIELD */
-#ifdef EXPAND_CHOSEN_ARG
+
+#ifdef EXPAND_ONE_ARG
if (0 <= chosen && chosen < expand_info->arity) {
MR_Word *arg_vector;
@@ -588,7 +664,7 @@
} else {
expand_info->chosen_index_exists = FALSE;
}
-#endif /* EXPAND_CHOSEN_ARG */
+#endif /* EXPAND_ONE_ARG */
break;
case MR_TYPECTOR_REP_UNIV: {
@@ -668,7 +744,8 @@
}
}
#endif /* EXPAND_ARGS_FIELD */
-#ifdef EXPAND_CHOSEN_ARG
+
+#ifdef EXPAND_ONE_ARG
if (0 <= chosen && chosen < array->size) {
MR_TypeInfoParams params;
@@ -679,7 +756,7 @@
} else {
expand_info->chosen_index_exists = FALSE;
}
-#endif /* EXPAND_CHOSEN_ARG */
+#endif /* EXPAND_ONE_ARG */
}
break;
@@ -733,8 +810,10 @@
#undef EXTRA_ARG1
#undef EXTRA_ARG2
+#undef EXTRA_ARG3
#undef EXTRA_ARGS
+#undef EXPAND_ONE_ARG
#undef handle_functor_name
#undef handle_zero_arity_args
#undef handle_zero_arity_all_args
-#undef handle_zero_arity_chosen_arg
+#undef handle_zero_arity_one_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
Index: tests/debugger/field_names.exp
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/field_names.exp,v
retrieving revision 1.1
diff -u -b -r1.1 field_names.exp
--- tests/debugger/field_names.exp 2000/12/18 07:43:03 1.1
+++ tests/debugger/field_names.exp 2001/12/19 04:15:16
@@ -29,6 +29,28 @@
HeadVar__5 44
mdb> p 5^t1e
mdb: the path t1e does not exist.
+mdb> browse 5
+browser> ^1x
+error: cannot change to subterm
+browser> ^1
+browser> p
+41
+browser> ^..^t1a
+browser> p
+41
+browser> ^..^t1b
+browser> p
+42
+browser> ^..^t1c
+error: cannot change to subterm
+browser> ^..^t1d
+browser> p
+44
+browser> ^..^t1e
+error: cannot change to subterm
+browser> p
+44
+browser> quit
mdb> step
4: 3 2 CALL pred field_names:make_t1f2/4-0 (det)
mdb> finish
@@ -49,6 +71,18 @@
mdb: the path t1f does not exist.
mdb> p 4^t1g
HeadVar__4 53
+mdb> browse 4
+browser> ^t1a
+error: cannot change to subterm
+browser> ^t1e
+browser> p
+51
+browser> ^..^t1f
+error: cannot change to subterm
+browser> ^..^t1g
+browser> p
+53
+browser> quit
mdb> step
6: 4 2 CALL pred field_names:make_t2/5-0 (det)
mdb> finish
@@ -105,6 +139,25 @@
mdb: the path t1f does not exist.
mdb> p 5^t2c^t1g
HeadVar__5 53
+mdb> browse 5
+browser> ^3^t1a
+browser> p
+41
+browser> ^..^..^3^t1b
+browser> p
+42
+browser> quit
+mdb> browse 5
+browser> ^t2b
+browser> p
+t1f1(41, 42, 43, 44)
+browser> ^t1a
+browser> p
+41
+browser> ^..^..^t2c^t1e
+browser> p
+51
+browser> quit
mdb> step
8: 5 2 CALL pred field_names:make_t3/4-0 (det)
mdb> finish
Index: tests/debugger/field_names.inp
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/field_names.inp,v
retrieving revision 1.1
diff -u -b -r1.1 field_names.inp
--- tests/debugger/field_names.inp 2000/12/18 07:43:03 1.1
+++ tests/debugger/field_names.inp 2001/12/19 04:15:16
@@ -13,6 +13,20 @@
p 5^t1c
p 5^t1d
p 5^t1e
+browse 5
+^1x
+^1
+p
+^..^t1a
+p
+^..^t1b
+p
+^..^t1c
+^..^t1d
+p
+^..^t1e
+p
+quit
step
finish
p 4
@@ -23,6 +37,14 @@
p 4^t1e
p 4^t1f
p 4^t1g
+browse 4
+^t1a
+^t1e
+p
+^..^t1f
+^..^t1g
+p
+quit
step
finish
p 5
@@ -51,6 +73,20 @@
p 5^t2c^t1e
p 5^t2c^t1f
p 5^t2c^t1g
+browse 5
+^3^t1a
+p
+^..^..^3^t1b
+p
+quit
+browse 5
+^t2b
+p
+^t1a
+p
+^..^..^t2c^t1e
+p
+quit
step
finish
p 4
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
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/recompilation
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
--------------------------------------------------------------------------
More information about the reviews
mailing list