mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-15 09:23:44 +00:00
d8a31e574e
compiler/inst_lookup.m:
compiler/inst_mode_type_prop.m:
compiler/inst_test.m:
compiler/inst_util.m:
compiler/mode_util.m:
compiler/type_util.m:
Move these modules from the check_hlds package to the hlds package.
The reason is that all the content of five of these modules, and
most of the content of one module (inst_util.m) is not used
exclusively during semantic checking passes. (A later diff
should deal with the exception.) Some are used by the pass that
builds the initial HLDS, and all are used by middle-end and backend
passes. The move therefore reduces the number of inappropriate imports
of the check_hlds package.
compiler/check_hlds.m:
compiler/hlds.m:
Effect the transfer.
compiler/*.m:
Conform to the changes above.
683 lines
27 KiB
Mathematica
683 lines
27 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 2007-2012 The University of Melbourne.
|
|
% Copyright (C) 2014-2015, 2025 The Mercury team.
|
|
% This file may only be copied under the terms of the GNU General
|
|
% Public License - see the file COPYING in the Mercury distribution.
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% File: delay_partial_inst.m.
|
|
% Author: wangp.
|
|
%
|
|
% This module runs just after mode analysis on mode-correct procedures and
|
|
% tries to transform procedures to avoid intermediate partially instantiated
|
|
% data structures. The original impetus for this pass was the Erlang backend,
|
|
% which could not handle partially instantiated data structures at all,
|
|
% because, due to all Erlang data structures being immutable, it could not
|
|
% further instantiate any originally partially instantiated data structures.
|
|
% However, even on other backends, constructing a ground data structure
|
|
% directly is simpler and more efficient than creating a partially instantiated
|
|
% data structure and then filling it in.
|
|
%
|
|
% There are two situations we look for. The first is an implied mode call
|
|
% such as
|
|
%
|
|
% p(f(_, _))
|
|
%
|
|
% which after mode checking looks like this:
|
|
%
|
|
% X := f(V_1, V_2), % partially instantiated
|
|
% p(Y),
|
|
% X ?= Y
|
|
%
|
|
% We transform it to this more obvious sequence which doesn't need the
|
|
% partially instantiated data structure:
|
|
%
|
|
% p(Y),
|
|
% Y ?= f(_, _)
|
|
%
|
|
% The other situation occurs when the user writes code that constructs data
|
|
% structures with free variables, e.g.
|
|
%
|
|
% :- type t
|
|
% ---> t(
|
|
% a :: int,
|
|
% b :: int
|
|
% ).
|
|
%
|
|
% F ^ a = 1,
|
|
% F ^ b = 2
|
|
%
|
|
% After mode checking we get:
|
|
%
|
|
% V_1 = 1,
|
|
% F := t(V_1, V_2), % ground, free
|
|
% V_3 = 2,
|
|
% F => t(V_4, V_3) % ground, ground
|
|
%
|
|
% Whereas we would like to see this:
|
|
%
|
|
% V_1 = 1,
|
|
% V_2 = 2,
|
|
% F := t(V_1, V_2)
|
|
%
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% ALGORITHM
|
|
%
|
|
% The idea is to remove unifications that produce partially instantiated data
|
|
% structures (as the mode checker can't be counted on to move these), and keep
|
|
% track of variables which are bound to top-level functors with free arguments.
|
|
% In place of the unifications we remove, we insert the unifications for the
|
|
% sub-components which are ground. Only once the variable is ground, because
|
|
% all its sub-components are ground, do we create the top-level memory cell.
|
|
%
|
|
% The algorithm makes a single forward pass over each procedure. When we see
|
|
% a unification that binds a variable V to a functor f/n with at least one
|
|
% free argument, we add an entry to the "construction map" and delete the
|
|
% unification. The construction map records that V was bound to f/n.
|
|
% We also create new "canonical" variables for each of the arguments.
|
|
%
|
|
% When we later see a deconstruction unification of V we first unify each
|
|
% argument in the deconstruction with its corresponding "canonical" variable.
|
|
% This way we can always use the canonical variables when it comes time to
|
|
% reconstruct V, so we don't need to keep track of aliases. If the mode of the
|
|
% deconstruction unification indicates that V should be ground at the end
|
|
% of the deconstruction, we insert a construction unification using the
|
|
% canonical variables, in place of the deconstruction, and delete V's entry
|
|
% from the construction map now. Otherwise, if V is not ground, we just delete
|
|
% the deconstruction unification.
|
|
%
|
|
% To handle the problem with implied mode calls, we look for complicated
|
|
% `can_fail' unifications that have V on the left-hand side. We transform them
|
|
% as in the example above, i.e. instead of unifying a ground variable G with a
|
|
% partially instantiated V, we unify G with the functor that V is bound to.
|
|
%
|
|
% After transforming all the procedures, we requantify and rerun mode analysis,
|
|
% which should do the rest.
|
|
%
|
|
% This algorithm can't handle everything that the mode checker allows, however
|
|
% most code written in practice should be okay. Here is an example of code we
|
|
% cannot handle:
|
|
%
|
|
% foo(Xs) :-
|
|
% ( Xs = []
|
|
% ; Xs = [1 | _]
|
|
% ),
|
|
% ( Xs = []
|
|
% ; Xs = [_ | []]
|
|
% ).
|
|
%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- module check_hlds.delay_partial_inst.
|
|
:- interface.
|
|
|
|
:- import_module hlds.
|
|
:- import_module hlds.hlds_module.
|
|
:- import_module hlds.hlds_pred.
|
|
|
|
:- import_module io.
|
|
:- import_module list.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred delay_partial_inst_preds(io.text_output_stream::in,
|
|
list(pred_id)::in, list(pred_id)::out,
|
|
module_info::in, module_info::out) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module hlds.goal_util.
|
|
:- import_module hlds.hlds_goal.
|
|
:- import_module hlds.hlds_out.
|
|
:- import_module hlds.hlds_out.hlds_out_goal.
|
|
:- import_module hlds.hlds_proc_util.
|
|
:- import_module hlds.inst_test.
|
|
:- import_module hlds.instmap.
|
|
:- import_module hlds.make_goal.
|
|
:- import_module hlds.passes_aux.
|
|
:- import_module hlds.quantification.
|
|
:- import_module parse_tree.
|
|
:- import_module parse_tree.prog_data.
|
|
:- import_module parse_tree.prog_rename.
|
|
:- import_module parse_tree.var_db.
|
|
:- import_module parse_tree.var_table.
|
|
|
|
:- import_module assoc_list.
|
|
:- import_module bool.
|
|
:- import_module map.
|
|
:- import_module pair.
|
|
:- import_module require.
|
|
:- import_module string.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- type delay_partial_inst_info
|
|
---> delay_partial_inst_info(
|
|
% Read-only.
|
|
dpi_module_info :: module_info,
|
|
|
|
% Read-write.
|
|
dpi_var_table :: var_table,
|
|
dpi_changed :: bool
|
|
).
|
|
|
|
% A map from the variable to the functor to which it is bound, which maps
|
|
% to the canonical variables assigned for that functor.
|
|
%
|
|
% We can actually only handle the case when a variable is definitely bound
|
|
% to a single functor. If different disjuncts bind a variable to different
|
|
% functors, then our algorithm won't work. So why do we use a single map
|
|
% from the variable to (cons_id, canon_vars)? To handle code like this,
|
|
% which can result from a reasonable predicate definition.
|
|
%
|
|
% ( X := f
|
|
% ; X := g
|
|
% ; X := h(_), fail
|
|
% ; X := i(_), fail
|
|
% )
|
|
%
|
|
% We don't want to abort as soon as we see that "X := i(_)" is incompatible
|
|
% with "X := h(_)". We *will* abort later if we need to look up the sole
|
|
% functor that X could be bound to, and find that there are multiple
|
|
% choices.
|
|
%
|
|
:- type construct_map == map(prog_var, canon_vars_map).
|
|
|
|
:- type canon_vars_map == map(cons_id, list(prog_var)).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
delay_partial_inst_preds(ProgressStream, PredIds, ChangedPredIds,
|
|
!ModuleInfo) :-
|
|
delay_partial_inst_preds_acc(ProgressStream, PredIds,
|
|
[], RevChangedPredIds, !ModuleInfo),
|
|
list.reverse(RevChangedPredIds, ChangedPredIds).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred delay_partial_inst_preds_acc(io.text_output_stream::in,
|
|
list(pred_id)::in, list(pred_id)::in, list(pred_id)::out,
|
|
module_info::in, module_info::out) is det.
|
|
|
|
delay_partial_inst_preds_acc(_, [], !RevChangedPredIds, !ModuleInfo).
|
|
delay_partial_inst_preds_acc(ProgressStream, [PredId | PredIds],
|
|
!RevChangedPredIds, !ModuleInfo) :-
|
|
module_info_pred_info(!.ModuleInfo, PredId, PredInfo0),
|
|
pred_info_get_proc_table(PredInfo0, ProcTable0),
|
|
ProcIds = pred_info_all_non_imported_procids(PredInfo0),
|
|
list.foldl(
|
|
delay_partial_inst_proc(ProgressStream, !.ModuleInfo, PredId,
|
|
ProcTable0),
|
|
ProcIds, [], ChangedProcs),
|
|
(
|
|
ChangedProcs = [_ | _],
|
|
map.set_from_assoc_list(ChangedProcs, ProcTable0, ProcTable),
|
|
pred_info_set_proc_table(ProcTable, PredInfo0, PredInfo),
|
|
module_info_set_pred_info(PredId, PredInfo, !ModuleInfo),
|
|
!:RevChangedPredIds = [PredId | !.RevChangedPredIds]
|
|
;
|
|
ChangedProcs = []
|
|
),
|
|
delay_partial_inst_preds_acc(ProgressStream, PredIds,
|
|
!RevChangedPredIds, !ModuleInfo).
|
|
|
|
:- pred delay_partial_inst_proc(io.text_output_stream::in, module_info::in,
|
|
pred_id::in, proc_table::in, proc_id::in,
|
|
assoc_list(proc_id, proc_info)::in, assoc_list(proc_id, proc_info)::out)
|
|
is det.
|
|
|
|
delay_partial_inst_proc(ProgressStream, ModuleInfo, PredId, ProcTable, ProcId,
|
|
!ChangedProcs) :-
|
|
trace [io(!IO)] (
|
|
maybe_write_proc_progress_message(ProgressStream, ModuleInfo,
|
|
"Delaying partial instantiations in", proc(PredId, ProcId), !IO)
|
|
),
|
|
some [!ProcInfo] (
|
|
map.lookup(ProcTable, ProcId, !:ProcInfo),
|
|
proc_info_get_var_table(!.ProcInfo, VarTable0),
|
|
proc_info_get_initial_instmap(ModuleInfo, !.ProcInfo, InstMap0),
|
|
proc_info_get_goal(!.ProcInfo, Goal0),
|
|
|
|
Changed0 = no,
|
|
DelayInfo0 = delay_partial_inst_info(ModuleInfo, VarTable0, Changed0),
|
|
delay_partial_inst_in_goal(InstMap0, Goal0, Goal,
|
|
map.init, _ConstructMap, DelayInfo0, DelayInfo),
|
|
DelayInfo = delay_partial_inst_info(_, VarTable, Changed),
|
|
|
|
(
|
|
Changed = yes,
|
|
proc_info_set_goal(Goal, !ProcInfo),
|
|
proc_info_set_var_table(VarTable, !ProcInfo),
|
|
requantify_proc_general(ord_nl_maybe_lambda, !ProcInfo),
|
|
!:ChangedProcs = [ProcId - !.ProcInfo | !.ChangedProcs],
|
|
|
|
trace [compiletime(flag("debug_delay_partial_inst")), io(!IO)] (
|
|
module_info_pred_info(ModuleInfo, PredId, PredInfo),
|
|
pred_info_get_typevarset(PredInfo, TVarSet),
|
|
proc_info_get_inst_varset(!.ProcInfo, InstVarSet),
|
|
io.write_string(ProgressStream,
|
|
"predicate body BEFORE delay_partial_inst:\n", !IO),
|
|
dump_goal_nl(ProgressStream, ModuleInfo,
|
|
vns_var_table(VarTable0), TVarSet, InstVarSet, Goal0, !IO),
|
|
io.write_string(ProgressStream,
|
|
"predicate body AFTER delay_partial_inst:\n", !IO),
|
|
dump_goal_nl(ProgressStream, ModuleInfo,
|
|
vns_var_table(VarTable), TVarSet, InstVarSet, Goal, !IO)
|
|
)
|
|
;
|
|
Changed = no
|
|
)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred delay_partial_inst_in_goal(instmap::in, hlds_goal::in, hlds_goal::out,
|
|
construct_map::in, construct_map::out,
|
|
delay_partial_inst_info::in, delay_partial_inst_info::out) is det.
|
|
|
|
delay_partial_inst_in_goal(InstMap0, Goal0, Goal, !ConstructMap, !DelayInfo) :-
|
|
Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
|
|
(
|
|
GoalExpr0 = conj(ConjType, Goals0),
|
|
delay_partial_inst_in_conj(InstMap0, Goals0, Goals, !ConstructMap,
|
|
!DelayInfo),
|
|
Goal = hlds_goal(conj(ConjType, Goals), GoalInfo0)
|
|
;
|
|
GoalExpr0 = disj(Goals0),
|
|
delay_partial_inst_in_disj(InstMap0, Goals0, Goals, !ConstructMap,
|
|
!DelayInfo),
|
|
Goal = hlds_goal(disj(Goals), GoalInfo0)
|
|
;
|
|
GoalExpr0 = negation(NegGoal0),
|
|
delay_partial_inst_in_goal(InstMap0, NegGoal0, NegGoal,
|
|
!.ConstructMap, _, !DelayInfo),
|
|
Goal = hlds_goal(negation(NegGoal), GoalInfo0)
|
|
;
|
|
GoalExpr0 = switch(Var, CanFail, Cases0),
|
|
delay_partial_inst_in_cases(InstMap0, Cases0, Cases, !ConstructMap,
|
|
!DelayInfo),
|
|
Goal = hlds_goal(switch(Var, CanFail, Cases), GoalInfo0)
|
|
;
|
|
GoalExpr0 = if_then_else(Vars, Cond0, Then0, Else0),
|
|
apply_goal_instmap_delta(Cond0, InstMap0, InstMapThen),
|
|
delay_partial_inst_in_goal(InstMap0, Cond0, Cond, !ConstructMap,
|
|
!DelayInfo),
|
|
delay_partial_inst_in_goal(InstMapThen, Then0, Then, !ConstructMap,
|
|
!DelayInfo),
|
|
delay_partial_inst_in_goal(InstMap0, Else0, Else, !ConstructMap,
|
|
!DelayInfo),
|
|
Goal = hlds_goal(if_then_else(Vars, Cond, Then, Else), GoalInfo0)
|
|
;
|
|
GoalExpr0 = scope(Reason, SubGoal0),
|
|
( if
|
|
Reason = from_ground_term(_, FGT),
|
|
( FGT = from_ground_term_construct
|
|
; FGT = from_ground_term_deconstruct
|
|
)
|
|
then
|
|
Goal = Goal0
|
|
else
|
|
delay_partial_inst_in_goal(InstMap0, SubGoal0, SubGoal,
|
|
!.ConstructMap, _, !DelayInfo),
|
|
Goal = hlds_goal(scope(Reason, SubGoal), GoalInfo0)
|
|
)
|
|
;
|
|
GoalExpr0 = unify(LHS, RHS0, Mode, Unify, Context),
|
|
(
|
|
Unify = construct(_Var, ConsId, _Args, ArgModes, _, _, _),
|
|
( if
|
|
% Is this construction of the form
|
|
% V = f(A1, A2, A3, ...)
|
|
% and at least one of the arguments is free?
|
|
%
|
|
( ConsId = du_data_ctor(_)
|
|
; ConsId = tuple_cons(_)
|
|
),
|
|
ModuleInfo = !.DelayInfo ^ dpi_module_info,
|
|
some [ArgMode] (
|
|
list.member(ArgMode, ArgModes),
|
|
ArgMode = unify_modes_li_lf_ri_rf(_, _, _, RHSFinalInst),
|
|
inst_is_free(ModuleInfo, RHSFinalInst)
|
|
)
|
|
then
|
|
delay_partial_inst_in_partial_construct(GoalInfo0, Unify, Goal,
|
|
!ConstructMap, !DelayInfo)
|
|
else
|
|
(
|
|
% Tranform lambda goals as well. Non-local variables in
|
|
% lambda goals must be any or ground so we don't carry the
|
|
% construct map into the lambda goal.
|
|
RHS0 = rhs_lambda_goal(Purity, Groundness, PredOrFunc,
|
|
NonLocals, LambdaArgVarsModes, Detism, LambdaGoal0),
|
|
delay_partial_inst_in_goal(InstMap0,
|
|
LambdaGoal0, LambdaGoal, map.init, _ConstructMap,
|
|
!DelayInfo),
|
|
RHS = rhs_lambda_goal(Purity, Groundness, PredOrFunc,
|
|
NonLocals, LambdaArgVarsModes, Detism, LambdaGoal),
|
|
GoalExpr = unify(LHS, RHS, Mode, Unify, Context),
|
|
Goal = hlds_goal(GoalExpr, GoalInfo0)
|
|
;
|
|
( RHS0 = rhs_var(_)
|
|
; RHS0 = rhs_functor(_, _, _)
|
|
),
|
|
Goal = Goal0
|
|
)
|
|
)
|
|
;
|
|
Unify = deconstruct(_Var, _ConsId, _Args, _ArgModes,
|
|
_CanFail, _CanCGC),
|
|
delay_partial_inst_in_deconstruct(!.DelayInfo, Goal0, Mode, Unify,
|
|
Goal, !ConstructMap)
|
|
;
|
|
Unify = complicated_unify(_Mode, _CanFail, _TypeInfos),
|
|
delay_partial_inst_in_complicated_unify(!.ConstructMap,
|
|
Goal0, LHS, RHS0, Unify, Goal)
|
|
;
|
|
( Unify = assign(_, _)
|
|
; Unify = simple_test(_, _)
|
|
),
|
|
Goal = Goal0
|
|
)
|
|
;
|
|
( GoalExpr0 = generic_call(_, _, _, _, _)
|
|
; GoalExpr0 = plain_call(_, _, _, _, _, _)
|
|
; GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _)
|
|
),
|
|
Goal = Goal0
|
|
;
|
|
GoalExpr0 = shorthand(ShortHand0),
|
|
(
|
|
ShortHand0 = atomic_goal(GoalType, Outer, Inner, MaybeOutputVars,
|
|
MainGoal0, OrElseGoals0, OrElseInners),
|
|
% XXX Is it ok to ignore the updated ConstructMaps,
|
|
% and if yes, why? This should be documented.
|
|
delay_partial_inst_in_goal(InstMap0, MainGoal0, MainGoal,
|
|
!.ConstructMap, _, !DelayInfo),
|
|
delay_partial_inst_in_disj(InstMap0, OrElseGoals0, OrElseGoals,
|
|
!.ConstructMap, _, !DelayInfo),
|
|
ShortHand = atomic_goal(GoalType, Outer, Inner, MaybeOutputVars,
|
|
MainGoal, OrElseGoals, OrElseInners),
|
|
GoalExpr = shorthand(ShortHand),
|
|
Goal = hlds_goal(GoalExpr, GoalInfo0)
|
|
;
|
|
ShortHand0 = try_goal(MaybeIO, ResultVar, SubGoal0),
|
|
delay_partial_inst_in_goal(InstMap0, SubGoal0, SubGoal,
|
|
!ConstructMap, !DelayInfo),
|
|
ShortHand = try_goal(MaybeIO, ResultVar, SubGoal),
|
|
GoalExpr = shorthand(ShortHand),
|
|
Goal = hlds_goal(GoalExpr, GoalInfo0)
|
|
;
|
|
ShortHand0 = bi_implication(_, _),
|
|
% These should have been expanded out by now.
|
|
unexpected($pred, "bi_implication")
|
|
)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Handle compound goals.
|
|
%
|
|
|
|
:- pred delay_partial_inst_in_conj(instmap::in,
|
|
list(hlds_goal)::in, list(hlds_goal)::out,
|
|
construct_map::in, construct_map::out,
|
|
delay_partial_inst_info::in, delay_partial_inst_info::out) is det.
|
|
|
|
delay_partial_inst_in_conj(_, [], [], !ConstructMap, !DelayInfo).
|
|
delay_partial_inst_in_conj(InstMap0, [HeadGoal0 | TailGoals0], Goals,
|
|
!ConstructMap, !DelayInfo) :-
|
|
delay_partial_inst_in_goal(InstMap0, HeadGoal0, HeadGoal, !ConstructMap,
|
|
!DelayInfo),
|
|
apply_goal_instmap_delta(HeadGoal0, InstMap0, InstMap1),
|
|
delay_partial_inst_in_conj(InstMap1, TailGoals0, TailGoals, !ConstructMap,
|
|
!DelayInfo),
|
|
goal_to_conj_list(HeadGoal, HeadGoals),
|
|
Goals = HeadGoals ++ TailGoals.
|
|
|
|
:- pred delay_partial_inst_in_disj(instmap::in,
|
|
list(hlds_goal)::in, list(hlds_goal)::out,
|
|
construct_map::in, construct_map::out,
|
|
delay_partial_inst_info::in, delay_partial_inst_info::out) is det.
|
|
|
|
delay_partial_inst_in_disj(_, [], [], !ConstructMap, !DelayInfo).
|
|
delay_partial_inst_in_disj(InstMap0, [Goal0 | Goals0], [Goal | Goals],
|
|
!ConstructMap, !DelayInfo) :-
|
|
% Each time that a variable X is bound to a partially instantiated term
|
|
% with functor f/n somewhere in the disjunction, we want the same set of
|
|
% "canonical" variables to name the individual arguments of f/n.
|
|
% That is why we thread the construct map through the disjunctions,
|
|
% so we don't end up with different canonical variables per disjunct.
|
|
%
|
|
% XXX we depend on the fact that (it seems) after mode checking a
|
|
% variable won't become ground in each of the disjuncts, but rather
|
|
% will become ground after the disjunction as a whole. Otherwise
|
|
% entries could be removed from the construct map in earlier disjuncts
|
|
% that should be visible in later disjuncts. To lift this assumption we
|
|
% would need to use separate construct maps per disjunct, merge them
|
|
% afterwards and renaming variables so that there is only one set of
|
|
% canonical variables.
|
|
%
|
|
delay_partial_inst_in_goal(InstMap0, Goal0, Goal, !ConstructMap,
|
|
!DelayInfo),
|
|
delay_partial_inst_in_disj(InstMap0, Goals0, Goals, !ConstructMap,
|
|
!DelayInfo).
|
|
|
|
:- pred delay_partial_inst_in_cases(instmap::in,
|
|
list(case)::in, list(case)::out, construct_map::in, construct_map::out,
|
|
delay_partial_inst_info::in, delay_partial_inst_info::out) is det.
|
|
|
|
delay_partial_inst_in_cases(_, [], [], !ConstructMap, !DelayInfo).
|
|
delay_partial_inst_in_cases(InstMap0, [Case0 | Cases0], [Case | Cases],
|
|
!ConstructMap, !DelayInfo) :-
|
|
% See comment in delay_partial_inst_in_goals.
|
|
Case0 = case(MainConsId, OtherConsIds, Goal0),
|
|
delay_partial_inst_in_goal(InstMap0, Goal0, Goal, !ConstructMap,
|
|
!DelayInfo),
|
|
Case = case(MainConsId, OtherConsIds, Goal),
|
|
delay_partial_inst_in_cases(InstMap0, Cases0, Cases, !ConstructMap,
|
|
!DelayInfo).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Handle unifications that construct partially instantated terms.
|
|
%
|
|
|
|
:- pred delay_partial_inst_in_partial_construct(hlds_goal_info::in,
|
|
unification::in(unification_construct), hlds_goal::out,
|
|
construct_map::in, construct_map::out,
|
|
delay_partial_inst_info::in, delay_partial_inst_info::out) is det.
|
|
|
|
delay_partial_inst_in_partial_construct(GoalInfo0, Unify, Goal,
|
|
!ConstructMap, !DelayInfo) :-
|
|
Unify = construct(Var, ConsId, Args, ArgModes, _, _, _),
|
|
% Add an entry for Var to the construct map if it doesn't exist
|
|
% already, otherwise look up the canonical variables.
|
|
( if
|
|
map.search(!.ConstructMap, Var, CanonVarsMap0),
|
|
map.search(CanonVarsMap0, ConsId, CanonVars0)
|
|
then
|
|
CanonVars = CanonVars0
|
|
else
|
|
create_canonical_variables(Args, CanonVars, !DelayInfo),
|
|
add_to_construct_map(Var, ConsId, CanonVars, !ConstructMap)
|
|
),
|
|
|
|
% Unify the canonical variables and corresponding ground
|
|
% arguments (if any).
|
|
ModuleInfo = !.DelayInfo ^ dpi_module_info,
|
|
VarTable = !.DelayInfo ^ dpi_var_table,
|
|
ProgContext = goal_info_get_context(GoalInfo0),
|
|
list.filter_map_corresponding3(
|
|
maybe_unify_var_with_ground_var(ModuleInfo, VarTable, ProgContext),
|
|
CanonVars, Args, ArgModes, SubUnifyGoals),
|
|
conj_list_to_goal(SubUnifyGoals, GoalInfo0, Goal),
|
|
|
|
% Mark the procedure as changed.
|
|
!DelayInfo ^ dpi_changed := yes.
|
|
|
|
:- pred create_canonical_variables(list(prog_var)::in, list(prog_var)::out,
|
|
delay_partial_inst_info::in, delay_partial_inst_info::out) is det.
|
|
|
|
create_canonical_variables(OrigVars, CanonVars, !DelayInfo) :-
|
|
VarTable0 = !.DelayInfo ^ dpi_var_table,
|
|
clone_variables(OrigVars, VarTable0, VarTable0, VarTable,
|
|
map.init, Renaming),
|
|
rename_var_list(must_rename, Renaming, OrigVars, CanonVars),
|
|
!DelayInfo ^ dpi_var_table := VarTable.
|
|
|
|
:- pred add_to_construct_map(prog_var::in, cons_id::in, list(prog_var)::in,
|
|
construct_map::in, construct_map::out) is det.
|
|
|
|
add_to_construct_map(Var, ConsId, CanonVars, !ConstructMap) :-
|
|
( if map.search(!.ConstructMap, Var, ConsIdMap0) then
|
|
ConsIdMap1 = ConsIdMap0
|
|
else
|
|
ConsIdMap1 = map.init
|
|
),
|
|
map.det_insert(ConsId, CanonVars, ConsIdMap1, ConsIdMap),
|
|
map.set(Var, ConsIdMap, !ConstructMap).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Handle deconstructions. In some of these, information flows from right to
|
|
% left, i.e. from some of the function symbol's argument variables to the
|
|
% LHS variable, which previously must have been bound to a partially
|
|
% instantiated term.
|
|
%
|
|
|
|
:- pred delay_partial_inst_in_deconstruct(delay_partial_inst_info::in,
|
|
hlds_goal::in, unify_mode::in, unification::in(unification_deconstruct),
|
|
hlds_goal::out, construct_map::in, construct_map::out) is det.
|
|
|
|
delay_partial_inst_in_deconstruct(DelayInfo, Goal0, UnifyMode, Unify, Goal,
|
|
!ConstructMap) :-
|
|
Unify = deconstruct(Var, ConsId, Args, ArgModes, _CanFail, _CanCGC),
|
|
( if
|
|
map.search(!.ConstructMap, Var, CanonVarsMap0),
|
|
map.search(CanonVarsMap0, ConsId, CanonArgs)
|
|
then
|
|
% Unify each ground argument with the corresponding canonical
|
|
% variable.
|
|
ModuleInfo = DelayInfo ^ dpi_module_info,
|
|
VarTable = DelayInfo ^ dpi_var_table,
|
|
ProgContext = goal_info_get_context(GoalInfo0),
|
|
list.filter_map_corresponding3(
|
|
maybe_unify_var_with_ground_var(ModuleInfo, VarTable, ProgContext),
|
|
CanonArgs, Args, ArgModes, SubUnifyGoals),
|
|
|
|
% Construct Var if it should be ground now.
|
|
lookup_var_type(VarTable, Var, Type),
|
|
UnifyMode = unify_modes_li_lf_ri_rf(_, LHSFinalInst, _, _),
|
|
( if inst_is_ground(ModuleInfo, Type, LHSFinalInst) then
|
|
construct_functor(Var, ConsId, CanonArgs, ConstructGoal),
|
|
|
|
% Delete the variable on the LHS from the construct map
|
|
% since it has been constructed.
|
|
map.delete(ConsId, CanonVarsMap0, CanonVarsMap),
|
|
map.det_update(Var, CanonVarsMap, !ConstructMap),
|
|
|
|
ConjList = SubUnifyGoals ++ [ConstructGoal]
|
|
else
|
|
ConjList = SubUnifyGoals
|
|
),
|
|
Goal0 = hlds_goal(_, GoalInfo0),
|
|
conj_list_to_goal(ConjList, GoalInfo0, Goal)
|
|
else
|
|
Goal = Goal0
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Utility predicate used by handling of both partial constructions and
|
|
% deconstructions.
|
|
%
|
|
|
|
:- pred maybe_unify_var_with_ground_var(module_info::in, var_table::in,
|
|
prog_context::in, prog_var::in, prog_var::in, unify_mode::in,
|
|
hlds_goal::out) is semidet.
|
|
|
|
maybe_unify_var_with_ground_var(ModuleInfo, VarTable, Context, LHSVar, RHSVar,
|
|
UnifyMode, Goal) :-
|
|
UnifyMode = unify_modes_li_lf_ri_rf(_, _, RHSInitInst, _),
|
|
lookup_var_type(VarTable, LHSVar, Type),
|
|
inst_is_ground(ModuleInfo, Type, RHSInitInst),
|
|
create_pure_atomic_complicated_unification(LHSVar, rhs_var(RHSVar),
|
|
Context, umc_implicit("delay_partial_inst"), [], Goal).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Handle complicated test unifications.
|
|
%
|
|
|
|
:- pred delay_partial_inst_in_complicated_unify(construct_map::in,
|
|
hlds_goal::in, prog_var::in, unify_rhs::in,
|
|
unification::in(unification_complicated_unify), hlds_goal::out) is det.
|
|
|
|
delay_partial_inst_in_complicated_unify(ConstructMap, Goal0, LHS, RHS0,
|
|
Unify, Goal) :-
|
|
Unify = complicated_unify(_Mode, CanFail, _TypeInfos),
|
|
% Deal with tests generated for calls to implied modes.
|
|
%
|
|
% LHS := f(_),
|
|
% p(RHS),
|
|
% LHS ?= RHS
|
|
% ===>
|
|
% p(RHS),
|
|
% RHS ?= f(_),
|
|
% LHS := RHS
|
|
%
|
|
% XXX I have not seen a case where the LHS and RHS are swapped
|
|
% but we should handle that if it comes up.
|
|
( if
|
|
CanFail = can_fail,
|
|
RHS0 = rhs_var(RHSVar),
|
|
get_sole_cons_id_and_canon_vars(ConstructMap, LHS, ConsId, CanonArgs)
|
|
then
|
|
Goal0 = hlds_goal(_, GoalInfo0),
|
|
ProgContext = goal_info_get_context(GoalInfo0),
|
|
create_pure_atomic_complicated_unification(RHSVar,
|
|
rhs_functor(ConsId, is_not_exist_constr, CanonArgs),
|
|
ProgContext, umc_explicit, [], TestGoal),
|
|
create_pure_atomic_complicated_unification(LHS, RHS0,
|
|
ProgContext, umc_implicit("delay_partial_inst"), [],
|
|
AssignGoal),
|
|
conjoin_goals(TestGoal, AssignGoal, Goal)
|
|
else
|
|
Goal = Goal0
|
|
).
|
|
|
|
:- pred get_sole_cons_id_and_canon_vars(construct_map::in, prog_var::in,
|
|
cons_id::out, list(prog_var)::out) is semidet.
|
|
|
|
get_sole_cons_id_and_canon_vars(ConstructMap, Var, ConsId, CanonVars) :-
|
|
map.search(ConstructMap, Var, CanonVarsMap),
|
|
List = map.to_assoc_list(CanonVarsMap),
|
|
(
|
|
List = [],
|
|
fail
|
|
;
|
|
List = [ConsId - CanonVars | Rest],
|
|
(
|
|
Rest = []
|
|
;
|
|
Rest = [_ | _],
|
|
% This algorithm does not work if a variable could be bound to
|
|
% multiple functors when we try to do a tag test against it.
|
|
% XXX report a nicer error message
|
|
sorry($pred,
|
|
"delaying partial instantiations when variable could be " ++
|
|
"bound to multiple functors")
|
|
)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
:- end_module check_hlds.delay_partial_inst.
|
|
%-----------------------------------------------------------------------------%
|