for review: a big step towards the trace-based debugger (part 3 of 3)

Zoltan Somogyi zs at cs.mu.OZ.AU
Fri Mar 20 19:57:37 AEDT 1998


Index: runtime/mercury_trace.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_trace.c,v
retrieving revision 1.8
diff -u -r1.8 mercury_trace.c
--- mercury_trace.c	1998/03/11 22:07:31	1.8
+++ mercury_trace.c	1998/03/20 08:11:37
@@ -18,7 +18,29 @@
 #include "mercury_trace.h"
 #include "mercury_engine.h"
 #include "mercury_wrapper.h"
+#include "mercury_misc.h"
 #include <stdio.h>
+#include <ctype.h>
+
+/*
+** Do we want to use the debugger within this process, or do want to use
+** the Opium-style trace analyzer debugger implemented by an external process.
+** This variable is set in mercury_wrapper.c and never modified afterwards.
+*/
+
+MR_trace_type	MR_trace_handler = MR_TRACE_INTERNAL;
+
+/*
+** Compiler generated tracing code will check whether MR_trace_enabled is true,
+** before calling MR_trace. For now, and until we implement interface tracing,
+** MR_trace_enabled should keep the same value throughout the execution of
+** the entire program after being set in mercury_wrapper.c. There is one
+** exception to this: the Mercury routines called as part of the functionality
+** of the tracer itself (e.g. the term browser) should always be executed
+** with MR_trace_enabled set to FALSE.
+*/
+
+bool	MR_trace_enabled = FALSE;
 
 /*
 ** MR_trace_call_seqno counts distinct calls. The prologue of every
@@ -42,11 +64,13 @@
 int	MR_trace_call_depth = 0;
 
 /*
-** MR_trace_event_number is a simple counter of events; currently we only
-** use it for display.
+** MR_trace_event_number is a simple counter of events. This is used in
+** two places: here, for display to the user and for skipping a given number
+** of events, and when printing an abort message, so that the programmer
+** can zero in on the source of the problem more quickly.
 */
 
-static	int	MR_trace_event_number = 0;
+int	MR_trace_event_number = 0;
 
 /*
 ** MR_trace_cmd and MR_trace_seqno are globals variables that we use
@@ -61,17 +85,16 @@
 */
 
 typedef enum {
-	MR_CMD_CONT,	/* c: continue to end, not printing the trace	  */
-	MR_CMD_DUMP,	/* d: continue to end, printing the trace	  */
-	MR_CMD_NEXT,	/* n: go to the next trace event		  */
-	MR_CMD_SKIP,	/* s: skip the current call, not printing trace	  */
-	MR_CMD_JUMP	/* j: jump to end of current call, printing trace */
+	MR_CMD_GOTO,
+	MR_CMD_FINISH,
+	MR_CMD_TO_END
 } MR_trace_cmd_type;
 
 /*
 ** This type must match the definition of classify_request in
 ** library/debugger_interface.m.
 */
+
 typedef enum {
 	MR_REQUEST_HELLO_REPLY = 0,  /* initiate debugging session	    */
 	MR_REQUEST_FORWARD_MOVE = 1, /* go to the next matching trace event */
@@ -81,8 +104,10 @@
 	MR_REQUEST_ERROR = 5         /* something went wrong                */
 } MR_debugger_request_type;
 
-static	MR_trace_cmd_type	MR_trace_cmd = MR_CMD_NEXT;
-static	int			MR_trace_seqno = 0;
+static	MR_trace_cmd_type	MR_trace_cmd = MR_CMD_GOTO;
+static	int			MR_trace_stop_seqno = 0;
+static	int			MR_trace_stop_event = 0;
+static	bool			MR_trace_print_intermediate = FALSE;
 
 typedef	enum {
 	MR_INTERACT,
@@ -90,25 +115,28 @@
 } MR_trace_interact;
 
 static void	MR_trace_event(MR_trace_interact interact,
-			const MR_stack_layout_entry *layout,
+			const MR_Stack_Layout_Label *layout,
 			MR_trace_port port, int seqno, int depth,
-			const char *path);
+			const char *path, int max_r_num);
+static void	MR_copy_saved_regs_to_regs(int max_mr_num);
+static void	MR_copy_regs_to_saved_regs(int max_mr_num);
 static void	MR_trace_display_user(MR_trace_interact interact,
-			const MR_stack_layout_entry *layout,
+			const MR_Stack_Layout_Label *layout,
 			MR_trace_port port, int seqno, int depth,
 			const char *path);
 static void	MR_trace_browse(int var_count,
-			const MR_stack_layout_vars *var_info);
-static void	MR_trace_browse_var(char *name,
-			const MR_stack_layout_var *var);
-static int	MR_trace_get_cmd(void);
+			const MR_Stack_Layout_Vars *var_info);
+static void	MR_trace_browse_var(const char *name,
+			const MR_Stack_Layout_Var *var, Word *type_params);
+static int	MR_trace_skip_spaces(int c);
+static void	MR_trace_discard_to_eol(int c);
 static void	MR_trace_help(void);
 
 static Word	MR_trace_make_var_list(MR_trace_port port,
-			const MR_stack_layout_entry *layout);
+			const MR_Stack_Layout_Label *layout);
 static Word	MR_trace_lookup_live_lval(MR_Live_Lval locn, bool *succeeded);
-static bool	MR_trace_get_type_and_value(const MR_stack_layout_var *var,
-			Word *type_info, Word *value);
+static bool	MR_trace_get_type_and_value(const MR_Stack_Layout_Var *var,
+			Word *type_params, Word *type_info, Word *value);
 
 /*
 We could use
@@ -118,7 +146,7 @@
 check for an additional flag in the MERCURY_OPTIONS
 environment variable and set MR_use_debugger accordingly.
 */
-#ifdef MR_USE_DEBUGGER
+#ifdef MR_USE_EXTERNAL_DEBUGGER
 
 static MercuryFile MR_debugger_socket_in;
 static MercuryFile MR_debugger_socket_out;
@@ -129,21 +157,18 @@
 			Integer *debugger_request_type_ptr);
 	
 static void	MR_debugger_step(MR_trace_interact interact,
-			const MR_stack_layout_entry *layout,
+			const MR_Stack_Layout_Label *layout,
 			MR_trace_port port, int seqno, int depth,
 			const char *path);
