[m-rev.] for review: untupling transformation

[Peter Wang]

On Tuesday 01 February 2005 12:28 pm, Julien Fischer wrote:
> On Mon, 31 Jan 2005, Peter Wang wrote:
> > +%
> > +% After all the procedures have been processed in that way, a second pass is
> > +% made to update all the calls in the module which refer to the old procedures
> > +% to call the transformed procedures.  This is done by adding deconstruction
> > +% and construction unifications as needed, which can later be simplified by a
> > +% simplification pass.
> > +%
> Are the simplifications done in this module or are they done
> eleswhere?

Elsewhere (I just rely on a later simplification pass).  I don't know what
would be better.

> > +:- pred expand_args_in_pred(pred_id::in, module_info::in, module_info::out,
> > +	transform_map::in, transform_map::out) is det.
> > +
> > +expand_args_in_pred(PredId, !ModuleInfo, !TransformMap) :-
> > +	module_info_types(!.ModuleInfo, TypeTable),
> > +	module_info_pred_info(!.ModuleInfo, PredId, PredInfo),
> > +	(
> > +		% Only perform the transformation on predicates which
> > +		% satisfy the following criteria.
> Is it possible that some of the restrictions below could eventually
> be lifted?

I don't know.

> If so, you should mention this.

Ok.

> > +:- pred expandable_arg_mode((mode)::in) is semidet.
> > +
> > +expandable_arg_mode(in_mode).
> > +expandable_arg_mode(out_mode).
> > +
> 
> Does this compiler bootstrap when this transformation is turned on?

Yes, and it runs slower too :-)

A relative diff follows.  In addition to the changes relating to
your comments, I also made it:

- perform the transformation for procedures which are exported (this was not
possible in my first attempt at it, but now there is no reason not to);

- not go into an infinite loop trying to expand recursive types, such as
	:- type t ---> t(t).
or
	:- type u ---> u(v).
	:- type v ---> v(u).


Thanks, Julien.

Peter


diff -u -r ws3.old/compiler/options.m ws3/compiler/options.m
--- ws3.old/compiler/options.m	2005-02-01 14:42:45.000000000 +1100
+++ ws3/compiler/options.m	2005-02-01 14:21:22.000000000 +1100
@@ -3704,6 +3704,11 @@
 		"\tEnable exception analysis.  Identify those",
 		"\tprocedures that will not throw an exception.",
 		"\tSome optimizations can make use of this information."
+		% ,
+		% "--untuple",
+		% "\tExpand out procedure arguments when the argument type",
+		% "\tis a tuple or a type with exactly one functor.",
+		% "\tNote this is almost always a pessimization."
 	]).
 
 :- pred options_help_hlds_llds_optimization(io::di, io::uo) is det.
diff -u -r ws3.old/compiler/untupling.m ws3/compiler/untupling.m
--- ws3.old/compiler/untupling.m	2005-02-01 14:42:45.000000000 +1100
+++ ws3/compiler/untupling.m	2005-02-01 15:28:07.000000000 +1100
@@ -8,14 +8,13 @@
 %
 % Author: wangp.
 %
-% This module takes an HLDS structure as its input and transforms the
-% locally-defined procedures as follows: if the formal parameter of a
-% procedure has a type consisting of a single function symbol then that
-% parameter is expanded into multiple parameters (one for each field of the
-% functor).  Tuple types are also expanded.  The argument lists are expanded
-% as deeply (flatly) as possible.
+% This module takes the HLDS and transforms the locally-defined procedures as
+% follows: if the formal parameter of a procedure has a type consisting of a
+% single function symbol then that parameter is expanded into multiple
+% parameters (one for each field of the functor).  Tuple types are also
+% expanded.  The argument lists are expanded as deeply (flatly) as possible.
 %
-% e.g. for the following module,
+% e.g. for the following predicate,
 %
 %	:- type t ---> t(u).
 %	:- type u ---> u(v, w).
