[m-rev.] for review: from_ground_term_construct
Zoltan Somogyi
zs at csse.unimelb.edu.au
Fri Dec 12 17:43:18 AEDT 2008
On 12-Dec-2008, Zoltan Somogyi <zs at csse.unimelb.edu.au> wrote:
> As mentioned on mercury-developers, I would like everyone to review their
> own modules. I am also looking for volunteers for reviewing the modules
> that noone who is around these days owns.
>
> Read the diff to hlds_goal.m first; without it, the rest won't be full sense.
>
> The diff was done with -b, so the indentation may not seem like it is ok,
> but it is. (Without -b, the diff would be even bigger.) You can't apply
> a -b diff and get something readable, so the full workspace is available
> at /home/taura/workspaces/zs/ws74.
>
> There is one issue marked XXX below; I will fix it before commit.
Here is the actual diff.
Zoltan.
cvs diff: Diffing .
cvs diff: Diffing analysis
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/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/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/Mmakefile,v
retrieving revision 1.100
diff -u -b -r1.100 Mmakefile
--- compiler/Mmakefile 18 Sep 2008 13:24:14 -0000 1.100
+++ compiler/Mmakefile 7 Dec 2008 07:44:21 -0000
@@ -265,6 +265,9 @@
check: $(MC_PROG).check
.PHONY: ints
+int3s: $(MC_PROG).int3s
+
+.PHONY: ints
ints: $(MC_PROG).ints
#-----------------------------------------------------------------------------#
Index: compiler/add_heap_ops.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_heap_ops.m,v
retrieving revision 1.38
diff -u -b -r1.38 add_heap_ops.m
--- compiler/add_heap_ops.m 21 Jan 2008 00:32:46 -0000 1.38
+++ compiler/add_heap_ops.m 11 Dec 2008 15:53:48 -0000
@@ -187,7 +187,11 @@
goal_expr_add_heap_ops(NewOuterGoal, OuterGoalInfo, Goal, !Info)
;
GoalExpr0 = scope(Reason, SubGoal0),
- goal_add_heap_ops(SubGoal0, SubGoal, !Info),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ SubGoal = SubGoal0
+ ;
+ goal_add_heap_ops(SubGoal0, SubGoal, !Info)
+ ),
GoalExpr = scope(Reason, SubGoal),
Goal = hlds_goal(GoalExpr, GoalInfo0)
;
Index: compiler/add_trail_ops.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_trail_ops.m,v
retrieving revision 1.50
diff -u -b -r1.50 add_trail_ops.m
--- compiler/add_trail_ops.m 21 Jan 2008 00:32:46 -0000 1.50
+++ compiler/add_trail_ops.m 12 Dec 2008 01:29:05 -0000
@@ -262,6 +262,12 @@
GoalExpr =
conj(plain_conj, [MarkTicketStackGoal, StoreTicketGoal, Goal3])
;
+ Reason = from_ground_term(_, from_ground_term_construct)
+ ->
+ % The scope has no goals that either create choice points
+ % or allocate dynamic terms.
+ GoalExpr = scope(Reason, InnerGoal0)
+ ;
goal_add_trail_ops(InnerGoal0, InnerGoal, !Info),
GoalExpr = scope(Reason, InnerGoal)
),
Index: compiler/assertion.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/assertion.m,v
retrieving revision 1.62
diff -u -b -r1.62 assertion.m
--- compiler/assertion.m 21 Jul 2008 03:10:06 -0000 1.62
+++ compiler/assertion.m 11 Dec 2008 15:53:48 -0000
@@ -560,7 +560,8 @@
equal_vars(VarsA, VarsB, !Subst).
equal_reason(barrier(Removable), barrier(Removable), !Subst).
equal_reason(commit(ForcePruning), commit(ForcePruning), !Subst).
-equal_reason(from_ground_term(VarA), from_ground_term(VarB), !Subst) :-
+equal_reason(from_ground_term(VarA, Kind), from_ground_term(VarB, Kind),
+ !Subst) :-
equal_var(VarA, VarB, !Subst).
:- pred equal_goals_shorthand(shorthand_goal_expr::in, shorthand_goal_expr::in,
Index: compiler/closure_analysis.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/closure_analysis.m,v
retrieving revision 1.17
diff -u -b -r1.17 closure_analysis.m
--- compiler/closure_analysis.m 27 Feb 2008 07:23:03 -0000 1.17
+++ compiler/closure_analysis.m 11 Dec 2008 15:53:48 -0000
@@ -337,9 +337,13 @@
!.ClosureInfo, _),
Goal = hlds_goal(negation(NegatedGoal), GoalInfo).
process_goal(VarTypes, ModuleInfo, Goal0, Goal, !ClosureInfo) :-
- Goal0 = hlds_goal(scope(Reason, ScopedGoal0), GoalInfo),
- process_goal(VarTypes, ModuleInfo, ScopedGoal0, ScopedGoal, !ClosureInfo),
- Goal = hlds_goal(scope(Reason, ScopedGoal), GoalInfo).
+ Goal0 = hlds_goal(scope(Reason, SubGoal0), GoalInfo),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ SubGoal = SubGoal0
+ ;
+ process_goal(VarTypes, ModuleInfo, SubGoal0, SubGoal, !ClosureInfo)
+ ),
+ Goal = hlds_goal(scope(Reason, SubGoal), GoalInfo).
process_goal(VarTypes, ModuleInfo, Goal0, Goal, !ClosureInfo) :-
Goal0 = hlds_goal(if_then_else(ExistQVars, Cond0, Then0, Else0), GoalInfo),
process_goal(VarTypes, ModuleInfo, Cond0, Cond, !.ClosureInfo, CondInfo),
@@ -369,7 +373,6 @@
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.177
diff -u -b -r1.177 code_gen.m
--- compiler/code_gen.m 28 Nov 2008 06:36:57 -0000 1.177
+++ compiler/code_gen.m 11 Dec 2008 15:53:48 -0000
@@ -96,7 +96,7 @@
HasSubGoals = goal_expr_has_subgoals(GoalExpr),
pre_goal_update(GoalInfo, HasSubGoals, !CI),
get_instmap(!.CI, InstMap),
- ( instmap.is_reachable(InstMap) ->
+ ( instmap_is_reachable(InstMap) ->
CodeModel = goal_info_get_code_model(GoalInfo),
% Sanity check: code of some code models should occur
% only in limited contexts.
@@ -314,7 +314,7 @@
generate_goals([Goal | Goals], CodeModel, Code, !CI) :-
generate_goal(CodeModel, Goal, Code1, !CI),
get_instmap(!.CI, Instmap),
- ( instmap.is_unreachable(Instmap) ->
+ ( instmap_is_unreachable(Instmap) ->
Code = Code1
;
generate_goals(Goals, CodeModel, Code2, !CI),
Index: compiler/code_info.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/code_info.m,v
retrieving revision 1.368
diff -u -b -r1.368 code_info.m
--- compiler/code_info.m 28 Nov 2008 06:36:58 -0000 1.368
+++ compiler/code_info.m 11 Dec 2008 15:53:48 -0000
@@ -1257,7 +1257,7 @@
code_util.max_mentioned_abs_reg(AbsLocs, MaxMentionedReg),
set_follow_vars(abs_follow_vars(FollowVarsMap, MaxMentionedReg + 1), !CI),
get_instmap(!.CI, InstMap),
- ( instmap.is_reachable(InstMap) ->
+ ( instmap_is_reachable(InstMap) ->
VarLocs = assoc_list.map_values(key_abs_locn_to_lval, AbsVarLocs),
place_vars(VarLocs, Code, !CI)
;
Index: compiler/const_prop.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/const_prop.m,v
retrieving revision 1.45
diff -u -b -r1.45 const_prop.m
--- compiler/const_prop.m 7 Aug 2007 07:09:49 -0000 1.45
+++ compiler/const_prop.m 11 Dec 2008 15:53:48 -0000
@@ -83,7 +83,7 @@
module_info_get_globals(ModuleInfo, Globals),
globals.lookup_bool_option(Globals, cross_compiling, CrossCompiling),
LookupArgs = (func(Var) = arg_hlds_info(Var, Type, Inst) :-
- instmap.lookup_var(InstMap, Var, Inst),
+ instmap_lookup_var(InstMap, Var, Inst),
Type = VarTypes ^ det_elem(Var)
),
ArgHldsInfos = list.map(LookupArgs, Args),
@@ -561,7 +561,8 @@
make_assignment_goal(OutputArg, InputArg, Goal, !GoalInfo) :-
make_assignment(OutputArg, InputArg, Goal),
Delta0 = goal_info_get_instmap_delta(!.GoalInfo),
- instmap_delta_set(OutputArg ^ arg_var, InputArg ^ arg_inst, Delta0, Delta),
+ instmap_delta_set_var(OutputArg ^ arg_var, InputArg ^ arg_inst,
+ Delta0, Delta),
goal_info_set_instmap_delta(Delta, !GoalInfo),
goal_info_set_determinism(detism_det, !GoalInfo).
@@ -571,8 +572,8 @@
make_construction_goal(OutputArg, Cons, Goal, !GoalInfo) :-
make_construction(OutputArg, Cons, Goal),
Delta0 = goal_info_get_instmap_delta(!.GoalInfo),
- instmap_delta_set(OutputArg ^ arg_var, bound(unique,
- [bound_functor(Cons, [])]), Delta0, Delta),
+ instmap_delta_set_var(OutputArg ^ arg_var,
+ bound(unique, [bound_functor(Cons, [])]), Delta0, Delta),
goal_info_set_instmap_delta(Delta, !GoalInfo),
goal_info_set_determinism(detism_det, !GoalInfo).
Index: compiler/constraint.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/constraint.m,v
retrieving revision 1.91
diff -u -b -r1.91 constraint.m
--- compiler/constraint.m 27 Feb 2008 07:23:03 -0000 1.91
+++ compiler/constraint.m 11 Dec 2008 15:53:48 -0000
@@ -116,7 +116,7 @@
),
InstMap0 = !.Info ^ constr_instmap,
propagate_conj_sub_goal_2(Goal0, Constraints, Goals, !Info),
- !:Info = !.Info ^ constr_instmap := InstMap0.
+ !Info ^ constr_instmap := InstMap0.
:- pred propagate_conj_sub_goal_2(hlds_goal::in, list(constraint)::in,
list(hlds_goal)::out, constraint_info::in, constraint_info::out) is det.
@@ -164,7 +164,8 @@
GoalExpr = scope(Reason, SubGoal0),
(
( Reason = exist_quant(_)
- ; Reason = from_ground_term(_)
+ ; Reason = from_ground_term(_, from_ground_term_deconstruct)
+ ; Reason = from_ground_term(_, from_ground_term_other)
),
propagate_goal(SubGoal0, Constraints, SubGoal, !Info),
FinalGoals = [hlds_goal(scope(Reason, SubGoal), GoalInfo)]
@@ -181,6 +182,12 @@
flatten_constraints(Constraints, ConstraintGoals),
FinalGoals = [hlds_goal(scope(Reason, SubGoal), GoalInfo) |
ConstraintGoals]
+ ;
+ Reason = from_ground_term(_, from_ground_term_construct),
+ % There is no point in either propagating constraints into these
+ % scopes or propagating local constraints within these scopes.
+ flatten_constraints(Constraints, ConstraintGoals),
+ FinalGoals = [hlds_goal(GoalExpr, GoalInfo) | ConstraintGoals]
)
;
GoalExpr = negation(NegGoal0),
@@ -296,41 +303,40 @@
instmap_changed_vars(InstMap0, InstMap, VarTypes,
ModuleInfo, ChangedVars0),
- instmap.vars_list(InstMap, InstMapVars),
- %
- % Restrict the set of changed variables down to the set for
- % which the new inst is not an acceptable substitute for the
- % old. This is done to allow reordering of a goal which uses a
- % variable with inst `ground(shared, no)' with a constraint
- % which just adds information, changing the inst to
- % `bound(shared, ...)'.
- %
- InCompatible = (pred(Var::in) is semidet :-
- instmap.lookup_var(InstMap0, Var, InstBefore),
+ instmap_vars_list(InstMap, InstMapVars),
+
+ % Restrict the set of changed variables down to the set for which
+ % the new inst is not an acceptable substitute for the old. This is done
+ % to allow reordering of a goal which uses a variable with inst
+ % `ground(shared, no)' with a constraint which just adds information,
+ % changing the inst to `bound(shared, ...)'.
+
+ InCompatible =
+ (pred(Var::in) is semidet :-
+ instmap_lookup_var(InstMap0, Var, InstBefore),
instmap_delta_search_var(InstMapDelta, Var, InstAfter),
\+ inst_matches_initial(InstAfter, InstBefore,
map.lookup(VarTypes, Var), ModuleInfo)
),
IncompatibleInstVars = set.list_to_set(
list.filter(InCompatible, InstMapVars)),
- %
- % This will consider variables with inst `any' to be bound by
- % the goal, so goals which have non-locals with inst `any' will
- % not be considered to be constraints. XXX This is too conservative.
- %
- Bound = (pred(Var::in) is semidet :-
- instmap.lookup_var(InstMap0, Var, InstBefore),
+
+ % This will consider variables with inst `any' to be bound by the goal,
+ % so goals which have non-locals with inst `any' will not be considered
+ % to be constraints. XXX This is too conservative.
+
+ Bound =
+ (pred(Var::in) is semidet :-
+ instmap_lookup_var(InstMap0, Var, InstBefore),
instmap_delta_search_var(InstMapDelta, Var, InstAfter),
\+ inst_matches_binding(InstAfter, InstBefore,
map.lookup(VarTypes, Var), ModuleInfo)
),
BoundVars = set.list_to_set(list.filter(Bound, InstMapVars)),
- %
- % Make sure that variables with inst `any' are placed in
- % the changed vars set. XXX This is too conservative, but
- % avoids unexpected reorderings.
- %
+ % Make sure that variables with inst `any' are placed in the changed vars
+ % set. XXX This is too conservative, but avoids unexpected reorderings.
+
set.union(ChangedVars0, BoundVars, ChangedVars),
AnnotatedConjunct = annotated_conjunct(Goal, ChangedVars, BoundVars,
Index: compiler/continuation_info.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/continuation_info.m,v
retrieving revision 1.95
diff -u -b -r1.95 continuation_info.m
--- compiler/continuation_info.m 18 Mar 2008 02:09:30 -0000 1.95
+++ compiler/continuation_info.m 11 Dec 2008 15:53:48 -0000
@@ -755,7 +755,7 @@
;
Name = ""
),
- instmap.lookup_var(InstMap, Var, Inst),
+ instmap_lookup_var(InstMap, Var, Inst),
map.lookup(VarTypes, Var, Type),
( inst_match.inst_is_ground(ModuleInfo, Inst) ->
LldsInst = llds_inst_ground
@@ -798,7 +798,7 @@
[ArgInfo | ArgInfos], [Layout | Layouts], InstMap,
!VarLocs, !TypeVars) :-
ArgInfo = arg_info(ArgLoc, _ArgMode),
- instmap.lookup_var(InstMap, Var, Inst),
+ instmap_lookup_var(InstMap, Var, Inst),
Layout = closure_arg_info(Type, Inst),
set.singleton_set(Locations, reg(reg_r, ArgLoc)),
svmap.det_insert(Var, Locations, !VarLocs),
Index: compiler/cse_detection.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/cse_detection.m,v
retrieving revision 1.118
diff -u -b -r1.118 cse_detection.m
--- compiler/cse_detection.m 21 Jul 2008 03:10:06 -0000 1.118
+++ compiler/cse_detection.m 11 Dec 2008 15:53:48 -0000
@@ -229,9 +229,8 @@
InstMap0, _InstMap, Redo).
% This version is the same as the above except that it returns
- % the resulting instmap on exit from the goal, which is
- % computed by applying the instmap delta specified in the
- % goal's goalinfo.
+ % the resulting instmap on exit from the goal, which is computed by
+ % applying the instmap delta specified in the goal's goalinfo.
%
:- pred detect_cse_in_goal_update_instmap(hlds_goal::in, hlds_goal::out,
cse_info::in, cse_info::out, instmap::in, instmap::out, bool::out) is det.
@@ -286,8 +285,14 @@
GoalExpr = negation(SubGoal)
;
GoalExpr0 = scope(Reason, SubGoal0),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ % There are no deconstructions at all inside these scopes.
+ GoalExpr = GoalExpr0,
+ Redo = no
+ ;
detect_cse_in_goal(SubGoal0, SubGoal, !CseInfo, InstMap0, Redo),
GoalExpr = scope(Reason, SubGoal)
+ )
;
GoalExpr0 = conj(ConjType, Goals0),
detect_cse_in_conj(Goals0, Goals, !CseInfo, ConjType, InstMap0, Redo),
@@ -374,7 +379,7 @@
detect_cse_in_disj([Var | Vars], Goals0, GoalInfo0, InstMap0,
!CseInfo, Redo, GoalExpr) :-
(
- instmap.lookup_var(InstMap0, Var, VarInst0),
+ instmap_lookup_var(InstMap0, Var, VarInst0),
ModuleInfo = !.CseInfo ^ csei_module_info,
% XXX We only need inst_is_bound, but leave this as it is until
% mode analysis can handle aliasing between free variables.
@@ -414,7 +419,7 @@
InstMap0, !CseInfo, Redo, GoalExpr) :-
(
Var \= SwitchVar,
- instmap.lookup_var(InstMap0, Var, VarInst0),
+ instmap_lookup_var(InstMap0, Var, VarInst0),
ModuleInfo = !.CseInfo ^ csei_module_info,
% XXX We only need inst_is_bound, but leave this as it is until
% mode analysis can handle aliasing between free variables.
@@ -457,7 +462,7 @@
InstMap, !CseInfo, Redo, GoalExpr) :-
(
ModuleInfo = !.CseInfo ^ csei_module_info,
- instmap.lookup_var(InstMap, Var, VarInst0),
+ instmap_lookup_var(InstMap, Var, VarInst0),
% XXX We only need inst_is_bound, but leave this as it is until
% mode analysis can handle aliasing between free variables.
inst_is_ground_or_any(ModuleInfo, VarInst0),
Index: compiler/dead_proc_elim.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/dead_proc_elim.m,v
retrieving revision 1.129
diff -u -b -r1.129 dead_proc_elim.m
--- compiler/dead_proc_elim.m 15 Oct 2008 04:06:02 -0000 1.129
+++ compiler/dead_proc_elim.m 11 Dec 2008 16:18:27 -0000
@@ -478,10 +478,16 @@
GoalExpr = switch(_Var, _CanFail, Cases),
dead_proc_examine_cases(Cases, CurrProc, !Queue, !Needed)
;
- ( GoalExpr = negation(SubGoal)
- ; GoalExpr = scope(_Reason, SubGoal)
- ),
+ GoalExpr = negation(SubGoal),
+ dead_proc_examine_goal(SubGoal, CurrProc, !Queue, !Needed)
+ ;
+ GoalExpr = scope(Reason, SubGoal),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ % The scope has no references to procedures at all.
+ true
+ ;
dead_proc_examine_goal(SubGoal, CurrProc, !Queue, !Needed)
+ )
;
GoalExpr = if_then_else(_, Cond, Then, Else),
dead_proc_examine_goal(Cond, CurrProc, !Queue, !Needed),
@@ -1050,10 +1056,13 @@
),
list.foldl(ExamineCase, Cases, !DeadInfo).
pre_modecheck_examine_goal_expr(generic_call(_,_,_,_), !DeadInfo).
-pre_modecheck_examine_goal_expr(negation(Goal), !DeadInfo) :-
- pre_modecheck_examine_goal(Goal, !DeadInfo).
-pre_modecheck_examine_goal_expr(scope(_, Goal), !DeadInfo) :-
- pre_modecheck_examine_goal(Goal, !DeadInfo).
+pre_modecheck_examine_goal_expr(negation(SubGoal), !DeadInfo) :-
+ pre_modecheck_examine_goal(SubGoal, !DeadInfo).
+pre_modecheck_examine_goal_expr(scope(_, SubGoal), !DeadInfo) :-
+ % The invariants that would allow us to optimize from_ground_term_construct
+ % scopes haven't been established yet, which is why we must always scan
+ % SubGoal.
+ pre_modecheck_examine_goal(SubGoal, !DeadInfo).
pre_modecheck_examine_goal_expr(plain_call(_, _, _, _, _, PredName),
!DeadInfo) :-
dead_pred_info_add_pred_name(PredName, !DeadInfo).
Index: compiler/deep_profiling.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/deep_profiling.m,v
retrieving revision 1.94
diff -u -b -r1.94 deep_profiling.m
--- compiler/deep_profiling.m 26 Nov 2008 02:59:53 -0000 1.94
+++ compiler/deep_profiling.m 11 Dec 2008 23:59:16 -0000
@@ -426,11 +426,15 @@
figure_out_rec_call_numbers(Then, !N, !TailCallSites),
figure_out_rec_call_numbers(Else, !N, !TailCallSites)
;
- GoalExpr = scope(_, Goal1),
- figure_out_rec_call_numbers(Goal1, !N, !TailCallSites)
+ GoalExpr = negation(SubGoal),
+ figure_out_rec_call_numbers(SubGoal, !N, !TailCallSites)
+ ;
+ GoalExpr = scope(Reason, SubGoal),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ true
;
- GoalExpr = negation(Goal1),
- figure_out_rec_call_numbers(Goal1, !N, !TailCallSites)
+ figure_out_rec_call_numbers(SubGoal, !N, !TailCallSites)
+ )
;
GoalExpr = shorthand(_),
unexpected(this_file, "shorthand in figure_out_rec_call_numbers")
@@ -1064,8 +1068,13 @@
)
),
ScopedGoalPath = goal_path_add_at_end(Path, step_scope(MaybeCut)),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ SubGoal = SubGoal0,
+ AddedImpurity = no
+ ;
deep_prof_transform_goal(ScopedGoalPath, SubGoal0, SubGoal,
- AddedImpurity, !DeepInfo),
+ AddedImpurity, !DeepInfo)
+ ),
add_impurity_if_needed(AddedImpurity, GoalInfo2, GoalInfo),
(
AddForceCommit = no,
@@ -2159,6 +2168,9 @@
GoalExpr1 = negation(NegGoal)
;
GoalExpr0 = scope(Reason, ScopeGoal0),
+ % XXX We should special-case the handling of from_ground_term_construct
+ % scopes, but that would require special-casing the coverage
+ % propagation code in the deep profiler as well.
coverage_prof_second_pass_goal(ScopeGoal0, ScopeGoal,
CoverageBeforeKnown, CoverageAfterScopedGoalKnown, !Info,
AddedImpurityInner),
@@ -2790,6 +2802,9 @@
GoalExpr = negation(InnerGoal)
;
GoalExpr0 = scope(Reason, InnerGoal0),
+ % XXX We should special-case the handling of from_ground_term_construct
+ % scopes, but that would require special-casing the coverage
+ % propagation code in the deep profiler as well.
coverage_prof_first_pass(CPOptions, InnerGoal0, InnerGoal,
PortCountsCoverageAfterBefore,
dp_coverage_goal_info(Trivial0, PortCountsCoverageAfterDirect)),
Index: compiler/deforest.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/deforest.m,v
retrieving revision 1.87
diff -u -b -r1.87 deforest.m
--- compiler/deforest.m 25 Nov 2008 07:46:39 -0000 1.87
+++ compiler/deforest.m 11 Dec 2008 15:53:48 -0000
@@ -284,25 +284,31 @@
hlds_goal_info::in, hlds_goal_info::out, pd_info::in, pd_info::out,
io::di, io::uo) is det.
-deforest_goal_expr(conj(ConjType, !.Goals), conj(ConjType, !:Goals), !GoalInfo,
- !PDInfo, !IO) :-
+deforest_goal_expr(GoalExpr0, GoalExpr, !GoalInfo, !PDInfo, !IO) :-
+ (
+ GoalExpr0 = conj(ConjType, Goals0),
+ some [!Goals] (
+ !:Goals = Goals0,
(
ConjType = plain_conj,
pd_info_get_instmap(!.PDInfo, InstMap0),
- partially_evaluate_conj_goals(!.Goals, [], !:Goals, !PDInfo, !IO),
+ partially_evaluate_conj_goals(!.Goals, [], !:Goals,
+ !PDInfo, !IO),
pd_info_set_instmap(InstMap0, !PDInfo),
NonLocals = goal_info_get_nonlocals(!.GoalInfo),
- globals.io_lookup_bool_option(deforestation, Deforestation, !IO),
+ globals.io_lookup_bool_option(deforestation, Deforestation,
+ !IO),
(
Deforestation = yes,
compute_goal_infos(!Goals, !PDInfo),
pd_info_set_instmap(InstMap0, !PDInfo),
- deforest_conj(!.Goals, NonLocals, [], !:Goals, !PDInfo, !IO)
+ deforest_conj(!.Goals, NonLocals, [], !:Goals, !PDInfo,
+ !IO)
;
Deforestation = no
),
- globals.io_lookup_bool_option(constraint_propagation, Constraints,
- !IO),
+ globals.io_lookup_bool_option(constraint_propagation,
+ Constraints, !IO),
pd_info_set_instmap(InstMap0, !PDInfo),
(
Constraints = yes,
@@ -315,50 +321,56 @@
;
ConjType = parallel_conj
% XXX cannot deforest across parallel_conjunctions!
- ).
-
-deforest_goal_expr(disj(Goals0), disj(Goals), !GoalInfo, !PDInfo, !IO) :-
- deforest_disj(Goals0, Goals, !PDInfo, !IO).
-
-deforest_goal_expr(if_then_else(Vars, Cond0, Then0, Else0),
- if_then_else(Vars, Cond, Then, Else), !GoalInfo, !PDInfo, !IO) :-
+ ),
+ Goals = !.Goals
+ ),
+ GoalExpr = conj(ConjType, Goals)
+ ;
+ GoalExpr0 = disj(Goals0),
+ deforest_disj(Goals0, Goals, !PDInfo, !IO),
+ GoalExpr = disj(Goals)
+ ;
+ GoalExpr0 = if_then_else(Vars, Cond0, Then0, Else0),
pd_info_get_instmap(!.PDInfo, InstMap0),
deforest_goal(Cond0, Cond, !PDInfo, !IO),
pd_info_update_goal(Cond, !PDInfo),
deforest_goal(Then0, Then, !PDInfo, !IO),
pd_info_set_instmap(InstMap0, !PDInfo),
deforest_goal(Else0, Else, !PDInfo, !IO),
- pd_info_set_instmap(InstMap0, !PDInfo).
-
-deforest_goal_expr(switch(Var, CanFail, Cases0),
- switch(Var, CanFail, Cases), !GoalInfo, !PDInfo, !IO) :-
- deforest_cases(Var, Cases0, Cases, !PDInfo, !IO).
-
-deforest_goal_expr(GoalExpr, GoalExpr, !GoalInfo, !PDInfo, !IO) :-
- GoalExpr = call_foreign_proc(_, _, _, _, _, _, _).
-
-deforest_goal_expr(GoalExpr, GoalExpr, !GoalInfo, !PDInfo, !IO) :-
- GoalExpr = generic_call(_, _, _, _).
-
-deforest_goal_expr(negation(Goal0), negation(Goal), !GoalInfo, !PDInfo, !IO) :-
- deforest_goal(Goal0, Goal, !PDInfo, !IO).
-
-deforest_goal_expr(scope(Reason, Goal0), scope(Reason, Goal), !GoalInfo,
- !PDInfo, !IO) :-
- deforest_goal(Goal0, Goal, !PDInfo, !IO).
-
-deforest_goal_expr(GoalExpr0, GoalExpr, !GoalInfo, !PDInfo, !IO) :-
+ pd_info_set_instmap(InstMap0, !PDInfo),
+ GoalExpr = if_then_else(Vars, Cond, Then, Else)
+ ;
+ GoalExpr0 = switch(Var, CanFail, Cases0),
+ deforest_cases(Var, Cases0, Cases, !PDInfo, !IO),
+ GoalExpr = switch(Var, CanFail, Cases)
+ ;
+ GoalExpr0 = negation(SubGoal0),
+ deforest_goal(SubGoal0, SubGoal, !PDInfo, !IO),
+ GoalExpr = negation(SubGoal)
+ ;
+ GoalExpr0 = scope(Reason, SubGoal0),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ SubGoal = SubGoal0
+ ;
+ deforest_goal(SubGoal0, SubGoal, !PDInfo, !IO)
+ ),
+ GoalExpr = scope(Reason, SubGoal)
+ ;
GoalExpr0 = plain_call(PredId, ProcId, Args, BuiltinState, _, Name),
deforest_call(PredId, ProcId, Args, Name, BuiltinState,
hlds_goal(GoalExpr0, !.GoalInfo), hlds_goal(GoalExpr, !:GoalInfo),
- !PDInfo, !IO).
-
-deforest_goal_expr(GoalExpr, GoalExpr, !GoalInfo, !PDInfo, !IO) :-
- GoalExpr = unify(_, _, _, _, _).
-
-deforest_goal_expr(shorthand(_), _, !GoalInfo, !PDInfo, !IO) :-
- % these should have been expanded out by now
- unexpected(this_file, "goal: unexpected shorthand").
+ !PDInfo, !IO)
+ ;
+ ( GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _)
+ ; GoalExpr0 = generic_call(_, _, _, _)
+ ; GoalExpr = unify(_, _, _, _, _)
+ ),
+ GoalExpr = GoalExpr0
+ ;
+ GoalExpr0 = shorthand(_),
+ % These should have been expanded out by now.
+ unexpected(this_file, "goal: unexpected shorthand")
+ ).
%-----------------------------------------------------------------------------%
@@ -1358,7 +1370,7 @@
pd_debug_message("goals match, trying MSG\n", [], !IO),
pd_info_get_module_info(!.PDInfo, ModuleInfo),
pd_info_get_instmap(!.PDInfo, InstMap0),
- instmap.lookup_vars(VersionArgs, VersionInstMap, VersionInsts),
+ instmap_lookup_vars(VersionInstMap, VersionArgs, VersionInsts),
pd_util.inst_list_size(ModuleInfo, VersionInsts, VersionInstSizes),
set.to_sorted_list(ConjNonLocals, ConjNonLocalsList),
(
@@ -1366,7 +1378,7 @@
% of the non-locals.
try_MSG(ModuleInfo, VersionInstMap, VersionArgs, Renaming,
InstMap0, InstMap),
- instmap.lookup_vars(ConjNonLocalsList, InstMap, ArgInsts),
+ instmap_lookup_vars(InstMap, ConjNonLocalsList, ArgInsts),
pd_util.inst_list_size(ModuleInfo, ArgInsts, NewInstSizes),
NewInstSizes < VersionInstSizes
->
@@ -1387,13 +1399,13 @@
try_MSG(_, _, [], _, !InstMap).
try_MSG(ModuleInfo, VersionInstMap, [VersionArg | VersionArgs], Renaming,
!InstMap) :-
- instmap.lookup_var(VersionInstMap, VersionArg, VersionInst),
+ instmap_lookup_var(VersionInstMap, VersionArg, VersionInst),
(
map.search(Renaming, VersionArg, Arg),
- instmap.lookup_var(!.InstMap, Arg, VarInst),
+ instmap_lookup_var(!.InstMap, Arg, VarInst),
inst_MSG(VersionInst, VarInst, ModuleInfo, Inst)
->
- instmap.set(Arg, Inst, !InstMap)
+ instmap_set_var(Arg, Inst, !InstMap)
;
true
),
@@ -1785,7 +1797,7 @@
ProcArgInfo = pd_branch_info(_, LeftArgs, _),
set.member(LeftArg, LeftArgs),
list.index1_det(Args, LeftArg, Arg),
- instmap.lookup_var(InstMap, Arg, ArgInst),
+ instmap_lookup_var(InstMap, Arg, ArgInst),
inst_is_bound_to_functors(ModuleInfo, ArgInst, [_]),
% We don't attempt to deforest predicates which are
Index: compiler/delay_construct.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/delay_construct.m,v
retrieving revision 1.27
diff -u -b -r1.27 delay_construct.m
--- compiler/delay_construct.m 29 Jan 2008 04:59:38 -0000 1.27
+++ compiler/delay_construct.m 11 Dec 2008 15:53:48 -0000
@@ -92,8 +92,8 @@
:- pred delay_construct_in_goal(hlds_goal::in, instmap::in,
delay_construct_info::in, hlds_goal::out) is det.
-delay_construct_in_goal(hlds_goal(GoalExpr0, GoalInfo0), InstMap0, DelayInfo,
- Goal) :-
+delay_construct_in_goal(Goal0, InstMap0, DelayInfo, Goal) :-
+ Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
(
GoalExpr0 = conj(ConjType, Goals0),
(
@@ -152,15 +152,19 @@
Goal = hlds_goal(if_then_else(Vars, Cond, Then, Else), GoalInfo0)
;
GoalExpr0 = scope(Reason, SubGoal0),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ Goal = Goal0
+ ;
delay_construct_in_goal(SubGoal0, InstMap0, DelayInfo, SubGoal),
Goal = hlds_goal(scope(Reason, SubGoal), GoalInfo0)
+ )
;
( GoalExpr0 = generic_call(_, _, _, _)
; GoalExpr0 = plain_call(_, _, _, _, _, _)
; GoalExpr0 = unify(_, _, _, _, _)
; GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _)
),
- Goal = hlds_goal(GoalExpr0, GoalInfo0)
+ Goal = Goal0
;
GoalExpr0 = shorthand(_),
% These should have been expanded out by now.
@@ -209,9 +213,9 @@
GoalExpr0 = unify(_, _, _, Unif, _),
Unif = construct(Var, _, Args, _, _, _, _),
Args = [_ | _], % We are constructing a cell, not a constant
- instmap.lookup_var(InstMap0, Var, Inst0),
+ instmap_lookup_var(InstMap0, Var, Inst0),
inst_is_free(DelayInfo ^ dci_module_info, Inst0),
- instmap.lookup_var(InstMap1, Var, Inst1),
+ instmap_lookup_var(InstMap1, Var, Inst1),
inst_is_ground(DelayInfo ^ dci_module_info, Inst1)
->
set.insert(ConstructedVars0, Var, ConstructedVars1),
Index: compiler/delay_partial_inst.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/delay_partial_inst.m,v
retrieving revision 1.9
diff -u -b -r1.9 delay_partial_inst.m
--- compiler/delay_partial_inst.m 15 Oct 2008 04:06:02 -0000 1.9
+++ compiler/delay_partial_inst.m 11 Dec 2008 15:53:48 -0000
@@ -282,9 +282,13 @@
Goal = hlds_goal(if_then_else(Vars, Cond, Then, Else), GoalInfo0)
;
GoalExpr0 = scope(Reason, SubGoal0),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ Goal = Goal0
+ ;
delay_partial_inst_in_goal(InstMap0, SubGoal0, SubGoal,
!.ConstructMap, _, !DelayInfo),
Goal = hlds_goal(scope(Reason, SubGoal), GoalInfo0)
+ )
;
GoalExpr0 = unify(LHS, RHS0, Mode, Unify, Context),
(
Index: compiler/dep_par_conj.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/dep_par_conj.m,v
retrieving revision 1.32
diff -u -b -r1.32 dep_par_conj.m
--- compiler/dep_par_conj.m 4 Nov 2008 02:16:32 -0000 1.32
+++ compiler/dep_par_conj.m 11 Dec 2008 15:53:48 -0000
@@ -332,10 +332,14 @@
Goal = hlds_goal(GoalExpr, GoalInfo0)
;
GoalExpr0 = scope(Reason, SubGoal0),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ Goal = Goal0
+ ;
sync_dep_par_conjs_in_goal(SubGoal0, SubGoal, InstMap0, _,
!SyncInfo),
GoalExpr = scope(Reason, SubGoal),
Goal = hlds_goal(GoalExpr, GoalInfo0)
+ )
;
( GoalExpr0 = unify(_, _, _, _, _)
; GoalExpr0 = plain_call(_, _, _, _, _, _)
@@ -675,11 +679,17 @@
;
GoalExpr0 = scope(Reason, SubGoal0),
InvariantEstablished = yes,
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ % These scopes do not consume anything.
+ unexpected(this_file,
+ "insert_wait_in_goal: from_ground_term_construct")
+ ;
insert_wait_in_goal(ModuleInfo, AllowSomePathsOnly,
FutureMap, ConsumedVar, WaitedOnAllSuccessPaths0,
SubGoal0, SubGoal, !VarSet, !VarTypes),
GoalExpr = scope(Reason, SubGoal),
Goal1 = hlds_goal(GoalExpr, GoalInfo0)
+ )
;
GoalExpr0 = negation(_SubGoal0),
InvariantEstablished = yes,
@@ -983,6 +993,16 @@
unexpected(this_file, "negation binds shared variable")
;
GoalExpr0 = scope(Reason, SubGoal0),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ % Pushing the signal into the scope would invalidate the
+ % invariant that from_ground_term_construct scopes do nothing
+ % except construct a ground term. It would also be pointless,
+ % since the code generator will turn the entire scope into a
+ % single assignment statement. We therefore put he signal
+ % *after* the scope.
+ insert_signal_after_goal(ModuleInfo, FutureMap, ProducedVar,
+ Goal0, Goal, !VarSet, !VarTypes)
+ ;
SubGoal0 = hlds_goal(_, SubGoalInfo0),
Detism0 = goal_info_get_determinism(GoalInfo0),
SubDetism0 = goal_info_get_determinism(SubGoalInfo0),
@@ -993,11 +1013,12 @@
MaxSolns0 \= at_most_many
->
% The value of ProducedVar is not stable inside SubGoal0,
- % i.e. SubGoal0 can generate a value for ProducedVar and then
- % backtrack over the goal that generated it. In such cases,
- % we can signal the availability of ProducedVar only when it
- % has become stable, which is when the scope has cut away
- % any possibility of further backtracking inside SubGoal0.
+ % i.e. SubGoal0 can generate a value for ProducedVar and
+ % then backtrack over the goal that generated it. In such
+ % cases, we can signal the availability of ProducedVar
+ % only when it has become stable, which is when the scope
+ % has cut away any possibility of further backtracking
+ % inside SubGoal0.
insert_signal_after_goal(ModuleInfo, FutureMap, ProducedVar,
Goal0, Goal, !VarSet, !VarTypes)
;
@@ -1006,6 +1027,7 @@
GoalExpr = scope(Reason, SubGoal),
Goal = hlds_goal(GoalExpr, GoalInfo0)
)
+ )
;
( GoalExpr0 = unify(_, _, _, _, _)
; GoalExpr0 = plain_call(_, _, _, _, _, _)
@@ -1432,9 +1454,15 @@
Goal = hlds_goal(GoalExpr, GoalInfo0)
;
GoalExpr0 = scope(Reason, SubGoal0),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ % We don't pu either wait or signal operations in such scopes,
+ % so there is nothing to specialize.
+ Goal = Goal0
+ ;
specialize_sequences_in_goal(SubGoal0, SubGoal, !SpecInfo),
GoalExpr = scope(Reason, SubGoal),
Goal = hlds_goal(GoalExpr, GoalInfo0)
+ )
;
( GoalExpr0 = unify(_, _, _, _, _)
; GoalExpr0 = plain_call(_, _, _, _, _, _)
@@ -2130,11 +2158,19 @@
cost_before_wait_components(Wait, Seen, Cost)
)
;
- ( GoalExpr = negation(SubGoal)
- ; GoalExpr = scope(_Reason, SubGoal)
- ),
+ GoalExpr = negation(SubGoal),
should_we_push_wait(Var, SubGoal, Wait)
;
+ GoalExpr = scope(Reason, SubGoal),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ % The SubGoal may be huge, but since the code generator will
+ % turn it all into a single assignment of a pointer to a large
+ % static data structure, its cost in execution time is negligible.
+ Wait = not_seen_wait_negligible_cost_so_far
+ ;
+ should_we_push_wait(Var, SubGoal, Wait)
+ )
+ ;
GoalExpr = shorthand(_),
unexpected(this_file, "should_we_push_wait: shorthand")
).
@@ -2359,8 +2395,16 @@
unexpected(this_file, "seen_signal_non_negligible_cost_after")
)
;
- GoalExpr = scope(_Reason, SubGoal),
+ GoalExpr = scope(Reason, SubGoal),
+ ( Reason = from_ground_term(TermVar, from_ground_term_construct) ->
+ ( Var = TermVar ->
+ seen_produced_var(!Signal)
+ ;
+ true
+ )
+ ;
should_we_push_signal(Var, SubGoal, !Signal)
+ )
;
GoalExpr = shorthand(_),
unexpected(this_file, "should_we_push_signal: shorthand")
@@ -2678,7 +2722,7 @@
% Keep only nonlocals which were not already bound at the start of the
% parallel conjunction.
Filter = (pred(Var::in) is semidet :-
- instmap.lookup_var(InstMap, Var, VarInst),
+ instmap_lookup_var(InstMap, Var, VarInst),
not inst_is_bound(ModuleInfo, VarInst)
),
UnboundNonlocals = set.filter(Filter, Nonlocals),
Index: compiler/dependency_graph.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/dependency_graph.m,v
retrieving revision 1.100
diff -u -b -r1.100 dependency_graph.m
--- compiler/dependency_graph.m 3 Apr 2008 05:26:42 -0000 1.100
+++ compiler/dependency_graph.m 11 Dec 2008 15:53:48 -0000
@@ -371,10 +371,16 @@
add_dependency_arcs_in_goal(Caller, Then, !DepGraph),
add_dependency_arcs_in_goal(Caller, Else, !DepGraph)
;
- ( GoalExpr = negation(SubGoal)
- ; GoalExpr = scope(_, SubGoal)
- ),
+ GoalExpr = negation(SubGoal),
+ add_dependency_arcs_in_goal(Caller, SubGoal, !DepGraph)
+ ;
+ GoalExpr = scope(Reason, SubGoal),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ % The scope references no predicates or procedures.
+ true
+ ;
add_dependency_arcs_in_goal(Caller, SubGoal, !DepGraph)
+ )
;
GoalExpr = generic_call(_, _, _, _)
;
Index: compiler/det_analysis.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/det_analysis.m,v
retrieving revision 1.215
diff -u -b -r1.215 det_analysis.m
--- compiler/det_analysis.m 21 Jul 2008 03:10:06 -0000 1.215
+++ compiler/det_analysis.m 11 Dec 2008 15:53:48 -0000
@@ -1669,11 +1669,25 @@
; Reason = promise_purity(_, _)
; Reason = commit(_)
; Reason = barrier(_)
- ; Reason = from_ground_term(_)
),
det_infer_goal(Goal0, Goal, InstMap0, SolnContext,
RightFailingContexts, MaybePromiseEqvSolutionSets0,
Detism, GoalFailingContexts, !DetInfo, !Specs)
+ ;
+ Reason = from_ground_term(_, FromGroundTermKind),
+ (
+ FromGroundTermKind = from_ground_term_construct,
+ Goal = Goal0,
+ Detism = detism_det,
+ GoalFailingContexts = []
+ ;
+ ( FromGroundTermKind = from_ground_term_deconstruct
+ ; FromGroundTermKind = from_ground_term_other
+ ),
+ det_infer_goal(Goal0, Goal, InstMap0, SolnContext,
+ RightFailingContexts, MaybePromiseEqvSolutionSets0,
+ Detism, GoalFailingContexts, !DetInfo, !Specs)
+ )
).
%-----------------------------------------------------------------------------%
Index: compiler/det_report.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/det_report.m,v
retrieving revision 1.143
diff -u -b -r1.143 det_report.m
--- compiler/det_report.m 27 Feb 2008 07:23:04 -0000 1.143
+++ compiler/det_report.m 11 Dec 2008 15:53:48 -0000
@@ -573,7 +573,7 @@
det_info_get_module_info(!.DetInfo, ModuleInfo),
(
(
- instmap.lookup_var(InstMap0, Var, VarInst),
+ instmap_lookup_var(InstMap0, Var, VarInst),
inst_is_bound_to_functors(ModuleInfo, VarInst, Functors)
->
functors_to_cons_ids(Functors, ConsIds)
Index: compiler/det_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/det_util.m,v
retrieving revision 1.47
diff -u -b -r1.47 det_util.m
--- compiler/det_util.m 22 Jan 2008 15:06:09 -0000 1.47
+++ compiler/det_util.m 11 Dec 2008 15:53:48 -0000
@@ -193,7 +193,7 @@
det_no_output_vars(Vars, InstMap, InstMapDelta, DetInfo) :-
det_info_get_module_info(DetInfo, ModuleInfo),
- instmap.no_output_vars(InstMap, InstMapDelta, Vars,
+ instmap_delta_no_output_vars(InstMap, InstMapDelta, Vars,
DetInfo ^ di_vartypes, ModuleInfo).
%-----------------------------------------------------------------------------%
Index: compiler/distance_granularity.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/distance_granularity.m,v
retrieving revision 1.7
diff -u -b -r1.7 distance_granularity.m
--- compiler/distance_granularity.m 27 Feb 2008 07:23:05 -0000 1.7
+++ compiler/distance_granularity.m 11 Dec 2008 15:53:48 -0000
@@ -362,21 +362,26 @@
!:Goal = hlds_goal(GoalExpr, GoalInfo),
IsRecursiveCallInParallelConj = no
;
- GoalExpr0 = negation(Goal0),
- apply_dg_to_goal(Goal0, Goal, CallerPredId, CallerProcId,
+ GoalExpr0 = negation(SubGoal0),
+ apply_dg_to_goal(SubGoal0, SubGoal, CallerPredId, CallerProcId,
PredIdSpecialized, SymNameSpecialized, !ProcInfo, !ModuleInfo,
Distance, IsInParallelConj, !MaybeGranularityVar,
IsRecursiveCallInParallelConj),
- GoalExpr = negation(Goal),
+ GoalExpr = negation(SubGoal),
!:Goal = hlds_goal(GoalExpr, GoalInfo)
;
- GoalExpr0 = scope(Reason, Goal0),
- apply_dg_to_goal(Goal0, Goal, CallerPredId, CallerProcId,
+ GoalExpr0 = scope(Reason, SubGoal0),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ % Return !.Goal as !:Goal.
+ IsRecursiveCallInParallelConj = no
+ ;
+ apply_dg_to_goal(SubGoal0, SubGoal, CallerPredId, CallerProcId,
PredIdSpecialized, SymNameSpecialized, !ProcInfo, !ModuleInfo,
Distance, IsInParallelConj, !MaybeGranularityVar,
IsRecursiveCallInParallelConj),
- GoalExpr = scope(Reason, Goal),
+ GoalExpr = scope(Reason, SubGoal),
!:Goal = hlds_goal(GoalExpr, GoalInfo)
+ )
;
GoalExpr0 = if_then_else(Vars, Cond0, Then0, Else0),
apply_dg_to_goal(Cond0, Cond, CallerPredId, CallerProcId,
@@ -583,10 +588,10 @@
% Var has instmap bound(Distance).
InstMapDelta0 = goal_info_get_instmap_delta(GoalInfo0),
- MerInst = bound(shared, [bound_functor(int_const(Distance),
- [])]),
- instmap_delta_insert(Var, MerInst, InstMapDelta0,
- InstMapDelta),
+ MerInst = bound(shared,
+ [bound_functor(int_const(Distance), [])]),
+ instmap_delta_insert_var(Var, MerInst,
+ InstMapDelta0, InstMapDelta),
goal_info_set_instmap_delta(InstMapDelta, GoalInfo0,
GoalInfo),
@@ -730,8 +735,8 @@
CallBuiltin, CallUnifyContext, CallSymName),
InstMapDelta0 = goal_info_get_instmap_delta(GoalInfo0),
MerInst = ground(shared, none),
- instmap_delta_insert(Var, MerInst, InstMapDelta0,
- InstMapDelta),
+ instmap_delta_insert_var(Var, MerInst,
+ InstMapDelta0, InstMapDelta),
goal_info_set_instmap_delta(InstMapDelta, GoalInfo0,
GoalInfo),
Goal = hlds_goal(GoalExpr, GoalInfo),
@@ -908,17 +913,24 @@
GoalExpr = switch(Var, CanFail, Cases),
!:Goal = hlds_goal(GoalExpr, GoalInfo)
;
- GoalExpr0 = negation(Goal0),
- update_original_predicate_goal(Goal0, Goal, CallerPredId, CallerProcId,
- PredIdSpecialized, SymNameSpecialized, !ProcInfo, Distance),
- GoalExpr = negation(Goal),
+ GoalExpr0 = negation(SubGoal0),
+ update_original_predicate_goal(SubGoal0, SubGoal,
+ CallerPredId, CallerProcId, PredIdSpecialized, SymNameSpecialized,
+ !ProcInfo, Distance),
+ GoalExpr = negation(SubGoal),
!:Goal = hlds_goal(GoalExpr, GoalInfo)
;
- GoalExpr0 = scope(Reason, Goal0),
- update_original_predicate_goal(Goal0, Goal, CallerPredId, CallerProcId,
+ GoalExpr0 = scope(Reason, SubGoal0),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ % Leave !Goal as it is.
+ true
+ ;
+ update_original_predicate_goal(SubGoal0, SubGoal,
+ CallerPredId, CallerProcId,
PredIdSpecialized, SymNameSpecialized, !ProcInfo, Distance),
- GoalExpr = scope(Reason, Goal),
+ GoalExpr = scope(Reason, SubGoal),
!:Goal = hlds_goal(GoalExpr, GoalInfo)
+ )
;
GoalExpr0 = if_then_else(Vars, Cond0, Then0, Else0),
update_original_predicate_goal(Cond0, Cond, CallerPredId, CallerProcId,
@@ -976,7 +988,7 @@
goal_info_set_nonlocals(NonLocals, CallInfo0, CallInfo1),
InstMapDelta0 = goal_info_get_instmap_delta(CallInfo1),
MerInst = ground(shared, none),
- instmap_delta_insert(Var, MerInst, InstMapDelta0, InstMapDelta),
+ instmap_delta_insert_var(Var, MerInst, InstMapDelta0, InstMapDelta),
goal_info_set_instmap_delta(InstMapDelta, CallInfo1, CallInfo),
Call = hlds_goal(CallExpr, CallInfo),
Index: compiler/equiv_type_hlds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/equiv_type_hlds.m,v
retrieving revision 1.51
diff -u -b -r1.51 equiv_type_hlds.m
--- compiler/equiv_type_hlds.m 27 Feb 2008 07:23:05 -0000 1.51
+++ compiler/equiv_type_hlds.m 11 Dec 2008 15:53:48 -0000
@@ -723,8 +723,8 @@
`with_type` replacer(hlds_goal, replace_info)
`with_inst` replacer.
-replace_in_goal(EqvMap, Goal0 @ hlds_goal(GoalExpr0, GoalInfo0), Goal,
- Changed, !Info) :-
+replace_in_goal(EqvMap, Goal0, Goal, Changed, !Info) :-
+ Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
replace_in_goal_expr(EqvMap, GoalExpr0, GoalExpr, Changed0, !Info),
InstMapDelta0 = goal_info_get_instmap_delta(GoalInfo0),
@@ -764,53 +764,62 @@
`with_type` replacer(hlds_goal_expr, replace_info)
`with_inst` replacer.
-replace_in_goal_expr(EqvMap, GoalExpr0 @ conj(ConjType, Goals0), GoalExpr,
- Changed, !Info) :-
+replace_in_goal_expr(EqvMap, GoalExpr0, GoalExpr, Changed, !Info) :-
+ (
+ GoalExpr0 = conj(ConjType, Goals0),
replace_in_list(replace_in_goal(EqvMap), Goals0, Goals,
Changed, !Info),
( Changed = yes, GoalExpr = conj(ConjType, Goals)
; Changed = no, GoalExpr = GoalExpr0
- ).
-replace_in_goal_expr(EqvMap, GoalExpr0 @ disj(Goals0), GoalExpr,
- Changed, !Info) :-
+ )
+ ;
+ GoalExpr0 = disj(Goals0),
replace_in_list(replace_in_goal(EqvMap), Goals0, Goals,
Changed, !Info),
( Changed = yes, GoalExpr = disj(Goals)
; Changed = no, GoalExpr = GoalExpr0
- ).
-replace_in_goal_expr(EqvMap, GoalExpr0 @ switch(A, B, Cases0), GoalExpr,
- Changed, !Info) :-
- replace_in_list(replace_in_case(EqvMap), Cases0, Cases, Changed, !Info),
- ( Changed = yes, GoalExpr = switch(A, B, Cases)
+ )
+ ;
+ GoalExpr0 = switch(Var, CanFail, Cases0),
+ replace_in_list(replace_in_case(EqvMap), Cases0, Cases,
+ Changed, !Info),
+ ( Changed = yes, GoalExpr = switch(Var, CanFail, Cases)
; Changed = no, GoalExpr = GoalExpr0
- ).
-replace_in_goal_expr(EqvMap, GoalExpr0 @ negation(NegGoal0), GoalExpr, Changed,
- !Info) :-
+ )
+ ;
+ GoalExpr0 = negation(NegGoal0),
replace_in_goal(EqvMap, NegGoal0, NegGoal, Changed, !Info),
( Changed = yes, GoalExpr = negation(NegGoal)
; Changed = no, GoalExpr = GoalExpr0
- ).
-replace_in_goal_expr(EqvMap, GoalExpr0 @ scope(Reason, SomeGoal0), GoalExpr,
- Changed, !Info) :-
+ )
+ ;
+ GoalExpr0 = scope(Reason, SomeGoal0),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ % The code in modes.m sets the kind to from_ground_term_construct
+ % only when SomeGoal0 does not have anything to expand.
+ GoalExpr = GoalExpr0,
+ Changed = no
+ ;
replace_in_goal(EqvMap, SomeGoal0, SomeGoal, Changed, !Info),
( Changed = yes, GoalExpr = scope(Reason, SomeGoal)
; Changed = no, GoalExpr = GoalExpr0
- ).
-replace_in_goal_expr(EqvMap,
- GoalExpr0 @ if_then_else(Vars, Cond0, Then0, Else0), GoalExpr,
- Changed, !Info) :-
+ )
+ )
+ ;
+ GoalExpr0 = if_then_else(Vars, Cond0, Then0, Else0),
replace_in_goal(EqvMap, Cond0, Cond, Changed1, !Info),
replace_in_goal(EqvMap, Then0, Then, Changed2, !Info),
replace_in_goal(EqvMap, Else0, Else, Changed3, !Info),
Changed = Changed1 `or` Changed2 `or` Changed3,
( Changed = yes, GoalExpr = if_then_else(Vars, Cond, Then, Else)
; Changed = no, GoalExpr = GoalExpr0
- ).
-replace_in_goal_expr(_, GoalExpr @ plain_call(_, _, _, _, _, _), GoalExpr,
- no, !Info).
-replace_in_goal_expr(EqvMap,
- GoalExpr0 @ call_foreign_proc(_, _, _, _, _, _, _), GoalExpr,
- Changed, !Info) :-
+ )
+ ;
+ GoalExpr0 = plain_call(_, _, _, _, _, _),
+ GoalExpr = GoalExpr0,
+ Changed = no
+ ;
+ GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _),
TVarSet0 = !.Info ^ tvarset,
replace_in_foreign_arg_list(EqvMap, GoalExpr0 ^ foreign_args,
Args, ChangedArgs, TVarSet0, TVarSet1, no, _),
@@ -825,9 +834,9 @@
;
Changed = no,
GoalExpr = GoalExpr0
- ).
-replace_in_goal_expr(EqvMap, GoalExpr0 @ generic_call(A, B, Modes0, D),
- GoalExpr, Changed, !Info) :-
+ )
+ ;
+ GoalExpr0 = generic_call(Details, Args, Modes0, Detism),
TVarSet0 = !.Info ^ tvarset,
Cache0 = !.Info ^ inst_cache,
replace_in_modes(EqvMap, Modes0, Modes, Changed, TVarSet0, TVarSet,
@@ -836,13 +845,13 @@
Changed = yes,
!:Info = !.Info ^ tvarset := TVarSet,
!:Info = !.Info ^ inst_cache := Cache,
- GoalExpr = generic_call(A, B, Modes, D)
+ GoalExpr = generic_call(Details, Args, Modes, Detism)
;
Changed = no,
GoalExpr = GoalExpr0
- ).
-replace_in_goal_expr(EqvMap, GoalExpr0 @ unify(Var, _, _, _, _), GoalExpr,
- Changed, !Info) :-
+ )
+ ;
+ GoalExpr0 = unify(Var, _, _, _, _),
module_info_get_type_table(!.Info ^ module_info, Types),
proc_info_get_vartypes(!.Info ^ proc_info, VarTypes),
proc_info_get_rtti_varmaps(!.Info ^ proc_info, RttiVarMaps),
@@ -850,8 +859,8 @@
TypeCtorCat = classify_type(!.Info ^ module_info, VarType),
(
% If this goal constructs a type_info for an equivalence type,
- % we need to expand that to make the type_info for the expanded type.
- % It is simpler to just recreate the type_info from scratch.
+ % we need to expand that to make the type_info for the expanded
+ % type. It is simpler to just recreate the type_info from scratch.
GoalExpr0 ^ unify_kind = construct(_, ConsId, _, _, _, _, _),
ConsId = type_info_cell_constructor(TypeCtor),
@@ -863,8 +872,8 @@
Changed = yes,
pred_info_set_typevarset(!.Info ^ tvarset, !.Info ^ pred_info,
PredInfo0),
- create_poly_info(!.Info ^ module_info, PredInfo0, !.Info ^ proc_info,
- PolyInfo0),
+ create_poly_info(!.Info ^ module_info,
+ PredInfo0, !.Info ^ proc_info, PolyInfo0),
rtti_varmaps_var_info(RttiVarMaps, Var, VarInfo),
(
VarInfo = type_info_var(TypeInfoType0),
@@ -929,6 +938,7 @@
Changed = no,
GoalExpr = GoalExpr0
)
+ )
).
replace_in_goal_expr(EqvMap, GoalExpr0, GoalExpr, Changed, !Info) :-
GoalExpr0 = shorthand(ShortHand0),
Index: compiler/erl_code_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/erl_code_gen.m,v
retrieving revision 1.31
diff -u -b -r1.31 erl_code_gen.m
--- compiler/erl_code_gen.m 27 Feb 2008 07:23:05 -0000 1.31
+++ compiler/erl_code_gen.m 11 Dec 2008 15:53:48 -0000
@@ -632,7 +632,7 @@
( ScopeReason = exist_quant(_)
; ScopeReason = promise_purity(_, _)
; ScopeReason = barrier(_)
- ; ScopeReason = from_ground_term(_)
+ ; ScopeReason = from_ground_term(_, _)
; ScopeReason = trace_goal(_, _, _, _, _)
% Trace goals with run-time conditions are transformed into
% if-then-else goals where the condition is a special foreign_proc
@@ -1005,7 +1005,7 @@
% not bound before the place where the success expression will be
% inserted). For our purposes it doesn't matter what insts these variables
% have, other than not being free, so we just use `ground'.
- instmap.set(Var, ground(shared, none), !InstMap).
+ instmap_set_var(Var, ground(shared, none), !InstMap).
%-----------------------------------------------------------------------------%
%
Index: compiler/exception_analysis.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/exception_analysis.m,v
retrieving revision 1.51
diff -u -b -r1.51 exception_analysis.m
--- compiler/exception_analysis.m 21 Aug 2008 07:31:57 -0000 1.51
+++ compiler/exception_analysis.m 11 Dec 2008 15:53:48 -0000
@@ -279,8 +279,11 @@
% that might have user-defined equality or comparison predicate that
% throw exceptions.
%
- all [EResult] list.member(EResult, ProcResults) =>
- EResult ^ status \= may_throw(_),
+ all [EResult] (
+ list.member(EResult, ProcResults)
+ =>
+ EResult ^ status \= may_throw(_)
+ ),
some [CResult] (
list.member(CResult, ProcResults),
CResult ^ status = throw_conditional
@@ -291,9 +294,12 @@
% If none of the procedures can throw a user_exception but one or more
% can throw a type_exception then mark the SCC as maybe throwing a
% type_exception.
- %
- all [EResult] list.member(EResult, ProcResults) =>
- EResult ^ status \= may_throw(user_exception),
+
+ all [EResult] (
+ list.member(EResult, ProcResults)
+ =>
+ EResult ^ status \= may_throw(user_exception)
+ ),
some [TResult] (
list.member(TResult, ProcResults),
TResult ^ status = may_throw(type_exception)
@@ -364,21 +370,89 @@
hlds_goal_expr::in, hlds_goal_info::in, proc_result::in, proc_result::out,
module_info::in, module_info::out) is det.
-check_goal_for_exceptions_2(_, _, Goal, _, !Result, !ModuleInfo) :-
- Goal = unify(_, _, _, Kind, _),
+check_goal_for_exceptions_2(SCC, VarTypes, GoalExpr, GoalInfo,
+ !Result, !ModuleInfo) :-
+ (
+ GoalExpr = unify(_, _, _, Kind, _),
(
Kind = complicated_unify(_, _, _),
- unexpected(this_file, "complicated unify during exception analysis.")
+ unexpected(this_file,
+ "complicated unify during exception analysis.")
;
( Kind = construct(_, _, _, _, _, _, _)
; Kind = deconstruct(_, _, _, _, _, _)
; Kind = assign(_, _)
; Kind = simple_test(_, _)
)
+ )
+ ;
+ GoalExpr = plain_call(CallPredId, CallProcId, Args, _, _, _),
+ check_goal_for_exceptions_plain_call(SCC, VarTypes,
+ CallPredId, CallProcId, Args, !Result, !ModuleInfo)
+ ;
+ GoalExpr = generic_call(Details, Args, _, _),
+ check_goal_for_exceptions_generic_call(VarTypes, Details, Args,
+ GoalInfo, !Result, !ModuleInfo)
+ ;
+ GoalExpr = call_foreign_proc(Attributes, _, _, _, _, _, _),
+
+ % NOTE: for --intermodule-analysis the results for for foreign_procs
+ % will *always* be optimal (since we always rely on user annotation),
+ % so there's nothing to do here.
+ MayCallMercury = get_may_call_mercury(Attributes),
+ (
+ MayCallMercury = proc_may_call_mercury,
+ get_may_throw_exception(Attributes) = MayThrowException,
+ % We do not need to deal with erroneous predicates here because
+ % they will have already been processed.
+ (
+ MayThrowException = default_exception_behaviour,
+ !Result ^ status := may_throw(user_exception)
+ ;
+ MayThrowException = proc_will_not_throw_exception
+ )
+ ;
+ MayCallMercury = proc_will_not_call_mercury
+ )
+ ;
+ ( GoalExpr = disj(Goals)
+ ; GoalExpr = conj(_, Goals)
+ ),
+ check_goals_for_exceptions(SCC, VarTypes, Goals, !Result, !ModuleInfo)
+ ;
+ GoalExpr = switch(_, _, Cases),
+ CaseGoals = list.map((func(case(_, _, CaseGoal)) = CaseGoal), Cases),
+ check_goals_for_exceptions(SCC, VarTypes, CaseGoals, !Result,
+ !ModuleInfo)
+ ;
+ GoalExpr = if_then_else(_, If, Then, Else),
+ check_goals_for_exceptions(SCC, VarTypes, [If, Then, Else],
+ !Result, !ModuleInfo)
+ ;
+ GoalExpr = negation(SubGoal),
+ check_goal_for_exceptions(SCC, VarTypes, SubGoal, !Result, !ModuleInfo)
+ ;
+ GoalExpr = scope(Reason, SubGoal),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ true
+ ;
+ check_goal_for_exceptions(SCC, VarTypes, SubGoal, !Result,
+ !ModuleInfo)
+ )
+ ;
+ GoalExpr = 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) :-
- Goal = plain_call(CallPredId, CallProcId, CallArgs, _, _, _),
+
+:- pred check_goal_for_exceptions_plain_call(scc::in, vartypes::in,
+ pred_id::in, proc_id::in, list(prog_var)::in,
+ proc_result::in, proc_result::out, module_info::in, module_info::out)
+ is det.
+
+check_goal_for_exceptions_plain_call(SCC, VarTypes, CallPredId, CallProcId,
+ CallArgs, !Result, !ModuleInfo) :-
CallPPId = proc(CallPredId, CallProcId),
module_info_pred_info(!.ModuleInfo, CallPredId, CallPredInfo),
(
@@ -427,9 +501,14 @@
check_nonrecursive_call(VarTypes, CallPPId, CallArgs, CallPredInfo,
!Result, !ModuleInfo)
).
-check_goal_for_exceptions_2(_SCC, VarTypes, Goal, GoalInfo, !Result,
- !ModuleInfo) :-
- Goal = generic_call(Details, Args, _ArgModes, _),
+
+:- pred check_goal_for_exceptions_generic_call(vartypes::in,
+ generic_call::in, list(prog_var)::in, hlds_goal_info::in,
+ proc_result::in, proc_result::out, module_info::in, module_info::out)
+ is det.
+
+check_goal_for_exceptions_generic_call(VarTypes, Details, Args, GoalInfo,
+ !Result, !ModuleInfo) :-
module_info_get_globals(!.ModuleInfo, Globals),
globals.lookup_bool_option(Globals, intermodule_analysis,
IntermodAnalysis),
@@ -447,7 +526,7 @@
% procedures that are known not to throw exceptions.
;
ConditionalProcs = [_ | _],
- %
+
% For 'conditional' procedures we need to make sure that
% if any type variables are bound at the generic_call
% site, then this does not cause the closure to throw an
@@ -468,16 +547,16 @@
% perform a fine-grained enough analysis of where
% out-of-line unifications/comparisons occur to be able to
% do better.
- %
+
check_vars(!.ModuleInfo, VarTypes, Args,
MaybeAnalysisStatus, !Result)
)
;
MaybeWillNotThrow = may_throw,
- !:Result = !.Result ^ status := may_throw(user_exception)
+ !Result ^ status := may_throw(user_exception)
)
;
- !:Result = !.Result ^ status := may_throw(user_exception)
+ !Result ^ status := may_throw(user_exception)
)
;
% XXX We could do better with class methods.
@@ -488,54 +567,6 @@
;
Details = cast(_)
).
-check_goal_for_exceptions_2(SCC, VarTypes, negation(Goal), _,
- !Result, !ModuleInfo) :-
- check_goal_for_exceptions(SCC, VarTypes, Goal, !Result, !ModuleInfo).
-check_goal_for_exceptions_2(SCC, VarTypes, Goal, _, !Result, !ModuleInfo) :-
- Goal = scope(_, ScopeGoal),
- check_goal_for_exceptions(SCC, VarTypes, ScopeGoal, !Result,
- !ModuleInfo).
-check_goal_for_exceptions_2(_, _, Goal, _, !Result, !ModuleInfo) :-
- Goal = call_foreign_proc(Attributes, _, _, _, _, _, _),
- %
- % NOTE: for --intermodule-analysis the results for for foreign_procs will
- % *always* be optimal (since we always rely on user annotation), so
- % there's nothing to do here.
- %
- MayCallMercury = get_may_call_mercury(Attributes),
- (
- MayCallMercury = proc_may_call_mercury,
- get_may_throw_exception(Attributes) = MayThrowException,
- %
- % We do not need to deal with erroneous predicates here because they
- % will have already been processed.
- %
- (
- MayThrowException = default_exception_behaviour,
- !:Result = !.Result ^ status := may_throw(user_exception)
- ;
- MayThrowException = proc_will_not_throw_exception
- )
- ;
- 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) :-
- Goal = switch(_, _, Cases),
- CaseGoals = list.map((func(case(_, _, CaseGoal)) = CaseGoal), Cases),
- check_goals_for_exceptions(SCC, VarTypes, CaseGoals, !Result, !ModuleInfo).
-check_goal_for_exceptions_2(SCC, VarTypes, Goal, _, !Result, !ModuleInfo) :-
- Goal = if_then_else(_, If, Then, Else),
- check_goals_for_exceptions(SCC, VarTypes, [If, Then, Else],
- !Result, !ModuleInfo).
-check_goal_for_exceptions_2(SCC, VarTypes, Goal, _, !Result, !ModuleInfo) :-
- ( Goal = disj(Goals)
- ; Goal = conj(_, Goals)
- ),
- check_goals_for_exceptions(SCC, VarTypes, Goals, !Result, !ModuleInfo).
:- pred check_goals_for_exceptions(scc::in, vartypes::in,
hlds_goals::in, proc_result::in, proc_result::out,
@@ -775,8 +806,11 @@
handle_mixed_conditional_scc(Results) =
(
- all [TypeStatus] list.member(Result, Results) =>
+ all [TypeStatus] (
+ list.member(Result, Results)
+ =>
Result ^ rec_calls \= type_may_throw
+ )
->
throw_conditional
;
@@ -858,9 +892,8 @@
( is_solver_type(ModuleInfo, Type)
; is_existq_type(ModuleInfo, Type))
->
- % XXX At the moment we just assume that existential
- % types and solver types result in a type exception
- % being thrown.
+ % XXX At the moment we just assume that existential types and
+ % solver types result in a type exception being thrown.
Status = type_may_throw
;
TypeCategory = classify_type(ModuleInfo, Type),
@@ -917,9 +950,9 @@
% type_ctor can be determined by examining the exception status of the
% arguments, if any.
%
- % NOTE: this list does not need to include enumerations since they
- % are already handled above. Also, this list does not need to
- % include non-abstract equivalence types.
+ % NOTE: This list does not need to include enumerations since they
+ % are already handled above. Also, this list does not need to include
+ % non-abstract equivalence types.
%
:- pred type_ctor_is_safe(type_ctor::in) is semidet.
@@ -1256,12 +1289,12 @@
IntermodAnalysis),
globals.lookup_bool_option(Globals, analyse_exceptions,
ExceptionAnalysis),
- %
+
% If we the procedure we are calling is imported and we are using
% intermodule-analysis then we need to look up the exception status in the
% analysis registry; otherwise we look it up in the the exception_info
% table.
- %
+
UseAnalysisRegistry = IsImported `bool.and` IntermodAnalysis
`bool.and` ExceptionAnalysis,
(
Index: compiler/follow_code.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/follow_code.m,v
retrieving revision 1.95
diff -u -b -r1.95 follow_code.m
--- compiler/follow_code.m 26 Mar 2008 11:02:15 -0000 1.95
+++ compiler/follow_code.m 11 Dec 2008 15:53:48 -0000
@@ -147,9 +147,13 @@
GoalExpr = if_then_else(Vars, Cond, Then, Else),
Goal = hlds_goal(GoalExpr, GoalInfo)
;
- GoalExpr0 = scope(Remove, SubGoal0),
- move_follow_code_in_goal(SubGoal0, SubGoal, RttiVarMaps, !Changed),
- GoalExpr = scope(Remove, SubGoal),
+ GoalExpr0 = scope(Reason, SubGoal0),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ SubGoal = SubGoal0
+ ;
+ move_follow_code_in_goal(SubGoal0, SubGoal, RttiVarMaps, !Changed)
+ ),
+ GoalExpr = scope(Reason, SubGoal),
Goal = hlds_goal(GoalExpr, GoalInfo)
;
( GoalExpr0 = generic_call(_, _, _, _)
Index: compiler/follow_vars.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/follow_vars.m,v
retrieving revision 1.91
diff -u -b -r1.91 follow_vars.m
--- compiler/follow_vars.m 21 Jan 2008 00:32:47 -0000 1.91
+++ compiler/follow_vars.m 11 Dec 2008 15:53:48 -0000
@@ -197,8 +197,12 @@
GoalExpr = negation(SubGoal)
;
GoalExpr0 = scope(Reason, SubGoal0),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ SubGoal = SubGoal0
+ ;
find_follow_vars_in_goal(SubGoal0, SubGoal, VarTypes, ModuleInfo,
- !FollowVarsMap, !NextNonReserved),
+ !FollowVarsMap, !NextNonReserved)
+ ),
GoalExpr = scope(Reason, SubGoal)
;
GoalExpr0 = unify(_, _, _, Unification, _),
Index: compiler/format_call.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/format_call.m,v
retrieving revision 1.13
diff -u -b -r1.13 format_call.m
--- compiler/format_call.m 27 Feb 2008 07:23:05 -0000 1.13
+++ compiler/format_call.m 11 Dec 2008 15:53:48 -0000
@@ -443,9 +443,18 @@
!Counter, !ConjMaps, !PredMap, !RelevantVars, ModuleInfo),
svmap.det_insert(SubGoalId, CurId, !PredMap)
;
- GoalExpr = scope(_, SubGoal),
+ GoalExpr = scope(Reason, SubGoal),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ % These scopes cannot build the format string (since that is
+ % a single constant, from which we don't build such scopes),
+ % or the list of things to print (since that term won't a ground
+ % term except in degenerate cases. These scopes also cannot call
+ % anything.
+ true
+ ;
traverse_conj([SubGoal], CurId, !FormatCallSites, !Counter,
!ConjMaps, !PredMap, !RelevantVars, ModuleInfo)
+ )
;
GoalExpr = generic_call(_, _, _, _)
;
Index: compiler/goal_form.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/goal_form.m,v
retrieving revision 1.44
diff -u -b -r1.44 goal_form.m
--- compiler/goal_form.m 27 Feb 2008 07:23:05 -0000 1.44
+++ compiler/goal_form.m 11 Dec 2008 15:53:48 -0000
@@ -46,7 +46,7 @@
%-----------------------------------------------------------------------------%
%
-% These versions use information from the intermodule-analysis framework
+% These versions use information from the intermodule-analysis framework.
%
% XXX Eventually we will only use these versions and the others can be
@@ -71,7 +71,6 @@
%-----------------------------------------------------------------------------%
-%
% The first three versions may be more accurate because they can use
% results of the termination and exception analyses.
% XXX These don't work with the intermodule-analysis framework, so don't
@@ -101,10 +100,8 @@
%
:- pred goal_can_loop_or_throw(module_info::in, hlds_goal::in) is semidet.
-%
% These versions do not use the results of the termination or exception
% analyses.
-%
% Succeeds if the goal cannot loop forever or throw an exception.
%
@@ -186,7 +183,7 @@
%-----------------------------------------------------------------------------%
%
% A version of goal_cannot_loop_or_throw that uses results from the
-% intermodule-analysis framework
+% intermodule-analysis framework.
%
goal_can_throw(hlds_goal(GoalExpr, GoalInfo), Result, !ModuleInfo) :-
@@ -246,10 +243,16 @@
Result = cannot_throw
)
;
- ( GoalExpr = negation(SubGoal)
- ; GoalExpr = scope(_, SubGoal)
- ),
+ GoalExpr = negation(SubGoal),
+ goal_can_throw(SubGoal, Result, !ModuleInfo)
+ ;
+ GoalExpr = scope(Reason, SubGoal),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ % These scopes contain only construction unifications.
+ Result = cannot_throw
+ ;
goal_can_throw(SubGoal, Result, !ModuleInfo)
+ )
;
GoalExpr = call_foreign_proc(Attributes, _, _, _, _, _, _),
ExceptionStatus = get_may_throw_exception(Attributes),
@@ -434,10 +437,16 @@
CanLoop = goal_can_loop_func(MaybeModuleInfo, Else)
)
;
- ( GoalExpr = negation(SubGoal)
- ; GoalExpr = scope(_, SubGoal)
- ),
+ GoalExpr = negation(SubGoal),
+ CanLoop = goal_can_loop_func(MaybeModuleInfo, SubGoal)
+ ;
+ GoalExpr = scope(Reason, SubGoal),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ % These scopes contain only construction unifications.
+ CanLoop = no
+ ;
CanLoop = goal_can_loop_func(MaybeModuleInfo, SubGoal)
+ )
;
GoalExpr = shorthand(ShortHand),
(
@@ -555,10 +564,16 @@
CanThrow = goal_can_throw_func(MaybeModuleInfo, Else)
)
;
- ( GoalExpr = negation(SubGoal)
- ; GoalExpr = scope(_Reason, SubGoal)
- ),
+ GoalExpr = negation(SubGoal),
+ CanThrow = goal_can_throw_func(MaybeModuleInfo, SubGoal)
+ ;
+ GoalExpr = scope(Reason, SubGoal),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ % These scopes contain only construction unifications.
+ CanThrow = no
+ ;
CanThrow = goal_can_throw_func(MaybeModuleInfo, SubGoal)
+ )
;
GoalExpr = shorthand(ShortHand),
(
@@ -596,24 +611,41 @@
:- func goal_is_flat_expr(hlds_goal_expr) = bool.
-goal_is_flat_expr(generic_call(_, _, _, _)) = yes.
-goal_is_flat_expr(plain_call(_, _, _, _, _, _)) = yes.
-goal_is_flat_expr(unify(_, _, _, _, _)) = yes.
-goal_is_flat_expr(call_foreign_proc(_, _, _, _, _, _, _)) = yes.
-goal_is_flat_expr(conj(ConjType, Goals)) = IsFlat :-
+goal_is_flat_expr(GoalExpr) = IsFlat :-
+ (
+ ( GoalExpr = generic_call(_, _, _, _)
+ ; GoalExpr = plain_call(_, _, _, _, _, _)
+ ; GoalExpr = unify(_, _, _, _, _)
+ ; GoalExpr = call_foreign_proc(_, _, _, _, _, _, _)
+ ),
+ IsFlat = yes
+ ;
+ GoalExpr = conj(ConjType, Goals),
(
ConjType = parallel_conj,
IsFlat = no
;
ConjType = plain_conj,
IsFlat = goal_is_flat_list(Goals)
+ )
+ ;
+ ( GoalExpr = disj(_)
+ ; GoalExpr = switch(_, _, _)
+ ; GoalExpr = if_then_else(_, _, _, _)
+ ; GoalExpr = shorthand(_)
+ ),
+ IsFlat = no
+ ;
+ GoalExpr = negation(SubGoal),
+ IsFlat = goal_is_flat(SubGoal)
+ ;
+ GoalExpr = scope(Reason, SubGoal),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ IsFlat = yes
+ ;
+ IsFlat = goal_is_flat(SubGoal)
+ )
).
-goal_is_flat_expr(disj(_)) = no.
-goal_is_flat_expr(switch(_, _, _)) = no.
-goal_is_flat_expr(if_then_else(_, _, _, _)) = no.
-goal_is_flat_expr(negation(Goal)) = goal_is_flat(Goal).
-goal_is_flat_expr(scope(_, Goal)) = goal_is_flat(Goal).
-goal_is_flat_expr(shorthand(_)) = no.
:- func goal_is_flat_list(list(hlds_goal)) = bool.
@@ -698,11 +730,20 @@
goal_may_allocate_heap(Else, May)
)
;
- ( GoalExpr = negation(SubGoal)
- ; GoalExpr = scope(_, SubGoal)
- ),
+ GoalExpr = negation(SubGoal),
goal_may_allocate_heap(SubGoal, May)
;
+ GoalExpr = scope(Reason, SubGoal),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ % These scopes construct ground terms, but they construct them
+ % statically, so if we modify the code above to check the
+ % construct_how field of construction unifications, we could
+ % return May = no here.
+ May = yes
+ ;
+ goal_may_allocate_heap(SubGoal, May)
+ )
+ ;
GoalExpr = shorthand(ShortHand),
(
ShortHand = atomic_goal(_, _, _, _, _, _),
@@ -853,11 +894,18 @@
int.min(CTMin, EMin, Min),
int.max(CTMax, EMax, Max)
;
- ( GoalExpr = negation(SubGoal)
- ; GoalExpr = scope(_, SubGoal)
- ),
+ GoalExpr = negation(SubGoal),
count_recursive_calls(SubGoal, PredId, ProcId, Min, Max)
;
+ GoalExpr = scope(Reason, SubGoal),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ % These scopes contain only construction unifications.
+ Min = 0,
+ Max = 0
+ ;
+ count_recursive_calls(SubGoal, PredId, ProcId, Min, Max)
+ )
+ ;
GoalExpr = shorthand(ShortHand),
(
ShortHand = atomic_goal(_, _, _, _, MainGoal, OrElseGoals),
Index: compiler/goal_path.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/goal_path.m,v
retrieving revision 1.51
diff -u -b -r1.51 goal_path.m
--- compiler/goal_path.m 4 Sep 2008 11:41:00 -0000 1.51
+++ compiler/goal_path.m 11 Dec 2008 15:53:48 -0000
@@ -169,6 +169,9 @@
GoalExpr = negation(SubGoal)
;
GoalExpr0 = scope(Reason, SubGoal0),
+ % We should consider not filling in the goal path slots inside
+ % from_ground_term_construct scopes, since we do not use them
+ % for anything.
SubGoal0 = hlds_goal(_, InnerInfo),
OuterDetism = goal_info_get_determinism(GoalInfo),
InnerDetism = goal_info_get_determinism(InnerInfo),
Index: compiler/goal_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/goal_util.m,v
retrieving revision 1.160
diff -u -b -r1.160 goal_util.m
--- compiler/goal_util.m 15 Oct 2008 04:06:03 -0000 1.160
+++ compiler/goal_util.m 11 Dec 2008 15:53:48 -0000
@@ -546,7 +546,7 @@
;
Reason = commit(_)
;
- Reason = from_ground_term(Var),
+ Reason = from_ground_term(Var, _),
set.insert(!.Set, Var, !:Set)
;
Reason = trace_goal(_, _, _, _, _)
@@ -677,6 +677,9 @@
GoalExpr = negation(Goal)
;
GoalExpr0 = scope(Reason, Goal0),
+ % For most features there would be no point in attaching them
+ % to the goals inside from_ground_term_construct scopes, but there
+ % may be one or two for which this may be meaningful.
attach_features_to_all_goals(Features, Goal0, Goal),
GoalExpr = scope(Reason, Goal)
;
@@ -702,31 +705,28 @@
extra_nonlocal_typeinfos(RttiVarMaps, VarTypes, ExistQVars,
NonLocals, NonLocalTypeInfos) :-
+ % Find all non-local type vars. That is, type vars that are existentially
+ % quantified or type vars that appear in the type of a non-local prog_var.
- % Find all non-local type vars. That is, type vars that are
- % existentially quantified or type vars that appear in the
- % type of a non-local prog_var.
- %
set.to_sorted_list(NonLocals, NonLocalsList),
map.apply_to_list(NonLocalsList, VarTypes, NonLocalsTypes),
type_vars_list(NonLocalsTypes, NonLocalTypeVarsList0),
list.append(ExistQVars, NonLocalTypeVarsList0, NonLocalTypeVarsList),
set.list_to_set(NonLocalTypeVarsList, NonLocalTypeVars),
- % Find all the type_infos that are non-local, that is,
- % type_infos for type vars that are non-local in the above
- % sense.
- %
+ % Find all the type_infos that are non-local, that is, type_infos for
+ % type vars that are non-local in the above sense.
+
TypeVarToProgVar = (func(TypeVar) = ProgVar :-
rtti_lookup_type_info_locn(RttiVarMaps, TypeVar, Locn),
type_info_locn_var(Locn, ProgVar)
),
NonLocalTypeInfoVars = set.map(TypeVarToProgVar, NonLocalTypeVars),
- % Find all the typeclass_infos that are non-local. These
- % include all typeclass_infos that constrain a type variable
- % that is non-local in the above sense.
- %
+ % Find all the typeclass_infos that are non-local. These include
+ % all typeclass_infos that constrain a type variable that is non-local
+ % in the above sense.
+
solutions.solutions_set(
(pred(Var::out) is nondet :-
% Search through all arguments of all constraints
@@ -772,10 +772,15 @@
),
IsLeaf = proc_body_is_leaf_goals(Goals)
;
- ( GoalExpr = negation(Goal)
- ; GoalExpr = scope(_, Goal)
- ),
- IsLeaf = proc_body_is_leaf(Goal)
+ GoalExpr = negation(SubGoal),
+ IsLeaf = proc_body_is_leaf(SubGoal)
+ ;
+ GoalExpr = scope(Reason, SubGoal),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ IsLeaf = is_leaf
+ ;
+ IsLeaf = proc_body_is_leaf(SubGoal)
+ )
;
GoalExpr = switch(_, _, Cases),
IsLeaf = proc_body_is_leaf_cases(Cases)
@@ -915,9 +920,14 @@
goal_size(SubGoal, Size1),
Size = Size1 + 1
;
- GoalExpr = scope(_, SubGoal),
+ GoalExpr = scope(Reason, SubGoal),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ % These scopes get turned into a single assignment.
+ Size = 1
+ ;
goal_size(SubGoal, Size1),
Size = Size1 + 1
+ )
;
GoalExpr = shorthand(ShortHand),
(
@@ -992,8 +1002,13 @@
).
goal_expr_calls(negation(Goal), PredProcId) :-
goal_calls(Goal, PredProcId).
-goal_expr_calls(scope(_, Goal), PredProcId) :-
- goal_calls(Goal, PredProcId).
+goal_expr_calls(scope(Reason, Goal), PredProcId) :-
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ % These goals contain only construction unifications.
+ fail
+ ;
+ goal_calls(Goal, PredProcId)
+ ).
goal_expr_calls(plain_call(PredId, ProcId, _, _, _, _), proc(PredId, ProcId)).
%-----------------------------------------------------------------------------%
@@ -1050,8 +1065,13 @@
).
goal_expr_calls_pred_id(negation(Goal), PredId) :-
goal_calls_pred_id(Goal, PredId).
-goal_expr_calls_pred_id(scope(_, Goal), PredId) :-
- goal_calls_pred_id(Goal, PredId).
+goal_expr_calls_pred_id(scope(Reason, Goal), PredId) :-
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ % These goals contain only construction unifications.
+ fail
+ ;
+ goal_calls_pred_id(Goal, PredId)
+ ).
goal_expr_calls_pred_id(plain_call(PredId, _, _, _, _, _), PredId).
%-----------------------------------------------------------------------------%
@@ -1100,8 +1120,13 @@
GoalExpr = negation(Goal),
goal_calls_proc_in_list_2(Goal, PredProcIds, !CalledSet)
;
- GoalExpr = scope(_, Goal),
+ GoalExpr = scope(Reason, Goal),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ % These goals contain only construction unifications.
+ true
+ ;
goal_calls_proc_in_list_2(Goal, PredProcIds, !CalledSet)
+ )
;
GoalExpr = shorthand(ShortHand),
(
@@ -1152,8 +1177,14 @@
goals_contain_reconstruction([Cond, Then, Else]).
goal_expr_contains_reconstruction(negation(Goal)) :-
goal_contains_reconstruction(Goal).
-goal_expr_contains_reconstruction(scope(_, Goal)) :-
- goal_contains_reconstruction(Goal).
+goal_expr_contains_reconstruction(scope(Reason, Goal)) :-
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ % These goals contain only construction unifications
+ % that do no reuse.
+ fail
+ ;
+ goal_contains_reconstruction(Goal)
+ ).
goal_expr_contains_reconstruction(unify(_, _, _, Unify, _)) :-
Unify = construct(_, _, _, _, HowToConstruct, _, _),
HowToConstruct = reuse_cell(_).
@@ -1207,7 +1238,7 @@
map.lookup(!.VarTypes, Var, VarType),
type_util.get_cons_id_arg_types(!.ModuleInfo, VarType, ConsId, ArgTypes),
svmap.det_insert_from_corresponding_lists(ArgVars, ArgTypes, !VarTypes),
- instmap.lookup_var(InstMap, Var, Inst0),
+ instmap_lookup_var(InstMap, Var, Inst0),
(
inst_expand(!.ModuleInfo, Inst0, Inst1),
get_arg_insts(Inst1, ConsId, ConsArity, ArgInsts1)
@@ -1729,9 +1760,13 @@
Goal = hlds_goal(GoalExpr, GoalInfo0)
;
GoalExpr0 = scope(Reason, SubGoal0),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ Goal = Goal0
+ ;
SubGoal = maybe_strip_equality_pretest(SubGoal0),
GoalExpr = scope(Reason, SubGoal),
Goal = hlds_goal(GoalExpr, GoalInfo0)
+ )
;
GoalExpr0 = shorthand(ShortHand0),
(
Index: compiler/granularity.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/granularity.m,v
retrieving revision 1.10
diff -u -b -r1.10 granularity.m
--- compiler/granularity.m 30 Dec 2007 08:23:40 -0000 1.10
+++ compiler/granularity.m 11 Dec 2008 15:53:48 -0000
@@ -192,9 +192,13 @@
GoalExpr = negation(SubGoal)
;
GoalExpr0 = scope(Reason, SubGoal0),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ GoalExpr = GoalExpr0
+ ;
runtime_granularity_test_in_goal(SubGoal0, SubGoal, !Changed, SCC,
ModuleInfo),
GoalExpr = scope(Reason, SubGoal)
+ )
;
( GoalExpr0 = plain_call(_, _, _, _, _, _)
; GoalExpr0 = generic_call(_, _, _, _)
Index: compiler/handle_options.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/handle_options.m,v
retrieving revision 1.327
diff -u -b -r1.327 handle_options.m
--- compiler/handle_options.m 25 Nov 2008 07:46:39 -0000 1.327
+++ compiler/handle_options.m 11 Dec 2008 15:53:48 -0000
@@ -26,6 +26,7 @@
:- import_module getopt_io.
:- import_module io.
:- import_module list.
+:- import_module maybe.
%-----------------------------------------------------------------------------%
@@ -73,6 +74,11 @@
%
:- pred grade_directory_component(globals::in, string::out) is det.
+ % Return the number of functions symbols at or above which a ground term's
+ % superhomogeneous form should be wrapped in a from_ground_term scope.
+ %
+:- func get_from_ground_term_threshold = maybe(int).
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -91,7 +97,6 @@
:- import_module int.
:- import_module library.
:- import_module map.
-:- import_module maybe.
:- import_module pair.
:- import_module set.
:- import_module solutions.
@@ -2060,6 +2065,11 @@
!Globals)
),
+ globals.lookup_int_option(!.Globals, from_ground_term_threshold,
+ FromGroundTermThreshold),
+ set_maybe_from_ground_term_threshold(yes(FromGroundTermThreshold),
+ !IO),
+
(
HighLevel = no,
postprocess_options_lowlevel(!Globals)
@@ -2070,6 +2080,15 @@
globals.io_set_globals(!.Globals, !IO)
).
+:- mutable(maybe_from_ground_term_threshold, maybe(int), no, ground,
+ [untrailed, attach_to_io_state]).
+
+% get_from_ground_term_threshold = yes(5).
+get_from_ground_term_threshold = MaybeThreshold :-
+ promise_pure (
+ semipure get_maybe_from_ground_term_threshold(MaybeThreshold)
+ ).
+
% These option implications only affect the low-level (LLDS) code
% generator. They may in fact be harmful if set for the high-level
% code generator, because sometimes the same option has different
Index: compiler/higher_order.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/higher_order.m,v
retrieving revision 1.179
diff -u -b -r1.179 higher_order.m
--- compiler/higher_order.m 9 Dec 2008 02:38:59 -0000 1.179
+++ compiler/higher_order.m 11 Dec 2008 15:53:48 -0000
@@ -602,9 +602,13 @@
Goal = hlds_goal(GoalExpr, GoalInfo0)
;
GoalExpr0 = scope(Reason, SubGoal0),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ Goal = Goal0
+ ;
ho_traverse_goal(SubGoal0, SubGoal, !Info),
GoalExpr = scope(Reason, SubGoal),
Goal = hlds_goal(GoalExpr, GoalInfo0)
+ )
;
GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _),
Goal = Goal0
@@ -1163,7 +1167,7 @@
set.list_to_set(CallArgs, NonLocals),
instmap_delta_init_reachable(InstMapDelta0),
- instmap_delta_insert(ResultVar, ground(shared, none),
+ instmap_delta_insert_var(ResultVar, ground(shared, none),
InstMapDelta0, InstMapDelta),
goal_info_init(NonLocals, InstMapDelta, detism_det, purity_pure, GoalInfo),
CallGoalExpr = plain_call(PredId, ProcId, CallArgs, not_builtin,
Index: compiler/hlds_desc.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_desc.m,v
retrieving revision 1.1
diff -u -b -r1.1 hlds_desc.m
--- compiler/hlds_desc.m 28 Nov 2008 06:36:58 -0000 1.1
+++ compiler/hlds_desc.m 11 Dec 2008 15:53:48 -0000
@@ -143,7 +143,7 @@
Reason = barrier(_),
Desc = "scope barrier"
;
- Reason = from_ground_term(_),
+ Reason = from_ground_term(_, _),
Desc = "scope from_ground_term"
;
Reason = trace_goal(_, _, _, _, _),
Index: compiler/hlds_goal.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_goal.m,v
retrieving revision 1.200
diff -u -b -r1.200 hlds_goal.m
--- compiler/hlds_goal.m 25 Nov 2008 07:46:40 -0000 1.200
+++ compiler/hlds_goal.m 12 Dec 2008 03:42:19 -0000
@@ -295,6 +295,74 @@
; top_level_atomic_goal
; nested_atomic_goal.
+ % Each scope that is created from the expansion of a ground term above
+ % a certain size is classified into one of these three categories.
+ % The categories are for scopes that (a) construct a ground term, (b)
+ % take an existing ground term and test whether it has a given shape, and
+ % (c) everything else (perhaps some parts of the term are matched and some
+ % parts are bound, or some invariant listed below is not guaranteed).
+ %
+ % Many parts of the compiler have special code for handling
+ % from_ground_term_construct scopes, code that avoids scanning the code
+ % inside the scope. This can be a very big win, since that code can be
+ % huge. To make this special casing possible, from_ground_term_construct
+ % scopes promise the following invariants.
+ %
+ % 1. The only nonlocal variable of the scope is the one listed in the
+ % scope_reason.
+ % 2. The shape of the code inside the scope is a plain conjunction of
+ % unifications.
+ % 3. These unifications are construct unifications whose construct_how
+ % field says construct_statically, and in which the nonlocals,
+ % instmap_delta and determinism fields of the goal_info are
+ % correctly filled in. The nonlocals will be all the variables in the
+ % unification, the instmap delta will say that the value being
+ % constructed is ground (not unique, because it is static), and the
+ % determinism says that the goal is det. The goal_info of the
+ % conjunction will be filled in similarly.
+ % 4. None of the these unifications constructs a higher order value.
+ %
+ % Invariants 3 and 4 are established during mode checking, so code executed
+ % before then cannot rely on them.
+ %
+ % If any compiler pass modifies a from_ground_term_construct scope in a way
+ % that invalidates these invariants, it must set the kind field of the
+ % scope to from_ground_term_other.
+ %
+ % For now, we don't optimize from_ground_term_deconstruct and
+ % from_ground_term_other scopes, so there are no invariants required
+ % of them.
+ %
+ % There are several possible alternative designs that could allow the
+ % special-casing of from_ground_term_construct scopes. Here are two
+ % of them.
+ %
+ % One alternative is to have fourth kind, from_ground_term_initial,
+ % which would promise only the first two invariants, so compiler writers
+ % wouldn't have to worry about when a piece of code is executed if they
+ % need to depend on invariants 3 and/or 4. This works, but it leads to
+ % a slight slowdown normal code (code without big ground terms).
+ %
+ % A second alternative is to have the mode checker turn any scope
+ % that it currently keeps as from_ground_term_construct into a new kind
+ % of generic call, one which basically says "this goal binds this variable
+ % to this ground term", with the ground term represented as a ground term,
+ % not as a bunch of construction unifications. The advantage of this
+ % approach would be that we could delete the local variables of these
+ % scopes (of which there can be hundreds of thousands) from the maps stored
+ % in the fields of the pred_info and proc_info (such as the varset and the
+ % var_types), making lookups and other operations on those maps
+ % significantly faster. The drawback would be the need for totally new code
+ % in most parts of the compiler to handle this new kind of goal.
+ % Using from_ground_term_construct, on the other hand, allows us to keep
+ % using the existing code for scopes in e.g. the type checker and the code
+ % generator.
+ %
+:- type from_ground_term_kind
+ ---> from_ground_term_construct
+ ; from_ground_term_deconstruct
+ ; from_ground_term_other.
+
:- type scope_reason
---> exist_quant(list(prog_var))
% The goal inside the scope construct has the listed variables
@@ -358,7 +426,7 @@
% A barrier says nothing about the determinism of either
% the inner or the outer goal, or about pruning.
- ; from_ground_term(prog_var)
+ ; from_ground_term(prog_var, from_ground_term_kind)
% The goal inside the scope, which should be a conjunction,
% results from the conversion of one ground term to
% superhomogeneous form. The variable specifies what the
@@ -1481,7 +1549,6 @@
% Return yes if goal(s) contain any foreign code
%
:- func goal_has_foreign(hlds_goal) = bool.
-:- func goal_list_has_foreign(list(hlds_goal)) = bool.
:- type has_subgoals
---> has_subgoals
@@ -2279,9 +2346,9 @@
Reason0 = commit(_),
Reason = Reason0
;
- Reason0 = from_ground_term(Var0),
+ Reason0 = from_ground_term(Var0, Kind),
rename_var(Must, Subn, Var0, Var),
- Reason = from_ground_term(Var)
+ Reason = from_ground_term(Var, Kind)
;
Reason0 = trace_goal(Flag, Grade, Env, Vars, QuantVars0),
rename_var_list(Must, Subn, QuantVars0, QuantVars),
@@ -2405,8 +2472,11 @@
How0 = construct_dynamically,
How = How0
;
- How0 = construct_statically(_),
- How = How0
+ How0 = construct_statically(StaticConss0),
+ % ZZZ
+ list.map(rename_var_in_static_cons(Must, Subn),
+ StaticConss0, StaticConss),
+ How = construct_statically(StaticConss)
;
How0 = construct_in_region(RegVar0),
rename_var(Must, Subn, RegVar0, RegVar),
@@ -2456,6 +2526,15 @@
Unify = complicated_unify(Modes, Cat, TypeInfoVars)
).
+:- pred rename_var_in_static_cons(must_rename::in, prog_var_renaming::in,
+ static_cons::in, static_cons::out) is det.
+
+rename_var_in_static_cons(Must, Subn, StaticCons0, StaticCons) :-
+ StaticCons0 = static_cons(ConsId, ArgVars0, ArgConss0),
+ list.map(rename_var(Must, Subn), ArgVars0, ArgVars),
+ list.map(rename_var_in_static_cons(Must, Subn), ArgConss0, ArgConss),
+ StaticCons = static_cons(ConsId, ArgVars, ArgConss).
+
:- pred rename_generic_call(must_rename::in, prog_var_renaming::in,
generic_call::in, generic_call::out) is det.
@@ -2698,29 +2777,30 @@
goal_has_foreign(Goal) = HasForeign :-
Goal = hlds_goal(GoalExpr, _),
(
+ ( GoalExpr = plain_call(_, _, _, _, _, _)
+ ; GoalExpr = generic_call(_, _, _, _)
+ ; GoalExpr = unify(_, _, _, _, _)
+ ),
+ HasForeign = no
+ ;
GoalExpr = conj(_, Goals),
HasForeign = goal_list_has_foreign(Goals)
;
- GoalExpr = plain_call(_, _, _, _, _, _),
- HasForeign = no
+ GoalExpr = disj(Goals),
+ HasForeign = goal_list_has_foreign(Goals)
;
- GoalExpr = generic_call(_, _, _, _),
- HasForeign = no
+ GoalExpr = switch(_, _, Cases),
+ HasForeign = case_list_has_foreign(Cases)
;
- GoalExpr = switch(_, _, _),
- HasForeign = no
+ GoalExpr = negation(SubGoal),
+ HasForeign = goal_has_foreign(SubGoal)
;
- GoalExpr = unify(_, _, _, _, _),
+ GoalExpr = scope(Reason, SubGoal),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
HasForeign = no
;
- GoalExpr = disj(Goals),
- HasForeign = goal_list_has_foreign(Goals)
- ;
- GoalExpr = negation(Goal2),
- HasForeign = goal_has_foreign(Goal2)
- ;
- GoalExpr = scope(_, Goal2),
- HasForeign = goal_has_foreign(Goal2)
+ HasForeign = goal_has_foreign(SubGoal)
+ )
;
GoalExpr = if_then_else(_, Cond, Then, Else),
(
@@ -2748,12 +2828,25 @@
)
).
+:- func goal_list_has_foreign(list(hlds_goal)) = bool.
+
goal_list_has_foreign([]) = no.
-goal_list_has_foreign([X | Xs]) =
- ( goal_has_foreign(X) = yes ->
- yes
+goal_list_has_foreign([Goal | Goals]) = HasForeign :-
+ ( goal_has_foreign(Goal) = yes ->
+ HasForeign = yes
+ ;
+ HasForeign = goal_list_has_foreign(Goals)
+ ).
+
+:- func case_list_has_foreign(list(case)) = bool.
+
+case_list_has_foreign([]) = no.
+case_list_has_foreign([Case | Cases]) = HasForeign :-
+ Case = case(_, _, Goal),
+ ( goal_has_foreign(Goal) = yes ->
+ HasForeign = yes
;
- goal_list_has_foreign(Xs)
+ HasForeign = case_list_has_foreign(Cases)
).
%-----------------------------------------------------------------------------%
@@ -3026,7 +3119,7 @@
GoalExpr = unify(Var, RHS, Mode, Unification, Context),
set.singleton_set(NonLocals, Var),
instmap_delta_init_reachable(InstMapDelta0),
- instmap_delta_insert(Var, Inst, InstMapDelta0, InstMapDelta),
+ instmap_delta_insert_var(Var, Inst, InstMapDelta0, InstMapDelta),
goal_info_init(NonLocals, InstMapDelta, detism_det, purity_pure, GoalInfo).
construct_functor(Var, ConsId, Args, Goal) :-
Index: compiler/hlds_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_out.m,v
retrieving revision 1.459
diff -u -b -r1.459 hlds_out.m
--- compiler/hlds_out.m 3 Nov 2008 03:08:02 -0000 1.459
+++ compiler/hlds_out.m 11 Dec 2008 15:53:48 -0000
@@ -1704,11 +1704,22 @@
write_indent(Indent, !IO),
io.write_string("% commit(dont_force_pruning)\n", !IO)
;
- Reason = from_ground_term(Var),
+ Reason = from_ground_term(Var, Kind),
io.write_string("(\n", !IO),
write_indent(Indent, !IO),
io.write_string("% from_ground_term [", !IO),
mercury_output_var(VarSet, AppendVarNums, Var, !IO),
+ io.write_string(", ", !IO),
+ (
+ Kind = from_ground_term_construct,
+ io.write_string("construct", !IO)
+ ;
+ Kind = from_ground_term_deconstruct,
+ io.write_string("deconstruct", !IO)
+ ;
+ Kind = from_ground_term_other,
+ io.write_string("other", !IO)
+ ),
io.write_string("]\n", !IO)
;
Reason = trace_goal(MaybeCompileTime, MaybeRunTime, MaybeIO,
@@ -3111,10 +3122,10 @@
write_some(_Vars, _VarSet, !IO).
write_instmap(InstMap, VarSet, AppendVarNums, Indent, !IO) :-
- ( instmap.is_unreachable(InstMap) ->
+ ( instmap_is_unreachable(InstMap) ->
io.write_string("unreachable", !IO)
;
- instmap.to_assoc_list(InstMap, AssocList),
+ instmap_to_assoc_list(InstMap, AssocList),
write_instmap_2(AssocList, VarSet, AppendVarNums, Indent, !IO)
).
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.248
diff -u -b -r1.248 hlds_pred.m
--- compiler/hlds_pred.m 25 Nov 2008 07:46:40 -0000 1.248
+++ compiler/hlds_pred.m 11 Dec 2008 15:53:48 -0000
@@ -1206,8 +1206,8 @@
compute_arg_types_modes([Var | Vars], VarTypes, InstMap0, InstMap,
[Type | Types], [Mode | Modes]) :-
map.lookup(VarTypes, Var, Type),
- instmap.lookup_var(InstMap0, Var, Inst0),
- instmap.lookup_var(InstMap, Var, Inst),
+ instmap_lookup_var(InstMap0, Var, Inst0),
+ instmap_lookup_var(InstMap, Var, Inst),
Mode = (Inst0 -> Inst),
compute_arg_types_modes(Vars, VarTypes, InstMap0, InstMap, Types, Modes).
@@ -2616,7 +2616,7 @@
proc_info_get_argmodes(ProcInfo, ArgModes),
mode_list_get_initial_insts(ModuleInfo, ArgModes, InitialInsts),
assoc_list.from_corresponding_lists(HeadVars, InitialInsts, InstAL),
- instmap.from_assoc_list(InstAL, InstMap).
+ instmap_from_assoc_list(InstAL, InstMap).
proc_info_declared_argmodes(ProcInfo, ArgModes) :-
proc_info_get_maybe_declared_argmodes(ProcInfo, MaybeArgModes),
Index: compiler/implementation_defined_literals.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/implementation_defined_literals.m,v
retrieving revision 1.2
diff -u -b -r1.2 implementation_defined_literals.m
--- compiler/implementation_defined_literals.m 27 Jun 2008 07:27:07 -0000 1.2
+++ compiler/implementation_defined_literals.m 11 Dec 2008 15:53:48 -0000
@@ -136,6 +136,8 @@
Goal = hlds_goal(GoalExpr, GoalInfo0)
;
GoalExpr0 = scope(Reason, SubGoal0),
+ % Implementation-defined literals may appear in
+ % from_ground_term_construct scopes.
subst_literals_in_goal(Info, SubGoal0, SubGoal),
GoalExpr = scope(Reason, SubGoal),
Goal = hlds_goal(GoalExpr, GoalInfo0)
Index: compiler/implicit_parallelism.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/implicit_parallelism.m,v
retrieving revision 1.9
diff -u -b -r1.9 implicit_parallelism.m
--- compiler/implicit_parallelism.m 30 Sep 2008 02:30:50 -0000 1.9
+++ compiler/implicit_parallelism.m 11 Dec 2008 15:53:48 -0000
@@ -320,23 +320,29 @@
!:Goal = hlds_goal(GoalExpr, GoalInfo),
update_conj_and_index(!MaybeConj, !.Goal, !IndexInConj)
;
- GoalExpr0 = negation(Goal0),
- process_goal_for_implicit_parallelism(Goal0, Goal, ProcInfo,
+ GoalExpr0 = negation(SubGoal0),
+ process_goal_for_implicit_parallelism(SubGoal0, SubGoal, ProcInfo,
!ModuleInfo, !MaybeConj, !IndexInConj, !CalleesToBeParallelized,
!SiteNumCounter),
- GoalExpr = negation(Goal),
+ GoalExpr = negation(SubGoal),
!: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).
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ % Treat the scope as if it were a single unification, since
+ % that is effectively what happens at runtime.
+ increment_index_if_in_conj(!.MaybeConj, !IndexInConj)
+ ;
+ % 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, _, !CalleesToBeParallelized,
!SiteNumCounter),
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,
Index: compiler/inlining.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/inlining.m,v
retrieving revision 1.160
diff -u -b -r1.160 inlining.m
--- compiler/inlining.m 15 Oct 2008 04:06:03 -0000 1.160
+++ compiler/inlining.m 11 Dec 2008 15:53:48 -0000
@@ -355,8 +355,13 @@
GoalExpr = negation(Goal),
is_flat_simple_goal(Goal)
;
- GoalExpr = scope(_, Goal),
+ GoalExpr = scope(Reason, Goal),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ % These scopes are flat and simple by construction.
+ true
+ ;
is_flat_simple_goal(Goal)
+ )
;
GoalExpr = plain_call(_, _, _, inline_builtin, _, _)
;
@@ -551,8 +556,8 @@
:- pred inlining_in_goal(hlds_goal::in, hlds_goal::out,
inline_info::in, inline_info::out) is det.
-inlining_in_goal(hlds_goal(GoalExpr0, GoalInfo0),
- hlds_goal(GoalExpr, GoalInfo), !Info) :-
+inlining_in_goal(Goal0, Goal, !Info) :-
+ Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
(
GoalExpr0 = plain_call(PredId, ProcId, ArgVars, Builtin, Context, Sym),
inlining_in_call(PredId, ProcId, ArgVars, Builtin,
@@ -599,14 +604,21 @@
GoalInfo = GoalInfo0
;
GoalExpr0 = scope(Reason, SubGoal0),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ % The scope has no calls to inline.
+ GoalExpr = GoalExpr0,
+ GoalInfo = GoalInfo0
+ ;
inlining_in_goal(SubGoal0, SubGoal, !Info),
GoalExpr = scope(Reason, SubGoal),
GoalInfo = GoalInfo0
+ )
;
GoalExpr0 = shorthand(_),
% These should have been expanded out by now.
unexpected(this_file, "inlining_in_goal: unexpected shorthand")
- ).
+ ),
+ Goal = hlds_goal(GoalExpr, GoalInfo).
:- pred inlining_in_call(pred_id::in, proc_id::in,
list(prog_var)::in, builtin_state::in, maybe(call_unify_context)::in,
Index: compiler/inst_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/inst_util.m,v
retrieving revision 1.56
diff -u -b -r1.56 inst_util.m
--- compiler/inst_util.m 22 Jan 2008 15:06:11 -0000 1.56
+++ compiler/inst_util.m 11 Dec 2008 15:53:48 -0000
@@ -1813,7 +1813,7 @@
%-----------------------------------------------------------------------------%
var_inst_contains_any(ModuleInfo, Instmap, Var) :-
- instmap.lookup_var(Instmap, Var, Inst),
+ instmap_lookup_var(Instmap, Var, Inst),
inst_contains_any(ModuleInfo, Inst).
%-----------------------------------------------------------------------------%
Index: compiler/instmap.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/instmap.m,v
retrieving revision 1.61
diff -u -b -r1.61 instmap.m
--- compiler/instmap.m 30 Dec 2007 08:23:44 -0000 1.61
+++ compiler/instmap.m 11 Dec 2008 15:53:48 -0000
@@ -56,11 +56,11 @@
% Is the instmap reachable?
%
-:- pred is_reachable(instmap::in) is semidet.
+:- pred instmap_is_reachable(instmap::in) is semidet.
% Is the instmap unreachable?
%
-:- pred is_unreachable(instmap::in) is semidet.
+:- pred instmap_is_unreachable(instmap::in) is semidet.
% For any instmap InstMapDelta, exactly one of
% instmap_delta_is_reachable(InstMapDelta) and
@@ -74,7 +74,7 @@
%
:- pred instmap_delta_is_unreachable(instmap_delta::in) is semidet.
-:- pred from_assoc_list(assoc_list(prog_var, mer_inst)::in,
+:- pred instmap_from_assoc_list(assoc_list(prog_var, mer_inst)::in,
instmap::out) is det.
:- pred instmap_delta_from_assoc_list(assoc_list(prog_var, mer_inst)::in,
@@ -87,11 +87,11 @@
% Return the set of variables in an instmap.
%
-:- pred vars(instmap::in, set(prog_var)::out) is det.
+:- pred instmap_vars(instmap::in, set(prog_var)::out) is det.
% Return the list of variables in an instmap.
%
-:- pred vars_list(instmap::in, list(prog_var)::out) is det.
+:- pred instmap_vars_list(instmap::in, list(prog_var)::out) is det.
% Return the set of variables whose instantiations have
% changed (or our knowledge about them has changed) across
@@ -127,7 +127,7 @@
% Given an instmap and a variable, determine the inst of that variable.
%
-:- pred lookup_var(instmap::in, prog_var::in, mer_inst::out) is det.
+:- pred instmap_lookup_var(instmap::in, prog_var::in, mer_inst::out) is det.
% Given an instmap_delta and a variable, determine the new inst
% of that variable (if any).
@@ -138,25 +138,34 @@
% Given an instmap and a list of variables, return a list
% containing the insts of those variable.
%
-:- pred lookup_vars(list(prog_var)::in, instmap::in,
+:- pred instmap_lookup_vars(instmap::in, list(prog_var)::in,
list(mer_inst)::out) is det.
% Insert an entry into an instmap_delta. Note that you cannot call
% instmap_delta_insert for a variable already present.
%
-:- pred instmap_delta_insert(prog_var::in, mer_inst::in,
+:- pred instmap_delta_insert_var(prog_var::in, mer_inst::in,
instmap_delta::in, instmap_delta::out) is det.
% Set an entry in an instmap.
%
-:- pred set(prog_var::in, mer_inst::in, instmap::in, instmap::out) is det.
+:- pred instmap_set_var(prog_var::in, mer_inst::in, instmap::in, instmap::out)
+ is det.
- % Set multiple entries in an instmap.
+ % Set multiple entries in an instmap. None of the insts should be
+ % `not_reached'.
%
-:- pred set_vars(list(prog_var)::in, list(mer_inst)::in,
+:- pred instmap_set_vars(assoc_list(prog_var, mer_inst)::in,
+ instmap::in, instmap::out) is det.
+:- pred instmap_set_vars_corresponding(list(prog_var)::in, list(mer_inst)::in,
instmap::in, instmap::out) is det.
+:- pred instmap_set_vars_same(mer_inst::in, list(prog_var)::in,
+ instmap::in, instmap::out) is det.
+
+:- pred instmap_delta_set_var(prog_var::in, mer_inst::in,
+ instmap_delta::in, instmap_delta::out) is det.
-:- pred instmap_delta_set(prog_var::in, mer_inst::in,
+:- pred instmap_delta_set_vars_same(mer_inst::in, list(prog_var)::in,
instmap_delta::in, instmap_delta::out) is det.
% Bind a variable in an instmap to a functor at the beginning
@@ -247,11 +256,11 @@
:- pred instmap_delta_delete_vars(list(prog_var)::in,
instmap_delta::in, instmap_delta::out) is det.
- % `no_output_vars(Instmap, InstmapDelta, Vars, ModuleInfo)'
+ % `instmap_delta_no_output_vars(Instmap, InstmapDelta, Vars, ModuleInfo)'
% is true if none of the vars in the set Vars could have become more
% instantiated when InstmapDelta is applied to Instmap.
%
-:- pred no_output_vars(instmap::in, instmap_delta::in,
+:- pred instmap_delta_no_output_vars(instmap::in, instmap_delta::in,
set(prog_var)::in, vartypes::in, module_info::in) is semidet.
% merge_instmap_delta(InitialInstMap, NonLocals,
@@ -297,12 +306,12 @@
:- pred instmap_delta_apply_sub(must_rename::in, map(prog_var, prog_var)::in,
instmap_delta::in, instmap_delta::out) is det.
-:- pred apply_sub(must_rename::in, map(prog_var, prog_var)::in,
+:- pred instmap_apply_sub(must_rename::in, map(prog_var, prog_var)::in,
instmap::in, instmap::out) is det.
%-----------------------------------------------------------------------------%
-:- pred to_assoc_list(instmap::in,
+:- pred instmap_to_assoc_list(instmap::in,
assoc_list(prog_var, mer_inst)::out) is det.
:- pred instmap_delta_to_assoc_list(instmap_delta::in,
@@ -347,6 +356,7 @@
:- import_module int.
:- import_module maybe.
:- import_module pair.
+:- import_module std_util.
:- import_module string.
:- import_module svmap.
:- import_module term.
@@ -377,9 +387,9 @@
%-----------------------------------------------------------------------------%
-is_reachable(reachable(_)).
+instmap_is_reachable(reachable(_)).
-is_unreachable(unreachable).
+instmap_is_unreachable(unreachable).
instmap_delta_is_reachable(reachable(_)).
@@ -387,7 +397,7 @@
%-----------------------------------------------------------------------------%
-from_assoc_list(AL, reachable(Instmapping)) :-
+instmap_from_assoc_list(AL, reachable(Instmapping)) :-
map.from_assoc_list(AL, Instmapping).
instmap_delta_from_assoc_list(AL, reachable(Instmapping)) :-
@@ -419,18 +429,18 @@
( Inst1 = Inst2 ->
instmap_delta_from_mode_list_2(Vars, Modes, ModuleInfo, !InstMapDelta)
;
- instmap_delta_set(Var, Inst2, !InstMapDelta),
+ instmap_delta_set_var(Var, Inst2, !InstMapDelta),
instmap_delta_from_mode_list_2(Vars, Modes, ModuleInfo, !InstMapDelta)
).
%-----------------------------------------------------------------------------%
-vars(Instmap, Vars) :-
- vars_list(Instmap, VarsList),
+instmap_vars(Instmap, Vars) :-
+ instmap_vars_list(Instmap, VarsList),
set.list_to_set(VarsList, Vars).
-vars_list(unreachable, []).
-vars_list(reachable(InstMapping), VarsList) :-
+instmap_vars_list(unreachable, []).
+instmap_vars_list(reachable(InstMapping), VarsList) :-
map.keys(InstMapping, VarsList).
instmap_bound_vars(unreachable, _ModuleInfo, set.init).
@@ -457,22 +467,23 @@
%-----------------------------------------------------------------------------%
instmap_changed_vars(InstMapA, InstMapB, VarTypes, ModuleInfo, ChangedVars) :-
- vars_list(InstMapB, VarsB),
- changed_vars_2(VarsB, InstMapA, InstMapB, VarTypes, ModuleInfo,
+ instmap_vars_list(InstMapB, VarsB),
+ instmap_changed_vars_2(VarsB, InstMapA, InstMapB, VarTypes, ModuleInfo,
ChangedVars).
-:- pred changed_vars_2(prog_vars::in, instmap::in, instmap::in, vartypes::in,
- module_info::in, set(prog_var)::out) is det.
+:- pred instmap_changed_vars_2(prog_vars::in, instmap::in, instmap::in,
+ vartypes::in, module_info::in, set(prog_var)::out) is det.
-changed_vars_2([], _InstMapA, _InstMapB, _Types, _ModuleInfo, ChangedVars) :-
+instmap_changed_vars_2([], _InstMapA, _InstMapB, _Types,
+ _ModuleInfo, ChangedVars) :-
set.init(ChangedVars).
-changed_vars_2([VarB | VarBs], InstMapA, InstMapB, VarTypes, ModuleInfo,
- ChangedVars) :-
- changed_vars_2(VarBs, InstMapA, InstMapB, VarTypes, ModuleInfo,
- ChangedVars0),
+instmap_changed_vars_2([VarB | VarBs], InstMapA, InstMapB, VarTypes,
+ ModuleInfo, ChangedVars) :-
+ instmap_changed_vars_2(VarBs, InstMapA, InstMapB, VarTypes,
+ ModuleInfo, ChangedVars0),
- lookup_var(InstMapA, VarB, InitialInst),
- lookup_var(InstMapB, VarB, FinalInst),
+ instmap_lookup_var(InstMapA, VarB, InitialInst),
+ instmap_lookup_var(InstMapB, VarB, FinalInst),
map.lookup(VarTypes, VarB, Type),
( inst_matches_final(InitialInst, FinalInst, Type, ModuleInfo) ->
@@ -483,8 +494,8 @@
%-----------------------------------------------------------------------------%
-lookup_var(unreachable, _Var, not_reached).
-lookup_var(reachable(InstMap), Var, Inst) :-
+instmap_lookup_var(unreachable, _Var, not_reached).
+instmap_lookup_var(reachable(InstMap), Var, Inst) :-
instmapping_lookup_var(InstMap, Var, Inst).
:- pred instmapping_lookup_var(instmapping::in, prog_var::in, mer_inst::out)
@@ -501,26 +512,86 @@
instmap_delta_search_var(reachable(InstMap), Var, Inst) :-
map.search(InstMap, Var, Inst).
-lookup_vars([], _InstMap, []).
-lookup_vars([Arg|Args], InstMap, [Inst|Insts]) :-
- lookup_var(InstMap, Arg, Inst),
- lookup_vars(Args, InstMap, Insts).
+instmap_lookup_vars(_InstMap, [], []).
+instmap_lookup_vars(InstMap, [Arg | Args], [Inst | Insts]) :-
+ instmap_lookup_var(InstMap, Arg, Inst),
+ instmap_lookup_vars(InstMap, Args, Insts).
-set(_Var, _Inst, unreachable, unreachable).
-set(Var, Inst, reachable(InstMapping0), reachable(InstMapping)) :-
+instmap_set_var(_Var, _Inst, unreachable, unreachable).
+instmap_set_var(Var, Inst, reachable(InstMapping0), reachable(InstMapping)) :-
map.set(InstMapping0, Var, Inst, InstMapping).
-set_vars([], [], !InstMap).
-set_vars([V | Vs], [I | Is], !InstMap) :-
- set(V, I, !InstMap),
- set_vars(Vs, Is, !InstMap).
-set_vars([_ | _], [], !InstMap) :-
- unexpected(this_file, "set_vars: length mismatch (1)").
-set_vars([], [_ | _], !InstMap) :-
- unexpected(this_file, "set_vars: length mismatch (2)").
+instmap_set_vars(VarsInsts, !InstMap) :-
+ (
+ !.InstMap = unreachable
+ % Leave the instmap as it is.
+ ;
+ !.InstMap = reachable(InstMapping0),
+ instmapping_set_vars(VarsInsts, InstMapping0, InstMapping),
+ !:InstMap = reachable(InstMapping)
+ ).
+
+:- pred instmapping_set_vars(assoc_list(prog_var, mer_inst)::in,
+ instmapping::in, instmapping::out) is det.
+
+instmapping_set_vars([], !InstMapping).
+instmapping_set_vars([Var - Inst | VarsInsts], !InstMapping) :-
+ expect(negate(unify(Inst, not_reached)), this_file,
+ "instmapping_set_vars: not_reached"),
+ svmap.set(Var, Inst, !InstMapping),
+ instmapping_set_vars(VarsInsts, !InstMapping).
+
+instmap_set_vars_corresponding(Vars, Insts, !InstMap) :-
+ (
+ !.InstMap = unreachable
+ % Leave the instmap as it is.
+ ;
+ !.InstMap = reachable(InstMapping0),
+ instmapping_set_vars_corresponding(Vars, Insts,
+ InstMapping0, InstMapping),
+ !:InstMap = reachable(InstMapping)
+ ).
+
+:- pred instmapping_set_vars_corresponding(
+ list(prog_var)::in, list(mer_inst)::in,
+ instmapping::in, instmapping::out) is det.
-instmap_delta_set(_Var, _Inst, unreachable, unreachable).
-instmap_delta_set(Var, Inst, reachable(InstMapping0), Instmap) :-
+instmapping_set_vars_corresponding([], [], !InstMapping).
+instmapping_set_vars_corresponding([Var | Vars], [Inst | Insts],
+ !InstMapping) :-
+ expect(negate(unify(Inst, not_reached)), this_file,
+ "instmapping_set_vars_corresponding: not_reached"),
+ svmap.set(Var, Inst, !InstMapping),
+ instmapping_set_vars_corresponding(Vars, Insts, !InstMapping).
+instmapping_set_vars_corresponding([_ | _], [], !InstMapping) :-
+ unexpected(this_file,
+ "instmapping_set_vars_corresponding: length mismatch (1)").
+instmapping_set_vars_corresponding([], [_ | _], !InstMapingp) :-
+ unexpected(this_file,
+ "instmapping_set_vars_corresponding: length mismatch (2)").
+
+instmap_set_vars_same(Inst, Vars, !InstMap) :-
+ (
+ !.InstMap = unreachable
+ % Leave the instmap as it is.
+ ;
+ !.InstMap = reachable(InstMapping0),
+ expect(negate(unify(Inst, not_reached)), this_file,
+ "instmap_set_vars_same: not_reached"),
+ instmapping_set_vars_same(Inst, Vars, InstMapping0, InstMapping),
+ !:InstMap = reachable(InstMapping)
+ ).
+
+:- pred instmapping_set_vars_same(mer_inst::in, list(prog_var)::in,
+ instmapping::in, instmapping::out) is det.
+
+instmapping_set_vars_same(_, [], !InstMapping).
+instmapping_set_vars_same(Inst, [Var | Vars], !InstMapping) :-
+ svmap.set(Var, Inst, !InstMapping),
+ instmapping_set_vars_same(Inst, Vars, !InstMapping).
+
+instmap_delta_set_var(_Var, _Inst, unreachable, unreachable).
+instmap_delta_set_var(Var, Inst, reachable(InstMapping0), Instmap) :-
( Inst = not_reached ->
Instmap = unreachable
;
@@ -528,8 +599,20 @@
Instmap = reachable(InstMapping)
).
-instmap_delta_insert(_Var, _Inst, unreachable, unreachable).
-instmap_delta_insert(Var, Inst, reachable(InstMapping0), Instmap) :-
+instmap_delta_set_vars_same(Inst, Vars, !InstMapDelta) :-
+ (
+ !.InstMapDelta = unreachable
+ % Leave the instmap as it is.
+ ;
+ !.InstMapDelta = reachable(InstMapping0),
+ expect(negate(unify(Inst, not_reached)), this_file,
+ "instmap_delta_set_vars_same: not_reached"),
+ instmapping_set_vars_same(Inst, Vars, InstMapping0, InstMapping),
+ !:InstMapDelta = reachable(InstMapping)
+ ).
+
+instmap_delta_insert_var(_Var, _Inst, unreachable, unreachable).
+instmap_delta_insert_var(Var, Inst, reachable(InstMapping0), Instmap) :-
( Inst = not_reached ->
Instmap = unreachable
;
@@ -547,7 +630,7 @@
!.InstmapDelta = reachable(InstmappingDelta0),
% Get the initial inst from the InstMap.
- lookup_var(InstMap, Var, OldInst),
+ instmap_lookup_var(InstMap, Var, OldInst),
% Compute the new inst by taking the old inst, applying the instmap
% delta to it, and then unifying with bound(ConsId, ...).
@@ -560,7 +643,7 @@
% Add `Var :: OldInst -> NewInst' to the instmap delta.
( NewInst \= OldInst ->
- instmap_delta_set(Var, NewInst, !InstmapDelta)
+ instmap_delta_set_var(Var, NewInst, !InstmapDelta)
;
true
)
@@ -574,7 +657,7 @@
!.InstmapDelta = reachable(InstmappingDelta0),
% Get the initial inst from the InstMap.
- lookup_var(InstMap, Var, OldInst),
+ instmap_lookup_var(InstMap, Var, OldInst),
% Compute the new inst by taking the old inst, applying the instmap
% delta to it, and then unifying with bound(MainConsId, ...).
@@ -588,23 +671,23 @@
% Add `Var :: OldInst -> NewInst' to the instmap delta.
( NewInst \= OldInst ->
- instmap_delta_set(Var, NewInst, !InstmapDelta)
+ instmap_delta_set_var(Var, NewInst, !InstmapDelta)
;
true
)
).
bind_var_to_functor(Var, Type, ConsId, !InstMap, !ModuleInfo) :-
- lookup_var(!.InstMap, Var, Inst0),
+ instmap_lookup_var(!.InstMap, Var, Inst0),
bind_inst_to_functor(Type, ConsId, Inst0, Inst, !ModuleInfo),
- set(Var, Inst, !InstMap).
+ instmap_set_var(Var, Inst, !InstMap).
bind_var_to_functors(Var, Type, MainConsId, OtherConsIds,
!InstMap, !ModuleInfo) :-
- lookup_var(!.InstMap, Var, Inst0),
+ instmap_lookup_var(!.InstMap, Var, Inst0),
bind_inst_to_functors(Type, MainConsId, OtherConsIds, Inst0, Inst,
!ModuleInfo),
- set(Var, Inst, !InstMap).
+ instmap_set_var(Var, Inst, !InstMap).
:- pred bind_inst_to_functor(mer_type::in, cons_id::in,
mer_inst::in, mer_inst::out, module_info::in, module_info::out) is det.
@@ -815,7 +898,7 @@
:- pred lookup_var_in_instmap(prog_var::in, instmap::in, mer_inst::out) is det.
lookup_var_in_instmap(Var, InstMap, Inst) :-
- lookup_var(InstMap, Var, Inst).
+ instmap_lookup_var(InstMap, Var, Inst).
% merge_var_insts:(Insts, Type, !ModuleInfo, MaybeMergedInst):
%
@@ -1029,7 +1112,7 @@
!ModuleInfo, !InstMap, ErrorList) :-
unify_insts_of_vars(Vars, InitialInstMap, InstMapList, !ModuleInfo,
!InstMap, ErrorListTail),
- lookup_var(InitialInstMap, Var, InitialVarInst),
+ instmap_lookup_var(InitialInstMap, Var, InitialVarInst),
unify_var_insts(InstMapList, Var, [], Insts, InitialVarInst, Inst,
!ModuleInfo, no, Error),
(
@@ -1057,7 +1140,7 @@
unify_var_insts([InstMap - Nonlocals| Rest], Var, !InstList, !Inst,
!ModuleInfo, !Error) :-
( set.member(Var, Nonlocals) ->
- lookup_var(InstMap, Var, VarInst),
+ instmap_lookup_var(InstMap, Var, VarInst),
(
% We can ignore the determinism of the unification:
% if it isn't det, then there will be a mode error
@@ -1103,16 +1186,17 @@
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-no_output_vars(_, unreachable, _, _, _).
-no_output_vars(InstMap0, reachable(InstMapDelta), Vars, VT, M) :-
+instmap_delta_no_output_vars(_, unreachable, _, _, _).
+instmap_delta_no_output_vars(InstMap0, reachable(InstMapDelta), Vars, VT, M) :-
set.to_sorted_list(Vars, VarList),
- no_output_vars_2(VarList, InstMap0, InstMapDelta, VT, M).
+ instmap_delta_no_output_vars_2(VarList, InstMap0, InstMapDelta, VT, M).
-:- pred no_output_vars_2(list(prog_var)::in, instmap::in,
+:- pred instmap_delta_no_output_vars_2(list(prog_var)::in, instmap::in,
instmapping::in, vartypes::in, module_info::in) is semidet.
-no_output_vars_2([], _, _, _, _).
-no_output_vars_2([Var | Vars], InstMap0, InstMapDelta, VarTypes, ModuleInfo) :-
+instmap_delta_no_output_vars_2([], _, _, _, _).
+instmap_delta_no_output_vars_2([Var | Vars], InstMap0, InstMapDelta, VarTypes,
+ ModuleInfo) :-
% We use `inst_matches_binding' to check that the new inst has only
% added information or lost uniqueness, not bound anything.
% If the instmap delta contains the variable, the variable may still
@@ -1120,7 +1204,7 @@
% rather than an increase in instantiatedness. If the instmap delta
% doesn't contain the variable, it may still have been (partially) output,
% if its inst is (or contains) `any'.
- lookup_var(InstMap0, Var, Inst0),
+ instmap_lookup_var(InstMap0, Var, Inst0),
( map.search(InstMapDelta, Var, Inst1) ->
Inst = Inst1
;
@@ -1128,7 +1212,8 @@
),
map.lookup(VarTypes, Var, Type),
inst_matches_binding(Inst, Inst0, Type, ModuleInfo),
- no_output_vars_2(Vars, InstMap0, InstMapDelta, VarTypes, ModuleInfo).
+ instmap_delta_no_output_vars_2(Vars, InstMap0, InstMapDelta, VarTypes,
+ ModuleInfo).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -1168,18 +1253,18 @@
( map.search(InstMappingA, Var, InstInA) ->
InstA = InstInA
;
- lookup_var(InstMap, Var, InstA)
+ instmap_lookup_var(InstMap, Var, InstA)
),
( map.search(InstMappingB, Var, InstInB) ->
InstB = InstInB
;
- lookup_var(InstMap, Var, InstB)
+ instmap_lookup_var(InstMap, Var, InstB)
),
(
inst_merge(InstA, InstB, yes(VarTypes ^ det_elem(Var)), Inst1,
!ModuleInfo)
->
- % XXX Given lookup_var(InstMap, Var, OldInst),
+ % XXX Given instmap_lookup_var(InstMap, Var, OldInst),
% we should probably set Inst not directly from Inst1, but
% from a conjunction of OldInst and Inst1. If OldInst says that
% Var is bound to f, and Inst1 says that it is bound to g,
@@ -1280,7 +1365,7 @@
instmap_delta_apply_sub_2(InstMappingAL, Must, Renaming,
map.init, InstMapping).
-apply_sub(Must, Renaming, InstMap0, InstMap) :-
+instmap_apply_sub(Must, Renaming, InstMap0, InstMap) :-
instmap_delta_apply_sub(Must, Renaming, InstMap0, InstMap).
:- pred instmap_delta_apply_sub_2(assoc_list(prog_var, mer_inst)::in,
@@ -1300,8 +1385,8 @@
%-----------------------------------------------------------------------------%
-to_assoc_list(unreachable, []).
-to_assoc_list(reachable(InstMapping), AL) :-
+instmap_to_assoc_list(unreachable, []).
+instmap_to_assoc_list(reachable(InstMapping), AL) :-
map.to_assoc_list(InstMapping, AL).
instmap_delta_to_assoc_list(unreachable, []).
@@ -1311,17 +1396,17 @@
%-----------------------------------------------------------------------------%
var_is_ground_in_instmap(ModuleInfo, InstMap, Var) :-
- lookup_var(InstMap, Var, Inst),
+ instmap_lookup_var(InstMap, Var, Inst),
inst_is_ground(ModuleInfo, Inst).
var_is_any_in_instmap(ModuleInfo, InstMap, Var) :-
- lookup_var(InstMap, Var, Inst),
+ instmap_lookup_var(InstMap, Var, Inst),
inst_is_any(ModuleInfo, Inst).
var_is_bound_in_instmap_delta(ModuleInfo, InstMap, InstMapDelta, Var) :-
- instmap.is_reachable(InstMap),
+ instmap_is_reachable(InstMap),
instmap_delta_is_reachable(InstMapDelta),
- instmap.lookup_var(InstMap, Var, OldVarInst),
+ instmap_lookup_var(InstMap, Var, OldVarInst),
inst_is_free(ModuleInfo, OldVarInst),
instmap_delta_search_var(InstMapDelta, Var, VarInst),
inst_is_bound(ModuleInfo, VarInst).
Index: compiler/intermod.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/intermod.m,v
retrieving revision 1.238
diff -u -b -r1.238 intermod.m
--- compiler/intermod.m 8 Sep 2008 04:35:53 -0000 1.238
+++ compiler/intermod.m 12 Dec 2008 00:44:55 -0000
@@ -479,17 +479,21 @@
:- pred intermod_traverse_goal_expr(hlds_goal_expr::in, hlds_goal_expr::out,
bool::out, intermod_info::in, intermod_info::out) is det.
-intermod_traverse_goal_expr(conj(ConjType, Goals0), conj(ConjType, Goals),
- DoWrite, !Info) :-
- intermod_traverse_list_of_goals(Goals0, Goals, DoWrite, !Info).
-intermod_traverse_goal_expr(disj(Goals0), disj(Goals), DoWrite, !Info) :-
- intermod_traverse_list_of_goals(Goals0, Goals, DoWrite, !Info).
-intermod_traverse_goal_expr(Goal, Goal, DoWrite, !Info) :-
- Goal = plain_call(PredId, _, _, _, _, _),
+intermod_traverse_goal_expr(GoalExpr0, GoalExpr, DoWrite, !Info) :-
+ (
+ GoalExpr0 = unify(LVar, RHS0, Mode, Kind, UnifyContext),
+ % Export declarations for preds used in higher order pred constants
+ % or function calls.
+ module_qualify_unify_rhs(RHS0, RHS, DoWrite, !Info),
+ GoalExpr = unify(LVar, RHS, Mode, Kind, UnifyContext)
+ ;
+ GoalExpr0 = plain_call(PredId, _, _, _, _, _),
% Ensure that the called predicate will be exported.
- add_proc(PredId, DoWrite, !Info).
-intermod_traverse_goal_expr(Goal @ generic_call(CallType, _, _, _), Goal,
- DoWrite, !Info) :-
+ add_proc(PredId, DoWrite, !Info),
+ GoalExpr = GoalExpr0
+ ;
+ GoalExpr0 = generic_call(CallType, _, _, _),
+ GoalExpr = GoalExpr0,
(
CallType = higher_order(_, _, _, _),
DoWrite = yes
@@ -499,30 +503,12 @@
; CallType = cast(_)
),
DoWrite = no
- ).
-intermod_traverse_goal_expr(switch(Var, CanFail, Cases0),
- switch(Var, CanFail, Cases), DoWrite, !Info) :-
- intermod_traverse_cases(Cases0, Cases, DoWrite, !Info).
- % Export declarations for preds used in higher order pred constants
- % or function calls.
-intermod_traverse_goal_expr(unify(LVar, RHS0, C, D, E),
- unify(LVar, RHS, C, D, E), DoWrite, !Info) :-
- module_qualify_unify_rhs(RHS0, RHS, DoWrite, !Info).
-intermod_traverse_goal_expr(negation(Goal0), negation(Goal), DoWrite, !Info) :-
- intermod_traverse_goal(Goal0, Goal, DoWrite, !Info).
-intermod_traverse_goal_expr(scope(Reason, Goal0), scope(Reason, Goal),
- DoWrite, !Info) :-
- intermod_traverse_goal(Goal0, Goal, DoWrite, !Info).
-intermod_traverse_goal_expr(if_then_else(Vars, Cond0, Then0, Else0),
- if_then_else(Vars, Cond, Then, Else), DoWrite, !Info) :-
- intermod_traverse_goal(Cond0, Cond, DoWrite1, !Info),
- intermod_traverse_goal(Then0, Then, DoWrite2, !Info),
- intermod_traverse_goal(Else0, Else, DoWrite3, !Info),
- bool.and_list([DoWrite1, DoWrite2, DoWrite3], DoWrite).
+ )
+ ;
+ GoalExpr0 = call_foreign_proc(Attrs, _, _, _, _, _, _),
+ GoalExpr = GoalExpr0,
% Inlineable exported pragma_foreign_code goals can't use any
% non-exported types, so we just write out the clauses.
-intermod_traverse_goal_expr(Goal @ call_foreign_proc(Attrs, _, _, _, _, _, _),
- Goal, DoWrite, !Info) :-
MaybeMayDuplicate = get_may_duplicate(Attrs),
(
MaybeMayDuplicate = yes(MayDuplicate),
@@ -536,9 +522,40 @@
;
MaybeMayDuplicate = no,
DoWrite = yes
- ).
-intermod_traverse_goal_expr(shorthand(ShortHand0), shorthand(ShortHand),
- DoWrite, !Info) :-
+ )
+ ;
+ GoalExpr0 = conj(ConjType, Goals0),
+ intermod_traverse_list_of_goals(Goals0, Goals, DoWrite, !Info),
+ GoalExpr = conj(ConjType, Goals)
+ ;
+ GoalExpr0 = disj(Goals0),
+ intermod_traverse_list_of_goals(Goals0, Goals, DoWrite, !Info),
+ GoalExpr = disj(Goals)
+ ;
+ GoalExpr0 = switch(Var, CanFail, Cases0),
+ intermod_traverse_cases(Cases0, Cases, DoWrite, !Info),
+ GoalExpr = switch(Var, CanFail, Cases)
+ ;
+ GoalExpr0 = if_then_else(Vars, Cond0, Then0, Else0),
+ intermod_traverse_goal(Cond0, Cond, DoWrite1, !Info),
+ intermod_traverse_goal(Then0, Then, DoWrite2, !Info),
+ intermod_traverse_goal(Else0, Else, DoWrite3, !Info),
+ bool.and_list([DoWrite1, DoWrite2, DoWrite3], DoWrite),
+ GoalExpr = if_then_else(Vars, Cond, Then, Else)
+ ;
+ GoalExpr0 = negation(SubGoal0),
+ intermod_traverse_goal(SubGoal0, SubGoal, DoWrite, !Info),
+ GoalExpr = negation(SubGoal)
+ ;
+ GoalExpr0 = scope(Reason, SubGoal0),
+ % Mode analysis hasn't been run yet, so we don't know yet whether
+ % from_ground_term_construct scopes actually satisfy their invariants,
+ % specifically the invariant that say they contain no calls or
+ % higher-order constants. We therefore cannot special-case them here.
+ intermod_traverse_goal(SubGoal0, SubGoal, DoWrite, !Info),
+ GoalExpr = scope(Reason, SubGoal)
+ ;
+ GoalExpr0 = shorthand(ShortHand0),
(
ShortHand0 = atomic_goal(GoalType, Outer, Inner, MaybeOutputVars,
MainGoal0, OrElseGoals0),
@@ -551,7 +568,10 @@
;
ShortHand0 = bi_implication(_, _),
% These should have been expanded out by now.
- unexpected(this_file, "intermod_traverse_goal_expr: bi_implication")
+ unexpected(this_file,
+ "intermod_traverse_goal_expr: bi_implication")
+ ),
+ GoalExpr = shorthand(ShortHand)
).
:- pred intermod_traverse_list_of_goals(hlds_goals::in, hlds_goals::out,
@@ -619,16 +639,14 @@
ProcIds = pred_info_procids(PredInfo),
pred_info_get_markers(PredInfo, Markers),
(
- %
% Calling compiler-generated procedures is fine; we don't need
% to output declarations for them to the `.opt' file, since they
% will be recreated every time anyway.
- %
+
is_unify_or_compare_pred(PredInfo)
->
DoWrite = yes
;
- %
% Don't write the caller to the `.opt' file if it calls a pred
% without mode or determinism decls, because we'd need to include
% the mode decls for the callee in the `.opt' file and (since
@@ -637,7 +655,7 @@
%
% XXX This prevents intermodule optimizations in such cases,
% which is a pity.
- %
+
(
check_marker(Markers, marker_infer_modes)
;
@@ -671,17 +689,16 @@
% the compiler generated mutable access predicates we can ensure
% that reordering is not necessary by construction, so it's safe
% to include them in .opt files.
- %
+
pred_info_get_purity(PredInfo, purity_impure),
not check_marker(Markers, marker_mutable_access_pred)
->
DoWrite = no
;
- %
% If a pred whose code we're going to put in the .opt file calls
% a predicate which is exported, then we don't need to do anything
% special.
- %
+
(
Status = status_exported
;
@@ -691,21 +708,19 @@
->
DoWrite = yes
;
- %
% Declarations for class methods will be recreated from the class
% declaration in the `.opt' file. Declarations for local classes
% are always written to the `.opt' file.
- %
+
pred_info_get_markers(PredInfo, Markers),
check_marker(Markers, marker_class_method)
->
DoWrite = yes
;
- %
% If a pred whose code we're going to put in the `.opt' file calls
% a predicate which is local to that module, then we need to put
% the declaration for the called predicate in the `.opt' file.
- %
+
import_status_to_write(Status)
->
DoWrite = yes,
@@ -717,9 +732,8 @@
; Status = status_opt_imported
)
->
- %
% Imported pred - add import for module.
- %
+
DoWrite = yes,
PredModule = pred_info_module(PredInfo),
intermod_info_get_modules(!.Info, Modules0),
@@ -743,9 +757,11 @@
RHS = RHS0,
DoWrite = yes
;
- RHS0 = rhs_lambda_goal(A, B, C, D, E, F, G, H, Goal0),
+ RHS0 = rhs_lambda_goal(Purity, HOGroundness, PorF, EvalMethod,
+ NonLocals, QuantVars, Modes, Detism, Goal0),
intermod_traverse_goal(Goal0, Goal, DoWrite, !Info),
- RHS = rhs_lambda_goal(A, B, C, D, E, F, G, H, Goal)
+ RHS = rhs_lambda_goal(Purity, HOGroundness, PorF, EvalMethod,
+ NonLocals, QuantVars, Modes, Detism, Goal)
;
RHS0 = rhs_functor(Functor, _Exist, _Vars),
RHS = RHS0,
@@ -795,11 +811,11 @@
DefinedThisModule = status_defined_in_this_module(Status),
(
DefinedThisModule = yes,
- %
+
% The bodies are always stripped from instance declarations
% before writing them to `int' files, so the full instance
% declaration should be written even for exported instances.
- %
+
SaveInfo = !.Info,
(
Interface0 = instance_body_concrete(Methods0),
@@ -943,7 +959,6 @@
MethodArity, MethodCallTVarSet, MethodCallExistQTVars,
MethodCallArgTypes, MethodCallHeadTypeParams, MethodContext,
MaybePredId, InstanceMethodName) :-
-
module_info_get_ctor_field_table(ModuleInfo, CtorFieldTable),
(
is_field_access_function_name(ModuleInfo, InstanceMethodName0,
@@ -1081,14 +1096,13 @@
module_info_get_globals(ModuleInfo, Globals),
globals.get_target(Globals, Target),
- %
% Note that we don't resolve overloading for the foreign definitions
% which won't be used on this back-end, because their unification and
% comparison predicates have not been typechecked. They are only written
% to the `.opt' it can be handy when building against a workspace
% for the other definitions to be present (e.g. when testing compiling
% a module to IL when the workspace was compiled to C).
- %
+
(
( Target = target_c
; Target = target_asm
@@ -1722,7 +1736,8 @@
(
% Pull the foreign code out of the goal.
Goal = hlds_goal(conj(plain_conj, Goals), _),
- list.filter((pred(X::in) is semidet :-
+ list.filter(
+ (pred(X::in) is semidet :-
X = hlds_goal(call_foreign_proc(_, _, _, _, _, _, _), _)
), Goals, [ForeignCodeGoal]),
ForeignCodeGoal = hlds_goal(call_foreign_proc(Attributes,
@@ -2355,9 +2370,7 @@
[], AncestorImports1,
[], AncestorImports2, !Module, !IO),
- %
% Figure out which .int files are needed by the .opt files
- %
get_dependencies(OptItems, NewImportDeps0, NewUseDeps0),
globals.io_get_globals(Globals, !IO),
get_implicit_dependencies(OptItems, Globals,
Index: compiler/interval.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/interval.m,v
retrieving revision 1.38
diff -u -b -r1.38 interval.m
--- compiler/interval.m 27 Feb 2008 07:23:07 -0000 1.38
+++ compiler/interval.m 11 Dec 2008 15:53:48 -0000
@@ -275,8 +275,15 @@
leave_branch_start(branch_ite, StartAnchor, BeforeId, MaybeResumeVars,
CondOpenIntervals, !IntervalInfo)
;
- GoalExpr = scope(_Reason, SubGoal),
+ GoalExpr = scope(Reason, SubGoal),
+ ( Reason = from_ground_term(TermVar, from_ground_term_construct) ->
+ % We treat this scope as a construction unification that unifies
+ % TermVar with a single big variable-free term, since this is what
+ % the generated code will do.
+ require_access([TermVar], !IntervalInfo)
+ ;
build_interval_info_in_goal(SubGoal, !IntervalInfo, !Acc)
+ )
;
GoalExpr = generic_call(GenericCall, ArgVars, ArgModes, _Detism),
goal_info_get_maybe_need_across_call(GoalInfo, MaybeNeedAcrossCall),
@@ -947,9 +954,9 @@
rename_var_list(need_not_rename, !.VarRename, Vars0, Vars),
Reason = exist_quant(Vars)
;
- Reason0 = from_ground_term(Var0),
+ Reason0 = from_ground_term(Var0, Kind),
rename_var(need_not_rename, !.VarRename, Var0, Var),
- Reason = from_ground_term(Var)
+ Reason = from_ground_term(Var, Kind)
;
( Reason0 = promise_purity(_, _)
; Reason0 = promise_solutions(_, _)
@@ -959,10 +966,15 @@
),
Reason = Reason0
),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ % There won't be any decisions to record.
+ Goal = Goal0
+ ;
record_decisions_in_goal(SubGoal0, SubGoal, !VarInfo, !VarRename,
InsertMap, MaybeFeature),
GoalExpr = scope(Reason, SubGoal),
Goal = hlds_goal(GoalExpr, GoalInfo0)
+ )
;
GoalExpr0 = generic_call(GenericCall, _, _, _),
% Casts are generated inline.
Index: compiler/ite_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ite_gen.m,v
retrieving revision 1.106
diff -u -b -r1.106 ite_gen.m
--- compiler/ite_gen.m 28 Nov 2008 06:36:58 -0000 1.106
+++ compiler/ite_gen.m 11 Dec 2008 15:53:48 -0000
@@ -196,7 +196,7 @@
goal_info_get_store_map(IteGoalInfo, StoreMap),
get_instmap(!.CI, EndCondInstMap),
- ( instmap.is_unreachable(EndCondInstMap) ->
+ ( instmap_is_unreachable(EndCondInstMap) ->
% If the instmap indicates we cannot reach the then part,
% do not attempt to generate it (may cause aborts).
ThenTraceCode = empty,
Index: compiler/lambda.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/lambda.m,v
retrieving revision 1.136
diff -u -b -r1.136 lambda.m
--- compiler/lambda.m 22 Oct 2008 05:42:57 -0000 1.136
+++ compiler/lambda.m 11 Dec 2008 15:53:48 -0000
@@ -218,11 +218,11 @@
:- pred lambda_process_goal(hlds_goal::in, hlds_goal::out,
lambda_info::in, lambda_info::out) is det.
-lambda_process_goal(hlds_goal(GoalExpr0, GoalInfo),
- hlds_goal(GoalExpr, GoalInfo), !Info) :-
+lambda_process_goal(Goal0, Goal, !Info) :-
+ Goal0 = hlds_goal(GoalExpr0, GoalInfo),
(
- GoalExpr0 = unify(XVar, Y, Mode, Unification, Context),
- lambda_process_unify_goal(XVar, Y, Mode, Unification, Context,
+ GoalExpr0 = unify(LHS, RHS, Mode, Unification, Context),
+ lambda_process_unify_goal(LHS, RHS, Mode, Unification, Context,
GoalExpr, !Info)
;
GoalExpr0 = conj(ConjType, Goals0),
@@ -233,17 +233,23 @@
lambda_process_goal_list(Goals0, Goals, !Info),
GoalExpr = disj(Goals)
;
- GoalExpr0 = negation(Goal0),
- lambda_process_goal(Goal0, Goal, !Info),
- GoalExpr = negation(Goal)
- ;
GoalExpr0 = switch(Var, CanFail, Cases0),
lambda_process_cases(Cases0, Cases, !Info),
GoalExpr = switch(Var, CanFail, Cases)
;
- GoalExpr0 = scope(Reason, Goal0),
- lambda_process_goal(Goal0, Goal, !Info),
- GoalExpr = scope(Reason, Goal)
+ GoalExpr0 = negation(SubGoal0),
+ lambda_process_goal(SubGoal0, SubGoal, !Info),
+ GoalExpr = negation(SubGoal)
+ ;
+ GoalExpr0 = scope(Reason, SubGoal0),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ % If the scope had any rhs_lambda_goals, modes.m wouldn't have
+ % left its kind field as from_ground_term_construct.
+ GoalExpr = GoalExpr0
+ ;
+ lambda_process_goal(SubGoal0, SubGoal, !Info),
+ GoalExpr = scope(Reason, SubGoal)
+ )
;
GoalExpr0 = if_then_else(Vars, Cond0, Then0, Else0),
lambda_process_goal(Cond0, Cond, !Info),
@@ -271,7 +277,8 @@
% These should have been expanded out by now.
unexpected(this_file, "lambda_process_goal_2: bi_implication")
)
- ).
+ ),
+ Goal = hlds_goal(GoalExpr, GoalInfo).
:- pred lambda_process_goal_list(list(hlds_goal)::in, list(hlds_goal)::out,
lambda_info::in, lambda_info::out) is det.
Index: compiler/lco.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/lco.m,v
retrieving revision 1.55
diff -u -b -r1.55 lco.m
--- compiler/lco.m 7 Oct 2008 05:27:43 -0000 1.55
+++ compiler/lco.m 11 Dec 2008 15:53:48 -0000
@@ -353,8 +353,8 @@
:- pred lco_in_goal(hlds_goal::in, hlds_goal::out, lco_info::in, lco_info::out,
lco_const_info::in) is det.
-lco_in_goal(hlds_goal(GoalExpr0, GoalInfo), hlds_goal(GoalExpr, GoalInfo),
- !Info, ConstInfo) :-
+lco_in_goal(Goal0, Goal, !Info, ConstInfo) :-
+ Goal0 = hlds_goal(GoalExpr0, GoalInfo),
(
GoalExpr0 = conj(ConjType, Goals0),
(
@@ -403,8 +403,12 @@
GoalExpr = if_then_else(Vars, Cond, Then, Else)
;
GoalExpr0 = scope(Reason, SubGoal0),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ GoalExpr = GoalExpr0
+ ;
lco_in_goal(SubGoal0, SubGoal, !Info, ConstInfo),
GoalExpr = scope(Reason, SubGoal)
+ )
;
( GoalExpr0 = negation(_)
; GoalExpr0 = generic_call(_, _, _, _)
@@ -417,7 +421,8 @@
GoalExpr0 = shorthand(_),
% These should have been expanded out by now.
unexpected(this_file, "lco_in_goal: shorthand")
- ).
+ ),
+ Goal = hlds_goal(GoalExpr, GoalInfo).
%-----------------------------------------------------------------------------%
@@ -781,7 +786,7 @@
AddrArgsTail, !InstMapDelta),
( map.search(Subst, OrigVar, AddrVar) ->
UpdatedVar = AddrVar,
- instmap_delta_set(AddrVar, ground(shared, none), !InstMapDelta),
+ instmap_delta_set_var(AddrVar, ground(shared, none), !InstMapDelta),
AddrArgs = [ArgNum | AddrArgsTail]
;
UpdatedVar = OrigVar,
@@ -921,9 +926,14 @@
GoalExpr = if_then_else(Vars, Cond, Then, Else)
;
GoalExpr0 = scope(Reason, SubGoal0),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ GoalExpr = GoalExpr0,
+ Changed = no
+ ;
transform_variant_goal(ModuleInfo, VarToAddr, InstMap0,
SubGoal0, SubGoal, Changed),
GoalExpr = scope(Reason, SubGoal)
+ )
;
GoalExpr0 = negation(_),
GoalExpr = GoalExpr0,
@@ -1012,9 +1022,9 @@
pair(prog_var)::in) is semidet.
is_grounding(ModuleInfo, InstMap0, InstMap, Var - _AddrVar) :-
- instmap.lookup_var(InstMap0, Var, Inst0),
+ instmap_lookup_var(InstMap0, Var, Inst0),
not inst_is_ground(ModuleInfo, Inst0),
- instmap.lookup_var(InstMap, Var, Inst),
+ instmap_lookup_var(InstMap, Var, Inst),
inst_is_ground(ModuleInfo, Inst).
:- pred make_store_goal(module_info::in, pair(prog_var)::in,
Index: compiler/live_vars.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/live_vars.m,v
retrieving revision 1.137
diff -u -b -r1.137 live_vars.m
--- compiler/live_vars.m 27 Feb 2008 07:23:08 -0000 1.137
+++ compiler/live_vars.m 11 Dec 2008 23:57:03 -0000
@@ -323,15 +323,26 @@
GoalExpr = if_then_else(Vars, Cond, Then, Else),
GoalInfo = GoalInfo0
;
- GoalExpr0 = negation(Goal0),
- build_live_sets_in_goal(Goal0, Goal, ResumeVars0, AllocData,
+ GoalExpr0 = negation(SubGoal0),
+ build_live_sets_in_goal(SubGoal0, SubGoal, ResumeVars0, AllocData,
!StackAlloc, !Liveness, !NondetLiveness, !ParStackVars),
- GoalExpr = negation(Goal),
+ GoalExpr = negation(SubGoal),
GoalInfo = GoalInfo0
;
- GoalExpr0 = scope(Reason, Goal0),
+ GoalExpr0 = scope(Reason, SubGoal0),
+ ( Reason = from_ground_term(TermVar, from_ground_term_construct) ->
+ % We do not modify construct unifications or conjunctions,
+ % so we do not modify these scopes, which contain only a
+ % conjunction of construct unifications.
+ GoalExpr = GoalExpr0,
+ GoalInfo = GoalInfo0,
+ % The scope does not contain any calls, resume points or parallel
+ % conjunctions, so there are no updates to !StackAlloc,
+ % !NondetLiveness, or !ParStackVars.
+ set.insert(!.Liveness, TermVar, !:Liveness)
+ ;
NondetLiveness0 = !.NondetLiveness,
- build_live_sets_in_goal(Goal0, Goal, ResumeVars0, AllocData,
+ build_live_sets_in_goal(SubGoal0, SubGoal, ResumeVars0, AllocData,
!StackAlloc, !Liveness, !NondetLiveness, !ParStackVars),
% If the "some" goal cannot succeed more than once, then execution
% cannot backtrack into the inner goal once control has left it.
@@ -346,8 +357,9 @@
),
!:NondetLiveness = NondetLiveness0
),
- GoalExpr = scope(Reason, Goal),
+ GoalExpr = scope(Reason, SubGoal),
GoalInfo = GoalInfo0
+ )
;
GoalExpr0 = generic_call(GenericCall, ArgVars, Modes, _Det),
GoalExpr = GoalExpr0,
Index: compiler/liveness.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/liveness.m,v
retrieving revision 1.165
diff -u -b -r1.165 liveness.m
--- compiler/liveness.m 2 Jun 2008 02:27:26 -0000 1.165
+++ compiler/liveness.m 12 Dec 2008 04:59:51 -0000
@@ -201,6 +201,7 @@
:- import_module libs.options.
:- import_module libs.trace_params.
:- import_module ll_backend.trace_gen.
+:- import_module parse_tree.mercury_to_mercury.
:- import_module assoc_list.
:- import_module bool.
@@ -360,8 +361,8 @@
:- pred detect_liveness_in_goal(hlds_goal::in, hlds_goal::out,
set(prog_var)::in, set(prog_var)::out, live_info::in) is det.
-detect_liveness_in_goal(hlds_goal(GoalExpr0, GoalInfo0),
- hlds_goal(GoalExpr, GoalInfo), Liveness0, Liveness, LiveInfo) :-
+detect_liveness_in_goal(Goal0, Goal, Liveness0, FinalLiveness, LiveInfo) :-
+ Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
% Work out which variables get born in this goal.
liveness.get_nonlocals_and_typeinfos(LiveInfo, GoalInfo0,
BaseNonLocals, CompletedNonLocals),
@@ -379,76 +380,56 @@
set.difference(TypeInfos, Liveness0, NewTypeInfos),
set.union(Births1, NewTypeInfos, Births)
),
- set.union(Liveness0, Births, Liveness),
- HasSubGoals = goal_expr_has_subgoals(GoalExpr0),
+ set.union(Liveness0, Births, FinalLiveness),
+
(
- HasSubGoals = does_not_have_subgoals,
- PreDeaths = Empty,
+ ( GoalExpr0 = plain_call(_, _, _, _, _, _)
+ ; GoalExpr0 = generic_call(_, _, _, _)
+ ; GoalExpr0 = call_foreign_proc(_,_, _, _, _, _, _)
+ ; GoalExpr0 = unify(_, _, _, _, _)
+ ),
+ PreDeaths = set.init,
PreBirths = Births,
- PostDeaths = Empty,
- PostBirths = Empty,
+ PostDeaths = set.init,
+ PostBirths = set.init,
GoalExpr = GoalExpr0
;
- HasSubGoals = has_subgoals,
- PreDeaths = Empty,
- PreBirths = Empty,
- detect_liveness_in_goal_2(GoalExpr0, GoalExpr, Liveness0,
- ActualLiveness, CompletedNonLocals, LiveInfo),
- set.intersect(CompletedNonLocals, ActualLiveness, NonLocalLiveness),
- set.union(NonLocalLiveness, Liveness0, FinalLiveness),
- set.difference(FinalLiveness, Liveness, PostDeaths),
- set.difference(Liveness, FinalLiveness, PostBirths)
- ),
- % We initialize all the fields in order to obliterate any annotations
- % left by a previous invocation of this module.
- goal_info_initialize_liveness_info(PreBirths, PostBirths,
- PreDeaths, PostDeaths, no_resume_point, GoalInfo0, GoalInfo).
-
-%-----------------------------------------------------------------------------%
-
- % Here we process each of the different sorts of goals.
- %
-:- pred detect_liveness_in_goal_2(hlds_goal_expr::in, hlds_goal_expr::out,
- set(prog_var)::in, set(prog_var)::out, set(prog_var)::in,
- live_info::in) is det.
-
-detect_liveness_in_goal_2(GoalExpr0, GoalExpr, !Liveness,
- NonLocals, LiveInfo) :-
(
GoalExpr0 = conj(ConjType, Goals0),
(
ConjType = plain_conj,
- detect_liveness_in_conj(Goals0, Goals, !Liveness, LiveInfo)
+ detect_liveness_in_conj(Goals0, Goals, Liveness0, Liveness,
+ LiveInfo)
;
ConjType = parallel_conj,
set.init(Union0),
- detect_liveness_in_par_conj(Goals0, Goals, !.Liveness, NonLocals,
- LiveInfo, Union0, Union),
- set.union(Union, !Liveness)
+ detect_liveness_in_par_conj(Goals0, Goals, Liveness0,
+ CompletedNonLocals, LiveInfo, Union0, Union),
+ set.union(Union, Liveness0, Liveness)
),
GoalExpr = conj(ConjType, Goals)
;
GoalExpr0 = disj(Goals0),
set.init(Union0),
- detect_liveness_in_disj(Goals0, Goals, !.Liveness, NonLocals,
- LiveInfo, Union0, Union),
- set.union(Union, !Liveness),
+ detect_liveness_in_disj(Goals0, Goals, Liveness0,
+ CompletedNonLocals, LiveInfo, Union0, Union),
+ set.union(Union, Liveness0, Liveness),
GoalExpr = disj(Goals)
;
GoalExpr0 = switch(Var, Det, Cases0),
- detect_liveness_in_cases(Cases0, Cases, !.Liveness, NonLocals,
- LiveInfo, !Liveness),
+ detect_liveness_in_cases(Cases0, Cases, Liveness0,
+ CompletedNonLocals, LiveInfo, Liveness0, Liveness),
GoalExpr = switch(Var, Det, Cases)
;
GoalExpr0 = if_then_else(Vars, Cond0, Then0, Else0),
- Liveness0 = !.Liveness,
detect_liveness_in_goal(Cond0, Cond, Liveness0, LivenessCond,
LiveInfo),
- % If the condition cannot succeed, any variables which become live
- % in the else part should be put in the post-birth set of the then part
- % by add_liveness_after_goal, and the other sets should be empty.
+ % If the condition cannot succeed, any variables which become
+ % live in the else part should be put in the post-birth set
+ % of the then part by add_liveness_after_goal, and the other
+ % sets should be empty.
Cond = hlds_goal(_, CondInfo),
CondDelta = goal_info_get_instmap_delta(CondInfo),
( instmap_delta_is_unreachable(CondDelta) ->
@@ -463,40 +444,47 @@
LiveInfo),
set.union(LivenessThen, LivenessElse, Liveness),
- set.intersect(Liveness, NonLocals, NonLocalLiveness),
+ set.intersect(Liveness, CompletedNonLocals,
+ ITENonLocalLiveness),
- set.difference(NonLocalLiveness, LivenessThen, ResidueThen),
- set.difference(NonLocalLiveness, LivenessElse, ResidueElse),
+ set.difference(ITENonLocalLiveness, LivenessThen, ResidueThen),
+ set.difference(ITENonLocalLiveness, LivenessElse, ResidueElse),
add_liveness_after_goal(Then1, ResidueThen, Then),
add_liveness_after_goal(Else1, ResidueElse, Else),
- !:Liveness = Liveness,
GoalExpr = if_then_else(Vars, Cond, Then, Else)
;
GoalExpr0 = negation(SubGoal0),
- detect_liveness_in_goal(SubGoal0, SubGoal, !Liveness, LiveInfo),
+ detect_liveness_in_goal(SubGoal0, SubGoal, Liveness0, Liveness,
+ LiveInfo),
GoalExpr = negation(SubGoal)
;
GoalExpr0 = scope(Reason, SubGoal0),
- detect_liveness_in_goal(SubGoal0, SubGoal, !Liveness, LiveInfo),
- GoalExpr = scope(Reason, SubGoal)
+ ( Reason = from_ground_term(TermVar, from_ground_term_construct) ->
+ detect_liveness_in_construct(SubGoal0, SubGoal,
+ Liveness0, Liveness, TermVar)
;
- GoalExpr0 = plain_call(_, _, _, _, _, _),
- unexpected(this_file, "detect_liveness_in_goal_2: plain_call")
- ;
- GoalExpr0 = generic_call(_, _, _, _),
- unexpected(this_file, "detect_liveness_in_goal_2: generic_call")
- ;
- GoalExpr0 = call_foreign_proc(_,_, _, _, _, _, _),
- unexpected(this_file, "detect_liveness_in_goal_2: call_foreign_proc")
- ;
- GoalExpr0 = unify(_, _, _, _, _),
- unexpected(this_file, "detect_liveness_in_goal_2: unify")
+ detect_liveness_in_goal(SubGoal0, SubGoal, Liveness0, Liveness,
+ LiveInfo)
+ ),
+ GoalExpr = scope(Reason, SubGoal)
+ ),
+ PreDeaths = set.init,
+ PreBirths = set.init,
+ set.intersect(CompletedNonLocals, Liveness, NonLocalLiveness),
+ set.union(NonLocalLiveness, Liveness0, GoalFinalLiveness),
+ set.difference(GoalFinalLiveness, FinalLiveness, PostDeaths),
+ set.difference(FinalLiveness, GoalFinalLiveness, PostBirths)
;
GoalExpr0 = shorthand(_),
- unexpected(this_file, "detect_liveness_in_goal_2: shorthand")
- ).
+ unexpected(this_file, "detect_liveness_in_goal: shorthand")
+ ),
+ % We always initialize all the liveness-related fields in order to
+ % obliterate any annotations left by a previous invocation of this module.
+ goal_info_initialize_liveness_info(PreBirths, PostBirths,
+ PreDeaths, PostDeaths, no_resume_point, GoalInfo0, GoalInfo),
+ Goal = hlds_goal(GoalExpr, GoalInfo).
%-----------------------------------------------------------------------------%
@@ -560,6 +548,67 @@
%-----------------------------------------------------------------------------%
+:- pred detect_liveness_in_construct(hlds_goal::in, hlds_goal::out,
+ set(prog_var)::in, set(prog_var)::out, prog_var::in) is det.
+
+detect_liveness_in_construct(Goal0, Goal, !Liveness, TermVar) :-
+ Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
+ ( GoalExpr0 = conj(plain_conj, Conjuncts0) ->
+ set.init(LocalLiveVars0),
+ detect_liveness_in_construct_goal_loop(Conjuncts0, Conjuncts,
+ LocalLiveVars0, LocalLiveVars),
+ ( set.singleton_set(LocalLiveVars, TermVar) ->
+ set.insert(!.Liveness, TermVar, !:Liveness),
+ GoalExpr = conj(plain_conj, Conjuncts),
+ set.init(PreBirths),
+ set.init(PostBirths),
+ set.init(PreDeaths),
+ set.init(PostDeaths),
+ goal_info_initialize_liveness_info(PreBirths, PostBirths,
+ PreDeaths, PostDeaths, no_resume_point, GoalInfo0, GoalInfo),
+ Goal = hlds_goal(GoalExpr, GoalInfo)
+ ;
+ unexpected(this_file,
+ "detect_liveness_in_construct: unexpected liveness")
+ )
+ ;
+ unexpected(this_file, "detect_liveness_in_construct: not conj")
+ ).
+
+:- pred detect_liveness_in_construct_goal_loop(
+ list(hlds_goal)::in, list(hlds_goal)::out,
+ set(prog_var)::in, set(prog_var)::out) is det.
+
+detect_liveness_in_construct_goal_loop([], [], !LocalLiveVars).
+detect_liveness_in_construct_goal_loop([Goal0 | Goals0], [Goal | Goals],
+ !LocalLiveVars) :-
+ Goal0 = hlds_goal(GoalExpr, GoalInfo0),
+ (
+ GoalExpr = unify(_, _, _, Unification, _),
+ Unification = construct(LHSVar, _ConsId, RHSVars, _ArgModes,
+ construct_statically(_), cell_is_shared, no_construct_sub_info)
+ ->
+ ( set.remove_list(!.LocalLiveVars, RHSVars, !:LocalLiveVars) ->
+ set.insert(!.LocalLiveVars, LHSVar, !:LocalLiveVars),
+ PreBirths = set.make_singleton_set(LHSVar),
+ set.init(PostBirths),
+ set.init(PreDeaths),
+ set.list_to_set(RHSVars, PostDeaths),
+ goal_info_initialize_liveness_info(PreBirths, PostBirths,
+ PreDeaths, PostDeaths, no_resume_point, GoalInfo0, GoalInfo),
+ Goal = hlds_goal(GoalExpr, GoalInfo)
+ ;
+ unexpected(this_file,
+ "detect_liveness_in_construct_goal_loop: rhs var not live")
+ )
+ ;
+ unexpected(this_file,
+ "detect_liveness_in_construct_goal_loop: unexpected conjunct")
+ ),
+ detect_liveness_in_construct_goal_loop(Goals0, Goals, !LocalLiveVars).
+
+%-----------------------------------------------------------------------------%
+
:- pred detect_liveness_in_par_conj(list(hlds_goal)::in, list(hlds_goal)::out,
set(prog_var)::in, set(prog_var)::in, live_info::in,
set(prog_var)::in, set(prog_var)::out) is det.
@@ -582,8 +631,8 @@
set(prog_var)::in, set(prog_var)::out, set(prog_var)::in,
live_info::in) is det.
-detect_deadness_in_goal(hlds_goal(GoalExpr0, GoalInfo0),
- hlds_goal(GoalExpr, GoalInfo), !Deadness, !.Liveness, LiveInfo) :-
+detect_deadness_in_goal(Goal0, Goal, !Deadness, !.Liveness, LiveInfo) :-
+ Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
goal_info_get_pre_deaths(GoalInfo0, PreDeaths0),
goal_info_get_pre_births(GoalInfo0, PreBirths0),
goal_info_get_post_deaths(GoalInfo0, PostDeaths0),
@@ -595,10 +644,14 @@
set.difference(!.Liveness, PreDeaths0, !:Liveness),
set.union(PreBirths0, !Liveness),
- set.init(Empty),
- HasSubGoals = goal_expr_has_subgoals(GoalExpr0),
(
- HasSubGoals = does_not_have_subgoals,
+ ( GoalExpr0 = plain_call(_, _, _, _, _, _)
+ ; GoalExpr0 = generic_call(_, _, _, _)
+ ; GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _)
+ ; GoalExpr0 = unify(_, _, _, _, _)
+ ; GoalExpr0 = conj(_, [])
+ ; GoalExpr0 = disj([])
+ ),
liveness.get_nonlocals_and_typeinfos(LiveInfo, GoalInfo0,
_BaseNonLocals, CompletedNonLocals),
set.intersect(!.Liveness, CompletedNonLocals, LiveNonLocals),
@@ -606,76 +659,61 @@
set.union(NewPostDeaths, !Deadness),
GoalExpr = GoalExpr0
;
- HasSubGoals = has_subgoals,
- NewPostDeaths = Empty,
- detect_deadness_in_goal_2(GoalExpr0, GoalExpr, GoalInfo0,
- !Deadness, !.Liveness, LiveInfo)
- ),
- set.union(PostDeaths0, NewPostDeaths, PostDeaths),
- goal_info_set_post_deaths(PostDeaths, GoalInfo0, GoalInfo),
-
- set.difference(!.Deadness, PreBirths0, !:Deadness),
- set.union(PreDeaths0, !Deadness).
-
- % Here we process each of the different sorts of goals.
- %
-:- pred detect_deadness_in_goal_2(hlds_goal_expr::in, hlds_goal_expr::out,
- hlds_goal_info::in, set(prog_var)::in, set(prog_var)::out,
- set(prog_var)::in, live_info::in) is det.
-
-detect_deadness_in_goal_2(GoalExpr0, GoalExpr, GoalInfo, !Deadness,
- Liveness0, LiveInfo) :-
- (
- GoalExpr0 = conj(ConjType, Goals0),
+ GoalExpr0 = conj(ConjType, Conjuncts0),
+ Conjuncts0 = [_ | _],
(
ConjType = plain_conj,
- detect_deadness_in_conj(Goals0, Goals, !Deadness,
- Liveness0, LiveInfo)
+ detect_deadness_in_conj(Conjuncts0, Conjuncts, !Deadness,
+ !.Liveness, LiveInfo)
;
ConjType = parallel_conj,
- liveness.get_nonlocals_and_typeinfos(LiveInfo, GoalInfo,
+ liveness.get_nonlocals_and_typeinfos(LiveInfo, GoalInfo0,
_, CompletedNonLocals),
set.init(Union0),
- detect_deadness_in_par_conj(Goals0, Goals, !.Deadness, Liveness0,
- CompletedNonLocals, LiveInfo, Union0, Union,
+ detect_deadness_in_par_conj(Conjuncts0, Conjuncts, !.Deadness,
+ !.Liveness, CompletedNonLocals, LiveInfo, Union0, Union,
_CompletedNonLocalUnion),
!:Deadness = Union
),
- GoalExpr = conj(ConjType, Goals)
+ NewPostDeaths = set.init,
+ GoalExpr = conj(ConjType, Conjuncts)
;
- GoalExpr0 = disj(Goals0),
+ GoalExpr0 = disj(Disjuncts0),
+ Disjuncts0 = [_ | _],
set.init(Union0),
- liveness.get_nonlocals_and_typeinfos(LiveInfo, GoalInfo,
+ liveness.get_nonlocals_and_typeinfos(LiveInfo, GoalInfo0,
_, CompletedNonLocals),
- detect_deadness_in_disj(Goals0, Goals, !.Deadness, Liveness0,
+ detect_deadness_in_disj(Disjuncts0, Disjuncts, !.Deadness, !.Liveness,
CompletedNonLocals, LiveInfo, Union0, Union, _),
!:Deadness = Union,
- GoalExpr = disj(Goals)
+ NewPostDeaths = set.init,
+ GoalExpr = disj(Disjuncts)
;
GoalExpr0 = switch(Var, Det, Cases0),
set.init(Union0),
- liveness.get_nonlocals_and_typeinfos(LiveInfo, GoalInfo,
+ liveness.get_nonlocals_and_typeinfos(LiveInfo, GoalInfo0,
_, CompletedNonLocals),
- detect_deadness_in_cases(Var, Cases0, Cases, !.Deadness, Liveness0,
+ detect_deadness_in_cases(Var, Cases0, Cases, !.Deadness, !.Liveness,
CompletedNonLocals, LiveInfo, Union0, Union, _),
!:Deadness = Union,
+ NewPostDeaths = set.init,
GoalExpr = switch(Var, Det, Cases)
;
GoalExpr0 = if_then_else(Vars, Cond0, Then0, Else0),
Deadness0 = !.Deadness,
- update_liveness_goal(Cond0, LiveInfo, Liveness0, LivenessCond),
+ update_liveness_goal(Cond0, LiveInfo, !.Liveness, LivenessCond),
detect_deadness_in_goal(Else0, Else1, Deadness0, DeadnessElse,
- Liveness0, LiveInfo),
+ !.Liveness, LiveInfo),
detect_deadness_in_goal(Then0, Then, Deadness0, DeadnessThen,
LivenessCond, LiveInfo),
detect_deadness_in_goal(Cond0, Cond1, DeadnessThen, DeadnessCond,
- Liveness0, LiveInfo),
+ !.Liveness, LiveInfo),
- liveness.get_nonlocals_and_typeinfos(LiveInfo, GoalInfo,
+ liveness.get_nonlocals_and_typeinfos(LiveInfo, GoalInfo0,
_, CompletedNonLocals),
- InstmapDelta = goal_info_get_instmap_delta(GoalInfo),
+ InstmapDelta = goal_info_get_instmap_delta(GoalInfo0),
( instmap_delta_is_reachable(InstmapDelta) ->
Cond0 = hlds_goal(_, CondGoalInfo),
CondInstmapDelta = goal_info_get_instmap_delta(CondGoalInfo),
@@ -720,34 +758,37 @@
add_branch_pre_deaths(DeadnessElse, Deadness0,
CompletedNonLocalDeadness, yes, Else1, Else)
),
+ NewPostDeaths = set.init,
!:Deadness = Deadness,
GoalExpr = if_then_else(Vars, Cond, Then, Else)
;
GoalExpr0 = negation(SubGoal0),
detect_deadness_in_goal(SubGoal0, SubGoal, !Deadness,
- Liveness0, LiveInfo),
+ !.Liveness, LiveInfo),
+ NewPostDeaths = set.init,
GoalExpr = negation(SubGoal)
;
GoalExpr0 = scope(Reason, SubGoal0),
+ ( Reason = from_ground_term(_TermVar, from_ground_term_construct) ->
+ % The job was done by detect_liveness_in_goal.
+ SubGoal = SubGoal0
+ ;
detect_deadness_in_goal(SubGoal0, SubGoal, !Deadness,
- Liveness0, LiveInfo),
+ !.Liveness, LiveInfo)
+ ),
+ NewPostDeaths = set.init,
GoalExpr = scope(Reason, SubGoal)
;
- GoalExpr0 = plain_call(_, _, _, _, _, _),
- unexpected(this_file, "detect_deadness_in_goal_2: plain_call")
- ;
- GoalExpr0 = generic_call(_, _, _, _),
- unexpected(this_file, "detect_deadness_in_goal_2: generic_call")
- ;
- GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _),
- unexpected(this_file, "detect_deadness_in_goal_2: call_foreign_proc")
- ;
- GoalExpr0 = unify(_, _, _, _, _),
- unexpected(this_file, "detect_deadness_in_goal_2: unify")
- ;
GoalExpr0 = shorthand(_),
unexpected(this_file, "detect_deadness_in_goal_2: shorthand")
- ).
+ ),
+
+ set.union(PostDeaths0, NewPostDeaths, PostDeaths),
+ goal_info_set_post_deaths(PostDeaths, GoalInfo0, GoalInfo),
+ Goal = hlds_goal(GoalExpr, GoalInfo),
+
+ set.difference(!.Deadness, PreBirths0, !:Deadness),
+ set.union(PreDeaths0, !Deadness).
%-----------------------------------------------------------------------------%
@@ -924,7 +965,8 @@
:- pred update_liveness_goal(hlds_goal::in, live_info::in,
set(prog_var)::in, set(prog_var)::out) is det.
-update_liveness_goal(hlds_goal(GoalExpr, GoalInfo), LiveInfo, !Liveness) :-
+update_liveness_goal(Goal, LiveInfo, !Liveness) :-
+ Goal = hlds_goal(GoalExpr, GoalInfo),
goal_info_get_pre_deaths(GoalInfo, PreDeaths),
goal_info_get_pre_births(GoalInfo, PreBirths),
goal_info_get_post_deaths(GoalInfo, PostDeaths),
@@ -993,10 +1035,15 @@
true
)
;
- ( GoalExpr = negation(SubGoal)
- ; GoalExpr = scope(_Reason, SubGoal)
- ),
+ GoalExpr = negation(SubGoal),
+ update_liveness_goal(SubGoal, LiveInfo, !Liveness)
+ ;
+ GoalExpr = scope(Reason, SubGoal),
+ ( Reason = from_ground_term(TermVar, from_ground_term_construct) ->
+ set.insert(!.Liveness, TermVar, !:Liveness)
+ ;
update_liveness_goal(SubGoal, LiveInfo, !Liveness)
+ )
;
GoalExpr = shorthand(_),
unexpected(this_file, "update_liveness_expr: shorthand")
@@ -1069,8 +1116,8 @@
set(prog_var)::in, set(prog_var)::out,
set(prog_var)::in, set(prog_var)::out, prog_varset::in) is det.
-delay_death_goal(hlds_goal(GoalExpr0, GoalInfo0),
- hlds_goal(GoalExpr, GoalInfo), !BornVars, !DelayedDead, VarSet) :-
+delay_death_goal(Goal0, Goal, !BornVars, !DelayedDead, VarSet) :-
+ Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
goal_info_get_pre_births(GoalInfo0, PreBirths),
goal_info_get_pre_deaths(GoalInfo0, PreDeaths0),
BornVars0 = !.BornVars,
@@ -1093,7 +1140,8 @@
set.union(PostDelayedDead, !DelayedDead),
set.divide_by_set(BornVars0, !.DelayedDead, !:DelayedDead, ToBeKilled),
set.union(UnnamedPostDeaths, ToBeKilled, PostDeaths),
- goal_info_set_post_deaths(PostDeaths, GoalInfo2, GoalInfo).
+ goal_info_set_post_deaths(PostDeaths, GoalInfo2, GoalInfo),
+ Goal = hlds_goal(GoalExpr, GoalInfo).
:- pred var_is_named(prog_varset::in, prog_var::in) is semidet.
@@ -1177,7 +1225,13 @@
!:GoalExpr = if_then_else(QuantVars, Cond, Then, Else)
;
!.GoalExpr = scope(Reason, Goal0),
- delay_death_goal(Goal0, Goal, !.BornVars, _, !DelayedDead, VarSet),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ % All the variables in the scope are anonymous, so there would
+ % be no point in delaying their death.
+ Goal = Goal0
+ ;
+ delay_death_goal(Goal0, Goal, !.BornVars, _, !DelayedDead, VarSet)
+ ),
!:GoalExpr = scope(Reason, Goal)
;
!.GoalExpr = shorthand(_),
@@ -1288,8 +1342,8 @@
set(prog_var)::in, set(prog_var)::out, live_info::in,
set(prog_var)::in) is det.
-detect_resume_points_in_goal(hlds_goal(GoalExpr0, GoalInfo0),
- hlds_goal(GoalExpr, GoalInfo0), !Liveness, LiveInfo, ResumeVars0) :-
+detect_resume_points_in_goal(Goal0, Goal, !Liveness, LiveInfo, ResumeVars0) :-
+ Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
goal_info_get_pre_deaths(GoalInfo0, PreDeaths0),
goal_info_get_pre_births(GoalInfo0, PreBirths0),
goal_info_get_post_deaths(GoalInfo0, PostDeaths0),
@@ -1298,18 +1352,6 @@
set.difference(!.Liveness, PreDeaths0, !:Liveness),
set.union(PreBirths0, !Liveness),
- detect_resume_points_in_goal_2(GoalExpr0, GoalExpr, !Liveness, GoalInfo0,
- LiveInfo, ResumeVars0),
-
- set.difference(!.Liveness, PostDeaths0, !:Liveness),
- set.union(PostBirths0, !Liveness).
-
-:- pred detect_resume_points_in_goal_2(hlds_goal_expr::in, hlds_goal_expr::out,
- set(prog_var)::in, set(prog_var)::out, hlds_goal_info::in,
- live_info::in, set(prog_var)::in) is det.
-
-detect_resume_points_in_goal_2(GoalExpr0, GoalExpr,
- !Liveness, GoalInfo0, LiveInfo, ResumeVars0) :-
(
GoalExpr0 = conj(ConjType, Goals0),
(
@@ -1430,8 +1472,14 @@
GoalExpr = negation(SubGoal)
;
GoalExpr0 = scope(Reason, SubGoal0),
+ ( Reason = from_ground_term(TermVar, from_ground_term_construct) ->
+ % There are no resume points in these scopes.
+ SubGoal = SubGoal0,
+ set.insert(!.Liveness, TermVar, !:Liveness)
+ ;
detect_resume_points_in_goal(SubGoal0, SubGoal, !Liveness,
- LiveInfo, ResumeVars0),
+ LiveInfo, ResumeVars0)
+ ),
GoalExpr = scope(Reason, SubGoal)
;
( GoalExpr0 = generic_call(_, _, _, _)
@@ -1444,7 +1492,11 @@
GoalExpr0 = shorthand(_),
% These should have been expanded out by now.
unexpected(this_file, "detect_resume_points_in_goal_2: shorthand")
- ).
+ ),
+
+ Goal = hlds_goal(GoalExpr, GoalInfo0),
+ set.difference(!.Liveness, PostDeaths0, !:Liveness),
+ set.union(PostBirths0, !Liveness).
:- pred detect_resume_points_in_conj(list(hlds_goal)::in, list(hlds_goal)::out,
set(prog_var)::in, set(prog_var)::out,
@@ -1627,15 +1679,10 @@
true
;
VarSet = LiveInfo ^ li_varset,
- set.to_sorted_list(LivenessFirst, FirstVarsList),
- set.to_sorted_list(LivenessRest, RestVarsList),
- list.map(varset.lookup_name(VarSet), FirstVarsList, FirstVarNames),
- list.map(varset.lookup_name(VarSet), RestVarsList, RestVarNames),
- Pad = (pred(S0::in, S::out) is det :- string.append(S0, " ", S)),
- list.map(Pad, FirstVarNames, PaddedFirstNames),
- list.map(Pad, RestVarNames, PaddedRestNames),
- string.append_list(PaddedFirstNames, FirstNames),
- string.append_list(PaddedRestNames, RestNames),
+ set.to_sorted_list(LivenessFirst, FirstVars),
+ set.to_sorted_list(LivenessRest, RestVars),
+ FirstNames = mercury_vars_to_string(VarSet, yes, FirstVars),
+ RestNames = mercury_vars_to_string(VarSet, yes, RestVars),
Msg = "branches of " ++ GoalType ++ " disagree on liveness\n" ++
"First: " ++ FirstNames ++ "\n" ++ "Rest: " ++ RestNames ++ "\n",
unexpected(this_file, Msg)
@@ -1710,29 +1757,32 @@
:- pred add_liveness_after_goal(hlds_goal::in, set(prog_var)::in,
hlds_goal::out) is det.
-add_liveness_after_goal(hlds_goal(GoalExpr, GoalInfo0), Residue,
- hlds_goal(GoalExpr, GoalInfo)) :-
+add_liveness_after_goal(Goal0, Residue, Goal) :-
+ Goal0 = hlds_goal(GoalExpr, GoalInfo0),
goal_info_get_post_births(GoalInfo0, PostBirths0),
set.union(PostBirths0, Residue, PostBirths),
- goal_info_set_post_births(PostBirths, GoalInfo0, GoalInfo).
+ goal_info_set_post_births(PostBirths, GoalInfo0, GoalInfo),
+ Goal = hlds_goal(GoalExpr, GoalInfo).
:- pred add_deadness_before_goal(set(prog_var)::in,
hlds_goal::in, hlds_goal::out) is det.
-add_deadness_before_goal(Residue, hlds_goal(GoalExpr, GoalInfo0),
- hlds_goal(GoalExpr, GoalInfo)) :-
+add_deadness_before_goal(Residue, Goal0, Goal) :-
+ Goal0 = hlds_goal(GoalExpr, GoalInfo0),
goal_info_get_pre_deaths(GoalInfo0, PreDeaths0),
set.union(PreDeaths0, Residue, PreDeaths),
- goal_info_set_pre_deaths(PreDeaths, GoalInfo0, GoalInfo).
+ goal_info_set_pre_deaths(PreDeaths, GoalInfo0, GoalInfo),
+ Goal = hlds_goal(GoalExpr, GoalInfo).
:- pred add_deadness_after_goal(set(prog_var)::in,
hlds_goal::in, hlds_goal::out) is det.
-add_deadness_after_goal(Residue, hlds_goal(GoalExpr, GoalInfo0),
- hlds_goal(GoalExpr, GoalInfo)) :-
+add_deadness_after_goal(Residue, Goal0, Goal) :-
+ Goal0 = hlds_goal(GoalExpr, GoalInfo0),
goal_info_get_post_deaths(GoalInfo0, PostDeaths0),
set.union(PostDeaths0, Residue, PostDeaths),
- goal_info_set_post_deaths(PostDeaths, GoalInfo0, GoalInfo).
+ goal_info_set_post_deaths(PostDeaths, GoalInfo0, GoalInfo),
+ Goal = hlds_goal(GoalExpr, GoalInfo).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -1769,19 +1819,18 @@
% Get the nonlocals, and, if doing typeinfo liveness, add the
% typeinfo vars for the nonlocals.
%
-:- pred liveness.get_nonlocals_and_typeinfos(live_info::in,
+:- pred get_nonlocals_and_typeinfos(live_info::in,
hlds_goal_info::in, set(prog_var)::out, set(prog_var)::out) is det.
-liveness.get_nonlocals_and_typeinfos(LiveInfo, GoalInfo,
+get_nonlocals_and_typeinfos(LiveInfo, GoalInfo,
NonLocals, CompletedNonLocals) :-
NonLocals = goal_info_get_code_gen_nonlocals(GoalInfo),
- liveness.maybe_complete_with_typeinfos(LiveInfo,
- NonLocals, CompletedNonLocals).
+ maybe_complete_with_typeinfos(LiveInfo, NonLocals, CompletedNonLocals).
-:- pred liveness.maybe_complete_with_typeinfos(live_info::in,
+:- pred maybe_complete_with_typeinfos(live_info::in,
set(prog_var)::in, set(prog_var)::out) is det.
-liveness.maybe_complete_with_typeinfos(LiveInfo, Vars0, Vars) :-
+maybe_complete_with_typeinfos(LiveInfo, Vars0, Vars) :-
maybe_complete_with_typeinfo_vars(Vars0, LiveInfo ^ li_typeinfo_liveness,
LiveInfo ^ li_vartypes, LiveInfo ^ li_rtti_varmaps, Vars).
Index: compiler/lookup_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/lookup_util.m,v
retrieving revision 1.7
diff -u -b -r1.7 lookup_util.m
--- compiler/lookup_util.m 2 Jun 2008 02:27:27 -0000 1.7
+++ compiler/lookup_util.m 11 Dec 2008 15:53:48 -0000
@@ -104,8 +104,8 @@
% If a variable has a final inst, then it changed
% instantiatedness during the switch.
set.member(Var, ChangedVars),
- instmap.lookup_var(CurrentInstMap, Var, Initial),
- instmap.lookup_var(InstMapAfter, Var, Final),
+ instmap_lookup_var(CurrentInstMap, Var, Initial),
+ instmap_lookup_var(InstMapAfter, Var, Final),
mode_is_output(ModuleInfo, (Initial -> Final))
),
solutions.solutions(Lambda, OutVars)
Index: compiler/loop_inv.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/loop_inv.m,v
retrieving revision 1.46
diff -u -b -r1.46 loop_inv.m
--- compiler/loop_inv.m 27 Feb 2008 07:23:08 -0000 1.46
+++ compiler/loop_inv.m 11 Dec 2008 15:53:48 -0000
@@ -141,58 +141,48 @@
%-----------------------------------------------------------------------------%
hoist_loop_invariants(PredId, ProcId, PredInfo, !ProcInfo, !ModuleInfo) :-
-
- ( if
+ (
% We only want to apply this optimization to pure preds (e.g.
% not benchmark_det_loop).
- %
pred_info_get_purity(PredInfo, purity_pure),
% Next, work out whether this predicate is optimizable and
% compute some auxiliary results along the way.
- % Obtain the requisite info for this procedure.
- %
PredProcId = proc(PredId, ProcId),
proc_info_get_goal(!.ProcInfo, Body),
proc_info_get_headvars(!.ProcInfo, HeadVars),
proc_info_get_argmodes(!.ProcInfo, HeadVarModes),
- % Find the set of variables that are used as (partly) unique
- % inputs to calls. These variables are not safe candidates
- % for hoisting. (A variable whose initial bound inst is
- % inferred as unique may be hoistable if it is not used as a
- % unique input to any call.)
- %
+ % Find the set of variables that are used as (partly) unique inputs
+ % to calls. These variables are not safe candidates for hoisting.
+ % (A variable whose initial bound inst is inferred as unique may be
+ % hoistable if it is not used as a unique input to any call.)
UniquelyUsedVars = uniquely_used_vars(!.ModuleInfo, Body),
% Find the set of candidate goals that may be invariant
% and the set of recursive calls involved.
%
- % A goal must appear on all recursive paths to be a
- % candidate.
- %
- % The recursive calls are the set of calls at the end
- % of each recursive path.
+ % A goal must appear on all recursive paths to be a candidate.
%
+ % The recursive calls are the set of calls at the end of each
+ % recursive path.
invariant_goal_candidates(PredProcId, Body, InvGoals0, RecCalls),
- % We can calculate the set of invariant args from
- % the set of recursive calls.
- %
+ % We can calculate the set of invariant args from the set of
+ % recursive calls.
InvArgs0 = inv_args(!.ModuleInfo, HeadVars, HeadVarModes, RecCalls),
InvArgs = InvArgs0 `delete_elems` UniquelyUsedVars,
- % Given the invariant args, we can calculate the set
- % of invariant goals and vars.
- %
+ % Given the invariant args, we can calculate the set of
+ % invariant goals and vars.
inv_goals_vars(!.ModuleInfo, UniquelyUsedVars,
InvGoals0, InvGoals1, InvArgs, InvVars1),
% We don't want to hoist out unifications with constants (i.e.
% constructions where the RHS has no arguments) or deconstructions
- % (it's probably cheaper to do the dereference than pass an extra
+ % (it is probably cheaper to do the dereference than pass an extra
% argument).
%
% We also don't want to hoist out goals that can't succeed,
@@ -206,7 +196,6 @@
%
% So here we compute the subset of InvGoals (and the corresponding
% InvVars) that should not be hoisted.
- %
dont_hoist(!.ModuleInfo, InvGoals1, DontHoistGoals, DontHoistVars),
InvGoals = InvGoals1 `delete_elems` DontHoistGoals,
@@ -214,60 +203,47 @@
% We only apply the optimization if the set of invariant goals
% is non-empty.
- %
InvGoals = [_ | _]
% NOTE! At this point it is vital that
- % - none of the InvVars are used as (partially) unique
- % inputs in any goals;
- % - all of the InvVars are either head vars or constructed
- % by one of the InvGoals;
+ % - none of the InvVars are used as (partially) unique inputs
+ % in any goals;
+ % - all of the InvVars are either head vars or constructed by one of
+ % the InvGoals;
% - all non-local vars in InvGoals are also in InvVars.
+ ->
- then
-
- % The set of computed invariant vars is the difference
- % between the whole invariant var set and the set of
- % invariant args.
- %
+ % The set of computed invariant vars is the difference between
+ % the whole invariant var set and the set of invariant args.
ComputedInvVars = InvVars `delete_elems` InvArgs,
- % We need to calculate the initial instmap for the aux
- % proc by applying the instmap_deltas from the InvGoals
- % to InitialInstMap.
- %
+ % We need to calculate the initial instmap for the aux proc by applying
+ % the instmap_deltas from the InvGoals to InitialInstMap.
proc_info_get_initial_instmap(!.ProcInfo, !.ModuleInfo,
InitialInstMap),
InitialAuxInstMap =
compute_initial_aux_instmap(InvGoals, InitialInstMap),
- % Create the pred for the aux proc. This is initially a
- % copy of the in proc with the head vars extended with the
- % list of computed inv vars. The body is adjusted
- % appropriately in the next step.
- %
+ % Create the pred for the aux proc. This is initially a copy of the
+ % in proc with the head vars extended with the list of computed
+ % inv vars. The body is adjusted appropriately in the next step.
create_aux_pred(PredProcId, HeadVars, ComputedInvVars,
InitialAuxInstMap, AuxPredProcId, CallAux,
AuxPredInfo, AuxProcInfo, !ModuleInfo),
- % We update the body of AuxProc by replacing adding the
- % set of computed invariant vars to the argument list,
- % replacing invariant goals in InProc with `true', and
- % recursive calls at the end of recursive paths with
- % calls to the auxiliary procedure.
- %
+ % We update the body of AuxProc by replacing adding the set of
+ % computed invariant vars to the argument list, % replacing invariant
+ % goals in InProc with `true', and recursive calls at the end of
+ % recursive paths with calls to the auxiliary procedure.
gen_aux_proc(InvGoals, PredProcId,
AuxPredProcId, CallAux, Body, AuxPredInfo, AuxProcInfo,
!ModuleInfo),
- % We construct OutProc by replacing recursive calls to
- % the InProc at the end of recursive paths with calls
- % to the auxiliary procedure.
- %
+ % We construct OutProc by replacing recursive calls to the InProc
+ % at the end of recursive paths with calls to the auxiliary procedure.
gen_out_proc(PredProcId, PredInfo, !ProcInfo, CallAux, Body,
!ModuleInfo)
-
- else
+ ;
true
).
@@ -286,18 +262,16 @@
---> invariant_goal_candidates_acc(
% path_candidates is the list of accumulated invariant
% goal candidates.
- %
path_candidates :: hlds_goals,
% rec_calls is the list of pairs of recursive calls
% with the path_candidates up to that point. This is
% extended whenever a recursive call is identified.
- %
rec_calls :: rec_calls
).
% invariant_goal_candidates(PredProcId, Body, CandidateInvGoals,
- % RecCallGoals)
+ % RecCallGoals):
%
% Computes (a conservative approximation to) the set of candidate
% invariant atomic goals in Body and the set of recursive calls
@@ -307,104 +281,84 @@
hlds_goals::out, hlds_goals::out) is det.
invariant_goal_candidates(PredProcId, Body, CandidateInvGoals, RecCallGoals) :-
- invariant_goal_candidates_acc(_, RecCalls) =
+ GoalCandidates0 = invariant_goal_candidates_acc([], []),
invariant_goal_candidates_2(PredProcId, Body,
- invariant_goal_candidates_acc([], [])),
+ GoalCandidates0, GoalCandidates),
+ GoalCandidates = invariant_goal_candidates_acc(_, RecCalls),
assoc_list.keys_and_values(RecCalls, RecCallGoals, CandidateInvGoalsList),
CandidateInvGoals = intersect_candidate_inv_goals(CandidateInvGoalsList).
%-----------------------------------------------------------------------------%
-:- func invariant_goal_candidates_2(pred_proc_id, hlds_goal,
- invariant_goal_candidates_acc
- ) = invariant_goal_candidates_acc.
-
-invariant_goal_candidates_2(PPId,
- hlds_goal(Call @ plain_call(PredId, ProcId, _, _, _, _), GoalInfo),
- IGCs) =
- ( if proc(PredId, ProcId) = PPId
- then add_recursive_call(hlds_goal(Call, GoalInfo), IGCs)
- else invariant_goal_candidates_handle_non_recursive_call(
- hlds_goal(Call, GoalInfo), IGCs)
- ).
-
-invariant_goal_candidates_2(_PPId,
- hlds_goal(Call @ generic_call(_, _, _, _), GoalInfo), IGCs) =
- invariant_goal_candidates_handle_non_recursive_call(
- hlds_goal(Call, GoalInfo),
- IGCs).
-
-invariant_goal_candidates_2(_PPId,
- hlds_goal(Unification @ unify(_, _, _, _, _), GoalInfo), IGCs) =
- invariant_goal_candidates_handle_non_recursive_call(
- hlds_goal(Unification, GoalInfo),
- IGCs).
-
-invariant_goal_candidates_2(_PPId,
- hlds_goal(ForeignProc @ call_foreign_proc(_, _, _, _, _, _, _),
- GoalInfo),
- IGCs) =
- invariant_goal_candidates_handle_non_recursive_call(
- hlds_goal(ForeignProc, GoalInfo),
- IGCs).
-
-invariant_goal_candidates_2(PPId,
- hlds_goal(conj(ConjType, Conjuncts), _GoalInfo), IGCs0)
- = IGCs :-
+:- pred invariant_goal_candidates_2(pred_proc_id::in, hlds_goal::in,
+ invariant_goal_candidates_acc::in, invariant_goal_candidates_acc::out)
+ is det.
+
+invariant_goal_candidates_2(PPId, Goal, !IGCs) :-
+ Goal = hlds_goal(GoalExpr, GoalInfo),
+ (
+ GoalExpr = plain_call(PredId, ProcId, _, _, _, _),
+ ( proc(PredId, ProcId) = PPId ->
+ add_recursive_call(Goal, !IGCs)
+ ;
+ invariant_goal_candidates_handle_non_recursive_call(Goal, !IGCs)
+ )
+ ;
+ ( GoalExpr = generic_call(_, _, _, _)
+ ; GoalExpr = unify(_, _, _, _, _)
+ ; GoalExpr = call_foreign_proc(_, _, _, _, _, _, _)
+ ),
+ invariant_goal_candidates_handle_non_recursive_call(Goal, !IGCs)
+ ;
+ GoalExpr = conj(ConjType, Conjuncts),
(
ConjType = plain_conj,
- IGCs = list.foldl(invariant_goal_candidates_2(PPId), Conjuncts, IGCs0)
+ list.foldl(invariant_goal_candidates_2(PPId), Conjuncts, !IGCs)
;
ConjType = parallel_conj,
- IGCs = list.foldl(
- invariant_goal_candidates_keeping_path_candidates(PPId),
- Conjuncts, IGCs0)
- ).
-
-invariant_goal_candidates_2(PPId,
- hlds_goal(disj(Disjuncts), _GoalInfo), IGCs) =
list.foldl(invariant_goal_candidates_keeping_path_candidates(PPId),
- Disjuncts,
- IGCs).
-
-invariant_goal_candidates_2(PPId,
- hlds_goal(switch(_, _, Cases), _GoalInfo), IGCs) =
+ Conjuncts, !IGCs)
+ )
+ ;
+ GoalExpr = disj(Disjuncts),
list.foldl(invariant_goal_candidates_keeping_path_candidates(PPId),
- case_goals(Cases),
- IGCs).
-
-invariant_goal_candidates_2(PPId,
- hlds_goal(negation(NegatedGoal), _GoalInfo), IGCs) =
- invariant_goal_candidates_keeping_path_candidates(PPId, NegatedGoal, IGCs).
-
-invariant_goal_candidates_2(PPId,
- hlds_goal(scope(_, QuantifiedGoal), _GoalInfo), IGCs) =
- invariant_goal_candidates_2(PPId, QuantifiedGoal, IGCs).
-
-invariant_goal_candidates_2(PPId,
- hlds_goal(if_then_else(_XVs, Cond, Then, Else), GoalInfo), IGCs0)
- = IGCs :-
- CondThenGoal = hlds_goal(conj(plain_conj, [Cond, Then]), GoalInfo),
- IGCs1 = invariant_goal_candidates_keeping_path_candidates(PPId,
- CondThenGoal, IGCs0),
- ElseGoal = Else,
- IGCs = invariant_goal_candidates_keeping_path_candidates(PPId,
- ElseGoal, IGCs1).
-
-invariant_goal_candidates_2(_PPId,
- hlds_goal(shorthand(_), _GoalInfo), _IGCs) = _ :-
+ Disjuncts, !IGCs)
+ ;
+ GoalExpr = switch(_, _, Cases),
+ list.foldl(invariant_goal_candidates_keeping_path_candidates(PPId),
+ case_goals(Cases), !IGCs)
+ ;
+ GoalExpr = negation(SubdGoal),
+ invariant_goal_candidates_keeping_path_candidates(PPId, SubdGoal,
+ !IGCs)
+ ;
+ GoalExpr = scope(_Reason, SubdGoal),
+ % XXX We should specialize the handling of from_ground_term_construct
+ % scopes here.
+ invariant_goal_candidates_keeping_path_candidates(PPId, SubdGoal,
+ !IGCs)
+ ;
+ GoalExpr = if_then_else(_XVs, Cond, Then, Else),
+ CoTe = hlds_goal(conj(plain_conj, [Cond, Then]), GoalInfo),
+ invariant_goal_candidates_keeping_path_candidates(PPId, CoTe, !IGCs),
+ invariant_goal_candidates_keeping_path_candidates(PPId, Else, !IGCs)
+ ;
+ GoalExpr = shorthand(_),
% These should have been expanded out by now.
- unexpected(this_file, "invariant_goal_candidates_2: shorthand").
+ unexpected(this_file, "invariant_goal_candidates_2: shorthand")
+ ).
%-----------------------------------------------------------------------------%
-:- func invariant_goal_candidates_keeping_path_candidates(pred_proc_id,
- hlds_goal, invariant_goal_candidates_acc
- ) = invariant_goal_candidates_acc.
+:- pred invariant_goal_candidates_keeping_path_candidates(pred_proc_id::in,
+ hlds_goal::in,
+ invariant_goal_candidates_acc::in, invariant_goal_candidates_acc::out)
+ is det.
-invariant_goal_candidates_keeping_path_candidates(PPId, Goal, IGCs) =
- ( invariant_goal_candidates_2(PPId, Goal, IGCs) ^ path_candidates :=
- IGCs ^ path_candidates ).
+invariant_goal_candidates_keeping_path_candidates(PPId, Goal, !IGCs) :-
+ PathCandidates0 = !.IGCs ^ path_candidates,
+ invariant_goal_candidates_2(PPId, Goal, !IGCs),
+ !IGCs ^ path_candidates := PathCandidates0.
%-----------------------------------------------------------------------------%
@@ -415,36 +369,37 @@
%-----------------------------------------------------------------------------%
-:- func add_recursive_call(hlds_goal, invariant_goal_candidates_acc) =
- invariant_goal_candidates_acc.
+:- pred add_recursive_call(hlds_goal::in,
+ invariant_goal_candidates_acc::in, invariant_goal_candidates_acc::out)
+ is det.
- % We have to reverse the path_candidates because they are
- % accumulated in reverse order, whereas we need them in
- % producer-consumer order as they appear in the procedure.
+ % We have to reverse the path_candidates because they are accumulated
+ % in reverse order, whereas we need them in producer-consumer order
+ % as they appear in the procedure.
%
-add_recursive_call(Goal, IGCs) =
- IGCs ^ rec_calls :=
- [Goal - list.reverse(IGCs ^ path_candidates) | IGCs ^ rec_calls].
+add_recursive_call(Goal, !IGCs) :-
+ !IGCs ^ rec_calls :=
+ [Goal - list.reverse(!.IGCs ^ path_candidates) | !.IGCs ^ rec_calls].
%-----------------------------------------------------------------------------%
- % NOTE: we could hoist semipure goals that have no preceeding
- % impure goals, but that's a very low-level optimization that
- % is not entirely trivial to implement.
+ % NOTE: We could hoist semipure goals that have no preceeding impure goals,
+ % but that's a very low-level optimization that is not entirely trivial
+ % to implement.
%
-:- func invariant_goal_candidates_handle_non_recursive_call(
- hlds_goal, invariant_goal_candidates_acc
- ) = invariant_goal_candidates_acc.
+:- pred invariant_goal_candidates_handle_non_recursive_call(hlds_goal::in,
+ invariant_goal_candidates_acc::in, invariant_goal_candidates_acc::out)
+ is det.
-invariant_goal_candidates_handle_non_recursive_call(
- Goal @ hlds_goal(_GoalExpr, GoalInfo), IGCs) =
+invariant_goal_candidates_handle_non_recursive_call(Goal, !IGCs) :-
+ Goal = hlds_goal(_GoalExpr, GoalInfo),
(
not model_non(GoalInfo),
goal_info_get_purity(GoalInfo) = purity_pure
->
- IGCs ^ path_candidates := [Goal | IGCs ^ path_candidates]
+ !IGCs ^ path_candidates := [Goal | !.IGCs ^ path_candidates]
;
- IGCs
+ true
).
%-----------------------------------------------------------------------------%
@@ -460,7 +415,6 @@
:- func intersect_candidate_inv_goals(list(hlds_goals)) = hlds_goals.
intersect_candidate_inv_goals([]) = [].
-
intersect_candidate_inv_goals([Goals | Goalss]) =
list.filter(common_goal(Goalss), Goals).
@@ -499,8 +453,8 @@
inv_args(ModuleInfo, HeadVars, HeadVarModes, RecCalls) = InvArgs :-
MaybeInvArgs0 =
- list.map_corresponding(
- arg_to_maybe_inv_arg(ModuleInfo), HeadVars, HeadVarModes),
+ list.map_corresponding(arg_to_maybe_inv_arg(ModuleInfo),
+ HeadVars, HeadVarModes),
MaybeInvArgs =
list.foldl(refine_candidate_inv_args, RecCalls, MaybeInvArgs0),
InvArgs =
@@ -523,12 +477,12 @@
list(maybe(prog_var)).
refine_candidate_inv_args(hlds_goal(RecCall, _RecCallInfo), MaybeInvArgs) =
- ( if RecCall = plain_call(_, _, CallArgs, _, _, _)
- then list.map_corresponding(refine_candidate_inv_args_2,
- MaybeInvArgs,
- CallArgs)
- else unexpected(this_file, "refine_candidate_inv_args/2: " ++
- "non call/6 found in argument 1")
+ ( RecCall = plain_call(_, _, CallArgs, _, _, _) ->
+ list.map_corresponding(refine_candidate_inv_args_2,
+ MaybeInvArgs, CallArgs)
+ ;
+ unexpected(this_file,
+ "refine_candidate_inv_args/2: non call/6 found in argument 1")
).
:- func refine_candidate_inv_args_2(maybe(prog_var), prog_var) =
@@ -571,15 +525,15 @@
:- pred inv_goals_vars_2(module_info::in, prog_vars::in, hlds_goal::in,
hlds_goals::in, hlds_goals::out, prog_vars::in, prog_vars::out) is det.
-inv_goals_vars_2(MI, UUVs, Goal, IGs0, IGs, IVs0, IVs) :-
- ( if
+inv_goals_vars_2(ModuleInfo, UUVs, Goal, IGs0, IGs, IVs0, IVs) :-
+ (
not invariant_goal(IGs0, Goal),
not has_uniquely_used_arg(UUVs, Goal),
- input_args_are_invariant(MI, Goal, IVs0)
- then
+ input_args_are_invariant(ModuleInfo, Goal, IVs0)
+ ->
IGs = [Goal | IGs0],
- IVs = add_outputs(MI, UUVs, Goal, IVs0)
- else
+ add_outputs(ModuleInfo, UUVs, Goal, IVs0, IVs)
+ ;
IGs = IGs0,
IVs = IVs0
).
@@ -627,17 +581,17 @@
hlds_goals::in, hlds_goals::out, prog_vars::in, prog_vars::out) is det.
dont_hoist_2(ModuleInfo, Goal, !DHGs, !DHVs) :-
- ( if
+ (
( const_construction(Goal)
; deconstruction(Goal)
; impure_goal(Goal)
; cannot_succeed(Goal)
; call_has_inst_any(ModuleInfo, Goal)
)
- then
+ ->
list.cons(Goal, !DHGs),
- !:DHVs = add_outputs(ModuleInfo, [], Goal, !.DHVs)
- else
+ add_outputs(ModuleInfo, [], Goal, !DHVs)
+ ;
true
).
@@ -711,7 +665,7 @@
arg_is_input(InstInfo, Arg) :-
InstInfo = {_ModuleInfo, InstMap},
- instmap.lookup_var(InstMap, Arg, Inst),
+ instmap_lookup_var(InstMap, Arg, Inst),
inst_is_input(InstInfo, Inst).
%-----------------------------------------------------------------------------%
@@ -727,19 +681,23 @@
%-----------------------------------------------------------------------------%
-:- func add_outputs(module_info, prog_vars, hlds_goal, prog_vars) =
- prog_vars.
+:- pred add_outputs(module_info::in, prog_vars::in, hlds_goal::in,
+ prog_vars::in, prog_vars::out) is det.
-add_outputs(ModuleInfo, UUVs, Goal, InvVars) =
- list.foldl(add_output(UUVs), goal_outputs(ModuleInfo, Goal), InvVars).
+add_outputs(ModuleInfo, UUVs, Goal, !InvVars) :-
+ list.foldl(add_output(UUVs), goal_outputs(ModuleInfo, Goal), !InvVars).
-:- func add_output(prog_vars, prog_var, prog_vars) = prog_vars.
+:- pred add_output(prog_vars::in, prog_var::in,
+ prog_vars::in, prog_vars::out) is det.
-add_output(UniquelyUsedVars, X, InvVars) =
- ( if not list.member(X, InvVars),
+add_output(UniquelyUsedVars, X, !InvVars) :-
+ (
+ not list.member(X, !.InvVars),
not list.member(X, UniquelyUsedVars)
- then [X | InvVars]
- else InvVars
+ ->
+ !:InvVars = [X | !.InvVars]
+ ;
+ true
).
%-----------------------------------------------------------------------------%
@@ -850,14 +808,11 @@
gen_aux_proc(InvGoals, PredProcId, AuxPredProcId, CallAux, Body,
AuxPredInfo, !.AuxProcInfo, !ModuleInfo) :-
-
% Compute the aux proc body.
- %
GapInfo = gen_aux_proc_info(!.ModuleInfo, InvGoals, PredProcId, CallAux),
- AuxBody = gen_aux_proc_2(GapInfo, Body),
+ AuxBody = gen_aux_proc_goal(GapInfo, Body),
% Put the new proc body and instmap into the module_info.
- %
AuxPredProcId = proc(AuxPredId, AuxProcId),
hlds_pred.proc_info_set_goal(AuxBody, !AuxProcInfo),
@@ -870,74 +825,68 @@
%-----------------------------------------------------------------------------%
-:- func gen_aux_proc_2(gen_aux_proc_info, hlds_goal) = hlds_goal.
+:- func gen_aux_proc_goal(gen_aux_proc_info, hlds_goal) = hlds_goal.
-gen_aux_proc_2(Info,
- hlds_goal(Call @ plain_call(PredId, ProcId, _,_,_,_), GoalInfo)) =
- ( if proc(PredId, ProcId) = Info ^ pred_proc_id
- then gen_aux_call(Info ^ call_aux_goal, hlds_goal(Call, GoalInfo))
- else gen_aux_proc_handle_non_recursive_call(Info,
- hlds_goal(Call, GoalInfo))
- ).
-
-gen_aux_proc_2(Info, hlds_goal(Call @ generic_call(_, _, _, _), GoalInfo)) =
- gen_aux_proc_handle_non_recursive_call(Info, hlds_goal(Call, GoalInfo)).
-
-gen_aux_proc_2(Info, hlds_goal(Unification @ unify(_, _, _, _, _), GoalInfo)) =
- gen_aux_proc_handle_non_recursive_call(Info,
- hlds_goal(Unification, GoalInfo)).
-
-gen_aux_proc_2(Info,
- hlds_goal(ForeignProc @ call_foreign_proc(_, _, _, _, _, _, _),
- GoalInfo)) =
- gen_aux_proc_handle_non_recursive_call(Info,
- hlds_goal(ForeignProc, GoalInfo)).
-
-gen_aux_proc_2(Info, hlds_goal(conj(ConjType, Conjuncts), GoalInfo)) =
- hlds_goal(conj(ConjType, gen_aux_proc_list(Info, Conjuncts)), GoalInfo).
-
-gen_aux_proc_2(Info, hlds_goal(disj(Disjuncts), GoalInfo)) =
- hlds_goal(disj(gen_aux_proc_list(Info, Disjuncts)), GoalInfo).
-
-gen_aux_proc_2(Info, hlds_goal(switch(Var, CanFail, Cases), GoalInfo)) =
- hlds_goal(switch(Var, CanFail, gen_aux_proc_switch(Info, Cases)),
- GoalInfo).
-
-gen_aux_proc_2(Info, hlds_goal(negation(NegatedGoal), GoalInfo)) =
- hlds_goal(negation(gen_aux_proc_2(Info, NegatedGoal)), GoalInfo).
-
-gen_aux_proc_2(Info, hlds_goal(scope(Reason, QuantifiedGoal), GoalInfo)) =
- hlds_goal(scope(Reason, gen_aux_proc_2(Info, QuantifiedGoal)), GoalInfo).
-
-gen_aux_proc_2(Info,
- hlds_goal(if_then_else(XVars, Cond, Then, Else), GoalInfo)) =
- hlds_goal(
- if_then_else(XVars,
- gen_aux_proc_2(Info, Cond),
- gen_aux_proc_2(Info, Then),
- gen_aux_proc_2(Info, Else)
+gen_aux_proc_goal(Info, Goal) = AuxGoal :-
+ Goal = hlds_goal(GoalExpr, GoalInfo),
+ (
+ GoalExpr = plain_call(PredId, ProcId, _,_,_,_),
+ ( proc(PredId, ProcId) = Info ^ pred_proc_id ->
+ AuxGoal = gen_aux_call(Info ^ call_aux_goal, Goal)
+ ;
+ AuxGoal = gen_aux_proc_handle_non_recursive_call(Info, Goal)
+ )
+ ;
+ ( GoalExpr = generic_call(_, _, _, _)
+ ; GoalExpr = unify(_, _, _, _, _)
+ ; GoalExpr = call_foreign_proc(_, _, _, _, _, _, _)
),
- GoalInfo).
-
-gen_aux_proc_2(_Info, hlds_goal(shorthand(_), _GoalInfo)) = _ :-
- unexpected(this_file, "gen_aux_proc_2/2: shorthand/1 in hlds_goal").
-
-%-----------------------------------------------------------------------------%
-
-:- func gen_aux_proc_list(gen_aux_proc_info, hlds_goals) = hlds_goals.
-
-gen_aux_proc_list(Info, Goals) = list.map(gen_aux_proc_2(Info), Goals).
-
-%-----------------------------------------------------------------------------%
+ AuxGoal = gen_aux_proc_handle_non_recursive_call(Info, Goal)
+ ;
+ GoalExpr = conj(ConjType, Conjuncts),
+ AuxConjuncts = list.map(gen_aux_proc_goal(Info), Conjuncts),
+ AuxGoalExpr = conj(ConjType, AuxConjuncts),
+ AuxGoal = hlds_goal(AuxGoalExpr, GoalInfo)
+ ;
+ GoalExpr = disj(Disjuncts),
+ AuxDisjuncts = list.map(gen_aux_proc_goal(Info), Disjuncts),
+ AuxGoalExpr = disj(AuxDisjuncts),
+ AuxGoal = hlds_goal(AuxGoalExpr, GoalInfo)
+ ;
+ GoalExpr = switch(Var, CanFail, Cases),
+ AuxCases = list.map(gen_aux_proc_case(Info), Cases),
+ AuxGoalExpr = switch(Var, CanFail, AuxCases),
+ AuxGoal = hlds_goal(AuxGoalExpr, GoalInfo)
+ ;
+ GoalExpr = negation(SubGoal),
+ AuxSubGoal = gen_aux_proc_goal(Info, SubGoal),
+ AuxGoalExpr = negation(AuxSubGoal),
+ AuxGoal = hlds_goal(AuxGoalExpr, GoalInfo)
+ ;
+ GoalExpr = scope(Reason, SubGoal),
+ % XXX We should consider special casing the handling of
+ % from_ground_term_construct scopes.
+ AuxSubGoal = gen_aux_proc_goal(Info, SubGoal),
+ AuxGoalExpr = scope(Reason, AuxSubGoal),
+ AuxGoal = hlds_goal(AuxGoalExpr, GoalInfo)
+ ;
+ GoalExpr = if_then_else(Vars, Cond, Then, Else),
+ AuxCond = gen_aux_proc_goal(Info, Cond),
+ AuxThen = gen_aux_proc_goal(Info, Then),
+ AuxElse = gen_aux_proc_goal(Info, Else),
+ AuxGoalExpr = if_then_else(Vars, AuxCond, AuxThen, AuxElse),
+ AuxGoal = hlds_goal(AuxGoalExpr, GoalInfo)
+ ;
+ GoalExpr = shorthand(_),
+ unexpected(this_file, "gen_aux_proc_goal: shorthand")
+ ).
-:- func gen_aux_proc_switch(gen_aux_proc_info, list(case)) = list(case).
+:- func gen_aux_proc_case(gen_aux_proc_info, case) = case.
-gen_aux_proc_switch(Info, Cases) =
- list.map(
- func(case(MainCaseId, OtherConsIds, Goal)) =
- case(MainCaseId, OtherConsIds, gen_aux_proc_2(Info, Goal)),
- Cases
- ).
+gen_aux_proc_case(Info, Case) = AuxCase :-
+ Case = case(MainConsId, OtherConsIds, Goal),
+ AuxGoal = gen_aux_proc_goal(Info, Goal),
+ AuxCase = case(MainConsId, OtherConsIds, AuxGoal).
%-----------------------------------------------------------------------------%
@@ -945,9 +894,10 @@
hlds_goal.
gen_aux_proc_handle_non_recursive_call(Info, Goal0) =
- ( if invariant_goal(Info ^ inv_goals, Goal0)
- then true_goal
- else Goal0
+ ( invariant_goal(Info ^ inv_goals, Goal0) ->
+ true_goal
+ ;
+ Goal0
).
%-----------------------------------------------------------------------------%
@@ -961,13 +911,10 @@
gen_out_proc(PredProcId, PredInfo0, ProcInfo0, ProcInfo, CallAux, Body0,
ModuleInfo0, ModuleInfo) :-
-
% Compute the new procedure body.
- %
- Body = gen_out_proc_2(PredProcId, CallAux, Body0),
+ Body = gen_out_proc_goal(PredProcId, CallAux, Body0),
% Put the new procedure body into the module_info.
- %
PredProcId = proc(PredId, ProcId),
proc_info_get_varset(ProcInfo0, VarSet),
@@ -987,81 +934,79 @@
%-----------------------------------------------------------------------------%
- % gen_out_proc_2(PredProcId, CallAux, Goal0) = Goal:
+ % gen_out_proc_goal(PredProcId, CallAux, Goal0) = Goal:
%
% Goal is Goal0 with calls to PredProcId replaced with CallAux.
%
-:- func gen_out_proc_2(pred_proc_id, hlds_goal, hlds_goal) = hlds_goal.
+:- func gen_out_proc_goal(pred_proc_id, hlds_goal, hlds_goal) = hlds_goal.
-gen_out_proc_2(PPId, CallAux,
- hlds_goal(Call @ plain_call(PredId, ProcId, _, _, _, _), GoalInfo)) =
- ( if proc(PredId, ProcId) = PPId
- then gen_aux_call(CallAux, hlds_goal(Call, GoalInfo))
- else hlds_goal(Call, GoalInfo)
- ).
-
-gen_out_proc_2(_PPId, _CallAux,
- hlds_goal(Call @ generic_call(_, _, _, _), GoalInfo)) =
- hlds_goal(Call, GoalInfo).
-
-gen_out_proc_2(_PPId, _CallAux,
- hlds_goal(Unification @ unify(_, _, _, _, _), GoalInfo)) =
- hlds_goal(Unification, GoalInfo).
-
-gen_out_proc_2(_PPId, _CallAux,
- hlds_goal(ForeignProc @ call_foreign_proc(_, _, _, _, _, _, _),
- GoalInfo)) =
- hlds_goal(ForeignProc, GoalInfo).
-
-gen_out_proc_2(PPId, CallAux,
- hlds_goal(conj(ConjType, Conjuncts), GoalInfo)) =
- hlds_goal(
- conj(ConjType, list.map(gen_out_proc_2(PPId, CallAux), Conjuncts)),
- GoalInfo).
-
-gen_out_proc_2(PPId, CallAux,
- hlds_goal(disj(Disjuncts), GoalInfo)) =
- hlds_goal(
- disj(list.map(gen_out_proc_2(PPId, CallAux), Disjuncts)),
- GoalInfo).
-
-gen_out_proc_2(PPId, CallAux,
- hlds_goal(switch(Var, CanFail, Cases), GoalInfo)) =
- hlds_goal(switch(Var, CanFail, list.map(GOPCase, Cases)), GoalInfo)
- :-
- GOPCase =
- ( func(case(MainConsId, OtherConsIds, Goal)) =
- case(MainConsId, OtherConsIds,
- gen_out_proc_2(PPId, CallAux, Goal)) ).
-
-gen_out_proc_2(PPId, CallAux,
- hlds_goal(negation(NegatedGoal), GoalInfo)) =
- hlds_goal(negation(gen_out_proc_2(PPId, CallAux, NegatedGoal)), GoalInfo).
-
-gen_out_proc_2(PPId, CallAux,
- hlds_goal(scope(Reason, QuantifiedGoal), GoalInfo)) =
- hlds_goal(
- scope(Reason, gen_out_proc_2(PPId, CallAux, QuantifiedGoal)),
- GoalInfo).
-
-gen_out_proc_2(PPId, CallAux,
- hlds_goal(if_then_else(XVars, Cond, Then, Else), GoalInfo)) =
- hlds_goal(
- if_then_else( XVars,
- gen_out_proc_2(PPId, CallAux, Cond),
- gen_out_proc_2(PPId, CallAux, Then),
- gen_out_proc_2(PPId, CallAux, Else)),
- GoalInfo).
+gen_out_proc_goal(PPId, CallAux, Goal) = AuxGoal :-
+ Goal = hlds_goal(GoalExpr, GoalInfo),
+ (
+ GoalExpr = plain_call(PredId, ProcId, _, _, _, _),
+ ( proc(PredId, ProcId) = PPId ->
+ AuxGoal = gen_aux_call(CallAux, Goal)
+ ;
+ AuxGoal = Goal
+ )
+ ;
+ ( GoalExpr = generic_call(_, _, _, _)
+ ; GoalExpr = unify(_, _, _, _, _)
+ ; GoalExpr = call_foreign_proc(_, _, _, _, _, _, _)
+ ),
+ AuxGoal = Goal
+ ;
+ GoalExpr = conj(ConjType, Conjuncts),
+ AuxConjuncts = list.map(gen_out_proc_goal(PPId, CallAux), Conjuncts),
+ AuxGoalExpr = conj(ConjType, AuxConjuncts),
+ AuxGoal = hlds_goal(AuxGoalExpr, GoalInfo)
+ ;
+ GoalExpr = disj(Disjuncts),
+ AuxDisjuncts = list.map(gen_out_proc_goal(PPId, CallAux), Disjuncts),
+ AuxGoalExpr = disj(AuxDisjuncts),
+ AuxGoal = hlds_goal(AuxGoalExpr, GoalInfo)
+ ;
+ GoalExpr = switch(Var, CanFail, Cases),
+ AuxCases = list.map(gen_out_proc_case(PPId, CallAux), Cases),
+ AuxGoalExpr = switch(Var, CanFail, AuxCases),
+ AuxGoal = hlds_goal(AuxGoalExpr, GoalInfo)
+ ;
+ GoalExpr = negation(SubGoal),
+ AuxSubGoal = gen_out_proc_goal(PPId, CallAux, SubGoal),
+ AuxGoalExpr = negation(AuxSubGoal),
+ AuxGoal = hlds_goal(AuxGoalExpr, GoalInfo)
+ ;
+ GoalExpr = scope(Reason, SubGoal),
+ % XXX We should consider special casing the handling of
+ % from_ground_term_construct scopes.
+ AuxSubGoal = gen_out_proc_goal(PPId, CallAux, SubGoal),
+ AuxGoalExpr = scope(Reason, AuxSubGoal),
+ AuxGoal = hlds_goal(AuxGoalExpr, GoalInfo)
+ ;
+ GoalExpr = if_then_else(Vars, Cond, Then, Else),
+ AuxCond = gen_out_proc_goal(PPId, CallAux, Cond),
+ AuxThen = gen_out_proc_goal(PPId, CallAux, Then),
+ AuxElse = gen_out_proc_goal(PPId, CallAux, Else),
+ AuxGoalExpr = if_then_else(Vars, AuxCond, AuxThen, AuxElse),
+ AuxGoal = hlds_goal(AuxGoalExpr, GoalInfo)
+ ;
+ GoalExpr = shorthand(_),
+ unexpected(this_file, "gen_out_proc_goal: shorthand")
+ ).
-gen_out_proc_2(_PPId, _CallAux, hlds_goal(shorthand(_), _GoalInfo)) = _ :-
- unexpected(this_file, "gen_out_proc_2/3: shorthand/1 in hlds_goal").
+:- func gen_out_proc_case(pred_proc_id, hlds_goal, case) = case.
+
+gen_out_proc_case(PPId, CallAux, Case) = AuxCase :-
+ Case = case(MainConsId, OtherConsIds, Goal),
+ AuxGoal = gen_out_proc_goal(PPId, CallAux, Goal),
+ AuxCase = case(MainConsId, OtherConsIds, AuxGoal).
%-----------------------------------------------------------------------------%
:- func gen_aux_call(hlds_goal, hlds_goal) = hlds_goal.
gen_aux_call(hlds_goal(CallAux0, _CallAuxInfo0), hlds_goal(Call, CallInfo)) =
- ( if
+ (
AuxArgs0 = CallAux0 ^ call_args,
Args0 = Call ^ call_args,
Args = replace_initial_args(Args0, AuxArgs0),
@@ -1072,9 +1017,9 @@
% are not changed by the recursive call and there is no need
% to adjust the instmap_delta. All other fields are correct for
% CallInfo.
- then
+ ->
hlds_goal(CallAux, CallInfo)
- else
+ ;
unexpected(this_file, "gen_aux_call/2: args not both ordinary calls")
).
@@ -1083,12 +1028,10 @@
:- func replace_initial_args(list(T), list(T)) = list(T).
replace_initial_args([], Ys ) = Ys.
-
replace_initial_args([X | Xs], [_ | Ys]) = [X | replace_initial_args(Xs, Ys)].
-
replace_initial_args([_ | _], [] ) = _ :-
unexpected(this_file,
- "replace_initial_args/2: first arg longer than second").
+ "replace_initial_args: first arg longer than second").
%-----------------------------------------------------------------------------%
@@ -1103,73 +1046,79 @@
:- func uniquely_used_vars(module_info, hlds_goal) = prog_vars.
uniquely_used_vars(ModuleInfo, Goal) =
- list.sort_and_remove_dups(uniquely_used_vars_2(ModuleInfo, Goal)).
+ list.sort_and_remove_dups(used_vars(ModuleInfo, Goal)).
%-----------------------------------------------------------------------------%
-:- func uniquely_used_vars_2(module_info, hlds_goal) = prog_vars.
-
-uniquely_used_vars_2(ModuleInfo, Goal) =
- uniquely_used_vars_3(ModuleInfo, Goal ^ hlds_goal_expr).
-
-:- func uniquely_used_vars_3(module_info, hlds_goal_expr) = prog_vars.
-
-uniquely_used_vars_3(MI, plain_call(PredId, ProcId, Args, _, _, _)) =
- list.filter_map_corresponding(uniquely_used_args(MI), Args,
- argmodes(MI, PredId, ProcId)).
-
-uniquely_used_vars_3(MI, generic_call(_, Args, Modes, _)) =
- list.filter_map_corresponding(uniquely_used_args(MI), Args, Modes).
-
-uniquely_used_vars_3(MI,
- call_foreign_proc(_, PredId, ProcId, Args, Extras, _, _)) =
- %
- % XXX `Extras' should be empty for pure calls. We cannot apply LIO to
- % non-pure goals so we shouldn't need to consider `Extras'. However, we
- % currently don't deal with the situation where we may be trying to apply
- % LIO to a non-pure goal until *after* we have called this predicate, so
- % `Extras' may not be empty. As a work-around we just add any variables
- % in `Extras' to the set of variables that cannot be hoisted.
- %
- list.filter_map_corresponding(uniquely_used_args(MI),
- list.map(foreign_arg_var, Args),
- argmodes(MI,PredId,ProcId)) ++ list.map(foreign_arg_var, Extras).
+:- func used_vars(module_info, hlds_goal) = prog_vars.
+used_vars(ModuleInfo, Goal) = UsedVars :-
+ Goal = hlds_goal(GoalExpr, _GoalInfo),
+ (
+ GoalExpr = plain_call(PredId, ProcId, Args, _, _, _),
+ UsedVars = list.filter_map_corresponding(
+ uniquely_used_args(ModuleInfo),
+ Args, argmodes(ModuleInfo, PredId, ProcId))
+ ;
+ GoalExpr = generic_call(_, Args, Modes, _),
+ UsedVars = list.filter_map_corresponding(
+ uniquely_used_args(ModuleInfo),
+ Args, Modes)
+ ;
+ GoalExpr = call_foreign_proc(_, PredId, ProcId,
+ ForeignArgs, ExtraForeignArgs, _, _),
+ % XXX `Extras' should be empty for pure calls. We cannot apply LIO
+ % to non-pure goals so we shouldn't need to consider `Extras'.
+ % However, we currently don't deal with the situation where we may be
+ % trying to apply LIO to a non-pure goal until *after* we have called
+ % this predicate, so `Extras' may not be empty. As a work-around,
+ % we just add any variables in `Extras' to the set of variables
+ % that cannot be hoisted.
+ UsedArgVars = list.filter_map_corresponding(
+ uniquely_used_args(ModuleInfo),
+ list.map(foreign_arg_var, ForeignArgs),
+ argmodes(ModuleInfo, PredId, ProcId)),
+ UsedExtraArgVars = list.map(foreign_arg_var, ExtraForeignArgs),
+ UsedVars = UsedArgVars ++ UsedExtraArgVars
+ ;
+ GoalExpr = unify(_LHS, _RHS, _UMode, _UKind, _),
% XXX This is very conservative!
- %
-uniquely_used_vars_3(_MI, unify(_LHS, _RHS, _UMode, _UKind, _)) = [].
-
-uniquely_used_vars_3(MI, conj(_, Conjuncts)) =
- list.condense(list.map(uniquely_used_vars_2(MI), Conjuncts)).
-
-uniquely_used_vars_3(MI, disj(Disjuncts)) =
- list.condense(list.map(uniquely_used_vars_2(MI), Disjuncts)).
-
-uniquely_used_vars_3(MI, switch(_, _, Cases)) =
- list.condense(list.map(uniquely_used_vars_2(MI), case_goals(Cases))).
-
-uniquely_used_vars_3(MI, negation(NegatedGoal)) =
- uniquely_used_vars_2(MI, NegatedGoal).
-
-uniquely_used_vars_3(MI, scope(_, QuantifiedGoal)) =
- uniquely_used_vars_2(MI, QuantifiedGoal).
-
-uniquely_used_vars_3(MI, if_then_else(_, Cond, Then, Else)) =
- uniquely_used_vars_2(MI, Cond) ++
- uniquely_used_vars_2(MI, Then) ++
- uniquely_used_vars_2(MI, Else).
-
-uniquely_used_vars_3(_MI, shorthand(_)) = _ :-
- unexpected(this_file, "uniquely_used_vars_3/2: shorthand/1 in hlds_goal").
+ UsedVars = []
+ ;
+ GoalExpr = conj(_, Conjuncts),
+ UsedVars = list.condense(list.map(used_vars(ModuleInfo), Conjuncts))
+ ;
+ GoalExpr = disj(Disjuncts),
+ UsedVars = list.condense(list.map(used_vars(ModuleInfo), Disjuncts))
+ ;
+ GoalExpr = switch(_, _, Cases),
+ UsedVars = list.condense(list.map(used_vars(ModuleInfo),
+ case_goals(Cases)))
+ ;
+ GoalExpr = if_then_else(_, Cond, Then, Else),
+ UsedVars = used_vars(ModuleInfo, Cond) ++
+ used_vars(ModuleInfo, Then) ++ used_vars(ModuleInfo, Else)
+ ;
+ GoalExpr = negation(SubGoal),
+ UsedVars = used_vars(ModuleInfo, SubGoal)
+ ;
+ GoalExpr = scope(_Reason, SubGoal),
+ % XXX We should consider special casing the handling of
+ % from_ground_term_construct scopes.
+ UsedVars = used_vars(ModuleInfo, SubGoal)
+ ;
+ GoalExpr = shorthand(_),
+ unexpected(this_file, "used_vars: shorthand")
+ ).
%-----------------------------------------------------------------------------%
:- func uniquely_used_args(module_info, prog_var, mer_mode) = prog_var
is semidet.
-uniquely_used_args(MI, X, M) = X :-
- mode_get_insts(MI, M, InInst, _OutInst),
- not inst_is_not_partly_unique(MI, InInst).
+uniquely_used_args(ModuleInfo, X, M) = X :-
+ mode_get_insts(ModuleInfo, M, InInst, _OutInst),
+ not inst_is_not_partly_unique(ModuleInfo, InInst).
%-----------------------------------------------------------------------------%
@@ -1186,34 +1135,34 @@
%
:- func goal_inputs(module_info, hlds_goal) = prog_vars.
-goal_inputs(ModuleInfo, Goal) =
- goal_expr_inputs(ModuleInfo, Goal ^ hlds_goal_expr).
-
-:- func goal_expr_inputs(module_info, hlds_goal_expr) = prog_vars.
-
-goal_expr_inputs(MI, plain_call(PredId, ProcId, Args, _, _, _)) =
- list.filter_map_corresponding(input_arg(MI), Args,
- argmodes(MI, PredId, ProcId)).
-
-goal_expr_inputs(MI, generic_call(_, Args, ArgModes, _)) =
- list.filter_map_corresponding(input_arg(MI), Args, ArgModes).
-
-goal_expr_inputs(MI, call_foreign_proc(_, PredId, ProcId, Args, _, _, _)) =
- list.filter_map_corresponding(input_arg(MI),
- list.map(foreign_arg_var, Args), argmodes(MI, PredId, ProcId)).
-
-goal_expr_inputs(MI, unify(LHS, UnifyRHS, _, Kind, _)) = Inputs :-
+goal_inputs(ModuleInfo, Goal) = Inputs :-
+ Goal = hlds_goal(GoalExpr, _GoalInfo),
+ (
+ GoalExpr = plain_call(PredId, ProcId, Args, _, _, _),
+ Inputs = list.filter_map_corresponding(input_arg(ModuleInfo),
+ Args, argmodes(ModuleInfo, PredId, ProcId))
+ ;
+ GoalExpr = generic_call(_, Args, ArgModes, _),
+ Inputs = list.filter_map_corresponding(input_arg(ModuleInfo),
+ Args, ArgModes)
+ ;
+ GoalExpr = call_foreign_proc(_, PredId, ProcId, ForeignArgs, _, _, _),
+ Inputs = list.filter_map_corresponding(input_arg(ModuleInfo),
+ list.map(foreign_arg_var, ForeignArgs),
+ argmodes(ModuleInfo, PredId, ProcId))
+ ;
+ GoalExpr = unify(LHS, UnifyRHS, _, Kind, _),
(
% The LHS is always an output var in constructions.
Kind = construct(_, _, RHSArgs, ArgUniModes, _, _, _),
- Inputs = list.filter_map_corresponding(
- input_arg(MI), RHSArgs, rhs_modes(ArgUniModes))
+ Inputs = list.filter_map_corresponding(input_arg(ModuleInfo),
+ RHSArgs, rhs_modes(ArgUniModes))
;
% The LHS is always in input var in deconstructions.
Kind = deconstruct(_, _, RHSArgs, ArgUniModes, _, _),
- Inputs = [ LHS
- | list.filter_map_corresponding(
- input_arg(MI), RHSArgs, rhs_modes(ArgUniModes)) ]
+ RHSInputs = list.filter_map_corresponding(input_arg(ModuleInfo),
+ RHSArgs, rhs_modes(ArgUniModes)),
+ Inputs = [LHS | RHSInputs]
;
% The RHS is the only input in an assignment.
Kind = assign(_, RHS),
@@ -1236,38 +1185,28 @@
% These should have been expanded out by now.
unexpected(this_file, "goal_expr_inputs: lambda goal")
)
+ )
+ ;
+ ( GoalExpr = conj(_, _)
+ ; GoalExpr = disj(_)
+ ; GoalExpr = switch(_, _, _)
+ ; GoalExpr = if_then_else(_, _, _, _)
+ ; GoalExpr = negation(_)
+ ; GoalExpr = scope(_, _)
+ ; GoalExpr = shorthand(_)
+ ),
+ unexpected(this_file, "goal_expr_inputs: compound goal")
).
-goal_expr_inputs(_MI, conj(_, _)) = _ :-
- unexpected(this_file, "goal_expr_inputs/2: conj/2 in hlds_goal").
-
-goal_expr_inputs(_MI, switch(_, _, _)) = _ :-
- unexpected(this_file, "goal_expr_inputs/2: switch/3 in hlds_goal").
-
-goal_expr_inputs(_MI, disj(_)) = _ :-
- unexpected(this_file, "goal_expr_inputs/2: disj/1 in hlds_goal").
-
-goal_expr_inputs(_MI, negation(_)) = _ :-
- unexpected(this_file, "goal_expr_inputs/2: negation/1 in hlds_goal").
-
-goal_expr_inputs(_MI, scope(_, _)) = _ :-
- unexpected(this_file, "goal_expr_inputs/2: some/3 in hlds_goal").
-
-goal_expr_inputs(_MI, if_then_else(_, _, _, _)) = _ :-
- unexpected(this_file, "goal_expr_inputs/2: if_then_else/4 in hlds_goal").
-
-goal_expr_inputs(_MI, shorthand(_)) = _ :-
- unexpected(this_file, "goal_expr_inputs/2: shorthand/1 in hlds_goal").
-
%-----------------------------------------------------------------------------%
% An input arg is one whose pre-call inst is not free.
%
:- func input_arg(module_info, prog_var, mer_mode) = prog_var is semidet.
-input_arg(MI, X, M) = X :-
- mode_get_insts(MI, M, InInst, _OutInst),
- not inst_is_free(MI, InInst).
+input_arg(ModuleInfo, X, M) = X :-
+ mode_get_insts(ModuleInfo, M, InInst, _OutInst),
+ not inst_is_free(ModuleInfo, InInst).
%-----------------------------------------------------------------------------%
@@ -1276,81 +1215,66 @@
%
:- func goal_outputs(module_info, hlds_goal) = prog_vars.
-goal_outputs(ModuleInfo, Goal) =
- goal_expr_outputs(ModuleInfo, Goal ^ hlds_goal_expr).
-
-:- func goal_expr_outputs(module_info, hlds_goal_expr) = prog_vars.
-
-goal_expr_outputs(MI, plain_call(PredId, ProcId, Args, _, _, _)) =
- list.filter_map_corresponding(output_arg(MI), Args,
- argmodes(MI, PredId, ProcId)).
-
-goal_expr_outputs(MI, generic_call(_, Args, ArgModes, _)) =
- list.filter_map_corresponding(output_arg(MI), Args, ArgModes).
-
-goal_expr_outputs(MI, call_foreign_proc(_, PredId, ProcId, Args, _, _, _)) =
- list.filter_map_corresponding(output_arg(MI),
- list.map(foreign_arg_var, Args), argmodes(MI, PredId, ProcId)).
-
-goal_expr_outputs(MI, unify(LHS, _RHS, _, Kind, _)) = Outputs :-
+goal_outputs(ModuleInfo, Goal) = Outputs :-
+ Goal = hlds_goal(GoalExpr, _GoalInfo),
+ (
+ GoalExpr = plain_call(PredId, ProcId, Args, _, _, _),
+ Outputs = list.filter_map_corresponding(output_arg(ModuleInfo),
+ Args, argmodes(ModuleInfo, PredId, ProcId))
+ ;
+ GoalExpr = generic_call(_, Args, ArgModes, _),
+ Outputs = list.filter_map_corresponding(output_arg(ModuleInfo),
+ Args, ArgModes)
+ ;
+ GoalExpr = call_foreign_proc(_, PredId, ProcId, ForeignArgs, _, _, _),
+ Outputs = list.filter_map_corresponding(output_arg(ModuleInfo),
+ list.map(foreign_arg_var, ForeignArgs),
+ argmodes(ModuleInfo, PredId, ProcId))
+ ;
+ GoalExpr = unify(LHS, _RHS, _, Kind, _),
(
% The LHS is the only output in a construction.
- %
Kind = construct(_, _, _, _, _, _, _),
Outputs = [LHS]
;
% The LHS is always in input in deconstructions.
- %
Kind = deconstruct(_, _, RHSArgs, ArgUniModes, _, _),
- Outputs = list.filter_map_corresponding(
- output_arg(MI), RHSArgs, rhs_modes(ArgUniModes))
+ Outputs = list.filter_map_corresponding(output_arg(ModuleInfo),
+ RHSArgs, rhs_modes(ArgUniModes))
;
% The LHS is the only output in an assignment.
- %
Kind = assign(_, _),
Outputs = [LHS]
;
% Both sides of a simple test are inputs.
- %
Kind = simple_test(_, _),
Outputs = []
;
% Both sides of a complicated unification are inputs.
- %
Kind = complicated_unify(_, _, _),
Outputs = []
+ )
+ ;
+ ( GoalExpr = conj(_, _)
+ ; GoalExpr = disj(_)
+ ; GoalExpr = switch(_, _, _)
+ ; GoalExpr = if_then_else(_, _, _, _)
+ ; GoalExpr = negation(_)
+ ; GoalExpr = scope(_, _)
+ ; GoalExpr = shorthand(_)
+ ),
+ unexpected(this_file, "goal_expr_outputs: compound goal")
).
-goal_expr_outputs(_MI, conj(_, _)) = _ :-
- unexpected(this_file, "goal_expr_outputs/2: conj/2 in hlds_goal").
-
-goal_expr_outputs(_MI, switch(_, _, _)) = _ :-
- unexpected(this_file, "goal_expr_outputs/2: switch/3 in hlds_goal").
-
-goal_expr_outputs(_MI, disj(_)) = _ :-
- unexpected(this_file, "goal_expr_outputs/2: disj/1 in hlds_goal").
-
-goal_expr_outputs(_MI, negation(_)) = _ :-
- unexpected(this_file, "goal_expr_outputs/2: negation/1 in hlds_goal").
-
-goal_expr_outputs(_MI, scope(_, _)) = _ :-
- unexpected(this_file, "goal_expr_outputs/2: some/3 in hlds_goal").
-
-goal_expr_outputs(_MI, if_then_else(_, _, _, _)) = _ :-
- unexpected(this_file, "goal_expr_outputs/2: if_then_else/4 in hlds_goal").
-
-goal_expr_outputs(_MI, shorthand(_)) = _ :-
- unexpected(this_file, "goal_expr_outputs/2: shorthand/1 in hlds_goal").
-
%-----------------------------------------------------------------------------%
% An output arg is one whose pre-call inst is free.
%
:- func output_arg(module_info, prog_var, mer_mode) = prog_var is semidet.
-output_arg(MI, X, M) = X :-
- mode_get_insts(MI, M, InInst, _OutInst),
- inst_is_free(MI, InInst).
+output_arg(ModuleInfo, X, M) = X :-
+ mode_get_insts(ModuleInfo, M, InInst, _OutInst),
+ inst_is_free(ModuleInfo, InInst).
%-----------------------------------------------------------------------------%
Index: compiler/make_hlds_passes.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/make_hlds_passes.m,v
retrieving revision 1.81
diff -u -b -r1.81 make_hlds_passes.m
--- compiler/make_hlds_passes.m 28 Jul 2008 08:34:17 -0000 1.81
+++ compiler/make_hlds_passes.m 11 Dec 2008 15:53:48 -0000
@@ -193,9 +193,12 @@
maybe_write_string(Statistics, "% Processed all items in pass 2\n",
!IO),
maybe_report_stats(Statistics, !IO),
+
init_qual_info(MQInfo0, EqvMap, QualInfo0),
add_item_list_pass_3(Items, status_local, !ModuleInfo,
QualInfo0, QualInfo, !Specs),
+ maybe_write_string(Statistics, "% Processed all items in pass 3\n",
+ !IO),
qual_info_get_mq_info(QualInfo, MQInfo),
mq_info_get_type_error_flag(MQInfo, InvalidTypes3),
Index: compiler/make_hlds_warn.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/make_hlds_warn.m,v
retrieving revision 1.28
diff -u -b -r1.28 make_hlds_warn.m
--- compiler/make_hlds_warn.m 6 Jun 2008 07:48:33 -0000 1.28
+++ compiler/make_hlds_warn.m 11 Dec 2008 15:53:48 -0000
@@ -123,8 +123,9 @@
prog_varset::in, simple_call_id::in, module_info::in,
list(error_spec)::in, list(error_spec)::out) is det.
-warn_singletons_in_goal(hlds_goal(GoalExpr, GoalInfo), QuantVars, VarSet,
- PredCallId, ModuleInfo, !Specs) :-
+warn_singletons_in_goal(Goal, QuantVars, VarSet, PredCallId, ModuleInfo,
+ !Specs) :-
+ Goal = hlds_goal(GoalExpr, GoalInfo),
(
GoalExpr = conj(_ConjType, Goals),
warn_singletons_in_goal_list(Goals, QuantVars, VarSet, PredCallId,
Index: compiler/mark_static_terms.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mark_static_terms.m,v
retrieving revision 1.29
diff -u -b -r1.29 mark_static_terms.m
--- compiler/mark_static_terms.m 30 Dec 2007 08:23:48 -0000 1.29
+++ compiler/mark_static_terms.m 11 Dec 2008 15:53:48 -0000
@@ -62,59 +62,64 @@
:- pred goal_mark_static_terms(hlds_goal::in, hlds_goal::out,
static_info::in, static_info::out) is det.
-goal_mark_static_terms(hlds_goal(GoalExpr0, GoalInfo),
- hlds_goal(GoalExpr, GoalInfo), !SI) :-
- goal_expr_mark_static_terms(GoalExpr0, GoalExpr, !SI).
-
-:- pred goal_expr_mark_static_terms(hlds_goal_expr::in, hlds_goal_expr::out,
- static_info::in, static_info::out) is det.
-
-goal_expr_mark_static_terms(conj(ConjType, Goals0), conj(ConjType, Goals),
- !SI) :-
- % It's OK to treat parallel conjunctions as if they were sequential here,
- % since if we mark any variables as static, the computation of those
- % variables will be done at compile time.
- conj_mark_static_terms(Goals0, Goals, !SI).
-
-goal_expr_mark_static_terms(disj(Goals0), disj(Goals), !SI) :-
+goal_mark_static_terms(Goal0, Goal, !SI) :-
+ Goal0 = hlds_goal(GoalExpr0, GoalInfo),
+ Goal = hlds_goal(GoalExpr, GoalInfo),
+ (
+ GoalExpr0 = conj(ConjType, Goals0),
+ % It's OK to treat parallel conjunctions as if they were sequential
+ % here, since if we mark any variables as static, the computation
+ %of those variables will be done at compile time.
+ conj_mark_static_terms(Goals0, Goals, !SI),
+ GoalExpr = conj(ConjType, Goals)
+ ;
+ GoalExpr0 = disj(Goals0),
% We revert to the original static_info at the end of branched goals.
- disj_mark_static_terms(Goals0, Goals, !.SI).
-
-goal_expr_mark_static_terms(switch(A, B, Cases0), switch(A, B, Cases), !SI) :-
+ disj_mark_static_terms(Goals0, Goals, !.SI),
+ GoalExpr = disj(Goals)
+ ;
+ GoalExpr0 = switch(Var, CanFail, Cases0),
% We revert to the original static_info at the end of branched goals.
- cases_mark_static_terms(Cases0, Cases, !.SI).
-
-goal_expr_mark_static_terms(negation(Goal0), negation(Goal), !SI) :-
+ cases_mark_static_terms(Cases0, Cases, !.SI),
+ GoalExpr = switch(Var, CanFail, Cases)
+ ;
+ GoalExpr0 = negation(SubGoal0),
% We revert to the original static_info at the end of the negation.
- goal_mark_static_terms(Goal0, Goal, !.SI, _SI).
-
-goal_expr_mark_static_terms(scope(A, Goal0), scope(A, Goal), !SI) :-
- goal_mark_static_terms(Goal0, Goal, !SI).
-
-goal_expr_mark_static_terms(if_then_else(A, Cond0, Then0, Else0),
- if_then_else(A, Cond, Then, Else), SI0, SI0) :-
+ goal_mark_static_terms(SubGoal0, SubGoal, !.SI, _SI),
+ GoalExpr = negation(SubGoal)
+ ;
+ GoalExpr0 = scope(Reason, SubGoal0),
+ % We should special-case the handling of from_ground_term_construct
+ % scopes, since these already have all their unifications marked
+ % as construct_statically.
+ goal_mark_static_terms(SubGoal0, SubGoal, !SI),
+ GoalExpr = scope(Reason, SubGoal)
+ ;
+ GoalExpr0 = if_then_else(Vars, Cond0, Then0, Else0),
+ SI0 = !.SI,
% We run the Cond and the Then in sequence, and we run the Else
% in parallel with that, and then we throw away the static_infos
% we computed and revert to the original static_info at the end,
% since this was a branched goal.
goal_mark_static_terms(Cond0, Cond, SI0, SI_Cond),
goal_mark_static_terms(Then0, Then, SI_Cond, _SI_Then),
- goal_mark_static_terms(Else0, Else, SI0, _SI_Else).
-
-goal_expr_mark_static_terms(Goal @ plain_call(_, _, _, _, _, _), Goal, !SI).
-
-goal_expr_mark_static_terms(Goal @ generic_call(_, _, _, _), Goal, !SI).
-
-goal_expr_mark_static_terms(unify(LHS, RHS, Mode, Unification0, Context),
- unify(LHS, RHS, Mode, Unification, Context), !SI) :-
- unification_mark_static_terms(Unification0, Unification, !SI).
-
-goal_expr_mark_static_terms(Goal @ call_foreign_proc(_, _, _, _, _, _, _),
- Goal, !SI).
-
-goal_expr_mark_static_terms(shorthand(_), _, !SI) :-
+ goal_mark_static_terms(Else0, Else, SI0, _SI_Else),
+ GoalExpr = if_then_else(Vars, Cond, Then, Else)
+ ;
+ ( GoalExpr0 = plain_call(_, _, _, _, _, _)
+ ; GoalExpr = generic_call(_, _, _, _)
+ ; GoalExpr = call_foreign_proc(_, _, _, _, _, _, _)
+ ),
+ GoalExpr = GoalExpr0
+ ;
+ GoalExpr0 = unify(LHS, RHS, Mode, Unification0, Context),
+ unification_mark_static_terms(Unification0, Unification, !SI),
+ GoalExpr = unify(LHS, RHS, Mode, Unification, Context)
+ ;
+ GoalExpr0 = shorthand(_),
% These should have been expanded out by now.
- unexpected(this_file, "fill_expr_slots: unexpected shorthand").
+ unexpected(this_file, "goal_mark_static_terms: shorthand")
+ ).
:- pred conj_mark_static_terms(hlds_goals::in, hlds_goals::out,
static_info::in, static_info::out) is det.
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.483
diff -u -b -r1.483 mercury_compile.m
--- compiler/mercury_compile.m 25 Nov 2008 07:46:41 -0000 1.483
+++ compiler/mercury_compile.m 11 Dec 2008 15:53:48 -0000
@@ -4087,7 +4087,7 @@
->
maybe_write_string(Verbose, "% Finding unused arguments ...\n", !IO),
maybe_flush_output(Verbose, !IO),
- unused_args.process_module(!HLDS, [], Specs, !IO),
+ unused_args_process_module(!HLDS, [], Specs, !IO),
write_error_specs(Specs, Globals, 0, _NumWarnings, 0, NumErrors, !IO),
module_info_incr_num_errors(NumErrors, !HLDS),
maybe_write_string(Verbose, "% done.\n", !IO),
@@ -4108,7 +4108,7 @@
"% Removing unneeded code from procedure bodies...\n", !IO),
maybe_flush_output(Verbose, !IO),
process_all_nonimported_procs(
- update_module_io(unneeded_code.process_proc_msg), !HLDS, !IO),
+ update_module_io(unneeded_process_proc_msg), !HLDS, !IO),
maybe_write_string(Verbose, "% done.\n", !IO),
maybe_report_stats(Stats, !IO)
;
@@ -4345,7 +4345,7 @@
"% Applying term size profiling transformation...\n", !IO),
maybe_flush_output(Verbose, !IO),
process_all_nonimported_procs(
- update_module_io(size_prof.process_proc_msg(Transform)),
+ update_module_io(size_prof_process_proc_msg(Transform)),
!HLDS, !IO),
maybe_write_string(Verbose, "% done.\n", !IO),
maybe_report_stats(Stats, !IO)
@@ -5226,9 +5226,19 @@
->
globals.lookup_bool_option(Globals, dump_same_hlds, DumpSameHLDS),
(
- DumpSameHLDS = no
+ DumpSameHLDS = no,
% Don't create a dump file for this stage, and keep the records
- % about previously dumped stages as they are.
+ % about previously dumped stages as they are. We do print a
+ % message (if asked to) about *why* we don't create this file.
+ maybe_write_string(Verbose, "% HLDS dump `", !IO),
+ maybe_write_string(Verbose, DumpFileName, !IO),
+ maybe_write_string(Verbose, "' would be identical ", !IO),
+ maybe_write_string(Verbose, "to previous dump.\n", !IO),
+
+ % If a previous dump exists with this name, leaving it around
+ % would be quite misleading. However, there is nothing useful
+ % we can do if the removal fails.
+ io.remove_file(DumpFileName, _Result, !IO)
;
DumpSameHLDS = yes,
CurDumpFileName = PrevDumpFileName,
Index: compiler/middle_rec.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/middle_rec.m,v
retrieving revision 1.135
diff -u -b -r1.135 middle_rec.m
--- compiler/middle_rec.m 27 Feb 2008 07:23:09 -0000 1.135
+++ compiler/middle_rec.m 11 Dec 2008 15:53:48 -0000
@@ -119,29 +119,39 @@
%
:- func contains_only_builtins(hlds_goal) = bool.
-contains_only_builtins(hlds_goal(GoalExpr, _GoalInfo)) =
- contains_only_builtins_expr(GoalExpr).
+contains_only_builtins(Goal) =
+ contains_only_builtins_expr(Goal ^ hlds_goal_expr).
:- func contains_only_builtins_expr(hlds_goal_expr) = bool.
-contains_only_builtins_expr(conj(ConjType, Goals)) = OnlyBuiltins :-
+contains_only_builtins_expr(GoalExpr) = OnlyBuiltins :-
+ (
+ GoalExpr = conj(ConjType, Goals),
(
ConjType = plain_conj,
OnlyBuiltins = contains_only_builtins_list(Goals)
;
ConjType = parallel_conj,
OnlyBuiltins = no
- ).
-contains_only_builtins_expr(disj(Goals)) =
- contains_only_builtins_list(Goals).
-contains_only_builtins_expr(switch(_Var, _Category, Cases)) =
- contains_only_builtins_cases(Cases).
-contains_only_builtins_expr(negation(Goal)) =
- contains_only_builtins(Goal).
-contains_only_builtins_expr(scope(_, Goal)) =
- contains_only_builtins(Goal).
-contains_only_builtins_expr(if_then_else(_Vars, Cond, Then, Else))
- = OnlyBuiltins :-
+ )
+ ;
+ GoalExpr = disj(Goals),
+ OnlyBuiltins = contains_only_builtins_list(Goals)
+ ;
+ GoalExpr = switch(_Var, _CanFail, Cases),
+ OnlyBuiltins = contains_only_builtins_cases(Cases)
+ ;
+ GoalExpr = negation(SubGoal),
+ OnlyBuiltins = contains_only_builtins(SubGoal)
+ ;
+ GoalExpr = scope(Reason, SubGoal),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ OnlyBuiltins = yes
+ ;
+ OnlyBuiltins = contains_only_builtins(SubGoal)
+ )
+ ;
+ GoalExpr = if_then_else(_Vars, Cond, Then, Else),
(
contains_only_builtins(Cond) = yes,
contains_only_builtins(Then) = yes,
@@ -150,20 +160,20 @@
OnlyBuiltins = yes
;
OnlyBuiltins = no
- ).
-contains_only_builtins_expr(plain_call(_, _, _, BuiltinState, _, _))
- = OnlyBuiltins :-
+ )
+ ;
+ GoalExpr = plain_call(_, _, _, BuiltinState, _, _),
(
BuiltinState = inline_builtin,
OnlyBuiltins = yes
;
- BuiltinState = out_of_line_builtin,
+ ( BuiltinState = out_of_line_builtin
+ ; BuiltinState = not_builtin
+ ),
OnlyBuiltins = no
+ )
;
- BuiltinState = not_builtin,
- OnlyBuiltins = no
- ).
-contains_only_builtins_expr(unify(_, _, _, Uni, _)) = OnlyBuiltins :-
+ GoalExpr = unify(_, _, _, Uni, _),
% Complicated unifies are _non_builtin_
(
Uni = assign(_, _),
@@ -192,10 +202,16 @@
;
Uni = complicated_unify(_, _, _),
OnlyBuiltins = no
+ )
+ ;
+ ( GoalExpr = call_foreign_proc(_, _, _, _, _, _, _)
+ ; GoalExpr = generic_call(_, _, _, _)
+ ),
+ OnlyBuiltins = no
+ ;
+ GoalExpr = shorthand(_),
+ unexpected(this_file, "contains_only_builtins: shorthand")
).
-contains_only_builtins_expr(call_foreign_proc(_, _, _, _, _, _, _)) = no.
-contains_only_builtins_expr(generic_call(_, _, _, _)) = no.
-contains_only_builtins_expr(shorthand(_)) = no.
:- func contains_only_builtins_cases(list(case)) = bool.
Index: compiler/ml_code_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.211
diff -u -b -r1.211 ml_code_gen.m
--- compiler/ml_code_gen.m 11 Feb 2008 21:26:00 -0000 1.211
+++ compiler/ml_code_gen.m 11 Dec 2008 15:53:48 -0000
@@ -2267,6 +2267,8 @@
ml_gen_negation(SubGoal, CodeModel, Context, Decls, Statements, !Info)
;
GoalExpr = scope(_, SubGoal),
+ % XXX We could special-case the handling of from_ground_term_construct
+ % scopes.
ml_gen_commit(SubGoal, CodeModel, Context, Decls, Statements, !Info)
;
GoalExpr = shorthand(_),
Index: compiler/mode_debug.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mode_debug.m,v
retrieving revision 1.31
diff -u -b -r1.31 mode_debug.m
--- compiler/mode_debug.m 21 Jul 2008 03:10:11 -0000 1.31
+++ compiler/mode_debug.m 11 Dec 2008 15:53:48 -0000
@@ -98,8 +98,8 @@
maybe_report_stats(Statistics, !IO),
maybe_flush_output(Statistics, !IO),
mode_info_get_instmap(!.ModeInfo, InstMap),
- ( instmap.is_reachable(InstMap) ->
- instmap.to_assoc_list(InstMap, NewInsts),
+ ( instmap_is_reachable(InstMap) ->
+ instmap_to_assoc_list(InstMap, NewInsts),
mode_info_get_last_checkpoint_insts(!.ModeInfo, OldInstMap),
mode_info_get_varset(!.ModeInfo, VarSet),
mode_info_get_instvarset(!.ModeInfo, InstVarSet),
@@ -122,7 +122,7 @@
write_var_insts([], _, _, _, _, _, !IO).
write_var_insts([Var - Inst | VarInsts], OldInstMap, VarSet, InstVarSet,
Verbose, Minimal, !IO) :-
- instmap.lookup_var(OldInstMap, Var, OldInst),
+ instmap_lookup_var(OldInstMap, Var, OldInst),
(
(
identical_insts(Inst, OldInst)
Index: compiler/mode_info.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mode_info.m,v
retrieving revision 1.97
diff -u -b -r1.97 mode_info.m
--- compiler/mode_info.m 27 Feb 2008 07:23:10 -0000 1.97
+++ compiler/mode_info.m 11 Dec 2008 15:53:48 -0000
@@ -646,8 +646,8 @@
mode_info_get_instmap(!.MI, InstMap0),
!MI ^ mi_instmap := InstMap,
(
- instmap.is_unreachable(InstMap),
- instmap.is_reachable(InstMap0)
+ instmap_is_unreachable(InstMap),
+ instmap_is_reachable(InstMap0)
->
mode_info_get_delay_info(!.MI, DelayInfo0),
delay_info_bind_all_vars(DelayInfo0, DelayInfo),
Index: compiler/mode_ordering.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mode_ordering.m,v
retrieving revision 1.28
diff -u -b -r1.28 mode_ordering.m
--- compiler/mode_ordering.m 4 Sep 2008 11:41:01 -0000 1.28
+++ compiler/mode_ordering.m 11 Dec 2008 15:53:48 -0000
@@ -312,6 +312,8 @@
goal_info_copy_mode_var_sets(SubGoal ^ hlds_goal_info, !GoalInfo).
mode_order_goal_2(Goal0, Goal, !GoalInfo, !MOI) :-
+ % XXX We should special-case the handling of from_ground_term_construct
+ % scopes.
Goal0 = scope(Reason, SubGoal0),
Goal = scope(Reason, SubGoal),
mode_order_goal(SubGoal0, SubGoal, !MOI),
Index: compiler/mode_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mode_util.m,v
retrieving revision 1.206
diff -u -b -r1.206 mode_util.m
--- compiler/mode_util.m 28 Aug 2008 03:12:53 -0000 1.206
+++ compiler/mode_util.m 11 Dec 2008 15:53:48 -0000
@@ -1032,7 +1032,7 @@
),
% If the initial instmap is unreachable so is the final instmap.
- ( instmap.is_unreachable(InstMap0) ->
+ ( instmap_is_unreachable(InstMap0) ->
instmap_delta_init_unreachable(UnreachableInstMapDelta),
goal_info_set_instmap_delta(UnreachableInstMapDelta,
GoalInfo1, GoalInfo)
@@ -1120,8 +1120,14 @@
GoalExpr = if_then_else(Vars, Cond, Then, Else)
;
GoalExpr0 = scope(Reason, SubGoal0),
- recompute_instmap_delta_1(RecomputeAtomic, SubGoal0, SubGoal, VarTypes,
- InstMap0, InstMapDelta, !RI),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ SubGoal = SubGoal0,
+ SubGoal = hlds_goal(_, SubGoalInfo),
+ InstMapDelta = goal_info_get_instmap_delta(SubGoalInfo)
+ ;
+ recompute_instmap_delta_1(RecomputeAtomic, SubGoal0, SubGoal,
+ VarTypes, InstMap0, InstMapDelta, !RI)
+ ),
GoalExpr = scope(Reason, SubGoal)
;
GoalExpr0 = generic_call(_Details, Vars, Modes, Detism),
@@ -1361,8 +1367,8 @@
% This is similar to modecheck_var_has_inst.
SaveModuleInfo = !.ModuleInfo,
SaveSub = !.Sub,
- ( instmap.is_reachable(InstMap) ->
- instmap.lookup_var(InstMap, Arg, ArgInst),
+ ( instmap_is_reachable(InstMap) ->
+ instmap_lookup_var(InstMap, Arg, ArgInst),
map.lookup(VarTypes, Arg, Type),
( inst_matches_initial(ArgInst, Inst, Type, !ModuleInfo, !Sub) ->
true
@@ -1394,8 +1400,8 @@
recompute_instmap_delta_call_2([Arg | Args], InstMap, [Mode0 | Modes0],
[Mode | Modes], !ModuleInfo) :-
% This is similar to modecheck_set_var_inst.
- ( instmap.is_reachable(InstMap) ->
- instmap.lookup_var(InstMap, Arg, ArgInst0),
+ ( instmap_is_reachable(InstMap) ->
+ instmap_lookup_var(InstMap, Arg, ArgInst0),
mode_get_insts(!.ModuleInfo, Mode0, _, FinalInst),
(
abstractly_unify_inst(is_dead, ArgInst0, FinalInst,
@@ -1431,7 +1437,7 @@
% as in the old instmap.
OldInstMapDelta = goal_info_get_instmap_delta(GoalInfo),
- instmap.lookup_var(InstMap, Var, InitialInst),
+ instmap_lookup_var(InstMap, Var, InitialInst),
( instmap_delta_search_var(OldInstMapDelta, Var, FinalInst1) ->
% XXX we need to merge the information in InitialInst
% and FinalInst1. In puzzle_detism_bug, InitialInst
@@ -1468,7 +1474,7 @@
->
UniMode = UniMode0,
instmap_delta_init_reachable(InstMapDelta0),
- instmap_delta_set(Var, Inst, InstMapDelta0, InstMapDelta)
+ instmap_delta_set_var(Var, Inst, InstMapDelta0, InstMapDelta)
;
InstMapDelta = goal_info_get_instmap_delta(GoalInfo),
UniMode = UniMode0
@@ -1602,12 +1608,12 @@
fixup_switch_var(Var, InstMap0, InstMap, Goal0, Goal) :-
Goal0 = hlds_goal(GoalExpr, GoalInfo0),
InstMapDelta0 = goal_info_get_instmap_delta(GoalInfo0),
- instmap.lookup_var(InstMap0, Var, Inst0),
- instmap.lookup_var(InstMap, Var, Inst),
+ instmap_lookup_var(InstMap0, Var, Inst0),
+ instmap_lookup_var(InstMap, Var, Inst),
( Inst = Inst0 ->
GoalInfo = GoalInfo0
;
- instmap_delta_set(Var, Inst, InstMapDelta0, InstMapDelta),
+ instmap_delta_set_var(Var, Inst, InstMapDelta0, InstMapDelta),
goal_info_set_instmap_delta(InstMapDelta, GoalInfo0, GoalInfo)
),
Goal = hlds_goal(GoalExpr, GoalInfo).
Index: compiler/modecheck_call.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/modecheck_call.m,v
retrieving revision 1.83
diff -u -b -r1.83 modecheck_call.m
--- compiler/modecheck_call.m 22 Jan 2008 15:06:13 -0000 1.83
+++ compiler/modecheck_call.m 11 Dec 2008 15:53:48 -0000
@@ -196,7 +196,7 @@
ArgVars = ArgVars0,
WaitingVars = set.list_to_set(ArgVars),
ExtraGoals = no_extra_goals,
- instmap.lookup_vars(ArgVars, InstMap, ArgInsts),
+ instmap_lookup_vars(InstMap, ArgVars, ArgInsts),
mode_info_set_call_arg_context(0, !ModeInfo),
mode_info_error(WaitingVars,
mode_error_in_callee(ArgVars, ArgInsts, PredId, TheProcId,
@@ -220,7 +220,7 @@
% First, check that `PredVar' has a higher-order pred inst
% (of the appropriate arity).
mode_info_get_instmap(!.ModeInfo, InstMap0),
- instmap.lookup_var(InstMap0, PredVar, PredVarInst0),
+ instmap_lookup_var(InstMap0, PredVar, PredVarInst0),
mode_info_get_module_info(!.ModeInfo, ModuleInfo0),
inst_expand(ModuleInfo0, PredVarInst0, PredVarInst),
list.length(Args0, Arity),
@@ -352,7 +352,7 @@
;
TheProcId = invalid_proc_id, % dummy value
mode_info_get_instmap(!.ModeInfo, InstMap),
- instmap.lookup_vars(ArgVars, InstMap, ArgInsts),
+ instmap_lookup_vars(InstMap, ArgVars, ArgInsts),
mode_info_set_call_arg_context(0, !ModeInfo),
mode_info_error(WaitingVars,
mode_error_no_matching_mode(ArgVars, ArgInsts), !ModeInfo)
@@ -507,7 +507,7 @@
mode_info_get_module_info(ModeInfo, ModuleInfo),
mode_info_get_instmap(ModeInfo, InstMap),
mode_info_get_var_types(ModeInfo, VarTypes),
- instmap.lookup_var(InstMap, Var, Inst0),
+ instmap_lookup_var(InstMap, Var, Inst0),
map.lookup(VarTypes, Var, Type),
normalise_inst(ModuleInfo, Type, Inst0, Inst),
Index: compiler/modecheck_unify.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/modecheck_unify.m,v
retrieving revision 1.126
diff -u -b -r1.126 modecheck_unify.m
--- compiler/modecheck_unify.m 28 Apr 2008 00:50:54 -0000 1.126
+++ compiler/modecheck_unify.m 11 Dec 2008 15:53:48 -0000
@@ -84,13 +84,12 @@
%-----------------------------------------------------------------------------%
- % We first have to check that if a unification occurs in a negated
- % context with an inst any argument then it has an explicit `impure'
- % annotation.
+ % If a unification occurs in a negated context with an inst "any" argument
+ % then it has an explicit `impure' annotation.
%
% With lambdas, the lambda itself has a higher-order any inst if it
- % includes any inst any nonlocals. The value of the lambda expression
- % does not become fixed until all of the non-locals become fixed.
+ % includes any inst "any" nonlocals. The value of the lambda expression
+ % does not become fixed until all of the nonlocals become fixed.
% Executing such a lambda may constrain nonlocal solver variables,
% which in turn constrains the higher-order value itself. Effectively,
% call/N constrains the predicate value to be "some predicate that is
@@ -101,41 +100,60 @@
% But we also allow a ground higher-order inst to be used with non-ground
% locals, provided the type of the higher-order value is impure.
%
-modecheck_unification(X, RHS, Unification0, UnifyContext, UnifyGoalInfo0,
- Unify, !ModeInfo, !IO) :-
+modecheck_unification(LHSVar, RHS, Unification0, UnifyContext, UnifyGoalInfo0,
+ Goal, !ModeInfo, !IO) :-
+ (
+ RHS = rhs_var(RHSVar),
+ modecheck_unification_var(LHSVar, RHSVar,
+ Unification0, UnifyContext, UnifyGoalInfo0, Goal, !ModeInfo, !IO)
+ ;
+ RHS = rhs_functor(ConsId, IsExistConstr, RHSVars),
+ modecheck_unification_functor(LHSVar, ConsId, IsExistConstr, RHSVars,
+ Unification0, UnifyContext, UnifyGoalInfo0, Goal, !ModeInfo, !IO)
+ ;
+ RHS = rhs_lambda_goal(Purity, HOGroundness, _PredOrFunc,
+ _LambdaEvalMethod, LambdaNonLocals, _LambdaQuantVars, _ArgModes,
+ _Detism, _LambdaGoal),
(
- % If this is a ground lambda unification containing some inst any
- % nonlocals, then the lambda should be marked as impure.
- %
- RHS = rhs_lambda_goal(Purity, ho_ground, _, _, NonLocals, _, _, _, _),
Purity \= purity_impure,
+ HOGroundness = ho_ground,
mode_info_get_module_info(!.ModeInfo, ModuleInfo),
mode_info_get_instmap(!.ModeInfo, InstMap),
AnyVars = list.filter(var_inst_contains_any(ModuleInfo, InstMap),
- NonLocals),
+ LambdaNonLocals),
AnyVars = [_ | _]
->
set.init(WaitingVars),
mode_info_error(WaitingVars,
purity_error_lambda_should_be_any(AnyVars), !ModeInfo),
- Unify = conj(plain_conj, [])
+ Goal = conj(plain_conj, [])
;
- modecheck_unification_2(X, RHS, Unification0, UnifyContext,
- UnifyGoalInfo0, Unify, !ModeInfo, !IO)
+ (
+ goal_info_has_feature(UnifyGoalInfo0,
+ feature_lambda_undetermined_mode)
+ ->
+ modecheck_unification_rhs_undetermined_mode_lambda(LHSVar,
+ RHS, Unification0, UnifyContext, UnifyGoalInfo0, Goal,
+ !ModeInfo, !IO)
+ ;
+ modecheck_unification_rhs_lambda(LHSVar,
+ RHS, Unification0, UnifyContext, UnifyGoalInfo0, Goal,
+ !ModeInfo, !IO)
+ )
+ )
).
-
-:- pred modecheck_unification_2(prog_var::in, unify_rhs::in, unification::in,
+:- pred modecheck_unification_var(prog_var::in, prog_var::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_unification_2(X, rhs_var(Y), Unification0, UnifyContext,
+modecheck_unification_var(X, Y, Unification0, UnifyContext,
UnifyGoalInfo0, UnifyGoalExpr, !ModeInfo, !IO) :-
mode_info_get_module_info(!.ModeInfo, ModuleInfo0),
mode_info_get_var_types(!.ModeInfo, VarTypes),
mode_info_get_instmap(!.ModeInfo, InstMap0),
- instmap.lookup_var(InstMap0, X, InstOfX0),
- instmap.lookup_var(InstMap0, Y, InstOfY0),
+ instmap_lookup_var(InstMap0, X, InstOfX0),
+ instmap_lookup_var(InstMap0, Y, InstOfY0),
% If X and Y are free and have a solver type and we are allowed to
% insert initialisation calls at this point, then do so to allow
% scheduling of the unification.
@@ -150,7 +168,7 @@
construct_initialisation_call(X, VarType, any_inst,
context_init, no, InitXGoal, !ModeInfo),
MaybeInitX = yes(InitXGoal),
- instmap.set(X, any_inst, InstMap0, InstMap),
+ instmap_set_var(X, any_inst, InstMap0, InstMap),
InstOfX = any_inst,
InstOfY = InstOfY0
;
@@ -221,14 +239,17 @@
UnifyGoalExpr = unify(X, rhs_var(Y), Modes, Unification, UnifyContext)
).
-modecheck_unification_2(X0,
- rhs_functor(ConsId0, IsExistConstruction, ArgVars0),
+:- pred modecheck_unification_functor(prog_var::in, cons_id::in,
+ is_existential_construction::in, list(prog_var)::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_unification_functor(X0, ConsId0, IsExistConstruction, ArgVars0,
Unification0, UnifyContext, GoalInfo0, Goal, !ModeInfo, !IO) :-
mode_info_get_module_info(!.ModeInfo, ModuleInfo0),
mode_info_get_var_types(!.ModeInfo, VarTypes0),
map.lookup(VarTypes0, X0, TypeOfX),
- %
% We replace any unifications with higher-order pred constants
% by lambda expressions. For example, we replace
%
@@ -243,7 +264,7 @@
% (e.g. for deforestation), then we may need to do it again here.
% Note that any changes to this code here will probably need to be
% duplicated there too.
- %
+
(
% Check if variable has a higher-order type.
type_is_higher_order_details(TypeOfX, Purity, _, EvalMethod,
@@ -261,7 +282,7 @@
mode_info_set_var_types(VarTypes, !ModeInfo),
% Modecheck this unification in its new form.
- modecheck_unification_2(X0, Functor0, Unification0, UnifyContext,
+ modecheck_unification(X0, Functor0, Unification0, UnifyContext,
GoalInfo0, Goal, !ModeInfo, !IO)
;
% It's not a higher-order pred unification - just
@@ -271,17 +292,6 @@
UnifyContext, GoalInfo0, Goal, !ModeInfo, !IO)
).
-modecheck_unification_2(X, LambdaGoal, Unification0, UnifyContext, GoalInfo,
- Goal, !ModeInfo, !IO) :-
- LambdaGoal = rhs_lambda_goal(_, _, _, _, _, _, _, _, _),
- ( goal_info_has_feature(GoalInfo, feature_lambda_undetermined_mode) ->
- modecheck_unification_rhs_undetermined_mode_lambda(X, LambdaGoal,
- Unification0, UnifyContext, GoalInfo, Goal, !ModeInfo, !IO)
- ;
- modecheck_unification_rhs_lambda(X, LambdaGoal, Unification0,
- UnifyContext, GoalInfo, Goal, !ModeInfo, !IO)
- ).
-
:- pred modecheck_unification_rhs_lambda(prog_var::in,
unify_rhs::in(rhs_lambda_goal), unification::in, unify_context::in,
hlds_goal_info::in, hlds_goal_expr::out, mode_info::in, mode_info::out,
@@ -374,13 +384,13 @@
mode_info_get_var_types(!.ModeInfo, NonLocalTypes),
NonLocals = set.filter((pred(NonLocal::in) is semidet :-
map.lookup(NonLocalTypes, NonLocal, NonLocalType),
- instmap.lookup_var(InstMap1, NonLocal, NonLocalInst),
+ instmap_lookup_var(InstMap1, NonLocal, NonLocalInst),
\+ inst_matches_initial(NonLocalInst, any(shared, none),
NonLocalType, ModuleInfo0)
), NonLocals1)
),
set.to_sorted_list(NonLocals, NonLocalsList),
- instmap.lookup_vars(NonLocalsList, InstMap1, NonLocalInsts),
+ instmap_lookup_vars(InstMap1, NonLocalsList, NonLocalInsts),
mode_info_get_module_info(!.ModeInfo, ModuleInfo2),
(
% XXX This test is too conservative.
@@ -408,7 +418,7 @@
->
make_shared_inst_list(NonLocalInsts, SharedNonLocalInsts,
ModuleInfo2, ModuleInfo3),
- instmap.set_vars(NonLocalsList, SharedNonLocalInsts,
+ instmap_set_vars_corresponding(NonLocalsList, SharedNonLocalInsts,
InstMap1, InstMap2),
mode_info_set_module_info(ModuleInfo3, !ModeInfo),
mode_info_set_instmap(InstMap2, !ModeInfo),
@@ -436,7 +446,7 @@
% Ensure that the non-local vars are shared OUTSIDE the
% lambda unification as well as inside.
- instmap.set_vars(NonLocalsList, SharedNonLocalInsts,
+ instmap_set_vars_corresponding(NonLocalsList, SharedNonLocalInsts,
InstMap0, InstMap11),
mode_info_set_instmap(InstMap11, !ModeInfo),
@@ -449,19 +459,19 @@
;
list.filter(
(pred(Var :: in) is semidet :-
- instmap.lookup_var(InstMap1, Var, Inst),
+ instmap_lookup_var(InstMap1, Var, Inst),
\+ inst_is_ground(ModuleInfo2, Inst)
), NonLocalsList, NonGroundNonLocals),
(
NonGroundNonLocals = [BadVar | _],
- instmap.lookup_var(InstMap1, BadVar, BadInst),
+ instmap_lookup_var(InstMap1, BadVar, BadInst),
set.singleton_set(WaitingVars, BadVar),
mode_info_error(WaitingVars,
mode_error_non_local_lambda_var(BadVar, BadInst), !ModeInfo)
;
NonGroundNonLocals = [],
unexpected(this_file,
- "modecheck_unification_2(lambda): very strange var")
+ "modecheck_unification_rhs_lambda: very strange var")
),
% Return any old garbage.
RHS = rhs_lambda_goal(Purity, Groundness, PredOrFunc, EvalMethod,
@@ -479,7 +489,7 @@
RHS0, RHS, Unification0, Unification, Mode, !ModeInfo) :-
mode_info_get_module_info(!.ModeInfo, ModuleInfo0),
mode_info_get_instmap(!.ModeInfo, InstMap0),
- instmap.lookup_var(InstMap0, X, InstOfX),
+ instmap_lookup_var(InstMap0, X, InstOfX),
InstOfY = ground(unique, higher_order(LambdaPredInfo)),
LambdaPredInfo = pred_inst_info(PredOrFunc, LambdaModes, LambdaDet),
(
@@ -493,7 +503,7 @@
Mode = ModeOfX - ModeOfY,
% the lambda expression just maps its argument variables
% from their current insts to the same inst
- instmap.lookup_vars(ArgVars, InstMap0, ArgInsts),
+ instmap_lookup_vars(InstMap0, ArgVars, ArgInsts),
inst_lists_to_mode_list(ArgInsts, ArgInsts, ArgModes),
categorize_unify_var_lambda(ModeOfX, ArgModes, X, ArgVars, PredOrFunc,
RHS0, RHS, Unification0, Unification, !ModeInfo),
@@ -522,9 +532,9 @@
hlds_goal_info::in, hlds_goal_expr::out, mode_info::in, mode_info::out,
io::di, io::uo) is det.
-modecheck_unification_rhs_undetermined_mode_lambda(X, LambdaGoal0, Unification,
+modecheck_unification_rhs_undetermined_mode_lambda(X, RHS0, Unification,
UnifyContext, GoalInfo0, Goal, !ModeInfo, !IO) :-
- LambdaGoal0 = rhs_lambda_goal(_, _, _, _, _, _, _, _, Goal0),
+ RHS0 = rhs_lambda_goal(_, _, _, _, _, _, _, _, Goal0),
% Find out the predicate called in the lambda goal.
( predids_with_args_from_goal(Goal0, [{PredId, ArgVars}]) ->
mode_info_get_module_info(!.ModeInfo, ModuleInfo),
@@ -543,12 +553,11 @@
Goal = true_goal_expr
;
MatchResult = possible_modes([ProcId]),
- fix_undetermined_mode_lambda_goal(ProcId, LambdaGoal0, LambdaGoal,
- ModuleInfo),
+ fix_undetermined_mode_lambda_goal(ProcId, RHS0, RHS, ModuleInfo),
goal_info_remove_feature(feature_lambda_undetermined_mode,
GoalInfo0, GoalInfo),
% Modecheck this unification in its new form.
- modecheck_unification_2(X, LambdaGoal, Unification, UnifyContext,
+ modecheck_unification_rhs_lambda(X, RHS, Unification, UnifyContext,
GoalInfo, Goal, !ModeInfo, !IO)
;
MatchResult = possible_modes([_, _ | _]),
@@ -580,7 +589,7 @@
qualify_cons_id(TypeOfX, ArgVars0, ConsId0, ConsId, InstConsId),
mode_info_get_instmap(!.ModeInfo, InstMap0),
- instmap.lookup_var(InstMap0, X0, InstOfX0),
+ instmap_lookup_var(InstMap0, X0, InstOfX0),
(
% If the unification was originally of the form X = 'new f'(Y),
% it must be classified as a construction. If it were classified as a
@@ -618,7 +627,7 @@
inst_match.inst_is_free(ModuleInfo0, InstOfX),
mode_info_may_init_solver_vars(!.ModeInfo),
mode_info_solver_init_is_supported(!.ModeInfo),
- instmap.lookup_vars(ArgVars0, InstMap0, InstArgs0),
+ instmap_lookup_vars(InstMap0, ArgVars0, InstArgs0),
all_arg_vars_are_non_free_or_solver_vars(ArgVars0, InstArgs0,
VarTypes, ModuleInfo0, ArgVarsToInit)
->
@@ -634,7 +643,7 @@
ExtraGoals1 = no_extra_goals
),
mode_info_get_instmap(!.ModeInfo, InstMap1),
- instmap.lookup_vars(ArgVars0, InstMap1, InstArgs),
+ instmap_lookup_vars(InstMap1, ArgVars0, InstArgs),
mode_info_var_list_is_live(!.ModeInfo, ArgVars0, LiveArgs),
InstOfY = bound(unique, [bound_functor(InstConsId, InstArgs)]),
(
@@ -756,11 +765,10 @@
ExtraGoals2 = no_extra_goals
),
- %
% Optimize away construction of unused terms by replacing the unification
% with `true'. Optimize away unifications which always fail by replacing
% them with `fail'.
- %
+
(
Unification = construct(_, _, _, _, _, _, _),
LiveX = is_dead
@@ -807,20 +815,20 @@
;
Functor = rhs_functor(ConsId, IsExistConstruction, ArgVars),
Unify = unify(X, Functor, Mode, Unification, UnifyContext),
- %
+
% Modecheck_unification sometimes needs to introduce new goals
% to handle complicated sub-unifications in deconstructions.
% The only time this can happen during unique mode analysis is if
% the instmap is unreachable, since inst_is_bound succeeds for
% not_reached. (If it did in other cases, the code would be wrong
% since it wouldn't have the correct determinism annotations.)
- %
+
append_extra_goals(ExtraGoals0, ExtraGoals1, ExtraGoals01),
append_extra_goals(ExtraGoals01, ExtraGoals2, ExtraGoals),
(
HowToCheckGoal = check_unique_modes,
ExtraGoals = extra_goals(_, _),
- instmap.is_reachable(InstMap1)
+ instmap_is_reachable(InstMap1)
->
unexpected(this_file,
"re-modecheck of unification " ++
@@ -1192,7 +1200,6 @@
mode_info_error(WaitingVars, mode_error_poly_unify(Y, InitialInstY),
!ModeInfo)
;
-
% Check that we're not trying to do a higher-order unification.
type_is_higher_order_details(Type, _, PredOrFunc, _, _)
->
@@ -1206,7 +1213,7 @@
mode_info_get_instmap(!.ModeInfo, InstMap0),
(
( is_unify_or_compare_pred(PredInfo)
- ; instmap.is_unreachable(InstMap0)
+ ; instmap_is_unreachable(InstMap0)
)
->
true
@@ -1284,7 +1291,7 @@
% not be converted back to a predicate constant, but that doesn't
% matter since the code will be pruned away later by simplify.m.
ConsId = pred_const(ShroudedPredProcId, EvalMethod),
- instmap.is_reachable(InstMap)
+ instmap_is_reachable(InstMap)
->
proc(PredId, ProcId) = unshroud_pred_proc_id(ShroudedPredProcId),
(
@@ -1305,7 +1312,7 @@
),
Unification = construct(X, ConsId, ArgVars, ArgModes,
construct_dynamically, cell_is_unique, SubInfo)
- ; instmap.is_reachable(InstMap) ->
+ ; instmap_is_reachable(InstMap) ->
% If it is a deconstruction, it is a mode error.
% The error message would be incorrect in unreachable code,
% since not_reached is considered bound.
@@ -1403,7 +1410,7 @@
mode_info_get_instmap(!.ModeInfo, InstMap0),
(
type_is_higher_order_details(TypeOfX, _, PredOrFunc, _, _),
- instmap.is_reachable(InstMap0)
+ instmap_is_reachable(InstMap0)
->
set.init(WaitingVars),
mode_info_error(WaitingVars,
@@ -1512,7 +1519,7 @@
% to delay the goal.
Initial = mode_get_initial_inst(ModuleInfo, ArgMode),
( Initial = ground(_, higher_order(_)) ->
- instmap.lookup_var(InstMap, Arg, ArgInst),
+ instmap_lookup_var(InstMap, Arg, ArgInst),
map.lookup(VarTypes, Arg, ArgType),
( inst_matches_initial(ArgInst, Initial, ArgType, ModuleInfo) ->
match_mode_by_higher_order_insts(ModuleInfo, InstMap, VarTypes,
@@ -1631,7 +1638,7 @@
init_instmap_may_have_subtype(ModeInfo) = MayHaveSubtype :-
mode_info_get_initial_instmap(ModeInfo, InitialInstMap),
- instmap.to_assoc_list(InitialInstMap, InitVarsInsts),
+ instmap_to_assoc_list(InitialInstMap, InitVarsInsts),
assoc_list.values(InitVarsInsts, InitInsts),
mode_info_get_module_info(ModeInfo, ModuleInfo),
MayRestrictList =
Index: compiler/modes.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/modes.m,v
retrieving revision 1.371
diff -u -b -r1.371 modes.m
--- compiler/modes.m 8 Sep 2008 04:35:53 -0000 1.371
+++ compiler/modes.m 12 Dec 2008 04:39:40 -0000
@@ -383,6 +383,7 @@
:- import_module mdbcomp.
:- import_module mdbcomp.prim_data.
:- import_module parse_tree.error_util.
+:- import_module parse_tree.mercury_to_mercury.
:- import_module parse_tree.prog_event.
:- import_module parse_tree.prog_mode.
:- import_module parse_tree.prog_out.
@@ -396,6 +397,7 @@
:- import_module pair.
:- import_module set.
:- import_module string.
+:- import_module svmap.
:- import_module term.
:- import_module varset.
@@ -492,7 +494,6 @@
DebugModes = no
),
- %
% Mode analysis may have modified the procedure bodies,
% since it does some optimizations such as deleting unreachable
% code. But since we didn't reach a fixpoint yet, the mode
@@ -500,7 +501,6 @@
% will have been done based on incomplete information, and so
% they may produce incorrect results. We thus need to restore
% the old procedure bodies.
- %
(
WhatToCheck = check_modes,
@@ -582,20 +582,19 @@
map.set(PredTable0, PredId, PredInfo, PredTable)
).
- % copy_proc_body(OldProcTable, ProcId, ProcTable0, ProcTable):
+ % copy_proc_body(OldProcTable, ProcId, !ProcTable):
%
- % Copy the body of the specified ProcId from OldProcTable
- % into ProcTable0, giving ProcTable.
+ % Copy the body of the specified ProcId from OldProcTable into !ProcTable.
%
:- pred copy_proc_body(proc_table::in, proc_id::in,
proc_table::in, proc_table::out) is det.
-copy_proc_body(OldProcTable, ProcId, ProcTable0, ProcTable) :-
+copy_proc_body(OldProcTable, ProcId, !ProcTable) :-
map.lookup(OldProcTable, ProcId, OldProcInfo),
proc_info_get_goal(OldProcInfo, OldProcBody),
- map.lookup(ProcTable0, ProcId, ProcInfo0),
+ map.lookup(!.ProcTable, ProcId, ProcInfo0),
proc_info_set_goal(OldProcBody, ProcInfo0, ProcInfo),
- map.set(ProcTable0, ProcId, ProcInfo, ProcTable).
+ svmap.set(ProcId, ProcInfo, !ProcTable).
:- func should_modecheck_pred(pred_info) = bool.
@@ -656,24 +655,21 @@
( check_marker(Markers, marker_infer_modes) ->
(
WhatToCheck = check_modes,
- write_pred_progress_message("% Mode-analysing ",
- PredId, ModuleInfo, !IO)
+ Msg = "% Mode-analysing "
;
WhatToCheck = check_unique_modes,
- write_pred_progress_message("% Unique-mode-analysing ",
- PredId, ModuleInfo, !IO)
+ Msg = "% Unique-mode-analysing "
)
;
(
WhatToCheck = check_modes,
- write_pred_progress_message("% Mode-checking ",
- PredId, ModuleInfo, !IO)
+ Msg = "% Mode-checking "
;
WhatToCheck = check_unique_modes,
- write_pred_progress_message("% Unique-mode-checking ",
- PredId, ModuleInfo, !IO)
+ Msg = "% Unique-mode-checking "
)
- ).
+ ),
+ write_pred_progress_message(Msg, PredId, ModuleInfo, !IO).
%-----------------------------------------------------------------------------%
@@ -708,9 +704,8 @@
ProcIds = pred_info_procids(PredInfo0),
modecheck_procs(ProcIds, PredId, WhatToCheck, MayChangeCalledProc,
!ModuleInfo, !Changed, init_error_spec_accumulator, ErrorSpecs, !IO),
- %
+
% Report errors and warnings.
- %
module_info_get_globals(!.ModuleInfo, Globals),
ErrorSpecsList = error_spec_accumulator_to_list(ErrorSpecs),
write_error_specs(ErrorSpecsList, Globals, 0, _NumWarnings, 0, NumErrors,
@@ -806,7 +801,7 @@
% Construct the initial instmap.
mode_list_get_initial_insts(!.ModuleInfo, ArgModes0, ArgInitialInsts),
assoc_list.from_corresponding_lists(HeadVars, ArgInitialInsts, InstAL),
- instmap.from_assoc_list(InstAL, InstMap0),
+ instmap_from_assoc_list(InstAL, InstMap0),
% Construct the initial set of live vars:
% initially, only the non-clobbered head variables are live.
@@ -912,7 +907,7 @@
% Manufacture an instmap_delta for the disjunction as a whole.
assoc_list.from_corresponding_lists(HeadVars, ArgFinalInsts0,
HeadVarFinalInsts),
- instmap.from_assoc_list(HeadVarFinalInsts, FinalInstMap),
+ instmap_from_assoc_list(HeadVarFinalInsts, FinalInstMap),
compute_instmap_delta(InstMap0, FinalInstMap, BodyNonLocals,
DeltaInstMap),
goal_info_set_instmap_delta(DeltaInstMap,
@@ -1017,7 +1012,7 @@
% Modecheck this case (if it is reachable).
mode_info_get_instmap(!.ModeInfo, InstMap1),
- ( instmap.is_reachable(InstMap1) ->
+ ( instmap_is_reachable(InstMap1) ->
modecheck_goal(Goal0, Goal1, !ModeInfo, !IO),
mode_info_get_instmap(!.ModeInfo, InstMap)
;
@@ -1065,7 +1060,7 @@
modecheck_functors_test(Var, MainConsId, OtherConsIds, !ModeInfo),
mode_info_get_instmap(!.ModeInfo, InstMap1),
- ( instmap.is_reachable(InstMap1) ->
+ ( instmap_is_reachable(InstMap1) ->
unique_modes_check_goal(Goal0, Goal1, !ModeInfo, !IO)
;
% We should not mode-analyse the goal, since it is unreachable.
@@ -1085,21 +1080,21 @@
%-----------------------------------------------------------------------------%
- % Modecheck_final_insts for a lambda expression.
+ % This is modecheck_final_insts for a lambda expression.
%
modecheck_lambda_final_insts(HeadVars, ArgFinalInsts, !Goal, !ModeInfo) :-
- % for lambda expressions, modes must always be
- % declared, we never infer them.
+ % For lambda expressions, modes must always be declared;
+ % we never infer them.
InferModes = no,
modecheck_final_insts(HeadVars, InferModes, ArgFinalInsts,
_NewFinalInsts, !Goal, !ModeInfo).
+ % Check that the final insts of the head vars match their expected insts.
+ %
:- pred modecheck_final_insts(list(prog_var)::in, bool::in,
list(mer_inst)::in, list(mer_inst)::out, hlds_goal::in, hlds_goal::out,
mode_info::in, mode_info::out) is det.
- % Check that the final insts of the head vars match their expected insts.
- %
modecheck_final_insts(HeadVars, InferModes, FinalInsts0, FinalInsts,
Body0, Body, !ModeInfo) :-
mode_info_get_module_info(!.ModeInfo, ModuleInfo),
@@ -1112,10 +1107,9 @@
% rejected modes.
(
Errors = [_ | _],
- % If there were any mode errors, something must have
- % changed, since if the procedure had mode errors
- % in a previous pass then it wouldn't have been
- % processed at all in this pass.
+ % If there were any mode errors, something must have changed, since
+ % if the procedure had mode errors in a previous pass, then it
+ % wouldn't have been processed at all in this pass.
Changed0 = yes,
instmap.init_unreachable(InstMap)
;
@@ -1124,7 +1118,7 @@
mode_info_get_instmap(!.ModeInfo, InstMap)
),
mode_info_get_var_types(!.ModeInfo, VarTypes),
- instmap.lookup_vars(HeadVars, InstMap, VarFinalInsts1),
+ instmap_lookup_vars(InstMap, HeadVars, VarFinalInsts1),
map.apply_to_list(HeadVars, VarTypes, ArgTypes),
(
InferModes = yes,
@@ -1360,7 +1354,8 @@
ConjType = plain_conj,
mode_checkpoint(enter, "conj", !ModeInfo, !IO),
(
- Goals0 = [], % for efficiency, optimize common case
+ Goals0 = [],
+ % Optimize the common case for efficiency.
GoalExpr = conj(plain_conj, [])
;
Goals0 = [_ | _],
@@ -1393,23 +1388,109 @@
% modecheck_clause_disj or the code that calls it.
Disjuncts0 = [_ | _],
NonLocals = goal_info_get_nonlocals(GoalInfo0),
- modecheck_disj_list(Disjuncts0, Disjuncts1, InstMapList0,
- !ModeInfo, !IO),
+ modecheck_disj_list(Disjuncts0, Disjuncts1, InstMaps0,
+ NonLocals, LargeFlatConstructs, !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, Disjuncts1, Disjuncts2, InstMapList0, InstMapList,
+ VarTypes, Disjuncts1, Disjuncts2, InstMaps0, InstMaps,
!ModeInfo)
;
- InstMapList = InstMapList0,
+ InstMaps = InstMaps0,
Disjuncts2 = Disjuncts1
),
- Disjuncts = flatten_disjs(Disjuncts2),
- instmap_merge(NonLocals, InstMapList, merge_disj, !ModeInfo),
+ Disjuncts3 = flatten_disjs(Disjuncts2),
+ merge_disj_branches(NonLocals, LargeFlatConstructs,
+ Disjuncts3, Disjuncts, InstMaps, !ModeInfo),
disj_list_to_goal(Disjuncts, GoalInfo0, hlds_goal(GoalExpr, _GoalInfo))
),
mode_checkpoint(exit, "disj", !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 = [],
+ Cases = [],
+ instmap.init_unreachable(InstMap),
+ mode_info_set_instmap(InstMap, !ModeInfo)
+ ;
+ % 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, Cases1, InstMaps,
+ NonLocals, LargeFlatConstructs, !ModeInfo, !IO),
+ merge_switch_branches(NonLocals, LargeFlatConstructs,
+ Cases1, Cases, InstMaps, !ModeInfo)
+ ),
+ GoalExpr = switch(Var, CanFail, Cases),
+ mode_checkpoint(exit, "switch", !ModeInfo, !IO).
+
+:- pred merge_disj_branches(set(prog_var)::in, set(prog_var)::in,
+ list(hlds_goal)::in, list(hlds_goal)::out, list(instmap)::in,
+ mode_info::in, mode_info::out) is det.
+
+merge_disj_branches(NonLocals, LargeFlatConstructs, Disjuncts0, Disjuncts,
+ InstMaps0, !ModeInfo) :-
+ ( set.empty(LargeFlatConstructs) ->
+ Disjuncts = Disjuncts0,
+ InstMaps = InstMaps0
+ ;
+ % The instmaps will each map every var in LargeFlatConstructs
+ % to a very big inst. This means that instmap_merge will take a long
+ % time on those variables and add lots of big insts to the merge_inst
+ % table. That in turn will cause the later equiv_type_hlds pass
+ % to take a long time processing the merge_inst table. All this
+ % expensse is for nothing, since the chances that the following code
+ % wants to know the precise set of possible bindings of variables
+ % constructed in what are effectively fact tables is astronomically
+ % small.
+ %
+ % For the variables in LargeFlatConstructs, we know that their
+ % final insts do not cause unreachability, do not have uniqueness,
+ % do not have higher order inst info, and any information they contain
+ % about specific bindings is something we are better off without.
+ % We therefore just map all these variables to ground in the instmaps
+ % of all the arms before merging them.
+
+ list.map(
+ set_large_flat_constructs_to_ground_in_goal(LargeFlatConstructs),
+ Disjuncts0, Disjuncts),
+ LargeFlatConstructList = set.to_sorted_list(LargeFlatConstructs),
+ list.map(
+ instmap_set_vars_same(ground(shared, none),
+ LargeFlatConstructList),
+ InstMaps0, InstMaps)
+ ),
+ instmap_merge(NonLocals, InstMaps, merge_disj, !ModeInfo).
+
+:- pred merge_switch_branches(set(prog_var)::in, set(prog_var)::in,
+ list(case)::in, list(case)::out, list(instmap)::in,
+ mode_info::in, mode_info::out) is det.
+
+merge_switch_branches(NonLocals, LargeFlatConstructs, Cases0, Cases,
+ InstMaps0, !ModeInfo) :-
+ ( set.empty(LargeFlatConstructs) ->
+ Cases = Cases0,
+ InstMaps = InstMaps0
+ ;
+ % The same considerations apply here as in merge_disj_branches.
+ list.map(
+ set_large_flat_constructs_to_ground_in_case(LargeFlatConstructs),
+ Cases0, Cases),
+ LargeFlatConstructList = set.to_sorted_list(LargeFlatConstructs),
+ list.map(
+ instmap_set_vars_same(ground(shared, none),
+ LargeFlatConstructList),
+ InstMaps0, InstMaps)
+ ),
+ instmap_merge(NonLocals, InstMaps, merge_disj, !ModeInfo).
+
:- 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,
@@ -1431,7 +1512,7 @@
mode_info_get_instmap(!.ModeInfo, InstMapCond),
mode_info_remove_live_vars(ThenVars, !ModeInfo),
mode_info_unlock_vars(var_lock_if_then_else, NonLocals, !ModeInfo),
- ( instmap.is_reachable(InstMapCond) ->
+ ( instmap_is_reachable(InstMapCond) ->
modecheck_goal(Then0, Then1, !ModeInfo, !IO),
mode_info_get_instmap(!.ModeInfo, InstMapThen1)
;
@@ -1533,21 +1614,89 @@
mode_checkpoint(exit, "scope", !ModeInfo, !IO),
GoalExpr = scope(Reason, SubGoal)
;
- Reason = from_ground_term(TermVar),
+ Reason = from_ground_term(TermVar, _OldKind),
% The original goal does no quantification, so deleting the `scope'
% would be OK. However, deleting it during mode analysis would mean
% we don't have it during unique mode analysis.
- (
mode_info_get_instmap(!.ModeInfo, InstMap0),
- instmap.lookup_var(InstMap0, TermVar, InstOfVar),
- InstOfVar = free,
- SubGoal0 = hlds_goal(SubGoalExpr0, SubGoalInfo),
- SubGoalExpr0 = conj(plain_conj, [UnifyTermGoal | UnifyArgGoals]),
+ instmap_lookup_var(InstMap0, TermVar, TermVarInst),
+ mode_info_get_varset(!.ModeInfo, VarSet),
+ modecheck_specializable_ground_term(SubGoal0, TermVar, TermVarInst,
+ MaybeGroundTermMode),
+ (
+ MaybeGroundTermMode = yes(construct_ground_term(RevConj0)),
+ SubGoal0 = hlds_goal(_, SubGoalInfo0),
+ modecheck_ground_term_construct(TermVar, RevConj0,
+ SubGoalInfo0, VarSet, SubGoal, !ModeInfo),
+ Kind = from_ground_term_construct,
+ UpdatedReason = from_ground_term(TermVar, Kind),
+ GoalExpr = scope(UpdatedReason, SubGoal)
+ ;
+ (
+ MaybeGroundTermMode = yes(deconstruct_ground_term(_)),
+ % We should specialize the handling of these scopes as well as
+ % scopes that construct ground terms, but we don't yet have
+ % a compelling motivating example.
+ SubGoal1 = SubGoal0,
+ Kind = from_ground_term_deconstruct
+ ;
+ MaybeGroundTermMode = no,
+ (
+ TermVarInst = free,
+ SubGoal0 = hlds_goal(SubGoalExpr0, SubGoalInfo0),
+ SubGoalExpr0 = conj(plain_conj, SubGoalConjuncts0)
+ ->
+ % We reverse the list here for the same reason
+ % modecheck_specializable_ground_term does in the
+ % corresponding case.
+ list.reverse(SubGoalConjuncts0, SubGoalConjuncts1),
+ SubGoalExpr1 = conj(plain_conj, SubGoalConjuncts1),
+ SubGoal1 = hlds_goal(SubGoalExpr1, SubGoalInfo0)
+ ;
+ SubGoal1 = SubGoal0
+ ),
+ Kind = from_ground_term_other
+ ),
+ mode_checkpoint(enter, "scope", !ModeInfo, !IO),
+ modecheck_goal(SubGoal1, SubGoal, !ModeInfo, !IO),
+ mode_checkpoint(exit, "scope", !ModeInfo, !IO),
+ UpdatedReason = from_ground_term(TermVar, Kind),
+ GoalExpr = scope(UpdatedReason, SubGoal)
+ )
+ ;
+ Reason = promise_purity(_Implicit, _Purity),
+ mode_info_get_in_promise_purity_scope(!.ModeInfo, InPPScope),
+ mode_info_set_in_promise_purity_scope(in_promise_purity_scope,
+ !ModeInfo),
+ mode_checkpoint(enter, "scope", !ModeInfo, !IO),
+ modecheck_goal(SubGoal0, SubGoal, !ModeInfo, !IO),
+ mode_checkpoint(exit, "scope", !ModeInfo, !IO),
+ GoalExpr = scope(Reason, SubGoal),
+ mode_info_set_in_promise_purity_scope(InPPScope, !ModeInfo)
+ ).
+
+:- type ground_term_mode
+ ---> construct_ground_term(list(hlds_goal))
+ ; deconstruct_ground_term(list(hlds_goal)).
+
+:- pred modecheck_specializable_ground_term(hlds_goal::in, prog_var::in,
+ mer_inst::in, maybe(ground_term_mode)::out) is det.
+
+modecheck_specializable_ground_term(SubGoal, TermVar, TermVarInst,
+ MaybeGroundTermMode) :-
+ SubGoal = hlds_goal(SubGoalExpr, SubGoalInfo),
+ (
+ NonLocals = goal_info_get_nonlocals(SubGoalInfo),
+ set.singleton_set(NonLocals, TermVar),
+ goal_info_get_purity(SubGoalInfo) = purity_pure,
+ SubGoalExpr = conj(plain_conj, [UnifyTermGoal | UnifyArgGoals]),
% If TermVar is created by an impure unification, which is
% possible for solver types, it is possible for UnifyTermGoal
% to contain a unification other than one involving TermVar.
- UnifyTermGoal ^ hlds_goal_expr = unify(TermVar, _, _, _, _)
+ UnifyTermGoal ^ hlds_goal_expr = unify(TermVar, _, _, _, _),
+ all_plain_construct_unifies([UnifyTermGoal | UnifyArgGoals])
->
+ ( TermVarInst = free ->
% UnifyTerm unifies TermVar with the arguments created
% by UnifyArgs. Since TermVar is now free and the
% argument variables haven't been encountered yet,
@@ -1559,34 +1708,126 @@
% repeatedly: it is linear instead of quadratic.
list.reverse([UnifyTermGoal | UnifyArgGoals], RevConj),
- RevSubGoal0 = hlds_goal(conj(plain_conj, RevConj), SubGoalInfo),
- mode_info_get_in_from_ground_term(!.ModeInfo, WasInFromGroundTerm),
- mode_info_set_in_from_ground_term(in_from_ground_term, !ModeInfo),
- mode_checkpoint(enter, "ground scope", !ModeInfo, !IO),
- modecheck_goal(RevSubGoal0, SubGoal, !ModeInfo, !IO),
- mode_checkpoint(exit, "ground scope", !ModeInfo, !IO),
- mode_info_set_in_from_ground_term(WasInFromGroundTerm, !ModeInfo),
-
- GoalExpr = scope(Reason, SubGoal)
+ MaybeGroundTermMode = yes(construct_ground_term(RevConj))
+ ; TermVarInst = ground(shared, none) ->
+ Conj = [UnifyTermGoal | UnifyArgGoals],
+ MaybeGroundTermMode = yes(deconstruct_ground_term(Conj))
;
- mode_checkpoint(enter, "scope", !ModeInfo, !IO),
- modecheck_goal(SubGoal0, SubGoal, !ModeInfo, !IO),
- mode_checkpoint(exit, "scope", !ModeInfo, !IO),
-
- GoalExpr = scope(Reason, SubGoal)
+ MaybeGroundTermMode = no
)
;
- Reason = promise_purity(_Implicit, _Purity),
- mode_info_get_in_promise_purity_scope(!.ModeInfo, InPPScope),
- mode_info_set_in_promise_purity_scope(in_promise_purity_scope,
- !ModeInfo),
- mode_checkpoint(enter, "scope", !ModeInfo, !IO),
- modecheck_goal(SubGoal0, SubGoal, !ModeInfo, !IO),
- mode_checkpoint(exit, "scope", !ModeInfo, !IO),
- GoalExpr = scope(Reason, SubGoal),
- mode_info_set_in_promise_purity_scope(InPPScope, !ModeInfo)
+ MaybeGroundTermMode = no
).
+:- pred all_plain_construct_unifies(list(hlds_goal)::in) is semidet.
+
+all_plain_construct_unifies([]).
+all_plain_construct_unifies([Goal | Goals]) :-
+ Goal = hlds_goal(GoalExpr, _),
+ GoalExpr = unify(_LHSVar, RHS, _, _, _),
+ RHS = rhs_functor(_ConsId, no, _RHSVars),
+ all_plain_construct_unifies(Goals).
+
+:- pred modecheck_ground_term_construct(prog_var::in, list(hlds_goal)::in,
+ hlds_goal_info::in, prog_varset::in, hlds_goal::out,
+ mode_info::in, mode_info::out) is det.
+
+modecheck_ground_term_construct(TermVar, ConjGoals0, !.SubGoalInfo, VarSet,
+ SubGoal, !ModeInfo) :-
+ map.init(LocalVarMap0),
+ modecheck_ground_term_construct_goal_loop(VarSet, ConjGoals0, ConjGoals,
+ LocalVarMap0, LocalVarMap),
+ map.lookup(LocalVarMap, TermVar, TermVarInfo),
+ TermVarInfo = construct_var_info(TermVarInst, _),
+ instmap_delta_from_assoc_list([TermVar - TermVarInst], InstMapDelta),
+ goal_info_set_instmap_delta(InstMapDelta, !SubGoalInfo),
+ % We present the determinism, so that the determinism analysis pass
+ % does not have to traverse the goals inside the scope.
+ goal_info_set_determinism(detism_det, !SubGoalInfo),
+ SubGoalExpr = conj(plain_conj, ConjGoals),
+ SubGoal = hlds_goal(SubGoalExpr, !.SubGoalInfo),
+
+ mode_info_get_instmap(!.ModeInfo, InstMap0),
+ instmap_set_var(TermVar, TermVarInst, InstMap0, InstMap),
+ mode_info_set_instmap(InstMap, !ModeInfo).
+
+:- type construct_var_info
+ ---> construct_var_info(mer_inst, static_cons).
+
+:- type construct_var_info_map == map(prog_var, construct_var_info).
+
+:- pred modecheck_ground_term_construct_goal_loop(prog_varset::in,
+ list(hlds_goal)::in, list(hlds_goal)::out,
+ construct_var_info_map::in, construct_var_info_map::out) is det.
+
+modecheck_ground_term_construct_goal_loop(_, [], [], !LocalVarMap).
+modecheck_ground_term_construct_goal_loop(VarSet,
+ [Goal0 | Goals0], [Goal | Goals], !LocalVarMap) :-
+ Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
+ (
+ GoalExpr0 = unify(LHSVar, RHS, _, _, UnifyContext),
+ RHS = rhs_functor(ConsId, no, RHSVars)
+ ->
+ % We could set TermInst to simply to ground, as opposed to the inst
+ % we now use which gives information about LHSVar's shape. This would
+ % remove the need for the inst information in !LocalVarMap, and
+ % would make HLDS dumps linear in the size of the term instead of
+ % quadratic. However, due to structure sharing, the actual memory
+ % requirements of these bound insts are only linear in the size of the
+ % term.
+ modecheck_ground_term_construct_arg_loop(RHSVars, ArgInsts, UniModes,
+ StaticConss, !LocalVarMap),
+ BoundInst = bound_functor(ConsId, ArgInsts),
+ TermInst = bound(shared, [BoundInst]),
+ LHSMode = (free -> TermInst),
+ RHSMode = (TermInst -> TermInst),
+ UnifyMode = LHSMode - RHSMode,
+ ConstructHow = construct_statically(StaticConss),
+ Uniqueness = cell_is_shared,
+ Unification = construct(LHSVar, ConsId, RHSVars, UniModes,
+ ConstructHow, Uniqueness, no_construct_sub_info),
+ GoalExpr = unify(LHSVar, RHS, UnifyMode, Unification, UnifyContext),
+ instmap_delta_from_assoc_list([LHSVar - TermInst], InstMapDelta),
+ goal_info_set_instmap_delta(InstMapDelta, GoalInfo0, GoalInfo1),
+ % We preset the determinism, so that the determinism analysis pass
+ % does not have to traverse the goals inside the scope.
+ goal_info_set_determinism(detism_det, GoalInfo1, GoalInfo),
+ Goal = hlds_goal(GoalExpr, GoalInfo),
+
+ LHSVarStaticCons = static_cons(ConsId, RHSVars, StaticConss),
+ LHSVarInfo = construct_var_info(TermInst, LHSVarStaticCons),
+ svmap.det_insert(LHSVar, LHSVarInfo, !LocalVarMap)
+ ;
+ unexpected(this_file,
+ "modecheck_ground_term_construct_goal_loop: not rhs_functor unify")
+ ),
+ modecheck_ground_term_construct_goal_loop(VarSet, Goals0, Goals,
+ !LocalVarMap).
+
+:- pred modecheck_ground_term_construct_arg_loop(list(prog_var)::in,
+ list(mer_inst)::out, list(uni_mode)::out, list(static_cons)::out,
+ construct_var_info_map::in, construct_var_info_map::out) is det.
+
+modecheck_ground_term_construct_arg_loop([], [], [], [], !LocalVarMap).
+modecheck_ground_term_construct_arg_loop([Var | Vars], [VarInst | VarInsts],
+ [UniMode | UniModes], [StaticCons | StaticConss], !LocalVarMap) :-
+ % Each variable introduced by the superhomogeneous transformation
+ % for a ground term appears in the from_ground_term scope exactly twice.
+ % Once when it is produced (which is handled in the goal loop predicate),
+ % and once when it is consumed, which is handled here.
+ %
+ % Since there will be no more appearances of this variable, we remove it
+ % from LocalVarMap. This greatly reduces the size of LocalVarMap.
+ svmap.det_remove(Var, VarInfo, !LocalVarMap),
+ VarInfo = construct_var_info(VarInst, StaticCons),
+ LHSOldInst = free,
+ RHSOldInst = VarInst,
+ LHSNewInst = VarInst,
+ RHSNewInst = VarInst,
+ UniMode = ((LHSOldInst - RHSOldInst) -> (LHSNewInst - RHSNewInst)),
+ modecheck_ground_term_construct_arg_loop(Vars, VarInsts, UniModes,
+ StaticConss, !LocalVarMap).
+
:- 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,
@@ -1675,7 +1916,7 @@
),
Mode1 = in_mode,
Mode2 = out_mode,
- instmap.lookup_var(InstMap, Arg1, Inst1),
+ instmap_lookup_var(InstMap, Arg1, Inst1),
Inst1 = bound(Unique, [bound_functor(ConsId, [])]),
mode_info_get_module_info(!.ModeInfo, ModuleInfo),
module_info_get_type_table(ModuleInfo, TypeTable),
@@ -1716,29 +1957,6 @@
mode_info_unset_call_context(!ModeInfo),
mode_checkpoint(exit, "unify", !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 = [],
- Cases = [],
- instmap.init_unreachable(InstMap),
- mode_info_set_instmap(InstMap, !ModeInfo)
- ;
- % 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, 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,
@@ -1882,8 +2100,8 @@
check_no_inst_any_vars(NegCtxtDesc, [NonLocal | NonLocals], InstMap0, InstMap,
!ModeInfo) :-
(
- ( instmap.lookup_var(InstMap0, NonLocal, Inst)
- ; instmap.lookup_var(InstMap, NonLocal, Inst)
+ ( instmap_lookup_var(InstMap0, NonLocal, Inst)
+ ; instmap_lookup_var(InstMap, NonLocal, Inst)
),
mode_info_get_module_info(!.ModeInfo, ModuleInfo),
inst_contains_any(ModuleInfo, Inst)
@@ -1913,7 +2131,7 @@
(
% There's no point adding extra goals if the code is
% unreachable anyway.
- instmap.is_reachable(InstMap0),
+ instmap_is_reachable(InstMap0),
% If we recorded errors processing the goal, it will have to be
% reprocessed anyway, so don't add the extra goals now.
@@ -2025,14 +2243,14 @@
construct_initialisation_calls(ThenVarsToInit, ThenInitCalls, !ModeInfo),
InitedThenVars = list_to_set(ThenVarsToInit),
Then = append_init_calls_to_goal(InitedThenVars, ThenInitCalls, Then0),
- ThenInstMap = set_vars_to_inst_any(ThenVarsToInit, ThenInstMap0),
+ instmap_set_vars_same(any_inst, ThenVarsToInit, ThenInstMap0, ThenInstMap),
ElseVarsToInit = solver_vars_to_init(EnsureInitialised, ModuleInfo,
ElseInstMap0),
construct_initialisation_calls(ElseVarsToInit, ElseInitCalls, !ModeInfo),
InitedElseVars = list_to_set(ElseVarsToInit),
Else = append_init_calls_to_goal(InitedElseVars, ElseInitCalls, Else0),
- ElseInstMap = set_vars_to_inst_any(ElseVarsToInit, ElseInstMap0).
+ instmap_set_vars_same(any_inst, ElseVarsToInit, ElseInstMap0, ElseInstMap).
:- func solver_vars_that_must_be_initialised(list(prog_var),
vartypes, module_info, list(instmap)) = list(prog_var).
@@ -2049,7 +2267,7 @@
map.lookup(VarTypes, Var, VarType),
type_is_solver_type_with_auto_init(ModuleInfo, VarType),
list.member(InstMap, InstMaps),
- instmap.lookup_var(InstMap, Var, Inst),
+ instmap_lookup_var(InstMap, Var, Inst),
not inst_match.inst_is_free(ModuleInfo, Inst).
:- pred is_solver_var(vartypes::in, module_info::in, prog_var::in) is semidet.
@@ -2075,7 +2293,7 @@
construct_initialisation_calls(VarsToInit, InitCalls, !ModeInfo),
InitedVars = list_to_set(VarsToInit),
Goal = append_init_calls_to_goal(InitedVars, InitCalls, Goal0),
- InstMap = set_vars_to_inst_any(VarsToInit, InstMap0),
+ instmap_set_vars_same(any_inst, VarsToInit, InstMap0, InstMap),
add_necessary_disj_init_calls(Goals0, Goals, InstMaps0, InstMaps,
EnsureInitialised, !ModeInfo).
@@ -2119,16 +2337,9 @@
is semidet.
solver_var_to_init(ModuleInfo, InstMap, Var) :-
- instmap.lookup_var(InstMap, Var, Inst),
+ instmap_lookup_var(InstMap, Var, Inst),
inst_match.inst_is_free(ModuleInfo, Inst).
-:- func set_vars_to_inst_any(list(prog_var), instmap) = instmap.
-
-set_vars_to_inst_any([], InstMap) = InstMap.
-set_vars_to_inst_any([Var | Vars], InstMap0) = InstMap :-
- instmap.set(Var, any_inst, InstMap0, InstMap1),
- InstMap = set_vars_to_inst_any(Vars, InstMap1).
-
%-----------------------------------------------------------------------------%
% Modecheck a conjunction without doing any reordering.
@@ -2144,7 +2355,7 @@
mode_info_remove_live_vars(NonLocals, !ModeInfo),
modecheck_goal(Goal0, Goal, !ModeInfo, !IO),
mode_info_get_instmap(!.ModeInfo, InstMap),
- ( instmap.is_unreachable(InstMap) ->
+ ( instmap_is_unreachable(InstMap) ->
% We should not mode-analyse the remaining goals, since they
% are unreachable. Instead we optimize them away, so that
% later passes won't complain about them not having mode information.
@@ -2366,7 +2577,7 @@
),
mode_info_set_delay_info(DelayInfo, !ModeInfo),
mode_info_get_instmap(!.ModeInfo, InstMap),
- ( instmap.is_unreachable(InstMap) ->
+ ( instmap_is_unreachable(InstMap) ->
% We should not mode-analyse the remaining goals, since they are
% unreachable. Instead we optimize them away, so that later passes
% won't complain about them not having mode information.
@@ -2399,7 +2610,7 @@
% from inst free to inst any. This predicate attempts to schedule
% such goals.
%
- % XXX despite its name this predicate will in fact try to reschedule all
+ % XXX Despite its name this predicate will in fact try to reschedule all
% delayed goals, not just delayed solver goals.
%
:- pred modecheck_delayed_solver_goals(conj_type::in, list(hlds_goal)::out,
@@ -2473,7 +2684,7 @@
% Work out which vars are already instantiated
% (i.e. have non-free insts).
mode_info_get_instmap(!.ModeInfo, InstMap),
- instmap.to_assoc_list(InstMap, VarInsts),
+ instmap_to_assoc_list(InstMap, VarInsts),
NonFreeVars0 = set.list_to_set(
non_free_vars_in_assoc_list(VarInsts)),
@@ -2665,6 +2876,8 @@
!:NonFree = set.union(NonFreeThen, NonFreeElse).
candidate_init_vars_3(ModeInfo, Goal0, !NonFree, !CandidateVars) :-
+ % XXX We should special-case the handling of from_ground_term_construct
+ % scopes.
Goal0 = hlds_goal(scope(_, Goal), _),
candidate_init_vars_3(ModeInfo, Goal, !NonFree, !CandidateVars).
@@ -2679,7 +2892,6 @@
% We assume that generic calls are deterministic. The modes field of
% higher_order calls is junk until *after* mode analysis, hence we can't
% handle them here.
- %
Goal = hlds_goal(GoalExpr, _),
GoalExpr = generic_call(Details, Args, ArgModes, _JunkDetism),
Details \= higher_order(_, _, _, _),
@@ -2725,7 +2937,6 @@
set(prog_var)::in, set(prog_var)::out) is semidet.
candidate_init_vars_call(_ModeInfo, [], [], !NonFree, !CandidateVars).
-
candidate_init_vars_call(ModeInfo, [Arg | Args], [Mode | Modes],
!NonFree, !CandidateVars) :-
mode_info_get_module_info(ModeInfo, ModuleInfo),
@@ -2742,14 +2953,12 @@
FinalInst \= free(_)
->
% And it is.
- (
- not set.contains(!.NonFree, Arg)
- ->
+ ( set.contains(!.NonFree, Arg) ->
+ % This arg appears in an implied mode.
+ fail
+ ;
% This arg is instantiated on output.
!:NonFree = set.insert(!.NonFree, Arg)
- ;
- % This arg appears in an implied mode.
- false
)
;
% This arg is unused.
@@ -2801,9 +3010,7 @@
mode_info_set_delay_info(DelayInfo3, !ModeInfo),
% See if we scheduled any goals.
- (
- length(DelayedGoals1) < length(DelayedGoals0)
- ->
+ ( length(DelayedGoals1) < length(DelayedGoals0) ->
% We scheduled some goals. Keep going until we either
% flounder or succeed.
modecheck_delayed_goals_eager(ConjType,
@@ -2915,35 +3122,37 @@
%-----------------------------------------------------------------------------%
:- pred modecheck_disj_list(list(hlds_goal)::in, list(hlds_goal)::out,
- list(instmap)::out, mode_info::in, mode_info::out,
- io::di, io::uo) is det.
+ list(instmap)::out, set(prog_var)::in, set(prog_var)::out,
+ mode_info::in, mode_info::out, io::di, io::uo) is det.
-modecheck_disj_list([], [], [], !ModeInfo, !IO).
+modecheck_disj_list([], [], [], !LargeFlatConstructs, !ModeInfo, !IO).
modecheck_disj_list([Goal0 | Goals0], [Goal | Goals], [InstMap | InstMaps],
- !ModeInfo, !IO) :-
+ !LargeFlatConstructs, !ModeInfo, !IO) :-
mode_info_get_instmap(!.ModeInfo, InstMap0),
modecheck_goal(Goal0, Goal, !ModeInfo, !IO),
+ accumulate_large_flat_constructs(Goal, !LargeFlatConstructs),
mode_info_get_instmap(!.ModeInfo, InstMap),
mode_info_set_instmap(InstMap0, !ModeInfo),
- modecheck_disj_list(Goals0, Goals, InstMaps, !ModeInfo, !IO).
+ modecheck_disj_list(Goals0, Goals, InstMaps, !LargeFlatConstructs,
+ !ModeInfo, !IO).
:- pred modecheck_case_list(list(case)::in, prog_var::in, list(case)::out,
- list(instmap)::out, mode_info::in, mode_info::out,
- io::di, io::uo) is det.
+ list(instmap)::out, set(prog_var)::in, set(prog_var)::out,
+ mode_info::in, mode_info::out, io::di, io::uo) is det.
-modecheck_case_list([], _Var, [], [], !ModeInfo, !IO).
+modecheck_case_list([], _Var, [], [], !LargeFlatConstructs, !ModeInfo, !IO).
modecheck_case_list([Case0 | Cases0], Var, [Case | Cases],
- [InstMap | InstMaps], !ModeInfo, !IO) :-
+ [InstMap | InstMaps], !LargeFlatConstructs, !ModeInfo, !IO) :-
Case0 = case(MainConsId, OtherConsIds, Goal0),
mode_info_get_instmap(!.ModeInfo, InstMap0),
- % Record the fact that Var was bound to ConsId in the
- % instmap before processing this case.
+ % Record the fact that Var was bound to ConsId in the instmap
+ % before processing this case.
modecheck_functors_test(Var, MainConsId, OtherConsIds, !ModeInfo),
% Modecheck this case (if it is reachable).
mode_info_get_instmap(!.ModeInfo, InstMap1),
- ( instmap.is_reachable(InstMap1) ->
+ ( instmap_is_reachable(InstMap1) ->
modecheck_goal(Goal0, Goal1, !ModeInfo, !IO),
mode_info_get_instmap(!.ModeInfo, InstMap)
;
@@ -2956,10 +3165,25 @@
% Don't lose the information added by the functor test above.
fixup_switch_var(Var, InstMap0, InstMap, Goal1, Goal),
- Case = case(MainConsId, OtherConsIds, Goal),
+ Case = case(MainConsId, OtherConsIds, Goal),
+ accumulate_large_flat_constructs(Goal, !LargeFlatConstructs),
mode_info_set_instmap(InstMap0, !ModeInfo),
- modecheck_case_list(Cases0, Var, Cases, InstMaps, !ModeInfo, !IO).
+ modecheck_case_list(Cases0, Var, Cases, InstMaps, !LargeFlatConstructs,
+ !ModeInfo, !IO).
+
+:- pred accumulate_large_flat_constructs(hlds_goal::in,
+ set(prog_var)::in, set(prog_var)::out) is det.
+
+accumulate_large_flat_constructs(Goal, !LargeFlatConstructs) :-
+ ( set.empty(!.LargeFlatConstructs) ->
+ % Calling goal_large_flat_constructs and then set.intersect
+ % would be waste of time; !:LargeFlatConstructs will still be empty.
+ true
+ ;
+ GoalLargeFlatConstructs = goal_large_flat_constructs(Goal),
+ set.intersect(GoalLargeFlatConstructs, !LargeFlatConstructs)
+ ).
modecheck_functor_test(Var, ConsId, !ModeInfo) :-
% Figure out the arity of this constructor, _including_ any type-infos
@@ -3011,6 +3235,157 @@
%-----------------------------------------------------------------------------%
+:- func goal_large_flat_constructs(hlds_goal) = set(prog_var).
+
+goal_large_flat_constructs(Goal) = LargeFlatConstructs :-
+ Goal = hlds_goal(GoalExpr, _),
+ (
+ GoalExpr = unify(_, _, _, _, _),
+ % Unifications not wrapped in from_ground_term_construct scopes
+ % are never marked by the modechecker as being constructed statically.
+ LargeFlatConstructs = set.init
+ ;
+ ( GoalExpr = plain_call(_, _, _, _, _, _)
+ ; GoalExpr = generic_call(_, _, _, _)
+ ; GoalExpr = call_foreign_proc(_, _, _, _, _, _, _)
+ ),
+ LargeFlatConstructs = set.init
+ ;
+ ( GoalExpr = disj(_)
+ ; GoalExpr = switch(_, _, _)
+ ; GoalExpr = if_then_else(_, _, _, _)
+ ; GoalExpr = negation(_)
+ ; GoalExpr = shorthand(_)
+ ; GoalExpr = conj(parallel_conj, _)
+ ),
+ LargeFlatConstructs = set.init
+ ;
+ GoalExpr = scope(Reason, _),
+ (
+ Reason = from_ground_term(TermVar, from_ground_term_construct),
+ LargeFlatConstructs = set.make_singleton_set(TermVar)
+ ;
+ ( Reason = from_ground_term(_, from_ground_term_deconstruct)
+ ; Reason = from_ground_term(_, from_ground_term_other)
+ ; Reason = exist_quant(_)
+ ; Reason = promise_solutions(_, _)
+ ; Reason = promise_purity(_, _)
+ ; Reason = commit(_)
+ ; Reason = barrier(_)
+ ; Reason = trace_goal(_, _, _, _, _)
+ ),
+ LargeFlatConstructs = set.init
+ )
+ ;
+ GoalExpr = conj(plain_conj, Conjuncts),
+ goals_large_flat_constructs(Conjuncts, set.init, LargeFlatConstructs)
+ ).
+
+:- pred goals_large_flat_constructs(list(hlds_goal)::in,
+ set(prog_var)::in, set(prog_var)::out) is det.
+
+goals_large_flat_constructs([], !LargeFlatConstructs).
+goals_large_flat_constructs([Goal | Goals], !LargeFlatConstructs) :-
+ GoalLargeFlatConstructs = goal_large_flat_constructs(Goal),
+ set.union(GoalLargeFlatConstructs, !LargeFlatConstructs),
+ goals_large_flat_constructs(Goals, !LargeFlatConstructs).
+
+:- pred set_large_flat_constructs_to_ground_in_goal(set(prog_var)::in,
+ hlds_goal::in, hlds_goal::out) is det.
+
+set_large_flat_constructs_to_ground_in_goal(LargeFlatConstructs,
+ Goal0, Goal) :-
+ Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
+ (
+ GoalExpr0 = unify(_, _, _, _, _),
+ Goal = Goal0
+ ;
+ ( GoalExpr0 = plain_call(_, _, _, _, _, _)
+ ; GoalExpr0 = generic_call(_, _, _, _)
+ ; GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _)
+ ),
+ Goal = Goal0
+ ;
+ ( GoalExpr0 = disj(_)
+ ; GoalExpr0 = switch(_, _, _)
+ ; GoalExpr0 = if_then_else(_, _, _, _)
+ ; GoalExpr0 = negation(_)
+ ; GoalExpr0 = shorthand(_)
+ ; GoalExpr0 = conj(parallel_conj, _)
+ ),
+ Goal = Goal0
+ ;
+ GoalExpr0 = scope(Reason, SubGoal0),
+ (
+ Reason = from_ground_term(TermVar, from_ground_term_construct),
+ ( set.member(TermVar, LargeFlatConstructs) ->
+ InstMapDelta0 = goal_info_get_instmap_delta(GoalInfo0),
+ instmap_delta_set_var(TermVar, ground(shared, none),
+ InstMapDelta0, InstMapDelta),
+ goal_info_set_instmap_delta(InstMapDelta, GoalInfo0, GoalInfo),
+
+ SubGoal0 = hlds_goal(SubGoalExpr0, SubGoalInfo0),
+ goal_info_set_instmap_delta(InstMapDelta,
+ SubGoalInfo0, SubGoalInfo),
+ % We could also replace the instmap deltas of the conjuncts
+ % inside SubGoalExpr0. Doing so would take time but reduce
+ % the compiler's memory requirements.
+ SubGoal = hlds_goal(SubGoalExpr0, SubGoalInfo),
+ GoalExpr = scope(Reason, SubGoal),
+ Goal = hlds_goal(GoalExpr, GoalInfo)
+ ;
+ Goal = Goal0
+ )
+ ;
+ ( Reason = from_ground_term(_, from_ground_term_deconstruct)
+ ; Reason = from_ground_term(_, from_ground_term_other)
+ ; Reason = exist_quant(_)
+ ; Reason = promise_solutions(_, _)
+ ; Reason = promise_purity(_, _)
+ ; Reason = commit(_)
+ ; Reason = barrier(_)
+ ; Reason = trace_goal(_, _, _, _, _)
+ ),
+ Goal = Goal0
+ )
+ ;
+ GoalExpr0 = conj(plain_conj, Conjuncts0),
+ set_large_flat_constructs_to_ground_in_goals(LargeFlatConstructs,
+ Conjuncts0, Conjuncts),
+ GoalExpr = conj(plain_conj, Conjuncts),
+
+ InstMapDelta0 = goal_info_get_instmap_delta(GoalInfo0),
+ instmap_delta_changed_vars(InstMapDelta0, ChangedVars),
+ set.intersect(ChangedVars, LargeFlatConstructs, GroundVars),
+ instmap_delta_set_vars_same(ground(shared, none),
+ set.to_sorted_list(GroundVars), InstMapDelta0, InstMapDelta),
+ goal_info_set_instmap_delta(InstMapDelta, GoalInfo0, GoalInfo),
+ Goal = hlds_goal(GoalExpr, GoalInfo)
+ ).
+
+:- pred set_large_flat_constructs_to_ground_in_goals(set(prog_var)::in,
+ list(hlds_goal)::in, list(hlds_goal)::out) is det.
+
+set_large_flat_constructs_to_ground_in_goals(_, [], []).
+set_large_flat_constructs_to_ground_in_goals(LargeFlatConstructs,
+ [Goal0 | Goals0], [Goal | Goals]) :-
+ set_large_flat_constructs_to_ground_in_goal(LargeFlatConstructs,
+ Goal0, Goal),
+ set_large_flat_constructs_to_ground_in_goals(LargeFlatConstructs,
+ Goals0, Goals).
+
+:- pred set_large_flat_constructs_to_ground_in_case(set(prog_var)::in,
+ case::in, case::out) is det.
+
+set_large_flat_constructs_to_ground_in_case(LargeFlatConstructs,
+ Case0, Case) :-
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
+ set_large_flat_constructs_to_ground_in_goal(LargeFlatConstructs,
+ Goal0, Goal),
+ Case = case(MainConsId, OtherConsIds, Goal).
+
+%-----------------------------------------------------------------------------%
+
% Calculate the argument number offset that needs to be passed to
% modecheck_var_list_is_live, modecheck_var_has_inst_list, and
% modecheck_set_var_inst_list. This offset number is calculated
@@ -3155,7 +3530,7 @@
modecheck_var_has_inst_exact_match(VarId, Inst, !Subst, !ModeInfo) :-
mode_info_get_instmap(!.ModeInfo, InstMap),
- instmap.lookup_var(InstMap, VarId, VarInst),
+ instmap_lookup_var(InstMap, VarId, VarInst),
mode_info_get_var_types(!.ModeInfo, VarTypes),
map.lookup(VarTypes, VarId, Type),
mode_info_get_module_info(!.ModeInfo, ModuleInfo0),
@@ -3176,7 +3551,7 @@
modecheck_var_has_inst_no_exact_match(VarId, Inst, !Subst, !ModeInfo) :-
mode_info_get_instmap(!.ModeInfo, InstMap),
- instmap.lookup_var(InstMap, VarId, VarInst),
+ instmap_lookup_var(InstMap, VarId, VarInst),
mode_info_get_var_types(!.ModeInfo, VarTypes),
map.lookup(VarTypes, VarId, Type),
mode_info_get_module_info(!.ModeInfo, ModuleInfo0),
@@ -3228,10 +3603,10 @@
modecheck_set_var_inst_call(Var0, InitialInst, FinalInst, Var, !ExtraGoals,
!ModeInfo) :-
mode_info_get_instmap(!.ModeInfo, InstMap0),
- ( instmap.is_reachable(InstMap0) ->
+ ( instmap_is_reachable(InstMap0) ->
% The new inst must be computed by unifying the
% old inst and the proc's final inst.
- instmap.lookup_var(InstMap0, Var0, VarInst0),
+ instmap_lookup_var(InstMap0, Var0, VarInst0),
handle_implied_mode(Var0, VarInst0, InitialInst, Var, !ExtraGoals,
!ModeInfo),
modecheck_set_var_inst(Var0, FinalInst, no, !ModeInfo),
@@ -3252,10 +3627,10 @@
modecheck_set_var_inst(Var0, FinalInst, MaybeUInst, !ModeInfo) :-
mode_info_get_parallel_vars(!.ModeInfo, PVars0),
mode_info_get_instmap(!.ModeInfo, InstMap0),
- ( instmap.is_reachable(InstMap0) ->
+ ( instmap_is_reachable(InstMap0) ->
% The new inst must be computed by unifying the
% old inst and the proc's final inst.
- instmap.lookup_var(InstMap0, Var0, Inst0),
+ instmap_lookup_var(InstMap0, Var0, Inst0),
mode_info_get_module_info(!.ModeInfo, ModuleInfo0),
(
abstractly_unify_inst(is_dead, Inst0, FinalInst,
@@ -3282,7 +3657,7 @@
% the only thing we can have done is lose uniqueness.
inst_matches_initial(Inst0, Inst, Type, ModuleInfo)
->
- instmap.set(Var0, Inst, InstMap0, InstMap),
+ instmap_set_var(Var0, Inst, InstMap0, InstMap),
mode_info_set_instmap(InstMap, !ModeInfo)
;
% We must have either added some information,
@@ -3312,7 +3687,7 @@
mode_info_error(WaitingVars,
mode_error_bind_var(Reason0, Var0, Inst0, Inst), !ModeInfo)
;
- instmap.set(Var0, Inst, InstMap0, InstMap),
+ instmap_set_var(Var0, Inst, InstMap0, InstMap),
mode_info_set_instmap(InstMap, !ModeInfo),
mode_info_get_delay_info(!.ModeInfo, DelayInfo0),
delay_info_bind_var(Var0, DelayInfo0, DelayInfo),
Index: compiler/options.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.640
diff -u -b -r1.640 options.m
--- compiler/options.m 28 Nov 2008 06:36:59 -0000 1.640
+++ compiler/options.m 11 Dec 2008 15:53:48 -0000
@@ -571,6 +571,7 @@
; inline_simple_threshold
; inline_vars_threshold
; intermod_inline_simple_threshold
+ ; from_ground_term_threshold
; common_struct
; common_struct_preds
; common_goal
@@ -1416,6 +1417,7 @@
intermod_inline_simple_threshold - int(5),
% Has no effect until
% --intermodule-optimization.
+ from_ground_term_threshold - int(5),
common_struct - bool(no),
common_struct_preds - string(""),
common_goal - bool(yes),
@@ -2203,6 +2205,8 @@
long_option("inline-simple-threshold", inline_simple_threshold).
long_option("intermod-inline-simple-threshold",
intermod_inline_simple_threshold).
+long_option("from-ground-term-threshold",
+ from_ground_term_threshold).
long_option("inline-vars-threshold", inline_vars_threshold).
long_option("common-struct", common_struct).
long_option("common-struct-preds", common_struct_preds).
@@ -4580,6 +4584,10 @@
"\tcontaining more than <threshold> variables. Procedures",
"\tcontaining large numbers of variables can cause",
"\tslow compilation.",
+% "--from-ground-term-threshold <n>",
+% "\tWrap a from_ground_term scope around the expanded,",
+% "\tsuperhomogeneous form of a ground term that involves at least.",
+% "\tthe given number of function symbols.",
"--no-common-struct",
"\tDisable optimization of common term structures.",
% "--common-struct-preds <predids>",
Index: compiler/ordering_mode_constraints.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ordering_mode_constraints.m,v
retrieving revision 1.19
diff -u -b -r1.19 ordering_mode_constraints.m
--- compiler/ordering_mode_constraints.m 4 Sep 2008 11:41:01 -0000 1.19
+++ compiler/ordering_mode_constraints.m 11 Dec 2008 15:53:48 -0000
@@ -346,8 +346,17 @@
:- pred goal_expr_reordering(pred_id::in, mc_var_map::in, mc_bindings::in,
hlds_goal_expr::in, hlds_goal_expr::out) is semidet.
-goal_expr_reordering(PredId, VarMap, Bindings, conj(ConjType, Goals0),
- conj(ConjType, Goals)) :-
+goal_expr_reordering(PredId, VarMap, Bindings, GoalExpr0, GoalExpr) :-
+ (
+ ( GoalExpr0 = plain_call(_, _, _, _, _, _)
+ ; GoalExpr0 = generic_call(_, _, _, _)
+ ; GoalExpr0 = unify(_, _, _, _, _)
+ ; GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _)
+ ),
+ % Atomic goals cannot be reordered.
+ GoalExpr = GoalExpr0
+ ;
+ GoalExpr0 = conj(ConjType, Goals0),
(
ConjType = plain_conj,
% Build constraints for this conjunction.
@@ -364,45 +373,37 @@
;
ConjType = parallel_conj,
list.map(goal_reordering(PredId, VarMap, Bindings), Goals0, Goals)
- ).
-
- % goal_expr_reordering for atomic goals, and ones that shouldn't
- % exist yet.
- %
-goal_expr_reordering(_PredId, _VarMap, _Bindings, GoalExpr, GoalExpr) :-
- (
- GoalExpr = plain_call(_, _, _, _, _, _)
- ;
- GoalExpr = generic_call(_, _, _, _)
- ;
- GoalExpr = unify(_, _, _, _, _)
+ ),
+ GoalExpr = conj(ConjType, Goals)
;
- GoalExpr = call_foreign_proc(_, _, _, _, _, _, _)
+ GoalExpr0 = disj(Goals0),
+ list.map(goal_reordering(PredId, VarMap, Bindings), Goals0, Goals),
+ GoalExpr = disj(Goals)
;
- GoalExpr = shorthand(_),
- unexpected(this_file, "shorthand goal")
+ GoalExpr0 = switch(_, _, _),
+ % We haven't yet even tried to turn disjunctions into switches.
+ unexpected(this_file, "goal_expr_reordering: switch")
;
- GoalExpr = switch(_, _, _),
- unexpected(this_file, "switch")
- ).
-
-goal_expr_reordering(PredId, VarMap, Bindings, disj(Goals0), disj(Goals)) :-
- list.map(goal_reordering(PredId, VarMap, Bindings), Goals0, Goals).
-
-goal_expr_reordering(PredId, VarMap, Bindings,
- negation(Goal0), negation(Goal)) :-
- goal_reordering(PredId, VarMap, Bindings, Goal0, Goal).
-
-goal_expr_reordering(PredId, VarMap, Bindings, scope(Reason, Goal0),
- scope(Reason, Goal)) :-
- goal_reordering(PredId, VarMap, Bindings, Goal0, Goal).
-
-goal_expr_reordering(PredId, VarMap, Bindings,
- if_then_else(Vars, Cond0, Then0, Else0),
- if_then_else(Vars, Cond, Then, Else)) :-
+ GoalExpr0 = if_then_else(Vars, Cond0, Then0, Else0),
goal_reordering(PredId, VarMap, Bindings, Cond0, Cond),
goal_reordering(PredId, VarMap, Bindings, Then0, Then),
- goal_reordering(PredId, VarMap, Bindings, Else0, Else).
+ goal_reordering(PredId, VarMap, Bindings, Else0, Else),
+ GoalExpr = if_then_else(Vars, Cond, Then, Else)
+ ;
+ GoalExpr0 = negation(SubGoal0),
+ goal_reordering(PredId, VarMap, Bindings, SubGoal0, SubGoal),
+ GoalExpr = negation(SubGoal)
+ ;
+ GoalExpr0 = scope(Reason, SubGoal0),
+ % Is it possible to special-case the handling of
+ % from_ground_term_construct scopes?
+ goal_reordering(PredId, VarMap, Bindings, SubGoal0, SubGoal),
+ GoalExpr = scope(Reason, SubGoal)
+ ;
+ GoalExpr0 = shorthand(_),
+ % XXX We need to handle atomic goals.
+ unexpected(this_file, "goal_expr_reordering: NYI: shorthand")
+ ).
%-----------------------------------------------------------------------------%
Index: compiler/par_conj_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/par_conj_gen.m,v
retrieving revision 1.37
diff -u -b -r1.37 par_conj_gen.m
--- compiler/par_conj_gen.m 11 Oct 2007 11:45:20 -0000 1.37
+++ compiler/par_conj_gen.m 11 Dec 2008 15:53:48 -0000
@@ -381,8 +381,8 @@
find_outputs([], _Initial, _Final, _ModuleInfo, !Outputs).
find_outputs([Var | Vars], Initial, Final, ModuleInfo, !Outputs) :-
- instmap.lookup_var(Initial, Var, InitialInst),
- instmap.lookup_var(Final, Var, FinalInst),
+ instmap_lookup_var(Initial, Var, InitialInst),
+ instmap_lookup_var(Final, Var, FinalInst),
( mode_is_output(ModuleInfo, (InitialInst -> FinalInst)) ->
!:Outputs = [Var | !.Outputs]
;
Index: compiler/parallel_to_plain_conj.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/parallel_to_plain_conj.m,v
retrieving revision 1.1
diff -u -b -r1.1 parallel_to_plain_conj.m
--- compiler/parallel_to_plain_conj.m 15 Oct 2008 04:06:04 -0000 1.1
+++ compiler/parallel_to_plain_conj.m 11 Dec 2008 15:53:48 -0000
@@ -79,7 +79,12 @@
GoalExpr = negation(SubGoal)
;
GoalExpr0 = scope(Reason, SubGoal0),
- parallel_to_plain_conjs_goal(SubGoal0, SubGoal),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ % There cannot be parallel conjunctions inside these scopes.
+ SubGoal = SubGoal0
+ ;
+ parallel_to_plain_conjs_goal(SubGoal0, SubGoal)
+ ),
GoalExpr = scope(Reason, SubGoal)
;
( GoalExpr0 = unify(_, _, _, _, _)
Index: compiler/pd_cost.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/pd_cost.m,v
retrieving revision 1.36
diff -u -b -r1.36 pd_cost.m
--- compiler/pd_cost.m 30 Dec 2007 08:23:53 -0000 1.36
+++ compiler/pd_cost.m 11 Dec 2008 15:53:48 -0000
@@ -59,23 +59,25 @@
:- pred goal_expr_cost(hlds_goal_expr::in, hlds_goal_info::in, int::out)
is det.
-goal_expr_cost(conj(_, Goals), _, Cost) :-
- goal_costs(Goals, 0, Cost).
-
-goal_expr_cost(disj(Goals), _, Cost) :-
+goal_expr_cost(GoalExpr, GoalInfo, Cost) :-
+ (
+ GoalExpr = conj(_, Goals),
+ goal_costs(Goals, 0, Cost)
+ ;
+ GoalExpr = disj(Goals),
goal_costs(Goals, 0, Cost0),
- Cost = Cost0 + cost_of_stack_flush.
-
-goal_expr_cost(switch(_, _, Cases), _, Cost) :-
- cases_cost(Cases, cost_of_simple_test, Cost).
-
-goal_expr_cost(if_then_else(_, Cond, Then, Else), _, Cost) :-
+ Cost = Cost0 + cost_of_stack_flush
+ ;
+ GoalExpr = switch(_, _, Cases),
+ cases_cost(Cases, cost_of_simple_test, Cost)
+ ;
+ GoalExpr = if_then_else(_, Cond, Then, Else),
goal_cost(Cond, Cost1),
goal_cost(Then, Cost2),
goal_cost(Else, Cost3),
- Cost = Cost1 + Cost2 + Cost3.
-
-goal_expr_cost(plain_call(_, _, Args, BuiltinState, _, _), _, Cost) :-
+ Cost = Cost1 + Cost2 + Cost3
+ ;
+ GoalExpr = plain_call(_, _, Args, BuiltinState, _, _),
(
BuiltinState = inline_builtin,
Cost = cost_of_builtin_call
@@ -87,24 +89,28 @@
InputArgs = Arity // 2, % rough
Cost = cost_of_stack_flush + cost_of_call
+ cost_of_reg_assign * InputArgs
- ).
-
-goal_expr_cost(negation(Goal), _, Cost) :-
- goal_cost(Goal, Cost).
-
-goal_expr_cost(scope(_, Goal), _, Cost) :-
- goal_cost(Goal, Cost).
-
-goal_expr_cost(generic_call(_, Args, _, _), _, Cost) :-
+ )
+ ;
+ GoalExpr = negation(Goal),
+ goal_cost(Goal, Cost)
+ ;
+ GoalExpr = scope(Reason, Goal),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ Cost = cost_of_reg_assign
+ ;
+ goal_cost(Goal, Cost)
+ )
+ ;
+ GoalExpr = generic_call(_, Args, _, _),
list.length(Args, Arity),
Cost0 = cost_of_reg_assign * Arity // 2,
- Cost = Cost0 + cost_of_stack_flush + cost_of_higher_order_call.
-
-goal_expr_cost(unify(_, _, _, Unification, _), GoalInfo, Cost) :-
+ Cost = Cost0 + cost_of_stack_flush + cost_of_higher_order_call
+ ;
+ GoalExpr = unify(_, _, _, Unification, _),
NonLocals = goal_info_get_nonlocals(GoalInfo),
- unify_cost(NonLocals, Unification, Cost).
-
-goal_expr_cost(call_foreign_proc(Attributes, _, _, Args, _, _, _), _, Cost) :-
+ unify_cost(NonLocals, Unification, Cost)
+ ;
+ GoalExpr = call_foreign_proc(Attributes, _, _, Args, _, _, _),
( get_may_call_mercury(Attributes) = proc_will_not_call_mercury ->
Cost1 = 0
;
@@ -113,25 +119,35 @@
% XXX This is *too* rough.
list.length(Args, Arity),
InputArgs = Arity // 2, % rough
- Cost = Cost1 + cost_of_call + cost_of_reg_assign * InputArgs.
-
-goal_expr_cost(shorthand(_), _, _) :-
+ Cost = Cost1 + cost_of_call + cost_of_reg_assign * InputArgs
+ ;
+ GoalExpr = shorthand(_),
% these should have been expanded out by now
- unexpected(this_file, "goal_cost: unexpected shorthand").
+ unexpected(this_file, "goal_cost: unexpected shorthand")
+ ).
:- pred unify_cost(set(prog_var)::in, unification::in, int::out) is det.
-unify_cost(_, assign(_, _), 0).
-unify_cost(_, complicated_unify(_, _, _), cost_of_stack_flush).
-unify_cost(_, simple_test(_, _), cost_of_simple_test).
-unify_cost(NonLocals, construct(Var, _, Args, _, _, _, _), Cost) :-
+unify_cost(NonLocals, Unification, Cost) :-
+ (
+ Unification = assign(_, _),
+ Cost = 0
+ ;
+ Unification = complicated_unify(_, _, _),
+ Cost = cost_of_stack_flush
+ ;
+ Unification = simple_test(_, _),
+ Cost = cost_of_simple_test
+ ;
+ Unification = construct(Var, _, Args, _, _, _, _),
( set.member(Var, NonLocals) ->
list.length(Args, Arity),
Cost = cost_of_heap_incr + Arity * cost_of_heap_assign
;
Cost = 0
- ).
-unify_cost(NonLocals, deconstruct(_, _, Args, _, CanFail, _), Cost) :-
+ )
+ ;
+ Unification = deconstruct(_, _, Args, _, CanFail, _),
(
CanFail = can_fail,
Cost0 = cost_of_simple_test
@@ -139,11 +155,10 @@
CanFail = cannot_fail,
Cost0 = 0
),
- list.filter((pred(X::in) is semidet :-
- set.member(X, NonLocals)
- ), Args, NonLocalArgs),
+ list.filter(set.contains(NonLocals), Args, NonLocalArgs),
list.length(NonLocalArgs, NumAssigns),
- Cost = Cost0 + cost_of_heap_incr + NumAssigns * cost_of_heap_assign.
+ Cost = Cost0 + cost_of_heap_incr + NumAssigns * cost_of_heap_assign
+ ).
:- pred goal_costs(list(hlds_goal)::in, int::in, int::out) is det.
Index: compiler/pd_info.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/pd_info.m,v
retrieving revision 1.37
diff -u -b -r1.37 pd_info.m
--- compiler/pd_info.m 30 Dec 2007 08:23:53 -0000 1.37
+++ compiler/pd_info.m 11 Dec 2008 15:53:48 -0000
@@ -222,27 +222,30 @@
% body for unfolding and deforestation opportunities.
:- type unfold_info
---> unfold_info(
- proc_info :: proc_info,
- instmap :: instmap,
- cost_delta :: int,
- % improvement in cost measured while
- % processing this procedure
- local_term_info :: local_term_info,
- % information used to prevent
- % infinite unfolding within the
- % current procedure.
- pred_info :: pred_info,
- parents :: set(pred_proc_id),
- pred_proc_id :: pred_proc_id,
- % current pred_proc_id
- changed :: bool,
- % has anything changed
- size_delta :: int,
- % increase in size measured while
- % processing this procedure
- rerun_det :: bool
- % does determinism analysis
- % need to be rerun.
+ ufi_proc_info :: proc_info,
+ ufi_instmap :: instmap,
+
+ % Improvement in cost measured while processing this procedure.
+ ufi_cost_delta :: int,
+
+ % Information used to prevent infinite unfolding within the
+ % current procedure..
+ ufi_local_term_info :: local_term_info,
+
+ ufi_pred_info :: pred_info,
+ ufi_parents :: set(pred_proc_id),
+
+ % Current pred_proc_id.
+ ufi_pred_proc_id :: pred_proc_id,
+
+ % Has anything changed?
+ ufi_changed :: bool,
+
+ % Increase in size measured while processing this procedure.
+ ufi_size_delta :: int,
+
+ % Does determinism analysis need to be rerun.
+ ufi_rerun_det :: bool
).
% pd_arg_info records which procedures have arguments for which
@@ -308,66 +311,66 @@
:- implementation.
-pd_info_get_proc_info(PDInfo, UnfoldInfo ^ proc_info) :-
+pd_info_get_proc_info(PDInfo, UnfoldInfo ^ ufi_proc_info) :-
pd_info_get_unfold_info(PDInfo, UnfoldInfo).
-pd_info_get_instmap(PDInfo, UnfoldInfo ^ instmap) :-
+pd_info_get_instmap(PDInfo, UnfoldInfo ^ ufi_instmap) :-
pd_info_get_unfold_info(PDInfo, UnfoldInfo).
-pd_info_get_cost_delta(PDInfo, UnfoldInfo ^ cost_delta) :-
+pd_info_get_cost_delta(PDInfo, UnfoldInfo ^ ufi_cost_delta) :-
pd_info_get_unfold_info(PDInfo, UnfoldInfo).
-pd_info_get_local_term_info(PDInfo, UnfoldInfo ^ local_term_info) :-
+pd_info_get_local_term_info(PDInfo, UnfoldInfo ^ ufi_local_term_info) :-
pd_info_get_unfold_info(PDInfo, UnfoldInfo).
-pd_info_get_pred_info(PDInfo, UnfoldInfo ^ pred_info) :-
+pd_info_get_pred_info(PDInfo, UnfoldInfo ^ ufi_pred_info) :-
pd_info_get_unfold_info(PDInfo, UnfoldInfo).
-pd_info_get_parents(PDInfo, UnfoldInfo ^ parents) :-
+pd_info_get_parents(PDInfo, UnfoldInfo ^ ufi_parents) :-
pd_info_get_unfold_info(PDInfo, UnfoldInfo).
-pd_info_get_pred_proc_id(PDInfo, UnfoldInfo ^ pred_proc_id) :-
+pd_info_get_pred_proc_id(PDInfo, UnfoldInfo ^ ufi_pred_proc_id) :-
pd_info_get_unfold_info(PDInfo, UnfoldInfo).
-pd_info_get_changed(PDInfo, UnfoldInfo ^ changed) :-
+pd_info_get_changed(PDInfo, UnfoldInfo ^ ufi_changed) :-
pd_info_get_unfold_info(PDInfo, UnfoldInfo).
-pd_info_get_size_delta(PDInfo, UnfoldInfo ^ size_delta) :-
+pd_info_get_size_delta(PDInfo, UnfoldInfo ^ ufi_size_delta) :-
pd_info_get_unfold_info(PDInfo, UnfoldInfo).
-pd_info_get_rerun_det(PDInfo, UnfoldInfo ^ rerun_det) :-
+pd_info_get_rerun_det(PDInfo, UnfoldInfo ^ ufi_rerun_det) :-
pd_info_get_unfold_info(PDInfo, UnfoldInfo).
pd_info_set_proc_info(ProcInfo, !PDInfo) :-
pd_info_get_unfold_info(!.PDInfo, UnfoldInfo0),
- UnfoldInfo = UnfoldInfo0 ^ proc_info := ProcInfo,
+ UnfoldInfo = UnfoldInfo0 ^ ufi_proc_info := ProcInfo,
pd_info_set_unfold_info(UnfoldInfo, !PDInfo).
pd_info_set_instmap(InstMap, !PDInfo) :-
pd_info_get_unfold_info(!.PDInfo, UnfoldInfo0),
- UnfoldInfo = UnfoldInfo0 ^ instmap := InstMap,
+ UnfoldInfo = UnfoldInfo0 ^ ufi_instmap := InstMap,
pd_info_set_unfold_info(UnfoldInfo, !PDInfo).
pd_info_set_cost_delta(CostDelta, !PDInfo) :-
pd_info_get_unfold_info(!.PDInfo, UnfoldInfo0),
- UnfoldInfo = UnfoldInfo0 ^ cost_delta := CostDelta,
+ UnfoldInfo = UnfoldInfo0 ^ ufi_cost_delta := CostDelta,
pd_info_set_unfold_info(UnfoldInfo, !PDInfo).
pd_info_set_local_term_info(TermInfo, !PDInfo) :-
pd_info_get_unfold_info(!.PDInfo, UnfoldInfo0),
- UnfoldInfo = UnfoldInfo0 ^ local_term_info := TermInfo,
+ UnfoldInfo = UnfoldInfo0 ^ ufi_local_term_info := TermInfo,
pd_info_set_unfold_info(UnfoldInfo, !PDInfo).
pd_info_set_pred_info(PredInfo, !PDInfo) :-
pd_info_get_unfold_info(!.PDInfo, UnfoldInfo0),
- UnfoldInfo = UnfoldInfo0 ^ pred_info := PredInfo,
+ UnfoldInfo = UnfoldInfo0 ^ ufi_pred_info := PredInfo,
pd_info_set_unfold_info(UnfoldInfo, !PDInfo).
pd_info_set_parents(Parents, !PDInfo) :-
pd_info_get_unfold_info(!.PDInfo, UnfoldInfo0),
- UnfoldInfo = UnfoldInfo0 ^ parents := Parents,
+ UnfoldInfo = UnfoldInfo0 ^ ufi_parents := Parents,
pd_info_set_unfold_info(UnfoldInfo, !PDInfo).
pd_info_set_pred_proc_id(PredProcId, !PDInfo) :-
pd_info_get_unfold_info(!.PDInfo, UnfoldInfo0),
- UnfoldInfo = UnfoldInfo0 ^ pred_proc_id := PredProcId,
+ UnfoldInfo = UnfoldInfo0 ^ ufi_pred_proc_id := PredProcId,
pd_info_set_unfold_info(UnfoldInfo, !PDInfo).
pd_info_set_changed(Changed, !PDInfo) :-
pd_info_get_unfold_info(!.PDInfo, UnfoldInfo0),
- UnfoldInfo = UnfoldInfo0 ^ changed := Changed,
+ UnfoldInfo = UnfoldInfo0 ^ ufi_changed := Changed,
pd_info_set_unfold_info(UnfoldInfo, !PDInfo).
pd_info_set_size_delta(SizeDelta, !PDInfo) :-
pd_info_get_unfold_info(!.PDInfo, UnfoldInfo0),
- UnfoldInfo = UnfoldInfo0 ^ size_delta := SizeDelta,
+ UnfoldInfo = UnfoldInfo0 ^ ufi_size_delta := SizeDelta,
pd_info_set_unfold_info(UnfoldInfo, !PDInfo).
pd_info_set_rerun_det(Rerun, !PDInfo) :-
pd_info_get_unfold_info(!.PDInfo, UnfoldInfo0),
- UnfoldInfo = UnfoldInfo0 ^ rerun_det := Rerun,
+ UnfoldInfo = UnfoldInfo0 ^ ufi_rerun_det := Rerun,
pd_info_set_unfold_info(UnfoldInfo, !PDInfo).
pd_info_incr_cost_delta(Delta1, !PDInfo) :-
@@ -591,9 +594,9 @@
pd_info.check_insts(_, [], _, _, _, _, !ExactSoFar).
pd_info.check_insts(ModuleInfo, [OldVar | Vars], VarRenaming, OldInstMap,
NewInstMap, VarTypes, !ExactSoFar) :-
- instmap.lookup_var(OldInstMap, OldVar, OldVarInst),
+ instmap_lookup_var(OldInstMap, OldVar, OldVarInst),
map.lookup(VarRenaming, OldVar, NewVar),
- instmap.lookup_var(NewInstMap, NewVar, NewVarInst),
+ instmap_lookup_var(NewInstMap, NewVar, NewVarInst),
map.lookup(VarTypes, NewVar, Type),
inst_matches_initial(NewVarInst, OldVarInst, Type, ModuleInfo),
(
Index: compiler/pd_term.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/pd_term.m,v
retrieving revision 1.18
diff -u -b -r1.18 pd_term.m
--- compiler/pd_term.m 6 Jan 2007 09:23:46 -0000 1.18
+++ compiler/pd_term.m 11 Dec 2008 15:53:48 -0000
@@ -275,7 +275,7 @@
[ArgNo - Size | Sizes]) :-
NextArgNo = ArgNo + 1,
initial_sizes(ModuleInfo, InstMap, Args, NextArgNo, Sizes),
- instmap.lookup_var(InstMap, Arg, ArgInst),
+ instmap_lookup_var(InstMap, Arg, ArgInst),
pd_util.inst_size(ModuleInfo, ArgInst, Size).
%-----------------------------------------------------------------------------%
@@ -291,7 +291,7 @@
get_matching_sizes(ModuleInfo, InstMap, Args, OldSizes, NewSizes,
OldTotal1, NewTotal1),
list.index1_det(Args, ArgNo, Arg),
- instmap.lookup_var(InstMap, Arg, ArgInst),
+ instmap_lookup_var(InstMap, Arg, ArgInst),
pd_util.inst_size(ModuleInfo, ArgInst, NewSize),
OldTotal = OldTotal1 + OldSize,
NewTotal = NewTotal1 + NewSize.
Index: compiler/pd_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/pd_util.m,v
retrieving revision 1.70
diff -u -b -r1.70 pd_util.m
--- compiler/pd_util.m 15 Oct 2008 04:06:04 -0000 1.70
+++ compiler/pd_util.m 11 Dec 2008 15:53:48 -0000
@@ -345,7 +345,7 @@
( instmap_delta_search_var(InstMapDelta, NonLocal, FinalInst0) ->
FinalInst = FinalInst0
;
- instmap.lookup_var(InstMap, NonLocal, FinalInst)
+ instmap_lookup_var(InstMap, NonLocal, FinalInst)
),
( inst_is_clobbered(ModuleInfo, FinalInst) ->
true
@@ -613,7 +613,7 @@
AddExtraInfoVars =
(pred(ChangedVar::in, Vars0::in, Vars::out) is det :-
(
- instmap.lookup_var(InstMap, ChangedVar, VarInst),
+ instmap_lookup_var(InstMap, ChangedVar, VarInst),
instmap_delta_search_var(InstMapDelta, ChangedVar,
DeltaVarInst),
inst_is_bound_to_functors(ModuleInfo, DeltaVarInst, [_]),
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.335
diff -u -b -r1.335 polymorphism.m
--- compiler/polymorphism.m 4 Sep 2008 11:41:01 -0000 1.335
+++ compiler/polymorphism.m 11 Dec 2008 15:53:48 -0000
@@ -483,7 +483,7 @@
OldHeadVarList),
map.apply_to_list(ExtraHeadVarList, VarTypes0, ExtraArgTypes),
- list.append(ExtraArgTypes, ArgTypes0, ArgTypes),
+ ArgTypes = ExtraArgTypes ++ ArgTypes0,
pred_info_set_arg_types(TypeVarSet, ExistQVars, ArgTypes,
PredInfo0, PredInfo1),
@@ -672,7 +672,7 @@
% XXX ARGVEC - revisit this when the proc_info uses proc_arg_vectors.
proc_info_get_argmodes(!.ProcInfo, ArgModes1),
ExtraArgModesList = poly_arg_vector_to_list(ExtraArgModes),
- list.append(ExtraArgModesList, ArgModes1, ArgModes),
+ ArgModes = ExtraArgModesList ++ ArgModes1,
proc_info_set_argmodes(ArgModes, !ProcInfo).
% XXX document me
@@ -1066,7 +1066,7 @@
ArgVars = ExtraVars ++ ArgVars0,
CallExpr = GoalExpr0 ^ call_args := ArgVars,
Call = hlds_goal(CallExpr, GoalInfo),
- list.append(ExtraGoals, [Call], GoalList),
+ GoalList = ExtraGoals ++ [Call],
conj_list_to_goal(GoalList, GoalInfo0, Goal)
;
GoalExpr0 = call_foreign_proc(_, PredId, _, _, _, _, _),
@@ -1105,8 +1105,54 @@
polymorphism_process_case_list(Cases0, Cases, !Info),
GoalExpr = switch(Var, CanFail, Cases)
;
- GoalExpr0 = scope(Reason, SubGoal0),
+ GoalExpr0 = scope(Reason0, SubGoal0),
+ (
+ Reason0 =
+ from_ground_term(TermVar, from_ground_term_construct)
+ ->
+ poly_info_get_varset(!.Info, VarSetBefore),
+ MaxVarBefore = varset.max_var(VarSetBefore),
+ polymorphism_process_goal(SubGoal0, SubGoal, !Info),
+ poly_info_get_varset(!.Info, VarSetAfter),
+ MaxVarAfter = varset.max_var(VarSetAfter),
+
+ ( not MaxVarAfter = MaxVarBefore ->
+ % We did introduced some variables into the scope,
+ % so we cannot guarantee that the scope still satisfies
+ % the invariants of from_ground_term_construct scopes.
+ Reason = from_ground_term(TermVar, from_ground_term_other)
+ ;
+ poly_info_get_var_types(!.Info, VarTypes),
+ map.lookup(VarTypes, TermVar, TermVarType),
+ type_vars(TermVarType, TermVarTypeVars),
+ (
+ TermVarTypeVars = [_ | _],
+ % We may have (and probably did) modified the code in
+ % the scope by adding a reference to typeinfo variables
+ % representing TermVarTypeVars.
+ Reason = from_ground_term(TermVar,
+ from_ground_term_other)
+ ;
+ TermVarTypeVars = [],
+ % TermVarTypeVars = [] says that there is no
+ % polymorphism imposed from the outside via TermVar,
+ % and MaxVarAfter = MaxVarBefore says that there was no
+ % polymorphism added by the goals inside the scope
+ % (since those would have required the creation of
+ % new typeinfo variables).
+ % XXX zs: I am only 90% sure of the statement in the
+ % parentheses. If it turns out to be wrong, we would
+ % have to add a flag to poly_infos that is set whenever
+ % this pass modifies a goal, at least in ways that
+ % would invalidate the from_ground_term_construct
+ % invariant.
+ Reason = Reason0
+ )
+ )
+ ;
polymorphism_process_goal(SubGoal0, SubGoal, !Info),
+ Reason = Reason0
+ ),
GoalExpr = scope(Reason, SubGoal)
;
GoalExpr0 = if_then_else(Vars, Cond0, Then0, Else0),
@@ -1147,14 +1193,14 @@
(
MaybeNameMode = yes(ArgName0 - Mode),
( mode_is_output(ModuleInfo, Mode) ->
- string.append("&", ArgName0, ArgName)
+ ArgName = "&" ++ ArgName0
;
ArgName = ArgName0
),
( String0 = "" ->
String = ArgName
;
- String = string.append_list([ArgName, ", ", String0])
+ String = ArgName ++ ", " ++ String0
)
;
MaybeNameMode = no,
@@ -1204,7 +1250,7 @@
fixup_lambda_quantification(ArgVars0, LambdaVars, ExistQVars,
LambdaGoal1, LambdaGoal, NonLocalTypeInfos, !Info),
set.to_sorted_list(NonLocalTypeInfos, NonLocalTypeInfosList),
- list.append(NonLocalTypeInfosList, ArgVars0, ArgVars),
+ ArgVars = NonLocalTypeInfosList ++ ArgVars0,
Y1 = rhs_lambda_goal(Purity, Groundness, PredOrFunc, EvalMethod,
ArgVars, LambdaVars, Modes, Det, LambdaGoal),
NonLocals0 = goal_info_get_nonlocals(GoalInfo0),
@@ -1372,7 +1418,7 @@
polymorphism_process_existq_unify_functor(ConsDefn,
IsConstruction, ActualArgTypes, TypeOfX, GoalInfo0,
ExtraVars, ExtraGoals, !Info),
- list.append(ExtraVars, ArgVars0, ArgVars),
+ ArgVars = ExtraVars ++ ArgVars0,
NonLocals0 = goal_info_get_nonlocals(GoalInfo0),
set.insert_list(NonLocals0, ExtraVars, NonLocals),
goal_info_set_nonlocals(NonLocals, GoalInfo0, GoalInfo1),
@@ -1385,7 +1431,7 @@
UnifyExpr = unify(X0, rhs_functor(ConsId, IsConstruction, ArgVars),
Mode0, Unification, UnifyContext),
Unify = hlds_goal(UnifyExpr, GoalInfo),
- list.append(ExtraGoals, [Unify], GoalList),
+ GoalList = ExtraGoals ++ [Unify],
conj_list_to_goal(GoalList, GoalInfo0, Goal)
;
% We leave construction/deconstruction unifications alone.
@@ -1402,10 +1448,9 @@
convert_pred_to_lambda_goal(Purity, EvalMethod, X0, PredId, ProcId,
ArgVars0, PredArgTypes, UnifyContext, GoalInfo0, Context,
ModuleInfo0, Functor, !VarSet, !VarTypes) :-
-
% Create the new lambda-quantified variables.
create_fresh_vars(PredArgTypes, LambdaVars, !VarSet, !VarTypes),
- list.append(ArgVars0, LambdaVars, Args),
+ Args = ArgVars0 ++ LambdaVars,
% Build up the hlds_goal_expr for the call that will form the lambda goal.
module_info_pred_proc_info(ModuleInfo0, PredId, ProcId,
@@ -1424,7 +1469,7 @@
% Construct a goal_info for the lambda goal, making sure to set up
% the nonlocals field in the goal_info correctly. The goal_path is needed
% to compute constraint_ids correctly.
- %
+
NonLocals = goal_info_get_nonlocals(GoalInfo0),
set.insert_list(NonLocals, LambdaVars, OutsideVars),
set.list_to_set(Args, InsideVars),
@@ -1649,7 +1694,7 @@
CallExpr = call_foreign_proc(Attributes, PredId, ProcId,
Args, ProcExtraArgs, MaybeTraceRuntimeCond, Impl),
Call = hlds_goal(CallExpr, GoalInfo),
- list.append(ExtraGoals, [Call], GoalList),
+ GoalList = ExtraGoals ++ [Call],
conj_list_to_goal(GoalList, GoalInfo0, Goal).
:- pred polymorphism_process_foreign_proc_args(pred_info::in, bool::in,
@@ -1736,7 +1781,7 @@
foreign_proc_add_typeinfo(CanOptAwayUnnamed, Mode, Impl, TypeVarSet, TVar,
MaybeArgName - native_if_possible) :-
( varset.search_name(TypeVarSet, TVar, TypeVarName) ->
- string.append("TypeInfo_for_", TypeVarName, C_VarName),
+ C_VarName = "TypeInfo_for_" ++ TypeVarName,
% If the variable name corresponding to the type_info isn't mentioned
% in the C code fragment, don't pass the variable to the C code at all.
(
@@ -1765,7 +1810,7 @@
underscore_and_tvar_name(TypeVarSet, TVar) = TVarName :-
varset.lookup_name(TypeVarSet, TVar, TVarName0),
- string.append("_", TVarName0, TVarName).
+ TVarName = "_" ++ TVarName0.
:- pred polymorphism_process_goal_list(list(hlds_goal)::in,
list(hlds_goal)::out, poly_info::in, poly_info::out) is det.
@@ -2371,7 +2416,6 @@
construct_typeclass_info(ArgUnconstrainedTypeInfoVars, ArgTypeInfoVars,
ArgTypeClassInfoVars, ClassId, Constraint, InstanceNum, InstanceTypes,
SuperClassProofs, ExistQVars, NewVar, NewGoals, !Info) :-
-
poly_info_get_module_info(!.Info, ModuleInfo),
module_info_get_class_table(ModuleInfo, ClassTable),
@@ -2381,9 +2425,8 @@
ExistQVars, ArgSuperClassVars, SuperClassGoals, !Info),
% Lay out the argument variables as expected in the typeclass_info.
- list.append(ArgTypeClassInfoVars, ArgSuperClassVars, ArgVars0),
- list.append(ArgVars0, ArgTypeInfoVars, ArgVars1),
- list.append(ArgUnconstrainedTypeInfoVars, ArgVars1, ArgVars),
+ ArgVars = ArgUnconstrainedTypeInfoVars ++ ArgTypeClassInfoVars ++
+ ArgSuperClassVars ++ ArgTypeInfoVars,
ClassId = class_id(ClassName, _Arity),
@@ -2454,8 +2497,7 @@
goal_info_set_determinism(detism_det, GoalInfo2, GoalInfo),
TypeClassInfoGoal = hlds_goal(Unify, GoalInfo),
- NewGoals0 = [TypeClassInfoGoal, BaseGoal],
- list.append(NewGoals0, SuperClassGoals, NewGoals).
+ NewGoals = [TypeClassInfoGoal, BaseGoal] ++ SuperClassGoals.
%---------------------------------------------------------------------------%
@@ -2734,7 +2776,7 @@
TypeInfoType = type_info_type,
map.det_update(!.VarTypes, TypeCtorVar, TypeInfoType, !:VarTypes),
Var = TypeCtorVar,
- list.append(ArgTypeInfoGoals, ExtraGoals0, ExtraGoals)
+ ExtraGoals = ArgTypeInfoGoals ++ ExtraGoals0
% The type_info to represent Type is just a type_ctor_info. We used
% to simply change the type of TypeCtorVar from type_ctor_info to
@@ -2912,7 +2954,7 @@
new_type_info_var(Type, type_info, Var, !Info),
( varset.search_name(TypeVarSet, TypeVar, TypeVarName) ->
poly_info_get_varset(!.Info, VarSet0),
- string.append("TypeInfo_for_", TypeVarName, VarName),
+ VarName = "TypeInfo_for_" ++ TypeVarName,
varset.name_var(VarSet0, Var, VarName, VarSet),
poly_info_set_varset(VarSet, !Info)
;
@@ -2949,7 +2991,7 @@
% XXX Perhaps we should record the variables holding
% type_ctor_infos in the rtti_varmaps somewhere.
),
- string.append(Prefix, VarNumStr, Name),
+ Name = Prefix ++ VarNumStr,
varset.name_var(!.VarSet, Var, Name, !:VarSet),
map.set(!.VarTypes, Var, type_info_type, !:VarTypes).
@@ -3128,7 +3170,7 @@
% Introduce new variable.
varset.new_var(VarSet0, Var, VarSet1),
- string.append("TypeClassInfo_for_", ClassString, Name),
+ Name = "TypeClassInfo_for_" ++ ClassString,
varset.name_var(VarSet1, Var, Name, VarSet),
build_typeclass_info_type(Constraint, DictionaryType),
map.set(VarTypes0, Var, DictionaryType, VarTypes),
@@ -3470,10 +3512,6 @@
poly_info::in, poly_info::out) is det.
:- pred poly_info_set_proofs(constraint_proof_map::in,
poly_info::in, poly_info::out) is det.
-:- pred poly_info_set_constraint_map(constraint_map::in,
- poly_info::in, poly_info::out) is det.
-:- pred poly_info_set_module_info(module_info::in,
- poly_info::in, poly_info::out) is det.
poly_info_set_varset(VarSet, !PI) :-
!PI ^ poly_varset := VarSet.
@@ -3488,10 +3526,6 @@
!PI ^ poly_rtti_varmaps := RttiVarMaps.
poly_info_set_proofs(Proofs, !PI) :-
!PI ^ poly_proof_map := Proofs.
-poly_info_set_constraint_map(ConstraintMap, !PI) :-
- !PI ^ poly_constraint_map := ConstraintMap.
-poly_info_set_module_info(ModuleInfo, !PI) :-
- !PI ^ poly_module_info := ModuleInfo.
%---------------------------------------------------------------------------%
Index: compiler/proc_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/proc_gen.m,v
retrieving revision 1.29
diff -u -b -r1.29 proc_gen.m
--- compiler/proc_gen.m 25 Nov 2008 07:46:42 -0000 1.29
+++ compiler/proc_gen.m 11 Dec 2008 15:53:48 -0000
@@ -1018,7 +1018,7 @@
ArgModes = get_arginfo(!.CI),
HeadVars = get_headvars(!.CI),
assoc_list.from_corresponding_lists(HeadVars, ArgModes, Args),
- ( instmap.is_unreachable(InstMap) ->
+ ( instmap_is_unreachable(InstMap) ->
OutLvals = set.init,
FlushCode = empty
;
Index: compiler/prog_rep.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_rep.m,v
retrieving revision 1.65
diff -u -b -r1.65 prog_rep.m
--- compiler/prog_rep.m 2 Oct 2008 05:22:37 -0000 1.65
+++ compiler/prog_rep.m 11 Dec 2008 15:53:48 -0000
@@ -600,7 +600,7 @@
head_var_to_byte_list(Info, InitialInstmap, InstmapDelta, Var) = Bytes :-
var_to_byte_list(Info, Var) = VarBytes,
ModuleInfo = Info ^ pri_module_info,
- lookup_var(InitialInstmap, Var, InitialInst),
+ instmap_lookup_var(InitialInstmap, Var, InitialInst),
( instmap_delta_search_var(InstmapDelta, Var, FinalInstPrime) ->
FinalInst = FinalInstPrime
;
Index: compiler/prop_mode_constraints.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prop_mode_constraints.m,v
retrieving revision 1.19
diff -u -b -r1.19 prop_mode_constraints.m
--- compiler/prop_mode_constraints.m 27 Feb 2008 07:23:13 -0000 1.19
+++ compiler/prop_mode_constraints.m 11 Dec 2008 15:53:48 -0000
@@ -343,6 +343,8 @@
!:GoalExpr = negation(Goal)
;
!.GoalExpr = scope(Reason, Goal0),
+ % XXX We should special-case the handling of from_ground_term_construct
+ % scopes.
ensure_unique_arguments_in_goal(Goal0, Goal, !SeenSoFar, !Varset,
!Vartypes),
!:GoalExpr = scope(Reason, Goal)
Index: compiler/purity.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/purity.m,v
retrieving revision 1.123
diff -u -b -r1.123 purity.m
--- compiler/purity.m 8 Sep 2008 04:35:54 -0000 1.123
+++ compiler/purity.m 11 Dec 2008 15:53:48 -0000
@@ -692,10 +692,14 @@
!:Info = !.Info ^ pi_implicit_purity := ImplicitPurity0,
Purity = PromisedPurity
;
+ % We haven't yet classified from_ground_term scopes into
+ % from_ground_term_construct and other kinds, which is a pity,
+ % since from_ground_term_construct scopes do not need purity
+ % checking.
( Reason = promise_solutions(_, _)
; Reason = commit(_)
; Reason = barrier(_)
- ; Reason = from_ground_term(_)
+ ; Reason = from_ground_term(_, _)
),
compute_goal_purity(Goal0, Goal, Purity, ContainsTrace, !Info)
;
Index: compiler/quantification.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/quantification.m,v
retrieving revision 1.128
diff -u -b -r1.128 quantification.m
--- compiler/quantification.m 2 Dec 2008 04:20:51 -0000 1.128
+++ compiler/quantification.m 11 Dec 2008 15:53:48 -0000
@@ -279,20 +279,21 @@
:- mode implicitly_quantify_goal_quant_info(in, out,
in(code_gen_nonlocals), in, out) is det.
-implicitly_quantify_goal_quant_info(Goal0, Goal, NonLocalsToRecompute, !Info) :-
+implicitly_quantify_goal_quant_info(Goal0, Goal, NonLocalsToRecompute,
+ !Info) :-
Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
get_seen(!.Info, SeenVars),
implicitly_quantify_goal_quant_info_2(GoalExpr0, GoalExpr1, GoalInfo0,
- NonLocalsToRecompute, !Info),
+ NonLocalsToRecompute, PossiblyNonLocalGoalVars0, !Info),
get_nonlocals(!.Info, NonLocalVars),
- (
+ difference(PossiblyNonLocalGoalVars0, NonLocalVars, LocalVars),
+ intersect(SeenVars, LocalVars, RenameVars),
% If there are any variables that are local to the goal
% which we have come across before, then we rename them apart.
- goal_vars_bitset(NonLocalsToRecompute, Goal0, GoalVars0),
- difference(GoalVars0, NonLocalVars, LocalVars),
- intersect(SeenVars, LocalVars, RenameVars),
- \+ empty(RenameVars)
- ->
+ ( empty(RenameVars) ->
+ GoalExpr = GoalExpr1,
+ GoalInfo1 = GoalInfo0
+ ;
rename_apart(RenameVars, RenameMap, NonLocalsToRecompute,
hlds_goal(GoalExpr1, GoalInfo0), hlds_goal(GoalExpr, GoalInfo1),
!Info),
@@ -305,9 +306,6 @@
map.foldl(rtti_var_info_duplicate, RenameMap, !RttiVarMaps),
set_rtti_varmaps(!.RttiVarMaps, !Info)
)
- ;
- GoalExpr = GoalExpr1,
- GoalInfo1 = GoalInfo0
),
set_goal_nonlocals_translate(NonLocalVars, NonLocals, NonLocalsToRecompute,
GoalInfo1, GoalInfo2, !Info),
@@ -335,84 +333,26 @@
% goal_infos in the usual (no warning) case.
%
:- pred implicitly_quantify_goal_quant_info_2(hlds_goal_expr, hlds_goal_expr,
- hlds_goal_info, nonlocals_to_recompute, quant_info, quant_info).
+ hlds_goal_info, nonlocals_to_recompute, set_of_var,
+ quant_info, quant_info).
:- mode implicitly_quantify_goal_quant_info_2(in, out, in,
- in(ordinary_nonlocals), in, out) is det.
+ in(ordinary_nonlocals), out, in, out) is det.
:- mode implicitly_quantify_goal_quant_info_2(in, out, in,
- in(code_gen_nonlocals), in, out) is det.
+ in(code_gen_nonlocals), out, in, out) is det.
implicitly_quantify_goal_quant_info_2(GoalExpr0, GoalExpr, GoalInfo0,
- NonLocalsToRecompute, !Info) :-
+ NonLocalsToRecompute, PossiblyNonLocalGoalVars0, !Info) :-
(
GoalExpr0 = scope(Reason0, SubGoal0),
- (
- Reason0 = exist_quant(Vars0),
- Reason1 = exist_quant([])
- ;
- ( Reason0 = promise_purity(_, _)
- ; Reason0 = promise_solutions(_, _)
- ; Reason0 = commit(_)
- ; Reason0 = barrier(_)
- ; Reason0 = from_ground_term(_)
- ),
- Reason1 = Reason0,
- Vars0 = []
- ;
- Reason0 = trace_goal(_, _, _, _, Vars0),
- Reason1 = Reason0
- ),
- get_outside(!.Info, OutsideVars),
- get_lambda_outside(!.Info, LambdaOutsideVars),
- get_quant_vars(!.Info, QuantVars),
- % Rename apart all the quantified variables that occur
- % outside this goal.
- QVars = list_to_set(Vars0),
- intersect(OutsideVars, QVars, RenameVars1),
- intersect(LambdaOutsideVars, QVars, RenameVars2),
- union(RenameVars1, RenameVars2, RenameVars),
- ( empty(RenameVars) ->
- SubGoal1 = SubGoal0,
- Vars = Vars0,
- Reason = Reason1
- ;
- Context = goal_info_get_context(GoalInfo0),
- warn_overlapping_scope(RenameVars, Context, !Info),
- rename_apart(RenameVars, RenameMap, NonLocalsToRecompute,
- SubGoal0, SubGoal1, !Info),
- rename_var_list(need_not_rename, RenameMap, Vars0, Vars),
- (
- Reason1 = promise_solutions(PromiseVars0, Kind),
- rename_var_list(need_not_rename, RenameMap,
- PromiseVars0, PromiseVars),
- Reason = promise_solutions(PromiseVars, Kind)
- ;
- Reason1 = exist_quant(_),
- % We have already handled this case.
- Reason = Reason1
- ;
- ( Reason1 = promise_purity(_, _)
- ; Reason1 = commit(_)
- ; Reason1 = barrier(_)
- ; Reason1 = from_ground_term(_)
- ; Reason1 = trace_goal(_, _, _, _, _)
- ),
- Reason = Reason1
- )
- ),
- update_seen_vars(QVars, !Info),
- insert_list(QuantVars, Vars, QuantVars1),
- set_quant_vars(QuantVars1, !Info),
- implicitly_quantify_goal_quant_info(SubGoal1, SubGoal,
- NonLocalsToRecompute, !Info),
- get_nonlocals(!.Info, NonLocals0),
- delete_list(NonLocals0, Vars, NonLocals),
- set_quant_vars(QuantVars, !Info),
- set_nonlocals(NonLocals, !Info),
- GoalExpr = scope(Reason, SubGoal)
+ implicitly_quantify_goal_quant_info_scope(Reason0, SubGoal0,
+ GoalExpr, GoalInfo0, NonLocalsToRecompute,
+ PossiblyNonLocalGoalVars0, !Info)
;
GoalExpr0 = conj(ConjType, Goals0),
implicitly_quantify_conj(Goals0, Goals, NonLocalsToRecompute, !Info),
- GoalExpr = conj(ConjType, Goals)
+ GoalExpr = conj(ConjType, Goals),
+ goal_expr_vars_bitset(NonLocalsToRecompute, GoalExpr0,
+ PossiblyNonLocalGoalVars0)
;
GoalExpr0 = disj(Goals0),
NonLocalVarSets0 = [],
@@ -420,7 +360,9 @@
NonLocalVarSets0, NonLocalVarSets),
union_list(NonLocalVarSets, NonLocalVars),
set_nonlocals(NonLocalVars, !Info),
- GoalExpr = disj(Goals)
+ GoalExpr = disj(Goals),
+ goal_expr_vars_bitset(NonLocalsToRecompute, GoalExpr0,
+ PossiblyNonLocalGoalVars0)
;
GoalExpr0 = switch(Var, Det, Cases0),
NonLocalVarSets0 = [],
@@ -431,7 +373,9 @@
union_list(NonLocalVarSets, NonLocalVars0),
insert(NonLocalVars0, Var, NonLocalVars),
set_nonlocals(NonLocalVars, !Info),
- GoalExpr = switch(Var, Det, Cases)
+ GoalExpr = switch(Var, Det, Cases),
+ goal_expr_vars_bitset(NonLocalsToRecompute, GoalExpr0,
+ PossiblyNonLocalGoalVars0)
;
GoalExpr0 = negation(SubGoal0),
% Quantified variables cannot be pushed inside a negation, so we insert
@@ -448,7 +392,9 @@
NonLocalsToRecompute, !Info),
GoalExpr = negation(SubGoal),
set_outside(OutsideVars, !Info),
- set_quant_vars(QuantVars, !Info)
+ set_quant_vars(QuantVars, !Info),
+ goal_expr_vars_bitset(NonLocalsToRecompute, GoalExpr0,
+ PossiblyNonLocalGoalVars0)
;
GoalExpr0 = if_then_else(Vars0, Cond0, Then0, Else0),
% After this pass, explicit quantifiers are redundant, since all
@@ -506,17 +452,23 @@
intersect(NonLocalsIfThenElse, OutsideVars, NonLocalsO),
intersect(NonLocalsIfThenElse, LambdaOutsideVars, NonLocalsL),
union(NonLocalsO, NonLocalsL, NonLocals),
- set_nonlocals(NonLocals, !Info)
+ set_nonlocals(NonLocals, !Info),
+ goal_expr_vars_bitset(NonLocalsToRecompute, GoalExpr0,
+ PossiblyNonLocalGoalVars0)
;
GoalExpr0 = plain_call(_, _, HeadVars, _, _, _),
GoalExpr = GoalExpr0,
- implicitly_quantify_primitive_goal(HeadVars, !Info)
+ implicitly_quantify_primitive_goal(HeadVars, !Info),
+ goal_expr_vars_bitset(NonLocalsToRecompute, GoalExpr0,
+ PossiblyNonLocalGoalVars0)
;
GoalExpr0 = generic_call(GenericCall, CallArgVars, _, _),
GoalExpr = GoalExpr0,
goal_util.generic_call_vars(GenericCall, ArgVars0),
list.append(ArgVars0, CallArgVars, ArgVars),
- implicitly_quantify_primitive_goal(ArgVars, !Info)
+ implicitly_quantify_primitive_goal(ArgVars, !Info),
+ goal_expr_vars_bitset(NonLocalsToRecompute, GoalExpr0,
+ PossiblyNonLocalGoalVars0)
;
GoalExpr0 = unify(Var, UnifyRHS0, Mode, Unification0, UnifyContext),
get_outside(!.Info, OutsideVars),
@@ -593,14 +545,18 @@
intersect(GoalVars, OutsideVars, NonLocalVars1),
intersect(GoalVars, LambdaOutsideVars, NonLocalVars2),
union(NonLocalVars1, NonLocalVars2, NonLocalVars),
- set_nonlocals(NonLocalVars, !Info)
+ set_nonlocals(NonLocalVars, !Info),
+ goal_expr_vars_bitset(NonLocalsToRecompute, GoalExpr0,
+ PossiblyNonLocalGoalVars0)
;
GoalExpr0 = call_foreign_proc(_, _, _, Args, ExtraArgs, _, _),
GoalExpr = GoalExpr0,
Vars = list.map(foreign_arg_var, Args),
ExtraVars = list.map(foreign_arg_var, ExtraArgs),
list.append(Vars, ExtraVars, AllVars),
- implicitly_quantify_primitive_goal(AllVars, !Info)
+ implicitly_quantify_primitive_goal(AllVars, !Info),
+ goal_expr_vars_bitset(NonLocalsToRecompute, GoalExpr0,
+ PossiblyNonLocalGoalVars0)
;
GoalExpr0 = shorthand(ShortHand0),
(
@@ -638,20 +594,143 @@
GoalExpr = shorthand(ShortHand)
;
ShortHand0 = bi_implication(LHS, RHS),
- implicitly_quantify_goal_quant_info_2_bi_implication(LHS, RHS,
+ implicitly_quantify_goal_quant_info_bi_implication(LHS, RHS,
GoalExpr, GoalInfo0, NonLocalsToRecompute, !Info)
- )
+ ),
+ goal_expr_vars_bitset(NonLocalsToRecompute, GoalExpr0,
+ PossiblyNonLocalGoalVars0)
).
-:- pred implicitly_quantify_goal_quant_info_2_bi_implication(
+:- pred implicitly_quantify_goal_quant_info_scope(scope_reason, hlds_goal,
+ hlds_goal_expr, hlds_goal_info, nonlocals_to_recompute, set_of_var,
+ quant_info, quant_info).
+:- mode implicitly_quantify_goal_quant_info_scope(in, in, out, in,
+ in(ordinary_nonlocals), out, in, out) is det.
+:- mode implicitly_quantify_goal_quant_info_scope(in, in, out, in,
+ in(code_gen_nonlocals), out, in, out) is det.
+
+implicitly_quantify_goal_quant_info_scope(Reason0, SubGoal0, GoalExpr,
+ GoalInfo0, NonLocalsToRecompute, PossiblyNonLocalGoalVars0, !Info) :-
+ GoalExpr0 = scope(Reason0, SubGoal0),
+ get_quant_vars(!.Info, QuantVars),
+ (
+ Reason0 = exist_quant(Vars0),
+ Reason1 = exist_quant([]),
+ implicitly_quantify_goal_quant_info_scope_rename_vars(
+ Reason1, Reason, SubGoal0, SubGoal1, Vars0, Vars, GoalInfo0,
+ NonLocalsToRecompute, !Info),
+ goal_expr_vars_bitset(NonLocalsToRecompute, GoalExpr0,
+ PossiblyNonLocalGoalVars0),
+ implicitly_quantify_goal_quant_info(SubGoal1, SubGoal,
+ NonLocalsToRecompute, !Info),
+ get_nonlocals(!.Info, NonLocals0),
+ delete_list(NonLocals0, Vars, NonLocals),
+ set_nonlocals(NonLocals, !Info)
+ ;
+ Reason0 = from_ground_term(TermVar, from_ground_term_construct),
+ Reason = Reason0,
+ % Not quantifying the subgoal is a substantial speedup. It is ok
+ % because superhomogeneous.m sets up the nonlocal sets of the
+ % unifications, their conjunction, and the scope goal itself,
+ % and every later compiler pass than can invalidate those nonlocal sets
+ % will either set the kind to from_ground_term_other or remove the
+ % scope altogether.
+ SubGoal = SubGoal0,
+ NonLocals = make_singleton_set(TermVar),
+ set_nonlocals(NonLocals, !Info),
+ PossiblyNonLocalGoalVars0 = NonLocals
+ ;
+ ( Reason0 = promise_purity(_, _)
+ ; Reason0 = promise_solutions(_, _)
+ ; Reason0 = commit(_)
+ ; Reason0 = barrier(_)
+ ; Reason0 = from_ground_term(_, from_ground_term_deconstruct)
+ ; Reason0 = from_ground_term(_, from_ground_term_other)
+ ),
+ Reason = Reason0,
+ goal_expr_vars_bitset(NonLocalsToRecompute, GoalExpr0,
+ PossiblyNonLocalGoalVars0),
+ implicitly_quantify_goal_quant_info(SubGoal0, SubGoal,
+ NonLocalsToRecompute, !Info)
+ ;
+ Reason0 = trace_goal(_, _, _, _, Vars0),
+ implicitly_quantify_goal_quant_info_scope_rename_vars(
+ Reason0, Reason, SubGoal0, SubGoal1, Vars0, Vars, GoalInfo0,
+ NonLocalsToRecompute, !Info),
+ goal_expr_vars_bitset(NonLocalsToRecompute, GoalExpr0,
+ PossiblyNonLocalGoalVars0),
+ implicitly_quantify_goal_quant_info(SubGoal1, SubGoal,
+ NonLocalsToRecompute, !Info),
+ get_nonlocals(!.Info, NonLocals0),
+ delete_list(NonLocals0, Vars, NonLocals),
+ set_nonlocals(NonLocals, !Info)
+ ),
+ set_quant_vars(QuantVars, !Info),
+ GoalExpr = scope(Reason, SubGoal).
+
+:- pred implicitly_quantify_goal_quant_info_scope_rename_vars(
+ scope_reason, scope_reason, hlds_goal, hlds_goal,
+ list(prog_var), list(prog_var), hlds_goal_info, nonlocals_to_recompute,
+ quant_info, quant_info).
+:- mode implicitly_quantify_goal_quant_info_scope_rename_vars(in, out,
+ in, out, in, out, in, in(ordinary_nonlocals), in, out) is det.
+:- mode implicitly_quantify_goal_quant_info_scope_rename_vars(in, out,
+ in, out, in, out, in, in(code_gen_nonlocals), in, out) is det.
+
+implicitly_quantify_goal_quant_info_scope_rename_vars(Reason0, Reason,
+ SubGoal0, SubGoal, Vars0, Vars, GoalInfo0, NonLocalsToRecompute,
+ !Info) :-
+ get_outside(!.Info, OutsideVars),
+ get_lambda_outside(!.Info, LambdaOutsideVars),
+ get_quant_vars(!.Info, QuantVars),
+ % Rename apart all the quantified variables that occur
+ % outside this goal.
+ QVars = list_to_set(Vars0),
+ intersect(OutsideVars, QVars, RenameVars1),
+ intersect(LambdaOutsideVars, QVars, RenameVars2),
+ union(RenameVars1, RenameVars2, RenameVars),
+ ( empty(RenameVars) ->
+ SubGoal = SubGoal0,
+ Vars = Vars0,
+ Reason = Reason0
+ ;
+ Context = goal_info_get_context(GoalInfo0),
+ warn_overlapping_scope(RenameVars, Context, !Info),
+ rename_apart(RenameVars, RenameMap, NonLocalsToRecompute,
+ SubGoal0, SubGoal, !Info),
+ rename_var_list(need_not_rename, RenameMap, Vars0, Vars),
+ (
+ Reason0 = exist_quant(_),
+ Reason = exist_quant([])
+ ;
+ Reason0 = trace_goal(Comp, Run, IO, Mut, TraceVars0),
+ rename_var_list(need_not_rename, RenameMap, TraceVars0, TraceVars),
+ Reason = trace_goal(Comp, Run, IO, Mut, TraceVars)
+ ;
+ ( Reason0 = promise_purity(_, _)
+ ; Reason0 = commit(_)
+ ; Reason0 = barrier(_)
+ ; Reason0 = from_ground_term(_, _)
+ ; Reason0 = promise_solutions(_, _)
+ ),
+ % We shouldn't invoke this predicate for these kinds of scopes.
+ unexpected(this_file,
+ "implicitly_quantify_goal_quant_info_scope_rename_vars")
+ )
+ ),
+ update_seen_vars(QVars, !Info),
+ insert_list(QuantVars, Vars, QuantVars1),
+ set_quant_vars(QuantVars1, !Info).
+
+:- pred implicitly_quantify_goal_quant_info_bi_implication(
hlds_goal, hlds_goal, hlds_goal_expr, hlds_goal_info,
nonlocals_to_recompute, quant_info, quant_info).
-:- mode implicitly_quantify_goal_quant_info_2_bi_implication(in, in, out, in,
+:- mode implicitly_quantify_goal_quant_info_bi_implication(in, in, out, in,
in(ordinary_nonlocals), in, out) is det.
-:- mode implicitly_quantify_goal_quant_info_2_bi_implication(in, in, out, in,
+:- mode implicitly_quantify_goal_quant_info_bi_implication(in, in, out, in,
in(code_gen_nonlocals), in, out) is det.
-implicitly_quantify_goal_quant_info_2_bi_implication(LHS0, RHS0, GoalExpr,
+implicitly_quantify_goal_quant_info_bi_implication(LHS0, RHS0, GoalExpr,
OldGoalInfo, NonLocalsToRecompute, !Info) :-
% Get the initial values of various settings.
@@ -1030,9 +1109,9 @@
:- mode conj_vars(in(code_gen_nonlocals), in, in, out, in, out) is det.
conj_vars(_, [], !Set, !LambdaSet).
-conj_vars(NonLocalsToRecompute, [hlds_goal(GoalExpr, _GoalInfo) | Goals],
- !Set, !LambdaSet) :-
- goal_vars_2(NonLocalsToRecompute, GoalExpr, !Set, !LambdaSet),
+conj_vars(NonLocalsToRecompute, [Goal | Goals], !Set, !LambdaSet) :-
+ Goal = hlds_goal(GoalExpr, _GoalInfo),
+ goal_expr_vars_2(NonLocalsToRecompute, GoalExpr, !Set, !LambdaSet),
conj_vars(NonLocalsToRecompute, Goals, !Set, !LambdaSet).
:- pred disj_vars(nonlocals_to_recompute, list(hlds_goal),
@@ -1067,11 +1146,7 @@
compute_disj_vars(_, [], !Sets, !LambdaSets).
compute_disj_vars(NonLocalsToRecompute, [Goal | Goals], !Sets, !LambdaSets) :-
- EmptySet = init,
- EmptyLambdaSet = init,
- Goal = hlds_goal(GoalExpr, _),
- goal_vars_2(NonLocalsToRecompute, GoalExpr,
- EmptySet, GoalSet, EmptyLambdaSet, GoalLambdaSet),
+ goal_vars_both(NonLocalsToRecompute, Goal, GoalSet, GoalLambdaSet),
!:Sets = [GoalSet | !.Sets],
!:LambdaSets = [GoalLambdaSet | !.LambdaSets],
compute_disj_vars(NonLocalsToRecompute, Goals, !Sets, !LambdaSets).
@@ -1108,11 +1183,8 @@
compute_case_vars(_, [], !Sets, !LambdaSets).
compute_case_vars(NonLocalsToRecompute, [Case | Cases], !Sets, !LambdaSets) :-
- Case = case(_MainConsId, _OtherConsIds, hlds_goal(GoalExpr, _GoalInfo)),
- EmptySet = init,
- EmptyLambdaSet = init,
- goal_vars_2(NonLocalsToRecompute, GoalExpr,
- EmptySet, GoalSet, EmptyLambdaSet, GoalLambdaSet),
+ Case = case(_MainConsId, _OtherConsIds, Goal),
+ goal_vars_both(NonLocalsToRecompute, Goal, GoalSet, GoalLambdaSet),
!:Sets = [GoalSet | !.Sets],
!:LambdaSets = [GoalLambdaSet | !.LambdaSets],
compute_case_vars(NonLocalsToRecompute, Cases, !Sets, !LambdaSets).
@@ -1165,10 +1237,21 @@
:- mode goal_vars_bitset(in(code_gen_nonlocals), in, out) is det.
goal_vars_bitset(NonLocalsToRecompute, Goal, BothSet) :-
- goal_vars_both(NonLocalsToRecompute, Goal, Set, LambdaSet),
+ Goal = hlds_goal(GoalExpr, _),
+ goal_expr_vars_both(NonLocalsToRecompute, GoalExpr, Set, LambdaSet),
+ BothSet = union(Set, LambdaSet).
+
+:- pred goal_expr_vars_bitset(nonlocals_to_recompute,
+ hlds_goal_expr, set_of_var).
+:- mode goal_expr_vars_bitset(in(ordinary_nonlocals), in, out) is det.
+:- mode goal_expr_vars_bitset(in(code_gen_nonlocals), in, out) is det.
+
+goal_expr_vars_bitset(NonLocalsToRecompute, GoalExpr, BothSet) :-
+ goal_expr_vars_both(NonLocalsToRecompute, GoalExpr, Set, LambdaSet),
BothSet = union(Set, LambdaSet).
- % goal_vars_both(NonLocalsToRecompute, Goal, NonLambdaSet, LambdaSet):
+ % goal_vars_both(NonLocalsToRecompute, Goal,
+ % NonLambdaSet, LambdaSet):
%
% Set is the set of variables that occur free (unquantified) in Goal,
% not counting occurrences in lambda expressions. LambdaSet is the set
@@ -1180,18 +1263,27 @@
:- mode goal_vars_both(in(ordinary_nonlocals), in, out, out) is det.
:- mode goal_vars_both(in(code_gen_nonlocals), in, out, out) is det.
-goal_vars_both(NonLocalsToRecompute, hlds_goal(Goal, _GoalInfo),
- Set, LambdaSet) :-
+goal_vars_both(NonLocalsToRecompute, Goal, Set, LambdaSet) :-
+ Goal = hlds_goal(GoalExpr, _),
+ goal_expr_vars_both(NonLocalsToRecompute, GoalExpr, Set, LambdaSet).
+
+:- pred goal_expr_vars_both(nonlocals_to_recompute, hlds_goal_expr,
+ set_of_var, set_of_var).
+:- mode goal_expr_vars_both(in(ordinary_nonlocals), in, out, out) is det.
+:- mode goal_expr_vars_both(in(code_gen_nonlocals), in, out, out) is det.
+
+goal_expr_vars_both(NonLocalsToRecompute, GoalExpr, Set, LambdaSet) :-
Set0 = init,
LambdaSet0 = init,
- goal_vars_2(NonLocalsToRecompute, Goal, Set0, Set, LambdaSet0, LambdaSet).
+ goal_expr_vars_2(NonLocalsToRecompute, GoalExpr, Set0, Set,
+ LambdaSet0, LambdaSet).
-:- pred goal_vars_2(nonlocals_to_recompute, hlds_goal_expr,
+:- pred goal_expr_vars_2(nonlocals_to_recompute, hlds_goal_expr,
set_of_var, set_of_var, set_of_var, set_of_var).
-:- 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.
+:- mode goal_expr_vars_2(in(ordinary_nonlocals), in, in, out, in, out) is det.
+:- mode goal_expr_vars_2(in(code_gen_nonlocals), in, in, out, in, out) is det.
-goal_vars_2(NonLocalsToRecompute, GoalExpr, !Set, !LambdaSet) :-
+goal_expr_vars_2(NonLocalsToRecompute, GoalExpr, !Set, !LambdaSet) :-
(
GoalExpr = unify(LHS, RHS, _, Unification, _),
insert(!.Set, LHS, !:Set),
@@ -1280,11 +1372,12 @@
;
GoalExpr = negation(SubGoal),
SubGoal = hlds_goal(SubGoalExpr, _SubGoalInfo),
- goal_vars_2(NonLocalsToRecompute, SubGoalExpr, !Set, !LambdaSet)
+ goal_expr_vars_2(NonLocalsToRecompute, SubGoalExpr, !Set, !LambdaSet)
;
GoalExpr = scope(Reason, SubGoal),
Set0 = !.Set,
LambdaSet0 = !.LambdaSet,
+ % ZZZ
goal_vars_both(NonLocalsToRecompute, SubGoal, !:Set, !:LambdaSet),
(
Reason = exist_quant(Vars),
@@ -1300,7 +1393,9 @@
;
Reason = barrier(_)
;
- Reason = from_ground_term(_)
+ Reason = from_ground_term(_Var, _)
+ % _Var should have been put into the relevant sets when we
+ % processed SubGoal, since it should appear in SubGoal.
;
Reason = trace_goal(_, _, _, _, _)
),
Index: compiler/rbmm.actual_region_arguments.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/rbmm.actual_region_arguments.m,v
retrieving revision 1.3
diff -u -b -r1.3 rbmm.actual_region_arguments.m
--- compiler/rbmm.actual_region_arguments.m 27 Feb 2008 07:23:14 -0000 1.3
+++ compiler/rbmm.actual_region_arguments.m 11 Dec 2008 15:53:48 -0000
@@ -191,6 +191,8 @@
GoalExpr = unify(_, _, _, _, _)
;
GoalExpr = scope(_, SubGoal),
+ % XXX We should special-case the handling of from_ground_term_construct
+ % scopes.
record_actual_region_arguments_goal(ModuleInfo, CallerPPId,
RptaInfoTable, ConstantRTable, DeadRTable, BornRTable, SubGoal,
!ActualRegionArgProc)
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.4
diff -u -b -r1.4 rbmm.add_rbmm_goal_infos.m
--- compiler/rbmm.add_rbmm_goal_infos.m 8 Apr 2008 20:12:17 -0000 1.4
+++ compiler/rbmm.add_rbmm_goal_infos.m 11 Dec 2008 15:53:48 -0000
@@ -313,6 +313,8 @@
ActualRegionsArgsProc, ResurRenamingProc, IteRenamingProc,
NameToRegionVarProc, !Expr, !Info) :-
!.Expr = scope(Reason, Goal0),
+ % XXX We should special-case the handling of from_ground_term_construct
+ % scopes.
collect_rbmm_goal_info_goal(ModuleInfo, ProcInfo, Graph,
ActualRegionsArgsProc, ResurRenamingProc, IteRenamingProc,
NameToRegionVarProc, Goal0, Goal),
Index: compiler/rbmm.condition_renaming.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/rbmm.condition_renaming.m,v
retrieving revision 1.10
diff -u -b -r1.10 rbmm.condition_renaming.m
--- compiler/rbmm.condition_renaming.m 4 Sep 2008 11:41:01 -0000 1.10
+++ compiler/rbmm.condition_renaming.m 11 Dec 2008 15:53:48 -0000
@@ -289,6 +289,8 @@
collect_non_local_and_in_cond_regions_expr(Graph, LRBeforeProc, LRAfterProc,
ResurRenamingProc, ResurRenamingAnnoProc, scope(_, Goal),
!NonLocalRegionsProc, !InCondRegionsProc) :-
+ % XXX We should special-case the handling of from_ground_term_construct
+ % scopes.
collect_non_local_and_in_cond_regions_goal(Graph, LRBeforeProc,
LRAfterProc, ResurRenamingProc, ResurRenamingAnnoProc, Goal,
!NonLocalRegionsProc, !InCondRegionsProc).
@@ -514,6 +516,8 @@
Goal, !NonLocalRegionProc)
;
Expr = scope(_, Goal),
+ % XXX We should special-case the handling of from_ground_term_construct
+ % scopes.
collect_non_local_regions_in_ite(Graph,
LRBeforeProc, LRAfterProc,
ResurRenamingProc, ResurRenamingAnnoProc,
@@ -689,6 +693,8 @@
Goal, !InCondRegionsProc)
;
Expr = scope(_, Goal),
+ % XXX We should special-case the handling of from_ground_term_construct
+ % scopes.
collect_regions_created_in_condition(Graph,
LRBeforeProc, LRAfterProc,
ResurRenamingProc, ResurRenamingAnnoProc,
@@ -852,6 +858,8 @@
collect_ite_renaming_expr(scope(_, Goal), IteRenamedRegionProc,
Graph, !IteRenamingProc) :-
+ % XXX We should special-case the handling of from_ground_term_construct
+ % scopes.
collect_ite_renaming_goal(IteRenamedRegionProc, Graph, Goal,
!IteRenamingProc).
@@ -960,6 +968,8 @@
Graph, Goal, !IteRenamingProc)
;
Expr = scope(_, Goal),
+ % XXX We should special-case the handling of from_ground_term_construct
+ % scopes.
collect_ite_renaming_in_condition(IteRenamedRegionProc,
Graph, Goal, !IteRenamingProc)
;
Index: compiler/rbmm.execution_path.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/rbmm.execution_path.m,v
retrieving revision 1.8
diff -u -b -r1.8 rbmm.execution_path.m
--- compiler/rbmm.execution_path.m 3 Apr 2008 05:26:45 -0000 1.8
+++ compiler/rbmm.execution_path.m 11 Dec 2008 15:53:48 -0000
@@ -147,6 +147,8 @@
execution_paths_covered_goal(ProcInfo, Goal, !ExecPaths)
;
Expr = scope(_, Goal),
+ % XXX We should special-case the handling of from_ground_term_construct
+ % scopes.
execution_paths_covered_goal(ProcInfo, Goal, !ExecPaths)
;
Expr = if_then_else(_V, Cond, Then, Else),
Index: compiler/rbmm.region_transformation.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/rbmm.region_transformation.m,v
retrieving revision 1.7
diff -u -b -r1.7 rbmm.region_transformation.m
--- compiler/rbmm.region_transformation.m 8 Apr 2008 20:12:17 -0000 1.7
+++ compiler/rbmm.region_transformation.m 11 Dec 2008 15:53:48 -0000
@@ -548,6 +548,8 @@
!:GoalExpr = negation(Goal)
;
!.GoalExpr = scope(Reason, Goal0),
+ % XXX We should special-case the handling of from_ground_term_construct
+ % scopes.
region_transform_goal(ModuleInfo, Graph, ResurRenamingProc,
IteRenamingProc, ActualRegionArgProc, RegionInstructionProc,
ResurRenamingAnnoProc, IteRenamingAnnoProc, Goal0, Goal,
Index: compiler/saved_vars.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/saved_vars.m,v
retrieving revision 1.79
diff -u -b -r1.79 saved_vars.m
--- compiler/saved_vars.m 25 Nov 2008 07:46:42 -0000 1.79
+++ compiler/saved_vars.m 11 Dec 2008 15:53:48 -0000
@@ -147,7 +147,14 @@
Goal = hlds_goal(GoalExpr, GoalInfo0)
;
GoalExpr0 = scope(Reason, SubGoal0),
- saved_vars_in_goal(SubGoal0, SubGoal, !SlotInfo),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ % Moving unifications around inside these scopes is
+ % (a) counterproductive, and (b) incorrect, since it would
+ % invalidate the invariants required of such scopes.
+ SubGoal = SubGoal0
+ ;
+ saved_vars_in_goal(SubGoal0, SubGoal, !SlotInfo)
+ ),
GoalExpr = scope(Reason, SubGoal),
Goal = hlds_goal(GoalExpr, GoalInfo0)
;
@@ -195,7 +202,7 @@
\+ slot_info_do_not_duplicate_var(!.SlotInfo, Var),
skip_constant_constructs(Goals0, Constants, OtherGoals),
OtherGoals = [First | _Rest],
- can_push(Var, First)
+ can_push(Var, First) = yes
->
set.is_member(Var, NonLocals, IsNonLocal),
saved_vars_delay_goal(OtherGoals, Goals1, Goal0, Var, IsNonLocal,
@@ -261,28 +268,59 @@
% NOTE: the logic of this predicate must match the logic of
% saved_vars_delay_goal.
%
-:- pred can_push(prog_var::in, hlds_goal::in) is semidet.
+:- func can_push(prog_var, hlds_goal) = bool.
-can_push(Var, First) :-
- First = hlds_goal(FirstExpr, FirstInfo),
- FirstNonLocals = goal_info_get_nonlocals(FirstInfo),
- ( set.member(Var, FirstNonLocals) ->
+can_push(Var, Goal) = CanPush :-
+ Goal = hlds_goal(GoalExpr, GoalInfo),
+ NonLocals = goal_info_get_nonlocals(GoalInfo),
+ ( set.member(Var, NonLocals) ->
(
- FirstExpr = conj(plain_conj, _)
+ ( GoalExpr = if_then_else(_, _, _, _)
+ ; GoalExpr = negation(_)
+ ; GoalExpr = disj(_)
+ ; GoalExpr = conj(plain_conj, _)
+ ),
+ CanPush = yes
+ ;
+ ( GoalExpr = conj(parallel_conj, _)
+ ; GoalExpr = unify(_, _, _, _, _)
+ ; GoalExpr = plain_call(_, _, _, _, _, _)
+ ; GoalExpr = generic_call(_, _, _, _)
+ ; GoalExpr = call_foreign_proc(_, _, _, _, _, _, _)
+ ),
+ CanPush = no
;
- FirstExpr = scope(_, _)
+ GoalExpr = scope(Reason, _),
+ (
+ ( Reason = exist_quant(_)
+ ; Reason = from_ground_term(_, from_ground_term_deconstruct)
+ ; Reason = from_ground_term(_, from_ground_term_other)
+ ),
+ CanPush = yes
;
- FirstExpr = negation(_)
+ ( Reason = from_ground_term(_, from_ground_term_construct)
+ ; Reason = promise_solutions(_, _)
+ ; Reason = promise_purity(_, _)
+ ; Reason = commit(_)
+ ; Reason = barrier(_)
+ ; Reason = trace_goal(_, _, _, _, _)
+ ),
+ CanPush = no
+ )
;
- FirstExpr = disj(_)
+ GoalExpr = switch(SwitchVar, _, _),
+ ( Var = SwitchVar ->
+ CanPush = no
;
- FirstExpr = switch(SwitchVar, _, _),
- Var \= SwitchVar
+ CanPush = yes
+ )
;
- FirstExpr = if_then_else(_, _, _, _)
+ GoalExpr = shorthand(_),
+ % These should have been expanded out by now.
+ unexpected(this_file, "can_push: unexpected shorthand")
)
;
- true
+ CanPush = yes
).
% The main inputs of this predicate are a list of goals in a
Index: compiler/simplify.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/simplify.m,v
retrieving revision 1.234
diff -u -b -r1.234 simplify.m
--- compiler/simplify.m 15 Oct 2008 04:06:04 -0000 1.234
+++ compiler/simplify.m 11 Dec 2008 15:53:48 -0000
@@ -791,8 +791,13 @@
(
simplify_do_elim_removable_scopes(!.Info),
Goal2 = hlds_goal(scope(Reason2, SomeGoal2), _GoalInfo2),
- ( Reason2 = barrier(removable)
- ; Reason2 = from_ground_term(_)
+ (
+ Reason2 = barrier(removable)
+ ;
+ Reason2 = from_ground_term(_, Kind),
+ ( Kind = from_ground_term_deconstruct
+ ; Kind = from_ground_term_other
+ )
)
->
Goal3 = SomeGoal2
@@ -801,7 +806,7 @@
),
simplify_info_maybe_clear_structs(before, Goal3, !Info),
Goal3 = hlds_goal(GoalExpr3, GoalInfo3),
- simplify_goal_2(GoalExpr3, GoalExpr, GoalInfo3, GoalInfo4, !Info),
+ simplify_goal_expr(GoalExpr3, GoalExpr, GoalInfo3, GoalInfo4, !Info),
simplify_info_maybe_clear_structs(after, hlds_goal(GoalExpr, GoalInfo4),
!Info),
simplify_info_set_inside_duplicated_for_switch(InsideDuplForSwitch, !Info),
@@ -862,53 +867,53 @@
:- inst goal_expr_foreign_proc == bound(call_foreign_proc(ground, ground,
ground, ground, ground, ground, ground)).
-:- pred simplify_goal_2(hlds_goal_expr::in, hlds_goal_expr::out,
+:- pred simplify_goal_expr(hlds_goal_expr::in, hlds_goal_expr::out,
hlds_goal_info::in, hlds_goal_info::out,
simplify_info::in, simplify_info::out) is det.
-simplify_goal_2(!GoalExpr, !GoalInfo, !Info) :-
+simplify_goal_expr(!GoalExpr, !GoalInfo, !Info) :-
(
!.GoalExpr = conj(ConjType, Goals),
(
ConjType = plain_conj,
- simplify_goal_2_plain_conj(Goals, !:GoalExpr, !GoalInfo, !Info)
+ simplify_goal_plain_conj(Goals, !:GoalExpr, !GoalInfo, !Info)
;
ConjType = parallel_conj,
- simplify_goal_2_parallel_conj(Goals, !:GoalExpr, !GoalInfo, !Info)
+ simplify_goal_parallel_conj(Goals, !:GoalExpr, !GoalInfo, !Info)
)
;
!.GoalExpr = disj(_),
- simplify_goal_2_disj(!GoalExpr, !GoalInfo, !Info)
+ simplify_goal_disj(!GoalExpr, !GoalInfo, !Info)
;
!.GoalExpr = switch(_, _, _),
- simplify_goal_2_switch(!GoalExpr, !GoalInfo, !Info)
+ simplify_goal_switch(!GoalExpr, !GoalInfo, !Info)
;
!.GoalExpr = generic_call(_, _, _, _),
- simplify_goal_2_generic_call(!GoalExpr, !GoalInfo, !Info)
+ simplify_goal_generic_call(!GoalExpr, !GoalInfo, !Info)
;
!.GoalExpr = plain_call(_, _, _, _, _, _),
- simplify_goal_2_plain_call(!GoalExpr, !GoalInfo, !Info)
+ simplify_goal_plain_call(!GoalExpr, !GoalInfo, !Info)
;
!.GoalExpr = unify(_, _, _, _, _),
- simplify_goal_2_unify(!GoalExpr, !GoalInfo, !Info)
+ simplify_goal_unify(!GoalExpr, !GoalInfo, !Info)
;
!.GoalExpr = if_then_else(_, _, _, _),
- simplify_goal_2_ite(!GoalExpr, !GoalInfo, !Info)
+ simplify_goal_ite(!GoalExpr, !GoalInfo, !Info)
;
!.GoalExpr = negation(_),
- simplify_goal_2_neg(!GoalExpr, !GoalInfo, !Info)
+ simplify_goal_neg(!GoalExpr, !GoalInfo, !Info)
;
!.GoalExpr = scope(_, _),
- simplify_goal_2_scope(!GoalExpr, !GoalInfo, !Info)
+ simplify_goal_scope(!GoalExpr, !GoalInfo, !Info)
;
!.GoalExpr = call_foreign_proc(_, _, _, _, _, _, _),
- simplify_goal_2_foreign_proc(!GoalExpr, !GoalInfo, !Info)
+ simplify_goal_foreign_proc(!GoalExpr, !GoalInfo, !Info)
;
!.GoalExpr = shorthand(ShortHand0),
(
ShortHand0 = atomic_goal(GoalType, Outer, Inner,
MaybeOutputVars, MainGoal, OrElseGoals),
- simplify_goal_2_atomic_goal(GoalType, Outer, Inner,
+ simplify_goal_atomic_goal(GoalType, Outer, Inner,
MaybeOutputVars, MainGoal, OrElseGoals, !:GoalExpr, !GoalInfo,
!Info)
;
@@ -918,11 +923,11 @@
)
).
-:- pred simplify_goal_2_plain_conj(list(hlds_goal)::in, hlds_goal_expr::out,
+:- pred simplify_goal_plain_conj(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_plain_conj(Goals0, GoalExpr, GoalInfo0, GoalInfo, !Info) :-
+simplify_goal_plain_conj(Goals0, GoalExpr, GoalInfo0, GoalInfo, !Info) :-
simplify_info_get_instmap(!.Info, InstMap0),
excess_assigns_in_conj(GoalInfo0, Goals0, Goals1, !Info),
simplify_conj(Goals1, [], Goals, GoalInfo0, !Info),
@@ -959,11 +964,11 @@
GoalInfo = GoalInfo0
).
-:- pred simplify_goal_2_parallel_conj(list(hlds_goal)::in, hlds_goal_expr::out,
+:- pred simplify_goal_parallel_conj(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_parallel_conj(Goals0, GoalExpr, GoalInfo0, GoalInfo, !Info) :-
+simplify_goal_parallel_conj(Goals0, GoalExpr, GoalInfo0, GoalInfo, !Info) :-
(
Goals0 = [],
Context = goal_info_get_context(GoalInfo0),
@@ -982,12 +987,12 @@
simplify_info_set_has_parallel_conj(yes, !Info)
).
-:- pred simplify_goal_2_disj(
+:- pred simplify_goal_disj(
hlds_goal_expr::in(goal_expr_disj), hlds_goal_expr::out,
hlds_goal_info::in, hlds_goal_info::out,
simplify_info::in, simplify_info::out) is det.
-simplify_goal_2_disj(GoalExpr0, GoalExpr, GoalInfo0, GoalInfo, !Info) :-
+simplify_goal_disj(GoalExpr0, GoalExpr, GoalInfo0, GoalInfo, !Info) :-
GoalExpr0 = disj(Disjuncts0),
simplify_info_get_instmap(!.Info, InstMap0),
simplify_disj(Disjuncts0, [], Disjuncts, [], InstMaps, !.Info, !Info),
@@ -1034,16 +1039,16 @@
true
).
-:- pred simplify_goal_2_switch(
+:- pred simplify_goal_switch(
hlds_goal_expr::in(goal_expr_switch), hlds_goal_expr::out,
hlds_goal_info::in, hlds_goal_info::out,
simplify_info::in, simplify_info::out) is det.
-simplify_goal_2_switch(GoalExpr0, GoalExpr, GoalInfo0, GoalInfo, !Info) :-
+simplify_goal_switch(GoalExpr0, GoalExpr, GoalInfo0, GoalInfo, !Info) :-
GoalExpr0 = switch(Var, SwitchCanFail0, Cases0),
simplify_info_get_instmap(!.Info, InstMap0),
simplify_info_get_module_info(!.Info, ModuleInfo0),
- instmap.lookup_var(InstMap0, Var, VarInst),
+ instmap_lookup_var(InstMap0, Var, VarInst),
( inst_is_bound_to_functors(ModuleInfo0, VarInst, Functors) ->
functors_to_cons_ids(Functors, ConsIds0),
list.sort(ConsIds0, ConsIds),
@@ -1053,8 +1058,10 @@
Cases1 = Cases0,
MaybeConsIds = no
),
- simplify_switch(Var, Cases1, [], Cases, [], InstMaps,
+ simplify_switch(Var, Cases1, [], RevCases, [], InstMaps,
+ not_seen_non_ground_term, SeenNonGroundTerm,
SwitchCanFail0, SwitchCanFail, !.Info, !Info),
+ list.reverse(RevCases, Cases),
(
Cases = [],
% An empty switch always fails.
@@ -1124,7 +1131,11 @@
;
Cases = [_, _ | _],
GoalExpr = switch(Var, SwitchCanFail, Cases),
- ( goal_info_has_feature(GoalInfo0, feature_mode_check_clauses_goal) ->
+ (
+ ( goal_info_has_feature(GoalInfo0, feature_mode_check_clauses_goal)
+ ; SeenNonGroundTerm = not_seen_non_ground_term
+ )
+ ->
% Recomputing the instmap delta would take very long and is
% very unlikely to get any better precision.
GoalInfo = GoalInfo0
@@ -1154,12 +1165,12 @@
true
).
-:- pred simplify_goal_2_generic_call(
+:- pred simplify_goal_generic_call(
hlds_goal_expr::in(goal_expr_generic_call), hlds_goal_expr::out,
hlds_goal_info::in, hlds_goal_info::out,
simplify_info::in, simplify_info::out) is det.
-simplify_goal_2_generic_call(GoalExpr0, GoalExpr, GoalInfo, GoalInfo, !Info) :-
+simplify_goal_generic_call(GoalExpr0, GoalExpr, GoalInfo, GoalInfo, !Info) :-
GoalExpr0 = generic_call(GenericCall, Args, Modes, Det),
(
GenericCall = higher_order(Closure, Purity, _, _),
@@ -1196,12 +1207,12 @@
GoalExpr = GoalExpr0
).
-:- pred simplify_goal_2_plain_call(
+:- pred simplify_goal_plain_call(
hlds_goal_expr::in(goal_expr_plain_call), hlds_goal_expr::out,
hlds_goal_info::in, hlds_goal_info::out,
simplify_info::in, simplify_info::out) is det.
-simplify_goal_2_plain_call(GoalExpr0, GoalExpr, GoalInfo0, GoalInfo, !Info) :-
+simplify_goal_plain_call(GoalExpr0, GoalExpr, GoalInfo0, GoalInfo, !Info) :-
GoalExpr0 = plain_call(PredId, ProcId, Args, IsBuiltin, _, _),
simplify_info_get_module_info(!.Info, ModuleInfo),
module_info_pred_info(ModuleInfo, PredId, PredInfo),
@@ -1232,12 +1243,12 @@
GoalExpr0, GoalExpr, GoalInfo0, GoalInfo, !Info)
).
-:- pred simplify_goal_2_unify(
+:- pred simplify_goal_unify(
hlds_goal_expr::in(goal_expr_unify), hlds_goal_expr::out,
hlds_goal_info::in, hlds_goal_info::out,
simplify_info::in, simplify_info::out) is det.
-simplify_goal_2_unify(GoalExpr0, GoalExpr, GoalInfo0, GoalInfo, !Info) :-
+simplify_goal_unify(GoalExpr0, GoalExpr, GoalInfo0, GoalInfo, !Info) :-
GoalExpr0 = unify(LT0, RT0, M, U0, C),
(
RT0 = rhs_lambda_goal(Purity, Groundness, PredOrFunc, EvalMethod,
@@ -1309,12 +1320,12 @@
)
).
-:- pred simplify_goal_2_ite(
+:- pred simplify_goal_ite(
hlds_goal_expr::in(goal_expr_ite), hlds_goal_expr::out,
hlds_goal_info::in, hlds_goal_info::out,
simplify_info::in, simplify_info::out) is det.
-simplify_goal_2_ite(GoalExpr0, GoalExpr, GoalInfo0, GoalInfo, !Info) :-
+simplify_goal_ite(GoalExpr0, GoalExpr, GoalInfo0, GoalInfo, !Info) :-
% (A -> B ; C) is logically equivalent to (A, B ; ~A, C).
% If the determinism of A means that one of these disjuncts
% cannot succeed, then we replace the if-then-else with the
@@ -1443,17 +1454,17 @@
; CondSolns0 = at_most_many
; CondSolns0 = at_most_many_cc
),
- simplify_goal_2_ordinary_ite(Vars, Cond0, Then0, Else0, GoalExpr,
+ simplify_goal_ordinary_ite(Vars, Cond0, Then0, Else0, GoalExpr,
GoalInfo0, GoalInfo, !Info)
)
).
-:- pred simplify_goal_2_ordinary_ite(list(prog_var)::in,
+:- pred simplify_goal_ordinary_ite(list(prog_var)::in,
hlds_goal::in, hlds_goal::in, 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_ordinary_ite(Vars, Cond0, Then0, Else0, GoalExpr,
+simplify_goal_ordinary_ite(Vars, Cond0, Then0, Else0, GoalExpr,
GoalInfo0, GoalInfo, !Info) :-
( Else0 = hlds_goal(disj([]), _) ->
% (A -> C ; fail) is equivalent to (A, C)
@@ -1512,7 +1523,7 @@
)
->
simplify_info_undo_goal_updates(Info0, !Info),
- simplify_goal_2(IfThenElse, GoalExpr, GoalInfo1, GoalInfo,
+ simplify_goal_expr(IfThenElse, GoalExpr, GoalInfo1, GoalInfo,
!Info)
;
simplify_info_get_module_info(!.Info, ModuleInfo),
@@ -1711,12 +1722,12 @@
unexpected(this_file, "warn_switch_for_ite_cond: solver type")
).
-:- pred simplify_goal_2_neg(
+:- pred simplify_goal_neg(
hlds_goal_expr::in(goal_expr_neg), hlds_goal_expr::out,
hlds_goal_info::in, hlds_goal_info::out,
simplify_info::in, simplify_info::out) is det.
-simplify_goal_2_neg(GoalExpr0, GoalExpr, GoalInfo0, GoalInfo, !Info) :-
+simplify_goal_neg(GoalExpr0, GoalExpr, GoalInfo0, GoalInfo, !Info) :-
GoalExpr0 = negation(SubGoal0),
% Can't use calls or unifications seen within a negation,
% since non-local variables may not be bound within the negation.
@@ -1775,50 +1786,108 @@
GoalInfo = GoalInfo0
).
-:- pred simplify_goal_2_scope(
+:- pred simplify_goal_scope(
hlds_goal_expr::in(goal_expr_scope), hlds_goal_expr::out,
hlds_goal_info::in, hlds_goal_info::out,
simplify_info::in, simplify_info::out) is det.
-simplify_goal_2_scope(GoalExpr0, GoalExpr, GoalInfo0, GoalInfo, !Info) :-
+simplify_goal_scope(GoalExpr0, GoalExpr, GoalInfo0, GoalInfo, !Info) :-
GoalExpr0 = scope(Reason0, SubGoal0),
+ ( Reason0 = from_ground_term(TermVar, from_ground_term_construct) ->
+ simplify_info_get_module_info(!.Info, ModuleInfo),
+ module_info_get_globals(ModuleInfo, Globals),
+ globals.lookup_bool_option(Globals, common_struct, CommonStruct),
+ (
+ CommonStruct = yes,
+ % Traversing the construction unifications inside the scope would
+ % allow common.m to
+ %
+ % - replace some of those constructions with references to other
+ % variables that were constructed the same way, and
+ % - remember those constructions, so that other constructions
+ % outside the scope could be replaced with references to
+ % variables built inside the scope.
+ %
+ % Since unifying a variable with a statically constructed ground
+ % term yields code that is at least as fast as unifying that
+ % variable with another variable that is already bound to that
+ % term, and probably faster because it does not require saving the
+ % other variable across calls, neither of these actions would be
+ % an advantage. On the other hand, both would complicate the
+ % required treatment of from_ground_term_construct scopes in
+ % liveness.m, slowing down the liveness pass, as well as this pass.
+ % Since the code inside the scope is already as simple as
+ % it can be, we leave it alone.
+ GoalExpr = GoalExpr0,
+ GoalInfo = GoalInfo0
+ ;
+ CommonStruct = no,
+ % Looking inside the scope may allow us to reduce the number of
+ % memory cells we may need to allocate dynamically. This
+ % improvement in the generated code trumps the cost in compile
+ % time. However, we need to update the reason, since leaving it
+ % as from_ground_term_construct would tell liveness.m that the
+ % code inside the scope hasn't had either of the actions mentioned
+ % in the comment above applied to it, and in this case, we cannot
+ % guarantee that.
+ simplify_goal(SubGoal0, SubGoal, !Info),
+ NewReason = from_ground_term(TermVar, from_ground_term_other),
+ GoalExpr = scope(NewReason, SubGoal),
+ GoalInfo = GoalInfo0
+ )
+ ;
simplify_info_get_common_info(!.Info, Common),
simplify_goal(SubGoal0, SubGoal, !Info),
nested_scopes(Reason0, SubGoal, GoalInfo0, Goal1),
- Goal1 = hlds_goal(GoalExpr1, GoalInfo1),
+ Goal1 = hlds_goal(GoalExpr1, _GoalInfo1),
( GoalExpr1 = scope(FinalReason, FinalSubGoal) ->
(
- FinalReason = promise_purity(_, _),
- Goal = Goal1,
- KeepCommon = yes
- ;
- FinalReason = commit(_),
- Goal = Goal1,
- KeepCommon = no
- ;
- FinalReason = from_ground_term(_),
- Goal = Goal1,
- KeepCommon = yes
- ;
- FinalReason = barrier(removable),
- Goal = Goal1,
- KeepCommon = yes
+ ( FinalReason = promise_purity(_, _)
+ ; FinalReason = from_ground_term(_, _)
+ ; FinalReason = barrier(removable)
+ ),
+ Goal = Goal1
;
- FinalReason = barrier(not_removable),
+ ( FinalReason = commit(_)
+ ; FinalReason = exist_quant(_)
+ ; FinalReason = promise_solutions(_, _)
+ ; FinalReason = barrier(not_removable)
+ ),
Goal = Goal1,
- KeepCommon = no
+ % Replacing calls, constructions or deconstructions outside
+ % a commit with references to variables created inside the
+ % commit would increase the set of output variables of the goal
+ % inside the commit. This is not allowed because it could
+ % change the determinism.
+ %
+ % Thus we need to reset the common_info to what it was before
+ % processing the goal inside the commit, to ensure that we
+ % don't make any such replacements when processing the rest
+ % of the goal.
+ simplify_info_set_common_info(Common, !Info)
;
- FinalReason = exist_quant(_),
- Goal = Goal1,
- KeepCommon = no
+ FinalReason = trace_goal(MaybeCompiletimeExpr,
+ MaybeRuntimeExpr, _, _, _),
+ ( simplify_do_after_front_end(!.Info) ->
+ simplify_goal_trace_goal(MaybeCompiletimeExpr,
+ MaybeRuntimeExpr, FinalSubGoal, Goal1, Goal, !Info)
;
- FinalReason = promise_solutions(_, _),
- Goal = Goal1,
- KeepCommon = no
+ Goal = Goal1
+ ),
+ simplify_info_set_common_info(Common, !Info)
+ )
;
- FinalReason = trace_goal(MaybeCompiletimeExpr, MaybeRuntimeExpr,
- _, _, _),
- ( simplify_do_after_front_end(!.Info) ->
+ Goal = Goal1
+ ),
+ Goal = hlds_goal(GoalExpr, GoalInfo)
+ ).
+
+:- pred simplify_goal_trace_goal(maybe(trace_expr(trace_compiletime))::in,
+ maybe(trace_expr(trace_runtime))::in, hlds_goal::in, hlds_goal::in,
+ hlds_goal::out, simplify_info::in, simplify_info::out) is det.
+
+simplify_goal_trace_goal(MaybeCompiletimeExpr, MaybeRuntimeExpr, SubGoal,
+ Goal0, Goal, !Info) :-
(
MaybeCompiletimeExpr = yes(CompiletimeExpr),
KeepGoal = evaluate_compile_time_condition(CompiletimeExpr,
@@ -1831,6 +1900,7 @@
),
(
KeepGoal = no,
+ Goal0 = hlds_goal(_GoalExpr0, GoalInfo0),
Context = goal_info_get_context(GoalInfo0),
Goal = true_goal_with_context(Context)
;
@@ -1838,24 +1908,22 @@
MaybeRuntimeExpr = no,
% We keep the scope as a marker of the existence of the
% trace scope.
- Goal = Goal1
+ Goal = Goal0
;
KeepGoal = yes,
MaybeRuntimeExpr = yes(RuntimeExpr),
- % We want to execute FinalSubGoal if and only if
- % RuntimeExpr turns out to be true. We could have the
- % code generators treat this kind of scope as if it were
- % an if-then-else, but that would require duplicating
- % most of the code required to handle code generation
- % for if-then-elses. Instead, we transform the scope
- % into an if-then-else, thus reducing the problem to one
- % that has already been solved.
- %
- % The evaluation of the runtime condition is done as
- % a special kind of foreign_proc, i.e. one that has
- % yes(RuntimeExpr) as its foreign_trace_cond field.
- % This kind of foreign_proc also acts as the marker
- % for the fact that the then-part originated as the goal
+ % We want to execute SubGoal if and only if RuntimeExpr turns out
+ % to be true. We could have the code generators treat this kind of
+ % scope as if it were an if-then-else, but that would require
+ % duplicating most of the code required to handle code generation
+ % for if-then-elses. Instead, we transform the scope into an
+ % if-then-else, thus reducing the problem to one that has already
+ % been solved.
+ %
+ % The evaluation of the runtime condition is done as a special kind
+ % of foreign_proc, i.e. one that has yes(RuntimeExpr) as its
+ % foreign_trace_cond field. This kind of foreign_proc also acts
+ % as the marker for the fact that the then-part originated as the goal
% of a trace scope.
simplify_info_get_module_info(!.Info, ModuleInfo),
module_info_get_globals(ModuleInfo, Globals),
@@ -1878,66 +1946,38 @@
sorry(this_file, "NYI: runtime trace conditions "
++ "in languages other than C")
),
- set_may_call_mercury(proc_will_not_call_mercury,
- !EvalAttributes),
+ set_may_call_mercury(proc_will_not_call_mercury, !EvalAttributes),
set_thread_safe(proc_thread_safe, !EvalAttributes),
set_purity(purity_semipure, !EvalAttributes),
set_terminates(proc_terminates, !EvalAttributes),
set_may_throw_exception(proc_will_not_throw_exception,
!EvalAttributes),
- set_may_modify_trail(proc_will_not_modify_trail,
- !EvalAttributes),
- set_may_call_mm_tabled(will_not_call_mm_tabled,
- !EvalAttributes),
+ set_may_modify_trail(proc_will_not_modify_trail, !EvalAttributes),
+ set_may_call_mm_tabled(will_not_call_mm_tabled, !EvalAttributes),
EvalAttributes = !.EvalAttributes
),
EvalFeatures = [],
- % The code field of the call_foreign_proc goal is ignored
- % when its foreign_trace_cond field is set to `yes', as
- % we do here.
+ % The code field of the call_foreign_proc goal is ignored when
+ % its foreign_trace_cond field is set to `yes', as we do here.
EvalCode = "",
EvalInstMapDeltaSrc = [],
+ Goal0 = hlds_goal(_GoalExpr0, GoalInfo0),
Context = goal_info_get_context(GoalInfo0),
generate_foreign_proc(PrivateBuiltin, EvalPredName,
pf_predicate, only_mode, detism_semi, purity_semipure,
EvalAttributes, [], [], yes(RuntimeExpr), EvalCode,
EvalFeatures, EvalInstMapDeltaSrc, ModuleInfo,
Context, CondGoal),
- Goal = hlds_goal(
- if_then_else([], CondGoal, FinalSubGoal, true_goal),
- GoalInfo1)
- )
- ;
- Goal = Goal1
- ),
- KeepCommon = no
- ),
- (
- KeepCommon = yes
- ;
- KeepCommon = no,
- % Replacing calls, constructions or deconstructions outside
- % a commit with references to variables created inside the commit
- % would increase the set of output variables of the goal inside
- % the commit. This is not allowed because it could change the
- % determinism.
- %
- % Thus we need to reset the common_info to what it was before
- % processing the goal inside the commit, to ensure that we don't
- % make any such replacements when processing the rest of the goal.
- simplify_info_set_common_info(Common, !Info)
- )
- ;
- Goal = Goal1
- ),
- Goal = hlds_goal(GoalExpr, GoalInfo).
+ GoalExpr = if_then_else([], CondGoal, SubGoal, true_goal),
+ Goal = hlds_goal(GoalExpr, GoalInfo0)
+ ).
-:- pred simplify_goal_2_foreign_proc(
+:- pred simplify_goal_foreign_proc(
hlds_goal_expr::in(goal_expr_foreign_proc), hlds_goal_expr::out,
hlds_goal_info::in, hlds_goal_info::out,
simplify_info::in, simplify_info::out) is det.
-simplify_goal_2_foreign_proc(GoalExpr0, GoalExpr, !GoalInfo, !Info) :-
+simplify_goal_foreign_proc(GoalExpr0, GoalExpr, !GoalInfo, !Info) :-
GoalExpr0 = call_foreign_proc(Attributes, PredId, ProcId,
Args0, ExtraArgs0, MaybeTraceRuntimeCond, Impl),
(
@@ -2037,13 +2077,13 @@
Result = bool.and(ResultA, ResultB)
).
-:- pred simplify_goal_2_atomic_goal(atomic_goal_type::in,
+:- pred simplify_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_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,
+simplify_goal_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
@@ -2088,8 +2128,8 @@
Args = [TI, R, X, Y],
simplify_info_get_instmap(!.Info, InstMap),
- instmap.lookup_var(InstMap, X, XInst),
- instmap.lookup_var(InstMap, Y, YInst),
+ instmap_lookup_var(InstMap, X, XInst),
+ instmap_lookup_var(InstMap, Y, YInst),
simplify_info_get_module_info(!.Info, ModuleInfo),
ModeNo =
( if inst_is_unique(ModuleInfo, XInst) then
@@ -2508,7 +2548,7 @@
"builtin_unify_pred", pf_predicate, mode_no(0), detism_semi,
purity_pure, [XVar, YVar], [], [], ModuleInfo, GContext,
hlds_goal(Call0, _)),
- simplify_goal_2(Call0, Call1, GoalInfo0, GoalInfo, !Info),
+ simplify_goal_expr(Call0, Call1, GoalInfo0, GoalInfo, !Info),
Call = hlds_goal(Call1, GoalInfo),
ExtraGoals = []
;
@@ -2568,7 +2608,8 @@
make_type_info_vars(TypeArgs, TypeInfoVars, ExtraGoals, !Info),
call_specific_unify(TypeCtor, TypeInfoVars, XVar, YVar, ProcId,
ModuleInfo, Context, GoalInfo0, Call0, CallGoalInfo0),
- simplify_goal_2(Call0, Call1, CallGoalInfo0, CallGoalInfo1, !Info),
+ simplify_goal_expr(Call0, Call1, CallGoalInfo0, CallGoalInfo1,
+ !Info),
Call = hlds_goal(Call1, CallGoalInfo1)
)
),
@@ -2766,14 +2807,6 @@
->
Reason2 = exist_quant(Vars0 ++ Vars1)
;
- Reason0 = from_ground_term(_)
- ->
- Reason2 = Reason1
- ;
- Reason1 = from_ground_term(_)
- ->
- Reason2 = Reason0
- ;
Reason0 = barrier(Removable0),
Reason1 = barrier(Removable1)
->
@@ -2865,7 +2898,7 @@
% Delete unreachable goals.
(
simplify_info_get_instmap(!.Info, InstMap1),
- instmap.is_unreachable(InstMap1)
+ instmap_is_unreachable(InstMap1)
;
Goal1 = hlds_goal(_, GoalInfo1),
Detism1 = goal_info_get_determinism(GoalInfo1),
@@ -3061,15 +3094,20 @@
%-----------------------------------------------------------------------------%
+:- type seen_non_ground_term
+ ---> not_seen_non_ground_term
+ ; seen_non_ground_term.
+
:- pred simplify_switch(prog_var::in, list(case)::in, list(case)::in,
list(case)::out, list(instmap_delta)::in, list(instmap_delta)::out,
+ seen_non_ground_term::in, seen_non_ground_term::out,
can_fail::in, can_fail::out, simplify_info::in,
simplify_info::in, simplify_info::out) is det.
-simplify_switch(_, [], RevCases, Cases, !InstMaps, !CanFail, _, !Info) :-
- list.reverse(RevCases, Cases).
-simplify_switch(Var, [Case0 | Cases0], RevCases0, Cases, !InstMaps,
- !CanFail, Info0, !Info) :-
+simplify_switch(_, [], !RevCases, !InstMaps, !SeenNonGroundTerm, !CanFail,
+ _, !Info).
+simplify_switch(Var, [Case0 | Cases0], !RevCases, !InstMaps,
+ !SeenNonGroundTerm, !CanFail, Info0, !Info) :-
simplify_info_get_instmap(Info0, InstMap0),
Case0 = case(MainConsId, OtherConsIds, Goal0),
simplify_info_get_module_info(!.Info, ModuleInfo0),
@@ -3083,11 +3121,20 @@
% Remove failing branches.
( Goal = hlds_goal(disj([]), _) ->
- RevCases = RevCases0,
+ % We don't add the case to RevCases.
!:CanFail = can_fail
;
Case = case(MainConsId, OtherConsIds, Goal),
- Goal = hlds_goal(_, GoalInfo),
+ Goal = hlds_goal(GoalExpr, GoalInfo),
+ (
+ GoalExpr = scope(Reason, _),
+ Reason = from_ground_term(_, from_ground_term_construct)
+ ->
+ % Leave SeenNonGroundTerm as it is.
+ true
+ ;
+ !:SeenNonGroundTerm = seen_non_ground_term
+ ),
% Make sure the switched on variable appears in the instmap delta.
% This avoids an abort in merge_instmap_delta if another branch
@@ -3102,12 +3149,12 @@
simplify_info_set_module_info(ModuleInfo, !Info),
!:InstMaps = [InstMapDelta | !.InstMaps],
- RevCases = [Case | RevCases0]
+ !:RevCases = [Case | !.RevCases]
),
simplify_info_post_branch_update(Info0, !Info),
- simplify_switch(Var, Cases0, RevCases, Cases, !InstMaps, !CanFail, Info0,
- !Info).
+ simplify_switch(Var, Cases0, !RevCases, !InstMaps, !SeenNonGroundTerm,
+ !CanFail, Info0, !Info).
% Create a semidet unification at the start of a singleton case
% in a can_fail switch.
@@ -3129,7 +3176,7 @@
simplify_info_set_varset(VarSet, !Info),
simplify_info_set_var_types(VarTypes, !Info),
simplify_info_get_instmap(!.Info, InstMap),
- instmap.lookup_var(InstMap, Var, Inst0),
+ instmap_lookup_var(InstMap, Var, Inst0),
(
inst_expand(ModuleInfo, Inst0, Inst1),
get_arg_insts(Inst1, ConsId, ConsArity, ArgInsts1)
@@ -3384,7 +3431,12 @@
GoalExpr = negation(SubGoal)
;
GoalExpr0 = scope(Reason, SubGoal0),
- goal_contains_trace(SubGoal0, SubGoal, ContainsTrace),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ SubGoal = SubGoal0,
+ ContainsTrace = contains_no_trace_goal
+ ;
+ goal_contains_trace(SubGoal0, SubGoal, ContainsTrace)
+ ),
GoalExpr = scope(Reason, SubGoal)
;
GoalExpr0 = shorthand(ShortHand0),
@@ -3448,7 +3500,7 @@
simp_inst_varset :: inst_varset,
% Does the goal need requantification?
- simp_requantify :: bool, % ZZZ
+ simp_requantify :: bool,
% Do we need to recompute instmap_deltas for atomic goals?
simp_recompute_atomic :: bool,
Index: compiler/size_prof.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/size_prof.m,v
retrieving revision 1.58
diff -u -b -r1.58 size_prof.m
--- compiler/size_prof.m 27 Feb 2008 07:23:14 -0000 1.58
+++ compiler/size_prof.m 11 Dec 2008 15:53:48 -0000
@@ -98,7 +98,8 @@
% Perform the transformation on the specified predicate.
%
-:- pred process_proc_msg(construct_transform::in, pred_id::in, proc_id::in,
+:- pred size_prof_process_proc_msg(construct_transform::in,
+ pred_id::in, proc_id::in,
proc_info::in, proc_info::out, module_info::in, module_info::out,
io::di, io::uo) is det.
@@ -213,7 +214,7 @@
spi_module_info :: module_info
).
-process_proc_msg(Transform, PredId, ProcId, ProcInfo0, ProcInfo,
+size_prof_process_proc_msg(Transform, PredId, ProcId, ProcInfo0, ProcInfo,
!ModuleInfo, !IO) :-
globals.io_lookup_bool_option(very_verbose, VeryVerbose, !IO),
(
@@ -221,19 +222,20 @@
io.write_string("% Adding typeinfos in ", !IO),
hlds_out.write_pred_proc_id_pair(!.ModuleInfo, PredId, ProcId, !IO),
io.write_string(": ", !IO),
- process_proc(Transform, PredId, ProcId, ProcInfo0, ProcInfo,
+ size_prof_process_proc(Transform, PredId, ProcId, ProcInfo0, ProcInfo,
!ModuleInfo),
io.write_string("done.\n", !IO)
;
VeryVerbose = no,
- process_proc(Transform, PredId, ProcId, ProcInfo0, ProcInfo,
+ size_prof_process_proc(Transform, PredId, ProcId, ProcInfo0, ProcInfo,
!ModuleInfo)
).
-:- pred process_proc(construct_transform::in, pred_id::in, proc_id::in,
+:- pred size_prof_process_proc(construct_transform::in,
+ pred_id::in, proc_id::in,
proc_info::in, proc_info::out, module_info::in, module_info::out) is det.
-process_proc(Transform, PredId, ProcId, !ProcInfo, !ModuleInfo) :-
+size_prof_process_proc(Transform, PredId, ProcId, !ProcInfo, !ModuleInfo) :-
Simplifications = list_to_simplifications([]),
simplify_proc_return_msgs(Simplifications, PredId, ProcId,
!ModuleInfo, !ProcInfo, _Msgs),
@@ -258,7 +260,7 @@
rtti_varmaps_tvars(RttiVarMaps0, TVars),
list.foldl(record_typeinfo_in_type_info_varmap(RttiVarMaps0), TVars,
Info0, Info1),
- process_goal(Goal0, Goal1, Info1, Info),
+ size_prof_process_goal(Goal0, Goal1, Info1, Info),
% We need to fix up goal_infos by recalculating
% the nonlocal vars and the non-atomic instmap deltas.
@@ -274,30 +276,31 @@
proc_info_set_vartypes(VarTypes, !ProcInfo),
proc_info_set_rtti_varmaps(RttiVarMaps, !ProcInfo).
-:- pred process_goal(hlds_goal::in, hlds_goal::out, info::in, info::out)
- is det.
+:- pred size_prof_process_goal(hlds_goal::in, hlds_goal::out,
+ info::in, info::out) is det.
-process_goal(Goal0, Goal, !Info) :-
+size_prof_process_goal(Goal0, Goal, !Info) :-
Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
(
GoalExpr0 = unify(LHS, RHS, UniMode, Unify0, UnifyContext),
(
Unify0 = construct(Var, ConsId, Args, ArgModes, How, Unique, _),
- process_construct(LHS, RHS, UniMode, UnifyContext, Var, ConsId,
- Args, ArgModes, How, Unique, GoalInfo0, GoalExpr, !Info)
+ size_prof_process_construct(LHS, RHS, UniMode, UnifyContext,
+ Var, ConsId, Args, ArgModes, How, Unique, GoalInfo0, GoalExpr,
+ !Info)
;
Unify0 = deconstruct(Var, ConsId, Args, ArgModes,
_CanFail, _CanCGC),
(
% The following test is an optimization. If
% BindingArgModes = [], which is almost 100% likely,
- % then process_deconstruct would return GoalExpr0 as
+ % then size_prof_process_deconstruct would return GoalExpr0 as
% GoalExpr anyway, but would take longer.
list.filter(binds_arg_in_cell(!.Info), ArgModes,
BindingArgModes),
BindingArgModes = [_ | _]
->
- process_deconstruct(Var, ConsId, Args, ArgModes,
+ size_prof_process_deconstruct(Var, ConsId, Args, ArgModes,
Goal0, GoalExpr, !Info)
;
GoalExpr = GoalExpr0
@@ -310,7 +313,7 @@
;
Unify0 = complicated_unify(_, _, _),
% These should have been expanded out by now.
- unexpected(this_file, "process_goal: complicated_unify")
+ unexpected(this_file, "size_prof_process_goal: complicated_unify")
)
;
GoalExpr0 = plain_call(_, _, _, _, _, _),
@@ -335,7 +338,7 @@
GoalExpr0 = conj(ConjType, Goals0),
(
ConjType = plain_conj,
- process_conj(Goals0, Goals, !Info)
+ size_prof_process_conj(Goals0, Goals, !Info)
;
ConjType = parallel_conj,
% This transformation produces code that is much less than
@@ -347,8 +350,8 @@
RevTypeInfoMap0 = !.Info ^ spi_rev_type_info_map,
TypeCtorMap0 = !.Info ^ spi_type_ctor_map,
KnownSizeMap0 = !.Info ^ spi_known_size_map,
- process_par_conj(Goals0, Goals, !Info, TargetTypeInfoMap0,
- TypeInfoMap0, TypeCtorMap0, KnownSizeMap0),
+ size_prof_process_par_conj(Goals0, Goals, !Info,
+ TargetTypeInfoMap0, TypeInfoMap0, TypeCtorMap0, KnownSizeMap0),
!:Info = !.Info ^ spi_target_type_info_map := TargetTypeInfoMap0,
!:Info = !.Info ^ spi_type_info_map := TypeInfoMap0,
!:Info = !.Info ^ spi_rev_type_info_map := RevTypeInfoMap0,
@@ -367,7 +370,7 @@
TypeCtorMap0 = !.Info ^ spi_type_ctor_map,
RevTypeCtorMap0 = !.Info ^ spi_rev_type_ctor_map,
KnownSizeMap0 = !.Info ^ spi_known_size_map,
- process_switch(First0, First, Later0, Later, !Info,
+ size_prof_process_switch(First0, First, Later0, Later, !Info,
TargetTypeInfoMap0,
TypeInfoMap0, RevTypeInfoMap0,
TypeCtorMap0, RevTypeCtorMap0,
@@ -381,7 +384,7 @@
Cases = [First | Later]
;
Cases0 = [],
- unexpected(this_file, "size_prof.process_goal: empty switch")
+ unexpected(this_file, "size_prof_process_goal: empty switch")
),
update_rev_maps(!Info),
update_target_map(!Info),
@@ -396,7 +399,7 @@
TypeCtorMap0 = !.Info ^ spi_type_ctor_map,
RevTypeCtorMap0 = !.Info ^ spi_rev_type_ctor_map,
KnownSizeMap0 = !.Info ^ spi_known_size_map,
- process_disj(First0, First, Later0, Later, !Info,
+ size_prof_process_disj(First0, First, Later0, Later, !Info,
TargetTypeInfoMap0,
TypeInfoMap0, RevTypeInfoMap0,
TypeCtorMap0, RevTypeCtorMap0,
@@ -430,9 +433,9 @@
KnownSizeMap0 = !.Info ^ spi_known_size_map,
!:Info = !.Info ^ spi_target_type_info_map := map.init,
- process_goal(Cond0, Cond, !Info),
+ size_prof_process_goal(Cond0, Cond, !Info),
!:Info = !.Info ^ spi_target_type_info_map := TargetTypeInfoMap0,
- process_goal(Then0, Then, !Info),
+ size_prof_process_goal(Then0, Then, !Info),
TargetTypeInfoMapThen = !.Info ^ spi_target_type_info_map,
TypeInfoMapThen = !.Info ^ spi_type_info_map,
KnownSizeMapThen = !.Info ^ spi_known_size_map,
@@ -445,7 +448,7 @@
!:Info = !.Info ^ spi_type_ctor_map := TypeCtorMap0,
!:Info = !.Info ^ spi_rev_type_ctor_map := RevTypeCtorMap0,
!:Info = !.Info ^ spi_known_size_map := KnownSizeMap0,
- process_goal(Else0, Else, !Info),
+ size_prof_process_goal(Else0, Else, !Info),
TypeInfoMapElse = !.Info ^ spi_type_info_map,
KnownSizeMapElse = !.Info ^ spi_known_size_map,
@@ -465,7 +468,7 @@
TypeCtorMap0 = !.Info ^ spi_type_ctor_map,
RevTypeCtorMap0 = !.Info ^ spi_rev_type_ctor_map,
KnownSizeMap0 = !.Info ^ spi_known_size_map,
- process_goal(NegGoal0, NegGoal, !Info),
+ size_prof_process_goal(NegGoal0, NegGoal, !Info),
% Variables constructed in negated goals are not available after the
% negated goal fails and the negation succeeds. The sizes we learn
% in NegGoal0 don't apply after NegGoal0 fails.
@@ -477,26 +480,34 @@
!:Info = !.Info ^ spi_known_size_map := KnownSizeMap0,
GoalExpr = negation(NegGoal)
;
- GoalExpr0 = scope(Reason, SomeGoal0),
- process_goal(SomeGoal0, SomeGoal, !Info),
- GoalExpr = scope(Reason, SomeGoal)
+ GoalExpr0 = scope(Reason0, SubGoal0),
+ % The code inside from_ground_term_construct scopes wants to construct
+ % terms statically, but for term size profiling, we need to construct
+ % terms dynamically,
+ ( Reason0 = from_ground_term(TermVar, from_ground_term_construct) ->
+ Reason = from_ground_term(TermVar, from_ground_term_other)
+ ;
+ Reason = Reason0
+ ),
+ size_prof_process_goal(SubGoal0, SubGoal, !Info),
+ GoalExpr = scope(Reason, SubGoal)
;
GoalExpr0 = shorthand(_),
- unexpected(this_file, "size_prof.process_goal: shorthand")
+ unexpected(this_file, "size_prof_process_goal: shorthand")
),
Goal = hlds_goal(GoalExpr, GoalInfo0).
%---------------------------------------------------------------------------%
-:- pred process_conj(list(hlds_goal)::in, list(hlds_goal)::out,
+:- pred size_prof_process_conj(list(hlds_goal)::in, list(hlds_goal)::out,
info::in, info::out) is det.
-process_conj([], [], !Info).
-process_conj([Goal0 | Goals0], Conj, !Info) :-
- process_goal(Goal0, Goal, !Info),
- process_conj(Goals0, Goals, !Info),
+size_prof_process_conj([], [], !Info).
+size_prof_process_conj([Goal0 | Goals0], Conj, !Info) :-
+ size_prof_process_goal(Goal0, Goal, !Info),
+ size_prof_process_conj(Goals0, Goals, !Info),
( Goal = hlds_goal(conj(plain_conj, SubConj), _) ->
- % Flatten out any conjunction introduced by process_goal.
+ % Flatten out any conjunction introduced by size_prof_process_goal.
% We never create conjunctions more than one level deep,
% so this single test is sufficient to ensure that we never
% leave conjunctions nested more deeply than the input goal.
@@ -507,30 +518,30 @@
%---------------------------------------------------------------------------%
-:- pred process_par_conj(list(hlds_goal)::in, list(hlds_goal)::out,
+:- pred size_prof_process_par_conj(list(hlds_goal)::in, list(hlds_goal)::out,
info::in, info::out, type_info_map::in, type_info_map::in,
type_ctor_map::in, known_size_map::in) is det.
-process_par_conj([], [], !Info, _, _, _, _).
-process_par_conj([Goal0 | Goals0], [Goal | Goals], !Info, TargetTypeInfoMap0,
- TypeInfoMap0, TypeCtorMap0, KnownSizeMap0) :-
+size_prof_process_par_conj([], [], !Info, _, _, _, _).
+size_prof_process_par_conj([Goal0 | Goals0], [Goal | Goals], !Info,
+ TargetTypeInfoMap0, TypeInfoMap0, TypeCtorMap0, KnownSizeMap0) :-
!:Info = !.Info ^ spi_target_type_info_map := TargetTypeInfoMap0,
!:Info = !.Info ^ spi_type_info_map := TypeInfoMap0,
!:Info = !.Info ^ spi_type_ctor_map := TypeCtorMap0,
!:Info = !.Info ^ spi_known_size_map := KnownSizeMap0,
- process_goal(Goal0, Goal, !Info),
- process_par_conj(Goals0, Goals, !Info, TargetTypeInfoMap0,
- TypeInfoMap0, TypeCtorMap0, KnownSizeMap0).
+ size_prof_process_goal(Goal0, Goal, !Info),
+ size_prof_process_par_conj(Goals0, Goals, !Info,
+ TargetTypeInfoMap0, TypeInfoMap0, TypeCtorMap0, KnownSizeMap0).
%---------------------------------------------------------------------------%
-:- pred process_disj(hlds_goal::in, hlds_goal::out,
+:- pred size_prof_process_disj(hlds_goal::in, hlds_goal::out,
list(hlds_goal)::in, list(hlds_goal)::out, info::in, info::out,
type_info_map::in, type_info_map::in, rev_type_info_map::in,
type_ctor_map::in, rev_type_ctor_map::in,
type_info_map::out, known_size_map::in, known_size_map::out) is det.
-process_disj(First0, First, Later0, Later, !Info, TargetTypeInfoMap,
+size_prof_process_disj(First0, First, Later0, Later, !Info, TargetTypeInfoMap,
TypeInfoMap0, RevTypeInfoMap0, TypeCtorMap0, RevTypeCtorMap0,
TypeInfoMap, KnownSizeMap0, KnownSizeMap) :-
!:Info = !.Info ^ spi_type_info_map := TypeInfoMap0,
@@ -538,7 +549,7 @@
!:Info = !.Info ^ spi_type_ctor_map := TypeCtorMap0,
!:Info = !.Info ^ spi_rev_type_ctor_map := RevTypeCtorMap0,
!:Info = !.Info ^ spi_known_size_map := KnownSizeMap0,
- process_goal(First0, First, !Info),
+ size_prof_process_goal(First0, First, !Info),
TypeInfoMapFirst = !.Info ^ spi_type_info_map,
KnownSizeMapFirst = !.Info ^ spi_known_size_map,
(
@@ -546,7 +557,8 @@
map.union(select_first, TypeInfoMapFirst,
TargetTypeInfoMap, LaterTargetTypeInfoMap),
!:Info = !.Info ^ spi_target_type_info_map := LaterTargetTypeInfoMap,
- process_disj(Head0, Head, Tail0, Tail, !Info, TargetTypeInfoMap,
+ size_prof_process_disj(Head0, Head, Tail0, Tail, !Info,
+ TargetTypeInfoMap,
TypeInfoMap0, RevTypeInfoMap0, TypeCtorMap0, RevTypeCtorMap0,
TypeInfoMapLater, KnownSizeMap0, KnownSizeMapLater),
TypeInfoMap = map.common_subset(TypeInfoMapFirst, TypeInfoMapLater),
@@ -561,14 +573,15 @@
%---------------------------------------------------------------------------%
-:- pred process_switch(case::in, case::out,
+:- pred size_prof_process_switch(case::in, case::out,
list(case)::in, list(case)::out, info::in, info::out,
type_info_map::in, type_info_map::in, rev_type_info_map::in,
type_ctor_map::in, rev_type_ctor_map::in,
type_info_map::out, known_size_map::in, known_size_map::out) is det.
-process_switch(First0, First, Later0, Later, !Info, TargetTypeInfoMap,
- TypeInfoMap0, RevTypeInfoMap0, TypeCtorMap0, RevTypeCtorMap0,
+size_prof_process_switch(First0, First, Later0, Later, !Info,
+ TargetTypeInfoMap, TypeInfoMap0, RevTypeInfoMap0,
+ TypeCtorMap0, RevTypeCtorMap0,
TypeInfoMap, KnownSizeMap0, KnownSizeMap) :-
!:Info = !.Info ^ spi_type_info_map := TypeInfoMap0,
!:Info = !.Info ^ spi_rev_type_info_map := RevTypeInfoMap0,
@@ -576,7 +589,7 @@
!:Info = !.Info ^ spi_rev_type_ctor_map := RevTypeCtorMap0,
!:Info = !.Info ^ spi_known_size_map := KnownSizeMap0,
First0 = case(FirstMainConsId, FirstOtherConsIds, FirstGoal0),
- process_goal(FirstGoal0, FirstGoal, !Info),
+ size_prof_process_goal(FirstGoal0, FirstGoal, !Info),
TypeInfoMapFirst = !.Info ^ spi_type_info_map,
KnownSizeMapFirst = !.Info ^ spi_known_size_map,
First = case(FirstMainConsId, FirstOtherConsIds, FirstGoal),
@@ -585,8 +598,9 @@
map.union(select_first, TargetTypeInfoMap,
TypeInfoMapFirst, LaterTargetTypeInfoMap),
!:Info = !.Info ^ spi_target_type_info_map := LaterTargetTypeInfoMap,
- process_switch(Head0, Head, Tail0, Tail, !Info, TargetTypeInfoMap,
- TypeInfoMap0, RevTypeInfoMap0, TypeCtorMap0, RevTypeCtorMap0,
+ size_prof_process_switch(Head0, Head, Tail0, Tail, !Info,
+ TargetTypeInfoMap, TypeInfoMap0, RevTypeInfoMap0,
+ TypeCtorMap0, RevTypeCtorMap0,
TypeInfoMapLater, KnownSizeMap0, KnownSizeMapLater),
TypeInfoMap = map.common_subset(TypeInfoMapFirst, TypeInfoMapLater),
KnownSizeMap = map.common_subset(KnownSizeMapFirst, KnownSizeMapLater),
@@ -600,13 +614,14 @@
%---------------------------------------------------------------------------%
-:- pred process_construct(prog_var::in, unify_rhs::in, unify_mode::in,
- unify_context::in, prog_var::in, cons_id::in, list(prog_var)::in,
- list(uni_mode)::in, how_to_construct::in, cell_is_unique::in,
- hlds_goal_info::in, hlds_goal_expr::out, info::in, info::out) is det.
+:- pred size_prof_process_construct(prog_var::in, unify_rhs::in,
+ unify_mode::in, unify_context::in, prog_var::in, cons_id::in,
+ list(prog_var)::in, list(uni_mode)::in, how_to_construct::in,
+ cell_is_unique::in, hlds_goal_info::in, hlds_goal_expr::out,
+ info::in, info::out) is det.
-process_construct(LHS, RHS, UniMode, UnifyContext, Var, ConsId, Args, ArgModes,
- How, Unique, GoalInfo, GoalExpr, !Info) :-
+size_prof_process_construct(LHS, RHS, UniMode, UnifyContext, Var, ConsId,
+ Args, ArgModes, How, Unique, GoalInfo, GoalExpr, !Info) :-
map.lookup(!.Info ^ spi_vartypes, Var, VarType),
( type_to_ctor_and_args(VarType, VarTypeCtorPrime, _VarTypeArgs) ->
VarTypeCtor = VarTypeCtorPrime
@@ -635,13 +650,15 @@
% TypeInfo_for_K as type_info, not type_ctor_info.
record_known_type_ctor_info(Var, M, N, A, !Info)
;
- unexpected(this_file, "process_construct: bad type_info")
+ unexpected(this_file,
+ "size_prof_process_construct: bad type_info")
)
; VarTypeCtorName = "type_ctor_info" ->
( ConsId = type_ctor_info_const(M, N, A) ->
record_known_type_ctor_info(Var, M, N, A, !Info)
;
- unexpected(this_file, "process_construct: bad type_ctor_info")
+ unexpected(this_file,
+ "size_prof_process_construct: bad type_ctor_info")
)
;
!:Info = !.Info
@@ -653,8 +670,9 @@
ConsId = cons(_Name, _Arity),
Args = [_ | _]
->
- process_cons_construct(LHS, RHS, UniMode, UnifyContext, Var, VarType,
- ConsId, Args, ArgModes, How, Unique, GoalInfo, GoalExpr, !Info)
+ size_prof_process_cons_construct(LHS, RHS, UniMode, UnifyContext,
+ Var, VarType, ConsId, Args, ArgModes, How, Unique,
+ GoalInfo, GoalExpr, !Info)
;
% All ConsIds other than cons/2 with at least one argument
% construct terms that we consider zero-sized.
@@ -666,17 +684,19 @@
%-----------------------------------------------------------------------------%
-:- pred process_deconstruct(prog_var::in, cons_id::in, list(prog_var)::in,
- list(uni_mode)::in, hlds_goal::in, hlds_goal_expr::out,
+:- pred size_prof_process_deconstruct(prog_var::in, cons_id::in,
+ list(prog_var)::in, list(uni_mode)::in, hlds_goal::in, hlds_goal_expr::out,
info::in, info::out) is det.
-process_deconstruct(Var, ConsId, Args, ArgModes, Goal0, GoalExpr, !Info) :-
+size_prof_process_deconstruct(Var, ConsId, Args, ArgModes, Goal0, GoalExpr,
+ !Info) :-
map.lookup(!.Info ^ spi_vartypes, Var, VarType),
( type_to_ctor_and_args(VarType, VarTypeCtorPrime, _VarTypeArgs) ->
VarTypeCtor = VarTypeCtorPrime
;
unexpected(this_file,
- "process_deconstruct: deconstructing term of variable type")
+ "size_prof_process_deconstruct: " ++
+ "deconstructing term of variable type")
),
ModuleInfo = !.Info ^ spi_module_info,
VarTypeCtorModule = type_ctor_module(ModuleInfo, VarTypeCtor),
@@ -689,7 +709,8 @@
ConsId = cons(_Name, _Arity),
Args = [_ | _]
->
- process_cons_deconstruct(Var, Args, ArgModes, Goal0, GoalExpr, !Info)
+ size_prof_process_cons_deconstruct(Var, Args, ArgModes, Goal0,
+ GoalExpr, !Info)
;
% All ConsIds other than cons/2 deconstruct terms that we
% consider zero-sized.
@@ -699,23 +720,23 @@
%-----------------------------------------------------------------------------%
-:- pred process_cons_construct(prog_var::in, unify_rhs::in, unify_mode::in,
- unify_context::in, prog_var::in, mer_type::in, cons_id::in,
+:- pred size_prof_process_cons_construct(prog_var::in, unify_rhs::in,
+ unify_mode::in, unify_context::in, prog_var::in, mer_type::in, cons_id::in,
list(prog_var)::in, list(uni_mode)::in, how_to_construct::in,
cell_is_unique::in, hlds_goal_info::in, hlds_goal_expr::out,
info::in, info::out) is det.
-process_cons_construct(LHS, RHS, UniMode, UnifyContext, Var, _Type, ConsId,
- Args, ArgModes, How, Unique, GoalInfo0, GoalExpr, !Info) :-
+size_prof_process_cons_construct(LHS, RHS, UniMode, UnifyContext, Var, _Type,
+ ConsId, Args, ArgModes, How, Unique, GoalInfo0, GoalExpr, !Info) :-
FunctorSize = compute_functor_size(Args, !.Info),
find_defined_args(Args, ArgModes, DefinedArgs, NonDefinedArgs, !.Info),
Context = goal_info_get_context(GoalInfo0),
- process_args(DefinedArgs, FunctorSize, KnownSize,
+ size_prof_process_args(DefinedArgs, FunctorSize, KnownSize,
no, MaybeDynamicSizeVar, Context, ArgGoals, !Info),
(
MaybeDynamicSizeVar = no,
expect(unify(ArgGoals, []), this_file,
- "process_cons_construct: nonempty ArgGoals"),
+ "size_prof_process_cons_construct: nonempty ArgGoals"),
(
NonDefinedArgs = [],
record_known_size(Var, KnownSize, !Info)
@@ -745,20 +766,21 @@
%-----------------------------------------------------------------------------%
-:- pred process_cons_deconstruct(prog_var::in, list(prog_var)::in,
+:- pred size_prof_process_cons_deconstruct(prog_var::in, list(prog_var)::in,
list(uni_mode)::in, hlds_goal::in, hlds_goal_expr::out,
info::in, info::out) is det.
-process_cons_deconstruct(Var, Args, ArgModes, UnifyGoal, GoalExpr, !Info) :-
+size_prof_process_cons_deconstruct(Var, Args, ArgModes, UnifyGoal, GoalExpr,
+ !Info) :-
find_defined_args(Args, ArgModes, DefinedArgs, _NonDefArgs, !.Info),
UnifyGoal = hlds_goal(GoalExpr0, GoalInfo0),
Context = goal_info_get_context(GoalInfo0),
- process_args(DefinedArgs, 0, KnownSize,
+ size_prof_process_args(DefinedArgs, 0, KnownSize,
no, MaybeDynamicSizeVar, Context, ArgGoals, !Info),
(
MaybeDynamicSizeVar = no,
expect(unify(ArgGoals, []), this_file,
- "process_cons_deconstruct: nonempty ArgGoals"),
+ "size_prof_process_cons_deconstruct: nonempty ArgGoals"),
GoalExpr = GoalExpr0
;
MaybeDynamicSizeVar = yes(SizeVar0),
@@ -787,12 +809,13 @@
% of the size only if the sum of the arguments' sizes is not static.
% In that case, the Goals we return will be nonempty.
%
-:- pred process_args(list(prog_var)::in, int::in, int::out,
+:- pred size_prof_process_args(list(prog_var)::in, int::in, int::out,
maybe(prog_var)::in, maybe(prog_var)::out, prog_context::in,
list(hlds_goal)::out, info::in, info::out) is det.
-process_args([], !KnownSize, !MaybeSizeVar, _, [], !Info).
-process_args([Arg | Args], !KnownSize, !MaybeSizeVar, Context, Goals, !Info) :-
+size_prof_process_args([], !KnownSize, !MaybeSizeVar, _, [], !Info).
+size_prof_process_args([Arg | Args], !KnownSize, !MaybeSizeVar, Context, Goals,
+ !Info) :-
map.lookup(!.Info ^ spi_vartypes, Arg, Type),
( map.search(!.Info ^ spi_known_size_map, Arg, ArgSize) ->
!:KnownSize = !.KnownSize + ArgSize,
@@ -805,8 +828,9 @@
!Info),
list.append(TypeInfoGoals, [SizeGoal], ArgGoals)
),
- process_args(Args, !KnownSize, !MaybeSizeVar, Context, LaterGoals, !Info),
- list.append(ArgGoals, LaterGoals, Goals).
+ size_prof_process_args(Args, !KnownSize, !MaybeSizeVar, Context,
+ LaterGoals, !Info),
+ Goals = ArgGoals ++ LaterGoals.
%-----------------------------------------------------------------------------%
@@ -1063,9 +1087,9 @@
%
% We override any old settings here, for use in the rest of the current
% branch. Other branches will do likewise. The correct handling of the code
- % after the branched structure is ensured by process_goal returning only
- % the common subsets of the maps constructed by the various branches to
- % be used when processing the following code.
+ % after the branched structure is ensured by size_prof_process_goal
+ % returning only the common subsets of the maps constructed by the
+ % various branches to be used when processing the following code.
%
:- pred record_known_type_ctor_info(prog_var::in, module_name::in, string::in,
int::in, info::in, info::out) is det.
@@ -1268,11 +1292,11 @@
;
Args = [],
Modes = [_ | _],
- unexpected(this_file, "size_prof.find_defined_args: length mismatch")
+ unexpected(this_file, "size_prof_find_defined_args: length mismatch")
;
Args = [_ | _],
Modes = [],
- unexpected(this_file, "size_prof.find_defined_args: length mismatch")
+ unexpected(this_file, "size_prof_find_defined_args: length mismatch")
;
Args = [FirstArg | LaterArgs],
Modes = [FirstMode | LaterModes],
@@ -1289,8 +1313,8 @@
:- pred binds_arg_in_cell(info::in, uni_mode::in) is semidet.
-binds_arg_in_cell(Info, (CellInitInst - _ArgInitInst) ->
- (CellFinalInst - _ArgFinalInst)) :-
+binds_arg_in_cell(Info,
+ (CellInitInst - _ArgInitInst) -> (CellFinalInst - _ArgFinalInst)) :-
ModuleInfo = Info ^ spi_module_info,
inst_is_free(ModuleInfo, CellInitInst),
inst_is_bound(ModuleInfo, CellFinalInst).
Index: compiler/ssdebug.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ssdebug.m,v
retrieving revision 1.17
diff -u -b -r1.17 ssdebug.m
--- compiler/ssdebug.m 27 Feb 2008 07:23:14 -0000 1.17
+++ compiler/ssdebug.m 11 Dec 2008 15:53:48 -0000
@@ -237,7 +237,6 @@
process_proc_failure(PredId, ProcId, !ProcInfo, !ModuleInfo, !IO)
).
-
% Source-to-source transformation for a deterministic goal.
%
:- pred process_proc_det(pred_id::in, proc_id::in,
@@ -329,7 +328,6 @@
!ModuleInfo, !.Varset, !.Vartypes)
).
-
% Source-to-source transformation for a semidet goal.
%
:- pred process_proc_semi(pred_id::in, proc_id::in,
@@ -483,7 +481,6 @@
)
).
-
% Source-to-source transformation for a nondeterministic procedure.
%
:- pred process_proc_nondet(pred_id::in, proc_id::in,
@@ -615,7 +612,6 @@
!ModuleInfo, !.Varset, !.Vartypes)
).
-
% Source-to-source transformation for a failure procedure.
%
:- pred process_proc_failure(pred_id::in, proc_id::in,
@@ -705,7 +701,6 @@
!ModuleInfo, !.Varset, !.Vartypes)
).
-
% Source-to-source transformation for an erroneous procedure.
% XXX ERRONEOUS procedure have currently just a call port.
%
@@ -764,7 +759,6 @@
%-----------------------------------------------------------------------------%
-
% Create the output variable DoRetry.
%
:- pred make_retry_var(string::in, prog_var::out,
@@ -777,7 +771,6 @@
svvarset.new_named_var(VarName, RetryVar, !VarSet),
svmap.det_insert(RetryVar, RetryType, !VarTypes).
-
% Create the goal for recursive call in the case of a retry.
%
:- pred make_recursive_call(pred_info::in, module_info::in, pred_id::in,
@@ -792,7 +785,6 @@
goal_info_init(GoalInfoHG),
Goal = hlds_goal(GoalExpr, GoalInfoHG).
-
% make_switch_goal(SwitchVar, SwitchCase1, SwitchCase2, GoalInfo, Goal).
%
% Create an output Goal, which is a switch with following pattern :
@@ -818,7 +810,6 @@
switch(SwitchVar, cannot_fail, [CaseDoRetry, CaseDoNotRetry]),
GoalInfo).
-
% wrap_with_purity_scope(Purity, GoalInfo, Goal0, Goal):
%
% The Goal0 is wrap with the Purity to give Goal.
@@ -831,7 +822,6 @@
ScopeReason = promise_purity(dont_make_implicit_promises, Purity),
Goal = hlds_goal(scope(ScopeReason, GoalWithoutPurity), GoalInfo).
-
% Update the proc_info and pred_info with the result of the
% source-to-source transformation.
%
@@ -851,7 +841,6 @@
repuritycheck_proc(!.ModuleInfo, proc(PredId, ProcId), !PredInfo),
module_info_set_pred_info(PredId, !.PredInfo, !ModuleInfo).
-
%-----------------------------------------------------------------------------%
% Build the following goal : handle_event_EVENT(ProcId, Arguments).
@@ -873,7 +862,6 @@
Arguments, Features, InstMapSrc, !.ModuleInfo, Context,
HandleEventGoal).
-
% make_proc_id_construction(PredInfo, Goals, Var, !Varset, !Vartypes)
%
% Returns a set of goals, Goals, which build the ssdb_proc_id structure
@@ -907,7 +895,6 @@
Goals = [ConstructModuleName, ConstructPredName, ConstructProcIdGoal].
-
% make_fail_call(FailGoal, ModuleInfo)
%
% Construct the fail goal.
@@ -922,7 +909,6 @@
"false", pf_predicate, only_mode, detism_failure, purity_pure,
[], Features, InstMapSrc, ModuleInfo, Context, FailGoal).
-
% Detect if all argument's mode are fully input or output.
% XXX Other mode than fully input or output are not handled for the
% moment. So the code of these procedures will not be generated.
@@ -1004,7 +990,6 @@
%XXX Optimize me: repeated appends are slow.
Goals = Goals0 ++ ValueGoals ++ [Goal].
-
% Return the type list(var_value).
%
:- func list_var_value_type = mer_type.
@@ -1017,7 +1002,6 @@
ListTypeCtor = type_ctor(qualified(unqualified("list"), "list"), 1),
construct_type(ListTypeCtor, [VarValueType], ListVarValueType).
-
% Create the goal's argument description :
% -> unbound_head_var(Name, Pos) if it is an unbound argument
% -> bound_head_var(type_of_T, Name, Position, T) if it is a bound argument
Index: compiler/stm_expand.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/stm_expand.m,v
retrieving revision 1.1
diff -u -b -r1.1 stm_expand.m
--- compiler/stm_expand.m 27 Feb 2008 07:23:15 -0000 1.1
+++ compiler/stm_expand.m 11 Dec 2008 15:53:48 -0000
@@ -330,18 +330,23 @@
;
GoalExpr0 = scope(Reason, InnerGoal0),
(
+ Reason = from_ground_term(_, from_ground_term_construct),
+ % There can be no atomic goals inside this scope.
+ Goal = Goal0
+ ;
( Reason = exist_quant(_)
; Reason = promise_solutions(_, _)
; Reason = promise_purity(_, _)
; Reason = commit(_)
; Reason = barrier(_)
- ; Reason = from_ground_term(_)
+ ; Reason = from_ground_term(_, from_ground_term_deconstruct)
+ ; Reason = from_ground_term(_, from_ground_term_other)
; 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,
@@ -514,8 +519,8 @@
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),
+ instmap_lookup_var(InitInstmap, Var, InitVarInst),
+ instmap_lookup_var(FinalInstmap, Var, FinalVarInst),
(
inst_is_free(ModuleInfo, InitVarInst),
inst_is_free(ModuleInfo, FinalVarInst)
Index: compiler/store_alloc.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/store_alloc.m,v
retrieving revision 1.109
diff -u -b -r1.109 store_alloc.m
--- compiler/store_alloc.m 29 Jan 2008 04:59:43 -0000 1.109
+++ compiler/store_alloc.m 12 Dec 2008 00:33:56 -0000
@@ -144,13 +144,14 @@
set.difference(Liveness0, PreDeaths, Liveness1),
set.union(Liveness1, PreBirths, Liveness2),
store_alloc_in_goal_2(GoalExpr0, GoalExpr, Liveness2, Liveness3,
- !LastLocns, ResumeVars0, StoreAllocInfo),
+ !LastLocns, ResumeVars0, BranchedGoal, StoreAllocInfo),
set.difference(Liveness3, PostDeaths, Liveness4),
% If any variables magically become live in the PostBirths,
% then they have to mundanely become live in a parallel goal,
% so we don't need to allocate anything for them here.
set.union(Liveness4, PostBirths, Liveness),
- ( goal_util.goal_is_branched(GoalExpr) ->
+ (
+ BranchedGoal = is_branched_goal,
% Any variables that become magically live at the
% end of the goal should not be included in the store map.
% That is why we use Liveness4 instead of Liveness here.
@@ -165,20 +166,25 @@
AdvisoryStoreMap, StoreMap),
goal_info_set_store_map(StoreMap, GoalInfo0, GoalInfo)
;
+ BranchedGoal = is_not_branched_goal,
GoalInfo = GoalInfo0
).
%-----------------------------------------------------------------------------%
+:- type branched_goal
+ ---> is_branched_goal
+ ; is_not_branched_goal.
+
% Here we process each of the different sorts of goals.
%
:- pred store_alloc_in_goal_2(hlds_goal_expr::in, hlds_goal_expr::out,
liveness_info::in, liveness_info::out,
- last_locns::in, last_locns::out, set(prog_var)::in,
+ last_locns::in, last_locns::out, set(prog_var)::in, branched_goal::out,
store_alloc_info::in) is det.
store_alloc_in_goal_2(GoalExpr0, GoalExpr, !Liveness, !LastLocns,
- ResumeVars0, StoreAllocInfo) :-
+ ResumeVars0, BranchedGoal, StoreAllocInfo) :-
(
GoalExpr0 = conj(ConjType, Goals0),
(
@@ -190,27 +196,22 @@
store_alloc_in_par_conj(Goals0, Goals, !Liveness, !LastLocns,
ResumeVars0, StoreAllocInfo)
),
- GoalExpr = conj(ConjType, Goals)
+ GoalExpr = conj(ConjType, Goals),
+ BranchedGoal = is_not_branched_goal
;
GoalExpr0 = disj(Goals0),
store_alloc_in_disj(Goals0, Goals, !Liveness,
!.LastLocns, LastLocnsList, ResumeVars0, StoreAllocInfo),
merge_last_locations(LastLocnsList, !:LastLocns),
- GoalExpr = disj(Goals)
- ;
- GoalExpr0 = negation(SubGoal0),
- SubGoal0 = hlds_goal(_, SubGoalInfo0),
- goal_info_get_resume_point(SubGoalInfo0, ResumeNot),
- goal_info_resume_vars_and_loc(ResumeNot, ResumeNotVars, _),
- store_alloc_in_goal(SubGoal0, SubGoal, !Liveness, !.LastLocns, _,
- ResumeNotVars, StoreAllocInfo),
- GoalExpr = negation(SubGoal)
+ GoalExpr = disj(Goals),
+ BranchedGoal = is_branched_goal
;
GoalExpr0 = switch(Var, Det, Cases0),
store_alloc_in_cases(Cases0, Cases, !Liveness,
!.LastLocns, LastLocnsList, ResumeVars0, StoreAllocInfo),
merge_last_locations(LastLocnsList, !:LastLocns),
- GoalExpr = switch(Var, Det, Cases)
+ GoalExpr = switch(Var, Det, Cases),
+ BranchedGoal = is_branched_goal
;
GoalExpr0 = if_then_else(Vars, Cond0, Then0, Else0),
Liveness0 = !.Liveness,
@@ -229,19 +230,36 @@
!:Liveness = Liveness,
!:LastLocns = LastLocns,
- GoalExpr = if_then_else(Vars, Cond, Then, Else)
+ GoalExpr = if_then_else(Vars, Cond, Then, Else),
+ BranchedGoal = is_branched_goal
+ ;
+ GoalExpr0 = negation(SubGoal0),
+ SubGoal0 = hlds_goal(_, SubGoalInfo0),
+ goal_info_get_resume_point(SubGoalInfo0, ResumeNot),
+ goal_info_resume_vars_and_loc(ResumeNot, ResumeNotVars, _),
+ store_alloc_in_goal(SubGoal0, SubGoal, !Liveness, !.LastLocns, _,
+ ResumeNotVars, StoreAllocInfo),
+ GoalExpr = negation(SubGoal),
+ BranchedGoal = is_not_branched_goal
+ ;
+ GoalExpr0 = scope(Reason, SubGoal0),
+ ( Reason = from_ground_term(TermVar, from_ground_term_construct) ->
+ GoalExpr = GoalExpr0,
+ set.insert(!.Liveness, TermVar, !:Liveness)
;
- GoalExpr0 = scope(Remove, SubGoal0),
store_alloc_in_goal(SubGoal0, SubGoal, !Liveness, !LastLocns,
ResumeVars0, StoreAllocInfo),
- GoalExpr = scope(Remove, SubGoal)
+ GoalExpr = scope(Reason, SubGoal)
+ ),
+ BranchedGoal = is_not_branched_goal
;
( GoalExpr0 = generic_call(_, _, _, _)
; GoalExpr0 = plain_call(_, _, _, _, _, _)
; GoalExpr0 = unify(_, _, _, _, _)
; GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _)
),
- GoalExpr = GoalExpr0
+ GoalExpr = GoalExpr0,
+ BranchedGoal = is_not_branched_goal
;
GoalExpr0 = shorthand(_),
% These should have been expanded out by now.
Index: compiler/stratify.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/stratify.m,v
retrieving revision 1.67
diff -u -b -r1.67 stratify.m
--- compiler/stratify.m 27 Feb 2008 07:23:15 -0000 1.67
+++ compiler/stratify.m 11 Dec 2008 15:53:48 -0000
@@ -16,12 +16,12 @@
% of the scc. If it encounters a higher order call or a call to an
% outside module it will also emit a message.
%
-% It has a second pass which is not currently enabled
+% It has a second pass which is not currently enabled.
%
% The second pass looks for possible non stratified code by looking at
% higher order calls. This second pass works by rebuilding the call
% graph with any possible arcs that can arise though higher order calls
-% and then traversing the new sccs looking for negative loops
+% and then traversing the new sccs looking for negative loops.
%
% The second pass is necessary because the rebuilt call graph does not
% allow the detection of definite non-stratification.
@@ -192,9 +192,14 @@
first_order_check_goal(SubGoal, yes, WholeScc,
ThisPredProcId, Error, !ModuleInfo, !IO)
;
- GoalExpr = scope(_, SubGoal),
+ GoalExpr = scope(Reason, SubGoal),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ % These scopes cannot contain any calls.
+ true
+ ;
first_order_check_goal(SubGoal, Negated, WholeScc,
ThisPredProcId, Error, !ModuleInfo, !IO)
+ )
;
( GoalExpr = plain_call(CPred, CProc, _Args, _BuiltinState, _UC, _Sym)
; GoalExpr = call_foreign_proc(_Attributes, CPred, CProc, _, _, _, _)
@@ -334,9 +339,14 @@
higher_order_check_goal(SubGoal, yes, WholeScc,
ThisPredProcId, HighOrderLoops, Error, !ModuleInfo, !IO)
;
- GoalExpr = scope(_, SubGoal),
+ GoalExpr = scope(Reason, SubGoal),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ % These scopes cannot contain any calls.
+ true
+ ;
higher_order_check_goal(SubGoal, Negated, WholeScc,
ThisPredProcId, HighOrderLoops, Error, !ModuleInfo, !IO)
+ )
;
GoalExpr = plain_call(_CPred, _CProc, _Args, _Builtin, _UC, Sym),
(
@@ -604,7 +614,7 @@
add_new_arcs2(Cs, CallerKey, !DepGraph).
% For each given pred id, pass all non imported procs onto the
- % process_procs predicate.
+ % stratify_process_procs predicate.
%
:- pred expand_predids(list(pred_id)::in, module_info::in,
call_map::in, call_map::out, ho_map::in, ho_map::out,
@@ -617,26 +627,38 @@
Procs = pred_info_non_imported_procids(PredInfo),
pred_info_get_procedures(PredInfo, ProcTable),
pred_info_get_arg_types(PredInfo, ArgTypes),
- process_procs(Procs, ModuleInfo, PredId, ArgTypes, ProcTable,
+ stratify_process_procs(Procs, ModuleInfo, PredId, ArgTypes, ProcTable,
!ProcCalls, !HOInfo, !CallsHO),
expand_predids(PredIds, ModuleInfo, !ProcCalls, !HOInfo, !CallsHO).
% For each given proc id, generate the set of procedures it calls
% and its higher order info structure.
%
-:- pred process_procs(list(proc_id)::in, module_info::in, pred_id::in,
+:- pred stratify_process_procs(list(proc_id)::in, module_info::in, pred_id::in,
list(mer_type)::in, proc_table::in, call_map::in, call_map::out,
ho_map::in, ho_map::out, set(pred_proc_id)::in, set(pred_proc_id)::out)
is det.
-process_procs([], _, _, _, _, !ProcCalls, !HOInfo, !CallsHO).
-process_procs([ProcId | Procs], ModuleInfo, PredId, ArgTypes, ProcTable,
+stratify_process_procs([], _, _, _, _, !ProcCalls, !HOInfo, !CallsHO).
+stratify_process_procs([ProcId | ProcIds], ModuleInfo, PredId, ArgTypes,
+ ProcTable, !ProcCalls, !HOInfo, !CallsHO) :-
+ stratify_process_proc(ProcId, ModuleInfo, PredId, ArgTypes, ProcTable,
+ !ProcCalls, !HOInfo, !CallsHO),
+ stratify_process_procs(ProcIds, ModuleInfo, PredId, ArgTypes, ProcTable,
+ !ProcCalls, !HOInfo, !CallsHO).
+
+:- pred stratify_process_proc(proc_id::in, module_info::in, pred_id::in,
+ list(mer_type)::in, proc_table::in, call_map::in, call_map::out,
+ ho_map::in, ho_map::out, set(pred_proc_id)::in, set(pred_proc_id)::out)
+ is det.
+
+stratify_process_proc(ProcId, ModuleInfo, PredId, ArgTypes, ProcTable,
!ProcCalls, !HOInfo, !CallsHO) :-
map.lookup(ProcTable, ProcId, ProcInfo),
proc_info_get_argmodes(ProcInfo, ArgModes),
proc_info_get_goal(ProcInfo, Goal),
PredProcId = proc(PredId, ProcId),
- check_proc_body(Goal, Calls, HaveAT, CallsHigherOrder),
+ stratify_analyze_proc_body(Goal, Calls, HaveAT, CallsHigherOrder),
map.det_insert(!.ProcCalls, PredProcId, Calls, !:ProcCalls),
higherorder_in_out(ArgTypes, ArgModes, ModuleInfo, HOInOut),
map.det_insert(!.HOInfo, PredProcId, info(HaveAT, HOInOut), !:HOInfo),
@@ -645,9 +667,7 @@
set.insert(!.CallsHO, PredProcId, !:CallsHO)
;
CallsHigherOrder = no
- ),
- process_procs(Procs, ModuleInfo, PredId, ArgTypes, ProcTable,
- !ProcCalls, !HOInfo, !CallsHO).
+ ).
% Determine if a given set of modes and types indicates that
% higher order values can be passed into and/or out of a procedure.
@@ -697,20 +717,21 @@
% Return the set of all procedures called in the given goal
% and all addresses taken in the given goal.
%
-:- pred check_proc_body(hlds_goal::in, set(pred_proc_id)::out,
+:- pred stratify_analyze_proc_body(hlds_goal::in, set(pred_proc_id)::out,
set(pred_proc_id)::out, bool::out) is det.
-check_proc_body(Goal, Calls, TakenAddrs, CallsHO) :-
+stratify_analyze_proc_body(Goal, Calls, TakenAddrs, CallsHO) :-
set.init(Calls0),
set.init(TakenAddrs0),
- check_goal(Goal, Calls0, Calls, TakenAddrs0, TakenAddrs, no, CallsHO).
+ stratify_analyze_goal(Goal, Calls0, Calls, TakenAddrs0, TakenAddrs,
+ no, CallsHO).
-:- pred check_goal(hlds_goal::in,
+:- pred stratify_analyze_goal(hlds_goal::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_goal(Goal, !Calls, !HasAT, !CallsHO) :-
+stratify_analyze_goal(Goal, !Calls, !HasAT, !CallsHO) :-
Goal = hlds_goal(GoalExpr, _GoalInfo),
(
GoalExpr = unify(_Var, RHS, _Mode, Unification, _Context),
@@ -750,7 +771,7 @@
% Do nothing.
;
Unification = complicated_unify(_, _, _),
- unexpected(this_file, "check_goal: complicated_unify")
+ unexpected(this_file, "stratify_analyze_goal: complicated_unify")
)
;
GoalExpr = plain_call(CPred, CProc, _Args, _Builtin, _UC, _Sym),
@@ -769,53 +790,60 @@
( GoalExpr = conj(_ConjType, Goals)
; GoalExpr = disj(Goals)
),
- check_goals(Goals, !Calls, !HasAT, !CallsHO)
+ stratify_analyze_goals(Goals, !Calls, !HasAT, !CallsHO)
;
GoalExpr = switch(_Var, _Fail, Cases),
- check_cases(Cases, !Calls, !HasAT, !CallsHO)
+ stratify_analyze_cases(Cases, !Calls, !HasAT, !CallsHO)
;
GoalExpr = if_then_else(_Vars, Cond, Then, Else),
- check_goal(Cond, !Calls, !HasAT, !CallsHO),
- check_goal(Then, !Calls, !HasAT, !CallsHO),
- check_goal(Else, !Calls, !HasAT, !CallsHO)
+ stratify_analyze_goal(Cond, !Calls, !HasAT, !CallsHO),
+ stratify_analyze_goal(Then, !Calls, !HasAT, !CallsHO),
+ stratify_analyze_goal(Else, !Calls, !HasAT, !CallsHO)
;
- ( GoalExpr = scope(_Reason, SubGoal)
- ; GoalExpr = negation(SubGoal)
- ),
- check_goal(SubGoal, !Calls, !HasAT, !CallsHO)
+ GoalExpr = negation(SubGoal),
+ stratify_analyze_goal(SubGoal, !Calls, !HasAT, !CallsHO)
+ ;
+ GoalExpr = scope(Reason, SubGoal),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ % The code in these scopes does not make calls (either first order
+ % or higher order), and it does not take addresses.
+ true
+ ;
+ stratify_analyze_goal(SubGoal, !Calls, !HasAT, !CallsHO)
+ )
;
GoalExpr = shorthand(ShortHand),
(
ShortHand = atomic_goal(_, _, _, _, MainGoal, OrElseGoals),
- check_goal(MainGoal, !Calls, !HasAT, !CallsHO),
- check_goals(OrElseGoals, !Calls, !HasAT, !CallsHO)
+ stratify_analyze_goal(MainGoal, !Calls, !HasAT, !CallsHO),
+ stratify_analyze_goals(OrElseGoals, !Calls, !HasAT, !CallsHO)
;
ShortHand = bi_implication(_, _),
% These should have been expanded out by now.
- unexpected(this_file, "check_goal: bi_implication")
+ unexpected(this_file, "stratify_analyze_goal: bi_implication")
)
).
-:- pred check_goals(list(hlds_goal)::in,
+:- pred stratify_analyze_goals(list(hlds_goal)::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_goals([], !Calls, !HasAT, !CallsHO).
-check_goals([Goal | Goals], !Calls, !HasAT, !CallsHO) :-
- check_goal(Goal, !Calls, !HasAT, !CallsHO),
- check_goals(Goals, !Calls, !HasAT, !CallsHO).
+stratify_analyze_goals([], !Calls, !HasAT, !CallsHO).
+stratify_analyze_goals([Goal | Goals], !Calls, !HasAT, !CallsHO) :-
+ stratify_analyze_goal(Goal, !Calls, !HasAT, !CallsHO),
+ stratify_analyze_goals(Goals, !Calls, !HasAT, !CallsHO).
-:- pred check_cases(list(case)::in,
+:- pred stratify_analyze_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_cases([], !Calls, !HasAT, !CallsHO).
-check_cases([Case | Goals], !Calls, !HasAT, !CallsHO) :-
+stratify_analyze_cases([], !Calls, !HasAT, !CallsHO).
+stratify_analyze_cases([Case | Goals], !Calls, !HasAT, !CallsHO) :-
Case = case(_, _, Goal),
- check_goal(Goal, !Calls, !HasAT, !CallsHO),
- check_cases(Goals, !Calls, !HasAT, !CallsHO).
+ stratify_analyze_goal(Goal, !Calls, !HasAT, !CallsHO),
+ stratify_analyze_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
@@ -888,11 +916,17 @@
get_called_procs(Then, !Calls),
get_called_procs(Else, !Calls)
;
- ( GoalExpr = scope(_Reason, SubGoal)
- ; GoalExpr = negation(SubGoal)
- ),
+ GoalExpr = negation(SubGoal),
get_called_procs(SubGoal, !Calls)
;
+ GoalExpr = scope(Reason, SubGoal),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ % The code in these scopes does not make calls.
+ true
+ ;
+ get_called_procs(SubGoal, !Calls)
+ )
+ ;
GoalExpr = shorthand(ShortHand),
(
ShortHand = atomic_goal(_, _, _, _, MainGoal, OrElseGoals),
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.20
diff -u -b -r1.20 structure_reuse.direct.choose_reuse.m
--- compiler/structure_reuse.direct.choose_reuse.m 8 Sep 2008 03:39:06 -0000 1.20
+++ compiler/structure_reuse.direct.choose_reuse.m 11 Dec 2008 15:53:48 -0000
@@ -634,6 +634,9 @@
!Table, !IO)
;
GoalExpr = scope(_, Goal),
+ % XXX We should special-case the handling of from_ground_term_construct
+ % scopes. Since they construct ground terms statically, there is no
+ % uniqueness we can exploit,
compute_match_table_with_continuation(Background, DeadCellTable,
Goal, Cont, !Table, !IO)
;
@@ -869,6 +872,9 @@
GoalExpr = negation(_)
;
GoalExpr = scope(_, ScopeGoal),
+ % XXX We should special-case the handling of from_ground_term_construct
+ % scopes. Since they construct ground terms statically, there is no
+ % uniqueness we can exploit,
find_match_in_goal_2(Background, ScopeGoal, !Match)
;
GoalExpr = shorthand(_),
@@ -1162,6 +1168,9 @@
GoalInfo = GoalInfo0
;
GoalExpr0 = scope(A, ScopeGoal0),
+ % XXX We should special-case the handling of from_ground_term_construct
+ % scopes. Since they construct ground terms statically, there is no
+ % uniqueness we can exploit,
annotate_reuses_in_goal(Background, Match, ScopeGoal0, ScopeGoal),
GoalExpr = scope(A, ScopeGoal),
GoalInfo = GoalInfo0
@@ -1435,6 +1444,9 @@
GoalInfo = GoalInfo0
;
GoalExpr0 = scope(A, ScopeGoal0),
+ % XXX We should special-case the handling of from_ground_term_construct
+ % scopes. Since they construct ground terms statically, there is no
+ % uniqueness we can exploit,
check_for_cell_caching_2(DeadCellTable, ScopeGoal0, ScopeGoal),
GoalExpr = scope(A, ScopeGoal),
GoalInfo = GoalInfo0
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.20
diff -u -b -r1.20 structure_reuse.direct.detect_garbage.m
--- compiler/structure_reuse.direct.detect_garbage.m 21 Jul 2008 03:10:14 -0000 1.20
+++ compiler/structure_reuse.direct.detect_garbage.m 11 Dec 2008 15:53:48 -0000
@@ -140,9 +140,13 @@
% XXX To check and compare with the theory.
GoalExpr = negation(_Goal)
;
- GoalExpr = scope(_, SubGoal),
+ GoalExpr = scope(Reason, SubGoal),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ true
+ ;
determine_dead_deconstructions_2(Background, SubGoal, !SharingAs,
!DeadCellTable)
+ )
;
GoalExpr = if_then_else(_, IfGoal, ThenGoal, ElseGoal),
determine_dead_deconstructions_2(Background, IfGoal, !.SharingAs,
Index: compiler/structure_reuse.indirect.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/structure_reuse.indirect.m,v
retrieving revision 1.33
diff -u -b -r1.33 structure_reuse.indirect.m
--- compiler/structure_reuse.indirect.m 28 Jul 2008 03:55:45 -0000 1.33
+++ compiler/structure_reuse.indirect.m 11 Dec 2008 15:53:48 -0000
@@ -520,9 +520,11 @@
% XXX To check and compare with the theory.
GoalExpr0 = negation(_Goal)
;
- GoalExpr0 = scope(A, SubGoal0),
+ GoalExpr0 = scope(Reason, SubGoal0),
+ % XXX We should special-case the handling of from_ground_term_construct
+ % scopes.
indirect_reuse_analyse_goal(BaseInfo, SubGoal0, SubGoal, !IrInfo),
- GoalExpr = scope(A, SubGoal),
+ GoalExpr = scope(Reason, SubGoal),
!:Goal = hlds_goal(GoalExpr, GoalInfo0)
;
% Brief sketch:
Index: compiler/structure_reuse.lbu.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/structure_reuse.lbu.m,v
retrieving revision 1.11
diff -u -b -r1.11 structure_reuse.lbu.m
--- compiler/structure_reuse.lbu.m 27 Feb 2008 07:23:15 -0000 1.11
+++ compiler/structure_reuse.lbu.m 11 Dec 2008 15:53:48 -0000
@@ -121,19 +121,23 @@
backward_use_in_cases(VarTypes, Cases0, Cases, !LBU),
!:Expr = switch(A, B, Cases)
;
- !.Expr = negation(Goal0),
- % handled as: if(Goal0) then fail else true
+ !.Expr = negation(SubGoal0),
+ % handled as: if SubGoal0 then fail else true
LBU0 = !.LBU,
- backward_use_in_goal(VarTypes, Goal0, Goal, !.LBU, _),
- % A not does not introduce any choice-points! Hence the
- % not itself is deterministic, and no new variables in LBU
+ backward_use_in_goal(VarTypes, SubGoal0, SubGoal, !.LBU, _),
+ % A negation does not introduce any choice-points! Hence the
+ % negation itself is deterministic, and no new variables in LBU
% are introduced into the resulting LBU-set.
!:LBU = LBU0,
- !:Expr = negation(Goal)
+ !:Expr = negation(SubGoal)
;
- !.Expr = scope(Reason, SomeGoal0),
- backward_use_in_goal(VarTypes, SomeGoal0, SomeGoal, !LBU),
- !:Expr = scope(Reason, SomeGoal)
+ !.Expr = scope(Reason, SubGoal0),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ SubGoal = SubGoal0
+ ;
+ backward_use_in_goal(VarTypes, SubGoal0, SubGoal, !LBU)
+ ),
+ !:Expr = scope(Reason, SubGoal)
;
% XXX The implementation for if-then-else is different from the theory
% in the thesis. We can obtain more precision when the Condition-goal
Index: compiler/structure_reuse.lfu.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/structure_reuse.lfu.m,v
retrieving revision 1.11
diff -u -b -r1.11 structure_reuse.lfu.m
--- compiler/structure_reuse.lfu.m 28 May 2008 00:52:29 -0000 1.11
+++ compiler/structure_reuse.lfu.m 11 Dec 2008 15:53:48 -0000
@@ -119,38 +119,34 @@
InstantiadedBefore = !.InstantiatedVars,
(
- GoalExpr0 = conj(A,Goals0)
- ->
+ GoalExpr0 = conj(ConjType, Goals0),
forward_use_in_conj(VarTypes, Goals0, Goals,
!InstantiatedVars, !DeadVars),
- GoalExpr = conj(A, Goals)
+ GoalExpr = conj(ConjType, Goals)
;
- GoalExpr0 = switch(A, B, Cases0)
- ->
+ GoalExpr0 = switch(Var, CanFail, Cases0),
forward_use_in_cases(VarTypes, Cases0, Cases,
!InstantiatedVars, !DeadVars),
- GoalExpr = switch(A, B, Cases)
+ GoalExpr = switch(Var, CanFail, Cases)
;
- GoalExpr0 = disj(Disj0)
- ->
+ GoalExpr0 = disj(Disj0),
forward_use_in_disj(VarTypes, Disj0, Disj,
!InstantiatedVars, !DeadVars),
GoalExpr = disj(Disj)
;
- GoalExpr0 = negation(Goal0)
- ->
- forward_use_in_goal(VarTypes, Goal0, Goal,
+ GoalExpr0 = negation(SubGoal0),
+ forward_use_in_goal(VarTypes, SubGoal0, SubGoal,
!InstantiatedVars, !DeadVars),
- GoalExpr = negation(Goal)
+ GoalExpr = negation(SubGoal)
;
- GoalExpr0 = scope(A, Goal0)
- ->
- forward_use_in_goal(VarTypes, Goal0, Goal,
+ GoalExpr0 = scope(Reason, SubGoal0),
+ % XXX We should special-case the handling of from_ground_term_construct
+ % scopes.
+ forward_use_in_goal(VarTypes, SubGoal0, SubGoal,
!InstantiatedVars, !DeadVars),
- GoalExpr = scope(A, Goal)
+ GoalExpr = scope(Reason, SubGoal)
;
- GoalExpr0 = if_then_else(V, Cond0, Then0, Else0)
- ->
+ GoalExpr0 = if_then_else(Vars, Cond0, Then0, Else0),
Inst0 = !.InstantiatedVars,
Dead0 = !.DeadVars,
forward_use_in_goal(VarTypes, Cond0, Cond,
@@ -160,10 +156,19 @@
forward_use_in_goal(VarTypes, Else0, Else, Inst0, Inst1, Dead0, Dead1),
set.union(Inst1, !InstantiatedVars),
set.union(Dead1, !DeadVars),
- GoalExpr = if_then_else(V, Cond, Then, Else)
+ GoalExpr = if_then_else(Vars, Cond, Then, Else)
;
+ ( GoalExpr0 = unify(_, _, _, _, _)
+ ; GoalExpr0 = plain_call(_, _, _, _, _, _)
+ ; GoalExpr0 = generic_call(_, _, _, _)
+ ; GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _)
+ ),
+ unexpected(this_file,
+ "forward_use_in_composite_goal: atomic goal")
+ ;
+ GoalExpr0 = shorthand(_),
unexpected(this_file,
- "Atomic goal in forward_use_in_composite_goal.")
+ "forward_use_in_composite_goal: shorthand")
),
set.difference(InstantiadedBefore, !.DeadVars, LFU),
goal_info_set_lfu(LFU, GoalInfo0, GoalInfo),
@@ -266,6 +271,8 @@
Expr = negation(Goal)
;
Expr0 = scope(Reason, Goal0),
+ % XXX We should special-case the handling of from_ground_term_construct
+ % scopes.
add_vars_to_lfu_in_goal(ForceInUse, Goal0, Goal),
Expr = scope(Reason, Goal)
;
Index: compiler/structure_reuse.versions.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/structure_reuse.versions.m,v
retrieving revision 1.18
diff -u -b -r1.18 structure_reuse.versions.m
--- compiler/structure_reuse.versions.m 23 Jul 2008 05:13:20 -0000 1.18
+++ compiler/structure_reuse.versions.m 11 Dec 2008 15:53:48 -0000
@@ -415,20 +415,22 @@
% XXX To check and compare with the theory.
GoalExpr0 = negation(_Goal)
;
- GoalExpr0 = scope(A, SubGoal0),
+ GoalExpr0 = scope(Reason, SubGoal0),
+ % XXX We should special-case the handling of from_ground_term_construct
+ % scopes.
process_goal(ConvertPotentialReuse, ReuseTable, ModuleInfo,
SubGoal0, SubGoal),
- GoalExpr = scope(A, SubGoal),
+ GoalExpr = scope(Reason, SubGoal),
!:Goal = hlds_goal(GoalExpr, GoalInfo0)
;
- GoalExpr0 = if_then_else(A, IfGoal0, ThenGoal0, ElseGoal0),
+ GoalExpr0 = if_then_else(Vars, IfGoal0, ThenGoal0, ElseGoal0),
process_goal(ConvertPotentialReuse, ReuseTable, ModuleInfo,
IfGoal0, IfGoal),
process_goal(ConvertPotentialReuse, ReuseTable, ModuleInfo,
ThenGoal0, ThenGoal),
process_goal(ConvertPotentialReuse, ReuseTable, ModuleInfo,
ElseGoal0, ElseGoal),
- GoalExpr = if_then_else(A, IfGoal, ThenGoal, ElseGoal),
+ GoalExpr = if_then_else(Vars, IfGoal, ThenGoal, ElseGoal),
!:Goal = hlds_goal(GoalExpr, GoalInfo0)
;
GoalExpr0 = call_foreign_proc(_Attrs, _ForeignPredId, _ForeignProcId,
Index: compiler/structure_sharing.analysis.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/structure_sharing.analysis.m,v
retrieving revision 1.42
diff -u -b -r1.42 structure_sharing.analysis.m
--- compiler/structure_sharing.analysis.m 7 Aug 2008 02:56:04 -0000 1.42
+++ compiler/structure_sharing.analysis.m 11 Dec 2008 15:53:48 -0000
@@ -645,10 +645,15 @@
% XXX Check theory, but a negated goal can not create bindings,
% hence it also can not create additional sharing.
;
- GoalExpr = scope(_, SubGoal),
+ GoalExpr = scope(Reason, SubGoal),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ % Ground terms cannot introduce sharing.
+ true
+ ;
% XXX Check theory.
analyse_goal(ModuleInfo, PredInfo, ProcInfo, SharingTable, Verbose,
SubGoal, !FixpointTable, !DepProcs, !SharingAs, !Status)
+ )
;
GoalExpr = if_then_else(_, IfGoal, ThenGoal, ElseGoal),
analyse_goal(ModuleInfo, PredInfo, ProcInfo, SharingTable, Verbose,
Index: compiler/superhomogeneous.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/superhomogeneous.m,v
retrieving revision 1.31
diff -u -b -r1.31 superhomogeneous.m
--- compiler/superhomogeneous.m 2 Dec 2008 04:30:25 -0000 1.31
+++ compiler/superhomogeneous.m 11 Dec 2008 15:53:48 -0000
@@ -119,6 +119,7 @@
:- import_module hlds.make_hlds.field_access.
:- import_module hlds.make_hlds.qual_info.
:- import_module libs.compiler_util.
+:- import_module libs.handle_options. % for get_from_ground_term_threshold
:- import_module parse_tree.mercury_to_mercury.
:- import_module parse_tree.module_qual.
:- import_module parse_tree.prog_io_sym_name.
@@ -139,34 +140,30 @@
%-----------------------------------------------------------------------------%
-:- func from_ground_term_scope_threshold = int.
-
-from_ground_term_scope_threshold = 15.
-
insert_arg_unifications(HeadVars, Args0, Context, ArgContext, !Goal, NumAdded,
!VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs) :-
do_insert_arg_unifications(HeadVars, Args0, Context, ArgContext, !Goal,
- yes(from_ground_term_scope_threshold), NumAdded,
+ get_from_ground_term_threshold, NumAdded,
!VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs).
insert_arg_unifications_with_supplied_contexts(ArgVars, ArgTerms0,
ArgContexts, Context, !Goal, NumAdded, !VarSet, !ModuleInfo, !QualInfo,
!SInfo, !Specs) :-
do_insert_arg_unifications_with_supplied_contexts(ArgVars, ArgTerms0,
- ArgContexts, Context,
- !Goal, yes(from_ground_term_scope_threshold), NumAdded,
+ ArgContexts, Context, !Goal,
+ get_from_ground_term_threshold, NumAdded,
!VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs).
append_arg_unifications(HeadVars, Args0, Context, ArgContext,
!Goal, NumAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs) :-
do_append_arg_unifications(HeadVars, Args0, Context, ArgContext, !Goal,
- yes(from_ground_term_scope_threshold), NumAdded,
+ get_from_ground_term_threshold, NumAdded,
!VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs).
unravel_unification(LHS0, RHS0, Context, MainContext, SubContext, Purity,
Goal, NumAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs) :-
do_unravel_unification(LHS0, RHS0, Context, MainContext, SubContext,
- Purity, Goal, yes(from_ground_term_scope_threshold), NumAdded,
+ Purity, Goal, get_from_ground_term_threshold, NumAdded,
!VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs).
%-----------------------------------------------------------------------------%
@@ -415,15 +412,51 @@
(
MaybeThreshold = yes(Threshold),
NumAdded > Threshold,
- LHS = term.variable(X, _),
+ LHS = term.variable(LHSVar, _),
ground_term(RHS)
->
- Goal0 = hlds_goal(_, GoalInfo),
- Goal = hlds_goal(scope(from_ground_term(X), Goal0), GoalInfo)
+ Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
+ % We don't yet know whether this scope is actually be a construction;
+ % that is decided during mode analysis. However, the code inside the
+ % scope actually maintains the invariants we expect from
+ % from_ground_term_construct scopes, and quantification can
+ % exploit this knowledge.
+ Kind = from_ground_term_construct,
+ goal_info_set_nonlocals(set.make_singleton_set(LHSVar),
+ GoalInfo0, GoalInfo),
+ ( GoalExpr0 = conj(plain_conj, Conjuncts0) ->
+ mark_nonlocals_in_ground_term_construct(Conjuncts0, Conjuncts),
+ SubGoalExpr = conj(plain_conj, Conjuncts),
+ SubGoal = hlds_goal(SubGoalExpr, GoalInfo),
+ GoalExpr = scope(from_ground_term(LHSVar, Kind), SubGoal),
+ Goal = hlds_goal(GoalExpr, GoalInfo)
+ ;
+ unexpected(this_file,
+ "do_unravel_unification: from_ground_term not conj")
+ )
;
Goal = Goal0
).
+:- pred mark_nonlocals_in_ground_term_construct(
+ list(hlds_goal)::in, list(hlds_goal)::out) is det.
+
+mark_nonlocals_in_ground_term_construct([], []).
+mark_nonlocals_in_ground_term_construct([Goal0 | Goals0], [Goal | Goals]) :-
+ Goal0 = hlds_goal(GoalExpr, GoalInfo0),
+ (
+ GoalExpr = unify(LHSVar, RHS, _, _, _),
+ RHS = rhs_functor(_, _, RHSVars)
+ ->
+ set.list_to_set([LHSVar | RHSVars], NonLocals),
+ goal_info_set_nonlocals(NonLocals, GoalInfo0, GoalInfo),
+ Goal = hlds_goal(GoalExpr, GoalInfo)
+ ;
+ unexpected(this_file,
+ "mark_nonlocals_in_ground_term_construct: wrong shape goal")
+ ),
+ mark_nonlocals_in_ground_term_construct(Goals0, Goals).
+
:- pred classify_unravel_unification(prog_term::in, prog_term::in,
prog_context::in, unify_main_context::in, unify_sub_contexts::in,
purity::in, hlds_goal::out, num_added_goals::out,
Index: compiler/switch_detection.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/switch_detection.m,v
retrieving revision 1.141
diff -u -b -r1.141 switch_detection.m
--- compiler/switch_detection.m 29 Aug 2008 05:33:46 -0000 1.141
+++ compiler/switch_detection.m 11 Dec 2008 15:53:48 -0000
@@ -274,8 +274,14 @@
GoalExpr = switch(Var, CanFail, Cases)
;
GoalExpr0 = scope(Reason, SubGoal0),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ % There are neither disjunctions nor deconstruction unifications
+ % inside these scopes.
+ SubGoal = SubGoal0
+ ;
detect_switches_in_goal(VarTypes, AllowMulti, InstMap0,
- SubGoal0, SubGoal, !ModuleInfo, !Requant),
+ SubGoal0, SubGoal, !ModuleInfo, !Requant)
+ ),
GoalExpr = scope(Reason, SubGoal)
;
GoalExpr0 = unify(_, RHS0, _, _, _),
@@ -525,7 +531,7 @@
[Var | Vars], InstMap, AgainList0, GoalExpr, !ModuleInfo, !Requant) :-
% Can we do at least a partial switch on this variable?
(
- instmap.lookup_var(InstMap, Var, VarInst0),
+ instmap_lookup_var(InstMap, Var, VarInst0),
inst_is_bound(!.ModuleInfo, VarInst0),
partition_disj(AllowMulti, Disjuncts0, Var, GoalInfo, Left, CasesList,
!Requant)
@@ -895,9 +901,19 @@
Goal0 = hlds_goal(GoalExpr0, GoalInfo),
(
GoalExpr0 = scope(Reason, SubGoal0),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ % There are no deconstruction unifications inside these scopes.
+ Goal = Goal0,
+ % Whether we want to keep looking at the code that follows them
+ % is a more interesting question. Since we keep going after
+ % construction unifications (whose behavior this scope resembles),
+ % we keep going.
+ FoundDeconstruct = before_deconstruct
+ ;
find_bind_var_2(Var, ProcessUnify, SubGoal0, SubGoal, !Subst,
!Result, !Info, FoundDeconstruct),
Goal = hlds_goal(scope(Reason, SubGoal), GoalInfo)
+ )
;
GoalExpr0 = conj(ConjType, SubGoals0),
(
@@ -1003,7 +1019,7 @@
cases_to_switch(Var, VarTypes, AllowMulti, Cases0, InstMap, GoalExpr,
!ModuleInfo, !Requant) :-
- instmap.lookup_var(InstMap, Var, VarInst),
+ instmap_lookup_var(InstMap, Var, VarInst),
( inst_is_bound_to_functors(!.ModuleInfo, VarInst, Functors) ->
functors_to_cons_ids(Functors, ConsIds),
delete_unreachable_cases(Cases0, ConsIds, Cases1),
Index: compiler/tabling_analysis.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/tabling_analysis.m,v
retrieving revision 1.18
diff -u -b -r1.18 tabling_analysis.m
--- compiler/tabling_analysis.m 21 Jul 2008 03:10:14 -0000 1.18
+++ compiler/tabling_analysis.m 11 Dec 2008 15:53:48 -0000
@@ -358,11 +358,18 @@
Result = get_mm_tabling_status_from_attributes(Attributes),
MaybeAnalysisStatus = yes(optimal)
;
- ( GoalExpr = negation(SubGoal)
- ; GoalExpr = scope(_, SubGoal)
- ),
+ GoalExpr = negation(SubGoal),
+ check_goal_for_mm_tabling(SCC, VarTypes, SubGoal, Result,
+ MaybeAnalysisStatus, !ModuleInfo)
+ ;
+ GoalExpr = scope(Reason, SubGoal),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ Result = mm_tabled_will_not_call,
+ MaybeAnalysisStatus = yes(optimal)
+ ;
check_goal_for_mm_tabling(SCC, VarTypes, SubGoal, Result,
MaybeAnalysisStatus, !ModuleInfo)
+ )
;
(
GoalExpr = conj(_, Goals)
@@ -673,8 +680,12 @@
!:GoalExpr = negation(SubGoal)
;
!.GoalExpr = scope(Reason, SubGoal0),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ Status = mm_tabled_will_not_call
+ ;
annotate_goal(VarTypes, SubGoal0, SubGoal, Status, !ModuleInfo),
!:GoalExpr = scope(Reason, SubGoal)
+ )
;
!.GoalExpr = shorthand(_),
unexpected(this_file, "shorthand goal")
@@ -684,8 +695,7 @@
mm_tabling_status::out, module_info::in, module_info::out) is det.
annotate_goal_list(VarTypes, !Goals, Status, !ModuleInfo) :-
- list.map2_foldl(annotate_goal(VarTypes), !Goals, Statuses,
- !ModuleInfo),
+ list.map2_foldl(annotate_goal(VarTypes), !Goals, Statuses, !ModuleInfo),
list.foldl(combine_mm_tabling_status, Statuses, mm_tabled_will_not_call,
Status).
Index: compiler/term_constr_build.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/term_constr_build.m,v
retrieving revision 1.21
diff -u -b -r1.21 term_constr_build.m
--- compiler/term_constr_build.m 27 Feb 2008 07:23:15 -0000 1.21
+++ compiler/term_constr_build.m 11 Dec 2008 15:53:48 -0000
@@ -389,19 +389,19 @@
:- pred build_abstract_goal_2(hlds_goal_expr::in, hlds_goal_info::in,
abstract_goal::out, traversal_info::in, traversal_info::out) is det.
-build_abstract_goal_2(conj(_, Goals), _, AbstractGoal, !Info) :-
+build_abstract_goal_2(GoalExpr, GoalInfo, AbstractGoal, !Info) :-
+ (
+ GoalExpr = conj(_, Goals),
% For the purposes of termination analysis there is no
% distinction between parallel conjunctions and normal ones.
- build_abstract_conj(Goals, AbstractGoal, !Info).
-
-build_abstract_goal_2(disj(Goals), _, AbstractGoal, !Info) :-
- build_abstract_disj(non_switch(Goals), AbstractGoal, !Info).
-
-build_abstract_goal_2(GoalExpr, _, AbstractGoal, !Info) :-
+ build_abstract_conj(Goals, AbstractGoal, !Info)
+ ;
+ GoalExpr = disj(Goals),
+ build_abstract_disj(non_switch(Goals), AbstractGoal, !Info)
+ ;
GoalExpr = switch(SwitchVar, _, Cases),
- build_abstract_disj(switch(SwitchVar, Cases), AbstractGoal, !Info).
-
-build_abstract_goal_2(GoalExpr, _, AbstractGoal, !Info) :-
+ build_abstract_disj(switch(SwitchVar, Cases), AbstractGoal, !Info)
+ ;
GoalExpr = if_then_else(_, Cond, Then, Else),
% Reduce the if-then goals to an abstract conjunction.
@@ -417,37 +417,37 @@
build_abstract_goal(Else, AbstractElse, !Info),
AbstractFailureGoal = term_conj([CondFail, AbstractElse], [], []),
AbstractDisjuncts = [AbstractSuccessGoal, AbstractFailureGoal],
- AbstractGoal = term_disj(AbstractDisjuncts, 2, [], []).
-
-build_abstract_goal_2(scope(_, Goal), _, AbstractGoal, !Info) :-
- build_abstract_goal(Goal, AbstractGoal, !Info).
-
-build_abstract_goal_2(GoalExpr, GoalInfo, AbstractGoal, !Info) :-
+ AbstractGoal = term_disj(AbstractDisjuncts, 2, [], [])
+ ;
+ GoalExpr = scope(_Reason, SubGoal),
+ % XXX We should special-case the handling of from_ground_term_construct
+ % scopes.
+ build_abstract_goal(SubGoal, AbstractGoal, !Info)
+ ;
GoalExpr = plain_call(CallPredId, CallProcId, CallArgs, _, _, _),
- CallSizeArgs = prog_vars_to_size_vars(!.Info ^ tti_size_var_map, CallArgs),
+ CallSizeArgs = prog_vars_to_size_vars(!.Info ^ tti_size_var_map,
+ CallArgs),
build_abstract_call(proc(CallPredId, CallProcId), CallSizeArgs,
- GoalInfo, AbstractGoal, !Info).
-
-build_abstract_goal_2(GoalExpr, _, AbstractGoal, !Info) :-
+ GoalInfo, AbstractGoal, !Info)
+ ;
GoalExpr = unify(_, _, _, Unification, _),
- build_abstract_unification(Unification, AbstractGoal, !Info).
-
-build_abstract_goal_2(negation(Goal), _GoalInfo, AbstractGoal, !Info) :-
+ build_abstract_unification(Unification, AbstractGoal, !Info)
+ ;
+ GoalExpr = negation(SubGoal),
% Event though a negated goal cannot have any output we still need
% to check it for calls to non-terminating procedures.
- build_abstract_goal(Goal, _, !Info),
+ build_abstract_goal(SubGoal, _, !Info),
% Find a failure constraint for the goal if
% `--term2-propagate-failure-constraints' is enabled,
% otherwise just use the constraint that all non-zero input vars
% should be non-negative.
- AbstractGoal = find_failure_constraint_for_goal(Goal, !.Info).
-
+ AbstractGoal = find_failure_constraint_for_goal(SubGoal, !.Info)
+ ;
+ GoalExpr = call_foreign_proc(Attrs, PredId, ProcId, Args, ExtraArgs,
+ _, _),
% XXX Eventually we should provide some facility for specifying the
% arg_size constraints for foreign_procs.
- %
-build_abstract_goal_2(GoalExpr, GoalInfo, AbstractGoal, !Info) :-
- GoalExpr = call_foreign_proc(Attrs, PredId, ProcId, Args, ExtraArgs, _, _),
% Create non-negativity constraints for each non-zero argument
% in the foreign proc.
@@ -470,23 +470,23 @@
info_update_errors(Error, !Info)
),
Polyhedron = polyhedron.from_constraints(Constraints),
- AbstractGoal = term_primitive(Polyhedron, [], []).
-
+ AbstractGoal = term_primitive(Polyhedron, [], [])
+ ;
+ GoalExpr = generic_call(_, _, _, _),
% XXX At the moment all higher-order calls are eventually treated
% as an error. We do not record them as a normal type of error
- % because this is going to change. To approximate their effect
- % here just assume that any non-zero output variables from the HO call
+ % because this is going to change. To approximate their effect here
+ % just assume that any non-zero output variables from the HO call
% are unbounded in size.
%
-build_abstract_goal_2(GoalExpr, GoalInfo, AbstractGoal, !Info) :-
- GoalExpr = generic_call(_, _, _, _),
Context = goal_info_get_context(GoalInfo),
AbstractGoal = term_primitive(polyhedron.universe, [], []),
- info_update_ho_info(Context, !Info).
-
-build_abstract_goal_2(shorthand(_), _, _, _, _) :-
+ info_update_ho_info(Context, !Info)
+ ;
+ GoalExpr = shorthand(_),
% These should have been expanded out by now.
- unexpected(this_file, "build_abstract_goal_2: shorthand").
+ unexpected(this_file, "build_abstract_goal_2: shorthand")
+ ).
%------------------------------------------------------------------------------%
%
Index: compiler/term_pass1.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/term_pass1.m,v
retrieving revision 1.40
diff -u -b -r1.40 term_pass1.m
--- compiler/term_pass1.m 29 Jan 2008 04:59:43 -0000 1.40
+++ compiler/term_pass1.m 11 Dec 2008 15:53:48 -0000
@@ -371,11 +371,18 @@
list.foldl3(check_goal_non_term_calls(PPId, VarTypes), Goals,
!Errors, !ModuleInfo, !IO)
;
- ( GoalExpr = negation(SubGoal)
- ; GoalExpr = scope(_, SubGoal)
- ),
+ GoalExpr = negation(SubGoal),
+ check_goal_non_term_calls(PPId, VarTypes, SubGoal,
+ !Errors, !ModuleInfo, !IO)
+ ;
+ GoalExpr = scope(Reason, SubGoal),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ % The scope has no calls, let alone nonterminating calls.
+ true
+ ;
check_goal_non_term_calls(PPId, VarTypes, SubGoal,
!Errors, !ModuleInfo, !IO)
+ )
;
GoalExpr = shorthand(_),
unexpected(this_file,
Index: compiler/term_traversal.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/term_traversal.m,v
retrieving revision 1.60
diff -u -b -r1.60 term_traversal.m
--- compiler/term_traversal.m 29 Jan 2008 04:59:44 -0000 1.60
+++ compiler/term_traversal.m 11 Dec 2008 15:53:48 -0000
@@ -331,6 +331,8 @@
term_traverse_goal(SubGoal, Params, !Info, !ModuleInfo, !IO)
;
GoalExpr = scope(_, SubGoal),
+ % XXX We should special-case the handling of from_ground_term_construct
+ % scopes.
term_traverse_goal(SubGoal, Params, !Info, !ModuleInfo, !IO)
;
GoalExpr = shorthand(_),
Index: compiler/trace_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/trace_gen.m,v
retrieving revision 1.26
diff -u -b -r1.26 trace_gen.m
--- compiler/trace_gen.m 25 Nov 2008 07:46:43 -0000 1.26
+++ compiler/trace_gen.m 11 Dec 2008 15:53:48 -0000
@@ -1251,7 +1251,7 @@
;
Name = ""
),
- instmap.lookup_var(InstMap, Var, Inst),
+ instmap_lookup_var(InstMap, Var, Inst),
( inst_match.inst_is_ground(ModuleInfo, Inst) ->
LldsInst = llds_inst_ground
;
Index: compiler/trailing_analysis.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/trailing_analysis.m,v
retrieving revision 1.37
diff -u -b -r1.37 trailing_analysis.m
--- compiler/trailing_analysis.m 21 Jul 2008 03:10:14 -0000 1.37
+++ compiler/trailing_analysis.m 11 Dec 2008 15:53:48 -0000
@@ -495,7 +495,12 @@
check_goal_for_trail_mods(SCC, VarTypes, SubGoal, Result,
MaybeAnalysisStatus, !ModuleInfo)
;
- GoalExpr = scope(_, InnerGoal),
+ GoalExpr = scope(Reason, InnerGoal),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ % The construction of ground terms will not modify the trail.
+ Result = trail_will_not_modify,
+ MaybeAnalysisStatus = yes(optimal)
+ ;
OuterGoalInfo = GoalInfo,
check_goal_for_trail_mods(SCC, VarTypes, InnerGoal, Result0,
MaybeAnalysisStatus, !ModuleInfo),
@@ -504,11 +509,12 @@
OuterCodeModel = goal_info_get_code_model(OuterGoalInfo),
% `trail_conditional' scope goals (of the type that require extra
- % trailing code) will have their status changed to `trail_may_modify'.
- % See the comment in the code handling if-then-elses above for
- % the reason why.
+ % trailing code) will have their status changed to
+ % `trail_may_modify'. See the comment in the code handling
+ % if-then-elses above for the reason why.
Result = scope_implies_trail_mod(InnerCodeModel, OuterCodeModel,
Result0)
+ )
;
GoalExpr = shorthand(_),
unexpected(this_file,
@@ -980,14 +986,19 @@
!:GoalExpr = negation(SubGoal)
;
!.GoalExpr = scope(Reason, InnerGoal0),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ Status = trail_will_not_modify
+ ;
OuterGoalInfo = GoalInfo,
- annotate_goal(VarTypes, InnerGoal0, InnerGoal, Status0, !ModuleInfo),
+ annotate_goal(VarTypes, InnerGoal0, InnerGoal, Status0,
+ !ModuleInfo),
InnerGoal = hlds_goal(_, InnerGoalInfo),
InnerCodeModel = goal_info_get_code_model(InnerGoalInfo),
OuterCodeModel = goal_info_get_code_model(OuterGoalInfo),
Status = scope_implies_trail_mod(InnerCodeModel, OuterCodeModel,
Status0),
!:GoalExpr = scope(Reason, InnerGoal)
+ )
;
!.GoalExpr = shorthand(_),
unexpected(this_file, "shorthand goal")
Index: compiler/tupling.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/tupling.m,v
retrieving revision 1.46
diff -u -b -r1.46 tupling.m
--- compiler/tupling.m 4 Sep 2008 11:41:01 -0000 1.46
+++ compiler/tupling.m 11 Dec 2008 15:53:48 -0000
@@ -1091,6 +1091,8 @@
count_load_stores_in_goal_expr(scope(_Reason, Goal), _GoalInfo, CountInfo,
!CountState) :-
+ % XXX We should special-case the handling of from_ground_term_construct
+ % scopes.
count_load_stores_in_goal(Goal, CountInfo, !CountState).
count_load_stores_in_goal_expr(conj(ConjType, Goals), _GoalInfo, CountInfo,
@@ -1191,11 +1193,13 @@
% TODO: If we kept track of the aliases of field variables,
% then they could be checked also.
get_own_tupling_proposal(CountInfo) = tupling(_, _, _),
- all [Var] Var `list.member` FieldVars => (
+ all [Var] (
+ Var `list.member` FieldVars
+ => (
Var `set.member` InputArgs0,
assoc_list.search(FieldVarArgPos, Var, Pos),
list.nth_member_search(ArgVars, Var, Pos)
- )
+ ))
->
% In this case, the cell var is not being used to access field
% variables, so it should not incur the cell var cost.
@@ -1743,10 +1747,14 @@
Goal = hlds_goal(GoalExpr, GoalInfo0)
;
GoalExpr0 = scope(Reason, SubGoal0),
- fix_calls_in_goal(SubGoal0, SubGoal, !VarSet, !VarTypes, !RttiVarMaps,
- TransformMap),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ Goal = Goal0
+ ;
+ fix_calls_in_goal(SubGoal0, SubGoal, !VarSet, !VarTypes,
+ !RttiVarMaps, TransformMap),
GoalExpr = scope(Reason, SubGoal),
Goal = hlds_goal(GoalExpr, GoalInfo0)
+ )
;
GoalExpr0 = conj(ConjType, Goals0),
(
@@ -1755,9 +1763,9 @@
TransformMap)
;
ConjType = parallel_conj,
- % XXX: I am not sure whether parallel conjunctions should be treated
- % with fix_calls_in_goal or fix_calls_in_goal_list. At any rate,
- % this is untested.
+ % XXX: I am not sure whether parallel conjunctions should be
+ % treated with fix_calls_in_goal or fix_calls_in_goal_list.
+ % At any rate, this is untested.
fix_calls_in_goal_list(Goals0, Goals, !VarSet, !VarTypes,
!RttiVarMaps, TransformMap)
),
Index: compiler/typecheck.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/typecheck.m,v
retrieving revision 1.433
diff -u -b -r1.433 typecheck.m
--- compiler/typecheck.m 21 Jul 2008 03:10:15 -0000 1.433
+++ compiler/typecheck.m 11 Dec 2008 15:53:48 -0000
@@ -1163,7 +1163,7 @@
;
Reason = barrier(_)
;
- Reason = from_ground_term(_)
+ Reason = from_ground_term(_, _)
;
Reason = trace_goal(_, _, _, _, _)
),
@@ -2727,7 +2727,6 @@
typecheck_info_get_ctor_list(Info, Functor, Arity, GoalPath, ConsInfos,
ConsErrors) :-
typecheck_info_get_is_field_access_function(Info, IsFieldAccessFunc),
- typecheck_info_get_pred_import_status(Info, ImportStatus),
(
% If we're typechecking the clause added for a field access function
% for which the user has supplied type or mode declarations, the goal
@@ -2735,6 +2734,7 @@
% not constructor applications or function calls. The clauses in
% `.opt' files will already have been expanded into unifications.
IsFieldAccessFunc = yes,
+ typecheck_info_get_pred_import_status(Info, ImportStatus),
ImportStatus \= status_opt_imported
->
(
@@ -2912,11 +2912,20 @@
convert_cons_defn(Info, GoalPath, Action, X, Y),
convert_cons_defn_list(Info, GoalPath, Action, Xs, Ys).
-:- pred convert_cons_defn(typecheck_info::in, goal_path::in,
- cons_constraints_action::in, hlds_cons_defn::in,
- maybe_cons_type_info::out) is det.
+:- pred convert_cons_defn(typecheck_info, goal_path,
+ cons_constraints_action, hlds_cons_defn, maybe_cons_type_info).
+:- mode convert_cons_defn(in, in, in(bound(do_not_flip_constraints)), in, out)
+ is det.
+:- mode convert_cons_defn(in, in, in, in, out) is det.
convert_cons_defn(Info, GoalPath, Action, HLDS_ConsDefn, ConsTypeInfo) :-
+ % XXX We should investigate whether the job done by this predicate
+ % on demand and therefore possibly lots of times for the same type,
+ % would be better done just once, either by invoking it (at least with
+ % Action = do_not_flip_constraints) before type checking even starts and
+ % recording the result, or by putting the result into the HLDS_ConsDefn
+ % or some related data structure.
+
HLDS_ConsDefn = hlds_cons_defn(ExistQVars0, ExistProgConstraints, Args,
TypeCtor, _),
ArgTypes = list.map(func(C) = C ^ arg_type, Args),
Index: compiler/typecheck_info.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/typecheck_info.m,v
retrieving revision 1.25
diff -u -b -r1.25 typecheck_info.m
--- compiler/typecheck_info.m 21 Jul 2008 03:10:15 -0000 1.25
+++ compiler/typecheck_info.m 11 Dec 2008 15:53:48 -0000
@@ -429,11 +429,17 @@
type_assign_get_constraint_map(TypeAssign, ConstraintMap0),
map.keys(VarTypes0, Vars),
+ ( map.is_empty(TypeBindings) ->
+ VarTypes = VarTypes0,
+ ConstraintProofs = ConstraintProofs0,
+ ConstraintMap1 = ConstraintMap0
+ ;
expand_types(Vars, TypeBindings, VarTypes0, VarTypes),
apply_rec_subst_to_constraint_proofs(TypeBindings,
ConstraintProofs0, ConstraintProofs),
apply_rec_subst_to_constraint_map(TypeBindings,
- ConstraintMap0, ConstraintMap1),
+ ConstraintMap0, ConstraintMap1)
+ ),
% When inferring the typeclass constraints, the universal constraints
% here may be assumed (if this is the last pass) but will not have been
Index: compiler/unique_modes.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unique_modes.m,v
retrieving revision 1.127
diff -u -b -r1.127 unique_modes.m
--- compiler/unique_modes.m 27 Feb 2008 07:23:16 -0000 1.127
+++ compiler/unique_modes.m 11 Dec 2008 15:53:48 -0000
@@ -167,8 +167,8 @@
make_all_nondet_live_vars_mostly_uniq(ModeInfo0, ModeInfo) :-
mode_info_get_instmap(ModeInfo0, FullInstMap0),
- ( instmap.is_reachable(FullInstMap0) ->
- instmap.vars_list(FullInstMap0, AllVars),
+ ( instmap_is_reachable(FullInstMap0) ->
+ instmap_vars_list(FullInstMap0, AllVars),
select_nondet_live_vars(AllVars, ModeInfo0, NondetLiveVars),
make_var_list_mostly_uniq(NondetLiveVars, ModeInfo0, ModeInfo)
;
@@ -210,7 +210,7 @@
select_changed_inst_vars([Var | Vars], DeltaInstMap, ModeInfo, ChangedVars) :-
mode_info_get_module_info(ModeInfo, ModuleInfo),
mode_info_get_instmap(ModeInfo, InstMap0),
- instmap.lookup_var(InstMap0, Var, Inst0),
+ instmap_lookup_var(InstMap0, Var, Inst0),
mode_info_get_var_types(ModeInfo, VarTypes),
map.lookup(VarTypes, Var, Type),
(
@@ -240,10 +240,10 @@
mode_info_get_module_info(!.ModeInfo, ModuleInfo0),
(
% Only variables which are `unique' need to be changed.
- instmap.is_reachable(InstMap0),
- instmap.vars_list(InstMap0, Vars),
+ instmap_is_reachable(InstMap0),
+ instmap_vars_list(InstMap0, Vars),
list.member(Var, Vars),
- instmap.lookup_var(InstMap0, Var, Inst0),
+ instmap_lookup_var(InstMap0, Var, Inst0),
inst_expand(ModuleInfo0, Inst0, Inst1),
( Inst1 = ground(unique, _)
; Inst1 = bound(unique, _)
@@ -252,7 +252,7 @@
->
make_mostly_uniq_inst(Inst0, Inst, ModuleInfo0, ModuleInfo),
mode_info_set_module_info(ModuleInfo, !ModeInfo),
- instmap.set(Var, Inst, InstMap0, InstMap),
+ instmap_set_var(Var, Inst, InstMap0, InstMap),
mode_info_set_instmap(InstMap, !ModeInfo)
;
true
@@ -440,7 +440,7 @@
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) ->
+ ( instmap_is_reachable(InstMapCond) ->
unique_modes_check_goal(Then0, Then, !ModeInfo, !IO),
mode_info_get_instmap(!.ModeInfo, InstMapThen)
;
@@ -498,11 +498,21 @@
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),
- mode_info_set_in_from_ground_term(in_from_ground_term, !ModeInfo),
- unique_modes_check_goal(SubGoal0, SubGoal, !ModeInfo, !IO),
- mode_info_set_in_from_ground_term(WasInFromGroundTerm, !ModeInfo)
+ ( Reason = from_ground_term(TermVar, from_ground_term_construct) ->
+ % The subgoal was left in its final state during (non-unique) mode
+ % checking. All we need to do here is to add the relevant information
+ % in the goal to ModeInfo.
+ SubGoal = SubGoal0,
+ SubGoal = hlds_goal(_, SubGoalInfo),
+ InstMapDelta = goal_info_get_instmap_delta(SubGoalInfo),
+ ( instmap_delta_search_var(InstMapDelta, TermVar, TermVarInst) ->
+ mode_info_get_instmap(!.ModeInfo, InstMap0),
+ instmap_set_var(TermVar, TermVarInst, InstMap0, InstMap),
+ mode_info_set_instmap(InstMap, !ModeInfo)
+ ;
+ unexpected(this_file,
+ "unique_modes_check_goal_scope: term var not in InstMapDelta")
+ )
;
unique_modes_check_goal(SubGoal0, SubGoal, !ModeInfo, !IO)
),
@@ -594,9 +604,9 @@
;
Cases0 = [_ | _],
NonLocals = goal_info_get_nonlocals(GoalInfo0),
- unique_modes_check_case_list(Cases0, Var, Cases, InstMapList,
+ unique_modes_check_case_list(Cases0, Var, Cases, InstMaps,
!ModeInfo, !IO),
- instmap_merge(NonLocals, InstMapList, merge_disj, !ModeInfo)
+ instmap_merge(NonLocals, InstMaps, merge_disj, !ModeInfo)
),
GoalExpr = switch(Var, CanFail, Cases),
mode_checkpoint(exit, "switch", !ModeInfo, !IO).
@@ -699,7 +709,7 @@
% mode error in callee for this mode
WaitingVars = set.list_to_set(ArgVars),
mode_info_get_instmap(!.ModeInfo, InstMap),
- instmap.lookup_vars(ArgVars, InstMap, ArgInsts),
+ instmap_lookup_vars(InstMap, ArgVars, ArgInsts),
mode_info_error(WaitingVars,
mode_error_in_callee(ArgVars, ArgInsts, PredId, ProcId0,
ProcInfo ^ mode_errors),
@@ -828,7 +838,7 @@
mode_info_remove_live_vars(NonLocals, !ModeInfo),
unique_modes_check_goal(Goal0, Goal, !ModeInfo, !IO),
mode_info_get_instmap(!.ModeInfo, InstMap),
- ( instmap.is_unreachable(InstMap) ->
+ ( instmap_is_unreachable(InstMap) ->
% We should not mode-analyse the remaining goals, since they are
% unreachable. Instead we optimize them away, so that later passes
% won't complain about them not having unique mode information.
@@ -886,12 +896,13 @@
Multiplicity > 1
), NonLocalVarsList, SharedList),
mode_info_get_instmap(!.ModeInfo, InstMap0),
- instmap.lookup_vars(SharedList, InstMap0, VarInsts),
+ instmap_lookup_vars(InstMap0, SharedList, VarInsts),
mode_info_get_module_info(!.ModeInfo, ModuleInfo0),
make_shared_inst_list(VarInsts, SharedVarInsts,
ModuleInfo0, ModuleInfo1),
mode_info_set_module_info(ModuleInfo1, !ModeInfo),
- instmap.set_vars(SharedList, SharedVarInsts, InstMap0, InstMap1),
+ instmap_set_vars_corresponding(SharedList, SharedVarInsts,
+ InstMap0, InstMap1),
mode_info_set_instmap(InstMap1, !ModeInfo).
% Just process each conjunct in turn. Because we have already done
@@ -979,7 +990,7 @@
modecheck_functors_test(Var, MainConsId, OtherConsIds, !ModeInfo),
mode_info_get_instmap(!.ModeInfo, InstMap1),
- ( instmap.is_reachable(InstMap1) ->
+ ( instmap_is_reachable(InstMap1) ->
unique_modes_check_goal(Goal0, Goal1, !ModeInfo, !IO)
;
% We should not mode-analyse the goal, since it is unreachable.
Index: compiler/unneeded_code.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unneeded_code.m,v
retrieving revision 1.48
diff -u -b -r1.48 unneeded_code.m
--- compiler/unneeded_code.m 4 Sep 2008 11:41:01 -0000 1.48
+++ compiler/unneeded_code.m 11 Dec 2008 15:53:48 -0000
@@ -66,7 +66,7 @@
%-----------------------------------------------------------------------------%
-:- pred process_proc_msg(pred_id::in, proc_id::in,
+:- pred unneeded_process_proc_msg(pred_id::in, proc_id::in,
proc_info::in, proc_info::out, module_info::in, module_info::out,
io::di, io::uo) is det.
@@ -214,7 +214,7 @@
%-----------------------------------------------------------------------------%
-process_proc_msg(PredId, ProcId, !ProcInfo, !ModuleInfo, !IO) :-
+unneeded_process_proc_msg(PredId, ProcId, !ProcInfo, !ModuleInfo, !IO) :-
% The transformation considers every nonlocal variable of a goal
% that is bound on entry to be consumed by that goal. If the nonlocal set
% contains any such variables that are not actually needed by the goal,
@@ -228,8 +228,8 @@
io.write_string("% Removing dead code in ", !IO),
hlds_out.write_pred_proc_id_pair(!.ModuleInfo, PredId, ProcId, !IO),
io.write_string(" ...\n", !IO),
- pre_process_proc(!ProcInfo),
- process_proc(!ProcInfo, !ModuleInfo, PredId, 1, Successful),
+ unneeded_pre_process_proc(!ProcInfo),
+ unneeded_process_proc(!ProcInfo, !ModuleInfo, PredId, 1, Successful),
(
Successful = yes,
io.write_string("% done.\n", !IO)
@@ -239,13 +239,13 @@
)
;
VeryVerbose = no,
- pre_process_proc(!ProcInfo),
- process_proc(!ProcInfo, !ModuleInfo, PredId, 1, _)
+ unneeded_pre_process_proc(!ProcInfo),
+ unneeded_process_proc(!ProcInfo, !ModuleInfo, PredId, 1, _)
).
-:- pred pre_process_proc(proc_info::in, proc_info::out) is det.
+:- pred unneeded_pre_process_proc(proc_info::in, proc_info::out) is det.
-pre_process_proc(!ProcInfo) :-
+unneeded_pre_process_proc(!ProcInfo) :-
proc_info_get_headvars(!.ProcInfo, HeadVars),
proc_info_get_goal(!.ProcInfo, Goal0),
proc_info_get_varset(!.ProcInfo, VarSet0),
@@ -292,10 +292,10 @@
debug :: bool
).
-:- pred process_proc(proc_info::in, proc_info::out,
+:- pred unneeded_process_proc(proc_info::in, proc_info::out,
module_info::in, module_info::out, pred_id::in, int::in, bool::out) is det.
-process_proc(!ProcInfo, !ModuleInfo, PredId, Pass, Successful) :-
+unneeded_process_proc(!ProcInfo, !ModuleInfo, PredId, Pass, Successful) :-
fill_goal_path_slots(!.ModuleInfo, !ProcInfo),
proc_info_get_goal(!.ProcInfo, Goal0),
proc_info_get_varset(!.ProcInfo, VarSet0),
@@ -344,12 +344,12 @@
)
)
),
- process_goal(Goal0, Goal1, InitInstMap, FinalInstMap, VarTypes0,
+ unneeded_process_goal(Goal0, Goal1, InitInstMap, FinalInstMap, VarTypes0,
!.ModuleInfo, Options, WhereNeededMap1, _, map.init, RefinedGoals1,
no, Changed),
- refine_goal(Goal1, Goal2, RefinedGoals1, RefinedGoals),
+ unneeded_refine_goal(Goal1, Goal2, RefinedGoals1, RefinedGoals),
expect(map.is_empty(RefinedGoals),
- this_file, "process_proc: goal reattachment unsuccessful"),
+ this_file, "unneeded_process_proc: goal reattachment unsuccessful"),
(
Changed = yes,
% We need to fix up the goal_info by recalculating the nonlocal vars
@@ -369,7 +369,7 @@
( Pass > 3 ->
true
;
- process_proc(!ProcInfo, !ModuleInfo, PredId, Pass + 1, _)
+ unneeded_process_proc(!ProcInfo, !ModuleInfo, PredId, Pass + 1, _)
),
Successful = yes
;
@@ -377,19 +377,20 @@
Successful = no
).
-:- pred process_goal(hlds_goal::in, hlds_goal::out, instmap::in, instmap::in,
- vartypes::in, module_info::in, option_values::in,
+:- pred unneeded_process_goal(hlds_goal::in, hlds_goal::out,
+ instmap::in, instmap::in, vartypes::in, module_info::in, option_values::in,
where_needed_map::in, where_needed_map::out,
refined_goal_map::in, refined_goal_map::out, bool::in, bool::out) is det.
-process_goal(Goal0, Goal, InitInstMap, FinalInstMap, VarTypes, ModuleInfo,
- Options, !WhereNeededMap, !RefinedGoals, !Changed) :-
+unneeded_process_goal(Goal0, Goal, InitInstMap, FinalInstMap, VarTypes,
+ ModuleInfo, Options, !WhereNeededMap, !RefinedGoals, !Changed) :-
can_eliminate_or_move(Goal0, InitInstMap, FinalInstMap,
VarTypes, ModuleInfo, Options, !.WhereNeededMap, WhereInfo),
(
WhereInfo = everywhere,
- process_goal_internal(Goal0, Goal, InitInstMap, FinalInstMap, VarTypes,
- ModuleInfo, Options, !WhereNeededMap, !RefinedGoals, !Changed)
+ unneeded_process_goal_internal(Goal0, Goal, InitInstMap, FinalInstMap,
+ VarTypes, ModuleInfo, Options, !WhereNeededMap, !RefinedGoals,
+ !Changed)
;
WhereInfo = branches(Branches),
demand_inputs(Goal0, ModuleInfo, InitInstMap, WhereInfo,
@@ -570,7 +571,7 @@
prog_var::in) is semidet.
nonlocal_may_be_input(ModuleInfo, InstMap, Var) :-
- instmap.lookup_var(InstMap, Var, Inst),
+ instmap_lookup_var(InstMap, Var, Inst),
inst_is_bound(ModuleInfo, Inst).
%---------------------------------------------------------------------------%
@@ -590,7 +591,7 @@
prog_var::in) is semidet.
nonlocal_is_virgin_output(ModuleInfo, InstMap, Var) :-
- instmap.lookup_var(InstMap, Var, Inst),
+ instmap_lookup_var(InstMap, Var, Inst),
\+ inst_is_bound(ModuleInfo, Inst).
%---------------------------------------------------------------------------%
@@ -621,13 +622,14 @@
%---------------------------------------------------------------------------%
-:- pred process_goal_internal(hlds_goal::in, hlds_goal::out,
+:- pred unneeded_process_goal_internal(hlds_goal::in, hlds_goal::out,
instmap::in, instmap::in, vartypes::in, module_info::in,
option_values::in, where_needed_map::in, where_needed_map::out,
refined_goal_map::in, refined_goal_map::out, bool::in, bool::out) is det.
-process_goal_internal(Goal0, Goal, InitInstMap, FinalInstMap, VarTypes,
- ModuleInfo, Options, !WhereNeededMap, !RefinedGoals, !Changed) :-
+unneeded_process_goal_internal(Goal0, Goal, InitInstMap, FinalInstMap,
+ VarTypes, ModuleInfo, Options, !WhereNeededMap, !RefinedGoals,
+ !Changed) :-
Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
(
GoalExpr0 = unify(_, _, _, _, _),
@@ -653,9 +655,9 @@
GoalExpr0 = conj(ConjType, Conjuncts0),
(
ConjType = plain_conj,
- process_conj(Conjuncts0, Conjuncts, InitInstMap, FinalInstMap,
- VarTypes, ModuleInfo, Options, !WhereNeededMap, !RefinedGoals,
- !Changed),
+ unneeded_process_conj(Conjuncts0, Conjuncts,
+ InitInstMap, FinalInstMap, VarTypes, ModuleInfo, Options,
+ !WhereNeededMap, !RefinedGoals, !Changed),
GoalExpr = conj(plain_conj, Conjuncts),
Goal = hlds_goal(GoalExpr, GoalInfo0)
;
@@ -674,15 +676,17 @@
->
MaybeNumAlt = MaybeNumAltPrime
;
- unexpected(this_file, "process_goal_internal: switch count")
+ unexpected(this_file,
+ "unneeded_process_goal_internal: switch count")
),
GoalPath = goal_info_get_goal_path(GoalInfo0),
BranchPoint = branch_point(GoalPath, alt_switch(MaybeNumAlt)),
map.map_values(demand_var_everywhere, !WhereNeededMap),
map.init(BranchNeededMap0),
- process_cases(Cases0, Cases, BranchPoint, 1, InitInstMap, FinalInstMap,
- VarTypes, ModuleInfo, Options, GoalPath, !.WhereNeededMap,
- BranchNeededMap0, BranchNeededMap, !RefinedGoals, !Changed),
+ unneeded_process_cases(Cases0, Cases, BranchPoint, 1,
+ InitInstMap, FinalInstMap, VarTypes, ModuleInfo, Options, GoalPath,
+ !.WhereNeededMap, BranchNeededMap0, BranchNeededMap, !RefinedGoals,
+ !Changed),
merge_where_needed_maps(GoalPath, !.WhereNeededMap,
BranchNeededMap, !:WhereNeededMap),
demand_var(GoalPath, everywhere, SwitchVar, !WhereNeededMap),
@@ -692,7 +696,7 @@
GoalExpr0 = disj(Disjuncts0),
GoalPath = goal_info_get_goal_path(GoalInfo0),
map.map_values(demand_var_everywhere, !WhereNeededMap),
- process_disj(Disjuncts0, Disjuncts, InitInstMap, FinalInstMap,
+ unneeded_process_disj(Disjuncts0, Disjuncts, InitInstMap, FinalInstMap,
VarTypes, ModuleInfo, Options, GoalPath,
!.WhereNeededMap, !.WhereNeededMap, !:WhereNeededMap,
!RefinedGoals, !Changed),
@@ -703,28 +707,33 @@
GoalPath = goal_info_get_goal_path(GoalInfo0),
BranchPoint = branch_point(GoalPath, alt_ite),
map.map_values(demand_var_everywhere, !WhereNeededMap),
- process_ite(Cond0, Cond, Then0, Then, Else0, Else, BranchPoint,
- InitInstMap, FinalInstMap, VarTypes, ModuleInfo, Options, GoalPath,
- !WhereNeededMap, !RefinedGoals, !Changed),
+ unneeded_process_ite(Cond0, Cond, Then0, Then, Else0, Else,
+ BranchPoint, InitInstMap, FinalInstMap, VarTypes, ModuleInfo,
+ Options, GoalPath, !WhereNeededMap, !RefinedGoals, !Changed),
GoalExpr = if_then_else(Quant, Cond, Then, Else),
Goal = hlds_goal(GoalExpr, GoalInfo0)
;
GoalExpr0 = negation(NegGoal0),
- process_goal(NegGoal0, NegGoal, InitInstMap, FinalInstMap,
+ unneeded_process_goal(NegGoal0, NegGoal, InitInstMap, FinalInstMap,
VarTypes, ModuleInfo, Options,
!WhereNeededMap, !RefinedGoals, !Changed),
GoalExpr = negation(NegGoal),
Goal = hlds_goal(GoalExpr, GoalInfo0)
;
GoalExpr0 = scope(Reason, SomeGoal0),
- process_goal(SomeGoal0, SomeGoal, InitInstMap, FinalInstMap, VarTypes,
- ModuleInfo, Options, !WhereNeededMap, !RefinedGoals, !Changed),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ Goal = Goal0
+ ;
+ unneeded_process_goal(SomeGoal0, SomeGoal,
+ InitInstMap, FinalInstMap, VarTypes, ModuleInfo, Options,
+ !WhereNeededMap, !RefinedGoals, !Changed),
GoalExpr = scope(Reason, SomeGoal),
Goal = hlds_goal(GoalExpr, GoalInfo0)
+ )
;
GoalExpr0 = shorthand(_),
% These should have been expanded out by now.
- unexpected(this_file, "shorthand in process_goal_internal")
+ unexpected(this_file, "unneeded_process_goal_internal: shorthand")
).
%---------------------------------------------------------------------------%
@@ -732,16 +741,16 @@
:- type bracketed_goal
---> bracketed_goal(hlds_goal, instmap, instmap).
-:- pred process_conj(list(hlds_goal)::in, list(hlds_goal)::out,
+:- pred unneeded_process_conj(list(hlds_goal)::in, list(hlds_goal)::out,
instmap::in, instmap::in, vartypes::in, module_info::in,
option_values::in, where_needed_map::in, where_needed_map::out,
refined_goal_map::in, refined_goal_map::out, bool::in, bool::out) is det.
-process_conj(Goals0, Goals, InitInstMap, _FinalInstMap, VarTypes, ModuleInfo,
- Options, !WhereNeededMap, !RefinedGoals, !Changed) :-
+unneeded_process_conj(Goals0, Goals, InitInstMap, _FinalInstMap, VarTypes,
+ ModuleInfo, Options, !WhereNeededMap, !RefinedGoals, !Changed) :-
build_bracketed_conj(Goals0, InitInstMap, BracketedGoals),
list.reverse(BracketedGoals, RevBracketedGoals),
- process_rev_bracketed_conj(RevBracketedGoals, RevGoals, VarTypes,
+ unneeded_process_rev_bracketed_conj(RevBracketedGoals, RevGoals, VarTypes,
ModuleInfo, Options, !WhereNeededMap, !RefinedGoals, !Changed),
list.reverse(RevGoals, Goals).
@@ -750,7 +759,7 @@
build_bracketed_conj([], _, []).
build_bracketed_conj([Goal | Goals], InitInstMap, BracketedGoals) :-
- ( instmap.is_unreachable(InitInstMap) ->
+ ( instmap_is_unreachable(InitInstMap) ->
BracketedGoals = []
;
Goal = hlds_goal(_, GoalInfo),
@@ -761,19 +770,20 @@
BracketedGoals = [BracketedGoal | BracketedTail]
).
-:- pred process_rev_bracketed_conj(list(bracketed_goal)::in,
+:- pred unneeded_process_rev_bracketed_conj(list(bracketed_goal)::in,
list(hlds_goal)::out, vartypes::in, module_info::in, option_values::in,
where_needed_map::in, where_needed_map::out,
refined_goal_map::in, refined_goal_map::out, bool::in, bool::out) is det.
-process_rev_bracketed_conj([], [], _, _, _,
+unneeded_process_rev_bracketed_conj([], [], _, _, _,
!WhereNeededMap, !RefinedGoals, !Changed).
-process_rev_bracketed_conj([BracketedGoal | BracketedGoals], Goals, VarTypes,
- ModuleInfo, Options, !WhereNeededMap, !RefinedGoals, !Changed) :-
+unneeded_process_rev_bracketed_conj([BracketedGoal | BracketedGoals], Goals,
+ VarTypes, ModuleInfo, Options, !WhereNeededMap, !RefinedGoals,
+ !Changed) :-
BracketedGoal = bracketed_goal(Goal0, InitInstMap, FinalInstMap),
- process_goal(Goal0, Goal1, InitInstMap, FinalInstMap, VarTypes,
+ unneeded_process_goal(Goal0, Goal1, InitInstMap, FinalInstMap, VarTypes,
ModuleInfo, Options, !WhereNeededMap, !RefinedGoals, !Changed),
- process_rev_bracketed_conj(BracketedGoals, Goals1, VarTypes,
+ unneeded_process_rev_bracketed_conj(BracketedGoals, Goals1, VarTypes,
ModuleInfo, Options, !WhereNeededMap, !RefinedGoals, !Changed),
( Goal1 = hlds_goal(true_goal_expr, _) ->
Goals = Goals1
@@ -783,74 +793,75 @@
%---------------------------------------------------------------------------%
-:- pred process_disj(list(hlds_goal)::in, list(hlds_goal)::out,
+:- pred unneeded_process_disj(list(hlds_goal)::in, list(hlds_goal)::out,
instmap::in, instmap::in, vartypes::in, module_info::in,
option_values::in, goal_path::in,
where_needed_map::in, where_needed_map::in, where_needed_map::out,
refined_goal_map::in, refined_goal_map::out, bool::in, bool::out) is det.
-process_disj([], [], _, _, _, _, _, _, _,
+unneeded_process_disj([], [], _, _, _, _, _, _, _,
!WhereNeededMap, !RefinedGoals, !Changed).
-process_disj([Goal0 | Goals0], [Goal | Goals], InitInstMap, FinalInstMap,
- VarTypes, ModuleInfo, Options, CurrentPath,
+unneeded_process_disj([Goal0 | Goals0], [Goal | Goals],
+ InitInstMap, FinalInstMap, VarTypes, ModuleInfo, Options, CurrentPath,
StartWhereNeededMap, !WhereNeededMap, !RefinedGoals, !Changed) :-
- process_goal(Goal0, Goal, InitInstMap, FinalInstMap, VarTypes, ModuleInfo,
- Options, StartWhereNeededMap, WhereNeededMapFirst, !RefinedGoals,
- !Changed),
+ unneeded_process_goal(Goal0, Goal, InitInstMap, FinalInstMap, VarTypes,
+ ModuleInfo, Options, StartWhereNeededMap, WhereNeededMapFirst,
+ !RefinedGoals, !Changed),
map.to_assoc_list(WhereNeededMapFirst, WhereNeededList),
add_where_needed_list(WhereNeededList, CurrentPath, !WhereNeededMap),
- process_disj(Goals0, Goals, InitInstMap, FinalInstMap, VarTypes,
+ unneeded_process_disj(Goals0, Goals, InitInstMap, FinalInstMap, VarTypes,
ModuleInfo, Options, CurrentPath, StartWhereNeededMap,
!WhereNeededMap, !RefinedGoals, !Changed).
%---------------------------------------------------------------------------%
-:- pred process_cases(list(case)::in, list(case)::out, branch_point::in,
- int::in, instmap::in, instmap::in, vartypes::in, module_info::in,
- option_values::in, goal_path::in, where_needed_map::in,
+:- pred unneeded_process_cases(list(case)::in, list(case)::out,
+ branch_point::in, int::in, instmap::in, instmap::in, vartypes::in,
+ module_info::in, option_values::in, goal_path::in, where_needed_map::in,
where_needed_map::in, where_needed_map::out,
refined_goal_map::in, refined_goal_map::out,
bool::in, bool::out) is det.
-process_cases([], [], _, _, _, _, _, _, _, _, _,
+unneeded_process_cases([], [], _, _, _, _, _, _, _, _, _,
!WhereNeededMap, !RefinedGoals, !Changed).
-process_cases([Case0 | Cases0], [Case | Cases], BranchPoint, BranchNum,
- InitInstMap, FinalInstMap, VarTypes, ModuleInfo, Options, CurrentPath,
- StartWhereNeededMap, !WhereNeededMap, !RefinedGoals, !Changed) :-
+unneeded_process_cases([Case0 | Cases0], [Case | Cases],
+ BranchPoint, BranchNum, InitInstMap, FinalInstMap, VarTypes,
+ ModuleInfo, Options, CurrentPath, StartWhereNeededMap,
+ !WhereNeededMap, !RefinedGoals, !Changed) :-
Case0 = case(MainConsId, OtherConsIds, Goal0),
- process_goal(Goal0, Goal, InitInstMap, FinalInstMap, VarTypes, ModuleInfo,
- Options, StartWhereNeededMap, WhereNeededMapFirst, !RefinedGoals,
- !Changed),
+ unneeded_process_goal(Goal0, Goal, InitInstMap, FinalInstMap, VarTypes,
+ ModuleInfo, Options, StartWhereNeededMap, WhereNeededMapFirst,
+ !RefinedGoals, !Changed),
Case = case(MainConsId, OtherConsIds, Goal),
map.to_assoc_list(WhereNeededMapFirst, WhereNeededList),
add_alt_start(WhereNeededList, BranchPoint, BranchNum, CurrentPath,
!WhereNeededMap),
- process_cases(Cases0, Cases, BranchPoint, BranchNum + 1,
+ unneeded_process_cases(Cases0, Cases, BranchPoint, BranchNum + 1,
InitInstMap, FinalInstMap, VarTypes, ModuleInfo, Options, CurrentPath,
StartWhereNeededMap, !WhereNeededMap, !RefinedGoals, !Changed).
%---------------------------------------------------------------------------%
-:- pred process_ite(hlds_goal::in, hlds_goal::out,
+:- pred unneeded_process_ite(hlds_goal::in, hlds_goal::out,
hlds_goal::in, hlds_goal::out, hlds_goal::in, hlds_goal::out,
branch_point::in, instmap::in, instmap::in, vartypes::in,
module_info::in, option_values::in, goal_path::in,
where_needed_map::in, where_needed_map::out,
refined_goal_map::in, refined_goal_map::out, bool::in, bool::out) is det.
-process_ite(Cond0, Cond, Then0, Then, Else0, Else, BranchPoint,
+unneeded_process_ite(Cond0, Cond, Then0, Then, Else0, Else, BranchPoint,
InitInstMap, FinalInstMap, VarTypes, ModuleInfo, Options,
CurrentPath, !WhereNeededMap, !RefinedGoals, !Changed) :-
Cond0 = hlds_goal(_, CondInfo0),
InstMapDelta = goal_info_get_instmap_delta(CondInfo0),
instmap.apply_instmap_delta(InitInstMap, InstMapDelta, InstMapCond),
- process_goal(Else0, Else, InitInstMap, FinalInstMap, VarTypes, ModuleInfo,
- Options, !.WhereNeededMap, WhereNeededMapElse, !RefinedGoals,
- !Changed),
- process_goal(Then0, Then, InstMapCond, FinalInstMap, VarTypes, ModuleInfo,
- Options, !.WhereNeededMap, WhereNeededMapThen, !RefinedGoals,
- !Changed),
+ unneeded_process_goal(Else0, Else, InitInstMap, FinalInstMap, VarTypes,
+ ModuleInfo, Options, !.WhereNeededMap, WhereNeededMapElse,
+ !RefinedGoals, !Changed),
+ unneeded_process_goal(Then0, Then, InstMapCond, FinalInstMap, VarTypes,
+ ModuleInfo, Options, !.WhereNeededMap, WhereNeededMapThen,
+ !RefinedGoals, !Changed),
map.init(BranchNeededMap0),
map.to_assoc_list(WhereNeededMapElse, WhereNeededListElse),
@@ -862,7 +873,7 @@
merge_where_needed_maps(CurrentPath,
!.WhereNeededMap, BranchNeededMap, WhereNeededMapCond),
- process_goal(Cond0, Cond, InitInstMap, InstMapCond,
+ unneeded_process_goal(Cond0, Cond, InitInstMap, InstMapCond,
VarTypes, ModuleInfo, Options, WhereNeededMapCond,
!:WhereNeededMap, !RefinedGoals, !Changed).
@@ -933,10 +944,10 @@
%---------------------------------------------------------------------------%
-:- pred refine_goal(hlds_goal::in, hlds_goal::out,
+:- pred unneeded_refine_goal(hlds_goal::in, hlds_goal::out,
refined_goal_map::in, refined_goal_map::out) is det.
-refine_goal(Goal0, Goal, !RefinedGoals) :-
+unneeded_refine_goal(Goal0, Goal, !RefinedGoals) :-
Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
(
( GoalExpr0 = unify(_, _, _, _, _)
@@ -949,7 +960,7 @@
GoalExpr0 = conj(ConjType, Conjuncts0),
(
ConjType = plain_conj,
- refine_conj(Conjuncts0, Conjuncts, !RefinedGoals),
+ unneeded_refine_conj(Conjuncts0, Conjuncts, !RefinedGoals),
GoalExpr = conj(ConjType, Conjuncts),
Goal = hlds_goal(GoalExpr, GoalInfo0)
;
@@ -959,59 +970,64 @@
;
GoalExpr0 = switch(SwitchVar, CanFail, Cases0),
GoalPath = goal_info_get_goal_path(GoalInfo0),
- refine_cases(Cases0, Cases, !RefinedGoals, GoalPath, 1),
+ unneeded_refine_cases(Cases0, Cases, !RefinedGoals, GoalPath, 1),
GoalExpr = switch(SwitchVar, CanFail, Cases),
Goal = hlds_goal(GoalExpr, GoalInfo0)
;
GoalExpr0 = disj(Disjuncts0),
GoalPath = goal_info_get_goal_path(GoalInfo0),
- refine_disj(Disjuncts0, Disjuncts, !RefinedGoals, GoalPath, 1),
+ unneeded_refine_disj(Disjuncts0, Disjuncts, !RefinedGoals,
+ GoalPath, 1),
GoalExpr = disj(Disjuncts),
Goal = hlds_goal(GoalExpr, GoalInfo0)
;
GoalExpr0 = if_then_else(Quant, Cond0, Then0, Else0),
GoalPath = goal_info_get_goal_path(GoalInfo0),
- refine_ite(Cond0, Cond, Then0, Then, Else0, Else, !RefinedGoals,
- GoalPath),
+ unneeded_refine_ite(Cond0, Cond, Then0, Then, Else0, Else,
+ !RefinedGoals, GoalPath),
GoalExpr = if_then_else(Quant, Cond, Then, Else),
Goal = hlds_goal(GoalExpr, GoalInfo0)
;
GoalExpr0 = negation(NegGoal0),
- refine_goal(NegGoal0, NegGoal, !RefinedGoals),
+ unneeded_refine_goal(NegGoal0, NegGoal, !RefinedGoals),
GoalExpr = negation(NegGoal),
Goal = hlds_goal(GoalExpr, GoalInfo0)
;
GoalExpr0 = scope(Reason, SomeGoal0),
- refine_goal(SomeGoal0, SomeGoal, !RefinedGoals),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ Goal = Goal0
+ ;
+ unneeded_refine_goal(SomeGoal0, SomeGoal, !RefinedGoals),
GoalExpr = scope(Reason, SomeGoal),
Goal = hlds_goal(GoalExpr, GoalInfo0)
+ )
;
GoalExpr0 = shorthand(_),
- unexpected(this_file, "shorthand in refine_goal")
+ unexpected(this_file, "unneeded_refine_goal: shorthand")
).
-:- pred refine_conj(list(hlds_goal)::in, list(hlds_goal)::out,
+:- pred unneeded_refine_conj(list(hlds_goal)::in, list(hlds_goal)::out,
refined_goal_map::in, refined_goal_map::out) is det.
-refine_conj([], [], !RefinedGoals).
-refine_conj([Goal0 | Goals0], Goals, !RefinedGoals) :-
- refine_goal(Goal0, HeadGoal, !RefinedGoals),
- refine_conj(Goals0, TailGoals, !RefinedGoals),
+unneeded_refine_conj([], [], !RefinedGoals).
+unneeded_refine_conj([Goal0 | Goals0], Goals, !RefinedGoals) :-
+ unneeded_refine_goal(Goal0, HeadGoal, !RefinedGoals),
+ unneeded_refine_conj(Goals0, TailGoals, !RefinedGoals),
( HeadGoal = hlds_goal(conj(plain_conj, HeadGoals), _) ->
Goals = HeadGoals ++ TailGoals
;
Goals = [HeadGoal | TailGoals]
).
-:- pred refine_cases(list(case)::in, list(case)::out,
+:- pred unneeded_refine_cases(list(case)::in, list(case)::out,
refined_goal_map::in, refined_goal_map::out,
goal_path::in, int::in) is det.
-refine_cases([], [], !RefinedGoals, _, _).
-refine_cases([Case0 | Cases0], [Case | Cases], !RefinedGoals, GoalPath,
- BranchNum) :-
+unneeded_refine_cases([], [], !RefinedGoals, _, _).
+unneeded_refine_cases([Case0 | Cases0], [Case | Cases], !RefinedGoals,
+ GoalPath, BranchNum) :-
Case0 = case(MainConsId, OtherConsIds, Goal0),
- refine_goal(Goal0, Goal1, !RefinedGoals),
+ unneeded_refine_goal(Goal0, Goal1, !RefinedGoals),
( map.search(!.RefinedGoals, GoalPath - BranchNum, ToInsertGoals) ->
insert_refine_goals(ToInsertGoals, Goal1, Goal),
svmap.delete(GoalPath - BranchNum, !RefinedGoals)
@@ -1019,33 +1035,35 @@
Goal = Goal1
),
Case = case(MainConsId, OtherConsIds, Goal),
- refine_cases(Cases0, Cases, !RefinedGoals, GoalPath, BranchNum + 1).
+ unneeded_refine_cases(Cases0, Cases, !RefinedGoals,
+ GoalPath, BranchNum + 1).
-:- pred refine_disj(list(hlds_goal)::in, list(hlds_goal)::out,
+:- pred unneeded_refine_disj(list(hlds_goal)::in, list(hlds_goal)::out,
refined_goal_map::in, refined_goal_map::out,
goal_path::in, int::in) is det.
-refine_disj([], [], !RefinedGoals, _, _).
-refine_disj([Goal0 | Goals0], [Goal | Goals], !RefinedGoals,
+unneeded_refine_disj([], [], !RefinedGoals, _, _).
+unneeded_refine_disj([Goal0 | Goals0], [Goal | Goals], !RefinedGoals,
GoalPath, BranchNum) :-
- refine_goal(Goal0, Goal1, !RefinedGoals),
+ unneeded_refine_goal(Goal0, Goal1, !RefinedGoals),
( map.search(!.RefinedGoals, GoalPath - BranchNum, ToInsertGoals) ->
insert_refine_goals(ToInsertGoals, Goal1, Goal),
svmap.delete(GoalPath - BranchNum, !RefinedGoals)
;
Goal = Goal1
),
- refine_disj(Goals0, Goals, !RefinedGoals, GoalPath, BranchNum + 1).
+ unneeded_refine_disj(Goals0, Goals, !RefinedGoals, GoalPath,
+ BranchNum + 1).
-:- pred refine_ite(hlds_goal::in, hlds_goal::out,
+:- pred unneeded_refine_ite(hlds_goal::in, hlds_goal::out,
hlds_goal::in, hlds_goal::out, hlds_goal::in, hlds_goal::out,
refined_goal_map::in, refined_goal_map::out, goal_path::in) is det.
-refine_ite(Cond0, Cond, Then0, Then, Else0, Else,
+unneeded_refine_ite(Cond0, Cond, Then0, Then, Else0, Else,
!RefinedGoals, GoalPath) :-
- refine_goal(Cond0, Cond, !RefinedGoals),
- refine_goal(Then0, Then1, !RefinedGoals),
- refine_goal(Else0, Else1, !RefinedGoals),
+ unneeded_refine_goal(Cond0, Cond, !RefinedGoals),
+ unneeded_refine_goal(Then0, Then1, !RefinedGoals),
+ unneeded_refine_goal(Else0, Else1, !RefinedGoals),
( map.search(!.RefinedGoals, GoalPath - 1, ToInsertGoalsThen) ->
insert_refine_goals(ToInsertGoalsThen, Then1, Then),
Index: compiler/untupling.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/untupling.m,v
retrieving revision 1.30
diff -u -b -r1.30 untupling.m
--- compiler/untupling.m 27 Feb 2008 07:23:17 -0000 1.30
+++ compiler/untupling.m 11 Dec 2008 15:53:48 -0000
@@ -543,10 +543,15 @@
Goal = hlds_goal(GoalExpr, GoalInfo0)
;
GoalExpr0 = scope(Reason, SubGoal0),
- fix_calls_in_goal(SubGoal0, SubGoal, !VarSet, !VarTypes, TransformMap,
- ModuleInfo),
+ ( Reason = from_ground_term(_, from_ground_term_construct) ->
+ % There are no calls in these scopes.
+ Goal = Goal0
+ ;
+ fix_calls_in_goal(SubGoal0, SubGoal, !VarSet, !VarTypes,
+ TransformMap, ModuleInfo),
GoalExpr = scope(Reason, SubGoal),
Goal = hlds_goal(GoalExpr, GoalInfo0)
+ )
;
GoalExpr0 = conj(ConjType, Goals0),
(
Index: compiler/unused_args.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unused_args.m,v
retrieving revision 1.156
diff -u -b -r1.156 unused_args.m
--- compiler/unused_args.m 21 Jul 2008 03:10:16 -0000 1.156
+++ compiler/unused_args.m 11 Dec 2008 15:53:48 -0000
@@ -56,7 +56,7 @@
%-----------------------------------------------------------------------------%
-:- pred unused_args.process_module(module_info::in, module_info::out,
+:- pred unused_args_process_module(module_info::in, module_info::out,
list(error_spec)::in, list(error_spec)::out, io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
@@ -120,15 +120,6 @@
%-----------------------------------------------------------------------------%
- % Information about the dependencies of a variable that is not known to be
- % used.
- %
-:- type usage_info
- ---> unused(set(prog_var), set(arg_var_in_proc)).
-
- % A collection of variable usages for each procedure.
-:- type var_usage == map(pred_proc_id, var_dep).
-
% Arguments are stored as their variable id, not their index
% in the argument vector.
:- type arg_var_in_proc
@@ -137,10 +128,19 @@
prog_var
).
+ % Information about the dependencies of a variable that is not known to be
+ % used.
+ %
+:- type usage_info
+ ---> unused(set(prog_var), set(arg_var_in_proc)).
+
% Contains dependency information for the variables in a procedure
% that are not yet known to be used.
:- type var_dep == map(prog_var, usage_info).
+ % A collection of variable usages for each procedure.
+:- type var_usage == map(pred_proc_id, var_dep).
+
:- type warning_info
---> warning_info(prog_context, string, int, list(int)).
% context, pred name, arity, list of args to warn
@@ -224,7 +224,7 @@
%-----------------------------------------------------------------------------%
-process_module(!ModuleInfo, !Specs, !IO) :-
+unused_args_process_module(!ModuleInfo, !Specs, !IO) :-
module_info_get_globals(!.ModuleInfo, Globals),
globals.lookup_bool_option(Globals, very_verbose, VeryVerbose),
init_var_usage(VarUsage0, PredProcs, ProcCallInfo0, !ModuleInfo),
@@ -305,8 +305,8 @@
ProcCallInfo0, ProcCallInfo, !ModuleInfo),
% maybe_write_string(VeryVerbose, "% Finished new preds.\n",
% !IO),
- fixup_unused_args(VarUsage, PredProcs, ProcCallInfo, !ModuleInfo,
- VeryVerbose, !IO),
+ unused_args_fixup_module(VarUsage, PredProcs, ProcCallInfo,
+ !ModuleInfo, VeryVerbose, !IO),
% maybe_write_string(VeryVerbose, "% Fixed up goals.\n", !IO),
( map.is_empty(ProcCallInfo) ->
true
@@ -490,7 +490,7 @@
proc_info_get_goal(ProcInfo, Goal),
Info = unused_args_info(!.ModuleInfo, VarTypes),
- traverse_goal(Info, Goal, !VarDep),
+ unused_args_traverse_goal(Info, Goal, !VarDep),
svmap.set(proc(PredId, ProcId), !.VarDep, !VarUsage),
!:PredProcs = [proc(PredId, ProcId) | !.PredProcs]
@@ -612,22 +612,22 @@
unarg_vartypes :: vartypes
).
-:- pred traverse_goal(unused_args_info::in, hlds_goal::in,
+:- pred unused_args_traverse_goal(unused_args_info::in, hlds_goal::in,
var_dep::in, var_dep::out) is det.
-traverse_goal(Info, Goal, !VarDep) :-
+unused_args_traverse_goal(Info, Goal, !VarDep) :-
Goal = hlds_goal(GoalExpr, _GoalInfo),
(
GoalExpr = conj(_ConjType, Goals),
- traverse_list_of_goals(Info, Goals, !VarDep)
+ unused_args_traverse_goals(Info, Goals, !VarDep)
;
GoalExpr = disj(Goals),
- traverse_list_of_goals(Info, Goals, !VarDep)
+ unused_args_traverse_goals(Info, Goals, !VarDep)
;
GoalExpr = switch(Var, _, Cases),
set_var_used(Var, !VarDep),
list_case_to_list_goal(Cases, Goals),
- traverse_list_of_goals(Info, Goals, !VarDep)
+ unused_args_traverse_goals(Info, Goals, !VarDep)
;
GoalExpr = plain_call(PredId, ProcId, Args, _, _, _),
module_info_pred_proc_info(Info ^ unarg_module_info, PredId, ProcId,
@@ -636,15 +636,21 @@
add_pred_call_arg_dep(proc(PredId, ProcId), Args, HeadVars, !VarDep)
;
GoalExpr = if_then_else(_, Cond, Then, Else),
- traverse_goal(Info, Cond, !VarDep),
- traverse_goal(Info, Then, !VarDep),
- traverse_goal(Info, Else, !VarDep)
+ unused_args_traverse_goal(Info, Cond, !VarDep),
+ unused_args_traverse_goal(Info, Then, !VarDep),
+ unused_args_traverse_goal(Info, Else, !VarDep)
;
GoalExpr = negation(SubGoal),
- traverse_goal(Info, SubGoal, !VarDep)
+ unused_args_traverse_goal(Info, SubGoal, !VarDep)
+ ;
+ GoalExpr = scope(Reason, SubGoal),
+ ( Reason = from_ground_term(_TermVar, from_ground_term_construct) ->
+ % What we do here is what we would do for a construction
+ % unification that binds TermVar to a constant, i.e. nothing.
+ true
;
- GoalExpr = scope(_, SubGoal),
- traverse_goal(Info, SubGoal, !VarDep)
+ unused_args_traverse_goal(Info, SubGoal, !VarDep)
+ )
;
GoalExpr = generic_call(GenericCall, Args, _, _),
goal_util.generic_call_vars(GenericCall, CallArgs),
@@ -654,8 +660,8 @@
GoalExpr = call_foreign_proc(_, _, _, Args, ExtraArgs, _, _),
% Only arguments with names can be used in the foreign code. The code
% in here should be kept in sync with the treatment of foreign_procs
- % in fixup_goal_expr: any variable considered unused here should be
- % renamed apart in fixup_goal_expr.
+ % in unused_args_fixup_goal_expr: any variable considered unused here
+ % should be renamed apart in unused_args_fixup_goal_expr.
ArgIsUsed = (pred(Arg::in, Var::out) is semidet :-
Arg = foreign_arg(Var, MaybeNameAndMode, _, _),
MaybeNameAndMode = yes(_)
@@ -680,7 +686,7 @@
;
Unify = deconstruct(CellVar, _, Args, Modes, CanFail, _),
expect(unify(CellVar, LHS), this_file,
- "traverse_goal: LHS != CellVar"),
+ "unused_args_traverse_goal: LHS != CellVar"),
partition_deconstruct_args(Info, Args, Modes,
InputVars, OutputVars),
% The deconstructed variable is used if any of the variables that
@@ -699,7 +705,7 @@
;
Unify = construct(CellVar, _, Args, _, _, _, _),
expect(unify(CellVar, LHS), this_file,
- "traverse_goal: LHS != CellVar"),
+ "unused_args_traverse_goal: LHS != CellVar"),
( local_var_is_used(!.VarDep, CellVar) ->
set_list_vars_used(Args, !VarDep)
;
@@ -725,7 +731,8 @@
;
GoalExpr = shorthand(_),
% These should have been expanded out by now.
- unexpected(this_file, "traverse_goal: unexpected shorthand")
+ unexpected(this_file,
+ "unused_args_traverse_goal: unexpected shorthand")
).
% Add PredProc - HeadVar as an alias for the same element of Args.
@@ -838,13 +845,13 @@
list_case_to_list_goal([case(_, _, Goal) | Cases], [Goal | Goals]) :-
list_case_to_list_goal(Cases, Goals).
-:- pred traverse_list_of_goals(unused_args_info::in, list(hlds_goal)::in,
+:- pred unused_args_traverse_goals(unused_args_info::in, list(hlds_goal)::in,
var_dep::in, var_dep::out) is det.
-traverse_list_of_goals(_, [], !VarDep).
-traverse_list_of_goals(Info, [Goal | Goals], !VarDep) :-
- traverse_goal(Info, Goal, !VarDep),
- traverse_list_of_goals(Info, Goals, !VarDep).
+unused_args_traverse_goals(_, [], !VarDep).
+unused_args_traverse_goals(Info, [Goal | Goals], !VarDep) :-
+ unused_args_traverse_goal(Info, Goal, !VarDep),
+ unused_args_traverse_goals(Info, Goals, !VarDep).
%-----------------------------------------------------------------------------%
%
@@ -1043,7 +1050,7 @@
pred_info_get_procedures(NewPredInfo0, NewProcs0),
% Assign the old procedure to a new predicate, which will be fixed up
- % in fixup_unused_args.
+ % in unused_args_fixup_module.
map.set(NewProcs0, ProcId, OrigProcInfo, NewProcs),
pred_info_set_procedures(NewProcs, NewPredInfo0, NewPredInfo),
@@ -1283,22 +1290,22 @@
% Note - we should probably remove unused variables from the type map.
%
-:- pred fixup_unused_args(var_usage::in, pred_proc_list::in,
+:- pred unused_args_fixup_module(var_usage::in, pred_proc_list::in,
proc_call_info::in, module_info::in, module_info::out, bool::in,
io::di, io::uo) is det.
-fixup_unused_args(VarUsage, PredProcs, ProcCallInfo, !ModuleInfo, VeryVerbose,
- !IO) :-
- list.foldl2(fixup_unused_args_proc(VeryVerbose, VarUsage, ProcCallInfo),
+unused_args_fixup_module(VarUsage, PredProcs, ProcCallInfo, !ModuleInfo,
+ VeryVerbose, !IO) :-
+ list.foldl2(unused_args_fixup_proc(VeryVerbose, VarUsage, ProcCallInfo),
PredProcs, !ModuleInfo, !IO).
% Note - we should probably remove unused variables from the type map.
%
-:- pred fixup_unused_args_proc(bool::in, var_usage::in, proc_call_info::in,
+:- pred unused_args_fixup_proc(bool::in, var_usage::in, proc_call_info::in,
pred_proc_id::in, module_info::in, module_info::out, io::di, io::uo)
is det.
-fixup_unused_args_proc(VeryVerbose, VarUsage, ProcCallInfo, PredProc,
+unused_args_fixup_proc(VeryVerbose, VarUsage, ProcCallInfo, PredProc,
!ModuleInfo, !IO) :-
(
VeryVerbose = yes,
@@ -1316,12 +1323,12 @@
;
VeryVerbose = no
),
- do_fixup_unused_args(VarUsage, PredProc, ProcCallInfo, !ModuleInfo).
+ do_unused_args_fixup_proc(VarUsage, PredProc, ProcCallInfo, !ModuleInfo).
-:- pred do_fixup_unused_args(var_usage::in, pred_proc_id::in,
+:- pred do_unused_args_fixup_proc(var_usage::in, pred_proc_id::in,
proc_call_info::in, module_info::in, module_info::out) is det.
-do_fixup_unused_args(VarUsage, proc(OldPredId, OldProcId), ProcCallInfo,
+do_unused_args_fixup_proc(VarUsage, proc(OldPredId, OldProcId), ProcCallInfo,
ModuleInfo0, ModuleInfo) :-
(
% Work out which proc we should be fixing up.
@@ -1361,7 +1368,7 @@
% Remove unused vars from goal.
FixupInfo0 = fixup_info(ModuleInfo0, ProcCallInfo, UnusedVars,
VarSet0, VarTypes0),
- fixup_goal(!Goal, FixupInfo0, FixupInfo, Changed),
+ unused_args_fixup_goal(!Goal, FixupInfo0, FixupInfo, Changed),
FixupInfo = fixup_info(_, _, _, VarSet1, VarTypes1),
(
Changed = yes,
@@ -1397,59 +1404,72 @@
% This is the important bit of the transformation.
%
-:- pred fixup_goal(hlds_goal::in, hlds_goal::out,
+:- pred unused_args_fixup_goal(hlds_goal::in, hlds_goal::out,
fixup_info::in, fixup_info::out, bool::out) is det.
-fixup_goal(Goal0, Goal, !Info, Changed) :-
- fixup_goal_expr(Goal0, Goal1, !Info, Changed),
+unused_args_fixup_goal(Goal0, Goal, !Info, Changed) :-
+ unused_args_fixup_goal_expr(Goal0, Goal1, !Info, Changed),
Goal1 = hlds_goal(GoalExpr1, GoalInfo1),
(
Changed = yes,
UnusedVars = !.Info ^ fixup_unused_vars,
- fixup_goal_info(UnusedVars, GoalInfo1, GoalInfo)
+ unused_args_fixup_goal_info(UnusedVars, GoalInfo1, GoalInfo)
;
Changed = no,
GoalInfo = GoalInfo1
),
Goal = hlds_goal(GoalExpr1, GoalInfo).
-:- pred fixup_goal_expr(hlds_goal::in, hlds_goal::out,
+:- pred unused_args_fixup_goal_expr(hlds_goal::in, hlds_goal::out,
fixup_info::in, fixup_info::out, bool::out) is det.
-fixup_goal_expr(hlds_goal(GoalExpr0, GoalInfo0), Goal, !Info, Changed) :-
+unused_args_fixup_goal_expr(Goal0, Goal, !Info, Changed) :-
+ Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
(
GoalExpr0 = conj(ConjType, Goals0),
- fixup_conjuncts(Goals0, Goals, !Info, no, Changed),
+ unused_args_fixup_conjuncts(Goals0, Goals, !Info, no, Changed),
GoalExpr = conj(ConjType, Goals),
Goal = hlds_goal(GoalExpr, GoalInfo0)
;
GoalExpr0 = disj(Goals0),
- fixup_disjuncts(Goals0, Goals, !Info, no, Changed),
+ unused_args_fixup_disjuncts(Goals0, Goals, !Info, no, Changed),
GoalExpr = disj(Goals),
Goal = hlds_goal(GoalExpr, GoalInfo0)
;
GoalExpr0 = negation(NegGoal0),
- fixup_goal(NegGoal0, NegGoal, !Info, Changed),
+ unused_args_fixup_goal(NegGoal0, NegGoal, !Info, Changed),
GoalExpr = negation(NegGoal),
Goal = hlds_goal(GoalExpr, GoalInfo0)
;
GoalExpr0 = switch(Var, CanFail, Cases0),
- fixup_cases(Cases0, Cases, !Info, no, Changed),
+ unused_args_fixup_cases(Cases0, Cases, !Info, no, Changed),
GoalExpr = switch(Var, CanFail, Cases),
Goal = hlds_goal(GoalExpr, GoalInfo0)
;
GoalExpr0 = if_then_else(Vars, Cond0, Then0, Else0),
- fixup_goal(Cond0, Cond, !Info, Changed1),
- fixup_goal(Then0, Then, !Info, Changed2),
- fixup_goal(Else0, Else, !Info, Changed3),
+ unused_args_fixup_goal(Cond0, Cond, !Info, Changed1),
+ unused_args_fixup_goal(Then0, Then, !Info, Changed2),
+ unused_args_fixup_goal(Else0, Else, !Info, Changed3),
bool.or_list([Changed1, Changed2, Changed3], Changed),
GoalExpr = if_then_else(Vars, Cond, Then, Else),
Goal = hlds_goal(GoalExpr, GoalInfo0)
;
GoalExpr0 = scope(Reason, SubGoal0),
- fixup_goal(SubGoal0, SubGoal, !Info, Changed),
+ ( Reason = from_ground_term(TermVar, from_ground_term_construct) ->
+ UnusedVars = !.Info ^ fixup_unused_vars,
+ ( list.member(TermVar, UnusedVars) ->
+ Goal = true_goal,
+ % We don't change the set of unneeded variables.
+ Changed = no
+ ;
+ Goal = Goal0,
+ Changed = no
+ )
+ ;
+ unused_args_fixup_goal(SubGoal0, SubGoal, !Info, Changed),
GoalExpr = scope(Reason, SubGoal),
Goal = hlds_goal(GoalExpr, GoalInfo0)
+ )
;
GoalExpr0 = plain_call(PredId, ProcId, ArgVars0, Builtin,
UnifyC, _Name),
@@ -1499,7 +1519,7 @@
;
GoalExpr0 = shorthand(_),
% These should have been expanded out by now.
- unexpected(this_file, "fixup_goal_expr: shorthand")
+ unexpected(this_file, "unused_args_fixup_goal_expr: shorthand")
).
:- pred rename_apart_unused_foreign_arg(foreign_arg::in, foreign_arg::out,
@@ -1534,12 +1554,12 @@
% Remove useless unifications from a list of conjuncts.
%
-:- pred fixup_conjuncts(hlds_goals::in, hlds_goals::out,
+:- pred unused_args_fixup_conjuncts(hlds_goals::in, hlds_goals::out,
fixup_info::in, fixup_info::out, bool::in, bool::out) is det.
-fixup_conjuncts([], [], !Info, !Changed).
-fixup_conjuncts([Goal0 | Goals0], Goals, !Info, !Changed) :-
- fixup_goal(Goal0, Goal, !Info, LocalChanged),
+unused_args_fixup_conjuncts([], [], !Info, !Changed).
+unused_args_fixup_conjuncts([Goal0 | Goals0], Goals, !Info, !Changed) :-
+ unused_args_fixup_goal(Goal0, Goal, !Info, LocalChanged),
(
LocalChanged = yes,
!:Changed = yes
@@ -1552,32 +1572,33 @@
;
Goals = [Goal | Goals1]
),
- fixup_conjuncts(Goals0, Goals1, !Info, !Changed).
+ unused_args_fixup_conjuncts(Goals0, Goals1, !Info, !Changed).
% We can't remove unused goals from the list of disjuncts as we do
% for conjuncts, since that would change the determinism of the goal.
%
-:- pred fixup_disjuncts(hlds_goals::in, hlds_goals::out,
+:- pred unused_args_fixup_disjuncts(hlds_goals::in, hlds_goals::out,
fixup_info::in, fixup_info::out, bool::in, bool::out) is det.
-fixup_disjuncts([], [], !Info, !Changed).
-fixup_disjuncts([Goal0 | Goals0], [Goal | Goals], !Info, !Changed) :-
- fixup_goal(Goal0, Goal, !Info, LocalChanged),
+unused_args_fixup_disjuncts([], [], !Info, !Changed).
+unused_args_fixup_disjuncts([Goal0 | Goals0], [Goal | Goals],
+ !Info, !Changed) :-
+ unused_args_fixup_goal(Goal0, Goal, !Info, LocalChanged),
(
LocalChanged = yes,
!:Changed = yes
;
LocalChanged = no
),
- fixup_disjuncts(Goals0, Goals, !Info, !Changed).
+ unused_args_fixup_disjuncts(Goals0, Goals, !Info, !Changed).
-:- pred fixup_cases(list(case)::in, list(case)::out,
+:- pred unused_args_fixup_cases(list(case)::in, list(case)::out,
fixup_info::in, fixup_info::out, bool::in, bool::out) is det.
-fixup_cases([], [], !Info, !Changed).
-fixup_cases([Case0 | Cases0], [Case | Cases], !Info, !Changed) :-
+unused_args_fixup_cases([], [], !Info, !Changed).
+unused_args_fixup_cases([Case0 | Cases0], [Case | Cases], !Info, !Changed) :-
Case0 = case(MainConsId, OtherConsIds, Goal0),
- fixup_goal(Goal0, Goal, !Info, LocalChanged),
+ unused_args_fixup_goal(Goal0, Goal, !Info, LocalChanged),
Case = case(MainConsId, OtherConsIds, Goal),
(
LocalChanged = yes,
@@ -1585,7 +1606,7 @@
;
LocalChanged = no
),
- fixup_cases(Cases0, Cases, !Info, !Changed).
+ unused_args_fixup_cases(Cases0, Cases, !Info, !Changed).
% Fail if the unification is no longer needed.
%
@@ -1624,7 +1645,7 @@
;
% These should have been transformed into calls by polymorphism.m.
Unify = complicated_unify(_, _, _),
- unexpected(this_file, "fixup_goal : complicated unify")
+ unexpected(this_file, "need_unify: complicated unify")
).
% Check if any of the arguments of a deconstruction are unused, if
@@ -1667,10 +1688,10 @@
% Remove unused vars from the instmap_delta, quantification fixes up
% the rest.
%
-:- pred fixup_goal_info(list(prog_var)::in, hlds_goal_info::in,
+:- pred unused_args_fixup_goal_info(list(prog_var)::in, hlds_goal_info::in,
hlds_goal_info::out) is det.
-fixup_goal_info(UnusedVars, !GoalInfo) :-
+unused_args_fixup_goal_info(UnusedVars, !GoalInfo) :-
InstMap0 = goal_info_get_instmap_delta(!.GoalInfo),
instmap_delta_delete_vars(UnusedVars, InstMap0, InstMap),
goal_info_set_instmap_delta(InstMap, !GoalInfo).
@@ -1916,8 +1937,7 @@
:- pred record_intermod_dependencies(module_info::in, pred_proc_id::in,
analysis_info::in, analysis_info::out) is det.
-record_intermod_dependencies(ModuleInfo, CallerPredProcId,
- !AnalysisInfo) :-
+record_intermod_dependencies(ModuleInfo, CallerPredProcId, !AnalysisInfo) :-
module_info_pred_proc_info(ModuleInfo, CallerPredProcId,
_CallerPredInfo, CallerProcInfo),
proc_info_get_goal(CallerProcInfo, Goal),
@@ -1928,8 +1948,8 @@
:- pred record_intermod_dependencies_2(module_info::in, pred_proc_id::in,
analysis_info::in, analysis_info::out) is det.
-record_intermod_dependencies_2(ModuleInfo,
- CalleePredProcId @ proc(CalleePredId, _), !AnalysisInfo) :-
+record_intermod_dependencies_2(ModuleInfo, CalleePredProcId, !AnalysisInfo) :-
+ CalleePredProcId = proc(CalleePredId, _),
module_info_pred_info(ModuleInfo, CalleePredId, CalleePredInfo),
(
pred_info_is_imported_not_external(CalleePredInfo),
Index: compiler/unused_imports.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unused_imports.m,v
retrieving revision 1.16
diff -u -b -r1.16 unused_imports.m
--- compiler/unused_imports.m 21 Jul 2008 03:10:16 -0000 1.16
+++ compiler/unused_imports.m 11 Dec 2008 15:53:48 -0000
@@ -411,6 +411,8 @@
GoalExpr = switch(_, _, Cases),
list.foldl(case_used_modules, Cases, !UsedModules)
;
+ % Even for from_ground_term_construct scopes, we need to check
+ % which modules are referenced by the cons_ids inside.
( GoalExpr = negation(SubGoal)
; GoalExpr = scope(_, SubGoal)
),
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing debian/patches
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
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
cvs diff: Diffing mdbcomp
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/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/analysis
cvs diff: Diffing tests/analysis/ctgc
cvs diff: Diffing tests/analysis/excp
cvs diff: Diffing tests/analysis/ext
cvs diff: Diffing tests/analysis/sharing
cvs diff: Diffing tests/analysis/table
cvs diff: Diffing tests/analysis/trail
cvs diff: Diffing tests/analysis/unused_args
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
Index: tools/binary
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/tools/binary,v
retrieving revision 1.32
diff -u -b -r1.32 binary
--- tools/binary 12 Jun 2008 03:08:42 -0000 1.32
+++ tools/binary 7 Dec 2008 08:00:21 -0000
@@ -441,6 +441,22 @@
then
echo skipping test of $testsubdir
else
+ testsubdir_modules=`ls stage2.ok/$testsubdir`
+ anydiff=false
+ for testsubdir_module in $testsubdir_modules
+ do
+ if cmp -s stage2.{bad,ok}/$testsubdir/$testsubdir_module
+ then
+ true
+ else
+ anydiff=true
+ fi
+ done
+
+ if $anydiff
+ then
+ echo testing whether the problem is in $testsubdir
+
for subdir in library mdbcomp compiler
do
if test "$subdir" = "$testsubdir"
@@ -482,6 +498,9 @@
echo "problem seems to be in the $testeddir directory"
fi
fi
+ else
+ echo skipping $testsubdir: the two stage2s match
+ fi
fi
done
@@ -522,7 +541,12 @@
cd stage2/$testeddir
for module in *.c
do
+ if cmp -s $root/stage2.{bad,ok}/$testeddir/$module.c
+ then
+ true
+ else
allmodules="$allmodules `basename $module .c`"
+ fi
done
cd $root
else
Index: tools/binary_step
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/tools/binary_step,v
retrieving revision 1.24
diff -u -b -r1.24 binary_step
--- tools/binary_step 30 May 2008 02:04:51 -0000 1.24
+++ tools/binary_step 7 Dec 2008 07:43:53 -0000
@@ -297,7 +297,8 @@
/bin/rm -f stage3/$dir/*.int
done
- if (cd stage3 ; mmake $mmake_opts depend_library depend_compiler)
+ if (cd stage3 ; mmake $mmake_opts depend_library depend_mdbcomp \
+ depend_compiler)
then
echo "building of stage 3 dependencies successful"
if $dependency_only
@@ -309,12 +310,13 @@
exit 1
fi
- MMAKE_VPATH=.
- export MMAKE_VPATH
+ # MMAKE_VPATH=.
+ # export MMAKE_VPATH
MMAKE_DIR=../scripts
export MMAKE_DIR
- if (cd stage3/library ; mmake -S $mmake_opts $jfactor ints ; mmake -S $mmake_opts $jfactor cs)
+ if (cd stage3/library ; mmake -S $mmake_opts $jfactor int3s ints ; \
+ mmake -S $mmake_opts $jfactor cs)
then
echo "building of stage 3 library successful"
if $library_only
@@ -326,7 +328,17 @@
exit 1
fi
- if (cd stage3/compiler ; mmake -S $mmake_opts $jfactor ints ; mmake -S $mmake_opts $jfactor cs)
+ if (cd stage3/mdbcomp ; mmake -S $mmake_opts $jfactor int3s ints ; \
+ mmake -S $mmake_opts $jfactor cs)
+ then
+ echo "building of stage 3 mdbcomp successful"
+ else
+ echo "building of stage 3 mdbcomp not successful"
+ exit 1
+ fi
+
+ if (cd stage3/compiler ; mmake -S $mmake_opts $jfactor int3s ints ; \
+ mmake -S $mmake_opts $jfactor cs)
then
echo "building of stage 3 compiler successful"
else
@@ -338,7 +350,7 @@
then
founddiff=false
cat /dev/null > $outfile
- for dir in library compiler
+ for dir in library mdbcomp compiler
do
# `mmake cs' in the compiler directory doesn't build
# `top_level_init.c', so we only compare the `.c'
cvs diff: Diffing trace
cvs diff: Diffing util
cvs diff: Diffing vim
cvs diff: Diffing vim/after
cvs diff: Diffing vim/ftplugin
cvs diff: Diffing vim/syntax
--------------------------------------------------------------------------
mercury-reviews mailing list
Post 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