%-----------------------------------------------------------------------------% % vim: ft=mercury ts=4 sw=4 et %-----------------------------------------------------------------------------% % Copyright (C) 1995-2012 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 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 '__LambdaGoal__1'(int::in, int::out) is nondet. % '__LambdaGoal__1'(X, Y) :- q(Y, X). % % p(X) :- % V__1 = '__LambdaGoal__1'(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'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 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 can't 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 hlds.vartypes. :- import_module mdbcomp. :- import_module mdbcomp.prim_data. :- import_module parse_tree. :- import_module parse_tree.prog_data. :- import_module parse_tree.set_of_var. :- import_module bool. :- import_module list. %-----------------------------------------------------------------------------% :- 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. %-----------------------------------------------------------------------------% % The following are exported for float_reg.m. :- type lambda_info. :- type reg_wrapper_proc ---> reg_wrapper_proc(set_of_progvar) ; not_reg_wrapper_proc. :- pred init_lambda_info(prog_varset::in, vartypes::in, tvarset::in, inst_varset::in, rtti_varmaps::in, has_parallel_conj::in, pred_info::in, module_info::in, lambda_info::out) is det. :- pred lambda_info_get_varset(lambda_info::in, prog_varset::out) is det. :- pred lambda_info_get_vartypes(lambda_info::in, vartypes::out) is det. :- pred lambda_info_get_tvarset(lambda_info::in, tvarset::out) is det. :- pred lambda_info_get_rtti_varmaps(lambda_info::in, rtti_varmaps::out) is det. :- pred lambda_info_get_inst_varset(lambda_info::in, inst_varset::out) is det. :- pred lambda_info_get_pred_info(lambda_info::in, pred_info::out) is det. :- pred lambda_info_get_module_info(lambda_info::in, module_info::out) is det. :- pred lambda_info_get_recompute_nonlocals(lambda_info::in, bool::out) is det. :- pred lambda_info_set_varset(prog_varset::in, lambda_info::in, lambda_info::out) is det. :- pred lambda_info_set_vartypes(vartypes::in, lambda_info::in, lambda_info::out) is det. :- pred lambda_info_set_module_info(module_info::in, lambda_info::in, lambda_info::out) is det. :- pred lambda_info_set_recompute_nonlocals(bool::in, lambda_info::in, lambda_info::out) is det. :- pred expand_lambda(purity::in, ho_groundness::in, pred_or_func::in, lambda_eval_method::in, reg_wrapper_proc::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. %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% :- implementation. :- import_module check_hlds. :- 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.pred_table. :- import_module hlds.quantification. :- import_module hlds.status. :- import_module libs. :- import_module libs.globals. :- import_module libs.options. :- 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 int. :- import_module map. :- import_module maybe. :- import_module pair. :- import_module require. :- import_module set. :- import_module term. :- import_module varset. %-----------------------------------------------------------------------------% :- type lambda_info ---> lambda_info( li_varset :: prog_varset, li_vartypes :: vartypes, li_tvarset :: tvarset, li_inst_varset :: inst_varset, li_rtti_varmaps :: rtti_varmaps, li_pred_info :: pred_info, li_module_info :: module_info, li_has_parallel_conj :: has_parallel_conj, li_recompute_nonlocals :: bool, % True iff we need to recompute the nonlocals. li_have_expanded_lambda :: bool % True if we expanded some lambda expressions. ). init_lambda_info(VarSet, VarTypes, TypeVarSet, InstVarSet, RttiVarMaps, HasParallelConj, PredInfo, ModuleInfo, Info) :- MustRecomputeNonLocals = no, HaveExpandedLambdas = no, Info = lambda_info(VarSet, VarTypes, TypeVarSet, InstVarSet, RttiVarMaps, PredInfo, ModuleInfo, HasParallelConj, MustRecomputeNonLocals, HaveExpandedLambdas). lambda_info_get_varset(Info, Info ^ li_varset). lambda_info_get_vartypes(Info, Info ^ li_vartypes). lambda_info_get_tvarset(Info, Info ^ li_tvarset). lambda_info_get_rtti_varmaps(Info, Info ^ li_rtti_varmaps). lambda_info_get_inst_varset(Info, Info ^ li_inst_varset). lambda_info_get_pred_info(Info, Info ^ li_pred_info). lambda_info_get_module_info(Info, Info ^ li_module_info). lambda_info_get_recompute_nonlocals(Info, Info ^ li_recompute_nonlocals). lambda_info_set_varset(VarSet, !Info) :- !Info ^ li_varset := VarSet. lambda_info_set_vartypes(VarTypes, !Info) :- !Info ^ li_vartypes := VarTypes. lambda_info_set_module_info(ModuleInfo, !Info) :- !Info ^ li_module_info := ModuleInfo. lambda_info_set_recompute_nonlocals(Recompute, !Info) :- !Info ^ li_recompute_nonlocals := Recompute. %-----------------------------------------------------------------------------% % % 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). 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_get_preds(!.ModuleInfo, PredTable0), map.lookup(PredTable0, PredId, PredInfo0), pred_info_get_proc_table(PredInfo0, ProcTable0), map.lookup(ProcTable0, ProcId, ProcInfo0), expand_lambdas_in_proc_2(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_get_preds(!.ModuleInfo, PredTable1), map.det_update(PredId, PredInfo, PredTable1, 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. pred_info_get_typevarset(!.PredInfo, TypeVarSet0), 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, !.PredInfo, !.ModuleInfo, HasParallelConj, MustRecomputeNonLocals0, HaveExpandedLambdas0), expand_lambdas_in_goal(Goal0, Goal1, Info0, Info1), Info1 = lambda_info(VarSet1, VarTypes1, TypeVarSet, _InstVarSet, RttiVarMaps1, _PredInfo, !:ModuleInfo, _HasParallelConj, 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), ( 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(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, not_reg_wrapper_proc, Vars, Modes, Det, NonLocalVars, LambdaGoal, Unification0, Y, Unification, !Info), GoalExpr = unify(LHS, Y, Mode, Unification, Context) ; ( RHS0 = rhs_var(_) ; RHS0 = rhs_functor(_, _, _) ), % We leave ordinary unifications unchanged. GoalExpr = unify(LHS, RHS0, Mode, Unification0, Context) ). %-----------------------------------------------------------------------------% expand_lambda(Purity, _Groundness, PredOrFunc, EvalMethod, RegWrapperProc, Vars, Modes, Detism, OrigNonLocals0, LambdaGoal, Unification0, Functor, Unification, LambdaInfo0, LambdaInfo) :- LambdaInfo0 = lambda_info(VarSet, VarTypes, TVarSet, InstVarSet, RttiVarMaps, OrigPredInfo, ModuleInfo0, HasParallelConj, 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), lookup_var_types(VarTypes, Vars, 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_of_var.insert_list(Vars, LambdaGoalNonLocals, LambdaNonLocals), goal_util.extra_nonlocal_typeinfos(RttiVarMaps, VarTypes, ExistQVars, LambdaNonLocals, ExtraTypeInfos), ( Unification0 = construct(Var, _, OrigNonLocals1, ArgUnifyModes0, _, _, _), % We used to use OrigVars = OrigNonLocals0 (from rhs_lambda_goal) but % the order of the variables does not necessarily match ArgUnifyModes0. OrigVars = OrigNonLocals1, trace [compiletime(flag("lambda_var_order"))] ( list.sort(OrigNonLocals0, SortedOrigNonLocals0), list.sort(OrigNonLocals1, SortedOrigNonLocals1), expect(unify(SortedOrigNonLocals0, SortedOrigNonLocals1), $pred, "OrigNonLocals0 != OrigNonLocals1") ) ; ( Unification0 = deconstruct(_, _, _, _, _, _) ; Unification0 = assign(_, _) ; Unification0 = simple_test(_, _) ; Unification0 = complicated_unify(_, _, _) ), unexpected($pred, "unexpected unification") ), set_of_var.delete_list(Vars, 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(ExtraTypeInfos, NonLocals1, NewTypeInfos), set_of_var.union(NonLocals1, NewTypeInfos, NonLocals), ( if set_of_var.is_empty(NewTypeInfos) then MustRecomputeNonLocals = MustRecomputeNonLocals0 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 = yes ), set_of_var.to_sorted_list(NonLocals, ArgVars1), ( if % 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. not ( 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_csharp ; Target = target_java ), ( 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) ) then ArgVars = InitialVars, PredId = PredId0, ProcId = ProcId0, modes_to_unify_modes(ModuleInfo0, CurriedArgModes, CurriedArgModes, ArgUnifyModes), % 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) else % 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), OrigPredName = pred_info_name(OrigPredInfo), 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 = [], 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(ModuleInfo1, ArgModes1, ArgModes1, ArgUnifyModes), list.append(ArgModes1, Modes, AllArgModes), lookup_var_types(VarTypes, AllArgVars, ArgTypes), list.foldl_corresponding(check_lambda_arg_type_and_mode(ModuleInfo1), 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, VarSet, LambdaVarSet, VarTypes, LambdaVarTypes, 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. ItemNumber = -1, proc_info_create(LambdaContext, ItemNumber, LambdaVarSet, LambdaVarTypes, 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 = yes, requantify_proc_general(ordinary_nonlocals_maybe_lambda, !ProcInfo) ; MustRecomputeNonLocals0 = no ), ( RegWrapperProc = reg_wrapper_proc(RegR_HeadVars), proc_info_set_reg_r_headvars(RegR_HeadVars, !ProcInfo) ; RegWrapperProc = not_reg_wrapper_proc ), ProcInfo = !.ProcInfo ), set.init(Assertions), pred_info_create(ModuleName, PredName, PredOrFunc, LambdaContext, origin_lambda(OrigFile, OrigLine, LambdaCount), pred_status(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, is_not_exist_constr, ArgVars), Unification = construct(Var, ConsId, ArgVars, ArgUnifyModes, construct_dynamically, cell_is_unique, no_construct_sub_info), HaveExpandedLambdas = yes, LambdaInfo = lambda_info(VarSet, VarTypes, TVarSet, InstVarSet, RttiVarMaps, OrigPredInfo, ModuleInfo, HasParallelConj, 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 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_lhs_rhs(_, from_to_insts(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 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), vartypes_to_sorted_assoc_list(!.VarTypes, VarTypesList0), filter_vartypes(VarTypesList0, [], RevVarTypesList, VarUses), list.reverse(RevVarTypesList, VarTypesList), vartypes_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, _, _), ( 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(_, _, _) ) ), ( 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_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 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(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). %---------------------------------------------------------------------------% :- end_module transform_hlds.lambda. %---------------------------------------------------------------------------%