for review: better debugging of llds instructions

[Zoltan Somogyi]

dupelim:
	Preserve the comments attached to labels, for debugging purposes.

llds_out:
	Add a predicate that displays an instruction and its comment for
	debugging. (Previously, you could only print the instruction
	for debugging.)

opt_debug:
	Print comments on instructions if --auto-comments is given.

Zoltan.

Index: compiler/dupelim.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/dupelim.m,v
retrieving revision 1.22
diff -u -u -r1.22 dupelim.m
--- dupelim.m	1997/08/25 17:48:09	1.22
+++ dupelim.m	1997/10/23 11:09:19
@@ -28,7 +28,7 @@
 
 :- import_module opt_util.
 
-:- type block == pair(label, list(instruction)).
+:- type block	--->	 block(label, string, list(instruction)).
 
 dupelim_main(Instrs0, Instrs) :-
 	map__init(Seqmap0),
@@ -48,10 +48,10 @@
 dupelim__make_blocks(Instrs0, Blocks) :-
 	( Instrs0 = [] ->
 		Blocks = []
-	; Instrs0 = [label(BlockLabel) - _ | Instrs1] ->
+	; Instrs0 = [label(BlockLabel) - Comment | Instrs1] ->
 		opt_util__skip_to_next_label(Instrs1, BlockCode, Instrs2),
 		dupelim__make_blocks(Instrs2, Blocks1),
-		Blocks = [BlockLabel - BlockCode | Blocks1]
+		Blocks = [block(BlockLabel, Comment, BlockCode) | Blocks1]
 	;
 		error("instruction other than label in dupelim__make_blocks")
 	).
@@ -72,7 +72,7 @@
 % the previous block.
 
 dupelim__build_maps([], _FallInto, _Seqmap, Replmap, Replmap).
-dupelim__build_maps([Label - Code | Blocks1], FallInto, Seqmap0,
+dupelim__build_maps([block(Label, _, Code) | Blocks1], FallInto, Seqmap0,
 		Replmap0, Replmap) :-
 	(
 		list__reverse(Code, RevCode0),
@@ -112,13 +112,14 @@
 :- mode dupelim__replace_labels(in, in, out) is det.
 
 dupelim__replace_labels([], _Replmap, []).
-dupelim__replace_labels([Label - Code | Blocks1], Replmap, Blocks) :-
+dupelim__replace_labels([block(Label, Comment, Code) | Blocks1],
+		Replmap, Blocks) :-
 	( map__search(Replmap, Label, _) ->
 		dupelim__replace_labels(Blocks1, Replmap, Blocks)
 	;
 		dupelim__replace_labels_instr_list(Code, Replmap, Code1),
 		dupelim__replace_labels(Blocks1, Replmap, Blocks2),
-		Blocks = [Label - Code1 | Blocks2]
+		Blocks = [block(Label, Comment, Code1) | Blocks2]
 	).
 
 :- pred dupelim__replace_labels_instr_list(list(instruction), map(label, label),
@@ -312,6 +313,6 @@
 :- mode dupelim__condense(in, out) is det.
 
 dupelim__condense([], []).
-dupelim__condense([Label - Code | Blocks1], Instrs) :-
+dupelim__condense([block(Label, Comment, Code) | Blocks1], Instrs) :-
 	dupelim__condense(Blocks1, Instrs1),
-	list__append([label(Label) - "" | Code], Instrs1, Instrs).
+	list__append([label(Label) - Comment | Code], Instrs1, Instrs).
Index: compiler/llds_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/llds_out.m,v
retrieving revision 1.59
diff -u -u -r1.59 llds_out.m
--- llds_out.m	1997/10/12 13:32:34	1.59
+++ llds_out.m	1997/10/23 10:41:03
@@ -37,7 +37,15 @@
 :- pred llds_out__binary_op_to_string(binary_op, string).
 :- mode llds_out__binary_op_to_string(in, out) is det.
 
-	% Output an instruction (used for debugging).
+	% Output an instruction and (if the third arg is yes) the comment.
+	% This predicate is provided for debugging use only.
+
+:- pred output_instruction_and_comment(instr, string, bool,
+	io__state, io__state).
+:- mode output_instruction_and_comment(in, in, in, di, uo) is det.
+
+	% Output an instruction.
+	% This predicate is provided for debugging use only.
 
 :- pred output_instruction(instr, io__state, io__state).
 :- mode output_instruction(in, di, uo) is det.
@@ -882,7 +890,17 @@
 		)
 	).
 
-	% output_instruction/2 is only for debugging.
+	% output_instruction_and_comment/5 is only for debugging.
+	% Normally we use output_instruction_and_comment/6.
+
+output_instruction_and_comment(Instr, Comment, PrintComments) -->
+	{ set__init(ContLabelSet) },
+	{ hlds_pred__initial_proc_id(ProcId) },
+	{ ProfInfo = local(proc("DEBUG", predicate, "DEBUG", "DEBUG", 0,
+			ProcId)) - ContLabelSet },
+	output_instruction_and_comment(Instr, Comment, PrintComments, ProfInfo).
+
+	% output_instruction/3 is only for debugging.
 	% Normally we use output_instruction/4.
 
 output_instruction(Instr) -->
Index: compiler/opt_debug.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/opt_debug.m,v
retrieving revision 1.72
diff -u -u -r1.72 opt_debug.m
--- opt_debug.m	1997/08/25 17:48:31	1.72
+++ opt_debug.m	1997/10/23 10:51:29
@@ -185,7 +185,7 @@
 
 :- implementation.
 
-:- import_module llds_out, opt_util, vn_util, hlds_pred.
+:- import_module llds_out, opt_util, vn_util, hlds_pred, globals, options.
 :- import_module int, set, map, string.
 
 opt_debug__msg(OptDebug, Msg) -->
@@ -201,18 +201,19 @@
 opt_debug__dump_instrs(OptDebug, Instrs) -->
 	(
 		{ OptDebug = yes },
-		opt_debug__dump_instrs_2(Instrs)
+		globals__io_lookup_bool_option(auto_comments, PrintComments),
+		opt_debug__dump_instrs_2(Instrs, PrintComments)
 	;
 		{ OptDebug = no }
 	).
 
-:- pred opt_debug__dump_instrs_2(list(instruction), io__state, io__state).
-:- mode opt_debug__dump_instrs_2(in, di, uo) is det.
+:- pred opt_debug__dump_instrs_2(list(instruction), bool, io__state, io__state).
+:- mode opt_debug__dump_instrs_2(in, in, di, uo) is det.
 
-opt_debug__dump_instrs_2([]) --> [].
-opt_debug__dump_instrs_2([Uinstr - _ | Instrs]) -->
-	output_instruction(Uinstr),
-	opt_debug__dump_instrs_2(Instrs).
+opt_debug__dump_instrs_2([], _PrintComments) --> [].
+opt_debug__dump_instrs_2([Uinstr - Comment | Instrs], PrintComments) -->
+	output_instruction_and_comment(Uinstr, Comment, PrintComments),
+	opt_debug__dump_instrs_2(Instrs, PrintComments).
 
 opt_debug__dump_node_relmap(Relmap, Str) :-
 	map__to_assoc_list(Relmap, Nodemap),