[m-rev.] diff: clean up more of the termination analyser
Julien Fischer
juliensf at students.cs.mu.OZ.AU
Sat Jan 31 11:51:29 AEDT 2004
Estimated hours taken: 0.5
Branches: main
Clean up some of the modules in the termination analyser.
This diff doesn't change any algorithms.
compiler/term_pass1.m:
compiler/term_pass2.m:
compiler/term_traversal.m:
compiler/term_util.m:
Use state variables where appropriate.
Rename some variables.
Call unexpected/2 rather than error/1.
Fix some incorrect error messages.
Use predmode declarations.
Add end_module declarations.
Replace calls to module_info_pred_proc_info/5 with
calls to module_info_pred_proc_info/4 and calls to
int.to_float/2 with calls to float.float/1.
Fix some minor layout/indentation problems.
Julien.
Index: compiler/term_pass1.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/term_pass1.m,v
retrieving revision 1.14
diff -u -r1.14 term_pass1.m
--- compiler/term_pass1.m 15 Dec 2003 07:11:05 -0000 1.14
+++ compiler/term_pass1.m 30 Jan 2004 04:41:35 -0000
@@ -46,9 +46,10 @@
:- pred find_arg_sizes_in_scc(list(pred_proc_id)::in, module_info::in,
pass_info::in, arg_size_result::out, list(term_errors__error)::out,
- io__state::di, io__state::uo) is det.
+ io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
:- implementation.
@@ -84,7 +85,7 @@
list(term_errors__error)
).
-find_arg_sizes_in_scc(SCC, Module, PassInfo, ArgSize, TermErrors, S0, S) :-
+find_arg_sizes_in_scc(SCC, Module, PassInfo, ArgSize, TermErrors, !IO) :-
init_output_suppliers(SCC, Module, InitOutputSupplierMap),
find_arg_sizes_in_scc_fixpoint(SCC, Module, PassInfo,
InitOutputSupplierMap, Result, TermErrors),
@@ -92,14 +93,12 @@
Result = ok(Paths, OutputSupplierMap, SubsetErrors),
( SubsetErrors = [_ | _] ->
- ArgSize = error(SubsetErrors),
- S = S0
+ ArgSize = error(SubsetErrors)
; Paths = [] ->
get_context_from_scc(SCC, Module, Context),
- ArgSize = error([Context - no_eqns]),
- S = S0
+ ArgSize = error([Context - no_eqns])
;
- solve_equations(Paths, SCC, MaybeSolution, S0, S),
+ solve_equations(Paths, SCC, MaybeSolution, !IO),
(
MaybeSolution = yes(Solution),
ArgSize = ok(Solution, OutputSupplierMap)
@@ -111,8 +110,7 @@
)
;
Result = error(Errors),
- ArgSize = error(Errors),
- S = S0
+ ArgSize = error(Errors)
).
%-----------------------------------------------------------------------------%
@@ -128,8 +126,7 @@
map__init(InitMap).
init_output_suppliers([PPId | PPIds], Module, OutputSupplierMap) :-
init_output_suppliers(PPIds, Module, OutputSupplierMap0),
- PPId = proc(PredId, ProcId),
- module_info_pred_proc_info(Module, PredId, ProcId, _, ProcInfo),
+ module_info_pred_proc_info(Module, PPId, _, ProcInfo),
proc_info_headvars(ProcInfo, HeadVars),
MapToNo = (pred(_HeadVar::in, Bool::out) is det :- Bool = no),
list__map(MapToNo, HeadVars, BoolList),
@@ -209,8 +206,7 @@
find_arg_sizes_pred(PPId, Module, PassInfo, OutputSupplierMap0, Result,
TermErrors) :-
- PPId = proc(PredId, ProcId),
- module_info_pred_proc_info(Module, PredId, ProcId, PredInfo, ProcInfo),
+ module_info_pred_proc_info(Module, PPId, PredInfo, ProcInfo),
pred_info_context(PredInfo, Context),
proc_info_headvars(ProcInfo, Args),
proc_info_argmodes(ProcInfo, ArgModes),
@@ -254,9 +250,9 @@
update_output_suppliers([], _ActiveVars, [], []).
update_output_suppliers([_ | _], _ActiveVars, [], []) :-
- error("update_output_suppliers: Unmatched variables").
+ unexpected(this_file, "update_output_suppliers/4: umatched variables.").
update_output_suppliers([], _ActiveVars, [_ | _], []) :-
- error("update_output_suppliers: Unmatched variables").
+ unexpected(this_file, "update_output_suppliers/4: umatched variables.").
update_output_suppliers([Arg | Args], ActiveVars,
[OutputSupplier0 | OutputSuppliers0],
[OutputSupplier | OutputSuppliers]) :-
@@ -364,8 +360,8 @@
"shorthand goal encountered during termination analysis.").
:- pred check_cases_non_term_calls(module_info::in, pred_proc_id::in,
- vartypes::in, case::in,
- list(term_errors__error)::in, list(term_errors__error)::out) is det.
+ vartypes::in, case::in, list(term_errors__error)::in,
+ list(term_errors__error)::out) is det.
check_cases_non_term_calls(Module, PPId, VarTypes, case(_, Goal), !Errors) :-
check_goal_non_term_calls(Module, PPId, VarTypes, Goal, !Errors).
@@ -389,10 +385,9 @@
% be negative even when a#_# and b are both positive.
:- pred solve_equations(list(path_info)::in, list(pred_proc_id)::in,
- maybe(list(pair(pred_proc_id, int)))::out,
- io__state::di, io__state::uo) is det.
+ maybe(list(pair(pred_proc_id, int)))::out, io::di, io::uo) is det.
-solve_equations(Paths, PPIds, Result, S0, S) :-
+solve_equations(Paths, PPIds, Result, !IO) :-
(
convert_equations(Paths, Varset, Equations,
Objective, PPVars)
@@ -407,7 +402,7 @@
% unsafe_perform_io(io__write(AllVars)),
% unsafe_perform_io(io__write_string("\n")),
lp_solve(Equations, min, Objective, Varset, AllVars, Soln,
- S0, S),
+ !IO),
% unsafe_perform_io(io__write_string("after\n")),
(
Soln = unsatisfiable,
@@ -419,8 +414,7 @@
Result = yes(SolutionList)
)
;
- Result = no,
- S = S0
+ Result = no
).
:- pred convert_equations(list(path_info)::in, varset::out, lp__equations::out,
@@ -428,9 +422,9 @@
convert_equations(Paths, Varset, Equations, Objective, PPVars) :-
varset__init(Varset0),
- map__init(PredProcVars0),
+ map__init(PPVars0),
set__init(EqnSet0),
- convert_equations_2(Paths, PredProcVars0, PPVars, Varset0, Varset,
+ convert_equations_2(Paths, PPVars0, PPVars, Varset0, Varset,
EqnSet0, EqnSet),
set__to_sorted_list(EqnSet, Equations),
map__values(PPVars, Vars),
@@ -442,25 +436,21 @@
varset::in, varset::out,
set(lp__equation)::in, set(lp__equation)::out) is semidet.
-convert_equations_2([], PPVars, PPVars, Varset, Varset, Eqns, Eqns).
-convert_equations_2([Path | Paths], PPVars0, PPVars, Varset0, Varset,
- Eqns0, Eqns) :-
+convert_equations_2([], !PPVars, !Varset, !Eqns).
+convert_equations_2([Path | Paths], !PPVars, !Varset, !Eqns) :-
Path = path_info(ThisPPId, _, IntGamma, PPIds, _),
- int__to_float(IntGamma, FloatGamma),
+ FloatGamma = float__float(IntGamma),
Eqn = eqn(Coeffs, (>=), FloatGamma),
- pred_proc_var(ThisPPId, ThisVar, Varset0, Varset2, PPVars0, PPVars1),
+ pred_proc_var(ThisPPId, ThisVar, !Varset, !PPVars),
Coeffs = [ThisVar - 1.0 | RestCoeffs],
- Convert = (pred(PPId::in, Coeff::out, Pair0::in, Pair::out) is det :-
- Pair0 = VS0 - PPV0,
- pred_proc_var(PPId, Var, VS0, VS, PPV0, PPV),
- Coeff = Var - (-1.0),
- Pair = VS - PPV
+ Convert = (pred(PPId::in, Coeff::out, !.VS::in, !:VS::out, !.PPV::in,
+ !:PPV::out) is det :-
+ pred_proc_var(PPId, Var, !VS, !PPV),
+ Coeff = Var - (-1.0)
),
- list__map_foldl(Convert, PPIds, RestCoeffs, Varset2 - PPVars1,
- Varset3 - PPVars2),
- set__insert(Eqns0, Eqn, Eqns1),
- convert_equations_2(Paths, PPVars2, PPVars, Varset3, Varset,
- Eqns1, Eqns).
+ list__map_foldl2(Convert, PPIds, RestCoeffs, !Varset, !PPVars),
+ set__insert(!.Eqns, Eqn, !:Eqns),
+ convert_equations_2(Paths, !PPVars, !Varset, !Eqns).
:- pred lookup_coeff(map(pred_proc_id, var)::in, map(var, float)::in,
pred_proc_id::in, pair(pred_proc_id, int)::out) is det.
@@ -473,14 +463,12 @@
:- pred pred_proc_var(pred_proc_id::in, var::out, varset::in, varset::out,
map(pred_proc_id, var)::in, map(pred_proc_id, var)::out) is det.
-pred_proc_var(PPId, Var, Varset0, Varset, PPVars0, PPVars) :-
- ( map__search(PPVars0, PPId, Var0) ->
- Var = Var0,
- Varset = Varset0,
- PPVars = PPVars0
+pred_proc_var(PPId, Var, !Varset, !PPVars) :-
+ ( map__search(!.PPVars, PPId, Var0) ->
+ Var = Var0
;
- varset__new_var(Varset0, Var, Varset),
- map__det_insert(PPVars0, PPId, Var, PPVars)
+ varset__new_var(!.Varset, Var, !:Varset),
+ map__det_insert(!.PPVars, PPId, Var, !:PPVars)
).
%-----------------------------------------------------------------------------%
Index: compiler/term_pass2.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/term_pass2.m,v
retrieving revision 1.14
diff -u -r1.14 term_pass2.m
--- compiler/term_pass2.m 15 Dec 2003 07:11:05 -0000 1.14
+++ compiler/term_pass2.m 30 Jan 2004 04:19:28 -0000
@@ -1,8 +1,8 @@
-%-----------------------------------------------------------------------------
+%-----------------------------------------------------------------------------%
% Copyright (C) 1997-1998, 2003 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
-%-----------------------------------------------------------------------------
+%-----------------------------------------------------------------------------%
%
% term_pass2.m
%
@@ -12,9 +12,10 @@
% This file contains the code that tries to prove that procedures terminate.
%
% For details, please refer to the papers mentioned in termination.m.
-%-----------------------------------------------------------------------------
+%-----------------------------------------------------------------------------%
:- module transform_hlds__term_pass2.
+
:- interface.
:- import_module hlds__hlds_module.
@@ -29,17 +30,21 @@
:- pred prove_termination_in_scc(list(pred_proc_id)::in, module_info::in,
pass_info::in, int::in, termination_info::out) is det.
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
:- implementation.
-:- import_module transform_hlds__term_traversal.
-:- import_module transform_hlds__term_errors.
+:- import_module check_hlds__mode_util.
+:- import_module check_hlds__type_util.
+:- import_module hlds__error_util.
:- import_module hlds__hlds_goal.
:- import_module parse_tree__prog_data.
-:- import_module check_hlds__type_util.
-:- import_module check_hlds__mode_util.
+:- import_module transform_hlds__term_traversal.
+:- import_module transform_hlds__term_errors.
-:- import_module std_util, bool, int, assoc_list.
-:- import_module set, bag, map, term, require.
+:- import_module assoc_list, bag, bool, int, map, require, set, std_util.
+:- import_module string, term.
:- type fixpoint_dir
---> up
@@ -66,7 +71,7 @@
list(term_errors__error)
).
-%-----------------------------------------------------------------------------
+%-----------------------------------------------------------------------------%
prove_termination_in_scc(SCC, Module, PassInfo, SingleArgs, Termination) :-
init_rec_input_suppliers(SCC, Module, InitRecSuppliers),
@@ -109,8 +114,7 @@
map__init(InitMap).
init_rec_input_suppliers([PPId | PPIds], Module, RecSupplierMap) :-
init_rec_input_suppliers(PPIds, Module, RecSupplierMap0),
- PPId = proc(PredId, ProcId),
- module_info_pred_proc_info(Module, PredId, ProcId, _, ProcInfo),
+ module_info_pred_proc_info(Module, PPId, _, ProcInfo),
proc_info_headvars(ProcInfo, HeadVars),
proc_info_argmodes(ProcInfo, ArgModes),
partition_call_args(Module, ArgModes, HeadVars, InArgs, _OutVars),
@@ -124,7 +128,7 @@
list__map(MapIsInput, HeadVars, BoolList),
map__det_insert(RecSupplierMap0, PPId, BoolList, RecSupplierMap).
-%-----------------------------------------------------------------------------
+%-----------------------------------------------------------------------------%
% Perform single arg analysis on the SCC.
%
@@ -153,7 +157,9 @@
prove_termination_in_scc_single_arg_2(TrialPPId, RestSCC, 1,
Module, PassInfo)
;
- error("empty SCC in prove_termination_in_scc_single_arg")
+
+ unexpected(this_file,
+ "prove_termination_in_scc_single_arg/3: empty SCC.")
).
% Find a procedure of minimum arity among the given list and the
@@ -202,8 +208,7 @@
init_rec_input_suppliers_single_arg(TrialPPId, RestSCC, ArgNum, Module,
RecSupplierMap) :-
- TrialPPId = proc(PredId, ProcId),
- module_info_pred_proc_info(Module, PredId, ProcId, _, ProcInfo),
+ module_info_pred_proc_info(Module, TrialPPId, _, ProcInfo),
proc_info_argmodes(ProcInfo, ArgModes),
init_rec_input_suppliers_add_single_arg(ArgModes, ArgNum,
Module, TrialPPIdRecSuppliers),
@@ -248,27 +253,24 @@
:- pred init_rec_input_suppliers_single_arg_others(list(pred_proc_id)::in,
module_info::in, used_args::in, used_args::out) is det.
-init_rec_input_suppliers_single_arg_others([], _,
- RecSupplierMap, RecSupplierMap).
+init_rec_input_suppliers_single_arg_others([], _, !RecSupplierMap).
init_rec_input_suppliers_single_arg_others([PPId | PPIds], Module,
- RecSupplierMap0, RecSupplierMap) :-
- PPId = proc(PredId, ProcId),
- module_info_pred_proc_info(Module, PredId, ProcId, _, ProcInfo),
+ !RecSupplierMap) :-
+ module_info_pred_proc_info(Module, PPId, _, ProcInfo),
proc_info_headvars(ProcInfo, HeadVars),
list__map(map_to_no, HeadVars, BoolList),
- map__det_insert(RecSupplierMap0, PPId, BoolList, RecSupplierMap1),
+ map__det_insert(!.RecSupplierMap, PPId, BoolList, !:RecSupplierMap),
init_rec_input_suppliers_single_arg_others(PPIds, Module,
- RecSupplierMap1, RecSupplierMap).
+ !RecSupplierMap).
:- pred lookup_proc_arity(pred_proc_id::in, module_info::in, int::out) is det.
lookup_proc_arity(PPId, Module, Arity) :-
- PPId = proc(PredId, ProcId),
- module_info_pred_proc_info(Module, PredId, ProcId, _, ProcInfo),
+ module_info_pred_proc_info(Module, PPId, _, ProcInfo),
proc_info_headvars(ProcInfo, HeadVars),
list__length(HeadVars, Arity).
-%-----------------------------------------------------------------------------
+%-----------------------------------------------------------------------------%
:- pred prove_termination_in_scc_trial(list(pred_proc_id)::in, used_args::in,
fixpoint_dir::in, module_info::in, pass_info::in,
@@ -303,7 +305,7 @@
Termination = can_loop(Errors)
).
-%-----------------------------------------------------------------------------
+%-----------------------------------------------------------------------------%
:- pred prove_termination_in_scc_fixpoint(list(pred_proc_id)::in,
fixpoint_dir::in, module_info::in, pass_info::in, used_args::in,
@@ -334,7 +336,7 @@
Result = Result1
).
-%-----------------------------------------------------------------------------
+%-----------------------------------------------------------------------------%
% Process a whole SCC, to determine the termination property of each
% procedure in that SCC.
@@ -348,8 +350,7 @@
prove_termination_in_scc_pass([PPId | PPIds], FixDir, Module, PassInfo,
RecSupplierMap, NewRecSupplierMap0, CallInfo0, Result) :-
% Get the goal info.
- PPId = proc(PredId, ProcId),
- module_info_pred_proc_info(Module, PredId, ProcId, PredInfo, ProcInfo),
+ module_info_pred_proc_info(Module, PPId, PredInfo, ProcInfo),
pred_info_context(PredInfo, Context),
proc_info_goal(ProcInfo, Goal),
proc_info_vartypes(ProcInfo, VarTypes),
@@ -386,27 +387,27 @@
Result = error(Errors)
).
-%-----------------------------------------------------------------------------
+%-----------------------------------------------------------------------------%
:- pred update_rec_input_suppliers(list(prog_var)::in, bag(prog_var)::in,
fixpoint_dir::in, list(bool)::in, list(bool)::out,
bag(prog_var)::in, bag(prog_var)::out) is det.
-update_rec_input_suppliers([], _, _, [], [], RecBag, RecBag).
+update_rec_input_suppliers([], _, _, [], [], !RecBag).
update_rec_input_suppliers([_ | _], _, _, [], [], _, _) :-
- error("update_rec_input_suppliers: Unmatched variables").
+ unexpected(this_file,
+ "update_rec_input_suppliers/7: unmatched variables.").
update_rec_input_suppliers([], _, _, [_ | _], [], _, _) :-
- error("update_rec_input_suppliers: Unmatched variables").
+ unexpected(this_file,
+ "update_rec_input_suppliers/7: unmatched variables.").
update_rec_input_suppliers([Arg | Args], ActiveVars, FixDir,
[RecInputSupplier0 | RecInputSuppliers0],
- [RecInputSupplier | RecInputSuppliers],
- RecBag0, RecBag) :-
+ [RecInputSupplier | RecInputSuppliers], !RecBag) :-
(
RecInputSupplier0 = yes,
- bag__insert(RecBag0, Arg, RecBag1)
+ bag__insert(!.RecBag, Arg, !:RecBag)
;
- RecInputSupplier0 = no,
- RecBag1 = RecBag0
+ RecInputSupplier0 = no
),
(
FixDir = down,
@@ -428,9 +429,9 @@
)
),
update_rec_input_suppliers(Args, ActiveVars, FixDir,
- RecInputSuppliers0, RecInputSuppliers, RecBag1, RecBag).
+ RecInputSuppliers0, RecInputSuppliers, !RecBag).
-%-----------------------------------------------------------------------------
+%-----------------------------------------------------------------------------%
% This adds the information from a stage 2 traversal to the graph.
% The graph's nodes are the procedures in the current SCC.
@@ -441,24 +442,26 @@
% in the head of p. If there is no finite upper bound, then we insert the
% details of the call into the list of "infinite" calls.
-:- pred add_call_arcs(list(path_info)::in,
- bag(prog_var)::in, call_weight_info::in, call_weight_info::out) is det.
+:- pred add_call_arcs(list(path_info)::in, bag(prog_var)::in,
+ call_weight_info::in, call_weight_info::out) is det.
-add_call_arcs([], _RecInputSuppliers, CallInfo, CallInfo).
-add_call_arcs([Path | Paths], RecInputSuppliers, CallInfo0, CallInfo) :-
+add_call_arcs([], _RecInputSuppliers, !CallInfo).
+add_call_arcs([Path | Paths], RecInputSuppliers, !CallInfo) :-
Path = path_info(PPId, CallSite, GammaConst, GammaVars, ActiveVars),
( CallSite = yes(CallPPIdPrime - ContextPrime) ->
CallPPId = CallPPIdPrime,
Context = ContextPrime
;
- error("no call site in path in stage 2")
+ unexpected(this_file,
+ "add_call_arcs/4: no call site in path in stage 2.")
),
( GammaVars = [] ->
true
;
- error("gamma variables in path in stage 2")
+ unexpected(this_file,
+ "add_call_arc/4: gamma variables in path in stage 2.")
),
- CallInfo0 = InfCalls0 - CallWeights0,
+ !.CallInfo = InfCalls0 - CallWeights0,
( bag__is_subbag(ActiveVars, RecInputSuppliers) ->
( map__search(CallWeights0, PPId, NeighbourMap0) ->
( map__search(NeighbourMap0, CallPPId, OldEdgeInfo) ->
@@ -483,14 +486,14 @@
map__det_insert(CallWeights0, PPId, NeighbourMap,
CallWeights1)
),
- CallInfo1 = InfCalls0 - CallWeights1
+ !:CallInfo = InfCalls0 - CallWeights1
;
InfCalls1 = [Context - inf_call(PPId, CallPPId) | InfCalls0],
- CallInfo1 = InfCalls1 - CallWeights0
+ !:CallInfo = InfCalls1 - CallWeights0
),
- add_call_arcs(Paths, RecInputSuppliers, CallInfo1, CallInfo).
+ add_call_arcs(Paths, RecInputSuppliers, !CallInfo).
-%-----------------------------------------------------------------------------
+%-----------------------------------------------------------------------------%
% We use a simple depth first search to find and return the list
% of all cycles in the call graph of the SCC where the change in
@@ -587,10 +590,16 @@
NewVisitedCalls, CallWeights, Cycles)
).
-%-----------------------------------------------------------------------------
+%-----------------------------------------------------------------------------%
:- pred map_to_no(T::in, bool::out) is det.
map_to_no(_, no).
-%-----------------------------------------------------------------------------
+:- func this_file = string.
+
+this_file = "term_pass2.m".
+
+%-----------------------------------------------------------------------------%
+:- end_module term_pass2.
+%-----------------------------------------------------------------------------%
Index: compiler/term_traversal.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/term_traversal.m,v
retrieving revision 1.26
diff -u -r1.26 term_traversal.m
--- compiler/term_traversal.m 15 Dec 2003 07:11:06 -0000 1.26
+++ compiler/term_traversal.m 30 Jan 2004 04:42:33 -0000
@@ -100,30 +100,34 @@
:- pred upper_bound_active_vars(list(path_info)::in, bag(prog_var)::out) is det.
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
:- implementation.
:- import_module check_hlds__type_util.
+:- import_module hlds__error_util.
:- import_module hlds__hlds_data.
-:- import_module assoc_list, bool, int, require.
+:- import_module assoc_list, bool, int, require, string.
-traverse_goal(Goal, Params, Info0, Info) :-
+traverse_goal(Goal, Params, !Info) :-
Goal = GoalExpr - GoalInfo,
(
goal_info_get_determinism(GoalInfo, Detism),
determinism_components(Detism, _, at_most_zero)
->
- cannot_succeed(Info0, Info1)
+ cannot_succeed(!Info)
;
- Info1 = Info0
+ true
),
- traverse_goal_2(GoalExpr, GoalInfo, Params, Info1, Info).
+ traverse_goal_2(GoalExpr, GoalInfo, Params, !Info).
:- pred traverse_goal_2(hlds_goal_expr::in, hlds_goal_info::in,
traversal_params::in, traversal_info::in, traversal_info::out) is det.
traverse_goal_2(unify(_Var, _RHS, _UniMode, Unification, _Context),
- _GoalInfo, Params, Info0, Info) :-
+ _GoalInfo, Params, !Info) :-
(
Unification = construct(OutVar, ConsId, Args, Modes, _, _, _),
(
@@ -131,11 +135,11 @@
Gamma, InVars, OutVars0)
->
bag__insert(OutVars0, OutVar, OutVars),
- record_change(InVars, OutVars, Gamma, [], Info0, Info)
+ record_change(InVars, OutVars, Gamma, [], !Info)
;
% length(Args) is not necessarily equal to length(Modes)
% for higher order constructions.
- Info = Info0
+ true
)
;
Unification = deconstruct(InVar, ConsId, Args, Modes, _, _),
@@ -145,63 +149,63 @@
->
bag__insert(InVars0, InVar, InVars),
Gamma = 0 - Gamma0,
- record_change(InVars, OutVars, Gamma, [], Info0, Info)
+ record_change(InVars, OutVars, Gamma, [], !Info)
;
- error("higher order deconstruction")
+ unexpected(this_file,
+ "traverse_goal_2/5: higher order deconstruction.")
)
;
Unification = assign(OutVar, InVar),
bag__init(Empty),
bag__insert(Empty, InVar, InVars),
bag__insert(Empty, OutVar, OutVars),
- record_change(InVars, OutVars, 0, [], Info0, Info)
+ record_change(InVars, OutVars, 0, [], !Info)
;
- Unification = simple_test(_InVar1, _InVar2),
- Info = Info0
+ Unification = simple_test(_InVar1, _InVar2)
;
Unification = complicated_unify(_, _, _),
- error("Unexpected complicated_unify in termination analysis")
+ unexpected(this_file, "traverse_goal_2/5: complicated unify.")
).
-traverse_goal_2(conj(Goals), _, Params, Info0, Info) :-
+traverse_goal_2(conj(Goals), _, Params, !Info) :-
list__reverse(Goals, RevGoals),
- traverse_conj(RevGoals, Params, Info0, Info).
+ traverse_conj(RevGoals, Params, !Info).
-traverse_goal_2(par_conj(Goals), _, Params, Info0, Info) :-
+traverse_goal_2(par_conj(Goals), _, Params, !Info) :-
list__reverse(Goals, RevGoals),
- traverse_conj(RevGoals, Params, Info0, Info).
+ traverse_conj(RevGoals, Params, !Info).
-traverse_goal_2(switch(_, _, Cases), _, Params, Info0, Info) :-
- traverse_switch(Cases, Params, Info0, Info).
+traverse_goal_2(switch(_, _, Cases), _, Params, !Info) :-
+ traverse_switch(Cases, Params, !Info).
-traverse_goal_2(disj(Goals), _, Params, Info0, Info) :-
- traverse_disj(Goals, Params, Info0, Info).
+traverse_goal_2(disj(Goals), _, Params, !Info) :-
+ traverse_disj(Goals, Params, !Info).
-traverse_goal_2(not(Goal), _, Params, Info0, Info) :-
+traverse_goal_2(not(Goal), _, Params, !Info) :-
% Since goal cannot bind any active variables,
% we don't need to traverse Goal for pass1,
% but it shouldn't hurt either.
- traverse_goal(Goal, Params, Info0, Info).
+ traverse_goal(Goal, Params, !Info).
-traverse_goal_2(some(_Vars, _, Goal), _GoalInfo, Params, Info0, Info) :-
- traverse_goal(Goal, Params, Info0, Info).
+traverse_goal_2(some(_Vars, _, Goal), _GoalInfo, Params, !Info) :-
+ traverse_goal(Goal, Params, !Info).
-traverse_goal_2(if_then_else(_, Cond, Then, Else), _, Params, Info0, Info) :-
- traverse_conj([Then, Cond], Params, Info0, Info1),
- traverse_goal(Else, Params, Info0, Info2),
- combine_paths(Info1, Info2, Params, Info).
+traverse_goal_2(if_then_else(_, Cond, Then, Else), _, Params, !Info) :-
+ traverse_conj([Then, Cond], Params, !.Info, CondThenInfo),
+ traverse_goal(Else, Params, !.Info, ElseInfo),
+ combine_paths(CondThenInfo, ElseInfo, Params, !:Info).
traverse_goal_2(foreign_proc(_, CallPredId, CallProcId, Args, _,_,_),
- GoalInfo, Params, Info0, Info) :-
+ GoalInfo, Params, !Info) :-
params_get_module_info(Params, Module),
module_info_pred_proc_info(Module, CallPredId, CallProcId, _,
CallProcInfo),
proc_info_argmodes(CallProcInfo, CallArgModes),
partition_call_args(Module, CallArgModes, Args, _InVars, OutVars),
goal_info_get_context(GoalInfo, Context),
- error_if_intersect(OutVars, Context, pragma_foreign_code, Info0, Info).
+ error_if_intersect(OutVars, Context, pragma_foreign_code, !Info).
-traverse_goal_2(generic_call(_, _, _, _), GoalInfo, Params, Info0, Info) :-
+traverse_goal_2(generic_call(_, _, _, _), GoalInfo, Params, !Info) :-
%
% For class method calls, we could probably analyse further
% than this, since we know that the method being called must come
@@ -219,10 +223,10 @@
% could be better.
%
goal_info_get_context(GoalInfo, Context),
- add_error(Context, horder_call, Params, Info0, Info).
+ add_error(Context, horder_call, Params, !Info).
traverse_goal_2(call(CallPredId, CallProcId, Args, _, _, _),
- GoalInfo, Params, Info0, Info) :-
+ GoalInfo, Params, !Info) :-
goal_info_get_context(GoalInfo, Context),
params_get_module_info(Params, Module),
params_get_ppid(Params, PPId),
@@ -240,11 +244,11 @@
(
CallArgSizeInfo = yes(finite(CallGamma, OutputSuppliers)),
remove_unused_args(InVars, Args, OutputSuppliers, UsedInVars),
- record_change(UsedInVars, OutVars, CallGamma, [], Info0, Info1)
+ record_change(UsedInVars, OutVars, CallGamma, [], !Info)
;
CallArgSizeInfo = yes(infinite(_)),
error_if_intersect(OutVars, Context,
- inf_termination_const(PPId, CallPPId), Info0, Info1)
+ inf_termination_const(PPId, CallPPId), !Info)
;
CallArgSizeInfo = no,
% We should get to this point only in pass 1.
@@ -253,7 +257,7 @@
params_get_output_suppliers(Params, OutputSuppliersMap),
map__lookup(OutputSuppliersMap, CallPPId, OutputSuppliers),
remove_unused_args(InVars, Args, OutputSuppliers, UsedInVars),
- record_change(UsedInVars, OutVars, 0, [CallPPId], Info0, Info1)
+ record_change(UsedInVars, OutVars, 0, [CallPPId], !Info)
),
% Did we call a non-terminating procedure?
@@ -261,22 +265,21 @@
CallTerminationInfo = yes(can_loop(_))
->
called_can_loop(Context, can_loop_proc_called(PPId, CallPPId),
- Params, Info1, Info2)
+ Params, !Info)
;
- Info2 = Info1
+ true
),
% Did we call a procedure with some procedure-valued arguments?
(
- % This is an overapproximation, since it includes
- % higher order outputs. XXX
+ % XXX This is an overapproximation, since it includes
+ % higher order outputs.
params_get_var_types(Params, VarTypes),
horder_vars(Args, VarTypes)
->
- add_error(Context, horder_args(PPId, CallPPId), Params,
- Info2, Info3)
+ add_error(Context, horder_args(PPId, CallPPId), Params, !Info)
;
- Info3 = Info2
+ true
),
% Do we start another path?
@@ -291,14 +294,14 @@
compute_rec_start_vars(Args, RecInputSuppliers, Bag),
PathStart = yes(CallPPId - Context),
NewPath = path_info(PPId, PathStart, 0, [], Bag),
- add_path(NewPath, Info3, Info)
+ add_path(NewPath, !Info)
;
- Info = Info3
+ true
).
traverse_goal_2(shorthand(_), _, _, _, _) :-
% these should have been expanded out by now
- error("traverse_goal_2traverse_goal_2: unexpected shorthand").
+ unexpected(this_file, "traverse_goal_2/5: shorthand goal.").
%-----------------------------------------------------------------------------%
@@ -308,30 +311,30 @@
:- pred traverse_conj(list(hlds_goal)::in, traversal_params::in,
traversal_info::in, traversal_info::out) is det.
-traverse_conj([], _, Info, Info).
-traverse_conj([Goal | Goals], Params, Info0, Info) :-
- traverse_goal(Goal, Params, Info0, Info1),
- traverse_conj(Goals, Params, Info1, Info).
+traverse_conj([], _, !Info).
+traverse_conj([Goal | Goals], Params, !Info) :-
+ traverse_goal(Goal, Params, !Info),
+ traverse_conj(Goals, Params, !Info).
:- pred traverse_disj(list(hlds_goal)::in, traversal_params::in,
traversal_info::in, traversal_info::out) is det.
traverse_disj([], _, _, ok(Empty, [])) :-
set__init(Empty).
-traverse_disj([Goal | Goals], Params, Info0, Info) :-
- traverse_goal(Goal, Params, Info0, Info1),
- traverse_disj(Goals, Params, Info0, Info2),
- combine_paths(Info1, Info2, Params, Info).
+traverse_disj([Goal | Goals], Params, !Info) :-
+ traverse_goal(Goal, Params, !.Info, GoalInfo),
+ traverse_disj(Goals, Params, !.Info, GoalsInfo),
+ combine_paths(GoalInfo, GoalsInfo, Params, !:Info).
:- pred traverse_switch(list(case)::in, traversal_params::in,
traversal_info::in, traversal_info::out) is det.
traverse_switch([], _, _, ok(Empty, [])) :-
set__init(Empty).
-traverse_switch([case(_, Goal) | Cases], Params, Info0, Info) :-
- traverse_goal(Goal, Params, Info0, Info1),
- traverse_switch(Cases, Params, Info0, Info2),
- combine_paths(Info1, Info2, Params, Info).
+traverse_switch([case(_, Goal) | Cases], Params, !Info) :-
+ traverse_goal(Goal, Params, !.Info, GoalInfo),
+ traverse_switch(Cases, Params, !.Info, CasesInfo),
+ combine_paths(GoalInfo, CasesInfo, Params, !:Info).
%-----------------------------------------------------------------------------%
@@ -419,9 +422,11 @@
compute_rec_start_vars([], [], Out) :-
bag__init(Out).
compute_rec_start_vars([_|_], [], _Out) :-
- error("Unmatched vars in compute_rec_start_vars\n").
+ unexpected(this_file,
+ "compute_rec_start_vars/3: unmatched variables.").
compute_rec_start_vars([], [_|_], _Out) :-
- error("Unmatched vars in compute_rec_start_vars\n").
+ unexpected(this_file,
+ "compute_rec_start_vars/3: unmatched variables.").
compute_rec_start_vars([Var | Vars], [RecInputSupplier | RecInputSuppliers],
Out) :-
compute_rec_start_vars(Vars, RecInputSuppliers, Out1),
@@ -458,7 +463,7 @@
Gamma, Args1, Args, Modes1, Modes),
split_unification_vars(Args, Modes, Module, InVars, OutVars)
;
- error("variable type in traverse_goal_2")
+ unexpected(this_file, "unify_change/8: variable type.")
).
:- pred filter_args_and_modes(map(prog_var, (type))::in, list(prog_var)::in,
@@ -487,12 +492,12 @@
NewPaths0, NewPaths).
:- pred record_change_2(list(path_info)::in, bag(prog_var)::in,
- bag(prog_var)::in, int::in, list(pred_proc_id)::in,
+ bag(prog_var)::in, int::in, list(pred_proc_id)::in,
set(path_info)::in, set(path_info)::out) is det.
-record_change_2([], _, _, _, _, PathSet, PathSet).
+record_change_2([], _, _, _, _, !PathSet).
record_change_2([Path0 | Paths0], InVars, OutVars, CallGamma, CallPPIds,
- PathSet0, PathSet) :-
+ !PathSet) :-
Path0 = path_info(ProcData, Start, Gamma0, PPIds0, Vars0),
( bag__intersect(OutVars, Vars0) ->
% The change produces some active variables.
@@ -505,9 +510,9 @@
% The change produces no active variables.
Path = Path0
),
- set__insert(PathSet0, Path, PathSet1),
+ set__insert(!.PathSet, Path, !:PathSet),
record_change_2(Paths0, InVars, OutVars, CallGamma, CallPPIds,
- PathSet1, PathSet).
+ !PathSet).
%-----------------------------------------------------------------------------%
@@ -526,7 +531,7 @@
).
:- pred some_active_vars_in_bag(list(path_info)::in,
- bag(prog_var)::in) is semidet.
+ bag(prog_var)::in) is semidet.
some_active_vars_in_bag([Path | Paths], OutVars) :-
(
@@ -615,4 +620,12 @@
params_get_max_paths(Params, I) :-
Params = traversal_params(_, _, _, _, _, _, _, _, I).
+%-----------------------------------------------------------------------------%
+
+:- func this_file = string.
+
+this_file = "term_traversal.m".
+
+%-----------------------------------------------------------------------------%
+:- end_module term_traversal.
%-----------------------------------------------------------------------------%
Index: compiler/term_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/term_util.m,v
retrieving revision 1.32
diff -u -r1.32 term_util.m
--- compiler/term_util.m 31 Oct 2003 03:27:30 -0000 1.32
+++ compiler/term_util.m 30 Jan 2004 03:51:12 -0000
@@ -113,9 +113,8 @@
% that has a `no' in the corresponding place in the BoolList is removed
% from InVarBag.
-:- pred remove_unused_args(bag(prog_var), list(prog_var), list(bool),
- bag(prog_var)).
-:- mode remove_unused_args(in, in, in, out) is det.
+:- pred remove_unused_args(bag(prog_var)::in, list(prog_var)::in,
+ list(bool)::in, bag(prog_var)::out) is det.
% This predicate sets the argument size info of a given a list of procedures.
@@ -135,8 +134,7 @@
% Succeeds if one or more variables in the list are higher order.
-:- pred horder_vars(list(prog_var), map(prog_var, type)).
-:- mode horder_vars(in, in) is semidet.
+:- pred horder_vars(list(prog_var)::in , map(prog_var, type)::in) is semidet.
:- pred get_context_from_scc(list(pred_proc_id)::in, module_info::in,
prog_context::out) is det.
@@ -146,16 +144,14 @@
% Convert a prog_data__pragma_termination_info into a
% term_util__termination_info, by adding the appropriate context.
-:- pred add_context_to_termination_info(maybe(pragma_termination_info),
- prog_context, maybe(termination_info)).
-:- mode add_context_to_termination_info(in, in, out) is det.
+:- pred add_context_to_termination_info(maybe(pragma_termination_info)::in,
+ prog_context::in, maybe(termination_info)::out) is det.
% Convert a prog_data__pragma_arg_size_info into a
% term_util__arg_size_info, by adding the appropriate context.
-:- pred add_context_to_arg_size_info(maybe(pragma_arg_size_info),
- prog_context, maybe(arg_size_info)).
-:- mode add_context_to_arg_size_info(in, in, out) is det.
+:- pred add_context_to_arg_size_info(maybe(pragma_arg_size_info)::in,
+ prog_context::in, maybe(arg_size_info)::out) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -165,11 +161,12 @@
:- import_module check_hlds__inst_match.
:- import_module check_hlds__mode_util.
:- import_module check_hlds__type_util.
+:- import_module hlds__error_util.
:- import_module libs__globals.
:- import_module libs__options.
:- import_module parse_tree__prog_out.
-:- import_module assoc_list, require.
+:- import_module assoc_list, require, string.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -184,9 +181,9 @@
partition_call_args_2(_, [], [], [], []).
partition_call_args_2(_, [], [_ | _], _, _) :-
- error("Unmatched variables in term_util:partition_call_args").
+ unexpected(this_file, "partition_call_args_2/5: unmatched variables.").
partition_call_args_2(_, [_ | _], [], _, _) :-
- error("Unmatched variables in term_util__partition_call_args").
+ unexpected(this_file, "partition_call_args_2/5: unmatched variables.").
partition_call_args_2(ModuleInfo, [ArgMode | ArgModes], [Arg | Args],
InputArgs, OutputArgs) :-
partition_call_args_2(ModuleInfo, ArgModes, Args,
@@ -221,7 +218,8 @@
( Modes = [] ->
true
;
- error("term_util:split_unification_vars: Unmatched Variables")
+ unexpected(this_file,
+ "split_unification_vars/5: unmatched variables.")
).
split_unification_vars([Arg | Args], Modes, ModuleInfo,
InVars, OutVars):-
@@ -229,50 +227,50 @@
split_unification_vars(Args, UniModes, ModuleInfo,
InVars0, OutVars0),
UniMode = ((_VarInit - ArgInit) -> (_VarFinal - ArgFinal)),
- ( % if
+ (
inst_is_bound(ModuleInfo, ArgInit)
->
% Variable is an input variable
bag__insert(InVars0, Arg, InVars),
OutVars = OutVars0
- ; % else if
+ ;
inst_is_free(ModuleInfo, ArgInit),
inst_is_bound(ModuleInfo, ArgFinal)
->
% Variable is an output variable
InVars = InVars0,
bag__insert(OutVars0, Arg, OutVars)
- ; % else
+ ;
InVars = InVars0,
OutVars = OutVars0
)
;
- error("term_util__split_unification_vars: Unmatched Variables")
+ unexpected(this_file,
+ "split_unification_vars/5: unmatched variables.")
).
%-----------------------------------------------------------------------------%
-term_util__make_bool_list(HeadVars0, Bools, Out) :-
+make_bool_list(HeadVars0, Bools, Out) :-
list__length(Bools, Arity),
( list__drop(Arity, HeadVars0, HeadVars1) ->
HeadVars = HeadVars1
;
- error("Unmatched variables in term_util:make_bool_list")
+ unexpected(this_file, "make_bool_list/3: unmatched variables.")
),
- term_util__make_bool_list_2(HeadVars, Bools, Out).
+ make_bool_list_2(HeadVars, Bools, Out).
-:- pred term_util__make_bool_list_2(list(_T), list(bool), list(bool)).
-:- mode term_util__make_bool_list_2(in, in, out) is det.
+:- pred make_bool_list_2(list(_T)::in, list(bool)::in, list(bool)::out) is det.
-term_util__make_bool_list_2([], Bools, Bools).
-term_util__make_bool_list_2([ _ | Vars ], Bools, [no | Out]) :-
- term_util__make_bool_list_2(Vars, Bools, Out).
+make_bool_list_2([], Bools, Bools).
+make_bool_list_2([ _ | Vars ], Bools, [no | Out]) :-
+ make_bool_list_2(Vars, Bools, Out).
remove_unused_args(Vars, [], [], Vars).
remove_unused_args(Vars, [], [_X | _Xs], Vars) :-
- error("Unmatched variables in term_util:remove_unused_args").
+ unexpected(this_file, "remove_unused_args/4: unmatched variables.").
remove_unused_args(Vars, [_X | _Xs], [], Vars) :-
- error("Unmatched variables in term_util__remove_unused_args").
+ unexpected(this_file, "remove_unused_args/4: unmatched variables.").
remove_unused_args(Vars0, [ Arg | Args ], [ UsedVar | UsedVars ], Vars) :-
( UsedVar = yes ->
% The variable is used, so leave it
@@ -319,14 +317,12 @@
module_info_set_preds(PredTable, !Module),
set_pred_proc_ids_termination_info(PPIds, Termination, !Module).
-lookup_proc_termination_info(Module, PredProcId, MaybeTermination) :-
- PredProcId = proc(PredId, ProcId),
- module_info_pred_proc_info(Module, PredId, ProcId, _, ProcInfo),
+lookup_proc_termination_info(Module, PPId, MaybeTermination) :-
+ module_info_pred_proc_info(Module, PPId, _, ProcInfo),
proc_info_get_maybe_termination_info(ProcInfo, MaybeTermination).
-lookup_proc_arg_size_info(Module, PredProcId, MaybeArgSize) :-
- PredProcId = proc(PredId, ProcId),
- module_info_pred_proc_info(Module, PredId, ProcId, _, ProcInfo),
+lookup_proc_arg_size_info(Module, PPId, MaybeArgSize) :-
+ module_info_pred_proc_info(Module, PPId, _, ProcInfo),
proc_info_get_maybe_arg_size_info(ProcInfo, MaybeArgSize).
horder_vars([Arg | Args], VarType) :-
@@ -344,7 +340,7 @@
module_info_pred_info(Module, PredId, PredInfo),
pred_info_context(PredInfo, Context)
;
- error("Empty SCC in pass 2 of termination analysis")
+ unexpected(this_file, "get_context_from_scc/3: empty SCC.")
).
%-----------------------------------------------------------------------------%
@@ -357,6 +353,14 @@
add_context_to_arg_size_info(no, _, no).
add_context_to_arg_size_info(yes(finite(A, B)), _, yes(finite(A, B))).
add_context_to_arg_size_info(yes(infinite), Context,
- yes(infinite([Context - imported_pred]))).
+ yes(infinite([Context - imported_pred]))).
+%-----------------------------------------------------------------------------%
+
+:- func this_file = string.
+
+this_file = "term_util.m".
+
+%-----------------------------------------------------------------------------%
+:- end_module term_util.
%-----------------------------------------------------------------------------%
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list