[m-rev.] for review: clean up code for computing norms

[Julien Fischer]

Estimated hours taken: 1
Branches: main

Shift some code related to setting up functor norms from termination.m
to term_norm.m.  This avoids having to duplicate the same code in the
new termination analyser.

Clean up the code in term_norm.m.

compiler/termination.m:
	Move predicate set_functor_info/3 from here to term_norm.m as this
	removes the need to duplicate this predicate in the new termination
	analyser.
compiler/term_norm.m:
	Make the functor_info type abstract since the rest of the compiler
	shouldn't need to modify it.

	Do not export the types weight_info and weight_table.

	Use ho list preds from the library where appropriate.

	Use predmode declarations and state variables where appropriate.

	Add an XXX comment about which norms the compiler currently supports.

	Fix a comment relating to the norms and the module_info.


Index: compiler/term_norm.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/term_norm.m,v
retrieving revision 1.1
diff -u -r1.1 term_norm.m
--- compiler/term_norm.m	22 Oct 2003 07:05:17 -0000	1.1
+++ compiler/term_norm.m	29 Oct 2003 05:41:23 -0000
@@ -18,42 +18,23 @@
 :- import_module hlds__hlds_data.
 :- import_module hlds__hlds_goal.
 :- import_module hlds__hlds_module.
+:- import_module libs__globals.
 :- import_module parse_tree__prog_data.

-:- import_module std_util, bool, int, list, map.
+:- import_module int, list.

 %-----------------------------------------------------------------------------%

