mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-16 14:25:56 +00:00
d69ba1a1f0
Estimated hours taken: 32 Branches: main Include the type_ctor in cons_ids for user-defined types. The intention is two-fold: - It prepares for a future in which we allow more than one function symbol to with the same name to be defined in a module. - It makes the HLDS code more self-contained. In many places, processing construction and deconstruction unifications required knowing which type the cons_id belongs to, but until now, code couldn't know that unless it kept track of the type of the variable unified with the cons_id. With this diff, user-defined cons_ids are represented as cons(SymName, Arity, TypeCtor) The last field is filled in during post-typecheck. After that time, any module qualification in the SymName (which may initially be partial) is redundant, since it is also available in the TypeCtor. In the future, we could make all those SymNames be just unqualified(_) at that time. We could also replace the current maps in HLDS type definitions with full cons_id keys with just name/arity keys (since the module qualifier is a given for any given type definition), we could also support partially qualified cons_ids in source code using a map from name/arity pairs to a list of all the type_ctors that have function symbols with that name/arity, instead of our current practice of inserting all possible partially module qualified version of every cons_id into a single giant table, and we could do the same thing with the field names table. This diff also separates tuples out from user-defined types, since in many respects they are different (they don't have a single type_ctor, for starters). It also separates out character constants, since they were alreay treated specially in most places, though not in some places where they *ought* to have been treated specially. Take the opportunity to give some other cons_ids better names. compiler/prog_data.m: Make the change described above, and document it. Put the implementations of the predicates declared in each part of this module next to the declarations, instead of keeping all the code until the very end (where it was usually far from their declarations). Remove three predicates with identical definitions from inst_match.m, inst_util.m and mode_constraints.m, and put the common definition in prog_data.m. library/term_io.m: Add a new predicate that is basically a reversible version of the existing function espaced_char, since the definition of char_consts needs reversibilty. compiler/post_typecheck.m: For functors of user-defined types, record their type_ctor. For tuples and char constants, record them as such. compiler/builtin_lib_types.m: compiler/parse_tree.m: compiler/notes/compiler_design.html: New module to centralize knowledge about builtin types, specially handled library types, and their function symbols. Previously, the stuff now in this module used to be in several different places, including prog_type.m and stm_expand.m, and some of it was duplicated. mdbcomp/prim_data.m: Add some predicates now needed by builtin_lib_types.m. compiler/builtin_ops.m: Factor out some duplicated code. compiler/add_type.m: Include the relevant type_ctors in the cons_ids generated in type definitions. compiler/hlds_data.m: Document an existing type better. Rename a cons_tag in sync with its corresponding cons_id. Put some declarations into logical order. compiler/hlds_out.m: Rename a misleadingly-named predicate. compiler/prog_ctgc.m: compiler/term_constr_build.m: Add XXXs for questionable existing code. compiler/add_clause.m: compiler/add_heap_ops.m: compiler/add_pragma.m: compiler/add_pred.m: compiler/add_trail_ops.m: compiler/assertion.m: compiler/bytecode_gen.m: compiler/closure_analysis.m: compiler/code_info.m: compiler/complexity.m: compiler/ctgc_selector.m: compiler/dead_proc_elim.m: compiler/deep_profiling.m: compiler/delay_partial_inst.m: compiler/dependency_graph.m: compiler/det_analysis.m: compiler/det_report.m: compiler/distance_granularity.m: compiler/erl_rtti.m: compiler/erl_unify_gen.m: compiler/export.m: compiler/field_access.m: compiler/foreign.m: compiler/format_call.m: compiler/hhf.m: compiler/higher_order.m: compiler/hlds_code_util.m: compiler/hlds_desc.m: compiler/hlds_goal.m: compiler/implementation_defined_literals.m: compiler/inst_check.m: compiler/inst_graph.m: compiler/inst_match.m: compiler/inst_util.m: compiler/instmap.m: compiler/intermod.m: compiler/interval.m: compiler/lambda.m: compiler/lco.m: compiler/make_tags.m: compiler/mercury_compile.m: compiler/mercury_to_mercury.m: compiler/middle_rec.m: compiler/ml_closure_gen.m: compiler/ml_code_gen.m: compiler/ml_code_util.m: compiler/ml_switch_gen.m: compiler/ml_type_gen.m: compiler/ml_unify_gen.m: compiler/ml_util.m: compiler/mlds_to_c.m: compiler/mlds_to_java.m: compiler/mode_constraints.m: compiler/mode_errors.m: compiler/mode_ordering.m: compiler/mode_util.m: compiler/modecheck_unify.m: compiler/modes.m: compiler/module_qual.m: compiler/polymorphism.m: compiler/prog_ctgc.m: compiler/prog_event.m: compiler/prog_io_util.m: compiler/prog_mode.m: compiler/prog_mutable.m: compiler/prog_out.m: compiler/prog_type.m: compiler/prog_util.m: compiler/purity.m: compiler/qual_info.m: compiler/rbmm.add_rbmm_goal_infos.m: compiler/rbmm.execution_path.m: compiler/rbmm.points_to_analysis.m: compiler/rbmm.region_transformation.m: compiler/recompilation.usage.m: compiler/rtti.m: compiler/rtti_out.m: compiler/rtti_to_mlds.m: compiler/simplify.m: compiler/simplify.m: compiler/special_pred.m: compiler/ssdebug.m: compiler/stack_opt.m: compiler/stm_expand.m: compiler/stratify.m: compiler/structure_reuse.direct.detect_garbagem: compiler/superhomoegenous.m: compiler/switch_detection.m: compiler/switch_gen.m: compiler/switch_util.m: compiler/table_gen.m: compiler/term_constr_build.m: compiler/term_norm.m: compiler/try_expand.m: compiler/type_constraints.m: compiler/type_ctor_info.m: compiler/type_util.m: compiler/typecheck.m: compiler/typecheck_errors.m: compiler/unify_gen.m: compiler/unify_proc.m: compiler/unify_modes.m: compiler/untupling.m: compiler/unused_imports.m: compiler/xml_documentation.m: Minor changes, mostly to ignore the type_ctor in cons_ids in places where it is not needed, take the type_ctor from the cons_id in places where it is more convenient, conform to the new names of some cons_ids, conform to the changes in hlds_out.m, and/or add now-needed imports of builtin_lib_types.m. In some places, the handling previously applied to cons/2 (which included tuples and character constants as well as user-defined function symbols) is now applied only to user-defined function symbols or to user-defined function symbols and tuples, as appropriate, with character constants being handled more like the other kinds of constants. In inst_match.m, rename a whole bunch of predicates to avoid ambiguities. In prog_util.m, remove two predicates that did almost nothing yet were far too easy to misuse.
2609 lines
107 KiB
Mathematica
2609 lines
107 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 1995-2009 The University of Melbourne.
|
|
% This file may only be copied under the terms of the GNU General
|
|
% Public 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 'StmExpaded_rollback_0_0_0'(int::in, int::out) is cc_multi.
|
|
% 'StmExpaded_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),
|
|
% ( Excp = univ(rollback_invalid_transaction) ->
|
|
% impure stm_discard_transaction_log(STM),
|
|
% 'StmExpanded_rollback_0_0_0'(X, Y)
|
|
% ; Excp = univ(rollback_retry) ->
|
|
% 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)
|
|
% ;
|
|
% 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.hlds_module.
|
|
:- import_module hlds.hlds_pred.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred stm_process_module(module_info::in, module_info::out) is det.
|
|
|
|
:- pred stm_process_pred(pred_id::in, module_info::in, module_info::out)
|
|
is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module check_hlds.inst_match.
|
|
:- 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.hlds_rtti.
|
|
:- import_module hlds.instmap.
|
|
:- import_module hlds.pred_table.
|
|
:- import_module hlds.quantification.
|
|
:- import_module libs.compiler_util.
|
|
:- import_module mdbcomp.prim_data.
|
|
:- 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 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 set.
|
|
:- import_module string.
|
|
:- import_module svmap.
|
|
:- import_module svvarset.
|
|
:- 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(prog_var),
|
|
vars_local :: set(prog_var),
|
|
vars_output :: set(prog_var),
|
|
vars_innerDI :: prog_var, % inner STM di var
|
|
vars_innerUO :: prog_var % inner STM uo var
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
stm_process_module(!ModuleInfo) :-
|
|
module_info_predids(PredIds, !ModuleInfo),
|
|
list.foldl(stm_process_pred, PredIds, !ModuleInfo),
|
|
module_info_clobber_dependency_info(!ModuleInfo).
|
|
|
|
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_preds(!.ModuleInfo, PredTable0),
|
|
map.lookup(PredTable0, PredId, PredInfo0),
|
|
pred_info_get_procedures(PredInfo0, ProcTable0),
|
|
map.lookup(ProcTable0, ProcId, ProcInfo0),
|
|
|
|
stm_process_proc_2(ProcInfo0, ProcInfo, PredId, ProcId, PredInfo0,
|
|
PredInfo1, !ModuleInfo),
|
|
|
|
pred_info_get_procedures(PredInfo1, ProcTable1),
|
|
map.det_update(ProcTable1, ProcId, ProcInfo, ProcTable),
|
|
pred_info_set_procedures(ProcTable, PredInfo1, PredInfo),
|
|
module_info_preds(!.ModuleInfo, PredTable1),
|
|
map.det_update(PredTable1, PredId, PredInfo, PredTable),
|
|
module_info_set_preds(PredTable, !ModuleInfo).
|
|
|
|
:- pred 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(!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(_, from_ground_term_construct),
|
|
% There can be no atomic goals inside this scope.
|
|
Goal = Goal0
|
|
;
|
|
( Reason = exist_quant(_)
|
|
; Reason = promise_solutions(_, _)
|
|
; Reason = promise_purity(_)
|
|
; Reason = commit(_)
|
|
; Reason = barrier(_)
|
|
; Reason = from_ground_term(_, from_ground_term_deconstruct)
|
|
; Reason = from_ground_term(_, from_ground_term_other)
|
|
; Reason = trace_goal(_, _, _, _, _)
|
|
),
|
|
stm_process_goal(Instmap, InnerGoal0, InnerGoal, !Info),
|
|
GoalExpr = scope(Reason, InnerGoal),
|
|
Goal = hlds_goal(GoalExpr, GoalInfo0)
|
|
)
|
|
;
|
|
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(this_file, "stm_process_goal: try_goal")
|
|
;
|
|
ShortHand0 = bi_implication(_, _),
|
|
unexpected(this_file, "stm_process_goal: 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 [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(this_file,
|
|
"stm_create_actual_goal: Unknown atomic goal type")
|
|
),
|
|
!:StmInfo = !.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),
|
|
(
|
|
inst_is_free(ModuleInfo, InitVarInst),
|
|
inst_is_free(ModuleInfo, FinalVarInst)
|
|
->
|
|
!:LocalVars = [Var | !.LocalVars]
|
|
;
|
|
inst_is_free(ModuleInfo, InitVarInst),
|
|
inst_is_bound(ModuleInfo, FinalVarInst)
|
|
->
|
|
!:OutputVars = [Var | !.OutputVars]
|
|
;
|
|
inst_is_bound(ModuleInfo, InitVarInst),
|
|
inst_is_bound(ModuleInfo, FinalVarInst)
|
|
->
|
|
!:InputVars = [Var | !.InputVars]
|
|
;
|
|
unexpected(this_file,
|
|
"order_vars_into_groups_2: Unhandled inst case")
|
|
),
|
|
order_vars_into_groups_2(ModuleInfo, Vars, InitInstmap, FinalInstmap,
|
|
!LocalVars, !InputVars, !OutputVars).
|
|
|
|
:- 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.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, HldsGoals,
|
|
InnerDIs, InnerUOs, IgnoreVarList0, StmGoalVarList,
|
|
!StmInfo) :-
|
|
(
|
|
HldsGoals = [],
|
|
InnerDIs = [],
|
|
InnerUOs = []
|
|
->
|
|
StmGoalVarList = []
|
|
;
|
|
HldsGoals = [HldsGoal | HldsGoals0],
|
|
InnerDIs = [InnerDI | InnerDIs0],
|
|
InnerUOs = [InnerUO | InnerUOs0]
|
|
->
|
|
IgnoreVarList = [InnerDI, InnerUO | IgnoreVarList0],
|
|
|
|
calc_pred_variables(InitInstmap, FinalInstmap, HldsGoal, InnerDI,
|
|
InnerUO, IgnoreVarList, StmGoalVar, !StmInfo),
|
|
calc_pred_variables_list(InitInstmap, FinalInstmap, HldsGoals0,
|
|
InnerDIs0, InnerUOs0, IgnoreVarList, StmGoalVarList0, !StmInfo),
|
|
StmGoalVarList = [StmGoalVar | StmGoalVarList0]
|
|
;
|
|
unexpected(this_file, "calc_pred_variables_list: 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, HldsGoal,
|
|
InnerDI, InnerUO, IgnoreVarList, StmGoalVars, !StmInfo) :-
|
|
ModuleInfo = !.StmInfo ^ stm_info_module_info,
|
|
|
|
goal_vars(HldsGoal, GoalVars0),
|
|
HldsGoal = hlds_goal(_, GoalInfo),
|
|
|
|
set.delete_list(GoalVars0, IgnoreVarList, GoalVars),
|
|
|
|
GoalVarList = set.to_sorted_list(GoalVars),
|
|
|
|
GoalNonLocalSet0 = goal_info_get_nonlocals(GoalInfo),
|
|
set.delete_list(GoalNonLocalSet0, IgnoreVarList, GoalNonLocalSet),
|
|
GoalNonLocals = set.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.from_list(LocalVarsList),
|
|
InputVars = set.from_list(InputVarsList),
|
|
OutputVars = set.from_list(OutputVarsList),
|
|
|
|
StmGoalVars = stm_goal_vars(InputVars, LocalVars, OutputVars, InnerDI,
|
|
InnerUO).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Predicates involved in the removal of the dummy predicates
|
|
% "stm_from_inner_to_outer_io" and "stm_from_outer_to_inner_io".
|
|
%
|
|
|
|
% 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([G | Gs], Goals, MaybeOutDI - MaybeOutUO,
|
|
MaybeInDI - MaybeInUO) :-
|
|
remove_tail(Gs, Goals0, MaybeOutDI0 - MaybeOutUO0,MaybeInDI0 - MaybeInUO0),
|
|
( G = hlds_goal(plain_call(_, _, [_, X, V], _, _, stm_outer_inner), _) ->
|
|
MaybeInDI = yes(V),
|
|
MaybeInUO = MaybeInUO0,
|
|
MaybeOutDI = yes(X),
|
|
MaybeOutUO = MaybeOutUO0,
|
|
Goals = Goals0
|
|
; G = hlds_goal(plain_call(_, _, [_, V, X], _, _, stm_inner_outer), _) ->
|
|
MaybeInDI = MaybeInDI0,
|
|
MaybeInUO = yes(V),
|
|
MaybeOutDI = MaybeOutDI0,
|
|
MaybeOutUO = yes(X),
|
|
Goals = Goals0
|
|
;
|
|
Goals = [G | Goals0],
|
|
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) :-
|
|
(
|
|
Goal0 = hlds_goal(conj(plain_conj, GoalList0), GoalInfo) ->
|
|
(
|
|
GoalList0 = [],
|
|
unexpected(this_file, "strip_goal_calls: conjunction is empty")
|
|
;
|
|
GoalList0 = [_ | _],
|
|
remove_tail(GoalList0, GoalList, MaybeOutVarPair, MaybeInVarPair),
|
|
MaybeInDI = fst(MaybeInVarPair),
|
|
MaybeInUO = snd(MaybeInVarPair),
|
|
MaybeOutDI = fst(MaybeOutVarPair),
|
|
MaybeOutUO = snd(MaybeOutVarPair),
|
|
(
|
|
MaybeInDI = yes(StmInDI0),
|
|
MaybeInUO = yes(StmInUO0),
|
|
MaybeOutDI = yes(StmOutDI0),
|
|
MaybeOutUO = yes(StmOutUO0)
|
|
->
|
|
StmInDI = StmInDI0,
|
|
StmInUO = StmInUO0,
|
|
StmOutDI = StmOutDI0,
|
|
StmOutUO = StmOutUO0,
|
|
Goal = hlds_goal(conj(plain_conj, GoalList), GoalInfo)
|
|
;
|
|
unexpected(this_file, "strip_goal_calls: Vars not extracted")
|
|
)
|
|
)
|
|
;
|
|
unexpected(this_file, "strip_goal_calls: 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, HldsGoal, !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,
|
|
pair(uo_mode, di_mode), CopyDIVars, !StmInfo),
|
|
create_var_unify_stm(MainOuterUO, MainInnerUO,
|
|
pair(uo_mode, di_mode), CopyUOVars, !StmInfo),
|
|
create_plain_conj([CopyDIVars, AtomicGoal, CopyUOVars], HldsGoal)
|
|
;
|
|
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 [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(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, AtomicGoalVarList1,
|
|
PPIDList, !StmInfo),
|
|
|
|
create_or_else_pred(AtomicGoalVars, AtomicGoalVarList1, PPIDList,
|
|
MainInnerDI, MainInnerUO, OrElseCall, !StmInfo),
|
|
create_var_unify_stm(MainInnerDI, MainOuterDI,
|
|
pair(uo_mode, di_mode), CopyDIVars, !StmInfo),
|
|
create_var_unify_stm(MainOuterUO, MainInnerUO,
|
|
pair(uo_mode, di_mode), CopyUOVars, !StmInfo),
|
|
create_plain_conj([CopyDIVars, OrElseCall, CopyUOVars], HldsGoal)
|
|
).
|
|
|
|
% 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, HldsGoal, !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, TopLevelCall, !StmInfo),
|
|
HldsGoal = TopLevelCall.
|
|
|
|
% 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, HldsGoal, !StmInfo) :-
|
|
AtomicGoalVars = list.det_head(AtomicGoalVarList),
|
|
|
|
create_rollback_pred(AtomicGoalVarList, WrapperCall, AtomicGoal,
|
|
OrElseGoals, !StmInfo),
|
|
|
|
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, HldsGoal, !StmInfo),
|
|
|
|
create_var_unify(OuterUO, OuterDI, pair(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:
|
|
%
|
|
% (
|
|
% X <- univ.univ(<<ExceptRes>>),
|
|
% X == << stm_rollback_exception_functor >>
|
|
% ->
|
|
% << true_goal >>
|
|
% ;
|
|
% << 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, HldsGoal, !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], [],
|
|
[pair(RttiVar, ground(shared, none)),
|
|
pair(ExceptVar, ground(shared, none)), pair(UnivPayloadVar, free)],
|
|
UnivCall, !NewPredInfo),
|
|
create_simple_call(mercury_public_builtin_module, "unify", pf_predicate,
|
|
only_mode, detism_semi, purity_pure,
|
|
[RttiVar, RollbackExceptVar, UnivPayloadVar], [],
|
|
[], _UnifyCall, !NewPredInfo),
|
|
create_var_test(UnivPayloadVar, RollbackExceptVar,
|
|
pair(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, HldsGoal, !NewPredInfo).
|
|
|
|
% Predicate that creates the following goals.
|
|
%
|
|
% impure stm_builtin.lock,
|
|
% impure stm_builtin.validate(<<STM>>, 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,
|
|
HldsGoals, !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, [], [], [], LockCall,
|
|
!NewPredInfo),
|
|
create_simple_call(mercury_stm_builtin_module, "stm_validate",
|
|
pf_predicate, only_mode, detism_det, purity_impure,
|
|
[StmVar, IsValidVar], [],
|
|
[pair(StmVar, ground(unique, none)), pair(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, [], [], [],
|
|
UnlockCall, !NewPredInfo),
|
|
HldsGoals = [LockCall, ValidCall, UnlockCall, DisjGoal]
|
|
;
|
|
UnlockAfterwards = no,
|
|
HldsGoals = [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, HldsGoals, !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, [], [], [], 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], [], [pair(StmVarL, ground(unique, none)),
|
|
pair(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,
|
|
pair(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, [], [], [],
|
|
UnlockCall, !NewPredInfo),
|
|
HldsGoals = [AssignValidConst, LockCall] ++ ValidCalls ++
|
|
[UnlockCall, ITEGoal]
|
|
;
|
|
UnlockAfterwards = no,
|
|
HldsGoals = [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,
|
|
HldsGoal, !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],
|
|
[],
|
|
[pair(TypeInfoVar, ground(shared, none)),
|
|
pair(ExceptionVar, ground(shared, none))],
|
|
HldsGoal_ExceptionThrow_Call, !NewPredInfo),
|
|
create_plain_conj(CreateTypeInfoGoals ++ [HldsGoal_ExceptionThrow_Call],
|
|
HldsGoal_ValidBranch),
|
|
create_plain_conj([RecursiveCall], HldsGoal_InvalidBranch),
|
|
template_lock_and_validate(StmVar, yes, HldsGoal_ValidBranch,
|
|
HldsGoal_InvalidBranch, HldsGoals, !NewPredInfo),
|
|
create_plain_conj(HldsGoals, HldsGoal).
|
|
|
|
% 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, HldsGoal, !NewPredInfo) :-
|
|
create_simple_call(mercury_stm_builtin_module, "stm_block", pf_predicate,
|
|
only_mode, detism_det, purity_impure, [StmVar], [],
|
|
[pair(StmVar, ground(unique, none))], BlockGoal, !NewPredInfo),
|
|
create_simple_call(mercury_stm_builtin_module, "stm_unlock", pf_predicate,
|
|
only_mode, detism_det, purity_impure, [], [], [], 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], [], [pair(StmVar, ground(clobbered, none))],
|
|
DropStateCall, !NewPredInfo),
|
|
create_plain_conj(LockAndValidateGoals ++ [DropStateCall, RecCall],
|
|
HldsGoal).
|
|
|
|
% 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, HldsGoal,
|
|
!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], [],
|
|
[pair(StmVar, ground(clobbered, none))], 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], HldsGoal).
|
|
|
|
% 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, HldsGoal, 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], [],
|
|
[pair(StmVarDI, ground(unique, none))], HldsGoal_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],
|
|
[], [pair(RttiTypeVar, ground(shared, none)),
|
|
pair(AtomicClosureVar, ground(shared, none)),
|
|
pair(ReturnExceptVar, ground(shared, none)),
|
|
pair(StmVarDI, ground(clobbered, none)),
|
|
pair(StmVarUO, ground(unique, none))], HldsGoal_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([HldsGoal_StmCreate] ++ RttiTypeVarAssign ++
|
|
[ClosureAssign, HldsGoal_TryStm, DisjGoal], HldsGoal0),
|
|
create_promise_purity_scope(HldsGoal0, purity_pure, HldsGoal).
|
|
|
|
% 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) :-
|
|
AtomicGoalVars = list.det_head(AtomicGoalVarList),
|
|
|
|
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) :-
|
|
AtomicGoalVars = list.det_head(AtomicGoalVarList),
|
|
|
|
get_input_output_types(AtomicGoalVars, !.StmInfo, _, OutputTypes),
|
|
make_return_type(OutputTypes, ResultType),
|
|
create_aux_variable(ResultType, yes("ResltVar"), 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) :-
|
|
map.lookup(!.OldPredVarTypes, ProgVar, ProgType),
|
|
% delete_var(!.OldPredVarSet, ProgVar, !:OldPredVarSet),
|
|
% map.delete(!.OldPredVarTypes, ProgVar, !:OldPredVarTypes),
|
|
new_var(NewProgVar, !NewPredVarSet),
|
|
map.det_insert(!.NewPredVarTypes, NewProgVar, ProgType,
|
|
!:NewPredVarTypes),
|
|
map.det_insert(!.VarMapping, 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.to_sorted_list(LocalVars),
|
|
|
|
VarMapping0 = map.init,
|
|
list.foldl5(apply_varset_to_preds, LocalVarList,
|
|
NewPredVarSet0, NewPredVarSet, NewPredVarTypes0, NewPredVarTypes,
|
|
OldPredVarSet0, OldPredVarSet, OldPredVarTypes0, OldPredVarTypes,
|
|
VarMapping0, VarMapping1),
|
|
|
|
( OrigInnerDI = OrigInnerUO ->
|
|
map.det_insert(VarMapping1, OrigInnerDI, InnerDI, VarMapping)
|
|
;
|
|
map.det_insert(VarMapping1, OrigInnerDI, InnerDI, VarMapping2),
|
|
map.det_insert(VarMapping2, OrigInnerUO, InnerUO, 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 = !.NewPredInfo ^ new_pred_proc_info := NewProcInfo,
|
|
!:StmInfo = !.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(this_file, "create_wrapper_for_goal_list: list empty")
|
|
;
|
|
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)
|
|
|
|
( InnerUO0 = InnerDI ->
|
|
CopyStm = yes,
|
|
create_aux_variable(stm_state_type, yes("NewUO"), InnerUO,
|
|
!NewPredInfo)
|
|
;
|
|
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, HldsGoal, 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, [], [], [], HldsGoal_StmLock_Call,
|
|
!NewPredInfo),
|
|
create_simple_call(StmModuleName, "stm_unlock", pf_predicate, only_mode,
|
|
detism_det, purity_impure, [], [], [], HldsGoal_StmUnLock_Call,
|
|
!NewPredInfo),
|
|
create_simple_call(StmModuleName, "stm_validate", pf_predicate, only_mode,
|
|
detism_det, purity_impure, [StmUO, IsValidVar], [],
|
|
[pair(StmUO, ground(unique, none)),
|
|
pair(IsValidVar, ground(shared, none))], HldsGoal_StmValidate_Call,
|
|
!NewPredInfo),
|
|
create_simple_call(StmModuleName, "stm_commit", pf_predicate, only_mode,
|
|
detism_det, purity_impure, [StmUO], [],
|
|
[pair(StmUO, ground(unique, none))], HldsGoal_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], [],
|
|
[pair(TypeInfoVar, ground(shared, none)),
|
|
pair(RollbackVar, ground(shared, none))],
|
|
HldsGoal_ExceptionThrow_Call, !NewPredInfo),
|
|
|
|
% Creates the branch on the validation result of the log.
|
|
create_plain_conj([HldsGoal_StmCommit_Call, HldsGoal_StmUnLock_Call],
|
|
HldsGoal_ValidBranch),
|
|
create_plain_conj([HldsGoal_StmUnLock_Call, ConstRollbackGoal] ++
|
|
CreateTypeInfoGoals ++ [HldsGoal_ExceptionThrow_Call],
|
|
HldsGoal_InvalidBranch),
|
|
|
|
create_switch_disjunction(IsValidVar,
|
|
[case(ValidTrueFunctor, [], HldsGoal_ValidBranch),
|
|
case(ValidFalseFunctor, [], HldsGoal_InvalidBranch)],
|
|
detism_det, purity_impure, DisjGoal, !NewPredInfo),
|
|
|
|
% Creates the main validation and commission goal.
|
|
PostAtomicTopLevelList = [HldsGoal_StmLock_Call,
|
|
HldsGoal_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, pair(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, HldsGoal).
|
|
|
|
% 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)
|
|
|
|
( InnerUO0 = InnerDI ->
|
|
CopyStm = yes,
|
|
create_aux_variable(stm_state_type, yes("NewUO"), InnerUO,
|
|
!NewPredInfo)
|
|
;
|
|
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, HldsGoals, !NewPredInfo) :-
|
|
HldsGoals = [].
|
|
|
|
% 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, HldsGoal, 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, pair(uo_mode, di_mode),
|
|
CopySTMAssign, !NewPredInfo),
|
|
TopLevelGoalList0 = Call1 ++ [CopySTMAssign, AtomicGoal] ++ Call2 ++
|
|
AssignResult
|
|
;
|
|
TopLevelGoalList0 = Call1 ++ [AtomicGoal] ++ Call2 ++ AssignResult
|
|
),
|
|
|
|
flatten_conj(TopLevelGoalList0, TopLevelGoalList),
|
|
create_plain_conj(TopLevelGoalList, HldsGoal).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Predicates used in the creation of "or_else" goals.
|
|
%
|
|
|
|
% or_else(<<inners>>, <<outers>>, <<STM_di>>, <<STM_uo>>) 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, HldsGoal, StmInfo, !NewPredInfo) :-
|
|
(
|
|
InnerSTMVars = [],
|
|
WrapperIDs = [],
|
|
AtomicGoalVars = []
|
|
->
|
|
HldsGoal = EndBranch
|
|
;
|
|
AtomicGoalVars = [AGV | AGVs],
|
|
InnerSTMVars = [InnerVar | InnerSTMVars0],
|
|
WrapperIDs = [WrapID | WrapperIDs0]
|
|
->
|
|
create_or_else_branches(AGVs, ReturnType, OuterStmDIVar,
|
|
OuterStmUOVar, InnerSTMVars0, RttiVar, RollbackExceptionRttiVar,
|
|
WrapperIDs0, EndBranch, HldsGoal0, StmInfo, !NewPredInfo),
|
|
create_or_else_branch(AGV, ReturnType, OuterStmDIVar,
|
|
OuterStmUOVar, InnerVar, RttiVar, RollbackExceptionRttiVar,
|
|
WrapID, HldsGoal0, HldsGoal, StmInfo, !NewPredInfo)
|
|
;
|
|
unexpected(this_file, "create_or_else_branches: 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) :-
|
|
( Count = 0 ->
|
|
Vars = []
|
|
; Count > 0 ->
|
|
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]
|
|
;
|
|
unexpected(this_file, "create_or_else_inner_stm_vars: 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)
|
|
% ( Excp = univ(rollback_retry) ->
|
|
% << nested or_else branch >>
|
|
% ;
|
|
% 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) :-
|
|
(
|
|
Src1 = [],
|
|
Src2 = []
|
|
->
|
|
Dest = []
|
|
;
|
|
Src1 = [S | Ss],
|
|
Src2 = [T | Ts]
|
|
->
|
|
Pred(S, T, R, !Accum),
|
|
map2_in_foldl(Pred, Ss, Ts, Rs, !Accum),
|
|
Dest = [R | Rs]
|
|
;
|
|
unexpected(this_file, "map2_in_foldl: 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) :-
|
|
(
|
|
Src1 = [],
|
|
Src2 = [],
|
|
Src3 = []
|
|
->
|
|
Dest = []
|
|
;
|
|
Src1 = [S | Ss],
|
|
Src2 = [T | Ts],
|
|
Src3 = [U | Us]
|
|
->
|
|
Pred(S, T, U, R, !Accum),
|
|
map3_in_foldl(Pred, Ss, Ts, Us, Rs, !Accum),
|
|
Dest = [R | Rs]
|
|
;
|
|
unexpected(this_file, "map2_in_foldl: 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,
|
|
HldsGoal, !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,
|
|
Goal::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], [],
|
|
[pair(StmVar, ground(unique, none)), pair(ThreadSTMDI, free),
|
|
pair(ThreadSTMUO, ground(unique, none))],
|
|
Goal, 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, [], [], [], 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], [], [pair(ExceptionRttiVar, ground(shared, none)),
|
|
pair(RetryConsVar, ground(shared, none))], RetryCall,
|
|
!NewPredInfo),
|
|
|
|
% XXX STM
|
|
% create_simple_call(mercury_stm_builtin_module, "retry",
|
|
% pf_predicate, only_mode,
|
|
% detism_det, purity_pure, [OuterSTMUO], [],
|
|
% [pair(OuterSTMUO, ground(unique, none))], 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], [], [pair(ExceptionRttiVar, ground(shared, none)),
|
|
pair(RollbackConsVar, ground(shared, none))], ThrowCall,
|
|
!NewPredInfo),
|
|
create_plain_conj([UnlockCall, AssignRollbackCons, ThrowCall],
|
|
InvalidGoal),
|
|
|
|
template_lock_and_validate_many(StmVars, no, ValidGoal, InvalidGoal,
|
|
HldsGoals, !NewPredInfo),
|
|
create_plain_conj(HldsGoals, HldsGoal).
|
|
|
|
% 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, HldsGoal, 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], [],
|
|
[pair(OuterStmDIVar, ground(unique, none)), pair(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],
|
|
[], [pair(RttiVar, ground(shared, none)),
|
|
pair(AtomicClosureVar, ground(shared, none)),
|
|
pair(ReturnExceptVar, free),
|
|
pair(InnerSTM0Var, ground(unique, none)),
|
|
pair(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], [],
|
|
[pair(InnerSTMVar, ground(unique, none)),
|
|
pair(OuterStmDIVar, ground(unique, none)), pair(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], [], [pair(InnerSTMVar, ground(unique, none))],
|
|
DiscardCall, !NewPredInfo),
|
|
create_simple_call(mercury_exception_module, "rethrow",
|
|
pf_predicate, only_mode, detism_erroneous, purity_pure,
|
|
[RttiVar, ReturnExceptVar], [], [pair(RttiVar, ground(shared, none)),
|
|
pair(ReturnExceptVar, ground(shared, none))], 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], HldsGoal).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% 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,
|
|
HldsGoal, 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"), SucessResultVar,
|
|
!NewPredInfo),
|
|
deconstruct_functor(ReturnExceptVar, exception_succeeded_functor,
|
|
[SucessResultVar], HldsGoal)
|
|
;
|
|
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], HldsGoal)
|
|
;
|
|
OutputTypes = [_, _ | _],
|
|
% Wrapper returns a tuple. Get the tuple result and return it.
|
|
|
|
make_type_info(ReturnType, _, MakeType, !NewPredInfo),
|
|
create_aux_variable(ReturnType, yes("SucessResult"), SucessResultVar,
|
|
!NewPredInfo),
|
|
deconstruct_functor(ReturnExceptVar, exception_succeeded_functor,
|
|
[SucessResultVar], DeconstructGoal),
|
|
deconstruct_tuple(SucessResultVar, OutputVars, UnifyOutputGoal),
|
|
|
|
create_plain_conj([DeconstructGoal, UnifyOutputGoal | MakeType],
|
|
HldsGoal)
|
|
).
|
|
|
|
% 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, HldsGoals,
|
|
!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, HldsGoal),
|
|
HldsGoals = [HldsGoal]
|
|
;
|
|
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, pair(out_mode, in_mode),
|
|
HldsGoal, !NewPredInfo),
|
|
|
|
HldsGoals = [HldsGoal]
|
|
;
|
|
OutputTypes = [_, _ | _],
|
|
% Wrapper returns a tuple. Creates a tuple from the output values.
|
|
|
|
make_type_info(ResultType, _, MakeType, !NewPredInfo),
|
|
hlds_goal.construct_tuple(ResultVar, OutputVars, HldsGoal),
|
|
|
|
HldsGoals = [HldsGoal | 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, !HldsGoal) :-
|
|
NewProcInfo0 = !.NewPredInfo ^ new_pred_proc_info,
|
|
proc_info_get_varset(NewProcInfo0, NewPredVarSet0),
|
|
proc_info_get_vartypes(NewProcInfo0, NewPredVarTypes0),
|
|
proc_info_get_headvars(NewProcInfo0, NewHeadVars0),
|
|
delete_var(NewPredVarSet0, ResultVar0, NewPredVarSet1),
|
|
map.delete(NewPredVarTypes0, ResultVar0, NewPredVarTypes1),
|
|
|
|
new_named_var(Name, ResultVar, NewPredVarSet1, NewPredVarSet),
|
|
map.det_insert(NewPredVarTypes1, ResultVar, ResultType, NewPredVarTypes),
|
|
|
|
VarMapping0 = map.init,
|
|
map.det_insert(VarMapping0, ResultVar0, ResultVar, VarMapping),
|
|
|
|
MapLambda = ((pred(X::in, Y::out) is det) :-
|
|
( X = ResultVar0 ->
|
|
Y = ResultVar
|
|
;
|
|
Y = X
|
|
)
|
|
),
|
|
list.map(MapLambda, NewHeadVars0, NewHeadVars),
|
|
|
|
rename_some_vars_in_goal(VarMapping, !HldsGoal),
|
|
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, HldsGoal, !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),
|
|
HldsGoalExpr = unify(VarLHS, UnifyRHS, UnifyMode, UnifyType, UnifyContext),
|
|
|
|
set.init(NonLocals0),
|
|
set.insert(NonLocals0, VarLHS, NonLocals1),
|
|
set.insert(NonLocals1, VarRHS, NonLocals),
|
|
|
|
Determism = detism_semi,
|
|
Purity = purity_pure,
|
|
goal_info_init(NonLocals, InstmapDelta, Determism, Purity, Context,
|
|
HldsGoalInfo),
|
|
|
|
HldsGoal = hlds_goal(HldsGoalExpr, HldsGoalInfo).
|
|
|
|
% 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, HldsGoal, !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),
|
|
HldsGoalExpr = unify(VarLHS, UnifyRHS, UnifyMode, UnifyType, UnifyContext),
|
|
|
|
set.init(NonLocals0),
|
|
set.insert(NonLocals0, VarLHS, NonLocals1),
|
|
set.insert(NonLocals1, VarRHS, NonLocals),
|
|
|
|
Determism = detism_det,
|
|
Purity = purity_pure,
|
|
goal_info_init(NonLocals, InstmapDelta, Determism, Purity, Context,
|
|
HldsGoalInfo),
|
|
|
|
HldsGoal = hlds_goal(HldsGoalExpr, HldsGoalInfo).
|
|
|
|
% 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, HldsGoal, !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),
|
|
HldsGoalExpr = unify(VarLHS, UnifyRHS, UnifyMode, UnifyType, UnifyContext),
|
|
|
|
set.init(NonLocals0),
|
|
set.insert(NonLocals0, VarLHS, NonLocals1),
|
|
set.insert(NonLocals1, VarRHS, NonLocals),
|
|
|
|
Determism = detism_det,
|
|
Purity = purity_pure,
|
|
goal_info_init(NonLocals, InstmapDelta, Determism, Purity, Context,
|
|
HldsGoalInfo),
|
|
|
|
HldsGoal = hlds_goal(HldsGoalExpr, HldsGoalInfo).
|
|
|
|
% 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, assoc_list(prog_var, mer_inst)::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, detism_det)))]),
|
|
instmap_delta_from_assoc_list(ClosureAssignInstmapDeltaList,
|
|
ClosureAssignInstmapDelta),
|
|
|
|
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.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.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(HldsGoalIn, ScopePurity, HldsGoalOut) :-
|
|
HldsGoalIn = 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),
|
|
HldsGoalOutExpr = scope(Reason, HldsGoalIn),
|
|
HldsGoalOut = hlds_goal(HldsGoalOutExpr, 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, HldsGoals, 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, HldsGoals,
|
|
PolyInfo0, PolyInfo),
|
|
poly_info_extract(PolyInfo, PredInfo0, PredInfo, ProcInfo0, ProcInfo,
|
|
ModuleInfo),
|
|
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_var_name_remap(ProcInfo, VarNameRemap),
|
|
proc_info_create(ProcContext, ProcVarSet, ProcVarTypes, ProcHeadVars,
|
|
ProcInstVarSet, ProcHeadModes, ProcDetism, ProcGoal, ProcRttiVarMaps,
|
|
address_is_not_taken, 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, 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.init(CallNonLocals0),
|
|
set.insert_list(CallNonLocals0, 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 = !.StmInfo ^ stm_info_expand_id := ExpansionCnt,
|
|
!:StmInfo = !.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 = !.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 = !.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(ProcInfo0, ProcInfo1),
|
|
recompute_instmap_delta_proc(recompute_atomic_instmap_deltas,
|
|
ProcInfo1, ProcInfo, ModuleInfo0, ModuleInfo),
|
|
!:NewPredInfo = !.NewPredInfo ^ new_pred_module_info := ModuleInfo,
|
|
!:NewPredInfo = !.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(HldsGoal, !NewPredInfo) :-
|
|
ProcInfo0 = !.NewPredInfo ^ new_pred_proc_info,
|
|
goal_vars(HldsGoal, GoalVars0),
|
|
proc_info_get_varset(ProcInfo0, ProcVarSet0),
|
|
proc_info_get_vartypes(ProcInfo0, ProcVarTypes0),
|
|
|
|
varset.select(ProcVarSet0, GoalVars0, ProgVarSet),
|
|
map.select(ProcVarTypes0, GoalVars0, ProcVarTypes),
|
|
|
|
proc_info_set_varset(ProgVarSet, ProcInfo0, ProcInfo1),
|
|
proc_info_set_goal(HldsGoal, ProcInfo1, ProcInfo2),
|
|
proc_info_set_vartypes(ProcVarTypes, ProcInfo2, ProcInfo),
|
|
!:NewPredInfo = !.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.to_sorted_list(InputSet),
|
|
Output = set.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),
|
|
|
|
list.map(map.lookup(VarTypes), InputVars, InputTypes),
|
|
list.map(map.lookup(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_io").
|
|
stm_outer_inner =
|
|
qualified(mercury_stm_builtin_module, "stm_from_outer_to_inner_io").
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- func this_file = string.
|
|
|
|
this_file = "stm_expand.m".
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
:- end_module transform_hlds.stm_expand.
|
|
%-----------------------------------------------------------------------------%
|