[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