@@ -34,7 +33,51 @@
 % made to update all the calls in the module which refer to the old procedures
 % to call the transformed procedures.  This is done by adding deconstruction
 % and construction unifications as needed, which can later be simplified by a
-% simplification pass.
+% simplification pass (not called from this module).
+%
+% e.g. a call to the predicate above,
+%
+%	:- pred g(T::in) is det.
+%	g(_) :-
+%		A = 1,
+%		B = "foo",
+%		C = w(A, B),
+%		D = v1,
+%		E = u(D, C),
+%		F = t(E),
+%		f(F).
+%
+% is changed to this:
+%
+%	g(_) :-
+%		A = 1,
+%		B = "foo",
+%		C = w(A, B),
+%		D = v1,
+%		E = u(D, C),
+%		F = t(E),
+%		F = t(G),	% added deconstructions
+%		G = u(H, I),
+%		I = w(J, K),
+%		f_untupled(H, J, K).
+%
+% which, after simplication, should become:
+%
+%	g(_) :-
+%		A = 1,
+%		B = "foo",
+%		D = v1,
+%		f_untupled(D, A, B).
+%
+% Limitations:
+%
+% - When a formal parameter is expanded, both the parameter's type and mode
+% have to be expanded.  Currently only arguments with in and out modes can
+% be expanded at present, as I don't know how to do it for the general case.
+% It should be enough for the majority of code.
+%
+% - Some predicates may or may not be expandable but won't be right now,
+% because I don't understand the features they use (see expand_args_in_pred).
 %
 %-----------------------------------------------------------------------------%
 
@@ -77,11 +120,11 @@
 :- type transformed_proc
 	--->	transformed_proc(
 			pred_proc_id,
-				% The predicate and procedure that the old
-				% procedure was transformed into.
+				% A procedure that was generated by the
+				% untupling transformation.
 			hlds_goal
 				% A call goal template that is used to update
-				% calls refering to the old procedure to the
+				% calls referring to the old procedure to the
 				% new procedure.
 		).
 
@@ -90,7 +133,9 @@
 	fix_calls_to_expanded_procs(TransformMap, !ModuleInfo).
 
 %-----------------------------------------------------------------------------%
-%-----------------------------------------------------------------------------%
+%
+% Pass 1
+%
 
 	% This is the top level of the first pass.  It expands procedure
 	% arguments where possible, adding new versions of the transformed
