mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2025-12-20 16:31:04 +00:00
Code Issues Projects Releases Wiki Activity
Files
f8742f93aa133f3db2bbb2ecaccbe4f00bbcc040
mercury/compiler/lambda.m
Mark Brown 4427723508 Remove the assumption made by polymorphism.m that all type variables 
Estimated hours taken: 240
Branches: main

Remove the assumption made by polymorphism.m that all type variables
appearing in class constraints also appear in the type being constrained.
This is a first step towards adding functional dependencies, since in the
presence of functional dependencies (or "improvement" in general) this
assumption no longer holds.

The assumption made by polymorphism manifests itself in the fact that
constraints on atomic goals are reconstructed by unifying the types of
formal parameters with the types of actual arguments, and then applying
the resulting substitution to the constraints.  Any type variables in
constraints that don't appear in the formal parameters will therefore
remain unbound.

This change overcomes the assumption by building up a map from constraint
identifiers to constraints during typechecking, and then looking up this
map in order to reconstruct the constraint during the polymorphism
transformation.

To support this, the type 'class_constraint' has been removed and replaced
by two distinct types, 'prog_constraint' and 'hlds_constraint'.  The former
is part of the parse tree and holds the same information as the old
class_constraint.  The latter is part of the HLDS, and is used during
typechecking; in addition to the information in prog_constraints, it also
stores a set of identifiers that represent where the constraint came from.
These identifiers are used as the keys in the aforementioned map.

At this stage the constraint identifiers are only used by typechecking to
build the constraint map.  Other passes use either prog_constraints or
hlds_constraints with an empty set of identifiers.

compiler/hlds_data.m:
	Define the constraint_id type, which is used to uniquely identify
	class constraints.  A better scheme than this one has been suggested,
	but that will be left to a later change.  An XXX comment to that
	effect has been added.

	Define the hlds_constraint type, which is like prog_constraint but
	it also includes a set of constraint_ids.  Define a set of predicates
	to initialise and manipulate these.

	Define the constraint_map type here.  Move the definition of
	constraint_proof_map to here, where it more sensibly belongs.

	Update the comments in hlds_instance_defn slightly, with information
	that I found I needed to know when making this change.

compiler/hlds_pred.m:
	Add a field to the pred_info to store the constraint_map.

	Move the definition of constraint_proof_map from here.

compiler/hlds_out.m:
	Print out a representation of the constraint map if it isn't empty.

compiler/type_util.m:
	Change the predicates that used to operate on class_constraints so
	that they now operate on hlds_constraints.  The old versions of these
	predicates have now moved to prog_util.

	Add some utility predicates to manipulate constraint_maps.

	Add a predicate to apply a variable renaming to constraint_proof_maps.

compiler/prog_data.m:
	Rename class_constraint(s) to prog_constraint(s).

compiler/prog_util.m:
	Provide a set of predicates for manipulating prog_constraints.

compiler/typecheck.m:
	Ensure that goal_paths are filled in before the first iteration
	of typechecking.

	Pass the hlds_goal_info down through typecheck_goal_2 so that the
	goal_path can be retrieved when needed to assign identifiers to
	constraints.  Thread the goal_path through to wherever it is needed.

	Store hlds_constraints in the args_type_assign rather than
	prog_constraints, so that the required information is available
	when creating the new set of type_assigns.  Do likewise for the
	cons_type_info type.  Don't pass the module_info through
	make_pred_cons_info*, since it isn't used.  Do pass the goal_path,
	though, so that constraints in cons_type_infos can be given the
	correct identifier.

	Add a constraint_map field to the typecheck_info, initialised to empty.

	When retrieving the final information from a typecheck_info, return
	the resulting constraint_map, after applying any type bindings.
	Ensure that any constraints that may not have been entered into the
	constraint_map are put there now.  Call the new predicate in type_util
	to rename the constraint_proof_map, rather than doing it longhand
	here.

	Make the following changes to context reduction:

		- Thread the constraint_map through, so that it can be updated
		as constraints are eliminated.

		- Instead of simply calling sort_and_remove_dups on the
		set of constraints remaining after one iteration, merge the
		constraints in such a way that the complete set of
		constraint_ids is retained.

		- Disregard the constraint_ids when deleting newly introduced
		constraints that are equivalent to constraints that have
		already been seen.

		- Simplify the code of find_matching_instance_rule_2 by
		moving the deterministic code out of the condition of the
		if-then-else.

	Move find_first_map into the library.