-% We use semilinear norms (denoted by ||) to compute the sizes of terms.
-% These have the form
-%
-% | f(t1, ... tn) | = weight(f) + sum of | ti |
-% where i is an element of a set I, and I is a subset of {1, ... n}
-%
-% We currently support four kinds of semilinear norms.
-
-:- type functor_info
-	--->	simple	% All non-constant functors have weight 1,
-			% while constants have weight 0.
-			% Use the size of all subterms (I = {1, ..., n}.
-
-	;	total	% All functors have weight = arity of the functor.
-			% Use the size of all subterms (I = {1, ..., n}.
-
-	;	use_map(weight_table)
-			% The weight of each functor is given by the table.
-			% Use the size of all subterms (I = {1, ..., n}.
+% The functor_info type contains information about how the weight of a term
+% is calculated.

-	;	use_map_and_args(weight_table).
-			% The weight of each functor is given by the table,
-			% and so is the set of arguments of the functor whose
-			% size should be counted (I is given by the table
-			% entry of the functor).
+:- type functor_info.

-:- type weight_info	--->	weight(int, list(bool)).
-:- type weight_table	==	map(pair(type_ctor, cons_id), weight_info).
+% This predicate sets the functor_info depending on the value of the
+% termination_norm option.

-:- pred find_weights(module_info::in, weight_table::out) is det.
+:- pred set_functor_info(globals__termination_norm::in, module_info::in,
+	functor_info::out) is det.

 % This predicate computes the weight of a functor and the set of arguments
 % of that functor whose sizes should be counted towards the size of the whole
@@ -63,11 +44,9 @@
 	module_info::in, int::out, list(prog_var)::in, list(prog_var)::out,
 	list(uni_mode)::in, list(uni_mode)::out) is det.

-
 % Succeeds if all values of the given type are zero size (for all norms).

-:- pred zero_size_type(type, module_info).
-:- mode zero_size_type(in, in) is semidet.
+:- pred zero_size_type((type)::in, module_info::in) is semidet.

 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
@@ -77,13 +56,40 @@
 :- import_module check_hlds__inst_match.
 :- import_module check_hlds__mode_util.
 :- import_module check_hlds__type_util.
-:- import_module libs__globals.
 :- import_module libs__options.
 :- import_module parse_tree__prog_out.

-:- import_module assoc_list, require.
+:- import_module assoc_list, bool, map, require, std_util.

 %-----------------------------------------------------------------------------%
+
+% We use semilinear norms (denoted by ||) to compute the sizes of terms.
+% These have the form
+%
+% | f(t1, ... tn) | = weight(f) + sum of | ti |
+% where i is an element of a set I, and I is a subset of {1, ... n}
+%
+% We currently support four kinds of semilinear norms.
+% XXX Actually we currently only use three of them.  `use_map/1' is unused.
+
+:- type functor_info
+	--->	simple	% All non-constant functors have weight 1,
+			% while constants have weight 0.
+			% Use the size of all subterms (I = {1, ..., n}.
+
+	;	total	% All functors have weight = arity of the functor.
+			% Use the size of all subterms (I = {1, ..., n}.
+
+	;	use_map(weight_table)
+			% The weight of each functor is given by the table.
+			% Use the size of all subterms (I = {1, ..., n}.
+
+	;	use_map_and_args(weight_table).
+			% The weight of each functor is given by the table,
+			% and so is the set of arguments of the functor whose
+			% size should be counted (I is given by the table
+			% entry of the functor).
+
 %-----------------------------------------------------------------------------%

 % Calculate the weight to be assigned to each function symbol for the
@@ -103,68 +109,49 @@
 % arguments, except that we assign a weight of at least 1 to all functors
 % which are not constants.

+:- type weight_table == map(pair(type_ctor, cons_id), weight_info).
+
+:- type weight_info ---> weight(int, list(bool)).
+
+:- pred find_weights(module_info::in, weight_table::out) is det.
+
 find_weights(ModuleInfo, Weights) :-
 	module_info_types(ModuleInfo, TypeTable),
 	map__to_assoc_list(TypeTable, TypeList),
 	map__init(Weights0),
-	find_weights_for_type_list(TypeList, Weights0, Weights).
+	list__foldl(find_weights_for_type, TypeList, Weights0, Weights).

-:- pred find_weights_for_type_list(assoc_list(type_ctor, hlds_type_defn)::in,
+:- pred find_weights_for_type(pair(type_ctor, hlds_type_defn)::in,
 	weight_table::in, weight_table::out) is det.

-find_weights_for_type_list([], Weights, Weights).
-find_weights_for_type_list([TypeCtor - TypeDefn | TypeList],
-		Weights0, Weights) :-
-	find_weights_for_type(TypeCtor, TypeDefn, Weights0, Weights1),
-	find_weights_for_type_list(TypeList, Weights1, Weights).
-
-:- pred find_weights_for_type(type_ctor::in, hlds_type_defn::in,
-	weight_table::in, weight_table::out) is det.
-
-find_weights_for_type(TypeCtor, TypeDefn, Weights0, Weights) :-
+find_weights_for_type(TypeCtor - TypeDefn, !Weights) :-
 	hlds_data__get_type_defn_body(TypeDefn, TypeBody),
 	(
 		Constructors = TypeBody ^ du_type_ctors,
 		hlds_data__get_type_defn_tparams(TypeDefn, TypeParams),
-		find_weights_for_cons_list(Constructors, TypeCtor, TypeParams,
-			Weights0, Weights)
+		list__foldl(find_weights_for_cons(TypeCtor, TypeParams),
+			Constructors, !Weights)
 	;
 		% This type does not introduce any functors
-		TypeBody = eqv_type(_),
-		Weights = Weights0
+		TypeBody = eqv_type(_)
 	;
 		% This type may introduce some functors,
 		% but we will never see them in this analysis
-		TypeBody = abstract_type(_),
-		Weights = Weights0
+		TypeBody = abstract_type(_)
 	;
 		% This type does not introduce any functors
-		TypeBody = foreign_type(_, _),
-		Weights = Weights0
+		TypeBody = foreign_type(_, _)
 	).

-:- pred find_weights_for_cons_list(list(constructor)::in,
-	type_ctor::in, list(type_param)::in,
-	weight_table::in, weight_table::out) is det.
-
-find_weights_for_cons_list([], _, _, Weights, Weights).
-find_weights_for_cons_list([Constructor | Constructors], TypeCtor, Params,
-		Weights0, Weights) :-
-	find_weights_for_cons(Constructor, TypeCtor, Params,
-		Weights0, Weights1),
-	find_weights_for_cons_list(Constructors, TypeCtor, Params,
-		Weights1, Weights).
-
-:- pred find_weights_for_cons(constructor::in,
-	type_ctor::in, list(type_param)::in,
-	weight_table::in, weight_table::out) is det.
+:- pred find_weights_for_cons(type_ctor::in, list(type_param)::in,
+	constructor::in, weight_table::in, weight_table::out) is det.

 % XXX Currently, the weight of a functor is not affected by the presence
 % of any arguments that are type_info related.  However, the set of
 % arguments whose sizes should be counted towards the total size of
 % the term will include any type-info related arguments.

-find_weights_for_cons(Ctor, TypeCtor, Params, Weights0, Weights) :-
+find_weights_for_cons(TypeCtor, Params, Ctor, !Weights) :-
 	Ctor = ctor(ExistQVars, _Constraints, SymName, Args),
 	list__length(ExistQVars, NumExistQVars),
 	list__length(Args, Arity),
@@ -184,7 +171,7 @@
 		WeightInfo = weight(0, [])
 	),
 	ConsId = cons(SymName, Arity),
-	map__det_insert(Weights0, TypeCtor - ConsId, WeightInfo, Weights).
+	map__det_insert(!.Weights, TypeCtor - ConsId, WeightInfo, !:Weights).

 :- pred find_weights_for_tuple(arity::in, weight_info::out) is det.

@@ -208,8 +195,8 @@
 		ArgInfo = [no | ArgInfo0]
 	).

-:- pred is_arg_recursive(constructor_arg::in,
-	type_ctor::in, list(type_param)::in) is semidet.
+:- pred is_arg_recursive(constructor_arg::in, type_ctor::in,
+	list(type_param)::in) is semidet.

 is_arg_recursive(Arg, TypeCtor, Params) :-
 	Arg = _Name - ArgType,
@@ -218,7 +205,7 @@
 	list__perm(Params, ArgTypeParams).

 :- pred search_weight_table(weight_table::in, type_ctor::in, cons_id::in,
-		weight_info::out) is semidet.
+	weight_info::out) is semidet.

 search_weight_table(WeightMap, TypeCtor, ConsId, WeightInfo) :-
 	( map__search(WeightMap, TypeCtor - ConsId, WeightInfo0) ->
@@ -232,10 +219,19 @@

 %-----------------------------------------------------------------------------%

-% Although the module info is not used in either of these norms, it could
+set_functor_info(total, _Module, total).
+set_functor_info(simple, _Module, simple).
+set_functor_info(num_data_elems, Module, use_map_and_args(WeightMap)) :-
+	find_weights(Module, WeightMap).
+set_functor_info(size_data_elems, Module, use_map(WeightMap)) :-
+	find_weights(Module, WeightMap).
+
+%-----------------------------------------------------------------------------%
+
+% Although the module info is not used in any of these norms, it could
 % be needed for other norms, so it should not be removed.

-functor_norm(simple, _, ConsId, _, Int, Args, Args, Modes, Modes) :-
+functor_norm(simple, _, ConsId, _, Int, !Args, !Modes) :-
 	(
 		ConsId = cons(_, Arity),
 		Arity \= 0
@@ -244,43 +240,38 @@
 	;
 		Int = 0
 	).
-functor_norm(total, _, ConsId, _Module, Int, Args, Args, Modes, Modes) :-
+functor_norm(total, _, ConsId, _, Int, !Args, !Modes) :-
 	( ConsId = cons(_, Arity) ->
 		Int = Arity
 	;
 		Int = 0
 	).
-functor_norm(use_map(WeightMap), TypeCtor, ConsId, _Module, Int,
-		Args, Args, Modes, Modes) :-
+functor_norm(use_map(WeightMap), TypeCtor, ConsId, _, Int, !Args, !Modes) :-
 	( search_weight_table(WeightMap, TypeCtor, ConsId, WeightInfo) ->
 		WeightInfo = weight(Int, _)
 	;
 		Int = 0
 	).
-functor_norm(use_map_and_args(WeightMap), TypeCtor, ConsId, _Module, Int,
-		Args0, Args, Modes0, Modes) :-
+functor_norm(use_map_and_args(WeightMap), TypeCtor, ConsId, _, Int, !Args,
+		!Modes) :-
 	( search_weight_table(WeightMap, TypeCtor, ConsId, WeightInfo) ->
 		WeightInfo = weight(Int, UseArgList),
 		(
-			functor_norm_filter_args(UseArgList, Args0, Args1,
-				Modes0, Modes1)
+			functor_norm_filter_args(UseArgList, !Args, !Modes)
 		->
-			Modes = Modes1,
-			Args = Args1
+			true
 		;
 			error("Unmatched lists in functor_norm_filter_args.")
 		)
 	;
-		Int = 0,
-		Modes = Modes0,
-		Args = Args0
+		Int = 0
 	).

 % This predicate will fail if the length of the input lists are not matched.

-:- pred functor_norm_filter_args(list(bool), list(prog_var), list(prog_var),
-	list(uni_mode), list(uni_mode)).
-:- mode functor_norm_filter_args(in, in, out, in, out) is semidet.
+:- pred functor_norm_filter_args(list(bool)::in, list(prog_var)::in,
+	list(prog_var)::out, list(uni_mode)::in, list(uni_mode)::out)
+	is semidet.

 functor_norm_filter_args([], [], [], [], []).
 functor_norm_filter_args([yes | Bools], [Arg0 | Args0], [Arg0 | Args],
@@ -296,8 +287,7 @@
 	classify_type(Module, Type) = TypeCategory,
 	zero_size_type_category(TypeCategory, yes).

-:- pred zero_size_type_category(type_category, bool).
-:- mode zero_size_type_category(in, out) is det.
+:- pred zero_size_type_category(type_category::in, bool::out) is det.

 zero_size_type_category(int_type, yes).
 zero_size_type_category(char_type, yes).
Index: compiler/termination.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/termination.m,v
retrieving revision 1.32
diff -u -r1.32 termination.m
--- compiler/termination.m	24 Oct 2003 06:17:49 -0000	1.32
+++ compiler/termination.m	24 Oct 2003 07:01:52 -0000
@@ -148,21 +148,6 @@
 		[]
 	).

-% This predicate sets the functor info depending on the value of the
-% termination_norm option. The functor info field stores the weight which
-% is associated with each functor, and may contain information about which
-% subterms contribute to the size of that functor.
-
-:- pred set_functor_info(globals__termination_norm, module_info, functor_info).
-:- mode set_functor_info(in, in, out) is det.
-
-set_functor_info(total, _Module, total).
-set_functor_info(simple, _Module, simple).
-set_functor_info(num_data_elems, Module, use_map_and_args(WeightMap)) :-
-	find_weights(Module, WeightMap).
-set_functor_info(size_data_elems, Module, use_map(WeightMap)) :-
-	find_weights(Module, WeightMap).
-
 %----------------------------------------------------------------------------%
 % Check that any user-supplied termination information (from pragma
 % terminates/does_not_terminate) is consistent for each SCC in the program.

--------------------------------------------------------------------------
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
--------------------------------------------------------------------------