-static bool	MR_found_match(const MR_stack_layout_entry *layout,
+static bool	MR_found_match(const MR_Stack_Layout_Label *layout,
 			MR_trace_port port, int seqno, int depth,
 			/* XXX registers */
 			const char *path, Word search_data);
-static void	MR_output_current(const MR_stack_layout_entry *layout,
+static void	MR_output_current(const MR_Stack_Layout_Label *layout,
 			MR_trace_port port, int seqno, int depth,
 			Word var_list,
 			const char *path, Word current_request);
 
-static void	MR_copy_saved_regs_to_regs(void);
-static void	MR_copy_regs_to_saved_regs(void);
-
 #endif
 
 #define	MR_port_is_final(port)	(port == MR_PORT_EXIT || port == MR_PORT_FAIL)
@@ -154,72 +179,167 @@
 */
 
 void
-MR_trace(const Word *layout_word, MR_trace_port port,
-	int seqno, int depth, const char *path)
+MR_trace(const MR_Stack_Layout_Label *layout, MR_trace_port port,
+	int seqno, int depth, const char *path, int max_r_num)
 {
-	const MR_stack_layout_entry	*layout;
 	MR_trace_interact		interact;
 
-	layout = (const MR_stack_layout_entry *) layout_word;
-
 	MR_trace_event_number++;
 	switch (MR_trace_cmd) {
-		case MR_CMD_NEXT:
-			MR_trace_event(MR_INTERACT, layout,
-				port, seqno, depth, path);
-			break;
+		case MR_CMD_FINISH:
+			if (MR_trace_stop_seqno == seqno
+			&& MR_port_is_final(port)) {
+				MR_trace_event(MR_INTERACT, layout,
+					port, seqno, depth, path, max_r_num);
 
-		case MR_CMD_JUMP:
-			if (MR_trace_seqno == seqno && MR_port_is_final(port))
-			{
-				interact = MR_INTERACT;
-			} else {
-				interact = MR_NO_INTERACT;
+			} else if (MR_trace_print_intermediate) {
+				MR_trace_event(MR_NO_INTERACT, layout,
+					port, seqno, depth, path, max_r_num);
 			}
 
-			MR_trace_event(interact, layout,
-				port, seqno, depth, path);
-
 			break;
 
-		case MR_CMD_SKIP:
-			if (MR_trace_seqno == seqno && MR_port_is_final(port))
-			{
+		case MR_CMD_GOTO:
+			if (MR_trace_event_number >= MR_trace_stop_event) {
 				MR_trace_event(MR_INTERACT, layout,
-					port, seqno, depth, path);
+					port, seqno, depth, path, max_r_num);
+			} else if (MR_trace_print_intermediate) {
+				MR_trace_event(MR_NO_INTERACT, layout,
+					port, seqno, depth, path, max_r_num);
 			}
 
-			break;
-
-		case MR_CMD_CONT:
-			break;
+		case MR_CMD_TO_END:
+			if (MR_trace_print_intermediate) {
+				MR_trace_event(MR_NO_INTERACT, layout,
+					port, seqno, depth, path, max_r_num);
+			}
 
-		case MR_CMD_DUMP:
-			MR_trace_event(MR_NO_INTERACT, layout,
-				port, seqno, depth, path);
 			break;
 
 		default:
-			fatal_error("MR_trace called with inappropriate port");
+			fatal_error("invalid cmd in MR_trace");
 			break;
 	}
 }
 
 static void
 MR_trace_event(MR_trace_interact interact,
-	const MR_stack_layout_entry *layout,
-	MR_trace_port port, int seqno, int depth, const char *path)
+	const MR_Stack_Layout_Label *layout, MR_trace_port port,
+	int seqno, int depth, const char *path, int max_r_num)
 {
-#ifdef MR_USE_DEBUGGER
-	MR_copy_regs_to_saved_regs();
-	MR_debugger_step(interact, layout, port, seqno, depth, path);
-	MR_copy_saved_regs_to_regs();
+	int	max_mr_num;
+
+	if (max_r_num + MR_NUM_SPECIAL_REG > MR_MAX_SPECIAL_REG_MR)
+		max_mr_num = max_r_num + MR_NUM_SPECIAL_REG;
+	else
+		max_mr_num = MR_MAX_SPECIAL_REG_MR;
+
+	MR_copy_regs_to_saved_regs(max_mr_num);
+#ifdef MR_USE_EXTERNAL_DEBUGGER
+	if (MR_trace_debugger == MR_TRACE_EXTERNAL)
+		MR_debugger_step(interact, layout, port, seqno, depth, path);
+	else
+		MR_trace_display_user(interact, layout, port, seqno, depth,
+			path);
 #else
+	/*
+	** We should get here only if MR_trace_debugger == MR_TRACE_INTERNAL.
+	** This is enforced by mercury_wrapper.c.
+	*/
+
 	MR_trace_display_user(interact, layout, port, seqno, depth, path);
 #endif
+	MR_copy_saved_regs_to_regs(max_mr_num);
+}
+
+static Word	MR_saved_regs[MAX_FAKE_REG];
+
+static void
+MR_copy_regs_to_saved_regs(int max_mr_num)
+{
+	/*
+	** In the process of browsing, we call Mercury code,
+	** which may clobber the contents of the virtual machine registers,
+	** both control and general purpose, and both real and virtual
+	** registers. We must therefore save and restore these.
+	** We store them in the MR_saved_regs array.
+	**
+	** The call to MR_trace will clobber the transient registers
+	** on architectures that have them. The compiler generated code
+	** will therefore call save_transient_registers to save the transient
+	** registers in the fake_reg array. We here restore them to the
+	** real registers, save them with the other registers back in
+	** fake_reg, and then copy all fake_reg entries to MR_saved_regs.
+	**
+	** If any code invoked by MR_trace is itself traced,
+	** MR_saved_regs will be overwritten, leading to a crash later on.
+	** This is one reason (but not the only one) why we turn off
+	** tracing when we call back Mercury code from this file.
+	*/
+
+	int i;
+
+	restore_transient_registers();
+	save_registers();
+
+	for (i = 0; i < max_mr_num; i++) {
+		MR_saved_regs[i] = fake_reg[i];
+	}
+}
+
+static void
+MR_copy_saved_regs_to_regs(int max_mr_num)
+{
+	/*
+	** We execute the converse procedure to MR_copy_regs_to_saved_regs.
+	** The save_transient_registers is there so that a call to the
+	** restore_transient_registers macro after MR_trace will do the
+	** right thing.
+	*/
+
+	int i;
+
+	for (i = 0; i < max_mr_num; i++) {
+		fake_reg[i] = MR_saved_regs[i];
+	}
+
+	restore_registers();
+	save_transient_registers();
+}
+
+void
+MR_trace_report(void)
+{
+	if (MR_trace_event_number > 0) {
+		/*
+		** This means that the executable was compiled with tracing,
+		** which implies that the user wants trace info on abort.
+		*/
+
+		fprintf(stderr, "Last event was event #%d.\n",
+			MR_trace_event_number);
+	}
+}
+
+void
+MR_trace_init(void)
+{
+#ifdef MR_USE_EXTERNAL_DEBUGGER
+	if (MR_trace_handler == MR_TRACE_EXTERNAL)
+		MR_trace_init_external();
+#endif
 }
 
-#ifdef MR_USE_DEBUGGER
+void
+MR_trace_end(void)
+{
+#ifdef MR_USE_EXTERNAL_DEBUGGER
+	if (MR_trace_handler == MR_TRACE_EXTERNAL)
+		MR_trace_end_external();
+#endif
+}
+
+#ifdef MR_USE_EXTERNAL_DEBUGGER
 
 #include <errno.h>
 #include <sys/types.h>
@@ -289,7 +409,7 @@
 static bool MR_debug_socket = FALSE;
 
 void
-MR_trace_init(void)
+MR_trace_init_external(void)
 {
 	int fd;
 	int len;
@@ -446,7 +566,7 @@
 }
 
 void
-MR_trace_end(void)
+MR_trace_end_external(void)
 {
 	/*
 	** This can only happen during a forward_move(),
@@ -466,7 +586,7 @@
 
 static void
 MR_debugger_step(MR_trace_interact interact,
-	const MR_stack_layout_entry *layout,
+	const MR_Stack_Layout_Label *layout,
 	MR_trace_port port, int seqno, int depth, const char *path)
 {
 	static bool searching = FALSE;
@@ -519,7 +639,7 @@
 				break;
 				
 			case MR_REQUEST_NO_TRACE:
-				MR_trace_cmd = MR_CMD_CONT;
+				MR_trace_cmd = MR_CMD_TO_END;
 				return;
 
 			default:
@@ -530,7 +650,7 @@
 }
 
 static void
-MR_output_current(const MR_stack_layout_entry *layout,
+MR_output_current(const MR_Stack_Layout_Label *layout,
 	MR_trace_port port, int seqno, int depth,
 	Word var_list,
 	const char *path, Word current_request)
@@ -540,11 +660,11 @@
 		seqno,
 		depth,
 		port,
-		layout->MR_sle_def_module,
-		layout->MR_sle_name,
-		layout->MR_sle_arity,
-		layout->MR_sle_mode,
-		layout->MR_sle_detism,
+		layout->MR_sll_entry->MR_sle_def_module,
+		layout->MR_sll_entry->MR_sle_name,
+		layout->MR_sll_entry->MR_sle_arity,
+		layout->MR_sll_entry->MR_sle_mode,
+		layout->MR_sll_entry->MR_sle_detism,
 		var_list,
 		(String) (Word) path,
 		current_request,
@@ -565,7 +685,7 @@
  
 
 static bool
-MR_found_match(const MR_stack_layout_entry *layout,
+MR_found_match(const MR_Stack_Layout_Label *layout,
 	MR_trace_port port, int seqno, int depth,
 	/* XXX live vars */
 	const char *path, Word search_data)
@@ -579,11 +699,11 @@
 		seqno,
 		depth,
 		port,
-		layout->MR_sle_def_module,
-		layout->MR_sle_name,
-		layout->MR_sle_arity,
-		layout->MR_sle_mode,
-		layout->MR_sle_detism,
+		layout->MR_sll_entry->MR_sle_def_module,
+		layout->MR_sll_entry->MR_sle_name,
+		layout->MR_sll_entry->MR_sle_arity,
+		layout->MR_sll_entry->MR_sle_mode,
+		layout->MR_sll_entry->MR_sle_detism,
 		arguments,
 		(String) (Word) path,
 		search_data);
@@ -598,27 +718,21 @@
 	MR_debugger_socket_out.line_number++;
 }
 
-#else /* !MR_USE_DEBUGGER */
-
-void MR_trace_init(void) {}
-void MR_trace_end(void) {}
-
-#endif /* MR_USE_DEBUGGER */
+#endif /* MR_USE_EXTERNAL_DEBUGGER */
 
 static void
 MR_trace_display_user(MR_trace_interact interact,
-	const MR_stack_layout_entry *layout,
+	const MR_Stack_Layout_Label *layout,
 	MR_trace_port port, int seqno, int depth, const char *path)
 {
 	int	i;
+	int	c;
+	int	count;
+	bool	count_given;
 
 	fflush(stdout);
 	fprintf(stderr, "%8d: %6d %2d ", MR_trace_event_number, seqno, depth);
 
-	for (i = 0; i < depth; i++) {
-		putc(' ', stderr);
-	}
-
 	switch (port) {
 		case MR_PORT_CALL:
 			fprintf(stderr, "CALL ");
@@ -653,7 +767,7 @@
 					"with bad port");
 	}
 
