mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-20 08:19:28 +00:00
f9fe8dcf61
Estimated hours taken: 8
Branches: main
Improve the error messages generated for determinism errors involving committed
choice contexts. Previously, we printed a message to the effect that e.g.
a cc pred is called in context that requires all solutions, but we didn't say
*why* the context requires all solutions. We now keep track of all the goals
to the right that could fail, since it is these goals that may reject the first
solution of a committed choice goal.
The motivation for this diff was the fact that I found that locating the
failing goal can be very difficult if the conjunction to the right is
a couple of hundred lines long. This would have been a nontrivial problem,
since (a) unifications involving values of user-defined types are committed
choice goals, and (b) we can expect uses of user-defined types to increase.
compiler/det_analysis.m:
Keep track of goals to the right of the current goal that could fail,
and include them in the error representation if required.
compiler/det_report.m:
Include the list of failing goals to the right in the representations
of determinism errors involving committed committed choice goals.
Convert the last part of this module that wasn't using error_util
to use error_util. Make most parts of this module just construct
error message specifications; print those specifications (using
error_util) in only a few places.
compiler/hlds_out.m:
Add a function for use by the new code in det_report.m.
compiler/error_util.m:
Add a function for use by the new code in det_report.m.
compiler/error_util.m:
compiler/compiler_util.m:
Error_util is still changing reasonably often, and yet it is
included in lots of modules, most of which need only a few simple
non-parse-tree-related predicates from it (e.g. unexpected).
Move those predicates to a new module, compiler_util.m. This also
eliminates some undesirable dependencies from libs to parse_tree.
compiler/libs.m:
Include compiler_util.m.
compiler/notes/compiler_design.html:
Document compiler_util.m, and fix the documentation of some other
modules.
compiler/*.m:
Import compiler_util instead of or in addition to error_util.
To make this easier, consistently use . instead of __ for module
qualifying module names.
tests/invalid/det_errors_cc.{m,err_exp}:
Add this new test case to test the error messages for cc contexts.
tests/invalid/det_errors_deet.{m,err_exp}:
Add this new test case to test the error messages for unifications
inside function symbols.
tests/invalid/Mmakefile:
Add the new test cases.
tests/invalid/det_errors.err_exp:
tests/invalid/magicbox.err_exp:
Change the expected output to conform to the change in det_report.m,
which is now more consistent.
767 lines
30 KiB
Mathematica
767 lines
30 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 2005 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: untupling.m.
|
|
%
|
|
% Author: wangp.
|
|
%
|
|
% 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 predicate and types,
|
|
%
|
|
% :- type t ---> t(u).
|
|
% :- type u ---> u(v, w).
|
|
% :- type v ---> v1 ; v2.
|
|
% :- type w ---> w(int, string).
|
|
%
|
|
% :- pred f(t::in) is det.
|
|
% f(T) :- blah.
|
|
%
|
|
% a transformed version of f/1 would be added:
|
|
%
|
|
% :- pred f_untupled(v::in, int::in, string::in) is det.
|
|
% f_untupled(V, W1, W2) :- blah.
|
|
%
|
|
% 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 (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, 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
|
|
% below).
|
|
%
|
|
% Julien says: "it should be possible for this transformation to work across
|
|
% module boundaries by exporting the goal templates [search for CallAux
|
|
% below] in the `.opt' files."
|
|
%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- module transform_hlds__untupling.
|
|
|
|
:- interface.
|
|
|
|
:- import_module hlds.hlds_module.
|
|
|
|
:- import_module io.
|
|
|
|
:- pred untuple_arguments(module_info::in, module_info::out, io::di, io::uo)
|
|
is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module check_hlds.det_analysis.
|
|
:- import_module check_hlds.mode_util.
|
|
:- import_module hlds.hlds_data.
|
|
:- import_module hlds.hlds_goal.
|
|
:- import_module hlds.hlds_pred.
|
|
:- import_module hlds.quantification.
|
|
:- import_module libs.compiler_util.
|
|
:- import_module mdbcomp.prim_data.
|
|
:- import_module parse_tree.prog_data.
|
|
:- import_module parse_tree.prog_mode.
|
|
:- import_module parse_tree.prog_type.
|
|
:- import_module parse_tree.prog_util.
|
|
|
|
:- import_module bool.
|
|
:- import_module counter.
|
|
:- import_module int.
|
|
:- import_module list.
|
|
:- import_module map.
|
|
:- import_module require.
|
|
:- import_module std_util.
|
|
:- import_module string.
|
|
:- import_module svmap.
|
|
:- import_module svvarset.
|
|
:- import_module term.
|
|
:- import_module varset.
|
|
|
|
% The transform_map structure records which procedures were
|
|
% transformed into what procedures during the first pass.
|
|
%
|
|
:- type transform_map == map(pred_proc_id, transformed_proc).
|
|
|
|
:- type transformed_proc
|
|
---> transformed_proc(
|
|
pred_proc_id,
|
|
% A procedure that was generated by the
|
|
% untupling transformation.
|
|
hlds_goal
|
|
% A call goal template that is used to update
|
|
% calls referring to the old procedure to the
|
|
% new procedure.
|
|
).
|
|
|
|
untuple_arguments(!ModuleInfo, !IO) :-
|
|
expand_args_in_module(!ModuleInfo, TransformMap),
|
|
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
|
|
% procedures into the module and recording the mapping between the old
|
|
% and new procedures in the transform map.
|
|
%
|
|
:- pred expand_args_in_module(module_info::in, module_info::out,
|
|
transform_map::out) is det.
|
|
|
|
expand_args_in_module(!ModuleInfo, TransformMap) :-
|
|
module_info_predids(!.ModuleInfo, PredIds),
|
|
list__foldl3(expand_args_in_pred, PredIds,
|
|
!ModuleInfo, map__init, TransformMap, counter__init(0), _).
|
|
|
|
:- pred expand_args_in_pred(pred_id::in, module_info::in, module_info::out,
|
|
transform_map::in, transform_map::out, counter::in, counter::out) is det.
|
|
|
|
expand_args_in_pred(PredId, !ModuleInfo, !TransformMap, !Counter) :-
|
|
module_info_get_type_table(!.ModuleInfo, TypeTable),
|
|
module_info_pred_info(!.ModuleInfo, PredId, PredInfo),
|
|
(
|
|
% Only perform the transformation on predicates which
|
|
% satisfy the following criteria.
|
|
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([], [])),
|
|
pred_info_get_origin(PredInfo, user(_)),
|
|
pred_info_arg_types(PredInfo, TypeVarSet, ExistQVars, ArgTypes),
|
|
varset__is_empty(TypeVarSet),
|
|
ExistQVars = [],
|
|
at_least_one_expandable_type(ArgTypes, TypeTable)
|
|
->
|
|
ProcIds = pred_info_non_imported_procids(PredInfo),
|
|
list__foldl3(expand_args_in_proc(PredId), ProcIds,
|
|
!ModuleInfo, !TransformMap, !Counter)
|
|
;
|
|
true
|
|
).
|
|
|
|
:- pred at_least_one_expandable_type(list(mer_type)::in, type_table::in)
|
|
is semidet.
|
|
|
|
at_least_one_expandable_type([Type | Types], TypeTable) :-
|
|
( expand_type(Type, [], TypeTable, expansion(_, _))
|
|
; at_least_one_expandable_type(Types, TypeTable)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% This structure records the mapping between a head variable of the
|
|
% original procedure, and the list of variables that it was finally
|
|
% expanded into. If the head variable expands into some intermediate
|
|
% variables which are then expanded further, the intermediate
|
|
% variables are not listed in the mapping.
|
|
%
|
|
:- type untuple_map == map(prog_var, prog_vars).
|
|
|
|
:- pred expand_args_in_proc(pred_id::in, proc_id::in, module_info::in,
|
|
module_info::out, transform_map::in, transform_map::out,
|
|
counter::in, counter::out) is det.
|
|
|
|
expand_args_in_proc(PredId, ProcId, !ModuleInfo, !TransformMap, !Counter) :-
|
|
some [!ProcInfo] (
|
|
module_info_get_type_table(!.ModuleInfo, TypeTable),
|
|
module_info_pred_proc_info(!.ModuleInfo, PredId, ProcId,
|
|
PredInfo0, !:ProcInfo),
|
|
|
|
proc_info_headvars(!.ProcInfo, HeadVars0),
|
|
proc_info_argmodes(!.ProcInfo, ArgModes0),
|
|
proc_info_goal(!.ProcInfo, Goal0),
|
|
proc_info_vartypes(!.ProcInfo, VarTypes0),
|
|
proc_info_varset(!.ProcInfo, VarSet0),
|
|
|
|
expand_args_in_proc_2(HeadVars0, ArgModes0, HeadVars, ArgModes,
|
|
Goal0, Goal, VarSet0, VarSet, VarTypes0, VarTypes,
|
|
TypeTable, UntupleMap),
|
|
|
|
proc_info_set_headvars(HeadVars, !ProcInfo),
|
|
proc_info_set_argmodes(ArgModes, !ProcInfo),
|
|
proc_info_set_goal(Goal, !ProcInfo),
|
|
proc_info_set_varset(VarSet, !ProcInfo),
|
|
proc_info_set_vartypes(VarTypes, !ProcInfo),
|
|
requantify_proc(!ProcInfo),
|
|
recompute_instmap_delta_proc(yes, !ProcInfo, !ModuleInfo),
|
|
|
|
counter__allocate(Num, !Counter),
|
|
create_aux_pred(PredId, ProcId, PredInfo0, !.ProcInfo, Num,
|
|
AuxPredId, AuxProcId, CallAux,
|
|
AuxPredInfo, AuxProcInfo0, !ModuleInfo),
|
|
proc_info_set_maybe_untuple_info(
|
|
yes(untuple_proc_info(UntupleMap)),
|
|
AuxProcInfo0, AuxProcInfo),
|
|
module_info_set_pred_proc_info(AuxPredId, AuxProcId,
|
|
AuxPredInfo, AuxProcInfo, !ModuleInfo),
|
|
svmap__det_insert(proc(PredId, ProcId),
|
|
transformed_proc(proc(AuxPredId, AuxProcId), CallAux),
|
|
!TransformMap)
|
|
).
|
|
|
|
:- pred expand_args_in_proc_2(prog_vars::in, list(mer_mode)::in,
|
|
prog_vars::out, list(mer_mode)::out, hlds_goal::in, hlds_goal::out,
|
|
prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
|
|
type_table::in, untuple_map::out) is det.
|
|
|
|
expand_args_in_proc_2(HeadVars0, ArgModes0, HeadVars, ArgModes,
|
|
Goal0, Goal - GoalInfo, !VarSet, !VarTypes, TypeTable, UntupleMap) :-
|
|
expand_args_in_proc_3(HeadVars0, ArgModes0, ListOfHeadVars,
|
|
ListOfArgModes, Goal0, Goal - GoalInfo1, !VarSet,
|
|
!VarTypes, [], TypeTable),
|
|
goal_info_get_context(snd(Goal0), Context),
|
|
goal_info_set_context(Context, GoalInfo1, GoalInfo),
|
|
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(mer_mode)::in,
|
|
list(list(prog_var))::out, list(list(mer_mode))::out,
|
|
hlds_goal::in, hlds_goal::out, prog_varset::in, prog_varset::out,
|
|
vartypes::in, vartypes::out, list(mer_type)::in, type_table::in) is det.
|
|
|
|
expand_args_in_proc_3([], [], [], [], !_, !_, !_, _, _).
|
|
expand_args_in_proc_3([HeadVar0 | HeadVars0], [ArgMode0 | ArgModes0],
|
|
[HeadVar | HeadVars], [ArgMode | ArgModes],
|
|
!Goal, !VarSet, !VarTypes, ContainerTypes, TypeTable) :-
|
|
expand_one_arg_in_proc(HeadVar0, ArgMode0, HeadVar, ArgMode,
|
|
!Goal, !VarSet, !VarTypes, ContainerTypes, TypeTable),
|
|
expand_args_in_proc_3(HeadVars0, ArgModes0, HeadVars, ArgModes,
|
|
!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([_|_], [], _, _, !_, !_, !_, _, _) :-
|
|
unexpected(this_file, "expand_args_in_proc_3: length mismatch").
|
|
|
|
:- pred expand_one_arg_in_proc(prog_var::in, mer_mode::in, prog_vars::out,
|
|
list(mer_mode)::out, hlds_goal::in, hlds_goal::out, prog_varset::in,
|
|
prog_varset::out, vartypes::in, vartypes::out, list(mer_type)::in,
|
|
type_table::in) is det.
|
|
|
|
expand_one_arg_in_proc(HeadVar0, ArgMode0, HeadVars, ArgModes,
|
|
!Goal, !VarSet, !VarTypes, ContainerTypes0, TypeTable) :-
|
|
expand_one_arg_in_proc_2(HeadVar0, ArgMode0, MaybeHeadVarsAndArgModes,
|
|
!Goal, !VarSet, !VarTypes, ContainerTypes0, ContainerTypes, TypeTable),
|
|
(
|
|
MaybeHeadVarsAndArgModes = yes(HeadVars1 - ArgModes1),
|
|
expand_args_in_proc_3(HeadVars1, ArgModes1,
|
|
ListOfHeadVars, ListOfArgModes, !Goal, !VarSet, !VarTypes,
|
|
ContainerTypes, TypeTable),
|
|
HeadVars = list__condense(ListOfHeadVars),
|
|
ArgModes = list__condense(ListOfArgModes)
|
|
;
|
|
MaybeHeadVarsAndArgModes = no,
|
|
HeadVars = [HeadVar0],
|
|
ArgModes = [ArgMode0]
|
|
).
|
|
|
|
:- pred expand_one_arg_in_proc_2(prog_var::in, mer_mode::in,
|
|
maybe(pair(list(prog_var), list(mer_mode)))::out,
|
|
hlds_goal::in, hlds_goal::out, prog_varset::in, prog_varset::out,
|
|
vartypes::in, vartypes::out, list(mer_type)::in, list(mer_type)::out,
|
|
type_table::in) is det.
|
|
|
|
expand_one_arg_in_proc_2(HeadVar0, ArgMode0, MaybeHeadVarsAndArgModes,
|
|
!Goal, !VarSet, !VarTypes, ContainerTypes0, ContainerTypes,
|
|
TypeTable) :-
|
|
map__lookup(!.VarTypes, HeadVar0, Type),
|
|
expand_argument(ArgMode0, Type, ContainerTypes0, TypeTable,
|
|
Expansion),
|
|
(
|
|
Expansion = expansion(ConsId, NewTypes),
|
|
varset__lookup_name(!.VarSet, HeadVar0, ParentName),
|
|
create_untuple_vars(ParentName, 0, NewTypes, NewHeadVars,
|
|
!VarSet, !VarTypes),
|
|
list__duplicate(list__length(NewHeadVars), ArgMode0, NewArgModes),
|
|
MaybeHeadVarsAndArgModes = yes(NewHeadVars - NewArgModes),
|
|
( ArgMode0 = in_mode ->
|
|
construct_functor(HeadVar0, ConsId, NewHeadVars, UnifGoal),
|
|
conjoin_goals_keep_detism(UnifGoal, !Goal)
|
|
; ArgMode0 = out_mode ->
|
|
deconstruct_functor(HeadVar0, ConsId, NewHeadVars, UnifGoal),
|
|
conjoin_goals_keep_detism(!.Goal, UnifGoal, !:Goal)
|
|
;
|
|
unexpected(this_file,
|
|
"expand_one_arg_in_proc_2: unsupported mode encountered")
|
|
),
|
|
ContainerTypes = [Type | ContainerTypes0]
|
|
;
|
|
Expansion = no_expansion,
|
|
MaybeHeadVarsAndArgModes = no,
|
|
ContainerTypes = ContainerTypes0
|
|
).
|
|
|
|
:- pred create_untuple_vars(string::in, int::in, list(mer_type)::in,
|
|
list(prog_var)::out, prog_varset::in, prog_varset::out,
|
|
vartypes::in, vartypes::out) is det.
|
|
|
|
create_untuple_vars(_, _, [], [], !VarSet, !VarTypes).
|
|
create_untuple_vars(ParentName, Num, [Type | Types], [NewVar | NewVars],
|
|
!VarSet, !VarTypes) :-
|
|
string__format("Untupled_%s_%d", [s(ParentName), i(Num)], Name),
|
|
svvarset__new_named_var(Name, NewVar, !VarSet),
|
|
svmap__det_insert(NewVar, Type, !VarTypes),
|
|
create_untuple_vars(ParentName, Num+1, Types, NewVars, !VarSet, !VarTypes).
|
|
|
|
:- pred conjoin_goals_keep_detism(hlds_goal::in, hlds_goal::in,
|
|
hlds_goal::out) is det.
|
|
|
|
conjoin_goals_keep_detism(GoalA, GoalB, conj(GoalList) - GoalInfo) :-
|
|
goal_to_conj_list(GoalA, GoalListA),
|
|
goal_to_conj_list(GoalB, GoalListB),
|
|
list__append(GoalListA, GoalListB, GoalList),
|
|
goal_list_determinism(GoalList, Determinism),
|
|
goal_info_init(GoalInfo0),
|
|
goal_info_set_determinism(Determinism, GoalInfo0, GoalInfo).
|
|
|
|
:- pred build_untuple_map(list(prog_var)::in, list(list(prog_var))::in,
|
|
untuple_map::in, untuple_map::out) is det.
|
|
|
|
build_untuple_map([], [], !UntupleMap).
|
|
build_untuple_map([OldVar | OldVars], [NewVars | NewVarss], !UntupleMap) :-
|
|
( NewVars = [OldVar] ->
|
|
build_untuple_map(OldVars, NewVarss, !UntupleMap)
|
|
;
|
|
svmap__det_insert(OldVar, NewVars, !UntupleMap),
|
|
build_untuple_map(OldVars, NewVarss, !UntupleMap)
|
|
).
|
|
build_untuple_map([], [_| _], !_) :-
|
|
unexpected(this_file, "build_untuple_map: length mismatch").
|
|
build_untuple_map([_| _], [], !_) :-
|
|
unexpected(this_file, "build_untuple_map: length mismatch").
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% This predicate makes a new version of the given procedure in a
|
|
% module. Amongst other things the new procedure is given a new
|
|
% pred_id and proc_id, a new name and a new goal.
|
|
%
|
|
% CallAux is an output variable, which is unified with a goal that
|
|
% can be used as a template for constructing calls to the newly
|
|
% created procedure.
|
|
%
|
|
% See also create_aux_pred in loop_inv.m.
|
|
%
|
|
:- pred create_aux_pred(pred_id::in, proc_id::in, pred_info::in,
|
|
proc_info::in, int::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, Counter,
|
|
AuxPredId, AuxProcId, CallAux, AuxPredInfo, AuxProcInfo,
|
|
!ModuleInfo) :-
|
|
module_info_get_name(!.ModuleInfo, ModuleName),
|
|
|
|
proc_info_headvars(ProcInfo, AuxHeadVars),
|
|
proc_info_goal(ProcInfo, Goal @ (_GoalExpr - GoalInfo)),
|
|
proc_info_get_initial_instmap(ProcInfo, !.ModuleInfo, InitialAuxInstMap),
|
|
pred_info_typevarset(PredInfo, TVarSet),
|
|
proc_info_vartypes(ProcInfo, VarTypes),
|
|
pred_info_get_class_context(PredInfo, ClassContext),
|
|
proc_info_rtti_varmaps(ProcInfo, RttiVarMaps),
|
|
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),
|
|
PredOrFunc = pred_info_is_pred_or_func(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,
|
|
PredOrFunc, PredName, Line, Counter, AuxPredSymName),
|
|
(
|
|
AuxPredSymName = unqualified(AuxPredName)
|
|
;
|
|
AuxPredSymName = qualified(_ModuleSpecifier, AuxPredName)
|
|
),
|
|
|
|
Origin = transformed(untuple(ProcNo), OrigOrigin, PredId),
|
|
hlds_pred__define_new_pred(Origin, Goal, CallAux, AuxHeadVars, _ExtraArgs,
|
|
InitialAuxInstMap, AuxPredName, TVarSet, VarTypes, ClassContext,
|
|
RttiVarMaps, VarSet, InstVarSet, Markers, Owner, address_is_not_taken,
|
|
!ModuleInfo, proc(AuxPredId, AuxProcId)),
|
|
|
|
module_info_pred_proc_info(!.ModuleInfo, AuxPredId, AuxProcId,
|
|
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 procedure
|
|
% in the transform map, it rewrites the call to use the new procedure
|
|
% instead, inserting unifications before and after the call as necessary.
|
|
%
|
|
:- pred fix_calls_to_expanded_procs(transform_map::in, module_info::in,
|
|
module_info::out) is det.
|
|
|
|
fix_calls_to_expanded_procs(TransformMap, !ModuleInfo) :-
|
|
module_info_predids(!.ModuleInfo, PredIds),
|
|
list__foldl(fix_calls_in_pred(TransformMap), PredIds, !ModuleInfo).
|
|
|
|
:- pred fix_calls_in_pred(transform_map::in, pred_id::in, module_info::in,
|
|
module_info::out) is det.
|
|
|
|
fix_calls_in_pred(TransformMap, PredId, !ModuleInfo) :-
|
|
module_info_pred_info(!.ModuleInfo, PredId, PredInfo),
|
|
ProcIds = pred_info_non_imported_procids(PredInfo),
|
|
list__foldl(fix_calls_in_proc(TransformMap, PredId), ProcIds, !ModuleInfo).
|
|
|
|
:- pred fix_calls_in_proc(transform_map::in, pred_id::in, proc_id::in,
|
|
module_info::in, module_info::out) is det.
|
|
|
|
fix_calls_in_proc(TransformMap, PredId, ProcId, !ModuleInfo) :-
|
|
some [!ProcInfo] (
|
|
module_info_pred_proc_info(!.ModuleInfo, PredId, ProcId,
|
|
PredInfo, !:ProcInfo),
|
|
proc_info_goal(!.ProcInfo, Goal0),
|
|
proc_info_vartypes(!.ProcInfo, VarTypes0),
|
|
proc_info_varset(!.ProcInfo, VarSet0),
|
|
fix_calls_in_goal(Goal0, Goal, VarSet0, VarSet,
|
|
VarTypes0, VarTypes, TransformMap, !.ModuleInfo),
|
|
( Goal0 \= Goal ->
|
|
proc_info_set_goal(Goal, !ProcInfo),
|
|
proc_info_set_varset(VarSet, !ProcInfo),
|
|
proc_info_set_vartypes(VarTypes, !ProcInfo),
|
|
requantify_proc(!ProcInfo),
|
|
recompute_instmap_delta_proc(yes, !ProcInfo, !ModuleInfo),
|
|
module_info_set_pred_proc_info(PredId, ProcId,
|
|
PredInfo, !.ProcInfo, !ModuleInfo)
|
|
;
|
|
true
|
|
)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred fix_calls_in_goal(hlds_goal::in, hlds_goal::out, prog_varset::in,
|
|
prog_varset::out, vartypes::in, vartypes::out, transform_map::in,
|
|
module_info::in) is det.
|
|
|
|
fix_calls_in_goal(Goal - GoalInfo, Goal - GoalInfo, !_, !_, _, _) :-
|
|
Goal = foreign_proc(_, _, _, _, _, _).
|
|
|
|
fix_calls_in_goal(Goal - GoalInfo, Goal - GoalInfo, !_, !_, _, _) :-
|
|
Goal = generic_call(_, _, _, _).
|
|
|
|
fix_calls_in_goal(Goal0 - GoalInfo0, Goal, !VarSet, !VarTypes,
|
|
TransformMap, ModuleInfo) :-
|
|
Goal0 = call(CalleePredId, CalleeProcId, OrigArgs, _, _, _),
|
|
(
|
|
map__search(TransformMap, proc(CalleePredId, CalleeProcId),
|
|
transformed_proc(_, CallAux0 - CallAuxInfo))
|
|
->
|
|
module_info_get_type_table(ModuleInfo, TypeTable),
|
|
module_info_pred_proc_info(ModuleInfo, CalleePredId,
|
|
CalleeProcId, _CalleePredInfo, CalleeProcInfo),
|
|
proc_info_argmodes(CalleeProcInfo, OrigArgModes),
|
|
expand_call_args(OrigArgs, OrigArgModes, Args,
|
|
EnterUnifs, ExitUnifs, !VarSet, !VarTypes, TypeTable),
|
|
( CallAux = CallAux0 ^ call_args := Args ->
|
|
Call = CallAux - CallAuxInfo,
|
|
ConjList = EnterUnifs ++ [Call] ++ ExitUnifs,
|
|
conj_list_to_goal(ConjList, GoalInfo0, Goal)
|
|
;
|
|
unexpected(this_file, "fix_calls_in_goal: not a call template")
|
|
)
|
|
;
|
|
Goal = Goal0 - GoalInfo0
|
|
).
|
|
|
|
fix_calls_in_goal(Goal - GoalInfo, Goal - GoalInfo, !_, !_, _, _) :-
|
|
Goal = unify(_, _, _, _, _).
|
|
|
|
fix_calls_in_goal(not(Goal0) - GoalInfo, not(Goal) - GoalInfo,
|
|
!VarSet, !VarTypes, TransformMap, ModuleInfo) :-
|
|
fix_calls_in_goal(Goal0, Goal, !VarSet, !VarTypes, TransformMap,
|
|
ModuleInfo).
|
|
|
|
fix_calls_in_goal(scope(Reason, Goal0) - GoalInfo,
|
|
scope(Reason, Goal) - GoalInfo,
|
|
!VarSet, !VarTypes, TransformMap, ModuleInfo) :-
|
|
fix_calls_in_goal(Goal0, Goal, !VarSet, !VarTypes, TransformMap,
|
|
ModuleInfo).
|
|
|
|
fix_calls_in_goal(conj(Goals0) - GoalInfo, conj(Goals) - GoalInfo,
|
|
!VarSet, !VarTypes, TransformMap, ModuleInfo) :-
|
|
fix_calls_in_conj(Goals0, Goals, !VarSet, !VarTypes, TransformMap,
|
|
ModuleInfo).
|
|
|
|
fix_calls_in_goal(par_conj(Goals0) - GoalInfo, par_conj(Goals) - GoalInfo,
|
|
!VarSet, !VarTypes, TransformMap, ModuleInfo) :-
|
|
% I am not sure whether parallel conjunctions should be treated
|
|
% with fix_calls_in_goal or fix_calls_in_goal_list. At any rate,
|
|
% this is untested.
|
|
fix_calls_in_goal_list(Goals0, Goals, !VarSet, !VarTypes,
|
|
TransformMap, ModuleInfo).
|
|
|
|
fix_calls_in_goal(disj(Goals0) - GoalInfo, disj(Goals) - GoalInfo,
|
|
!VarSet, !VarTypes, TransformMap, ModuleInfo) :-
|
|
fix_calls_in_goal_list(Goals0, Goals, !VarSet, !VarTypes,
|
|
TransformMap, ModuleInfo).
|
|
|
|
fix_calls_in_goal(switch(Var, CanFail, Cases0) - GoalInfo,
|
|
switch(Var, CanFail, Cases) - GoalInfo,
|
|
!VarSet, !VarTypes, TransformMap, ModuleInfo) :-
|
|
fix_calls_in_cases(Cases0, Cases, !VarSet, !VarTypes, TransformMap,
|
|
ModuleInfo).
|
|
|
|
fix_calls_in_goal(if_then_else(Vars, Cond0, Then0, Else0) - GoalInfo,
|
|
if_then_else(Vars, Cond, Then, Else) - GoalInfo,
|
|
!VarSet, !VarTypes, TransformMap, ModuleInfo) :-
|
|
fix_calls_in_goal(Cond0, Cond, !VarSet, !VarTypes, TransformMap,
|
|
ModuleInfo),
|
|
fix_calls_in_goal(Then0, Then, !VarSet, !VarTypes, TransformMap,
|
|
ModuleInfo),
|
|
fix_calls_in_goal(Else0, Else, !VarSet, !VarTypes, TransformMap,
|
|
ModuleInfo).
|
|
|
|
fix_calls_in_goal(shorthand(_) - _, _, !_, !_, _, _) :-
|
|
unexpected(this_file, "fix_calls_in_goal: unexpected shorthand").
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- 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_goal_list(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_goal_list([], [], !VarSet, !VarTypes, _, _).
|
|
fix_calls_in_goal_list([Goal0 | Goals0], [Goal | Goals], !VarSet, !VarTypes,
|
|
TransformMap, ModuleInfo) :-
|
|
fix_calls_in_goal(Goal0, Goal, !VarSet, !VarTypes,
|
|
TransformMap, ModuleInfo),
|
|
fix_calls_in_goal_list(Goals0, Goals, !VarSet, !VarTypes,
|
|
TransformMap, ModuleInfo).
|
|
|
|
:- pred fix_calls_in_cases(list(case)::in, list(case)::out, prog_varset::in,
|
|
prog_varset::out, vartypes::in, vartypes::out, transform_map::in,
|
|
module_info::in) is det.
|
|
|
|
fix_calls_in_cases([], [], !VarSet, !VarTypes, _, _).
|
|
fix_calls_in_cases([Case0 | Cases0], [Case | Cases], !VarSet, !VarTypes,
|
|
TransformMap, ModuleInfo) :-
|
|
Case0 = case(Functor, Goal0),
|
|
fix_calls_in_goal(Goal0, Goal, !VarSet, !VarTypes,
|
|
TransformMap, ModuleInfo),
|
|
Case = case(Functor, Goal),
|
|
fix_calls_in_cases(Cases0, Cases, !VarSet, !VarTypes,
|
|
TransformMap, ModuleInfo).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred expand_call_args(prog_vars::in, list(mer_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(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(mer_mode)::in, prog_vars::out,
|
|
hlds_goals::out, hlds_goals::out, prog_varset::in, prog_varset::out,
|
|
vartypes::in, vartypes::out, list(mer_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),
|
|
(
|
|
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_2(ReplacementArgs ++ Args0,
|
|
ReplacementModes ++ ArgModes,
|
|
Args, EnterUnifs1, ExitUnifs, !VarSet,
|
|
!VarTypes, ContainerTypes, TypeTable)
|
|
; ArgMode = out_mode ->
|
|
construct_functor(Arg0, ConsId, ReplacementArgs, Unif),
|
|
ExitUnifs = ExitUnifs1 ++ [Unif],
|
|
expand_call_args_2(ReplacementArgs ++ Args0,
|
|
ReplacementModes ++ ArgModes,
|
|
Args, EnterUnifs, ExitUnifs1, !VarSet,
|
|
!VarTypes, ContainerTypes, TypeTable)
|
|
;
|
|
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_2([], [_|_], _, _, _, !_, !_, _, _) :-
|
|
unexpected(this_file, "expand_call_args: length mismatch").
|
|
expand_call_args_2([_|_], [], _, _, _, !_, !_, _, _) :-
|
|
unexpected(this_file, "expand_call_args: length mismatch").
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- type expansion_result
|
|
---> expansion(
|
|
cons_id,
|
|
% the cons_id of the expanded constructor
|
|
list(mer_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 Expansion is unified with the
|
|
% `expansion' functor, giving the details of the expansion.
|
|
% Otherwise it is unified with `no_expansion'.
|
|
%
|
|
:- pred expand_argument(mer_mode::in, mer_type::in, list(mer_type)::in,
|
|
type_table::in, expansion_result::out) is det.
|
|
|
|
expand_argument(ArgMode, ArgType, ContainerTypes, TypeTable, Expansion) :-
|
|
( expandable_arg_mode(ArgMode) ->
|
|
expand_type(ArgType, ContainerTypes, TypeTable, Expansion)
|
|
;
|
|
Expansion = no_expansion
|
|
).
|
|
|
|
% This module so far only knows how to expand arguments which have
|
|
% the following modes.
|
|
%
|
|
:- pred expandable_arg_mode(mer_mode::in) is semidet.
|
|
|
|
expandable_arg_mode(in_mode).
|
|
expandable_arg_mode(out_mode).
|
|
|
|
:- pred expand_type(mer_type::in, list(mer_type)::in, type_table::in,
|
|
expansion_result::out) is det.
|
|
|
|
expand_type(Type, ContainerTypes, TypeTable, Expansion) :-
|
|
(
|
|
% Always expand tuple types.
|
|
type_to_ctor_and_args(Type, TypeCtor, TypeArgs),
|
|
type_ctor_is_tuple(TypeCtor)
|
|
->
|
|
Arity = list__length(TypeArgs),
|
|
ConsId = cons(unqualified("{}"), Arity),
|
|
Expansion = expansion(ConsId, TypeArgs)
|
|
;
|
|
% Expand a discriminated union type if it has only a
|
|
% single functor and the type has no parameters.
|
|
type_to_ctor_and_args(Type, TypeCtor, []),
|
|
map__search(TypeTable, TypeCtor, TypeDefn),
|
|
get_type_defn_tparams(TypeDefn, []),
|
|
get_type_defn_body(TypeDefn, TypeBody),
|
|
TypeBody ^ du_type_ctors = [SingleCtor],
|
|
SingleCtor ^ cons_exist = [],
|
|
SingleCtorName = SingleCtor ^ cons_name,
|
|
SingleCtorArgs = SingleCtor ^ cons_args,
|
|
SingleCtorArgs \= [],
|
|
% Prevent infinite loop with recursive types.
|
|
\+ list__member(Type, ContainerTypes)
|
|
->
|
|
Arity = list__length(SingleCtorArgs),
|
|
ConsId = cons(SingleCtorName, Arity),
|
|
ExpandedTypes = list__map(snd, SingleCtorArgs),
|
|
Expansion = expansion(ConsId, ExpandedTypes)
|
|
;
|
|
Expansion = no_expansion
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- func this_file = string.
|
|
|
|
this_file = "untupling.m".
|
|
|
|
%-----------------------------------------------------------------------------%
|