@@ -114,8 +159,11 @@
 	(
 		% Only perform the transformation on predicates which
 		% satisfy the following criteria.
-		pred_info_import_status(PredInfo, local),
+		pred_info_import_status(PredInfo, ImportStatus),
+		status_defined_in_this_module(ImportStatus, yes),
 		pred_info_get_goal_type(PredInfo, clauses),
+		% Some of these limitations may be able to be lifted later.
+		% For now, take the safe option and don't touch them.
 		pred_info_get_exist_quant_tvars(PredInfo, []),
 		pred_info_get_head_type_params(PredInfo, []),
 		pred_info_get_class_context(PredInfo, constraints([], [])),
@@ -137,7 +185,7 @@
 	is semidet.
 
 at_least_one_expandable_type([Type | Types], TypeTable) :-
-	( expand_type(Type, TypeTable, yes(_))
+	( expand_type(Type, [], TypeTable, expansion(_, _))
 	; at_least_one_expandable_type(Types, TypeTable)
 	).
 
@@ -199,42 +247,44 @@
 expand_args_in_proc_2(HeadVars0, ArgModes0, HeadVars, ArgModes,
 		!Goal, !VarSet, !VarTypes, TypeTable, UntupleMap) :-
 	expand_args_in_proc_3(HeadVars0, ArgModes0, ListOfHeadVars,
-		ListOfArgModes, !Goal, !VarSet, !VarTypes, TypeTable),
+		ListOfArgModes, !Goal, !VarSet, !VarTypes, [], TypeTable),
 	list__condense(ListOfHeadVars, HeadVars),
 	list__condense(ListOfArgModes, ArgModes),
 	build_untuple_map(HeadVars0, ListOfHeadVars, map__init, UntupleMap).
 
-:- pred expand_args_in_proc_3(list(prog_var)::in, list(mode)::in, 
+:- pred expand_args_in_proc_3(list(prog_var)::in, list(mode)::in,
 	list(list(prog_var))::out, list(list(mode))::out,
 	hlds_goal::in, hlds_goal::out, prog_varset::in, prog_varset::out,
-	vartypes::in, vartypes::out, type_table::in) is det.
+	vartypes::in, vartypes::out, list(type)::in, type_table::in) is det.
 
-expand_args_in_proc_3([], [], [], [], !_, !_, !_, _).
+expand_args_in_proc_3([], [], [], [], !_, !_, !_, _, _).
 expand_args_in_proc_3([HeadVar0 | HeadVars0], [ArgMode0 | ArgModes0],
 		[HeadVar | HeadVars], [ArgMode | ArgModes],
-		!Goal, !VarSet, !VarTypes, TypeTable) :-
+		!Goal, !VarSet, !VarTypes, ContainerTypes, TypeTable) :-
 	expand_one_arg_in_proc(HeadVar0, ArgMode0, HeadVar, ArgMode,
-		!Goal, !VarSet, !VarTypes, TypeTable),
+		!Goal, !VarSet, !VarTypes, ContainerTypes, TypeTable),
 	expand_args_in_proc_3(HeadVars0, ArgModes0, HeadVars, ArgModes,
-		!Goal, !VarSet, !VarTypes, TypeTable).
-expand_args_in_proc_3([], [_|_], _, _, !_, !_, !_, _) :-
+		!Goal, !VarSet, !VarTypes, ContainerTypes, TypeTable).
+expand_args_in_proc_3([], [_|_], _, _, !_, !_, !_, _, _) :-
 	unexpected(this_file, "expand_args_in_proc_3: length mismatch").
-expand_args_in_proc_3([_|_], [], _, _, !_, !_, !_, _) :-
+expand_args_in_proc_3([_|_], [], _, _, !_, !_, !_, _, _) :-
 	unexpected(this_file, "expand_args_in_proc_3: length mismatch").
 
 :- pred expand_one_arg_in_proc(prog_var::in, (mode)::in, prog_vars::out,
 	list(mode)::out, hlds_goal::in, hlds_goal::out, prog_varset::in,
-	prog_varset::out, vartypes::in, vartypes::out, type_table::in)
-	is det.
+	prog_varset::out, vartypes::in, vartypes::out, list(type)::in,
+	type_table::in) is det.
 
 expand_one_arg_in_proc(HeadVar0, ArgMode0, HeadVars, ArgModes,
-		!Goal, !VarSet, !VarTypes, TypeTable) :-
+		!Goal, !VarSet, !VarTypes, ContainerTypes0, TypeTable) :-
 	expand_one_arg_in_proc_2(HeadVar0, ArgMode0, MaybeHeadVarsAndArgModes,
-		!Goal, !VarSet, !VarTypes, TypeTable),
+		!Goal, !VarSet, !VarTypes, ContainerTypes0, ContainerTypes,
+		TypeTable),
 	(
 		MaybeHeadVarsAndArgModes = yes(HeadVars1 - ArgModes1),
 		expand_args_in_proc_3(HeadVars1, ArgModes1, ListOfHeadVars,
-			ListOfArgModes, !Goal, !VarSet, !VarTypes, TypeTable),
+			ListOfArgModes, !Goal, !VarSet, !VarTypes,
+			ContainerTypes, TypeTable),
 		HeadVars = list__condense(ListOfHeadVars),
 		ArgModes = list__condense(ListOfArgModes)
 	;
