[m-rev.] for review: field names and higher order values in the debugger
Zoltan Somogyi
zs at cs.mu.OZ.AU
Tue Dec 18 14:35:27 AEDT 2001
For review by Mark, Tyson and/or Fergus.
Note: the diff doesn't yet have meaningful .exp2 files for the test cases,
since that bootcheck is still in progress. They will be meaningful before
commit, though.
Estimated hours taken: 16
Branches: main
Allow the browser to refer to fields by name, and allow the debugger to print
higher order values.
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.
library/Mmakefile:
Record the dependence of std_util's object files on
mercury_ml_expand_body.h.
runtime/mercury_ho_call.h:
runtime/mercury_stack_layout.h:
Add prefixes on structure field names that did not have them.
runtime/mercury_ml_expand_body.h:
Add a new alternative, EXPAND_NAMED_ARG, for use in implementing
ML_named_arg.
Deconstruct closures as if they were ordinary terms, with the function
symbol being the name of the predicate/function and the arguments being
the terms stored in the closure.
runtime/mercury_layout_util.[ch]:
Remove the first argument of MR_materialize_closure_typeinfos, since
its correct value is always the same part of the second argument.
runtime/mercury_deep_copy_body.h:
Do not pass the first argument of MR_materialize_closure_typeinfos.
Add field name prefixes where necessary.
trace/mercury_trace_vars.c:
Do not ignore predicates and functions anymore.
tests/debugger/field_names.{m,inp,exp,exp2}:
Expand this test case to exercise the browser.
tests/debugger/higher_order.{m,inp,exp,exp2}:
A new test case to exercise the ability to print higher order values.
Note that the format of the predicate names in the output should be
improved, but that is a separate change since doing it the right way
requires bootstrapping.
tests/debugger/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.21
diff -u -b -r1.21 browse.m
--- browser/browse.m 2001/06/22 08:28:55 1.21
+++ browser/browse.m 2001/12/14 17:05:20
@@ -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/14 14:37:33
@@ -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/18 03:22:13
@@ -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/14 14:50:25
@@ -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/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/mercury/library/Mmakefile,v
retrieving revision 1.80
diff -u -b -r1.80 Mmakefile
--- library/Mmakefile 2001/12/13 09:06:09 1.80
+++ library/Mmakefile 2001/12/17 02:13:02
@@ -297,6 +297,10 @@
$(os_subdir)std_util.pic_o \
: ../runtime/mercury_stack_layout.h
+$(os_subdir)std_util.$O \
+$(os_subdir)std_util.pic_o \
+ : ../runtime/mercury_ml_expand_body.h
+
#-----------------------------------------------------------------------------#
realclean_local:
Index: library/std_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/std_util.m,v
retrieving revision 1.248
diff -u -b -r1.248 std_util.m
--- library/std_util.m 2001/11/08 06:36:54 1.248
+++ library/std_util.m 2001/12/17 04:06:07
@@ -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, 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_argyment/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
@@ -3134,6 +3149,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
@@ -3142,6 +3161,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.
*/
@@ -3263,6 +3286,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.
@@ -3294,6 +3325,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;
@@ -3537,6 +3597,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, "
{
@@ -3566,10 +3650,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 ->
@@ -3580,12 +3671,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_deep_copy_body.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_deep_copy_body.h,v
retrieving revision 1.40
diff -u -b -r1.40 mercury_deep_copy_body.h
--- runtime/mercury_deep_copy_body.h 2001/10/31 17:59:03 1.40
+++ runtime/mercury_deep_copy_body.h 2001/12/16 11:46:43
@@ -506,7 +506,7 @@
** with the values from the closure.
*/
type_info_arg_vector = MR_materialize_closure_typeinfos(
- closure_layout->type_params, old_closure);
+ old_closure);
/* copy the arguments */
for (i = 0; i < args; i++) {
@@ -517,14 +517,15 @@
MR_fatal_error("Sorry, not implemented: copying closures");
#endif
arg_pseudo_type_info =
- closure_layout->arg_pseudo_type_info[i];
+ closure_layout->MR_closure_arg_pseudo_type_info[i];
new_closure->MR_closure_hidden_args_0[i] =
copy_arg(NULL,
&old_closure->MR_closure_hidden_args_0[i], NULL,
type_info_arg_vector, arg_pseudo_type_info,
lower_limit, upper_limit);
}
- if (type_info_arg_vector) {
+
+ if (type_info_arg_vector != NULL) {
MR_free(type_info_arg_vector);
}
Index: runtime/mercury_ho_call.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_ho_call.h,v
retrieving revision 1.4
diff -u -b -r1.4 mercury_ho_call.h
--- runtime/mercury_ho_call.h 2001/01/18 01:19:06 1.4
+++ runtime/mercury_ho_call.h 2001/12/16 10:43:25
@@ -38,7 +38,7 @@
** contain values for all the arguments of the procedure, but the closure
** layout structure has information about all arguments. This is to make
** the creation of a closure from another closure by adding some more
-** hidden arguments as fast as possible. There is no problem is finding
+** hidden arguments as fast as possible. There is no problem in finding
** out which pseudotypeinfo describes which hidden argument, because if
** the closure contains n hidden arguments, these must be the first n arguments
** of the procedure.
@@ -73,16 +73,17 @@
*/
typedef struct MR_Closure_Layout_Struct {
- MR_Closure_Id *closure_id;
- MR_Type_Param_Locns *type_params;
- MR_Integer num_all_args;
- MR_PseudoTypeInfo arg_pseudo_type_info[MR_VARIABLE_SIZED];
+ MR_Closure_Id *MR_closure_id;
+ MR_Type_Param_Locns *MR_closure_type_params;
+ MR_Integer MR_closure_num_all_args;
+ MR_PseudoTypeInfo MR_closure_arg_pseudo_type_info
+ [MR_VARIABLE_SIZED];
} MR_Closure_Layout;
typedef struct MR_Closure_Dyn_Link_Layout_Struct {
- MR_Closure_Id *closure_id;
- MR_Type_Param_Locns *type_params;
- MR_Integer num_all_args;
+ MR_Closure_Id *MR_closure_dl_closure_id;
+ MR_Type_Param_Locns *MR_closure_dl_type_params;
+ MR_Integer MR_closure_dl_num_all_args;
} MR_Closure_Dyn_Link_Layout;
/*
Index: runtime/mercury_layout_util.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_layout_util.c,v
retrieving revision 1.24
diff -u -b -r1.24 mercury_layout_util.c
--- runtime/mercury_layout_util.c 2001/12/10 06:50:10 1.24
+++ runtime/mercury_layout_util.c 2001/12/16 11:02:40
@@ -115,9 +115,11 @@
}
MR_TypeInfoParams
-MR_materialize_closure_typeinfos(const MR_Type_Param_Locns *tvar_locns,
- MR_Closure *closure)
+MR_materialize_closure_typeinfos(MR_Closure *closure)
{
+ const MR_Type_Param_Locns *tvar_locns;
+
+ tvar_locns = closure->MR_closure_layout->MR_closure_type_params;
if (tvar_locns != NULL) {
MR_TypeInfoParams type_params;
bool succeeded;
Index: runtime/mercury_layout_util.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_layout_util.h,v
retrieving revision 1.15
diff -u -b -r1.15 mercury_layout_util.h
--- runtime/mercury_layout_util.h 2001/08/07 23:12:26 1.15
+++ runtime/mercury_layout_util.h 2001/12/16 10:59:43
@@ -62,7 +62,6 @@
MR_Word *saved_regs,
MR_Word *base_sp, MR_Word *base_curfr);
extern MR_TypeInfoParams MR_materialize_closure_typeinfos(
- const MR_Type_Param_Locns *tvar_locns,
MR_Closure *closure);
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/18 03:33:42
@@ -43,6 +43,10 @@
** argument, chosen, and it 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, 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
@@ -51,7 +55,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 +87,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,13 +100,15 @@
** 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.
*/
#include <stdio.h>
#include "mercury_library_types.h" /* for MR_ArrayType */
+#include "mercury_layout_util.h" /* for MR_materialize_closure_typeinfos */
+#include "mercury_ho_call.h" /* for MR_Closure_Id etc */
#ifdef MR_DEEP_PROFILING
#include "mercury_deep_profiling.h"
@@ -117,9 +124,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 +164,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 +191,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 +260,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 +344,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 +352,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 +385,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 +422,7 @@
} else {
expand_info->chosen_index_exists = FALSE;
}
-#endif /* EXPAND_CHOSEN_ARG */
+#endif /* EXPAND_ONE_ARG */
}
break;
@@ -397,7 +447,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 +470,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 +492,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 +513,7 @@
} else {
expand_info->chosen_index_exists = FALSE;
}
-#endif /* EXPAND_CHOSEN_ARG */
+#endif /* EXPAND_ONE_ARG */
break;
case MR_TYPECTOR_REP_EQUIV:
@@ -549,8 +621,88 @@
case MR_TYPECTOR_REP_PRED:
/* XXX expand_info->non_canonical_type = TRUE; */
- handle_functor_name("<<predicate>>");
- handle_zero_arity_args();
+ {
+ MR_Closure *closure;
+ MR_Closure_Layout *closure_layout;
+ MR_Proc_Id *proc_id;
+ MR_User_Proc_Id *user_proc_id;
+ MR_Compiler_Proc_Id *comp_proc_id;
+ MR_ConstString name;
+ int num_args;
+ int i;
+
+ closure = (MR_Closure *) *data_word_ptr;
+ closure_layout = closure->MR_closure_layout;
+ num_args = closure->MR_closure_num_hidden_args;
+ expand_info->arity = num_args;
+
+#ifdef EXPAND_FUNCTOR_FIELD
+ proc_id = &closure_layout->MR_closure_id->MR_closure_proc_id;
+ if (proc_id->MR_proc_user.MR_user_arity < 0) {
+ name = "dynlink_proc"; /* XXX */
+ } else if (MR_PROC_ID_COMPILER_GENERATED(*proc_id)) {
+ name = proc_id->MR_proc_comp.MR_comp_pred_name;
+ } else {
+ name = proc_id->MR_proc_user.MR_user_name;
+ }
+ handle_functor_name(name);
+#endif /* EXPAND_FUNCTOR_FIELD */
+
+#ifdef EXPAND_ARGS_FIELD
+ #ifdef EXPAND_APPLY_LIMIT
+ if (num_args > max_arity) {
+ expand_info->limit_reached = TRUE;
+ } else
+ #endif /* EXPAND_APPLY_LIMIT */
+ {
+ MR_TypeInfo *type_params;
+
+ type_params =
+ MR_materialize_closure_typeinfos(closure);
+ expand_info->EXPAND_ARGS_FIELD.num_extra_args = 0;
+ expand_info->EXPAND_ARGS_FIELD.arg_values = &closure->
+ MR_closure_hidden_args_0[0];
+ expand_info->EXPAND_ARGS_FIELD.arg_type_infos =
+ MR_GC_NEW_ARRAY(MR_TypeInfo, num_args);
+ expand_info->EXPAND_ARGS_FIELD.can_free_arg_type_infos =
+ TRUE;
+ for (i = 0; i < num_args ; i++) {
+ expand_info->EXPAND_ARGS_FIELD.arg_type_infos[i] =
+ MR_create_type_info(type_params,
+ closure_layout->
+ MR_closure_arg_pseudo_type_info[i]);
+ }
+ if (type_params != NULL) {
+ MR_free(type_params);
+ }
+ }
+#endif /* EXPAND_ARGS_FIELD */
+
+#ifdef EXPAND_CHOSEN_ARG
+ if (0 <= chosen && chosen < num_args) {
+ MR_TypeInfo *type_params;
+
+ expand_info->chosen_index_exists = TRUE;
+ expand_info->chosen_value_ptr =
+ &closure->MR_closure_hidden_args_0[chosen];
+ /* the following code could be improved */
+ type_params = MR_materialize_closure_typeinfos(closure);
+ expand_info->chosen_type_info =
+ MR_create_type_info(type_params,
+ closure_layout->
+ MR_closure_arg_pseudo_type_info[chosen]);
+ if (type_params != NULL) {
+ MR_free(type_params);
+ }
+ } else {
+ expand_info->chosen_index_exists = FALSE;
+ }
+#endif /* EXPAND_CHOSEN_ARG */
+
+#ifdef EXPAND_NAMED_ARG
+ expand_info->chosen_index_exists = FALSE;
+#endif /* EXPAND_NAMED_ARG */
+ }
break;
case MR_TYPECTOR_REP_TUPLE:
@@ -576,7 +728,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 +741,7 @@
} else {
expand_info->chosen_index_exists = FALSE;
}
-#endif /* EXPAND_CHOSEN_ARG */
+#endif /* EXPAND_ONE_ARG */
break;
case MR_TYPECTOR_REP_UNIV: {
@@ -668,7 +821,8 @@
}
}
#endif /* EXPAND_ARGS_FIELD */
-#ifdef EXPAND_CHOSEN_ARG
+
+#ifdef EXPAND_ONE_ARG
if (0 <= chosen && chosen < array->size) {
MR_TypeInfoParams params;
@@ -679,7 +833,7 @@
} else {
expand_info->chosen_index_exists = FALSE;
}
-#endif /* EXPAND_CHOSEN_ARG */
+#endif /* EXPAND_ONE_ARG */
}
break;
@@ -733,8 +887,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
Index: runtime/mercury_stack_layout.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_stack_layout.h,v
retrieving revision 1.53
diff -u -b -r1.53 mercury_stack_layout.h
--- runtime/mercury_stack_layout.h 2001/12/10 06:50:11 1.53
+++ runtime/mercury_stack_layout.h 2001/12/15 06:52:09
@@ -892,27 +892,27 @@
*/
typedef struct MR_Closure_Id_Struct {
- MR_Proc_Id proc_id;
- MR_ConstString module_name;
- MR_ConstString file_name;
- MR_Integer line_number;
- MR_ConstString goal_path;
+ MR_Proc_Id MR_closure_proc_id;
+ MR_ConstString MR_closure_module_name;
+ MR_ConstString MR_closure_file_name;
+ MR_Integer MR_closure_line_number;
+ MR_ConstString MR_closure_goal_path;
} MR_Closure_Id;
typedef struct MR_User_Closure_Id_Struct {
- MR_User_Proc_Id proc_id;
- MR_ConstString module_name;
- MR_ConstString file_name;
- MR_Integer line_number;
- MR_ConstString goal_path;
+ MR_User_Proc_Id MR_user_closure_proc_id;
+ MR_ConstString MR_user_closure_module_name;
+ MR_ConstString MR_user_closure_file_name;
+ MR_Integer MR_user_closure_line_number;
+ MR_ConstString MR_user_closure_goal_path;
} MR_User_Closure_Id;
typedef struct MR_Compiler_Closure_Id_Struct {
- MR_Compiler_Proc_Id proc_id;
- MR_ConstString module_name;
- MR_ConstString file_name;
- MR_Integer line_number;
- MR_ConstString goal_path;
+ MR_Compiler_Proc_Id MR_comp_closure_proc_id;
+ MR_ConstString MR_comp_closure_module_name;
+ MR_ConstString MR_comp_closure_file_name;
+ MR_Integer MR_comp_closure_line_number;
+ MR_ConstString MR_comp_closure_goal_path;
} MR_Compiler_Closure_Id;
#endif /* not MERCURY_STACK_LAYOUT_H */
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/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/Mmakefile,v
retrieving revision 1.59
diff -u -b -r1.59 Mmakefile
--- tests/debugger/Mmakefile 2001/12/16 04:46:03 1.59
+++ tests/debugger/Mmakefile 2001/12/17 17:02:05
@@ -32,6 +32,7 @@
exception_vars \
existential_type_classes \
field_names \
+ higher_order \
implied_instance \
interpreter \
loopcheck \
@@ -205,6 +206,9 @@
field_names.out: field_names field_names.inp
$(MDB) ./field_names < field_names.inp > field_names.out 2>&1
+
+higher_order.out: higher_order higher_order.inp
+ $(MDB) ./higher_order < higher_order.inp > higher_order.out 2>&1
implied_instance.out: implied_instance implied_instance.inp
$(MDB) ./implied_instance < implied_instance.inp \
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/17 16:58:57
@@ -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/17 16:58:52
@@ -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
Index: tests/debugger/higher_order.exp
===================================================================
RCS file: higher_order.exp
diff -N higher_order.exp
--- /dev/null Fri Dec 1 02:25:58 2000
+++ higher_order.exp Tue Dec 18 04:06:17 2001
@@ -0,0 +1,69 @@
+ 1: 1 1 CALL pred higher_order:main/2-0 (det) higher_order.m:12
+mdb> echo on
+Command echo enabled.
+mdb> context none
+Contexts will not be printed.
+mdb> set size 100
+mdb> set depth 100
+mdb> set format flat
+mdb> step
+ 2: 2 2 CALL pred higher_order:domap/3-0 (det)
+mdb> print *
+ HeadVar__1 float_add2(3.00000000000000)
+ HeadVar__2 [|](1.00000000000000, [|](2.00000000000000, [|](3.00000000000000, [|](4.00000000000000, [|](5.00000000000000, [])))))
+mdb> finish
+ 29: 2 2 EXIT pred higher_order:domap/3-0 (det)
+mdb> print *
+ HeadVar__1 float_add2(3.00000000000000)
+ HeadVar__2 [|](1.00000000000000, [|](2.00000000000000, [|](3.00000000000000, [|](4.00000000000000, [|](5.00000000000000, [])))))
+ HeadVar__3 [|](4.00000000000000, [|](5.00000000000000, [|](6.00000000000000, [|](7.00000000000000, [|](8.00000000000000, [])))))
+mdb> step
+ 30: 13 2 CALL pred higher_order:domap/3-0 (det)
+mdb> print *
+ HeadVar__1 float_op3(4.00000000000000, 5.00000000000000)
+ HeadVar__2 [|](1.00000000000000, [|](2.00000000000000, [|](3.00000000000000, [|](4.00000000000000, [|](5.00000000000000, [])))))
+mdb> finish
+ 57: 13 2 EXIT pred higher_order:domap/3-0 (det)
+mdb> print *
+ HeadVar__1 float_op3(4.00000000000000, 5.00000000000000)
+ HeadVar__2 [|](1.00000000000000, [|](2.00000000000000, [|](3.00000000000000, [|](4.00000000000000, [|](5.00000000000000, [])))))
+ HeadVar__3 [|](9.00000000000000, [|](14.0000000000000, [|](19.0000000000000, [|](24.0000000000000, [|](29.0000000000000, [])))))
+mdb> step
+ 58: 24 2 CALL pred higher_order:domap/3-0 (det)
+mdb> print *
+ HeadVar__1 max(3)
+ HeadVar__2 [1, 2, 3, 4, 5]
+mdb> finish
+ 75: 24 2 EXIT pred higher_order:domap/3-0 (det)
+mdb> print *
+ HeadVar__1 max(3)
+ HeadVar__2 [1, 2, 3, 4, 5]
+ HeadVar__3 [3, 3, 3, 4, 5]
+mdb> step
+ 76: 30 2 CALL pred higher_order:domap/3-0 (det)
+mdb> print *
+ HeadVar__1 'IntroducedFrom__pred__main__21__1'([6])
+ HeadVar__2 [[1, 2], [3, 4, 5]]
+mdb> finish
+ 92: 30 2 EXIT pred higher_order:domap/3-0 (det)
+mdb> print *
+ HeadVar__1 'IntroducedFrom__pred__main__21__1'([6])
+ HeadVar__2 [[1, 2], [3, 4, 5]]
+ HeadVar__3 [|]([|](6, [|](1, [|](2, []))), [|]([|](6, [|](3, [|](4, [|](5, [])))), []))
+mdb> step
+ 93: 37 2 CALL pred higher_order:domap/3-0 (det)
+mdb> print *
+ HeadVar__1 'IntroducedFrom__pred__main__22__2'(["a"])
+ HeadVar__2 [|]([|]("one", [|]("two", [])), [|]([|]("three", [|]("four", [|]("five", []))), []))
+mdb> finish
+ 109: 37 2 EXIT pred higher_order:domap/3-0 (det)
+mdb> print *
+ HeadVar__1 'IntroducedFrom__pred__main__22__2'(["a"])
+ HeadVar__2 [|]([|]("one", [|]("two", [])), [|]([|]("three", [|]("four", [|]("five", []))), []))
+ HeadVar__3 [|]([|]("a", [|]("one", [|]("two", []))), [|]([|]("a", [|]("three", [|]("four", [|]("five", [])))), []))
+mdb> continue -S
+[4.00000000000000, 5.00000000000000, 6.00000000000000, 7.00000000000000, 8.00000000000000]
+[9.00000000000000, 14.0000000000000, 19.0000000000000, 24.0000000000000, 29.0000000000000]
+[3, 3, 3, 4, 5]
+[[6, 1, 2], [6, 3, 4, 5]]
+[["a", "one", "two"], ["a", "three", "four", "five"]]
Index: tests/debugger/higher_order.exp2
===================================================================
RCS file: higher_order.exp2
diff -N higher_order.exp2
Index: tests/debugger/higher_order.inp
===================================================================
RCS file: higher_order.inp
diff -N higher_order.inp
--- /dev/null Fri Dec 1 02:25:58 2000
+++ higher_order.inp Tue Dec 18 04:04:09 2001
@@ -0,0 +1,26 @@
+echo on
+context none
+set size 100
+set depth 100
+set format flat
+step
+print *
+finish
+print *
+step
+print *
+finish
+print *
+step
+print *
+finish
+print *
+step
+print *
+finish
+print *
+step
+print *
+finish
+print *
+continue -S
Index: tests/debugger/higher_order.m
===================================================================
RCS file: higher_order.m
diff -N higher_order.m
--- /dev/null Fri Dec 1 02:25:58 2000
+++ higher_order.m Tue Dec 18 04:05:17 2001
@@ -0,0 +1,49 @@
+:- module higher_order.
+
+:- interface.
+:- import_module io.
+
+:- pred main(io__state::di, state::uo) is det.
+
+:- implementation.
+
+:- import_module int, float, list.
+
+main -->
+ { IntIn = [1, 2, 3, 4, 5] },
+ { FloatIn = [1.0, 2.0, 3.0, 4.0, 5.0] },
+ { IntListIn = [[1, 2], [3, 4, 5]] },
+ { StringListIn = [["one", "two"], ["three", "four", "five"]] },
+
+ { domap(float_add2(3.0), FloatIn, FloatAdd2Out) },
+ { domap(float_op3(4.0, 5.0), FloatIn, FloatOp3Out) },
+ { domap(int__max(3), IntIn, IntMaxOut) },
+ { domap(do_append([6]), IntListIn, IntAppendOut) },
+ { domap(do_append(["a"]), StringListIn, StringAppendOut) },
+
+ io__write(FloatAdd2Out), nl,
+ io__write(FloatOp3Out), nl,
+ io__write(IntMaxOut), nl,
+ io__write(IntAppendOut), nl,
+ io__write(StringAppendOut), nl.
+
+:- pred domap(pred(X, Y), list(X), list(Y)).
+:- mode domap(pred(in, out) is det, in, out) is det.
+
+domap(_, [], []).
+domap(P, [H0 | T0], [H | T]) :-
+ P(H0, H),
+ domap(P, T0, T).
+
+:- pred float_add2(float::in, float::in, float::out) is det.
+
+float_add2(A, B, A + B).
+
+:- pred float_op3(float::in, float::in, float::in, float::out) is det.
+
+float_op3(A, B, C, A + B * C).
+
+:- pred do_append(list(T)::in, list(T)::in, list(T)::out) is det.
+
+do_append(A, B, C) :-
+ list__append(A, B, C).
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
Index: trace/mercury_trace_vars.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_vars.c,v
retrieving revision 1.28
diff -u -b -r1.28 mercury_trace_vars.c
--- trace/mercury_trace_vars.c 2001/12/10 06:50:15 1.28
+++ trace/mercury_trace_vars.c 2001/12/17 03:54:29
@@ -165,18 +165,14 @@
static MR_TypeCtorInfo
MR_trace_ignored_type_ctors[] =
{
- /* we ignore these until the debugger can handle their varying arity */
#ifndef MR_HIGHLEVEL_CODE
+ /* we ignore these until the debugger can handle their varying arity */
&mercury_data_private_builtin__type_ctor_info_type_info_1,
&mercury_data_private_builtin__type_ctor_info_type_ctor_info_1,
&mercury_data_private_builtin__type_ctor_info_typeclass_info_1,
&mercury_data_private_builtin__type_ctor_info_base_typeclass_info_1,
&mercury_data_std_util__type_ctor_info_type_desc_0,
&mercury_data_std_util__type_ctor_info_type_ctor_desc_0,
-
- /* we ignore these until the debugger can print higher-order terms */
- &mercury_data___type_ctor_info_func_0,
- &mercury_data___type_ctor_info_pred_0,
/* we ignore these because they should never be needed */
&mercury_data___type_ctor_info_void_0,
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