mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2026-04-15 09:23:44 +00:00
Code Issues Projects Releases Wiki Activity

Convert (C->T;E) to (if C then T else E).

Browse Source 
Avoid the use of semidet functions.
This commit is contained in:
Zoltan Somogyi
2015-10-18 06:57:19 +11:00
parent bd641cc5d7
commit a828e36796
6 changed files with 472 additions and 458 deletions
Download Patch File Download Diff File Expand all files Collapse all files

42
compiler/dependency_graph.m
View File

@@ -254,12 +254,12 @@ add_pred_nodes([PredId | PredIds], ModuleInfo, IncludeImported, !DepGraph) :-
map.lookup(PredTable, PredId, PredInfo),
% Don't bother adding nodes (or arcs) for predicates
% which are imported (i.e. which we don't have any `clauses' for).
(
( if
IncludeImported = do_not_include_imported,
pred_info_is_imported(PredInfo)
->
then
true
;
else
digraph.add_vertex(PredId, _, !DepGraph)
),
add_pred_nodes(PredIds, ModuleInfo, IncludeImported, !DepGraph).
@@ -326,12 +326,12 @@ add_pred_arcs([], _ModuleInfo, _, !DepGraph).
add_pred_arcs([PredId | PredIds], ModuleInfo, IncludeImported, !DepGraph) :-
module_info_get_preds(ModuleInfo, PredTable),
map.lookup(PredTable, PredId, PredInfo),
(
( if
IncludeImported = do_not_include_imported,
pred_info_is_imported(PredInfo)
->
then
true
;
else
pred_info_get_clauses_info(PredInfo, ClausesInfo),
clauses_info_get_clauses_rep(ClausesInfo, ClausesRep, _ItemNumbers),
get_clause_list_maybe_repeated(ClausesRep, Clauses),
@@ -375,15 +375,15 @@ add_dependency_arcs_in_goal(Caller, Goal, !DepGraph) :-
add_dependency_arcs_in_goal(Caller, SubGoal, !DepGraph)
;
GoalExpr = scope(Reason, SubGoal),
(
( if
Reason = from_ground_term(_, FGT),
( FGT = from_ground_term_construct
; FGT = from_ground_term_deconstruct
)
->
then
% The scope references no predicates or procedures.
true
;
else
add_dependency_arcs_in_goal(Caller, SubGoal, !DepGraph)
)
;
@@ -396,14 +396,14 @@ add_dependency_arcs_in_goal(Caller, Goal, !DepGraph) :-
( Builtin = out_of_line_builtin
; Builtin = not_builtin
),
(
( if
% If the node isn't in the graph, then we didn't insert it
% because is was imported, and we don't consider it.
digraph.search_key(!.DepGraph,
dependency_node(proc(PredId, ProcId)), Callee)
->
then
digraph.add_edge(Caller, Callee, !DepGraph)
;
else
true
)
)
@@ -476,13 +476,13 @@ add_dependency_arcs_in_cons(Caller, ConsId, !DepGraph) :-
(
ConsId = closure_cons(ShroudedPredProcId, _),
PredProcId = unshroud_pred_proc_id(ShroudedPredProcId),
(
( if
% If the node isn't in the graph, then we didn't insert it
% because it was imported, and we don't consider it.
digraph.search_key(!.DepGraph, dependency_node(PredProcId), Callee)
->
then
digraph.add_edge(Caller, Callee, !DepGraph)
;
else
true
)
;
@@ -688,10 +688,10 @@ get_called_scc_ids(SCCid, SCCRel, CalledSCCSet) :-
handle_higher_order_args([], _, _, _, _, !SCCRel, !NoMerge).
handle_higher_order_args([Arg | Args], IsAgg, SCCid, Map, PredSCC,
!SCCGraph, !NoMerge) :-
( multi_map.search(Map, Arg, PredProcIds) ->
( if multi_map.search(Map, Arg, PredProcIds) then
list.foldl2(handle_higher_order_arg(PredSCC, IsAgg, SCCid),
PredProcIds, !SCCGraph, !NoMerge)
;
else
true
),
handle_higher_order_args(Args, IsAgg, SCCid, Map, PredSCC,
@@ -704,7 +704,7 @@ handle_higher_order_args([Arg | Args], IsAgg, SCCid, Map, PredSCC,
handle_higher_order_arg(PredSCC, IsAgg, SCCid, PredProcId,
!SCCGraph, !NoMerge) :-
( map.search(PredSCC, PredProcId, CalledSCCid) ->
( if map.search(PredSCC, PredProcId, CalledSCCid) then
% Make sure anything called through an aggregate
% is not merged into the current sub-module.
(
@@ -713,12 +713,12 @@ handle_higher_order_arg(PredSCC, IsAgg, SCCid, PredProcId,
;
IsAgg = no
),
( CalledSCCid = SCCid ->
( if CalledSCCid = SCCid then
true
;
else
digraph.add_vertices_and_edge(SCCid, CalledSCCid, !SCCGraph)
)
;
else
true
).

45
compiler/du_type_layout.m
View File

@@ -79,7 +79,7 @@ layout_du_ctor_args(ModuleInfo, DuKind, Ctor0, Ctor) :-
)
),
globals.lookup_int_option(Globals, arg_pack_bits, ArgPackBits),
( ArgPackBits > 0 ->
( if ArgPackBits > 0 then
pack_du_ctor_args(ModuleInfo, ArgPackBits, 0, Args1, Args2, _),
WorthPacking = worth_arg_packing(Args1, Args2),
(
@@ -89,7 +89,7 @@ layout_du_ctor_args(ModuleInfo, DuKind, Ctor0, Ctor) :-
WorthPacking = no,
Args = Args1
)
;
else
Args = Args1
),
% The individual args may have changed, but the number of args
@@ -105,12 +105,12 @@ use_double_word_floats(Globals, DoubleWordFloats) :-
AllowDoubleWords = yes,
globals.lookup_int_option(Globals, bits_per_word, TargetWordBits),
globals.lookup_bool_option(Globals, single_prec_float, SinglePrec),
(
( if
TargetWordBits = 32,
SinglePrec = no
->
then
DoubleWordFloats = yes
;
else
DoubleWordFloats = no
)
;
@@ -124,10 +124,10 @@ use_double_word_floats(Globals, DoubleWordFloats) :-
set_double_word_floats(_ModuleInfo, [], []).
set_double_word_floats(ModuleInfo, [Arg0 | Args0], [Arg | Args]) :-
Arg0 = ctor_arg(Name, Type, _, Context),
( type_is_float_eqv(ModuleInfo, Type) ->
( if type_is_float_eqv(ModuleInfo, Type) then
ArgWidth = double_word,
Arg = ctor_arg(Name, Type, ArgWidth, Context)
;
else
Arg = Arg0
),
set_double_word_floats(ModuleInfo, Args0, Args).
@@ -140,17 +140,17 @@ pack_du_ctor_args(_ModuleInfo, _TargetWordBits, _Shift, [], [], full_word).
pack_du_ctor_args(ModuleInfo, TargetWordBits, Shift,
[Arg0 | Args0], [Arg | Args], ArgWidth) :-
Arg0 = ctor_arg(Name, Type, ArgWidth0, Context),
( type_is_enum_bits(ModuleInfo, Type, NumBits) ->
( if type_is_enum_bits(ModuleInfo, Type, NumBits) then
Mask = int.pow(2, NumBits) - 1,
% Try to place the argument in the current word, otherwise move on to
% the next word.
( Shift + NumBits > TargetWordBits ->
( if Shift + NumBits > TargetWordBits then
ArgWidth1 = partial_word_first(Mask),
NextShift = NumBits
; Shift = 0 ->
else if Shift = 0 then
ArgWidth1 = partial_word_first(Mask),
NextShift = NumBits
;
else
ArgWidth1 = partial_word_shifted(Shift, Mask),
NextShift = Shift + NumBits
),
@@ -158,16 +158,16 @@ pack_du_ctor_args(ModuleInfo, TargetWordBits, Shift,
NextArgWidth),
% If this argument starts a word but the next argument is not packed
% with it, then this argument is not packed.
(
( if
ArgWidth1 = partial_word_first(_),
NextArgWidth \= partial_word_shifted(_, _)
->
then
ArgWidth = full_word
;
else
ArgWidth = ArgWidth1
),
Arg = ctor_arg(Name, Type, ArgWidth, Context)
;
else
Arg = Arg0,
ArgWidth = ArgWidth0,
NextShift = 0,
@@ -197,9 +197,9 @@ cons_tags_bits(ConsTagValues) = NumBits :-
:- pred max_int_tag(cons_tag::in, int::in, int::out) is det.
max_int_tag(ConsTag, !Max) :-
( ConsTag = int_tag(Int) ->
( if ConsTag = int_tag(Int) then
int.max(Int, !Max)
;
else
unexpected($module, $pred, "non-integer value for enumeration")
).
@@ -213,9 +213,9 @@ worth_arg_packing(UnpackedArgs, PackedArgs) = Worthwhile :-
% Boehm GC will round up allocations (at least) to the next even number
% of words. There is no point saving a single word if that word will be
% allocated anyway.
( round_to_even(PackedLength) < round_to_even(UnpackedLength) ->
( if round_to_even(PackedLength) < round_to_even(UnpackedLength) then
Worthwhile = yes
;
else
Worthwhile = no
).
@@ -240,7 +240,12 @@ count_words([Arg | Args], !Count) :-
:- func round_to_even(int) = int.
round_to_even(I) = (int.even(I) -> I ; I + 1).
round_to_even(I) = E :-
( if int.even(I) then
E = I
else
E = I + 1
).
%-----------------------------------------------------------------------------%
:- end_module hlds.make_hlds.make_hlds_passes.du_type_layout.

354
compiler/higher_order.m
View File

File diff suppressed because it is too large Load Diff

12
compiler/implementation_defined_literals.m
View File

@@ -210,22 +210,22 @@ subst_literals_in_case(Info, Case0, Case) :-
make_impl_defined_literal(Var, Name, Context, Info, Goal) :-
Context = term.context(File, Line),
Info = subst_literals_info(ModuleInfo, PredInfo, PredId),
( Name = "file" ->
( if Name = "file" then
make_string_const_construction(Var, File, Goal)
; Name = "line" ->
else if Name = "line" then
make_int_const_construction(Var, Line, Goal)
; Name = "module" ->
else if Name = "module" then
ModuleName = pred_info_module(PredInfo),
Str = sym_name_to_string(ModuleName),
make_string_const_construction(Var, Str, Goal)
; Name = "pred" ->
else if Name = "pred" then
Str = pred_id_to_string(ModuleInfo, PredId),
make_string_const_construction(Var, Str, Goal)
; Name = "grade" ->
else if Name = "grade" then
module_info_get_globals(ModuleInfo, Globals),
grade_directory_component(Globals, Grade),
make_string_const_construction(Var, Grade, Goal)
;
else
% These should have been caught during type checking.
unexpected($module, $pred, "unknown literal")
).

84
compiler/inlining.m
View File

@@ -219,13 +219,13 @@ inlining(!ModuleInfo) :-
% Get the usage counts for predicates (but only if needed, i.e. only if
% --inline-single-use or --inline-compound-threshold has been specified).
(
( if
( SingleUse = yes
; CompoundThreshold > 0
)
->
then
dead_proc_analyze(!.ModuleInfo, NeededMap)
;
else
map.init(NeededMap)
),
@@ -267,7 +267,7 @@ do_inlining([PPId | PPIds], Needed, Params, !.Inlined, !Module) :-
set(pred_proc_id)::in, set(pred_proc_id)::out) is det.
mark_predproc(PredProcId, NeededMap, Params, ModuleInfo, !InlinedProcs) :-
(
( if
Simple = Params ^ simple,
SingleUse = Params ^ single_use,
CallCost = Params ^ call_cost,
@@ -301,10 +301,10 @@ mark_predproc(PredProcId, NeededMap, Params, ModuleInfo, !InlinedProcs) :-
NumUses = 1
),
% Don't inline recursive predicates (unless explicitly requested).
\+ goal_calls(CalledGoal, PredProcId)
->
not goal_calls(CalledGoal, PredProcId)
then
mark_proc_as_inlined(PredProcId, ModuleInfo, !InlinedProcs)
;
else
true
).
@@ -350,15 +350,15 @@ is_flat_simple_goal(hlds_goal(GoalExpr, _)) :-
is_flat_simple_goal(Goal)
;
GoalExpr = scope(Reason, Goal),
(
( if
Reason = from_ground_term(_, FGT),
( FGT = from_ground_term_construct
; FGT = from_ground_term_deconstruct
)
->
then
% These scopes are flat and simple by construction.
true
;
else
is_flat_simple_goal(Goal)
)
;
@@ -380,9 +380,9 @@ is_flat_simple_goal_list([Goal | Goals]) :-
mark_proc_as_inlined(proc(PredId, ProcId), ModuleInfo, !InlinedProcs) :-
set.insert(proc(PredId, ProcId), !InlinedProcs),
module_info_pred_info(ModuleInfo, PredId, PredInfo),
( pred_info_requested_inlining(PredInfo) ->
( if pred_info_requested_inlining(PredInfo) then
true
;
else
trace [io(!IO)] (
write_proc_progress_message("% Inlining ", PredId, ProcId,
ModuleInfo, !IO)
@@ -603,16 +603,16 @@ inlining_in_goal(Goal0, Goal, !Info) :-
GoalInfo = GoalInfo0
;
GoalExpr0 = scope(Reason, SubGoal0),
(
( if
Reason = from_ground_term(_, FGT),
( FGT = from_ground_term_construct
; FGT = from_ground_term_deconstruct
)
->
then
% The scope has no calls to inline.
GoalExpr = GoalExpr0,
GoalInfo = GoalInfo0
;
else
inlining_in_goal(SubGoal0, SubGoal, !Info),
GoalExpr = scope(Reason, SubGoal),
GoalInfo = GoalInfo0
@@ -639,7 +639,7 @@ inlining_in_call(PredId, ProcId, ArgVars, Builtin,
module_info_pred_proc_info(ModuleInfo, PredId, ProcId, PredInfo, ProcInfo),
% Should we inline this call?
(
( if
should_inline_proc(PredId, ProcId, Builtin, HighLevelCode,
AnyTracing, InlinedProcs, Markers, ModuleInfo, UserReq),
(
@@ -659,7 +659,7 @@ inlining_in_call(PredId, ProcId, ArgVars, Builtin,
),
% XXX Work around bug #142.
not may_encounter_bug_142(ProcInfo, ArgVars)
->
then
do_inline_call(HeadTypeParams, ArgVars, PredInfo, ProcInfo,
VarSet0, VarSet, VarTypes0, VarTypes, TypeVarSet0, TypeVarSet,
RttiVarMaps0, RttiVarMaps, hlds_goal(GoalExpr, GoalInfo)),
@@ -667,15 +667,17 @@ inlining_in_call(PredId, ProcId, ArgVars, Builtin,
% If some of the output variables are not used in the calling
% procedure, requantify the procedure.
NonLocals = goal_info_get_nonlocals(GoalInfo0),
( set_of_var.list_to_set(ArgVars) = NonLocals ->
( if set_of_var.list_to_set(ArgVars) = NonLocals then
Requantify = Requantify0
;
else
Requantify = yes
),
( goal_info_get_purity(GoalInfo0) = goal_info_get_purity(GoalInfo) ->
( if
goal_info_get_purity(GoalInfo0) = goal_info_get_purity(GoalInfo)
then
PurityChanged = PurityChanged0
;
else
PurityChanged = yes
),
@@ -684,9 +686,9 @@ inlining_in_call(PredId, ProcId, ArgVars, Builtin,
% on this proc.
Determinism0 = goal_info_get_determinism(GoalInfo0),
Determinism = goal_info_get_determinism(GoalInfo),
( Determinism0 = Determinism ->
( if Determinism0 = Determinism then
DetChanged = DetChanged0
;
else
DetChanged = yes
),
@@ -705,7 +707,7 @@ inlining_in_call(PredId, ProcId, ArgVars, Builtin,
InlinedProcs, ModuleInfo, HeadTypeParams, Markers,
VarSet, VarTypes, TypeVarSet, RttiVarMaps, DidInlining,
InlinedParallel, Requantify, DetChanged, PurityChanged)
;
else
GoalExpr = plain_call(PredId, ProcId, ArgVars, Builtin, Context, Sym),
GoalInfo = GoalInfo0
).
@@ -823,9 +825,9 @@ get_type_substitution(HeadTypes, ArgTypes,
HeadTypeParams, CalleeExistQVars, TypeSubn) :-
(
CalleeExistQVars = [],
( type_list_subsumes(HeadTypes, ArgTypes, TypeSubn0) ->
( if type_list_subsumes(HeadTypes, ArgTypes, TypeSubn0) then
TypeSubn = TypeSubn0
;
else
% The head types should always be unifiable with the actual
% argument types, otherwise it is a type error that should have
% been detected by typechecking. But polymorphism.m introduces
@@ -841,13 +843,13 @@ get_type_substitution(HeadTypes, ArgTypes,
CalleeExistQVars = [_ | _],
% For calls to existentially type preds, we may need to bind
% type variables in the caller, not just those in the callee.
(
( if
map.init(TypeSubn0),
type_unify_list(HeadTypes, ArgTypes, HeadTypeParams,
TypeSubn0, TypeSubn1)
->
then
TypeSubn = TypeSubn1
;
else
unexpected($module, $pred, "type unification failed")
)
).
@@ -934,15 +936,17 @@ should_inline_proc(PredId, ProcId, BuiltinState, HighLevelCode,
% OK, we could inline it - but should we? Apply our heuristic.
module_info_pred_info(ModuleInfo, PredId, PredInfo),
pred_info_get_markers(PredInfo, Markers),
( check_marker(Markers, marker_user_marked_inline) ->
( if
check_marker(Markers, marker_user_marked_inline)
then
UserReq = yes
;
else if
( check_marker(Markers, marker_heuristic_inline)
; set.member(proc(PredId, ProcId), InlinedProcs)
)
->
then
UserReq = no
;
else
fail
).
@@ -965,11 +969,11 @@ can_inline_proc_2(PredId, ProcId, BuiltinState, HighLevelCode,
% Don't try to inline imported predicates, since we don't
% have the code for them.
\+ pred_info_is_imported(PredInfo),
not pred_info_is_imported(PredInfo),
% This next line catches the case of locally defined unification predicates
% for imported types.
\+ (
not (
pred_info_is_pseudo_imported(PredInfo),
hlds_pred.in_in_unification_proc_id(ProcId)
),
@@ -981,7 +985,7 @@ can_inline_proc_2(PredId, ProcId, BuiltinState, HighLevelCode,
proc_info_get_eval_method(ProcInfo, eval_normal),
% Don't inline anything we have been specifically requested not to inline.
\+ pred_info_requested_no_inlining(PredInfo),
not pred_info_requested_no_inlining(PredInfo),
% Don't inline any procedure whose complexity we are trying to determine,
% since the complexity transformation can't transform *part* of a
@@ -1000,7 +1004,7 @@ can_inline_proc_2(PredId, ProcId, BuiltinState, HighLevelCode,
% For the LLDS back-end, under no circumstances inline model_non
% foreign_procs. The resulting code would not work properly.
proc_info_get_goal(ProcInfo, CalledGoal),
\+ (
not (
HighLevelCode = no,
CalledGoal = hlds_goal(call_foreign_proc(_, _, _, _, _, _, _), _),
proc_info_interface_determinism(ProcInfo, Detism),
@@ -1009,10 +1013,10 @@ can_inline_proc_2(PredId, ProcId, BuiltinState, HighLevelCode,
module_info_get_globals(ModuleInfo, Globals),
globals.get_target(Globals, Target),
(
( if
CalledGoal = hlds_goal(call_foreign_proc(ForeignAttributes,
_, _, _, _, _, _), _)
->
then
% Only inline a foreign_proc if it is appropriate for the target
% language.
(
@@ -1032,7 +1036,7 @@ can_inline_proc_2(PredId, ProcId, BuiltinState, HighLevelCode,
MaybeMayDuplicate = yes(proc_may_duplicate)
)
)
;
else
true
),

393
compiler/loop_inv.m
View File

@@ -146,7 +146,7 @@
%-----------------------------------------------------------------------------%
hoist_loop_invariants(PredProcId, PredInfo, !ProcInfo, !ModuleInfo) :-
(
( if
% We only want to apply this optimization to pure preds (e.g.
% not benchmark_det_loop).
@@ -178,7 +178,7 @@ hoist_loop_invariants(PredProcId, PredInfo, !ProcInfo, !ModuleInfo) :-
% We can calculate the set of invariant args from the set of
% recursive calls.
InvArgs0 = inv_args(!.ModuleInfo, HeadVars, HeadVarModes, RecCalls),
InvArgs = InvArgs0 `delete_elems` UniquelyUsedVars,
list.delete_elems(InvArgs0, UniquelyUsedVars, InvArgs),
% Given the invariant args, we can calculate the set of
% invariant goals and vars.
@@ -216,7 +216,7 @@ hoist_loop_invariants(PredProcId, PredInfo, !ProcInfo, !ModuleInfo) :-
% - all of the InvVars are either head vars or constructed by one of
% the InvGoals;
% - all non-local vars in InvGoals are also in InvVars.
->
then
% The set of computed invariant vars is the difference between
% the whole invariant var set and the set of invariant args.
%
@@ -237,21 +237,21 @@ hoist_loop_invariants(PredProcId, PredInfo, !ProcInfo, !ModuleInfo) :-
% in proc with the head vars extended with the list of computed
% inv vars. The body is adjusted appropriately in the next step.
create_aux_pred(PredProcId, HeadVars, ComputedInvVars,
InitialAuxInstMap, AuxPredProcId, CallAux,
InitialAuxInstMap, AuxPredProcId, Replacement,
AuxPredInfo, AuxProcInfo, !ModuleInfo),
% We update the body of AuxProc by replacing adding the set of
% computed invariant vars to the argument list, replacing invariant
% goals in InProc with `true', and recursive calls at the end of
% recursive paths with calls to the auxiliary procedure.
gen_aux_proc(InvGoals, PredProcId, AuxPredProcId, CallAux, Body,
gen_aux_proc(InvGoals, PredProcId, AuxPredProcId, Replacement, Body,
AuxPredInfo, AuxProcInfo, !ModuleInfo),
% We construct OutProc by replacing recursive calls to the InProc
% at the end of recursive paths with calls to the auxiliary procedure.
gen_out_proc(PredProcId, PredInfo, !ProcInfo, CallAux, Body,
gen_out_proc(PredProcId, PredInfo, !ProcInfo, Replacement, Body,
!ModuleInfo)
;
else
true
).
@@ -286,7 +286,7 @@ hoist_loop_invariants(PredProcId, PredInfo, !ProcInfo, !ModuleInfo) :-
% in Body identified via PredProcId.
%
:- pred invariant_goal_candidates_in_proc(module_info::in, pred_proc_id::in,
hlds_goal::in, hlds_goals::out, hlds_goals::out) is det.
hlds_goal::in, list(hlds_goal)::out, list(hlds_goal)::out) is det.
invariant_goal_candidates_in_proc(ModuleInfo, PredProcId, Body,
CandidateInvGoals, RecCallGoals) :-
@@ -306,9 +306,9 @@ invariant_goal_candidates_in_goal(PPId, Goal, !IGCs) :-
Goal = hlds_goal(GoalExpr, _GoalInfo),
(
GoalExpr = plain_call(PredId, ProcId, _, _, _, _),
( proc(PredId, ProcId) = PPId ->
( if proc(PredId, ProcId) = PPId then
add_recursive_call(Goal, !IGCs)
;
else
invariant_goal_candidates_handle_primitive_goal(Goal, !IGCs)
)
;
@@ -418,7 +418,7 @@ add_recursive_call(Goal, !IGCs) :-
invariant_goal_candidates_handle_primitive_goal(Goal, !IGCs) :-
Goal = hlds_goal(_GoalExpr, GoalInfo),
(
( if
Detism = hlds_goal.goal_info_get_determinism(GoalInfo),
code_model.determinism_to_code_model(Detism, CodeModel),
( CodeModel = model_det
@@ -431,10 +431,10 @@ invariant_goal_candidates_handle_primitive_goal(Goal, !IGCs) :-
instmap_delta_to_assoc_list(InstMapDelta, InstMapDeltaPairs),
ModuleInfo = !.IGCs ^ igc_module_info,
all_instmap_deltas_are_ground(ModuleInfo, InstMapDeltaPairs)
->
then
!IGCs ^ igc_path_candidates :=
snoc(!.IGCs ^ igc_path_candidates, Goal)
;
else
true
).
@@ -450,7 +450,7 @@ all_instmap_deltas_are_ground(ModuleInfo, [_Var - Inst | VarInsts]) :-
%-----------------------------------------------------------------------------%
:- func intersect_candidate_inv_goals(list(hlds_goals)) = hlds_goals.
:- func intersect_candidate_inv_goals(list(list(hlds_goal))) = list(hlds_goal).
intersect_candidate_inv_goals([]) = [].
intersect_candidate_inv_goals([Goals | Goalss]) =
@@ -458,14 +458,14 @@ intersect_candidate_inv_goals([Goals | Goalss]) =
%-----------------------------------------------------------------------------%
:- pred common_goal(list(hlds_goals)::in, hlds_goal::in) is semidet.
:- pred common_goal(list(list(hlds_goal))::in, hlds_goal::in) is semidet.
common_goal(Goalss, Goal) :-
all [Gs] (
list.member(Gs, Goalss)
=>
(
list.member(G, Gs),
list.member(G, Gs),
equivalent_goals(G, Goal)
)
).
@@ -486,28 +486,27 @@ equivalent_goals(hlds_goal(GoalExprX, _), hlds_goal(GoalExprY, _)) :-
%-----------------------------------------------------------------------------%
:- func inv_args(module_info, prog_vars, list(mer_mode), hlds_goals)
= prog_vars.
:- func inv_args(module_info, list(prog_var), list(mer_mode), list(hlds_goal))
= list(prog_var).
inv_args(ModuleInfo, HeadVars, HeadVarModes, RecCalls) = InvArgs :-
MaybeInvArgs0 =
list.map_corresponding(arg_to_maybe_inv_arg(ModuleInfo),
HeadVars, HeadVarModes),
MaybeInvArgs =
MaybeInvArgs =
list.foldl(refine_candidate_inv_args, RecCalls, MaybeInvArgs0),
InvArgs =
list.filter_map(func(yes(Arg)) = Arg is semidet, MaybeInvArgs).
list.filter_map(maybe_is_yes, MaybeInvArgs, InvArgs).
%-----------------------------------------------------------------------------%
% Maps an Arg in HeadVars to yes(Arg) if Arg is an input
% or to no otherwise.
% Maps an Arg in HeadVars to `yes(Arg)' if Arg is an input,
% and to `no' otherwise.
%
:- func arg_to_maybe_inv_arg(module_info, prog_var, mer_mode)
= maybe(prog_var).
arg_to_maybe_inv_arg(ModuleInfo, Arg, Mode) =
( if input_arg(ModuleInfo, Arg, Mode) = InvArg then yes(InvArg) else no ).
( if input_arg(ModuleInfo, Arg, Mode, InvArg) then yes(InvArg) else no ).
%-----------------------------------------------------------------------------%
@@ -515,17 +514,17 @@ arg_to_maybe_inv_arg(ModuleInfo, Arg, Mode) =
list(maybe(prog_var)).
refine_candidate_inv_args(hlds_goal(RecCall, _RecCallInfo), MaybeInvArgs) =
( RecCall = plain_call(_, _, CallArgs, _, _, _) ->
( if RecCall = plain_call(_, _, CallArgs, _, _, _) then
list.map_corresponding(refine_candidate_inv_args_2,
MaybeInvArgs, CallArgs)
;
else
unexpected($module, $pred, "non call/6 found in argument 1")
).
:- func refine_candidate_inv_args_2(maybe(prog_var), prog_var) =
maybe(prog_var).
refine_candidate_inv_args_2(no, _) = no.
refine_candidate_inv_args_2(no, _) = no.
refine_candidate_inv_args_2(yes(X), Y) = ( if X = Y then yes(X) else no ).
%-----------------------------------------------------------------------------%
@@ -545,39 +544,37 @@ refine_candidate_inv_args_2(yes(X), Y) = ( if X = Y then yes(X) else no ).
% used as unique inputs since the user may clobber the variable
% in question.
%
:- pred inv_goals_vars(module_info::in, prog_vars::in,
hlds_goals::in, hlds_goals::out, prog_vars::in, prog_vars::out) is det.
:- pred inv_goals_vars(module_info::in, list(prog_var)::in,
list(hlds_goal)::in, list(hlds_goal)::out,
list(prog_var)::in, list(prog_var)::out) is det.
inv_goals_vars(ModuleInfo, UniquelyUsedVars,
InvGoals0, InvGoals, InvVars0, InvVars) :-
list.foldl2(
inv_goals_vars_2(ModuleInfo, UniquelyUsedVars),
InvGoals0,
[], InvGoals,
InvVars0, InvVars
).
list.foldl2(inv_goals_vars_2(ModuleInfo, UniquelyUsedVars),
InvGoals0, [], InvGoals, InvVars0,InvVars).
%-----------------------------------------------------------------------------%
:- pred inv_goals_vars_2(module_info::in, prog_vars::in, hlds_goal::in,
hlds_goals::in, hlds_goals::out, prog_vars::in, prog_vars::out) is det.
:- pred inv_goals_vars_2(module_info::in, list(prog_var)::in, hlds_goal::in,
list(hlds_goal)::in, list(hlds_goal)::out,
list(prog_var)::in, list(prog_var)::out) is det.
inv_goals_vars_2(ModuleInfo, UUVs, Goal, IGs0, IGs, IVs0, IVs) :-
(
( if
not invariant_goal(IGs0, Goal),
not has_uniquely_used_arg(UUVs, Goal),
input_args_are_invariant(ModuleInfo, Goal, IVs0)
->
then
IGs = [Goal | IGs0],
add_outputs(ModuleInfo, UUVs, Goal, IVs0, IVs)
;
else
IGs = IGs0,
IVs = IVs0
).
%-----------------------------------------------------------------------------%
:- pred has_uniquely_used_arg(prog_vars::in, hlds_goal::in) is semidet.
:- pred has_uniquely_used_arg(list(prog_var)::in, hlds_goal::in) is semidet.
has_uniquely_used_arg(UUVs, hlds_goal(_GoalExpr, GoalInfo)) :-
NonLocals = goal_info_get_nonlocals(GoalInfo),
@@ -586,7 +583,7 @@ has_uniquely_used_arg(UUVs, hlds_goal(_GoalExpr, GoalInfo)) :-
%-----------------------------------------------------------------------------%
:- pred invariant_goal(hlds_goals::in, hlds_goal::in) is semidet.
:- pred invariant_goal(list(hlds_goal)::in, hlds_goal::in) is semidet.
invariant_goal(InvariantGoals, Goal) :-
list.member(InvariantGoal, InvariantGoals),
@@ -594,8 +591,8 @@ invariant_goal(InvariantGoals, Goal) :-
%-----------------------------------------------------------------------------%
:- pred input_args_are_invariant(module_info::in, hlds_goal::in, prog_vars::in)
is semidet.
:- pred input_args_are_invariant(module_info::in, hlds_goal::in,
list(prog_var)::in) is semidet.
input_args_are_invariant(ModuleInfo, Goal, InvVars) :-
Inputs = goal_inputs(ModuleInfo, Goal),
@@ -607,28 +604,29 @@ input_args_are_invariant(ModuleInfo, Goal, InvVars) :-
%-----------------------------------------------------------------------------%
:- pred do_not_hoist(module_info::in, hlds_goals::in,
hlds_goals::out, prog_vars::out) is det.
:- pred do_not_hoist(module_info::in,
list(hlds_goal)::in, list(hlds_goal)::out, list(prog_var)::out) is det.
do_not_hoist(ModuleInfo, InvGoals, DontHoistGoals, DontHoistVars) :-
list.foldl2(do_not_hoist_2(ModuleInfo), InvGoals,
[], DontHoistGoals, [], DontHoistVars).
:- pred do_not_hoist_2(module_info::in, hlds_goal::in,
hlds_goals::in, hlds_goals::out, prog_vars::in, prog_vars::out) is det.
list(hlds_goal)::in, list(hlds_goal)::out,
list(prog_var)::in, list(prog_var)::out) is det.
do_not_hoist_2(ModuleInfo, Goal, !DHGs, !DHVs) :-
(
( if
( const_construction(Goal)
; deconstruction(Goal)
; impure_goal(Goal)
; cannot_succeed(Goal)
; call_has_inst_any(ModuleInfo, Goal)
)
->
then
list.cons(Goal, !DHGs),
add_outputs(ModuleInfo, [], Goal, !DHVs)
;
else
true
).
@@ -643,7 +641,7 @@ do_not_hoist_2(ModuleInfo, Goal, !DHGs, !DHVs) :-
const_construction(hlds_goal(GoalExpr, _GoalInfo)) :-
Construction = GoalExpr ^ unify_kind,
( Construction ^ construct_args = []
; Construction ^ construct_how = construct_statically
; Construction ^ construct_how = construct_statically
).
%-----------------------------------------------------------------------------%
@@ -718,28 +716,28 @@ inst_is_input({ModuleInfo, _InstMap}, Inst) :-
%-----------------------------------------------------------------------------%
:- pred add_outputs(module_info::in, prog_vars::in, hlds_goal::in,
prog_vars::in, prog_vars::out) is det.
:- pred add_outputs(module_info::in, list(prog_var)::in, hlds_goal::in,
list(prog_var)::in, list(prog_var)::out) is det.
add_outputs(ModuleInfo, UUVs, Goal, !InvVars) :-
list.foldl(add_output(UUVs), goal_outputs(ModuleInfo, Goal), !InvVars).
:- pred add_output(prog_vars::in, prog_var::in,
prog_vars::in, prog_vars::out) is det.
:- pred add_output(list(prog_var)::in, prog_var::in,
list(prog_var)::in, list(prog_var)::out) is det.
add_output(UniquelyUsedVars, X, !InvVars) :-
(
( if
not list.member(X, !.InvVars),
not list.member(X, UniquelyUsedVars)
->
then
!:InvVars = [X | !.InvVars]
;
else
true
).
%-----------------------------------------------------------------------------%
:- func compute_initial_aux_instmap(hlds_goals, instmap) = instmap.
:- func compute_initial_aux_instmap(list(hlds_goal), instmap) = instmap.
compute_initial_aux_instmap(Gs, IM) = list.foldl(ApplyGoalInstMap, Gs, IM) :-
ApplyGoalInstMap =
@@ -750,12 +748,13 @@ compute_initial_aux_instmap(Gs, IM) = list.foldl(ApplyGoalInstMap, Gs, IM) :-
%-----------------------------------------------------------------------------%
:- pred create_aux_pred(pred_proc_id::in, prog_vars::in, prog_vars::in,
instmap::in, pred_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_proc_id::in,
list(prog_var)::in, list(prog_var)::in, instmap::in, pred_proc_id::out,
hlds_goal::out, pred_info::out, proc_info::out,
module_info::in, module_info::out) is det.
create_aux_pred(PredProcId, HeadVars, ComputedInvArgs,
InitialAuxInstMap, AuxPredProcId, CallAux,
InitialAuxInstMap, AuxPredProcId, Replacement,
AuxPredInfo, AuxProcInfo, ModuleInfo0, ModuleInfo) :-
PredProcId = proc(PredId, ProcId),
@@ -781,11 +780,11 @@ create_aux_pred(PredProcId, HeadVars, ComputedInvArgs,
PredOrFunc = pred_info_is_pred_or_func(PredInfo),
Context = goal_info_get_context(GoalInfo),
term.context_line(Context, Line),
( Line = 0 ->
( if Line = 0 then
% Use the predicate number to distinguish between similarly named
% generated predicates, e.g. special predicates.
Counter = pred_id_to_int(PredId)
;
else
Counter = 1
),
make_pred_name_with_context(PredModule, "loop_inv",
@@ -799,7 +798,7 @@ create_aux_pred(PredProcId, HeadVars, ComputedInvArgs,
hlds_pred.define_new_pred(
Origin, % in - The origin of this new predicate
Goal, % in - The goal for the new aux proc.
CallAux, % out - How we can call the new aux proc.
Replacement, % out - How we can call the new aux proc.
AuxHeadVars, % in - The args for the new aux proc.
_ExtraArgs, % out - Extra args prepended to Args for typeinfo
% liveness purposes.
@@ -822,7 +821,7 @@ create_aux_pred(PredProcId, HeadVars, ComputedInvArgs,
AuxPredProcId % out - The pred_proc_id for the new aux proc.
),
% Note on CallAux:
% Note on Replacement:
% - we change the call args as necessary in gen_aux_call;
% - we handle the changes to nonlocals by requantifying
% over the entire goal after we've transformed it.
@@ -836,23 +835,24 @@ create_aux_pred(PredProcId, HeadVars, ComputedInvArgs,
:- type gen_aux_proc_info
---> gen_aux_proc_info(
gapi_module_info :: module_info,
gapi_inv_goals :: hlds_goals,
gapi_inv_goals :: list(hlds_goal),
gapi_pred_proc_id :: pred_proc_id,
gapi_call_aux_goal :: hlds_goal
gapi_replament_goal :: hlds_goal
).
% Replace the invariant goals in the original Body
% with just `true' in the new AuxBody.
%
:- pred gen_aux_proc(hlds_goals::in, pred_proc_id::in, pred_proc_id::in,
:- pred gen_aux_proc(list(hlds_goal)::in, pred_proc_id::in, pred_proc_id::in,
hlds_goal::in, hlds_goal::in, pred_info::in, proc_info::in,
module_info::in, module_info::out) is det.
gen_aux_proc(InvGoals, PredProcId, AuxPredProcId, CallAux, Body,
gen_aux_proc(InvGoals, PredProcId, AuxPredProcId, Replacement, Body,
AuxPredInfo, !.AuxProcInfo, !ModuleInfo) :-
% Compute the aux proc body.
GapInfo = gen_aux_proc_info(!.ModuleInfo, InvGoals, PredProcId, CallAux),
AuxBody = gen_aux_proc_goal(GapInfo, Body),
GapInfo = gen_aux_proc_info(!.ModuleInfo, InvGoals, PredProcId,
Replacement),
gen_aux_proc_goal(GapInfo, Body, AuxBody),
% Put the new proc body and instmap into the module_info.
AuxPredProcId = proc(AuxPredId, AuxProcId),
@@ -867,55 +867,56 @@ gen_aux_proc(InvGoals, PredProcId, AuxPredProcId, CallAux, Body,
%-----------------------------------------------------------------------------%
:- func gen_aux_proc_goal(gen_aux_proc_info, hlds_goal) = hlds_goal.
:- pred gen_aux_proc_goal(gen_aux_proc_info::in, hlds_goal::in, hlds_goal::out)
is det.
gen_aux_proc_goal(Info, Goal) = AuxGoal :-
gen_aux_proc_goal(Info, Goal, AuxGoal) :-
Goal = hlds_goal(GoalExpr, GoalInfo),
(
GoalExpr = plain_call(PredId, ProcId, _,_,_,_),
( proc(PredId, ProcId) = Info ^ gapi_pred_proc_id ->
AuxGoal = gen_aux_call(Info ^ gapi_call_aux_goal, Goal)
;
AuxGoal = gen_aux_proc_handle_non_recursive_call(Info, Goal)
( if proc(PredId, ProcId) = Info ^ gapi_pred_proc_id then
gen_aux_call(Info ^ gapi_replament_goal, Goal, AuxGoal)
else
gen_aux_proc_handle_non_recursive_call(Info, Goal, AuxGoal)
)
;
( GoalExpr = generic_call(_, _, _, _, _)
; GoalExpr = unify(_, _, _, _, _)
; GoalExpr = call_foreign_proc(_, _, _, _, _, _, _)
),
AuxGoal = gen_aux_proc_handle_non_recursive_call(Info, Goal)
gen_aux_proc_handle_non_recursive_call(Info, Goal, AuxGoal)
;
GoalExpr = conj(ConjType, Conjuncts),
AuxConjuncts = list.map(gen_aux_proc_goal(Info), Conjuncts),
list.map(gen_aux_proc_goal(Info), Conjuncts, AuxConjuncts),
AuxGoalExpr = conj(ConjType, AuxConjuncts),
AuxGoal = hlds_goal(AuxGoalExpr, GoalInfo)
;
GoalExpr = disj(Disjuncts),
AuxDisjuncts = list.map(gen_aux_proc_goal(Info), Disjuncts),
list.map(gen_aux_proc_goal(Info), Disjuncts, AuxDisjuncts),
AuxGoalExpr = disj(AuxDisjuncts),
AuxGoal = hlds_goal(AuxGoalExpr, GoalInfo)
;
GoalExpr = switch(Var, CanFail, Cases),
AuxCases = list.map(gen_aux_proc_case(Info), Cases),
list.map(gen_aux_proc_case(Info), Cases, AuxCases),
AuxGoalExpr = switch(Var, CanFail, AuxCases),
AuxGoal = hlds_goal(AuxGoalExpr, GoalInfo)
;
GoalExpr = negation(SubGoal),
AuxSubGoal = gen_aux_proc_goal(Info, SubGoal),
gen_aux_proc_goal(Info, SubGoal, AuxSubGoal),
AuxGoalExpr = negation(AuxSubGoal),
AuxGoal = hlds_goal(AuxGoalExpr, GoalInfo)
;
GoalExpr = scope(Reason, SubGoal),
% XXX We should consider special casing the handling of
% from_ground_term_construct scopes.
AuxSubGoal = gen_aux_proc_goal(Info, SubGoal),
gen_aux_proc_goal(Info, SubGoal, AuxSubGoal),
AuxGoalExpr = scope(Reason, AuxSubGoal),
AuxGoal = hlds_goal(AuxGoalExpr, GoalInfo)
;
GoalExpr = if_then_else(Vars, Cond, Then, Else),
AuxCond = gen_aux_proc_goal(Info, Cond),
AuxThen = gen_aux_proc_goal(Info, Then),
AuxElse = gen_aux_proc_goal(Info, Else),
gen_aux_proc_goal(Info, Cond, AuxCond),
gen_aux_proc_goal(Info, Then, AuxThen),
gen_aux_proc_goal(Info, Else, AuxElse),
AuxGoalExpr = if_then_else(Vars, AuxCond, AuxThen, AuxElse),
AuxGoal = hlds_goal(AuxGoalExpr, GoalInfo)
;
@@ -923,23 +924,23 @@ gen_aux_proc_goal(Info, Goal) = AuxGoal :-
unexpected($module, $pred, "shorthand")
).
:- func gen_aux_proc_case(gen_aux_proc_info, case) = case.
:- pred gen_aux_proc_case(gen_aux_proc_info::in, case::in, case::out) is det.
gen_aux_proc_case(Info, Case) = AuxCase :-
gen_aux_proc_case(Info, Case, AuxCase) :-
Case = case(MainConsId, OtherConsIds, Goal),
AuxGoal = gen_aux_proc_goal(Info, Goal),
gen_aux_proc_goal(Info, Goal, AuxGoal),
AuxCase = case(MainConsId, OtherConsIds, AuxGoal).
%-----------------------------------------------------------------------------%
:- func gen_aux_proc_handle_non_recursive_call(gen_aux_proc_info, hlds_goal) =
hlds_goal.
:- pred gen_aux_proc_handle_non_recursive_call(gen_aux_proc_info::in,
hlds_goal::in, hlds_goal::out) is det.
gen_aux_proc_handle_non_recursive_call(Info, Goal0) =
( invariant_goal(Info ^ gapi_inv_goals, Goal0) ->
true_goal
;
Goal0
gen_aux_proc_handle_non_recursive_call(Info, Goal, AuxGoal) :-
( if invariant_goal(Info ^ gapi_inv_goals, Goal) then
AuxGoal = true_goal
else
AuxGoal = Goal
).
%-----------------------------------------------------------------------------%
@@ -951,10 +952,10 @@ gen_aux_proc_handle_non_recursive_call(Info, Goal0) =
proc_info::in, proc_info::out, hlds_goal::in, hlds_goal::in,
module_info::in, module_info::out) is det.
gen_out_proc(PredProcId, PredInfo0, ProcInfo0, ProcInfo, CallAux, Body0,
ModuleInfo0, ModuleInfo) :-
gen_out_proc(PredProcId, PredInfo0, ProcInfo0, ProcInfo, Replacement, Body0,
!ModuleInfo) :-
% Compute the new procedure body.
Body = gen_out_proc_goal(PredProcId, CallAux, Body0),
gen_out_proc_goal(PredProcId, Replacement, Body0, Body),
% Put the new procedure body into the module_info.
PredProcId = proc(PredId, ProcId),
@@ -970,26 +971,27 @@ gen_out_proc(PredProcId, PredInfo0, ProcInfo0, ProcInfo, CallAux, Body0,
requantify_proc_general(ordinary_nonlocals_no_lambda,
ProcInfo1, ProcInfo2),
recompute_instmap_delta_proc(do_not_recompute_atomic_instmap_deltas,
ProcInfo2, ProcInfo, ModuleInfo0, ModuleInfo1),
ProcInfo2, ProcInfo, !ModuleInfo),
module_info_set_pred_proc_info(PredId, ProcId,
PredInfo0, ProcInfo, ModuleInfo1, ModuleInfo).
PredInfo0, ProcInfo, !ModuleInfo).
%-----------------------------------------------------------------------------%
% gen_out_proc_goal(PredProcId, CallAux, Goal0) = Goal:
% gen_out_proc_goal(PredProcId, Replacement, Goal, AuxGoal):
%
% Goal is Goal0 with calls to PredProcId replaced with CallAux.
% AuxGoal is Goal with calls to PredProcId replaced with Replacement.
%
:- func gen_out_proc_goal(pred_proc_id, hlds_goal, hlds_goal) = hlds_goal.
:- pred gen_out_proc_goal(pred_proc_id::in, hlds_goal::in,
hlds_goal::in, hlds_goal::out) is det.
gen_out_proc_goal(PPId, CallAux, Goal) = AuxGoal :-
gen_out_proc_goal(PPId, Replacement, Goal, AuxGoal) :-
Goal = hlds_goal(GoalExpr, GoalInfo),
(
GoalExpr = plain_call(PredId, ProcId, _, _, _, _),
( proc(PredId, ProcId) = PPId ->
AuxGoal = gen_aux_call(CallAux, Goal)
;
( if proc(PredId, ProcId) = PPId then
gen_aux_call(Replacement, Goal, AuxGoal)
else
AuxGoal = Goal
)
;
@@ -1000,36 +1002,36 @@ gen_out_proc_goal(PPId, CallAux, Goal) = AuxGoal :-
AuxGoal = Goal
;
GoalExpr = conj(ConjType, Conjuncts),
AuxConjuncts = list.map(gen_out_proc_goal(PPId, CallAux), Conjuncts),
list.map(gen_out_proc_goal(PPId, Replacement), Conjuncts, AuxConjuncts),
AuxGoalExpr = conj(ConjType, AuxConjuncts),
AuxGoal = hlds_goal(AuxGoalExpr, GoalInfo)
;
GoalExpr = disj(Disjuncts),
AuxDisjuncts = list.map(gen_out_proc_goal(PPId, CallAux), Disjuncts),
list.map(gen_out_proc_goal(PPId, Replacement), Disjuncts, AuxDisjuncts),
AuxGoalExpr = disj(AuxDisjuncts),
AuxGoal = hlds_goal(AuxGoalExpr, GoalInfo)
;
GoalExpr = switch(Var, CanFail, Cases),
AuxCases = list.map(gen_out_proc_case(PPId, CallAux), Cases),
list.map(gen_out_proc_case(PPId, Replacement), Cases, AuxCases),
AuxGoalExpr = switch(Var, CanFail, AuxCases),
AuxGoal = hlds_goal(AuxGoalExpr, GoalInfo)
;
GoalExpr = negation(SubGoal),
AuxSubGoal = gen_out_proc_goal(PPId, CallAux, SubGoal),
gen_out_proc_goal(PPId, Replacement, SubGoal, AuxSubGoal),
AuxGoalExpr = negation(AuxSubGoal),
AuxGoal = hlds_goal(AuxGoalExpr, GoalInfo)
;
GoalExpr = scope(Reason, SubGoal),
% XXX We should consider special casing the handling of
% from_ground_term_construct scopes.
AuxSubGoal = gen_out_proc_goal(PPId, CallAux, SubGoal),
gen_out_proc_goal(PPId, Replacement, SubGoal, AuxSubGoal),
AuxGoalExpr = scope(Reason, AuxSubGoal),
AuxGoal = hlds_goal(AuxGoalExpr, GoalInfo)
;
GoalExpr = if_then_else(Vars, Cond, Then, Else),
AuxCond = gen_out_proc_goal(PPId, CallAux, Cond),
AuxThen = gen_out_proc_goal(PPId, CallAux, Then),
AuxElse = gen_out_proc_goal(PPId, CallAux, Else),
gen_out_proc_goal(PPId, Replacement, Cond, AuxCond),
gen_out_proc_goal(PPId, Replacement, Then, AuxThen),
gen_out_proc_goal(PPId, Replacement, Else, AuxElse),
AuxGoalExpr = if_then_else(Vars, AuxCond, AuxThen, AuxElse),
AuxGoal = hlds_goal(AuxGoalExpr, GoalInfo)
;
@@ -1037,42 +1039,48 @@ gen_out_proc_goal(PPId, CallAux, Goal) = AuxGoal :-
unexpected($module, $pred, "shorthand")
).
:- func gen_out_proc_case(pred_proc_id, hlds_goal, case) = case.
:- pred gen_out_proc_case(pred_proc_id::in, hlds_goal::in, case::in, case::out)
is det.
gen_out_proc_case(PPId, CallAux, Case) = AuxCase :-
gen_out_proc_case(PPId, Replacement, Case, AuxCase) :-
Case = case(MainConsId, OtherConsIds, Goal),
AuxGoal = gen_out_proc_goal(PPId, CallAux, Goal),
gen_out_proc_goal(PPId, Replacement, Goal, AuxGoal),
AuxCase = case(MainConsId, OtherConsIds, AuxGoal).
%-----------------------------------------------------------------------------%
:- func gen_aux_call(hlds_goal, hlds_goal) = hlds_goal.
:- pred gen_aux_call(hlds_goal::in, hlds_goal::in, hlds_goal::out) is det.
gen_aux_call(hlds_goal(CallAux0, _CallAuxInfo0), hlds_goal(Call, CallInfo)) =
(
AuxArgs0 = CallAux0 ^ call_args,
Args0 = Call ^ call_args,
Args = replace_initial_args(Args0, AuxArgs0),
CallAux = ( CallAux0 ^ call_args := Args )
gen_aux_call(Replacement, CallGoal, AuxCallGoal) :-
Replacement = hlds_goal(ReplacementExpr, _ReplacementInfo0),
CallGoal = hlds_goal(CallExpr, CallInfo),
( if
ReplacementArgs0 = ReplacementExpr ^ call_args,
Args0 = CallExpr ^ call_args,
replace_initial_args(Args0, ReplacementArgs0, Args),
AuxCallGoalExpr = ReplacementExpr ^ call_args := Args
% Note that one might expect instmap_delta to change, however the
% invariant arguments are just that -invariant- hence their insts
% are not changed by the recursive call and there is no need
% to adjust the instmap_delta. All other fields are correct for
% CallInfo.
->
hlds_goal(CallAux, CallInfo)
;
then
AuxCallGoal = hlds_goal(AuxCallGoalExpr, CallInfo)
else
unexpected($module, $pred, "args not both ordinary calls")
).
%-----------------------------------------------------------------------------%
% replace_initial_args(Rs, Xs0, Xs):
%
% If Rs has N elements, then replace the first N elements of Xs0 with Rs.
%
:- pred replace_initial_args(list(T)::in, list(T)::in, list(T)::out) is det.
:- func replace_initial_args(list(T), list(T)) = list(T).
replace_initial_args([], Ys ) = Ys.
replace_initial_args([X | Xs], [_ | Ys]) = [X | replace_initial_args(Xs, Ys)].
replace_initial_args([_ | _], [] ) = _ :-
replace_initial_args([], Xs, Xs).
replace_initial_args([R | Rs], [_ | Xs0], [R | Xs]) :-
replace_initial_args(Rs, Xs0, Xs).
replace_initial_args([_ | _], [], _) :-
unexpected($module, $pred, "first arg longer than second").
%-----------------------------------------------------------------------------%
@@ -1085,27 +1093,25 @@ replace_initial_args([_ | _], [] ) = _ :-
%
% TODO: get this to handle unification properly. See the XXX below.
%
:- func uniquely_used_vars(module_info, hlds_goal) = prog_vars.
:- func uniquely_used_vars(module_info, hlds_goal) = list(prog_var).
uniquely_used_vars(ModuleInfo, Goal) =
list.sort_and_remove_dups(used_vars(ModuleInfo, Goal)).
%-----------------------------------------------------------------------------%
:- func used_vars(module_info, hlds_goal) = prog_vars.
:- func used_vars(module_info, hlds_goal) = list(prog_var).
used_vars(ModuleInfo, Goal) = UsedVars :-
Goal = hlds_goal(GoalExpr, _GoalInfo),
(
GoalExpr = plain_call(PredId, ProcId, Args, _, _, _),
UsedVars = list.filter_map_corresponding(
uniquely_used_args(ModuleInfo),
Args, argmodes(ModuleInfo, PredId, ProcId))
list.filter_map_corresponding(uniquely_used_args(ModuleInfo),
Args, argmodes(ModuleInfo, PredId, ProcId), UsedVars)
;
GoalExpr = generic_call(_, Args, Modes, _, _),
UsedVars = list.filter_map_corresponding(
uniquely_used_args(ModuleInfo),
Args, Modes)
list.filter_map_corresponding(uniquely_used_args(ModuleInfo),
Args, Modes, UsedVars)
;
GoalExpr = call_foreign_proc(_, PredId, ProcId,
ForeignArgs, ExtraForeignArgs, _, _),
@@ -1116,10 +1122,9 @@ used_vars(ModuleInfo, Goal) = UsedVars :-
% this predicate, so `Extras' may not be empty. As a work-around,
% we just add any variables in `Extras' to the set of variables
% that cannot be hoisted.
UsedArgVars = list.filter_map_corresponding(
uniquely_used_args(ModuleInfo),
list.filter_map_corresponding(uniquely_used_args(ModuleInfo),
list.map(foreign_arg_var, ForeignArgs),
argmodes(ModuleInfo, PredId, ProcId)),
argmodes(ModuleInfo, PredId, ProcId), UsedArgVars),
UsedExtraArgVars = list.map(foreign_arg_var, ExtraForeignArgs),
UsedVars = UsedArgVars ++ UsedExtraArgVars
;
@@ -1160,10 +1165,10 @@ case_goals(Cases) =
%-----------------------------------------------------------------------------%
:- func uniquely_used_args(module_info, prog_var, mer_mode) = prog_var
is semidet.
:- pred uniquely_used_args(module_info::in, prog_var::in, mer_mode::in,
prog_var::out) is semidet.
uniquely_used_args(ModuleInfo, X, M) = X :-
uniquely_used_args(ModuleInfo, X, M, X) :-
mode_get_insts(ModuleInfo, M, InInst, _OutInst),
not inst_is_not_partly_unique(ModuleInfo, InInst).
@@ -1180,49 +1185,49 @@ argmodes(ModuleInfo, PredId, ProcId) = ArgModes :-
% Find the list of vars for a goal that are free before the call.
% This only applies to calls and unifications.
%
:- func goal_inputs(module_info, hlds_goal) = prog_vars.
:- func goal_inputs(module_info, hlds_goal) = list(prog_var).
goal_inputs(ModuleInfo, Goal) = Inputs :-
Goal = hlds_goal(GoalExpr, _GoalInfo),
(
GoalExpr = plain_call(PredId, ProcId, Args, _, _, _),
Inputs = list.filter_map_corresponding(input_arg(ModuleInfo),
Args, argmodes(ModuleInfo, PredId, ProcId))
list.filter_map_corresponding(input_arg(ModuleInfo),
Args, argmodes(ModuleInfo, PredId, ProcId), Inputs)
;
GoalExpr = generic_call(GenericCall, Args, ArgModes, _, _),
generic_call_vars(GenericCall, GenericCallVars),
Inputs0 = list.filter_map_corresponding(input_arg(ModuleInfo),
Args, ArgModes),
list.filter_map_corresponding(input_arg(ModuleInfo),
Args, ArgModes, Inputs0),
Inputs = GenericCallVars ++ Inputs0
;
GoalExpr = call_foreign_proc(_, PredId, ProcId, ForeignArgs, _, _, _),
Inputs = list.filter_map_corresponding(input_arg(ModuleInfo),
list.filter_map_corresponding(input_arg(ModuleInfo),
list.map(foreign_arg_var, ForeignArgs),
argmodes(ModuleInfo, PredId, ProcId))
argmodes(ModuleInfo, PredId, ProcId), Inputs)
;
GoalExpr = unify(LHS, UnifyRHS, _, Kind, _),
(
% The LHS is always an output var in constructions.
Kind = construct(_, _, RHSArgs, ArgUniModes, _, _, _),
Inputs = list.filter_map_corresponding(input_arg(ModuleInfo),
RHSArgs, rhs_modes(ArgUniModes))
Kind = construct(_, _, RHSArgs, ArgUniModes, _, _, _),
list.filter_map_corresponding(input_arg(ModuleInfo),
RHSArgs, rhs_modes(ArgUniModes), Inputs)
;
% The LHS is always in input var in deconstructions.
Kind = deconstruct(_, _, RHSArgs, ArgUniModes, _, _),
RHSInputs = list.filter_map_corresponding(input_arg(ModuleInfo),
RHSArgs, rhs_modes(ArgUniModes)),
Kind = deconstruct(_, _, RHSArgs, ArgUniModes, _, _),
list.filter_map_corresponding(input_arg(ModuleInfo),
RHSArgs, rhs_modes(ArgUniModes), RHSInputs),
Inputs = [LHS | RHSInputs]
;
% The RHS is the only input in an assignment.
Kind = assign(_, RHS),
Kind = assign(_, RHS),
Inputs = [RHS]
;
% Both sides of a simple test are inputs.
Kind = simple_test(_, RHS),
Kind = simple_test(_, RHS),
Inputs = [LHS, RHS]
;
% Both sides of a complicated unification are inputs.
Kind = complicated_unify(_, _, _),
Kind = complicated_unify(_, _, _),
(
UnifyRHS = rhs_var(RHS),
Inputs = [LHS, RHS]
@@ -1247,60 +1252,48 @@ goal_inputs(ModuleInfo, Goal) = Inputs :-
unexpected($module, $pred, "compound goal")
).
%-----------------------------------------------------------------------------%
% An input arg is one whose pre-call inst is not free.
%
:- func input_arg(module_info, prog_var, mer_mode) = prog_var is semidet.
input_arg(ModuleInfo, X, M) = X :-
mode_get_insts(ModuleInfo, M, InInst, _OutInst),
not inst_is_free(ModuleInfo, InInst).
%-----------------------------------------------------------------------------%
% Find the list of vars for a goal that are free before the call and bound
% afterwards. This only applies to calls and unifications.
%
:- func goal_outputs(module_info, hlds_goal) = prog_vars.
:- func goal_outputs(module_info, hlds_goal) = list(prog_var).
goal_outputs(ModuleInfo, Goal) = Outputs :-
Goal = hlds_goal(GoalExpr, _GoalInfo),
(
GoalExpr = plain_call(PredId, ProcId, Args, _, _, _),
Outputs = list.filter_map_corresponding(output_arg(ModuleInfo),
Args, argmodes(ModuleInfo, PredId, ProcId))
list.filter_map_corresponding(output_arg(ModuleInfo),
Args, argmodes(ModuleInfo, PredId, ProcId), Outputs)
;
GoalExpr = generic_call(_, Args, ArgModes, _, _),
Outputs = list.filter_map_corresponding(output_arg(ModuleInfo),
Args, ArgModes)
list.filter_map_corresponding(output_arg(ModuleInfo),
Args, ArgModes, Outputs)
;
GoalExpr = call_foreign_proc(_, PredId, ProcId, ForeignArgs, _, _, _),
Outputs = list.filter_map_corresponding(output_arg(ModuleInfo),
list.filter_map_corresponding(output_arg(ModuleInfo),
list.map(foreign_arg_var, ForeignArgs),
argmodes(ModuleInfo, PredId, ProcId))
argmodes(ModuleInfo, PredId, ProcId), Outputs)
;
GoalExpr = unify(LHS, _RHS, _, Kind, _),
(
% The LHS is the only output in a construction.
Kind = construct(_, _, _, _, _, _, _),
Kind = construct(_, _, _, _, _, _, _),
Outputs = [LHS]
;
% The LHS is always in input in deconstructions.
Kind = deconstruct(_, _, RHSArgs, ArgUniModes, _, _),
Outputs = list.filter_map_corresponding(output_arg(ModuleInfo),
RHSArgs, rhs_modes(ArgUniModes))
Kind = deconstruct(_, _, RHSArgs, ArgUniModes, _, _),
list.filter_map_corresponding(output_arg(ModuleInfo),
RHSArgs, rhs_modes(ArgUniModes), Outputs)
;
% The LHS is the only output in an assignment.
Kind = assign(_, _),
Kind = assign(_, _),
Outputs = [LHS]
;
% Both sides of a simple test are inputs.
Kind = simple_test(_, _),
Kind = simple_test(_, _),
Outputs = []
;
% Both sides of a complicated unification are inputs.
Kind = complicated_unify(_, _, _),
Kind = complicated_unify(_, _, _),
Outputs = []
)
;
@@ -1315,13 +1308,21 @@ goal_outputs(ModuleInfo, Goal) = Outputs :-
unexpected($module, $pred, "compound goal")
).
%-----------------------------------------------------------------------------%
% An input arg is one whose pre-call inst is not free.
%
:- pred input_arg(module_info::in, prog_var::in, mer_mode::in, prog_var::out)
is semidet.
input_arg(ModuleInfo, X, M, X) :-
mode_get_insts(ModuleInfo, M, InInst, _OutInst),
not inst_is_free(ModuleInfo, InInst).
% An output arg is one whose pre-call inst is free and ground after.
%
:- func output_arg(module_info, prog_var, mer_mode) = prog_var is semidet.
:- pred output_arg(module_info::in, prog_var::in, mer_mode::in, prog_var::out)
is semidet.
output_arg(ModuleInfo, X, M) = X :-
output_arg(ModuleInfo, X, M, X) :-
mode_is_fully_output(ModuleInfo, M).
%-----------------------------------------------------------------------------%