[m-rev.] for review: untupling transformation

[Julien Fischer]

On Mon, 31 Jan 2005, Peter Wang wrote:

> +%-----------------------------------------------------------------------------%
> +
> +	% Similar to the create_aux_pred in loop_inv.m.
> +	%
That's not particularly helpful since the predicate in that module
isn't documented anyway - add a more meaningful description of this.

> +:- 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,
> +		AuxPredId, AuxProcId, CallAux, AuxPredInfo, AuxProcInfo,
> +		ModuleInfo0, ModuleInfo) :-
> +	module_info_name(ModuleInfo0, ModuleName),
> +
> +	proc_info_headvars(ProcInfo, AuxHeadVars),
> +	proc_info_goal(ProcInfo, Goal @ (_GoalExpr - GoalInfo)),
> +	proc_info_get_initial_instmap(ProcInfo, ModuleInfo0,
> +		InitialAuxInstMap),
> +	pred_info_typevarset(PredInfo, TVarSet),
> +	proc_info_vartypes(ProcInfo, VarTypes),
> +	pred_info_get_class_context(PredInfo, ClassContext),
> +	proc_info_typeinfo_varmap(ProcInfo, TVarMap),
> +	proc_info_typeclass_info_varmap(ProcInfo, TCVarMap),
> +	proc_info_varset(ProcInfo, VarSet),
> +	proc_info_inst_varset(ProcInfo, InstVarSet),
> +	pred_info_get_markers(PredInfo, Markers),
> +	pred_info_get_aditi_owner(PredInfo, Owner),
> +	pred_info_get_origin(PredInfo, OrigOrigin),
> +
> +	PredName = pred_info_name(PredInfo),
> +	goal_info_get_context(GoalInfo, Context),
> +	term__context_line(Context, Line),
> +	proc_id_to_int(ProcId, ProcNo),
> +	AuxNamePrefix = string__format("untupling_%d", [i(ProcNo)]),
> +	make_pred_name_with_context(ModuleName, AuxNamePrefix,
> +		predicate, PredName, Line, 1, AuxPredSymName),
> +	(
> +		AuxPredSymName = unqualified(AuxPredName)
> +	;
> +		AuxPredSymName = qualified(_ModuleSpecifier, AuxPredName)
> +	),
> +
> +	Origin = transformed(untuple(ProcNo), OrigOrigin, PredId),
> +	hlds_pred__define_new_pred(
> +		Origin,			% in
> +		Goal,			% in
> +		CallAux,		% out
> +		AuxHeadVars,		% in
> +		_ExtraArgs,		% out
> +		InitialAuxInstMap,	% in
> +		AuxPredName,		% in
> +		TVarSet,		% in
> +		VarTypes,		% in
> +		ClassContext,		% in
> +		TVarMap,		% in
> +		TCVarMap,		% in
> +		VarSet,			% in
> +		InstVarSet,		% in
> +		Markers,		% in
> +		Owner,			% in
> +		address_is_not_taken,	% in
> +		ModuleInfo0,
> +		ModuleInfo,
> +		proc(AuxPredId, AuxProcId)
> +					% out
> +	),
> +
> +	module_info_pred_proc_info(ModuleInfo, AuxPredId, AuxProcId,
> +		AuxPredInfo, AuxProcInfo).
> +


> +%-----------------------------------------------------------------------------%
> +
> +:- pred fix_calls_in_conj(hlds_goals::in, hlds_goals::out, prog_varset::in,
> +	prog_varset::out, vartypes::in, vartypes::out, transform_map::in,
> +	module_info::in) is det.
> +
> +fix_calls_in_conj([], [], !VarSet, !VarTypes, _, _).
> +fix_calls_in_conj([Goal0 | Goals0], Goals, !VarSet, !VarTypes, TransformMap,
> +		ModuleInfo) :-
> +	fix_calls_in_goal(Goal0, Goal1, !VarSet, !VarTypes, TransformMap,
> +		ModuleInfo),
> +	fix_calls_in_conj(Goals0, Goals1, !VarSet, !VarTypes, TransformMap,
> +		ModuleInfo),
> +	(if Goal1 = conj(ConjGoals) - _ then
> +		Goals = ConjGoals ++ Goals1
> +	else
> +		Goals = [Goal1 | Goals1]
> +	).
> +
> +:- pred fix_calls_in_par_conj(hlds_goals::in, hlds_goals::out,
> +	prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
> +	transform_map::in, module_info::in) is det.
> +
> +fix_calls_in_par_conj([], [], !VarSet, !VarTypes, _, _).
> +fix_calls_in_par_conj([Goal0 | Goals0], [Goal | Goals], !VarSet, !VarTypes,
> +		TransformMap, ModuleInfo) :-
> +	fix_calls_in_goal(Goal0, Goal, !VarSet, !VarTypes, TransformMap,
> +		ModuleInfo),
> +	fix_calls_in_par_conj(Goals0, Goals, !VarSet, !VarTypes, TransformMap,
> +		ModuleInfo).
> +
Add a comment explaining why parallel conjunction is treated differently to
normal conjunction.

> +%-----------------------------------------------------------------------------%
> +
> +:- pred expand_call_args(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, type_table::in) is det.
> +
> +expand_call_args([], [], [], [], [], !VarSet, !VarTypes, _).
> +expand_call_args([Arg0 | Args0], [ArgMode | ArgModes], Args,
> +		EnterUnifs, ExitUnifs, !VarSet, !VarTypes, TypeTable) :-
> +	map__lookup(!.VarTypes, Arg0, Arg0Type),
> +	(
> +		expand_argument(ArgMode, Arg0Type, TypeTable,
> +			yes(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),
> +		( ArgMode = in_mode ->
> +			deconstruct_functor(Arg0, ConsId,
> +				ReplacementArgs, Unif),
> +			EnterUnifs = [Unif | EnterUnifs1],
> +			expand_call_args(ReplacementArgs ++ Args0,
> +				ReplacementModes ++ ArgModes,
> +				Args, EnterUnifs1, ExitUnifs,
> +				!VarSet, !VarTypes, TypeTable)
> +		; ArgMode = out_mode ->
> +			construct_functor(Arg0, ConsId,
> +				ReplacementArgs, Unif),
> +			ExitUnifs = ExitUnifs1 ++ [Unif],

It might be better to generate this list in reverse and then
call list.reverse on it.  (Although I don't think it's really going
to matter for lists of the length you'll typically be dealing with).

That looks fine otherwise.

Cheers,
Julien.
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------