[m-rev.] for review: move code for computing functor norms to new file

Julien Fischer juliensf at students.cs.mu.OZ.AU
Tue Oct 21 17:48:41 AEST 2003


Estimated hours taken: 0.5
Branches: main

Factor out the code used for computing term sizes and put it in a separate
module.  The rationale for this change is that this code will be used by
the new termination analysis (some of it is now also used by term
size profiling) and it is preferable not to have the new termination analyser
importing bits of the old one.

Delete the unify_info type since it is not actually used anywhere.

compiler/term_util.m
	Move code for computing term sizes to new file term_norm.m.
	Delete unify_info type since it is unused.

compiler/term_norm.m
	New file containing code for computing term sizes.

compiler/termination.m:
compiler/term_traversal.m:
compiler/transform_hlds.m:
compiler/size_prof.m:
	Minor changes to conform to the above.



Index: compiler/size_prof.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/size_prof.m,v
retrieving revision 1.1
diff -u -r1.1 size_prof.m
--- compiler/size_prof.m	20 Oct 2003 07:29:11 -0000	1.1
+++ compiler/size_prof.m	21 Oct 2003 03:50:55 -0000
@@ -65,7 +65,7 @@
 % need for their sizes, and (2) this allows us to create e.g. static type_info
 % structures without worrying about term size slots. The set of type categories
 % whose values are always considered zero sized is defined by the predicate
-% zero_size_type in term_util.m.
+% zero_size_type in term_norm.m.
 %
 % We currently do not associate sizes with data types which are handled mostly
 % by hand-written C code in the runtime system or in the standard library:
@@ -119,7 +119,7 @@
 :- import_module parse_tree__inst.
 :- import_module parse_tree__prog_data.
 :- import_module parse_tree__prog_util.
-:- import_module transform_hlds__term_util.
+:- import_module transform_hlds__term_norm.

 :- import_module bool, int, string, list, assoc_list, map, set, std_util.
 :- import_module varset, term, require.