@@ -246,15 +296,17 @@
 :- pred expand_one_arg_in_proc_2(prog_var::in, (mode)::in,
 	maybe(pair(list(prog_var), list(mode)))::out,
 	hlds_goal::in, hlds_goal::out, prog_varset::in, prog_varset::out,
-	vartypes::in, vartypes::out, type_table::in) is det.
+	vartypes::in, vartypes::out, list(type)::in, list(type)::out,
+	type_table::in) is det.
 
 expand_one_arg_in_proc_2(HeadVar0, ArgMode0, MaybeHeadVarsAndArgModes,
-		!Goal, !VarSet, !VarTypes, TypeTable) :-
+		!Goal, !VarSet, !VarTypes, ContainerTypes0, ContainerTypes,
+		TypeTable) :-
 	map__lookup(!.VarTypes, HeadVar0, Type),
+	expand_argument(ArgMode0, Type, ContainerTypes0, TypeTable,
+		Expansion),
 	(
-		expand_argument(ArgMode0, Type, TypeTable,
-			yes(ConsId - NewTypes))
-	->
+		Expansion = expansion(ConsId, NewTypes),
 		NumVars = list__length(NewTypes),
 		svvarset__new_vars(NumVars, NewHeadVars, !VarSet),
 		svmap__det_insert_from_corresponding_lists(
@@ -271,12 +323,15 @@
 				UnifGoal),
 			conjoin_goals_keep_detism(!.Goal, UnifGoal, !:Goal)
 		;
-			unexpected(this_file, 
+			unexpected(this_file,
 				"expand_one_arg_in_proc_2: " ++
 				"unsupported mode encountered")
-		)
+		),
+		ContainerTypes = [Type | ContainerTypes0]
 	;
-		MaybeHeadVarsAndArgModes = no
+		Expansion = no_expansion,
+		MaybeHeadVarsAndArgModes = no,
+		ContainerTypes = ContainerTypes0
 	).
 
 :- pred conjoin_goals_keep_detism(hlds_goal::in, hlds_goal::in,
@@ -310,11 +365,12 @@
 
 	% Similar to the create_aux_pred in loop_inv.m.
 	%
-:- pred create_aux_pred(pred_id::in, proc_id::in, pred_info::in, proc_info::in,
-	pred_id::out, proc_id::out, hlds_goal::out, pred_info::out,
-	proc_info::out, module_info::in, module_info::out) is det.
+:- pred create_aux_pred(pred_id::in, proc_id::in, pred_info::in,
+	proc_info::in, pred_id::out, proc_id::out, hlds_goal::out,
+	pred_info::out, proc_info::out, module_info::in, module_info::out)
+	is det.
 
-create_aux_pred(PredId, ProcId, PredInfo, ProcInfo, 
+create_aux_pred(PredId, ProcId, PredInfo, ProcInfo,
 		AuxPredId, AuxProcId, CallAux, AuxPredInfo, AuxProcInfo,
 		ModuleInfo0, ModuleInfo) :-
 	module_info_name(ModuleInfo0, ModuleName),
@@ -376,7 +432,9 @@
 		AuxPredInfo, AuxProcInfo).
 
 %-----------------------------------------------------------------------------%
-%-----------------------------------------------------------------------------%
+%
+% Pass 2
+%
 
 	% This is the top level of the second pass.  It takes the transform
 	% map built during the first pass as input.  For every call to a
@@ -577,67 +635,88 @@
 	hlds_goals::out, hlds_goals::out, prog_varset::in, prog_varset::out,
 	vartypes::in, vartypes::out, type_table::in) is det.
 
