for review: deforestation [1/4]
Simon Taylor
stayl at cs.mu.OZ.AU
Thu Feb 19 16:35:14 AEDT 1998
Fergus, could you please review this.
Simon.
Estimated hours taken: 400
Deforestation.
This increases the code size of the compiler by ~80k when compiling
with --intermodule-optimization --deforestation.
The improvement from deforestation is not measurable for mmc -C make_hlds.m.
Compile time for make_hlds.m increased from 50.7 seconds to 52.2 seconds
when running deforestation.
compiler/simplify.m
compiler/common.m
Provide an interface for simplifying just a goal, not an
entire procedure.
Return an estimate of the improvement in cost from simplification.
Remove failing cases and disjuncts.
Add an option to optimize common structures even across calls.
Remove code to merge branched goals, since that is now
done by deforestation.
Fix a bug: the code to collect instmap_deltas for cases was not
including the switched-on variable in the instmap_delta,
which caused an abort in merge_instmap_delta if the switched
on variable was further instantiated in the switch.
This came up while compiling the compiler with --deforestation.
compiler/code_aux.m
Update code_aux__cannot_loop to use termination information.
compiler/hlds_pred.m
compiler/dnf.m
Pass the type_info_varmap and typeclass_info_varmap
into hlds_pred__define_new_pred.
Restrict the variables of the new procedure onto the variables
of the goal.
compiler/options.m
New options:
--deforestation
--deforestation-depth-limit
Safety net for termination of the algorithm.
--deforestation-cost-factor
Fudge factor for working out whether deforestation
was worthwhile.
--deforestation-vars-threshold
Like --inline-vars-threshold.
Enable deforestation at -O3.
Removed an unnecessary mode for option_defaults_2, since it
resulted in a warning about disjuncts which cannot succeed
(fix coming soon).
compiler/handle_options.m
--no-reorder-conj implies --no-deforestation.
compiler/inlining.m
Separate code to rename goals into inlining__do_inline_call.
compiler/hlds_goal.m
Added predicates goal_list_nonlocals, goal_list_instmap_delta
and goal_list_determinism to approximate information about
conjunctions.
compiler/hlds_module.m
Added module_info_set_pred_proc_info to put an updated
pred_info and proc_info back into the module_info.
compiler/hlds_out.m
Exported hlds_out__write_instmap for debugging of deforestation.
Bracket module names on constructors where necessary.
compiler/mercury_compile.m
Call deforestation.
compiler/intermod.m
Put recursive predicates with a top-level branched goal
into `.opt' files.
goal_util.m
Added goal_calls_pred_id to work out if a predicate is
recursive before mode analysis.
Export goal_util__goals_goal_vars for use by deforestation.
Give a better message for a missing variable in a
substitution.
compiler/instmap.m
Give a better message for inst_merge failing.
compiler/notes/compiler_design.m
Document the new modules.
library/varset.m
Add varset__select to project a varset onto a set of variables.
doc/user_guide.texi
Document deforestation.
Remove a reference to --specialize, which was added in 1995
"for later use", but was never used.
New files:
deforest.m Deforestation.
pd_cost.m Cost estimation.
pd_debug.m Debugging output.
pd_info.m State type and version control.
pd_term.m Termination checking.
pd_util.m Utility predicates
Index: NEWS
===================================================================
RCS file: /home/staff/zs/imp/mercury/NEWS,v
retrieving revision 1.93
diff -u -r1.93 NEWS
--- NEWS 1998/02/11 16:56:49 1.93
+++ NEWS 1998/02/19 00:45:18
@@ -290,6 +290,13 @@
Changes to the Mercury implementation:
**************************************
+* We've added a new source-to-source transformation - deforestation.
+
+ Deforestation transforms conjunctions to avoid the construction
+ of intermediate data structures and to avoid multiple traversals
+ over data structures. Deforestation is enabled with the
+ `--deforestation' option.
+
* We've added support for "transitive" inter-module analysis.
With the previous support for inter-module optimization, when
Index: compiler/code_aux.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/code_aux.m,v
retrieving revision 1.52
diff -u -r1.52 code_aux.m
--- code_aux.m 1998/01/13 10:11:07 1.52
+++ code_aux.m 1998/02/18 04:49:09
@@ -52,7 +52,7 @@
:- implementation.
-:- import_module hlds_module, llds, llds_out, type_util.
+:- import_module hlds_module, hlds_pred, llds, llds_out, type_util, term_util.
:- import_module bool, string, set, term, std_util, assoc_list, require.
:- import_module list, map.
@@ -140,6 +140,10 @@
code_aux__goal_cannot_loop(ModuleInfo, Cond),
code_aux__goal_cannot_loop(ModuleInfo, Then),
code_aux__goal_cannot_loop(ModuleInfo, Else).
+code_aux__goal_cannot_loop_2(ModuleInfo, call(PredId, ProcId, _, _, _, _)) :-
+ module_info_pred_proc_info(ModuleInfo, PredId, ProcId, _, ProcInfo),
+ proc_info_get_maybe_termination_info(ProcInfo, MaybeTermInfo),
+ MaybeTermInfo = yes(cannot_loop).
code_aux__goal_cannot_loop_2(_, unify(_, _, _, Uni, _)) :-
(
Uni = assign(_, _)
Index: compiler/common.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/common.m,v
retrieving revision 1.47
diff -u -r1.47 common.m
--- common.m 1998/01/23 12:56:21 1.47
+++ common.m 1998/02/18 04:49:10
@@ -80,7 +80,7 @@
:- import_module hlds_goal, hlds_data, quantification, mode_util, type_util.
:- import_module det_util, det_report, globals, options, inst_match, instmap.
-:- import_module prog_data, hlds_module, (inst).
+:- import_module prog_data, hlds_module, (inst), pd_cost.
:- import_module bool, term, map, set, list, eqvclass, require, std_util.
:- type structure ---> structure(var, type, cons_id, list(var)).
@@ -126,12 +126,14 @@
common__find_matching_cell(Var, ConsId, ArgVars,
construction, Info0, OldStruct)
->
+ pd_cost__goal(Goal0 - GoalInfo0, Cost),
+ simplify_info_incr_cost_delta(Info0, Cost, Info1),
OldStruct = structure(OldVar, _, _, _),
Unification = assign(Var, OldVar),
Right = var(OldVar),
Goal = unify(Left0, Right, Mode, Unification, Context),
- common__record_equivalence(Var, OldVar, Info0, Info1),
- simplify_info_set_requantify(Info1, Info),
+ common__record_equivalence(Var, OldVar, Info1, Info2),
+ simplify_info_set_requantify(Info2, Info),
set__list_to_set([OldVar, Var], NonLocals),
goal_info_set_nonlocals(GoalInfo0, NonLocals, GoalInfo)
;
@@ -163,10 +165,12 @@
OldArgVars, Info0, Info1),
simplify_info_set_requantify(Info1, Info2),
( RecomputeAtomic = yes ->
- simplify_info_set_recompute_atomic(Info2, Info)
+ simplify_info_set_recompute_atomic(Info2, Info3)
;
- Info = Info2
- )
+ Info3 = Info2
+ ),
+ pd_cost__goal(Goal0 - GoalInfo0, Cost),
+ simplify_info_incr_cost_delta(Info3, Cost, Info)
;
Goal = Goal0,
common__record_cell(Var, ConsId, ArgVars, Info0, Info)
@@ -491,7 +515,9 @@
simplify_info_set_recompute_atomic(Info2, Info3)
;
Info3 = Info2
- )
+ ),
+ pd_cost__goal(Goal0 - GoalInfo, Cost),
+ simplify_info_incr_cost_delta(Info3, Cost, Info4)
;
goal_info_get_context(GoalInfo, Context),
ThisCall = call_args(Context, InputArgs, OutputArgs),
@@ -500,7 +526,7 @@
CommonInfo = common(Eqv0, Structs0,
Structs1, SeenCalls),
Goal = Goal0,
- Info3 = Info0
+ Info4 = Info0
)
;
goal_info_get_context(GoalInfo, Context),
@@ -508,9 +534,9 @@
map__det_insert(SeenCalls0, SeenCall, [ThisCall], SeenCalls),
CommonInfo = common(Eqv0, Structs0, Structs1, SeenCalls),
Goal = Goal0,
- Info3 = Info0
+ Info4 = Info0
),
- simplify_info_set_common_info(Info3, CommonInfo, Info).
+ simplify_info_set_common_info(Info4, CommonInfo, Info).
%---------------------------------------------------------------------------%
Index: compiler/det_report.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/det_report.m,v
retrieving revision 1.48
diff -u -r1.48 det_report.m
--- det_report.m 1998/01/13 10:11:36 1.48
+++ det_report.m 1998/02/18 04:49:12
@@ -876,15 +876,32 @@
{ WarnCnt1 = WarnCnt0 },
{ ErrCnt1 = ErrCnt0 }
;
- det_report_msg(Msg, ModuleInfo),
(
{ MsgType = warning },
- { WarnCnt1 is WarnCnt0 + 1 },
- { ErrCnt1 = ErrCnt0 }
+ { det_msg_get_context(Msg, MaybeContext) },
+ (
+ { MaybeContext = yes(Context) },
+ { term__context_file(Context, File) },
+ { File = "" }
+ ->
+ % Don't warn when we don't have a valid
+ % context for the warning, since that
+ % suggests that the warning has been
+ % introduced by the compiler. This can
+ % occur for switches where the mode
+ % of the procedure contains sub-typing.
+ { WarnCnt1 = WarnCnt0 },
+ { ErrCnt1 = ErrCnt0 }
+ ;
+ { WarnCnt1 is WarnCnt0 + 1 },
+ { ErrCnt1 = ErrCnt0 },
+ det_report_msg(Msg, ModuleInfo)
+ )
;
{ MsgType = error },
{ ErrCnt1 is ErrCnt0 + 1 },
- { WarnCnt1 = WarnCnt0 }
+ { WarnCnt1 = WarnCnt0 },
+ det_report_msg(Msg, ModuleInfo)
)
),
det_report_msgs_2(Msgs, Warn, ModuleInfo,
@@ -911,6 +928,36 @@
det_msg_get_type(higher_order_cc_pred_in_wrong_context(_, _), error).
det_msg_get_type(error_in_lambda(_, _, _, _, _, _), error).
det_msg_get_type(pragma_c_code_without_det_decl(_, _), error).
+
+:- pred det_msg_get_context(det_msg, maybe(term__context)).
+:- mode det_msg_get_context(in, out) is det.
+
+det_msg_get_context(multidet_disj(Context, _), yes(Context)).
+det_msg_get_context(det_disj(Context, _), yes(Context)).
+det_msg_get_context(semidet_disj(Context, _), yes(Context)).
+det_msg_get_context(zero_soln_disj(Context, _), yes(Context)).
+det_msg_get_context(zero_soln_disjunct(Context), yes(Context)).
+det_msg_get_context(ite_cond_cannot_fail(Context), yes(Context)).
+det_msg_get_context(ite_cond_cannot_succeed(Context), yes(Context)).
+det_msg_get_context(negated_goal_cannot_fail(Context), yes(Context)).
+det_msg_get_context(negated_goal_cannot_succeed(Context), yes(Context)).
+det_msg_get_context(warn_obsolete(_, Context), yes(Context)).
+det_msg_get_context(warn_infinite_recursion(Context), yes(Context)).
+det_msg_get_context(duplicate_call(_, Context, _), yes(Context)).
+det_msg_get_context(cc_unify_can_fail(GoalInfo, _, _, _, _), yes(Context)) :-
+ goal_info_get_context(GoalInfo, Context).
+det_msg_get_context(cc_unify_in_wrong_context(GoalInfo, _, _, _, _),
+ yes(Context)) :-
+ goal_info_get_context(GoalInfo, Context).
+det_msg_get_context(cc_pred_in_wrong_context(GoalInfo, _, _, _),
+ yes(Context)) :-
+ goal_info_get_context(GoalInfo, Context).
+det_msg_get_context(higher_order_cc_pred_in_wrong_context(GoalInfo, _),
+ yes(Context)) :-
+ goal_info_get_context(GoalInfo, Context).
+det_msg_get_context(error_in_lambda(_, _, _, GoalInfo, _, _), yes(Context)) :-
+ goal_info_get_context(GoalInfo, Context).
+det_msg_get_context(pragma_c_code_without_det_decl(_, _), no).
:- pred det_report_msg(det_msg, module_info, io__state, io__state).
:- mode det_report_msg(in, in, di, uo) is det.
Index: compiler/dnf.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/dnf.m,v
retrieving revision 1.28
diff -u -r1.28 dnf.m
--- dnf.m 1998/01/13 10:11:41 1.28
+++ dnf.m 1998/02/18 04:49:12
@@ -117,8 +117,7 @@
pred_info_procedures(PredInfo0, ProcTable0),
map__lookup(ProcTable0, ProcId, ProcInfo0),
- excess_assignments_proc(ProcInfo0, ModuleInfo0, ProcInfo1),
- dnf__transform_proc(ProcInfo1, PredInfo0, MaybeNonAtomic,
+ dnf__transform_proc(ProcInfo0, PredInfo0, MaybeNonAtomic,
ModuleInfo0, ModuleInfo1, ProcInfo, NewPredIds0, NewPredIds1),
map__det_update(ProcTable0, ProcId, ProcInfo, ProcTable),
@@ -141,7 +140,10 @@
proc_info_goal(ProcInfo0, Goal0),
proc_info_varset(ProcInfo0, VarSet),
proc_info_vartypes(ProcInfo0, VarTypes),
- DnfInfo = dnf_info(TVarSet, VarTypes, ClassContext, VarSet, Markers),
+ proc_info_typeinfo_varmap(ProcInfo0, TVarMap),
+ proc_info_typeclass_info_varmap(ProcInfo0, TCVarMap),
+ DnfInfo = dnf_info(TVarSet, VarTypes, ClassContext,
+ VarSet, Markers, TVarMap, TCVarMap),
proc_info_get_initial_instmap(ProcInfo0, ModuleInfo0, InstMap),
dnf__transform_goal(Goal0, InstMap, MaybeNonAtomic,
@@ -156,7 +158,9 @@
map(var, type),
list(class_constraint),
varset,
- pred_markers
+ pred_markers,
+ map(tvar, type_info_locn),
+ map(class_constraint, var)
).
:- pred dnf__transform_goal(hlds_goal::in, instmap::in,
@@ -368,7 +372,8 @@
dnf__define_new_pred(Goal0, Goal, InstMap0, PredName, DnfInfo,
ModuleInfo0, ModuleInfo, PredId) :-
- DnfInfo = dnf_info(TVarSet, VarTypes, ClassContext, VarSet, Markers),
+ DnfInfo = dnf_info(TVarSet, VarTypes, ClassContext,
+ VarSet, Markers, TVarMap, TCVarMap),
Goal0 = _GoalExpr - GoalInfo,
goal_info_get_nonlocals(GoalInfo, NonLocals),
set__to_sorted_list(NonLocals, ArgVars),
@@ -376,8 +381,8 @@
% We could get rid of some constraints on variables
% that are not part of the goal.
hlds_pred__define_new_pred(Goal0, Goal, ArgVars, InstMap0, PredName,
- TVarSet, VarTypes, ClassContext, VarSet, Markers,
- ModuleInfo0, ModuleInfo, PredProcId),
+ TVarSet, VarTypes, ClassContext, TVarMap, TCVarMap,
+ VarSet, Markers, ModuleInfo0, ModuleInfo, PredProcId),
PredProcId = proc(PredId, _).
:- pred dnf__compute_arg_types_modes(list(var)::in, map(var, type)::in,
Index: compiler/goal_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/goal_util.m,v
retrieving revision 1.42
diff -u -r1.42 goal_util.m
--- goal_util.m 1998/02/12 01:17:13 1.42
+++ goal_util.m 1998/02/18 04:49:14
@@ -61,6 +61,9 @@
:- pred goal_util__goal_vars(hlds_goal, set(var)).
:- mode goal_util__goal_vars(in, out) is det.
+:- pred goal_util__goals_goal_vars(list(hlds_goal), set(var), set(var)).
+:- mode goal_util__goals_goal_vars(in, in, out) is det.
+
% See whether the goal is a branched structure.
:- pred goal_util__goal_is_branched(hlds_goal_expr).
:- mode goal_util__goal_is_branched(in) is semidet.
@@ -69,17 +72,23 @@
:- pred goal_size(hlds_goal, int).
:- mode goal_size(in, out) is det.
+:- pred goals_size(list(hlds_goal), int).
+:- mode goals_size(in, out) is det.
+
% Test whether the goal calls the given procedure.
:- pred goal_calls(hlds_goal, pred_proc_id).
:- mode goal_calls(in, in) is semidet.
+:- pred goal_calls_pred_id(hlds_goal, pred_id).
+:- mode goal_calls_pred_id(in, in) is semidet.
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module hlds_data, mode_util, code_aux, prog_data, instmap.
-:- import_module int, set, std_util, assoc_list, term, require, varset.
+:- import_module int, set, std_util, string, assoc_list, term, require, varset.
%-----------------------------------------------------------------------------%
@@ -155,7 +164,11 @@
N = V
;
Must = yes,
- error("goal_util__rename_var: no substitute")
+ term__var_to_int(V, VInt),
+ string__format(
+ "goal_util__rename_var: no substitute for var %i",
+ [i(VInt)], Msg),
+ error(Msg)
)
).
@@ -456,9 +469,6 @@
Set0, Set) :-
set__insert_list(Set0, ArgVars, Set).
-:- pred goal_util__goals_goal_vars(list(hlds_goal), set(var), set(var)).
-:- mode goal_util__goals_goal_vars(in, in, out) is det.
-
goal_util__goals_goal_vars([], Set, Set).
goal_util__goals_goal_vars([Goal - _ | Goals], Set0, Set) :-
goal_util__goal_vars_2(Goal, Set0, Set1),
@@ -497,9 +507,6 @@
goal_size(GoalExpr - _, Size) :-
goal_expr_size(GoalExpr, Size).
-:- pred goals_size(list(hlds_goal), int).
-:- mode goals_size(in, out) is det.
-
goals_size([], 0).
goals_size([Goal | Goals], Size) :-
goal_size(Goal, Size1),
@@ -590,3 +597,54 @@
goal_expr_calls(some(_, Goal), PredProcId) :-
goal_calls(Goal, PredProcId).
goal_expr_calls(call(PredId, ProcId, _, _, _, _), proc(PredId, ProcId)).
+
+%-----------------------------------------------------------------------------%
+
+goal_calls_pred_id(GoalExpr - _, PredId) :-
+ goal_expr_calls_pred_id(GoalExpr, PredId).
+
+:- pred goals_calls_pred_id(list(hlds_goal), pred_id).
+:- mode goals_calls_pred_id(in, in) is semidet.
+
+goals_calls_pred_id([Goal | Goals], PredId) :-
+ (
+ goal_calls_pred_id(Goal, PredId)
+ ;
+ goals_calls_pred_id(Goals, PredId)
+ ).
+
+:- pred cases_calls_pred_id(list(case), pred_id).
+:- mode cases_calls_pred_id(in, in) is semidet.
+
+cases_calls_pred_id([case(_, Goal) | Cases], PredId) :-
+ (
+ goal_calls_pred_id(Goal, PredId)
+ ;
+ cases_calls_pred_id(Cases, PredId)
+ ).
+
+:- pred goal_expr_calls_pred_id(hlds_goal_expr, pred_id).
+:- mode goal_expr_calls_pred_id(in, in) is semidet.
+
+goal_expr_calls_pred_id(conj(Goals), PredId) :-
+ goals_calls_pred_id(Goals, PredId).
+goal_expr_calls_pred_id(disj(Goals, _), PredId) :-
+ goals_calls_pred_id(Goals, PredId).
+goal_expr_calls_pred_id(switch(_, _, Goals, _), PredId) :-
+ cases_calls_pred_id(Goals, PredId).
+goal_expr_calls_pred_id(if_then_else(_, Cond, Then, Else, _), PredId) :-
+ (
+ goal_calls_pred_id(Cond, PredId)
+ ;
+ goal_calls_pred_id(Then, PredId)
+ ;
+ goal_calls_pred_id(Else, PredId)
+ ).
+goal_expr_calls_pred_id(not(Goal), PredId) :-
+ goal_calls_pred_id(Goal, PredId).
+goal_expr_calls_pred_id(some(_, Goal), PredId) :-
+ goal_calls_pred_id(Goal, PredId).
+goal_expr_calls_pred_id(call(PredId, _, _, _, _, _), PredId).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
Index: compiler/handle_options.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/handle_options.m,v
retrieving revision 1.44
diff -u -r1.44 handle_options.m
--- handle_options.m 1998/02/09 10:23:41 1.44
+++ handle_options.m 1998/02/18 04:49:14
@@ -270,6 +270,7 @@
globals__io_set_option(inline_compound_threshold, int(0)),
globals__io_set_option(optimize_unused_args, bool(no)),
globals__io_set_option(optimize_higher_order, bool(no)),
+ globals__io_set_option(deforestation, bool(no)),
globals__io_set_option(optimize_duplicate_calls, bool(no)),
globals__io_set_option(optimize_constructor_last_call,
bool(no)),
@@ -280,6 +281,9 @@
[]
),
+ % --no-reorder-conj implies --no-deforestation.
+ option_neg_implies(reorder_conj, deforestation, bool(no)),
+
% --stack-trace requires `procid' stack layouts
option_implies(stack_trace, procid_stack_layout, bool(yes)),
@@ -351,6 +355,20 @@
option_implies(SourceOption, ImpliedOption, ImpliedOptionValue) -->
globals__io_lookup_bool_option(SourceOption, SourceOptionValue),
( { SourceOptionValue = yes } ->
+ globals__io_set_option(ImpliedOption, ImpliedOptionValue)
+ ;
+ []
+ ).
+
+% option_neg_implies(SourceBoolOption, ImpliedOption,
+% ImpliedOptionValue, IO0, IO).
+% If the SourceBoolOption is set to no, then the ImpliedOption is set
+% to ImpliedOptionValue.
+:- pred option_neg_implies(option::in, option::in, option_data::in,
+ io__state::di, io__state::uo) is det.
+option_neg_implies(SourceOption, ImpliedOption, ImpliedOptionValue) -->
+ globals__io_lookup_bool_option(SourceOption, SourceOptionValue),
+ ( { SourceOptionValue = no } ->
globals__io_set_option(ImpliedOption, ImpliedOptionValue)
;
[]
Index: compiler/hlds_goal.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/hlds_goal.m,v
retrieving revision 1.48
diff -u -r1.48 hlds_goal.m
--- hlds_goal.m 1998/02/12 01:17:16 1.48
+++ hlds_goal.m 1998/02/18 04:49:15
@@ -682,10 +682,24 @@
:- pred fail_goal(hlds_goal).
:- mode fail_goal(out) is det.
+ % Union together all the nonlocals of a list of goals.
+:- pred goal_list_nonlocals(list(hlds_goal), set(var)).
+:- mode goal_list_nonlocals(in, out) is det.
+
+ % Compute the instmap_delta resulting from applying
+ % all the instmap_deltas of the given goals.
+:- pred goal_list_instmap_delta(list(hlds_goal), instmap_delta).
+:- mode goal_list_instmap_delta(in, out) is det.
+
+ % Compute the determinism of a list of goals.
+:- pred goal_list_determinism(list(hlds_goal), determinism).
+:- mode goal_list_determinism(in, out) is det.
+
%-----------------------------------------------------------------------------%
:- implementation.
+:- import_module det_analysis.
:- import_module require, term.
goal_info_init(GoalInfo) :-
@@ -933,6 +947,38 @@
goal_info_set_determinism(GoalInfo0, failure, GoalInfo1),
instmap_delta_init_unreachable(InstMapDelta),
goal_info_set_instmap_delta(GoalInfo1, InstMapDelta, GoalInfo).
+
+%-----------------------------------------------------------------------------%
+
+goal_list_nonlocals(Goals, NonLocals) :-
+ UnionNonLocals =
+ lambda([Goal::in, Vars0::in, Vars::out] is det, (
+ Goal = _ - GoalInfo,
+ goal_info_get_nonlocals(GoalInfo, Vars1),
+ set__union(Vars0, Vars1, Vars)
+ )),
+ set__init(NonLocals0),
+ list__foldl(UnionNonLocals, Goals, NonLocals0, NonLocals).
+
+goal_list_instmap_delta(Goals, InstMapDelta) :-
+ ApplyDelta =
+ lambda([Goal::in, Delta0::in, Delta::out] is det, (
+ Goal = _ - GoalInfo,
+ goal_info_get_instmap_delta(GoalInfo, Delta1),
+ instmap_delta_apply_instmap_delta(Delta0,
+ Delta1, Delta)
+ )),
+ instmap_delta_init_reachable(InstMapDelta0),
+ list__foldl(ApplyDelta, Goals, InstMapDelta0, InstMapDelta).
+
+goal_list_determinism(Goals, Determinism) :-
+ ComputeDeterminism =
+ lambda([Goal::in, Det0::in, Det::out] is det, (
+ Goal = _ - GoalInfo,
+ goal_info_get_determinism(GoalInfo, Det1),
+ det_conjunction_detism(Det0, Det1, Det)
+ )),
+ list__foldl(ComputeDeterminism, Goals, det, Determinism).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: compiler/hlds_module.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/hlds_module.m,v
retrieving revision 1.30
diff -u -r1.30 hlds_module.m
--- hlds_module.m 1998/01/05 07:26:14 1.30
+++ hlds_module.m 1998/02/18 04:49:15
@@ -277,6 +277,10 @@
:- pred module_info_set_pred_info(module_info, pred_id, pred_info, module_info).
:- mode module_info_set_pred_info(in, in, in, out) is det.
+:- pred module_info_set_pred_proc_info(module_info,
+ pred_id, proc_id, pred_info, proc_info, module_info).
+:- mode module_info_set_pred_proc_info(in, in, in, in, in, out) is det.
+
:- pred module_info_typeids(module_info, list(type_id)).
:- mode module_info_typeids(in, out) is det.
@@ -901,6 +905,12 @@
module_info_preds(MI0, Preds0),
map__set(Preds0, PredId, PredInfo, Preds),
module_info_set_preds(MI0, Preds, MI).
+
+module_info_set_pred_proc_info(MI0, PredId, ProcId, PredInfo0, ProcInfo, MI) :-
+ pred_info_procedures(PredInfo0, Procs0),
+ map__set(Procs0, ProcId, ProcInfo, Procs),
+ pred_info_set_procedures(PredInfo0, Procs, PredInfo),
+ module_info_set_pred_info(MI0, PredId, PredInfo, MI).
module_info_typeids(MI, TypeIds) :-
module_info_types(MI, Types),
Index: compiler/hlds_out.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/hlds_out.m,v
retrieving revision 1.189
diff -u -r1.189 hlds_out.m
--- hlds_out.m 1998/02/12 01:17:18 1.189
+++ hlds_out.m 1998/02/18 04:49:15
@@ -156,6 +156,10 @@
io__state, io__state).
:- mode hlds_out__write_var_modes(in, in, in, in, di, uo) is det.
+:- pred hlds_out__write_instmap(instmap, varset, bool, int,
+ io__state, io__state).
+:- mode hlds_out__write_instmap(in, in, in, in, di, uo) is det.
+
% find the name of a marker
:- pred hlds_out__marker_name(marker, string).
@@ -1434,7 +1438,7 @@
hlds_out__write_qualified_functor(ModuleName, Functor, ArgVars, VarSet,
AppendVarnums) -->
- io__write_string(ModuleName),
+ mercury_output_bracketed_constant(term__atom(ModuleName)),
io__write_string(":"),
hlds_out__write_functor(Functor, ArgVars, VarSet, AppendVarnums).
@@ -1611,10 +1615,6 @@
% quantification is all implicit by the time we get to the hlds.
hlds_out__write_some(_Vars, _VarSet) --> [].
-
-:- pred hlds_out__write_instmap(instmap, varset, bool, int,
- io__state, io__state).
-:- mode hlds_out__write_instmap(in, in, in, in, di, uo) is det.
hlds_out__write_instmap(InstMap, VarSet, AppendVarnums, Indent) -->
( { instmap__is_unreachable(InstMap) } ->
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/hlds_pred.m,v
retrieving revision 1.45
diff -u -r1.45 hlds_pred.m
--- hlds_pred.m 1998/02/12 01:17:20 1.45
+++ hlds_pred.m 1998/02/18 04:49:16
@@ -20,7 +20,8 @@
:- implementation.
-:- import_module make_hlds, prog_util, mode_util, type_util.
+:- import_module code_aux, goal_util, make_hlds, prog_util.
+:- import_module mode_util, type_util.
:- import_module int, string, set, require, assoc_list.
%-----------------------------------------------------------------------------%
@@ -256,17 +257,17 @@
type_info_locn::out) is det.
% hlds_pred__define_new_pred(Goal, CallGoal, Args, InstMap, PredName,
- % TVarSet, VarTypes, ClassContext, VarSet, Markers, ModuleInfo0,
- % ModuleInfo, PredProcId)
+ % TVarSet, VarTypes, ClassContext, TVarMap, TCVarMap,
+ % VarSet, Markers, ModuleInfo0, ModuleInfo, PredProcId)
%
% Create a new predicate for the given goal, returning a goal to
- % call the created predicate. This must only be called after
- % polymorphism.m.
+ % call the created predicate.
:- pred hlds_pred__define_new_pred(hlds_goal, hlds_goal, list(var),
instmap, string, tvarset, map(var, type),
- list(class_constraint), varset,
- pred_markers, module_info, module_info, pred_proc_id).
-:- mode hlds_pred__define_new_pred(in, out, in, in, in,
+ list(class_constraint), map(tvar, type_info_locn),
+ map(class_constraint, var), varset, pred_markers,
+ module_info, module_info, pred_proc_id).
+:- mode hlds_pred__define_new_pred(in, out, in, in, in, in, in,
in, in, in, in, in, in, out, out) is det.
% Various predicates for accessing the information stored in the
@@ -748,26 +749,41 @@
%-----------------------------------------------------------------------------%
hlds_pred__define_new_pred(Goal0, Goal, ArgVars, InstMap0, PredName, TVarSet,
- VarTypes, ClassContext, VarSet, Markers, ModuleInfo0,
- ModuleInfo, PredProcId) :-
+ VarTypes0, ClassContext, TVarMap, TCVarMap, VarSet0,
+ Markers, ModuleInfo0, ModuleInfo, PredProcId) :-
Goal0 = _GoalExpr - GoalInfo,
goal_info_get_instmap_delta(GoalInfo, InstMapDelta),
instmap__apply_instmap_delta(InstMap0, InstMapDelta, InstMap),
goal_info_get_context(GoalInfo, Context),
goal_info_get_determinism(GoalInfo, Detism),
- compute_arg_types_modes(ArgVars, VarTypes, InstMap0, InstMap,
+ compute_arg_types_modes(ArgVars, VarTypes0, InstMap0, InstMap,
ArgTypes, ArgModes),
module_info_name(ModuleInfo0, ModuleName),
SymName = qualified(ModuleName, PredName),
- map__init(TVarMap), % later, polymorphism.m will fill this in.
- map__init(TCVarMap), % later, polymorphism.m will fill this in.
+
+ % Remove unneeded variables from the vartypes and varset.
+ goal_util__goal_vars(Goal0, GoalVars0),
+ set__insert_list(GoalVars0, ArgVars, GoalVars),
+ map__select(VarTypes0, GoalVars, VarTypes),
+ varset__select(VarSet0, GoalVars, VarSet),
+
+ % Approximate the termination information
+ % for the new procedure.
+ ( code_aux__goal_cannot_loop(ModuleInfo0, Goal0) ->
+ TermInfo = yes(cannot_loop)
+ ;
+ TermInfo = no
+ ),
module_info_globals(ModuleInfo0, Globals),
globals__get_args_method(Globals, ArgsMethod),
+
proc_info_create(VarSet, VarTypes, ArgVars, ArgModes, Detism,
- Goal0, Context, TVarMap, TCVarMap, ArgsMethod, ProcInfo),
+ Goal0, Context, TVarMap, TCVarMap, ArgsMethod, ProcInfo0),
+ proc_info_set_maybe_termination_info(ProcInfo0, TermInfo, ProcInfo),
+
pred_info_create(ModuleName, SymName, TVarSet, ArgTypes, true,
Context, local, Markers, predicate, ClassContext,
ProcInfo, ProcId, PredInfo),
Index: compiler/inlining.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/inlining.m,v
retrieving revision 1.73
diff -u -r1.73 inlining.m
--- inlining.m 1998/01/13 10:12:18 1.73
+++ inlining.m 1998/02/18 04:49:16
@@ -81,7 +81,7 @@
%-----------------------------------------------------------------------------%
:- interface.
-:- import_module hlds_module.
+:- import_module hlds_module, hlds_pred.
:- import_module io.
:- pred inlining(module_info, module_info, io__state, io__state).
@@ -90,12 +90,19 @@
:- pred inlining__is_simple_goal(hlds_goal, int).
:- mode inlining__is_simple_goal(in, in) is semidet.
+:- pred inlining__do_inline_call(list(var), pred_info, proc_info,
+ varset, varset, map(var, type), map(var, type),
+ tvarset, tvarset, map(tvar, type_info_locn),
+ map(tvar, type_info_locn), hlds_goal).
+:- mode inlining__do_inline_call(in, in, in, in, out, in, out,
+ in, out, in, out, out) is det.
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
-:- import_module hlds_pred, hlds_goal, globals, options, llds.
+:- import_module hlds_goal, globals, options, llds.
:- import_module dead_proc_elim, type_util, mode_util, goal_util.
:- import_module passes_aux, code_aux, quantification, det_analysis, prog_data.
@@ -427,62 +434,10 @@
TotalVars is ThisMany + CalleeThisMany,
TotalVars =< VarThresh
->
- % Yes. So look up the rest of the info for the
- % called procedure.
-
- pred_info_typevarset(PredInfo, CalleeTypeVarSet),
- proc_info_headvars(ProcInfo, HeadVars),
- proc_info_goal(ProcInfo, CalledGoal),
- proc_info_vartypes(ProcInfo, CalleeVarTypes0),
- proc_info_typeinfo_varmap(ProcInfo, CalledTypeInfoVarMap0),
-
- % Substitute the appropriate types into the type
- % mapping of the called procedure. For example, if we
- % call `:- pred foo(T)' with an argument of type
- % `int', then we need to replace all occurrences of
- % type `T' with type `int' when we inline it.
-
- % first, rename apart the type variables in the callee.
- % (we can almost throw away the new typevarset, since we
- % are about to substitute away any new type variables,
- % but any unbound type variables in the callee will not
- % be substituted away)
-
- varset__merge_subst(TypeVarSet0, CalleeTypeVarSet,
- TypeVarSet, TypeRenaming),
- apply_substitution_to_type_map(CalleeVarTypes0, TypeRenaming,
- CalleeVarTypes1),
-
- % next, compute the type substitution and then apply it
-
- map__apply_to_list(HeadVars, CalleeVarTypes1, HeadTypes),
- map__apply_to_list(ArgVars, VarTypes0, ArgTypes),
- (
- type_list_subsumes(HeadTypes, ArgTypes, TypeSubn)
- ->
- apply_rec_substitution_to_type_map(CalleeVarTypes1,
- TypeSubn, CalleeVarTypes)
- ;
- % The head types should always subsume the
- % actual argument types, otherwise it is a type error
- % that should have been detected by typechecking
- % But polymorphism.m introduces type-incorrect code --
- % e.g. compare(Res, EnumA, EnumB) gets converted
- % into builtin_compare_int(Res, EnumA, EnumB), which
- % is a type error since it assumes that an enumeration
- % is an int. In those cases, we don't need to
- % worry about the type substitution.
- CalleeVarTypes = CalleeVarTypes1
- ),
-
- % Now rename apart the variables in the called goal.
-
- map__from_corresponding_lists(HeadVars, ArgVars, Subn0),
- goal_util__create_variables(CalleeListOfVars, VarSet0,
- VarTypes0, Subn0, CalleeVarTypes, CalleeVarset,
- VarSet, VarTypes, Subn),
- goal_util__must_rename_vars_in_goal(CalledGoal, Subn,
- Goal - GoalInfo),
+ inlining__do_inline_call(ArgVars, PredInfo,
+ ProcInfo, VarSet0, VarSet, VarTypes0, VarTypes,
+ TypeVarSet0, TypeVarSet, TypeInfoVarMap0,
+ TypeInfoVarMap, Goal - GoalInfo),
% If the inferred determinism of the called
% goal differs from the declared determinism,
@@ -494,12 +449,7 @@
DetChanged = DetChanged0
;
DetChanged = yes
- ),
-
- apply_substitutions_to_var_map(CalledTypeInfoVarMap0,
- TypeRenaming, Subn, CalledTypeInfoVarMap1),
- map__merge(TypeInfoVarMap0, CalledTypeInfoVarMap1,
- TypeInfoVarMap)
+ )
;
Goal = call(PredId, ProcId, ArgVars, Builtin, Context, Sym),
GoalInfo = GoalInfo0,
@@ -523,6 +473,75 @@
inlining__inlining_in_goal(pragma_c_code(A, B, C, D, E, F, G) - GoalInfo,
pragma_c_code(A, B, C, D, E, F, G) - GoalInfo) --> [].
+
+%-----------------------------------------------------------------------------%
+
+inlining__do_inline_call(ArgVars, PredInfo, ProcInfo,
+ VarSet0, VarSet, VarTypes0, VarTypes, TypeVarSet0, TypeVarSet,
+ TypeInfoVarMap0, TypeInfoVarMap, Goal) :-
+
+ proc_info_goal(ProcInfo, CalledGoal),
+
+ % look up the rest of the info for the called procedure.
+
+ pred_info_typevarset(PredInfo, CalleeTypeVarSet),
+ proc_info_headvars(ProcInfo, HeadVars),
+ proc_info_vartypes(ProcInfo, CalleeVarTypes0),
+ proc_info_varset(ProcInfo, CalleeVarset),
+ varset__vars(CalleeVarset, CalleeListOfVars),
+ proc_info_typeinfo_varmap(ProcInfo, CalleeTypeInfoVarMap0),
+
+ % Substitute the appropriate types into the type
+ % mapping of the called procedure. For example, if we
+ % call `:- pred foo(T)' with an argument of type
+ % `int', then we need to replace all occurrences of
+ % type `T' with type `int' when we inline it.
+
+ % first, rename apart the type variables in the callee.
+ % (we can almost throw away the new typevarset, since we
+ % are about to substitute away any new type variables,
+ % but any unbound type variables in the callee will not
+ % be substituted away)
+
+ varset__merge_subst(TypeVarSet0, CalleeTypeVarSet,
+ TypeVarSet, TypeRenaming),
+ apply_substitution_to_type_map(CalleeVarTypes0, TypeRenaming,
+ CalleeVarTypes1),
+
+ % next, compute the type substitution and then apply it
+
+ map__apply_to_list(HeadVars, CalleeVarTypes1, HeadTypes),
+ map__apply_to_list(ArgVars, VarTypes0, ArgTypes),
+ (
+ type_list_subsumes(HeadTypes, ArgTypes, TypeSubn)
+ ->
+ apply_rec_substitution_to_type_map(CalleeVarTypes1,
+ TypeSubn, CalleeVarTypes)
+ ;
+ % The head types should always subsume the
+ % actual argument types, otherwise it is a type error
+ % that should have been detected by typechecking
+ % But polymorphism.m introduces type-incorrect code --
+ % e.g. compare(Res, EnumA, EnumB) gets converted
+ % into builtin_compare_int(Res, EnumA, EnumB), which
+ % is a type error since it assumes that an enumeration
+ % is an int. In those cases, we don't need to
+ % worry about the type substitution.
+ CalleeVarTypes = CalleeVarTypes1
+ ),
+
+ % Now rename apart the variables in the called goal.
+
+ map__from_corresponding_lists(HeadVars, ArgVars, Subn0),
+ goal_util__create_variables(CalleeListOfVars, VarSet0,
+ VarTypes0, Subn0, CalleeVarTypes, CalleeVarset,
+ VarSet, VarTypes, Subn),
+ goal_util__must_rename_vars_in_goal(CalledGoal, Subn, Goal),
+
+ apply_substitutions_to_var_map(CalleeTypeInfoVarMap0,
+ TypeRenaming, Subn, CalleeTypeInfoVarMap1),
+ map__merge(TypeInfoVarMap0, CalleeTypeInfoVarMap1,
+ TypeInfoVarMap).
%-----------------------------------------------------------------------------%
Index: compiler/instmap.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/instmap.m,v
retrieving revision 1.19
diff -u -r1.19 instmap.m
--- instmap.m 1998/02/13 10:12:17 1.19
+++ instmap.m 1998/02/18 04:49:16
@@ -264,7 +264,7 @@
:- import_module mode_util, inst_match, prog_data, mode_errors, goal_util.
:- import_module hlds_data, inst_util.
-:- import_module list, std_util, bool, map, set, assoc_list, require.
+:- import_module list, std_util, bool, map, set, assoc_list, require, string.
:- type instmap_delta == instmap.
@@ -762,7 +762,11 @@
ModuleInfo1 = ModuleInfoPrime,
map__det_insert(InstMapping0, Var, Inst, InstMapping1)
;
- error("merge_instmapping_delta_2: unexpected mode error")
+ term__var_to_int(Var, VarInt),
+ string__format(
+ "merge_instmapping_delta_2: error merging var %i",
+ [i(VarInt)], Msg),
+ error(Msg)
),
merge_instmapping_delta_2(Vars, InstMap, InstMappingA, InstMappingB,
InstMapping1, InstMapping, ModuleInfo1, ModuleInfo).
Index: compiler/intermod.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/intermod.m,v
retrieving revision 1.45
diff -u -r1.45 intermod.m
--- intermod.m 1998/02/18 23:41:55 1.45
+++ intermod.m 1998/02/19 04:55:24
@@ -95,8 +95,9 @@
{ init_intermod_info(ModuleInfo0, IntermodInfo0) },
globals__io_lookup_int_option(
intermod_inline_simple_threshold, Threshold),
+ globals__io_lookup_bool_option(deforestation, Deforestation),
{ intermod__gather_preds(PredIds, yes, Threshold,
- IntermodInfo0, IntermodInfo1) },
+ Deforestation, IntermodInfo0, IntermodInfo1) },
{ intermod__gather_abstract_exported_types(IntermodInfo1,
IntermodInfo2) },
{ intermod_info_get_pred_decls(PredDeclsSet,
@@ -158,10 +159,11 @@
% Predicates to gather stuff to output to .opt file.
:- pred intermod__gather_preds(list(pred_id)::in, bool::in, int::in,
- intermod_info::in, intermod_info::out) is det.
+ bool::in, intermod_info::in, intermod_info::out) is det.
-intermod__gather_preds([], _CollectTypes, _) --> [].
-intermod__gather_preds([PredId | PredIds], CollectTypes, InlineThreshold) -->
+intermod__gather_preds([], _CollectTypes, _, _) --> [].
+intermod__gather_preds([PredId | PredIds], CollectTypes,
+ InlineThreshold, Deforestation) -->
intermod_info_get_module_info(ModuleInfo0),
{ module_info_preds(ModuleInfo0, PredTable0) },
{ map__lookup(PredTable0, PredId, PredInfo0) },
@@ -185,6 +187,16 @@
{ pred_info_requested_inlining(PredInfo0) }
;
{ has_ho_input(ModuleInfo0, ProcInfo) }
+ ;
+ { Deforestation = yes },
+ % Double the inline-threshold since
+ % goals we want to deforest will have
+ % at least two disjuncts. This allows
+ % one simple goal in each disjunct.
+ { DeforestThreshold is InlineThreshold * 2 },
+ { inlining__is_simple_goal(Goal,
+ DeforestThreshold) },
+ { goal_is_deforestable(PredId, Goal) }
)
)
->
@@ -229,7 +241,8 @@
;
[]
),
- intermod__gather_preds(PredIds, CollectTypes, InlineThreshold).
+ intermod__gather_preds(PredIds, CollectTypes,
+ InlineThreshold, Deforestation).
:- pred intermod__traverse_clauses(list(clause)::in, list(clause)::out,
bool::out, intermod_info::in, intermod_info::out) is det.
@@ -267,6 +280,31 @@
ArgModes, VarTypes)
).
+ % Rough guess: a goal is deforestable if it contains a single
+ % top-level branched goal and is recursive.
+:- pred goal_is_deforestable(pred_id::in, hlds_goal::in) is semidet.
+
+goal_is_deforestable(PredId, Goal) :-
+ goal_calls_pred_id(Goal, PredId),
+ goal_to_conj_list(Goal, GoalList),
+ goal_contains_one_branched_goal(GoalList, no).
+
+:- pred goal_contains_one_branched_goal(list(hlds_goal)::in,
+ bool::in) is semidet.
+
+goal_contains_one_branched_goal([], yes).
+goal_contains_one_branched_goal([Goal | Goals], FoundBranch0) :-
+ Goal = GoalExpr - _,
+ (
+ goal_is_branched(GoalExpr),
+ FoundBranch0 = no,
+ FoundBranch = yes
+ ;
+ goal_is_atomic(GoalExpr),
+ FoundBranch = FoundBranch0
+ ),
+ goal_contains_one_branched_goal(Goals, FoundBranch).
+
% Add all local types used in a type to the intermod info.
% It may be sufficient (and much more efficient! to just export
% the definitions of all local types).
@@ -1158,7 +1196,9 @@
module_info_globals(Module0, Globals),
globals__lookup_int_option(Globals, intermod_inline_simple_threshold,
Threshold),
- intermod__gather_preds(PredIds, yes, Threshold, Info0, Info1),
+ globals__lookup_bool_option(Globals, deforestation, Deforestation),
+ intermod__gather_preds(PredIds, yes, Threshold,
+ Deforestation, Info0, Info1),
intermod__gather_abstract_exported_types(Info1, Info),
do_adjust_pred_import_status(Info, Module0, Module).
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/mercury_compile.m,v
retrieving revision 1.75
diff -u -r1.75 mercury_compile.m
--- mercury_compile.m 1998/02/12 01:17:28 1.75
+++ mercury_compile.m 1998/02/18 04:49:18
@@ -32,11 +32,11 @@
:- import_module handle_options, prog_io, modules, module_qual, equiv_type.
:- import_module make_hlds, typecheck, purity, modes.
:- import_module switch_detection, cse_detection, det_analysis, unique_modes.
-:- import_module check_typeclass, simplify, intermod, trans_opt.
+:- import_module stratify, check_typeclass, simplify, intermod, trans_opt.
:- import_module bytecode_gen, bytecode.
:- import_module (lambda), polymorphism, termination, higher_order, inlining.
-:- import_module dnf, constraint, unused_args, dead_proc_elim, saved_vars.
-:- import_module lco, liveness, stratify.
+:- import_module deforest, dnf, constraint, unused_args, dead_proc_elim.
+:- import_module lco, saved_vars, liveness.
:- import_module follow_code, live_vars, arg_info, store_alloc, goal_path.
:- import_module code_gen, optimize, export, base_type_info, base_type_layout.
:- import_module llds_common, llds_out, continuation_info, stack_layout.
@@ -712,7 +712,17 @@
mercury_compile__maybe_polymorphism(HLDS25, Verbose, Stats, HLDS26),
mercury_compile__maybe_dump_hlds(HLDS26, "26", "polymorphism"), !,
- mercury_compile__maybe_termination(HLDS26, Verbose, Stats, HLDS28),
+ { HLDS27 = HLDS26 },
+ %mercury_compile__check_unique_modes(HLDS26, Verbose, Stats,
+ % HLDS27, FoundUniqError), !,
+
+ %{ FoundUniqError = yes ->
+ % error("unique modes failed")
+ %;
+ % true
+ %},
+
+ mercury_compile__maybe_termination(HLDS27, Verbose, Stats, HLDS28),
mercury_compile__maybe_dump_hlds(HLDS28, "28", "termination"), !,
mercury_compile__maybe_base_type_infos(HLDS28, Verbose, Stats, HLDS29),
@@ -734,9 +744,13 @@
mercury_compile__maybe_do_inlining(HLDS32, Verbose, Stats, HLDS34), !,
mercury_compile__maybe_dump_hlds(HLDS34, "34", "inlining"), !,
+ mercury_compile__maybe_deforestation(HLDS34,
+ Verbose, Stats, HLDS36), !,
+ mercury_compile__maybe_dump_hlds(HLDS36, "36", "deforestation"), !,
+
% dnf transformations should be after inlining
% magic sets transformations should be before constraints
- mercury_compile__maybe_transform_dnf(HLDS34, Verbose, Stats, HLDS38), !,
+ mercury_compile__maybe_transform_dnf(HLDS36, Verbose, Stats, HLDS38), !,
mercury_compile__maybe_dump_hlds(HLDS38, "38", "dnf"), !,
mercury_compile__maybe_constraints(HLDS38, Verbose, Stats, HLDS40), !,
@@ -912,7 +926,7 @@
Calls) },
{ globals__lookup_bool_option(Globals, constant_propagation, Prop) },
simplify__proc(
- simplify(no, no, yes, yes, Common, ExcessAssign, Calls, Prop),
+ simplify(no, no, yes, Common, ExcessAssign, Calls, Prop, no),
PredId, ProcId, ModuleInfo1, ModuleInfo2,
ProcInfo1, ProcInfo2, _, _),
{ globals__lookup_bool_option(Globals, optimize_saved_vars,
@@ -1160,7 +1174,7 @@
{ WarnCalls = no }
),
{ Simplify = simplify(Warn, WarnCalls, Once,
- yes, Common, Excess, Calls, Prop) },
+ Common, Excess, Calls, Prop, no) },
process_all_nonimported_procs(
update_proc_error(simplify__proc(Simplify)),
HLDS0, HLDS),
@@ -1361,6 +1375,22 @@
maybe_report_stats(Stats)
;
{ HLDS = HLDS0 }
+ ).
+
+:- pred mercury_compile__maybe_deforestation(module_info, bool, bool,
+ module_info, io__state, io__state).
+:- mode mercury_compile__maybe_deforestation(in, in, in, out, di, uo) is det.
+
+mercury_compile__maybe_deforestation(HLDS0, Verbose, Stats, HLDS) -->
+ globals__io_lookup_bool_option(deforestation, Deforest),
+ ( { Deforest = yes } ->
+ maybe_write_string(Verbose, "% Deforestation...\n"),
+ maybe_flush_output(Verbose),
+ deforestation(HLDS0, HLDS),
+ maybe_write_string(Verbose, " done.\n"),
+ maybe_report_stats(Stats)
+ ;
+ { HLDS0 = HLDS }
).
:- pred mercury_compile__maybe_transform_dnf(module_info, bool, bool,
Index: compiler/options.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/options.m,v
retrieving revision 1.223
diff -u -r1.223 options.m
--- options.m 1998/02/03 08:18:31 1.223
+++ options.m 1998/02/19 03:49:42
@@ -71,6 +71,7 @@
; debug_det
; debug_opt
; debug_vn
+ ; debug_pd
% Output options
; make_short_interface
; make_interface
@@ -213,6 +214,10 @@
; follow_code
; prev_code
; optimize_dead_procs
+ ; deforestation
+ ; deforestation_depth_limit
+ ; deforestation_cost_factor
+ ; deforestation_vars_threshold
; termination
; check_termination
; verbose_check_termination
@@ -294,7 +299,6 @@
:- pred option_defaults_2(option_category, list(pair(option, option_data))).
:- mode option_defaults_2(in, out) is det.
:- mode option_defaults_2(out, out) is multidet.
-:- mode option_defaults_2(in(bound(optimization_option)), out) is det.
option_defaults_2(warning_option, [
% Warning Options
@@ -331,7 +335,8 @@
debug_modes - bool(no),
debug_det - bool(no),
debug_opt - bool(no),
- debug_vn - int(0)
+ debug_vn - int(0),
+ debug_pd - bool(no)
]).
option_defaults_2(output_option, [
% Output Options (mutually exclusive)
@@ -505,6 +510,10 @@
optimize_higher_order - bool(no),
optimize_constructor_last_call - bool(no),
optimize_dead_procs - bool(no),
+ deforestation - bool(no),
+ deforestation_depth_limit - int(4),
+ deforestation_cost_factor - int(1000),
+ deforestation_vars_threshold - int(200),
% HLDS -> LLDS
smart_indexing - bool(no),
@@ -627,6 +636,7 @@
long_option("debug-det", debug_det).
long_option("debug-opt", debug_opt).
long_option("debug-vn", debug_vn).
+long_option("debug-pd", debug_pd).
% output options (mutually exclusive)
long_option("generate-dependencies", generate_dependencies).
@@ -791,6 +801,10 @@
long_option("optimize-constructor-last-call", optimize_constructor_last_call).
long_option("optimize-dead-procs", optimize_dead_procs).
long_option("optimise-dead-procs", optimize_dead_procs).
+long_option("deforestation", deforestation).
+long_option("deforestation-depth-limit", deforestation_depth_limit).
+long_option("deforestation-cost-factor", deforestation_cost_factor).
+long_option("deforestation-vars-threshold", deforestation_vars_threshold).
long_option("enable-termination", termination).
long_option("enable-term", termination).
long_option("check-termination", check_termination).
@@ -1080,6 +1094,7 @@
optimize_saved_vars - bool(yes),
optimize_unused_args - bool(yes),
optimize_higher_order - bool(yes),
+ deforestation - bool(yes),
constant_propagation - bool(yes),
optimize_repeat - int(4)
]).
@@ -1228,7 +1243,10 @@
io__write_string("\t\tOutput detailed debugging traces of the value numbering\n"),
io__write_string("\t\toptimization pass. The different bits in the number\n"),
io__write_string("\t\targument of this option control the printing of\n"),
- io__write_string("\t\tdifferent types of tracing messages.\n").
+ io__write_string("\t\tdifferent types of tracing messages.\n"),
+ io__write_string("\t--debug-pd\n"),
+ io__write_string("\t\tOutput detailed debugging traces of the partial\n"),
+ io__write_string("\t\tdeduction and deforestation process.\n").
:- pred options_help_output(io__state::di, io__state::uo) is det.
@@ -1700,7 +1718,17 @@
io__write_string("\t\tEnable specialization higher-order predicates.\n"),
io__write_string("\t--optimize-constructor-last-call\n"),
io__write_string("\t\tEnable the optimization of ""last"" calls that are followed by\n"),
- io__write_string("\t\tconstructor application.\n").
+ io__write_string("\t\tconstructor application.\n"),
+ io__write_string("\t--deforestation\n"),
+ io__write_string("\t\tPerform deforestation.\n"),
+ io__write_string("\t--deforestation-depth-limit\n"),
+ io__write_string("\t\tSpecify a depth limit for the deforestation algorithm\n"),
+ io__write_string("\t\tin addition to the usual termination checks.\n"),
+ io__write_string("\t\tA value of -1 specifies no depth limit.\n"),
+ io__write_string("\t--deforestation-vars-threshold\n"),
+ io__write_string("\t\tSpecify a rough limit on the number of variables\n"),
+ io__write_string("\t\tin a procedure created by deforestation.\n"),
+ io__write_string("\t\tA value of -1 specifies no limit.\n").
:- pred options_help_hlds_llds_optimization(io__state::di, io__state::uo) is det.
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/polymorphism.m,v
retrieving revision 1.128
diff -u -r1.128 polymorphism.m
--- polymorphism.m 1998/02/15 06:48:35 1.128
+++ polymorphism.m 1998/02/18 04:49:23
@@ -1731,8 +1731,16 @@
IsHigherOrder = no
->
Var = BaseVar,
+
+ % Since this base_type_info is pretending to be
+ % a type_info, we need to adjust its type.
+ % Since base_type_info_const cons_ids are handled
+ % specially, this should not cause problems.
+ construct_type(qualified("mercury_builtin", "type_info") - 1,
+ [Type], NewBaseVarType),
+ map__det_update(VarTypes0, BaseVar, NewBaseVarType, VarTypes),
+
VarSet = VarSet0,
- VarTypes = VarTypes0,
ExtraGoals = ExtraGoals0
;
% Unfortunately, if we have higher order terms, we
More information about the developers
mailing list