[m-rev.] for review: software transactional memory
Zoltan Somogyi
zs at csse.unimelb.edu.au
Mon Feb 25 17:33:48 AEDT 2008
For review by Julien.
Zoltan.
Provide compiler support for Software Transactional Memory through the new
atomic goal. This work was done by Leon Mika; I merely brought it up to date,
resolved conflicts, and cleaned up a few things. There are still several
aspects that are as yet incomplete.
library/ops.m:
Add the operators needed for the syntax of atomic scopes.
library/stm_builtin.m:
Add the builtin operations needed for the implementation of atomic
goals.
compiler/hlds_goal.m:
Add a new HLDS goal type, which represents an atomic goal and its
possible fallbacks (in case an earlier goal throws an exception).
Rename the predicate goal_is_atomic as goal_expr_has_subgoals,
since now its old name would be misleading.
compiler/prog_data.m:
compiler/prog_item.m:
Add a parse tree representation of the new kind of goal.
compiler/prog_io_goal.m:
Parse the new kind of goal.
compiler/add_clause.m:
Translate atomic goals from parse tree form to HLDS.
compiler/typecheck.m:
compiler/typecheck_errors.m:
Do type checking of atomic goals.
compiler/modes.m:
Do mode checking of atomic goals, and determine whether they are nested
or not.
compiler/unique_modes.m:
Do unique mode checking of atomic goals.
compiler/stm_expand.m:
New module to expand atomic goals into sequences of simpler goals.
library/stm_builtin.m:
Add the primitives needed by the transformation.
Improve the existing debugging support.
mdbcomp/prim_data.m:
Add utility functions to allow stm_expand.m to refer to modules in the
library.
mdbcomp/program_representation.m:
Expand the goal_path type to allow the representation of components of
atomic goals.
compiler/notes/compiler_design.html:
Document the new module.
compiler/transform_hlds.m:
Include the new module in the compiler.
compiler/mercury_compile.m:
Invoke the STM transformation.
compiler/hlds_module.m:
Add an auxiliary counter used by the STM transformation.
compiler/hlds_pred.m:
Add a new predicate origin: the STM transformation.
compiler/modules.m:
Import the STM builtin module automatically if the module contains any
atomic goals.
compiler/assertion.m:
compiler/bytecode_gen.m:
compiler/clause_to_proc.m:
compiler/code_gen.m:
compiler/code_info.m:
compiler/code_util.m:
compiler/constraint.m:
compiler/cse_detection.m:
compiler/deep_profiling.m:
compiler/code_util.m:
compiler/delay_construct.m:
compiler/delay_partial_inst.m:
compiler/dep_par_conj.m:
compiler/dependency_graph.m:
compiler/det_analysis.m:
compiler/det_report.m:
compiler/distance_granularity.m:
compiler/equiv_type_hlds.m:
compiler/erl_code_gen.m:
compiler/exception_analysis.m:
compiler/follow_code.m:
compiler/format_call.m:
compiler/goal_form.m:
compiler/goal_path.m:
compiler/goal_util.m:
compiler/granularity.m:
compiler/hlds_out.m:
compiler/implicit_parallelism.m:
compiler/inlining.m:
compiler/intermod.m:
compiler/lambda.m:
compiler/layout_out.m:
compiler/lco.m:
compiler/lookup_switch.m:
compiler/make_hlds_warn.m:
compiler/mark_static_terms.m:
compiler/mercury_to_mercury.m:
compiler/middle_rec.m:
compiler/ml_code_gen.m:
compiler/mode_constraint_robdd.m:
compiler/mode_constraints.m:
compiler/mode_errors.m:
compiler/mode_info.m:
compiler/mode_util.m:
compiler/ordering_mode_constraints.m:
compiler/pd_cost.m:
compiler/pd_util.m:
compiler/polymorphism.m:
compiler/post_typecheck.m:
compiler/prog_rep.m:
compiler/prog_type.m:
compiler/prop_mode_constraints.m:
compiler/rbmm.actual_region_arguments.m:
compiler/rbmm.add_rbmm_goal_info.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/simplify.m:
compiler/size_prog.m:
compiler/smm_common.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.lfu.m:
compiler/structure_reuse.versions.m:
compiler/structure_sharing.analysis.m:
compiler/switch_detection.m:
compiler/unused_imports.m:
compiler/granularity.m:
compiler/granularity.m:
Conform to the changes above. Mostly this means handling the new
kind of goal.
compiler/add_heap_ops.m:
compiler/add_trail_ops.m:
compiler/build_mode_constraints.m:
compiler/closure_analysis.m:
compiler/dead_proc_elim.m:
compiler/deforest.m:
compiler/follow_vars.m:
compiler/higher_order.m:
compiler/live_vars.m:
compiler/liveness.m:
compiler/loop_inv.m:
compiler/module_qual.m:
compiler/prog_util.m:
compiler/purity.m:
compiler/quantification.m:
compiler/store_alloc.m:
compiler/stratify.m:
compiler/tabling_analysis.m:
compiler/term_constr_build.m:
compiler/term_pass1.m:
compiler/term_traversal.m:
compiler/trailing_analysis.m:
Conform to the changes above. Mostly this means handling the new
kind of goal.
Switch syntax from clauses to disj.
runtime/mercury_stm.[ch]:
Implement the primitives needed by the STM transformation.
Add more debugging support to the existing primitives.
cvs diff: Diffing .
cvs diff: Diffing analysis
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/libatomic_ops-1.2
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/doc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/gcc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/hpc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/ibmc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/icc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/msftc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/sunc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/tests
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing boehm_gc/windows-untested
cvs diff: Diffing boehm_gc/windows-untested/vc60
cvs diff: Diffing boehm_gc/windows-untested/vc70
cvs diff: Diffing boehm_gc/windows-untested/vc71
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/add_clause.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_clause.m,v
retrieving revision 1.48
diff -u -b -r1.48 add_clause.m
--- compiler/add_clause.m 29 Jan 2008 01:49:12 -0000 1.48
+++ compiler/add_clause.m 25 Feb 2008 06:13:08 -0000
@@ -575,8 +575,8 @@
!.SInfo),
qual_info_get_var_types(!.QualInfo, VarTypes0),
- % The RTTI varmaps here are just a dummy value because the real ones
- % are not introduced until typechecking and polymorphism.
+ % The RTTI varmaps here are just a dummy value, because the real ones
+ % are not introduced until polymorphism.
rtti_varmaps_init(EmptyRttiVarmaps),
implicitly_quantify_clause_body(HeadVarList, Warnings, Goal0, Goal,
!VarSet, VarTypes0, VarTypes, EmptyRttiVarmaps, _),
@@ -679,6 +679,92 @@
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, MaybeOutputVars0,
+ MainGoal, OrElseGoals), Context, Renaming, HLDSGoal,
+ !:NumAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs) :-
+ (
+ Outer0 = atomic_state_var(OuterStateVar0),
+ rename_var(need_not_rename, Renaming, OuterStateVar0, OuterStateVar),
+ svar_start_outer_atomic_scope(Context, OuterStateVar, OuterDI, OuterUO,
+ OuterScopeInfo, !VarSet, !SInfo, !Specs),
+ MaybeOuterScopeInfo = yes(OuterScopeInfo),
+ Outer = atomic_interface_vars(OuterDI, OuterUO)
+ ;
+ Outer0 = atomic_var_pair(OuterDI0, OuterUO0),
+ rename_var(need_not_rename, Renaming, OuterDI0, OuterDI),
+ rename_var(need_not_rename, Renaming, OuterUO0, OuterUO),
+ Outer = atomic_interface_vars(OuterDI, OuterUO),
+ MaybeOuterScopeInfo = no
+ ),
+ (
+ Inner0 = atomic_state_var(InnerStateVar0),
+ rename_var(need_not_rename, Renaming, InnerStateVar0, InnerStateVar),
+ svar_start_inner_atomic_scope(Context, InnerStateVar, InnerScopeInfo,
+ !VarSet, !SInfo, !Specs),
+ MaybeInnerScopeInfo = yes(InnerScopeInfo)
+ ;
+ Inner0 = atomic_var_pair(_InnerDI0, _InnerUO0),
+ MaybeInnerScopeInfo = no
+ ),
+ BeforeDisjSInfo = !.SInfo,
+ transform_goal(MainGoal, Renaming, HLDSMainGoal0,
+ !:NumAdded, !VarSet, !ModuleInfo, !QualInfo, BeforeDisjSInfo, SInfo1,
+ !Specs),
+ MainDisjInfo = {HLDSMainGoal0, SInfo1},
+ transform_orelse_goals(OrElseGoals, Renaming, OrElseDisjInfos,
+ 0, OrElseNumAdded, !VarSet, !ModuleInfo, !QualInfo, BeforeDisjSInfo,
+ !Specs),
+ AllDisjInfos = [MainDisjInfo | OrElseDisjInfos],
+ svar_finish_disjunction(Context, !.VarSet, AllDisjInfos, HLDSGoals,
+ !:SInfo),
+ (
+ HLDSGoals = [HLDSMainGoal | HLDSOrElseGoals]
+ ;
+ HLDSGoals = [],
+ unexpected(this_file, "transform_goal_2: atomic HLDSGoals = []")
+ ),
+ (
+ Inner0 = atomic_state_var(_),
+ (
+ MaybeInnerScopeInfo = yes(InnerScopeInfo2),
+ svar_finish_inner_atomic_scope(Context, InnerScopeInfo2,
+ InnerDI, InnerUO, !VarSet, !SInfo, !Specs),
+ Inner = atomic_interface_vars(InnerDI, InnerUO)
+ ;
+ MaybeInnerScopeInfo = no,
+ unexpected(this_file, "transform_goal_2: MaybeFinishStateVar = no")
+ )
+ ;
+ Inner0 = atomic_var_pair(InnerDI0, InnerUO0),
+ rename_var(need_not_rename, Renaming, InnerDI0, InnerDI),
+ rename_var(need_not_rename, Renaming, InnerUO0, InnerUO),
+ Inner = atomic_interface_vars(InnerDI, InnerUO)
+ ),
+ (
+ MaybeOutputVars0 = no,
+ MaybeOutputVars = no
+ ;
+ MaybeOutputVars0 = yes(OutputVars0),
+ rename_var_list(need_not_rename, Renaming, OutputVars0, OutputVars),
+ MaybeOutputVars = yes(OutputVars)
+ ),
+ (
+ MaybeOuterScopeInfo = yes(OuterScopeInfo2),
+ svar_finish_outer_atomic_scope(OuterScopeInfo2, !SInfo)
+ ;
+ MaybeOuterScopeInfo = no
+ ),
+ !:NumAdded = !.NumAdded + 1 + OrElseNumAdded,
+ ShortHand = atomic_goal(unknown_atomic_goal_type, Outer, Inner,
+ MaybeOutputVars, HLDSMainGoal, HLDSOrElseGoals),
+ GoalExpr = shorthand(ShortHand),
+ goal_info_init(Context, GoalInfo),
+ HLDSGoal = hlds_goal(GoalExpr, GoalInfo),
+ trace [compiletime(flag("atomic_scope_syntax")), io(!IO)] (
+ io.write_string("atomic:\n", !IO),
+ write_goal(HLDSGoal, !.ModuleInfo, !.VarSet, yes, 0, "\n", !IO),
+ io.nl(!IO)
+ ).
transform_goal_2(
trace_expr(MaybeCompileTime, MaybeRunTime, MaybeIO, Mutables, Goal0),
Context, Renaming, hlds_goal(scope(Reason, Goal), GoalInfo), NumAdded,
@@ -1236,25 +1322,48 @@
% append Disj0, and return the result in Disj.
%
:- pred get_disj(goal::in, prog_var_renaming::in,
- hlds_goal_svar_infos::in, hlds_goal_svar_infos::out, int::in, int::out,
- prog_varset::in, prog_varset::out, module_info::in, module_info::out,
- qual_info::in, qual_info::out, svar_info::in,
- list(error_spec)::in, list(error_spec)::out) is det.
+ list(hlds_goal_svar_info)::in, list(hlds_goal_svar_info)::out,
+ int::in, int::out, prog_varset::in, prog_varset::out,
+ module_info::in, module_info::out, qual_info::in, qual_info::out,
+ svar_info::in, list(error_spec)::in, list(error_spec)::out) is det.
-get_disj(Goal, Renaming, Disj0, Disj, !NumAdded, !VarSet, !ModuleInfo,
- !QualInfo, SInfo, !Specs) :-
+get_disj(Goal, Renaming, DisjInfos0, DisjInfos, !NumAdded, !VarSet,
+ !ModuleInfo, !QualInfo, SInfo0, !Specs) :-
( Goal = disj_expr(A, B) - _Context ->
- get_disj(B, Renaming, Disj0, Disj1, !NumAdded, !VarSet, !ModuleInfo,
- !QualInfo, SInfo, !Specs),
- get_disj(A, Renaming, Disj1, Disj, !NumAdded, !VarSet, !ModuleInfo,
- !QualInfo, SInfo, !Specs)
+ % We recurse on the *second* arm first, so that we will put the
+ % disjuncts from *that* arm at the front of DisjInfos0, before
+ % putting the disjuncts from the first arm at the front of the
+ % resulting DisjInfos1. This way, the overall result, DisjInfos,
+ % will have the disjuncts and their svar_infos in the correct order.
+ get_disj(B, Renaming, DisjInfos0, DisjInfos1, !NumAdded, !VarSet,
+ !ModuleInfo, !QualInfo, SInfo0, !Specs),
+ get_disj(A, Renaming, DisjInfos1, DisjInfos, !NumAdded, !VarSet,
+ !ModuleInfo, !QualInfo, SInfo0, !Specs)
;
- transform_goal(Goal, Renaming, Goal1, GoalAdded, !VarSet, !ModuleInfo,
- !QualInfo, SInfo, SInfo1, !Specs),
+ transform_goal(Goal, Renaming, HLDSGoal, GoalAdded, !VarSet,
+ !ModuleInfo, !QualInfo, SInfo0, SInfo1, !Specs),
!:NumAdded = !.NumAdded + GoalAdded,
- Disj = [{Goal1, SInfo1} | Disj0]
+ DisjInfo = {HLDSGoal, SInfo1},
+ DisjInfos = [DisjInfo | DisjInfos0]
).
+:- pred transform_orelse_goals(goals::in, prog_var_renaming::in,
+ list(hlds_goal_svar_info)::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,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+transform_orelse_goals([], _, [],
+ !NumAdded, !VarSet, !ModuleInfo, !QualInfo, _SInfo0, !Specs).
+transform_orelse_goals([Goal | Goals], Renaming, [DisjInfo | DisjInfos],
+ !NumAdded, !VarSet, !ModuleInfo, !QualInfo, SInfo0, !Specs) :-
+ transform_goal(Goal, Renaming, HLDSGoal, NumAddedGoal,
+ !VarSet, !ModuleInfo, !QualInfo, SInfo0, SInfo1, !Specs),
+ DisjInfo = {HLDSGoal, SInfo1},
+ !:NumAdded = !.NumAdded + NumAddedGoal,
+ transform_orelse_goals(Goals, Renaming, DisjInfos,
+ !NumAdded, !VarSet, !ModuleInfo, !QualInfo, SInfo0, !Specs).
+
%----------------------------------------------------------------------------%
:- func this_file = string.
Index: compiler/assertion.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/assertion.m,v
retrieving revision 1.60
diff -u -b -r1.60 assertion.m
--- compiler/assertion.m 22 Jan 2008 15:06:08 -0000 1.60
+++ compiler/assertion.m 25 Jan 2008 05:52:09 -0000
@@ -704,22 +704,22 @@
normalise_goal(Else0, Else),
GoalExpr = if_then_else(Vars, Cond, Then, Else)
;
- GoalExpr0 = shorthand(ShortHandGoal0),
- normalise_goal_shorthand(ShortHandGoal0, ShortHandGoal),
- GoalExpr = shorthand(ShortHandGoal)
- ).
-
- % Place a shorthand goal into a standard form. Currently
- % all the code does is replace conj([G]) with G.
- %
-:- pred normalise_goal_shorthand(shorthand_goal_expr::in,
- shorthand_goal_expr::out) is det.
-
-normalise_goal_shorthand(ShortHand0, ShortHand) :-
+ GoalExpr0 = shorthand(ShortHand0),
+ (
+ ShortHand0 = atomic_goal(GoalType, Outer, Inner, Vars,
+ MainGoal0, OrElseAlternatives0),
+ normalise_goal(MainGoal0, MainGoal),
+ normalise_goals(OrElseAlternatives0, OrElseAlternatives),
+ ShortHand = atomic_goal(GoalType, Outer, Inner, Vars, MainGoal,
+ OrElseAlternatives)
+ ;
ShortHand0 = bi_implication(LHS0, RHS0),
normalise_goal(LHS0, LHS),
normalise_goal(RHS0, RHS),
- ShortHand = bi_implication(LHS, RHS).
+ ShortHand = bi_implication(LHS, RHS)
+ ),
+ GoalExpr = shorthand(ShortHand)
+ ).
%-----------------------------------------------------------------------------%
Index: compiler/build_mode_constraints.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/build_mode_constraints.m,v
retrieving revision 1.30
diff -u -b -r1.30 build_mode_constraints.m
--- compiler/build_mode_constraints.m 22 Jan 2008 15:06:08 -0000 1.30
+++ compiler/build_mode_constraints.m 27 Jan 2008 01:24:00 -0000
@@ -333,7 +333,14 @@
;
GoalExpr = call_foreign_proc(_, _, _, _, _, _, _)
;
- GoalExpr = shorthand(_ShorthandGoalExpr)
+ GoalExpr = shorthand(ShortHand),
+ (
+ ShortHand = atomic_goal(_, _, _, _, _, _),
+ sorry(this_file, "add_mc_vars_for_goal: NYI: atomic_goal")
+ ;
+ ShortHand = bi_implication(_, _),
+ unexpected(this_file, "add_mc_vars_for_goal: bi_implication")
+ )
).
%-----------------------------------------------------------------------------%
@@ -412,9 +419,10 @@
nonlocals::in, mc_var_info::in, mc_var_info::out, mode_constraints::in,
mode_constraints::out) is det.
-add_goal_expr_constraints(ModuleInfo, ProgVarset, PredId,
- conj(ConjType, Goals), Context, GoalPath, Nonlocals, !VarInfo,
- !Constraints) :-
+add_goal_expr_constraints(ModuleInfo, ProgVarset, PredId, GoalExpr,
+ Context, GoalPath, Nonlocals, !VarInfo, !Constraints) :-
+ (
+ GoalExpr = conj(ConjType, Goals),
(
ConjType = plain_conj,
list.foldl(
@@ -422,7 +430,6 @@
Nonlocals),
Goals, conj_constraints_info_init, ConjConstraintsInfo),
VarMap = rep_var_map(!.VarInfo),
-
list.foldl2(add_goal_constraints(ModuleInfo, ProgVarset, PredId),
Goals, !VarInfo, !Constraints),
map.foldl(add_local_var_conj_constraints(Context),
@@ -434,13 +441,12 @@
ConjType = parallel_conj,
% XXX Need to do something here.
sorry(this_file, "par_conj")
- ).
-
-add_goal_expr_constraints(ModuleInfo, ProgVarset, CallerPredId, GoalExpr,
- Context, GoalPath, _Nonlocals, !VarInfo, !Constraints) :-
+ )
+ ;
GoalExpr = plain_call(CalleePredId, _, Args, _, _, _),
module_info_pred_info(ModuleInfo, CalleePredId, CalleePredInfo),
-
+ % The predicate we are in now is the caller.
+ CallerPredId = PredId,
( pred_info_infer_modes(CalleePredInfo) ->
% No modes declared so just constrain the hearvars
pred_info_get_clauses_info(CalleePredInfo, CalleeClausesInfo),
@@ -453,15 +459,14 @@
% At least one declared mode
pred_info_get_procedures(CalleePredInfo, CalleeProcTable),
map.values(CalleeProcTable, CalleeProcInfos),
- list.map(proc_info_get_argmodes, CalleeProcInfos, CalleeArgModeDecls),
+ list.map(proc_info_get_argmodes, CalleeProcInfos,
+ CalleeArgModeDecls),
add_call_mode_decls_constraints(ModuleInfo, ProgVarset, Context,
CallerPredId, CalleeArgModeDecls, GoalPath, Args, !VarInfo,
!Constraints)
- ).
-
-add_goal_expr_constraints(_ModuleInfo, _ProgVarset, _PredId,
- generic_call(Details, _, _, _), _Context, _GoalPath,
- _Nonlocals, !VarInfo, !Constraints) :-
+ )
+ ;
+ GoalExpr = generic_call(Details, _, _, _),
% XXX Need to do something here.
(
% XXX Need to do something here.
@@ -472,22 +477,19 @@
Details = class_method(_, _, _, _),
sorry(this_file, "class_method generic_call")
;
- % XXX We need to impose the constraint that all the argument variables
- % are bound elsewhere.
+ % XXX We need to impose the constraint that all the argument
+ % variables are bound elsewhere.
Details = event_call(_),
sorry(this_file, "event_call generic_call")
;
% No mode constraints
Details = cast(_)
- ).
-
-add_goal_expr_constraints(_ModuleInfo, _ProgVarset, _PredId,
- switch(_, _, _), _Context, _GoalPath, _Nonlocals, _, _, _, _) :-
- unexpected(this_file, "switch").
-
-add_goal_expr_constraints(_ModuleInfo, ProgVarset, PredId,
- unify(LHSvar, RHS, _Mode, _Kind, _UnifyContext),
- GoalContext, GoalPath, _Nonlocals, !VarInfo, !Constraints) :-
+ )
+ ;
+ GoalExpr = switch(_, _, _),
+ unexpected(this_file, "switch")
+ ;
+ GoalExpr = unify(LHSvar, RHS, _Mode, _Kind, _UnifyContext),
prog_var_at_path(ProgVarset, PredId, LHSvar, GoalPath,
LHSvarProducedHere, !VarInfo),
(
@@ -497,25 +499,25 @@
% is produced at the unification.
prog_var_at_path(ProgVarset, PredId, RHSvar, GoalPath,
RHSvarProducedHere, !VarInfo),
- not_both(GoalContext, LHSvarProducedHere, RHSvarProducedHere,
+ not_both(Context, LHSvarProducedHere, RHSvarProducedHere,
!Constraints)
;
RHS = rhs_functor(_Functor, _IsExistConstr, Args),
- prog_vars_at_path(ProgVarset, PredId, Args, GoalPath, ArgsProducedHere,
- !VarInfo),
+ prog_vars_at_path(ProgVarset, PredId, Args, GoalPath,
+ ArgsProducedHere, !VarInfo),
(
ArgsProducedHere = [OneArgProducedHere, _Two| _],
% Goal: LHSvar = functor(Args)
% (a): If one arg is produced here, then they all are.
% (b): At most one side of the unification is produced.
- equivalent(GoalContext, ArgsProducedHere, !Constraints),
- not_both(GoalContext, LHSvarProducedHere, OneArgProducedHere,
+ equivalent(Context, ArgsProducedHere, !Constraints),
+ not_both(Context, LHSvarProducedHere, OneArgProducedHere,
!Constraints)
;
ArgsProducedHere = [OneArgProducedHere],
% Goal: LHSvar = functor(Arg)
% At most one side of the unification is produced.
- not_both(GoalContext, LHSvarProducedHere, OneArgProducedHere,
+ not_both(Context, LHSvarProducedHere, OneArgProducedHere,
!Constraints)
;
ArgsProducedHere = []
@@ -526,14 +528,12 @@
;
RHS = rhs_lambda_goal(_, _, _, _, _, _, _, _, _),
sorry(this_file, "unify with lambda goal")
- ).
-
-add_goal_expr_constraints(ModuleInfo, ProgVarset, PredId,
- disj(Goals), Context, GoalPath, Nonlocals, !VarInfo, !Constraints) :-
+ )
+ ;
+ GoalExpr = disj(Goals),
nonlocals_at_path_and_subpaths(ProgVarset, PredId, GoalPath,
DisjunctGoalPaths, Nonlocals, NonlocalsHere, NonlocalsAtDisjuncts,
!VarInfo),
-
GoalInfos = list.map(get_hlds_goal_info, Goals),
DisjunctGoalPaths = list.map(goal_info_get_goal_path, GoalInfos),
@@ -545,18 +545,18 @@
% it must be able to be bound at any.
EquivVarss = list.map_corresponding(list.cons, NonlocalsHere,
NonlocalsAtDisjuncts),
- list.foldl(equivalent(Context), EquivVarss, !Constraints).
-
-add_goal_expr_constraints(ModuleInfo, ProgVarset, PredId,
- negation(Goal), Context, GoalPath, Nonlocals, !VarInfo,
- !Constraints) :-
+ list.foldl(equivalent(Context), EquivVarss, !Constraints)
+ ;
+ GoalExpr = negation(Goal),
Goal = hlds_goal(_, NegatedGoalInfo),
NegatedGoalPath = goal_info_get_goal_path(NegatedGoalInfo),
VarMap = rep_var_map(!.VarInfo),
- NonlocalsAtPath = set.fold(cons_prog_var_at_path(VarMap, PredId, GoalPath),
+ NonlocalsAtPath = set.fold(
+ cons_prog_var_at_path(VarMap, PredId, GoalPath),
Nonlocals, []),
- NonlocalsConstraintVars = set.fold(cons_prog_var_at_path(VarMap, PredId,
- NegatedGoalPath), Nonlocals, NonlocalsAtPath),
+ NonlocalsConstraintVars = set.fold(
+ cons_prog_var_at_path(VarMap, PredId, NegatedGoalPath),
+ Nonlocals, NonlocalsAtPath),
add_goal_constraints(ModuleInfo, ProgVarset, PredId, Goal, !VarInfo,
!Constraints),
@@ -564,11 +564,9 @@
% The variables non-local to the negation are not to be produced
% at the negation or any deeper, so we constrain their mode constraint
% variables for these positions to `no'.
- list.foldl(equiv_no(Context), NonlocalsConstraintVars, !Constraints).
-
-add_goal_expr_constraints(ModuleInfo, ProgVarset, PredId,
- scope(_Reason, Goal), Context, GoalPath, Nonlocals, !VarInfo,
- !Constraints) :-
+ list.foldl(equiv_no(Context), NonlocalsConstraintVars, !Constraints)
+ ;
+ GoalExpr = scope(_Reason, Goal),
Goal = hlds_goal(_, SomeGoalInfo),
SomeGoalPath = goal_info_get_goal_path(SomeGoalInfo),
@@ -587,11 +585,9 @@
list.foldl(equivalent(Context), EquivVarss, !Constraints),
add_goal_constraints(ModuleInfo, ProgVarset, PredId, Goal, !VarInfo,
- !Constraints).
-
-add_goal_expr_constraints(ModuleInfo, ProgVarset, PredId,
- if_then_else(ExistVars, Cond, Then, Else),
- Context, GoalPath, Nonlocals, !VarInfo, !Constraints) :-
+ !Constraints)
+ ;
+ GoalExpr = if_then_else(ExistVars, Cond, Then, Else),
Cond = hlds_goal(_, CondInfo),
Then = hlds_goal(_, ThenInfo),
Else = hlds_goal(_, ElseInfo),
@@ -615,7 +611,8 @@
CondNonlocals = goal_info_get_nonlocals(CondInfo),
ThenNonlocals = goal_info_get_nonlocals(ThenInfo),
list.filter(set.contains(CondNonlocals), ExistVars, NonlocalToCond),
- list.filter(set.contains(ThenNonlocals), NonlocalToCond, LocalAndShared),
+ list.filter(set.contains(ThenNonlocals), NonlocalToCond,
+ LocalAndShared),
prog_vars_at_path(ProgVarset, PredId, LocalAndShared, CondPath,
LocalAndSharedAtCond, !VarInfo),
prog_vars_at_path(ProgVarset, PredId, LocalAndShared, ThenPath,
@@ -644,29 +641,40 @@
% simply constrain LocalAtCond = yes and LocalAtThen = no.
% Instead we constrain exactly one of them to be yes.
list.foldl_corresponding(xor(Context), LocalAndSharedAtCond,
- LocalAndSharedAtThen, !Constraints).
-
-add_goal_expr_constraints(ModuleInfo, ProgVarset, PredId,
- call_foreign_proc(_, CalledPred, ProcId, ForeignArgs, _, _, _),
- Context, GoalPath, _Nonlocals, !VarInfo, !Constraints) :-
+ LocalAndSharedAtThen, !Constraints)
+ ;
+ GoalExpr = call_foreign_proc(_, CalledPred, ProcId, ForeignArgs,
+ _, _, _),
CallArgs = list.map(foreign_arg_var, ForeignArgs),
module_info_pred_proc_info(ModuleInfo, CalledPred, ProcId, _, ProcInfo),
( proc_info_get_maybe_declared_argmodes(ProcInfo, yes(_OrigDecl)) ->
proc_info_get_argmodes(ProcInfo, Decl),
- % This pred should strip the disj(conj()) for the single declaration.
+ % This pred should strip the disj(conj()) for the single
+ % declaration.
add_call_mode_decls_constraints(ModuleInfo, ProgVarset, Context,
PredId, [Decl], GoalPath, CallArgs, !VarInfo, !Constraints)
;
unexpected(this_file, "no mode declaration for foreign proc")
+ )
+ ;
+ GoalExpr = shorthand(Shorthand),
+ (
+ Shorthand = atomic_goal(_, _, _, _, _, _),
+ % Should record that
+ % - OuterDI is definitely not produced inside this goal
+ % - InnerDI is definitely produced by this goal
+ % - InnerUO should definitely be produced inside this goal,
+ % by the main goal and each orelse goal
+ % - OuterUO is definitely produced by this goal
+ sorry(this_file, "NYI: atomic_goal")
+ ;
+ Shorthand = bi_implication(_, _),
+ % These should have been expanded out by now.
+ unexpected(this_file, "shorthand goal")
+ )
).
-add_goal_expr_constraints(_ModuleInfo, _ProgVarset, _PredId,
- shorthand(_ShorthandGoalExpr), _Context, _GoalPath, _Nonlocals,
- _, _, _, _) :-
- % Shorthand goals should not exist at this point in compilation.
- unexpected(this_file, "shorthand goal").
-
%-----------------------------------------------------------------------------%
mode_decls_constraints(ModuleInfo, VarMap, PredId, Decls, HeadVarsList,
Index: compiler/bytecode_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/bytecode_gen.m,v
retrieving revision 1.118
diff -u -b -r1.118 bytecode_gen.m
--- compiler/bytecode_gen.m 11 Feb 2008 21:25:50 -0000 1.118
+++ compiler/bytecode_gen.m 12 Feb 2008 01:22:16 -0000
@@ -317,7 +317,7 @@
Code = node([byte_not_supported])
;
GoalExpr = shorthand(_),
- % these should have been expanded out by now
+ % These should have been expanded out by now.
unexpected(this_file, "goal_expr: unexpected shorthand")
).
Index: compiler/clause_to_proc.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/clause_to_proc.m,v
retrieving revision 1.81
diff -u -b -r1.81 clause_to_proc.m
Index: compiler/closure_analysis.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/closure_analysis.m,v
retrieving revision 1.16
diff -u -b -r1.16 closure_analysis.m
--- compiler/closure_analysis.m 30 Dec 2007 08:23:32 -0000 1.16
+++ compiler/closure_analysis.m 6 Jan 2008 09:46:41 -0000
@@ -369,6 +369,7 @@
list.filter_map(ForeignHOArgs, Args, OutputForeignHOArgs),
svmap.det_insert_from_assoc_list(OutputForeignHOArgs, !ClosureInfo),
Goal = hlds_goal(GoalExpr, GoalInfo).
+
process_goal(_, _, hlds_goal(shorthand(_), _), _, _, _) :-
unexpected(this_file, "shorthand/1 goal during closure analysis.").
Index: compiler/code_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/code_gen.m,v
retrieving revision 1.175
diff -u -b -r1.175 code_gen.m
--- compiler/code_gen.m 26 Nov 2007 05:13:17 -0000 1.175
+++ compiler/code_gen.m 6 Jan 2008 10:32:03 -0000
@@ -74,12 +74,8 @@
get_forward_live_vars(!.CI, ForwardLiveVarsBeforeGoal),
% Make any changes to liveness before Goal.
- ( goal_is_atomic(GoalExpr) ->
- IsAtomic = yes
- ;
- IsAtomic = no
- ),
- pre_goal_update(GoalInfo, IsAtomic, !CI),
+ HasSubGoals = goal_expr_has_subgoals(GoalExpr),
+ pre_goal_update(GoalInfo, HasSubGoals, !CI),
get_instmap(!.CI, InstMap),
( instmap.is_reachable(InstMap) ->
CodeModel = goal_info_get_code_model(GoalInfo),
Index: compiler/code_info.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/code_info.m,v
retrieving revision 1.360
diff -u -b -r1.360 code_info.m
--- compiler/code_info.m 11 Feb 2008 21:25:50 -0000 1.360
+++ compiler/code_info.m 12 Feb 2008 01:22:16 -0000
@@ -689,11 +689,11 @@
:- pred set_follow_vars(abs_follow_vars::in,
code_info::in, code_info::out) is det.
- % pre_goal_update(GoalInfo, Atomic, OldCodeInfo, NewCodeInfo)
+ % pre_goal_update(GoalInfo, HasSubGoal, OldCodeInfo, NewCodeInfo)
% updates OldCodeInfo to produce NewCodeInfo with the changes
% specified by GoalInfo.
%
-:- pred pre_goal_update(hlds_goal_info::in, bool::in,
+:- pred pre_goal_update(hlds_goal_info::in, has_subgoals::in,
code_info::in, code_info::out) is det.
% post_goal_update(GoalInfo, OldCodeInfo, NewCodeInfo)
@@ -842,7 +842,7 @@
%-----------------------------------------------------------------------------%
-pre_goal_update(GoalInfo, Atomic, !CI) :-
+pre_goal_update(GoalInfo, HasSubGoals, !CI) :-
% The liveness pass puts resume_point annotations on some kinds
% of goals. The parts of the code generator that handle those kinds
% of goals should handle the resume point annotation as well;
@@ -869,11 +869,11 @@
goal_info_get_pre_births(GoalInfo, PreBirths),
add_forward_live_vars(PreBirths, !CI),
(
- Atomic = yes,
+ HasSubGoals = does_not_have_subgoals,
goal_info_get_post_deaths(GoalInfo, PostDeaths),
rem_forward_live_vars(PostDeaths, !CI)
;
- Atomic = no
+ HasSubGoals = has_subgoals
).
post_goal_update(GoalInfo, !CI) :-
@@ -1967,7 +1967,7 @@
ResumePoint = orig_only(ResumeMap, do_redo),
effect_resume_point(ResumePoint, model_semi, Code, !CI),
expect(unify(Code, empty), this_file, "nonempty code for simple neg"),
- pre_goal_update(GoalInfo, yes, !CI).
+ pre_goal_update(GoalInfo, does_not_have_subgoals, !CI).
leave_simple_neg(GoalInfo, FailInfo, !CI) :-
post_goal_update(GoalInfo, !CI),
Index: compiler/code_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/code_util.m,v
retrieving revision 1.182
diff -u -b -r1.182 code_util.m
--- compiler/code_util.m 30 Dec 2007 08:23:33 -0000 1.182
+++ compiler/code_util.m 6 Jan 2008 10:33:39 -0000
@@ -256,18 +256,9 @@
;
goal_may_alloc_temp_frame(E, May)
).
-goal_may_alloc_temp_frame_2(shorthand(ShorthandGoal), May) :-
- goal_may_alloc_temp_frame_2_shorthand(ShorthandGoal,May).
-
-:- pred goal_may_alloc_temp_frame_2_shorthand(shorthand_goal_expr::in,
- bool::out) is det.
-
-goal_may_alloc_temp_frame_2_shorthand(bi_implication(G1, G2), May) :-
- ( goal_may_alloc_temp_frame(G1, yes) ->
- May = yes
- ;
- goal_may_alloc_temp_frame(G2, May)
- ).
+goal_may_alloc_temp_frame_2(shorthand(_), _) :-
+ % These should have been expanded out by now.
+ unexpected(this_file, "goal_may_alloc_temp_frame_2: shorthand").
:- pred goal_list_may_alloc_temp_frame(list(hlds_goal)::in, bool::out) is det.
Index: compiler/constraint.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/constraint.m,v
retrieving revision 1.90
diff -u -b -r1.90 constraint.m
--- compiler/constraint.m 21 Feb 2008 04:22:40 -0000 1.90
+++ compiler/constraint.m 22 Feb 2008 02:14:33 -0000
@@ -104,9 +104,11 @@
propagate_conj_sub_goal(Goal0, Constraints, Goals, !Info) :-
Goal0 = hlds_goal(GoalExpr0, _),
- ( goal_is_atomic(GoalExpr0) ->
- true
+ HasSubGoals = goal_expr_has_subgoals(GoalExpr0),
+ (
+ HasSubGoals = does_not_have_subgoals
;
+ HasSubGoals = has_subgoals,
% If a non-empty list of constraints is pushed into a sub-goal,
% quantification, instmap_deltas and determinism need to be
% recomputed.
@@ -710,8 +712,9 @@
goal_is_simple(Goal) :-
Goal = hlds_goal(GoalExpr, _),
+ % XXX This code should be replaced with an explicit switch.
(
- goal_is_atomic(GoalExpr)
+ goal_expr_has_subgoals(GoalExpr) = does_not_have_subgoals
;
( GoalExpr = scope(_, SubGoal)
; GoalExpr = negation(SubGoal)
Index: compiler/cse_detection.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/cse_detection.m,v
retrieving revision 1.116
diff -u -b -r1.116 cse_detection.m
--- compiler/cse_detection.m 29 Jan 2008 04:59:37 -0000 1.116
+++ compiler/cse_detection.m 29 Jan 2008 05:00:20 -0000
@@ -318,9 +318,22 @@
detect_cse_in_ite(NonLocalsList, Vars, Cond0, Then0, Else0, GoalInfo,
InstMap0, !CseInfo, Redo, GoalExpr)
;
- GoalExpr0 = shorthand(_),
+ GoalExpr0 = shorthand(ShortHand0),
+ (
+ ShortHand0 = atomic_goal(AtomicGoalType, Outer, Inner,
+ MaybeOutputVars, MainGoal0, OrElseGoals0),
+ detect_cse_in_goal(MainGoal0, MainGoal, !CseInfo, InstMap0, Redo1),
+ detect_cse_in_independent_goals(OrElseGoals0, OrElseGoals,
+ !CseInfo, InstMap0, Redo2),
+ ShortHand = atomic_goal(AtomicGoalType, Outer, Inner,
+ MaybeOutputVars, MainGoal, OrElseGoals),
+ bool.or(Redo1, Redo2, Redo)
+ ;
+ ShortHand0 = bi_implication(_, _),
% These should have been expanded out by now.
- unexpected(this_file, "detect_cse_in_goal_expr: unexpected shorthand")
+ unexpected(this_file, "detect_cse_in_goal_expr: bi_implication")
+ ),
+ GoalExpr = shorthand(ShortHand)
).
%-----------------------------------------------------------------------------%
@@ -357,7 +370,7 @@
cse_info::out, bool::out, hlds_goal_expr::out) is det.
detect_cse_in_disj([], Goals0, _, InstMap, !CseInfo, Redo, disj(Goals)) :-
- detect_cse_in_disjuncts(Goals0, Goals, !CseInfo, InstMap, Redo).
+ detect_cse_in_independent_goals(Goals0, Goals, !CseInfo, InstMap, Redo).
detect_cse_in_disj([Var | Vars], Goals0, GoalInfo0, InstMap0,
!CseInfo, Redo, GoalExpr) :-
(
@@ -379,14 +392,15 @@
!CseInfo, Redo, GoalExpr)
).
-:- pred detect_cse_in_disjuncts(list(hlds_goal)::in, list(hlds_goal)::out,
+:- pred detect_cse_in_independent_goals(
+ list(hlds_goal)::in, list(hlds_goal)::out,
cse_info::in, cse_info::out, instmap::in, bool::out) is det.
-detect_cse_in_disjuncts([], [], !CseInfo, _, no).
-detect_cse_in_disjuncts([Goal0 | Goals0], [Goal | Goals], !CseInfo, InstMap0,
- Redo) :-
+detect_cse_in_independent_goals([], [], !CseInfo, _, no).
+detect_cse_in_independent_goals([Goal0 | Goals0], [Goal | Goals], !CseInfo,
+ InstMap0, Redo) :-
detect_cse_in_goal(Goal0, Goal, !CseInfo, InstMap0, Redo1),
- detect_cse_in_disjuncts(Goals0, Goals, !CseInfo, InstMap0, Redo2),
+ detect_cse_in_independent_goals(Goals0, Goals, !CseInfo, InstMap0, Redo2),
bool.or(Redo1, Redo2, Redo).
:- pred detect_cse_in_cases(list(prog_var)::in, prog_var::in, can_fail::in,
Index: compiler/deep_profiling.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/deep_profiling.m,v
retrieving revision 1.73
diff -u -b -r1.73 deep_profiling.m
--- compiler/deep_profiling.m 30 Dec 2007 08:23:34 -0000 1.73
+++ compiler/deep_profiling.m 6 Jan 2008 09:15:39 -0000
@@ -1037,8 +1037,8 @@
:- pred deep_prof_wrap_call(goal_path::in, hlds_goal::in, hlds_goal::out,
deep_info::in, deep_info::out) is det.
-deep_prof_wrap_call(GoalPath, hlds_goal(GoalExpr0, GoalInfo0),
- hlds_goal(GoalExpr, GoalInfo), !DeepInfo) :-
+deep_prof_wrap_call(GoalPath, Goal0, Goal, !DeepInfo) :-
+ Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
ModuleInfo = !.DeepInfo ^ deep_module_info,
GoalFeatures = goal_info_get_features(GoalInfo0),
goal_info_remove_feature(feature_tailcall, GoalInfo0, GoalInfo1),
@@ -1222,7 +1222,8 @@
)
;
GoalExpr = conj(plain_conj, [SiteNumVarGoal, PrepareGoal, Goal2])
- ).
+ ),
+ Goal = hlds_goal(GoalExpr, GoalInfo).
:- pred deep_prof_transform_higher_order_call(globals::in, code_model::in,
hlds_goal::in, hlds_goal::out, deep_info::in, deep_info::out) is det.
Index: compiler/deforest.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/deforest.m,v
retrieving revision 1.84
diff -u -b -r1.84 deforest.m
--- compiler/deforest.m 21 Feb 2008 04:22:40 -0000 1.84
+++ compiler/deforest.m 22 Feb 2008 02:14:33 -0000
@@ -228,8 +228,8 @@
proc_info_get_initial_instmap(!.ProcInfo, !.ModuleInfo, InstMap0),
proc_info_get_vartypes(!.ProcInfo, VarTypes),
proc_info_get_inst_varset(!.ProcInfo, InstVarSet),
- recompute_instmap_delta(yes, !Goal, VarTypes,
- InstVarSet, InstMap0, !ModuleInfo),
+ recompute_instmap_delta(recompute_atomic_instmap_deltas, !Goal,
+ VarTypes, InstVarSet, InstMap0, !ModuleInfo),
pd_info_set_module_info(!.ModuleInfo, !PDInfo),
pd_info_get_pred_info(!.PDInfo, !:PredInfo),
@@ -242,9 +242,8 @@
(
RerunDet = yes,
% If the determinism of some sub-goals has changed,
- % then we re-run determinism analysis. As with
- % inlining.m, this avoids problems with inlining
- % erroneous procedures.
+ % then we re-run determinism analysis. As with inlining.m,
+ % this avoids problems with inlining erroneous procedures.
det_infer_proc(PredId, ProcId, !ModuleInfo, _, _, _)
;
RerunDet = no
@@ -1999,7 +1998,7 @@
is_simple_goal(hlds_goal(GoalExpr, _)) :-
(
- goal_is_atomic(GoalExpr)
+ goal_expr_has_subgoals(GoalExpr) = does_not_have_subgoals
;
GoalExpr = negation(Goal1),
% Handle a call or builtin + tests on the output.
Index: compiler/delay_partial_inst.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/delay_partial_inst.m,v
retrieving revision 1.6
diff -u -b -r1.6 delay_partial_inst.m
--- compiler/delay_partial_inst.m 22 Jan 2008 15:06:08 -0000 1.6
+++ compiler/delay_partial_inst.m 25 Jan 2008 05:52:09 -0000
@@ -335,7 +335,6 @@
% Mark the procedure as changed.
!DelayInfo ^ dpi_changed := yes
-
else
(
% Tranform lambda goals as well. Non-local variables in
@@ -395,7 +394,6 @@
)
;
Unify = complicated_unify(_UniMode, CanFail, _TypeInfos),
- %
% Deal with tests generated for calls to implied modes.
%
% LHS := f(_),
@@ -408,7 +406,6 @@
%
% XXX I have not seen a case where the LHS and RHS are swapped
% but we should handle that if it comes up.
- %
(if
CanFail = can_fail,
RHS0 = rhs_var(RHSVar),
@@ -439,10 +436,26 @@
),
Goal = Goal0
;
- GoalExpr0 = shorthand(_),
+ GoalExpr0 = shorthand(ShortHand0),
+ (
+ ShortHand0 = atomic_goal(GoalType, Outer, Inner, MaybeOutputVars,
+ MainGoal0, OrElseGoals0),
+ % XXX Is it ok to ignore the updated ConstructMaps,
+ % and if yes, why? This should be documented.
+ delay_partial_inst_in_goal(InstMap0, MainGoal0, MainGoal,
+ !.ConstructMap, _, !DelayInfo),
+ delay_partial_inst_in_goals(InstMap0, OrElseGoals0, OrElseGoals,
+ !.ConstructMap, _, !DelayInfo),
+ ShortHand = atomic_goal(GoalType, Outer, Inner, MaybeOutputVars,
+ MainGoal, OrElseGoals),
+ GoalExpr = shorthand(ShortHand),
+ Goal = hlds_goal(GoalExpr, GoalInfo0)
+ ;
+ ShortHand0 = bi_implication(_, _),
% These should have been expanded out by now.
unexpected(this_file,
- "delay_partial_inst_in_goal: unexpected shorthand")
+ "delay_partial_inst_in_goal: bi_implication")
+ )
).
:- pred create_canonical_variables(prog_vars::in, prog_vars::out,
@@ -529,6 +542,8 @@
delay_partial_inst_in_goals(_, [], [], !ConstructMap, !DelayInfo).
delay_partial_inst_in_goals(InstMap0,
[Goal0 | Goals0], [Goal | Goals], !ConstructMap, !DelayInfo) :-
+ % XXX I think using the ConstructMap at the end of one disjunct
+ % at the start of the next disjunct is a bug. zs
delay_partial_inst_in_goal(InstMap0, Goal0, Goal, !ConstructMap,
!DelayInfo),
delay_partial_inst_in_goals(InstMap0, Goals0, Goals, !ConstructMap,
@@ -541,6 +556,8 @@
delay_partial_inst_in_cases(_, [], [], !ConstructMap, !DelayInfo).
delay_partial_inst_in_cases(InstMap0, [Case0 | Cases0], [Case | Cases],
!ConstructMap, !DelayInfo) :-
+ % XXX I think using the ConstructMap at the end of one case
+ % at the start of the next case is a bug. zs
Case0 = case(MainConsId, OtherConsIds, Goal0),
delay_partial_inst_in_goal(InstMap0, Goal0, Goal, !ConstructMap,
!DelayInfo),
Index: compiler/dep_par_conj.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/dep_par_conj.m,v
retrieving revision 1.24
diff -u -b -r1.24 dep_par_conj.m
--- compiler/dep_par_conj.m 30 Dec 2007 08:23:35 -0000 1.24
+++ compiler/dep_par_conj.m 6 Jan 2008 09:18:39 -0000
@@ -273,8 +273,8 @@
fixup_and_reinsert_proc(PredId, ProcId, !.PredInfo, !.ProcInfo, !ModuleInfo) :-
requantify_proc(!ProcInfo),
- RecomputeAtomic = no,
- recompute_instmap_delta_proc(RecomputeAtomic, !ProcInfo, !ModuleInfo),
+ recompute_instmap_delta_proc(do_not_recompute_atomic_instmap_deltas,
+ !ProcInfo, !ModuleInfo),
pred_info_set_proc_info(ProcId, !.ProcInfo, !PredInfo),
repuritycheck_proc(!.ModuleInfo, proc(PredId, ProcId), !PredInfo),
module_info_set_pred_info(PredId, !.PredInfo, !ModuleInfo).
@@ -484,6 +484,7 @@
Goal = Goal0
;
GoalExpr0 = shorthand(_),
+ % These should have been expanded out by now.
unexpected(this_file,
"shorthand goal encountered during dependent parallel " ++
"conjunction transformation.")
Index: compiler/dependency_graph.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/dependency_graph.m,v
retrieving revision 1.98
diff -u -b -r1.98 dependency_graph.m
--- compiler/dependency_graph.m 30 Dec 2007 08:23:35 -0000 1.98
+++ compiler/dependency_graph.m 6 Jan 2008 10:35:29 -0000
@@ -355,7 +355,8 @@
dependency_graph(T)::in, dependency_graph(T)::out) is det
<= dependency_node(T).
-add_dependency_arcs_in_goal(Caller, hlds_goal(GoalExpr, _), !DepGraph) :-
+add_dependency_arcs_in_goal(Caller, Goal, !DepGraph) :-
+ Goal = hlds_goal(GoalExpr, _),
(
( GoalExpr = conj(_, Goals)
; GoalExpr = disj(Goals)
@@ -370,10 +371,10 @@
add_dependency_arcs_in_goal(Caller, Then, !DepGraph),
add_dependency_arcs_in_goal(Caller, Else, !DepGraph)
;
- ( GoalExpr = negation(Goal)
- ; GoalExpr = scope(_, Goal)
+ ( GoalExpr = negation(SubGoal)
+ ; GoalExpr = scope(_, SubGoal)
),
- add_dependency_arcs_in_goal(Caller, Goal, !DepGraph)
+ add_dependency_arcs_in_goal(Caller, SubGoal, !DepGraph)
;
GoalExpr = generic_call(_, _, _, _)
;
@@ -413,9 +414,16 @@
;
GoalExpr = call_foreign_proc(_, _, _, _, _, _, _)
;
- GoalExpr = shorthand(ShorthandGoal),
- ShorthandGoal = bi_implication(LHS, RHS),
+ GoalExpr = shorthand(ShortHand),
+ (
+ ShortHand = atomic_goal(_GoalType, _Outer, _Inner, _Vars,
+ MainGoal, OrElseGoals),
+ add_dependency_arcs_in_goal(Caller, MainGoal, !DepGraph),
+ add_dependency_arcs_in_list(Caller, OrElseGoals, !DepGraph)
+ ;
+ ShortHand = bi_implication(LHS, RHS),
add_dependency_arcs_in_list(Caller, [LHS, RHS], !DepGraph)
+ )
).
%-----------------------------------------------------------------------------%
Index: compiler/det_analysis.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/det_analysis.m,v
retrieving revision 1.212
diff -u -b -r1.212 det_analysis.m
--- compiler/det_analysis.m 22 Jan 2008 15:06:08 -0000 1.212
+++ compiler/det_analysis.m 25 Jan 2008 05:52:09 -0000
@@ -626,9 +626,22 @@
GoalFailingContexts, !.DetInfo, !Specs),
GoalExpr = GoalExpr0
;
- GoalExpr0 = shorthand(_),
+ GoalExpr0 = shorthand(ShortHand0),
+ (
+ ShortHand0 = atomic_goal(GoalType, Inner, Outer, Vars, MainGoal0,
+ OrElseGoals0),
+ det_infer_atomic(MainGoal0, MainGoal, OrElseGoals0, OrElseGoals,
+ InstMap0, SolnContext, RightFailingContexts,
+ MaybePromiseEqvSolutionSets, Detism, !DetInfo, !Specs),
+ GoalFailingContexts = [],
+ ShortHand = atomic_goal(GoalType, Inner, Outer, Vars, MainGoal,
+ OrElseGoals)
+ ;
+ ShortHand0 = bi_implication(_, _),
% These should have been expanded out by now.
- unexpected(this_file, "det_infer_goal_2: unexpected shorthand")
+ unexpected(this_file, "det_infer_goal_2: bi_implication")
+ ),
+ GoalExpr = shorthand(ShortHand)
).
%-----------------------------------------------------------------------------%
@@ -1338,6 +1351,110 @@
%-----------------------------------------------------------------------------%
+:- pred det_infer_atomic(hlds_goal::in, hlds_goal::out,
+ list(hlds_goal)::in, list(hlds_goal)::out, instmap::in,
+ soln_context::in, list(failing_context)::in, maybe(pess_info)::in,
+ determinism::out, det_info::in, det_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+det_infer_atomic(MainGoal0, MainGoal, OrElseGoals0, OrElseGoals, InstMap0,
+ SolnContext, RightFailingContexts, MaybePromiseEqvSolutionSets0,
+ Detism, !DetInfo, !Specs) :-
+ det_infer_atomic_goal(MainGoal0, MainGoal, InstMap0,
+ SolnContext, RightFailingContexts, MaybePromiseEqvSolutionSets0,
+ MainDetism, !DetInfo, !Specs),
+ (
+ OrElseGoals0 = [],
+ OrElseGoals = [],
+ Detism = MainDetism
+ ;
+ OrElseGoals0 = [_ | _],
+ determinism_components(MainDetism, MainCanFail, MainMaxSolns),
+ det_infer_orelse_goals(OrElseGoals0, OrElseGoals, InstMap0,
+ SolnContext, RightFailingContexts, MaybePromiseEqvSolutionSets0,
+ MainCanFail, CanFail, MainMaxSolns, MaxSolns0, !DetInfo, !Specs),
+ (
+ MaxSolns0 = at_most_zero,
+ MaxSolns = at_most_zero
+ ;
+ MaxSolns0 = at_most_one,
+ % The final solution is given by the main goal or one of the
+ % orelse goals; whichever succeeds first. This effectively makes
+ % the atomic scope commit to the first of several possible
+ % solutions.
+ MaxSolns = at_most_many_cc
+ ;
+ MaxSolns0 = at_most_many_cc,
+ MaxSolns = at_most_many_cc
+ ;
+ MaxSolns0 = at_most_many,
+ MaxSolns = at_most_many
+ ),
+ determinism_components(Detism, CanFail, MaxSolns)
+ ).
+
+:- pred det_infer_atomic_goal(hlds_goal::in, hlds_goal::out, instmap::in,
+ soln_context::in, list(failing_context)::in, maybe(pess_info)::in,
+ determinism::out, det_info::in, det_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+det_infer_atomic_goal(Goal0, Goal, InstMap0,
+ SolnContext, RightFailingContexts, MaybePromiseEqvSolutionSets0,
+ Detism, !DetInfo, !Specs) :-
+ det_infer_goal(Goal0, Goal, InstMap0, SolnContext, RightFailingContexts,
+ MaybePromiseEqvSolutionSets0, Detism, GoalFailingContexts,
+ !DetInfo, !Specs),
+ (
+ ( Detism = detism_det
+ ; Detism = detism_cc_multi
+ ; Detism = detism_erroneous
+ ),
+ % XXX STM Detism = detism_cc_multi % <== TMP
+ expect(unify(GoalFailingContexts, []), this_file,
+ "det_infer_atomic_goal: GoalFailingContexts != []")
+ ;
+ ( Detism = detism_semi
+ ; Detism = detism_multi
+ ; Detism = detism_non
+ ; Detism = detism_cc_non
+ ; Detism = detism_failure
+ ),
+ Goal0 = hlds_goal(_, GoalInfo0),
+ Context = goal_info_get_context(GoalInfo0),
+ 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_goals(list(hlds_goal)::in, list(hlds_goal)::out,
+ instmap::in, soln_context::in, list(failing_context)::in,
+ maybe(pess_info)::in,
+ can_fail::in, can_fail::out, soln_count::in, soln_count::out,
+ det_info::in, det_info::out, list(error_spec)::in, list(error_spec)::out)
+ is det.
+
+det_infer_orelse_goals([], [], _InstMap0,
+ _SolnContext, _RightFailingContexts, _MaybePromiseEqvSolutionSets,
+ !CanFail, !MaxSolns, !DetInfo, !Specs).
+det_infer_orelse_goals([Goal0 | Goals0], [Goal | Goals], InstMap0,
+ SolnContext, RightFailingContexts, MaybePromiseEqvSolutionSets,
+ !CanFail, !MaxSolns, !DetInfo, !Specs) :-
+ det_infer_atomic_goal(Goal0, Goal, InstMap0,
+ SolnContext, RightFailingContexts, MaybePromiseEqvSolutionSets,
+ FirstDetism, !DetInfo, !Specs),
+ determinism_components(FirstDetism, FirstCanFail, FirstMaxSolns),
+ det_switch_canfail(!.CanFail, FirstCanFail, !:CanFail),
+ det_switch_maxsoln(!.MaxSolns, FirstMaxSolns, !:MaxSolns),
+ det_infer_orelse_goals(Goals0, Goals, InstMap0,
+ SolnContext, RightFailingContexts, MaybePromiseEqvSolutionSets,
+ !CanFail, !MaxSolns, !DetInfo, !Specs).
+
+%-----------------------------------------------------------------------------%
+
:- 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,
Index: compiler/det_report.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/det_report.m,v
retrieving revision 1.142
diff -u -b -r1.142 det_report.m
--- compiler/det_report.m 22 Jan 2008 13:28:53 -0000 1.142
+++ compiler/det_report.m 25 Jan 2008 05:52:09 -0000
@@ -607,23 +607,30 @@
Context = goal_info_get_context(GoalInfo),
det_report_call_context(Context, CallContext, !.DetInfo,
PredId, ProcId, InitMsgs, StartingPieces),
- det_diagnose_atomic_goal(Desired, Actual, Context, StartingPieces,
+ det_diagnose_primitive_goal(Desired, Actual, Context, StartingPieces,
AtomicMsgs),
Msgs = InitMsgs ++ AtomicMsgs
;
GoalExpr = generic_call(GenericCall, _, _, _),
Context = goal_info_get_context(GoalInfo),
report_generic_call_context(GenericCall, StartingPieces),
- det_diagnose_atomic_goal(Desired, Actual, Context, StartingPieces,
+ det_diagnose_primitive_goal(Desired, Actual, Context, StartingPieces,
Msgs)
;
GoalExpr = unify(LHS, RHS, _, _, UnifyContext),
Context = goal_info_get_context(GoalInfo),
det_report_unify_context(is_first, is_last, Context, UnifyContext,
!.DetInfo, LHS, RHS, StartingPieces),
- det_diagnose_atomic_goal(Desired, Actual, Context, StartingPieces,
+ det_diagnose_primitive_goal(Desired, Actual, Context, StartingPieces,
Msgs)
;
+ GoalExpr = call_foreign_proc(_, _, _, _, _, _, _),
+ Context = goal_info_get_context(GoalInfo),
+ DesiredStr = determinism_to_string(Desired),
+ Pieces = [words("Determinism declaration not satisfied."),
+ words("Desired determinism is " ++ DesiredStr ++ ".")],
+ Msgs = [simple_msg(Context, [always(Pieces)])]
+ ;
GoalExpr = if_then_else(_Vars, Cond, Then, Else),
determinism_components(Desired, _DesiredCanFail, DesiredSolns),
Cond = hlds_goal(_CondGoal, CondInfo),
@@ -679,16 +686,19 @@
det_diagnose_goal(SubGoal, InstMap0, InternalDesired, SwitchContexts,
!DetInfo, Msgs)
;
- GoalExpr = call_foreign_proc(_, _, _, _, _, _, _),
- Context = goal_info_get_context(GoalInfo),
- DesiredStr = determinism_to_string(Desired),
- Pieces = [words("Determinism declaration not satisfied."),
- words("Desired determinism is " ++ DesiredStr ++ ".")],
- Msgs = [simple_msg(Context, [always(Pieces)])]
+ GoalExpr = shorthand(ShortHand),
+ (
+ ShortHand = atomic_goal(_, _, _, _, MainGoal, OrElseGoals),
+ det_diagnose_goal(MainGoal, InstMap0, Desired,
+ SwitchContexts, !DetInfo, MainMsgs),
+ det_diagnose_orelse_goals(OrElseGoals, InstMap0, Desired,
+ SwitchContexts, !DetInfo, OrElseMsgs),
+ Msgs = MainMsgs ++ OrElseMsgs
;
- GoalExpr = shorthand(_),
+ ShortHand = bi_implication(_, _),
% These should have been expanded out by now.
- unexpected(this_file, "det_diagnose_goal_expr: unexpected shorthand")
+ unexpected(this_file, "det_diagnose_goal_expr: bi_implication")
+ )
).
%-----------------------------------------------------------------------------%
@@ -702,10 +712,10 @@
%-----------------------------------------------------------------------------%
-:- pred det_diagnose_atomic_goal(determinism::in, determinism::in,
+:- pred det_diagnose_primitive_goal(determinism::in, determinism::in,
prog_context::in, list(format_component)::in, list(error_msg)::out) is det.
-det_diagnose_atomic_goal(Desired, Actual, Context, StartingPieces, Msgs) :-
+det_diagnose_primitive_goal(Desired, Actual, Context, StartingPieces, Msgs) :-
determinism_components(Desired, DesiredCanFail, DesiredSolns),
determinism_components(Actual, ActualCanFail, ActualSolns),
compare_canfails(DesiredCanFail, ActualCanFail, CmpCanFail),
@@ -832,6 +842,19 @@
!DetInfo, Msgs2),
Msgs = Msgs1 ++ Msgs2.
+:- pred det_diagnose_orelse_goals(list(hlds_goal)::in, instmap::in,
+ determinism::in, list(switch_context)::in, det_info::in, det_info::out,
+ list(error_msg)::out) is det.
+
+det_diagnose_orelse_goals([], _, _Desired, _SwitchContexts, !DetInfo, []).
+det_diagnose_orelse_goals([Goal | Goals], InstMap0, Desired, SwitchContexts0,
+ !DetInfo, Msgs) :-
+ det_diagnose_goal(Goal, InstMap0, Desired, SwitchContexts0,
+ !DetInfo, Msgs1),
+ det_diagnose_orelse_goals(Goals, InstMap0, Desired, SwitchContexts0,
+ !DetInfo, Msgs2),
+ Msgs = Msgs1 ++ Msgs2.
+
%-----------------------------------------------------------------------------%
:- pred det_diagnose_missing_consids(list(cons_id)::in, list(case)::in,
Index: compiler/distance_granularity.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/distance_granularity.m,v
retrieving revision 1.6
diff -u -b -r1.6 distance_granularity.m
--- compiler/distance_granularity.m 30 Dec 2007 08:23:37 -0000 1.6
+++ compiler/distance_granularity.m 6 Jan 2008 09:34:15 -0000
@@ -280,9 +280,9 @@
!:Specialized = yes,
proc_info_set_goal(BodyClone, ProcInfo1, ProcInfo2),
requantify_proc(ProcInfo2, ProcInfo3),
- RecomputeAtomic = no,
- recompute_instmap_delta_proc(RecomputeAtomic, ProcInfo3,
- ProcInfo, !ModuleInfo),
+ recompute_instmap_delta_proc(
+ do_not_recompute_atomic_instmap_deltas, ProcInfo3, ProcInfo,
+ !ModuleInfo),
pred_info_set_proc_info(ProcId, ProcInfo, !PredInfo)
;
MaybeGranularityVar = no
@@ -393,7 +393,7 @@
IsRecursiveCallInParallelConj = no
;
GoalExpr0 = shorthand(_),
- % Shorthand are not supposed to occur here.
+ % These should have been expanded out by now.
unexpected(this_file, "apply_dg_to_goal")
).
@@ -847,9 +847,8 @@
PredIdSpecialized, SymNameSpecialized, ProcInfo0, ProcInfo1, Distance),
proc_info_set_goal(Body, ProcInfo1, ProcInfo2),
requantify_proc(ProcInfo2, ProcInfo3),
- RecomputeAtomic = no,
- recompute_instmap_delta_proc(RecomputeAtomic, ProcInfo3,
- ProcInfo, !ModuleInfo),
+ recompute_instmap_delta_proc(do_not_recompute_atomic_instmap_deltas,
+ ProcInfo3, ProcInfo, !ModuleInfo),
pred_info_set_proc_info(ProcId, ProcInfo, !PredInfo),
update_original_predicate_procs(PredId, ProcIds, Distance,
PredIdSpecialized, SymNameSpecialized, !PredInfo, !ModuleInfo).
Index: compiler/equiv_type_hlds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/equiv_type_hlds.m,v
retrieving revision 1.50
diff -u -b -r1.50 equiv_type_hlds.m
--- compiler/equiv_type_hlds.m 15 Feb 2008 02:26:54 -0000 1.50
+++ compiler/equiv_type_hlds.m 15 Feb 2008 02:42:08 -0000
@@ -399,7 +399,8 @@
(
Recompute = yes,
requantify_proc(!ProcInfo),
- recompute_instmap_delta_proc(no, !ProcInfo, !ModuleInfo)
+ recompute_instmap_delta_proc(
+ do_not_recompute_atomic_instmap_deltas, !ProcInfo, !ModuleInfo)
;
Recompute = no
),
@@ -929,8 +930,28 @@
GoalExpr = GoalExpr0
)
).
-replace_in_goal_expr(_, shorthand(_), _, _, !Info) :-
- unexpected(this_file, "replace_in_goal_expr: shorthand").
+replace_in_goal_expr(EqvMap, GoalExpr0, GoalExpr, Changed, !Info) :-
+ GoalExpr0 = shorthand(ShortHand0),
+ (
+ ShortHand0 = atomic_goal(GoalType, Outer, Inner,
+ MaybeOutputVars, MainGoal0, OrElseGoals0),
+ replace_in_goal(EqvMap, MainGoal0, MainGoal, Changed1, !Info),
+ replace_in_list(replace_in_goal(EqvMap), OrElseGoals0,
+ OrElseGoals, Changed2, !Info),
+ Changed = Changed1 `or` Changed2,
+ (
+ Changed = yes,
+ ShortHand = atomic_goal(GoalType, Outer, Inner,
+ MaybeOutputVars, MainGoal, OrElseGoals),
+ GoalExpr = shorthand(ShortHand)
+ ;
+ Changed = no,
+ GoalExpr = GoalExpr0
+ )
+ ;
+ ShortHand0 = bi_implication(_, _),
+ unexpected(this_file, "replace_in_goal_expr: bi_implication")
+ ).
:- pred replace_in_unification(eqv_map::in)
`with_type` replacer(unification, replace_info)
Index: compiler/erl_code_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/erl_code_gen.m,v
retrieving revision 1.30
diff -u -b -r1.30 erl_code_gen.m
--- compiler/erl_code_gen.m 11 Feb 2008 21:25:52 -0000 1.30
+++ compiler/erl_code_gen.m 12 Feb 2008 01:22:17 -0000
@@ -720,7 +720,7 @@
CodeModel, OuterContext, MaybeSuccessExpr, Statement, !Info).
erl_gen_goal_expr(shorthand(_), _, _, _, _, _, _, !Info) :-
- % these should have been expanded out by now
+ % These should have been expanded out by now.
unexpected(this_file, "erl_gen_goal_expr: unexpected shorthand").
%-----------------------------------------------------------------------------%
Index: compiler/error_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/error_util.m,v
retrieving revision 1.66
diff -u -b -r1.66 error_util.m
--- compiler/error_util.m 25 Oct 2007 05:05:13 -0000 1.66
+++ compiler/error_util.m 28 Jan 2008 01:40:22 -0000
@@ -364,8 +364,9 @@
%
:- func choose_number(list(T), U, U) = U.
- % is_or_are(List) returns "is" if the list is singleton, an exception
- % if the list is empty, otherwise it returns "are"
+ % is_or_are(List) throws an exception if the list is empty, returns "is"
+ % if the list is a singleton, and otherwise returns "are".
+ %
:- func is_or_are(list(T)) = string.
%-----------------------------------------------------------------------------%
Index: compiler/exception_analysis.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/exception_analysis.m,v
retrieving revision 1.45
diff -u -b -r1.45 exception_analysis.m
--- compiler/exception_analysis.m 21 Feb 2008 04:22:40 -0000 1.45
+++ compiler/exception_analysis.m 22 Feb 2008 07:18:25 -0000
@@ -522,6 +522,7 @@
MayCallMercury = proc_will_not_call_mercury
).
check_goal_for_exceptions_2(_, _, shorthand(_), _, _, _, _, _) :-
+ % These should have been expanded out by now.
unexpected(this_file,
"shorthand goal encountered during exception analysis.").
check_goal_for_exceptions_2(SCC, VarTypes, Goal, _, !Result, !ModuleInfo) :-
@@ -687,8 +688,9 @@
%
:- pred check_nonrecursive_call(scc::in, vartypes::in,
- pred_proc_id::in, prog_vars::in, bool::in, proc_result::in,
- proc_result::out, module_info::in, module_info::out) is det.
+ pred_proc_id::in, prog_vars::in, bool::in,
+ proc_result::in, proc_result::out,
+ module_info::in, module_info::out) is det.
check_nonrecursive_call(SCC, VarTypes, PPId, Args, Imported, !Result,
!ModuleInfo) :-
@@ -731,6 +733,7 @@
!Result)
)
).
+
:- pred check_vars(module_info::in, vartypes::in, prog_vars::in,
maybe(analysis_status)::in, proc_result::in, proc_result::out) is det.
Index: compiler/follow_code.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/follow_code.m,v
retrieving revision 1.93
diff -u -b -r1.93 follow_code.m
--- compiler/follow_code.m 30 Dec 2007 08:23:38 -0000 1.93
+++ compiler/follow_code.m 6 Jan 2008 10:34:49 -0000
@@ -86,8 +86,8 @@
RttiVarMaps0, RttiVarMaps),
proc_info_get_initial_instmap(!.ProcInfo, !.ModuleInfo, InstMap0),
proc_info_get_inst_varset(!.ProcInfo, InstVarSet),
- recompute_instmap_delta(no, Goal2, Goal, VarTypes, InstVarSet,
- InstMap0, !ModuleInfo)
+ recompute_instmap_delta(do_not_recompute_atomic_instmap_deltas,
+ Goal2, Goal, VarTypes, InstVarSet, InstMap0, !ModuleInfo)
;
Goal = Goal0,
Varset = Varset0,
Index: compiler/format_call.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/format_call.m,v
retrieving revision 1.12
diff -u -b -r1.12 format_call.m
--- compiler/format_call.m 30 Dec 2007 08:23:38 -0000 1.12
+++ compiler/format_call.m 5 Jan 2008 14:24:38 -0000
@@ -469,9 +469,17 @@
GoalExpr = unify(_, _, _, Unification, _),
traverse_unify(Unification, CurId, !ConjMaps, !PredMap, !RelevantVars)
;
- GoalExpr = shorthand(_),
+ GoalExpr = shorthand(ShortHand),
+ (
+ ShortHand = atomic_goal(_, _, _, _, MainGoal, OrElseGoals),
+ traverse_disj([MainGoal | OrElseGoals], CurId,
+ !FormatCallSites, !Counter, !ConjMaps, !PredMap, !RelevantVars,
+ ModuleInfo)
+ ;
+ ShortHand = bi_implication(_, _),
% These should have been expanded by now.
- unexpected(this_file, "traverse_conj: shorthand")
+ unexpected(this_file, "traverse_conj: bi_implication")
+ )
).
:- pred traverse_unify(unification::in, conj_id::in,
@@ -587,13 +595,14 @@
traverse_disj_arms([], _, [], !Counter, !ConjMaps, !PredMap, [], _).
traverse_disj_arms([Goal | Goals], ContainingId,
- [FormatCallSites | FormatCallSitesTail], !Counter,
- !ConjMaps, !PredMap, [RelevantVars | RelevantVarSets], ModuleInfo) :-
- traverse_goal(Goal, DisjId, [], FormatCallSites, !Counter,
- !ConjMaps, !PredMap, set.init, RelevantVars, ModuleInfo),
+ [GoalFormatCallSites | GoalsFormatCallSites], !Counter,
+ !ConjMaps, !PredMap, [GoalRelevantVars | GoalsRelevantVarSet],
+ ModuleInfo) :-
+ traverse_goal(Goal, DisjId, [], GoalFormatCallSites, !Counter,
+ !ConjMaps, !PredMap, set.init, GoalRelevantVars, ModuleInfo),
svmap.det_insert(DisjId, ContainingId, !PredMap),
- traverse_disj_arms(Goals, ContainingId, FormatCallSitesTail, !Counter,
- !ConjMaps, !PredMap, RelevantVarSets, ModuleInfo).
+ traverse_disj_arms(Goals, ContainingId, GoalsFormatCallSites, !Counter,
+ !ConjMaps, !PredMap, GoalsRelevantVarSet, ModuleInfo).
:- func get_conj_map(conj_maps, conj_id) = conj_map.
Index: compiler/goal_form.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/goal_form.m,v
retrieving revision 1.43
diff -u -b -r1.43 goal_form.m
--- compiler/goal_form.m 21 Feb 2008 04:22:40 -0000 1.43
+++ compiler/goal_form.m 22 Feb 2008 06:38:06 -0000
@@ -200,18 +200,19 @@
:- pred goal_can_throw_2(hlds_goal_expr::in, hlds_goal_info::in,
goal_throw_status::out, module_info::in, module_info::out) is det.
-goal_can_throw_2(Goal, _GoalInfo, Result, !ModuleInfo) :-
+goal_can_throw_2(GoalExpr, _GoalInfo, Result, !ModuleInfo) :-
(
- Goal = conj(_, Goals)
+ (
+ GoalExpr = conj(_, Goals)
;
- Goal = disj(Goals)
+ GoalExpr = disj(Goals)
;
- Goal = if_then_else(_, IfGoal, ThenGoal, ElseGoal),
- Goals = [IfGoal, ThenGoal, ElseGoal]
+ GoalExpr = if_then_else(_, CondGoal, ThenGoal, ElseGoal),
+ Goals = [CondGoal, ThenGoal, ElseGoal]
),
- goals_can_throw(Goals, Result, !ModuleInfo).
-goal_can_throw_2(Goal, _GoalInfo, Result, !ModuleInfo) :-
- Goal = plain_call(PredId, ProcId, _, _, _, _),
+ goals_can_throw(Goals, Result, !ModuleInfo)
+ ;
+ GoalExpr = plain_call(PredId, ProcId, _, _, _, _),
lookup_exception_analysis_result(proc(PredId, ProcId), Status,
!ModuleInfo),
(
@@ -222,16 +223,16 @@
; Status = throw_conditional
),
Result = can_throw
- ).
-goal_can_throw_2(Goal, _GoalInfo, Result, !ModuleInfo) :-
+ )
+ ;
+ GoalExpr = generic_call(_, _, _, _),
% XXX We should use results form closure analysis here.
- Goal = generic_call(_, _, _, _),
- Result = can_throw.
-goal_can_throw_2(Goal, _GoalInfo, Result, !ModuleInfo) :-
- Goal = switch(_, _, Cases),
- cases_can_throw(Cases, Result, !ModuleInfo).
-goal_can_throw_2(Goal, _GoalInfo, Result, !ModuleInfo) :-
- Goal = unify(_, _, _, Uni, _),
+ Result = can_throw
+ ;
+ GoalExpr = switch(_, _, Cases),
+ cases_can_throw(Cases, Result, !ModuleInfo)
+ ;
+ GoalExpr = unify(_, _, _, Uni, _),
% Complicated unifies are _non_builtin_
(
Uni = complicated_unify(_, _, _),
@@ -243,16 +244,14 @@
; Uni = simple_test(_, _)
),
Result = cannot_throw
- ).
-goal_can_throw_2(OuterGoal, _, Result, !ModuleInfo) :-
- (
- OuterGoal = negation(InnerGoal)
+ )
;
- OuterGoal = scope(_, InnerGoal)
+ ( GoalExpr = negation(SubGoal)
+ ; GoalExpr = scope(_, SubGoal)
),
- goal_can_throw(InnerGoal, Result, !ModuleInfo).
-goal_can_throw_2(Goal, _, Result, !ModuleInfo) :-
- Goal = call_foreign_proc(Attributes, _, _, _, _, _, _),
+ goal_can_throw(SubGoal, Result, !ModuleInfo)
+ ;
+ GoalExpr = call_foreign_proc(Attributes, _, _, _, _, _, _),
ExceptionStatus = get_may_throw_exception(Attributes),
(
(
@@ -265,9 +264,20 @@
Result = cannot_throw
;
Result = can_throw
+ )
+ ;
+ GoalExpr = shorthand(ShortHand),
+ (
+ ShortHand = bi_implication(GoalA, GoalB),
+ goals_can_throw([GoalA, GoalB], Result, !ModuleInfo)
+ ;
+ ShortHand = atomic_goal(_, _, _, _, _, _),
+ % 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.
+ Result = can_throw
+ )
).
-goal_can_throw_2(Goal, _, can_throw, !ModuleInfo) :-
- Goal = shorthand(_). % XXX maybe call unexpected/2 here.
:- pred goals_can_throw(hlds_goals::in, goal_throw_status::out,
module_info::in, module_info::out) is det.
@@ -344,56 +354,29 @@
:- func goal_can_loop_func(maybe(module_info), hlds_goal) = bool.
-goal_can_loop_func(MaybeModuleInfo, hlds_goal(GoalExpr, _)) =
- goal_expr_can_loop(MaybeModuleInfo, GoalExpr).
-
-:- func goal_expr_can_loop(maybe(module_info), hlds_goal_expr) = bool.
-
-goal_expr_can_loop(MaybeModuleInfo, conj(plain_conj, Goals)) =
- goal_list_can_loop(MaybeModuleInfo, Goals).
-goal_expr_can_loop(_MaybeModuleInfo, conj(parallel_conj, _Goals)) = yes.
- % In theory, parallel conjunctions can get into deadlocks, which are
- % effectively a form of nontermination. We can return `no' here only
- % if we are sure this cannot happen for this conjunction.
-goal_expr_can_loop(MaybeModuleInfo, disj(Goals)) =
- goal_list_can_loop(MaybeModuleInfo, Goals).
-goal_expr_can_loop(MaybeModuleInfo, switch(_Var, _CanFail, Cases)) =
- case_list_can_loop(MaybeModuleInfo, Cases).
-goal_expr_can_loop(MaybeModuleInfo, negation(Goal)) =
- goal_can_loop_func(MaybeModuleInfo, Goal).
-goal_expr_can_loop(MaybeModuleInfo, scope(_, Goal)) =
- goal_can_loop_func(MaybeModuleInfo, Goal).
-goal_expr_can_loop(MaybeModuleInfo, Goal) = CanLoop :-
- Goal = if_then_else(_Vars, Cond, Then, Else),
- ( goal_can_loop_func(MaybeModuleInfo, Cond) = yes ->
- CanLoop = yes
- ; goal_can_loop_func(MaybeModuleInfo, Then) = yes ->
- CanLoop = yes
- ; goal_can_loop_func(MaybeModuleInfo, Else) = yes ->
- CanLoop = yes
- ;
- CanLoop = no
- ).
-goal_expr_can_loop(_MaybeModuleInfo, Goal) = CanLoop :-
- Goal = call_foreign_proc(Attributes, _, _, _, _, _, _),
+goal_can_loop_func(MaybeModuleInfo, Goal) = CanLoop :-
+ Goal = hlds_goal(GoalExpr, _),
(
- Terminates = get_terminates(Attributes),
+ GoalExpr = unify(_, _, _, Uni, _),
(
- Terminates = proc_terminates
- ;
- Terminates = depends_on_mercury_calls,
- get_may_call_mercury(Attributes) = proc_will_not_call_mercury
- )
- ->
+ ( Uni = assign(_, _)
+ ; Uni = simple_test(_, _)
+ ; Uni = construct(_, _, _, _, _, _, _)
+ ; Uni = deconstruct(_, _, _, _, _, _)
+ ),
CanLoop = no
;
+ Uni = complicated_unify(_, _, _),
+ % It can call, possibly indirectly, a user-specified unification
+ % predicate.
CanLoop = yes
- ).
-goal_expr_can_loop(MaybeModuleInfo, Goal) = CanLoop :-
- Goal = plain_call(PredId, ProcId, _, _, _, _),
+ )
+ ;
+ GoalExpr = plain_call(PredId, ProcId, _, _, _, _),
(
MaybeModuleInfo = yes(ModuleInfo),
- module_info_pred_proc_info(ModuleInfo, PredId, ProcId, _, ProcInfo),
+ module_info_pred_proc_info(ModuleInfo, PredId, ProcId, _,
+ ProcInfo),
(
proc_info_get_maybe_termination_info(ProcInfo, MaybeTermInfo),
MaybeTermInfo = yes(cannot_loop(_))
@@ -405,27 +388,68 @@
CanLoop = no
;
CanLoop = yes
- ).
-goal_expr_can_loop(_MaybeModuleInfo, Goal) = yes :-
+ )
+ ;
+ GoalExpr = generic_call(_, _, _, _),
% We have no idea whether the called goal can throw exceptions,
% at least without closure analysis.
- Goal = generic_call(_, _, _, _).
-goal_expr_can_loop(_, unify(_, _, _, Uni, _)) = CanLoop :-
+ CanLoop = yes
+ ;
+ GoalExpr = call_foreign_proc(Attributes, _, _, _, _, _, _),
(
- ( Uni = assign(_, _)
- ; Uni = simple_test(_, _)
- ; Uni = construct(_, _, _, _, _, _, _)
- ; Uni = deconstruct(_, _, _, _, _, _)
- ),
+ Terminates = get_terminates(Attributes),
+ (
+ Terminates = proc_terminates
+ ;
+ Terminates = depends_on_mercury_calls,
+ get_may_call_mercury(Attributes) = proc_will_not_call_mercury
+ )
+ ->
CanLoop = no
;
- Uni = complicated_unify(_, _, _),
- % It can call, possibly indirectly, a user-specified unification
- % predicate.
CanLoop = yes
+ )
+ ;
+ GoalExpr = conj(plain_conj, Goals),
+ CanLoop = goal_list_can_loop(MaybeModuleInfo, Goals)
+ ;
+ GoalExpr = conj(parallel_conj, _Goals),
+ % In theory, parallel conjunctions can get into deadlocks, which are
+ % effectively a form of nontermination. We can return `no' here only
+ % if we are sure this cannot happen for this conjunction.
+ CanLoop = yes
+ ;
+ GoalExpr = disj(Goals),
+ CanLoop = goal_list_can_loop(MaybeModuleInfo, Goals)
+ ;
+ GoalExpr = switch(_Var, _CanFail, Cases),
+ CanLoop = case_list_can_loop(MaybeModuleInfo, Cases)
+ ;
+ GoalExpr = if_then_else(_Vars, Cond, Then, Else),
+ ( goal_can_loop_func(MaybeModuleInfo, Cond) = yes ->
+ CanLoop = yes
+ ; goal_can_loop_func(MaybeModuleInfo, Then) = yes ->
+ CanLoop = yes
+ ;
+ CanLoop = goal_can_loop_func(MaybeModuleInfo, Else)
+ )
+ ;
+ ( GoalExpr = negation(SubGoal)
+ ; GoalExpr = scope(_, SubGoal)
+ ),
+ CanLoop = goal_can_loop_func(MaybeModuleInfo, SubGoal)
+ ;
+ GoalExpr = shorthand(ShortHand),
+ (
+ ShortHand = atomic_goal(_, _, _, _, MainGoal, OrElseGoals),
+ MainGoalCanLoop = goal_can_loop_func(MaybeModuleInfo, MainGoal),
+ OrElseCanLoop = goal_list_can_loop(MaybeModuleInfo, OrElseGoals),
+ CanLoop = MainGoalCanLoop `or` OrElseCanLoop
+ ;
+ ShortHand = bi_implication(_, _),
+ unexpected(this_file, "goal_can_loop: bi_implication")
+ )
).
-goal_expr_can_loop(_, shorthand(_)) = _ :-
- unexpected(this_file, "goal_expr_can_loop: shorthand").
:- func goal_list_can_loop(maybe(module_info), list(hlds_goal)) = bool.
@@ -465,29 +489,36 @@
:- func goal_expr_can_throw(maybe(module_info), hlds_goal_expr) = bool.
-goal_expr_can_throw(MaybeModuleInfo, conj(_ConjType, Goals)) =
- goal_list_can_throw(MaybeModuleInfo, Goals).
-goal_expr_can_throw(MaybeModuleInfo, disj(Goals)) =
- goal_list_can_throw(MaybeModuleInfo, Goals).
-goal_expr_can_throw(MaybeModuleInfo, switch(_Var, _Category, Cases)) =
- case_list_can_throw(MaybeModuleInfo, Cases).
-goal_expr_can_throw(MaybeModuleInfo, negation(Goal)) =
- goal_can_throw_func(MaybeModuleInfo, Goal).
-goal_expr_can_throw(MaybeModuleInfo, scope(_, Goal)) =
- goal_can_throw_func(MaybeModuleInfo, Goal).
-goal_expr_can_throw(MaybeModuleInfo, Goal) = CanThrow :-
- Goal = if_then_else(_, Cond, Then, Else),
- ( goal_can_throw_func(MaybeModuleInfo, Cond) = yes ->
- CanThrow = yes
- ; goal_can_throw_func(MaybeModuleInfo, Then) = yes ->
- CanThrow = yes
- ; goal_can_throw_func(MaybeModuleInfo, Else) = yes ->
+goal_expr_can_throw(MaybeModuleInfo, GoalExpr) = CanThrow :-
+ (
+ GoalExpr = unify(_, _, _, Uni, _),
+ (
+ ( Uni = assign(_, _)
+ ; Uni = simple_test(_, _)
+ ; Uni = construct(_, _, _, _, _, _, _)
+ ; Uni = deconstruct(_, _, _, _, _, _)
+ ),
+ CanThrow = no
+ ;
+ Uni = complicated_unify(_, _, _),
+ % It can call, possibly indirectly, a user-specified unification
+ % predicate.
CanThrow = yes
+ )
;
+ GoalExpr = plain_call(PredId, ProcId, _, _, _, _),
+ (
+ MaybeModuleInfo = yes(ModuleInfo),
+ module_info_get_exception_info(ModuleInfo, ExceptionInfo),
+ map.search(ExceptionInfo, proc(PredId, ProcId), ProcExceptionInfo),
+ ProcExceptionInfo = proc_exception_info(will_not_throw, _)
+ ->
CanThrow = no
- ).
-goal_expr_can_throw(_MaybeModuleInfo, Goal) = CanThrow :-
- Goal = call_foreign_proc(Attributes, _, _, _, _, _, _),
+ ;
+ CanThrow = yes
+ )
+ ;
+ GoalExpr = call_foreign_proc(Attributes, _, _, _, _, _, _),
ExceptionStatus = get_may_throw_exception(Attributes),
(
(
@@ -500,40 +531,44 @@
CanThrow = no
;
CanThrow = yes
- ).
-goal_expr_can_throw(MaybeModuleInfo, Goal) = CanThrow :-
- Goal = plain_call(PredId, ProcId, _, _, _, _),
- (
- MaybeModuleInfo = yes(ModuleInfo),
- module_info_get_exception_info(ModuleInfo, ExceptionInfo),
- map.search(ExceptionInfo, proc(PredId, ProcId), ProcExceptionInfo),
- ProcExceptionInfo = proc_exception_info(will_not_throw, _)
- ->
- CanThrow = no
+ )
;
- CanThrow = yes
- ).
-goal_expr_can_throw(_MaybeModuleInfo, Goal) = yes :-
+ GoalExpr = generic_call(_, _, _, _),
% We have no idea whether the called goal can throw exceptions,
% at least without closure analysis.
- Goal = generic_call(_, _, _, _).
-goal_expr_can_throw(_, unify(_, _, _, Uni, _)) = CanThrow :-
- % Complicated unifies are _non_builtin_
- (
- ( Uni = assign(_, _)
- ; Uni = simple_test(_, _)
- ; Uni = construct(_, _, _, _, _, _, _)
- ; Uni = deconstruct(_, _, _, _, _, _)
+ CanThrow = yes
+ ;
+ ( GoalExpr = conj(_ConjType, Goals)
+ ; GoalExpr = disj(Goals)
),
- CanThrow = no
+ CanThrow = goal_list_can_throw(MaybeModuleInfo, Goals)
;
- Uni = complicated_unify(_, _, _),
- % It can call, possibly indirectly, a user-specified unification
- % predicate.
+ GoalExpr = switch(_Var, _CanFail, Cases),
+ CanThrow = case_list_can_throw(MaybeModuleInfo, Cases)
+ ;
+ GoalExpr = if_then_else(_, Cond, Then, Else),
+ ( goal_can_throw_func(MaybeModuleInfo, Cond) = yes ->
CanThrow = yes
+ ; goal_can_throw_func(MaybeModuleInfo, Then) = yes ->
+ CanThrow = yes
+ ;
+ CanThrow = goal_can_throw_func(MaybeModuleInfo, Else)
+ )
+ ;
+ ( GoalExpr = negation(SubGoal)
+ ; GoalExpr = scope(_Reason, SubGoal)
+ ),
+ CanThrow = goal_can_throw_func(MaybeModuleInfo, SubGoal)
+ ;
+ GoalExpr = shorthand(ShortHand),
+ (
+ ShortHand = atomic_goal(_, _, _, _, _, _),
+ CanThrow = yes
+ ;
+ ShortHand = bi_implication(_, _),
+ unexpected(this_file, "goal_expr_can_throw: bi_implication")
+ )
).
-goal_expr_can_throw(_, shorthand(_)) = _ :-
- unexpected(this_file, "goal_expr_can_throw: shorthand").
:- func goal_list_can_throw(maybe(module_info), list(hlds_goal)) = bool.
@@ -605,8 +640,19 @@
:- pred goal_may_allocate_heap_2(hlds_goal_expr::in, bool::out) is det.
-goal_may_allocate_heap_2(generic_call(_, _, _, _), yes).
-goal_may_allocate_heap_2(plain_call(_, _, _, Builtin, _, _), May) :-
+goal_may_allocate_heap_2(GoalExpr, May) :-
+ (
+ GoalExpr = unify(_, _, _, Unification, _),
+ (
+ Unification = construct(_, _, Args, _, _, _, _),
+ Args = [_ | _]
+ ->
+ May = yes
+ ;
+ May = no
+ )
+ ;
+ GoalExpr = plain_call(_, _, _, Builtin, _, _),
(
Builtin = inline_builtin,
May = no
@@ -615,57 +661,60 @@
; Builtin = not_builtin
),
May = yes
- ).
-goal_may_allocate_heap_2(unify(_, _, _, Unification, _), May) :-
- (
- Unification = construct(_, _, Args, _, _, _, _),
- Args = [_ | _]
- ->
+ )
+ ;
+ GoalExpr = generic_call(_, _, _, _),
May = yes
;
- May = no
- ).
+ GoalExpr = call_foreign_proc(_, _, _, _, _, _, _),
% We cannot safely say that a foreign code fragment does not
% allocate memory without knowing all the #defined macros that
% expand to incr_hp and variants thereof.
% XXX You could make it an attribute of the foreign code and
% trust the programmer.
-goal_may_allocate_heap_2(call_foreign_proc(_, _, _, _, _, _, _), yes).
-goal_may_allocate_heap_2(scope(_, Goal), May) :-
- goal_may_allocate_heap(Goal, May).
-goal_may_allocate_heap_2(negation(Goal), May) :-
- goal_may_allocate_heap(Goal, May).
-goal_may_allocate_heap_2(conj(ConjType, Goals), May) :-
+ May = yes
+ ;
+ GoalExpr = conj(ConjType, Goals),
(
ConjType = parallel_conj,
May = yes
;
ConjType = plain_conj,
goal_list_may_allocate_heap(Goals, May)
- ).
-goal_may_allocate_heap_2(disj(Goals), May) :-
- goal_list_may_allocate_heap(Goals, May).
-goal_may_allocate_heap_2(switch(_Var, _Det, Cases), May) :-
- cases_may_allocate_heap(Cases, May).
-goal_may_allocate_heap_2(if_then_else(_Vars, C, T, E), May) :-
- ( goal_may_allocate_heap(C, yes) ->
+ )
+ ;
+ GoalExpr = disj(Goals),
+ goal_list_may_allocate_heap(Goals, May)
+ ;
+ GoalExpr = switch(_Var, _CanFail, Cases),
+ cases_may_allocate_heap(Cases, May)
+ ;
+ GoalExpr = if_then_else(_Vars, Cond, Then, Else),
+ ( goal_may_allocate_heap(Cond, yes) ->
May = yes
- ; goal_may_allocate_heap(T, yes) ->
+ ; goal_may_allocate_heap(Then, yes) ->
May = yes
;
- goal_may_allocate_heap(E, May)
- ).
-goal_may_allocate_heap_2(shorthand(ShorthandGoal), May) :-
- goal_may_allocate_heap_2_shorthand(ShorthandGoal, May).
-
-:- pred goal_may_allocate_heap_2_shorthand(shorthand_goal_expr::in, bool::out)
- is det.
-
-goal_may_allocate_heap_2_shorthand(bi_implication(G1, G2), May) :-
- ( goal_may_allocate_heap(G1, yes) ->
+ goal_may_allocate_heap(Else, May)
+ )
+ ;
+ ( GoalExpr = negation(SubGoal)
+ ; GoalExpr = scope(_, SubGoal)
+ ),
+ goal_may_allocate_heap(SubGoal, May)
+ ;
+ GoalExpr = shorthand(ShortHand),
+ (
+ ShortHand = atomic_goal(_, _, _, _, _, _),
May = yes
;
- goal_may_allocate_heap(G2, May)
+ ShortHand = bi_implication(GoalA, GoalB),
+ ( goal_may_allocate_heap(GoalA, yes) ->
+ May = yes
+ ;
+ goal_may_allocate_heap(GoalB, May)
+ )
+ )
).
:- pred goal_list_may_allocate_heap(list(hlds_goal)::in, bool::out) is det.
@@ -764,21 +813,17 @@
%-----------------------------------------------------------------------------%
-count_recursive_calls(hlds_goal(GoalExpr, _), PredId, ProcId, Min, Max) :-
- count_recursive_calls_2(GoalExpr, PredId, ProcId, Min, Max).
-
-:- pred count_recursive_calls_2(hlds_goal_expr::in, pred_id::in, proc_id::in,
- int::out, int::out) is det.
-
-count_recursive_calls_2(negation(Goal), PredId, ProcId, Min, Max) :-
- count_recursive_calls(Goal, PredId, ProcId, Min, Max).
-count_recursive_calls_2(scope(_, Goal), PredId, ProcId, Min, Max) :-
- count_recursive_calls(Goal, PredId, ProcId, Min, Max).
-count_recursive_calls_2(unify(_, _, _, _, _), _, _, 0, 0).
-count_recursive_calls_2(generic_call(_, _, _, _), _, _, 0, 0).
-count_recursive_calls_2(call_foreign_proc(_, _, _, _, _, _, _), _, _, 0, 0).
-count_recursive_calls_2(plain_call(CallPredId, CallProcId, _, _, _, _),
- PredId, ProcId, Count, Count) :-
+count_recursive_calls(Goal, PredId, ProcId, Min, Max) :-
+ Goal = hlds_goal(GoalExpr, _),
+ (
+ ( GoalExpr = unify(_, _, _, _, _)
+ ; GoalExpr = generic_call(_, _, _, _)
+ ; GoalExpr = call_foreign_proc(_, _, _, _, _, _, _)
+ ),
+ Min = 0,
+ Max = 0
+ ;
+ GoalExpr = plain_call(CallPredId, CallProcId, _, _, _, _),
(
PredId = CallPredId,
ProcId = CallProcId
@@ -786,25 +831,44 @@
Count = 1
;
Count = 0
- ).
-count_recursive_calls_2(conj(_, Goals), PredId, ProcId, Min, Max) :-
- count_recursive_calls_conj(Goals, PredId, ProcId, 0, 0, Min, Max).
-count_recursive_calls_2(disj(Goals), PredId, ProcId, Min, Max) :-
- count_recursive_calls_disj(Goals, PredId, ProcId, Min, Max).
-count_recursive_calls_2(switch(_, _, Cases), PredId, ProcId, Min, Max) :-
- count_recursive_calls_cases(Cases, PredId, ProcId, Min, Max).
-count_recursive_calls_2(if_then_else(_, Cond, Then, Else), PredId, ProcId,
- Min, Max) :-
+ ),
+ Min = Count,
+ Max = Count
+ ;
+ GoalExpr = conj(_, Goals),
+ count_recursive_calls_conj(Goals, PredId, ProcId, 0, 0, Min, Max)
+ ;
+ GoalExpr = disj(Goals),
+ count_recursive_calls_disj(Goals, PredId, ProcId, Min, Max)
+ ;
+ GoalExpr = switch(_, _, Cases),
+ count_recursive_calls_cases(Cases, PredId, ProcId, Min, Max)
+ ;
+ GoalExpr = if_then_else(_, Cond, Then, Else),
count_recursive_calls(Cond, PredId, ProcId, CMin, CMax),
count_recursive_calls(Then, PredId, ProcId, TMin, TMax),
count_recursive_calls(Else, PredId, ProcId, EMin, EMax),
CTMin = CMin + TMin,
CTMax = CMax + TMax,
int.min(CTMin, EMin, Min),
- int.max(CTMax, EMax, Max).
-count_recursive_calls_2(shorthand(_), _, _, _, _) :-
- % these should have been expanded out by now
- unexpected(this_file, "count_recursive_calls_2: unexpected shorthand").
+ int.max(CTMax, EMax, Max)
+ ;
+ ( GoalExpr = negation(SubGoal)
+ ; GoalExpr = scope(_, SubGoal)
+ ),
+ count_recursive_calls(SubGoal, PredId, ProcId, Min, Max)
+ ;
+ GoalExpr = shorthand(ShortHand),
+ (
+ ShortHand = atomic_goal(_, _, _, _, MainGoal, OrElseGoals),
+ count_recursive_calls_disj([MainGoal | OrElseGoals],
+ PredId, ProcId, Min, Max)
+ ;
+ ShortHand = bi_implication(_, _),
+ % These should have been expanded out by now.
+ unexpected(this_file, "count_recursive_calls: bi_implication")
+ )
+ ).
:- pred count_recursive_calls_conj(list(hlds_goal)::in,
pred_id::in, proc_id::in, int::in, int::in, int::out, int::out) is det.
Index: compiler/goal_path.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/goal_path.m,v
retrieving revision 1.49
diff -u -b -r1.49 goal_path.m
--- compiler/goal_path.m 29 Jan 2008 04:59:38 -0000 1.49
+++ compiler/goal_path.m 29 Jan 2008 06:50:14 -0000
@@ -141,17 +141,17 @@
:- pred fill_expr_slots(hlds_goal_info::in, goal_path::in, slot_info::in,
hlds_goal_expr::in, hlds_goal_expr::out) is det.
-fill_expr_slots(GoalInfo, Path0, SlotInfo, Goal0, Goal) :-
+fill_expr_slots(GoalInfo, Path0, SlotInfo, GoalExpr0, GoalExpr) :-
(
- Goal0 = conj(ConjType, Goals0),
+ GoalExpr0 = conj(ConjType, Goals0),
fill_conj_slots(Path0, 0, SlotInfo, Goals0, Goals),
- Goal = conj(ConjType, Goals)
+ GoalExpr = conj(ConjType, Goals)
;
- Goal0 = disj(Goals0),
+ GoalExpr0 = disj(Goals0),
fill_disj_slots(Path0, 0, SlotInfo, Goals0, Goals),
- Goal = disj(Goals)
+ GoalExpr = disj(Goals)
;
- Goal0 = switch(Var, CanFail, Cases0),
+ GoalExpr0 = switch(Var, CanFail, Cases0),
VarTypes = SlotInfo ^ slot_info_vartypes,
ModuleInfo = SlotInfo ^ slot_info_module_info,
map.lookup(VarTypes, Var, Type),
@@ -161,14 +161,14 @@
MaybeNumFunctors = no
),
fill_switch_slots(Path0, 0, MaybeNumFunctors, SlotInfo, Cases0, Cases),
- Goal = switch(Var, CanFail, Cases)
+ GoalExpr = switch(Var, CanFail, Cases)
;
- Goal0 = negation(SubGoal0),
+ GoalExpr0 = negation(SubGoal0),
fill_goal_slots(cord.snoc(Path0, step_neg), SlotInfo,
SubGoal0, SubGoal),
- Goal = negation(SubGoal)
+ GoalExpr = negation(SubGoal)
;
- Goal0 = scope(Reason, SubGoal0),
+ GoalExpr0 = scope(Reason, SubGoal0),
SubGoal0 = hlds_goal(_, InnerInfo),
OuterDetism = goal_info_get_determinism(GoalInfo),
InnerDetism = goal_info_get_determinism(InnerInfo),
@@ -179,42 +179,53 @@
),
fill_goal_slots(cord.snoc(Path0, step_scope(MaybeCut)), SlotInfo,
SubGoal0, SubGoal),
- Goal = scope(Reason, SubGoal)
+ GoalExpr = scope(Reason, SubGoal)
;
- Goal0 = if_then_else(A, Cond0, Then0, Else0),
+ GoalExpr0 = if_then_else(A, Cond0, Then0, Else0),
fill_goal_slots(cord.snoc(Path0, step_ite_cond), SlotInfo,
Cond0, Cond),
fill_goal_slots(cord.snoc(Path0, step_ite_then), SlotInfo,
Then0, Then),
fill_goal_slots(cord.snoc(Path0, step_ite_else), SlotInfo,
Else0, Else),
- Goal = if_then_else(A, Cond, Then, Else)
+ GoalExpr = if_then_else(A, Cond, Then, Else)
;
- Goal0 = unify(LHS, RHS0, Mode, Kind, Context),
+ GoalExpr0 = unify(LHS, RHS0, Mode, Kind, Context),
(
- RHS0 = rhs_lambda_goal(A, B, C, D, E, F, G, H, LambdaGoal0),
+ RHS0 = rhs_lambda_goal(Purity, Groundness, PredOrFunc, EvalMethod,
+ NonLocals, QuantVars, LambdaModes, Detism, LambdaGoal0),
fill_goal_slots(Path0, SlotInfo, LambdaGoal0, LambdaGoal),
- RHS = rhs_lambda_goal(A, B, C, D, E, F, G, H, LambdaGoal)
+ RHS = rhs_lambda_goal(Purity, Groundness, PredOrFunc, EvalMethod,
+ NonLocals, QuantVars, LambdaModes, Detism, LambdaGoal)
;
( RHS0 = rhs_var(_)
; RHS0 = rhs_functor(_, _, _)
),
RHS = RHS0
),
- Goal = unify(LHS, RHS, Mode, Kind, Context)
+ GoalExpr = unify(LHS, RHS, Mode, Kind, Context)
;
- Goal0 = plain_call(_, _, _, _, _, _),
- Goal = Goal0
- ;
- Goal0 = generic_call(_, _, _, _),
- Goal = Goal0
+ ( GoalExpr0 = plain_call(_, _, _, _, _, _)
+ ; GoalExpr0 = generic_call(_, _, _, _)
+ ; GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _)
+ ),
+ GoalExpr = GoalExpr0
;
- Goal0 = call_foreign_proc(_, _, _, _, _, _, _),
- Goal = Goal0
+ GoalExpr0 = shorthand(ShortHand0),
+ (
+ ShortHand0 = atomic_goal(GoalType, Outer, Inner, MaybeOutputVars,
+ MainGoal0, OrElseGoals0),
+ fill_goal_slots(cord.snoc(Path0, step_atomic_main), SlotInfo,
+ MainGoal0, MainGoal),
+ fill_orelse_slots(Path0, 0, SlotInfo, OrElseGoals0, OrElseGoals),
+ ShortHand = atomic_goal(GoalType, Outer, Inner, MaybeOutputVars,
+ MainGoal, OrElseGoals)
;
- Goal0 = shorthand(_),
+ ShortHand0 = bi_implication(_, _),
% These should have been expanded out by now.
unexpected(this_file, "fill_expr_slots: unexpected shorthand")
+ ),
+ GoalExpr = shorthand(ShortHand)
).
:- pred fill_conj_slots(goal_path::in, int::in, slot_info::in,
@@ -248,6 +259,16 @@
Case = case(MainConsId, OtherConsIds, Goal),
fill_switch_slots(Path0, N1, MaybeNumFunctors, SlotInfo, Cases0, Cases).
+:- pred fill_orelse_slots(goal_path::in, int::in, slot_info::in,
+ list(hlds_goal)::in, list(hlds_goal)::out) is det.
+
+fill_orelse_slots(_, _, _, [], []).
+fill_orelse_slots(Path0, N0, SlotInfo, [Goal0 | Goals0], [Goal | Goals]) :-
+ N1 = N0 + 1,
+ fill_goal_slots(cord.snoc(Path0, step_atomic_orelse(N1)), SlotInfo,
+ Goal0, Goal),
+ fill_orelse_slots(Path0, N1, SlotInfo, Goals0, Goals).
+
%-----------------------------------------------------------------------------%
:- func this_file = string.
Index: compiler/goal_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/goal_util.m,v
retrieving revision 1.156
diff -u -b -r1.156 goal_util.m
--- compiler/goal_util.m 21 Feb 2008 04:22:40 -0000 1.156
+++ compiler/goal_util.m 22 Feb 2008 02:14:34 -0000
@@ -84,8 +84,8 @@
% Unlike quantification.goal_vars, this predicate returns
% even the explicitly quantified variables.
%
-:- pred goals_goal_vars(hlds_goals::in, set(prog_var)::in,
- set(prog_var)::out) is det.
+:- pred goals_goal_vars(hlds_goals::in,
+ set(prog_var)::in, set(prog_var)::out) is det.
% Return all the variables in a generic call.
%
@@ -452,13 +452,17 @@
%-----------------------------------------------------------------------------%
-goal_vars(hlds_goal(GoalExpr, _GoalInfo), Set) :-
- goal_vars_2(GoalExpr, set.init, Set).
+goal_vars(Goal, !:Set) :-
+ set.init(!:Set),
+ goal_vars_2(Goal, !Set).
-:- pred goal_vars_2(hlds_goal_expr::in,
- set(prog_var)::in, set(prog_var)::out) is det.
+:- pred goal_vars_2(hlds_goal::in, set(prog_var)::in, set(prog_var)::out)
+ is det.
-goal_vars_2(unify(Var, RHS, _, Unif, _), !Set) :-
+goal_vars_2(Goal, !Set) :-
+ Goal = hlds_goal(GoalExpr, _GoalInfo),
+ (
+ GoalExpr = unify(Var, RHS, _, Unif, _),
svset.insert(Var, !Set),
(
Unif = construct(_, _, _, _, CellToReuse, _, _),
@@ -476,27 +480,26 @@
;
Unif = complicated_unify(_, _, _)
),
- rhs_goal_vars(RHS, !Set).
-
-goal_vars_2(generic_call(GenericCall, ArgVars, _, _), !Set) :-
- generic_call_vars(GenericCall, Vars0),
- svset.insert_list(Vars0, !Set),
- svset.insert_list(ArgVars, !Set).
-
-goal_vars_2(plain_call(_, _, ArgVars, _, _, _), !Set) :-
- svset.insert_list(ArgVars, !Set).
-
-goal_vars_2(conj(_, Goals), !Set) :-
- goals_goal_vars(Goals, !Set).
-
-goal_vars_2(disj(Goals), !Set) :-
- goals_goal_vars(Goals, !Set).
-
-goal_vars_2(switch(Var, _Det, Cases), !Set) :-
+ rhs_goal_vars(RHS, !Set)
+ ;
+ GoalExpr = generic_call(GenericCall, ArgVars, _, _),
+ generic_call_vars(GenericCall, GenericCallVars),
+ svset.insert_list(GenericCallVars, !Set),
+ svset.insert_list(ArgVars, !Set)
+ ;
+ GoalExpr = plain_call(_, _, ArgVars, _, _, _),
+ svset.insert_list(ArgVars, !Set)
+ ;
+ ( GoalExpr = conj(_, Goals)
+ ; GoalExpr = disj(Goals)
+ ),
+ goals_goal_vars(Goals, !Set)
+ ;
+ GoalExpr = switch(Var, _Det, Cases),
svset.insert(Var, !Set),
- cases_goal_vars(Cases, !Set).
-
-goal_vars_2(scope(Reason, hlds_goal(GoalExpr, _)), !Set) :-
+ cases_goal_vars(Cases, !Set)
+ ;
+ GoalExpr = scope(Reason, SubGoal),
(
Reason = exist_quant(Vars),
svset.insert_list(Vars, !Set)
@@ -515,35 +518,51 @@
;
Reason = trace_goal(_, _, _, _, _)
),
- goal_vars_2(GoalExpr, !Set).
-
-goal_vars_2(negation(hlds_goal(GoalExpr, _GoalInfo)), !Set) :-
- goal_vars_2(GoalExpr, !Set).
-
-goal_vars_2(if_then_else(Vars, Cond, Then, Else), !Set) :-
- set.insert_list(!.Set, Vars, !:Set),
- goal_vars_2(Cond ^ hlds_goal_expr, !Set),
- goal_vars_2(Then ^ hlds_goal_expr, !Set),
- goal_vars_2(Else ^ hlds_goal_expr, !Set).
-
-goal_vars_2(call_foreign_proc(_, _, _, Args, ExtraArgs, _, _), !Set) :-
+ goal_vars_2(SubGoal, !Set)
+ ;
+ GoalExpr = negation(SubGoal),
+ goal_vars_2(SubGoal, !Set)
+ ;
+ GoalExpr = if_then_else(Vars, Cond, Then, Else),
+ svset.insert_list(Vars, !Set),
+ goal_vars_2(Cond, !Set),
+ goal_vars_2(Then, !Set),
+ goal_vars_2(Else, !Set)
+ ;
+ GoalExpr = call_foreign_proc(_, _, _, Args, ExtraArgs, _, _),
ArgVars = list.map(foreign_arg_var, Args),
ExtraVars = list.map(foreign_arg_var, ExtraArgs),
- svset.insert_list(list.append(ArgVars, ExtraVars), !Set).
-
-goal_vars_2(shorthand(ShorthandGoal), !Set) :-
- goal_vars_2_shorthand(ShorthandGoal, !Set).
-
-:- pred goal_vars_2_shorthand(shorthand_goal_expr::in,
- set(prog_var)::in, set(prog_var)::out) is det.
-
-goal_vars_2_shorthand(bi_implication(LHS, RHS), !Set) :-
- goal_vars_2(LHS ^ hlds_goal_expr, !Set),
- goal_vars_2(RHS ^ hlds_goal_expr, !Set).
+ svset.insert_list(ArgVars, !Set),
+ svset.insert_list(ExtraVars, !Set)
+ ;
+ GoalExpr = shorthand(Shorthand),
+ (
+ Shorthand = atomic_goal(_, Outer, Inner, MaybeOutputVars,
+ MainGoal, OrElseGoals),
+ Outer = atomic_interface_vars(OuterDI, OuterUO),
+ svset.insert(OuterDI, !Set),
+ svset.insert(OuterUO, !Set),
+ Inner = atomic_interface_vars(InnerDI, InnerUO),
+ svset.insert(InnerDI, !Set),
+ svset.insert(InnerUO, !Set),
+ (
+ MaybeOutputVars = no
+ ;
+ MaybeOutputVars = yes(OutputVars),
+ svset.insert_list(OutputVars, !Set)
+ ),
+ goal_vars_2(MainGoal, !Set),
+ goals_goal_vars(OrElseGoals, !Set)
+ ;
+ Shorthand = bi_implication(LeftGoal, RightGoal),
+ goal_vars_2(LeftGoal, !Set),
+ goal_vars_2(RightGoal, !Set)
+ )
+ ).
goals_goal_vars([], !Set).
goals_goal_vars([Goal | Goals], !Set) :-
- goal_vars_2(Goal ^ hlds_goal_expr, !Set),
+ goal_vars_2(Goal, !Set),
goals_goal_vars(Goals, !Set).
:- pred cases_goal_vars(list(case)::in,
@@ -551,7 +570,7 @@
cases_goal_vars([], !Set).
cases_goal_vars([case(_, _, Goal) | Cases], !Set) :-
- goal_vars_2(Goal ^ hlds_goal_expr, !Set),
+ goal_vars_2(Goal, !Set),
cases_goal_vars(Cases, !Set).
:- pred rhs_goal_vars(unify_rhs::in,
@@ -567,7 +586,7 @@
RHS = rhs_lambda_goal(_, _, _, _, NonLocals, LambdaVars, _, _, Goal),
svset.insert_list(NonLocals, !Set),
svset.insert_list(LambdaVars, !Set),
- goal_vars_2(Goal ^ hlds_goal_expr, !Set).
+ goal_vars_2(Goal, !Set).
generic_call_vars(higher_order(Var, _, _, _), [Var]).
generic_call_vars(class_method(Var, _, _, _), [Var]).
@@ -595,6 +614,13 @@
attach_features_goal_expr(Features, GoalExpr0, GoalExpr) :-
(
+ ( GoalExpr0 = plain_call(_, _, _, _, _, _)
+ ; GoalExpr0 = generic_call(_, _, _, _)
+ ; GoalExpr0 = unify(_, _, _, _, _)
+ ; GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _)
+ ),
+ GoalExpr = GoalExpr0
+ ;
GoalExpr0 = conj(ConjType, Goals0),
list.map(attach_features_to_all_goals(Features), Goals0, Goals),
GoalExpr = conj(ConjType, Goals)
@@ -621,20 +647,22 @@
attach_features_to_all_goals(Features, Goal0, Goal),
GoalExpr = scope(Reason, Goal)
;
- GoalExpr0 = plain_call(_, _, _, _, _, _),
- GoalExpr = GoalExpr0
- ;
- GoalExpr0 = generic_call(_, _, _, _),
- GoalExpr = GoalExpr0
- ;
- GoalExpr0 = unify(_, _, _, _, _),
- GoalExpr = GoalExpr0
- ;
- GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _),
- GoalExpr = GoalExpr0
- ;
- GoalExpr0 = shorthand(_),
- GoalExpr = GoalExpr0
+ GoalExpr0 = shorthand(ShortHand0),
+ (
+ ShortHand0 = atomic_goal(GoalType, Outer, Inner, MaybeOutputVars,
+ MainGoal0, OrElseGoals0),
+ attach_features_to_all_goals(Features, MainGoal0, MainGoal),
+ list.map(attach_features_to_all_goals(Features),
+ OrElseGoals0, OrElseGoals),
+ ShortHand = atomic_goal(GoalType, Outer, Inner, MaybeOutputVars,
+ MainGoal, OrElseGoals)
+ ;
+ ShortHand0 = bi_implication(GoalA0, GoalB0),
+ attach_features_to_all_goals(Features, GoalA0, GoalA),
+ attach_features_to_all_goals(Features, GoalB0, GoalB),
+ ShortHand = bi_implication(GoalA, GoalB)
+ ),
+ GoalExpr = shorthand(ShortHand)
).
%-----------------------------------------------------------------------------%
@@ -731,6 +759,10 @@
)
;
GoalExpr = shorthand(ShortHand),
+ (
+ ShortHand = atomic_goal(_, _, _, _, _, _),
+ IsLeaf = is_not_leaf
+ ;
ShortHand = bi_implication(GoalA, GoalB),
(
proc_body_is_leaf(GoalA) = is_leaf,
@@ -740,6 +772,7 @@
;
IsLeaf = is_not_leaf
)
+ )
).
:- func proc_body_is_leaf_goals(list(hlds_goal)) = is_leaf.
@@ -812,7 +845,16 @@
:- pred goal_expr_size(hlds_goal_expr::in, int::out) is det.
-goal_expr_size(conj(ConjType, Goals), Size) :-
+goal_expr_size(GoalExpr, Size) :-
+ (
+ ( GoalExpr = plain_call(_, _, _, _, _, _)
+ ; GoalExpr = generic_call(_, _, _, _)
+ ; GoalExpr = unify(_, _, _, _, _)
+ ; GoalExpr = call_foreign_proc(_, _, _, _, _, _, _)
+ ),
+ Size = 1
+ ;
+ GoalExpr = conj(ConjType, Goals),
goals_size(Goals, InnerSize),
(
ConjType = plain_conj,
@@ -820,37 +862,43 @@
;
ConjType = parallel_conj,
Size = InnerSize + 1
- ).
-goal_expr_size(disj(Goals), Size) :-
+ )
+ ;
+ GoalExpr = disj(Goals),
goals_size(Goals, Size1),
- Size = Size1 + 1.
-goal_expr_size(switch(_, _, Goals), Size) :-
- cases_size(Goals, Size1),
- Size = Size1 + 1.
-goal_expr_size(if_then_else(_, Cond, Then, Else), Size) :-
+ Size = Size1 + 1
+ ;
+ GoalExpr = switch(_, _, Cases),
+ cases_size(Cases, Size1),
+ Size = Size1 + 1
+ ;
+ GoalExpr = if_then_else(_, Cond, Then, Else),
goal_size(Cond, Size1),
goal_size(Then, Size2),
goal_size(Else, Size3),
- Size = Size1 + Size2 + Size3 + 1.
-goal_expr_size(negation(Goal), Size) :-
- goal_size(Goal, Size1),
- Size = Size1 + 1.
-goal_expr_size(scope(_, Goal), Size) :-
- goal_size(Goal, Size1),
- Size = Size1 + 1.
-goal_expr_size(plain_call(_, _, _, _, _, _), 1).
-goal_expr_size(generic_call(_, _, _, _), 1).
-goal_expr_size(unify(_, _, _, _, _), 1).
-goal_expr_size(call_foreign_proc(_, _, _, _, _, _, _), 1).
-goal_expr_size(shorthand(ShorthandGoal), Size) :-
- goal_expr_size_shorthand(ShorthandGoal, Size).
-
-:- pred goal_expr_size_shorthand(shorthand_goal_expr::in, int::out) is det.
-
-goal_expr_size_shorthand(bi_implication(LHS, RHS), Size) :-
- goal_size(LHS, Size1),
- goal_size(RHS, Size2),
- Size = Size1 + Size2 + 1.
+ Size = Size1 + Size2 + Size3 + 1
+ ;
+ GoalExpr = negation(SubGoal),
+ goal_size(SubGoal, Size1),
+ Size = Size1 + 1
+ ;
+ GoalExpr = scope(_, SubGoal),
+ goal_size(SubGoal, Size1),
+ Size = Size1 + 1
+ ;
+ GoalExpr = shorthand(ShortHand),
+ (
+ ShortHand = atomic_goal(_, _, _, _, MainGoal, OrElseGoals),
+ goal_size(MainGoal, Size1),
+ goals_size(OrElseGoals, Size2),
+ Size = Size1 + Size2 + 1
+ ;
+ ShortHand = bi_implication(GoalA, GoalB),
+ goal_size(GoalA, Size1),
+ goal_size(GoalB, Size2),
+ Size = Size1 + Size2 + 1
+ )
+ ).
%-----------------------------------------------------------------------------%
%
@@ -861,6 +909,11 @@
% since it avoids creating any choice points.
%
+% XXX STM
+% split this predicate into two:
+% goal_calls_this_proc(Goal, PredProcId) = bool
+% all_called_procs_in_goal(Goal) = cord(pred_proc_id)
+
goal_calls(hlds_goal(GoalExpr, _), PredProcId) :-
goal_expr_calls(GoalExpr, PredProcId).
@@ -1017,8 +1070,16 @@
GoalExpr = scope(_, Goal),
goal_calls_proc_in_list_2(Goal, PredProcIds, !CalledSet)
;
- GoalExpr = shorthand(_),
- unexpected(this_file, "goal__calls_proc_in_list_2: shorthand")
+ GoalExpr = shorthand(ShortHand),
+ (
+ ShortHand = atomic_goal(_, _, _, _, MainGoal, OrElseGoals),
+ goal_calls_proc_in_list_2(MainGoal, PredProcIds, !CalledSet),
+ goal_list_calls_proc_in_list_2(OrElseGoals, PredProcIds,
+ !CalledSet)
+ ;
+ ShortHand = bi_implication(_, _),
+ unexpected(this_file, "goal__calls_proc_in_list_2: bi_implication")
+ )
).
:- pred goal_list_calls_proc_in_list_2(list(hlds_goal)::in,
@@ -1603,16 +1664,6 @@
GoalExpr = switch(Var, CanFail, Cases),
Goal = hlds_goal(GoalExpr, GoalInfo0)
;
- GoalExpr0 = scope(Reason, SubGoal0),
- SubGoal = maybe_strip_equality_pretest(SubGoal0),
- GoalExpr = scope(Reason, SubGoal),
- Goal = hlds_goal(GoalExpr, GoalInfo0)
- ;
- GoalExpr0 = negation(SubGoal0),
- SubGoal = maybe_strip_equality_pretest(SubGoal0),
- GoalExpr = negation(SubGoal),
- Goal = hlds_goal(GoalExpr, GoalInfo0)
- ;
GoalExpr0 = if_then_else(Vars, Cond0, Then0, Else0),
( goal_info_has_feature(GoalInfo0, feature_pretest_equality) ->
Goal = Else0
@@ -1624,8 +1675,31 @@
Goal = hlds_goal(GoalExpr, GoalInfo0)
)
;
- GoalExpr0 = shorthand(_),
- unexpected(this_file, "maybe_strip_equality_pretest: shorthand")
+ GoalExpr0 = negation(SubGoal0),
+ SubGoal = maybe_strip_equality_pretest(SubGoal0),
+ GoalExpr = negation(SubGoal),
+ Goal = hlds_goal(GoalExpr, GoalInfo0)
+ ;
+ GoalExpr0 = scope(Reason, SubGoal0),
+ SubGoal = maybe_strip_equality_pretest(SubGoal0),
+ GoalExpr = scope(Reason, SubGoal),
+ Goal = hlds_goal(GoalExpr, GoalInfo0)
+ ;
+ GoalExpr0 = shorthand(ShortHand0),
+ (
+ ShortHand0 = atomic_goal(GoalType, Outer, Inner, MaybeOutputVars,
+ MainGoal0, OrElseGoals0),
+ MainGoal = maybe_strip_equality_pretest(MainGoal0),
+ OrElseGoals = list.map(maybe_strip_equality_pretest, OrElseGoals0),
+ ShortHand = atomic_goal(GoalType, Outer, Inner, MaybeOutputVars,
+ MainGoal, OrElseGoals),
+ GoalExpr = shorthand(ShortHand),
+ Goal = hlds_goal(GoalExpr, GoalInfo0)
+ ;
+ ShortHand0 = bi_implication(_, _),
+ unexpected(this_file,
+ "maybe_strip_equality_pretest: bi_implication")
+ )
).
:- func maybe_strip_equality_pretest_case(case) = case.
Index: compiler/higher_order.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/higher_order.m,v
retrieving revision 1.175
diff -u -b -r1.175 higher_order.m
--- compiler/higher_order.m 11 Feb 2008 21:25:53 -0000 1.175
+++ compiler/higher_order.m 12 Feb 2008 01:22:17 -0000
@@ -489,12 +489,11 @@
proc_info_set_goal(Goal0, !ProcInfo),
requantify_proc(!ProcInfo),
proc_info_get_goal(!.ProcInfo, Goal2),
- RecomputeAtomic = no,
proc_info_get_initial_instmap(!.ProcInfo, !.ModuleInfo, InstMap),
proc_info_get_vartypes(!.ProcInfo, VarTypes),
proc_info_get_inst_varset(!.ProcInfo, InstVarSet),
- recompute_instmap_delta(RecomputeAtomic, Goal2, Goal3,
- VarTypes, InstVarSet, InstMap, !ModuleInfo),
+ recompute_instmap_delta(do_not_recompute_atomic_instmap_deltas,
+ Goal2, Goal3, VarTypes, InstVarSet, InstMap, !ModuleInfo),
proc_info_set_goal(Goal3, !ProcInfo),
!Info ^ hoi_proc_info := !.ProcInfo,
!Info ^ hoi_global_info ^ hogi_module_info := !.ModuleInfo
Index: compiler/hlds_goal.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_goal.m,v
retrieving revision 1.188
diff -u -b -r1.188 hlds_goal.m
--- compiler/hlds_goal.m 22 Jan 2008 15:06:10 -0000 1.188
+++ compiler/hlds_goal.m 25 Jan 2008 05:52:10 -0000
@@ -231,25 +231,69 @@
---> plain_conj
; parallel_conj.
-:- type after_semantic_analysis
- ---> before_semantic_analysis
- ; after_semantic_analysis.
-
- % Instances of these `shorthand' goals are implemented by a
- % hlds --> hlds transformation that replaces them with
- % equivalent non-shorthand goals.
+ % These `shorthand' goals are implemented by HLDS --> HLDS transformations
+ % that replaces them with equivalent non-shorthand goals.
%
:- type shorthand_goal_expr
+ ---> bi_implication(
% bi-implication (A <=> B)
%
- % Note that ordinary implications (A => B)
- % and reverse implications (A <= B) are expanded
- % out before we construct the HLDS. But we can't
- % do that for bi-implications, because if expansion
- % of bi-implications is done before implicit quantification,
- % then the quantification would be wrong.
- %
- ---> bi_implication(hlds_goal, hlds_goal).
+ % Note that ordinary implications (A => B) and reverse
+ % implications (A <= B) are expanded out before we construct
+ % the HLDS. We cannot do that for bi-implications, because
+ % if expansion of bi-implications is done before implicit
+ % quantification, then the quantification would be wrong.
+
+ hlds_goal,
+ hlds_goal
+ )
+
+ ; atomic_goal(
+ % An atomic goal that will be executed atomically against
+ % all running threads using the stm system.
+
+ % The type of atomic goal. Either a top level atomic goal,
+ % or a nested atomic goal. This isn't known until after
+ % typechecking.
+ atomic_goal_type :: atomic_goal_type,
+
+ % The variables representing the initial and final versions
+ % of the outer state. For top level atomic goals, of type
+ % io.state; for nested atomic goals, of type stm_builtin.stm.
+ atomic_outer :: atomic_interface_vars,
+
+ % The variables representing the initial and final versions
+ % of the inner state (always of type stm_builtin.stm).
+ atomic_inner :: atomic_interface_vars,
+
+ % List of output variables specified with `var(...)`.
+ % These variables should be free when the atomic goal
+ % is started and ground when the atomic goal is complete.
+ atomic_output_vars :: maybe(list(prog_var)),
+
+ % The main atomic transaction goal. If any or_else goals
+ % also exist, this goal is the first or_else alternative.
+ atomic_main_goal :: hlds_goal,
+
+ % Any later or_else alternative goals.
+ orelse_alternatives :: list(hlds_goal)
+
+ ).
+
+:- type atomic_interface_vars
+ ---> atomic_interface_vars(
+ atomic_initial :: prog_var,
+ atomic_final :: prog_var
+ ).
+
+ % If an atomic goal has type unknown_atomic_goal_type, then the conversion
+ % predicates to and from the inner variables have not been added yet to the
+ % main and orelse goals. If the type is top_level_atomic_goal or
+ % nested_atomic_goal, then the conversion predicates *have* been added.
+:- type atomic_goal_type
+ ---> unknown_atomic_goal_type
+ ; top_level_atomic_goal
+ ; nested_atomic_goal.
:- type scope_reason
---> exist_quant(list(prog_var))
@@ -1369,12 +1413,16 @@
:- func goal_has_foreign(hlds_goal) = bool.
:- func goal_list_has_foreign(list(hlds_goal)) = bool.
- % A goal is atomic iff it doesn't contain any sub-goals
+:- type has_subgoals
+ ---> has_subgoals
+ ; does_not_have_subgoals.
+
+ % A goal is primitive iff it doesn't contain any sub-goals
% (except possibly goals inside lambda expressions --
% but lambda expressions will get transformed into separate
% predicates by the polymorphism.m pass).
%
-:- pred goal_is_atomic(hlds_goal_expr::in) is semidet.
+:- func goal_expr_has_subgoals(hlds_goal_expr) = has_subgoals.
% Return the HLDS equivalent of `true'.
%
@@ -2189,19 +2237,40 @@
Expr = call_foreign_proc(Attrs, PredId, ProcId, Args, Extra,
MTRC, Impl)
;
- Expr0 = shorthand(ShorthandGoal0),
- rename_vars_in_shorthand(Must, Subn, ShorthandGoal0, ShorthandGoal),
- Expr = shorthand(ShorthandGoal)
+ Expr0 = shorthand(Shorthand0),
+ (
+ Shorthand0 = atomic_goal(GoalType0, Outer0, Inner0,
+ MaybeOutputVars0, MainGoal0, OrElseGoals0),
+ GoalType = GoalType0,
+ Outer0 = atomic_interface_vars(OuterDI0, OuterUO0),
+ rename_var(Must, Subn, OuterDI0, OuterDI),
+ rename_var(Must, Subn, OuterUO0, OuterUO),
+ Outer = atomic_interface_vars(OuterDI, OuterUO),
+ Inner0 = atomic_interface_vars(InnerDI0, InnerUO0),
+ rename_var(Must, Subn, InnerDI0, InnerDI),
+ rename_var(Must, Subn, InnerUO0, InnerUO),
+ Inner = atomic_interface_vars(InnerDI, InnerUO),
+ (
+ MaybeOutputVars0 = no,
+ MaybeOutputVars = MaybeOutputVars0
+ ;
+ MaybeOutputVars0 = yes(OutputVars0),
+ rename_var_list(Must, Subn, OutputVars0, OutputVars),
+ MaybeOutputVars = yes(OutputVars)
+ ),
+ rename_vars_in_goal(Must, Subn, MainGoal0, MainGoal),
+ rename_vars_in_goals(Must, Subn, OrElseGoals0, OrElseGoals),
+ Shorthand = atomic_goal(GoalType, Outer, Inner,
+ MaybeOutputVars, MainGoal, OrElseGoals)
+ ;
+ Shorthand0 = bi_implication(LeftGoal0, RightGoal0),
+ rename_vars_in_goal(Must, Subn, LeftGoal0, LeftGoal),
+ rename_vars_in_goal(Must, Subn, RightGoal0, RightGoal),
+ Shorthand = bi_implication(LeftGoal, RightGoal)
+ ),
+ Expr = shorthand(Shorthand)
).
-:- pred rename_vars_in_shorthand(must_rename::in, prog_var_renaming::in,
- shorthand_goal_expr::in, shorthand_goal_expr::out) is det.
-
-rename_vars_in_shorthand(Must, Subn,
- bi_implication(LHS0, RHS0), bi_implication(LHS, RHS)) :-
- rename_vars_in_goal(Must, Subn, LHS0, LHS),
- rename_vars_in_goal(Must, Subn, RHS0, RHS).
-
:- pred rename_arg_list(must_rename::in, prog_var_renaming::in,
list(foreign_arg)::in, list(foreign_arg)::out) is det.
@@ -2591,23 +2660,15 @@
GoalExpr = call_foreign_proc(_, _, _, _, _, _, _),
HasForeign = yes
;
- GoalExpr = shorthand(ShorthandGoal),
- HasForeign = goal_has_foreign_shorthand(ShorthandGoal)
- ).
-
- % Return yes if the shorthand goal contains any foreign code.
- %
-:- func goal_has_foreign_shorthand(shorthand_goal_expr) = bool.
-
-goal_has_foreign_shorthand(bi_implication(GoalA, GoalB)) =
+ GoalExpr = shorthand(ShortHand),
(
- ( goal_has_foreign(GoalA) = yes
- ; goal_has_foreign(GoalB) = yes
- )
- ->
- yes
+ ShortHand = atomic_goal(_, _, _, _, _, _),
+ HasForeign = yes
;
- no
+ ShortHand = bi_implication(GoalA, GoalB),
+ HasForeign = bool.or(goal_has_foreign(GoalA),
+ goal_has_foreign(GoalB))
+ )
).
goal_list_has_foreign([]) = no.
@@ -2620,36 +2681,39 @@
%-----------------------------------------------------------------------------%
-goal_is_atomic(Goal) :-
- goal_is_atomic(Goal) = yes.
-
-:- func goal_is_atomic(hlds_goal_expr) = bool.
-
-goal_is_atomic(unify(_, _, _, _, _)) = yes.
-goal_is_atomic(generic_call(_, _, _, _)) = yes.
-goal_is_atomic(plain_call(_, _, _, _, _, _)) = yes.
-goal_is_atomic(call_foreign_proc(_, _, _, _, _, _, _)) = yes.
-goal_is_atomic(conj(_, Conj)) = IsAtomic :-
+goal_expr_has_subgoals(GoalExpr) = HasSubGoals :-
(
- Conj = [],
- IsAtomic = yes
+ ( GoalExpr = unify(_, _, _, _, _)
+ ; GoalExpr = generic_call(_, _, _, _)
+ ; GoalExpr = plain_call(_, _, _, _, _, _)
+ ; GoalExpr = call_foreign_proc(_, _, _, _, _, _, _)
+ ),
+ HasSubGoals = does_not_have_subgoals
;
- Conj = [_ | _],
- IsAtomic = no
- ).
-goal_is_atomic(disj(Disj)) = IsAtomic :-
+ ( GoalExpr = conj(_, SubGoals)
+ ; GoalExpr = disj(SubGoals)
+ ),
(
- Disj = [],
- IsAtomic = yes
+ SubGoals = [],
+ HasSubGoals = does_not_have_subgoals
;
- Disj = [_ | _],
- IsAtomic = no
+ SubGoals = [_ | _],
+ HasSubGoals = has_subgoals
+ )
+ ;
+ ( GoalExpr = if_then_else(_, _, _, _)
+ ; GoalExpr = negation(_)
+ ; GoalExpr = switch(_, _, _)
+ ; GoalExpr = scope(_, _)
+ ),
+ HasSubGoals = has_subgoals
+ ;
+ GoalExpr = shorthand(ShortHand),
+ ( ShortHand = atomic_goal(_, _, _, _, _, _)
+ ; ShortHand = bi_implication(_, _)
+ ),
+ HasSubGoals = has_subgoals
).
-goal_is_atomic(if_then_else(_, _, _, _)) = no.
-goal_is_atomic(negation(_)) = no.
-goal_is_atomic(switch(_, _, _)) = no.
-goal_is_atomic(scope(_, _)) = no.
-goal_is_atomic(shorthand(_)) = no.
%-----------------------------------------------------------------------------%
@@ -2715,55 +2779,65 @@
set_goal_contexts(Context, Goal0, Goal) :-
Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
goal_info_set_context(Context, GoalInfo0, GoalInfo),
- set_goal_contexts_expr(Context, GoalExpr0, GoalExpr),
+ (
+ GoalExpr0 = conj(ConjType, SubGoals0),
+ list.map(set_goal_contexts(Context), SubGoals0, SubGoals),
+ GoalExpr = conj(ConjType, SubGoals)
+ ;
+ GoalExpr0 = disj(SubGoals0),
+ list.map(set_goal_contexts(Context), SubGoals0, SubGoals),
+ GoalExpr = disj(SubGoals)
+ ;
+ GoalExpr0 = if_then_else(Vars, Cond0, Then0, Else0),
+ set_goal_contexts(Context, Cond0, Cond),
+ set_goal_contexts(Context, Then0, Then),
+ set_goal_contexts(Context, Else0, Else),
+ GoalExpr = if_then_else(Vars, Cond, Then, Else)
+ ;
+ GoalExpr0 = switch(Var, CanFail, Cases0),
+ list.map(set_case_contexts(Context), Cases0, Cases),
+ GoalExpr = switch(Var, CanFail, Cases)
+ ;
+ GoalExpr0 = scope(Reason, SubGoal0),
+ set_goal_contexts(Context, SubGoal0, SubGoal),
+ GoalExpr = scope(Reason, SubGoal)
+ ;
+ GoalExpr0 = negation(SubGoal0),
+ set_goal_contexts(Context, SubGoal0, SubGoal),
+ GoalExpr = negation(SubGoal)
+ ;
+ ( GoalExpr0 = plain_call(_, _, _, _, _, _)
+ ; GoalExpr0 = generic_call(_, _, _, _)
+ ; GoalExpr0 = unify(_, _, _, _, _)
+ ; GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _)
+ ),
+ GoalExpr = GoalExpr0
+ ;
+ GoalExpr0 = shorthand(ShortHand0),
+ (
+ ShortHand0 = atomic_goal(GoalType, Outer, Inner, MaybeOutputVars,
+ MainGoal0, OrElseGoals0),
+ set_goal_contexts(Context, MainGoal0, MainGoal),
+ list.map(set_goal_contexts(Context), OrElseGoals0, OrElseGoals),
+ ShortHand = atomic_goal(GoalType, Outer, Inner, MaybeOutputVars,
+ MainGoal, OrElseGoals)
+ ;
+ ShortHand0 = bi_implication(LHS0, RHS0),
+ set_goal_contexts(Context, LHS0, LHS),
+ set_goal_contexts(Context, RHS0, RHS),
+ ShortHand = bi_implication(LHS, RHS)
+ ),
+ GoalExpr = shorthand(ShortHand)
+ ),
Goal = hlds_goal(GoalExpr, GoalInfo).
-:- pred set_goal_contexts_case(prog_context::in, case::in, case::out) is det.
+:- pred set_case_contexts(prog_context::in, case::in, case::out) is det.
-set_goal_contexts_case(Context, Case0, Case) :-
+set_case_contexts(Context, Case0, Case) :-
Case0 = case(MainConsId, OtherConsIds, Goal0),
set_goal_contexts(Context, Goal0, Goal),
Case = case(MainConsId, OtherConsIds, Goal).
-:- pred set_goal_contexts_expr(prog_context::in, hlds_goal_expr::in,
- hlds_goal_expr::out) is det.
-
-set_goal_contexts_expr(Context, conj(ConjType, Goals0), conj(ConjType, Goals)) :-
- list.map(set_goal_contexts(Context), Goals0, Goals).
-set_goal_contexts_expr(Context, disj(Goals0), disj(Goals)) :-
- list.map(set_goal_contexts(Context), Goals0, Goals).
-set_goal_contexts_expr(Context, if_then_else(Vars, Cond0, Then0, Else0),
- if_then_else(Vars, Cond, Then, Else)) :-
- set_goal_contexts(Context, Cond0, Cond),
- set_goal_contexts(Context, Then0, Then),
- set_goal_contexts(Context, Else0, Else).
-set_goal_contexts_expr(Context, switch(Var, CanFail, Cases0),
- switch(Var, CanFail, Cases)) :-
- list.map(set_goal_contexts_case(Context), Cases0, Cases).
-set_goal_contexts_expr(Context, scope(Reason, Goal0), scope(Reason, Goal)) :-
- set_goal_contexts(Context, Goal0, Goal).
-set_goal_contexts_expr(Context, negation(Goal0), negation(Goal)) :-
- set_goal_contexts(Context, Goal0, Goal).
-set_goal_contexts_expr(_, Goal, Goal) :-
- Goal = plain_call(_, _, _, _, _, _).
-set_goal_contexts_expr(_, Goal, Goal) :-
- Goal = generic_call(_, _, _, _).
-set_goal_contexts_expr(_, Goal, Goal) :-
- Goal = unify(_, _, _, _, _).
-set_goal_contexts_expr(_, Goal, Goal) :-
- Goal = call_foreign_proc(_, _, _, _, _, _, _).
-set_goal_contexts_expr(Context,
- shorthand(ShorthandGoal0), shorthand(ShorthandGoal)) :-
- set_goal_contexts_shorthand(Context, ShorthandGoal0, ShorthandGoal).
-
-:- pred set_goal_contexts_shorthand(prog_context::in,
- shorthand_goal_expr::in, shorthand_goal_expr::out) is det.
-
-set_goal_contexts_shorthand(Context,
- bi_implication(LHS0, RHS0), bi_implication(LHS, RHS)) :-
- set_goal_contexts(Context, LHS0, LHS),
- set_goal_contexts(Context, RHS0, RHS).
-
%-----------------------------------------------------------------------------%
create_pure_atomic_complicated_unification(LHS, RHS, Context,
Index: compiler/hlds_module.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_module.m,v
retrieving revision 1.156
diff -u -b -r1.156 hlds_module.m
--- compiler/hlds_module.m 15 Feb 2008 02:26:54 -0000 1.156
+++ compiler/hlds_module.m 15 Feb 2008 02:42:09 -0000
@@ -635,6 +635,9 @@
:- pred module_info_next_lambda_count(prog_context::in, int::out,
module_info::in, module_info::out) is det.
+:- pred module_info_next_atomic_count(prog_context::in, int::out,
+ module_info::in, module_info::out) is det.
+
:- pred module_info_next_model_non_pragma_count(int::out,
module_info::in, module_info::out) is det.
@@ -673,6 +676,12 @@
:- pred module_info_set_lambdas_per_context(map(prog_context, counter)::in,
module_info::in, module_info::out) is det.
+:- pred module_info_get_atomics_per_context(module_info::in,
+ map(prog_context, counter)::out) is det.
+
+:- pred module_info_set_atomics_per_context(map(prog_context, counter)::in,
+ module_info::in, module_info::out) is det.
+
:- pred module_info_get_model_non_pragma_counter(module_info::in, counter::out)
is det.
@@ -759,6 +768,12 @@
% expressions that appear on the same line of the same file.
lambdas_per_context :: map(prog_context, counter),
+ % How many STM atomic expressions there are at different
+ % contexts in the module. This is used to uniquely identify
+ % STM atomic expressions that appear on the same line of
+ % the same file.
+ atomics_per_context :: map(prog_context, counter),
+
% Used to ensure uniqueness of the structure types defined
% so far for model_non foreign_procs.
model_non_pragma_counter :: counter,
@@ -839,6 +854,7 @@
map.init(TablingStructMap),
map.init(MM_TablingInfo),
map.init(LambdasPerContext),
+ map.init(AtomicsPerContext),
counter.init(1, ModelNonPragmaCounter),
% The builtin modules are automatically imported.
@@ -872,7 +888,8 @@
MaybeDependencyInfo, NumErrors, PragmaExportedProcs,
MustBeStratifiedPreds, StratPreds, UnusedArgInfo,
ExceptionInfo, TrailingInfo, TablingStructMap, MM_TablingInfo,
- LambdasPerContext, ModelNonPragmaCounter, ImportedModules,
+ LambdasPerContext, AtomicsPerContext, ModelNonPragmaCounter,
+ ImportedModules,
IndirectlyImportedModules, TypeSpecInfo, NoTagTypes,
MaybeComplexityMap, ComplexityProcInfos,
AnalysisInfo, UserInitPredCNames, UserFinalPredCNames,
@@ -968,6 +985,7 @@
module_info_get_table_struct_map(MI, MI ^ sub_info ^ table_struct_map).
module_info_get_mm_tabling_info(MI, MI ^ sub_info ^ mm_tabling_info).
module_info_get_lambdas_per_context(MI, MI ^ sub_info ^ lambdas_per_context).
+module_info_get_atomics_per_context(MI, MI ^ sub_info ^ atomics_per_context).
module_info_get_model_non_pragma_counter(MI,
MI ^ sub_info ^ model_non_pragma_counter).
module_info_get_imported_module_specifiers(MI,
@@ -1100,6 +1118,8 @@
MI ^ sub_info ^ mm_tabling_info := NewVal).
module_info_set_lambdas_per_context(NewVal, MI,
MI ^ sub_info ^ lambdas_per_context := NewVal).
+module_info_set_atomics_per_context(NewVal, MI,
+ MI ^ sub_info ^ atomics_per_context := NewVal).
module_info_set_model_non_pragma_counter(NewVal, MI,
MI ^ sub_info ^ model_non_pragma_counter := NewVal).
module_add_imported_module_specifiers(IStat, ModuleSpecifiers, !MI) :-
@@ -1268,6 +1288,21 @@
),
module_info_set_lambdas_per_context(ContextCounter, !MI).
+module_info_next_atomic_count(Context, Count, !MI) :-
+ module_info_get_atomics_per_context(!.MI, ContextCounter0),
+ (
+ map.insert(ContextCounter0, Context, counter.init(2),
+ FoundContextCounter)
+ ->
+ Count = 1,
+ ContextCounter = FoundContextCounter
+ ;
+ map.lookup(ContextCounter0, Context, Counter0),
+ counter.allocate(Count, Counter0, Counter),
+ map.det_update(ContextCounter0, Context, Counter, ContextCounter)
+ ),
+ module_info_set_atomics_per_context(ContextCounter, !MI).
+
module_info_next_model_non_pragma_count(Count, !MI) :-
module_info_get_model_non_pragma_counter(!.MI, Counter0),
counter.allocate(Count, Counter0, Counter),
Index: compiler/hlds_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_out.m,v
retrieving revision 1.443
diff -u -b -r1.443 hlds_out.m
--- compiler/hlds_out.m 11 Feb 2008 21:25:55 -0000 1.443
+++ compiler/hlds_out.m 12 Feb 2008 01:22:18 -0000
@@ -2104,24 +2104,80 @@
write_goal_2_shorthand(ShortHandGoal, ModuleInfo, VarSet, AppendVarNums,
Indent, Follow, TypeQual, !IO).
+:- pred write_atomic_interface_vars(string::in, atomic_interface_vars::in,
+ prog_varset::in, bool::in, io::di, io::uo) is det.
+
+write_atomic_interface_vars(CompName, CompState, VarSet, AppendVarNums, !IO) :-
+ io.write_string(CompName, !IO),
+ io.write_string("(", !IO),
+ CompState = atomic_interface_vars(Var1, Var2),
+ mercury_output_var(VarSet, AppendVarNums, Var1, !IO),
+ io.write_string(", ", !IO),
+ mercury_output_var(VarSet, AppendVarNums, Var2, !IO),
+ io.write_string(")", !IO).
+
+:- pred write_or_else_list(hlds_goals::in, module_info::in, prog_varset::in,
+ bool::in, int::in, string::in, maybe_vartypes::in, io::di, io::uo) is det.
+
+write_or_else_list([], _, _, _, _, _, _, !IO).
+write_or_else_list([Goal | Goals], ModuleInfo, VarSet, AppendVarNums, Indent,
+ Follow, TypeQual, !IO) :-
+ write_indent(Indent, !IO),
+ io.write_string("or_else\n", !IO),
+ write_goal_a(Goal, ModuleInfo, VarSet, AppendVarNums, Indent+1, Follow,
+ TypeQual, !IO),
+ write_or_else_list(Goals, ModuleInfo, VarSet, AppendVarNums, Indent+1,
+ Follow, TypeQual, !IO).
+
:- pred write_goal_2_shorthand(shorthand_goal_expr::in, module_info::in,
prog_varset::in, bool::in, int::in, string::in, maybe_vartypes::in,
io::di, io::uo) is det.
-write_goal_2_shorthand(bi_implication(LHS, RHS), ModuleInfo, VarSet,
- AppendVarNums, Indent, Follow, TypeQual, !IO) :-
+write_goal_2_shorthand(ShortHand, ModuleInfo, VarSet, AppendVarNums,
+ Indent, Follow, TypeQual, !IO) :-
+ (
+ ShortHand = atomic_goal(_GoalType, Outer, Inner, MaybeOutputVars,
+ MainGoal, OrElseGoals),
+ write_indent(Indent, !IO),
+ io.write_string("atomic [", !IO),
+ write_atomic_interface_vars("outer", Outer, VarSet, AppendVarNums,
+ !IO),
+ io.write_string(" ", !IO),
+ write_atomic_interface_vars("inner", Inner, VarSet, AppendVarNums,
+ !IO),
+ io.write_string(" ", !IO),
+ (
+ MaybeOutputVars = no
+ ;
+ MaybeOutputVars = yes(OutputVars),
+ io.write_string("vars([", !IO),
+ mercury_output_vars(VarSet, AppendVarNums, OutputVars, !IO),
+ io.write_string("])", !IO)
+ ),
+ io.write_string("] (\n",!IO),
+
+ write_goal_a(MainGoal, ModuleInfo, VarSet, AppendVarNums,
+ Indent + 1, "\n", TypeQual, !IO),
+ write_goal_list(OrElseGoals, ModuleInfo, VarSet, AppendVarNums,
+ Indent, "or_else\n", TypeQual, !IO),
+ write_indent(Indent, !IO),
+ io.write_string(")", !IO),
+ io.write_string(Follow, !IO)
+ ;
+ ShortHand = bi_implication(GoalA, GoalB),
write_indent(Indent, !IO),
io.write_string("( % bi-implication\n", !IO),
Indent1 = Indent + 1,
- write_goal_a(LHS, ModuleInfo, VarSet, AppendVarNums, Indent1, "\n",
+ write_goal_a(GoalA, ModuleInfo, VarSet, AppendVarNums, Indent1, "\n",
TypeQual, !IO),
write_indent(Indent, !IO),
io.write_string("<=>\n", !IO),
- write_goal_a(RHS, ModuleInfo, VarSet, AppendVarNums, Indent1, "\n",
+ write_goal_a(GoalB, ModuleInfo, VarSet, AppendVarNums, Indent1, "\n",
TypeQual, !IO),
write_indent(Indent, !IO),
io.write_string(")", !IO),
- io.write_string(Follow, !IO).
+ io.write_string(Follow, !IO)
+ ).
:- pred write_trace_mutable_var_hlds(int::in, trace_mutable_var_hlds::in,
io::di, io::uo) is det.
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.237
diff -u -b -r1.237 hlds_pred.m
--- compiler/hlds_pred.m 11 Feb 2008 21:25:56 -0000 1.237
+++ compiler/hlds_pred.m 12 Feb 2008 01:22:18 -0000
@@ -425,8 +425,7 @@
:- type attribute
---> custom(mer_type).
% A custom attribute, indended to be associated
- % with this predicate in the underlying
- % implementation.
+ % with this predicate in the underlying implementation.
:- type pred_transformation
---> transform_higher_order_specialization(
@@ -468,6 +467,7 @@
% pointer.
)
; transform_table_generator
+ ; transform_stm_expansion
; transform_dnf(
int % This predicate was originally part of a predicate
% transformed into disjunctive normal form; this integer
@@ -507,6 +507,10 @@
% The predicate is a normal user-written predicate;
% the string is its name.
+:- type need_to_requantify
+ ---> need_to_requantify
+ ; do_not_need_to_requantify.
+
% pred_info_init(ModuleName, SymName, Arity, PredOrFunc, Context,
% Origin, Status, GoalType, Markers, ArgTypes, TypeVarSet,
% ExistQVars, ClassContext, ClassProofs, ClassConstraintMap,
@@ -2003,8 +2007,8 @@
is semidet.
:- pred proc_info_set_imported_structure_reuse(prog_vars::in,
- list(mer_type)::in, structure_reuse_domain::in, proc_info::in,
- proc_info::out) is det.
+ list(mer_type)::in, structure_reuse_domain::in,
+ proc_info::in, proc_info::out) is det.
:- pred proc_info_reset_imported_structure_reuse(proc_info::in,
proc_info::out) is det.
@@ -2020,7 +2024,8 @@
is det.
% proc_info_never_succeeds(ProcInfo, Result):
- % return Result = yes if the procedure is known to never succeed
+ %
+ % Return Result = yes if the procedure is known to never succeed
% according to the declared determinism.
%
:- pred proc_info_never_succeeds(proc_info::in, bool::out) is det.
@@ -2456,8 +2461,7 @@
MaybeDeclaredDetism, Detism, Goal, yes, ModeErrors,
RttiVarMaps, eval_normal, ProcSubInfo).
-proc_info_set_body(VarSet, VarTypes, HeadVars, Goal, RttiVarMaps,
- !ProcInfo) :-
+proc_info_set_body(VarSet, VarTypes, HeadVars, Goal, RttiVarMaps, !ProcInfo) :-
!:ProcInfo = !.ProcInfo ^ prog_varset := VarSet,
!:ProcInfo = !.ProcInfo ^ var_types := VarTypes,
!:ProcInfo = !.ProcInfo ^ head_vars := HeadVars,
@@ -2642,8 +2646,7 @@
!:ProcInfo = !.ProcInfo ^ proc_sub_info ^ structure_sharing
^ maybe_sharing := yes(Sharing).
-proc_info_get_imported_structure_sharing(ProcInfo, HeadVars, Types,
- Sharing) :-
+proc_info_get_imported_structure_sharing(ProcInfo, HeadVars, Types, Sharing) :-
MaybeImportedSharing = ProcInfo ^ proc_sub_info ^ structure_sharing
^ maybe_imported_sharing,
MaybeImportedSharing = yes(ImportedSharing),
@@ -2667,8 +2670,7 @@
!:ProcInfo = !.ProcInfo ^ proc_sub_info ^ structure_reuse
^ maybe_reuse := yes(Reuse).
-proc_info_get_imported_structure_reuse(ProcInfo, HeadVars, Types,
- Reuse) :-
+proc_info_get_imported_structure_reuse(ProcInfo, HeadVars, Types, Reuse) :-
MaybeImportedReuse = ProcInfo ^ proc_sub_info ^ structure_reuse
^ maybe_imported_reuse,
MaybeImportedReuse = yes(ImportedReuse),
@@ -3144,7 +3146,7 @@
% a cannot_fail execution path is guaranteed not to go through a call
% to a predicate that is mutually recursive with this one, which (if this
% predicate is minimal model) is the only way that the predicate can be
- % properly cannot_fail. The problem is that in in general, the mutually
+ % properly cannot_fail. The problem is that in general, the mutually
% recursive predicate may be in another module.
%
% Reason 2:
Index: compiler/implicit_parallelism.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/implicit_parallelism.m,v
retrieving revision 1.6
diff -u -b -r1.6 implicit_parallelism.m
--- compiler/implicit_parallelism.m 30 Dec 2007 08:23:43 -0000 1.6
+++ compiler/implicit_parallelism.m 6 Jan 2008 09:37:32 -0000
@@ -123,16 +123,16 @@
:- pred process_preds_for_implicit_parallelism(list(pred_id)::in,
list(candidate_call_site)::in, module_info::in, module_info::out) is det.
-process_preds_for_implicit_parallelism([], _ListCandidateCallSite,
- !ModuleInfo).
-process_preds_for_implicit_parallelism([PredId | PredIdList],
- ListCandidateCallSite, !ModuleInfo) :-
+process_preds_for_implicit_parallelism([],
+ _CandidateCallSites, !ModuleInfo).
+process_preds_for_implicit_parallelism([PredId | PredIds],
+ CandidateCallSites, !ModuleInfo) :-
module_info_pred_info(!.ModuleInfo, PredId, PredInfo),
ProcIds = pred_info_non_imported_procids(PredInfo),
process_procs_for_implicit_parallelism(PredId, ProcIds,
- ListCandidateCallSite, !ModuleInfo),
- process_preds_for_implicit_parallelism(PredIdList,
- ListCandidateCallSite, !ModuleInfo).
+ CandidateCallSites, !ModuleInfo),
+ process_preds_for_implicit_parallelism(PredIds,
+ CandidateCallSites, !ModuleInfo).
% Process procedures for implicit parallelism.
%
@@ -141,21 +141,20 @@
module_info::in, module_info::out) is det.
process_procs_for_implicit_parallelism(_PredId, [],
- _ListCandidateCallSite, !ModuleInfo).
+ _CandidateCallSites, !ModuleInfo).
process_procs_for_implicit_parallelism(PredId, [ProcId | ProcIds],
- ListCandidateCallSite, !ModuleInfo) :-
+ CandidateCallSites, !ModuleInfo) :-
module_info_pred_proc_info(!.ModuleInfo, PredId, ProcId,
PredInfo0, ProcInfo0),
% Initialize the counter for the slot number.
SiteNumCounter = counter.init(0),
pred_proc_id_to_raw_id(PredInfo0, ProcId, CallerRawId),
- get_callees_feedback(CallerRawId, ListCandidateCallSite, [],
- CallSites),
+ get_callees_feedback(CallerRawId, CandidateCallSites, [], CallSites),
list.length(CallSites, NumCallSites),
( NumCallSites = 0 ->
% No candidate calls for implicit parallelism in this procedure.
process_procs_for_implicit_parallelism(PredId, ProcIds,
- ListCandidateCallSite, !ModuleInfo)
+ CandidateCallSites, !ModuleInfo)
;
proc_info_get_goal(ProcInfo0, Body0),
process_goal_for_implicit_parallelism(Body0, Body, ProcInfo0,
@@ -163,13 +162,12 @@
proc_info_set_goal(Body, ProcInfo0, ProcInfo1),
proc_info_set_has_parallel_conj(yes, ProcInfo1, ProcInfo2),
requantify_proc(ProcInfo2, ProcInfo3),
- RecomputeAtomic = no,
- recompute_instmap_delta_proc(RecomputeAtomic, ProcInfo3, ProcInfo,
- !ModuleInfo),
+ recompute_instmap_delta_proc(do_not_recompute_atomic_instmap_deltas,
+ ProcInfo3, ProcInfo, !ModuleInfo),
pred_info_set_proc_info(ProcId, ProcInfo, PredInfo0, PredInfo),
module_info_set_pred_info(PredId, PredInfo, !ModuleInfo),
process_procs_for_implicit_parallelism(PredId, ProcIds,
- ListCandidateCallSite, !ModuleInfo)
+ CandidateCallSites, !ModuleInfo)
).
% Filter the list of call site information from the feedback file so that
@@ -180,15 +178,15 @@
list(candidate_call_site)::in, list(candidate_call_site)::out) is det.
get_callees_feedback(_Caller, [], !ResultAcc).
-get_callees_feedback(Caller, [CandidateCallSite | ListCandidateCallSite],
+get_callees_feedback(Caller, [CandidateCallSite | CandidateCallSites],
!ResultAcc) :-
CandidateCallSite = candidate_call_site(CSSCaller, _, _, _),
( Caller = CSSCaller ->
- !:ResultAcc = [CandidateCallSite | !.ResultAcc],
- get_callees_feedback(Caller, ListCandidateCallSite, !ResultAcc)
+ !:ResultAcc = [CandidateCallSite | !.ResultAcc]
;
- get_callees_feedback(Caller, ListCandidateCallSite, !ResultAcc)
- ).
+ true
+ ),
+ get_callees_feedback(Caller, CandidateCallSites, !ResultAcc).
% Process a goal for implicit parallelism.
% MaybeConj is the conjunction which contains Goal.
@@ -200,7 +198,7 @@
counter::in, counter::out) is det.
process_goal_for_implicit_parallelism(!Goal, ProcInfo, !ModuleInfo,
- !MaybeConj, !IndexInConj, !CalleeListToBeParallelized, !SiteNumCounter) :-
+ !MaybeConj, !IndexInConj, !CalleesToBeParallelized, !SiteNumCounter) :-
!.Goal = hlds_goal(GoalExpr0, GoalInfo),
(
GoalExpr0 = unify(_, _, _, _, _),
@@ -208,14 +206,14 @@
;
GoalExpr0 = plain_call(_, _, _, _, _, _),
process_call_for_implicit_parallelism(!.Goal, ProcInfo, !ModuleInfo,
- !IndexInConj, !MaybeConj, !CalleeListToBeParallelized,
+ !IndexInConj, !MaybeConj, !CalleesToBeParallelized,
!SiteNumCounter)
% We deal with the index in the conjunction in
% process_call_for_implicit_parallelism.
;
GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _),
process_call_for_implicit_parallelism(!.Goal, ProcInfo, !ModuleInfo,
- !IndexInConj, !MaybeConj, !CalleeListToBeParallelized,
+ !IndexInConj, !MaybeConj, !CalleesToBeParallelized,
!SiteNumCounter)
;
GoalExpr0 = generic_call(Details, _, _, _),
@@ -223,12 +221,12 @@
Details = higher_order(_, _, _, _),
process_call_for_implicit_parallelism(!.Goal, ProcInfo,
!ModuleInfo, !IndexInConj, !MaybeConj,
- !CalleeListToBeParallelized, !SiteNumCounter)
+ !CalleesToBeParallelized, !SiteNumCounter)
;
Details = class_method(_, _, _, _),
process_call_for_implicit_parallelism(!.Goal, ProcInfo,
!ModuleInfo, !IndexInConj, !MaybeConj,
- !CalleeListToBeParallelized, !SiteNumCounter)
+ !CalleesToBeParallelized, !SiteNumCounter)
;
Details = event_call(_),
increment_index_if_in_conj(!.MaybeConj, !IndexInConj)
@@ -242,69 +240,68 @@
% slot number.
GoalExpr0 = conj(_, _),
process_conj_for_implicit_parallelism(GoalExpr0, GoalExpr, 1,
- ProcInfo, !ModuleInfo, !CalleeListToBeParallelized,
- !SiteNumCounter),
+ ProcInfo, !ModuleInfo, !CalleesToBeParallelized, !SiteNumCounter),
% A plain conjunction will never be contained in an other plain
- % conjunction. As for parallel conjunctions, they will not
- % be modified. Therefore, incrementing the index suffices (no need to
- % call update_conj_and_index).
+ % conjunction. As for parallel conjunctions, they will not be modified.
+ % Therefore, incrementing the index suffices (no need to call
+ % update_conj_and_index).
!:Goal = hlds_goal(GoalExpr, GoalInfo),
increment_index_if_in_conj(!.MaybeConj, !IndexInConj)
;
GoalExpr0 = disj(Goals0),
process_disj_for_implicit_parallelism(Goals0, [], Goals,
- ProcInfo, !ModuleInfo, !CalleeListToBeParallelized,
+ ProcInfo, !ModuleInfo, !CalleesToBeParallelized,
!SiteNumCounter),
- GoalProcessed = hlds_goal(disj(Goals), GoalInfo),
- update_conj_and_index(!MaybeConj, GoalProcessed, !IndexInConj),
+ GoalExpr = disj(Goals),
% If we are not in a conjunction, then we need to return the modified
- % value of Goal. In we are in a conjunction, that information is not
+ % value of Goal. If we are in a conjunction, that information is not
% read (see process_conj_for_implicit_parallelism).
- !:Goal = GoalProcessed
+ !:Goal = hlds_goal(GoalExpr, GoalInfo),
+ update_conj_and_index(!MaybeConj, !.Goal, !IndexInConj)
;
GoalExpr0 = switch(Var, CanFail, Cases0),
process_switch_cases_for_implicit_parallelism(Cases0, [], Cases,
- ProcInfo, !ModuleInfo, !CalleeListToBeParallelized,
- !SiteNumCounter),
- GoalProcessed = hlds_goal(switch(Var, CanFail, Cases), GoalInfo),
- update_conj_and_index(!MaybeConj, GoalProcessed, !IndexInConj),
- !:Goal = GoalProcessed
+ ProcInfo, !ModuleInfo, !CalleesToBeParallelized, !SiteNumCounter),
+ GoalExpr = switch(Var, CanFail, Cases),
+ !:Goal = hlds_goal(GoalExpr, GoalInfo),
+ update_conj_and_index(!MaybeConj, !.Goal, !IndexInConj)
;
GoalExpr0 = negation(Goal0),
process_goal_for_implicit_parallelism(Goal0, Goal, ProcInfo,
- !ModuleInfo, !MaybeConj, !IndexInConj, !CalleeListToBeParallelized,
+ !ModuleInfo, !MaybeConj, !IndexInConj, !CalleesToBeParallelized,
!SiteNumCounter),
- GoalProcessed = hlds_goal(negation(Goal), GoalInfo),
- update_conj_and_index(!MaybeConj, GoalProcessed, !IndexInConj),
- !:Goal = GoalProcessed
+ GoalExpr = negation(Goal),
+ !:Goal = hlds_goal(GoalExpr, GoalInfo),
+ update_conj_and_index(!MaybeConj, !.Goal, !IndexInConj)
;
GoalExpr0 = scope(Reason, Goal0),
% 0 is the default value when we are not in a conjunction (in this case
% a scope).
process_goal_for_implicit_parallelism(Goal0, Goal, ProcInfo,
- !ModuleInfo, no, _, 0, _, !CalleeListToBeParallelized,
+ !ModuleInfo, no, _, 0, _, !CalleesToBeParallelized,
!SiteNumCounter),
- GoalProcessed = hlds_goal(scope(Reason, Goal), GoalInfo),
- update_conj_and_index(!MaybeConj, GoalProcessed, !IndexInConj),
- !:Goal = GoalProcessed
+ GoalExpr = scope(Reason, Goal),
+ !:Goal = hlds_goal(GoalExpr, GoalInfo),
+ update_conj_and_index(!MaybeConj, !.Goal, !IndexInConj)
;
GoalExpr0 = if_then_else(Vars, Cond0, Then0, Else0),
process_goal_for_implicit_parallelism(Cond0, Cond, ProcInfo,
- !ModuleInfo, no, _, 0, _, !CalleeListToBeParallelized,
+ !ModuleInfo, no, _, 0, _, !CalleesToBeParallelized,
!SiteNumCounter),
process_goal_for_implicit_parallelism(Then0, Then, ProcInfo,
- !ModuleInfo, no, _, 0, _, !CalleeListToBeParallelized,
+ !ModuleInfo, no, _, 0, _, !CalleesToBeParallelized,
!SiteNumCounter),
process_goal_for_implicit_parallelism(Else0, Else, ProcInfo,
- !ModuleInfo, no, _, 0, _, !CalleeListToBeParallelized,
+ !ModuleInfo, no, _, 0, _, !CalleesToBeParallelized,
!SiteNumCounter),
- GoalProcessed = hlds_goal(if_then_else(Vars, Cond, Then, Else),
- GoalInfo),
- update_conj_and_index(!MaybeConj, GoalProcessed, !IndexInConj),
- !:Goal = GoalProcessed
+ GoalExpr = if_then_else(Vars, Cond, Then, Else),
+ !:Goal = hlds_goal(GoalExpr, GoalInfo),
+ update_conj_and_index(!MaybeConj, !.Goal, !IndexInConj)
;
GoalExpr0 = shorthand(_),
- increment_index_if_in_conj(!.MaybeConj, !IndexInConj)
+ % These should have been expanded out by now.
+ unexpected(this_file,
+ "process_goal_for_implicit_parallelism: shorthand")
).
% Increment the index if we are in a conjunction.
@@ -329,7 +326,7 @@
counter::in, counter::out) is det.
process_call_for_implicit_parallelism(Call, ProcInfo, !ModuleInfo,
- !IndexInConj, !MaybeConj, !CalleeListToBeParallelized, !SiteNumCounter) :-
+ !IndexInConj, !MaybeConj, !CalleesToBeParallelized, !SiteNumCounter) :-
counter.allocate(SlotNumber, !SiteNumCounter),
get_call_kind_and_callee(!.ModuleInfo, Call, Kind, CalleeRawId),
(
@@ -338,12 +335,12 @@
->
(
is_in_css_list_to_be_parallelized(Kind, SlotNumber, CalleeRawId,
- !.CalleeListToBeParallelized, [], !:CalleeListToBeParallelized)
+ !.CalleesToBeParallelized, [], !:CalleesToBeParallelized)
->
(
build_goals_surrounded_by_calls_to_be_parallelized(ConjGoals0,
!.ModuleInfo, [Call], Goals, !.IndexInConj + 1, End,
- !SiteNumCounter, !CalleeListToBeParallelized)
+ !SiteNumCounter, !CalleesToBeParallelized)
->
parallelize_calls(Goals, !.IndexInConj, End, Conj0, Conj,
ProcInfo, !ModuleInfo),
@@ -351,7 +348,7 @@
!:MaybeConj = yes(Conj)
;
% The next call is not in the feedback file or we've hit a
- % plain conjunction/disjunction/switch/if then else.
+ % plain conjunction/disjunction/switch/if_then_else.
!:IndexInConj = !.IndexInConj + 1
)
;
@@ -374,14 +371,12 @@
GoalExpr = Call ^ hlds_goal_expr,
(
GoalExpr = plain_call(PredId, ProcId, _, _, _, _),
- module_info_pred_proc_info(ModuleInfo, PredId, ProcId,
- PredInfo, _),
+ module_info_pred_proc_info(ModuleInfo, PredId, ProcId, PredInfo, _),
pred_proc_id_to_raw_id(PredInfo, ProcId, CalleeRawId),
Kind = csk_normal
;
GoalExpr = call_foreign_proc(_, PredId, ProcId, _, _, _, _),
- module_info_pred_proc_info(ModuleInfo, PredId, ProcId,
- PredInfo, _),
+ module_info_pred_proc_info(ModuleInfo, PredId, ProcId, PredInfo, _),
pred_proc_id_to_raw_id(PredInfo, ProcId, CalleeRawId),
Kind = csk_special
;
@@ -396,10 +391,10 @@
Kind = csk_method
;
Details = event_call(_),
- unexpected(this_file, "get_call_kind_and_callee")
+ unexpected(this_file, "get_call_kind_and_callee: event_call")
;
Details = cast(_),
- unexpected(this_file, "get_call_kind_and_callee")
+ unexpected(this_file, "get_call_kind_and_callee: cast")
)
;
% XXX Some of our callers can call us with these kinds of goals.
@@ -446,8 +441,8 @@
CandidateCallSites = [],
fail
;
- CandidateCallSites = [CandidateCallSite | CandidateCallSitesTail],
- CandidateCallSite = candidate_call_site(_, CSSSlotNumber, CSSKind,
+ CandidateCallSites = [HeadCandidateCallSite | TailCandidateCallSites],
+ HeadCandidateCallSite = candidate_call_site(_, CSSSlotNumber, CSSKind,
CSSCallee),
% =< because there is not a one to one correspondance with the source
% code. New calls might have been added by the previous passes of the
@@ -457,11 +452,11 @@
CSSKind = Kind,
CSSCallee = CalleeRawId
->
- !:ResultAcc = !.ResultAcc ++ CandidateCallSitesTail
+ !:ResultAcc = !.ResultAcc ++ TailCandidateCallSites
;
- !:ResultAcc = !.ResultAcc ++ [CandidateCallSite],
+ !:ResultAcc = !.ResultAcc ++ [HeadCandidateCallSite],
is_in_css_list_to_be_parallelized(Kind, SlotNumber, CalleeRawId,
- CandidateCallSitesTail, !ResultAcc)
+ TailCandidateCallSites, !ResultAcc)
)
).
@@ -479,7 +474,7 @@
is semidet.
build_goals_surrounded_by_calls_to_be_parallelized(ConjGoals, ModuleInfo,
- !ResultAcc, !Index, !SiteNumCounter, !CalleeListToBeParallelized) :-
+ !ResultAcc, !Index, !SiteNumCounter, !CalleesToBeParallelized) :-
list.length(ConjGoals, Length),
( !.Index > Length ->
fail
@@ -505,21 +500,21 @@
CalleeRawId),
(
is_in_css_list_to_be_parallelized(Kind, SlotNumber,
- CalleeRawId, !.CalleeListToBeParallelized, [],
- !:CalleeListToBeParallelized)
+ CalleeRawId, !.CalleesToBeParallelized,
+ [], !:CalleesToBeParallelized)
->
true
;
!:Index = !.Index + 1,
build_goals_surrounded_by_calls_to_be_parallelized(
ConjGoals, ModuleInfo, !ResultAcc, !Index,
- !SiteNumCounter, !CalleeListToBeParallelized)
+ !SiteNumCounter, !CalleesToBeParallelized)
)
;
!:Index = !.Index + 1,
build_goals_surrounded_by_calls_to_be_parallelized(
ConjGoals, ModuleInfo, !ResultAcc, !Index,
- !SiteNumCounter, !CalleeListToBeParallelized)
+ !SiteNumCounter, !CalleesToBeParallelized)
)
)
)
@@ -538,6 +533,8 @@
% Call here includes higher-order and class method calls.
% Fail otherwise.
%
+ % XXX Should be a function returning a bool or something similar.
+ %
:- pred goal_is_call_or_negated_call(hlds_goal::in) is semidet.
goal_is_call_or_negated_call(Goal) :-
@@ -571,9 +568,9 @@
).
% Parallelize two calls/a call and a parallel conjunction which might have
- % goals between them. If these have no dependencies with the first call then
- % we move them before the first call and parallelize the two calls/call and
- % parallel conjunction.
+ % goals between them. If these have no dependencies with the first call
+ % then we move them before the first call and parallelize the two
+ % calls/call and parallel conjunction.
%
% Goals is contained in Conj.
%
@@ -735,7 +732,8 @@
ParallelGoalInfo1),
goal_info_set_instmap_delta(InstMapDelta, ParallelGoalInfo1,
ParallelGoalInfo2),
- goal_info_set_determinism(Detism, ParallelGoalInfo2, ParallelGoalInfo3),
+ goal_info_set_determinism(Detism,
+ ParallelGoalInfo2, ParallelGoalInfo3),
goal_info_set_purity(Purity, ParallelGoalInfo3, ParallelGoalInfo),
ParallelGoalExpr = conj(parallel_conj, GoalList),
ParallelGoal = hlds_goal(ParallelGoalExpr, ParallelGoalInfo)
@@ -748,7 +746,9 @@
%
:- pred goal_depends_on_goal(hlds_goal::in, hlds_goal::in) is semidet.
-goal_depends_on_goal(hlds_goal(_, GoalInfo1), hlds_goal(_, GoalInfo2)) :-
+goal_depends_on_goal(Goal1, Goal2) :-
+ Goal1 = hlds_goal(_, GoalInfo1),
+ Goal2 = hlds_goal(_, GoalInfo2),
InstmapDelta1 = goal_info_get_instmap_delta(GoalInfo1),
instmap_delta_changed_vars(InstmapDelta1, ChangedVars1),
NonLocals2 = goal_info_get_nonlocals(GoalInfo2),
@@ -764,7 +764,7 @@
counter::in, counter::out) is det.
process_conj_for_implicit_parallelism(!GoalExpr, IndexInConj, ProcInfo,
- !ModuleInfo, !CalleeListToBeParallelized, !SiteNumCounter) :-
+ !ModuleInfo, !CalleesToBeParallelized, !SiteNumCounter) :-
( !.GoalExpr = conj(_, GoalsConj) ->
list.length(GoalsConj, Length),
( IndexInConj > Length ->
@@ -776,14 +776,14 @@
% MaybeConj matters.
process_goal_for_implicit_parallelism(GoalInConj, _, ProcInfo,
!ModuleInfo, MaybeConj0, MaybeConj, IndexInConj, IndexInConj0,
- !CalleeListToBeParallelized, !SiteNumCounter),
+ !CalleesToBeParallelized, !SiteNumCounter),
( MaybeConj = yes(GoalExprProcessed) ->
!:GoalExpr = GoalExprProcessed
;
unexpected(this_file, "process_conj_for_implicit_parallelism")
),
process_conj_for_implicit_parallelism(!GoalExpr, IndexInConj0,
- ProcInfo, !ModuleInfo, !CalleeListToBeParallelized,
+ ProcInfo, !ModuleInfo, !CalleesToBeParallelized,
!SiteNumCounter)
)
;
@@ -799,14 +799,14 @@
counter::in, counter::out) is det.
process_disj_for_implicit_parallelism([], !GoalsAcc, _ProcInfo,
- !ModuleInfo, !CalleeListToBeParallelized, !SiteNumCounter).
+ !ModuleInfo, !CalleesToBeParallelized, !SiteNumCounter).
process_disj_for_implicit_parallelism([Goal0 | Goals], !GoalsAcc,
- ProcInfo, !ModuleInfo, !CalleeListToBeParallelized, !SiteNumCounter) :-
+ ProcInfo, !ModuleInfo, !CalleesToBeParallelized, !SiteNumCounter) :-
process_goal_for_implicit_parallelism(Goal0, Goal, ProcInfo,
- !ModuleInfo, no, _, 0, _, !CalleeListToBeParallelized, !SiteNumCounter),
+ !ModuleInfo, no, _, 0, _, !CalleesToBeParallelized, !SiteNumCounter),
!:GoalsAcc = !.GoalsAcc ++ [Goal],
process_disj_for_implicit_parallelism(Goals, !GoalsAcc, ProcInfo,
- !ModuleInfo, !CalleeListToBeParallelized, !SiteNumCounter).
+ !ModuleInfo, !CalleesToBeParallelized, !SiteNumCounter).
% If we are in a conjunction, update it by replacing the goal at index by
% Goal and increment the index.
@@ -833,16 +833,16 @@
counter::in, counter::out) is det.
process_switch_cases_for_implicit_parallelism([], !CasesAcc, _ProcInfo,
- !ModuleInfo, !CalleeListToBeParallelized, !SiteNumCounter).
+ !ModuleInfo, !CalleesToBeParallelized, !SiteNumCounter).
process_switch_cases_for_implicit_parallelism([Case0 | Cases], !CasesAcc,
- ProcInfo, !ModuleInfo, !CalleeListToBeParallelized, !SiteNumCounter) :-
+ ProcInfo, !ModuleInfo, !CalleesToBeParallelized, !SiteNumCounter) :-
Case0 = case(MainConsId, OtherConsIds, Goal0),
process_goal_for_implicit_parallelism(Goal0, Goal, ProcInfo,
- !ModuleInfo, no, _, 0, _, !CalleeListToBeParallelized, !SiteNumCounter),
+ !ModuleInfo, no, _, 0, _, !CalleesToBeParallelized, !SiteNumCounter),
Case = case(MainConsId, OtherConsIds, Goal),
!:CasesAcc = !.CasesAcc ++ [Case],
process_switch_cases_for_implicit_parallelism(Cases, !CasesAcc,
- ProcInfo, !ModuleInfo, !CalleeListToBeParallelized, !SiteNumCounter).
+ ProcInfo, !ModuleInfo, !CalleesToBeParallelized, !SiteNumCounter).
%-----------------------------------------------------------------------------%
@@ -851,30 +851,28 @@
:- pred parse_feedback_file(string::in,
maybe_error(list(candidate_call_site))::out, io::di, io::uo) is det.
-parse_feedback_file(InputFile, MaybeListCandidateCallSite, !IO) :-
+parse_feedback_file(InputFile, MaybeCandidateCallSites, !IO) :-
io.open_input(InputFile, Result, !IO),
(
Result = io.error(ErrInput),
- MaybeListCandidateCallSite = error(io.error_message(ErrInput))
+ MaybeCandidateCallSites = error(io.error_message(ErrInput))
;
Result = ok(Stream),
io.read_file_as_string(Stream, MaybeFileAsString, !IO),
(
MaybeFileAsString = ok(FileAsString),
- LineList = string.words_separator(is_carriage_return,
- FileAsString),
- process_header(LineList, MaybeBodyFileAsListString, !IO),
+ Lines = string.words_separator(is_carriage_return, FileAsString),
+ process_feedback_file_header(Lines, MaybeBodyLines, !IO),
(
- MaybeBodyFileAsListString = error(ErrProcessHeader),
- MaybeListCandidateCallSite = error(ErrProcessHeader)
+ MaybeBodyLines = error(HeaderError),
+ MaybeCandidateCallSites = error(HeaderError)
;
- MaybeBodyFileAsListString = ok(BodyFileAsListString),
- process_body(BodyFileAsListString, MaybeListCandidateCallSite)
+ MaybeBodyLines = ok(BodyLines),
+ process_feedback_file_body(BodyLines, MaybeCandidateCallSites)
)
;
- MaybeFileAsString = error(_, ErrReadFileAsString),
- MaybeListCandidateCallSite =
- error(io.error_message(ErrReadFileAsString))
+ MaybeFileAsString = error(_, ReadError),
+ MaybeCandidateCallSites = error(io.error_message(ReadError))
),
io.close_input(Stream, !IO)
).
@@ -886,83 +884,66 @@
% Process the header of the feedback file.
%
-:- pred process_header(list(string)::in, maybe_error(list(string))::out,
- io::di, io::uo) is det.
+:- pred process_feedback_file_header(list(string)::in,
+ maybe_error(list(string))::out, io::di, io::uo) is det.
-process_header(FileAsListString, MaybeFileAsListStringWithoutHeader, !IO) :-
- ( list.index0(FileAsListString, 0, Type) ->
- ( Type = "Profiling feedback file" ->
- (list.index0(FileAsListString, 1, Version) ->
- ( Version = "Version = 1.0" ->
- list.det_split_list(4, FileAsListString, _,
- FileAsListStringWithoutHeader),
- MaybeFileAsListStringWithoutHeader =
- ok(FileAsListStringWithoutHeader)
- ;
- MaybeFileAsListStringWithoutHeader =
- error("Profiling feedback file version incorrect")
- )
- ;
- MaybeFileAsListStringWithoutHeader =
- error("Not a profiling feedback file")
- )
+process_feedback_file_header(Lines, MaybeBodyLines, !IO) :-
+ (
+ Lines = [IdLine, VersionLine, _MeasureLine, _ThresholdLine
+ | BodyLines],
+ IdLine = "Profiling feedback file"
+ ->
+ ( VersionLine = "Version = 1.0" ->
+ MaybeBodyLines = ok(BodyLines)
;
- MaybeFileAsListStringWithoutHeader =
- error("Not a profiling feedback file")
+ MaybeBodyLines = error("Profiling feedback file version incorrect")
)
;
- MaybeFileAsListStringWithoutHeader =
- error("Not a profiling feedback file")
+ MaybeBodyLines = error("Not a profiling feedback file")
).
% Process the body of the feedback file.
%
-:- pred process_body(list(string)::in,
+:- pred process_feedback_file_body(list(string)::in,
maybe_error(list(candidate_call_site))::out) is det.
-process_body(CoreFileAsListString, MaybeListCandidateCallSite) :-
- ( process_body2(CoreFileAsListString, [], ListCandidateCallSite) ->
- MaybeListCandidateCallSite = ok(ListCandidateCallSite)
+process_feedback_file_body(BodyLines, MaybeCandidateCallSites) :-
+ ( process_feedback_file_body_2(BodyLines, [], CandidateCallSites) ->
+ MaybeCandidateCallSites = ok(CandidateCallSites)
;
- MaybeListCandidateCallSite =
+ MaybeCandidateCallSites =
error("Profiling feedback file is not well-formed")
).
-:- pred process_body2(list(string)::in, list(candidate_call_site)::in,
- list(candidate_call_site)::out) is semidet.
+:- pred process_feedback_file_body_2(list(string)::in,
+ list(candidate_call_site)::in, list(candidate_call_site)::out) is semidet.
-process_body2([], !ListCandidateCallSiteAcc).
-process_body2([Line | Lines], !ListCandidateCallSiteAcc) :-
+process_feedback_file_body_2([], !CandidateCallSites).
+process_feedback_file_body_2([Line | Lines], !CandidateCallSites) :-
Words = string.words_separator(is_whitespace, Line),
- list.index0_det(Words, 0, Caller),
+ Words = [Caller, SlotNumber, KindAsString | WordsTail],
( Caller = "Mercury" ->
- process_body2(Lines, !ListCandidateCallSiteAcc)
+ true
;
- list.index0_det(Words, 1, SlotNumber),
string.to_int(SlotNumber, IntSlotNumber),
- list.index0_det(Words, 2, KindAsString),
- ( construct_call_site_kind(KindAsString, Kind) ->
+ construct_call_site_kind(KindAsString, Kind),
(
Kind = csk_normal,
- list.index0_det(Words, 3, Callee)
+ WordsTail = [Callee]
;
( Kind = csk_higher_order
; Kind = csk_method
; Kind = csk_special
; Kind = csk_callback
),
+ WordsTail = [],
Callee = ""
),
CandidateCallSite = candidate_call_site(Caller, IntSlotNumber,
- Kind, Callee)
- ;
- % Unexpected call site kind.
- unexpected(this_file, "process_body2")
+ Kind, Callee),
+ !:CandidateCallSites = [CandidateCallSite | !.CandidateCallSites]
),
- !:ListCandidateCallSiteAcc =
- [CandidateCallSite | !.ListCandidateCallSiteAcc],
- process_body2(Lines, !ListCandidateCallSiteAcc)
- ).
+ process_feedback_file_body_2(Lines, !CandidateCallSites).
%-----------------------------------------------------------------------------%
Index: compiler/inlining.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/inlining.m,v
retrieving revision 1.158
diff -u -b -r1.158 inlining.m
--- compiler/inlining.m 30 Dec 2007 08:23:43 -0000 1.158
+++ compiler/inlining.m 6 Jan 2008 10:36:00 -0000
@@ -516,7 +516,8 @@
(
DidInlining = yes,
- recompute_instmap_delta_proc(yes, !ProcInfo, !ModuleInfo)
+ recompute_instmap_delta_proc(recompute_atomic_instmap_deltas,
+ !ProcInfo, !ModuleInfo)
;
DidInlining = no
),
@@ -553,6 +554,17 @@
inlining_in_goal(hlds_goal(GoalExpr0, GoalInfo0),
hlds_goal(GoalExpr, GoalInfo), !Info) :-
(
+ GoalExpr0 = plain_call(PredId, ProcId, ArgVars, Builtin, Context, Sym),
+ inlining_in_call(PredId, ProcId, ArgVars, Builtin,
+ Context, Sym, GoalExpr, GoalInfo0, GoalInfo, !Info)
+ ;
+ ( GoalExpr0 = generic_call(_, _, _, _)
+ ; GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _)
+ ; GoalExpr0 = unify(_, _, _, _, _)
+ ),
+ GoalExpr = GoalExpr0,
+ GoalInfo = GoalInfo0
+ ;
GoalExpr0 = conj(ConjType, Goals0),
(
ConjType = plain_conj,
@@ -591,20 +603,9 @@
GoalExpr = scope(Reason, SubGoal),
GoalInfo = GoalInfo0
;
- ( GoalExpr0 = generic_call(_, _, _, _)
- ; GoalExpr0 = unify(_, _, _, _, _)
- ; GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _)
- ),
- GoalExpr = GoalExpr0,
- GoalInfo = GoalInfo0
- ;
GoalExpr0 = shorthand(_),
% These should have been expanded out by now.
unexpected(this_file, "inlining_in_goal: unexpected shorthand")
- ;
- GoalExpr0 = plain_call(PredId, ProcId, ArgVars, Builtin, Context, Sym),
- inlining_in_call(PredId, ProcId, ArgVars, Builtin,
- Context, Sym, GoalExpr, GoalInfo0, GoalInfo, !Info)
).
:- pred inlining_in_call(pred_id::in, proc_id::in,
Index: compiler/intermod.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/intermod.m,v
retrieving revision 1.229
diff -u -b -r1.229 intermod.m
--- compiler/intermod.m 15 Feb 2008 02:26:54 -0000 1.229
+++ compiler/intermod.m 15 Feb 2008 02:42:09 -0000
@@ -456,7 +456,7 @@
FoundBranch0 = no,
FoundBranch = yes
;
- goal_is_atomic(GoalExpr),
+ goal_expr_has_subgoals(GoalExpr) = does_not_have_subgoals,
FoundBranch = FoundBranch0
),
goal_contains_one_branched_goal(Goals, FoundBranch).
@@ -519,9 +519,22 @@
% non-exported types, so we just write out the clauses.
intermod_traverse_goal_expr(Goal @ call_foreign_proc(_, _, _, _, _, _, _),
Goal, yes, !Info).
-intermod_traverse_goal_expr(shorthand(_), _, _, _, _) :-
+intermod_traverse_goal_expr(shorthand(ShortHand0), shorthand(ShortHand),
+ DoWrite, !Info) :-
+ (
+ ShortHand0 = atomic_goal(GoalType, Outer, Inner, MaybeOutputVars,
+ MainGoal0, OrElseGoals0),
+ intermod_traverse_goal(MainGoal0, MainGoal, DoWrite1, !Info),
+ intermod_traverse_list_of_goals(OrElseGoals0, OrElseGoals, DoWrite2,
+ !Info),
+ bool.and(DoWrite1, DoWrite2, DoWrite),
+ ShortHand = atomic_goal(GoalType, Outer, Inner, MaybeOutputVars,
+ MainGoal, OrElseGoals)
+ ;
+ ShortHand0 = bi_implication(_, _),
% These should have been expanded out by now.
- unexpected(this_file, "traverse_goal: unexpected shorthand").
+ unexpected(this_file, "intermod_traverse_goal_expr: bi_implication")
+ ).
:- pred intermod_traverse_list_of_goals(hlds_goals::in, hlds_goals::out,
bool::out, intermod_info::in, intermod_info::out) is det.
Index: compiler/interval.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/interval.m,v
retrieving revision 1.37
diff -u -b -r1.37 interval.m
--- compiler/interval.m 29 Jan 2008 04:59:39 -0000 1.37
+++ compiler/interval.m 29 Jan 2008 05:00:20 -0000
@@ -405,6 +405,7 @@
)
;
GoalExpr = shorthand(_),
+ % These should have been expanded out by now.
unexpected(this_file, "shorthand in build_interval_info_in_goal")
).
@@ -946,23 +947,16 @@
rename_var_list(need_not_rename, !.VarRename, Vars0, Vars),
Reason = exist_quant(Vars)
;
- Reason0 = promise_purity(_, _),
- Reason = Reason0
- ;
- Reason0 = promise_solutions(_, _),
- Reason = Reason0
- ;
- Reason0 = commit(_),
- Reason = Reason0
- ;
- Reason0 = barrier(_),
- Reason = Reason0
- ;
Reason0 = from_ground_term(Var0),
rename_var(need_not_rename, !.VarRename, Var0, Var),
Reason = from_ground_term(Var)
;
- Reason0 = trace_goal(_, _, _, _, _),
+ ( Reason0 = promise_purity(_, _)
+ ; Reason0 = promise_solutions(_, _)
+ ; Reason0 = commit(_)
+ ; Reason0 = barrier(_)
+ ; Reason0 = trace_goal(_, _, _, _, _)
+ ),
Reason = Reason0
),
record_decisions_in_goal(SubGoal0, SubGoal, !VarInfo, !VarRename,
Index: compiler/lambda.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/lambda.m,v
retrieving revision 1.134
diff -u -b -r1.134 lambda.m
--- compiler/lambda.m 22 Jan 2008 15:06:11 -0000 1.134
+++ compiler/lambda.m 25 Jan 2008 05:52:10 -0000
@@ -254,9 +254,20 @@
),
GoalExpr = GoalExpr0
;
- GoalExpr0 = shorthand(_),
+ GoalExpr0 = shorthand(ShortHand0),
+ (
+ ShortHand0 = atomic_goal(GoalType, Outer, Inner, MaybeOutputVars,
+ MainGoal0, OrElseGoals0),
+ lambda_process_goal(MainGoal0, MainGoal, !Info),
+ lambda_process_goal_list(OrElseGoals0, OrElseGoals, !Info),
+ ShortHand = atomic_goal(GoalType, Outer, Inner, MaybeOutputVars,
+ MainGoal, OrElseGoals),
+ GoalExpr = shorthand(ShortHand)
+ ;
+ ShortHand0 = bi_implication(_, _),
% These should have been expanded out by now.
- unexpected(this_file, "lambda_process_goal_2: unexpected shorthand")
+ unexpected(this_file, "lambda_process_goal_2: bi_implication")
+ )
).
:- pred lambda_process_goal_list(list(hlds_goal)::in, list(hlds_goal)::out,
Index: compiler/layout_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/layout_out.m,v
retrieving revision 1.94
diff -u -b -r1.94 layout_out.m
--- compiler/layout_out.m 23 Dec 2007 23:57:17 -0000 1.94
+++ compiler/layout_out.m 27 Dec 2007 07:50:08 -0000
@@ -1456,6 +1456,7 @@
"retptr_" ++ int_to_string(proc_id_to_int(ProcId)) ++ "_args"
++ ints_to_string(ArgPos).
pred_transform_name(transform_table_generator) = "table_gen".
+pred_transform_name(transform_stm_expansion) = "stm_expansion".
pred_transform_name(transform_dnf(N)) = "dnf_" ++ int_to_string(N).
:- func ints_to_string(list(int)) = string.
Index: compiler/lco.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/lco.m,v
retrieving revision 1.53
diff -u -b -r1.53 lco.m
--- compiler/lco.m 29 Jan 2008 04:59:39 -0000 1.53
+++ compiler/lco.m 29 Jan 2008 05:00:20 -0000
@@ -415,6 +415,7 @@
GoalExpr = GoalExpr0
;
GoalExpr0 = shorthand(_),
+ % These should have been expanded out by now.
unexpected(this_file, "lco_in_goal: shorthand")
).
@@ -946,6 +947,7 @@
GoalInfo0, GoalExpr0, GoalExpr, Changed)
;
GoalExpr0 = shorthand(_),
+ % These should have been expanded out by now.
unexpected(this_file, "transform_variant_goal: shorthand")
),
(
Index: compiler/live_vars.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/live_vars.m,v
retrieving revision 1.136
diff -u -b -r1.136 live_vars.m
--- compiler/live_vars.m 29 Jan 2008 04:59:39 -0000 1.136
+++ compiler/live_vars.m 29 Jan 2008 05:00:20 -0000
@@ -127,10 +127,12 @@
% If the goal is atomic, we want to apply the postdeaths before processing
% the goal, but if the goal is a compound goal, then we want to apply them
% after processing it.
- ( goal_is_atomic(GoalExpr0) ->
+ HasSubGoals = goal_expr_has_subgoals(GoalExpr0),
+ (
+ HasSubGoals = does_not_have_subgoals,
set.difference(!.Liveness, PostDeaths, !:Liveness)
;
- true
+ HasSubGoals = has_subgoals
),
goal_info_get_resume_point(GoalInfo0, ResumePoint),
@@ -156,9 +158,10 @@
ResumeVars1, AllocData, !StackAlloc, !Liveness, !NondetLiveness,
!ParStackVars),
- ( goal_is_atomic(GoalExpr0) ->
- true
+ (
+ HasSubGoals = does_not_have_subgoals
;
+ HasSubGoals = has_subgoals,
set.difference(!.Liveness, PostDeaths, !:Liveness)
),
Index: compiler/liveness.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/liveness.m,v
retrieving revision 1.163
diff -u -b -r1.163 liveness.m
--- compiler/liveness.m 31 Jan 2008 02:16:00 -0000 1.163
+++ compiler/liveness.m 1 Feb 2008 05:44:41 -0000
@@ -382,14 +382,16 @@
set.union(Births1, NewTypeInfos, Births)
),
set.union(Liveness0, Births, Liveness),
-
- ( goal_is_atomic(GoalExpr0) ->
+ HasSubGoals = goal_expr_has_subgoals(GoalExpr0),
+ (
+ HasSubGoals = does_not_have_subgoals,
PreDeaths = Empty,
PreBirths = Births,
PostDeaths = Empty,
PostBirths = Empty,
GoalExpr = GoalExpr0
;
+ HasSubGoals = has_subgoals,
PreDeaths = Empty,
PreBirths = Empty,
detect_liveness_in_goal_2(GoalExpr0, GoalExpr, Liveness0,
@@ -596,7 +598,9 @@
set.union(PreBirths0, !Liveness),
set.init(Empty),
- ( goal_is_atomic(GoalExpr0) ->
+ HasSubGoals = goal_expr_has_subgoals(GoalExpr0),
+ (
+ HasSubGoals = does_not_have_subgoals,
liveness.get_nonlocals_and_typeinfos(LiveInfo, GoalInfo0,
_BaseNonLocals, CompletedNonLocals),
set.intersect(!.Liveness, CompletedNonLocals, LiveNonLocals),
@@ -604,6 +608,7 @@
set.union(NewPostDeaths, !Deadness),
GoalExpr = GoalExpr0
;
+ HasSubGoals = has_subgoals,
NewPostDeaths = Empty,
detect_deadness_in_goal_2(GoalExpr0, GoalExpr, GoalInfo0,
!Deadness, !.Liveness, LiveInfo)
Index: compiler/lookup_switch.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/lookup_switch.m,v
retrieving revision 1.79
diff -u -b -r1.79 lookup_switch.m
--- compiler/lookup_switch.m 30 Dec 2007 08:23:47 -0000 1.79
+++ compiler/lookup_switch.m 30 Dec 2007 08:42:36 -0000
@@ -354,7 +354,7 @@
% The pre- and post-goal updates for the disjuncts themselves are
% done as part of the call to generate_goal in
% generate_constants_for_disjuncts in lookup_util.m.
- pre_goal_update(GoalInfo, no, !CI),
+ pre_goal_update(GoalInfo, has_subgoals, !CI),
get_instmap(!.CI, InstMap),
generate_constants_for_disjuncts(Disjuncts, Vars, StoreMap, Solns,
!MaybeEnd, MaybeLiveness, !CI),
Index: compiler/loop_inv.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/loop_inv.m,v
retrieving revision 1.45
diff -u -b -r1.45 loop_inv.m
--- compiler/loop_inv.m 22 Jan 2008 15:06:12 -0000 1.45
+++ compiler/loop_inv.m 25 Jan 2008 05:52:11 -0000
@@ -393,8 +393,8 @@
invariant_goal_candidates_2(_PPId,
hlds_goal(shorthand(_), _GoalInfo), _IGCs) = _ :-
- unexpected(this_file,
- "invariant_goal_candidates_2/3: shorthand/1 in hlds_goal").
+ % These should have been expanded out by now.
+ unexpected(this_file, "invariant_goal_candidates_2: shorthand").
%-----------------------------------------------------------------------------%
@@ -862,7 +862,8 @@
hlds_pred.proc_info_set_goal(AuxBody, !AuxProcInfo),
requantify_proc(!AuxProcInfo),
- recompute_instmap_delta_proc(no, !AuxProcInfo, !ModuleInfo),
+ recompute_instmap_delta_proc(do_not_recompute_atomic_instmap_deltas,
+ !AuxProcInfo, !ModuleInfo),
module_info_set_pred_proc_info(AuxPredId, AuxProcId,
AuxPredInfo, !.AuxProcInfo, !ModuleInfo).
@@ -978,8 +979,8 @@
RttiVarMaps, ProcInfo0, ProcInfo1),
quantification.requantify_proc(ProcInfo1, ProcInfo2),
- recompute_instmap_delta_proc(no, ProcInfo2, ProcInfo,
- ModuleInfo0, ModuleInfo1),
+ recompute_instmap_delta_proc(do_not_recompute_atomic_instmap_deltas,
+ ProcInfo2, ProcInfo, ModuleInfo0, ModuleInfo1),
module_info_set_pred_proc_info(PredId, ProcId,
PredInfo0, ProcInfo, ModuleInfo1, ModuleInfo).
Index: compiler/make_hlds_warn.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/make_hlds_warn.m,v
retrieving revision 1.26
diff -u -b -r1.26 make_hlds_warn.m
--- compiler/make_hlds_warn.m 22 Jan 2008 15:06:12 -0000 1.26
+++ compiler/make_hlds_warn.m 25 Jan 2008 05:52:11 -0000
@@ -208,21 +208,25 @@
warn_singletons_in_pragma_foreign_proc(PragmaImpl, Lang,
NamesModes, Context, PredCallId, ModuleInfo, !Specs)
;
- GoalExpr = shorthand(ShorthandGoal),
- warn_singletons_in_goal_2_shorthand(ShorthandGoal, GoalInfo,
- QuantVars, VarSet, PredCallId, ModuleInfo, !Specs)
+ GoalExpr = shorthand(ShortHand),
+ (
+ % XXX STM We need to look at how we should handle Outer, Inner and
+ % MaybeOutputVars.
+ ShortHand = atomic_goal(_GoalType, _Outer, Inner,
+ _MaybeOutputVars, MainGoal, OrElseGoals),
+ Inner = atomic_interface_vars(InnerDI, InnerUO),
+ set.insert_list(QuantVars, [InnerDI, InnerUO], InsideQuantVars),
+ warn_singletons_in_goal(MainGoal, InsideQuantVars, VarSet,
+ PredCallId, ModuleInfo, !Specs),
+ warn_singletons_in_goal_list(OrElseGoals, InsideQuantVars, VarSet,
+ PredCallId, ModuleInfo, !Specs)
+ ;
+ ShortHand = bi_implication(GoalA, GoalB),
+ warn_singletons_in_goal_list([GoalA, GoalB], QuantVars, VarSet,
+ PredCallId, ModuleInfo, !Specs)
+ )
).
-:- pred warn_singletons_in_goal_2_shorthand(shorthand_goal_expr::in,
- hlds_goal_info::in, set(prog_var)::in, prog_varset::in,
- simple_call_id::in, module_info::in,
- list(error_spec)::in, list(error_spec)::out) is det.
-
-warn_singletons_in_goal_2_shorthand(bi_implication(LHS, RHS), _GoalInfo,
- QuantVars, VarSet, PredCallId, ModuleInfo, !Specs) :-
- warn_singletons_in_goal_list([LHS, RHS], QuantVars, VarSet, PredCallId,
- ModuleInfo, !Specs).
-
:- pred warn_singletons_in_goal_list(list(hlds_goal)::in, set(prog_var)::in,
prog_varset::in, simple_call_id::in, module_info::in,
list(error_spec)::in, list(error_spec)::out) is det.
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.463
diff -u -b -r1.463 mercury_compile.m
--- compiler/mercury_compile.m 21 Feb 2008 04:22:41 -0000 1.463
+++ compiler/mercury_compile.m 22 Feb 2008 02:14:35 -0000
@@ -71,6 +71,7 @@
:- import_module transform_hlds.table_gen.
:- import_module transform_hlds.complexity.
:- import_module transform_hlds.lambda.
+:- import_module transform_hlds.stm_expand.
:- import_module transform_hlds.closure_analysis.
:- import_module transform_hlds.termination.
:- import_module transform_hlds.ssdebug.
@@ -230,12 +231,8 @@
handle_options([], _, _, _, _, !IO),
( Args0 = ["--arg-file", ArgFile] ->
- %
- % All the configuration and options file options
- % are passed in the given file, which is created
- % by the parent `mmc --make' process.
- %
-
+ % All the configuration and options file options are passed in the
+ % given file, which is created by the parent `mmc --make' process.
options_file.read_args_file(ArgFile, MaybeArgs1, !IO),
(
MaybeArgs1 = yes(Args1),
@@ -250,9 +247,7 @@
Variables = options_variables_init,
Link = no
;
- %
% Find out which options files to read.
- %
handle_options(Args0, Errors0, OptionArgs, NonOptionArgs, Link, !IO),
(
Errors0 = [_ | _],
@@ -286,11 +281,8 @@
MaybeMCFlags = yes(MCFlags),
handle_options(MCFlags ++ OptionArgs, Errors, _, _, _, !IO),
- %
- % When computing the option arguments to pass
- % to `--make', only include the command-line
- % arguments, not the contents of DEFAULT_MCFLAGS.
- %
+ % When computing the option arguments to pass to `--make', only include
+ % the command-line arguments, not the contents of DEFAULT_MCFLAGS.
main_2(Errors, Variables, OptionArgs, NonOptionArgs, Link, !IO)
;
MaybeMCFlags = no,
@@ -302,10 +294,7 @@
io::di, io::uo) is det.
real_main_2(MCFlags0, MaybeMCFlags, Args0, Variables0, Variables, !IO) :-
- %
- % Process the options again to find out
- % which configuration file to read.
- %
+ % Process the options again to find out which configuration file to read.
handle_options(MCFlags0 ++ Args0, Errors, _, _, _, !IO),
(
Errors = [_ | _],
@@ -497,13 +486,11 @@
true
)
;
- % If we found some errors, but the user didn't enable
- % the `-E' (`--verbose-errors') option, give them a
- % hint about it. Of course, we should only output the
- % hint when we have further information to give the user.
- %
- globals.lookup_bool_option(Globals, verbose_errors,
- VerboseErrors),
+ % If we found some errors, but the user didn't enable the `-E'
+ % (`--verbose-errors') option, give them a hint about it.
+ % Of course, we should only output the hint when we have further
+ % information to give the user.
+ globals.lookup_bool_option(Globals, verbose_errors, VerboseErrors),
globals.io_get_extra_error_info(ExtraErrorInfo, !IO),
(
VerboseErrors = no,
@@ -542,16 +529,16 @@
% we need to call run_gcc_backend here at the top level.
globals.io_get_globals(Globals, !IO),
( compiling_to_asm(Globals) ->
- ( Args = [FirstArg | OtherArgs] ->
+ (
+ Args = [FirstArg | OtherArgs],
globals.lookup_bool_option(Globals, smart_recompilation, Smart),
(
Smart = yes,
(
OtherArgs = [],
- % With smart recompilation we need to delay
- % starting the gcc backend to avoid overwriting
- % the output assembler file even if
- % recompilation is found to be unnecessary.
+ % With smart recompilation we need to delay starting
+ % the gcc backend to avoid overwriting the output assembler
+ % file even if recompilation is found to be unnecessary.
process_args(OptionVariables, OptionArgs, Args,
ModulesToLink, FactTableObjFiles, !IO)
;
@@ -574,6 +561,7 @@
FactTableObjFiles = []
)
;
+ Args = [],
Msg = "Sorry, not implemented: `--target asm' " ++
"with `--filenames-from-stdin",
write_error_pieces_plain([words(Msg)], !IO),
@@ -582,9 +570,8 @@
FactTableObjFiles = []
)
;
- % If we're NOT using the GCC back-end,
- % then we can just call process_args directly,
- % rather than via GCC.
+ % If we're NOT using the GCC back-end, then we can just call
+ % process_args directly, rather than via GCC.
process_args(OptionVariables, OptionArgs, Args, ModulesToLink,
FactTableObjFiles, !IO)
).
@@ -613,49 +600,41 @@
compile_using_gcc_backend(OptionVariables, OptionArgs, FirstFileOrModule,
CallBack, ModulesToLink, !IO) :-
- % The name of the assembler file that we generate
- % is based on name of the first module named
- % on the command line. (Mmake requires this.)
+ % The name of the assembler file that we generate is based on name
+ % of the first module named on the command line. (Mmake requires this.)
%
- % There's two cases:
- % (1) If the argument ends in ".m", we assume
- % that the argument is a file name.
- % To find the corresponding module name,
- % we would need to read in the file
- % (at least up to the first item);
- % this is needed to handle the case where
- % the module name does not match the file
- % name, e.g. file "browse.m" containing
- % ":- module mdb.browse." as its first item.
- % Rather than reading in the source file here,
- % we just pick a name
- % for the asm file based on the file name argument,
- % (e.g. "browse.s") and if necessary rename it later
- % (e.g. to "mdb.browse.s").
- %
- % (2) If the argument doesn't end in `.m',
- % then we assume it is a module name.
- % (Is it worth checking that the name doesn't
- % contain directory separators, and issuing
- % a warning or error in that case?)
+ % There are two cases:
%
+ % (1) If the argument ends in ".m", we assume that the argument is a file
+ % name. To find the corresponding module name, we would need to read in
+ % the file (at least up to the first item); this is needed to handle
+ % the case where the module name does not match the file name, e.g.
+ % file "browse.m" containing ":- module mdb.browse." as its first item.
+ % Rather than reading in the source file here, we just pick a name
+ % for the asm file based on the file name argument, (e.g. "browse.s")
+ % and if necessary rename it later (e.g. to "mdb.browse.s").
+ %
+ % (2) If the argument doesn't end in `.m', then we assume it is
+ % a module name. (Is it worth checking that the name doesn't contain
+ % directory separators, and issuing a warning or error in that case?)
+
(
- FirstFileOrModule = file(FirstFileName),
+ FirstFileOrModule = fm_file(FirstFileName),
file_name_to_module_name(FirstFileName, FirstModuleName)
;
- FirstFileOrModule = module(FirstModuleName)
+ FirstFileOrModule = fm_module(FirstModuleName)
),
- % Invoke run_gcc_backend. It will call us back,
- % and then we'll continue with the normal work of
- % the compilation, which will be done by the callback
- % function (`process_args').
+ % Invoke run_gcc_backend. It will call us back, and then we will continue
+ % with the normal work of the compilation, which will be done by the
+ % callback function (`process_args').
maybe_mlds_to_gcc.run_gcc_backend(FirstModuleName, CallBack, ModulesToLink,
!IO),
- % Now we know what the real module name was, so we
- % can rename the assembler file if needed (see above).
- ( ModulesToLink = [Module | _] ->
+ % Now we know what the real module name was, so we can rename
+ % the assembler file if needed (see above).
+ (
+ ModulesToLink = [Module | _],
file_name_to_module_name(Module, ModuleName),
globals.io_lookup_bool_option(pic, Pic, !IO),
AsmExt = (Pic = yes -> ".pic_s" ; ".s"),
@@ -668,8 +647,7 @@
Result = ok
),
- % Invoke the assembler to produce an object file,
- % if needed.
+ % Invoke the assembler to produce an object file, if needed.
globals.io_lookup_bool_option(target_code_only, TargetCodeOnly, !IO),
(
Result = ok,
@@ -687,9 +665,9 @@
true
)
;
+ ModulesToLink = []
% This can happen if smart recompilation decided
% that nothing needed to be compiled.
- true
).
:- pred do_rename_file(string::in, string::in, io.res::out,
@@ -901,10 +879,10 @@
ModulesToLink = [],
FactTableObjFiles = [],
(
- FileOrModule = file(FileName),
+ FileOrModule = fm_file(FileName),
generate_file_dependencies(FileName, !IO)
;
- FileOrModule = module(ModuleName),
+ FileOrModule = fm_module(ModuleName),
generate_module_dependencies(ModuleName, !IO)
)
;
@@ -916,10 +894,10 @@
ModulesToLink = [],
FactTableObjFiles = [],
(
- FileOrModule = file(FileName),
+ FileOrModule = fm_file(FileName),
generate_file_dependency_file(FileName, !IO)
;
- FileOrModule = module(ModuleName),
+ FileOrModule = fm_module(ModuleName),
generate_module_dependency_file(ModuleName, !IO)
)
;
@@ -930,39 +908,38 @@
).
:- type file_or_module
- ---> file(file_name)
- ; module(module_name).
+ ---> fm_file(file_name)
+ ; fm_module(module_name).
:- func string_to_file_or_module(string) = file_or_module.
string_to_file_or_module(String) = FileOrModule :-
( string.remove_suffix(String, ".m", FileName) ->
- % If the argument name ends in `.m', then we assume it is
- % a file name.
- FileOrModule = file(FileName)
- ;
- % If it doesn't end in `.m', then we assume it is
- % a module name. (Is it worth checking that the
- % name doesn't contain directory separators, and issuing
- % a warning or error in that case?)
+ % If the argument name ends in `.m', then we assume it is a file name.
+ FileOrModule = fm_file(FileName)
+ ;
+ % If it doesn't end in `.m', then we assume it is a module name.
+ % (Is it worth checking that the name doesn't contain directory
+ % separators, and issuing a warning or error in that case?)
file_name_to_module_name(String, ModuleName),
- FileOrModule = module(ModuleName)
+ FileOrModule = fm_module(ModuleName)
).
:- func file_or_module_to_module_name(file_or_module) = module_name.
-file_or_module_to_module_name(file(FileName)) = ModuleName :-
+file_or_module_to_module_name(fm_file(FileName)) = ModuleName :-
% Assume the module name matches the file name.
file_name_to_module_name(FileName, ModuleName).
-file_or_module_to_module_name(module(ModuleName)) = ModuleName.
+file_or_module_to_module_name(fm_module(ModuleName)) = ModuleName.
:- pred read_module_or_file(file_or_module::in, bool::in, module_name::out,
file_name::out, maybe(timestamp)::out, list(item)::out,
module_error::out, read_modules::in, read_modules::out,
io::di, io::uo) is det.
-read_module_or_file(module(ModuleName), ReturnTimestamp, ModuleName, FileName,
- MaybeTimestamp, Items, Error, !ReadModules, !IO) :-
+read_module_or_file(fm_module(ModuleName), ReturnTimestamp,
+ ModuleName, FileName, MaybeTimestamp, Items, Error, !ReadModules,
+ !IO) :-
globals.io_lookup_bool_option(verbose, Verbose, !IO),
maybe_write_string(Verbose, "% Parsing module `", !IO),
ModuleNameString = sym_name_to_string(ModuleName),
@@ -989,7 +966,7 @@
),
globals.io_lookup_bool_option(statistics, Stats, !IO),
maybe_report_stats(Stats, !IO).
-read_module_or_file(file(FileName), ReturnTimestamp, ModuleName,
+read_module_or_file(fm_file(FileName), ReturnTimestamp, ModuleName,
SourceFileName, MaybeTimestamp, Items, Error, !ReadModules, !IO) :-
globals.io_lookup_bool_option(verbose, Verbose, !IO),
maybe_write_string(Verbose, "% Parsing file `", !IO),
@@ -1016,12 +993,11 @@
read_mod_from_file(FileName, ".m", "Reading file", Search,
ReturnTimestamp, Items, Error, ModuleName, MaybeTimestamp, !IO),
- %
- % XXX If the module name doesn't match the file name the compiler
+ % XXX If the module name doesn't match the file name, the compiler
% won't be able to find the `.used' file (the name of the `.used' file
% is derived from the module name not the file name). This will be
% fixed when mmake functionality is moved into the compiler.
- %
+
globals.io_lookup_bool_option(smart_recompilation, Smart, !IO),
(
Smart = yes,
@@ -1118,17 +1094,15 @@
(
Smart = yes,
(
- FileOrModule = module(ModuleName)
+ FileOrModule = fm_module(ModuleName)
;
- FileOrModule = file(FileName),
- % XXX This won't work if the module name
- % doesn't match the file name -- such
- % modules will always be recompiled.
- %
- % This problem will be fixed when mmake
- % functionality is moved into the compiler.
- % The file_name->module_name mapping
- % will be explicitly recorded.
+ FileOrModule = fm_file(FileName),
+ % XXX This won't work if the module name doesn't match
+ % the file name -- such modules will always be recompiled.
+ %
+ % This problem will be fixed when mmake functionality
+ % is moved into the compiler. The file_name->module_name
+ % mapping will be explicitly recorded.
file_name_to_module_name(FileName, ModuleName)
),
@@ -1141,12 +1115,9 @@
Target = target_asm,
ModulesToRecompile0 = some_modules([_ | _])
->
- %
- % With `--target asm', if one module
- % needs to be recompiled, all need to be
- % recompiled because they are all compiled
+ % With `--target asm', if one module needs to be recompiled,
+ % all need to be recompiled because they are all compiled
% into a single object file.
- %
ModulesToRecompile = all_modules
;
ModulesToRecompile = ModulesToRecompile0
@@ -1157,11 +1128,9 @@
ModulesToRecompile = all_modules
),
( ModulesToRecompile = some_modules([]) ->
- % XXX Currently smart recompilation is disabled
- % if mmc is linking the executable because it
- % doesn't know how to check whether all the
- % necessary intermediate files are present
- % and up-to-date.
+ % XXX Currently smart recompilation is disabled if mmc is linking
+ % the executable because it doesn't know how to check whether
+ % all the necessary intermediate files are present and up-to-date.
ModulesToLink = [],
FactTableObjFiles = []
;
@@ -1244,12 +1213,11 @@
TraceProf = yes
)
->
- % Some predicates in the builtin modules are missing
- % typeinfo arguments, which means that execution
- % tracing will not work on them. Predicates defined
- % there should never be part of an execution trace
- % anyway; they are effectively language primitives.
- % (They may still be parts of stack traces.)
+ % Some predicates in the builtin modules are missing typeinfo
+ % arguments, which means that execution tracing will not work
+ % on them. Predicates defined there should never be part of
+ % an execution trace anyway; they are effectively language
+ % primitives. (They may still be parts of stack traces.)
globals.lookup_bool_option(Globals, trace_stack_layout, TSL),
globals.get_trace_level(Globals, TraceLevel),
@@ -1444,9 +1412,8 @@
CompilationTarget = target_asm,
ModuleName \= TopLevelModuleName
->
- % With `--target asm' all the nested
- % sub-modules are placed in the `.s' file
- % of the top-level module.
+ % With `--target asm' all the nested sub-modules are placed in
+ % the `.s' file of the top-level module.
TimestampFiles = []
;
module_name_to_file_name(ModuleName, TimestampSuffix, yes, FileName,
@@ -1534,8 +1501,8 @@
( TypeCheckOnly = yes ->
FactTableObjFiles = []
; ErrorCheckOnly = yes ->
- % we may still want to run `unused_args' so that we get
- % the appropriate warnings
+ % We may still want to run `unused_args' so that we get
+ % the appropriate warnings.
globals.io_lookup_bool_option(warn_unused_args, UnusedArgs, !IO),
(
UnusedArgs = yes,
@@ -1622,13 +1589,11 @@
globals.io_get_target(Target, !IO),
globals.io_lookup_bool_option(target_code_only, TargetCodeOnly, !IO),
- %
- % Remove any existing `.used' file before writing the
- % output file file. This avoids leaving the old `used'
- % file lying around if compilation is interrupted after
- % the new output file is written but before the new
+ % Remove any existing `.used' file before writing the output file.
+ % This avoids leaving the old `used' file lying around if compilation
+ % is interrupted after the new output file is written but before the new
% `.used' file is written.
- %
+
module_name_to_file_name(ModuleName, ".used", no, UsageFileName, !IO),
io.remove_file(UsageFileName, _, !IO),
@@ -1639,14 +1604,11 @@
; Target = target_asm
; Target = target_x86_64
),
- %
% Produce the grade independent header file <module>.mh
% containing function prototypes for the procedures
% referred to by foreign_export pragmas.
- %
export.get_foreign_export_decls(!.HLDS, ExportDecls),
- export.produce_header_file(!.HLDS, ExportDecls, ModuleName,
- !IO)
+ export.produce_header_file(!.HLDS, ExportDecls, ModuleName, !IO)
;
( Target = target_java
; Target = target_il
@@ -1839,10 +1801,10 @@
module_imports_get_module_name(ModuleImports0, ModuleName),
(
DontWriteDFile = yes,
- % The only time the TransOptDeps are required is when
- % creating the .trans_opt file. If DontWriteDFile is yes,
- % then error check only or type-check only is enabled, so
- % we cant be creating the .trans_opt file.
+ % The only time the TransOptDeps are required is when creating the
+ % .trans_opt file. If DontWriteDFile is yes, then error check only
+ % or type-check only is enabled, so we can't be creating the
+ % .trans_opt file.
MaybeTransOptDeps = no
;
DontWriteDFile = no,
@@ -2018,22 +1980,21 @@
)
)
; MakeOptInt = yes ->
- % If we're making the `.opt' file, then we can't
- % read any `.trans_opt' files, since `.opt' files
- % aren't allowed to depend on `.trans_opt' files.
+ % If we're making the `.opt' file, then we can't read any `.trans_opt'
+ % files, since `.opt' files aren't allowed to depend on `.trans_opt'
+ % files.
Imports = Imports1,
Error2 = no
;
(
TransOpt = yes,
- % If transitive optimization is enabled, but we are
- % not creating the .opt or .trans opt file, then import
- % the trans_opt files for all the modules that are
- % imported (or used), and for all ancestor modules.
+ % If transitive optimization is enabled, but we are not creating
+ % the .opt or .trans opt file, then import the trans_opt files
+ % for all the modules that are imported (or used), and for all
+ % ancestor modules.
list.condense([Imports0 ^ parent_deps,
Imports0 ^ int_deps, Imports0 ^ impl_deps], TransOptFiles),
- grab_trans_opt_files(TransOptFiles, Imports1, Imports, Error2,
- !IO)
+ grab_trans_opt_files(TransOptFiles, Imports1, Imports, Error2, !IO)
;
TransOpt = no,
Imports = Imports1,
@@ -2173,9 +2134,7 @@
WarnInstsWithNoMatchingType = no
),
- %
% Next typecheck the clauses.
- %
maybe_write_string(Verbose, "% Type-checking...\n", !IO),
maybe_write_string(Verbose, "% Type-checking clauses...\n", !IO),
typecheck_module(!HLDS, TypeCheckSpecs, ExceededTypeCheckIterationLimit),
@@ -2219,9 +2178,7 @@
!:FoundError = !.FoundError `or` FoundTypeError,
- %
% Stop here if `--typecheck-only' was specified.
- %
globals.lookup_bool_option(Globals, typecheck_only, TypecheckOnly),
(
TypecheckOnly = yes
@@ -2324,6 +2281,8 @@
ClosureAnalysis = yes,
mercury_compile.process_lambdas(Verbose, Stats,
!HLDS, !IO),
+
+ mercury_compile.process_stms(Verbose, Stats, !HLDS, !IO),
mercury_compile.maybe_closure_analysis(Verbose, Stats,
!HLDS, !IO)
;
@@ -2588,6 +2547,9 @@
process_lambdas(Verbose, Stats, !HLDS, !IO),
maybe_dump_hlds(!.HLDS, 110, "lambda", !DumpInfo, !IO),
+ process_stms(Verbose, Stats, !HLDS, !IO),
+ maybe_dump_hlds(!.HLDS, 113, "stm", !DumpInfo, !IO),
+
expand_equiv_types_hlds(Verbose, Stats, !HLDS, !IO),
maybe_dump_hlds(!.HLDS, 115, "equiv_types", !DumpInfo, !IO),
@@ -2600,7 +2562,6 @@
% five modules in the compiler and library). It is important that unique
% mode analysis work most of the time after optimizations because
% deforestation reruns it.
- %
% check_unique_modes(Verbose, Stats, !HLDS,
% FoundUniqError, !IO),
@@ -2613,7 +2574,7 @@
% Exception analysis and termination analysis need to come before any
% optimization passes that could benefit from the information that
% they provide.
- %
+
maybe_exception_analysis(Verbose, Stats, !HLDS, !IO),
maybe_dump_hlds(!.HLDS, 118, "exception_analysis", !DumpInfo, !IO),
@@ -2660,7 +2621,6 @@
% Hoisting loop invariants first invokes pass 148, "mark_static".
% "mark_static" is also run at stage 420.
- %
maybe_loop_inv(Verbose, Stats, !HLDS, !DumpInfo, !IO),
maybe_dump_hlds(!.HLDS, 150, "loop_inv", !DumpInfo, !IO),
@@ -2708,7 +2668,6 @@
% opportunities the other optimizations have provided for constant
% propagation and we cannot do that once the term-size profiling or deep
% profiling transformations have been applied.
- %
simplify(no, pre_prof_transforms, Verbose, Stats, !HLDS, SimplifySpecs,
!IO),
expect(unify(contains_errors(Globals, SimplifySpecs), no), this_file,
@@ -3300,8 +3259,7 @@
:- pred check_stratification(bool::in, bool::in,
module_info::in, module_info::out, bool::out, io::di, io::uo) is det.
-check_stratification(Verbose, Stats, !HLDS, FoundError,
- !IO) :-
+check_stratification(Verbose, Stats, !HLDS, FoundError, !IO) :-
module_info_get_stratified_preds(!.HLDS, StratifiedPreds),
globals.io_lookup_bool_option(warn_non_stratification, Warn, !IO),
(
@@ -3464,8 +3422,7 @@
module_info::in, module_info::out, io::di, io::uo) is det.
maybe_mark_static_terms(Verbose, Stats, !HLDS, !IO) :-
- globals.io_lookup_bool_option(static_ground_terms, StaticGroundTerms,
- !IO),
+ globals.io_lookup_bool_option(static_ground_terms, StaticGroundTerms, !IO),
(
StaticGroundTerms = yes,
maybe_write_string(Verbose, "% Marking static ground terms...\n", !IO),
@@ -3667,6 +3624,18 @@
%-----------------------------------------------------------------------------%
+:- pred process_stms(bool::in, bool::in,
+ module_info::in, module_info::out, io::di, io::uo) is det.
+
+process_stms(Verbose, Stats, !HLDS, !IO) :-
+ maybe_write_string(Verbose, "% Transforming stm expressions...", !IO),
+ maybe_flush_output(Verbose, !IO),
+ stm_process_module(!HLDS),
+ maybe_write_string(Verbose, " done.\n", !IO),
+ maybe_report_stats(Stats, !IO).
+
+%-----------------------------------------------------------------------------%
+
:- pred expand_equiv_types_hlds(bool::in, bool::in,
module_info::in, module_info::out, io::di, io::uo) is det.
@@ -4593,7 +4562,7 @@
module_info_get_name(HLDS, ModuleName),
module_info_get_foreign_decl(HLDS, ForeignDecls),
module_info_get_foreign_import_module(HLDS, ForeignImports0),
- %
+
% Always include the module we are compiling amongst the foreign import
% modules so that pragma foreign_exported procedures are visible to
% foreign code in this module.
@@ -4602,7 +4571,7 @@
% inconsistent in its treatement of self-imports. Both this backend
% (the LLDS) and the MLDS backend currently handle self foreign imports
% directly.
- %
+
ForeignSelfImport = foreign_import_module_info(UseForeignLanguage,
ModuleName, term.context_init),
ForeignImports = [ ForeignSelfImport | ForeignImports0 ],
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.327
diff -u -b -r1.327 mercury_to_mercury.m
--- compiler/mercury_to_mercury.m 15 Feb 2008 08:31:58 -0000 1.327
+++ compiler/mercury_to_mercury.m 15 Feb 2008 08:47:07 -0000
@@ -2917,6 +2917,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),
+ 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),
@@ -3239,6 +3272,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 = [_|_],
+ 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)
+ )
+ ).
+
+%-----------------------------------------------------------------------------%
+
mercury_output_pragma_foreign_decl(Lang, IsLocal, ForeignDeclString, !IO) :-
mercury_format_pragma_foreign_decl(Lang, IsLocal, ForeignDeclString, !IO).
Index: compiler/middle_rec.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/middle_rec.m,v
retrieving revision 1.134
diff -u -b -r1.134 middle_rec.m
--- compiler/middle_rec.m 11 Feb 2008 03:56:10 -0000 1.134
+++ compiler/middle_rec.m 11 Feb 2008 04:28:40 -0000
@@ -233,7 +233,7 @@
get_proc_id(!.CI, ProcId),
EntryLabel = make_local_entry_label(ModuleInfo, PredId, ProcId, no),
- pre_goal_update(SwitchGoalInfo, no, !CI),
+ pre_goal_update(SwitchGoalInfo, has_subgoals, !CI),
VarType = variable_type(!.CI, Var),
CheaperTagTest = lookup_cheaper_tag_test(!.CI, VarType),
generate_tag_test(Var, BaseConsId, CheaperTagTest, branch_on_success,
Index: compiler/mode_constraint_robdd.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mode_constraint_robdd.m,v
retrieving revision 1.13
diff -u -b -r1.13 mode_constraint_robdd.m
--- compiler/mode_constraint_robdd.m 12 Nov 2007 03:52:43 -0000 1.13
+++ compiler/mode_constraint_robdd.m 27 Dec 2007 07:52:16 -0000
@@ -378,6 +378,11 @@
io.write_char('f', !IO).
dump_goal_path_step(step_later, !IO) :-
io.write_char('l', !IO).
+dump_goal_path_step(step_atomic_main, !IO) :-
+ io.write_char('a', !IO).
+dump_goal_path_step(step_atomic_orelse(N), !IO) :-
+ io.write_char('o', !IO),
+ io.write_int(N, !IO).
robdd_to_dot(Constraint, ProgVarSet, Info, FileName, !IO) :-
robdd_to_dot(Constraint ^ robdd, P, FileName, !IO),
@@ -400,8 +405,7 @@
atomic_prodvars_map(Constraint, MCInfo) =
(
- some_vars(VarsEntailed) =
- vars_entailed(ensure_normalised(Constraint))
+ some_vars(VarsEntailed) = vars_entailed(ensure_normalised(Constraint))
->
list.foldl(
(func(MCVar, PVM) =
Index: compiler/mode_constraints.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mode_constraints.m,v
retrieving revision 1.46
diff -u -b -r1.46 mode_constraints.m
--- compiler/mode_constraints.m 29 Jan 2008 04:59:40 -0000 1.46
+++ compiler/mode_constraints.m 29 Jan 2008 05:00:21 -0000
@@ -453,7 +453,15 @@
Occurring = OccCond `set.union` OccThen `set.union` OccElse.
number_robdd_variables_in_goal_2(_, _, _, _, _, shorthand(_), _, !RInfo) :-
unexpected(this_file, "number_robdd_variables_in_goal_2: shorthand").
-
+% number_robdd_variables_in_goal_2(InstGraph, _, _, NonLocals, Occurring,
+% atomic_goal(GoalType, Inner, Outer, Vars, MainGoal0, OrElseGoals0),
+% atomic_goal(GoalType, Inner, Outer, Vars, MainGoal, OrElseGoals),
+% !RInfo) :-
+% number_robdd_variables_in_goal(InstGraph, NonLocals, OccMain,
+% MainGoal0, MainGoal, !RInfo),
+% number_robdd_variables_in_goals(InstGraph, NonLocals, OccOrElse,
+% OrElseGoals0, OrElseGoals, !RInfo),
+% Occurring = OccMain `set.union` OccOrElse.
number_robdd_variables_in_goal_2(InstGraph, GoalPath, ParentNonLocals, _,
Occurring, GoalExpr, GoalExpr, !RInfo) :-
GoalExpr = plain_call(_, _, Args, _, _, _),
@@ -1119,10 +1127,12 @@
goal_constraints(ParentNonLocals, CanSucceed, hlds_goal(GoalExpr0, GoalInfo0),
hlds_goal(GoalExpr, GoalInfo), !Constraint, !GCInfo) :-
- ( goal_is_atomic(GoalExpr0) ->
- add_atomic_goal(GoalPath, !GCInfo)
+ HasSubGoals = goal_expr_has_subgoals(GoalExpr0),
+ (
+ HasSubGoals = has_subgoals
;
- true
+ HasSubGoals = does_not_have_subgoals,
+ add_atomic_goal(GoalPath, !GCInfo)
),
GoalPath = goal_info_get_goal_path(GoalInfo0),
@@ -1439,9 +1449,27 @@
goal_constraints_2(_, _, _, _, call_foreign_proc(_, _, _, _, _, _, _),
_, _, _, _, _) :-
sorry(this_file, "goal_constraints_2: foreign_proc NYI").
+
goal_constraints_2(_, _, _, _, shorthand(_), _, _, _, _, _) :-
sorry(this_file, "goal_constraints_2: shorthand").
+% goal_constraints_2(GoalPath, NonLocals, Vars, CanSucceed,
+% atomic_goal(GoalType, Outer, Inner, OutVars, MainGoal0, OrElseGoals0),
+% atomic_goal(GoalType, Outer, Inner, OutVars, MainGoal, OrElseGoals),
+% !Constraint, !GCInfo) :-
+% Goals0 = [MainGoal0 | OrElseGoals0],
+% disj_constraints(NonLocals, CanSucceed, !Constraint, Goals0, Goals,
+% [], DisjunctPaths, !GCInfo),
+% list.foldl2((pred(V::in, Cons0::in, Cons::out, in, out) is det -->
+% get_var(V `at` GoalPath, Vgp),
+% list.foldl2((pred(Path::in, C0::in, C::out, in, out) is det -->
+% get_var(V `at` Path, VPath),
+% { C = C0 ^ eq_vars(Vgp, VPath) }
+% ), DisjunctPaths, Cons0, Cons)
+% ), set.to_sorted_list(Vars), !Constraint, !GCInfo),
+% MainGoal = list.det_head(Goals),
+% OrElseGoals = list.det_tail(Goals).
+
% Constraints for the conjunction. If UseKnownVars = yes, generate
% constraints only for the vars in KnownVars, otherwise generate
% constraints only for the vars _not_ is KnownVars.
Index: compiler/mode_errors.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mode_errors.m,v
retrieving revision 1.123
diff -u -b -r1.123 mode_errors.m
--- compiler/mode_errors.m 22 Jan 2008 15:06:12 -0000 1.123
+++ compiler/mode_errors.m 25 Jan 2008 05:52:11 -0000
@@ -35,8 +35,9 @@
%-----------------------------------------------------------------------------%
:- type merge_context
- ---> disj
- ; if_then_else.
+ ---> merge_disj
+ ; merge_if_then_else
+ ; merge_stm_atomic.
:- type merge_error
---> merge_error(prog_var, list(mer_inst)).
@@ -541,8 +542,9 @@
:- func merge_context_to_string(merge_context) = string.
-merge_context_to_string(disj) = "disjunction".
-merge_context_to_string(if_then_else) = "if-then-else".
+merge_context_to_string(merge_disj) = "disjunction".
+merge_context_to_string(merge_if_then_else) = "if-then-else".
+merge_context_to_string(merge_stm_atomic) = "atomic".
%-----------------------------------------------------------------------------%
@@ -569,6 +571,10 @@
Reason = var_lock_trace_goal,
ReasonStr = "attempt to bind a non-local variable inside a trace goal."
;
+ Reason = var_lock_atomic_goal,
+ ReasonStr = "attempt to bind outer state variables inside an " ++
+ "atomic goal."
+ ;
Reason = var_lock_par_conj,
ReasonStr = "attempt to bind a non-local variable" ++
" inside more than one parallel conjunct."
@@ -606,6 +612,11 @@
[words("A trace goal is only allowed to bind variables"),
words("which are local to the trace goal."), nl]
;
+ Reason = var_lock_atomic_goal,
+ VerbosePieces =
+ [words("An atomic goal may not use the state variables"),
+ words("belonging to the outer scope."), nl]
+ ;
Reason = var_lock_par_conj,
VerbosePieces =
[words("A nonlocal variable of a parallel conjunction"),
Index: compiler/mode_info.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mode_info.m,v
retrieving revision 1.96
diff -u -b -r1.96 mode_info.m
--- compiler/mode_info.m 31 Oct 2007 03:58:27 -0000 1.96
+++ compiler/mode_info.m 12 Jan 2008 16:13:02 -0000
@@ -69,6 +69,7 @@
; var_lock_if_then_else
; var_lock_lambda(pred_or_func)
; var_lock_trace_goal
+ ; var_lock_atomic_goal
; var_lock_par_conj.
% Specify how to process goals - using either modes.m or unique_modes.m.
@@ -107,10 +108,6 @@
proc_id::in, prog_context::in, set(prog_var)::in, instmap::in,
how_to_check_goal::in, may_change_called_proc::in, mode_info::out) is det.
-:- type need_to_requantify
- ---> need_to_requantify
- ; do_not_need_to_requantify.
-
% The mode_info contains a flag indicating whether initialisation calls,
% converting a solver variable from `free' to `any', may be inserted
% during mode analysis.
Index: compiler/mode_ordering.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mode_ordering.m,v
retrieving revision 1.26
diff -u -b -r1.26 mode_ordering.m
--- compiler/mode_ordering.m 22 Jan 2008 15:06:13 -0000 1.26
+++ compiler/mode_ordering.m 25 Jan 2008 05:52:11 -0000
@@ -342,6 +342,13 @@
mode_order_goal_2(Goal0, _, !GoalInfo, !MOI) :-
Goal0 = shorthand(_),
unexpected(this_file, "mode_order_goal_2: shorthand").
+% mode_order_goal_2(Goal0, Goal, !GoalInfo, !MOI) :-
+% Goal0 = atomic_goal(GoalType, Outer, Inner, Vars, MainGoal0,
+% OrElseGoals0),
+% mode_order_goal(MainGoal0, MainGoal, !MOI),
+% list.map_foldl(mode_order_goal, OrElseGoals0, OrElseGoals, !MOI),
+% mode_order_disj(OrElseGoals, !GoalInfo),
+% Goal = atomic_goal(GoalType, Outer, Inner, Vars, MainGoal, OrElseGoals).
:- pred mode_order_disj(hlds_goals::in,
hlds_goal_info::in, hlds_goal_info::out) is det.
Index: compiler/mode_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mode_util.m,v
retrieving revision 1.203
diff -u -b -r1.203 mode_util.m
--- compiler/mode_util.m 22 Jan 2008 15:06:13 -0000 1.203
+++ compiler/mode_util.m 27 Jan 2008 23:49:52 -0000
@@ -24,7 +24,6 @@
:- import_module parse_tree.
:- import_module parse_tree.prog_data.
-:- import_module bool.
:- import_module list.
%-----------------------------------------------------------------------------%
@@ -105,21 +104,25 @@
%
:- pred inst_lookup(module_info::in, inst_name::in, mer_inst::out) is det.
+:- type recompute_atomic_instmap_deltas
+ ---> recompute_atomic_instmap_deltas
+ ; do_not_recompute_atomic_instmap_deltas.
+
% Use the instmap deltas for all the atomic sub-goals to recompute
% the instmap deltas for all the non-atomic sub-goals of a goal.
% Used to ensure that the instmap deltas remain valid after code has
% been re-arranged, e.g. by followcode. This also takes the
% module_info as input and output since it may need to insert new
- % merge_insts into the merge_inst table. If the first argument is
- % yes, the instmap_deltas for calls and deconstruction unifications
- % are also recomputed.
- %
-:- pred recompute_instmap_delta_proc(bool::in, proc_info::in, proc_info::out,
- module_info::in, module_info::out) is det.
-
-:- pred recompute_instmap_delta(bool::in, hlds_goal::in, hlds_goal::out,
- vartypes::in, inst_varset::in, instmap::in, module_info::in,
- module_info::out) is det.
+ % merge_insts into the merge_inst table. The first argument says
+ % whether the instmap_deltas for calls and deconstruction unifications
+ % should also recomputed.
+ %
+:- pred recompute_instmap_delta_proc(recompute_atomic_instmap_deltas::in,
+ proc_info::in, proc_info::out, module_info::in, module_info::out) is det.
+
+:- pred recompute_instmap_delta(recompute_atomic_instmap_deltas::in,
+ hlds_goal::in, hlds_goal::out, vartypes::in, inst_varset::in,
+ instmap::in, module_info::in, module_info::out) is det.
% Given corresponding lists of types and modes, produce a new list
% of modes which includes the information provided by the
@@ -1000,18 +1003,18 @@
RI0 = recompute_info(ModuleInfo0, InstVarSet),
recompute_instmap_delta_1(RecomputeAtomic, Goal0, Goal, VarTypes,
InstMap0, _, RI0, RI),
- ModuleInfo = RI ^ module_info.
+ ModuleInfo = RI ^ ri_module_info.
-:- pred recompute_instmap_delta_1(bool::in, hlds_goal::in, hlds_goal::out,
- vartypes::in, instmap::in, instmap_delta::out,
- recompute_info::in, recompute_info::out) is det.
+:- pred recompute_instmap_delta_1(recompute_atomic_instmap_deltas::in,
+ hlds_goal::in, hlds_goal::out, vartypes::in, instmap::in,
+ instmap_delta::out, recompute_info::in, recompute_info::out) is det.
-recompute_instmap_delta_1(RecomputeAtomic, Goal0, Goal,
- VarTypes, InstMap0, InstMapDelta, !RI) :-
+recompute_instmap_delta_1(RecomputeAtomic, Goal0, Goal, VarTypes,
+ InstMap0, InstMapDelta, !RI) :-
Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
(
- RecomputeAtomic = no,
- goal_is_atomic(GoalExpr0),
+ RecomputeAtomic = do_not_recompute_atomic_instmap_deltas,
+ goal_expr_has_subgoals(GoalExpr0) = does_not_have_subgoals,
\+ (
GoalExpr0 = unify(_, RHS, _, _, _),
RHS = rhs_lambda_goal(_, _, _, _, _, _, _, _, _)
@@ -1021,8 +1024,8 @@
GoalExpr = GoalExpr0,
GoalInfo1 = GoalInfo0
;
- recompute_instmap_delta_2(RecomputeAtomic, GoalExpr0, GoalInfo0,
- GoalExpr, VarTypes, InstMap0, InstMapDelta0, !RI),
+ recompute_instmap_delta_2(RecomputeAtomic, GoalExpr0, GoalExpr,
+ GoalInfo0, VarTypes, InstMap0, InstMapDelta0, !RI),
NonLocals = goal_info_get_nonlocals(GoalInfo0),
instmap_delta_restrict(NonLocals, InstMapDelta0, InstMapDelta1),
goal_info_set_instmap_delta(InstMapDelta1, GoalInfo0, GoalInfo1)
@@ -1041,8 +1044,8 @@
:- type recompute_info
---> recompute_info(
- module_info :: module_info,
- inst_varset :: inst_varset
+ ri_module_info :: module_info,
+ ri_inst_varset :: inst_varset
).
% update_module_info(P, R, RI0, RI) will call predicate P, passing it
@@ -1054,117 +1057,116 @@
T::out, recompute_info::in, recompute_info::out) is det.
update_module_info(P, R, !RI) :-
- ModuleInfo0 = !.RI ^ module_info,
+ ModuleInfo0 = !.RI ^ ri_module_info,
P(R, ModuleInfo0, ModuleInfo),
- !:RI = !.RI ^ module_info := ModuleInfo.
+ !:RI = !.RI ^ ri_module_info := ModuleInfo.
-:- pred recompute_instmap_delta_2(bool::in, hlds_goal_expr::in,
- hlds_goal_info::in, hlds_goal_expr::out, vartypes::in, instmap::in,
- instmap_delta::out, recompute_info::in, recompute_info::out) is det.
+:- pred recompute_instmap_delta_2(recompute_atomic_instmap_deltas::in,
+ hlds_goal_expr::in, hlds_goal_expr::out, hlds_goal_info::in,
+ vartypes::in, instmap::in, instmap_delta::out,
+ recompute_info::in, recompute_info::out) is det.
-recompute_instmap_delta_2(Atomic, switch(Var, Det, Cases0), GoalInfo,
- switch(Var, Det, Cases), VarTypes, InstMap, InstMapDelta, !RI) :-
+recompute_instmap_delta_2(RecomputeAtomic, GoalExpr0, GoalExpr, GoalInfo,
+ VarTypes, InstMap0, InstMapDelta, !RI) :-
+ (
+ GoalExpr0 = switch(Var, Det, Cases0),
( goal_info_has_feature(GoalInfo, feature_mode_check_clauses_goal) ->
Cases = Cases0,
InstMapDelta = goal_info_get_instmap_delta(GoalInfo)
;
NonLocals = goal_info_get_nonlocals(GoalInfo),
- recompute_instmap_delta_cases(Atomic, Var, Cases0, Cases,
- VarTypes, InstMap, NonLocals, InstMapDelta, !RI)
- ).
-
-recompute_instmap_delta_2(Atomic, conj(ConjType, Goals0), _GoalInfo,
- conj(ConjType, Goals), VarTypes, InstMap, InstMapDelta, !RI) :-
- recompute_instmap_delta_conj(Atomic, Goals0, Goals,
- VarTypes, InstMap, InstMapDelta, !RI).
-
-recompute_instmap_delta_2(Atomic, disj(Goals0), GoalInfo, disj(Goals),
- VarTypes, InstMap, InstMapDelta, !RI) :-
+ recompute_instmap_delta_cases(RecomputeAtomic, Var, Cases0, Cases,
+ VarTypes, InstMap0, NonLocals, InstMapDelta, !RI)
+ ),
+ GoalExpr = switch(Var, Det, Cases)
+ ;
+ GoalExpr0 = conj(ConjType, Goals0),
+ recompute_instmap_delta_conj(RecomputeAtomic, Goals0, Goals,
+ VarTypes, InstMap0, InstMapDelta, !RI),
+ GoalExpr = conj(ConjType, Goals)
+ ;
+ GoalExpr0 = disj(Goals0),
( goal_info_has_feature(GoalInfo, feature_mode_check_clauses_goal) ->
Goals = Goals0,
InstMapDelta = goal_info_get_instmap_delta(GoalInfo)
;
NonLocals = goal_info_get_nonlocals(GoalInfo),
- recompute_instmap_delta_disj(Atomic, Goals0, Goals,
- VarTypes, InstMap, NonLocals, InstMapDelta, !RI)
- ).
-
-recompute_instmap_delta_2(Atomic, negation(Goal0), _, negation(Goal),
- VarTypes, InstMap, InstMapDelta, !RI) :-
+ recompute_instmap_delta_disj(RecomputeAtomic, Goals0, Goals,
+ VarTypes, InstMap0, NonLocals, InstMapDelta, !RI)
+ ),
+ GoalExpr = disj(Goals)
+ ;
+ GoalExpr0 = negation(SubGoal0),
instmap_delta_init_reachable(InstMapDelta),
- recompute_instmap_delta_1(Atomic, Goal0, Goal, VarTypes, InstMap, _,
- !RI).
-
-recompute_instmap_delta_2(Atomic, if_then_else(Vars, Cond0, Then0, Else0),
- GoalInfo, if_then_else(Vars, Cond, Then, Else), VarTypes,
- InstMap0, InstMapDelta, !RI) :-
- recompute_instmap_delta_1(Atomic, Cond0, Cond, VarTypes, InstMap0,
- InstMapDeltaCond, !RI),
+ recompute_instmap_delta_1(RecomputeAtomic, SubGoal0, SubGoal, VarTypes,
+ InstMap0, _, !RI),
+ GoalExpr = negation(SubGoal)
+ ;
+ GoalExpr0 = if_then_else(Vars, Cond0, Then0, Else0),
+ recompute_instmap_delta_1(RecomputeAtomic, Cond0, Cond, VarTypes,
+ InstMap0, InstMapDeltaCond, !RI),
instmap.apply_instmap_delta(InstMap0, InstMapDeltaCond, InstMapCond),
- recompute_instmap_delta_1(Atomic, Then0, Then, VarTypes, InstMapCond,
- InstMapDeltaThen, !RI),
- recompute_instmap_delta_1(Atomic, Else0, Else, VarTypes, InstMap0,
- InstMapDeltaElse, !RI),
+ recompute_instmap_delta_1(RecomputeAtomic, Then0, Then, VarTypes,
+ InstMapCond, InstMapDeltaThen, !RI),
+ recompute_instmap_delta_1(RecomputeAtomic, Else0, Else, VarTypes,
+ InstMap0, InstMapDeltaElse, !RI),
instmap_delta_apply_instmap_delta(InstMapDeltaCond, InstMapDeltaThen,
test_size, InstMapDeltaCondThen),
NonLocals = goal_info_get_nonlocals(GoalInfo),
update_module_info(
merge_instmap_delta(InstMap0, NonLocals,
VarTypes, InstMapDeltaElse, InstMapDeltaCondThen),
- InstMapDelta, !RI).
-
-recompute_instmap_delta_2(Atomic, scope(Reason, Goal0), _,
- scope(Reason, Goal), VarTypes, InstMap, InstMapDelta, !RI) :-
- recompute_instmap_delta_1(Atomic, Goal0, Goal, VarTypes, InstMap,
- InstMapDelta, !RI).
-
-recompute_instmap_delta_2(_, generic_call(Details, Vars, Modes, Detism), _,
- generic_call(Details, Vars, Modes, Detism),
- _VarTypes, _InstMap, InstMapDelta, !RI) :-
- ModuleInfo = !.RI ^ module_info,
- instmap_delta_from_mode_list(Vars, Modes, ModuleInfo, InstMapDelta).
-
-recompute_instmap_delta_2(_, plain_call(PredId, ProcId, Args, BI, UC, Name), _,
- plain_call(PredId, ProcId, Args, BI, UC, Name), VarTypes,
- InstMap, InstMapDelta, !RI) :-
- recompute_instmap_delta_call(PredId, ProcId,
- Args, VarTypes, InstMap, InstMapDelta, !RI).
-
-recompute_instmap_delta_2(Atomic, unify(LHS, RHS0, UniMode0, Uni, Context),
- GoalInfo, unify(LHS, RHS, UniMode, Uni, Context), VarTypes,
- InstMap0, InstMapDelta, !RI) :-
- (
- RHS0 = rhs_lambda_goal(Purity, Groundness, PorF, EvalMethod, NonLocals,
- LambdaVars, Modes, Det, Goal0)
- ->
- ModuleInfo0 = !.RI ^ module_info,
+ InstMapDelta, !RI),
+ GoalExpr = if_then_else(Vars, Cond, Then, Else)
+ ;
+ GoalExpr0 = scope(Reason, SubGoal0),
+ recompute_instmap_delta_1(RecomputeAtomic, SubGoal0, SubGoal, VarTypes,
+ InstMap0, InstMapDelta, !RI),
+ GoalExpr = scope(Reason, SubGoal)
+ ;
+ GoalExpr0 = generic_call(_Details, Vars, Modes, _Detism),
+ ModuleInfo = !.RI ^ ri_module_info,
+ instmap_delta_from_mode_list(Vars, Modes, ModuleInfo, InstMapDelta),
+ GoalExpr = GoalExpr0
+ ;
+ GoalExpr0 = plain_call(PredId, ProcId, Args, _BI, _UC, _Name),
+ recompute_instmap_delta_call(PredId, ProcId, Args, VarTypes,
+ InstMap0, InstMapDelta, !RI),
+ GoalExpr = GoalExpr0
+ ;
+ GoalExpr0 = unify(LHS, RHS0, UniMode0, Uni, Context),
+ GoalExpr = unify(LHS, RHS, UniMode, Uni, Context),
+ (
+ RHS0 = rhs_lambda_goal(Purity, Groundness, PorF, EvalMethod,
+ NonLocals, LambdaVars, Modes, Det, Goal0),
+ ModuleInfo0 = !.RI ^ ri_module_info,
instmap.pre_lambda_update(ModuleInfo0, LambdaVars, Modes,
InstMap0, InstMap),
- recompute_instmap_delta_1(Atomic, Goal0, Goal, VarTypes,
+ recompute_instmap_delta_1(RecomputeAtomic, Goal0, Goal, VarTypes,
InstMap, _, !RI),
- RHS = rhs_lambda_goal(Purity, Groundness, PorF, EvalMethod, NonLocals,
- LambdaVars, Modes, Det, Goal)
+ RHS = rhs_lambda_goal(Purity, Groundness, PorF, EvalMethod,
+ NonLocals, LambdaVars, Modes, Det, Goal)
;
+ ( RHS0 = rhs_var(_)
+ ; RHS0 = rhs_functor(_, _, _)
+ ),
RHS = RHS0
),
(
- Atomic = yes,
+ RecomputeAtomic = recompute_atomic_instmap_deltas,
recompute_instmap_delta_unify(Uni, UniMode0, UniMode,
GoalInfo, InstMap0, InstMapDelta, !.RI)
;
- Atomic = no,
+ RecomputeAtomic = do_not_recompute_atomic_instmap_deltas,
UniMode = UniMode0,
InstMapDelta = goal_info_get_instmap_delta(GoalInfo)
- ).
-
-recompute_instmap_delta_2(_,
- call_foreign_proc(Attr, PredId, ProcId, Args, ExtraArgs, MTRC, Impl),
- GoalInfo,
- call_foreign_proc(Attr, PredId, ProcId, Args, ExtraArgs, MTRC, Impl),
- VarTypes, InstMap, InstMapDelta, !RI) :-
+ )
+ ;
+ GoalExpr0 = call_foreign_proc(_Attr, PredId, ProcId, Args, ExtraArgs,
+ _MTRC, _Impl),
ArgVars = list.map(foreign_arg_var, Args),
- recompute_instmap_delta_call(PredId, ProcId,
- ArgVars, VarTypes, InstMap, InstMapDelta0, !RI),
+ recompute_instmap_delta_call(PredId, ProcId, ArgVars, VarTypes,
+ InstMap0, InstMapDelta0, !RI),
(
ExtraArgs = [],
InstMapDelta = InstMapDelta0
@@ -1176,41 +1178,64 @@
OldInstMapDelta, ExtraArgsInstMapDelta),
instmap_delta_apply_instmap_delta(InstMapDelta0,
ExtraArgsInstMapDelta, large_base, InstMapDelta)
- ).
-
-recompute_instmap_delta_2(_, shorthand(_), _, _, _, _, _, !RI) :-
- % these should have been expanded out by now
+ ),
+ GoalExpr = GoalExpr0
+ ;
+ GoalExpr0 = shorthand(ShortHand0),
+ (
+ ShortHand0 = atomic_goal(GoalType, Outer, Inner, MaybeOutputVars,
+ MainGoal0, OrElseGoals0),
+ Goals0 = [MainGoal0 | OrElseGoals0],
+ NonLocals = goal_info_get_nonlocals(GoalInfo),
+ recompute_instmap_delta_disj(RecomputeAtomic, Goals0, Goals,
+ VarTypes, InstMap0, NonLocals, InstMapDelta, !RI),
+ (
+ Goals = [],
+ unexpected(this_file,
+ "recompute_instmap_delta_2: Goals = []")
+ ;
+ Goals = [MainGoal | OrElseGoals]
+ ),
+ ShortHand = atomic_goal(GoalType, Outer, Inner, MaybeOutputVars,
+ MainGoal, OrElseGoals)
+ ;
+ ShortHand0 = bi_implication(_, _),
+ % These should have been expanded out by now.
unexpected(this_file,
- "recompute_instmap_delta_2: unexpected shorthand").
+ "recompute_instmap_delta_2: bi_implication")
+ ),
+ GoalExpr = shorthand(ShortHand)
+ ).
%-----------------------------------------------------------------------------%
-:- pred recompute_instmap_delta_conj(bool::in, list(hlds_goal)::in,
- list(hlds_goal)::out, vartypes::in, instmap::in, instmap_delta::out,
- recompute_info::in, recompute_info::out) is det.
+:- pred recompute_instmap_delta_conj(recompute_atomic_instmap_deltas::in,
+ list(hlds_goal)::in, list(hlds_goal)::out, vartypes::in, instmap::in,
+ instmap_delta::out, recompute_info::in, recompute_info::out) is det.
recompute_instmap_delta_conj(_, [], [], _, _, InstMapDelta, !RI) :-
instmap_delta_init_reachable(InstMapDelta).
-recompute_instmap_delta_conj(Atomic, [Goal0 | Goals0], [Goal | Goals],
+recompute_instmap_delta_conj(RecomputeAtomic, [Goal0 | Goals0], [Goal | Goals],
VarTypes, InstMap0, InstMapDelta, !RI) :-
- recompute_instmap_delta_1(Atomic, Goal0, Goal, VarTypes, InstMap0,
- InstMapDelta0, !RI),
+ recompute_instmap_delta_1(RecomputeAtomic, Goal0, Goal,
+ VarTypes, InstMap0, InstMapDelta0, !RI),
instmap.apply_instmap_delta(InstMap0, InstMapDelta0, InstMap1),
- recompute_instmap_delta_conj(Atomic, Goals0, Goals, VarTypes, InstMap1,
- InstMapDelta1, !RI),
+ recompute_instmap_delta_conj(RecomputeAtomic, Goals0, Goals,
+ VarTypes, InstMap1, InstMapDelta1, !RI),
instmap_delta_apply_instmap_delta(InstMapDelta0, InstMapDelta1,
large_overlay, InstMapDelta).
%-----------------------------------------------------------------------------%
-:- pred recompute_instmap_delta_disj(bool::in, list(hlds_goal)::in,
- list(hlds_goal)::out, vartypes::in, instmap::in, set(prog_var)::in,
- instmap_delta::out, recompute_info::in, recompute_info::out) is det.
+:- pred recompute_instmap_delta_disj(recompute_atomic_instmap_deltas::in,
+ list(hlds_goal)::in, list(hlds_goal)::out,
+ vartypes::in, instmap::in, set(prog_var)::in, instmap_delta::out,
+ recompute_info::in, recompute_info::out) is det.
-recompute_instmap_delta_disj(Atomic, Goals0, Goals, VarTypes, InstMap,
- NonLocals, InstMapDelta, !RI) :-
- recompute_instmap_delta_disj_2(Atomic, Goals0, Goals, VarTypes, InstMap,
- NonLocals, InstMapDeltas, !RI),
+recompute_instmap_delta_disj(RecomputeAtomic, Goals0, Goals,
+ VarTypes, InstMap, NonLocals, InstMapDelta, !RI) :-
+ recompute_instmap_delta_disj_2(RecomputeAtomic, Goals0, Goals,
+ VarTypes, InstMap, NonLocals, InstMapDeltas, !RI),
(
InstMapDeltas = [],
instmap_delta_init_unreachable(InstMapDelta)
@@ -1221,29 +1246,32 @@
InstMapDelta, !RI)
).
-:- pred recompute_instmap_delta_disj_2(bool::in, list(hlds_goal)::in,
- list(hlds_goal)::out, vartypes::in, instmap::in, set(prog_var)::in,
- list(instmap_delta)::out, recompute_info::in, recompute_info::out) is det.
+:- pred recompute_instmap_delta_disj_2(recompute_atomic_instmap_deltas::in,
+ list(hlds_goal)::in, list(hlds_goal)::out,
+ vartypes::in, instmap::in, set(prog_var)::in, list(instmap_delta)::out,
+ recompute_info::in, recompute_info::out) is det.
-recompute_instmap_delta_disj_2(_Atomic, [], [],
+recompute_instmap_delta_disj_2(_RecomputeAtomic, [], [],
_VarTypes, _InstMap, _NonLocals, [], !RI).
-recompute_instmap_delta_disj_2(Atomic, [Goal0 | Goals0], [Goal | Goals],
- VarTypes, InstMap, NonLocals, [InstMapDelta | InstMapDeltas], !RI) :-
- recompute_instmap_delta_1(Atomic, Goal0, Goal,
+recompute_instmap_delta_disj_2(RecomputeAtomic,
+ [Goal0 | Goals0], [Goal | Goals], VarTypes, InstMap, NonLocals,
+ [InstMapDelta | InstMapDeltas], !RI) :-
+ recompute_instmap_delta_1(RecomputeAtomic, Goal0, Goal,
VarTypes, InstMap, InstMapDelta, !RI),
- recompute_instmap_delta_disj_2(Atomic, Goals0, Goals,
+ recompute_instmap_delta_disj_2(RecomputeAtomic, Goals0, Goals,
VarTypes, InstMap, NonLocals, InstMapDeltas, !RI).
%-----------------------------------------------------------------------------%
-:- pred recompute_instmap_delta_cases(bool::in, prog_var::in, list(case)::in,
- list(case)::out, vartypes::in, instmap::in, set(prog_var)::in,
- instmap_delta::out, recompute_info::in, recompute_info::out) is det.
+:- pred recompute_instmap_delta_cases(recompute_atomic_instmap_deltas::in,
+ prog_var::in, list(case)::in, list(case)::out,
+ vartypes::in, instmap::in, set(prog_var)::in, instmap_delta::out,
+ recompute_info::in, recompute_info::out) is det.
-recompute_instmap_delta_cases(Atomic, Var, Cases0, Cases, VarTypes,
- InstMap0, NonLocals, InstMapDelta, !RI) :-
- recompute_instmap_delta_cases_2(Atomic, Var, Cases0, Cases, VarTypes,
- InstMap0, NonLocals, InstMapDeltas, !RI),
+recompute_instmap_delta_cases(RecomputeAtomic, Var, Cases0, Cases,
+ VarTypes, InstMap0, NonLocals, InstMapDelta, !RI) :-
+ recompute_instmap_delta_cases_2(RecomputeAtomic, Var, Cases0, Cases,
+ VarTypes, InstMap0, NonLocals, InstMapDeltas, !RI),
(
InstMapDeltas = [],
instmap_delta_init_unreachable(InstMapDelta)
@@ -1254,24 +1282,26 @@
InstMapDelta, !RI)
).
-:- pred recompute_instmap_delta_cases_2(bool::in, prog_var::in, list(case)::in,
+:- pred recompute_instmap_delta_cases_2(recompute_atomic_instmap_deltas::in,
+ prog_var::in, list(case)::in,
list(case)::out, vartypes::in, instmap::in, set(prog_var)::in,
list(instmap_delta)::out, recompute_info::in, recompute_info::out) is det.
-recompute_instmap_delta_cases_2(_Atomic, _Var, [], [],
+recompute_instmap_delta_cases_2(_RecomputeAtomic, _Var, [], [],
_VarTypes, _InstMap, _NonLocals, [], !RI).
-recompute_instmap_delta_cases_2(Atomic, Var, [Case0 | Cases0], [Case | Cases],
- VarTypes, InstMap0, NonLocals, [InstMapDelta | InstMapDeltas], !RI) :-
+recompute_instmap_delta_cases_2(RecomputeAtomic, Var,
+ [Case0 | Cases0], [Case | Cases], VarTypes, InstMap0, NonLocals,
+ [InstMapDelta | InstMapDeltas], !RI) :-
Case0 = case(MainConsId, OtherConsIds, Goal0),
map.lookup(VarTypes, Var, Type),
update_module_info(bind_var_to_functors(Var, Type,
MainConsId, OtherConsIds, InstMap0), InstMap1, !RI),
- recompute_instmap_delta_1(Atomic, Goal0, Goal, VarTypes, InstMap1,
+ recompute_instmap_delta_1(RecomputeAtomic, Goal0, Goal, VarTypes, InstMap1,
InstMapDelta0, !RI),
update_module_info(instmap_delta_bind_var_to_functors(Var, Type,
MainConsId, OtherConsIds, InstMap0, InstMapDelta0), InstMapDelta, !RI),
Case = case(MainConsId, OtherConsIds, Goal),
- recompute_instmap_delta_cases_2(Atomic, Var, Cases0, Cases,
+ recompute_instmap_delta_cases_2(RecomputeAtomic, Var, Cases0, Cases,
VarTypes, InstMap0, NonLocals, InstMapDeltas, !RI).
%-----------------------------------------------------------------------------%
@@ -1282,7 +1312,7 @@
recompute_instmap_delta_call(PredId, ProcId, Args, VarTypes, InstMap,
InstMapDelta, !RI) :-
- ModuleInfo = !.RI ^ module_info,
+ ModuleInfo = !.RI ^ ri_module_info,
module_info_pred_proc_info(ModuleInfo, PredId, ProcId, _, ProcInfo),
proc_info_interface_determinism(ProcInfo, Detism),
( determinism_components(Detism, _, at_most_zero) ->
@@ -1290,7 +1320,7 @@
;
proc_info_get_argmodes(ProcInfo, ArgModes0),
proc_info_get_inst_varset(ProcInfo, ProcInstVarSet),
- InstVarSet = !.RI ^ inst_varset,
+ InstVarSet = !.RI ^ ri_inst_varset,
rename_apart_inst_vars(InstVarSet, ProcInstVarSet,
ArgModes0, ArgModes1),
mode_list_get_initial_insts(ModuleInfo, ArgModes1, InitialInsts),
@@ -1389,7 +1419,7 @@
% Type specialization may require constructions of type-infos,
% typeclass-infos or predicate constants to be added to the
% instmap_delta.
- ModuleInfo = RI ^ module_info,
+ ModuleInfo = RI ^ ri_module_info,
(
Uni = deconstruct(Var, _ConsId, Vars, UniModes, _, _CanCGC),
Index: compiler/modes.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/modes.m,v
retrieving revision 1.366
diff -u -b -r1.366 modes.m
--- compiler/modes.m 22 Jan 2008 15:06:13 -0000 1.366
+++ compiler/modes.m 25 Jan 2008 05:52:11 -0000
@@ -961,7 +961,7 @@
mode_info_get_warnings(!.ModeInfo, ModeWarnings),
WarningSpecs = list.map(mode_warning_info_to_spec(!.ModeInfo),
ModeWarnings),
- list.append(ErrorSpecs, WarningSpecs, ErrorAndWarningSpecs)
+ ErrorAndWarningSpecs = ErrorSpecs ++ WarningSpecs
),
% Save away the results.
inst_lists_to_mode_list(ArgInitialInsts, ArgFinalInsts, ArgModes),
@@ -1297,25 +1297,64 @@
!ModeInfo),
Goal = hlds_goal(GoalExpr, GoalInfo).
-compute_goal_instmap_delta(InstMap0, GoalExpr, !GoalInfo, !ModeInfo) :-
- ( GoalExpr = conj(_, []) ->
- % When modecheck_unify.m replaces a unification with a dead variable
- % with `true', make sure the instmap_delta of the goal is empty.
- % The code generator and mode_util.recompute_instmap_delta can be
- % confused by references to the dead variable in the instmap_delta,
- % resulting in calls to error/1.
-
- instmap_delta_init_reachable(DeltaInstMap),
- mode_info_set_instmap(InstMap0, !ModeInfo)
+modecheck_goal_expr(GoalExpr0, GoalInfo0, GoalExpr, !ModeInfo, !IO) :-
+ % XXX The predicates we call here should have their definitions
+ % in the same order as this switch.
+ (
+ GoalExpr0 = unify(LHS0, RHS0, _UniMode, Unification0, UnifyContext),
+ modecheck_goal_unify(LHS0, RHS0, Unification0, UnifyContext, GoalInfo0,
+ GoalExpr, !ModeInfo, !IO)
+ ;
+ GoalExpr0 = plain_call(PredId, ProcId0, Args0, _Builtin,
+ MaybeCallUnifyContext, PredName),
+ modecheck_goal_plain_call(PredId, ProcId0, Args0,
+ MaybeCallUnifyContext, PredName, GoalInfo0, GoalExpr,
+ !ModeInfo, !IO)
;
- NonLocals = goal_info_get_nonlocals(!.GoalInfo),
- mode_info_get_instmap(!.ModeInfo, InstMap),
- compute_instmap_delta(InstMap0, InstMap, NonLocals, DeltaInstMap)
- ),
- goal_info_set_instmap_delta(DeltaInstMap, !GoalInfo).
+ GoalExpr0 = generic_call(GenericCall, Args0, Modes0, _Detism),
+ modecheck_goal_generic_call(GenericCall, Args0, Modes0, GoalInfo0,
+ GoalExpr, !ModeInfo, !IO)
+ ;
+ GoalExpr0 = call_foreign_proc(Attributes, PredId, ProcId0,
+ Args0, ExtraArgs, MaybeTraceRuntimeCond, PragmaCode),
+ modecheck_goal_call_foreign_proc(Attributes, PredId, ProcId0,
+ Args0, ExtraArgs, MaybeTraceRuntimeCond, PragmaCode,
+ GoalInfo0, GoalExpr, !ModeInfo, !IO)
+ ;
+ GoalExpr0 = conj(ConjType, Goals),
+ modecheck_goal_conj(ConjType, Goals, GoalInfo0, GoalExpr,
+ !ModeInfo, !IO)
+ ;
+ GoalExpr0 = disj(Goals),
+ modecheck_goal_disj(Goals, GoalInfo0, GoalExpr, !ModeInfo, !IO)
+ ;
+ GoalExpr0 = switch(Var, CanFail, Cases0),
+ modecheck_goal_switch(Var, CanFail, Cases0, GoalInfo0, GoalExpr,
+ !ModeInfo, !IO)
+ ;
+ GoalExpr0 = if_then_else(Vars, Cond0, Then0, Else0),
+ modecheck_goal_if_then_else(Vars, Cond0, Then0, Else0, GoalInfo0,
+ GoalExpr, !ModeInfo, !IO)
+ ;
+ GoalExpr0 = negation(SubGoal0),
+ modecheck_goal_negation(SubGoal0, GoalInfo0, GoalExpr, !ModeInfo, !IO)
+ ;
+ GoalExpr0 = scope(Reason, SubGoal0),
+ modecheck_goal_scope(Reason, SubGoal0, GoalInfo0, GoalExpr,
+ !ModeInfo, !IO)
+ ;
+ GoalExpr0 = shorthand(ShortHand0),
+ modecheck_goal_shorthand(ShortHand0, GoalInfo0, GoalExpr,
+ !ModeInfo, !IO)
+ ).
-modecheck_goal_expr(conj(ConjType, Goals0), GoalInfo0, GoalExpr,
- !ModeInfo, !IO) :-
+%-----------------------------------------------------------------------------%
+
+:- pred modecheck_goal_conj(conj_type::in, list(hlds_goal)::in,
+ hlds_goal_info::in, hlds_goal_expr::out,
+ mode_info::in, mode_info::out, io::di, io::uo) is det.
+
+modecheck_goal_conj(ConjType, Goals0, GoalInfo0, GoalExpr, !ModeInfo, !IO) :-
(
ConjType = plain_conj,
mode_checkpoint(enter, "conj", !ModeInfo, !IO),
@@ -1338,36 +1377,45 @@
mode_checkpoint(exit, "par_conj", !ModeInfo, !IO)
).
-modecheck_goal_expr(disj(Disjs0), GoalInfo0, GoalExpr, !ModeInfo, !IO) :-
+:- pred modecheck_goal_disj(list(hlds_goal)::in, hlds_goal_info::in,
+ hlds_goal_expr::out, mode_info::in, mode_info::out, io::di, io::uo) is det.
+
+modecheck_goal_disj(Disjuncts0, GoalInfo0, GoalExpr, !ModeInfo, !IO) :-
mode_checkpoint(enter, "disj", !ModeInfo, !IO),
(
- Disjs0 = [], % for efficiency, optimize common case
- GoalExpr = disj(Disjs0),
+ Disjuncts0 = [], % for efficiency, optimize common case
+ GoalExpr = disj(Disjuncts0),
instmap.init_unreachable(InstMap),
mode_info_set_instmap(InstMap, !ModeInfo)
;
% If you modify this code, you may also need to modify
% modecheck_clause_disj or the code that calls it.
-
- Disjs0 = [_ | _],
+ Disjuncts0 = [_ | _],
NonLocals = goal_info_get_nonlocals(GoalInfo0),
- modecheck_disj_list(Disjs0, Disjs1, InstMapList0, !ModeInfo, !IO),
+ modecheck_disj_list(Disjuncts0, Disjuncts1, InstMapList0,
+ !ModeInfo, !IO),
( mode_info_solver_init_is_supported(!.ModeInfo) ->
mode_info_get_var_types(!.ModeInfo, VarTypes),
handle_solver_vars_in_disjs(set.to_sorted_list(NonLocals),
- VarTypes, Disjs1, Disjs2, InstMapList0, InstMapList, !ModeInfo)
+ VarTypes, Disjuncts1, Disjuncts2, InstMapList0, InstMapList,
+ !ModeInfo)
;
InstMapList = InstMapList0,
- Disjs2 = Disjs1
+ Disjuncts2 = Disjuncts1
),
- Disjs = flatten_disjs(Disjs2),
- instmap_merge(NonLocals, InstMapList, disj, !ModeInfo),
- disj_list_to_goal(Disjs, GoalInfo0, hlds_goal(GoalExpr, _GoalInfo))
+ Disjuncts = flatten_disjs(Disjuncts2),
+ instmap_merge(NonLocals, InstMapList, merge_disj, !ModeInfo),
+ disj_list_to_goal(Disjuncts, GoalInfo0, hlds_goal(GoalExpr, _GoalInfo))
),
mode_checkpoint(exit, "disj", !ModeInfo, !IO).
-modecheck_goal_expr(if_then_else(Vars, Cond0, Then0, Else0), GoalInfo0,
- GoalExpr, !ModeInfo, !IO) :-
+:- pred modecheck_goal_if_then_else(list(prog_var)::in,
+ hlds_goal::in, hlds_goal::in, hlds_goal::in,
+ hlds_goal_info::in, hlds_goal_expr::out,
+ mode_info::in, mode_info::out, io::di, io::uo) is det.
+
+modecheck_goal_if_then_else(Vars, Cond0, Then0, Else0, GoalInfo0, GoalExpr,
+ !ModeInfo, !IO) :-
mode_checkpoint(enter, "if-then-else", !ModeInfo, !IO),
NonLocals = goal_info_get_nonlocals(GoalInfo0),
ThenVars = goal_get_nonlocals(Then0),
@@ -1400,7 +1448,7 @@
Then1, Then, Else1, Else,
InstMapThen1, InstMapThen, InstMapElse1, InstMapElse, !ModeInfo),
mode_info_set_instmap(InstMap0, !ModeInfo),
- instmap_merge(NonLocals, [InstMapThen, InstMapElse], if_then_else,
+ instmap_merge(NonLocals, [InstMapThen, InstMapElse], merge_if_then_else,
!ModeInfo),
GoalExpr = if_then_else(Vars, Cond, Then, Else),
mode_info_get_instmap(!.ModeInfo, InstMap),
@@ -1417,8 +1465,10 @@
),
mode_checkpoint(exit, "if-then-else", !ModeInfo, !IO).
-modecheck_goal_expr(negation(SubGoal0), GoalInfo0, negation(SubGoal),
- !ModeInfo, !IO) :-
+:- pred modecheck_goal_negation(hlds_goal::in, hlds_goal_info::in,
+ hlds_goal_expr::out, mode_info::in, mode_info::out, io::di, io::uo) is det.
+
+modecheck_goal_negation(SubGoal0, GoalInfo0, GoalExpr, !ModeInfo, !IO) :-
mode_checkpoint(enter, "not", !ModeInfo, !IO),
NonLocals = goal_info_get_nonlocals(GoalInfo0),
mode_info_get_instmap(!.ModeInfo, InstMap0),
@@ -1449,10 +1499,14 @@
;
InPromisePurityScope = in_promise_purity_scope
),
+ GoalExpr = negation(SubGoal),
mode_checkpoint(exit, "not", !ModeInfo, !IO).
-modecheck_goal_expr(scope(Reason, SubGoal0), GoalInfo0, GoalExpr, !ModeInfo,
- !IO) :-
+:- pred modecheck_goal_scope(scope_reason::in, hlds_goal::in,
+ hlds_goal_info::in, hlds_goal_expr::out,
+ mode_info::in, mode_info::out, io::di, io::uo) is det.
+
+modecheck_goal_scope(Reason, SubGoal0, GoalInfo0, GoalExpr, !ModeInfo, !IO) :-
(
Reason = trace_goal(_, _, _, _, _),
mode_checkpoint(enter, "scope", !ModeInfo, !IO),
@@ -1532,10 +1586,15 @@
mode_info_set_in_promise_purity_scope(InPPScope, !ModeInfo)
).
-modecheck_goal_expr(plain_call(PredId, ProcId0, Args0, _, Context, PredName),
- GoalInfo0, GoalExpr, !ModeInfo, !IO) :-
+:- pred modecheck_goal_plain_call(pred_id::in, proc_id::in,
+ list(prog_var)::in, maybe(call_unify_context)::in, sym_name::in,
+ hlds_goal_info::in, hlds_goal_expr::out,
+ mode_info::in, mode_info::out, io::di, io::uo) is det.
+
+modecheck_goal_plain_call(PredId, ProcId0, Args0, MaybeCallUnifyContext,
+ PredName, GoalInfo0, GoalExpr, !ModeInfo, !IO) :-
PredNameString = sym_name_to_string(PredName),
- string.append("call ", PredNameString, CallString),
+ CallString = "call " ++ PredNameString,
mode_checkpoint(enter, CallString, !ModeInfo, !IO),
mode_info_get_call_id(!.ModeInfo, PredId, CallId),
@@ -1550,15 +1609,20 @@
mode_info_get_module_info(!.ModeInfo, ModuleInfo),
mode_info_get_pred_id(!.ModeInfo, CallerPredId),
Builtin = builtin_state(ModuleInfo, CallerPredId, PredId, ProcId),
- Call = plain_call(PredId, ProcId, Args, Builtin, Context, PredName),
+ Call = plain_call(PredId, ProcId, Args, Builtin, MaybeCallUnifyContext,
+ PredName),
handle_extra_goals(Call, ExtraGoals, GoalInfo0, Args0, Args,
InstMap0, GoalExpr, !ModeInfo, !IO),
mode_info_unset_call_context(!ModeInfo),
mode_checkpoint(exit, CallString, !ModeInfo, !IO).
-modecheck_goal_expr(generic_call(GenericCall, Args0, Modes0, _),
- GoalInfo0, GoalExpr, !ModeInfo, !IO) :-
+:- pred modecheck_goal_generic_call(generic_call::in, list(prog_var)::in,
+ list(mer_mode)::in, hlds_goal_info::in, hlds_goal_expr::out,
+ mode_info::in, mode_info::out, io::di, io::uo) is det.
+
+modecheck_goal_generic_call(GenericCall, Args0, Modes0, GoalInfo0, GoalExpr,
+ !ModeInfo, !IO) :-
mode_checkpoint(enter, "generic_call", !ModeInfo, !IO),
mode_info_get_instmap(!.ModeInfo, InstMap0),
@@ -1638,17 +1702,25 @@
mode_info_unset_call_context(!ModeInfo),
mode_checkpoint(exit, "generic_call", !ModeInfo, !IO).
-modecheck_goal_expr(unify(LHS0, RHS0, _, UnifyInfo0, UnifyContext), GoalInfo0,
+:- pred modecheck_goal_unify(prog_var::in, unify_rhs::in,
+ unification::in, unify_context::in, hlds_goal_info::in,
+ hlds_goal_expr::out, mode_info::in, mode_info::out, io::di, io::uo) is det.
+
+modecheck_goal_unify(LHS0, RHS0, Unification0, UnifyContext, GoalInfo0,
GoalExpr, !ModeInfo, !IO) :-
mode_checkpoint(enter, "unify", !ModeInfo, !IO),
mode_info_set_call_context(call_context_unify(UnifyContext), !ModeInfo),
- modecheck_unification(LHS0, RHS0, UnifyInfo0, UnifyContext, GoalInfo0,
+ modecheck_unification(LHS0, RHS0, Unification0, UnifyContext, GoalInfo0,
GoalExpr, !ModeInfo, !IO),
mode_info_unset_call_context(!ModeInfo),
mode_checkpoint(exit, "unify", !ModeInfo, !IO).
-modecheck_goal_expr(switch(Var, CanFail, Cases0), GoalInfo0,
- switch(Var, CanFail, Cases), !ModeInfo, !IO) :-
+:- pred modecheck_goal_switch(prog_var::in, can_fail::in, list(case)::in,
+ hlds_goal_info::in, hlds_goal_expr::out,
+ mode_info::in, mode_info::out, io::di, io::uo) is det.
+
+modecheck_goal_switch(Var, CanFail, Cases0, GoalInfo0, GoalExpr,
+ !ModeInfo, !IO) :-
mode_checkpoint(enter, "switch", !ModeInfo, !IO),
(
Cases0 = [],
@@ -1658,20 +1730,26 @@
;
% If you modify this code, you may also need to modify
% modecheck_clause_switch or the code that calls it.
-
Cases0 = [_ | _],
NonLocals = goal_info_get_nonlocals(GoalInfo0),
modecheck_case_list(Cases0, Var, Cases, InstMapList, !ModeInfo, !IO),
- instmap_merge(NonLocals, InstMapList, disj, !ModeInfo)
+ instmap_merge(NonLocals, InstMapList, merge_disj, !ModeInfo)
),
+ GoalExpr = switch(Var, CanFail, Cases),
mode_checkpoint(exit, "switch", !ModeInfo, !IO).
+:- pred modecheck_goal_call_foreign_proc(pragma_foreign_proc_attributes::in,
+ pred_id::in, proc_id::in, list(foreign_arg)::in, list(foreign_arg)::in,
+ maybe(trace_expr(trace_runtime))::in, pragma_foreign_code_impl::in,
+ hlds_goal_info::in, hlds_goal_expr::out,
+ mode_info::in, mode_info::out, io::di, io::uo) is det.
+
+modecheck_goal_call_foreign_proc(Attributes, PredId, ProcId0, Args0, ExtraArgs,
+ MaybeTraceRuntimeCond, PragmaCode, GoalInfo0, GoalExpr,
+ !ModeInfo, !IO) :-
% To modecheck a foreign_proc, we just modecheck the proc for
% which it is the goal.
- %
-modecheck_goal_expr(ForeignProc, GoalInfo, GoalExpr, !ModeInfo, !IO) :-
- ForeignProc = call_foreign_proc(Attributes, PredId, ProcId0,
- Args0, ExtraArgs, MaybeTraceRuntimeCond, PragmaCode),
+
mode_checkpoint(enter, "pragma_foreign_code", !ModeInfo, !IO),
mode_info_get_call_id(!.ModeInfo, PredId, CallId),
mode_info_get_instmap(!.ModeInfo, InstMap0),
@@ -1680,7 +1758,7 @@
!ModeInfo),
ArgVars0 = list.map(foreign_arg_var, Args0),
modecheck_call_pred(PredId, DeterminismKnown, ProcId0, ProcId,
- ArgVars0, ArgVars, GoalInfo, ExtraGoals, !ModeInfo),
+ ArgVars0, ArgVars, GoalInfo0, ExtraGoals, !ModeInfo),
% zs: The assignment to Pragma looks wrong: instead of Args0,
% I think we should use Args after the following call:
@@ -1688,15 +1766,108 @@
% or is there some reason why Args0 and Args would be the same?
Pragma = call_foreign_proc(Attributes, PredId, ProcId, Args0, ExtraArgs,
MaybeTraceRuntimeCond, PragmaCode),
- handle_extra_goals(Pragma, ExtraGoals, GoalInfo, ArgVars0, ArgVars,
+ handle_extra_goals(Pragma, ExtraGoals, GoalInfo0, ArgVars0, ArgVars,
InstMap0, GoalExpr, !ModeInfo, !IO),
mode_info_unset_call_context(!ModeInfo),
mode_checkpoint(exit, "pragma_foreign_code", !ModeInfo, !IO).
-modecheck_goal_expr(shorthand(_), _, _, !ModeInfo, !IO) :-
- % these should have been expanded out by now
- unexpected(this_file, "modecheck_goal_expr: unexpected shorthand").
+:- pred modecheck_goal_shorthand(shorthand_goal_expr::in, hlds_goal_info::in,
+ hlds_goal_expr::out, mode_info::in, mode_info::out, io::di, io::uo) is det.
+
+modecheck_goal_shorthand(ShortHand0, GoalInfo0, GoalExpr, !ModeInfo, !IO) :-
+ (
+ ShortHand0 = atomic_goal(_, Outer, Inner, MaybeOutputVars,
+ MainGoal0, OrElseGoals0),
+
+ % The uniqueness of the Outer and Inner variables are handled by the
+ % addition of calls to the fake predicates "stm_inner_to_outer_io" and
+ % "stm_outer_to_inner_io" during the construction of the HLDS.
+ % These calls are removed when atomic goals are expanded.
+
+ mode_checkpoint(enter, "atomic", !ModeInfo, !IO),
+ AtomicGoalList0 = [MainGoal0 | OrElseGoals0],
+ NonLocals = goal_info_get_nonlocals(GoalInfo0),
+
+ % XXX STM: Locking the outer variables would generate an error message
+ % during mode analysis of the sub goal because of the calls to
+ % "stm_outer_to_inner_io" and "stm_inner_to_outer_io". I (lmika) don't
+ % think this is a 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 STM: Handling of solver vars
+ handle_solver_vars_in_disjs(set.to_sorted_list(NonLocals),
+ VarTypes, AtomicGoalList1, AtomicGoalList, InstMapList0,
+ InstMapList, !ModeInfo),
+ MainGoal = list.det_head(AtomicGoalList),
+ OrElseGoals = list.det_tail(AtomicGoalList),
+
+ instmap_merge(NonLocals, InstMapList, merge_stm_atomic, !ModeInfo),
+
+ % Here we determine the type of atomic goal this is. It could be argued
+ % that this should have been done in the typechecker, but the type of
+ % the outer variables could be unknown when the typechecker looks
+ % at the atomic goal.
+ %
+ % To prevent the need to traverse the code again, we will put this
+ % check here (also: types of variables must be known at this point).
+
+ Outer = atomic_interface_vars(OuterDI, OuterUO),
+ map.lookup(VarTypes, OuterDI, OuterDIType),
+ map.lookup(VarTypes, OuterUO, OuterUOType),
+ (
+ ( OuterDIType = io_state_type
+ ; OuterDIType = io_io_type
+ )
+ ->
+ GoalType = top_level_atomic_goal
+ ;
+ OuterDIType = stm_atomic_type
+ ->
+ GoalType = nested_atomic_goal
+ ;
+ unexpected(this_file,
+ "modecheck_goal_shorthand atomic_goal: Invalid outer var type")
+ ),
+
+ % The following are sanity checks.
+ expect(unify(OuterDIType, OuterUOType), this_file,
+ "modecheck_goal_shorthand atomic_goal: mismatched outer var type"),
+ Inner = atomic_interface_vars(InnerDI, InnerUO),
+ map.lookup(VarTypes, InnerDI, InnerDIType),
+ map.lookup(VarTypes, InnerUO, InnerUOType),
+ expect(unify(InnerDIType, stm_atomic_type), this_file,
+ "modecheck_goal_shorthand atomic_goal: Invalid inner var type"),
+ expect(unify(InnerUOType, stm_atomic_type), this_file,
+ "modecheck_goal_shorthand atomic_goal: Invalid inner var type"),
+
+ ShortHand = atomic_goal(GoalType, Outer, Inner, MaybeOutputVars,
+ MainGoal, OrElseGoals),
+ GoalExpr = shorthand(ShortHand),
+ mode_checkpoint(exit, "atomic", !ModeInfo, !IO)
+ ;
+ ShortHand0 = bi_implication(_, _),
+ % These should have been expanded out by now.
+ unexpected(this_file, "modecheck_goal_shorthand: bi_implication")
+ ).
+
+:- 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).
% If the condition of a negation or if-then-else contains any inst any
% non-locals (a potential referential transparency violation), then
@@ -1730,8 +1901,8 @@
append_extra_goals(extra_goals(BeforeGoals0, AfterGoals0),
extra_goals(BeforeGoals1, AfterGoals1),
extra_goals(BeforeGoals, AfterGoals)) :-
- list.append(BeforeGoals0, BeforeGoals1, BeforeGoals),
- list.append(AfterGoals0, AfterGoals1, AfterGoals).
+ BeforeGoals = BeforeGoals0 ++ BeforeGoals1,
+ AfterGoals = AfterGoals0 ++ AfterGoals1.
handle_extra_goals(MainGoal, no_extra_goals, _GoalInfo0, _Args0, _Args,
_InstMap0, MainGoal, !ModeInfo, !IO).
@@ -1773,7 +1944,7 @@
Context = goal_info_get_context(GoalInfo0),
handle_extra_goals_contexts(BeforeGoals0, Context, BeforeGoals),
handle_extra_goals_contexts(AfterGoals0, Context, AfterGoals),
- list.append(BeforeGoals, [Goal0 | AfterGoals], GoalList0),
+ GoalList0 = BeforeGoals ++ [Goal0 | AfterGoals],
mode_info_get_may_change_called_proc(!.ModeInfo, MayChangeCalledProc0),
@@ -2021,7 +2192,7 @@
Goals = Goals1 ++ Goals2,
mode_info_get_errors(!.ModeInfo, NewErrors),
- list.append(OldErrors, NewErrors, Errors),
+ Errors = OldErrors ++ NewErrors,
mode_info_set_errors(Errors, !ModeInfo),
% We only report impurity errors if there were no other errors.
@@ -2032,7 +2203,7 @@
% (making sure we report the errors in the correct order).
list.reverse(RevImpurityErrors, ImpurityErrors),
mode_info_get_errors(!.ModeInfo, Errors5),
- list.append(Errors5, ImpurityErrors, Errors6),
+ Errors6 = Errors5 ++ ImpurityErrors,
mode_info_set_errors(Errors6, !ModeInfo)
;
DelayedGoals = [FirstDelayedGoal | MoreDelayedGoals],
@@ -2101,10 +2272,10 @@
modecheck_conj_list_2(ConjType, [Goal0 | Goals0], Goals, !ImpurityErrors,
!ModeInfo, !IO) :-
(
- Goal0 = hlds_goal(conj(ConjType, ConjGoals), _),
+ Goal0 = hlds_goal(conj(plain_conj, ConjGoals), _),
ConjType = plain_conj
->
- list.append(ConjGoals, Goals0, Goals1),
+ Goals1 = ConjGoals ++ Goals0,
modecheck_conj_list_2(ConjType, Goals1, Goals, !ImpurityErrors,
!ModeInfo, !IO)
;
@@ -2182,7 +2353,7 @@
% Next, we attempt to wake up any pending goals, and then continue
% scheduling the rest of the goal.
delay_info_wakeup_goals(WokenGoals, DelayInfo1, DelayInfo),
- list.append(WokenGoals, Goals0, Goals1),
+ Goals1 = WokenGoals ++ Goals0,
(
WokenGoals = []
;
@@ -2820,6 +2991,23 @@
list.duplicate(ConsIdAdjustedArity, free, ArgInsts),
BoundInst = bound_functor(ConsId, ArgInsts).
+compute_goal_instmap_delta(InstMap0, GoalExpr, !GoalInfo, !ModeInfo) :-
+ ( GoalExpr = conj(_, []) ->
+ % When modecheck_unify.m replaces a unification with a dead variable
+ % with `true', make sure the instmap_delta of the goal is empty.
+ % The code generator and mode_util.recompute_instmap_delta can be
+ % confused by references to the dead variable in the instmap_delta,
+ % resulting in calls to error/1.
+
+ instmap_delta_init_reachable(DeltaInstMap),
+ mode_info_set_instmap(InstMap0, !ModeInfo)
+ ;
+ NonLocals = goal_info_get_nonlocals(!.GoalInfo),
+ mode_info_get_instmap(!.ModeInfo, InstMap),
+ compute_instmap_delta(InstMap0, InstMap, NonLocals, DeltaInstMap)
+ ),
+ goal_info_set_instmap_delta(DeltaInstMap, !GoalInfo).
+
%-----------------------------------------------------------------------------%
% Calculate the argument number offset that needs to be passed to
Index: compiler/module_qual.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/module_qual.m,v
retrieving revision 1.164
diff -u -b -r1.164 module_qual.m
--- compiler/module_qual.m 15 Feb 2008 08:31:59 -0000 1.164
+++ compiler/module_qual.m 15 Feb 2008 08:47:07 -0000
@@ -539,6 +539,12 @@
process_assert(G, Symbols, Success).
process_assert(trace_expr(_C, _R, _I, _M, G) - _, Symbols, Success) :-
process_assert(G, Symbols, Success).
+process_assert(atomic_expr(_, _, _, MainGoal, OrElseGoals) - _, Symbols,
+ Success) :-
+ process_assert(MainGoal, SymbolsMainGoal, SuccessMainGoal),
+ process_assert_list(OrElseGoals, SymbolsOrElseGoals, SuccessOrElseGoals),
+ list.append(SymbolsMainGoal, SymbolsOrElseGoals, Symbols),
+ bool.and(SuccessMainGoal, SuccessOrElseGoals, Success).
process_assert(implies_expr(GA, GB) - _, Symbols, Success) :-
process_assert(GA, SymbolsA, SuccessA),
process_assert(GB, SymbolsB, SuccessB),
@@ -598,6 +604,26 @@
Success = no
).
+ % process_assert(G, SNs, B)
+ %
+ % Performs process_assert on a list of goals.
+ %
+:- pred process_assert_list(list(goal)::in, list(sym_name)::out,
+ bool::out) is det.
+
+process_assert_list(ExprList, Symbols, Success) :-
+ (
+ ExprList = [],
+ Symbols = [],
+ Success = yes
+ ;
+ ExprList = [Expr | Rest],
+ process_assert(Expr, SymbolsE, SuccessE),
+ process_assert_list(Rest, SymbolsR, SuccessR),
+ list.append(SymbolsE, SymbolsR, Symbols),
+ bool.and(SuccessE, SuccessR, Success)
+ ).
+
% term_qualified_symbols(T, S)
%
% Given a term, T, return the list of all the sym_names, S, in the
Index: compiler/modules.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.445
diff -u -b -r1.445 modules.m
--- compiler/modules.m 15 Feb 2008 08:31:59 -0000 1.445
+++ compiler/modules.m 16 Feb 2008 08:04:10 -0000
@@ -2969,14 +2969,27 @@
add_implicit_imports(Items, Globals, !ImportDeps, !UseDeps) :-
!:ImportDeps = [mercury_public_builtin_module | !.ImportDeps],
!:UseDeps = [mercury_private_builtin_module | !.UseDeps],
- (
+ items_need_imports(Items, no, ItemsNeedTabling,
+ no, ItemsNeedTablingStatistics, no, ItemsNeedSTM),
% We should include mercury_table_builtin_module if the Items contain
- % a tabling pragma, or if one of --use-minimal-model and
- % --trace-table-io is specified.
-
- ( contains_tabling_pragma(Items, HasStatsPrime) ->
- HasStats = HasStatsPrime
+ % a tabling pragma, or if one of --use-minimal-model (either kind) and
+ % --trace-table-io is specified. In the former case, we may also need
+ % to import mercury_table_statistics_module.
+ (
+ ItemsNeedTabling = yes,
+ !:UseDeps = [mercury_table_builtin_module | !.UseDeps],
+ (
+ ItemsNeedTablingStatistics = yes,
+ !:UseDeps = [mercury_table_statistics_module | !.UseDeps]
+ ;
+ ItemsNeedTablingStatistics = no
+ )
;
+ ItemsNeedTabling = no,
+ expect(unify(ItemsNeedTablingStatistics, no), this_file,
+ "add_implicit_imports: tabling statistics without tabling"),
+ (
+ % These forms of tabling cannot ask for statistics.
(
globals.lookup_bool_option(Globals,
use_minimal_model_stack_copy, yes)
@@ -2985,19 +2998,19 @@
use_minimal_model_own_stacks, yes)
;
globals.lookup_bool_option(Globals, trace_table_io, yes)
- ),
- HasStats = table_dont_gather_statistics
)
->
- !:UseDeps = [mercury_table_builtin_module | !.UseDeps],
- (
- HasStats = table_dont_gather_statistics
+ !:UseDeps = [mercury_table_builtin_module | !.UseDeps]
;
- HasStats = table_gather_statistics,
- !:UseDeps = [mercury_table_statistics_module | !.UseDeps]
+ true
)
+ ),
+ (
+ ItemsNeedSTM = yes,
+ !:UseDeps = [mercury_stm_builtin_module, mercury_exception_module,
+ mercury_univ_module | !.UseDeps]
;
- true
+ ItemsNeedSTM = no
),
globals.lookup_bool_option(Globals, profile_deep, Deep),
(
@@ -3046,43 +3059,131 @@
SSDB = no
).
-:- pred contains_tabling_pragma(list(item)::in, table_attr_statistics::out)
- is semidet.
+:- pred items_need_imports(list(item)::in,
+ bool::in, bool::out, bool::in, bool::out, bool::in, bool::out) is det.
-contains_tabling_pragma(Items, HasStats) :-
- contains_tabling_pragma_2(Items, no, HasTabling,
- table_dont_gather_statistics, HasStats),
- HasTabling = yes.
-
-:- pred contains_tabling_pragma_2(list(item)::in, bool::in, bool::out,
- table_attr_statistics::in, table_attr_statistics::out) is det.
-
-contains_tabling_pragma_2([], !HasTabling, !HasStats).
-contains_tabling_pragma_2([Item | Items], !HasTabling, !HasStats) :-
+items_need_imports([], !ItemsNeedTabling,
+ !ItemsNeedTablingStatistics, !ItemsNeedSTM).
+items_need_imports([Item | Items], !ItemsNeedTabling,
+ !ItemsNeedTablingStatistics, !ItemsNeedSTM) :-
(
Item = item_pragma(ItemPragma),
ItemPragma = item_pragma_info(_, Pragma, _),
Pragma = pragma_tabled(_, _, _, _, _, MaybeAttributes)
->
- !:HasTabling = yes,
+ !:ItemsNeedTabling = yes,
(
MaybeAttributes = no,
- contains_tabling_pragma_2(Items, !HasTabling, !HasStats)
+ % We cannot be done yet. If !.ItemsNeedTablingStatistics and
+ % !.ItemsNeedSTM were already both `yes', !.ItemsNeedTabling
+ % would have been too, and we would have stopped before looking
+ % at this item.
+ items_need_imports(Items, !ItemsNeedTabling,
+ !ItemsNeedTablingStatistics, !ItemsNeedSTM)
;
MaybeAttributes = yes(Attributes),
StatsAttr = Attributes ^ table_attr_statistics,
(
StatsAttr = table_gather_statistics,
- !:HasStats = table_gather_statistics
- % We can stop recursing; later items cannot change the result.
+ !:ItemsNeedTablingStatistics = yes,
+ (
+ !.ItemsNeedSTM = yes
+ % There is nothing left to search for; stop recursing.
;
- StatsAttr = table_dont_gather_statistics,
- % Leave !HasStats as it is.
- contains_tabling_pragma_2(Items, !HasTabling, !HasStats)
+ !.ItemsNeedSTM = no,
+ items_need_imports(Items, !ItemsNeedTabling,
+ !ItemsNeedTablingStatistics, !ItemsNeedSTM)
)
+ ;
+ StatsAttr = table_dont_gather_statistics
+ )
+ )
+ ;
+ Item = item_clause(ItemClause),
+ Body = ItemClause ^ cl_body,
+ goal_contains_stm_atomic(Body) = yes
+ ->
+ !:ItemsNeedSTM = yes,
+ (
+ !.ItemsNeedTabling = yes,
+ !.ItemsNeedTablingStatistics = yes
+ ->
+ % There is nothing left to search for; stop recursing.
+ true
+ ;
+ items_need_imports(Items, !ItemsNeedTabling,
+ !ItemsNeedTablingStatistics, !ItemsNeedSTM)
)
;
- contains_tabling_pragma_2(Items, !HasTabling, !HasStats)
+ items_need_imports(Items, !ItemsNeedTabling,
+ !ItemsNeedTablingStatistics, !ItemsNeedSTM)
+ ).
+
+:- func goal_contains_stm_atomic(goal) = bool.
+
+goal_contains_stm_atomic(GoalExpr - _Context) = ContainsAtomic :-
+ (
+ ( GoalExpr = true_expr
+ ; GoalExpr = fail_expr
+ ),
+ ContainsAtomic = no
+ ;
+ ( GoalExpr = conj_expr(SubGoalA, SubGoalB)
+ ; GoalExpr = par_conj_expr(SubGoalA, SubGoalB)
+ ; GoalExpr = disj_expr(SubGoalA, SubGoalB)
+ ),
+ ContainsAtomic = two_goals_contain_stm_atomic(SubGoalA, SubGoalB)
+ ;
+ ( GoalExpr = some_expr(_, SubGoal)
+ ; GoalExpr = all_expr(_, SubGoal)
+ ; GoalExpr = some_state_vars_expr(_, SubGoal)
+ ; GoalExpr = all_state_vars_expr(_, SubGoal)
+ ; GoalExpr = promise_purity_expr(_, _, SubGoal)
+ ; GoalExpr = promise_equivalent_solutions_expr(_, _, _, SubGoal)
+ ; GoalExpr = promise_equivalent_solution_sets_expr(_, _, _, SubGoal)
+ ; GoalExpr = promise_equivalent_solution_arbitrary_expr(_, _, _,
+ SubGoal)
+ ; GoalExpr = trace_expr(_, _, _, _, SubGoal)
+ ),
+ ContainsAtomic = goal_contains_stm_atomic(SubGoal)
+ ;
+ ( GoalExpr = implies_expr(SubGoalA, SubGoalB)
+ ; GoalExpr = equivalent_expr(SubGoalA, SubGoalB)
+ ),
+ ContainsAtomic = two_goals_contain_stm_atomic(SubGoalA, SubGoalB)
+ ;
+ GoalExpr = not_expr(SubGoal),
+ ContainsAtomic = goal_contains_stm_atomic(SubGoal)
+ ;
+ GoalExpr = if_then_else_expr(_, _, Cond, Then, Else),
+ ContainsAtomic = three_goals_contain_stm_atomic(Cond, Then, Else)
+ ;
+ GoalExpr = atomic_expr(_, _, _, _, _),
+ ContainsAtomic = yes
+ ;
+ ( GoalExpr = event_expr(_, _)
+ ; GoalExpr = call_expr(_, _, _)
+ ; GoalExpr = unify_expr(_, _, _)
+ ),
+ ContainsAtomic = no
+ ).
+
+:- func two_goals_contain_stm_atomic(goal, goal) = bool.
+
+two_goals_contain_stm_atomic(GoalA, GoalB) = ContainsAtomic :-
+ ( goal_contains_stm_atomic(GoalA) = yes ->
+ ContainsAtomic = yes
+ ;
+ ContainsAtomic = goal_contains_stm_atomic(GoalB)
+ ).
+
+:- func three_goals_contain_stm_atomic(goal, goal, goal) = bool.
+
+three_goals_contain_stm_atomic(GoalA, GoalB, GoalC) = ContainsAtomic :-
+ ( goal_contains_stm_atomic(GoalA) = yes ->
+ ContainsAtomic = yes
+ ;
+ ContainsAtomic = two_goals_contain_stm_atomic(GoalB, GoalC)
).
% Warn if a module imports itself, or an ancestor.
Index: compiler/ordering_mode_constraints.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ordering_mode_constraints.m,v
retrieving revision 1.17
diff -u -b -r1.17 ordering_mode_constraints.m
--- compiler/ordering_mode_constraints.m 12 Nov 2007 03:52:44 -0000 1.17
+++ compiler/ordering_mode_constraints.m 5 Jan 2008 16:44:13 -0000
@@ -760,64 +760,53 @@
%
:- pred dump_goal_goal_paths(int::in, hlds_goal::in, io::di, io::uo) is det.
-dump_goal_goal_paths(Indent, hlds_goal(GoalExpr, GoalInfo), !IO) :-
+dump_goal_goal_paths(Indent, Goal, !IO) :-
+ Goal = hlds_goal(GoalExpr, GoalInfo),
GoalPath = goal_info_get_goal_path(GoalInfo),
GoalPathFormat = [words(goal_path_to_string(GoalPath)), nl],
write_error_pieces_maybe_with_context(no, Indent, GoalPathFormat, !IO),
- dump_goal_expr_goal_paths(Indent+1, GoalExpr, !IO).
- % dump_goal_expr_goal_paths(Indent, GoalExpr, !IO)
- %
- % Dumps the goal paths for each sub-goal in GoalExpr at level of indent
- % Indent, in the order they appear, and for each of their sub-goals in
- % turn, for the purposes of visually checking reordering.
- %
-:- pred dump_goal_expr_goal_paths(int::in, hlds_goal_expr::in, io::di, io::uo)
- is det.
-
-dump_goal_expr_goal_paths(_Indent, GoalExpr, !IO) :-
- %
- % Do nothing for atomic goals.
- %
+ % Dump the goal paths for each subgoal in GoalExpr at SubGoalIndent,
+ % in the order they appear, for the purposes of visually checking
+ % reordering.
+ SubGoalIndent = Indent + 1,
(
- GoalExpr = plain_call(_, _, _, _, _, _)
+ ( GoalExpr = plain_call(_, _, _, _, _, _)
+ ; GoalExpr = generic_call(_, _, _, _)
+ ; GoalExpr = unify(_, _, _, _, _)
+ ; GoalExpr = call_foreign_proc(_, _, _, _, _, _, _)
+ )
+ % There are no subgoals to recurse on.
;
- GoalExpr = generic_call(_, _, _, _)
+ GoalExpr = conj(_, Goals),
+ list.foldl(dump_goal_goal_paths(SubGoalIndent), Goals, !IO)
;
- GoalExpr = unify(_, _, _, _, _)
+ GoalExpr = disj(Goals),
+ list.foldl(dump_goal_goal_paths(SubGoalIndent), Goals, !IO)
;
- GoalExpr = call_foreign_proc(_, _, _, _, _, _, _)
- ).
-
-dump_goal_expr_goal_paths(_Indent, GoalExpr, !IO) :-
- (
GoalExpr = switch(_, _, _),
unexpected(this_file, "switch")
;
- GoalExpr = shorthand(_),
- unexpected(this_file, "shorthand")
- ).
-
-dump_goal_expr_goal_paths(Indent, GoalExpr, !IO) :-
- GoalExpr = conj(_, Goals),
- list.foldl(dump_goal_goal_paths(Indent), Goals, !IO).
-
-dump_goal_expr_goal_paths(Indent, GoalExpr, !IO) :-
- GoalExpr = disj(Goals),
- list.foldl(dump_goal_goal_paths(Indent), Goals, !IO).
-
-dump_goal_expr_goal_paths(Indent, GoalExpr, !IO) :-
- GoalExpr = negation(Goal),
- dump_goal_goal_paths(Indent, Goal, !IO).
-
-dump_goal_expr_goal_paths(Indent, GoalExpr, !IO) :-
- GoalExpr = scope(_, Goal),
- dump_goal_goal_paths(Indent, Goal, !IO).
-
-dump_goal_expr_goal_paths(Indent, GoalExpr, !IO) :-
GoalExpr = if_then_else(_, CondGoal, ThenGoal, ElseGoal),
Goals = [CondGoal, ThenGoal, ElseGoal],
- list.foldl(dump_goal_goal_paths(Indent), Goals, !IO).
+ list.foldl(dump_goal_goal_paths(SubGoalIndent), Goals, !IO)
+ ;
+ GoalExpr = negation(SubGoal),
+ dump_goal_goal_paths(SubGoalIndent, SubGoal, !IO)
+ ;
+ GoalExpr = scope(_, SubGoal),
+ dump_goal_goal_paths(SubGoalIndent, SubGoal, !IO)
+ ;
+ GoalExpr = shorthand(ShortHand),
+ (
+ ShortHand = atomic_goal(_, _, _, _, MainGoal, OrElseGoals),
+ Goals = [MainGoal | OrElseGoals],
+ list.foldl(dump_goal_goal_paths(SubGoalIndent), Goals, !IO)
+ ;
+ ShortHand = bi_implication(_, _),
+ unexpected(this_file, "bi_implication")
+ )
+ ).
%-----------------------------------------------------------------------------%
Index: compiler/pd_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/pd_util.m,v
retrieving revision 1.68
diff -u -b -r1.68 pd_util.m
--- compiler/pd_util.m 21 Feb 2008 04:22:41 -0000 1.68
+++ compiler/pd_util.m 22 Feb 2008 02:14:35 -0000
@@ -558,7 +558,7 @@
!:FoundBranch = yes
;
Goal = hlds_goal(GoalExpr, _),
- goal_is_atomic(GoalExpr)
+ goal_expr_has_subgoals(GoalExpr) = does_not_have_subgoals
),
get_branch_vars_goal_2(ModuleInfo, Goals, !.FoundBranch,
VarTypes, InstMap, !LeftVars, !Vars).
@@ -658,7 +658,7 @@
get_sub_branch_vars_goal(_, [], _, _, Vars, Vars, !Module).
get_sub_branch_vars_goal(ProcArgInfo, [Goal | GoalList],
- VarTypes, InstMap0, Vars0, SubVars, !ModuleInfo) :-
+ VarTypes, InstMap0, !.Vars, SubVars, !ModuleInfo) :-
Goal = hlds_goal(GoalExpr, GoalInfo),
(
GoalExpr = if_then_else(_, Cond, Then, Else),
@@ -667,18 +667,18 @@
instmap.apply_instmap_delta(InstMap0, CondDelta, InstMap1),
goal_to_conj_list(Then, ThenList),
examine_branch(!.ModuleInfo, ProcArgInfo, 1, ThenList,
- VarTypes, InstMap1, Vars0, Vars1),
+ VarTypes, InstMap1, !Vars),
goal_to_conj_list(Else, ElseList),
examine_branch(!.ModuleInfo, ProcArgInfo, 2, ElseList,
- VarTypes, InstMap0, Vars1, Vars2)
+ VarTypes, InstMap0, !Vars)
;
GoalExpr = disj(Goals),
examine_branch_list(!.ModuleInfo, ProcArgInfo,
- 1, Goals, VarTypes, InstMap0, Vars0, Vars2)
+ 1, Goals, VarTypes, InstMap0, !Vars)
;
GoalExpr = switch(Var, _, Cases),
examine_case_list(ProcArgInfo, 1, Var,
- Cases, VarTypes, InstMap0, Vars0, Vars2, !ModuleInfo)
+ Cases, VarTypes, InstMap0, !Vars, !ModuleInfo)
;
( GoalExpr = unify(_, _, _, _, _)
; GoalExpr = plain_call(_, _, _, _, _, _)
@@ -687,8 +687,7 @@
; GoalExpr = conj(_, _)
; GoalExpr = negation(_)
; GoalExpr = scope(_, _)
- ),
- Vars2 = Vars0
+ )
;
GoalExpr = shorthand(_),
unexpected(this_file, "get_sub_branch_vars_goal: shorthand")
@@ -696,7 +695,7 @@
InstMapDelta = goal_info_get_instmap_delta(GoalInfo),
instmap.apply_instmap_delta(InstMap0, InstMapDelta, InstMap),
get_sub_branch_vars_goal(ProcArgInfo, GoalList,
- VarTypes, InstMap, Vars2, SubVars, !ModuleInfo).
+ VarTypes, InstMap, !.Vars, SubVars, !ModuleInfo).
:- pred examine_branch_list(module_info::in, pd_arg_info::in, int::in,
hlds_goals::in, vartypes::in, instmap::in,
@@ -738,7 +737,9 @@
examine_branch(_, _, _, [], _, _, !Vars).
examine_branch(ModuleInfo, ProcArgInfo, BranchNo, [Goal | Goals],
VarTypes, InstMap, !Vars) :-
- ( Goal = hlds_goal(plain_call(PredId, ProcId, Args, _, _, _), _) ->
+ (
+ Goal = hlds_goal(plain_call(PredId, ProcId, Args, _, _, _), _)
+ ->
( map.search(ProcArgInfo, proc(PredId, ProcId), ThisProcArgInfo) ->
convert_branch_info(ThisProcArgInfo, Args, BranchInfo),
BranchInfo = pd_branch_info(!:Vars, _, _),
@@ -800,8 +801,8 @@
pd_info_get_proc_info(!.PDInfo, ProcInfo),
proc_info_get_vartypes(ProcInfo, VarTypes),
proc_info_get_inst_varset(ProcInfo, InstVarSet),
- recompute_instmap_delta(yes, Goal0, Goal, VarTypes, InstVarSet,
- InstMap, ModuleInfo0, ModuleInfo),
+ recompute_instmap_delta(recompute_atomic_instmap_deltas,
+ Goal0, Goal, VarTypes, InstVarSet, InstMap, ModuleInfo0, ModuleInfo),
pd_info_set_module_info(ModuleInfo, !PDInfo).
%-----------------------------------------------------------------------------%
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.327
diff -u -b -r1.327 polymorphism.m
--- compiler/polymorphism.m 11 Feb 2008 21:26:06 -0000 1.327
+++ compiler/polymorphism.m 12 Feb 2008 01:22:20 -0000
@@ -1107,8 +1107,20 @@
),
Goal = hlds_goal(GoalExpr, GoalInfo0)
;
- GoalExpr0 = shorthand(_),
- unexpected(this_file, "process_goal_expr: unexpected shorthand")
+ GoalExpr0 = shorthand(ShortHand0),
+ (
+ ShortHand0 = atomic_goal(GoalType, Outer, Inner, Vars,
+ MainGoal0, OrElseGoals0),
+ polymorphism_process_goal(MainGoal0, MainGoal, !Info),
+ polymorphism_process_goal_list(OrElseGoals0, OrElseGoals, !Info),
+ ShortHand = atomic_goal(GoalType, Outer, Inner, Vars,
+ MainGoal, OrElseGoals),
+ GoalExpr = shorthand(ShortHand),
+ Goal = hlds_goal(GoalExpr, GoalInfo0)
+ ;
+ ShortHand0 = bi_implication(_, _),
+ unexpected(this_file, "process_goal_expr: bi_implication")
+ )
).
% type_info_vars prepends a comma separated list of variables
Index: compiler/post_typecheck.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/post_typecheck.m,v
retrieving revision 1.124
diff -u -b -r1.124 post_typecheck.m
--- compiler/post_typecheck.m 18 Feb 2008 23:57:45 -0000 1.124
+++ compiler/post_typecheck.m 25 Feb 2008 06:26:58 -0000
@@ -78,6 +78,10 @@
:- pred post_typecheck_finish_imported_pred_no_io(module_info::in,
list(proc_id)::out, pred_info::in, pred_info::out) is det.
+ % For ill-typed preds, we just need to set the modes up correctly
+ % so that any calls to that pred from correctly-typed predicates
+ % won't result in spurious mode errors.
+ %
:- pred post_typecheck_finish_ill_typed_pred(module_info::in, pred_id::in,
pred_info::in, pred_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
@@ -436,21 +440,17 @@
:- func get_qualified_pred_name(module_info, pred_id) = sym_name.
-get_qualified_pred_name(ModuleInfo, PredId)
- = qualified(PredModule, PredName) :-
+get_qualified_pred_name(ModuleInfo, PredId) = SymName :-
module_info_pred_info(ModuleInfo, PredId, PredInfo),
PredModule = pred_info_module(PredInfo),
- PredName = pred_info_name(PredInfo).
+ PredName = pred_info_name(PredInfo),
+ SymName = qualified(PredModule, PredName).
%-----------------------------------------------------------------------------%
post_typecheck_finish_pred_no_io(ModuleInfo, ErrorProcs, !PredInfo) :-
propagate_types_into_modes(ModuleInfo, ErrorProcs, !PredInfo).
- % For ill-typed preds, we just need to set the modes up correctly
- % so that any calls to that pred from correctly-typed predicates
- % won't result in spurious mode errors.
- %
post_typecheck_finish_ill_typed_pred(ModuleInfo, PredId, !PredInfo, !Specs) :-
propagate_types_into_modes(ModuleInfo, ErrorProcs, !PredInfo),
report_unbound_inst_vars(ModuleInfo, PredId, ErrorProcs, !PredInfo,
@@ -475,9 +475,9 @@
post_typecheck_finish_imported_pred_no_io(ModuleInfo, ErrorProcIds,
!PredInfo) :-
- % Make sure the var-types field in the clauses_info is valid for imported
+ % Make sure the vartypes field in the clauses_info is valid for imported
% predicates. Unification procedures have clauses generated, so they
- % already have valid var-types.
+ % already have valid vartypes.
( pred_info_is_pseudo_imported(!.PredInfo) ->
true
;
@@ -572,8 +572,8 @@
:- pred in_interface_check(module_info::in, pred_info::in, hlds_goal::in,
list(error_spec)::in, list(error_spec)::out) is det.
-in_interface_check(ModuleInfo, PredInfo, hlds_goal(GoalExpr, GoalInfo),
- !Specs) :-
+in_interface_check(ModuleInfo, PredInfo, Goal, !Specs) :-
+ Goal = hlds_goal(GoalExpr, GoalInfo),
(
GoalExpr = plain_call(PredId, _, _, _, _,SymName),
module_info_pred_info(ModuleInfo, PredId, CallPredInfo),
@@ -623,30 +623,28 @@
GoalExpr = disj(Goals),
in_interface_check_list(ModuleInfo, PredInfo, Goals, !Specs)
;
- GoalExpr = negation(Goal),
- in_interface_check(ModuleInfo, PredInfo, Goal, !Specs)
+ GoalExpr = negation(SubGoal),
+ in_interface_check(ModuleInfo, PredInfo, SubGoal, !Specs)
;
- GoalExpr = scope(_, Goal),
- in_interface_check(ModuleInfo, PredInfo, Goal, !Specs)
+ GoalExpr = scope(_, SubGoal),
+ in_interface_check(ModuleInfo, PredInfo, SubGoal, !Specs)
;
- GoalExpr = if_then_else(_, If, Then, Else),
- in_interface_check(ModuleInfo, PredInfo, If, !Specs),
+ GoalExpr = if_then_else(_, Cond, Then, Else),
+ in_interface_check(ModuleInfo, PredInfo, Cond, !Specs),
in_interface_check(ModuleInfo, PredInfo, Then, !Specs),
in_interface_check(ModuleInfo, PredInfo, Else, !Specs)
;
- GoalExpr = shorthand(ShorthandGoal),
- in_interface_check_shorthand(ModuleInfo, PredInfo, ShorthandGoal,
- !Specs)
- ).
-
-:- pred in_interface_check_shorthand(module_info::in, pred_info::in,
- shorthand_goal_expr::in, list(error_spec)::in, list(error_spec)::out)
- is det.
-
-in_interface_check_shorthand(ModuleInfo, PredInfo, bi_implication(LHS, RHS),
- !Specs) :-
+ GoalExpr = shorthand(ShortHand),
+ (
+ ShortHand = atomic_goal(_, _, _, _, MainGoal, OrElseGoals),
+ in_interface_check(ModuleInfo, PredInfo, MainGoal, !Specs),
+ in_interface_check_list(ModuleInfo, PredInfo, OrElseGoals, !Specs)
+ ;
+ ShortHand = bi_implication(LHS, RHS),
in_interface_check(ModuleInfo, PredInfo, LHS, !Specs),
- in_interface_check(ModuleInfo, PredInfo, RHS, !Specs).
+ in_interface_check(ModuleInfo, PredInfo, RHS, !Specs)
+ )
+ ).
%-----------------------------------------------------------------------------%
@@ -663,21 +661,19 @@
pred_info_get_clauses_info(PredInfo, ClausesInfo),
clauses_info_get_vartypes(ClausesInfo, VarTypes),
map.lookup(VarTypes, Var, Type),
- ( type_to_ctor_and_args(Type, TypeCtor, _) ->
+ type_to_ctor_det(Type, TypeCtor),
module_info_get_type_table(ModuleInfo, Types),
map.lookup(Types, TypeCtor, TypeDefn),
get_type_defn_status(TypeDefn, TypeStatus),
- ( status_defined_in_impl_section(TypeStatus) = yes ->
+ DefinedInImpl = status_defined_in_impl_section(TypeStatus),
+ (
+ DefinedInImpl = yes,
ConsIdStr = cons_id_to_string(ConsId),
IdPieces = [words("constructor"), quote(ConsIdStr)],
report_assertion_interface_error(ModuleInfo, Context, IdPieces,
!Specs)
;
- true
- )
- ;
- unexpected(this_file,
- "in_interface_check_unify_rhs: type_to_ctor_and_args failed.")
+ DefinedInImpl = no
)
;
RHS = rhs_lambda_goal(_, _, _, _, _, _, _, _, Goal),
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.206
diff -u -b -r1.206 prog_data.m
--- compiler/prog_data.m 15 Feb 2008 08:31:59 -0000 1.206
+++ compiler/prog_data.m 15 Feb 2008 08:47:08 -0000
@@ -988,6 +988,10 @@
trace_state_var :: prog_var
).
+:- type atomic_component_state
+ ---> atomic_state_var(prog_var)
+ ; atomic_var_pair(prog_var, prog_var).
+
% These type equivalences are for the type of program variables
% and associated structures.
%
Index: compiler/prog_io_goal.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_io_goal.m,v
retrieving revision 1.53
diff -u -b -r1.53 prog_io_goal.m
--- compiler/prog_io_goal.m 22 Jan 2008 15:06:15 -0000 1.53
+++ compiler/prog_io_goal.m 25 Jan 2008 05:52:12 -0000
@@ -386,6 +386,28 @@
SubGoalErrors = get_any_errors1(MaybeSubGoal),
MaybeGoal = error1(ParamsErrors ++ SubGoalErrors)
).
+parse_goal_2("atomic", [ParamsTerm, SubTerm], Context, MaybeGoal, !VarSet) :-
+ parse_atomic_params(Context, ParamsTerm, MaybeParams),
+ parse_atomic_subexpr(SubTerm, MaybeSubGoals, !VarSet),
+ (
+ MaybeParams = ok1(Params),
+ MaybeSubGoals = ok2(MainGoal, OrElseGoals)
+ ->
+ convert_atomic_params(ParamsTerm, Params, MaybeComponents),
+ (
+ MaybeComponents = ok3(Outer, Inner, MaybeOutputVars),
+ GoalExpr = atomic_expr(Outer, Inner, MaybeOutputVars, MainGoal,
+ OrElseGoals),
+ MaybeGoal = ok1(GoalExpr - Context)
+ ;
+ MaybeComponents = error3(Errors),
+ MaybeGoal = error1(Errors)
+ )
+ ;
+ ParamsErrors = get_any_errors1(MaybeParams),
+ SubGoalErrors = get_any_errors2(MaybeSubGoals),
+ MaybeGoal = error1(ParamsErrors ++ SubGoalErrors)
+ ).
parse_goal_2("promise_equivalent_solutions", [VarsTerm, SubTerm], Context,
MaybeGoal, !VarSet) :-
parse_vars_and_state_vars(VarsTerm, MaybeVars),
@@ -638,8 +660,7 @@
MaybeHeadComponent = ok1(HeadComponent),
MaybeTailComponentsTerms = ok1(TailComponentsTerms)
->
- MaybeComponentsTerms = ok1([HeadComponent |
- TailComponentsTerms])
+ MaybeComponentsTerms = ok1([HeadComponent | TailComponentsTerms])
;
HeadErrors = get_any_errors1(MaybeHeadComponent),
TailErrors = get_any_errors1(MaybeTailComponentsTerms),
@@ -1056,6 +1077,313 @@
%-----------------------------------------------------------------------------%
+:- type atomic_component
+ ---> atomic_component_inner(atomic_component_state)
+ ; atomic_component_outer(atomic_component_state)
+ ; atomic_component_vars(list(prog_var)).
+
+:- pred parse_atomic_params(context::in, term::in,
+ maybe1(assoc_list(atomic_component, term))::out) is det.
+
+parse_atomic_params(Context, Term, MaybeComponentsTerms) :-
+ ( Term = term.functor(term.atom("[]"), [], _) ->
+ MaybeComponentsTerms = ok1([])
+ ; Term = term.functor(term.atom("[|]"), [HeadTerm, TailTerm], _) ->
+ parse_atomic_component(Term, HeadTerm, MaybeHeadComponent),
+ parse_atomic_params(Context, TailTerm, MaybeTailComponentsTerms),
+ (
+ MaybeHeadComponent = ok1(HeadComponent),
+ MaybeTailComponentsTerms = ok1(TailComponentsTerms)
+ ->
+ MaybeComponentsTerms = ok1([HeadComponent | TailComponentsTerms])
+ ;
+ HeadErrors = get_any_errors1(MaybeHeadComponent),
+ TailErrors = get_any_errors1(MaybeTailComponentsTerms),
+ MaybeComponentsTerms = error1(HeadErrors ++ TailErrors)
+ )
+ ;
+ (
+ Term = term.functor(_, _, _),
+ Msg = "invalid atomic goal parameter",
+ MaybeComponentsTerms = error1([Msg - Term])
+ ;
+ Term = term.variable(_, _),
+ Msg = "expected atomic goal parameter, found variable",
+ ErrorTerm = term.functor(term.atom(""), [], Context),
+ MaybeComponentsTerms = error1([Msg - ErrorTerm])
+ )
+ ).
+
+:- pred parse_atomic_subterm(string::in, term::in, term::in,
+ maybe1(atomic_component_state)::out) is det.
+
+parse_atomic_subterm(Name, ErrorTerm, Term, MaybeComponentTerm) :-
+ (
+ Term = term.functor(_, SubTerms, _),
+ ( SubTerms = [SubTerm] ->
+ parse_atomic_component_state(Name, SubTerm, MaybeCompState),
+ (
+ MaybeCompState = ok1(Component),
+ MaybeComponentTerm = ok1(Component)
+ ;
+ MaybeCompState = error1(Errors),
+ MaybeComponentTerm = error1(Errors)
+ )
+ ; SubTerms = [SubTermA, SubTermB] ->
+ parse_atomic_component_pair(Name, SubTermA, SubTermB,
+ MaybeCompState),
+ (
+ MaybeCompState = ok1(Component),
+ MaybeComponentTerm = ok1(Component)
+ ;
+ MaybeCompState = error1(Errors),
+ MaybeComponentTerm = error1(Errors)
+ )
+ ;
+ Msg = Name ++ " takes exactly one argument, " ++
+ "which should be a state variable " ++
+ "or a pair of variables",
+ MaybeComponentTerm = error1([Msg - Term])
+ )
+ ;
+ Term = term.variable(_, _),
+ Msg = "expected atomic goal parameter, found variable",
+ MaybeComponentTerm = error1([Msg - ErrorTerm])
+ ).
+
+:- pred parse_atomic_component(term::in, term::in,
+ maybe1(pair(atomic_component, term))::out) is det.
+
+parse_atomic_component(ErrorTerm, Term, MaybeComponentTerm) :-
+ (
+ Term = term.functor(Functor, SubTerms, _),
+ ( Functor = term.atom(Atom) ->
+ ( Atom = "outer" ->
+ parse_atomic_subterm(Atom, ErrorTerm, Term,
+ MaybeComponentSubTerm),
+ (
+ MaybeComponentSubTerm = ok1(CompTerm),
+ Component = atomic_component_outer(CompTerm),
+ MaybeComponentTerm = ok1(Component - Term)
+ ;
+ MaybeComponentSubTerm = error1(Errors),
+ MaybeComponentTerm = error1(Errors)
+ )
+ ; Atom = "inner" ->
+ parse_atomic_subterm(Atom, ErrorTerm, Term,
+ MaybeComponentSubTerm),
+ (
+ MaybeComponentSubTerm = ok1(CompTerm),
+ Component = atomic_component_inner(CompTerm),
+ MaybeComponentTerm = ok1(Component - Term)
+ ;
+ MaybeComponentSubTerm = error1(Errors),
+ MaybeComponentTerm = error1(Errors)
+ )
+ ; Atom = "vars" ->
+ ( SubTerms = [SubTerm] ->
+ parse_vars(SubTerm, MaybeVars),
+ (
+ MaybeVars = ok1(Vars),
+ list.map(term.coerce_var, Vars, ProgVars),
+ Component = atomic_component_vars(ProgVars),
+ MaybeComponentTerm = ok1(Component - Term)
+ ;
+ MaybeVars = error1(Errors),
+ MaybeComponentTerm = error1(Errors)
+ )
+ ;
+ Msg = Atom ++ " takes exactly one argument, " ++
+ "which should be a list of variable names",
+ MaybeComponentTerm = error1([Msg - Term])
+ )
+ ;
+ Msg = "invalid atomic goal parameter",
+ MaybeComponentTerm = error1([Msg - Term])
+ )
+ ;
+ Msg = "invalid atomic goal parameter",
+ MaybeComponentTerm = error1([Msg - Term])
+ )
+ ;
+ Term = term.variable(_, _),
+ Msg = "expected atomic goal parameter, found variable",
+ MaybeComponentTerm = error1([Msg - ErrorTerm])
+ ).
+
+:- pred parse_atomic_component_state(string::in, term::in,
+ maybe1(atomic_component_state)::out) is det.
+
+parse_atomic_component_state(Scope, Term, MaybeState) :-
+ (
+ Term = term.functor(term.atom("!"), [term.variable(Var, _)], _)
+ ->
+ term.coerce_var(Var, ProgVar),
+ MaybeState = ok1(atomic_state_var(ProgVar))
+ ;
+ Msg = atomic_component_state_error(Scope),
+ MaybeState = error1([Msg - Term])
+ ).
+
+:- pred parse_atomic_component_pair(string::in, term::in,
+ term::in, maybe1(atomic_component_state)::out) is det.
+
+parse_atomic_component_pair(Scope, TermA, TermB, MaybeState) :-
+ (
+ TermA = term.variable(VarA, _),
+ TermB = term.variable(VarB, _)
+ ->
+ term.coerce_var(VarA, ProgVarA),
+ term.coerce_var(VarB, ProgVarB),
+ MaybeState = ok1(atomic_var_pair(ProgVarA, ProgVarB))
+ ;
+ Msg = atomic_component_state_error(Scope),
+ MaybeState = error1([Msg - TermA])
+ ).
+
+:- func atomic_component_state_error(string) = string.
+
+atomic_component_state_error(Scope) =
+ "The argument of " ++ Scope ++ " should contain " ++
+ "either a state variable or a pair of variables".
+
+:- pred convert_atomic_params(term::in,
+ assoc_list(atomic_component, term)::in,
+ maybe3(atomic_component_state, atomic_component_state,
+ maybe(list(prog_var)))::out) is det.
+
+convert_atomic_params(ErrorTerm, Components, MaybeParams) :-
+ convert_atomic_params_2(ErrorTerm, Components, no, no, no, [],
+ MaybeParams).
+
+:- pred convert_atomic_params_2(term::in,
+ assoc_list(atomic_component, term)::in,
+ maybe(atomic_component_state)::in,
+ maybe(atomic_component_state)::in,
+ maybe(list(prog_var))::in,
+ assoc_list(string, term)::in,
+ maybe3(atomic_component_state, atomic_component_state,
+ maybe(list(prog_var)))::out) is det.
+
+convert_atomic_params_2(ErrorTerm, [], MaybeOuter, MaybeInner, MaybeVars,
+ Errors, MaybeParams) :-
+ (
+ Errors = [],
+ (
+ MaybeOuter = yes(Outer),
+ MaybeInner = yes(Inner),
+ MaybeParams = ok3(Outer, Inner, MaybeVars)
+ ;
+ MaybeOuter = yes(_),
+ MaybeInner = no,
+ Msg = "atomic goal is missing " ++
+ "a specification of the inner STM state",
+ MaybeParams = error3([Msg - ErrorTerm])
+ ;
+ MaybeOuter = no,
+ MaybeInner = yes(_),
+ Msg = "atomic goal is missing " ++
+ "a specification of the outer STM state",
+ MaybeParams = error3([Msg - ErrorTerm])
+ ;
+ MaybeOuter = no,
+ MaybeInner = no,
+ Msg = "atomic goal is missing " ++
+ "a specification of both the outer and inner STM state",
+ MaybeParams = error3([Msg - ErrorTerm])
+ )
+ ;
+ Errors = [_ | _],
+ MaybeParams = error3(Errors)
+ ).
+convert_atomic_params_2(ErrorTerm, [Component - Term | ComponentsTerms],
+ !.MaybeOuter, !.MaybeInner, !.MaybeVars, !.Errors, MaybeParams) :-
+ (
+ Component = atomic_component_outer(Outer),
+ (
+ !.MaybeOuter = no,
+ !:MaybeOuter = yes(Outer)
+ ;
+ !.MaybeOuter = yes(_),
+ Msg = "duplicate outer atomic parameter",
+ !:Errors = !.Errors ++ [Msg - Term]
+ )
+ ;
+ Component = atomic_component_inner(Inner),
+ (
+ !.MaybeInner = no,
+ !:MaybeInner = yes(Inner)
+ ;
+ !.MaybeInner = yes(_),
+ Msg = "duplicate inner atomic parameter",
+ !:Errors = !.Errors ++ [Msg - Term]
+ )
+ ;
+ Component = atomic_component_vars(Vars),
+ (
+ !.MaybeVars = no,
+ !:MaybeVars = yes(Vars)
+ ;
+ !.MaybeVars = yes(_),
+ Msg = "duplicate io trace parameter",
+ !:Errors = !.Errors ++ [Msg - Term]
+ )
+ ),
+ convert_atomic_params_2(ErrorTerm, ComponentsTerms,
+ !.MaybeOuter, !.MaybeInner, !.MaybeVars, !.Errors, MaybeParams).
+
+:- pred parse_atomic_subexpr(term::in, maybe2(goal, goals)::out,
+ prog_varset::in, prog_varset::out) is det.
+
+parse_atomic_subexpr(Term, MaybeSubExpr, !VarSet) :-
+ parse_atomic_subgoals_as_list(Term, MaybeGoalList, !VarSet),
+ ( MaybeGoalList = ok1(GoalList) ->
+ (
+ GoalList = [],
+ Msg = "atomic goal must have a subgoal",
+ MaybeSubExpr = error2([Msg - Term])
+ ;
+ GoalList = [MainSubGoalExpr | OrElseAlternativeSubExpr],
+ MaybeSubExpr = ok2(MainSubGoalExpr, OrElseAlternativeSubExpr)
+ )
+ ;
+ GoalListErrors = get_any_errors1(MaybeGoalList),
+ MaybeSubExpr = error2(GoalListErrors)
+ ).
+
+:- pred parse_atomic_subgoals_as_list(term::in, maybe1(list(goal))::out,
+ prog_varset::in, prog_varset::out) is det.
+
+parse_atomic_subgoals_as_list(Term, MaybeGoals, !VarSet) :-
+ (
+ Term = term.functor(term.atom("or_else"), [LeftGoal, RightGoal], _)
+ ->
+ parse_atomic_subgoals_as_list(LeftGoal, MaybeLeftGoalList, !VarSet),
+ parse_atomic_subgoals_as_list(RightGoal, MaybeRightGoalList, !VarSet),
+ (
+ MaybeLeftGoalList = ok1(LeftGoalList),
+ MaybeRightGoalList = ok1(RightGoalList)
+ ->
+ MaybeGoals = ok1(LeftGoalList ++ RightGoalList)
+ ;
+ LeftErrors = get_any_errors1(MaybeLeftGoalList),
+ RightErrors = get_any_errors1(MaybeRightGoalList),
+ MaybeGoals = error1(LeftErrors ++ RightErrors)
+ )
+ ;
+ parse_goal(Term, MaybeSubGoal, !VarSet),
+ (
+ MaybeSubGoal = ok1(SubGoal)
+ ->
+ MaybeGoals = ok1([SubGoal])
+ ;
+ SubGoalErrors = get_any_errors1(MaybeSubGoal),
+ MaybeGoals = error1(SubGoalErrors)
+ )
+ ).
+
+%-----------------------------------------------------------------------------%
+
:- pred parse_lambda_arg(term::in, prog_term::out, mer_mode::out) is semidet.
parse_lambda_arg(Term, ArgTerm, Mode) :-
Index: compiler/prog_item.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_item.m,v
retrieving revision 1.32
diff -u -b -r1.32 prog_item.m
--- compiler/prog_item.m 15 Feb 2008 08:32:00 -0000 1.32
+++ compiler/prog_item.m 15 Feb 2008 08:47:08 -0000
@@ -779,6 +779,23 @@
texpr_mutable_vars :: list(trace_mutable_var),
texpr_goal :: goal
)
+ ; atomic_expr(
+ % Subgoals of the atomic goal are parsed into the following
+ % datatype. During the creation of the parse tree, all
+ % subterms of the "orelse" operator are flattened and placed
+ % into a list. If this is the case, the first "orelse"
+ % alternative is stored in "main_goal" whilst the other
+ % alternatives are stored in "orelse_alternatives". If there
+ % are no "or_else" operators within the atomic subgoal,
+ % the subgoal is stored in "main_goal" whilst the
+ % "orelse_alternatives" list remains empty.
+
+ aexpr_outer :: atomic_component_state,
+ aexpr_inner :: atomic_component_state,
+ aexpr_output_vars :: maybe(list(prog_var)),
+ aexpr_main_goal :: goal,
+ aexpr_orelse_goals :: goals
+ )
% implications
; implies_expr(goal, goal)
Index: compiler/prog_rep.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_rep.m,v
retrieving revision 1.58
diff -u -b -r1.58 prog_rep.m
--- compiler/prog_rep.m 29 Jan 2008 04:59:42 -0000 1.58
+++ compiler/prog_rep.m 29 Jan 2008 05:00:21 -0000
@@ -298,7 +298,7 @@
vars_to_byte_list(Info, ArgVars) ++ AtomicBytes
;
GoalExpr = shorthand(_),
- % these should have been expanded out by now
+ % These should have been expanded out by now.
unexpected(this_file, "goal_expr_to_byte_list: unexpected shorthand")
).
Index: compiler/prog_type.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_type.m,v
retrieving revision 1.43
diff -u -b -r1.43 prog_type.m
--- compiler/prog_type.m 11 Feb 2008 21:26:07 -0000 1.43
+++ compiler/prog_type.m 12 Feb 2008 01:22:20 -0000
@@ -317,6 +317,8 @@
:- func sample_typeclass_info_type = mer_type.
:- func comparison_result_type = mer_type.
:- func io_state_type = mer_type.
+:- func io_io_type = mer_type.
+:- func stm_atomic_type = mer_type.
:- func region_type = mer_type.
% Succeed iff the given variable is of region_type.
@@ -922,6 +924,14 @@
Module = mercury_std_lib_module_name(unqualified("io")),
Name = qualified(Module, "state").
+io_io_type = defined_type(Name, [], kind_star) :-
+ Module = mercury_std_lib_module_name(unqualified("io")),
+ Name = qualified(Module, "io").
+
+stm_atomic_type = defined_type(Name, [], kind_star) :-
+ Module = mercury_std_lib_module_name(unqualified("stm_builtin")),
+ Name = qualified(Module, "stm").
+
region_type = defined_type(Name, [], kind_star) :-
Module = mercury_region_builtin_module,
Name = qualified(Module, "region").
Index: compiler/prog_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_util.m,v
retrieving revision 1.102
diff -u -b -r1.102 prog_util.m
--- compiler/prog_util.m 23 Nov 2007 07:35:22 -0000 1.102
+++ compiler/prog_util.m 30 Dec 2007 11:38:05 -0000
@@ -461,6 +461,22 @@
Mutables0, Mutables),
rename_in_goal(OldVar, NewVar, Goal0, Goal).
rename_in_goal_expr(OldVar, NewVar,
+ atomic_expr(InVars0, OutVars0, MaybeVars0, MainExpr0, OrElseExpr0),
+ atomic_expr(InVars, OutVars, MaybeVars, MainExpr, OrElseExpr)) :-
+ rename_in_atomic_varlist(OldVar, NewVar, InVars0, InVars),
+ rename_in_atomic_varlist(OldVar, NewVar, OutVars0, OutVars),
+ (
+ MaybeVars0 = no,
+ MaybeVars = no
+ ;
+ MaybeVars0 = yes(TransVars0),
+ list.map(rename_in_var(OldVar, NewVar),
+ TransVars0, TransVars),
+ MaybeVars = yes(TransVars)
+ ),
+ rename_in_goal(OldVar, NewVar, MainExpr0, MainExpr),
+ list.map(rename_in_goal(OldVar, NewVar), OrElseExpr0, OrElseExpr).
+rename_in_goal_expr(OldVar, NewVar,
implies_expr(GoalA0, GoalB0),
implies_expr(GoalA, GoalB)) :-
rename_in_goal(OldVar, NewVar, GoalA0, GoalA),
@@ -492,6 +508,21 @@
term.substitute(TermA0, OldVar, term.variable(NewVar, context_init), TermA),
term.substitute(TermB0, OldVar, term.variable(NewVar, context_init), TermB).
+:- pred rename_in_atomic_varlist(prog_var::in, prog_var::in,
+ atomic_component_state::in, atomic_component_state::out) is det.
+
+rename_in_atomic_varlist(OldVar, NewVar, Comp0, Comp) :-
+ (
+ Comp0 = atomic_state_var(SVar0),
+ rename_in_var(OldVar, NewVar, SVar0, SVar),
+ Comp = atomic_state_var(SVar)
+ ;
+ Comp0 = atomic_var_pair(IVar0, OVar0),
+ rename_in_var(OldVar, NewVar, IVar0, IVar),
+ rename_in_var(OldVar, NewVar, OVar0, OVar),
+ Comp = atomic_var_pair(IVar, OVar)
+ ).
+
:- pred rename_in_trace_mutable_var(prog_var::in, prog_var::in,
trace_mutable_var::in, trace_mutable_var::out) is det.
Index: compiler/prop_mode_constraints.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prop_mode_constraints.m,v
retrieving revision 1.18
diff -u -b -r1.18 prop_mode_constraints.m
--- compiler/prop_mode_constraints.m 7 Aug 2007 07:10:03 -0000 1.18
+++ compiler/prop_mode_constraints.m 5 Jan 2008 21:05:47 -0000
@@ -358,8 +358,21 @@
;
!.GoalExpr = call_foreign_proc(_, _, _, _, _, _, _)
;
- !.GoalExpr = shorthand(_),
- unexpected(this_file, "shorthand goal expression")
+ !.GoalExpr = shorthand(ShortHand0),
+ (
+ ShortHand0 = atomic_goal(GoalType, Outer, Inner, MaybeOutputVars,
+ MainGoal0, OrElseGoals0),
+ ensure_unique_arguments_in_goal(MainGoal0, MainGoal, !SeenSoFar,
+ !Varset, !Vartypes),
+ list.map_foldl3(ensure_unique_arguments_in_goal,
+ OrElseGoals0, OrElseGoals, !SeenSoFar, !Varset, !Vartypes),
+ ShortHand = atomic_goal(GoalType, Outer, Inner, MaybeOutputVars,
+ MainGoal, OrElseGoals),
+ !:GoalExpr = shorthand(ShortHand)
+ ;
+ ShortHand0 = bi_implication(_, _),
+ unexpected(this_file, "bi_implication")
+ )
).
% flatten_conjunction(!Goals) flattens the conjunction Goals - that
Index: compiler/purity.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/purity.m,v
retrieving revision 1.118
diff -u -b -r1.118 purity.m
--- compiler/purity.m 22 Jan 2008 15:06:15 -0000 1.118
+++ compiler/purity.m 25 Jan 2008 05:59:35 -0000
@@ -7,10 +7,11 @@
%-----------------------------------------------------------------------------%
%
% File: purity.m
-% Authors: scachte (Peter Schachte, main author and designer of purity system)
-% trd (modifications for impure functions)
-% Purpose: handle `impure' and `promise_pure' declarations;
-% finish off type checking.
+% Main authors: schachte (Peter Schachte, main author and designer of
+% purity system), trd (modifications for impure functions).
+
+% Purpose: handle `impure' and `promise_pure' declarations; finish off
+% type checking.
%
% The main purpose of this module is check the consistency of the `impure' and
% `promise_pure' (etc.) declarations, and to thus report error messages if the
@@ -18,8 +19,13 @@
% different clauses for different modes as impure, unless promised pure.
%
% This module also calls post_typecheck.m to perform the final parts of
-% type analysis, including resolution of predicate and function overloading
-% (see the comments in that file).
+% type analysis, including
+%
+% - resolution of predicate and function overloading
+% - checking the types of the outer variables in atomic goals, and insertion
+% of their conversions to and from the inner variables.
+%
+% (See the comments in typecheck.m and post_typecheck.m.)
%
% These actions cannot be done until after type inference is complete,
% so they need to be a separate "post-typecheck pass"; they are done
@@ -164,17 +170,21 @@
:- implementation.
:- import_module check_hlds.post_typecheck.
+:- import_module hlds.goal_util.
:- import_module hlds.hlds_clauses.
:- import_module hlds.hlds_error_util.
:- import_module hlds.hlds_goal.
+:- import_module hlds.hlds_rtti.
:- import_module hlds.passes_aux.
:- import_module hlds.pred_table.
+:- import_module hlds.quantification.
:- import_module libs.
:- import_module libs.compiler_util.
:- import_module libs.globals.
:- import_module libs.options.
:- import_module mdbcomp.
:- import_module mdbcomp.prim_data.
+:- import_module parse_tree.mercury_to_mercury.
:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_mode.
:- import_module parse_tree.prog_out.
@@ -184,7 +194,9 @@
:- import_module int.
:- import_module list.
:- import_module map.
+:- import_module maybe.
:- import_module pair.
+:- import_module set.
:- import_module string.
:- import_module term.
:- import_module varset.
@@ -299,13 +311,13 @@
clauses_info_clauses(Clauses0, !ClausesInfo),
clauses_info_get_vartypes(!.ClausesInfo, VarTypes0),
clauses_info_get_varset(!.ClausesInfo, VarSet0),
- RunPostTypecheck = yes,
- PurityInfo0 = purity_info(ModuleInfo, RunPostTypecheck,
- !.PredInfo, VarTypes0, VarSet0, [], dont_make_implicit_promises),
- compute_purity(Clauses0, Clauses, !.PredInfo, purity_pure, Purity,
- PurityInfo0, PurityInfo),
+ PurityInfo0 = purity_info(ModuleInfo, run_post_typecheck,
+ !.PredInfo, VarTypes0, VarSet0, [], dont_make_implicit_promises,
+ do_not_need_to_requantify),
+ compute_purity_for_clauses(Clauses0, Clauses, !.PredInfo,
+ purity_pure, Purity, PurityInfo0, PurityInfo),
PurityInfo = purity_info(_, _, !:PredInfo,
- VarTypes, VarSet, GoalSpecs, _),
+ VarTypes, VarSet, GoalSpecs, _, _),
clauses_info_set_vartypes(VarTypes, !ClausesInfo),
clauses_info_set_varset(VarSet, !ClausesInfo),
clauses_info_set_clauses(Clauses, !ClausesInfo),
@@ -354,14 +366,22 @@
proc_info_get_goal(ProcInfo0, Goal0),
proc_info_get_vartypes(ProcInfo0, VarTypes0),
proc_info_get_varset(ProcInfo0, VarSet0),
- RunPostTypeCheck = no,
- PurityInfo0 = purity_info(ModuleInfo, RunPostTypeCheck,
- !.PredInfo, VarTypes0, VarSet0, [], dont_make_implicit_promises),
+ PurityInfo0 = purity_info(ModuleInfo, do_not_run_post_typecheck,
+ !.PredInfo, VarTypes0, VarSet0, [], dont_make_implicit_promises,
+ do_not_need_to_requantify),
compute_goal_purity(Goal0, Goal, Bodypurity, _, PurityInfo0, PurityInfo),
- PurityInfo = purity_info(_, _, !:PredInfo, VarTypes, VarSet, _, _),
+ PurityInfo = purity_info(_, _, !:PredInfo, VarTypes, VarSet, _, _,
+ NeedToRequantify),
proc_info_set_goal(Goal, ProcInfo0, ProcInfo1),
proc_info_set_vartypes(VarTypes, ProcInfo1, ProcInfo2),
- proc_info_set_varset(VarSet, ProcInfo2, ProcInfo),
+ proc_info_set_varset(VarSet, ProcInfo2, ProcInfo3),
+ (
+ NeedToRequantify = need_to_requantify,
+ requantify_proc(ProcInfo3, ProcInfo)
+ ;
+ NeedToRequantify = do_not_need_to_requantify,
+ ProcInfo = ProcInfo3
+ ),
map.det_update(Procs0, ProcId, ProcInfo, Procs),
pred_info_set_procedures(Procs, !PredInfo),
@@ -414,15 +434,28 @@
% Infer the purity of a single (non-foreign_proc) predicate.
%
-:- pred compute_purity(list(clause)::in, list(clause)::out,
+:- pred compute_purity_for_clauses(list(clause)::in, list(clause)::out,
pred_info::in, purity::in, purity::out,
purity_info::in, purity_info::out) is det.
-compute_purity([], [], _, !Purity, !Info).
-compute_purity([Clause0 | Clauses0], [Clause | Clauses], PredInfo, !Purity,
- !Info) :-
- Clause0 = clause(Ids, hlds_goal(GoalExpr0, GoalInfo0), Lang, Context),
- compute_expr_purity(GoalExpr0, GoalExpr, GoalInfo0, BodyPurity0, _, !Info),
+compute_purity_for_clauses([], [], _, !Purity, !Info).
+compute_purity_for_clauses([Clause0 | Clauses0], [Clause | Clauses], PredInfo,
+ !Purity, !Info) :-
+ compute_purity_for_clause(Clause0, Clause, PredInfo, ClausePurity, !Info),
+ !:Purity = worst_purity(!.Purity, ClausePurity),
+ compute_purity_for_clauses(Clauses0, Clauses, PredInfo, !Purity, !Info).
+
+ % Infer the purity of a single clause.
+ %
+:- pred compute_purity_for_clause(clause::in, clause::out, pred_info::in,
+ purity::out, purity_info::in, purity_info::out) is det.
+
+compute_purity_for_clause(Clause0, Clause, PredInfo, Purity, !Info) :-
+ Clause0 = clause(Ids, Goal0, Lang, Context),
+ Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
+ !Info ^ pi_requant := do_not_need_to_requantify,
+ compute_expr_purity(GoalExpr0, GoalExpr1, GoalInfo0, BodyPurity0, _,
+ !Info),
% If this clause doesn't apply to all modes of this procedure,
% i.e. the procedure has different clauses for different modes,
% then we must treat it as impure, unless the programmer has promised
@@ -447,11 +480,28 @@
;
ClausePurity = purity_impure
),
- BodyPurity = worst_purity(BodyPurity0, ClausePurity),
- goal_info_set_purity(BodyPurity, GoalInfo0, GoalInfo),
- !:Purity = worst_purity(!.Purity, BodyPurity),
- Clause = clause(Ids, hlds_goal(GoalExpr, GoalInfo), Lang, Context),
- compute_purity(Clauses0, Clauses, PredInfo, !Purity, !Info).
+ Purity = worst_purity(BodyPurity0, ClausePurity),
+ goal_info_set_purity(Purity, GoalInfo0, GoalInfo1),
+ Goal1 = hlds_goal(GoalExpr1, GoalInfo1),
+ NeedToRequantify = !.Info ^ pi_requant,
+ (
+ NeedToRequantify = need_to_requantify,
+ pred_info_get_clauses_info(PredInfo, ClausesInfo),
+ clauses_info_get_headvar_list(ClausesInfo, HeadVars),
+ VarTypes1 = !.Info ^ pi_vartypes,
+ VarSet1 = !.Info ^ pi_varset,
+ % The RTTI varmaps here are just a dummy value, because the real ones
+ % are not introduced until polymorphism.
+ rtti_varmaps_init(EmptyRttiVarmaps),
+ implicitly_quantify_clause_body(HeadVars, _Warnings, Goal1, Goal,
+ VarSet1, VarSet, VarTypes1, VarTypes, EmptyRttiVarmaps, _),
+ !Info ^ pi_vartypes := VarTypes,
+ !Info ^ pi_varset := VarSet
+ ;
+ NeedToRequantify = do_not_need_to_requantify,
+ Goal = Goal1
+ ),
+ Clause = clause(Ids, Goal, Lang, Context).
:- pred applies_to_all_modes(clause::in, list(proc_id)::in) is semidet.
@@ -470,8 +520,10 @@
hlds_goal_info::in, purity::out, contains_trace_goal::out,
purity_info::in, purity_info::out) is det.
-compute_expr_purity(conj(ConjType, Goals0), conj(ConjType, Goals), _,
- Purity, ContainsTrace, !Info) :-
+compute_expr_purity(GoalExpr0, GoalExpr, GoalInfo, Purity, ContainsTrace,
+ !Info) :-
+ (
+ GoalExpr0 = conj(ConjType, Goals0),
(
ConjType = plain_conj,
compute_goals_purity(Goals0, Goals, purity_pure, Purity,
@@ -480,72 +532,80 @@
ConjType = parallel_conj,
compute_parallel_goals_purity(Goals0, Goals, purity_pure, Purity,
contains_no_trace_goal, ContainsTrace, !Info)
- ).
-compute_expr_purity(Goal0, Goal, GoalInfo, ActualPurity,
- contains_no_trace_goal, !Info) :-
- Goal0 = plain_call(PredId0, ProcId, Vars, BIState, UContext, Name0),
- RunPostTypecheck = !.Info ^ run_post_typecheck,
- PredInfo = !.Info ^ pred_info,
- ModuleInfo = !.Info ^ module_info,
- (
- RunPostTypecheck = yes,
- finally_resolve_pred_overloading(Vars, PredInfo, ModuleInfo,
- Name0, Name, PredId0, PredId),
+ ),
+ GoalExpr = conj(ConjType, Goals)
+ ;
+ GoalExpr0 = plain_call(PredId0, ProcId, ArgVars, Status,
+ MaybeUnifyContext, SymName0),
+ RunPostTypecheck = !.Info ^ pi_run_post_typecheck,
+ PredInfo = !.Info ^ pi_pred_info,
+ ModuleInfo = !.Info ^ pi_module_info,
+ (
+ RunPostTypecheck = run_post_typecheck,
+ finally_resolve_pred_overloading(ArgVars, PredInfo, ModuleInfo,
+ SymName0, SymName, PredId0, PredId),
(
% Convert any calls to private_builtin.unsafe_type_cast
% into unsafe_type_cast generic calls.
- Name = qualified(mercury_private_builtin_module,
+ SymName = qualified(mercury_private_builtin_module,
"unsafe_type_cast"),
- Vars = [InputArg, OutputArg]
+ ArgVars = [InputArg, OutputArg]
->
- Goal = generic_call(cast(unsafe_type_cast), [InputArg, OutputArg],
- [in_mode, out_mode], detism_det)
+ GoalExpr = generic_call(cast(unsafe_type_cast),
+ [InputArg, OutputArg], [in_mode, out_mode], detism_det)
;
- Goal = plain_call(PredId, ProcId, Vars, BIState, UContext, Name)
+ GoalExpr = plain_call(PredId, ProcId, ArgVars, Status,
+ MaybeUnifyContext, SymName)
)
;
- RunPostTypecheck = no,
+ RunPostTypecheck = do_not_run_post_typecheck,
PredId = PredId0,
- Goal = Goal0
+ GoalExpr = GoalExpr0
),
DeclaredPurity = goal_info_get_purity(GoalInfo),
CallContext = goal_info_get_context(GoalInfo),
perform_goal_purity_checks(CallContext, PredId,
- DeclaredPurity, ActualPurity, !Info).
-compute_expr_purity(generic_call(GenericCall0, Args, Modes0, Det),
- GoalExpr, _GoalInfo, Purity, contains_no_trace_goal, !Info) :-
+ DeclaredPurity, ActualPurity, !Info),
+ Purity = ActualPurity,
+ ContainsTrace = contains_no_trace_goal
+ ;
+ GoalExpr0 = generic_call(GenericCall0, _ArgVars, _Modes0, _Det),
+ GoalExpr = GoalExpr0,
(
- GenericCall0 = higher_order(_, Purity, _, _),
- GoalExpr = generic_call(GenericCall0, Args, Modes0, Det)
+ GenericCall0 = higher_order(_, Purity, _, _)
;
GenericCall0 = class_method(_, _, _, _),
- Purity = purity_pure, % XXX this is wrong!
- GoalExpr = generic_call(GenericCall0, Args, Modes0, Det)
+ Purity = purity_pure % XXX this is wrong!
;
( GenericCall0 = cast(_)
; GenericCall0 = event_call(_)
),
- Purity = purity_pure,
- GoalExpr = generic_call(GenericCall0, Args, Modes0, Det)
- ).
-compute_expr_purity(switch(Var, Canfail, Cases0),
- switch(Var, Canfail, Cases), _, Purity, ContainsTrace, !Info) :-
+ Purity = purity_pure
+ ),
+ ContainsTrace = contains_no_trace_goal
+ ;
+ GoalExpr0 = switch(Var, Canfail, Cases0),
compute_cases_purity(Cases0, Cases, purity_pure, Purity,
- contains_no_trace_goal, ContainsTrace, !Info).
-compute_expr_purity(Unif0, GoalExpr, GoalInfo, ActualPurity,
- ContainsTrace, !Info) :-
- Unif0 = unify(Var, RHS0, Mode, Unification, UnifyContext),
- (
- RHS0 = rhs_lambda_goal(LambdaPurity, Groundness, F, EvalMethod, H,
- Vars, Modes, K, hlds_goal(LambdaGoalExpr0, LambdaGoalInfo0)),
- compute_expr_purity(LambdaGoalExpr0, LambdaGoalExpr, LambdaGoalInfo0,
- GoalPurity, _, !Info),
- RHS = rhs_lambda_goal(LambdaPurity, Groundness, F, EvalMethod, H, Vars,
- Modes, K, hlds_goal(LambdaGoalExpr, LambdaGoalInfo0)),
+ contains_no_trace_goal, ContainsTrace, !Info),
+ GoalExpr = switch(Var, Canfail, Cases)
+ ;
+ GoalExpr0 = unify(LHS, RHS0, Mode, Unification, UnifyContext),
+ (
+ RHS0 = rhs_lambda_goal(LambdaPurity, Groundness, PredOrFunc,
+ EvalMethod, LambdaNonLocals, LambdaQuantVars,
+ LambdaModes, LambdaDetism, LambdaGoal0),
+ LambdaGoal0 = hlds_goal(LambdaGoalExpr0, LambdaGoalInfo0),
+ compute_expr_purity(LambdaGoalExpr0, LambdaGoalExpr,
+ LambdaGoalInfo0, GoalPurity, _, !Info),
+ LambdaGoal = hlds_goal(LambdaGoalExpr, LambdaGoalInfo0),
+ RHS = rhs_lambda_goal(LambdaPurity, Groundness, PredOrFunc,
+ EvalMethod, LambdaNonLocals, LambdaQuantVars,
+ LambdaModes, LambdaDetism, LambdaGoal),
+
check_closure_purity(GoalInfo, LambdaPurity, GoalPurity, !Info),
- GoalExpr = unify(Var, RHS, Mode, Unification, UnifyContext),
- % the unification itself is always pure,
- % even if the lambda expression body is impure
+ GoalExpr = unify(LHS, RHS, Mode, Unification, UnifyContext),
+ % The unification itself is always pure,
+ % even if the lambda expression body is impure.
DeclaredPurity = goal_info_get_purity(GoalInfo),
(
( DeclaredPurity = purity_impure
@@ -561,26 +621,26 @@
ContainsTrace = contains_no_trace_goal
;
RHS0 = rhs_functor(ConsId, _, Args),
- RunPostTypecheck = !.Info ^ run_post_typecheck,
+ RunPostTypecheck = !.Info ^ pi_run_post_typecheck,
(
- RunPostTypecheck = yes,
- ModuleInfo = !.Info ^ module_info,
- PredInfo0 = !.Info ^ pred_info,
- VarTypes0 = !.Info ^ vartypes,
- VarSet0 = !.Info ^ varset,
- post_typecheck.resolve_unify_functor(Var, ConsId, Args, Mode,
+ RunPostTypecheck = run_post_typecheck,
+ ModuleInfo = !.Info ^ pi_module_info,
+ PredInfo0 = !.Info ^ pi_pred_info,
+ VarTypes0 = !.Info ^ pi_vartypes,
+ VarSet0 = !.Info ^ pi_varset,
+ post_typecheck.resolve_unify_functor(LHS, ConsId, Args, Mode,
Unification, UnifyContext, GoalInfo, ModuleInfo,
PredInfo0, PredInfo, VarTypes0, VarTypes, VarSet0, VarSet,
Goal1),
- !:Info = !.Info ^ vartypes := VarTypes,
- !:Info = !.Info ^ varset := VarSet,
- !:Info = !.Info ^ pred_info := PredInfo
+ !Info ^ pi_vartypes := VarTypes,
+ !Info ^ pi_varset := VarSet,
+ !Info ^ pi_pred_info := PredInfo
;
- RunPostTypecheck = no,
- Goal1 = hlds_goal(Unif0, GoalInfo)
+ RunPostTypecheck = do_not_run_post_typecheck,
+ Goal1 = hlds_goal(GoalExpr0, GoalInfo)
),
( Goal1 = hlds_goal(unify(_, _, _, _, _), _) ->
- check_higher_order_purity(GoalInfo, ConsId, Var, Args,
+ check_higher_order_purity(GoalInfo, ConsId, LHS, Args,
ActualPurity, !Info),
ContainsTrace = contains_no_trace_goal,
Goal = Goal1
@@ -591,63 +651,61 @@
Goal = hlds_goal(GoalExpr, _)
;
RHS0 = rhs_var(_),
- GoalExpr = Unif0,
+ GoalExpr = GoalExpr0,
ActualPurity = purity_pure,
ContainsTrace = contains_no_trace_goal
- ).
-compute_expr_purity(disj(Goals0), disj(Goals), _, Purity, ContainsTrace,
- !Info) :-
+ ),
+ Purity = ActualPurity
+ ;
+ GoalExpr0 = disj(Goals0),
compute_goals_purity(Goals0, Goals, purity_pure, Purity,
- contains_no_trace_goal, ContainsTrace, !Info).
-compute_expr_purity(negation(Goal0), NotGoal, GoalInfo0, Purity, ContainsTrace,
- !Info) :-
+ contains_no_trace_goal, ContainsTrace, !Info),
+ GoalExpr = disj(Goals)
+ ;
+ GoalExpr0 = negation(Goal0),
% Eliminate double negation.
- negate_goal(Goal0, GoalInfo0, NotGoal0),
+ negate_goal(Goal0, GoalInfo, NotGoal0),
( NotGoal0 = hlds_goal(negation(Goal1), _) ->
compute_goal_purity(Goal1, Goal, Purity, ContainsTrace, !Info),
- NotGoal = negation(Goal)
+ GoalExpr = negation(Goal)
;
- compute_goal_purity(NotGoal0, NotGoal1, Purity, ContainsTrace, !Info),
- NotGoal1 = hlds_goal(NotGoal, _)
- ).
-compute_expr_purity(scope(Reason, Goal0), scope(Reason, Goal),
- _, Purity, ContainsTrace, !Info) :-
+ compute_goal_purity(NotGoal0, NotGoal1, Purity, ContainsTrace,
+ !Info),
+ NotGoal1 = hlds_goal(GoalExpr, _)
+ )
+ ;
+ GoalExpr0 = scope(Reason, Goal0),
(
Reason = exist_quant(_),
compute_goal_purity(Goal0, Goal, Purity, ContainsTrace, !Info)
;
Reason = promise_purity(Implicit, PromisedPurity),
- ImplicitPurity0 = !.Info ^ implicit_purity,
+ ImplicitPurity0 = !.Info ^ pi_implicit_purity,
(
Implicit = make_implicit_promises,
- !:Info = !.Info ^ implicit_purity := Implicit
+ !:Info = !.Info ^ pi_implicit_purity := Implicit
;
Implicit = dont_make_implicit_promises
),
compute_goal_purity(Goal0, Goal, _, ContainsTrace, !Info),
- !:Info = !.Info ^ implicit_purity := ImplicitPurity0,
+ !:Info = !.Info ^ pi_implicit_purity := ImplicitPurity0,
Purity = PromisedPurity
;
- Reason = promise_solutions(_, _),
- compute_goal_purity(Goal0, Goal, Purity, ContainsTrace, !Info)
- ;
- Reason = commit(_),
- compute_goal_purity(Goal0, Goal, Purity, ContainsTrace, !Info)
- ;
- Reason = barrier(_),
- compute_goal_purity(Goal0, Goal, Purity, ContainsTrace, !Info)
- ;
- Reason = from_ground_term(_),
+ ( Reason = promise_solutions(_, _)
+ ; Reason = commit(_)
+ ; Reason = barrier(_)
+ ; Reason = from_ground_term(_)
+ ),
compute_goal_purity(Goal0, Goal, Purity, ContainsTrace, !Info)
;
Reason = trace_goal(_, _, _, _, _),
compute_goal_purity(Goal0, Goal, _SubPurity, _, !Info),
Purity = purity_pure,
ContainsTrace = contains_trace_goal
- ).
-compute_expr_purity(if_then_else(Vars, Cond0, Then0, Else0),
- if_then_else(Vars, Cond, Then, Else), _, Purity, ContainsTrace,
- !Info) :-
+ ),
+ GoalExpr = scope(Reason, Goal)
+ ;
+ GoalExpr0 = if_then_else(Vars, Cond0, Then0, Else0),
compute_goal_purity(Cond0, Cond, Purity1, ContainsTrace1, !Info),
compute_goal_purity(Then0, Then, Purity2, ContainsTrace2, !Info),
compute_goal_purity(Else0, Else, Purity3, ContainsTrace3, !Info),
@@ -662,31 +720,202 @@
ContainsTrace = contains_trace_goal
;
ContainsTrace = contains_no_trace_goal
- ).
-compute_expr_purity(ForeignProc0, ForeignProc, _, Purity,
- contains_no_trace_goal, !Info) :-
- ForeignProc0 = call_foreign_proc(_, _, _, _, _, _, _),
- Attributes = ForeignProc0 ^ foreign_attr,
- PredId = ForeignProc0 ^ foreign_pred_id,
- ModuleInfo = !.Info ^ module_info,
+ ),
+ GoalExpr = if_then_else(Vars, Cond, Then, Else)
+ ;
+ GoalExpr0 = call_foreign_proc(Attributes, PredId, _, _, _, _, _),
+ ModuleInfo = !.Info ^ pi_module_info,
LegacyBehaviour = get_legacy_purity_behaviour(Attributes),
(
LegacyBehaviour = yes,
% Get the purity from the declaration, and set it here so that
% it is correct for later use.
-
module_info_pred_info(ModuleInfo, PredId, PredInfo),
pred_info_get_purity(PredInfo, Purity),
set_purity(Purity, Attributes, NewAttributes),
- ForeignProc = ForeignProc0 ^ foreign_attr := NewAttributes
+ GoalExpr = GoalExpr0 ^ foreign_attr := NewAttributes
;
LegacyBehaviour = no,
- ForeignProc = ForeignProc0,
+ GoalExpr = GoalExpr0,
Purity = get_purity(Attributes)
- ).
-compute_expr_purity(shorthand(_), _, _, _, _, !Info) :-
+ ),
+ ContainsTrace = contains_no_trace_goal
+ ;
+ GoalExpr0 = shorthand(ShortHand0),
+ (
+ ShortHand0 = atomic_goal(GoalType, Outer, Inner, MaybeOutputVars,
+ MainGoal0, OrElseGoals0),
+ RunPostTypecheck = !.Info ^ pi_run_post_typecheck,
+ (
+ RunPostTypecheck = run_post_typecheck,
+ VarSet = !.Info ^ pi_varset,
+ VarTypes = !.Info ^ pi_vartypes,
+ Outer = atomic_interface_vars(OuterDI, OuterUO),
+ Inner = atomic_interface_vars(InnerDI, InnerUO),
+ Context = goal_info_get_context(GoalInfo),
+ check_outer_var_type(Context, VarTypes, VarSet, OuterDI,
+ OuterDIType, OuterDITypeSpecs),
+ check_outer_var_type(Context, VarTypes, VarSet, OuterUO,
+ OuterUOType, OuterUOTypeSpecs),
+ OuterTypeSpecs = OuterDITypeSpecs ++ OuterUOTypeSpecs,
+ (
+ OuterTypeSpecs = [_ | _],
+ list.foldl(purity_info_add_message, OuterTypeSpecs, !Info),
+ MainGoal1 = MainGoal0,
+ OrElseGoals1 = OrElseGoals0
+ ;
+ OuterTypeSpecs = [],
+ (
+ (
+ OuterDIType = io_state_type,
+ OuterUOType = io_state_type
+ ->
+ OuterToInnerPred = "stm_from_outer_to_inner_io",
+ InnerToOuterPred = "stm_from_inner_to_outer_io"
+ ;
+ OuterDIType = stm_atomic_type,
+ OuterUOType = stm_atomic_type
+ ->
+ OuterToInnerPred = "stm_from_outer_to_inner_stm",
+ InnerToOuterPred = "stm_from_inner_to_outer_stm"
+ ;
+ fail
+ )
+ ->
+ ModuleInfo = !.Info ^ pi_module_info,
+ generate_simple_call(mercury_stm_builtin_module,
+ OuterToInnerPred, pf_predicate, only_mode,
+ detism_det, purity_pure, [OuterDI, InnerDI], [],
+ [OuterDI - ground(clobbered, none),
+ InnerDI - ground(unique, none)],
+ ModuleInfo, Context, OuterToInnerGoal),
+ generate_simple_call(mercury_stm_builtin_module,
+ InnerToOuterPred, pf_predicate, only_mode,
+ detism_det, purity_pure, [InnerUO, OuterUO], [],
+ [InnerUO - ground(clobbered, none),
+ OuterUO - ground(unique, none)],
+ ModuleInfo, Context, InnerToOuterGoal),
+ wrap_inner_outer_goals(Outer, Inner,
+ OuterToInnerGoal, InnerToOuterGoal,
+ MainGoal0, MainGoal1, !Info),
+ list.map_foldl(wrap_inner_outer_goals(Outer, Inner,
+ OuterToInnerGoal, InnerToOuterGoal),
+ OrElseGoals0, OrElseGoals1, !Info),
+ !Info ^ pi_requant := need_to_requantify
+ ;
+ MisMatchSpec = mismatched_outer_var_types(Context),
+ purity_info_add_message(MisMatchSpec, !Info),
+ MainGoal1 = MainGoal0,
+ OrElseGoals1 = OrElseGoals0
+ )
+ )
+ ;
+ RunPostTypecheck = do_not_run_post_typecheck,
+ MainGoal1 = MainGoal0,
+ OrElseGoals1 = OrElseGoals0
+ ),
+ compute_goal_purity(MainGoal1, MainGoal, Purity1, ContainsTrace1,
+ !Info),
+ compute_goals_purity(OrElseGoals1, OrElseGoals,
+ purity_pure, Purity2, contains_no_trace_goal, ContainsTrace2,
+ !Info),
+ Purity = worst_purity(Purity1, Purity2),
+ (
+ ( ContainsTrace1 = contains_trace_goal
+ ; ContainsTrace2 = contains_trace_goal
+ )
+ ->
+ ContainsTrace = contains_trace_goal
+ ;
+ ContainsTrace = contains_no_trace_goal
+ ),
+ ShortHand = atomic_goal(GoalType, Outer, Inner, MaybeOutputVars,
+ MainGoal, OrElseGoals),
+ GoalExpr = shorthand(ShortHand)
+ ;
+ ShortHand0 = bi_implication(_, _),
% These should have been expanded out by now.
- unexpected(this_file, "compute_expr_purity: unexpected shorthand").
+ unexpected(this_file, "compute_expr_purity: bi_implication")
+ )
+ ).
+
+:- pred wrap_inner_outer_goals(
+ atomic_interface_vars::in, atomic_interface_vars::in,
+ hlds_goal::in, hlds_goal::in, hlds_goal::in, hlds_goal::out,
+ purity_info::in, purity_info::out) is det.
+
+wrap_inner_outer_goals(Outer, Inner, OuterToInnerGoal, InnerToOuterGoal,
+ Goal0, Goal, !Info) :-
+ % Generate an error if the outer variables are in the nonlocals of the
+ % original goal, since they are not supposed to be used in the goal.
+ %
+ % Generate an error if the inner variables are in the nonlocals of the
+ % original goal, since they are not supposed to be used outside the goal.
+ Goal0 = hlds_goal(_, GoalInfo0),
+ NonLocals0 = goal_info_get_nonlocals(GoalInfo0),
+ Context = goal_info_get_context(GoalInfo0),
+ Outer = atomic_interface_vars(OuterDI, OuterUO),
+ Inner = atomic_interface_vars(InnerDI, InnerUO),
+ list.filter(set.contains(NonLocals0), [OuterUO, OuterDI], PresentOuter),
+ list.filter(set.contains(NonLocals0), [InnerUO, InnerDI], PresentInner),
+ VarSet = !.Info ^ pi_varset,
+ (
+ PresentOuter = []
+ ;
+ PresentOuter = [_ | _],
+ PresentOuterVarNames =
+ list.map(mercury_var_to_string(VarSet, no), PresentOuter),
+ Pieces1 = [words("Outer"),
+ words(choose_number(PresentOuterVarNames,
+ "variable", "variables"))] ++
+ list_to_pieces(PresentOuterVarNames) ++
+ [words(choose_number(PresentOuterVarNames, "is", "are")),
+ words("present in the atomic goal.")],
+ Msg1 = error_msg(yes(Context), no, 0, [always(Pieces1)]),
+ Spec1 = error_spec(severity_error, phase_type_check, [Msg1]),
+ purity_info_add_message(Spec1, !Info)
+ ),
+ (
+ PresentInner = []
+ ;
+ PresentInner = [_ | _],
+ PresentInnerVarNames =
+ list.map(mercury_var_to_string(VarSet, no), PresentInner),
+ Pieces2 = [words("Inner"),
+ words(choose_number(PresentInnerVarNames,
+ "variable", "variables"))] ++
+ list_to_pieces(PresentInnerVarNames) ++
+ [words(choose_number(PresentInnerVarNames, "is", "are")),
+ words("present outside the atomic goal.")],
+ Msg2 = error_msg(yes(Context), no, 0, [always(Pieces2)]),
+ Spec2 = error_spec(severity_error, phase_type_check, [Msg2]),
+ purity_info_add_message(Spec2, !Info)
+ ),
+
+ WrapExpr = conj(plain_conj, [OuterToInnerGoal, Goal0, InnerToOuterGoal]),
+ % After the addition of OuterToInnerGoal and InnerToOuterGoal,
+ % OuterDI and OuterUO will definitely be used by the code inside the new
+ % goal, and *should* be used by code outside the goal. However, even if
+ % they are not, the nonlocals set is allowed to overapproximate.
+ set.insert_list(NonLocals0, [OuterDI, OuterUO], NonLocals),
+ goal_info_set_nonlocals(NonLocals, GoalInfo0, GoalInfo),
+ Goal = hlds_goal(WrapExpr, GoalInfo).
+
+:- pred check_outer_var_type(prog_context::in, vartypes::in, prog_varset::in,
+ prog_var::in, mer_type::out, list(error_spec)::out) is det.
+
+check_outer_var_type(Context, VarTypes, VarSet, Var, VarType, Specs) :-
+ map.lookup(VarTypes, Var, VarType),
+ (
+ ( VarType = io_state_type
+ ; VarType = stm_atomic_type
+ )
+ ->
+ Specs = []
+ ;
+ Spec = bad_outer_var_type_error(Context, VarSet, Var),
+ Specs = [Spec]
+ ).
:- pred check_higher_order_purity(hlds_goal_info::in, cons_id::in,
prog_var::in, list(prog_var)::in, purity::out,
@@ -695,20 +924,19 @@
check_higher_order_purity(GoalInfo, ConsId, Var, Args, ActualPurity, !Info) :-
% Check that the purity of the ConsId matches the purity of the
% variable's type.
- VarTypes = !.Info ^ vartypes,
+ VarTypes = !.Info ^ pi_vartypes,
map.lookup(VarTypes, Var, TypeOfVar),
(
ConsId = cons(PName, _),
type_is_higher_order_details(TypeOfVar, TypePurity, PredOrFunc,
_EvalMethod, VarArgTypes)
->
- PredInfo = !.Info ^ pred_info,
+ PredInfo = !.Info ^ pi_pred_info,
pred_info_get_typevarset(PredInfo, TVarSet),
map.apply_to_list(Args, VarTypes, ArgTypes0),
list.append(ArgTypes0, VarArgTypes, PredArgTypes),
- ModuleInfo = !.Info ^ module_info,
- CallerPredInfo = !.Info ^ pred_info,
- pred_info_get_markers(CallerPredInfo, CallerMarkers),
+ ModuleInfo = !.Info ^ pi_module_info,
+ pred_info_get_markers(PredInfo, CallerMarkers),
(
get_pred_id(calls_are_fully_qualified(CallerMarkers), PName,
PredOrFunc, TVarSet, PredArgTypes, ModuleInfo, CalleePredId)
@@ -734,7 +962,7 @@
DeclaredPurity = goal_info_get_purity(GoalInfo),
(
DeclaredPurity \= purity_pure,
- !.Info ^ implicit_purity = dont_make_implicit_promises
+ !.Info ^ pi_implicit_purity = dont_make_implicit_promises
->
Context = goal_info_get_context(GoalInfo),
Spec = impure_unification_expr_error(Context, DeclaredPurity),
@@ -849,9 +1077,9 @@
perform_goal_purity_checks(Context, PredId, DeclaredPurity, ActualPurity,
!Info) :-
- ModuleInfo = !.Info ^ module_info,
- PredInfo = !.Info ^ pred_info,
- ImplicitPurity = !.Info ^ implicit_purity,
+ ModuleInfo = !.Info ^ pi_module_info,
+ PredInfo = !.Info ^ pi_pred_info,
+ ImplicitPurity = !.Info ^ pi_implicit_purity,
module_info_pred_info(ModuleInfo, PredId, CalleePredInfo),
pred_info_get_purity(CalleePredInfo, ActualPurity),
(
@@ -1180,31 +1408,54 @@
Msg = simple_msg(Context, [always(Pieces)]),
Spec = error_spec(severity_error, phase_purity_check, [Msg]).
+:- func bad_outer_var_type_error(prog_context, prog_varset, prog_var)
+ = error_spec.
+
+bad_outer_var_type_error(Context, VarSet, Var) = Spec :-
+ Pieces = [words("The type of outer variable"),
+ fixed(mercury_var_to_string(VarSet, no, Var)),
+ words("must be either io.state or stm_builtin.stm.")],
+ Msg = simple_msg(Context, [always(Pieces)]),
+ Spec = error_spec(severity_error, phase_type_check, [Msg]).
+
+:- func mismatched_outer_var_types(prog_context) = error_spec.
+
+mismatched_outer_var_types(Context) = Spec :-
+ Pieces = [words("The types of the two outer variables differ.")],
+ Msg = simple_msg(Context, [always(Pieces)]),
+ Spec = error_spec(severity_error, phase_type_check, [Msg]).
+
%-----------------------------------------------------------------------------%
+:- type run_post_typecheck
+ ---> run_post_typecheck
+ ; do_not_run_post_typecheck.
+
:- type purity_info
---> purity_info(
% Fields not changed by purity checking.
- module_info :: module_info,
- run_post_typecheck :: bool,
+ pi_module_info :: module_info,
+ pi_run_post_typecheck :: run_post_typecheck,
% Fields which may be changed.
- pred_info :: pred_info,
- vartypes :: vartypes,
- varset :: prog_varset,
- messages :: list(error_spec),
- implicit_purity :: implicit_purity_promise
- % If this is make_implicit_promises then
- % purity annotations are optional in the
- % current scope and purity warnings/errors
- % should not be generated.
+ pi_pred_info :: pred_info,
+ pi_vartypes :: vartypes,
+ pi_varset :: prog_varset,
+ pi_messages :: list(error_spec),
+ pi_implicit_purity :: implicit_purity_promise,
+ % If this is make_implicit_promises,
+ % then purity annotations are optional
+ % in the current scope and purity
+ % warnings/errors should not be
+ % generated.
+ pi_requant :: need_to_requantify
).
:- pred purity_info_add_message(error_spec::in,
purity_info::in, purity_info::out) is det.
purity_info_add_message(Spec, Info0, Info) :-
- Info = Info0 ^ messages := [Spec | Info0 ^ messages].
+ Info = Info0 ^ pi_messages := [Spec | Info0 ^ pi_messages].
%-----------------------------------------------------------------------------%
Index: compiler/quantification.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/quantification.m,v
retrieving revision 1.125
diff -u -b -r1.125 quantification.m
--- compiler/quantification.m 22 Jan 2008 15:06:16 -0000 1.125
+++ compiler/quantification.m 25 Feb 2008 06:18:25 -0000
@@ -301,7 +301,7 @@
GoalExpr = GoalExpr1,
GoalInfo1 = GoalInfo0
),
- set_goal_nonlocals(NonLocalVars, NonLocalVarsSet, GoalInfo1, GoalInfo2,
+ set_goal_nonlocals_translate(NonLocalVars, NonLocals, GoalInfo1, GoalInfo2,
!Info),
% If the nonlocals set has shrunk (e.g. because some optimization
@@ -310,7 +310,7 @@
% then we may need to likewise shrink the instmap delta.
InstMapDelta0 = goal_info_get_instmap_delta(GoalInfo2),
- instmap_delta_restrict(NonLocalVarsSet, InstMapDelta0, InstMapDelta),
+ instmap_delta_restrict(NonLocals, InstMapDelta0, InstMapDelta),
goal_info_set_instmap_delta(InstMapDelta, GoalInfo2, GoalInfo),
Goal = hlds_goal(GoalExpr, GoalInfo).
@@ -507,13 +507,13 @@
implicitly_quantify_goal_quant_info_2(Expr, Expr, _, !Info) :-
Expr = plain_call(_, _, HeadVars, _, _, _),
- implicitly_quantify_atomic_goal(HeadVars, !Info).
+ implicitly_quantify_primitive_goal(HeadVars, !Info).
implicitly_quantify_goal_quant_info_2(Expr, Expr, _, !Info) :-
Expr = generic_call(GenericCall, CallArgVars, _, _),
goal_util.generic_call_vars(GenericCall, ArgVars0),
list.append(ArgVars0, CallArgVars, ArgVars),
- implicitly_quantify_atomic_goal(ArgVars, !Info).
+ implicitly_quantify_primitive_goal(ArgVars, !Info).
implicitly_quantify_goal_quant_info_2(Expr0, Expr, GoalInfo0, !Info) :-
Expr0 = unify(Var, UnifyRHS0, Mode, Unification0, UnifyContext),
@@ -597,19 +597,53 @@
Vars = list.map(foreign_arg_var, Args),
ExtraVars = list.map(foreign_arg_var, ExtraArgs),
list.append(Vars, ExtraVars, AllVars),
- implicitly_quantify_atomic_goal(AllVars, !Info).
+ implicitly_quantify_primitive_goal(AllVars, !Info).
implicitly_quantify_goal_quant_info_2(Expr0, Expr, GoalInfo0, !Info) :-
- Expr0 = shorthand(ShorthandGoal),
- implicitly_quantify_goal_quant_info_2_shorthand(ShorthandGoal, Expr,
- GoalInfo0, !Info).
+ Expr0 = shorthand(ShortHand0),
+ (
+ ShortHand0 = atomic_goal(GoalType, Outer, Inner, MaybeOutputVars,
+ MainGoal0, OrElseGoals0),
+ Outer = atomic_interface_vars(OuterDI, OuterUO),
+ Inner = atomic_interface_vars(InnerDI, InnerUO),
+ AllAtomicGoals0 = [MainGoal0 | OrElseGoals0],
+ NonLocalVarSets0 = [],
+ implicitly_quantify_disj(AllAtomicGoals0, AllAtomicGoals, !Info,
+ NonLocalVarSets0, NonLocalVarSets),
+ (
+ AllAtomicGoals = [MainGoal | OrElseGoals]
+ ;
+ AllAtomicGoals = [],
+ unexpected(this_file,
+ "implicitly_quantify_goal_quant_info_2: AllAtomicGoals = []")
+ ),
+ union_list(NonLocalVarSets, NonLocalVars0),
+ (
+ GoalType = unknown_atomic_goal_type,
+ insert_list(NonLocalVars0, [OuterDI, OuterUO], NonLocalVars1),
+ delete_list(NonLocalVars1, [InnerDI, InnerUO], NonLocalVars)
+ ;
+ ( GoalType = top_level_atomic_goal
+ ; GoalType = nested_atomic_goal
+ ),
+ NonLocalVars = NonLocalVars0
+ ),
+ set_nonlocals(NonLocalVars, !Info),
+ ShortHand = atomic_goal(GoalType, Outer, Inner, MaybeOutputVars,
+ MainGoal, OrElseGoals),
+ Expr = shorthand(ShortHand)
+ ;
+ ShortHand0 = bi_implication(LHS, RHS),
+ implicitly_quantify_goal_quant_info_2_bi_implication(LHS, RHS,
+ Expr, GoalInfo0, !Info)
+ ).
-:- pred implicitly_quantify_goal_quant_info_2_shorthand(
- shorthand_goal_expr::in, hlds_goal_expr::out, hlds_goal_info::in,
+:- pred implicitly_quantify_goal_quant_info_2_bi_implication(
+ hlds_goal::in, hlds_goal::in, hlds_goal_expr::out, hlds_goal_info::in,
quant_info::in, quant_info::out) is det.
-implicitly_quantify_goal_quant_info_2_shorthand(bi_implication(LHS0, RHS0),
- GoalExpr, OldGoalInfo, !Info) :-
+implicitly_quantify_goal_quant_info_2_bi_implication(LHS0, RHS0, GoalExpr,
+ OldGoalInfo, !Info) :-
% Get the initial values of various settings.
get_quant_vars(!.Info, QuantVars0),
@@ -696,10 +730,10 @@
GoalExpr = conj(plain_conj, [ForwardsImplication, ReverseImplication]).
-:- pred implicitly_quantify_atomic_goal(list(prog_var)::in,
+:- pred implicitly_quantify_primitive_goal(list(prog_var)::in,
quant_info::in, quant_info::out) is det.
-implicitly_quantify_atomic_goal(HeadVars, !Info) :-
+implicitly_quantify_primitive_goal(HeadVars, !Info) :-
GoalVars = list_to_set(HeadVars),
update_seen_vars(GoalVars, !Info),
get_outside(!.Info, OutsideVars),
@@ -1152,8 +1186,9 @@
:- mode goal_vars_2(in(ordinary_nonlocals), in, in, out, in, out) is det.
:- mode goal_vars_2(in(code_gen_nonlocals), in, in, out, in, out) is det.
-goal_vars_2(NonLocalsToRecompute, unify(LHS, RHS, _, Unification, _),
- !Set, !LambdaSet) :-
+goal_vars_2(NonLocalsToRecompute, GoalExpr, !Set, !LambdaSet) :-
+ (
+ GoalExpr = unify(LHS, RHS, _, Unification, _),
insert(!.Set, LHS, !:Set),
(
Unification = construct(_, _, _, _, How, _, SubInfo),
@@ -1190,35 +1225,62 @@
),
MaybeSetArgs = no
),
- unify_rhs_vars(NonLocalsToRecompute, RHS, MaybeSetArgs, !Set, !LambdaSet).
-
-goal_vars_2(_, generic_call(GenericCall, ArgVars1, _, _), !Set, !LambdaSet) :-
+ unify_rhs_vars(NonLocalsToRecompute, RHS, MaybeSetArgs,
+ !Set, !LambdaSet)
+ ;
+ GoalExpr = plain_call(_, _, ArgVars, _, _, _),
+ insert_list(!.Set, ArgVars, !:Set)
+ ;
+ GoalExpr = generic_call(GenericCall, ArgVars1, _, _),
goal_util.generic_call_vars(GenericCall, ArgVars0),
insert_list(!.Set, ArgVars0, !:Set),
- insert_list(!.Set, ArgVars1, !:Set).
-
-goal_vars_2(_, plain_call(_, _, ArgVars, _, _, _), !Set, !LambdaSet) :-
- insert_list(!.Set, ArgVars, !:Set).
-
-goal_vars_2(NonLocalsToRecompute, conj(ConjType, Goals), !Set, !LambdaSet) :-
+ insert_list(!.Set, ArgVars1, !:Set)
+ ;
+ GoalExpr = call_foreign_proc(_, _, _, Args, ExtraArgs, _, _),
+ Vars = list.map(foreign_arg_var, Args),
+ ExtraVars = list.map(foreign_arg_var, ExtraArgs),
+ list.append(Vars, ExtraVars, AllVars),
+ insert_list(!.Set, AllVars, !:Set)
+ ;
+ GoalExpr = conj(ConjType, Goals),
(
ConjType = plain_conj
;
ConjType = parallel_conj
),
- conj_vars(NonLocalsToRecompute, Goals, !Set, !LambdaSet).
-
-goal_vars_2(NonLocalsToRecompute, disj(Goals), !Set, !LambdaSet) :-
- disj_vars(NonLocalsToRecompute, Goals, !Set, !LambdaSet).
-
-goal_vars_2(NonLocalsToRecompute, switch(Var, _Det, Cases), !Set,
- !LambdaSet) :-
+ conj_vars(NonLocalsToRecompute, Goals, !Set, !LambdaSet)
+ ;
+ GoalExpr = disj(Goals),
+ disj_vars(NonLocalsToRecompute, Goals, !Set, !LambdaSet)
+ ;
+ GoalExpr = switch(Var, _Det, Cases),
insert(!.Set, Var, !:Set),
- case_vars(NonLocalsToRecompute, Cases, !Set, !LambdaSet).
-
-goal_vars_2(NonLocalsToRecompute, scope(Reason, Goal), Set0, !:Set,
- LambdaSet0, !:LambdaSet) :-
- goal_vars_both(NonLocalsToRecompute, Goal, !:Set, !:LambdaSet),
+ case_vars(NonLocalsToRecompute, Cases, !Set, !LambdaSet)
+ ;
+ GoalExpr = if_then_else(Vars, Cond, Then, Else),
+ % This code does the following:
+ % !:Set = !.Set + ( (vars(Cond) + vars(Then)) \ Vars ) + vars(Else)
+ % where `+' is set union and `\' is relative complement.
+ goal_vars_both(NonLocalsToRecompute, Cond, CondSet, CondLambdaSet),
+ goal_vars_both(NonLocalsToRecompute, Then, ThenSet, ThenLambdaSet),
+ goal_vars_both(NonLocalsToRecompute, Else, ElseSet, ElseLambdaSet),
+ union(CondSet, ThenSet, CondThenSet),
+ union(CondLambdaSet, ThenLambdaSet, CondThenLambdaSet),
+ delete_list(CondThenSet, Vars, SomeCondThenSet),
+ delete_list(CondThenLambdaSet, Vars, SomeCondThenLambdaSet),
+ union(!.Set, SomeCondThenSet, !:Set),
+ union(!.LambdaSet, SomeCondThenLambdaSet, !:LambdaSet),
+ union(!.Set, ElseSet, !:Set),
+ union(!.LambdaSet, ElseLambdaSet, !:LambdaSet)
+ ;
+ GoalExpr = negation(SubGoal),
+ SubGoal = hlds_goal(SubGoalExpr, _SubGoalInfo),
+ goal_vars_2(NonLocalsToRecompute, SubGoalExpr, !Set, !LambdaSet)
+ ;
+ GoalExpr = scope(Reason, SubGoal),
+ Set0 = !.Set,
+ LambdaSet0 = !.LambdaSet,
+ goal_vars_both(NonLocalsToRecompute, SubGoal, !:Set, !:LambdaSet),
(
Reason = exist_quant(Vars),
delete_list(!.Set, Vars, !:Set),
@@ -1238,51 +1300,23 @@
Reason = trace_goal(_, _, _, _, _)
),
union(Set0, !Set),
- union(LambdaSet0, !LambdaSet).
-
-goal_vars_2(NonLocalsToRecompute, negation(hlds_goal(GoalExpr, _GoalInfo)),
- !Set, !LambdaSet) :-
- goal_vars_2(NonLocalsToRecompute, GoalExpr, !Set, !LambdaSet).
-
-goal_vars_2(NonLocalsToRecompute, if_then_else(Vars, Cond, Then, Else),
- !Set, !LambdaSet) :-
- % This code does the following:
- % !:Set = !.Set + ( (vars(Cond) + vars(Then)) \ Vars ) + vars(Else)
- % where `+' is set union and `\' is relative complement.
- goal_vars_both(NonLocalsToRecompute, Cond, CondSet, CondLambdaSet),
- goal_vars_both(NonLocalsToRecompute, Then, ThenSet, ThenLambdaSet),
- goal_vars_both(NonLocalsToRecompute, Else, ElseSet, ElseLambdaSet),
- union(CondSet, ThenSet, CondThenSet),
- union(CondLambdaSet, ThenLambdaSet, CondThenLambdaSet),
- delete_list(CondThenSet, Vars, SomeCondThenSet),
- delete_list(CondThenLambdaSet, Vars, SomeCondThenLambdaSet),
- union(!.Set, SomeCondThenSet, !:Set),
- union(!.LambdaSet, SomeCondThenLambdaSet, !:LambdaSet),
- union(!.Set, ElseSet, !:Set),
- union(!.LambdaSet, ElseLambdaSet, !:LambdaSet).
-
-goal_vars_2(_, call_foreign_proc(_, _, _, Args, ExtraArgs, _, _), !Set,
- !LambdaSet) :-
- Vars = list.map(foreign_arg_var, Args),
- ExtraVars = list.map(foreign_arg_var, ExtraArgs),
- list.append(Vars, ExtraVars, AllVars),
- insert_list(!.Set, AllVars, !:Set).
-
-goal_vars_2(NonLocalsToRecompute, shorthand(ShorthandGoal), !Set,
- !LambdaSet) :-
- goal_vars_2_shorthand(NonLocalsToRecompute, ShorthandGoal, !Set,
- !LambdaSet).
-
-:- pred goal_vars_2_shorthand(nonlocals_to_recompute, shorthand_goal_expr,
- set_of_var, set_of_var, set_of_var, set_of_var).
-:- mode goal_vars_2_shorthand(in(ordinary_nonlocals), in, in, out, in, out)
- is det.
-:- mode goal_vars_2_shorthand(in(code_gen_nonlocals), in, in, out, in, out)
- is det.
-
-goal_vars_2_shorthand(NonLocalsToRecompute, bi_implication(LHS, RHS), !Set,
- !LambdaSet) :-
- conj_vars(NonLocalsToRecompute, [LHS, RHS], !Set, !LambdaSet).
+ union(LambdaSet0, !LambdaSet)
+ ;
+ GoalExpr = shorthand(ShortHand),
+ (
+ ShortHand = atomic_goal(_GoalType, Outer, Inner,
+ _MaybeOutputVars, MainGoal, OrElseGoals),
+ % XXX STM
+ Outer = atomic_interface_vars(OuterDI, OuterUO),
+ Inner = atomic_interface_vars(InnerDI, InnerUO),
+ insert_list(!.Set, [OuterDI, OuterUO, InnerDI, InnerUO], !:Set),
+ disj_vars(NonLocalsToRecompute, [MainGoal | OrElseGoals],
+ !Set, !LambdaSet)
+ ;
+ ShortHand = bi_implication(LHS, RHS),
+ conj_vars(NonLocalsToRecompute, [LHS, RHS], !Set, !LambdaSet)
+ )
+ ).
:- pred unify_rhs_vars(nonlocals_to_recompute, unify_rhs,
maybe(list(needs_update)), set_of_var, set_of_var, set_of_var, set_of_var).
@@ -1423,14 +1457,14 @@
quant_info::in, quant_info::out) is det.
set_goal_nonlocals(NonLocals, !GoalInfo, !Info) :-
- set_goal_nonlocals(NonLocals, _, !GoalInfo, !Info).
+ set_goal_nonlocals_translate(NonLocals, _, !GoalInfo, !Info).
-:- pred set_goal_nonlocals(set_of_var::in, set(prog_var)::out,
+:- pred set_goal_nonlocals_translate(set_of_var::in, set(prog_var)::out,
hlds_goal_info::in, hlds_goal_info::out,
quant_info::in, quant_info::out) is det.
-set_goal_nonlocals(NonLocals0, NonLocals, !GoalInfo, !Info) :-
- NonLocals = bitset_to_set(NonLocals0),
+set_goal_nonlocals_translate(NonLocalsBitSet, NonLocals, !GoalInfo, !Info) :-
+ NonLocals = bitset_to_set(NonLocalsBitSet),
get_nonlocals_to_recompute(!.Info, NonLocalsToRecompute),
(
NonLocalsToRecompute = ordinary_nonlocals,
Index: compiler/rbmm.actual_region_arguments.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/rbmm.actual_region_arguments.m,v
retrieving revision 1.2
diff -u -b -r1.2 rbmm.actual_region_arguments.m
--- compiler/rbmm.actual_region_arguments.m 30 Dec 2007 08:23:55 -0000 1.2
+++ compiler/rbmm.actual_region_arguments.m 6 Jan 2008 09:52:47 -0000
@@ -119,8 +119,7 @@
pp_actual_region_args_table::in, pp_actual_region_args_table::out) is det.
record_actual_region_arguments_goal(ModuleInfo, PPId, RptaInfoTable,
- ConstantRTable, DeadRTable, BornRTable, Goal,
- !ActualRegionArgProc) :-
+ ConstantRTable, DeadRTable, BornRTable, Goal, !ActualRegionArgProc) :-
Goal = hlds_goal(Expr, Info),
record_actual_region_arguments_expr(Expr, Info, ModuleInfo, PPId,
RptaInfoTable, ConstantRTable, DeadRTable, BornRTable,
@@ -132,66 +131,74 @@
proc_region_set_table::in, proc_region_set_table::in,
pp_actual_region_args_table::in, pp_actual_region_args_table::out) is det.
-record_actual_region_arguments_expr(conj(_, Conjs), _, ModuleInfo, PPId,
- RptaInfoTable, ConstantRTable, DeadRTable, BornRTable,
- !ActualRegionArgProc) :-
- list.foldl(record_actual_region_arguments_goal(ModuleInfo, PPId,
- RptaInfoTable, ConstantRTable, DeadRTable, BornRTable), Conjs,
- !ActualRegionArgProc).
-
-record_actual_region_arguments_expr(disj(Disjs), _, ModuleInfo, PPId,
+record_actual_region_arguments_expr(GoalExpr, GoalInfo, ModuleInfo, CallerPPId,
RptaInfoTable, ConstantRTable, DeadRTable, BornRTable,
!ActualRegionArgProc) :-
- list.foldl(record_actual_region_arguments_goal(ModuleInfo, PPId,
+ (
+ GoalExpr = plain_call(PredId, ProcId, _, _, _, _),
+ CalleePPId = proc(PredId, ProcId),
+ ( some_are_special_preds([CalleePPId], ModuleInfo) ->
+ true
+ ;
+ CallSite = program_point_init(GoalInfo),
+ record_actual_region_arguments_call_site(CallerPPId, CallSite,
+ CalleePPId, RptaInfoTable, ConstantRTable, DeadRTable,
+ BornRTable, !ActualRegionArgProc)
+ )
+ ;
+ GoalExpr = conj(_, Conjuncts),
+ list.foldl(
+ record_actual_region_arguments_goal(ModuleInfo, CallerPPId,
RptaInfoTable, ConstantRTable, DeadRTable, BornRTable),
- Disjs, !ActualRegionArgProc).
-
-record_actual_region_arguments_expr(if_then_else(_, If, Then, Else), _,
- ModuleInfo, PPId, RptaInfoTable, ConstantRTable, DeadRTable,
- BornRTable, !ActualRegionArgProc) :-
- record_actual_region_arguments_goal(ModuleInfo, PPId, RptaInfoTable,
- ConstantRTable, DeadRTable, BornRTable, If, !ActualRegionArgProc),
- record_actual_region_arguments_goal(ModuleInfo, PPId, RptaInfoTable,
- ConstantRTable, DeadRTable, BornRTable, Then, !ActualRegionArgProc),
- record_actual_region_arguments_goal(ModuleInfo, PPId, RptaInfoTable,
- ConstantRTable, DeadRTable, BornRTable, Else, !ActualRegionArgProc).
-
-record_actual_region_arguments_expr(switch(_, _, Cases), _, ModuleInfo,
- PPId, RptaInfoTable, ConstantRTable, DeadRTable, BornRTable,
- !ActualRegionArgProc) :-
- list.foldl(record_actual_region_arguments_case(ModuleInfo, PPId,
+ Conjuncts, !ActualRegionArgProc)
+ ;
+ GoalExpr = disj(Disjuncts),
+ list.foldl(
+ record_actual_region_arguments_goal(ModuleInfo, CallerPPId,
RptaInfoTable, ConstantRTable, DeadRTable, BornRTable),
- Cases, !ActualRegionArgProc).
-
-record_actual_region_arguments_expr(generic_call(_, _, _, _), _, _, _, _, _,
- _, _, !ActualRegionArgProc) :-
+ Disjuncts, !ActualRegionArgProc)
+ ;
+ GoalExpr = if_then_else(_, Cond, Then, Else),
+ record_actual_region_arguments_goal(ModuleInfo, CallerPPId,
+ RptaInfoTable, ConstantRTable, DeadRTable, BornRTable, Cond,
+ !ActualRegionArgProc),
+ record_actual_region_arguments_goal(ModuleInfo, CallerPPId,
+ RptaInfoTable, ConstantRTable, DeadRTable, BornRTable, Then,
+ !ActualRegionArgProc),
+ record_actual_region_arguments_goal(ModuleInfo, CallerPPId,
+ RptaInfoTable, ConstantRTable, DeadRTable, BornRTable, Else,
+ !ActualRegionArgProc)
+ ;
+ GoalExpr = switch(_, _, Cases),
+ list.foldl(
+ record_actual_region_arguments_case(ModuleInfo, CallerPPId,
+ RptaInfoTable, ConstantRTable, DeadRTable, BornRTable),
+ Cases, !ActualRegionArgProc)
+ ;
+ GoalExpr = generic_call(_, _, _, _),
sorry(this_file,
- "record_actual_region_arguments_expr: generic_call not handled").
-
-record_actual_region_arguments_expr(call_foreign_proc(_, _, _, _, _, _, _),
- _, _, _, _, _, _, _, !ActualRegionArgProc) :-
+ "record_actual_region_arguments_expr: generic_call NYI")
+ ;
+ GoalExpr = call_foreign_proc(_, _, _, _, _, _, _),
sorry(this_file,
- "record_actual_region_arguments_expr: call_foreign_proc not handled").
-
-record_actual_region_arguments_expr(negation(Goal), _, ModuleInfo, PPId,
- RptaInfoTable, ConstantRTable, DeadRTable, BornRTable,
- !ActualRegionArgProc) :-
- record_actual_region_arguments_goal(ModuleInfo, PPId, RptaInfoTable,
- ConstantRTable, DeadRTable, BornRTable, Goal, !ActualRegionArgProc).
-
-record_actual_region_arguments_expr(unify(_, _, _, _, _), _, _, _, _, _, _,
- _, !ActualRegionArgProc).
-
-record_actual_region_arguments_expr(scope(_, Goal), _, ModuleInfo, PPId,
- RptaInfoTable, ConstantRTable, DeadRTable, BornRTable,
- !ActualRegionArgProc) :-
- record_actual_region_arguments_goal(ModuleInfo, PPId, RptaInfoTable,
- ConstantRTable, DeadRTable, BornRTable, Goal, !ActualRegionArgProc).
-
-record_actual_region_arguments_expr(shorthand(_), _, _, _, _, _, _, _,
- !ActualRegionArgProc) :-
+ "record_actual_region_arguments_expr: call_foreign_proc NYI")
+ ;
+ GoalExpr = negation(SubGoal),
+ record_actual_region_arguments_goal(ModuleInfo, CallerPPId,
+ RptaInfoTable, ConstantRTable, DeadRTable, BornRTable, SubGoal,
+ !ActualRegionArgProc)
+ ;
+ GoalExpr = unify(_, _, _, _, _)
+ ;
+ GoalExpr = scope(_, SubGoal),
+ record_actual_region_arguments_goal(ModuleInfo, CallerPPId,
+ RptaInfoTable, ConstantRTable, DeadRTable, BornRTable, SubGoal,
+ !ActualRegionArgProc)
+ ;
+ GoalExpr = shorthand(_),
unexpected(this_file,
- "record_actual_region_arguments_expr: shorthand not handled").
+ "record_actual_region_arguments_expr: shorthand")
+ ).
:- pred record_actual_region_arguments_case(module_info::in,
pred_proc_id::in, rpta_info_table::in, proc_region_set_table::in,
@@ -204,20 +211,6 @@
record_actual_region_arguments_goal(ModuleInfo, PPId, RptaInfoTable,
ConstantRTable, DeadRTable, BornRTable, Goal, !ActualRegionArgProc).
-record_actual_region_arguments_expr(Expr, Info, ModuleInfo, CallerPPId,
- RptaInfoTable, ConstantRTable, DeadRTable, BornRTable,
- !ActualRegionArgProc) :-
- Expr = plain_call(PredId, ProcId, _, _, _, _),
- CalleePPId = proc(PredId, ProcId),
- ( if some_are_special_preds([CalleePPId], ModuleInfo)
- then true
- else
- CallSite = program_point_init(Info),
- record_actual_region_arguments_call_site(CallerPPId, CallSite,
- CalleePPId, RptaInfoTable, ConstantRTable, DeadRTable,
- BornRTable, !ActualRegionArgProc)
- ).
-
:- pred record_actual_region_arguments_call_site(pred_proc_id::in,
program_point::in, pred_proc_id::in,
rpta_info_table::in, proc_region_set_table::in,
Index: compiler/rbmm.add_rbmm_goal_infos.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/rbmm.add_rbmm_goal_infos.m,v
retrieving revision 1.2
diff -u -b -r1.2 rbmm.add_rbmm_goal_infos.m
--- compiler/rbmm.add_rbmm_goal_infos.m 30 Dec 2007 08:23:55 -0000 1.2
+++ compiler/rbmm.add_rbmm_goal_infos.m 6 Jan 2008 10:06:35 -0000
@@ -349,6 +349,7 @@
collect_rbmm_goal_info_goal_expr(_, _, _, _, _, _, _, !Expr, !Info) :-
!.Expr = shorthand(_),
+ % These should have been expanded out by now.
unexpected(this_file,
"collect_rbmm_goal_info_goal_expr: shorthand unexpected").
Index: compiler/rbmm.condition_renaming.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/rbmm.condition_renaming.m,v
retrieving revision 1.7
diff -u -b -r1.7 rbmm.condition_renaming.m
--- compiler/rbmm.condition_renaming.m 30 Dec 2007 08:23:55 -0000 1.7
+++ compiler/rbmm.condition_renaming.m 6 Jan 2008 09:17:13 -0000
@@ -308,6 +308,7 @@
collect_non_local_and_in_cond_regions_expr(_, _, _, _, _, shorthand(_),
!NonLocalRegionProc, !InCondRegionsProc) :-
+ % These should have been expanded out by now.
unexpected(this_file, "collect_non_local_and_in_cond_regions_expr: "
++ "shorthand not handled").
@@ -334,7 +335,9 @@
ResurRenamingProc, ResurRenamingAnnoProc, GoalInIte,
!NonLocalRegionProc) :-
GoalInIte = hlds_goal(Expr, Info),
- ( goal_is_atomic(Expr) ->
+ HasSubGoals = goal_expr_has_subgoals(Expr),
+ (
+ HasSubGoals = does_not_have_subgoals,
ProgPoint = program_point_init(Info),
ProgPoint = pp(_, GoalPath),
map.lookup(LRBeforeProc, ProgPoint, LRBefore),
@@ -372,6 +375,7 @@
record_non_local_regions(GoalPath, CreatedBeforeRegions,
RemovedAfterRegions, !NonLocalRegionProc)
;
+ HasSubGoals = has_subgoals,
collect_non_local_regions_in_ite_compound_goal(Graph,
LRBeforeProc, LRAfterProc,
ResurRenamingProc, ResurRenamingAnnoProc,
@@ -562,9 +566,11 @@
collect_regions_created_in_condition(Graph, LRBeforeProc, LRAfterProc,
ResurRenamingProc, ResurRenamingAnnoProc, Cond, !InCondRegionsProc) :-
- Cond = hlds_goal(Expr, Info),
- ( goal_is_atomic(Expr) ->
- ProgPoint = program_point_init(Info),
+ Cond = hlds_goal(CondExpr, CondInfo),
+ HasSubGoals = goal_expr_has_subgoals(CondExpr),
+ (
+ HasSubGoals = does_not_have_subgoals,
+ ProgPoint = program_point_init(CondInfo),
ProgPoint = pp(_, GoalPath),
map.lookup(LRBeforeProc, ProgPoint, LRBefore),
map.lookup(LRAfterProc, ProgPoint, LRAfter),
@@ -594,6 +600,7 @@
record_regions_created_in_condition(GoalPath,
CreatedRegions, !InCondRegionsProc)
;
+ HasSubGoals = has_subgoals,
collect_regions_created_in_condition_compound_goal(Graph,
LRBeforeProc, LRAfterProc,
ResurRenamingProc, ResurRenamingAnnoProc,
@@ -871,9 +878,11 @@
collect_ite_renaming_in_condition(IteRenamedRegionProc, Graph, Cond,
!IteRenamingProc) :-
- Cond = hlds_goal(Expr, Info),
- ( goal_is_atomic(Expr) ->
- ProgPoint = program_point_init(Info),
+ Cond = hlds_goal(CondExpr, CondInfo),
+ HasSubGoals = goal_expr_has_subgoals(CondExpr),
+ (
+ HasSubGoals = does_not_have_subgoals,
+ ProgPoint = program_point_init(CondInfo),
% It is enough to look for the regions to be renamed at the closest
% condition because if a region is to be renamed for a compounding
% if-then-else of the closest if-then-else then it also needs to be
@@ -892,6 +901,7 @@
true
)
;
+ HasSubGoals = has_subgoals,
collect_ite_renaming_in_condition_compound_goal(IteRenamedRegionProc,
Graph, Cond, !IteRenamingProc)
).
Index: compiler/rbmm.execution_path.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/rbmm.execution_path.m,v
retrieving revision 1.6
diff -u -b -r1.6 rbmm.execution_path.m
--- compiler/rbmm.execution_path.m 30 Dec 2007 08:23:55 -0000 1.6
+++ compiler/rbmm.execution_path.m 6 Jan 2008 10:10:45 -0000
@@ -98,17 +98,19 @@
list(execution_path)::in, list(execution_path)::out) is det.
execution_paths_covered_goal(ProcInfo, Goal, !ExecPaths) :-
- Goal = hlds_goal(Expr, Info),
- ( goal_is_atomic(Expr) ->
+ Goal = hlds_goal(GoalExpr, GoalInfo),
+ HasSubGoals = goal_expr_has_subgoals(GoalExpr),
(
- ( Expr = unify(_, _, _, _, _)
- ; Expr = plain_call(_, _, _, _, _, _)
- ; Expr = conj(_ConjType, [])
- ; Expr = disj([])
+ HasSubGoals = does_not_have_subgoals,
+ (
+ ( GoalExpr = unify(_, _, _, _, _)
+ ; GoalExpr = plain_call(_, _, _, _, _, _)
+ ; GoalExpr = conj(_ConjType, [])
+ ; GoalExpr = disj([])
)
->
% Retrieve the program point of this goal.
- ProgPoint = program_point_init(Info),
+ ProgPoint = program_point_init(GoalInfo),
append_to_each_execution_path(!.ExecPaths,
[[pair(ProgPoint, Goal)]], !:ExecPaths)
;
@@ -118,6 +120,7 @@
append_to_each_execution_path(!.ExecPaths, [[]], !:ExecPaths)
)
;
+ HasSubGoals = has_subgoals,
execution_paths_covered_compound_goal(ProcInfo, Goal, !ExecPaths)
).
Index: compiler/rbmm.points_to_analysis.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/rbmm.points_to_analysis.m,v
retrieving revision 1.8
diff -u -b -r1.8 rbmm.points_to_analysis.m
--- compiler/rbmm.points_to_analysis.m 30 Dec 2007 08:23:55 -0000 1.8
+++ compiler/rbmm.points_to_analysis.m 6 Jan 2008 09:41:51 -0000
@@ -168,7 +168,8 @@
intra_analyse_goal(Else, !RptaInfo).
intra_analyse_goal_expr(shorthand(_), _, _) :-
- unexpected(this_file, "intra_analyse_goal_expr: shorthand not handled").
+ % These should have been expanded out by now.
+ unexpected(this_file, "intra_analyse_goal_expr: shorthand").
:- pred intra_analyse_case(case::in, rpta_info::in, rpta_info::out) is det.
Index: compiler/rbmm.region_transformation.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/rbmm.region_transformation.m,v
retrieving revision 1.5
diff -u -b -r1.5 rbmm.region_transformation.m
--- compiler/rbmm.region_transformation.m 30 Dec 2007 08:23:56 -0000 1.5
+++ compiler/rbmm.region_transformation.m 6 Jan 2008 09:41:59 -0000
@@ -357,9 +357,11 @@
region_transform_goal(ModuleInfo, Graph, ResurRenamingProc, IteRenamingProc,
ActualRegionArgProc, RegionInstructionProc, ResurRenamingAnnoProc,
IteRenamingAnnoProc, !Goal, !NameToVar, !VarSet, !VarTypes) :-
- !.Goal = hlds_goal(GoalExpr0, Info0),
- ( goal_is_atomic(GoalExpr0) ->
- ProgPoint = program_point_init(Info0),
+ !.Goal = hlds_goal(GoalExpr0, GoalInfo0),
+ HasSubGoals = goal_expr_has_subgoals(GoalExpr0),
+ (
+ HasSubGoals = does_not_have_subgoals,
+ ProgPoint = program_point_init(GoalInfo0),
ProgPoint = pp(Context, _),
find_renamings_at_prog_point(ResurRenamingProc, IteRenamingProc,
ProgPoint, ResurRenaming, IteRenaming),
@@ -369,7 +371,7 @@
% - a construction unification with a region to construct in.
region_transform_goal_expr(ModuleInfo, Graph, ResurRenaming,
IteRenaming, ActualRegionArgProc, ProgPoint, GoalExpr0, GoalExpr,
- Info0, Info, !NameToVar, !VarSet, !VarTypes),
+ GoalInfo0, GoalInfo, !NameToVar, !VarSet, !VarTypes),
% Assignment unifications due to ite renaming.
assignments_from_ite_renaming_anno(IteRenamingAnnoProc, ProgPoint,
@@ -386,7 +388,7 @@
!VarSet, !VarTypes, IteRenamingAssignments, Conjs1),
% The goal at this program point itself.
- Conjs2 = Conjs1 ++ [hlds_goal(GoalExpr, Info)],
+ Conjs2 = Conjs1 ++ [hlds_goal(GoalExpr, GoalInfo)],
% Region instructions after this program point.
list.foldl4(region_instruction_to_conj(ModuleInfo, Context,
@@ -394,7 +396,7 @@
!VarSet, !VarTypes, Conjs2, Conjs3)
;
% The goal at this program point itself.
- Conjs3 = IteRenamingAssignments ++ [hlds_goal(GoalExpr, Info)]
+ Conjs3 = IteRenamingAssignments ++ [hlds_goal(GoalExpr, GoalInfo)]
),
% Assignment unifications due to region resurrection renaming.
@@ -403,11 +405,12 @@
Conjs3, Conjs),
( Conjs = [_, _ | _] ->
- !:Goal = hlds_goal(conj(plain_conj, Conjs), Info)
+ !:Goal = hlds_goal(conj(plain_conj, Conjs), GoalInfo)
;
- !:Goal = hlds_goal(GoalExpr, Info)
+ !:Goal = hlds_goal(GoalExpr, GoalInfo)
)
;
+ HasSubGoals = has_subgoals,
region_transform_compound_goal(ModuleInfo, Graph,
ResurRenamingProc, IteRenamingProc, ActualRegionArgProc,
RegionInstructionProc, ResurRenamingAnnoProc,
@@ -950,9 +953,8 @@
update_instmap_delta_proc(PredId, ProcId, !ModuleInfo) :-
PPId = proc(PredId, ProcId),
module_info_pred_proc_info(!.ModuleInfo, PPId, PredInfo, ProcInfo0),
- RecomputeAtomic = yes,
- recompute_instmap_delta_proc(RecomputeAtomic, ProcInfo0, ProcInfo,
- !ModuleInfo),
+ recompute_instmap_delta_proc(recompute_atomic_instmap_deltas,
+ ProcInfo0, ProcInfo, !ModuleInfo),
module_info_set_pred_proc_info(PPId, PredInfo, ProcInfo, !ModuleInfo).
%-----------------------------------------------------------------------------%
Index: compiler/saved_vars.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/saved_vars.m,v
retrieving revision 1.76
diff -u -b -r1.76 saved_vars.m
--- compiler/saved_vars.m 30 Dec 2007 08:23:56 -0000 1.76
+++ compiler/saved_vars.m 6 Jan 2008 10:01:18 -0000
@@ -94,8 +94,8 @@
Varset1, Varset, VarTypes1, VarTypes, RttiVarMaps1, RttiVarMaps),
proc_info_get_initial_instmap(!.ProcInfo, !.ModuleInfo, InstMap0),
proc_info_get_inst_varset(!.ProcInfo, InstVarSet),
- recompute_instmap_delta(no, Goal2, Goal, VarTypes,
- InstVarSet, InstMap0, !ModuleInfo),
+ recompute_instmap_delta(do_not_recompute_atomic_instmap_deltas,
+ Goal2, Goal, VarTypes, InstVarSet, InstMap0, !ModuleInfo),
% hlds_out.write_goal(Goal, !.ModuleInfo, Varset, 0, "\n"),
Index: compiler/simplify.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/simplify.m,v
retrieving revision 1.227
diff -u -b -r1.227 simplify.m
--- compiler/simplify.m 21 Feb 2008 04:22:41 -0000 1.227
+++ compiler/simplify.m 22 Feb 2008 07:14:47 -0000
@@ -498,40 +498,39 @@
IsDefinedHere = yes
).
-simplify_process_clause_body_goal(Goal0, Goal, !Info) :-
- simplify_info_get_simplifications(!.Info, Simplifications0),
+simplify_process_clause_body_goal(!Goal, !Info) :-
+ some [!Simplifications] (
+ simplify_info_get_simplifications(!.Info, !:Simplifications),
simplify_info_get_instmap(!.Info, InstMap0),
(
( simplify_do_common_struct(!.Info)
; simplify_do_opt_duplicate_calls(!.Info)
)
->
- Simplifications1 = ((Simplifications0
- ^ do_do_once := no)
- ^ do_excess_assign := no),
- simplify_info_set_simplifications(Simplifications1, !Info),
-
- do_process_clause_body_goal(Goal0, Goal1, !Info),
-
- Simplifications2 = ((((Simplifications0
- ^ do_warn_simple_code := no)
- ^ do_warn_duplicate_calls := no)
- ^ do_common_struct := no)
- ^ do_opt_duplicate_calls := no),
- simplify_info_reinit(Simplifications2, InstMap0, !Info)
+ !Simplifications ^ do_do_once := no,
+ !Simplifications ^ do_excess_assign := no,
+ simplify_info_set_simplifications(!.Simplifications, !Info),
+
+ do_process_clause_body_goal(!Goal, !Info),
+
+ !Simplifications ^ do_warn_simple_code := no,
+ !Simplifications ^ do_warn_duplicate_calls := no,
+ !Simplifications ^ do_common_struct := no,
+ !Simplifications ^ do_opt_duplicate_calls := no,
+ simplify_info_reinit(!.Simplifications, InstMap0, !Info)
;
- Goal1 = Goal0
+ true
),
- % On the second pass do excess assignment elimination and some cleaning up
- % after the common structure pass.
- do_process_clause_body_goal(Goal1, Goal2, !Info),
+ % On the second pass do excess assignment elimination and
+ % some cleaning up after the common structure pass.
+ do_process_clause_body_goal(!Goal, !Info),
simplify_info_get_found_contains_trace(!.Info, FoundContainsTrace),
(
- FoundContainsTrace = no,
- Goal = Goal2
+ FoundContainsTrace = no
;
FoundContainsTrace = yes,
- goal_contains_trace(Goal2, Goal, _)
+ goal_contains_trace(!Goal, _)
+ )
).
:- pred do_process_clause_body_goal(hlds_goal::in, hlds_goal::out,
@@ -558,11 +557,10 @@
% in the case where unused variables should no longer be included
% in the instmap_delta for a goal.
% In the alias branch this is necessary anyway.
- RecomputeAtomic = yes,
-
simplify_info_get_module_info(!.Info, ModuleInfo0),
- recompute_instmap_delta(RecomputeAtomic, Goal2, Goal3, VarTypes1,
- !.Info ^ simp_inst_varset, InstMap0, ModuleInfo0, ModuleInfo1),
+ recompute_instmap_delta(recompute_atomic_instmap_deltas, Goal2, Goal3,
+ VarTypes1, !.Info ^ simp_inst_varset, InstMap0,
+ ModuleInfo0, ModuleInfo1),
simplify_info_set_module_info(ModuleInfo1, !Info)
;
Goal3 = Goal1
@@ -825,7 +823,6 @@
:- inst goal_expr_scope == bound(scope(ground, ground)).
:- inst goal_expr_foreign_proc == bound(call_foreign_proc(ground, ground,
ground, ground, ground, ground, ground)).
-:- inst goal_expr_shorthand == bound(shorthand(ground)).
:- pred simplify_goal_2(hlds_goal_expr::in, hlds_goal_expr::out,
hlds_goal_info::in, hlds_goal_info::out,
@@ -869,9 +866,18 @@
!.GoalExpr = call_foreign_proc(_, _, _, _, _, _, _),
simplify_goal_2_foreign_proc(!GoalExpr, !GoalInfo, !Info)
;
- !.GoalExpr = shorthand(_),
+ !.GoalExpr = shorthand(ShortHand0),
+ (
+ ShortHand0 = atomic_goal(GoalType, Outer, Inner,
+ MaybeOutputVars, MainGoal, OrElseGoals),
+ simplify_goal_2_atomic_goal(GoalType, Outer, Inner,
+ MaybeOutputVars, MainGoal, OrElseGoals, !:GoalExpr, !GoalInfo,
+ !Info)
+ ;
+ ShortHand0 = bi_implication(_, _),
% These should have been expanded out by now.
- unexpected(this_file, "goal_2: unexpected shorthand")
+ unexpected(this_file, "simplify_goal_2: bi_implication")
+ )
).
:- pred simplify_goal_2_plain_conj(list(hlds_goal)::in, hlds_goal_expr::out,
@@ -1603,8 +1609,14 @@
),
!:CondCanSwitch = cond_cannot_switch
;
- CondExpr = shorthand(_),
+ CondExpr = shorthand(ShortHand),
+ (
+ ShortHand = atomic_goal(_, _, _, _, _, _),
+ !:CondCanSwitch = cond_cannot_switch
+ ;
+ ShortHand = bi_implication(_, _),
unexpected(this_file, "warn_ite_instead_of_switch: shorthand")
+ )
).
:- func can_switch_on_type(hlds_type_body) = bool.
@@ -1987,6 +1999,34 @@
Result = bool.and(ResultA, ResultB)
).
+:- pred simplify_goal_2_atomic_goal(atomic_goal_type::in,
+ atomic_interface_vars::in, atomic_interface_vars::in,
+ maybe(list(prog_var))::in, hlds_goal::in, list(hlds_goal)::in,
+ hlds_goal_expr::out, hlds_goal_info::in, hlds_goal_info::out,
+ simplify_info::in, simplify_info::out) is det.
+
+simplify_goal_2_atomic_goal(GoalType, Outer, Inner, MaybeOutputVars,
+ MainGoal0, OrElseGoals0, GoalExpr, !GoalInfo, !Info) :-
+ % XXX STM: At the moment we do not simplify the inner goals as there is
+ % a chance that the outer and inner variables will change which will
+ % cause problems during expansion of STM constructs. This will be
+ % fixed eventually.
+ MainGoal = MainGoal0,
+ OrElseGoals = OrElseGoals0,
+ % simplify_goal(MainGoal0, MainGoal, !Info),
+ % simplify_or_else_goals(OrElseGoals0, OrElseGoals, !Info),
+ ShortHand = atomic_goal(GoalType, Outer, Inner, MaybeOutputVars,
+ MainGoal, OrElseGoals),
+ GoalExpr = shorthand(ShortHand).
+
+:- pred simplify_or_else_goals(list(hlds_goal)::in, list(hlds_goal)::out,
+ simplify_info::in, simplify_info::out) is det.
+
+simplify_or_else_goals([], [], !Info).
+simplify_or_else_goals([Goal0 | Goals0], [Goal | Goals], !Info) :-
+ simplify_goal(Goal0, Goal, !Info),
+ simplify_or_else_goals(Goals0, Goals, !Info).
+
%-----------------------------------------------------------------------------%
:- pred inequality_goal(prog_var::in, prog_var::in, prog_var::in, string::in,
@@ -3308,8 +3348,22 @@
goal_contains_trace(SubGoal0, SubGoal, ContainsTrace),
GoalExpr = scope(Reason, SubGoal)
;
- GoalExpr0 = shorthand(_),
- unexpected(this_file, "goal_contains_trace: shorthand")
+ GoalExpr0 = shorthand(ShortHand0),
+ (
+ ShortHand0 = atomic_goal(GoalType, Outer, Inner, MaybeOutputVars,
+ MainGoal0, OrElseGoals0),
+ goal_contains_trace(MainGoal0, MainGoal, MainContainsTrace),
+ goal_list_contains_trace(OrElseGoals0, OrElseGoals,
+ contains_no_trace_goal, OrElseContainsTrace),
+ ShortHand = atomic_goal(GoalType, Outer, Inner, MaybeOutputVars,
+ MainGoal, OrElseGoals),
+ GoalExpr = shorthand(ShortHand),
+ ContainsTrace = worst_contains_trace(MainContainsTrace,
+ OrElseContainsTrace)
+ ;
+ ShortHand0 = bi_implication(_, _),
+ unexpected(this_file, "goal_contains_trace: bi_implication")
+ )
),
(
ContainsTrace = contains_trace_goal,
@@ -3661,9 +3715,9 @@
true
).
- % Succeed if execution of the given goal cannot encounter a context
+ % Return `no' if execution of the given goal cannot encounter a context
% that causes any variable to be flushed to its stack slot or to a
- % register at the specified time.
+ % register at the specified time, and `yes' otherwise.
%
:- func will_flush(hlds_goal_expr, before_after) = bool.
@@ -3745,9 +3799,15 @@
).
will_flush(negation(_), _) = yes.
will_flush(scope(_, _), _) = no.
-will_flush(shorthand(_), _) = _ :-
+will_flush(shorthand(ShortHand), _) = WillFlush :-
+ (
+ ShortHand = atomic_goal(_, _, _, _, _MainGoal, _OrElseGoals),
+ WillFlush = yes
+ ;
+ ShortHand = bi_implication(_, _),
% These should have been expanded out by now.
- unexpected(this_file, "will_flush: unexpected shorthand").
+ unexpected(this_file, "will_flush: bi_implication")
+ ).
% Reset the instmap and seen calls for the next branch.
%
Index: compiler/size_prof.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/size_prof.m,v
retrieving revision 1.57
diff -u -b -r1.57 size_prof.m
--- compiler/size_prof.m 21 Feb 2008 04:22:42 -0000 1.57
+++ compiler/size_prof.m 22 Feb 2008 02:14:36 -0000
@@ -267,8 +267,8 @@
implicitly_quantify_clause_body(HeadVars, _Warnings, Goal1, Goal2,
Info ^ spi_varset, VarSet, Info ^ spi_vartypes, VarTypes,
Info ^ spi_rtti_varmaps, RttiVarMaps),
- recompute_instmap_delta(no, Goal2, Goal, VarTypes, InstVarSet,
- InstMap0, !ModuleInfo),
+ recompute_instmap_delta(do_not_recompute_atomic_instmap_deltas,
+ Goal2, Goal, VarTypes, InstVarSet, InstMap0, !ModuleInfo),
proc_info_set_goal(Goal, !ProcInfo),
proc_info_set_varset(VarSet, !ProcInfo),
proc_info_set_vartypes(VarTypes, !ProcInfo),
Index: compiler/smm_common.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/smm_common.m,v
retrieving revision 1.4
diff -u -b -r1.4 smm_common.m
--- compiler/smm_common.m 12 Nov 2007 03:52:44 -0000 1.4
+++ compiler/smm_common.m 27 Dec 2007 07:54:51 -0000
@@ -175,6 +175,11 @@
io.write_char('f').
dump_goal_path_step(step_later) -->
io.write_char('l').
+dump_goal_path_step(step_atomic_main) -->
+ io.write_char('a').
+dump_goal_path_step(step_atomic_orelse(N)) -->
+ io.write_char('o'),
+ io.write_int(N).
%-----------------------------------------------------------------------------%
:- end_module smm_common.
Index: compiler/ssdebug.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ssdebug.m,v
retrieving revision 1.16
diff -u -b -r1.16 ssdebug.m
--- compiler/ssdebug.m 30 Dec 2007 08:23:56 -0000 1.16
+++ compiler/ssdebug.m 6 Jan 2008 10:34:25 -0000
@@ -845,7 +845,8 @@
proc_info_set_vartypes(Vartypes, !ProcInfo),
proc_info_set_goal(Goal, !ProcInfo),
requantify_proc(!ProcInfo),
- recompute_instmap_delta_proc(yes, !ProcInfo, !ModuleInfo),
+ recompute_instmap_delta_proc(recompute_atomic_instmap_deltas,
+ !ProcInfo, !ModuleInfo),
pred_info_set_proc_info(ProcId, !.ProcInfo, !PredInfo),
repuritycheck_proc(!.ModuleInfo, proc(PredId, ProcId), !PredInfo),
module_info_set_pred_info(PredId, !.PredInfo, !ModuleInfo).
Index: compiler/stack_opt.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/stack_opt.m,v
retrieving revision 1.36
diff -u -b -r1.36 stack_opt.m
--- compiler/stack_opt.m 29 Jan 2008 04:59:43 -0000 1.36
+++ compiler/stack_opt.m 29 Jan 2008 05:00:21 -0000
@@ -201,7 +201,8 @@
requantify_proc(!ProcInfo),
maybe_write_progress_message("\nafter stack opt requantify",
DebugStackOpt, PredIdInt, !.ProcInfo, !.ModuleInfo, !IO),
- recompute_instmap_delta_proc(yes, !ProcInfo, !ModuleInfo),
+ recompute_instmap_delta_proc(recompute_atomic_instmap_deltas,
+ !ProcInfo, !ModuleInfo),
maybe_write_progress_message("\nafter stack opt recompute instmaps",
DebugStackOpt, PredIdInt, !.ProcInfo, !.ModuleInfo, !IO)
;
Index: compiler/state_var.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/state_var.m,v
retrieving revision 1.24
diff -u -b -r1.24 state_var.m
--- compiler/state_var.m 15 Feb 2008 02:26:58 -0000 1.24
+++ compiler/state_var.m 25 Feb 2008 06:10:04 -0000
@@ -157,6 +157,57 @@
:- pred finish_local_state_vars(svars::in, prog_vars::out,
svar_info::in, svar_info::in, svar_info::out) is det.
+:- type svar_outer_atomic_scope_info.
+
+ % svar_start_outer_atomic_scope(Context, OuterStateVar, OuterDI, OuterUO,
+ % OuterScopeInfo, !VarSet, !SInfo, !Specs):
+ %
+ % This predicate converts a !OuterStateVar specification in an atomic scope
+ % to a pair of outer state variables, OuterDI and OuterUO. Since
+ % !OuterStateVar should *not* be accessible inside the atomic scope,
+ % we delete it, but record it in OuterScopeInfo. The accessibility of
+ % !OuterStateVar will be restored when you call svar_finish_atomic_scope
+ % with OuterScopeInfo.
+ %
+:- pred svar_start_outer_atomic_scope(prog_context::in, prog_var::in,
+ prog_var::out, prog_var::out, svar_outer_atomic_scope_info::out,
+ prog_varset::in, prog_varset::out, svar_info::in, svar_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+ % svar_finish_outer_atomic_scope(OuterScopeInfo, !SInfo):
+ %
+ % Restore the accessibility of !OuterStateVar that was disabled by
+ % svar_start_atomic_scope.
+ %
+:- pred svar_finish_outer_atomic_scope(svar_outer_atomic_scope_info::in,
+ svar_info::in, svar_info::out) is det.
+
+:- type svar_inner_atomic_scope_info.
+
+ % svar_start_inner_atomic_scope(Context, InnerStateVar, InnerScopeInfo,
+ % !VarSet, !SInfo, !Specs):
+ %
+ % This predicate prepares for an atomic scope with an !InnerStateVar
+ % specification by making that state var available.
+ %
+:- pred svar_start_inner_atomic_scope(prog_context::in, prog_var::in,
+ svar_inner_atomic_scope_info::out,
+ prog_varset::in, prog_varset::out, svar_info::in, svar_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+ % svar_finish_inner_atomic_scope(Context, InnerScopeInfo, InnerDI, InnerUO,
+ % !VarSet, !SInfo, !Specs):
+ %
+ % This predicate ends an atomic scope with an !InnerStateVar
+ % specification by making that state var unavailable, and returning
+ % the two variables InnerDI and InnerUO representing the initial and final
+ % states of this state variable.
+ %
+:- pred svar_finish_inner_atomic_scope(prog_context::in,
+ svar_inner_atomic_scope_info::in, prog_var::out, prog_var::out,
+ prog_varset::in, prog_varset::out, svar_info::in, svar_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
% We have to add unifiers to the Then and Else arms of an
% if-then-else to make sure all the state variables match up.
%
@@ -225,8 +276,8 @@
% The condition of an if-then-else expression is a goal in which
% only !.X state variables in scope are visible (although the goal
- % may use local state variables introduced via an explicit
- % quantifier.) The StateVars are local to the condition and then-goal.
+ % may use local state variables introduced via an explicit quantifier.)
+ % The StateVars are local to the condition and then-goal.
%
:- pred svar_prepare_for_if_then_else_expr(svars::in,
prog_varset::in, prog_varset::out, svar_info::in, svar_info::out) is det.
@@ -558,6 +609,122 @@
%-----------------------------------------------------------------------------%
+:- type svar_outer_atomic_scope_info
+ ---> svar_outer_atomic_scope_info(
+ outer_state_var :: prog_var,
+ maybe_outer_read_only_dot :: maybe(prog_var),
+ maybe_outer_dot :: maybe(prog_var),
+ maybe_outer_colon :: maybe(prog_var)
+ ).
+
+svar_start_outer_atomic_scope(Context, OuterStateVar, OuterDI, OuterUO,
+ OuterScopeInfo, !VarSet, !SInfo, !Specs) :-
+ svar_prepare_for_call(!SInfo),
+ svar_dot(Context, OuterStateVar, OuterDI, !VarSet, !SInfo, !Specs),
+ svar_colon(Context, OuterStateVar, OuterUO, !VarSet, !SInfo, !Specs),
+ svar_finish_call(!VarSet, !SInfo),
+ !.SInfo = svar_info(SVarContext, SVarNum, RODotMap0, DotMap0, ColonMap0),
+ ( map.remove(RODotMap0, OuterStateVar, OuterRODot, RODotMap1) ->
+ MaybeOuterRODot = yes(OuterRODot),
+ RODotMap = RODotMap1
+ ;
+ MaybeOuterRODot = no,
+ RODotMap = RODotMap0
+ ),
+ ( map.remove(DotMap0, OuterStateVar, OuterDot, DotMap1) ->
+ MaybeOuterDot = yes(OuterDot),
+ DotMap = DotMap1
+ ;
+ MaybeOuterDot = no,
+ DotMap = DotMap0
+ ),
+ ( map.remove(ColonMap0, OuterStateVar, OuterColon, ColonMap1) ->
+ MaybeOuterColon = yes(OuterColon),
+ ColonMap = ColonMap1
+ ;
+ MaybeOuterColon = no,
+ ColonMap = ColonMap0
+ ),
+ OuterScopeInfo = svar_outer_atomic_scope_info(OuterStateVar,
+ MaybeOuterRODot, MaybeOuterDot, MaybeOuterColon),
+ !:SInfo = svar_info(SVarContext, SVarNum, RODotMap, DotMap, ColonMap).
+
+svar_finish_outer_atomic_scope(OuterScopeInfo, !SInfo) :-
+ OuterScopeInfo = svar_outer_atomic_scope_info(OuterStateVar,
+ MaybeOuterRODot, MaybeOuterDot, MaybeOuterColon),
+ !.SInfo = svar_info(SVarContext, SVarNum, RODotMap0, DotMap0, ColonMap0),
+ % For each of the "yes" cases below, we deleted the corresponding entry
+ % in svar_start_atomic_scope. While a goal inside the atomic state could
+ % have introduced a state variable with the same name again, that could
+ % have been done only in a scope which also deletes the state variable.
+ % Hence the use of det_inserts below.
+ (
+ MaybeOuterRODot = yes(OuterRODot),
+ map.det_insert(RODotMap0, OuterStateVar, OuterRODot, RODotMap)
+ ;
+ MaybeOuterRODot = no,
+ RODotMap = RODotMap0
+ ),
+ (
+ MaybeOuterDot = yes(OuterDot),
+ map.det_insert(DotMap0, OuterStateVar, OuterDot, DotMap)
+ ;
+ MaybeOuterDot = no,
+ DotMap = DotMap0
+ ),
+ (
+ MaybeOuterColon = yes(OuterColon),
+ map.det_insert(ColonMap0, OuterStateVar, OuterColon, ColonMap)
+ ;
+ MaybeOuterColon = no,
+ ColonMap = ColonMap0
+ ),
+ !:SInfo = svar_info(SVarContext, SVarNum, RODotMap, DotMap, ColonMap).
+
+%-----------------------------------------------------------------------------%
+
+:- type svar_inner_atomic_scope_info
+ ---> svar_inner_atomic_scope_info(
+ inner_state_var :: prog_var,
+ inner_di_var :: prog_var,
+ before_svar_info :: svar_info
+ ).
+
+svar_start_inner_atomic_scope(Context, InnerStateVar, InnerScopeInfo,
+ !VarSet, !SInfo, !Specs) :-
+ prepare_for_local_state_vars([InnerStateVar], !VarSet, !SInfo),
+ % This mention of !:InnerStateVar is to allow code in the atomic scope
+ % to access !.InnerStateVar.
+ svar_colon(Context, InnerStateVar, InnerDI, !VarSet, !SInfo, !Specs),
+ InnerScopeInfo = svar_inner_atomic_scope_info(InnerStateVar, InnerDI,
+ !.SInfo).
+
+svar_finish_inner_atomic_scope(Context, InnerScopeInfo, InnerDI, InnerUO,
+ !VarSet, !SInfo, !Specs) :-
+ InnerScopeInfo = svar_inner_atomic_scope_info(InnerStateVar, InnerDI,
+ BeforeSInfo),
+ % XXX Should this be svar_dot?
+ svar_colon(Context, InnerStateVar, InnerUO, !VarSet, !SInfo, !Specs),
+ finish_local_state_vars([InnerStateVar], Vars, BeforeSInfo, !SInfo),
+ trace [compiletime(flag("atomic_scope_syntax")), io(!IO)] (
+ ( Vars = [Var1, Var2] ->
+ io.write_string("dot/colon:\n", !IO),
+ io.write(InnerDI, !IO),
+ io.nl(!IO),
+ io.write(InnerUO, !IO),
+ io.nl(!IO),
+ io.write_string("finish", !IO),
+ io.write(Var1, !IO),
+ io.nl(!IO),
+ io.write(Var2, !IO),
+ io.nl(!IO)
+ ;
+ unexpected(this_file, "transform_goal_2: |Vars| != 2")
+ )
+ ).
+
+%-----------------------------------------------------------------------------%
+
svar_finish_if_then_else(Context, Then0, Then, Else0, Else,
SInfo0, SInfoC, SInfoT0, SInfoE, SInfo, !VarSet) :-
% Add unifiers to the Then arm for state variables that acquired
Index: compiler/stm_expand.m
===================================================================
RCS file: compiler/stm_expand.m
diff -N compiler/stm_expand.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ compiler/stm_expand.m 6 Jan 2008 10:41:37 -0000
@@ -0,0 +1,2671 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
+% Copyright (C) 1995-2007 The University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public Licence - see the file COPYING in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% File: stm.m
+% Author: lm
+%
+% This module contains the source to source transformations for expanding out
+% atomic goals.
+%
+% 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:
+%
+% :- 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)
+% ...
+% )
+%
+% 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. 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 tuple of these variables
+% is created and the tuple 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.
+%
+% - 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.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- 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.
+
+:- 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,
+ new_pred_var_cnt :: int
+ ).
+
+ % 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
+ ).
+
+%-----------------------------------------------------------------------------%
+
+stm_process_module(!ModuleInfo) :-
+ module_info_predids(PredIds, !ModuleInfo),
+ list.foldl(stm_process_pred, PredIds, !ModuleInfo),
+ module_info_clobber_dependency_info(!ModuleInfo).
+
+stm_process_pred(PredId, !ModuleInfo) :-
+ module_info_pred_info(!.ModuleInfo, PredId, PredInfo),
+ ProcIds = pred_info_procids(PredInfo),
+ list.foldl(stm_process_proc(PredId), ProcIds, !ModuleInfo).
+
+:- pred stm_process_proc(pred_id::in, proc_id::in, module_info::in,
+ module_info::out) is det.
+
+stm_process_proc(PredId, ProcId, !ModuleInfo) :-
+ module_info_preds(!.ModuleInfo, PredTable0),
+ map.lookup(PredTable0, PredId, PredInfo0),
+ pred_info_get_procedures(PredInfo0, ProcTable0),
+ map.lookup(ProcTable0, ProcId, ProcInfo0),
+
+ stm_process_proc_2(ProcInfo0, ProcInfo, PredId, ProcId, PredInfo0,
+ PredInfo1, !ModuleInfo),
+
+ pred_info_get_procedures(PredInfo1, ProcTable1),
+ map.det_update(ProcTable1, ProcId, ProcInfo, ProcTable),
+ pred_info_set_procedures(ProcTable, PredInfo1, PredInfo),
+ module_info_preds(!.ModuleInfo, PredTable1),
+ map.det_update(PredTable1, PredId, PredInfo, PredTable),
+ module_info_set_preds(PredTable, !ModuleInfo).
+
+:- 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),
+ recompute_instmap_delta_proc(recompute_atomic_instmap_deltas,
+ !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(_, _, _, _, _)
+ )
+ ),
+ 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
+ ;
+ % This should be expanded out at this stage
+ GoalExpr0 = shorthand(ShortHand0),
+ (
+ % XXX STM: Why do we ignore _MaybeOutputVars?
+ ShortHand0 = atomic_goal(GoalType, Outer, Inner, _MaybeOutputVars,
+ MainGoal0, OrElseGoals0),
+
+ GoalDisj0 = [MainGoal0 | OrElseGoals0],
+ stm_process_disj(Instmap, GoalDisj0, GoalDisj, !Info),
+ MainGoal = list.det_head(GoalDisj),
+ OrElseGoals = list.det_tail(GoalDisj),
+
+ InstmapDelta = goal_info_get_instmap_delta(GoalInfo0),
+ apply_instmap_delta(Instmap, InstmapDelta, FinalInstmap),
+
+ % Traverse the goal and if an inside goal is encountered:
+ % 1. If goal is single, connect the outers and inners
+ % 2. Process or_else as if it would be called directly in goal
+
+ stm_create_actual_goal(GoalType, Instmap, FinalInstmap,
+ Outer, Inner, MainGoal, OrElseGoals, Goal, !Info)
+ ;
+ ShortHand0 = bi_implication(_, _),
+ unexpected(this_file, "stm_process_goal: bi_implication")
+ )
+ ).
+
+:- pred stm_process_conj(instmap::in, hlds_goals::in, hlds_goals::out,
+ stm_info::in, stm_info::out) is det.
+
+stm_process_conj(Instmap0, GoalList0, GoalList, !Info) :-
+ (
+ GoalList0 = [],
+ GoalList = []
+ ;
+ GoalList0 = [Goal0 | Goals0],
+ InstmapDelta = goal_info_get_instmap_delta(GoalInfo),
+
+ stm_process_goal(Instmap0, Goal0, Goal, !Info),
+
+ Goal0 = hlds_goal(_, GoalInfo),
+ apply_instmap_delta(Instmap0, InstmapDelta, Instmap),
+ stm_process_conj(Instmap, Goals0, Goals, !Info),
+ GoalList = [Goal | Goals]
+ ).
+
+:- pred stm_process_disj(instmap::in, hlds_goals::in, hlds_goals::out,
+ stm_info::in, stm_info::out) is det.
+
+stm_process_disj(Instmap, GoalList0, GoalList, !Info) :-
+ (
+ GoalList0 = [],
+ GoalList = []
+ ;
+ GoalList0 = [Goal0 | Goals0],
+ stm_process_goal(Instmap, Goal0, Goal, !Info),
+ stm_process_disj(Instmap, Goals0, Goals, !Info),
+ GoalList = [Goal | Goals]
+ ).
+
+:- 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.
+
+ 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.
+
+stm_process_switch_cases(_Instmap0, [], [], !Info).
+stm_process_switch_cases(Instmap0, [Case0 | Cases0], [Case | Cases], !Info) :-
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
+ stm_process_goal(Instmap0, Goal0, Goal, !Info),
+ stm_process_switch_cases(Instmap0, Cases0, Cases, !Info),
+ Case = case(MainConsId, OtherConsIds, Goal).
+
+%-----------------------------------------------------------------------------%
+%
+% 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(atomic_goal_type::in, instmap::in, instmap::in,
+ atomic_interface_vars::in, atomic_interface_vars::in, hlds_goal::in,
+ list(hlds_goal)::in, hlds_goal::out, stm_info::in, stm_info::out) is det.
+
+stm_create_actual_goal(GoalType, InitInstmap, FinalInstmap, Outer, Inner,
+ MainGoal, OrElseGoals, FinalGoal, !StmInfo) :-
+ Outer = atomic_interface_vars(OuterDI, OuterUO),
+ Inner = atomic_interface_vars(InnerDI, InnerUO),
+
+ % Performs different operations based on the goal type
+ (
+ GoalType = top_level_atomic_goal,
+ create_top_level_goal(InitInstmap, FinalInstmap,
+ OuterDI, OuterUO, InnerDI, InnerUO, MainGoal, OrElseGoals,
+ FinalGoal, !StmInfo)
+ ;
+ GoalType = nested_atomic_goal,
+ trace [io(!IO)] (
+ io.write_string("Creating nested atomic goal\n",!IO)
+ ),
+ create_nested_goal(InitInstmap, FinalInstmap,
+ OuterDI, OuterUO, InnerDI, InnerUO, MainGoal, OrElseGoals,
+ FinalGoal, !StmInfo)
+ ;
+ GoalType = unknown_atomic_goal_type,
+ unexpected(this_file,
+ "stm_create_actual_goal: Unknown atomic goal type")
+ ),
+ !:StmInfo = !.StmInfo ^ stm_info_requalify := yes.
+
+%-----------------------------------------------------------------------------%
+%
+% Predicates to determine if variables are inputs, outputs or local to a goal.
+% This decision is currenly governed by the following rules:
+%
+% 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.
+
+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 common_goal_vars_from_list(list(stm_goal_vars)::in,
+ stm_goal_vars::out) is det.
+
+common_goal_vars_from_list(GoalList, GoalVar) :-
+ ExtractInputSet = (pred(AGV::in, Input::out) is det :-
+ Input = AGV ^ vars_input),
+
+ list.map(ExtractInputSet, GoalList, InputVarList),
+ InputVars = set.union_list(InputVarList),
+ GoalVar0 = list.det_head(GoalList),
+ GoalVar = GoalVar0 ^ vars_input := InputVars.
+
+:- pred copy_input_vars_in_goallist(stm_goal_vars::in,
+ list(stm_goal_vars)::in, list(stm_goal_vars)::out) is det.
+
+copy_input_vars_in_goallist(GoalVar, !GoalList) :-
+ CopyInputVarLambda = (pred(AGV0::in, AGV::out) is det :-
+ AGV = AGV0 ^ vars_input := (GoalVar ^ vars_input)),
+ list.map(CopyInputVarLambda, !GoalList).
+
+:- pred calc_pred_variables_list(instmap::in, instmap::in,
+ hlds_goals::in, list(prog_var)::in, list(prog_var)::in, list(prog_var)::in,
+ list(stm_goal_vars)::out, stm_info::in, stm_info::out) is det.
+
+calc_pred_variables_list(InitInstmap, FinalInstmap, HldsGoals,
+ InnerDIs, InnerUOs, IgnoreVarList0, StmGoalVarList,
+ !StmInfo) :-
+ (
+ HldsGoals = [],
+ InnerDIs = [],
+ InnerUOs = []
+ ->
+ StmGoalVarList = []
+ ;
+ HldsGoals = [HldsGoal | HldsGoals0],
+ InnerDIs = [InnerDI | InnerDIs0],
+ InnerUOs = [InnerUO | InnerUOs0]
+ ->
+ IgnoreVarList = [InnerDI, InnerUO | IgnoreVarList0],
+
+ calc_pred_variables(InitInstmap, FinalInstmap, HldsGoal, InnerDI,
+ InnerUO, IgnoreVarList, StmGoalVar, !StmInfo),
+ calc_pred_variables_list(InitInstmap, FinalInstmap, HldsGoals0,
+ InnerDIs0, InnerUOs0, IgnoreVarList, StmGoalVarList0, !StmInfo),
+ StmGoalVarList = [StmGoalVar | StmGoalVarList0]
+ ;
+ unexpected(this_file, "calc_pred_variables_list: lengths mismatch")
+ ).
+
+ % 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, InputVarsList, _),
+ 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,
+ pair(maybe(prog_var), maybe(prog_var))::out,
+ pair(maybe(prog_var), maybe(prog_var))::out) is det.
+
+remove_tail([], [], no - no, no - no).
+remove_tail([G | Gs], Goals, MaybeOutDI - MaybeOutUO,
+ MaybeInDI - MaybeInUO) :-
+ remove_tail(Gs, Goals0, MaybeOutDI0 - MaybeOutUO0,MaybeInDI0 - MaybeInUO0),
+ ( G = hlds_goal(plain_call(_, _, [_, X, V], _, _, stm_outer_inner), _) ->
+ MaybeInDI = yes(V),
+ MaybeInUO = MaybeInUO0,
+ MaybeOutDI = yes(X),
+ MaybeOutUO = MaybeOutUO0,
+ Goals = Goals0
+ ; G = hlds_goal(plain_call(_, _, [_, V, X], _, _, stm_inner_outer), _) ->
+ MaybeInDI = MaybeInDI0,
+ MaybeInUO = yes(V),
+ MaybeOutDI = MaybeOutDI0,
+ MaybeOutUO = yes(X),
+ Goals = Goals0
+ ;
+ Goals = [G | Goals0],
+ MaybeInDI = MaybeInDI0,
+ MaybeInUO = MaybeInUO0,
+ MaybeOutDI = MaybeOutDI0,
+ MaybeOutUO = MaybeOutUO0
+ ).
+
+ % 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,
+ prog_var::out, prog_var::out, prog_var::out, prog_var::out) is det.
+
+strip_goal_calls(Goal0, Goal, StmOutDI, StmOutUO, StmInDI, StmInUO) :-
+ (
+ Goal0 = hlds_goal(conj(plain_conj, GoalList0), GoalInfo) ->
+ (
+ GoalList0 = [],
+ unexpected(this_file, "strip_goal_calls: conjunction is empty")
+ ;
+ GoalList0 = [_ | _],
+ remove_tail(GoalList0, GoalList, MaybeOutVarPair, MaybeInVarPair),
+ MaybeInDI = fst(MaybeInVarPair),
+ MaybeInUO = snd(MaybeInVarPair),
+ MaybeOutDI = fst(MaybeOutVarPair),
+ MaybeOutUO = snd(MaybeOutVarPair),
+ (
+ MaybeInDI = yes(StmInDI0),
+ MaybeInUO = yes(StmInUO0),
+ MaybeOutDI = yes(StmOutDI0),
+ MaybeOutUO = yes(StmOutUO0)
+ ->
+ StmInDI = StmInDI0,
+ StmInUO = StmInUO0,
+ StmOutDI = StmOutDI0,
+ StmOutUO = StmOutUO0,
+ Goal = hlds_goal(conj(plain_conj, GoalList), GoalInfo)
+ ;
+ unexpected(this_file, "strip_goal_calls: Vars not extracted")
+ )
+ )
+ ;
+ 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 a nested atomic goal
+ %
+:- pred create_nested_goal(instmap::in, instmap::in,
+ prog_var::in, prog_var::in, prog_var::in, prog_var::in,
+ hlds_goal::in, list(hlds_goal)::in, hlds_goal::out,
+ stm_info::in, stm_info::out) is det.
+
+create_nested_goal(InitInstmap, FinalInstmap, OuterDI, OuterUO,
+ _InnerDI, _InnerUO, AtomicGoal0, OrElseGoals0, HldsGoal, !StmInfo) :-
+ strip_goal_calls(AtomicGoal0, AtomicGoal, MainOuterDI, MainOuterUO,
+ MainInnerDI, MainInnerUO),
+ list.map5(strip_goal_calls, OrElseGoals0, OrElseGoals, _, _,
+ OrElseInnerDIs, OrElseInnerUOs),
+ (
+ OrElseGoals = [],
+
+ % If no or_else goals, simply connect up the outer and inner variables
+ create_var_unify_stm(MainInnerDI, MainOuterDI,
+ pair(mer_mode_uo, mer_mode_di), CopyDIVars, !StmInfo),
+ create_var_unify_stm(MainOuterUO, MainInnerUO,
+ pair(mer_mode_uo, mer_mode_di), CopyUOVars, !StmInfo),
+ create_plain_conj([CopyDIVars, AtomicGoal, CopyUOVars], HldsGoal)
+ ;
+ OrElseGoals = [_ | _],
+
+ % Creates a call to an or_else branch predicate
+ calc_pred_variables_list(InitInstmap, FinalInstmap,
+ [AtomicGoal0 | OrElseGoals0], [MainInnerDI | OrElseInnerDIs],
+ [MainInnerUO | OrElseInnerUOs], [OuterDI, OuterUO],
+ AtomicGoalVarList, !StmInfo),
+ GoalList = [AtomicGoal | OrElseGoals],
+
+ common_goal_vars_from_list(AtomicGoalVarList, AtomicGoalVars),
+% copy_input_vars_in_goallist(AtomicGoalVars, AtomicGoalVarList,
+% AtomicGoalVarList1),
+ AtomicGoalVarList1 = AtomicGoalVarList,
+
+ trace [io(!IO)] (
+ io.write_string("Local: " ++
+ string(AtomicGoalVars ^ vars_local) ++ "\n", !IO),
+ io.write_string("Inner: " ++
+ string(AtomicGoalVars ^ vars_input) ++ "\n", !IO),
+ io.write_string("Outer: " ++
+ string(AtomicGoalVars ^ vars_output) ++ "\n", !IO)
+ ),
+
+ get_input_output_types(AtomicGoalVars, !.StmInfo, _, OutputTypes),
+ make_return_type(OutputTypes, ResultType),
+ create_aux_variable_stm(ResultType, yes("res"), ResultVar, !StmInfo),
+ CreateWrapperForEachGoal = (
+ pred(Goal::in, GoalVars::in, PPID::out, SInfo0::in,
+ SInfo::out) is det :-
+ % These predicates should be plain predicates without code to
+ % validate logs.
+ create_simple_wrapper_pred(GoalVars, ResultType, ResultVar,
+ Goal, PPID, _, SInfo0, SInfo)
+ ),
+ map2_in_foldl(CreateWrapperForEachGoal, GoalList, AtomicGoalVarList1,
+ PPIDList, !StmInfo),
+
+ create_or_else_pred(AtomicGoalVars, AtomicGoalVarList1, PPIDList,
+ MainInnerDI, MainInnerUO, OrElseCall, !StmInfo),
+ create_var_unify_stm(MainInnerDI, MainOuterDI,
+ pair(mer_mode_uo, mer_mode_di), CopyDIVars, !StmInfo),
+ create_var_unify_stm(MainOuterUO, MainInnerUO,
+ pair(mer_mode_uo, mer_mode_di), CopyUOVars, !StmInfo),
+ create_plain_conj([CopyDIVars, OrElseCall, CopyUOVars], HldsGoal)
+ ).
+
+ % 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, list(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, OrElseGoals0, HldsGoal, !StmInfo) :-
+
+ strip_goal_calls(AtomicGoal0, AtomicGoal, _, _, MainInnerDI, MainInnerUO),
+ list.map5(strip_goal_calls, OrElseGoals0, OrElseGoals, _, _,
+ OrElseInnerDIs, OrElseInnerUOs),
+
+ % The input and output variables of the atomic goal and or_else goals
+ % should be the same as or_elses are treated as disjunctions.
+
+ calc_pred_variables_list(InitInstmap, FinalInstmap,
+ [AtomicGoal0 | OrElseGoals0], [MainInnerDI | OrElseInnerDIs],
+ [MainInnerUO | OrElseInnerUOs], [OuterDI, OuterUO],
+ AtomicGoalVarList, !StmInfo),
+
+ create_top_level_pred(AtomicGoalVarList, OuterDI, OuterUO, AtomicGoal,
+ OrElseGoals, TopLevelCall, !StmInfo),
+ HldsGoal = TopLevelCall.
+
+ % Creates the top level predicate. Calling this implicitly creates the
+ % rollback and wrapper predicate.
+ %
+:- pred create_top_level_pred(list(stm_goal_vars)::in, prog_var::in,
+ prog_var::in, hlds_goal::in, list(hlds_goal)::in, hlds_goal::out,
+ stm_info::in, stm_info::out) is det.
+
+create_top_level_pred(AtomicGoalVarList, OuterDI, OuterUO, AtomicGoal,
+ OrElseGoals, HldsGoal, !StmInfo) :-
+ AtomicGoalVars = list.det_head(AtomicGoalVarList),
+
+ create_rollback_pred(AtomicGoalVarList, WrapperCall, AtomicGoal,
+ OrElseGoals, !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, no, 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 ...
+ %
+:- 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_rollback_exception_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),
+% XXX STM
+% create_plain_conj([AssignGoal, UnivCall, TestGoal, UnifyCall], CondGoal),
+ create_plain_conj([AssignGoal, UnivCall, TestGoal], 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]
+ ).
+
+ % Lock and validate a number of transactions. The success branch will
+ % be passed if all transactions are valid,.
+ %
+:- pred template_lock_and_validate_many(list(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_many(StmVars, UnlockAfterwards, ValidGoal,
+ InvalidGoal, HldsGoals, !NewPredInfo) :-
+ create_aux_variable_assignment(stm_validres_valid_functor,
+ stm_valid_result_type, yes("IsValidConst"), AssignValidConst,
+ IsValidConstVar, !NewPredInfo),
+
+ create_simple_call(module_stm_sym_name, "stm_lock", pf_predicate,
+ only_mode, detism_det, purity_impure, [], [], [], LockCall,
+ !NewPredInfo),
+
+ % Create N value result variables. Variables are returned as a list
+
+ CreateValidate = (pred(StmVarL::in, ValidGoalL::out, ValidResL::out,
+ NPI0::in, NPI::out) is det :-
+ create_aux_variable(stm_valid_result_type, yes("ValidResult"),
+ ValidResL, NPI0, NPI1),
+ create_simple_call(module_stm_sym_name, "stm_validate",
+ pf_predicate, only_mode, detism_det, purity_impure,
+ [StmVarL, ValidResL], [], [pair(StmVarL, ground(unique, none)),
+ pair(ValidResL, free)], ValidGoalL, NPI1, NPI)),
+
+ list.map2_foldl(CreateValidate, StmVars, ValidCalls, IsValidVars,
+ !NewPredInfo),
+
+ CreateValidTests = (pred(ValidRes::in, ValidTest::out, NPI0::in,
+ NPI::out) is det :-
+ create_var_test(ValidRes, IsValidConstVar,
+ pair(mer_mode_in, mer_mode_in), ValidTest, NPI0, NPI)),
+
+ list.map_foldl(CreateValidTests, IsValidVars, TestValidGoals,
+ !NewPredInfo),
+ create_plain_conj(TestValidGoals, TestValidCond),
+
+ create_if_then_else([], TestValidCond, ValidGoal, InvalidGoal,
+ detism_cc_multi, purity_impure, ITEGoal, !NewPredInfo),
+
+ (
+ UnlockAfterwards = yes,
+ create_simple_call(module_stm_sym_name, "stm_unlock", pf_predicate,
+ only_mode, detism_det, purity_impure, [], [], [], UnlockCall,
+ !NewPredInfo),
+ HldsGoals = [AssignValidConst, LockCall] ++ ValidCalls ++
+ [UnlockCall, ITEGoal]
+ ;
+ UnlockAfterwards = no,
+ HldsGoals = [AssignValidConst, LockCall] ++ ValidCalls ++ [ITEGoal]
+ ).
+
+%-----------------------------------------------------------------------------%
+%
+% 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
+% 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_erroneous, 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) :-
+ get_input_output_varlist(AtomicGoalVars, InputVars, _),
+ get_input_output_types(AtomicGoalVars, StmInfo, InputTypes, _),
+ get_input_output_modes(AtomicGoalVars, InputModes, _),
+
+ create_closure(WrapperID, InputVars,
+ InputTypes ++ [ReturnType, stm_state_type, stm_state_type],
+ InputModes ++ [mer_mode_out, mer_mode_di, mer_mode_uo],
+ AtomicClosureVar, ClosureAssign, !NewPredInfo),
+
+ make_type_info(ReturnType, RttiTypeVar, RttiTypeVarAssign, !NewPredInfo),
+
+ % 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
+ 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(list(stm_goal_vars)::in, hlds_goal::out,
+ hlds_goal::in, list(hlds_goal)::in, stm_info::in, stm_info::out) is det.
+
+create_rollback_pred(AtomicGoalVarList, CallGoal, AtomicGoal, OrElseGoals,
+ !StmInfo) :-
+ AtomicGoalVars = list.det_head(AtomicGoalVarList),
+
+ 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, no, NewPredInfo0,
+ CallGoal, !StmInfo),
+
+ create_rollback_pred_2(AtomicGoalVarList, CallGoal, AtomicGoal, OrElseGoals,
+ NewPredInfo0, NewPredInfo, !StmInfo),
+ commit_new_pred(NewPredInfo, !StmInfo).
+
+:- pred create_rollback_pred_2(list(stm_goal_vars)::in, hlds_goal::in,
+ hlds_goal::in, list(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(AtomicGoalVarList, RecCallGoal, AtomicGoal, OrElseGoals,
+ !NewPredInfo, !StmInfo) :-
+ AtomicGoalVars = list.det_head(AtomicGoalVarList),
+
+ 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
+ % predicate can have the most up to date copy of the module info.
+ commit_new_pred(!.NewPredInfo, !StmInfo),
+
+ ProcessGoalList = [AtomicGoal | OrElseGoals],
+ create_wrapper_for_goal_list(AtomicGoalVarList, ResultType, ResultVar,
+ ProcessGoalList, 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).
+
+ % Moves all local variables from the original predicate to the newly
+ % created wrapper predicate. This also includes the original STM
+ % di and uo variables.
+ %
+:- 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.
+%
+
+:- pred create_wrapper_for_goal_list(list(stm_goal_vars)::in, mer_type::in,
+ prog_var::in, list(hlds_goal)::in, pred_proc_id::out, hlds_goal::out,
+ stm_info::in, stm_info::out) is det.
+
+create_wrapper_for_goal_list(AtomicGoalVarList, ResultType, ResultVar,
+ GoalList, PredProcId, CallGoal, !StmInfo) :-
+ (
+ GoalList = [],
+ unexpected(this_file, "create_wrapper_for_goal_list: list empty")
+ ;
+ GoalList = [SingleGoal],
+ AtomicGoalVars = list.det_head(AtomicGoalVarList),
+ create_wrapper_pred(AtomicGoalVars, ResultType, ResultVar, SingleGoal,
+ PredProcId, CallGoal, !StmInfo)
+ ;
+ GoalList = [_, _ | _],
+
+ CreateWrapperForEachGoal = (
+ pred(Goal::in, GoalVars::in, PPID::out, SInfo0::in,
+ SInfo::out) is det :-
+ % These predicates should be plain predicates without code to
+ % validate logs.
+ create_simple_wrapper_pred(GoalVars, ResultType, ResultVar,
+ Goal, PPID, _, SInfo0, SInfo)
+ ),
+ map2_in_foldl(CreateWrapperForEachGoal, GoalList, AtomicGoalVarList,
+ PPIDList, !StmInfo),
+
+ common_goal_vars_from_list(AtomicGoalVarList, AtomicGoalVars),
+% XXX STM
+% copy_input_vars_in_goallist(AtomicGoalVars, AtomicGoalVarList,
+% AtomicGoalVarList1),
+ AtomicGoalVarList1 = AtomicGoalVarList,
+ StmDI = AtomicGoalVars ^ vars_innerDI,
+ StmUO = AtomicGoalVars ^ vars_innerUO,
+
+ create_or_else_pred(AtomicGoalVars, AtomicGoalVarList1, PPIDList,
+ StmDI, StmUO, NewAtomicGoal, !StmInfo),
+ create_wrapper_pred(AtomicGoalVars, ResultType, ResultVar,
+ NewAtomicGoal, PredProcId, CallGoal, !StmInfo)
+ ).
+
+ % 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, no, !: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)
+ ;
+ CopyStm = no,
+ InnerUO = InnerUO0
+ ),
+
+ create_post_wrapper_goal(AtomicGoalVars, !.AtomicGoal, ResultType,
+ ResultVar, InnerDI, InnerUO, CopyStm, WrapperGoal, !.StmInfo,
+ !NewPredInfo),
+
+ set_head_vars(InputVars ++ [ResultVar0, InnerDI, InnerUO], !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_erroneous, 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]
+ ),
+
+ flatten_conj(TopLevelGoalList0, TopLevelGoalList),
+ create_plain_conj(TopLevelGoalList, HldsGoal).
+
+ % Creates a simpler wrapper predicate for or_else branches.
+ %
+:- pred create_simple_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_simple_wrapper_pred(AtomicGoalVars, ResultType, ResultVar0, AtomicGoal,
+ PredProcId, CallGoal, !StmInfo) :-
+ create_simple_wrapper_pred_2(AtomicGoalVars, ResultType, ResultVar0,
+ AtomicGoal, PredProcId, _, CallGoal, !StmInfo).
+
+:- pred create_simple_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_simple_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],
+ "simple_wrapper", !.AtomicGoal, no, !: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)
+ ;
+ CopyStm = no,
+ InnerUO = InnerUO0
+ ),
+
+ create_simple_post_wrapper_goal(AtomicGoalVars, !.AtomicGoal, ResultType,
+ ResultVar, InnerDI, InnerUO, CopyStm, WrapperGoal, !.StmInfo,
+ !NewPredInfo),
+
+ set_head_vars(InputVars ++ [ResultVar, InnerDI, InnerUO], !NewPredInfo),
+ new_pred_set_goal(WrapperGoal, !NewPredInfo),
+ run_quantification_over_pred(!NewPredInfo),
+ get_pred_proc_id(!.NewPredInfo, PredProcId),
+ commit_new_pred(!.NewPredInfo, !StmInfo).
+
+% To Remove eventually
+:- pred create_probe_call(string::in, prog_var::in, hlds_goals::out,
+ stm_new_pred_info::in, stm_new_pred_info::out) is det.
+
+create_probe_call(_Name, _Var, HldsGoals, !NewPredInfo) :-
+ HldsGoals = [].
+
+ % 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_simple_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_simple_post_wrapper_goal(AtomicGoalVars, AtomicGoal, ResultType,
+ ResultVar, StmDI, StmUO, CopySTM, HldsGoal, StmInfo, !NewPredInfo) :-
+ construct_output(AtomicGoalVars, ResultType, ResultVar, StmInfo,
+ AssignResult, !NewPredInfo),
+
+ create_probe_call("start_of_wrapper", StmDI, Call1, !NewPredInfo),
+ create_probe_call("start_of_wrapper", StmUO, Call2, !NewPredInfo),
+
+ % 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 = Call1 ++ [CopySTMAssign, AtomicGoal] ++ Call2 ++
+ AssignResult
+ ;
+ TopLevelGoalList0 = Call1 ++ [AtomicGoal] ++ Call2 ++ AssignResult
+ ),
+
+ flatten_conj(TopLevelGoalList0, TopLevelGoalList),
+ create_plain_conj(TopLevelGoalList, HldsGoal).
+
+%-----------------------------------------------------------------------------%
+%
+% Predicates used in the creation of "or_else" goals.
+%
+
+ % or_else(<<inners>>, <<outers>>, <<STM_di>>, <<STM_uo>>) is det.
+ %
+:- pred create_or_else_pred(stm_goal_vars::in, list(stm_goal_vars)::in,
+ list(pred_proc_id)::in, prog_var::in, prog_var::in, hlds_goal::out,
+ stm_info::in, stm_info::out) is det.
+
+create_or_else_pred(AtomicGoalVars, BranchGoalVars, Closures, StmDI, StmUO,
+ CallGoal, !StmInfo) :-
+ get_input_output_varlist(AtomicGoalVars, InputVars, OutputVars),
+ get_input_output_types(AtomicGoalVars, !.StmInfo, InputTypes, OutputTypes),
+ get_input_output_modes(AtomicGoalVars, InputModes, OutputModes),
+
+% MaybeDetism = yes(detism_cc_multi),
+ MaybeDetism = no,
+
+ make_return_type(OutputTypes, ReturnType),
+ create_cloned_pred(InputVars ++ OutputVars ++ [StmDI, StmUO],
+ InputTypes ++ OutputTypes ++ [stm_state_type, stm_state_type],
+ InputModes ++ OutputModes ++ [mer_mode_di, mer_mode_uo],
+ "or_else", true_goal, MaybeDetism, NewPredInfo0, CallGoal,
+ !StmInfo),
+
+ create_aux_variable(stm_state_type, yes("STMDI"), NewStmDI,
+ NewPredInfo0, NewPredInfo1),
+ create_aux_variable(stm_state_type, yes("STMUO"), NewStmUO,
+ NewPredInfo1, NewPredInfo2),
+ set_head_vars(InputVars ++ OutputVars ++ [NewStmDI, NewStmUO],
+ NewPredInfo2, NewPredInfo3),
+
+ create_or_else_pred_2(BranchGoalVars, Closures, NewStmDI, NewStmUO,
+ ReturnType, !.StmInfo, NewPredInfo3, NewPredInfo),
+
+ commit_new_pred(NewPredInfo, !StmInfo).
+
+:- pred create_or_else_pred_2(list(stm_goal_vars)::in, list(pred_proc_id)::in,
+ prog_var::in, prog_var::in, mer_type::in, stm_info::in,
+ stm_new_pred_info::in, stm_new_pred_info::out) is det.
+
+create_or_else_pred_2(AtomicGoalVars, Closures, StmDI, StmUO, ReturnType,
+ StmInfo, !NewPredInfo) :-
+
+ list.length(Closures, ClosureCount),
+ create_or_else_inner_stm_vars(ClosureCount, InnerSTMVars, !NewPredInfo),
+
+ make_type_info(ReturnType, ReturnRttiVar, CreateRetTypeInfo,
+ !NewPredInfo),
+ make_type_info(stm_rollback_exception_type, ExceptRttiVar,
+ CreateExceptTypeInfo, !NewPredInfo),
+
+ create_or_else_end_branch(InnerSTMVars, StmDI, StmUO, ExceptRttiVar,
+ EndBranchGoal, !NewPredInfo),
+
+ create_or_else_branches(AtomicGoalVars, ReturnType, StmDI, StmUO,
+ InnerSTMVars, ReturnRttiVar, ExceptRttiVar, Closures, EndBranchGoal,
+ MainGoal0, StmInfo, !NewPredInfo),
+
+ TopLevelGoalList0 = CreateRetTypeInfo ++ CreateExceptTypeInfo ++
+ [MainGoal0],
+ flatten_conj(TopLevelGoalList0, TopLevelGoalList),
+
+ create_plain_conj(TopLevelGoalList, MainGoal1),
+ create_promise_purity_scope(MainGoal1, purity_pure, MainGoal),
+
+ new_pred_set_goal(MainGoal, !NewPredInfo),
+ run_quantification_over_pred(!NewPredInfo).
+
+:- pred create_or_else_branches(list(stm_goal_vars)::in, mer_type::in,
+ prog_var::in, prog_var::in, list(prog_var)::in, prog_var::in, prog_var::in,
+ list(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_or_else_branches(AtomicGoalVars, ReturnType, OuterStmDIVar,
+ OuterStmUOVar, InnerSTMVars, RttiVar, RollbackExceptionRttiVar,
+ WrapperIDs, EndBranch, HldsGoal, StmInfo, !NewPredInfo) :-
+ (
+ InnerSTMVars = [],
+ WrapperIDs = [],
+ AtomicGoalVars = []
+ ->
+ HldsGoal = EndBranch
+ ;
+ AtomicGoalVars = [AGV | AGVs],
+ InnerSTMVars = [InnerVar | InnerSTMVars0],
+ WrapperIDs = [WrapID | WrapperIDs0]
+ ->
+ create_or_else_branches(AGVs, ReturnType, OuterStmDIVar,
+ OuterStmUOVar, InnerSTMVars0, RttiVar, RollbackExceptionRttiVar,
+ WrapperIDs0, EndBranch, HldsGoal0, StmInfo, !NewPredInfo),
+ create_or_else_branch(AGV, ReturnType, OuterStmDIVar,
+ OuterStmUOVar, InnerVar, RttiVar, RollbackExceptionRttiVar,
+ WrapID, HldsGoal0, HldsGoal, StmInfo, !NewPredInfo)
+ ;
+ unexpected(this_file, "create_or_else_branches: Mismatched lists")
+ ).
+
+:- pred create_or_else_inner_stm_vars(int::in, list(prog_var)::out,
+ stm_new_pred_info::in, stm_new_pred_info::out) is det.
+
+create_or_else_inner_stm_vars(Count, Vars, !NewPredInfo) :-
+ ( Count = 0 ->
+ Vars = []
+ ; Count > 0 ->
+ create_aux_variable(stm_state_type, yes("InnSTM"), Var, !NewPredInfo),
+ Count1 = Count - 1,
+ create_or_else_inner_stm_vars(Count1, Vars0, !NewPredInfo),
+ Vars = [Var | Vars0]
+ ;
+ unexpected(this_file, "create_or_else_inner_stm_vars: Negative count")
+ ).
+
+ % Creates an or_else branch.
+ %
+ % impure stm_create_nested_log(OuterSTM0, InnerSTM0),
+ % unsafe_try_stm(TransA, ResultA, InnerSTM0, InnerSTM),
+ % (
+ % ResultA = succeeded(Result),
+ % impure stm_merge_nested_logs(InnerSTM, OuterSTM0, OuterSTM)
+ % ;
+ % ResultA = exception(Excp)
+ % ( Excp = univ(rollback_retry) ->
+ % << nested or_else branch >>
+ % ;
+ % impure stm_discard_transaction_log(InnerSTM),
+ % rethrow(Result)
+ % )
+ % )
+ %
+:- pred map2_in_foldl(
+ pred(K, L, N, A, A)::in(pred(in, in, out, in, out) is det),
+ list(K)::in, list(L)::in, list(N)::out, A::in, A::out) is det.
+
+map2_in_foldl(Pred, Src1, Src2, Dest, !Accum) :-
+ (
+ Src1 = [],
+ Src2 = []
+ ->
+ Dest = []
+ ;
+ Src1 = [S | Ss],
+ Src2 = [T | Ts]
+ ->
+ Pred(S, T, R, !Accum),
+ map2_in_foldl(Pred, Ss, Ts, Rs, !Accum),
+ Dest = [R | Rs]
+ ;
+ unexpected(this_file, "map2_in_foldl: Source list lengths mismatch")
+ ).
+
+:- pred map3_in_foldl(
+ pred(K, L, M, N, A, A)::in(pred(in, in, in, out, in, out) is det),
+ list(K)::in, list(L)::in, list(M)::in, list(N)::out, A::in, A::out) is det.
+
+map3_in_foldl(Pred, Src1, Src2, Src3, Dest, !Accum) :-
+ (
+ Src1 = [],
+ Src2 = [],
+ Src3 = []
+ ->
+ Dest = []
+ ;
+ Src1 = [S | Ss],
+ Src2 = [T | Ts],
+ Src3 = [U | Us]
+ ->
+ Pred(S, T, U, R, !Accum),
+ map3_in_foldl(Pred, Ss, Ts, Us, Rs, !Accum),
+ Dest = [R | Rs]
+ ;
+ unexpected(this_file, "map2_in_foldl: Source list lengths mismatch")
+ ).
+
+:- pred create_or_else_end_branch(list(prog_var)::in, prog_var::in,
+ prog_var::in, prog_var::in, hlds_goal::out, stm_new_pred_info::in,
+ stm_new_pred_info::out) is det.
+
+create_or_else_end_branch(StmVars, OuterSTMDI, OuterSTMUO, ExceptionRttiVar,
+ HldsGoal, !NewPredInfo) :-
+
+ MakeIntermediateStmVars = (pred(_::in, Var::out, NPI0::in, NPI::out)
+ is det:-
+ create_aux_variable(stm_state_type, yes("InterSTM"), Var, NPI0, NPI)),
+
+ % We don't actually need the list as it is simply used as a counter.
+ StmVarsMinusHead = list.det_tail(StmVars),
+ list.map_foldl(MakeIntermediateStmVars, StmVarsMinusHead,
+ IntermediateStmVars, !NewPredInfo),
+
+ MergeStmVarsIn = [OuterSTMDI | IntermediateStmVars],
+ MergeStmVarsOut = IntermediateStmVars ++ [OuterSTMUO],
+
+ MakeMergeGoals = (pred(StmVar::in, ThreadSTMDI::in, ThreadSTMUO::in,
+ Goal::out, NPI0::in, NPI::out) is det :-
+ create_simple_call(module_stm_sym_name, "stm_merge_nested_logs",
+ pf_predicate, only_mode, detism_det, purity_impure,
+ [StmVar, ThreadSTMDI, ThreadSTMUO], [],
+ [pair(StmVar, ground(unique, none)), pair(ThreadSTMDI, free),
+ pair(ThreadSTMUO, ground(unique, none))],
+ Goal, NPI0, NPI)),
+
+ map3_in_foldl(MakeMergeGoals, StmVars, MergeStmVarsIn, MergeStmVarsOut,
+ MergeGoals, !NewPredInfo),
+
+ create_simple_call(module_stm_sym_name, "stm_unlock", pf_predicate,
+ only_mode, detism_det, purity_impure, [], [], [], UnlockCall,
+ !NewPredInfo),
+
+ create_aux_variable_assignment(stm_rollback_retry_functor,
+ stm_rollback_exception_type, yes("RetryCons"), AssignRetryCons,
+ RetryConsVar, !NewPredInfo),
+ create_simple_call(module_exception_sym_name, "throw", pf_predicate,
+ only_mode, detism_erroneous, purity_pure, [ExceptionRttiVar,
+ RetryConsVar], [], [pair(ExceptionRttiVar, ground(shared, none)),
+ pair(RetryConsVar, ground(shared, none))], RetryCall,
+ !NewPredInfo),
+
+% XXX STM
+% create_simple_call(module_stm_sym_name, "retry", pf_predicate, only_mode,
+% detism_det, purity_pure, [OuterSTMUO], [],
+% [pair(OuterSTMUO, ground(unique, none))], RetryCall, !NewPredInfo),
+ create_plain_conj(MergeGoals ++ [UnlockCall, AssignRetryCons, RetryCall],
+ ValidGoal),
+
+ % Failure break
+
+ create_aux_variable_assignment(stm_rollback_exception_functor,
+ stm_rollback_exception_type, yes("RollbackCons"), AssignRollbackCons,
+ RollbackConsVar, !NewPredInfo),
+ create_simple_call(module_exception_sym_name, "throw", pf_predicate,
+ only_mode, detism_erroneous, purity_pure, [ExceptionRttiVar,
+ RollbackConsVar], [], [pair(ExceptionRttiVar, ground(shared, none)),
+ pair(RollbackConsVar, ground(shared, none))], ThrowCall,
+ !NewPredInfo),
+ create_plain_conj([UnlockCall, AssignRollbackCons, ThrowCall],
+ InvalidGoal),
+
+ template_lock_and_validate_many(StmVars, no, ValidGoal, InvalidGoal,
+ HldsGoals, !NewPredInfo),
+ create_plain_conj(HldsGoals, HldsGoal).
+
+ % Variables are:
+ % StmGoalVars
+ % ReturnType -- Return type of the or_else pred
+ % ReturnValue -- Return variable of the or_else pred (not
+ % decompressed)
+ % OuterStmDIVar -- Outer STM DI Variable (in pred head)
+ % OuterStmUOVar -- Outer STM UO Variable (in pred head)
+ % RttiVar -- Variable holding type_info for ReturnType
+ % RollbackExceptionRttiVar -- Variable holding type_info forr
+ % "stm_builtin.rollback_exception_type"
+ % WrapperID -- The predicate ID of the call to try
+ % RetryBranch -- The goal to execute when a retry is called
+ % InnerSTMVar -- The DI variable of the retry branch. It must
+ % be created outside this predicate as it needs to be
+ % known to the validate & merge branch.
+ %
+ %
+:- pred create_or_else_branch(stm_goal_vars::in, mer_type::in, prog_var::in,
+ prog_var::in, prog_var::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_or_else_branch(AtomicGoalVars, ReturnType, OuterStmDIVar,
+ OuterStmUOVar, InnerSTMVar, RttiVar, RollbackExceptionRttiVar,
+ WrapperID, RetryBranch, HldsGoal, StmInfo, !NewPredInfo) :-
+ get_input_output_varlist(AtomicGoalVars, InputVars, _),
+ get_input_output_types(AtomicGoalVars, StmInfo, InputTypes, _),
+ get_input_output_modes(AtomicGoalVars, InputModes, _),
+
+ create_aux_variable(stm_state_type, yes("InnerSTM0"), InnerSTM0Var,
+ !NewPredInfo),
+ create_aux_variable(stm_exception_result_type(ReturnType), yes("ExcptRes"),
+ ReturnExceptVar, !NewPredInfo),
+
+ create_closure(WrapperID, InputVars,
+ InputTypes ++ [ReturnType, stm_state_type, stm_state_type],
+ InputModes ++ [mer_mode_out, mer_mode_di, mer_mode_uo],
+ AtomicClosureVar, ClosureAssign, !NewPredInfo),
+
+ create_simple_call(module_stm_sym_name, "stm_create_nested_transaction_log",
+ pf_predicate, only_mode, detism_det, purity_impure,
+ [OuterStmDIVar, InnerSTM0Var], [],
+ [pair(OuterStmDIVar, ground(unique, none)), pair(InnerSTM0Var, free)],
+ CreateNestedLogCall, !NewPredInfo),
+
+ create_simple_call(module_exception_sym_name, "unsafe_try_stm",
+ pf_predicate, mode_no(0), detism_cc_multi, purity_pure,
+ [RttiVar, AtomicClosureVar, ReturnExceptVar, InnerSTM0Var,InnerSTMVar],
+ [], [pair(RttiVar, ground(shared, none)),
+ pair(AtomicClosureVar, ground(shared, none)),
+ pair(ReturnExceptVar, free),
+ pair(InnerSTM0Var, ground(unique, none)),
+ pair(InnerSTMVar, free)], TryStmCall, !NewPredInfo),
+
+ % Successfull execution, deconstruct and return
+ deconstruct_output(AtomicGoalVars, ReturnType, ReturnExceptVar,
+ DeconstructGoal, StmInfo, !NewPredInfo),
+ create_simple_call(module_stm_sym_name, "stm_merge_nested_logs",
+ pf_predicate, only_mode, detism_det, purity_impure,
+ [InnerSTMVar, OuterStmDIVar, OuterStmUOVar], [],
+ [pair(InnerSTMVar, ground(unique, none)),
+ pair(OuterStmDIVar, ground(unique, none)), pair(OuterStmUOVar, free)],
+ MergeNestedLogsCall, !NewPredInfo),
+
+ create_plain_conj([DeconstructGoal, MergeNestedLogsCall], SuccessBranch),
+
+ % General exception: discard and throw upwards
+ create_simple_call(module_stm_sym_name, "stm_discard_transaction_log",
+ pf_predicate, only_mode, detism_det, purity_impure,
+ [InnerSTMVar], [], [pair(InnerSTMVar, ground(unique, none))],
+ DiscardCall, !NewPredInfo),
+ create_simple_call(module_exception_sym_name, "rethrow",
+ pf_predicate, only_mode, detism_erroneous, purity_pure,
+ [RttiVar, ReturnExceptVar], [], [pair(RttiVar, ground(shared, none)),
+ pair(ReturnExceptVar, ground(shared, none))], RethrowCall,
+ !NewPredInfo),
+
+ % Code to extract the exception result.
+ create_aux_variable(stm_univ_type, yes("ExceptUnivVar"), ExceptUnivVar,
+ !NewPredInfo),
+ deconstruct_functor(ReturnExceptVar, stm_exceptres_exception_functor,
+ [ExceptUnivVar], DeconstructException),
+
+ create_plain_conj([DiscardCall, RethrowCall], NotRetryBranch),
+
+ % Code to generate top level goals
+ template_if_exceptres_is_cons(RollbackExceptionRttiVar, ExceptUnivVar,
+ stm_rollback_retry_functor, RetryBranch, NotRetryBranch, IfRetryGoal,
+ !NewPredInfo),
+
+ create_plain_conj([DeconstructException, IfRetryGoal], ExceptionBranch),
+ create_switch_disjunction(ReturnExceptVar,
+ [case(stm_exceptres_exception_functor, [], ExceptionBranch),
+ case(stm_exceptres_success_functor, [], SuccessBranch)],
+ detism_det, purity_impure, DisjGoal, !NewPredInfo),
+
+ create_plain_conj([CreateNestedLogCall, ClosureAssign, TryStmCall,
+ DisjGoal], 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)
+ )
+ ).
+
+ % 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) :-
+ 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 tuple. Get the tuple result and return it.
+
+ 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)
+ ).
+
+ % 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 tuple. Creates a tuple 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_stm(mer_type::in, maybe(string)::in, prog_var::out,
+ stm_info::in, stm_info::out) is det.
+
+create_aux_variable_stm(Type, MaybeName0, Var, !StmInfo) :-
+ ProcInfo0 = !.StmInfo ^ stm_info_proc_info,
+ (
+ MaybeName0 = no,
+ MaybeName0 = MaybeName
+ ;
+ MaybeName0 = yes(Name),
+ MaybeName = yes(Name ++ "_Aux_STM")
+ ),
+ proc_info_create_var_from_type(Type, MaybeName, Var, ProcInfo0, ProcInfo),
+ !:StmInfo = !.StmInfo ^ stm_info_proc_info := ProcInfo.
+
+ % 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, MaybeName0, Var, !NewPredInfo) :-
+ ProcInfo0 = !.NewPredInfo ^ new_pred_proc_info,
+ Cnt0 = !.NewPredInfo ^ new_pred_var_cnt,
+ (
+ MaybeName0 = no,
+ MaybeName0 = MaybeName
+ ;
+ MaybeName0 = yes(Name),
+ MaybeName = yes(Name ++ "_Aux_" ++ string(Cnt0))
+ ),
+ proc_info_create_var_from_type(Type, MaybeName, Var, ProcInfo0, ProcInfo),
+ Cnt = Cnt0 + 1,
+ !:NewPredInfo = !.NewPredInfo ^ new_pred_proc_info := ProcInfo,
+ !:NewPredInfo = !.NewPredInfo ^ new_pred_var_cnt := Cnt.
+
+ % 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)
+ % Takes the "stm_info" state
+ %
+:- pred create_var_unify_stm(prog_var::in, prog_var::in, unify_mode::in,
+ hlds_goal::out, stm_info::in, stm_info::out) is det.
+
+create_var_unify_stm(VarLHS, VarRHS, UnifyMode, HldsGoal, !StmInfo) :-
+ Context = term.context("--temp-context--", 999),
+ ModuleInfo = !.StmInfo ^ stm_info_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 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 a closure for a predicate.
+ %
+:- pred create_closure(pred_proc_id::in, list(prog_var)::in,
+ list(mer_type)::in, list(mer_mode)::in, prog_var::out, hlds_goal::out,
+ stm_new_pred_info::in, stm_new_pred_info::out) is det.
+
+create_closure(PredProcID, Args, ArgTypes, ArgModes, ClosureVar,
+ ClosureAssignGoal, !NewPredInfo) :-
+ ShroudPredProcID = shroud_pred_proc_id(PredProcID),
+ construct_higher_order_pred_type(purity_pure, lambda_normal, ArgTypes,
+ ClosureType),
+ ClosureCons = pred_const(ShroudPredProcID, lambda_normal),
+ create_aux_variable(ClosureType, yes("Closure"), ClosureVar, !NewPredInfo),
+ construct_functor(ClosureVar, ClosureCons, Args, ClosureAssignGoal0),
+
+ ClosureAssignInstmapDeltaList = assoc_list.from_corresponding_lists(
+ [ClosureVar], [ground(shared, higher_order(pred_inst_info(
+ pf_predicate, ArgModes, detism_det)))]),
+ instmap_delta_from_assoc_list(ClosureAssignInstmapDeltaList,
+ ClosureAssignInstmapDelta),
+
+ ClosureAssignGoal0 = hlds_goal(ClosureAssignExpr, ClosureAssignInfo0),
+ goal_info_set_instmap_delta(ClosureAssignInstmapDelta, ClosureAssignInfo0,
+ ClosureAssignInfo),
+ ClosureAssignGoal = hlds_goal(ClosureAssignExpr, ClosureAssignInfo).
+
+ % 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, VarCnt),
+ 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, VarCnt).
+
+ % 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, maybe(determinism)::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, MaybeDetism, 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,
+ ExpansionCnt0 = !.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),
+ (
+ MaybeDetism = yes(ProcDetism)
+ ;
+ MaybeDetism = no,
+ 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(ExpansionCnt0)),
+
+ 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 = ProcDetism,
+ 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),
+
+ ExpansionCnt = ExpansionCnt0 + 1,
+ !:StmInfo = !.StmInfo ^ stm_info_expand_id := ExpansionCnt,
+ !:StmInfo = !.StmInfo ^ stm_info_module_info := ModuleInfo,
+ NewStmPredInfo = stm_new_pred_info(ModuleInfo, NewPredId, NewProcId,
+ NewPredInfo, NewProcInfo, CallContext, 0).
+
+ % 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),
+ recompute_instmap_delta_proc(recompute_atomic_instmap_deltas,
+ 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).
+
+%-----------------------------------------------------------------------------%
+%
+% 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").
+
+stm_inner_outer = qualified(module_stm_sym_name, "stm_from_inner_to_outer_io").
+stm_outer_inner = qualified(module_stm_sym_name, "stm_from_outer_to_inner_io").
+
+stm_state_type =
+ defined_type(qualified(module_stm_sym_name, "stm"), [], kind_star).
+stm_valid_result_type =
+ defined_type(qualified(module_stm_sym_name, "stm_validation_result"),
+ [], kind_star).
+stm_rollback_exception_type =
+ defined_type(qualified(module_stm_sym_name, "rollback_exception"), [],
+ kind_star).
+stm_dummy_output_type =
+ defined_type(qualified(module_stm_sym_name, "stm_dummy_output"), [],
+ kind_star).
+stm_univ_type =
+ defined_type(qualified(module_univ_sym_name, "univ"), [], kind_star).
+stm_io_type =
+ defined_type(qualified(module_io_sym_name, "state"), [], kind_star).
+
+stm_exception_result_type(SubType) =
+ defined_type(qualified(module_exception_sym_name, "exception_result"),
+ [SubType], kind_star).
+
+stm_validres_valid_functor =
+ cons(qualified(module_stm_sym_name, "stm_transaction_valid"), 0).
+stm_validres_invalid_functor =
+ cons(qualified(module_stm_sym_name, "stm_transaction_invalid"), 0).
+stm_rollback_exception_functor =
+ cons(qualified(module_stm_sym_name, "rollback_invalid_transaction"), 0).
+stm_rollback_retry_functor =
+ cons(qualified(module_stm_sym_name, "rollback_retry"), 0).
+stm_dummy_output_functor =
+ cons(qualified(module_stm_sym_name, "stm_dummy_output"), 0).
+stm_exceptres_success_functor =
+ cons(qualified(module_exception_sym_name, "succeeded"), 1).
+stm_exceptres_exception_functor =
+ cons(qualified(module_exception_sym_name, "exception"), 1).
+
+mer_mode_in = user_defined_mode(qualified(unqualified("builtin"), "in"), []).
+mer_mode_out = user_defined_mode(qualified(unqualified("builtin"), "out"), []).
+mer_mode_di = user_defined_mode(qualified(unqualified("builtin"), "di"), []).
+mer_mode_uo = user_defined_mode(qualified(unqualified("builtin"), "uo"), []).
+
+%-----------------------------------------------------------------------------%
+
+:- func this_file = string.
+
+this_file = "stm_expand.m".
+
+%-----------------------------------------------------------------------------%
+:- end_module transform_hlds.stm_expand.
+%-----------------------------------------------------------------------------%
Index: compiler/stratify.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/stratify.m,v
retrieving revision 1.66
diff -u -b -r1.66 stratify.m
--- compiler/stratify.m 22 Jan 2008 15:06:16 -0000 1.66
+++ compiler/stratify.m 27 Jan 2008 23:50:06 -0000
@@ -173,11 +173,11 @@
( GoalExpr = conj(_ConjType, Goals)
; GoalExpr = disj(Goals)
),
- first_order_check_goal_list(Goals, Negated, WholeScc, ThisPredProcId,
+ first_order_check_goals(Goals, Negated, WholeScc, ThisPredProcId,
Error, !ModuleInfo, !IO)
;
GoalExpr = switch(_Var, _Fail, Cases),
- first_order_check_case_list(Cases, Negated, WholeScc, ThisPredProcId,
+ first_order_check_cases(Cases, Negated, WholeScc, ThisPredProcId,
Error, !ModuleInfo, !IO)
;
GoalExpr = if_then_else(_Vars, Cond, Then, Else),
@@ -218,34 +218,43 @@
GoalExpr = unify(_LHS, _RHS, _Mode, _Unification, _UnifyContext)
% Do nothing.
;
- GoalExpr = shorthand(_),
- % these should have been expanded out by now
- unexpected(this_file, "first_order_check_goal: shorthand")
+ GoalExpr = shorthand(ShortHand),
+ (
+ ShortHand = atomic_goal(_, _, _, _, MainGoal, OrElseGoals),
+ first_order_check_goal(MainGoal, Negated, WholeScc,
+ ThisPredProcId, Error, !ModuleInfo, !IO),
+ first_order_check_goals(OrElseGoals, Negated, WholeScc,
+ ThisPredProcId, Error, !ModuleInfo, !IO)
+ ;
+ ShortHand = bi_implication(_, _),
+ % These should have been expanded out by now.
+ unexpected(this_file, "first_order_check_goal: bi_implication")
+ )
).
-:- pred first_order_check_goal_list(list(hlds_goal)::in, bool::in,
+:- pred first_order_check_goals(list(hlds_goal)::in, bool::in,
list(pred_proc_id)::in, pred_proc_id::in, bool::in,
module_info::in, module_info::out, io::di, io::uo) is det.
-first_order_check_goal_list([], _, _, _, _, !ModuleInfo, !IO).
-first_order_check_goal_list([Goal | Goals], Negated,
+first_order_check_goals([], _, _, _, _, !ModuleInfo, !IO).
+first_order_check_goals([Goal | Goals], Negated,
WholeScc, ThisPredProcId, Error, !ModuleInfo, !IO) :-
first_order_check_goal(Goal, Negated, WholeScc, ThisPredProcId,
Error, !ModuleInfo, !IO),
- first_order_check_goal_list(Goals, Negated, WholeScc, ThisPredProcId,
+ first_order_check_goals(Goals, Negated, WholeScc, ThisPredProcId,
Error, !ModuleInfo, !IO).
-:- pred first_order_check_case_list(list(case)::in, bool::in,
+:- pred first_order_check_cases(list(case)::in, bool::in,
list(pred_proc_id)::in, pred_proc_id::in, bool::in,
module_info::in, module_info::out, io::di, io::uo) is det.
-first_order_check_case_list([], _, _, _, _, !ModuleInfo, !IO).
-first_order_check_case_list([Case | Goals], Negated, WholeScc, ThisPredProcId,
+first_order_check_cases([], _, _, _, _, !ModuleInfo, !IO).
+first_order_check_cases([Case | Goals], Negated, WholeScc, ThisPredProcId,
Error, !ModuleInfo, !IO) :-
Case = case(_, _, Goal),
first_order_check_goal(Goal, Negated, WholeScc,
ThisPredProcId, Error, !ModuleInfo, !IO),
- first_order_check_case_list(Goals, Negated, WholeScc, ThisPredProcId,
+ first_order_check_cases(Goals, Negated, WholeScc, ThisPredProcId,
Error, !ModuleInfo, !IO).
%-----------------------------------------------------------------------------%
@@ -306,11 +315,11 @@
( GoalExpr = conj(_ConjType, Goals)
; GoalExpr = disj(Goals)
),
- higher_order_check_goal_list(Goals, Negated, WholeScc, ThisPredProcId,
+ higher_order_check_goals(Goals, Negated, WholeScc, ThisPredProcId,
HighOrderLoops, Error, !ModuleInfo, !IO)
;
GoalExpr = switch(_Var, _Fail, Cases),
- higher_order_check_case_list(Cases, Negated, WholeScc, ThisPredProcId,
+ higher_order_check_cases(Cases, Negated, WholeScc, ThisPredProcId,
HighOrderLoops, Error, !ModuleInfo, !IO)
;
GoalExpr = if_then_else(_Vars, Cond, Then, Else),
@@ -368,34 +377,43 @@
GoalExpr = unify(_LHS, _RHS, _Mode, _Unification, _UnifyContext)
% Do nothing.
;
- GoalExpr = shorthand(_),
+ GoalExpr = shorthand(ShortHand),
+ (
+ ShortHand = atomic_goal(_, _, _, _, MainGoal, OrElseGoals),
+ higher_order_check_goal(MainGoal, Negated, WholeScc,
+ ThisPredProcId, HighOrderLoops, Error, !ModuleInfo, !IO),
+ higher_order_check_goals(OrElseGoals, Negated, WholeScc,
+ ThisPredProcId, HighOrderLoops, Error, !ModuleInfo, !IO)
+ ;
+ ShortHand = bi_implication(_, _),
% These should have been expanded out by now.
- unexpected(this_file, "higher_order_check_goal: shorthand")
+ unexpected(this_file, "higher_order_check_goal: bi_implication")
+ )
).
-:- pred higher_order_check_goal_list(list(hlds_goal)::in, bool::in,
+:- pred higher_order_check_goals(list(hlds_goal)::in, bool::in,
set(pred_proc_id)::in, pred_proc_id::in, bool::in, bool::in,
module_info::in, module_info::out, io::di, io::uo) is det.
-higher_order_check_goal_list([], _, _, _, _, _, !ModuleInfo, !IO).
-higher_order_check_goal_list([Goal | Goals], Negated,
+higher_order_check_goals([], _, _, _, _, _, !ModuleInfo, !IO).
+higher_order_check_goals([Goal | Goals], Negated,
WholeScc, ThisPredProcId, HighOrderLoops, Error, !ModuleInfo, !IO) :-
higher_order_check_goal(Goal, Negated, WholeScc,
ThisPredProcId, HighOrderLoops, Error, !ModuleInfo, !IO),
- higher_order_check_goal_list(Goals, Negated, WholeScc, ThisPredProcId,
+ higher_order_check_goals(Goals, Negated, WholeScc, ThisPredProcId,
HighOrderLoops, Error, !ModuleInfo, !IO).
-:- pred higher_order_check_case_list(list(case)::in, bool::in,
+:- pred higher_order_check_cases(list(case)::in, bool::in,
set(pred_proc_id)::in, pred_proc_id::in, bool::in, bool::in,
module_info::in, module_info::out, io::di, io::uo) is det.
-higher_order_check_case_list([], _, _, _, _, _, !ModuleInfo, !IO).
-higher_order_check_case_list([Case | Goals], Negated, WholeScc, ThisPredProcId,
+higher_order_check_cases([], _, _, _, _, _, !ModuleInfo, !IO).
+higher_order_check_cases([Case | Goals], Negated, WholeScc, ThisPredProcId,
HighOrderLoops, Error, !ModuleInfo, !IO) :-
Case = case(_, _, Goal),
higher_order_check_goal(Goal, Negated, WholeScc,
ThisPredProcId, HighOrderLoops, Error, !ModuleInfo, !IO),
- higher_order_check_case_list(Goals, Negated, WholeScc, ThisPredProcId,
+ higher_order_check_cases(Goals, Negated, WholeScc, ThisPredProcId,
HighOrderLoops, Error, !ModuleInfo, !IO).
%-----------------------------------------------------------------------------%
@@ -754,7 +772,7 @@
check_goals(Goals, !Calls, !HasAT, !CallsHO)
;
GoalExpr = switch(_Var, _Fail, Cases),
- check_case_list(Cases, !Calls, !HasAT, !CallsHO)
+ check_cases(Cases, !Calls, !HasAT, !CallsHO)
;
GoalExpr = if_then_else(_Vars, Cond, Then, Else),
check_goal(Cond, !Calls, !HasAT, !CallsHO),
@@ -766,9 +784,16 @@
),
check_goal(SubGoal, !Calls, !HasAT, !CallsHO)
;
- GoalExpr = shorthand(_),
+ GoalExpr = shorthand(ShortHand),
+ (
+ ShortHand = atomic_goal(_, _, _, _, MainGoal, OrElseGoals),
+ check_goal(MainGoal, !Calls, !HasAT, !CallsHO),
+ check_goals(OrElseGoals, !Calls, !HasAT, !CallsHO)
+ ;
+ ShortHand = bi_implication(_, _),
% These should have been expanded out by now.
- unexpected(this_file, "check_goal: shorthand")
+ unexpected(this_file, "check_goal: bi_implication")
+ )
).
:- pred check_goals(list(hlds_goal)::in,
@@ -781,16 +806,16 @@
check_goal(Goal, !Calls, !HasAT, !CallsHO),
check_goals(Goals, !Calls, !HasAT, !CallsHO).
-:- pred check_case_list(list(case)::in,
+:- pred check_cases(list(case)::in,
set(pred_proc_id)::in, set(pred_proc_id)::out,
set(pred_proc_id)::in, set(pred_proc_id)::out,
bool::in, bool::out) is det.
-check_case_list([], !Calls, !HasAT, !CallsHO).
-check_case_list([Case | Goals], !Calls, !HasAT, !CallsHO) :-
+check_cases([], !Calls, !HasAT, !CallsHO).
+check_cases([Case | Goals], !Calls, !HasAT, !CallsHO) :-
Case = case(_, _, Goal),
check_goal(Goal, !Calls, !HasAT, !CallsHO),
- check_case_list(Goals, !Calls, !HasAT, !CallsHO).
+ check_cases(Goals, !Calls, !HasAT, !CallsHO).
% This pred returns a list of all the calls in a given set of goals,
% including calls in unification lambda functions and pred_proc_id's
@@ -868,9 +893,16 @@
),
get_called_procs(SubGoal, !Calls)
;
- GoalExpr = shorthand(_),
+ GoalExpr = shorthand(ShortHand),
+ (
+ ShortHand = atomic_goal(_, _, _, _, MainGoal, OrElseGoals),
+ get_called_procs(MainGoal, !Calls),
+ get_called_procs_goals(OrElseGoals, !Calls)
+ ;
+ ShortHand = bi_implication(_, _),
% These should have been expanded out by now.
- unexpected(this_file, "get_called_procs: shorthand")
+ unexpected(this_file, "get_called_procs: bi_implication")
+ )
).
:- pred get_called_procs_goals(list(hlds_goal)::in,
Index: compiler/structure_reuse.direct.choose_reuse.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/structure_reuse.direct.choose_reuse.m,v
retrieving revision 1.14
diff -u -b -r1.14 structure_reuse.direct.choose_reuse.m
--- compiler/structure_reuse.direct.choose_reuse.m 29 Jan 2008 04:59:43 -0000 1.14
+++ compiler/structure_reuse.direct.choose_reuse.m 29 Jan 2008 05:04:01 -0000
@@ -627,8 +627,9 @@
!Table, !IO)
;
GoalExpr = shorthand(_),
+ % These should have been expanded out by now.
unexpected(choose_reuse.this_file,
- "compute_match_table: shorthand goal.")
+ "compute_match_table: shorthand")
).
:- pred compute_match_table_in_disjs(background_info::in, dead_cell_table::in,
@@ -1144,8 +1145,9 @@
GoalInfo = GoalInfo0
;
GoalExpr0 = shorthand(_),
- unexpected(choose_reuse.this_file, "annotate_reuses: " ++
- "shorthand goal.")
+ % These should have been expanded out by now.
+ unexpected(choose_reuse.this_file,
+ "annotate_reuses: shorthand.")
),
!:Goal = hlds_goal(GoalExpr, GoalInfo).
@@ -1182,13 +1184,9 @@
ReuseAs = match_get_condition(Background, Match),
ReuseFields = ConSpec ^ con_reuse ^ reuse_fields,
- (
- reuse_as_conditional_reuses(ReuseAs)
- ->
+ ( reuse_as_conditional_reuses(ReuseAs) ->
Kind = conditional_reuse
- ;
- reuse_as_all_unconditional_reuses(ReuseAs)
- ->
+ ; reuse_as_all_unconditional_reuses(ReuseAs) ->
Kind = unconditional_reuse
;
% reuse_as_no_reuses(ReuseAs)
@@ -1197,7 +1195,6 @@
),
CellReused = cell_reused(DeadVar, Kind, DeadConsIds,
ReuseFields),
-
(
Kind = conditional_reuse,
KindReuse = potential_reuse(CellReused)
@@ -1282,6 +1279,7 @@
).
:- pred dump_match(string::in, match::in, io::di, io::uo) is det.
+
dump_match(Prefix, Match, !IO):-
io.write_string(Prefix, !IO),
io.write_string("\t|\t", !IO),
@@ -1303,12 +1301,11 @@
io.nl(!IO).
:- pred dump_match_details(match::in, io::di, io::uo) is det.
+
dump_match_details(Match, !IO) :-
Conds = list.map((func(DeconSpec) = DeconSpec ^ decon_conds),
Match ^ decon_specs),
- (
- list.takewhile(reuse_as_all_unconditional_reuses, Conds, _, [])
- ->
+ ( list.takewhile(reuse_as_all_unconditional_reuses, Conds, _, []) ->
CondsString = "A"
;
CondsString = "C"
@@ -1322,10 +1319,9 @@
io.write_string(Details, !IO).
:- pred dump_full_table(match_table::in, io::di, io::uo) is det.
+
dump_full_table(MatchTable, !IO) :-
- (
- multi_map.is_empty(MatchTable)
- ->
+ ( multi_map.is_empty(MatchTable) ->
dump_line("empty match table", !IO)
;
dump_line("full table (start)", !IO),
@@ -1355,13 +1351,11 @@
check_for_cell_caching(DeadCellTable0, !Goal, !IO) :-
dead_cell_table_remove_conditionals(DeadCellTable0, DeadCellTable),
globals.io_lookup_bool_option(very_verbose, VeryVerbose, !IO),
- (
- \+ dead_cell_table_is_empty(DeadCellTable)
- ->
+ ( dead_cell_table_is_empty(DeadCellTable) ->
+ maybe_write_string(VeryVerbose, "% No cells to be cached.\n", !IO)
+ ;
maybe_write_string(VeryVerbose, "% Marking cacheable cells.\n", !IO),
check_for_cell_caching_2(DeadCellTable, !Goal)
- ;
- maybe_write_string(VeryVerbose, "% No cells to be cached.\n", !IO)
).
:- pred check_for_cell_caching_2(dead_cell_table::in,
@@ -1419,8 +1413,8 @@
GoalInfo = GoalInfo0
;
GoalExpr0 = shorthand(_),
- unexpected(choose_reuse.this_file, "check_cc: " ++
- "shorthand goal.")
+ % These should have been expanded out by now.
+ unexpected(choose_reuse.this_file, "check_cc: shorthand.")
),
!:Goal = hlds_goal(GoalExpr, GoalInfo).
Index: compiler/structure_reuse.direct.detect_garbage.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/structure_reuse.direct.detect_garbage.m,v
retrieving revision 1.13
diff -u -b -r1.13 structure_reuse.direct.detect_garbage.m
--- compiler/structure_reuse.direct.detect_garbage.m 20 Feb 2008 02:34:49 -0000 1.13
+++ compiler/structure_reuse.direct.detect_garbage.m 20 Feb 2008 03:13:13 -0000
@@ -158,6 +158,7 @@
!.SharingAs)
;
GoalExpr = shorthand(_),
+ % These should have been expanded out by now.
unexpected(detect_garbage.this_file,
"determine_dead_deconstructions_2: shorthand goal.")
).
Index: compiler/structure_reuse.indirect.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/structure_reuse.indirect.m,v
retrieving revision 1.16
diff -u -b -r1.16 structure_reuse.indirect.m
--- compiler/structure_reuse.indirect.m 20 Feb 2008 02:34:49 -0000 1.16
+++ compiler/structure_reuse.indirect.m 20 Feb 2008 03:13:13 -0000
@@ -387,7 +387,8 @@
!.AnalysisInfo ^ sharing_as)
;
GoalExpr0 = shorthand(_),
- unexpected(this_file, "indirect_reuse_analyse_goal: shorthand goal.")
+ % These should have been expanded out by now.
+ unexpected(this_file, "indirect_reuse_analyse_goal: shorthand")
).
:- pred indirect_reuse_analyse_goal_with_progress(ir_background_info::in,
Index: compiler/structure_reuse.lbu.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/structure_reuse.lbu.m,v
retrieving revision 1.10
diff -u -b -r1.10 structure_reuse.lbu.m
--- compiler/structure_reuse.lbu.m 30 Dec 2007 08:23:57 -0000 1.10
+++ compiler/structure_reuse.lbu.m 6 Jan 2008 10:02:24 -0000
@@ -163,7 +163,8 @@
!:Expr = if_then_else(Vars, Cond, Then, Else)
;
!.Expr = shorthand(_),
- unexpected(this_file, "backward_use_in_goal_2: shorthand goal.")
+ % These should have been expanded out by now.
+ unexpected(this_file, "backward_use_in_goal_2: shorthand")
).
:- func get_backtrack_vars(vartypes, hlds_goal_info) = set(prog_var).
Index: compiler/structure_reuse.lfu.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/structure_reuse.lfu.m,v
retrieving revision 1.9
diff -u -b -r1.9 structure_reuse.lfu.m
--- compiler/structure_reuse.lfu.m 15 Jan 2008 00:01:21 -0000 1.9
+++ compiler/structure_reuse.lfu.m 19 Jan 2008 07:30:41 -0000
@@ -67,7 +67,9 @@
forward_use_in_goal(VarTypes, !Goal, !InstantiatedVars, !DeadVars) :-
!.Goal = hlds_goal(GoalExpr0, GoalInfo0),
- ( goal_is_atomic(GoalExpr0) ->
+ HasSubGoals = goal_expr_has_subgoals(GoalExpr0),
+ (
+ HasSubGoals = does_not_have_subgoals,
InstantiatedVars0 = !.InstantiatedVars,
compute_instantiated_and_dead_vars(VarTypes, GoalInfo0,
!InstantiatedVars, !DeadVars),
@@ -75,6 +77,7 @@
goal_info_set_lfu(LFU, GoalInfo0, GoalInfo),
!:Goal = hlds_goal(GoalExpr0, GoalInfo)
;
+ HasSubGoals = has_subgoals,
goal_info_get_pre_deaths(GoalInfo0, PreDeaths),
set.union(PreDeaths, !DeadVars),
forward_use_in_composite_goal(VarTypes, !Goal,
Index: compiler/structure_reuse.versions.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/structure_reuse.versions.m,v
retrieving revision 1.11
diff -u -b -r1.11 structure_reuse.versions.m
--- compiler/structure_reuse.versions.m 20 Feb 2008 02:34:49 -0000 1.11
+++ compiler/structure_reuse.versions.m 20 Feb 2008 03:13:14 -0000
@@ -188,9 +188,8 @@
% requantify. Then we recompute instmap deltas with the updated
% non-local sets.
requantify_proc(!ProcInfo),
- RecomputeAtomic = no,
- recompute_instmap_delta_proc(RecomputeAtomic, !ProcInfo, !ModuleInfo),
-
+ recompute_instmap_delta_proc(do_not_recompute_atomic_instmap_deltas,
+ !ProcInfo, !ModuleInfo),
module_info_set_pred_proc_info(PPId, PredInfo0, !.ProcInfo,
!ModuleInfo)
).
@@ -287,6 +286,7 @@
_Args, _ExtraArgs, _MaybeTraceRuntimeCond, _Impl)
;
GoalExpr0 = shorthand(_),
+ % These should have been expanded out by now.
unexpected(this_file, "process_goal: shorthand goal.")
).
Index: compiler/structure_sharing.analysis.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/structure_sharing.analysis.m,v
retrieving revision 1.29
diff -u -b -r1.29 structure_sharing.analysis.m
--- compiler/structure_sharing.analysis.m 20 Feb 2008 02:34:49 -0000 1.29
+++ compiler/structure_sharing.analysis.m 20 Feb 2008 03:13:14 -0000
@@ -432,7 +432,8 @@
!.SharingAs)
;
GoalExpr = shorthand(_),
- unexpected(this_file, "analyse_goal: shorthand goal.")
+ % These should have been expanded out by now.
+ unexpected(this_file, "analyse_goal: shorthand.")
).
:- pred analyse_goal_with_progress(module_info::in, pred_info::in,
Index: compiler/superhomogeneous.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/superhomogeneous.m,v
retrieving revision 1.28
diff -u -b -r1.28 superhomogeneous.m
--- compiler/superhomogeneous.m 29 Jan 2008 01:49:12 -0000 1.28
+++ compiler/superhomogeneous.m 29 Jan 2008 02:00:10 -0000
@@ -854,7 +854,7 @@
% capturing any variables of the same name that occur outside this scope.
%
% Also, note that any introduced unifications that construct the output
- % arguments for the lambda expression, need to occur *after*, the body
+ % arguments for the lambda expression, need to occur *after* the body
% of the lambda expression. This is in case the body of the lambda
% expression is impure, in which case the mode analyser cannot reorder
% the unifications; this results in a mode error.
@@ -889,11 +889,10 @@
list.length(Args, NumArgs),
svvarset.new_vars(NumArgs, LambdaVars, !VarSet),
- %
+
% Partition the arguments (and their corresponding lambda variables)
% into two sets: those that are not output, i.e. input and unused,
% and those that are output.
- %
(
partition_args_and_lambda_vars(!.ModuleInfo, Args, LambdaVars,
Modes, NonOutputArgs0, OutputArgs0, NonOutputLambdaVars0,
@@ -911,17 +910,16 @@
map.init(Substitution),
ArgContext = ac_head(PredOrFunc, NumArgs),
- % Create the unifications that need to come before the body of
- % the lambda expression; those corresponding to args whose mode
- % is input or unused.
+ % Create the unifications that need to come before the body of the
+ % lambda expression; those corresponding to args whose mode is input
+ % or unused.
HeadBefore0 = true_goal,
insert_arg_unifications(NonOutputLambdaVars, NonOutputArgs,
Context, ArgContext, HeadBefore0, HeadBefore, NonOutputAdded,
!VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
- % Create the unifications that need to come after the body of
- % the lambda expression; those corresponding to args whose mode
- % is output.
+ % Create the unifications that need to come after the body of the
+ % lambda expression; those corresponding to args whose mode is output.
HeadAfter0 = true_goal,
insert_arg_unifications(OutputLambdaVars, OutputArgs,
Context, ArgContext, HeadAfter0, HeadAfter, OutputAdded,
@@ -997,8 +995,7 @@
OutputArgs = OutputArgs0,
InputLambdaVars = [LambdaVar | InputLambdaVars0],
OutputLambdaVars = OutputLambdaVars0
- ;
- ( mode_is_output(ModuleInfo, Mode) ->
+ ; mode_is_output(ModuleInfo, Mode) ->
InputArgs = InputArgs0,
OutputArgs = [Arg | OutputArgs0],
InputLambdaVars = InputLambdaVars0,
@@ -1008,7 +1005,6 @@
OutputArgs = OutputArgs0,
InputLambdaVars = [LambdaVar | InputLambdaVars0],
OutputLambdaVars = OutputLambdaVars0
- )
).
%-----------------------------------------------------------------------------%
@@ -1028,19 +1024,25 @@
:- pred arg_context_to_unify_context(arg_context::in, int::in,
unify_main_context::out, unify_sub_contexts::out) is det.
-arg_context_to_unify_context(ac_head(PredOrFunc, Arity), ArgNum,
- ArgContext, []) :-
+arg_context_to_unify_context(ArgContext, ArgNum, MainContext, SubContexts) :-
+ (
+ ArgContext = ac_head(PredOrFunc, Arity),
( PredOrFunc = pf_function, ArgNum = Arity ->
% It's the function result term in the head.
- ArgContext = umc_head_result
+ MainContext = umc_head_result
;
% It's a head argument.
- ArgContext = umc_head(ArgNum)
+ MainContext = umc_head(ArgNum)
+ ),
+ SubContexts = []
+ ;
+ ArgContext = ac_call(PredId),
+ MainContext = umc_call(PredId, ArgNum),
+ SubContexts = []
+ ;
+ ArgContext = ac_functor(ConsId, MainContext, SubContexts0),
+ SubContexts = [ConsId - ArgNum | SubContexts0]
).
-arg_context_to_unify_context(ac_call(PredId), ArgNum,
- umc_call(PredId, ArgNum), []).
-arg_context_to_unify_context(ac_functor(ConsId, MainContext, SubContexts),
- ArgNum, MainContext, [ConsId - ArgNum | SubContexts]).
%-----------------------------------------------------------------------------%
Index: compiler/switch_detection.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/switch_detection.m,v
retrieving revision 1.139
diff -u -b -r1.139 switch_detection.m
--- compiler/switch_detection.m 22 Jan 2008 15:06:17 -0000 1.139
+++ compiler/switch_detection.m 25 Jan 2008 05:52:13 -0000
@@ -180,14 +180,14 @@
proc_info_get_vartypes(ProcInfo0, VarTypes),
proc_info_get_initial_instmap(ProcInfo0, !.ModuleInfo, InstMap0),
detect_switches_in_goal(VarTypes, AllowMulti, InstMap0,
- Goal0, Goal, !ModuleInfo, dont_need_to_requantify, Requant),
+ Goal0, Goal, !ModuleInfo, do_not_need_to_requantify, Requant),
proc_info_set_goal(Goal, ProcInfo0, ProcInfo1),
(
Requant = need_to_requantify,
requantify_proc(ProcInfo1, ProcInfo)
;
- Requant = dont_need_to_requantify,
+ Requant = do_not_need_to_requantify,
ProcInfo = ProcInfo1
),
map.det_update(ProcTable0, ProcId, ProcInfo, ProcTable),
@@ -197,10 +197,6 @@
%-----------------------------------------------------------------------------%
-:- type need_to_requantify
- ---> dont_need_to_requantify
- ; need_to_requantify.
-
% Given a goal, and the instmap on entry to that goal,
% replace disjunctions with switches whereever possible.
%
@@ -306,9 +302,22 @@
),
GoalExpr = GoalExpr0
;
- GoalExpr0 = shorthand(_),
+ GoalExpr0 = shorthand(ShortHand0),
+ (
+ ShortHand0 = atomic_goal(GoalType, Outer, Inner, MaybeOutputVars,
+ MainGoal0, OrElseGoals0),
+ detect_switches_in_goal(VarTypes, AllowMulti, InstMap0,
+ MainGoal0, MainGoal, !ModuleInfo, !Requant),
+ detect_switches_in_orelse(VarTypes, AllowMulti, InstMap0,
+ OrElseGoals0, OrElseGoals, !ModuleInfo, !Requant),
+ ShortHand = atomic_goal(GoalType, Outer, Inner, MaybeOutputVars,
+ MainGoal, OrElseGoals),
+ GoalExpr = shorthand(ShortHand)
+ ;
+ ShortHand0 = bi_implication(_, _),
% These should have been expanded out by now.
- unexpected(this_file, "detect_switches_in_goal_2: shorthand")
+ unexpected(this_file, "detect_switches_in_goal_2: bi_implication")
+ )
).
%-----------------------------------------------------------------------------%
@@ -628,6 +637,19 @@
detect_switches_in_conj(VarTypes, AllowMulti,
InstMap1, Goals0, Goals, !ModuleInfo, !Requant).
+:- pred detect_switches_in_orelse(vartypes::in, allow_multi_arm::in,
+ instmap::in, list(hlds_goal)::in, list(hlds_goal)::out,
+ module_info::in, module_info::out,
+ need_to_requantify::in, need_to_requantify::out) is det.
+
+detect_switches_in_orelse(_, _, _, [], [], !ModuleInfo, !Requant).
+detect_switches_in_orelse(VarTypes, AllowMulti, InstMap,
+ [Goal0 | Goals0], [Goal | Goals], !ModuleInfo, !Requant) :-
+ detect_switches_in_goal(VarTypes, AllowMulti, InstMap, Goal0, Goal,
+ !ModuleInfo, !Requant),
+ detect_switches_in_orelse(VarTypes, AllowMulti, InstMap, Goals0, Goals,
+ !ModuleInfo, !Requant).
+
%-----------------------------------------------------------------------------%
% partition_disj(AllowMulti, Disjuncts, Var, GoalInfo, VarTypes,
@@ -925,8 +947,15 @@
FoundDeconstruct = given_up_search
)
;
- GoalExpr0 = shorthand(_),
- unexpected(this_file, "find_bind_var_2: shorthand")
+ GoalExpr0 = shorthand(ShortHand0),
+ (
+ ShortHand0 = atomic_goal(_, _, _, _, _, _),
+ Goal = Goal0,
+ FoundDeconstruct = given_up_search
+ ;
+ ShortHand0 = bi_implication(_, _),
+ unexpected(this_file, "find_bind_var_2: bi_implication")
+ )
).
:- pred conj_find_bind_var(prog_var::in,
Index: compiler/table_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/table_gen.m,v
retrieving revision 1.145
diff -u -b -r1.145 table_gen.m
--- compiler/table_gen.m 11 Feb 2008 21:26:09 -0000 1.145
+++ compiler/table_gen.m 12 Feb 2008 01:22:21 -0000
@@ -552,8 +552,8 @@
% Some of the instmap_deltas generated in this module are pretty dodgy
% (especially those for if-then-elses), so recompute them here.
% XXX Fix this: generate correct-by-construction instmap_deltas.
- RecomputeAtomic = no,
- recompute_instmap_delta_proc(RecomputeAtomic, !ProcInfo, !ModuleInfo),
+ recompute_instmap_delta_proc(do_not_recompute_atomic_instmap_deltas,
+ !ProcInfo, !ModuleInfo),
pred_info_get_procedures(!.PredInfo, ProcTable1),
map.det_update(ProcTable1, ProcId, !.ProcInfo, ProcTable),
Index: compiler/term_constr_build.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/term_constr_build.m,v
retrieving revision 1.20
diff -u -b -r1.20 term_constr_build.m
--- compiler/term_constr_build.m 21 Jan 2008 00:32:54 -0000 1.20
+++ compiler/term_constr_build.m 21 Jan 2008 00:44:49 -0000
@@ -484,11 +484,9 @@
AbstractGoal = term_primitive(polyhedron.universe, [], []),
info_update_ho_info(Context, !Info).
- % shorthand/1 goals ought to have been transformed away by
- % the time we get round to termination analysis.
- %
build_abstract_goal_2(shorthand(_), _, _, _, _) :-
- unexpected(this_file, "shorthand/1 goal during termination analysis.").
+ % These should have been expanded out by now.
+ unexpected(this_file, "build_abstract_goal_2: shorthand").
%------------------------------------------------------------------------------%
%
Index: compiler/transform_hlds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/transform_hlds.m,v
retrieving revision 1.28
diff -u -b -r1.28 transform_hlds.m
--- compiler/transform_hlds.m 3 Oct 2007 23:48:16 -0000 1.28
+++ compiler/transform_hlds.m 14 Oct 2007 11:06:40 -0000
@@ -32,6 +32,7 @@
:- include_module complexity.
:- include_module (lambda).
+:- include_module stm_expand.
:- include_module closure_analysis.
Index: compiler/tupling.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/tupling.m,v
retrieving revision 1.44
diff -u -b -r1.44 tupling.m
--- compiler/tupling.m 29 Jan 2008 04:59:44 -0000 1.44
+++ compiler/tupling.m 29 Jan 2008 05:00:21 -0000
@@ -638,7 +638,8 @@
% Make a transformed version of the procedure and add it to
% the module.
make_transformed_proc(CellVar, FieldVars, InsertMap, !ProcInfo),
- recompute_instmap_delta_proc(yes, !ProcInfo, !ModuleInfo),
+ recompute_instmap_delta_proc(recompute_atomic_instmap_deltas,
+ !ProcInfo, !ModuleInfo),
counter.allocate(Num, !Counter),
create_aux_pred(PredId, ProcId, PredInfo, !.ProcInfo, Num,
AuxPredProcId, CallAux, !ModuleInfo),
@@ -1153,8 +1154,9 @@
).
count_load_stores_in_goal_expr(shorthand(_), _, _, !_) :-
+ % These should have been expanded out by now.
unexpected(this_file,
- "count_load_stores_in_goal_expr: unexpected shorthand").
+ "count_load_stores_in_goal_expr: shorthand").
%-----------------------------------------------------------------------------%
@@ -1680,7 +1682,8 @@
proc_info_set_vartypes(VarTypes, !ProcInfo),
proc_info_set_rtti_varmaps(RttiVarMaps, !ProcInfo),
requantify_proc(!ProcInfo),
- recompute_instmap_delta_proc(yes, !ProcInfo, !ModuleInfo),
+ recompute_instmap_delta_proc(recompute_atomic_instmap_deltas,
+ !ProcInfo, !ModuleInfo),
module_info_set_pred_proc_info(PredId, ProcId,
PredInfo, !.ProcInfo, !ModuleInfo)
)
@@ -1784,7 +1787,8 @@
Goal = hlds_goal(GoalExpr, GoalInfo0)
;
GoalExpr0 = shorthand(_),
- unexpected(this_file, "fix_calls_in_goal: unexpected shorthand")
+ % These should have been expanded out by now.
+ unexpected(this_file, "fix_calls_in_goal: shorthand")
).
%-----------------------------------------------------------------------------%
Index: compiler/typecheck.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/typecheck.m,v
retrieving revision 1.428
diff -u -b -r1.428 typecheck.m
--- compiler/typecheck.m 22 Jan 2008 15:06:17 -0000 1.428
+++ compiler/typecheck.m 25 Jan 2008 05:52:13 -0000
@@ -479,10 +479,10 @@
;
IsFieldAccessFunction = no
),
- pred_info_get_markers(!.PredInfo, PredMarkers),
+ pred_info_get_markers(!.PredInfo, PredMarkers0),
typecheck_info_init(!.ModuleInfo, PredId, IsFieldAccessFunction,
TypeVarSet0, VarSet, ExplicitVarTypes0, !.HeadTypeParams,
- Constraints, Status, PredMarkers, StartingSpecs, !:Info),
+ Constraints, Status, PredMarkers0, StartingSpecs, !:Info),
get_clause_list(ClausesRep1, Clauses1),
typecheck_clause_list(HeadVars, ArgTypes0, Clauses1, Clauses,
!Info),
@@ -495,6 +495,7 @@
!:HeadTypeParams, InferredVarTypes0,
InferredTypeConstraints0, ConstraintProofs,
ConstraintMap, TVarRenaming, ExistTypeRenaming),
+ typecheck_info_get_pred_markers(!.Info, PredMarkers),
map.optimize(InferredVarTypes0, InferredVarTypes),
clauses_info_set_vartypes(InferredVarTypes, !ClausesInfo),
@@ -516,6 +517,7 @@
pred_info_set_typevarset(TypeVarSet, !PredInfo),
pred_info_set_constraint_proofs(ConstraintProofs, !PredInfo),
pred_info_set_constraint_map(ConstraintMap, !PredInfo),
+ pred_info_set_markers(PredMarkers, !PredInfo),
% Split the inferred type class constraints into those that
% apply only to the head variables, and those that apply to
@@ -1232,22 +1234,51 @@
perform_context_reduction(!Info),
GoalExpr = GoalExpr0
;
- GoalExpr0 = shorthand(ShorthandGoal0),
- typecheck_goal_2_shorthand(ShorthandGoal0, ShorthandGoal, !Info),
- GoalExpr = shorthand(ShorthandGoal)
- ).
-
-:- pred typecheck_goal_2_shorthand(shorthand_goal_expr::in,
- shorthand_goal_expr::out,
- typecheck_info::in, typecheck_info::out) is det.
-
-typecheck_goal_2_shorthand(bi_implication(LHS0, RHS0),
- bi_implication(LHS, RHS), !Info) :-
+ GoalExpr0 = shorthand(ShortHand0),
+ (
+ ShortHand0 = bi_implication(LHS0, RHS0),
trace [io(!IO)] (
type_checkpoint("<=>", !.Info, !IO)
),
typecheck_goal(LHS0, LHS, !Info),
- typecheck_goal(RHS0, RHS, !Info).
+ typecheck_goal(RHS0, RHS, !Info),
+ ShortHand = bi_implication(LHS, RHS)
+ ;
+ ShortHand0 = atomic_goal(GoalType, Outer, Inner, MaybeOutputVars,
+ MainGoal0, OrElseGoals0),
+ trace [io(!IO)] (
+ type_checkpoint("atomic_goal", !.Info, !IO)
+ ),
+ (
+ MaybeOutputVars = yes(OutputVars),
+ ensure_vars_have_a_type(OutputVars, !Info)
+ ;
+ MaybeOutputVars = no
+ ),
+
+ typecheck_goal(MainGoal0, MainGoal, !Info),
+ typecheck_goal_list(OrElseGoals0, OrElseGoals, !Info),
+
+ Outer = atomic_interface_vars(OuterDI, OuterUO),
+ Inner = atomic_interface_vars(InnerDI, InnerUO),
+ ensure_vars_have_a_type([OuterDI, OuterUO, InnerDI, InnerUO],
+ !Info),
+
+ % The outer variables must either be both I/O states of STM states.
+ % Checking that here could double the number of type assign sets.
+ % We therefore delay the check until after we have typechecked
+ % the predicate body, in post_typecheck. The code in the
+ % post_typecheck pass (actually in purity.m) will do this
+ % if the GoalType is unknown_atomic_goal_type.
+ typecheck_var_has_type(InnerDI, stm_atomic_type, !Info),
+ typecheck_var_has_type(InnerUO, stm_atomic_type, !Info),
+ expect(unify(GoalType, unknown_atomic_goal_type), this_file,
+ "typecheck_goal_2: GoalType != unknown_atomic_goal_type"),
+ ShortHand = atomic_goal(GoalType, Outer, Inner, MaybeOutputVars,
+ MainGoal, OrElseGoals)
+ ),
+ GoalExpr = shorthand(ShortHand)
+ ).
%-----------------------------------------------------------------------------%
@@ -1642,6 +1673,33 @@
unexpected(this_file, "arg_type_assign_var_has_type")
).
+:- pred type_assign_var_has_one_of_these_types(type_assign::in,
+ prog_var::in, mer_type::in, mer_type::in, type_assign_set::in,
+ type_assign_set::out) is det.
+
+type_assign_var_has_one_of_these_types(TypeAssign0, Var, TypeA, TypeB,
+ !TypeAssignSet) :-
+ type_assign_get_var_types(TypeAssign0, VarTypes0),
+ ( map.search(VarTypes0, Var, VarType) ->
+ ( type_assign_unify_type(TypeAssign0, VarType, TypeA, TypeAssignA) ->
+ !:TypeAssignSet = [TypeAssignA | !.TypeAssignSet]
+ ;
+ !:TypeAssignSet = !.TypeAssignSet
+ ),
+ ( type_assign_unify_type(TypeAssign0, VarType, TypeB, TypeAssignB) ->
+ !:TypeAssignSet = [TypeAssignB | !.TypeAssignSet]
+ ;
+ !:TypeAssignSet = !.TypeAssignSet
+ )
+ ;
+ % YYY
+ map.det_insert(VarTypes0, Var, TypeA, VarTypesA),
+ type_assign_set_var_types(VarTypesA, TypeAssign0, TypeAssignA),
+ map.det_insert(VarTypes0, Var, TypeB, VarTypesB),
+ type_assign_set_var_types(VarTypesB, TypeAssign0, TypeAssignB),
+ !: TypeAssignSet = [TypeAssignA, TypeAssignB | !.TypeAssignSet]
+ ).
+
%-----------------------------------------------------------------------------%
% Given a list of variables and a list of types, ensure
Index: compiler/typecheck_errors.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/typecheck_errors.m,v
retrieving revision 1.40
diff -u -b -r1.40 typecheck_errors.m
--- compiler/typecheck_errors.m 23 Nov 2007 07:35:31 -0000 1.40
+++ compiler/typecheck_errors.m 27 Dec 2007 07:54:53 -0000
@@ -72,6 +72,9 @@
:- func report_error_var(typecheck_info, prog_var, mer_type, type_assign_set)
= error_spec.
+:- func report_error_var_either_type(typecheck_info, prog_var,
+ mer_type, mer_type, type_assign_set) = error_spec.
+
:- func report_error_arg_var(typecheck_info, prog_var, args_type_assign_set)
= error_spec.
@@ -886,6 +889,60 @@
%-----------------------------------------------------------------------------%
+report_error_var_either_type(Info, Var, TypeA, TypeB, TypeAssignSet0) = Spec :-
+ typecheck_info_get_pred_markers(Info, PredMarkers),
+ typecheck_info_get_called_predid(Info, CalledPredId),
+ ArgNum = Info ^ tc_info_arg_num,
+ Context = Info ^ tc_info_context,
+ UnifyContext = Info ^ tc_info_unify_context,
+ get_type_stuff(TypeAssignSet0, Var, TypeStuffList),
+ typecheck_info_get_varset(Info, VarSet),
+
+ InClauseForPieces = in_clause_for_pieces(Info),
+ CallContextPieces = call_context_to_pieces(PredMarkers, CalledPredId,
+ ArgNum, UnifyContext),
+
+ ActualExpectedListA0 = list.map(type_stuff_to_actual_expected(TypeA),
+ TypeStuffList),
+ ActualExpectedListB0 = list.map(type_stuff_to_actual_expected(TypeB),
+ TypeStuffList),
+ list.sort_and_remove_dups(ActualExpectedListA0, ActualExpectedListA),
+ list.sort_and_remove_dups(ActualExpectedListB0, ActualExpectedListB),
+
+ Pieces1 = [words("type error:")],
+ (
+ ActualExpectedListA = [ActualExpectedA],
+ ActualExpectedListB = [ActualExpectedB]
+ ->
+ ActualExpectedA = actual_expected_types(ActualPieces, ExpectedPiecesA),
+ ActualExpectedB = actual_expected_types(_, ExpectedPiecesB),
+ Pieces2 = argument_name_to_pieces(VarSet, Var) ++
+ [words("has type"), prefix("`")] ++ ActualPieces ++
+ [suffix("'"), suffix(","), nl,
+ words("expected type was either"), prefix("`")] ++
+ ExpectedPiecesA ++ [suffix("'"), words("or"), prefix("`")] ++
+ ExpectedPiecesB ++ [suffix("'"), suffix("."), nl]
+ ;
+ Pieces2 = [words("type of")] ++
+ argument_name_to_pieces(VarSet, Var) ++
+ [words("does not match its expected type;"), nl] ++
+ argument_name_to_pieces(VarSet, Var) ++
+ [words("has overloaded actual/expected types {"), nl] ++
+ actual_expected_types_list_to_pieces(ActualExpectedListA) ++
+ [nl, fixed("} or {."), nl] ++
+ actual_expected_types_list_to_pieces(ActualExpectedListB) ++
+ [nl, fixed("}."), nl]
+ ),
+
+ VerbosePieces = type_assign_set_msg_to_pieces(TypeAssignSet0, VarSet),
+ Msg = simple_msg(Context,
+ [always(InClauseForPieces ++ CallContextPieces),
+ always(Pieces1 ++ Pieces2),
+ verbose_only(VerbosePieces)]),
+ Spec = error_spec(severity_error, phase_type_check, [Msg]).
+
+%-----------------------------------------------------------------------------%
+
report_error_arg_var(Info, Var, ArgTypeAssignSet0) = Spec :-
typecheck_info_get_pred_markers(Info, PredMarkers),
typecheck_info_get_called_predid(Info, CalledPredId),
Index: compiler/typecheck_info.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/typecheck_info.m,v
retrieving revision 1.23
diff -u -b -r1.23 typecheck_info.m
--- compiler/typecheck_info.m 14 May 2007 08:20:12 -0000 1.23
+++ compiler/typecheck_info.m 11 Jan 2008 19:56:06 -0000
@@ -216,6 +216,9 @@
:- pred typecheck_info_get_all_errors(typecheck_info::in,
list(error_spec)::out) is det.
+:- pred typecheck_info_add_pred_marker(marker::in,
+ typecheck_info::in, typecheck_info::out) is det.
+
%-----------------------------------------------------------------------------%
%
% The type_assign and type_assign_set data structures.
@@ -664,6 +667,11 @@
Errors = [OverloadError | Errors0]
).
+typecheck_info_add_pred_marker(Marker, !Info) :-
+ Markers0 = !.Info ^ tc_info_sub_info ^ tc_sub_info_pred_markers,
+ add_marker(Marker, Markers0, Markers),
+ !:Info = !.Info ^ tc_info_sub_info ^ tc_sub_info_pred_markers := Markers.
+
%-----------------------------------------------------------------------------%
type_assign_get_var_types(TA, TA ^ var_types).
Index: compiler/unique_modes.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unique_modes.m,v
retrieving revision 1.126
diff -u -b -r1.126 unique_modes.m
--- compiler/unique_modes.m 22 Jan 2008 15:06:18 -0000 1.126
+++ compiler/unique_modes.m 25 Jan 2008 05:52:13 -0000
@@ -258,34 +258,104 @@
true
).
+%-----------------------------------------------------------------------------%
+
:- pred unique_modes_check_goal_expr(hlds_goal_expr::in, hlds_goal_info::in,
- hlds_goal_expr::out, mode_info::in, mode_info::out,
- io::di, io::uo) is det.
+ hlds_goal_expr::out, mode_info::in, mode_info::out, io::di, io::uo) is det.
+
+unique_modes_check_goal_expr(GoalExpr0, GoalInfo0, GoalExpr, !ModeInfo, !IO) :-
+ % XXX The predicates we call here should have their definitions
+ % in the same order as this switch.
+ (
+ GoalExpr0 = unify(LHS0, RHS0, _UniModes0, Unification0, UnifyContext0),
+ unique_modes_check_goal_unify(LHS0, RHS0, Unification0, UnifyContext0,
+ GoalInfo0, GoalExpr, !ModeInfo, !IO)
+ ;
+ GoalExpr0 = plain_call(PredId0, ProcId0, ArgVars0, Builtin0,
+ MaybeUnifyContext0, SymName0),
+ unique_modes_check_goal_plain_call(PredId0, ProcId0, ArgVars0,
+ Builtin0, MaybeUnifyContext0, SymName0, GoalInfo0, GoalExpr,
+ !ModeInfo, !IO)
+ ;
+ GoalExpr0 = generic_call(GenericCall0, ArgVars0, ArgModes0, Detism0),
+ unique_modes_check_goal_generic_call(GenericCall0, ArgVars0, ArgModes0,
+ Detism0, GoalExpr, !ModeInfo, !IO)
+ ;
+ GoalExpr0 = call_foreign_proc(Attributes0, PredId0, ProcId0,
+ Args0, ExtraArgs0, MaybeTraceRuntimeCond0, PragmaCode0),
+ unique_modes_check_goal_call_foreign_proc(Attributes0,
+ PredId0, ProcId0, Args0, ExtraArgs0, MaybeTraceRuntimeCond0,
+ PragmaCode0, GoalInfo0, GoalExpr, !ModeInfo, !IO)
+ ;
+ GoalExpr0 = conj(GoalType0, Goals0),
+ unique_modes_check_goal_conj(GoalType0, Goals0, GoalExpr,
+ !ModeInfo, !IO)
+ ;
+ GoalExpr0 = disj(Goals0),
+ unique_modes_check_goal_disj(Goals0, GoalInfo0, GoalExpr,
+ !ModeInfo, !IO)
+ ;
+ GoalExpr0 = switch(Var0, CanFail0, Cases0),
+ unique_modes_check_goal_switch(Var0, CanFail0, Cases0, GoalInfo0,
+ GoalExpr, !ModeInfo, !IO)
+ ;
+ GoalExpr0 = if_then_else(Vars0, Cond0, Then0, Else0),
+ unique_modes_check_goal_if_then_else(Vars0, Cond0, Then0, Else0,
+ GoalInfo0, GoalExpr, !ModeInfo, !IO)
+ ;
+ GoalExpr0 = negation(SubGoal0),
+ unique_modes_check_goal_negation(SubGoal0, GoalInfo0, GoalExpr,
+ !ModeInfo, !IO)
+ ;
+ GoalExpr0 = scope(Reason0, SubGoal0),
+ unique_modes_check_goal_scope(Reason0, SubGoal0, GoalExpr,
+ !ModeInfo, !IO)
+ ;
+ GoalExpr0 = shorthand(ShortHand0),
+ (
+ ShortHand0 = atomic_goal(GoalType, Outer, Inner, MaybeOutputVars,
+ MainGoal0, OrElseGoals0),
+ unique_modes_check_goal_atomic_goal(GoalType, Outer, Inner,
+ MaybeOutputVars, MainGoal0, OrElseGoals0, GoalInfo0, GoalExpr,
+ !ModeInfo, !IO)
+ ;
+ ShortHand0 = bi_implication(_, _),
+ % These should have been expanded out by now.
+ unexpected(this_file,
+ "unique_modes_check_goal_expr: bi_implication")
+ )
+ ).
+
+:- pred unique_modes_check_goal_conj(conj_type::in, list(hlds_goal)::in,
+ hlds_goal_expr::out, mode_info::in, mode_info::out, io::di, io::uo) is det.
-unique_modes_check_goal_expr(conj(ConjType, List0), _GoalInfo0,
- conj(ConjType, List), !ModeInfo, !IO) :-
+unique_modes_check_goal_conj(ConjType, Goals0, GoalExpr, !ModeInfo, !IO) :-
mode_checkpoint(enter, "*conj", !ModeInfo, !IO),
(
- List0 = [],
+ Goals0 = [],
% For efficiency, optimize common case.
- List = []
+ Goals = []
;
- List0 = [_ | _],
- mode_info_add_goals_live_vars(ConjType, List0, !ModeInfo),
- unique_modes_check_conj(ConjType, List0, List, !ModeInfo, !IO)
+ Goals0 = [_ | _],
+ mode_info_add_goals_live_vars(ConjType, Goals0, !ModeInfo),
+ unique_modes_check_conj(ConjType, Goals0, Goals, !ModeInfo, !IO)
),
+ GoalExpr = conj(ConjType, Goals),
mode_checkpoint(exit, "*conj", !ModeInfo, !IO).
-unique_modes_check_goal_expr(disj(List0), GoalInfo0, disj(List), !ModeInfo,
- !IO) :-
+:- pred unique_modes_check_goal_disj(list(hlds_goal)::in,
+ hlds_goal_info::in, hlds_goal_expr::out,
+ mode_info::in, mode_info::out, io::di, io::uo) is det.
+
+unique_modes_check_goal_disj(Goals0, GoalInfo0, GoalExpr, !ModeInfo, !IO) :-
mode_checkpoint(enter, "disj", !ModeInfo, !IO),
(
- List0 = [],
- List = [],
+ Goals0 = [],
+ Goals = [],
instmap.init_unreachable(InstMap),
mode_info_set_instmap(InstMap, !ModeInfo)
;
- List0 = [_ | _],
+ Goals0 = [_ | _],
% If the disjunction creates a choice point (i.e. is model_non), then
% mark all the variables which are live at the start of the disjunction
% and whose inst is `unique' as instead being only `mostly_unique',
@@ -309,19 +379,25 @@
% Now just modecheck each disjunct in turn, and then
% merge the resulting instmaps.
- unique_modes_check_disj(List0, Determinism, NonLocals, List,
- InstMapList, !ModeInfo, !IO),
- instmap_merge(NonLocals, InstMapList, disj, !ModeInfo)
+ unique_modes_check_disj(Goals0, Determinism, NonLocals, Goals,
+ InstMaps, !ModeInfo, !IO),
+ instmap_merge(NonLocals, InstMaps, merge_disj, !ModeInfo)
),
+ GoalExpr = disj(Goals),
mode_checkpoint(exit, "disj", !ModeInfo, !IO).
-unique_modes_check_goal_expr(if_then_else(Vars, Cond0, Then0, Else0), GoalInfo0,
- Goal, !ModeInfo, !IO) :-
+:- pred unique_modes_check_goal_if_then_else(list(prog_var)::in,
+ hlds_goal::in, hlds_goal::in, hlds_goal::in,
+ hlds_goal_info::in, hlds_goal_expr::out,
+ mode_info::in, mode_info::out, io::di, io::uo) is det.
+
+unique_modes_check_goal_if_then_else(Vars, Cond0, Then0, Else0, GoalInfo0,
+ GoalExpr, !ModeInfo, !IO) :-
mode_checkpoint(enter, "if-then-else", !ModeInfo, !IO),
NonLocals = goal_info_get_nonlocals(GoalInfo0),
- Cond_Vars = goal_get_nonlocals(Cond0),
- Then_Vars = goal_get_nonlocals(Then0),
- Else_Vars = goal_get_nonlocals(Else0),
+ CondVars = goal_get_nonlocals(Cond0),
+ ThenVars = goal_get_nonlocals(Then0),
+ ElseVars = goal_get_nonlocals(Else0),
mode_info_get_instmap(!.ModeInfo, InstMap0),
mode_info_lock_vars(var_lock_if_then_else, NonLocals, !ModeInfo),
@@ -349,19 +425,19 @@
% use(Var)
% ).
- mode_info_add_live_vars(Else_Vars, !ModeInfo),
- set.to_sorted_list(Cond_Vars, Cond_Vars_List),
- select_live_vars(Cond_Vars_List, !.ModeInfo, Cond_Live_Vars),
- Cond0 = hlds_goal(_, Cond0_GoalInfo),
- Cond0_DeltaInstMap = goal_info_get_instmap_delta(Cond0_GoalInfo),
- select_changed_inst_vars(Cond_Live_Vars, Cond0_DeltaInstMap, !.ModeInfo,
+ mode_info_add_live_vars(ElseVars, !ModeInfo),
+ set.to_sorted_list(CondVars, CondVarList),
+ select_live_vars(CondVarList, !.ModeInfo, CondLiveVars),
+ Cond0 = hlds_goal(_, CondInfo0),
+ CondDeltaInstMap0 = goal_info_get_instmap_delta(CondInfo0),
+ select_changed_inst_vars(CondLiveVars, CondDeltaInstMap0, !.ModeInfo,
ChangedVars),
make_var_list_mostly_uniq(ChangedVars, !ModeInfo),
- mode_info_remove_live_vars(Else_Vars, !ModeInfo),
+ mode_info_remove_live_vars(ElseVars, !ModeInfo),
- mode_info_add_live_vars(Then_Vars, !ModeInfo),
+ mode_info_add_live_vars(ThenVars, !ModeInfo),
unique_modes_check_goal(Cond0, Cond, !ModeInfo, !IO),
- mode_info_remove_live_vars(Then_Vars, !ModeInfo),
+ mode_info_remove_live_vars(ThenVars, !ModeInfo),
mode_info_unlock_vars(var_lock_if_then_else, NonLocals, !ModeInfo),
mode_info_get_instmap(!.ModeInfo, InstMapCond),
( instmap.is_reachable(InstMapCond) ->
@@ -378,12 +454,16 @@
unique_modes_check_goal(Else0, Else, !ModeInfo, !IO),
mode_info_get_instmap(!.ModeInfo, InstMapElse),
mode_info_set_instmap(InstMap0, !ModeInfo),
- instmap_merge(NonLocals, [InstMapThen, InstMapElse], if_then_else,
+ instmap_merge(NonLocals, [InstMapThen, InstMapElse], merge_if_then_else,
!ModeInfo),
- Goal = if_then_else(Vars, Cond, Then, Else),
+ GoalExpr = if_then_else(Vars, Cond, Then, Else),
mode_checkpoint(exit, "if-then-else", !ModeInfo, !IO).
-unique_modes_check_goal_expr(negation(SubGoal0), GoalInfo0, negation(SubGoal),
+:- pred unique_modes_check_goal_negation(hlds_goal::in,
+ hlds_goal_info::in, hlds_goal_expr::out,
+ mode_info::in, mode_info::out, io::di, io::uo) is det.
+
+unique_modes_check_goal_negation(SubGoal0, GoalInfo0, GoalExpr,
!ModeInfo, !IO) :-
mode_checkpoint(enter, "not", !ModeInfo, !IO),
mode_info_get_instmap(!.ModeInfo, InstMap0),
@@ -410,10 +490,13 @@
mode_info_unlock_vars(var_lock_negation, NonLocals, !ModeInfo),
mode_info_set_live_vars(LiveVars0, !ModeInfo),
mode_info_set_instmap(InstMap0, !ModeInfo),
+ GoalExpr = negation(SubGoal),
mode_checkpoint(exit, "not", !ModeInfo, !IO).
-unique_modes_check_goal_expr(scope(Reason, SubGoal0), _, scope(Reason, SubGoal),
- !ModeInfo, !IO) :-
+:- pred unique_modes_check_goal_scope(scope_reason::in, hlds_goal::in,
+ hlds_goal_expr::out, mode_info::in, mode_info::out, io::di, io::uo) is det.
+
+unique_modes_check_goal_scope(Reason, SubGoal0, GoalExpr, !ModeInfo, !IO) :-
mode_checkpoint(enter, "scope", !ModeInfo, !IO),
( Reason = from_ground_term(_) ->
mode_info_get_in_from_ground_term(!.ModeInfo, WasInFromGroundTerm),
@@ -423,14 +506,19 @@
;
unique_modes_check_goal(SubGoal0, SubGoal, !ModeInfo, !IO)
),
+ GoalExpr = scope(Reason, SubGoal),
mode_checkpoint(exit, "scope", !ModeInfo, !IO).
-unique_modes_check_goal_expr(generic_call(GenericCall, Args, Modes, Det),
- _GoalInfo0, Goal, !ModeInfo, !IO) :-
+:- pred unique_modes_check_goal_generic_call(generic_call::in,
+ list(prog_var)::in, list(mer_mode)::in, determinism::in,
+ hlds_goal_expr::out, mode_info::in, mode_info::out, io::di, io::uo) is det.
+
+unique_modes_check_goal_generic_call(GenericCall, ArgVars, Modes, Detism,
+ GoalExpr, !ModeInfo, !IO) :-
mode_checkpoint(enter, "generic_call", !ModeInfo, !IO),
hlds_goal.generic_call_id(GenericCall, CallId),
mode_info_set_call_context(call_context_call(CallId), !ModeInfo),
- ( determinism_components(Det, _, at_most_zero) ->
+ ( determinism_components(Detism, _, at_most_zero) ->
NeverSucceeds = yes
;
NeverSucceeds = no
@@ -451,38 +539,52 @@
GenericCall = cast(_),
ArgOffset = 0
),
- unique_modes_check_call_modes(Args, Modes, ArgOffset, Det, NeverSucceeds,
- !ModeInfo),
- Goal = generic_call(GenericCall, Args, Modes, Det),
+ unique_modes_check_call_modes(ArgVars, Modes, ArgOffset, Detism,
+ NeverSucceeds, !ModeInfo),
+ GoalExpr = generic_call(GenericCall, ArgVars, Modes, Detism),
mode_info_unset_call_context(!ModeInfo),
mode_checkpoint(exit, "generic_call", !ModeInfo, !IO).
-unique_modes_check_goal_expr(GoalExpr0, GoalInfo0, Goal, !ModeInfo, !IO) :-
- GoalExpr0 = plain_call(PredId, ProcId0, Args, Builtin, CallContext,
- PredName),
+:- pred unique_modes_check_goal_plain_call(pred_id::in, proc_id::in,
+ list(prog_var)::in, builtin_state::in, maybe(call_unify_context)::in,
+ sym_name::in, hlds_goal_info::in, hlds_goal_expr::out,
+ mode_info::in, mode_info::out, io::di, io::uo) is det.
+
+unique_modes_check_goal_plain_call(PredId, ProcId0, ArgVars, Builtin,
+ MaybeUnifyContext, PredName, GoalInfo0, GoalExpr, !ModeInfo, !IO) :-
PredNameString = sym_name_to_string(PredName),
string.append("call ", PredNameString, CallString),
mode_checkpoint(enter, CallString, !ModeInfo, !IO),
mode_info_get_call_id(!.ModeInfo, PredId, CallId),
mode_info_set_call_context(call_context_call(plain_call_id(CallId)),
!ModeInfo),
- unique_modes_check_call(PredId, ProcId0, Args, GoalInfo0, ProcId,
+ unique_modes_check_call(PredId, ProcId0, ArgVars, GoalInfo0, ProcId,
!ModeInfo),
- Goal = plain_call(PredId, ProcId, Args, Builtin, CallContext, PredName),
+ GoalExpr = plain_call(PredId, ProcId, ArgVars, Builtin, MaybeUnifyContext,
+ PredName),
mode_info_unset_call_context(!ModeInfo),
mode_checkpoint(exit, "call", !ModeInfo, !IO).
-unique_modes_check_goal_expr(unify(LHS0, RHS0, _, UnifyInfo0, UnifyContext),
- GoalInfo0, Goal, !ModeInfo, !IO) :-
+:- pred unique_modes_check_goal_unify(prog_var::in, unify_rhs::in,
+ unification::in, unify_context::in,
+ hlds_goal_info::in, hlds_goal_expr::out,
+ mode_info::in, mode_info::out, io::di, io::uo) is det.
+
+unique_modes_check_goal_unify(LHS0, RHS0, Unification0, UnifyContext,
+ GoalInfo0, GoalExpr, !ModeInfo, !IO) :-
mode_checkpoint(enter, "unify", !ModeInfo, !IO),
mode_info_set_call_context(call_context_unify(UnifyContext), !ModeInfo),
- modecheck_unification(LHS0, RHS0, UnifyInfo0, UnifyContext, GoalInfo0,
- Goal, !ModeInfo, !IO),
+ modecheck_unification(LHS0, RHS0, Unification0, UnifyContext, GoalInfo0,
+ GoalExpr, !ModeInfo, !IO),
mode_info_unset_call_context(!ModeInfo),
mode_checkpoint(exit, "unify", !ModeInfo, !IO).
-unique_modes_check_goal_expr(switch(Var, CanFail, Cases0), GoalInfo0,
- switch(Var, CanFail, Cases), !ModeInfo, !IO) :-
+:- pred unique_modes_check_goal_switch(prog_var::in, can_fail::in,
+ list(case)::in, hlds_goal_info::in, hlds_goal_expr::out,
+ mode_info::in, mode_info::out, io::di, io::uo) is det.
+
+unique_modes_check_goal_switch(Var, CanFail, Cases0, GoalInfo0, GoalExpr,
+ !ModeInfo, !IO) :-
mode_checkpoint(enter, "switch", !ModeInfo, !IO),
(
Cases0 = [],
@@ -494,13 +596,21 @@
NonLocals = goal_info_get_nonlocals(GoalInfo0),
unique_modes_check_case_list(Cases0, Var, Cases, InstMapList,
!ModeInfo, !IO),
- instmap_merge(NonLocals, InstMapList, disj, !ModeInfo)
+ instmap_merge(NonLocals, InstMapList, merge_disj, !ModeInfo)
),
+ GoalExpr = switch(Var, CanFail, Cases),
mode_checkpoint(exit, "switch", !ModeInfo, !IO).
-unique_modes_check_goal_expr(GoalExpr0, GoalInfo0, Goal, !ModeInfo, !IO) :-
- GoalExpr0 = call_foreign_proc(Attributes, PredId, ProcId0, Args, ExtraArgs,
- MaybeTraceRuntimeCond, PragmaCode),
+:- pred unique_modes_check_goal_call_foreign_proc(
+ pragma_foreign_proc_attributes::in, pred_id::in, proc_id::in,
+ list(foreign_arg)::in, list(foreign_arg)::in,
+ maybe(trace_expr(trace_runtime))::in, pragma_foreign_code_impl::in,
+ hlds_goal_info::in, hlds_goal_expr::out,
+ mode_info::in, mode_info::out, io::di, io::uo) is det.
+
+unique_modes_check_goal_call_foreign_proc(Attributes, PredId, ProcId0,
+ Args, ExtraArgs, MaybeTraceRuntimeCond, PragmaCode,
+ GoalInfo0, GoalExpr, !ModeInfo, !IO) :-
% To modecheck a pragma_c_code, we just modecheck the proc for
% which it is the goal.
mode_checkpoint(enter, "foreign_proc", !ModeInfo, !IO),
@@ -510,14 +620,57 @@
ArgVars = list.map(foreign_arg_var, Args),
unique_modes_check_call(PredId, ProcId0, ArgVars, GoalInfo0, ProcId,
!ModeInfo),
- Goal = call_foreign_proc(Attributes, PredId, ProcId, Args, ExtraArgs,
+ GoalExpr = call_foreign_proc(Attributes, PredId, ProcId, Args, ExtraArgs,
MaybeTraceRuntimeCond, PragmaCode),
mode_info_unset_call_context(!ModeInfo),
mode_checkpoint(exit, "foreign_proc", !ModeInfo, !IO).
-unique_modes_check_goal_expr(shorthand(_), _, _, !ModeInfo, !IO) :-
- % These should have been expanded out by now.
- unexpected(this_file, "unique_modes_check_goal_expr: unexpected shorthand").
+:- pred unique_modes_check_goal_atomic_goal(atomic_goal_type::in,
+ atomic_interface_vars::in, atomic_interface_vars::in,
+ maybe(list(prog_var))::in, hlds_goal::in, list(hlds_goal)::in,
+ hlds_goal_info::in, hlds_goal_expr::out,
+ mode_info::in, mode_info::out, io::di, io::uo) is det.
+
+unique_modes_check_goal_atomic_goal(GoalType, Outer, Inner, MaybeOutputVars,
+ MainGoal0, OrElseGoals0, GoalInfo0, GoalExpr, !ModeInfo, !IO) :-
+ mode_checkpoint(enter, "atomic_goal", !ModeInfo, !IO),
+ (
+ OrElseGoals0 = [],
+ unique_modes_check_goal(MainGoal0, MainGoal, !ModeInfo, !IO),
+ OrElseGoals = []
+ ;
+ OrElseGoals0 = [_ | _],
+ % The unique mode check on the or_else goals is very similar
+ % to the unique mode check for disjunctions. Please see
+ % "unique_modes_check_goal_disj" for disjunctions for discussion
+ % of this code.
+ NonLocals = goal_info_get_nonlocals(GoalInfo0),
+ Determinism = goal_info_get_determinism(GoalInfo0),
+ ( determinism_components(Determinism, _, at_most_many) ->
+ mode_info_add_live_vars(NonLocals, !ModeInfo),
+ make_all_nondet_live_vars_mostly_uniq(!ModeInfo),
+ mode_info_remove_live_vars(NonLocals, !ModeInfo)
+ ;
+ true
+ ),
+ Goals0 = [MainGoal0 | OrElseGoals0],
+ unique_modes_check_disj(Goals0, Determinism, NonLocals, Goals,
+ InstMapList, !ModeInfo, !IO),
+ (
+ Goals = [MainGoal | OrElseGoals]
+ ;
+ Goals = [],
+ unexpected(this_file,
+ "unique_modes_check_goal_atomic_goal: Goals = []")
+ ),
+ instmap_merge(NonLocals, InstMapList, merge_disj, !ModeInfo)
+ ),
+ ShortHand = atomic_goal(GoalType, Outer, Inner, MaybeOutputVars,
+ MainGoal, OrElseGoals),
+ GoalExpr = shorthand(ShortHand),
+ mode_checkpoint(exit, "atomic_goal", !ModeInfo, !IO).
+
+%-----------------------------------------------------------------------------%
:- pred unique_modes_check_call(pred_id::in, proc_id::in, list(prog_var)::in,
hlds_goal_info::in, proc_id::out, mode_info::in, mode_info::out) is det.
Index: compiler/unneeded_code.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unneeded_code.m,v
retrieving revision 1.46
diff -u -b -r1.46 unneeded_code.m
--- compiler/unneeded_code.m 30 Dec 2007 08:24:02 -0000 1.46
+++ compiler/unneeded_code.m 6 Jan 2008 09:39:42 -0000
@@ -360,8 +360,8 @@
implicitly_quantify_clause_body(HeadVars, _Warnings,
Goal2, Goal3, VarSet0, VarSet, VarTypes0, VarTypes,
RttiVarMaps0, RttiVarMaps),
- recompute_instmap_delta(no, Goal3, Goal, VarTypes, InstVarSet,
- InitInstMap, !ModuleInfo),
+ recompute_instmap_delta(do_not_recompute_atomic_instmap_deltas,
+ Goal3, Goal, VarTypes, InstVarSet, InitInstMap, !ModuleInfo),
proc_info_set_goal(Goal, !ProcInfo),
proc_info_set_varset(VarSet, !ProcInfo),
proc_info_set_vartypes(VarTypes, !ProcInfo),
@@ -723,6 +723,7 @@
Goal = hlds_goal(GoalExpr, GoalInfo0)
;
GoalExpr0 = shorthand(_),
+ % These should have been expanded out by now.
unexpected(this_file, "shorthand in process_goal_internal")
).
Index: compiler/untupling.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/untupling.m,v
retrieving revision 1.29
diff -u -b -r1.29 untupling.m
--- compiler/untupling.m 30 Dec 2007 08:24:02 -0000 1.29
+++ compiler/untupling.m 6 Jan 2008 10:30:45 -0000
@@ -241,7 +241,8 @@
proc_info_set_varset(VarSet, !ProcInfo),
proc_info_set_vartypes(VarTypes, !ProcInfo),
requantify_proc(!ProcInfo),
- recompute_instmap_delta_proc(yes, !ProcInfo, !ModuleInfo),
+ recompute_instmap_delta_proc(recompute_atomic_instmap_deltas,
+ !ProcInfo, !ModuleInfo),
counter.allocate(Num, !Counter),
create_aux_pred(PredId, ProcId, PredInfo0, !.ProcInfo, Num,
@@ -489,7 +490,8 @@
proc_info_set_varset(VarSet, !ProcInfo),
proc_info_set_vartypes(VarTypes, !ProcInfo),
requantify_proc(!ProcInfo),
- recompute_instmap_delta_proc(yes, !ProcInfo, !ModuleInfo),
+ recompute_instmap_delta_proc(recompute_atomic_instmap_deltas,
+ !ProcInfo, !ModuleInfo),
module_info_set_pred_proc_info(PredId, ProcId,
PredInfo, !.ProcInfo, !ModuleInfo)
;
@@ -585,6 +587,7 @@
Goal = hlds_goal(GoalExpr, GoalInfo0)
;
GoalExpr0 = shorthand(_),
+ % These should have been expanded out by now.
unexpected(this_file, "fix_calls_in_goal: unexpected shorthand")
).
Index: compiler/unused_imports.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unused_imports.m,v
retrieving revision 1.13
diff -u -b -r1.13 unused_imports.m
--- compiler/unused_imports.m 22 Jan 2008 15:06:18 -0000 1.13
+++ compiler/unused_imports.m 25 Jan 2008 05:52:13 -0000
@@ -376,22 +376,20 @@
:- pred hlds_goal_used_modules(hlds_goal::in,
used_modules::in, used_modules::out) is det.
-hlds_goal_used_modules(hlds_goal(GoalExpr, _), !UsedModules) :-
- hlds_goal_expr_used_modules(GoalExpr, !UsedModules).
-
-:- pred hlds_goal_expr_used_modules(hlds_goal_expr::in,
- used_modules::in, used_modules::out) is det.
-
-hlds_goal_expr_used_modules(unify(_, Rhs, _, _, _), !UsedModules) :-
- unify_rhs_used_modules(Rhs, !UsedModules).
-hlds_goal_expr_used_modules(plain_call(_, _, _, _, _, Name), !UsedModules) :-
- add_sym_name_module(visibility_private, Name, !UsedModules).
-hlds_goal_expr_used_modules(generic_call(Call, _, _, _), !UsedModules) :-
+hlds_goal_used_modules(Goal, !UsedModules) :-
+ Goal = hlds_goal(GoalExpr, _),
+ (
+ GoalExpr = unify(_, Rhs, _, _, _),
+ unify_rhs_used_modules(Rhs, !UsedModules)
+ ;
+ GoalExpr = plain_call(_, _, _, _, _, Name),
+ add_sym_name_module(visibility_private, Name, !UsedModules)
+ ;
+ GoalExpr = generic_call(Call, _, _, _),
(
Call = class_method(_, _, ClassId, CallId),
ClassId = class_id(ClassName, _),
add_sym_name_module(visibility_private, ClassName, !UsedModules),
-
CallId = simple_call_id(_, MethodName, _),
add_sym_name_module(visibility_private, MethodName, !UsedModules)
;
@@ -399,27 +397,39 @@
; Call = event_call(_)
; Call = cast(_)
)
- ).
-hlds_goal_expr_used_modules(call_foreign_proc(_, _, _, _, _, _, _),
- !UsedModules).
-hlds_goal_expr_used_modules(conj(_, Goals), !UsedModules) :-
- list.foldl(hlds_goal_used_modules, Goals, !UsedModules).
-hlds_goal_expr_used_modules(disj(Goals), !UsedModules) :-
- list.foldl(hlds_goal_used_modules, Goals, !UsedModules).
-hlds_goal_expr_used_modules(switch(_, _, Cases), !UsedModules) :-
- list.foldl(case_used_modules, Cases, !UsedModules).
-hlds_goal_expr_used_modules(negation(Goal), !UsedModules) :-
- hlds_goal_used_modules(Goal, !UsedModules).
-hlds_goal_expr_used_modules(scope(_, Goal), !UsedModules) :-
- hlds_goal_used_modules(Goal, !UsedModules).
-hlds_goal_expr_used_modules(if_then_else(_, If, Then, Else), !UsedModules) :-
- hlds_goal_used_modules(If, !UsedModules),
+ )
+ ;
+ GoalExpr = call_foreign_proc(_, _, _, _, _, _, _)
+ ;
+ ( GoalExpr = conj(_, Goals)
+ ; GoalExpr = disj(Goals)
+ ),
+ list.foldl(hlds_goal_used_modules, Goals, !UsedModules)
+ ;
+ GoalExpr = switch(_, _, Cases),
+ list.foldl(case_used_modules, Cases, !UsedModules)
+ ;
+ ( GoalExpr = negation(SubGoal)
+ ; GoalExpr = scope(_, SubGoal)
+ ),
+ hlds_goal_used_modules(SubGoal, !UsedModules)
+ ;
+ GoalExpr = if_then_else(_, Cond, Then, Else),
+ hlds_goal_used_modules(Cond, !UsedModules),
hlds_goal_used_modules(Then, !UsedModules),
- hlds_goal_used_modules(Else, !UsedModules).
-hlds_goal_expr_used_modules(shorthand(bi_implication(GoalA, GoalB)),
- !UsedModules) :-
+ hlds_goal_used_modules(Else, !UsedModules)
+ ;
+ GoalExpr = shorthand(ShortHand),
+ (
+ ShortHand = bi_implication(GoalA, GoalB),
hlds_goal_used_modules(GoalA, !UsedModules),
- hlds_goal_used_modules(GoalB, !UsedModules).
+ hlds_goal_used_modules(GoalB, !UsedModules)
+ ;
+ ShortHand = atomic_goal(_, _, _, _, MainGoal, OrElseGoals),
+ hlds_goal_used_modules(MainGoal, !UsedModules),
+ list.foldl(hlds_goal_used_modules, OrElseGoals, !UsedModules)
+ )
+ ).
:- pred case_used_modules(case::in, used_modules::in, used_modules::out)
is det.
@@ -444,26 +454,28 @@
:- pred cons_id_used_modules(item_visibility::in, cons_id::in,
used_modules::in, used_modules::out) is det.
-cons_id_used_modules(Visibility, cons(Name, _), !UsedModules) :-
- add_sym_name_module(Visibility, Name, !UsedModules).
-cons_id_used_modules(_, int_const(_), !UsedModules).
-cons_id_used_modules(_, string_const(_), !UsedModules).
-cons_id_used_modules(_, float_const(_), !UsedModules).
-cons_id_used_modules(_, pred_const(_, _), !UsedModules).
-cons_id_used_modules(Visibility,
- type_ctor_info_const(ModuleName, _, _), !UsedModules) :-
- add_all_modules(Visibility, ModuleName, !UsedModules).
-cons_id_used_modules(Visibility,
- base_typeclass_info_const(ModuleName, _, _, _), !UsedModules) :-
- add_all_modules(Visibility, ModuleName, !UsedModules).
-cons_id_used_modules(Visibility,
- type_info_cell_constructor(type_ctor(SymName, _Arity)),
- !UsedModules) :-
- add_sym_name_module(Visibility, SymName, !UsedModules).
-cons_id_used_modules(_, typeclass_info_cell_constructor, !UsedModules).
-cons_id_used_modules(_, tabling_info_const(_), !UsedModules).
-cons_id_used_modules(_, deep_profiling_proc_layout(_), !UsedModules).
-cons_id_used_modules(_, table_io_decl(_), !UsedModules).
+cons_id_used_modules(Visibility, ConsId, !UsedModules) :-
+ (
+ ( ConsId = cons(SymName, _)
+ ; ConsId = type_info_cell_constructor(type_ctor(SymName, _))
+ ),
+ add_sym_name_module(Visibility, SymName, !UsedModules)
+ ;
+ ( ConsId = type_ctor_info_const(ModuleName, _, _)
+ ; ConsId = base_typeclass_info_const(ModuleName, _, _, _)
+ ),
+ add_all_modules(Visibility, ModuleName, !UsedModules)
+ ;
+ ( ConsId = int_const(_)
+ ; ConsId = string_const(_)
+ ; ConsId = float_const(_)
+ ; ConsId = pred_const(_, _)
+ ; ConsId = typeclass_info_cell_constructor
+ ; ConsId = tabling_info_const(_)
+ ; ConsId = deep_profiling_proc_layout(_)
+ ; ConsId = table_io_decl(_)
+ )
+ ).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
cvs diff: Diffing compiler/notes
Index: compiler/notes/compiler_design.html
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/notes/compiler_design.html,v
retrieving revision 1.132
diff -u -b -r1.132 compiler_design.html
--- compiler/notes/compiler_design.html 20 Feb 2008 03:09:59 -0000 1.132
+++ compiler/notes/compiler_design.html 20 Feb 2008 03:13:15 -0000
@@ -928,6 +928,10 @@
(Is there any good reason why lambda.m comes after table_gen.m?)
+<p>
+
+The next pass also simplifies the HLDS by expanding out the atomic goals
+implementing Software Transactional Memory (stm_expand.m).
<p>
cvs diff: Diffing debian
cvs diff: Diffing debian/patches
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
Index: doc/reference_manual.texi
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/doc/reference_manual.texi,v
retrieving revision 1.422
diff -u -b -r1.422 reference_manual.texi
--- doc/reference_manual.texi 1 Feb 2008 05:45:28 -0000 1.422
+++ doc/reference_manual.texi 6 Feb 2008 01:52:15 -0000
@@ -9621,6 +9621,12 @@
@menu
* Fact tables:: Support for very large tables of facts.
+ at c XXX STM
+ at c The documentation of STM is commented out because its support is
+ at c not yet complete. All such lines are preceded by XXX STM.
+ at c * Software Transactional Memory::
+ at c Support for synchronisation of threads without
+ at c explicit locking.
* Tabled evaluation:: Support for automatically recording previously
calculated results and detecting or avoiding
certain kinds of infinite loops.
@@ -9677,6 +9683,109 @@
not support @samp{pragma fact_table} for procedures with determinism
@samp{nondet} or @samp{multi}.
+ at c XXX STM
+ at c @node Software Transactional Memory
+ at c @section Software Transactional Memory
+ at c
+ at c (Note: Software Transactional Memory is still in development and many
+ at c aspects c documented here might change without notice.
+ at c Please use with caution.)
+ at c
+ at c Software Transactional Memory or STM
+ at c is an method of synchronising access to shared data
+ at c between concurrently running threads.
+ at c It is an alternative to the use of explicit locking.
+ at c
+ at c The way to synchronise threads using Software Transactional Memory
+ at c is through the use of the @samp{atomic} scope.
+ at c The syntax of an atomic scope is @code{atomic @var{Params} @var{Goal}}.
+ at c @var{Goal} must be a valid goal;
+ at c @var{Params} must be a list of atomic parameters
+ at c which must include the @samp{outer} and @samp{inner} parameters.
+ at c The following example shows the use of the atomic scope:
+ at c
+ at c @example
+ at c :- pred add_2_atomically(stm_var(int)::in, io::di, io::uo) is cc_multi.
+ at c
+ at c add_2_atomically(TVar, IO0, IO) :-
+ at c atomic [ outer(IO0, IO1), inner(STM0, STM) ] (
+ at c read_stm_var(TVar, X, STM0, STM1),
+ at c Y = X + 2,
+ at c write_stm_var(TVar, Y, STM1, STM)
+ at c ),
+ at c io.write_string("Value of Y is ", IO1, IO2),
+ at c io.write(Y, IO2, IO3),
+ at c io.nl(IO3, IO).
+ at c @end example
+ at c
+ at c
+ at c The @samp{outer} parameter takes a pair of variables of type @samp{io.io}.
+ at c As the atomic scope can be seen as an operation which changes the I/O state,
+ at c the modes of these variables must be @samp{di} and @samp{uo} respectively.
+ at c
+ at c The @samp{inner} parameter takes a pair of variables of type @samp{stm}.
+ at c When the atomic scope is executed,
+ at c these variables supply and consume the @samp{stm} state
+ at c which can be used by the Software Transactional Memory primitives.
+ at c Calling these primitives requires threading the @samp{stm} state
+ at c in a way similar to I/O operations and,
+ at c as such, the modes of these variables must also be @samp{di} and @samp{uo}.
+ at c
+ at c The code within the atomic scope is restricted
+ at c in the same way as code which takes the I/O state.
+ at c The code within the atomic scope
+ at c must be either @samp{det} or @samp{cc_multi}.
+ at c Due to the way Software Transactional Memory provides synchronous behaviour,
+ at c it is likely that the goal will be executed more than once.
+ at c As it is unknown how many times (if any) the inner goal will be repeated,
+ at c only pure code or code which makes use of the @samp{stm} state
+ at c should be placed inside an atomic scope.
+ at c (Trace goals are permitted but should not be used for any action
+ at c that depends on the number of times the goal is executed).
+ at c
+ at c Using the atomic scope requires the program to explicitly import the modules
+ at c @samp{stm_builtin}, @samp{exception} and @samp{univ}.
+ at c This restriction will soon be dropped,
+ at c as the the compiler itself will do the required imports.
+ at c
+ at c In STM systems, data shared between threads
+ at c is stored in @samp{Transaction Variables}.
+ at c This is the only form of shared data
+ at c which the atomic scope will synchronise.
+ at c @samp{Transaction Variables} can be operated on
+ at c using the following predicates:
+ at c
+ at c @example
+ at c :- pred new_stm_var(T::in, stm_var(T)::out, io::di, io::uo) is det.
+ at c
+ at c :- pred read_stm_var(stm_var(T)::in, T::out, stm::di, stm::uo) is det.
+ at c
+ at c :- pred write_stm_var(stm_var(T)::in, T::in, stm::di, stm::uo) is det.
+ at c @end example
+ at c
+ at c The @samp{new_stm_var} creates a new transaction variable
+ at c whose the type and initial value are given by the first argument,
+ at c and returns a reference to it.
+ at c Only one copy of the transaction variable exists in memory,
+ at c but references to it can be duplicated.
+ at c Unifications and tests of references
+ at c affect only the references themselves,
+ at c and do not affect the underlying transaction variables.
+ at c
+ at c To get or set the value of the actual transaction variable,
+ at c programs must call
+ at c the builtins @samp{read_stm_var} and @samp{write_stm_var}.
+ at c These calls take a reference to a transaction variable
+ at c and either set or return the value of the transaction variable.
+ at c @footnote{In actual fact, write_stm_var does not update the variable.
+ at c The update is instead written to a log,
+ at c and the real transaction variable is changed
+ at c only when the atomic goal has completed
+ at c and the whole log has been validated.}
+ at c As the calls to @samp{read_stm_var} and @samp{write_stm_var}
+ at c take a pair of @samp{stm} states,
+ at c they can only appear within an atomic scope.
+
@node Tabled evaluation
@section Tabled evaluation
cvs diff: Diffing extras
cvs diff: Diffing extras/base64
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/concurrency
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/error
cvs diff: Diffing extras/fixed
cvs diff: Diffing extras/gator
cvs diff: Diffing extras/gator/generations
cvs diff: Diffing extras/gator/generations/1
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/easyx
cvs diff: Diffing extras/graphics/easyx/samples
cvs diff: Diffing extras/graphics/mercury_allegro
cvs diff: Diffing extras/graphics/mercury_allegro/examples
cvs diff: Diffing extras/graphics/mercury_allegro/samples
cvs diff: Diffing extras/graphics/mercury_allegro/samples/demo
cvs diff: Diffing extras/graphics/mercury_allegro/samples/mandel
cvs diff: Diffing extras/graphics/mercury_allegro/samples/pendulum2
cvs diff: Diffing extras/graphics/mercury_allegro/samples/speed
cvs diff: Diffing extras/graphics/mercury_glut
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/gears
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
cvs diff: Diffing extras/log4m
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/moose/tests
cvs diff: Diffing extras/mopenssl
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/net
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/posix/samples
cvs diff: Diffing extras/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/solver_types
cvs diff: Diffing extras/solver_types/library
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/windows_installer_generator
cvs diff: Diffing extras/windows_installer_generator/sample
cvs diff: Diffing extras/windows_installer_generator/sample/images
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing extras/xml_stylesheets
cvs diff: Diffing java
cvs diff: Diffing java/runtime
cvs diff: Diffing library
Index: library/ops.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/ops.m,v
retrieving revision 1.69
diff -u -b -r1.69 ops.m
--- library/ops.m 30 May 2007 08:16:06 -0000 1.69
+++ library/ops.m 14 Oct 2007 11:07:54 -0000
@@ -405,6 +405,7 @@
; Op = "==>", Info = op_info(infix(x, x), 1175)
; Op = "=^", Info = op_info(infix(x, x), 650)
; Op = "@", Info = op_info(infix(x, x), 90)
+ ; Op = "or_else", Info = op_info(infix(x, y), 1100)
; Op = "end_module", Info = op_info(prefix(x), 1199)
; Op = "event", Info = op_info(prefix(x), 100)
; Op = "finalise", Info = op_info(prefix(x), 1199)
@@ -433,6 +434,7 @@
; Op = "promise_equivalent_solutions"
; Op = "promise_equivalent_solution_sets"
; Op = "trace"
+ ; Op = "atomic"
),
Info = op_info(binary_prefix(x, y), 950),
OtherInfos = []
Index: library/stm_builtin.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/stm_builtin.m,v
retrieving revision 1.12
diff -u -b -r1.12 stm_builtin.m
--- library/stm_builtin.m 17 Sep 2007 13:28:55 -0000 1.12
+++ library/stm_builtin.m 30 Dec 2007 15:15:34 -0000
@@ -10,9 +10,8 @@
% 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.
%
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -54,10 +53,14 @@
%
% Create a new transaction variable with initial value `Value'.
%
- % XXX we need a version that works within atomic blocks as well.
- %
:- pred new_stm_var(T::in, stm_var(T)::out, io::di, io::uo) is det.
+ % new_stm_var_atomic(Value, TVar, !STM):
+ %
+ % A version of new_stm_var which works within an atomic scope.
+ %
+:- pred new_stm_var_atomic(T::in, stm_var(T)::out, stm::di, stm::uo) is det.
+
% Update the value stored in a transaction variable.
%
:- pred write_stm_var(stm_var(T)::in, T::in, stm::di, stm::uo) is det.
@@ -76,19 +79,31 @@
% 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.
%-----------------------------------------------------------------------------%
%
-% Atomic transactions
+% Closure versions of atomic transactions. These predicates can be used
+% to perform Software Transactional Memory without using the atomic scope.
%
-:- 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.
+ % atomic_transaction(Closure, Result, !IO):
+ %
+ % Performs the Software Transactional Memory operations in Closure
+ % atomically. If the transaction is invalid, the Closure is
+ % re-executed.
+ %
+:- pred atomic_transaction(pred(T, stm, stm)::in(pred(out, di, uo) is det),
+ T::out, io::di, io::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.
+ %
+:- pred or_else(pred(T, stm, stm)::in(pred(out, di, uo) is det),
+ pred(T, stm, stm)::in(pred(out, di, uo) is det),
+ T::out, stm::di, stm::uo) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -120,8 +135,9 @@
:- impure pred stm_discard_transaction_log(stm::di) is det.
% stm_create_nested_transaction_log(Parent, Child):
- % `Child' is a new transaction log whose enclosing transaction's
- % log is given by `Parent'.
+ %
+ % `Child' is a new transaction log whose enclosing transaction's log
+ % is given by `Parent'.
%
:- impure pred stm_create_nested_transaction_log(stm::ui, stm::uo) is det.
@@ -135,10 +151,10 @@
% 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
; stm_transaction_invalid.
@@ -150,7 +166,7 @@
% Write the changes in the given log to memory.
%
- % NOTE: this predicate must *only* be called while the STM global mutex
+ % NOTE: This predicate must *only* be called while the STM global mutex
% is locked.
%
:- impure pred stm_commit(stm::ui) is det.
@@ -159,7 +175,7 @@
% to by the given log and then block until another thread makes a commit
% that involves one of those transaction variables.
%
- % NOTE: this predicate must *only* be called while the STM global mutex
+ % NOTE: This predicate must *only* be called while the STM global mutex
% is locked.
%
:- impure pred stm_block(stm::ui) is det.
@@ -171,6 +187,19 @@
:- 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(T::di, stm::uo) is det.
+:- pred stm_from_inner_to_outer_io(stm::di, T::uo) is det.
+
+ % Changes the value of a transaction variable without going through
+ % the log. USE ONLY FOR DEBUGGING PURPOSES.
+ %
+:- pred unsafe_write_stm_var(stm_var(T)::in, T::in, stm::di, stm::uo) is det.
+
+:- impure pred stm_merge_nested_logs(stm::di, stm::di, stm::uo) is det.
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -208,6 +237,14 @@
").
:- pragma foreign_proc("C",
+ new_stm_var_atomic(T::in, TVar::out, STM0::di, STM::uo),
+ [promise_pure, will_not_call_mercury, thread_safe],
+"
+ MR_STM_new_stm_var(T, TVar);
+ STM = STM0;
+").
+
+:- pragma foreign_proc("C",
write_stm_var(TVar::in, Value::in, STM0::di, STM::uo),
[promise_pure, will_not_call_mercury, thread_safe],
"
@@ -216,6 +253,14 @@
").
:- pragma foreign_proc("C",
+ unsafe_write_stm_var(TVar::in, Value::in, STM0::di, STM::uo),
+ [promise_pure, will_not_call_mercury, thread_safe],
+"
+ MR_STM_unsafe_write_var(TVar, Value);
+ STM = STM0;
+").
+
+:- pragma foreign_proc("C",
read_stm_var(TVar::in, Value::out, STM0::di, STM::uo),
[promise_pure, will_not_call_mercury, thread_safe],
"
@@ -228,6 +273,11 @@
[will_not_call_mercury, thread_safe],
"
MR_STM_create_log(STM, NULL);
+
+#if defined(MR_STM_DEBUG)
+ fprintf(stderr, \"STM NEW LOG: log <0x%.8lx>\\n\",
+ (MR_Word)(STM));
+#endif
").
:- pragma foreign_proc("C",
@@ -235,6 +285,11 @@
[will_not_call_mercury, thread_safe],
"
MR_STM_create_log(Child, Parent);
+#ifdef MR_STM_DEBUG
+ fprintf(stderr,
+ \"STM: Creating nested log <0x%.8lx>, parent <0x%.8lx>\\n\",
+ (MR_Word)(Child), (MR_Word)(Parent));
+#endif
").
:- pragma foreign_proc("C",
@@ -245,19 +300,38 @@
").
:- pragma foreign_proc("C",
+ stm_merge_nested_logs(Child::di, Parent0::di, Parent::uo),
+ [will_not_call_mercury, thread_safe],
+"
+ /* Avoid a warning: Child, Parent0, Parent */
+#if defined(MR_STM_DEBUG)
+ fprintf(stderr, \"STM Calling Merge Nested: log <0x%.8lx>\\n\",
+ (MR_Word)(Child));
+#endif
+ MR_STM_merge_transactions(Child);
+ Parent = Parent0;
+").
+
+:- pragma foreign_proc("C",
stm_lock,
[will_not_call_mercury, thread_safe],
"
- #ifdef MR_THREAD_SAFE
+ #if defined(MR_THREAD_SAFE)
MR_LOCK(&MR_STM_lock, \"stm_lock/0\");
#endif
+ #if defined(MR_STM_DEBUG)
+ fprintf(stderr, \"STM LOCKING\\n\");
+ #endif
").
:- pragma foreign_proc("C",
stm_unlock,
[will_not_call_mercury, thread_safe],
"
- #ifdef MR_THREAD_SAFE
+ #if defined(MR_STM_DEBUG)
+ fprintf(stderr, \"STM UNLOCKING\\n\");
+ #endif
+ #if defined(MR_THREAD_SAFE)
MR_UNLOCK(&MR_STM_lock, \"stm_unlock/0\");
#endif
").
@@ -276,12 +350,29 @@
MR_STM_commit(STM);
").
+:- 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_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_block(_STM::ui),
+ stm_block(STM::ui),
[will_not_call_mercury, thread_safe],
"
+ MR_STM_block_thread(STM);
").
%-----------------------------------------------------------------------------%
@@ -297,13 +388,73 @@
% Atomic transactions
%
-:- pragma promise_pure(atomic_transaction/4).
atomic_transaction(Goal, Result, !IO) :-
- impure atomic_transaction_impl(Goal, Result).
+ promise_pure (
+ impure atomic_transaction_impl(Goal, Result)
+ ).
+
+:- pragma promise_pure(or_else/5).
+or_else(TransA, TransB, Result, OuterSTM0, OuterSTM) :-
+ impure stm_create_nested_transaction_log(OuterSTM0, InnerSTM_A0),
+ promise_equivalent_solutions [ResultA, InnerSTM_A] (
+ unsafe_try_stm(TransA, ResultA,
+ InnerSTM_A0, InnerSTM_A)
+ ),
+ (
+ ResultA = succeeded(Result),
+ impure stm_merge_nested_logs(InnerSTM_A, OuterSTM0, OuterSTM)
+ ;
+ ResultA = exception(ExcpA),
+
+ % If transaction A retried, then we should attemp transaction B.
+ % Otherwise we just propagate the exception upwards.
-:- impure pred atomic_transaction_impl(pred(T, stm, stm), T).
-:- mode atomic_transaction_impl(in(pred(out, di, uo) is det), out)
- is det.
+ ( ExcpA = univ(rollback_retry) ->
+ impure stm_create_nested_transaction_log(OuterSTM0, InnerSTM_B0),
+ promise_equivalent_solutions [ResultB, InnerSTM_B] (
+ unsafe_try_stm(TransB, ResultB,
+ InnerSTM_B0, InnerSTM_B)
+ ),
+ (
+ ResultB = succeeded(Result),
+ impure stm_merge_nested_logs(InnerSTM_B, OuterSTM0, OuterSTM)
+ ;
+ ResultB = exception(ExcpB),
+ ( ExcpB = univ(rollback_retry) ->
+ impure stm_lock,
+ impure stm_validate(InnerSTM_A, IsValidA),
+ impure stm_validate(InnerSTM_B, IsValidB),
+ (
+ IsValidA = stm_transaction_valid,
+ IsValidB = stm_transaction_valid
+ ->
+ % We want to wait on the union of the transaction
+ % variables accessed during both alternatives.
+ % We merge the transaction logs (the order does not
+ % matter) and then propagate the retry upwards.
+ impure stm_merge_nested_logs(InnerSTM_A, OuterSTM0,
+ OuterSTM1),
+ impure stm_merge_nested_logs(InnerSTM_B, OuterSTM1,
+ OuterSTM),
+ impure stm_unlock,
+ retry(OuterSTM)
+ ;
+ impure stm_unlock,
+ throw(rollback_invalid_transaction)
+ )
+ ;
+ impure stm_unlock,
+ rethrow(ResultB)
+ )
+ )
+ ;
+ impure stm_discard_transaction_log(InnerSTM_A),
+ rethrow(ResultA)
+ )
+ ).
+
+:- impure pred atomic_transaction_impl(
+ pred(T, stm, stm)::in(pred(out, di, uo) is det), T::out) is det.
atomic_transaction_impl(Goal, Result) :-
impure stm_create_transaction_log(STM0),
@@ -345,12 +496,11 @@
)
).
-:- pragma promise_pure(call_atomic_goal/4).
-:- pred call_atomic_goal(pred(T, stm, stm), T, stm, stm).
-:- mode call_atomic_goal(in(pred(out, di, uo) is det), out, di, uo)
- is det.
+:- pred call_atomic_goal(pred(T, stm, stm)::in(pred(out, di, uo) is det),
+ T::out, stm::di, stm::uo) is det.
call_atomic_goal(Goal, Result, !STM) :-
+ promise_pure (
Goal(Result, !STM),
impure stm_lock,
impure stm_validate(!.STM, IsValid),
@@ -362,6 +512,7 @@
IsValid = stm_transaction_invalid,
impure stm_unlock,
throw(rollback_invalid_transaction)
+ )
).
%----------------------------------------------------------------------------%
Index: library/term.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/term.m,v
retrieving revision 1.129
diff -u -b -r1.129 term.m
--- library/term.m 15 Feb 2008 02:27:04 -0000 1.129
+++ library/term.m 16 Feb 2008 07:27:00 -0000
@@ -59,7 +59,7 @@
:- type term == term(generic).
:- type var == var(generic).
-:- func get_term_context(term) = term.context.
+:- func get_term_context(term(T)) = term.context.
%-----------------------------------------------------------------------------%
cvs diff: Diffing mdbcomp
Index: mdbcomp/prim_data.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/mdbcomp/prim_data.m,v
retrieving revision 1.27
diff -u -b -r1.27 prim_data.m
--- mdbcomp/prim_data.m 31 Dec 2007 10:04:01 -0000 1.27
+++ mdbcomp/prim_data.m 31 Dec 2007 10:17:40 -0000
@@ -207,6 +207,16 @@
%
:- func mercury_stm_builtin_module = sym_name.
+ % Returns the name of the module implementing exceptions.
+ % This module is automatically imported iff STM is used in a module.
+ %
+:- func mercury_exception_module = sym_name.
+
+ % Returns the name of the module implementing univs.
+ % This module is automatically imported iff STM is used in a module.
+ %
+:- func mercury_univ_module = sym_name.
+
% Returns the name of the module containing builtins for tabling;
% originally these were in "private_builtin", but were then moved into
% a separate module. This module is automatically imported iff any
@@ -353,6 +363,11 @@
mercury_ssdb_builtin_module = unqualified("ssdb").
mercury_std_lib_module_name(Name) = Name.
+% Additional non-builtin modules that are needed by the STM system.
+%
+mercury_exception_module = unqualified("exception").
+mercury_univ_module = unqualified("univ").
+
is_std_lib_module_name(SymName, Name) :-
Name = sym_name_to_string(SymName),
mercury_std_library_module(Name).
Index: mdbcomp/program_representation.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/mdbcomp/program_representation.m,v
retrieving revision 1.28
diff -u -b -r1.28 program_representation.m
--- mdbcomp/program_representation.m 30 Dec 2007 08:24:23 -0000 1.28
+++ mdbcomp/program_representation.m 30 Dec 2007 08:42:48 -0000
@@ -314,6 +314,8 @@
; step_ite_else
; step_neg
; step_scope(maybe_cut)
+ ; step_atomic_main
+ ; step_atomic_orelse(int)
; step_first
; step_later.
@@ -612,6 +614,9 @@
goal_path_step_from_string_2('~', "", step_neg).
goal_path_step_from_string_2('q', "!", step_scope(scope_is_cut)).
goal_path_step_from_string_2('q', "", step_scope(scope_is_no_cut)).
+goal_path_step_from_string_2('a', "", step_atomic_main).
+goal_path_step_from_string_2('o', NStr, step_atomic_orelse(N)) :-
+ string.to_int(NStr, N).
goal_path_step_from_string_2('f', "", step_first).
goal_path_step_from_string_2('l', "", step_later).
@@ -636,6 +641,9 @@
goal_path_step_to_string(step_neg) = "~;".
goal_path_step_to_string(step_scope(scope_is_cut)) = "q!;".
goal_path_step_to_string(step_scope(scope_is_no_cut)) = "q;".
+goal_path_step_to_string(step_atomic_main) = "a;".
+goal_path_step_to_string(step_atomic_orelse(N)) =
+ "o" ++ int_to_string(N) ++ ";".
goal_path_step_to_string(step_first) = "f;".
goal_path_step_to_string(step_later) = "l;".
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
Index: runtime/mercury_stm.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_stm.c,v
retrieving revision 1.5
diff -u -b -r1.5 mercury_stm.c
--- runtime/mercury_stm.c 21 Sep 2007 06:13:12 -0000 1.5
+++ runtime/mercury_stm.c 30 Dec 2007 15:00:30 -0000
@@ -15,7 +15,7 @@
#include "mercury_misc.h"
#if defined(MR_THREAD_SAFE)
- MercuryLock MR_STM_lock;
+MercuryLock MR_STM_lock;
#endif
void
@@ -33,15 +33,56 @@
}
void
-MR_STM_attach_waiter(MR_STM_Var *var, MR_ThreadId tid)
+MR_STM_attach_waiter(MR_STM_Var *var, MR_ThreadId tid,
+ MR_STM_ConditionVar *cvar)
{
- MR_fatal_error("NYI MR_STM_attach_waiter");
+ MR_STM_Waiter *new_waiter;
+
+ new_waiter = MR_GC_NEW(MR_STM_Waiter);
+ new_waiter->MR_STM_cond_var = cvar;
+
+ if (var->MR_STM_var_waiters == NULL) {
+ var->MR_STM_var_waiters = new_waiter;
+ new_waiter->MR_STM_waiter_prev = NULL;
+ new_waiter->MR_STM_waiter_next = NULL;
+ } else {
+ new_waiter->MR_STM_waiter_prev = NULL;
+ new_waiter->MR_STM_waiter_next = var->MR_STM_var_waiters;
+ var->MR_STM_var_waiters->MR_STM_waiter_prev = new_waiter;
+ var->MR_STM_var_waiters = new_waiter;
+ }
}
void
-MR_STM_detach_waiter(MR_STM_Var *var, MR_ThreadId tid)
+MR_STM_detach_waiter(MR_STM_Var *var, MR_STM_ConditionVar *cvar)
{
- MR_fatal_error("NYI MR_STM_detach_waiter");
+ MR_STM_Waiter *curr_waiter;
+
+ MR_assert(var != NULL);
+ MR_assert(var->MR_STM_var_waiters != NULL);
+
+ curr_waiter = var->MR_STM_var_waiters;
+ while (curr_waiter != NULL) {
+ if (curr_waiter->MR_STM_cond_var == cvar) {
+ if (curr_waiter == var->MR_STM_var_waiters) {
+ var->MR_STM_var_waiters =
+ var->MR_STM_var_waiters->MR_STM_waiter_next;
+ }
+ if (curr_waiter->MR_STM_waiter_prev != NULL) {
+ curr_waiter->MR_STM_waiter_prev->MR_STM_waiter_next =
+ curr_waiter->MR_STM_waiter_next;
+ }
+ if (curr_waiter->MR_STM_waiter_next != NULL) {
+ curr_waiter->MR_STM_waiter_next->MR_STM_waiter_prev =
+ curr_waiter->MR_STM_waiter_prev;
+ }
+ curr_waiter = NULL;
+ return;
+ }
+ curr_waiter = curr_waiter->MR_STM_waiter_next;
+ }
+
+ MR_fatal_error("MR_STM_detach_waiter: Thread ID not in wait queue");
}
MR_Integer
@@ -51,40 +92,85 @@
MR_assert(tlog != NULL);
- while (tlog != NULL) {
+#if defined(MR_STM_DEBUG)
+ fprintf(stderr, "STM VALIDATE: validating log <0x%.8lx>\n",
+ (MR_Word) tlog);
+ fprintf(stderr, "\tRecords: <0x%.8lx>\n",
+ (MR_Word) tlog->MR_STM_tl_records);
+#endif
+ while (tlog != NULL) {
current = tlog->MR_STM_tl_records;
while (current != NULL) {
if (current->MR_STM_tr_var->MR_STM_var_value !=
current->MR_STM_tr_old_value)
{
+#if defined(MR_STM_DEBUG)
+ fprintf(stderr, "\ttransaction INVALID.\n");
+#endif
return MR_STM_TRANSACTION_INVALID;
}
+
current = current->MR_STM_tr_next;
}
tlog = tlog->MR_STM_tl_parent;
}
+#if defined(MR_STM_DEBUG)
+ fprintf(stderr, "\ttransaction VALID.\n");
+#endif
+
return MR_STM_TRANSACTION_VALID;
}
void
-MR_STM_commit(MR_STM_TransLog *tlog) {
+MR_STM_signal_vars(MR_STM_Var *tvar)
+{
+ MR_STM_Waiter *wait_queue;
+
+ wait_queue = tvar->MR_STM_var_waiters;
+ while (wait_queue != NULL) {
+#if defined(MR_STM_DEBUG)
+ fprintf(stderr, "STM SIGNAL: signalling log <0x%.8lx>\n",
+ (MR_Word) wait_queue->MR_STM_cond_var);
+#endif
+ MR_STM_condvar_signal(wait_queue->MR_STM_cond_var);
+ wait_queue = wait_queue->MR_STM_waiter_next;
+ }
+}
+
+void
+MR_STM_commit(MR_STM_TransLog *tlog)
+{
MR_STM_TransRecord *current;
+#if defined(MR_STM_DEBUG)
+ fprintf(stderr, "STM COMMIT: committing log <0x%.8lx>\n",
+ (MR_Word) tlog);
+#endif
+
current = tlog->MR_STM_tl_records;
while (current != NULL) {
- current->MR_STM_tr_var->MR_STM_var_value
- = current->MR_STM_tr_new_value;
+#if defined(MR_STM_DEBUG)
+ fprintf(stderr,
+ "\tSTM_Var <%.8lx>, changing value from %ld to %ld\n",
+ (MR_Word) current->MR_STM_tr_var,
+ current->MR_STM_tr_var->MR_STM_var_value,
+ current->MR_STM_tr_new_value);
+#endif
+ current->MR_STM_tr_var->MR_STM_var_value =
+ current->MR_STM_tr_new_value;
+
+ MR_STM_signal_vars(current->MR_STM_tr_var);
current = current->MR_STM_tr_next;
}
}
void
-MR_STM_wait(MR_STM_TransLog *tlog)
+MR_STM_wait(MR_STM_TransLog *tlog, MR_STM_ConditionVar *cvar)
{
MR_STM_TransRecord *current;
MR_ThreadId this_thread_id;
@@ -93,13 +179,20 @@
current = tlog->MR_STM_tl_records;
while (current != NULL) {
- MR_STM_attach_waiter(current->MR_STM_tr_var, this_thread_id);
+#if defined(MR_STM_DEBUG)
+ fprintf(stderr, "STM WAIT: attaching waiter on log <0x%.8lx>\n",
+ (MR_Word) tlog);
+ fprintf(stderr, "\tSTM_Var: <0x%.8lx>\n",
+ (MR_Word) current->MR_STM_tr_var);
+#endif
+
+ MR_STM_attach_waiter(current->MR_STM_tr_var, this_thread_id, cvar);
current = current->MR_STM_tr_next;
}
}
void
-MR_STM_unwait(MR_STM_TransLog *tlog)
+MR_STM_unwait(MR_STM_TransLog *tlog, MR_STM_ConditionVar *cvar)
{
MR_STM_TransRecord *current;
MR_ThreadId this_thread_id;
@@ -108,15 +201,37 @@
current = tlog->MR_STM_tl_records;
while (current != NULL) {
- MR_STM_detach_waiter(current->MR_STM_tr_var, this_thread_id);
+#if defined(MR_STM_DEBUG)
+ fprintf(stderr, "STM UNWAIT: detaching waiter on log <0x%.8lx>\n",
+ (MR_Word) tlog);
+ fprintf(stderr, "\tSTM_Var: <0x%.8lx>\n",
+ (MR_Word) current->MR_STM_tr_var);
+#endif
+
+ MR_STM_detach_waiter(current->MR_STM_tr_var, cvar);
current = current->MR_STM_tr_next;
}
}
void
+MR_STM_unsafe_write_var(MR_STM_Var *var, MR_Word value)
+{
+#if defined(MR_STM_DEBUG)
+ fprintf(stderr, "UNSAFE_WRITE_VAR:\n");
+ fprintf(stderr, "\tSTM_Var <%.8lx>, changing value from %ld to %ld\n",
+ (MR_Word) var, var->MR_STM_var_value, value);
+#endif
+
+ var->MR_STM_var_value = value;
+}
+
+
+void
MR_STM_write_var(MR_STM_Var *var, MR_Word value, MR_STM_TransLog *tlog)
{
+
MR_STM_TransRecord *current;
+ MR_STM_TransRecord *local_log;
MR_bool has_existing_record = MR_FALSE;
/*
@@ -130,6 +245,7 @@
current->MR_STM_tr_new_value = value;
break;
}
+
current = current->MR_STM_tr_next;
}
@@ -150,13 +266,18 @@
current_tlog = tlog;
- while (current_tlog != NULL) {
+#if defined(MR_STM_DEBUG)
+ fprintf(stderr, "STM Read: Log <%.8lx> -- var <%.8lx>\n",
+ (MR_Word) tlog, (MR_Word) var);
+#endif
- current = tlog->MR_STM_tl_records;
+ while (current_tlog != NULL) {
+ current = current_tlog->MR_STM_tl_records;
while (current != NULL) {
if (current->MR_STM_tr_var == var) {
return current->MR_STM_tr_new_value;
}
+
current = current->MR_STM_tr_next;
}
@@ -176,3 +297,84 @@
return var->MR_STM_var_value;
}
+
+void
+MR_STM_merge_transactions(MR_STM_TransLog *tlog)
+{
+ MR_STM_TransLog *parent_log;
+ MR_STM_TransRecord *parent_current;
+ MR_STM_TransRecord *current;
+ MR_bool found_tvar_in_parent;
+
+ MR_assert(tlog != NULL);
+ MR_assert(tlog->MR_STM_tl_parent != NULL);
+
+ parent_log = tlog->MR_STM_tl_parent;
+
+ current = tlog->MR_STM_tl_records;
+ while (current != NULL) {
+ found_tvar_in_parent = MR_NO;
+ parent_current = parent_log->MR_STM_tl_records;
+
+ while (parent_current != NULL) {
+ if (current->MR_STM_tr_var == parent_current->MR_STM_tr_var) {
+ parent_current->MR_STM_tr_new_value =
+ current->MR_STM_tr_new_value;
+ found_tvar_in_parent = MR_YES;
+ break;
+ }
+
+ parent_current = parent_current->MR_STM_tr_next;
+ }
+
+ if (! found_tvar_in_parent) {
+ MR_STM_record_transaction(parent_log,
+ current->MR_STM_tr_var, current->MR_STM_tr_old_value,
+ current->MR_STM_tr_new_value);
+ }
+
+ current = current->MR_STM_tr_next;
+ }
+
+#if defined(MR_STM_DEBUG)
+ fprintf(stderr, "STM: Merging log end: <0x%.8lx>\n",
+ (MR_Word) tlog);
+#endif
+
+ /* Deallocate child log */
+#if !defined(MR_CONSERVATIVE_GC)
+ /* XXX -- Free tlog and log entries */
+#endif
+}
+
+void
+MR_STM_block_thread(MR_STM_TransLog *tlog)
+{
+#if defined(MR_THREAD_SAFE)
+ #if defined(MR_HIGHLEVEL_CODE)
+ MR_STM_ConditionVar *thread_condvar;
+
+ thread_condvar = MR_GC_NEW(MR_STM_ConditionVar);
+
+ MR_STM_wait(tlog, thread_condvar);
+
+#if defined(MR_STM_DEBUG)
+ fprintf(stderr, "STM BLOCKING: log <0x%.8lx>\n", (MR_Word)tlog);
+#endif
+ MR_STM_condvar_wait(thread_condvar, &MR_STM_lock);
+ MR_UNLOCK(&MR_STM_lock, "MR_STM_block_thread");
+
+#if defined(MR_STM_DEBUG)
+ fprintf(stderr, "STM RESCHEDULING: log <0x%.8lx>\n", (MR_Word)tlog);
+#endif
+ MR_STM_unwait(tlog, thread_condvar);
+
+ MR_GC_free(thread_condvar);
+ #else
+ MR_fatal_error("Low-Level backend: Not implemented");
+ #endif
+#else
+ MR_fatal_error("Blocking thread in non-parallel grade");
+#endif
+
+}
Index: runtime/mercury_stm.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_stm.h,v
retrieving revision 1.5
diff -u -b -r1.5 mercury_stm.h
--- runtime/mercury_stm.h 17 Sep 2007 13:28:56 -0000 1.5
+++ runtime/mercury_stm.h 30 Dec 2007 15:08:44 -0000
@@ -9,6 +9,8 @@
/*
** mercury_stm.h - runtime support for software transactional memory.
+**
+** TODO: Currently, only the High Level C Grades have been fully implemented.
*/
#ifndef MERCURY_STM_H
@@ -17,14 +19,17 @@
#include "mercury_types.h"
#include "mercury_thread.h"
#include "mercury_conf.h"
+#include "mercury_conf_param.h"
#include "mercury_context.h"
#include "mercury_engine.h"
+#include <stdio.h>
typedef struct MR_STM_Waiter_Struct MR_STM_Waiter;
typedef struct MR_STM_Var_Struct MR_STM_Var;
typedef struct MR_STM_TransRecord_Struct MR_STM_TransRecord;
typedef struct MR_STM_TransLog_Struct MR_STM_TransLog;
+
/*
** The type MR_ThreadId provides an abstract means of identifying a Mercury
** thread. Depending upon the grade we use one of three notions of thread
@@ -45,6 +50,7 @@
#if defined(MR_THREAD_SAFE)
typedef pthread_t MR_ThreadId;
+
#define MR_THIS_THREAD_ID pthread_self()
#else
typedef MR_Integer MR_ThreadId;
@@ -62,19 +68,57 @@
#endif /* !MR_HIGHLEVEL_CODE */
+
+/*
+** The type MR_STM_ConditionVar provides an abstract method of blocking and
+** signalling threads based on conditions.
+*/
+#if defined(MR_HIGHLEVEL_CODE)
+
+ #if defined(MR_THREAD_SAFE)
+ typedef MercuryCond MR_STM_ConditionVar;
+
+ #define MR_STM_condvar_wait(x, y) MR_cond_wait(x, y)
+ #define MR_STM_condvar_signal(x) MR_cond_signal(x)
+ #else
+ typedef MR_Integer MR_STM_ConditionVar;
+ /*
+ ** Since these grades don't support concurrency, there is no
+ ** need to block the thread.
+ */
+ #define MR_STM_condvar_wait(x, y)
+ #define MR_STM_condvar_signal(x)
+ #endif
+
+#else /* !MR_HIGHLEVEL_CODE */
+
+ typedef MR_Context *MR_STM_ConditionVar;
+
+ /*
+ ** These are dummy definitions; STM is not yet implemented for low level C
+ ** grades.
+ */
+ #define MR_STM_condvar_wait(x, y)
+ #define MR_STM_condvar_signal(x)
+
+#endif /* !MR_HIGHLEVEL_CODE */
+
/*
** A waiter is the identity of a thread that is blocking until the value
** of this transaction variable changes.
*/
+
struct MR_STM_Waiter_Struct {
- MR_ThreadId MR_STM_waiter_thread;
+ MR_STM_ConditionVar *MR_STM_cond_var;
MR_STM_Waiter *MR_STM_waiter_next;
+ MR_STM_Waiter *MR_STM_waiter_prev;
};
/*
-** XXX this should also contain the type_info for the value, so we can
+** XXX This should also contain the type_info for the value, so we can
** print them out in the debugger.
*/
+
struct MR_STM_Var_Struct {
MR_Word MR_STM_var_value;
MR_STM_Waiter *MR_STM_var_waiters;
@@ -94,6 +138,15 @@
};
/*
+** The global STM lock. This lock must be acquired before validating or
+** committing a transaction log.
+*/
+
+#if defined(MR_THREAD_SAFE)
+ extern MercuryLock MR_STM_lock;
+#endif
+
+/*
** Allocate a new transaction variable.
*/
#define MR_STM_new_stm_var(value, var) \
@@ -105,7 +158,7 @@
/*
** Create a new transaction log.
-** If the log is for a nested transaction then the field `parent' points
+** If the log is for a nested transaction then the `parent' field points
** to the log of the enclosing transaction. It is NULL otherwise.
*/
#define MR_STM_create_log(tlog, parent) \
@@ -130,29 +183,34 @@
** given transaction log. `old_value' and `new_value' give the value
** of the transaction variable before and after the change of state.
*/
-extern void
-MR_STM_record_transaction(MR_STM_TransLog *tlog, MR_STM_Var *var,
+
+extern void MR_STM_record_transaction(MR_STM_TransLog *tlog,
+ MR_STM_Var *var,
MR_Word old_value, MR_Word new_value);
/*
** Add a waiter for the current thread to all of the transaction variables
** listed in the log.
*/
-extern void
-MR_STM_wait(MR_STM_TransLog *tlog);
+
+extern void MR_STM_wait(MR_STM_TransLog *tlog,
+ MR_STM_ConditionVar *cvar);
/*
** Detach waiters for the current thread from all of the transaction variables
** referenced by the given transaction log.
*/
-extern void
-MR_STM_unwait(MR_STM_TransLog *tlog);
+
+extern void MR_STM_unwait(MR_STM_TransLog *tlog,
+ MR_STM_ConditionVar *cvar);
/*
-** Attach a waiter for thread tid to the transaction variable.
+** Attach a waiter for thread tid to the transaction variable. The condition
+** variable should be a condition variable properly initialised and associated
+** with the thread.
*/
-extern void
-MR_STM_attach_waiter(MR_STM_Var *var, MR_ThreadId tid);
+extern void MR_STM_attach_waiter(MR_STM_Var *var, MR_ThreadId tid,
+ MR_STM_ConditionVar *cvar);
/*
** Detach any waiters for thread tid from the transaction variable.
@@ -160,33 +218,73 @@
** be found since it can only correctly be called in a situation where
** such a waiter exists.
*/
-extern void
-MR_STM_detach_waiter(MR_STM_Var *var, MR_ThreadId tid);
-extern MR_Integer
-MR_STM_validate(MR_STM_TransLog *tlog);
+extern void MR_STM_detach_waiter(MR_STM_Var *var,
+ MR_STM_ConditionVar *cvar);
+
+extern MR_Integer MR_STM_validate(MR_STM_TransLog *tlog);
/*
** Irrevocably write the changes stored in a transaction log to memory.
*/
-extern void
-MR_STM_commit(MR_STM_TransLog *tlog);
-extern void
-MR_STM_write_var(MR_STM_Var *var, MR_Word value, MR_STM_TransLog *tlog);
+extern void MR_STM_commit(MR_STM_TransLog *tlog);
-extern MR_Word
-MR_STM_read_var(MR_STM_Var *var, MR_STM_TransLog *tlog);
+/*
+** Changes the value of transaction variable var in a transaction log.
+*/
-#if defined(MR_THREAD_SAFE)
- extern MercuryLock MR_STM_lock;
-#endif
+extern void MR_STM_write_var(MR_STM_Var *var, MR_Word value,
+ MR_STM_TransLog *tlog);
+
+/*
+** Returns the value of transaction variable var in a transaction log.
+** If no entry for var exists, the actual value of the transaction variable
+** var is returned (and added to the transaction log).
+*/
+
+extern MR_Word MR_STM_read_var(MR_STM_Var *var, MR_STM_TransLog *tlog);
+
+/*
+** Changes the value of the transaction variable var without going through
+** the log.
+**
+** NOTE: This functions must only be used for debugging purposes and will
+** eventually be removed. Please, DO NOT use it for normal operations.
+*/
+
+extern void MR_STM_unsafe_write_var(MR_STM_Var *var, MR_Word value);
+
+/*
+** Blocks a thread from execution. This method is called by the thread
+** which is to be blocked. The STM lock MUST be aquired by the thread
+** before this method is called and acquires the lock when the thread
+** is signalled.
+*/
+
+extern void MR_STM_block_thread(MR_STM_TransLog *tlog);
+
+/*
+** Merges a transaction log with its parent. Do not merge it with any
+** other ancestors. Aborts if the given transaction log does not have a
+** parent.
+*/
+
+extern void MR_STM_merge_transactions(MR_STM_TransLog *tlog);
+
+/*
+** Reschedules all threads currently waiting on the given transaction
+** variables.
+*/
+
+extern void MR_STM_signal_vars(MR_STM_Var *tvar);
/*
** These definitions need to be kept in sync with the definition of the type
** stm_validation_result/0 in library/stm_builtin.m. Changes here may need
** be reflected there.
*/
+
#define MR_STM_TRANSACTION_VALID 0
#define MR_STM_TRANSACTION_INVALID 1
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/standalone_c
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/solver_types
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing slice
cvs diff: Diffing ssdb
cvs diff: Diffing tests
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/string_format
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/grade_subdirs
cvs diff: Diffing tests/hard_coded
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/mmc_make
cvs diff: Diffing tests/mmc_make/lib
cvs diff: Diffing tests/par_conj
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/trailing
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
cvs diff: Diffing util
cvs diff: Diffing vim
cvs diff: Diffing vim/after
cvs diff: Diffing vim/ftplugin
cvs diff: Diffing vim/syntax
Index: vim/syntax/mercury.vim
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/vim/syntax/mercury.vim,v
retrieving revision 1.23
diff -u -b -r1.23 mercury.vim
--- vim/syntax/mercury.vim 20 Aug 2007 03:39:31 -0000 1.23
+++ vim/syntax/mercury.vim 10 Jan 2008 14:27:13 -0000
@@ -42,6 +42,7 @@
syn keyword mercuryKeyword cc_nondet cc_multi
syn keyword mercuryKeyword typeclass instance where
syn keyword mercuryKeyword pragma promise external
+syn keyword mercuryKeyword trace atomic or_else
syn keyword mercuryPragma inline no_inline
syn keyword mercuryPragma type_spec source_file fact_table obsolete
syn keyword mercuryPragma memo loop_check minimal_model
--------------------------------------------------------------------------
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