-expand_call_args([], [], [], [], [], !VarSet, !VarTypes, _).
-expand_call_args([Arg0 | Args0], [ArgMode | ArgModes], Args,
-		EnterUnifs, ExitUnifs, !VarSet, !VarTypes, TypeTable) :-
+expand_call_args(Args0, ArgModes0, Args, EnterUnifs, ExitUnifs,
+		!VarSet, !VarTypes, TypeTable) :-
+	expand_call_args_2(Args0, ArgModes0, Args, EnterUnifs, ExitUnifs,
+		!VarSet, !VarTypes, [], TypeTable).
+
+:- pred expand_call_args_2(prog_vars::in, list(mode)::in, prog_vars::out,
+	hlds_goals::out, hlds_goals::out, prog_varset::in, prog_varset::out,
+	vartypes::in, vartypes::out, list(type)::in, type_table::in) is det.
+
+expand_call_args_2([], [], [], [], [], !VarSet, !VarTypes, _, _).
+expand_call_args_2([Arg0 | Args0], [ArgMode | ArgModes], Args,
+		EnterUnifs, ExitUnifs, !VarSet, !VarTypes,
+		ContainerTypes0, TypeTable) :-
 	map__lookup(!.VarTypes, Arg0, Arg0Type),
+	expand_argument(ArgMode, Arg0Type, ContainerTypes0, TypeTable,
+		Expansion),
 	(
-		expand_argument(ArgMode, Arg0Type, TypeTable,
-			yes(ConsId - Types))
-	->
+		Expansion = expansion(ConsId, Types),
 		NumVars = list__length(Types),
 		svvarset__new_vars(NumVars, ReplacementArgs, !VarSet),
 		svmap__det_insert_from_corresponding_lists(
 			ReplacementArgs, Types, !VarTypes),
 		list__duplicate(NumVars, ArgMode, ReplacementModes),
+		ContainerTypes = [Arg0Type | ContainerTypes0],
 		( ArgMode = in_mode ->
 			deconstruct_functor(Arg0, ConsId,
 				ReplacementArgs, Unif),
 			EnterUnifs = [Unif | EnterUnifs1],
-			expand_call_args(ReplacementArgs ++ Args0,
+			expand_call_args_2(ReplacementArgs ++ Args0,
 				ReplacementModes ++ ArgModes,
-				Args, EnterUnifs1, ExitUnifs,
-				!VarSet, !VarTypes, TypeTable)
+				Args, EnterUnifs1, ExitUnifs, !VarSet,
+				!VarTypes, ContainerTypes, TypeTable)
 		; ArgMode = out_mode ->
 			construct_functor(Arg0, ConsId,
 				ReplacementArgs, Unif),
 			ExitUnifs = ExitUnifs1 ++ [Unif],
-			expand_call_args(ReplacementArgs ++ Args0,
+			expand_call_args_2(ReplacementArgs ++ Args0,
 				ReplacementModes ++ ArgModes,
-				Args, EnterUnifs, ExitUnifs1,
-				!VarSet, !VarTypes, TypeTable)
+				Args, EnterUnifs, ExitUnifs1, !VarSet,
+				!VarTypes, ContainerTypes, TypeTable)
 		;
-			unexpected(this_file, 
+			unexpected(this_file,
 				"expand_call_args: unsupported mode")
 		)
 	;
+		Expansion = no_expansion,
 		Args = [Arg0 | Args1],
 		expand_call_args(Args0, ArgModes, Args1, EnterUnifs,
 			ExitUnifs, !VarSet, !VarTypes, TypeTable)
 	).
 
-expand_call_args([], [_|_], _, _, _, !_, !_, _) :-
+expand_call_args_2([], [_|_], _, _, _, !_, !_, _, _) :-
 	unexpected(this_file, "expand_call_args: length mismatch").
-expand_call_args([_|_], [], _, _, _, !_, !_, _) :-
+expand_call_args_2([_|_], [], _, _, _, !_, !_, _, _) :-
 	unexpected(this_file, "expand_call_args: length mismatch").
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
-	% expand_argument(ArgMode, ArgType, TypeTable, MaybeConsIdAndTypes)
+:- type expansion_result
+	--->	expansion(
+			cons_id,
+				% the cons_id of the expanded constructor
+			list(type)
+				% the types of the arguments for the
+				% expanded constructor
+		)
+	;	no_expansion.
+
 	% This predicate tries to expand the argument of the given mode and
-	% type.  If this is possible then MaybeConsIdAndTypes is unified with
-	% a pair consisting of the cons_id of the constructor which was
-	% expanded and the types for that constructor.
-	% 
-:- pred expand_argument((mode)::in, (type)::in, type_table::in,
-	maybe(pair(cons_id, list(type)))::out) is det.
+	% type.  If this is possible then Expansion is unified with the
+	% `expansion' functor, giving the details of the expansion.
+	% Otherwise it is unified with `no_expansion'.
+	%
+:- pred expand_argument((mode)::in, (type)::in, list(type)::in,
+	type_table::in, expansion_result::out) is det.
 
-expand_argument(ArgMode, ArgType, TypeTable, MaybeConsIdAndTypes) :-
+expand_argument(ArgMode, ArgType, ContainerTypes, TypeTable, Expansion) :-
 	( expandable_arg_mode(ArgMode) ->
-		expand_type(ArgType, TypeTable, MaybeConsIdAndTypes)
+		expand_type(ArgType, ContainerTypes, TypeTable, Expansion)
 	;
-		MaybeConsIdAndTypes = no
+		Expansion = no_expansion
 	).
 
 	% This module so far only knows how to expand arguments which have
@@ -648,10 +727,10 @@
 expandable_arg_mode(in_mode).
 expandable_arg_mode(out_mode).
 
-:- pred expand_type((type)::in, type_table::in,
-	maybe(pair(cons_id, list(type)))::out) is det.
+:- pred expand_type((type)::in, list(type)::in, type_table::in,
+	expansion_result::out) is det.
 
-expand_type(Type, TypeTable, MaybeConsIdAndTypes) :-
+expand_type(Type, ContainerTypes, TypeTable, Expansion) :-
 	(
 		% Always expand tuple types.
 		type_to_ctor_and_args(Type, TypeCtor, TypeArgs),
@@ -659,7 +738,7 @@
 	->
 		Arity = list__length(TypeArgs),
 		ConsId = cons(unqualified("{}"), Arity),
-		MaybeConsIdAndTypes = yes(ConsId - TypeArgs)
+		Expansion = expansion(ConsId, TypeArgs)
 	;
 		% Expand a discriminated union type if it has only a
 		% single functor and the type has no parameters.
@@ -669,17 +748,18 @@
 		get_type_defn_body(TypeDefn, TypeBody),
 		TypeBody ^ du_type_ctors = [SingleCtor],
 		SingleCtor ^ cons_exist = [],
-
 		SingleCtorName = SingleCtor ^ cons_name,
 		SingleCtorArgs = SingleCtor ^ cons_args,
-		SingleCtorArgs \= []
+		SingleCtorArgs \= [],
+		% Prevent infinite loop with recursive types.
+		\+ list__member(Type, ContainerTypes)
 	->
 		Arity = list__length(SingleCtorArgs),
 		ConsId = cons(SingleCtorName, Arity),
 		ExpandedTypes = list__map(snd, SingleCtorArgs),
-		MaybeConsIdAndTypes = yes(ConsId - ExpandedTypes)
+		Expansion = expansion(ConsId, ExpandedTypes)
 	;
-		MaybeConsIdAndTypes = no
+		Expansion = no_expansion
 	).
 
 %-----------------------------------------------------------------------------%
diff -u -r ws3.old/doc/user_guide.texi ws3/doc/user_guide.texi
--- ws3.old/doc/user_guide.texi	2005-02-01 14:40:29.000000000 +1100
+++ ws3/doc/user_guide.texi	2005-02-01 14:43:11.000000000 +1100
@@ -6764,6 +6764,13 @@
 exception.  This information can be used by some 
 optimization passes.
 
+ at c @sp 1
+ at c @item --untuple
+ at c @findex --untuple
+ at c Expand out procedure arguments when the argument type
+ at c is a tuple or a type with exactly one functor.
+ at c Note this is almost always a pessimization.
+
 @end table
 
 @node MLDS backend (MLDS -> MLDS) optimization options


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