[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