for review: rewrite of duplicate elimination.

[Zoltan Somogyi]

Estimated hours taken: 20

Give duplicate code elimination more teeth in dealing with similar arguments
of difference function symbols. For the source code

	:- type t1	--->	f(int)
			;	g(int, int).

	:- pred p1(t1::in, int::out) is det.

	p1(f(Y), Y).
	p1(g(Y, _), Y).

we now generate the C code

	Define_entry(mercury__xdup__p1_2_0);
		r1 = const_mask_field(r1, (Integer) 0);
		proceed();

thus avoiding the cost of testing the function symbol.

runtime/mercury_tags.h:
	Add two new macros, mask_field and const_mask_field, that behave
	just like field and const_field except that instead of stripping
	off a known tag from the pointer, they strip (mask) off an unknown
	tag.

compiler/llds.m:
	Change the first argument of the lval field/3 from tag to maybe(tag).

	Make the comments on some types more readable.

compiler/llds_out.m:
	If the first arg of the lval field/3 is no, emit a (const_)mask_field
	macro; otherwise, emit a (const_)field macro.

compiler/basic_block.m:
	New module to convert sequences of instructions to sequences of
	basic blocks and vice versa. Used in the new dupelim.m.

compiler/dupelim.m:
	Complete rewrite to give duplicate code elimination more teeth.
	Whereas previously we eliminated blocks of code only if they exactly
	duplicated other blocks of code, we now look for blocks that can be
	"anti-unified". For example, the blocks

	r1 = field(mktag(0), r2, 0)
	goto L1

	and

	r1 = field(mktag(1), r2, 0)
	<fall through to L1>

	anti-unify, with the most specific common generalization being

	r1 = mask_field(r2, 0)
	goto L1

	If several basic blocks antiunify, we replace one copy with the
	antiunified block and try to eliminate the others. We do not
	eliminate blocks that can be fallen into, since eliminating them
	would require introducing a goto, which would slow the code down.

compiler/peephole,m:
	If a conditional branch to a label is followed by that label or
	by an unconditional branch to that label, eliminate the branch.
	Dupelim produces this kind of code.

compiler/{code_exprn,exprn_aux,lookup_switch,opt_debug,unify_gen}.m:
	Minor changes required by the change to field/3.

compiler/{frameopt,jumpopt,labelopt,mercury_compile,optimize,value_number}.m:
	s/__main/_main/ in predicate names.

compiler/jumpopt.m:
	Add some documentation.

compiler/unify_gen.m:
	Fix a module qualified predicate name reference that would not
	work in Prolog.

Zoltan.