Index: compiler/term_norm.m
===================================================================
RCS file: compiler/term_norm.m
diff -N compiler/term_norm.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ compiler/term_norm.m	21 Oct 2003 07:05:56 -0000
@@ -0,0 +1,319 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 1997-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.
+%-----------------------------------------------------------------------------%
+%
+% File: term_norm.m
+% Main author: crs.
+%
+% This modules defines predicates for computing functor norms.
+%
+%-----------------------------------------------------------------------------%
+
+:- module transform_hlds__term_norm.
+
+:- interface.
+
+:- import_module hlds__hlds_data.
+:- import_module hlds__hlds_goal.
+:- import_module hlds__hlds_module.
+:- import_module parse_tree__prog_data.
+
+:- import_module std_util, bool, int, list, map.
+
+%-----------------------------------------------------------------------------%
+
+% 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}.
+
+	;	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 weight_info	--->	weight(int, list(bool)).
+:- type weight_table	==	map(pair(type_ctor, cons_id), weight_info).
+
+:- pred find_weights(module_info::in, weight_table::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
+% term.
+
+:- pred functor_norm(functor_info::in, type_ctor::in, cons_id::in,
+	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.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- 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.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+% Calculate the weight to be assigned to each function symbol for the
+% use_map and use_map_and_args semilinear norms.
+%
+% Given a type definition such as
+%
+% :- type t(Tk)	--->	f1(a11, ... a1n1)	where n1 is the arity of f1
+%		;	...
+%		;	fm(am1, ... amnm)	where nm is the arity of fm
+%
+% we check, for each aij, whether its type is recursive (i.e. it is t with
+% type variable arguments that are a permutation of Tk). The weight info
+% we compute for each functor will have a boolean list that has a `yes'
+% for each recursive argument and a `no' for each nonrecursive argument.
+% The weight to be assigned to the functor is the number of nonrecursive
+% arguments, except that we assign a weight of at least 1 to all functors
+% which are not constants.
+
+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).
+
+:- pred find_weights_for_type_list(assoc_list(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) :-
+	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)
+	;
+		% This type does not introduce any functors
+		TypeBody = eqv_type(_),
+		Weights = Weights0
+	;
+		% This type may introduce some functors,
+		% but we will never see them in this analysis
+		TypeBody = abstract_type(_),
+		Weights = Weights0
+	;
+		% This type does not introduce any functors
+		TypeBody = foreign_type(_, _),
+		Weights = Weights0
+	).
+
+:- 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.
+
+% 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) :-
+	Ctor = ctor(ExistQVars, _Constraints, SymName, Args),
+	list__length(ExistQVars, NumExistQVars),
+	list__length(Args, Arity),
+	( Arity > 0 ->
+		find_and_count_nonrec_args(Args, TypeCtor, Params,
+			NumNonRec, ArgInfos0),
+		( NumNonRec = 0 ->
+			Weight = 1,
+			list__duplicate(Arity, yes, ArgInfos1)
+		;
+			Weight = NumNonRec,
+			ArgInfos1 = ArgInfos0
+		),
+		ArgInfos = list__duplicate(NumExistQVars, no) ++ ArgInfos1,
+		WeightInfo = weight(Weight, ArgInfos)
+	;
+		WeightInfo = weight(0, [])
+	),
+	ConsId = cons(SymName, Arity),
+	map__det_insert(Weights0, TypeCtor - ConsId, WeightInfo, Weights).
+
+:- pred find_weights_for_tuple(arity::in, weight_info::out) is det.
+
+find_weights_for_tuple(Arity, weight(Weight, ArgInfos)) :-
+	% None of the tuple arguments are recursive.
+	Weight = Arity,
+	list__duplicate(Arity, yes, ArgInfos).
+
+:- pred find_and_count_nonrec_args(list(constructor_arg)::in,
+	type_ctor::in, list(type_param)::in,
+	int::out, list(bool)::out) is det.
+
+find_and_count_nonrec_args([], _, _, 0, []).
+find_and_count_nonrec_args([Arg | Args], Id, Params, NonRecArgs, ArgInfo) :-
+	find_and_count_nonrec_args(Args, Id, Params, NonRecArgs0, ArgInfo0),
+	( is_arg_recursive(Arg, Id, Params) ->
+		NonRecArgs = NonRecArgs0,
+		ArgInfo = [yes | ArgInfo0]
+	;
+		NonRecArgs = NonRecArgs0 + 1,
+		ArgInfo = [no | ArgInfo0]
+	).
+
+:- 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,
+	type_to_ctor_and_args(ArgType, ArgTypeCtor, ArgTypeParams),
+	TypeCtor = ArgTypeCtor,
+	list__perm(Params, ArgTypeParams).
+
+:- pred search_weight_table(weight_table::in, type_ctor::in, cons_id::in,
+		weight_info::out) is semidet.
+
+search_weight_table(WeightMap, TypeCtor, ConsId, WeightInfo) :-
+	( map__search(WeightMap, TypeCtor - ConsId, WeightInfo0) ->
+		WeightInfo = WeightInfo0
+	; type_ctor_is_tuple(TypeCtor) ->
+		TypeCtor = _ - Arity,
+		find_weights_for_tuple(Arity, WeightInfo)
+	;
+		fail
+	).
+
+%-----------------------------------------------------------------------------%
+
+% Although the module info is not used in either 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) :-
+	(
+		ConsId = cons(_, Arity),
+		Arity \= 0
+	->
+		Int = 1
+	;
+		Int = 0
+	).
+functor_norm(total, _, ConsId, _Module, Int, Args, Args, Modes, Modes) :-
+	( ConsId = cons(_, Arity) ->
+		Int = Arity
+	;
+		Int = 0
+	).
+functor_norm(use_map(WeightMap), TypeCtor, ConsId, _Module, Int,
+		Args, Args, Modes, 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) :-
+	( search_weight_table(WeightMap, TypeCtor, ConsId, WeightInfo) ->
+		WeightInfo = weight(Int, UseArgList),
+		(
+			functor_norm_filter_args(UseArgList, Args0, Args1,
+				Modes0, Modes1)
+		->
+			Modes = Modes1,
+			Args = Args1
+		;
+			error("Unmatched lists in functor_norm_filter_args.")
+		)
+	;
+		Int = 0,
+		Modes = Modes0,
+		Args = Args0
+	).
+
+% 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.
+
+functor_norm_filter_args([], [], [], [], []).
+functor_norm_filter_args([yes | Bools], [Arg0 | Args0], [Arg0 | Args],
+		[Mode0 | Modes0], [Mode0 | Modes]) :-
+	functor_norm_filter_args(Bools, Args0, Args, Modes0, Modes).
+functor_norm_filter_args([no | Bools], [_Arg0 | Args0], Args,
+		[_Mode0 | Modes0], Modes) :-
+	functor_norm_filter_args(Bools, Args0, Args, Modes0, Modes).
+
+%-----------------------------------------------------------------------------%
+
+zero_size_type(Type, Module) :-
+	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.
+
+zero_size_type_category(int_type, yes).
+zero_size_type_category(char_type, yes).
+zero_size_type_category(str_type, yes).
+zero_size_type_category(float_type, yes).
+zero_size_type_category(void_type, yes).
+zero_size_type_category(type_info_type, yes).
+zero_size_type_category(type_ctor_info_type, yes).
+zero_size_type_category(typeclass_info_type, yes).
+zero_size_type_category(base_typeclass_info_type, yes).
+zero_size_type_category(higher_order_type, no).
+zero_size_type_category(tuple_type, no).
+zero_size_type_category(enum_type, yes).
+zero_size_type_category(variable_type, no).
+zero_size_type_category(user_ctor_type, no).
+
+%-----------------------------------------------------------------------------%
+:- end_module transform_hlds__term_norm.
+%-----------------------------------------------------------------------------%
Index: compiler/term_traversal.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/term_traversal.m,v
retrieving revision 1.23
diff -u -r1.23 term_traversal.m
--- compiler/term_traversal.m	26 May 2003 09:00:10 -0000	1.23
+++ compiler/term_traversal.m	21 Oct 2003 04:43:45 -0000
@@ -25,6 +25,7 @@
 :- import_module hlds__hlds_pred.
 :- import_module parse_tree__prog_data.
 :- import_module transform_hlds__term_errors.