compiler/polymorphism.m:
	Ensure that the goal_path is set when constructing lambda goals.

	In process_call, look up the constraints in the constraint_map
	using the goal_path as part of the key, rather than calculating
	the constraints by applying the ParentToActual type substitution.
	Rearrange this code so that it is divided into easier to understand
	blocks.

	Add a field to the poly_info to store the constraint_map, and
	initialise it from the pred_info.

compiler/goal_path.m:
	Fill slots in lambda_goals, since constraints inside these will
	otherwise not be identified properly.  The goal_paths inside here
	do not entirely make sense, since there is no goal_path_step for
	the lambda_goal itself.  However, there is enough information
	retained to distinguish these goal_paths from any other possible
	goal_path, which is all that we require to identify constraints.

	Add a warning not to fill in the goal slots between the typechecking
	and polymorphism passes, since doing so could potentially render the
	constraint_maps incorrect.

compiler/make_hlds.m:
	Initialise the constraint_map to empty in pred_infos.

	Move the code for updating the superclass_table into a separate
	predicate.  Initially this change was made because, in an earlier
	version of the change, the superclass_table had some extra
	information that needed to be filled in.  That part of the change
	is not needed in this diff, but the new predicate simplifies the
	code a bit so I've left it there.

compiler/check_typeclass.m:
	Convert the prog_constraints into hlds_constraints before passing
	them to typecheck.reduce_context_by_rule_application.  They are
	assigned no identifiers, since these constraints are not required
	to be put into the constraint map.

	Change the name of the function get_constraint_id to
	get_constraint_class_id, since it would now be ambiguous otherwise.

compiler/cse_detection.m:
	Import parse_tree__prog_util, since that is where renamings of
	prog_constraints are now defined.

compiler/higher_order.m:
	Initialise pred_infos here with an empty constraint_map.

compiler/post_typecheck.m:
	When binding type vars to void, apply the void substitution to the
	constraint_map.

compiler/table_gen.m:
	Pass the constraint_map when creating a new pred_info.

compiler/unused_args.m:
	Create the pred_info with an empty constraint_map.  The constraint_map
	won't be used by this stage anyway.