Index: compiler/code_exprn.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/code_exprn.m,v
retrieving revision 1.53
diff -u -r1.53 code_exprn.m
--- code_exprn.m	1997/12/05 15:47:04	1.53
+++ code_exprn.m	1997/12/09 02:26:24
@@ -1317,7 +1317,7 @@
 	(
 		{ R = yes(Rval) }
 	->
-		{ Target0 = field(Tag, lval(Lval), const(int_const(N0))) },
+		{ Target0 = field(yes(Tag), lval(Lval), const(int_const(N0))) },
 		{ MaybeTarget = yes(Target0) },
 		code_exprn__place_arg(Rval, yes(Target0), _, Code0)
 	;
Index: compiler/exprn_aux.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/exprn_aux.m,v
retrieving revision 1.25
diff -u -r1.25 exprn_aux.m
--- exprn_aux.m	1997/12/19 03:06:33	1.25
+++ exprn_aux.m	1997/12/21 09:09:34
@@ -717,15 +717,21 @@
 
 exprn_aux__simplify_rval_2(Rval0, Rval) :-
 	(
-		Rval0 = lval(field(Tag, create(Tag, Args, _, _, _), Field)),
+		Rval0 = lval(field(MaybeTag, Base, Field)),
+		Base = create(Tag, Args, _, _, _),
+		(
+			MaybeTag = yes(Tag)
+		;
+			MaybeTag = no
+		),
 		Field = const(int_const(FieldNum))
 	->
 		list__index0_det(Args, FieldNum, yes(Rval))
 	;
-		Rval0 = lval(field(Tag, Rval1, Num)),
+		Rval0 = lval(field(MaybeTag, Rval1, Num)),
 		exprn_aux__simplify_rval_2(Rval1, Rval2)
 	->
-		Rval = lval(field(Tag, Rval2, Num))
+		Rval = lval(field(MaybeTag, Rval2, Num))
 	;
 		Rval0 = create(Tag, Args0, Unique, CNum, Msg),
 		exprn_aux__simplify_args(Args0, Args),
@@ -733,20 +739,20 @@
 	->
 		Rval = create(Tag, Args, Unique, CNum, Msg)
 	;
-		Rval0 = unop(UOp, Rval1),
+		Rval0 = unop(UnOp, Rval1),
 		exprn_aux__simplify_rval_2(Rval1, Rval2)
 	->
-		Rval = unop(UOp, Rval2)
+		Rval = unop(UnOp, Rval2)
 	;
-		Rval0 = binop(BOp, Rval1, Rval2),
+		Rval0 = binop(BinOp, Rval1, Rval2),
 		exprn_aux__simplify_rval_2(Rval1, Rval3)
 	->
-		Rval = binop(BOp, Rval3, Rval2)
+		Rval = binop(BinOp, Rval3, Rval2)
 	;
-		Rval0 = binop(BOp, Rval1, Rval2),
+		Rval0 = binop(BinOp, Rval1, Rval2),
 		exprn_aux__simplify_rval_2(Rval2, Rval3)
 	->
-		Rval = binop(BOp, Rval1, Rval3)
+		Rval = binop(BinOp, Rval1, Rval3)
 	;
 		fail
 	).
Index: compiler/frameopt.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/frameopt.m,v
retrieving revision 1.64
diff -u -r1.64 frameopt.m
--- frameopt.m	1997/12/05 15:47:13	1.64
+++ frameopt.m	1997/12/11 07:29:29
@@ -96,7 +96,7 @@
 	% deleted. The second says whether we introduced any jumps that
 	% can be profitably be short-circuited.
 
-:- pred frameopt__main(list(instruction)::in, list(instruction)::out,
+:- pred frameopt_main(list(instruction)::in, list(instruction)::out,
 	bool::out, bool::out) is det.
 
 %-----------------------------------------------------------------------------%
@@ -106,7 +106,7 @@
 :- import_module livemap, prog_data, opt_util, code_util, opt_debug.
 :- import_module int, string, require, std_util, assoc_list, set, map, queue.
 
-frameopt__main(Instrs0, Instrs, Mod, Jumps) :-
+frameopt_main(Instrs0, Instrs, Mod, Jumps) :-
 	opt_util__get_prologue(Instrs0, ProcLabel, LabelInstr,
 		Comments0, Instrs1),
 	(
Index: compiler/jumpopt.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/jumpopt.m,v
retrieving revision 1.40
diff -u -r1.40 jumpopt.m
--- jumpopt.m	1997/07/27 15:00:42	1.40
+++ jumpopt.m	1997/12/10 08:39:15
@@ -7,14 +7,6 @@
 % jumpopt.m - optimize jumps to jumps.
 %
 % Author: zs.
-%
-% We first build up a bunch of tables giving information about labels.
-% This information includes the first instruction following each label,
-% the block following each label, whether a label is part of a procedure
-% epilog of various types (det, semidet or nondet).
-%
-% We then traverse the instruction list, using the information in the
-% tables to short-circuit jumps.
 
 %-----------------------------------------------------------------------------%
 
@@ -22,19 +14,46 @@
 
 :- interface.
 
-:- import_module list, bool.
 :- import_module llds.
+:- import_module list, bool.
 
-:- pred jumpopt__main(list(instruction), bool, bool, list(instruction), bool).
-:- mode jumpopt__main(in, in, in, out, out) is det.
+:- pred jumpopt_main(list(instruction), bool, bool, list(instruction), bool).
+:- mode jumpopt_main(in, in, in, out, out) is det.
 
 %-----------------------------------------------------------------------------%
 
 :- implementation.
 
-:- import_module code_util, opt_util, std_util, map, string, require.
+:- import_module code_util, opt_util.
+:- import_module std_util, map, string, require.
+
+% We first build up a bunch of tables giving information about labels.
+% We then traverse the instruction list, using the information in the
+% tables to short-circuit jumps.
+%
+% Instrmap:	Maps each label to the next real (non-comment, non-livevals)
+%		instruction after that label.
+% Lvalmap:	Maps each label to yes(Livevals) if the label is followed
+%		by a livevals instruction, and to no otherwise.
+% Blockmap:	Maps each label to the block following that label.
+%		This includes all instructions up to the first one that
+%		cannot fall through.
+% Procmap:	Maps each label that begins a det epilog to the epilog.
+% Succmap:	Maps each label that begins a nondet epilog to the epilog.
+% Sdprocmap:	Maps each label that begins a semidet epilog to the epilog.
+%		This can be the success epilog or the failure epilog.
+% Forkmap:	Maps each label that begins a full semidet epilog (code to
+%		test r1, and to execute the the success or failure epilog
+%		depending on the result) to the epilog.
+%
+% If we are not doing full jump optimization, Blockmap will be empty.
+% Even with full jump optimization, Blockmap will not contain the initial
+% block of the procedure unless Recjump is set. The intention is that
+% Recjump will not be set until optimizations such as frameopt and value
+% numbering, which can do a better job of optimizing this block, have
+% been applied.
 
-jumpopt__main(Instrs0, Blockopt, Recjump, Instrs, Mod) :-
+jumpopt_main(Instrs0, Blockopt, Recjump, Instrs, Mod) :-
 	map__init(Instrmap0),
 	map__init(Lvalmap0),
 	map__init(Procmap0),
@@ -52,15 +71,8 @@
 
 %-----------------------------------------------------------------------------%
 
-	% Build up three tables mapping labels to instruction sequences.
-	% A label has an entry in a table if it is followed by a deterministic,
-	% semideterministic or nondeterministic proceed/succeed; the map target
-	% gives the code sequence between the label and the proceed/succeed.
-	% We also build up a map giving the livevals instruction at the label
-	% if any, and the first real instruction at the label.
-
-:- pred jumpopt__build_maps(list(instruction), bool, bool, instrmap, instrmap,
-	tailmap, tailmap, lvalmap, lvalmap,
+:- pred jumpopt__build_maps(list(instruction), bool, bool,
+	instrmap, instrmap, tailmap, tailmap, lvalmap, lvalmap,
 	tailmap, tailmap, tailmap, tailmap, tailmap, tailmap).
 % :- mode jumpopt__build_maps(in, in, in, di, uo, di, uo, di, uo, di, uo,
 %	di, uo, di, uo) is det.
@@ -426,27 +438,27 @@
 			RemainInstrs = [NewInstr | AfterGoto],
 			Mod0 = yes
 		;
-			% Attempt to transform code such as
-			%
-			%	if (Cond) L2
-			%	r1 = TRUE
-			% 	<epilog>
-			%	...
-			% L2:
-			%	r1 = FALSE
-			%	<epilog>
-			%
-			% into
-			%
-			%	r1 = Cond
-			%	<epilog>
-			%
-
 			map__search(Instrmap, TargetLabel, TargetInstr)
 		->
 			jumpopt__final_dest(TargetLabel, TargetInstr,
 				Instrmap, DestLabel, _DestInstr),
 			(
+				% Attempt to transform code such as
+				%
+				%	if (Cond) L1
+				%	r1 = TRUE
+				% 	<epilog>
+				%	...
+				% L1:
+				%	r1 = FALSE
+				%	<epilog>
+				%
+				% into
+				%
+				%	r1 = Cond
+				%	<epilog>
+				%
+
 				opt_util__is_sdproceed_next(Instrs0, BetweenFT),
 				map__search(Blockmap, DestLabel, Block),
 				opt_util__is_sdproceed_next(Block, BetweenBR),
@@ -477,7 +489,8 @@
 				RemainInstrs = Instrs0,
 				Mod0 = yes
 			;
-				% Short-circuit the destination.
+				% Try to short-circuit the destination.
+
 				TargetLabel \= DestLabel
 			->
 				string__append("shortcircuited jump: ",
@@ -636,3 +649,5 @@
 		DestLabel = SrcLabel,
 		DestInstr = SrcInstr
 	).
+
+%-----------------------------------------------------------------------------%
Index: compiler/labelopt.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/labelopt.m,v
retrieving revision 1.16
diff -u -r1.16 labelopt.m
--- labelopt.m	1997/07/27 15:00:43	1.16
+++ labelopt.m	1997/12/10 08:38:35
@@ -22,8 +22,8 @@
 	% If the instruction before the label branches away, we also
 	% remove the instruction block following the label.
 
-:- pred labelopt__main(list(instruction), bool, list(instruction), bool).
-:- mode labelopt__main(in, in, out, out) is det.
+:- pred labelopt_main(list(instruction), bool, list(instruction), bool).
+:- mode labelopt_main(in, in, out, out) is det.
 
 	% Build up a set showing which labels are branched to.
 
@@ -37,11 +37,11 @@
 :- import_module opt_util.
 :- import_module std_util.
 
-labelopt__main(Instrs0, Final, Instrs, Mod) :-
+labelopt_main(Instrs0, Final, Instrs, Mod) :-
 	labelopt__build_useset(Instrs0, Useset),
 	labelopt__instr_list(Instrs0, yes, Useset, Instrs1, Mod),
 	( Final = yes, Mod = yes ->
-		labelopt__main(Instrs1, Final, Instrs, _)
+		labelopt_main(Instrs1, Final, Instrs, _)
 	;
 		Instrs = Instrs1
 	).
Index: compiler/llds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/llds.m,v
retrieving revision 1.215
diff -u -r1.215 llds.m
--- llds.m	1997/12/19 03:07:16	1.215
+++ llds.m	1997/12/21 09:09:52
@@ -305,20 +305,26 @@
 	/* virtual machine registers */
 
 		reg(reg_type, int)
-				% one of the general-purpose virtual machine
-				% registers (either an int or float reg)
-	;	succip		% virtual machine register holding the
-				% return address for det/semidet code
-	;	maxfr		% virtual machine register holding a pointer
-				% to the top of nondet stack
-	;	curfr		% virtual machine register holding a pointer
-				% to the current nondet stack frame
-	;	hp		% virtual machine register holding the heap
-				% pointer
-	;	sp		% virtual machine register point to the
-				% top of det stack
+				% One of the general-purpose virtual machine
+				% registers (either an int or float reg).
+
+	;	succip		% Virtual machine register holding the
+				% return address for det/semidet code.
+
+	;	maxfr		% Virtual machine register holding a pointer
+				% to the top of nondet stack.
+
+	;	curfr		% Virtual machine register holding a pointer
+				% to the current nondet stack frame.
+
+	;	hp		% Virtual machine register holding the heap
+				% pointer.
+
+	;	sp		% Virtual machine register point to the
+				% top of det stack.
+
 	;	temp(reg_type, int)
-				% a local temporary register
+				% A local temporary register.
 				% These temporary registers are actually
 				% local variables declared in `block'
 				% instructions.  They may only be
@@ -332,43 +338,55 @@
 
 	/* values on the stack */
 
-	;	stackvar(int)	% det stack slots (numbered starting from 1)
-				% relative to the current value of `sp'
-				% these are used for both det and semidet code
-	;	framevar(int)	% nondet stack slots (numbered starting from 0)
-				% relative to the current value of `curfr'
+	;	stackvar(int)	% A det stack slot. The number is the offset
+				% relative to the current value of `sp'.
+				% These are used in both det and semidet code.
+				% Stackvar slot numbers start at 1.
+
+	;	framevar(int)	% A nondet stack slot. The reference is
+				% relative to the current value of `curfr'.
+				% These are used in nondet code.
+				% Framevar slot numbers start at 0.
 
-	;	succip(rval)	% the succip slot of the specified
+	;	succip(rval)	% The succip slot of the specified
 				% nondet stack frame; holds the code address
 				% to jump to on successful exit from this
-				% nondet procedure
-	;	redoip(rval)	% the redoip slot of the specified
+				% nondet procedure.
+
+	;	redoip(rval)	% The redoip slot of the specified
 				% nondet stack frame; holds the code address
-				% to jump to on failure
-	;	succfr(rval)	% the succfr slot of the specified
+				% to jump to on failure.
+
+	;	succfr(rval)	% The succfr slot of the specified
 				% nondet stack frame; holds the address of
 				% caller's nondet stack frame.  On successful
 				% exit from this nondet procedure, we will
 				% set curfr to this value.
-	;	prevfr(rval)	% the prevfr slot of the specified
+
+	;	prevfr(rval)	% The prevfr slot of the specified
 				% nondet stack frame; holds the address of
 				% the previous frame on the nondet stack.
 
 	/* values on the heap */
 
-	;	field(tag, rval, rval)
+	;	field(maybe(tag), rval, rval)
 				% field(Tag, Address, FieldNum)
-				% selects a field of a compound term
+				% selects a field of a compound term.
+				% Address is a tagged pointer to a cell
+				% on the heap; the offset into the cell
+				% is FieldNum words. If Tag is yes, the
+				% arg gives the value of the tag; if it is
+				% no, the tag bits will have to be masked off.
 
 	/* values somewhere in memory */
 
-	;	mem_ref(rval)	% a word in the heap, in the det stack or
+	;	mem_ref(rval)	% A word in the heap, in the det stack or
 				% in the nondet stack. The rval should have
 				% originally come from a mem_addr rval.
 
 	/* pseudo-values */
 
-	;	lvar(var).	% the location of the specified variable
+	;	lvar(var).	% The location of the specified variable.
 				% `var' lvals are used during code generation,
 				% but should not be present in the LLDS at any
 				% stage after code generation.
@@ -378,12 +396,14 @@
 	--->	lval(lval)
 		% The value of an `lval' rval is just the value stored in
 		% the specified lval.
+
 	;	var(var)
 		% The value of a `var' rval is just the value of the
 		% specified variable.
 		% `var' rvals are used during code generation,
 		% but should not be present in the LLDS at any
 		% stage after code generation.
+
 	;	create(tag, list(maybe(rval)), bool, int, string)
 		% create(Tag, Arguments, IsUnique, LabelNumber):
 		% A `create' instruction is used during code generation
@@ -407,14 +427,18 @@
 		% The last argument gives the name of the type constructor
 		% of the function symbol of which this is a cell, for use
 		% in memory profiling.
+
 	;	mkword(tag, rval)
-		% given a pointer and a tag,
-		% mkword returns a tagged pointer
+		% Given a pointer and a tag, mkword returns a tagged pointer.
+
 	;	const(rval_const)
+
 	;	unop(unary_op, rval)
+
 	;	binop(binary_op, rval, rval)
+
 	;	mem_addr(mem_ref).
-		% The addess of a word in the heap, the det stack or
+		% The address of a word in the heap, the det stack or
 		% the nondet stack.
 
 :- type mem_ref
Index: compiler/llds_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/llds_out.m,v
retrieving revision 1.66
diff -u -r1.66 llds_out.m
--- llds_out.m	1997/12/19 03:07:18	1.66
+++ llds_out.m	1997/12/21 09:09:54
@@ -2629,11 +2629,16 @@
 output_rval(lval(Lval)) -->
 	% if a field is used as an rval, then we need to use
 	% the const_field() macro, not the field() macro,
-	% to avoid warnings about discarding const.
-	( { Lval = field(Tag, Rval, FieldNum) } ->
-		io__write_string("const_field("),
-		output_tag(Tag),
-		io__write_string(", "),
+	% to avoid warnings about discarding const,
+	% and similarly for mask_field.
+	( { Lval = field(MaybeTag, Rval, FieldNum) } ->
+		( { MaybeTag = yes(Tag) } ->
+			io__write_string("const_field("),
+			output_tag(Tag),
+			io__write_string(", ")
+		;
+			io__write_string("const_mask_field(")
+		),
 		output_rval(Rval),
 		io__write_string(", "),
 		output_rval(FieldNum),
@@ -2833,10 +2838,14 @@
 	io__write_string("bt_succip("),
 	output_rval(Rval),
 	io__write_string(")").
-output_lval(field(Tag, Rval, FieldNum)) -->
-	io__write_string("field("),
-	output_tag(Tag),
-	io__write_string(", "),
+output_lval(field(MaybeTag, Rval, FieldNum)) -->
+	( { MaybeTag = yes(Tag) } ->
+		io__write_string("field("),
+		output_tag(Tag),
+		io__write_string(", ")
+	;
+		io__write_string("mask_field(")
+	),
 	output_rval(Rval),
 	io__write_string(", "),
 	output_rval(FieldNum),
Index: compiler/lookup_switch.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/lookup_switch.m,v
retrieving revision 1.26
diff -u -r1.26 lookup_switch.m
--- lookup_switch.m	1997/12/05 15:47:31	1.26
+++ lookup_switch.m	1997/12/09 02:40:47
@@ -349,7 +349,7 @@
 		BitNum = UIndex
 	;
 		WordNum = binop(/, UIndex, const(int_const(WordBits))),
-		Word = lval(field(0, BitVec, WordNum)),
+		Word = lval(field(yes(0), BitVec, WordNum)),
 		BitNum = binop(mod, UIndex, const(int_const(WordBits)))
 	},
 	{ HasBit = binop((&),
@@ -454,7 +454,7 @@
 	{ construct_args(Vals, 0, Args) },
 	code_info__get_next_cell_number(CellNo),
 	{ ArrayTerm = create(0, Args, no, CellNo, "lookup_switch_data") },
-	{ LookupTerm = lval(field(0, ArrayTerm, Index)) },
+	{ LookupTerm = lval(field(yes(0), ArrayTerm, Index)) },
 	code_info__cache_expression(Var, LookupTerm),
 	lookup_switch__generate_terms_2(Index, Vars, Map).
 
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.67
diff -u -r1.67 mercury_compile.m
--- mercury_compile.m	1997/12/19 04:48:10	1.67
+++ mercury_compile.m	1997/12/21 09:09:57
@@ -1533,7 +1533,7 @@
 		maybe_write_string(Verbose,
 			"% Doing optimizations...\n"),
 		maybe_flush_output(Verbose),
-		optimize__main(LLDS0, LLDS),
+		optimize_main(LLDS0, LLDS),
 		maybe_write_string(Verbose, "% done.\n"),
 		maybe_report_stats(Stats)
 	;
Index: compiler/opt_debug.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/opt_debug.m,v
retrieving revision 1.76
diff -u -r1.76 opt_debug.m
--- opt_debug.m	1997/12/19 03:07:46	1.76
+++ opt_debug.m	1997/12/21 09:10:06
@@ -511,8 +511,12 @@
 	string__append_list(["vn_hp"], Str).
 opt_debug__dump_vnlval(vn_sp, Str) :-
 	string__append_list(["vn_sp"], Str).
-opt_debug__dump_vnlval(vn_field(T, N, F), Str) :-
-	string__int_to_string(T, T_str),
+opt_debug__dump_vnlval(vn_field(MT, N, F), Str) :-
+	( MT = yes(T) ->
+		string__int_to_string(T, T_str)
+	;
+		T_str = "no"
+	),
 	string__int_to_string(N, N_str),
 	string__int_to_string(F, F_str),
 	string__append_list(["vn_field(", T_str, ", ", N_str, ", ",
@@ -591,8 +595,12 @@
 	string__append_list(["hp"], Str).
 opt_debug__dump_lval(sp, Str) :-
 	string__append_list(["sp"], Str).
-opt_debug__dump_lval(field(T, N, F), Str) :-
-	string__int_to_string(T, T_str),
+opt_debug__dump_lval(field(MT, N, F), Str) :-
+	( MT = yes(T) ->
+		string__int_to_string(T, T_str)
+	;
+		T_str = "no"
+	),
 	opt_debug__dump_rval(N, N_str),
 	opt_debug__dump_rval(F, F_str),
 	string__append_list(["field(", T_str, ", ", N_str, ", ",
Index: compiler/optimize.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/optimize.m,v
retrieving revision 1.10
diff -u -r1.10 optimize.m
--- optimize.m	1997/12/10 07:15:48	1.10
+++ optimize.m	1997/12/10 08:38:09
@@ -16,9 +16,9 @@
 
 :- import_module llds, io.
 
-:- pred optimize__main(list(c_procedure), list(c_procedure),
+:- pred optimize_main(list(c_procedure), list(c_procedure),
 	io__state, io__state).
-:- mode optimize__main(in, out, di, uo) is det.
+:- mode optimize_main(in, out, di, uo) is det.
 
 :- pred optimize__proc(c_procedure, c_procedure, io__state, io__state).
 :- mode optimize__proc(in, out, di, uo) is det.
@@ -33,10 +33,10 @@
 :- import_module frameopt, delay_slot, value_number, options.
 :- import_module globals, passes_aux, opt_util, opt_debug, vn_debug.
 
-optimize__main([], []) --> [].
-optimize__main([Proc0|Procs0], [Proc|Procs]) -->
+optimize_main([], []) --> [].
+optimize_main([Proc0|Procs0], [Proc|Procs]) -->
 	optimize__proc(Proc0, Proc), !,
-	optimize__main(Procs0, Procs).
+	optimize_main(Procs0, Procs).
 
 optimize__proc(c_procedure(Name, Arity, PredProcId, Instrs0),
 		   c_procedure(Name, Arity, PredProcId, Instrs)) -->
@@ -105,7 +105,7 @@
 		;
 			[]
 		),
-		value_number__main(Instrs0, Instrs1),
+		value_number_main(Instrs0, Instrs1),
 		( { Instrs1 = Instrs0 } ->
 			[]
 		;
@@ -125,7 +125,7 @@
 		;
 			[]
 		),
-		{ jumpopt__main(Instrs1, FullJumpopt, Final, Instrs2, Mod1) },
+		{ jumpopt_main(Instrs1, FullJumpopt, Final, Instrs2, Mod1) },
 		( { Mod1 = yes } ->
 			opt_debug__msg(DebugOpt, "after jump optimization"),
 			opt_debug__dump_instrs(DebugOpt, Instrs2)
@@ -165,7 +165,7 @@
 		;
 			[]
 		),
-		{ labelopt__main(Instrs3, Final, Instrs4, Mod3) },
+		{ labelopt_main(Instrs3, Final, Instrs4, Mod3) },
 		( { Mod3 = yes } ->
 			opt_debug__msg(DebugOpt, "after label optimization"),
 			opt_debug__dump_instrs(DebugOpt, Instrs4)
@@ -222,7 +222,7 @@
 		;
 			[]
 		),
-		{ frameopt__main(Instrs0, Instrs1, Mod1, Jumps) },
+		{ frameopt_main(Instrs0, Instrs1, Mod1, Jumps) },
 		( { Mod1 = yes } ->
 			opt_debug__msg(DebugOpt, "after frame optimization"),
 			opt_debug__dump_instrs(DebugOpt, Instrs1)
@@ -238,7 +238,7 @@
 			;
 				[]
 			),
-			{ jumpopt__main(Instrs1, FullJumpopt, Final, Instrs2, Mod2) },
+			{ jumpopt_main(Instrs1, FullJumpopt, Final, Instrs2, Mod2) },
 			( { Mod2 = yes } ->
 				opt_debug__msg(DebugOpt, "after jump optimization"),
 				opt_debug__dump_instrs(DebugOpt, Instrs2)
@@ -256,7 +256,7 @@
 			;
 				[]
 			),
-			{ labelopt__main(Instrs2, Final, Instrs, Mod3) },
+			{ labelopt_main(Instrs2, Final, Instrs, Mod3) },
 			( { Mod3 = yes } ->
 				opt_debug__msg(DebugOpt, "after label optimization"),
 				opt_debug__dump_instrs(DebugOpt, Instrs)
@@ -292,7 +292,7 @@
 		;
 			[]
 		),
-		{ labelopt__main(Instrs0, no, Instrs1, Mod1) },
+		{ labelopt_main(Instrs0, no, Instrs1, Mod1) },
 		( { Mod1 = yes } ->
 			opt_debug__msg(DebugOpt, "after label optimization"),
 			opt_debug__dump_instrs(DebugOpt, Instrs1)
Index: compiler/peephole.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/peephole.m,v
retrieving revision 1.69
diff -u -r1.69 peephole.m
--- peephole.m	1997/08/24 01:29:54	1.69
+++ peephole.m	1997/12/10 09:01:02
@@ -81,16 +81,38 @@
 	Instrs = [goto(label(Target)) - Comment | Instrs0].
 
 	% A conditional branch whose condition is constant
-	% can be either elimininated or replaced by an unconditional goto.
+	% can be either eliminated or replaced by an unconditional goto.
+	%
+	% A conditional branch to an address followed by an unconditional
+	% branch to the same address can be eliminated.
+	%
+	% A conditional branch to a label followed by that label
+	% can be eliminated.
 
 peephole__match(if_val(Rval, CodeAddr), Comment, Instrs0, Instrs) :-
-	opt_util__is_const_condition(Rval, Taken),
 	(
-		Taken = yes,
-		Instrs = [goto(CodeAddr) - Comment | Instrs0]
+		opt_util__is_const_condition(Rval, Taken)
+	->
+		(
+			Taken = yes,
+			Instrs = [goto(CodeAddr) - Comment | Instrs0]
+		;
+			Taken = no,
+			Instrs = Instrs0
+		)
 	;
-		Taken = no,
+		opt_util__skip_comments(Instrs0, Instrs1),
+		Instrs1 = [Instr1 | _],
+		Instr1 = goto(CodeAddr) - _
+	->
 		Instrs = Instrs0
+	;
+		CodeAddr = label(Label),
+		opt_util__is_this_label_next(Label, Instrs0, _)
+	->
+		Instrs = Instrs0
+	;
+		fail
 	).
 
 	% If a `mkframe' is followed by a `modframe', with the instructions
Index: compiler/unify_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unify_gen.m,v
retrieving revision 1.85
diff -u -r1.85 unify_gen.m
--- unify_gen.m	1997/12/19 03:08:34	1.85
+++ unify_gen.m	1997/12/21 09:10:28
@@ -214,7 +214,7 @@
 	TestRval = binop(and,
 			binop(eq,	unop(tag, Rval),
 					unop(mktag, const(int_const(Bits)))), 
-			binop(eq,	lval(field(Bits, Rval,
+			binop(eq,	lval(field(yes(Bits), Rval,
 						const(int_const(0)))),
 					const(int_const(Num)))).
 unify_gen__generate_tag_rval_2(complicated_constant_tag(Bits, Num), Rval,
@@ -388,13 +388,13 @@
 		{ Code2 = node([
 			comment("build new closure from old closure") - "",
 			assign(NumOldArgs,
-				lval(field(0, OldClosure, Zero)))
+				lval(field(yes(0), OldClosure, Zero)))
 				- "get number of arguments",
 			incr_hp(NewClosure, no,
 				binop(+, lval(NumOldArgs),
 				NumNewArgsPlusTwo_Rval), "closure")
 				- "allocate new closure",
-			assign(field(0, lval(NewClosure), Zero),
+			assign(field(yes(0), lval(NewClosure), Zero),
 				binop(+, lval(NumOldArgs), NumNewArgs_Rval))
 				- "set new number of arguments",
 			assign(LoopCounter, Zero)
@@ -403,9 +403,9 @@
 			assign(LoopCounter,
 				binop(+, lval(LoopCounter), One))
 				- "increment loop counter",
-			assign(field(0, lval(NewClosure),
+			assign(field(yes(0), lval(NewClosure),
 					lval(LoopCounter)),
-				lval(field(0, OldClosure,
+				lval(field(yes(0), OldClosure,
 					lval(LoopCounter))))
 				- "copy old field",
 			if_val(binop(<=, lval(LoopCounter),
@@ -449,7 +449,7 @@
 		assign(LoopCounter,
 			binop(+, lval(LoopCounter), One))
 			- "increment argument counter",
-		assign(field(0, lval(NewClosure), lval(LoopCounter)),
+		assign(field(yes(0), lval(NewClosure), lval(LoopCounter)),
 			Value)
 			- "set new argument field"
 	]) },
@@ -529,7 +529,7 @@
 unify_gen__make_fields_and_argvars([], _, _, _, [], []).
 unify_gen__make_fields_and_argvars([Var | Vars], Rval, Field0, TagNum,
 		[F | Fs], [A | As]) :-
-	F = lval(field(TagNum, Rval, const(int_const(Field0)))),
+	F = lval(field(yes(TagNum), Rval, const(int_const(Field0)))),
 	A = ref(Var),
 	Field1 is Field0 + 1,
 	unify_gen__make_fields_and_argvars(Vars, Rval, Field1, TagNum, Fs, As).
@@ -755,7 +755,7 @@
 :- mode unify_gen__var_type_msg(in, out) is det.
 
 unify_gen__var_type_msg(Type, Msg) :-
-	( type_util__type_to_type_id(Type, TypeId, _) ->
+	( type_to_type_id(Type, TypeId, _) ->
 		TypeId = TypeSym - TypeArity,
 		(
 			TypeSym = qualified(ModuleName, TypeName),
Index: compiler/value_number.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/value_number.m,v
retrieving revision 1.87
diff -u -r1.87 value_number.m
--- value_number.m	1997/12/05 15:47:59	1.87
+++ value_number.m	1997/12/10 08:39:01
@@ -20,9 +20,9 @@
 	% Find straight-line code sequences and optimize them using
 	% value numbering.
 
-:- pred value_number__main(list(instruction), list(instruction),
+:- pred value_number_main(list(instruction), list(instruction),
 	io__state, io__state).
-:- mode value_number__main(in, out, di, uo) is det.
+:- mode value_number_main(in, out, di, uo) is det.
 
 	% The main value numbering pass introduces references to temporary
 	% variables whose values need be preserved only within an extended
@@ -50,7 +50,7 @@
 	% We can't find out what variables are used by C code sequences,
 	% so we don't optimize any predicates containing them.
 
-value_number__main(Instrs0, Instrs) -->
+value_number_main(Instrs0, Instrs) -->
 	{ opt_util__get_prologue(Instrs0, ProcLabel,
 		LabelInstr, Comments, Instrs1) },
 	{ opt_util__new_label_no(Instrs1, 1000, N0) },
Index: compiler/vn_type.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/vn_type.m,v
retrieving revision 1.35
diff -u -r1.35 vn_type.m
--- vn_type.m	1997/12/05 15:48:12	1.35
+++ vn_type.m	1997/12/08 03:38:12
@@ -31,7 +31,7 @@
 			;	vn_succip(vn)
 			;	vn_hp
 			;	vn_sp
-			;	vn_field(tag, vn, vn)		% lval
+			;	vn_field(maybe(tag), vn, vn)
 			;	vn_mem_ref(vn).
 
 			% these lvals do not have vnlval parallels
Index: runtime/mercury_tags.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_tags.h,v
retrieving revision 1.2
diff -u -r1.2 mercury_tags.h
--- mercury_tags.h	1997/11/23 07:21:38	1.2
+++ mercury_tags.h	1997/12/11 06:09:30
@@ -66,6 +66,9 @@
 #define	field(t, p, i)		((Word *) body((p), (t)))[i]
 #define	const_field(t, p, i)	((const Word *) body((p), (t)))[i]
 
+#define	mask_field(p, i)	((Word *) strip_tag(p))[i]
+#define	const_mask_field(p, i)	((const Word *) strip_tag(p))[i]
+
 /*
 ** the following list_* macros are used by handwritten C code
 ** that needs to access Mercury lists.
New File: compiler/basic_block.m
===================================================================
%-----------------------------------------------------------------------------%
% Copyright (C) 1997 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
%
% Main author: zs.
%
% This module defines a representation for basic blocks, sequences of
% instructions with one entry and one exit, and provides predicates
% that convert a list of instructions into a list of basic blocks
% and vice versa.

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

:- module basic_block.

:- interface.

:- import_module llds.
:- import_module list, map, std_util.

:- type block_map	==	map(label, block_info).

:- type block_info
	--->	block_info(
			label,
				% The label starting the block.
			instruction,
				% The instruction containing the label.
			list(instruction),
				% The code of the block without the initial
				% label.
			list(label),
				% The labels we can jump to
				% (not falling through).
			maybe(label)
				% The label we fall through to
				% (if there is one).
		).

:- pred create_basic_blocks(list(instruction)::in, list(instruction)::out,
	proc_label::out, int::out, list(label)::out, block_map::out) is det.

:- pred flatten_basic_blocks(list(label)::in, block_map::in,
        list(instruction)::out) is det.

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

:- implementation.

:- import_module opt_util.
:- import_module bool, int, require.

create_basic_blocks(Instrs0, Comments, ProcLabel, N,
		LabelSeq, BlockMap) :-
	opt_util__get_prologue(Instrs0, ProcLabel, LabelInstr,
		Comments, AfterLabelInstrs),
	Instrs1 = [LabelInstr | AfterLabelInstrs],
	opt_util__new_label_no(Instrs0, 1000, N0),
	map__init(BlockMap0),
	build_block_map(Instrs1, LabelSeq, BlockMap0, BlockMap,
		ProcLabel, N0, N).

	% Add labels to the given instruction sequence so that
	% every basic block has labels around it.

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

:- pred build_block_map(list(instruction)::in, list(label)::out,
	block_map::in, block_map::out, proc_label::in, int::in, int::out)
	is det.

build_block_map([], [], BlockMap, BlockMap, _, N, N).
build_block_map([OrigInstr0 | OrigInstrs0], LabelSeq, BlockMap0, BlockMap,
		ProcLabel, N0, N) :-
	( OrigInstr0 = label(OrigLabel) - _ ->
		Label = OrigLabel,
		LabelInstr = OrigInstr0,
		RestInstrs = OrigInstrs0,
		N1 = N0
	;
		N1 is N0 + 1,
		Label = local(ProcLabel, N0),
		LabelInstr = label(Label) - "",
		RestInstrs = [OrigInstr0 | OrigInstrs0]
	),
	( 
		take_until_end_of_block(RestInstrs, BlockInstrs, Instrs1),
		build_block_map(Instrs1, LabelSeq0,
			BlockMap0, BlockMap1, ProcLabel, N1, N),
		( list__last(BlockInstrs, LastInstr) ->
			LastInstr = LastUinstr - _,
			possible_targets(LastUinstr, SideLabels),
			opt_util__can_instr_fall_through(LastUinstr,
				CanFallThrough),
			( CanFallThrough = yes ->
				get_fallthrough_from_seq(LabelSeq0,
					MaybeFallThrough)
			;
				MaybeFallThrough = no
			)
		;
			SideLabels = [],
			get_fallthrough_from_seq(LabelSeq0,
				MaybeFallThrough)
		),
		BlockInfo = block_info(Label, LabelInstr, BlockInstrs,
			SideLabels, MaybeFallThrough),
		map__det_insert(BlockMap1, Label, BlockInfo, BlockMap),
		LabelSeq = [Label | LabelSeq0]
	).

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

:- pred take_until_end_of_block(list(instruction)::in,
	list(instruction)::out, list(instruction)::out) is det.

take_until_end_of_block([], [], []).
take_until_end_of_block([Instr0 | Instrs0], BlockInstrs, Rest) :-
	Instr0 = Uinstr0 - _Comment,
	( Uinstr0 = label(_) ->
		BlockInstrs = [],
		Rest = [Instr0 | Instrs0]
	; opt_util__can_instr_branch_away(Uinstr0, yes) ->
		BlockInstrs = [Instr0],
		Rest = Instrs0
	;
		take_until_end_of_block(Instrs0, BlockInstrs1, Rest),
		BlockInstrs = [Instr0 | BlockInstrs1]
	).

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

:- pred get_fallthrough_from_seq(list(label)::in, maybe(label)::out) is det.

get_fallthrough_from_seq(LabelSeq, MaybeFallThrough) :-
	( LabelSeq = [NextLabel | _] ->
		MaybeFallThrough = yes(NextLabel)
	;
		MaybeFallThrough = no
	).

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

	% Given an instruction, find the set of labels to which it can cause
	% control to transfer. In the case of calls, this includes transfer
	% via return from the called procedure.

:- pred possible_targets(instr::in, list(label)::out) is det.

possible_targets(comment(_), []).
possible_targets(livevals(_), []).
possible_targets(block(_, _, _), _) :-
	error("block in possible_targets").
possible_targets(assign(_, _), []).
possible_targets(call(_, ReturnAddr, _, _), Labels) :-
	( ReturnAddr = label(Label) ->
		Labels = [Label]
	;
		Labels = []
	).
possible_targets(mkframe(_, _, _), []).
possible_targets(modframe(_), []).
possible_targets(label(_), []).
possible_targets(goto(CodeAddr), Targets) :-
	( CodeAddr = label(Label) ->
		Targets = [Label]
	;
		Targets = []
	).
possible_targets(computed_goto(_, Targets), Targets).
possible_targets(c_code(_), []).
possible_targets(if_val(_, CodeAddr), Targets) :-
	( CodeAddr = label(Label) ->
		Targets = [Label]
	;
		Targets = []
	).
possible_targets(incr_hp(_, _, _, _), []).
possible_targets(mark_hp(_), []).
possible_targets(restore_hp(_), []).
possible_targets(store_ticket(_), []).
possible_targets(reset_ticket(_, _), []).
possible_targets(discard_ticket, []).
possible_targets(mark_ticket_stack(_), []).
possible_targets(discard_tickets_to(_), []).
possible_targets(incr_sp(_, _), []).
possible_targets(decr_sp(_), []).
possible_targets(pragma_c(_, _, _, _, _), []).

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

flatten_basic_blocks([], _, []).
flatten_basic_blocks([Label | Labels], BlockMap, Instrs) :-
	flatten_basic_blocks(Labels, BlockMap, RestInstrs),
	map__lookup(BlockMap, Label, BlockInfo),
	BlockInfo = block_info(_, BlockLabelInstr, BlockInstrs, _, _),
	list__append([BlockLabelInstr | BlockInstrs], RestInstrs, Instrs).

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
% Copyright (C) 1995-1997 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
%
% dupelim.m - eliminate some duplicate code sequences.
%
% Author: zs.
%
% Our algorithm has the following stages.
%
% 1.	Divide the code of the procedure into basic blocks.
%
% 2.	For each block, compute a standard form, which is its most general
%	generalization.
%
% 3.	Find out which sets of blocks have the same standard form.
%
% 4.	For each set of blocks with the same standard form, find out
%	which blocks are not fallen into and can thus be eliminated,
%	and choose which blocks will be eliminated.
%
% 5.	For each set of blocks with the same standard form, compute
%	their most specific common generalization (which must exist),
%	and substitute this code for the code of the copy of the block
%	that step 4 has decided to keep.
%
% 5.	Convert the (possibly reduced) list of basic blocks back to a
%	list of instructions and substitute all references to the labels
%	starting eliminated blocks to refer to their noneliminated version.

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

:- module dupelim.

:- interface.

:- import_module list, llds.

:- pred dupelim_main(list(instruction)::in, list(instruction)::out) is det.

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

:- implementation.

:- import_module basic_block, opt_util.
:- import_module bool, std_util, assoc_list, set, map, require.

	% A std_map maps a list of standardized instructions to the list
	% of labels whose basic blocks have that standardized form.
:- type std_map		==	map(list(instr), list(label)).

	% cluster(Exemplar, OtherLabels) means that references to labels
	% in OtherLabels can be replaced with references to Exemplar
	% once its block has been replaced with the most specific antiunified
	% version of the blocks started by Exemplar and OtherLabels.
	% OtherLabels must be nonempty.
:- type cluster		--->	cluster(label, list(label)).

dupelim_main(Instrs0, Instrs) :-
	create_basic_blocks(Instrs0, Comments, _ProcLabel, _N,
		LabelSeq0, BlockMap0),
	map__init(StdMap0),
	set__init(FallInto0),
	dupelim__build_maps(LabelSeq0, BlockMap0, StdMap0, StdMap,
		FallInto0, FallInto),
	map__values(StdMap, StdList),
	find_clusters(StdList, FallInto, [], Clusters),
	( Clusters = [] ->
			% We don't want to introduce any incidental changes
			% if we cannot eliminate any blocks.
		Instrs = Instrs0
	;
		map__init(ReplMap0),
		process_clusters(Clusters, LabelSeq0, LabelSeq,
			BlockMap0, BlockMap, ReplMap0, ReplMap),
		flatten_basic_blocks(LabelSeq, BlockMap, Instrs1),
		dupelim__replace_labels_instr_list(Instrs1, ReplMap, Instrs2),
		list__append(Comments, Instrs2, Instrs)
	).

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

:- pred dupelim__build_maps(list(label)::in, block_map::in,
	std_map::in, std_map::out, set(label)::in, set(label)::out) is det.

dupelim__build_maps([], _, StdMap, StdMap, FallInto, FallInto).
dupelim__build_maps([Label | Labels], BlockMap, StdMap0, StdMap,
		FallInto0, FallInto) :-
	map__lookup(BlockMap, Label, BlockInfo),
	BlockInfo = block_info(_, _, Instrs, _, MaybeFallThrough),
	standardize_block(Instrs, MaybeFallThrough, StdInstrs),
	( map__search(StdMap0, StdInstrs, Cluster) ->
		map__det_update(StdMap0, StdInstrs, [Label | Cluster], StdMap1)
	;
		map__det_insert(StdMap0, StdInstrs, [Label], StdMap1)
	),
	( MaybeFallThrough = yes(FallIntoLabel) ->
		set__insert(FallInto0, FallIntoLabel, FallInto1)
	;
		FallInto1 = FallInto0
	),
	dupelim__build_maps(Labels, BlockMap, StdMap1, StdMap,
		FallInto1, FallInto).

% If two or more blocks have the same standardized form, it may be possible
% to eliminate all but one of the blocks. However, blocks that can be fallen
% into cannot be eliminated. (Actually, they could, but only by inserting
% a goto, and full jumpopt would then undo the elimination of the block.)

:- pred find_clusters(list(list(label))::in, set(label)::in,
	list(cluster)::in, list(cluster)::out) is det.

find_clusters([], _, Clusters, Clusters).
find_clusters([Labels | LabelsList], FallInto, Clusters0, Clusters) :-
	(
		Labels = [_, _ | _],
			% The rest of the condition is relatively expensive,
			% so don't do it if there aren't at least two labels
			% whose blocks have the same standardized form.
		IsFallenInto = lambda([Label::in] is semidet, (
			set__member(Label, FallInto)
		)),
		list__filter(IsFallenInto, Labels,
			FallIntoLabels, NonFallIntoLabels),
		NonFallIntoLabels = [FirstNonFallInto | OtherNonFallInto]
	->
		( FallIntoLabels = [ChosenLabel | _] ->
			Cluster = cluster(ChosenLabel, NonFallIntoLabels)
		;
			Cluster = cluster(FirstNonFallInto, OtherNonFallInto)
		),
		Clusters1 = [Cluster | Clusters0]
	;
		Clusters1 = Clusters0
	),
	find_clusters(LabelsList, FallInto, Clusters1, Clusters).

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

:- pred process_clusters(list(cluster)::in, list(label)::in, list(label)::out,
	block_map::in, block_map::out,
	map(label, label)::in, map(label, label)::out) is det.

process_clusters([], LabelSeq, LabelSeq, BlockMap, BlockMap,
		ReplMap, ReplMap).
process_clusters([Cluster | Clusters], LabelSeq0, LabelSeq,
		BlockMap0, BlockMap, ReplMap0, ReplMap) :-
	Cluster = cluster(Exemplar, ElimLabels),
	map__lookup(BlockMap0, Exemplar, ExemplarInfo0),
	ExemplarInfo0 = block_info(ExLabel, ExLabelInstr, ExInstrs0,
		ExSideLabels, ExMaybeFallThrough),
	require(unify(Exemplar, ExLabel), "exemplar label mismatch"),
	process_elim_labels(ElimLabels, ExInstrs0, ExMaybeFallThrough,
		LabelSeq0, LabelSeq1, BlockMap0, Exemplar, ReplMap0, ReplMap1,
		UnifiedInstrs, UnifiedMaybeFallThrough),
	ExemplarInfo = block_info(ExLabel, ExLabelInstr, UnifiedInstrs,
		ExSideLabels, UnifiedMaybeFallThrough),
	map__det_update(BlockMap0, Exemplar, ExemplarInfo, BlockMap1),
	process_clusters(Clusters, LabelSeq1, LabelSeq, BlockMap1, BlockMap,
		ReplMap1, ReplMap).

:- pred process_elim_labels(list(label)::in, list(instruction)::in,
	maybe(label)::in, list(label)::in, list(label)::out, block_map::in,
	label::in, map(label, label)::in, map(label, label)::out,
	list(instruction)::out, maybe(label)::out) is det.

process_elim_labels([], Instrs, MaybeFT, LabelSeq, LabelSeq, _,
		_, ReplMap, ReplMap, Instrs, MaybeFT).
process_elim_labels([Label | Labels], Instrs0, MaybeFallThrough0,
		LabelSeq0, LabelSeq, BlockMap, Exemplar, ReplMap0, ReplMap,
		Instrs, MaybeFallThrough) :-
	map__lookup(BlockMap, Label, LabelInfo),
	LabelInfo = block_info(ElimLabel, _, ElimInstrs,
		_, ElimMaybeFallThrough),
	require(unify(Label, ElimLabel), "elim label mismatch"),
	(
		most_specific_instrs(Instrs0, MaybeFallThrough0,
			ElimInstrs, ElimMaybeFallThrough,
			Instrs1, MaybeFallThrough1)
	->
		list__delete_all(LabelSeq0, Label, LabelSeq1),
		map__det_insert(ReplMap0, Label, Exemplar, ReplMap1),
		process_elim_labels(Labels, Instrs1, MaybeFallThrough1,
			LabelSeq1, LabelSeq, BlockMap,
			Exemplar, ReplMap1, ReplMap, Instrs, MaybeFallThrough)
	;
		error("blocks with same standard form don't antiunify")
	).

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

	% The code of this section is concerned with computing the standard
	% form of a sequence of instructions.

:- pred standardize_block(list(instruction)::in, maybe(label)::in,
	list(instr)::out) is det.

% If a block can fall through, we add a goto to the following label at the end.
% This way, it will match with other blocks that have identical content
% except for an explicit goto to the fallthrough label.

standardize_block(Instrs0, MaybeFallThrough, Uinstrs) :-
	standardize_instrs(Instrs0, Uinstrs1),
	( MaybeFallThrough = yes(Label) ->
		Goto = goto(label(Label)),
		list__append(Uinstrs1, [Goto], Uinstrs)
	;
		Uinstrs = Uinstrs1
	).

:- pred standardize_instrs(list(instruction)::in, list(instr)::out) is det.

standardize_instrs([], []).
standardize_instrs([Instr - _ | Instrs], StdInstrs) :-
	standardize_instrs(Instrs, StdInstrs1),
	standardize_instr(Instr, StdInstr),
	( StdInstr = comment(_) ->
		StdInstrs = StdInstrs1
	;
		StdInstrs = [StdInstr | StdInstrs1]
	).

:- pred standardize_instr(instr::in, instr::out) is det.

standardize_instr(Instr1, Instr) :-
	(
		Instr1 = comment(_),
		Instr = Instr1
	;
		Instr1 = livevals(_),
		Instr = Instr1
	;
		Instr1 = block(_, _, _),
		Instr = Instr1
	;
		Instr1 = assign(Lval1, Rval1),
		standardize_lval(Lval1, Lval),
		standardize_rval(Rval1, Rval),
		Instr = assign(Lval, Rval)
	;
		Instr1 = call(_, _, _, _),
		Instr = Instr1
	;
		Instr1 = mkframe(_, _, _),
		Instr = Instr1
	;
		Instr1 = modframe(_),
		Instr = Instr1
	;
		Instr1 = label(_),
		Instr = Instr1
	;
		Instr1 = goto(_),
		Instr = Instr1
	;
		Instr1 = computed_goto(_, _),
		Instr = Instr1
	;
		Instr1 = c_code(_),
		Instr = Instr1
	;
		Instr1 = if_val(Rval1, CodeAddr),
		standardize_rval(Rval1, Rval),
		Instr = if_val(Rval, CodeAddr)
	;
		Instr1 = incr_hp(Lval1, MaybeTag, Rval1, Msg),
		standardize_lval(Lval1, Lval),
		standardize_rval(Rval1, Rval),
		Instr = incr_hp(Lval, MaybeTag, Rval, Msg)
	;
		Instr1 = mark_hp(Lval1),
		standardize_lval(Lval1, Lval),
		Instr = mark_hp(Lval)
	;
		Instr1 = restore_hp(Rval1),
		standardize_rval(Rval1, Rval),
		Instr = restore_hp(Rval)
	;
		Instr1 = store_ticket(Lval1),
		standardize_lval(Lval1, Lval),
		Instr = store_ticket(Lval)
	;
		Instr1 = reset_ticket(Rval1, Reason),
		standardize_rval(Rval1, Rval),
		Instr = reset_ticket(Rval, Reason)
	;
		Instr1 = discard_ticket,
		Instr = Instr1
	;
		Instr1 = mark_ticket_stack(Lval1),
		standardize_lval(Lval1, Lval),
		Instr = mark_ticket_stack(Lval)
	;
		Instr1 = discard_tickets_to(Rval1),
		standardize_rval(Rval1, Rval),
		Instr = discard_tickets_to(Rval)
	;
		Instr1 = incr_sp(_, _),
		Instr = Instr1
	;
		Instr1 = decr_sp(_),
		Instr = Instr1
	;
		Instr1 = pragma_c(_, _, _, _, _),
		Instr = Instr1
	).

:- pred standardize_lval(lval::in, lval::out) is det.

standardize_lval(Lval1, Lval) :-
	(
		Lval1 = reg(_, _),
		Lval = Lval1
	;
		Lval1 = succip,
		Lval = Lval1
	;
		Lval1 = maxfr,
		Lval = Lval1
	;
		Lval1 = curfr,
		Lval = Lval1
	;
		Lval1 = hp,
		Lval = Lval1
	;
		Lval1 = sp,
		Lval = Lval1
	;
		Lval1 = temp(_, _),
		Lval = Lval1
	;
		Lval1 = stackvar(_),
		Lval = Lval1
	;
		Lval1 = framevar(_),
		Lval = Lval1
	;
		Lval1 = succip(_),
		Lval = Lval1
	;
		Lval1 = redoip(_),
		Lval = Lval1
	;
		Lval1 = succfr(_),
		Lval = Lval1
	;
		Lval1 = prevfr(_),
		Lval = Lval1
	;
		Lval1 = field(_, Addr, FieldNum),
		Lval = field(no, Addr, FieldNum)
	;
		Lval1 = mem_ref(_),
		Lval = Lval1
	;
		Lval1 = lvar(_),
		error("lvar in standardize_lval")
	).

:- pred standardize_rval(rval::in, rval::out) is det.

standardize_rval(Rval1, Rval) :-
	(
		Rval1 = lval(Lval1),
		standardize_lval(Lval1, Lval),
		Rval = lval(Lval)
	;
		Rval1 = var(_),
		error("var in standardize_rval")
	;
		Rval1 = create(_, _, _, _, _),
		Rval = Rval1
	;
		Rval1 = mkword(_, _),
		Rval = Rval1
	;
		Rval1 = const(_),
		Rval = Rval1
	;
		Rval1 = unop(Unop, Rval1L),
		standardize_rval(Rval1L, RvalL),
		Rval = unop(Unop, RvalL)
	;
		Rval1 = binop(Binnop, Rval1L, Rval1R),
		standardize_rval(Rval1L, RvalL),
		standardize_rval(Rval1R, RvalR),
		Rval = binop(Binnop, RvalL, RvalR)
	;
		Rval1 = mem_addr(_),
		Rval = Rval1
	).

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

	% The code of this section is concerned with computing the most
	% specific code sequence that generalizes both input sequneces.

:- pred most_specific_instrs(list(instruction)::in, maybe(label)::in,
	list(instruction)::in, maybe(label)::in,
	list(instruction)::out, maybe(label)::out) is semidet.

most_specific_instrs(Instrs1, MaybeFallThrough1,
		Instrs2, MaybeFallThrough2, Instrs, MaybeFallThrough) :-
	(
		Instrs1 = [Instr1 | Tail1],
		Instrs2 = [Instr2 | Tail2]
	->
		Instr1 = Uinstr1 - Comment1,
		Instr2 = Uinstr2 - Comment2,
		(
			most_specific_instr(Uinstr1, Uinstr2, Uinstr)
		->
			( Comment1 = Comment2 ->
				Comment = Comment1
			;
				Comment = "unified intruction"
			),
			Instr = Uinstr - Comment,
			most_specific_instrs(Tail1, MaybeFallThrough1,
				Tail2, MaybeFallThrough2,
				Tail, MaybeFallThrough),
			Instrs = [Instr | Tail]
		;
			Uinstr1 = comment(_)
		->
			most_specific_instrs(Tail1, MaybeFallThrough1,
				Instrs2, MaybeFallThrough2,
				Instrs, MaybeFallThrough)
		;
			Uinstr2 = comment(_)
		->
			most_specific_instrs(Instrs1, MaybeFallThrough1,
				Tail2, MaybeFallThrough2,
				Instrs, MaybeFallThrough)
		;
			fail
		)
	;
		Instrs1 = [],
		Instrs2 = []
	->
		require(unify(MaybeFallThrough1, no), "two empty lists with fallthrough"),
		require(unify(MaybeFallThrough2, no), "two empty lists with fallthrough"),
		Instrs = [],
		MaybeFallThrough = no
	;
		Instrs1 = [Instr1],
		Instrs2 = [],
		Instr1 = goto(label(Target)) - _,
		MaybeFallThrough2 = yes(Target)
	->
		Instrs = [Instr1],
		MaybeFallThrough = no
	;
		Instrs1 = [],
		Instrs2 = [Instr2],
		Instr2 = goto(label(Target)) - _,
		MaybeFallThrough1 = yes(Target)
	->
		Instrs = [Instr2],
		MaybeFallThrough = no
	;
		fail
	).

:- pred most_specific_instr(instr::in, instr::in, instr::out) is semidet.

most_specific_instr(Instr1, Instr2, Instr) :-
	(
		Instr1 = livevals(_),
		Instr2 = Instr1,
		Instr = Instr1
	;
		Instr1 = block(_, _, _),
		Instr2 = Instr1,
		Instr = Instr1
	;
		Instr1 = assign(Lval1, Rval1),
		Instr2 = assign(Lval2, Rval2),
		most_specific_lval(Lval1, Lval2, Lval),
		most_specific_rval(Rval1, Rval2, Rval),
		Instr = assign(Lval, Rval)
	;
		Instr1 = call(_, _, _, _),
		Instr2 = Instr1,
		Instr = Instr1
	;
		Instr1 = mkframe(_, _, _),
		Instr2 = Instr1,
		Instr = Instr1
	;
		Instr1 = modframe(_),
		Instr2 = Instr1,
		Instr = Instr1
	;
		Instr1 = label(_),
		Instr2 = Instr1,
		Instr = Instr1
	;
		Instr1 = goto(_),
		Instr2 = Instr1,
		Instr = Instr1
	;
		Instr1 = computed_goto(_, _),
		Instr2 = Instr1,
		Instr = Instr1
	;
		Instr1 = c_code(_),
		Instr2 = Instr1,
		Instr = Instr1
	;
		Instr1 = if_val(Rval1, CodeAddr),
		Instr2 = if_val(Rval2, CodeAddr),
		most_specific_rval(Rval1, Rval2, Rval),
		Instr = if_val(Rval, CodeAddr)
	;
		Instr1 = incr_hp(Lval1, MaybeTag, Rval1, Msg),
		Instr2 = incr_hp(Lval2, MaybeTag, Rval2, Msg),
		most_specific_lval(Lval1, Lval2, Lval),
		most_specific_rval(Rval1, Rval2, Rval),
		Instr = incr_hp(Lval, MaybeTag, Rval, Msg)
	;
		Instr1 = mark_hp(Lval1),
		Instr2 = mark_hp(Lval2),
		most_specific_lval(Lval1, Lval2, Lval),
		Instr = mark_hp(Lval)
	;
		Instr1 = restore_hp(Rval1),
		Instr2 = restore_hp(Rval2),
		most_specific_rval(Rval1, Rval2, Rval),
		Instr = restore_hp(Rval)
	;
		Instr1 = store_ticket(Lval1),
		Instr2 = store_ticket(Lval2),
		most_specific_lval(Lval1, Lval2, Lval),
		Instr = store_ticket(Lval)
	;
		Instr1 = reset_ticket(Rval1, Reason),
		Instr2 = reset_ticket(Rval2, Reason),
		most_specific_rval(Rval1, Rval2, Rval),
		Instr = reset_ticket(Rval, Reason)
	;
		Instr1 = discard_ticket,
		Instr2 = Instr1,
		Instr = Instr1
	;
		Instr1 = mark_ticket_stack(Lval1),
		Instr2 = mark_ticket_stack(Lval2),
		most_specific_lval(Lval1, Lval2, Lval),
		Instr = mark_ticket_stack(Lval)
	;
		Instr1 = discard_tickets_to(Rval1),
		Instr2 = discard_tickets_to(Rval2),
		most_specific_rval(Rval1, Rval2, Rval),
		Instr = discard_tickets_to(Rval)
	;
		Instr1 = incr_sp(_, _),
		Instr2 = Instr1,
		Instr = Instr1
	;
		Instr1 = decr_sp(_),
		Instr2 = Instr1,
		Instr = Instr1
	;
		Instr1 = pragma_c(_, _, _, _, _),
		Instr2 = Instr1,
		Instr = Instr1
	).

:- pred most_specific_lval(lval::in, lval::in, lval::out) is semidet.

most_specific_lval(Lval1, Lval2, Lval) :-
	(
		Lval1 = reg(_, _),
		Lval2 = Lval1,
		Lval = Lval1
	;
		Lval1 = succip,
		Lval2 = Lval1,
		Lval = Lval1
	;
		Lval1 = maxfr,
		Lval2 = Lval1,
		Lval = Lval1
	;
		Lval1 = curfr,
		Lval2 = Lval1,
		Lval = Lval1
	;
		Lval1 = hp,
		Lval2 = Lval1,
		Lval = Lval1
	;
		Lval1 = sp,
		Lval2 = Lval1,
		Lval = Lval1
	;
		Lval1 = temp(_, _),
		Lval2 = Lval1,
		Lval = Lval1
	;
		Lval1 = stackvar(_),
		Lval2 = Lval1,
		Lval = Lval1
	;
		Lval1 = framevar(_),
		Lval2 = Lval1,
		Lval = Lval1
	;
		Lval1 = succip(_),
		Lval2 = Lval1,
		Lval = Lval1
	;
		Lval1 = redoip(_),
		Lval2 = Lval1,
		Lval = Lval1
	;
		Lval1 = succfr(_),
		Lval2 = Lval1,
		Lval = Lval1
	;
		Lval1 = prevfr(_),
		Lval2 = Lval1,
		Lval = Lval1
	;
		Lval1 = field(MaybeTag1, Addr, FieldNum),
		Lval2 = field(MaybeTag2, Addr, FieldNum),
		( MaybeTag1 = MaybeTag2 ->
			MaybeTag = MaybeTag1
		;
			MaybeTag = no
		),
		Lval = field(MaybeTag, Addr, FieldNum)
	;
		Lval1 = mem_ref(_),
		Lval2 = Lval1,
		Lval = Lval1
	;
		Lval1 = lvar(_),
		error("lvar in most_specific_lval")
	).

:- pred most_specific_rval(rval::in, rval::in, rval::out) is semidet.

most_specific_rval(Rval1, Rval2, Rval) :-
	(
		Rval1 = lval(Lval1),
		Rval2 = lval(Lval2),
		most_specific_lval(Lval1, Lval2, Lval),
		Rval = lval(Lval)
	;
		Rval1 = var(_),
		error("var in most_specific_rval")
	;
		Rval1 = create(_, _, _, _, _),
		Rval2 = Rval1,
		Rval = Rval1
	;
		Rval1 = mkword(_, _),
		Rval2 = Rval1,
		Rval = Rval1
	;
		Rval1 = const(_),
		Rval2 = Rval1,
		Rval = Rval1
	;
		Rval1 = unop(Unop, Rval1L),
		Rval2 = unop(Unop, Rval2L),
		most_specific_rval(Rval1L, Rval2L, RvalL),
		Rval = unop(Unop, RvalL)
	;
		Rval1 = binop(Binnop, Rval1L, Rval1R),
		Rval2 = binop(Binnop, Rval2L, Rval2R),
		most_specific_rval(Rval1L, Rval2L, RvalL),
		most_specific_rval(Rval1R, Rval2R, RvalR),
		Rval = binop(Binnop, RvalL, RvalR)
	;
		Rval1 = mem_addr(_),
		Rval2 = Rval1,
		Rval = Rval1
	).

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

	% The code in this section is concerned with replacing all references
	% to one given label with a reference to another given label.

:- pred dupelim__replace_labels_instr_list(list(instruction)::in,
	map(label, label)::in, list(instruction)::out) is det.

dupelim__replace_labels_instr_list([], _ReplMap, []).
dupelim__replace_labels_instr_list([Instr0 - Comment | Instrs0],
		ReplMap, [Instr - Comment | Instrs]) :-
	dupelim__replace_labels_instr(Instr0, ReplMap, Instr),
	dupelim__replace_labels_instr_list(Instrs0, ReplMap, Instrs).

:- pred dupelim__replace_labels_instr(instr::in, map(label, label)::in,
	instr::out) is det.

dupelim__replace_labels_instr(comment(Comment), _, comment(Comment)).
dupelim__replace_labels_instr(livevals(Livevals), _, livevals(Livevals)).
dupelim__replace_labels_instr(block(R, F, Instrs0), ReplMap,
		block(R, F, Instrs)) :-
	dupelim__replace_labels_instr_list(Instrs0, ReplMap, Instrs).
dupelim__replace_labels_instr(assign(Lval0, Rval0), ReplMap,
		assign(Lval, Rval)) :-
	dupelim__replace_labels_lval(Lval0, ReplMap, Lval),
	dupelim__replace_labels_rval(Rval0, ReplMap, Rval).
dupelim__replace_labels_instr(call(Target, Return0, LiveInfo, CM),
		ReplMap, call(Target, Return, LiveInfo, CM)) :-
	dupelim__replace_labels_code_addr(Return0, ReplMap, Return).
dupelim__replace_labels_instr(mkframe(Name, Size, Redoip0), ReplMap,
		mkframe(Name, Size, Redoip)) :-
	dupelim__replace_labels_code_addr(Redoip0, ReplMap, Redoip).
dupelim__replace_labels_instr(modframe(Redoip0), ReplMap, modframe(Redoip)) :-
	dupelim__replace_labels_code_addr(Redoip0, ReplMap, Redoip).
dupelim__replace_labels_instr(label(Label), ReplMap, label(Label)) :-
	( map__search(ReplMap, Label, _) ->
		error("found eliminated label in dupelim__replace_labels_instr")
	;
		true
	).
dupelim__replace_labels_instr(goto(Target0), ReplMap, goto(Target)) :-
	dupelim__replace_labels_code_addr(Target0, ReplMap, Target).
dupelim__replace_labels_instr(computed_goto(Rval0, Labels0), ReplMap,
		computed_goto(Rval, Labels)) :-
	dupelim__replace_labels_rval(Rval0, ReplMap, Rval),
	dupelim__replace_labels_label_list(Labels0, ReplMap, Labels).
dupelim__replace_labels_instr(c_code(Code), _, c_code(Code)).
dupelim__replace_labels_instr(if_val(Rval0, Target0), ReplMap,
		if_val(Rval, Target)) :-
	dupelim__replace_labels_rval(Rval0, ReplMap, Rval),
	dupelim__replace_labels_code_addr(Target0, ReplMap, Target).
dupelim__replace_labels_instr(incr_hp(Lval0, MaybeTag, Rval0, Msg), ReplMap,
		incr_hp(Lval, MaybeTag, Rval, Msg)) :-
	dupelim__replace_labels_lval(Lval0, ReplMap, Lval),
	dupelim__replace_labels_rval(Rval0, ReplMap, Rval).
dupelim__replace_labels_instr(mark_hp(Lval0), ReplMap, mark_hp(Lval)) :-
	dupelim__replace_labels_lval(Lval0, ReplMap, Lval).
dupelim__replace_labels_instr(restore_hp(Rval0), ReplMap, restore_hp(Rval)) :-
	dupelim__replace_labels_rval(Rval0, ReplMap, Rval).
dupelim__replace_labels_instr(store_ticket(Lval0), ReplMap, 
		store_ticket(Lval)) :-
	dupelim__replace_labels_lval(Lval0, ReplMap, Lval).
dupelim__replace_labels_instr(reset_ticket(Rval0, Reason), ReplMap, 
		reset_ticket(Rval, Reason)) :-
	dupelim__replace_labels_rval(Rval0, ReplMap, Rval).
dupelim__replace_labels_instr(discard_ticket, _, discard_ticket).
dupelim__replace_labels_instr(mark_ticket_stack(Lval0), ReplMap, 
		mark_ticket_stack(Lval)) :-
	dupelim__replace_labels_lval(Lval0, ReplMap, Lval).
dupelim__replace_labels_instr(discard_tickets_to(Rval0), ReplMap, 
		discard_tickets_to(Rval)) :-
	dupelim__replace_labels_rval(Rval0, ReplMap, Rval).
dupelim__replace_labels_instr(incr_sp(Size, Msg), _, incr_sp(Size, Msg)).
dupelim__replace_labels_instr(decr_sp(Size), _, decr_sp(Size)).
dupelim__replace_labels_instr(pragma_c(A,B,C,D,E), _, pragma_c(A,B,C,D,E)).

:- pred dupelim__replace_labels_lval(lval::in, map(label, label)::in,
	lval::out) is det.

dupelim__replace_labels_lval(reg(RegType, RegNum), _, reg(RegType, RegNum)).
dupelim__replace_labels_lval(stackvar(N), _, stackvar(N)).
dupelim__replace_labels_lval(framevar(N), _, framevar(N)).
dupelim__replace_labels_lval(succip, _, succip).
dupelim__replace_labels_lval(maxfr, _, maxfr).
dupelim__replace_labels_lval(curfr, _, curfr).
dupelim__replace_labels_lval(succip(Rval0), ReplMap, succip(Rval)) :-
	dupelim__replace_labels_rval(Rval0, ReplMap, Rval).
dupelim__replace_labels_lval(redoip(Rval0), ReplMap, redoip(Rval)) :-
	dupelim__replace_labels_rval(Rval0, ReplMap, Rval).
dupelim__replace_labels_lval(succfr(Rval0), ReplMap, succfr(Rval)) :-
	dupelim__replace_labels_rval(Rval0, ReplMap, Rval).
dupelim__replace_labels_lval(prevfr(Rval0), ReplMap, prevfr(Rval)) :-
	dupelim__replace_labels_rval(Rval0, ReplMap, Rval).
dupelim__replace_labels_lval(hp, _, hp).
dupelim__replace_labels_lval(sp, _, sp).
dupelim__replace_labels_lval(field(Tag, Base0, Offset0), ReplMap,
		field(Tag, Base, Offset)) :-
	dupelim__replace_labels_rval(Base0, ReplMap, Base),
	dupelim__replace_labels_rval(Offset0, ReplMap, Offset).
dupelim__replace_labels_lval(lvar(Var), _, lvar(Var)).
dupelim__replace_labels_lval(temp(Type, Num), _, temp(Type, Num)).
dupelim__replace_labels_lval(mem_ref(Rval0), ReplMap, mem_ref(Rval)) :-
	dupelim__replace_labels_rval(Rval0, ReplMap, Rval).

:- pred dupelim__replace_labels_rval(rval::in, map(label, label)::in,
	rval::out) is det.

dupelim__replace_labels_rval(lval(Lval0), ReplMap, lval(Lval)) :-
	dupelim__replace_labels_lval(Lval0, ReplMap, Lval).
dupelim__replace_labels_rval(var(Var), _, var(Var)).
dupelim__replace_labels_rval(create(Tag, Rvals, Unique, N, Msg), _,
		create(Tag, Rvals, Unique, N, Msg)).
dupelim__replace_labels_rval(mkword(Tag, Rval0), ReplMap, mkword(Tag, Rval)) :-
	dupelim__replace_labels_rval(Rval0, ReplMap, Rval).
dupelim__replace_labels_rval(const(Const0), ReplMap, const(Const)) :-
	dupelim__replace_labels_rval_const(Const0, ReplMap, Const).
dupelim__replace_labels_rval(unop(Op, Rval0), ReplMap, unop(Op, Rval)) :-
	dupelim__replace_labels_rval(Rval0, ReplMap, Rval).
dupelim__replace_labels_rval(binop(Op, LRval0, RRval0), ReplMap,
		binop(Op, LRval, RRval)) :-
	dupelim__replace_labels_rval(LRval0, ReplMap, LRval),
	dupelim__replace_labels_rval(RRval0, ReplMap, RRval).
dupelim__replace_labels_rval(mem_addr(MemRef0), ReplMap, mem_addr(MemRef)) :-
	dupelim__replace_labels_mem_ref(MemRef0, ReplMap, MemRef).

:- pred dupelim__replace_labels_mem_ref(mem_ref::in, map(label, label)::in,
	mem_ref::out) is det.

dupelim__replace_labels_mem_ref(stackvar_ref(N), _, stackvar_ref(N)).
dupelim__replace_labels_mem_ref(framevar_ref(N), _, framevar_ref(N)).
dupelim__replace_labels_mem_ref(heap_ref(Rval0, Tag, N), ReplMap,
		heap_ref(Rval, Tag, N)) :-
	dupelim__replace_labels_rval(Rval0, ReplMap, Rval).

:- pred dupelim__replace_labels_rval_const(rval_const::in,
	map(label, label)::in, rval_const::out) is det.

dupelim__replace_labels_rval_const(true, _, true).
dupelim__replace_labels_rval_const(false, _, false).
dupelim__replace_labels_rval_const(int_const(N), _, int_const(N)).
dupelim__replace_labels_rval_const(float_const(N), _, float_const(N)).
dupelim__replace_labels_rval_const(string_const(S), _, string_const(S)).
dupelim__replace_labels_rval_const(code_addr_const(Addr0), ReplMap,
		code_addr_const(Addr)) :-
	dupelim__replace_labels_code_addr(Addr0, ReplMap, Addr).
dupelim__replace_labels_rval_const(data_addr_const(DataAddr), _,
		data_addr_const(DataAddr)).
dupelim__replace_labels_rval_const(label_entry(Label), _, label_entry(Label)).

:- pred dupelim__replace_labels_code_addr(code_addr::in, map(label, label)::in,
	code_addr::out) is det.

dupelim__replace_labels_code_addr(label(Label0), ReplMap, label(Label)) :-
	dupelim__replace_labels_label(Label0, ReplMap, Label).
dupelim__replace_labels_code_addr(imported(Proc), _, imported(Proc)).
dupelim__replace_labels_code_addr(succip, _, succip).
dupelim__replace_labels_code_addr(do_succeed(Last), _, do_succeed(Last)).
dupelim__replace_labels_code_addr(do_redo, _, do_redo).
dupelim__replace_labels_code_addr(do_fail, _, do_fail).
dupelim__replace_labels_code_addr(do_det_closure, _, do_det_closure).
dupelim__replace_labels_code_addr(do_semidet_closure, _, do_semidet_closure).
dupelim__replace_labels_code_addr(do_nondet_closure, _, do_nondet_closure).
dupelim__replace_labels_code_addr(do_det_class_method, _, do_det_class_method).
dupelim__replace_labels_code_addr(do_semidet_class_method, _,
	do_semidet_class_method).
dupelim__replace_labels_code_addr(do_nondet_class_method, _,
	do_nondet_class_method).
dupelim__replace_labels_code_addr(do_not_reached, _, do_not_reached).

:- pred dupelim__replace_labels_label_list(list(label)::in,
	map(label, label)::in, list(label)::out) is det.

dupelim__replace_labels_label_list([], _ReplMap, []).
dupelim__replace_labels_label_list([Label0 | Labels0], ReplMap,
		[Label | Labels]) :-
	dupelim__replace_labels_label(Label0, ReplMap, Label),
	dupelim__replace_labels_label_list(Labels0, ReplMap, Labels).

:- pred dupelim__replace_labels_label(label::in, map(label, label)::in,
	label::out) is det.

dupelim__replace_labels_label(Label0, ReplMap, Label) :-
	( map__search(ReplMap, Label0, NewLabel) ->
		Label = NewLabel
	;
		Label = Label0
	).

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