+:- import_module transform_hlds__term_norm.
 :- import_module transform_hlds__term_util.

 :- import_module list, bag, map, std_util, set.
Index: compiler/term_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/term_util.m,v
retrieving revision 1.29
diff -u -r1.29 term_util.m
--- compiler/term_util.m	20 Oct 2003 07:29:11 -0000	1.29
+++ compiler/term_util.m	21 Oct 2003 06:24:54 -0000
@@ -10,7 +10,6 @@
 % This module:
 %
 % -	defines the types used by termination analysis
-% -	defines predicates for computing functor norms
 % -	defines some utility predicates
 %
 %-----------------------------------------------------------------------------%
@@ -19,12 +18,12 @@

 :- interface.

-:- import_module hlds__hlds_data.
 :- import_module hlds__hlds_goal.
 :- import_module hlds__hlds_module.
 :- import_module hlds__hlds_pred.
 :- import_module parse_tree__prog_data.
 :- import_module transform_hlds__term_errors.
+:- import_module transform_hlds__term_norm.

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

@@ -75,49 +74,6 @@

 :- type used_args	==	map(pred_proc_id, list(bool)).

-%-----------------------------------------------------------------------------%
-
-% 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}.
-
-	;	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 unify_info	==	pair(map(prog_var, type), functor_info).
-
-:- type weight_info	--->	weight(int, list(bool)).
-:- type weight_table	==	map(pair(type_ctor, cons_id), weight_info).
-
-:- pred find_weights(module_info::in, weight_table::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
-% term.
-
-:- pred functor_norm(functor_info::in, type_ctor::in, cons_id::in,
-	module_info::in, int::out, list(prog_var)::in, list(prog_var)::out,
-	list(uni_mode)::in, list(uni_mode)::out) is det.
-
 :- type pass_info
 	--->	pass_info(
 			functor_info,
@@ -182,11 +138,6 @@
 :- pred horder_vars(list(prog_var), map(prog_var, type)).
 :- mode horder_vars(in, in) is semidet.

-% 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 get_context_from_scc(list(pred_proc_id)::in, module_info::in,
 	prog_context::out) is det.

@@ -223,212 +174,6 @@
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%

-% Calculate the weight to be assigned to each function symbol for the
-% use_map and use_map_and_args semilinear norms.
-%
-% Given a type definition such as
-%
-% :- type t(Tk)	--->	f1(a11, ... a1n1)	where n1 is the arity of f1
-%		;	...
-%		;	fm(am1, ... amnm)	where nm is the arity of fm
-%
-% we check, for each aij, whether its type is recursive (i.e. it is t with
-% type variable arguments that are a permutation of Tk). The weight info
-% we compute for each functor will have a boolean list that has a `yes'
-% for each recursive argument and a `no' for each nonrecursive argument.
-% The weight to be assigned to the functor is the number of nonrecursive
-% arguments, except that we assign a weight of at least 1 to all functors
-% which are not constants.
-
-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).
-
-:- pred find_weights_for_type_list(assoc_list(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) :-
-	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)
-	;
-		% This type does not introduce any functors
-		TypeBody = eqv_type(_),
-		Weights = Weights0
-	;
-		% This type may introduce some functors,
-		% but we will never see them in this analysis
-		TypeBody = abstract_type(_),
-		Weights = Weights0
-	;
-		% This type does not introduce any functors
-		TypeBody = foreign_type(_, _),
-		Weights = Weights0
-	).
-
-:- 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.
-
-% 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) :-
-	Ctor = ctor(ExistQVars, _Constraints, SymName, Args),
-	list__length(ExistQVars, NumExistQVars),
-	list__length(Args, Arity),
-	( Arity > 0 ->
-		find_and_count_nonrec_args(Args, TypeCtor, Params,
-			NumNonRec, ArgInfos0),
-		( NumNonRec = 0 ->
-			Weight = 1,
-			list__duplicate(Arity, yes, ArgInfos1)
-		;
-			Weight = NumNonRec,
-			ArgInfos1 = ArgInfos0
-		),
-		ArgInfos = list__duplicate(NumExistQVars, no) ++ ArgInfos1,
-		WeightInfo = weight(Weight, ArgInfos)
-	;
-		WeightInfo = weight(0, [])
-	),
-	ConsId = cons(SymName, Arity),
-	map__det_insert(Weights0, TypeCtor - ConsId, WeightInfo, Weights).
-
-:- pred find_weights_for_tuple(arity::in, weight_info::out) is det.
-
-find_weights_for_tuple(Arity, weight(Weight, ArgInfos)) :-
-	% None of the tuple arguments are recursive.
-	Weight = Arity,
-	list__duplicate(Arity, yes, ArgInfos).
-
-:- pred find_and_count_nonrec_args(list(constructor_arg)::in,
-	type_ctor::in, list(type_param)::in,
-	int::out, list(bool)::out) is det.
-
-find_and_count_nonrec_args([], _, _, 0, []).
-find_and_count_nonrec_args([Arg | Args], Id, Params, NonRecArgs, ArgInfo) :-
-	find_and_count_nonrec_args(Args, Id, Params, NonRecArgs0, ArgInfo0),
-	( is_arg_recursive(Arg, Id, Params) ->
-		NonRecArgs = NonRecArgs0,
-		ArgInfo = [yes | ArgInfo0]
-	;
-		NonRecArgs = NonRecArgs0 + 1,
-		ArgInfo = [no | ArgInfo0]
-	).
-
-:- 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,
-	type_to_ctor_and_args(ArgType, ArgTypeCtor, ArgTypeParams),
-	TypeCtor = ArgTypeCtor,
-	list__perm(Params, ArgTypeParams).
-
-:- pred search_weight_table(weight_table::in, type_ctor::in, cons_id::in,
-		weight_info::out) is semidet.
-
-search_weight_table(WeightMap, TypeCtor, ConsId, WeightInfo) :-
-	( map__search(WeightMap, TypeCtor - ConsId, WeightInfo0) ->
-		WeightInfo = WeightInfo0
-	; type_ctor_is_tuple(TypeCtor) ->
-		TypeCtor = _ - Arity,
-		find_weights_for_tuple(Arity, WeightInfo)
-	;
-		fail
-	).
-
-%-----------------------------------------------------------------------------%
-
-% Although the module info is not used in either 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) :-
-	(
-		ConsId = cons(_, Arity),
-		Arity \= 0
-	->
-		Int = 1
-	;
-		Int = 0
-	).
-functor_norm(total, _, ConsId, _Module, Int, Args, Args, Modes, Modes) :-
-	( ConsId = cons(_, Arity) ->
-		Int = Arity
-	;
-		Int = 0
-	).
-functor_norm(use_map(WeightMap), TypeCtor, ConsId, _Module, Int,
-		Args, Args, Modes, 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) :-
-	( search_weight_table(WeightMap, TypeCtor, ConsId, WeightInfo) ->
-		WeightInfo = weight(Int, UseArgList),
-		(
-			functor_norm_filter_args(UseArgList, Args0, Args1,
-				Modes0, Modes1)
-		->
-			Modes = Modes1,
-			Args = Args1
-		;
-			error("Unmatched lists in functor_norm_filter_args.")
-		)
-	;
-		Int = 0,
-		Modes = Modes0,
-		Args = Args0
-	).
-
-% 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.
-
-functor_norm_filter_args([], [], [], [], []).
-functor_norm_filter_args([yes | Bools], [Arg0 | Args0], [Arg0 | Args],
-		[Mode0 | Modes0], [Mode0 | Modes]) :-
-	functor_norm_filter_args(Bools, Args0, Args, Modes0, Modes).
-functor_norm_filter_args([no | Bools], [_Arg0 | Args0], Args,
-		[_Mode0 | Modes0], Modes) :-
-	functor_norm_filter_args(Bools, Args0, Args, Modes0, Modes).
-
-%-----------------------------------------------------------------------------%
-
 partition_call_args(Module, ArgModes, Args, InVarsBag, OutVarsBag) :-
 	partition_call_args_2(Module, ArgModes, Args, InVars, OutVars),
 	bag__from_list(InVars, InVarsBag),
