for review: deforestation [1/3]
Simon Taylor
stayl at cs.mu.OZ.AU
Wed Apr 1 10:43:59 AEST 1998
Hi Fergus,
This is the second round of the deforestation diff.
Included in this diff but not the log message are the changes to
polymorphism.m, lambda.m and goal_util.m for --typeinfo-liveness, which I
expect Zoltan will commit first.
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 a nicer interface for simplifying a goal,
not an entire procedure.
Rework the interface to avoid manipulating lots of booleans.
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/det_report.m
Output duplicate call warnings even if --warn-simple-code is not set.
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.
Make sure all relevant type_infos are passed into the new
procedure if --typeinfo-liveness is set.
compiler/modes.m
compiler/unique_modes.m
compiler/mode_info.m
compiler/modecheck_unify.m
Put `how_to_check_goal' into the mode_info, rather
than passing it around.
Add a field to the `check_unique_modes' case which
controls whether unique modes is allowed to choose
a different procedure. For deforestation, this is
not allowed, since it could result in choosing a less
efficient procedure after generalisation.
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.
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.
Use the new interface to simplify.m.
Dump the correct version of the HLDS for the first
pass of simplification.
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's names and values
onto a set of variables.
doc/user_guide.texi
Document deforestation.
Remove a reference to a non-existent option, --no-specialize.
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.98
diff -u -r1.98 NEWS
--- NEWS 1998/03/31 23:16:14 1.98
+++ NEWS 1998/03/31 23:22:22
@@ -297,7 +297,8 @@
bag__least_upper_bound/3, bag__remove_list/3, bag__det_remove_list/3,
list__take_upto/3, set__count/2, set_ordlist__count/2,
store__new_cyclic_mutvar/4, relation__add_values/4,
- relation__from_assoc_list/2, and relation__compose/3.
+ relation__from_assoc_list/2, relation__compose/3,
+ and varset__select/3.
Also the old relation__to_assoc_list/2 predicate has been renamed as
relation__to_key_assoc_list/2; there is a new relation__to_assoc_list/2
@@ -319,6 +320,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 at optimization level
+ `-O3' or higher, or by using the `--deforestation' option.
* We've added support for "transitive" inter-module analysis.
Index: compiler/code_aux.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/code_aux.m,v
retrieving revision 1.53
diff -u -r1.53 code_aux.m
--- code_aux.m 1998/03/03 17:33:42 1.53
+++ code_aux.m 1998/03/06 11:32:58
@@ -52,7 +52,7 @@
:- implementation.
-:- import_module llds, llds_out, type_util.
+:- import_module hlds_pred, llds, llds_out, type_util, term_util.
:- import_module 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.49
diff -u -r1.49 common.m
--- common.m 1998/03/03 17:33:52 1.49
+++ common.m 1998/03/30 23:26:51
@@ -81,7 +81,7 @@
:- import_module quantification, mode_util, type_util, prog_util.
:- import_module det_util, det_report, globals, options, inst_match, instmap.
-:- import_module hlds_module, (inst).
+:- import_module hlds_module, (inst), pd_cost.
:- import_module bool, map, set, eqvclass, require, std_util.
:- type structure ---> structure(var, type, cons_id, list(var)).
@@ -130,7 +130,9 @@
OldStruct = structure(OldVar, _, _, _),
common__generate_assign(Var, OldVar, GoalInfo0,
Goal - GoalInfo, Info0, Info1),
- simplify_info_set_requantify(Info1, Info)
+ simplify_info_set_requantify(Info1, Info2),
+ pd_cost__goal(Goal0 - GoalInfo0, Cost),
+ simplify_info_incr_cost_delta(Info2, Cost, Info)
;
Goal = Goal0,
GoalInfo = GoalInfo0,
@@ -151,8 +153,10 @@
OldStruct = structure(_, _, _, OldArgVars),
common__create_output_unifications(GoalInfo0, ArgVars,
OldArgVars, Goals, Info0, Info1),
- simplify_info_set_requantify(Info1, Info),
- Goal = conj(Goals)
+ simplify_info_set_requantify(Info1, Info2),
+ Goal = conj(Goals),
+ pd_cost__goal(Goal0 - GoalInfo0, Cost),
+ simplify_info_incr_cost_delta(Info2, Cost, Info)
;
Goal = Goal0,
common__record_cell(Var, ConsId, ArgVars, Info0, Info)
@@ -436,7 +440,7 @@
OutputArgTypes2)
->
goal_info_get_context(GoalInfo, Context),
- simplify_info_add_msg(Info1,
+ simplify_info_do_add_msg(Info1,
duplicate_call(SeenCall, PrevContext,
Context),
Info2)
@@ -445,7 +449,9 @@
),
CommonInfo = common(Eqv0, Structs0,
Structs1, SeenCalls0),
- simplify_info_set_requantify(Info2, Info3)
+ pd_cost__goal(Goal0 - GoalInfo, Cost),
+ simplify_info_incr_cost_delta(Info2, Cost, Info3),
+ simplify_info_set_requantify(Info3, Info4)
;
goal_info_get_context(GoalInfo, Context),
ThisCall = call_args(Context, InputArgs, OutputArgs),
@@ -454,7 +460,7 @@
CommonInfo = common(Eqv0, Structs0,
Structs1, SeenCalls),
Goal = Goal0,
- Info3 = Info0
+ Info4 = Info0
)
;
goal_info_get_context(GoalInfo, Context),
@@ -462,9 +468,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/constraint.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/constraint.m,v
retrieving revision 1.39
diff -u -r1.39 constraint.m
--- constraint.m 1998/01/13 10:11:21 1.39
+++ constraint.m 1998/03/10 23:17:29
@@ -95,7 +95,7 @@
proc_info_get_initial_instmap(ProcInfo0, ModuleInfo0, InstMap0),
proc_info_context(ProcInfo0, Context),
mode_info_init(IoState0, ModuleInfo0, PredId, ProcId,
- Context, VarSet1, InstMap0, ModeInfo0),
+ Context, VarSet1, InstMap0, check_modes, ModeInfo0),
constraint__propagate_goal(Goal0, Goal, ModeInfo0, ModeInfo),
Index: compiler/det_report.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/det_report.m,v
retrieving revision 1.49
diff -u -r1.49 det_report.m
--- det_report.m 1998/03/03 17:34:04 1.49
+++ det_report.m 1998/03/31 00:02:46
@@ -837,7 +837,7 @@
%-----------------------------------------------------------------------------%
-:- type det_msg_type ---> warning ; error.
+:- type det_msg_type ---> warning ; call_warning ; error.
det_report_and_handle_msgs(Msgs, ModuleInfo0, ModuleInfo) -->
( { Msgs = [] } ->
@@ -862,20 +862,26 @@
).
det_report_msgs(Msgs, ModuleInfo, WarnCnt, ErrCnt) -->
- globals__io_lookup_bool_option(warn_simple_code, Warn),
- det_report_msgs_2(Msgs, Warn, ModuleInfo, 0, WarnCnt, 0, ErrCnt).
+ globals__io_lookup_bool_option(warn_simple_code, WarnSimple),
+ globals__io_lookup_bool_option(warn_duplicate_calls, WarnCalls),
+ det_report_msgs_2(Msgs, WarnSimple, WarnCalls, ModuleInfo,
+ 0, WarnCnt, 0, ErrCnt).
-:- pred det_report_msgs_2(list(det_msg), bool, module_info, int, int,
+:- pred det_report_msgs_2(list(det_msg), bool, bool, module_info, int, int,
int, int, io__state, io__state).
-:- mode det_report_msgs_2(in, in, in, in, out, in, out, di, uo) is det.
+:- mode det_report_msgs_2(in, in, in, in, in, out, in, out, di, uo) is det.
-det_report_msgs_2([], _, _ModuleInfo, WarnCnt, WarnCnt, ErrCnt, ErrCnt) --> [].
-det_report_msgs_2([Msg | Msgs], Warn, ModuleInfo,
+det_report_msgs_2([], _, _, _ModuleInfo,
+ WarnCnt, WarnCnt, ErrCnt, ErrCnt) --> [].
+det_report_msgs_2([Msg | Msgs], Warn, WarnCalls, ModuleInfo,
WarnCnt0, WarnCnt, ErrCnt0, ErrCnt) -->
{ det_msg_get_type(Msg, MsgType) },
( { Warn = no, MsgType = warning } ->
{ WarnCnt1 = WarnCnt0 },
{ ErrCnt1 = ErrCnt0 }
+ ; { WarnCalls = no, MsgType = call_warning } ->
+ { WarnCnt1 = WarnCnt0 },
+ { ErrCnt1 = ErrCnt0 }
;
det_report_msg(Msg, ModuleInfo),
(
@@ -883,12 +889,16 @@
{ WarnCnt1 is WarnCnt0 + 1 },
{ ErrCnt1 = ErrCnt0 }
;
+ { MsgType = call_warning },
+ { WarnCnt1 is WarnCnt0 + 1 },
+ { ErrCnt1 = ErrCnt0 }
+ ;
{ MsgType = error },
{ ErrCnt1 is ErrCnt0 + 1 },
{ WarnCnt1 = WarnCnt0 }
)
),
- det_report_msgs_2(Msgs, Warn, ModuleInfo,
+ det_report_msgs_2(Msgs, Warn, WarnCalls, ModuleInfo,
WarnCnt1, WarnCnt, ErrCnt1, ErrCnt).
:- pred det_msg_get_type(det_msg, det_msg_type).
@@ -905,7 +915,7 @@
det_msg_get_type(negated_goal_cannot_succeed(_), warning).
det_msg_get_type(warn_obsolete(_, _), warning).
det_msg_get_type(warn_infinite_recursion(_), warning).
-det_msg_get_type(duplicate_call(_, _, _), warning).
+det_msg_get_type(duplicate_call(_, _, _), call_warning).
det_msg_get_type(cc_unify_can_fail(_, _, _, _, _), error).
det_msg_get_type(cc_unify_in_wrong_context(_, _, _, _, _), error).
det_msg_get_type(cc_pred_in_wrong_context(_, _, _, _), error).
Index: compiler/dnf.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/dnf.m,v
retrieving revision 1.29
diff -u -r1.29 dnf.m
--- dnf.m 1998/03/03 17:34:08 1.29
+++ dnf.m 1998/03/06 11:30:47
@@ -118,8 +118,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),
@@ -142,7 +141,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,
@@ -157,7 +159,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,
@@ -369,7 +373,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),
@@ -377,8 +382,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.43
diff -u -r1.43 goal_util.m
--- goal_util.m 1998/03/03 17:34:19 1.43
+++ goal_util.m 1998/03/26 06:28:35
@@ -61,6 +61,27 @@
:- pred goal_util__goal_vars(hlds_goal, set(var)).
:- mode goal_util__goal_vars(in, out) is det.
+ % Return all the variables in the list of goals.
+ % Unlike quantification:goal_vars, this predicate returns
+ % even the explicitly quantified variables.
+:- pred goal_util__goals_goal_vars(list(hlds_goal), set(var), set(var)).
+:- mode goal_util__goals_goal_vars(in, in, out) is det.
+
+ %
+ % A type-info variable may be non-local to a goal if any of
+ % the ordinary non-local variables for that goal are
+ % polymorphically typed with a type that depends on that
+ % type-info variable.
+ %
+ % In addition, a typeclass-info may be non-local to a goal if
+ % any of the non-local variables for that goal are
+ % polymorphically typed and are constrained by the typeclass
+ % constraints for that typeclass-info variable.
+ %
+:- pred goal_util__extra_nonlocal_typeinfos(map(var, type_info_locn),
+ map(var, type), hlds_goal, set(var)).
+:- mode goal_util__extra_nonlocal_typeinfos(in, 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 +90,27 @@
:- pred goal_size(hlds_goal, int).
:- mode goal_size(in, out) is det.
+ % Return an indication of the size of the list of goals.
+:- 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.
+ % Test whether the goal calls the given predicate.
+ % This is useful before mode analysis when the proc_ids
+ % have not been determined.
+:- 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, instmap.
-:- import_module int, std_util, assoc_list, require.
+:- import_module int, std_util, assoc_list, require, string.
%-----------------------------------------------------------------------------%
@@ -155,7 +186,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 +491,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),
@@ -488,6 +520,23 @@
%-----------------------------------------------------------------------------%
+goal_util__extra_nonlocal_typeinfos(TypeVarMap, VarTypes,
+ Goal0, NonLocalTypeInfos) :-
+ Goal0 = _ - GoalInfo0,
+ goal_info_get_nonlocals(GoalInfo0, NonLocals),
+ set__to_sorted_list(NonLocals, NonLocalsList),
+ map__apply_to_list(NonLocalsList, VarTypes, NonLocalsTypes),
+ term__vars_list(NonLocalsTypes, NonLocalTypeVars),
+ % Find all the type-infos and typeclass-infos that are
+ % non-local
+ solutions_set(lambda([Var::out] is nondet, (
+ list__member(TheVar, NonLocalTypeVars),
+ map__search(TypeVarMap, TheVar, Location),
+ type_info_locn_var(Location, Var)
+ )), NonLocalTypeInfos).
+
+%-----------------------------------------------------------------------------%
+
goal_util__goal_is_branched(if_then_else(_, _, _, _, _)).
goal_util__goal_is_branched(switch(_, _, _, _)).
goal_util__goal_is_branched(disj(_, _)).
@@ -497,9 +546,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 +636,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.45
diff -u -r1.45 handle_options.m
--- handle_options.m 1998/03/03 17:34:21 1.45
+++ handle_options.m 1998/03/06 11:30:49
@@ -273,6 +273,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)),
@@ -283,6 +284,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)),
@@ -354,6 +358,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.50
diff -u -r1.50 hlds_goal.m
--- hlds_goal.m 1998/03/24 00:06:53 1.50
+++ hlds_goal.m 1998/03/30 02:15:52
@@ -682,10 +682,24 @@
:- pred fail_goal(hlds_goal).
:- mode fail_goal(out) is det.
+ % Return the union of 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.
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.32
diff -u -r1.32 hlds_module.m
--- hlds_module.m 1998/03/04 19:47:31 1.32
+++ hlds_module.m 1998/03/06 11:30:50
@@ -278,6 +278,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.
@@ -902,6 +906,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.191
diff -u -r1.191 hlds_out.m
--- hlds_out.m 1998/03/12 01:12:09 1.191
+++ hlds_out.m 1998/03/19 04:07:59
@@ -33,7 +33,7 @@
:- interface.
:- import_module hlds_module, hlds_pred, hlds_goal, hlds_data.
-:- import_module prog_data, llds.
+:- import_module prog_data, llds, instmap.
:- import_module io, bool, term, map, list, varset.
%-----------------------------------------------------------------------------%
@@ -155,6 +155,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).
@@ -1427,7 +1431,7 @@
hlds_out__write_qualified_functor(ModuleName, Functor, ArgVars, VarSet,
AppendVarnums) -->
- prog_out__write_sym_name(ModuleName),
+ mercury_output_bracketed_sym_name(ModuleName),
io__write_string(":"),
hlds_out__write_functor(Functor, ArgVars, VarSet, AppendVarnums).
@@ -1604,10 +1608,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.46
diff -u -r1.46 hlds_pred.m
--- hlds_pred.m 1998/03/03 17:34:35 1.46
+++ hlds_pred.m 1998/03/30 02:40:06
@@ -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, options.
:- import_module int, string, require, assoc_list.
%-----------------------------------------------------------------------------%
@@ -238,10 +239,6 @@
% If the compiler cannot guarantee termination
% then it must give an error message.
.
-
-:- type marker_status
- ---> request(marker)
- ; done(marker).
:- type type_info_locn
---> type_info(var) % it is a normal type info
@@ -256,17 +253,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
@@ -747,27 +744,56 @@
%-----------------------------------------------------------------------------%
-hlds_pred__define_new_pred(Goal0, Goal, ArgVars, InstMap0, PredName, TVarSet,
- VarTypes, ClassContext, VarSet, Markers, ModuleInfo0,
- ModuleInfo, PredProcId) :-
+hlds_pred__define_new_pred(Goal0, Goal, ArgVars0, InstMap0, PredName, TVarSet,
+ 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),
+ % If typeinfo_liveness is set, all type_infos for the argument
+ % variables need to be passed in, not just the ones that are used.
+ module_info_globals(ModuleInfo0, Globals),
+ globals__lookup_bool_option(Globals, typeinfo_liveness,
+ TypeInfoLiveness),
+ ( TypeInfoLiveness = yes ->
+ goal_util__extra_nonlocal_typeinfos(TVarMap, VarTypes0,
+ Goal0, ExtraTypeInfos0),
+ set__delete_list(ExtraTypeInfos0, ArgVars0, ExtraTypeInfos),
+ set__to_sorted_list(ExtraTypeInfos, ExtraArgs),
+ list__append(ExtraArgs, ArgVars0, ArgVars)
+ ;
+ ArgVars = ArgVars0
+ ),
+
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.
- module_info_globals(ModuleInfo0, Globals),
+ % 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
+ ),
+
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.74
diff -u -r1.74 inlining.m
--- inlining.m 1998/03/03 17:34:37 1.74
+++ inlining.m 1998/03/06 11:45:23
@@ -81,8 +81,8 @@
%-----------------------------------------------------------------------------%
:- interface.
-:- import_module hlds_goal, hlds_module.
-:- import_module io.
+:- import_module hlds_goal, hlds_module, hlds_pred, prog_data.
+:- import_module io, list, map, term, varset.
:- pred inlining(module_info, module_info, io__state, io__state).
:- mode inlining(in, out, di, uo) is det.
@@ -90,17 +90,32 @@
:- pred inlining__is_simple_goal(hlds_goal, int).
:- mode inlining__is_simple_goal(in, in) is semidet.
+ % inlining__do_inline_call(Args, CalledPredInfo, CalledProcInfo,
+ % VarSet0, VarSet, VarTypes0, VarTypes, TVarSet0, TVarSet,
+ % TypeInfoMap0, TypeInfoMap).
+ %
+ % Given the arguments to the call, the pred_info and proc_info
+ % for the called goal and various information about the
+ % procedure currently being analysed, rename the goal for
+ % the called procedure so that it can be inlined.
+:- 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, globals, options, llds.
+:- import_module 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.
-:- import_module bool, int, list, assoc_list, map, set, std_util.
-:- import_module term, varset, require, hlds_data, dependency_graph.
+:- import_module bool, int, list, assoc_list, set, std_util.
+:- import_module require, hlds_data, dependency_graph.
%-----------------------------------------------------------------------------%
@@ -421,68 +436,16 @@
% Callee has
module_info_pred_proc_info(ModuleInfo, PredId, ProcId,
PredInfo, ProcInfo),
- proc_info_varset(ProcInfo, CalleeVarset),
- varset__vars(CalleeVarset, CalleeListOfVars),
+ proc_info_varset(ProcInfo, CalleeVarSet),
+ varset__vars(CalleeVarSet, CalleeListOfVars),
list__length(CalleeListOfVars, CalleeThisMany),
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 +457,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 +481,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.20
diff -u -r1.20 instmap.m
--- instmap.m 1998/03/03 17:34:42 1.20
+++ instmap.m 1998/03/06 12:05:54
@@ -268,7 +268,7 @@
:- import_module mode_util, inst_match, prog_data, goal_util.
:- import_module hlds_data, inst_util.
-:- import_module std_util, require.
+:- import_module std_util, require, string.
:- type instmap_delta == instmap.
@@ -766,7 +766,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.49
diff -u -r1.49 intermod.m
--- intermod.m 1998/03/18 17:30:33 1.49
+++ intermod.m 1998/03/19 04:08:00
@@ -94,8 +94,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,
@@ -157,10 +158,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) },
@@ -184,6 +186,19 @@
{ 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.
+ % The disjunction adds one to the goal
+ % size, hence the `+1'.
+ { DeforestThreshold is
+ InlineThreshold * 2 + 1},
+ { inlining__is_simple_goal(Goal,
+ DeforestThreshold) },
+ { goal_is_deforestable(PredId, Goal) }
)
)
->
@@ -228,7 +243,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.
@@ -266,6 +282,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).
@@ -1163,7 +1204,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/lambda.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/lambda.m,v
retrieving revision 1.40
diff -u -r1.40 lambda.m
--- lambda.m 1998/03/03 17:34:45 1.40
+++ lambda.m 1998/03/23 02:09:57
@@ -41,28 +41,28 @@
:- interface.
:- import_module hlds_module, hlds_pred, hlds_goal, hlds_data, prog_data.
-:- import_module list, map, term, varset.
+:- import_module list, map, set, term, varset.
:- pred lambda__process_pred(pred_id, module_info, module_info).
:- mode lambda__process_pred(in, in, out) is det.
:- pred lambda__transform_lambda(pred_or_func, string, list(var), list(mode),
- determinism, list(var), hlds_goal, unification,
+ determinism, list(var), set(var), hlds_goal, unification,
varset, map(var, type), list(class_constraint), tvarset,
map(tvar, type_info_locn), map(class_constraint, var),
module_info, unify_rhs, unification, module_info).
-:- mode lambda__transform_lambda(in, in, in, in, in, in, in, in, in, in, in, in,
- in, in, in, out, out, out) is det.
+:- mode lambda__transform_lambda(in, in, in, in, in, in, in, in, in, in, in,
+ in, in, in, in, in, out, out, out) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
-:- import_module make_hlds.
-:- import_module prog_util, mode_util, inst_match, llds, arg_info.
+:- import_module make_hlds, globals, options.
+:- import_module goal_util, prog_util, mode_util, inst_match, llds, arg_info.
-:- import_module bool, set, string, std_util, require.
+:- import_module bool, string, std_util, require.
:- type lambda_info --->
lambda_info(
@@ -238,17 +238,19 @@
Unification0, Functor, Unification, LambdaInfo0, LambdaInfo) :-
LambdaInfo0 = lambda_info(VarSet, VarTypes, Constraints, TVarSet,
TVarMap, TCVarMap, POF, PredName, ModuleInfo0),
+ goal_util__extra_nonlocal_typeinfos(TVarMap, VarTypes,
+ LambdaGoal, ExtraTypeInfos),
lambda__transform_lambda(PredOrFunc, PredName, Vars, Modes, Det,
- OrigNonLocals0, LambdaGoal, Unification0, VarSet, VarTypes,
- Constraints, TVarSet, TVarMap, TCVarMap, ModuleInfo0, Functor,
- Unification, ModuleInfo),
+ OrigNonLocals0, ExtraTypeInfos, LambdaGoal, Unification0,
+ VarSet, VarTypes, Constraints, TVarSet, TVarMap, TCVarMap,
+ ModuleInfo0, Functor, Unification, ModuleInfo),
LambdaInfo = lambda_info(VarSet, VarTypes, Constraints, TVarSet,
TVarMap, TCVarMap, POF, PredName, ModuleInfo).
lambda__transform_lambda(PredOrFunc, OrigPredName, Vars, Modes, Detism,
- OrigVars, LambdaGoal, Unification0, VarSet, VarTypes,
- Constraints, TVarSet, TVarMap, TCVarMap, ModuleInfo0, Functor,
- Unification, ModuleInfo) :-
+ OrigVars, ExtraTypeInfos, LambdaGoal, Unification0,
+ VarSet, VarTypes, Constraints, TVarSet, TVarMap, TCVarMap,
+ ModuleInfo0, Functor, Unification, ModuleInfo) :-
(
Unification0 = construct(Var0, _, _, UniModes0)
->
@@ -270,7 +272,20 @@
LambdaGoal = _ - LambdaGoalInfo,
goal_info_get_nonlocals(LambdaGoalInfo, NonLocals0),
- set__delete_list(NonLocals0, Vars, NonLocals),
+ set__delete_list(NonLocals0, Vars, NonLocals1),
+ module_info_globals(ModuleInfo0, Globals),
+
+ % If typeinfo_liveness is set, all type_infos for the
+ % arguments should be included, not just the ones
+ % that are used.
+ globals__lookup_bool_option(Globals,
+ typeinfo_liveness, TypeInfoLiveness),
+ ( TypeInfoLiveness = yes ->
+ set__union(NonLocals1, ExtraTypeInfos, NonLocals)
+ ;
+ NonLocals = NonLocals1
+ ),
+
set__to_sorted_list(NonLocals, ArgVars1),
(
LambdaGoal = call(PredId0, ProcId0, CallVars,
@@ -334,8 +349,9 @@
ModuleInfo1),
goal_info_get_context(LambdaGoalInfo, OrigContext),
term__context_line(OrigContext, OrigLine),
- make_lambda_name(ModuleName, PredOrFunc, OrigPredName,
- OrigLine, LambdaCount, PredName),
+ make_pred_name_with_context(ModuleName, "IntroducedFrom",
+ PredOrFunc, OrigPredName, OrigLine,
+ LambdaCount, PredName),
goal_info_get_context(LambdaGoalInfo, LambdaContext),
% the TVarSet is a superset of what it really ought be,
% but that shouldn't matter
@@ -376,7 +392,6 @@
% inputs came before outputs, but that resulted in the
% HLDS not being type or mode correct which caused problems
% for some transformations and for rerunning mode analysis.
- module_info_globals(ModuleInfo1, Globals),
arg_info__ho_call_args_method(Globals, ArgsMethod),
% Now construct the proc_info and pred_info for the new
@@ -402,21 +417,6 @@
Functor = functor(cons(PredName, NumArgVars), ArgVars),
ConsId = pred_const(PredId, ProcId),
Unification = construct(Var, ConsId, ArgVars, UniModes).
-
-:- pred make_lambda_name(module_name, pred_or_func, string, int, int, sym_name).
-:- mode make_lambda_name(in, in, in, in, in, out) is det.
-
-make_lambda_name(ModuleName, PredOrFunc, PredName, Line, Counter, SymName) :-
- (
- PredOrFunc = predicate,
- PFS = "pred"
- ;
- PredOrFunc = function,
- PFS = "func"
- ),
- string__format("IntroducedFrom__%s__%s__%d__%d",
- [s(PFS), s(PredName), i(Line), i(Counter)], Name),
- SymName = qualified(ModuleName, Name).
:- pred lambda__uni_modes_to_modes(list(uni_mode), list(mode)).
:- mode lambda__uni_modes_to_modes(in, out) is det.
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/mercury_compile.m,v
retrieving revision 1.81
diff -u -r1.81 mercury_compile.m
--- mercury_compile.m 1998/03/30 13:30:57 1.81
+++ mercury_compile.m 1998/03/31 01:37:33
@@ -32,11 +32,11 @@
:- import_module handle_options, prog_io, prog_out, modules, module_qual.
:- import_module equiv_type, 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.
@@ -685,10 +685,9 @@
mercury_compile__maybe_dump_hlds(HLDS11, "11",
"stratification"), !,
- globals__io_lookup_bool_option(warn_simple_code, Warn),
- mercury_compile__simplify(HLDS11, Warn, no,
+ mercury_compile__simplify(HLDS11, yes, no,
Verbose, Stats, HLDS12), !,
- mercury_compile__maybe_dump_hlds(HLDS11, "12", "simplify"), !,
+ mercury_compile__maybe_dump_hlds(HLDS12, "12", "simplify"), !,
%
% work out whether we encountered any errors
@@ -750,7 +749,26 @@
mercury_compile__maybe_polymorphism(HLDS25, Verbose, Stats, HLDS26),
mercury_compile__maybe_dump_hlds(HLDS26, "26", "polymorphism"), !,
- mercury_compile__maybe_termination(HLDS26, Verbose, Stats, HLDS28),
+ %
+ % Uncomment the following code to check that unique mode analysis
+ % works after polymorphism has been run. Currently it does not
+ % because common.m does not preserve unique mode correctness
+ % (this test fails on about five modules in the compiler and library).
+ % It is important that unique mode analysis work most of the time
+ % after optimizations and polymorphism because deforestation reruns it.
+ %
+
+ { 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),
@@ -772,9 +790,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), !,
@@ -944,15 +966,9 @@
{ ProcInfo1 = ProcInfo0 },
{ ModuleInfo1 = ModuleInfo0 }
),
- { globals__lookup_bool_option(Globals, excess_assign, ExcessAssign) },
- { globals__lookup_bool_option(Globals, common_struct, Common) },
- { globals__lookup_bool_option(Globals, optimize_duplicate_calls,
- Calls) },
- { globals__lookup_bool_option(Globals, constant_propagation, Prop) },
- simplify__proc(
- simplify(no, no, yes, yes, Common, ExcessAssign, Calls, Prop),
- PredId, ProcId, ModuleInfo1, ModuleInfo2,
- ProcInfo1, ProcInfo2, _, _),
+ { simplify__find_simplifications(no, Globals, Simplifications) },
+ simplify__proc([do_once | Simplifications], PredId, ProcId,
+ ModuleInfo1, ModuleInfo2, ProcInfo1, ProcInfo2, _, _),
{ globals__lookup_bool_option(Globals, optimize_saved_vars,
SavedVars) },
( { SavedVars = yes } ->
@@ -1187,20 +1203,15 @@
mercury_compile__simplify(HLDS0, Warn, Once, Verbose, Stats, HLDS) -->
maybe_write_string(Verbose, "% Simplifying goals...\n"),
maybe_flush_output(Verbose),
- globals__io_lookup_bool_option(common_struct, Common),
- globals__io_lookup_bool_option(excess_assign, Excess),
- globals__io_lookup_bool_option(optimize_duplicate_calls, Calls),
- globals__io_lookup_bool_option(constant_propagation, Prop),
- ( { Warn = yes } ->
- globals__io_lookup_bool_option(warn_duplicate_calls,
- WarnCalls)
+ globals__io_get_globals(Globals),
+ { simplify__find_simplifications(Warn, Globals, Simplifications0) },
+ ( { Once = yes } ->
+ { Simplifications = [do_once | Simplifications0] }
;
- { WarnCalls = no }
+ { Simplifications = Simplifications0 }
),
- { Simplify = simplify(Warn, WarnCalls, Once,
- yes, Common, Excess, Calls, Prop) },
process_all_nonimported_procs(
- update_proc_error(simplify__proc(Simplify)),
+ update_proc_error(simplify__proc(Simplifications)),
HLDS0, HLDS),
maybe_write_string(Verbose, "% done.\n"),
maybe_report_stats(Stats).
@@ -1402,6 +1413,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/mode_info.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/mode_info.m,v
retrieving revision 1.45
diff -u -r1.45 mode_info.m
--- mode_info.m 1998/03/03 17:35:13 1.45
+++ mode_info.m 1998/03/10 22:55:09
@@ -61,13 +61,29 @@
; if_then_else
; lambda(pred_or_func).
+
+ % Specify how to process goals - using either
+ % modes.m or unique_modes.m.
+:- type how_to_check_goal
+ ---> check_modes
+ ; check_unique_modes(may_change_called_proc).
+
+
+ % Is unique modes allowed to change which procedure of a predicate
+ % is called. It may not change the called procedure after deforestation
+ % has performed a generalisation step, since that could result
+ % in selecting a less efficient mode.
+:- type may_change_called_proc
+ ---> may_change_called_proc
+ ; may_not_change_called_proc.
+
:- type locked_vars == assoc_list(var_lock_reason, set(var)).
:- type mode_info.
-:- pred mode_info_init(io__state, module_info, pred_id, proc_id,
- term__context, set(var), instmap, mode_info).
-:- mode mode_info_init(di, in, in, in, in, in, in, mode_info_uo) is det.
+:- pred mode_info_init(io__state, module_info, pred_id, proc_id, term__context,
+ set(var), instmap, how_to_check_goal, mode_info).
+:- mode mode_info_init(di, in, in, in, in, in, in, in, mode_info_uo) is det.
:- pred mode_info_get_io_state(mode_info, io__state).
:- mode mode_info_get_io_state(mode_info_get_io_state, uo) is det.
@@ -224,6 +240,12 @@
:- pred mode_info_set_changed_flag(bool, mode_info, mode_info).
:- mode mode_info_set_changed_flag(in, mode_info_di, mode_info_uo) is det.
+:- pred mode_info_get_how_to_check(mode_info, how_to_check_goal).
+:- mode mode_info_get_how_to_check(mode_info_ui, out) is det.
+
+:- pred mode_info_set_how_to_check(how_to_check_goal, mode_info, mode_info).
+:- mode mode_info_set_how_to_check(in, mode_info_di, mode_info_uo) is det.
+
/*
:- inst uniq_mode_info = bound_unique(
mode_info(
@@ -325,9 +347,11 @@
% This field will always contain an empty list if debug_modes is off,
% since its information is not needed then.
- bool % Changed flag
+ bool, % Changed flag
% If `yes', then we may need
% to repeat mode inference.
+
+ how_to_check_goal
).
% The normal inst of a mode_info struct: ground, with
@@ -339,7 +363,7 @@
% Initialize the mode_info
mode_info_init(IOState, ModuleInfo, PredId, ProcId, Context,
- LiveVars, InstMapping0, ModeInfo) :-
+ LiveVars, InstMapping0, HowToCheck, ModeInfo) :-
mode_context_init(ModeContext),
LockedVars = [],
delay_info__init(DelayInfo),
@@ -361,96 +385,103 @@
IOState, ModuleInfo, PredId, ProcId, VarSet, VarTypes,
Context, ModeContext, InstMapping0, LockedVars, DelayInfo,
ErrorList, LiveVarsList, NondetLiveVarsList, [],
- Changed
+ Changed, HowToCheck
).
%-----------------------------------------------------------------------------%
% Lots of very boring access predicates.
-mode_info_get_io_state(mode_info(IOState0,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_),
+mode_info_get_io_state(mode_info(IOState0,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_),
IOState) :-
% XXX
unsafe_promise_unique(IOState0, IOState).
%-----------------------------------------------------------------------------%
-mode_info_set_io_state( mode_info(_,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P), IOState0,
- mode_info(IOState,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P)) :-
+mode_info_set_io_state( mode_info(_,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q), IOState0,
+ mode_info(IOState,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q)) :-
% XXX
unsafe_promise_unique(IOState0, IOState).
%-----------------------------------------------------------------------------%
-mode_info_get_module_info(mode_info(_,ModuleInfo,_,_,_,_,_,_,_,_,_,_,_,_,_,_),
+mode_info_get_module_info(mode_info(_,ModuleInfo,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_),
ModuleInfo).
%-----------------------------------------------------------------------------%
-mode_info_set_module_info(mode_info(A,_,C,D,E,F,G,H,I,J,K,L,M,N,O,P), ModuleInfo,
- mode_info(A,ModuleInfo,C,D,E,F,G,H,I,J,K,L,M,N,O,P)).
+mode_info_set_module_info(mode_info(A,_,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q),
+ ModuleInfo,
+ mode_info(A,ModuleInfo,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q)).
%-----------------------------------------------------------------------------%
-mode_info_get_preds(mode_info(_,ModuleInfo,_,_,_,_,_,_,_,_,_,_,_,_,_,_), Preds) :-
+mode_info_get_preds(mode_info(_,ModuleInfo,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_),
+ Preds) :-
module_info_preds(ModuleInfo, Preds).
%-----------------------------------------------------------------------------%
-mode_info_get_modes(mode_info(_,ModuleInfo,_,_,_,_,_,_,_,_,_,_,_,_,_,_), Modes) :-
+mode_info_get_modes(mode_info(_,ModuleInfo,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_),
+ Modes) :-
module_info_modes(ModuleInfo, Modes).
%-----------------------------------------------------------------------------%
-mode_info_get_insts(mode_info(_,ModuleInfo,_,_,_,_,_,_,_,_,_,_,_,_,_,_), Insts) :-
+mode_info_get_insts(mode_info(_,ModuleInfo,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_),
+ Insts) :-
module_info_insts(ModuleInfo, Insts).
%-----------------------------------------------------------------------------%
-mode_info_get_predid(mode_info(_,_,PredId,_,_,_,_,_,_,_,_,_,_,_,_,_), PredId).
+mode_info_get_predid(mode_info(_,_,PredId,_,_,_,_,_,_,_,_,_,_,_,_,_,_),
+ PredId).
%-----------------------------------------------------------------------------%
-mode_info_get_procid(mode_info(_,_,_,ProcId,_,_,_,_,_,_,_,_,_,_,_,_), ProcId).
+mode_info_get_procid(mode_info(_,_,_,ProcId,_,_,_,_,_,_,_,_,_,_,_,_,_), ProcId).
%-----------------------------------------------------------------------------%
-mode_info_get_varset(mode_info(_,_,_,_,VarSet,_,_,_,_,_,_,_,_,_,_,_), VarSet).
+mode_info_get_varset(mode_info(_,_,_,_,VarSet,_,_,_,_,_,_,_,_,_,_,_,_), VarSet).
%-----------------------------------------------------------------------------%
-mode_info_set_varset(VarSet, mode_info(A,B,C,D,_,F,G,H,I,J,K,L,M,N,O,P),
- mode_info(A,B,C,D,VarSet,F,G,H,I,J,K,L,M,N,O,P)).
+mode_info_set_varset(VarSet, mode_info(A,B,C,D,_,F,G,H,I,J,K,L,M,N,O,P,Q),
+ mode_info(A,B,C,D,VarSet,F,G,H,I,J,K,L,M,N,O,P,Q)).
%-----------------------------------------------------------------------------%
-mode_info_get_var_types(mode_info(_,_,_,_,_,VarTypes,_,_,_,_,_,_,_,_,_,_),
+mode_info_get_var_types(mode_info(_,_,_,_,_,VarTypes,_,_,_,_,_,_,_,_,_,_,_),
VarTypes).
%-----------------------------------------------------------------------------%
-mode_info_set_var_types(VarTypes, mode_info(A,B,C,D,E,_,G,H,I,J,K,L,M,N,O,P),
- mode_info(A,B,C,D,E,VarTypes,G,H,I,J,K,L,M,N,O,P)).
+mode_info_set_var_types(VarTypes, mode_info(A,B,C,D,E,_,G,H,I,J,K,L,M,N,O,P,Q),
+ mode_info(A,B,C,D,E,VarTypes,G,H,I,J,K,L,M,N,O,P,Q)).
%-----------------------------------------------------------------------------%
-mode_info_get_context(mode_info(_,_,_,_,_,_,Context,_,_,_,_,_,_,_,_,_), Context).
+mode_info_get_context(mode_info(_,_,_,_,_,_,Context,_,_,_,_,_,_,_,_,_,_),
+ Context).
%-----------------------------------------------------------------------------%
-mode_info_set_context(Context, mode_info(A,B,C,D,E,F,_,H,I,J,K,L,M,N,O,P),
- mode_info(A,B,C,D,E,F,Context,H,I,J,K,L,M,N,O,P)).
+mode_info_set_context(Context, mode_info(A,B,C,D,E,F,_,H,I,J,K,L,M,N,O,P,Q),
+ mode_info(A,B,C,D,E,F,Context,H,I,J,K,L,M,N,O,P,Q)).
%-----------------------------------------------------------------------------%
-mode_info_get_mode_context(mode_info(_,_,_,_,_,_,_,ModeContext,_,_,_,_,_,_,_,_),
- ModeContext).
+mode_info_get_mode_context(
+ mode_info(_,_,_,_,_,_,_,ModeContext,_,_,_,_,_,_,_,_,_),
+ ModeContext).
%-----------------------------------------------------------------------------%
mode_info_set_mode_context(ModeContext,
- mode_info(A,B,C,D,E,F,G,_,I,J,K,L,M,N,O,P),
- mode_info(A,B,C,D,E,F,G,ModeContext,I,J,K,L,M,N,O,P)).
+ mode_info(A,B,C,D,E,F,G,_,I,J,K,L,M,N,O,P,Q),
+ mode_info(A,B,C,D,E,F,G,ModeContext,I,J,K,L,M,N,O,P,Q)).
%-----------------------------------------------------------------------------%
@@ -479,7 +510,8 @@
%-----------------------------------------------------------------------------%
-mode_info_get_instmap(mode_info(_,_,_,_,_,_,_,_,InstMap,_,_,_,_,_,_,_), InstMap).
+mode_info_get_instmap(mode_info(_,_,_,_,_,_,_,_,InstMap,_,_,_,_,_,_,_,_),
+ InstMap).
% mode_info_dcg_get_instmap/3 is the same as mode_info_get_instmap/2
% except that it's easier to use inside a DCG.
@@ -490,8 +522,8 @@
%-----------------------------------------------------------------------------%
mode_info_set_instmap( InstMap,
- mode_info(A,B,C,D,E,F,G,H,InstMap0,J,DelayInfo0,L,M,N,O,P),
- mode_info(A,B,C,D,E,F,G,H,InstMap,J,DelayInfo,L,M,N,O,P)) :-
+ mode_info(A,B,C,D,E,F,G,H,InstMap0,J,DelayInfo0,L,M,N,O,P,Q),
+ mode_info(A,B,C,D,E,F,G,H,InstMap,J,DelayInfo,L,M,N,O,P,Q)) :-
( instmap__is_unreachable(InstMap), instmap__is_reachable(InstMap0) ->
delay_info__bind_all_vars(DelayInfo0, DelayInfo)
;
@@ -500,28 +532,28 @@
%-----------------------------------------------------------------------------%
-mode_info_get_locked_vars(mode_info(_,_,_,_,_,_,_,_,_,LockedVars,_,_,_,_,_,_),
+mode_info_get_locked_vars(mode_info(_,_,_,_,_,_,_,_,_,LockedVars,_,_,_,_,_,_,_),
LockedVars).
%-----------------------------------------------------------------------------%
-mode_info_set_locked_vars( mode_info(A,B,C,D,E,F,G,H,I,_,K,L,M,N,O,P), LockedVars,
- mode_info(A,B,C,D,E,F,G,H,I,LockedVars,K,L,M,N,O,P)).
+mode_info_set_locked_vars( mode_info(A,B,C,D,E,F,G,H,I,_,K,L,M,N,O,P,Q),
+ LockedVars, mode_info(A,B,C,D,E,F,G,H,I,LockedVars,K,L,M,N,O,P,Q)).
%-----------------------------------------------------------------------------%
-mode_info_get_errors(mode_info(_,_,_,_,_,_,_,_,_,_,_,Errors,_,_,_,_), Errors).
+mode_info_get_errors(mode_info(_,_,_,_,_,_,_,_,_,_,_,Errors,_,_,_,_,_), Errors).
%-----------------------------------------------------------------------------%
-mode_info_get_num_errors(mode_info(_,_,_,_,_,_,_,_,_,_,_,Errors,_,_,_,_),
+mode_info_get_num_errors(mode_info(_,_,_,_,_,_,_,_,_,_,_,Errors,_,_,_,_,_),
NumErrors) :-
list__length(Errors, NumErrors).
%-----------------------------------------------------------------------------%
-mode_info_set_errors( Errors, mode_info(A,B,C,D,E,F,G,H,I,J,K,_,M,N,O,P),
- mode_info(A,B,C,D,E,F,G,H,I,J,K,Errors,M,N,O,P)).
+mode_info_set_errors( Errors, mode_info(A,B,C,D,E,F,G,H,I,J,K,_,M,N,O,P,Q),
+ mode_info(A,B,C,D,E,F,G,H,I,J,K,Errors,M,N,O,P,Q)).
%-----------------------------------------------------------------------------%
@@ -535,9 +567,9 @@
mode_info_add_live_vars(NewLiveVars,
mode_info(A,B,C,D,E,F,G,H,I,J,K,L,
- LiveVars0,NondetLiveVars0,O,P),
+ LiveVars0,NondetLiveVars0,O,P,Q),
mode_info(A,B,C,D,E,F,G,H,I,J,K,L,
- LiveVars,NondetLiveVars,O,P)) :-
+ LiveVars,NondetLiveVars,O,P,Q)) :-
LiveVars = [NewLiveVars | LiveVars0],
NondetLiveVars = [NewLiveVars | NondetLiveVars0].
@@ -547,9 +579,9 @@
mode_info_remove_live_vars(OldLiveVars, ModeInfo0, ModeInfo) :-
ModeInfo0 = mode_info(A,B,C,D,E,F,G,H,I,J,K,L,
- LiveVars0, NondetLiveVars0,O,P),
+ LiveVars0, NondetLiveVars0,O,P,Q),
ModeInfo1 = mode_info(A,B,C,D,E,F,G,H,I,J,K,L,
- LiveVars, NondetLiveVars,O,P),
+ LiveVars, NondetLiveVars,O,P,Q),
(
list__delete_first(LiveVars0, OldLiveVars, LiveVars1),
list__delete_first(NondetLiveVars0, OldLiveVars,
@@ -576,8 +608,8 @@
% Check whether a variable is live or not
-mode_info_var_is_live(mode_info(_,_,_,_,_,_,_,_,_,_,_,_,LiveVarsList,_,_,_), Var,
- Result) :-
+mode_info_var_is_live(mode_info(_,_,_,_,_,_,_,_,_,_,_,_,LiveVarsList,_,_,_,_),
+ Var, Result) :-
(
% some [LiveVars]
list__member(LiveVars, LiveVarsList),
@@ -591,7 +623,7 @@
% Check whether a variable is nondet_live or not.
mode_info_var_is_nondet_live(mode_info(_,_,_,_,_,_,_,_,_,_,_,_,_,
- NondetLiveVarsList,_,_), Var, Result) :-
+ NondetLiveVarsList,_,_,_), Var, Result) :-
(
% some [LiveVars]
list__member(LiveVars, NondetLiveVarsList),
@@ -602,7 +634,7 @@
Result = dead
).
-mode_info_get_liveness(mode_info(_,_,_,_,_,_,_,_,_,_,_,_,LiveVarsList,_,_,_),
+mode_info_get_liveness(mode_info(_,_,_,_,_,_,_,_,_,_,_,_,LiveVarsList,_,_,_,_),
LiveVars) :-
set__init(LiveVars0),
mode_info_get_liveness_2(LiveVarsList, LiveVars0, LiveVars).
@@ -612,12 +644,12 @@
set__union(LiveVars0, LiveVarsSet, LiveVars1),
mode_info_get_liveness_2(LiveVarsList, LiveVars1, LiveVars).
-mode_info_get_live_vars(mode_info(_,_,_,_,_,_,_,_,_,_,_,_,LiveVarsList,_,_,_),
+mode_info_get_live_vars(mode_info(_,_,_,_,_,_,_,_,_,_,_,_,LiveVarsList,_,_,_,_),
LiveVarsList).
mode_info_set_live_vars(LiveVarsList,
- mode_info(A,B,C,D,E,F,G,H,I,J,K,L,_,N,O,P),
- mode_info(A,B,C,D,E,F,G,H,I,J,K,L,LiveVarsList,N,O,P)).
+ mode_info(A,B,C,D,E,F,G,H,I,J,K,L,_,N,O,P,Q),
+ mode_info(A,B,C,D,E,F,G,H,I,J,K,L,LiveVarsList,N,O,P,Q)).
%-----------------------------------------------------------------------------%
@@ -670,33 +702,39 @@
mode_info_var_is_locked_2(Sets, Var, Reason)
).
-mode_info_get_delay_info(mode_info(_,_,_,_,_,_,_,_,_,_,DelayInfo,_,_,_,_,_),
+mode_info_get_delay_info(mode_info(_,_,_,_,_,_,_,_,_,_,DelayInfo,_,_,_,_,_,_),
DelayInfo).
-mode_info_set_delay_info(DelayInfo, mode_info(A,B,C,D,E,F,G,H,I,J,_,L,M,N,O,P),
- mode_info(A,B,C,D,E,F,G,H,I,J,DelayInfo,L,M,N,O,P)).
+mode_info_set_delay_info(DelayInfo,
+ mode_info(A,B,C,D,E,F,G,H,I,J,_,L,M,N,O,P,Q),
+ mode_info(A,B,C,D,E,F,G,H,I,J,DelayInfo,L,M,N,O,P,Q)).
mode_info_get_nondet_live_vars(mode_info(_,_,_,_,_,_,_,_,_,_,_,_,_,
- NondetLiveVars,_,_), NondetLiveVars).
+ NondetLiveVars,_,_,_), NondetLiveVars).
mode_info_set_nondet_live_vars(NondetLiveVars,
- mode_info(A,B,C,D,E,F,G,H,I,J,K,L,M,_,O,P),
- mode_info(A,B,C,D,E,F,G,H,I,J,K,L,M,NondetLiveVars,O,P)).
+ mode_info(A,B,C,D,E,F,G,H,I,J,K,L,M,_,O,P,Q),
+ mode_info(A,B,C,D,E,F,G,H,I,J,K,L,M,NondetLiveVars,O,P,Q)).
mode_info_get_last_checkpoint_insts(mode_info(_,_,_,_,_,_,_,_,_,_,_,_,_,_,
- LastCheckpointInsts,_), LastCheckpointInsts).
+ LastCheckpointInsts,_,_), LastCheckpointInsts).
mode_info_set_last_checkpoint_insts(LastCheckpointInsts,
- mode_info(A,B,C,D,E,F,G,H,I,J,K,L,M,N,_,P),
+ mode_info(A,B,C,D,E,F,G,H,I,J,K,L,M,N,_,P,Q),
mode_info(A,B,C,D,E,F,G,H,I,J,K,L,M,N,
- LastCheckpointInsts,P)).
+ LastCheckpointInsts,P,Q)).
-mode_info_get_changed_flag(mode_info(_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,Changed),
+mode_info_get_changed_flag(mode_info(_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,Changed,_),
Changed).
mode_info_set_changed_flag(Changed,
- mode_info(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,_),
- mode_info(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,Changed)).
+ mode_info(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,_,Q),
+ mode_info(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,Changed,Q)).
+
+mode_info_get_how_to_check(mode_info(_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,How), How).
+
+mode_info_set_how_to_check(How, mode_info(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,_),
+ mode_info(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,How)).
%-----------------------------------------------------------------------------%
Index: compiler/modecheck_unify.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/modecheck_unify.m,v
retrieving revision 1.34
diff -u -r1.34 modecheck_unify.m
--- modecheck_unify.m 1998/03/04 19:47:36 1.34
+++ modecheck_unify.m 1998/03/10 23:48:18
@@ -20,14 +20,13 @@
:- module modecheck_unify.
:- interface.
-:- import_module hlds_goal, hlds_data, prog_data, mode_info, modes.
+:- import_module hlds_goal, hlds_data, prog_data, mode_info.
:- import_module map, term, list.
% Modecheck a unification
:- pred modecheck_unification( var, unify_rhs, unification, unify_context,
- hlds_goal_info, how_to_check_goal, hlds_goal_expr,
- mode_info, mode_info).
-:- mode modecheck_unification(in, in, in, in, in, in, out,
+ hlds_goal_info, hlds_goal_expr, mode_info, mode_info).
+:- mode modecheck_unification(in, in, in, in, in, out,
mode_info_di, mode_info_uo) is det.
% Work out what kind of unification a var-var unification is.
@@ -61,7 +60,7 @@
%-----------------------------------------------------------------------------%
-modecheck_unification(X, var(Y), _Unification0, UnifyContext, _GoalInfo, _,
+modecheck_unification(X, var(Y), _Unification0, UnifyContext, _GoalInfo,
Unify, ModeInfo0, ModeInfo) :-
mode_info_get_module_info(ModeInfo0, ModuleInfo0),
mode_info_get_instmap(ModeInfo0, InstMap0),
@@ -109,14 +108,14 @@
).
modecheck_unification(X0, functor(ConsId0, ArgVars0), Unification0,
- UnifyContext, GoalInfo0, HowToCheckGoal,
- Goal, ModeInfo0, ModeInfo) :-
+ UnifyContext, GoalInfo0, Goal, ModeInfo0, ModeInfo) :-
mode_info_get_module_info(ModeInfo0, ModuleInfo0),
mode_info_get_var_types(ModeInfo0, VarTypes0),
map__lookup(VarTypes0, X0, TypeOfX),
module_info_get_predicate_table(ModuleInfo0, PredTable),
list__length(ArgVars0, Arity),
mode_info_get_predid(ModeInfo0, ThisPredId),
+ mode_info_get_how_to_check(ModeInfo0, HowToCheckGoal),
(
%
% is the function symbol apply/N or ''/N,
@@ -126,7 +125,7 @@
% then don't bother checking, since they will have already
% been expanded.)
%
- HowToCheckGoal \= check_unique_modes,
+ HowToCheckGoal \= check_unique_modes(_),
ConsId0 = cons(unqualified(ApplyName), _),
( ApplyName = "apply" ; ApplyName = "" ),
Arity >= 1,
@@ -150,7 +149,7 @@
% As an optimization, if HowToCheck = check_unique_modes,
% then don't bother checking, since they will have already
% been expanded.
- HowToCheckGoal \= check_unique_modes,
+ HowToCheckGoal \= check_unique_modes(_),
% Find the set of candidate predicates which have the
% specified name and arity (and module, if module-qualified)
@@ -319,8 +318,7 @@
Functor0 = lambda_goal(PredOrFunc, ArgVars0, LambdaVars,
LambdaModes, LambdaDet, LambdaGoal),
modecheck_unification( X0, Functor0, Unification0, UnifyContext,
- GoalInfo0, HowToCheckGoal, Goal,
- ModeInfo2, ModeInfo)
+ GoalInfo0, Goal, ModeInfo2, ModeInfo)
;
%
% It's not a higher-order pred unification - just
@@ -328,13 +326,12 @@
%
modecheck_unify_functor(X0, TypeOfX,
ConsId0, ArgVars0, Unification0, UnifyContext,
- HowToCheckGoal, GoalInfo0,
- Goal, ModeInfo0, ModeInfo)
+ GoalInfo0, Goal, ModeInfo0, ModeInfo)
).
modecheck_unification(X,
lambda_goal(PredOrFunc, ArgVars, Vars, Modes0, Det, Goal0),
- Unification0, UnifyContext, _GoalInfo, HowToCheckGoal,
+ Unification0, UnifyContext, _GoalInfo,
unify(X, RHS, Mode, Unification, UnifyContext),
ModeInfo0, ModeInfo) :-
%
@@ -375,6 +372,7 @@
%
mode_info_get_module_info(ModeInfo0, ModuleInfo0),
+ mode_info_get_how_to_check(ModeInfo0, HowToCheckGoal),
( HowToCheckGoal = check_modes ->
% This only needs to be done once.
@@ -452,7 +450,7 @@
% 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, Goal, ModeInfo6,
ModeInfo7)
@@ -511,7 +509,7 @@
list(mode), determinism, unify_rhs, unification,
pair(mode), unify_rhs, unification, mode_info, mode_info).
:- mode modecheck_unify_lambda(in, in, in, in, in, in, in,
- out, out, out, mode_info_di, mode_info_uo) is det.
+ out, out, out, mode_info_di, mode_info_uo) is det.
modecheck_unify_lambda(X, PredOrFunc, ArgVars, LambdaModes,
LambdaDet, RHS0, Unification0, Mode, RHS, Unification,
@@ -561,15 +559,16 @@
).
:- pred modecheck_unify_functor(var, (type), cons_id, list(var), unification,
- unify_context, how_to_check_goal, hlds_goal_info,
+ unify_context, hlds_goal_info,
hlds_goal_expr, mode_info, mode_info).
-:- mode modecheck_unify_functor(in, in, in, in, in, in, in, in,
+:- mode modecheck_unify_functor(in, in, in, in, in, in, in,
out, mode_info_di, mode_info_uo) is det.
modecheck_unify_functor(X, TypeOfX, ConsId0, ArgVars0, Unification0,
- UnifyContext, HowToCheckGoal, GoalInfo0,
- Goal, ModeInfo0, ModeInfo) :-
+ UnifyContext, GoalInfo0, Goal, ModeInfo0, ModeInfo) :-
mode_info_get_module_info(ModeInfo0, ModuleInfo0),
+ mode_info_get_how_to_check(ModeInfo0, HowToCheckGoal),
+
%
% fully module qualify all cons_ids
% (except for builtins such as ints and characters).
@@ -732,7 +731,7 @@
% wouldn't have the correct determinism annotations.)
%
(
- HowToCheckGoal = check_unique_modes,
+ HowToCheckGoal = check_unique_modes(_),
ExtraGoals \= no_extra_goals,
instmap__is_reachable(InstMap0)
->
Index: compiler/modes.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/modes.m,v
retrieving revision 1.222
diff -u -r1.222 modes.m
--- modes.m 1998/03/24 00:06:48 1.222
+++ modes.m 1998/03/30 02:15:59
@@ -190,12 +190,6 @@
% Modecheck a unification.
- % This argument specifies how to recursively process lambda goals -
- % using either modes.m or unique_modes.m.
-:- type how_to_check_goal
- ---> check_modes
- ; check_unique_modes.
-
% given the right-hand-side of a unification, return a list of
% the potentially non-local variables of that unification.
%
@@ -336,7 +330,7 @@
MaxIterations),
modecheck_to_fixpoint(PredIds, MaxIterations, WhatToCheck, ModuleInfo0,
ModuleInfo, UnsafeToContinue),
- ( { WhatToCheck = check_unique_modes },
+ ( { WhatToCheck = check_unique_modes(_) },
write_mode_inference_messages(PredIds, yes, ModuleInfo)
; { WhatToCheck = check_modes },
( { UnsafeToContinue = yes } ->
@@ -463,7 +457,7 @@
( { WhatToCheck = check_modes },
write_pred_progress_message("% Mode-analysing ",
PredId, ModuleInfo)
- ; { WhatToCheck = check_unique_modes },
+ ; { WhatToCheck = check_unique_modes(_) },
write_pred_progress_message("% Unique-mode-analysing ",
PredId, ModuleInfo)
)
@@ -471,7 +465,7 @@
( { WhatToCheck = check_modes },
write_pred_progress_message("% Mode-checking ",
PredId, ModuleInfo)
- ; { WhatToCheck = check_unique_modes },
+ ; { WhatToCheck = check_unique_modes(_) },
write_pred_progress_message("% Unique-mode-checking ",
PredId, ModuleInfo)
)
@@ -676,12 +670,12 @@
set__list_to_set(LiveVarsList, LiveVars),
% initialize the mode info
- mode_info_init(IOState0, ModuleInfo0, PredId, ProcId,
- Context, LiveVars, InstMap0, ModeInfo0),
+ mode_info_init(IOState0, ModuleInfo0, PredId, ProcId, Context,
+ LiveVars, InstMap0, WhatToCheck, ModeInfo0),
mode_info_set_changed_flag(Changed0, ModeInfo0, ModeInfo1),
% modecheck the procedure body
- ( WhatToCheck = check_unique_modes ->
+ ( WhatToCheck = check_unique_modes(_) ->
unique_modes__check_goal(Body0, Body, ModeInfo1, ModeInfo2)
;
modecheck_goal(Body0, Body, ModeInfo1, ModeInfo2)
@@ -963,7 +957,7 @@
mode_checkpoint(enter, "unify"),
mode_info_set_call_context(unify(UnifyContext)),
modecheck_unification(A0, B0, UnifyInfo0, UnifyContext, GoalInfo0,
- check_modes, Goal),
+ Goal),
mode_info_unset_call_context,
mode_checkpoint(exit, "unify").
More information about the developers
mailing list