%-----------------------------------------------------------------------------% % vim: ft=mercury ts=4 sw=4 et %-----------------------------------------------------------------------------% % Copyright (C) 1995-2012 The University of Melbourne. % Copyright (C) 2015 The Mercury team. % This file may only be copied under the terms of the GNU General % Public Licence - see the file COPYING in the Mercury distribution. %-----------------------------------------------------------------------------% % % File: stm.m % Author: lm % % This module contains the source to source transformations for expanding out % atomic goals. % % The atomic goals are converted into a series of predicate calls and % predicate definitions using standard calls from the library modules % "stm_builtin", "exception" and "univ". % % An example transformation might be the following: % % :- pred foo(int::in, int::out, io::di, io::uo) is det. % % foo(X, Y, IO0, IO) :- % atomic [outer(IO0, IO), inner(STM0, STM)] ( % stm_operations(X, Y, STM0, STM) % ... % ) % % into % % foo(X, Y, IO0, IO) :- % 'StmExpanded_toplevel_0_0_0'(X, Y, IO0, IO). % % :- pred 'StmExpanded_toplevel_0_0_0'(int::in, int::out, io::di, io::uo) % is det. % 'StmExpanded_toplevel_0_0_0'(X, Y, IO0, IO) :- % 'StmExpanded_rollback_0_0_0'(X, Y), % IO0 = IO. % % :- pred 'StmExpanded_rollback_0_0_0'(int::in, int::out) is cc_multi. % 'StmExpanded_rollback_0_0_0'(X, Y) :- % promise_pure ( % impure stm_create_trasaction_log(STM0), % Closure = 'StmExpanded_wrapper_0_0_0'(X), % unsafe_try_stm(Closure(X), Result0, STM0, STM), % ( % Result0 = succeeded(Y) % ; % Result0 = exception(Excp), % ( if Excp = univ(rollback_invalid_transaction) then % impure stm_discard_transaction_log(STM), % 'StmExpanded_rollback_0_0_0'(X, Y) % else if Excp = univ(rollback_retry) then % impure stm_lock, % impure stm_validate(STM, IsValid), % ( % IsValid = stm_transaction_valid, % impure stm_block(STM) % ; % IsValid = stm_transaction_invalid, % impure stm_unlock % ), % impure stm_discard_trasaction_log(STM), % 'StmExpanded_rollback_0_0_0'(X, Y) % else % impure stm_lock, % impure stm_validate(STM, IsValid), % impure stm_unlock, % ( % IsValid = stm_transaction_valid, % rethrow(Result0) % ; % IsValid = stm_transaction_invalid, % impure stm_discard_transaction_log(STM), % 'StmExpanded_rollback_0_0_0'(X, Y) % ) % ) % ) % ). % % :- pred 'StmExpanded_wrapper_0_0_0'(int::in, int::out, stm::di, stm::uo) % is det. % 'StmExpanded_wrapper_0_0_0'(X, Result, STM0, STM) :- % stm_operations(X, Y, STM0, STM) % ... % Result = Y, % promise_pure ( % impure stm_lock, % impure stm_validate(STM, IsValid), % ( % IsValid = stm_transaction_valid, % impure stm_commit(STM), % impure stm_unlock % ; % IsValid = stm_transaction_invalid, % impure stm_unlock, % throw(rollback_invalid_transaction) % ). % % Currently, the atomic goal supports a single STM transaction with any number % of input and output arguments. As the atomic goal may need to unroll the % call stack (when performing a retry or a rollback), the exception module % is used. The use of the exception module impacts the passing of output % variables and is explained below. % % Nonlocals instantiated before the atomic goal are passed through the % expanded predicates as input arguments (with mode "in"). Nonlocals which % are instantiated inside the atomic goal and are used outside the atomic goal % (which, for the sake of simplicitly, will be called "output" variables in % this discussion) are passed as output arguments in the "entrypoint" and % "rollback" expanded predicates (with mode "out). In the "actual" expanded % predicate, these variables must be passed as part of an exception result and % are handled in the following way: % % - If there are no output variables, a dummy variable is created and % passed up to the rollback predicate. This variable simply exists to % satify the requirement of the closure returning an argument and % will be ignored in the rollback predicate. % - If there is one output variable, that variable will be passed up to % the rollback predicate as it is. % - If there is more than one output variable, a tuple of these variables % is created and the tuple itself is passed up to the rollback predicate. % There, it will be deconstructed and the associated output variables % will be returned as output arguments. % % Currently a subset of the complete STM system is implemented. The following % features will be included in subsequent review postings. A number of % these relate to this module, whilst others relate to other modules. % % - Nested atomic blocks: Whilst this will eventually be incluced, this % is neither supported in the front end or in this module (although some % passes, such as the type checker, has code for handling this). % However, the current method of mode checking atomic goals pervents % nested atomic goals (the uniqueness of the outer and inner variables % are handled by inserting dummy predicates at the beginning and end % of the atomic goal. The current implementation of these predicates % only allow the outer variables to be of type io). % % - The "vars" parameter: The "vars" atomic goal parameter is used by the % programmer to list the outer variables. Whilst it is optional, the % variables it lists needs to be checked to ensure that they are properly % instantiated. % % - State Variables: The "outer" and "inner" atomic goal parameters are % designed to take state variables along with variable pairs. Although % they are handled in the parser, they are not yet handled in the % parse tree -> HLDS transformation. % % - Automatic importing of necessary modules: Currently, all necessary % modules must be explicitly imported by the programmer if they wish % to use the STM constructs. % %-----------------------------------------------------------------------------% :- module transform_hlds.stm_expand. :- interface. :- import_module hlds. :- import_module hlds.hlds_module. %-----------------------------------------------------------------------------% :- pred stm_process_module(module_info::in, module_info::out) is det. %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% :- implementation. :- import_module check_hlds. :- import_module check_hlds.inst_test. :- import_module check_hlds.mode_util. :- import_module check_hlds.polymorphism. :- import_module hlds.goal_util. :- import_module hlds.hlds_goal. :- import_module hlds.hlds_pred. :- import_module hlds.instmap. :- import_module hlds.make_goal. :- import_module hlds.pred_table. :- import_module hlds.quantification. :- import_module hlds.status. :- import_module hlds.vartypes. :- import_module mdbcomp. :- import_module mdbcomp.builtin_modules. :- import_module mdbcomp.prim_data. :- import_module mdbcomp.sym_name. :- import_module parse_tree. :- import_module parse_tree.builtin_lib_types. :- import_module parse_tree.prog_data. :- import_module parse_tree.prog_mode. :- import_module parse_tree.prog_type. :- import_module parse_tree.set_of_var. :- import_module assoc_list. :- import_module bool. :- import_module int. :- import_module io. :- import_module list. :- import_module map. :- import_module maybe. :- import_module pair. :- import_module require. :- import_module string. :- import_module term. :- import_module varset. %-----------------------------------------------------------------------------% % Information about the predicate which contains the atomic goal along % with other information relative to all STM expansions. % :- type stm_info ---> stm_info( stm_info_module_info :: module_info, stm_info_pred_id :: pred_id, stm_info_proc_id :: proc_id, stm_info_proc_info :: proc_info, stm_info_pred_info :: pred_info, stm_info_requalify :: bool, stm_info_expand_id :: int % Number of goals expanded ). % Information about a newly created predicate. Mainly used to save % explicitly passing pred_info and proc_info for creation of goals. % :- type stm_new_pred_info ---> stm_new_pred_info( new_pred_module_info :: module_info, new_pred_pred_id :: pred_id, new_pred_proc_id :: proc_id, new_pred_pred_info :: pred_info, new_pred_proc_info :: proc_info, new_pred_context :: term.context, new_pred_var_cnt :: int ). % Information about the local and non-local variables of an atomic goal. % :- type stm_goal_vars ---> stm_goal_vars( vars_input :: set_of_progvar, vars_local :: set_of_progvar, vars_output :: set_of_progvar, vars_innerDI :: prog_var, % inner STM di var vars_innerUO :: prog_var % inner STM uo var ). %-----------------------------------------------------------------------------% stm_process_module(!ModuleInfo) :- module_info_get_valid_pred_ids(!.ModuleInfo, PredIds), list.foldl(stm_process_pred, PredIds, !ModuleInfo), module_info_clobber_dependency_info(!ModuleInfo). :- pred stm_process_pred(pred_id::in, module_info::in, module_info::out) is det. stm_process_pred(PredId, !ModuleInfo) :- module_info_pred_info(!.ModuleInfo, PredId, PredInfo), ProcIds = pred_info_procids(PredInfo), list.foldl(stm_process_proc(PredId), ProcIds, !ModuleInfo). :- pred stm_process_proc(pred_id::in, proc_id::in, module_info::in, module_info::out) is det. stm_process_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), stm_process_proc_2(ProcInfo0, ProcInfo, PredId, ProcId, 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 stm_process_proc_2(proc_info::in, proc_info::out, pred_id::in, proc_id::in, pred_info::in, pred_info::out, module_info::in, module_info::out) is det. stm_process_proc_2(!ProcInfo, PredId, ProcId, !PredInfo, !ModuleInfo) :- proc_info_get_goal(!.ProcInfo, Goal0), proc_info_get_initial_instmap(!.ProcInfo, !.ModuleInfo, InitInstmap), StmInfo0 = stm_info(!.ModuleInfo, PredId, ProcId, !.ProcInfo, !.PredInfo, no, 0), stm_process_goal(InitInstmap, Goal0, Goal, StmInfo0, StmInfo), StmInfo = stm_info(!:ModuleInfo, _, _, !:ProcInfo, !:PredInfo, RecalcInfo, _), proc_info_set_goal(Goal, !ProcInfo), ( RecalcInfo = yes, requantify_proc_general(ordinary_nonlocals_no_lambda, !ProcInfo), recompute_instmap_delta_proc(recompute_atomic_instmap_deltas, !ProcInfo, !ModuleInfo) ; RecalcInfo = no ). :- pred stm_process_goal(instmap::in, hlds_goal::in, hlds_goal::out, stm_info::in, stm_info::out) is det. stm_process_goal(Instmap, Goal0, Goal, !Info) :- Goal0 = hlds_goal(GoalExpr0, GoalInfo0), ( GoalExpr0 = unify(_, _, _, _, _), Goal = Goal0 ; GoalExpr0 = conj(ConjType, Conjuncts0), stm_process_conj(Instmap, Conjuncts0, Conjuncts, !Info), GoalExpr = conj(ConjType, Conjuncts), Goal = hlds_goal(GoalExpr, GoalInfo0) ; GoalExpr0 = disj(Disjuncts0), stm_process_disj(Instmap, Disjuncts0, Disjuncts, !Info), GoalExpr = disj(Disjuncts), Goal = hlds_goal(GoalExpr, GoalInfo0) ; GoalExpr0 = negation(SubGoal0), stm_process_goal(Instmap, SubGoal0, SubGoal, !Info), GoalExpr = negation(SubGoal), Goal = hlds_goal(GoalExpr, GoalInfo0) ; GoalExpr0 = switch(Var, CanFail, Cases0), stm_process_switch_cases(Instmap, Cases0, Cases, !Info), GoalExpr = switch(Var, CanFail, Cases), Goal = hlds_goal(GoalExpr, GoalInfo0) ; GoalExpr0 = scope(Reason, InnerGoal0), ( Reason = from_ground_term(_, FGT), ( ( FGT = from_ground_term_construct ; FGT = from_ground_term_deconstruct ), % There can be no atomic goals inside this scope. Goal = Goal0 ; FGT = from_ground_term_other, stm_process_goal(Instmap, InnerGoal0, InnerGoal, !Info), GoalExpr = scope(Reason, InnerGoal), Goal = hlds_goal(GoalExpr, GoalInfo0) ; FGT = from_ground_term_initial, % These scopes should have been deleted by now. unexpected($module, $pred, "unexpected scope") ) ; ( Reason = exist_quant(_) ; Reason = promise_solutions(_, _) ; Reason = promise_purity(_) ; Reason = commit(_) ; Reason = barrier(_) ; Reason = trace_goal(_, _, _, _, _) ; Reason = loop_control(_, _, _) ), stm_process_goal(Instmap, InnerGoal0, InnerGoal, !Info), GoalExpr = scope(Reason, InnerGoal), Goal = hlds_goal(GoalExpr, GoalInfo0) ; ( Reason = require_detism(_) ; Reason = require_complete_switch(_) ; Reason = require_switch_arms_detism(_, _) ), % These scopes should have been deleted by now. unexpected($module, $pred, "unexpected scope") ) ; GoalExpr0 = if_then_else(Vars, Cond0, Then0, Else0), stm_process_if_then_else(Instmap, Cond0, Then0, Else0, Cond, Then, Else, !Info), GoalExpr = if_then_else(Vars, Cond, Then, Else), Goal = hlds_goal(GoalExpr, GoalInfo0) ; ( GoalExpr0 = generic_call(_, _, _, _, _) ; GoalExpr0 = plain_call(_, _, _, _, _, _) ; GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _) ), Goal = Goal0 ; % This should be expanded out at this stage GoalExpr0 = shorthand(ShortHand0), ( % XXX STM: Why do we ignore _MaybeOutputVars? ShortHand0 = atomic_goal(GoalType, Outer, Inner, _MaybeOutputVars, MainGoal0, OrElseGoals0, _OrElseInners), GoalDisj0 = [MainGoal0 | OrElseGoals0], stm_process_disj(Instmap, GoalDisj0, GoalDisj, !Info), MainGoal = list.det_head(GoalDisj), OrElseGoals = list.det_tail(GoalDisj), InstmapDelta = goal_info_get_instmap_delta(GoalInfo0), apply_instmap_delta(Instmap, InstmapDelta, FinalInstmap), % Traverse the goal and if an inside goal is encountered: % 1. If goal is single, connect the outers and inners % 2. Process or_else as if it would be called directly in goal stm_create_actual_goal(GoalType, Instmap, FinalInstmap, Outer, Inner, MainGoal, OrElseGoals, Goal, !Info) ; ShortHand0 = try_goal(_, _, _), unexpected($module, $pred, "try_goal") ; ShortHand0 = bi_implication(_, _), unexpected($module, $pred, "bi_implication") ) ). :- pred stm_process_conj(instmap::in, hlds_goals::in, hlds_goals::out, stm_info::in, stm_info::out) is det. stm_process_conj(Instmap0, GoalList0, GoalList, !Info) :- ( GoalList0 = [], GoalList = [] ; GoalList0 = [Goal0 | Goals0], InstmapDelta = goal_info_get_instmap_delta(GoalInfo), stm_process_goal(Instmap0, Goal0, Goal, !Info), Goal0 = hlds_goal(_, GoalInfo), apply_instmap_delta(Instmap0, InstmapDelta, Instmap), stm_process_conj(Instmap, Goals0, Goals, !Info), GoalList = [Goal | Goals] ). :- pred stm_process_disj(instmap::in, hlds_goals::in, hlds_goals::out, stm_info::in, stm_info::out) is det. stm_process_disj(Instmap, GoalList0, GoalList, !Info) :- ( GoalList0 = [], GoalList = [] ; GoalList0 = [Goal0 | Goals0], stm_process_goal(Instmap, Goal0, Goal, !Info), stm_process_disj(Instmap, Goals0, Goals, !Info), GoalList = [Goal | Goals] ). :- pred stm_process_if_then_else(instmap::in, hlds_goal::in, hlds_goal::in, hlds_goal::in, hlds_goal::out, hlds_goal::out, hlds_goal::out, stm_info::in, stm_info::out) is det. stm_process_if_then_else(Instmap0, Cond0, Then0, Else0, Cond, Then, Else, !Info) :- stm_process_goal(Instmap0, Cond0, Cond, !Info), % XXX: It is currently assumed that the initial instmap of the Then part % is the same as the final instmap of the condition part whilst the % initial instmap of the else part is the same as the initial instmap % of the entire if_then_else goal. I'm not sure if this is correct % or not. Cond0 = hlds_goal(_, CondInfo), CondInstmapDelta = goal_info_get_instmap_delta(CondInfo), apply_instmap_delta(Instmap0, CondInstmapDelta, InstmapAfterCond), stm_process_goal(InstmapAfterCond, Then0, Then, !Info), stm_process_goal(Instmap0, Else0, Else, !Info). :- pred stm_process_switch_cases(instmap::in, list(case)::in, list(case)::out, stm_info::in, stm_info::out) is det. stm_process_switch_cases(_Instmap0, [], [], !Info). stm_process_switch_cases(Instmap0, [Case0 | Cases0], [Case | Cases], !Info) :- Case0 = case(MainConsId, OtherConsIds, Goal0), stm_process_goal(Instmap0, Goal0, Goal, !Info), stm_process_switch_cases(Instmap0, Cases0, Cases, !Info), Case = case(MainConsId, OtherConsIds, Goal). %-----------------------------------------------------------------------------% % % Predicate related to the creation of the top level goal. % Creates all the required predicates and returns the call to the % newly created top_level goal. The InitInstmap and FinalInstmap is the % instmap before and after the atomic goal respectivly. % :- pred stm_create_actual_goal(atomic_goal_type::in, instmap::in, instmap::in, atomic_interface_vars::in, atomic_interface_vars::in, hlds_goal::in, list(hlds_goal)::in, hlds_goal::out, stm_info::in, stm_info::out) is det. stm_create_actual_goal(GoalType, InitInstmap, FinalInstmap, Outer, Inner, MainGoal, OrElseGoals, FinalGoal, !StmInfo) :- Outer = atomic_interface_vars(OuterDI, OuterUO), Inner = atomic_interface_vars(InnerDI, InnerUO), % Performs different operations based on the goal type ( GoalType = top_level_atomic_goal, create_top_level_goal(InitInstmap, FinalInstmap, OuterDI, OuterUO, InnerDI, InnerUO, MainGoal, OrElseGoals, FinalGoal, !StmInfo) ; GoalType = nested_atomic_goal, trace [compiletime(flag("debug_stm")), io(!IO)] ( io.write_string("Creating nested atomic goal\n",!IO) ), create_nested_goal(InitInstmap, FinalInstmap, OuterDI, OuterUO, InnerDI, InnerUO, MainGoal, OrElseGoals, FinalGoal, !StmInfo) ; GoalType = unknown_atomic_goal_type, unexpected($module, $pred, "unknown atomic goal type") ), !StmInfo ^ stm_info_requalify := yes. %-----------------------------------------------------------------------------% % % Predicates to determine if variables are inputs, outputs or local to a goal. % This decision is currenly governed by the following rules: % % 1. If it is free in the initial instmap and not free in the final instmap, % the variable is an output. % 2. If it is not free in the initial instmap and not free in the final % instmap, the % Arranges variables into groups of local variables, input variables and % output variables. This uses the instmap before and after the atomic % goal. % :- pred order_vars_into_groups(module_info::in, list(prog_var)::in, instmap::in, instmap::in, list(prog_var)::out, list(prog_var)::out, list(prog_var)::out) is det. order_vars_into_groups(ModuleInfo, Vars, InitInstmap, FinalInstmap, Local, Input, Output) :- order_vars_into_groups_2(ModuleInfo, Vars, InitInstmap, FinalInstmap, [], Local, [], Input, [], Output). :- pred order_vars_into_groups_2(module_info::in, list(prog_var)::in, instmap::in, instmap::in, list(prog_var)::in, list(prog_var)::out, list(prog_var)::in, list(prog_var)::out, list(prog_var)::in, list(prog_var)::out) is det. order_vars_into_groups_2(_, [], _, _, !Local, !Input, !Output). order_vars_into_groups_2(ModuleInfo, [Var|Vars], InitInstmap, FinalInstmap, !LocalVars, !InputVars, !OutputVars) :- instmap_lookup_var(InitInstmap, Var, InitVarInst), instmap_lookup_var(FinalInstmap, Var, FinalVarInst), ( if inst_is_free(ModuleInfo, InitVarInst), inst_is_free(ModuleInfo, FinalVarInst) then !:LocalVars = [Var | !.LocalVars] else if inst_is_free(ModuleInfo, InitVarInst), inst_is_bound(ModuleInfo, FinalVarInst) then !:OutputVars = [Var | !.OutputVars] else if inst_is_bound(ModuleInfo, InitVarInst), inst_is_bound(ModuleInfo, FinalVarInst) then !:InputVars = [Var | !.InputVars] else unexpected($module, $pred, "unhandled inst case") ), order_vars_into_groups_2(ModuleInfo, Vars, InitInstmap, FinalInstmap, !LocalVars, !InputVars, !OutputVars). % Return the var sets for the first atomic goal in the list, taking the % union of the input var sets of all the goals. If the first atomic goal % does not succeed, we will try the later goals, so inputs to the later % goals must also be inputs of the first goal. % % XXX This probably could done directly in calc_pred_variables_list. % :- pred common_goal_vars_from_list(list(stm_goal_vars)::in, stm_goal_vars::out) is det. common_goal_vars_from_list(GoalList, GoalVar) :- ExtractInputSet = (pred(AGV::in, Input::out) is det :- Input = AGV ^ vars_input), list.map(ExtractInputSet, GoalList, InputVarList), InputVars = set_of_var.union_list(InputVarList), GoalVar0 = list.det_head(GoalList), GoalVar = GoalVar0 ^ vars_input := InputVars. :- pred copy_input_vars_in_goallist(stm_goal_vars::in, list(stm_goal_vars)::in, list(stm_goal_vars)::out) is det. copy_input_vars_in_goallist(GoalVar, !GoalList) :- CopyInputVarLambda = (pred(AGV0::in, AGV::out) is det :- AGV = AGV0 ^ vars_input := (GoalVar ^ vars_input)), list.map(CopyInputVarLambda, !GoalList). :- pred calc_pred_variables_list(instmap::in, instmap::in, hlds_goals::in, list(prog_var)::in, list(prog_var)::in, list(prog_var)::in, list(stm_goal_vars)::out, stm_info::in, stm_info::out) is det. calc_pred_variables_list(InitInstmap, FinalInstmap, Goals, InnerDIs, InnerUOs, IgnoreVarList0, StmGoalVarList, !StmInfo) :- ( if Goals = [], InnerDIs = [], InnerUOs = [] then StmGoalVarList = [] else if Goals = [HeadGoal | TailGoals], InnerDIs = [HeadInnerDI | TailInnerDIs], InnerUOs = [HeadInnerUO | TailInnerUOs] then IgnoreVarList = [HeadInnerDI, HeadInnerUO | IgnoreVarList0], calc_pred_variables(InitInstmap, FinalInstmap, HeadGoal, HeadInnerDI, HeadInnerUO, IgnoreVarList, StmGoalVar, !StmInfo), calc_pred_variables_list(InitInstmap, FinalInstmap, TailGoals, TailInnerDIs, TailInnerUOs, IgnoreVarList, StmGoalVarList0, !StmInfo), StmGoalVarList = [StmGoalVar | StmGoalVarList0] else unexpected($module, $pred, "lengths mismatch") ). % Arranges all variables from the goal and non-locals into local variables, % input variables and output variables. All variables that appear in the % list of IgnoreVarList are not included. % :- pred calc_pred_variables(instmap::in, instmap::in, hlds_goal::in, prog_var::in, prog_var::in, list(prog_var)::in, stm_goal_vars::out, stm_info::in, stm_info::out) is det. calc_pred_variables(InitInstmap, FinalInstmap, Goal, InnerDI, InnerUO, IgnoreVarList, StmGoalVars, !StmInfo) :- ModuleInfo = !.StmInfo ^ stm_info_module_info, goal_vars(Goal, GoalVars0), set_of_var.delete_list(IgnoreVarList, GoalVars0, GoalVars), GoalVarList = set_of_var.to_sorted_list(GoalVars), Goal = hlds_goal(_, GoalInfo), GoalNonLocalSet0 = goal_info_get_nonlocals(GoalInfo), set_of_var.delete_list(IgnoreVarList, GoalNonLocalSet0, GoalNonLocalSet), GoalNonLocals = set_of_var.to_sorted_list(GoalNonLocalSet), order_vars_into_groups(ModuleInfo, GoalVarList, InitInstmap, FinalInstmap, LocalVarsList, InputVarsList, _), order_vars_into_groups(ModuleInfo, GoalNonLocals, InitInstmap, FinalInstmap, _, _InputVarsList, OutputVarsList), LocalVars = set_of_var.list_to_set(LocalVarsList), InputVars = set_of_var.list_to_set(InputVarsList), OutputVars = set_of_var.list_to_set(OutputVarsList), StmGoalVars = stm_goal_vars(InputVars, LocalVars, OutputVars, InnerDI, InnerUO). %-----------------------------------------------------------------------------% % % Predicates involved in the removal of the dummy predicates % "stm_from_inner_to_outer" and "stm_from_outer_to_inner". % % Removes all calls to the dummy predicates in a list of goals. % :- pred remove_tail(hlds_goals::in, hlds_goals::out, pair(maybe(prog_var), maybe(prog_var))::out, pair(maybe(prog_var), maybe(prog_var))::out) is det. remove_tail([], [], no - no, no - no). remove_tail([HeadGoal0 | TailGoals0], Goals, MaybeOutDI - MaybeOutUO, MaybeInDI - MaybeInUO) :- remove_tail(TailGoals0, TailGoals, MaybeOutDI0 - MaybeOutUO0, MaybeInDI0 - MaybeInUO0), HeadGoal0 = hlds_goal(HeadGoalExpr0, _), ( if HeadGoalExpr0 = plain_call(_, _, [_, X, V], _, _, stm_outer_inner) then MaybeInDI = yes(V), MaybeInUO = MaybeInUO0, MaybeOutDI = yes(X), MaybeOutUO = MaybeOutUO0, Goals = TailGoals else if HeadGoalExpr0 = plain_call(_, _, [_, V, X], _, _, stm_inner_outer) then MaybeInDI = MaybeInDI0, MaybeInUO = yes(V), MaybeOutDI = MaybeOutDI0, MaybeOutUO = yes(X), Goals = TailGoals else Goals = [HeadGoal0 | TailGoals], MaybeInDI = MaybeInDI0, MaybeInUO = MaybeInUO0, MaybeOutDI = MaybeOutDI0, MaybeOutUO = MaybeOutUO0 ). % Strip the dummy predicates. At the very minimum, these predicates % should be in the atomic goal so the atomic goal must be a conjunction. % :- pred strip_goal_calls(hlds_goal::in, hlds_goal::out, prog_var::out, prog_var::out, prog_var::out, prog_var::out) is det. strip_goal_calls(Goal0, Goal, StmOutDI, StmOutUO, StmInDI, StmInUO) :- ( if Goal0 = hlds_goal(conj(plain_conj, GoalList0), GoalInfo) then ( GoalList0 = [], unexpected($module, $pred, "empty conjunction") ; GoalList0 = [_ | _], remove_tail(GoalList0, GoalList, MaybeOutVarPair, MaybeInVarPair), MaybeInDI = fst(MaybeInVarPair), MaybeInUO = snd(MaybeInVarPair), MaybeOutDI = fst(MaybeOutVarPair), MaybeOutUO = snd(MaybeOutVarPair), ( if MaybeInDI = yes(StmInDI0), MaybeInUO = yes(StmInUO0), MaybeOutDI = yes(StmOutDI0), MaybeOutUO = yes(StmOutUO0) then StmInDI = StmInDI0, StmInUO = StmInUO0, StmOutDI = StmOutDI0, StmOutUO = StmOutUO0, Goal = hlds_goal(conj(plain_conj, GoalList), GoalInfo) else unexpected($module, $pred, "Vars not extracted") ) ) else unexpected($module, $pred, "atomic_goal not a conj") ). %-----------------------------------------------------------------------------% % % Predicates related to the creation of the top level predicate. % The created predicate calls the rollback predicate and threads the IO state. % Creating the top-level predicate implicitly creates the rollback predicate % and wrapper predicates. % % Creates a nested atomic goal % :- pred create_nested_goal(instmap::in, instmap::in, prog_var::in, prog_var::in, prog_var::in, prog_var::in, hlds_goal::in, list(hlds_goal)::in, hlds_goal::out, stm_info::in, stm_info::out) is det. create_nested_goal(InitInstmap, FinalInstmap, OuterDI, OuterUO, _InnerDI, _InnerUO, AtomicGoal0, OrElseGoals0, Goal, !StmInfo) :- strip_goal_calls(AtomicGoal0, AtomicGoal, MainOuterDI, MainOuterUO, MainInnerDI, MainInnerUO), list.map5(strip_goal_calls, OrElseGoals0, OrElseGoals, _, _, OrElseInnerDIs, OrElseInnerUOs), ( OrElseGoals = [], % If no or_else goals, simply connect up the outer and inner variables. create_var_unify_stm(MainInnerDI, MainOuterDI, uo_mode - di_mode, CopyDIVars, !StmInfo), create_var_unify_stm(MainOuterUO, MainInnerUO, uo_mode - di_mode, CopyUOVars, !StmInfo), create_plain_conj([CopyDIVars, AtomicGoal, CopyUOVars], Goal) ; OrElseGoals = [_ | _], % Creates a call to an or_else branch predicate. calc_pred_variables_list(InitInstmap, FinalInstmap, [AtomicGoal0 | OrElseGoals0], [MainInnerDI | OrElseInnerDIs], [MainInnerUO | OrElseInnerUOs], [OuterDI, OuterUO], AtomicGoalVarList, !StmInfo), GoalList = [AtomicGoal | OrElseGoals], common_goal_vars_from_list(AtomicGoalVarList, AtomicGoalVars), % copy_input_vars_in_goallist(AtomicGoalVars, AtomicGoalVarList, % AtomicGoalVarList1), AtomicGoalVarList1 = AtomicGoalVarList, trace [compiletime(flag("debug_stm")), io(!IO)] ( io.write_string("Local: " ++ string(AtomicGoalVars ^ vars_local) ++ "\n", !IO), io.write_string("Inner: " ++ string(AtomicGoalVars ^ vars_input) ++ "\n", !IO), io.write_string("Outer: " ++ string(AtomicGoalVars ^ vars_output) ++ "\n", !IO) ), get_input_output_types(AtomicGoalVars, !.StmInfo, _, OutputTypes), make_return_type(OutputTypes, ResultType), create_aux_variable_stm(ResultType, yes("res"), ResultVar, !StmInfo), CreateWrapperForEachGoal = ( pred(ThisGoal::in, GoalVars::in, PPID::out, SInfo0::in, SInfo::out) is det :- % These predicates should be plain predicates without code to % validate logs. create_simple_wrapper_pred(GoalVars, ResultType, ResultVar, ThisGoal, PPID, _, SInfo0, SInfo) ), map2_in_foldl(CreateWrapperForEachGoal, GoalList, AtomicGoalVarList1, PPIDList, !StmInfo), create_or_else_pred(AtomicGoalVars, AtomicGoalVarList1, PPIDList, MainInnerDI, MainInnerUO, OrElseCall, !StmInfo), create_var_unify_stm(MainInnerDI, MainOuterDI, uo_mode - di_mode, CopyDIVars, !StmInfo), create_var_unify_stm(MainOuterUO, MainInnerUO, uo_mode - di_mode, CopyUOVars, !StmInfo), create_plain_conj([CopyDIVars, OrElseCall, CopyUOVars], Goal) ). % Creates the top level predicate and returns a call to that predicate % :- pred create_top_level_goal(instmap::in, instmap::in, prog_var::in, prog_var::in, prog_var::in, prog_var::in, hlds_goal::in, list(hlds_goal)::in, hlds_goal::out, stm_info::in, stm_info::out) is det. create_top_level_goal(InitInstmap, FinalInstmap, OuterDI, OuterUO, _InnerDI, _InnerUO, AtomicGoal0, OrElseGoals0, Goal, !StmInfo) :- strip_goal_calls(AtomicGoal0, AtomicGoal, _, _, MainInnerDI, MainInnerUO), list.map5(strip_goal_calls, OrElseGoals0, OrElseGoals, _, _, OrElseInnerDIs, OrElseInnerUOs), % The input and output variables of the atomic goal and or_else goals % should be the same as or_elses are treated as disjunctions. calc_pred_variables_list(InitInstmap, FinalInstmap, [AtomicGoal0 | OrElseGoals0], [MainInnerDI | OrElseInnerDIs], [MainInnerUO | OrElseInnerUOs], [OuterDI, OuterUO], AtomicGoalVarList, !StmInfo), create_top_level_pred(AtomicGoalVarList, OuterDI, OuterUO, AtomicGoal, OrElseGoals, Goal, !StmInfo). % Creates the top level predicate. Calling this implicitly creates the % rollback and wrapper predicate. % :- pred create_top_level_pred(list(stm_goal_vars)::in, prog_var::in, prog_var::in, hlds_goal::in, list(hlds_goal)::in, hlds_goal::out, stm_info::in, stm_info::out) is det. create_top_level_pred(AtomicGoalVarList, OuterDI, OuterUO, AtomicGoal, OrElseGoals, Goal, !StmInfo) :- create_rollback_pred(AtomicGoalVarList, WrapperCall, AtomicGoal, OrElseGoals, !StmInfo), common_goal_vars_from_list(AtomicGoalVarList, AtomicGoalVars), get_input_output_varlist(AtomicGoalVars, InputVars, OutputVars), get_input_output_types(AtomicGoalVars, !.StmInfo, InputTypes, OutputTypes), get_input_output_modes(AtomicGoalVars, InputModes, OutputModes), create_cloned_pred(InputVars ++ OutputVars ++ [OuterDI, OuterUO], InputTypes ++ OutputTypes ++ [io_io_type, io_io_type], InputModes ++ OutputModes ++ [di_mode, uo_mode], "toplevel", AtomicGoal, no, NewPredInfo0, Goal, !StmInfo), create_var_unify(OuterUO, OuterDI, uo_mode - di_mode, CopyIOAssign, NewPredInfo0, NewPredInfo1), create_plain_conj([WrapperCall, CopyIOAssign], TopLevelGoal), new_pred_set_goal(TopLevelGoal, NewPredInfo1, NewPredInfo2), run_quantification_over_pred(NewPredInfo2, NewPredInfo), commit_new_pred(NewPredInfo, !StmInfo). %-----------------------------------------------------------------------------% % % Template predicates. These predicates are used to create frequently % occurring patterns in the predicate clause. % % Predicate that creates the following goal: % % ( if % X <- univ.univ(<>), % X == << stm_rollback_exception_functor >> % then % << true_goal >> % else % << false_goal >> % ) % % The RttiVar variable must contain ... % :- pred template_if_exceptres_is_cons(prog_var::in, prog_var::in, cons_id::in, hlds_goal::in, hlds_goal::in, hlds_goal::out, stm_new_pred_info::in, stm_new_pred_info::out) is det. template_if_exceptres_is_cons(RttiVar, ExceptVar, RollbackExceptCons, TrueGoal, FalseGoal, Goal, !NewPredInfo) :- create_aux_variable(stm_rollback_exception_type, yes("UnivPayload"), UnivPayloadVar, !NewPredInfo), create_aux_variable_assignment(RollbackExceptCons, stm_rollback_exception_type, yes("RollbackExcpt"), AssignGoal, RollbackExceptVar, !NewPredInfo), create_simple_call(mercury_univ_module, "type_to_univ", pf_predicate, mode_no(2), detism_semi, purity_pure, [RttiVar, UnivPayloadVar, ExceptVar], [], instmap_delta_from_assoc_list( [RttiVar - ground(shared, none_or_default_func), ExceptVar - ground(shared, none_or_default_func), UnivPayloadVar - free]), UnivCall, !NewPredInfo), create_simple_call(mercury_public_builtin_module, "unify", pf_predicate, only_mode, detism_semi, purity_pure, [RttiVar, RollbackExceptVar, UnivPayloadVar], [], instmap_delta_bind_no_var, _UnifyCall, !NewPredInfo), create_var_test(UnivPayloadVar, RollbackExceptVar, in_mode - in_mode, TestGoal, !NewPredInfo), % XXX STM % create_plain_conj([AssignGoal, UnivCall, TestGoal, UnifyCall], CondGoal), create_plain_conj([AssignGoal, UnivCall, TestGoal], CondGoal), ITEDetermism = detism_det, ITEPurity = purity_impure, create_if_then_else([], CondGoal, TrueGoal, FalseGoal, ITEDetermism, ITEPurity, Goal, !NewPredInfo). % Predicate that creates the following goals. % % impure stm_builtin.lock, % impure stm_builtin.validate(<>, IsValid), % { impure stm_builtin.unlock } when unlock_after == yes % ( % IsValid = stm_transaction_valid, % << TrueGoal >> % ; % IsValid = stm_transaction_invalid, % << FalseGoal >> % ) % % The call to "stm_builtin.unlock" is only included if the value of % UnlockAfterwards is yes. % :- pred template_lock_and_validate(prog_var::in, bool::in, hlds_goal::in, hlds_goal::in, hlds_goals::out, stm_new_pred_info::in, stm_new_pred_info::out) is det. template_lock_and_validate(StmVar, UnlockAfterwards, ValidGoal, InvalidGoal, Goals, !NewPredInfo) :- create_aux_variable(stm_valid_result_type, yes("ValidResult"), IsValidVar, !NewPredInfo), create_simple_call(mercury_stm_builtin_module, "stm_lock", pf_predicate, only_mode, detism_det, purity_impure, [], [], instmap_delta_bind_no_var, LockCall, !NewPredInfo), create_simple_call(mercury_stm_builtin_module, "stm_validate", pf_predicate, only_mode, detism_det, purity_impure, [StmVar, IsValidVar], [], instmap_delta_from_assoc_list( [StmVar - ground(unique, none_or_default_func), IsValidVar - free]), ValidCall, !NewPredInfo), create_switch_disjunction(IsValidVar, [case(stm_validres_valid_functor, [], ValidGoal), case(stm_validres_invalid_functor, [], InvalidGoal)], detism_det, purity_impure, DisjGoal, !NewPredInfo), ( UnlockAfterwards = yes, create_simple_call(mercury_stm_builtin_module, "stm_unlock", pf_predicate, only_mode, detism_det, purity_impure, [], [], instmap_delta_bind_no_var, UnlockCall, !NewPredInfo), Goals = [LockCall, ValidCall, UnlockCall, DisjGoal] ; UnlockAfterwards = no, Goals = [LockCall, ValidCall, DisjGoal] ). % Lock and validate a number of transactions. The success branch will % be passed if all transactions are valid. % :- pred template_lock_and_validate_many(list(prog_var)::in, bool::in, hlds_goal::in, hlds_goal::in, hlds_goals::out, stm_new_pred_info::in, stm_new_pred_info::out) is det. template_lock_and_validate_many(StmVars, UnlockAfterwards, ValidGoal, InvalidGoal, Goals, !NewPredInfo) :- create_aux_variable_assignment(stm_validres_valid_functor, stm_valid_result_type, yes("IsValidConst"), AssignValidConst, IsValidConstVar, !NewPredInfo), create_simple_call(mercury_stm_builtin_module, "stm_lock", pf_predicate, only_mode, detism_det, purity_impure, [], [], instmap_delta_bind_no_var, LockCall, !NewPredInfo), % Create N value result variables. Variables are returned as a list CreateValidate = (pred(StmVarL::in, ValidGoalL::out, ValidResL::out, NPI0::in, NPI::out) is det :- create_aux_variable(stm_valid_result_type, yes("ValidResult"), ValidResL, NPI0, NPI1), create_simple_call(mercury_stm_builtin_module, "stm_validate", pf_predicate, only_mode, detism_det, purity_impure, [StmVarL, ValidResL], [], instmap_delta_from_assoc_list( [StmVarL - ground(unique, none_or_default_func), ValidResL - free]), ValidGoalL, NPI1, NPI)), list.map2_foldl(CreateValidate, StmVars, ValidCalls, IsValidVars, !NewPredInfo), CreateValidTests = (pred(ValidRes::in, ValidTest::out, NPI0::in, NPI::out) is det :- create_var_test(ValidRes, IsValidConstVar, in_mode - in_mode, ValidTest, NPI0, NPI) ), list.map_foldl(CreateValidTests, IsValidVars, TestValidGoals, !NewPredInfo), create_plain_conj(TestValidGoals, TestValidCond), create_if_then_else([], TestValidCond, ValidGoal, InvalidGoal, detism_cc_multi, purity_impure, ITEGoal, !NewPredInfo), ( UnlockAfterwards = yes, create_simple_call(mercury_stm_builtin_module, "stm_unlock", pf_predicate, only_mode, detism_det, purity_impure, [], [], instmap_delta_bind_no_var, UnlockCall, !NewPredInfo), Goals = [AssignValidConst, LockCall | ValidCalls] ++ [UnlockCall, ITEGoal] ; UnlockAfterwards = no, Goals = [AssignValidConst, LockCall | ValidCalls] ++ [ITEGoal] ). %-----------------------------------------------------------------------------% % % Predicates involved in the creation of the rollback predicate. The rollback % predicate is responsible for calling the wrapper predicate and handling % the excepion result. If the exception result indicates a rollback because % of an invalid transaction or a retry, this predicate is responsible for % handling these. For an example of the goals created by this predicate, % please see the comment in the top of this file. % % Creates the necessary goals for handling exceptions that do not indicate % a rollback. The role of the these goals is to validate the transaction % log and act upon the result. The goals created are listed below: % % impure stm_builtin.stm_lock, % impure stm_builtin.validate(STM, IsValid), % impure stm_builtin.stm_unlock, % ( % IsValid = stm_transaction_valid, % rethrow(Exception) % ; % IsValid = stm_transaction_invalid, % impure stm_discard_transaction_log(STM), % 'StmExpanded_rollback_0_0_0'(X, Y) % ) % :- pred create_validate_exception_goal(prog_var::in, prog_var::in, mer_type::in, hlds_goal::in, hlds_goal::out, stm_new_pred_info::in, stm_new_pred_info::out) is det. create_validate_exception_goal(StmVar, ExceptionVar, ReturnType, RecursiveCall, Goal, !NewPredInfo) :- make_type_info(ReturnType, TypeInfoVar, CreateTypeInfoGoals, !NewPredInfo), create_simple_call(mercury_exception_module, "rethrow", pf_predicate, only_mode, detism_erroneous, purity_pure, [TypeInfoVar, ExceptionVar], [], instmap_delta_bind_vars([TypeInfoVar, ExceptionVar]), Goal_ExceptionThrow_Call, !NewPredInfo), create_plain_conj(CreateTypeInfoGoals ++ [Goal_ExceptionThrow_Call], Goal_ValidBranch), create_simple_call(mercury_stm_builtin_module, "stm_discard_transaction_log", pf_predicate, only_mode, detism_det, purity_impure, [StmVar], [], instmap_delta_from_assoc_list( [StmVar - ground(clobbered, none_or_default_func)]), DropStateCall, !NewPredInfo), create_plain_conj([DropStateCall, RecursiveCall], Goal_InvalidBranch), template_lock_and_validate(StmVar, yes, Goal_ValidBranch, Goal_InvalidBranch, Goals, !NewPredInfo), create_plain_conj(Goals, Goal). % Creates the necessary goals for handling explicit retries. The role % of these goals is to validate the log and block the thread if the % log is valid (provided that transaction variables to wait on exist % in the log). % :- pred create_retry_handler_branch(prog_var::in, hlds_goal::in, hlds_goal::out, stm_new_pred_info::in, stm_new_pred_info::out) is det. create_retry_handler_branch(StmVar, RecCall, Goal, !NewPredInfo) :- create_simple_call(mercury_stm_builtin_module, "stm_block", pf_predicate, only_mode, detism_det, purity_impure, [StmVar], [], instmap_delta_bind_var(StmVar), BlockGoal, !NewPredInfo), create_simple_call(mercury_stm_builtin_module, "stm_unlock", pf_predicate, only_mode, detism_det, purity_impure, [], [], instmap_delta_bind_no_var, UnlockGoal, !NewPredInfo), template_lock_and_validate(StmVar, no, BlockGoal, UnlockGoal, LockAndValidateGoals, !NewPredInfo), create_simple_call(mercury_stm_builtin_module, "stm_discard_transaction_log", pf_predicate, only_mode, detism_det, purity_impure, [StmVar], [], instmap_delta_from_assoc_list( [StmVar - ground(clobbered, none_or_default_func)]), DropStateCall, !NewPredInfo), create_plain_conj(LockAndValidateGoals ++ [DropStateCall, RecCall], Goal). % Creates the necessary goals for switching on an exception. The role of % the created goals is to extract the exception from the exception result % (using predicates from the "univ" module) and create the if-then-else % statements which branch on the result. % :- pred create_test_on_exception(prog_var::in, prog_var::in, mer_type::in, hlds_goal::in, hlds_goal::out, stm_new_pred_info::in, stm_new_pred_info::out) is det. create_test_on_exception(ExceptVar, StmVar, ReturnType, RecCall, Goal, !NewPredInfo) :- create_aux_variable(univ_type, yes("ExceptUnivVar"), ExceptUnivVar, !NewPredInfo), deconstruct_functor(ExceptVar, exception_exception_functor, [ExceptUnivVar], DeconstructException), make_type_info(stm_rollback_exception_type, TypeInfoRollbackVar, TypeInfoRollbackAssign, !NewPredInfo), create_simple_call(mercury_stm_builtin_module, "stm_discard_transaction_log", pf_predicate, only_mode, detism_det, purity_impure, [StmVar], [], instmap_delta_from_assoc_list( [StmVar - ground(clobbered, none_or_default_func)]), DropStateGoal, !NewPredInfo), create_plain_conj([DropStateGoal, RecCall], TrueGoal), create_validate_exception_goal(StmVar, ExceptVar, ReturnType, RecCall, RethrowBranch, !NewPredInfo), create_retry_handler_branch(StmVar, RecCall, RetryBranch, !NewPredInfo), template_if_exceptres_is_cons(TypeInfoRollbackVar, ExceptUnivVar, stm_rollback_retry_functor, RetryBranch, RethrowBranch, FalseGoal, !NewPredInfo), template_if_exceptres_is_cons(TypeInfoRollbackVar, ExceptUnivVar, stm_rollback_exception_functor, TrueGoal, FalseGoal, IfThenElseGoal, !NewPredInfo), create_plain_conj([DeconstructException] ++ TypeInfoRollbackAssign ++ [IfThenElseGoal], Goal). % Creates the main goal for the rollback predicate. The goals created % by this predicate create the closure for the wrapper predicate and % deconstructs the value returned if no exception is present. It relies % on the above predicates to generate code for handling exceptions. % :- pred create_rollback_handler_goal(stm_goal_vars::in, mer_type::in, prog_var::in, prog_var::in, pred_proc_id::in, hlds_goal::in, hlds_goal::out, stm_info::in, stm_new_pred_info::in, stm_new_pred_info::out) is det. create_rollback_handler_goal(AtomicGoalVars, ReturnType, StmVarDI, StmVarUO, WrapperID, RecCall, Goal, StmInfo, !NewPredInfo) :- get_input_output_varlist(AtomicGoalVars, InputVars, _), get_input_output_types(AtomicGoalVars, StmInfo, InputTypes, _), get_input_output_modes(AtomicGoalVars, InputModes, _), create_closure(WrapperID, InputVars, InputTypes ++ [ReturnType, stm_state_type, stm_state_type], InputModes ++ [out_mode, di_mode, uo_mode], AtomicClosureVar, ClosureAssign, !NewPredInfo), make_type_info(ReturnType, RttiTypeVar, RttiTypeVarAssign, !NewPredInfo), % Creates the necessary exception types, based on the output type of % the stm predicate. Exception_Result_Type = exception_result_type(ReturnType), ExceptRes_Success_Functor = exception_succeeded_functor, ExceptRes_Failure_Functor = exception_exception_functor, create_aux_variable(Exception_Result_Type, yes("ExceptionResult"), ReturnExceptVar, !NewPredInfo), create_simple_call(mercury_stm_builtin_module, "stm_create_transaction_log", pf_predicate, only_mode, detism_det, purity_impure, [StmVarDI], [], instmap_delta_from_assoc_list( [StmVarDI - ground(unique, none_or_default_func)]), Goal_StmCreate, !NewPredInfo), % TODO: Select mode based on determism of actual goal. 0 if determistic, % 1 if cc_multi. create_simple_call(mercury_exception_module, "unsafe_try_stm", pf_predicate, mode_no(0), detism_cc_multi, purity_pure, [RttiTypeVar, AtomicClosureVar, ReturnExceptVar, StmVarDI, StmVarUO], [], instmap_delta_from_assoc_list([ RttiTypeVar - ground(shared, none_or_default_func), AtomicClosureVar - ground(shared, none_or_default_func), ReturnExceptVar - ground(shared, none_or_default_func), StmVarDI - ground(clobbered, none_or_default_func), StmVarUO - ground(unique, none_or_default_func)]), Goal_TryStm, !NewPredInfo), % For successfull execution, deconstruct and return true deconstruct_output(AtomicGoalVars, ReturnType, ReturnExceptVar, Branch_AtomicSuccess, StmInfo, !NewPredInfo), create_test_on_exception(ReturnExceptVar, StmVarUO, ReturnType, RecCall, Branch_AtomicException, !NewPredInfo), create_switch_disjunction(ReturnExceptVar, [case(ExceptRes_Failure_Functor, [], Branch_AtomicException), case(ExceptRes_Success_Functor, [], Branch_AtomicSuccess)], detism_det, purity_impure, DisjGoal, !NewPredInfo), create_plain_conj([Goal_StmCreate | RttiTypeVarAssign] ++ [ClosureAssign, Goal_TryStm, DisjGoal], Goal0), create_promise_purity_scope(Goal0, purity_pure, Goal). % Creates the rollback predicate. This predicate is responsible for % making the closure to the wrapper predicate and executing it whilst % catching any possible exceptions that might be thrown It is also % responsible for handing retries and rollbacks. % :- pred create_rollback_pred(list(stm_goal_vars)::in, hlds_goal::out, hlds_goal::in, list(hlds_goal)::in, stm_info::in, stm_info::out) is det. create_rollback_pred(AtomicGoalVarList, CallGoal, AtomicGoal, OrElseGoals, !StmInfo) :- common_goal_vars_from_list(AtomicGoalVarList, AtomicGoalVars), get_input_output_varlist(AtomicGoalVars, InputVars, OutputVars), get_input_output_types(AtomicGoalVars, !.StmInfo, InputTypes, OutputTypes), get_input_output_modes(AtomicGoalVars, InputModes, OutputModes), create_cloned_pred(InputVars ++ OutputVars, InputTypes ++ OutputTypes, InputModes ++ OutputModes, "rollback", AtomicGoal, no, NewPredInfo0, CallGoal, !StmInfo), create_rollback_pred_2(AtomicGoalVarList, CallGoal, AtomicGoal, OrElseGoals, NewPredInfo0, NewPredInfo, !StmInfo), commit_new_pred(NewPredInfo, !StmInfo). :- pred create_rollback_pred_2(list(stm_goal_vars)::in, hlds_goal::in, hlds_goal::in, list(hlds_goal)::in, stm_new_pred_info::in, stm_new_pred_info::out, stm_info::in, stm_info::out) is det. create_rollback_pred_2(AtomicGoalVarList, RecCallGoal, AtomicGoal, OrElseGoals, !NewPredInfo, !StmInfo) :- common_goal_vars_from_list(AtomicGoalVarList, AtomicGoalVars), get_input_output_types(AtomicGoalVars, !.StmInfo, _, OutputTypes), make_return_type(OutputTypes, ResultType), create_aux_variable(ResultType, yes("ResultVar"), ResultVar, !NewPredInfo), create_aux_variable(stm_state_type, yes("STM0"), InnerDI, !NewPredInfo), create_aux_variable(stm_state_type, yes("STM"), InnerUO, !NewPredInfo), % Temporally commits the predicate to the StmInfo so that the wrapper % predicate can have the most up to date copy of the module info. commit_new_pred(!.NewPredInfo, !StmInfo), ProcessGoalList = [AtomicGoal | OrElseGoals], create_wrapper_for_goal_list(AtomicGoalVarList, ResultType, ResultVar, ProcessGoalList, WrapperID, _, !StmInfo), % Stores the up to date module info back into the new predicate info. update_new_pred_info(!.StmInfo, !NewPredInfo), create_rollback_handler_goal(AtomicGoalVars, ResultType, InnerDI, InnerUO, WrapperID, RecCallGoal, RollbackGoal, !.StmInfo, !NewPredInfo), new_pred_set_goal(RollbackGoal, !NewPredInfo), run_quantification_over_pred(!NewPredInfo), commit_new_pred(!.NewPredInfo, !StmInfo). %-----------------------------------------------------------------------------% % % Predicates involved in moving local variables from the original predicate % to the newly created wrapper predicate. % Moves a single variable, along with its type, from the original % predicate to the newly created wrapper predicate. % :- pred apply_varset_to_preds(prog_var::in, prog_varset::in, prog_varset::out, vartypes::in, vartypes::out, prog_varset::in, prog_varset::out, vartypes::in, vartypes::out, prog_var_renaming::in, prog_var_renaming::out) is det. apply_varset_to_preds(ProgVar, !NewPredVarSet, !NewPredVarTypes, !OldPredVarSet, !OldPredVarTypes, !VarMapping) :- lookup_var_type(!.OldPredVarTypes, ProgVar, ProgType), % delete_var(!.OldPredVarSet, ProgVar, !:OldPredVarSet), % map.delete(!.OldPredVarTypes, ProgVar, !:OldPredVarTypes), varset.new_var(NewProgVar, !NewPredVarSet), add_var_type(NewProgVar, ProgType, !NewPredVarTypes), map.det_insert(ProgVar, NewProgVar, !VarMapping). % Moves all local variables from the original predicate to the newly % created wrapper predicate. This also includes the original STM % di and uo variables. % :- pred move_variables_to_new_pred(hlds_goal::in, hlds_goal::out, stm_goal_vars::in, prog_var::in, prog_var::in, stm_new_pred_info::in, stm_new_pred_info::out, stm_info::in, stm_info::out) is det. move_variables_to_new_pred(AtomicGoal0, AtomicGoal, AtomicGoalVars, InnerDI, InnerUO, !NewPredInfo, !StmInfo) :- NewProcInfo0 = !.NewPredInfo ^ new_pred_proc_info, OldProcInfo0 = !.StmInfo ^ stm_info_proc_info, proc_info_get_varset(NewProcInfo0, NewPredVarSet0), proc_info_get_vartypes(NewProcInfo0, NewPredVarTypes0), proc_info_get_varset(OldProcInfo0, OldPredVarSet0), proc_info_get_vartypes(OldProcInfo0, OldPredVarTypes0), AtomicGoalVars = stm_goal_vars(_, LocalVars, _, OrigInnerDI, OrigInnerUO), LocalVarList = set_of_var.to_sorted_list(LocalVars), VarMapping0 = map.init, list.foldl5(apply_varset_to_preds, LocalVarList, NewPredVarSet0, NewPredVarSet, NewPredVarTypes0, NewPredVarTypes, OldPredVarSet0, OldPredVarSet, OldPredVarTypes0, OldPredVarTypes, VarMapping0, VarMapping1), ( if OrigInnerDI = OrigInnerUO then map.det_insert(OrigInnerDI, InnerDI, VarMapping1, VarMapping) else map.det_insert(OrigInnerDI, InnerDI, VarMapping1, VarMapping2), map.det_insert(OrigInnerUO, InnerUO, VarMapping2, VarMapping) ), rename_some_vars_in_goal(VarMapping, AtomicGoal0, AtomicGoal), proc_info_set_varset(NewPredVarSet, NewProcInfo0, NewProcInfo1), proc_info_set_vartypes(NewPredVarTypes, NewProcInfo1, NewProcInfo), proc_info_set_varset(OldPredVarSet, OldProcInfo0, OldProcInfo1), proc_info_set_vartypes(OldPredVarTypes, OldProcInfo1, OldProcInfo), !NewPredInfo ^ new_pred_proc_info := NewProcInfo, !StmInfo ^ stm_info_proc_info := OldProcInfo. %-----------------------------------------------------------------------------% % % Predicates involved in the creation of the wrapper predicate. % :- pred create_wrapper_for_goal_list(list(stm_goal_vars)::in, mer_type::in, prog_var::in, list(hlds_goal)::in, pred_proc_id::out, hlds_goal::out, stm_info::in, stm_info::out) is det. create_wrapper_for_goal_list(AtomicGoalVarList, ResultType, ResultVar, GoalList, PredProcId, CallGoal, !StmInfo) :- ( GoalList = [], unexpected($module, $pred, "empty list") ; GoalList = [SingleGoal], AtomicGoalVars = list.det_head(AtomicGoalVarList), create_wrapper_pred(AtomicGoalVars, ResultType, ResultVar, SingleGoal, PredProcId, CallGoal, !StmInfo) ; GoalList = [_, _ | _], CreateWrapperForEachGoal = ( pred(Goal::in, GoalVars::in, PPID::out, SInfo0::in, SInfo::out) is det :- % These predicates should be plain predicates without code to % validate logs. create_simple_wrapper_pred(GoalVars, ResultType, ResultVar, Goal, PPID, _, SInfo0, SInfo) ), map2_in_foldl(CreateWrapperForEachGoal, GoalList, AtomicGoalVarList, PPIDList, !StmInfo), common_goal_vars_from_list(AtomicGoalVarList, AtomicGoalVars), % XXX STM % copy_input_vars_in_goallist(AtomicGoalVars, AtomicGoalVarList, % AtomicGoalVarList1), AtomicGoalVarList1 = AtomicGoalVarList, StmDI = AtomicGoalVars ^ vars_innerDI, StmUO = AtomicGoalVars ^ vars_innerUO, create_or_else_pred(AtomicGoalVars, AtomicGoalVarList1, PPIDList, StmDI, StmUO, NewAtomicGoal, !StmInfo), create_wrapper_pred(AtomicGoalVars, ResultType, ResultVar, NewAtomicGoal, PredProcId, CallGoal, !StmInfo) ). % Creates the wrapper predicate. Return the pred_proc_id of the newly % created wrapper predicate as well as a goal to call it. % :- pred create_wrapper_pred(stm_goal_vars::in, mer_type::in, prog_var::in, hlds_goal::in, pred_proc_id::out, hlds_goal::out, stm_info::in, stm_info::out) is det. create_wrapper_pred(AtomicGoalVars, ResultType, ResultVar0, AtomicGoal, PredProcId, CallGoal, !StmInfo) :- create_wrapper_pred_2(AtomicGoalVars, ResultType, ResultVar0, AtomicGoal, PredProcId, _, CallGoal, !StmInfo). :- pred create_wrapper_pred_2(stm_goal_vars::in, mer_type::in, prog_var::in, hlds_goal::in, pred_proc_id::out, stm_new_pred_info::out, hlds_goal::out, stm_info::in, stm_info::out) is det. create_wrapper_pred_2(AtomicGoalVars, ResultType, ResultVar0, !.AtomicGoal, PredProcId, !:NewPredInfo, CallGoal, !StmInfo) :- InnerDI = AtomicGoalVars ^ vars_innerDI, InnerUO0 = AtomicGoalVars ^ vars_innerUO, get_input_output_varlist(AtomicGoalVars, InputVars, _), get_input_output_types(AtomicGoalVars, !.StmInfo, InputTypes, _), get_input_output_modes(AtomicGoalVars, InputModes, _), create_cloned_pred(InputVars ++ [ResultVar0, InnerDI, InnerUO0], InputTypes ++ [ResultType, stm_state_type, stm_state_type], InputModes ++ [out_mode, di_mode, uo_mode], "wrapper", !.AtomicGoal, no, !:NewPredInfo, CallGoal, !StmInfo), rename_var_in_wrapper_pred("stm_ResultVar", ResultVar0, ResultType, ResultVar, !NewPredInfo, !AtomicGoal), move_variables_to_new_pred(!AtomicGoal, AtomicGoalVars, InnerDI, InnerUO0, !NewPredInfo, !StmInfo), % Handles the case when the Inner di and Inner uo variables are the same. % Explicitly creates a unification to keep these variables different % (because of the uniqueness requirements of a number of calls added to % the end of the original goal) ( if InnerUO0 = InnerDI then CopyStm = yes, create_aux_variable(stm_state_type, yes("NewUO"), InnerUO, !NewPredInfo) else CopyStm = no, InnerUO = InnerUO0 ), create_post_wrapper_goal(AtomicGoalVars, !.AtomicGoal, ResultType, ResultVar, InnerDI, InnerUO, CopyStm, WrapperGoal, !.StmInfo, !NewPredInfo), set_head_vars(InputVars ++ [ResultVar0, InnerDI, InnerUO], !NewPredInfo), new_pred_set_goal(WrapperGoal, !NewPredInfo), run_quantification_over_pred(!NewPredInfo), get_pred_proc_id(!.NewPredInfo, PredProcId), commit_new_pred(!.NewPredInfo, !StmInfo). % Creates the goals for validating and committing (or raising a rollback % exception) a transaction log. These goals appear after the original goal. % If the value of CopySTM is "yes", a goal unifying the variable in StmDI % and the variable in StmUO will be created before the log is validated. % :- pred create_post_wrapper_goal(stm_goal_vars::in, hlds_goal::in, mer_type::in, prog_var::in, prog_var::in, prog_var::in, bool::in, hlds_goal::out, stm_info::in, stm_new_pred_info::in, stm_new_pred_info::out) is det. create_post_wrapper_goal(AtomicGoalVars, AtomicGoal, ResultType, ResultVar, StmDI, StmUO, CopySTM, Goal, StmInfo, !NewPredInfo) :- StmModuleName = mercury_stm_builtin_module, ExceptionModuleName = mercury_exception_module, construct_output(AtomicGoalVars, ResultType, ResultVar, StmInfo, AssignResult, !NewPredInfo), create_aux_variable(stm_valid_result_type, yes("Stm_Expand_IsValid"), IsValidVar, !NewPredInfo), ValidTrueFunctor = stm_validres_valid_functor, ValidFalseFunctor = stm_validres_invalid_functor, RollbackCons = stm_rollback_exception_functor, % Creates the necessary predicate calls. create_aux_variable_assignment(RollbackCons, stm_rollback_exception_type, yes("Stm_Expand_Rollback"), ConstRollbackGoal, RollbackVar, !NewPredInfo), create_simple_call(StmModuleName, "stm_lock", pf_predicate, only_mode, detism_det, purity_impure, [], [], instmap_delta_bind_no_var, Goal_StmLock_Call, !NewPredInfo), create_simple_call(StmModuleName, "stm_unlock", pf_predicate, only_mode, detism_det, purity_impure, [], [], instmap_delta_bind_no_var, Goal_StmUnLock_Call, !NewPredInfo), create_simple_call(StmModuleName, "stm_validate", pf_predicate, only_mode, detism_det, purity_impure, [StmUO, IsValidVar], [], instmap_delta_from_assoc_list( [StmUO - ground(unique, none_or_default_func), IsValidVar - ground(shared, none_or_default_func)]), Goal_StmValidate_Call, !NewPredInfo), create_simple_call(StmModuleName, "stm_commit", pf_predicate, only_mode, detism_det, purity_impure, [StmUO], [], instmap_delta_from_assoc_list( [StmUO - ground(unique, none_or_default_func)]), Goal_StmCommit_Call, !NewPredInfo), make_type_info(stm_rollback_exception_type, TypeInfoVar, CreateTypeInfoGoals, !NewPredInfo), create_simple_call(ExceptionModuleName, "throw", pf_predicate, only_mode, detism_erroneous, purity_pure, [TypeInfoVar, RollbackVar], [], instmap_delta_bind_vars([TypeInfoVar, RollbackVar]), Goal_ExceptionThrow_Call, !NewPredInfo), % Creates the branch on the validation result of the log. create_plain_conj([Goal_StmCommit_Call, Goal_StmUnLock_Call], Goal_ValidBranch), create_plain_conj([Goal_StmUnLock_Call, ConstRollbackGoal] ++ CreateTypeInfoGoals ++ [Goal_ExceptionThrow_Call], Goal_InvalidBranch), create_switch_disjunction(IsValidVar, [case(ValidTrueFunctor, [], Goal_ValidBranch), case(ValidFalseFunctor, [], Goal_InvalidBranch)], detism_det, purity_impure, DisjGoal, !NewPredInfo), % Creates the main validation and commission goal. PostAtomicTopLevelList = [Goal_StmLock_Call, Goal_StmValidate_Call, DisjGoal], create_plain_conj(PostAtomicTopLevelList, PostAtomicGoal0), create_promise_purity_scope(PostAtomicGoal0, purity_pure, PostAtomicGoal), % Creates the unification between StmUO and StmDI is needed. ( CopySTM = yes, create_var_unify(StmUO, StmDI, uo_mode - di_mode, CopySTMAssign, !NewPredInfo), TopLevelGoalList0 = [AtomicGoal] ++ AssignResult ++ [CopySTMAssign, PostAtomicGoal] ; CopySTM = no, TopLevelGoalList0 = [AtomicGoal] ++ AssignResult ++ [PostAtomicGoal] ), flatten_conj(TopLevelGoalList0, TopLevelGoalList), create_plain_conj(TopLevelGoalList, Goal). % Creates a simpler wrapper predicate for or_else branches. % :- pred create_simple_wrapper_pred(stm_goal_vars::in, mer_type::in, prog_var::in, hlds_goal::in, pred_proc_id::out, hlds_goal::out, stm_info::in, stm_info::out) is det. create_simple_wrapper_pred(AtomicGoalVars, ResultType, ResultVar0, AtomicGoal, PredProcId, CallGoal, !StmInfo) :- create_simple_wrapper_pred_2(AtomicGoalVars, ResultType, ResultVar0, AtomicGoal, PredProcId, _, CallGoal, !StmInfo). :- pred create_simple_wrapper_pred_2(stm_goal_vars::in, mer_type::in, prog_var::in, hlds_goal::in, pred_proc_id::out, stm_new_pred_info::out, hlds_goal::out, stm_info::in, stm_info::out) is det. create_simple_wrapper_pred_2(AtomicGoalVars, ResultType, ResultVar0, !.AtomicGoal, PredProcId, !:NewPredInfo, CallGoal, !StmInfo) :- InnerDI = AtomicGoalVars ^ vars_innerDI, InnerUO0 = AtomicGoalVars ^ vars_innerUO, get_input_output_varlist(AtomicGoalVars, InputVars, _), get_input_output_types(AtomicGoalVars, !.StmInfo, InputTypes, _), get_input_output_modes(AtomicGoalVars, InputModes, _), create_cloned_pred(InputVars ++ [ResultVar0, InnerDI, InnerUO0], InputTypes ++ [ResultType, stm_state_type, stm_state_type], InputModes ++ [out_mode, di_mode, uo_mode], "simple_wrapper", !.AtomicGoal, no, !:NewPredInfo, CallGoal, !StmInfo), rename_var_in_wrapper_pred("stm_ResultVar", ResultVar0, ResultType, ResultVar, !NewPredInfo, !AtomicGoal), move_variables_to_new_pred(!AtomicGoal, AtomicGoalVars, InnerDI, InnerUO0, !NewPredInfo, !StmInfo), % Handles the case when the Inner di and Inner uo variables are the same. % Explicitly creates a unification to keep these variables different % (because of the uniqueness requirements of a number of calls added to % the end of the original goal) ( if InnerUO0 = InnerDI then CopyStm = yes, create_aux_variable(stm_state_type, yes("NewUO"), InnerUO, !NewPredInfo) else CopyStm = no, InnerUO = InnerUO0 ), create_simple_post_wrapper_goal(AtomicGoalVars, !.AtomicGoal, ResultType, ResultVar, InnerDI, InnerUO, CopyStm, WrapperGoal, !.StmInfo, !NewPredInfo), set_head_vars(InputVars ++ [ResultVar, InnerDI, InnerUO], !NewPredInfo), new_pred_set_goal(WrapperGoal, !NewPredInfo), run_quantification_over_pred(!NewPredInfo), get_pred_proc_id(!.NewPredInfo, PredProcId), commit_new_pred(!.NewPredInfo, !StmInfo). % To Remove eventually :- pred create_probe_call(string::in, prog_var::in, hlds_goals::out, stm_new_pred_info::in, stm_new_pred_info::out) is det. create_probe_call(_Name, _Var, Goals, !NewPredInfo) :- Goals = []. % Creates the goals for validating and committing (or raising a rollback % exception) a transaction log. These goals appear after the original goal. % If the value of CopySTM is "yes", a goal unifying the variable in StmDI % and the variable in StmUO will be created before the log is validated. % :- pred create_simple_post_wrapper_goal(stm_goal_vars::in, hlds_goal::in, mer_type::in, prog_var::in, prog_var::in, prog_var::in, bool::in, hlds_goal::out, stm_info::in, stm_new_pred_info::in, stm_new_pred_info::out) is det. create_simple_post_wrapper_goal(AtomicGoalVars, AtomicGoal, ResultType, ResultVar, StmDI, StmUO, CopySTM, Goal, StmInfo, !NewPredInfo) :- construct_output(AtomicGoalVars, ResultType, ResultVar, StmInfo, AssignResult, !NewPredInfo), create_probe_call("start_of_wrapper", StmDI, Call1, !NewPredInfo), create_probe_call("start_of_wrapper", StmUO, Call2, !NewPredInfo), % Creates the unification between StmUO and StmDI is needed. ( CopySTM = yes, create_var_unify(StmUO, StmDI, uo_mode - di_mode, CopySTMAssign, !NewPredInfo), TopLevelGoalList0 = Call1 ++ [CopySTMAssign, AtomicGoal] ++ Call2 ++ AssignResult ; CopySTM = no, TopLevelGoalList0 = Call1 ++ [AtomicGoal] ++ Call2 ++ AssignResult ), flatten_conj(TopLevelGoalList0, TopLevelGoalList), create_plain_conj(TopLevelGoalList, Goal). %-----------------------------------------------------------------------------% % % Predicates used in the creation of "or_else" goals. % % or_else(<>, <>, <>, <>) is det. % :- pred create_or_else_pred(stm_goal_vars::in, list(stm_goal_vars)::in, list(pred_proc_id)::in, prog_var::in, prog_var::in, hlds_goal::out, stm_info::in, stm_info::out) is det. create_or_else_pred(AtomicGoalVars, BranchGoalVars, Closures, StmDI, StmUO, CallGoal, !StmInfo) :- get_input_output_varlist(AtomicGoalVars, InputVars, OutputVars), get_input_output_types(AtomicGoalVars, !.StmInfo, InputTypes, OutputTypes), get_input_output_modes(AtomicGoalVars, InputModes, OutputModes), % MaybeDetism = yes(detism_cc_multi), MaybeDetism = no, make_return_type(OutputTypes, ReturnType), create_cloned_pred(InputVars ++ OutputVars ++ [StmDI, StmUO], InputTypes ++ OutputTypes ++ [stm_state_type, stm_state_type], InputModes ++ OutputModes ++ [di_mode, uo_mode], "or_else", true_goal, MaybeDetism, NewPredInfo0, CallGoal, !StmInfo), create_aux_variable(stm_state_type, yes("STMDI"), NewStmDI, NewPredInfo0, NewPredInfo1), create_aux_variable(stm_state_type, yes("STMUO"), NewStmUO, NewPredInfo1, NewPredInfo2), set_head_vars(InputVars ++ OutputVars ++ [NewStmDI, NewStmUO], NewPredInfo2, NewPredInfo3), create_or_else_pred_2(BranchGoalVars, Closures, NewStmDI, NewStmUO, ReturnType, !.StmInfo, NewPredInfo3, NewPredInfo), commit_new_pred(NewPredInfo, !StmInfo). :- pred create_or_else_pred_2(list(stm_goal_vars)::in, list(pred_proc_id)::in, prog_var::in, prog_var::in, mer_type::in, stm_info::in, stm_new_pred_info::in, stm_new_pred_info::out) is det. create_or_else_pred_2(AtomicGoalVars, Closures, StmDI, StmUO, ReturnType, StmInfo, !NewPredInfo) :- list.length(Closures, ClosureCount), create_or_else_inner_stm_vars(ClosureCount, InnerSTMVars, !NewPredInfo), make_type_info(ReturnType, ReturnRttiVar, CreateRetTypeInfo, !NewPredInfo), make_type_info(stm_rollback_exception_type, ExceptRttiVar, CreateExceptTypeInfo, !NewPredInfo), create_or_else_end_branch(InnerSTMVars, StmDI, StmUO, ExceptRttiVar, EndBranchGoal, !NewPredInfo), create_or_else_branches(AtomicGoalVars, ReturnType, StmDI, StmUO, InnerSTMVars, ReturnRttiVar, ExceptRttiVar, Closures, EndBranchGoal, MainGoal0, StmInfo, !NewPredInfo), TopLevelGoalList0 = CreateRetTypeInfo ++ CreateExceptTypeInfo ++ [MainGoal0], flatten_conj(TopLevelGoalList0, TopLevelGoalList), create_plain_conj(TopLevelGoalList, MainGoal1), create_promise_purity_scope(MainGoal1, purity_pure, MainGoal), new_pred_set_goal(MainGoal, !NewPredInfo), run_quantification_over_pred(!NewPredInfo). :- pred create_or_else_branches(list(stm_goal_vars)::in, mer_type::in, prog_var::in, prog_var::in, list(prog_var)::in, prog_var::in, prog_var::in, list(pred_proc_id)::in, hlds_goal::in, hlds_goal::out, stm_info::in, stm_new_pred_info::in, stm_new_pred_info::out) is det. create_or_else_branches(AtomicGoalVars, ReturnType, OuterStmDIVar, OuterStmUOVar, InnerSTMVars, RttiVar, RollbackExceptionRttiVar, WrapperIDs, EndBranch, Goal, StmInfo, !NewPredInfo) :- ( if InnerSTMVars = [], WrapperIDs = [], AtomicGoalVars = [] then Goal = EndBranch else if AtomicGoalVars = [AGV | AGVs], InnerSTMVars = [InnerVar | InnerSTMVars0], WrapperIDs = [WrapID | WrapperIDs0] then create_or_else_branches(AGVs, ReturnType, OuterStmDIVar, OuterStmUOVar, InnerSTMVars0, RttiVar, RollbackExceptionRttiVar, WrapperIDs0, EndBranch, Goal0, StmInfo, !NewPredInfo), create_or_else_branch(AGV, ReturnType, OuterStmDIVar, OuterStmUOVar, InnerVar, RttiVar, RollbackExceptionRttiVar, WrapID, Goal0, Goal, StmInfo, !NewPredInfo) else unexpected($module, $pred, "mismatched lists") ). :- pred create_or_else_inner_stm_vars(int::in, list(prog_var)::out, stm_new_pred_info::in, stm_new_pred_info::out) is det. create_or_else_inner_stm_vars(Count, Vars, !NewPredInfo) :- ( if Count = 0 then Vars = [] else if Count > 0 then create_aux_variable(stm_state_type, yes("InnSTM"), Var, !NewPredInfo), Count1 = Count - 1, create_or_else_inner_stm_vars(Count1, Vars0, !NewPredInfo), Vars = [Var | Vars0] else unexpected($module, $pred, "negative count") ). % Creates an or_else branch. % % impure stm_create_nested_log(OuterSTM0, InnerSTM0), % unsafe_try_stm(TransA, ResultA, InnerSTM0, InnerSTM), % ( % ResultA = succeeded(Result), % impure stm_merge_nested_logs(InnerSTM, OuterSTM0, OuterSTM) % ; % ResultA = exception(Excp) % ( if Excp = univ(rollback_retry) then % << nested or_else branch >> % else % impure stm_discard_transaction_log(InnerSTM), % rethrow(Result) % ) % ) % :- pred map2_in_foldl( pred(K, L, N, A, A)::in(pred(in, in, out, in, out) is det), list(K)::in, list(L)::in, list(N)::out, A::in, A::out) is det. map2_in_foldl(Pred, Src1, Src2, Dest, !Accum) :- ( if Src1 = [], Src2 = [] then Dest = [] else if Src1 = [S | Ss], Src2 = [T | Ts] then Pred(S, T, R, !Accum), map2_in_foldl(Pred, Ss, Ts, Rs, !Accum), Dest = [R | Rs] else unexpected($module, $pred, "source list lengths mismatch") ). :- pred map3_in_foldl( pred(K, L, M, N, A, A)::in(pred(in, in, in, out, in, out) is det), list(K)::in, list(L)::in, list(M)::in, list(N)::out, A::in, A::out) is det. map3_in_foldl(Pred, Src1, Src2, Src3, Dest, !Accum) :- ( if Src1 = [], Src2 = [], Src3 = [] then Dest = [] else if Src1 = [S | Ss], Src2 = [T | Ts], Src3 = [U | Us] then Pred(S, T, U, R, !Accum), map3_in_foldl(Pred, Ss, Ts, Us, Rs, !Accum), Dest = [R | Rs] else unexpected($module, $pred, "source list lengths mismatch") ). :- pred create_or_else_end_branch(list(prog_var)::in, prog_var::in, prog_var::in, prog_var::in, hlds_goal::out, stm_new_pred_info::in, stm_new_pred_info::out) is det. create_or_else_end_branch(StmVars, OuterSTMDI, OuterSTMUO, ExceptionRttiVar, Goal, !NewPredInfo) :- MakeIntermediateStmVars = ( pred(_::in, Var::out, NPI0::in, NPI::out) is det:- create_aux_variable(stm_state_type, yes("InterSTM"), Var, NPI0, NPI) ), % We don't actually need the list as it is simply used as a counter. StmVarsMinusHead = list.det_tail(StmVars), list.map_foldl(MakeIntermediateStmVars, StmVarsMinusHead, IntermediateStmVars, !NewPredInfo), MergeStmVarsIn = [OuterSTMDI | IntermediateStmVars], MergeStmVarsOut = IntermediateStmVars ++ [OuterSTMUO], MakeMergeGoals = (pred(StmVar::in, ThreadSTMDI::in, ThreadSTMUO::in, ThisGoal::out, NPI0::in, NPI::out) is det :- create_simple_call(mercury_stm_builtin_module, "stm_merge_nested_logs", pf_predicate, only_mode, detism_det, purity_impure, [StmVar, ThreadSTMDI, ThreadSTMUO], [], instmap_delta_from_assoc_list( [StmVar - ground(unique, none_or_default_func), ThreadSTMDI - free, ThreadSTMUO - ground(unique, none_or_default_func)]), ThisGoal, NPI0, NPI) ), map3_in_foldl(MakeMergeGoals, StmVars, MergeStmVarsIn, MergeStmVarsOut, MergeGoals, !NewPredInfo), create_simple_call(mercury_stm_builtin_module, "stm_unlock", pf_predicate, only_mode, detism_det, purity_impure, [], [], instmap_delta_bind_no_var, UnlockCall, !NewPredInfo), create_aux_variable_assignment(stm_rollback_retry_functor, stm_rollback_exception_type, yes("RetryCons"), AssignRetryCons, RetryConsVar, !NewPredInfo), create_simple_call(mercury_exception_module, "throw", pf_predicate, only_mode, detism_erroneous, purity_pure, [ExceptionRttiVar, RetryConsVar], [], instmap_delta_bind_vars([ExceptionRttiVar, RetryConsVar]), RetryCall, !NewPredInfo), % XXX STM % create_simple_call(mercury_stm_builtin_module, "retry", % pf_predicate, only_mode, % detism_det, purity_pure, [OuterSTMUO], [], % instmap_delta_bind_var(OuterSTMUO), RetryCall, !NewPredInfo), create_plain_conj(MergeGoals ++ [UnlockCall, AssignRetryCons, RetryCall], ValidGoal), % Failure break create_aux_variable_assignment(stm_rollback_exception_functor, stm_rollback_exception_type, yes("RollbackCons"), AssignRollbackCons, RollbackConsVar, !NewPredInfo), create_simple_call(mercury_exception_module, "throw", pf_predicate, only_mode, detism_erroneous, purity_pure, [ExceptionRttiVar, RollbackConsVar], [], instmap_delta_bind_vars([ExceptionRttiVar, RollbackConsVar]), ThrowCall, !NewPredInfo), create_plain_conj([UnlockCall, AssignRollbackCons, ThrowCall], InvalidGoal), template_lock_and_validate_many(StmVars, no, ValidGoal, InvalidGoal, Goals, !NewPredInfo), create_plain_conj(Goals, Goal). % Variables are: % % StmGoalVars % ReturnType -- Return type of the or_else pred % ReturnValue -- Return variable of the or_else pred (not decompressed) % OuterStmDIVar -- Outer STM DI Variable (in pred head) % OuterStmUOVar -- Outer STM UO Variable (in pred head) % RttiVar -- Variable holding type_info for ReturnType % RollbackExceptionRttiVar -- Variable holding type_info for % "stm_builtin.rollback_exception_type" % WrapperID -- The predicate ID of the call to try % RetryBranch -- The goal to execute when a retry is called % InnerSTMVar -- The DI variable of the retry branch. It must be created % outside this predicate as it needs to be known to the validate & merge % branch. % :- pred create_or_else_branch(stm_goal_vars::in, mer_type::in, prog_var::in, prog_var::in, prog_var::in, prog_var::in, prog_var::in, pred_proc_id::in, hlds_goal::in, hlds_goal::out, stm_info::in, stm_new_pred_info::in, stm_new_pred_info::out) is det. create_or_else_branch(AtomicGoalVars, ReturnType, OuterStmDIVar, OuterStmUOVar, InnerSTMVar, RttiVar, RollbackExceptionRttiVar, WrapperID, RetryBranch, Goal, StmInfo, !NewPredInfo) :- get_input_output_varlist(AtomicGoalVars, InputVars, _), get_input_output_types(AtomicGoalVars, StmInfo, InputTypes, _), get_input_output_modes(AtomicGoalVars, InputModes, _), create_aux_variable(stm_state_type, yes("InnerSTM0"), InnerSTM0Var, !NewPredInfo), create_aux_variable(exception_result_type(ReturnType), yes("ExcptRes"), ReturnExceptVar, !NewPredInfo), create_closure(WrapperID, InputVars, InputTypes ++ [ReturnType, stm_state_type, stm_state_type], InputModes ++ [out_mode, di_mode, uo_mode], AtomicClosureVar, ClosureAssign, !NewPredInfo), create_simple_call(mercury_stm_builtin_module, "stm_create_nested_transaction_log", pf_predicate, only_mode, detism_det, purity_impure, [OuterStmDIVar, InnerSTM0Var], [], instmap_delta_from_assoc_list( [OuterStmDIVar - ground(unique, none_or_default_func), InnerSTM0Var - free]), CreateNestedLogCall, !NewPredInfo), create_simple_call(mercury_exception_module, "unsafe_try_stm", pf_predicate, mode_no(0), detism_cc_multi, purity_pure, [RttiVar, AtomicClosureVar, ReturnExceptVar, InnerSTM0Var, InnerSTMVar], [], instmap_delta_from_assoc_list([ RttiVar - ground(shared, none_or_default_func), AtomicClosureVar - ground(shared, none_or_default_func), ReturnExceptVar - free, InnerSTM0Var - ground(unique, none_or_default_func), InnerSTMVar - free]), TryStmCall, !NewPredInfo), % Successfull execution, deconstruct and return deconstruct_output(AtomicGoalVars, ReturnType, ReturnExceptVar, DeconstructGoal, StmInfo, !NewPredInfo), create_simple_call(mercury_stm_builtin_module, "stm_merge_nested_logs", pf_predicate, only_mode, detism_det, purity_impure, [InnerSTMVar, OuterStmDIVar, OuterStmUOVar], [], instmap_delta_from_assoc_list( [InnerSTMVar - ground(unique, none_or_default_func), OuterStmDIVar - ground(unique, none_or_default_func), OuterStmUOVar - free]), MergeNestedLogsCall, !NewPredInfo), create_plain_conj([DeconstructGoal, MergeNestedLogsCall], SuccessBranch), % General exception: discard and throw upwards create_simple_call(mercury_stm_builtin_module, "stm_discard_transaction_log", pf_predicate, only_mode, detism_det, purity_impure, [InnerSTMVar], [], instmap_delta_from_assoc_list( [InnerSTMVar - ground(unique, none_or_default_func)]), DiscardCall, !NewPredInfo), create_simple_call(mercury_exception_module, "rethrow", pf_predicate, only_mode, detism_erroneous, purity_pure, [RttiVar, ReturnExceptVar], [], instmap_delta_bind_vars([RttiVar, ReturnExceptVar]), RethrowCall, !NewPredInfo), % Code to extract the exception result. create_aux_variable(univ_type, yes("ExceptUnivVar"), ExceptUnivVar, !NewPredInfo), deconstruct_functor(ReturnExceptVar, exception_exception_functor, [ExceptUnivVar], DeconstructException), create_plain_conj([DiscardCall, RethrowCall], NotRetryBranch), % Code to generate top level goals template_if_exceptres_is_cons(RollbackExceptionRttiVar, ExceptUnivVar, stm_rollback_retry_functor, RetryBranch, NotRetryBranch, IfRetryGoal, !NewPredInfo), create_plain_conj([DeconstructException, IfRetryGoal], ExceptionBranch), create_switch_disjunction(ReturnExceptVar, [case(exception_exception_functor, [], ExceptionBranch), case(exception_succeeded_functor, [], SuccessBranch)], detism_det, purity_impure, DisjGoal, !NewPredInfo), create_plain_conj([CreateNestedLogCall, ClosureAssign, TryStmCall, DisjGoal], Goal). %-----------------------------------------------------------------------------% % % Utility predicates used in the creation of the rollback predicate and the % wrapper predicate. % % Returns the type of the value that is to be returned by the wrapper % predicate given the types of the output variables. % :- pred make_return_type(list(mer_type)::in, mer_type::out) is det. make_return_type(Types, ReturnType) :- ( Types = [], ReturnType = stm_dummy_output_type ; Types = [ReturnType] ; Types = [_, _ | _], ReturnType = tuple_type(Types, kind_star) ). % Creates the goals necessary for extracting the output variables from % the return value of the wrapper. % :- pred deconstruct_output(stm_goal_vars::in, mer_type::in, prog_var::in, hlds_goal::out, stm_info::in, stm_new_pred_info::in, stm_new_pred_info::out) is det. deconstruct_output(AtomicGoalVars, ReturnType, ReturnExceptVar, Goal, StmInfo, !NewPredInfo) :- get_input_output_varlist(AtomicGoalVars, _, OutputVars), get_input_output_types(AtomicGoalVars, StmInfo, _, OutputTypes), ( OutputTypes = [], % Extract the return type but do nothing with it. For reasons that % I do not know, this is the bare minimum that is required without % causing an exception in a later stage. create_aux_variable(ReturnType, yes("BoringResult"), SuccessResultVar, !NewPredInfo), deconstruct_functor(ReturnExceptVar, exception_succeeded_functor, [SuccessResultVar], Goal) ; OutputTypes = [_], % Wrapper returns a single value -- Simply get the value from the % exception result and return. OutVar = list.det_head(OutputVars), deconstruct_functor(ReturnExceptVar, exception_succeeded_functor, [OutVar], Goal) ; OutputTypes = [_, _ | _], % Wrapper returns a tuple. Get the tuple result and return it. make_type_info(ReturnType, _, MakeType, !NewPredInfo), create_aux_variable(ReturnType, yes("SuccessResult"), SuccessResultVar, !NewPredInfo), deconstruct_functor(ReturnExceptVar, exception_succeeded_functor, [SuccessResultVar], DeconstructGoal), deconstruct_tuple(SuccessResultVar, OutputVars, UnifyOutputGoal), create_plain_conj([DeconstructGoal, UnifyOutputGoal | MakeType], Goal) ). % Creates the goals necessary for constructing the output variables % in the wrapper predicate. It is necessary to compress all the output % values into a single variable to be passed along with the exception % result. % :- pred construct_output(stm_goal_vars::in, mer_type::in, prog_var::in, stm_info::in, hlds_goals::out, stm_new_pred_info::in, stm_new_pred_info::out) is det. construct_output(AtomicGoalVars, ResultType, ResultVar, StmInfo, Goals, !NewPredInfo) :- get_input_output_varlist(AtomicGoalVars, _, OutputVars), get_input_output_types(AtomicGoalVars, StmInfo, _, OutputTypes), ( OutputTypes = [], % Since a value must be returned, simply return a value which will be % discarded. create_const_assign(ResultVar, stm_dummy_output_functor, Goal), Goals = [Goal] ; OutputTypes = [_], % Wrapper returns a single value -- Simply get the value from the % exception result and return. OutVar = list.det_head(OutputVars), create_var_unify(ResultVar, OutVar, out_mode - in_mode, Goal, !NewPredInfo), Goals = [Goal] ; OutputTypes = [_, _ | _], % Wrapper returns a tuple. Creates a tuple from the output values. make_type_info(ResultType, _, MakeType, !NewPredInfo), construct_tuple(ResultVar, OutputVars, Goal), Goals = [Goal | MakeType] ). % Renames the value of a variable in a predicate. % :- pred rename_var_in_wrapper_pred(string::in, prog_var::in, mer_type::in, prog_var::out, stm_new_pred_info::in, stm_new_pred_info::out, hlds_goal::in, hlds_goal::out) is det. rename_var_in_wrapper_pred(Name, ResultVar0, ResultType, ResultVar, !NewPredInfo, !Goal) :- NewProcInfo0 = !.NewPredInfo ^ new_pred_proc_info, proc_info_get_varset(NewProcInfo0, NewPredVarSet0), proc_info_get_vartypes(NewProcInfo0, NewPredVarTypes0), proc_info_get_headvars(NewProcInfo0, NewHeadVars0), varset.delete_var(ResultVar0, NewPredVarSet0, NewPredVarSet1), delete_var_type(ResultVar0, NewPredVarTypes0, NewPredVarTypes1), varset.new_named_var(Name, ResultVar, NewPredVarSet1, NewPredVarSet), add_var_type(ResultVar, ResultType, NewPredVarTypes1, NewPredVarTypes), VarMapping = map.singleton(ResultVar0, ResultVar), MapLambda = ((pred(X::in, Y::out) is det) :- ( if X = ResultVar0 then Y = ResultVar else Y = X ) ), list.map(MapLambda, NewHeadVars0, NewHeadVars), rename_some_vars_in_goal(VarMapping, !Goal), proc_info_set_varset(NewPredVarSet, NewProcInfo0, NewProcInfo1), proc_info_set_vartypes(NewPredVarTypes, NewProcInfo1, NewProcInfo2), proc_info_set_headvars(NewHeadVars, NewProcInfo2, NewProcInfo), !NewPredInfo ^ new_pred_proc_info := NewProcInfo. %-----------------------------------------------------------------------------% % % Predicates to assist in the creation of hlds_goals. To simplify the creation % of goals in a predicate, many of these functions thread the type % "stm_new_pred_info" which contains, amonst other things, the predicate info, % procedure info and module info of the newly created predicate. % % Many of the created goals create default instmap_deltas and non-local % variable sets. This is because it is assumed that quantification and % recalculation of the instmap_deltas will be done over the newly created % predicate (the call to "run_quantification_over_pred" will do this). % % Creates an auxiliary variable with a specific type % :- pred create_aux_variable_stm(mer_type::in, maybe(string)::in, prog_var::out, stm_info::in, stm_info::out) is det. create_aux_variable_stm(Type, MaybeName0, Var, !StmInfo) :- ProcInfo0 = !.StmInfo ^ stm_info_proc_info, ( MaybeName0 = no, MaybeName0 = MaybeName ; MaybeName0 = yes(Name), MaybeName = yes(Name ++ "_Aux_STM") ), proc_info_create_var_from_type(Type, MaybeName, Var, ProcInfo0, ProcInfo), !StmInfo ^ stm_info_proc_info := ProcInfo. % Creates an auxiliary variable with a specific type % :- pred create_aux_variable(mer_type::in, maybe(string)::in, prog_var::out, stm_new_pred_info::in, stm_new_pred_info::out) is det. create_aux_variable(Type, MaybeName0, Var, !NewPredInfo) :- ProcInfo0 = !.NewPredInfo ^ new_pred_proc_info, Cnt0 = !.NewPredInfo ^ new_pred_var_cnt, ( MaybeName0 = no, MaybeName0 = MaybeName ; MaybeName0 = yes(Name), MaybeName = yes(Name ++ "_Aux_" ++ string(Cnt0)) ), proc_info_create_var_from_type(Type, MaybeName, Var, ProcInfo0, ProcInfo), Cnt = Cnt0 + 1, !NewPredInfo ^ new_pred_proc_info := ProcInfo, !NewPredInfo ^ new_pred_var_cnt := Cnt. % Creates a goal which assigns a variable to a cons_id. % :- pred create_const_assign(prog_var::in, cons_id::in, hlds_goal::out) is det. create_const_assign(Var, Const, AssignmentGoal) :- make_const_construction(Var, Const, AssignmentGoal). % Creates a new auxiliary variable and a goal which assigns it to a % cons_id. % :- pred create_aux_variable_assignment(cons_id::in, mer_type::in, maybe(string)::in, hlds_goal::out, prog_var::out, stm_new_pred_info::in, stm_new_pred_info::out) is det. create_aux_variable_assignment(Cons, Type, MaybeName, Goal, Var, !NewPredInfo) :- create_aux_variable(Type, MaybeName, Var, !NewPredInfo), create_const_assign(Var, Cons, Goal). % Creates a simple test between two variables (using the unify goal). % :- pred create_var_test(prog_var::in, prog_var::in, unify_mode::in, hlds_goal::out, stm_new_pred_info::in, stm_new_pred_info::out) is det. create_var_test(VarLHS, VarRHS, UnifyMode, Goal, !NewPredInfo) :- Context = !.NewPredInfo ^ new_pred_context, ModuleInfo = !.NewPredInfo ^ new_pred_module_info, UnifyType = simple_test(VarLHS, VarRHS), UnifyRHS = rhs_var(VarRHS), UnifyContext = unify_context(umc_explicit, []), UnifyMode = ModeLHS - ModeRHS, instmap_delta_from_mode_list([VarLHS, VarRHS], [ModeLHS, ModeRHS], ModuleInfo, InstmapDelta), GoalExpr = unify(VarLHS, UnifyRHS, UnifyMode, UnifyType, UnifyContext), set_of_var.list_to_set([VarLHS, VarRHS], NonLocals), Determism = detism_semi, Purity = purity_pure, goal_info_init(NonLocals, InstmapDelta, Determism, Purity, Context, GoalInfo), Goal = hlds_goal(GoalExpr, GoalInfo). % Creates a unification between two variables (using the unify goal) % Takes the "stm_info" state % :- pred create_var_unify_stm(prog_var::in, prog_var::in, unify_mode::in, hlds_goal::out, stm_info::in, stm_info::out) is det. create_var_unify_stm(VarLHS, VarRHS, UnifyMode, Goal, !StmInfo) :- Context = term.context("--temp-context--", 999), ModuleInfo = !.StmInfo ^ stm_info_module_info, UnifyType = assign(VarLHS, VarRHS), UnifyRHS = rhs_var(VarRHS), UnifyContext = unify_context(umc_explicit, []), UnifyMode = ModeLHS - ModeRHS, instmap_delta_from_mode_list([VarLHS, VarRHS], [ModeLHS, ModeRHS], ModuleInfo, InstmapDelta), GoalExpr = unify(VarLHS, UnifyRHS, UnifyMode, UnifyType, UnifyContext), set_of_var.list_to_set([VarLHS, VarRHS], NonLocals), Determism = detism_det, Purity = purity_pure, goal_info_init(NonLocals, InstmapDelta, Determism, Purity, Context, GoalInfo), Goal = hlds_goal(GoalExpr, GoalInfo). % Creates a unification between two variables (using the unify goal) % :- pred create_var_unify(prog_var::in, prog_var::in, unify_mode::in, hlds_goal::out, stm_new_pred_info::in, stm_new_pred_info::out) is det. create_var_unify(VarLHS, VarRHS, UnifyMode, Goal, !NewPredInfo) :- Context = !.NewPredInfo ^ new_pred_context, ModuleInfo = !.NewPredInfo ^ new_pred_module_info, UnifyType = assign(VarLHS, VarRHS), UnifyRHS = rhs_var(VarRHS), UnifyContext = unify_context(umc_explicit, []), UnifyMode = ModeLHS - ModeRHS, instmap_delta_from_mode_list([VarLHS, VarRHS], [ModeLHS, ModeRHS], ModuleInfo, InstmapDelta), GoalExpr = unify(VarLHS, UnifyRHS, UnifyMode, UnifyType, UnifyContext), set_of_var.list_to_set([VarLHS, VarRHS], NonLocals), Determism = detism_det, Purity = purity_pure, goal_info_init(NonLocals, InstmapDelta, Determism, Purity, Context, GoalInfo), Goal = hlds_goal(GoalExpr, GoalInfo). % Creates a simple call. If the call is polymorphic, remember to add % the runtime type information as well ("type_info" variable). % :- pred create_simple_call(module_name::in, string::in, pred_or_func::in, mode_no::in, determinism::in, purity::in, prog_vars::in, list(goal_feature)::in, instmap_delta::in, hlds_goal::out, stm_new_pred_info::in, stm_new_pred_info::out) is det. create_simple_call(ModuleName, ProcName, PredOrFunc, Mode, Detism, Purity, ProgVars, GoalFeatures, InstmapDelta, Goal, !NewPredInfo) :- Context = !.NewPredInfo ^ new_pred_context, ModuleInfo = !.NewPredInfo ^ new_pred_module_info, generate_simple_call(ModuleName, ProcName, PredOrFunc, Mode, Detism, Purity, ProgVars, GoalFeatures, InstmapDelta, ModuleInfo, Context, Goal). % Creates a closure for a predicate. % :- pred create_closure(pred_proc_id::in, list(prog_var)::in, list(mer_type)::in, list(mer_mode)::in, prog_var::out, hlds_goal::out, stm_new_pred_info::in, stm_new_pred_info::out) is det. create_closure(PredProcID, Args, ArgTypes, ArgModes, ClosureVar, ClosureAssignGoal, !NewPredInfo) :- ShroudPredProcID = shroud_pred_proc_id(PredProcID), construct_higher_order_pred_type(purity_pure, lambda_normal, ArgTypes, ClosureType), ClosureCons = closure_cons(ShroudPredProcID, lambda_normal), create_aux_variable(ClosureType, yes("Closure"), ClosureVar, !NewPredInfo), construct_functor(ClosureVar, ClosureCons, Args, ClosureAssignGoal0), ClosureAssignInstmapDeltaList = assoc_list.from_corresponding_lists( [ClosureVar], [ground(shared, higher_order(pred_inst_info( pf_predicate, ArgModes, arg_reg_types_unset, detism_det)))]), ClosureAssignInstmapDelta = instmap_delta_from_assoc_list(ClosureAssignInstmapDeltaList), ClosureAssignGoal0 = hlds_goal(ClosureAssignExpr, ClosureAssignInfo0), goal_info_set_instmap_delta(ClosureAssignInstmapDelta, ClosureAssignInfo0, ClosureAssignInfo), ClosureAssignGoal = hlds_goal(ClosureAssignExpr, ClosureAssignInfo). % Creates an if-then-else goal. % :- pred create_if_then_else(list(prog_var)::in, hlds_goal::in, hlds_goal::in, hlds_goal::in, determinism::in, purity::in, hlds_goal::out, stm_new_pred_info::in, stm_new_pred_info::out) is det. create_if_then_else(ExistVars, Cond, Then, Else, Detism, Purity, OutGoal, !NewPredInfo) :- Context = !.NewPredInfo ^ new_pred_context, OutGoalExpr = if_then_else(ExistVars, Cond, Then, Else), NonLocals = set_of_var.init, instmap_delta_init_reachable(InstMapDelta), goal_info_init(NonLocals, InstMapDelta, Detism, Purity, Context, GoalInfo), OutGoal = hlds_goal(OutGoalExpr, GoalInfo). % Creates a switch goal. % :- pred create_switch_disjunction(prog_var::in, list(case)::in, determinism::in, purity::in, hlds_goal::out, stm_new_pred_info::in, stm_new_pred_info::out) is det. create_switch_disjunction(ProgVar, Cases, Detism, Purity, OutGoal, !NewPredInfo) :- Context = !.NewPredInfo ^ new_pred_context, NonLocals = set_of_var.init, instmap_delta_init_reachable(InstMapDelta), OutGoalExpr = switch(ProgVar, cannot_fail, Cases), goal_info_init(NonLocals, InstMapDelta, Detism, Purity, Context, GoalInfo), OutGoal = hlds_goal(OutGoalExpr, GoalInfo). % Creates a promise_purity around a goal for a given purity. % :- pred create_promise_purity_scope(hlds_goal::in, purity::in, hlds_goal::out) is det. create_promise_purity_scope(GoalIn, ScopePurity, GoalOut) :- GoalIn = hlds_goal(_, GoalInInfo), NonLocals = goal_info_get_nonlocals(GoalInInfo), InstMapDelta = goal_info_get_instmap_delta(GoalInInfo), Detism = goal_info_get_determinism(GoalInInfo), GoalPurity = ScopePurity, Context = goal_info_get_context(GoalInInfo), goal_info_init(NonLocals, InstMapDelta, Detism, GoalPurity, Context, GoalInfo), Reason = promise_purity(ScopePurity), GoalOutExpr = scope(Reason, GoalIn), GoalOut = hlds_goal(GoalOutExpr, GoalInfo). % Creates a list of regular conjoined goals. % :- pred create_plain_conj(hlds_goals::in, hlds_goal::out) is det. create_plain_conj(GoalsInConj, ConjGoal) :- Type = plain_conj, ConjGoalExpr = conj(Type, GoalsInConj), goal_list_nonlocals(GoalsInConj, NonLocals), goal_list_instmap_delta(GoalsInConj, InstMapDelta), goal_list_determinism(GoalsInConj, Detism), goal_list_purity(GoalsInConj, Purity), GoalAInfo = list.det_head(GoalsInConj) ^ hlds_goal_info, Context = goal_info_get_context(GoalAInfo), goal_info_init(NonLocals, InstMapDelta, Detism, Purity, Context, ConjGoalInfo), ConjGoal = hlds_goal(ConjGoalExpr, ConjGoalInfo). % Create typeinfo for use in polymorphic predicates % :- pred make_type_info(mer_type::in, prog_var::out, hlds_goals::out, stm_new_pred_info::in, stm_new_pred_info::out) is det. make_type_info(Type, Var, Goals, NewPredInfo0, NewPredInfo) :- NewPredInfo0 = stm_new_pred_info(ModuleInfo0, PredId, ProcId, PredInfo0, ProcInfo0, Context, VarCnt), create_poly_info(ModuleInfo0, PredInfo0, ProcInfo0, PolyInfo0), polymorphism_make_type_info_var(Type, Context, Var, Goals, PolyInfo0, PolyInfo), poly_info_extract(PolyInfo, PolySpecs, PredInfo0, PredInfo, ProcInfo0, ProcInfo, ModuleInfo), expect(unify(PolySpecs, []), $module, $pred, "got errors while making type_info_var"), NewPredInfo = stm_new_pred_info(ModuleInfo, PredId, ProcId, PredInfo, ProcInfo, Context, VarCnt). % Returns the list of goals from a case % :- pred goals_from_case_list(list(case)::in, hlds_goals::out) is det. goals_from_case_list(CaseList, GoalList) :- StripCase = (pred(Case::in, Goal::out) is det :- Case = case(_, _, Goal)), list.map(StripCase, CaseList, GoalList). %-----------------------------------------------------------------------------% % % Predicates to assist in the creation of new predicates. % % Creates a new predicate. The head variables, head variable types, head % variable modes, name and goal of the new predicate are set from the % arguments. All other properties are copied from the predicate in which % the original atomic goal appears in. The predicate returns a % "stm_new_pred_info" value (so that the body of the predicate can be % built) as well as a call to the new predicate. % :- pred create_cloned_pred(list(prog_var)::in, list(mer_type)::in, list(mer_mode)::in, string::in, hlds_goal::in, maybe(determinism)::in, stm_new_pred_info::out, hlds_goal::out, stm_info::in, stm_info::out) is det. create_cloned_pred(ProcHeadVars, PredArgTypes, ProcHeadModes, Prefix, OrigGoal, MaybeDetism, NewStmPredInfo, CallGoal, !StmInfo) :- ModuleInfo0 = !.StmInfo ^ stm_info_module_info, PredInfo = !.StmInfo ^ stm_info_pred_info, ProcId = !.StmInfo ^ stm_info_proc_id, PredId = !.StmInfo ^ stm_info_pred_id, ExpansionCnt0 = !.StmInfo ^ stm_info_expand_id, list.length(ProcHeadVars, Arity), OrigGoal = hlds_goal(_, GoalInfo0), pred_info_proc_info(PredInfo, ProcId, ProcInfo), proc_info_get_context(ProcInfo, ProcContext), proc_info_get_varset(ProcInfo, ProcVarSet), proc_info_get_vartypes(ProcInfo, ProcVarTypes), proc_info_get_inst_varset(ProcInfo, ProcInstVarSet), ( MaybeDetism = yes(ProcDetism) ; MaybeDetism = no, proc_info_get_inferred_determinism(ProcInfo, ProcDetism) ), proc_info_get_goal(ProcInfo, ProcGoal), proc_info_get_rtti_varmaps(ProcInfo, ProcRttiVarMaps), proc_info_get_has_parallel_conj(ProcInfo, HasParallelConj), proc_info_get_var_name_remap(ProcInfo, VarNameRemap), proc_info_create(ProcContext, ProcVarSet, ProcVarTypes, ProcHeadVars, ProcInstVarSet, ProcHeadModes, detism_decl_none, ProcDetism, ProcGoal, ProcRttiVarMaps, address_is_not_taken, HasParallelConj, VarNameRemap, NewProcInfo), ModuleName = pred_info_module(PredInfo), OrigPredName = pred_info_name(PredInfo), PredOrFunc = pred_info_is_pred_or_func(PredInfo), pred_info_get_context(PredInfo, PredContext), NewPredName = qualified(ModuleName, "StmExpanded_" ++ Prefix ++ "_" ++ OrigPredName ++ "_" ++ string(Arity) ++ "_" ++ string(PredId) ++ "_" ++ string(ExpansionCnt0)), pred_info_get_origin(PredInfo, OrigPredOrigin), NewPredOrigin = origin_transformed(transform_stm_expansion, OrigPredOrigin, PredId), pred_info_get_typevarset(PredInfo, PredTypeVarSet), pred_info_get_exist_quant_tvars(PredInfo, PredExistQVars), pred_info_get_class_context(PredInfo, PredClassContext), pred_info_get_assertions(PredInfo, PredAssertions), pred_info_get_markers(PredInfo, Markers), pred_info_create(ModuleName, NewPredName, PredOrFunc, PredContext, NewPredOrigin, pred_status(status_local), Markers, PredArgTypes, PredTypeVarSet, PredExistQVars, PredClassContext, PredAssertions, VarNameRemap, NewProcInfo, NewProcId, NewPredInfo), module_info_get_predicate_table(ModuleInfo0, PredicateTable0), predicate_table_insert(NewPredInfo, NewPredId, PredicateTable0, PredicateTable), module_info_set_predicate_table(PredicateTable, ModuleInfo0, ModuleInfo), CallExpr = plain_call(NewPredId, NewProcId, ProcHeadVars, not_builtin, no, NewPredName), set_of_var.list_to_set(ProcHeadVars, CallNonLocals), instmap_delta_from_mode_list(ProcHeadVars, ProcHeadModes, ModuleInfo0, CallInstmapDelta), CallDeterminism = ProcDetism, CallPurity = goal_info_get_purity(GoalInfo0), CallContext = goal_info_get_context(GoalInfo0), goal_info_init(CallNonLocals, CallInstmapDelta, CallDeterminism, CallPurity, CallContext, GoalInfo), CallGoal = hlds_goal(CallExpr, GoalInfo), ExpansionCnt = ExpansionCnt0 + 1, !StmInfo ^ stm_info_expand_id := ExpansionCnt, !StmInfo ^ stm_info_module_info := ModuleInfo, NewStmPredInfo = stm_new_pred_info(ModuleInfo, NewPredId, NewProcId, NewPredInfo, NewProcInfo, CallContext, 0). % Sets the head variables of the new predicate. % :- pred set_head_vars(list(prog_var)::in, stm_new_pred_info::in, stm_new_pred_info::out) is det. set_head_vars(NewHeadVars, !NewPredInfo) :- ProcInfo0 = !.NewPredInfo ^ new_pred_proc_info, proc_info_set_headvars(NewHeadVars, ProcInfo0, ProcInfo), !NewPredInfo ^ new_pred_proc_info := ProcInfo. % Writes the changes made to the new predicate to the predicate table % and returns an updates the stm_info state. % :- pred commit_new_pred(stm_new_pred_info::in, stm_info::in, stm_info::out) is det. commit_new_pred(NewPred, StmInfo0, StmInfo) :- StmInfo0 = stm_info(_StmModuleInfo0, OrigPredId, OrigProcId, OrigProcInfo, OrigPredInfo, StmExpanded, ExpandNum), NewPred = stm_new_pred_info(PredModuleInfo0, NewPredId, NewProcId, NewPredInfo, NewProcInfo, _, _), module_info_set_pred_proc_info(NewPredId, NewProcId, NewPredInfo, NewProcInfo, PredModuleInfo0, PredModuleInfo), StmInfo = stm_info(PredModuleInfo, OrigPredId, OrigProcId, OrigProcInfo, OrigPredInfo, StmExpanded, ExpandNum). % If changes have been made to the stm_info type (specifically the % module_info), update these changes in stm_new_pred_info. % :- pred update_new_pred_info(stm_info::in, stm_new_pred_info::in, stm_new_pred_info::out) is det. update_new_pred_info(StmInfo, !NewPredInfo) :- ModuleInfo = StmInfo ^ stm_info_module_info, !NewPredInfo ^ new_pred_module_info := ModuleInfo. % Runs quantification and recalculates the instmap-delta over the % new predicate. % :- pred run_quantification_over_pred(stm_new_pred_info::in, stm_new_pred_info::out) is det. run_quantification_over_pred(!NewPredInfo) :- ProcInfo0 = !.NewPredInfo ^ new_pred_proc_info, ModuleInfo0 = !.NewPredInfo ^ new_pred_module_info, requantify_proc_general(ordinary_nonlocals_no_lambda, ProcInfo0, ProcInfo1), recompute_instmap_delta_proc(recompute_atomic_instmap_deltas, ProcInfo1, ProcInfo, ModuleInfo0, ModuleInfo), !NewPredInfo ^ new_pred_module_info := ModuleInfo, !NewPredInfo ^ new_pred_proc_info := ProcInfo. % Sets the goal of the new predicate. % :- pred new_pred_set_goal(hlds_goal::in, stm_new_pred_info::in, stm_new_pred_info::out) is det. new_pred_set_goal(Goal, !NewPredInfo) :- ProcInfo0 = !.NewPredInfo ^ new_pred_proc_info, goal_vars(Goal, GoalVars), GoalVarsSet = set_of_var.bitset_to_set(GoalVars), proc_info_get_varset(ProcInfo0, ProcVarSet0), proc_info_get_vartypes(ProcInfo0, ProcVarTypes0), varset.select(GoalVarsSet, ProcVarSet0, ProgVarSet), vartypes_select(GoalVarsSet, ProcVarTypes0, ProcVarTypes), proc_info_set_varset(ProgVarSet, ProcInfo0, ProcInfo1), proc_info_set_goal(Goal, ProcInfo1, ProcInfo2), proc_info_set_vartypes(ProcVarTypes, ProcInfo2, ProcInfo), !NewPredInfo ^ new_pred_proc_info := ProcInfo. % Returns the pred_proc_id of the new predicate. % :- pred get_pred_proc_id(stm_new_pred_info::in, pred_proc_id::out) is det. get_pred_proc_id(NewPredInfo0, PredProcId) :- PredId = NewPredInfo0 ^ new_pred_pred_id, ProcId = NewPredInfo0 ^ new_pred_proc_id, PredProcId = proc(PredId, ProcId). %-----------------------------------------------------------------------------% % % Predicates related to the goal variables. % % Get the list of input and output variables of the original atomic goal. % :- pred get_input_output_varlist(stm_goal_vars::in, list(prog_var)::out, list(prog_var)::out) is det. get_input_output_varlist(StmGoalVars, Input, Output) :- InputSet = StmGoalVars ^ vars_input, OutputSet = StmGoalVars ^ vars_output, Input = set_of_var.to_sorted_list(InputSet), Output = set_of_var.to_sorted_list(OutputSet). % Get the list of types corresponding to the input and output % variables of the original atomic goal. % :- pred get_input_output_types(stm_goal_vars::in, stm_info::in, list(mer_type)::out, list(mer_type)::out) is det. get_input_output_types(StmGoalVars, StmInfo, InputTypes, OutputTypes) :- ProcInfo0 = StmInfo ^ stm_info_proc_info, proc_info_get_vartypes(ProcInfo0, VarTypes), get_input_output_varlist(StmGoalVars, InputVars, OutputVars), lookup_var_types(VarTypes, InputVars, InputTypes), lookup_var_types(VarTypes, OutputVars, OutputTypes). % Used by "get_input_output_modes". % :- pred set_list_val(X::in, Y::in, X::out) is det. set_list_val(X, _, X). % Get the list of modes corresponding to the input and output % variables of the original atomic goal. Input variables will have % the mode "in" while output variables will have the mode "out". % :- pred get_input_output_modes(stm_goal_vars::in, list(mer_mode)::out, list(mer_mode)::out) is det. get_input_output_modes(StmGoalVars, InputModes, OutputModes) :- get_input_output_varlist(StmGoalVars, InputVars, OutputVars), list.map(set_list_val(in_mode), InputVars, InputModes), list.map(set_list_val(out_mode), OutputVars, OutputModes). %-----------------------------------------------------------------------------% % Special (dummy) predicate names % :- func stm_inner_outer = sym_name. :- func stm_outer_inner = sym_name. stm_inner_outer = qualified(mercury_stm_builtin_module, "stm_from_inner_to_outer"). stm_outer_inner = qualified(mercury_stm_builtin_module, "stm_from_outer_to_inner"). %-----------------------------------------------------------------------------% :- end_module transform_hlds.stm_expand. %-----------------------------------------------------------------------------%