[m-rev.] for review: software transactional memory language extension

Julien Fischer juliensf at csse.unimelb.edu.au
Wed Oct 10 19:22:12 AEST 2007


On Tue, 9 Oct 2007, Leon Ilario MIKA wrote:

> Estimated hours taken: 198
>
> Addition of Software Transactional Memory constructs into the language.
> This includes the addition of the "atomic_goal" HLDS goal expression, and the
> "atomic" and "or_else" operators into the parse tree.  It also includes the
> addition of another HLDS -> HLDS transformation to expand out atomic_goals
> into standard predicates (Stage 113).

I suggest rewording that as:

 	Add support for atomic scopes to the language.  Code inside an
 	atomic scope is executed atomically w.r.t other threads using
 	software transactional memory (STM).

 	Extend the parse tree to include a representation of atomic scopes
 	and nested atomic scopes.  (Note: neither the parser, nor the
 	source-to-source transformation described below, handle nested
 	nested atomic scopes yet.)

 	Add a new HLDS->HLDS transformation pass that converts each
 	atomic scope in a module into a set of predicates that will
 	execute the goal inside the atomic scope atomically using STM.
 	The new transformation is stage 113.


> Also, fixed some bugs in "library/stm_builtin.m" and "runtime/mercury_stm.c"
> and "runtime/mercury_stm.h"

 	Fix some bugs in the runtime support for STM.

> and began work on the reference manual entry for
> Software Transactional Memory.

Please don't include the reference manual change in this diff; I think
it requires further work and would best be done as a separate change.

> Currently, single atomic transactions are supported.  The transactions can
> rollback if invalid and can block when retried.  Only support for the
> High Level C backend has been fully implemented (transactions do work in
> the "asm_fast" grades but raise an exception when attempting to retry).
> Also, the modules "stm_builtin", "exception" and "univ" must be explicitly
> imported if the "atomic" scope is to be used.

I suggest:

 	The STM implementation is still a work-in-progress.  There are
 	a number of limitations:

and then list them using dot points.
e.g.

 	* the existing runtime support only works for the high-level
 	  C .par grades.
etc.

A general note about file specific changes in log messages: the
convention that we use is that the files that have had major changes
made to them, should be listed first.  In this case, things like
compiler/stm_expand.m.  Files that have only had minor changes made to
them, such as conforming to the addition of a function symbol to a type,
should be listed last.

> compiler/add_clause.m:
> 	Added case for transforming atomic terms into "atomic_goal" HLDS 
> goals.
> 	No support for state variables has been added yet.
>
> compiler/det_analysis.m:
> 	Added code the determine the determinism of atomic_goals.  Currently,
> 	the inner goals of atomic scopes can only be "det" or "cc_multi" or
> 	"erroneous" for exceptions or the retry call.

Currently?  Unless Mercury moves to a different mechanims for
inter-thread communication, i.e. not through the I/O state, it's going
to be always.

I would change that to:

 	Handle atomic_goals.

> compiler/det_report.m:
> 	Added code to diagnose the determinism discrepency of the 
> atomic_goals.

If you mean "Add code to report determinsim errors in atomic_goals."
then just say so; if not, what does the above mean?

> compiler/goal_form.m:
> 	Added code to support the atomic_goal in switch statements over the
> 	HLDS goal expression.
>
> compiler/goal_path.m:
> 	Added code to support the atomic_goal.  Also added new slots
> 	"atomic_goal_main" and "atomic_goal_orelse".
>
> compiler/goal_util.m:
> 	Added code to support the atomic_goal in switch statements over the
> 	HLDS goal expression.

These four can be:

 	compiler/goal_form.m:
 	compiler/goal_path.m:
 	compiler/goal_util.m:
 		Handle atomic_goals.

> compiler/hlds_goal.m:
> 	Added the "atomic_goal" expression into the list of HLDS goal
> 	expressions.  Also added the "atomic_goal_type" type to identify the
> 	kind of atomic goal an atomic_goal is.  Also added cases for switch
> 	statements over the HLDS expression.

Shift this entry to before the goal_*.m ones.

>
> compiler/hlds_module.m:
> 	Added predicates to count the number of atomic scopes exist in a
> 	particular context.

s/exist/existing/ or "that exist in".

> compiler/hlds_out.m:
> 	Added code to display atomic_goals.
>
> compiler/hlds_pred.m:
> 	Added a new predicate transform origin reason for STM expansion.

 	Add new predicate transformation alternative for predidcates
 	created by the expansion of atomic scopes.

> compiler/layout_out.m:
> 	Added a new predicate transform origin reason for STM expansion.

 	Handle the above alternative.
...

> compiler/simplify.m:
> 	Added case for atomic goals.  Currently not simplifying the inner
> 	goals as code to fixup outer and inner variables have not been
> 	written yet.

See comments below.  Could you elaborate on this?  I don't understand
what the problem you are seeking to avoid is.

...

> compiler/stm_expand.m:
> 	New HLDS -> HLDS transform module.  This module will expand out all
> 	"atomic_goals" into separate predicates which will perform the
> 	required behaviour of Software Transactional Memory.

This module expands the HLDS "atomic_goal" construct into separate 
predicates that implement the behaviour for ...


>       This will
> 	expand atomic_goals in an entire module or an individual predicate
> 	and is designed to be called by "mercury_compile.m" durring the
> 	HLDS -> HLDS transform stage of compilation.

Move this entry to the top of the file-specific changes.

...

> compiler/add_heap_ops.m:
> compiler/add_trail_ops.m:
> compiler/bytecode_gen.m:
> compiler/closure_analysis.m:
> compiler/code_gen.m:
> compiler/code_util.m:
> compiler/constraints.m:
> compiler/dead_proc_elim.m:
> compiler/deep_profiling.m:
> compiler/deforest.m:
> compiler/delay_construct.m:
> compiler/dep_par_conj.m:
> compiler/distance_granularity.m:
> compiler/erl_code_gen.m:
> compiler/exception_analysis.m:
> compiler/follow_code.m:
> compiler/follow_vars.m:
> compiler/granularity.m:
> compiler/hhf.m:
> compiler/higher_order.m:
> compiler/implicit_parallelism.m:
> compiler/inlining.m:
> compiler/interval.m:
> compiler/lco.m:
> compiler/live_vars.m:
> compiler/liveness.m:
> compiler/loop_inv.m:
> compiler/make_static_terms.m:
> compiler/ml_code_gen.m:
> compiler/pd_const.m:
> compiler/prog_rep.m:
> compiler/rbmm.actual_region_arguments.m:
> compiler/rbmm.add_rbmm_goal_infos.m:
> compiler/rbmm.condition_renaming.m:
> compiler/rbmm.execution_path.m:
> compiler/rbmm.points_to_analysis.m:
> compiler/rbmm.region_transformation.m:
> compiler/saved_vars.m:
> compiler/size_prof.m:
> compiler/store_alloc.m:
> compiler/structure_reuse.direct.choose_reuse.m:
> compiler/structure_reuse.direct.detect_garbage.m:
> compiler/structure_reuse.indirect.m:
> compiler/structure_reuse.lbu.m:
> compiler/structure_reuse.versions.m:
> compiler/structure_sharing.analysis.m:
> compiler/tabling_analysis.m:
> compiler/term_constr_build.m:
> compiler/term_pass1.m:
> compiler/term_traversal.m:
> compiler/trailing_analysis.m:
> compiler/tupling.m:
> compiler/unneeded_code.m:
> compiler/untupling.m:
> compiler/unused_args.m:
> 	Added calls to "unexpected" indicating that atomic_goals should be
> 	expanded out at that stage.

Where relevant also add comment saying that we expected atomic_goals
to have been expanded away.  It is potentially confusing when something
that processes a shorthand_goal has such a comment and 
shorthand goal has such a comment a


Also, for the big lists files that only contain minor changes, it is
more concise just to say:

compiler/*.m:
 	Add calls to unexpected/2 ...



> doc/reference_manual.texi:
> 	Began writing a section documenting how to use the Software
> 	Transactional Memory constructs in programs.  Currently this section
> 	is listed in the section of Melbourne University Mercury Extensions
> 	and explains how to use the atomic scope and a brief explaination
> 	about transaction variables.  Still a work in progress.

I don't think the reference manual changes should be committed



> library/ops.m:
> 	Added the "atomic" operator as a binary posfix operator and "or_else"
> 	as a binary infix operator.
>
> library/stm_builtin.m:
> 	Fixed a number of bugs.  Addition of closure versions of atomic
> 	goals and "or_else" by juliensf also included.
>
> mdbcomp/program_representation.m:
> 	Addition of the "stem_atomic_main" and "step_atomic_orelse" goal
> 	paths.
>
> runtime/mercury_conf_params.h:
> 	Addition of the flag "MR_STM_PROFILE" which, when defined, will
> 	perform and display performance and profiling information which
> 	may be useful for evaluation purposes.  Not used at the moment.

>
> runtime/mercury_stm.c:
> 	Fixed up a few bugs and added a few more tracing code.  Also fully

The log message should mention what the bugs were.

> 	implemented wait queues, merging of transaction logs and blocking and
> 	rescheduling of threads (for the "hlc" at the moment).
>
> runtime/mercury_stm.h:
> 	Changed declarations of condition variables from POSIX condition
> 	variables to Mercury condition variables in "mercury_thread.h".
> 	Also added prototypes for wait queues, merging of transaction logs
> 	and blocking/rescheduling of threads.
>
>
> Index: compiler/add_clause.m
> ===================================================================
> RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_clause.m,v
> retrieving revision 1.45
> diff -u -r1.45 add_clause.m
> --- compiler/add_clause.m	28 Sep 2007 03:17:11 -0000	1.45
> +++ compiler/add_clause.m	9 Oct 2007 02:45:53 -0000
> @@ -677,6 +677,78 @@
>     transform_promise_eqv_goal(Vars0, DotSVars0, ColonSVars0,
>         Context, Renaming, Vars, Goal0, Goal, GoalInfo, NumAdded,
>         !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs).
> +transform_goal_2(atomic_expr(Outer0, Inner0, MaybeVars0, MainGoalExpr0,
> +        OrElseGoalsExprs), Context, Renaming, Goal, !:NumAdded, !VarSet, + 
> !ModuleInfo, !QualInfo, !SInfo, !Specs) :-
> +    rename_atomic_component_vars(Inner0, Renaming, Inner),
> +    rename_atomic_component_vars(Outer0, Renaming, Outer),
> +    (
> +        Outer0 = atomic_state_var(_),
> +        sorry(this_file, "transform_goal_2: atomic_state_var")
> +        % XXX Need to implement

s/XXX/XXX STM/

> +    ;
> +        Outer0 = atomic_var_pair(OuterDI, OuterUO)
> +    ),
> +
> +    (
> +        Inner0 = atomic_state_var(_),
> +        sorry(this_file, "transform_goal_2: atomic_state_var")
> +        % XXX Need to implement

s/XXX/XXX STM/

> +    ;
> +        Inner0 = atomic_var_pair(InnerDI, InnerUO)
> +    ),
> +
> +    (
> +        MaybeVars0 = no,
> +        MaybeVars = no
> +    ;
> +        MaybeVars0 = yes(OutVars0),
> +        rename_var_list(need_not_rename, Renaming, OutVars0, OutVars),
> +        MaybeVars = yes(OutVars)
> +    ),
> +
> +    % TODO: Need to extend this to handle stm -> stm as well.
> +    IOToStmName = qualified(mercury_stm_builtin_module, + 
> "stm_from_outer_to_inner_io"),
> +    StmToIOName = qualified(mercury_stm_builtin_module, + 
> "stm_from_inner_to_outer_io"),
> +
> +    OuterDIVar = term.variable(OuterDI, Context),
> +    OuterUOVar = term.variable(OuterUO, Context),
> +    InnerDIVar = term.variable(InnerDI, Context),
> +    InnerUOVar = term.variable(InnerUO, Context),
> +
> +    Purity = purity_pure,
> +
> +    PreGoal = call_expr(IOToStmName, [OuterDIVar, InnerDIVar], + 
> Purity) - Context,
> +    PostGoal = call_expr(StmToIOName, [InnerUOVar, OuterUOVar], + 
> Purity) - Context,
> +
> +    MainGoalExpr = goal_list_to_conj(Context, +        [PreGoal, 
> MainGoalExpr0, PostGoal]),
> + +    transform_goal(MainGoalExpr, Renaming, MainGoal,
> +        !:NumAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
> +
> +    (
> +        OrElseGoalsExprs = [],
> +        OrElseGoals = [],
> +        OrElseNumAdded = 0
> +    ;
> +        OrElseGoalsExprs = [_ | _],
> +        % TODO: Also do the same for each or_else branch.
> +        transform_orelse_goals(OrElseGoalsExprs, PreGoal, PostGoal, + 
> Renaming, OrElseGoals, 0,
> +            OrElseNumAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs)
> +    ),
> +
> +    !:NumAdded = !.NumAdded + OrElseNumAdded + 1,
> +
> +    GoalExpr = atomic_goal(unknown_atomic_goal_type, Outer, Inner,
> +        MaybeVars, MainGoal, OrElseGoals),
> +    Goal = hlds_goal(GoalExpr, GoalInfo),
> +    goal_info_init(GoalInfo).
> transform_goal_2(
>         trace_expr(MaybeCompileTime, MaybeRunTime, MaybeIO, Mutables, 
> Goal0),
>         Context, Renaming, hlds_goal(scope(Reason, Goal), GoalInfo), 
> NumAdded,
> @@ -1253,6 +1325,47 @@
>         Disj = [{Goal1, SInfo1} | Disj0]
>     ).
>
> +:- pred rename_atomic_component_vars(atomic_component_state::in,
> +    prog_var_renaming::in, atomic_component_state::out) is det.
> +
> +rename_atomic_component_vars(AtomicCompState0, Renaming, AtomicCompState) :-
> +    (
> +        AtomicCompState0 = atomic_state_var(Var0),
> +        rename_var(need_not_rename, Renaming, Var0, Var),
> +        AtomicCompState = atomic_state_var(Var)
> +    ;
> +        AtomicCompState0 = atomic_var_pair(VarDI0, VarUO0),
> +        rename_var(need_not_rename, Renaming, VarDI0, VarDI),
> +        rename_var(need_not_rename, Renaming, VarUO0, VarUO),
> +        AtomicCompState = atomic_var_pair(VarDI, VarUO)
> +    ).
> +
> +:- pred transform_orelse_goals(goals::in, goal::in, goal::in, + 
> prog_var_renaming::in, hlds_goals::out, num_added_goals::in, + 
> num_added_goals::out, prog_varset::in, prog_varset::out,
> +    module_info::in, module_info::out, qual_info::in, qual_info::out,
> +    svar_info::in, svar_info::out,
> +    list(error_spec)::in, list(error_spec)::out) is det.
> +
> +transform_orelse_goals([], _, _, _, [], NumAdded, NumAdded, !VarSet, + 
> !ModuleInfo, !QualInfo, !SInfo, !Specs).
> +transform_orelse_goals([Goal | Goals], PreGoal, PostGoal, Renaming, + 
> [HldsGoal | HldsGoals], NumAdded0, NumAdded, !VarSet, !ModuleInfo, + 
> !QualInfo, !SInfo, !Specs) :-
> +    Goal = (_ - Context),
> +
> +    NewGoal = goal_list_to_conj(Context, +        [PreGoal, Goal, 
> PostGoal]),
> +
> +    NewGoal = (GoalExpr - _),
> +
> +    transform_goal_2(GoalExpr, Context, Renaming, HldsGoal, NumAddedGoal,
> +        !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
> +
> +    NumAdded1 = NumAdded0 + NumAddedGoal,
> +    transform_orelse_goals(Goals, PreGoal, PostGoal, Renaming, HldsGoals, + 
> NumAdded1, NumAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs).
> +

...


> Index: compiler/assertion.m
> ===================================================================
> RCS file: /home/mercury/mercury1/repository/mercury/compiler/assertion.m,v
> retrieving revision 1.58
> diff -u -r1.58 assertion.m
> --- compiler/assertion.m	7 Aug 2007 07:09:46 -0000	1.58
> +++ compiler/assertion.m	1 Oct 2007 02:44:08 -0000
> @@ -701,6 +701,13 @@
>         normalise_goal(Then0, Then),
>         normalise_goal(Else0, Else),
>         GoalExpr = if_then_else(Vars, Cond, Then, Else)
> +    ;   % XXX STM - To Check

What does that mean?

> +        GoalExpr0 = atomic_goal(GoalType, Outer, Inner, Vars, + 
> MainGoal0, OrElseAlternatives0),
> +        normalise_goal(MainGoal0, MainGoal),
> +        normalise_goals(OrElseAlternatives0, OrElseAlternatives),
> +        GoalExpr = atomic_goal(GoalType, Outer, Inner, Vars, MainGoal,
> +            OrElseAlternatives)
>     ;
>         GoalExpr0 = shorthand(ShortHandGoal0),
>         normalise_goal_shorthand(ShortHandGoal0, ShortHandGoal),

...

> Index: compiler/bytecode_gen.m
> ===================================================================
> RCS file: /home/mercury/mercury1/repository/mercury/compiler/bytecode_gen.m,v
> retrieving revision 1.115
> diff -u -r1.115 bytecode_gen.m
> --- compiler/bytecode_gen.m	11 Sep 2007 03:12:27 -0000	1.115
> +++ compiler/bytecode_gen.m	9 Oct 2007 03:00:39 -0000
> @@ -299,6 +299,9 @@
>         GoalExpr = call_foreign_proc(_, _, _, _, _, _, _),
>         Code = node([byte_not_supported])
>     ;
> +        GoalExpr = atomic_goal(_, _, _, _, _, _),
> +        sorry(this_file, "goal_expr: unexpecet atomic_goal")


s/unexpecet/unexpected/


> Index: compiler/closure_analysis.m
> ===================================================================
> RCS file: 
> /home/mercury/mercury1/repository/mercury/compiler/closure_analysis.m,v
> retrieving revision 1.15
> diff -u -r1.15 closure_analysis.m
> --- compiler/closure_analysis.m	7 Aug 2007 07:09:47 -0000	1.15
> +++ compiler/closure_analysis.m	9 Oct 2007 03:00:53 -0000
> @@ -369,6 +369,10 @@
>     list.filter_map(ForeignHOArgs, Args, OutputForeignHOArgs),
>     svmap.det_insert_from_assoc_list(OutputForeignHOArgs, !ClosureInfo),
>     Goal = hlds_goal(GoalExpr, GoalInfo).
> +
> +process_goal(_, _, hlds_goal(atomic_goal(_, _, _, _, _, _), _), _, _, _) :-
> +    unexpected(this_file, "atomic_goal/4 goal durring closure analysis.").

s/durring/during/

...

> Index: compiler/cse_detection.m
> ===================================================================
> RCS file: 
> /home/mercury/mercury1/repository/mercury/compiler/cse_detection.m,v
> retrieving revision 1.110
> diff -u -r1.110 cse_detection.m
> --- compiler/cse_detection.m	7 Aug 2007 07:09:49 -0000	1.110
> +++ compiler/cse_detection.m	1 Oct 2007 02:44:09 -0000
> @@ -248,6 +248,10 @@
>     instmap::in, cse_info::in, cse_info::out, bool::out,
>     hlds_goal_expr::out) is det.
>
> +% XXX STM - To Check and finish
> +detect_cse_in_goal_2(Goal @ atomic_goal(_, _, _, _, _, _), _, _,
> +        !CseInfo, no, Goal).

CSE needs to happen for atomic goals as well.

...

> Index: compiler/deforest.m
> ===================================================================
> RCS file: /home/mercury/mercury1/repository/mercury/compiler/deforest.m,v
> retrieving revision 1.81
> diff -u -r1.81 deforest.m
> --- compiler/deforest.m	7 Aug 2007 07:09:50 -0000	1.81
> +++ compiler/deforest.m	9 Oct 2007 03:02:42 -0000
> @@ -357,6 +357,10 @@
> deforest_goal_expr(GoalExpr, GoalExpr, !GoalInfo, !PDInfo, !IO) :-
>     GoalExpr = unify(_, _, _, _, _).
>
> +deforest_goal_expr(atomic_goal(_, _, _, _, _, _), _, !GoalInfo, !PDInfo, 
> !IO) :-
> +    % these should have been expanded out by now

Sentences begin with a capital letter and end with a full stop.

...

> Index: compiler/delay_partial_inst.m
> ===================================================================
> RCS file: 
> /home/mercury/mercury1/repository/mercury/compiler/delay_partial_inst.m,v
> retrieving revision 1.3
> diff -u -r1.3 delay_partial_inst.m
> --- compiler/delay_partial_inst.m	28 Sep 2007 03:17:11 -0000	1.3
> +++ compiler/delay_partial_inst.m	1 Oct 2007 02:44:09 -0000
> @@ -432,6 +432,16 @@
>         ),
>         Goal = Goal0
>     ;
> +        % XXX STM - To Check
> +        GoalExpr0 = atomic_goal(GoalType, Inner, Outer, Vars, MainGoal0,
> +            OrElseAlternatives0),
> +        delay_partial_inst_in_goal(InstMap0, MainGoal0, MainGoal,
> +            !.ConstructMap, _, !DelayInfo),
> +        delay_partial_inst_in_goals(InstMap0, OrElseAlternatives0,
> +            OrElseAlternatives, !.ConstructMap, _, !DelayInfo),
> +        Goal = hlds_goal(atomic_goal(GoalType, Inner, Outer, Vars, + 
> MainGoal, OrElseAlternatives), GoalInfo0)
> +    ;
>         GoalExpr0 = shorthand(_),
>         % These should have been expanded out by now.
>         unexpected(this_file,

...

> Index: compiler/dependency_graph.m
> ===================================================================
> RCS file: 
> /home/mercury/mercury1/repository/mercury/compiler/dependency_graph.m,v
> retrieving revision 1.96
> diff -u -r1.96 dependency_graph.m
> --- compiler/dependency_graph.m	7 Sep 2007 15:08:16 -0000	1.96
> +++ compiler/dependency_graph.m	1 Oct 2007 02:44:09 -0000
> @@ -410,6 +410,12 @@
>     ;
>         GoalExpr = call_foreign_proc(_, _, _, _, _, _, _)
>     ;
> +        % XXX STM - To Check
> +        GoalExpr = atomic_goal(_GoalType, _Outer, _Inner, _Vars, MainGoal,
> +            OrElseGoals),
> +        add_dependency_arcs_in_goal(MainGoal, Caller, !DepGraph),
> +        add_dependency_arcs_in_list(OrElseGoals, Caller, !DepGraph)

Delete the XXX there.

...

> ===================================================================
> RCS file: /home/mercury/mercury1/repository/mercury/compiler/det_analysis.m,v
> retrieving revision 1.208
> diff -u -r1.208 det_analysis.m
> --- compiler/det_analysis.m	7 Aug 2007 07:09:50 -0000	1.208
> +++ compiler/det_analysis.m	9 Oct 2007 03:03:46 -0000
> @@ -622,6 +622,15 @@
>             GoalFailingContexts, !Specs),
>         GoalExpr = GoalExpr0
>     ;
> +        GoalExpr0 = atomic_goal(GoalType, Inner, Outer, Vars, MainGoal0,
> +            OrElseGoals0),
> +        det_infer_atomic(MainGoal0, MainGoal, OrElseGoals0, OrElseGoals, + 
> GoalInfo, InstMap0, SolnContext, RightFailingContexts, + 
> MaybePromiseEqvSolutionSets, DetInfo, Detism, GoalFailingContexts,
> +            !Specs),
> +        GoalExpr = atomic_goal(GoalType, Inner, Outer, Vars, MainGoal,
> +            OrElseGoals)
> +    ;
>         GoalExpr0 = shorthand(_),
>         % These should have been expanded out by now.
>         unexpected(this_file, "det_infer_goal_2: unexpected shorthand")
> @@ -1293,6 +1302,147 @@
>
> %-----------------------------------------------------------------------------%
>
> +
> +:- pred det_infer_atomic(hlds_goal::in, hlds_goal::out,
> +    hlds_goals::in, hlds_goals::out, hlds_goal_info::in, instmap::in, + 
> soln_context::in, list(failing_context)::in, maybe(pess_info)::in, + 
> det_info::in, determinism::out, list(failing_context)::out,
> +    list(error_spec)::in, list(error_spec)::out) is det.
> +
> +det_infer_atomic(MainGoal0, MainGoal, OrElseGoals0, OrElseGoals, + 
> GoalInfo, InstMap0, SolnContext, RightFailingContexts, + 
> MaybePromiseEqvSolutionSets0, DetInfo, Detism, GoalFailingContexts, + 
> !Specs) :-
> +    (
> +        OrElseGoals0 = [],
> +        AnyOrElse = no
> +    ;
> +        OrElseGoals0 = [_ | _],
> +        AnyOrElse = yes
> +    ),
> +    det_infer_atomic_main(AnyOrElse, MainGoal0, MainGoal, GoalInfo, + 
> InstMap0, SolnContext, RightFailingContexts, + 
> MaybePromiseEqvSolutionSets0, DetInfo, MainDetism, + 
> MainGoalFailingContexts, !Specs),
> +    (
> +        OrElseGoals0 = [],
> +        Detism = MainDetism,
> +        GoalFailingContexts = MainGoalFailingContexts,
> +        OrElseGoals = []
> +    ;
> +        OrElseGoals0 = [_ | _],
> +        det_infer_orelse(OrElseGoals0, OrElseGoals, GoalInfo,
> +            InstMap0, SolnContext, RightFailingContexts,
> +            MaybePromiseEqvSolutionSets0, DetInfo, Detism,
> +            GoalFailingContexts, !Specs)
> +    ).
> +
> +:- pred det_infer_atomic_main(bool::in, hlds_goal::in, hlds_goal::out,
> +    hlds_goal_info::in, instmap::in, soln_context::in,
> +    list(failing_context)::in, maybe(pess_info)::in, det_info::in,
> +    determinism::out, list(failing_context)::out, list(error_spec)::in, + 
> list(error_spec)::out) is det.
> +
> +det_infer_atomic_main(_AtomicGoalHasOrElse, Goal0, Goal, GoalInfo, InstMap0, 
> SolnContext,
> +        RightFailingContexts, MaybePromiseEqvSolutionSets0, DetInfo, Detism,
> +        GoalFailingContexts, !Specs) :-
> +    det_infer_goal(Goal0, Goal, InstMap0, SolnContext,
> +        RightFailingContexts, MaybePromiseEqvSolutionSets0, DetInfo,
> +        Detism, GoalFailingContexts, !Specs),
> +    (
> +        ( Detism = detism_det
> +        ; Detism = detism_cc_multi
> +        ; Detism = detism_erroneous
> +        )
> +    ;
> +        ( Detism = detism_semi
> +        ; Detism = detism_multi
> +        ; Detism = detism_non
> +        ; Detism = detism_cc_non
> +        ; Detism = detism_failure
> +        ),
> +        Context = goal_info_get_context(GoalInfo),
> +        DetismStr = determinism_to_string(Detism),
> +        Pieces = [words("Error: atomic goal has determinism"),
> +            quote(DetismStr), suffix(","),
> +            words("should be det or cc_multi.")],
> +        Spec = error_spec(severity_error, phase_detism_check,
> +            [simple_msg(Context, [always(Pieces)])]),
> +        !:Specs = [Spec | !.Specs]
> +    ).
> + +
> +:- pred det_infer_orelse(list(hlds_goal)::in, list(hlds_goal)::out,
> +    hlds_goal_info::in, instmap::in, soln_context::in,
> +    list(failing_context)::in, maybe(pess_info)::in, det_info::in,
> +    determinism::out, list(failing_context)::out,
> +    list(error_spec)::in, list(error_spec)::out) is det.
> +
> +det_infer_orelse(Goals0, Goals, GoalInfo, InstMap0, SolnContext,
> +        RightFailingContexts, MaybePromiseEqvSolutionSets, DetInfo,
> +        Detism, GoalFailingContexts, !Specs) :-
> +    det_infer_orelse_goals(Goals0, Goals, InstMap0, SolnContext,
> +        RightFailingContexts, MaybePromiseEqvSolutionSets, DetInfo,
> +        can_fail, at_most_zero, Detism, [], GoalFailingContexts0, !Specs),
> +    (
> +        Goals = [],
> +        Context = goal_info_get_context(GoalInfo),
> +        FailingContext = failing_context(Context, fail_goal),
> +        GoalFailingContexts = [FailingContext | GoalFailingContexts0]
> +    ;
> +        Goals = [_ | _],
> +        % XXX Should we add to the failing contexts here?
> +        GoalFailingContexts = GoalFailingContexts0
> +    ).
> +
> +:- pred det_infer_orelse_goals(list(hlds_goal)::in, list(hlds_goal)::out,
> +    instmap::in, soln_context::in, list(failing_context)::in,
> +    maybe(pess_info)::in, det_info::in, can_fail::in, soln_count::in,
> +    determinism::out, list(failing_context)::in, list(failing_context)::out,
> +    list(error_spec)::in, list(error_spec)::out) is det.
> +
> +det_infer_orelse_goals([], [], _InstMap0, _SolnContext, 
> _RightFailingContexts,
> +        _MaybePromiseEqvSolutionSets, _DetInfo, CanFail, MaxSolns, Detism,
> +         !OrElseFailingContexts, !Specs) :-
> +    determinism_components(Detism, CanFail, MaxSolns).
> +det_infer_orelse_goals([Goal0 | Goals0], [Goal | Goals], InstMap0, 
> SolnContext,
> +        RightFailingContexts, MaybePromiseEqvSolutionSets, DetInfo,
> +        !.CanFail, !.MaxSolns, Detism, !OrElseFailingContexts, !Specs) :-
> +    det_infer_goal(Goal0, Goal, InstMap0, SolnContext, RightFailingContexts,
> +        MaybePromiseEqvSolutionSets, DetInfo, FirstDetism, 
> GoalFailingContexts,
> +        !Specs),
> +    (
> +        ( FirstDetism = detism_det
> +        ; FirstDetism = detism_cc_multi
> +        ; FirstDetism = detism_erroneous +        )
> +    ;
> +        ( FirstDetism = detism_semi
> +        ; FirstDetism = detism_multi
> +        ; FirstDetism = detism_non
> +        ; FirstDetism = detism_cc_non
> +        ; FirstDetism = detism_failure
> +        ),
> +        Goal = hlds_goal(_, GoalInfo),
> +        Context = goal_info_get_context(GoalInfo),
> +        DetismStr = determinism_to_string(FirstDetism),
> +        Pieces = [words("Error: atomic goal has determinism"),
> +            quote(DetismStr), suffix(","),
> +            words("should be det or cc_multi.")],
> +        Spec = error_spec(severity_error, phase_detism_check,
> +            [simple_msg(Context, [always(Pieces)])]),
> +        !:Specs = [Spec | !.Specs]
> +    ),
> +    determinism_components(FirstDetism, FirstCanFail, FirstMaxSolns),
> +    det_disjunction_canfail(!.CanFail, FirstCanFail, !:CanFail),
> +    det_disjunction_maxsoln(!.MaxSolns, FirstMaxSolns, !:MaxSolns),
> + +    det_infer_orelse_goals(Goals0, Goals, InstMap0, SolnContext,
> +        RightFailingContexts, MaybePromiseEqvSolutionSets, DetInfo,
> +        !.CanFail, !.MaxSolns, Detism, !OrElseFailingContexts, !Specs),
> +    !:OrElseFailingContexts = GoalFailingContexts ++ 
> !.OrElseFailingContexts.
> +%-----------------------------------------------------------------------------%
> +
> :- pred det_infer_scope(scope_reason::in, hlds_goal::in, hlds_goal::out,
>     hlds_goal_info::in, instmap::in, soln_context::in,
>     list(failing_context)::in, maybe(pess_info)::in, det_info::in,
> Index: compiler/det_report.m
> ===================================================================
> RCS file: /home/mercury/mercury1/repository/mercury/compiler/det_report.m,v
> retrieving revision 1.138
> diff -u -r1.138 det_report.m
> --- compiler/det_report.m	7 Aug 2007 07:09:51 -0000	1.138
> +++ compiler/det_report.m	9 Oct 2007 03:03:55 -0000
> @@ -633,6 +633,25 @@
>         Msgs = []
>     ).
>
> +det_diagnose_goal_2(atomic_goal(_, _, _, _, _, _), GoalInfo, +        _, 
> Actual, _, _, Msgs) :-
> +    determinism_components(Actual, ActualCanFail, ActualSolns),
> +    ( ActualCanFail = can_fail ->
> +        Context = goal_info_get_context(GoalInfo),
> +        Pieces = [words("Atomic goal can fail.")],
> +        Msgs = [simple_msg(Context, [always(Pieces)])]
> +    ; ActualSolns = at_most_zero ->
> +        Context = goal_info_get_context(GoalInfo),
> +        Pieces = [words("Atomic goal can fail.")],
> +        Msgs = [simple_msg(Context, [always(Pieces)])]
> +    ; ActualSolns = at_most_many ->
> +        Context = goal_info_get_context(GoalInfo),
> +        Pieces = [words("Atomic goal is nondet.")],
> +        Msgs = [simple_msg(Context, [always(Pieces)])]
> +    ;
> +        Msgs = []
> +    ).
> +
> det_diagnose_goal_2(scope(_, Goal), _, Desired, Actual, SwitchContext, 
> DetInfo,
>         Msgs) :-
>     Goal = hlds_goal(_, GoalInfo),

...

> Index: compiler/distance_granularity.m
> ===================================================================
> RCS file: 
> /home/mercury/mercury1/repository/mercury/compiler/distance_granularity.m,v
> retrieving revision 1.4
> diff -u -r1.4 distance_granularity.m
> --- compiler/distance_granularity.m	7 Aug 2007 07:09:51 -0000	1.4
> +++ compiler/distance_granularity.m	9 Oct 2007 03:04:21 -0000
>         unexpected(this_file, "apply_dg_to_goal")

...

> @@ -924,6 +927,9 @@
>         GoalExpr = if_then_else(Vars, Cond, Then, Else),
>         !:Goal = hlds_goal(GoalExpr, GoalInfo)
>     ;
> +        GoalExpr0 = atomic_goal(_, _, _, _, _, _),
> +        sorry(this_file, "update_original_predicate_goal: atomic_goal")
> +    ;

atomic_goals should have been transformed away by now, so just
call unexpected/2 there.

...

> Index: compiler/follow_code.m
> ===================================================================
> RCS file: /home/mercury/mercury1/repository/mercury/compiler/follow_code.m,v
> retrieving revision 1.91
> diff -u -r1.91 follow_code.m
> --- compiler/follow_code.m	7 Aug 2007 10:03:47 -0000	1.91
> +++ compiler/follow_code.m	9 Oct 2007 03:05:14 -0000
> @@ -155,6 +155,10 @@
>         ),
>         Goal = Goal0
>     ;
> +        GoalExpr0 = atomic_goal(_, _, _, _, _, _),
> +        unexpected(this_file,
> +            "move_follow_code_in_goal: unexpected shorthand")

shorthand? I think you mean atomic_goal.

...

> Index: compiler/goal_form.m
> ===================================================================
> RCS file: /home/mercury/mercury1/repository/mercury/compiler/goal_form.m,v
> retrieving revision 1.39
> diff -u -r1.39 goal_form.m
> --- compiler/goal_form.m	7 Aug 2007 07:09:53 -0000	1.39
> +++ compiler/goal_form.m	9 Oct 2007 03:05:59 -0000
> @@ -243,6 +243,15 @@
>         OuterGoal = scope(_, InnerGoal)
>     ),
>     goal_can_throw(InnerGoal, Result, !ModuleInfo, !IO).
> +
> +% Atomic goals currently throw an exception to signal a rollback so
> +% it is pretty safe to say that any goal inside an atomic goal can throw
> +% an exception.
> +goal_can_throw_2(Goal, _GoalInfo, Result, !ModuleInfo, !IO) :-
> +    Goal = atomic_goal(_GoalType, _Outer, _Inner, _Vars, _MainGoal, +

It is safe to say it, although it may not need to be useful to.  There
is a distinction between exceptions as are used by the STM execution
mechanism and those that are thrown by user code; the former should not
be taken into consideration by the things that call goal_can_throw_2.

Put an XXX comment saying that the relationship between this and STM
needs further work.

> _OrElseAlternatives),
> +    Result = can_throw.
> +
> goal_can_throw_2(Goal, _, Result, !ModuleInfo, !IO) :-
>     Goal = call_foreign_proc(Attributes, _, _, _, _, _, _),
>     ExceptionStatus = get_may_throw_exception(Attributes),
> @@ -398,6 +407,12 @@
>     ;
>         CanLoop = yes
>     ).
> +goal_expr_can_loop(MaybeModuleInfo, Goal) = CanLoop :-
> +    Goal = atomic_goal(_, _, _, _, MainGoal, OrElseAlternatives),
> +    MainGoal = hlds_goal(MainGoalExpr, _),
> +    MainGoalCanLoop = goal_expr_can_loop(MaybeModuleInfo, MainGoalExpr),
> +    OrElseCanLoop = goal_list_can_loop(MaybeModuleInfo, OrElseAlternatives),
> +    CanLoop = MainGoalCanLoop `or` OrElseCanLoop.
> goal_expr_can_loop(_MaybeModuleInfo, Goal) = yes :-
>     % We have no idea whether the called goal can throw exceptions,
>     % at least without closure analysis.
> @@ -524,6 +539,8 @@
>         % predicate.
>         CanThrow = yes
>     ).
> +goal_expr_can_throw(_, atomic_goal(_, _, _, _, _, _)) = yes.
> +
> goal_expr_can_throw(_, shorthand(_)) = _ :-
>     unexpected(this_file, "goal_expr_can_throw: shorthand").
>
> @@ -570,6 +587,7 @@
> goal_is_flat_expr(if_then_else(_, _, _, _)) = no.
> goal_is_flat_expr(negation(Goal)) = goal_is_flat(Goal).
> goal_is_flat_expr(scope(_, Goal)) = goal_is_flat(Goal).
> +goal_is_flat_expr(atomic_goal(_, _, _, _, _, _)) = no.
> goal_is_flat_expr(shorthand(_)) = no.
>
> :- func goal_is_flat_list(list(hlds_goal)) = bool.
> @@ -643,6 +661,8 @@
>     ;
>         goal_may_allocate_heap(E, May)
>     ).
> +goal_may_allocate_heap_2(atomic_goal(_, _, _, _, _, _), May) :-
> +    May = yes.
> goal_may_allocate_heap_2(shorthand(ShorthandGoal), May) :-
>     goal_may_allocate_heap_2_shorthand(ShorthandGoal, May).
>
> @@ -790,6 +810,13 @@
>     CTMax = CMax + TMax,
>     int.min(CTMin, EMin, Min),
>     int.max(CTMax, EMax, Max).
> +count_recursive_calls_2(atomic_goal(_, _, _, _, MainGoal, 
> OrElseAlternatives),
> +        PredId, ProcId, Min, Max) :-
> +    count_recursive_calls(MainGoal, PredId, ProcId, MMin, MMax),
> +    count_recursive_calls_disj(OrElseAlternatives, PredId, ProcId, + 
> OMin, OMax),
> +    int.min(MMin, OMin, Min),
> +    int.max(MMax, OMax, Max).
> count_recursive_calls_2(shorthand(_), _, _, _, _) :-
>     % these should have been expanded out by now
>     unexpected(this_file, "count_recursive_calls_2: unexpected shorthand").

...


> Index: compiler/hlds_goal.m
> ===================================================================
> RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_goal.m,v
> retrieving revision 1.182
> diff -u -r1.182 hlds_goal.m
> --- compiler/hlds_goal.m	28 Sep 2007 03:17:11 -0000	1.182
> +++ compiler/hlds_goal.m	1 Oct 2007 02:44:09 -0000
> @@ -199,6 +199,50 @@
>                 scope_goal          :: hlds_goal
>             )
>
> +    ;       atomic_goal(
> +                % An atomic goal that will be executed atomically against
> +                % all running threads using the stm system.
> +
> +                atomic_goal_type    :: atomic_goal_type,
> +                                    % The type of atomic goal.  Either
> +                                    % a toplevel atomic goal or a nested
> +                                    % atomic goal.  This isn't known
> +                                    % until after typechecking.
> + +                atomic_outer        :: atomic_component_state,
> +                                    % The outer atomic variables.  Either
> +                                    % represented as a pair of prog_vars
> +                                    % (shen specified in the program as

s/shen/when/

> +                                    % `outer(Var1, Var2)`) or a single
> +                                    % state prog_var (when specified in the
> +                                    % program as `outer(!Var)`.
> +
> +                atomic_inner        :: atomic_component_state,
> +                                    % The inner atomic variables.  Either
> +                                    % represented as a pair of prog_vars
> +                                    % (shen specified in the program as

s/shen/when/

> +                                    % `inner(Var1, Var2)`) or a single
> +                                    % state prog_var (when specified in the
> +                                    % program as `inner(!Var)`.
> +
> +                atomic_output_vars  :: maybe(list(prog_var)),
> +                                    % List of specified output variables
> +                                    % (that exist within the `var(...)`
> +                                    % functor).  These variables will be
> +                                    % free when the atomic goal is started 
> and
> +                                    % grounded when the atomic goal is

s/grounded/ground/

(I think you probably lose subtype information on the output variables,
but fixing that is not important at the moment.)


> +                                    % complete.
> +
> +                atomic_main_goal    :: hlds_goal,
> +                                    % The main atomic transaction goal.  If
> +                                    % any or_else goals also exist, this 
> goal
> +                                    % is the first or_else alternative.

Does that last sentence mean:

 	If the top-level goal is an or_else goal then this is the first
 	or_else alternative.

> +
> +                orelse_alternatives :: hlds_goals
> +                                    % Any other or_else alternative goals.
> + +            )
> +

...

> :- type conj_type
>     --->    plain_conj
> @@ -229,6 +274,12 @@
>     --->    before_semantic_analysis
>     ;       after_semantic_analysis.
>
> +:- type atomic_goal_type
> +    --->    unknown_atomic_goal_type
> +    ;       top_level_atomic_goal
> +    ;       nested_atomic_goal.

Add a comment describing the functors of this type.

> @@ -2552,6 +2653,9 @@
>             HasForeign = no
>         )
>     ;
> +        GoalExpr = atomic_goal(_, _, _, _, _, _),
> +        HasForeign = yes
> +    ;
>         GoalExpr = call_foreign_proc(_, _, _, _, _, _, _),
>         HasForeign = yes
>     ;

Why do you set HasForeign to `yes' for atomic_goals?
Shouldn't you call goal_has_foreign for each of its sub-goals?

...

> Index: compiler/mercury_to_mercury.m
> ===================================================================
> RCS file: 
> /home/mercury/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
> retrieving revision 1.319
> diff -u -r1.319 mercury_to_mercury.m
> --- compiler/mercury_to_mercury.m	27 Aug 2007 06:22:13 -0000	1.319
> +++ compiler/mercury_to_mercury.m	9 Oct 2007 03:06:50 -0000
> @@ -2774,6 +2774,39 @@
>     mercury_output_newline(Indent, !IO),
>     io.write_string(")", !IO).
>
> +mercury_output_goal_2(atomic_expr(Outer, Inner, _, MainExpr, + 
> OrElseExprs), VarSet, Indent, !IO) :-
> +    io.write_string("atomic [outer(", !IO),
> +    (
> +        Outer = atomic_state_var(OVar),
> +        io.write_string("!", !IO),
> +        mercury_output_var(VarSet, no, OVar, !IO)
> +    ;
> +        Outer = atomic_var_pair(OuterDI, OuterUO),
> +        mercury_output_var(VarSet, no, OuterDI, !IO),
> +        io.write_string(", ", !IO),
> +        mercury_output_var(VarSet, no, OuterUO, !IO)
> +    ),
> +    io.write_string("), inner(", !IO),
> +    (
> +        Inner = atomic_state_var(IVar),
> +        io.write_string("!", !IO),
> +        mercury_output_var(VarSet, no, IVar, !IO)
> +    ;
> +        Inner = atomic_var_pair(InnerDI, InnerUO),
> +        mercury_output_var(VarSet, no, InnerDI, !IO),
> +        io.write_string(", ", !IO),
> +        mercury_output_var(VarSet, no, InnerUO, !IO)
> +    ),
> +    io.write_string(")] (", !IO),
> +
> +    Indent1 = Indent + 1,
> +    mercury_output_newline(Indent1, !IO),

or even just:

 	mercury_output_newline(Indent + 1, !IO).

> +    mercury_output_orelse_goals([MainExpr | OrElseExprs], VarSet, Indent1,
> +        !IO),
> +    mercury_output_newline(Indent, !IO),
> +    io.write_string(")", !IO).
> +
> mercury_output_goal_2(Expr, VarSet, Indent, !IO) :-
>     Expr = trace_expr(MaybeCompileTime, MaybeRunTime, MaybeIO, MutableVars,
>         Goal),
> @@ -3096,6 +3129,29 @@
>
> %-----------------------------------------------------------------------------%
>
> +:- pred mercury_output_orelse_goals(goals::in, prog_varset::in, int::in,
> +    io::di, io::uo) is det.
> +
> +mercury_output_orelse_goals(Goals, VarSet, Indent, !IO) :-
> +    (
> +        Goals = []
> +    ;
> +        Goals = [Goal0 | GoalTails],
> +        (
> +            GoalTails = [],
> +            mercury_output_goal(Goal0, VarSet, Indent + 1, !IO)
> +        ;
> +            GoalTails = [_|_],

s/[_|_]/[_ | _]/

> +            mercury_output_goal(Goal0, VarSet, Indent + 1, !IO),
> +            mercury_output_newline(Indent, !IO),
> +            io.write_string("orelse", !IO),
> +            mercury_output_newline(Indent, !IO),
> +            mercury_output_orelse_goals(GoalTails, VarSet, Indent, !IO)
> +        )

...


> Index: compiler/modes.m
> ===================================================================
> RCS file: /home/mercury/mercury1/repository/mercury/compiler/modes.m,v
> retrieving revision 1.360
> diff -u -r1.360 modes.m
> --- compiler/modes.m	14 Aug 2007 01:52:29 -0000	1.360
> +++ compiler/modes.m	9 Oct 2007 03:07:34 -0000
> @@ -1669,6 +1669,63 @@
>     mode_info_unset_call_context(!ModeInfo),
>     mode_checkpoint(exit, "pragma_foreign_code", !ModeInfo, !IO).
>
> +modecheck_goal_expr(atomic_goal(GoalType, Outer, Inner, Vars, MainGoal0, + 
> OrElseGoals0), GoalInfo0, GoalExpr, !ModeInfo, !IO) :-
> +
> +    mode_checkpoint(enter, "atomic", !ModeInfo, !IO),
> +
> +    (
> +        Outer = atomic_state_var(_),
> +        sorry(this_file, "atomic_state_var not yet supported")
> +    ;
> +        Outer = atomic_var_pair(OuterDI, OuterUO),
> +
> +        OuterVars0 = set.init,
> +        set.insert(OuterVars0, OuterDI, OuterVars1),
> +        set.insert(OuterVars1, OuterUO, _OuterVars)
> +    ),
> +
> +    (
> +        Inner = atomic_state_var(_Var),
> +        sorry(this_file, "atomic_state_var not yet supported")
> +    ;
> +        Inner = atomic_var_pair(_InnerDI, _InnerUO)
> +
> +    ),
> +
> +    AtomicGoalList0 = [MainGoal0 | OrElseGoals0],
> +
> +    NonLocals = goal_info_get_nonlocals(GoalInfo0),
> +
> +    % XXX STM: Locking the outer variables will generate an error message
> +    % durring mode analysis of the sub goal because of the calls to

s/durring/during/

> +    % "stm_outer_to_inner_io" and "stm_inner_to_outer_io".  I don't think
> +    % this is a major problem as the uniqueness states of the outer and
> +    % inner variables are enforced by these calls anyway.
> + +%     mode_info_lock_vars(var_lock_atomic_goal, OuterVars, !ModeInfo),
> +    modecheck_orelse_list(AtomicGoalList0, AtomicGoalList1, InstMapList0, + 
> !ModeInfo, !IO),
> +    mode_info_get_var_types(!.ModeInfo, VarTypes),
> +%     mode_info_unlock_vars(var_lock_atomic_goal, OuterVars, !ModeInfo),
> +
> +    % XXX - Handling of solver vars
> +    handle_solver_vars_in_disjs(set.to_sorted_list(NonLocals),
> +        VarTypes, AtomicGoalList1, AtomicGoalList2, InstMapList0, + 
> InstMapList, !ModeInfo),
> +    AtomicGoalList = AtomicGoalList2,
> +
> +    instmap_merge(NonLocals, InstMapList, stm_atomic, !ModeInfo),
> +
> +    MainGoal = list.det_head(AtomicGoalList),
> +    OrElseGoals = list.det_tail(AtomicGoalList),
> +
> +    GoalExpr = atomic_goal(GoalType, Outer, Inner, Vars, MainGoal, + 
> OrElseGoals),
> +
> +    mode_checkpoint(exit, "atomic", !ModeInfo, !IO).
> +
> +
> modecheck_goal_expr(shorthand(_), _, _, !ModeInfo, !IO) :-
>     % these should have been expanded out by now
>     unexpected(this_file, "modecheck_goal_expr: unexpected shorthand").
> @@ -2777,6 +2834,23 @@
>     modecheck_set_var_inst(Var,
>         bound(unique, [bound_functor(ConsId, ArgInsts)]), no, !ModeInfo).
>
> +% The uniqueness of the Inner And Outer variables are handled
> +% by the addition of calls to the fake predicates "stm_inner_to_outer_io" 
> and
> +% "stm_outer_to_inner_io" durring the construction of the HLDS.  These
> +% calls are removed when atomic goals are expanded.
> +%
> +:- pred modecheck_orelse_list(list(hlds_goal)::in, list(hlds_goal)::out,
> +    list(instmap)::out, mode_info::in, mode_info::out, io::di, io::uo) is 
> det.
> +
> +modecheck_orelse_list([], [], [], !ModeInfo, !IO).
> +modecheck_orelse_list([Goal0 | Goals0], [Goal | Goals], [InstMap | 
> InstMaps],
> +        !ModeInfo, !IO) :-
> +    mode_info_get_instmap(!.ModeInfo, InstMap0),
> +    modecheck_goal(Goal0, Goal, !ModeInfo, !IO),
> +    mode_info_get_instmap(!.ModeInfo, InstMap),
> +    mode_info_set_instmap(InstMap0, !ModeInfo),
> +    modecheck_orelse_list(Goals0, Goals, InstMaps, !ModeInfo, !IO).

...

> Index: compiler/prog_data.m
> ===================================================================
> RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_data.m,v
> retrieving revision 1.196
> diff -u -r1.196 prog_data.m
> --- compiler/prog_data.m	28 Sep 2007 03:17:13 -0000	1.196
> +++ compiler/prog_data.m	1 Oct 2007 02:44:13 -0000
> @@ -966,6 +966,10 @@
>                 trace_state_var         :: prog_var
>             ).
>
> +:- type atomic_component_state
> +    --->    atomic_state_var(prog_var)
> +    ;       atomic_var_pair(prog_var, prog_var).
> +

Document this type.

...

> Index: compiler/quantification.m
> ===================================================================
> RCS file: 
> /home/mercury/mercury1/repository/mercury/compiler/quantification.m,v
> retrieving revision 1.121
> diff -u -r1.121 quantification.m
> --- compiler/quantification.m	28 Sep 2007 03:17:13 -0000	1.121
> +++ compiler/quantification.m	9 Oct 2007 03:08:26 -0000
> @@ -593,6 +593,27 @@
>     list.append(Vars, ExtraVars, AllVars),
>     implicitly_quantify_atomic_goal(AllVars, !Info).
>
> +implicitly_quantify_goal_quant_info_2(Expr0, Expr, _, !Info) :-
> +    Expr0 = atomic_goal(GoalType, Outer, Inner, Vars, MainGoal0, 
> OrElseGoals0),
> +
> +    % XXX STM: Because of the calls to "stm_inner_to_outer_io" and
> +    % "stm_outer_to_inner_io", the outer variables are implicitly added
> +    % to the list of non-local variables. + +    NonLocalVarSets0 = [],

Why does that comment have an XXX in front of it?

> +    AllAtomicGoals0 = [MainGoal0 | OrElseGoals0],
> +    implicitly_quantify_disj(AllAtomicGoals0, AllAtomicGoals, !Info, + 
> NonLocalVarSets0, NonLocalVarSets),
> +
> +    union_list(NonLocalVarSets, NonLocalVars),
> +    set_nonlocals(NonLocalVars, !Info),
> +
> +    MainGoal = list.det_head(AllAtomicGoals),
> +    OrElseGoals = list.det_tail(AllAtomicGoals),
> +
> +    Expr = atomic_goal(GoalType, Outer, Inner, Vars, MainGoal, OrElseGoals).

...

> Index: compiler/simplify.m
> ===================================================================
> RCS file: /home/mercury/mercury1/repository/mercury/compiler/simplify.m,v
> retrieving revision 1.217
> diff -u -r1.217 simplify.m
> --- compiler/simplify.m	28 Sep 2007 03:17:13 -0000	1.217
> +++ compiler/simplify.m	9 Oct 2007 03:11:32 -0000
> @@ -1748,6 +1748,28 @@
>         )
>     ).
>
> +% XXX STM: At the moment the inner goals are not simplified as there is
> +% a chance that the outer and inner variables will change which will
> +% cause problems durring expansion of STM constructs.  This will be
> +% fixed eventually.

I don't understand that comment.

> +simplify_goal_2(atomic_goal(GoalType, Outer, Inner, Vars, + 
> MainGoal0, OrElseGoals0), Goal, GoalInfo, GoalInfo, !Info, !IO) :-
> +    MainGoal = MainGoal0,
> +    OrElseGoals = OrElseGoals0,
> +%     simplify_goal(MainGoal0, MainGoal, !Info, !IO),
> +%     simplify_or_else_goals(OrElseGoals0, OrElseGoals, !Info, !IO),
> +    Goal = atomic_goal(GoalType, Outer, Inner, Vars, MainGoal, OrElseGoals).
> +
> +:- pred simplify_or_else_goals(hlds_goals::in, hlds_goals::out, + 
> simplify_info::in, simplify_info::out, io::di, io::uo) is det.
> +
> +simplify_or_else_goals([], [], !Info, !IO).
> +simplify_or_else_goals([Goal0 | Goals0], [Goal | Goals], !Info, !IO) :-
> +    simplify_goal(Goal0, Goal, !Info, !IO),
> +    simplify_or_else_goals(Goals0, Goals, !Info, !IO).
> +
> +
> :- func make_arg_always_boxed(foreign_arg) = foreign_arg.
>
> make_arg_always_boxed(Arg) = Arg ^ arg_box_policy := always_boxed.

...

>     % Index: compiler/term_pass1.m
> ===================================================================
> RCS file: /home/mercury/mercury1/repository/mercury/compiler/term_pass1.m,v
> retrieving revision 1.37
> diff -u -r1.37 term_pass1.m
> --- compiler/term_pass1.m	27 Aug 2007 06:22:15 -0000	1.37
> +++ compiler/term_pass1.m	1 Oct 2007 02:44:13 -0000
> @@ -390,6 +390,9 @@
> check_goal_expr_non_term_calls(_, _, Goal, _, !Errors, !ModuleInfo, !IO) :-
>     % XXX This looks incomplete - juliensf.
>     Goal = call_foreign_proc(_, _, _, _, _, _, _).
> +check_goal_expr_non_term_calls(_, _, atomic_goal(_, _, _, _, _, _), _, + 
> _, _, _, _, _, _) :-
> +    sorry(this_file, "check_goal_expr_non_term_calls: atomic_goal").

atomic_goals should have been expanded by now, so call unexpected here.

...

> Index: compiler/term_traversal.m
> ===================================================================
> RCS file: 
> /home/mercury/mercury1/repository/mercury/compiler/term_traversal.m,v
> retrieving revision 1.56
> diff -u -r1.56 term_traversal.m
> --- compiler/term_traversal.m	27 Aug 2007 06:22:15 -0000	1.56
> +++ compiler/term_traversal.m	1 Oct 2007 02:44:13 -0000
> @@ -349,6 +349,8 @@
>         true
>     ).
>
> +traverse_goal_2(atomic_goal(_, _, _, _, _, _), _, _, _, _, _, _, _, _) :-
> +    sorry(this_file, "traverse_goal_2: atomic_goal").

Likewise here.

...

> Index: library/stm_builtin.m
> ===================================================================
> RCS file: /home/mercury/mercury1/repository/mercury/library/stm_builtin.m,v
> retrieving revision 1.12
> diff -u -r1.12 stm_builtin.m
> --- library/stm_builtin.m	17 Sep 2007 13:28:55 -0000	1.12
> +++ library/stm_builtin.m	8 Oct 2007 23:41:39 -0000
> @@ -9,10 +9,9 @@
> % File: stm_builtin.m.
> % Main author: lmika.
> % Stability: low.
> -% -% This file is automatically imported into every module that uses 
> software
> -% transactional memory (STM).  It defines the data types and predicates
> -% use to implement STM.
> +%
> +% This module defines types and predicates that can be used with the
> +% Software Transactional Memory constructs.  Currently,

That sentence is incomplete.


I suggest:

 	This module defines type and predicates that are used to
 	implement software transactional memory.
...

> :- pred write_stm_var(stm_var(T)::in, T::in, stm::di, stm::uo) is det.
> @@ -76,20 +79,34 @@
>     % of at least one transaction variable read during the attempted
>     % transaction is written by another thread.
>     %
> -    % XXX the implementation of this predicate is incomplete.  Calling it
> -    % will currently cause the program to abort execution.
> -    %
> -:- pred retry(stm::di) is erroneous.
> +:- pred retry(stm::ui) is erroneous.

Why is this now ui?

> -% Atomic transactions
> +% Closure versions of atomic transactions.  These predicates can be used

s/Closure/Higher-order/

> +% to perform Software Transactional Memory without using the atomic scope.

 	These predicates can be used to execute closure atomically using
 	software transactional memory.
...

> +    % atomic_transaction(Closure, Result, !IO):
> +    %
> +    % Performs the Software Transactional Memory operations in Closure
> +    % atomically.  If the transaction is invalid, the Closure is
> +    % re-executed.

What do you mean by "Perform the STM operations in Closure atomically".

I suggest:

 	Execute `Closure' atomically w.r.t other threads using STM.

Delete the bit about what happens if the transaction is invalid; all the
user should need to care about is that it *is* executed atomically, not how
it does it.

> :- pred atomic_transaction(pred(T, stm, stm), T, io, io).
> :- mode atomic_transaction(in(pred(out, di, uo) is det), out, di, uo)
>     is det.
>
> +
> +    % or_else(AtomicClosure1, AtomicClosure2, Result, !STM):
> +    %
> +    % Performs the Software Transactional Memory operations in 
> AtomicClosure1
> +    % atomically.  If a retry is thrown, AtomicClosure2 is executed 
> atomically.
> +    %

Numbering them implies some sort of ordering or sequencing, I suggest
referring to them as AtomicClosureA and AtomicClosureB.

> +:- pred or_else(pred(T, stm, stm), pred(T, stm, stm), T, stm, stm).
> +:- mode or_else(in(pred(out, di, uo) is det), in(pred(out, di, uo) is det),
> +    out, di, uo) is det.

At some point, there should be a cc_multi version of this one as well,
although that isn't important at the moment.

> @@ -125,6 +142,10 @@
>     %
> :- impure pred stm_create_nested_transaction_log(stm::ui, stm::uo) is det.
>
> +    % stm_create_nested_log(Parent, Child):
> +    % +:-impure pred stm_create_nested_log(stm::ui, stm::uo) is det.
> +
>     % Lock the STM global mutex.
>     %
> :- impure pred stm_lock is det.
> @@ -135,9 +156,9 @@
>
>     % Values of this type are returned by stm_validate/2 and indicate
>     % whether a given transaction log is valid.
> +    %
>     % NOTE: The definition of this type must be kept consistent with the
>     % constants defined in runtime/mercury_stm.h.
> -    %
>     %
> :- type stm_validation_result
>     --->    stm_transaction_valid
> @@ -171,6 +192,21 @@
> :- type stm_dummy_output
>     --->    stm_dummy_output.
>
> +    % Used to enforce the uniqueness of outer and inner variables.
> +    % Will be removed before stm_expansion.
> +    %
> +:- pred stm_from_outer_to_inner_io(io::di, stm::uo) is det.
> +:- pred stm_from_outer_to_inner_stm(stm::di, stm::uo) is det.
> +
> +:- pred stm_from_inner_to_outer_io(stm::di, io::uo) is det.
> +:- pred stm_from_inner_to_outer_stm(stm::di, stm::uo) is det.
> + +    % Changes the value of a transaction variable without going through
> +    % the log.  ONLY USE FOR DEBUGGING PURPOSES.
> +    %
> +:- pred unsafe_write_stm_var(stm_var(T)::in, T::in, stm::di, stm::uo) is 
> det.

If it doesn't go through the log then why does it take STM arguments?

> +
> +:- impure pred stm_merge_nested_logs(stm::di, stm::di, stm::uo) is det.

Document this one.

...

> +:- pragma foreign_proc("C",
> +    stm_from_outer_to_inner_io(IO::di, STM::uo),
> +    [promise_pure, will_not_call_mercury, thread_safe],
> +"
> +    STM = NULL;
> +    MR_final_io_state(IO);
> +").
> +
> +:- pragma foreign_proc("C",
> +    stm_from_outer_to_inner_stm(STM0::di, STM::uo),
> +    [promise_pure, will_not_call_mercury, thread_safe],
> +"
> +    STM = STM0;
> +").
> +
> +:- pragma foreign_proc("C",
> +    stm_from_inner_to_outer_io(STM0::di, IO::uo),
> +    [promise_pure, will_not_call_mercury, thread_safe],
> +"
> +    STM0 = NULL;
> +    IO = MR_initial_io_state();
> +").
> +
> +
> +:- pragma foreign_proc("C",
> +    stm_from_inner_to_outer_stm(STM0::di, STM::uo),
> +    [promise_pure, will_not_call_mercury, thread_safe],
> +"
> +    STM0 = NULL;
> +    STM = NULL;
> +").

These predicates should just call MR_fatal_error(), since they will never
really be called if the source-to-source transformation is working
properly.

...

> Index: runtime/mercury_stm.c
> ===================================================================
> RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_stm.c,v
> retrieving revision 1.5
> diff -u -r1.5 mercury_stm.c
> --- runtime/mercury_stm.c	21 Sep 2007 06:13:12 -0000	1.5
> +++ runtime/mercury_stm.c	8 Oct 2007 05:40:23 -0000
> @@ -20,8 +20,7 @@
>
> void
> MR_STM_record_transaction(MR_STM_TransLog *tlog, MR_STM_Var *var,
> -    MR_Word old_value, MR_Word new_value)
> -{
> +        MR_Word old_value, MR_Word new_value) {
>     MR_STM_TransRecord  *new_record;
>
>     new_record = MR_GC_NEW(MR_STM_TransRecord);
> @@ -33,32 +32,80 @@
> }
>
> void
> -MR_STM_attach_waiter(MR_STM_Var *var, MR_ThreadId tid)
> -{
> -    MR_fatal_error("NYI MR_STM_attach_waiter");
> +MR_STM_attach_waiter(MR_STM_Var *var, MR_ThreadId tid, + 
> MR_STM_ConditionVar *cvar) {


I suggest s/cvar/cond_var/

...

> % File: stm.m
> % Author: lm

Did you do a `cvs add' on this file?


> % This module contains the source to source transformations for expanding out
> % atomic goals.

atomic goals or atomic scopes?

> %
> % The atomic goals are converted into a series of predicate calls and
> % predicate definitions using standard calls from the library modules
> % "stm_builtin", "exception" and "univ".
> %
> % An example transformation might be the following:

might be?  (Does that mean it might not be?)

 	An example of the transformation is ...

> %
> %   :- pred foo(int::in, int::out, io::di, io::uo) is det.
> %
> %   foo(X, Y, IO0, IO) :-
> %       atomic [outer(IO0, IO), inner(STM0, STM)] (
> %           stm_operations(X, Y, STM0, STM)
> %           ...
> %       )

I think there should be another output variable added, so that the
example transformation includes the tupling of multiple output args.

> % into
> %
> %   foo(X, Y, IO0, IO) :-
> %       'StmExpanded_toplevel_0_0_0'(X, Y, IO0, IO).
> %
> %
> %   :- pred 'StmExpanded_toplevel_0_0_0'(int::in, int::out, io::di, io::uo)
> %           is det.
> %   'StmExpanded_toplevel_0_0_0'(X, Y, IO0, IO) :-
> %       'StmExpanded_rollback_0_0_0'(X, Y),
> %       IO0 = IO.
> %
> %
> %   :- pred 'StmExpaded_rollback_0_0_0'(int::in, int::out) is cc_multi.
> %   'StmExpaded_rollback_0_0_0'(X, Y) :-
> %       promise_pure (
> %           impure stm_create_trasaction_log(STM0),
> %           Closure = 'StmExpanded_wrapper_0_0_0'(X),
> %           unsafe_try_stm(Closure(X), Result0, STM0, STM),
> %           (
> %               Result0 = succeeded(Y)
> %           ;
> %               Result0 = exception(Excp),
> %               ( Excp = univ(rollback_invalid_transaction) ->
> %                   impure stm_discard_transaction_log(STM),
> %                   'StmExpanded_rollback_0_0_0'(X, Y)
> %               ; Excp = univ(rollback_retry) ->
> %                   impure stm_lock,
> %                   impure stm_validate(STM, IsValid),
> %                   (
> %                       IsValid = stm_transaction_valid,
> %                       impure stm_block(STM)
> %                   ;
> %                       IsValid = stm_transaction_invalid,
> %                       impure stm_unlock
> %                   ),
> %                   impure stm_discard_trasaction_log(STM),
> %                   'StmExpanded_rollback_0_0_0'(X, Y)
> %               ;
> %                   impure stm_lock,
> %                   impure stm_validate(STM, IsValid),
> %                   impure stm_unlock,
> %                   (
> %                       IsValid = stm_transaction_valid,
> %                       rethrow(Result0)
> %                   ;
> %                       IsValid = stm_transaction_invalid,
> %                       impure stm_discard_transaction_log(STM),
> %                       'StmExpanded_rollback_0_0_0'(X, Y)
> %                   )
> %               )
> %           )
> %       ).
> %
> %
> %   :- pred 'StmExpanded_wrapper_0_0_0'(int::in, int::out, stm::di, stm::uo)
> %           is det.
> %   'StmExpanded_wrapper_0_0_0'(X, Result, STM0, STM) :-
> %       stm_operations(X, Y, STM0, STM)
> %       ...
> %       Result = Y,
> %       promise_pure (
> %           impure stm_lock,
> %           impure stm_validate(STM, IsValid),
> %           (
> %               IsValid = stm_transaction_valid,
> %               impure stm_commit(STM),
> %               impure stm_unlock
> %           ;
> %               IsValid = stm_transaction_invalid,
> %               impure stm_unlock,
> %               throw(rollback_invalid_transaction)
> %           ).
> %
> %
> % Currently, the atomic goal supports a single STM transaction with any 
> number
> % of input and output arguments.

s/single/unnested/

> As the atomic goal may need to unroll the
> % call stack (when performing a retry or a rollback), the exception module
> % is used.  The use of the exception module impacts the passing of output
> % variables and is explained below.




> % Nonlocals instantiated before the atomic goal are passed through the % 
> expanded predicates as input arguments (with mode "in").  Nonlocals which % 
> are instantiated inside the atomic goal and are used outside the atomic goal
> % (which, for the sake of simplicitly, will be called "output" variables in % 
> this discussion) are passed as output arguments in the "entrypoint" and % 
> "rollback" expanded predicates (with mode "out).  In the "actual" expanded % 
> predicate, these variables must be passed as part of an exception result and
> % are handled in the following way:
> %
> %   - If there are no output variables, a dummy variable is created and
> %     passed up to the rollback predicate.  This variable simply exists to
> %     satify the requirement of the closure returning an argument and
> %     will be ignored in the rollback predicate.
> %   - If there is one output variable, that variable will be passed up to
> %     the rollback predicate as it is.
> %   - If there is more than one output variable, a tupple of these variables
> %     is created and the tupple itself is passed up to the rollback 
> predicate.
> %     There, it will be deconstructed and the associated output variables
> %     will be returned as output arguments.
> %
> % Currently a subset of the complete STM system is implemented.  The 
> following % features will be included in subsequent review postings.  A 
> number of
> % these relate to this module, whilst others relate to other modules.
> %
> %   - or_else: Support for this exists in the front end but is not yet 
> handled
> %     here (an error is thrown if or_else goals are present).  There is no
> %     real reason for this except for the fact that it hasn't been done yet.
> %     This will eventually be included in the next review of this module.
> % %   - Nested atomic blocks: Whilst this will eventually be incluced, this
> %     is neither supported in the front end or in this module (although some
> %     passes, such as the type checker, has code for handling this).
> %     However, the current method of mode checking atomic goals pervents
> %     nested atomic goals (the uniqueness of the outer and inner variables
> %     are handled by inserting dummy predicates at the beginning and end
> %     of the atomic goal.  The current implementation of these predicates
> %     only allow the outer variables to be of type io).
> %
> %   - The "vars" parameter: The "vars" atomic goal parameter is used by the
> %     programmer to list the outer variables.  Whilst it is optional, the
> %     variables it lists needs to be checked to ensure that they are properly
> %     instantiated.
> % %   - State Variables: The "outer" and "inner" atomic goal parameters are
> %     designed to take state variables along with variable pairs.  Although
> %     they are handled in the parser, they are not yet handled in the
> %     parse tree -> HLDS transformation.
> % %   - Automatic importing of necessary modules: Currently, all necessary
> %     modules must be explicitly imported by the programmer if they wish
> %     to use the STM constructs.

> %-----------------------------------------------------------------------------%
>
>
> :- module transform_hlds.stm_expand.
> :- interface.
>
> :- import_module hlds.hlds_module.
> :- import_module hlds.hlds_pred.
>
> %-----------------------------------------------------------------------------%
>
> :- pred stm_process_module(module_info::in, module_info::out) is det.
>
> :- pred stm_process_pred(pred_id::in, module_info::in, module_info::out)
>    is det.


Why is it necessary for stm_process_pred/3 to be exported?  It doesn't 
appear to be called from anywhere other than within this stm_expand.m.

...

> :- import_module assoc_list.
> :- import_module bool.
> :- import_module int.
> :- import_module io.
> :- import_module list.
> :- import_module map.
> :- import_module maybe.
> :- import_module set.
> :- import_module string.
> :- import_module svmap.
> :- import_module svvarset.
> :- import_module term.
> :- import_module pair.
> :- import_module varset.

Please ensure that these import declarations are ordered, pair is not
in the above one, and parse_tree.prog_type is not in the following.

> :- import_module check_hlds.polymorphism.
> :- import_module check_hlds.inst_match.
> :- import_module check_hlds.mode_util.
> :- import_module hlds.goal_util.
> :- import_module hlds.hlds_goal.
> :- import_module hlds.hlds_pred.
> :- import_module hlds.hlds_rtti.
> :- import_module hlds.instmap.
> :- import_module hlds.pred_table.
> :- import_module hlds.quantification.
> :- import_module libs.compiler_util.
> :- import_module parse_tree.prog_type.
> :- import_module mdbcomp.prim_data.
> :- import_module parse_tree.prog_data.
>
> %-----------------------------------------------------------------------------%
>
>    % Information about the predicate which contains the atomic goal along
>    % with other information relative to all STM expansions.
>    %
> :- type stm_info
>    --->    stm_info(
>                stm_info_module_info     :: module_info,
>                stm_info_pred_id         :: pred_id,
>                stm_info_proc_id         :: proc_id,
>                stm_info_proc_info       :: proc_info,
>                stm_info_pred_info       :: pred_info,
>                stm_info_requalify       :: bool,
>                stm_info_expand_id       :: int     % Number of goals 
> expanded
>            ).
>
>
>    % Information about a newly created predicate.  Mainly used to save
>    % explicitly passing pred_info and proc_info for creation of goals.
>    %
> :- type stm_new_pred_info
>    --->    stm_new_pred_info(
>                new_pred_module_info     :: module_info,
>                new_pred_pred_id         :: pred_id,
>                new_pred_proc_id         :: proc_id,
>                new_pred_pred_info       :: pred_info,
>                new_pred_proc_info       :: proc_info,
>                new_pred_context         :: term.context
>            ).
>
>
>    % Information about the local and non-local variables of an atomic goal.
>    %
> :- type stm_goal_vars
>    --->    stm_goal_vars(
>                vars_input               :: set(prog_var),
>                vars_local               :: set(prog_var),
>                vars_output              :: set(prog_var),
>                vars_innerDI             :: prog_var,       % inner STM di 
> var
>                vars_innerUO             :: prog_var        % inner STM uo 
> var
>            ).
>

...

> :- pred stm_process_proc_2(proc_info::in, proc_info::out, pred_id::in,
>    proc_id::in, pred_info::in, pred_info::out, module_info::in,
>    module_info::out) is det.
>
> stm_process_proc_2(!ProcInfo, PredId, ProcId, !PredInfo, !ModuleInfo) :-
>    proc_info_get_goal(!.ProcInfo, Goal0),
>    proc_info_get_initial_instmap(!.ProcInfo, !.ModuleInfo, InitInstmap),
>    StmInfo0 = stm_info(!.ModuleInfo, PredId, ProcId, !.ProcInfo,
>        !.PredInfo, no, 0),
>    stm_process_goal(InitInstmap, Goal0, Goal, StmInfo0, StmInfo),
>    StmInfo = stm_info(!:ModuleInfo, _, _, !:ProcInfo, !:PredInfo,
>        RecalcInfo, _),
>    proc_info_set_goal(Goal, !ProcInfo),
>
>    (
>        RecalcInfo = yes,
>        requantify_proc(!ProcInfo),
>        RecomputeAtomic = yes,
>        recompute_instmap_delta_proc(RecomputeAtomic, !ProcInfo, !ModuleInfo)
>    ;
>        RecalcInfo = no
>    ).
>
>
> :- pred stm_process_goal(instmap::in, hlds_goal::in, hlds_goal::out,
>    stm_info::in, stm_info::out) is det.
>
> stm_process_goal(Instmap, Goal0, Goal, !Info) :-
>    Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
>    (
>        GoalExpr0 = unify(_, _, _, _, _),
>        Goal = Goal0
>    ;
>        GoalExpr0 = conj(ConjType, Conjuncts0),
>        stm_process_conj(Instmap, Conjuncts0, Conjuncts, !Info),
>        GoalExpr = conj(ConjType, Conjuncts),
>        Goal = hlds_goal(GoalExpr, GoalInfo0)
>    ;
>        GoalExpr0 = disj(Disjuncts0),
>        stm_process_disj(Instmap, Disjuncts0, Disjuncts, !Info),
>        GoalExpr = disj(Disjuncts),
>        Goal = hlds_goal(GoalExpr, GoalInfo0)
>    ;
>        GoalExpr0 = negation(SubGoal0),
>        stm_process_goal(Instmap, SubGoal0, SubGoal, !Info),
>        GoalExpr = negation(SubGoal),
>        Goal = hlds_goal(GoalExpr, GoalInfo0)
>    ;
>        GoalExpr0 = switch(Var, CanFail, Cases0),
>        stm_process_switch_cases(Instmap, Cases0, Cases, !Info),
>        GoalExpr = switch(Var, CanFail, Cases),
>        Goal = hlds_goal(GoalExpr, GoalInfo0)
>    ;
>        GoalExpr0 = scope(Reason, InnerGoal0),
>        (
>            ( Reason = exist_quant(_)
>            ; Reason = promise_solutions(_, _)
>            ; Reason = promise_purity(_, _)
>            ; Reason = commit(_)
>            ; Reason = barrier(_)
>            ; Reason = from_ground_term(_)
>            ; Reason = trace_goal(_, _, _, _, _)
>            )
>        ),

There doesn't seem to be any point in listing all the scope reasons
there.

>        stm_process_goal(Instmap, InnerGoal0, InnerGoal, !Info),
>        GoalExpr = scope(Reason, InnerGoal),
>        Goal = hlds_goal(GoalExpr, GoalInfo0)
>    ;
>        GoalExpr0 = if_then_else(Vars, Cond0, Then0, Else0),
>        stm_process_if_then_else(Instmap, Cond0, Then0, Else0, Cond, Then,
>            Else, !Info),
>        GoalExpr = if_then_else(Vars, Cond, Then, Else),
>        Goal = hlds_goal(GoalExpr, GoalInfo0)
>    ;
>        ( GoalExpr0 = generic_call(_, _, _, _)
>        ; GoalExpr0 = plain_call(_, _, _, _, _, _)
>        ; GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _)
>        ),
>        Goal = Goal0
>    ;
>        GoalExpr0 = atomic_goal(_, Outer, Inner, _, MainGoal, OrElseGoals),
>        (
>            OrElseGoals = []
>        ;
>            OrElseGoals = [_ | _],
>            sorry(this_file, "stm_process_goal: OrElse not yet implemented")
>        ),
>        InstmapDelta = goal_info_get_instmap_delta(GoalInfo0),
>        apply_instmap_delta(Instmap, InstmapDelta, FinalInstmap),
>        stm_create_actual_goal(Instmap, FinalInstmap, Outer, Inner,
>            MainGoal, Goal, !Info)
>    ;
>        % This should be expanded out at this stage
>        GoalExpr0 = shorthand(_),
>        unexpected(this_file, "stm_process_goal: unexpected shorthand")
>    ).
>
>



> :- pred stm_process_if_then_else(instmap::in, hlds_goal::in, hlds_goal::in,
>    hlds_goal::in, hlds_goal::out, hlds_goal::out, hlds_goal::out,
>    stm_info::in, stm_info::out) is det.
>
> stm_process_if_then_else(Instmap0, Cond0, Then0, Else0, Cond, Then, Else,
>        !Info) :-
>    stm_process_goal(Instmap0, Cond0, Cond, !Info),
>
>    % XXX: It is currently assumed that the initial instmap of the Then part
>    % is the same as the final instmap of the condition part whilst the
>    % initial instmap of the else part is the same as the initial instmap
>    % of the entire if_then_else goal.  I'm not sure if this is correct
>    % or not.

Yes.

>
>    Cond0 = hlds_goal(_, CondInfo),
>    CondInstmapDelta = goal_info_get_instmap_delta(CondInfo),
>    apply_instmap_delta(Instmap0, CondInstmapDelta, InstmapAfterCond),
>    stm_process_goal(InstmapAfterCond, Then0, Then, !Info),
>    stm_process_goal(Instmap0, Else0, Else, !Info).
>
>
> :- pred stm_process_switch_cases(instmap::in, list(case)::in, 
> list(case)::out,
>    stm_info::in, stm_info::out) is det.
>



> % Predicate related to the creation of the top level goal.
>
>
>    % Creates all the required predicates and returns the call to the
>    % newly created top_level goal.  The InitInstmap and FinalInstmap is the
>    % instmap before and after the atomic goal respectivly.

>    %
> :- pred stm_create_actual_goal(instmap::in, instmap::in,
>    atomic_component_state::in, atomic_component_state::in, hlds_goal::in,
>    hlds_goal::out, stm_info::in, stm_info::out) is det.
>
> stm_create_actual_goal(InitInstmap, FinalInstmap, Outer, Inner, AtomicGoal,
>        HldsGoal, !StmInfo) :-
>    (
>        Outer = atomic_state_var(_),
>        sorry(this_file, "stm_create_new_goal: atomic_state_var")
>    ;
>        Outer = atomic_var_pair(OuterDI, OuterUO)
>    ),
>
>    (
>        Inner = atomic_state_var(_),
>        sorry(this_file, "stm_create_new_goal: atomic_state_var")
>    ;
>        Inner = atomic_var_pair(InnerDI, InnerUO)
>    ),
>    create_top_level_goal(InitInstmap, FinalInstmap, OuterDI, OuterUO,
>        InnerDI, InnerUO, AtomicGoal, HldsGoal, !StmInfo),
>    !:StmInfo = !.StmInfo ^ stm_info_requalify := yes,
>    increment_stm_expand_id(!StmInfo).
>
>
> %-----------------------------------------------------------------------------%
> %
> % Predicates to determine if variables are inputs, outputs or local to a 
> goal.
> % This decision is currenly governed by the following rules:

Delete "currenly".

> %
> %   1. If it is free in the initial instmap and not free in the final 
> instmap,
> %      the variable is an output.
> %   2. If it is not free in the initial instmap and not free in the final
> %      instmap, the
>
>
>    % Arranges variables into groups of local variables, input variables and
>    % output variables.  This uses the instmap before and after the atomic
>    % goal.
>    %
> :- pred order_vars_into_groups(module_info::in, list(prog_var)::in,
>    instmap::in, instmap::in, list(prog_var)::out, list(prog_var)::out,
>    list(prog_var)::out) is det.

"partition" would be a more descriptive word then either "order" or
"arrange".


> order_vars_into_groups(ModuleInfo, Vars, InitInstmap, FinalInstmap, Local,
>        Input, Output) :-
>    order_vars_into_groups_2(ModuleInfo, Vars, InitInstmap, FinalInstmap,
>        [], Local, [], Input, [], Output).
>
>
> :- pred order_vars_into_groups_2(module_info::in, list(prog_var)::in,
>    instmap::in, instmap::in, list(prog_var)::in, list(prog_var)::out,
>    list(prog_var)::in, list(prog_var)::out, list(prog_var)::in,
>    list(prog_var)::out) is det.
>
> order_vars_into_groups_2(_, [], _, _, !Local, !Input, !Output).
> order_vars_into_groups_2(ModuleInfo, [Var|Vars], InitInstmap, FinalInstmap,
>        !LocalVars, !InputVars, !OutputVars) :-
>    lookup_var(InitInstmap, Var, InitVarInst),
>    lookup_var(FinalInstmap, Var, FinalVarInst),
>    (
>        inst_is_free(ModuleInfo, InitVarInst),
>        inst_is_free(ModuleInfo, FinalVarInst)
>    ->
>        !:LocalVars = [Var | !.LocalVars]
>    ;
>        inst_is_free(ModuleInfo, InitVarInst),
>        inst_is_bound(ModuleInfo, FinalVarInst)
>    ->
>        !:OutputVars = [Var | !.OutputVars]
>    ;
>        inst_is_bound(ModuleInfo, InitVarInst),
>        inst_is_bound(ModuleInfo, FinalVarInst)
>    ->
>        !:InputVars = [Var | !.InputVars]
>    ;
>        unexpected(this_file,
>            "order_vars_into_groups_2: Unhandled inst case")
>    ),
>    order_vars_into_groups_2(ModuleInfo, Vars, InitInstmap, FinalInstmap,
>        !LocalVars, !InputVars, !OutputVars).
>
>
> :- pred calc_pred_variables_list(instmap::in, instmap::in,
>    hlds_goals::in, prog_var::in, prog_var::in, list(prog_var)::in,
>    list(stm_goal_vars)::out, stm_info::in, stm_info::out) is det.
>
> calc_pred_variables_list(_, _, [], _, _, _, [], !StmInfo).
> calc_pred_variables_list(InitInstmap, FinalInstmap, [HldsGoal | HldsGoals],
>        InnerDI, InnerUO, IgnoreVarList, [StmGoalVar | StmGoalVarList],
>        !StmInfo) :-
>    calc_pred_variables(InitInstmap, FinalInstmap, HldsGoal, InnerDI,
>        InnerUO, IgnoreVarList, StmGoalVar, !StmInfo),
>    calc_pred_variables_list(InitInstmap, FinalInstmap, HldsGoals, InnerDI,
>        InnerUO, IgnoreVarList, StmGoalVarList, !StmInfo).
>
>
>    % Arranges all variables from the goal and non-locals into local
>    % variables, input variables and output variables.  All variables that
>    % appear in the list of IgnoreVarList are not included.
>    %
> :- pred calc_pred_variables(instmap::in, instmap::in,
>    hlds_goal::in, prog_var::in, prog_var::in, list(prog_var)::in,
>    stm_goal_vars::out, stm_info::in, stm_info::out) is det.
>
> calc_pred_variables(InitInstmap, FinalInstmap, HldsGoal,
>        InnerDI, InnerUO, IgnoreVarList, StmGoalVars, !StmInfo) :-
>
>    ModuleInfo = !.StmInfo ^ stm_info_module_info,
>
>    goal_vars(HldsGoal, GoalVars0),
>    HldsGoal = hlds_goal(_, GoalInfo),
>
>    set.delete_list(GoalVars0, IgnoreVarList, GoalVars),
>
>    GoalVarList = set.to_sorted_list(GoalVars),
>
>    GoalNonLocalSet0 = goal_info_get_nonlocals(GoalInfo),
>    set.delete_list(GoalNonLocalSet0, IgnoreVarList, GoalNonLocalSet),
>    GoalNonLocals = set.to_sorted_list(GoalNonLocalSet),
>
>    order_vars_into_groups(ModuleInfo, GoalVarList, InitInstmap, 
> FinalInstmap,
>        LocalVarsList, _, _),
>    order_vars_into_groups(ModuleInfo, GoalNonLocals, InitInstmap,
>        FinalInstmap, _, InputVarsList, OutputVarsList),
>
>    LocalVars = set.from_list(LocalVarsList),
>    InputVars = set.from_list(InputVarsList),
>    OutputVars = set.from_list(OutputVarsList),
>
>    StmGoalVars = stm_goal_vars(InputVars, LocalVars, OutputVars, InnerDI,
>        InnerUO).
>
>
> %-----------------------------------------------------------------------------%
> %
> % Predicates involved in the removal of the dummy predicates
> % "stm_from_inner_to_outer_io" and "stm_from_outer_to_inner_io".
> %
>
>    % Removes all calls to the dummy predicates in a list of goals.
>    %
> :- pred remove_tail(hlds_goals::in, hlds_goals::out) is det.
>
> remove_tail([], []).
> remove_tail([G | Gs], Goals) :-
>    remove_tail(Gs, Goals0),
>    (
>        ( G = hlds_goal(plain_call(_, _, _, _, _, stm_inner_outer), _)
>        ; G = hlds_goal(plain_call(_, _, _, _, _, stm_outer_inner), _)
>        )
>    ->
>        Goals = Goals0
>    ;
>        Goals = [G | Goals0]
>    ).
>
>
>    % Strip the dummy predicates.  At the very minimum, these predicates
>    % should be in the atomic goal so the atomic goal must be a
>    % conjunction.
>    %
> :- pred strip_goal_calls(hlds_goal::in, hlds_goal::out) is det.
>
> strip_goal_calls(Goal0, Goal) :-
>    (
>        Goal0 = hlds_goal(conj(plain_conj, GoalList0), GoalInfo) ->
>        (
>            GoalList0 = [],
>            unexpected(this_file, "strip_goal_calls: conjunction is empty")
>        ;
>            GoalList0 = [_ | _],
>            remove_tail(GoalList0, GoalList),
>            Goal = hlds_goal(conj(plain_conj, GoalList), GoalInfo)
>        )
>    ;
>        unexpected(this_file, "strip_goal_calls: atomic_goal not a conj")
>    ).
>
>
> %-----------------------------------------------------------------------------%
> %
> % Predicates related to the creation of the top level predicate.
> % The created predicate calls the rollback predicate and threads the IO 
> state.
> % Creating the top-level predicate implicitly creates the rollback predicate
> % and wrapper predicates.
> %
>
>    % Creates the top level predicate and returns a call to that predicate
>    %
> :- pred create_top_level_goal(instmap::in, instmap::in, prog_var::in,
>    prog_var::in, prog_var::in, prog_var::in, hlds_goal::in, hlds_goal::out,
>    stm_info::in, stm_info::out) is det.
>
> create_top_level_goal(InitInstmap, FinalInstmap, OuterDI, OuterUO,
>        InnerDI, InnerUO, AtomicGoal0, HldsGoal, !StmInfo) :-
>    strip_goal_calls(AtomicGoal0, AtomicGoal_TMP),
>    calc_pred_variables(InitInstmap, FinalInstmap, AtomicGoal0,
>        InnerDI, InnerUO, [OuterDI, OuterUO, InnerDI, InnerUO], 
> AtomicGoalVars,
>        !StmInfo),
>    create_top_level_pred(AtomicGoalVars, OuterDI, OuterUO, AtomicGoal_TMP,
>        TopLevelCall, !StmInfo),
>    HldsGoal = TopLevelCall.
>
>
>    % Creates the top level predicate.  Calling this implicitly creates the
>    % rollback and wrapper predicate.
>    %
> :- pred create_top_level_pred(stm_goal_vars::in, prog_var::in, prog_var::in,
>    hlds_goal::in, hlds_goal::out, stm_info::in, stm_info::out) is det.
>
> create_top_level_pred(AtomicGoalVars, OuterDI, OuterUO, AtomicGoal, HldsGoal,
>        !StmInfo) :-
>    create_rollback_pred(AtomicGoalVars, WrapperCall, AtomicGoal, !StmInfo),
>    get_input_output_varlist(AtomicGoalVars, InputVars, OutputVars),
>    get_input_output_types(AtomicGoalVars, !.StmInfo, InputTypes, 
> OutputTypes),
>    get_input_output_modes(AtomicGoalVars, InputModes, OutputModes),
>    create_cloned_pred(InputVars ++ OutputVars ++ [OuterDI, OuterUO],
>        InputTypes ++ OutputTypes ++ [stm_io_type, stm_io_type],
>        InputModes ++ OutputModes ++ [mer_mode_di, mer_mode_uo], "toplevel",
>        AtomicGoal, NewPredInfo0, HldsGoal, !StmInfo),
>
>    create_var_unify(OuterUO, OuterDI, pair(mer_mode_uo, mer_mode_di),
>        CopyIOAssign, NewPredInfo0, NewPredInfo1),
>    create_plain_conj([WrapperCall, CopyIOAssign], TopLevelGoal),
>
>    new_pred_set_goal(TopLevelGoal, NewPredInfo1, NewPredInfo2),
>    run_quantification_over_pred(NewPredInfo2, NewPredInfo),
>    commit_new_pred(NewPredInfo, !StmInfo).
>
>
> %-----------------------------------------------------------------------------%
> %
> % Template predicates.  These predicates are used to create frequently
> % occurring patterns in the predicate clause.
> %
>
>
>    % Predicate that creates the following goal:
>    %
>    %       (
>    %           X <- univ.univ(<<ExceptRes>>),
>    %           X == << stm_rollback_exception_functor >>
>    %       ->
>    %           << true_goal >>
>    %       ;
>    %           << false_goal >>
>    %       )
>    %
>    % The RttiVar variable must contain ...

... must contain what?


>    % :- pred template_if_exceptres_is_cons(prog_var::in, prog_var::in, 
> cons_id::in,
>    hlds_goal::in, hlds_goal::in, hlds_goal::out, stm_new_pred_info::in,
>    stm_new_pred_info::out) is det.
>
> template_if_exceptres_is_cons(RttiVar, ExceptVar, RollbackExceptCons,
>        TrueGoal, FalseGoal, HldsGoal, !NewPredInfo) :-
>    create_aux_variable(stm_valid_result_type, yes("UnivPayload"),
>        UnivPayloadVar, !NewPredInfo),
>    create_aux_variable_assignment(RollbackExceptCons,
>        stm_rollback_exception_type, yes("RollbackExcpt"), AssignGoal,
>        RollbackExceptVar, !NewPredInfo),
>    create_simple_call(module_univ_sym_name, "type_to_univ", pf_predicate,
>        mode_no(2), detism_semi, purity_pure,
>        [RttiVar, UnivPayloadVar, ExceptVar], [],
>        [pair(RttiVar, ground(shared, none)),
>         pair(ExceptVar, ground(shared, none)), pair(UnivPayloadVar, free)],
>         UnivCall, !NewPredInfo),
>    create_simple_call(module_builtin_sym_name, "unify", pf_predicate,
>        only_mode, detism_semi, purity_pure,
>        [RttiVar, RollbackExceptVar, UnivPayloadVar], [],
>        [], UnifyCall, !NewPredInfo),
>    create_var_test(UnivPayloadVar, RollbackExceptVar,
>        pair(mer_mode_in, mer_mode_in), TestGoal, !NewPredInfo),
>    create_plain_conj([AssignGoal, UnivCall, TestGoal, UnifyCall], CondGoal),
>
>    ITEDetermism = detism_det,
>    ITEPurity = purity_impure,
>
>    create_if_then_else([], CondGoal, TrueGoal, FalseGoal, ITEDetermism,
>        ITEPurity, HldsGoal, !NewPredInfo).
>
>
>    % Predicate that creates the following goals.
>    %
>    %       impure stm_builtin.lock,
>    %       impure stm_builtin.validate(<<STM>>, IsValid),
>    %       { impure stm_builtin.unlock } when unlock_after == yes
>    %       (
>    %           IsValid = stm_transaction_valid,
>    %           << TrueGoal >>
>    %       ;
>    %           IsValid = stm_transaction_invalid,
>    %           << FalseGoal >>
>    %       )
>    %
>    % The call to "stm_builtin.unlock" is only included if the value of
>    % UnlockAfterwards is yes.
>    %
> :- pred template_lock_and_validate(prog_var::in, bool::in, hlds_goal::in,
>    hlds_goal::in, hlds_goals::out, stm_new_pred_info::in,
>    stm_new_pred_info::out) is det.
>
> template_lock_and_validate(StmVar, UnlockAfterwards, ValidGoal, InvalidGoal,
>        HldsGoals, !NewPredInfo) :-
>    create_aux_variable(stm_valid_result_type, yes("ValidResult"),
>        IsValidVar, !NewPredInfo),
>    create_simple_call(module_stm_sym_name, "stm_lock", pf_predicate,
>        only_mode, detism_det, purity_impure, [], [], [], LockCall,
>        !NewPredInfo),
>    create_simple_call(module_stm_sym_name, "stm_validate", pf_predicate,
>        only_mode, detism_det, purity_impure, [StmVar, IsValidVar], [],
>        [pair(StmVar, ground(unique, none)), pair(IsValidVar, free)],
>        ValidCall, !NewPredInfo),
>    create_switch_disjunction(IsValidVar,
>        [case(stm_validres_valid_functor, ValidGoal),
>         case(stm_validres_invalid_functor, InvalidGoal)], detism_det,
>         purity_impure,  DisjGoal, !NewPredInfo),
>    (
>        UnlockAfterwards = yes,
>        create_simple_call(module_stm_sym_name, "stm_unlock", pf_predicate,
>            only_mode, detism_det, purity_impure, [], [], [], UnlockCall,
>            !NewPredInfo),
>        HldsGoals = [LockCall, ValidCall, UnlockCall, DisjGoal]
>    ;
>        UnlockAfterwards = no,
>        HldsGoals = [LockCall, ValidCall, DisjGoal]
>    ).
>
>
> %-----------------------------------------------------------------------------%
> %
> % Predicates involved in the creation of the rollback predicate.  The 
> rollback
> % predicate is responsible for calling the wrapper predicate and handling
> % the excepion result.  If the exception result indicates a rollback because

s/excepion/exception/

> % of an invalid transaction or a retry, this predicate is responsible for

> % handling these.  For an example of the goals created by this predicate,
> % please see the comment in the top of this file.
> %
>
>    % Creates the necessary goals for handling exceptions that do not 
> indicate
>    % a rollback.  The role of the these goals is to validate the transaction
>    % log and act upon the result.  The goals created are listed below:
>    %
>    %   impure stm_builtin.stm_lock,
>    %   impure stm_builtin.validate(STM, IsValid),
>    %   impure stm_builtin.stm_unlock,
>    %   (
>    %       IsValid = stm_transaction_valid,
>    %       rethrow(Exception)
>    %   ;
>    %       IsValid = stm_transaction_invalid,
>    %       impure stm_discard_transaction_log(STM),
>    %       'StmExpanded_rollback_0_0_0'(X, Y)
>    %   )
>    %
> :- pred create_validate_exception_goal(prog_var::in, prog_var::in,
>    mer_type::in, hlds_goal::in, hlds_goal::out, stm_new_pred_info::in,
>    stm_new_pred_info::out) is det.
>
> create_validate_exception_goal(StmVar, ExceptionVar, ReturnType, 
> RecursiveCall,
>        HldsGoal, !NewPredInfo) :-
>    make_type_info(ReturnType, TypeInfoVar, CreateTypeInfoGoals, 
> !NewPredInfo),
>    create_simple_call(module_exception_sym_name, "rethrow", pf_predicate,
>        only_mode, detism_det, purity_pure, [TypeInfoVar, ExceptionVar], [],
>        [pair(TypeInfoVar, ground(shared, none)),
>        pair(ExceptionVar, ground(shared, none))],
>        HldsGoal_ExceptionThrow_Call, !NewPredInfo),
>    create_plain_conj(CreateTypeInfoGoals ++ [HldsGoal_ExceptionThrow_Call],
>        HldsGoal_ValidBranch),
>    create_plain_conj([RecursiveCall], HldsGoal_InvalidBranch),
>    template_lock_and_validate(StmVar, yes, HldsGoal_ValidBranch,
>        HldsGoal_InvalidBranch, HldsGoals, !NewPredInfo),
>    create_plain_conj(HldsGoals, HldsGoal).
>
>
>    % Creates the necessary goals for handling explicit retries.  The role
>    % of these goals is to validate the log and block the thread if the
>    % log is valid (provided that transaction variables to wait on exist
>    % in the log).
>    %
> :- pred create_retry_handler_branch(prog_var::in, hlds_goal::in,
>    hlds_goal::out, stm_new_pred_info::in, stm_new_pred_info::out) is det.
>
> create_retry_handler_branch(StmVar, RecCall, HldsGoal, !NewPredInfo) :-
>    create_simple_call(module_stm_sym_name, "stm_block", pf_predicate,
>        only_mode, detism_det, purity_impure, [StmVar], [],
>        [pair(StmVar, ground(unique, none))], BlockGoal, !NewPredInfo),
>    create_simple_call(module_stm_sym_name, "stm_unlock", pf_predicate,
>        only_mode, detism_det, purity_impure, [], [], [], UnlockGoal,
>        !NewPredInfo),
>    template_lock_and_validate(StmVar, no, BlockGoal, UnlockGoal,
>        LockAndValidateGoals, !NewPredInfo),
>    create_simple_call(module_stm_sym_name, "stm_discard_transaction_log",
>        pf_predicate, only_mode, detism_det, purity_impure,
>        [StmVar], [], [pair(StmVar, ground(clobbered, none))],
>        DropStateCall, !NewPredInfo),
>    create_plain_conj(LockAndValidateGoals ++ [DropStateCall, RecCall],
>        HldsGoal).
>
>
>    % Creates the necessary goals for switching on an exception.  The role of

>    % the created goals is to extract the exception from the exception result
>    % (using predicates from the "univ" module) and create the if-then-else
>    % statements which branch on the result.
>    % :- pred create_test_on_exception(prog_var::in, prog_var::in, 
> mer_type::in,
>    hlds_goal::in, hlds_goal::out, stm_new_pred_info::in,
>    stm_new_pred_info::out) is det.
>
> create_test_on_exception(ExceptVar, StmVar, ReturnType, RecCall, HldsGoal,
>        !NewPredInfo) :-
>    create_aux_variable(stm_univ_type, yes("ExceptUnivVar"), ExceptUnivVar,
>        !NewPredInfo),
>    deconstruct_functor(ExceptVar, stm_exceptres_exception_functor,
>        [ExceptUnivVar], DeconstructException),
>    make_type_info(stm_rollback_exception_type, TypeInfoRollbackVar,
>        TypeInfoRollbackAssign, !NewPredInfo),
>    create_simple_call(module_stm_sym_name, "stm_discard_transaction_log",
>        pf_predicate, only_mode, detism_det, purity_impure, [StmVar], [],
>        [pair(StmVar, ground(clobbered, none))], DropStateGoal, 
> !NewPredInfo),
>
>    create_plain_conj([DropStateGoal, RecCall], TrueGoal),
>    create_validate_exception_goal(StmVar, ExceptVar, ReturnType, RecCall,
>        RethrowBranch, !NewPredInfo),
>
>    create_retry_handler_branch(StmVar, RecCall, RetryBranch, !NewPredInfo),
>
>    template_if_exceptres_is_cons(TypeInfoRollbackVar, ExceptUnivVar,
>        stm_rollback_retry_functor, RetryBranch, RethrowBranch, FalseGoal,
>        !NewPredInfo),
>    template_if_exceptres_is_cons(TypeInfoRollbackVar, ExceptUnivVar,
>        stm_rollback_exception_functor, TrueGoal, FalseGoal, IfThenElseGoal,
>        !NewPredInfo),
>    create_plain_conj([DeconstructException] ++ TypeInfoRollbackAssign ++
>        [IfThenElseGoal], HldsGoal).
>
>
>    % Creates the main goal for the rollback predicate.  The goals created
>    % by this predicate create the closure for the wrapper predicate and
>    % deconstructs the value returned if no exception is present.  It
>    % relies on the above predicates to generate code for handling 
> exceptions.
>    %
> :- pred create_rollback_handler_goal(stm_goal_vars::in, mer_type::in,
>    prog_var::in, prog_var::in, pred_proc_id::in, hlds_goal::in,
>    hlds_goal::out, stm_info::in, stm_new_pred_info::in,
>    stm_new_pred_info::out) is det.
>
> create_rollback_handler_goal(AtomicGoalVars, ReturnType, StmVarDI, StmVarUO,
>        WrapperID, RecCall, HldsGoal, StmInfo, !NewPredInfo) :-
>    % Creates the higher order type for the wrapper closure.
>    WrapperIDShroud = shroud_pred_proc_id(WrapperID),
>
>    get_input_output_varlist(AtomicGoalVars, InputVars, _),
>    get_input_output_types(AtomicGoalVars, StmInfo, InputTypes, _),
>    get_input_output_modes(AtomicGoalVars, InputModes, _),
>
>    construct_higher_order_pred_type(purity_pure, lambda_normal,
>        InputTypes ++ [ReturnType, stm_state_type, stm_state_type],
>        Wrapper_HO_Type),
>
>    Wrapper_HO_Functor = pred_const(WrapperIDShroud, lambda_normal),
>    create_aux_variable(Wrapper_HO_Type, yes("AtomicClosure"),
>        AtomicClosureVar, !NewPredInfo),
>    make_type_info(ReturnType, RttiTypeVar, RttiTypeVarAssign, !NewPredInfo),
>    construct_functor(AtomicClosureVar, Wrapper_HO_Functor, InputVars,
>        ClosureAssign0),
>
>    ClosureAssignInstmapDeltaList = assoc_list.from_corresponding_lists(
>        [AtomicClosureVar],
>        [ground(shared, higher_order(pred_inst_info(pf_predicate,
>        InputModes ++ [mer_mode_out, mer_mode_di, mer_mode_uo],
>        detism_det)))]),
>
>    instmap_delta_from_assoc_list(ClosureAssignInstmapDeltaList,
>        ClosureAssignInstmapDelta),
>
>    ClosureAssign0 = hlds_goal(ClosureAssignExpr, ClosureAssignInfo0),
>    goal_info_set_instmap_delta(ClosureAssignInstmapDelta, 
> ClosureAssignInfo0,
>        ClosureAssignInfo),
>    ClosureAssign = hlds_goal(ClosureAssignExpr, ClosureAssignInfo),
>
>    % Creates the necessary exception types, based on the output type of
>    % the stm predicate.
>
>    Exception_Result_Type = stm_exception_result_type(ReturnType),
>    ExceptRes_Success_Functor = stm_exceptres_success_functor,
>    ExceptRes_Failure_Functor = stm_exceptres_exception_functor,
>
>    create_aux_variable(Exception_Result_Type, yes("ExceptionResult"),
>        ReturnExceptVar, !NewPredInfo),
>
>    create_simple_call(module_stm_sym_name, "stm_create_transaction_log",
>        pf_predicate, only_mode, detism_det, purity_impure, [StmVarDI], [],
>        [pair(StmVarDI, ground(unique, none))], HldsGoal_StmCreate,
>        !NewPredInfo),
>
>    % TODO: Select mode based on determism of actual goal.  0 if determistic,
>    % 1 if cc_multi.
>
>    create_simple_call(module_exception_sym_name, "unsafe_try_stm",
>        pf_predicate, mode_no(0), detism_cc_multi, purity_pure,
>        [RttiTypeVar, AtomicClosureVar, ReturnExceptVar, StmVarDI, StmVarUO],
>        [], [pair(RttiTypeVar, ground(shared, none)),
>        pair(AtomicClosureVar, ground(shared, none)),
>        pair(ReturnExceptVar, ground(shared, none)),
>        pair(StmVarDI, ground(clobbered, none)),
>        pair(StmVarUO, ground(unique, none))], HldsGoal_TryStm,
>        !NewPredInfo),
>
>    % For successfull execution, deconstruct and return true

I don't understand that comment.

>    deconstruct_output(AtomicGoalVars, ReturnType, ReturnExceptVar,
>        Branch_AtomicSuccess, StmInfo, !NewPredInfo),
>    create_test_on_exception(ReturnExceptVar, StmVarUO, ReturnType, RecCall,
>        Branch_AtomicException, !NewPredInfo),
>
>    create_switch_disjunction(ReturnExceptVar,
>        [case(ExceptRes_Failure_Functor, Branch_AtomicException),
>        case(ExceptRes_Success_Functor, Branch_AtomicSuccess)],
>        detism_det, purity_impure, DisjGoal, !NewPredInfo),
>
>    create_plain_conj([HldsGoal_StmCreate] ++ RttiTypeVarAssign ++
>        [ClosureAssign, HldsGoal_TryStm, DisjGoal], HldsGoal0),
>    create_promise_purity_scope(HldsGoal0, purity_pure, HldsGoal).
>
>
>    % Creates the rollback predicate.  This predicate is responsible for
>    % making the closure to the wrapper predicate and executing it whilst
>    % catching any possible exceptions that might be thrown It is also
>    % responsible for handing retries and rollbacks.
>    %
> :- pred create_rollback_pred(stm_goal_vars::in, hlds_goal::out, 
> hlds_goal::in,
>    stm_info::in, stm_info::out) is det.
>
> create_rollback_pred(AtomicGoalVars, CallGoal, AtomicGoal,
>        !StmInfo) :-
>    get_input_output_varlist(AtomicGoalVars, InputVars, OutputVars),
>    get_input_output_types(AtomicGoalVars, !.StmInfo, InputTypes, 
> OutputTypes),
>    get_input_output_modes(AtomicGoalVars, InputModes, OutputModes),
>
>    create_cloned_pred(InputVars ++ OutputVars, InputTypes ++ OutputTypes,
>        InputModes ++ OutputModes, "rollback", AtomicGoal, NewPredInfo0,
>        CallGoal, !StmInfo),
>
>    create_rollback_pred_2(AtomicGoalVars, CallGoal, AtomicGoal,
>        NewPredInfo0, NewPredInfo, !StmInfo),
>    commit_new_pred(NewPredInfo, !StmInfo).
>
>
> :- pred create_rollback_pred_2(stm_goal_vars::in, hlds_goal::in, 
> hlds_goal::in,
>    stm_new_pred_info::in, stm_new_pred_info::out, stm_info::in,
>    stm_info::out) is det.
>
> create_rollback_pred_2(AtomicGoalVars, RecCallGoal, AtomicGoal, !NewPredInfo,
>        !StmInfo) :-
>    get_input_output_types(AtomicGoalVars, !.StmInfo, _, OutputTypes),
>    make_return_type(OutputTypes, ResultType),
>    create_aux_variable(ResultType, yes("ResltVar"), ResultVar, 
> !NewPredInfo),
>    create_aux_variable(stm_state_type, yes("STM0"), InnerDI, !NewPredInfo),
>    create_aux_variable(stm_state_type, yes("STM"), InnerUO, !NewPredInfo),
>
>    % Temporally commits the predicate to the StmInfo so that the wrapper

s/Temporally/Temporarily/

>    % predicate can have the most up to date copy of the module info.
>    commit_new_pred(!.NewPredInfo, !StmInfo),
>
>    create_wrapper_pred(AtomicGoalVars, ResultType, ResultVar, AtomicGoal,
>        WrapperID, _, !StmInfo),
>
>    % Stores the up to date module info back into the new predicate info.
>    update_new_pred_info(!.StmInfo, !NewPredInfo),
>
>    create_rollback_handler_goal(AtomicGoalVars, ResultType, InnerDI, 
> InnerUO,
>        WrapperID, RecCallGoal, RollbackGoal, !.StmInfo, !NewPredInfo),
>    new_pred_set_goal(RollbackGoal, !NewPredInfo),
>    run_quantification_over_pred(!NewPredInfo),
>    commit_new_pred(!.NewPredInfo, !StmInfo).
>
> %-----------------------------------------------------------------------------%
> %
> % Predicates involved in moving local variables from the original predicate
> % to the newly created wrapper predicate.
>
>    % Moves a single variable, along with its type, from the original
>    % predicate to the newly created wrapper predicate.
>    % :- pred apply_varset_to_preds(prog_var::in, prog_varset::in, 
> prog_varset::out,
>    vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
>    vartypes::in, vartypes::out, prog_var_renaming::in,
>    prog_var_renaming::out) is det.
>
> apply_varset_to_preds(ProgVar, !NewPredVarSet, !NewPredVarTypes,
>        !OldPredVarSet, !OldPredVarTypes, !VarMapping) :-
>    map.lookup(!.OldPredVarTypes, ProgVar, ProgType),
>    delete_var(!.OldPredVarSet, ProgVar, !:OldPredVarSet),
>    map.delete(!.OldPredVarTypes, ProgVar, !:OldPredVarTypes),
>    new_var(NewProgVar, !NewPredVarSet),
>    map.det_insert(!.NewPredVarTypes, NewProgVar, ProgType,
>        !:NewPredVarTypes),
>    map.det_insert(!.VarMapping, ProgVar, NewProgVar, !:VarMapping).

Use the predicates in the svmap module in preference to those in map,
since in the former the argument orders are more amenable to state
variables.

>    % Moves all local variables from the original predicate to the newly
>    % created wrapper predicate.  This also includes the original STM
>    % di and uo variables.

s/di and uo/state/

>    % :- pred move_variables_to_new_pred(hlds_goal::in, hlds_goal::out,
>    stm_goal_vars::in, prog_var::in, prog_var::in, stm_new_pred_info::in,
>    stm_new_pred_info::out, stm_info::in, stm_info::out) is det.
>
> move_variables_to_new_pred(AtomicGoal0, AtomicGoal, AtomicGoalVars,
>        InnerDI, InnerUO, !NewPredInfo, !StmInfo) :-
>    NewProcInfo0 = !.NewPredInfo ^ new_pred_proc_info,
>    OldProcInfo0 = !.StmInfo ^ stm_info_proc_info,
>    proc_info_get_varset(NewProcInfo0, NewPredVarSet0),
>    proc_info_get_vartypes(NewProcInfo0, NewPredVarTypes0),
>    proc_info_get_varset(OldProcInfo0, OldPredVarSet0),
>    proc_info_get_vartypes(OldProcInfo0, OldPredVarTypes0),
>    AtomicGoalVars = stm_goal_vars(_, LocalVars, _, OrigInnerDI, 
> OrigInnerUO),
>    LocalVarList = set.to_sorted_list(LocalVars),
>
>    VarMapping0 = map.init,
>    list.foldl5(apply_varset_to_preds, LocalVarList,
>        NewPredVarSet0, NewPredVarSet, NewPredVarTypes0, NewPredVarTypes,
>        OldPredVarSet0, OldPredVarSet, OldPredVarTypes0, OldPredVarTypes,
>        VarMapping0, VarMapping1),
>
>    ( OrigInnerDI = OrigInnerUO ->
>        map.det_insert(VarMapping1, OrigInnerDI, InnerDI, VarMapping)
>    ;
>        map.det_insert(VarMapping1, OrigInnerDI, InnerDI, VarMapping2),
>        map.det_insert(VarMapping2, OrigInnerUO, InnerUO, VarMapping)
>    ),
>
>    rename_some_vars_in_goal(VarMapping, AtomicGoal0, AtomicGoal),
>    proc_info_set_varset(NewPredVarSet, NewProcInfo0, NewProcInfo1),
>    proc_info_set_vartypes(NewPredVarTypes, NewProcInfo1, NewProcInfo),
>    proc_info_set_varset(OldPredVarSet, OldProcInfo0, OldProcInfo1),
>    proc_info_set_vartypes(OldPredVarTypes, OldProcInfo1, OldProcInfo),
>    !:NewPredInfo = !.NewPredInfo ^ new_pred_proc_info := NewProcInfo,
>    !:StmInfo = !.StmInfo ^ stm_info_proc_info := OldProcInfo.
>
> %-----------------------------------------------------------------------------%
> %
> % Predicates involved in the creation of the wrapper predicate.
> %
>
>    % Creates the wrapper predicate.  Return the pred_proc_id of the newly
>    % created wrapper predicate as well as a goal to call it.
>    %
> :- pred create_wrapper_pred(stm_goal_vars::in, mer_type::in, prog_var::in,
>    hlds_goal::in, pred_proc_id::out, hlds_goal::out, stm_info::in,
>    stm_info::out) is det.
>
> create_wrapper_pred(AtomicGoalVars, ResultType, ResultVar0, AtomicGoal,
>        PredProcId, CallGoal, !StmInfo) :-
>    create_wrapper_pred_2(AtomicGoalVars, ResultType, ResultVar0, AtomicGoal,
>        PredProcId, _, CallGoal, !StmInfo).
>
>
> :- pred create_wrapper_pred_2(stm_goal_vars::in, mer_type::in, prog_var::in,
>    hlds_goal::in, pred_proc_id::out, stm_new_pred_info::out, hlds_goal::out,
>    stm_info::in, stm_info::out) is det.
>
> create_wrapper_pred_2(AtomicGoalVars, ResultType, ResultVar0,
>        !.AtomicGoal, PredProcId, !:NewPredInfo, CallGoal, !StmInfo) :-
>    InnerDI = AtomicGoalVars ^ vars_innerDI,
>    InnerUO0 = AtomicGoalVars ^ vars_innerUO,
>
>    get_input_output_varlist(AtomicGoalVars, InputVars, _),
>    get_input_output_types(AtomicGoalVars, !.StmInfo, InputTypes, _),
>    get_input_output_modes(AtomicGoalVars, InputModes, _),
>
>    create_cloned_pred(InputVars ++ [ResultVar0, InnerDI, InnerUO0],
>        InputTypes ++ [ResultType, stm_state_type, stm_state_type],
>        InputModes ++ [mer_mode_out, mer_mode_di, mer_mode_uo],
>        "wrapper", !.AtomicGoal, !:NewPredInfo, CallGoal, !StmInfo),
>
>    rename_var_in_wrapper_pred("stm_ResultVar", ResultVar0, ResultType,
>        ResultVar, !NewPredInfo, !AtomicGoal),
>    move_variables_to_new_pred(!AtomicGoal, AtomicGoalVars, InnerDI, 
> InnerUO0,
>        !NewPredInfo, !StmInfo),
>
>    % Handles the case when the Inner di and Inner uo variables are the same.
>    % Explicitly creates a unification to keep these variables different
>    % (because of the uniqueness requirements of a number of calls added to
>    % the end of the original goal)
>
>    ( InnerUO0 = InnerDI ->
>        CopyStm = yes,
>        create_aux_variable(stm_state_type, yes("NewUO"), InnerUO,
>            !NewPredInfo),
>        set_head_vars(InputVars ++ [ResultVar0, InnerDI, InnerUO], 
> !NewPredInfo)
>    ;
>        CopyStm = no,
>        InnerUO = InnerUO0
>    ),
>
>    create_post_wrapper_goal(AtomicGoalVars, !.AtomicGoal, ResultType,
>        ResultVar, InnerDI, InnerUO, CopyStm, WrapperGoal, !.StmInfo,
>        !NewPredInfo),
>
>    new_pred_set_goal(WrapperGoal, !NewPredInfo),
>    run_quantification_over_pred(!NewPredInfo),
>    get_pred_proc_id(!.NewPredInfo, PredProcId),
>    commit_new_pred(!.NewPredInfo, !StmInfo).
>
>
>    % Creates the goals for validating and committing (or raising a rollback
>    % exception) a transaction log.  These goals appear after the original
>    % goal.  If the value of CopySTM is "yes", a goal unifying the variable
>    % in StmDI and the variable in StmUO will be created before the log
>    % is validated.
>    %
> :- pred create_post_wrapper_goal(stm_goal_vars::in, hlds_goal::in,
>    mer_type::in, prog_var::in, prog_var::in, prog_var::in, bool::in,
>    hlds_goal::out, stm_info::in, stm_new_pred_info::in,
>    stm_new_pred_info::out) is det.
>
> create_post_wrapper_goal(AtomicGoalVars, AtomicGoal, ResultType, ResultVar,
>        StmDI, StmUO, CopySTM, HldsGoal, StmInfo, !NewPredInfo) :-
>    StmModuleName = module_stm_sym_name,
>    ExceptionModuleName = module_exception_sym_name,
>
>    construct_output(AtomicGoalVars, ResultType, ResultVar, StmInfo,
>        AssignResult, !NewPredInfo),
>    create_aux_variable(stm_valid_result_type, yes("Stm_Expand_IsValid"),
>        IsValidVar, !NewPredInfo),
>
>    ValidTrueFunctor = stm_validres_valid_functor,
>    ValidFalseFunctor = stm_validres_invalid_functor,
>    RollbackCons = stm_rollback_exception_functor,
>
>    % Creates the necessary predicate calls.
>
>    create_aux_variable_assignment(RollbackCons, stm_rollback_exception_type,
>        yes("Stm_Expand_Rollback"), ConstRollbackGoal, RollbackVar,
>        !NewPredInfo),
>    create_simple_call(StmModuleName, "stm_lock", pf_predicate, only_mode,
>        detism_det, purity_impure, [], [], [], HldsGoal_StmLock_Call,
>        !NewPredInfo),
>    create_simple_call(StmModuleName, "stm_unlock", pf_predicate, only_mode,
>        detism_det, purity_impure, [], [], [], HldsGoal_StmUnLock_Call,
>        !NewPredInfo),
>    create_simple_call(StmModuleName, "stm_validate", pf_predicate, 
> only_mode,
>        detism_det, purity_impure, [StmUO, IsValidVar], [],
>        [pair(StmUO, ground(unique, none)),
>        pair(IsValidVar, ground(shared, none))], HldsGoal_StmValidate_Call,
>        !NewPredInfo),
>    create_simple_call(StmModuleName, "stm_commit", pf_predicate, only_mode,
>        detism_det, purity_impure, [StmUO], [],
>        [pair(StmUO, ground(unique, none))], HldsGoal_StmCommit_Call,
>        !NewPredInfo),
>
>    make_type_info(stm_rollback_exception_type, TypeInfoVar,
>        CreateTypeInfoGoals, !NewPredInfo),
>
>    create_simple_call(ExceptionModuleName, "throw", pf_predicate, only_mode,
>        detism_det, purity_pure, [TypeInfoVar, RollbackVar], [],
>        [pair(TypeInfoVar, ground(shared, none)),
>         pair(RollbackVar, ground(shared, none))],
>        HldsGoal_ExceptionThrow_Call, !NewPredInfo),
>
>    % Creates the branch on the validation result of the log.
>    create_plain_conj([HldsGoal_StmCommit_Call, HldsGoal_StmUnLock_Call],
>        HldsGoal_ValidBranch),
>    create_plain_conj([HldsGoal_StmUnLock_Call, ConstRollbackGoal] ++
>        CreateTypeInfoGoals ++ [HldsGoal_ExceptionThrow_Call],
>        HldsGoal_InvalidBranch),
>
>    create_switch_disjunction(IsValidVar,
>        [case(ValidTrueFunctor, HldsGoal_ValidBranch),
>         case(ValidFalseFunctor, HldsGoal_InvalidBranch)],
>        detism_det, purity_impure, DisjGoal, !NewPredInfo),
>
>    % Creates the main validation and commission goal.
>    PostAtomicTopLevelList = [HldsGoal_StmLock_Call,
>        HldsGoal_StmValidate_Call, DisjGoal],
>
>    create_plain_conj(PostAtomicTopLevelList, PostAtomicGoal0),
>    create_promise_purity_scope(PostAtomicGoal0, purity_pure, 
> PostAtomicGoal),
>
>    % Creates the unification between StmUO and StmDI is needed.
>    ( CopySTM = yes ->
>        create_var_unify(StmUO, StmDI, pair(mer_mode_uo, mer_mode_di),
>            CopySTMAssign, !NewPredInfo),
>        TopLevelGoalList0 = [AtomicGoal] ++ AssignResult ++ [CopySTMAssign,
>            PostAtomicGoal]
>    ;
>        TopLevelGoalList0 = [AtomicGoal] ++ AssignResult ++
>            [PostAtomicGoal]
>    ),


Switch on CopySTM rather than using an if-then-else.

>
>    flatten_conj(TopLevelGoalList0, TopLevelGoalList),
>    create_plain_conj(TopLevelGoalList, HldsGoal).
>
>
> %-----------------------------------------------------------------------------%
> %
> % Utility predicates used in the creation of the rollback predicate and the
> % wrapper predicate.
> %
>
>    % Returns the type of the value that is to be returned by the wrapper
>    % predicate given the types of the output variables.
>    %
> :- pred make_return_type(list(mer_type)::in, mer_type::out) is det.
>
> make_return_type(Types, ReturnType) :-
>    (
>        Types = [],
>        ReturnType = stm_dummy_output_type
>    ;
>        Types = [_ | _],
>
>        ( Types = [SingleType] ->
>            ReturnType = SingleType
>        ;
>            ReturnType = tuple_type(Types, kind_star)
>        )
>    ).

That would be more simply expressed as:

 	make_return_type([], stm_dummy_output_type).
 	make_return_type([Type], Type).
 	make_return_type([_, _ | _] @ Types,
 		tuple_type(Types, kind_star).

...

>    % Creates the goals necessary for extracting the output variables from
>    % the return value of the wrapper.
>    %
> :- pred deconstruct_output(stm_goal_vars::in, mer_type::in, prog_var::in,
>    hlds_goal::out, stm_info::in, stm_new_pred_info::in,
>    stm_new_pred_info::out) is det.
>
> deconstruct_output(AtomicGoalVars, ReturnType, ReturnExceptVar,
>        HldsGoal, StmInfo, !NewPredInfo) :-

The code following refers to HldsGoals and HldsGoal; I would use just
Goals and Goal in their place.


>    get_input_output_varlist(AtomicGoalVars, _, OutputVars),
>    get_input_output_types(AtomicGoalVars, StmInfo, _, OutputTypes),
>
>    ( OutputTypes = [] ->
>        % Extract the return type but do nothing with it.  For reasons that
>        % I do not know, this is the bare minimum that is required without
>        % causing an exception in a later stage.
>
>        create_aux_variable(ReturnType, yes("BoringResult"), SucessResultVar,
>            !NewPredInfo),
>        deconstruct_functor(ReturnExceptVar, stm_exceptres_success_functor,
>            [SucessResultVar], HldsGoal)
>
>    ; OutputTypes = [_] ->
>        % Wrapper returns a single value -- Simply get the value from the
>        % exception result and return.
>
>        OutVar = list.det_head(OutputVars),
>        deconstruct_functor(ReturnExceptVar, stm_exceptres_success_functor,
>            [OutVar], HldsGoal)
>    ;
>        % Wrapper returns a tupple.  Get the tupple result and return it.

s/tupple/tuple/

>        make_type_info(ReturnType, _, MakeType, !NewPredInfo),
>        create_aux_variable(ReturnType, yes("SucessResult"), SucessResultVar,
>            !NewPredInfo),
>        deconstruct_functor(ReturnExceptVar, stm_exceptres_success_functor,
>            [SucessResultVar], DeconstructGoal),
>        deconstruct_tuple(SucessResultVar, OutputVars, UnifyOutputGoal),
>
>        create_plain_conj([DeconstructGoal, UnifyOutputGoal | MakeType],
>            HldsGoal)
>    ).

Replace that if-then-else with a switch, e.g.

 	(
 		OutputTypes = [],
 		...
 	;
 		OutputTypes = [_],
 		...
 	;
 		OutputTypes = [_, _ | _],
 		...
 	)

Likewise construct_output/7 following should also use a switch.

>    % Creates the goals necessary for constructing the output variables
>    % in the wrapper predicate.  It is necessary to compress all the output
>    % values into a single variable to be passed along with the exception
>    % result.
>    %
> :- pred construct_output(stm_goal_vars::in, mer_type::in, prog_var::in,
>    stm_info::in, hlds_goals::out, stm_new_pred_info::in,
>    stm_new_pred_info::out) is det.
>
> construct_output(AtomicGoalVars, ResultType, ResultVar, StmInfo, HldsGoals,
>        !NewPredInfo) :-
>    get_input_output_varlist(AtomicGoalVars, _, OutputVars),
>    get_input_output_types(AtomicGoalVars, StmInfo, _, OutputTypes),
>
>    ( OutputTypes = [] ->
>        % Since a value must be returned, simply return a value which will be
>        % discarded.
>
>        create_const_assign(ResultVar, stm_dummy_output_functor, HldsGoal),
>        HldsGoals = [HldsGoal]
>
>    ; OutputTypes = [_] ->
>        % Wrapper returns a single value -- Simply get the value from the
>        % exception result and return.
>
>        OutVar = list.det_head(OutputVars),
>        create_var_unify(ResultVar, OutVar, pair(mer_mode_out, mer_mode_in),
>            HldsGoal, !NewPredInfo),
>
>        HldsGoals = [HldsGoal]
>    ;
>        % Wrapper returns a tupple.  Creates a tupple from the output values.
>
>        make_type_info(ResultType, _, MakeType, !NewPredInfo),
>        hlds_goal.construct_tuple(ResultVar, OutputVars, HldsGoal),
>
>        HldsGoals = [HldsGoal | MakeType]
>    ).
>
>
>    % Renames the value of a variable in a predicate.
>    %
> :- pred rename_var_in_wrapper_pred(string::in, prog_var::in, mer_type::in,
>    prog_var::out, stm_new_pred_info::in, stm_new_pred_info::out,
>    hlds_goal::in, hlds_goal::out) is det.
>
> rename_var_in_wrapper_pred(Name, ResultVar0, ResultType, ResultVar,
>        !NewPredInfo, !HldsGoal) :-
>    NewProcInfo0 = !.NewPredInfo ^ new_pred_proc_info,
>    proc_info_get_varset(NewProcInfo0, NewPredVarSet0),
>    proc_info_get_vartypes(NewProcInfo0, NewPredVarTypes0),
>    proc_info_get_headvars(NewProcInfo0, NewHeadVars0),
>    delete_var(NewPredVarSet0, ResultVar0, NewPredVarSet1),
>    map.delete(NewPredVarTypes0, ResultVar0, NewPredVarTypes1),
>
>    new_named_var(Name, ResultVar, NewPredVarSet1, NewPredVarSet),
>    map.det_insert(NewPredVarTypes1, ResultVar, ResultType, NewPredVarTypes),
>
>    VarMapping0 = map.init,
>    map.det_insert(VarMapping0, ResultVar0, ResultVar, VarMapping),
>
>    MapLambda = ((pred(X::in, Y::out) is det) :-
>        ( X = ResultVar0 ->
>            Y = ResultVar
>        ;
>            Y = X
>        )
>    ),
>    list.map(MapLambda, NewHeadVars0, NewHeadVars),
>
>    rename_some_vars_in_goal(VarMapping, !HldsGoal),
>    proc_info_set_varset(NewPredVarSet, NewProcInfo0, NewProcInfo1),
>    proc_info_set_vartypes(NewPredVarTypes, NewProcInfo1, NewProcInfo2),
>    proc_info_set_headvars(NewHeadVars, NewProcInfo2, NewProcInfo),
>    !:NewPredInfo = !.NewPredInfo ^ new_pred_proc_info := NewProcInfo.
>
>
> %-----------------------------------------------------------------------------%
> %
> % Predicates to assist in the creation of hlds_goals.  To simplify the 
> creation
> % of goals in a predicate, many of these functions thread the type
> % "stm_new_pred_info" which contains, amonst other things, the predicate 
> info,
> % procedure info and module info of the newly created predicate.
> %
> % Many of the created goals create default instmap_deltas and non-local
> % variable sets.  This is because it is assumed that quantification and
> % recalculation of the instmap_deltas will be done over the newly created
> % predicate (the call to "run_quantification_over_pred" will do this).
> %
>
>    % Creates an auxiliary variable with a specific type
>    %
> :- pred create_aux_variable(mer_type::in, maybe(string)::in, prog_var::out,
>    stm_new_pred_info::in, stm_new_pred_info::out) is det.
>
> create_aux_variable(Type, MaybeName, Var, !NewPredInfo) :-
>    ProcInfo0 = !.NewPredInfo ^ new_pred_proc_info,
>    proc_info_create_var_from_type(Type, MaybeName, Var, ProcInfo0, 
> ProcInfo),
>    !:NewPredInfo = !.NewPredInfo ^ new_pred_proc_info := ProcInfo.
>
>
>    % Creates a goal which assigns a variable to a cons_id.
>    %
> :- pred create_const_assign(prog_var::in, cons_id::in, hlds_goal::out) is 
> det.
>
> create_const_assign(Var, Const, AssignmentGoal) :-
>    make_const_construction(Var, Const, AssignmentGoal).
>
>
>    % Creates a new auxiliary variable and a goal which assigns it to a
>    % cons_id.
>    %
> :- pred create_aux_variable_assignment(cons_id::in, mer_type::in,
>    maybe(string)::in, hlds_goal::out, prog_var::out, stm_new_pred_info::in,
>    stm_new_pred_info::out) is det.
>
> create_aux_variable_assignment(Cons, Type, MaybeName, Goal, Var,
>        !NewPredInfo) :-
>    create_aux_variable(Type, MaybeName, Var, !NewPredInfo),
>    create_const_assign(Var, Cons, Goal).
>
>
>    % Creates a simple test between two variables (using the unify goal).
>    %
> :- pred create_var_test(prog_var::in, prog_var::in, unify_mode::in,
>    hlds_goal::out, stm_new_pred_info::in, stm_new_pred_info::out) is det.
>
> create_var_test(VarLHS, VarRHS, UnifyMode, HldsGoal, !NewPredInfo) :-
>    Context = !.NewPredInfo ^ new_pred_context,
>    ModuleInfo = !.NewPredInfo ^ new_pred_module_info,
>
>    UnifyType = simple_test(VarLHS, VarRHS),
>    UnifyRHS = rhs_var(VarRHS),
>    UnifyContext = unify_context(umc_explicit, []),
>    UnifyMode = ModeLHS - ModeRHS,
>
>    instmap_delta_from_mode_list([VarLHS, VarRHS], [ModeLHS, ModeRHS],
>        ModuleInfo, InstmapDelta),
>    HldsGoalExpr = unify(VarLHS, UnifyRHS, UnifyMode, UnifyType, 
> UnifyContext),
>
>    set.init(NonLocals0),
>    set.insert(NonLocals0, VarLHS, NonLocals1),
>    set.insert(NonLocals1, VarRHS, NonLocals),
>
>    Determism = detism_semi,
>    Purity = purity_pure,
>    goal_info_init(NonLocals, InstmapDelta, Determism, Purity, Context,
>        HldsGoalInfo),
>
>    HldsGoal = hlds_goal(HldsGoalExpr, HldsGoalInfo).
>
>
>    % Creates a unification between two variables (using the unify goal)
>    %
> :- pred create_var_unify(prog_var::in, prog_var::in, unify_mode::in,
>    hlds_goal::out, stm_new_pred_info::in, stm_new_pred_info::out) is det.
>
> create_var_unify(VarLHS, VarRHS, UnifyMode, HldsGoal, !NewPredInfo) :-
>    Context = !.NewPredInfo ^ new_pred_context,
>    ModuleInfo = !.NewPredInfo ^ new_pred_module_info,
>
>    UnifyType = assign(VarLHS, VarRHS),
>    UnifyRHS = rhs_var(VarRHS),
>    UnifyContext = unify_context(umc_explicit, []),
>    UnifyMode = ModeLHS - ModeRHS,
>
>    instmap_delta_from_mode_list([VarLHS, VarRHS], [ModeLHS, ModeRHS],
>        ModuleInfo, InstmapDelta),
>    HldsGoalExpr = unify(VarLHS, UnifyRHS, UnifyMode, UnifyType, 
> UnifyContext),
>
>    set.init(NonLocals0),
>    set.insert(NonLocals0, VarLHS, NonLocals1),
>    set.insert(NonLocals1, VarRHS, NonLocals),
>
>    Determism = detism_det,
>    Purity = purity_pure,
>    goal_info_init(NonLocals, InstmapDelta, Determism, Purity, Context,
>        HldsGoalInfo),
>
>    HldsGoal = hlds_goal(HldsGoalExpr, HldsGoalInfo).
>
>
>    % Creates a simple call.  If the call is polymorphic, remember to add
>    % the runtime type information as well ("type_info" variable).
>    %
> :- pred create_simple_call(module_name::in, string::in, pred_or_func::in,
>    mode_no::in, determinism::in, purity::in, prog_vars::in,
>    list(goal_feature)::in, assoc_list(prog_var, mer_inst)::in,
>    hlds_goal::out, stm_new_pred_info::in, stm_new_pred_info::out) is det.
>
> create_simple_call(ModuleName, ProcName, PredOrFunc, Mode, Detism, Purity,
>        ProgVars, GoalFeatures, InstmapDelta, Goal, !NewPredInfo) :-
>    Context = !.NewPredInfo ^ new_pred_context,
>    ModuleInfo = !.NewPredInfo ^ new_pred_module_info,
>    generate_simple_call(ModuleName, ProcName, PredOrFunc, Mode, Detism,
>        Purity, ProgVars, GoalFeatures, InstmapDelta, ModuleInfo, Context,
>        Goal).
>
>
>    % Creates an if-then-else goal.
>    %
> :- pred create_if_then_else(list(prog_var)::in, hlds_goal::in, hlds_goal::in,
>    hlds_goal::in, determinism::in, purity::in, hlds_goal::out,
>    stm_new_pred_info::in, stm_new_pred_info::out) is det.
>
> create_if_then_else(ExistVars, Cond, Then, Else, Detism, Purity, OutGoal,
>        !NewPredInfo) :-
>    Context = !.NewPredInfo ^ new_pred_context,
>    OutGoalExpr = if_then_else(ExistVars, Cond, Then, Else),
>    NonLocals = set.init,
>    instmap_delta_init_reachable(InstMapDelta),
>    goal_info_init(NonLocals, InstMapDelta, Detism, Purity, Context,
>        GoalInfo),
>    OutGoal = hlds_goal(OutGoalExpr, GoalInfo).
>
>
>    % Creates a switch goal.
>    %
> :- pred create_switch_disjunction(prog_var::in, list(case)::in,
>    determinism::in, purity::in, hlds_goal::out, stm_new_pred_info::in,
>    stm_new_pred_info::out) is det.
>
> create_switch_disjunction(ProgVar, Cases, Detism, Purity, OutGoal,
>        !NewPredInfo) :-
>    Context = !.NewPredInfo ^ new_pred_context,
>    NonLocals = set.init,
>    instmap_delta_init_reachable(InstMapDelta),
>    OutGoalExpr = switch(ProgVar, cannot_fail, Cases),
>    goal_info_init(NonLocals, InstMapDelta, Detism, Purity, Context,
>        GoalInfo),
>    OutGoal = hlds_goal(OutGoalExpr, GoalInfo).
>
>
>    % Creates a promise_purity around a goal for a given purity.
>    %
> :- pred create_promise_purity_scope(hlds_goal::in, purity::in,
>        hlds_goal::out) is det.
>
> create_promise_purity_scope(HldsGoalIn, ScopePurity, HldsGoalOut) :-
>    HldsGoalIn = hlds_goal(_, GoalInInfo),
>    NonLocals = goal_info_get_nonlocals(GoalInInfo),
>    InstMapDelta = goal_info_get_instmap_delta(GoalInInfo),
>    Detism = goal_info_get_determinism(GoalInInfo),
>    GoalPurity = ScopePurity,
>    Context = goal_info_get_context(GoalInInfo),
>    goal_info_init(NonLocals, InstMapDelta, Detism, GoalPurity, Context,
>        GoalInfo),
>    Reason = promise_purity(dont_make_implicit_promises, ScopePurity),
>    HldsGoalOutExpr = scope(Reason, HldsGoalIn),
>    HldsGoalOut = hlds_goal(HldsGoalOutExpr, GoalInfo).
>
>
>    % Creates a list of regular conjoined goals.
>    %
> :- pred create_plain_conj(hlds_goals::in, hlds_goal::out) is det.
>
> create_plain_conj(GoalsInConj, ConjGoal) :-
>    Type = plain_conj,
>    ConjGoalExpr = conj(Type, GoalsInConj),
>    goal_list_nonlocals(GoalsInConj, NonLocals),
>    goal_list_instmap_delta(GoalsInConj, InstMapDelta),
>    goal_list_determinism(GoalsInConj, Detism),
>    goal_list_purity(GoalsInConj, Purity),
>    GoalAInfo = list.det_head(GoalsInConj) ^ hlds_goal_info,
>    Context = goal_info_get_context(GoalAInfo),
>    goal_info_init(NonLocals, InstMapDelta, Detism, Purity, Context,
>        ConjGoalInfo),
>    ConjGoal = hlds_goal(ConjGoalExpr, ConjGoalInfo).
>
>
>    % Create typeinfo for use in polymorphic predicates
>    %
> :- pred make_type_info(mer_type::in, prog_var::out,
>    hlds_goals::out, stm_new_pred_info::in, stm_new_pred_info::out) is det.
>
> make_type_info(Type, Var, HldsGoals, NewPredInfo0, NewPredInfo) :-
>    NewPredInfo0 = stm_new_pred_info(ModuleInfo0, PredId, ProcId,
>        PredInfo0, ProcInfo0, Context),
>    create_poly_info(ModuleInfo0, PredInfo0, ProcInfo0, PolyInfo0),
>    polymorphism_make_type_info_var(Type, Context, Var, HldsGoals,
>        PolyInfo0, PolyInfo),
>    poly_info_extract(PolyInfo, PredInfo0, PredInfo, ProcInfo0, ProcInfo,
>        ModuleInfo),
>    NewPredInfo = stm_new_pred_info(ModuleInfo, PredId, ProcId,
>        PredInfo, ProcInfo, Context).
>
>
>    % Returns the list of goals from a case
>    %
> :- pred goals_from_case_list(list(case)::in, hlds_goals::out) is det.
>
> goals_from_case_list(CaseList, GoalList) :-
>    StripCase = (pred(Case::in, Goal::out) is det :- Case = case(_, Goal)),
>    list.map(StripCase, CaseList, GoalList).
>
>
> %-----------------------------------------------------------------------------%
> %
> % Predicates to assist in the creation of new predicates.
> %
>
>
>    % Creates a new predicate.  The head variables, head variable types, head
>    % variable modes, name and goal of the new predicate are set from the
>    % arguments.  All other properties are copied from the predicate in which
>    % the original atomic goal appears in.  The predicate returns a
>    % "stm_new_pred_info" value (so that the body of the predicate can be
>    % built) as well as a call to the new predicate.
>    %
> :- pred create_cloned_pred(list(prog_var)::in, list(mer_type)::in,
>    list(mer_mode)::in, string::in, hlds_goal::in, stm_new_pred_info::out,
>    hlds_goal::out, stm_info::in, stm_info::out) is det.
>
> create_cloned_pred(ProcHeadVars, PredArgTypes, ProcHeadModes,
>        Prefix, OrigGoal, NewStmPredInfo, CallGoal, !StmInfo) :-
>    ModuleInfo0 = !.StmInfo ^ stm_info_module_info,
>    PredInfo = !.StmInfo ^ stm_info_pred_info,
>    ProcId = !.StmInfo ^ stm_info_proc_id,
>    PredId = !.StmInfo ^ stm_info_pred_id,
>    ExpansionCnt = !.StmInfo ^ stm_info_expand_id,
>
>    list.length(ProcHeadVars, Arity),
>    OrigGoal = hlds_goal(_, GoalInfo0),
>
>    pred_info_proc_info(PredInfo, ProcId, ProcInfo),
>    proc_info_get_context(ProcInfo, ProcContext),
>    proc_info_get_varset(ProcInfo, ProcVarSet),
>    proc_info_get_vartypes(ProcInfo, ProcVarTypes),
>    proc_info_get_inst_varset(ProcInfo, ProcInstVarSet),
>    proc_info_get_inferred_determinism(ProcInfo, ProcDetism),
>    proc_info_get_goal(ProcInfo, ProcGoal),
>    proc_info_get_rtti_varmaps(ProcInfo, ProcRttiVarMaps),
>    proc_info_get_var_name_remap(ProcInfo, VarNameRemap),
>    proc_info_create(ProcContext, ProcVarSet, ProcVarTypes, ProcHeadVars,
>        ProcInstVarSet, ProcHeadModes, ProcDetism, ProcGoal, ProcRttiVarMaps,
>        address_is_not_taken, VarNameRemap, NewProcInfo),
>    ModuleName = pred_info_module(PredInfo),
>    OrigPredName = pred_info_name(PredInfo),
>    PredOrFunc = pred_info_is_pred_or_func(PredInfo),
>    pred_info_get_context(PredInfo, PredContext),
>
>    NewPredName = qualified(ModuleName, "StmExpanded_" ++ Prefix ++ "_" ++
>        OrigPredName ++ "_" ++ string(Arity) ++ "_" ++ string(PredId) ++
>        "_" ++ string(ExpansionCnt)),
>
>    pred_info_get_origin(PredInfo, OrigPredOrigin),
>    NewPredOrigin = origin_transformed(transform_stm_expansion,
>        OrigPredOrigin, PredId),
>
>    pred_info_get_typevarset(PredInfo, PredTypeVarSet),
>    pred_info_get_exist_quant_tvars(PredInfo, PredExistQVars),
>    pred_info_get_class_context(PredInfo, PredClassContext),
>    pred_info_get_assertions(PredInfo, PredAssertions),
>    pred_info_get_markers(PredInfo, Markers),
>    pred_info_create(ModuleName, NewPredName, PredOrFunc, PredContext,
>        NewPredOrigin, status_local, Markers, PredArgTypes,
>        PredTypeVarSet, PredExistQVars, PredClassContext, PredAssertions,
>        VarNameRemap, NewProcInfo, NewProcId, NewPredInfo),
>
>    module_info_get_predicate_table(ModuleInfo0, PredicateTable0),
>    predicate_table_insert(NewPredInfo, NewPredId,
>        PredicateTable0, PredicateTable),
>    module_info_set_predicate_table(PredicateTable, ModuleInfo0,
>        ModuleInfo),
>    CallExpr = plain_call(NewPredId, NewProcId, ProcHeadVars, not_builtin, 
> no,
>        NewPredName),
>
>    set.init(CallNonLocals0),
>    set.insert_list(CallNonLocals0, ProcHeadVars, CallNonLocals),
>    instmap_delta_from_mode_list(ProcHeadVars, ProcHeadModes, ModuleInfo0,
>        CallInstmapDelta),
>
>    CallDeterminism = goal_info_get_determinism(GoalInfo0),
>    CallPurity = goal_info_get_purity(GoalInfo0),
>    CallContext = goal_info_get_context(GoalInfo0),
>
>    goal_info_init(CallNonLocals, CallInstmapDelta, CallDeterminism,
>        CallPurity, CallContext, GoalInfo),
>    CallGoal = hlds_goal(CallExpr, GoalInfo),
>
>    !:StmInfo = !.StmInfo ^ stm_info_module_info := ModuleInfo,
>    NewStmPredInfo = stm_new_pred_info(ModuleInfo, NewPredId, NewProcId,
>       NewPredInfo, NewProcInfo, CallContext).
>
>
>    % Sets the head variables of the new predicate.
>    %
> :- pred set_head_vars(list(prog_var)::in, stm_new_pred_info::in,
>    stm_new_pred_info::out) is det.
>
> set_head_vars(NewHeadVars, !NewPredInfo) :-
>    ProcInfo0 = !.NewPredInfo ^ new_pred_proc_info,
>    proc_info_set_headvars(NewHeadVars, ProcInfo0, ProcInfo),
>    !:NewPredInfo = !.NewPredInfo ^ new_pred_proc_info := ProcInfo.
>
>
>    % Writes the changes made to the new predicate to the predicate table
>    % and returns an updates the stm_info state.
>    %
> :- pred commit_new_pred(stm_new_pred_info::in, stm_info::in,
>    stm_info::out) is det.
>
> commit_new_pred(NewPred, StmInfo0, StmInfo) :-
>    StmInfo0 = stm_info(_StmModuleInfo0, OrigPredId, OrigProcId, 
> OrigProcInfo,
>        OrigPredInfo, StmExpanded, ExpandNum),
>
>    NewPred = stm_new_pred_info(PredModuleInfo0, NewPredId, NewProcId,
>        NewPredInfo, NewProcInfo, _),
>    module_info_set_pred_proc_info(NewPredId, NewProcId, NewPredInfo,
>        NewProcInfo, PredModuleInfo0, PredModuleInfo),
>    StmInfo = stm_info(PredModuleInfo, OrigPredId, OrigProcId, OrigProcInfo,
>        OrigPredInfo, StmExpanded, ExpandNum).
>
>
>    % If changes have been made to the stm_info type (specifically the
>    % module_info), update these changes in stm_new_pred_info.
>    %
> :- pred update_new_pred_info(stm_info::in, stm_new_pred_info::in,
>    stm_new_pred_info::out) is det.
>
> update_new_pred_info(StmInfo, !NewPredInfo) :-
>    ModuleInfo = StmInfo ^ stm_info_module_info,
>    !:NewPredInfo = !.NewPredInfo ^ new_pred_module_info := ModuleInfo.
>
>
>    % Runs quantification and recalculates the instmap-delta over the
>    % new predicate.
>    %
> :- pred run_quantification_over_pred(stm_new_pred_info::in,
>    stm_new_pred_info::out) is det.
>
> run_quantification_over_pred(!NewPredInfo) :-
>    ProcInfo0 = !.NewPredInfo ^ new_pred_proc_info,
>    ModuleInfo0 = !.NewPredInfo ^ new_pred_module_info,
>
>    requantify_proc(ProcInfo0, ProcInfo1),
>
>    RecomputeAtomic = yes,
>    recompute_instmap_delta_proc(RecomputeAtomic, ProcInfo1, ProcInfo,
>        ModuleInfo0, ModuleInfo),
>
>    !:NewPredInfo = !.NewPredInfo ^ new_pred_module_info := ModuleInfo,
>    !:NewPredInfo = !.NewPredInfo ^ new_pred_proc_info := ProcInfo.
>
>
>    % Sets the goal of the new predicate.
>    %
> :- pred new_pred_set_goal(hlds_goal::in, stm_new_pred_info::in,
>    stm_new_pred_info::out) is det.
>
> new_pred_set_goal(HldsGoal, !NewPredInfo) :-
>    ProcInfo0 = !.NewPredInfo ^ new_pred_proc_info,
>    goal_vars(HldsGoal, GoalVars0),
>    proc_info_get_varset(ProcInfo0, ProcVarSet0),
>    proc_info_get_vartypes(ProcInfo0, ProcVarTypes0),
>
>    varset.select(ProcVarSet0, GoalVars0, ProgVarSet),
>    map.select(ProcVarTypes0, GoalVars0, ProcVarTypes),
>
>    proc_info_set_varset(ProgVarSet, ProcInfo0, ProcInfo1),
>    proc_info_set_goal(HldsGoal, ProcInfo1, ProcInfo2),
>    proc_info_set_vartypes(ProcVarTypes, ProcInfo2, ProcInfo),
>    !:NewPredInfo = !.NewPredInfo ^ new_pred_proc_info := ProcInfo.
>
>
>    % Returns the pred_proc_id of the new predicate.
>    %
> :- pred get_pred_proc_id(stm_new_pred_info::in, pred_proc_id::out) is det.
>
> get_pred_proc_id(NewPredInfo0, PredProcId) :-
>    PredId = NewPredInfo0 ^ new_pred_pred_id,
>    ProcId = NewPredInfo0 ^ new_pred_proc_id,
>    PredProcId = proc(PredId, ProcId).
>
> %-----------------------------------------------------------------------------%
> %
> % Miscellaneous predicates.
> %
>
>    % Increments the stm expand id
>    %
> :- pred increment_stm_expand_id(stm_info::in, stm_info::out) is det.
>
> increment_stm_expand_id(!StmInfo) :-
>    ExpandId0 = !.StmInfo ^ stm_info_expand_id,
>    ExpandId = ExpandId0 + 1,
>    !:StmInfo = !.StmInfo ^ stm_info_expand_id := ExpandId.
>
>
> %-----------------------------------------------------------------------------%
> %
> % Predicates related to the goal variables.
> %
>
>
>    % Get the list of input and output variables of the original atomic goal.
>    %
> :- pred get_input_output_varlist(stm_goal_vars::in, list(prog_var)::out,
>    list(prog_var)::out) is det.
>
> get_input_output_varlist(StmGoalVars, Input, Output) :-
>    InputSet = StmGoalVars ^ vars_input,
>    OutputSet = StmGoalVars ^ vars_output,
>
>    Input = set.to_sorted_list(InputSet),
>    Output = set.to_sorted_list(OutputSet).
>
>
>    % Get the list of types corresponding to the input and output
>    % variables of the original atomic goal.
>    %
> :- pred get_input_output_types(stm_goal_vars::in, stm_info::in,
>    list(mer_type)::out, list(mer_type)::out) is det.
>
> get_input_output_types(StmGoalVars, StmInfo, InputTypes, OutputTypes) :-
>    ProcInfo0 = StmInfo ^ stm_info_proc_info,
>    proc_info_get_vartypes(ProcInfo0, VarTypes),
>    get_input_output_varlist(StmGoalVars, InputVars, OutputVars),
>
>    list.map(map.lookup(VarTypes), InputVars, InputTypes),
>    list.map(map.lookup(VarTypes), OutputVars, OutputTypes).
>
>
>    % Used by "get_input_output_modes".
>    %
> :- pred set_list_val(X::in, Y::in, X::out) is det.
> set_list_val(X, _, X).
>
>
>    % Get the list of modes corresponding to the input and output
>    % variables of the original atomic goal.  Input variables will have
>    % the mode "in" while output variables will have the mode "out".
>    %
> :- pred get_input_output_modes(stm_goal_vars::in, list(mer_mode)::out,
>    list(mer_mode)::out) is det.
>
> get_input_output_modes(StmGoalVars, InputModes, OutputModes) :-
>    get_input_output_varlist(StmGoalVars, InputVars, OutputVars),
>    list.map(set_list_val(mer_mode_in), InputVars, InputModes),
>    list.map(set_list_val(mer_mode_out), OutputVars, OutputModes).
>
> %-----------------------------------------------------------------------------%
> %
> % Constants of modules, types and functors that are useful in this source to
> % source transformation.
> %
>
>    % Module names
>    %
> :- func module_stm_sym_name = sym_name.
> :- func module_exception_sym_name = sym_name.
> :- func module_univ_sym_name = sym_name.
> :- func module_builtin_sym_name = sym_name.
> :- func module_io_sym_name = sym_name.
>
>    % Special (dummy) predicate names
>    %
> :- func stm_inner_outer = sym_name.
> :- func stm_outer_inner = sym_name.
>
>    % Types
>    %
> :- func stm_state_type = mer_type.
> :- func stm_valid_result_type = mer_type.
> :- func stm_rollback_exception_type = mer_type.
> :- func stm_dummy_output_type = mer_type.
> :- func stm_univ_type = mer_type.
> :- func stm_io_type = mer_type.
> :- func stm_exception_result_type(mer_type) = mer_type.
>
>    % Function symbols (ie: cons_id)
>    %
> :- func stm_validres_valid_functor = cons_id.
> :- func stm_validres_invalid_functor = cons_id.
> :- func stm_rollback_exception_functor = cons_id.
> :- func stm_rollback_retry_functor = cons_id.
> :- func stm_dummy_output_functor = cons_id.
> :- func stm_exceptres_success_functor = cons_id.
> :- func stm_exceptres_exception_functor = cons_id.
>
>    % Modes
>    %
> :- func mer_mode_in = mer_mode.
> :- func mer_mode_out = mer_mode.
> :- func mer_mode_di = mer_mode.
> :- func mer_mode_uo = mer_mode.
>
> module_stm_sym_name = mercury_stm_builtin_module.
> module_builtin_sym_name = mercury_public_builtin_module.
> module_exception_sym_name = unqualified("exception").
> module_univ_sym_name = unqualified("univ").
> module_io_sym_name = unqualified("io").

Wrap those last three in calls to mercury_std_lib_module_name/1.

Once the above points have been addressed I am happy for you to commit
this as is; the changes shouldn't affect anybody else.

Please bootcheck this in at least the following grades *before*
committing: asm_fast.gc, hlc.gc, hlc.gc.par.

Cheers,
Julien.



--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to:       mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions:          mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------



More information about the reviews mailing list