mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2025-12-18 07:15:19 +00:00
Code Issues Projects Releases Wiki Activity
Files
d4bbcda309ebe07bcac75d23c5cb10a6f17dc852
mercury/compiler/lambda.m
Zoltan Somogyi 62d7496a7e Significant further improvements in the worst-case behavior of the compiler 
Estimated hours taken: 16
Branches: main

Significant further improvements in the worst-case behavior of the compiler
when working on code such as zm_eq20.m and zm_coerce_tuples.m. On my laptop,
zm_eq20.m and zm_coerce_tuples.m now compile in 2.5s and 12.9s respectively;
the times before were 86.4s and 54.0s. The sizes of the stage 110 HLDS dumps
(the stage just after lambda expansion) go from 8.5Mb and 760Mb (!) to
just 0.4Mb and 7.4Mb respectively.

compiler/polymorphism.m:
	Remember not just which typeinfos we have constructed, but also what
	type_ctor_infos, base_typeclass_infos and typeclass_infos we have
	constructed, so that we don't have to construct them again for code
	that is executed later.

	The maintenance of the additional maps adds some overhead that in
	typical code probably cannot be made back through the resulting
	reductions in the workload of later compiler passes. However,
	the avoidance of horrible worst-case behavior trumps small increases
	in normal-case runtime.

	For zm_coerce_tuples, polymorphism.m now generates as good HLDS code
	as can be expected within each lambda expression. There is still
	a lot of duplicated code, with each copy being in a different lambda
	expression, but factoring out these commonalities will require a
	fundamentally different approach.

	Avoid using the misleading prefix "TypeClassInfo_" on the names of
	variables holding base_typeclass_infos.

compiler/ml_elim_nested.m:
	Don't look for static definitions where they cannot occur anymore.

	When deciding whether a definition needs to be hoisted out,
	don't look for it being used in later static definitions,
	since all the static definitions are now elsewhere.

	In order to avoid running the compiler out of nondet stack space
	on zm_coerce_tuples.m, avoid the use of enumerating all the
	definitions in a potentially huge piece of MLDS by backtracking.

compiler/hlds_rtti.m:
	Avoid enumerating all the members of a potentially huge list
	by backtracking in order to avoid running the compiler out of nondet
	stack space on zm_coerce_tuples.m.

	I first tried to do this by constructing the list with det code,
	but this turned out not to fix the underlying problem, which was that
	almost all of the list's elements were copies of each other, and we
	then had to get rid of the copies. The actual fix is to gather the
	types we need directly as a set.

	Provide restrict_rtti_varmaps for use by lambda.m.

	Give the field names of the rtti_varmaps type a distinguishing prefix.

compiler/lambda.m:
	The fundamental reason for the bad performance of the equiv_type_hlds
	pass on zm_coerce_tuples.m was that even with the recent improvements
	to polymorphism.m, a couple of big predicates had about ten thousand
	variables each, and when lambda.m created about 200 new procedures
	from the lambda expressions inside them, it duplicated those huge
	vartypes and rtti_varmaps for each one.

	The fix is to restrict the vartypes and the rtti_varmaps of both
	the newly created procedures and the old procedure they were taken from
	to the variables that actually occur in them.

	We could potentially avoid the need to restrict the rtti_varmap
	of the original procedure for the new procedures created for lambda
	goals by having polymorphism.m give each rhs_lambda_goal its own
	rtti_varmap in the first place, but that would be future work.

	Use the "no lambda" version of quantification after the lambda pass,
	since we have just removed all the lambdas from the goal being
	quantified.

	Give the predicates of this module more expressive names.

compiler/mercury_compile.m:
	Conform to the change in lambda.m.

compiler/equiv_type_hlds.m:
	Use specialized versions of the predicates in equiv_type.m, since
	the general versions do some things (finding circularities, recording
	used modules) that this pass does not need. Use some new predicates
	from the standard library to reduce overhead.