@@ -593,28 +338,6 @@
 	;
 		horder_vars(Args, VarType)
 	).
-
-zero_size_type(Type, Module) :-
-	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.
-
-zero_size_type_category(int_type, yes).
-zero_size_type_category(char_type, yes).
-zero_size_type_category(str_type, yes).
-zero_size_type_category(float_type, yes).
-zero_size_type_category(void_type, yes).
-zero_size_type_category(type_info_type, yes).
-zero_size_type_category(type_ctor_info_type, yes).
-zero_size_type_category(typeclass_info_type, yes).
-zero_size_type_category(base_typeclass_info_type, yes).
-zero_size_type_category(higher_order_type, no).
-zero_size_type_category(tuple_type, no).
-zero_size_type_category(enum_type, yes).
-zero_size_type_category(variable_type, no).
-zero_size_type_category(user_ctor_type, no).

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

Index: compiler/termination.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/termination.m,v
retrieving revision 1.30
diff -u -r1.30 termination.m
--- compiler/termination.m	26 Sep 2003 05:14:22 -0000	1.30
+++ compiler/termination.m	21 Oct 2003 06:44:00 -0000
@@ -105,6 +105,7 @@
 :- import_module parse_tree__prog_util.
 :- import_module transform_hlds__dependency_graph.
 :- import_module transform_hlds__term_errors.
+:- import_module transform_hlds__term_norm.
 :- import_module transform_hlds__term_pass1.
 :- import_module transform_hlds__term_pass2.

Index: compiler/transform_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/transform_hlds.m,v
retrieving revision 1.6
diff -u -r1.6 transform_hlds.m
--- compiler/transform_hlds.m	20 Oct 2003 07:29:12 -0000	1.6
+++ compiler/transform_hlds.m	21 Oct 2003 03:46:05 -0000
@@ -29,6 +29,7 @@
    :- include_module term_pass2.
    :- include_module term_traversal.
    :- include_module term_errors.
+   :- include_module term_norm.
    :- include_module term_util.
    :- include_module lp. % this could alternatively go in the `libs' module
--------------------------------------------------------------------------
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