[m-rev.] diff: removal of a frameopt limitation

Zoltan Somogyi zs at cs.mu.OZ.AU
Thu Aug 25 13:19:26 AEST 2005


Significantly improve the capabilities of the LLDS optimization that tries
to delay the creation of the stack frame, in the hope that on some computation
paths the frame won't need to be created at all. Previously, the delayed
setup of the stack frame could take place only when a block without a stack
frame fell through to a block that needed a stack frame. If block B1 jumped
to another block B2 that needed a frame, this was taken as meaning that B1
also had to have a frame. This was a problem, because if B1 ends with a
computed goto, some of whose targets need stack frames and some do not,
this limitation effectively gave all of them a stack frame, whether they
wanted it or not, and thus required them to execute the stack frame teardown
code.

This diff removes the limitation, optimization allows B1 in this case to not
have a stack frame. Instead of jumping to B2, B1 will not jump to a label B3
it inserts immediately before B2, the code at B3 setting up the stack frame
and falling through to B2. (We also insert code to jump around B3 if the
code immediately preceding it could fall into it accidentally.)

The new code in frameopt is conceptually cleaner than it was before, because
we now handle transitions from blocks that don't have a stack stack to blocks
that do in a much more uniform manner.

Most of the changes to other modules are to make the change to frameopt.m
easier to debug.

The motivation for the change was that we were beaten by YAP (Yet Another
Prolog) on the deriv benchmark due to the limitation of frameopt. I haven't
measured against YAP yet, but the runtime for 1.5 million iterations has been
reduced from about 20 seconds to about 13.