-	switch ((int) layout->MR_sle_detism) {
+	switch ((int) layout->MR_sll_entry->MR_sle_detism) {
 		case MR_DETISM_DET:
 			fprintf(stderr, "DET   ");
 			break;
@@ -698,81 +812,122 @@
 	*/
 
 	fprintf(stderr, "%s:%s/%ld-%ld %s\n",
-		layout->MR_sle_def_module,
-		layout->MR_sle_name,
-		(long) layout->MR_sle_arity,
-		(long) layout->MR_sle_mode,
+		layout->MR_sll_entry->MR_sle_def_module,
+		layout->MR_sll_entry->MR_sle_name,
+		(long) layout->MR_sll_entry->MR_sle_arity,
+		(long) layout->MR_sll_entry->MR_sle_mode,
 		path);
 
 	while (interact == MR_INTERACT) {
 		fprintf(stderr, "mtrace> ");
 
-		switch (MR_trace_get_cmd()) {
-			case 'n':
-			case '\n':
-				MR_trace_cmd = MR_CMD_NEXT;
-				break;
+		count = 1;
+		count_given = FALSE;
+		MR_trace_print_intermediate = FALSE;
+
+		c = MR_trace_skip_spaces(' ');
+		if (isdigit(c)) {
+			count_given = TRUE;
+			count = c - '0';
+			c = getchar();
+			while (c != EOF && isdigit(c)) {
+				count = (count * 10) + c - '0';
+				c = getchar();
+			}
 
-			case 'c':
-				MR_trace_cmd = MR_CMD_CONT;
-				break;
+			c = MR_trace_skip_spaces(c);
+		}
 
-			case 'd':
-				MR_trace_cmd = MR_CMD_DUMP;
+		switch (c) {
+			case 'S':
+				MR_trace_print_intermediate = TRUE;
+				/* fall through */
+
+			case 's':
+			case '\n':
+				MR_trace_cmd = MR_CMD_GOTO;
+				MR_trace_stop_event =
+					MR_trace_event_number + count;
+				MR_trace_discard_to_eol(c);
 				break;
 
-			case 'j':
-				if (MR_port_is_final(port)) {
-					fprintf(stderr, "mtrace: cannot jump"
-							" from this port\n");
+			case 'G':
+				MR_trace_print_intermediate = TRUE;
+				/* fall through */
+
+			case 'g':
+				if (! count_given) {
+					MR_trace_discard_to_eol(c);
+					fprintf(stderr, "mtrace: "
+						"no count given\n");
 					continue;
-				} else {
-					MR_trace_cmd = MR_CMD_JUMP;
-					MR_trace_seqno = seqno;
 				}
 
+				MR_trace_cmd = MR_CMD_GOTO;
+				MR_trace_stop_event = count;
+				MR_trace_discard_to_eol(c);
 				break;
 
-			case 'p':
-				if (port == MR_PORT_CALL) {
-					MR_trace_browse((int)
-						layout->MR_sle_in_arg_count,
-						&layout->MR_sle_in_arg_info);
-				} else if (port == MR_PORT_EXIT) {
-					MR_trace_browse((int)
-						layout->MR_sle_out_arg_count,
-						&layout->MR_sle_out_arg_info);
-				} else {
-					fprintf(stderr, "mtrace: cannot print"
-							" from this port\n");
-				}
-
-				continue;
+			case 'F':
+				MR_trace_print_intermediate = TRUE;
+				/* fall through */
 
-			case 's':
+			case 'f':
 				if (MR_port_is_final(port)) {
-					fprintf(stderr, "mtrace: cannot skip"
-							" from this port\n");
+					MR_trace_discard_to_eol(c);
+					fprintf(stderr, "mtrace: this port"
+						"is already final\n");
 					continue;
 				} else {
-					MR_trace_cmd = MR_CMD_SKIP;
-					MR_trace_seqno = seqno;
+					MR_trace_cmd = MR_CMD_FINISH;
+					MR_trace_stop_seqno = seqno;
 				}
 
+				MR_trace_discard_to_eol(c);
 				break;
 
-			case EOF:
+			case 'C':
+				MR_trace_print_intermediate = TRUE;
+				/* fall through */
+
+			case 'c':
+				if (count_given)
+					fprintf(stderr, "mtrace: "
+						"count ignored\n");
+
+				MR_trace_cmd = MR_CMD_TO_END;
+				MR_trace_discard_to_eol(c);
+				break;
+
+			case 'p':
+				if (count_given)
+					fprintf(stderr, "mtrace: "
+						"count ignored\n");
+
+				MR_trace_discard_to_eol(c);
+				MR_trace_browse((int)
+					layout->MR_sll_var_count,
+					&layout->MR_sll_var_info);
+
+				continue;
+
 			case 'a':
+			case EOF:
+				MR_trace_discard_to_eol(c);
 				fprintf(stderr, "mtrace: are you sure"
 						" you want to abort? ");
 
-				if (MR_trace_get_cmd() == 'y') {
+				c = MR_trace_skip_spaces(' ');
+				if (c == 'y' | c == EOF) {
 					fatal_error("aborting the execution "
 						"on user request");
 				}
+
+				MR_trace_discard_to_eol(c);
 				continue;
 
 			default:
+				MR_trace_discard_to_eol(c);
 				MR_trace_help();
 				continue;
 		}
@@ -781,71 +936,24 @@
 	}
 }
 
-static Word	MR_saved_regs[MAX_FAKE_REG];
-
-static void
-MR_copy_regs_to_saved_regs(void)
-{
-	/*
-	** In the process of browsing, we call Mercury code,
-	** which may clobber the contents of the registers,
-	** both the control registers and the general purpose registers.
-	** We must therefore save and restore these.
-	**
-	** XXX This is very inefficient!
-	**
-	** Some are in real machine registers; others in the fake_reg array.
-	** We need to copy them all to the fake_reg array, because the
-	** calling convention for calling Mercury functions exported to C
-	** assumes that they will be in the fake_reg array.
-	*/
-
-	int i;
-
-	restore_transient_registers();
-	save_registers();
-	for (i = 0; i < MAX_FAKE_REG; i++) {
-		MR_saved_regs[i] = fake_reg[i];
-	}
-}
-
-static void
-MR_copy_saved_regs_to_regs(void)
-{
-	int i;
-
-	for (i = 0; i < MAX_FAKE_REG; i++) {
-		fake_reg[i] = MR_saved_regs[i];
-	}
-	restore_registers();
-	save_transient_registers();
-}
-
 static Word
-MR_trace_make_var_list(MR_trace_port port, const MR_stack_layout_entry *layout)
+MR_trace_make_var_list(MR_trace_port port, const MR_Stack_Layout_Label *layout)
 {
 	int 				var_count;
-	const MR_stack_layout_vars 	*vars;
+	const MR_Stack_Layout_Vars 	*vars;
 	int				i;
 	const char			*name;
 
 	Word				univ_list;
-	MR_stack_layout_var*		var;
+	MR_Stack_Layout_Var*		var;
 	Word				univ, value;
 	MR_Live_Type			live_type;
 	Word				type_info;
 
 	restore_transient_registers();
 
-	if (port == MR_PORT_CALL) {
-		var_count = layout->MR_sle_in_arg_count;
-		vars = &layout->MR_sle_in_arg_info;
-	} else if (port == MR_PORT_EXIT) {
-		var_count = layout->MR_sle_out_arg_count;
-		vars = &layout->MR_sle_out_arg_info;
-	} else {
-		return list_empty();
-	}
+	var_count = layout->MR_sll_var_count;
+	vars = &layout->MR_sll_var_info;
 
 	/* build up the live variable list, starting from the end */
 	univ_list = list_empty();
@@ -855,15 +963,22 @@
 		** (XXX we don't include the name or the inst
 		** in the list that we return)
 		*/
-		if (vars->MR_slvs_names != NULL &&
-				vars->MR_slvs_names[i] != NULL)
-		{
-			name = vars->MR_slvs_names[i];
-		} else {
-			name = "";
-		}
+
+		name = MR_name_if_present(vars, i);
 		var = &vars->MR_slvs_pairs[i];
-		if (!MR_trace_get_type_and_value(var, &type_info, &value)) {
+
+		/*
+		** XXX The printing of type_infos is buggy at the moment
+		** due to the fake arity of mercury_builtin:typeinfo/1.
+		**
+		** "variables" representing the saved values of succip, hp etc,
+		** which are the "variables" for which get_type_and_value
+		** fails, are not of interest to the trace analyzer.
+		*/
+
+		if (strncmp(name, "TypeInfo", 8) == 0
+		|| !MR_trace_get_type_and_value(var, NULL, &type_info, &value))
+		{
 			continue;
 		}
 
@@ -881,31 +996,34 @@
 }
 
 static void
-MR_trace_browse(int var_count, const MR_stack_layout_vars *vars)
+MR_trace_browse(int var_count, const MR_Stack_Layout_Vars *vars)
 {
+	Word	*type_params;
+	bool	succeeded;
 	int	i;
-	char	*name;
 
 	if (var_count == 0) {
 		printf("mtrace: no live variables\n");
 		return;
 	}
 
-	MR_copy_regs_to_saved_regs();
-
-	for (i = 0; i < var_count; i++) {
-		if (vars->MR_slvs_names != NULL &&
-				vars->MR_slvs_names[i] != NULL)
-		{
-			name = vars->MR_slvs_names[i];
-		} else {
-			name = NULL;
+	type_params = checked_malloc((vars->MR_slvs_tvar_count + 1)
+		* sizeof(Word));
+	/* type_params should look like a typeinfo; type_params[0] is empty */
+	for (i = 0; i < vars->MR_slvs_tvar_count; i++) {
+		type_params[i+1] = MR_trace_lookup_live_lval(
+			vars->MR_slvs_tvars[i], &succeeded);
+		if (!succeeded) {
+			fatal_error("missing type param in MR_trace_browse");
 		}
+	}
 
-		MR_trace_browse_var(name, &vars->MR_slvs_pairs[i]);
+	for (i = 0; i < var_count; i++) {
+		MR_trace_browse_var(MR_name_if_present(vars, i),
+			&vars->MR_slvs_pairs[i], type_params);
 	}
 
-	MR_copy_saved_regs_to_regs();
+	free(type_params);
 }
 
 /* if you want to debug this code, you may want to set this var to TRUE */
@@ -991,26 +1109,44 @@
 	return value;
 }
 
+/* XXX fix this ref to the library */
+extern	Word	*ML_create_type_info(Word *term_type_info,
+			Word *arg_pseudo_type_info);
+
 static bool
-MR_trace_get_type_and_value(const MR_stack_layout_var *var,
-	Word *type_info, Word *value)
+MR_trace_get_type_and_value(const MR_Stack_Layout_Var *var,
+	Word *type_params, Word *type_info, Word *value)
 {
-	bool succeeded;
+	bool	succeeded;
+	Word	*pseudo_type_info;
+	int	i;
 
-	if (MR_LIVE_TYPE_IS_VAR(var->MR_slv_live_type)) {
-		*type_info = MR_LIVE_TYPE_GET_VAR_TYPE(var->MR_slv_live_type);
-	} else {
+	if (!MR_LIVE_TYPE_IS_VAR(var->MR_slv_live_type)) {
 		return FALSE;
 	}
-	*value = MR_trace_lookup_live_lval(var->MR_slv_locn, &succeeded);
+
+	pseudo_type_info = MR_LIVE_TYPE_GET_VAR_TYPE(var->MR_slv_live_type);
+	*type_info = (Word) ML_create_type_info(type_params, pseudo_type_info);
+	*value = MR_trace_lookup_live_lval(var->MR_slv_locn,
+		&succeeded);
 	return succeeded;
 }
 
 static void
-MR_trace_browse_var(char *name, const MR_stack_layout_var *var)
+MR_trace_browse_var(const char *name, const MR_Stack_Layout_Var *var,
+	Word *type_params)
 {
-	Word			value, type_info;
-	bool			print_value;
+	Word	value, type_info;
+	bool	print_value;
+	int	i;
+
+	/*
+	** XXX The printing of type_infos is buggy at the moment
+	** due to the fake arity of the type mercury_builtin:typeinfo/1.
+	*/
+
+	if (strncmp(name, "TypeInfo", 8) == 0)
+		return;
 
 	/* The initial blanks are to visually separate */
 	/* the variable names from the prompt. */
@@ -1021,7 +1157,14 @@
 		printf("%10s%-21s\t", "", "anonymous variable");
 	}
 
-	if (MR_trace_get_type_and_value(var, &type_info, &value)) {
+	/*
+	** "variables" representing the saved values of succip, hp etc,
+	** which are the "variables" for which get_type_and_value fails,
+	** are not of interest to the user.
+	*/
+
+	if (MR_trace_get_type_and_value(var, type_params, &type_info, &value))
+	{
 		printf("\t");
 
 		/*
@@ -1030,42 +1173,72 @@
 		** avoid going through call_engine, but for some unknown
 		** reason, that seemed to cause the Mercury code in the
 		** browser to clobber part of the C stack.
+		**
 		** Probably that was due to a bug which has since been
 		** fixed, so we should change the code below back again...
+		**
+		** call_engine expects the transient registers to be
+		** in fake_reg, others in their normal homes.
+		** The code below works by placing r1, r2 and all other
+		** transient registers both in their normal homes and
+		** and in fake_reg as well.
 		*/
+
+		MR_trace_enabled = FALSE;
+		for (i = 0; i < MAX_FAKE_REG; i++) {
+			fake_reg[i] = MR_saved_regs[i];
+		}
+		restore_registers();
 		r1 = type_info;
 		r2 = value;
+		save_transient_registers(); /* XXX probably redundant now */
 		call_engine(MR_library_trace_browser);
+		MR_trace_enabled = TRUE;
 	}
 
 	printf("\n");
 }
 
 static int
-MR_trace_get_cmd(void)
+MR_trace_skip_spaces(int c)
 {
-	int	cmd;
-	int	c;
+	while (c != EOF && c != '\n' && isspace(c))
+		c = getchar();
 
-	cmd = getchar();	/* read the trace command */
+	return c;
+}
 
-	/* skip the rest of the line */
-	c = cmd;
+static void
+MR_trace_discard_to_eol(int c)
+{
 	while (c != EOF && c != '\n')
 		c = getchar();
-
-	return cmd;
 }
 
+
 static void
 MR_trace_help(void)
 {
 	fprintf(stderr, "valid commands are:\n"
-			" a: abort the current execution.\n"
-			" c: continue to end, not printing the trace.\n"
-			" d: continue to end, printing the trace.\n"
-			" n: go to the next trace event.\n"
-			" s: skip the current call, not printing trace.\n"
-			" j: jump to end of current call, printing trace.\n"
-			" p: print the variables live at this point.\n");
+		"a, EOF:\t\t"
+		"\tabort the current execution.\n"
+		"c:\t\t"
+		"\tcontinue to end of program, not printing the trace.\n"
+		"C:\t\t"
+		"\tcontinue to end of program, printing the trace.\n"
+		"f:\t\t"
+		"\tfinish this call, not printing the trace.\n"
+		"F:\t\t"
+		"\tfinish this call, printing the trace.\n"
+		"<N> g:\t\t"
+		"\tgo to event #N, not printing the trace.\n"
+		"<N> G:\t\t"
+		"\tgo to event #N, printing the trace.\n"
+		"p:\t\t"
+		"\tprint the variables live at this point.\n"
+		"[<N>] s, [N] CR:"
+		"\tskip N events, not printing the trace.\n"
+		"[<N>] S:\t"
+		"\tskip N events, printing the trace.\n"
+	);
 }
Index: runtime/mercury_trace.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_trace.h,v
retrieving revision 1.6
diff -u -r1.6 mercury_trace.h
--- mercury_trace.h	1998/03/11 22:07:32	1.6
+++ mercury_trace.h	1998/03/20 08:13:07
@@ -8,9 +8,9 @@
 ** mercury_trace.h - defines the interface between
 ** the tracing subsystem and compiled code.
 **
-** The macros and the function defined in this module are intended to be
-** called only from code generated by the Mercury compiler, and from
-** hand-compiled code in the Mercury runtime or the Mercury standard library.
+** The macros and functions defined in this module are intended to be called
+** only from code generated by the Mercury compiler, and from hand-written
+** code in the Mercury runtime or the Mercury standard library.
 */
 
 #ifndef MERCURY_TRACE_H
@@ -27,6 +27,7 @@
 ** This enum should exactly match the definition of the `trace_port' type in
 ** library/debugger_interface.
 */
+
 typedef	enum {
 	MR_PORT_CALL,
 	MR_PORT_EXIT,
@@ -38,11 +39,19 @@
 } MR_trace_port;
 
 extern	void	MR_trace(
-	const Word *,		/* pointer to stack layout info */
+	const MR_Stack_Layout_Label *,	/* layout info for the event */
 	MR_trace_port,
 	int,			/* call sequence number */
 	int,			/* call depth */
-	const char *);		/* path to event goal within procedure */
+	const char *,		/* path to event goal within procedure */
+	int);			/* highest numbered rN register in use */
+
+/*
+** This function will report the number of the last event,
+** if there have been some events, and will do nothing otherwise.
+*/
+
+extern	void	MR_trace_report(void);
 
 /*
 ** MR_trace_init() is called from mercury_runtime_init()
@@ -50,7 +59,18 @@
 ** MR_trace_end() is called from mercury_runtime_terminate()
 ** when the debuggee programs is exiting.
 */
+
 extern	void	MR_trace_init(void);
 extern	void	MR_trace_end(void);
+
+typedef	enum {
+	MR_TRACE_INTERNAL,
+	MR_TRACE_EXTERNAL
+} MR_trace_type;
+
+extern	MR_trace_type	MR_trace_handler;
+extern	bool		MR_trace_enabled;
+
+extern	int		MR_trace_event_number;
 
 #endif /* MERCURY_TRACE_H */
Index: runtime/mercury_wrapper.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_wrapper.c,v
retrieving revision 1.8
diff -u -r1.8 mercury_wrapper.c
--- mercury_wrapper.c	1998/03/16 12:23:40	1.8
+++ mercury_wrapper.c	1998/03/18 01:11:31
@@ -443,7 +443,7 @@
 	unsigned long size;
 	int c;
 
-	while ((c = getopt(argc, argv, "acC:d:hLlP:pr:s:tT:w:xz:1:2:3:")) != EOF)
+	while ((c = getopt(argc, argv, "acC:d:D:hLlP:pr:s:tT:w:xz:")) != EOF)
 	{
 		switch (c)
 		{
@@ -512,6 +512,21 @@
 			use_own_timer = FALSE;
 			break;
 
+		case 'D':
+			MR_trace_enabled = TRUE;
+
+			if (streq(optarg, "i"))
+				MR_trace_handler = MR_TRACE_INTERNAL;
+#ifdef	MR_USE_EXTERNAL_DEBUGGER
+			else if (streq(optarg, "e"))
+				MR_trace_handler = MR_TRACE_EXTERNAL;
+#endif
+
+			else
+				usage();
+
+			break;
+
 		case 'h':
 			usage();
 			break;
@@ -647,24 +662,6 @@
 
 			break;
 
-		case '1':	
-			if (sscanf(optarg, "%d", &r1val) != 1)
-				usage();
-
-			break;
-
-		case '2':	
-			if (sscanf(optarg, "%d", &r2val) != 1)
-				usage();
-
-			break;
-
-		case '3':	
-			if (sscanf(optarg, "%d", &r3val) != 1)
-				usage();
-
-			break;
-
 		default:	
 			usage();
 
@@ -698,6 +695,10 @@
 		"-dm \t\tdebug memory allocation\n"
 		"-dG \t\tdebug garbage collection\n"
 		"-dd \t\tdetailed debug\n"
+		"-Di \t\tdebug the program using the internal debugger\n"
+#ifdef MR_USE_EXTERNAL_DEBUGGER
+		"-De \t\tdebug the program using the external debugger\n"
+#endif
 		"-sh<n> \t\tallocate n kb for the heap\n"
 		"-sd<n> \t\tallocate n kb for the det stack\n"
 		"-sn<n> \t\tallocate n kb for the nondet stack\n"
@@ -718,9 +719,7 @@
 #endif
 		"-r<n> \t\trepeat n times\n"
 		"-w<name> \tcall predicate with given name (default: main/2)\n"
-		"-1<x> \t\tinitialize register r1 with value x\n"
-		"-2<x> \t\tinitialize register r2 with value x\n"
-		"-3<x> \t\tinitialize register r3 with value x\n");
+		);
 	fflush(stdout);
 	exit(1);
 } /* end usage() */
Index: scripts/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/mercury/scripts/Mmakefile,v
retrieving revision 1.6
diff -u -r1.6 Mmakefile
--- Mmakefile	1997/11/21 07:11:00	1.6
+++ Mmakefile	1998/03/14 06:07:48
@@ -14,7 +14,7 @@
 
 #-----------------------------------------------------------------------------#
 
-SCRIPTS = mmake mmc c2init mgnuc ml mprof mprof_merge_runs mint \
+SCRIPTS = mmake mmc mmd c2init mgnuc ml mprof mprof_merge_runs mint \
 	  sicstus_conv mtags vpath_find mercury_update_interface \
 	  mkfifo_using_mknod
 NUPROLOG_SCRIPTS = mnc mnl mnp
Index: tests/misc_tests/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/misc_tests/Mmakefile,v
retrieving revision 1.6
diff -u -r1.6 Mmakefile
--- Mmakefile	1998/02/16 17:23:15	1.6
+++ Mmakefile	1998/03/18 00:57:55
@@ -9,41 +9,14 @@
 mdemangle_test.out: mdemangle_test.inp
 	mdemangle < mdemangle_test.inp > mdemangle_test.out 2>&1
 
-debugger_regs.out: debugger_regs debugger_regs.inp
-	./debugger_regs debugger_regs.m < debugger_regs.inp \
-		> debugger_regs.out 2>&1
-
-debugger_test.out: debugger_test debugger_test.inp
-	./debugger_test debugger_test.m < debugger_test.inp \
-		> debugger_test.out 2>&1
-
 pretty_print_test.out: pretty_print_test.ugly
 	cp pretty_print_test.ugly pretty_print_test.out
 
 #-----------------------------------------------------------------------------#
 
-STACK_LAYOUT_PROGS=	\
-	debugger_regs	\
-	debugger_test
-
-OTHER_PROGS =
+PROGS =
 
 OTHER_TESTS = mdemangle_test pretty_print_test
-
-MCFLAGS-debugger_regs = --generate-trace
-MCFLAGS-debugger_test = --generate-trace
-
-# Not all grades can be used with stack layouts
-#
-ifeq ($(GRADE),jump) 
-	PROGS=$(OTHER_PROGS)
-else
-	ifeq ($(GRADE),fast)
-		PROGS=$(OTHER_PROGS)
-	else
-		PROGS=$(STACK_LAYOUT_PROGS) $(OTHER_PROGS)
-	endif
-endif
 
 #-----------------------------------------------------------------------------#
 

New File: scripts/mmd
===================================================================
#!/bin/sh
case $# in
	0)	echo "Usage: mmd <executable> [<arg> ...]"
		exit 1;;
esac

MERCURY_OPTIONS="$MERCURY_OPTIONS -Di"
export MERCURY_OPTIONS
exec "$@"

New File: tests/debugger/Mmakefile
===================================================================
#-----------------------------------------------------------------------------#

MMD_WRAPPER = yes

main_target: check

include ../Mmake.common

#-----------------------------------------------------------------------------#

DEBUGGER_PROGS=	\
	debugger_regs	\
	interpreter	\
	queens

MCFLAGS = --generate-trace

# Not all grades can be used with stack layouts
#
ifeq ($(GRADE),jump) 
	PROGS=
else
	ifeq ($(GRADE),fast)
		PROGS=
	else
		PROGS=$(DEBUGGER_PROGS)
	endif
endif

#-----------------------------------------------------------------------------#

debugger_regs.out: debugger_regs debugger_regs.inp
	mmd ./debugger_regs < debugger_regs.inp > debugger_regs.out 2>&1

interpreter.out: interpreter interpreter.inp
	mmd ./interpreter interpreter.m < interpreter.inp \
		> interpreter.out 2>&1

queens.out: queens queens.inp
	mmd ./queens < queens.inp > queens.out 2>&1

#-----------------------------------------------------------------------------#

DEPS=	$(PROGS:%=%.dep)
DEPENDS=$(PROGS:%=%.depend)
OUTS=	$(PROGS:%=%.out)
RESS=	$(PROGS:%=%.res)
MODS=	$(PROGS:%=%.mod)

#-----------------------------------------------------------------------------#

dep:	$(DEPS)

depend:	$(DEPENDS)

check:	$(OUTS) $(RESS)

mods:	$(MODS)

all:	$(PROGS)

#-----------------------------------------------------------------------------#

New File: tests/debugger/debugger_regs.exp
===================================================================
       1:      1  1 CALL DET   debugger_regs:main/2-0 
mtrace>        2:      2  2 CALL DET   debugger_regs:data/41-0 
mtrace>        3:      2  2 EXIT DET   debugger_regs:data/41-0 
mtrace> mtrace>           HeadVar__1           		[1, 2, 3, 4, 5]
          HeadVar__2           		a0
          HeadVar__3           		a1
          HeadVar__4           		a2
          HeadVar__5           		a3
          HeadVar__6           		a4
          HeadVar__7           		a5
          HeadVar__8           		a6
          HeadVar__9           		a7
          HeadVar__10          		a8
          HeadVar__11          		a9
          HeadVar__12          		b0
          HeadVar__13          		b1
          HeadVar__14          		b2
          HeadVar__15          		b3
          HeadVar__16          		b4
          HeadVar__17          		b5
          HeadVar__18          		b6
          HeadVar__19          		b7
          HeadVar__20          		b8
          HeadVar__21          		b9
          HeadVar__22          		c0
          HeadVar__23          		c1
          HeadVar__24          		c2
          HeadVar__25          		c3
          HeadVar__26          		c4
          HeadVar__27          		c5
          HeadVar__28          		c6
          HeadVar__29          		c7
          HeadVar__30          		c8
          HeadVar__31          		c9
          HeadVar__32          		d0
          HeadVar__33          		d1
          HeadVar__34          		d2
          HeadVar__35          		d3
          HeadVar__36          		d4
          HeadVar__37          		d5
          HeadVar__38          		d6
          HeadVar__39          		d7
          HeadVar__40          		d8
          HeadVar__41          		d9
a0a1a2a3a4a5a6a7a8a9
b0b1b2b3b4b5b6b7b8b9
c0c1c2c3c4c5c6c7c8c9
d0d1d2d3d4d5d6d7d8d9

New File: tests/debugger/debugger_regs.inp
===================================================================


p
c

New File: tests/debugger/debugger_regs.m
===================================================================
% This program tests whether the tracer works for procedures with
% lots of arguments (beyond NUM_REAL_REGS and MAX_REAL_REGS).
% At the moment, MAX_REAL_REGS is 32, so a procedure with 41 args
% is a full test.

:- module debugger_regs.

:- interface.

:- import_module io.

:- pred main(io__state, io__state).
:- mode main(di, uo) is det.

:- implementation.

:- import_module list, int.

main -->
	% The purpose of list is to force the tracer to call the Mercury
	% code to print a list of integers, when the input script asks
	% for the outputs of data to be printed. In the past this was
	% sufficed to cause part of the C stack to be overwritten.
	% It also tests whether the values of A0 etc that the tracer prints
	% are derived from the register contents produced by data,
	% or from the register contents left there by the code that
	% prints _List.
	{ data(_List,
		A0, A1, A2, A3, A4, A5, A6, A7, A8, A9,
		B0, B1, B2, B3, B4, B5, B6, B7, B8, B9,
		C0, C1, C2, C3, C4, C5, C6, C7, C8, C9,
		D0, D1, D2, D3, D4, D5, D6, D7, D8, D9) },
	io__write_string(A0),
	io__write_string(A1),
	io__write_string(A2),
	io__write_string(A3),
	io__write_string(A4),
	io__write_string(A5),
	io__write_string(A6),
	io__write_string(A7),
	io__write_string(A8),
	io__write_string(A9),
	io__write_string("\n"),
	io__write_string(B0),
	io__write_string(B1),
	io__write_string(B2),
	io__write_string(B3),
	io__write_string(B4),
	io__write_string(B5),
	io__write_string(B6),
	io__write_string(B7),
	io__write_string(B8),
	io__write_string(B9),
	io__write_string("\n"),
	io__write_string(C0),
	io__write_string(C1),
	io__write_string(C2),
	io__write_string(C3),
	io__write_string(C4),
	io__write_string(C5),
	io__write_string(C6),
	io__write_string(C7),
	io__write_string(C8),
	io__write_string(C9),
	io__write_string("\n"),
	io__write_string(D0),
	io__write_string(D1),
	io__write_string(D2),
	io__write_string(D3),
	io__write_string(D4),
	io__write_string(D5),
	io__write_string(D6),
	io__write_string(D7),
	io__write_string(D8),
	io__write_string(D9),
	io__write_string("\n").

:- pred data(list(int)::out,
	string::out, string::out, string::out, string::out, string::out,
	string::out, string::out, string::out, string::out, string::out,
	string::out, string::out, string::out, string::out, string::out,
	string::out, string::out, string::out, string::out, string::out,
	string::out, string::out, string::out, string::out, string::out,
	string::out, string::out, string::out, string::out, string::out,
	string::out, string::out, string::out, string::out, string::out,
	string::out, string::out, string::out, string::out, string::out) is det.

data([1, 2, 3, 4, 5],
	"a0", "a1", "a2", "a3", "a4", "a5", "a6", "a7", "a8", "a9",
	"b0", "b1", "b2", "b3", "b4", "b5", "b6", "b7", "b8", "b9",
	"c0", "c1", "c2", "c3", "c4", "c5", "c6", "c7", "c8", "c9",
	"d0", "d1", "d2", "d3", "d4", "d5", "d6", "d7", "d8", "d9").

New File: tests/debugger/interpreter.exp
===================================================================
       1:      1  1 CALL DET   interpreter:main/2-0 
mtrace> valid commands are:
a, EOF:			abort the current execution.
c:			continue to end of program, not printing the trace.
C:			continue to end of program, printing the trace.
f:			finish this call, not printing the trace.
F:			finish this call, printing the trace.
<N> g:			go to event #N, not printing the trace.
<N> G:			go to event #N, printing the trace.
p:			print the variables live at this point.
[<N>] s, [N] CR:	skip N events, not printing the trace.
[<N>] S:		skip N events, printing the trace.
mtrace> Pure Prolog Interpreter.

Consulting file `interpreter.m'...
      11:      6  5 SWTC DET   interpreter:consult_until_eof_2/5-0 s3;
mtrace> mtrace>           HeadVar__1           		term(varset(0, empty, empty), functor(atom(":-"), [functor(atom("module"), [functor(atom("interpreter"), [], context("interpreter.m", 22))], context("interpreter.m", 22))], context("interpreter.m", 22)))
          HeadVar__2           		[]
          HeadVar__4           		state('<<c_pointer>>')
      30:     16 12 CALL DET   interpreter:database_assert_clause/4-0 
mtrace> mtrace>           HeadVar__1           		[clause(varset(0, empty, empty), functor(atom(":-"), [functor(atom("import_module"), [functor(atom("io"), [], context("interpreter.m", 24))], context("interpreter.m", 24))], context("interpreter.m", 24)), functor(atom("true"), [], context("", 0))), clause(varset(0, empty, empty), functor(atom(":-"), [functor(atom("interface"), [], context("interpreter.m", 23))], context("interpreter.m", 23)), functor(atom("true"), [], context("", 0))), clause(varset(0, empty, empty), functor(atom(":-"), [functor(atom("module"), [functor(atom("interpreter"), [], context("interpreter.m", 22))], context("interpreter.m", 22))], context("interpreter.m", 22)), functor(atom("true"), [], context("", 0)))]
          HeadVar__2           		varset(0, empty, empty)
          HeadVar__3           		functor(atom(":-"), [functor(atom("pred"), [functor(atom("main"), [functor(atom("io__state"), [], context("interpreter.m", 26)), functor(atom("io__state"), [], context("interpreter.m", 26))], context("interpreter.m", 26))], context("interpreter.m", 26))], context("interpreter.m", 26))
      30:     16 12 CALL DET   interpreter:database_assert_clause/4-0 
      31:     16 12 ELSE DET   interpreter:database_assert_clause/4-0 e;
      32:     16 12 EXIT DET   interpreter:database_assert_clause/4-0 
mtrace> mtrace>           HeadVar__4           		[clause(varset(0, empty, empty), functor(atom(":-"), [functor(atom("pred"), [functor(atom("main"), [functor(atom("io__state"), [], context("interpreter.m", 26)), functor(atom("io__state"), [], context("interpreter.m", 26))], context("interpreter.m", 26))], context("interpreter.m", 26))], context("interpreter.m", 26)), functor(atom("true"), [], context("", 0))), clause(varset(0, empty, empty), functor(atom(":-"), [functor(atom("import_module"), [functor(atom("io"), [], context("interpreter.m", 24))], context("interpreter.m", 24))], context("interpreter.m", 24)), functor(atom("true"), [], context("", 0))), clause(varset(0, empty, empty), functor(atom(":-"), [functor(atom("interface"), [], context("interpreter.m", 23))], context("interpreter.m", 23)), functor(atom("true"), [], context("", 0))), clause(varset(0, empty, empty), functor(atom(":-"), [functor(atom("module"), [functor(atom("interpreter"), [], context("interpreter.m", 22))], context("interpreter.m", 22)
)], context("interpreter.m", 22)), functor(atom("true"), [], context("", 0)))]
          HeadVar__1           		[clause(varset(0, empty, empty), functor(atom(":-"), [functor(atom("import_module"), [functor(atom("io"), [], context("interpreter.m", 24))], context("interpreter.m", 24))], context("interpreter.m", 24)), functor(atom("true"), [], context("", 0))), clause(varset(0, empty, empty), functor(atom(":-"), [functor(atom("interface"), [], context("interpreter.m", 23))], context("interpreter.m", 23)), functor(atom("true"), [], context("", 0))), clause(varset(0, empty, empty), functor(atom(":-"), [functor(atom("module"), [functor(atom("interpreter"), [], context("interpreter.m", 22))], context("interpreter.m", 22))], context("interpreter.m", 22)), functor(atom("true"), [], context("", 0)))]
          HeadVar__2           		varset(0, empty, empty)
          HeadVar__3           		functor(atom(":-"), [functor(atom("pred"), [functor(atom("main"), [functor(atom("io__state"), [], context("interpreter.m", 26)), functor(atom("io__state"), [], context("interpreter.m", 26))], context("interpreter.m", 26))], context("interpreter.m", 26))], context("interpreter.m", 26))
      33:     17 12 CALL DET   interpreter:consult_until_eof/4-0 
mtrace>      677:     17 12 EXIT DET   interpreter:consult_until_eof/4-0 
mtrace>      678:     15 11 EXIT DET   interpreter:consult_until_eof_2/5-0 
mtrace>      679:     14 10 EXIT DET   interpreter:consult_until_eof/4-0 
mtrace>      679:     14 10 EXIT DET   interpreter:consult_until_eof/4-0 
     680:     12  9 EXIT DET   interpreter:consult_until_eof_2/5-0 
     681:     11  8 EXIT DET   interpreter:consult_until_eof/4-0 
     682:      9  7 EXIT DET   interpreter:consult_until_eof_2/5-0 
     683:      8  6 EXIT DET   interpreter:consult_until_eof/4-0 
     684:      6  5 EXIT DET   interpreter:consult_until_eof_2/5-0 
     685:      5  4 EXIT DET   interpreter:consult_until_eof/4-0 
     686:      4  3 EXIT DET   interpreter:consult/5-0 
     687:    259  3 CALL DET   interpreter:consult_list/5-0 
     688:    259  3 SWTC DET   interpreter:consult_list/5-0 s2;
     689:    259  3 EXIT DET   interpreter:consult_list/5-0 
     690:      3  2 EXIT DET   interpreter:consult_list/5-0 
     691:    260  2 CALL DET   interpreter:main_loop/3-0 
?-      692:    261  3 CALL DET   interpreter:main_loop_2/4-0 
     693:    261  3 SWTC DET   interpreter:main_loop_2/4-0 s1;
     694:    261  3 EXIT DET   interpreter:main_loop_2/4-0 
     695:    260  2 EXIT DET   interpreter:main_loop/3-0 
     696:      1  1 EXIT DET   interpreter:main/2-0 

New File: tests/debugger/interpreter.inp
===================================================================
h
10s
p
30 g
p
F
p

f


C

New File: tests/debugger/interpreter.m
===================================================================
%-----------------------------------------------------------------------------%

% File: interpreter.m.
% Main author: fjh.

% This is an interpreter for definite logic programs
% (i.e. pure Prolog with no negation or if-then-else.)
%
% This is just intended as a demonstration of the use of the
% meta-programming library modules term, varset, and term_io.

% There are many extensions/improvements that could be made;
% they're left as an exercise for the reader.

% For a more efficient version (using backtrackable destructive update),
% see extras/trailed_update/samples/interpreter.m.

% This source file is hereby placed in the public domain.  -fjh (the author).

%-----------------------------------------------------------------------------%

:- module interpreter.
:- interface.
:- import_module io.

:- pred main(io__state, io__state).
:- mode main(di, uo) is det.

%-----------------------------------------------------------------------------%

:- implementation.
:- import_module list, string, term, varset, term_io, require, std_util.

main -->
	io__write_string("Pure Prolog Interpreter.\n\n"),
	io__command_line_arguments(Args),
	( { Args = [] } ->
		io__stderr_stream(StdErr),
		io__write_string(StdErr, "Usage: interpreter filename ...\n"),
		io__set_exit_status(1)
	;
		{ database_init(Database0) },
		consult_list(Args, Database0, Database),
		main_loop(Database)
	).

:- pred main_loop(database, io__state, io__state).
:- mode main_loop(in, di, uo) is det.

main_loop(Database) -->
	io__write_string("?- "),
	term_io__read_term(ReadTerm),
	main_loop_2(ReadTerm, Database).

:- pred main_loop_2(read_term, database, io__state, io__state).
:- mode main_loop_2(in, in, di, uo) is det.

main_loop_2(eof, _Database) --> [].
main_loop_2(error(ErrorMessage, LineNumber), Database) -->
	io__write_string("Error reading term at line "),
	io__write_int(LineNumber),
	io__write_string(" of standard input: "),
	io__write_string(ErrorMessage),
	io__write_string("\n"),
	main_loop(Database).
main_loop_2(term(VarSet0, Goal), Database) -->
	%%% It would be a good idea to add some special commands
	%%% with side-effects (such as `consult' and `listing');
	%%% these could be identified and processed here.
	{ solutions(solve(Database, Goal, VarSet0), Solutions) },
	write_solutions(Solutions, Goal),
	main_loop(Database).

:- pred write_solutions(list(varset), term, io__state, io__state).
:- mode write_solutions(in, in, di, uo) is det.

write_solutions(Solutions, Goal) -->
	( { Solutions = [] } ->
		io__write_string("No.\n")
	;
		write_solutions_2(Solutions, Goal),
		io__write_string("Yes.\n")
	).

:- pred write_solutions_2(list(varset), term, io__state, io__state).
:- mode write_solutions_2(in, in, di, uo) is det.

write_solutions_2([], _) --> [].
write_solutions_2([VarSet | VarSets], Goal) -->
	term_io__write_term_nl(VarSet, Goal),
	write_solutions_2(VarSets, Goal).

%-----------------------------------------------------------------------------%

:- pred consult_list(list(string), database, database, io__state, io__state).
:- mode consult_list(in, in, out, di, uo) is det.

consult_list([], Database, Database) --> [].
consult_list([File | Files], Database0, Database) -->
	consult(File, Database0, Database1),
	consult_list(Files, Database1, Database).

:- pred consult(string, database, database, io__state, io__state).
:- mode consult(in, in, out, di, uo) is det.

consult(File, Database0, Database) -->
	io__write_string("Consulting file `"),
	io__write_string(File),
	io__write_string("'...\n"),
	io__see(File, Result),
	( { Result = ok } ->
		consult_until_eof(Database0, Database),
		io__seen
	;
		io__write_string("Error opening file `"),
		io__write_string(File),
		io__write_string("' for input.\n"),
		{ Database = Database0 }
	).

:- pred consult_until_eof(database, database, io__state, io__state).
:- mode consult_until_eof(in, out, di, uo) is det.

consult_until_eof(Database0, Database) -->
	term_io__read_term(ReadTerm),
	consult_until_eof_2(ReadTerm, Database0, Database).

:- pred consult_until_eof_2(read_term, database, database,
				io__state, io__state).
:- mode consult_until_eof_2(in, in, out, di, uo) is det.

consult_until_eof_2(eof, Database, Database) --> [].

consult_until_eof_2(error(ErrorMessage, LineNumber), Database0, Database) -->
	io__write_string("Error reading term at line "),
	io__write_int(LineNumber),
	io__write_string(" of standard input: "),
	io__write_string(ErrorMessage),
	io__write_string("\n"),
	consult_until_eof(Database0, Database).

consult_until_eof_2(term(VarSet, Term), Database0, Database) -->
	{ database_assert_clause(Database0, VarSet, Term, Database1) },
	consult_until_eof(Database1, Database).

%-----------------------------------------------------------------------------%

% Solve takes a database of rules and facts, a goal to be solved,
% and a varset (which includes a supply of fresh vars, a substitution,
% and names for [some subset of] the variables).  It updates
% the varset, producing a new substitution and perhaps introducing
% some new vars, and returns the result.

% Goals are stored just as terms.
% (It might be more efficient to parse them 
% before storing them in the database.  Currently we do
% this parsing work every time we interpret a clause.)

:- pred solve(database, term, varset, varset).
:- mode solve(in, in, in, out) is nondet.

solve(_Database, term__functor(term__atom("true"), [], _)) --> [].

solve(Database, term__functor(term__atom(","), [A, B], _)) -->
	solve(Database, A),
	solve(Database, B).

solve(Database, term__functor(term__atom(";"), [A, B], _)) -->
	solve(Database, A)
	;
	solve(Database, B).

solve(_Database, term__functor(term__atom("="), [A, B], _)) -->
	unify(A, B).

solve(Database, Goal) -->
	{ database_lookup_clause(Database, Goal, ClauseVarSet, Head0, Body0) },
	rename_apart(ClauseVarSet, [Head0, Body0], [Head, Body]),
	unify(Goal, Head),
	solve(Database, Body).

%-----------------------------------------------------------------------------%

:- pred rename_apart(varset, list(term), list(term), varset, varset).
:- mode rename_apart(in, in, out, in, out) is det.

rename_apart(NewVarSet, Terms0, Terms, VarSet0, VarSet) :-
	varset__merge(VarSet0, NewVarSet, Terms0, VarSet, Terms).

%-----------------------------------------------------------------------------%

% The standard library module `term' contains routines for
% unifying terms based on separate substitutions, but we are
% using the substitutions that are contained in the `varset',
% so we can't use those versions.

:- pred unify(term, term, varset, varset).
:- mode unify(in, in, in, out) is semidet.

unify(term__variable(X), term__variable(Y), VarSet0, VarSet) :-
	(
		varset__search_var(VarSet0, X, BindingOfX)
	->
		(
			varset__search_var(VarSet0, Y, BindingOfY)
		->
			% both X and Y already have bindings - just
			% unify the terms they are bound to
			unify(BindingOfX, BindingOfY, VarSet0, VarSet)
		;
			% Y is a variable which hasn't been bound yet
			apply_rec_substitution(BindingOfX, VarSet0,
				SubstBindingOfX),
			( SubstBindingOfX = term__variable(Y) ->
			 	VarSet = VarSet0
			;
				\+ occurs(SubstBindingOfX, Y, VarSet0),
				varset__bind_var(VarSet0, Y, SubstBindingOfX,
					VarSet)
			)
		)
	;
		(
			varset__search_var(VarSet0, Y, BindingOfY2)
		->
			% X is a variable which hasn't been bound yet
			apply_rec_substitution(BindingOfY2, VarSet0,
				SubstBindingOfY2),
			( SubstBindingOfY2 = term__variable(X) ->
				VarSet = VarSet0
			;
				\+ occurs(SubstBindingOfY2, X, VarSet0),
				varset__bind_var(VarSet0, X, SubstBindingOfY2,
					VarSet)
			)
		;
			% both X and Y are unbound variables -
			% bind one to the other
			( X = Y ->
				VarSet = VarSet0
			;
				varset__bind_var(VarSet0, X, term__variable(Y),
					VarSet)
			)
		)
	).

unify(term__variable(X), term__functor(F, As, C), VarSet0, VarSet) :-
	(
		varset__search_var(VarSet0, X, BindingOfX)
	->
		unify(BindingOfX, term__functor(F, As, C), VarSet0,
			VarSet)
	;
		\+ occurs_list(As, X, VarSet0),
		varset__bind_var(VarSet0, X, term__functor(F, As, C), VarSet)
	).

unify(term__functor(F, As, C), term__variable(X), VarSet0, VarSet) :-
	(
		varset__search_var(VarSet0, X, BindingOfX)
	->
		unify(term__functor(F, As, C), BindingOfX, VarSet0,
			VarSet)
	;
		\+ occurs_list(As, X, VarSet0),
		varset__bind_var(VarSet0, X, term__functor(F, As, C), VarSet)
	).

unify(term__functor(F, AsX, _), term__functor(F, AsY, _)) -->
	unify_list(AsX, AsY).

:- pred unify_list(list(term), list(term), varset, varset).
:- mode unify_list(in, in, in, out) is semidet.

unify_list([], []) --> [].
unify_list([X | Xs], [Y | Ys]) -->
	unify(X, Y),
	unify_list(Xs, Ys).

%-----------------------------------------------------------------------------%

	% occurs(Term, Var, Subst) succeeds if Term contains Var,
	% perhaps indirectly via the substitution.  (The variable must
	% not be mapped by the substitution.)

:- pred occurs(term, var, varset).
:- mode occurs(in, in, in) is semidet.

occurs(term__variable(X), Y, VarSet) :-
	X = Y
	;
	varset__search_var(VarSet, X, BindingOfX),
	occurs(BindingOfX, Y, VarSet).
occurs(term__functor(_F, As, _), Y, VarSet) :-
	occurs_list(As, Y, VarSet).

:- pred occurs_list(list(term), var, varset).
:- mode occurs_list(in, in, in) is semidet.

occurs_list([Term | Terms], Y, VarSet) :-
	occurs(Term, Y, VarSet)
	;
	occurs_list(Terms, Y, VarSet).

%-----------------------------------------------------------------------------%

%	apply_rec_substitution(Term0, VarSet, Term) :
%		recursively apply substitution to Term0 until
%		no more substitions can be applied, and then
%		return the result in Term.

:- pred apply_rec_substitution(term, varset, term).
:- mode apply_rec_substitution(in, in, out) is det.

apply_rec_substitution(term__variable(Var), VarSet, Term) :-
	(
		varset__search_var(VarSet, Var, Replacement)
	->
		% recursively apply the substition to the replacement
		apply_rec_substitution(Replacement, VarSet, Term)
	;
		Term = term__variable(Var)
	).
apply_rec_substitution(term__functor(Name, Args0, Context), VarSet,
		 term__functor(Name, Args, Context)) :-
	apply_rec_substitution_to_list(Args0, VarSet, Args).

:- pred apply_rec_substitution_to_list(list(term), varset, list(term)).
:- mode apply_rec_substitution_to_list(in, in, out) is det.

apply_rec_substitution_to_list([], _VarSet, []).
apply_rec_substitution_to_list([Term0 | Terms0], VarSet,
		[Term | Terms]) :-
	apply_rec_substitution(Term0, VarSet, Term),
	apply_rec_substitution_to_list(Terms0, VarSet, Terms).

%-----------------------------------------------------------------------------%

% We store the database just as a list of clauses.
% (It would be more realistic to index this on the predicate name/arity
% and subindex on the name/arity of the first argument.)

:- type database == list(clause).
:- type clause ---> clause(varset, term, term).

:- pred database_init(database).
:- mode database_init(out) is det.

database_init([]).

:- pred database_assert_clause(database, varset, term, database).
:- mode database_assert_clause(in, in, in, out) is det.

database_assert_clause(Database, VarSet, Term, [Clause | Database]) :-
	( Term = term__functor(term__atom(":-"), [H, B], _) ->
		Head = H,
		Body = B
	;
		Head = Term,
		term__context_init(Context),
		Body = term__functor(term__atom("true"), [], Context)
	),
	Clause = clause(VarSet, Head, Body).

:- pred database_lookup_clause(database, term, varset, term, term).
:- mode database_lookup_clause(in, in, out, out, out) is nondet.

database_lookup_clause(Database, _Goal, VarSet, Head, Body) :-
	list__member(Clause, Database),
	Clause = clause(VarSet, Head, Body).

%-----------------------------------------------------------------------------%

New File: tests/debugger/queens.exp
===================================================================
       1:      1  1 CALL CCMUL queens:main/2-0 
mtrace> mtrace>           HeadVar__1           		state('<<c_pointer>>')
       2:      2  2 CALL DET   queens:data/1-0 
mtrace> mtrace> mtrace: no live variables
       3:      2  2 EXIT DET   queens:data/1-0 
mtrace> mtrace>           HeadVar__1           		[1, 2, 3, 4, 5]
       4:      3  2 CALL NON   queens:queen/2-0 
mtrace> mtrace>           HeadVar__1           		[1, 2, 3, 4, 5]
       5:      4  3 CALL NON   queens:qperm/2-0 
mtrace> mtrace>           HeadVar__1           		[1, 2, 3, 4, 5]
       6:      4  3 SWTC NON   queens:qperm/2-0 s1;
mtrace> mtrace>           HeadVar__1           		[1, 2, 3, 4, 5]
       7:      5  4 CALL NON   queens:qdelete/3-0 
mtrace> mtrace>           HeadVar__2           		[1, 2, 3, 4, 5]
       8:      5  4 DISJ NON   queens:qdelete/3-0 c2;d1;
mtrace> mtrace>           HeadVar__2           		[1, 2, 3, 4, 5]
          V_11                 		1
          V_10                 		[2, 3, 4, 5]
       9:      5  4 EXIT NON   queens:qdelete/3-0 
mtrace> mtrace>           HeadVar__1           		1
          HeadVar__3           		[2, 3, 4, 5]
          HeadVar__2           		[1, 2, 3, 4, 5]
      10:      6  4 CALL NON   queens:qperm/2-0 
mtrace> mtrace>           HeadVar__1           		[2, 3, 4, 5]
      11:      6  4 SWTC NON   queens:qperm/2-0 s1;
mtrace> mtrace>           HeadVar__1           		[2, 3, 4, 5]
      12:      7  5 CALL NON   queens:qdelete/3-0 
mtrace> mtrace>           HeadVar__2           		[2, 3, 4, 5]
      13:      7  5 DISJ NON   queens:qdelete/3-0 c2;d1;
mtrace> mtrace>           HeadVar__2           		[2, 3, 4, 5]
          V_11                 		2
          V_10                 		[3, 4, 5]
      14:      7  5 EXIT NON   queens:qdelete/3-0 
mtrace> mtrace>           HeadVar__1           		2
          HeadVar__3           		[3, 4, 5]
          HeadVar__2           		[2, 3, 4, 5]
      15:      8  5 CALL NON   queens:qperm/2-0 
mtrace> mtrace>           HeadVar__1           		[3, 4, 5]
      16:      8  5 SWTC NON   queens:qperm/2-0 s1;
mtrace> mtrace>           HeadVar__1           		[3, 4, 5]
      17:      9  6 CALL NON   queens:qdelete/3-0 
mtrace> mtrace>           HeadVar__2           		[3, 4, 5]
      18:      9  6 DISJ NON   queens:qdelete/3-0 c2;d1;
mtrace> mtrace>           HeadVar__2           		[3, 4, 5]
          V_11                 		3
          V_10                 		[4, 5]
      19:      9  6 EXIT NON   queens:qdelete/3-0 
mtrace> mtrace>           HeadVar__1           		3
          HeadVar__3           		[4, 5]
          HeadVar__2           		[3, 4, 5]
      20:     10  6 CALL NON   queens:qperm/2-0 
mtrace> mtrace>           HeadVar__1           		[4, 5]
      21:     10  6 SWTC NON   queens:qperm/2-0 s1;
mtrace> mtrace>           HeadVar__1           		[4, 5]
      22:     11  7 CALL NON   queens:qdelete/3-0 
mtrace> mtrace>           HeadVar__2           		[4, 5]
      23:     11  7 DISJ NON   queens:qdelete/3-0 c2;d1;
mtrace> mtrace>           HeadVar__2           		[4, 5]
          V_11                 		4
          V_10                 		[5]
      24:     11  7 EXIT NON   queens:qdelete/3-0 
mtrace> mtrace>           HeadVar__1           		4
          HeadVar__3           		[5]
          HeadVar__2           		[4, 5]
      25:     12  7 CALL NON   queens:qperm/2-0 
mtrace> mtrace>           HeadVar__1           		[5]
      26:     12  7 SWTC NON   queens:qperm/2-0 s1;
mtrace> mtrace>           HeadVar__1           		[5]
      27:     13  8 CALL NON   queens:qdelete/3-0 
mtrace> mtrace>           HeadVar__2           		[5]
      28:     13  8 DISJ NON   queens:qdelete/3-0 c2;d1;
mtrace> mtrace>           HeadVar__2           		[5]
          V_11                 		5
          V_10                 		[]
      29:     13  8 EXIT NON   queens:qdelete/3-0 
mtrace> mtrace>           HeadVar__1           		5
          HeadVar__3           		[]
          HeadVar__2           		[5]
      30:     14  8 CALL NON   queens:qperm/2-0 
mtrace> mtrace>           HeadVar__1           		[]
      31:     14  8 SWTC NON   queens:qperm/2-0 s2;
mtrace> mtrace>       32:     14  8 EXIT NON   queens:qperm/2-0 
mtrace> mtrace>           HeadVar__2           		[]
          HeadVar__1           		[]
      33:     12  7 EXIT NON   queens:qperm/2-0 
mtrace> mtrace>           HeadVar__2           		[5]
          HeadVar__1           		[5]
      34:     10  6 EXIT NON   queens:qperm/2-0 
mtrace> mtrace>           HeadVar__2           		[4, 5]
          HeadVar__1           		[4, 5]
      35:      8  5 EXIT NON   queens:qperm/2-0 
mtrace> mtrace>           HeadVar__2           		[3, 4, 5]
          HeadVar__1           		[3, 4, 5]
      36:      6  4 EXIT NON   queens:qperm/2-0 
mtrace> mtrace>           HeadVar__2           		[2, 3, 4, 5]
          HeadVar__1           		[2, 3, 4, 5]
      37:      4  3 EXIT NON   queens:qperm/2-0 
mtrace> mtrace>           HeadVar__2           		[1, 2, 3, 4, 5]
          HeadVar__1           		[1, 2, 3, 4, 5]
      38:     15  3 CALL SEMI  queens:safe/1-0 
mtrace> mtrace>           HeadVar__1           		[1, 2, 3, 4, 5]
      39:     15  3 SWTC SEMI  queens:safe/1-0 s1;
mtrace> mtrace>           HeadVar__1           		[1, 2, 3, 4, 5]
      40:     16  4 CALL SEMI  queens:nodiag/3-0 
mtrace> mtrace>           HeadVar__1           		1
          HeadVar__2           		1
          HeadVar__3           		[2, 3, 4, 5]
      41:     16  4 SWTC SEMI  queens:nodiag/3-0 s1;
mtrace> mtrace>           HeadVar__1           		1
          HeadVar__2           		1
          HeadVar__3           		[2, 3, 4, 5]
[1, 3, 5, 2, 4]

New File: tests/debugger/queens.inp
===================================================================
p

p

p

p

p

p

p

p

p

p

p

p

p

p

p

p

p

p

p

p

p

p

p

p

p

p

p

p

p

p

p

p

p

p

p

p

p

p

p

p

p
c

New File: tests/debugger/queens.m
===================================================================
:- module queens.

:- interface.

:- import_module io.

:- pred main(io__state, io__state).
:- mode main(di, uo) is cc_multi.

:- implementation.

:- import_module list, int.

main -->
	( { data(Data), queen(Data, Out) } ->
		print_list(Out)
	;
		io__write_string("No solution\n")
	).

:- pred data(list(int)).
:- mode data(out) is det.

:- pred queen(list(int), list(int)).
:- mode queen(in, out) is nondet.

:- pred qperm(list(T), list(T)).
:- mode qperm(in, out) is nondet.

:- pred qdelete(T, list(T), list(T)).
:- mode qdelete(out, in, out) is nondet.

:- pred safe(list(int)).
:- mode safe(in) is semidet.

:- pred nodiag(int, int, list(int)).
:- mode nodiag(in, in, in) is semidet.

data([1,2,3,4,5]).

queen(Data, Out) :-
	qperm(Data, Out),
	safe(Out).

qperm([], []).
qperm([X|Y], K) :-
	qdelete(U, [X|Y], Z),
	K = [U|V],
	qperm(Z, V).

qdelete(A, [A|L], L).
qdelete(X, [A|Z], [A|R]) :-
	qdelete(X, Z, R).

safe([]).
safe([N|L]) :-
	nodiag(N, 1, L),
	safe(L).

nodiag(_, _, []).
nodiag(B, D, [N|L]) :-
	NmB is N - B,
	BmN is B - N,
	( D = NmB ->
		fail
	; D = BmN ->
		fail
	;
		true
	),
	D1 is D + 1,
	nodiag(B, D1, L).

:- pred print_list(list(int), io__state, io__state).
:- mode print_list(in, di, uo) is det.

print_list(Xs) -->
	(
		{ Xs = [] }
	->
		io__write_string("[]\n")
	;
		io__write_string("["),
		print_list_2(Xs),
		io__write_string("]\n")
	).

:- pred print_list_2(list(int), io__state, io__state).
:- mode print_list_2(in, di, uo) is det.

print_list_2([]) --> [].
print_list_2([X|Xs]) --> 
	io__write_int(X),
	(
		{ Xs = [] }
	->
		[]
	;
		io__write_string(", "),
		print_list_2(Xs)
	).

New File: tests/debugger/runtests
===================================================================
#!/bin/sh
# Test whether the code generated by the Mercury compiler
# is producing the expected output.
# Return a status of 0 (true) if everything is all right, and 1 otherwise.

. ../handle_options

mmake $jfactor clean > /dev/null 2>&1
mmake $jfactor depend || exit 1
eval mmake -k $jfactor $gradeopt $flagsopt $cflagsopt check
checkstatus=$?

cat *.res > .allres
if test ! -s .allres -a "$checkstatus" = 0
then
	echo "the tests in the debugger directory succeeded"
	rm -f .allres
	exit 0
else
	echo "the tests in the debugger directory failed"
	echo "the differences are:"
	cat .allres
	exit 1
fi





More information about the developers mailing list