compiler/ml_optimize.m:
	In order to avoid running the compiler out of nondet stack space
	on zm_coerce_tuples.m, avoid the use of enumerating all the members
	of a potentially huge list by backtracking.

	Move a cheap test before a more expensive one.

compiler/modes.m:
compiler/modecheck_unify.m:
	Avoid some unnecessary overheads when modechecking typeinfos and
	related variables. One overhead was iteration over a list of exactly
	one element, another is a redundant lookup of the variable's type,
	and the third is the redundant setting of the unify context.

compiler/inst_match.m:
	Use set_tree234s instead sets to keep track of expansions in one group
	of predicates indicated by benchmarking.

library/list.m:
	Add a new predicate, list.find_first_match, which is a version of
	filter that returns only the first matching item. This is for use
	in ml_elim_nested.m.

	Make list.sort_and_remove_dups remove duplicates as it goes,
	not all at the end, since this (a) allows us to avoid a separate
	duplicate-elimination pass at the end, and (b) any duplicate eliminated
	in one merge pass reduces the workload for any later merge passes.

	Put some code in its proper order, since preserving tail recursion
	in Prolog is no longer an issue.

library/map.m:
	Add  versions of map.foldl{,2,3} and map.map_foldl{,2,3} that do not
	pass the key to the higher order argument, for use by some of the
	compiler modules above.

	Group the declarations of all the foldr predicates together.

library/tree.m:
	Make the same changes as in map.m, in order to implement map.m's new
	predicates.

library/varset.m:
	Minor style improvements.

library/set_tree234.m:
	Fix a wrong comment.

NEWS:
	Mention the new additions to the library.
2009-09-16 02:32:56 +00:00

843 lines
34 KiB
Mathematica
Raw Blame History

