mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2026-04-15 01:13:30 +00:00
Code Issues Projects Releases Wiki Activity
Files
b28858717f3fd5cd040bc40f2d352431be9bb71d
mercury/compiler/lambda.m
Zoltan Somogyi 33fb4d7618 Fix a mismatch between old and new code. 
compiler/unused_args.m:
    Make the new version of a test succeeds, where the old version
    *looked like* it failed, but did not.

compiler/lambda.m:
    Fix misleading module comment.
2026-02-16 15:23:12 +11:00

991 lines
40 KiB
Mathematica
Raw Blame History

%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 1995-2012 The University of Melbourne.
% Copyright (C) 2013-2026 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: lambda.m.
% Main author: fjh.
%
% This module does lambda expansion, which means that it replaces each
% unification with a lambda expression with the construction of a closure
% whose code address refers to a new predicate that this module creates
% from that lambda expression.
%
% For example, we translate
%
% :- pred p(int::in) is det.
% p(X) :-
% V__1 = (pred(Y::out) is nondet :- q(Y, X)),
% solutions(V__1, List),
% ...
% :- pred q(int::out, int::in) is nondet.
%
% into
%
% :- pred 'IntroducedFrom__...'(int::in, int::out) is nondet.
% 'IntroducedFrom__...'(X, Y) :- q(Y, X).
%
% p(X) :-
% V__1 = closure_cons('IntroducedFrom__...')(X)
% solutions(V__1, List),
% ...
%
% Note that the mode checker requires that lambda expressions
% not bind any of their non-local variables, such as `X' in the above example.
%
% Similarly, a lambda expression may not bind any of the type_infos for
% those variables; that is, none of the non-local variables should be
% existentially typed (from the perspective of the lambda goal).
% Now that we run the polymorphism.m pass before mode checking,
% and that this is also checked by mode analysis.
%
% It might be OK to allow the parameters of the lambda goal to be
% existentially typed, but currently that is not supported.
% One difficulty is that it is hard to determine here which type variables
% should be existentially quantified. The information is readily
% available during type inference, and really type inference should save
% that information in a field in the lambda_goal struct, but currently it
% does not; it saves the head_type_params field in the pred_info, which
% tells us which type variables were produced by the body, but for
% any given lambda goal, we don't know whether the type variable was
% produced by something outside the lambda goal or by something inside
% the lambda goal (only in the latter case should it be existentially
% quantified).
%
% The other difficulty is that taking the address of a predicate with an
% existential type would require second-order polymorphism: for a predicate
% declared as `:- some [T] pred p(int, T)', the expression `p' must have
% type `some [T] pred(int, T)', which is quite a different thing to saying
% that there is some type `T' for which `p' has type `pred(int, T)' --
% we don't know what `T' is until the predicate is called, and it might
% be different for each call.
%
% Currently we don't support second-order polymorphism, so we cannot support
% existentially typed lambda expressions either.
%
%---------------------------------------------------------------------------%
:- module transform_hlds.lambda.
:- interface.
:- import_module hlds.
:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_module.
:- import_module hlds.hlds_pred.
:- import_module hlds.hlds_rtti.
:- import_module parse_tree.
:- import_module parse_tree.prog_data.
:- import_module parse_tree.set_of_var.
:- import_module parse_tree.var_table.
%---------------------------------------------------------------------------%
:- pred expand_lambdas_in_module(module_info::in, module_info::out) is det.
%---------------------------------------------------------------------------%
% The following are exported for float_reg.m.
:- type reg_wrapper_proc
---> reg_wrapper_proc(set_of_progvar)
; not_reg_wrapper_proc.
:- pred expand_lambda(reg_wrapper_proc::in, prog_var::in,
unify_rhs::in(rhs_lambda_goal), unify_mode::in,
unification::in(unification_construct), unify_context::in,
hlds_goal_expr::out, lambda_info::in, lambda_info::out) is det.
:- type lambda_info.
:- pred init_lambda_info(module_info::in, pred_info::in,
tvarset::in, inst_varset::in, var_table::in,
rtti_varmaps::in, has_parallel_conj::in, lambda_info::out) is det.
:- type maybe_recompute_nonlocals
---> need_not_recompute_nonlocals
; must_recompute_nonlocals.
:- pred lambda_info_get_module_info(lambda_info::in, module_info::out) is det.
:- pred lambda_info_get_pred_info(lambda_info::in, pred_info::out) is det.
:- pred lambda_info_get_tvarset(lambda_info::in, tvarset::out) is det.
:- pred lambda_info_get_inst_varset(lambda_info::in, inst_varset::out) is det.
:- pred lambda_info_get_var_table(lambda_info::in, var_table::out) is det.
:- pred lambda_info_get_rtti_varmaps(lambda_info::in, rtti_varmaps::out)
is det.
:- pred lambda_info_get_recompute_nonlocals(lambda_info::in,
maybe_recompute_nonlocals::out) is det.
:- pred lambda_info_set_module_info(module_info::in,
lambda_info::in, lambda_info::out) is det.
:- pred lambda_info_set_var_table(var_table::in,
lambda_info::in, lambda_info::out) is det.
:- pred lambda_info_set_recompute_nonlocals(maybe_recompute_nonlocals::in,
lambda_info::in, lambda_info::out) is det.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
:- import_module check_hlds.
:- import_module check_hlds.mode_test.
:- import_module check_hlds.recompute_instmap_deltas.
:- import_module hlds.code_model.
:- import_module hlds.goal_util.
:- import_module hlds.hlds_markers.
:- import_module hlds.hlds_proc_util.
:- import_module hlds.mode_util.
:- import_module hlds.pred_name.
:- import_module hlds.pred_table.
:- import_module hlds.quantification.
:- import_module hlds.status.
:- import_module hlds.type_util.
:- import_module libs.
:- import_module libs.globals.
:- import_module libs.options.
:- import_module mdbcomp.
:- import_module mdbcomp.prim_data.
:- import_module parse_tree.prog_mode.
:- import_module parse_tree.prog_type_scan.
:- import_module parse_tree.prog_type_test.
:- import_module transform_hlds.direct_arg_in_out.
:- import_module array.
:- import_module assoc_list.
:- import_module bool.
:- import_module int.
:- import_module list.
:- import_module map.
:- import_module maybe.
:- import_module pair.
:- import_module require.
:- import_module set.
:- import_module term.
:- import_module term_context.
:- import_module varset.
%---------------------------------------------------------------------------%
%
% This whole section just traverses the module structure.
%
expand_lambdas_in_module(!ModuleInfo) :-
module_info_get_valid_pred_ids(!.ModuleInfo, PredIds),
list.foldl(expand_lambdas_in_pred, PredIds, !ModuleInfo),
% Need update the dependency graph to include the lambda predicates.
module_info_clobber_dependency_info(!ModuleInfo).
:- pred expand_lambdas_in_pred(pred_id::in, module_info::in, module_info::out)
is det.
expand_lambdas_in_pred(PredId, !ModuleInfo) :-
module_info_pred_info(!.ModuleInfo, PredId, PredInfo),
ProcIds = pred_info_all_procids(PredInfo),
list.foldl(expand_lambdas_in_proc(PredId), ProcIds, !ModuleInfo).
:- pred expand_lambdas_in_proc(pred_id::in, proc_id::in,
module_info::in, module_info::out) is det.
expand_lambdas_in_proc(PredId, ProcId, !ModuleInfo) :-
module_info_pred_info(!.ModuleInfo, PredId, PredInfo0),
pred_info_get_proc_table(PredInfo0, ProcTable0),
map.lookup(ProcTable0, ProcId, ProcInfo0),
do_expand_lambdas_in_proc(ProcInfo0, ProcInfo, PredInfo0, PredInfo1,
!ModuleInfo),
pred_info_get_proc_table(PredInfo1, ProcTable1),
map.det_update(ProcId, ProcInfo, ProcTable1, ProcTable),
pred_info_set_proc_table(ProcTable, PredInfo1, PredInfo),
module_info_set_pred_info(PredId, PredInfo, !ModuleInfo).
:- pred do_expand_lambdas_in_proc(proc_info::in, proc_info::out,
pred_info::in, pred_info::out, module_info::in, module_info::out) is det.
do_expand_lambdas_in_proc(!ProcInfo, !PredInfo, !ModuleInfo) :-
% Grab the appropriate fields from the pred_info and proc_info.
pred_info_get_typevarset(!.PredInfo, TypeVarSet0),
proc_info_get_headvars(!.ProcInfo, HeadVars),
proc_info_get_var_table(!.ProcInfo, VarTable0),
proc_info_get_goal(!.ProcInfo, Goal0),
proc_info_get_rtti_varmaps(!.ProcInfo, RttiVarMaps0),
proc_info_get_inst_varset(!.ProcInfo, InstVarSet0),
proc_info_get_has_parallel_conj(!.ProcInfo, HasParallelConj),
% Process the goal.
Info0 = lambda_info(!.ModuleInfo, !.PredInfo, TypeVarSet0, InstVarSet0,
VarTable0, RttiVarMaps0, HasParallelConj,
need_not_recompute_nonlocals, have_not_expanded_lambdas),
expand_lambdas_in_goal(Goal0, Goal1, Info0, Info1),
Info1 = lambda_info(!:ModuleInfo, _PredInfo, TypeVarSet, _InstVarSet,
VarTable1, RttiVarMaps1, _HasParallelConj,
MustRecomputeNonLocals, HaveExpandedLambdas),
% Check if we need to requantify.
(
MustRecomputeNonLocals = must_recompute_nonlocals,
implicitly_quantify_clause_body_general(ord_nl_no_lambda,
HeadVars, _Warnings, Goal1, Goal2,
VarTable1, VarTable2, RttiVarMaps1, RttiVarMaps2),
proc_info_get_initial_instmap(!.ModuleInfo, !.ProcInfo, InstMap0),
recompute_instmap_delta(recomp_atomics,
VarTable2, InstVarSet0, InstMap0, Goal2, Goal, !ModuleInfo)
;
MustRecomputeNonLocals = need_not_recompute_nonlocals,
Goal = Goal1,
VarTable2 = VarTable1,
RttiVarMaps2 = RttiVarMaps1
),
(
HaveExpandedLambdas = have_expanded_lambdas,
restrict_var_maps(HeadVars, Goal, VarTable2, VarTable,
RttiVarMaps2, RttiVarMaps)
;
HaveExpandedLambdas = have_not_expanded_lambdas,
VarTable = VarTable2,
RttiVarMaps = RttiVarMaps2
),
% Set the new values of the fields in proc_info and pred_info.
proc_info_set_goal(Goal, !ProcInfo),
proc_info_set_var_table(VarTable, !ProcInfo),
proc_info_set_rtti_varmaps(RttiVarMaps, !ProcInfo),
pred_info_set_typevarset(TypeVarSet, !PredInfo).
:- pred expand_lambdas_in_goal(hlds_goal::in, hlds_goal::out,
lambda_info::in, lambda_info::out) is det.
expand_lambdas_in_goal(Goal0, Goal, !Info) :-
Goal0 = hlds_goal(GoalExpr0, GoalInfo),
(
GoalExpr0 = unify(LHS, RHS, Mode, Unification, Context),
expand_lambdas_in_unify_goal(LHS, RHS, Mode, Unification, Context,
GoalExpr, !Info)
;
GoalExpr0 = conj(ConjType, Goals0),
expand_lambdas_in_goal_list(Goals0, Goals, !Info),
GoalExpr = conj(ConjType, Goals)
;
GoalExpr0 = disj(Goals0),
expand_lambdas_in_goal_list(Goals0, Goals, !Info),
GoalExpr = disj(Goals)
;
GoalExpr0 = switch(Var, CanFail, Cases0),
expand_lambdas_in_cases(Cases0, Cases, !Info),
GoalExpr = switch(Var, CanFail, Cases)
;
GoalExpr0 = negation(SubGoal0),
expand_lambdas_in_goal(SubGoal0, SubGoal, !Info),
GoalExpr = negation(SubGoal)
;
GoalExpr0 = scope(Reason, SubGoal0),
( if
Reason = from_ground_term(_, FGT),
( FGT = from_ground_term_construct
; FGT = from_ground_term_deconstruct
)
then
% If the scope had any rhs_lambda_goals, modes.m wouldn't have
% left its kind field as from_ground_term_(de)construct.
GoalExpr = GoalExpr0
else
expand_lambdas_in_goal(SubGoal0, SubGoal, !Info),
GoalExpr = scope(Reason, SubGoal)
)
;
GoalExpr0 = if_then_else(Vars, Cond0, Then0, Else0),
expand_lambdas_in_goal(Cond0, Cond, !Info),
expand_lambdas_in_goal(Then0, Then, !Info),
expand_lambdas_in_goal(Else0, Else, !Info),
GoalExpr = if_then_else(Vars, Cond, Then, Else)
;
( GoalExpr0 = generic_call(_, _, _, _, _)
; GoalExpr0 = plain_call(_, _, _, _, _, _)
; GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _)
),
GoalExpr = GoalExpr0
;
GoalExpr0 = shorthand(ShortHand0),
(
ShortHand0 = atomic_goal(GoalType, Outer, Inner, MaybeOutputVars,
MainGoal0, OrElseGoals0, OrElseInners),
expand_lambdas_in_goal(MainGoal0, MainGoal, !Info),
expand_lambdas_in_goal_list(OrElseGoals0, OrElseGoals, !Info),
ShortHand = atomic_goal(GoalType, Outer, Inner, MaybeOutputVars,
MainGoal, OrElseGoals, OrElseInners)
;
ShortHand0 = try_goal(MaybeIO, ResultVar, SubGoal0),
expand_lambdas_in_goal(SubGoal0, SubGoal, !Info),
ShortHand = try_goal(MaybeIO, ResultVar, SubGoal)
;
ShortHand0 = bi_implication(_, _),
% These should have been expanded out by now.
unexpected($pred, "bi_implication")
),
GoalExpr = shorthand(ShortHand)
),
Goal = hlds_goal(GoalExpr, GoalInfo).
:- pred expand_lambdas_in_goal_list(list(hlds_goal)::in, list(hlds_goal)::out,
lambda_info::in, lambda_info::out) is det.
expand_lambdas_in_goal_list([], [], !Info).
expand_lambdas_in_goal_list([Goal0 | Goals0], [Goal | Goals], !Info) :-
expand_lambdas_in_goal(Goal0, Goal, !Info),
expand_lambdas_in_goal_list(Goals0, Goals, !Info).
:- pred expand_lambdas_in_cases(list(case)::in, list(case)::out,
lambda_info::in, lambda_info::out) is det.
expand_lambdas_in_cases([], [], !Info).
expand_lambdas_in_cases([Case0 | Cases0], [Case | Cases], !Info) :-
Case0 = case(MainConsId, OtherConsIds, Goal0),
expand_lambdas_in_goal(Goal0, Goal, !Info),
Case = case(MainConsId, OtherConsIds, Goal),
expand_lambdas_in_cases(Cases0, Cases, !Info).
:- pred expand_lambdas_in_unify_goal(prog_var::in, unify_rhs::in,
unify_mode::in, unification::in, unify_context::in, hlds_goal_expr::out,
lambda_info::in, lambda_info::out) is det.
expand_lambdas_in_unify_goal(LHSVar, RHS0, UnifyMode, Unification0,
UnifyContext, GoalExpr, !Info) :-
(
RHS0 = rhs_lambda_goal(Purity, Groundness, PredOrFunc, NonLocals,
ArgVarsModes, Detism, LambdaGoal0),
% First, process the lambda goal recursively, in case it contains
% some nested lambda expressions.
expand_lambdas_in_goal(LambdaGoal0, LambdaGoal, !Info),
RHS = rhs_lambda_goal(Purity, Groundness, PredOrFunc, NonLocals,
ArgVarsModes, Detism, LambdaGoal),
(
Unification0 = construct(_, _, _, _, _, _, _),
% Then, convert the lambda expression into a new predicate.
expand_lambda(not_reg_wrapper_proc, LHSVar, RHS, UnifyMode,
Unification0, UnifyContext, GoalExpr, !Info)
;
( Unification0 = deconstruct(_, _, _, _, _, _)
; Unification0 = assign(_, _)
; Unification0 = simple_test(_, _)
; Unification0 = complicated_unify(_, _, _)
),
unexpected($pred, "unexpected unification")
)
;
( RHS0 = rhs_var(_)
; RHS0 = rhs_functor(_, _, _)
),
% We leave ordinary unifications unchanged.
GoalExpr = unify(LHSVar, RHS0, UnifyMode, Unification0, UnifyContext)
).
%---------------------------------------------------------------------------%
expand_lambda(RegWrapperProc, LHSVar, RHS0, UnifyMode,
Unification0, UnifyContext, GoalExpr, LambdaInfo0, LambdaInfo) :-
LambdaInfo0 = lambda_info(ModuleInfo0, OrigPredInfo, TVarSet, InstVarSet,
VarTable, RttiVarMaps, HasParallelConj,
MustRecomputeNonLocals0, _HaveExpandedLambdas),
RHS0 = rhs_lambda_goal(_Purity, _Groundness, PredOrFunc, RHSNonLocals,
VarsModes, Detism, LambdaGoal),
assoc_list.keys(VarsModes, Vars),
Unification0 = construct(Var, _, ArgVars0, ArgUnifyModes0, _, _, _),
trace [compiletime(flag("lambda_sanity_check"))]
(
expect(unify(LHSVar, Var), $pred, "LHSVar != Var"),
list.sort(RHSNonLocals, SortedRHSNonLocals),
list.sort(ArgVars0, SortedArgVars0),
expect(unify(SortedRHSNonLocals, SortedArgVars0), $pred,
"RHSNonLocals != ArgVars0")
),
( if
can_we_use_existing_pred(ModuleInfo0, PredOrFunc, Vars, Detism,
LambdaGoal, PredId0, ProcId0, CalleePredInfo, CalleeProcInfo0,
CurriedArgVars, ArgUnifyModes1)
then
PredId = PredId0,
ProcId = ProcId0,
ArgVars = CurriedArgVars,
ArgUnifyModes = ArgUnifyModes1,
% We must mark the procedure as having had its address taken.
proc_info_set_address_taken(address_is_taken,
CalleeProcInfo0, CalleeProcInfo),
module_info_set_pred_proc_info(PredId, ProcId,
CalleePredInfo, CalleeProcInfo, ModuleInfo0, ModuleInfo),
MustRecomputeNonLocals = MustRecomputeNonLocals0
else
create_new_pred_for_lambda(RegWrapperProc, RHS0, ArgVars0, ArgVars,
PredId, ProcId, ArgUnifyModes0, ArgUnifyModes,
MustRecomputeNonLocals0, MustRecomputeNonLocals,
LambdaInfo0, ModuleInfo)
),
ShroudedPredProcId = shroud_pred_proc_id(proc(PredId, ProcId)),
ConsId = closure_cons(ShroudedPredProcId),
RHS = rhs_functor(ConsId, is_not_exist_constr, ArgVars),
Unification = construct(Var, ConsId, ArgVars, ArgUnifyModes,
construct_dynamically, cell_is_unique, no_construct_sub_info),
GoalExpr = unify(LHSVar, RHS, UnifyMode, Unification, UnifyContext),
LambdaInfo = lambda_info(ModuleInfo, OrigPredInfo, TVarSet, InstVarSet,
VarTable, RttiVarMaps, HasParallelConj,
MustRecomputeNonLocals, have_expanded_lambdas).
%---------------------%
% We would like to optimize a special case: replacing
% `(pred(Y1, Y2, ...) is Detism :-
% p(X1, X2, ..., Y1, Y2, ...))'
% where `p' has determinism `Detism', with
% `p(X1, X2, ...)'
%
% This optimization is only valid if the modes of the Xi are input,
% since only input arguments can be curried. It is also only valid
% if all the inputs in the Yi precede the outputs. It is also not valid
% if any of the Xi are in the Yi.
%
:- pred can_we_use_existing_pred(module_info::in, pred_or_func::in,
list(prog_var)::in, determinism::in, hlds_goal::in,
pred_id::out, proc_id::out, pred_info::out, proc_info::out,
list(prog_var)::out, list(unify_mode)::out) is semidet.
can_we_use_existing_pred(ModuleInfo, PredOrFunc, Vars, Detism, LambdaGoal,
PredId, ProcId, CalleePredInfo, CalleeProcInfo,
CurriedArgVars, CurriedArgUnifyModes) :-
LambdaGoal = hlds_goal(LambdaGoalExpr, _),
LambdaGoalExpr = plain_call(PredId, ProcId, CallVars, _, _, _),
module_info_pred_proc_info(ModuleInfo, PredId, ProcId,
CalleePredInfo, CalleeProcInfo),
% If this succeeds, then
% - Vars are the Yi above;
% - InitialVars are the Xi; and
% - CallVars are the Xi followed by the Yi.
% Thus InitialVars are the variables we put into the curried closure.
list.remove_suffix(CallVars, Vars, CurriedArgVars),
% Check that none of the variables that we are trying to use
% as curried arguments are lambda-bound variables.
set.list_to_set(CurriedArgVars, CurriedArgVarsSet),
set.list_to_set(Vars, VarsSet),
set.intersect(CurriedArgVarsSet, VarsSet, BothSet),
set.is_empty(BothSet),
% Check that the curried arguments are all input.
proc_info_get_argmodes(CalleeProcInfo, CalleeArgModes),
list.length(CurriedArgVars, NumCurriedArgVars),
list.take(NumCurriedArgVars, CalleeArgModes, CurriedArgModes),
list.all_true(mode_is_input(ModuleInfo), CurriedArgModes),
modes_to_unify_modes(ModuleInfo, CurriedArgModes, CurriedArgModes,
CurriedArgUnifyModes),
% Check that the code models are compatible. Note that det is not
% compatible with semidet, and semidet is not compatible with nondet,
% since the calling conventions are different. If we are using the LLDS
% backend, det is compatible with nondet. If we are using the MLDS
% backend, then predicates and functions have different calling
% conventions.
CalleeCodeModel = proc_info_interface_code_model(CalleeProcInfo),
determinism_to_code_model(Detism, CodeModel),
module_info_get_globals(ModuleInfo, Globals),
globals.lookup_bool_option(Globals, highlevel_code, HighLevelCode),
(
HighLevelCode = no,
(
CodeModel = CalleeCodeModel
;
CodeModel = model_non,
CalleeCodeModel = model_det
)
;
HighLevelCode = yes,
CalleePredOrFunc = pred_info_is_pred_or_func(CalleePredInfo),
PredOrFunc = CalleePredOrFunc,
CodeModel = CalleeCodeModel
).
%---------------------%
:- pred create_new_pred_for_lambda(reg_wrapper_proc::in,
unify_rhs::in(rhs_lambda_goal), list(prog_var)::in, list(prog_var)::out,
pred_id::out, proc_id::out, list(unify_mode)::in, list(unify_mode)::out,
maybe_recompute_nonlocals::in, maybe_recompute_nonlocals::out,
lambda_info::in, module_info::out) is det.
create_new_pred_for_lambda(RegWrapperProc, RHS0, OrigVars, ArgVars,
PredId, ProcId, ArgUnifyModes0, ArgUnifyModes, !MustRecomputeNonLocals,
LambdaInfo0, !:ModuleInfo) :-
LambdaInfo0 = lambda_info(!:ModuleInfo, OrigPredInfo, TVarSet,
InstVarSet, VarTable, RttiVarMaps, HasParallelConj,
MustRecomputeNonLocals0, _HaveExpandedLambdas),
RHS0 = rhs_lambda_goal(Purity, _Groundness, PredOrFunc, _ClosureVars,
LambdaVarsModes, Detism, LambdaGoal),
assoc_list.keys_and_values(LambdaVarsModes, LambdaVars, LambdaVarModes),
LambdaGoal = hlds_goal(_, LambdaGoalInfo),
% Calculate the constraints which apply to this lambda expression.
% Note currently we only allow lambda expressions to have universally
% quantified constraints.
rtti_varmaps_reusable_constraints(RttiVarMaps, AllConstraints),
lookup_var_types(VarTable, LambdaVars, LambdaVarTypeList),
set_of_type_vars_in_types(LambdaVarTypeList, LambdaTypeVars),
list.filter(constraint_contains_only_lambda_tvars(LambdaTypeVars),
AllConstraints, UnivConstraints),
Constraints = univ_exist_constraints(UnivConstraints, []),
% Existentially typed lambda expressions are not yet supported
% (see the documentation at top of this file).
ExistQVars = [],
LambdaGoalNonLocals = goal_info_get_nonlocals(LambdaGoalInfo),
set_of_var.insert_list(LambdaVars, LambdaGoalNonLocals, LambdaNonLocals),
extra_nonlocal_typeinfos_typeclass_infos(RttiVarMaps, VarTable,
ExistQVars, LambdaNonLocals, ExtraTiTcis),
set_of_var.delete_list(LambdaVars, LambdaGoalNonLocals, NonLocals1),
% We need all the typeinfos, including the ones that are not used,
% for the layout structure describing the closure.
set_of_var.difference(ExtraTiTcis, NonLocals1, NewTiTcis),
set_of_var.union(NonLocals1, NewTiTcis, NonLocals),
set_of_var.to_sorted_list(NonLocals, ArgVars1),
( if set_of_var.is_empty(NewTiTcis) then
true
else
% If we added variables to the nonlocals of the lambda goal, then
% we must recompute the nonlocals for the procedure that contains it.
!:MustRecomputeNonLocals = must_recompute_nonlocals
),
% Prepare to create a new predicate for the lambda expression:
% work out the arguments, module name, predicate name, arity,
% arg types, determinism, context, status, etc. for the new predicate.
ArgVars = put_typeinfo_vars_first(VarTable, ArgVars1),
AllArgVars = ArgVars ++ LambdaVars,
module_info_get_name(!.ModuleInfo, ModuleName),
OrigPredName = pred_info_name(OrigPredInfo),
OrigContext = goal_info_get_context(LambdaGoalInfo),
OrigContext = context(OrigFile, OrigLine),
module_info_next_lambda_count(OrigLine, LambdaCount, !ModuleInfo),
Transform = tn_lambda(PredOrFunc, lnc(OrigLine, LambdaCount)),
make_transformed_pred_name(OrigPredName, Transform, TransformedName),
LambdaContext = goal_info_get_context(LambdaGoalInfo),
% The TVarSet is a superset of what it really ought be,
% but that should not matter.
unify_modes_to_modes(ArgUnifyModes0, OrigArgModes),
% We have to jump through hoops to work out the mode of the lambda
% predicate. For introduced type_info arguments, we use the mode "in".
% For the original non-local vars, we use the modes from `ArgUnifyModes0'.
% For the lambda var arguments at the end, we use the mode in the
% lambda expression.
% XXX The above comment has probably suffered bit-rot.
list.length(ArgVars, NumArgVars),
in_mode(In),
list.duplicate(NumArgVars, In, InModes),
map.from_corresponding_lists(ArgVars, InModes, ArgModesMap),
map.from_corresponding_lists(OrigVars, OrigArgModes, OrigArgModesMap),
map.overlay(ArgModesMap, OrigArgModesMap, ArgModesMap1),
map.apply_to_list(ArgVars, ArgModesMap1, ArgModes1),
% Recompute the unify_modes.
modes_to_unify_modes(!.ModuleInfo, ArgModes1, ArgModes1, ArgUnifyModes),
AllArgModes = ArgModes1 ++ LambdaVarModes,
lookup_var_types(VarTable, AllArgVars, ArgTypes),
list.foldl_corresponding(check_lambda_arg_type_and_mode(!.ModuleInfo),
ArgTypes, AllArgModes, 0, _),
purity_to_markers(Purity, PurityMarkers),
init_markers(LambdaMarkers0),
add_markers(PurityMarkers, LambdaMarkers0, LambdaMarkers),
% Now construct the proc_info and pred_info for the new single-mode
% predicate, using the information computed above.
map.init(VarNameRemap),
restrict_var_maps(AllArgVars, LambdaGoal, VarTable, LambdaVarTable,
RttiVarMaps, LambdaRttiVarMaps),
some [!ProcInfo] (
% If the original procedure contained parallel conjunctions,
% then the one we are creating here may have them as well.
% If it does not, then the value in the proc_info of the lambda
% predicate will be an overconservative estimate.
SeqNum = item_no_seq_num,
proc_info_create(LambdaContext, SeqNum, LambdaVarTable,
AllArgVars, InstVarSet, AllArgModes, detism_decl_explicit, Detism,
LambdaGoal, LambdaRttiVarMaps, address_is_taken,
HasParallelConj, VarNameRemap, !:ProcInfo),
% The debugger ignores unnamed variables.
ensure_all_headvars_are_named(!ProcInfo),
% If we previously already needed to recompute the nonlocals,
% then we had better apply that recomputation for the procedure
% that we just created.
(
MustRecomputeNonLocals0 = must_recompute_nonlocals,
requantify_proc_general(ord_nl_maybe_lambda, !ProcInfo)
;
MustRecomputeNonLocals0 = need_not_recompute_nonlocals
),
(
RegWrapperProc = reg_wrapper_proc(RegRHeadVars),
proc_info_set_reg_r_headvars(RegRHeadVars, !ProcInfo)
;
RegWrapperProc = not_reg_wrapper_proc
),
ProcInfo = !.ProcInfo
),
Origin = origin_user(user_made_lambda(OrigFile, OrigLine, LambdaCount)),
set.init(Assertions),
GoalType = goal_not_for_promise(np_goal_type_none),
pred_info_create(PredOrFunc, ModuleName, TransformedName,
LambdaContext, Origin, pred_status(status_local), LambdaMarkers,
ArgTypes, TVarSet, ExistQVars, Constraints, Assertions, VarNameRemap,
GoalType, ProcInfo, ProcId, PredInfo),
% Save the new predicate in the predicate table.
module_info_get_predicate_table(!.ModuleInfo, PredicateTable0),
predicate_table_insert(PredInfo, PredId, PredicateTable0, PredicateTable),
module_info_set_predicate_table(PredicateTable, !ModuleInfo),
find_and_record_any_direct_arg_in_out_posns(PredId, ProcId, LambdaVarTable,
AllArgVars, AllArgModes, !ModuleInfo).
:- pred constraint_contains_only_lambda_tvars(set(tvar)::in,
prog_constraint::in) is semidet.
constraint_contains_only_lambda_tvars(LambdaTVars, ClassConstraint) :-
ClassConstraint = constraint(_, ConstraintTypes),
set_of_type_vars_in_types(ConstraintTypes, ConstraintTVars),
set.subset(ConstraintTVars, LambdaTVars).
% This predicate works out the modes of the original non-local variables
% of a lambda expression based on the list of unify_mode in the unify_info
% for the lambda unification.
%
:- pred unify_modes_to_modes(list(unify_mode)::in, list(mer_mode)::out) is det.
unify_modes_to_modes([], []).
unify_modes_to_modes([UnifyMode | UnifyModes], [Mode | Modes]) :-
UnifyMode = unify_modes_li_lf_ri_rf(_, _, RHSInit, _RHSFinal),
Mode = from_to_mode(RHSInit, RHSInit),
unify_modes_to_modes(UnifyModes, Modes).
% Make sure the arguments and modes are not misordered. An obvious
% indicator is if a non-higher order argument is paired a higher order
% inst.
%
:- pred check_lambda_arg_type_and_mode(module_info::in, mer_type::in,
mer_mode::in, int::in, int::out) is det.
check_lambda_arg_type_and_mode(ModuleInfo, Type, Mode, X, X) :-
Inst = mode_get_initial_inst(ModuleInfo, Mode),
( if Inst = ground(_, higher_order(_)) then
( if type_is_higher_order(Type) then
true
else
unexpected($pred,
"non-higher order argument with higher order inst")
)
else
true
).
%---------------------------------------------------------------------------%
% The proc_info has several maps that refer to variables. After lambda
% expansion, both the newly created procedures and the original procedure
% that they were carved out of have duplicate copies of these maps.
% This duplication is a problem because later passes (in particular,
% the equiv_types_hlds pass) iterate over the entries in these maps,
% and if an entry is duplicated N times, they have to process it N times.
% The task of this predicate is to eliminate unnecessary entries
% from the var_table, and this requires also eliminating them from
% the rtti_varmaps.
%
% We could in theory restrict the tvarset and the inst_varset as well,
% but since we don't iterate over those sets, there is (as yet) no need
% for this.
%
:- pred restrict_var_maps(list(prog_var)::in, hlds_goal::in,
var_table::in, var_table::out, rtti_varmaps::in, rtti_varmaps::out) is det.
restrict_var_maps(HeadVars, Goal, !VarTable, !RttiVarMaps) :-
var_table_max_var_num(!.VarTable, MaxVarNum),
% Variable numbers go from 1 to MaxVarNum. Reserve array slots
% from 0 to MaxVarNum, since wasting the space of one array element
% is preferable to having to do a subtraction on every array lookup.
array.init(MaxVarNum + 1, no, VarUses0),
mark_vars_as_used(HeadVars, VarUses0, VarUses1),
find_used_vars_in_goal(Goal, VarUses1, VarUses),
var_table_to_sorted_assoc_list(!.VarTable, VarTableEntries0),
filter_var_table_entries(VarTableEntries0, VarUses,
[], RevVarTableEntries),
var_table_from_rev_sorted_assoc_list(RevVarTableEntries, !:VarTable),
restrict_rtti_varmaps(VarUses, !RttiVarMaps).
:- pred find_used_vars_in_goal(hlds_goal::in,
array(bool)::array_di, array(bool)::array_uo) is det.
find_used_vars_in_goal(Goal, !VarUses) :-
Goal = hlds_goal(GoalExpr, _GoalInfo),
(
GoalExpr = unify(LHSVar, RHS, _, Unif, _),
mark_var_as_used(LHSVar, !VarUses),
(
Unif = construct(_, _, _, _, CellToReuse, _, _),
( if CellToReuse = reuse_cell(cell_to_reuse(ReuseVar, _, _)) then
mark_var_as_used(ReuseVar, !VarUses)
else
true
)
;
( Unif = deconstruct(_, _, _, _, _, _)
; Unif = assign(_, _)
; Unif = simple_test(_, _)
; Unif = complicated_unify(_, _, _)
)
),
find_used_vars_in_unify_rhs(RHS, !VarUses)
;
GoalExpr = generic_call(GenericCall, ArgVars, _, _, _),
(
GenericCall = higher_order(Var, _, _, _, _),
mark_var_as_used(Var, !VarUses)
;
GenericCall = class_method(Var, _, _, _),
mark_var_as_used(Var, !VarUses)
;
GenericCall = event_call(_)
;
GenericCall = cast(_)
),
mark_vars_as_used(ArgVars, !VarUses)
;
GoalExpr = plain_call(_, _, ArgVars, _, MaybeCallUnifyContext, _),
mark_vars_as_used(ArgVars, !VarUses),
(
MaybeCallUnifyContext = no
;
MaybeCallUnifyContext = yes(CallUnifyContext),
CallUnifyContext = call_unify_context(Var, RHS, _UC),
mark_var_as_used(Var, !VarUses),
find_used_vars_in_unify_rhs(RHS, !VarUses)
)
;
( GoalExpr = conj(_, Goals)
; GoalExpr = disj(Goals)
),
find_used_vars_in_goals(Goals, !VarUses)
;
GoalExpr = switch(Var, _Det, Cases),
mark_var_as_used(Var, !VarUses),
find_used_vars_in_cases(Cases, !VarUses)
;
GoalExpr = scope(Reason, SubGoal),
(
Reason = exist_quant(Vars, _),
mark_vars_as_used(Vars, !VarUses)
;
Reason = promise_solutions(Vars, _),
mark_vars_as_used(Vars, !VarUses)
;
Reason = from_ground_term(Var, _),
mark_var_as_used(Var, !VarUses)
;
Reason = loop_control(LCVar, LCSVar, _),
mark_var_as_used(LCVar, !VarUses),
mark_var_as_used(LCSVar, !VarUses)
;
( Reason = disable_warnings(_, _)
; Reason = promise_purity(_)
; Reason = barrier(_)
; Reason = commit(_)
; Reason = trace_goal(_, _, _, _, _)
)
% Do nothing.
;
( Reason = require_detism(_)
; Reason = require_complete_switch(_)
; Reason = require_switch_arms_detism(_, _)
),
% These scopes should have been deleted by now.
unexpected($pred, "unexpected scope")
),
find_used_vars_in_goal(SubGoal, !VarUses)
;
GoalExpr = negation(SubGoal),
find_used_vars_in_goal(SubGoal, !VarUses)
;
GoalExpr = if_then_else(Vars, Cond, Then, Else),
mark_vars_as_used(Vars, !VarUses),
find_used_vars_in_goal(Cond, !VarUses),
find_used_vars_in_goal(Then, !VarUses),
find_used_vars_in_goal(Else, !VarUses)
;
GoalExpr = call_foreign_proc(_, _, _, Args, ExtraArgs, _, _),
ArgVars = list.map(foreign_arg_var, Args),
ExtraVars = list.map(foreign_arg_var, ExtraArgs),
mark_vars_as_used(ArgVars, !VarUses),
mark_vars_as_used(ExtraVars, !VarUses)
;
GoalExpr = shorthand(Shorthand),
(
Shorthand = atomic_goal(_, Outer, Inner, MaybeOutputVars,
MainGoal, OrElseGoals, _),
Outer = atomic_interface_vars(OuterDI, OuterUO),
mark_var_as_used(OuterDI, !VarUses),
mark_var_as_used(OuterUO, !VarUses),
Inner = atomic_interface_vars(InnerDI, InnerUO),
mark_var_as_used(InnerDI, !VarUses),
mark_var_as_used(InnerUO, !VarUses),
(
MaybeOutputVars = no
;
MaybeOutputVars = yes(OutputVars),
mark_vars_as_used(OutputVars, !VarUses)
),
find_used_vars_in_goal(MainGoal, !VarUses),
find_used_vars_in_goals(OrElseGoals, !VarUses)
;
Shorthand = try_goal(_, _, SubGoal),
% The IO and Result variables would be in SubGoal.
find_used_vars_in_goal(SubGoal, !VarUses)
;
Shorthand = bi_implication(LeftGoal, RightGoal),
find_used_vars_in_goal(LeftGoal, !VarUses),
find_used_vars_in_goal(RightGoal, !VarUses)
)
).
:- pred find_used_vars_in_goals(list(hlds_goal)::in,
array(bool)::array_di, array(bool)::array_uo) is det.
find_used_vars_in_goals([], !VarUses).
find_used_vars_in_goals([Goal | Goals], !VarUses) :-
find_used_vars_in_goal(Goal, !VarUses),
find_used_vars_in_goals(Goals, !VarUses).
:- pred find_used_vars_in_cases(list(case)::in,
array(bool)::array_di, array(bool)::array_uo) is det.
find_used_vars_in_cases([], !VarUses).
find_used_vars_in_cases([Case | Cases], !VarUses) :-
Case = case(_, _, Goal),
find_used_vars_in_goal(Goal, !VarUses),
find_used_vars_in_cases(Cases, !VarUses).
:- pred find_used_vars_in_unify_rhs(unify_rhs::in,
array(bool)::array_di, array(bool)::array_uo) is det.
find_used_vars_in_unify_rhs(RHS, !VarUses) :-
(
RHS = rhs_var(RHSVar),
mark_var_as_used(RHSVar, !VarUses)
;
RHS = rhs_functor(_, _, ArgVars),
mark_vars_as_used(ArgVars, !VarUses)
;
RHS = rhs_lambda_goal(_, _, _, NonLocals, ArgVarsModes, _, LambdaGoal),
assoc_list.keys(ArgVarsModes, ArgVars),
mark_vars_as_used(NonLocals, !VarUses),
mark_vars_as_used(ArgVars, !VarUses),
find_used_vars_in_goal(LambdaGoal, !VarUses)
).
:- pred mark_var_as_used(prog_var::in,
array(bool)::array_di, array(bool)::array_uo) is det.
:- pragma inline(pred(mark_var_as_used/3)).
mark_var_as_used(Var, !VarUses) :-
array.set(var_to_int(Var), yes, !VarUses).
:- pred mark_vars_as_used(list(prog_var)::in,
array(bool)::array_di, array(bool)::array_uo) is det.
mark_vars_as_used([], !VarUses).
mark_vars_as_used([Var | Vars], !VarUses) :-
mark_var_as_used(Var, !VarUses),
mark_vars_as_used(Vars, !VarUses).
:- pred filter_var_table_entries(assoc_list(prog_var, var_table_entry)::in,
array(bool)::in,
assoc_list(prog_var, var_table_entry)::in,
assoc_list(prog_var, var_table_entry)::out) is det.
filter_var_table_entries([], _VarUses, !RevVarsEntries).
filter_var_table_entries([VarEntry | VarsEntries], VarUses, !RevVarsEntries) :-
VarEntry = Var - _Entry,
VarNum = var_to_int(Var),
array.unsafe_lookup(VarUses, VarNum, Used),
(
Used = yes,
!:RevVarsEntries = [VarEntry | !.RevVarsEntries]
;
Used = no
),
filter_var_table_entries(VarsEntries, VarUses, !RevVarsEntries).
%---------------------------------------------------------------------------%
:- type lambda_info
---> lambda_info(
li_module_info :: module_info,
li_pred_info :: pred_info,
li_tvarset :: tvarset,
li_inst_varset :: inst_varset,
li_var_table :: var_table,
li_rtti_varmaps :: rtti_varmaps,
li_has_parallel_conj :: has_parallel_conj,
% Do we need to recompute the nonlocals?
li_recompute_nonlocals :: maybe_recompute_nonlocals,
% Have we expanded some lambda expressions?
li_have_expanded_lambda :: have_we_expanded_lambdas
).
:- type have_we_expanded_lambdas
---> have_not_expanded_lambdas
; have_expanded_lambdas.
init_lambda_info(ModuleInfo, PredInfo, TypeVarSet, InstVarSet, VarTable,
RttiVarMaps, HasParallelConj, Info) :-
Info = lambda_info(ModuleInfo, PredInfo, TypeVarSet, InstVarSet, VarTable,
RttiVarMaps, HasParallelConj,
need_not_recompute_nonlocals, have_not_expanded_lambdas).
lambda_info_get_module_info(Info, X) :-
X = Info ^ li_module_info.
lambda_info_get_pred_info(Info, X) :-
X = Info ^ li_pred_info.
lambda_info_get_tvarset(Info, X) :-
X = Info ^ li_tvarset.
lambda_info_get_inst_varset(Info, X) :-
X = Info ^ li_inst_varset.
lambda_info_get_var_table(Info, X) :-
X = Info ^ li_var_table.
lambda_info_get_rtti_varmaps(Info, X) :-
X = Info ^ li_rtti_varmaps.
lambda_info_get_recompute_nonlocals(Info, X) :-
X = Info ^ li_recompute_nonlocals.
lambda_info_set_module_info(X, !Info) :-
!Info ^ li_module_info := X.
lambda_info_set_var_table(X, !Info) :-
!Info ^ li_var_table := X.
lambda_info_set_recompute_nonlocals(X, !Info) :-
!Info ^ li_recompute_nonlocals := X.
%---------------------------------------------------------------------------%
:- end_module transform_hlds.lambda.
%---------------------------------------------------------------------------%
Reference in New Issue View Git Blame Copy Permalink