Since the compiler doesn't have any predicates that are both frequently used
and can benefit from the removal of that old limitation (which is why the
limitation wasn't really noticed before), there is no measurable effect
on the speed of the compiler itself.

compiler/frameopt.m:
	Effectively rewrite the optimization that delays stack frame creation
	along the lines above. The code for the optimization that keeps the
	stack frame for recursive calls if possible is unaffected.

	If the new option --frameopt-comments is specified, insert into the
	generated LLDS code a nicely formatted description of the main
	frameopt.m data structures. These are much easier to read that the
	term browser in the debugger.

compiler/options.m:
	Add the new developer-only option --frameopt-comments.

compiler/llds_out.m:
	Change the way we output comments to make the coments generated by
	frameopt.m easier to read. (We output comments only if --auto-comments
	is given, which it usually isn't.)

compiler/opt_debug.m:
	Provide the functionality of printing local labels in an easier-to-read
	form that doesn't repeat the (possibly long) procedure name. Local
	labels can now be printed as e.g. local_15.

	Rewrite the module to use functions instead of predicates for appending
	strings, since this makes the code shorter, easier to use and to read.
	The original code was written before Mercury had functions.

compiler/switch_util.m:
	When gathering information about switches, return the cons_id with each
	goal.

	Switch to four-space indentation.

compiler/tag_switch.m:
	When generating code for switches, insert a comment at the start of
	each case saying what cons_id it is for, using the new information from
	switch_util. This is to make the generated code easier to understand.

	Switch to four-space indentation.

compiler/ml_tag_switch.m:
	Conform to the change in switch_util.

compiler/optimize.m:
	Conform to the slightly modified interface of frameopt.m.

	Switch to four-space indentation.

compiler/peephole.m:
	Switch to four-space indentation, and fix some coding style issues.

compiler/basic_block.m:
	When dividing a procedure body into basic blocks, remember for each
	block whether it could be fallen into. This modification is not
	strictly required for this change, since frameopt has its own
	(specialized) code for creating basic blocks, but it could be useful
	in the future.

compiler/dupelim.m:
compiler/use_local_vars.m:
	Conform to the change in basic_block.m

Zoltan.

cvs diff: Diffing .
cvs diff: Diffing analysis
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/basic_block.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/basic_block.m,v
retrieving revision 1.20
diff -u -b -r1.20 basic_block.m
--- compiler/basic_block.m	8 Aug 2005 02:57:09 -0000	1.20
+++ compiler/basic_block.m	21 Aug 2005 03:34:20 -0000
@@ -22,6 +22,7 @@
 :- import_module ll_backend__llds.
 :- import_module mdbcomp__prim_data.
 
+:- import_module bool.
 :- import_module counter.
 :- import_module list.
 :- import_module map.
@@ -33,14 +34,22 @@
     --->    block_info(
                 starting_label      :: label,
                                     % The label starting the block.
+
                 label_instr         :: instruction,
                                     % The instruction containing the label.
+
                 later_instrs        :: list(instruction),
                                     % The code of the block without the initial
                                     % label.
+
+                fallen_into         :: bool,
+                                    % Does the previous block (if any)
+                                    % fall through to this block?
+
                 jump_dests          :: list(label),
                                     % The labels we can jump to
                                     % (not falling through).
+
                 fall_dest           :: maybe(label)
                                     % The label we fall through to
                                     % (if there is one).
@@ -59,14 +68,13 @@
 
 :- import_module ll_backend__opt_util.
 
-:- import_module bool.
 :- import_module int.
 :- import_module require.
 
 create_basic_blocks(Instrs0, Comments, ProcLabel, !C, LabelSeq, BlockMap) :-
     opt_util__get_prologue(Instrs0, LabelInstr, Comments, AfterLabelInstrs),
     Instrs1 = [LabelInstr | AfterLabelInstrs],
-    build_block_map(Instrs1, LabelSeq, ProcLabel, map__init, BlockMap, !C).
+    build_block_map(Instrs1, LabelSeq, ProcLabel, no, map__init, BlockMap, !C).
 
 %-----------------------------------------------------------------------------%
 
@@ -74,11 +82,11 @@
     % instruction sequence so that every basic block has labels around it.
     %
 :- pred build_block_map(list(instruction)::in, list(label)::out,
-    proc_label::in, block_map::in, block_map::out,
+    proc_label::in, bool::in, block_map::in, block_map::out,
     counter::in, counter::out) is det.
 
-build_block_map([], [], _, !BlockMap, !C).
-build_block_map([OrigInstr0 | OrigInstrs0], LabelSeq, ProcLabel,
+build_block_map([], [], _, _, !BlockMap, !C).
+build_block_map([OrigInstr0 | OrigInstrs0], LabelSeq, ProcLabel, FallInto,
         !BlockMap, !C) :-
     ( OrigInstr0 = label(OrigLabel) - _ ->
         Label = OrigLabel,
@@ -92,27 +100,27 @@
     ),
     (
         take_until_end_of_block(RestInstrs, BlockInstrs, Instrs1),
-        build_block_map(Instrs1, LabelSeq0, ProcLabel, !BlockMap, !C),
+        build_block_map(Instrs1, LabelSeq1, ProcLabel, NextFallInto, !BlockMap,
+            !C),
         ( list__last(BlockInstrs, LastInstr) ->
             LastInstr = LastUinstr - _,
             opt_util__possible_targets(LastUinstr, SideLabels),
-            opt_util__can_instr_fall_through(LastUinstr, CanFallThrough),
+            opt_util__can_instr_fall_through(LastUinstr, NextFallInto)
+        ;
+            SideLabels = [],
+            NextFallInto = yes
+        ),
             (
-                CanFallThrough = yes,
-                get_fallthrough_from_seq(LabelSeq0,
-                    MaybeFallThrough)
+            NextFallInto = yes,
+            get_fallthrough_from_seq(LabelSeq1, MaybeFallThrough)
             ;
-                CanFallThrough = no,
+            NextFallInto = no,
                 MaybeFallThrough = no
-            )
-        ;
-            SideLabels = [],
-            get_fallthrough_from_seq(LabelSeq0, MaybeFallThrough)
         ),
-        BlockInfo = block_info(Label, LabelInstr, BlockInstrs,
+        BlockInfo = block_info(Label, LabelInstr, BlockInstrs, FallInto,
             SideLabels, MaybeFallThrough),
         map__det_insert(!.BlockMap, Label, BlockInfo, !:BlockMap),
-        LabelSeq = [Label | LabelSeq0]
+        LabelSeq = [Label | LabelSeq1]
     ).
 
 %-----------------------------------------------------------------------------%
@@ -151,7 +159,7 @@
 flatten_basic_blocks([Label | Labels], BlockMap, Instrs) :-
     flatten_basic_blocks(Labels, BlockMap, RestInstrs),
     map__lookup(BlockMap, Label, BlockInfo),
-    BlockInfo = block_info(_, BlockLabelInstr, BlockInstrs, _, _),
+    BlockInfo = block_info(_, BlockLabelInstr, BlockInstrs, _, _, _),
     list__append([BlockLabelInstr | BlockInstrs], RestInstrs, Instrs).
 
 %-----------------------------------------------------------------------------%
Index: compiler/dupelim.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/dupelim.m,v
retrieving revision 1.65
diff -u -b -r1.65 dupelim.m
--- compiler/dupelim.m	8 Jul 2005 04:22:01 -0000	1.65
+++ compiler/dupelim.m	20 Aug 2005 14:00:22 -0000
@@ -115,7 +115,7 @@
 dupelim__build_maps([], _, !StdMap, !Fixed).
 dupelim__build_maps([Label | Labels], BlockMap, !StdMap, !Fixed) :-
 	map__lookup(BlockMap, Label, BlockInfo),
-	BlockInfo = block_info(_, _, Instrs, _, MaybeFallThrough),
+	BlockInfo = block_info(_, _, Instrs, _, _, MaybeFallThrough),
 	standardize_instr_block(Instrs, MaybeFallThrough, StdInstrs),
 	( map__search(!.StdMap, StdInstrs, Cluster) ->
 		map__det_update(!.StdMap, StdInstrs, [Label | Cluster],
@@ -223,13 +223,13 @@
 	Cluster = cluster(Exemplar, ElimLabels),
 	map__lookup(!.BlockMap, Exemplar, ExemplarInfo0),
 	ExemplarInfo0 = block_info(ExLabel, ExLabelInstr, ExInstrs0,
-		ExSideLabels, ExMaybeFallThrough),
+		ExFallInto, ExSideLabels, ExMaybeFallThrough),
 	require(unify(Exemplar, ExLabel), "exemplar label mismatch"),
 	process_elim_labels(ElimLabels, ExInstrs0, !LabelSeq, !.BlockMap,
 		Exemplar, !ReplMap, UnifiedInstrs,
 		ExMaybeFallThrough, UnifiedMaybeFallThrough),
 	ExemplarInfo = block_info(ExLabel, ExLabelInstr, UnifiedInstrs,
-		ExSideLabels, UnifiedMaybeFallThrough),
+		ExFallInto, ExSideLabels, UnifiedMaybeFallThrough),
 	map__det_update(!.BlockMap, Exemplar, ExemplarInfo, !:BlockMap),
 	process_clusters(Clusters, !LabelSeq, !BlockMap, !ReplMap).
 
@@ -254,7 +254,7 @@
 		Exemplar, !ReplMap, Instrs, !MaybeFallThrough) :-
 	map__lookup(BlockMap, ElimLabel, ElimLabelInfo),
 	ElimLabelInfo = block_info(ElimLabel2, _, ElimInstrs,
-		_, ElimMaybeFallThrough),
+		_, _, ElimMaybeFallThrough),
 	require(unify(ElimLabel, ElimLabel2), "elim label mismatch"),
 	(
 		most_specific_block(Instrs0, !.MaybeFallThrough,
Index: compiler/frameopt.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/frameopt.m,v
retrieving revision 1.90
diff -u -b -r1.90 frameopt.m
--- compiler/frameopt.m	5 Aug 2005 05:01:30 -0000	1.90
+++ compiler/frameopt.m	24 Aug 2005 04:48:10 -0000
@@ -93,6 +93,7 @@
 
 :- interface.
 
+:- import_module libs__globals.
 :- import_module ll_backend__llds.
 :- import_module mdbcomp__prim_data.
 
@@ -101,24 +102,24 @@
 :- import_module list.
 :- import_module set.
 
-    % frameopt_main(ProcLabel, !LabelCounter, !Instrs, AnyChange, NewJumps):
+    % frameopt_main(ProcLabel, !LabelCounter, !Instrs, Globals, AnyChange,
+    %   NewJumps):
     %
     % Attempt to update !Instrs using the one of the transformations
     % described above for procedures that live on the det stack.
     %
-    % ProcLabel should be the ProcLabel of the procedure whose body
-    % !.Instrs implements, and !.LabelCounter that procedure's label
-    % counter. If frameopt_main allocates any labels, !:LabelCounter
-    % will reflect this.
+    % ProcLabel should be the ProcLabel of the procedure whose body !.Instrs
+    % implements, and !.LabelCounter that procedure's label counter.
+    % If frameopt_main allocates any labels, !:LabelCounter will reflect this.
     %
     % AnyChange says whether we performed any modifications.
     % If yes, then we also introduced some extra labels that should be
-    % deleted. NewJumps says whether we introduced any jumps that could
-    % be profitably be short-circuited.
+    % deleted and probably some jumps that could be profitably be
+    % short-circuited.
     %
 :- pred frameopt_main(proc_label::in, counter::in, counter::out,
-    list(instruction)::in, list(instruction)::out,
-    bool::out, bool::out) is det.
+    list(instruction)::in, list(instruction)::out, globals::in, bool::out)
+    is det.
 
     % frameopt_nondet(ProcLabel, LayoutLabels, MayAlterRtti, !LabelCounter,
     %   !Instrs, AnyChange):
@@ -148,10 +149,12 @@
 
 :- implementation.
 
+:- import_module libs__options.
 :- import_module ll_backend__code_util.
 :- import_module ll_backend__livemap.
 :- import_module ll_backend__opt_debug.
 :- import_module ll_backend__opt_util.
+:- import_module parse_tree__error_util.
 :- import_module parse_tree__prog_data.
 
 :- import_module assoc_list.
@@ -166,61 +169,72 @@
 :- import_module svqueue.
 :- import_module svset.
 
-frameopt_main(ProcLabel, !C, Instrs0, Instrs, Mod, Jumps) :-
+frameopt_main(ProcLabel, !C, Instrs0, Instrs, Globals, Mod) :-
     opt_util__get_prologue(Instrs0, LabelInstr, Comments0, Instrs1),
     ( frameopt__detstack_setup(Instrs1, FrameSize, Msg, _, _, _) ->
     	some [!BlockMap] (
             map__init(!:BlockMap),
             divide_into_basic_blocks([LabelInstr | Instrs1], ProcLabel,
                 BasicInstrs, !C),
-            build_block_map(BasicInstrs, FrameSize, LabelSeq0,
-                !BlockMap, ProcLabel, !C),
+            build_frame_block_map(BasicInstrs, FrameSize, LabelSeq0, no, no,
+                ProcLabel, !BlockMap, map__init, PredMap, !C),
             analyze_block_map(LabelSeq0, !BlockMap, KeepFrame),
             (
                 KeepFrame = yes(FirstLabel - SecondLabel),
                 CanClobberSuccip = can_clobber_succip(LabelSeq0, !.BlockMap),
-                keep_frame(LabelSeq0, FirstLabel, SecondLabel,
+                keep_frame_transform(LabelSeq0, FirstLabel, SecondLabel,
                     CanClobberSuccip, !BlockMap),
                 LabelSeq = LabelSeq0,
                 NewComment = comment("keeping stack frame") - "",
                 list__append(Comments0, [NewComment], Comments),
                 flatten_block_seq(LabelSeq, !.BlockMap, BodyInstrs),
                 list__append(Comments, BodyInstrs, Instrs),
-                Mod = yes,
-                Jumps = yes
+                Mod = yes
             ;
                 KeepFrame = no,
-                ( can_delay_frame(LabelSeq0, !.BlockMap, yes) ->
-                    delay_frame(LabelSeq0, LabelSeq, FrameSize, Msg, ProcLabel,
-                        !C, !BlockMap),
-                    NewComment = comment("delaying stack frame") - "",
-                    list__append(Comments0, [NewComment], Comments),
+                (
+                    can_delay_frame(LabelSeq0, !.BlockMap),
+                    delay_frame_transform(LabelSeq0, LabelSeq, FrameSize, Msg,
+                        ProcLabel, PredMap, !C, !BlockMap, Globals,
+                        NewComments, CanTransform),
+                    CanTransform = can_transform
+                ->
+                    Comments = Comments0 ++ NewComments,
                     flatten_block_seq(LabelSeq, !.BlockMap, BodyInstrs),
                     list__append(Comments, BodyInstrs, Instrs),
-                    Mod = yes,
-                    Jumps = no
+                    Mod = yes
                 ;
                     Instrs = Instrs0,
-                    Mod = no,
-                    Jumps = no
+                    Mod = no
                 )
             )
         )
     ;
         Instrs = Instrs0,
-        Mod = no,
-        Jumps = no
+        Mod = no
     ).
 
-:- pred flatten_block_seq(list(label)::in, block_map::in,
+:- pred flatten_block_seq(list(label)::in, frame_block_map::in,
     list(instruction)::out) is det.
 
 flatten_block_seq([], _, []).
 flatten_block_seq([Label | Labels], BlockMap, Instrs) :-
     flatten_block_seq(Labels, BlockMap, RestInstrs),
     map__lookup(BlockMap, Label, BlockInfo),
-    BlockInfo = block_info(_, BlockInstrs, _, _, _),
-    list__append(BlockInstrs, RestInstrs, Instrs).
+    BlockInstrs = BlockInfo ^ fb_instrs,
+    (
+        list__split_last(BlockInstrs, MostInstrs, LastInstr),
+        Labels = [NextLabel | _],
+        LastInstr = goto(label(NextLabel)) - _
+    ->
+        % Optimize away the redundant goto, which we probably introduced.
+        % The next invocation of jumpopt would also do this, but doing it here
+        % is cheaper and may let us reach a fixpoint in the optimization
+        % sequence earlier.
+        Instrs = MostInstrs ++ RestInstrs
+    ;
+        Instrs = BlockInstrs ++ RestInstrs
+    ).
 
 %-----------------------------------------------------------------------------%
 
@@ -313,38 +327,48 @@
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
-:- type block_map   ==  map(label, block_info).
+:- type frame_block_map   ==  map(label, frame_block_info).
 
-:- type block_info
-    --->    block_info(
-                label,
+:- type frame_block_info
+    --->    frame_block_info(
+                fb_label        :: label,
                     % The label of the first instr.
-                list(instruction),
+
+                fb_instrs       :: list(instruction),
                     % The code of the block.
-                list(label),
+
+                fb_fallen_into  :: maybe(label),
+                                % Does the previous block (if any)
+                                % fall through to this block, and if yes,
+                                % what is its label?
+
+                fb_jump_dests   :: list(label),
                     % The labels we can jump to
                     % (not falling through).
-                maybe(label),
+
+                fb_fall_dest    :: maybe(label),
                     % The label we fall through to
                     % (if there is one).
-                block_type
+
+                fb_type         :: block_type
             ).
 
 :- type block_type
     --->    setup           % This is a block containing
                             % only setup instructions.
+
     ;       ordinary(bool)  % This block does not contain setup or
                             % teardown. The bool says whether the code
                             % in the block needs a stack frame.
-    ;       teardown(
-                            % This block contains stack
-                            % teardown and goto code.
+
+    ;       teardown(           % This block contains stack teardown
+                                % and goto code.
                 list(instruction),
-                            % the instr that restores succip (if any),
+                                % The instr that restores succip (if any),
                 list(instruction),
-                            % the livevals instr before the goto (if any),
+                                % The livevals instr before the goto (if any),
                 instruction
-                            % the goto instr
+                                % The goto instr.
             ).
 
 %-----------------------------------------------------------------------------%
@@ -356,7 +380,7 @@
     list(instruction)::out, counter::in, counter::out) is det.
 
 divide_into_basic_blocks([], _, [], !C).
-    % Control can fall of the end of a procedure if that procedure
+    % Control can fall off the end of a procedure if that procedure
     % ends with a call to another procedure that cannot succeed.
     % This is the only situation in which the base case can be reached.
 divide_into_basic_blocks([Instr0 | Instrs0], ProcLabel, Instrs, !C) :-
@@ -396,30 +420,37 @@
     %
     % - teardown blocks that remove an existing stack frame.
     %
-    % For such each block, create a block_info structure that gives the
+    % For such each block, create a frame_block_info structure that gives the
     % label starting the block, the instructions in the block, and its
-    % type. Two of the fields of the block_info structure are filled in
+    % type. Two of the fields of the frame_block_info structure are filled in
     % with dummy values; they will be filled in for real later.
     %
-    % Put these block_info structures into a table indexed by the label,
+    % Put these frame_block_info structures into a table indexed by the label,
     % and return the sequence of labels of the blocks in their original
     % order.
     %
-:- pred build_block_map(list(instruction)::in, int::in, list(label)::out,
-    block_map::in, block_map::out, proc_label::in,
-    counter::in, counter::out) is det.
-
-build_block_map([], _, [], !BlockMap, _, !C).
-build_block_map([Instr0 | Instrs0], FrameSize, LabelSeq, !BlockMap,
-        ProcLabel, !C) :-
+:- pred build_frame_block_map(list(instruction)::in, int::in, list(label)::out,
+    maybe(label)::in, maybe(label)::in, proc_label::in,
+    frame_block_map::in, frame_block_map::out,
+    pred_map::in, pred_map::out, counter::in, counter::out) is det.
+
+build_frame_block_map([], _, [], _, _, _, !BlockMap, !PredMap, !C).
+build_frame_block_map([Instr0 | Instrs0], FrameSize, LabelSeq,
+        MaybePrevLabel, FallInto, ProcLabel, !BlockMap, !PredMap, !C) :-
     ( Instr0 = label(Label) - _ ->
         (
+            MaybePrevLabel = yes(PrevLabel),
+            svmap__det_insert(Label, PrevLabel, !PredMap)
+        ;
+            MaybePrevLabel = no
+        ),
+        (
             frameopt__detstack_setup(Instrs0, _, _, Setup, Others, Remain)
         ->
-            % Create a block with just the Setup instructions
-            % in it.
+            % Create a block with just the Setup instructions in it.
 
-            BlockInfo = block_info(Label, [Instr0 | Setup], [], no, setup),
+            BlockInfo = frame_block_info(Label, [Instr0 | Setup], FallInto,
+                [], no, setup),
             list__append(Others, Remain, Instrs1),
             (
                 Instrs1 = [Instr1 | _],
@@ -432,62 +463,80 @@
                 NewInstr = label(NewLabel) - "",
                 Instrs2 = [NewInstr | Instrs1]
             ),
-            build_block_map(Instrs2, FrameSize, LabelSeq0, !BlockMap,
-                ProcLabel, !C),
+            build_frame_block_map(Instrs2, FrameSize, LabelSeq0, yes(Label),
+                yes(Label), ProcLabel, !BlockMap, !PredMap, !C),
             svmap__det_insert(Label, BlockInfo, !BlockMap),
             LabelSeq = [Label | LabelSeq0]
         ;
-            frameopt__detstack_teardown(Instrs0, FrameSize, Tail, Succip,
-                Decrsp, Livevals, Goto, Remain)
+            frameopt__detstack_teardown(Instrs0, FrameSize, Extra,
+                SuccipRestore, Decrsp, Livevals, Goto, Remain)
         ->
-            list__append(Livevals, [Goto], Teardown0),
-            list__append(Decrsp, Teardown0, Teardown1),
-            list__append(Succip, Teardown1, Teardown),
+            Teardown = SuccipRestore ++ Decrsp ++ Livevals ++ [Goto],
             (
-                Tail = [],
-                MaybeTailInfo = no,
+                Extra = [],
+                MaybeExtraInfo = no,
                 LabelledBlock = [Instr0 | Teardown],
                 TeardownLabel = Label,
-                TeardownInfo = block_info(TeardownLabel, LabelledBlock, [], no,
-                    teardown(Succip, Livevals, Goto))
-            ;
-                Tail = [_ | _],
-                block_needs_frame(Tail, Needs),
-                TailInfo = block_info(Label, [Instr0 | Tail], [], no,
-                    ordinary(Needs)),
-                MaybeTailInfo = yes(TailInfo - Label),
+                TeardownInfo = frame_block_info(TeardownLabel, LabelledBlock,
+                    FallInto, [], no, teardown(SuccipRestore, Livevals, Goto)),
+                NextPrevLabel = Label
+            ;
+                Extra = [_ | _],
+                block_needs_frame(Extra, Needs),
+                ExtraInfo = frame_block_info(Label, [Instr0 | Extra],
+                    FallInto, [], no, ordinary(Needs)),
+                MaybeExtraInfo = yes(ExtraInfo - Label),
                 counter__allocate(N, !C),
                 NewLabel = internal(N, ProcLabel),
                 NewInstr = label(NewLabel) - "",
                 LabelledBlock = [NewInstr | Teardown],
                 TeardownLabel = NewLabel,
-                TeardownInfo = block_info(TeardownLabel, LabelledBlock, [], no,
-                    teardown(Succip, Livevals, Goto))
+                TeardownInfo = frame_block_info(TeardownLabel, LabelledBlock,
+                    yes(Label), [], no,
+                    teardown(SuccipRestore, Livevals, Goto)),
+                svmap__det_insert(NewLabel, Label, !PredMap),
+                NextPrevLabel = TeardownLabel
             ),
-            build_block_map(Remain, FrameSize, LabelSeq0, !BlockMap,
-                ProcLabel, !C),
+            build_frame_block_map(Remain, FrameSize, LabelSeq0,
+                yes(NextPrevLabel), no, ProcLabel, !BlockMap, !PredMap, !C),
             (
-                MaybeTailInfo = no,
+                MaybeExtraInfo = no,
                 svmap__det_insert(TeardownLabel, TeardownInfo, !BlockMap),
                 LabelSeq = [TeardownLabel | LabelSeq0]
             ;
-                MaybeTailInfo = yes(TailInfo2 - TailLabel2),
+                MaybeExtraInfo = yes(ExtraInfo2 - ExtraLabel2),
                 svmap__det_insert(TeardownLabel, TeardownInfo, !BlockMap),
-                svmap__det_insert(TailLabel2, TailInfo2, !BlockMap),
-                LabelSeq = [TailLabel2, TeardownLabel | LabelSeq0]
+                svmap__det_insert(ExtraLabel2, ExtraInfo2, !BlockMap),
+                LabelSeq = [ExtraLabel2, TeardownLabel | LabelSeq0]
             )
         ;
             opt_util__skip_to_next_label(Instrs0, Block, Instrs1),
             block_needs_frame(Block, Needs),
-            BlockInfo = block_info(Label, [Instr0 | Block], [], no,
-                ordinary(Needs)),
-            build_block_map(Instrs1, FrameSize, LabelSeq0, !BlockMap,
-                ProcLabel, !C),
+            BlockInstrs = [Instr0 | Block],
+            BlockInfo = frame_block_info(Label, BlockInstrs, FallInto,
+                [], no, ordinary(Needs)),
+            ( list__last(BlockInstrs, LastBlockInstr) ->
+                LastBlockInstr = LastBlockUinstr - _,
+                opt_util__can_instr_fall_through(LastBlockUinstr,
+                    NextFallIntoBool),
+                (
+                    NextFallIntoBool = yes,
+                    NextFallInto = yes(Label)
+                ;
+                    NextFallIntoBool = no,
+                    NextFallInto = no
+                )
+            ;
+                NextFallInto = yes(Label)
+            ),
+            build_frame_block_map(Instrs1, FrameSize, LabelSeq0,
+                yes(Label), NextFallInto, ProcLabel, !BlockMap, !PredMap, !C),
             svmap__det_insert(Label, BlockInfo, !BlockMap),
             LabelSeq = [Label | LabelSeq0]
         )
     ;
-        error("block does not start with label")
+        unexpected(this_file,
+            "build_frame_block_map; block does not start with label")
     ).
 
 %-----------------------------------------------------------------------------%
@@ -516,30 +565,28 @@
     instruction::out, list(instruction)::in, list(instruction)::out,
     list(instruction)::out) is semidet.
 
-frameopt__detstack_setup_2([Instr0 | Instrs0], FrameSize, Setup,
-        Others0, Others, Remain) :-
+frameopt__detstack_setup_2([Instr0 | Instrs0], FrameSize, Setup, !Others,
+        Remain) :-
     ( Instr0 = assign(Lval, Rval) - _ ->
         (
             Lval = stackvar(FrameSize),
             Rval = lval(succip)
         ->
-            Others = Others0,
             Setup = Instr0,
             Remain = Instrs0
         ;
             Lval \= succip,
             Lval \= stackvar(FrameSize)
         ->
-            list__append(Others0, [Instr0], Others1),
-            frameopt__detstack_setup_2(Instrs0, FrameSize, Setup,
-                Others1, Others, Remain)
+            !:Others = !.Others ++ [Instr0],
+            frameopt__detstack_setup_2(Instrs0, FrameSize, Setup, !Others,
+                Remain)
         ;
             fail
         )
     ; Instr0 = comment(_) - _ ->
-        list__append(Others0, [Instr0], Others1),
-        frameopt__detstack_setup_2(Instrs0, FrameSize, Setup,
-            Others1, Others, Remain)
+        !:Others = !.Others ++ [Instr0],
+        frameopt__detstack_setup_2(Instrs0, FrameSize, Setup, !Others, Remain)
     ;
         fail
     ).
@@ -682,7 +729,7 @@
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
-    % For each block in the given sequence, whose block_info structures
+    % For each block in the given sequence, whose frame_block_info structures
     % in the given block map have been partially filled in, fill in the
     % remaining two fields. These two fields give the labels the block
     % can branch to on the side (this includes return addresses for calls),
@@ -698,14 +745,14 @@
     % it in tailcalls that avoid the stack teardown, which is the label
     % immediately after the initial stack setup block.
     %
-:- pred analyze_block_map(list(label)::in, block_map::in, block_map::out,
-    maybe(pair(label))::out) is det.
+:- pred analyze_block_map(list(label)::in,
+    frame_block_map::in, frame_block_map::out, maybe(pair(label))::out) is det.
 
 analyze_block_map(LabelSeq, !BlockMap, KeepFrameData) :-
     (
         LabelSeq = [FirstLabel, SecondLabel | _],
         map__search(!.BlockMap, FirstLabel, FirstBlockInfo),
-        FirstBlockInfo = block_info(FirstLabel, _, _, _, setup)
+        FirstBlockInfo = frame_block_info(FirstLabel, _, _, _, _, setup)
     ->
         analyze_block_map_2(LabelSeq, FirstLabel, !BlockMap, no, KeepFrame),
         (
@@ -716,16 +763,17 @@
             KeepFrameData = no
         )
     ;
-        error("bad data in analyze_block_map")
+        unexpected(this_file, "analyze_block_map: bad data")
     ).
 
 :- pred analyze_block_map_2(list(label)::in, label::in,
-    block_map::in, block_map::out, bool::in, bool::out) is det.
+    frame_block_map::in, frame_block_map::out, bool::in, bool::out) is det.
 
 analyze_block_map_2([], _, !BlockMap, !KeepFrame).
 analyze_block_map_2([Label | Labels], FirstLabel, !BlockMap, !KeepFrame) :-
     map__lookup(!.BlockMap, Label, BlockInfo0),
-    BlockInfo0 = block_info(BlockLabel, BlockInstrs, _, _, Type),
+    BlockInfo0 = frame_block_info(BlockLabel, BlockInstrs, FallInto,
+        _, _, Type),
     (
         Label = BlockLabel, % sanity check
         list__last(BlockInstrs, LastInstr)
@@ -749,11 +797,11 @@
             true
         )
     ;
-        error("bad data in analyze_block_map_2")
+        unexpected(this_file, "analyze_block_map_2: mismatch or no last instr")
     ),
-    BlockInfo = block_info(BlockLabel, BlockInstrs, SideLabels,
-        MaybeFallThrough, Type),
-    map__det_update(!.BlockMap, Label, BlockInfo, !:BlockMap),
+    BlockInfo = frame_block_info(BlockLabel, BlockInstrs, FallInto,
+        SideLabels, MaybeFallThrough, Type),
+    svmap__det_update(Label, BlockInfo, !BlockMap),
     analyze_block_map_2(Labels, FirstLabel, !BlockMap, !KeepFrame).
 
     % The form of a label used in a tailcall may be different from
@@ -785,12 +833,12 @@
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
-:- func can_clobber_succip(list(label), block_map) = bool.
+:- func can_clobber_succip(list(label), frame_block_map) = bool.
 
 can_clobber_succip([], _BlockMap) = no.
 can_clobber_succip([Label | Labels], BlockMap) = CanClobberSuccip :-
     map__lookup(BlockMap, Label, BlockInfo),
-    BlockInfo = block_info(_, Instrs, _, _, _),
+    Instrs = BlockInfo ^ fb_instrs,
     (
         list__member(Instr, Instrs),
         Instr = Uinstr - _,
@@ -816,15 +864,15 @@
     % (a form of which appears in existing tailcalls) and the label that
     % should replace it in tailcalls that avoid the stack teardown.
     %
-:- pred keep_frame(list(label)::in, label::in, label::in, bool::in,
-    block_map::in, block_map::out) is det.
+:- pred keep_frame_transform(list(label)::in, label::in, label::in, bool::in,
+    frame_block_map::in, frame_block_map::out) is det.
 
-keep_frame([], _, _, _, !BlockMap).
-keep_frame([Label | Labels], FirstLabel, SecondLabel, CanClobberSuccip,
-        !BlockMap) :-
+keep_frame_transform([], _, _, _, !BlockMap).
+keep_frame_transform([Label | Labels], FirstLabel, SecondLabel,
+        CanClobberSuccip, !BlockMap) :-
     map__lookup(!.BlockMap, Label, BlockInfo0),
     (
-        BlockInfo0 = block_info(Label, OrigInstrs, [_], no,
+        BlockInfo0 = frame_block_info(Label, OrigInstrs, FallInto, [_], no,
             teardown(Succip, Livevals, Goto)),
         Goto = goto(label(GotoLabel)) - Comment,
         matching_label_ref(FirstLabel, GotoLabel)
@@ -835,7 +883,8 @@
         ->
             OrigLabelInstr = OrigInstr0
         ;
-            error("block does not begin with label")
+            unexpected(this_file,
+                "keep_frame_transform: block does not begin with label")
         ),
         string__append(Comment, " (keeping frame)", NewComment),
         NewGoto = goto(label(SecondLabel)) - NewComment,
@@ -848,18 +897,20 @@
             BackInstrs = LivevalsGoto
         ),
         Instrs = [OrigLabelInstr | BackInstrs],
-        BlockInfo = block_info(Label, Instrs, [SecondLabel], no,
-            ordinary(yes)),
+        BlockInfo = frame_block_info(Label, Instrs, FallInto,
+            [SecondLabel], no, ordinary(yes)),
         map__det_update(!.BlockMap, Label, BlockInfo, !:BlockMap)
     ;
         true
     ),
-    keep_frame(Labels, FirstLabel, SecondLabel, CanClobberSuccip, !BlockMap).
+    keep_frame_transform(Labels, FirstLabel, SecondLabel, CanClobberSuccip,
+        !BlockMap).
 
+% list__split_last_det
 :- pred pick_last(list(T)::in, list(T)::out, T::out) is det.
 
 pick_last([], _, _) :-
-    error("empty list in pick_last").
+    unexpected(this_file, "empty list in pick_last").
 pick_last([First | Rest], NonLast, Last) :-
     (
         Rest = [],
@@ -875,128 +926,214 @@
 %-----------------------------------------------------------------------------%
 
     % Check that we can use the delay_frame transformation. This requires
-    % that only the first block is of the setup type, and that the
-    % second block is of the ordinary type. Since the transformation
-    % is a null operation if the second block needs a stack frame,
-    % we lie a bit and say that the transformation is not applicable
-    % in such cases.
+    % that only the first block is of the setup type.
     %
-:- pred can_delay_frame(list(label)::in, block_map::in, bool::in) is semidet.
+:- pred can_delay_frame(list(label)::in, frame_block_map::in) is semidet.
 
-can_delay_frame([], _, _).
-can_delay_frame([Label | Labels], BlockMap, First) :-
+can_delay_frame([], _).
+can_delay_frame([Label | _Labels], BlockMap) :-
     map__lookup(BlockMap, Label, BlockInfo),
-    BlockInfo = block_info(_, _, _, MaybeFallThrough, BlockType),
-    ( BlockType = setup ->
-        First = yes,
-        MaybeFallThrough = yes(FallThrough),
-        map__lookup(BlockMap, FallThrough, FallThroughBlockInfo),
-        FallThroughBlockInfo = block_info(_, _, _, _, FallThroughType),
-        FallThroughType = ordinary(no)
-    ;
-        can_delay_frame(Labels, BlockMap, no)
-    ).
+    BlockInfo ^ fb_type = setup.
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
     % The data structures used in the delaying optimizations.
 
-    % map__search(RevMap, Label, SideLabels) should be true
-    % if the block started by Label can be reached via jump
-    % (i.e. not fallthrough) from the labels in SideLabels.
+    % map__search(RevMap, Label, SideLabels) should be true if the block
+    % started by Label can be reached via jump or fallthrough from the labels
+    % in SideLabels.
     %
 :- type rev_map ==  map(label, list(label)).
 
-    % map__search(ParMap, Label, ParallelLabel) should be true if
-    % Label starts a teardown block and ParallelLabel starts its parallel
-    % (i.e. a copy without the stack teardown code and therefore an
-    % ordinary block).
-    %
-:- type par_map ==  map(label, label).
-
-    % set__member(Label, FallIntoParallel) should be true if
-    % Label starts a teardown block and the immediately previous block
-    % does not have a stack frame and falls through into the teardown
-    % block.
-    %
-    % If it is true, then we will put the new ParallelLabel block
-    % immediately before the Label block; if it is false, we will put it
-    % immediately after. (Both teardown blocks and their parallels
-    % end with a goto, so the first block cannot fall through to the
-    % second, nor can the presence of the second block prevent any
-    % fallthrough from the first block to some other block.)
+    % Given the label L starting a block, map__search(PredMap, L, PrevL)
+    % is true if PrevL starts the block immediately before L.
+    % If L is the first block in the sequence (which should be a setup block),
+    % map__search(PredMap, L, _) fails.
+:- type pred_map == map(label, label).
+
+    % map__search(SetupParMap, L, SetupL) should be true if L starts
+    % an ordinary block that needs a stack frame that can be jumped to by
+    % blocks that do not have a stack frame. In this case, SetupL will be the
+    % label starting a new block that sets up the stack frame before handing
+    % control to L. We put SetupL's block immediately before L's block.
+    % If L cannot be fallen into, this is fine. If it can, we put a goto
+    % around SetupL's block after the previous block. In most cases,
+    % full jump optimization to duplicate code as necessary to optimize away
+    % the goto.
+    %
+:- type setup_par_map ---> setup_par_map(map(label, label)).
+
+    % map__search(TeardownParMap, L, ParallelL should be true if L starts
+    % a teardown block and ParallelL starts a copy of L's block from which
+    % the instructions to tear down the stack frame have been deleted.
+    % If the block immediately before L does not have a stack frame,
+    % we put ParallelL before L. If it does, we put ParallelL after L.
+    % since neither L nor ParallelL can fall through, we don't need any gotos
+    % to jump around blocks.
+    %
+:- type teardown_par_map ---> teardown_par_map(map(label, label)).
 
 %-----------------------------------------------------------------------------%
 
+:- type can_transform
+    --->    can_transform
+    ;       cannot_transform.
+
+    % XXX needs updating
+
     % The optimization of delaying the creation of stack frames as long
     % as possible is in three main phases:
     %
-    % - The first phase finds out which ordinary blocks need a
-    %   a stack frame. This naturally includes blocks that access
-    %   stackvars, and blocks that perform calls. It also includes
-    %   blocks that jump to ordinary blocks that need a frame,
-    %   or which are jumped to or fallen through to from ordinary
-    %   blocks that need a stack frame. It does not include blocks
-    %   that fall through to ordinary blocks that need a frame,
-    %   since the frame setup code can be interposed between the
-    %   two blocks.
-    %
-    % - The second phase gets rid of the frame setup code in the
-    %   initial setup block, but its main task is to transform
-    %   ordinary blocks that do not need a frame. Such blocks cannot
-    %   directly jump to ordinary blocks that need a frame (if they
-    %   could, they would have been marked as needing a frame too),
-    %   but they can jump to teardown blocks that also assume the
-    %   presence of a frame. Therefore the last instruction in such
-    %   blocks, the only one that can jump out of the block, must be
-    %   modified to jump to non-teardown parallels to these teardown
-    %   blocks. These parallel blocks will be created in the third
-    %   phase, but to make the substitution possible we allocate labels
-    %   for them in this phase.
-    %
-    %   We must also correctly process fallthrough from such blocks.
-    %   If the block can fall through to a teardown block, we mark
-    %   the teardown block so that its parallel will be put before it.
-    %   If the block can fall through to an ordinary block that needs
-    %   a frame, then we put stack frame setup code between the two
-    %   blocks.
-    %
-    % - The third phase creates non-teardown parallels to the teardown
-    %   blocks that need them, and puts them in their correct place,
-    %   either just before or just after the original block.
+    % - The first phase finds out which ordinary blocks need a stack frame.
+    %   This naturally includes blocks that access stackvars, and blocks
+    %   that perform calls. It also includes blocks which are jumped to
+    %   or fallen through to from ordinary blocks that need a stack frame;
+    %   this is done by propagate_frame_requirement_to_successors.   
+    %   A predecessor of a block that needs a frame need not have a frame
+    %   itself, since we can interpose the frame setup code on the jump or
+    %   fallthrough between them. However, if all of a block's successors
+    %   need a frame, then interposing the setup code on *all* those jumps
+    %   and/or fallthroughs is a space cost, and delaying the setup doesn't
+    %   gain any time, so we may as well say that the predecessor itself needs
+    %   a frame. This is done by propagate_frame_requirement_to_predecessors.
+    %   If a propagation step says that a setup block needs a stack frame,
+    %   that implies that all blocks need a frame, and thus we cannot avoid
+    %   setting up a stack frame on any path. In such cases, this predicate
+    %   wil return CanTransform = cannot_transform, which tells our caller
+    %   to leave the procedure's code unmodified.
+    %
+    % - The second phase gets rid of the frame setup code in the initial
+    %   setup block, but its main task is to transform ordinary blocks that
+    %   do not need a frame. Every block that is a successor of such a block,
+    %   whether via jump or fallthrough, will be an ordinary block or a
+    %   teardown block.
+    %
+    %   - If the successor is an ordinary block that doesn't need a frame,
+    %     the transfer of control remains as before.
+    %
+    %   - If the successor is an ordinary block B that does need a stack frame,
+    %     we need to insert the frame setup code at the transfer between the
+    %     two blocks. In phase 2, we note the need for this insertion by
+    %     allocating a new label SetupB, which will start a new block that will
+    %     create the stack frame and then fall through to B. In the second
+    %     phase, we alter the transfer of control to goto to SetupB instead
+    %     of B; the creation of SetupB's block is left to the third phase.
+    %     The correspondence between B and SetupB is recorded in SetupParMap.
+    %
+    %   - If the successor is a teardown block B, then we modify the transfer
+    %     of control to jump a new label ParallelB, whose block has the same
+    %     code as B's block, except for the deletion of the instructions that
+    %     tear down the (nonexistent along this path) stack frame. The
+    %     correspondence between B and ParallelB is recorded in TeardownParMap.
+    %
+    % - The third phase has the job of adding the pieces of code whose
+    %   existence is assumed by the modified code output by the second stage.
+    %
+    %   For every frame-needing ordinary block that can be jumped to from
+    %   someplace that does not have a stack frame (i.e. for every B in
+    %   SetupParMap), we insert before it the SetupB label followed by
+    %   the code to set up the stack frame SetupB's predecessor may need to
+    %   jump around SetupB's block if previously it fell through to B.)
+    %
+    %   For every teardown block that can jumped to from someplace that does
+    %   not have a stack frame (i.e. for every B in TeardownParMap), we create
+    %   a new block that is a clone of B with the stack teardown deleted.
+    %   Whether we put B or ParallelB first depends on whether the immediately
+    %   previous block has a stack frame or not.
+    %
+:- pred delay_frame_transform(list(label)::in, list(label)::out, int::in,
+    string::in, proc_label::in, pred_map::in, counter::in, counter::out,
+    frame_block_map::in, frame_block_map::out, globals::in,
+    list(instruction)::out, can_transform::out) is det.
+
+delay_frame_transform(!LabelSeq, FrameSize, Msg, ProcLabel, PredMap, !C,
+        !BlockMap, Globals, NewComments, CanTransform) :-
+    some [!OrdNeedsFrame, !CanTransform, !PropagationStepsLeft] (
+        !:OrdNeedsFrame = map__init,
+        !:CanTransform = can_transform,
+        !:PropagationStepsLeft = max_propagation_steps,
+        delay_frame_init(!.LabelSeq, !.BlockMap, map__init, RevMap,
+            queue__init, SuccQueue, !OrdNeedsFrame),
+        propagate_frame_requirement_to_successors(SuccQueue, !.BlockMap,
+            !OrdNeedsFrame, set__init, !PropagationStepsLeft, !CanTransform),
+        map__to_assoc_list(!.OrdNeedsFrame, OrdNeedsFrameList),
+        list__filter_map(key_block_needs_frame, OrdNeedsFrameList, Frontier),
+        queue__list_to_queue(Frontier, PredQueue),
+        propagate_frame_requirement_to_predecessors(PredQueue, !.BlockMap,
+            RevMap, !OrdNeedsFrame, !.PropagationStepsLeft, _, !CanTransform),
+        (
+            !.CanTransform = cannot_transform,
+            % The delay frame optimization is not applicable; our caller will
+            % ignore all the other output arguments.
+            NewComments = []
+        ;
+            !.CanTransform = can_transform,
+            globals__lookup_bool_option(Globals, frameopt_comments,
+                FrameoptComments),
+            (
+                FrameoptComments = no,
+                NewComments = []
+            ;
+                FrameoptComments = yes,
+                FirstComment = comment("delaying stack frame") - "",
+                list__map(describe_block(!.BlockMap, !.OrdNeedsFrame,
+                    PredMap, ProcLabel), !.LabelSeq, BlockComments),
+                NewComments = [FirstComment | BlockComments]
+            ),
+            process_frame_delay(!.LabelSeq, !.OrdNeedsFrame, ProcLabel, !C,
+                !BlockMap, setup_par_map(map__init), SetupParMap,
+                teardown_par_map(map__init), TeardownParMap),
+            create_parallels(!LabelSeq, FrameSize, Msg, ProcLabel, !C,
+                !.OrdNeedsFrame, SetupParMap, TeardownParMap, PredMap,
+                !BlockMap)
+        ),
+        CanTransform = !.CanTransform
+    ).
+
+    % We want to stop the transformation if we need more than this many
+    % propagation steps. For such large predicates (write_ordinary_term
+    % in , any performance benefit
+    % of frameopt is unlikely to be noticeable.
     %
-:- pred delay_frame(list(label)::in, list(label)::out, int::in, string::in,
-    proc_label::in, counter::in, counter::out,
-    block_map::in, block_map::out) is det.
+:- func max_propagation_steps = int.
+
+max_propagation_steps = 10000.
 
-delay_frame(LabelSeq0, LabelSeq, FrameSize, Msg, ProcLabel, !C, !BlockMap) :-
-    delay_frame_init(LabelSeq0, !.BlockMap, map__init, RevMap,
-        queue__init, Queue1),
-    propagate_framed_labels(Queue1, !.BlockMap, RevMap,
-        set__init, FramedLabels),
-    process_frame_delay(LabelSeq0, FramedLabels, FrameSize, Msg, ProcLabel, !C,
-        LabelSeq1, !BlockMap, map__init, ParMap, set__init, FallIntoParallel),
-    create_parallels(LabelSeq1, LabelSeq, ParMap, FallIntoParallel, !BlockMap).
+:- pred key_block_needs_frame(pair(label, bool)::in, label::out) is semidet.
+
+key_block_needs_frame(Label - yes, Label).
 
 %-----------------------------------------------------------------------------%
 
-    % Initialize two data structures for the delaying operation.
+    % Maps the label of each ordinary block to a bool that says whether
+    % the block needs a stack frame or not.
+    %
+:- type ord_needs_frame == map(label, bool).
+
+    % Initialize the data structures for the delaying operation.
     % The first is a map showing the predecessors of each block,
-    % i.e. the set of blocks that can jump to each other block.
+    % i.e. the set of blocks that can jump to or fall through each other block.
     % The second is a queue of ordinary blocks that need a stack frame.
+    % The third says, for each ordinary block, whether it needs a stack frame.
     %
-:- pred delay_frame_init(list(label)::in, block_map::in,
-    rev_map::in, rev_map::out, queue(label)::in, queue(label)::out) is det.
-
-delay_frame_init([], _, !RevMap, !Queue).
-delay_frame_init([Label | Labels], BlockMap, !RevMap, !Queue) :-
+    % This predicate implements the first part of the first phase of
+    % delay_frame_transform.
+    %
+:- pred delay_frame_init(list(label)::in, frame_block_map::in,
+    rev_map::in, rev_map::out, queue(label)::in, queue(label)::out,
+    ord_needs_frame::in, ord_needs_frame::out) is det.
+
+delay_frame_init([], _, !RevMap, !Queue, !OrdNeedsFrame).
+delay_frame_init([Label | Labels], BlockMap, !RevMap, !Queue,
+        !OrdNeedsFrame) :-
     map__lookup(BlockMap, Label, BlockInfo),
-    BlockInfo = block_info(_, _, SideLabels, _, BlockType),
+    BlockType = BlockInfo ^ fb_type,
     (
         BlockType = setup
     ;
         BlockType = ordinary(NeedsFrame),
+        svmap__det_insert(Label, NeedsFrame, !OrdNeedsFrame),
         (
             NeedsFrame = no
         ;
@@ -1006,8 +1143,8 @@
     ;
         BlockType = teardown(_, _, _)
     ),
-    rev_map_side_labels(SideLabels, Label, !RevMap),
-    delay_frame_init(Labels, BlockMap, !RevMap, !Queue).
+    rev_map_side_labels(successors(BlockInfo), Label, !RevMap),
+    delay_frame_init(Labels, BlockMap, !RevMap, !Queue, !OrdNeedsFrame).
 
 :- pred rev_map_side_labels(list(label)::in, label::in,
     rev_map::in, rev_map::out) is det.
@@ -1025,89 +1162,185 @@
 
 %-----------------------------------------------------------------------------%
 
-    % Given !.FramedLabels, a set of labels representing ordinary blocks
-    % that must have a stack frame, propagate the requirement for a stack
-    % frame to labels representing other ordinary blocks that
-    %
-    % - are reachable from a block in FramedLabels0, either by jump or
-    %   by falling through, or
-    %
-    % - can perform a jump to a block in FramedLabels0.
-    %
-    % The requirement is not propagated to blocks that can fall through
-    % to a block in !.FramedLabels, since on such paths stack frame setup
-    % code can be inserted between the two blocks.
-    %
-:- pred propagate_framed_labels(queue(label)::in, block_map::in, rev_map::in,
-    set(label)::in, set(label)::out) is det.
+    % Given a queue of labels representing ordinary blocks that must have
+    % a stack frame, propagate the requirement for a stack frame to all
+    % other ordinary blocks that are their successors.
+    %
+    % This predicate implements the second part of the first phase of
+    % delay_frame_transform.
+    %
+:- pred propagate_frame_requirement_to_successors(queue(label)::in,
+    frame_block_map::in, ord_needs_frame::in, ord_needs_frame::out,
+    set(label)::in, int::in, int::out, can_transform::in, can_transform::out)
+    is det.
 
-propagate_framed_labels(!.Queue, BlockMap, RevMap, !FramedLabels) :-
-    ( svqueue__get(Label, !Queue) ->
-        (
+propagate_frame_requirement_to_successors(!.Queue, BlockMap, !OrdNeedsFrame,
+        !.AlreadyProcessed, !PropagationStepsLeft, !CanTransform) :-
+    ( !.CanTransform = cannot_transform ->
+        true
+    ; !.PropagationStepsLeft < 0 ->
+        !:CanTransform = cannot_transform
+    ; svqueue__get(Label, !Queue) ->
+        !:PropagationStepsLeft = !.PropagationStepsLeft - 1,
+        svset__insert(Label, !AlreadyProcessed),
             map__lookup(BlockMap, Label, BlockInfo),
-            BlockInfo = block_info(_, _, SideLabels, MaybeFallThrough,
-                BlockType),
-            BlockType = ordinary(_),
-            \+ set__member(Label, !.FramedLabels)
-        ->
-            svset__insert(Label, !FramedLabels),
+        BlockType = BlockInfo ^ fb_type,
             (
-                MaybeFallThrough = no,
-                ReachableLabels = SideLabels
+            BlockType = ordinary(_),
+            svmap__det_update(Label, yes, !OrdNeedsFrame),
+            % Putting an already processed label into the queue could
+            % lead to an infinite loop. However, we cannot decide whether
+            % a label has been processed by checking whether !.OrdNeedsFrame
+            % maps Label to yes, since !.OrdNeedsFrame doesn't mention setup
+            % frames, and we want to set !:CanTransform to no if any successor
+            % is a setup frame. We cannot assume that successors not in
+            % !.OrdNeedsFrame should set !:CanTransform to no either, since
+            % we don't want to do that for teardown frames.
+            list__filter(set__contains(!.AlreadyProcessed),
+                successors(BlockInfo), _, UnprocessedSuccessors),
+            svqueue__put_list(UnprocessedSuccessors, !Queue)
             ;
-                MaybeFallThrough = yes(FallThrough),
-                ReachableLabels = [FallThrough | SideLabels]
+            BlockType = setup,
+            !:CanTransform = cannot_transform
+        ;
+            BlockType = teardown(_, _, _)
+            % Teardown frames never *need* stack frames.
             ),
-            svqueue__put_list(ReachableLabels, !Queue),
-            ( map__search(RevMap, Label, Sources) ->
-                svqueue__put_list(Sources, !Queue)
+        propagate_frame_requirement_to_successors(!.Queue, BlockMap,
+            !OrdNeedsFrame, !.AlreadyProcessed, !PropagationStepsLeft,
+            !CanTransform)
             ;
                 true
+    ).
+
+    % This predicate implements the third part of the first phase of
+    % delay_frame_transform; see the documentation there.
+    %
+:- pred propagate_frame_requirement_to_predecessors(queue(label)::in,
+    frame_block_map::in, rev_map::in,
+    ord_needs_frame::in, ord_needs_frame::out, int::in, int::out,
+    can_transform::in, can_transform::out) is det.
+
+propagate_frame_requirement_to_predecessors(!.Queue, BlockMap, RevMap,
+        !OrdNeedsFrame, !PropagationStepsLeft, !CanTransform) :-
+    ( !.CanTransform = cannot_transform ->
+        true
+    ; !.PropagationStepsLeft < 0 ->
+        !:CanTransform = cannot_transform
+    ; svqueue__get(Label, !Queue) ->
+        !:PropagationStepsLeft = !.PropagationStepsLeft - 1,
+        ( map__search(RevMap, Label, PredecessorsPrime) ->
+            Predecessors = PredecessorsPrime
+        ;
+            % We get here if Label cannot be reached by a fallthrough or an
+            % explicit jump, but only by backtracking. In that case, the code
+            % that sets up the resumption point saves the address of Label on
+            % the stack, and thus is already known to need a stack frame.
+            Predecessors = [],
+            svmap__det_update(Label, yes, !OrdNeedsFrame)
             ),
-            propagate_framed_labels(!.Queue, BlockMap, RevMap, !FramedLabels)
-        ;
-            propagate_framed_labels(!.Queue, BlockMap, RevMap, !FramedLabels)
-        )
+        list__filter(all_successors_need_frame(BlockMap, !.OrdNeedsFrame),
+            Predecessors, NowNeedFrameLabels),
+        list__foldl2(record_frame_need(BlockMap), NowNeedFrameLabels,
+            !OrdNeedsFrame, !CanTransform),
+        svqueue__put_list(NowNeedFrameLabels, !Queue),
+        propagate_frame_requirement_to_predecessors(!.Queue, BlockMap,
+            RevMap, !OrdNeedsFrame, !PropagationStepsLeft, !CanTransform)
     ;
         true
     ).
 
+:- pred record_frame_need(frame_block_map::in, label::in,
+    ord_needs_frame::in, ord_needs_frame::out,
+    can_transform::in, can_transform::out) is det.
+
+record_frame_need(BlockMap, Label, !OrdNeedsFrame, !CanTransform) :-
+    map__lookup(BlockMap, Label, BlockInfo),
+    BlockType = BlockInfo ^ fb_type,
+    (
+        BlockType = setup,
+        !:CanTransform = cannot_transform
+    ;
+        BlockType = ordinary(_),
+        svmap__det_update(Label, yes, !OrdNeedsFrame)
+    ;
+        BlockType = teardown(_, _, _),
+        unexpected(this_file, "record_frame_need: teardown")
+    ).
+
+:- pred all_successors_need_frame(frame_block_map::in, ord_needs_frame::in,
+    label::in) is semidet.
+
+all_successors_need_frame(BlockMap, OrdNeedsFrame, Label) :-
+    map__lookup(BlockMap, Label, BlockInfo),
+    Successors = successors(BlockInfo),
+    list__filter(label_needs_frame(OrdNeedsFrame), Successors,
+        _NeedFrameSuccessors, NoNeedFrameSuccessors),
+    NoNeedFrameSuccessors = [].
+
+:- pred label_needs_frame(ord_needs_frame::in, label::in) is semidet.
+
+label_needs_frame(OrdNeedsFrame, Label) :-
+    ( map__search(OrdNeedsFrame, Label, NeedsFrame) ->
+        NeedsFrame = yes
+    ;
+        % If the map__search fails, Label is not an ordinary frame.
+        % Setup blocks and teardown blocks don't need frames.
+        fail
+    ).
+
+    % Returns the set of successors of the given block as a list
+    % (which may contain duplicates).
+    %
+:- func successors(frame_block_info) = list(label).
+
+successors(BlockInfo) = Successors :-
+    SideLabels = BlockInfo ^ fb_jump_dests,
+    MaybeFallThrough = BlockInfo ^ fb_fall_dest,
+    (
+        MaybeFallThrough = no,
+        Successors = SideLabels
+    ;
+        MaybeFallThrough = yes(FallThrough),
+        Successors = [FallThrough | SideLabels]
+    ).
+
 %-----------------------------------------------------------------------------%
 
     % The predicates process_frame_delay and transform_ordinary_block
-    % implement the second phase of delay_frame. For documentation,
-    % see the comment at the top of delay_frame.
+    % implement the second phase of delay_frame_transform. For documentation,
+    % see the comment at the top of delay_frame_transform.
     %
-:- pred process_frame_delay(list(label)::in, set(label)::in, int::in,
-    string::in, proc_label::in, counter::in, counter::out,
-    list(label)::out, block_map::in, block_map::out,
-    par_map::in, par_map::out, set(label)::in, set(label)::out) is det.
-
-process_frame_delay([], _, _, _, _, !C, [], !BlockMap, !ParMap,
-        !FallIntoParallel).
-process_frame_delay([Label0 | Labels0], FramedLabels, FrameSize, Msg,
-        ProcLabel, !C, Labels, !BlockMap, !ParMap, !FallIntoParallel) :-
+:- pred process_frame_delay(list(label)::in, ord_needs_frame::in,
+    proc_label::in, counter::in, counter::out,
+    frame_block_map::in, frame_block_map::out,
+    setup_par_map::in, setup_par_map::out,
+    teardown_par_map::in, teardown_par_map::out) is det.
+
+process_frame_delay([], _, _, !C, !BlockMap,
+        !SetupParMap, !TeardownParMap).
+process_frame_delay([Label0 | Labels0], OrdNeedsFrame, ProcLabel, !C,
+        !BlockMap, !SetupParMap, !TeardownParMap) :-
     map__lookup(!.BlockMap, Label0, BlockInfo0),
-    BlockInfo0 = block_info(Label0Copy, Instrs0, SideLabels0,
+    BlockInfo0 = frame_block_info(Label0Copy, Instrs0, FallInto, SideLabels0,
         MaybeFallThrough0, Type),
-    ( Label0 = Label0Copy ->
-        true
-    ;
-        error("label in block_info is not copy")
-    ),
+    require(unify(Label0, Label0Copy),
+        "process_frame_delay: label in frame_block_info is not copy"),
     (
         Type = setup,
         (
-            MaybeFallThrough0 = yes(FallThrough)
+            MaybeFallThrough0 = yes(_FallThrough)
         ;
             MaybeFallThrough0 = no,
-            error("no fallthrough for setup block")
+            unexpected(this_file,
+                "process_frame_delay: no fallthrough for setup block")
         ),
         (
             SideLabels0 = []
         ;
             SideLabels0 = [_ | _],
-            error("nonempty side labels for setup block")
+            unexpected(this_file,
+                "process_frame_delay: nonempty side labels for setup block")
         ),
         (
             Instrs0 = [LabelInstrPrime | _],
@@ -1115,214 +1348,452 @@
         ->
             LabelInstr = LabelInstrPrime
         ;
-            error("setup block does not begin with label")
+            unexpected(this_file,
+                "process_frame_delay: setup block does not begin with label")
         ),
-        ( set__member(FallThrough, FramedLabels) ->
-            % we can't delay the frame setup,
-            % so return everything unchanged
-            Labels = [Label0 | Labels0]
-        ;
-            BlockInfo = block_info(Label0, [LabelInstr],
+        BlockInfo = frame_block_info(Label0, [LabelInstr], FallInto,
                 SideLabels0, MaybeFallThrough0, ordinary(no)),
             svmap__det_update(Label0, BlockInfo, !BlockMap),
-            process_frame_delay(Labels0, FramedLabels, FrameSize, Msg,
-                ProcLabel, !C, Labels1, !BlockMap, !ParMap, !FallIntoParallel),
-            Labels = [Label0 | Labels1]
-        )
+        process_frame_delay(Labels0, OrdNeedsFrame,
+            ProcLabel, !C, !BlockMap, !SetupParMap, !TeardownParMap)
     ;
         Type = ordinary(_),
-        ( set__member(Label0, FramedLabels) ->
-            % Every block reachable from this block, whether via
-            % jump or fallthrough, will be an ordinary block also
-            % in FramedLabels, or will be a teardown block.
-            % We already have a stack frame, and all our
-            % successors expect one, so we need not do anything.
-            process_frame_delay(Labels0, FramedLabels, FrameSize, Msg,
-                ProcLabel, !C, Labels1, !BlockMap, !ParMap, !FallIntoParallel),
-            Labels = [Label0 | Labels1]
-        ;
-            % Every block reachable from this block, whether via
-            % jump or fallthrough, will be an ordinary block also
-            % not in FramedLabels, or will be a teardown block.
-            % The ordinary blocks are OK, since we don't have a
-            % stack frame and they don't expect one exither, but
-            % the teardown blocks are a different matter; we must
-            % make sure that we reach their non-teardown parallels
-            % instead.
-            transform_ordinary_block(Label0, Labels0, BlockInfo0, FramedLabels,
-                FrameSize, Msg, ProcLabel, !C, Labels, !BlockMap, !ParMap,
-                !FallIntoParallel)
+        map__lookup(OrdNeedsFrame, Label0, NeedsFrame),
+        (
+            NeedsFrame = yes,
+            % Every block reachable from this block, whether via jump or
+            % fallthrough, will be an ordinary block also mapped to `yes'
+            % by OrdNeedsFrame, or will be a teardown block. We already have
+            % a stack frame, and all our successors expect one, so we need not
+            % do anything.
+            process_frame_delay(Labels0, OrdNeedsFrame, ProcLabel, !C,
+                !BlockMap, !SetupParMap, !TeardownParMap)
+        ;
+            NeedsFrame = no,
+            transform_nostack_ordinary_block(Label0, Labels0, BlockInfo0,
+                OrdNeedsFrame, ProcLabel, !C, !BlockMap,
+                !SetupParMap, !TeardownParMap)
         )
     ;
         Type = teardown(_, _, _),
-        process_frame_delay(Labels0, FramedLabels, FrameSize, Msg, ProcLabel,
-            !C, Labels1, !BlockMap, !ParMap, !FallIntoParallel),
-        Labels = [Label0 | Labels1]
+        process_frame_delay(Labels0, OrdNeedsFrame, ProcLabel, !C,
+            !BlockMap, !SetupParMap, !TeardownParMap)
     ).
 
-:- pred transform_ordinary_block(label::in, list(label)::in, block_info::in,
-    set(label)::in, int::in, string::in, proc_label::in,
-    counter::in, counter::out, list(label)::out,
-    block_map::in, block_map::out, par_map::in, par_map::out,
-    set(label)::in, set(label)::out) is det.
-
-transform_ordinary_block(Label0, Labels0, BlockInfo0, FramedLabels, FrameSize,
-        Msg, ProcLabel, !C, Labels, !BlockMap, !ParMap, !FallIntoParallel) :-
-    BlockInfo0 = block_info(_, Instrs0, SideLabels0, MaybeFallThrough0, Type),
-    mark_parallels_for_teardown(SideLabels0, SideLabels, AssocLabelMap,
-        !.BlockMap, ProcLabel, !C, !ParMap),
-    pick_last(Instrs0, PrevInstrs, LastInstr0),
-    map__from_assoc_list(AssocLabelMap, LabelMap),
-    opt_util__replace_labels_instruction(LastInstr0, LabelMap, no, LastInstr),
-    list__append(PrevInstrs, [LastInstr], Instrs),
-    (
-        MaybeFallThrough0 = yes(FallThrough),
-        map__lookup(!.BlockMap, FallThrough, FallThroughInfo),
-        FallThroughInfo = block_info(_, _, _, _, FallThroughType),
-        (
-            FallThroughType = setup,
-            error("ordinary block falls through to setup")
-        ;
-            FallThroughType = ordinary(_),
-            ( set__member(FallThrough, FramedLabels) ->
-                % We fall through from a block without a
-                % stack frame to a block which needs a
-                % stack frame, so we must create one.
-
-                counter__allocate(N, !C),
-                NewLabel = internal(N, ProcLabel),
-                MaybeFallThrough = yes(NewLabel),
-                MaybeNewLabel = yes(NewLabel),
-                SetupCode = [
-                    label(NewLabel) - "late setup label",
-                    incr_sp(FrameSize, Msg) - "late setup",
-                    assign(stackvar(FrameSize), lval(succip)) - "late save"
-                ],
-                SetupBlock = block_info(NewLabel, SetupCode, [],
-                    MaybeFallThrough0, setup),
-                svmap__det_insert(NewLabel, SetupBlock, !BlockMap)
-            ;
-                MaybeFallThrough = yes(FallThrough),
-                MaybeNewLabel = no
-            )
-        ;
-            FallThroughType = teardown(_, _, _),
-            MaybeFallThrough = yes(FallThrough),
-            svset__insert(FallThrough, !FallIntoParallel),
-            MaybeNewLabel = no,
-            mark_parallel(FallThrough, _, ProcLabel, !C, !ParMap)
+    % Transform an ordinary block that doesn't have a stack frame.
+    % Every block that is a successor of this block, whether via jump or
+    % fallthrough, will be an ordinary block or a teardown block.
+    %
+    % - If it is an ordinary block that doesn't need a frame, we need not
+    %   do anything.
+    %
+    % - If it is an ordinary block B that does need a stack frame, we need to
+    %   insert the frame setup code at the transfer between the two blocks.
+    %   The label S of the block that contains the setup code and then goes
+    %   to block B will be given by map__lookup(!.SetupParMap, B, S).
+    %   Here, we just allocate the label S; the block will be created later.
+    %
+    % - If it is teardown block B, then we need to jump to a variant of B
+    %   that does no teardown, since there is no stack frame to tear down.
+    %   The label S of the variant block will be given by
+    %   map__lookup(!.TeardownParMap, B, S). Here, we just allocate
+    %   the label S; the block will be created later.
+    %
+:- pred transform_nostack_ordinary_block(label::in, list(label)::in,
+    frame_block_info::in, ord_needs_frame::in,
+    proc_label::in, counter::in, counter::out,
+    frame_block_map::in, frame_block_map::out,
+    setup_par_map::in, setup_par_map::out,
+    teardown_par_map::in, teardown_par_map::out) is det.
+
+transform_nostack_ordinary_block(Label0, Labels0, BlockInfo0, OrdNeedsFrame,
+        ProcLabel, !C, !BlockMap, !SetupParMap, !TeardownParMap) :-
+    BlockInfo0 = frame_block_info(_, Instrs0, FallInto,
+        SideLabels0, MaybeFallThrough0, Type),
+    mark_parallels_for_nostack_successors(SideLabels0, SideLabels,
+        SideAssocLabelMap, OrdNeedsFrame, !.BlockMap, ProcLabel, !C,
+        !SetupParMap, !TeardownParMap),
+    (
+        MaybeFallThrough0 = yes(FallThroughLabel0),
+        mark_parallel_for_nostack_successor(FallThroughLabel0,
+            FallThroughLabel, OrdNeedsFrame, !.BlockMap, ProcLabel, !C,
+            !SetupParMap, !TeardownParMap),
+        MaybeFallThrough = yes(FallThroughLabel),
+        require(no_disagreement(SideAssocLabelMap,
+            FallThroughLabel0, FallThroughLabel),
+            "transform_nostack_ordinary_block: disagreement"),
+        AssocLabelMap = [FallThroughLabel0 - FallThroughLabel
+            | SideAssocLabelMap],
+        ( FallThroughLabel = FallThroughLabel0 ->
+            RedirectFallThrough = []
+        ;
+            RedirectFallThrough = [goto(label(FallThroughLabel))
+                - "redirect fallthrough"]
+            % We can expect this jump to be optimized away in most cases.
         )
     ;
         MaybeFallThrough0 = no,
         MaybeFallThrough = no,
-        MaybeNewLabel = no
+        AssocLabelMap = SideAssocLabelMap,
+        RedirectFallThrough = []
     ),
-    BlockInfo = block_info(Label0, Instrs, SideLabels, MaybeFallThrough, Type),
+    pick_last(Instrs0, PrevInstrs, LastInstr0),
+    map__from_assoc_list(AssocLabelMap, LabelMap),
+    opt_util__replace_labels_instruction(LastInstr0, LabelMap, no, LastInstr),
+    Instrs = PrevInstrs ++ [LastInstr | RedirectFallThrough],
+    BlockInfo = frame_block_info(Label0, Instrs, FallInto,
+        SideLabels, MaybeFallThrough, Type),
     map__set(!.BlockMap, Label0, BlockInfo, !:BlockMap),
-    process_frame_delay(Labels0, FramedLabels, FrameSize, Msg, ProcLabel, !C,
-        Labels1, !BlockMap, !ParMap, !FallIntoParallel),
-    (
-        MaybeNewLabel = yes(NewLabel2),
-        Labels = [Label0, NewLabel2 | Labels1]
-    ;
-        MaybeNewLabel = no,
-        Labels = [Label0 | Labels1]
-    ).
+    process_frame_delay(Labels0, OrdNeedsFrame, ProcLabel, !C, !BlockMap,
+        !SetupParMap, !TeardownParMap).
+
+:- pred no_disagreement(assoc_list(label, label)::in, label::in, label::in)
+    is semidet.
+
+no_disagreement([], _, _).
+no_disagreement([K - V | KVs], Key, Value) :-
+    ( K = Key => V = Value ),
+    no_disagreement(KVs, Key, Value).
 
 %-----------------------------------------------------------------------------%
 
-    % The input is a list of labels that are jumped to from a frame
-    % which has no stack frame. Therefore if some of those labels start
-    % teardown blocks, we ensure that those blocks have non-teardown
-    % parallels, allocating labels for them if they haven't been allocated
-    % already. We return both the updated list of labels and the
-    % substitution (represented as an association list) that will have
-    % to applied to the jumping instruction.
-    %
-:- pred mark_parallels_for_teardown(list(label)::in, list(label)::out,
-    assoc_list(label)::out, block_map::in,
-    proc_label::in, counter::in, counter::out,
-    par_map::in, par_map::out) is det.
+    % Invokes mark_parallel_for_nostack_successor on each input label,
+    % and returns both the updated list of labels and the substitution
+    % (represented as an association list) that will have to applied
+    % to the jumping instruction.
+    %
+:- pred mark_parallels_for_nostack_successors(list(label)::in,
+    list(label)::out, assoc_list(label)::out, ord_needs_frame::in,
+    frame_block_map::in, proc_label::in, counter::in, counter::out,
+    setup_par_map::in, setup_par_map::out,
+    teardown_par_map::in, teardown_par_map::out) is det.
+
+mark_parallels_for_nostack_successors([], [], [], _, _, _, !C,
+        !SetupParMap, !TeardownParMap).
+mark_parallels_for_nostack_successors([Label0 | Labels0], [Label | Labels],
+        [Label0 - Label | LabelMap], OrdNeedsFrame, BlockMap, ProcLabel, !C,
+        !SetupParMap, !TeardownParMap) :-
+    mark_parallel_for_nostack_successor(Label0, Label,
+        OrdNeedsFrame, BlockMap, ProcLabel, !C, !SetupParMap, !TeardownParMap),
+    mark_parallels_for_nostack_successors(Labels0, Labels, LabelMap,
+        OrdNeedsFrame, BlockMap, ProcLabel, !C, !SetupParMap, !TeardownParMap).
+
+    % Label0 is a label that is a successor of a block which has no stack
+    % frame.
+    %
+    % If Label0 starts a teardown block, we ensure that it has a non-teardown
+    % parallel Label.
+    %
+    % If Label0 starts an ordinary block that needs a stack frame, we ensure
+    % that it has a parallel Label that allocates a stack frame before handing
+    % control to Label0.
+    %
+:- pred mark_parallel_for_nostack_successor(label::in, label::out,
+    ord_needs_frame::in, frame_block_map::in, proc_label::in,
+    counter::in, counter::out, setup_par_map::in, setup_par_map::out,
+    teardown_par_map::in, teardown_par_map::out) is det.
 
-mark_parallels_for_teardown([], [], [], _, _, !C, !ParMap).
-mark_parallels_for_teardown([Label0 | Labels0], [Label | Labels],
-        [Label0 - Label | LabelMap], BlockMap, ProcLabel, !C, !ParMap) :-
+mark_parallel_for_nostack_successor(Label0, Label, OrdNeedsFrame, BlockMap,
+        ProcLabel, !C, !SetupParMap, !TeardownParMap) :-
     map__lookup(BlockMap, Label0, BlockInfo),
-    BlockInfo = block_info(_, _, _, _, Type),
+    Type = BlockInfo ^ fb_type,
     (
         Type = setup,
-        error("reached setup via jump from ordinary block")
+        unexpected(this_file, "mark_parallels_for_nostack_jump: " ++
+            "reached setup via jump from ordinary block")
     ;
         Type = ordinary(_),
+        map__lookup(OrdNeedsFrame, Label0, NeedsFrame),
+        (
+            NeedsFrame = yes,
+            ensure_setup_parallel(Label0, Label, ProcLabel, !C, !SetupParMap)
+        ;
+            NeedsFrame = no,
         Label = Label0
+        )
     ;
         Type = teardown(_, _, _),
-        mark_parallel(Label0, Label, ProcLabel, !C, !ParMap)
+        ensure_teardown_parallel(Label0, Label, ProcLabel, !C, !TeardownParMap)
+    ).
+
+%-----------------------------------------------------------------------------%
+
+    % The third phase of the delay_frame_transform optimization, creating
+    %
+    % - the setup code of ordinary blocks that need frames but (some of)
+    %   whose predecessors don't have one, and
+    %
+    % - the parallels of teardown blocks that can assume there is no frame to
+    %   tear down.
+    %
+:- pred create_parallels(list(label)::in, list(label)::out, int::in,
+    string::in, proc_label::in, counter::in, counter::out, ord_needs_frame::in,
+    setup_par_map::in, teardown_par_map::in, pred_map::in,
+    frame_block_map::in, frame_block_map::out) is det.
+
+create_parallels([], [], _, _, _, !C, _, _, _, _, !BlockMap).
+create_parallels([Label0 | Labels0], Labels, FrameSize, Msg, ProcLabel, !C,
+        OrdNeedsFrame, SetupParMap, TeardownParMap, PredMap, !BlockMap) :-
+    create_parallels(Labels0, Labels1, FrameSize, Msg, ProcLabel, !C,
+        OrdNeedsFrame, SetupParMap, TeardownParMap, PredMap, !BlockMap),
+    map__lookup(!.BlockMap, Label0, BlockInfo0),
+    BlockInfo0 = frame_block_info(Label0Copy, _, FallInto,
+        SideLabels, MaybeFallThrough, Type),
+    require(unify(Label0, Label0Copy),
+        "create_parallels: label in frame_block_info is not copy"),
+    ( search_teardown_par_map(TeardownParMap, Label0, ParallelLabel) ->
+        require(unify(MaybeFallThrough, no),
+            "create_parallels: teardown block with parallel has fall through"),
+        (
+            SideLabels = [],
+            Comments = []
+        ;
+            SideLabels = [_ | _],
+            % This can happen if fulljump optimization has redirected the
+            % return.
+            Comments = [comment("teardown side labels "
+                ++ dump_labels(ProcLabel, SideLabels)) - ""]
+        ),
+        PrevNeedsFrame = prev_block_needs_frame(OrdNeedsFrame, BlockInfo0),
+        ( Type = teardown(_, Livevals, Goto) ->
+            LabelInstr = label(ParallelLabel) - "non-teardown parallel",
+            ReplacementCode = [LabelInstr] ++ Comments ++ Livevals ++ [Goto],
+            (
+                PrevNeedsFrame = no,
+                Labels = [ParallelLabel, Label0 | Labels1],
+                BlockInfo = BlockInfo0 ^ fb_fallen_into := no,
+                svmap__det_update(Label0, BlockInfo, !BlockMap),
+                ParallelBlockFallInto = FallInto
+            ;
+                PrevNeedsFrame = yes,
+                Labels = [Label0, ParallelLabel | Labels1],
+                ParallelBlockFallInto = no
+            ),
+            ParallelBlockInfo = frame_block_info(ParallelLabel,
+                ReplacementCode, ParallelBlockFallInto, SideLabels,
+                no, ordinary(no)),
+            svmap__det_insert(ParallelLabel, ParallelBlockInfo, !BlockMap)
+        ;
+            unexpected(this_file,
+                "block in teardown_par_map is not teardown")
+        )
+    ; search_setup_par_map(SetupParMap, Label0, SetupLabel) ->
+        require(is_ordinary(Type),
+            "create_parallels: block in setup map is not ordinary"),
+        PrevNeedsFrame = prev_block_needs_frame(OrdNeedsFrame, BlockInfo0),
+        (
+            PrevNeedsFrame = yes,
+            counter__allocate(N, !C),
+            JumpAroundLabel = internal(N, ProcLabel),
+            % By not including a label instruction at the start of
+            % JumpAroundCode, we are breaking an invariant of frame_block_maps.
+            % However, we don't execute any code during or after
+            % create_parallels that depends on that invariant, and not
+            % including the label saves memory and reduces the amount of work
+            % labelopt has to do. (The label *would* be optimized away, since
+            % it can't be referred to from anywhere.)
+            JumpAroundCode = [goto(label(Label0)) - "jump around setup"],
+            Labels = [JumpAroundLabel, SetupLabel, Label0 | Labels1],
+            JumpAroundBlockInfo = frame_block_info(JumpAroundLabel,
+                JumpAroundCode, no, [Label0], FallInto, ordinary(yes)),
+            svmap__det_insert(JumpAroundLabel, JumpAroundBlockInfo, !BlockMap),
+            SetupFallInto = yes(JumpAroundLabel),
+            BlockInfo = BlockInfo0 ^ fb_fallen_into := yes(SetupLabel),
+            svmap__det_update(Label0, BlockInfo, !BlockMap)
+        ;
+            PrevNeedsFrame = no,
+            Labels = [SetupLabel, Label0 | Labels1],
+            SetupFallInto = no
     ),
-    mark_parallels_for_teardown(Labels0, Labels, LabelMap, BlockMap, ProcLabel,
-        !C, !ParMap).
+        SetupCode = [
+            label(SetupLabel) - "late setup label",
+            incr_sp(FrameSize, Msg) - "late setup",
+            assign(stackvar(FrameSize), lval(succip)) - "late save"
+        ],
+        SetupBlockInfo = frame_block_info(SetupLabel, SetupCode,
+            SetupFallInto, [], yes(Label0), setup),
+        svmap__det_insert(SetupLabel, SetupBlockInfo, !BlockMap)
+    ;
+        Labels = [Label0 | Labels1]
+    ).
+
+:- func prev_block_needs_frame(ord_needs_frame, frame_block_info) = bool.
+
+prev_block_needs_frame(OrdNeedsFrame, BlockInfo) = PrevNeedsFrame :-
+    MaybeFallIntoFrom = BlockInfo ^ fb_fallen_into,
+    (
+        MaybeFallIntoFrom = yes(FallIntoFrom),
+        ( map__search(OrdNeedsFrame, FallIntoFrom, NeedsFrame) ->
+            % FallIntoFrom is an ordinary block that can fall through
+            % to this block.
+            PrevNeedsFrame = NeedsFrame
+        ;
+            % FallIntoFrom is a setup block; teardown blocks cannot fall
+            % through. Setup blocks don't need frames.
+            PrevNeedsFrame = no
+        )
+    ;
+        MaybeFallIntoFrom = no,
+        % The previous block doesn't care whether the following block
+        % has a frame or not.
+        PrevNeedsFrame = no
+    ).
+
+:- pred is_ordinary(block_type::in) is semidet.
+
+is_ordinary(ordinary(_)).
+
+%-----------------------------------------------------------------------------%
+
+    % Given the label of a block, allocate a label for its parallel
+    % in the given setup map if it doesn't already have one.
+    %
+:- pred ensure_setup_parallel(label::in, label::out, proc_label::in,
+    counter::in, counter::out, setup_par_map::in, setup_par_map::out) is det.
+
+ensure_setup_parallel(Label, ParallelLabel, ProcLabel, !C, !SetupParMap) :-
+    !.SetupParMap = setup_par_map(ParMap0),
+    ( map__search(ParMap0, Label, OldParallel) ->
+        ParallelLabel = OldParallel
+    ;
+        counter__allocate(N, !C),
+        NewParallel = internal(N, ProcLabel),
+        ParallelLabel = NewParallel,
+        map__det_insert(ParMap0, Label, NewParallel, ParMap),
+        !:SetupParMap = setup_par_map(ParMap)
+    ).
 
-    % Given the label of a teardown block, allocate a label for its
-    % non-teardown parallel if it doesn't already have one.
+    % Given the label of a block, allocate a label for its parallel
+    % in the given teardown map if it doesn't already have one.
     %
-:- pred mark_parallel(label::in, label::out, proc_label::in,
-    counter::in, counter::out, par_map::in, par_map::out) is det.
+:- pred ensure_teardown_parallel(label::in, label::out, proc_label::in,
+    counter::in, counter::out, teardown_par_map::in, teardown_par_map::out)
+    is det.
 
-mark_parallel(Label0, Label, ProcLabel, !C, !ParMap) :-
-    ( map__search(!.ParMap, Label0, OldParallel) ->
-        Label = OldParallel
+ensure_teardown_parallel(Label, ParallelLabel, ProcLabel, !C,
+        !TeardownParMap) :-
+    !.TeardownParMap = teardown_par_map(ParMap0),
+    ( map__search(ParMap0, Label, OldParallel) ->
+        ParallelLabel = OldParallel
     ;
         counter__allocate(N, !C),
         NewParallel = internal(N, ProcLabel),
-        Label = NewParallel,
-        svmap__det_insert(Label0, NewParallel, !ParMap)
+        ParallelLabel = NewParallel,
+        map__det_insert(ParMap0, Label, NewParallel, ParMap),
+        !:TeardownParMap = teardown_par_map(ParMap)
     ).
 
 %-----------------------------------------------------------------------------%
 
-    % The third phase of the delay_frame optimization, creating
-    % the non-teardown parallel blocks.
+    % This predicate generates a human-readable description of a block
+    % as a comment instruction. This can make it much easier to debug
+    % frameopt.
     %
-:- pred create_parallels(list(label)::in, list(label)::out,
-    par_map::in, set(label)::in, block_map::in, block_map::out) is det.
+:- pred describe_block(frame_block_map::in, ord_needs_frame::in, pred_map::in,
+    proc_label::in, label::in, instruction::out) is det.
 
-create_parallels([], [], _, _, !BlockMap).
-create_parallels([Label0 | Labels0], Labels, ParMap, FallIntoParallel,
-        !BlockMap) :-
-    create_parallels(Labels0, Labels1, ParMap, FallIntoParallel, !BlockMap),
-    ( map__search(ParMap, Label0, ParallelLabel) ->
-        map__lookup(!.BlockMap, Label0, BlockInfo0),
-        BlockInfo0 = block_info(Label0Copy, _, SideLabels, MaybeFallThrough,
-            Type),
-        ( Label0 = Label0Copy ->
-            true
+describe_block(BlockMap, OrdNeedsFrame, PredMap, ProcLabel, Label, Instr) :-
+    map__lookup(BlockMap, Label, BlockInfo),
+    BlockInfo = frame_block_info(BlockLabel, BlockInstrs, FallInto,
+        SideLabels, MaybeFallThrough, Type),
+    require(unify(Label, BlockLabel), "describe_block: label mismatch"),
+    LabelStr = dump_label(ProcLabel, Label),
+    BlockInstrsStr = dump_fullinstrs(ProcLabel, BlockInstrs),
+    Heading = "\nBLOCK " ++ LabelStr ++ "\n\n",
+    ( map__search(PredMap, Label, PredLabel) ->
+        PredStr = "previous label " ++ dump_label(ProcLabel, PredLabel) ++ "\n"
         ;
-            error("label in block_info is not copy")
+        PredStr = "no previous label\n"
         ),
         (
-            MaybeFallThrough = no
+        FallInto = yes(FallIntoFromLabel),
+        FallIntoStr = "fallen into from "
+            ++ dump_label(ProcLabel, FallIntoFromLabel) ++ "\n"
         ;
-            MaybeFallThrough = yes(_),
-            error("block with parallel has fall through")
+        FallInto = no,
+        FallIntoStr = "not fallen into\n"
         ),
-        ( Type = teardown(_, Livevals, Goto) ->
-            LabelInstr = label(ParallelLabel) - "non-teardown parallel",
-            list__append(Livevals, [Goto], Replacement0),
-            Replacement = [LabelInstr | Replacement0],
-            NewBlockInfo = block_info(ParallelLabel, Replacement, SideLabels,
-                no, ordinary(no)),
-            svmap__det_insert(ParallelLabel, NewBlockInfo, !BlockMap),
-            ( set__member(Label0, FallIntoParallel) ->
-                Labels = [ParallelLabel, Label0 | Labels1]
+    (
+        SideLabels = [],
+        SideStr = "no side labels\n"
             ;
-                Labels = [Label0, ParallelLabel | Labels1]
-            )
+        SideLabels = [_ | _],
+        SideStr = "side labels " ++ dump_labels(ProcLabel, SideLabels) ++ "\n"
+    ),
+    (
+        MaybeFallThrough = yes(FallThroughLabel),
+        FallThroughStr = "falls through to "
+            ++ dump_label(ProcLabel, FallThroughLabel) ++ "\n"
         ;
-            error("block with parallel is not teardown")
+        MaybeFallThrough = no,
+        FallThroughStr = "does not fall through\n"
+    ),
+    (
+        Type = setup,
+        require(unify(SideLabels, []),
+            "describe_block: setup, SideLabels=[_ | _]"),
+        require(is_yes(MaybeFallThrough),
+            "describe_block: setup, MaybeFallThrough=no"),
+        TypeStr = "setup\n",
+        OrdNeedsFrameStr = ""
+    ;
+        Type = ordinary(UsesFrame),
+        (
+            UsesFrame = yes,
+            TypeStr = "ordinary; uses frame, "
+        ;
+            UsesFrame = no,
+            TypeStr = "ordinary; does not use frame, "
+        ),
+        map__lookup(OrdNeedsFrame, Label, NeedsFrame),
+        (
+            NeedsFrame = no,
+            require(unify(UsesFrame, no),
+                "describe_block: NeedsFrame=no, UsesFrame=yes"),
+            OrdNeedsFrameStr = "does not need frame\n"
+        ;
+            NeedsFrame = yes,
+            OrdNeedsFrameStr = "does need frame\n"
         )
     ;
-        Labels = [Label0 | Labels1]
-    ).
+        Type = teardown(RestoreSuccip, Livevals, Goto),
+        require(unify(MaybeFallThrough, no),
+            "describe_block: teardown, MaybeFallThrough=yes(_)"),
+        TypeStr = "teardown\n"
+            ++ "restore:  "
+            ++ dump_fullinstrs(ProcLabel, RestoreSuccip)
+            ++ "livevals: "
+            ++ dump_fullinstrs(ProcLabel, Livevals)
+            ++ "goto:     "
+            ++ dump_fullinstr(ProcLabel, Goto),
+        OrdNeedsFrameStr = ""
+    ),
+    Comment = Heading ++ PredStr ++ FallIntoStr ++ SideStr ++ FallThroughStr
+        ++ TypeStr ++ OrdNeedsFrameStr ++ "CODE:\n" ++ BlockInstrsStr,
+    Instr = comment(Comment) - "".
+
+:- pred is_yes(maybe(T)::in) is semidet.
+
+is_yes(yes(_)).
 
 %-----------------------------------------------------------------------------%
+
+:- pred search_setup_par_map(setup_par_map::in, label::in, label::out)
+    is semidet.
+
+search_setup_par_map(setup_par_map(ParMap), Label, ParallelLabel) :-
+    map__search(ParMap, Label, ParallelLabel).
+
+:- pred search_teardown_par_map(teardown_par_map::in, label::in, label::out)
+    is semidet.
+
+search_teardown_par_map(teardown_par_map(ParMap), Label, ParallelLabel) :-
+    map__search(ParMap, Label, ParallelLabel).
+
+%-----------------------------------------------------------------------------%
+
+:- func this_file = string.
+
+this_file = "frameopt.m".
+
 %-----------------------------------------------------------------------------%
Index: compiler/llds_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/llds_out.m,v
retrieving revision 1.250
diff -u -b -r1.250 llds_out.m
--- compiler/llds_out.m	8 Jul 2005 04:22:04 -0000	1.250
+++ compiler/llds_out.m	23 Aug 2005 10:28:25 -0000
@@ -1268,14 +1268,15 @@
 	( Lang = c ->
 		globals__io_lookup_bool_option(auto_comments, PrintComments,
 			!IO),
-		( PrintComments = yes ->
+		(
+			PrintComments = yes,
 			io__write_string("/* ", !IO),
 			prog_out__write_context(Context, !IO),
 			io__write_string(" pragma foreign_decl_code( ", !IO),
 			io__write(Lang, !IO),
 			io__write_string(" */\n", !IO)
 		;
-			true
+			PrintComments = no
 		),
 		output_set_line_num(Context, !IO),
 		io__write_string(Code, !IO),
@@ -1980,7 +1981,7 @@
 		;
 			io__write_string("\t\t/* ", !IO),
 			io__write_string(Comment, !IO),
-			io__write_string(" */\n", !IO)
+			io__write_string("*/\n", !IO)
 		)
 	).
 
@@ -2015,13 +2016,13 @@
 	io::di, io::uo) is det.
 
 output_instruction(comment(Comment), _, !IO) :-
-	io__write_strings(["/* ", Comment, " */\n"], !IO).
+	io__write_strings(["/*", Comment, "*/\n"], !IO).
 
 output_instruction(livevals(LiveVals), _, !IO) :-
-	io__write_string("/*\n * Live lvalues:\n", !IO),
+	io__write_string("/*\n* Live lvalues:\n", !IO),
 	set__to_sorted_list(LiveVals, LiveValsList),
 	output_livevals(LiveValsList, !IO),
-	io__write_string(" */\n", !IO).
+	io__write_string("*/\n", !IO).
 
 output_instruction(block(TempR, TempF, Instrs), ProfInfo, !IO) :-
 	io__write_string("\t{\n", !IO),
@@ -2557,7 +2558,7 @@
 
 output_livevals([], !IO).
 output_livevals([Lval | Lvals], !IO) :-
-	io__write_string(" *\t", !IO),
+	io__write_string("*\t", !IO),
 	output_lval(Lval, !IO),
 	io__write_string("\n", !IO),
 	output_livevals(Lvals, !IO).
@@ -2566,13 +2567,14 @@
 
 output_gc_livevals(LiveVals, !IO) :-
 	globals__io_lookup_bool_option(auto_comments, PrintAutoComments, !IO),
-	( PrintAutoComments = yes ->
+	(
+		PrintAutoComments = yes,
 		io__write_string("/*\n", !IO),
-		io__write_string(" * Garbage collection livevals info\n", !IO),
+		io__write_string("* Garbage collection livevals info\n", !IO),
 		output_gc_livevals_2(LiveVals, !IO),
-		io__write_string(" */\n", !IO)
+		io__write_string("*/\n", !IO)
 	;
-		true
+		PrintAutoComments = no
 	).
 
 :- pred output_gc_livevals_2(list(liveinfo)::in, io::di, io::uo) is det.
@@ -2580,7 +2582,7 @@
 output_gc_livevals_2([], !IO).
 output_gc_livevals_2([LiveInfo | LiveInfos], !IO) :-
 	LiveInfo = live_lvalue(Locn, LiveValueType, TypeParams),
-	io__write_string(" *\t", !IO),
+	io__write_string("*\t", !IO),
 	output_layout_locn(Locn, !IO),
 	io__write_string("\t", !IO),
 	output_live_value_type(LiveValueType, !IO),
Index: compiler/ml_tag_switch.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_tag_switch.m,v
retrieving revision 1.10
diff -u -b -r1.10 ml_tag_switch.m
--- compiler/ml_tag_switch.m	22 Mar 2005 06:40:10 -0000	1.10
+++ compiler/ml_tag_switch.m	23 Aug 2005 08:22:10 -0000
@@ -102,22 +102,18 @@
 	ml_tag_switch__gen_ptag_cases(Cases, Var, CanFail, CodeModel,
 		PtagCountMap, Context, MLDS_Cases, !Info).
 
-:- pred ml_tag_switch__gen_ptag_case(
-	pair(tag_bits, pair(stag_loc, stag_goal_map))::in,
+:- pred ml_tag_switch__gen_ptag_case(pair(tag_bits, ptag_case)::in,
 	prog_var::in, can_fail::in, code_model::in, ptag_count_map::in,
 	prog_context::in, mlds__switch_case::out,
 	ml_gen_info::in, ml_gen_info::out) is det.
 
 ml_tag_switch__gen_ptag_case(Case, Var, CanFail, CodeModel, PtagCountMap,
 		Context, MLDS_Case, !Info) :-
-	Case = PrimaryTag - (SecTagLocn - GoalMap),
+	Case = PrimaryTag - ptag_case(SecTagLocn, GoalMap),
 	map__lookup(PtagCountMap, PrimaryTag, CountInfo),
 	CountInfo = SecTagLocn1 - MaxSecondary,
-	( SecTagLocn = SecTagLocn1 ->
-		true
-	;
-		error("ml_tag_switch.m: secondary tag locations differ")
-	),
+	require(unify(SecTagLocn, SecTagLocn1),
+		"ml_tag_switch.m: secondary tag locations differ"),
 	map__to_assoc_list(GoalMap, GoalList),
 	( SecTagLocn = none ->
 		% There is no secondary tag, so there is no switch on it
@@ -125,7 +121,7 @@
 			GoalList = [],
 			error("no goal for non-shared tag")
 		;
-			GoalList = [_ - Goal],
+			GoalList = [_Stag - stag_goal(_ConsId, Goal)],
 			ml_gen_goal(CodeModel, Goal, Statement, !Info)
 		;
 			GoalList = [_, _ | _],
@@ -145,7 +141,10 @@
 		;
 			CaseCanFail = can_fail
 		),
-		( GoalList = [_ - Goal], CaseCanFail = cannot_fail ->
+		(
+			GoalList = [_Stag - stag_goal(_ConsId, Goal)],
+			CaseCanFail = cannot_fail
+		->
 			% There is only one possible matching goal,
 			% so we don't need to switch on it
 			ml_gen_goal(CodeModel, Goal, Statement, !Info)
@@ -207,12 +206,12 @@
 	ml_tag_switch__gen_stag_case(Case, CodeModel, MLDS_Case, !Info),
 	ml_tag_switch__gen_stag_cases(Cases, CodeModel, MLDS_Cases, !Info).
 
-:- pred ml_tag_switch__gen_stag_case(pair(tag_bits, hlds_goal)::in,
+:- pred ml_tag_switch__gen_stag_case(pair(tag_bits, stag_goal)::in,
 	code_model::in, mlds__switch_case::out,
 	ml_gen_info::in, ml_gen_info::out) is det.
 
 ml_tag_switch__gen_stag_case(Case, CodeModel, MLDS_Case, !Info) :-
-	Case = Stag - Goal,
+	Case = Stag - stag_goal(_ConsId, Goal),
 	StagRval = const(int_const(Stag)),
 	ml_gen_goal(CodeModel, Goal, Statement, !Info),
 	MLDS_Case = [match_value(StagRval)] - Statement.
Index: compiler/opt_debug.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/opt_debug.m,v
retrieving revision 1.151
diff -u -b -r1.151 opt_debug.m
--- compiler/opt_debug.m	8 Jul 2005 04:22:05 -0000	1.151
+++ compiler/opt_debug.m	23 Aug 2005 06:50:09 -0000
@@ -1,4 +1,6 @@
 %-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
 % Copyright (C) 1994-2005 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.
@@ -30,74 +32,82 @@
 
 :- pred msg(bool::in, int::in, string::in, io::di, io::uo) is det.
 
-:- pred dump_instrs(bool::in, list(instruction)::in, io::di, io::uo) is det.
+:- pred maybe_dump_instrs(bool::in, list(instruction)::in, io::di, io::uo)
+    is det.
+
+:- func dump_intlist(list(int)) = string.
+
+:- func dump_livemap(livemap) = string.
+
+:- func dump_livemaplist(assoc_list(label, lvalset)) = string.
+
+:- func dump_livevals(lvalset) = string.
 
-:- pred dump_intlist(list(int)::in, string::out) is det.
+:- func dump_livelist(list(lval)) = string.
 
-:- pred dump_livemap(livemap::in, string::out) is det.
+:- func dump_reg(reg_type, int) = string.
 
-:- pred dump_livemaplist(assoc_list(label, lvalset)::in, string::out) is det.
+:- func dump_lval(lval) = string.
 
-:- pred dump_livevals(lvalset::in, string::out) is det.
+:- func dump_rval(rval) = string.
 
-:- pred dump_livelist(list(lval)::in, string::out) is det.
+:- func dump_rvals(list(rval)) = string.
 
-:- pred dump_reg(reg_type::in, int::in, string::out) is det.
+:- func dump_mem_ref(mem_ref) = string.
 
-:- pred dump_lval(lval::in, string::out) is det.
+:- func dump_const(rval_const) = string.
 
-:- pred dump_rval(rval::in, string::out) is det.
+:- func dump_data_addr(data_addr) = string.
 
-:- pred dump_rvals(list(rval)::in, string::out) is det.
+:- func dump_data_name(data_name) = string.
 
-:- pred dump_mem_ref(mem_ref::in, string::out) is det.
+:- func dump_rtti_type_ctor(rtti_type_ctor) = string.
 
-:- pred dump_const(rval_const::in, string::out) is det.
+:- func dump_rtti_type_class_name(tc_name) = string.
 
-:- pred dump_data_addr(data_addr::in, string::out) is det.
+:- func dump_rtti_type_class_instance_types(list(tc_type)) = string.
 
-:- pred dump_data_name(data_name::in, string::out) is det.
+:- func dump_rtti_name(ctor_rtti_name) = string.
 
-:- pred dump_rtti_type_ctor(rtti_type_ctor::in, string::out) is det.
+:- func dump_tc_rtti_name(tc_rtti_name) = string.
 
-:- pred dump_rtti_type_class_name(tc_name::in, string::out) is det.
+:- func dump_layout_name(layout_name) = string.
 
-:- pred dump_rtti_type_class_instance_types(list(tc_type)::in,
-	string::out) is det.
+:- func dump_unop(unary_op) = string.
 
-:- pred dump_rtti_name(ctor_rtti_name::in, string::out) is det.
+:- func dump_binop(binary_op) = string.
 
-:- pred dump_tc_rtti_name(tc_rtti_name::in, string::out) is det.
+:- func dump_label(label) = string.
 
-:- pred dump_layout_name(layout_name::in, string::out) is det.
+:- func dump_label(proc_label, label) = string.
 
-:- pred dump_unop(unary_op::in, string::out) is det.
+:- func dump_labels(list(label)) = string.
 
-:- pred dump_binop(binary_op::in, string::out) is det.
+:- func dump_labels(proc_label, list(label)) = string.
 
-:- pred dump_label(label::in, string::out) is det.
+:- func dump_label_pairs(list(pair(label))) = string.
 
-:- pred dump_labels(list(label)::in, string::out) is det.
+:- func dump_proclabel(proc_label) = string.
 
-:- pred dump_label_pairs(list(pair(label))::in, string::out) is det.
+:- func dump_maybe_rvals(list(maybe(rval)), int) = string.
 
-:- pred dump_proclabel(proc_label::in, string::out) is det.
+:- func dump_code_addr(code_addr) = string.
 
-:- pred dump_maybe_rvals(list(maybe(rval))::in, int::in, string::out) is det.
+:- func dump_code_addr(proc_label, code_addr) = string.
 
-:- pred dump_code_addr(code_addr::in, string::out) is det.
+:- func dump_code_addrs(list(code_addr)) = string.
 
-:- pred dump_code_addrs(list(code_addr)::in, string::out) is det.
+:- func dump_code_addrs(proc_label, list(code_addr)) = string.
 
-:- pred dump_bool(bool::in, string::out) is det.
+:- func dump_bool(bool) = string.
 
-:- pred dump_instr(instr::in, string::out) is det.
+:- func dump_instr(proc_label, instr) = string.
 
-:- pred dump_fullinstr(instruction::in, string::out) is det.
+:- func dump_fullinstr(proc_label, instruction) = string.
 
-:- pred dump_fullinstrs(list(instruction)::in, string::out) is det.
+:- func dump_fullinstrs(proc_label, list(instruction)) = string.
 
-:- pred dump_code_model(code_model::in, string::out) is det.
+:- func dump_code_model(code_model) = string.
 
 %-----------------------------------------------------------------------------%
 
@@ -137,7 +147,7 @@
 		OptDebug = no
 	).
 
-dump_instrs(OptDebug, Instrs, !IO) :-
+maybe_dump_instrs(OptDebug, Instrs, !IO) :-
 	(
 		OptDebug = yes,
 		globals__io_lookup_bool_option(auto_comments, PrintComments,
@@ -155,337 +165,225 @@
 	output_instruction_and_comment(Uinstr, Comment, PrintComments, !IO),
 	dump_instrs_2(Instrs, PrintComments, !IO).
 
-dump_intlist([], "").
-dump_intlist([H | T], Str) :-
-	string__int_to_string(H, H_str),
-	dump_intlist(T, T_str),
-	string__append_list([" ", H_str, T_str], Str).
-
-dump_livemap(Livemap, Str) :-
-	map__to_assoc_list(Livemap, Livemaplist),
-	dump_livemaplist(Livemaplist, Str).
-
-dump_livemaplist([], "").
-dump_livemaplist([Label - Lvalset | Livemaplist], Str) :-
-	dump_label(Label, L_str),
-	dump_livevals(Lvalset, S_str),
-	dump_livemaplist(Livemaplist, Str2),
-	string__append_list([L_str, " ->", S_str, "\n", Str2], Str).
-
-dump_livevals(Lvalset, Str) :-
-	set__to_sorted_list(Lvalset, Lvallist),
-	dump_livelist(Lvallist, Str).
-
-dump_livelist([], "").
-dump_livelist([Lval | Lvallist], Str) :-
-	dump_lval(Lval, L_str),
-	dump_livelist(Lvallist, L2_str),
-	string__append_list([" ", L_str, L2_str], Str).
-
-dump_reg(r, N, Str) :-
-	string__int_to_string(N, N_str),
-	string__append_list(["r(", N_str, ")"], Str).
-dump_reg(f, N, Str) :-
-	string__int_to_string(N, N_str),
-	string__append_list(["f(", N_str, ")"], Str).
-
-dump_lval(reg(Type, Num), Str) :-
-	dump_reg(Type, Num, R_str),
-	string__append_list(["reg(", R_str, ")"], Str).
-dump_lval(stackvar(N), Str) :-
-	string__int_to_string(N, N_str),
-	string__append_list(["stackvar(", N_str, ")"], Str).
-dump_lval(framevar(N), Str) :-
-	string__int_to_string(N, N_str),
-	string__append_list(["framevar(", N_str, ")"], Str).
-dump_lval(succip, Str) :-
-	string__append_list(["succip"], Str).
-dump_lval(maxfr, Str) :-
-	string__append_list(["maxfr"], Str).
-dump_lval(curfr, Str) :-
-	string__append_list(["curfr"], Str).
-dump_lval(succfr(R), Str) :-
-	dump_rval(R, R_str),
-	string__append_list(["succfr(", R_str, ")"], Str).
-dump_lval(prevfr(R), Str) :-
-	dump_rval(R, R_str),
-	string__append_list(["prevfr(", R_str, ")"], Str).
-dump_lval(redofr(R), Str) :-
-	dump_rval(R, R_str),
-	string__append_list(["redofr(", R_str, ")"], Str).
-dump_lval(redoip(R), Str) :-
-	dump_rval(R, R_str),
-	string__append_list(["redoip(", R_str, ")"], Str).
-dump_lval(succip(R), Str) :-
-	dump_rval(R, R_str),
-	string__append_list(["succip(", R_str, ")"], Str).
-dump_lval(hp, Str) :-
-	string__append_list(["hp"], Str).
-dump_lval(sp, Str) :-
-	string__append_list(["sp"], Str).
-dump_lval(field(MT, N, F), Str) :-
-	( MT = yes(T) ->
+dump_intlist([]) = "".
+dump_intlist([H | T]) =
+    " " ++ int_to_string(H) ++ dump_intlist(T).
+
+dump_livemap(Livemap) =
+    dump_livemaplist(map__to_assoc_list(Livemap)).
+
+dump_livemaplist([]) = "".
+dump_livemaplist([Label - Lvalset | Livemaplist]) =
+    dump_label(Label) ++ " ->" ++ dump_livevals(Lvalset) ++ "\n"
+        ++ dump_livemaplist(Livemaplist).
+
+dump_livevals(Lvalset) =
+    dump_livelist(set__to_sorted_list(Lvalset)).
+
+dump_livelist([]) = "".
+dump_livelist([Lval | Lvallist]) =
+    " " ++ dump_lval(Lval) ++ dump_livelist(Lvallist).
+
+dump_reg(r, N) =
+    "r(" ++ int_to_string(N) ++ ")".
+dump_reg(f, N) =
+    "f(" ++ int_to_string(N) ++ ")".
+
+dump_lval(reg(Type, Num)) =
+    "reg(" ++ dump_reg(Type, Num) ++ ")".
+dump_lval(stackvar(N)) =
+    "stackvar(" ++ int_to_string(N) ++ ")".
+dump_lval(framevar(N)) =
+    "framevar(" ++ int_to_string(N) ++ ")".
+dump_lval(succip) = "succip".
+dump_lval(maxfr) = "maxfr".
+dump_lval(curfr) = "curfr".
+dump_lval(succfr(R)) =
+    "succfr(" ++ dump_rval(R) ++ ")".
+dump_lval(prevfr(R)) =
+    "prevfr(" ++ dump_rval(R) ++ ")".
+dump_lval(redofr(R)) =
+    "redofr(" ++ dump_rval(R) ++ ")".
+dump_lval(redoip(R)) =
+    "redoip(" ++ dump_rval(R) ++ ")".
+dump_lval(succip(R)) =
+    "succip(" ++ dump_rval(R) ++ ")".
+dump_lval(hp) = "hp".
+dump_lval(sp) = "sp".
+dump_lval(field(MT, N, F)) = Str :-
+    (
+        MT = yes(T),
 		string__int_to_string(T, T_str)
 	;
+        MT = no,
 		T_str = "no"
 	),
-	dump_rval(N, N_str),
-	dump_rval(F, F_str),
-	string__append_list(["field(", T_str, ", ", N_str, ", ",
-		F_str, ")"], Str).
-dump_lval(lvar(_), Str) :-
-	string__append_list(["lvar(_)"], Str).
-dump_lval(temp(Type, Num), Str) :-
-	dump_reg(Type, Num, R_str),
-	string__append_list(["temp(", R_str, ")"], Str).
-dump_lval(mem_ref(R), Str) :-
-	dump_rval(R, R_str),
-	string__append_list(["mem_ref(", R_str, ")"], Str).
-
-dump_rval(lval(Lval), Str) :-
-	dump_lval(Lval, Lval_str),
-	string__append_list(["lval(", Lval_str, ")"], Str).
-dump_rval(var(_), Str) :-
-	string__append_list(["var(_)"], Str).
-dump_rval(mkword(T, N), Str) :-
-	string__int_to_string(T, T_str),
-	dump_rval(N, N_str),
-	string__append_list(["mkword(", T_str, ", ", N_str, ")"], Str).
-dump_rval(const(C), Str) :-
-	dump_const(C, C_str),
-	string__append_list(["const(", C_str, ")"], Str).
-dump_rval(unop(O, N), Str) :-
-	dump_unop(O, O_str),
-	dump_rval(N, N_str),
-	string__append_list(["unop(", O_str, ", ", N_str, ")"], Str).
-dump_rval(binop(O, N1, N2), Str) :-
-	dump_binop(O, O_str),
-	dump_rval(N1, N1_str),
-	dump_rval(N2, N2_str),
-	string__append_list(["binop(", O_str, ", ", N1_str, ", ",
-		N2_str, ")"], Str).
-dump_rval(mem_addr(M), Str) :-
-	dump_mem_ref(M, M_str),
-	string__append_list(["mem_addr(", M_str, ")"], Str).
-
-dump_rvals([], "").
-dump_rvals([Rval | Rvals], Str) :-
-	dump_rval(Rval, R_str),
-	dump_rvals(Rvals, S_str),
-	string__append_list([R_str, ", ", S_str], Str).
-
-dump_mem_ref(stackvar_ref(N), Str) :-
-	string__int_to_string(N, N_str),
-	string__append_list(["stackvar_ref(", N_str, ")"], Str).
-dump_mem_ref(framevar_ref(N), Str) :-
-	string__int_to_string(N, N_str),
-	string__append_list(["framevar_ref(", N_str, ")"], Str).
-dump_mem_ref(heap_ref(R, T, N), Str) :-
-	dump_rval(R, R_str),
-	string__int_to_string(T, T_str),
-	string__int_to_string(N, N_str),
-	string__append_list(["heap_ref(", R_str, ", ", T_str, ", ",
-		N_str, ")"], Str).
-
-dump_const(true, "true").
-dump_const(false, "false").
-dump_const(int_const(I), Str) :-
-	string__int_to_string(I, Str).
-dump_const(float_const(F), Str) :-
-	string__float_to_string(F, Str).
-dump_const(string_const(S), Str) :-
-	string__append_list(["""", S, """"], Str).
-dump_const(multi_string_const(L, _S), Str) :-
-	string__int_to_string(L, L_str),
-	string__append_list(["multi_string(", L_str, ")"], Str).
-dump_const(code_addr_const(CodeAddr), Str) :-
-	dump_code_addr(CodeAddr, C_str),
-	string__append_list(["code_addr_const(", C_str, ")"], Str).
-dump_const(data_addr_const(DataAddr, MaybeOffset), Str) :-
-	dump_data_addr(DataAddr, DataAddr_str),
+    Str = "field(" ++ T_str ++ ", " ++ dump_rval(N) ++ ", "
+        ++ dump_rval(F) ++ ")".
+dump_lval(lvar(_)) = "lvar(_)".
+dump_lval(temp(Type, Num)) =
+    "temp(" ++ dump_reg(Type, Num) ++ ")".
+dump_lval(mem_ref(R)) =
+    "mem_ref(" ++ dump_rval(R) ++ ")".
+
+dump_rval(lval(Lval)) =
+    "lval(" ++ dump_lval(Lval) ++ ")".
+dump_rval(var(_)) =
+    "var(_)".
+dump_rval(mkword(T, N)) =
+    "mkword(" ++ int_to_string(T) ++ ", " ++ dump_rval(N) ++ ")".
+dump_rval(const(C)) =
+    "const(" ++ dump_const(C) ++ ")".
+dump_rval(unop(O, N)) =
+    "unop(" ++ dump_unop(O) ++ ", " ++ dump_rval(N) ++ ")".
+dump_rval(binop(O, N1, N2)) =
+    "binop(" ++ dump_binop(O) ++ ", "
+        ++ dump_rval(N1) ++ ", " ++ dump_rval(N2) ++ ")".
+dump_rval(mem_addr(M)) =
+    "mem_addr(" ++ dump_mem_ref(M) ++ ")".
+
+dump_rvals([]) = "".
+dump_rvals([Rval | Rvals]) =
+    dump_rval(Rval) ++ ", " ++ dump_rvals(Rvals).
+
+dump_mem_ref(stackvar_ref(N)) =
+    "stackvar_ref(" ++ int_to_string(N) ++ ")".
+dump_mem_ref(framevar_ref(N)) =
+    "framevar_ref(" ++ int_to_string(N) ++ ")".
+dump_mem_ref(heap_ref(R, T, N)) =
+    "heap_ref(" ++ dump_rval(R) ++ ", " ++ int_to_string(T) ++ ", "
+        ++ int_to_string(N) ++ ")".
+
+dump_const(true) = "true".
+dump_const(false) = "false".
+dump_const(int_const(I)) =
+    int_to_string(I).
+dump_const(float_const(F)) =
+    float_to_string(F).
+dump_const(string_const(S)) =
+    """" ++ S ++ """".
+dump_const(multi_string_const(L, _S)) =
+    "multi_string(" ++ int_to_string(L) ++ ")".
+dump_const(code_addr_const(CodeAddr)) =
+    "code_addr_const(" ++ dump_code_addr(CodeAddr) ++ ")".
+dump_const(data_addr_const(DataAddr, MaybeOffset)) = Str :-
+    DataAddr_str = dump_data_addr(DataAddr),
 	(
 		MaybeOffset = no,
-		string__append_list(
-			["data_addr_const(", DataAddr_str, ")"], Str)
+        Str = "data_addr_const(" ++ DataAddr_str ++ ")"
 	;
 		MaybeOffset = yes(Offset),
-		string__int_to_string(Offset, Offset_str),
-		string__append_list(
-			["data_addr_const(", DataAddr_str, ", ",
-			Offset_str, ")"], Str)
+        Str = "data_addr_const(" ++ DataAddr_str ++ ", "
+            ++ int_to_string(Offset) ++ ")"
 	).
 
-dump_data_addr(data_addr(ModuleName, DataName), Str) :-
-	mdbcomp__prim_data__sym_name_to_string(ModuleName, ModuleName_str),
-	dump_data_name(DataName, DataName_str),
-	string__append_list(
-		["data_addr(", ModuleName_str, ", ", DataName_str, ")"], Str).
-dump_data_addr(rtti_addr(ctor_rtti_id(RttiTypeCtor, DataName)),
-		Str) :-
-	dump_rtti_type_ctor(RttiTypeCtor, RttiTypeCtor_str),
-	dump_rtti_name(DataName, DataName_str),
-	string__append_list(
-		["rtti_addr(", RttiTypeCtor_str, ", ", DataName_str, ")"],
-		Str).
-dump_data_addr(rtti_addr(tc_rtti_id(TCName, TCDataName)), Str) :-
-	dump_rtti_type_class_name(TCName, TCNameStr),
-	dump_tc_rtti_name(TCDataName, TCDataName_str),
-	string__append_list(
-		["tc_rtti_addr(", TCNameStr, ", ", TCDataName_str, ")"],
-		Str).
-dump_data_addr(rtti_addr(aditi_rtti_id(ProcLabel)), Str) :-
-	string__append_list(
-		["aditi_rtti_addr(",
-			sym_name_to_string(qualified(ProcLabel ^ proc_module,
-				ProcLabel ^ proc_name)),
-			")"],
-		Str).
-dump_data_addr(layout_addr(LayoutName), Str) :-
-	dump_layout_name(LayoutName, LayoutName_str),
-	string__append_list(["layout_addr(", LayoutName_str, ")"], Str).
-
-dump_data_name(common(CellNum, TypeNum), Str) :-
-	string__int_to_string(CellNum, C_str),
-	string__int_to_string(TypeNum, T_str),
-	string__append_list(["common(", C_str, ", ", T_str, ")"], Str).
-dump_data_name(tabling_pointer(ProcLabel), Str) :-
-	dump_proclabel(ProcLabel, ProcLabelStr),
-	string__append_list(["tabling_pointer(", ProcLabelStr, ")"], Str).
-
-dump_rtti_type_ctor(rtti_type_ctor(ModuleName, TypeName, Arity),
-		Str) :-
-	ModuleName_str = sym_name_mangle(ModuleName),
-	TypeName_str = name_mangle(TypeName),
-	string__int_to_string(Arity, Arity_str),
-	string__append_list(["rtti_type_ctor(", ModuleName_str, ", ",
-		TypeName_str, Arity_str, ")"], Str).
-
-dump_rtti_name(exist_locns(Ordinal), Str) :-
-	string__int_to_string(Ordinal, Ordinal_str),
-	string__append("exist_locns_", Ordinal_str, Str).
-dump_rtti_name(exist_locn, Str) :-
-	Str = "exist_loc".
-dump_rtti_name(exist_tc_constr(Ordinal, TCCNum, Arity), Str) :-
-	string__int_to_string(Ordinal, Ordinal_str),
-	string__int_to_string(TCCNum, TCCNum_str),
-	string__int_to_string(Arity, Arity_str),
-	string__append_list(["exist_tc_constr_", Ordinal_str, "_", TCCNum_str,
-		"_", Arity_str], Str).
-dump_rtti_name(exist_tc_constrs(Ordinal), Str) :-
-	string__int_to_string(Ordinal, Ordinal_str),
-	string__append("exist_tc_constrs_", Ordinal_str, Str).
-dump_rtti_name(exist_info(Ordinal), Str) :-
-	string__int_to_string(Ordinal, Ordinal_str),
-	string__append("exist_info_", Ordinal_str, Str).
-dump_rtti_name(field_names(Ordinal), Str) :-
-	string__int_to_string(Ordinal, Ordinal_str),
-	string__append("field_names_", Ordinal_str, Str).
-dump_rtti_name(field_types(Ordinal), Str) :-
-	string__int_to_string(Ordinal, Ordinal_str),
-	string__append("field_types_", Ordinal_str, Str).
-dump_rtti_name(res_addrs, Str) :-
-	Str = "res_addrs".
-dump_rtti_name(res_addr_functors, Str) :-
-	Str = "res_addr_functors".
-dump_rtti_name(enum_functor_desc(Ordinal), Str) :-
-	string__int_to_string(Ordinal, Ordinal_str),
-	string__append("enum_functor_desc_", Ordinal_str, Str).
-dump_rtti_name(notag_functor_desc, Str) :-
-	Str = "notag_functor_desc_".
-dump_rtti_name(du_functor_desc(Ordinal), Str) :-
-	string__int_to_string(Ordinal, Ordinal_str),
-	string__append("du_functor_desc_", Ordinal_str, Str).
-dump_rtti_name(res_functor_desc(Ordinal), Str) :-
-	string__int_to_string(Ordinal, Ordinal_str),
-	string__append("res_functor_desc_", Ordinal_str, Str).
-dump_rtti_name(enum_name_ordered_table, Str) :-
-	Str = "enum_name_ordered_table".
-dump_rtti_name(enum_value_ordered_table, Str) :-
-	Str = "enum_value_ordered_table".
-dump_rtti_name(du_name_ordered_table, Str) :-
-	Str = "du_name_ordered_table".
-dump_rtti_name(du_stag_ordered_table(Ptag), Str) :-
-	string__int_to_string(Ptag, Ptag_str),
-	string__append("du_stag_ordered_table_", Ptag_str, Str).
-dump_rtti_name(du_ptag_ordered_table, Str) :-
-	Str = "du_ptag_ordered_table".
-dump_rtti_name(du_ptag_layout(Ptag), Str) :-
-	string__int_to_string(Ptag, Ptag_str),
-	string__append("du_ptag_layout", Ptag_str, Str).
-dump_rtti_name(res_value_ordered_table, Str) :-
-	Str = "res_value_ordered_table".
-dump_rtti_name(res_name_ordered_table, Str) :-
-	Str = "res_name_ordered_table".
-dump_rtti_name(maybe_res_addr_functor_desc, Str) :-
-	Str = "maybe_res_addr_functor_desc".
-dump_rtti_name(type_layout, Str) :-
-	Str = "type_layout".
-dump_rtti_name(type_functors, Str) :-
-	Str = "type_functors".
-dump_rtti_name(type_ctor_info, Str) :-
-	Str = "type_ctor_info".
-dump_rtti_name(type_info(_TypeInfo), Str) :-
-	% XXX should give more info than this
-	Str = "type_info".
-dump_rtti_name(pseudo_type_info(_PseudoTypeInfo), Str) :-
-	% XXX should give more info than this
-	Str = "pseudo_type_info".
-dump_rtti_name(type_hashcons_pointer, Str) :-
-	Str = "type_hashcons_pointer".
-
-dump_tc_rtti_name(base_typeclass_info(_ModuleName, InstanceStr),
-		Str) :-
-	string__append_list(["base_typeclass_info(", InstanceStr, ")"], Str).
-dump_tc_rtti_name(type_class_id, "type_class_id").
-dump_tc_rtti_name(type_class_decl, "type_class_decl").
-dump_tc_rtti_name(type_class_decl_super(Ordinal, _), Str) :-
-	string__int_to_string(Ordinal, OrdinalStr),
-	string__append_list(["type_class_decl_super(", OrdinalStr, ")"], Str).
-dump_tc_rtti_name(type_class_decl_supers, "type_class_decl_supers").
-dump_tc_rtti_name(type_class_id_method_ids,
-		"type_class_id_method_ids").
-dump_tc_rtti_name(type_class_id_var_names,
-		"type_class_id_var_names").
-dump_tc_rtti_name(type_class_instance(TCTypes), Str) :-
-	dump_rtti_type_class_instance_types(TCTypes, InstanceStr),
-	string__append_list(["type_class_instance(", InstanceStr, ")"], Str).
-dump_tc_rtti_name(type_class_instance_tc_type_vector(TCTypes),
-		Str) :-
-	dump_rtti_type_class_instance_types(TCTypes, InstanceStr),
-	string__append_list(["type_class_instance_tc_types_vector(",
-		InstanceStr, ")"], Str).
-dump_tc_rtti_name(type_class_instance_constraints(TCTypes), Str) :-
-	dump_rtti_type_class_instance_types(TCTypes, InstanceStr),
-	string__append_list(["type_class_instance_constraints(",
-		InstanceStr, ")"], Str).
-dump_tc_rtti_name(type_class_instance_constraint(TCTypes,
-		Ordinal, _), Str) :-
-	dump_rtti_type_class_instance_types(TCTypes, InstanceStr),
-	string__int_to_string(Ordinal, OrdinalStr),
-	string__append_list(["type_class_instance_constraint(",
-		InstanceStr, ", ", OrdinalStr, ")"], Str).
-dump_tc_rtti_name(type_class_instance_methods(TCTypes), Str) :-
-	dump_rtti_type_class_instance_types(TCTypes, InstanceStr),
-	string__append_list(["type_class_instance_methods(",
-		InstanceStr, ")"], Str).
-
-dump_rtti_type_class_name(tc_name(ModuleName, ClassName, Arity),
-		Str) :-
-	ModuleNameStr = sym_name_mangle(ModuleName),
-	ClassNameStr = name_mangle(ClassName),
-	string__int_to_string(Arity, ArityStr),
-	string__append_list(["tc_name(", ModuleNameStr, ", ",
-		ClassNameStr, ArityStr, ")"], Str).
+dump_data_addr(data_addr(ModuleName, DataName)) =
+    "data_addr(" ++ mdbcomp__prim_data__sym_name_to_string(ModuleName) ++ ", "
+        ++ dump_data_name(DataName) ++ ")".
+dump_data_addr(rtti_addr(ctor_rtti_id(RttiTypeCtor, DataName))) =
+    "rtti_addr(" ++ dump_rtti_type_ctor(RttiTypeCtor) ++ ", "
+        ++ dump_rtti_name(DataName) ++ ")".
+dump_data_addr(rtti_addr(tc_rtti_id(TCName, TCDataName))) =
+    "tc_rtti_addr(" ++ dump_rtti_type_class_name(TCName) ++ ", "
+        ++ dump_tc_rtti_name(TCDataName) ++ ")".
+dump_data_addr(rtti_addr(aditi_rtti_id(ProcLabel))) =
+    "aditi_rtti_addr("
+        ++ sym_name_to_string(
+            qualified(ProcLabel ^ proc_module, ProcLabel ^ proc_name))
+        ++ ")".
+dump_data_addr(layout_addr(LayoutName)) =
+    "layout_addr(" ++ dump_layout_name(LayoutName) ++ ")".
+
+dump_data_name(common(CellNum, TypeNum)) =
+    "common(" ++ int_to_string(CellNum) ++ ", "
+        ++ int_to_string(TypeNum) ++ ")".
+dump_data_name(tabling_pointer(ProcLabel)) =
+    "tabling_pointer(" ++ dump_proclabel(ProcLabel) ++ ")".
+
+dump_rtti_type_ctor(rtti_type_ctor(ModuleName, TypeName, Arity)) =
+    "rtti_type_ctor(" ++ sym_name_mangle(ModuleName) ++ ", "
+        ++ name_mangle(TypeName) ++ int_to_string(Arity) ++ ")".
+
+dump_rtti_name(exist_locns(Ordinal)) =
+    "exist_locns_" ++ int_to_string(Ordinal).
+dump_rtti_name(exist_locn) = "exist_loc".
+dump_rtti_name(exist_tc_constr(Ordinal, TCCNum, Arity)) =
+    "exist_tc_constr_" ++ int_to_string(Ordinal) ++ "_"
+        ++ int_to_string(TCCNum) ++ "_" ++ int_to_string(Arity).
+dump_rtti_name(exist_tc_constrs(Ordinal)) =
+    "exist_tc_constrs_" ++ int_to_string(Ordinal).
+dump_rtti_name(exist_info(Ordinal)) =
+    "exist_info_" ++ int_to_string(Ordinal).
+dump_rtti_name(field_names(Ordinal)) =
+    "field_names_" ++ int_to_string(Ordinal).
+dump_rtti_name(field_types(Ordinal)) =
+    "field_types_" ++ int_to_string(Ordinal).
+dump_rtti_name(res_addrs) = "res_addrs".
+dump_rtti_name(res_addr_functors) = "res_addr_functors".
+dump_rtti_name(enum_functor_desc(Ordinal)) =
+    "enum_functor_desc_" ++ int_to_string(Ordinal).
+dump_rtti_name(notag_functor_desc) = "notag_functor_desc_".
+dump_rtti_name(du_functor_desc(Ordinal)) =
+    "du_functor_desc_" ++ int_to_string(Ordinal).
+dump_rtti_name(res_functor_desc(Ordinal)) =
+    "res_functor_desc_" ++ int_to_string(Ordinal).
+dump_rtti_name(enum_name_ordered_table) = "enum_name_ordered_table".
+dump_rtti_name(enum_value_ordered_table) = "enum_value_ordered_table".
+dump_rtti_name(du_name_ordered_table) = "du_name_ordered_table".
+dump_rtti_name(du_stag_ordered_table(Ptag)) =
+    "du_stag_ordered_table_" ++ int_to_string(Ptag).
+dump_rtti_name(du_ptag_ordered_table) = "du_ptag_ordered_table".
+dump_rtti_name(du_ptag_layout(Ptag)) =
+    "du_ptag_layout" ++ int_to_string(Ptag).
+dump_rtti_name(res_value_ordered_table) = "res_value_ordered_table".
+dump_rtti_name(res_name_ordered_table) = "res_name_ordered_table".
+dump_rtti_name(maybe_res_addr_functor_desc) = "maybe_res_addr_functor_desc".
+dump_rtti_name(type_layout) = "type_layout".
+dump_rtti_name(type_functors) = "type_functors".
+dump_rtti_name(type_ctor_info) = "type_ctor_info".
+dump_rtti_name(type_info(_TypeInfo)) = "type_info".
+    % XXX Should give more info than this for _TypeInfo.
+dump_rtti_name(pseudo_type_info(_PseudoTypeInfo)) = "pseudo_type_info".
+    % XXX Should give more info than this for _PseudoTypeInfo.
+dump_rtti_name(type_hashcons_pointer) = "type_hashcons_pointer".
+
+dump_tc_rtti_name(base_typeclass_info(_ModuleName, InstanceStr)) =
+    "base_typeclass_info(" ++ InstanceStr ++ ")".
+dump_tc_rtti_name(type_class_id) = "type_class_id".
+dump_tc_rtti_name(type_class_decl) = "type_class_decl".
+dump_tc_rtti_name(type_class_decl_super(Ordinal, _)) =
+    "type_class_decl_super(" ++ int_to_string(Ordinal) ++ ")".
+dump_tc_rtti_name(type_class_decl_supers) = "type_class_decl_supers".
+dump_tc_rtti_name(type_class_id_method_ids) = "type_class_id_method_ids".
+dump_tc_rtti_name(type_class_id_var_names) = "type_class_id_var_names".
+dump_tc_rtti_name(type_class_instance(TCTypes)) =
+    "type_class_instance("
+        ++ dump_rtti_type_class_instance_types(TCTypes) ++ ")".
+dump_tc_rtti_name(type_class_instance_tc_type_vector(TCTypes)) =
+    "type_class_instance_tc_types_vector("
+    ++ dump_rtti_type_class_instance_types(TCTypes) ++ ")".
+dump_tc_rtti_name(type_class_instance_constraints(TCTypes)) =
+    "type_class_instance_constraints("
+        ++ dump_rtti_type_class_instance_types(TCTypes) ++ ")".
+dump_tc_rtti_name(type_class_instance_constraint(TCTypes, Ordinal, _)) =
+    "type_class_instance_constraint("
+        ++ dump_rtti_type_class_instance_types(TCTypes) ++ ", "
+        ++ int_to_string(Ordinal) ++ ")".
+dump_tc_rtti_name(type_class_instance_methods(TCTypes)) =
+    "type_class_instance_methods("
+        ++ dump_rtti_type_class_instance_types(TCTypes) ++ ")".
+
+dump_rtti_type_class_name(tc_name(ModuleName, ClassName, Arity)) = Str :-
+    Str = "tc_name(" ++ sym_name_mangle(ModuleName) ++ ", "
+        ++ name_mangle(ClassName) ++ int_to_string(Arity) ++ ")".
 
-dump_rtti_type_class_instance_types(TCTypes, Str) :-
+dump_rtti_type_class_instance_types(TCTypes) = Str :-
 	EncodedTCTypes = list__map(rtti__encode_tc_instance_type, TCTypes),
 	string__append_list(EncodedTCTypes, TypesStr),
-	string__append_list(["tc_instance(", TypesStr, ")"],
-		Str).
+    Str = "tc_instance(" ++ TypesStr ++ ")".
 
-dump_layout_name(label_layout(ProcLabel, LabelNum, LabelVars),
-		Str) :-
-	dump_label(internal(LabelNum, ProcLabel), LabelStr),
+dump_layout_name(label_layout(ProcLabel, LabelNum, LabelVars)) = Str :-
+    LabelStr = dump_label(internal(LabelNum, ProcLabel)),
 	(
 		LabelVars = label_has_var_info,
 		LabelVarsStr = "label_has_var_info"
@@ -493,129 +391,105 @@
 		LabelVars = label_has_no_var_info,
 		LabelVarsStr = "label_has_no_var_info"
 	),
-	string__append_list(["label_layout(", LabelStr, ", ",
-		LabelVarsStr, ")"], Str).
-dump_layout_name(proc_layout(RttiProcLabel, _), Str) :-
-	dump_rttiproclabel(RttiProcLabel, ProcLabelStr),
-	string__append_list(["proc_layout(", ProcLabelStr, ")"], Str).
-dump_layout_name(proc_layout_exec_trace(RttiProcLabel), Str) :-
-	dump_rttiproclabel(RttiProcLabel, ProcLabelStr),
-	string__append_list(["proc_layout_exec_trace(", ProcLabelStr, ")"],
-		Str).
-dump_layout_name(proc_layout_head_var_nums(RttiProcLabel), Str) :-
-	dump_rttiproclabel(RttiProcLabel, ProcLabelStr),
-	string__append_list(["proc_layout_head_var_nums(", ProcLabelStr, ")"],
-		Str).
-dump_layout_name(proc_layout_var_names(RttiProcLabel), Str) :-
-	dump_rttiproclabel(RttiProcLabel, ProcLabelStr),
-	string__append_list(["proc_layout_var_names(", ProcLabelStr, ")"],
-		Str).
-dump_layout_name(proc_layout_body_bytecode(RttiProcLabel), Str) :-
-	dump_rttiproclabel(RttiProcLabel, ProcLabelStr),
-	string__append_list(["proc_layout_body_bytecode(", ProcLabelStr, ")"],
-		Str).
-dump_layout_name(closure_proc_id(ProcLabel, SeqNo, _), Str) :-
-	dump_proclabel(ProcLabel, ProcLabelStr),
-	string__int_to_string(SeqNo, SeqNoStr),
-	string__append_list(["closure_proc_id(", ProcLabelStr, ", ",
-		SeqNoStr, ")"], Str).
-dump_layout_name(file_layout(ModuleName, FileNum), Str) :-
-	ModuleNameStr = sym_name_mangle(ModuleName),
-	string__int_to_string(FileNum, FileNumStr),
-	string__append_list(["file_layout(", ModuleNameStr, ", ",
-		FileNumStr, ")"], Str).
-dump_layout_name(file_layout_line_number_vector(ModuleName,
-		FileNum), Str) :-
-	ModuleNameStr = sym_name_mangle(ModuleName),
-	string__int_to_string(FileNum, FileNumStr),
-	string__append_list(["file_layout_line_number_vector(", ModuleNameStr,
-		", ", FileNumStr, ")"], Str).
-dump_layout_name(file_layout_label_layout_vector(ModuleName,
-		FileNum), Str) :-
-	ModuleNameStr = sym_name_mangle(ModuleName),
-	string__int_to_string(FileNum, FileNumStr),
-	string__append_list(["file_layout_label_layout_vector(", ModuleNameStr,
-		", ", FileNumStr, ")"], Str).
-dump_layout_name(module_layout_string_table(ModuleName), Str) :-
-	ModuleNameStr = sym_name_mangle(ModuleName),
-	string__append_list(["module_layout_string_table(", ModuleNameStr,
-		")"], Str).
-dump_layout_name(module_layout_file_vector(ModuleName), Str) :-
-	ModuleNameStr = sym_name_mangle(ModuleName),
-	string__append_list(["module_layout_file_vector(", ModuleNameStr, ")"],
-		Str).
-dump_layout_name(module_layout_proc_vector(ModuleName), Str) :-
-	ModuleNameStr = sym_name_mangle(ModuleName),
-	string__append_list(["module_layout_proc_vector(", ModuleNameStr, ")"],
-		Str).
-dump_layout_name(module_layout_label_exec_count(ModuleName, NumLabels), Str) :-
-	ModuleNameStr = sym_name_mangle(ModuleName),
-	NumLabelsStr = int_to_string(NumLabels),
-	string__append_list(["module_layout_label_exec_count(",
-		ModuleNameStr, ", ", NumLabelsStr, ")"], Str).
-dump_layout_name(module_layout(ModuleName), Str) :-
-	ModuleNameStr = sym_name_mangle(ModuleName),
-	string__append_list(["module_layout(", ModuleNameStr, ")"], Str).
-dump_layout_name(proc_static(RttiProcLabel), Str) :-
-	ProcLabel = make_proc_label_from_rtti(RttiProcLabel),
-	dump_proclabel(ProcLabel, ProcLabelStr),
-	string__append_list(["proc_static(", ProcLabelStr, ")"], Str).
-dump_layout_name(proc_static_call_sites(RttiProcLabel), Str) :-
-	ProcLabel = make_proc_label_from_rtti(RttiProcLabel),
-	dump_proclabel(ProcLabel, ProcLabelStr),
-	string__append_list(["proc_static_call_sites(", ProcLabelStr, ")"],
-		Str).
-dump_layout_name(table_io_decl(RttiProcLabel), Str) :-
-	ProcLabel = make_proc_label_from_rtti(RttiProcLabel),
-	dump_proclabel(ProcLabel, ProcLabelStr),
-	string__append_list(["table_io_decl(", ProcLabelStr, ")"], Str).
-dump_layout_name(table_gen_info(RttiProcLabel), Str) :-
-	ProcLabel = make_proc_label_from_rtti(RttiProcLabel),
-	dump_proclabel(ProcLabel, ProcLabelStr),
-	string__append_list(["table_gen_info(", ProcLabelStr, ")"], Str).
-dump_layout_name(table_gen_enum_params(RttiProcLabel), Str) :-
-	ProcLabel = make_proc_label_from_rtti(RttiProcLabel),
-	dump_proclabel(ProcLabel, ProcLabelStr),
-	string__append_list(["table_gen_enum_params(", ProcLabelStr, ")"], Str).
-dump_layout_name(table_gen_steps(RttiProcLabel), Str) :-
-	ProcLabel = make_proc_label_from_rtti(RttiProcLabel),
-	dump_proclabel(ProcLabel, ProcLabelStr),
-	string__append_list(["table_gen_steps(", ProcLabelStr, ")"], Str).
-
-dump_unop(mktag, "mktag").
-dump_unop(tag, "tag").
-dump_unop(unmktag, "unmktag").
-dump_unop(strip_tag, "strip_tag").
-dump_unop(mkbody, "mkbody").
-dump_unop(unmkbody, "unmkbody").
-dump_unop(not, "not").
-dump_unop(hash_string, "hash_string").
-dump_unop(bitwise_complement, "bitwise_complement").
+    Str = "label_layout(" ++ LabelStr ++ ", " ++ LabelVarsStr ++ ")".
+dump_layout_name(proc_layout(RttiProcLabel, _)) =
+    "proc_layout(" ++ dump_rttiproclabel(RttiProcLabel) ++ ")".
+dump_layout_name(proc_layout_exec_trace(RttiProcLabel)) =
+    "proc_layout_exec_trace(" ++ dump_rttiproclabel(RttiProcLabel) ++ ")".
+dump_layout_name(proc_layout_head_var_nums(RttiProcLabel)) =
+    "proc_layout_head_var_nums(" ++ dump_rttiproclabel(RttiProcLabel) ++ ")".
+dump_layout_name(proc_layout_var_names(RttiProcLabel)) =
+    "proc_layout_var_names(" ++ dump_rttiproclabel(RttiProcLabel) ++ ")".
+dump_layout_name(proc_layout_body_bytecode(RttiProcLabel)) =
+    "proc_layout_body_bytecode(" ++ dump_rttiproclabel(RttiProcLabel) ++ ")".
+dump_layout_name(closure_proc_id(ProcLabel, SeqNo, _)) =
+    "closure_proc_id(" ++ dump_proclabel(ProcLabel)
+        ++ int_to_string(SeqNo) ++ ")".
+dump_layout_name(file_layout(ModuleName, FileNum)) =
+    "file_layout(" ++ sym_name_mangle(ModuleName)
+        ++ int_to_string(FileNum) ++ ")".
+dump_layout_name(file_layout_line_number_vector(ModuleName, FileNum)) =
+    "file_layout_line_number_vector(" ++ sym_name_mangle(ModuleName)
+        ++ int_to_string(FileNum) ++ ")".
+dump_layout_name(file_layout_label_layout_vector(ModuleName, FileNum)) =
+    "file_layout_label_layout_vector(" ++ sym_name_mangle(ModuleName)
+        ++ int_to_string(FileNum) ++ ")".
+dump_layout_name(module_layout_string_table(ModuleName)) =
+    "module_layout_string_table(" ++ sym_name_mangle(ModuleName) ++ ")".
+dump_layout_name(module_layout_file_vector(ModuleName)) =
+    "module_layout_file_vector(" ++ sym_name_mangle(ModuleName) ++ ")".
+dump_layout_name(module_layout_proc_vector(ModuleName)) =
+    "module_layout_proc_vector(" ++ sym_name_mangle(ModuleName) ++ ")".
+dump_layout_name(module_layout_label_exec_count(ModuleName, NumLabels)) =
+    "module_layout_label_exec_count(" ++ sym_name_mangle(ModuleName)
+        ++ ", " ++ int_to_string(NumLabels) ++ ")".
+dump_layout_name(module_layout(ModuleName)) =
+    "module_layout(" ++ sym_name_mangle(ModuleName) ++ ")".
+dump_layout_name(proc_static(RttiProcLabel)) =
+    "proc_static(" ++ dump_rttiproclabel(RttiProcLabel) ++ ")".
+dump_layout_name(proc_static_call_sites(RttiProcLabel)) =
+    "proc_static_call_sites(" ++ dump_rttiproclabel(RttiProcLabel) ++ ")".
+dump_layout_name(table_io_decl(RttiProcLabel)) =
+    "table_io_decl(" ++ dump_rttiproclabel(RttiProcLabel) ++ ")".
+dump_layout_name(table_gen_info(RttiProcLabel)) =
+    "table_gen_info(" ++ dump_rttiproclabel(RttiProcLabel) ++ ")".
+dump_layout_name(table_gen_enum_params(RttiProcLabel)) =
+    "table_gen_enum_params(" ++ dump_rttiproclabel(RttiProcLabel) ++ ")".
+dump_layout_name(table_gen_steps(RttiProcLabel)) =
+    "table_gen_steps(" ++ dump_rttiproclabel(RttiProcLabel) ++ ")".
+
+dump_unop(mktag) = "mktag".
+dump_unop(tag) = "tag".
+dump_unop(unmktag) = "unmktag".
+dump_unop(strip_tag) = "strip_tag".
+dump_unop(mkbody) = "mkbody".
+dump_unop(unmkbody) = "unmkbody".
+dump_unop(not) = "not".
+dump_unop(hash_string) = "hash_string".
+dump_unop(bitwise_complement) = "bitwise_complement".
 
-dump_binop(Op, String) :-
-	llds_out__binary_op_to_string(Op, String).
+dump_binop(Op) = Str :-
+    llds_out__binary_op_to_string(Op, Str).
 
-dump_maybe_rvals([], _, "").
-dump_maybe_rvals([MR | MRs], N, Str) :-
+dump_maybe_rvals([], _) = "".
+dump_maybe_rvals([MR | MRs], N) = Str :-
 	( N > 0 ->
-		( MR = yes(R) ->
-			dump_rval(R, MR_str)
+        (
+            MR = yes(R),
+            MR_str = dump_rval(R)
 		;
+            MR = no,
 			MR_str = "no"
 		),
-		N1 = N - 1,
-		dump_maybe_rvals(MRs, N1, MRs_str),
-		string__append_list([MR_str, ", ", MRs_str], Str)
+        Str = MR_str ++ ", " ++ dump_maybe_rvals(MRs, N - 1)
 	;
 		Str = "truncated"
 	).
 
-dump_code_addr(label(Label), Str) :-
-	dump_label(Label, Str).
-dump_code_addr(imported(ProcLabel), Str) :-
-	dump_proclabel(ProcLabel, Str).
-dump_code_addr(succip, "succip").
-dump_code_addr(do_succeed(Last), Str) :-
+dump_code_addr(label(Label)) = dump_label(Label).
+dump_code_addr(imported(ProcLabel)) = dump_proclabel(ProcLabel).
+dump_code_addr(succip) = "succip".
+dump_code_addr(do_succeed(Last)) = Str :-
+    (
+        Last = no,
+        Str = "do_succeed"
+    ;
+        Last = yes,
+        Str = "do_last_succeed"
+    ).
+dump_code_addr(do_redo) = "do_redo".
+dump_code_addr(do_fail) = "do_fail".
+dump_code_addr(do_trace_redo_fail_shallow) =
+    "do_trace_redo_fail_shallow".
+dump_code_addr(do_trace_redo_fail_deep) = "do_trace_redo_fail_deep".
+dump_code_addr(do_call_closure) = "do_nondet_closure".
+dump_code_addr(do_call_class_method) = "do_nondet_class_method".
+dump_code_addr(do_not_reached) = "do_not_reached".
+
+dump_code_addr(ProcLabel, label(Label)) = dump_label(ProcLabel, Label).
+dump_code_addr(_, imported(ProcLabel)) = dump_proclabel(ProcLabel).
+dump_code_addr(_, succip) = "succip".
+dump_code_addr(_, do_succeed(Last)) = Str :-
 	(
 		Last = no,
 		Str = "do_succeed"
@@ -623,144 +497,157 @@
 		Last = yes,
 		Str = "do_last_succeed"
 	).
-dump_code_addr(do_redo, "do_redo").
-dump_code_addr(do_fail, "do_fail").
-dump_code_addr(do_trace_redo_fail_shallow,
-	"do_trace_redo_fail_shallow").
-dump_code_addr(do_trace_redo_fail_deep, "do_trace_redo_fail_deep").
-dump_code_addr(do_call_closure, "do_nondet_closure").
-dump_code_addr(do_call_class_method, "do_nondet_class_method").
-dump_code_addr(do_not_reached, "do_not_reached").
-
-dump_code_addrs([], "").
-dump_code_addrs([Addr | Addrs], Str) :-
-	dump_code_addr(Addr, A_str),
-	dump_code_addrs(Addrs, A2_str),
-	string__append_list([" ", A_str, A2_str], Str).
+dump_code_addr(_, do_redo) = "do_redo".
+dump_code_addr(_, do_fail) = "do_fail".
+dump_code_addr(_, do_trace_redo_fail_shallow) =
+    "do_trace_redo_fail_shallow".
+dump_code_addr(_, do_trace_redo_fail_deep) = "do_trace_redo_fail_deep".
+dump_code_addr(_, do_call_closure) = "do_nondet_closure".
+dump_code_addr(_, do_call_class_method) = "do_nondet_class_method".
+dump_code_addr(_, do_not_reached) = "do_not_reached".
+
+dump_code_addrs([]) = "".
+dump_code_addrs([Addr | Addrs]) =
+    " " ++ dump_code_addr(Addr) ++ dump_code_addrs(Addrs).
+
+dump_code_addrs(_, []) = "".
+dump_code_addrs(ProcLabel, [Addr | Addrs]) =
+    " " ++ dump_code_addr(ProcLabel, Addr)
+        ++ dump_code_addrs(ProcLabel, Addrs).
+
+dump_label(internal(N, ProcLabel)) =
+    dump_proclabel(ProcLabel) ++ "_" ++ int_to_string(N).
+dump_label(entry(_, ProcLabel)) =
+    dump_proclabel(ProcLabel).
 
-dump_label(internal(N, ProcLabel), Str) :-
-	dump_proclabel(ProcLabel, P_str),
+dump_label(CurProcLabel, internal(N, ProcLabel)) = Str :-
 	string__int_to_string(N, N_str),
-	string__append_list([P_str, "_", N_str], Str).
-dump_label(entry(_, ProcLabel), Str) :-
-	dump_proclabel(ProcLabel, Str).
-
-dump_labels([], "").
-dump_labels([Label | Labels], Str) :-
-	dump_label(Label, L_str),
-	dump_labels(Labels, L2_str),
-	string__append_list([" ", L_str, L2_str], Str).
-
-dump_label_pairs([], "").
-dump_label_pairs([L1 - L2 | Labels], Str) :-
-	dump_label(L1, L1_str),
-	dump_label(L2, L2_str),
-	dump_label_pairs(Labels, L_str),
-	string__append_list([" ", L1_str, "-", L2_str, L_str], Str).
-
-:- pred dump_rttiproclabel(rtti_proc_label::in, string::out) is det.
-
-dump_rttiproclabel(RttiProcLabel, Str) :-
-	ProcLabel = make_proc_label_from_rtti(RttiProcLabel),
-	dump_proclabel(ProcLabel, Str).
+    ( CurProcLabel = ProcLabel ->
+        Str = "local_" ++ N_str
+    ;
+        Str = dump_proclabel(ProcLabel) ++ "_" ++ N_str
+    ).
+dump_label(CurProcLabel, entry(_, ProcLabel)) = Str :-
+    ( CurProcLabel = ProcLabel ->
+        Str = "CUR_PROC_ENTRY"
+    ;
+        Str = dump_proclabel(ProcLabel)
+    ).
 
-dump_proclabel(proc(Module, _PredOrFunc, PredModule,
-		PredName, Arity, Mode), Str) :-
+dump_labels([]) = "".
+dump_labels([Label | Labels]) =
+    " " ++ dump_label(Label) ++ dump_labels(Labels).
+
+dump_labels(_, []) = "".
+dump_labels(ProcLabel, [Label | Labels]) =
+    " " ++ dump_label(ProcLabel, Label) ++ dump_labels(ProcLabel, Labels).
+
+dump_label_pairs([]) = "".
+dump_label_pairs([L1 - L2 | Labels]) =
+    " " ++ dump_label(L1) ++ "-" ++ dump_label(L2) ++ dump_label_pairs(Labels).
+
+:- func dump_rttiproclabel(rtti_proc_label) = string.
+
+dump_rttiproclabel(RttiProcLabel) =
+    dump_proclabel(make_proc_label_from_rtti(RttiProcLabel)).
+
+dump_proclabel(ProcLabel) = Str :-
+    (
+        ProcLabel = proc(Module, _PredOrFunc, PredModule, PredName,
+            Arity, Mode),
 	( Module = PredModule ->
 		ExtraModule = ""
 	;
 		PredModuleName = sym_name_mangle(PredModule),
-		string__append(PredModuleName, "_", ExtraModule)
+            ExtraModule = PredModuleName ++ "_"
 	),
-	ModuleName = sym_name_mangle(Module),
-	string__int_to_string(Arity, A_str),
-	string__int_to_string(Mode, M_str),
-	string__append_list([ExtraModule, ModuleName, "_", PredName,
-		"_", A_str, "_", M_str], Str).
-dump_proclabel(special_proc(Module, SpecialPredId, TypeModule,
-		TypeName, TypeArity, Mode), Str) :-
-	ModuleName = sym_name_mangle(Module),
-	TypeModuleName = sym_name_mangle(TypeModule),
-	QualTypeName = qualify_name(TypeModuleName, TypeName),
-	string__int_to_string(TypeArity, A_str),
-	string__int_to_string(Mode, M_str),
+        Str = ExtraModule ++ sym_name_mangle(Module) ++ "_" ++ PredName ++ "_"
+            ++ int_to_string(Arity) ++ "_" ++ int_to_string(Mode)
+
+    ;
+        ProcLabel = special_proc(Module, SpecialPredId, TypeModule,
+            TypeName, TypeArity, Mode),
 	TypeCtor = qualified(TypeModule, TypeName) - TypeArity,
-	SpecialPredStr = special_pred_name(SpecialPredId, TypeCtor),
-	string__append_list([ModuleName, "_", SpecialPredStr, "_",
-		QualTypeName, "_", A_str, "_", M_str], Str).
-
-dump_bool(yes, "yes").
-dump_bool(no, "no").
-
-dump_code_model(model_det, "model_det").
-dump_code_model(model_semi, "model_semi").
-dump_code_model(model_non, "model_non").
-
-dump_instr(comment(Comment), Str) :-
-	string__append_list(["comment(", Comment, ")"], Str).
-dump_instr(livevals(Livevals), Str) :-
-	dump_livevals(Livevals, L_str),
-	string__append_list(["livevals(", L_str, ")"], Str).
-dump_instr(block(RTemps, FTemps, _), Str) :-
-	string__int_to_string(RTemps, R_str),
-	string__int_to_string(FTemps, F_str),
-	string__append_list(["block(", R_str, ", ", F_str, ", ...)"], Str).
-dump_instr(assign(Lval, Rval), Str) :-
-	dump_lval(Lval, L_str),
-	dump_rval(Rval, R_str),
-	string__append_list(["assign(", L_str, ", ", R_str, ")"], Str).
-dump_instr(call(Proc, Ret, _, _, _, _), Str) :-
-	dump_code_addr(Proc, P_str),
-	dump_code_addr(Ret, R_str),
-	string__append_list(["call(", P_str, ", ", R_str, ", ...)"], Str).
-dump_instr(mkframe(FrameInfo, MaybeRedoip), Str) :-
+        Str = sym_name_mangle(Module) ++ "_"
+            ++ special_pred_name(SpecialPredId, TypeCtor) ++ "_"
+            ++ qualify_name(sym_name_mangle(TypeModule), TypeName) ++ "_"
+            ++ int_to_string(TypeArity) ++ "_" ++ int_to_string(Mode)
+    ).
+
+dump_bool(yes) = "yes".
+dump_bool(no) = "no".
+
+dump_code_model(model_det) = "model_det".
+dump_code_model(model_semi) = "model_semi".
+dump_code_model(model_non) = "model_non".
+
+dump_instr(ProcLabel, Instr) = Str :-
+    (
+        Instr = comment(Comment),
+        Str = "comment(" ++ Comment ++ ")"
+    ;
+        Instr = livevals(Livevals),
+        Str = "livevals(" ++ dump_livevals(Livevals) ++ ")"
+    ;
+        Instr = block(RTemps, FTemps, _),
+        Str = "block(" ++ int_to_string(RTemps) ++ ", "
+            ++ int_to_string(FTemps) ++ ", ...)"
+    ;
+        Instr = assign(Lval, Rval),
+        Str = "assign(" ++ dump_lval(Lval) ++ ", " ++ dump_rval(Rval) ++ ")"
+    ;
+        Instr = call(Callee, ReturnLabel, _, _, _, _),
+        Str = "call(" ++ dump_code_addr(ProcLabel, Callee) ++ ", "
+            ++ dump_code_addr(ProcLabel, ReturnLabel) ++ ", ...)"
+    ;
+        Instr = mkframe(FrameInfo, MaybeRedoip),
 	(
 		MaybeRedoip = yes(Redoip),
-		dump_code_addr(Redoip, R_str)
+            R_str = dump_code_addr(ProcLabel, Redoip)
 	;
 		MaybeRedoip = no,
 		R_str = "no_redoip"
 	),
 	(
 		FrameInfo = ordinary_frame(Name, Size, MaybePragma),
-		string__int_to_string(Size, S_str),
-		( MaybePragma = yes(pragma_c_struct(StructName, Fields, _)) ->
-			string__append_list(["yes(", StructName, ", ",
-				Fields, ")"], P_str)
+            (
+                MaybePragma = yes(pragma_c_struct(StructName, Fields, _)),
+                P_str = "yes(" ++ StructName ++ ", " ++ Fields ++ ")"
 		;
+                MaybePragma = no,
 			P_str = "no"
 		),
-		string__append_list(["mkframe(", Name, ", ", S_str, ", ",
-			P_str, ", ", R_str, ")"], Str)
+            Str = "mkframe(" ++ Name ++ ", " ++ int_to_string(Size) ++ ", "
+                ++ P_str ++ ", " ++ R_str ++ ")"
 	;
 		FrameInfo = temp_frame(Kind),
 		(
 			Kind = nondet_stack_proc,
-			string__append_list(["mktempframe(", R_str, ")"], Str)
+                Str = "mktempframe(" ++ R_str ++ ")"
 		;
 			Kind = det_stack_proc,
-			string__append_list(["mkdettempframe(", R_str, ")"],
-				Str)
+                Str = "mkdettempframe(" ++ R_str ++ ")"
 		)
-	).
-dump_instr(label(Label), Str) :-
-	dump_label(Label, L_str),
-	string__append_list(["label(", L_str, ")"], Str).
-dump_instr(goto(CodeAddr), Str) :-
-	dump_code_addr(CodeAddr, C_str),
-	string__append_list(["goto(", C_str, ")"], Str).
-dump_instr(computed_goto(Rval, Labels), Str) :-
-	dump_rval(Rval, R_str),
-	dump_labels(Labels, L_str),
-	string__append_list(["computed_goto(", R_str, ", ", L_str, ")"], Str).
-dump_instr(c_code(Code, _), Str) :-
-	string__append_list(["c_code(", Code, ")"], Str).
-dump_instr(if_val(Rval, CodeAddr), Str) :-
-	dump_rval(Rval, R_str),
-	dump_code_addr(CodeAddr, C_str),
-	string__append_list(["if_val(", R_str, ", ", C_str, ")"], Str).
-dump_instr(incr_hp(Lval, MaybeTag, MaybeOffset, Size, _), Str) :-
-	dump_lval(Lval, L_str),
+        )
+    ;
+        Instr = label(Label),
+        Str = "label(" ++ dump_label(ProcLabel, Label) ++ ")"
+    ;
+        Instr = goto(CodeAddr),
+        Str = "goto(" ++ dump_code_addr(ProcLabel, CodeAddr) ++ ")"
+    ;
+        Instr = computed_goto(Rval, Labels),
+        Str = "computed_goto(" ++ dump_rval(Rval) ++ ", "
+            ++ dump_labels(ProcLabel, Labels) ++ ")"
+    ;
+        Instr = c_code(Code, _),
+        Str = "c_code(" ++ Code ++ ")"
+    ;
+        Instr = if_val(Rval, CodeAddr),
+        Str = "if_val(" ++ dump_rval(Rval) ++ ", "
+            ++ dump_code_addr(ProcLabel, CodeAddr) ++ ")"
+    ;
+        Instr = incr_hp(Lval, MaybeTag, MaybeOffset, Size, _),
 	(
 		MaybeTag = no,
 		T_str = "no"
@@ -775,85 +662,82 @@
 		MaybeOffset = yes(Offset),
 		string__int_to_string(Offset, O_str)
 	),
-	dump_rval(Size, S_str),
-	string__append_list(["incr_hp(", L_str, ", ", T_str, ", ", O_str,
-		", ", S_str, ")"], Str).
-dump_instr(mark_hp(Lval), Str) :-
-	dump_lval(Lval, L_str),
-	string__append_list(["mark_hp(", L_str, ")"], Str).
-dump_instr(restore_hp(Rval), Str) :-
-	dump_rval(Rval, R_str),
-	string__append_list(["restore_hp(", R_str, ")"], Str).
-dump_instr(free_heap(Rval), Str) :-
-	dump_rval(Rval, R_str),
-	string__append_list(["free_heap(", R_str, ")"], Str).
-dump_instr(store_ticket(Lval), Str) :-
-	dump_lval(Lval, L_str),
-	string__append_list(["store_ticket(", L_str, ")"], Str).
-dump_instr(reset_ticket(Rval, _Reason), Str) :-
-	dump_rval(Rval, R_str),
-	string__append_list(["reset_ticket(", R_str, ", _)"], Str).
-dump_instr(discard_ticket, "discard_ticket").
-dump_instr(prune_ticket, "prune_ticket").
-dump_instr(mark_ticket_stack(Lval), Str) :-
-	dump_lval(Lval, L_str),
-	string__append_list(["mark_ticket_stack(", L_str, ")"], Str).
-dump_instr(prune_tickets_to(Rval), Str) :-
-	dump_rval(Rval, R_str),
-	string__append_list(["prune_tickets_to(", R_str, ")"], Str).
-dump_instr(incr_sp(Size, _), Str) :-
-	string__int_to_string(Size, S_str),
-	string__append_list(["incr_sp(", S_str, ")"], Str).
-dump_instr(decr_sp(Size), Str) :-
-	string__int_to_string(Size, S_str),
-	string__append_list(["decr_sp(", S_str, ")"], Str).
-dump_instr(init_sync_term(Lval, N), Str) :-
-	dump_lval(Lval, L_str),
-	string__int_to_string(N, N_str),
-	string__append_list(["init_sync_term(", L_str, ", ", N_str, ")"], Str).
-dump_instr(fork(Child, Parent, Lval), Str) :-
-	dump_label(Child, ChildStr),
-	dump_label(Parent, ParentStr),
-	string__int_to_string(Lval, LvalStr),
-	string__append_list(["fork(", ChildStr, ", ", ParentStr, ", ",
-		LvalStr, ")"], Str).
-dump_instr(join_and_terminate(Lval), Str) :-
-	dump_lval(Lval, LvalStr),
-	string__append_list(["join_and_terminate(", LvalStr, ")"], Str).
-dump_instr(join_and_continue(Lval, Label), Str) :-
-	dump_lval(Lval, LvalStr),
-	dump_label(Label, LabelStr),
-	string__append_list(["join(", LvalStr, ", ", LabelStr, ")"], Str).
-% XXX  should probably give more info than this
-dump_instr(pragma_c(_, Comps, _, _, _, _, _, _, _), Str) :-
-	dump_components(Comps, C_str),
-	string__append_list(["pragma_c(", C_str, ")"], Str).
-
-:- pred dump_components(list(pragma_c_component)::in, string::out) is det.
-
-dump_components([], "").
-dump_components([Comp | Comps], Str) :-
-	dump_component(Comp, Str1),
-	dump_components(Comps, Str2),
-	string__append(Str1, Str2, Str).
-
-:- pred dump_component(pragma_c_component::in, string::out) is det.
-
-dump_component(pragma_c_inputs(_), "").
-dump_component(pragma_c_outputs(_), "").
-dump_component(pragma_c_user_code(_, Code), Code).
-dump_component(pragma_c_raw_code(Code, _), Code).
-dump_component(pragma_c_fail_to(Label), Code) :-
-	dump_label(Label, LabelStr),
-	string__append_list(["fail to ", LabelStr], Code).
-dump_component(pragma_c_noop, "").
-
-dump_fullinstr(Uinstr - Comment, Str) :-
-	dump_instr(Uinstr, U_str),
-	string__append_list([U_str, " - ", Comment, "\n"], Str).
-
-dump_fullinstrs([], "").
-dump_fullinstrs([Instr | Instrs], Str) :-
-	dump_fullinstr(Instr, S1_str),
-	dump_fullinstrs(Instrs, S2_str),
-	string__append_list([S1_str, S2_str], Str).
+        Str = "incr_hp(" ++ dump_lval(Lval) ++ ", " ++ T_str ++ ", " ++ O_str
+            ++ ", " ++ dump_rval(Size) ++ ")"
+    ;
+        Instr = mark_hp(Lval),
+        Str = "mark_hp(" ++ dump_lval(Lval) ++ ")"
+    ;
+        Instr = restore_hp(Rval),
+        Str = "restore_hp(" ++ dump_rval(Rval) ++ ")"
+    ;
+        Instr = free_heap(Rval),
+        Str = "free_heap(" ++ dump_rval(Rval) ++ ")"
+    ;
+        Instr = store_ticket(Lval),
+        Str = "store_ticket(" ++ dump_lval(Lval) ++ ")"
+    ;
+        Instr = reset_ticket(Rval, _Reason),
+        Str = "reset_ticket(" ++ dump_rval(Rval) ++ ", _)"
+    ;
+        Instr = discard_ticket,
+        Str = "discard_ticket"
+    ;
+        Instr = prune_ticket,
+        Str = "prune_ticket"
+    ;
+        Instr = mark_ticket_stack(Lval),
+        Str = "mark_ticket_stack(" ++ dump_lval(Lval) ++ ")"
+    ;
+        Instr = prune_tickets_to(Rval),
+        Str = "prune_tickets_to(" ++ dump_rval(Rval) ++ ")"
+    ;
+        Instr = incr_sp(Size, _),
+        Str = "incr_sp(" ++ int_to_string(Size) ++ ")"
+    ;
+        Instr = decr_sp(Size),
+        Str = "decr_sp(" ++ int_to_string(Size) ++ ")"
+    ;
+        Instr = init_sync_term(Lval, N),
+        Str = "init_sync_term(" ++ dump_lval(Lval) ++ ", "
+            ++ int_to_string(N) ++")"
+    ;
+        Instr = fork(Child, Parent, NumSlots),
+        Str = "fork(" ++ dump_label(ProcLabel, Child) ++ ", "
+            ++ dump_label(ProcLabel, Parent) ++ ", "
+            ++ int_to_string(NumSlots) ++ ")"
+    ;
+        Instr = join_and_terminate(Lval),
+        Str = "join_and_terminate(" ++ dump_lval(Lval) ++ ")"
+    ;
+        Instr = join_and_continue(Lval, Label),
+        Str = "join(" ++ dump_lval(Lval) ++ ", "
+            ++ dump_label(ProcLabel, Label) ++ ")"
+    ;
+        Instr = pragma_c(_, Comps, _, _, _, _, _, _, _),
+        % XXX  should probably give more info than this
+        Str = "pragma_c(" ++ dump_components(ProcLabel, Comps) ++ ")"
+    ).
+
+:- func dump_components(proc_label, list(pragma_c_component)) = string.
+
+dump_components(_, []) = "".
+dump_components(ProcLabel, [Comp | Comps]) =
+    dump_component(ProcLabel, Comp) ++ dump_components(ProcLabel, Comps).
+
+:- func dump_component(proc_label, pragma_c_component) = string.
+
+dump_component(_, pragma_c_inputs(_)) = "".
+dump_component(_, pragma_c_outputs(_)) = "".
+dump_component(_, pragma_c_user_code(_, Code)) = Code.
+dump_component(_, pragma_c_raw_code(Code, _)) = Code.
+dump_component(ProcLabel, pragma_c_fail_to(Label)) =
+    "fail to " ++ dump_label(ProcLabel, Label).
+dump_component(_, pragma_c_noop) = "".
+
+dump_fullinstr(ProcLabel, Uinstr - Comment) =
+    dump_instr(ProcLabel, Uinstr) ++ " - " ++ Comment ++ "\n".
+
+dump_fullinstrs(_ProcLabel, []) = "".
+dump_fullinstrs(ProcLabel, [Instr | Instrs]) =
+    dump_fullinstr(ProcLabel, Instr) ++ dump_fullinstrs(ProcLabel, Instrs).
Index: compiler/optimize.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/optimize.m,v
retrieving revision 1.46
diff -u -b -r1.46 optimize.m
--- compiler/optimize.m	22 Mar 2005 06:40:16 -0000	1.46
+++ compiler/optimize.m	23 Aug 2005 10:53:12 -0000
@@ -1,4 +1,6 @@
 %-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
 % Copyright (C) 1996-2005 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.
@@ -65,10 +67,6 @@
 optimize_main(GlobalData, !Procs, !IO) :-
 	list__map_foldl(optimize__proc(GlobalData), !Procs, !IO).
 
-:- func make_internal_label(proc_label, int) = label.
-
-make_internal_label(ProcLabel, LabelNum) = internal(LabelNum, ProcLabel).
-
 optimize__proc(GlobalData, CProc0, CProc, !IO) :-
 	some [!OptDebugInfo, !C, !Instrs] (
 		CProc0 = c_procedure(Name, Arity, PredProcId, !:Instrs,
@@ -88,18 +86,21 @@
 		;
 			set__init(LayoutLabelSet)
 		),
-		optimize__initial(LayoutLabelSet, ProcLabel, MayAlterRtti,
-			!C, !OptDebugInfo, !Instrs, !IO),
-		optimize__repeat(Repeat, LayoutLabelSet, ProcLabel,
-			MayAlterRtti, !C, !OptDebugInfo, !Instrs, !IO),
-		optimize__middle(yes, LayoutLabelSet, ProcLabel, MayAlterRtti,
-			!C, !OptDebugInfo, !Instrs, !IO),
-		optimize__last(LayoutLabelSet, !.C, !.OptDebugInfo, !Instrs,
-			!IO),
-		CProc = c_procedure(Name, Arity, PredProcId, !.Instrs,
-			ProcLabel, !.C, MayAlterRtti)
+        optimize__initial(LayoutLabelSet, ProcLabel, MayAlterRtti, !C,
+            !OptDebugInfo, !Instrs, !IO),
+        optimize__repeat(Repeat, LayoutLabelSet, ProcLabel, MayAlterRtti, !C,
+            !OptDebugInfo, !Instrs, !IO),
+        optimize__middle(yes, LayoutLabelSet, ProcLabel, MayAlterRtti, !C,
+            !OptDebugInfo, !Instrs, !IO),
+        optimize__last(LayoutLabelSet, !.C, !.OptDebugInfo, !Instrs, !IO),
+        CProc = c_procedure(Name, Arity, PredProcId, !.Instrs, ProcLabel,
+            !.C, MayAlterRtti)
 	).
 
+:- func make_internal_label(proc_label, int) = label.
+
+make_internal_label(ProcLabel, LabelNum) = internal(LabelNum, ProcLabel).
+
 %-----------------------------------------------------------------------------%
 
 :- type opt_debug_info
@@ -128,8 +129,8 @@
 		string__int_to_string(Arity, ArityStr),
 		string__int_to_string(PredIdInt, PredIdStr),
 		string__int_to_string(ProcIdInt, ProcIdStr),
-		string__append_list([MangledName, "_", ArityStr,
-			".pred", PredIdStr, ".proc", ProcIdStr], BaseName),
+        BaseName = MangledName ++ "_" ++ ArityStr ++ ".pred" ++ PredIdStr
+            ++ ".proc" ++ ProcIdStr,
 		OptDebugInfo = opt_debug_info(BaseName, 0),
 
 		string__append_list([BaseName, ".opt0"], FileName),
@@ -137,9 +138,8 @@
 		( Res = ok(FileStream) ->
 			io__set_output_stream(FileStream, OutputStream, !IO),
 			counter__allocate(NextLabel, Counter, _),
-			opt_debug__msg(yes, NextLabel, "before optimization",
-				!IO),
-			opt_debug__dump_instrs(yes, Instrs0, !IO),
+            opt_debug__msg(yes, NextLabel, "before optimization", !IO),
+            opt_debug__maybe_dump_instrs(yes, Instrs0, !IO),
 			io__set_output_stream(OutputStream, _, !IO),
 			io__close_output(FileStream, !IO)
 		;
@@ -151,8 +151,8 @@
 	).
 
 :- pred optimize__maybe_opt_debug(list(instruction)::in, counter::in,
-	string::in, opt_debug_info::in, opt_debug_info::out,
-	io::di, io::uo) is det.
+    string::in, opt_debug_info::in, opt_debug_info::out, io::di, io::uo)
+    is det.
 
 optimize__maybe_opt_debug(Instrs, Counter, Msg, OptDebugInfo0, OptDebugInfo,
 		!IO) :-
@@ -161,31 +161,26 @@
 		OptNum = OptNum0 + 1,
 		string__int_to_string(OptNum0, OptNum0Str),
 		string__int_to_string(OptNum, OptNumStr),
-		string__append_list([BaseName, ".opt", OptNum0Str],
-			OptFileName0),
-		string__append_list([BaseName, ".opt", OptNumStr],
-			OptFileName),
-		string__append_list([BaseName, ".diff", OptNumStr],
-			DiffFileName),
+        OptFileName0 = BaseName ++ ".opt" ++ OptNum0Str,
+        OptFileName = BaseName ++ ".opt" ++ OptNumStr,
+        DiffFileName = BaseName ++ ".diff" ++ OptNumStr,
 		io__open_output(OptFileName, Res, !IO),
 		( Res = ok(FileStream) ->
 			io__set_output_stream(FileStream, OutputStream, !IO),
 			counter__allocate(NextLabel, Counter, _),
 			opt_debug__msg(yes, NextLabel, Msg, !IO),
-			opt_debug__dump_instrs(yes, Instrs, !IO),
+            opt_debug__maybe_dump_instrs(yes, Instrs, !IO),
 			io__set_output_stream(OutputStream, _, !IO),
 			io__close_output(FileStream, !IO)
 		;
-			string__append("cannot open ", OptFileName,
-				ErrorMsg),
+            ErrorMsg = "cannot open " ++ OptFileName,
 			error(ErrorMsg)
 		),
 		% Although the -u is not fully portable, it is available
 		% on all the systems we intend to use it on, and the main user
 		% of --debug-opt (zs) strongly prefers -u to -c.
-		string__append_list(["diff -u ",
-			OptFileName0, " ", OptFileName,
-			" > ", DiffFileName], DiffCommand),
+        DiffCommand = "diff -u " ++ OptFileName0 ++ " " ++ OptFileName
+            ++ " > " ++ DiffFileName,
 		io__call_system(DiffCommand, _, !IO),
 		OptDebugInfo = opt_debug_info(BaseName, OptNum)
 	;
@@ -210,17 +205,16 @@
 		FrameOpt = yes,
 		(
 			VeryVerbose = yes,
-			io__write_string("% Optimizing nondet frames for ",
-				!IO),
+            io__write_string("% Optimizing nondet frames for ", !IO),
 			io__write_string(LabelStr, !IO),
 			io__write_string("\n", !IO)
 		;
 			VeryVerbose = no
 		),
-		frameopt_nondet(ProcLabel, LayoutLabelSet, MayAlterRtti, !C,
-			!Instrs, _Mod),
-		optimize__maybe_opt_debug(!.Instrs, !.C,
-			"after nondet frame opt", !OptDebugInfo, !IO)
+        frameopt_nondet(ProcLabel, LayoutLabelSet, MayAlterRtti, !C, !Instrs,
+            _Mod),
+        optimize__maybe_opt_debug(!.Instrs, !.C, "after nondet frame opt",
+            !OptDebugInfo, !IO)
 	;
 		FrameOpt = no
 	).
@@ -241,13 +235,12 @@
 		;
 			Final = no
 		),
-		optimize__repeated(Final, LayoutLabelSet, ProcLabel,
-			MayAlterRtti, !C, !OptDebugInfo,
-			!Instrs, Mod, !IO),
+        optimize__repeated(Final, LayoutLabelSet, ProcLabel, MayAlterRtti,
+            !C, !OptDebugInfo, !Instrs, Mod, !IO),
 		(
 			Mod = yes,
-			optimize__repeat(NextIter, LayoutLabelSet, ProcLabel,
-				MayAlterRtti, !C, !OptDebugInfo, !Instrs, !IO)
+            optimize__repeat(NextIter, LayoutLabelSet, ProcLabel, MayAlterRtti,
+                !C, !OptDebugInfo, !Instrs, !IO)
 		;
 			Mod = no
 		)
@@ -257,7 +250,7 @@
 
 	% We short-circuit jump sequences before normal peepholing
 	% to create more opportunities for use of the tailcall macro.
-
+    %
 :- pred optimize__repeated(bool::in, set(label)::in, proc_label::in,
 	may_alter_rtti::in, counter::in, counter::out,
 	opt_debug_info::in, opt_debug_info::out,
@@ -286,9 +279,9 @@
 		;
 			VeryVerbose = no
 		),
-		jumpopt_main(LayoutLabelSet, MayAlterRtti, ProcLabel,
-			FullJumpopt, Final, PessimizeTailCalls,
-			CheckedNondetTailCalls, !C, !Instrs, Mod1),
+        jumpopt_main(LayoutLabelSet, MayAlterRtti, ProcLabel, FullJumpopt,
+            Final, PessimizeTailCalls, CheckedNondetTailCalls, !C, !Instrs,
+            Mod1),
 		optimize__maybe_opt_debug(!.Instrs, !.C, "after jump opt",
 			!OptDebugInfo, !IO)
 	;
@@ -379,31 +372,31 @@
 		;
 			VeryVerbose = no
 		),
-		frameopt_main(ProcLabel, !C, !Instrs, Mod1, Jumps),
+        globals__io_get_globals(Globals, !IO),
+        frameopt_main(ProcLabel, !C, !Instrs, Globals, Mod1),
 		optimize__maybe_opt_debug(!.Instrs, !.C, "after frame opt",
 			!OptDebugInfo, !IO),
-		globals__io_lookup_bool_option(optimize_fulljumps,
-			FullJumpopt, !IO),
+        globals__io_lookup_bool_option(optimize_fulljumps, FullJumpopt, !IO),
 		globals__io_lookup_bool_option(pessimize_tailcalls,
 			PessimizeTailCalls, !IO),
 		globals__io_lookup_bool_option(checked_nondet_tailcalls,
 			CheckedNondetTailCalls, !IO),
 		(
-			Jumps = yes,
-			FullJumpopt = yes
+            ( FullJumpopt = yes
+            ; Mod1 = yes
+            )
 		->
 			(
 				VeryVerbose = yes,
-				io__write_string("% Optimizing jumps for ",
-					!IO),
+                io__write_string("% Optimizing jumps for ", !IO),
 				io__write_string(LabelStr, !IO),
 				io__write_string("\n", !IO)
 			;
 				VeryVerbose = no
 			),
-			jumpopt_main(LayoutLabelSet, MayAlterRtti, ProcLabel,
-				FullJumpopt, Final, PessimizeTailCalls,
-				CheckedNondetTailCalls, !C, !Instrs, _Mod2),
+            jumpopt_main(LayoutLabelSet, MayAlterRtti, ProcLabel, FullJumpopt,
+                Final, PessimizeTailCalls, CheckedNondetTailCalls, !C, !Instrs,
+                _Mod2),
 			optimize__maybe_opt_debug(!.Instrs, !.C, "after jumps",
 				!OptDebugInfo, !IO)
 		;
@@ -413,8 +406,7 @@
 			Mod1 = yes,
 			(
 				VeryVerbose = yes,
-				io__write_string("% Optimizing labels for ",
-					!IO),
+                io__write_string("% Optimizing labels for ", !IO),
 				io__write_string(LabelStr, !IO),
 				io__write_string("\n", !IO)
 			;
@@ -440,8 +432,7 @@
 		;
 			VeryVerbose = no
 		),
-		globals__io_lookup_int_option(num_real_r_regs, NumRealRRegs,
-			!IO),
+        globals__io_lookup_int_option(num_real_r_regs, NumRealRRegs, !IO),
 		globals__io_lookup_int_option(local_var_access_threshold,
 			AccessThreshold, !IO),
 		use_local_vars__main(!Instrs, ProcLabel, NumRealRRegs,
Index: compiler/options.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.462
diff -u -b -r1.462 options.m
--- compiler/options.m	8 Jul 2005 04:22:06 -0000	1.462
+++ compiler/options.m	24 Aug 2005 04:47:38 -0000
@@ -179,6 +179,7 @@
 		;	generate_bytecode
 		;	line_numbers
 		;	auto_comments
+		;	frameopt_comments
 		;	show_dependency_graph
 		;	dump_hlds
 		;	dump_hlds_pred_id
@@ -911,6 +912,7 @@
 	generate_bytecode	-	bool(no),
 	line_numbers		-	bool(yes),
 	auto_comments		-	bool(no),
+	frameopt_comments	-	bool(no),
 	show_dependency_graph	-	bool(no),
 	dump_hlds		-	accumulating([]),
 	dump_hlds_pred_id	-	int(-1),
@@ -1602,6 +1604,7 @@
 long_option("generate-bytecode",	generate_bytecode).
 long_option("line-numbers",		line_numbers).
 long_option("auto-comments",		auto_comments).
+long_option("frameopt-comments",	frameopt_comments).
 long_option("show-dependency-graph",	show_dependency_graph).
 long_option("dump-hlds",		dump_hlds).
 long_option("hlds-dump",		dump_hlds).
@@ -3036,6 +3039,10 @@
 		"\tor in Mercury (with the option --convert-to-mercury).",
 		"--auto-comments",
 		"\tOutput comments in the `<module>.c' file.",
+% This option is for developers only. Since it can include one C comment inside
+% another, the resulting code is not guaranteed to be valid C.
+%		"--frameopt-comments",
+%		"\tGet frameopt.m to generate comments describing its operation.",
 		"\t(The code may be easier to understand if you also",
 		"\tuse the `--no-llds-optimize' option.)",
 		"--show-dependency-graph",
Index: compiler/peephole.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/peephole.m,v
retrieving revision 1.82
diff -u -b -r1.82 peephole.m
--- compiler/peephole.m	22 Mar 2005 06:40:17 -0000	1.82
+++ compiler/peephole.m	23 Aug 2005 10:26:24 -0000
@@ -1,4 +1,6 @@
 %-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
 % Copyright (C) 1994-1998,2002-2005 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.
@@ -21,7 +23,7 @@
 :- import_module list.
 
 	% Peephole optimize a list of instructions.
-
+    %
 :- pred peephole__optimize(gc_method::in, list(instruction)::in,
 	list(instruction)::out, bool::out) is det.
 
@@ -46,7 +48,7 @@
 	% optimizing the instruction sequence, we keep doing so;
 	% when we find a sequence we can't optimize, we back up and try
 	% to optimize the sequence starting with the previous instruction.
-
+    %
 peephole__optimize(GC_Method, Instrs0, Instrs, Mod) :-
 	peephole__invalid_opts(GC_Method, InvalidPatterns),
 	peephole__optimize_2(InvalidPatterns, Instrs0, Instrs, Mod).
@@ -58,8 +60,8 @@
 peephole__optimize_2(InvalidPatterns, [Instr0 - Comment | Instrs0],
 		Instrs, Mod) :-
 	peephole__optimize_2(InvalidPatterns, Instrs0, Instrs1, Mod0),
-	peephole__opt_instr(Instr0, Comment, InvalidPatterns, Instrs1,
-		Instrs, Mod1),
+    peephole__opt_instr(Instr0, Comment, InvalidPatterns, Instrs1, Instrs,
+        Mod1),
 	( Mod0 = no, Mod1 = no ->
 		Mod = no
 	;
@@ -68,15 +70,14 @@
 
 	% Try to optimize the beginning of the given instruction sequence.
 	% If successful, try it again.
-
+    %
 :- pred peephole__opt_instr(instr::in, string::in, list(pattern)::in,
 	list(instruction)::in, list(instruction)::out, bool::out) is det.
 
 peephole__opt_instr(Instr0, Comment0, InvalidPatterns, Instrs0, Instrs, Mod) :-
 	(
 		opt_util__skip_comments(Instrs0, Instrs1),
-		peephole__match(Instr0, Comment0, InvalidPatterns, Instrs1,
-			Instrs2)
+        peephole__match(Instr0, Comment0, InvalidPatterns, Instrs1, Instrs2)
 	->
 		( Instrs2 = [Instr2 - Comment2 | Instrs3] ->
 			peephole__opt_instr(Instr2, Comment2, InvalidPatterns,
@@ -94,7 +95,7 @@
 
 	% Build a map that associates each label in a computed goto with the
 	% values of the switch rval that cause a jump to it.
-
+    %
 :- pred peephole__build_jump_label_map(list(label)::in, int::in,
 	map(label, list(int))::in, map(label, list(int))::out) is det.
 
@@ -110,10 +111,9 @@
 	% If one of the two labels has only one associated value, return it and
 	% the associated value as the first two output arguments, and the
 	% remaining label as the last output argument.
-
+    %
 :- pred peephole__pick_one_val_label(pair(label, list(int))::in,
-	pair(label, list(int))::in, label::out, int::out, label::out)
-	is semidet.
+    pair(label, list(int))::in, label::out, int::out, label::out) is semidet.
 
 peephole__pick_one_val_label(LabelVals1, LabelVals2, OneValLabel, Val,
 		OtherLabel) :-
@@ -132,17 +132,17 @@
 	).
 
 	% Look for code patterns that can be optimized, and optimize them.
-
+    %
 :- pred peephole__match(instr::in, string::in, list(pattern)::in,
 	list(instruction)::in, list(instruction)::out) is semidet.
 
-	% A `computed_goto' with all branches pointing to the same
-	% label can be replaced with an unconditional goto.
+    % A `computed_goto' with all branches pointing to the same label
+    % can be replaced with an unconditional goto.
+    %
+    % A `computed_goto' with all branches but one pointing to the same label
+    % can be replaced with a conditional branch followed by an unconditional
+    % goto.
 	%
-	% A `computed_goto' with all branches but one pointing to the same
-	% label can be replaced with a conditional branch followed by an
-	% unconditional goto.
-
 peephole__match(computed_goto(SelectorRval, Labels), Comment, _,
 		Instrs0, Instrs) :-
 	peephole__build_jump_label_map(Labels, 0, map__init, LabelMap),
@@ -154,8 +154,8 @@
 		Instrs = [GotoInstr | Instrs0]
 	;
 		LabelValsList = [LabelVals1, LabelVals2],
-		peephole__pick_one_val_label(LabelVals1, LabelVals2,
-			OneValLabel, Val, OtherLabel)
+        peephole__pick_one_val_label(LabelVals1, LabelVals2, OneValLabel,
+            Val, OtherLabel)
 	->
 		CondRval = binop(eq, SelectorRval, const(int_const(Val))),
 		CommentInstr = comment(Comment) - "",
@@ -174,7 +174,7 @@
 	%
 	% 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)
@@ -224,7 +224,7 @@
 	%
 	% These two classes of patterns are mutually exclusive because if_val
 	% is not straight-line code.
-
+    %
 peephole__match(mkframe(NondetFrameInfo, yes(Redoip1)), Comment, _,
 		Instrs0, Instrs) :-
 	(
@@ -235,13 +235,12 @@
 		;
 			AllowedBases = [maxfr]
 		),
-		opt_util__next_assign_to_redoip(Instrs0, AllowedBases,
-			[], Redoip2, Skipped, Rest),
+        opt_util__next_assign_to_redoip(Instrs0, AllowedBases, [], Redoip2,
+            Skipped, Rest),
 		opt_util__touches_nondet_ctrl(Skipped, no)
 	->
 		list__append(Skipped, Rest, Instrs1),
-		Instrs = [mkframe(NondetFrameInfo, yes(Redoip2)) - Comment
-			| Instrs1]
+        Instrs = [mkframe(NondetFrameInfo, yes(Redoip2)) - Comment | Instrs1]
 	;
 		opt_util__skip_comments_livevals(Instrs0, Instrs1),
 		Instrs1 = [Instr1 | Instrs2],
@@ -251,10 +250,8 @@
 			( Target = do_redo ; Target = do_fail)
 		->
 			Instrs = [
-				if_val(Test, do_redo)
-					- Comment2,
-				mkframe(NondetFrameInfo, yes(do_fail))
-					- Comment
+                if_val(Test, do_redo) - Comment2,
+                mkframe(NondetFrameInfo, yes(do_fail)) - Comment
 				| Instrs2
 			]
 		;
@@ -264,20 +261,16 @@
 				Target = do_fail
 			->
 				Instrs = [
-					if_val(Test, do_redo)
-						- Comment2,
-					mkframe(NondetFrameInfo, yes(Redoip1))
-						- Comment
+                    if_val(Test, do_redo) - Comment2,
+                    mkframe(NondetFrameInfo, yes(Redoip1)) - Comment
 					| Instrs2
 				]
 			;
 				Target = do_redo
 			->
 				Instrs = [
-					mkframe(NondetFrameInfo, yes(Redoip1))
-						- Comment,
-					if_val(Test, Redoip1)
-						- Comment2
+                    mkframe(NondetFrameInfo, yes(Redoip1)) - Comment,
+                    if_val(Test, Redoip1) - Comment2
 					| Instrs2
 				]
 			;
@@ -293,7 +286,7 @@
 	%
 	%	store_ticket(Lval)	=>	store_ticket(Lval)
 	%	reset_ticket(Lval, _R)
-
+    %
 peephole__match(store_ticket(Lval), Comment, _, Instrs0, Instrs) :-
 	opt_util__skip_comments(Instrs0, Instrs1),
 	Instrs1 = [reset_ticket(lval(Lval), _Reason) - _Comment2 | Instrs2],
@@ -313,18 +306,17 @@
 	% and if the nondet stack linkages are not touched by the
 	% straight-line instructions, then we can discard the nondet stack
 	% frame early.
-
+    %
 peephole__match(assign(redoip(lval(Base)), Redoip), Comment, _,
 		Instrs0, Instrs) :-
 	(
-		opt_util__next_assign_to_redoip(Instrs0, [Base],
-			[], Redoip2, Skipped, Rest),
+        opt_util__next_assign_to_redoip(Instrs0, [Base], [], Redoip2,
+            Skipped, Rest),
 		opt_util__touches_nondet_ctrl(Skipped, no)
 	->
 		list__append(Skipped, Rest, Instrs1),
 		Instrs = [assign(redoip(lval(Base)),
-			const(code_addr_const(Redoip2))) - Comment
-			| Instrs1]
+            const(code_addr_const(Redoip2))) - Comment | Instrs1]
 	;
 		Base = curfr,
 		Redoip = const(code_addr_const(do_fail)),
@@ -332,8 +324,7 @@
 		opt_util__touches_nondet_ctrl(Between, no)
 	->
 		list__condense([Between,
-			[goto(do_succeed(yes)) - "early discard"], After],
-				Instrs)
+            [goto(do_succeed(yes)) - "early discard"], After], Instrs)
 	;
 		fail
 	).
@@ -351,7 +342,7 @@
 	%	<...>		=>	<...>
 	%	succip = detstackvar(N)
 	%	decr_sp N
-
+    %
 peephole__match(incr_sp(N, _), _, InvalidPatterns, Instrs0, Instrs) :-
 	\+ list__member(incr_sp, InvalidPatterns),
 	( opt_util__no_stackvars_til_decr_sp(Instrs0, N, Between, Remain) ->
@@ -362,9 +353,8 @@
 
 %-----------------------------------------------------------------------------%
 
-	% Given a GC method, return the list of invalid peephole
-	% optimizations.
-
+    % Given a GC method, return the list of invalid peephole optimizations.
+    %
 :- pred peephole__invalid_opts(gc_method::in, list(pattern)::out) is det.
 
 peephole__invalid_opts(GC_Method, InvalidPatterns) :-
Index: compiler/switch_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/switch_util.m,v
retrieving revision 1.21
diff -u -b -r1.21 switch_util.m
--- compiler/switch_util.m	22 Mar 2005 06:40:27 -0000	1.21
+++ compiler/switch_util.m	23 Aug 2005 08:16:05 -0000
@@ -1,4 +1,6 @@
 %-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
 % Copyright (C) 2000-2005 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.
@@ -33,6 +35,7 @@
 
 % An extended_case is an HLDS case annotated with some additional info.
 % The first (int) field is the priority, as computed by switch_priority/2.
+
 :- type extended_case ---> case(int, cons_tag, cons_id, hlds_goal).
 :- type cases_list == list(extended_case).
 
@@ -42,21 +45,22 @@
 	;	tag_switch
 	;	other_switch.
 
-:- func switch_util__type_cat_to_switch_cat(type_category) = switch_category.
+    % Convert a type category to a switch category.
+:- func type_cat_to_switch_cat(type_category) = switch_category.
 
 	% Return the priority of a constructor test.
 	% A low number here indicates a high priority.
 	% We prioritize the tag tests so that the cheapest
 	% (most efficient) ones come first.
 	%
-:- func switch_util__switch_priority(cons_tag) = int.
+:- func switch_priority(cons_tag) = int.
 
-	% switch_util__type_range(TypeCategory, Type, ModuleInfo, Min, Max):
+    % type_range(TypeCategory, Type, ModuleInfo, Min, Max):
 	% Determine the range [Min..Max] of an atomic type.
 	% Fail if the type isn't the sort of type that has a range
 	% or if the type's range is too big to switch on (e.g. int).
 	%
-:- pred switch_util__type_range(type_category::in, (type)::in, module_info::in,
+:- pred type_range(type_category::in, (type)::in, module_info::in,
 	int::out, int::out) is semidet.
 
 %-----------------------------------------------------------------------------%
@@ -64,26 +68,24 @@
 % Stuff for string hash switches
 %
 
-	% for a string switch, compute the hash value for each case
-	% in the list of cases, and store the cases in a map
-	% from hash values to cases.
-
-:- pred switch_util__string_hash_cases(cases_list::in, int::in,
-	map(int, cases_list)::out) is det.
-
-	% switch_util__calc_hash_slots(AssocList, HashMap, Map) :-
-	%	For each (HashVal - Case) pair in AssocList,
-	%	allocate a hash slot in Map for the case.
-	%	If the hash slot corresponding to HashVal is not
-	%	already used, then use that one.  Otherwise, find
-	%	the next spare slot (making sure that we don't
-	%	use slots which can be used for a direct match with
-	%	the hash value for one of the other cases), and
-	%	use it instead.
+    % For a string switch, compute the hash value for each case in the list
+    % of cases, and store the cases in a map from hash values to cases.
+    %
+:- pred string_hash_cases(cases_list::in, int::in, map(int, cases_list)::out)
+    is det.
 
 :- type hash_slot ---> hash_slot(extended_case, int).
 
-:- pred switch_util__calc_hash_slots(assoc_list(int, cases_list)::in,
+    % calc_hash_slots(AssocList, HashMap, Map):
+    %
+    % For each (HashVal - Case) pair in AssocList, allocate a hash slot in Map
+    % for the case. If the hash slot corresponding to HashVal is not already
+    % used, then use that one. Otherwise, find the next spare slot (making sure
+    % that we don't use slots which can be used for a direct match with the
+    % hash value for one of the other cases), and use it instead.
+    % Keep track of the hash chains as we do this.
+    %
+:- pred calc_hash_slots(assoc_list(int, cases_list)::in,
 	map(int, cases_list)::in, map(int, hash_slot)::out) is det.
 
 %-----------------------------------------------------------------------------%
@@ -91,26 +93,27 @@
 % Stuff for tag switches
 %
 
-% where is the secondary tag (if any) for this primary tag value
+% Where is the secondary tag (if any) for this primary tag value.
 :- type stag_loc	--->	none ; local ; remote.
 
-% map secondary tag values (-1 stands for none) to their goal
-:- type stag_goal_map	==	map(int, hlds_goal).
-:- type stag_goal_list	==	assoc_list(int, hlds_goal).
-
-% map primary tag values to the set of their goals
-:- type ptag_case_map	==	map(tag_bits, pair(stag_loc, stag_goal_map)).
-:- type ptag_case_list	==	assoc_list(tag_bits,
-					pair(stag_loc, stag_goal_map)).
+% Map secondary tag values (-1 stands for none) to their goal.
+:- type stag_goal ---> stag_goal(cons_id, hlds_goal).
+:- type stag_goal_map   ==  map(int, stag_goal).
+:- type stag_goal_list  ==  assoc_list(int, stag_goal).
+
+% Map primary tag values to the set of their goals.
+:- type ptag_case ---> ptag_case(stag_loc, stag_goal_map).
+:- type ptag_case_map   ==  map(tag_bits, ptag_case).
+:- type ptag_case_list  ==  assoc_list(tag_bits, ptag_case).
 
-% map primary tag values to the number of constructors sharing them
+% Map primary tag values to the number of constructors sharing them.
 :- type ptag_count_map	==	map(tag_bits, pair(stag_loc, int)).
 :- type ptag_count_list ==	assoc_list(tag_bits, pair(stag_loc, int)).
 
 	% Group together all the cases that depend on the given variable
 	% having the same primary tag value.
-
-:- pred switch_util__group_cases_by_ptag(cases_list::in,
+    %
+:- pred group_cases_by_ptag(cases_list::in,
 	ptag_case_map::in, ptag_case_map::out) is det.
 
 	% Order the primary tags based on the number of secondary tags
@@ -120,47 +123,49 @@
 	% this can happen in semidet switches, or in det switches
 	% where the initial inst of the switch variable is a bound(...) inst
 	% representing a subtype.
-
-:- pred switch_util__order_ptags_by_count(ptag_count_list::in,
+    %
+:- pred order_ptags_by_count(ptag_count_list::in,
 	ptag_case_map::in, ptag_case_list::out) is det.
 
-	% switch_util__order_ptags_by_value(FirstPtag, MaxPtag,
+    % order_ptags_by_value(FirstPtag, MaxPtag,
 	%	PtagCaseMap0, PtagCaseList):
 	% Order the primary tags based on their value, lowest value first.
 	% We scan through the primary tags values from zero to maximum.
 	% Note that it is not an error for a primary tag to have no case list,
 	% since this can happen in semidet switches.
-
-:- pred switch_util__order_ptags_by_value(int::in, int::in, ptag_case_map::in,
+    %
+:- pred order_ptags_by_value(int::in, int::in, ptag_case_map::in,
 	ptag_case_list::out) is det.
 
 	% Find out how many secondary tags share each primary tag
 	% of the given variable.
-
-:- pred switch_util__get_ptag_counts((type)::in, module_info::in,
+    %
+:- pred get_ptag_counts((type)::in, module_info::in,
 	int::out, ptag_count_map::out) is det.
 
 %-----------------------------------------------------------------------------%
 
 :- implementation.
 
+:- import_module parse_tree__error_util.
 :- import_module parse_tree__prog_type.
 
 :- import_module char.
 :- import_module int.
 :- import_module require.
 :- import_module string.
+:- import_module svmap.
 
 %-----------------------------------------------------------------------------%
 
-switch_util__string_hash_cases([], _, Map) :-
+string_hash_cases([], _, Map) :-
 	map__init(Map).
-switch_util__string_hash_cases([Case | Cases], HashMask, Map) :-
-	switch_util__string_hash_cases(Cases, HashMask, Map0),
+string_hash_cases([Case | Cases], HashMask, Map) :-
+    string_hash_cases(Cases, HashMask, Map0),
 	( Case = case(_, string_constant(String0), _, _) ->
 		String = String0
 	;
-		error("switch_util__string_hash_cases: non-string case?")
+        unexpected(this_file, "string_hash_cases: non-string case?")
 	),
 	string__hash(String, HashVal0),
 	HashVal = HashVal0 /\ HashMask,
@@ -170,78 +175,61 @@
 		map__det_insert(Map0, HashVal, [Case], Map)
 	).
 
-	% switch_util__calc_hash_slots(AssocList, HashMap, Map) :-
-	%	For each (HashVal - Case) pair in AssocList,
-	%	allocate a hash slot in Map for the case, as follows.
-	%	If the hash slot corresponding to HashVal is not
-	%	already used, then use that one.  Otherwise, find
-	%	the next spare slot (making sure that we don't
-	%	use slots which can be used for a direct match with
-	%	the hash value for one of the other cases), and
-	%	use it instead.  Keep track of the hash chains
-	%	as we do this.
-
-switch_util__calc_hash_slots(HashValList, HashMap, Map) :-
-	map__init(Map0),
-	switch_util__calc_hash_slots_1(HashValList, HashMap, Map0, Map, 0, _).
+calc_hash_slots(HashValList, HashMap, Map) :-
+    calc_hash_slots_1(HashValList, HashMap, map__init, Map, 0, _).
 
-:- pred switch_util__calc_hash_slots_1(assoc_list(int, cases_list)::in,
+:- pred calc_hash_slots_1(assoc_list(int, cases_list)::in,
 	map(int, cases_list)::in,
 	map(int, hash_slot)::in, map(int, hash_slot)::out,
 	int::in, int::out) is det.
 
-switch_util__calc_hash_slots_1([], _, !Map, !LastUsed).
-switch_util__calc_hash_slots_1([HashVal - Cases | Rest], HashMap,
+calc_hash_slots_1([], _, !Map, !LastUsed).
+calc_hash_slots_1([HashVal - Cases | Rest], HashMap,
 		!Map, !LastUsed) :-
-	switch_util__calc_hash_slots_2(Cases, HashVal, HashMap,
-		!Map, !LastUsed),
-	switch_util__calc_hash_slots_1(Rest, HashMap, !Map, !LastUsed).
+    calc_hash_slots_2(Cases, HashVal, HashMap, !Map, !LastUsed),
+    calc_hash_slots_1(Rest, HashMap, !Map, !LastUsed).
 
-:- pred switch_util__calc_hash_slots_2(cases_list::in, int::in,
+:- pred calc_hash_slots_2(cases_list::in, int::in,
 	map(int, cases_list)::in,
 	map(int, hash_slot)::in, map(int, hash_slot)::out,
 	int::in, int::out) is det.
 
-switch_util__calc_hash_slots_2([], _HashVal, _HashMap, !Map, !LastUsed).
-switch_util__calc_hash_slots_2([Case | Cases], HashVal, HashMap,
-		!Map, !LastUsed) :-
-	switch_util__calc_hash_slots_2(Cases, HashVal, HashMap,
-		!Map, !LastUsed),
+calc_hash_slots_2([], _HashVal, _HashMap, !Map, !LastUsed).
+calc_hash_slots_2([Case | Cases], HashVal, HashMap, !Map, !LastUsed) :-
+    calc_hash_slots_2(Cases, HashVal, HashMap, !Map, !LastUsed),
 	( map__contains(!.Map, HashVal) ->
-		switch_util__follow_hash_chain(!.Map, HashVal, ChainEnd),
-		switch_util__next_free_hash_slot(!.Map, HashMap, !LastUsed),
+        follow_hash_chain(!.Map, HashVal, ChainEnd),
+        next_free_hash_slot(!.Map, HashMap, !LastUsed),
 		map__lookup(!.Map, ChainEnd, hash_slot(PrevCase, _)),
-		map__det_update(!.Map, ChainEnd,
-			hash_slot(PrevCase, !.LastUsed), !:Map),
-		map__det_insert(!.Map, !.LastUsed, hash_slot(Case, -1), !:Map)
+        svmap__det_update(ChainEnd, hash_slot(PrevCase, !.LastUsed), !Map),
+        svmap__det_insert(!.LastUsed, hash_slot(Case, -1), !Map)
 	;
-		map__det_insert(!.Map, HashVal, hash_slot(Case, -1), !:Map)
+        svmap__det_insert(HashVal, hash_slot(Case, -1), !Map)
 	).
 
-:- pred switch_util__follow_hash_chain(map(int, hash_slot)::in,
-	int::in, int::out) is det.
+:- pred follow_hash_chain(map(int, hash_slot)::in, int::in, int::out) is det.
 
-switch_util__follow_hash_chain(Map, Slot, LastSlot) :-
+follow_hash_chain(Map, Slot, LastSlot) :-
 	map__lookup(Map, Slot, hash_slot(_, NextSlot)),
 	(
 		NextSlot >= 0,
 		map__contains(Map, NextSlot)
 	->
-		switch_util__follow_hash_chain(Map, NextSlot, LastSlot)
+        follow_hash_chain(Map, NextSlot, LastSlot)
 	;
 		LastSlot = Slot
 	).
 
-	% next_free_hash_slot(M, H_M, LastUsed, FreeSlot) :-
-	%	Find the next available slot FreeSlot in the hash table
-	%	which is not already used (contained in M) and which is not
-	%	going to be used a primary slot (contained in H_M),
-	%	starting at the slot after LastUsed.
-
-:- pred switch_util__next_free_hash_slot(map(int, hash_slot)::in,
+    % next_free_hash_slot(M, H_M, LastUsed, FreeSlot):
+    %
+    % Find the next available slot FreeSlot in the hash table which is not
+    % already used (contained in M) and which is not going to be used a
+    % primary slot (contained in H_M), starting at the slot after LastUsed.
+    %
+:- pred next_free_hash_slot(map(int, hash_slot)::in,
 	map(int, cases_list)::in, int::in, int::out) is det.
 
-switch_util__next_free_hash_slot(Map, H_Map, LastUsed, FreeSlot) :-
+next_free_hash_slot(Map, H_Map, LastUsed, FreeSlot) :-
 	NextSlot = LastUsed + 1,
 	(
 		\+ map__contains(Map, NextSlot),
@@ -249,8 +237,7 @@
 	->
 		FreeSlot = NextSlot
 	;
-		switch_util__next_free_hash_slot(Map, H_Map, NextSlot,
-			FreeSlot)
+        next_free_hash_slot(Map, H_Map, NextSlot, FreeSlot)
 	).
 
 %-----------------------------------------------------------------------------%
@@ -258,56 +245,46 @@
 % Stuff for categorizing switches
 %
 
-	% Convert a type category to a switch category
-switch_util__type_cat_to_switch_cat(enum_type) = atomic_switch.
-switch_util__type_cat_to_switch_cat(int_type) =  atomic_switch.
-switch_util__type_cat_to_switch_cat(char_type) = atomic_switch.
-switch_util__type_cat_to_switch_cat(float_type) = other_switch.
-switch_util__type_cat_to_switch_cat(str_type) =  string_switch.
-switch_util__type_cat_to_switch_cat(higher_order_type) = other_switch.
-switch_util__type_cat_to_switch_cat(user_ctor_type) = tag_switch.
-switch_util__type_cat_to_switch_cat(variable_type) = other_switch.
-switch_util__type_cat_to_switch_cat(tuple_type) = other_switch.
-switch_util__type_cat_to_switch_cat(void_type) = _ :-
-	error("switch_util__type_cat_to_switch_cat: void").
-switch_util__type_cat_to_switch_cat(type_info_type) = _ :-
-	error("switch_util__type_cat_to_switch_cat: type_info").
-switch_util__type_cat_to_switch_cat(type_ctor_info_type) = _ :-
-	error("switch_util__type_cat_to_switch_cat: type_ctor_info").
-switch_util__type_cat_to_switch_cat(typeclass_info_type) = _ :-
-	error("switch_util__type_cat_to_switch_cat: typeclass_info").
-switch_util__type_cat_to_switch_cat(base_typeclass_info_type) = _ :-
-	error("switch_util__type_cat_to_switch_cat: base_typeclass_info").
-
-	% Return the priority of a constructor test.
-	% A low number here indicates a high priority.
-	% We prioritize the tag tests so that the cheapest
-	% (most efficient) ones come first.
-	%
-switch_util__switch_priority(no_tag) = 0.		% should never occur
-switch_util__switch_priority(int_constant(_)) = 1.
-switch_util__switch_priority(reserved_address(_)) = 1.
-switch_util__switch_priority(shared_local_tag(_, _)) = 1.
-switch_util__switch_priority(single_functor) = 2.
-switch_util__switch_priority(unshared_tag(_)) = 2.
-switch_util__switch_priority(float_constant(_)) = 3.
-switch_util__switch_priority(shared_remote_tag(_, _)) = 4.
-switch_util__switch_priority(string_constant(_)) = 5.
-switch_util__switch_priority(shared_with_reserved_addresses(RAs, Tag)) =
-	switch_util__switch_priority(Tag) + list__length(RAs).
+type_cat_to_switch_cat(enum_type) = atomic_switch.
+type_cat_to_switch_cat(int_type) =  atomic_switch.
+type_cat_to_switch_cat(char_type) = atomic_switch.
+type_cat_to_switch_cat(float_type) = other_switch.
+type_cat_to_switch_cat(str_type) =  string_switch.
+type_cat_to_switch_cat(higher_order_type) = other_switch.
+type_cat_to_switch_cat(user_ctor_type) = tag_switch.
+type_cat_to_switch_cat(variable_type) = other_switch.
+type_cat_to_switch_cat(tuple_type) = other_switch.
+type_cat_to_switch_cat(void_type) = _ :-
+    unexpected(this_file, "type_cat_to_switch_cat: void").
+type_cat_to_switch_cat(type_info_type) = _ :-
+    unexpected(this_file, "type_cat_to_switch_cat: type_info").
+type_cat_to_switch_cat(type_ctor_info_type) = _ :-
+    unexpected(this_file, "type_cat_to_switch_cat: type_ctor_info").
+type_cat_to_switch_cat(typeclass_info_type) = _ :-
+    unexpected(this_file, "type_cat_to_switch_cat: typeclass_info").
+type_cat_to_switch_cat(base_typeclass_info_type) = _ :-
+    unexpected(this_file, "type_cat_to_switch_cat: base_typeclass_info").
+
+switch_priority(no_tag) = 0.       % should never occur
+switch_priority(int_constant(_)) = 1.
+switch_priority(reserved_address(_)) = 1.
+switch_priority(shared_local_tag(_, _)) = 1.
+switch_priority(single_functor) = 2.
+switch_priority(unshared_tag(_)) = 2.
+switch_priority(float_constant(_)) = 3.
+switch_priority(shared_remote_tag(_, _)) = 4.
+switch_priority(string_constant(_)) = 5.
+switch_priority(shared_with_reserved_addresses(RAs, Tag)) =
+    switch_priority(Tag) + list__length(RAs).
 	% The following tags should all never occur in switches.
-switch_util__switch_priority(pred_closure_tag(_, _, _)) = 6.
-switch_util__switch_priority(type_ctor_info_constant(_, _, _)) = 6.
-switch_util__switch_priority(base_typeclass_info_constant(_, _, _)) = 6.
-switch_util__switch_priority(tabling_pointer_constant(_, _)) = 6.
-switch_util__switch_priority(deep_profiling_proc_layout_tag(_, _)) = 6.
-switch_util__switch_priority(table_io_decl_tag(_, _)) = 6.
+switch_priority(pred_closure_tag(_, _, _)) = 6.
+switch_priority(type_ctor_info_constant(_, _, _)) = 6.
+switch_priority(base_typeclass_info_constant(_, _, _)) = 6.
+switch_priority(tabling_pointer_constant(_, _)) = 6.
+switch_priority(deep_profiling_proc_layout_tag(_, _)) = 6.
+switch_priority(table_io_decl_tag(_, _)) = 6.
 
-	% Determine the range of an atomic type.
-	% Fail if the type isn't the sort of type that has a range
-	% or if the type's range is to big to switch on (e.g. int).
-	%
-switch_util__type_range(char_type, _, _, MinChar, MaxChar) :-
+type_range(char_type, _, _, MinChar, MaxChar) :-
 	% XXX the following code uses the host's character size,
 	% not the target's, so it won't work if cross-compiling
 	% to a machine with a different character size.
@@ -315,11 +292,11 @@
 	% in lookup_switch.m assume that char__min_char_value is 0.
 	char__min_char_value(MinChar),
 	char__max_char_value(MaxChar).
-switch_util__type_range(enum_type, Type, ModuleInfo, 0, MaxEnum) :-
+type_range(enum_type, Type, ModuleInfo, 0, MaxEnum) :-
 	( type_to_ctor_and_args(Type, TypeCtorPrime, _) ->
 		TypeCtor = TypeCtorPrime
 	;
-		error("dense_switch__type_range: invalid enum type?")
+        unexpected(this_file, "dense_switch__type_range: invalid enum type?")
 	),
 	module_info_types(ModuleInfo, TypeTable),
 	map__lookup(TypeTable, TypeCtor, TypeDefn),
@@ -328,7 +305,7 @@
 		map__count(ConsTable, TypeRange),
 		MaxEnum = TypeRange - 1
 	;
-		error("dense_switch__type_range: enum type is not d.u. type?")
+        unexpected(this_file, "type_range: enum type is not d.u. type?")
 	).
 
 %-----------------------------------------------------------------------------%
@@ -336,11 +313,11 @@
 	% Find out how many secondary tags share each primary tag
 	% of the given variable.
 
-switch_util__get_ptag_counts(Type, ModuleInfo, MaxPrimary, PtagCountMap) :-
+get_ptag_counts(Type, ModuleInfo, MaxPrimary, PtagCountMap) :-
 	( type_to_ctor_and_args(Type, TypeCtorPrime, _) ->
 		TypeCtor = TypeCtorPrime
 	;
-		error("unknown type in switch_util__get_ptag_counts")
+        unexpected(this_file, "unknown type in get_ptag_counts")
 	),
 	module_info_types(ModuleInfo, TypeTable),
 	map__lookup(TypeTable, TypeCtor, TypeDefn),
@@ -349,18 +326,16 @@
 		map__to_assoc_list(ConsTable, ConsList),
 		assoc_list__values(ConsList, TagList)
 	;
-		error("non-du type in switch_util__get_ptag_counts")
+        unexpected(this_file, "non-du type in get_ptag_counts")
 	),
 	map__init(PtagCountMap0),
-	switch_util__get_ptag_counts_2(TagList, -1, MaxPrimary,
-		PtagCountMap0, PtagCountMap).
+    get_ptag_counts_2(TagList, -1, MaxPrimary, PtagCountMap0, PtagCountMap).
 
-:- pred switch_util__get_ptag_counts_2(list(cons_tag)::in, int::in, int::out,
+:- pred get_ptag_counts_2(list(cons_tag)::in, int::in, int::out,
 	ptag_count_map::in, ptag_count_map::out) is det.
 
-switch_util__get_ptag_counts_2([], !Max, !PtagCountMap).
-switch_util__get_ptag_counts_2([ConsTag | TagList], !MaxPrimary,
-		!PtagCountMap) :-
+get_ptag_counts_2([], !Max, !PtagCountMap).
+get_ptag_counts_2([ConsTag | TagList], !MaxPrimary, !PtagCountMap) :-
 	(
 		( ConsTag = single_functor, Primary = 0
 		; ConsTag = unshared_tag(Primary)
@@ -368,7 +343,7 @@
 	->
 		int__max(Primary, !MaxPrimary),
 		( map__search(!.PtagCountMap, Primary, _) ->
-			error("unshared tag is shared")
+            unexpected(this_file, "unshared tag is shared")
 		;
 			map__det_insert(!.PtagCountMap, Primary, none - (-1),
 				!:PtagCountMap)
@@ -380,7 +355,7 @@
 			( TagType = remote ->
 				true
 			;
-				error("remote tag is shared with non-remote")
+                unexpected(this_file, "remote tag is shared with non-remote")
 			),
 			int__max(Secondary, MaxSoFar, Max),
 			map__det_update(!.PtagCountMap, Primary, remote - Max,
@@ -396,7 +371,7 @@
 			( TagType = local ->
 				true
 			;
-				error("local tag is shared with non-local")
+                unexpected(this_file, "local tag is shared with non-local")
 			),
 			int__max(Secondary, MaxSoFar, Max),
 			map__det_update(!.PtagCountMap, Primary, local - Max,
@@ -406,73 +381,64 @@
 				local - Secondary, !:PtagCountMap)
 		)
 	;
-		error("non-du tag in switch_util__get_ptag_counts_2")
+        unexpected(this_file, "non-du tag in get_ptag_counts_2")
 	),
-	switch_util__get_ptag_counts_2(TagList, !MaxPrimary, !PtagCountMap).
+    get_ptag_counts_2(TagList, !MaxPrimary, !PtagCountMap).
 
 %-----------------------------------------------------------------------------%
 
 	% Group together all the cases that depend on the given variable
 	% having the same primary tag value.
 
-switch_util__group_cases_by_ptag([], !PtagCaseMap).
-switch_util__group_cases_by_ptag([Case0 | Cases0], !PtagCaseMap) :-
-	Case0 = case(_Priority, Tag, _ConsId, Goal),
+group_cases_by_ptag([], !PtagCaseMap).
+group_cases_by_ptag([Case0 | Cases0], !PtagCaseMap) :-
+    Case0 = case(_Priority, Tag, ConsId, Goal),
+    ConsIdGoal = stag_goal(ConsId, Goal),
 	(
 		( Tag = single_functor, Primary = 0
 		; Tag = unshared_tag(Primary)
 		)
 	->
 		( map__search(!.PtagCaseMap, Primary, _Group) ->
-			error("unshared tag is shared")
+            unexpected(this_file, "unshared tag is shared")
 		;
 			map__init(StagGoalMap0),
-			map__det_insert(StagGoalMap0, -1, Goal, StagGoalMap),
-			map__det_insert(!.PtagCaseMap, Primary,
-				none - StagGoalMap, !:PtagCaseMap)
+            map__det_insert(StagGoalMap0, -1, ConsIdGoal, StagGoalMap),
+            svmap__det_insert(Primary, ptag_case(none, StagGoalMap),
+                !PtagCaseMap)
 		)
 	; Tag = shared_remote_tag(Primary, Secondary) ->
 		( map__search(!.PtagCaseMap, Primary, Group) ->
-			Group = StagLoc - StagGoalMap0,
-			( StagLoc = remote ->
-				true
-			;
-				error("remote tag is shared with non-remote")
-			),
-			map__det_insert(StagGoalMap0, Secondary, Goal,
-				StagGoalMap),
-			map__det_update(!.PtagCaseMap, Primary,
-				remote - StagGoalMap, !:PtagCaseMap)
+            Group = ptag_case(StagLoc, StagGoalMap0),
+            require(unify(StagLoc, remote),
+                "remote tag is shared with non-remote"),
+            map__det_insert(StagGoalMap0, Secondary, ConsIdGoal, StagGoalMap),
+            svmap__det_update(Primary, ptag_case(remote, StagGoalMap),
+                !PtagCaseMap)
 		;
 			map__init(StagGoalMap0),
-			map__det_insert(StagGoalMap0, Secondary, Goal,
-				StagGoalMap),
-			map__det_insert(!.PtagCaseMap, Primary,
-				remote - StagGoalMap, !:PtagCaseMap)
+            map__det_insert(StagGoalMap0, Secondary, ConsIdGoal, StagGoalMap),
+            svmap__det_insert(Primary, ptag_case(remote, StagGoalMap),
+                !PtagCaseMap)
 		)
 	; Tag = shared_local_tag(Primary, Secondary) ->
 		( map__search(!.PtagCaseMap, Primary, Group) ->
-			Group = StagLoc - StagGoalMap0,
-			( StagLoc = local ->
-				true
-			;
-				error("local tag is shared with non-local")
-			),
-			map__det_insert(StagGoalMap0, Secondary, Goal,
-				StagGoalMap),
-			map__det_update(!.PtagCaseMap, Primary,
-				local - StagGoalMap, !:PtagCaseMap)
+            Group = ptag_case(StagLoc, StagGoalMap0),
+            require(unify(StagLoc, local),
+                "local tag is shared with non-local"),
+            map__det_insert(StagGoalMap0, Secondary, ConsIdGoal, StagGoalMap),
+            svmap__det_update(Primary, ptag_case(local, StagGoalMap),
+                !PtagCaseMap)
 		;
 			map__init(StagGoalMap0),
-			map__det_insert(StagGoalMap0, Secondary, Goal,
-				StagGoalMap),
-			map__det_insert(!.PtagCaseMap, Primary,
-				local - StagGoalMap, !:PtagCaseMap)
+            map__det_insert(StagGoalMap0, Secondary, ConsIdGoal, StagGoalMap),
+            svmap__det_insert(Primary, ptag_case(local, StagGoalMap),
+                !PtagCaseMap)
 		)
 	;
-		error("non-du tag in switch_util__group_cases_by_ptag")
+        unexpected(this_file, "non-du tag in group_cases_by_ptag")
 	),
-	switch_util__group_cases_by_ptag(Cases0, !PtagCaseMap).
+    group_cases_by_ptag(Cases0, !PtagCaseMap).
 
 %-----------------------------------------------------------------------------%
 
@@ -486,41 +452,35 @@
 	%
 	% We use selection sort.
 
-switch_util__order_ptags_by_count(PtagCountList0, PtagCaseMap0, PtagCaseList) :-
-	(
-		switch_util__select_frequent_ptag(PtagCountList0,
-			Primary, _, PtagCountList1)
-	->
+order_ptags_by_count(PtagCountList0, PtagCaseMap0, PtagCaseList) :-
+    ( select_frequent_ptag(PtagCountList0, Primary, _, PtagCountList1) ->
 		( map__search(PtagCaseMap0, Primary, PtagCase) ->
 			map__delete(PtagCaseMap0, Primary, PtagCaseMap1),
-			switch_util__order_ptags_by_count(PtagCountList1,
-				PtagCaseMap1, PtagCaseList1),
+            order_ptags_by_count(PtagCountList1, PtagCaseMap1, PtagCaseList1),
 			PtagCaseList = [Primary - PtagCase | PtagCaseList1]
 		;
-			switch_util__order_ptags_by_count(PtagCountList1,
-				PtagCaseMap0, PtagCaseList)
+            order_ptags_by_count(PtagCountList1, PtagCaseMap0, PtagCaseList)
 		)
 	;
 		( map__is_empty(PtagCaseMap0) ->
 			PtagCaseList = []
 		;
-			error("PtagCaseMap0 is not empty in " ++
-				"switch_util__order_ptags_by_count")
+            unexpected(this_file,
+                "PtagCaseMap0 is not empty in order_ptags_by_count")
 		)
 	).
 
 	% Select the most frequently used primary tag based on the number of
 	% secondary tags associated with it.
-
-:- pred switch_util__select_frequent_ptag(ptag_count_list::in, tag_bits::out,
+    %
+:- pred select_frequent_ptag(ptag_count_list::in, tag_bits::out,
 	int::out, ptag_count_list::out) is semidet.
 
-switch_util__select_frequent_ptag([PtagCount0 | PtagCountList1], Primary,
+select_frequent_ptag([PtagCount0 | PtagCountList1], Primary,
 		Count, PtagCountList) :-
 	PtagCount0 = Primary0 - (_ - Count0),
 	(
-		switch_util__select_frequent_ptag(PtagCountList1,
-			Primary1, Count1, PtagCountList2),
+        select_frequent_ptag(PtagCountList1, Primary1, Count1, PtagCountList2),
 		Count1 > Count0
 	->
 		Primary = Primary1,
@@ -539,25 +499,30 @@
 	% Note that it is not an error for a primary tag to have no case list,
 	% since this can happen in semidet switches.
 
-switch_util__order_ptags_by_value(Ptag, MaxPtag, PtagCaseMap0, PtagCaseList) :-
+order_ptags_by_value(Ptag, MaxPtag, PtagCaseMap0, PtagCaseList) :-
 	( MaxPtag >= Ptag ->
 		NextPtag = Ptag + 1,
 		( map__search(PtagCaseMap0, Ptag, PtagCase) ->
 			map__delete(PtagCaseMap0, Ptag, PtagCaseMap1),
-			switch_util__order_ptags_by_value(NextPtag, MaxPtag,
+            order_ptags_by_value(NextPtag, MaxPtag,
 				PtagCaseMap1, PtagCaseList1),
 			PtagCaseList = [Ptag - PtagCase | PtagCaseList1]
 		;
-			switch_util__order_ptags_by_value(NextPtag, MaxPtag,
-				PtagCaseMap0, PtagCaseList)
+            order_ptags_by_value(NextPtag, MaxPtag, PtagCaseMap0, PtagCaseList)
 		)
 	;
 		( map__is_empty(PtagCaseMap0) ->
 			PtagCaseList = []
 		;
-			error("PtagCaseMap0 is not empty in " ++
-				"order_ptags_by_value")
+            unexpected(this_file,
+                "PtagCaseMap0 is not empty in order_ptags_by_value")
 		)
 	).
+
+%-----------------------------------------------------------------------------%
+
+:- func this_file = string.
+
+this_file = "switch_util.m".
 
 %-----------------------------------------------------------------------------%
Index: compiler/tag_switch.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/tag_switch.m,v
retrieving revision 1.62
diff -u -b -r1.62 tag_switch.m
--- compiler/tag_switch.m	22 Mar 2005 06:40:27 -0000	1.62
+++ compiler/tag_switch.m	23 Aug 2005 08:42:22 -0000
@@ -1,4 +1,6 @@
 %-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
 % Copyright (C) 1994-2000,2002-2005 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.
@@ -25,7 +27,7 @@
 :- import_module list.
 
 	% Generate intelligent indexing code for tag based switches.
-
+    %
 :- pred tag_switch__generate(list(extended_case)::in, prog_var::in,
 	code_model::in, can_fail::in, hlds_goal_info::in, label::in,
 	branch_end::in, branch_end::out, code_tree::out,
@@ -37,12 +39,14 @@
 :- import_module check_hlds__type_util.
 :- import_module hlds__hlds_llds.
 :- import_module hlds__hlds_module.
+:- import_module hlds__hlds_out.
 :- import_module hlds__hlds_pred.
 :- import_module libs__globals.
 :- import_module libs__options.
 :- import_module libs__tree.
 :- import_module ll_backend__code_gen.
 :- import_module ll_backend__trace.
+:- import_module parse_tree__error_util.
 :- import_module parse_tree__prog_data.
 
 :- import_module assoc_list.
@@ -117,7 +121,7 @@
 	%
 	% Note that for a det switch with two tag values, try-me-else chains
 	% and try chains are equivalent.
-
+    %
 	% Which method is best depends on the number of possible tag values,
 	% on the costs of taken/untaken branches and table lookups on the given
 	% architecture, and on the frequency with which the various
@@ -178,15 +182,16 @@
 	% want the more frequently reached cases to be in the half that
 	% immediately follows the if statement implementing the decision.
 
-:- type switch_method	--->	try_me_else_chain
+:- type switch_method
+    --->    try_me_else_chain
 			;	try_chain
 			;	jump_table
 			;	binary_search.
 
-tag_switch__generate(Cases, Var, CodeModel, CanFail, SwitchGoalInfo, EndLabel,
-		!MaybeEnd, Code, !CI) :-
-	% group the cases based on primary tag value
-	% and find out how many constructors share each primary tag value
+generate(Cases, Var, CodeModel, CanFail, SwitchGoalInfo, EndLabel, !MaybeEnd,
+        Code, !CI) :-
+    % Group the cases based on primary tag value and find out how many
+    % constructors share each primary tag value.
 
 	code_info__get_module_info(!.CI, ModuleInfo),
 	code_info__get_proc_info(!.CI, ProcInfo),
@@ -232,21 +237,19 @@
 	(
 		PrimaryMethod \= jump_table,
 		PtagsUsed >= 2,
-		globals__lookup_int_option(Globals, num_real_r_regs,
-			NumRealRegs),
+        globals__lookup_int_option(Globals, num_real_r_regs, NumRealRegs),
 		(
 			NumRealRegs = 0
 		;
 			( PtagReg = reg(r, PtagRegNo) ->
 				PtagRegNo =< NumRealRegs
 			;
-				error("improper reg in tag switch")
+                unexpected(this_file, "improper reg in tag switch")
 			)
 		)
 	->
 		PtagCode = node([
-			assign(PtagReg, unop(tag, VarRval))
-				- "compute tag to switch on"
+            assign(PtagReg, unop(tag, VarRval)) - "compute tag to switch on"
 		]),
 		PtagRval = lval(PtagReg)
 	;
@@ -258,15 +261,10 @@
 	% a primary tag may not be the last case overall.
 
 	code_info__get_next_label(FailLabel, !CI),
-	FailLabelCode = node([
-		label(FailLabel) -
-			"switch has failed"
-	]),
+    FailLabelCode = node([label(FailLabel) - "switch has failed"]),
 	(
 		CanFail = cannot_fail,
-		FailCode = node([
-			goto(do_not_reached) - "oh-oh, det switch failed"
-		])
+        FailCode = node([goto(do_not_reached) - "oh-oh, det switch failed"])
 	;
 		CanFail = can_fail,
 		code_info__generate_failure(FailCode, !CI)
@@ -279,21 +277,18 @@
 		PrimaryMethod = binary_search,
 		switch_util__order_ptags_by_value(0, MaxPrimary, PtagCaseMap,
 			PtagCaseList),
-		tag_switch__generate_primary_binary_search(PtagCaseList,
-			0, MaxPrimary, PtagRval, VarRval, CodeModel, CanFail,
-			SwitchGoalInfo, EndLabel, FailLabel, PtagCountMap,
-			!MaybeEnd, CasesCode, !CI)
+        generate_primary_binary_search(PtagCaseList, 0, MaxPrimary, PtagRval,
+            VarRval, CodeModel, CanFail, SwitchGoalInfo, EndLabel, FailLabel,
+            PtagCountMap, !MaybeEnd, CasesCode, !CI)
 	;
 		PrimaryMethod = jump_table,
 		switch_util__order_ptags_by_value(0, MaxPrimary, PtagCaseMap,
 			PtagCaseList),
-		tag_switch__generate_primary_jump_table(PtagCaseList,
-			0, MaxPrimary, VarRval, CodeModel, SwitchGoalInfo,
-			EndLabel, FailLabel, PtagCountMap, !MaybeEnd,
-			Labels, TableCode, !CI),
+        generate_primary_jump_table(PtagCaseList, 0, MaxPrimary, VarRval,
+            CodeModel, SwitchGoalInfo, EndLabel, FailLabel, PtagCountMap,
+            !MaybeEnd, Labels, TableCode, !CI),
 		SwitchCode = node([
-			computed_goto(PtagRval, Labels) -
-				"switch on primary tag"
+            computed_goto(PtagRval, Labels) - "switch on primary tag"
 		]),
 		CasesCode = tree(SwitchCode, TableCode)
 	;
@@ -308,79 +303,66 @@
 		;
 			PtagCaseList = PtagCaseList0
 		),
-		tag_switch__generate_primary_try_chain(PtagCaseList,
-			PtagRval, VarRval, CodeModel, CanFail, SwitchGoalInfo,
-			EndLabel, FailLabel, PtagCountMap, empty, empty,
-			!MaybeEnd, CasesCode, !CI)
+        generate_primary_try_chain(PtagCaseList, PtagRval, VarRval, CodeModel,
+            CanFail, SwitchGoalInfo, EndLabel, FailLabel, PtagCountMap,
+            empty, empty, !MaybeEnd, CasesCode, !CI)
 	;
 		PrimaryMethod = try_me_else_chain,
 		switch_util__order_ptags_by_count(PtagCountList, PtagCaseMap,
 			PtagCaseList),
-		tag_switch__generate_primary_try_me_else_chain(PtagCaseList,
-			PtagRval, VarRval, CodeModel, CanFail, SwitchGoalInfo,
-			EndLabel, FailLabel, PtagCountMap, !MaybeEnd,
-			CasesCode, !CI)
+        generate_primary_try_me_else_chain(PtagCaseList, PtagRval, VarRval,
+            CodeModel, CanFail, SwitchGoalInfo, EndLabel, FailLabel,
+            PtagCountMap, !MaybeEnd, CasesCode, !CI)
 	),
-	Code =
-		tree(VarCode,
-		tree(PtagCode,
-		tree(CasesCode,
-		tree(LabelledFailCode,
-		     EndCode)))).
+    Code = tree_list([VarCode, PtagCode, CasesCode, LabelledFailCode,
+        EndCode]).
 
 %-----------------------------------------------------------------------------%
 
 	% Generate a switch on a primary tag value using a try-me-else chain.
-
-:- pred tag_switch__generate_primary_try_me_else_chain(ptag_case_list::in,
+    %
+:- pred generate_primary_try_me_else_chain(ptag_case_list::in,
 	rval::in, rval::in, code_model::in, can_fail::in, hlds_goal_info::in,
 	label::in, label::in, ptag_count_map::in,
 	branch_end::in, branch_end::out, code_tree::out,
 	code_info::in, code_info::out) is det.
 
-tag_switch__generate_primary_try_me_else_chain([], _, _, _, _, _, _, _, _, _,
-		_, _, !CI) :-
-	error("generate_primary_try_me_else_chain: empty switch").
-tag_switch__generate_primary_try_me_else_chain([PtagGroup | PtagGroups],
-		TagRval, VarRval, CodeModel, CanFail, SwitchGoalInfo,
-		EndLabel, FailLabel, PtagCountMap, !MaybeEnd, Code, !CI) :-
-	PtagGroup = Primary - (StagLoc - StagGoalMap),
+generate_primary_try_me_else_chain([], _, _, _, _, _, _, _, _, _, _, _, !CI) :-
+    unexpected(this_file, "generate_primary_try_me_else_chain: empty switch").
+generate_primary_try_me_else_chain([PtagGroup | PtagGroups], TagRval, VarRval,
+        CodeModel, CanFail, SwitchGoalInfo, EndLabel, FailLabel, PtagCountMap,
+        !MaybeEnd, Code, !CI) :-
+    PtagGroup = Primary - ptag_case(StagLoc, StagGoalMap),
 	map__lookup(PtagCountMap, Primary, CountInfo),
 	CountInfo = StagLoc1 - MaxSecondary,
-	( StagLoc = StagLoc1 ->
-		true
-	;
-		error("secondary tag locations differ in generate_primary_try_me_else_chain")
-	),
-	( ( PtagGroups = [_|_] ; CanFail = can_fail ) ->
+    require(unify(StagLoc, StagLoc1),
+        "generate_primary_try_me_else_chain: secondary tag locations differ"),
+    (
+        ( PtagGroups = [_ | _]
+        ; CanFail = can_fail
+        )
+    ->
 		code_info__remember_position(!.CI, BranchStart),
 		code_info__get_next_label(ElseLabel, !CI),
 		TestRval = binop(ne, TagRval,
 			unop(mktag, const(int_const(Primary)))),
 		TestCode = node([
-			if_val(TestRval, label(ElseLabel)) -
-				"test primary tag only"
+            if_val(TestRval, label(ElseLabel)) - "test primary tag only"
 		]),
-		tag_switch__generate_primary_tag_code(StagGoalMap,
-			Primary, MaxSecondary, StagLoc, VarRval, CodeModel,
-			SwitchGoalInfo, EndLabel, FailLabel, !MaybeEnd,
+        generate_primary_tag_code(StagGoalMap, Primary, MaxSecondary, StagLoc,
+            VarRval, CodeModel, SwitchGoalInfo, EndLabel, FailLabel, !MaybeEnd,
 			TagCode, !CI),
-		ElseCode = node([
-			label(ElseLabel) -
-				"handle next primary tag"
-		]),
-		ThisTagCode =
-			tree(TestCode,
-			tree(TagCode,
-			     ElseCode)),
-		( PtagGroups = [_|_] ->
+        ElseCode = node([label(ElseLabel) - "handle next primary tag"]),
+        ThisTagCode = tree_list([TestCode, TagCode, ElseCode]),
+        (
+            PtagGroups = [_ | _],
 			code_info__reset_to_position(BranchStart, !CI),
-			tag_switch__generate_primary_try_me_else_chain(
-				PtagGroups, TagRval, VarRval, CodeModel,
-				CanFail, SwitchGoalInfo, EndLabel, FailLabel,
+            generate_primary_try_me_else_chain(PtagGroups, TagRval, VarRval,
+                CodeModel, CanFail, SwitchGoalInfo, EndLabel, FailLabel,
 				PtagCountMap, !MaybeEnd, OtherTagsCode, !CI),
 			Code = tree(ThisTagCode, OtherTagsCode)
 		;
+            PtagGroups = [],
 			% FailLabel ought to be the next label anyway,
 			% so this goto will be optimized away (unless the
 			% layout of the failcode in the caller changes).
@@ -391,64 +373,57 @@
 			Code = tree(ThisTagCode, FailCode)
 		)
 	;
-		tag_switch__generate_primary_tag_code(StagGoalMap,
-			Primary, MaxSecondary, StagLoc, VarRval, CodeModel,
-			SwitchGoalInfo, EndLabel, FailLabel, !MaybeEnd, Code,
-			!CI)
+        generate_primary_tag_code(StagGoalMap, Primary, MaxSecondary, StagLoc,
+            VarRval, CodeModel, SwitchGoalInfo, EndLabel, FailLabel, !MaybeEnd,
+            Code, !CI)
 	).
 
 %-----------------------------------------------------------------------------%
 
 	% Generate a switch on a primary tag value using a try chain.
-
-:- pred tag_switch__generate_primary_try_chain(ptag_case_list::in,
+    %
+:- pred generate_primary_try_chain(ptag_case_list::in,
 	rval::in, rval::in, code_model::in, can_fail::in, hlds_goal_info::in,
 	label::in, label::in, ptag_count_map::in, code_tree::in, code_tree::in,
 	branch_end::in, branch_end::out, code_tree::out,
 	code_info::in, code_info::out) is det.
 
-tag_switch__generate_primary_try_chain([], _, _, _, _, _, _, _, _, _, _, _,
-		_, _, !CI) :-
-	 error("empty list in generate_primary_try_chain").
-tag_switch__generate_primary_try_chain([PtagGroup | PtagGroups],
-		TagRval, VarRval, CodeModel, CanFail, SwitchGoalInfo, EndLabel,
-		FailLabel, PtagCountMap, PrevTests0, PrevCases0,
-		!MaybeEnd, Code, !CI) :-
-	PtagGroup = Primary - (StagLoc - StagGoalMap),
+generate_primary_try_chain([], _, _, _, _, _, _, _, _, _, _, _, _, _, !CI) :-
+     unexpected(this_file, "empty list in generate_primary_try_chain").
+generate_primary_try_chain([PtagGroup | PtagGroups], TagRval, VarRval,
+        CodeModel, CanFail, SwitchGoalInfo, EndLabel, FailLabel, PtagCountMap,
+        PrevTests0, PrevCases0, !MaybeEnd, Code, !CI) :-
+    PtagGroup = Primary - ptag_case(StagLoc, StagGoalMap),
 	map__lookup(PtagCountMap, Primary, CountInfo),
 	CountInfo = StagLoc1 - MaxSecondary,
-	( StagLoc = StagLoc1 ->
-		true
-	;
-		error("secondary tag locations differ in generate_primary_try_chain")
-	),
-	( ( PtagGroups = [_|_] ; CanFail = can_fail ) ->
+    require(unify(StagLoc, StagLoc1),
+        "secondary tag locations differ in generate_primary_try_chain"),
+    (
+        ( PtagGroups = [_ | _]
+        ; CanFail = can_fail
+        )
+    ->
 		code_info__remember_position(!.CI, BranchStart),
 		code_info__get_next_label(ThisPtagLabel, !CI),
 		TestRval = binop(eq, TagRval,
 			unop(mktag, const(int_const(Primary)))),
 		TestCode = node([
-			if_val(TestRval, label(ThisPtagLabel)) -
-				"test primary tag only"
-		]),
-		LabelCode = node([
-			label(ThisPtagLabel) -
-				"this primary tag"
+            if_val(TestRval, label(ThisPtagLabel)) - "test primary tag only"
 		]),
-		tag_switch__generate_primary_tag_code(StagGoalMap,
-			Primary, MaxSecondary, StagLoc, VarRval, CodeModel,
-			SwitchGoalInfo, EndLabel, FailLabel,
-			!MaybeEnd, TagCode, !CI),
+        LabelCode = node([label(ThisPtagLabel) - "this primary tag"]),
+        generate_primary_tag_code(StagGoalMap, Primary, MaxSecondary, StagLoc,
+            VarRval, CodeModel, SwitchGoalInfo, EndLabel, FailLabel, !MaybeEnd,
+            TagCode, !CI),
 		PrevTests = tree(PrevTests0, TestCode),
 		PrevCases = tree(tree(LabelCode, TagCode), PrevCases0),
-		( PtagGroups = [_|_] ->
+        (
+            PtagGroups = [_ | _],
 			code_info__reset_to_position(BranchStart, !CI),
-			tag_switch__generate_primary_try_chain(PtagGroups,
-				TagRval, VarRval, CodeModel, CanFail,
-				SwitchGoalInfo, EndLabel, FailLabel,
-				PtagCountMap, PrevTests, PrevCases,
-				!MaybeEnd, Code, !CI)
+            generate_primary_try_chain(PtagGroups, TagRval, VarRval, CodeModel,
+                CanFail, SwitchGoalInfo, EndLabel, FailLabel, PtagCountMap,
+                PrevTests, PrevCases, !MaybeEnd, Code, !CI)
 		;
+            PtagGroups = [],
 			FailCode = node([
 				goto(label(FailLabel)) -
 					"primary tag with no code to handle it"
@@ -456,93 +431,73 @@
 			Code = tree(PrevTests, tree(FailCode, PrevCases))
 		)
 	;
-		Comment = node([
-			comment("fallthrough to last tag value") - ""
-		]),
-		tag_switch__generate_primary_tag_code(StagGoalMap,
-			Primary, MaxSecondary, StagLoc, VarRval,
-			CodeModel, SwitchGoalInfo, EndLabel, FailLabel,
-			!MaybeEnd, TagCode, !CI),
-		Code =
-			tree(PrevTests0,
-			tree(Comment,
-			tree(TagCode,
-			     PrevCases0)))
+        Comment = node([comment("fallthrough to last tag value") - ""]),
+        generate_primary_tag_code(StagGoalMap, Primary, MaxSecondary, StagLoc,
+            VarRval, CodeModel, SwitchGoalInfo, EndLabel, FailLabel, !MaybeEnd,
+            TagCode, !CI),
+        Code = tree_list([PrevTests0, Comment, TagCode, PrevCases0])
 	).
 
 %-----------------------------------------------------------------------------%
 
 	% Generate the cases for a primary tag using a dense jump table
 	% that has an entry for all possible primary tag values.
-
-:- pred tag_switch__generate_primary_jump_table(ptag_case_list::in, int::in,
+    %
+:- pred generate_primary_jump_table(ptag_case_list::in, int::in,
 	int::in, rval::in, code_model::in, hlds_goal_info::in,
 	label::in, label::in, ptag_count_map::in,
 	branch_end::in, branch_end::out, list(label)::out, code_tree::out,
 	code_info::in, code_info::out) is det.
 
-tag_switch__generate_primary_jump_table(PtagGroups, CurPrimary, MaxPrimary,
-		VarRval, CodeModel, SwitchGoalInfo, EndLabel, FailLabel,
-		PtagCountMap, !MaybeEnd, Labels, Code, !CI) :-
+generate_primary_jump_table(PtagGroups, CurPrimary, MaxPrimary, VarRval,
+        CodeModel, SwitchGoalInfo, EndLabel, FailLabel, PtagCountMap,
+        !MaybeEnd, Labels, Code, !CI) :-
 	( CurPrimary > MaxPrimary ->
-		( PtagGroups = [] ->
-			true
+        (
+            PtagGroups = []
 		;
-			error("tag_switch__generate_primary_jump_table: " ++
-				"caselist not empty " ++
-				"when reaching limiting primary tag")
+            PtagGroups = [_ | _],
+            unexpected(this_file,
+                "generate_primary_jump_table: " ++
+                "caselist not empty when reaching limiting primary tag")
 		),
 		Labels = [],
 		Code = empty
 	;
 		NextPrimary = CurPrimary + 1,
 		( PtagGroups = [CurPrimary - PrimaryInfo | PtagGroups1] ->
-			PrimaryInfo = StagLoc - StagGoalMap,
+            PrimaryInfo = ptag_case(StagLoc, StagGoalMap),
 			map__lookup(PtagCountMap, CurPrimary, CountInfo),
 			CountInfo = StagLoc1 - MaxSecondary,
-			( StagLoc = StagLoc1 ->
-				true
-			;
-				error("secondary tag locations differ " ++
-					"in generate_primary_jump_table")
-			),
+            require(unify(StagLoc, StagLoc1),
+                "secondary tag locations differ " ++
+                "in generate_primary_jump_table"),
 			code_info__get_next_label(NewLabel, !CI),
 			LabelCode = node([
-				label(NewLabel) -
-					"start of a case in primary tag switch"
+                label(NewLabel) - "start of a case in primary tag switch"
 			]),
-			( PtagGroups1 = [] ->
-				tag_switch__generate_primary_tag_code(
-					StagGoalMap, CurPrimary, MaxSecondary,
-					StagLoc, VarRval, CodeModel,
-					SwitchGoalInfo, EndLabel, FailLabel,
-					!MaybeEnd, ThisTagCode, !CI)
-			;
-				code_info__remember_position(!.CI,
-					BranchStart),
-				tag_switch__generate_primary_tag_code(
-					StagGoalMap, CurPrimary, MaxSecondary,
-					StagLoc, VarRval, CodeModel,
-					SwitchGoalInfo, EndLabel, FailLabel,
-					!MaybeEnd, ThisTagCode, !CI),
+            (
+                PtagGroups1 = [],
+                generate_primary_tag_code(StagGoalMap, CurPrimary,
+                    MaxSecondary, StagLoc, VarRval, CodeModel, SwitchGoalInfo,
+                    EndLabel, FailLabel, !MaybeEnd, ThisTagCode, !CI)
+            ;
+                PtagGroups1 = [_ | _],
+                code_info__remember_position(!.CI, BranchStart),
+                generate_primary_tag_code(StagGoalMap, CurPrimary,
+                    MaxSecondary, StagLoc, VarRval, CodeModel, SwitchGoalInfo,
+                    EndLabel, FailLabel, !MaybeEnd, ThisTagCode, !CI),
 				code_info__reset_to_position(BranchStart, !CI)
 			),
-			tag_switch__generate_primary_jump_table(PtagGroups1,
-				NextPrimary, MaxPrimary, VarRval, CodeModel,
-				SwitchGoalInfo, EndLabel, FailLabel,
-				PtagCountMap, !MaybeEnd, OtherLabels,
-				OtherCode, !CI),
+            generate_primary_jump_table(PtagGroups1, NextPrimary, MaxPrimary,
+                VarRval, CodeModel, SwitchGoalInfo, EndLabel, FailLabel,
+                PtagCountMap, !MaybeEnd, OtherLabels, OtherCode, !CI),
 			Labels = [NewLabel | OtherLabels],
-			Code =
-				tree(LabelCode,
-				tree(ThisTagCode,
-				     OtherCode))
-		;
-			tag_switch__generate_primary_jump_table(PtagGroups,
-				NextPrimary, MaxPrimary, VarRval, CodeModel,
-				SwitchGoalInfo, EndLabel, FailLabel,
-				PtagCountMap, !MaybeEnd, OtherLabels, Code,
-				!CI),
+            Code = tree_list([LabelCode, ThisTagCode, OtherCode])
+        ;
+            generate_primary_jump_table(PtagGroups, NextPrimary, MaxPrimary,
+                VarRval, CodeModel, SwitchGoalInfo, EndLabel, FailLabel,
+                PtagCountMap, !MaybeEnd, OtherLabels, Code, !CI),
 			Labels = [FailLabel | OtherLabels]
 		)
 	).
@@ -552,50 +507,47 @@
 	% Generate the cases for a primary tag using a binary search.
 	% This invocation looks after primary tag values in the range
 	% MinPtag to MaxPtag (including both boundary values).
-
-:- pred tag_switch__generate_primary_binary_search(ptag_case_list::in, int::in,
+    %
+:- pred generate_primary_binary_search(ptag_case_list::in, int::in,
 	int::in, rval::in, rval::in, code_model::in, can_fail::in,
 	hlds_goal_info::in, label::in, label::in, ptag_count_map::in,
 	branch_end::in, branch_end::out, code_tree::out,
 	code_info::in, code_info::out) is det.
 
-tag_switch__generate_primary_binary_search(PtagGroups, MinPtag, MaxPtag,
-		PtagRval, VarRval, CodeModel, CanFail, SwitchGoalInfo,
-		EndLabel, FailLabel, PtagCountMap, !MaybeEnd, Code, !CI) :-
+generate_primary_binary_search(PtagGroups, MinPtag, MaxPtag, PtagRval, VarRval,
+        CodeModel, CanFail, SwitchGoalInfo, EndLabel, FailLabel, PtagCountMap,
+        !MaybeEnd, Code, !CI) :-
 	( MinPtag = MaxPtag ->
 		CurPrimary = MinPtag,
-		( PtagGroups = [] ->
-			% there is no code for this tag
+        (
+            PtagGroups = [],
+            % There is no code for this tag.
 			(
 				CanFail = can_fail,
 				string__int_to_string(CurPrimary, PtagStr),
-				string__append("no code for ptag ", PtagStr,
-					Comment),
-				Code = node([
-					goto(label(FailLabel)) -
-						Comment
-				])
+                string__append("no code for ptag ", PtagStr, Comment),
+                Code = node([goto(label(FailLabel)) - Comment])
 			;
 				CanFail = cannot_fail,
 				Code = empty
 			)
-		; PtagGroups = [CurPrimary - PrimaryInfo] ->
-			PrimaryInfo = StagLoc - StagGoalMap,
+        ;
+            PtagGroups = [CurPrimaryPrime - PrimaryInfo],
+            require(unify(CurPrimary, CurPrimaryPrime),
+                "generate_primary_binary_search: cur_primary mismatch"),
+            PrimaryInfo = ptag_case(StagLoc, StagGoalMap),
 			map__lookup(PtagCountMap, CurPrimary, CountInfo),
 			CountInfo = StagLoc1 - MaxSecondary,
-			( StagLoc = StagLoc1 ->
-				true
-			;
-				error("secondary tag locations differ " ++
-					"in generate_primary_jump_table")
-			),
-			tag_switch__generate_primary_tag_code(
-				StagGoalMap, CurPrimary, MaxSecondary, StagLoc,
-				VarRval, CodeModel, SwitchGoalInfo, EndLabel,
-				FailLabel, !MaybeEnd, Code, !CI)
-		;
-			error("caselist not singleton or empty " ++
-				"when binary search ends")
+            require(unify(StagLoc, StagLoc1),
+                "secondary tag locations differ " ++
+                "in generate_primary_jump_table"),
+            generate_primary_tag_code(StagGoalMap, CurPrimary, MaxSecondary,
+                StagLoc, VarRval, CodeModel, SwitchGoalInfo,
+                EndLabel, FailLabel, !MaybeEnd, Code, !CI)
+        ;
+            PtagGroups = [_, _ | _],
+            unexpected(this_file,
+                "caselist not singleton or empty when binary search ends")
 		)
 	;
 		LowRangeEnd = (MinPtag + MaxPtag) // 2,
@@ -616,31 +568,19 @@
 			" to ", HighEndStr], LabelComment),
 		LowRangeEndConst = const(int_const(LowRangeEnd)),
 		TestRval = binop(>, PtagRval, LowRangeEndConst),
-		IfCode = node([
-			if_val(TestRval, label(NewLabel)) -
-				IfComment
-		]),
-		LabelCode = node([
-			label(NewLabel) -
-				LabelComment
-		]),
+        IfCode = node([if_val(TestRval, label(NewLabel)) - IfComment]),
+        LabelCode = node([label(NewLabel) - LabelComment]),
 
 		code_info__remember_position(!.CI, BranchStart),
-		tag_switch__generate_primary_binary_search(LowGroups,
-			MinPtag, LowRangeEnd, PtagRval, VarRval, CodeModel,
-			CanFail, SwitchGoalInfo, EndLabel, FailLabel,
-			PtagCountMap, !MaybeEnd, LowRangeCode, !CI),
+        generate_primary_binary_search(LowGroups, MinPtag, LowRangeEnd,
+            PtagRval, VarRval, CodeModel, CanFail, SwitchGoalInfo,
+            EndLabel, FailLabel, PtagCountMap, !MaybeEnd, LowRangeCode, !CI),
 		code_info__reset_to_position(BranchStart, !CI),
-		tag_switch__generate_primary_binary_search(HighGroups,
-			HighRangeStart, MaxPtag, PtagRval, VarRval, CodeModel,
-			CanFail, SwitchGoalInfo, EndLabel, FailLabel,
-			PtagCountMap, !MaybeEnd, HighRangeCode, !CI),
-
-		Code =
-			tree(IfCode,
-			tree(LowRangeCode,
-			tree(LabelCode,
-			     HighRangeCode)))
+        generate_primary_binary_search(HighGroups, HighRangeStart, MaxPtag,
+            PtagRval, VarRval, CodeModel, CanFail, SwitchGoalInfo,
+            EndLabel, FailLabel, PtagCountMap, !MaybeEnd, HighRangeCode, !CI),
+
+        Code = tree_list([IfCode, LowRangeCode, LabelCode, HighRangeCode])
 	).
 
 %-----------------------------------------------------------------------------%
@@ -648,41 +588,37 @@
 	% Generate the code corresponding to a primary tag.
 	% If this primary tag has secondary tags, decide whether we should
 	% use a jump table to implement the secondary switch.
-
-:- pred tag_switch__generate_primary_tag_code(stag_goal_map::in, tag_bits::in,
+    %
+:- pred generate_primary_tag_code(stag_goal_map::in, tag_bits::in,
 	int::in, stag_loc::in, rval::in, code_model::in, hlds_goal_info::in,
 	label::in, label::in, branch_end::in, branch_end::out, code_tree::out,
 	code_info::in, code_info::out) is det.
 
-tag_switch__generate_primary_tag_code(GoalMap, Primary, MaxSecondary, StagLoc,
-		Rval, CodeModel, SwitchGoalInfo, EndLabel, FailLabel,
-		!MaybeEnd, Code, !CI) :-
+generate_primary_tag_code(GoalMap, Primary, MaxSecondary, StagLoc, Rval,
+        CodeModel, SwitchGoalInfo, EndLabel, FailLabel, !MaybeEnd, Code,
+        !CI) :-
 	map__to_assoc_list(GoalMap, GoalList),
 	(
 		StagLoc = none
 	->
 		% There is no secondary tag, so there is no switch on it
-		( GoalList = [-1 - Goal] ->
-			trace__maybe_generate_internal_event_code(Goal,
-				SwitchGoalInfo, TraceCode, !CI),
-			code_gen__generate_goal(CodeModel, Goal, GoalCode,
-				!CI),
+        ( GoalList = [-1 - stag_goal(ConsId, Goal)] ->
+            Comment = "case " ++ cons_id_to_string(ConsId),
+            CommentCode = node([comment(Comment) - ""]),
+            trace__maybe_generate_internal_event_code(Goal, SwitchGoalInfo,
+                TraceCode, !CI),
+            code_gen__generate_goal(CodeModel, Goal, GoalCode, !CI),
 			goal_info_get_store_map(SwitchGoalInfo, StoreMap),
-			code_info__generate_branch_end(StoreMap, !MaybeEnd,
-				SaveCode, !CI),
+            code_info__generate_branch_end(StoreMap, !MaybeEnd, SaveCode, !CI),
 			GotoCode = node([
-				goto(label(EndLabel)) -
-					"skip to end of primary tag switch"
+                goto(label(EndLabel)) - "skip to end of primary tag switch"
 			]),
-			Code =
-				tree(TraceCode,
-				tree(GoalCode,
-				tree(SaveCode,
-				     GotoCode)))
+            Code = tree_list([CommentCode, TraceCode, GoalCode, SaveCode,
+                GotoCode])
 		; GoalList = [] ->
-			error("no goal for non-shared tag")
+            unexpected(this_file, "no goal for non-shared tag")
 		;
-			error("more than one goal for non-shared tag")
+            unexpected(this_file, "more than one goal for non-shared tag")
 		)
 	;
 		% There is a secondary tag, so figure out how to switch on it
@@ -691,8 +627,7 @@
 			DenseSwitchSize),
 		globals__lookup_int_option(Globals, binary_switch_size,
 			BinarySwitchSize),
-		globals__lookup_int_option(Globals, try_switch_size,
-			TrySwitchSize),
+        globals__lookup_int_option(Globals, try_switch_size, TrySwitchSize),
 		( MaxSecondary >= DenseSwitchSize ->
 			SecondaryMethod = jump_table
 		; MaxSecondary >= BinarySwitchSize ->
@@ -717,22 +652,18 @@
 		(
 			SecondaryMethod \= jump_table,
 			MaxSecondary >= 2,
-			globals__lookup_int_option(Globals, num_real_r_regs,
-				NumRealRegs),
+            globals__lookup_int_option(Globals, num_real_r_regs, NumRealRegs),
 			(
 				NumRealRegs = 0
 			;
 				( StagReg = reg(r, StagRegNo) ->
 					StagRegNo =< NumRealRegs
 				;
-					error("improper reg in tag switch")
+                    unexpected(this_file, "improper reg in tag switch")
 				)
 			)
 		->
-			StagCode = node([
-				assign(StagReg, OrigStagRval) -
-					Comment
-			]),
+            StagCode = node([assign(StagReg, OrigStagRval) - Comment]),
 			StagRval = lval(StagReg)
 		;
 			StagCode = empty,
@@ -750,34 +681,29 @@
 
 		(
 			SecondaryMethod = jump_table,
-			tag_switch__generate_secondary_jump_table(GoalList,
-				0, MaxSecondary, CodeModel, SwitchGoalInfo,
-				EndLabel, FailLabel, !MaybeEnd, Labels,
+            generate_secondary_jump_table(GoalList, 0, MaxSecondary, CodeModel,
+                SwitchGoalInfo, EndLabel, FailLabel, !MaybeEnd, Labels,
 				CasesCode, !CI),
 			SwitchCode = node([
-				computed_goto(StagRval, Labels) -
-					"switch on secondary tag"
+                computed_goto(StagRval, Labels) - "switch on secondary tag"
 			]),
 			Code = tree(SwitchCode, CasesCode)
 		;
 			SecondaryMethod = binary_search,
-			tag_switch__generate_secondary_binary_search(GoalList,
-				0, MaxSecondary, StagRval, CodeModel, CanFail,
-				SwitchGoalInfo, EndLabel, FailLabel, !MaybeEnd,
-				Code, !CI)
+            generate_secondary_binary_search(GoalList, 0, MaxSecondary,
+                StagRval, CodeModel, CanFail, SwitchGoalInfo,
+                EndLabel, FailLabel, !MaybeEnd, Code, !CI)
 		;
 			SecondaryMethod = try_chain,
-			tag_switch__generate_secondary_try_chain(GoalList,
-				StagRval, CodeModel, CanFail, SwitchGoalInfo,
-				EndLabel, FailLabel, empty, empty,
+            generate_secondary_try_chain(GoalList, StagRval, CodeModel,
+                CanFail, SwitchGoalInfo, EndLabel, FailLabel, empty, empty,
 				!MaybeEnd, Codes, !CI),
 			Code = tree(StagCode, Codes)
 		;
 			SecondaryMethod = try_me_else_chain,
-			tag_switch__generate_secondary_try_me_else_chain(
-				GoalList, StagRval, CodeModel, CanFail,
-				SwitchGoalInfo, EndLabel, FailLabel,
-				!MaybeEnd, Codes, !CI),
+            generate_secondary_try_me_else_chain(GoalList, StagRval, CodeModel,
+                CanFail, SwitchGoalInfo, EndLabel, FailLabel, !MaybeEnd,
+                Codes, !CI),
 			Code = tree(StagCode, Codes)
 		)
 	).
@@ -785,26 +711,30 @@
 %-----------------------------------------------------------------------------%
 
 	% Generate a switch on a secondary tag value using a try-me-else chain.
-
-:- pred tag_switch__generate_secondary_try_me_else_chain(stag_goal_list::in,
+    %
+:- pred generate_secondary_try_me_else_chain(stag_goal_list::in,
 	rval::in, code_model::in, can_fail::in, hlds_goal_info::in,
 	label::in, label::in, branch_end::in, branch_end::out, code_tree::out,
 	code_info::in, code_info::out) is det.
 
-tag_switch__generate_secondary_try_me_else_chain([], _, _, _, _, _, _, _, _, _,
-		!CI) :-
-	error("generate_secondary_try_me_else_chain: empty switch").
-tag_switch__generate_secondary_try_me_else_chain([Case0 | Cases0], StagRval,
-		CodeModel, CanFail, SwitchGoalInfo, EndLabel, FailLabel,
-		!MaybeEnd, Code, !CI) :-
-	Case0 = Secondary - Goal,
+generate_secondary_try_me_else_chain([], _, _, _, _, _, _, _, _, _, !CI) :-
+    unexpected(this_file,
+        "generate_secondary_try_me_else_chain: empty switch").
+generate_secondary_try_me_else_chain([Case0 | Cases0], StagRval, CodeModel,
+        CanFail, SwitchGoalInfo, EndLabel, FailLabel, !MaybeEnd, Code, !CI) :-
+    Case0 = Secondary - stag_goal(ConsId, Goal),
+    Comment = "case " ++ cons_id_to_string(ConsId),
+    CommentCode = node([comment(Comment) - ""]),
 	goal_info_get_store_map(SwitchGoalInfo, StoreMap),
-	( ( Cases0 = [_|_] ; CanFail = can_fail ) ->
+    (
+        ( Cases0 = [_ | _]
+        ; CanFail = can_fail
+        )
+    ->
 		code_info__remember_position(!.CI, BranchStart),
 		code_info__get_next_label(ElseLabel, !CI),
 		TestCode = node([
-			if_val(binop(ne, StagRval,
-					const(int_const(Secondary))),
+            if_val(binop(ne, StagRval, const(int_const(Secondary))),
 				label(ElseLabel))
 				- "test remote sec tag only"
 		]),
@@ -814,28 +744,22 @@
 		code_info__generate_branch_end(StoreMap, !MaybeEnd,
 			SaveCode, !CI),
 		GotoLabelCode = node([
-			goto(label(EndLabel)) -
-				"skip to end of secondary tag switch",
-			label(ElseLabel) -
-				"handle next secondary tag"
+            goto(label(EndLabel)) - "skip to end of secondary tag switch",
+            label(ElseLabel) - "handle next secondary tag"
 		]),
-		ThisCode =
-			tree(TestCode,
-			tree(TraceCode,
-			tree(GoalCode,
-			tree(SaveCode,
-			     GotoLabelCode)))),
-		( Cases0 = [_|_] ->
+        ThisCode = tree_list([TestCode, CommentCode, TraceCode, GoalCode,
+            SaveCode, GotoLabelCode]),
+        (
+            Cases0 = [_ | _],
 			code_info__reset_to_position(BranchStart, !CI),
-			tag_switch__generate_secondary_try_me_else_chain(
-				Cases0, StagRval, CodeModel, CanFail,
-				SwitchGoalInfo, EndLabel, FailLabel, !MaybeEnd,
+            generate_secondary_try_me_else_chain(Cases0, StagRval, CodeModel,
+                CanFail, SwitchGoalInfo, EndLabel, FailLabel, !MaybeEnd,
 				OtherCode, !CI),
 			Code = tree(ThisCode, OtherCode)
 		;
+            Cases0 = [],
 			FailCode = node([
-				goto(label(FailLabel)) -
-					"secondary tag does not match"
+                goto(label(FailLabel)) - "secondary tag does not match"
 			]),
 			Code = tree(ThisCode, FailCode)
 		)
@@ -843,73 +767,66 @@
 		trace__maybe_generate_internal_event_code(Goal, SwitchGoalInfo,
 			TraceCode, !CI),
 		code_gen__generate_goal(CodeModel, Goal, GoalCode, !CI),
-		code_info__generate_branch_end(StoreMap, !MaybeEnd, SaveCode,
-			!CI),
+        code_info__generate_branch_end(StoreMap, !MaybeEnd, SaveCode, !CI),
 		GotoCode = node([
-			goto(label(EndLabel)) -
-				"skip to end of secondary tag switch"
+            goto(label(EndLabel)) - "skip to end of secondary tag switch"
 		]),
-		Code =
-			tree(TraceCode,
-			tree(GoalCode,
-			tree(SaveCode,
-			     GotoCode)))
+        Code = tree_list([CommentCode, TraceCode, GoalCode, SaveCode,
+            GotoCode])
 	).
 
 %-----------------------------------------------------------------------------%
 
 	% Generate a switch on a secondary tag value using a try chain.
-
-:- pred tag_switch__generate_secondary_try_chain(stag_goal_list::in, rval::in,
+    %
+:- pred generate_secondary_try_chain(stag_goal_list::in, rval::in,
 	code_model::in, can_fail::in, hlds_goal_info::in, label::in, label::in,
 	code_tree::in, code_tree::in, branch_end::in, branch_end::out,
 	code_tree::out, code_info::in, code_info::out) is det.
 
-tag_switch__generate_secondary_try_chain([], _, _, _, _, _, _, _, _, _, _, _,
-		!CI) :-
-	error("generate_secondary_try_chain: empty switch").
-tag_switch__generate_secondary_try_chain([Case0 | Cases0], StagRval,
-		CodeModel, CanFail, SwitchGoalInfo, EndLabel, FailLabel,
-		PrevTests0, PrevCases0, !MaybeEnd, Code, !CI) :-
-	Case0 = Secondary - Goal,
+generate_secondary_try_chain([], _, _, _, _, _, _, _, _, _, _, _, !CI) :-
+    unexpected(this_file, "generate_secondary_try_chain: empty switch").
+generate_secondary_try_chain([Case0 | Cases0], StagRval, CodeModel, CanFail,
+        SwitchGoalInfo, EndLabel, FailLabel, PrevTests0, PrevCases0, !MaybeEnd,
+        Code, !CI) :-
+    Case0 = Secondary - stag_goal(ConsId, Goal),
+    Comment = "case " ++ cons_id_to_string(ConsId),
 	goal_info_get_store_map(SwitchGoalInfo, StoreMap),
-	( ( Cases0 = [_|_] ; CanFail = can_fail ) ->
+    (
+        ( Cases0 = [_ | _]
+        ; CanFail = can_fail
+        )
+    ->
 		code_info__remember_position(!.CI, BranchStart),
 		code_info__get_next_label(ThisStagLabel, !CI),
 		TestCode = node([
-			if_val(binop(eq, StagRval,
-					const(int_const(Secondary))),
+            if_val(binop(eq, StagRval, const(int_const(Secondary))),
 				label(ThisStagLabel))
-				- "test remote sec tag only"
+                - ("test remote sec tag only for " ++ Comment)
 		]),
 		LabelCode = node([
-			label(ThisStagLabel) -
-				"handle next secondary tag"
+            label(ThisStagLabel)
+                - ("handle next secondary tag for " ++ Comment)
 		]),
 		trace__maybe_generate_internal_event_code(Goal, SwitchGoalInfo,
 			TraceCode, !CI),
 		code_gen__generate_goal(CodeModel, Goal, GoalCode, !CI),
-		code_info__generate_branch_end(StoreMap, !MaybeEnd, SaveCode,
-			!CI),
+        code_info__generate_branch_end(StoreMap, !MaybeEnd, SaveCode, !CI),
 		GotoCode = node([
-			goto(label(EndLabel)) -
-				"skip to end of secondary tag switch"
+            goto(label(EndLabel)) - "skip to end of secondary tag switch"
 		]),
-		ThisCode =
-			tree(LabelCode,
-			tree(TraceCode,
-			tree(GoalCode,
-			tree(SaveCode,
-			     GotoCode)))),
+        ThisCode = tree_list([LabelCode, TraceCode, GoalCode, SaveCode,
+            GotoCode]),
 		PrevTests = tree(PrevTests0, TestCode),
 		PrevCases = tree(ThisCode, PrevCases0),
-		( Cases0 = [_|_] ->
+        (
+            Cases0 = [_ | _],
 			code_info__reset_to_position(BranchStart, !CI),
-			tag_switch__generate_secondary_try_chain(Cases0,
-				StagRval, CodeModel, CanFail, SwitchGoalInfo,
-				EndLabel, FailLabel, PrevTests, PrevCases,
+            generate_secondary_try_chain(Cases0, StagRval, CodeModel, CanFail,
+                SwitchGoalInfo, EndLabel, FailLabel, PrevTests, PrevCases,
 				!MaybeEnd, Code, !CI)
 		;
+            Cases0 = [],
 			FailCode = node([
 				goto(label(FailLabel)) -
 					"secondary tag with no code to handle it"
@@ -917,87 +834,69 @@
 			Code = tree(PrevTests, tree(FailCode, PrevCases))
 		)
 	;
+        CommentCode = node([comment(Comment) - ""]),
 		trace__maybe_generate_internal_event_code(Goal, SwitchGoalInfo,
 			TraceCode, !CI),
 		code_gen__generate_goal(CodeModel, Goal, GoalCode, !CI),
-		code_info__generate_branch_end(StoreMap, !MaybeEnd, SaveCode,
-			!CI),
+        code_info__generate_branch_end(StoreMap, !MaybeEnd, SaveCode, !CI),
 		GotoCode = node([
-			goto(label(EndLabel)) -
-				"skip to end of secondary tag switch"
+            goto(label(EndLabel)) - "skip to end of secondary tag switch"
 		]),
-		Code =
-			tree(PrevTests0,
-			tree(TraceCode,
-			tree(GoalCode,
-			tree(SaveCode,
-			tree(GotoCode,
-			     PrevCases0)))))
+        Code = tree_list([PrevTests0, CommentCode, TraceCode, GoalCode,
+            SaveCode, GotoCode, PrevCases0])
 	).
 
 %-----------------------------------------------------------------------------%
 
 	% Generate the cases for a primary tag using a dense jump table
 	% that has an entry for all possible secondary tag values.
-
-:- pred tag_switch__generate_secondary_jump_table(stag_goal_list::in, int::in,
+    %
+:- pred generate_secondary_jump_table(stag_goal_list::in, int::in,
 	int::in, code_model::in, hlds_goal_info::in, label::in, label::in,
 	branch_end::in, branch_end::out, list(label)::out, code_tree::out,
 	code_info::in, code_info::out) is det.
 
-tag_switch__generate_secondary_jump_table(CaseList, CurSecondary, MaxSecondary,
-		CodeModel, SwitchGoalInfo, EndLabel, FailLabel,
-		!MaybeEnd, Labels, Code, !CI) :-
+generate_secondary_jump_table(CaseList, CurSecondary, MaxSecondary, CodeModel,
+        SwitchGoalInfo, EndLabel, FailLabel, !MaybeEnd, Labels, Code, !CI) :-
 	( CurSecondary > MaxSecondary ->
-		( CaseList = [] ->
-			true
-		;
-			error("caselist not empty when reaching " ++
-				"limiting secondary tag")
-		),
+        require(unify(CaseList, []),
+            "caselist not empty when reaching limiting secondary tag"),
 		Labels = [],
 		Code = empty
 	;
 		NextSecondary = CurSecondary + 1,
-		( CaseList = [CurSecondary - Goal | CaseList1] ->
+        ( CaseList = [CurSecondary - stag_goal(ConsId, Goal) | CaseList1] ->
+            Comment = "case " ++ cons_id_to_string(ConsId),
 			code_info__get_next_label(NewLabel, !CI),
 			LabelCode = node([
 				label(NewLabel) -
-					"start of case in secondary tag switch"
+                    ("start of " ++ Comment ++ " in secondary tag switch")
 			]),
 			code_info__remember_position(!.CI, BranchStart),
-			trace__maybe_generate_internal_event_code(Goal,
-				SwitchGoalInfo, TraceCode, !CI),
+            trace__maybe_generate_internal_event_code(Goal, SwitchGoalInfo,
+                TraceCode, !CI),
 			code_gen__generate_goal(CodeModel, Goal, GoalCode, !CI),
 			goal_info_get_store_map(SwitchGoalInfo, StoreMap),
-			code_info__generate_branch_end(StoreMap,
-				!MaybeEnd, SaveCode, !CI),
-			( CaseList1 = [] ->
-				true
+            code_info__generate_branch_end(StoreMap, !MaybeEnd, SaveCode, !CI),
+            (
+                CaseList1 = []
 			;
+                CaseList1 = [_ | _],
 				code_info__reset_to_position(BranchStart, !CI)
 			),
 			GotoCode = node([
-				goto(label(EndLabel)) -
-					"branch to end of tag switch"
+                goto(label(EndLabel)) - "branch to end of tag switch"
 			]),
-			tag_switch__generate_secondary_jump_table(CaseList1,
-				NextSecondary, MaxSecondary, CodeModel,
-				SwitchGoalInfo, EndLabel, FailLabel,
+            generate_secondary_jump_table(CaseList1, NextSecondary,
+                MaxSecondary, CodeModel, SwitchGoalInfo, EndLabel, FailLabel,
 				!MaybeEnd, OtherLabels, OtherCode, !CI),
 			Labels = [NewLabel | OtherLabels],
-			Code =
-				tree(LabelCode,
-				tree(TraceCode,
-				tree(GoalCode,
-				tree(SaveCode,
-				tree(GotoCode,
-				     OtherCode)))))
-		;
-			tag_switch__generate_secondary_jump_table(CaseList,
-				NextSecondary, MaxSecondary, CodeModel,
-				SwitchGoalInfo, EndLabel, FailLabel,
-				!MaybeEnd, OtherLabels, Code, !CI),
+            Code = tree_list([LabelCode, TraceCode, GoalCode, SaveCode, 
+                GotoCode, OtherCode])
+        ;
+            generate_secondary_jump_table(CaseList,
+                NextSecondary, MaxSecondary, CodeModel, SwitchGoalInfo,
+                EndLabel, FailLabel, !MaybeEnd, OtherLabels, Code, !CI),
 			Labels = [FailLabel | OtherLabels]
 		)
 	).
@@ -1007,49 +906,47 @@
 	% Generate the cases for a secondary tag using a binary search.
 	% This invocation looks after secondary tag values in the range
 	% MinPtag to MaxPtag (including both boundary values).
-
-:- pred tag_switch__generate_secondary_binary_search(stag_goal_list::in,
+    %
+:- pred generate_secondary_binary_search(stag_goal_list::in,
 	int::in, int::in, rval::in, code_model::in, can_fail::in,
 	hlds_goal_info::in, label::in, label::in,
 	branch_end::in, branch_end::out, code_tree::out,
 	code_info::in, code_info::out) is det.
 
-tag_switch__generate_secondary_binary_search(StagGoals, MinStag, MaxStag,
-		StagRval, CodeModel, CanFail, SwitchGoalInfo, EndLabel,
-		FailLabel, !MaybeEnd, Code, !CI) :-
+generate_secondary_binary_search(StagGoals, MinStag, MaxStag, StagRval,
+        CodeModel, CanFail, SwitchGoalInfo, EndLabel, FailLabel, !MaybeEnd,
+        Code, !CI) :-
 	( MinStag = MaxStag ->
 		CurSec = MinStag,
-		( StagGoals = [] ->
-			% there is no code for this tag
+        (
+            StagGoals = [],
+            % There is no code for this tag.
 			(
 				CanFail = can_fail,
 				string__int_to_string(CurSec, StagStr),
-				string__append("no code for ptag ", StagStr,
-					Comment),
-				Code = node([
-					goto(label(FailLabel)) -
-						Comment
-				])
+                string__append("no code for ptag ", StagStr, Comment),
+                Code = node([goto(label(FailLabel)) - Comment])
 			;
 				CanFail = cannot_fail,
 				Code = empty
 			)
-		; StagGoals = [CurSec - Goal] ->
-			trace__maybe_generate_internal_event_code(Goal,
-				SwitchGoalInfo, TraceCode, !CI),
-			code_gen__generate_goal(CodeModel, Goal, GoalCode,
-				!CI),
+        ;
+            StagGoals = [CurSecPrime - stag_goal(ConsId, Goal)],
+            Comment = "case " ++ cons_id_to_string(ConsId),
+            CommentCode = node([comment(Comment) - ""]),
+            require(unify(CurSec, CurSecPrime),
+                "generate_secondary_binary_search: cur_secondary mismatch"),
+            trace__maybe_generate_internal_event_code(Goal, SwitchGoalInfo,
+                TraceCode, !CI),
+            code_gen__generate_goal(CodeModel, Goal, GoalCode, !CI),
 			goal_info_get_store_map(SwitchGoalInfo, StoreMap),
-			code_info__generate_branch_end(StoreMap, !MaybeEnd,
-				SaveCode, !CI),
-			Code =
-				tree(TraceCode,
-				tree(GoalCode,
-				     SaveCode))
-		;
-			error("generate_secondary_binary_search: " ++
-				"goallist not singleton or empty " ++
-				"when binary search ends")
+            code_info__generate_branch_end(StoreMap, !MaybeEnd, SaveCode, !CI),
+            Code = tree_list([CommentCode, TraceCode, GoalCode, SaveCode])
+        ;
+            StagGoals = [_, _ | _],
+            unexpected(this_file,
+                "generate_secondary_binary_search: " ++
+                "goallist not singleton or empty when binary search ends")
 		)
 	;
 		LowRangeEnd = (MinStag + MaxStag) // 2,
@@ -1070,31 +967,25 @@
 			" to ", HighEndStr], LabelComment),
 		LowRangeEndConst = const(int_const(LowRangeEnd)),
 		TestRval = binop(>, StagRval, LowRangeEndConst),
-		IfCode = node([
-			if_val(TestRval, label(NewLabel)) -
-				IfComment
-		]),
-		LabelCode = node([
-			label(NewLabel) -
-				LabelComment
-		]),
+        IfCode = node([if_val(TestRval, label(NewLabel)) - IfComment]),
+        LabelCode = node([label(NewLabel) - LabelComment ]),
 
 		code_info__remember_position(!.CI, BranchStart),
-		tag_switch__generate_secondary_binary_search(LowGoals,
-			MinStag, LowRangeEnd, StagRval, CodeModel,
-			CanFail, SwitchGoalInfo, EndLabel, FailLabel,
+        generate_secondary_binary_search(LowGoals, MinStag, LowRangeEnd,
+            StagRval, CodeModel, CanFail, SwitchGoalInfo, EndLabel, FailLabel,
 			!MaybeEnd, LowRangeCode, !CI),
 		code_info__reset_to_position(BranchStart, !CI),
-		tag_switch__generate_secondary_binary_search(HighGoals,
-			HighRangeStart, MaxStag, StagRval, CodeModel,
-			CanFail, SwitchGoalInfo, EndLabel, FailLabel,
+        generate_secondary_binary_search(HighGoals, HighRangeStart, MaxStag,
+            StagRval, CodeModel, CanFail, SwitchGoalInfo, EndLabel, FailLabel,
 			!MaybeEnd, HighRangeCode, !CI),
 
-		Code =
-			tree(IfCode,
-			tree(LowRangeCode,
-			tree(LabelCode,
-			     HighRangeCode)))
+        Code = tree_list([IfCode, LowRangeCode, LabelCode, HighRangeCode])
 	).
+
+%-----------------------------------------------------------------------------%
+
+:- func this_file = string.
+
+this_file = "tag_switch.m".
 
 %-----------------------------------------------------------------------------%
Index: compiler/use_local_vars.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/use_local_vars.m,v
retrieving revision 1.13
diff -u -b -r1.13 use_local_vars.m
--- compiler/use_local_vars.m	15 Aug 2005 07:18:31 -0000	1.13
+++ compiler/use_local_vars.m	20 Aug 2005 14:00:52 -0000
@@ -112,8 +112,8 @@
 use_local_vars_block(LiveMap, NumRealRRegs, AccessThreshold, Label,
         !BlockMap) :-
     map__lookup(!.BlockMap, Label, BlockInfo0),
-    BlockInfo0 = block_info(BlockLabel, LabelInstr, RestInstrs0, JumpLabels,
-        MaybeFallThrough),
+    BlockInfo0 = block_info(BlockLabel, LabelInstr, RestInstrs0,
+        FallInto, JumpLabels, MaybeFallThrough),
     ( can_branch_to_unknown_label(RestInstrs0) ->
         MaybeEndLiveLvals = no
     ;
@@ -136,8 +136,8 @@
     ( TempCounter = TempCounter0 ->
         true
     ;
-        BlockInfo = block_info(BlockLabel, LabelInstr, RestInstrs, JumpLabels,
-            MaybeFallThrough),
+        BlockInfo = block_info(BlockLabel, LabelInstr, RestInstrs, FallInto,
+            JumpLabels, MaybeFallThrough),
         map__det_update(!.BlockMap, Label, BlockInfo, !:BlockMap)
     ).
 
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/aditi
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/concurrency
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/error
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/easyx
cvs diff: Diffing extras/graphics/easyx/samples
cvs diff: Diffing extras/graphics/mercury_glut
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/gears
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/moose/tests
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/stream
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing extras/xml_stylesheets
cvs diff: Diffing java
cvs diff: Diffing java/runtime
cvs diff: Diffing library
cvs diff: Diffing mdbcomp
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing slice
cvs diff: Diffing tests
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/string_format
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/grade_subdirs
cvs diff: Diffing tests/hard_coded
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/mmc_make
cvs diff: Diffing tests/mmc_make/lib
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
cvs diff: Diffing util
cvs diff: Diffing vim
cvs diff: Diffing vim/after
cvs diff: Diffing vim/ftplugin
cvs diff: Diffing vim/syntax
--------------------------------------------------------------------------
mercury-reviews mailing list
post:  mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe:   Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------



More information about the reviews mailing list