%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 1995-2009 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
%
% File: lambda.m.
% Main author: fjh.
%
% This module is a pass over the HLDS to deal with lambda expressions.
%
% Lambda expressions are converted into separate predicates, so 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
%
% p(X) :-
% V__1 = '__LambdaGoal__1'(X)
% solutions(V__1, List),
% ...
%
% :- pred '__LambdaGoal__1'(int::in, int::out) is nondet.
% '__LambdaGoal__1'(X, Y) :- q(Y, X).
%
%
% Note that the mode checker requires that a lambda expression
% not bind any of the 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, 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's 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
% doesn't; it saves the head_type_params field in the pred_info, which
% tells us which type variables where 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
% don't support existentially typed lambda expressions either.
%
%-----------------------------------------------------------------------------%
:- module transform_hlds.lambda.
:- interface.
:- import_module hlds.hlds_module.
:- import_module hlds.hlds_pred.
%-----------------------------------------------------------------------------%
:- pred expand_lambdas_in_module(module_info::in, module_info::out) is det.
:- pred expand_lambdas_in_pred(pred_id::in, module_info::in, module_info::out)
is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module check_hlds.mode_util.
:- import_module hlds.code_model.
:- import_module hlds.goal_util.
:- import_module hlds.hlds_data.
:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_rtti.
:- import_module hlds.pred_table.
:- import_module hlds.quantification.
:- import_module libs.compiler_util.
:- import_module libs.globals.
:- import_module libs.options.
:- import_module mdbcomp.prim_data.
:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_mode.
:- import_module parse_tree.prog_type.
:- import_module parse_tree.prog_util.
:- import_module assoc_list.
:- import_module array.
:- import_module bool.
:- import_module int.
:- import_module list.
:- import_module map.
:- import_module maybe.
:- import_module pair.
:- import_module set.
:- import_module term.
:- import_module varset.
%-----------------------------------------------------------------------------%
:- type lambda_info
---> lambda_info(
prog_varset, % from the proc_info
vartypes, % from the proc_info
tvarset, % from the proc_info
inst_varset, % from the proc_info
rtti_varmaps, % from the proc_info
pred_markers, % from the pred_info
bool, % has_parallel_conj, from the proc_info
pred_or_func,
string, % pred/func name
module_info,
bool, % true iff we need to recompute
% the nonlocals
bool % true if we expanded some lambda
% expressions
).
%-----------------------------------------------------------------------------%
%
% This whole section just traverses the module structure
%
expand_lambdas_in_module(!ModuleInfo) :-
module_info_predids(PredIds, !ModuleInfo),
list.foldl(expand_lambdas_in_pred, PredIds, !ModuleInfo),
% Need update the dependency graph to include the lambda predicates.
module_info_clobber_dependency_info(!ModuleInfo).
expand_lambdas_in_pred(PredId, !ModuleInfo) :-
module_info_pred_info(!.ModuleInfo, PredId, PredInfo),
ProcIds = pred_info_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_preds(!.ModuleInfo, PredTable0),
map.lookup(PredTable0, PredId, PredInfo0),
pred_info_get_procedures(PredInfo0, ProcTable0),
map.lookup(ProcTable0, ProcId, ProcInfo0),
expand_lambdas_in_proc_2(ProcInfo0, ProcInfo, PredInfo0, PredInfo1,
!ModuleInfo),
pred_info_get_procedures(PredInfo1, ProcTable1),
map.det_update(ProcTable1, ProcId, ProcInfo, ProcTable),
pred_info_set_procedures(ProcTable, PredInfo1, PredInfo),
module_info_preds(!.ModuleInfo, PredTable1),
map.det_update(PredTable1, PredId, PredInfo, PredTable),
module_info_set_preds(PredTable, !ModuleInfo).
:- pred expand_lambdas_in_proc_2(proc_info::in, proc_info::out,
pred_info::in, pred_info::out, module_info::in, module_info::out) is det.
expand_lambdas_in_proc_2(!ProcInfo, !PredInfo, !ModuleInfo) :-
% Grab the appropriate fields from the pred_info and proc_info.
PredName = pred_info_name(!.PredInfo),
PredOrFunc = pred_info_is_pred_or_func(!.PredInfo),
pred_info_get_typevarset(!.PredInfo, TypeVarSet0),
pred_info_get_markers(!.PredInfo, Markers),
proc_info_get_headvars(!.ProcInfo, HeadVars),
proc_info_get_varset(!.ProcInfo, VarSet0),
proc_info_get_vartypes(!.ProcInfo, VarTypes0),
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),
MustRecomputeNonLocals0 = no,
HaveExpandedLambdas0 = no,
% Process the goal.
Info0 = lambda_info(VarSet0, VarTypes0, TypeVarSet0, InstVarSet0,
RttiVarMaps0, Markers, HasParallelConj, PredOrFunc,
PredName, !.ModuleInfo, MustRecomputeNonLocals0, HaveExpandedLambdas0),
expand_lambdas_in_goal(Goal0, Goal1, Info0, Info1),
Info1 = lambda_info(VarSet1, VarTypes1, TypeVarSet, _InstVarSet,
RttiVarMaps1, _, _, _, _, !:ModuleInfo, MustRecomputeNonLocals,
HaveExpandedLambdas),
% Check if we need to requantify.
(
MustRecomputeNonLocals = yes,
implicitly_quantify_clause_body_general(
ordinary_nonlocals_no_lambda, HeadVars, _Warnings,
Goal1, Goal2, VarSet1, VarSet2, VarTypes1, VarTypes2,
RttiVarMaps1, RttiVarMaps2),
proc_info_get_initial_instmap(!.ProcInfo, !.ModuleInfo, InstMap0),
recompute_instmap_delta(recompute_atomic_instmap_deltas,
Goal2, Goal, VarTypes2, InstVarSet0, InstMap0, !ModuleInfo)
;
MustRecomputeNonLocals = no,
Goal = Goal1,
VarSet2 = VarSet1,
VarTypes2 = VarTypes1,
RttiVarMaps2 = RttiVarMaps1
),
(
HaveExpandedLambdas = yes,
restrict_var_maps(HeadVars, Goal, VarSet2, VarSet, VarTypes2, VarTypes,
RttiVarMaps2, RttiVarMaps)
;
HaveExpandedLambdas = no,
VarSet = VarSet2,
VarTypes = VarTypes2,
RttiVarMaps = RttiVarMaps2
),
% Set the new values of the fields in proc_info and pred_info.
proc_info_set_goal(Goal, !ProcInfo),
proc_info_set_varset(VarSet, !ProcInfo),
proc_info_set_vartypes(VarTypes, !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),
( Reason = from_ground_term(_, from_ground_term_construct) ->
% If the scope had any rhs_lambda_goals, modes.m wouldn't have
% left its kind field as from_ground_term_construct.
GoalExpr = GoalExpr0
;
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(this_file, "expand_lambdas_in_goal_2: 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(LHS, RHS0, Mode, Unification0, Context, GoalExpr,
!Info) :-
(
RHS0 = rhs_lambda_goal(Purity, Groundness, PredOrFunc, EvalMethod,
NonLocalVars, Vars, Modes, Det, LambdaGoal0),
% First, process the lambda goal recursively, in case it contains
% some nested lambda expressions.
expand_lambdas_in_goal(LambdaGoal0, LambdaGoal, !Info),
% Then, convert the lambda expression into a new predicate.
expand_lambda(Purity, Groundness, PredOrFunc, EvalMethod, Vars,
Modes, Det, NonLocalVars, LambdaGoal, Unification0, Y, Unification,
!Info),
GoalExpr = unify(LHS, Y, Mode, Unification, Context)
;
( RHS0 = rhs_var(_)
; RHS0 = rhs_functor(_, _, _)
),
% Ordinary unifications are left unchanged.
GoalExpr = unify(LHS, RHS0, Mode, Unification0, Context)
).
:- pred expand_lambda(purity::in, ho_groundness::in,
pred_or_func::in, lambda_eval_method::in,
list(prog_var)::in, list(mer_mode)::in, determinism::in,
list(prog_var)::in, hlds_goal::in, unification::in, unify_rhs::out,
unification::out, lambda_info::in, lambda_info::out) is det.
expand_lambda(Purity, _Groundness, PredOrFunc, EvalMethod, Vars, Modes,
Detism, OrigNonLocals0, LambdaGoal, Unification0, Functor, Unification,
LambdaInfo0, LambdaInfo) :-
LambdaInfo0 = lambda_info(VarSet, VarTypes, TVarSet,
InstVarSet, RttiVarMaps, Markers, HasParallelConj, POF, OrigPredName,
ModuleInfo0, MustRecomputeNonLocals0, _HaveExpandedLambdas),
% 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),
map.apply_to_list(Vars, VarTypes, LambdaVarTypeList),
list.map(type_vars, LambdaVarTypeList, LambdaTypeVarsList),
list.condense(LambdaTypeVarsList, LambdaTypeVars),
list.filter(constraint_contains_vars(LambdaTypeVars),
AllConstraints, UnivConstraints),
Constraints = constraints(UnivConstraints, []),
% Existentially typed lambda expressions are not yet supported
% (see the documentation at top of this file).
ExistQVars = [],
LambdaGoal = hlds_goal(_, LambdaGoalInfo),
LambdaGoalNonLocals = goal_info_get_nonlocals(LambdaGoalInfo),
set.insert_list(LambdaGoalNonLocals, Vars, LambdaNonLocals),
goal_util.extra_nonlocal_typeinfos(RttiVarMaps, VarTypes, ExistQVars,
LambdaNonLocals, ExtraTypeInfos),
OrigVars = OrigNonLocals0,
(
Unification0 = construct(Var, _, _, UniModes0, _, _, _)
;
( Unification0 = deconstruct(_, _, _, _, _, _)
; Unification0 = assign(_, _)
; Unification0 = simple_test(_, _)
; Unification0 = complicated_unify(_, _, _)
),
unexpected(this_file, "expand_lambda: unexpected unification")
),
set.delete_list(LambdaGoalNonLocals, Vars, NonLocals1),
% We need all the typeinfos, including the ones that are not used,
% for the layout structure describing the closure.
set.difference(ExtraTypeInfos, NonLocals1, NewTypeInfos),
set.union(NonLocals1, NewTypeInfos, NonLocals),
( set.empty(NewTypeInfos) ->
MustRecomputeNonLocals = MustRecomputeNonLocals0
;
% If we added variables to the nonlocals of the lambda goal, then
% we must recompute the nonlocals for the procedure that contains it.
MustRecomputeNonLocals = yes
),
set.to_sorted_list(NonLocals, ArgVars1),
(
% Optimize a special case: replace
% `(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's also only valid
% if all the inputs in the Yi precede the outputs. It's also not valid
% if any of the Xi are in the Yi.
LambdaGoal = hlds_goal(LambdaGoalExpr, _),
LambdaGoalExpr = plain_call(PredId0, ProcId0, CallVars, _, _, _),
module_info_pred_proc_info(ModuleInfo0, PredId0, ProcId0,
Call_PredInfo, Call_ProcInfo),
list.remove_suffix(CallVars, Vars, InitialVars),
% Check that none of the variables that we're trying to use
% as curried arguments are lambda-bound variables.
\+ (
list.member(InitialVar, InitialVars),
list.member(InitialVar, Vars)
),
% 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're using the LLDS
% back-end (i.e. not --high-level-code), det is compatible with nondet.
% If we're using the MLDS back-end, then predicates and functions have
% different calling conventions.
Call_CodeModel = proc_info_interface_code_model(Call_ProcInfo),
determinism_to_code_model(Detism, CodeModel),
module_info_get_globals(ModuleInfo0, Globals),
globals.get_target(Globals, Target),
globals.lookup_bool_option(Globals, highlevel_code, HighLevelCode),
(
( Target = target_c
; Target = target_il
; Target = target_java
; Target = target_asm
; Target = target_x86_64
),
(
HighLevelCode = no,
(
CodeModel = Call_CodeModel
;
CodeModel = model_non,
Call_CodeModel = model_det
)
;
HighLevelCode = yes,
Call_PredOrFunc = pred_info_is_pred_or_func(Call_PredInfo),
PredOrFunc = Call_PredOrFunc,
CodeModel = Call_CodeModel
)
;
Target = target_erlang,
CodeModel = Call_CodeModel
),
% Check that the curried arguments are all input.
proc_info_get_argmodes(Call_ProcInfo, Call_ArgModes),
list.length(InitialVars, NumInitialVars),
list.take(NumInitialVars, Call_ArgModes, CurriedArgModes),
(
list.member(Mode, CurriedArgModes)
=>
mode_is_input(ModuleInfo0, Mode)
)
->
ArgVars = InitialVars,
PredId = PredId0,
ProcId = ProcId0,
mode_util.modes_to_uni_modes(ModuleInfo0,
CurriedArgModes, CurriedArgModes, UniModes),
% We must mark the procedure as having had its address taken.
proc_info_set_address_taken(address_is_taken,
Call_ProcInfo, Call_NewProcInfo),
module_info_set_pred_proc_info(PredId, ProcId,
Call_PredInfo, Call_NewProcInfo, ModuleInfo0, ModuleInfo)
;
% 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(ArgVars1, VarTypes),
list.append(ArgVars, Vars, AllArgVars),
module_info_get_name(ModuleInfo0, ModuleName),
OrigContext = goal_info_get_context(LambdaGoalInfo),
term.context_file(OrigContext, OrigFile),
term.context_line(OrigContext, OrigLine),
module_info_next_lambda_count(OrigContext, LambdaCount,
ModuleInfo0, ModuleInfo1),
make_pred_name_with_context(ModuleName, "IntroducedFrom",
PredOrFunc, OrigPredName, OrigLine, LambdaCount, PredName),
LambdaContext = goal_info_get_context(LambdaGoalInfo),
% The TVarSet is a superset of what it really ought be,
% but that shouldn't matter.
% Existentially typed lambda expressions are not yet supported
% (see the documentation at top of this file).
ExistQVars = [],
uni_modes_to_modes(UniModes0, 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 `UniModes1'.
% For the lambda var arguments at the end, we use the mode in the
% lambda expression.
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 uni_modes.
modes_to_uni_modes(ModuleInfo1, ArgModes1, ArgModes1, UniModes),
list.append(ArgModes1, Modes, AllArgModes),
map.apply_to_list(AllArgVars, VarTypes, ArgTypes),
purity_to_markers(Purity, 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, VarSet, LambdaVarSet,
VarTypes, LambdaVarTypes, RttiVarMaps, LambdaRttiVarMaps),
proc_info_create(LambdaContext, LambdaVarSet, LambdaVarTypes,
AllArgVars, InstVarSet, AllArgModes, Detism, LambdaGoal,
LambdaRttiVarMaps, address_is_taken, VarNameRemap, ProcInfo0),
% The debugger ignores unnamed variables.
ensure_all_headvars_are_named(ProcInfo0, ProcInfo1),
% 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.
proc_info_set_has_parallel_conj(HasParallelConj, ProcInfo1, ProcInfo2),
% If we previously already needed to recompute the nonlocals,
% then we'd better to that recomputation for the procedure
% that we just created.
(
MustRecomputeNonLocals0 = yes,
% ZZZ
requantify_proc_general(ordinary_nonlocals_maybe_lambda,
ProcInfo2, ProcInfo)
;
MustRecomputeNonLocals0 = no,
ProcInfo = ProcInfo2
),
set.init(Assertions),
pred_info_create(ModuleName, PredName, PredOrFunc, LambdaContext,
origin_lambda(OrigFile, OrigLine, LambdaCount), status_local,
LambdaMarkers, ArgTypes, TVarSet, ExistQVars, Constraints,
Assertions, VarNameRemap, ProcInfo, ProcId, PredInfo),
% Save the new predicate in the predicate table.
module_info_get_predicate_table(ModuleInfo1, PredicateTable0),
predicate_table_insert(PredInfo, PredId,
PredicateTable0, PredicateTable),
module_info_set_predicate_table(PredicateTable,
ModuleInfo1, ModuleInfo)
),
ShroudedPredProcId = shroud_pred_proc_id(proc(PredId, ProcId)),
ConsId = closure_cons(ShroudedPredProcId, EvalMethod),
Functor = rhs_functor(ConsId, no, ArgVars),
Unification = construct(Var, ConsId, ArgVars, UniModes,
construct_dynamically, cell_is_unique, no_construct_sub_info),
HaveExpandedLambdas = yes,
LambdaInfo = lambda_info(VarSet, VarTypes, TVarSet,
InstVarSet, RttiVarMaps, Markers, HasParallelConj, POF, OrigPredName,
ModuleInfo, MustRecomputeNonLocals, HaveExpandedLambdas).
:- pred constraint_contains_vars(list(tvar)::in, prog_constraint::in)
is semidet.
constraint_contains_vars(LambdaVars, ClassConstraint) :-
ClassConstraint = constraint(_, ConstraintTypes),
list.map(type_vars, ConstraintTypes, ConstraintVarsList),
list.condense(ConstraintVarsList, ConstraintVars),
% Probably not the most efficient way of doing it, but I wouldn't think
% that it matters.
set.list_to_set(LambdaVars, LambdaVarsSet),
set.list_to_set(ConstraintVars, ConstraintVarsSet),
set.subset(ConstraintVarsSet, LambdaVarsSet).
% This predicate works out the modes of the original non-local variables
% of a lambda expression based on the list of uni_mode in the unify_info
% for the lambda unification.
%
:- pred uni_modes_to_modes(list(uni_mode)::in, list(mer_mode)::out) is det.
uni_modes_to_modes([], []).
uni_modes_to_modes([UniMode | UniModes], [Mode | Modes]) :-
UniMode = ((_Initial0 - Initial1) -> (_Final0 - _Final1)),
Mode = (Initial1 -> Initial1),
uni_modes_to_modes(UniModes, Modes).
%---------------------------------------------------------------------------%
% 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 vartypes map, and this requires also eliminating them from
% the rtti_varmaps.
%
% We could in theory restrict the varsets in the proc_info as well
% both the main prog_varset and the other varsets, e.g. the tvarset),
% 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,
prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
rtti_varmaps::in, rtti_varmaps::out) is det.
restrict_var_maps(HeadVars, Goal, !VarSet, !VarTypes, !RttiVarMaps) :-
MaxVar = varset.max_var(!.VarSet),
MaxVarNum = var_to_int(MaxVar),
% 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 always 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),
map.to_assoc_list(!.VarTypes, VarTypesList0),
filter_vartypes(VarTypesList0, [], RevVarTypesList, VarUses),
list.reverse(RevVarTypesList, VarTypesList),
map.from_sorted_assoc_list(VarTypesList, !:VarTypes),
restrict_rtti_varmaps(VarUses, !RttiVarMaps).
:- pred filter_vartypes(assoc_list(prog_var, mer_type)::in,
assoc_list(prog_var, mer_type)::in, assoc_list(prog_var, mer_type)::out,
array(bool)::in) is det.
filter_vartypes([], !RevVarTypes, _VarUses).
filter_vartypes([VarType | VarTypes], !RevVarTypes, VarUses) :-
VarType = Var - _Type,
VarNum = var_to_int(Var),
array.unsafe_lookup(VarUses, VarNum, Used),
(
Used = yes,
!:RevVarTypes = [VarType | !.RevVarTypes]
;
Used = no
),
filter_vartypes(VarTypes, !RevVarTypes, VarUses).
:- 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, _, _),
( CellToReuse = reuse_cell(cell_to_reuse(ReuseVar, _, _)) ->
mark_var_as_used(ReuseVar, !VarUses)
;
true
)
;
Unif = deconstruct(_, _, _, _, _, _)
;
Unif = assign(_, _)
;
Unif = simple_test(_, _)
;
Unif = complicated_unify(_, _, _)
),
(
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, LambdaVars,
_, _, LambdaGoal),
mark_vars_as_used(NonLocals, !VarUses),
mark_vars_as_used(LambdaVars, !VarUses),
find_used_vars_in_goal(LambdaGoal, !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, _, _, _),
mark_vars_as_used(ArgVars, !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_purity(_)
;
Reason = promise_solutions(Vars, _),
mark_vars_as_used(Vars, !VarUses)
;
Reason = barrier(_)
;
Reason = commit(_)
;
Reason = from_ground_term(Var, _),
mark_var_as_used(Var, !VarUses)
;
Reason = trace_goal(_, _, _, _, _)
),
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 mark_var_as_used(prog_var::in,
array(bool)::array_di, array(bool)::array_uo) is det.
:- pragma inline(mark_var_as_used/3).
mark_var_as_used(Var, !VarUses) :-
array.set(!.VarUses, 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).
%---------------------------------------------------------------------------%
:- func this_file = string.
this_file = "lambda.m".
%---------------------------------------------------------------------------%
:- end_module lambda.
%---------------------------------------------------------------------------%
Reference in New Issue View Git Blame Copy Permalink