[m-rev.] for prelim review: fix compiler performance problems on large programs
Zoltan Somogyi
zs at cs.mu.OZ.AU
Mon Mar 27 16:28:18 AEDT 2006
This is a request for a preliminary review. It containms some pieces of code
marked by ZZZ that need minor cleanups, and the final set of changes to
expected out files is not yet complete (the required bootcheck started
just now.) If I find a need for significant fixes, I will put up an interdiff
for review, but I hope that won't be necessary.
Zoltan.
Fix several performance bugs that showed up when the compiler was invoked on
Douglas Auclair's training_cars example. Also fix some minor problems that
made it harder to find the information needed to localize those problems.
training_cars.m is hard to compile quickly because it is big in two dimensions:
it has lots of clauses, and each clause has big terms.
My laptop still tries to swap itself to death on the full version of
training_cars.m (it has only 512 Mb), but the compiler now works fine
on a version containing about 20% of its clauses, whereas previously
it couldn't compile it at all.
In most cases, the changes convert N^2 algorithms to NlogN algorithms.
They probably have higher constant factors and may yield small slowdowns
for small N, but this is probably not noticeable. Avoiding bad worst case
behavior is more important.
compiler/superhomogeneous.m:
Record the number of goals inserted in each goal being converted
to superhomogeneous form. If this exceeds a threshold, wrap a
from_ground_term scope around it.
Put the predicates into a more cohesive sequence.
compiler/field_access.m:
Work with the code in superhomogeneous to record the number of inserted
goals. Reorder the arguments of some performances to be consistent
with the predicates in superhomogeneous.m.
compiler/modes.m:
Use the from_ground_term scope to reverse the list of inserted
unifications if necessary. It is much more efficient to do this here
than to let it happen by sequences of delays and wakeups. That would
have quadratic complexity; this is linear.
This is what I originally introduced from_ground_term scopes for.
Then, the overhead was too high, because I added one scope per function
symbol. This version should be fine, since there is at most one scope
added per argument of an atom (clause head or call).
compiler/modes.m:
compiler/unique_modes.m:
When we are processing goals inside a from_ground_term scope, record
this fact.
compiler/mode_info.m:
Make it possible to record this fact.
compiler/modecheck_unify.m:
When we are inside a from_ground_term scope, don't try to update the
insts of vars on the right hand sides of construction unifications.
Since these variables came from expansion to superhomogeneous form,
those variables won't occur in any following code, so updating their
state is useless, and the algorithm we used to do so is linear in the
size of the inst. Since the size of an inst of a variable that results
from superhomogeneous expansion is itself on average proportional to
the size of the original term, this change turns a quadratic algorithm
into a linear one.
compiler/inst_match.m:
Use balanced trees instead of ordered lists to represents sets of
expansions, since these sets can be large.
Note an opportunity for further improvement.
compiler/inst_util.m:
Note another opportunity for further improvement.
compiler/instmap.m:
Rename several predicates to avoid ambiguities.
compiler/cse_detection.m:
We used to print statistics for the processing of each procedure
without saying which procedure it is for; fix this.
compiler/switch_detection.m:
Don't print progress messages for predicates with no procedures,
since they would be misleading.
compiler/higher_order.m:
Change an algorithm that was quadratic in the number of arms
for merging the information from the different arms of disjunctions
and switches to an NlogN algorithm.
Change the algorithm for merging the info from two branches
that quadratic in the number of variables per arm to an NlogN
algorithm.
Changed some type equivalences to notag types to aid robustness.
compiler/quantification.m:
Rename several predicates to avoid ambiguities.
The sets of variables in different arms of disjunctions and switches
tend to have relatively small intersections. Yet the algorithms we
used to compute the set of variables free in the disjunction or switch
included the variables from the already processed arms in the sets
being accumulated when processing later arms, leading the quadratic
behavior. This diff changes the algorithm to process each arm
independently, and then use a more balanced algorithm to summarize
the result.
Specialize the predicates that compute sets of free vars in various
HLDS fragments to work either with ordinary_nonlocals or
code_gen_nonlocals without making the same decision repeatedly.
Move some code out of large predicates into predicates of their own.
compiler/Mercury.options:
Specify the compiler option that can exploit this specialization
to make the code run faster.
compiler/simplify.m:
Use a more efficient data structure for recording the parameters
of an invocation of simplification.
Change some predicate names and function symbol names to avoid
ambiguity.
compiler/common.m:
compiler/deforest.m:
compiler/deforest.m:
compiler/make_hlds_warn.m:
compiler/mercury_compile.m:
compiler/pd_util.m:
compiler/stack_opt.m:
compiler/term_constr_build.m:
Conform to the changes in simplify.m and/or instmap.m.
compiler/mercury_compile.m:
Fix a bug in progress messages for polymorphism.m.
compiler/equiv_type_hlds.m:
Most of the time, substitutions inside insts have no effect, because
very few insts include any reference to a types. Instead of the old
approach of building new insts and then throwing them away if they
are the same as the old ones, don't build new insts at all if the
old inst contains no types.
compiler/common.m:
Change some predicate names to make them clearer.
compiler/hlds_clauses.m:
Record the number of clauses so far, to allow a more informative
progress message to be printed.
compiler/add_clause.m:
Print this more informative progress message.
Conform to the changes in superhomogeneous.m.
compiler/code_gen.m:
Use the context of the predicate's first clause (which will be the
context of the first clause head) as the context of the predicate's
interface events. Unlike the context of the body goal, this won't
be affected by program transformations such as wrapping a
from_ground_term scope around some goals. It is better for users
anyway, since the old policy lead to contexts in the middle of
procedure bodies if the top level goal was a disjunction, switch or
if-then-else.
tests/debugger/*.exp:
Update the expected outputs to conform to the change to code_gen.m.
cvs diff: Diffing .
cvs diff: Diffing analysis
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/Mercury.options
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/Mercury.options,v
retrieving revision 1.21
diff -u -b -r1.21 Mercury.options
--- compiler/Mercury.options 24 Feb 2006 07:21:22 -0000 1.21
+++ compiler/Mercury.options 25 Mar 2006 15:12:53 -0000
@@ -9,7 +9,12 @@
# llds_out.m contains some sanity checking code that is usually turned off.
# However, the cost of checking whether they turned off exceeds the cost of
# performing them unless inlining is enabled.
-MCFLAGS-ll_backend.llds_out=--inlining
+MCFLAGS-ll_backend.llds_out = --inlining
+
+# Several predicates in quantification.m contain an argument which is needed
+# only to select the right mode. We want to make sure that we don't take up
+# code space or execution time to pass these arguments.
+MCFLAGS-hlds.quantification = --optimize-unused-args
# process_util.m uses `kill' and `struct sigaction' from <signal.h>,
# which are not available with `--ansi'.
Index: compiler/add_clause.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_clause.m,v
retrieving revision 1.19
diff -u -b -r1.19 add_clause.m
--- compiler/add_clause.m 24 Mar 2006 03:03:37 -0000 1.19
+++ compiler/add_clause.m 27 Mar 2006 02:44:47 -0000
@@ -44,12 +44,13 @@
% the goal, to rename it apart from the other clauses.
%
:- pred transform_goal(goal::in, prog_substitution::in, hlds_goal::out,
- prog_varset::in, prog_varset::out,
+ int::out, prog_varset::in, prog_varset::out,
module_info::in, module_info::out, qual_info::in, qual_info::out,
svar_info::in, svar_info::out, io::di, io::uo) is det.
-:- pred qualify_lambda_mode_list(list(mer_mode)::in, list(mer_mode)::out,
- prog_context::in, qual_info::in, qual_info::out, io::di, io::uo) is det.
+:- pred qualify_lambda_mode_list_if_not_opt_imported(
+ list(mer_mode)::in, list(mer_mode)::out, prog_context::in,
+ qual_info::in, qual_info::out, io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -98,20 +99,6 @@
),
ArityAdjustment = ( if IllegalSVarResult = yes(_) then -1 else 0 ),
Args = expand_bang_state_var_args(Args0),
- globals.io_lookup_bool_option(very_verbose, VeryVerbose, !IO),
- (
- VeryVerbose = yes,
- io.write_string("% Processing clause for ", !IO),
- write_pred_or_func(PredOrFunc, !IO),
- io.write_string(" `", !IO),
- list.length(Args, PredArity0),
- PredArity = PredArity0 + ArityAdjustment,
- adjust_func_arity(PredOrFunc, OrigArity, PredArity),
- prog_out.write_sym_name_and_arity(PredName/OrigArity, !IO),
- io.write_string("'...\n", !IO)
- ;
- VeryVerbose = no
- ),
% Lookup the pred declaration in the predicate table.
% (If it's not there, call maybe_undefined_pred_error
@@ -159,6 +146,25 @@
module_info_get_predicate_table(!.ModuleInfo, !:PredicateTable),
predicate_table_get_preds(!.PredicateTable, Preds0),
map.lookup(Preds0, PredId, !:PredInfo),
+
+ globals.io_lookup_bool_option(very_verbose, VeryVerbose, !IO),
+ (
+ VeryVerbose = yes,
+ pred_info_clauses_info(!.PredInfo, MsgClauses),
+ NumClauses = num_clauses_in_clauses_rep(MsgClauses ^ clauses_rep),
+ io.format("%% Processing clause %d for ", [i(NumClauses + 1)],
+ !IO),
+ write_pred_or_func(PredOrFunc, !IO),
+ io.write_string(" `", !IO),
+ list.length(Args, PredArity0),
+ PredArity = PredArity0 + ArityAdjustment,
+ adjust_func_arity(PredOrFunc, OrigArity, PredArity),
+ prog_out.write_sym_name_and_arity(PredName/OrigArity, !IO),
+ io.write_string("'...\n", !IO)
+ ;
+ VeryVerbose = no
+ ),
+
% opt_imported preds are initially tagged as imported and are
% tagged as opt_imported only if/when we see a clause for them
( Status = opt_imported ->
@@ -299,7 +305,7 @@
ModeList = ModeList0
;
qual_info_get_mq_info(!.QualInfo, MQInfo0),
- module_qual.qualify_clause_mode_list(ModeList0, ModeList, Context,
+ qualify_clause_mode_list(ModeList0, ModeList, Context,
MQInfo0, MQInfo, !IO),
qual_info_set_mq_info(MQInfo, !QualInfo)
),
@@ -505,12 +511,12 @@
;
ArgContext = head(PredOrFunc, Arity),
insert_arg_unifications(HeadVars, Args, Context, ArgContext,
- HeadGoal0, HeadGoal1, !VarSet, !ModuleInfo, !QualInfo, !SInfo,
- !IO),
+ HeadGoal0, HeadGoal1, _, !VarSet, !ModuleInfo, !QualInfo,
+ !SInfo, !IO),
attach_features_to_all_goals([from_head], HeadGoal1, HeadGoal)
),
prepare_for_body(FinalSVarMap, !VarSet, !SInfo),
- transform_goal(Body0, Subst, Body, !VarSet, !ModuleInfo, !QualInfo,
+ transform_goal(Body0, Subst, Body, _, !VarSet, !ModuleInfo, !QualInfo,
!SInfo, !IO),
finish_goals(Context, FinalSVarMap, [HeadGoal, Body], Goal0,
!.SInfo),
@@ -522,151 +528,155 @@
%-----------------------------------------------------------------------------%
-transform_goal(Goal0 - Context, Subst, Goal - GoalInfo, !VarSet,
+transform_goal(Goal0 - Context, Subst, Goal - GoalInfo, NumAdded, !VarSet,
!ModuleInfo, !QualInfo, !SInfo, !IO) :-
- transform_goal_2(Goal0, Context, Subst, Goal - GoalInfo1,
+ transform_goal_2(Goal0, Context, Subst, Goal - GoalInfo1, NumAdded,
!VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO),
goal_info_set_context(Context, GoalInfo1, GoalInfo).
:- pred transform_goal_2(goal_expr::in, prog_context::in,
- prog_substitution::in, hlds_goal::out,
+ prog_substitution::in, hlds_goal::out, int::out,
prog_varset::in, prog_varset::out,
module_info::in, module_info::out, qual_info::in, qual_info::out,
svar_info::in, svar_info::out, io::di, io::uo) is det.
-transform_goal_2(fail_expr, _, _, disj([]) - GoalInfo, !VarSet, !ModuleInfo,
- !QualInfo, !SInfo, !IO) :-
+transform_goal_2(fail_expr, _, _, disj([]) - GoalInfo, 0,
+ !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO) :-
goal_info_init(GoalInfo),
prepare_for_next_conjunct(set.init, !VarSet, !SInfo).
-transform_goal_2(true_expr, _, _, conj(plain_conj, []) - GoalInfo, !VarSet,
- !ModuleInfo, !QualInfo, !SInfo, !IO) :-
+transform_goal_2(true_expr, _, _, conj(plain_conj, []) - GoalInfo, 0,
+ !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO) :-
goal_info_init(GoalInfo),
prepare_for_next_conjunct(set.init, !VarSet, !SInfo).
-transform_goal_2(all_expr(Vars0, Goal0), Context, Subst, Goal, !VarSet,
- !ModuleInfo, !QualInfo, !SInfo, !IO) :-
+transform_goal_2(all_expr(Vars0, Goal0), Context, Subst, Goal, NumAdded,
+ !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO) :-
% Convert `all [Vars] Goal' into `not some [Vars] not Goal'.
TransformedGoal = not_expr(some_expr(Vars0, not_expr(Goal0) - Context)
- Context),
- transform_goal_2(TransformedGoal, Context, Subst, Goal, !VarSet,
- !ModuleInfo, !QualInfo, !SInfo, !IO).
+ transform_goal_2(TransformedGoal, Context, Subst, Goal, NumAdded,
+ !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO).
transform_goal_2(all_state_vars_expr(StateVars, Goal0), Context, Subst,
- Goal, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO) :-
+ Goal, NumAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO) :-
transform_goal_2(
not_expr(some_state_vars_expr(StateVars,
not_expr(Goal0) - Context) - Context),
- Context, Subst, Goal, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO).
+ Context, Subst, Goal, NumAdded, !VarSet, !ModuleInfo, !QualInfo,
+ !SInfo, !IO).
transform_goal_2(some_expr(Vars0, Goal0), _, Subst,
- scope(exist_quant(Vars), Goal) - GoalInfo,
+ scope(exist_quant(Vars), Goal) - GoalInfo, NumAdded,
!VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO) :-
substitute_vars(Vars0, Subst, Vars),
- transform_goal(Goal0, Subst, Goal, !VarSet, !ModuleInfo, !QualInfo,
- !SInfo, !IO),
+ transform_goal(Goal0, Subst, Goal, NumAdded, !VarSet, !ModuleInfo,
+ !QualInfo, !SInfo, !IO),
goal_info_init(GoalInfo).
transform_goal_2(some_state_vars_expr(StateVars0, Goal0), _, Subst,
- scope(exist_quant(Vars), Goal) - GoalInfo,
+ scope(exist_quant(Vars), Goal) - GoalInfo, NumAdded,
!VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO) :-
BeforeSInfo = !.SInfo,
substitute_vars(StateVars0, Subst, StateVars),
prepare_for_local_state_vars(StateVars, !VarSet, !SInfo),
- transform_goal(Goal0, Subst, Goal, !VarSet, !ModuleInfo, !QualInfo,
- !SInfo, !IO),
+ transform_goal(Goal0, Subst, Goal, NumAdded, !VarSet, !ModuleInfo,
+ !QualInfo, !SInfo, !IO),
finish_local_state_vars(StateVars, Vars, BeforeSInfo, !SInfo),
goal_info_init(GoalInfo).
transform_goal_2(promise_purity_expr(Implicit, Purity, Goal0), _, Subst,
- scope(promise_purity(Implicit, Purity), Goal) - GoalInfo,
+ scope(promise_purity(Implicit, Purity), Goal) - GoalInfo, NumAdded,
!VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO) :-
- transform_goal(Goal0, Subst, Goal, !VarSet, !ModuleInfo, !QualInfo,
- !SInfo, !IO),
+ transform_goal(Goal0, Subst, Goal, NumAdded, !VarSet, !ModuleInfo,
+ !QualInfo, !SInfo, !IO),
goal_info_init(GoalInfo).
transform_goal_2(
promise_equivalent_solutions_expr(Vars0, DotSVars0, ColonSVars0,
Goal0),
Context, Subst,
scope(promise_solutions(Vars, equivalent_solutions), Goal) - GoalInfo,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO) :-
+ NumAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO) :-
transform_promise_eqv_goal(Vars0, DotSVars0, ColonSVars0, Subst, Context,
- Vars, Goal0, Goal, GoalInfo, !VarSet, !ModuleInfo, !QualInfo, !SInfo,
- !IO).
+ Vars, Goal0, Goal, GoalInfo, NumAdded, !VarSet, !ModuleInfo,
+ !QualInfo, !SInfo, !IO).
transform_goal_2(
promise_equivalent_solution_sets_expr(Vars0, DotSVars0, ColonSVars0,
Goal0),
Context, Subst,
scope(promise_solutions(Vars, equivalent_solution_sets), Goal)
- GoalInfo,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO) :-
+ NumAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO) :-
transform_promise_eqv_goal(Vars0, DotSVars0, ColonSVars0, Subst, Context,
- Vars, Goal0, Goal, GoalInfo, !VarSet, !ModuleInfo, !QualInfo, !SInfo,
- !IO).
+ Vars, Goal0, Goal, GoalInfo, NumAdded, !VarSet, !ModuleInfo,
+ !QualInfo, !SInfo, !IO).
transform_goal_2(
promise_equivalent_solution_arbitrary_expr(Vars0,
DotSVars0, ColonSVars0, Goal0),
Context, Subst,
scope(promise_solutions(Vars, equivalent_solution_sets_arbitrary),
Goal) - GoalInfo,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO) :-
+ NumAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO) :-
transform_promise_eqv_goal(Vars0, DotSVars0, ColonSVars0, Subst, Context,
- Vars, Goal0, Goal, GoalInfo, !VarSet, !ModuleInfo, !QualInfo, !SInfo,
- !IO).
+ Vars, Goal0, Goal, GoalInfo, NumAdded, !VarSet, !ModuleInfo,
+ !QualInfo, !SInfo, !IO).
transform_goal_2(if_then_else_expr(Vars0, StateVars0, Cond0, Then0, Else0),
Context, Subst, if_then_else(Vars, Cond, Then, Else) - GoalInfo,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO) :-
+ NumAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO) :-
BeforeSInfo = !.SInfo,
substitute_vars(Vars0, Subst, Vars),
substitute_vars(StateVars0, Subst, StateVars),
prepare_for_if_then_else_goal(StateVars, !VarSet, !SInfo),
- transform_goal(Cond0, Subst, Cond, !VarSet, !ModuleInfo, !QualInfo,
- !SInfo, !IO),
+ transform_goal(Cond0, Subst, Cond, CondAdded, !VarSet, !ModuleInfo,
+ !QualInfo, !SInfo, !IO),
finish_if_then_else_goal_condition(StateVars,
BeforeSInfo, !.SInfo, AfterCondSInfo, !:SInfo),
- transform_goal(Then0, Subst, Then1, !VarSet, !ModuleInfo, !QualInfo,
- !SInfo, !IO),
+ transform_goal(Then0, Subst, Then1, ThenAdded, !VarSet, !ModuleInfo,
+ !QualInfo, !SInfo, !IO),
finish_if_then_else_goal_then_goal(StateVars, BeforeSInfo, !SInfo),
AfterThenSInfo = !.SInfo,
- transform_goal(Else0, Subst, Else1, !VarSet, !ModuleInfo, !QualInfo,
- BeforeSInfo, !:SInfo, !IO),
+ transform_goal(Else0, Subst, Else1, ElseAdded, !VarSet, !ModuleInfo,
+ !QualInfo, BeforeSInfo, !:SInfo, !IO),
+ NumAdded = CondAdded + ThenAdded + ElseAdded,
goal_info_init(Context, GoalInfo),
finish_if_then_else(Context, Then1, Then, Else1, Else,
BeforeSInfo, AfterCondSInfo, AfterThenSInfo, !SInfo, !VarSet).
-transform_goal_2(not_expr(A0), _, Subst, Goal, !VarSet, !ModuleInfo, !QualInfo,
- !SInfo, !IO) :-
+transform_goal_2(not_expr(SubGoal0), _, Subst, not(SubGoal) - GoalInfo,
+ NumAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO) :-
BeforeSInfo = !.SInfo,
- transform_goal(A0, Subst, A, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO),
+ transform_goal(SubGoal0, Subst, SubGoal, NumAdded, !VarSet, !ModuleInfo,
+ !QualInfo, !SInfo, !IO),
goal_info_init(GoalInfo),
- Goal = not(A) - GoalInfo,
finish_negation(BeforeSInfo, !SInfo).
-transform_goal_2(conj_expr(A0, B0), _, Subst, Goal, !VarSet, !ModuleInfo,
- !QualInfo, !SInfo, !IO) :-
- get_rev_conj(A0, Subst, [], R0, !VarSet, !ModuleInfo, !QualInfo,
- !SInfo, !IO),
- get_rev_conj(B0, Subst, R0, R, !VarSet, !ModuleInfo, !QualInfo,
- !SInfo, !IO),
+transform_goal_2(conj_expr(A0, B0), _, Subst, Goal, NumAdded, !VarSet,
+ !ModuleInfo, !QualInfo, !SInfo, !IO) :-
+ get_rev_conj(A0, Subst, [], R0, 0, NumAddedA,
+ !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO),
+ get_rev_conj(B0, Subst, R0, R, NumAddedA, NumAdded,
+ !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO),
L = list.reverse(R),
goal_info_init(GoalInfo),
conj_list_to_goal(L, GoalInfo, Goal).
-transform_goal_2(par_conj_expr(A0, B0), _, Subst, Goal, !VarSet, !ModuleInfo,
- !QualInfo, !SInfo, !IO) :-
- get_rev_par_conj(B0, Subst, [], R0, !VarSet, !ModuleInfo, !QualInfo,
- !SInfo, !IO),
- get_rev_par_conj(A0, Subst, R0, R, !VarSet, !ModuleInfo, !QualInfo,
- !SInfo, !IO),
+transform_goal_2(par_conj_expr(A0, B0), _, Subst, Goal, NumAdded, !VarSet,
+ !ModuleInfo, !QualInfo, !SInfo, !IO) :-
+ get_rev_par_conj(B0, Subst, [], R0, 0, NumAddedB,
+ !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO),
+ get_rev_par_conj(A0, Subst, R0, R, NumAddedB, NumAdded,
+ !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO),
L = list.reverse(R),
goal_info_init(GoalInfo),
par_conj_list_to_goal(L, GoalInfo, Goal).
-transform_goal_2(disj_expr(A0, B0), Context, Subst, Goal, !VarSet, !ModuleInfo,
- !QualInfo, !SInfo, !IO) :-
- get_disj(B0, Subst, [], L0, !VarSet, !ModuleInfo, !QualInfo, !.SInfo, !IO),
- get_disj(A0, Subst, L0, L1, !VarSet, !ModuleInfo, !QualInfo, !.SInfo, !IO),
+transform_goal_2(disj_expr(A0, B0), Context, Subst, Goal, NumAdded, !VarSet,
+ !ModuleInfo, !QualInfo, !SInfo, !IO) :-
+ get_disj(B0, Subst, [], L0, 0, NumAddedB,
+ !VarSet, !ModuleInfo, !QualInfo, !.SInfo, !IO),
+ get_disj(A0, Subst, L0, L1, NumAddedB, NumAdded,
+ !VarSet, !ModuleInfo, !QualInfo, !.SInfo, !IO),
finish_disjunction(Context, !.VarSet, L1, L, !:SInfo),
goal_info_init(Context, GoalInfo),
disj_list_to_goal(L, GoalInfo, Goal).
-transform_goal_2(implies_expr(P, Q), Context, Subst, Goal, !VarSet,
+transform_goal_2(implies_expr(P, Q), Context, Subst, Goal, NumAdded, !VarSet,
!ModuleInfo, !QualInfo, !SInfo, !IO) :-
% `P => Q' is defined as `not (P, not Q)'
TransformedGoal = not_expr(conj_expr(P, not_expr(Q) - Context) - Context),
- transform_goal_2(TransformedGoal, Context, Subst, Goal, !VarSet,
+ transform_goal_2(TransformedGoal, Context, Subst, Goal, NumAdded, !VarSet,
!ModuleInfo, !QualInfo, !SInfo, !IO).
-transform_goal_2(equivalent_expr(P0, Q0), _, Subst, Goal, !VarSet, !ModuleInfo,
- !QualInfo, !SInfo, !IO) :-
+transform_goal_2(equivalent_expr(P0, Q0), _, Subst, Goal, NumAdded, !VarSet,
+ !ModuleInfo, !QualInfo, !SInfo, !IO) :-
%
% `P <=> Q' is defined as `(P => Q), (Q => P)',
% but that transformation must not be done until
@@ -676,12 +686,15 @@
%
BeforeSInfo = !.SInfo,
goal_info_init(GoalInfo),
- transform_goal(P0, Subst, P, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO),
- transform_goal(Q0, Subst, Q, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO),
+ transform_goal(P0, Subst, P, NumAddedP, !VarSet, !ModuleInfo, !QualInfo,
+ !SInfo, !IO),
+ transform_goal(Q0, Subst, Q, NumAddedQ, !VarSet, !ModuleInfo, !QualInfo,
+ !SInfo, !IO),
+ NumAdded = NumAddedP + NumAddedQ,
Goal = shorthand(bi_implication(P, Q)) - GoalInfo,
finish_equivalence(BeforeSInfo, !SInfo).
-transform_goal_2(call_expr(Name, Args0, Purity), Context, Subst, Goal, !VarSet,
- !ModuleInfo, !QualInfo, !SInfo, !IO) :-
+transform_goal_2(call_expr(Name, Args0, Purity), Context, Subst, Goal,
+ NumAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO) :-
Args1 = expand_bang_state_var_args(Args0),
(
Name = unqualified("\\="),
@@ -690,8 +703,8 @@
prepare_for_call(!SInfo),
% `LHS \= RHS' is defined as `not (LHS = RHS)'
transform_goal_2(not_expr(unify_expr(LHS, RHS, Purity) - Context),
- Context, Subst, Goal, !VarSet, !ModuleInfo, !QualInfo, !SInfo,
- !IO),
+ Context, Subst, Goal, NumAdded, !VarSet, !ModuleInfo, !QualInfo,
+ !SInfo, !IO),
finish_call(!VarSet, !SInfo)
;
% check for a DCG field access goal:
@@ -704,8 +717,8 @@
->
prepare_for_call(!SInfo),
term.apply_substitution_to_list(Args1, Subst, Args2),
- transform_dcg_record_syntax(Operator, Args2, Context,
- Goal, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO),
+ transform_dcg_record_syntax(Operator, Args2, Context, Goal, NumAdded,
+ !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO),
finish_call(!VarSet, !SInfo)
;
prepare_for_call(!SInfo),
@@ -744,42 +757,46 @@
record_called_pred_or_func(predicate, Name, Arity, !QualInfo),
insert_arg_unifications(HeadVars, Args, Context, call(CallId),
- Goal0, Goal, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO),
+ Goal0, Goal, NumAdded, !VarSet, !ModuleInfo, !QualInfo,
+ !SInfo, !IO),
finish_call(!VarSet, !SInfo)
).
-transform_goal_2(unify_expr(A0, B0, Purity), Context, Subst, Goal, !VarSet,
- !ModuleInfo, !QualInfo, !SInfo, !IO) :-
+transform_goal_2(unify_expr(A0, B0, Purity), Context, Subst, Goal, NumAdded,
+ !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO) :-
% It is an error for the left or right hand side of a
% unification to be !X (it may be !.X or !:X, however).
( A0 = functor(atom("!"), [variable(StateVarA)], _) ->
report_svar_unify_error(Context, !.VarSet, StateVarA, !IO),
- Goal = true_goal
+ Goal = true_goal,
+ NumAdded = 0
; B0 = functor(atom("!"), [variable(StateVarB)], _) ->
report_svar_unify_error(Context, !.VarSet, StateVarB, !IO),
- Goal = true_goal
+ Goal = true_goal,
+ NumAdded = 0
;
prepare_for_call(!SInfo),
term.apply_substitution(A0, Subst, A),
term.apply_substitution(B0, Subst, B),
unravel_unification(A, B, Context, explicit, [], Purity, Goal,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO),
+ NumAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO),
finish_call(!VarSet, !SInfo)
).
:- pred transform_promise_eqv_goal(prog_vars::in, prog_vars::in, prog_vars::in,
prog_substitution::in, prog_context::in, prog_vars::out,
- goal::in, hlds_goal::out, hlds_goal_info::out,
+ goal::in, hlds_goal::out, hlds_goal_info::out, int::out,
prog_varset::in, prog_varset::out, module_info::in, module_info::out,
qual_info::in, qual_info::out, svar_info::in, svar_info::out,
io::di, io::uo) is det.
transform_promise_eqv_goal(Vars0, DotSVars0, ColonSVars0, Subst, Context, Vars,
- Goal0, Goal, GoalInfo, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO) :-
+ Goal0, Goal, GoalInfo, NumAdded, !VarSet, !ModuleInfo, !QualInfo,
+ !SInfo, !IO) :-
substitute_vars(Vars0, Subst, Vars1),
substitute_vars(DotSVars0, Subst, DotSVars1),
convert_dot_state_vars(Context, DotSVars1, DotSVars, !VarSet, !SInfo, !IO),
- transform_goal(Goal0, Subst, Goal, !VarSet, !ModuleInfo, !QualInfo,
- !SInfo, !IO),
+ transform_goal(Goal0, Subst, Goal, NumAdded, !VarSet, !ModuleInfo,
+ !QualInfo, !SInfo, !IO),
goal_info_init(GoalInfo),
substitute_vars(ColonSVars0, Subst, ColonSVars1),
convert_dot_state_vars(Context, ColonSVars1, ColonSVars, !VarSet,
@@ -820,13 +837,13 @@
:- inst dcg_record_syntax_op == bound("=^"; ":=").
:- pred transform_dcg_record_syntax(string::in(dcg_record_syntax_op),
- list(prog_term)::in, prog_context::in, hlds_goal::out,
+ list(prog_term)::in, prog_context::in, hlds_goal::out, int::out,
prog_varset::in, prog_varset::out,
module_info::in, module_info::out, qual_info::in, qual_info::out,
svar_info::in, svar_info::out, io::di, io::uo) is det.
-transform_dcg_record_syntax(Operator, ArgTerms0, Context, Goal, !VarSet,
- !ModuleInfo, !QualInfo, !SInfo, !IO) :-
+transform_dcg_record_syntax(Operator, ArgTerms0, Context, Goal, NumAdded,
+ !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO) :-
goal_info_init(Context, GoalInfo),
(
ArgTerms0 = [LHSTerm, RHSTerm, TermInputTerm, TermOutputTerm],
@@ -848,10 +865,12 @@
MaybeFieldNames = ok(FieldNames),
ArgTerms = [FieldValueTerm, TermInputTerm, TermOutputTerm],
transform_dcg_record_syntax_2(AccessType, FieldNames, ArgTerms,
- Context, Goal, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO)
+ Context, Goal, NumAdded, !VarSet, !ModuleInfo, !QualInfo,
+ !SInfo, !IO)
;
MaybeFieldNames = error(Msg, ErrorTerm),
invalid_goal("^", ArgTerms0, GoalInfo, Goal, !VarSet, !SInfo, !IO),
+ NumAdded = 0,
qual_info_set_found_syntax_error(yes, !QualInfo),
io.set_exit_status(1, !IO),
prog_out.write_context(Context, !IO),
@@ -873,6 +892,7 @@
)
;
invalid_goal("^", ArgTerms0, GoalInfo, Goal, !VarSet, !SInfo, !IO),
+ NumAdded = 0,
qual_info_set_found_syntax_error(yes, !QualInfo),
io.set_exit_status(1, !IO),
prog_out.write_context(Context, !IO),
@@ -897,21 +917,21 @@
MaybeUnifyContext, unqualified(UpdateStr)) - GoalInfo.
:- pred transform_dcg_record_syntax_2(field_access_type::in, field_list::in,
- list(prog_term)::in, prog_context::in, hlds_goal::out,
+ list(prog_term)::in, prog_context::in, hlds_goal::out, int::out,
prog_varset::in, prog_varset::out,
module_info::in, module_info::out, qual_info::in, qual_info::out,
svar_info::in, svar_info::out, io::di, io::uo) is det.
transform_dcg_record_syntax_2(AccessType, FieldNames, ArgTerms, Context, Goal,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO) :-
+ NumAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO) :-
make_fresh_arg_vars(ArgTerms, ArgVars, !VarSet, !SInfo, !IO),
( ArgVars = [FieldValueVar, TermInputVar, TermOutputVar] ->
(
AccessType = set,
expand_set_field_function_call(Context, explicit, [], FieldNames,
- FieldValueVar, TermInputVar, TermOutputVar, !VarSet, Functor,
- InnermostFunctor - InnermostSubContext, Goal0, !ModuleInfo,
- !QualInfo, !SInfo, !IO),
+ FieldValueVar, TermInputVar, TermOutputVar, Functor,
+ InnermostFunctor - InnermostSubContext, Goal0, SetAdded,
+ !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO),
FieldArgNumber = 2,
FieldArgContext = functor(InnermostFunctor, explicit,
@@ -935,14 +955,15 @@
OutputTermArgNumber - OutputTermArgContext
],
insert_arg_unifications_with_supplied_contexts(ArgVars, ArgTerms,
- ArgContexts, Context, Goal0, Goal, !VarSet, !ModuleInfo,
- !QualInfo, !SInfo, !IO)
+ ArgContexts, Context, Goal0, Goal, ArgAdded, !VarSet,
+ !ModuleInfo, !QualInfo, !SInfo, !IO),
+ NumAdded = SetAdded + ArgAdded
;
AccessType = get,
expand_dcg_field_extraction_goal(Context, explicit, [], FieldNames,
- FieldValueVar, TermInputVar, TermOutputVar, !VarSet, Functor,
- InnermostFunctor - _InnerSubContext, Goal0, !ModuleInfo,
- !QualInfo, !SInfo, !IO),
+ FieldValueVar, TermInputVar, TermOutputVar, Functor,
+ InnermostFunctor - _InnerSubContext, Goal0, ExtractAdded,
+ !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO),
InputTermArgNumber = 1,
InputTermArgContext = functor(Functor, explicit, []),
@@ -965,20 +986,21 @@
OutputTermArgNumber - OutputTermArgContext
],
insert_arg_unifications_with_supplied_contexts(ArgVars, ArgTerms,
- ArgContexts, Context, Goal0, Goal, !VarSet, !ModuleInfo,
- !QualInfo, !SInfo, !IO)
+ ArgContexts, Context, Goal0, Goal, ArgAdded, !VarSet,
+ !ModuleInfo, !QualInfo, !SInfo, !IO),
+ NumAdded = ExtractAdded + ArgAdded
)
;
unexpected(this_file, "do_transform_dcg_record_syntax")
).
-qualify_lambda_mode_list(Modes0, Modes, Context, !QualInfo, !IO) :-
+qualify_lambda_mode_list_if_not_opt_imported(Modes0, Modes, Context,
+ !QualInfo, !IO) :-
% The modes in `.opt' files are already fully module qualified.
qual_info_get_import_status(!.QualInfo, ImportStatus),
( ImportStatus \= opt_imported ->
qual_info_get_mq_info(!.QualInfo, MQInfo0),
- module_qual.qualify_lambda_mode_list(Modes0, Modes, Context,
- MQInfo0, MQInfo, !IO),
+ qualify_lambda_mode_list(Modes0, Modes, Context, MQInfo0, MQInfo, !IO),
qual_info_set_mq_info(MQInfo, !QualInfo)
;
Modes = Modes0
@@ -989,21 +1011,23 @@
% Goal is a tree of conjuncts. Flatten it into a list (applying Subst),
% reverse it, append RevConj0, and return the result in RevConj.
%
-:- pred get_rev_conj(goal::in, prog_substitution::in, list(hlds_goal)::in,
- list(hlds_goal)::out, prog_varset::in, prog_varset::out,
- module_info::in, module_info::out, qual_info::in, qual_info::out,
- svar_info::in, svar_info::out, io::di, io::uo) is det.
+:- pred get_rev_conj(goal::in, prog_substitution::in,
+ list(hlds_goal)::in, list(hlds_goal)::out, int::in, int::out,
+ prog_varset::in, prog_varset::out, module_info::in, module_info::out,
+ qual_info::in, qual_info::out, svar_info::in, svar_info::out,
+ io::di, io::uo) is det.
-get_rev_conj(Goal, Subst, RevConj0, RevConj, !VarSet, !ModuleInfo, !QualInfo,
- !SInfo, !IO) :-
+get_rev_conj(Goal, Subst, RevConj0, RevConj, !NumAdded, !VarSet, !ModuleInfo,
+ !QualInfo, !SInfo, !IO) :-
( Goal = conj_expr(A, B) - _Context ->
- get_rev_conj(A, Subst, RevConj0, RevConj1,
+ get_rev_conj(A, Subst, RevConj0, RevConj1, !NumAdded,
!VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO),
- get_rev_conj(B, Subst, RevConj1, RevConj,
+ get_rev_conj(B, Subst, RevConj1, RevConj, !NumAdded,
!VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO)
;
- transform_goal(Goal, Subst, Goal1, !VarSet, !ModuleInfo, !QualInfo,
- !SInfo, !IO),
+ transform_goal(Goal, Subst, Goal1, GoalAdded, !VarSet, !ModuleInfo,
+ !QualInfo, !SInfo, !IO),
+ !:NumAdded = !.NumAdded + GoalAdded,
goal_to_conj_list(Goal1, ConjList),
RevConj = list.reverse(ConjList) ++ RevConj0
).
@@ -1013,21 +1037,23 @@
% Goal is a tree of conjuncts. Flatten it into a list (applying Subst),
% reverse it, append RevParConj0, and return the result in RevParConj.
%
-:- pred get_rev_par_conj(goal::in, prog_substitution::in, list(hlds_goal)::in,
- list(hlds_goal)::out, prog_varset::in, prog_varset::out,
- module_info::in, module_info::out, qual_info::in, qual_info::out,
- svar_info::in, svar_info::out, io::di, io::uo) is det.
+:- pred get_rev_par_conj(goal::in, prog_substitution::in,
+ list(hlds_goal)::in, list(hlds_goal)::out, int::in, int::out,
+ prog_varset::in, prog_varset::out, module_info::in, module_info::out,
+ qual_info::in, qual_info::out, svar_info::in, svar_info::out,
+ io::di, io::uo) is det.
-get_rev_par_conj(Goal, Subst, RevParConj0, RevParConj, !VarSet, !ModuleInfo,
- !QualInfo, !SInfo, !IO) :-
+get_rev_par_conj(Goal, Subst, RevParConj0, RevParConj, !NumAdded, !VarSet,
+ !ModuleInfo, !QualInfo, !SInfo, !IO) :-
( Goal = par_conj_expr(A, B) - _Context ->
- get_rev_par_conj(A, Subst, RevParConj0, RevParConj1,
+ get_rev_par_conj(A, Subst, RevParConj0, RevParConj1, !NumAdded,
!VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO),
- get_rev_par_conj(B, Subst, RevParConj1, RevParConj,
+ get_rev_par_conj(B, Subst, RevParConj1, RevParConj, !NumAdded,
!VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO)
;
- transform_goal(Goal, Subst, Goal1, !VarSet, !ModuleInfo, !QualInfo,
- !SInfo, !IO),
+ transform_goal(Goal, Subst, Goal1, GoalAdded, !VarSet, !ModuleInfo,
+ !QualInfo, !SInfo, !IO),
+ !:NumAdded = !.NumAdded + GoalAdded,
goal_to_par_conj_list(Goal1, ParConjList),
RevParConj = list.reverse(ParConjList) ++ RevParConj0
).
@@ -1037,21 +1063,22 @@
% Goal is a tree of disjuncts. Flatten it into a list (applying Subst),
% append Disj0, and return the result in Disj.
%
-:- pred get_disj(goal::in, prog_substitution::in, hlds_goal_svar_infos::in,
- hlds_goal_svar_infos::out, prog_varset::in, prog_varset::out,
- module_info::in, module_info::out, qual_info::in, qual_info::out,
- svar_info::in, io::di, io::uo) is det.
+:- pred get_disj(goal::in, prog_substitution::in,
+ hlds_goal_svar_infos::in, hlds_goal_svar_infos::out, int::in, int::out,
+ prog_varset::in, prog_varset::out, module_info::in, module_info::out,
+ qual_info::in, qual_info::out, svar_info::in, io::di, io::uo) is det.
-get_disj(Goal, Subst, Disj0, Disj, !VarSet, !ModuleInfo, !QualInfo, SInfo,
- !IO) :-
+get_disj(Goal, Subst, Disj0, Disj, !NumAdded, !VarSet, !ModuleInfo, !QualInfo,
+ SInfo, !IO) :-
( Goal = disj_expr(A, B) - _Context ->
- get_disj(B, Subst, Disj0, Disj1, !VarSet, !ModuleInfo, !QualInfo,
- SInfo, !IO),
- get_disj(A, Subst, Disj1, Disj, !VarSet, !ModuleInfo, !QualInfo,
- SInfo, !IO)
- ;
- transform_goal(Goal, Subst, Goal1, !VarSet, !ModuleInfo, !QualInfo,
- SInfo, SInfo1, !IO),
+ get_disj(B, Subst, Disj0, Disj1, !NumAdded, !VarSet, !ModuleInfo,
+ !QualInfo, SInfo, !IO),
+ get_disj(A, Subst, Disj1, Disj, !NumAdded, !VarSet, !ModuleInfo,
+ !QualInfo, SInfo, !IO)
+ ;
+ transform_goal(Goal, Subst, Goal1, GoalAdded, !VarSet, !ModuleInfo,
+ !QualInfo, SInfo, SInfo1, !IO),
+ !:NumAdded = !.NumAdded + GoalAdded,
Disj = [{Goal1, SInfo1} | Disj0]
).
Index: compiler/code_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/code_gen.m,v
retrieving revision 1.153
diff -u -b -r1.153 code_gen.m
--- compiler/code_gen.m 24 Mar 2006 04:40:41 -0000 1.153
+++ compiler/code_gen.m 27 Mar 2006 02:57:37 -0000
@@ -78,6 +78,7 @@
:- import_module check_hlds.mode_util.
:- import_module check_hlds.type_util.
:- import_module hlds.goal_util.
+:- import_module hlds.hlds_clauses.
:- import_module hlds.hlds_llds.
:- import_module hlds.hlds_out.
:- import_module hlds.instmap.
@@ -260,8 +261,21 @@
ProcInfo, FollowVars, ModuleInfo, StaticCellInfo0,
OutsideResumePoint, TraceSlotInfo, CodeInfo0),
+ % Find out the approriate context for the predicate's interface events.
+ pred_info_clauses_info(PredInfo, ClausesInfo),
+ get_clause_list(ClausesInfo ^ clauses_rep, Clauses),
+ (
+ Clauses = [],
+ % This predicate must have been created by the compiler. In that case,
+ % the context of the body goal is the best we can do.
+ goal_info_get_context(GoalInfo, ProcContext)
+ ;
+ Clauses = [FirstClause | _],
+ ProcContext = FirstClause ^ clause_context
+ ),
+
% Generate code for the procedure.
- generate_category_code(CodeModel, Goal, OutsideResumePoint,
+ generate_category_code(CodeModel, ProcContext, Goal, OutsideResumePoint,
TraceSlotInfo, CodeTree, MaybeTraceCallLabel, FrameInfo,
CodeInfo0, CodeInfo),
code_info.get_max_reg_in_use_at_trace(CodeInfo, MaxTraceReg),
@@ -531,13 +545,13 @@
% a failure continuation, but in the absence of tracing this
% continuation needs no code. Only model_semi procedures need code
% for the failure continuation at all times.)
-
-:- pred generate_category_code(code_model::in, hlds_goal::in,
+ %
+:- pred generate_category_code(code_model::in, prog_context::in, hlds_goal::in,
resume_point_info::in, trace_slot_info::in, code_tree::out,
maybe(label)::out, frame_info::out, code_info::in, code_info::out) is det.
-generate_category_code(model_det, Goal, ResumePoint, TraceSlotInfo, Code,
- MaybeTraceCallLabel, FrameInfo, !CI) :-
+generate_category_code(model_det, ProcContext, Goal, ResumePoint,
+ TraceSlotInfo, Code, MaybeTraceCallLabel, FrameInfo, !CI) :-
% Generate the code for the body of the procedure.
(
code_info.get_globals(!.CI, Globals),
@@ -548,13 +562,11 @@
MaybeTraceCallLabel = no,
FrameInfo = frame(0, no, no)
;
- Goal = _ - GoalInfo,
- goal_info_get_context(GoalInfo, BodyContext),
code_info.get_maybe_trace_info(!.CI, MaybeTraceInfo),
(
MaybeTraceInfo = yes(TraceInfo),
trace.generate_external_event_code(call, TraceInfo,
- BodyContext, MaybeCallExternalInfo, !CI),
+ ProcContext, MaybeCallExternalInfo, !CI),
(
MaybeCallExternalInfo = yes(CallExternalInfo),
CallExternalInfo = external_event_info(TraceCallLabel, _,
@@ -574,24 +586,22 @@
generate_entry(!.CI, model_det, Goal, ResumePoint,
FrameInfo, EntryCode),
generate_exit(model_det, FrameInfo, TraceSlotInfo,
- BodyContext, _, ExitCode, !CI),
+ ProcContext, _, ExitCode, !CI),
Code = tree_list([EntryCode, TraceCallCode, BodyCode, ExitCode])
).
-generate_category_code(model_semi, Goal, ResumePoint, TraceSlotInfo, Code,
- MaybeTraceCallLabel, FrameInfo, !CI) :-
+generate_category_code(model_semi, ProcContext, Goal, ResumePoint,
+ TraceSlotInfo, Code, MaybeTraceCallLabel, FrameInfo, !CI) :-
set.singleton_set(FailureLiveRegs, reg(r, 1)),
FailCode = node([
assign(reg(r, 1), const(false)) - "Fail",
livevals(FailureLiveRegs) - "",
goto(succip) - "Return from procedure call"
]),
- Goal = _ - GoalInfo,
- goal_info_get_context(GoalInfo, BodyContext),
code_info.get_maybe_trace_info(!.CI, MaybeTraceInfo),
(
MaybeTraceInfo = yes(TraceInfo),
- trace.generate_external_event_code(call, TraceInfo, BodyContext,
+ trace.generate_external_event_code(call, TraceInfo, ProcContext,
MaybeCallExternalInfo, !CI),
(
MaybeCallExternalInfo = yes(CallExternalInfo),
@@ -607,15 +617,15 @@
generate_entry(!.CI, model_semi, Goal, ResumePoint,
FrameInfo, EntryCode),
generate_exit(model_semi, FrameInfo, TraceSlotInfo,
- BodyContext, RestoreDeallocCode, ExitCode, !CI),
+ ProcContext, RestoreDeallocCode, ExitCode, !CI),
code_info.generate_resume_point(ResumePoint, ResumeCode, !CI),
code_info.resume_point_vars(ResumePoint, ResumeVarList),
set.list_to_set(ResumeVarList, ResumeVars),
code_info.set_forward_live_vars(ResumeVars, !CI),
- % XXX A context that gives the end of the procedure
- % definition would be better than BodyContext.
- trace.generate_external_event_code(fail, TraceInfo, BodyContext,
+ % XXX A context that gives the end of the procedure definition
+ % would be better than ProcContext.
+ trace.generate_external_event_code(fail, TraceInfo, ProcContext,
MaybeFailExternalInfo, !CI),
(
MaybeFailExternalInfo = yes(FailExternalInfo),
@@ -633,20 +643,18 @@
generate_entry(!.CI, model_semi, Goal, ResumePoint,
FrameInfo, EntryCode),
generate_exit(model_semi, FrameInfo, TraceSlotInfo,
- BodyContext, RestoreDeallocCode, ExitCode, !CI),
+ ProcContext, RestoreDeallocCode, ExitCode, !CI),
code_info.generate_resume_point(ResumePoint, ResumeCode, !CI),
Code = tree_list([EntryCode, BodyCode, ExitCode,
ResumeCode, RestoreDeallocCode, FailCode])
).
-generate_category_code(model_non, Goal, ResumePoint, TraceSlotInfo, Code,
- MaybeTraceCallLabel, FrameInfo, !CI) :-
+generate_category_code(model_non, ProcContext, Goal, ResumePoint,
+ TraceSlotInfo, Code, MaybeTraceCallLabel, FrameInfo, !CI) :-
code_info.get_maybe_trace_info(!.CI, MaybeTraceInfo),
- Goal = _ - GoalInfo,
- goal_info_get_context(GoalInfo, BodyContext),
(
MaybeTraceInfo = yes(TraceInfo),
- trace.generate_external_event_code(call, TraceInfo, BodyContext,
+ trace.generate_external_event_code(call, TraceInfo, ProcContext,
MaybeCallExternalInfo, !CI),
(
MaybeCallExternalInfo = yes(CallExternalInfo),
@@ -662,15 +670,15 @@
generate_entry(!.CI, model_non, Goal, ResumePoint,
FrameInfo, EntryCode),
generate_exit(model_non, FrameInfo, TraceSlotInfo,
- BodyContext, _, ExitCode, !CI),
+ ProcContext, _, ExitCode, !CI),
code_info.generate_resume_point(ResumePoint, ResumeCode, !CI),
code_info.resume_point_vars(ResumePoint, ResumeVarList),
set.list_to_set(ResumeVarList, ResumeVars),
code_info.set_forward_live_vars(ResumeVars, !CI),
- % XXX A context that gives the end of the procedure
- % definition would be better than BodyContext.
- trace.generate_external_event_code(fail, TraceInfo, BodyContext,
+ % XXX A context that gives the end of the procedure definition
+ % would be better than ProcContext.
+ trace.generate_external_event_code(fail, TraceInfo, ProcContext,
MaybeFailExternalInfo, !CI),
(
MaybeFailExternalInfo = yes(FailExternalInfo),
@@ -715,7 +723,7 @@
generate_entry(!.CI, model_non, Goal, ResumePoint,
FrameInfo, EntryCode),
generate_exit(model_non, FrameInfo, TraceSlotInfo,
- BodyContext, _, ExitCode, !CI),
+ ProcContext, _, ExitCode, !CI),
Code = tree_list([EntryCode, BodyCode, ExitCode])
).
@@ -874,7 +882,7 @@
trace_slot_info::in, prog_context::in, code_tree::out, code_tree::out,
code_info::in, code_info::out) is det.
-generate_exit(CodeModel, FrameInfo, TraceSlotInfo, BodyContext,
+generate_exit(CodeModel, FrameInfo, TraceSlotInfo, ProcContext,
RestoreDeallocCode, ExitCode, !CI) :-
StartComment = node([
comment("Start of procedure epilogue") - ""
@@ -978,7 +986,7 @@
MaybeTraceInfo = yes(TraceInfo),
% XXX A context that gives the end of the procedure definition
% would be better than CallContext.
- trace.generate_external_event_code(exit, TraceInfo, BodyContext,
+ trace.generate_external_event_code(exit, TraceInfo, ProcContext,
MaybeExitExternalInfo, !CI),
(
MaybeExitExternalInfo = yes(ExitExternalInfo),
@@ -1282,8 +1290,8 @@
Instrn0 = call(Target, ReturnLabel, LiveVals0, Context, GP, CM)
->
map.init(Empty),
- LiveVals = [live_lvalue(direct(stackvar(StackLoc)),
- succip, Empty) | LiveVals0],
+ LiveVals = [live_lvalue(direct(stackvar(StackLoc)), succip, Empty)
+ | LiveVals0],
Instrn = call(Target, ReturnLabel, LiveVals, Context, GP, CM)
;
Instrn = Instrn0
Index: compiler/common.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/common.m,v
retrieving revision 1.91
diff -u -b -r1.91 common.m
--- compiler/common.m 24 Mar 2006 03:03:40 -0000 1.91
+++ compiler/common.m 25 Mar 2006 13:28:13 -0000
@@ -47,7 +47,7 @@
% have seen before, replace the construction with an assignment from the
% variable unified with that cell.
%
-:- pred optimise_unification(unification::in, prog_var::in,
+:- pred common_optimise_unification(unification::in, prog_var::in,
unify_rhs::in, unify_mode::in, unify_context::in,
hlds_goal_expr::in, hlds_goal_expr::out,
hlds_goal_info::in, hlds_goal_info::out,
@@ -60,11 +60,11 @@
% and no destructive inputs.
% It is the caller's responsibility to check that the call is pure.
%
-:- pred optimise_call(pred_id::in, proc_id::in, list(prog_var)::in,
+:- pred common_optimise_call(pred_id::in, proc_id::in, list(prog_var)::in,
hlds_goal_info::in, hlds_goal_expr::in, hlds_goal_expr::out,
simplify_info::in, simplify_info::out) is det.
-:- pred optimise_higher_order_call(prog_var::in, list(prog_var)::in,
+:- pred common_optimise_higher_order_call(prog_var::in, list(prog_var)::in,
list(mer_mode)::in, determinism::in, hlds_goal_info::in,
hlds_goal_expr::in, hlds_goal_expr::out,
simplify_info::in, simplify_info::out) is det.
@@ -72,7 +72,7 @@
% Succeeds if the two variables are equivalent according to the specified
% equivalence class.
%
-:- pred vars_are_equivalent(prog_var::in, prog_var::in,
+:- pred common_vars_are_equivalent(prog_var::in, prog_var::in,
common_info::in) is semidet.
% Assorted stuff used here that simplify.m doesn't need to know about.
@@ -236,7 +236,7 @@
%---------------------------------------------------------------------------%
-optimise_unification(Unification0, _Left0, _Right0, Mode, _Context,
+common_optimise_unification(Unification0, _Left0, _Right0, Mode, _Context,
Goal0, Goal, GoalInfo0, GoalInfo, !Info) :-
(
Unification0 = construct(Var, ConsId, ArgVars, _, _, _, SubInfo),
@@ -247,12 +247,12 @@
Goal = Goal0,
GoalInfo = GoalInfo0
;
- optimise_construct(Var, ConsId, ArgVars, Mode,
+ common_optimise_construct(Var, ConsId, ArgVars, Mode,
Goal0, Goal, GoalInfo0, GoalInfo, !Info)
)
;
Unification0 = deconstruct(Var, ConsId, ArgVars, UniModes, CanFail, _),
- optimise_deconstruct(Var, ConsId, ArgVars, UniModes, CanFail,
+ common_optimise_deconstruct(Var, ConsId, ArgVars, UniModes, CanFail,
Mode, Goal0, Goal, GoalInfo0, GoalInfo, !Info)
;
Unification0 = assign(Var1, Var2),
@@ -270,22 +270,22 @@
GoalInfo = GoalInfo0
).
-:- pred optimise_construct(prog_var::in, cons_id::in,
+:- pred common_optimise_construct(prog_var::in, cons_id::in,
list(prog_var)::in, unify_mode::in,
hlds_goal_expr::in, hlds_goal_expr::out,
hlds_goal_info::in, hlds_goal_info::out,
simplify_info::in, simplify_info::out) is det.
-optimise_construct(Var, ConsId, ArgVars, Mode, Goal0, Goal,
+common_optimise_construct(Var, ConsId, ArgVars, Mode, Goal0, Goal,
GoalInfo0, GoalInfo, !Info) :-
Mode = LVarMode - _,
simplify_info_get_module_info(!.Info, ModuleInfo),
mode_get_insts(ModuleInfo, LVarMode, _, Inst),
(
- % Don't optimise partially instantiated deconstruction
- % unifications, because it's tricky to work out how to mode
- % the replacement asssignment unifications. In the vast
- % majority of cases, the variable is ground.
+ % Don't optimise partially instantiated construction unifications,
+ % because it would be tricky to work out how to mode the replacement
+ % assignment unifications. In the vast majority of cases, the variable
+ % is ground.
\+ inst_is_ground(ModuleInfo, Inst)
->
Goal = Goal0,
@@ -338,20 +338,20 @@
)
).
-:- pred optimise_deconstruct(prog_var::in, cons_id::in,
+:- pred common_optimise_deconstruct(prog_var::in, cons_id::in,
list(prog_var)::in, list(uni_mode)::in, can_fail::in, unify_mode::in,
hlds_goal_expr::in, hlds_goal_expr::out,
hlds_goal_info::in, hlds_goal_info::out,
simplify_info::in, simplify_info::out) is det.
-optimise_deconstruct(Var, ConsId, ArgVars, UniModes, CanFail, Mode,
+common_optimise_deconstruct(Var, ConsId, ArgVars, UniModes, CanFail, Mode,
Goal0, Goal, GoalInfo0, GoalInfo, !Info) :-
simplify_info_get_module_info(!.Info, ModuleInfo),
(
% Don't optimise partially instantiated deconstruction unifications,
- % because it's tricky to work out how to mode the replacement
- % asssignment unifications. In the vast majority of cases,
- % the variable is ground.
+ % because it would be tricky to work out how to mode the replacement
+ % asssignment unifications. In the vast majority of cases, the variable
+ % is ground.
Mode = LVarMode - _,
mode_get_insts(ModuleInfo, LVarMode, Inst0, _),
\+ inst_is_ground(ModuleInfo, Inst0)
@@ -365,8 +365,8 @@
SinceCallStructMap0 = CommonInfo0 ^ since_call_structs,
(
% Do not delete deconstruction unifications inserted by
- % stack_opt.m, which has done a more comprehensive cost
- % analysis than common.m can do.
+ % stack_opt.m or tupling.m, which have done a more comprehensive
+ % cost analysis than common.m can do.
\+ goal_info_has_feature(GoalInfo, stack_opt),
\+ goal_info_has_feature(GoalInfo, tuple_opt),
@@ -444,9 +444,9 @@
id_var_match(Id, Var, VarEqv),
ids_vars_match(Ids, Vars, VarEqv).
-:- pragma inline(id_var_match/3).
:- pred id_var_match(partition_id::in, prog_var::in,
eqvclass(prog_var)::in) is semidet.
+:- pragma inline(id_var_match/3).
id_var_match(Id, Var, VarEqv) :-
eqvclass.partition_id(VarEqv, Var, VarId),
@@ -504,7 +504,7 @@
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
-optimise_call(PredId, ProcId, Args, GoalInfo, Goal0, Goal, !Info) :-
+common_optimise_call(PredId, ProcId, Args, GoalInfo, Goal0, Goal, !Info) :-
(
goal_info_get_determinism(GoalInfo, Det),
check_call_detism(Det),
@@ -515,13 +515,13 @@
partition_call_args(VarTypes, ModuleInfo, ArgModes, Args,
InputArgs, OutputArgs, OutputModes)
->
- optimise_call_2(seen_call(PredId, ProcId), InputArgs,
+ common_optimise_call_2(seen_call(PredId, ProcId), InputArgs,
OutputArgs, OutputModes, GoalInfo, Goal0, Goal, !Info)
;
Goal = Goal0
).
-optimise_higher_order_call(Closure, Args, Modes, Det, GoalInfo,
+common_optimise_higher_order_call(Closure, Args, Modes, Det, GoalInfo,
Goal0, Goal, !Info) :-
(
check_call_detism(Det),
@@ -530,7 +530,7 @@
partition_call_args(VarTypes, ModuleInfo, Modes, Args,
InputArgs, OutputArgs, OutputModes)
->
- optimise_call_2(higher_order_call, [Closure | InputArgs],
+ common_optimise_call_2(higher_order_call, [Closure | InputArgs],
OutputArgs, OutputModes, GoalInfo, Goal0, Goal, !Info)
;
Goal = Goal0
@@ -546,12 +546,12 @@
; SolnCount = at_most_many_cc
).
-:- pred optimise_call_2(seen_call_id::in, list(prog_var)::in,
+:- pred common_optimise_call_2(seen_call_id::in, list(prog_var)::in,
list(prog_var)::in, list(mer_mode)::in, hlds_goal_info::in,
hlds_goal_expr::in, hlds_goal_expr::out,
simplify_info::in, simplify_info::out) is det.
-optimise_call_2(SeenCall, InputArgs, OutputArgs, Modes, GoalInfo,
+common_optimise_call_2(SeenCall, InputArgs, OutputArgs, Modes, GoalInfo,
Goal0, Goal, !Info) :-
simplify_info_get_common_info(!.Info, CommonInfo0),
Eqv0 = CommonInfo0 ^ var_eqv,
@@ -568,7 +568,7 @@
Goal = conj(plain_conj, Goals),
simplify_info_get_var_types(!.Info, VarTypes),
(
- simplify_do_warn_calls(!.Info),
+ simplify_do_warn_duplicate_calls(!.Info),
% Don't warn for cases such as:
% set.init(Set1 : set(int)),
% set.init(Set2 : set(float)).
@@ -615,6 +615,7 @@
% Partition the arguments of a call into inputs and outputs,
% failing if any of the outputs have a unique component
% or if any of the outputs contain any `any' insts.
+ %
:- pred partition_call_args(vartypes::in, module_info::in,
list(mer_mode)::in, list(prog_var)::in, list(prog_var)::out,
list(prog_var)::out, list(mer_mode)::out) is semidet.
@@ -664,7 +665,7 @@
find_previous_call([SeenCall | SeenCalls], InputArgs, Eqv, OutputArgs,
PrevContext) :-
SeenCall = call_args(PrevContext, InputArgs1, OutputArgs1),
- ( var_lists_are_equiv(InputArgs, InputArgs1, Eqv) ->
+ ( common_var_lists_are_equiv(InputArgs, InputArgs1, Eqv) ->
OutputArgs = OutputArgs1
;
find_previous_call(SeenCalls, InputArgs, Eqv, OutputArgs, PrevContext)
@@ -672,27 +673,28 @@
%---------------------------------------------------------------------------%
- % succeeds if the two lists of variables are equivalent
+ % Succeeds if the two lists of variables are equivalent
% according to the specified equivalence class.
-:- pred var_lists_are_equiv(list(prog_var)::in, list(prog_var)::in,
+ %
+:- pred common_var_lists_are_equiv(list(prog_var)::in, list(prog_var)::in,
eqvclass(prog_var)::in) is semidet.
-var_lists_are_equiv([], [], _VarEqv).
-var_lists_are_equiv([X | Xs], [Y | Ys], VarEqv) :-
- vars_are_equiv(X, Y, VarEqv),
- var_lists_are_equiv(Xs, Ys, VarEqv).
+common_var_lists_are_equiv([], [], _VarEqv).
+common_var_lists_are_equiv([X | Xs], [Y | Ys], VarEqv) :-
+ common_vars_are_equiv(X, Y, VarEqv),
+ common_var_lists_are_equiv(Xs, Ys, VarEqv).
-vars_are_equivalent(X, Y, CommonInfo) :-
+common_vars_are_equivalent(X, Y, CommonInfo) :-
EqvVars = CommonInfo ^ var_eqv,
- vars_are_equiv(X, Y, EqvVars).
+ common_vars_are_equiv(X, Y, EqvVars).
% Succeeds if the two variables are equivalent according to the
% specified equivalence class.
%
-:- pred vars_are_equiv(prog_var::in, prog_var::in,
+:- pred common_vars_are_equiv(prog_var::in, prog_var::in,
eqvclass(prog_var)::in) is semidet.
-vars_are_equiv(X, Y, VarEqv) :-
+common_vars_are_equiv(X, Y, VarEqv) :-
(
X = Y
;
Index: compiler/cse_detection.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/cse_detection.m,v
retrieving revision 1.96
diff -u -b -r1.96 cse_detection.m
--- compiler/cse_detection.m 24 Mar 2006 03:03:41 -0000 1.96
+++ compiler/cse_detection.m 24 Mar 2006 16:51:12 -0000
@@ -105,13 +105,21 @@
detect_cse_in_proc(ProcId, PredId, !ModuleInfo, !IO) :-
detect_cse_in_proc_2(ProcId, PredId, Redo, !ModuleInfo),
+ globals.io_lookup_bool_option(very_verbose, VeryVerbose, !IO),
+ (
+ VeryVerbose = yes,
+ io.write_string("% Detecting common deconstructions for ", !IO),
+ hlds_out.write_pred_id(!.ModuleInfo, PredId, !IO),
+ io.write_string("\n", !IO)
+ ;
+ VeryVerbose = no
+ ),
globals.io_lookup_bool_option(detailed_statistics, Statistics, !IO),
maybe_report_stats(Statistics, !IO),
(
Redo = no
;
Redo = yes,
- globals.io_lookup_bool_option(very_verbose, VeryVerbose, !IO),
(
VeryVerbose = yes,
io.write_string("% Repeating mode check for ", !IO),
Index: compiler/deforest.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/deforest.m,v
retrieving revision 1.61
diff -u -b -r1.61 deforest.m
--- compiler/deforest.m 24 Mar 2006 03:03:42 -0000 1.61
+++ compiler/deforest.m 25 Mar 2006 14:01:39 -0000
@@ -1627,10 +1627,11 @@
pd_info_get_module_info(!.PDInfo, ModuleInfo),
module_info_get_globals(ModuleInfo, Globals),
simplify.find_simplifications(no, Globals, Simplifications0),
-
+ SimpList0 = simplifications_to_list(Simplifications0),
% Be a bit more aggressive with common structure elimination.
% This helps achieve folding in some cases.
- Simplifications = [extra_common_struct | Simplifications0],
+ SimpList = [extra_common_struct | SimpList0],
+ Simplifications = list_to_simplifications(SimpList),
pd_util.simplify_goal(Simplifications, Goal2, Goal3, !PDInfo, !IO),
pd_info_set_instmap(InstMap0, !PDInfo),
Index: compiler/equiv_type_hlds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/equiv_type_hlds.m,v
retrieving revision 1.29
diff -u -b -r1.29 equiv_type_hlds.m
--- compiler/equiv_type_hlds.m 24 Mar 2006 03:03:43 -0000 1.29
+++ compiler/equiv_type_hlds.m 25 Mar 2006 11:10:34 -0000
@@ -437,6 +437,15 @@
inst_cache::in, inst_cache::out) is det.
replace_in_inst(EqvMap, Inst0, Inst, Changed, !TVarSet, !Cache) :-
+ % The call to replace_in_inst_2 can allocate a *lot* of cells if the
+ % inst is complex, as it will be for an inst describing a large term.
+ % The fact that we traverse the inst twice if ContainsType = yes
+ % shouldn't be a problem, since we expect that ContainsType = no
+ % almost all the time.
+
+ ContainsType = type_may_occur_in_inst(Inst0),
+ (
+ ContainsType = yes,
replace_in_inst_2(EqvMap, Inst0, Inst1, Changed, !TVarSet, !Cache),
(
Changed = yes,
@@ -446,6 +455,66 @@
;
Changed = no,
Inst = Inst1
+ )
+ ;
+ ContainsType = no,
+ Inst = Inst0,
+ Changed = no
+ ).
+
+ % Return true if any type may occur inside the given inst.
+ %
+ % The logic here should be a conservative approximation of the code
+ % of replace_in_inst_2.
+ %
+:- func type_may_occur_in_inst(mer_inst) = bool.
+
+type_may_occur_in_inst(any(_)) = no.
+type_may_occur_in_inst(free) = no.
+type_may_occur_in_inst(free(_)) = yes.
+type_may_occur_in_inst(bound(_, BoundInsts)) =
+ type_may_occur_in_bound_insts(BoundInsts).
+type_may_occur_in_inst(ground(_, none)) = no.
+type_may_occur_in_inst(ground(_, higher_order(_PredInstInfo))) = yes.
+ % This is a conservative approximation; the mode in _PredInstInfo
+ % may contain a reference to a type.
+type_may_occur_in_inst(not_reached) = no.
+type_may_occur_in_inst(inst_var(_)) = no.
+type_may_occur_in_inst(constrained_inst_vars(_, CInst)) =
+ type_may_occur_in_inst(CInst).
+type_may_occur_in_inst(defined_inst(_)) = yes.
+ % This is also a conservative approximation.
+type_may_occur_in_inst(abstract_inst(_, Insts)) =
+ type_may_occur_in_insts(Insts).
+
+ % Return true if any type may occur inside any of the given bound insts.
+ %
+ % The logic here should be a conservative approximation of the code
+ % of replace_in_bound_insts.
+ %
+:- func type_may_occur_in_bound_insts(list(bound_inst)) = bool.
+
+type_may_occur_in_bound_insts([]) = no.
+type_may_occur_in_bound_insts([functor(_, Insts) | BoundInsts]) =
+ ( type_may_occur_in_insts(Insts) = yes ->
+ yes
+ ;
+ type_may_occur_in_bound_insts(BoundInsts)
+ ).
+
+ % Return true if any type may occur inside any of the given insts.
+ %
+ % The logic here should be a conservative approximation of the code
+ % of replace_in_insts.
+ %
+:- func type_may_occur_in_insts(list(mer_inst)) = bool.
+
+type_may_occur_in_insts([]) = no.
+type_may_occur_in_insts([Inst | Insts]) =
+ ( type_may_occur_in_inst(Inst) = yes ->
+ yes
+ ;
+ type_may_occur_in_insts(Insts)
).
:- pred replace_in_inst_2(eqv_map::in, mer_inst::in, mer_inst::out, bool::out,
@@ -574,8 +643,7 @@
replace_in_bound_insts(_EqvMap, [], [], no, !TVarSet, !Cache).
replace_in_bound_insts(EqvMap, List0 @ [functor(ConsId, Insts0) | BoundInsts0],
List, Changed, !TVarSet, !Cache) :-
- replace_in_insts(EqvMap, Insts0, Insts,
- InstsChanged, !TVarSet, !Cache),
+ replace_in_insts(EqvMap, Insts0, Insts, InstsChanged, !TVarSet, !Cache),
replace_in_bound_insts(EqvMap, BoundInsts0, BoundInsts,
BoundInstsChanged, !TVarSet, !Cache),
Changed = InstsChanged `or` BoundInstsChanged,
Index: compiler/field_access.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/field_access.m,v
retrieving revision 1.6
diff -u -b -r1.6 field_access.m
--- compiler/field_access.m 17 Mar 2006 01:40:18 -0000 1.6
+++ compiler/field_access.m 24 Mar 2006 04:53:51 -0000
@@ -43,9 +43,9 @@
%
:- pred expand_set_field_function_call(prog_context::in,
unify_main_context::in, unify_sub_contexts::in, field_list::in,
- prog_var::in, prog_var::in, prog_var::in,
- prog_varset::in, prog_varset::out, cons_id::out,
- pair(cons_id, unify_sub_contexts)::out, hlds_goal::out,
+ prog_var::in, prog_var::in, prog_var::in, cons_id::out,
+ pair(cons_id, unify_sub_contexts)::out, hlds_goal::out, int::out,
+ prog_varset::in, prog_varset::out,
module_info::in, module_info::out, qual_info::in, qual_info::out,
svar_info::in, svar_info::out, io::di, io::uo) is det.
@@ -63,11 +63,11 @@
%
:- pred expand_dcg_field_extraction_goal(prog_context::in,
unify_main_context::in, unify_sub_contexts::in, field_list::in,
- prog_var::in, prog_var::in, prog_var::in,
- prog_varset::in, prog_varset::out, cons_id::out,
- pair(cons_id, unify_sub_contexts)::out, hlds_goal::out,
- module_info::in, module_info::out, qual_info::in, qual_info::out,
- svar_info::in, svar_info::out, io::di, io::uo) is det.
+ prog_var::in, prog_var::in, prog_var::in, cons_id::out,
+ pair(cons_id, unify_sub_contexts)::out, hlds_goal::out, int::out,
+ prog_varset::in, prog_varset::out, module_info::in, module_info::out,
+ qual_info::in, qual_info::out, svar_info::in, svar_info::out,
+ io::di, io::uo) is det.
% Expand a field extraction function call into a list of goals which
% each get one level of the structure.
@@ -81,10 +81,11 @@
%
:- pred expand_get_field_function_call(prog_context::in,
unify_main_context::in, unify_sub_contexts::in, field_list::in,
- prog_var::in, prog_var::in, purity::in, prog_varset::in, prog_varset::out,
- cons_id::out, pair(cons_id, unify_sub_contexts)::out, hlds_goal::out,
- module_info::in, module_info::out, qual_info::in, qual_info::out,
- svar_info::in, svar_info::out, io::di, io::uo) is det.
+ prog_var::in, prog_var::in, purity::in, cons_id::out,
+ pair(cons_id, unify_sub_contexts)::out, hlds_goal::out, int::out,
+ prog_varset::in, prog_varset::out,module_info::in, module_info::out,
+ qual_info::in, qual_info::out, svar_info::in, svar_info::out,
+ io::di, io::uo) is det.
:- pred parse_field_list(prog_term::in,
maybe1(field_list, prog_var_type)::out) is det.
@@ -108,31 +109,31 @@
%-----------------------------------------------------------------------------%
expand_set_field_function_call(Context, MainContext, SubContext0, FieldNames,
- FieldValueVar, TermInputVar, TermOutputVar, !VarSet, Functor,
- FieldSubContext, Goal, !ModuleInfo, !QualInfo, !SInfo, !IO) :-
- expand_set_field_function_call_2(Context, MainContext,
- SubContext0, FieldNames, FieldValueVar, TermInputVar,
- TermOutputVar, !VarSet, Functor, FieldSubContext, Goals,
- !ModuleInfo, !QualInfo, !SInfo, !IO),
+ FieldValueVar, TermInputVar, TermOutputVar, Functor, FieldSubContext,
+ Goal, NumAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO) :-
+ expand_set_field_function_call_2(Context, MainContext, SubContext0,
+ FieldNames, FieldValueVar, TermInputVar, TermOutputVar, Functor,
+ FieldSubContext, Goals, NumAdded,
+ !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO),
goal_info_init(Context, GoalInfo),
conj_list_to_goal(Goals, GoalInfo, Goal).
:- pred expand_set_field_function_call_2(prog_context::in,
unify_main_context::in, unify_sub_contexts::in, field_list::in,
- prog_var::in, prog_var::in, prog_var::in,
- prog_varset::in, prog_varset::out, cons_id::out,
- pair(cons_id, unify_sub_contexts)::out, list(hlds_goal)::out,
- module_info::in, module_info::out, qual_info::in, qual_info::out,
- svar_info::in, svar_info::out, io::di, io::uo) is det.
+ prog_var::in, prog_var::in, prog_var::in, cons_id::out,
+ pair(cons_id, unify_sub_contexts)::out, list(hlds_goal)::out, int::out,
+ prog_varset::in, prog_varset::out, module_info::in, module_info::out,
+ qual_info::in, qual_info::out, svar_info::in, svar_info::out,
+ io::di, io::uo) is det.
-expand_set_field_function_call_2(_, _, _, [], _, _, _, !VarSet, _, _, _,
- !ModuleInfo, !QualInfo, !SInfo, !IO) :-
+expand_set_field_function_call_2(_, _, _, [], _, _, _, _, _, _, _,
+ !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO) :-
unexpected(this_file,
"expand_set_field_function_call_2: empty list of field names").
expand_set_field_function_call_2(Context, MainContext, SubContext0,
[FieldName - FieldArgs | FieldNames], FieldValueVar,
- TermInputVar, TermOutputVar, !VarSet, Functor,
- FieldSubContext, Goals, !ModuleInfo, !QualInfo, !SInfo, !IO) :-
+ TermInputVar, TermOutputVar, Functor, FieldSubContext, Goals, NumAdded,
+ !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO) :-
make_fresh_arg_vars(FieldArgs, FieldArgVars, !VarSet, !SInfo, !IO),
(
FieldNames = [_ | _],
@@ -142,12 +143,14 @@
construct_field_access_function_call(set, Context,
MainContext, SubContext0, FieldName, TermOutputVar,
SetArgs, purity_pure, Functor, UpdateGoal, !QualInfo),
+ UpdateAdded = 1,
% Extract the field containing the field to update.
construct_field_access_function_call(get, Context,
MainContext, SubContext0, FieldName, SubTermInputVar,
list.append(FieldArgVars, [TermInputVar]), purity_pure, _,
GetSubFieldGoal, !QualInfo),
+ GetSubFieldAdded = 1,
% Recursively update the field.
SubTermInputArgNumber = 2 + list.length(FieldArgs),
@@ -155,9 +158,10 @@
SubContext = [TermInputContext | SubContext0],
expand_set_field_function_call_2(Context, MainContext,
SubContext, FieldNames, FieldValueVar, SubTermInputVar,
- SubTermOutputVar, !VarSet, _, FieldSubContext, Goals0,
- !ModuleInfo, !QualInfo, !SInfo, !IO),
+ SubTermOutputVar, _, FieldSubContext, Goals0, SetAdded,
+ !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO),
+ FieldAdded = GetSubFieldAdded + SetAdded + UpdateAdded,
Goals1 = [GetSubFieldGoal | Goals0] ++ [UpdateGoal]
;
FieldNames = [],
@@ -165,56 +169,62 @@
construct_field_access_function_call(set, Context,
MainContext, SubContext0, FieldName, TermOutputVar,
SetArgs, purity_pure, Functor, Goal, !QualInfo),
+ FieldAdded = 1,
FieldSubContext = Functor - SubContext0,
Goals1 = [Goal]
-
),
ArgContext = functor(Functor, MainContext, SubContext0),
goal_info_init(Context, GoalInfo),
conj_list_to_goal(Goals1, GoalInfo, Conj0),
insert_arg_unifications(FieldArgVars, FieldArgs, Context, ArgContext,
- Conj0, Conj, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO),
+ Conj0, Conj, ArgAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO),
+ NumAdded = FieldAdded + ArgAdded,
goal_to_conj_list(Conj, Goals).
expand_dcg_field_extraction_goal(Context, MainContext, SubContext, FieldNames,
- FieldValueVar, TermInputVar, TermOutputVar, !VarSet, Functor,
- FieldSubContext, Goal, !ModuleInfo, !QualInfo, !SInfo, !IO) :-
+ FieldValueVar, TermInputVar, TermOutputVar, Functor, FieldSubContext,
+ Goal, NumAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO) :-
% Unify the DCG input and output variables.
make_atomic_unification(TermOutputVar, var(TermInputVar), Context,
MainContext, SubContext, UnifyDCG, !QualInfo),
+ UnifyAdded = 1,
% Process the access function as a get function on the output DCG variable.
expand_get_field_function_call_2(Context, MainContext, SubContext,
- FieldNames, FieldValueVar, TermOutputVar, purity_pure, !VarSet,
- Functor, FieldSubContext, Goals1, !ModuleInfo, !QualInfo, !SInfo, !IO),
+ FieldNames, FieldValueVar, TermOutputVar, purity_pure,
+ Functor, FieldSubContext, Goals1, GetAdded,
+ !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO),
+ NumAdded = UnifyAdded + GetAdded,
Goals = [UnifyDCG | Goals1],
goal_info_init(Context, GoalInfo),
conj_list_to_goal(Goals, GoalInfo, Goal).
-expand_get_field_function_call(Context, MainContext, SubContext0,
- FieldNames, FieldValueVar, TermInputVar, Purity, !VarSet,
- Functor, FieldSubContext, Goal, !ModuleInfo, !QualInfo, !SInfo, !IO) :-
+expand_get_field_function_call(Context, MainContext, SubContext0, FieldNames,
+ FieldValueVar, TermInputVar, Purity, Functor, FieldSubContext,
+ Goal, NumAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO) :-
expand_get_field_function_call_2(Context, MainContext, SubContext0,
- FieldNames, FieldValueVar, TermInputVar, Purity, !VarSet,
- Functor, FieldSubContext, Goals, !ModuleInfo, !QualInfo, !SInfo, !IO),
+ FieldNames, FieldValueVar, TermInputVar, Purity, Functor,
+ FieldSubContext, Goals, NumAdded, !VarSet, !ModuleInfo, !QualInfo,
+ !SInfo, !IO),
goal_info_init(Context, GoalInfo),
conj_list_to_goal(Goals, GoalInfo, Goal).
:- pred expand_get_field_function_call_2(prog_context::in,
unify_main_context::in, unify_sub_contexts::in, field_list::in,
- prog_var::in, prog_var::in, purity::in, prog_varset::in, prog_varset::out,
- cons_id::out, pair(cons_id, unify_sub_contexts)::out, list(hlds_goal)::out,
- module_info::in, module_info::out, qual_info::in, qual_info::out,
- svar_info::in, svar_info::out, io::di, io::uo) is det.
+ prog_var::in, prog_var::in, purity::in, cons_id::out,
+ pair(cons_id, unify_sub_contexts)::out, list(hlds_goal)::out, int::out,
+ prog_varset::in, prog_varset::out, module_info::in, module_info::out,
+ qual_info::in, qual_info::out, svar_info::in, svar_info::out,
+ io::di, io::uo) is det.
-expand_get_field_function_call_2(_, _, _, [], _, _, _, _, _, _, _, _,
- !ModuleInfo, !QualInfo, !Sinfo, !IO) :-
+expand_get_field_function_call_2(_, _, _, [], _, _, _, _, _, _, _,
+ !VarSet, !ModuleInfo, !QualInfo, !Sinfo, !IO) :-
unexpected(this_file,
"expand_get_field_function_call_2: empty list of field names").
expand_get_field_function_call_2(Context, MainContext, SubContext0,
- [FieldName - FieldArgs | FieldNames], FieldValueVar,
- TermInputVar, Purity, !VarSet, Functor, FieldSubContext, Goals,
- !ModuleInfo, !QualInfo, !SInfo, !IO) :-
+ [FieldName - FieldArgs | FieldNames], FieldValueVar, TermInputVar,
+ Purity, Functor, FieldSubContext, Goals, NumAdded,
+ !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO) :-
make_fresh_arg_vars(FieldArgs, FieldArgVars, !VarSet, !SInfo, !IO),
GetArgVars = FieldArgVars ++ [TermInputVar],
(
@@ -223,29 +233,33 @@
construct_field_access_function_call(get, Context, MainContext,
SubContext0, FieldName, SubTermInputVar, GetArgVars, Purity,
Functor, Goal, !QualInfo),
+ CallAdded = 1,
- % recursively extract until we run out of field names
+ % Recursively extract until we run out of field names
TermInputArgNumber = 1 + list.length(FieldArgVars),
TermInputContext = Functor - TermInputArgNumber,
SubContext = [TermInputContext | SubContext0],
expand_get_field_function_call_2(Context, MainContext,
SubContext, FieldNames, FieldValueVar, SubTermInputVar, Purity,
- !VarSet, _, FieldSubContext, Goals1, !ModuleInfo, !QualInfo,
- !SInfo, !IO),
- Goals2 = [Goal | Goals1]
+ _, FieldSubContext, Goals1, ExtractAdded, !VarSet, !ModuleInfo,
+ !QualInfo, !SInfo, !IO),
+ Goals2 = [Goal | Goals1],
+ FieldAdded = CallAdded + ExtractAdded
;
FieldNames = [],
FieldSubContext = Functor - SubContext0,
construct_field_access_function_call(get, Context,
MainContext, SubContext0, FieldName, FieldValueVar,
GetArgVars, Purity, Functor, Goal, !QualInfo),
- Goals2 = [Goal]
+ Goals2 = [Goal],
+ FieldAdded = 1
),
ArgContext = functor(Functor, MainContext, SubContext0),
goal_info_init(Context, GoalInfo),
conj_list_to_goal(Goals2, GoalInfo, Conj0),
insert_arg_unifications(FieldArgVars, FieldArgs, Context, ArgContext,
- Conj0, Conj, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO),
+ Conj0, Conj, ArgAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO),
+ NumAdded = FieldAdded + ArgAdded,
goal_to_conj_list(Conj, Goals).
:- pred construct_field_access_function_call(field_access_type::in,
Index: compiler/higher_order.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/higher_order.m,v
retrieving revision 1.149
diff -u -b -r1.149 higher_order.m
--- compiler/higher_order.m 24 Mar 2006 03:03:45 -0000 1.149
+++ compiler/higher_order.m 25 Mar 2006 08:55:11 -0000
@@ -76,6 +76,7 @@
:- import_module int.
:- import_module list.
:- import_module map.
+:- import_module require.
:- import_module set.
:- import_module std_util.
:- import_module string.
@@ -449,10 +450,9 @@
!:GlobalInfo = !.GlobalInfo ^ goal_sizes := GoalSizes
).
- % This is called when the first procedure of a predicate was
- % changed. It fixes up all the other procedures, ignoring the
- % goal_size and requests that come out, since that information has
- % already been collected.
+ % This is called when the first procedure of a predicate was changed.
+ % It fixes up all the other procedures, ignoring the goal_size and requests
+ % that come out, since that information has already been collected.
%
:- pred traverse_proc(bool::in, pred_id::in, proc_id::in,
higher_order_global_info::in, higher_order_global_info::out) is det.
@@ -500,7 +500,9 @@
fixup_proc_info(MustRecompute, Goal0, !Info) :-
(
- ( !.Info ^ changed = changed ; MustRecompute = yes )
+ ( !.Info ^ changed = changed
+ ; MustRecompute = yes
+ )
->
some [!ModuleInfo, !ProcInfo] (
!:ModuleInfo = !.Info ^ global_info ^ module_info,
@@ -580,13 +582,13 @@
% if-then-elses are handled as disjunctions.
%
Goal0 = if_then_else(Vars, Cond0, Then0, Else0) - GoalInfo,
- get_pre_branch_info(PreInfo, !Info),
+ get_pre_branch_info(!.Info, PreInfo),
traverse_goal_2(Cond0, Cond, !Info),
traverse_goal_2(Then0, Then, !Info),
- get_post_branch_info(PostThenInfo, !Info),
+ get_post_branch_info(!.Info, PostThenInfo),
set_pre_branch_info(PreInfo, !Info),
traverse_goal_2(Else0, Else, !Info),
- get_post_branch_info(PostElseInfo, !Info),
+ get_post_branch_info(!.Info, PostElseInfo),
Goal = if_then_else(Vars, Cond, Then, Else) - GoalInfo,
merge_post_branch_infos(PostThenInfo, PostElseInfo, PostInfo),
set_post_branch_info(PostInfo, !Info).
@@ -628,145 +630,203 @@
:- pred traverse_independent_goals(hlds_goals::in, hlds_goals::out,
higher_order_info::in, higher_order_info::out) is det.
-traverse_independent_goals([], [], !Info).
-traverse_independent_goals([Goal0 | Goals0], [Goal | Goals], !Info) :-
- get_pre_branch_info(PreInfo, !Info),
- traverse_goal_2(Goal0, Goal, !Info),
- get_post_branch_info(PostInfo0, !Info),
- traverse_independent_goals_2(PreInfo, Goals0, Goals, PostInfo0, PostInfo,
+traverse_independent_goals(Goals0, Goals, !Info) :-
+ % We handle empty lists separately because merge_post_branch_infos_into_one
+ % works only on nonempty lists.
+ (
+ Goals0 = [],
+ Goals = []
+ ;
+ Goals0 = [_ | _],
+ get_pre_branch_info(!.Info, PreInfo),
+ traverse_independent_goals_2(PreInfo, Goals0, Goals, [], PostInfos,
!Info),
- set_post_branch_info(PostInfo, !Info).
+ merge_post_branch_infos_into_one(PostInfos, PostInfo),
+ set_post_branch_info(PostInfo, !Info)
+ ).
:- pred traverse_independent_goals_2(pre_branch_info::in,
hlds_goals::in, hlds_goals::out,
- post_branch_info::in, post_branch_info::out,
+ list(post_branch_info)::in, list(post_branch_info)::out,
higher_order_info::in, higher_order_info::out) is det.
-traverse_independent_goals_2(_, [], [], PostInfo, PostInfo, !Info).
+traverse_independent_goals_2(_, [], [], !PostInfos, !Info).
traverse_independent_goals_2(PreInfo, [Goal0 | Goals0], [Goal | Goals],
- PostInfo0, PostInfo, !Info) :-
+ !PostInfos, !Info) :-
set_pre_branch_info(PreInfo, !Info),
traverse_goal_2(Goal0, Goal, !Info),
- get_post_branch_info(PostInfo1, !Info),
- merge_post_branch_infos(PostInfo0, PostInfo1, PostInfo2),
- traverse_independent_goals_2(PreInfo, Goals0, Goals, PostInfo2, PostInfo,
- !Info).
+ get_post_branch_info(!.Info, GoalPostInfo),
+ !:PostInfos = [GoalPostInfo | !.PostInfos],
+ traverse_independent_goals_2(PreInfo, Goals0, Goals, !PostInfos, !Info).
% Switches are treated in exactly the same way as disjunctions.
%
:- pred traverse_cases(list(case)::in, list(case)::out,
higher_order_info::in, higher_order_info::out) is det.
-traverse_cases([], [], !Info).
-traverse_cases([case(ConsId, Goal0) | Cases0], [case(ConsId, Goal) | Cases],
- !Info) :-
- get_pre_branch_info(PreInfo, !Info),
- traverse_goal_2(Goal0, Goal, !Info),
- get_post_branch_info(PostInfo0, !Info),
- traverse_cases_2(PreInfo, Cases0, Cases, PostInfo0, PostInfo, !Info),
- set_post_branch_info(PostInfo, !Info).
+traverse_cases(Cases0, Cases, !Info) :-
+ % We handle empty lists separately because merge_post_branch_infos_into_one
+ % works only on nonempty lists.
+ (
+ Cases0 = [],
+ error("traverse_cases: empty list of cases")
+ ;
+ Cases0 = [_ | _],
+ get_pre_branch_info(!.Info, PreInfo),
+ traverse_cases_2(PreInfo, Cases0, Cases, [], PostInfos, !Info),
+ merge_post_branch_infos_into_one(PostInfos, PostInfo),
+ set_post_branch_info(PostInfo, !Info)
+ ).
:- pred traverse_cases_2(pre_branch_info::in, list(case)::in, list(case)::out,
- post_branch_info::in, post_branch_info::out,
+ list(post_branch_info)::in, list(post_branch_info)::out,
higher_order_info::in, higher_order_info::out) is det.
-traverse_cases_2(_, [], [], !PostInfo, !Info).
-traverse_cases_2(PreInfo, [Case0 | Cases0], [Case | Cases],
- PostInfo0, PostInfo, !Info) :-
+traverse_cases_2(_, [], [], !PostInfos, !Info).
+traverse_cases_2(PreInfo, [Case0 | Cases0], [Case | Cases], !PostInfos,
+ !Info) :-
set_pre_branch_info(PreInfo, !Info),
Case0 = case(ConsId, Goal0),
traverse_goal_2(Goal0, Goal, !Info),
Case = case(ConsId, Goal),
- get_post_branch_info(PostInfo1, !Info),
- merge_post_branch_infos(PostInfo0, PostInfo1, PostInfo2),
- traverse_cases_2(PreInfo, Cases0, Cases, PostInfo2, PostInfo, !Info).
+ get_post_branch_info(!.Info, GoalPostInfo),
+ !:PostInfos = [GoalPostInfo | !.PostInfos],
+ traverse_cases_2(PreInfo, Cases0, Cases, !PostInfos, !Info).
-:- type pre_branch_info == pred_vars.
-:- type post_branch_info == pred_vars.
+:- type pre_branch_info
+ ---> pre_branch_info(pred_vars).
-:- pred get_pre_branch_info(pre_branch_info::out,
- higher_order_info::in, higher_order_info::out) is det.
+:- type post_branch_info
+ ---> post_branch_info(pred_vars).
+
+:- pred get_pre_branch_info(higher_order_info::in, pre_branch_info::out)
+ is det.
-get_pre_branch_info(Info ^ pred_vars, Info, Info).
+get_pre_branch_info(Info, pre_branch_info(Info ^ pred_vars)).
:- pred set_pre_branch_info(pre_branch_info::in,
higher_order_info::in, higher_order_info::out) is det.
-set_pre_branch_info(PreInfo, Info, Info ^ pred_vars := PreInfo).
+set_pre_branch_info(pre_branch_info(PreInfo),
+ Info, Info ^ pred_vars := PreInfo).
-:- pred get_post_branch_info(pre_branch_info::out,
- higher_order_info::in, higher_order_info::out) is det.
+:- pred get_post_branch_info(higher_order_info::in, post_branch_info::out)
+ is det.
-get_post_branch_info(Info ^ pred_vars, Info, Info).
+get_post_branch_info(Info, post_branch_info(Info ^ pred_vars)).
:- pred set_post_branch_info(post_branch_info::in,
higher_order_info::in, higher_order_info::out) is det.
-set_post_branch_info(PostInfo, Info, Info ^ pred_vars := PostInfo).
+set_post_branch_info(post_branch_info(PostInfo),
+ Info, Info ^ pred_vars := PostInfo).
- % This is used in traversing disjunctions. We save the initial
- % accumulator, then traverse each disjunct starting with the initial
- % info. We then merge the resulting infos.
+ % Merge a bunch of post_branch_infos into one.
+ %
+ % The algorithm we use has a complexity of N log N, whereas the obvious
+ % algorithm is quadratic. Since N can be very large for predicates defined
+ % lots of facts, this can be the difference between being able to compile
+ % them and having the compiler exhaust available memory in the attempt.
+ %
+:- pred merge_post_branch_infos_into_one(list(post_branch_info)::in,
+ post_branch_info::out) is det.
+
+merge_post_branch_infos_into_one([], _) :-
+ error("merge_post_branch_infos_into_one: empty list").
+merge_post_branch_infos_into_one([PostInfo], PostInfo).
+merge_post_branch_infos_into_one(PostInfos @ [_, _ | _], PostInfo) :-
+ merge_post_branch_info_pass(PostInfos, [], MergedPostInfos),
+ merge_post_branch_infos_into_one(MergedPostInfos, PostInfo).
+
+:- pred merge_post_branch_info_pass(list(post_branch_info)::in,
+ list(post_branch_info)::in, list(post_branch_info)::out) is det.
+
+merge_post_branch_info_pass([], !MergedPostInfos).
+merge_post_branch_info_pass([PostInfo], !MergedPostInfos) :-
+ !:MergedPostInfos = [PostInfo | !.MergedPostInfos].
+merge_post_branch_info_pass([PostInfo1, PostInfo2 | Rest], !MergedPostInfos) :-
+ merge_post_branch_infos(PostInfo1, PostInfo2, PostInfo12),
+ !:MergedPostInfos = [PostInfo12 | !.MergedPostInfos],
+ merge_post_branch_info_pass(Rest, !MergedPostInfos).
+
+ % Merge two post_branch_infos.
+ %
+ % The algorithm we use is designed to minimize worst case complexity,
+ % to minimize compilation time for predicates defined by clauses in which
+ % each clause contains lots of variables. This will happen e.g. when the
+ % clause contains some large ground terms.
+ %
+ % We separate out the variables that occur in only one post_branch_info
+ % to avoid having to process them at all, while allowing the variables
+ % occur in both post_branch_infos to be processed using a linear algorithm.
+ % The algorithm here is mostly linear, with an extra log N factor coming in
+ % from the operations on maps.
%
:- pred merge_post_branch_infos(post_branch_info::in,
post_branch_info::in, post_branch_info::out) is det.
-merge_post_branch_infos(PredVars1, PredVars2, PredVars) :-
- map.to_assoc_list(PredVars1, PredVarList1),
- map.to_assoc_list(PredVars2, PredVarList2),
- merge_pred_var_lists(PredVarList1, PredVarList2, PredVarList),
- map.from_assoc_list(PredVarList, PredVars).
+merge_post_branch_infos(PostA, PostB, Post) :-
+ PostA = post_branch_info(VarConstMapA),
+ PostB = post_branch_info(VarConstMapB),
+ map.keys(VarConstMapA, VarListA),
+ map.keys(VarConstMapB, VarListB),
+ set.sorted_list_to_set(VarListA, VarsA),
+ set.sorted_list_to_set(VarListB, VarsB),
+ set.intersect(VarsA, VarsB, CommonVars),
+ VarConstCommonMapA = map.select(VarConstMapA, CommonVars),
+ VarConstCommonMapB = map.select(VarConstMapB, CommonVars),
+ map.to_assoc_list(VarConstCommonMapA, VarConstCommonListA),
+ map.to_assoc_list(VarConstCommonMapB, VarConstCommonListB),
+ merge_common_var_const_list(VarConstCommonListA, VarConstCommonListB,
+ [], VarConstCommonList),
+ set.difference(VarsA, CommonVars, OnlyVarsA),
+ set.difference(VarsB, CommonVars, OnlyVarsB),
+ VarConstOnlyMapA = map.select(VarConstMapA, OnlyVarsA),
+ VarConstOnlyMapB = map.select(VarConstMapB, OnlyVarsB),
+ map.to_assoc_list(VarConstOnlyMapA, VarConstOnlyListA),
+ map.to_assoc_list(VarConstOnlyMapB, VarConstOnlyListB),
+ FinalList = VarConstOnlyListA ++ VarConstOnlyListB ++ VarConstCommonList,
+ map.from_assoc_list(FinalList, FinalVarConstMap),
+ Post = post_branch_info(FinalVarConstMap).
- % Find out which variables after a disjunction cannot be specialized.
- %
-:- pred merge_pred_var_lists(assoc_list(prog_var, maybe_const)::in,
+:- pred merge_common_var_const_list(assoc_list(prog_var, maybe_const)::in,
assoc_list(prog_var, maybe_const)::in,
- assoc_list(prog_var, maybe_const)::out) is det.
-
-merge_pred_var_lists([], !MergedList).
-merge_pred_var_lists([PredVar | PredVars], !MergedList) :-
- merge_pred_var_with_list(PredVar, !MergedList),
- merge_pred_var_lists(PredVars, !MergedList).
-
-:- pred merge_pred_var_with_list(pair(prog_var, maybe_const)::in,
assoc_list(prog_var, maybe_const)::in,
assoc_list(prog_var, maybe_const)::out) is det.
-merge_pred_var_with_list(VarValue, [], [VarValue]).
-merge_pred_var_with_list(Var1 - Value1, [Var2 - Value2 | Vars], MergedList) :-
- ( Var1 = Var2 ->
- (
- ( Value1 \= Value2
- ; Value1 = multiple_values
- ; Value2 = multiple_values
- )
- ->
- MergedList = [Var1 - multiple_values | Vars]
- ;
- MergedList = [Var2 - Value2 | Vars]
- )
- % Each var occurs at most once most in each list
- % so if we have seen it we don't need to go on.
- ;
- MergedList = [Var2 - Value2 | MergedList1],
- merge_pred_var_with_list(Var1 - Value1, Vars, MergedList1)
- ).
+merge_common_var_const_list([], [], !List).
+merge_common_var_const_list([], [_ | _], !MergedList) :-
+ error("merge_common_var_const_list: mismatched list").
+merge_common_var_const_list([_ | _], [], !MergedList) :-
+ error("merge_common_var_const_list: mismatched list").
+merge_common_var_const_list([VarA - ValueA | ListA], [VarB - ValueB | ListB],
+ !MergedList) :-
+ require(unify(VarA, VarB), "merge_common_var_const_list: var mismatch"),
+ ( ValueA = ValueB ->
+ % It does not matter whether ValueA is bound to constant(_, _)
+ % or to multiple_values, in both cases, if ValueA = ValueB, the
+ % right value for Value is ValueA.
+ Value = ValueA
+ ;
+ % Either ValueA and ValueB are both bound to different constants,
+ % or one is constant and the other is multiple_values. In both cases,
+ % the right value for Value is multiple_values.
+ Value = multiple_values
+ ),
+ !:MergedList = [VarA - Value | !.MergedList],
+ merge_common_var_const_list(ListA, ListB, !MergedList).
:- pred check_unify(unification::in,
higher_order_info::in, higher_order_info::out) is det.
- % Testing two higher order terms for equality is not allowed.
- %
check_unify(simple_test(_, _), !Info).
-check_unify(assign(Var1, Var2), !Info) :- maybe_add_alias(Var1, Var2, !Info).
- % Deconstructing a higher order term is not allowed.
- %
+ % Testing two higher order terms for equality is not allowed.
+check_unify(assign(Var1, Var2), !Info) :-
+ maybe_add_alias(Var1, Var2, !Info).
check_unify(deconstruct(_, _, _, _, _, _), !Info).
+ % Deconstructing a higher order term is not allowed.
check_unify(construct(LVar, ConsId, Args, _Modes, _, _, _), !Info) :-
- (
- is_interesting_cons_id(!.Info ^ global_info ^ ho_params,
- ConsId) = yes
- ->
+ ( is_interesting_cons_id(!.Info ^ global_info ^ ho_params, ConsId) = yes ->
( map.search(!.Info ^ pred_vars, LVar, Specializable) ->
(
% We cannot specialize calls involving a variable with
Index: compiler/hlds_clauses.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_clauses.m,v
retrieving revision 1.1
diff -u -b -r1.1 hlds_clauses.m
--- compiler/hlds_clauses.m 24 Mar 2006 03:03:46 -0000 1.1
+++ compiler/hlds_clauses.m 24 Mar 2006 05:42:51 -0000
@@ -77,6 +77,10 @@
%
:- func clause_list_is_empty(clauses_rep) = bool.
+ % Returns the number of clauses in the clauses list.
+ %
+:- func num_clauses_in_clauses_rep(clauses_rep) = int.
+
% Adds the given clause to the end of the clause list.
%
:- pred add_clause(clause::in, clauses_rep::in, clauses_rep::out) is det.
@@ -215,27 +219,43 @@
clauses_info_set_explicit_vartypes(X, CI, CI ^ explicit_vartypes := X).
clauses_info_set_vartypes(X, CI, CI ^ vartypes := X).
clauses_info_set_headvars(X, CI, CI ^ headvars := X).
-clauses_info_set_clauses(X, CI, CI ^ clauses_rep := forw(X)).
+clauses_info_set_clauses(X, CI, CI ^ clauses_rep := Rep) :-
+ set_clause_list(X, Rep).
clauses_info_set_clauses_rep(X, CI, CI ^ clauses_rep := X).
clauses_info_set_rtti_varmaps(X, CI, CI ^ clauses_rtti_varmaps := X).
+ % In each of the alternatives below, the num field gives the number of
+ % clauses. in the forw_list and both_forw fields, the clauses are in
+ % program order. In the rev_list and both_rev fields, the clauses are in
+ % reverse program order. It is an invariant that
+ %
+ % list.reverse(Rep ^ both_rev, Rep & both_forw)
+ %
+ % holds.
:- type clauses_rep
- ---> rev(list(clause))
- ; forw(list(clause))
+ ---> rev(
+ rev_num :: int,
+ rev_list :: list(clause)
+ )
+ ; forw(
+ forw_num :: int,
+ forw_list :: list(clause)
+ )
; both(
- rev :: list(clause),
- forw :: list(clause)
+ both_num :: int,
+ both_rev :: list(clause),
+ both_forw :: list(clause)
).
-init_clauses_rep = forw([]).
+init_clauses_rep = forw(0, []).
clause_list_is_empty(ClausesRep) = IsEmpty :-
(
- ClausesRep = rev(List)
+ ClausesRep = rev(_, List)
;
- ClausesRep = forw(List)
+ ClausesRep = forw(_, List)
;
- ClausesRep = both(List, _)
+ ClausesRep = both(_, List, _)
),
(
List = [],
@@ -245,26 +265,35 @@
IsEmpty = no
).
+num_clauses_in_clauses_rep(ClausesRep) = NumClauses :-
+ (
+ ClausesRep = rev(NumClauses, _)
+ ;
+ ClausesRep = forw(NumClauses, _)
+ ;
+ ClausesRep = both(NumClauses, _, _)
+ ).
+
get_clause_list_any_order(ClausesRep, Clauses) :-
(
- ClausesRep = rev(Clauses)
+ ClausesRep = rev(_, Clauses)
;
- ClausesRep = forw(Clauses)
+ ClausesRep = forw(_, Clauses)
;
- ClausesRep = both(_, Clauses)
+ ClausesRep = both(_, _, Clauses)
).
get_clause_list(ClausesRep, Clauses) :-
(
- ClausesRep = rev(RevClauses),
+ ClausesRep = rev(_, RevClauses),
list.reverse(RevClauses, Clauses)
;
- ClausesRep = forw(Clauses)
+ ClausesRep = forw(_, Clauses)
;
- ClausesRep = both(_, Clauses)
+ ClausesRep = both(_, _, Clauses)
).
-set_clause_list(Clauses, forw(Clauses)).
+set_clause_list(Clauses, forw(list.length(Clauses), Clauses)).
clauses_info_clauses_only(CI, Clauses) :-
ClausesRep = CI ^ clauses_rep,
@@ -273,31 +302,34 @@
clauses_info_clauses(Clauses, !CI) :-
ClausesRep = !.CI ^ clauses_rep,
(
- ClausesRep = rev(RevClauses),
+ ClausesRep = rev(NumClauses, RevClauses),
list.reverse(RevClauses, Clauses),
- !:CI = !.CI ^ clauses_rep := both(RevClauses, Clauses)
+ !:CI = !.CI ^ clauses_rep := both(NumClauses, RevClauses, Clauses)
;
- ClausesRep = forw(Clauses)
+ ClausesRep = forw(_, Clauses)
;
- ClausesRep = both(_, Clauses)
+ ClausesRep = both(_, _, Clauses)
).
add_clause(Clause, !ClausesRep) :-
% We keep the clause list in reverse order, to make it possible
% to add other clauses without quadratic behavior.
(
- !.ClausesRep = rev(RevClauses0),
+ !.ClausesRep = rev(NumClauses0, RevClauses0),
+ NumClauses = NumClauses0 + 1,
RevClauses = [Clause | RevClauses0],
- !:ClausesRep = rev(RevClauses)
+ !:ClausesRep = rev(NumClauses, RevClauses)
;
- !.ClausesRep = forw(Clauses0),
+ !.ClausesRep = forw(NumClauses0, Clauses0),
+ NumClauses = NumClauses0 + 1,
list.reverse(Clauses0, RevClauses0),
RevClauses = [Clause | RevClauses0],
- !:ClausesRep = rev(RevClauses)
+ !:ClausesRep = rev(NumClauses, RevClauses)
;
- !.ClausesRep = both(RevClauses0, _),
+ !.ClausesRep = both(NumClauses0, RevClauses0, _),
+ NumClauses = NumClauses0 + 1,
RevClauses = [Clause | RevClauses0],
- !:ClausesRep = rev(RevClauses)
+ !:ClausesRep = rev(NumClauses, RevClauses)
).
%-----------------------------------------------------------------------------%
Index: compiler/inst_match.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/inst_match.m,v
retrieving revision 1.72
diff -u -b -r1.72 inst_match.m
--- compiler/inst_match.m 17 Mar 2006 01:40:21 -0000 1.72
+++ compiler/inst_match.m 25 Mar 2006 12:12:18 -0000
@@ -314,6 +314,7 @@
:- import_module list.
:- import_module map.
:- import_module set.
+:- import_module set_tree234.
:- import_module std_util.
:- import_module svset.
:- import_module term.
@@ -363,7 +364,26 @@
mer_inst,
maybe(mer_type)
).
-:- type expansions == set(inst_match_inputs).
+
+:- type expansions == set_tree234(inst_match_inputs).
+
+:- func expansion_init = expansions.
+:- pragma inline(expansion_init/0).
+
+expansion_init = set_tree234.init.
+
+:- pred expansion_member(inst_match_inputs::in, expansions::in) is semidet.
+:- pragma inline(expansion_member/2).
+
+expansion_member(E, S) :-
+ set_tree234.member(S, E).
+
+:- pred expansion_insert(inst_match_inputs::in,
+ expansions::in, expansions::out) is det.
+:- pragma inline(expansion_insert/3).
+
+expansion_insert(E, S0, S) :-
+ set_tree234.insert(E, S0, S).
% The uniqueness_comparison type is used by the predicate
% compare_uniqueness to determine what order should be used for
@@ -371,12 +391,12 @@
:- type uniqueness_comparison
---> match
- % We are doing a "matches" comparison, e.g. at a
- % predicate call or the end of a procedure body.
+ % We are doing a "matches" comparison, e.g. at a predicate call
+ % or the end of a procedure body.
; instantiated.
- % We are comparing two insts for how "instantiated" they
- % are. The uniqueness order here should be the reverse
- % of the order used for matching.
+ % We are comparing two insts for how "instantiated" they are.
+ % The uniqueness order here should be the reverse of the order
+ % used for matching.
:- type inst_match_info
---> inst_match_info(
@@ -417,7 +437,7 @@
:- func init_inst_match_info(module_info) = inst_match_info.
init_inst_match_info(ModuleInfo) =
- inst_match_info(ModuleInfo, set.init, no, none, match, yes).
+ inst_match_info(ModuleInfo, expansion_init, no, none, match, yes).
:- pred swap_sub(
pred(inst_match_info, inst_match_info)::in(pred(in, out) is semidet),
@@ -446,12 +466,12 @@
inst_matches_initial_2(InstA, InstB, MaybeType, !Info) :-
ThisExpansion = inst_match_inputs(InstA, InstB, MaybeType),
- ( set.member(ThisExpansion, !.Info ^ expansions) ->
+ ( expansion_member(ThisExpansion, !.Info ^ expansions) ->
true
;
inst_expand(!.Info ^ module_info, InstA, InstA2),
inst_expand(!.Info ^ module_info, InstB, InstB2),
- set.insert(!.Info ^ expansions, ThisExpansion, Expansions1),
+ expansion_insert(ThisExpansion, !.Info ^ expansions, Expansions1),
handle_inst_var_subs(inst_matches_initial_2,
inst_matches_initial_4, InstA2, InstB2, MaybeType,
!.Info ^ expansions := Expansions1, !:Info)
@@ -962,14 +982,14 @@
inst_matches_final_2(InstA, InstB, MaybeType, !Info) :-
ThisExpansion = inst_match_inputs(InstA, InstB, MaybeType),
- ( set.member(ThisExpansion, !.Info ^ expansions) ->
+ ( expansion_member(ThisExpansion, !.Info ^ expansions) ->
true
; InstA = InstB ->
true
;
inst_expand(!.Info ^ module_info, InstA, InstA2),
inst_expand(!.Info ^ module_info, InstB, InstB2),
- set.insert(!.Info ^ expansions, ThisExpansion, Expansions1),
+ expansion_insert(ThisExpansion, !.Info ^ expansions, Expansions1),
handle_inst_var_subs(inst_matches_final_2,
inst_matches_final_3, InstA2, InstB2, MaybeType,
!.Info ^ expansions := Expansions1, !:Info)
@@ -1082,15 +1102,13 @@
inst_matches_final_2(ArgA, ArgB, Type, !Info),
inst_list_matches_final(ArgsA, ArgsB, Types, !Info).
- % Here we check that the functors in the first list are a
- % subset of the functors in the second list.
- % (If a bound(...) inst only specifies the insts for some of
- % the constructors of its type, then it implicitly means that
- % all other constructors must have all their arguments
- % `not_reached'.)
- % The code here makes use of the fact that the bound_inst lists
- % are sorted.
-
+ % Here we check that the functors in the first list are a subset of the
+ % functors in the second list. (If a bound(...) inst only specifies
+ % the insts for some of the constructors of its type, then it implicitly
+ % means that all other constructors must have all their arguments
+ % `not_reached'.) The code here makes use of the fact that the bound_inst
+ % lists are sorted.
+ %
:- pred bound_inst_list_matches_final(list(bound_inst)::in,
list(bound_inst)::in, maybe(mer_type)::in,
inst_match_info::in, inst_match_info::out) is semidet.
@@ -1133,14 +1151,14 @@
inst_matches_binding_2(InstA, InstB, MaybeType, !Info) :-
ThisExpansion = inst_match_inputs(InstA, InstB, MaybeType),
- ( set.member(ThisExpansion, !.Info ^ expansions) ->
+ ( expansion_member(ThisExpansion, !.Info ^ expansions) ->
true
;
inst_expand_and_remove_constrained_inst_vars(
!.Info ^ module_info, InstA, InstA2),
inst_expand_and_remove_constrained_inst_vars(
!.Info ^ module_info, InstB, InstB2),
- set.insert(!.Info ^ expansions, ThisExpansion, Expansions1),
+ expansion_insert(ThisExpansion, !.Info ^ expansions, Expansions1),
inst_matches_binding_3(InstA2, InstB2, MaybeType,
!.Info ^ expansions := Expansions1, !:Info)
).
@@ -1228,15 +1246,13 @@
inst_matches_binding_2(ArgA, ArgB, MaybeType, !Info),
inst_list_matches_binding(ArgsA, ArgsB, MaybeTypes, !Info).
- % Here we check that the functors in the first list are a
- % subset of the functors in the second list.
- % (If a bound(...) inst only specifies the insts for some of
- % the constructors of its type, then it implicitly means that
- % all other constructors must have all their arguments
- % `not_reached'.)
- % The code here makes use of the fact that the bound_inst lists
- % are sorted.
-
+ % Here we check that the functors in the first list are a subset of the
+ % functors in the second list. (If a bound(...) inst only specifies
+ % the insts for some of the constructors of its type, then it implicitly
+ % means that all other constructors must have all their arguments
+ % `not_reached'.) The code here makes use of the fact that the bound_inst
+ % lists are sorted.
+ %
:- pred bound_inst_list_matches_binding(list(bound_inst)::in,
list(bound_inst)::in, maybe(mer_type)::in,
inst_match_info::in, inst_match_info::out) is semidet.
@@ -1847,6 +1863,20 @@
).
inst_contains_instname_2(bound(_Uniq, ArgInsts), ModuleInfo,
InstName, Result, !Expansions) :-
+ % XXX This code has a performance problem.
+ %
+ % The problem is that e.g. in a list of length N, you'll have N variables
+ % for the skeletons whose insts contain an average of N/2 occurences of
+ % `bound' each, so the complexity of running inst_contains_instname_2
+ % on all their insts is quadratic in N.
+ %
+ % One solution to this would be to add an extra argument to bound/2
+ % that gives the set of included inst_names, or simply asserts that this
+ % set is empty. This field can be set at the time of the construction
+ % of the inst, avoiding quadratic behavior in inst_contains_instname_2.
+ % The complexity of constructing all the insts will remain quadratic in N,
+ % of course.
+
bound_inst_list_contains_instname(ArgInsts, ModuleInfo,
InstName, Result, !Expansions).
@@ -1854,8 +1884,7 @@
module_info::in, inst_name::in, bool::out,
inst_names::in, inst_names::out) is det.
-bound_inst_list_contains_instname([], _ModuleInfo,
- _InstName, no, !Expansions).
+bound_inst_list_contains_instname([], _ModuleInfo, _InstName, no, !Expansions).
bound_inst_list_contains_instname([BoundInst | BoundInsts], ModuleInfo,
InstName, Result, !Expansions) :-
BoundInst = functor(_Functor, ArgInsts),
@@ -1873,19 +1902,17 @@
:- pred inst_list_contains_instname(list(mer_inst)::in, module_info::in,
inst_name::in, bool::out, inst_names::in, inst_names::out) is det.
-inst_list_contains_instname([], _ModuleInfo, _InstName, no,
- !Expansions).
+inst_list_contains_instname([], _ModuleInfo, _InstName, no, !Expansions).
inst_list_contains_instname([Inst | Insts], ModuleInfo, InstName, Result,
!Expansions) :-
- inst_contains_instname_2(Inst, ModuleInfo, InstName, Result1,
- !Expansions),
+ inst_contains_instname_2(Inst, ModuleInfo, InstName, Result1, !Expansions),
(
Result1 = yes,
Result = yes
;
Result1 = no,
- inst_list_contains_instname(Insts, ModuleInfo, InstName,
- Result, !Expansions)
+ inst_list_contains_instname(Insts, ModuleInfo, InstName, Result,
+ !Expansions)
).
%-----------------------------------------------------------------------------%
Index: compiler/inst_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/inst_util.m,v
retrieving revision 1.45
diff -u -b -r1.45 inst_util.m
--- compiler/inst_util.m 17 Mar 2006 01:40:21 -0000 1.45
+++ compiler/inst_util.m 25 Mar 2006 12:18:15 -0000
@@ -784,8 +784,8 @@
unify_uniq(live, _, _, unique, mostly_unique, shared).
unify_uniq(dead, _, _, unique, unique, unique).
unify_uniq(dead, _, _, unique, mostly_unique, mostly_unique).
- % XXX the above line is a conservative approximation
- % sometimes it should return unique not mostly_unique
+ % XXX The above line is a conservative approximation;
+ % sometimes it should return unique not mostly_unique.
unify_uniq(Live, Real, Det, unique, clobbered, clobbered) :-
allow_unify_with_clobbered(Live, Real, Det).
unify_uniq(Live, Real, Det, unique, mostly_clobbered, mostly_clobbered) :-
@@ -795,8 +795,8 @@
unify_uniq(live, _, _, mostly_unique, unique, shared).
unify_uniq(live, _, _, mostly_unique, mostly_unique, shared).
unify_uniq(dead, _, _, mostly_unique, unique, mostly_unique).
- % XXX the above line is a conservative approximation
- % sometimes it should return unique not mostly_unique
+ % XXX The above line is a conservative approximation;
+ % sometimes it should return unique not mostly_unique.
unify_uniq(dead, _, _, mostly_unique, mostly_unique, mostly_unique).
unify_uniq(Live, Real, Det, mostly_unique, clobbered, clobbered) :-
allow_unify_with_clobbered(Live, Real, Det).
@@ -808,7 +808,11 @@
allow_unify_with_clobbered(Live, Real, Det).
unify_uniq(Live, Real, Det, mostly_clobbered, Uniq0, Uniq) :-
- ( Uniq0 = clobbered -> Uniq = clobbered ; Uniq = mostly_clobbered ),
+ ( Uniq0 = clobbered ->
+ Uniq = clobbered
+ ;
+ Uniq = mostly_clobbered
+ ),
allow_unify_with_clobbered(Live, Real, Det).
:- pred allow_unify_with_clobbered(is_live::in, unify_is_real::in,
@@ -1143,6 +1147,29 @@
"make_shared_inst: cannot make shared version of `free(T)'").
make_shared_inst(bound(Uniq0, BoundInsts0), bound(Uniq, BoundInsts),
!ModuleInfo) :-
+ % XXX This code has a performance problem.
+ %
+ % The problem is that e.g. in a list of length N, you'll have N variables
+ % for the skeletons whose insts contain an average of N/2 occurences of
+ % `bound' each, so the complexity of running make_shared_inst on all their
+ % insts is quadratic in N.
+ %
+ % One potential way to fix this would be to introduce a new function
+ % symbol for insts, make_shared(mer_inst), which would have the meaning of
+ % requiring any compiler component that finds it to run make_shared_inst
+ % on its argument before using it. That would require parameterizing
+ % make_shared_inst to say whether it is being used in such a manner.
+ %
+ % Another similar fix would be to add an extra argument to bound/2
+ % to say whether the insts in its last argument should implicitly be made
+ % shared.
+ %
+ % If Uniq0 = shared, then all the other cells below it should also be
+ % shared as well, which means we should be able to avoid the call to
+ % make_shared_bound_inst_list below. However, for the kinds of goals
+ % for which the call is a bottleneck, the goals resulting from the
+ % construction of large ground terms, Uniq0 will in fact be `unique'.
+
make_shared(Uniq0, Uniq),
make_shared_bound_inst_list(BoundInsts0, BoundInsts, !ModuleInfo).
make_shared_inst(ground(Uniq0, PredInst), ground(Uniq, PredInst),
@@ -1188,8 +1215,7 @@
inst_table_get_shared_insts(InstTable2, SharedInsts2),
svmap.det_update(InstName, known(SharedInst),
SharedInsts2, SharedInsts),
- inst_table_set_shared_insts(SharedInsts,
- InstTable2, InstTable),
+ inst_table_set_shared_insts(SharedInsts, InstTable2, InstTable),
module_info_set_inst_table(InstTable, !ModuleInfo)
),
% Avoid expanding recursive insts.
@@ -1283,7 +1309,7 @@
InstTable2, InstTable),
module_info_set_inst_table(InstTable, !ModuleInfo)
),
- % avoid expanding recursive insts
+ % Avoid expanding recursive insts.
( inst_contains_instname(NondetLiveInst, !.ModuleInfo, InstName) ->
Inst = defined_inst(InstName)
;
Index: compiler/instmap.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/instmap.m,v
retrieving revision 1.48
diff -u -b -r1.48 instmap.m
--- compiler/instmap.m 17 Mar 2006 01:40:22 -0000 1.48
+++ compiler/instmap.m 24 Mar 2006 06:16:24 -0000
@@ -31,7 +31,6 @@
:- import_module list.
:- import_module map.
:- import_module set.
-:- import_module std_util.
:- type instmap.
:- type instmap_delta.
@@ -197,16 +196,16 @@
:- pred instmap_delta_apply_instmap_delta(instmap_delta::in, instmap_delta::in,
overlay_how::in, instmap_delta::out) is det.
- % instmap_merge(NonLocalVars, InstMaps, MergeContext):
+ % instmap_merge(NonLocalVars, InstMaps, MergeContext, !ModeInfo):
%
% Merge the `InstMaps' resulting from different branches of a disjunction
% or if-then-else, and update the instantiatedness of all the nonlocal
% variables, checking that it is the same for every branch.
%
-:- pred merge(set(prog_var)::in, list(instmap)::in, merge_context::in,
+:- pred instmap_merge(set(prog_var)::in, list(instmap)::in, merge_context::in,
mode_info::in, mode_info::out) is det.
- % unify(NonLocalVars, InstMapNonlocalvarPairss):
+ % instmap_unify(NonLocalVars, InstMapNonlocalvarPairs, !ModeInfo):
%
% Unify the `InstMaps' in the list of pairs resulting from different
% branches of a parallel conjunction and update the instantiatedness
@@ -214,14 +213,14 @@
% when modechecking the individual conjuncts ensures that variables
% have at most one producer.
%
-:- pred unify(set(prog_var)::in, list(pair(instmap,
- set(prog_var)))::in, mode_info::in, mode_info::out) is det.
+:- pred instmap_unify(set(prog_var)::in,
+ assoc_list(instmap, set(prog_var))::in,
+ mode_info::in, mode_info::out) is det.
- % restrict takes an instmap and a set of vars and returns
+ % instmap_restrict takes an instmap and a set of vars and returns
% an instmap with its domain restricted to those vars.
%
-:- pred restrict(set(prog_var)::in, instmap::in, instmap::out)
- is det.
+:- pred instmap_restrict(set(prog_var)::in, instmap::in, instmap::out) is det.
% instmap_delta_restrict takes an instmap and a set of vars and returns
% an instmap_delta with its domain restricted to those vars.
@@ -252,8 +251,8 @@
instmap_delta::in, instmap_delta::in, instmap_delta::out,
module_info::in, module_info::out) is det.
- % merge_instmap_deltas(Vars, InstMapDeltas,
- % MergedInstMapDelta, ModuleInfo):
+ % merge_instmap_deltas(Vars, InstMapDeltas, MergedInstMapDelta,
+ % !ModuleInfo):
%
% Takes a list of instmap deltas from the branches of an if-then-else,
% switch, or disj and merges them. This is used in situations
@@ -600,13 +599,13 @@
%-----------------------------------------------------------------------------%
-restrict(_, unreachable, unreachable).
-restrict(Vars, reachable(InstMapping0), reachable(InstMapping)) :-
+instmap_restrict(_, unreachable, unreachable).
+instmap_restrict(Vars, reachable(InstMapping0), reachable(InstMapping)) :-
map.select(InstMapping0, Vars, InstMapping).
instmap_delta_restrict(_, unreachable, unreachable).
-instmap_delta_restrict(Vars, reachable(InstMapping0),
- reachable(InstMapping)) :-
+instmap_delta_restrict(Vars,
+ reachable(InstMapping0), reachable(InstMapping)) :-
map.select(InstMapping0, Vars, InstMapping).
instmap_delta_delete_vars(_, unreachable, unreachable).
@@ -617,13 +616,7 @@
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
- % merge(NonLocals, InstMapList, MergeContext, !ModeInfo):
- %
- % Merge the `InstMapList' resulting from different branches of a
- % disjunction or if-then-else, and update the instantiatedness of all
- % the nonlocal variables, checking that it is the same for every branch.
- %
-merge(NonLocals, InstMapList, MergeContext, !ModeInfo) :-
+instmap_merge(NonLocals, InstMapList, MergeContext, !ModeInfo) :-
mode_info_get_instmap(!.ModeInfo, InstMap0),
mode_info_get_module_info(!.ModeInfo, ModuleInfo0),
get_reachable_instmaps(InstMapList, InstMappingList),
@@ -742,8 +735,7 @@
module_info::in, module_info::out, maybe(mer_inst)::out) is det.
merge_var(Insts, Var, Type, !ModuleInfo, MaybeMergedInst) :-
- merge_var_2(Insts, Var, Type, [], MergedInsts, !ModuleInfo,
- no, Error),
+ merge_var_2(Insts, Var, Type, [], MergedInsts, !ModuleInfo, no, Error),
(
Error = yes,
MaybeMergedInst = no
@@ -757,8 +749,7 @@
MaybeMergedInst = yes(MergedInst)
;
MergedInsts = [_, _ | _],
- merge_var(MergedInsts, Var, Type, !ModuleInfo,
- MaybeMergedInst)
+ merge_var(MergedInsts, Var, Type, !ModuleInfo, MaybeMergedInst)
)
).
@@ -769,12 +760,11 @@
merge_var_2([], _, _, !MergedInsts, !ModuleInfo, !Error).
merge_var_2([Inst], _Var, _Type, !MergedInsts, !ModuleInfo, !Error) :-
!:MergedInsts = [Inst | !.MergedInsts].
-merge_var_2([Inst1, Inst2 | Insts], Var, Type, !MergedInsts,
- !ModuleInfo, !Error) :-
+merge_var_2([Inst1, Inst2 | Insts], Var, Type, !MergedInsts, !ModuleInfo,
+ !Error) :-
( inst_merge(Inst1, Inst2, yes(Type), MergedInst, !ModuleInfo) ->
!:MergedInsts = [MergedInst | !.MergedInsts],
- merge_var_2(Insts, Var, Type, !MergedInsts, !ModuleInfo,
- !Error)
+ merge_var_2(Insts, Var, Type, !MergedInsts, !ModuleInfo, !Error)
;
!:Error = yes
).
@@ -818,7 +808,7 @@
%-----------------------------------------------------------------------------%
-unify(NonLocals, InstMapList, !ModeInfo) :-
+instmap_unify(NonLocals, InstMapList, !ModeInfo) :-
(
% If any of the instmaps is unreachable, then the final instmap
% is unreachable.
Index: compiler/make_hlds_warn.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/make_hlds_warn.m,v
retrieving revision 1.10
diff -u -b -r1.10 make_hlds_warn.m
--- compiler/make_hlds_warn.m 24 Mar 2006 04:40:44 -0000 1.10
+++ compiler/make_hlds_warn.m 25 Mar 2006 14:42:19 -0000
@@ -157,7 +157,7 @@
),
Vars = [_ | _]
->
- quantification.goal_vars(SubGoal, SubGoalVars),
+ SubGoalVars = free_goal_vars(SubGoal),
goal_info_get_context(GoalInfo, Context),
set.init(EmptySet),
warn_singletons(Vars, GoalInfo, EmptySet, SubGoalVars, VarSet,
@@ -177,8 +177,8 @@
%
(
Vars = [_ | _],
- quantification.goal_vars(Cond, CondVars),
- quantification.goal_vars(Then, ThenVars),
+ CondVars = free_goal_vars(Cond),
+ ThenVars = free_goal_vars(Then),
set.union(CondVars, ThenVars, CondThenVars),
goal_info_get_context(GoalInfo, Context),
set.init(EmptySet),
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.379
diff -u -b -r1.379 mercury_compile.m
--- compiler/mercury_compile.m 17 Mar 2006 01:40:27 -0000 1.379
+++ compiler/mercury_compile.m 25 Mar 2006 13:53:00 -0000
@@ -2637,6 +2637,7 @@
true
),
find_simplifications(no, Globals, Simplifications0),
+ SimpList0 = simplifications_to_list(Simplifications0),
globals.lookup_bool_option(Globals, profile_deep, DeepProf),
globals.lookup_bool_option(Globals, record_term_sizes_as_words, TSWProf),
@@ -2651,14 +2652,15 @@
% mercury_compile.simplify.
%
ProfTrans = yes,
- Simplifications = list.delete_all(Simplifications0, constant_prop)
+ SimpList1 = list.delete_all(SimpList0, constant_prop)
;
ProfTrans = no,
- Simplifications = Simplifications0
+ SimpList1 = SimpList0
),
- simplify_proc([do_once | Simplifications], PredId, ProcId,
- !HLDS, !ProcInfo, !IO),
+ SimpList = [do_once | SimpList1],
+ Simplifications = list_to_simplifications(SimpList),
+ simplify_proc(Simplifications, PredId, ProcId, !HLDS, !ProcInfo, !IO),
write_proc_progress_message("% Computing liveness in ", PredId, ProcId,
!.HLDS, !IO),
detect_liveness_proc(PredId, ProcId, !.HLDS, !ProcInfo, !IO),
@@ -3040,22 +3042,23 @@
->
true
;
- some [!Simplifications] (
maybe_write_string(Verbose, "% Simplifying goals...\n", !IO),
maybe_flush_output(Verbose, !IO),
- simplify.find_simplifications(Warn, Globals, !:Simplifications),
+ some [!SimpList] (
+ simplify.find_simplifications(Warn, Globals, Simplifications0),
+ !:SimpList = simplifications_to_list(Simplifications0),
(
SimplifyPass = frontend
;
SimplifyPass = post_untuple,
- list.cons(do_once, !Simplifications)
+ list.cons(do_once, !SimpList)
;
SimplifyPass = pre_prof_transforms,
- list.cons(do_once, !Simplifications)
+ list.cons(do_once, !SimpList)
;
SimplifyPass = ml_backend,
- list.cons(do_once, !Simplifications)
+ list.cons(do_once, !SimpList)
;
% Don't perform constant propagation if one of the
% profiling transformations has been applied.
@@ -3068,19 +3071,18 @@
IsProfPass = yes,
% XXX Why does find_simplifications return a list of
% them rather than a set?
- list.delete_all(!.Simplifications, constant_prop,
- !:Simplifications)
+ list.delete_all(!.SimpList, constant_prop, !:SimpList)
;
IsProfPass = no
),
- list.cons(do_once, !Simplifications)
+ list.cons(do_once, !SimpList)
+ ),
+ Simplifications = list_to_simplifications(!.SimpList)
),
- Process(update_pred_error(simplify_pred(!.Simplifications)), !HLDS,
- !IO),
+ Process(update_pred_error(simplify_pred(Simplifications)), !HLDS, !IO),
maybe_write_string(Verbose, "% done.\n", !IO),
maybe_report_stats(Stats, !IO)
- )
).
%-----------------------------------------------------------------------------%
@@ -3298,11 +3300,25 @@
globals.io_lookup_bool_option(polymorphism, Polymorphism, !IO),
(
Polymorphism = yes,
+ globals.io_lookup_bool_option(very_verbose, VeryVerbose, !IO),
+ (
+ VeryVerbose = no,
+ maybe_write_string(Verbose,
+ "% Transforming polymorphic unifications...", !IO)
+ ;
+ VeryVerbose = yes,
maybe_write_string(Verbose,
- "% Transforming polymorphic unifications...", !IO),
+ "% Transforming polymorphic unifications...\n", !IO)
+ ),
maybe_flush_output(Verbose, !IO),
polymorphism.process_module(!HLDS, !IO),
- maybe_write_string(Verbose, " done.\n", !IO),
+ (
+ VeryVerbose = no,
+ maybe_write_string(Verbose, " done.\n", !IO)
+ ;
+ VeryVerbose = yes,
+ maybe_write_string(Verbose, "% done.\n", !IO)
+ ),
maybe_report_stats(Stats, !IO)
;
Polymorphism = no,
Index: compiler/mode_info.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mode_info.m,v
retrieving revision 1.84
diff -u -b -r1.84 mode_info.m
--- compiler/mode_info.m 24 Mar 2006 03:03:55 -0000 1.84
+++ compiler/mode_info.m 24 Mar 2006 14:29:48 -0000
@@ -1,4 +1,4 @@
-%-----------------------------------------------------------------------------%
+ %-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 1994-2001, 2003-2006 The University of Melbourne.
@@ -141,6 +141,7 @@
:- pred mode_info_get_may_change_called_proc(mode_info::in,
may_change_called_proc::out) is det.
:- pred mode_info_get_initial_instmap(mode_info::in, instmap::out) is det.
+:- pred mode_info_get_in_from_ground_term(mode_info::in, bool::out) is det.
%-----------------------------------------------------------------------------%
@@ -198,6 +199,8 @@
mode_info::in, mode_info::out) is det.
:- pred mode_info_set_checking_extra_goals(bool::in,
mode_info::in, mode_info::out) is det.
+:- pred mode_info_set_in_from_ground_term(bool::in,
+ mode_info::in, mode_info::out) is det.
%-----------------------------------------------------------------------------%
@@ -219,12 +222,15 @@
:- pred mode_info_get_call_id(mode_info::in, pred_id::in,
simple_call_id::out) is det.
+ % Check whether a variable or a list of variables are live or not.
+ %
:- pred mode_info_var_list_is_live(mode_info::in, list(prog_var)::in,
list(is_live)::out) is det.
-
:- pred mode_info_var_is_live(mode_info::in, prog_var::in,
is_live::out) is det.
+ % Check whether a variable is nondet_live or not.
+ %
:- pred mode_info_var_is_nondet_live(mode_info::in, prog_var::in,
is_live::out) is det.
@@ -321,11 +327,16 @@
% after mode analysis finishes.
need_to_requantify :: bool,
- % Set to `yes' if we are in a promise_<purity> scope. This
- % information is needed to check that potentially impure
- % uses of inst any non-locals in negated contexts are
- % properly acknowledged by the programmer.
- in_promise_purity_scope :: bool
+ % Set to `yes' if we are in a promise_<purity> scope.
+ % This information is needed to check that potentially impure
+ % uses of inst any non-locals in negated contexts are properly
+ % acknowledged by the programmer.
+ in_promise_purity_scope :: bool,
+
+ % Set to `yes' if we are in a from_ground_term scope.
+ % This information allows us to optimize some aspects of
+ % mode analysis.
+ in_from_ground_term :: bool
).
:- type mode_info
@@ -388,7 +399,8 @@
% first, and is the set of variables that have been [further]
% bound inside the current parallel conjunct - the stack
% is for the correct handling of nested parallel conjunctions.
- parallel_vars :: list(pair(set(prog_var), set(prog_var))),
+ parallel_vars :: list(pair(set(prog_var),
+ set(prog_var))),
how_to_check :: how_to_check_goal,
@@ -416,10 +428,8 @@
DebugModes = yes,
( DebugModesPredId >= 0 => DebugModesPredId = PredIdInt )
->
- globals.lookup_bool_option(Globals, debug_modes_verbose,
- DebugVerbose),
- globals.lookup_bool_option(Globals, debug_modes_minimal,
- DebugMinimal),
+ globals.lookup_bool_option(Globals, debug_modes_verbose, DebugVerbose),
+ globals.lookup_bool_option(Globals, debug_modes_minimal, DebugMinimal),
globals.lookup_bool_option(Globals, debug_modes_statistics,
Statistics),
Flags = debug_flags(DebugVerbose, DebugMinimal, Statistics),
@@ -434,7 +444,6 @@
delay_info_init(DelayInfo),
ErrorList = [],
WarningList = [],
- % look up the varset and var types
module_info_preds(ModuleInfo, Preds),
map.lookup(Preds, PredId, PredInfo),
pred_info_procedures(PredInfo, Procs),
@@ -454,7 +463,7 @@
ModeSubInfo = mode_sub_info(ProcId, VarSet, Unreachable, Changed,
CheckingExtraGoals, InstMapping0, WarningList, NeedToRequantify,
- InNegatedContext),
+ InNegatedContext, no),
ModeInfo = mode_info(ModuleInfo, PredId, VarTypes, Debug,
Context, ModeContext, InstMapping0, LockedVars, DelayInfo,
@@ -489,6 +498,8 @@
mode_info_get_how_to_check(MI, MI ^ how_to_check).
mode_info_get_may_change_called_proc(MI, MI ^ may_change_called_proc).
mode_info_get_initial_instmap(MI, MI ^ mode_sub_info ^ initial_instmap).
+mode_info_get_in_from_ground_term(MI,
+ MI ^ mode_sub_info ^ in_from_ground_term).
mode_info_set_module_info(ModuleInfo, MI, MI ^ module_info := ModuleInfo).
mode_info_set_predid(PredId, MI, MI ^ predid := PredId).
@@ -517,6 +528,8 @@
mode_info_set_how_to_check(How, MI, MI ^ how_to_check := How).
mode_info_set_may_change_called_proc(MayChange, MI,
MI ^ may_change_called_proc := MayChange).
+mode_info_set_in_from_ground_term(FGI, MI,
+ MI ^ mode_sub_info ^ in_from_ground_term := FGI).
%-----------------------------------------------------------------------------%
@@ -537,8 +550,7 @@
mode_info_set_call_arg_context(ArgNum, ModeInfo0, ModeInfo) :-
mode_info_get_mode_context(ModeInfo0, ModeContext0),
( ModeContext0 = call(CallId, _) ->
- mode_info_set_mode_context(call(CallId, ArgNum),
- ModeInfo0, ModeInfo)
+ mode_info_set_mode_context(call(CallId, ArgNum), ModeInfo0, ModeInfo)
; ModeContext0 = unify(_UnifyContext, _Side) ->
% This only happens when checking that the typeinfo variables
% for polymorphic complicated unifications are ground.
@@ -579,8 +591,8 @@
% This allows us to easily add and remove sets of variables.
% It's probably not maximally efficient.
- % Add a set of vars to the bag of live vars and
- % the bag of nondet-live vars.
+ % Add a set of vars to the bag of live vars and the bag of
+ % nondet-live vars.
mode_info_add_live_vars(NewLiveVars, !MI) :-
LiveVars0 = !.MI ^ live_vars,
@@ -607,8 +619,6 @@
delay_info_bind_var_list(VarList, DelayInfo0, DelayInfo),
!:MI = !.MI ^ delay_info := DelayInfo.
- % Check whether a list of variables are live or not
-
mode_info_var_list_is_live(_, [], []).
mode_info_var_list_is_live(ModeInfo, [Var | Vars], [Live | Lives]) :-
mode_info_var_is_live(ModeInfo, Var, Live),
@@ -622,8 +632,6 @@
;
Result = dead
).
-
- % Check whether a variable is nondet_live or not.
mode_info_var_is_nondet_live(ModeInfo, Var, Result) :-
( bag.contains(ModeInfo ^ nondet_live_vars, Var) ->
Index: compiler/modecheck_unify.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/modecheck_unify.m,v
retrieving revision 1.99
diff -u -b -r1.99 modecheck_unify.m
--- compiler/modecheck_unify.m 9 Mar 2006 04:56:36 -0000 1.99
+++ compiler/modecheck_unify.m 25 Mar 2006 01:15:53 -0000
@@ -193,7 +193,7 @@
Unify = Unify0
;
MaybeInitX = yes(InitGoal - InitGoalInfo),
- modes.compute_goal_instmap_delta(InstMap, Unify0,
+ compute_goal_instmap_delta(InstMap, Unify0,
UnifyGoalInfo0, UnifyGoalInfo, !ModeInfo),
Unify = conj(plain_conj,
[InitGoal - InitGoalInfo, Unify0 - UnifyGoalInfo])
@@ -239,21 +239,17 @@
% duplicated there too.
%
(
- % check if variable has a higher-order type
- type_is_higher_order(TypeOfX, Purity, _, EvalMethod,
- PredArgTypes),
+ % Check if variable has a higher-order type.
+ type_is_higher_order(TypeOfX, Purity, _, EvalMethod, PredArgTypes),
ConsId0 = pred_const(ShroudedPredProcId, _)
->
% Convert the pred term to a lambda expression.
mode_info_get_varset(!.ModeInfo, VarSet0),
mode_info_get_context(!.ModeInfo, Context),
- proc(PredId, ProcId) =
- unshroud_pred_proc_id(ShroudedPredProcId),
- convert_pred_to_lambda_goal(Purity, EvalMethod,
- X0, PredId, ProcId, ArgVars0, PredArgTypes,
- UnifyContext, GoalInfo0, Context,
- ModuleInfo0, Functor0,
- VarSet0, VarSet, VarTypes0, VarTypes),
+ proc(PredId, ProcId) = unshroud_pred_proc_id(ShroudedPredProcId),
+ convert_pred_to_lambda_goal(Purity, EvalMethod, X0, PredId, ProcId,
+ ArgVars0, PredArgTypes, UnifyContext, GoalInfo0, Context,
+ ModuleInfo0, Functor0, VarSet0, VarSet, VarTypes0, VarTypes),
mode_info_set_varset(VarSet, !ModeInfo),
mode_info_set_var_types(VarTypes, !ModeInfo),
@@ -310,11 +306,13 @@
mode_info_get_module_info(!.ModeInfo, ModuleInfo0),
mode_info_get_how_to_check(!.ModeInfo, HowToCheckGoal),
- ( HowToCheckGoal = check_modes ->
+ (
+ HowToCheckGoal = check_modes,
% This only needs to be done once.
mode_info_get_types_of_vars(!.ModeInfo, Vars, VarTypes),
propagate_types_into_mode_list(ModuleInfo0, VarTypes, Modes0, Modes)
;
+ HowToCheckGoal = check_unique_modes,
Modes = Modes0
),
@@ -334,7 +332,7 @@
% Lock the non-locals. (A lambda goal is not allowed to bind any of the
% non-local variables, since it could get called more than once, or
- % from inside a negation)
+ % from inside a negation.)
Goal0 = _ - GoalInfo0,
goal_info_get_nonlocals(GoalInfo0, NonLocals0),
set.delete_list(NonLocals0, Vars, NonLocals),
@@ -378,9 +376,11 @@
mode_checkpoint(enter, "lambda goal", !ModeInfo, !IO),
% If we're being called from unique_modes.m, then we need to
% call unique_modes.check_goal rather than modecheck_goal.
- ( HowToCheckGoal = check_unique_modes ->
+ (
+ HowToCheckGoal = check_unique_modes,
unique_modes.check_goal(Goal0, Goal1, !ModeInfo, !IO)
;
+ HowToCheckGoal = check_modes,
modecheck_goal(Goal0, Goal1, !ModeInfo, !IO)
),
mode_list_get_final_insts(ModuleInfo0, Modes, FinalInsts),
@@ -409,12 +409,14 @@
instmap.lookup_var(InstMap1, Var, Inst),
\+ inst_is_ground(ModuleInfo2, Inst)
), NonLocalsList, NonGroundNonLocals),
- ( NonGroundNonLocals = [BadVar | _] ->
+ (
+ NonGroundNonLocals = [BadVar | _],
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")
),
@@ -466,6 +468,7 @@
ModeOfX = (InstOfX -> Inst),
ModeOfY = (InstOfY -> Inst),
Mode = ModeOfX - ModeOfY,
+
% Return any old garbage.
Unification = Unification0,
RHS = RHS0
@@ -514,15 +517,14 @@
% This needs to come after make_complicated_sub_unify because
% make_complicated_sub_unify may introduce new variables
% whose types we need to look-up.
- %
mode_info_get_var_types(!.ModeInfo, VarTypes),
(
% If we are allowed to insert solver type initialisation calls and
% InstOfX0 is free and all ArgVars0 are either non-free or have
% solver types, then we know that this is going to be a construction,
% so we can insert the necessary initialisation calls.
- ArgVars0 \= [],
- HowToCheckGoal \= check_unique_modes,
+ ArgVars0 = [_ | _],
+ HowToCheckGoal = check_modes,
inst_match.inst_is_free(ModuleInfo0, InstOfX),
mode_info_may_initialise_solver_vars(!.ModeInfo),
instmap.lookup_vars(ArgVars0, InstMap0, InstArgs0),
@@ -561,9 +563,9 @@
!ModeInfo),
Inst = not_reached,
Det = erroneous,
- % If we get an error, set the inst to not_reached to avoid
- % cascading errors. But don't call categorize_unification, because
- % that could cause an invalid call to `unify_proc.request_unify'.
+ % If we get an error, set the inst to not_reached to avoid cascading
+ % errors. But don't call categorize_unification, because that could
+ % cause an invalid call to `unify_proc.request_unify'.
ModeOfX = (InstOfX -> Inst),
ModeOfY = (InstOfY -> Inst),
Mode = ModeOfX - ModeOfY,
@@ -575,13 +577,12 @@
ArgVars = ArgVars0,
ExtraGoals2 = no_extra_goals
;
- % XXX We forbid the construction of partially instantiated
- % structures involving solver types. We'd like to forbid all
- % such constructions here, but that causes trouble with the current
- % implementation of term.term_to_univ_special_case which does
- % use partial instantiation (in a rather horrible way). This is
- % a hacky solution that gets us most of what we want w.r.t.
- % solver types.
+ % XXX We forbid the construction of partially instantiated structures
+ % involving solver types. We'd like to forbid all such constructions
+ % here, but that causes trouble with the current implementation of
+ % term.term_to_univ_special_case which does use partial instantiation
+ % (in a rather horrible way). This is a hacky solution that gets us
+ % most of what we want w.r.t. solver types.
not (
inst_is_free(ModuleInfo0, InstOfX),
list.member(InstArg, InstArgs),
@@ -624,16 +625,23 @@
ArgVars0, ArgVars, ExtraGoals2, !ModeInfo),
modecheck_set_var_inst(X, Inst, yes(InstOfY), !ModeInfo),
UnifyArgInsts = list.map(func(I) = yes(I), InstOfXArgs),
+ mode_info_get_in_from_ground_term(!.ModeInfo, InFromGroundTerm),
+ % ZZZ
+ (
+ InFromGroundTerm = yes
+ ;
+ InFromGroundTerm = no,
bind_args(Inst, ArgVars, UnifyArgInsts, !ModeInfo)
+ )
;
set.list_to_set([X | ArgVars0], WaitingVars), % conservative
mode_info_error(WaitingVars,
mode_error_unify_var_functor(X, InstConsId, ArgVars0,
InstOfX, InstArgs),
!ModeInfo),
- % If we get an error, set the inst to not_reached to avoid
- % cascading errors. But don't call categorize_unification, because
- % that could cause an invalid call to `unify_proc.request_unify'.
+ % If we get an error, set the inst to not_reached to avoid cascading
+ % errors. But don't call categorize_unification, because that could
+ % cause an invalid call to `unify_proc.request_unify'.
Inst = not_reached,
Det = erroneous,
ModeOfX = (InstOfX -> Inst),
@@ -702,7 +710,7 @@
append_extra_goals(ExtraGoals01, ExtraGoals2, ExtraGoals),
(
HowToCheckGoal = check_unique_modes,
- ExtraGoals \= no_extra_goals,
+ ExtraGoals = extra_goals(_, _),
instmap.is_reachable(InstMap1)
->
unexpected(this_file,
@@ -716,21 +724,18 @@
).
:- pred all_arg_vars_are_non_free_or_solver_vars(list(prog_var)::in,
- list(mer_inst)::in, vartypes::in, module_info::in,
- list(prog_var)::out) is semidet.
+ list(mer_inst)::in, vartypes::in, module_info::in, list(prog_var)::out)
+ is semidet.
all_arg_vars_are_non_free_or_solver_vars([], [], _, _, []).
-
-all_arg_vars_are_non_free_or_solver_vars([], [_|_], _, _, _) :-
+all_arg_vars_are_non_free_or_solver_vars([], [_ | _], _, _, _) :-
unexpected(this_file,
"modecheck_unify.all_arg_vars_are_non_free_or_solver_vars: " ++
"mismatch in list lengths").
-
-all_arg_vars_are_non_free_or_solver_vars([_|_], [], _, _, _) :-
+all_arg_vars_are_non_free_or_solver_vars([_ | _], [], _, _, _) :-
unexpected(this_file,
"modecheck_unify.all_arg_vars_are_non_free_or_solver_vars: " ++
"mismatch in list lengths").
-
all_arg_vars_are_non_free_or_solver_vars([Arg | Args], [Inst | Insts],
VarTypes, ModuleInfo, ArgsToInit) :-
( inst_match.inst_is_free(ModuleInfo, Inst) ->
@@ -1129,9 +1134,7 @@
RHS0, RHS, Unification0, Unification, !ModeInfo) :-
% If we are re-doing mode analysis, preserve the existing cons_id.
list.length(ArgVars, Arity),
- (
- Unification0 = construct(_, ConsId0, _, _, _, _, SubInfo0)
- ->
+ ( Unification0 = construct(_, ConsIdPrime, _, _, _, _, SubInfo0) ->
(
SubInfo0 = construct_sub_info(MaybeTakeAddr, _MaybeSize),
expect(unify(MaybeTakeAddr, no), this_file,
@@ -1140,12 +1143,10 @@
SubInfo0 = no_construct_sub_info
),
SubInfo = SubInfo0,
- ConsId = ConsId0
- ;
- Unification0 = deconstruct(_, ConsId1, _, _, _, _)
- ->
+ ConsId = ConsIdPrime
+ ; Unification0 = deconstruct(_, ConsIdPrime, _, _, _, _) ->
SubInfo = no_construct_sub_info,
- ConsId = ConsId1
+ ConsId = ConsIdPrime
;
% The real cons_id will be computed by lambda.m;
% we just put in a dummy one for now.
@@ -1153,7 +1154,7 @@
ConsId = cons(unqualified("__LambdaGoal__"), Arity)
),
mode_info_get_module_info(!.ModeInfo, ModuleInfo),
- mode_util.modes_to_uni_modes(ModuleInfo, ArgModes0, ArgModes0, ArgModes),
+ modes_to_uni_modes(ModuleInfo, ArgModes0, ArgModes0, ArgModes),
mode_info_get_instmap(!.ModeInfo, InstMap),
( mode_is_output(ModuleInfo, ModeOfX) ->
(
@@ -1189,7 +1190,7 @@
Unification = construct(X, ConsId, ArgVars, ArgModes,
construct_dynamically, cell_is_unique, SubInfo)
; instmap.is_reachable(InstMap) ->
- % If it's a deconstruction, it is a mode error.
+ % 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.
set.init(WaitingVars),
@@ -1211,7 +1212,7 @@
% between a variable and a functor is - whether it is a construction
% unification or a deconstruction. It also works out whether it will be
% deterministic or semideterministic.
-
+ %
:- pred categorize_unify_var_functor(mer_mode::in, list(mer_mode)::in,
list(mer_mode)::in, prog_var::in, cons_id::in, list(prog_var)::in,
vartypes::in, unify_context::in,
@@ -1224,9 +1225,7 @@
mode_info_get_module_info(!.ModeInfo, ModuleInfo),
map.lookup(VarTypes, X, TypeOfX),
% If we are re-doing mode analysis, preserve the existing cons_id.
- (
- Unification0 = construct(_, ConsId0, _, _, _, _, SubInfo0)
- ->
+ ( Unification0 = construct(_, ConsIdPrime, _, _, _, _, SubInfo0) ->
(
SubInfo0 = construct_sub_info(MaybeTakeAddr, _MaybeSize0),
expect(unify(MaybeTakeAddr, no), this_file,
@@ -1235,20 +1234,17 @@
SubInfo0 = no_construct_sub_info
),
SubInfo = SubInfo0,
- ConsId = ConsId0
- ;
- Unification0 = deconstruct(_, ConsId1, _, _, _, _)
- ->
+ ConsId = ConsIdPrime
+ ; Unification0 = deconstruct(_, ConsIdPrime, _, _, _, _) ->
SubInfo = no_construct_sub_info,
- ConsId = ConsId1
+ ConsId = ConsIdPrime
;
SubInfo = no_construct_sub_info,
ConsId = NewConsId
),
- mode_util.modes_to_uni_modes(ModuleInfo, ModeOfXArgs,
- ArgModes0, ArgModes),
+ modes_to_uni_modes(ModuleInfo, ModeOfXArgs, ArgModes0, ArgModes),
( mode_is_output(ModuleInfo, ModeOfX) ->
- % It's a construction.
+ % It is a construction.
Unification = construct(X, ConsId, ArgVars, ArgModes,
construct_dynamically, cell_is_unique, SubInfo),
@@ -1257,7 +1253,7 @@
check_type_info_args_are_ground(ArgVars, VarTypes,
UnifyContext, !ModeInfo)
;
- % It's a deconstruction.
+ % It is a deconstruction.
(
% If the variable was already known to be bound to a single
% particular functor, then the unification either always succeeds
@@ -1265,8 +1261,7 @@
% `not_reached' or `bound([])'. So if both the initial and final
% inst are `bound([_])', then the unification must be
% deterministic.
- mode_get_insts(ModuleInfo, ModeOfX,
- InitialInst0, FinalInst0),
+ mode_get_insts(ModuleInfo, ModeOfX, InitialInst0, FinalInst0),
inst_expand(ModuleInfo, InitialInst0, InitialInst),
inst_expand(ModuleInfo, FinalInst0, FinalInst),
InitialInst = bound(_, [_]),
Index: compiler/modes.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/modes.m,v
retrieving revision 1.328
diff -u -b -r1.328 modes.m
--- compiler/modes.m 24 Mar 2006 03:03:56 -0000 1.328
+++ compiler/modes.m 24 Mar 2006 14:44:40 -0000
@@ -1320,7 +1320,7 @@
modecheck_par_conj_list(Goals0, Goals, NonLocals, InstMapNonlocalList,
!ModeInfo, !IO),
Goal = conj(parallel_conj, Goals),
- instmap.unify(NonLocals, InstMapNonlocalList, !ModeInfo),
+ instmap_unify(NonLocals, InstMapNonlocalList, !ModeInfo),
mode_checkpoint(exit, "par_conj", !ModeInfo, !IO)
).
@@ -1342,7 +1342,7 @@
handle_solver_vars_in_disjs(set.to_sorted_list(NonLocals),
VarTypes, Disjs1, Disjs2, InstMapList0, InstMapList, !ModeInfo),
Disjs = flatten_disjs(Disjs2),
- instmap.merge(NonLocals, InstMapList, disj, !ModeInfo),
+ instmap_merge(NonLocals, InstMapList, disj, !ModeInfo),
disj_list_to_goal(Disjs, GoalInfo0, Goal - _GoalInfo)
),
mode_checkpoint(exit, "disj", !ModeInfo, !IO).
@@ -1381,13 +1381,11 @@
Then1, Then, Else1, Else,
InstMapThen1, InstMapThen, InstMapElse1, InstMapElse, !ModeInfo),
mode_info_set_instmap(InstMap0, !ModeInfo),
- instmap.merge(NonLocals, [InstMapThen, InstMapElse], if_then_else,
+ instmap_merge(NonLocals, [InstMapThen, InstMapElse], if_then_else,
!ModeInfo),
Goal = if_then_else(Vars, Cond, Then, Else),
mode_info_get_instmap(!.ModeInfo, InstMap),
- (
- mode_info_get_in_promise_purity_scope(!.ModeInfo, no)
- ->
+ ( mode_info_get_in_promise_purity_scope(!.ModeInfo, no) ->
goal_get_nonlocals(Cond, CondNonLocals0),
CondNonLocals =
set.to_sorted_list(CondNonLocals0 `intersect` NonLocals),
@@ -1423,9 +1421,7 @@
mode_info_set_live_vars(LiveVars0, !ModeInfo),
mode_info_unlock_vars(negation, NonLocals, !ModeInfo),
mode_info_set_instmap(InstMap0, !ModeInfo),
- (
- mode_info_get_in_promise_purity_scope(!.ModeInfo, no)
- ->
+ ( mode_info_get_in_promise_purity_scope(!.ModeInfo, no) ->
goal_info_get_nonlocals(GoalInfo0, NegNonLocals),
instmap.init_unreachable(Unreachable),
check_no_inst_any_vars(negation, set.to_sorted_list(NegNonLocals),
@@ -1439,20 +1435,17 @@
!ModeInfo, !IO) :-
( Reason = from_ground_term(TermVar) ->
% The original goal does no quantification, so deleting the `scope'
- % is OK, and it is necessary for avoiding bad performance in
- % later compiler phases, such as simplification. This deletion
- % undoes the insertion done in the base case of unravel_unification
- % in superhomogeneous.m.
+ % 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 = conj(plain_conj, [UnifyTermGoal | UnifyArgGoals])
- SubGoalInfo,
- % If TermVar 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.
+ % 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 = unify(TermVar, _, _, _, _) - _
->
% UnifyTerm unifies TermVar with the arguments created
@@ -1461,22 +1454,26 @@
% UnifyTerm cannot succeed until *after* the argument
% variables become ground.
%
- % Putting UnifyTerm after UnifyArgs here is much more
- % efficient than letting the usual more ordering
- % algorithm delay it repeatedly.
+ % Putting UnifyTerm after UnifyArgs here is much more efficient
+ % than letting the usual more ordering algorithm delay it
+ % repeatedly: it is linear instead of quadratic.
list.reverse([UnifyTermGoal | UnifyArgGoals], RevConj),
RevSubGoal0 = conj(plain_conj, RevConj) - SubGoalInfo,
+ mode_info_get_in_from_ground_term(!.ModeInfo, WasInFromGroundTerm),
+ mode_info_set_in_from_ground_term(yes, !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),
- SubGoal = GoalExpr - _
+ GoalExpr = scope(Reason, SubGoal)
;
mode_checkpoint(enter, "scope", !ModeInfo, !IO),
modecheck_goal(SubGoal0, SubGoal, !ModeInfo, !IO),
mode_checkpoint(exit, "scope", !ModeInfo, !IO),
- SubGoal = GoalExpr - _
+
+ GoalExpr = scope(Reason, SubGoal)
)
; Reason = promise_purity(_Implicit, _Purity) ->
mode_info_get_in_promise_purity_scope(!.ModeInfo, InPPScope),
@@ -1609,7 +1606,7 @@
goal_info_get_nonlocals(GoalInfo0, NonLocals),
modecheck_case_list(Cases0, Var, Cases, InstMapList,
!ModeInfo, !IO),
- instmap.merge(NonLocals, InstMapList, disj, !ModeInfo)
+ instmap_merge(NonLocals, InstMapList, disj, !ModeInfo)
),
mode_checkpoint(exit, "switch", !ModeInfo, !IO).
@@ -1644,7 +1641,6 @@
% these should have been expanded out by now
unexpected(this_file, "modecheck_goal_expr: unexpected shorthand").
-
% If the condition of a negation or if-then-else contains any inst any
% non-locals (a potential referential transparency violation)
% we need to check that the programmer has recognised the
@@ -2067,11 +2063,11 @@
list(hlds_goal)::out, impurity_errors::in, impurity_errors::out,
mode_info::in, mode_info::out, io::di, io::uo) is det.
- % Schedule a conjunction. If it's empty, then there is nothing to do.
- % For non-empty conjunctions, we attempt to schedule the first
- % goal in the conjunction. If successful, we wakeup a newly
- % pending goal (if any), and if not, we delay the goal. Then we
- % continue attempting to schedule all the rest of the goals.
+ % Schedule a conjunction. If it is empty, then there is nothing to do.
+ % For non-empty conjunctions, we attempt to schedule the first goal
+ % in the conjunction. If successful, we wakeup a newly pending goal
+ % (if any), and if not, we delay the goal. Then we continue attempting
+ % to schedule all the rest of the goals.
%
modecheck_conj_list_3(Goal0, Goals0, Goals, !ImpurityErrors, !ModeInfo, !IO) :-
Goal0 = _GoalExpr - GoalInfo0,
@@ -2084,7 +2080,7 @@
ScheduledSolverGoals = []
),
- % Hang onto the original instmap, delay_info, and live_vars
+ % Hang onto the original instmap, delay_info, and live_vars.
mode_info_get_instmap(!.ModeInfo, InstMap0),
mode_info_get_delay_info(!.ModeInfo, DelayInfo0),
@@ -2141,10 +2137,9 @@
mode_info_set_delay_info(DelayInfo, !ModeInfo),
mode_info_get_instmap(!.ModeInfo, 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.
+ % 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.
mode_info_remove_goals_live_vars(Goals1, !ModeInfo),
Goals2 = []
;
@@ -2182,8 +2177,7 @@
!ImpurityErrors, !ModeInfo, !IO) :-
% Try to handle any unscheduled goals by inserting solver
- % initialisation calls, aiming for a deterministic
- % schedule.
+ % initialisation calls, aiming for a deterministic schedule.
%
modecheck_delayed_goals_try_det(DelayedGoals0, DelayedGoals1, Goals0,
!ImpurityErrors, !ModeInfo, !IO),
@@ -2231,28 +2225,22 @@
modecheck_delayed_goals_try_det(DelayedGoals0, DelayedGoals, Goals,
!ImpurityErrors, !ModeInfo, !IO) :-
(
- % There are no unscheduled goals, so we don't
- % need to do anything.
- %
+ % There are no unscheduled goals, so we don't need to do anything.
+
DelayedGoals0 = [],
DelayedGoals = [],
Goals = []
;
- % There are some unscheduled goals. See if
- % allowing extra initialisation calls (for
- % a single goal) makes a difference.
- %
- DelayedGoals0 = [_ | _],
+ % There are some unscheduled goals. See if allowing extra
+ % initialisation calls (for a single goal) makes a difference.
+ DelayedGoals0 = [_ | _],
(
- % Extract the HLDS goals from the delayed
- % goals.
- %
+ % Extract the HLDS goals from the delayed goals.
Goals0 = list.map(hlds_goal_from_delayed_goal, DelayedGoals0),
- % Work out which vars are already
- % instantiated (i.e. have non-free insts).
- %
+ % 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),
NonFreeVars0 = set.list_to_set(
@@ -2260,16 +2248,13 @@
% Find the set of vars whose instantiation should lead to
% a deterministic schedule.
- %
promise_equivalent_solutions [CandidateInitVars] (
candidate_init_vars(!.ModeInfo, Goals0, NonFreeVars0,
CandidateInitVars)
),
- % And verify that all of these vars are
- % solver type vars (and can therefore be
- % initialised.)
- %
+ % And verify that all of these vars are solver type vars
+ % (and can therefore be initialised.)
mode_info_get_module_info(!.ModeInfo, ModuleInfo),
mode_info_get_var_types(!.ModeInfo, VarTypes),
all [Var] (
@@ -2283,7 +2268,6 @@
->
% Construct the inferred initialisation goals
% and try scheduling again.
- %
CandidateInitVarList = set.to_sorted_list(CandidateInitVars),
construct_initialisation_calls(CandidateInitVarList,
InitGoals, !ModeInfo),
@@ -2328,7 +2312,11 @@
non_free_vars_in_assoc_list([]) = [].
non_free_vars_in_assoc_list([Var - Inst | AssocList]) =
- ( ( Inst = free ; Inst = free(_) ) ->
+ (
+ ( Inst = free
+ ; Inst = free(_)
+ )
+ ->
non_free_vars_in_assoc_list(AssocList)
;
[Var | non_free_vars_in_assoc_list(AssocList)]
@@ -2373,15 +2361,15 @@
set.member(X, !.NonFree)
->
not set.member(Y, !.NonFree),
- % It's an assignment from X to Y.
+ % It is an assignment from X to Y.
!:NonFree = set.insert(!.NonFree, Y)
;
set.member(Y, !.NonFree)
->
- % It's an assignment from Y to X.
+ % It is an assignment from Y to X.
!:NonFree = set.insert(!.NonFree, X)
;
- % It's an assignment one way or the other.
+ % It is an assignment one way or the other.
(
!:NonFree = set.insert(!.NonFree, X),
!:CandidateVars = set.insert(!.CandidateVars, Y)
Index: compiler/pd_debug.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/pd_debug.m,v
retrieving revision 1.18
diff -u -b -r1.18 pd_debug.m
--- compiler/pd_debug.m 24 Mar 2006 03:03:58 -0000 1.18
+++ compiler/pd_debug.m 24 Mar 2006 06:33:19 -0000
@@ -146,7 +146,7 @@
goal_info_get_nonlocals(GoalInfo, NonLocals),
module_info_pred_proc_info(ModuleInfo, PredId, ProcId, _, ProcInfo),
proc_info_varset(ProcInfo, VarSet),
- instmap.restrict(NonLocals, InstMap, InstMap1),
+ instmap_restrict(NonLocals, InstMap, InstMap1),
io.write_string(" args: ", !IO),
mercury_output_vars(Args, VarSet, yes, !IO),
io.nl(!IO),
@@ -214,7 +214,7 @@
pd_info_get_module_info(PDInfo, ModuleInfo),
io.write_string(Msg, !IO),
goal_util.goal_vars(GoalExpr - GoalInfo, Vars),
- instmap.restrict(Vars, InstMap, InstMap1),
+ instmap_restrict(Vars, InstMap, InstMap1),
hlds_out.write_instmap(InstMap1, VarSet, yes, 1, !IO),
io.nl(!IO),
hlds_out.write_goal(GoalExpr - GoalInfo, ModuleInfo, VarSet,
Index: compiler/pd_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/pd_util.m,v
retrieving revision 1.49
diff -u -b -r1.49 pd_util.m
--- compiler/pd_util.m 21 Mar 2006 22:25:27 -0000 1.49
+++ compiler/pd_util.m 25 Mar 2006 13:57:05 -0000
@@ -45,7 +45,7 @@
% Apply simplify.m to the goal.
%
-:- pred simplify_goal(list(simplification)::in, hlds_goal::in,
+:- pred simplify_goal(simplifications::in, hlds_goal::in,
hlds_goal::out, pd_info::in, pd_info::out, io::di, io::uo) is det.
% Apply unique_modes.m to the goal.
@@ -120,8 +120,7 @@
% expanded inst_name.
%
:- pred inst_size(module_info::in, mer_inst::in, int::out) is det.
-:- pred inst_list_size(module_info::in, list(mer_inst)::in,
- int::out) is det.
+:- pred inst_list_size(module_info::in, list(mer_inst)::in, int::out) is det.
% goals_match(ModuleInfo, OldGoal, OldArgs, OldArgTypes,
% NewGoal, NewArgTypes, OldToNewVarRenaming, OldToNewTypeSubst):
@@ -255,7 +254,7 @@
simplify_info_init(DetInfo0, Simplifications, InstMap0, ProcInfo0,
SimplifyInfo0),
- simplify.process_goal(Goal0, Goal, SimplifyInfo0, SimplifyInfo, !IO),
+ simplify_process_goal(Goal0, Goal, SimplifyInfo0, SimplifyInfo, !IO),
% Deconstruct the simplify_info.
simplify_info_get_module_info(SimplifyInfo, ModuleInfo),
Index: compiler/quantification.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/quantification.m,v
retrieving revision 1.102
diff -u -b -r1.102 quantification.m
--- compiler/quantification.m 17 Mar 2006 01:40:38 -0000 1.102
+++ compiler/quantification.m 25 Mar 2006 16:04:40 -0000
@@ -104,18 +104,13 @@
:- type quant_warning
---> warn_overlap(list(prog_var), prog_context).
- % goal_vars(NonLocalsToRecompute, Goal, Vars):
+ % free_goal_vars(Goal) = Vars:
%
- % Vars is the set of variables that occur free (unquantified)
- % in Goal, excluding unset fields of reconstructions if
+ % Vars is the set of variables that occur free (unquantified) in Goal
+ % excluding unset fields of reconstructions if
% NonLocalsToRecompute is `code_gen_nonlocals'.
%
-:- pred goal_vars(nonlocals_to_recompute::in, hlds_goal::in,
- set(prog_var)::out) is det.
-
- % As above, with `ordinary_nonlocals' passed as the first argument.
- %
-:- pred goal_vars(hlds_goal::in, set(prog_var)::out) is det.
+:- func free_goal_vars(hlds_goal) = set(prog_var).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -129,6 +124,7 @@
:- import_module bool.
:- import_module enum.
:- import_module map.
+:- import_module require.
:- import_module sparse_bitset.
:- import_module std_util.
:- import_module term.
@@ -193,6 +189,9 @@
% OutsideVars will be [X] and QuantifiedVars will be [],
% since the quantification can't be pushed inside the negation.
+:- inst ordinary_nonlocals ---> ordinary_nonlocals.
+:- inst code_gen_nonlocals ---> code_gen_nonlocals.
+
%-----------------------------------------------------------------------------%
implicitly_quantify_clause_body(HeadVars, Warnings,
@@ -268,7 +267,8 @@
(
% 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 - GoalInfo0, GoalVars0),
+ goal_vars_bitset_choose(NonLocalsToRecompute, Goal0 - GoalInfo0,
+ GoalVars0),
difference(GoalVars0, NonLocalVars, LocalVars),
intersect(SeenVars, LocalVars, RenameVars),
\+ empty(RenameVars)
@@ -442,7 +442,8 @@
),
insert_list(QuantVars, Vars, QuantVars1),
get_nonlocals_to_recompute(!.Info, NonLocalsToRecompute),
- goal_vars(NonLocalsToRecompute, Then1, VarsThen, LambdaVarsThen),
+ goal_vars_both_choose(NonLocalsToRecompute, Then1,
+ VarsThen, LambdaVarsThen),
union(OutsideVars, VarsThen, OutsideVars1),
union(LambdaOutsideVars, LambdaVarsThen, LambdaOutsideVars1),
set_quant_vars(QuantVars1, !Info),
@@ -566,7 +567,8 @@
% Prepare for quantifying the LHS: add variables from the RHS to the
% outside vars and the outside lambda vars sets.
get_nonlocals_to_recompute(!.Info, NonLocalsToRecompute),
- goal_vars(NonLocalsToRecompute, RHS0, RHS_Vars, RHS_LambdaVars),
+ goal_vars_both_choose(NonLocalsToRecompute, RHS0,
+ RHS_Vars, RHS_LambdaVars),
union(OutsideVars1, RHS_Vars, LHS_OutsideVars),
union(LambdaOutsideVars1, RHS_LambdaVars, LHS_LambdaOutsideVars),
@@ -621,7 +623,8 @@
% Rename apart the local variables of the goals we've just duplicated.
ReverseImplication0 = not(conj(plain_conj, [RHS, NotLHS]) - GI) - GI,
- goal_vars_bitset(NonLocalsToRecompute, ReverseImplication0, GoalVars),
+ goal_vars_bitset_choose(NonLocalsToRecompute, ReverseImplication0,
+ GoalVars),
difference(GoalVars, NonLocalVars, RenameVars),
rename_apart(RenameVars, _, ReverseImplication0, ReverseImplication,
!Info),
@@ -772,7 +775,7 @@
implicitly_quantify_conj(!Goals, !Info) :-
get_nonlocals_to_recompute(!.Info, NonLocalsToRecompute),
- get_vars(NonLocalsToRecompute, !.Goals, FollowingVarsList),
+ get_vars_choose(NonLocalsToRecompute, !.Goals, FollowingVarsList),
implicitly_quantify_conj_2(FollowingVarsList, !Goals, !Info).
:- pred implicitly_quantify_conj_2(list(pair(set_of_var))::in,
@@ -857,16 +860,32 @@
% contains following variables that occur not in lambda goals, and the
% second contains following variables that occur in lambda goals.
%
-:- pred get_vars(nonlocals_to_recompute::in, list(hlds_goal)::in,
+:- pred get_vars_choose(nonlocals_to_recompute::in, list(hlds_goal)::in,
list(pair(set_of_var))::out) is det.
+get_vars_choose(NonLocalsToRecompute, Goals, Pairs) :-
+ (
+ NonLocalsToRecompute = ordinary_nonlocals,
+ get_vars(ordinary_nonlocals, Goals, Pairs)
+ ;
+ NonLocalsToRecompute = code_gen_nonlocals,
+ get_vars(code_gen_nonlocals, Goals, Pairs)
+ ).
+
+:- pred get_vars(nonlocals_to_recompute, list(hlds_goal),
+ list(pair(set_of_var))).
+:- mode get_vars(in(ordinary_nonlocals), in, out) is det.
+:- mode get_vars(in(code_gen_nonlocals), in, out) is det.
+
get_vars(_, [], []).
get_vars(NonLocalsToRecompute, [_Goal | Goals],
[Set - LambdaSet | SetPairs]) :-
get_vars_2(NonLocalsToRecompute, Goals, Set, LambdaSet, SetPairs).
-:- pred get_vars_2(nonlocals_to_recompute::in, list(hlds_goal)::in,
- set_of_var::out, set_of_var::out, list(pair(set_of_var))::out) is det.
+:- pred get_vars_2(nonlocals_to_recompute, list(hlds_goal),
+ set_of_var, set_of_var, list(pair(set_of_var))).
+:- mode get_vars_2(in(ordinary_nonlocals), in, out, out, out) is det.
+:- mode get_vars_2(in(code_gen_nonlocals), in, out, out, out) is det.
get_vars_2(_, [], Set, LambdaSet, []) :-
init(Set),
@@ -874,60 +893,199 @@
get_vars_2(NonLocalsToRecompute, [Goal | Goals], Set, LambdaSet,
SetPairList) :-
get_vars_2(NonLocalsToRecompute, Goals, Set0, LambdaSet0, SetPairList0),
- goal_vars(NonLocalsToRecompute, Goal, Set1, LambdaSet1),
+ goal_vars_both(NonLocalsToRecompute, Goal, Set1, LambdaSet1),
union(Set0, Set1, Set),
union(LambdaSet0, LambdaSet1, LambdaSet),
SetPairList = [Set0 - LambdaSet0 | SetPairList0].
-:- pred goal_list_vars_2(nonlocals_to_recompute::in, list(hlds_goal)::in,
- set_of_var::in, set_of_var::out, set_of_var::in, set_of_var::out) is det.
+:- pred conj_vars(nonlocals_to_recompute, list(hlds_goal),
+ set_of_var, set_of_var, set_of_var, set_of_var).
+:- mode conj_vars(in(ordinary_nonlocals), in, in, out, in, out) is det.
+:- mode conj_vars(in(code_gen_nonlocals), in, in, out, in, out) is det.
-goal_list_vars_2(_, [], !Set, !LambdaSet).
-goal_list_vars_2(NonLocalsToRecompute, [Goal - _GoalInfo| Goals],
- !Set, !LambdaSet) :-
+conj_vars(_, [], !Set, !LambdaSet).
+conj_vars(NonLocalsToRecompute, [Goal - _GoalInfo| Goals], !Set, !LambdaSet) :-
goal_vars_2(NonLocalsToRecompute, Goal, !Set, !LambdaSet),
- goal_list_vars_2(NonLocalsToRecompute, Goals, !Set, !LambdaSet).
+ conj_vars(NonLocalsToRecompute, Goals, !Set, !LambdaSet).
-:- pred case_list_vars_2(nonlocals_to_recompute::in, list(case)::in,
- set_of_var::in, set_of_var::out, set_of_var::in, set_of_var::out) is det.
+:- pred disj_vars(nonlocals_to_recompute, list(hlds_goal),
+ set_of_var, set_of_var, set_of_var, set_of_var).
+:- mode disj_vars(in(ordinary_nonlocals), in, in, out, in, out) is det.
+:- mode disj_vars(in(code_gen_nonlocals), in, in, out, in, out) is det.
+
+disj_vars(NonLocalsToRecompute, Goals, !Set, !LambdaSet) :-
+ compute_disj_vars(NonLocalsToRecompute, Goals,
+ [], GoalSets, [], GoalLambdaSets),
+ (
+ GoalSets = [],
+ init(GoalsSet)
+ ;
+ GoalSets = [_ | _],
+ union_list(GoalSets, GoalsSet)
+ ),
+ (
+ GoalLambdaSets = [],
+ init(GoalsLambdaSet)
+ ;
+ GoalLambdaSets = [_ | _],
+ union_list(GoalLambdaSets, GoalsLambdaSet)
+ ),
+ union(GoalsSet, !Set),
+ union(GoalsLambdaSet, !LambdaSet).
-case_list_vars_2(_, [], !Set, !LambdaSet).
-case_list_vars_2(NonLocalsToRecompute, [case(_Cons, Goal - _GoalInfo) | Cases],
- !Set, !LambdaSet) :-
- goal_vars_2(NonLocalsToRecompute, Goal, !Set, !LambdaSet),
- case_list_vars_2(NonLocalsToRecompute, Cases, !Set, !LambdaSet).
+:- pred compute_disj_vars(nonlocals_to_recompute, list(hlds_goal),
+ list(set_of_var), list(set_of_var), list(set_of_var), list(set_of_var)).
+:- mode compute_disj_vars(in(ordinary_nonlocals), in, in, out, in, out) is det.
+:- mode compute_disj_vars(in(code_gen_nonlocals), in, in, out, in, out) is det.
+
+compute_disj_vars(_, [], !Sets, !LambdaSets).
+compute_disj_vars(NonLocalsToRecompute, [Goal | Goals], !Sets, !LambdaSets) :-
+ init(EmptySet),
+ init(EmptyLambdaSet),
+ Goal = GoalExpr - _,
+ goal_vars_2(NonLocalsToRecompute, GoalExpr,
+ EmptySet, GoalSet, EmptyLambdaSet, GoalLambdaSet),
+ !:Sets = [GoalSet | !.Sets],
+ !:LambdaSets = [GoalLambdaSet | !.LambdaSets],
+ compute_disj_vars(NonLocalsToRecompute, Goals, !Sets, !LambdaSets).
+
+:- pred case_vars(nonlocals_to_recompute, list(case),
+ set_of_var, set_of_var, set_of_var, set_of_var).
+:- mode case_vars(in(ordinary_nonlocals), in, in, out, in, out) is det.
+:- mode case_vars(in(code_gen_nonlocals), in, in, out, in, out) is det.
+
+case_vars(NonLocalsToRecompute, Cases, !Set, !LambdaSet) :-
+ compute_case_vars(NonLocalsToRecompute, Cases,
+ [], CaseSets, [], CaseLambdaSets),
+ (
+ CaseSets = [],
+ error("case_vars: no cases")
+ ;
+ CaseSets = [_ | _],
+ union_list(CaseSets, CasesSet)
+ ),
+ (
+ CaseLambdaSets = [],
+ error("case_vars: no cases")
+ ;
+ CaseLambdaSets = [_ | _],
+ union_list(CaseLambdaSets, CasesLambdaSet)
+ ),
+ union(CasesSet, !Set),
+ union(CasesLambdaSet, !LambdaSet).
-goal_vars(NonLocalsToRecompute, Goal, bitset_to_set(BothSet)) :-
- goal_vars_bitset(NonLocalsToRecompute, Goal, BothSet).
+:- pred compute_case_vars(nonlocals_to_recompute, list(case),
+ list(set_of_var), list(set_of_var), list(set_of_var), list(set_of_var)).
+:- mode compute_case_vars(in(ordinary_nonlocals), in, in, out, in, out) is det.
+:- mode compute_case_vars(in(code_gen_nonlocals), in, in, out, in, out) is det.
+
+compute_case_vars(_, [], !Sets, !LambdaSets).
+compute_case_vars(NonLocalsToRecompute, [Case | Cases], !Sets, !LambdaSets) :-
+ Case = case(_Cons, Goal - _GoalInfo),
+ init(EmptySet),
+ init(EmptyLambdaSet),
+ goal_vars_2(NonLocalsToRecompute, Goal,
+ EmptySet, GoalSet, EmptyLambdaSet, GoalLambdaSet),
+ !:Sets = [GoalSet | !.Sets],
+ !:LambdaSets = [GoalLambdaSet | !.LambdaSets],
+ compute_case_vars(NonLocalsToRecompute, Cases, !Sets, !LambdaSets).
-goal_vars(Goal, BothSet) :-
- goal_vars(ordinary_nonlocals, Goal, BothSet).
+:- pred union_list(list(set_of_var)::in, set_of_var::out) is det.
-:- pred goal_vars_bitset(nonlocals_to_recompute::in, hlds_goal::in,
+union_list(Sets, Union) :-
+ (
+ Sets = [],
+ init(Union)
+ ;
+ Sets = [_ | _],
+ union_list_pass(Sets, [], MergedSets),
+ ( MergedSets = [Set] ->
+ Union = Set
+ ;
+ union_list(MergedSets, Union)
+ )
+ ).
+
+:- pred union_list_pass(list(set_of_var)::in,
+ list(set_of_var)::in, list(set_of_var)::out) is det.
+
+union_list_pass([], !MergedSets).
+union_list_pass([Set], !MergedSets) :-
+ !:MergedSets = [Set | !.MergedSets].
+union_list_pass([Set1, Set2 | Sets], !MergedSets) :-
+ union(Set1, Set2, Set12),
+ !:MergedSets = [Set12 | !.MergedSets],
+ union_list_pass(Sets, !MergedSets).
+
+free_goal_vars(Goal) =
+ free_goal_vars_nl(ordinary_nonlocals, Goal).
+
+ % free_goal_vars_nl(NonLocalsToRecompute, Goal) = Vars:
+ %
+ % Vars is the set of variables that occur free (unquantified) in Goal,
+ % excluding unset fields of reconstructions if NonLocalsToRecompute
+ % is `code_gen_nonlocals'.
+ %
+:- func free_goal_vars_nl(nonlocals_to_recompute, hlds_goal) = set(prog_var).
+:- mode free_goal_vars_nl(in(ordinary_nonlocals), in) = out is det.
+:- mode free_goal_vars_nl(in(code_gen_nonlocals), in) = out is det.
+
+free_goal_vars_nl(NonLocalsToRecompute, Goal) = bitset_to_set(BothSet) :-
+ goal_vars_bitset(NonLocalsToRecompute, Goal, BothSet).
+
+:- pred goal_vars_bitset_choose(nonlocals_to_recompute::in, hlds_goal::in,
set_of_var::out) is det.
+goal_vars_bitset_choose(NonLocalsToRecompute, Goal, BothSet) :-
+ (
+ NonLocalsToRecompute = ordinary_nonlocals,
+ goal_vars_bitset(ordinary_nonlocals, Goal, BothSet)
+ ;
+ NonLocalsToRecompute = code_gen_nonlocals,
+ goal_vars_bitset(code_gen_nonlocals, Goal, BothSet)
+ ).
+
+:- pred goal_vars_bitset(nonlocals_to_recompute, hlds_goal, set_of_var).
+:- mode goal_vars_bitset(in(ordinary_nonlocals), in, out) is det.
+:- mode goal_vars_bitset(in(code_gen_nonlocals), in, out) is det.
+
goal_vars_bitset(NonLocalsToRecompute, Goal, BothSet) :-
- goal_vars(NonLocalsToRecompute, Goal, Set, LambdaSet),
+ goal_vars_both(NonLocalsToRecompute, Goal, Set, LambdaSet),
BothSet = union(Set, LambdaSet).
- % goal_vars(Goal, NonLambdaSet, LambdaSet):
+:- pred goal_vars_both_choose(nonlocals_to_recompute::in, hlds_goal::in,
+ set_of_var::out, set_of_var::out) is det.
+
+goal_vars_both_choose(NonLocalsToRecompute, Goal, Set, LambdaSet) :-
+ (
+ NonLocalsToRecompute = ordinary_nonlocals,
+ goal_vars_both(ordinary_nonlocals, Goal, Set, LambdaSet)
+ ;
+ NonLocalsToRecompute = code_gen_nonlocals,
+ goal_vars_both(code_gen_nonlocals, Goal, Set, 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
% of variables that occur free (unquantified) in lambda expressions
% in Goal.
%
-:- pred goal_vars(nonlocals_to_recompute::in, hlds_goal::in,
- set_of_var::out, set_of_var::out) is det.
+:- pred goal_vars_both(nonlocals_to_recompute, hlds_goal,
+ set_of_var, set_of_var).
+:- 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(NonLocalsToRecompute, Goal - _GoalInfo, Set, LambdaSet) :-
+goal_vars_both(NonLocalsToRecompute, Goal - _GoalInfo, Set, LambdaSet) :-
init(Set0),
init(LambdaSet0),
goal_vars_2(NonLocalsToRecompute, Goal, Set0, Set, LambdaSet0, LambdaSet).
-:- pred goal_vars_2(nonlocals_to_recompute::in, hlds_goal_expr::in,
- set_of_var::in, set_of_var::out,
- set_of_var::in, set_of_var::out) is det.
+:- pred goal_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.
goal_vars_2(NonLocalsToRecompute, unify(LHS, RHS, _, Unification, _),
!Set, !LambdaSet) :-
@@ -969,19 +1127,19 @@
;
ConjType = parallel_conj
),
- goal_list_vars_2(NonLocalsToRecompute, Goals, !Set, !LambdaSet).
+ conj_vars(NonLocalsToRecompute, Goals, !Set, !LambdaSet).
goal_vars_2(NonLocalsToRecompute, disj(Goals), !Set, !LambdaSet) :-
- goal_list_vars_2(NonLocalsToRecompute, Goals, !Set, !LambdaSet).
+ disj_vars(NonLocalsToRecompute, Goals, !Set, !LambdaSet).
goal_vars_2(NonLocalsToRecompute, switch(Var, _Det, Cases), !Set,
!LambdaSet) :-
insert(!.Set, Var, !:Set),
- case_list_vars_2(NonLocalsToRecompute, Cases, !Set, !LambdaSet).
+ case_vars(NonLocalsToRecompute, Cases, !Set, !LambdaSet).
goal_vars_2(NonLocalsToRecompute, scope(Reason, Goal), Set0, !:Set,
LambdaSet0, !:LambdaSet) :-
- goal_vars(NonLocalsToRecompute, Goal, !:Set, !:LambdaSet),
+ goal_vars_both(NonLocalsToRecompute, Goal, !:Set, !:LambdaSet),
(
Reason = exist_quant(Vars),
delete_list(!.Set, Vars, !:Set),
@@ -1009,9 +1167,9 @@
% This code does the following:
% !:Set = !.Set + ( (vars(Cond) + vars(Then)) \ Vars ) + vars(Else)
% where `+' is set union and `\' is relative complement.
- goal_vars(NonLocalsToRecompute, Cond, CondSet, CondLambdaSet),
- goal_vars(NonLocalsToRecompute, Then, ThenSet, ThenLambdaSet),
- goal_vars(NonLocalsToRecompute, Else, ElseSet, ElseLambdaSet),
+ goal_vars_both(NonLocalsToRecompute, Cond, CondSet, CondLambdaSet),
+ goal_vars_both(NonLocalsToRecompute, Then, ThenSet, ThenLambdaSet),
+ goal_vars_both(NonLocalsToRecompute, Else, ElseSet, ElseLambdaSet),
union(CondSet, ThenSet, CondThenSet),
union(CondLambdaSet, ThenLambdaSet, CondThenLambdaSet),
delete_list(CondThenSet, Vars, SomeCondThenSet),
@@ -1032,17 +1190,23 @@
goal_vars_2_shorthand(NonLocalsToRecompute, ShorthandGoal, !Set,
!LambdaSet).
-:- pred goal_vars_2_shorthand(nonlocals_to_recompute::in,
- shorthand_goal_expr::in, set_of_var::in, set_of_var::out,
- set_of_var::in, set_of_var::out) is det.
+:- pred goal_vars_2_shorthand(nonlocals_to_recompute, shorthand_goal_expr,
+ set_of_var, set_of_var, set_of_var, set_of_var).
+:- mode goal_vars_2_shorthand(in(ordinary_nonlocals), in, in, out, in, out)
+ is det.
+:- mode goal_vars_2_shorthand(in(code_gen_nonlocals), in, in, out, in, out)
+ is det.
goal_vars_2_shorthand(NonLocalsToRecompute, bi_implication(LHS, RHS), !Set,
!LambdaSet) :-
- goal_list_vars_2(NonLocalsToRecompute, [LHS, RHS], !Set, !LambdaSet).
+ conj_vars(NonLocalsToRecompute, [LHS, RHS], !Set, !LambdaSet).
-:- pred unify_rhs_vars(nonlocals_to_recompute::in, unify_rhs::in,
- maybe(list(bool))::in, set_of_var::in, set_of_var::out,
- set_of_var::in, set_of_var::out) is det.
+:- pred unify_rhs_vars(nonlocals_to_recompute, unify_rhs, maybe(list(bool)),
+ set_of_var, set_of_var, set_of_var, set_of_var).
+:- mode unify_rhs_vars(in(ordinary_nonlocals), in, in, in, out, in, out)
+ is det.
+:- mode unify_rhs_vars(in(code_gen_nonlocals), in, in, in, out, in, out)
+ is det.
unify_rhs_vars(_, var(Y), _, !Set, !LambdaSet) :-
insert(!.Set, Y, !:Set).
Index: compiler/simplify.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/simplify.m,v
retrieving revision 1.171
diff -u -b -r1.171 simplify.m
--- compiler/simplify.m 24 Mar 2006 03:04:02 -0000 1.171
+++ compiler/simplify.m 25 Mar 2006 13:59:00 -0000
@@ -47,27 +47,27 @@
%-----------------------------------------------------------------------------%
-:- pred simplify_pred(list(simplification)::in, pred_id::in,
+:- pred simplify_pred(simplifications::in, pred_id::in,
module_info::in, module_info::out, pred_info::in, pred_info::out,
int::out, int::out, io::di, io::uo) is det.
-:- pred simplify_proc(list(simplification)::in, pred_id::in, proc_id::in,
+:- pred simplify_proc(simplifications::in, pred_id::in, proc_id::in,
module_info::in, module_info::out, proc_info::in, proc_info::out,
io::di, io::uo) is det.
-:- pred simplify_proc_return_msgs(list(simplification)::in, pred_id::in,
+:- pred simplify_proc_return_msgs(simplifications::in, pred_id::in,
proc_id::in, module_info::in, module_info::out,
proc_info::in, proc_info::out, set(context_det_msg)::out,
io::di, io::uo) is det.
-:- pred process_goal(hlds_goal::in, hlds_goal::out,
+:- pred simplify_process_goal(hlds_goal::in, hlds_goal::out,
simplify_info::in, simplify_info::out, io::di, io::uo) is det.
% Find out which simplifications should be run from the options table
% stored in the globals. The first argument states whether warnings
% should be issued during this pass of simplification.
%
-:- pred find_simplifications(bool::in, globals::in, list(simplification)::out)
+:- pred find_simplifications(bool::in, globals::in, simplifications::out)
is det.
:- type simplification
@@ -77,7 +77,7 @@
; warn_unknown_format % --warn-unknown-format-calls
; do_once % run things that should be done once
; excess_assigns % remove excess assignment unifications
- ; duplicate_calls % optimize duplicate calls
+ ; opt_duplicate_calls % optimize duplicate calls
; constant_prop % partially evaluate calls
; common_struct % common structure elimination
; extra_common_struct % do common structure elimination
@@ -85,8 +85,24 @@
% usage (used by deforestation).
.
+:- type simplifications.
+
+:- func simplifications_to_list(simplifications) = list(simplification).
+:- func list_to_simplifications(list(simplification)) = simplifications.
+
:- type simplify_info.
+:- pred simplify_do_warn_simple_code(simplify_info::in) is semidet.
+:- pred simplify_do_warn_duplicate_calls(simplify_info::in) is semidet.
+:- pred simplify_do_warn_known_bad_format(simplify_info::in) is semidet.
+:- pred simplify_do_warn_unknown_format(simplify_info::in) is semidet.
+:- pred simplify_do_once(simplify_info::in) is semidet.
+:- pred simplify_do_excess_assign(simplify_info::in) is semidet.
+:- pred simplify_do_opt_duplicate_calls(simplify_info::in) is semidet.
+:- pred simplify_do_const_prop(simplify_info::in) is semidet.
+:- pred simplify_do_common_struct(simplify_info::in) is semidet.
+:- pred simplify_do_extra_common_struct(simplify_info::in) is semidet.
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -132,16 +148,118 @@
%-----------------------------------------------------------------------------%
+:- type simplifications
+ ---> simplifications(
+ do_warn_simple_code :: bool,
+ do_warn_duplicate_calls :: bool,
+ do_warn_known_bad_format :: bool,
+ do_warn_unknown_format :: bool,
+ do_do_once :: bool,
+ do_excess_assign :: bool,
+ do_opt_duplicate_calls :: bool,
+ do_constant_prop :: bool,
+ do_common_struct :: bool,
+ do_extra_common_struct :: bool
+ ).
+
+simplifications_to_list(Simplifications) = List :-
+ Simplifications = simplifications(WarnSimpleCode, WarnDupCalls,
+ WarnKnownBadFormat, WarnUnknownFormat, DoOnce, ExcessAssign,
+ OptDuplicateCalls, ConstantProp, CommonStruct, ExtraCommonStruct),
+ List =
+ ( WarnSimpleCode = yes -> [warn_simple_code] ; [] ) ++
+ ( WarnDupCalls = yes -> [warn_duplicate_calls] ; [] ) ++
+ ( WarnKnownBadFormat = yes -> [warn_known_bad_format] ; [] ) ++
+ ( WarnUnknownFormat = yes -> [warn_unknown_format] ; [] ) ++
+ ( DoOnce = yes -> [do_once] ; [] ) ++
+ ( ExcessAssign = yes -> [excess_assigns] ; [] ) ++
+ ( OptDuplicateCalls = yes -> [opt_duplicate_calls] ; [] ) ++
+ ( ConstantProp = yes -> [constant_prop] ; [] ) ++
+ ( CommonStruct = yes -> [common_struct] ; [] ) ++
+ ( ExtraCommonStruct = yes -> [extra_common_struct] ; [] ).
+
+list_to_simplifications(List) =
+ simplifications(
+ ( list.member(warn_simple_code, List) -> yes ; no ),
+ ( list.member(warn_duplicate_calls, List) -> yes ; no ),
+ ( list.member(warn_known_bad_format, List) -> yes ; no ),
+ ( list.member(warn_unknown_format, List) -> yes ; no ),
+ ( list.member(do_once, List) -> yes ; no ),
+ ( list.member(excess_assigns, List) -> yes ; no ),
+ ( list.member(opt_duplicate_calls, List) -> yes ; no ),
+ ( list.member(constant_prop, List) -> yes ; no ),
+ ( list.member(common_struct, List) -> yes ; no ),
+ ( list.member(extra_common_struct, List) -> yes ; no )
+ ).
+
+find_simplifications(WarnThisPass, Globals, Simplifications) :-
+ globals.lookup_bool_option(Globals, warn_simple_code, WarnSimple),
+ globals.lookup_bool_option(Globals, warn_duplicate_calls, WarnDupCalls),
+ globals.lookup_bool_option(Globals, warn_known_bad_format_calls,
+ WarnKnownBadFormat),
+ globals.lookup_bool_option(Globals, warn_unknown_format_calls,
+ WarnUnknownFormat),
+ globals.lookup_bool_option(Globals, excess_assign, ExcessAssign),
+ globals.lookup_bool_option(Globals, common_struct, CommonStruct),
+ globals.lookup_bool_option(Globals, optimize_duplicate_calls,
+ OptDuplicateCalls),
+ globals.lookup_bool_option(Globals, constant_propagation, ConstantProp),
+ DoOnce = no,
+ ExtraCommonStruct = no,
+
+ Simplifications = simplifications(
+ ( WarnSimple = yes, WarnThisPass = yes -> yes ; no),
+ ( WarnDupCalls = yes, WarnThisPass = yes -> yes ; no),
+ ( WarnKnownBadFormat = yes, WarnThisPass = yes -> yes ; no),
+ ( WarnUnknownFormat = yes, WarnThisPass = yes -> yes ; no),
+ DoOnce,
+ ExcessAssign,
+ OptDuplicateCalls,
+ ConstantProp,
+ CommonStruct,
+ ExtraCommonStruct
+ ).
+
+simplify_do_warn_simple_code(Info) :-
+ simplify_info_get_simplifications(Info, Simplifications),
+ Simplifications ^ do_warn_simple_code = yes.
+simplify_do_warn_duplicate_calls(Info) :-
+ simplify_info_get_simplifications(Info, Simplifications),
+ Simplifications ^ do_warn_duplicate_calls = yes.
+simplify_do_warn_known_bad_format(Info) :-
+ simplify_info_get_simplifications(Info, Simplifications),
+ Simplifications ^ do_warn_known_bad_format = yes.
+simplify_do_warn_unknown_format(Info) :-
+ simplify_info_get_simplifications(Info, Simplifications),
+ Simplifications ^ do_warn_unknown_format = yes.
+simplify_do_once(Info) :-
+ simplify_info_get_simplifications(Info, Simplifications),
+ Simplifications ^ do_do_once = yes.
+simplify_do_excess_assign(Info) :-
+ simplify_info_get_simplifications(Info, Simplifications),
+ Simplifications ^ do_excess_assign = yes.
+simplify_do_opt_duplicate_calls(Info) :-
+ simplify_info_get_simplifications(Info, Simplifications),
+ Simplifications ^ do_opt_duplicate_calls = yes.
+simplify_do_const_prop(Info) :-
+ simplify_info_get_simplifications(Info, Simplifications),
+ Simplifications ^ do_constant_prop = yes.
+simplify_do_common_struct(Info) :-
+ simplify_info_get_simplifications(Info, Simplifications),
+ Simplifications ^ do_common_struct = yes.
+simplify_do_extra_common_struct(Info) :-
+ simplify_info_get_simplifications(Info, Simplifications),
+ Simplifications ^ do_extra_common_struct = yes.
+
+%-----------------------------------------------------------------------------%
+
simplify_pred(Simplifications0, PredId, !ModuleInfo, !PredInfo,
WarnCnt, ErrCnt, !IO) :-
write_pred_progress_message("% Simplifying ", PredId, !.ModuleInfo, !IO),
ProcIds = pred_info_non_imported_procids(!.PredInfo),
- (
% Don't warn for compiler-generated procedures.
- list.member(warn_simple_code, Simplifications0),
- is_unify_or_compare_pred(!.PredInfo)
- ->
- list.delete_all(Simplifications0, warn_simple_code, Simplifications)
+ ( is_unify_or_compare_pred(!.PredInfo) ->
+ Simplifications = Simplifications0 ^ do_warn_simple_code := no
;
Simplifications = Simplifications0
),
@@ -161,7 +279,7 @@
globals.io_lookup_bool_option(detailed_statistics, Statistics, !IO),
maybe_report_stats(Statistics, !IO).
-:- pred simplify_procs(list(simplification)::in, pred_id::in,
+:- pred simplify_procs(simplifications::in, pred_id::in,
list(proc_id)::in, module_info::in, module_info::out,
pred_info::in, pred_info::out,
maybe(pair(set(context_det_msg)))::in,
@@ -200,12 +318,25 @@
simplify_proc_return_msgs(Simplifications, PredId, ProcId, !ModuleInfo,
!Proc, _, !IO).
-simplify_proc_return_msgs(Simplifications, PredId, ProcId, !ModuleInfo,
+:- func turn_off_common_struct_threshold = int.
+
+turn_off_common_struct_threshold = 1000.
+
+simplify_proc_return_msgs(Simplifications0, PredId, ProcId, !ModuleInfo,
!ProcInfo, DetMsgs, !IO) :-
module_info_get_globals(!.ModuleInfo, Globals),
proc_info_vartypes(!.ProcInfo, VarTypes0),
- det_info_init(!.ModuleInfo, VarTypes0, PredId, ProcId, Globals,
- DetInfo0),
+ NumVars = map.count(VarTypes0),
+ ( NumVars > turn_off_common_struct_threshold ->
+ % If we have too many variables, common_struct takes so long that
+ % either the compiler runs out of memory or the user runs out of
+ % patience. The fact that we would generate better code if the
+ % compilation finished is therefore of limited interest.
+ Simplifications = Simplifications0 ^ do_common_struct := no
+ ;
+ Simplifications = Simplifications0
+ ),
+ det_info_init(!.ModuleInfo, VarTypes0, PredId, ProcId, Globals, DetInfo0),
proc_info_get_initial_instmap(!.ProcInfo, !.ModuleInfo, InstMap0),
simplify_info_init(DetInfo0, Simplifications, InstMap0, !.ProcInfo, Info0),
proc_info_goal(!.ProcInfo, Goal0),
@@ -225,7 +356,7 @@
Goal1 = Goal0
),
- process_goal(Goal1, Goal, Info0, Info, !IO),
+ simplify_process_goal(Goal1, Goal, Info0, Info, !IO),
simplify_info_get_varset(Info, VarSet),
simplify_info_get_var_types(Info, VarTypes),
@@ -239,9 +370,9 @@
(
Info ^ format_calls = yes,
(
- list.member(warn_known_bad_format, Simplifications)
+ Simplifications ^ do_warn_known_bad_format = yes
;
- list.member(warn_unknown_format, Simplifications)
+ Simplifications ^ do_warn_unknown_format = yes
)
->
% We must use the original goal, Goal0, here. This is because excess
@@ -268,26 +399,26 @@
DetMsgs = DetMsgs1
).
-process_goal(Goal0, Goal, !Info, !IO) :-
+simplify_process_goal(Goal0, Goal, !Info, !IO) :-
simplify_info_get_simplifications(!.Info, Simplifications0),
simplify_info_get_instmap(!.Info, InstMap0),
-
(
- ( simplify_do_common(!.Info)
- ; simplify_do_calls(!.Info)
+ ( simplify_do_common_struct(!.Info)
+ ; simplify_do_opt_duplicate_calls(!.Info)
)
->
- % On the first pass do common structure and call elimination.
- NotOnFirstPass = [do_once, excess_assigns],
-
- set.delete_list(Simplifications0, NotOnFirstPass, Simplifications1),
+ Simplifications1 = ((Simplifications0
+ ^ do_do_once := no)
+ ^ do_excess_assign := no),
simplify_info_set_simplifications(Simplifications1, !Info),
do_process_goal(Goal0, Goal1, !Info, !IO),
- NotOnSecondPass = [warn_simple_code, warn_duplicate_calls,
- common_struct, duplicate_calls],
- set.delete_list(Simplifications0, NotOnSecondPass, Simplifications2),
+ Simplifications2 = ((((Simplifications0
+ ^ do_warn_simple_code := no)
+ ^ do_warn_duplicate_calls := no)
+ ^ do_common_struct := no)
+ ^ do_opt_duplicate_calls := no),
simplify_info_reinit(Simplifications2, InstMap0, !Info)
;
Goal1 = Goal0
@@ -313,9 +444,9 @@
simplify_info_set_varset(VarSet1, !Info),
simplify_info_set_var_types(VarTypes1, !Info),
- % Always recompute instmap_deltas for atomic goals - this
- % is safer in the case where unused variables should no
- % longer be included in the instmap_delta for a goal.
+ % Always recompute instmap_deltas for atomic goals - this is safer
+ % in the case where unused variables should no longer be included
+ % in the instmap_delta for a goal.
% In the alias branch this is necessary anyway.
RecomputeAtomic = yes,
@@ -332,8 +463,7 @@
det_get_soln_context(Det, SolnContext),
% det_infer_goal looks up the proc_info in the module_info
- % for the vartypes, so we'd better stick them back in the
- % module_info.
+ % for the vartypes, so we'd better stick them back in the module_info.
simplify_info_get_module_info(!.Info, ModuleInfo2),
simplify_info_get_varset(!.Info, VarSet2),
simplify_info_get_var_types(!.Info, VarTypes2),
@@ -357,45 +487,6 @@
%-----------------------------------------------------------------------------%
-find_simplifications(WarnThisPass, Globals, Simps) :-
- find_simplifications_2(WarnThisPass, Globals, [], Simps).
-
-:- pred find_simplifications_2(bool::in, globals::in,
- list(simplification)::in, list(simplification)::out) is det.
-
-find_simplifications_2(WarnThisPass, Globals, !Simps) :-
- (
- WarnThisPass = yes,
- set_by_option(Globals, warn_duplicate_calls,
- warn_duplicate_calls, !Simps),
- set_by_option(Globals, warn_simple_code,
- warn_simple_code, !Simps),
- set_by_option(Globals, warn_known_bad_format_calls,
- warn_known_bad_format, !Simps),
- set_by_option(Globals, warn_unknown_format_calls,
- warn_unknown_format, !Simps)
- ;
- WarnThisPass = no
- ),
- set_by_option(Globals, excess_assign, excess_assigns, !Simps),
- set_by_option(Globals, common_struct, common_struct, !Simps),
- set_by_option(Globals, optimize_duplicate_calls, duplicate_calls, !Simps),
- set_by_option(Globals, constant_propagation, constant_prop, !Simps).
-
-:- pred set_by_option(globals::in, option::in, simplification::in,
- list(simplification)::in, list(simplification)::out) is det.
-
-set_by_option(Globals, Option, Simplification, !Simplifications) :-
- globals.lookup_bool_option(Globals, Option, Result),
- (
- Result = yes,
- !:Simplifications = [Simplification | !.Simplifications]
- ;
- Result = no
- ).
-
-%-----------------------------------------------------------------------------%
-
:- pred simplify_goal(hlds_goal::in, hlds_goal::out,
simplify_info::in, simplify_info::out, io::di, io::uo) is det.
@@ -425,11 +516,12 @@
%
goal_info_get_context(GoalInfo0, Context),
(
- simplify_do_warn(!.Info),
+ simplify_do_warn_simple_code(!.Info),
\+ (
goal_contains_goal(Goal0, SubGoal),
( SubGoal = disj([]) - _
- ; goal_is_call_to_builtin_false(SubGoal))
+ ; goal_is_call_to_builtin_false(SubGoal)
+ )
)
->
Msg = goal_cannot_succeed,
@@ -489,7 +581,7 @@
% % quantifications, because it seems that warnings in those
% % cases are usually spurious.
% (
-% simplify_do_warn(!.Info),
+% simplify_do_warn_simple_code(!.Info),
% % Goal0 \= conj(plain_conj, []) - _,
% \+ (Goal0 = call(_, _, _, _, _, SymName) - _,
% unqualify_name(SymName, "!")),
@@ -636,8 +728,7 @@
simplify_goal_2(disj(Disjuncts0), Goal, GoalInfo0, GoalInfo, !Info, !IO) :-
simplify_info_get_instmap(!.Info, InstMap0),
- simplify_disj(Disjuncts0, [], Disjuncts, [], InstMaps, !.Info, !Info,
- !IO),
+ simplify_disj(Disjuncts0, [], Disjuncts, [], InstMaps, !.Info, !Info, !IO),
(
Disjuncts = [],
goal_info_get_context(GoalInfo0, Context),
@@ -651,8 +742,8 @@
Disjuncts = [_, _ | _],
Goal = disj(Disjuncts),
( goal_info_has_feature(GoalInfo0, mode_check_clauses_goal) ->
- % Recomputing the instmap delta would take very long and is
- % very unlikely to get any better precision.
+ % Recomputing the instmap delta would take very long
+ % and is very unlikely to get any better precision.
GoalInfo = GoalInfo0
;
simplify_info_get_module_info(!.Info, ModuleInfo1),
@@ -798,24 +889,24 @@
simplify_goal_2(Goal0, Goal, GoalInfo, GoalInfo, !Info, !IO) :-
Goal0 = generic_call(GenericCall, Args, Modes, Det),
(
- simplify_do_calls(!.Info),
+ simplify_do_opt_duplicate_calls(!.Info),
% XXX We should do duplicate call elimination for
% class method calls here.
GenericCall = higher_order(Closure, Purity, _, _),
% XXX Should we handle semipure higher-order calls too?
Purity = purity_pure
->
- common.optimise_higher_order_call(Closure, Args, Modes, Det,
+ common_optimise_higher_order_call(Closure, Args, Modes, Det,
GoalInfo, Goal0, Goal, !Info)
;
- simplify_do_warn_calls(!.Info),
+ simplify_do_warn_duplicate_calls(!.Info),
GenericCall = higher_order(Closure, Purity, _, _),
% XXX Should we handle impure/semipure higher-order calls too?
Purity = purity_pure
->
% We need to do the pass, for the warnings, but we ignore
% the optimized goal and instead use the original one.
- common.optimise_higher_order_call(Closure, Args, Modes, Det,
+ common_optimise_higher_order_call(Closure, Args, Modes, Det,
GoalInfo, Goal0, _Goal1, !Info),
Goal = Goal0
;
@@ -899,21 +990,20 @@
unexpected(this_file, "invalid RHS for complicated unify")
)
;
- simplify_do_common(!.Info)
+ simplify_do_common_struct(!.Info)
->
- common.optimise_unification(U0, LT0, RT0, M, C,
+ common_optimise_unification(U0, LT0, RT0, M, C,
Goal0, Goal, GoalInfo0, GoalInfo, !Info)
;
- ( simplify_do_calls(!.Info)
- ; simplify_do_warn_calls(!.Info)
+ ( simplify_do_opt_duplicate_calls(!.Info)
+ ; simplify_do_warn_duplicate_calls(!.Info)
)
->
- % We need to do the pass, to record the variable
- % equivalences used for optimizing or warning about
- % duplicate calls. But we don't want to perform
- % the optimization, so we disregard the optimized goal
- % and instead use the original one.
- common.optimise_unification(U0, LT0, RT0, M, C,
+ % We need to do the pass, to record the variable equivalences
+ % used for optimizing or warning about duplicate calls.
+ % But we don't want to perform the optimization, so we disregard
+ % the optimized goal and instead use the original one.
+ common_optimise_unification(U0, LT0, RT0, M, C,
Goal0, _Goal1, GoalInfo0, _GoalInfo1, !Info),
Goal = Goal0,
GoalInfo = GoalInfo0
@@ -1201,12 +1291,12 @@
Goal1 = foreign_proc(Attributes, PredId, ProcId, Args, ExtraArgs, Impl)
),
(
- simplify_do_calls(!.Info),
+ simplify_do_opt_duplicate_calls(!.Info),
goal_info_is_pure(GoalInfo),
ExtraArgs = []
->
ArgVars = list.map(foreign_arg_var, Args),
- common.optimise_call(PredId, ProcId, ArgVars, GoalInfo, Goal1, Goal,
+ common_optimise_call(PredId, ProcId, ArgVars, GoalInfo, Goal1, Goal,
!Info)
;
Goal = Goal1
@@ -1299,7 +1389,7 @@
module_info_pred_proc_info(ModuleInfo, PredId, ProcId, PredInfo, ProcInfo),
% Check for calls to predicates with `pragma obsolete' declarations.
(
- simplify_do_warn(!.Info),
+ simplify_do_warn_simple_code(!.Info),
pred_info_get_markers(PredInfo, Markers),
check_marker(Markers, obsolete),
@@ -1322,7 +1412,7 @@
% Check for recursive calls with the same input arguments,
% and warn about them (since they will lead to infinite loops).
(
- simplify_do_warn(!.Info),
+ simplify_do_warn_simple_code(!.Info),
% Is this a (directly) recursive call, i.e. is the procedure being
% called the same as the procedure we're analyzing?
@@ -1392,18 +1482,18 @@
% Check for duplicate calls to the same procedure.
(
- simplify_do_calls(!.Info),
+ simplify_do_opt_duplicate_calls(!.Info),
goal_info_is_pure(GoalInfo0)
->
- common.optimise_call(PredId, ProcId, Args, GoalInfo0, Goal0, Goal1,
+ common_optimise_call(PredId, ProcId, Args, GoalInfo0, Goal0, Goal1,
!Info)
;
- simplify_do_warn_calls(!.Info),
+ simplify_do_warn_duplicate_calls(!.Info),
goal_info_is_pure(GoalInfo0)
->
- % we need to do the pass, for the warnings, but we ignore
- % the optimized goal and instead use the original one
- common.optimise_call(PredId, ProcId, Args, GoalInfo0, Goal0, _Goal1,
+ % We need to do the pass, for the warnings, but we ignore
+ % the optimized goal and instead use the original one.
+ common_optimise_call(PredId, ProcId, Args, GoalInfo0, Goal0, _Goal1,
!Info),
Goal1 = Goal0
;
@@ -1658,7 +1748,7 @@
input_args_are_equiv([Arg | Args], [HeadVar | HeadVars], [Mode | Modes],
CommonInfo, ModuleInfo) :-
( mode_is_input(ModuleInfo, Mode) ->
- common.vars_are_equivalent(Arg, HeadVar, CommonInfo)
+ common_vars_are_equivalent(Arg, HeadVar, CommonInfo)
;
true
),
@@ -1860,7 +1950,7 @@
simplify_info::in, simplify_info::out) is det.
excess_assigns_in_conj(ConjInfo, Goals0, Goals, !Info) :-
- ( simplify_do_excess_assigns(!.Info) ->
+ ( simplify_do_excess_assign(!.Info) ->
goal_info_get_nonlocals(ConjInfo, ConjNonLocals),
map.init(Subn0),
simplify_info_get_module_info(!.Info, ModuleInfo),
@@ -1876,7 +1966,7 @@
renaming_transitive_closure(Subn1, Subn),
list.reverse(RevGoals, Goals1),
MustSub = no,
- goal_util.rename_vars_in_goals(MustSub, Subn, Goals1, Goals),
+ rename_vars_in_goals(MustSub, Subn, Goals1, Goals),
map.keys(Subn0, RemovedVars),
varset.delete_vars(VarSet0, RemovedVars, VarSet),
simplify_info_set_varset(VarSet, !Info),
@@ -2106,7 +2196,7 @@
MaxSolns = at_most_zero
->
(
- simplify_do_warn(!.Info),
+ simplify_do_warn_simple_code(!.Info),
% Don't warn where the initial goal was fail, since that can result
% from mode analysis pruning away cases in a switch which cannot
% succeed due to sub-typing in the modes.
@@ -2261,7 +2351,7 @@
---> simplify_info(
det_info :: det_info,
msgs :: set(context_det_msg),
- simplifications :: set(simplification),
+ simplifications :: simplifications,
common_info :: common_info,
% Info about common subexpressions.
instmap :: instmap,
@@ -2294,14 +2384,13 @@
proc_info_inst_varset(ProcInfo, InstVarSet),
proc_info_rtti_varmaps(ProcInfo, RttiVarMaps),
set.init(Msgs),
- set.list_to_set(Simplifications, SimplificationsSet),
- Info = simplify_info(DetInfo, Msgs, SimplificationsSet,
+ Info = simplify_info(DetInfo, Msgs, Simplifications,
common_info_init, InstMap, VarSet, InstVarSet,
no, no, no, 0, 0, RttiVarMaps, no).
% Reinitialise the simplify_info before reprocessing a goal.
%
-:- pred simplify_info_reinit(set(simplification)::in, instmap::in,
+:- pred simplify_info_reinit(simplifications::in, instmap::in,
simplify_info::in, simplify_info::out) is det.
simplify_info_reinit(Simplifications, InstMap0, !Info) :-
@@ -2319,14 +2408,14 @@
:- import_module parse_tree.prog_data.
:- import_module set.
-:- pred simplify_info_init(det_info::in, list(simplification)::in,
+:- pred simplify_info_init(det_info::in, simplifications::in,
instmap::in, proc_info::in, simplify_info::out) is det.
:- pred simplify_info_get_det_info(simplify_info::in, det_info::out) is det.
:- pred simplify_info_get_det_msgs(simplify_info::in,
set(context_det_msg)::out) is det.
:- pred simplify_info_get_simplifications(simplify_info::in,
- set(simplification)::out) is det.
+ simplifications::out) is det.
:- pred simplify_info_get_common_info(simplify_info::in, common_info::out)
is det.
:- pred simplify_info_get_instmap(simplify_info::in, instmap::out) is det.
@@ -2396,7 +2485,7 @@
simplify_info::in, simplify_info::out) is det.
:- pred simplify_info_set_det_msgs(set(context_det_msg)::in,
simplify_info::in, simplify_info::out) is det.
-:- pred simplify_info_set_simplifications(set(simplification)::in,
+:- pred simplify_info_set_simplifications(simplifications::in,
simplify_info::in, simplify_info::out) is det.
:- pred simplify_info_set_instmap(instmap::in,
simplify_info::in, simplify_info::out) is det.
@@ -2442,7 +2531,7 @@
Info ^ cost_delta := Info ^ cost_delta + Incr).
simplify_info_add_det_msg(Msg, !Info) :-
- ( simplify_do_warn(!.Info) ->
+ ( simplify_do_warn_simple_code(!.Info) ->
simplify_info_do_add_det_msg(Msg, !Info)
;
true
@@ -2482,44 +2571,6 @@
simplify_info_set_var_types(VarTypes, !Info),
simplify_info_set_rtti_varmaps(RttiVarMaps, !Info).
-:- interface.
-
-:- pred simplify_do_warn(simplify_info::in) is semidet.
-:- pred simplify_do_warn_calls(simplify_info::in) is semidet.
-:- pred simplify_do_once(simplify_info::in) is semidet.
-:- pred simplify_do_common(simplify_info::in) is semidet.
-:- pred simplify_do_excess_assigns(simplify_info::in) is semidet.
-:- pred simplify_do_calls(simplify_info::in) is semidet.
-:- pred simplify_do_const_prop(simplify_info::in) is semidet.
-:- pred simplify_do_more_common(simplify_info::in) is semidet.
-
-:- implementation.
-
-simplify_do_warn(Info) :-
- simplify_info_get_simplifications(Info, Simplifications),
- set.member(warn_simple_code, Simplifications).
-simplify_do_warn_calls(Info) :-
- simplify_info_get_simplifications(Info, Simplifications),
- set.member(warn_duplicate_calls, Simplifications).
-simplify_do_once(Info) :-
- simplify_info_get_simplifications(Info, Simplifications),
- set.member(do_once, Simplifications).
-simplify_do_common(Info) :-
- simplify_info_get_simplifications(Info, Simplifications),
- set.member(common_struct, Simplifications).
-simplify_do_excess_assigns(Info) :-
- simplify_info_get_simplifications(Info, Simplifications),
- set.member(excess_assigns, Simplifications).
-simplify_do_calls(Info) :-
- simplify_info_get_simplifications(Info, Simplifications),
- set.member(duplicate_calls, Simplifications).
-simplify_do_const_prop(Info) :-
- simplify_info_get_simplifications(Info, Simplifications),
- set.member(constant_prop, Simplifications).
-simplify_do_more_common(Info) :-
- simplify_info_get_simplifications(Info, Simplifications),
- set.member(extra_common_struct, Simplifications).
-
:- pred simplify_info_update_instmap(hlds_goal::in,
simplify_info::in, simplify_info::out) is det.
@@ -2544,8 +2595,8 @@
simplify_info_maybe_clear_structs(BeforeAfter, Goal, !Info) :-
(
- simplify_do_common(!.Info),
- \+ simplify_do_more_common(!.Info),
+ simplify_do_common_struct(!.Info),
+ \+ simplify_do_extra_common_struct(!.Info),
Goal = GoalExpr - _,
will_flush(GoalExpr, BeforeAfter) = yes
->
Index: compiler/size_prof.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/size_prof.m,v
retrieving revision 1.34
diff -u -b -r1.34 size_prof.m
--- compiler/size_prof.m 24 Mar 2006 03:04:02 -0000 1.34
+++ compiler/size_prof.m 25 Mar 2006 13:57:22 -0000
@@ -236,7 +236,7 @@
io::di, io::uo) is det.
process_proc(Transform, PredId, ProcId, !ProcInfo, !ModuleInfo, !IO) :-
- Simplifications = [],
+ Simplifications = list_to_simplifications([]),
simplify_proc_return_msgs(Simplifications, PredId, ProcId,
!ModuleInfo, !ProcInfo, _Msgs, !IO),
Index: compiler/stack_opt.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/stack_opt.m,v
retrieving revision 1.24
diff -u -b -r1.24 stack_opt.m
--- compiler/stack_opt.m 17 Mar 2006 01:40:40 -0000 1.24
+++ compiler/stack_opt.m 25 Mar 2006 13:52:12 -0000
@@ -174,7 +174,8 @@
% This simplication is necessary to fix some bad inputs from
% getting to the liveness computation.
% (see tests/valid/stack_opt_simplify.m)
- simplify_proc([], PredId, ProcId, !ModuleInfo, !ProcInfo, !IO),
+ Simplications = list_to_simplifications([]),
+ simplify_proc(Simplications, PredId, ProcId, !ModuleInfo, !ProcInfo, !IO),
detect_liveness_proc(PredId, ProcId, !.ModuleInfo, !ProcInfo, !IO),
initial_liveness(!.ProcInfo, PredId, !.ModuleInfo, Liveness0),
module_info_get_globals(!.ModuleInfo, Globals),
Index: compiler/superhomogeneous.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/superhomogeneous.m,v
retrieving revision 1.14
diff -u -b -r1.14 superhomogeneous.m
--- compiler/superhomogeneous.m 17 Mar 2006 01:40:41 -0000 1.14
+++ compiler/superhomogeneous.m 24 Mar 2006 06:01:14 -0000
@@ -44,56 +44,52 @@
unify_sub_contexts
).
- % `insert_arg_unifications' takes a list of variables,
- % a list of terms to unify them with, and a goal, and
- % inserts the appropriate unifications onto the front of
- % the goal. It calls `unravel_unification' to ensure
- % that each unification gets reduced to superhomogeneous form.
- % It also gets passed an `arg_context', which indicates
- % where the terms came from.
+ % `insert_arg_unifications' takes a list of variables, a list of terms
+ % to unify them with, and a goal, and inserts the appropriate unifications
+ % onto the front of the goal. It calls `unravel_unification' to ensure that
+ % each unification gets reduced to superhomogeneous form. It also gets
+ % passed an `arg_context', which indicates where the terms came from.
%
% We never insert unifications of the form X = X.
%
:- pred insert_arg_unifications(list(prog_var)::in, list(prog_term)::in,
- prog_context::in, arg_context::in,
- hlds_goal::in, hlds_goal::out, prog_varset::in, prog_varset::out,
- module_info::in, module_info::out, qual_info::in, qual_info::out,
- svar_info::in, svar_info::out, io::di, io::uo) is det.
+ prog_context::in, arg_context::in, hlds_goal::in, hlds_goal::out, int::out,
+ prog_varset::in, prog_varset::out, module_info::in, module_info::out,
+ qual_info::in, qual_info::out, svar_info::in, svar_info::out,
+ io::di, io::uo) is det.
:- pred insert_arg_unifications_with_supplied_contexts(list(prog_var)::in,
list(prog_term)::in, assoc_list(int, arg_context)::in, prog_context::in,
- hlds_goal::in, hlds_goal::out, prog_varset::in, prog_varset::out,
- module_info::in, module_info::out, qual_info::in, qual_info::out,
- svar_info::in, svar_info::out, io::di, io::uo) is det.
+ hlds_goal::in, hlds_goal::out, int::out,
+ prog_varset::in, prog_varset::out, module_info::in, module_info::out,
+ qual_info::in, qual_info::out, svar_info::in, svar_info::out,
+ io::di, io::uo) is det.
% append_arg_unifications is the same as insert_arg_unifications,
% except that the unifications are added after the goal rather
% than before the goal.
%
:- pred append_arg_unifications(list(prog_var)::in, list(prog_term)::in,
- prog_context::in, arg_context::in, hlds_goal::in, hlds_goal::out,
- prog_varset::in, prog_varset::out,
- module_info::in, module_info::out, qual_info::in, qual_info::out,
- svar_info::in, svar_info::out, io::di, io::uo) is det.
+ prog_context::in, arg_context::in, hlds_goal::in, hlds_goal::out, int::out,
+ prog_varset::in, prog_varset::out, module_info::in, module_info::out,
+ qual_info::in, qual_info::out, svar_info::in, svar_info::out,
+ io::di, io::uo) is det.
:- pred unravel_unification(prog_term::in, prog_term::in, prog_context::in,
unify_main_context::in, unify_sub_contexts::in, purity::in,
- hlds_goal::out, prog_varset::in, prog_varset::out,
+ hlds_goal::out, int::out, prog_varset::in, prog_varset::out,
module_info::in, module_info::out, qual_info::in, qual_info::out,
svar_info::in, svar_info::out, io::di, io::uo) is det.
% make_fresh_arg_vars(Args, VarSet0, Vars, VarSet, !SInfo, !IO):
- % `Vars' is a list of distinct variables corresponding to
- % the terms in `Args'. For each term in `Args', if
- % the term is a variable V which is distinct from the
- % variables already produced, then the corresponding
- % variable in `Vars' is just V, otherwise a fresh variable
- % is allocated from `VarSet0'. `VarSet' is the resulting
- % varset after all the necessary variables have been allocated.
- % !SInfo and !IO are required to handle state variables.
%
- % For efficiency, the list `Vars' is constructed backwards
- % and then reversed to get the correct order.
+ % `Vars' is a list of distinct variables corresponding to the terms
+ % in `Args'. For each term in `Args', if the term is a variable V
+ % which is distinct from the variables already produced, then the
+ % corresponding variable in `Vars' is just V, otherwise a fresh variable
+ % is allocated from `VarSet0'. `VarSet' is the varset resulting after
+ % all the necessary variables have been allocated. !SInfo and !IO
+ % are required to handle state variables.
%
:- pred make_fresh_arg_vars(list(prog_term)::in, list(prog_var)::out,
prog_varset::in, prog_varset::out, svar_info::in, svar_info::out,
@@ -138,79 +134,138 @@
%-----------------------------------------------------------------------------%
-insert_arg_unifications(HeadVars, Args0, Context, ArgContext,
- !Goal, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO) :-
+:- 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, !IO) :-
+ do_insert_arg_unifications(HeadVars, Args0, Context, ArgContext, !Goal,
+ yes(from_ground_term_scope_threshold), NumAdded,
+ !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO).
+
+insert_arg_unifications_with_supplied_contexts(ArgVars, ArgTerms0,
+ ArgContexts, Context, !Goal, NumAdded, !VarSet, !ModuleInfo, !QualInfo,
+ !SInfo, !IO) :-
+ do_insert_arg_unifications_with_supplied_contexts(ArgVars, ArgTerms0,
+ ArgContexts, Context,
+ !Goal, yes(from_ground_term_scope_threshold), NumAdded,
+ !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO).
+
+append_arg_unifications(HeadVars, Args0, Context, ArgContext,
+ !Goal, NumAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO) :-
+ do_append_arg_unifications(HeadVars, Args0, Context, ArgContext, !Goal,
+ yes(from_ground_term_scope_threshold), NumAdded,
+ !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO).
+
+unravel_unification(LHS0, RHS0, Context, MainContext, SubContext, Purity,
+ Goal, NumAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO) :-
+ do_unravel_unification(LHS0, RHS0, Context, MainContext, SubContext,
+ Purity, Goal, yes(from_ground_term_scope_threshold), NumAdded,
+ !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO).
+
+%-----------------------------------------------------------------------------%
+
+:- pred do_insert_arg_unifications(list(prog_var)::in, list(prog_term)::in,
+ prog_context::in, arg_context::in,
+ hlds_goal::in, hlds_goal::out, maybe(int)::in, int::out,
+ prog_varset::in, prog_varset::out, module_info::in, module_info::out,
+ qual_info::in, qual_info::out, svar_info::in, svar_info::out,
+ io::di, io::uo) is det.
+
+do_insert_arg_unifications(HeadVars, Args0, Context, ArgContext,
+ !Goal, MaybeThreshold, NumAdded, !VarSet, !ModuleInfo, !QualInfo,
+ !SInfo, !IO) :-
(
- HeadVars = []
+ HeadVars = [],
+ NumAdded = 0
;
HeadVars = [_ | _],
!.Goal = _ - GoalInfo0,
goal_to_conj_list(!.Goal, Goals0),
substitute_state_var_mappings(Args0, Args, !VarSet, !SInfo, !IO),
- insert_arg_unifications_2(HeadVars, Args, Context, ArgContext,
- 0, Goals0, Goals, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO),
+ do_insert_arg_unifications_2(HeadVars, Args, Context, ArgContext,
+ 0, Goals0, Goals, MaybeThreshold, 0, NumAdded, !VarSet, !ModuleInfo,
+ !QualInfo, !SInfo, !IO),
goal_info_set_context(Context, GoalInfo0, GoalInfo),
conj_list_to_goal(Goals, GoalInfo, !:Goal)
).
-:- pred insert_arg_unifications_2(list(prog_var)::in, list(prog_term)::in,
+:- pred do_insert_arg_unifications_2(list(prog_var)::in, list(prog_term)::in,
prog_context::in, arg_context::in, int::in,
list(hlds_goal)::in, list(hlds_goal)::out,
- prog_varset::in, prog_varset::out,
- module_info::in, module_info::out, qual_info::in, qual_info::out,
- svar_info::in, svar_info::out, io::di, io::uo) is det.
+ maybe(int)::in, int::in, int::out,
+ prog_varset::in, prog_varset::out, module_info::in, module_info::out,
+ qual_info::in, qual_info::out, svar_info::in, svar_info::out,
+ io::di, io::uo) is det.
-insert_arg_unifications_2([], [_ | _], _, _, _, _, _, _, _, !ModuleInfo,
- !QualInfo, !SInfo, !IO) :-
- unexpected(this_file, "insert_arg_unifications_2: length mismatch").
-insert_arg_unifications_2([_ | _], [], _, _, _, _, _, _, _, !ModuleInfo,
- !QualInfo, !SInfo, !IO) :-
- unexpected(this_file, "insert_arg_unifications_2: length mismatch").
-insert_arg_unifications_2([], [], _, _, _, !Goals, !VarSet, !ModuleInfo,
- !QualInfo, !SInfo, !IO).
-insert_arg_unifications_2([Var | Vars], [Arg | Args], Context, ArgContext,
- N0, !Goals, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO) :-
+do_insert_arg_unifications_2([], [_ | _], _, _, _, _, _, _, !NumAdded, !VarSet,
+ !ModuleInfo, !QualInfo, !SInfo, !IO) :-
+ unexpected(this_file, "do_insert_arg_unifications_2: length mismatch").
+do_insert_arg_unifications_2([_ | _], [], _, _, _, _, _, _, !NumAdded, !VarSet,
+ !ModuleInfo, !QualInfo, !SInfo, !IO) :-
+ unexpected(this_file, "do_insert_arg_unifications_2: length mismatch").
+do_insert_arg_unifications_2([], [], _, _, _, !Goals, _, !NumAdded, !VarSet,
+ !ModuleInfo, !QualInfo, !SInfo, !IO).
+do_insert_arg_unifications_2([Var | Vars], [Arg | Args], Context, ArgContext,
+ N0, !Goals, MaybeThreshold, !NumAdded, !VarSet, !ModuleInfo, !QualInfo,
+ !SInfo, !IO) :-
N1 = N0 + 1,
- insert_arg_unification(Var, Arg, Context, ArgContext, N1,
- !VarSet, ArgUnifyConj, !ModuleInfo, !QualInfo, !SInfo, !IO),
+ do_insert_arg_unification(Var, Arg, Context, ArgContext, N1, ArgUnifyConj,
+ MaybeThreshold, ArgAdded, !VarSet, !ModuleInfo, !QualInfo,
+ !SInfo, !IO),
+ !:NumAdded = !.NumAdded + ArgAdded,
(
ArgUnifyConj = [],
% Allow the recursive call to be tail recursive.
- insert_arg_unifications_2(Vars, Args, Context, ArgContext,
- N1, !Goals, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO)
+ do_insert_arg_unifications_2(Vars, Args, Context, ArgContext, N1,
+ !Goals, MaybeThreshold, !NumAdded, !VarSet, !ModuleInfo,
+ !QualInfo, !SInfo, !IO)
;
ArgUnifyConj = [_ | _],
- insert_arg_unifications_2(Vars, Args, Context, ArgContext,
- N1, !Goals, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO),
+ do_insert_arg_unifications_2(Vars, Args, Context, ArgContext, N1,
+ !Goals, MaybeThreshold, !NumAdded, !VarSet, !ModuleInfo,
+ !QualInfo, !SInfo, !IO),
list.append(ArgUnifyConj, !.Goals, !:Goals)
).
-insert_arg_unifications_with_supplied_contexts(ArgVars, ArgTerms0, ArgContexts,
- Context, !Goal, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO) :-
+:- pred do_insert_arg_unifications_with_supplied_contexts(list(prog_var)::in,
+ list(prog_term)::in, assoc_list(int, arg_context)::in, prog_context::in,
+ hlds_goal::in, hlds_goal::out, maybe(int)::in, int::out,
+ prog_varset::in, prog_varset::out, module_info::in, module_info::out,
+ qual_info::in, qual_info::out, svar_info::in, svar_info::out,
+ io::di, io::uo) is det.
+
+do_insert_arg_unifications_with_supplied_contexts(ArgVars, ArgTerms0,
+ ArgContexts, Context, !Goal, MaybeThreshold, NumAdded,
+ !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO) :-
(
- ArgVars = []
+ ArgVars = [],
+ NumAdded = 0
;
ArgVars = [_ | _],
!.Goal = _ - GoalInfo0,
goal_to_conj_list(!.Goal, GoalList0),
substitute_state_var_mappings(ArgTerms0, ArgTerms, !VarSet, !SInfo,
!IO),
- insert_arg_unifications_with_supplied_contexts_2(ArgVars, ArgTerms,
- ArgContexts, Context, GoalList0, GoalList, !VarSet,
- !ModuleInfo, !QualInfo, !SInfo, !IO),
+ do_insert_arg_unifications_with_supplied_contexts_2(ArgVars, ArgTerms,
+ ArgContexts, Context, GoalList0, GoalList, MaybeThreshold,
+ 0, NumAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO),
goal_info_set_context(Context, GoalInfo0, GoalInfo),
conj_list_to_goal(GoalList, GoalInfo, !:Goal)
).
-:- pred insert_arg_unifications_with_supplied_contexts_2(list(prog_var)::in,
+:- pred do_insert_arg_unifications_with_supplied_contexts_2(list(prog_var)::in,
list(prog_term)::in, assoc_list(int, arg_context)::in, prog_context::in,
list(hlds_goal)::in, list(hlds_goal)::out,
- prog_varset::in, prog_varset::out,
- module_info::in, module_info::out, qual_info::in, qual_info::out,
- svar_info::in, svar_info::out, io::di, io::uo) is det.
+ maybe(int)::in, int::in, int::out,
+ prog_varset::in, prog_varset::out, module_info::in, module_info::out,
+ qual_info::in, qual_info::out, svar_info::in, svar_info::out,
+ io::di, io::uo) is det.
-insert_arg_unifications_with_supplied_contexts_2(Vars, Terms, ArgContexts,
- Context, !Goals, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO) :-
+do_insert_arg_unifications_with_supplied_contexts_2(Vars, Terms, ArgContexts,
+ Context, !Goals, MaybeThreshold, !NumAdded, !VarSet, !ModuleInfo,
+ !QualInfo, !SInfo, !IO) :-
(
Vars = [],
Terms = [],
@@ -222,166 +277,199 @@
Terms = [Term | TermsTail],
ArgContexts = [ArgNumber - ArgContext | ArgContextsTail]
->
- insert_arg_unification(Var, Term, Context, ArgContext, ArgNumber,
- !VarSet, UnifyConj, !ModuleInfo, !QualInfo, !SInfo, !IO),
- insert_arg_unifications_with_supplied_contexts_2(VarsTail, TermsTail,
- ArgContextsTail, Context, !Goals, !VarSet, !ModuleInfo, !QualInfo,
- !SInfo, !IO),
+ do_insert_arg_unification(Var, Term, Context, ArgContext, ArgNumber,
+ UnifyConj, MaybeThreshold, ArgAdded, !VarSet, !ModuleInfo,
+ !QualInfo, !SInfo, !IO),
+ !:NumAdded = !.NumAdded + ArgAdded,
+ do_insert_arg_unifications_with_supplied_contexts_2(VarsTail,
+ TermsTail, ArgContextsTail, Context, !Goals, MaybeThreshold,
+ !NumAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO),
list.append(UnifyConj, !.Goals, !:Goals)
;
unexpected(this_file, "insert_arg_unifications_with_supplied_contexts")
).
-:- pred insert_arg_unification(prog_var::in, prog_term::in, prog_context::in,
- arg_context::in, int::in, prog_varset::in, prog_varset::out,
- list(hlds_goal)::out, module_info::in, module_info::out,
+:- pred do_insert_arg_unification(prog_var::in, prog_term::in, prog_context::in,
+ arg_context::in, int::in, list(hlds_goal)::out, maybe(int)::in, int::out,
+ prog_varset::in, prog_varset::out, module_info::in, module_info::out,
qual_info::in, qual_info::out, svar_info::in, svar_info::out,
io::di, io::uo) is det.
-insert_arg_unification(Var, Arg, Context, ArgContext, N1, !VarSet,
- ArgUnifyConj, !ModuleInfo, !QualInfo, !SInfo, !IO) :-
+do_insert_arg_unification(Var, Arg, Context, ArgContext, N1, ArgUnifyConj,
+ MaybeThreshold, NumAdded, !VarSet, !ModuleInfo, !QualInfo,
+ !SInfo, !IO) :-
( Arg = term.variable(Var) ->
% Skip unifications of the form `X = X'
- ArgUnifyConj = []
+ ArgUnifyConj = [],
+ NumAdded = 0
;
arg_context_to_unify_context(ArgContext, N1, UnifyMainContext,
UnifySubContext),
- unravel_unification(term.variable(Var), Arg, Context,
+ do_unravel_unification(term.variable(Var), Arg, Context,
UnifyMainContext, UnifySubContext, purity_pure, Goal,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO),
+ MaybeThreshold, NumAdded, !VarSet, !ModuleInfo, !QualInfo,
+ !SInfo, !IO),
goal_to_conj_list(Goal, ArgUnifyConj)
).
-append_arg_unifications(HeadVars, Args0, Context, ArgContext,
- !Goal, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO) :-
+:- pred do_append_arg_unifications(list(prog_var)::in, list(prog_term)::in,
+ prog_context::in, arg_context::in,
+ hlds_goal::in, hlds_goal::out, maybe(int)::in, int::out,
+ prog_varset::in, prog_varset::out, module_info::in, module_info::out,
+ qual_info::in, qual_info::out, svar_info::in, svar_info::out,
+ io::di, io::uo) is det.
+
+do_append_arg_unifications(HeadVars, Args0, Context, ArgContext, !Goal,
+ MaybeThreshold, NumAdded, !VarSet, !ModuleInfo, !QualInfo,
+ !SInfo, !IO) :-
(
- HeadVars = []
+ HeadVars = [],
+ NumAdded = 0
;
HeadVars = [_ | _],
!.Goal = _ - GoalInfo,
- goal_to_conj_list(!.Goal, List0),
- substitute_state_var_mappings(Args0, Args, !VarSet,
- !SInfo, !IO),
- append_arg_unifications_2(HeadVars, Args, Context, ArgContext,
- 0, List0, List, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO),
- conj_list_to_goal(List, GoalInfo, !:Goal)
+ goal_to_conj_list(!.Goal, GoalList0),
+ substitute_state_var_mappings(Args0, Args, !VarSet, !SInfo, !IO),
+ do_append_arg_unifications_2(HeadVars, Args, Context, ArgContext,
+ 0, GoalList0, GoalList, MaybeThreshold, 0, NumAdded,
+ !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO),
+ conj_list_to_goal(GoalList, GoalInfo, !:Goal)
).
-:- pred append_arg_unifications_2(list(prog_var)::in, list(prog_term)::in,
+:- pred do_append_arg_unifications_2(list(prog_var)::in, list(prog_term)::in,
prog_context::in, arg_context::in, int::in,
list(hlds_goal)::in, list(hlds_goal)::out,
- prog_varset::in, prog_varset::out,
- module_info::in, module_info::out, qual_info::in, qual_info::out,
- svar_info::in, svar_info::out, io::di, io::uo) is det.
+ maybe(int)::in, int::in, int::out,
+ prog_varset::in, prog_varset::out, module_info::in, module_info::out,
+ qual_info::in, qual_info::out, svar_info::in, svar_info::out,
+ io::di, io::uo) is det.
-append_arg_unifications_2([], [_|_], _, _, _, _, _, _, _, !ModuleInfo,
- !QualInfo, !SInfo, !IO) :-
- unexpected(this_file, "append_arg_unifications_2: length mismatch").
-append_arg_unifications_2([_|_], [], _, _, _, _, _, _, _, !ModuleInfo,
+do_append_arg_unifications_2([], [_ | _], _, _, _, _, _, _, !NumAdded,
+ !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO) :-
+ unexpected(this_file, "do_append_arg_unifications_2: length mismatch").
+do_append_arg_unifications_2([_ | _], [], _, _, _, _, _, _, !NumAdded,
+ !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO) :-
+ unexpected(this_file, "do_append_arg_unifications_2: length mismatch").
+do_append_arg_unifications_2([], [], _, _, _, !GoalList, _, !NumAdded,
+ !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO).
+do_append_arg_unifications_2([Var | Vars], [Arg | Args], Context, ArgContext,
+ N0, !GoalList, MaybeThreshold, !NumAdded, !VarSet, !ModuleInfo,
!QualInfo, !SInfo, !IO) :-
- unexpected(this_file, "append_arg_unifications_2: length mismatch").
-append_arg_unifications_2([], [], _, _, _, !List, !VarSet, !ModuleInfo,
- !QualInfo, !SInfo, !IO).
-append_arg_unifications_2([Var|Vars], [Arg|Args], Context, ArgContext,
- N0, !List, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO) :-
N1 = N0 + 1,
- append_arg_unification(Var, Arg, Context, ArgContext, N1, ConjList,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO),
- list.append(!.List, ConjList, !:List),
- append_arg_unifications_2(Vars, Args, Context, ArgContext, N1,
- !List, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO).
+ do_append_arg_unification(Var, Arg, Context, ArgContext, N1, ConjList,
+ MaybeThreshold, ArgAdded, !VarSet, !ModuleInfo, !QualInfo,
+ !SInfo, !IO),
+ !:NumAdded = !.NumAdded + ArgAdded,
+ list.append(!.GoalList, ConjList, !:GoalList),
+ do_append_arg_unifications_2(Vars, Args, Context, ArgContext, N1,
+ !GoalList, MaybeThreshold, !NumAdded, !VarSet, !ModuleInfo,
+ !QualInfo, !SInfo, !IO).
-:- pred append_arg_unification(prog_var::in, prog_term::in, prog_context::in,
- arg_context::in, int::in, list(hlds_goal)::out,
- prog_varset::in, prog_varset::out,
- module_info::in, module_info::out, qual_info::in, qual_info::out,
- svar_info::in, svar_info::out, io::di, io::uo) is det.
+:- pred do_append_arg_unification(prog_var::in, prog_term::in,
+ prog_context::in, arg_context::in, int::in, list(hlds_goal)::out,
+ maybe(int)::in, int::out,
+ prog_varset::in, prog_varset::out, module_info::in, module_info::out,
+ qual_info::in, qual_info::out, svar_info::in, svar_info::out,
+ io::di, io::uo) is det.
-append_arg_unification(Var, Arg, Context, ArgContext, N1, ConjList,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO) :-
+do_append_arg_unification(Var, Arg, Context, ArgContext, N1, ConjList,
+ MaybeThreshold, NumAdded, !VarSet, !ModuleInfo, !QualInfo,
+ !SInfo, !IO) :-
( Arg = term.variable(Var) ->
- % skip unifications of the form `X = X'
- ConjList = []
+ % Skip unifications of the form `X = X'.
+ ConjList = [],
+ NumAdded = 0
;
arg_context_to_unify_context(ArgContext, N1, UnifyMainContext,
UnifySubContext),
- unravel_unification(term.variable(Var), Arg, Context,
+ do_unravel_unification(term.variable(Var), Arg, Context,
UnifyMainContext, UnifySubContext, purity_pure, Goal,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO),
+ MaybeThreshold, NumAdded, !VarSet, !ModuleInfo, !QualInfo,
+ !SInfo, !IO),
goal_to_conj_list(Goal, ConjList)
).
-:- pred arg_context_to_unify_context(arg_context::in, int::in,
- unify_main_context::out, unify_sub_contexts::out) is det.
-
-arg_context_to_unify_context(head(PredOrFunc, Arity), ArgNum,
- ArgContext, []) :-
- ( PredOrFunc = function, ArgNum = Arity ->
- % it's the function result term in the head
- ArgContext = head_result
- ;
- % it's a head argument
- ArgContext = head(ArgNum)
- ).
-arg_context_to_unify_context(call(PredId), ArgNum, call(PredId, ArgNum), []).
-arg_context_to_unify_context(functor(ConsId, MainContext, SubContexts), ArgNum,
- MainContext, [ConsId - ArgNum | SubContexts]).
-
%-----------------------------------------------------------------------------%
-make_fresh_arg_vars(Args, Vars, !VarSet, !SInfo, !IO) :-
- make_fresh_arg_vars_2(Args, [], Vars1, !VarSet, !SInfo, !IO),
- list.reverse(Vars1, Vars).
-
-:- pred make_fresh_arg_vars_2(list(prog_term)::in, list(prog_var)::in,
- list(prog_var)::out, prog_varset::in,prog_varset::out,
- svar_info::in, svar_info::out, io::di, io::uo) is det.
-
-make_fresh_arg_vars_2([], Vars, Vars, !VarSet, !SInfo, !IO).
-make_fresh_arg_vars_2([Arg | Args], Vars0, Vars, !VarSet, !SInfo, !IO) :-
- make_fresh_arg_var(Arg, Var, Vars0, !VarSet, !SInfo, !IO),
- make_fresh_arg_vars_2(Args, [Var | Vars0], Vars, !VarSet, !SInfo, !IO).
+:- pred do_unravel_unification(prog_term::in, prog_term::in, prog_context::in,
+ unify_main_context::in, unify_sub_contexts::in, purity::in,
+ hlds_goal::out, maybe(int)::in, int::out,
+ prog_varset::in, prog_varset::out, module_info::in, module_info::out,
+ qual_info::in, qual_info::out, svar_info::in, svar_info::out,
+ io::di, io::uo) is det.
-make_fresh_arg_var(Arg0, Var, Vars0, !VarSet, !SInfo, !IO) :-
- substitute_state_var_mapping(Arg0, Arg, !VarSet, !SInfo, !IO),
+do_unravel_unification(LHS0, RHS0, Context, MainContext, SubContext, Purity,
+ Goal, MaybeThreshold, NumAdded, !VarSet, !ModuleInfo, !QualInfo,
+ !SInfo, !IO) :-
+ substitute_state_var_mapping(LHS0, LHS, !VarSet, !SInfo, !IO),
+ substitute_state_var_mapping(RHS0, RHS, !VarSet, !SInfo, !IO),
+ classify_unravel_unification(LHS, RHS, Context, MainContext, SubContext,
+ Purity, Goal0, NumAdded, !VarSet, !ModuleInfo, !QualInfo,
+ !SInfo, !IO),
(
- Arg = term.variable(ArgVar),
- \+ list.member(ArgVar, Vars0)
+ MaybeThreshold = yes(Threshold),
+ NumAdded > Threshold,
+ LHS = term.variable(X),
+ ground_term(RHS)
->
- Var = ArgVar
+ Goal0 = _ - GoalInfo,
+ Goal = scope(from_ground_term(X), Goal0) - GoalInfo
;
- varset.new_var(!.VarSet, Var, !:VarSet)
+ Goal = Goal0
).
-%-----------------------------------------------------------------------------%
-
- %
- % XXX We could do better on the error messages for
- % lambda expressions and field extraction and update expressions.
- %
-
-unravel_unification(LHS0, RHS0, Context, MainContext, SubContext,
- Purity, Goal, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO) :-
- substitute_state_var_mapping(LHS0, LHS, !VarSet, !SInfo, !IO),
- substitute_state_var_mapping(RHS0, RHS, !VarSet, !SInfo, !IO),
- unravel_unification_2(LHS, RHS, Context, MainContext, SubContext,
- Purity, Goal, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO).
-
-:- pred unravel_unification_2(prog_term::in, prog_term::in, prog_context::in,
- unify_main_context::in, unify_sub_contexts::in, purity::in,
- hlds_goal::out, prog_varset::in, prog_varset::out,
+:- 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, int::out, prog_varset::in, prog_varset::out,
module_info::in, module_info::out, qual_info::in, qual_info::out,
svar_info::in, svar_info::out, io::di, io::uo) is det.
+classify_unravel_unification(TermX, TermY, Context, MainContext, SubContext,
+ Purity, Goal, NumAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo,
+ !IO) :-
+ (
% `X = Y' needs no unravelling.
-
-unravel_unification_2(term.variable(X), term.variable(Y), Context,
- MainContext, SubContext, Purity, Goal, !VarSet,
- !ModuleInfo, !QualInfo, !SInfo, !IO) :-
+ TermX = term.variable(X),
+ TermY = term.variable(Y),
make_atomic_unification(X, var(Y), Context, MainContext, SubContext,
- Purity, Goal, !QualInfo).
+ Purity, Goal, !QualInfo),
+ NumAdded = 0
+ ;
+ TermX = term.variable(X),
+ TermY = term.functor(F, Args, FunctorContext),
+ unravel_var_functor_unification(X, F, Args, FunctorContext,
+ Context, MainContext, SubContext, Purity, Goal, NumAdded,
+ !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO)
+ ;
+ TermX = term.functor(F, Args, FunctorContext),
+ TermY = term.variable(Y),
+ unravel_var_functor_unification(Y, F, Args, FunctorContext,
+ Context, MainContext, SubContext, Purity, Goal, NumAdded,
+ !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO)
+ ;
+ % If we find a unification of the form `f1(...) = f2(...)',
+ % then we replace it with `Tmp = f1(...), Tmp = f2(...)',
+ % and then process it according to the rules above.
+ % Note that we can't simplify it yet, because we might simplify
+ % away type errors.
+ TermX = term.functor(_, _, _),
+ TermY = term.functor(_, _, _),
+ varset.new_var(!.VarSet, TmpVar, !:VarSet),
+ do_unravel_unification(term.variable(TmpVar), TermX,
+ Context, MainContext, SubContext, Purity, GoalX, no, NumAddedX,
+ !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO),
+ do_unravel_unification(term.variable(TmpVar), TermY,
+ Context, MainContext, SubContext, Purity, GoalY, no, NumAddedY,
+ !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO),
+ goal_to_conj_list(GoalX, ConjListX),
+ goal_to_conj_list(GoalY, ConjListY),
+ ConjList = ConjListX ++ ConjListY,
+ goal_info_init(GoalInfo),
+ conj_list_to_goal(ConjList, GoalInfo, Goal),
+ NumAdded = NumAddedX + NumAddedY
+ ).
- % If we find a unification of the form
+ % Given an unification of the form
% X = f(A1, A2, A3)
% we replace it with
% X = f(NewVar1, NewVar2, NewVar3),
@@ -389,10 +477,20 @@
% NewVar2 = A2,
% NewVar3 = A3.
% In the trivial case `X = c', no unravelling occurs.
+ %
+ % XXX We could do better on the error messages for lambda expressions
+ % and field extraction and update expressions.
+ %
+:- pred unravel_var_functor_unification(prog_var::in, term.const::in,
+ list(prog_term)::in, term.context::in,
+ prog_context::in, unify_main_context::in, unify_sub_contexts::in,
+ purity::in, hlds_goal::out, int::out, prog_varset::in, prog_varset::out,
+ module_info::in, module_info::out, qual_info::in, qual_info::out,
+ svar_info::in, svar_info::out, io::di, io::uo) is det.
-unravel_unification_2(term.variable(X), RHS, Context, MainContext, SubContext,
- Purity, Goal, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO) :-
- RHS = term.functor(F, Args1, FunctorContext),
+unravel_var_functor_unification(X, F, Args1, FunctorContext,
+ Context, MainContext, SubContext, Purity, Goal, NumAdded,
+ !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO) :-
substitute_state_var_mappings(Args1, Args, !VarSet, !SInfo, !IO),
(
% Handle explicit type qualification.
@@ -425,20 +523,21 @@
write_error_pieces(Context, 0, Pieces, !IO),
io.set_exit_status(1, !IO)
),
- unravel_unification(term.variable(X), RVal, Context, MainContext,
- SubContext, Purity, Goal, !VarSet, !ModuleInfo, !QualInfo,
- !SInfo, !IO)
+ do_unravel_unification(term.variable(X), RVal, Context, MainContext,
+ SubContext, Purity, Goal, no, NumAdded, !VarSet, !ModuleInfo,
+ !QualInfo, !SInfo, !IO)
;
% Handle unification expressions.
F = term.atom("@"),
Args = [LVal, RVal]
->
- unravel_unification(term.variable(X), LVal, Context,
- MainContext, SubContext, Purity, Goal1,
+ do_unravel_unification(term.variable(X), LVal, Context,
+ MainContext, SubContext, Purity, Goal1, no, NumAdded1,
!VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO),
- unravel_unification(term.variable(X), RVal, Context,
- MainContext, SubContext, Purity, Goal2,
+ do_unravel_unification(term.variable(X), RVal, Context,
+ MainContext, SubContext, Purity, Goal2, no, NumAdded2,
!VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO),
+ NumAdded = NumAdded1 + NumAdded2,
goal_info_init(GoalInfo),
goal_to_conj_list(Goal1, ConjList1),
goal_to_conj_list(Goal2, ConjList2),
@@ -446,12 +545,12 @@
conj_list_to_goal(ConjList, GoalInfo, Goal)
;
% Handle higher-order pred and func expressions.
+ % XXX Why do we use Arg1 instead of Args here?
+ RHS = term.functor(F, Args1, FunctorContext),
parse_rule_term(Context, RHS, HeadTerm0, GoalTerm1),
term.coerce(HeadTerm0, HeadTerm1),
parse_purity_annotation(HeadTerm1, LambdaPurity, HeadTerm),
- (
- parse_pred_expression(HeadTerm, EvalMethod0, Vars0, Modes0, Det0)
- ->
+ ( parse_pred_expression(HeadTerm, EvalMethod0, Vars0, Modes0, Det0) ->
PredOrFunc = predicate,
EvalMethod = EvalMethod0,
Vars1 = Vars0,
@@ -462,79 +561,79 @@
PredOrFunc = function
)
->
- add_clause.qualify_lambda_mode_list(Modes1, Modes, Context,
+ qualify_lambda_mode_list_if_not_opt_imported(Modes1, Modes, Context,
!QualInfo, !IO),
Det = Det1,
term.coerce(GoalTerm1, GoalTerm),
parse_goal(GoalTerm, ParsedGoal, !VarSet),
build_lambda_expression(X, Purity, LambdaPurity, PredOrFunc,
EvalMethod, Vars1, Modes, Det, ParsedGoal, Context, MainContext,
- SubContext, Goal, !VarSet, !ModuleInfo, !QualInfo, !.SInfo, !IO)
+ SubContext, Goal, NumAdded, !VarSet, !ModuleInfo, !QualInfo,
+ !.SInfo, !IO)
;
- % handle higher-order dcg pred expressions -
- % same semantics as higher-order pred expressions,
- % but has two extra arguments, and the goal is expanded
- % as a DCG goal.
+ % Handle higher-order dcg pred expressions. They have the same
+ % semantics as higher-order pred expressions, but have two extra
+ % arguments, and the goal is expanded as a DCG goal.
F = term.atom("-->"),
Args = [PredTerm0, GoalTerm0],
term.coerce(PredTerm0, PredTerm1),
parse_purity_annotation(PredTerm1, DCGLambdaPurity, PredTerm),
parse_dcg_pred_expression(PredTerm, EvalMethod, Vars0, Modes0, Det)
->
- add_clause.qualify_lambda_mode_list(Modes0, Modes, Context, !QualInfo,
- !IO),
+ qualify_lambda_mode_list_if_not_opt_imported(Modes0, Modes, Context,
+ !QualInfo, !IO),
term.coerce(GoalTerm0, GoalTerm),
parse_dcg_pred_goal(GoalTerm, ParsedGoal, DCG0, DCGn, !VarSet),
- list.append(Vars0, [term.variable(DCG0), term.variable(DCGn)],
- Vars1),
+ Vars1 = Vars0 ++ [term.variable(DCG0), term.variable(DCGn)],
build_lambda_expression(X, Purity, DCGLambdaPurity, predicate,
EvalMethod, Vars1, Modes, Det, ParsedGoal, Context, MainContext,
- SubContext, Goal0, !VarSet, !ModuleInfo, !QualInfo, !.SInfo, !IO),
+ SubContext, Goal0, NumAdded, !VarSet, !ModuleInfo, !QualInfo,
+ !.SInfo, !IO),
Goal0 = GoalExpr - GoalInfo0,
add_goal_info_purity_feature(Purity, GoalInfo0, GoalInfo),
Goal = GoalExpr - GoalInfo
;
- % handle if-then-else expressions
+ % Handle if-then-else expressions
(
F = term.atom("else"),
- IfThenTerm = term.functor(
- term.atom("if"),
- [term.functor(term.atom("then"), [IfTerm0, ThenTerm], _)],
- _),
- Args = [IfThenTerm, ElseTerm]
+ Args = [CondThenTerm, ElseTerm],
+ CondThenTerm = term.functor(term.atom("if"),
+ [term.functor(term.atom("then"), [CondTerm0, ThenTerm], _)], _)
;
F = term.atom(";"),
- Args = [term.functor(term.atom("->"), [IfTerm0, ThenTerm], _),
- ElseTerm]
+ Args = [CondThenTerm, ElseTerm],
+ CondThenTerm = term.functor(term.atom("->"),
+ [CondTerm0, ThenTerm], _)
),
- term.coerce(IfTerm0, IfTerm),
- parse_some_vars_goal(IfTerm, Vars, StateVars, IfParseTree, !VarSet)
+ term.coerce(CondTerm0, CondTerm),
+ parse_some_vars_goal(CondTerm, Vars, StateVars, CondParseTree, !VarSet)
->
BeforeSInfo = !.SInfo,
prepare_for_if_then_else_expr(StateVars, !VarSet, !SInfo),
map.init(EmptySubst),
- transform_goal(IfParseTree, EmptySubst, IfGoal, !VarSet,
+ transform_goal(CondParseTree, EmptySubst, CondGoal, CondAdded, !VarSet,
!ModuleInfo, !QualInfo, !SInfo, !IO),
finish_if_then_else_expr_condition(BeforeSInfo, !SInfo),
- unravel_unification(term.variable(X), ThenTerm,
- Context, MainContext, SubContext, Purity, ThenGoal,
+ do_unravel_unification(term.variable(X), ThenTerm,
+ Context, MainContext, SubContext, Purity, ThenGoal, no, ThenAdded,
!VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO),
finish_if_then_else_expr_then_goal(StateVars, BeforeSInfo, !SInfo),
- unravel_unification(term.variable(X), ElseTerm,
- Context, MainContext, SubContext, Purity,
- ElseGoal, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO),
+ do_unravel_unification(term.variable(X), ElseTerm,
+ Context, MainContext, SubContext, Purity, ElseGoal, no, ElseAdded,
+ !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO),
- IfThenElse = if_then_else(StateVars ++ Vars, IfGoal, ThenGoal,
- ElseGoal),
+ NumAdded = CondAdded + ThenAdded + ElseAdded,
+ GoalExpr = if_then_else(StateVars ++ Vars,
+ CondGoal, ThenGoal, ElseGoal),
goal_info_init(Context, GoalInfo),
- Goal = IfThenElse - GoalInfo
+ Goal = GoalExpr - GoalInfo
;
- % handle field extraction expressions
+ % Handle field extraction expressions.
F = term.atom("^"),
Args = [InputTerm, FieldNameTerm],
parse_field_list(FieldNameTerm, FieldNameResult),
@@ -542,15 +641,16 @@
->
make_fresh_arg_var(InputTerm, InputTermVar, [], !VarSet, !SInfo, !IO),
expand_get_field_function_call(Context, MainContext, SubContext,
- FieldNames, X, InputTermVar, Purity, !VarSet, Functor, _, Goal0,
- !ModuleInfo, !QualInfo, !SInfo, !IO),
+ FieldNames, X, InputTermVar, Purity, Functor, _, Goal0, CallAdded,
+ !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO),
ArgContext = functor(Functor, MainContext, SubContext),
- insert_arg_unifications([InputTermVar], [InputTerm],
- FunctorContext, ArgContext, Goal0, Goal,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO)
+ do_insert_arg_unifications([InputTermVar], [InputTerm],
+ FunctorContext, ArgContext, Goal0, Goal, no, ArgAdded,
+ !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO),
+ NumAdded = CallAdded + ArgAdded
;
- % handle field update expressions
+ % Handle field update expressions.
F = term.atom(":="),
Args = [FieldDescrTerm, FieldValueTerm],
FieldDescrTerm = term.functor(term.atom("^"),
@@ -563,9 +663,9 @@
!VarSet, !SInfo, !IO),
expand_set_field_function_call(Context, MainContext, SubContext,
- FieldNames, FieldValueVar, InputTermVar, X, !VarSet,
- Functor, InnerFunctor - FieldSubContext, Goal0,
- !ModuleInfo, !QualInfo, !SInfo, !IO),
+ FieldNames, FieldValueVar, InputTermVar, X,
+ Functor, InnerFunctor - FieldSubContext, Goal0, CallAdded,
+ !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO),
TermArgContext = functor(Functor, MainContext, SubContext),
TermArgNumber = 1,
@@ -573,12 +673,15 @@
FieldArgNumber = 2,
ArgContexts = [TermArgNumber - TermArgContext,
FieldArgNumber - FieldArgContext],
- insert_arg_unifications_with_supplied_contexts(
- [InputTermVar, FieldValueVar],
- [InputTerm, FieldValueTerm], ArgContexts, Context,
- Goal0, Goal, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO)
+ do_insert_arg_unifications_with_supplied_contexts(
+ [InputTermVar, FieldValueVar], [InputTerm, FieldValueTerm],
+ ArgContexts, Context, Goal0, Goal, no, ArgAdded, !VarSet,
+ !ModuleInfo, !QualInfo, !SInfo, !IO),
+ NumAdded = CallAdded + ArgAdded
;
- % handle the usual case
+ % Handle the usual case.
+ % XXX Why do we use Arg1 instead of Args here?
+ RHS = term.functor(F, Args1, FunctorContext),
parse_qualified_term(RHS, RHS, "", MaybeFunctor),
(
MaybeFunctor = ok(FunctorName, FunctorArgs),
@@ -596,9 +699,10 @@
FunctorArgs = [],
make_atomic_unification(X, functor(ConsId, no, []), Context,
MainContext, SubContext, Purity, Goal0, !QualInfo),
+ NumAdded = 1,
Goal0 = GoalExpr - GoalInfo0,
add_goal_info_purity_feature(Purity, GoalInfo0, GoalInfo),
- % We could attach the from_ground_term feature to Goal,
+ % We could wrap a from_ground_term(X) scope around Goal,
% but there would be no gain from doing so, whereas the
% increase would lead to a slight increase in memory and time
% requirements.
@@ -608,88 +712,46 @@
make_fresh_arg_vars(FunctorArgs, HeadVars, !VarSet, !SInfo, !IO),
make_atomic_unification(X, functor(ConsId, no, HeadVars), Context,
MainContext, SubContext, Purity, Goal0, !QualInfo),
+ MainFunctorAdded = 1,
ArgContext = functor(ConsId, MainContext, SubContext),
% Should this be insert_... rather than append_...?
% No, because that causes efficiency problems
% with type-checking :-(
- % But for impure unifications, we need to do
- % this, because mode reordering can't reorder
- % around the functor unification.
+ % But for impure unifications, we need to do this, because
+ % mode reordering can't reorder around the functor unification.
( Purity = purity_pure ->
- append_arg_unifications(HeadVars, FunctorArgs, FunctorContext,
- ArgContext, Goal0, Goal2, !VarSet,
- !ModuleInfo, !QualInfo, !SInfo, !IO)
+ do_append_arg_unifications(HeadVars, FunctorArgs,
+ FunctorContext, ArgContext, Goal0, Goal, no, ArgAdded,
+ !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO)
;
Goal0 = GoalExpr0 - GoalInfo0,
add_goal_info_purity_feature(Purity, GoalInfo0, GoalInfo1),
Goal1 = GoalExpr0 - GoalInfo1,
- insert_arg_unifications(HeadVars, FunctorArgs, FunctorContext,
- ArgContext, Goal1, Goal2, !VarSet,
- !ModuleInfo, !QualInfo, !SInfo, !IO)
+ do_insert_arg_unifications(HeadVars, FunctorArgs,
+ FunctorContext, ArgContext, Goal1, Goal, no, ArgAdded,
+ !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO)
),
- % This "optimization" is disabled, because the extra cost of
- % traversing the scope goals in typechecking is more than the
- % savings from the reduction in delays/wakeups in modechecking.
- (
- semidet_fail,
- ground_terms(FunctorArgs)
- ->
- % This insertion of the `scope' goal is undone by the code
- % handling `scope' goals in modecheck_goal_expr in modes.m.
-
- Goal2 = _GoalExpr2 - GoalInfo,
- GoalExpr = scope(from_ground_term(X), Goal2),
- Goal = GoalExpr - GoalInfo
- ;
- Goal = Goal2
- )
+ NumAdded = MainFunctorAdded + ArgAdded
+% % This "optimization" is disabled, because the extra cost of
+% % traversing the scope goals in typechecking is more than the
+% % savings from the reduction in delays/wakeups in modechecking.
+% (
+% % ZZZ
+% semidet_fail,
+% ground_terms(FunctorArgs)
+% ->
+% % This insertion of the `scope' goal is undone by the code
+% % handling `scope' goals in modecheck_goal_expr in modes.m.
+%
+% Goal2 = _GoalExpr2 - GoalInfo,
+% GoalExpr = scope(from_ground_term(X), Goal2),
+% Goal = GoalExpr - GoalInfo
+% ;
+% Goal = Goal2
+% )
)
).
- % Handle `f(...) = X' in the same way as `X = f(...)'.
-
-unravel_unification_2(term.functor(F, As, FC), term.variable(Y), C, MC, SC,
- Purity, Goal, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO) :-
- unravel_unification(term.variable(Y), term.functor(F, As, FC), C, MC, SC,
- Purity, Goal, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO).
-
- % If we find a unification of the form `f1(...) = f2(...)',
- % then we replace it with `Tmp = f1(...), Tmp = f2(...)',
- % and then process it according to the rule above.
- % Note that we can't simplify it yet, because we might simplify
- % away type errors.
-
-unravel_unification_2(term.functor(LeftF, LeftAs, LeftC),
- term.functor(RightF, RightAs, RightC),
- Context, MainContext, SubContext,
- Purity, Goal, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO) :-
- varset.new_var(!.VarSet, TmpVar, !:VarSet),
- unravel_unification(term.variable(TmpVar),
- term.functor(LeftF, LeftAs, LeftC),
- Context, MainContext, SubContext,
- Purity, Goal0, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO),
- unravel_unification(term.variable(TmpVar),
- term.functor(RightF, RightAs, RightC),
- Context, MainContext, SubContext,
- Purity, Goal1, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO),
- goal_info_init(GoalInfo),
- goal_to_conj_list(Goal0, ConjList0),
- goal_to_conj_list(Goal1, ConjList1),
- list.append(ConjList0, ConjList1, ConjList),
- conj_list_to_goal(ConjList, GoalInfo, Goal).
-
-:- pred ground_term(term(T)::in) is semidet.
-
-ground_term(term.functor(_, Terms, _)) :-
- ground_terms(Terms).
-
-:- pred ground_terms(list(term(T))::in) is semidet.
-
-ground_terms([]).
-ground_terms([Term | Terms]) :-
- ground_term(Term),
- ground_terms(Terms).
-
%-----------------------------------------------------------------------------%
%
% Code for building lambda expressions
@@ -698,19 +760,18 @@
:- pred build_lambda_expression(prog_var::in, purity::in, purity::in,
pred_or_func::in, lambda_eval_method::in, list(prog_term)::in,
list(mer_mode)::in, determinism::in, goal::in, prog_context::in,
- unify_main_context::in, unify_sub_contexts::in, hlds_goal::out,
+ unify_main_context::in, unify_sub_contexts::in, hlds_goal::out, int::out,
prog_varset::in, prog_varset::out,
module_info::in, module_info::out, qual_info::in, qual_info::out,
svar_info::in, io::di, io::uo) is det.
build_lambda_expression(X, UnificationPurity, LambdaPurity, PredOrFunc,
- EvalMethod, Args0, Modes, Det, ParsedGoal, Context, MainContext,
- SubContext, Goal, !VarSet, !ModuleInfo, !QualInfo, !.SInfo, !IO) :-
- %
- % In the parse tree, the lambda arguments can be any terms, but
- % in the HLDS they must be distinct variables. So we introduce
- % fresh variables for the lambda arguments, and add appropriate
- % unifications.
+ EvalMethod, Args0, Modes, Det, ParsedGoal,
+ Context, MainContext, SubContext, Goal, NumAdded,
+ !VarSet, !ModuleInfo, !QualInfo, !.SInfo, !IO) :-
+ % In the parse tree, the lambda arguments can be any terms, but in the HLDS
+ % they must be distinct variables. So we introduce fresh variables
+ % for the lambda arguments, and add appropriate unifications.
%
% For example, we convert from:
%
@@ -726,45 +787,41 @@
% H3 = D
% )
%
- % Note that the quantification is important here. That's why we
- % need to introduce the explicit `some [...]'. Variables in the
- % argument positions are lambda-quantified, so when we move them to
- % the body, we need to make them explicitly existentially quantified
- % to avoid capturing any variables of the same name that occur
- % outside this scope.
- %
- % Also, note that any introduced unifications that construct the
- % output arguments for the lambda expression, need to occur *after*,
- % the body of the lambda expression. This is in case the body of
- % the lambda expression is impure, in which case the mode analyser
- % cannot reorder the unifications; this results in a mode error.
+ % Note that the quantification is important here. That's why we need
+ % to introduce the explicit `some [...]'. Variables in the argument
+ % positions are lambda-quantified, so when we move them to the body,
+ % we need to make them explicitly existentially quantified to avoid
+ % capturing any variables of the same name that occur outside this scope.
+ %
+ % Also, note that any introduced unifications that construct the output
+ % arguments for the lambda expression, need to occur *after*, the body
+ % of the lambda expression. This is in case the body of the lambda
+ % expression is impure, in which case the mode analyser cannot reorder
+ % the unifications; this results in a mode error.
%
- % XXX the mode analyser *should* be able to reorder such unifications,
+ % XXX The mode analyser *should* be able to reorder such unifications,
% especially ones that the compiler introduced itself.
%
% For predicates, all variables occurring in the lambda arguments are
% locally quantified to the lambda goal. For functions, we need to
- % be careful because variables in arguments should similarly be
- % quantified, but variables in the function return value term (and
- % not in the arguments) should *not* be locally quantified.
- %
- % Create fresh variables, transform the goal to HLDS, and add
- % unifications with the fresh variables. We use varset.new_vars
- % rather than make_fresh_arg_vars, since for functions we need to
- % ensure that the variable corresponding to the function result term
- % is a new variable, to avoid the function result term becoming
- % lambda-quantified.
- %
- (
- illegal_state_var_func_result(PredOrFunc, Args0, StateVar)
- ->
+ % be careful because variables in arguments should similarly be quantified,
+ % but variables in the function return value term (and not in the
+ % arguments) should *not* be locally quantified.
+ %
+ % Create fresh variables, transform the goal to HLDS, and add unifications
+ % with the fresh variables. We use varset.new_vars rather than
+ % make_fresh_arg_vars, since for functions we need to ensure that
+ % the variable corresponding to the function result term is a new variable,
+ % to avoid the function result term becoming lambda-quantified.
+
+ ( illegal_state_var_func_result(PredOrFunc, Args0, StateVar) ->
report_illegal_func_svar_result(Context, !.VarSet, StateVar, !IO),
- Goal = true_goal
- ;
- lambda_args_contain_bang_state_var(Args0, StateVar)
- ->
+ Goal = true_goal,
+ NumAdded = 0
+ ; lambda_args_contain_bang_state_var(Args0, StateVar) ->
report_illegal_bang_svar_lambda_arg(Context, !.VarSet, StateVar, !IO),
- Goal = true_goal
+ Goal = true_goal,
+ NumAdded = 0
;
prepare_for_lambda(!SInfo),
substitute_state_var_mappings(Args0, Args, !VarSet, !SInfo, !IO),
@@ -787,7 +844,7 @@
OutputLambdaVars = OutputLambdaVars0
;
unexpected(this_file,
- "Mismatched lists in build_lambda_expression.")
+ "mismatched lists in build_lambda_expression.")
),
map.init(Substitution),
@@ -799,8 +856,8 @@
%
HeadBefore0 = true_goal,
insert_arg_unifications(NonOutputLambdaVars, NonOutputArgs,
- Context, ArgContext, HeadBefore0, HeadBefore, !VarSet,
- !ModuleInfo, !QualInfo, !SInfo, !IO),
+ Context, ArgContext, HeadBefore0, HeadBefore, NonOutputAdded,
+ !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO),
%
% Create the unifications that need to come after the body of
% the lambda expression; those corresponding to args whose mode
@@ -808,13 +865,15 @@
%
HeadAfter0 = true_goal,
insert_arg_unifications(OutputLambdaVars, OutputArgs,
- Context, ArgContext, HeadAfter0, HeadAfter, !VarSet,
- !ModuleInfo, !QualInfo, !SInfo, !IO),
+ Context, ArgContext, HeadAfter0, HeadAfter, OutputAdded,
+ !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO),
prepare_for_body(FinalSVarMap, !VarSet, !SInfo),
- transform_goal(ParsedGoal, Substitution,
- Body, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO),
+ transform_goal(ParsedGoal, Substitution, Body, BodyAdded,
+ !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO),
+ NumAdded = NonOutputAdded + OutputAdded + BodyAdded,
+
%
% Fix up any state variable unifications.
%
@@ -857,44 +916,100 @@
% Partition the lists of arguments and variables into lists
% of non-output and output arguments and variables.
%
- :- pred partition_args_and_lambda_vars(
- module_info::in, list(prog_term)::in,
- list(prog_var)::in, list(mer_mode)::in,
+ :- pred partition_args_and_lambda_vars(module_info::in,
+ list(prog_term)::in, list(prog_var)::in, list(mer_mode)::in,
list(prog_term)::out, list(prog_term)::out,
list(prog_var)::out, list(prog_var)::out) is semidet.
partition_args_and_lambda_vars(_, [], [], [], [], [], [], []).
-partition_args_and_lambda_vars(ModuleInfo, [ Arg | Args ],
- [ LambdaVar | LambdaVars ],
- [Mode | Modes], InputArgs, OutputArgs,
+partition_args_and_lambda_vars(ModuleInfo, [Arg | Args],
+ [LambdaVar | LambdaVars], [Mode | Modes], InputArgs, OutputArgs,
InputLambdaVars, OutputLambdaVars) :-
partition_args_and_lambda_vars(ModuleInfo, Args, LambdaVars, Modes,
InputArgs0, OutputArgs0, InputLambdaVars0, OutputLambdaVars0),
- %
- % Calling mode_is_output/2 directly will cause the compiler to
- % abort if the mode is undefined, so we first check for this.
- % If the mode is undefined, it doesn't really matter which
- % partitions we place the arguements/lambda vars into because
- % mode analysis will fail anyway.
- %
+
+ % Calling mode_is_output/2 directly will cause the compiler to abort
+ % if the mode is undefined, so we first check for this. If the mode
+ % is undefined, it doesn't really matter which partitions we place
+ % the arguements/lambda vars into because mode analysis will fail
+ % anyway.
+
( mode_is_undefined(ModuleInfo, Mode) ->
- InputArgs = [ Arg | InputArgs0],
+ InputArgs = [Arg | InputArgs0],
OutputArgs = OutputArgs0,
- InputLambdaVars = [ LambdaVar | InputLambdaVars0 ],
+ InputLambdaVars = [LambdaVar | InputLambdaVars0],
OutputLambdaVars = OutputLambdaVars0
;
( mode_is_output(ModuleInfo, Mode) ->
InputArgs = InputArgs0,
OutputArgs = [Arg | OutputArgs0],
InputLambdaVars = InputLambdaVars0,
- OutputLambdaVars = [ LambdaVar | OutputLambdaVars0 ]
+ OutputLambdaVars = [LambdaVar | OutputLambdaVars0]
;
- InputArgs = [ Arg | InputArgs0],
+ InputArgs = [Arg | InputArgs0],
OutputArgs = OutputArgs0,
- InputLambdaVars = [ LambdaVar | InputLambdaVars0 ],
+ InputLambdaVars = [LambdaVar | InputLambdaVars0],
OutputLambdaVars = OutputLambdaVars0
)
).
+
+%-----------------------------------------------------------------------------%
+
+:- pred ground_term(term(T)::in) is semidet.
+
+ground_term(term.functor(_, Terms, _)) :-
+ ground_terms(Terms).
+
+:- pred ground_terms(list(term(T))::in) is semidet.
+
+ground_terms([]).
+ground_terms([Term | Terms]) :-
+ ground_term(Term),
+ ground_terms(Terms).
+
+:- pred arg_context_to_unify_context(arg_context::in, int::in,
+ unify_main_context::out, unify_sub_contexts::out) is det.
+
+arg_context_to_unify_context(head(PredOrFunc, Arity), ArgNum,
+ ArgContext, []) :-
+ ( PredOrFunc = function, ArgNum = Arity ->
+ % it's the function result term in the head
+ ArgContext = head_result
+ ;
+ % it's a head argument
+ ArgContext = head(ArgNum)
+ ).
+arg_context_to_unify_context(call(PredId), ArgNum, call(PredId, ArgNum), []).
+arg_context_to_unify_context(functor(ConsId, MainContext, SubContexts), ArgNum,
+ MainContext, [ConsId - ArgNum | SubContexts]).
+
+%-----------------------------------------------------------------------------%
+
+make_fresh_arg_vars(Args, Vars, !VarSet, !SInfo, !IO) :-
+ % For efficiency, we construct `Vars' backwards and then reverse it
+ % to get the correct order.
+ make_fresh_arg_vars_2(Args, [], Vars1, !VarSet, !SInfo, !IO),
+ list.reverse(Vars1, Vars).
+
+:- pred make_fresh_arg_vars_2(list(prog_term)::in, list(prog_var)::in,
+ list(prog_var)::out, prog_varset::in,prog_varset::out,
+ svar_info::in, svar_info::out, io::di, io::uo) is det.
+
+make_fresh_arg_vars_2([], Vars, Vars, !VarSet, !SInfo, !IO).
+make_fresh_arg_vars_2([Arg | Args], Vars0, Vars, !VarSet, !SInfo, !IO) :-
+ make_fresh_arg_var(Arg, Var, Vars0, !VarSet, !SInfo, !IO),
+ make_fresh_arg_vars_2(Args, [Var | Vars0], Vars, !VarSet, !SInfo, !IO).
+
+make_fresh_arg_var(Arg0, Var, Vars0, !VarSet, !SInfo, !IO) :-
+ substitute_state_var_mapping(Arg0, Arg, !VarSet, !SInfo, !IO),
+ (
+ Arg = term.variable(ArgVar),
+ \+ list.member(ArgVar, Vars0)
+ ->
+ Var = ArgVar
+ ;
+ varset.new_var(!.VarSet, Var, !:VarSet)
+ ).
%-----------------------------------------------------------------------------%
Index: compiler/switch_detection.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/switch_detection.m,v
retrieving revision 1.119
diff -u -b -r1.119 switch_detection.m
--- compiler/switch_detection.m 17 Mar 2006 01:40:41 -0000 1.119
+++ compiler/switch_detection.m 24 Mar 2006 16:31:18 -0000
@@ -105,11 +105,13 @@
(
ProcIds = [_ | _],
write_pred_progress_message("% Detecting switches in ", PredId,
- !.ModuleInfo, !IO)
+ !.ModuleInfo, !IO),
+ detect_switches_in_procs(ProcIds, PredId, !ModuleInfo)
+ % This is where we should print statistics, if we ever need
+ % to debug the performance of switch detection.
;
ProcIds = []
- ),
- detect_switches_in_procs(ProcIds, PredId, !ModuleInfo).
+ ).
:- pred detect_switches_in_procs(list(proc_id)::in, pred_id::in,
module_info::in, module_info::out) is det.
Index: compiler/term_constr_build.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/term_constr_build.m,v
retrieving revision 1.4
diff -u -b -r1.4 term_constr_build.m
--- compiler/term_constr_build.m 24 Feb 2006 05:49:40 -0000 1.4
+++ compiler/term_constr_build.m 25 Mar 2006 14:41:48 -0000
@@ -935,7 +935,7 @@
local_vars(GoalExpr - GoalInfo) = Locals :-
goal_info_get_nonlocals(GoalInfo, NonLocals),
- quantification.goal_vars(GoalExpr - GoalInfo, QuantVars),
+ QuantVars = free_goal_vars(GoalExpr - GoalInfo),
LocalsSet = set.difference(QuantVars, NonLocals),
Locals = set.to_sorted_list(LocalsSet).
@@ -946,7 +946,7 @@
partition_vars(GoalExpr - GoalInfo, Locals, NonLocals) :-
goal_info_get_nonlocals(GoalInfo, NonLocals0),
- quantification.goal_vars(GoalExpr - GoalInfo, QuantVars),
+ QuantVars = free_goal_vars(GoalExpr - GoalInfo),
Locals = set.to_sorted_list(set.difference(QuantVars, NonLocals0)),
NonLocals = set.to_sorted_list(NonLocals0).
@@ -975,7 +975,7 @@
size_varset::in, size_varset::out, size_var_map::out) is det.
fill_var_to_sizevar_map(Goal, !SizeVarset, SizeVarMap) :-
- quantification.goal_vars(Goal, ProgVarsInGoal),
+ ProgVarsInGoal = free_goal_vars(Goal),
ProgVars = set.to_sorted_list(ProgVarsInGoal),
make_size_var_map(ProgVars, !SizeVarset, SizeVarMap).
Index: compiler/unique_modes.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unique_modes.m,v
retrieving revision 1.106
diff -u -b -r1.106 unique_modes.m
--- compiler/unique_modes.m 17 Mar 2006 01:40:45 -0000 1.106
+++ compiler/unique_modes.m 25 Mar 2006 01:19:43 -0000
@@ -275,7 +275,7 @@
% parallel conjunction.
make_par_conj_nonlocal_multiset(List0, NonLocalsBag),
check_par_conj(List0, NonLocalsBag, List, InstMapList, !ModeInfo, !IO),
- instmap.unify(NonLocals, InstMapList, !ModeInfo),
+ instmap_unify(NonLocals, InstMapList, !ModeInfo),
mode_info_remove_live_vars(NonLocals, !ModeInfo),
mode_checkpoint(exit, "par_conj", !ModeInfo, !IO)
).
@@ -314,7 +314,7 @@
% merge the resulting instmaps.
check_disj(List0, Determinism, NonLocals, List, InstMapList,
!ModeInfo, !IO),
- instmap.merge(NonLocals, InstMapList, disj, !ModeInfo)
+ instmap_merge(NonLocals, InstMapList, disj, !ModeInfo)
),
mode_checkpoint(exit, "disj", !ModeInfo, !IO).
@@ -381,7 +381,7 @@
check_goal(Else0, Else, !ModeInfo, !IO),
mode_info_get_instmap(!.ModeInfo, InstMapElse),
mode_info_set_instmap(InstMap0, !ModeInfo),
- instmap.merge(NonLocals, [InstMapThen, InstMapElse], if_then_else,
+ instmap_merge(NonLocals, [InstMapThen, InstMapElse], if_then_else,
!ModeInfo),
Goal = if_then_else(Vars, Cond, Then, Else),
mode_checkpoint(exit, "if-then-else", !ModeInfo, !IO).
@@ -416,9 +416,16 @@
check_goal_2(scope(Reason, SubGoal0), _, scope(Reason, SubGoal),
!ModeInfo, !IO) :-
- mode_checkpoint(enter, "some", !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(yes, !ModeInfo),
check_goal(SubGoal0, SubGoal, !ModeInfo, !IO),
- mode_checkpoint(exit, "some", !ModeInfo, !IO).
+ mode_info_set_in_from_ground_term(WasInFromGroundTerm, !ModeInfo)
+ ;
+ check_goal(SubGoal0, SubGoal, !ModeInfo, !IO)
+ ),
+ mode_checkpoint(exit, "scope", !ModeInfo, !IO).
check_goal_2(generic_call(GenericCall, Args, Modes, Det), _GoalInfo0, Goal,
!ModeInfo, !IO) :-
@@ -481,7 +488,7 @@
Cases0 = [_ | _],
goal_info_get_nonlocals(GoalInfo0, NonLocals),
check_case_list(Cases0, Var, Cases, InstMapList, !ModeInfo, !IO),
- instmap.merge(NonLocals, InstMapList, disj, !ModeInfo)
+ instmap_merge(NonLocals, InstMapList, disj, !ModeInfo)
),
mode_checkpoint(exit, "switch", !ModeInfo, !IO).
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/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/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_glut
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/gears
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/moose/tests
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/solver_types
cvs diff: Diffing extras/solver_types/library
cvs diff: Diffing extras/stream
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/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/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing slice
cvs diff: Diffing tests
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
Index: tests/debugger/breakpoints.exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/debugger/breakpoints.exp,v
retrieving revision 1.13
diff -u -b -r1.13 breakpoints.exp
--- tests/debugger/breakpoints.exp 27 Jan 2005 06:17:37 -0000 1.13
+++ tests/debugger/breakpoints.exp 25 Mar 2006 19:40:55 -0000
@@ -1,4 +1,4 @@
- E1: C1 CALL pred breakpoints.main/2-0 (cc_multi) breakpoints.m:31
+ E1: C1 CALL pred breakpoints.main/2-0 (cc_multi) breakpoints.m:24
mdb> echo on
Command echo enabled.
mdb> register --quiet
@@ -22,7 +22,7 @@
Which do you want to put a breakpoint on (0-1 or *)? 0
0: + stop interface pred breakpoints.data/1-0 (det)
mdb> continue
- E2: C2 CALL pred breakpoints.data/1-0 (det) breakpoints.m:58 (breakpoints.m:56)
+ E2: C2 CALL pred breakpoints.data/1-0 (det) breakpoints.m:58 (breakpoints.m:55)
mdb> disable 0
0: - stop interface pred breakpoints.data/1-0 (det)
mdb> break info
Index: tests/debugger/dice.exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/debugger/dice.exp,v
retrieving revision 1.2
diff -u -b -r1.2 dice.exp
--- tests/debugger/dice.exp 18 Feb 2005 04:05:35 -0000 1.2
+++ tests/debugger/dice.exp 25 Mar 2006 19:41:23 -0000
@@ -18,8 +18,8 @@
pred dice.merge/3-0 <s2;c2;s2;c4;e;> dice.m:74 0 (0) 1 1.00
pred dice.merge_sort/2-0 CALL dice.m:31 3 (3) 1 0.25
pred dice.merge_sort/2-0 EXIT dice.m:31 3 (3) 1 0.25
-pred dice.msort_n/4-0 CALL dice.m:43 19 (3) 7 0.27
-pred dice.msort_n/4-0 EXIT dice.m:43 19 (3) 7 0.27
+pred dice.msort_n/4-0 CALL dice.m:37 19 (3) 7 0.27
+pred dice.msort_n/4-0 EXIT dice.m:37 19 (3) 7 0.27
pred dice.msort_n/4-0 <?;> dice.m:39 19 (3) 7 0.27
pred dice.msort_n/4-0 <e;> dice.m:54 19 (3) 7 0.27
pred dice.msort_n/4-0 <e;?;> dice.m:44 19 (3) 7 0.27
@@ -38,8 +38,8 @@
pred dice.merge/3-0 EXIT dice.m:64 18 (3) 7 0.28
pred dice.merge/3-0 <s1;> dice.m:64 8 (3) 3 0.27
pred dice.msort_n/4-0 <e;e;> dice.m:55 8 (3) 3 0.27
-pred dice.msort_n/4-0 CALL dice.m:43 19 (3) 7 0.27
-pred dice.msort_n/4-0 EXIT dice.m:43 19 (3) 7 0.27
+pred dice.msort_n/4-0 CALL dice.m:37 19 (3) 7 0.27
+pred dice.msort_n/4-0 EXIT dice.m:37 19 (3) 7 0.27
pred dice.msort_n/4-0 <?;> dice.m:39 19 (3) 7 0.27
pred dice.msort_n/4-0 <e;> dice.m:54 19 (3) 7 0.27
pred dice.msort_n/4-0 <e;?;> dice.m:44 19 (3) 7 0.27
@@ -62,8 +62,8 @@
pred dice.merge/3-0 EXIT dice.m:64 18 (3) 7 0.28
pred dice.merge/3-0 <s1;> dice.m:64 8 (3) 3 0.27
pred dice.msort_n/4-0 <e;e;> dice.m:55 8 (3) 3 0.27
-pred dice.msort_n/4-0 CALL dice.m:43 19 (3) 7 0.27
-pred dice.msort_n/4-0 EXIT dice.m:43 19 (3) 7 0.27
+pred dice.msort_n/4-0 CALL dice.m:37 19 (3) 7 0.27
+pred dice.msort_n/4-0 EXIT dice.m:37 19 (3) 7 0.27
pred dice.msort_n/4-0 <?;> dice.m:39 19 (3) 7 0.27
pred dice.msort_n/4-0 <e;> dice.m:54 19 (3) 7 0.27
pred dice.msort_n/4-0 <e;?;> dice.m:44 19 (3) 7 0.27
@@ -78,15 +78,15 @@
pred dice.merge/3-0 <s2;c2;s2;c4;t;> dice.m:71 10 (3) 3 0.23
mdb> dice -n 3 -s P -m dice
Procedure Path/Port File:Line Pass (3) Fail Suspicion
-pred dice.msort_n/4-0 CALL dice.m:43 19 (3) 7 0.27
-pred dice.msort_n/4-0 EXIT dice.m:43 19 (3) 7 0.27
+pred dice.msort_n/4-0 CALL dice.m:37 19 (3) 7 0.27
+pred dice.msort_n/4-0 EXIT dice.m:37 19 (3) 7 0.27
pred dice.msort_n/4-0 <?;> dice.m:39 19 (3) 7 0.27
mdb> dice -s Fp -m dice
Procedure Path/Port File:Line Pass (3) Fail Suspicion
pred dice.merge/3-0 CALL dice.m:64 18 (3) 7 0.28
pred dice.merge/3-0 EXIT dice.m:64 18 (3) 7 0.28
-pred dice.msort_n/4-0 CALL dice.m:43 19 (3) 7 0.27
-pred dice.msort_n/4-0 EXIT dice.m:43 19 (3) 7 0.27
+pred dice.msort_n/4-0 CALL dice.m:37 19 (3) 7 0.27
+pred dice.msort_n/4-0 EXIT dice.m:37 19 (3) 7 0.27
pred dice.msort_n/4-0 <?;> dice.m:39 19 (3) 7 0.27
pred dice.msort_n/4-0 <e;> dice.m:54 19 (3) 7 0.27
pred dice.msort_n/4-0 <e;?;> dice.m:44 19 (3) 7 0.27
Index: tests/debugger/exception_vars.exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/debugger/exception_vars.exp,v
retrieving revision 1.11
diff -u -b -r1.11 exception_vars.exp
--- tests/debugger/exception_vars.exp 16 Nov 2004 00:16:38 -0000 1.11
+++ tests/debugger/exception_vars.exp 25 Mar 2006 19:41:37 -0000
@@ -2,7 +2,7 @@
mdb> echo on
Command echo enabled.
mdb> goto 2
- E2: C2 CALL pred exception_vars.test/2-0 (det) exception_vars.m:19 (exception_vars.m:12)
+ E2: C2 CALL pred exception_vars.test/2-0 (det) exception_vars.m:16 (exception_vars.m:12)
mdb> finish
E3: C2 EXCP pred exception_vars.test/2-0 (det)
mdb> print *
Index: tests/debugger/label_layout.exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/debugger/label_layout.exp,v
retrieving revision 1.2
diff -u -b -r1.2 label_layout.exp
--- tests/debugger/label_layout.exp 4 Feb 2003 23:29:23 -0000 1.2
+++ tests/debugger/label_layout.exp 25 Mar 2006 19:42:20 -0000
@@ -1,4 +1,4 @@
- 1: 1 1 CALL pred label_layout.main/2-0 (det) label_layout.m:18
+ 1: 1 1 CALL pred label_layout.main/2-0 (det) label_layout.m:8
mdb> echo on
Command echo enabled.
mdb> register --quiet
Index: tests/debugger/loopcheck.exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/debugger/loopcheck.exp,v
retrieving revision 1.9
diff -u -b -r1.9 loopcheck.exp
--- tests/debugger/loopcheck.exp 31 May 2004 04:13:15 -0000 1.9
+++ tests/debugger/loopcheck.exp 25 Mar 2006 19:42:28 -0000
@@ -5,13 +5,13 @@
Contexts will be printed on the next line.
mdb> continue -a
2: 2 2 CALL pred loopcheck.loop/1-0 (det)
- loopcheck.m:21 (from loopcheck.m:14)
+ loopcheck.m:20 (from loopcheck.m:14)
3: 3 3 CALL pred loopcheck.loop/1-0 (det)
- loopcheck.m:21 (from loopcheck.m:21)
+ loopcheck.m:20 (from loopcheck.m:20)
4: 3 3 EXCP pred loopcheck.loop/1-0 (det)
- loopcheck.m:21 (from loopcheck.m:21)
+ loopcheck.m:20 (from loopcheck.m:20)
5: 2 2 EXCP pred loopcheck.loop/1-0 (det)
- loopcheck.m:21 (from loopcheck.m:14)
+ loopcheck.m:20 (from loopcheck.m:14)
6: 1 1 EXCP pred loopcheck.main/2-0 (det)
loopcheck.m:14
Uncaught Mercury exception:
Index: tests/debugger/queens.exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/debugger/queens.exp,v
retrieving revision 1.31
diff -u -b -r1.31 queens.exp
--- tests/debugger/queens.exp 11 Jul 2005 07:30:28 -0000 1.31
+++ tests/debugger/queens.exp 25 Mar 2006 19:44:28 -0000
@@ -1,4 +1,4 @@
- E1: C1 CALL pred queens.main/2-0 (cc_multi) queens.m:17
+ E1: C1 CALL pred queens.main/2-0 (cc_multi) queens.m:14
mdb> echo on
Command echo enabled.
mdb> register --quiet
@@ -356,12 +356,12 @@
0: + stop interface pred queens.main/2-0 (cc_multi)
mdb> continue -n
[1, 3, 5, 2, 4]
- E60: C1 EXIT queens.m:17
+ E60: C1 EXIT queens.m:14
pred queens.main/2-0 (cc_multi)
mdb> retry
Retry across I/O operations is not always safe.
Are you sure you want to do it? yes
- E1: C1 CALL queens.m:17
+ E1: C1 CALL queens.m:14
pred queens.main/2-0 (cc_multi)
mdb> continue -n -S
[1, 3, 5, 2, 4]
Index: tests/debugger/queens_rep.exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/debugger/queens_rep.exp,v
retrieving revision 1.3
diff -u -b -r1.3 queens_rep.exp
--- tests/debugger/queens_rep.exp 17 Jan 2003 05:56:56 -0000 1.3
+++ tests/debugger/queens_rep.exp 25 Mar 2006 19:43:10 -0000
@@ -1,4 +1,4 @@
- 1: 1 1 CALL pred queens_rep.main/2-0 (cc_multi) queens_rep.m:17
+ 1: 1 1 CALL pred queens_rep.main/2-0 (cc_multi) queens_rep.m:14
mdb> echo on
Command echo enabled.
mdb> context none
Index: tests/debugger/shallow.exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/debugger/shallow.exp,v
retrieving revision 1.6
diff -u -b -r1.6 shallow.exp
--- tests/debugger/shallow.exp 17 Jan 2003 05:56:56 -0000 1.6
+++ tests/debugger/shallow.exp 25 Mar 2006 19:43:51 -0000
@@ -1,4 +1,4 @@
- 1: 1 1 CALL pred shallow.main/2-0 (cc_multi) shallow.m:18
+ 1: 1 1 CALL pred shallow.main/2-0 (cc_multi) shallow.m:15
mdb> echo on
Command echo enabled.
mdb> context before
cvs diff: Diffing tests/debugger/declarative
Index: tests/debugger/declarative/aadebug.exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/debugger/declarative/aadebug.exp,v
retrieving revision 1.12
diff -u -b -r1.12 aadebug.exp
--- tests/debugger/declarative/aadebug.exp 20 May 2005 05:40:20 -0000 1.12
+++ tests/debugger/declarative/aadebug.exp 25 Mar 2006 19:44:58 -0000
@@ -1,4 +1,4 @@
- E1: C1 CALL pred aadebug.main/2-0 (det) aadebug.m:11
+ E1: C1 CALL pred aadebug.main/2-0 (det) aadebug.m:8
mdb> echo on
Command echo enabled.
mdb> register --quiet
Index: tests/debugger/declarative/backtrack.exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/debugger/declarative/backtrack.exp,v
retrieving revision 1.9
diff -u -b -r1.9 backtrack.exp
--- tests/debugger/declarative/backtrack.exp 20 May 2005 05:40:20 -0000 1.9
+++ tests/debugger/declarative/backtrack.exp 25 Mar 2006 19:45:14 -0000
@@ -5,9 +5,9 @@
mdb> break p
0: + stop interface pred backtrack.p/2-0 (det)
mdb> continue
- 2: 2 2 CALL pred backtrack.p/2-0 (det) backtrack.m:24 (backtrack.m:10)
+ 2: 2 2 CALL pred backtrack.p/2-0 (det) backtrack.m:16 (backtrack.m:10)
mdb> finish
- 23: 2 2 EXIT pred backtrack.p/2-0 (det) backtrack.m:24 (backtrack.m:10)
+ 23: 2 2 EXIT pred backtrack.p/2-0 (det) backtrack.m:16 (backtrack.m:10)
mdb> dd -d 3 -n 7
p(1, no)
Valid? no
@@ -32,6 +32,6 @@
Found incorrect contour:
p(1, no)
Is this a bug? yes
- 23: 2 2 EXIT pred backtrack.p/2-0 (det) backtrack.m:24 (backtrack.m:10)
+ 23: 2 2 EXIT pred backtrack.p/2-0 (det) backtrack.m:16 (backtrack.m:10)
mdb> continue
no
Index: tests/debugger/declarative/browser_mode.exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/debugger/declarative/browser_mode.exp,v
retrieving revision 1.4
diff -u -b -r1.4 browser_mode.exp
--- tests/debugger/declarative/browser_mode.exp 20 May 2005 05:40:21 -0000 1.4
+++ tests/debugger/declarative/browser_mode.exp 25 Mar 2006 19:45:29 -0000
@@ -1,4 +1,4 @@
- E1: C1 CALL pred browser_mode.main/2-0 (det) browser_mode.m:11
+ E1: C1 CALL pred browser_mode.main/2-0 (det) browser_mode.m:8
mdb> mdb> Contexts will not be printed.
mdb> echo on
Command echo enabled.
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/string_format
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/grade_subdirs
cvs diff: Diffing tests/hard_coded
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/mmc_make
cvs diff: Diffing tests/mmc_make/lib
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/trailing
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
cvs diff: Diffing util
cvs diff: Diffing vim
cvs diff: Diffing vim/after
cvs diff: Diffing vim/ftplugin
cvs diff: Diffing vim/syntax
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list