[m-rev.] for review: fix some problems with erlang code generator
Peter Wang
wangp at students.csse.unimelb.edu.au
Fri Jun 1 13:08:45 AEST 2007
Estimated hours taken: 15
Branches: main
Fix some problems with the Erlang code generator.
One problem was that success expressions which got duplicated into different
branches of a conditional statement could contain assignments to local
variables (which the Erlang compiler could warn about in some cases). We now
rename apart these variables when success expressions are duplicated.
Another problem was that we were duplicating large success expressions into
branches of an if-then-else. We now handle this as we do for disjunctions and
switches, by inserting calls to a closure containing the success expression
rather than the success expression itself.
The third problem occurred when a conditional branch contained an erroneous
goal that bound a variable. In Mercury, if a different, non-erroneous, branch
was taken then the same variable could be bound later. However, the Erlang
compiler would declare the code we generated unsafe because it does not know
which procedures will throw exceptions. We fix this by renaming away variables
which are assigned in erroneous goals.
compiler/erl_code_gen.m:
Fix the problems described above.
Reenable duplication of small success exceptions.
compiler/erl_code_util.m:
Add `erl_fix_success_expr' that renames apart local variables in a
success expression.
Add `erl_rename_vars_in_expr_except' to rename apart all variables in
an ELDS expression _except_ those listed.
Add `erl_expr_vars' which returns the set of variables appearing in an
ELDS expression.
Make `erl_create_renaming' give names to new variables based on the old
variable names.
compiler/elds.m:
Add `maybe_join_exprs1' utility predicate.
compiler/instmap.m:
Add predicate `instmap_bound_vars' to return variables in an instmap
which are bound.
Index: compiler/elds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/elds.m,v
retrieving revision 1.7
diff -u -r1.7 elds.m
--- compiler/elds.m 1 Jun 2007 02:12:58 -0000 1.7
+++ compiler/elds.m 1 Jun 2007 02:39:08 -0000
@@ -306,6 +306,13 @@
%
:- func maybe_join_exprs(elds_expr, maybe(elds_expr)) = elds_expr.
+ % maybe_join_exprs1(MaybeExprA, ExprB)
+ %
+ % Join ExprA and ExprB as above if MaybeExprA = `yes(ExprA)',
+ % otherwise return ExprB.
+ %
+:- func maybe_join_exprs1(maybe(elds_expr), elds_expr) = elds_expr.
+
% expr_or_void(MaybeExpr)
%
% Return `E' if MaybeExpr is `yes(E)', otherwise return any constant
@@ -399,6 +406,9 @@
maybe_join_exprs(ExprA, yes(ExprB)) = join_exprs(ExprA, ExprB).
maybe_join_exprs(Expr, no) = Expr.
+maybe_join_exprs1(yes(ExprA), ExprB) = join_exprs(ExprA, ExprB).
+maybe_join_exprs1(no, Expr) = Expr.
+
expr_or_void(yes(Expr)) = Expr.
expr_or_void(no) = elds_term(elds_atom_raw("void")).
Index: compiler/erl_code_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/erl_code_gen.m,v
retrieving revision 1.5
diff -u -r1.5 erl_code_gen.m
--- compiler/erl_code_gen.m 30 May 2007 05:15:04 -0000 1.5
+++ compiler/erl_code_gen.m 1 Jun 2007 02:39:08 -0000
@@ -257,7 +257,8 @@
%
% On success, the procedure returns a tuple of its output variables.
%
- SuccessExpr = elds_term(elds_tuple(OutputVarsExprs))
+ SuccessExpr = elds_term(elds_tuple(OutputVarsExprs)),
+ InstMap = InstMap0
;
CodeModel = model_non,
%
@@ -266,12 +267,12 @@
% an extra argument to the current procedure.
%
erl_gen_info_new_named_var("SucceedHeadVar", SucceedVar, !Info),
+ ground_var_in_instmap(SucceedVar, InstMap0, InstMap),
InputVarsTerms = terms_from_vars(InputVars ++ [SucceedVar]),
SuccessExpr = elds_call(elds_call_ho(expr_from_var(SucceedVar)),
OutputVarsExprs)
),
- erl_gen_goal(CodeModel, InstMap0, Goal, yes(SuccessExpr), Statement,
- !Info),
+ erl_gen_goal(CodeModel, InstMap, Goal, yes(SuccessExpr), Statement, !Info),
ProcClause = elds_clause(InputVarsTerms, Statement).
%-----------------------------------------------------------------------------%
@@ -493,11 +494,11 @@
erl_gen_negation(Goal, CodeModel, InstMap, Context, MaybeSuccessExpr,
Statement, !Info).
-erl_gen_goal_expr(conj(_ConjType, Goals), CodeModel, _Detism, InstMap, Context,
+erl_gen_goal_expr(conj(_ConjType, Goals), CodeModel, Detism, InstMap, Context,
MaybeSuccessExpr, Statement, !Info) :-
% XXX Currently we treat parallel conjunction the same as
% sequential conjunction -- parallelism is not yet implemented.
- erl_gen_conj(Goals, CodeModel, InstMap, Context, MaybeSuccessExpr,
+ erl_gen_conj(Goals, CodeModel, Detism, InstMap, Context, MaybeSuccessExpr,
Statement, !Info).
erl_gen_goal_expr(disj(Goals), CodeModel, _Detism, InstMap, Context,
@@ -568,19 +569,13 @@
:- func duplicate_expr_limit = int.
- % XXX duplicating expressions into branches of disjunctions and switches
- % is currently disabled. The problem is that the duplicated expression
- % may bind local variables. These would need to be renamed apart when
- % the expression is duplicated.
- %
-duplicate_expr_limit = 0.
-%duplicate_expr_limit = 10. % XXX arbitrary
+duplicate_expr_limit = 10. % XXX arbitrary
:- pred erl_gen_switch(prog_var::in, can_fail::in, list(hlds_goal.case)::in,
code_model::in, instmap::in, prog_context::in, maybe(elds_expr)::in,
elds_expr::out, erl_gen_info::in, erl_gen_info::out) is det.
-erl_gen_switch(Var, CanFail, CasesList, CodeModel, InstMap, _Context,
+erl_gen_switch(Var, CanFail, CasesList, CodeModel, InstMap0, _Context,
MaybeSuccessExpr0, Statement, !Info) :-
%
% If the success expression is not too big, then we generate code for
@@ -613,13 +608,14 @@
% Get the union of all nonlocal variables bound in all cases.
erl_gen_info_get_module_info(!.Info, ModuleInfo),
CasesGoals = list.map((func(case(_, Goal)) = Goal), CasesList),
- union_bound_nonlocals_in_goals(ModuleInfo, InstMap, CasesGoals,
+ union_bound_nonlocals_in_goals(ModuleInfo, InstMap0, CasesGoals,
NonLocalsBoundInCases),
% Create a closure for the success expression if it is too large to
% duplicate into the disjuncts.
maybe_create_closure_for_success_expr(NonLocalsBoundInCases,
- MaybeSuccessExpr0, MaybeMakeClosure, MaybeSuccessExpr, !Info),
+ MaybeSuccessExpr0, MaybeMakeClosure, MaybeSuccessExpr,
+ InstMap0, InstMap, !Info),
% Generate code for each case.
list.map_foldl(erl_gen_case(CodeModel, InstMap, NonLocalsBoundInCases,
@@ -636,13 +632,7 @@
% Create the overall switch statement,.
CaseExpr = elds_case_expr(expr_from_var(Var), ErlCases),
- (
- MaybeMakeClosure = yes(MakeClosure1),
- Statement = join_exprs(MakeClosure1, CaseExpr)
- ;
- MaybeMakeClosure = no,
- Statement = CaseExpr
- ).
+ Statement = maybe_join_exprs1(MaybeMakeClosure, CaseExpr).
:- pred erl_gen_case(code_model::in, instmap::in, set(prog_var)::in,
maybe(elds_expr)::in, hlds_goal.case::in, elds_case::out,
@@ -661,7 +651,9 @@
;
unexpected(this_file, "erl_gen_case: cannot pattern match on object")
),
- erl_gen_goal(CodeModel, InstMap, Goal, MaybeSuccessExpr, Statement0,
+ erl_fix_success_expr(InstMap, Goal, MaybeSuccessExpr,
+ MaybeSuccessExprForCase, !Info),
+ erl_gen_goal(CodeModel, InstMap, Goal, MaybeSuccessExprForCase, Statement0,
!Info),
%
% To prevent warnings from the Erlang compiler we must make sure all cases
@@ -684,17 +676,23 @@
list.map(IsBound, Goals, NonLocalsLists),
NonLocalsUnion = set.union_list(NonLocalsLists).
+ % If a success expression is too large to duplicate but is required after
+ % two or more goals Gs, we generate a closure C containing the success
+ % expression which takes the nonlocal variables bound by Gs as arguments.
+ % Then we generate the code for Gs such that they call C on success.
+ %
:- pred maybe_create_closure_for_success_expr(set(prog_var)::in,
maybe(elds_expr)::in, maybe(elds_expr)::out, maybe(elds_expr)::out,
- erl_gen_info::in, erl_gen_info::out) is det.
+ instmap::in, instmap::out, erl_gen_info::in, erl_gen_info::out) is det.
maybe_create_closure_for_success_expr(NonLocals, MaybeSuccessExpr0,
- MaybeMakeClosure, MaybeSuccessExpr, !Info) :-
+ MaybeMakeClosure, MaybeSuccessExpr, InstMap0, InstMap, !Info) :-
(if
MaybeSuccessExpr0 = yes(SuccessExpr0),
erl_expr_size(SuccessExpr0) > duplicate_expr_limit
then
erl_gen_info_new_named_var("SuccessClosure", ClosureVar, !Info),
+ ground_var_in_instmap(ClosureVar, InstMap0, InstMap),
ClosureVarExpr = expr_from_var(ClosureVar),
ClosureArgs0 = set.to_sorted_list(NonLocals),
@@ -717,6 +715,7 @@
MaybeMakeClosure = yes(MakeClosure),
MaybeSuccessExpr = yes(CallClosure)
else
+ InstMap = InstMap0,
MaybeMakeClosure = no,
MaybeSuccessExpr = MaybeSuccessExpr0
).
@@ -726,6 +725,17 @@
non_dummy_var(ModuleInfo, Var, Type) = Var :-
not is_dummy_argument_type(ModuleInfo, Type).
+:- pred ground_var_in_instmap(prog_var::in, instmap::in, instmap::out) is det.
+
+ground_var_in_instmap(Var, !InstMap) :-
+ % Sometimes we introduce variables which aren't in the HLDS, but which need
+ % to be in an instmap so that they don't get renamed away (when we
+ % duplicate success expressions, we rename away all variables which were
+ % not bound before the place where the success expression will be
+ % inserted). For our purposes it doesn't matter what insts these variables
+ % have, other than not being free, so we just use `ground'.
+ instmap.set(Var, ground(shared, none), !InstMap).
+
%-----------------------------------------------------------------------------%
%
% Code for if-then-else
@@ -736,7 +746,7 @@
prog_context::in, maybe(elds_expr)::in, elds_expr::out,
erl_gen_info::in, erl_gen_info::out) is det.
-erl_gen_ite(CodeModel, InstMap0, Cond, Then, Else, _Context, MaybeSuccessExpr,
+erl_gen_ite(CodeModel, InstMap0, Cond, Then, Else, _Context, MaybeSuccessExpr0,
Statement, !Info) :-
Cond = hlds_goal(_, CondGoalInfo),
goal_info_get_code_model(CondGoalInfo, CondCodeModel),
@@ -755,7 +765,7 @@
Statement = CondStatement
;
update_instmap(Cond, InstMap0, CondInstMap),
- erl_gen_goal(CodeModel, CondInstMap, Then, MaybeSuccessExpr,
+ erl_gen_goal(CodeModel, CondInstMap, Then, MaybeSuccessExpr0,
ThenStatement, !Info),
Statement = join_exprs(CondStatement, ThenStatement)
)
@@ -779,38 +789,49 @@
CondCodeModel = model_semi,
% Find the non-local variables bound in the condition.
+ % The instmap before Then should really be
+ % InstMap0 + instmap_delta(Cond) but this is okay.
erl_gen_info_get_module_info(!.Info, ModuleInfo),
- erl_bound_nonlocals_in_goal(ModuleInfo, InstMap0, Cond, CondVarsSet),
- CondVars = set.to_sorted_list(CondVarsSet),
+ erl_bound_nonlocals_in_goal(ModuleInfo, InstMap0, Cond, CondVars),
+ erl_bound_nonlocals_in_goal(ModuleInfo, InstMap0, Then, ThenVars),
+ erl_bound_nonlocals_in_goal(ModuleInfo, InstMap0, Else, ElseVars),
+ CondVarsList = set.to_sorted_list(CondVars),
% Generate the condition goal, making it evaluate to a tuple of the
% non-local variables that it binds on success.
- CondVarsTerm = elds_tuple(exprs_from_vars(CondVars)),
+ CondVarsTerm = elds_tuple(exprs_from_vars(CondVarsList)),
erl_gen_goal(model_semi, InstMap0, Cond,
yes(elds_term(CondVarsTerm)), CondStatement0, !Info),
% Rename the variables in the generated condition expression.
- erl_create_renaming(CondVars, Subn, !Info),
+ erl_create_renaming(CondVarsList, Subn, !Info),
erl_rename_vars_in_expr(Subn, CondStatement0, CondStatement),
+ % Create a closure for the success expression if it is too large to
+ % duplicate into the branches.
+ % (InstMap1 = InstMap0 + optionally a variable bound to a closure)
+ BoundNonLocals = set.union_list([CondVars, ThenVars, ElseVars]),
+ maybe_create_closure_for_success_expr(BoundNonLocals,
+ MaybeSuccessExpr0, MaybeMakeClosure, MaybeSuccessExpr,
+ InstMap0, InstMap1, !Info),
+
% Generate the Then and Else branches.
- update_instmap(Cond, InstMap0, InstMap1),
- erl_gen_goal(CodeModel, InstMap1, Then, MaybeSuccessExpr,
+ update_instmap(Cond, InstMap1, InstMap2),
+ erl_gen_goal(CodeModel, InstMap2, Then, MaybeSuccessExpr,
ThenStatement0, !Info),
- erl_gen_goal(CodeModel, InstMap0, Else, MaybeSuccessExpr,
+ erl_gen_goal(CodeModel, InstMap1, Else, MaybeSuccessExpr,
ElseStatement0, !Info),
% Make sure both branches bind the same sets of variables.
- erl_bound_nonlocals_in_goal(ModuleInfo, InstMap1, Then, ThenVars),
- erl_bound_nonlocals_in_goal(ModuleInfo, InstMap0, Else, ElseVars),
erl_bind_unbound_vars(ModuleInfo, ElseVars, Then, InstMap1,
ThenStatement0, ThenStatement),
erl_bind_unbound_vars(ModuleInfo, ThenVars, Else, InstMap0,
ElseStatement0, ElseStatement),
- Statement = elds_case_expr(CondStatement, [TrueCase, FalseCase]),
+ IfStatement = elds_case_expr(CondStatement, [TrueCase, FalseCase]),
TrueCase = elds_case(CondVarsTerm, ThenStatement),
- FalseCase = elds_case(elds_anon_var, ElseStatement)
+ FalseCase = elds_case(elds_anon_var, ElseStatement),
+ Statement = maybe_join_exprs1(MaybeMakeClosure, IfStatement)
;
CondCodeModel = model_non,
%
@@ -833,21 +854,27 @@
%
erl_gen_info_new_named_var("Ref", Ref, !Info),
+ ground_var_in_instmap(Ref, InstMap0, InstMap1),
+
RefExpr = expr_from_var(Ref),
MakeRef = elds_eq(RefExpr, elds_call_builtin("make_ref", [])),
PutRef = elds_call_builtin("put", [RefExpr, elds_term(elds_true)]),
GetRef = elds_call_builtin("get", [RefExpr]),
EraseRef = elds_call_builtin("erase", [RefExpr]),
- update_instmap(Cond, InstMap0, InstMap1),
- erl_gen_goal(CodeModel, InstMap1, Then, MaybeSuccessExpr,
+ % Due to the way we generate code for model_non conjunctions, the
+ % success expression at this point should not be too large to
+ % duplicate.
+
+ update_instmap(Cond, InstMap1, InstMap2),
+ erl_gen_goal(CodeModel, InstMap2, Then, MaybeSuccessExpr0,
ThenStatement, !Info),
PutAndThen = join_exprs(PutRef, ThenStatement),
- erl_gen_goal(CondCodeModel, InstMap0, Cond, yes(PutAndThen),
+ erl_gen_goal(CondCodeModel, InstMap1, Cond, yes(PutAndThen),
CondThen, !Info),
- erl_gen_goal(CodeModel, InstMap0, Else, MaybeSuccessExpr,
+ erl_gen_goal(CodeModel, InstMap1, Else, MaybeSuccessExpr0,
ElseStatement, !Info),
CaseElse = elds_case_expr(GetRef, [TrueCase, OtherCase]),
@@ -930,11 +957,34 @@
% Code for conjunctions
%
-:- pred erl_gen_conj(hlds_goals::in, code_model::in, instmap::in,
+:- pred erl_gen_conj(hlds_goals::in, code_model::in, determinism::in,
+ instmap::in, prog_context::in, maybe(elds_expr)::in, elds_expr::out,
+ erl_gen_info::in, erl_gen_info::out) is det.
+
+erl_gen_conj(Goals, CodeModel, Detism, InstMap, Context, MaybeSuccessExpr,
+ Statement, !Info) :-
+ erl_gen_conj_2(Goals, CodeModel, InstMap, Context, MaybeSuccessExpr,
+ Statement0, !Info),
+ ( Detism = detism_erroneous ->
+ % This conjunction may be part of a conditional statement, in which
+ % this branch binds some variables Vars before throwing an exception.
+ % Another, non-erroneous, branch might not bind those Vars, leaving
+ % them to be bound after the conditional statement. We rename away the
+ % variables bound in this branch so that the Erlang compiler won't
+ % complain about variables not being bound in all branches of a
+ % conditional statement.
+ erl_gen_info_get_module_info(!.Info, ModuleInfo),
+ instmap_bound_vars(InstMap, ModuleInfo, BoundVars),
+ erl_rename_vars_in_expr_except(BoundVars, Statement0, Statement, !Info)
+ ;
+ Statement = Statement0
+ ).
+
+:- pred erl_gen_conj_2(hlds_goals::in, code_model::in, instmap::in,
prog_context::in, maybe(elds_expr)::in, elds_expr::out,
erl_gen_info::in, erl_gen_info::out) is det.
-erl_gen_conj([], CodeModel, _InstMap0, _Context, MaybeSuccessExpr,
+erl_gen_conj_2([], CodeModel, _InstMap0, _Context, MaybeSuccessExpr,
Statement, !Info) :-
(
CodeModel = model_det,
@@ -945,11 +995,11 @@
),
Statement = det_expr(MaybeSuccessExpr)
).
-erl_gen_conj([SingleGoal], CodeModel, InstMap0, _Context, MaybeSuccessExpr,
+erl_gen_conj_2([SingleGoal], CodeModel, InstMap0, _Context, MaybeSuccessExpr,
Statement, !Info) :-
erl_gen_goal(CodeModel, InstMap0, SingleGoal, MaybeSuccessExpr,
Statement, !Info).
-erl_gen_conj([First | Rest], CodeModel, InstMap0, Context, MaybeSuccessExpr,
+erl_gen_conj_2([First | Rest], CodeModel, InstMap0, Context, MaybeSuccessExpr,
Statement, !Info) :-
Rest = [_ | _],
First = hlds_goal(_, FirstGoalInfo),
@@ -972,8 +1022,8 @@
%
erl_gen_goal(model_det, InstMap0, First, no,
FirstStatement, !Info),
- erl_gen_conj(Rest, CodeModel, InstMap1, Context, MaybeSuccessExpr,
- RestStatement, !Info),
+ erl_gen_conj_2(Rest, CodeModel, InstMap1, Context,
+ MaybeSuccessExpr, RestStatement, !Info),
Statement = join_exprs(FirstStatement, RestStatement)
;
FirstCodeModel = model_semi,
@@ -988,8 +1038,8 @@
% fail
% end
%
- erl_gen_conj(Rest, CodeModel, InstMap1, Context, MaybeSuccessExpr,
- RestStatement, !Info),
+ erl_gen_conj_2(Rest, CodeModel, InstMap1, Context,
+ MaybeSuccessExpr, RestStatement, !Info),
erl_gen_goal(model_semi, InstMap0, First, yes(RestStatement),
Statement, !Info)
;
@@ -1005,8 +1055,8 @@
%
% Generate the code for Rest.
- erl_gen_conj(Rest, CodeModel, InstMap1, Context, MaybeSuccessExpr,
- RestStatement, !Info),
+ erl_gen_conj_2(Rest, CodeModel, InstMap1, Context,
+ MaybeSuccessExpr, RestStatement, !Info),
% Find the variables bound by First.
erl_gen_info_get_module_info(!.Info, ModuleInfo),
@@ -1024,6 +1074,8 @@
% MakeSucceed == "SucceedConj = fun(...) -> ... end "
% CallSucceed == "SucceedConj(...)"
erl_gen_info_new_named_var("SucceedConj", SucceedVar, !Info),
+ ground_var_in_instmap(SucceedVar, InstMap0, InstMap),
+
SucceedVarExpr = expr_from_var(SucceedVar),
MakeSucceed = elds_eq(SucceedVarExpr, SucceedFunc),
CallSucceed = elds_call(elds_call_ho(SucceedVarExpr),
@@ -1031,7 +1083,7 @@
% Generate the code for First, such that it calls the success
% continuation on success.
- erl_gen_goal(model_non, InstMap0, First, yes(CallSucceed),
+ erl_gen_goal(model_non, InstMap, First, yes(CallSucceed),
FirstStatement, !Info),
Statement = join_exprs(MakeSucceed, FirstStatement)
@@ -1066,29 +1118,24 @@
erl_gen_goal(CodeModel, InstMap, SingleGoal, MaybeSuccessExpr,
Statement, !Info).
-erl_gen_disj([First | Rest], CodeModel, InstMap, Context, MaybeSuccessExpr0,
+erl_gen_disj([First | Rest], CodeModel, InstMap0, Context, MaybeSuccessExpr0,
Statement, !Info) :-
Rest = [_ | _],
% Get the union of all nonlocal variables bound in all disjuncts.
erl_gen_info_get_module_info(!.Info, ModuleInfo),
- union_bound_nonlocals_in_goals(ModuleInfo, InstMap, [First | Rest],
+ union_bound_nonlocals_in_goals(ModuleInfo, InstMap0, [First | Rest],
NonLocalsBoundInGoals),
% Create a closure for the success expression if it is too large to
% duplicate into the disjuncts.
maybe_create_closure_for_success_expr(NonLocalsBoundInGoals,
- MaybeSuccessExpr0, MaybeMakeClosure, MaybeSuccessExpr, !Info),
+ MaybeSuccessExpr0, MaybeMakeClosure, MaybeSuccessExpr,
+ InstMap0, InstMap, !Info),
erl_gen_disjunct([First | Rest], CodeModel, InstMap, Context,
MaybeSuccessExpr, DisjStatement, !Info),
- (
- MaybeMakeClosure = no,
- Statement = DisjStatement
- ;
- MaybeMakeClosure = yes(MakeClosure1),
- Statement = join_exprs(MakeClosure1, DisjStatement)
- ).
+ Statement = maybe_join_exprs1(MaybeMakeClosure, DisjStatement).
:- pred erl_gen_disjunct(hlds_goals::in, code_model::in, instmap::in,
prog_context::in, maybe(elds_expr)::in, elds_expr::out,
@@ -1140,7 +1187,9 @@
goal_info_get_determinism(FirstGoalInfo, FirstDeterminism),
(
FirstCodeModel = model_det,
- erl_gen_goal(model_det, InstMap, First, MaybeSuccessExpr,
+ erl_fix_success_expr(InstMap, First, MaybeSuccessExpr,
+ MaybeSuccessExprForFirst, !Info),
+ erl_gen_goal(model_det, InstMap, First, MaybeSuccessExprForFirst,
Statement, !Info)
;
FirstCodeModel = model_semi,
@@ -1150,8 +1199,10 @@
% model_semi first goal. It doesn't matter what the value is,
% otherwise MaybeSuccessExpr wouldn't have been `no'.
%
- SuccessExpr = expr_or_void(MaybeSuccessExpr),
- erl_gen_goal(model_semi, InstMap, First, yes(SuccessExpr),
+ erl_fix_success_expr(InstMap, First, MaybeSuccessExpr,
+ MaybeSuccessExprForFirst, !Info),
+ SuccessExprFirst = expr_or_void(MaybeSuccessExprForFirst),
+ erl_gen_goal(model_semi, InstMap, First, yes(SuccessExprFirst),
FirstStatement0, !Info),
erl_gen_disjunct(Rest, CodeModel, InstMap, Context,
MaybeSuccessExpr, RestStatement, !Info),
@@ -1202,7 +1253,9 @@
% Generate the first disjunct, renaming apart variables bound by it.
% Otherwise the second and later disjuncts would try to bind the same
% variables to different values.
- erl_gen_goal(model_non, InstMap, First, MaybeSuccessExpr,
+ erl_fix_success_expr(InstMap, First, MaybeSuccessExpr,
+ MaybeSuccessExprForFirst, !Info),
+ erl_gen_goal(model_non, InstMap, First, MaybeSuccessExprForFirst,
FirstStatement0, !Info),
erl_gen_info_get_module_info(!.Info, ModuleInfo),
Index: compiler/erl_code_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/erl_code_util.m,v
retrieving revision 1.4
diff -u -r1.4 erl_code_util.m
--- compiler/erl_code_util.m 28 May 2007 03:13:51 -0000 1.4
+++ compiler/erl_code_util.m 1 Jun 2007 02:39:08 -0000
@@ -25,6 +25,7 @@
:- import_module parse_tree.prog_data.
:- import_module list.
+:- import_module maybe.
:- import_module set.
%-----------------------------------------------------------------------------%
@@ -102,6 +103,21 @@
list(T)::in, list(mer_type)::in, list(arg_mode)::in,
list(T)::out, list(T)::out) is det.
+ % erl_fix_success_expr(InstMap, Goal, MaybeExpr0, MaybeExpr, !Info)
+ %
+ % Success expressions may contain assignments. Assignments to local
+ % variables may be incorrect or raise warnings from the Erlang compiler if
+ % a success expression is duplicated. Hence we rename away local variables
+ % when duplicating a success expression.
+ %
+ % This predicate renames any local variables appearing in the success
+ % expression (if any) to fresh variables, where local variables are those
+ % which are not bound in InstMap and not bound within Goal.
+ %
+:- pred erl_fix_success_expr(instmap::in, hlds_goal::in,
+ maybe(elds_expr)::in, maybe(elds_expr)::out,
+ erl_gen_info::in, erl_gen_info::out) is det.
+
% Return the set of variables non-local to a goal which are bound
% by that goal.
%
@@ -138,6 +154,20 @@
:- pred erl_rename_vars_in_expr(prog_var_renaming::in,
elds_expr::in, elds_expr::out) is det.
+ % erl_rename_vars_in_expr_except(KeepVars, Expr0, Expr, !Info):
+ %
+ % Rename all variables in Expr0 to fresh variables, except for the
+ % variables in the set KeepVars.
+ %
+:- pred erl_rename_vars_in_expr_except(set(prog_var)::in,
+ elds_expr::in, elds_expr::out, erl_gen_info::in, erl_gen_info::out) is det.
+
+ % erl_expr_vars(Expr, Vars)
+ %
+ % Vars is the set of variables appearing in Expr.
+ %
+:- pred erl_expr_vars(elds_expr::in, set(prog_var)::out) is det.
+
% Return a rough indication of the "size" of an expression, where each
% simple constant has a value of 1. This is used to decide if an
% expression is too big to duplicate.
@@ -152,13 +182,16 @@
:- implementation.
+:- import_module check_hlds.inst_match.
:- import_module check_hlds.mode_util.
:- import_module check_hlds.type_util.
:- import_module libs.compiler_util.
:- import_module int.
:- import_module map.
+:- import_module pair.
:- import_module set.
+:- import_module svset.
:- import_module term.
:- import_module varset.
@@ -304,6 +337,21 @@
%-----------------------------------------------------------------------------%
+erl_fix_success_expr(InstMap0, Goal, MaybeExpr0, MaybeExpr, !Info) :-
+ (
+ MaybeExpr0 = yes(Expr0),
+ erl_gen_info_get_module_info(!.Info, ModuleInfo),
+ update_instmap(Goal, InstMap0, InstMap),
+ instmap_bound_vars(InstMap, ModuleInfo, BoundVars),
+ erl_rename_vars_in_expr_except(BoundVars, Expr0, Expr, !Info),
+ MaybeExpr = yes(Expr)
+ ;
+ MaybeExpr0 = no,
+ MaybeExpr = no
+ ).
+
+%-----------------------------------------------------------------------------%
+
erl_bound_nonlocals_in_goal(ModuleInfo, InstMap, Goal, BoundNonLocals) :-
Goal = hlds_goal(_, GoalInfo),
goal_info_get_nonlocals(GoalInfo, NonLocals),
@@ -327,8 +375,20 @@
%-----------------------------------------------------------------------------%
erl_create_renaming(Vars, Subst, !Info) :-
- erl_gen_info_new_vars(list.length(Vars), NewVars, !Info),
- map.from_corresponding_lists(Vars, NewVars, Subst).
+ erl_gen_info_get_varset(!.Info, VarSet0),
+ list.foldl2(erl_create_renaming_2, Vars, VarSet0, VarSet, map.init, Subst),
+ erl_gen_info_set_varset(VarSet, !Info).
+
+:- pred erl_create_renaming_2(prog_var::in, prog_varset::in, prog_varset::out,
+ prog_var_renaming::in, prog_var_renaming::out) is det.
+
+erl_create_renaming_2(OldVar, VarSet0, VarSet, !Subst) :-
+ ( varset.search_name(VarSet0, OldVar, Name) ->
+ varset.new_named_var(VarSet0, Name, NewVar, VarSet)
+ ;
+ varset.new_var(VarSet0, NewVar, VarSet)
+ ),
+ map.det_insert(!.Subst, OldVar, NewVar, !:Subst).
:- pred erl_rename_vars_in_exprs(prog_var_renaming::in,
list(elds_expr)::in, list(elds_expr)::out) is det.
@@ -472,6 +532,143 @@
%-----------------------------------------------------------------------------%
+erl_rename_vars_in_expr_except(ExceptVars, Expr0, Expr, !Info) :-
+ erl_expr_vars(Expr0, Vars0),
+ Vars = set.difference(Vars0, ExceptVars),
+ erl_create_renaming(set.to_sorted_list(Vars), Subn, !Info),
+ erl_rename_vars_in_expr(Subn, Expr0, Expr).
+
+%-----------------------------------------------------------------------------%
+
+erl_expr_vars(Expr, Set) :-
+ erl_vars_in_expr(Expr, set.init, Set).
+
+:- pred erl_vars_in_exprs(list(elds_expr)::in,
+ set(prog_var)::in, set(prog_var)::out) is det.
+
+erl_vars_in_exprs(Exprs, !Set) :-
+ list.foldl(erl_vars_in_expr, Exprs, !Set).
+
+:- pred erl_vars_in_expr(elds_expr::in,
+ set(prog_var)::in, set(prog_var)::out) is det.
+
+erl_vars_in_expr(Expr, !Set) :-
+ (
+ Expr = elds_block(Exprs),
+ erl_vars_in_exprs(Exprs, !Set)
+ ;
+ Expr = elds_term(Term),
+ erl_vars_in_term(Term, !Set)
+ ;
+ Expr = elds_eq(ExprA, ExprB),
+ erl_vars_in_expr(ExprA, !Set),
+ erl_vars_in_expr(ExprB, !Set)
+ ;
+ Expr = elds_unop(_Op, ExprA),
+ erl_vars_in_expr(ExprA, !Set)
+ ;
+ Expr = elds_binop(_Op, ExprA, ExprB),
+ erl_vars_in_expr(ExprA, !Set),
+ erl_vars_in_expr(ExprB, !Set)
+ ;
+ Expr = elds_call(CallTarget, ExprsB),
+ erl_vars_in_call_target(CallTarget, !Set),
+ erl_vars_in_exprs(ExprsB, !Set)
+ ;
+ Expr = elds_fun(Clause),
+ erl_vars_in_clause(Clause, !Set)
+ ;
+ Expr = elds_case_expr(ExprA, Cases),
+ erl_vars_in_expr(ExprA, !Set),
+ erl_vars_in_cases(Cases, !Set)
+ ;
+ Expr = elds_try(ExprA, Cases, Catch),
+ erl_vars_in_expr(ExprA, !Set),
+ erl_vars_in_cases(Cases, !Set),
+ erl_vars_in_catch(Catch, !Set)
+ ;
+ Expr = elds_throw(ExprA),
+ erl_vars_in_expr(ExprA, !Set)
+ ;
+ ( Expr = elds_rtti_ref(_)
+ ; Expr = elds_foreign_code(_)
+ )
+ ).
+
+:- pred erl_vars_in_terms(list(elds_term)::in,
+ set(prog_var)::in, set(prog_var)::out) is det.
+
+erl_vars_in_terms(Terms, !Set) :-
+ list.foldl(erl_vars_in_term, Terms, !Set).
+
+:- pred erl_vars_in_term(elds_term::in,
+ set(prog_var)::in, set(prog_var)::out) is det.
+
+erl_vars_in_term(Term, !Set) :-
+ (
+ ( Term = elds_int(_)
+ ; Term = elds_float(_)
+ ; Term = elds_string(_)
+ ; Term = elds_char(_)
+ ; Term = elds_atom_raw(_)
+ ; Term = elds_atom(_)
+ ; Term = elds_anon_var
+ ; Term = elds_fixed_name_var(_)
+ )
+ ;
+ Term = elds_tuple(Exprs),
+ erl_vars_in_exprs(Exprs, !Set)
+ ;
+ Term = elds_var(Var),
+ svset.insert(Var, !Set)
+ ).
+
+:- pred erl_vars_in_call_target(elds_call_target::in,
+ set(prog_var)::in, set(prog_var)::out) is det.
+
+erl_vars_in_call_target(Target, !Set) :-
+ (
+ ( Target = elds_call_plain(_)
+ ; Target = elds_call_builtin(_)
+ )
+ ;
+ Target = elds_call_ho(Expr),
+ erl_vars_in_expr(Expr, !Set)
+ ).
+
+:- pred erl_vars_in_clause(elds_clause::in,
+ set(prog_var)::in, set(prog_var)::out) is det.
+
+erl_vars_in_clause(Clause, !Set) :-
+ Clause = elds_clause(Pattern, Expr),
+ erl_vars_in_terms(Pattern, !Set),
+ erl_vars_in_expr(Expr, !Set).
+
+:- pred erl_vars_in_cases(list(elds_case)::in,
+ set(prog_var)::in, set(prog_var)::out) is det.
+
+erl_vars_in_cases(Cases, !Set) :-
+ list.foldl(erl_vars_in_case, Cases, !Set).
+
+:- pred erl_vars_in_case(elds_case::in,
+ set(prog_var)::in, set(prog_var)::out) is det.
+
+erl_vars_in_case(Case, !Set) :-
+ Case = elds_case(Pattern, Expr),
+ erl_vars_in_term(Pattern, !Set),
+ erl_vars_in_expr(Expr, !Set).
+
+:- pred erl_vars_in_catch(elds_catch::in,
+ set(prog_var)::in, set(prog_var)::out) is det.
+
+erl_vars_in_catch(Catch, !Set) :-
+ Catch = elds_catch(PatternA, PatternB, Expr),
+ erl_vars_in_term(PatternA, !Set),
+ erl_vars_in_term(PatternB, !Set),
+ erl_vars_in_expr(Expr, !Set).
+
+%-----------------------------------------------------------------------------%
+
:- func erl_exprs_size(list(elds_expr)) = int.
erl_exprs_size(Exprs) = sum(list.map(erl_expr_size, Exprs)).
Index: compiler/instmap.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/instmap.m,v
retrieving revision 1.57
diff -u -r1.57 instmap.m
--- compiler/instmap.m 28 May 2007 03:13:52 -0000 1.57
+++ compiler/instmap.m 1 Jun 2007 02:39:08 -0000
@@ -104,6 +104,12 @@
:- pred instmap_delta_changed_vars(instmap_delta::in, set(prog_var)::out)
is det.
+ % Return the set of variables which has an instantiatedness for which
+ % inst_is_bound succeeds.
+ %
+:- pred instmap_bound_vars(instmap::in, module_info::in, set(prog_var)::out)
+ is det.
+
% instmap_changed_vars(IMA, IMB, MI, CV)
%
% Given an earlier instmap, IMA, and a later instmap, IMB,
@@ -418,6 +424,21 @@
vars_list(reachable(InstMapping), VarsList) :-
map.keys(InstMapping, VarsList).
+instmap_bound_vars(unreachable, _ModuleInfo, set.init).
+instmap_bound_vars(reachable(InstMapping), ModuleInfo, BoundVars) :-
+ map.foldl(instmap_bound_vars_2(ModuleInfo), InstMapping,
+ set.init, BoundVars).
+
+:- pred instmap_bound_vars_2(module_info::in, prog_var::in, mer_inst::in,
+ set(prog_var)::in, set(prog_var)::out) is det.
+
+instmap_bound_vars_2(ModuleInfo, Var, Inst, BoundVars0, BoundVars) :-
+ ( inst_is_bound(ModuleInfo, Inst) ->
+ set.insert(BoundVars0, Var, BoundVars)
+ ;
+ BoundVars = BoundVars0
+ ).
+
instmap_delta_changed_vars(unreachable, EmptySet) :-
set.init(EmptySet).
instmap_delta_changed_vars(reachable(InstMapping), ChangedVars) :-
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list