compiler/*.m:
	Update to use the new type names.  Also update to use the existing
	type synonyms typeclass_info_varmap and constraint_proof_map.

	Change names of predicates and functions to use prog_constraint
	instead of class_constraint, where applicable.

library/list.m:
	Add find_first_map from typecheck.  Also add find_first_map{2,3},
	since at one stage during development I needed find_first_map3, and,
	although it's not used in the current diff, there is little point
	removing it now.
2005-04-01 14:29:19 +00:00

627 lines
23 KiB
Mathematica
Raw Blame History

%-----------------------------------------------------------------------------%
% Copyright (C) 1995-2005 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
% file: 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 = lambda([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 lambda__process_module(module_info::in, module_info::out) is det.
:- pred lambda__process_pred(pred_id::in, module_info::in, module_info::out)
is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
% Parse tree modules
:- import_module parse_tree__prog_data.
:- import_module parse_tree__prog_mode.
:- import_module parse_tree__prog_util.
:- import_module parse_tree__prog_type.
% HLDS modules
:- import_module check_hlds__inst_match.
:- import_module check_hlds__mode_util.
:- import_module check_hlds__type_util.
:- import_module hlds__code_model.
:- import_module hlds__goal_util.
:- import_module hlds__hlds_data.
:- import_module hlds__hlds_goal.
:- import_module hlds__quantification.
% Misc
:- import_module libs__globals.
:- import_module libs__options.
:- import_module mdbcomp__prim_data.
% Standard library modules
:- import_module bool.
:- import_module list.
:- import_module map.
:- import_module require.
:- import_module set.
:- import_module std_util.
:- import_module string.
:- import_module term.
:- import_module varset.
:- type lambda_info --->
lambda_info(
prog_varset, % from the proc_info
map(prog_var, type), % from the proc_info
prog_constraints, % from the pred_info
tvarset, % from the proc_info
inst_varset, % from the proc_info
map(tvar, type_info_locn),
% from the proc_info
% (typeinfos)
typeclass_info_varmap, % from the proc_info
% (typeclass_infos)
pred_markers, % from the pred_info
pred_or_func,
string, % pred/func name
aditi_owner,
module_info,
bool % true iff we need to recompute the nonlocals
).
%-----------------------------------------------------------------------------%
% This whole section just traverses the module structure.
lambda__process_module(ModuleInfo0, ModuleInfo) :-
module_info_predids(ModuleInfo0, PredIds),
lambda__process_preds(PredIds, ModuleInfo0, ModuleInfo1),
% Need update the dependency graph to include the lambda predicates.
module_info_clobber_dependency_info(ModuleInfo1, ModuleInfo).
:- pred lambda__process_preds(list(pred_id)::in,
module_info::in, module_info::out) is det.
lambda__process_preds([], ModuleInfo, ModuleInfo).
lambda__process_preds([PredId | PredIds], ModuleInfo0, ModuleInfo) :-
lambda__process_pred(PredId, ModuleInfo0, ModuleInfo1),
lambda__process_preds(PredIds, ModuleInfo1, ModuleInfo).
lambda__process_pred(PredId, ModuleInfo0, ModuleInfo) :-
module_info_pred_info(ModuleInfo0, PredId, PredInfo),
ProcIds = pred_info_procids(PredInfo),
lambda__process_procs(PredId, ProcIds, ModuleInfo0, ModuleInfo).
:- pred lambda__process_procs(pred_id::in, list(proc_id)::in,
module_info::in, module_info::out) is det.
lambda__process_procs(_PredId, [], ModuleInfo, ModuleInfo).
lambda__process_procs(PredId, [ProcId | ProcIds], ModuleInfo0, ModuleInfo) :-
lambda__process_proc(PredId, ProcId, ModuleInfo0, ModuleInfo1),
lambda__process_procs(PredId, ProcIds, ModuleInfo1, ModuleInfo).
:- pred lambda__process_proc(pred_id::in, proc_id::in,
module_info::in, module_info::out) is det.
lambda__process_proc(PredId, ProcId, !ModuleInfo) :-
module_info_preds(!.ModuleInfo, PredTable0),
map__lookup(PredTable0, PredId, PredInfo0),
pred_info_procedures(PredInfo0, ProcTable0),
map__lookup(ProcTable0, ProcId, ProcInfo0),
lambda__process_proc_2(ProcInfo0, ProcInfo, PredInfo0, PredInfo1,
!ModuleInfo),
pred_info_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 lambda__process_proc_2(proc_info::in, proc_info::out,
pred_info::in, pred_info::out, module_info::in, module_info::out)
is det.
lambda__process_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_typevarset(!.PredInfo, TypeVarSet0),
pred_info_get_markers(!.PredInfo, Markers),
pred_info_get_class_context(!.PredInfo, Constraints0),
pred_info_get_aditi_owner(!.PredInfo, Owner),
proc_info_headvars(!.ProcInfo, HeadVars),
proc_info_varset(!.ProcInfo, VarSet0),
proc_info_vartypes(!.ProcInfo, VarTypes0),
proc_info_goal(!.ProcInfo, Goal0),
proc_info_typeinfo_varmap(!.ProcInfo, TVarMap0),
proc_info_typeclass_info_varmap(!.ProcInfo, TCVarMap0),
proc_info_inst_varset(!.ProcInfo, InstVarSet0),
MustRecomputeNonLocals0 = no,
% process the goal
Info0 = lambda_info(VarSet0, VarTypes0, Constraints0, TypeVarSet0,
InstVarSet0, TVarMap0, TCVarMap0, Markers, PredOrFunc,
PredName, Owner, !.ModuleInfo, MustRecomputeNonLocals0),
lambda__process_goal(Goal0, Goal1, Info0, Info1),
Info1 = lambda_info(VarSet1, VarTypes1, Constraints, TypeVarSet,
_, TVarMap, TCVarMap, _, _, _, _, !:ModuleInfo,
MustRecomputeNonLocals),
% check if we need to requantify
( MustRecomputeNonLocals = yes ->
implicitly_quantify_clause_body(HeadVars, _Warnings,
Goal1, Goal, VarSet1, VarSet, VarTypes1, VarTypes)
;
Goal = Goal1,
VarSet = VarSet1,
VarTypes = VarTypes1
),
% 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_typeinfo_varmap(TVarMap, !ProcInfo),
proc_info_set_typeclass_info_varmap(TCVarMap, !ProcInfo),
pred_info_set_typevarset(TypeVarSet, !PredInfo),
pred_info_set_class_context(Constraints, !PredInfo).
:- pred lambda__process_goal(hlds_goal::in, hlds_goal::out,
lambda_info::in, lambda_info::out) is det.
lambda__process_goal(Goal0 - GoalInfo0, Goal, !Info) :-
lambda__process_goal_2(Goal0, GoalInfo0, Goal, !Info).
:- pred lambda__process_goal_2(hlds_goal_expr::in, hlds_goal_info::in,
hlds_goal::out, lambda_info::in, lambda_info::out) is det.
lambda__process_goal_2(unify(XVar, Y, Mode, Unification, Context), GoalInfo,
Unify - GoalInfo, !Info) :-
(
Y = lambda_goal(Purity, PredOrFunc, EvalMethod, _,
NonLocalVars, Vars, Modes, Det, LambdaGoal0)
->
% first, process the lambda goal recursively, in case it
% contains some nested lambda expressions.
lambda__process_goal(LambdaGoal0, LambdaGoal1, !Info),
% then, convert the lambda expression into a new predicate
lambda__process_lambda(Purity, PredOrFunc, EvalMethod, Vars,
Modes, Det, NonLocalVars, LambdaGoal1,
Unification, Y1, Unification1, !Info),
Unify = unify(XVar, Y1, Mode, Unification1, Context)
;
% ordinary unifications are left unchanged
Unify = unify(XVar, Y, Mode, Unification, Context)
).
% the rest of the clauses just process goals recursively
lambda__process_goal_2(conj(Goals0), GoalInfo, conj(Goals) - GoalInfo,
!Info) :-
lambda__process_goal_list(Goals0, Goals, !Info).
lambda__process_goal_2(par_conj(Goals0), GoalInfo,
par_conj(Goals) - GoalInfo, !Info) :-
lambda__process_goal_list(Goals0, Goals, !Info).
lambda__process_goal_2(disj(Goals0), GoalInfo, disj(Goals) - GoalInfo,
!Info) :-
lambda__process_goal_list(Goals0, Goals, !Info).
lambda__process_goal_2(not(Goal0), GoalInfo, not(Goal) - GoalInfo, !Info) :-
lambda__process_goal(Goal0, Goal, !Info).
lambda__process_goal_2(switch(Var, CanFail, Cases0), GoalInfo,
switch(Var, CanFail, Cases) - GoalInfo, !Info) :-
lambda__process_cases(Cases0, Cases, !Info).
lambda__process_goal_2(scope(Reason, Goal0), GoalInfo,
scope(Reason, Goal) - GoalInfo, !Info) :-
lambda__process_goal(Goal0, Goal, !Info).
lambda__process_goal_2(if_then_else(Vars, Cond0, Then0, Else0), GoalInfo,
if_then_else(Vars, Cond, Then, Else) - GoalInfo, !Info) :-
lambda__process_goal(Cond0, Cond, !Info),
lambda__process_goal(Then0, Then, !Info),
lambda__process_goal(Else0, Else, !Info).
lambda__process_goal_2(Goal @ generic_call(_, _, _, _), GoalInfo,
Goal - GoalInfo, !Info).
lambda__process_goal_2(Goal @ call(_, _, _, _, _, _), GoalInfo,
Goal - GoalInfo, !Info).
lambda__process_goal_2(Goal @ foreign_proc(_, _, _, _, _, _), GoalInfo,
Goal - GoalInfo, !Info).
lambda__process_goal_2(shorthand(_), _, _, !Info) :-
% these should have been expanded out by now
error("lambda__process_goal_2: unexpected shorthand").
:- pred lambda__process_goal_list(list(hlds_goal)::in, list(hlds_goal)::out,
lambda_info::in, lambda_info::out) is det.
lambda__process_goal_list([], [], !Info).
lambda__process_goal_list([Goal0 | Goals0], [Goal | Goals], !Info) :-
lambda__process_goal(Goal0, Goal, !Info),
lambda__process_goal_list(Goals0, Goals, !Info).
:- pred lambda__process_cases(list(case)::in, list(case)::out,
lambda_info::in, lambda_info::out) is det.
lambda__process_cases([], [], !Info).
lambda__process_cases([case(ConsId, Goal0) | Cases0],
[case(ConsId, Goal) | Cases], !Info) :-
lambda__process_goal(Goal0, Goal, !Info),
lambda__process_cases(Cases0, Cases, !Info).
:- pred lambda__process_lambda(purity::in, pred_or_func::in,
lambda_eval_method::in, list(prog_var)::in, list(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.
lambda__process_lambda(Purity, PredOrFunc, EvalMethod, Vars, Modes, Detism,
OrigNonLocals0, LambdaGoal, Unification0, Functor,
Unification, LambdaInfo0, LambdaInfo) :-
LambdaInfo0 = lambda_info(VarSet, VarTypes, _PredConstraints, TVarSet,
InstVarSet, TVarMap, TCVarMap, Markers, POF, OrigPredName,
Owner, ModuleInfo0, MustRecomputeNonLocals0),
% Calculate the constraints which apply to this lambda
% expression.
% Note currently we only allow lambda expressions
% to have universally quantified constraints.
map__keys(TCVarMap, AllConstraints),
map__apply_to_list(Vars, VarTypes, LambdaVarTypes),
list__map(prog_type__vars, LambdaVarTypes, LambdaTypeVarsList),
list__condense(LambdaTypeVarsList, LambdaTypeVars),
list__filter(lambda__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 = _ - LambdaGoalInfo,
goal_info_get_nonlocals(LambdaGoalInfo, LambdaGoalNonLocals),
set__insert_list(LambdaGoalNonLocals, Vars, LambdaNonLocals),
goal_util__extra_nonlocal_typeinfos(TVarMap, TCVarMap, VarTypes,
ExistQVars, LambdaNonLocals, ExtraTypeInfos),
OrigVars = OrigNonLocals0,
(
Unification0 = construct(Var0, _, _, UniModes0, _, _, _)
->
Var = Var0,
UniModes1 = UniModes0
;
error("lambda__transform_lambda: weird 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.
NewTypeInfos = ExtraTypeInfos `set__difference` NonLocals1,
NonLocals = NonLocals1 `set__union` NewTypeInfos,
% If we added variables to the nonlocals of the lambda goal,
% then we need to recompute the nonlocals for the procedure
% that contains it.
( \+ set__empty(NewTypeInfos) ->
MustRecomputeNonLocals = yes
;
MustRecomputeNonLocals = MustRecomputeNonLocals0
),
set__to_sorted_list(NonLocals, ArgVars1),
(
% Optimize a special case: replace
% `lambda([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 = call(PredId0, ProcId0, CallVars, _, _, _) - _,
module_info_pred_proc_info(ModuleInfo0, PredId0, ProcId0,
Call_PredInfo, Call_ProcInfo),
(
EvalMethod = (aditi_bottom_up),
pred_info_get_markers(Call_PredInfo, Call_Markers),
check_marker(Call_Markers, aditi)
;
EvalMethod = normal
),
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.
proc_info_interface_code_model(Call_ProcInfo, Call_CodeModel),
determinism_to_code_model(Detism, CodeModel),
module_info_globals(ModuleInfo0, Globals),
globals__lookup_bool_option(Globals, highlevel_code,
HighLevelCode),
(
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
),
% check that the curried arguments are all input
proc_info_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(CurriedArgModes, CurriedArgModes,
ModuleInfo0, UniModes),
%
% we need to 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_name(ModuleInfo0, ModuleName),
module_info_next_lambda_count(LambdaCount,
ModuleInfo0, ModuleInfo1),
goal_info_get_context(LambdaGoalInfo, OrigContext),
term__context_file(OrigContext, OrigFile),
term__context_line(OrigContext, OrigLine),
make_pred_name_with_context(ModuleName, "IntroducedFrom",
PredOrFunc, OrigPredName, OrigLine,
LambdaCount, PredName),
goal_info_get_context(LambdaGoalInfo, LambdaContext),
% 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 = [],
lambda__uni_modes_to_modes(UniModes1, 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.
mode_util__modes_to_uni_modes(ArgModes1, ArgModes1,
ModuleInfo1, UniModes),
list__append(ArgModes1, Modes, AllArgModes),
map__apply_to_list(AllArgVars, VarTypes, ArgTypes),
purity_to_markers(Purity, LambdaMarkers0),
(
% Pass through the aditi markers for
% aggregate query closures.
% XXX we should differentiate between normal
% top-down closures and aggregate query closures,
% possibly by using a different type for aggregate
% queries. Currently all nondet lambda expressions
% within Aditi predicates are treated as aggregate
% inputs.
% EvalMethod = (aditi_bottom_up),
determinism_components(Detism, _, at_most_many),
check_marker(Markers, aditi)
->
markers_to_marker_list(Markers, MarkerList0),
list__filter(
(pred(Marker::in) is semidet :-
% Pass through only Aditi markers.
% Don't pass through `context' markers, since
% they are useless for non-recursive predicates
% such as the created predicate.
( Marker = aditi
; Marker = dnf
; Marker = psn
; Marker = naive
; Marker = supp_magic
; Marker = aditi_memo
; Marker = aditi_no_memo
)),
MarkerList0, MarkerList),
list__foldl(add_marker, MarkerList,
LambdaMarkers0, LambdaMarkers)
;
EvalMethod = (aditi_bottom_up)
->
add_marker(aditi, LambdaMarkers0, LambdaMarkers)
;
LambdaMarkers = LambdaMarkers0
),
% Now construct the proc_info and pred_info for the new
% single-mode predicate, using the information computed above
proc_info_create(LambdaContext, VarSet, VarTypes,
AllArgVars, InstVarSet, AllArgModes, Detism,
LambdaGoal, TVarMap, TCVarMap, address_is_taken,
ProcInfo0),
% The debugger ignores unnamed variables.
ensure_all_headvars_are_named(ProcInfo0, ProcInfo1),
% 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,
requantify_proc(ProcInfo1, ProcInfo)
;
MustRecomputeNonLocals0 = no,
ProcInfo = ProcInfo1
),
set__init(Assertions),
pred_info_create(ModuleName, PredName, PredOrFunc,
LambdaContext, lambda(OrigFile, OrigLine), local,
LambdaMarkers, ArgTypes, TVarSet, ExistQVars,
Constraints, Assertions, Owner, 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 = pred_const(ShroudedPredProcId, EvalMethod),
Functor = functor(ConsId, no, ArgVars),
Unification = construct(Var, ConsId, ArgVars, UniModes,
construct_dynamically, cell_is_unique, no),
LambdaInfo = lambda_info(VarSet, VarTypes, Constraints, TVarSet,
InstVarSet, TVarMap, TCVarMap, Markers, POF, OrigPredName,
Owner, ModuleInfo, MustRecomputeNonLocals).
:- pred lambda__constraint_contains_vars(list(tvar)::in, prog_constraint::in)
is semidet.
lambda__constraint_contains_vars(LambdaVars, ClassConstraint) :-
ClassConstraint = constraint(_, ConstraintTypes),
list__map(prog_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).
:- pred lambda__uni_modes_to_modes(list(uni_mode)::in, list(mode)::out)
is det.
% 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.
lambda__uni_modes_to_modes([], []).
lambda__uni_modes_to_modes([UniMode | UniModes], [Mode | Modes]) :-
UniMode = ((_Initial0 - Initial1) -> (_Final0 - _Final1)),
Mode = (Initial1 -> Initial1),
lambda__uni_modes_to_modes(UniModes, Modes).
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
Reference in New Issue View Git Blame Copy Permalink