[m-rev.] for review: rewrite of the state variable transformation
Zoltan Somogyi
zs at csse.unimelb.edu.au
Wed Mar 2 14:00:02 AEDT 2011
For review by anyone. I am including a copy of state_var.m before the diff,
since it is much easier to read than the diff for that file.
Zoltan.
A rewrite of the state variable transformation from the ground up.
The initial aim was to avoid situations (encountered in the g12 project)
in which the old state variable transformation generated code that
did not satisfy the mode checker, due to unnecessary unifications.
The new system tries hard to minimize the number of unifications added to the
program. It does this by relying extensively on the idea that in a branched
structure such as an disjunction, if two branches both update the same state
variable, and the variables representing the last state of the state variable
in the two branches are (say) X and Y, and we pick X to represent the current
state after the disjunction, then we don't have to put the assignment X := Y
into the second branch; instead, we can RENAME Y to X in that branch.
To avoid renaming a goal several times (for itself, for its parent, for its
grandparent etc), we delay all renamings until the end, when we do it all
in one traversal.
The old state var system was opaque and hard to understand, partly because
its basic operations did different things in different contexts. The new system
is a much more direct expression of the intuitive meaning of state variables;
it keeps track of their state much as the programmer writing the original code
would. It should therefore be significantly easier to understand and to modify
in the future.
The new system can also detect more kinds of errors in the use of state
variables. For example it can discover that some branches of a disjunction or
if-then-else set the initial value of a state variable and some do not.
This is ok if the non-setting-branch cannot succeed; if it can, then it is
a bug. We therefore generate messages about such branches, but print them
only if mode analysis finds a bug in the procedure, since in that case,
the lack of initialization may be the cause of the bug.
doc/reference_manual.texi:
Replaced an old example that didn't know what it was talking about,
and thoroughly confused the issue of what is legal use of state
variables and what is not.
compiler/state_var.m:
Rewrite this module along the lines mentioned above.
compiler/options.m:
Add two new options. One, warn-state-var-shadowing, controls whether
we generate warnings for one state var shadowing another (which
G12 has lots of). The other, --allow-defn-for-builtins, is for
developers only; it is needed to bootstrap changes that add new
builtins. I needed this for a form of the state variable transformation
that used calls to a new builtin predicate to copy the values of state
this one.
compiler/add_clause.m:
compiler/add_pragma.m:
Respect the new --allow-defn-for-builtins option.
(Previously, we changed the code that now looks up the value of the
option.)
doc/user_guide.texi:
Document the --warn-state-var-shadowing option.
Fix some old documentation about dump options.
compiler/simplify.m:
Fix an old oversight: list the predicates in table_builtin.m that may
have calls introduced to them by table_gen.m.
compiler/superhomogeneous.m:
compiler/field_access.m:
compiler/add_clause.m:
compiler/goal_expr_to_goal.m:
Together with state_var.m, these modules contain the transformation
from the parse tree to the HLDS. Since the change to state_var.m
involves significant changes in its interface (such as separating out
the persistent and location-dependent aspects of the information needed
by the state variable transformation), and needing callbacks at
different points than the old transformation, these modules had to
change extensively as well to conform.
goal_expr_to_goal.m is a new module carved out of add_clause.m.
It deserves a module of its own because its code has a significantly
different purpose than add_clause.m. The two separate modules each
have much better cohesion than the old conjoined module did.
In superhomogeneous.m, replace two predicates that did the same thing
with one predicate.
compiler/make_hlds.m:
compiler/notes/compiler_design.html.m:
Mention the new module.
compiler/hlds_goal.m:
Add a mechanism to do the kind of incremental renaming that the state
variable transformation needs.
Add some utility predicates needed by the new code in other modules.
compiler/hlds_clause.m:
compiler/hlds_pred.m:
Add an extra piece of information to clauses and proc_infos:
a list of informational messages generated by the state variable
transformation about some branches of branched goals not giving initial
values to some state variables, while other branches do.
The state variable transformation fills in this field in clauses
where relevant.
compiler/clause_to_proc.m:
Copy this list of messages from clauses to proc_infos.
compiler/modes.m:
When generating an error message for a procedure, include this list
of messages from the state var transformation in the output.
compiler/handle_options.m:
Add a dump alias for debugging the state var transformation.
compiler/hlds_out_goal.m:
Add a predicate that is useful in trace messages when debugging
the compiler.
compiler/hlds_out_pred.m:
Print goal path and goal id information in clauses as well as
proc_infos, since the state var transformation now uses goal ids.
compiler/prog_item.m:
In lists of quantified vars in scope headers, separate out the vars
introduced as !S from those introduced as !.S and !:S. This makes it
easier for the state var transformation to handle them.
Document that we expect lists of quantified variables and state
variables to contain no duplicates. The state var transformation
is slightly simpler if we impose this requirement, and quantifying
a variable twice in the same scope does not make sense, and is
therefore almost certainly an error.
compiler/prog_io_util.m:
Generate error messages when a variable or state variable IS
listed twice in the same quantification list.
Factor out some code used to generate error messages.
compiler/typecheck.m:
Conform to the changes above.
Break a very large predicate into two smaller pieces.
compiler/add_class.m:
compiler/add_pragma.m:
compiler/add_pred.m:
compiler/assertion.m:
compiler/dead_proc_elim.m:
compiler/dependency_graph.m:
compiler/goal_path.m:
compiler/goal_util.m:
compiler/headvar_names.m:
compiler/hhf.m:
compiler/hlds_out_module.m:
compiler/inlining.m:
compiler/intermod.m:
compiler/mercury_to_mercury.m:
compiler/module_imports.m:
compiler/module_qual.m:
compiler/post_typecheck.m:
compiler/prog_io_goal.m:
compiler/prog_util.m:
compiler/purity.m:
compiler/unify_proc.m:
compiler/unused_imports.m:
Conform to the changes above.
compiler/mode_constraints.m:
compiler/modules.m:
compiler/structure_reuse.analysis.m:
Avoid the warnings we now generate about one state variable shadowing
another.
browser/declarative_user.m:
compiler/hlds_out_util.m:
compiler/ordering_mode_constraints.m:
compiler/table_gen.m:
deep_profiler/read_profile.m:
Improve programming style.
library/require.m:
Add expect_not, a negated version of expect.
library/varset.m:
Return lists of new variables in order, not reverse order.
mdbcomp/mdbcomp.goal_path.m:
compiler/prog_mode.m:
Add a utility predicate.
tests/debugger/tailrec1.exp:
tests/debugger/user_event_2.exp:
tests/invalid/any_passed_as_ground.err_exp:
tests/invalid/bad_sv_unify_msg.err_exp:
tests/invalid/state_vars_test1.err_exp:
tests/invalid/state_vars_test4.err_exp:
tests/invalid/try_bad_params.err_exp:
tests/invalid/try_detism.err_exp:
tests/invalid/purity/impure_pred_t1_fixed.err_exp:
tests/invalid/purity/impure_pred_t2.err_exp:
Update the expected outputs of these test cases to account for
incidental changes in variable numbers and goal paths after this
change.
tests/general/state_vars_tests.{m,exp}:
Remove the code that expected the state var transformation to do
something that was actually AGAINST the reference manual: treating
the step from the condition to the then part of an if-then-else
expression (not a goal) as a sequence point.
tests/hard_coded/if_then_else_expr_state_var.{m,exp}:
A new test to check the proper handling of state vars in if-then-else
expressions.
tests/hard_coded/Mmakefile:
Enable the new test.
tests/hard_coded/bit_buffer_test.m:
Fix a bug in the test itself: the introduction of a state var twice
in the same scope.
tests/hard_coded/try_syntax_6.m:
Avoid a warning about state var shadowing.
%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 2005-2011 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
%
% File: state_var.m.
% Main author: rafe.
%
%-----------------------------------------------------------------------------%
:- module hlds.make_hlds.state_var.
:- interface.
:- import_module hlds.hlds_goal.
:- import_module hlds.make_hlds.goal_expr_to_goal.
:- import_module mdbcomp.prim_data.
:- import_module parse_tree.error_util.
:- import_module parse_tree.prog_data.
:- import_module list.
:- import_module map.
%-----------------------------------------------------------------------------%
% This synonym improves code legibility. The intention is that we use
% svar instead of prog_var in pred type declarations for any variables X
% that represent state variables !X.
%
:- type svar == prog_var.
% When collecting the arms of a disjunction, we also need to collect
% the resulting svar_states.
%
:- type hlds_goal_svar_state
---> hlds_goal_svar_state(hlds_goal, svar_state).
% The state of the currently visible state variables. The state gets
% updated differently along differently execution paths. When execution
% paths rejoin, you need to create the state after the rejoin from the
% states being rejoined (which is what we use hlds_goal_svar_state for)
% using their last common ancestor state as a basis.
:- type svar_state.
% The persistent information needed by the state variable transformation.
% The store should always be threaded straight through all computations
% involved in the translation of the parse tree to the HLDS, with all
% updates being permanent.
:- type svar_store.
%-----------------------------------------------------------------------------%
% Replace !X args with two args !.X, !:X in that order.
%
:- pred expand_bang_states(list(prog_term)::in, list(prog_term)::out) is det.
:- pred expand_bang_states_instance_body(instance_body::in,
instance_body::out) is det.
%-----------------------------------------------------------------------------%
% Prepare for processing a clause by processing its head.
% If the head contains any references to !.S or !:S or both,
% make state variable S known in the body of the clause.
% (The head should not contain any references to !S; those should
% have been expanded out by calling expand_bang_states BEFORE calling
% this predicate.)
%
% Given the original list of args, we return a version in which state
% variable references have been replaced. Since we don't yet know what
% the final values of the state variables will be, we create prog_vars
% to represent these values, and return a mapping from the state vars
% to these designated-final-value prog_vars.
%
:- pred svar_prepare_for_clause_head(list(prog_term)::in, list(prog_term)::out,
prog_varset::in, prog_varset::out, map(svar, prog_var)::out,
svar_state::out, svar_store::out,
list(error_spec)::in, list(error_spec)::out) is det.
% Finish processing a clause. Make the final values of the clause's state
% vars match the mapping we decided on when processing the head.
%
:- pred svar_finish_clause_body(prog_context::in, map(svar, prog_var)::in,
list(hlds_goal)::in, hlds_goal::out,
svar_state::in, svar_state::in, svar_store::in,
list(error_spec)::out) is det.
% Prepare for processing a lambda expression by processing its head.
%
% In most ways, this is very similar to processing the head of a clause,
% but we also need to handle state variables which are visible in the scope
% that encloses the lambda expression. We make those state vars read-only
% within the lambda expression.
%
:- pred svar_prepare_for_lambda_head(prog_context::in,
list(prog_term)::in, list(prog_term)::out,
map(svar, prog_var)::out, svar_state::in, svar_state::out,
prog_varset::in, prog_varset::out,
list(error_spec)::in, list(error_spec)::out) is det.
% Finish processing a lambda expression.
%
:- pred svar_finish_lambda_body(prog_context::in, map(svar, prog_var)::in,
list(hlds_goal)::in, hlds_goal::out,
svar_state::in, svar_state::in, svar_store::in, svar_store::out) is det.
%-----------------------------------------------------------------------------%
% Finish the execution of an atomic goal. If this goal was not inside
% another atomic goal, then make any updates to state variables performed
% by the atomic goal take effect: make the value assigned to !:S inside
% the goal the new !.S.
%
:- pred svar_finish_atomic_goal(loc_kind::in, svar_state::in, svar_state::out)
is det.
%-----------------------------------------------------------------------------%
% Add some local state variables.
%
:- pred svar_prepare_for_local_state_vars(prog_context::in, prog_varset::in,
list(svar)::in, svar_state::in, svar_state::out,
list(error_spec)::in, list(error_spec)::out) is det.
% Remove some local state variables.
%
:- pred svar_finish_local_state_vars(list(svar)::in, svar_state::in,
svar_state::in, svar_state::out) is det.
%-----------------------------------------------------------------------------%
% Make sure that all arms of a disjunction produce the same state variable
% bindings, by adding unifiers as necessary.
%
:- pred svar_finish_disjunction(prog_context::in,
list(hlds_goal_svar_state)::in, list(hlds_goal)::out,
prog_varset::in, prog_varset::out, svar_state::in, svar_state::out,
svar_store::in, svar_store::out) is det.
%-----------------------------------------------------------------------------%
% Add unifiers to the Then and Else arms of an if-then-else to make sure
% that all the state variables match up.
%
% We also add unifiers to the Then arm for any new state variable
% mappings produced in the condition.
%
:- pred svar_finish_if_then_else(loc_kind::in, prog_context::in,
list(svar)::in,
hlds_goal::in, hlds_goal::out, hlds_goal::in, hlds_goal::out,
svar_state::in, svar_state::in, svar_state::in, svar_state::in,
svar_state::out, prog_varset::in, prog_varset::out,
svar_store::in, svar_store::out,
list(error_spec)::in, list(error_spec)::out) is det.
%-----------------------------------------------------------------------------%
:- type svar_outer_atomic_scope_info.
:- type svar_inner_atomic_scope_info.
% svar_start_outer_atomic_scope(Context, OuterStateVar, OuterDI, OuterUO,
% OuterScopeInfo, !State, !VarSet, !Specs):
%
% This predicate converts a !OuterStateVar specification in an atomic scope
% to a pair of outer state variables, OuterDI and OuterUO. Since
% !OuterStateVar should *not* be accessible inside the atomic scope,
% we delete it, but record it in OuterScopeInfo. The accessibility of
% !OuterStateVar will be restored when you call svar_finish_atomic_scope
% with OuterScopeInfo.
%
:- pred svar_start_outer_atomic_scope(prog_context::in, prog_var::in,
prog_var::out, prog_var::out, svar_outer_atomic_scope_info::out,
svar_state::in, svar_state::out, prog_varset::in, prog_varset::out,
list(error_spec)::in, list(error_spec)::out) is det.
% svar_finish_outer_atomic_scope(OuterScopeInfo, !SInfo):
%
% Restore the accessibility of !OuterStateVar that was disabled by
% svar_start_atomic_scope.
%
:- pred svar_finish_outer_atomic_scope(svar_outer_atomic_scope_info::in,
svar_state::in, svar_state::out) is det.
% svar_start_inner_atomic_scope(Context, InnerStateVar, InnerScopeInfo,
% !State, !VarSet, !Specs):
%
% This predicate prepares for an atomic scope with an !InnerStateVar
% specification by making that state var available.
%
:- pred svar_start_inner_atomic_scope(prog_context::in, prog_var::in,
svar_inner_atomic_scope_info::out,
svar_state::in, svar_state::out, prog_varset::in, prog_varset::out,
list(error_spec)::in, list(error_spec)::out) is det.
% svar_finish_inner_atomic_scope(Context, InnerScopeInfo, InnerDI, InnerUO,
% !State, !VarSet, !Specs):
%
% This predicate ends an atomic scope with an !InnerStateVar
% specification by making that state var unavailable, and returning
% the two variables InnerDI and InnerUO representing the initial and final
% states of this state variable.
%
:- pred svar_finish_inner_atomic_scope(prog_context::in,
svar_inner_atomic_scope_info::in, prog_var::out, prog_var::out,
svar_state::in, svar_state::out, prog_varset::in, prog_varset::out,
list(error_spec)::in, list(error_spec)::out) is det.
%-----------------------------------------------------------------------------%
% Given a list of argument terms, substitute !.X and !:X with the
% corresponding state variable mappings. Any !X should already have been
% expanded into !.X, !:X via a call to expand_bang_states.
%
:- pred substitute_state_var_mappings(list(prog_term)::in,
list(prog_term)::out, prog_varset::in, prog_varset::out,
svar_state::in, svar_state::out,
list(error_spec)::in, list(error_spec)::out) is det.
% Same as substitute_state_var_mappings, but for only one term.
%
:- pred substitute_state_var_mapping(prog_term::in, prog_term::out,
prog_varset::in, prog_varset::out, svar_state::in, svar_state::out,
list(error_spec)::in, list(error_spec)::out) is det.
% Look up the prog_var that represents the current state of the given
% state variable.
%
:- pred lookup_dot_state_var(prog_context::in, svar::in, prog_var::out,
prog_varset::in, prog_varset::out, svar_state::in, svar_state::out,
list(error_spec)::in, list(error_spec)::out) is det.
% Look up the prog_var that represents the next state of the given
% state variable.
%
:- pred lookup_colon_state_var(prog_context::in, svar::in, prog_var::out,
prog_varset::in, prog_varset::out, svar_state::in, svar_state::out,
list(error_spec)::in, list(error_spec)::out) is det.
%-----------------------------------------------------------------------------%
% Flatten a conjunction while preserving the invariants that the state
% variable transformation cares about.
%
:- pred svar_flatten_conj(prog_context::in,
list(hlds_goal)::in, hlds_goal::out,
svar_store::in, svar_store::out) is det.
% Flatten a goal into a conjunction while preserving the invariants that
% the state variable transformation cares about.
%
:- pred svar_goal_to_conj_list(hlds_goal::in, list(hlds_goal)::out,
svar_store::in, svar_store::out) is det.
%-----------------------------------------------------------------------------%
% Does the given argument list have an illegal result term?
%
:- pred illegal_state_var_func_result(pred_or_func::in, list(prog_term)::in,
svar::out) is semidet.
% Does the given lambda argument list have an illegal element?
% We currently do not allow !X to appear as a lambda head argument, though
% we might later extend the syntax still further to accommodate this
% using syntax such as !IO::(di, uo).
%
:- pred lambda_args_contain_bang_state_var(list(prog_term)::in, prog_var::out)
is semidet.
%-----------------------------------------------------------------------------%
:- pred report_illegal_state_var_update(prog_context::in,
string::in, prog_context::in, prog_varset::in,
svar::in, list(error_spec)::in, list(error_spec)::out) is det.
:- pred report_illegal_func_svar_result(prog_context::in, prog_varset::in,
svar::in, list(error_spec)::in, list(error_spec)::out) is det.
:- pred report_illegal_bang_svar_lambda_arg(prog_context::in, prog_varset::in,
svar::in, list(error_spec)::in, list(error_spec)::out) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module libs.options.
:- import_module mdbcomp.goal_path.
:- import_module parse_tree.prog_util.
:- import_module assoc_list.
:- import_module char.
:- import_module counter.
:- import_module int.
:- import_module io.
:- import_module pair.
:- import_module require.
:- import_module string.
:- import_module svmap.
:- import_module term.
:- import_module varset.
%-----------------------------------------------------------------------------%
%
% Define the main data structures used by the implementation of state vars.
%
% State vars defined outside a lambda goal become readonly when we move
% inside the lambda goal. Inside the lambda goal, it makes sense to access
% the current value of such state vars, but not to update it.
%
% We should make negations behave similarly: it should not be possible
% to update an outside state var inside a negation. However, for now,
% the language reference manual allows such updates. This type is here
% in case that changes.
:- type readonly_context_kind
---> roc_lambda.
:- type svar_status
% The two updated statuses may legally be present in a status map
% only DURING the processing of an atomic goal. At the end of each
% atomic goal, such statuses are always reset to status_known.
---> status_unknown
% We are in a scope that allows use of this state var,
% but it has not been given a value yet. This could be because
% the scope of the state var was established with !:S, not !S
% or !.S, in a clause head, or because it was established
% in a `some [!S]' scope.
; status_unknown_updated(prog_var)
% Before this atomic goal, this state var was status_unknown,
% but it was initialized by the current atomic goal to the given
% prog_var.
; status_known_ro(prog_var, readonly_context_kind, prog_context)
% The given prog_var is the current version of this state var,
% but the variable is readonly (ro); the program CANNOT create
% new versions of the state var. The second argument says WHY
% new versions cannot be created, and the third says where
% the construct named by the second argument occurs.
; status_known(prog_var)
% The given prog_var is the current version of this state var;
% the program can create new versions of the state var,
% but has not done so yet.
; status_known_updated(prog_var, prog_var).
% The first prog_var is the current version of this state var,
% and the second is the new, updated version, which will become
% the current version when we finish executing the current
% atomic goal.
:- type svar_state
---> svar_state(
state_status_map :: map(svar, svar_status)
).
:- type svar_store
---> svar_store(
store_next_goal_id :: counter,
store_final_remap :: map(goal_id,
assoc_list(prog_var, prog_var)),
store_warnings :: list(error_spec)
).
% Create a new svar_state/store set up to start processing a clause head.
%
:- func new_svar_state = svar_state.
:- func new_svar_store = svar_store.
new_svar_state = svar_state(map.init).
new_svar_store = svar_store(counter.init(1), map.init, []).
:- type state_var_name_source
---> name_initial
; name_middle
; name_final.
:- pred new_state_var_instance(svar::in, state_var_name_source::in,
prog_var::out, prog_varset::in, prog_varset::out) is det.
new_state_var_instance(StateVar, NameSource, Var, !VarSet) :-
SVarName = varset.lookup_name(!.VarSet, StateVar),
(
NameSource = name_initial,
ProgVarName = string.format("STATE_VARIABLE_%s_0", [s(SVarName)]),
varset.new_named_var(!.VarSet, ProgVarName, Var, !:VarSet)
;
NameSource = name_middle,
ProgVarBaseName = string.format("STATE_VARIABLE_%s", [s(SVarName)]),
varset.new_uniquely_named_var(!.VarSet, ProgVarBaseName, Var, !:VarSet)
;
NameSource = name_final,
ProgVarName = string.format("STATE_VARIABLE_%s", [s(SVarName)]),
varset.new_named_var(!.VarSet, ProgVarName, Var, !:VarSet)
).
%-----------------------------------------------------------------------------%
%
% Expand !S into !.S, !:S pairs.
%
expand_bang_states([], []).
expand_bang_states([HeadArg0 | TailArgs0], Args) :-
expand_bang_states(TailArgs0, TailArgs),
(
HeadArg0 = variable(_, _),
Args = [HeadArg0 | TailArgs]
;
HeadArg0 = functor(Const, FunctorArgs, Ctxt),
(
Const = atom("!"),
FunctorArgs = [variable(_StateVar, _)]
->
HeadArg1 = functor(atom("!."), FunctorArgs, Ctxt),
HeadArg2 = functor(atom("!:"), FunctorArgs, Ctxt),
Args = [HeadArg1, HeadArg2 | TailArgs]
;
Args = [HeadArg0 | TailArgs]
)
).
expand_bang_states_instance_body(InstanceBody0, InstanceBody) :-
(
InstanceBody0 = instance_body_abstract,
InstanceBody = instance_body_abstract
;
InstanceBody0 = instance_body_concrete(Methods0),
list.map(expand_bang_states_method, Methods0, Methods),
InstanceBody = instance_body_concrete(Methods)
).
:- pred expand_bang_states_method(instance_method::in, instance_method::out)
is det.
expand_bang_states_method(IM0, IM) :-
IM0 = instance_method(PredOrFunc, Method, ProcDef0, Arity0, Ctxt),
(
ProcDef0 = instance_proc_def_name(_),
IM = IM0
;
ProcDef0 = instance_proc_def_clauses(ItemClauses0),
list.map(expand_bang_states_clause, ItemClauses0, ItemClauses),
% Note that the condition should always succeed...
( ItemClauses = [ItemClause | _] ->
Args = ItemClause ^ cl_head_args,
adjust_func_arity(PredOrFunc, Arity, list.length(Args))
;
Arity = Arity0
),
ProcDef = instance_proc_def_clauses(ItemClauses),
IM = instance_method(PredOrFunc, Method, ProcDef, Arity, Ctxt)
).
:- pred expand_bang_states_clause(item_clause_info::in, item_clause_info::out)
is det.
expand_bang_states_clause(ItemClause0, ItemClause) :-
ItemClause0 = item_clause_info(Origin, VarSet, PredOrFunc, SymName,
Args0, Body, Context, SeqNum),
expand_bang_states(Args0, Args),
ItemClause = item_clause_info(Origin, VarSet, PredOrFunc, SymName,
Args, Body, Context, SeqNum).
%-----------------------------------------------------------------------------%
%
% Handle the start of processing a clause.
%
svar_prepare_for_clause_head(Args0, Args, !VarSet, FinalMap,
!:State, !:Store, !Specs) :-
!:State = new_svar_state,
!:Store = new_svar_store,
svar_prepare_head_terms(Args0, Args, map.init, FinalMap,
!State, !VarSet, !Specs).
:- pred svar_prepare_head_terms(list(prog_term)::in, list(prog_term)::out,
map(svar, prog_var)::in, map(svar, prog_var)::out,
svar_state::in, svar_state::out, prog_varset::in, prog_varset::out,
list(error_spec)::in, list(error_spec)::out) is det.
svar_prepare_head_terms([], [], !FinalMap, !State, !VarSet, !Specs).
svar_prepare_head_terms([Term0 | Terms0], [Term | Terms],
!FinalMap, !State, !VarSet, !Specs) :-
svar_prepare_head_term(Term0, Term, !FinalMap, !State, !VarSet, !Specs),
svar_prepare_head_terms(Terms0, Terms, !FinalMap, !State, !VarSet, !Specs).
:- pred svar_prepare_head_term(prog_term::in, prog_term::out,
map(svar, prog_var)::in, map(svar, prog_var)::out,
svar_state::in, svar_state::out,
prog_varset::in, prog_varset::out,
list(error_spec)::in, list(error_spec)::out) is det.
svar_prepare_head_term(Term0, Term, !FinalMap, !State, !VarSet, !Specs) :-
(
Term0 = variable(_, _),
Term = Term0
;
Term0 = functor(Functor, SubTerms0, Context),
(
Functor = atom("!."),
SubTerms0 = [variable(StateVar, _)]
->
!.State = svar_state(StatusMap0),
( map.search(StatusMap0, StateVar, OldStatus) ->
(
OldStatus = status_unknown,
% !:S happened to precede !.S in the head, which is ok.
new_state_var_instance(StateVar, name_initial, Var,
!VarSet),
Term = variable(Var, context_init),
Status = status_known(Var),
map.det_update(StatusMap0, StateVar, Status, StatusMap)
;
OldStatus = status_known(Var),
Term = variable(Var, context_init),
StatusMap = StatusMap0
;
OldStatus = status_unknown_updated(_),
unexpected($module, $pred, "status_unknown_updated for !.")
;
OldStatus = status_known_updated(_, _),
unexpected($module, $pred, "status_known_updated for !.")
;
OldStatus = status_known_ro(_, _, _),
% This can happen if the context outside a lambda
% expression has a state variable named StateVar,
% which make_svars_read_only has given this status,
% and the lambda expression itself also has !.StateVar.
new_state_var_instance(StateVar, name_initial, Var,
!VarSet),
Term = variable(Var, context_init),
Status = status_known(Var),
map.det_update(StatusMap0, StateVar, Status, StatusMap)
)
;
new_state_var_instance(StateVar, name_initial, Var, !VarSet),
Term = variable(Var, context_init),
Status = status_known(Var),
map.det_insert(StatusMap0, StateVar, Status, StatusMap)
),
!:State = svar_state(StatusMap)
;
Functor = atom("!:"),
SubTerms0 = [variable(StateVar, _)]
->
new_state_var_instance(StateVar, name_final, Var, !VarSet),
Term = variable(Var, context_init),
Status = status_unknown,
!.State = svar_state(StatusMap0),
( map.search(StatusMap0, StateVar, OldStatus) ->
(
OldStatus = status_unknown,
% This is the second occurrence of !:StateVar.
% Since !.FinalMap will contain StateVar, we will generate
% the error message below.
StatusMap = StatusMap0
;
OldStatus = status_known(_),
% The !. part of this state var has already been processed.
% We have nothing more to do.
StatusMap = StatusMap0
;
OldStatus = status_unknown_updated(_),
unexpected($module, $pred, "status_unknown_updated for !:")
;
OldStatus = status_known_updated(_, _),
unexpected($module, $pred, "status_known_updated for !:")
;
OldStatus = status_known_ro(_, _, _),
% This can happen if the context outside a lambda
% expression has a state variable named StateVar,
% which make_svars_read_only has given this status,
% and the lambda expression itself also has !:StateVar.
StatusMap = StatusMap0
)
;
map.det_insert(StatusMap0, StateVar, Status, StatusMap)
),
!:State = svar_state(StatusMap),
( map.search(!.FinalMap, StateVar, _) ->
report_repeated_head_state_var(Context, !.VarSet, StateVar,
!Specs)
;
svmap.det_insert(StateVar, Var, !FinalMap)
)
;
svar_prepare_head_terms(SubTerms0, SubTerms,
!FinalMap, !State, !VarSet, !Specs),
Term = functor(Functor, SubTerms, Context)
)
).
%-----------------------------------------------------------------------------%
%
% Handle the start of processing a lambda expression.
%
svar_prepare_for_lambda_head(Context, Args0, Args, FinalMap,
OutsideState, InsideState, !VarSet, !Specs) :-
% Make all currently visible state vars readonly, since they cannot
% be updated inside the lambda expression.
%
% Note that some of these state vars may already be readonly, since
% we may already be inside e.g. a lambda expression. We must make sure
% that readonly references work even from code that is inside two or more
% lambda expressions.
OutsideState = svar_state(OutsideStatusMap),
map.to_sorted_assoc_list(OutsideStatusMap, OutsideStatusList),
make_svars_read_only(roc_lambda, Context,
OutsideStatusList, InsideStatusList),
map.from_sorted_assoc_list(InsideStatusList, InsideStatusMap),
InsideState0 = svar_state(InsideStatusMap),
% Handle the arguments of the lambda expression as if they were the head
% of a clause.
svar_prepare_head_terms(Args0, Args, map.init, FinalMap,
InsideState0, InsideState, !VarSet, !Specs).
:- pred make_svars_read_only(readonly_context_kind::in, prog_context::in,
assoc_list(svar, svar_status)::in, assoc_list(svar, svar_status)::out)
is det.
make_svars_read_only(_ROC, _Context, [], []).
make_svars_read_only(ROC, Context, [SVar - CurStatus | CurTail], LambdaList) :-
make_svars_read_only(ROC, Context, CurTail, LambdaTail),
(
( CurStatus = status_unknown
; CurStatus = status_unknown_updated(_)
),
LambdaList = LambdaTail
;
CurStatus = status_known_ro(_, _, _),
LambdaList = [SVar - CurStatus | LambdaTail]
;
( CurStatus = status_known(Var)
; CurStatus = status_known_updated(Var, _)
),
LambdaStatus = status_known_ro(Var, ROC, Context),
LambdaList = [SVar - LambdaStatus | LambdaTail]
).
%-----------------------------------------------------------------------------%
%
% Handle the end of processing a clause or lambda expression.
%
svar_finish_clause_body(Context, FinalMap, Goals0, Goal,
InitialSVarState, FinalSVarState,
!.SVarStore, Warnings) :-
svar_finish_body(Context, FinalMap, Goals0, Goal1,
InitialSVarState, FinalSVarState, !SVarStore),
!.SVarStore = svar_store(_, DelayedRenamings, Warnings),
(
map.is_empty(FinalMap),
map.is_empty(DelayedRenamings)
->
Goal = Goal1
;
trace [compiletime(flag("state-var-lambda")), io(!IO)] (
some [FinalList, DelayedList] (
map.to_assoc_list(FinalMap, FinalList),
map.to_assoc_list(DelayedRenamings, DelayedList),
io.write_string("\nFINISH CLAUSE BODY in context ", !IO),
io.write(Context, !IO),
io.nl(!IO),
io.write_string("applying subn\n", !IO),
io.write(FinalList, !IO),
io.nl(!IO),
io.write_string("with incremental subn\n", !IO),
io.write(DelayedList, !IO),
io.nl(!IO)
)
),
incremental_rename_vars_in_goal(map.init, DelayedRenamings,
Goal1, Goal)
).
svar_finish_lambda_body(Context, FinalMap, Goals0, Goal,
InitialSVarState, FinalSVarState, !SVarStore) :-
svar_finish_body(Context, FinalMap, Goals0, Goal,
InitialSVarState, FinalSVarState, !SVarStore).
:- pred svar_finish_body(prog_context::in, map(svar, prog_var)::in,
list(hlds_goal)::in, hlds_goal::out,
svar_state::in, svar_state::in, svar_store::in, svar_store::out) is det.
svar_finish_body(Context, FinalMap, Goals0, Goal,
InitialSVarState, FinalSVarState, !Store) :-
map.to_assoc_list(FinalMap, FinalAssocList),
InitialSVarState = svar_state(InitialSVarStatusMap),
FinalSVarState = svar_state(FinalSVarStatusMap),
svar_find_final_renames_and_copy_goals(FinalAssocList,
InitialSVarStatusMap, FinalSVarStatusMap,
[], FinalSVarSubn, [], CopyGoals),
(
CopyGoals = [],
Goals1 = Goals0
;
CopyGoals = [_ | _],
Goals1 = Goals0 ++ CopyGoals
),
svar_flatten_conj(Context, Goals1, Goal1, !Store),
Goal1 = hlds_goal(GoalExpr1, GoalInfo1),
GoalId1 = goal_info_get_goal_id(GoalInfo1),
!.Store = svar_store(NextGoalId1, DelayedRenamingMap1, Warnings),
( map.search(DelayedRenamingMap1, GoalId1, DelayedRenaming0) ->
trace [compiletime(flag("state-var-lambda")), io(!IO)] (
io.write_string("\nfinishing body, ", !IO),
io.write_string("attaching subn to existing goal_id ", !IO),
io.write(GoalId1, !IO),
io.nl(!IO),
io.write_string("subn is ", !IO),
io.write(FinalSVarSubn, !IO),
io.nl(!IO)
),
svmap.det_update(GoalId1, DelayedRenaming0 ++ FinalSVarSubn,
DelayedRenamingMap1, DelayedRenamingMap),
NextGoalId = NextGoalId1,
Goal = Goal1
;
(
FinalSVarSubn = [],
NextGoalId = NextGoalId1,
DelayedRenamingMap = DelayedRenamingMap1,
Goal = Goal1
;
FinalSVarSubn = [_ | _],
counter.allocate(GoalIdNum, NextGoalId1, NextGoalId),
GoalId = goal_id(GoalIdNum),
trace [compiletime(flag("state-var-lambda")), io(!IO)] (
io.write_string("\nfinishing body, ", !IO),
io.write_string("attaching subn to new goal_id ", !IO),
io.write(GoalId, !IO),
io.nl(!IO),
io.write_string("subn is ", !IO),
io.write(FinalSVarSubn, !IO),
io.nl(!IO)
),
svmap.det_insert(GoalId, FinalSVarSubn,
DelayedRenamingMap1, DelayedRenamingMap),
goal_info_set_goal_id(GoalId, GoalInfo1, GoalInfo),
Goal = hlds_goal(GoalExpr1, GoalInfo)
)
),
!:Store = svar_store(NextGoalId, DelayedRenamingMap, Warnings).
:- pred svar_find_final_renames_and_copy_goals(assoc_list(svar, prog_var)::in,
map(svar, svar_status)::in, map(svar, svar_status)::in,
assoc_list(prog_var, prog_var)::in, assoc_list(prog_var, prog_var)::out,
list(hlds_goal)::in, list(hlds_goal)::out) is det.
svar_find_final_renames_and_copy_goals([], _, _, !FinalSVarSubn, !CopyGoals).
svar_find_final_renames_and_copy_goals([Head | Tail],
InitialStatusMap, FinalStatusMap, !FinalSVarSubn, !CopyGoals) :-
Head = SVar - FinalHeadVar,
map.lookup(InitialStatusMap, SVar, InitialStatus),
map.lookup(FinalStatusMap, SVar, FinalStatus),
(
FinalStatus = status_known(LastVar),
( FinalStatus = InitialStatus ->
% The state variable was not updated by the body.
% Leaving the unification between two headvars representing the
% initial and final states to the done at the start of the clause
% causes problems at the moment for the mode checker in the
% presence of unique modes.
make_copy_goal(LastVar, FinalHeadVar, CopyGoal),
!:CopyGoals = [CopyGoal | !.CopyGoals]
;
!:FinalSVarSubn = [LastVar - FinalHeadVar | !.FinalSVarSubn]
)
;
FinalStatus = status_unknown
% The state variable was never defined.
% The clause head already refers to the final version.
;
FinalStatus = status_known_ro(_, _, _),
unexpected($module, $pred, "readonly status")
;
( FinalStatus = status_known_updated(_, _)
; FinalStatus = status_unknown_updated(_)
),
unexpected($module, $pred, "updated status")
),
svar_find_final_renames_and_copy_goals(Tail,
InitialStatusMap, FinalStatusMap, !FinalSVarSubn, !CopyGoals).
%-----------------------------------------------------------------------------%
%
% Handle the completion of an atomic goal. Any variable that was updated in the
% goal gets the updated value as its new current value. The Loc argument is
% needed because sometimes what looks like an atomic goal (such as the
% condition of an if-then-else) is inside another atomic goal (such as an
% if-then-else expression). In such cases, the end of the inside atomic goal
% does NOT mean that we finished the containing atomic goal.
%
svar_finish_atomic_goal(Loc, !State) :-
(
Loc = loc_whole_goal,
!.State = svar_state(StatusMap0),
map.map_values_only(reset_updated_status, StatusMap0, StatusMap),
!:State = svar_state(StatusMap)
;
Loc = loc_inside_atomic_goal
).
:- pred reset_updated_status(svar_status::in, svar_status::out) is det.
reset_updated_status(!Status) :-
(
( !.Status = status_unknown
; !.Status = status_known_ro(_, _, _)
; !.Status = status_known(_)
)
;
!.Status = status_unknown_updated(NewProgVar),
!:Status = status_known(NewProgVar)
;
!.Status = status_known_updated(_OldProgVar, NewProgVar),
!:Status = status_known(NewProgVar)
).
%-----------------------------------------------------------------------------%
%
% Handle scopes that introduce state variables.
%
svar_prepare_for_local_state_vars(Context, VarSet, StateVars,
OutsideState, InsideState, !Specs) :-
OutsideState = svar_state(StatusMapOutside),
prepare_svars_for_scope(Context, VarSet, StateVars,
StatusMapOutside, StatusMapInside, !Specs),
InsideState = svar_state(StatusMapInside).
:- pred prepare_svars_for_scope(prog_context::in, prog_varset::in,
list(svar)::in, map(svar, svar_status)::in, map(svar, svar_status)::out,
list(error_spec)::in, list(error_spec)::out) is det.
prepare_svars_for_scope(_Context, _VarSet, [], !StatusMap, !Specs).
prepare_svars_for_scope(Context, VarSet, [SVar | SVars],
!StatusMap, !Specs) :-
( map.search(!.StatusMap, SVar, _OldStatus) ->
report_state_var_shadow(Context, VarSet, SVar, !Specs),
svmap.det_update(SVar, status_unknown, !StatusMap)
;
svmap.det_insert(SVar, status_unknown, !StatusMap)
),
prepare_svars_for_scope(Context, VarSet, SVars, !StatusMap, !Specs).
svar_finish_local_state_vars(StateVars, StateBeforeOutside, StateAfterInside,
StateAfterOutside) :-
StateBeforeOutside = svar_state(StatusMapBeforeOutside),
StateAfterInside = svar_state(StatusMapAfterInside),
trace [compiletime(flag("state-var-scope")), io(!IO)] (
map.to_assoc_list(StatusMapBeforeOutside, BeforeOutsideStatuses),
map.to_assoc_list(StatusMapAfterInside, AfterInsideStatuses),
io.write_string("Finish of scope\n", !IO),
io.write_string("quantified state vars\n", !IO),
io.write(StateVars, !IO),
io.nl(!IO),
io.write_string("status before outside\n", !IO),
io.write_list(BeforeOutsideStatuses, "\n", io.write, !IO),
io.nl(!IO),
io.write_string("status after inside\n", !IO),
io.write_list(AfterInsideStatuses, "\n", io.write, !IO),
io.nl(!IO)
),
% Remove access to the state vars introduced in the scope.
% Leave the status of all other state vars unaffected.
StatusMapAfterOutside0 = StatusMapAfterInside,
finish_svars_for_scope(StateVars, StatusMapBeforeOutside,
StatusMapAfterOutside0, StatusMapAfterOutside),
StateAfterOutside = svar_state(StatusMapAfterOutside).
:- pred finish_svars_for_scope(list(svar)::in, map(svar, svar_status)::in,
map(svar, svar_status)::in, map(svar, svar_status)::out) is det.
finish_svars_for_scope([], _, !StatusMapAfterOutside).
finish_svars_for_scope([SVar | SVars], StatusMapBeforeOutside,
!StatusMapAfterOutside) :-
( map.search(StatusMapBeforeOutside, SVar, BeforeOutsideStatus) ->
% The state var was visible before the scope. The outside state var
% was shadowed by a state var in the scope. Now that we are leaving
% the scope, restore access to the outside state var. Due to the
% shadowing, its status couldn't have changed inside the scope.
svmap.det_update(SVar, BeforeOutsideStatus, !StatusMapAfterOutside)
;
% The state var introduced in the scope wasn't visible before it.
svmap.det_remove(SVar, _, !StatusMapAfterOutside)
),
finish_svars_for_scope(SVars, StatusMapBeforeOutside,
!StatusMapAfterOutside).
%-----------------------------------------------------------------------------%
%
% Handle disjunctions. The algorithm we use has two passes over the disjuncts.
%
% - Pass 1 computes finds out, for each state variable known at the start of
% the disjunction, whether it was updated by any arms, and if yes, it picks
% the fina, prog_var from one of the updated arms to represent the state var
% after the disjunction.
%
% - Pass two processes the arms to ensure that the picked prog_var represents
% the final value of the state variable in all the arms. In arms that do not
% update the state variable, it introduces unifications to copy the initial
% value of the state var to be the final value. In arms that do update the
% state var, it schedules the prog_var representing the final value in
% that arm to be renamed to the picked prog_var.
svar_finish_disjunction(_Context, DisjStates, Disjs, !VarSet,
StateBefore, StateAfter, !Store) :-
StateBefore = svar_state(StatusMapBefore),
( map.is_empty(StatusMapBefore) ->
% Optimize the common case.
get_disjuncts_with_empty_states(DisjStates, [], RevDisjs),
list.reverse(RevDisjs, Disjs),
StateAfter = StateBefore
;
map.to_sorted_assoc_list(StatusMapBefore, StatusListBefore),
compute_status_after_arms(StatusListBefore, DisjStates,
map.init, ChangedStatusMapAfter, StatusMapBefore, StatusMapAfter),
map.to_sorted_assoc_list(ChangedStatusMapAfter,
ChangedStatusListAfter),
StateAfter = svar_state(StatusMapAfter),
!.Store = svar_store(NextGoalId0, DelayedRenamings0, Warnings0),
merge_changes_made_by_arms(DisjStates, StatusMapBefore,
ChangedStatusListAfter, !.VarSet, [], RevDisjs,
NextGoalId0, NextGoalId, DelayedRenamings0, DelayedRenamings,
Warnings0, Warnings),
list.reverse(RevDisjs, Disjs),
!:Store = svar_store(NextGoalId, DelayedRenamings, Warnings)
).
:- pred get_disjuncts_with_empty_states(list(hlds_goal_svar_state)::in,
list(hlds_goal)::in, list(hlds_goal)::out) is det.
get_disjuncts_with_empty_states([], !RevDisjuncts).
get_disjuncts_with_empty_states([GoalState | GoalStates], !RevDisjuncts) :-
GoalState = hlds_goal_svar_state(Goal, State),
StatusMapAfterGoal = State ^ state_status_map,
expect(map.is_empty(StatusMapAfterGoal), $module,
"map after goal not empty"),
!:RevDisjuncts = [Goal | !.RevDisjuncts],
get_disjuncts_with_empty_states(GoalStates, !RevDisjuncts).
% Pass 1. Compute the changes in the status map.
%
:- pred compute_status_after_arms(assoc_list(svar, svar_status)::in,
list(hlds_goal_svar_state)::in,
map(svar, svar_status)::in, map(svar, svar_status)::out,
map(svar, svar_status)::in, map(svar, svar_status)::out) is det.
compute_status_after_arms(_StatusListBefore, [],
!ChangedStatusMapAfter, !StatusMapAfter).
compute_status_after_arms(StatusListBefore, [ArmState | ArmStates],
!ChangedStatusMapAfter, !StatusMapAfter) :-
ArmState = hlds_goal_svar_state(_Armunct, StateAfterArm),
StatusMapAfterArm = StateAfterArm ^ state_status_map,
find_changes_in_arm_and_update_changed_status_map(StatusListBefore,
StatusMapAfterArm, !ChangedStatusMapAfter, !StatusMapAfter),
compute_status_after_arms(StatusListBefore, ArmStates,
!ChangedStatusMapAfter, !StatusMapAfter).
:- pred find_changes_in_arm_and_update_changed_status_map(
assoc_list(svar, svar_status)::in, map(svar, svar_status)::in,
map(svar, svar_status)::in, map(svar, svar_status)::out,
map(svar, svar_status)::in, map(svar, svar_status)::out) is det.
find_changes_in_arm_and_update_changed_status_map([], _,
!ChangedStatusMapAfter, !StatusMapAfter).
find_changes_in_arm_and_update_changed_status_map([Before | Befores],
StatusMapAfterArm, !ChangedStatusMapAfter, !StatusMapAfter) :-
Before = SVar - StatusBefore,
map.lookup(StatusMapAfterArm, SVar, StatusAfter),
( StatusBefore = StatusAfter ->
true
;
( map.search(!.ChangedStatusMapAfter, SVar, _AlreadyUpdated) ->
true
;
svmap.det_insert(SVar, StatusAfter, !ChangedStatusMapAfter),
svmap.det_update(SVar, StatusAfter, !StatusMapAfter)
)
),
find_changes_in_arm_and_update_changed_status_map(Befores,
StatusMapAfterArm, !ChangedStatusMapAfter, !StatusMapAfter).
% Pass 2. Effect the computed changes in the status map.
%
:- pred merge_changes_made_by_arms(list(hlds_goal_svar_state)::in,
map(svar, svar_status)::in, assoc_list(svar, svar_status)::in,
prog_varset::in, list(hlds_goal)::in, list(hlds_goal)::out,
counter::in, counter::out,
map(goal_id, assoc_list(prog_var, prog_var))::in,
map(goal_id, assoc_list(prog_var, prog_var))::out,
list(error_spec)::in, list(error_spec)::out) is det.
merge_changes_made_by_arms([], _StatusMapBefore, _ChangedStatusListAfter,
_VarSet, !RevArms, !NextGoalId, !DelayedRenamings, !Warnings).
merge_changes_made_by_arms([ArmState | ArmStates],
StatusMapBefore, ChangedStatusListAfter, VarSet, !RevArms,
!NextGoalId, !DelayedRenamings, !Warnings) :-
ArmState = hlds_goal_svar_state(Arm0, StateAfterArm),
StatusMapAfterArm = StateAfterArm ^ state_status_map,
counter.allocate(ArmIdNum, !NextGoalId),
ArmId = goal_id(ArmIdNum),
handle_arm_updated_state_vars(ChangedStatusListAfter, StatusMapBefore,
StatusMapAfterArm, VarSet, UninitVarNames, CopyGoals, ArmRenames),
svmap.det_insert(ArmId, ArmRenames, !DelayedRenamings),
Arm0 = hlds_goal(ArmExpr0, ArmInfo0),
(
CopyGoals = [],
ArmExpr = ArmExpr0
;
CopyGoals = [_ | _],
svar_goal_to_conj_list_internal(Arm0, ArmGoals0,
!NextGoalId, !DelayedRenamings),
ArmExpr = conj(plain_conj, ArmGoals0 ++ CopyGoals)
),
(
UninitVarNames = []
;
UninitVarNames = [_ | _],
% It is ok for an arm that cannot succeed not to initialize
% a variable, but we record a warning anyway, to be printed
% in case the procedure has a mode error.
ArmContext = goal_info_get_context(ArmInfo0),
report_missing_inits_in_disjunct(ArmContext, UninitVarNames,
!Warnings)
),
goal_info_set_goal_id(ArmId, ArmInfo0, ArmInfo),
Arm = hlds_goal(ArmExpr, ArmInfo),
!:RevArms = [Arm | !.RevArms],
merge_changes_made_by_arms(ArmStates, StatusMapBefore,
ChangedStatusListAfter, VarSet, !RevArms,
!NextGoalId, !DelayedRenamings, !Warnings).
:- pred handle_arm_updated_state_vars(assoc_list(svar, svar_status)::in,
map(svar, svar_status)::in, map(svar, svar_status)::in,
prog_varset::in, list(string)::out,
list(hlds_goal)::out, assoc_list(prog_var, prog_var)::out) is det.
handle_arm_updated_state_vars([], _, _, _, [], [], []).
handle_arm_updated_state_vars([Change | Changes], StatusMapBefore,
StatusMapAfterArm, VarSet, UninitVarNames, CopyGoals, Renames) :-
handle_arm_updated_state_vars(Changes, StatusMapBefore, StatusMapAfterArm,
VarSet, UninitVarNamesTail, CopyGoalsTail, RenamesTail),
Change = StateVar - AfterAllArmsStatus,
map.lookup(StatusMapBefore, StateVar, BeforeStatus),
map.lookup(StatusMapAfterArm, StateVar, AfterArmStatus),
( AfterArmStatus = BeforeStatus ->
expect_not(unify(AfterArmStatus, AfterAllArmsStatus),
$pred, "AfterArmStatus = AfterAllArmsStatus"),
(
BeforeStatus = status_known(BeforeVar),
(
AfterAllArmsStatus = status_known(AfterAllVar),
make_copy_goal(BeforeVar, AfterAllVar, CopyGoal),
CopyGoals = [CopyGoal | CopyGoalsTail],
UninitVarNames = UninitVarNamesTail,
Renames = RenamesTail
;
( AfterAllArmsStatus = status_known_ro(_, _, _)
; AfterAllArmsStatus = status_known_updated(_, _)
; AfterAllArmsStatus = status_unknown
; AfterAllArmsStatus = status_unknown_updated(_)
),
unexpected($module, $pred,
"AfterAllArmsStatus != status_known (Before == After)")
)
;
BeforeStatus = status_unknown,
varset.lookup_name(VarSet, StateVar, Name),
UninitVarName = "!:" ++ Name,
CopyGoals = CopyGoalsTail,
UninitVarNames = [UninitVarName | UninitVarNamesTail],
Renames = RenamesTail
;
( BeforeStatus = status_known_updated(_, _)
; BeforeStatus = status_unknown_updated(_)
),
% If the state var was updated before this disjunction,
% then any reference to !:StateVar should refer to the already
% known updated prog_var, and thus AfterAllArmsStatus should be
% the same as StatusBefore, which means we shouldn't get here.
unexpected($module, $pred, "BeforeStatus is updated")
;
BeforeStatus = status_known_ro(_, _, _),
unexpected($module, $pred, "BeforeStatus = status_known_ro")
)
;
(
AfterArmStatus = status_known(AfterArmVar),
(
AfterAllArmsStatus = status_known(AfterAllVar),
CopyGoals = CopyGoalsTail,
UninitVarNames = UninitVarNamesTail,
( AfterArmVar = AfterAllVar ->
Renames = RenamesTail
;
Renames = [AfterArmVar - AfterAllVar | RenamesTail]
)
;
( AfterAllArmsStatus = status_known_ro(_, _, _)
; AfterAllArmsStatus = status_known_updated(_, _)
; AfterAllArmsStatus = status_unknown
; AfterAllArmsStatus = status_unknown_updated(_)
),
unexpected($module, $pred,
"AfterAllArmsStatus != status_known (Before != After)")
)
;
AfterArmStatus = status_known_ro(_, _, _),
unexpected($module, $pred, "AfterArmStatus = status_known_ro")
;
AfterArmStatus = status_known_updated(_, _),
unexpected($module, $pred, "AfterArmStatus = status_known_updated")
;
AfterArmStatus = status_unknown,
unexpected($module, $pred, "AfterArmStatus = status_unknown")
;
AfterArmStatus = status_unknown_updated(_),
unexpected($module, $pred, "AfterArmStatus = status_unknown")
)
).
:- pred make_copy_goal(prog_var::in, prog_var::in, hlds_goal::out) is det.
make_copy_goal(FromVar, ToVar, CopyGoal) :-
% We can do the copying in one of two ways. Using unifications
% can cause problems because the (plain, non-unique) mode analysis pass
% feels free to schedule them in places where the unique mode analysis pass
% does not like them; specifically, it can cause a di reference to a
% variable to appear before a ui reference.
%
% The alternative is to add a builtin predicate to the standard library
% that just does copying, and to make make_copy_goal construct a call to
% that predicate. That predicate would need to be able to be called in
% three modes: di/uo, mdi/muo and in/out. However, it needs to have inst
% parameters so that whatever shape information we have about the source
% (subtype info, higher order mode info), we copy to the target.
%
% We generate a unification, and try to ensure that we don't generate
% di references to state variables before possible ui references. See the
% comment in svar_find_final_renames_and_copy_goals before the call to
% make_copy_goal.
create_pure_atomic_complicated_unification(ToVar, rhs_var(FromVar),
term.context_init, umc_implicit("state variable"), [], CopyGoal0),
goal_add_feature(feature_dont_warn_singleton,
CopyGoal0, CopyGoal).
%-----------------------------------------------------------------------------%
%
% Handle if-then-else goals. The basic idea is the same as for
% disjunctions, but we also have to handle three complications.
%
% First, the first disjunct consists of two parts: the condition and the then
% part, with data flowing between them.
%
% Second, variables can be quantified over the condition and the then part.
%
% Third, the if-then-else need not be a goal; it can also be an expression.
% This means that it is ok for variables to have status known_updated or
% unknown_updated in any of the status maps we handle.
%
svar_finish_if_then_else(LocKind, Context, QuantStateVars,
ThenGoal0, ThenGoal, ElseGoal0, ElseGoal,
StateBefore, StateAfterCond, StateAfterThen, StateAfterElse,
StateAfterITE, !VarSet, !Store, !Specs) :-
StateBefore = svar_state(StatusMapBefore),
StatusMapAfterCond = StateAfterCond ^ state_status_map,
StatusMapAfterThen = StateAfterThen ^ state_status_map,
StatusMapAfterElse = StateAfterElse ^ state_status_map,
map.keys(StatusMapBefore, SVarsBefore),
map.keys(StatusMapAfterCond, SVarsAfterCond),
map.keys(StatusMapAfterThen, SVarsAfterThen),
map.keys(StatusMapAfterElse, SVarsAfterElse),
expect(list.sublist(SVarsBefore, SVarsAfterCond), $pred,
"vars Before not sublist of Cond"),
expect(unify(SVarsBefore, SVarsAfterThen), $pred,
"vars Before != AfterThen"),
expect(unify(SVarsBefore, SVarsAfterElse), $pred,
"vars Before != AfterElse"),
handle_state_vars_in_ite(LocKind, QuantStateVars,
SVarsBefore, StatusMapBefore, StatusMapAfterCond,
StatusMapAfterThen, StatusMapAfterElse,
map.init, StatusMapAfterITE, !VarSet,
[], NeckCopyGoals, [], ThenEndCopyGoals, [], ElseEndCopyGoals,
[], ThenRenames, [], ElseRenames,
[], ThenMissingInits, [], ElseMissingInits),
StateAfterITE = svar_state(StatusMapAfterITE),
% It is ok for an arm that cannot succeed not to initialize a variable,
% but we record warnings for them anyway, to be printed in case the
% procedure has a mode error.
(
ThenMissingInits = []
;
ThenMissingInits = [_ | _],
ThenWarnings0 = !.Store ^ store_warnings,
report_missing_inits_in_ite(Context, ThenMissingInits,
"succeeds", "fails", ThenWarnings0, ThenWarnings),
!Store ^ store_warnings := ThenWarnings
),
(
ElseMissingInits = []
;
ElseMissingInits = [_ | _],
ElseWarnings0 = !.Store ^ store_warnings,
report_missing_inits_in_ite(Context, ThenMissingInits,
"fails", "succeeds", ElseWarnings0, ElseWarnings),
!Store ^ store_warnings := ElseWarnings
),
svar_goal_to_conj_list(ThenGoal0, ThenGoals0, !Store),
svar_goal_to_conj_list(ElseGoal0, ElseGoals0, !Store),
ThenGoals = NeckCopyGoals ++ ThenGoals0 ++ ThenEndCopyGoals,
ElseGoals = ElseGoals0 ++ ElseEndCopyGoals,
ThenGoal0 = hlds_goal(_ThenExpr0, ThenInfo0),
ElseGoal0 = hlds_goal(_ElseExpr0, ElseInfo0),
conj_list_to_goal(ThenGoals, ThenInfo0, ThenGoal1),
conj_list_to_goal(ElseGoals, ElseInfo0, ElseGoal1),
!.Store = svar_store(NextGoalId0, DelayedRenamings0, Warnings),
counter.allocate(ThenGoalIdNum, NextGoalId0, NextGoalId1),
counter.allocate(ElseGoalIdNum, NextGoalId1, NextGoalId),
ThenGoalId = goal_id(ThenGoalIdNum),
ElseGoalId = goal_id(ElseGoalIdNum),
goal_set_goal_id(ThenGoalId, ThenGoal1, ThenGoal),
goal_set_goal_id(ElseGoalId, ElseGoal1, ElseGoal),
svmap.det_insert(ThenGoalId, ThenRenames,
DelayedRenamings0, DelayedRenamings1),
svmap.det_insert(ElseGoalId, ElseRenames,
DelayedRenamings1, DelayedRenamings),
!:Store = svar_store(NextGoalId, DelayedRenamings, Warnings).
:- pred handle_state_vars_in_ite(loc_kind::in, list(svar)::in, list(svar)::in,
map(svar, svar_status)::in, map(svar, svar_status)::in,
map(svar, svar_status)::in, map(svar, svar_status)::in,
map(svar, svar_status)::in, map(svar, svar_status)::out,
prog_varset::in, prog_varset::out,
list(hlds_goal)::in, list(hlds_goal)::out,
list(hlds_goal)::in, list(hlds_goal)::out,
list(hlds_goal)::in, list(hlds_goal)::out,
assoc_list(prog_var, prog_var)::in, assoc_list(prog_var, prog_var)::out,
assoc_list(prog_var, prog_var)::in, assoc_list(prog_var, prog_var)::out,
list(string)::in, list(string)::out, list(string)::in, list(string)::out)
is det.
handle_state_vars_in_ite(_, _, [], _, _, _, _, !StatusMapAfterITE,
!VarSet, !NeckCopyGoals, !ThenEndCopyGoals, !ElseEndCopyGoals,
!ThenRenames, !ElseRenames, !ThenMissingInits, !ElseMissingInits).
handle_state_vars_in_ite(LocKind, QuantStateVars, [SVar | SVars],
StatusMapBefore, StatusMapAfterCond, StatusMapAfterThen,
StatusMapAfterElse, !StatusMapAfterITE,
!VarSet, !NeckCopyGoals, !ThenEndCopyGoals, !ElseEndCopyGoals,
!ThenRenames, !ElseRenames, !ThenMissingInits, !ElseMissingInits) :-
map.lookup(StatusMapBefore, SVar, StatusBefore),
map.lookup(StatusMapAfterCond, SVar, StatusAfterCond),
map.lookup(StatusMapAfterThen, SVar, StatusAfterThen),
map.lookup(StatusMapAfterElse, SVar, StatusAfterElse),
( list.member(SVar, QuantStateVars) ->
expect(unify(StatusBefore, StatusAfterThen), $module,
"state var shadowed in if-then-else is nevertheless updated"),
% SVar is quantified in the if-then-else. That means that Cond and Then
% may update a state variable with the same name as SVar, but this
% won't be SVar itself. The status of SVar itself after Cond and after
% Then will thus be unchanged. This is why we pass StatusBefore
% not just for itself, but in place of StatusAfterCond and
% StatusAfterThen as well.
handle_state_var_in_ite(LocKind, SVar, StatusBefore,
StatusBefore, StatusBefore, StatusAfterElse, StatusAfterITE,
!VarSet, !NeckCopyGoals, !ThenEndCopyGoals, !ElseEndCopyGoals,
!ThenRenames, !ElseRenames, !ThenMissingInits, !ElseMissingInits)
;
% If StatusBefore = status_known_ro(_, _, _), then we would expect
% StatusBefore = StatusAfterCond
% StatusBefore = StatusAfterThen
% StatusBefore = StatusAfterElse
% However, if the user program actually updates a state variable
% that should be readonly in this scope, then our recovery from that
% error would invalidate these expectations.
handle_state_var_in_ite(LocKind, SVar, StatusBefore,
StatusAfterCond, StatusAfterThen, StatusAfterElse, StatusAfterITE,
!VarSet, !NeckCopyGoals, !ThenEndCopyGoals, !ElseEndCopyGoals,
!ThenRenames, !ElseRenames, !ThenMissingInits, !ElseMissingInits)
),
svmap.det_insert(SVar, StatusAfterITE, !StatusMapAfterITE),
handle_state_vars_in_ite(LocKind, QuantStateVars, SVars,
StatusMapBefore, StatusMapAfterCond, StatusMapAfterThen,
StatusMapAfterElse, !StatusMapAfterITE,
!VarSet, !NeckCopyGoals, !ThenEndCopyGoals, !ElseEndCopyGoals,
!ThenRenames, !ElseRenames, !ThenMissingInits, !ElseMissingInits).
:- pred handle_state_var_in_ite(loc_kind::in, svar::in,
svar_status::in, svar_status::in, svar_status::in, svar_status::in,
svar_status::out, prog_varset::in, prog_varset::out,
list(hlds_goal)::in, list(hlds_goal)::out,
list(hlds_goal)::in, list(hlds_goal)::out,
list(hlds_goal)::in, list(hlds_goal)::out,
assoc_list(prog_var, prog_var)::in, assoc_list(prog_var, prog_var)::out,
assoc_list(prog_var, prog_var)::in, assoc_list(prog_var, prog_var)::out,
list(string)::in, list(string)::out, list(string)::in, list(string)::out)
is det.
handle_state_var_in_ite(LocKind, SVar, StatusBefore,
StatusAfterCond, StatusAfterThen, StatusAfterElse, StatusAfterITE,
!VarSet, !NeckCopyGoals, !ThenEndCopyGoals, !ElseEndCopyGoals,
!ThenRenames, !ElseRenames, !ThenMissingInits, !ElseMissingInits) :-
% There are eight cases depending on which of Cond, Then and Else
% update the state variable:
%
% # Cond Then Else Action
% 1 no no no do nothing
% 2 no no yes copy at end of then
% 3 no yes no copy at end of else
% 4 no yes yes rename else to match then
% 5 yes no no copy from cond at start of then, copy at end of else
% 6 yes no yes copy from cond at start of then
% 7 yes yes no copy at end of else
% 8 yes yes yes rename else to match then
trace [compiletime(flag("state-var-ite")), io(!IO)] (
io.write_string("state variable ", !IO),
io.write(SVar, !IO),
io.nl(!IO),
io.write_string("status before: ", !IO),
io.write(StatusBefore, !IO),
io.nl(!IO),
io.write_string("status after cond: ", !IO),
io.write(StatusAfterCond, !IO),
io.nl(!IO),
io.write_string("status after then: ", !IO),
io.write(StatusAfterThen, !IO),
io.nl(!IO),
io.write_string("status after else: ", !IO),
io.write(StatusAfterElse, !IO),
io.nl(!IO)
),
( StatusAfterCond = StatusBefore ->
% Cases 1-4.
( StatusAfterThen = StatusAfterCond ->
% Cases 1-2.
( StatusAfterElse = StatusBefore ->
% Case 1.
StatusAfterITE = StatusBefore
;
% Case 2.
(
StatusBefore = status_known(VarBefore),
VarAfterElse =
svar_get_current_progvar(LocKind, StatusAfterElse),
make_copy_goal(VarBefore, VarAfterElse, CopyGoal),
!:ThenEndCopyGoals = [CopyGoal | !.ThenEndCopyGoals],
StatusAfterITE = StatusAfterElse
;
StatusBefore = status_unknown,
varset.lookup_name(!.VarSet, SVar, SVarName),
!:ThenMissingInits =
["!:" ++ SVarName | !.ThenMissingInits],
% We pretend the then part defines StateVar, since this is
% the right thing to do when the then part cannot succeed.
% If it can, we will generate an error message during
% mode analysis.
StatusAfterITE = StatusAfterElse
;
StatusBefore = status_known_ro(_, _, _),
% The update of !SVar in the else case was an error,
% for which we have already generated an error message.
% Because of that, this dummy value won't be used.
% XXX Returning StatusAfterElse would cause fewer cascading
% error messages, but are those messages useful or not?
StatusAfterITE = StatusBefore
;
( StatusBefore = status_known_updated(_, _)
; StatusBefore = status_unknown_updated(_)
),
% This can happen if LocKind = loc_inside_atomic_goal,
% but any reference to !:SVar in the else case should
% have just returned the new progvar for SVar.
unexpected($module, $pred, "updated before (case 2)")
)
)
;
% Cases 3-4.
( StatusAfterElse = StatusBefore ->
% Case 3.
(
StatusBefore = status_known(VarBefore),
VarAfterThen =
svar_get_current_progvar(LocKind, StatusAfterThen),
make_copy_goal(VarBefore, VarAfterThen, CopyGoal),
!:ElseEndCopyGoals = [CopyGoal | !.ElseEndCopyGoals],
StatusAfterITE = StatusAfterThen
;
StatusBefore = status_unknown,
varset.lookup_name(!.VarSet, SVar, SVarName),
!:ElseMissingInits =
["!:" ++ SVarName | !.ElseMissingInits],
% We pretend the else part defines StateVar, since this is
% the right thing to do when the else part cannot succeed.
% If it can, we will generate an error message during
% mode analysis.
StatusAfterITE = StatusAfterThen
;
StatusBefore = status_known_ro(_, _, _),
% The update of !SVar in the then case was an error,
% for which we have already generated an error message.
% Because of that, this dummy value won't be used.
% XXX Returning StatusAfterThen would cause fewer cascading
% error messages, but are those messages useful or not?
StatusAfterITE = StatusBefore
;
( StatusBefore = status_known_updated(_, _)
; StatusBefore = status_unknown_updated(_)
),
% This can happen if LocKind = loc_inside_atomic_goal,
% but any reference to !:SVar in the then case should
% have just returned the new progvar for SVar.
unexpected($module, $pred, "updated before (case 3)")
)
;
% Case 4.
VarAfterThen =
svar_get_current_progvar(LocKind, StatusAfterThen),
VarAfterElse =
svar_get_current_progvar(LocKind, StatusAfterElse),
!:ElseRenames = [VarAfterElse - VarAfterThen | !.ElseRenames],
StatusAfterITE = StatusAfterThen
)
)
;
% Cases 5-8.
( StatusAfterThen = StatusAfterCond ->
% Cases 5-6.
( StatusAfterElse = StatusBefore ->
% Case 5.
(
StatusBefore = status_known(VarBefore),
new_state_var_instance(SVar, name_middle, FinalVar,
!VarSet),
VarAfterCond =
svar_get_current_progvar(LocKind, StatusAfterCond),
make_copy_goal(VarAfterCond, FinalVar, NeckCopyGoal),
!:NeckCopyGoals = [NeckCopyGoal | !.NeckCopyGoals],
make_copy_goal(VarBefore, FinalVar, ElseCopyGoal),
!:ElseEndCopyGoals = [ElseCopyGoal | !.ElseEndCopyGoals],
StatusAfterITE = status_known(FinalVar)
;
StatusBefore = status_unknown,
varset.lookup_name(!.VarSet, SVar, SVarName),
!:ElseMissingInits =
["!:" ++ SVarName | !.ElseMissingInits],
% We pretend the else part defines StateVar, since this is
% the right thing to do when the else part cannot succeed.
% If it can, we will generate an error message during
% mode analysis.
new_state_var_instance(SVar, name_middle, FinalVar,
!VarSet),
VarAfterCond =
svar_get_current_progvar(LocKind, StatusAfterCond),
make_copy_goal(VarAfterCond, FinalVar, NeckCopyGoal),
!:NeckCopyGoals = [NeckCopyGoal | !.NeckCopyGoals],
StatusAfterITE = status_known(FinalVar)
;
StatusBefore = status_known_ro(_, _, _),
% The update of !SVar in the condition was an error,
% for which we have already generated an error message.
% Because of that, this dummy value won't be used.
% XXX Returning StatusAfterCond would cause fewer cascading
% error messages, but are those messages useful or not?
StatusAfterITE = StatusBefore
;
( StatusBefore = status_known_updated(_, _)
; StatusBefore = status_unknown_updated(_)
),
% This can happen if LocKind = loc_inside_atomic_goal,
% but any reference to !:SVar in the condition should
% have just returned the new progvar for SVar.
unexpected($module, $pred, "updated before (case 5)")
)
;
% Case 6.
VarAfterCond =
svar_get_current_progvar(LocKind, StatusAfterCond),
VarAfterElse =
svar_get_current_progvar(LocKind, StatusAfterElse),
make_copy_goal(VarAfterCond, VarAfterElse, CopyGoal),
!:NeckCopyGoals = [CopyGoal | !.NeckCopyGoals],
StatusAfterITE = StatusAfterElse
)
;
% Cases 7-8.
( StatusAfterElse = StatusBefore ->
% Case 7.
(
StatusBefore = status_known(VarBefore),
VarAfterThen =
svar_get_current_progvar(LocKind, StatusAfterThen),
make_copy_goal(VarBefore, VarAfterThen, CopyGoal),
!:ElseEndCopyGoals = [CopyGoal | !.ElseEndCopyGoals],
StatusAfterITE = StatusAfterThen
;
StatusBefore = status_unknown,
varset.lookup_name(!.VarSet, SVar, SVarName),
!:ElseMissingInits =
["!:" ++ SVarName | !.ElseMissingInits],
% We pretend the else part defines StateVar, since this is
% the right thing to do when the else part cannot succeed.
% If it can, we will generate an error message during
% mode analysis.
StatusAfterITE = StatusAfterThen
;
StatusBefore = status_known_ro(_, _, _),
% The updates of !SVar in the condition and then cases
% were errors, for which we already generated messages.
% Because of that, this dummy value won't be used.
% XXX Returning StatusAfterThen would cause fewer cascading
% error messages, but are those messages useful or not?
StatusAfterITE = StatusBefore
;
( StatusBefore = status_known_updated(_, _)
; StatusBefore = status_unknown_updated(_)
),
% This can happen if LocKind = loc_inside_atomic_goal,
% but any reference to !:SVar in the condition and
% then case should have just returned the new progvar
% for SVar.
unexpected($module, $pred, "updated before (case 7)")
)
;
% Case 8.
VarAfterThen =
svar_get_current_progvar(LocKind, StatusAfterThen),
VarAfterElse =
svar_get_current_progvar(LocKind, StatusAfterElse),
!:ElseRenames = [VarAfterElse - VarAfterThen | !.ElseRenames],
StatusAfterITE = StatusAfterThen
)
)
).
%-----------------------------------------------------------------------------%
%
% Handle atomic goals. Atomic goals are basically a disjunction between
% the main goal and the orelse goals.
%
:- type svar_outer_atomic_scope_info
---> svar_outer_atomic_scope_info(
soasi_state_var :: svar,
soasi_before_status :: svar_status,
soasi_after_status :: svar_status
)
; no_svar_outer_atomic_scope_info.
svar_start_outer_atomic_scope(Context, OuterStateVar, OuterDIVar, OuterUOVar,
OuterScopeInfo, !State, !VarSet, !Specs) :-
StatusMap0 = !.State ^ state_status_map,
( map.remove(StatusMap0, OuterStateVar, BeforeStatus, StatusMap) ->
!State ^ state_status_map := StatusMap,
(
BeforeStatus = status_unknown,
report_uninitialized_state_var(Context, !.VarSet, OuterStateVar,
!Specs),
new_state_var_instance(OuterStateVar, name_middle, OuterDIVar,
!VarSet),
new_state_var_instance(OuterStateVar, name_middle, OuterUOVar,
!VarSet),
OuterScopeInfo = svar_outer_atomic_scope_info(OuterStateVar,
BeforeStatus, BeforeStatus)
;
BeforeStatus = status_known_ro(OuterDIVar, RO_Construct,
RO_Context),
report_illegal_state_var_update(Context,
ro_construct_name(RO_Construct), RO_Context, !.VarSet,
OuterStateVar, !Specs),
new_state_var_instance(OuterStateVar, name_middle, OuterUOVar,
!VarSet),
OuterScopeInfo = svar_outer_atomic_scope_info(OuterStateVar,
BeforeStatus, BeforeStatus)
;
BeforeStatus = status_known(OuterDIVar),
new_state_var_instance(OuterStateVar, name_middle, OuterUOVar,
!VarSet),
AfterStatus = status_known(OuterUOVar),
OuterScopeInfo = svar_outer_atomic_scope_info(OuterStateVar,
BeforeStatus, AfterStatus)
;
( BeforeStatus = status_known_updated(_, _)
; BeforeStatus = status_unknown_updated(_)
),
% This status should exist in a status map only when we are in the
% middle of processing an atomic goal.
unexpected($module, $pred, "status updated")
)
;
report_non_visible_state_var("", Context, !.VarSet, OuterStateVar,
!Specs),
new_state_var_instance(OuterStateVar, name_middle, OuterDIVar,
!VarSet),
new_state_var_instance(OuterStateVar, name_middle, OuterUOVar,
!VarSet),
OuterScopeInfo = no_svar_outer_atomic_scope_info
).
svar_finish_outer_atomic_scope(OuterScopeInfo, !State) :-
(
OuterScopeInfo = svar_outer_atomic_scope_info(OuterStateVar,
_BeforeStatus, AfterStatus),
StatusMap0 = !.State ^ state_status_map,
svmap.det_insert(OuterStateVar, AfterStatus, StatusMap0, StatusMap),
!State ^ state_status_map := StatusMap
;
OuterScopeInfo = no_svar_outer_atomic_scope_info
).
%-----------------------------------------------------------------------------%
:- type svar_inner_atomic_scope_info
---> svar_inner_atomic_scope_info(
siasi_state_var :: svar,
siasi_di_var :: prog_var,
siasi_state_before :: svar_state
).
svar_start_inner_atomic_scope(_Context, InnerStateVar, InnerScopeInfo,
!State, !VarSet, !Specs) :-
StateBefore = !.State,
new_state_var_instance(InnerStateVar, name_initial, InnerDIVar, !VarSet),
StatusMap0 = !.State ^ state_status_map,
svmap.set(InnerStateVar, status_known(InnerDIVar), StatusMap0, StatusMap),
!State ^ state_status_map := StatusMap,
InnerScopeInfo = svar_inner_atomic_scope_info(InnerStateVar, InnerDIVar,
StateBefore).
svar_finish_inner_atomic_scope(_Context, InnerScopeInfo,
InnerDIVar, InnerUOVar, !State, !VarSet, !Specs) :-
InnerScopeInfo = svar_inner_atomic_scope_info(InnerStateVar, InnerDIVar,
StateBefore),
StatusMap0 = !.State ^ state_status_map,
map.lookup(StatusMap0, InnerStateVar, Status),
(
Status = status_known(InnerUOVar)
;
( Status = status_unknown
; Status = status_unknown_updated(_)
; Status = status_known_ro(_, _, _)
; Status = status_known_updated(_, _)
),
unexpected($module, $pred, "status != known")
),
!:State = StateBefore.
%-----------------------------------------------------------------------------%
%
% Look up prog_vars for a state_var.
%
substitute_state_var_mappings([], [], !VarSet, !State, !Specs).
substitute_state_var_mappings([Arg0 | Args0], [Arg | Args], !VarSet, !State,
!Specs) :-
substitute_state_var_mapping(Arg0, Arg, !VarSet, !State, !Specs),
substitute_state_var_mappings(Args0, Args, !VarSet, !State, !Specs).
substitute_state_var_mapping(Arg0, Arg, !VarSet, !State, !Specs) :-
( Arg0 = functor(atom("!."), [variable(StateVar, _)], Context) ->
lookup_dot_state_var(Context, StateVar, Var, !VarSet, !State, !Specs),
Arg = variable(Var, context_init)
; Arg0 = functor(atom("!:"), [variable(StateVar, _)], Context) ->
lookup_colon_state_var(Context, StateVar, Var, !VarSet, !State,
!Specs),
Arg = variable(Var, context_init)
;
Arg = Arg0
).
lookup_dot_state_var(Context, StateVar, Var, !VarSet, !State, !Specs) :-
StatusMap0 = !.State ^ state_status_map,
( map.search(StatusMap0, StateVar, Status) ->
(
Status = status_unknown,
report_uninitialized_state_var(Context, !.VarSet, StateVar,
!Specs),
% We make StateVar known to avoid duplicate reports.
new_state_var_instance(StateVar, name_middle, Var, !VarSet),
svmap.det_update(StateVar, status_known_updated(Var, Var),
StatusMap0, StatusMap),
!State ^ state_status_map := StatusMap
;
Status = status_unknown_updated(NewVar),
report_uninitialized_state_var(Context, !.VarSet, StateVar,
!Specs),
% We make StateVar known to avoid duplicate reports.
new_state_var_instance(StateVar, name_middle, Var, !VarSet),
svmap.det_update(StateVar, status_known_updated(Var, NewVar),
StatusMap0, StatusMap),
!State ^ state_status_map := StatusMap
;
( Status = status_known(Var)
; Status = status_known_ro(Var, _, _)
; Status = status_known_updated(Var, _)
)
)
;
report_non_visible_state_var(".", Context, !.VarSet, StateVar,
!Specs),
Var = StateVar
).
lookup_colon_state_var(Context, StateVar, Var, !VarSet, !State, !Specs) :-
StatusMap0 = !.State ^ state_status_map,
( map.search(StatusMap0, StateVar, Status) ->
(
Status = status_unknown,
new_state_var_instance(StateVar, name_middle, Var, !VarSet),
svmap.det_update(StateVar, status_unknown_updated(Var),
StatusMap0, StatusMap),
!State ^ state_status_map := StatusMap
;
Status = status_known(OldVar),
new_state_var_instance(StateVar, name_middle, Var, !VarSet),
svmap.det_update(StateVar, status_known_updated(OldVar, Var),
StatusMap0, StatusMap),
!State ^ state_status_map := StatusMap
;
Status = status_known_ro(OldVar, RO_Construct, RO_Context),
(
RO_Construct = roc_lambda,
RO_ConstructName = "lambda expression"
),
report_illegal_state_var_update(Context, RO_ConstructName,
RO_Context, !.VarSet, StateVar, !Specs),
% We remove the readonly notation to avoid duplicate reports.
new_state_var_instance(StateVar, name_middle, Var, !VarSet),
svmap.det_update(StateVar, status_known_updated(OldVar, Var),
StatusMap0, StatusMap),
!State ^ state_status_map := StatusMap
;
Status = status_known_updated(_OldVar, Var)
;
Status = status_unknown_updated(Var)
)
;
report_non_visible_state_var(":", Context, !.VarSet, StateVar, !Specs),
% We could make StateVar known to avoid duplicate reports.
% new_state_var_instance(StateVar, name_initial, Var, !VarSet),
% svmap.det_insert(StateVar, status_known_updated(Var, Var),
% StatusMap0, StatusMap),
% !State ^ state_status_map := StatusMap
Var = StateVar
).
% Look up the prog_var representing the current state of the state_var
% whose status is given as the second argument.
%
:- func svar_get_current_progvar(loc_kind, svar_status) = prog_var.
svar_get_current_progvar(LocKind, Status) = ProgVar :-
(
LocKind = loc_whole_goal,
(
Status = status_known(ProgVar)
;
( Status = status_known_ro(_, _, _)
; Status = status_known_updated(_, _)
; Status = status_unknown
; Status = status_unknown_updated(_)
),
unexpected($module, $pred, "Status not known")
)
;
LocKind = loc_inside_atomic_goal,
(
Status = status_known(ProgVar)
;
Status = status_known_updated(_, ProgVar)
;
Status = status_unknown_updated(ProgVar)
;
( Status = status_known_ro(_, _, _)
; Status = status_unknown
),
unexpected($module, $pred, "Status not known or updated")
)
).
%-----------------------------------------------------------------------------%
%
% Code to handle the flattening of conjunctions. We need to be careful when we
% do so, since the goal we flatten could have a goal id, which would mean that
% the svar_store could have a delayed remapping for that goal_id. Just
% flattening the goal would remove the goal_info containing the goal_id from
% the HLDS, and the delayed renaming would not get done.
%
% We therefore make sure that when we flatten such a goal, we ensure that
% its subgoals all have goal_ids (creating new ones if needed), and that
% the delayed renaming that now won't get done on the conjunction as a whole
% *will* get done on each conjunct.
%
svar_flatten_conj(Context, Goals, Goal, !Store) :-
list.map_foldl(svar_goal_to_conj_list, Goals, GoalConjuncts, !Store),
list.condense(GoalConjuncts, Conjuncts),
GoalExpr = conj(plain_conj, Conjuncts),
goal_info_init(Context, GoalInfo),
Goal = hlds_goal(GoalExpr, GoalInfo).
svar_goal_to_conj_list(Goal, Conjuncts, !Store) :-
% The code here is the same as in svar_goal_to_conj_list_internal,
% modulo the differences in the argument list.
Goal = hlds_goal(GoalExpr, GoalInfo),
( GoalExpr = conj(plain_conj, Conjuncts0) ->
!.Store = svar_store(NextGoalId0, DelayedRenamingMap0, Warnings),
GoalId = goal_info_get_goal_id(GoalInfo),
( map.search(DelayedRenamingMap0, GoalId, GoalDelayedRenaming) ->
list.map_foldl2(
add_conjunct_delayed_renames(GoalDelayedRenaming),
Conjuncts0, Conjuncts, NextGoalId0, NextGoalId,
DelayedRenamingMap0, DelayedRenamingMap),
!:Store = svar_store(NextGoalId, DelayedRenamingMap, Warnings)
;
Conjuncts = Conjuncts0
)
;
Conjuncts = [Goal]
).
:- pred svar_goal_to_conj_list_internal(hlds_goal::in, list(hlds_goal)::out,
counter::in, counter::out,
map(goal_id, assoc_list(prog_var, prog_var))::in,
map(goal_id, assoc_list(prog_var, prog_var))::out) is det.
svar_goal_to_conj_list_internal(Goal, Conjuncts,
!NextGoalId, !DelayedRenamingMap) :-
% The code here is the same as in svar_goal_to_conj_list,
% modulo the differences in the argument list.
Goal = hlds_goal(GoalExpr, GoalInfo),
( GoalExpr = conj(plain_conj, Conjuncts0) ->
GoalId = goal_info_get_goal_id(GoalInfo),
( map.search(!.DelayedRenamingMap, GoalId, GoalDelayedRenaming) ->
list.map_foldl2(
add_conjunct_delayed_renames(GoalDelayedRenaming),
Conjuncts0, Conjuncts, !NextGoalId, !DelayedRenamingMap)
;
Conjuncts = Conjuncts0
)
;
Conjuncts = [Goal]
).
:- pred add_conjunct_delayed_renames(assoc_list(prog_var, prog_var)::in,
hlds_goal::in, hlds_goal::out, counter::in, counter::out,
map(goal_id, assoc_list(prog_var, prog_var))::in,
map(goal_id, assoc_list(prog_var, prog_var))::out) is det.
add_conjunct_delayed_renames(DelayedRenamingToAdd, Goal0, Goal,
!NextGoalId, !DelayedRenamingMap) :-
Goal0 = hlds_goal(GoalExpr, GoalInfo0),
GoalId0 = goal_info_get_goal_id(GoalInfo0),
( map.search(!.DelayedRenamingMap, GoalId0, DelayedRenaming0) ->
% The goal id must be valid.
DelayedRenaming = DelayedRenamingToAdd ++ DelayedRenaming0,
svmap.det_update(GoalId0, DelayedRenaming, !DelayedRenamingMap),
Goal = Goal0
;
% The goal id must be invalid, since the only thing that attaches goal
% ids to goals at this stage of the compilation process is this module,
% and it attaches goal_ids to goals only if it also puts them the
% delayed renaming map.
counter.allocate(GoalIdNum, !NextGoalId),
GoalId = goal_id(GoalIdNum),
goal_info_set_goal_id(GoalId, GoalInfo0, GoalInfo),
svmap.det_insert(GoalId, DelayedRenamingToAdd, !DelayedRenamingMap),
Goal = hlds_goal(GoalExpr, GoalInfo)
).
%-----------------------------------------------------------------------------%
%
% Test for various kinds of errors.
%
illegal_state_var_func_result(pf_function, Args, StateVar) :-
list.last(Args, functor(atom("!"), [variable(StateVar, _)], _Ctxt)).
lambda_args_contain_bang_state_var([Arg | Args], StateVar) :-
( Arg = functor(atom("!"), [variable(StateVar0, _)], _) ->
StateVar = StateVar0
;
lambda_args_contain_bang_state_var(Args, StateVar)
).
%-----------------------------------------------------------------------------%
%
% Report various kinds of errors.
%
report_illegal_state_var_update(Context, RO_Construct, RO_Context, VarSet,
StateVar, !Specs) :-
Name = varset.lookup_name(VarSet, StateVar),
Pieces1 = [words("Error: cannot use"), fixed("!:" ++ Name),
words("here due to the surrounding"), words(RO_Construct), suffix(";"),
words("you may only refer to"), fixed("!." ++ Name), suffix("."), nl],
Msg1 = simple_msg(Context, [always(Pieces1)]),
Pieces2 = [words("Here is the surrounding context that makes"),
words("state variable"), fixed(Name), words("readonly."), nl],
Msg2 = simple_msg(RO_Context, [always(Pieces2)]),
Spec = error_spec(severity_error, phase_parse_tree_to_hlds, [Msg1, Msg2]),
!:Specs = [Spec | !.Specs].
:- func ro_construct_name(readonly_context_kind) = string.
ro_construct_name(roc_lambda) = "lambda expression".
%-----------------------------------------------------------------------------%
report_illegal_func_svar_result(Context, VarSet, StateVar, !Specs) :-
Name = varset.lookup_name(VarSet, StateVar),
Pieces = [words("Error:"), fixed("!" ++ Name),
words("cannot be a function result."), nl,
words("You probably meant"), fixed("!." ++ Name),
words("or"), fixed("!:" ++ Name), suffix("."), nl],
Msg = simple_msg(Context, [always(Pieces)]),
Spec = error_spec(severity_error, phase_parse_tree_to_hlds, [Msg]),
!:Specs = [Spec | !.Specs].
%-----------------------------------------------------------------------------%
report_illegal_bang_svar_lambda_arg(Context, VarSet, StateVar, !Specs) :-
Name = varset.lookup_name(VarSet, StateVar),
Pieces = [words("Error:"), fixed("!" ++ Name),
words("cannot be a lambda argument."), nl,
words("Perhaps you meant"), fixed("!." ++ Name),
words("or"), fixed("!:" ++ Name), suffix("."), nl],
Msg = simple_msg(Context, [always(Pieces)]),
Spec = error_spec(severity_error, phase_parse_tree_to_hlds, [Msg]),
!:Specs = [Spec | !.Specs].
%-----------------------------------------------------------------------------%
:- pred report_non_visible_state_var(string::in, prog_context::in,
prog_varset::in, svar::in, list(error_spec)::in, list(error_spec)::out)
is det.
report_non_visible_state_var(DorC, Context, VarSet, StateVar, !Specs) :-
Name = varset.lookup_name(VarSet, StateVar),
Pieces = [words("Error: state variable"), fixed("!" ++ DorC ++ Name),
words("is not visible in this context."), nl],
Msg = simple_msg(Context, [always(Pieces)]),
Spec = error_spec(severity_error, phase_parse_tree_to_hlds, [Msg]),
!:Specs = [Spec | !.Specs].
%-----------------------------------------------------------------------------%
:- pred report_uninitialized_state_var(prog_context::in, prog_varset::in,
svar::in, list(error_spec)::in, list(error_spec)::out) is det.
report_uninitialized_state_var(Context, VarSet, StateVar, !Specs) :-
Name = varset.lookup_name(VarSet, StateVar),
Pieces = [words("Warning: reference to uninitialized state variable"),
fixed("!." ++ Name), suffix("."), nl],
Msg = simple_msg(Context, [always(Pieces)]),
Spec = error_spec(severity_warning, phase_parse_tree_to_hlds, [Msg]),
!:Specs = [Spec | !.Specs].
%-----------------------------------------------------------------------------%
:- pred report_repeated_head_state_var(prog_context::in, prog_varset::in,
svar::in, list(error_spec)::in, list(error_spec)::out) is det.
report_repeated_head_state_var(Context, VarSet, StateVar, !Specs) :-
Name = varset.lookup_name(VarSet, StateVar),
Pieces = [words("Warning: clause head introduces"),
words("state variable"), fixed(Name), words("more than once."), nl],
Msg = simple_msg(Context, [always(Pieces)]),
Spec = error_spec(severity_error, phase_parse_tree_to_hlds, [Msg]),
!:Specs = [Spec | !.Specs].
%-----------------------------------------------------------------------------%
:- pred report_state_var_shadow(prog_context::in, prog_varset::in,
svar::in, list(error_spec)::in, list(error_spec)::out) is det.
report_state_var_shadow(Context, VarSet, StateVar, !Specs) :-
Name = varset.lookup_name(VarSet, StateVar),
Pieces = [words("Warning: new state variable"), fixed(Name),
words("shadows old one."), nl],
Msg = simple_msg(Context, [option_is_set(warn_state_var_shadowing, yes,
[always(Pieces)])]),
Severity = severity_conditional(warn_state_var_shadowing, yes,
severity_warning, no),
Spec = error_spec(Severity, phase_parse_tree_to_hlds, [Msg]),
!:Specs = [Spec | !.Specs].
%-----------------------------------------------------------------------------%
:- pred report_missing_inits_in_ite(prog_context::in, list(string)::in,
string::in, string::in, list(error_spec)::in, list(error_spec)::out)
is det.
report_missing_inits_in_ite(Context, NextStateVars,
WhenMissing, WhenNotMissing, !Specs) :-
Pieces = [words("When the condition"), words(WhenNotMissing), suffix(","),
words("the if-then-else defines")] ++
list_to_pieces(NextStateVars) ++ [suffix(","),
words("but when the condition"), words(WhenMissing), suffix(","),
words("it does not."), nl],
Msg = simple_msg(Context, [always(Pieces)]),
Spec = error_spec(severity_informational, phase_parse_tree_to_hlds, [Msg]),
!:Specs = [Spec | !.Specs].
:- pred report_missing_inits_in_disjunct(prog_context::in, list(string)::in,
list(error_spec)::in, list(error_spec)::out) is det.
report_missing_inits_in_disjunct(Context, NextStateVars, !Specs) :-
Pieces = [words("Other disjuncts define")] ++
list_to_pieces(NextStateVars) ++ [suffix(","),
words("but not this one."), nl],
Msg = simple_msg(Context, [always(Pieces)]),
Spec = error_spec(severity_informational, phase_parse_tree_to_hlds, [Msg]),
!:Specs = [Spec | !.Specs].
%-----------------------------------------------------------------------------%
cvs diff: Diffing .
cvs diff: Diffing analysis
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/extra
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/extra
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/libatomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops/doc
cvs diff: Diffing boehm_gc/libatomic_ops/src
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/armcc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/gcc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/hpc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/ibmc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/icc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/msftc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/sunc
cvs diff: Diffing boehm_gc/libatomic_ops/tests
cvs diff: Diffing boehm_gc/libatomic_ops-1.2
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/doc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/tests
cvs diff: Diffing boehm_gc/m4
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing browser
Index: browser/declarative_user.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/browser/declarative_user.m,v
retrieving revision 1.70
diff -u -b -r1.70 declarative_user.m
--- browser/declarative_user.m 5 Feb 2010 04:16:14 -0000 1.70
+++ browser/declarative_user.m 19 Feb 2011 14:35:37 -0000
@@ -233,7 +233,7 @@
!.User ^ display_question = yes,
write_decl_question(Question, !.User, !IO),
user_question_prompt(UserQuestion, Prompt),
- !:User = !.User ^ display_question := no
+ !User ^ display_question := no
;
!.User ^ display_question = no,
Prompt = "dd> "
@@ -241,7 +241,7 @@
get_command(Prompt, Command, !User, !IO),
handle_command(Command, UserQuestion, Response, !User, !IO),
( Response \= user_response_show_info(_) ->
- !:User = !.User ^ display_question := yes
+ !User ^ display_question := yes
;
true
)
@@ -251,31 +251,32 @@
user_response(T)::out, user_state::in, user_state::out,
io::di, io::uo) is cc_multi.
-handle_command(user_cmd_yes, UserQuestion, Response, !User, !IO) :-
+handle_command(Cmd, UserQuestion, Response, !User, !IO) :-
+ (
+ Cmd = user_cmd_yes,
Question = get_decl_question(UserQuestion),
Node = get_decl_question_node(Question),
Response = user_response_answer(Question,
- truth_value(Node, truth_correct)).
-
-handle_command(user_cmd_no, UserQuestion, Response, !User, !IO) :-
+ truth_value(Node, truth_correct))
+ ;
+ Cmd = user_cmd_no,
Question = get_decl_question(UserQuestion),
Node = get_decl_question_node(Question),
Response = user_response_answer(Question,
- truth_value(Node, truth_erroneous)).
-
-handle_command(user_cmd_inadmissible, UserQuestion, Response, !User, !IO) :-
+ truth_value(Node, truth_erroneous))
+ ;
+ Cmd = user_cmd_inadmissible,
Question = get_decl_question(UserQuestion),
Node = get_decl_question_node(Question),
Response = user_response_answer(Question,
- truth_value(Node, truth_inadmissible)).
-
-handle_command(user_cmd_skip, UserQuestion, Response, !User, !IO) :-
+ truth_value(Node, truth_inadmissible))
+ ;
+ Cmd = user_cmd_skip,
Question = get_decl_question(UserQuestion),
Node = get_decl_question_node(Question),
- Response = user_response_answer(Question, skip(Node)).
-
-handle_command(user_cmd_browse_arg(MaybeArgNum), UserQuestion, Response,
- !User, !IO) :-
+ Response = user_response_answer(Question, skip(Node))
+ ;
+ Cmd = user_cmd_browse_arg(MaybeArgNum),
Question = get_decl_question(UserQuestion),
edt_node_trace_atoms(Question, InitAtom, FinalAtom),
(
@@ -317,10 +318,9 @@
"Please select a subterm to track.\n", !IO),
query_user(UserQuestion, Response, !User, !IO)
)
- ).
-
-handle_command(user_cmd_browse_xml_arg(MaybeArgNum), UserQuestion, Response,
- !User, !IO) :-
+ )
+ ;
+ Cmd = user_cmd_browse_xml_arg(MaybeArgNum),
Question = get_decl_question(UserQuestion),
edt_node_trace_atoms(Question, _, FinalAtom),
(
@@ -330,73 +330,71 @@
MaybeArgNum = no,
browse_xml_atom(FinalAtom, !.User, !IO)
),
- query_user(UserQuestion, Response, !User, !IO).
-
-handle_command(user_cmd_print_arg(From, To), UserQuestion, Response,
- !User, !IO) :-
+ query_user(UserQuestion, Response, !User, !IO)
+ ;
+ Cmd = user_cmd_print_arg(From, To),
Question = get_decl_question(UserQuestion),
edt_node_trace_atoms(Question, _, TraceAtom),
print_atom_arguments(TraceAtom, From, To, !.User, !IO),
- query_user(UserQuestion, Response, !User, !IO).
-
-handle_command(user_cmd_param_command(ParamCommand), UserQuestion, Response,
- !User, !IO) :-
+ query_user(UserQuestion, Response, !User, !IO)
+ ;
+ Cmd = user_cmd_param_command(ParamCommand),
Browser0 = !.User ^ browser,
DummyTerm = synthetic_term("", [], no),
Info0 = browser_info(DummyTerm, [], print, no, Browser0, no_track, no),
- run_param_command(debugger_internal, ParamCommand, no, Info0, Info, !IO),
+ run_param_command(debugger_internal, ParamCommand, no,
+ Info0, Info, !IO),
Info = browser_info(_, _, _, _, Browser, _, _),
- !:User = !.User ^ browser := Browser,
- query_user(UserQuestion, Response, !User, !IO).
-
-handle_command(user_cmd_trust_predicate, UserQuestion,
- user_response_trust_predicate(Question), !User, !IO) :-
- Question = get_decl_question(UserQuestion).
-
-handle_command(user_cmd_trust_module, UserQuestion,
- user_response_trust_module(Question), !User, !IO) :-
- Question = get_decl_question(UserQuestion).
-
-handle_command(user_cmd_info, _, user_response_show_info(!.User ^ outstr),
- !User, !IO).
-
-handle_command(user_cmd_undo, _, user_response_undo, !User, !IO).
-
-handle_command(user_cmd_browse_io(ActionNum), UserQuestion, Response,
- !User, !IO) :-
+ !User ^ browser := Browser,
+ query_user(UserQuestion, Response, !User, !IO)
+ ;
+ Cmd = user_cmd_trust_predicate,
+ Question = get_decl_question(UserQuestion),
+ Response = user_response_trust_predicate(Question)
+ ;
+ Cmd = user_cmd_trust_module,
+ Question = get_decl_question(UserQuestion),
+ Response = user_response_trust_module(Question)
+ ;
+ Cmd = user_cmd_info,
+ Response = user_response_show_info(!.User ^ outstr)
+ ;
+ Cmd = user_cmd_undo,
+ Response = user_response_undo
+ ;
+ Cmd = user_cmd_browse_io(ActionNum),
Question = get_decl_question(UserQuestion),
edt_node_io_actions(Question, MaybeIoActions),
% We don't have code yet to trace a marked I/O action.
browse_chosen_io_action(MaybeIoActions, ActionNum, _MaybeTrack,
!User, !IO),
- query_user(UserQuestion, Response, !User, !IO).
-
-handle_command(user_cmd_print_io(From, To), UserQuestion, Response,
- !User, !IO) :-
+ query_user(UserQuestion, Response, !User, !IO)
+ ;
+ Cmd = user_cmd_print_io(From, To),
Question = get_decl_question(UserQuestion),
edt_node_io_actions(Question, MaybeIoActions),
print_chosen_io_actions(MaybeIoActions, From, To, !.User, !IO),
- query_user(UserQuestion, Response, !User, !IO).
-
-handle_command(user_cmd_change_search(Mode), _,
- user_response_change_search(Mode), !User, !IO).
-
-handle_command(user_cmd_ask, UserQuestion, Response, !User, !IO) :-
- !:User = !.User ^ display_question := yes,
- query_user(UserQuestion, Response, !User, !IO).
-
-handle_command(user_cmd_pd, UserQuestion, Response, !User, !IO) :-
+ query_user(UserQuestion, Response, !User, !IO)
+ ;
+ Cmd = user_cmd_change_search(Mode),
+ Response = user_response_change_search(Mode)
+ ;
+ Cmd = user_cmd_ask,
+ !User ^ display_question := yes,
+ query_user(UserQuestion, Response, !User, !IO)
+ ;
+ Cmd = user_cmd_pd,
Question = get_decl_question(UserQuestion),
Node = get_decl_question_node(Question),
- Response = user_response_exit_diagnosis(Node).
-
-handle_command(user_cmd_quit, _, Response, !User, !IO) :-
- Response = user_response_abort_diagnosis.
-
-handle_command(user_cmd_help(MaybeCmd), UserQuestion, Response, !User, !IO) :-
+ Response = user_response_exit_diagnosis(Node)
+ ;
+ Cmd = user_cmd_quit,
+ Response = user_response_abort_diagnosis
+ ;
+ Cmd = user_cmd_help(MaybeCmd),
(
- MaybeCmd = yes(Cmd),
- Path = ["decl", Cmd]
+ MaybeCmd = yes(CmdName),
+ Path = ["decl", CmdName]
;
MaybeCmd = no,
Path = ["concepts", "decl_debug"]
@@ -408,9 +406,9 @@
Res = help_error(Message),
io.write_strings([Message, "\n"], !IO)
),
- query_user(UserQuestion, Response, !User, !IO).
-
-handle_command(user_cmd_empty, UserQuestion, Response, !User, !IO) :-
+ query_user(UserQuestion, Response, !User, !IO)
+ ;
+ Cmd = user_cmd_empty,
(
UserQuestion = plain_question(_),
Command = user_cmd_skip
@@ -427,11 +425,13 @@
Command = user_cmd_inadmissible
)
),
- handle_command(Command, UserQuestion, Response, !User, !IO).
-
-handle_command(user_cmd_illegal, UserQuestion, Response, !User, !IO) :-
- io.write_string(!.User ^ outstr, "Unknown command, 'h' for help.\n", !IO),
- query_user(UserQuestion, Response, !User, !IO).
+ handle_command(Command, UserQuestion, Response, !User, !IO)
+ ;
+ Cmd = user_cmd_illegal,
+ io.write_string(!.User ^ outstr, "Unknown command, 'h' for help.\n",
+ !IO),
+ query_user(UserQuestion, Response, !User, !IO)
+ ).
:- func arg_num_to_arg_pos(int) = arg_pos.
@@ -452,13 +452,16 @@
:- pred user_question_prompt(user_question(T)::in, string::out) is det.
-user_question_prompt(plain_question(Question), Prompt) :-
- decl_question_prompt(Question, Prompt).
-
-user_question_prompt(question_with_default(Question, DefaultTruth), Prompt) :-
+user_question_prompt(UserQuestion, Prompt) :-
+ (
+ UserQuestion = plain_question(Question),
+ decl_question_prompt(Question, Prompt)
+ ;
+ UserQuestion = question_with_default(Question, DefaultTruth),
decl_question_prompt(Question, QuestionPrompt),
default_prompt(DefaultTruth, DefaultPrompt),
- string.append(QuestionPrompt, DefaultPrompt, Prompt).
+ Prompt = QuestionPrompt ++ DefaultPrompt
+ ).
:- pred decl_question_prompt(decl_question(T)::in, string::out) is det.
@@ -473,9 +476,9 @@
default_prompt(truth_erroneous, "[no] ").
default_prompt(truth_inadmissible, "[inadmissible] ").
- % Find the initial and final atoms for a question. For all
- % questions besides wrong answer questions the initial and
- % final atoms will be the same.
+ % Find the initial and final atoms for a question. For all questions
+ % besides wrong answer questions, the initial and final atoms
+ % will be the same.
%
:- pred edt_node_trace_atoms(decl_question(T)::in, trace_atom::out,
trace_atom::out) is det.
@@ -611,7 +614,7 @@
;
MaybeTrackDirs = no_track
),
- !:User = !.User ^ browser := Browser.
+ !User ^ browser := Browser.
:- pred browse_decl_bug(decl_bug::in, maybe(int)::in, user_state::in,
user_state::out, io::di, io::uo) is cc_multi.
@@ -659,7 +662,7 @@
MaybeTrackDirs, !.User ^ browser, Browser, !IO),
convert_maybe_track_dirs_to_term_path_from_arg(ArgRep,
MaybeTrackDirs, MaybeTrack),
- !:User = !.User ^ browser := Browser
+ !User ^ browser := Browser
;
io.write_string(!.User ^ outstr, "Invalid argument number\n", !IO),
MaybeTrack = no_track
@@ -701,7 +704,7 @@
MaybeTrackDirs, !.User ^ browser, Browser, !IO),
convert_maybe_track_dirs_to_term_path_from_atom(FinalAtom,
MaybeTrackDirs, MaybeTrack),
- !:User = !.User ^ browser := Browser.
+ !User ^ browser := Browser.
:- pred browse_xml_atom(trace_atom::in, user_state::in, io::di, io::uo)
is cc_multi.
@@ -1139,25 +1142,30 @@
:- pred write_decl_question(decl_question(T)::in, user_state::in,
io::di, io::uo) is cc_multi.
-write_decl_question(wrong_answer(_, _, Atom), User, !IO) :-
- write_decl_final_atom(User, "", decl_caller_type, Atom, !IO).
-
-write_decl_question(missing_answer(_, Call, Solns), User, !IO) :-
+write_decl_question(Question, User, !IO) :-
+ (
+ Question = wrong_answer(_, _, Atom),
+ write_decl_final_atom(User, "", decl_caller_type, Atom, !IO)
+ ;
+ Question = missing_answer(_, Call, Solns),
write_decl_init_atom(User, "Call ", decl_caller_type, Call, !IO),
(
Solns = []
;
Solns = [_ | _],
io.write_string(User ^ outstr, "Solutions:\n", !IO),
- list.foldl(write_decl_final_atom(User, "\t", print_all), Solns, !IO)
- ).
-
-write_decl_question(unexpected_exception(_, Call, ExceptionRep), User, !IO) :-
+ list.foldl(write_decl_final_atom(User, "\t", print_all), Solns,
+ !IO)
+ )
+ ;
+ Question = unexpected_exception(_, Call, ExceptionRep),
write_decl_init_atom(User, "Call ", decl_caller_type, Call, !IO),
io.write_string(User ^ outstr, "Throws ", !IO),
term_rep.rep_to_univ(ExceptionRep, Exception),
- io.write(User ^ outstr, include_details_cc, univ_value(Exception), !IO),
- io.nl(User ^ outstr, !IO).
+ io.write(User ^ outstr, include_details_cc, univ_value(Exception),
+ !IO),
+ io.nl(User ^ outstr, !IO)
+ ).
:- pred write_decl_bug(decl_bug::in, user_state::in, io::di, io::uo)
is cc_multi.
@@ -1343,7 +1351,7 @@
get_browser_state(User) = User ^ browser.
set_browser_state(Browser, !User) :-
- !:User = !.User ^ browser := Browser.
+ !User ^ browser := Browser.
get_user_output_stream(User) = User ^ outstr.
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/add_class.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_class.m,v
retrieving revision 1.34
diff -u -b -r1.34 add_class.m
--- compiler/add_class.m 15 Dec 2010 06:29:26 -0000 1.34
+++ compiler/add_class.m 26 Feb 2011 03:34:44 -0000
@@ -456,7 +456,7 @@
module_info_get_instance_table(!.ModuleInfo, Instances0),
list.length(Types, ClassArity),
ClassId = class_id(ClassName, ClassArity),
- Body = expand_bang_state_var_args_in_instance_method_heads(Body0),
+ expand_bang_states_instance_body(Body0, Body),
( map.search(Classes, ClassId, _) ->
map.init(Empty),
NewInstanceDefn = hlds_instance_defn(InstanceModuleName, Status,
@@ -625,7 +625,7 @@
construct_pred_or_func_call(invalid_pred_id, PredOrFunc,
InstancePredName, HeadVars, GoalInfo, IntroducedGoal, !QualInfo),
IntroducedClause = clause(all_modes, IntroducedGoal, impl_lang_mercury,
- Context),
+ Context, []),
map.init(TVarNameMap),
map.from_corresponding_lists(HeadVars, ArgTypes, VarTypes),
@@ -665,7 +665,7 @@
TVarSet = TVarSet0,
report_illegal_func_svar_result(Context, CVarSet, StateVar, !Specs)
;
- HeadTerms = expand_bang_state_var_args(HeadTerms0),
+ expand_bang_states(HeadTerms0, HeadTerms),
PredArity = list.length(HeadTerms),
adjust_func_arity(PredOrFunc, Arity, PredArity),
Index: compiler/add_clause.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_clause.m,v
retrieving revision 1.63
diff -u -b -r1.63 add_clause.m
--- compiler/add_clause.m 31 Jan 2011 19:30:34 -0000 1.63
+++ compiler/add_clause.m 1 Mar 2011 08:45:37 -0000
@@ -13,7 +13,6 @@
:- import_module hlds.hlds_module.
:- import_module hlds.hlds_pred.
:- import_module hlds.make_hlds.qual_info.
-:- import_module hlds.make_hlds.state_var.
:- import_module hlds.quantification.
:- import_module mdbcomp.prim_data.
:- import_module parse_tree.error_util.
@@ -37,22 +36,6 @@
module_info::in, module_info::out, qual_info::in, qual_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
- % Convert goals from the prog_data `goal' structure into the HLDS
- % `hlds_goal' structure. At the same time,
- %
- % - convert it to super-homogeneous form by unravelling all the complex
- % unifications, and annotate those unifications with a unify_context
- % so that we can still give good error messages;
- % - apply the given substitution to the goal, to rename it apart
- % from the other clauses; and
- % - expand references to state variables.
- %
-:- pred transform_goal_expr_context_to_goal(goal::in, prog_var_renaming::in,
- hlds_goal::out, int::out, prog_varset::in, prog_varset::out,
- module_info::in, module_info::out, qual_info::in, qual_info::out,
- svar_info::in, svar_info::out,
- list(error_spec)::in, list(error_spec)::out) is det.
-
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -72,7 +55,9 @@
:- import_module hlds.make_hlds.add_pragma.
:- import_module hlds.make_hlds.add_pred.
:- import_module hlds.make_hlds.field_access.
+:- import_module hlds.make_hlds.goal_expr_to_goal.
:- import_module hlds.make_hlds.make_hlds_warn.
+:- import_module hlds.make_hlds.state_var.
:- import_module hlds.make_hlds.superhomogeneous.
:- import_module hlds.pred_table.
:- import_module libs.globals.
@@ -106,7 +91,7 @@
IllegalSVarResult = no
),
ArityAdjustment = ( if IllegalSVarResult = yes(_) then -1 else 0 ),
- Args = expand_bang_state_var_args(Args0),
+ expand_bang_states(Args0, Args),
% Lookup the pred declaration in the predicate table.
% (If it's not there, call maybe_undefined_pred_error and insert
@@ -155,14 +140,16 @@
map.lookup(Preds0, PredId, !:PredInfo),
trace [io(!IO)] (
+ some [Globals] (
module_info_get_globals(!.ModuleInfo, Globals),
globals.lookup_bool_option(Globals, very_verbose, VeryVerbose),
(
VeryVerbose = yes,
pred_info_get_clauses_info(!.PredInfo, MsgClauses),
- NumClauses = num_clauses_in_clauses_rep(MsgClauses ^ cli_rep),
- io.format("%% Processing clause %d for ", [i(NumClauses + 1)],
- !IO),
+ NumClauses = num_clauses_in_clauses_rep(
+ MsgClauses ^ cli_rep),
+ io.format("%% Processing clause %d for ",
+ [i(NumClauses + 1)], !IO),
write_pred_or_func(PredOrFunc, !IO),
io.write_string(" `", !IO),
list.length(Args, PredArity0),
@@ -173,6 +160,7 @@
;
VeryVerbose = no
)
+ )
),
% Opt_imported preds are initially tagged as imported, and are tagged
@@ -224,14 +212,25 @@
;
pred_info_is_builtin(!.PredInfo)
->
- % When bootstrapping a change that redefines a builtin as
- % normal Mercury code, you may need to disable this action.
+ % When bootstrapping a change that defines a builtin using
+ % normal Mercury code, we need to disable the generation
+ % of the error message, and just ignore the definition.
+ some [Globals] (
+ module_info_get_globals(!.ModuleInfo, Globals),
+ globals.lookup_bool_option(Globals, allow_defn_of_builtins,
+ AllowDefnOfBuiltin)
+ ),
+ (
+ AllowDefnOfBuiltin = no,
Msg = simple_msg(Context,
[always([words("Error: clause for builtin.")])]),
Spec = error_spec(severity_error, phase_parse_tree_to_hlds,
[Msg]),
!:Specs = [Spec | !.Specs]
;
+ AllowDefnOfBuiltin = yes
+ )
+ ;
pred_info_get_clauses_info(!.PredInfo, Clauses0),
pred_info_get_typevarset(!.PredInfo, TVarSet0),
maybe_add_default_func_mode(!PredInfo, _),
@@ -469,7 +468,7 @@
clauses_info_add_clause(ApplModeIds0, AllModeIds, CVarSet, TVarSet0,
Args, Body, Context, MaybeSeqNum, Status, PredOrFunc, Arity,
- GoalType, Goal, VarSet, TVarSet, !ClausesInfo, Warnings,
+ GoalType, Goal, VarSet, TVarSet, !ClausesInfo, QuantWarnings,
!ModuleInfo, !QualInfo, !Specs) :-
!.ClausesInfo = clauses_info(VarSet0, ExplicitVarTypes0,
TVarNameMap0, InferredVarTypes, HeadVars, ClausesRep0, ItemNumbers0,
@@ -492,8 +491,8 @@
!QualInfo),
varset.merge_renaming(VarSet0, CVarSet, VarSet1, Renaming),
add_clause_transform(Renaming, HeadVars, Args, Body, Context, PredOrFunc,
- Arity, GoalType, Goal0, VarSet1, VarSet, Warnings, !ModuleInfo,
- !QualInfo, !Specs),
+ Arity, GoalType, Goal0, VarSet1, VarSet,
+ QuantWarnings, StateVarWarnings, !ModuleInfo, !QualInfo, !Specs),
qual_info_get_tvarset(!.QualInfo, TVarSet),
qual_info_get_found_syntax_error(!.QualInfo, FoundError),
qual_info_set_found_syntax_error(no, !QualInfo),
@@ -515,8 +514,8 @@
get_clause_list_any_order(ClausesRep0, AnyOrderClauseList),
ForeignModeIds = list.condense(list.filter_map(
(func(C) = ProcIds is semidet :-
- C = clause(ApplProcIds, _, ClauseLang, _),
- ClauseLang = impl_lang_foreign(_),
+ C ^ clause_lang = impl_lang_foreign(_),
+ ApplProcIds = C ^ clause_applicable_procs,
(
ApplProcIds = all_modes,
unexpected($module, $pred, "all_modes foreign_proc")
@@ -539,12 +538,13 @@
ModeIds = [_ | _],
ApplicableModeIds = selected_modes(ModeIds),
Clause = clause(ApplicableModeIds, Goal, impl_lang_mercury,
- Context),
+ Context, StateVarWarnings),
add_clause(Clause, ClausesRep0, ClausesRep)
)
;
HasForeignClauses = no,
- Clause = clause(ApplModeIds0, Goal, impl_lang_mercury, Context),
+ Clause = clause(ApplModeIds0, Goal, impl_lang_mercury, Context,
+ StateVarWarnings),
add_clause(Clause, ClausesRep0, ClausesRep)
),
qual_info_get_var_types(!.QualInfo, ExplicitVarTypes),
@@ -555,30 +555,33 @@
RttiVarMaps, HasForeignClauses)
).
+ % Args0 has already had !S arguments replaced by a !.S, !:S argument pair.
+ %
:- pred add_clause_transform(prog_var_renaming::in,
proc_arg_vector(prog_var)::in, list(prog_term)::in, goal::in,
prog_context::in, pred_or_func::in, arity::in, goal_type::in,
hlds_goal::out, prog_varset::in, prog_varset::out,
- list(quant_warning)::out, module_info::in, module_info::out,
- qual_info::in, qual_info::out,
+ list(quant_warning)::out, list(error_spec)::out,
+ module_info::in, module_info::out, qual_info::in, qual_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
add_clause_transform(Renaming, HeadVars, Args0, ParseBody, Context, PredOrFunc,
- Arity, GoalType, Goal, !VarSet, Warnings, !ModuleInfo,
- !QualInfo, !Specs) :-
- some [!SInfo] (
+ Arity, GoalType, Goal, !VarSet, QuantWarnings, StateVarWarnings,
+ !ModuleInfo, !QualInfo, !Specs) :-
+ some [!SInfo, !SVarState, !SVarStore] (
HeadVarList = proc_arg_vector_to_list(HeadVars),
- svar_prepare_for_head(!:SInfo),
rename_vars_in_term_list(need_not_rename, Renaming, Args0, Args1),
- substitute_state_var_mappings(Args1, Args, !VarSet, !SInfo, !Specs),
- HeadGoal0 = true_goal,
+ svar_prepare_for_clause_head(Args1, Args, !VarSet, FinalSVarMap,
+ !:SVarState, !:SVarStore, !Specs),
+ InitialSVarState = !.SVarState,
( GoalType = goal_type_promise(_) ->
- HeadGoal = HeadGoal0
+ HeadGoal = true_goal
;
ArgContext = ac_head(PredOrFunc, Arity),
+ HeadGoal0 = true_goal,
insert_arg_unifications(HeadVarList, Args, Context, ArgContext,
- HeadGoal0, HeadGoal1, _, !VarSet, !ModuleInfo, !QualInfo,
- !SInfo, !Specs),
+ HeadGoal0, HeadGoal1, _, !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs),
% The only pass that pays attention to the from_head feature,
% switch_detection, only does so on kinds of hlds_goal_exprs
% that do not occur in from_ground_term scopes, which we have
@@ -594,13 +597,44 @@
attach_features_to_all_goals([feature_from_head],
do_not_attach_in_from_ground_term, HeadGoal1, HeadGoal)
),
- svar_prepare_for_body(FinalSVarMap, !VarSet, !SInfo),
- transform_goal_expr_context_to_goal(ParseBody, Renaming, BodyGoal, _,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
- svar_finish_goals(Context, FinalSVarMap, [HeadGoal, BodyGoal], Goal0,
- !.SInfo),
- qual_info_get_var_types(!.QualInfo, VarTypes0),
+ transform_goal_expr_context_to_goal(loc_whole_goal, ParseBody,
+ Renaming, BodyGoal, _, !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs),
+
+ trace [compiletime(flag("debug-statevar-lambda")), io(!IO)] (
+ io.write_string("\nCLAUSE HEAD\n", !IO),
+ io.write_string("args before:\n", !IO),
+ io.write_list(Args0, "\n", io.write, !IO),
+ io.nl(!IO),
+ io.write_string("args renamed:\n", !IO),
+ io.write_list(Args1, "\n", io.write, !IO),
+ io.nl(!IO),
+ io.write_string("args after:\n", !IO),
+ io.write_list(Args, "\n", io.write, !IO),
+ io.nl(!IO),
+ io.write_string("head vars:\n", !IO),
+ io.write(HeadVarList, !IO),
+ io.nl(!IO),
+ io.write_string("arg unifies:\n", !IO),
+ dump_goal(!.ModuleInfo, !.VarSet, HeadGoal, !IO),
+ io.nl(!IO),
+ io.write_string("clause body:\n", !IO),
+ dump_goal(!.ModuleInfo, !.VarSet, BodyGoal, !IO),
+ io.nl(!IO),
+ some [FinalSVarList] (
+ map.to_assoc_list(FinalSVarMap, FinalSVarList),
+ io.write_string("FinalSVarMap:\n", !IO),
+ io.write(FinalSVarList, !IO),
+ io.nl(!IO)
+ )
+ ),
+
+ FinalSVarState = !.SVarState,
+ svar_finish_clause_body(Context, FinalSVarMap,
+ [HeadGoal, BodyGoal], Goal0, InitialSVarState, FinalSVarState,
+ !.SVarStore, StateVarWarnings),
+ qual_info_get_var_types(!.QualInfo, VarTypes0),
% The RTTI varmaps here are just a dummy value, because the real ones
% are not introduced until polymorphism.
rtti_varmaps_init(EmptyRttiVarmaps),
@@ -608,1145 +642,9 @@
% are not yet recognized as such inside from_ground_term scopes.
implicitly_quantify_clause_body_general(
ordinary_nonlocals_maybe_lambda,
- HeadVarList, Warnings, Goal0, Goal,
+ HeadVarList, QuantWarnings, Goal0, Goal,
!VarSet, VarTypes0, VarTypes, EmptyRttiVarmaps, _),
qual_info_set_var_types(VarTypes, !QualInfo)
).
%-----------------------------------------------------------------------------%
-
-transform_goal_expr_context_to_goal(Goal0 - Context, Renaming, Goal,
- NumAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs) :-
- transform_goal_expr_to_goal(Goal0, Context, Renaming, Goal1,
- NumAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
- Goal1 = hlds_goal(GoalExpr, GoalInfo1),
- goal_info_set_context(Context, GoalInfo1, GoalInfo),
- Goal = hlds_goal(GoalExpr, GoalInfo).
-
-:- pred transform_goal_expr_to_goal(goal_expr::in, prog_context::in,
- prog_var_renaming::in, hlds_goal::out, num_added_goals::out,
- prog_varset::in, prog_varset::out,
- module_info::in, module_info::out, qual_info::in, qual_info::out,
- svar_info::in, svar_info::out,
- list(error_spec)::in, list(error_spec)::out) is det.
-
-transform_goal_expr_to_goal(Expr, Context, Renaming, Goal, !:NumAdded,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs) :-
- (
- (
- Expr = fail_expr,
- GoalExpr = disj([])
- ;
- Expr = true_expr,
- GoalExpr = conj(plain_conj, [])
- ),
- !:NumAdded = 0,
- goal_info_init(GoalInfo),
- Goal = hlds_goal(GoalExpr, GoalInfo),
- svar_prepare_for_next_conjunct(set.init, !VarSet, !SInfo)
- ;
- % Convert `all [Vars] Goal' into `not some [Vars] not Goal'.
- (
- Expr = all_expr(Vars0, Goal0),
- TransformedExpr = not_expr(some_expr(Vars0,
- not_expr(Goal0) - Context) - Context)
- ;
- Expr = all_state_vars_expr(StateVars, Goal0),
- TransformedExpr = not_expr(some_state_vars_expr(StateVars,
- not_expr(Goal0) - Context) - Context)
- ),
- transform_goal_expr_to_goal(TransformedExpr, Context, Renaming,
- Goal, !:NumAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs)
- ;
- Expr = some_expr(Vars0, SubExpr),
- rename_var_list(need_not_rename, Renaming, Vars0, Vars),
- transform_goal_expr_context_to_goal(SubExpr, Renaming, SubGoal,
- !:NumAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
- GoalExpr = scope(exist_quant(Vars), SubGoal),
- goal_info_init(GoalInfo),
- Goal = hlds_goal(GoalExpr, GoalInfo)
- ;
- Expr = some_state_vars_expr(StateVars0, SubExpr0),
- BeforeSInfo = !.SInfo,
- rename_var_list(need_not_rename, Renaming, StateVars0, StateVars),
- prepare_for_local_state_vars(StateVars, !VarSet, !SInfo),
- transform_goal_expr_context_to_goal(SubExpr0, Renaming, SubGoal,
- !:NumAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
- finish_local_state_vars(StateVars, Vars, BeforeSInfo, !SInfo),
- GoalExpr = scope(exist_quant(Vars), SubGoal),
- goal_info_init(GoalInfo),
- Goal = hlds_goal(GoalExpr, GoalInfo)
- ;
- Expr = promise_purity_expr(Purity, SubExpr0),
- transform_goal_expr_context_to_goal(SubExpr0, Renaming, SubGoal,
- !:NumAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
- GoalExpr = scope(promise_purity(Purity), SubGoal),
- goal_info_init(GoalInfo),
- Goal = hlds_goal(GoalExpr, GoalInfo)
- ;
- Expr = promise_equivalent_solutions_expr(Vars0, DotSVars0, ColonSVars0,
- SubExpr0),
- transform_promise_eqv_goal(Vars0, DotSVars0, ColonSVars0,
- Context, Renaming, Vars, SubExpr0, SubGoal, GoalInfo, !:NumAdded,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
- GoalExpr = scope(promise_solutions(Vars, equivalent_solutions),
- SubGoal),
- Goal = hlds_goal(GoalExpr, GoalInfo)
- ;
- Expr = promise_equivalent_solution_sets_expr(Vars0,
- DotSVars0, ColonSVars0, SubExpr0),
- transform_promise_eqv_goal(Vars0, DotSVars0, ColonSVars0,
- Context, Renaming, Vars, SubExpr0, SubGoal, GoalInfo, !:NumAdded,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
- GoalExpr = scope(promise_solutions(Vars, equivalent_solution_sets),
- SubGoal),
- Goal = hlds_goal(GoalExpr, GoalInfo)
- ;
- Expr = require_detism_expr(Detism, SubExpr),
- transform_goal_expr_context_to_goal(SubExpr, Renaming, SubGoal,
- !:NumAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
- GoalExpr = scope(require_detism(Detism), SubGoal),
- goal_info_init(GoalInfo),
- Goal = hlds_goal(GoalExpr, GoalInfo)
- ;
- Expr = require_complete_switch_expr(Var0, SubExpr),
- rename_var(need_not_rename, Renaming, Var0, Var),
- transform_goal_expr_context_to_goal(SubExpr, Renaming, SubGoal,
- !:NumAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
- GoalExpr = scope(require_complete_switch(Var), SubGoal),
- goal_info_init(GoalInfo),
- Goal = hlds_goal(GoalExpr, GoalInfo)
- ;
- Expr = promise_equivalent_solution_arbitrary_expr(Vars0,
- DotSVars0, ColonSVars0, SubExpr0),
- transform_promise_eqv_goal(Vars0, DotSVars0, ColonSVars0,
- Context, Renaming, Vars, SubExpr0, SubGoal, GoalInfo, !:NumAdded,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
- GoalExpr = scope(promise_solutions(Vars,
- equivalent_solution_sets_arbitrary), SubGoal),
- Goal = hlds_goal(GoalExpr, GoalInfo)
- ;
- Expr = atomic_expr(Outer0, Inner0, MaybeOutputVars0,
- MainExpr, OrElseExprs),
- (
- Outer0 = atomic_state_var(OuterStateVar0),
- rename_var(need_not_rename, Renaming,
- OuterStateVar0, OuterStateVar),
- svar_start_outer_atomic_scope(Context, OuterStateVar,
- OuterDI, OuterUO, OuterScopeInfo, !VarSet, !SInfo, !Specs),
- MaybeOuterScopeInfo = yes(OuterScopeInfo),
- Outer = atomic_interface_vars(OuterDI, OuterUO)
- ;
- Outer0 = atomic_var_pair(OuterDI0, OuterUO0),
- rename_var(need_not_rename, Renaming, OuterDI0, OuterDI),
- rename_var(need_not_rename, Renaming, OuterUO0, OuterUO),
- Outer = atomic_interface_vars(OuterDI, OuterUO),
- MaybeOuterScopeInfo = no
- ),
- (
- Inner0 = atomic_state_var(InnerStateVar0),
- rename_var(need_not_rename, Renaming,
- InnerStateVar0, InnerStateVar),
- svar_start_inner_atomic_scope(Context, InnerStateVar,
- InnerScopeInfo, !VarSet, !SInfo, !Specs),
- MaybeInnerScopeInfo = yes(InnerScopeInfo)
- ;
- Inner0 = atomic_var_pair(_InnerDI0, _InnerUO0),
- MaybeInnerScopeInfo = no
- ),
- BeforeDisjSInfo = !.SInfo,
- transform_goal_expr_context_to_goal(MainExpr, Renaming, HLDSMainGoal0,
- !:NumAdded, !VarSet, !ModuleInfo, !QualInfo,
- BeforeDisjSInfo, SInfo1, !Specs),
- MainDisjInfo = hlds_goal_svar_info(HLDSMainGoal0, SInfo1),
- transform_orelse_goals(OrElseExprs, Renaming, OrElseDisjInfos,
- 0, OrElseNumAdded, !VarSet, !ModuleInfo, !QualInfo,
- BeforeDisjSInfo, !Specs),
- AllDisjInfos = [MainDisjInfo | OrElseDisjInfos],
- svar_finish_disjunction(Context, !.VarSet, AllDisjInfos, HLDSGoals,
- !:SInfo),
- (
- HLDSGoals = [HLDSMainGoal | HLDSOrElseGoals]
- ;
- HLDSGoals = [],
- unexpected($module, $pred, "atomic HLDSGoals = []")
- ),
- (
- Inner0 = atomic_state_var(_),
- (
- MaybeInnerScopeInfo = yes(InnerScopeInfo2),
- svar_finish_inner_atomic_scope(Context, InnerScopeInfo2,
- InnerDI, InnerUO, !VarSet, !SInfo, !Specs),
- Inner = atomic_interface_vars(InnerDI, InnerUO)
- ;
- MaybeInnerScopeInfo = no,
- unexpected($module, $pred, "MaybeFinishStateVar = no")
- )
- ;
- Inner0 = atomic_var_pair(InnerDI0, InnerUO0),
- rename_var(need_not_rename, Renaming, InnerDI0, InnerDI),
- rename_var(need_not_rename, Renaming, InnerUO0, InnerUO),
- Inner = atomic_interface_vars(InnerDI, InnerUO)
- ),
- (
- MaybeOutputVars0 = no,
- MaybeOutputVars = no
- ;
- MaybeOutputVars0 = yes(OutputVars0),
- rename_var_list(need_not_rename, Renaming,
- OutputVars0, OutputVars),
- MaybeOutputVars = yes(OutputVars)
- ),
- (
- MaybeOuterScopeInfo = yes(OuterScopeInfo2),
- svar_finish_outer_atomic_scope(OuterScopeInfo2, !SInfo)
- ;
- MaybeOuterScopeInfo = no
- ),
- !:NumAdded = !.NumAdded + 1 + OrElseNumAdded,
- ShortHand = atomic_goal(unknown_atomic_goal_type, Outer, Inner,
- MaybeOutputVars, HLDSMainGoal, HLDSOrElseGoals, []),
- GoalExpr = shorthand(ShortHand),
- goal_info_init(Context, GoalInfo),
- Goal = hlds_goal(GoalExpr, GoalInfo),
- trace [compiletime(flag("atomic_scope_syntax")), io(!IO)] (
- io.write_string("atomic:\n", !IO),
- module_info_get_globals(!.ModuleInfo, Globals),
- OutInfo = init_hlds_out_info(Globals),
- write_goal(OutInfo, Goal, !.ModuleInfo, !.VarSet, yes, 0, "\n",
- !IO),
- io.nl(!IO)
- )
- ;
- Expr = trace_expr(MaybeCompileTime, MaybeRunTime, MaybeIO,
- Mutables, SubExpr0),
- list.map4(extract_trace_mutable_var(Context, !.VarSet), Mutables,
- MutableHLDSs, MutableStateVars, MutableGetExprs, MutableSetExprs),
- (
- MaybeIO = yes(IOStateVar),
- varset.lookup_name(!.VarSet, IOStateVar, IOStateVarName),
- MaybeIOHLDS = yes(IOStateVarName),
- extract_trace_io_var(Context, IOStateVar, IOGetExpr, IOSetExpr),
- StateVars0 = [IOStateVar | MutableStateVars],
- GetExprs = [IOGetExpr | MutableGetExprs],
- SetExprs = [IOSetExpr | MutableSetExprs]
- ;
- MaybeIO = no,
- MaybeIOHLDS = no,
- StateVars0 = MutableStateVars,
- GetExprs = MutableGetExprs,
- SetExprs = MutableSetExprs
- ),
- SubExpr1 =
- goal_list_to_conj(Context, GetExprs ++ [SubExpr0] ++ SetExprs),
- BeforeSInfo = !.SInfo,
- rename_var_list(need_not_rename, Renaming, StateVars0, StateVars),
- prepare_for_local_state_vars(StateVars, !VarSet, !SInfo),
- transform_goal_expr_context_to_goal(SubExpr1, Renaming, SubGoal,
- !:NumAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
- !:NumAdded =
- list.length(GetExprs) + !.NumAdded + list.length(SetExprs),
- finish_local_state_vars(StateVars, Vars, BeforeSInfo, !SInfo),
- Reason = trace_goal(MaybeCompileTime, MaybeRunTime, MaybeIOHLDS,
- MutableHLDSs, Vars),
- GoalExpr = scope(Reason, SubGoal),
- goal_info_init(GoalInfo),
- Goal = hlds_goal(GoalExpr, GoalInfo)
- ;
- Expr = try_expr(MaybeIO0, SubExpr0, Then0, MaybeElse0,
- Catches0, MaybeCatchAny0),
- (
- MaybeIO0 = yes(IOStateVar0),
- (
- MaybeElse0 = no,
- rename_var(need_not_rename, Renaming, IOStateVar0, IOStateVar),
- transform_try_expr_with_io(IOStateVar0, IOStateVar, SubExpr0,
- Then0, Catches0, MaybeCatchAny0, Context, Renaming, Goal,
- !:NumAdded, !VarSet, !ModuleInfo, !QualInfo,
- !SInfo, !Specs)
- ;
- MaybeElse0 = yes(_),
- Pieces = [words("Error: a `try' goal with an `io' parameter"),
- words("cannot have an else part."), nl],
- Msg = simple_msg(Context, [always(Pieces)]),
- Spec = error_spec(severity_error,
- phase_parse_tree_to_hlds, [Msg]),
- !:Specs = [Spec | !.Specs],
- Goal = true_goal,
- !:NumAdded = 0
- )
- ;
- MaybeIO0 = no,
- transform_try_expr_without_io(SubExpr0, Then0, MaybeElse0,
- Catches0, MaybeCatchAny0, Context, Renaming, Goal, !:NumAdded,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs)
- )
- ;
- Expr = if_then_else_expr(Vars0, StateVars0, Cond0, Then0, Else0),
- BeforeSInfo = !.SInfo,
- rename_var_list(need_not_rename, Renaming, Vars0, Vars),
- rename_var_list(need_not_rename, Renaming, StateVars0, StateVars),
- svar_prepare_for_if_then_else_goal(StateVars, !VarSet, !SInfo),
- transform_goal_expr_context_to_goal(Cond0, Renaming, Cond, CondAdded,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
- svar_finish_if_then_else_goal_condition(StateVars,
- BeforeSInfo, !.SInfo, AfterCondSInfo, !:SInfo),
- transform_goal_expr_context_to_goal(Then0, Renaming, Then1, ThenAdded,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
- svar_finish_if_then_else_goal_then_goal(StateVars, BeforeSInfo,
- !SInfo),
- AfterThenSInfo = !.SInfo,
- transform_goal_expr_context_to_goal(Else0, Renaming, Else1, ElseAdded,
- !VarSet, !ModuleInfo, !QualInfo, BeforeSInfo, !:SInfo, !Specs),
- !:NumAdded = CondAdded + ThenAdded + ElseAdded,
- goal_info_init(Context, GoalInfo),
- svar_finish_if_then_else(Context, Then1, Then, Else1, Else,
- BeforeSInfo, AfterCondSInfo, AfterThenSInfo, !SInfo, !VarSet),
- GoalExpr = if_then_else(Vars, Cond, Then, Else),
- Goal = hlds_goal(GoalExpr, GoalInfo)
- ;
- Expr = not_expr(SubExpr0),
- BeforeSInfo = !.SInfo,
- transform_goal_expr_context_to_goal(SubExpr0, Renaming, SubGoal,
- !:NumAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
- svar_finish_negation(BeforeSInfo, !SInfo),
- GoalExpr = negation(SubGoal),
- goal_info_init(GoalInfo),
- Goal = hlds_goal(GoalExpr, GoalInfo)
- ;
- Expr = conj_expr(A0, B0),
- get_rev_conj(A0, Renaming, [], R0, 0, !:NumAdded,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
- get_rev_conj(B0, Renaming, R0, R, !NumAdded,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
- L = list.reverse(R),
- goal_info_init(GoalInfo),
- conj_list_to_goal(L, GoalInfo, Goal)
- ;
- Expr = par_conj_expr(A0, B0),
- get_rev_par_conj(A0, Renaming, [], R0, 0, !:NumAdded,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
- get_rev_par_conj(B0, Renaming, R0, R, !NumAdded,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
- L = list.reverse(R),
- goal_info_init(GoalInfo),
- par_conj_list_to_goal(L, GoalInfo, Goal)
- ;
- Expr = disj_expr(A0, B0),
- get_disj(B0, Renaming, [], L0, 0, !:NumAdded,
- !VarSet, !ModuleInfo, !QualInfo, !.SInfo, !Specs),
- get_disj(A0, Renaming, L0, L1, !NumAdded,
- !VarSet, !ModuleInfo, !QualInfo, !.SInfo, !Specs),
- svar_finish_disjunction(Context, !.VarSet, L1, L, !:SInfo),
- goal_info_init(Context, GoalInfo),
- disj_list_to_goal(L, GoalInfo, Goal)
- ;
- Expr = implies_expr(P, Q),
- % `P => Q' is defined as `not (P, not Q)'
- TransformedExpr = not_expr(conj_expr(P, not_expr(Q) - Context)
- - Context),
- transform_goal_expr_to_goal(TransformedExpr, Context, Renaming,
- Goal, !:NumAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs)
- ;
- Expr = equivalent_expr(P0, Q0),
- % `P <=> Q' is defined as `(P => Q), (Q => P)',
- % but that transformation must not be done until after quantification,
- % lest the duplication of the goals concerned affect the implicit
- % quantification of the variables inside them.
-
- BeforeSInfo = !.SInfo,
- transform_goal_expr_context_to_goal(P0, Renaming, P, NumAddedP,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
- transform_goal_expr_context_to_goal(Q0, Renaming, Q, NumAddedQ,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
- svar_finish_equivalence(BeforeSInfo, !SInfo),
- !:NumAdded = NumAddedP + NumAddedQ,
- GoalExpr = shorthand(bi_implication(P, Q)),
- goal_info_init(GoalInfo),
- Goal = hlds_goal(GoalExpr, GoalInfo)
- ;
- Expr = event_expr(EventName, Args0),
- Args1 = expand_bang_state_var_args(Args0),
- svar_prepare_for_call(!SInfo),
- rename_vars_in_term_list(need_not_rename, Renaming, Args1, Args),
- make_fresh_arg_vars(Args, HeadVars, !VarSet, !SInfo, !Specs),
- list.length(HeadVars, Arity),
- list.duplicate(Arity, in_mode, Modes),
- goal_info_init(Context, GoalInfo),
- Details = event_call(EventName),
- GoalExpr0 = generic_call(Details, HeadVars, Modes, detism_det),
- Goal0 = hlds_goal(GoalExpr0, GoalInfo),
- CallId = generic_call_id(gcid_event_call(EventName)),
- insert_arg_unifications(HeadVars, Args, Context, ac_call(CallId),
- Goal0, Goal, !:NumAdded, !VarSet, !ModuleInfo, !QualInfo,
- !SInfo, !Specs),
- svar_finish_call(!VarSet, !SInfo)
- ;
- Expr = call_expr(Name, Args0, Purity),
- Args1 = expand_bang_state_var_args(Args0),
- (
- Name = unqualified("\\="),
- Args1 = [LHS, RHS]
- ->
- svar_prepare_for_call(!SInfo),
- % `LHS \= RHS' is defined as `not (LHS = RHS)'
- TransformedExpr = not_expr(unify_expr(LHS, RHS, Purity) - Context),
- transform_goal_expr_to_goal(TransformedExpr, Context, Renaming,
- Goal, !:NumAdded, !VarSet, !ModuleInfo,
- !QualInfo, !SInfo, !Specs),
- svar_finish_call(!VarSet, !SInfo)
- ;
- % check for a state var record assignment:
- % !Var ^ field := Value
- Name = unqualified(":="),
- Args1 = [LHS0, RHS0],
- LHS0 = functor(atom("^"), [StateVar0, Remainder],
- FieldListContext),
- StateVar0 = functor(atom("!"), Args @ [variable(_, _)],
- StateVarContext)
- ->
- svar_prepare_for_call(!SInfo),
- % !Var ^ field := Value is defined as
- % !:Var = !.Var ^ field := Value.
- LHS = functor(atom("!:"), Args, StateVarContext),
- StateVar = functor(atom("!."), Args, StateVarContext),
- FieldList = functor(atom("^"), [StateVar, Remainder],
- FieldListContext),
- RHS = functor(atom(":="), [FieldList, RHS0], Context),
- TransformedExpr = unify_expr(LHS, RHS, Purity),
- transform_goal_expr_to_goal(TransformedExpr, Context, Renaming,
- Goal, !:NumAdded, !VarSet, !ModuleInfo,
- !QualInfo, !SInfo, !Specs),
- svar_finish_call(!VarSet, !SInfo)
- ;
- % check for a DCG field access goal:
- % get: Field =^ field
- % set: ^ field := Field
- ( Name = unqualified(Operator) ),
- ( Operator = "=^"
- ; Operator = ":="
- )
- ->
- svar_prepare_for_call(!SInfo),
- rename_vars_in_term_list(need_not_rename, Renaming, Args1, Args2),
- transform_dcg_record_syntax(Operator, Args2, Context, Goal,
- !:NumAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
- svar_finish_call(!VarSet, !SInfo)
- ;
- svar_prepare_for_call(!SInfo),
- rename_vars_in_term_list(need_not_rename, Renaming, Args1, Args),
- make_fresh_arg_vars(Args, HeadVars, !VarSet, !SInfo, !Specs),
- list.length(Args, Arity),
- (
- % Check for a higher-order call,
- % i.e. a call to either call/N or ''/N.
- ( Name = unqualified("call")
- ; Name = unqualified("")
- ),
- HeadVars = [PredVar | RealHeadVars]
- ->
- % Initialize some fields to junk.
- Modes = [],
- Det = detism_erroneous,
-
- GenericCall = higher_order(PredVar, Purity, pf_predicate,
- Arity),
- Call = generic_call(GenericCall, RealHeadVars, Modes, Det),
-
- hlds_goal.generic_call_id(GenericCall, CallId)
- ;
- % Initialize some fields to junk.
- PredId = invalid_pred_id,
- ModeId = invalid_proc_id,
-
- MaybeUnifyContext = no,
- Call = plain_call(PredId, ModeId, HeadVars, not_builtin,
- MaybeUnifyContext, Name),
- CallId =
- plain_call_id(simple_call_id(pf_predicate, Name, Arity))
- ),
- goal_info_init(Context, GoalInfo0),
- goal_info_set_purity(Purity, GoalInfo0, GoalInfo),
- Goal0 = hlds_goal(Call, GoalInfo),
-
- record_called_pred_or_func(pf_predicate, Name, Arity, !QualInfo),
- insert_arg_unifications(HeadVars, Args, Context, ac_call(CallId),
- Goal0, Goal, !:NumAdded, !VarSet, !ModuleInfo, !QualInfo,
- !SInfo, !Specs),
- svar_finish_call(!VarSet, !SInfo)
- )
- ;
- Expr = unify_expr(A0, B0, Purity),
- rename_vars_in_term(need_not_rename, Renaming, A0, A),
- rename_vars_in_term(need_not_rename, Renaming, B0, B),
- % It is an error for the left or right hand side of a
- % unification to be !X (it may be !.X or !:X, however).
- ( A = functor(atom("!"), [variable(StateVarA, _)], _) ->
- report_svar_unify_error(Context, !.VarSet, StateVarA, !Specs),
- Goal = true_goal,
- !:NumAdded = 0
- ; B = functor(atom("!"), [variable(StateVarB, _)], _) ->
- report_svar_unify_error(Context, !.VarSet, StateVarB, !Specs),
- Goal = true_goal,
- !:NumAdded = 0
- ;
- svar_prepare_for_call(!SInfo),
- unravel_unification(A, B, Context, umc_explicit, [], Purity, Goal,
- !:NumAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
- svar_finish_call(!VarSet, !SInfo)
- )
- ).
-
-:- pred extract_trace_mutable_var(prog_context::in, prog_varset::in,
- trace_mutable_var::in, trace_mutable_var_hlds::out,
- prog_var::out, goal::out, goal::out) is det.
-
-extract_trace_mutable_var(Context, VarSet, Mutable, MutableHLDS, StateVar,
- GetGoal, SetGoal) :-
- Mutable = trace_mutable_var(MutableName, StateVar),
- varset.lookup_name(VarSet, StateVar, StateVarName),
- MutableHLDS = trace_mutable_var_hlds(MutableName, StateVarName),
- GetPredName = unqualified("get_" ++ MutableName),
- SetPredName = unqualified("set_" ++ MutableName),
- SetVar = functor(atom("!:"), [variable(StateVar, Context)], Context),
- UseVar = functor(atom("!."), [variable(StateVar, Context)], Context),
- GetPurity = purity_semipure,
- SetPurity = purity_impure,
- GetGoal = call_expr(GetPredName, [SetVar], GetPurity) - Context,
- SetGoal = call_expr(SetPredName, [UseVar], SetPurity) - Context.
-
-:- pred extract_trace_io_var(prog_context::in, prog_var::in,
- goal::out, goal::out) is det.
-
-extract_trace_io_var(Context, StateVar, GetGoal, SetGoal) :-
- Builtin = mercury_private_builtin_module,
- GetPredName = qualified(Builtin, "trace_get_io_state"),
- SetPredName = qualified(Builtin, "trace_set_io_state"),
- SetVar = functor(atom("!:"), [variable(StateVar, Context)], Context),
- UseVar = functor(atom("!."), [variable(StateVar, Context)], Context),
- GetPurity = purity_semipure,
- SetPurity = purity_impure,
- GetGoal = call_expr(GetPredName, [SetVar], GetPurity) - Context,
- SetGoal = call_expr(SetPredName, [UseVar], SetPurity) - Context.
-
-:- pred transform_promise_eqv_goal(prog_vars::in, prog_vars::in, prog_vars::in,
- prog_context::in, prog_var_renaming::in, prog_vars::out,
- goal::in, hlds_goal::out, hlds_goal_info::out, int::out,
- prog_varset::in, prog_varset::out, module_info::in, module_info::out,
- qual_info::in, qual_info::out, svar_info::in, svar_info::out,
- list(error_spec)::in, list(error_spec)::out) is det.
-
-transform_promise_eqv_goal(Vars0, DotSVars0, ColonSVars0, Context, Renaming,
- Vars, Goal0, Goal, GoalInfo, NumAdded, !VarSet, !ModuleInfo, !QualInfo,
- !SInfo, !Specs) :-
- rename_var_list(need_not_rename, Renaming, Vars0, Vars1),
- rename_var_list(need_not_rename, Renaming, DotSVars0, DotSVars1),
- convert_dot_state_vars(Context, DotSVars1, DotSVars, !VarSet,
- !SInfo, !Specs),
- transform_goal_expr_context_to_goal(Goal0, Renaming, Goal, NumAdded,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
- goal_info_init(GoalInfo),
- rename_var_list(need_not_rename, Renaming, ColonSVars0, ColonSVars1),
- convert_dot_state_vars(Context, ColonSVars1, ColonSVars, !VarSet,
- !SInfo, !Specs),
- Vars = Vars1 ++ DotSVars ++ ColonSVars.
-
-:- pred convert_dot_state_vars(prog_context::in, prog_vars::in, prog_vars::out,
- prog_varset::in, prog_varset::out, svar_info::in, svar_info::out,
- list(error_spec)::in, list(error_spec)::out) is det.
-
-convert_dot_state_vars(_Context, [], [], !VarSet, !SInfo, !Specs).
-convert_dot_state_vars(Context, [Dot0 | Dots0], [Dot | Dots],
- !VarSet, !SInfo, !Specs) :-
- svar_dot(Context, Dot0, Dot, !VarSet, !SInfo, !Specs),
- convert_dot_state_vars(Context, Dots0, Dots, !VarSet, !SInfo, !Specs).
-
-:- pred convert_colon_state_vars(prog_context::in,
- prog_vars::in, prog_vars::out, prog_varset::in, prog_varset::out,
- svar_info::in, svar_info::out,
- list(error_spec)::in, list(error_spec)::out) is det.
-
-convert_colon_state_vars(_Context, [], [], !VarSet, !SInfo, !Specs).
-convert_colon_state_vars(Context, [Colon0 | Colons0], [Colon | Colons],
- !VarSet, !SInfo, !Specs) :-
- svar_colon(Context, Colon0, Colon, !VarSet, !SInfo, !Specs),
- convert_colon_state_vars(Context, Colons0, Colons, !VarSet,
- !SInfo, !Specs).
-
-:- pred report_svar_unify_error(prog_context::in, prog_varset::in, svar::in,
- list(error_spec)::in, list(error_spec)::out) is det.
-
-report_svar_unify_error(Context, VarSet, StateVar, !Specs) :-
- Name = varset.lookup_name(VarSet, StateVar),
- Pieces = [words("Error:"), fixed("!" ++ Name),
- words("cannot appear as a unification argument."), nl,
- words("You probably meant"), fixed("!." ++ Name),
- words("or"), fixed("!:" ++ Name), suffix(".")],
- Msg = simple_msg(Context, [always(Pieces)]),
- Spec = error_spec(severity_error, phase_parse_tree_to_hlds, [Msg]),
- !:Specs = [Spec | !.Specs].
-
-:- inst dcg_record_syntax_op == bound("=^"; ":=").
-
-:- pred transform_dcg_record_syntax(string::in(dcg_record_syntax_op),
- list(prog_term)::in, prog_context::in, hlds_goal::out, int::out,
- prog_varset::in, prog_varset::out,
- module_info::in, module_info::out, qual_info::in, qual_info::out,
- svar_info::in, svar_info::out,
- list(error_spec)::in, list(error_spec)::out) is det.
-
-transform_dcg_record_syntax(Operator, ArgTerms0, Context, Goal, NumAdded,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs) :-
- goal_info_init(Context, GoalInfo),
- (
- ArgTerms0 = [LHSTerm, RHSTerm, TermInputTerm, TermOutputTerm],
- (
- Operator = "=^",
- AccessType = get,
- FieldNameTerm = RHSTerm,
- FieldValueTerm = LHSTerm
- ;
- Operator = ":=",
- AccessType = set,
- LHSTerm = term.functor(term.atom("^"), [FieldNameTerm0], _),
- FieldNameTerm = FieldNameTerm0,
- FieldValueTerm = RHSTerm
- )
- ->
- ContextPieces = dcg_field_error_context_pieces(AccessType),
- parse_field_list(FieldNameTerm, !.VarSet, ContextPieces,
- MaybeFieldNames),
- (
- MaybeFieldNames = ok1(FieldNames),
- ArgTerms = [FieldValueTerm, TermInputTerm, TermOutputTerm],
- transform_dcg_record_syntax_2(AccessType, FieldNames, ArgTerms,
- Context, Goal, NumAdded, !VarSet, !ModuleInfo, !QualInfo,
- !SInfo, !Specs)
- ;
- MaybeFieldNames = error1(FieldNamesSpecs),
- !:Specs = FieldNamesSpecs ++ !.Specs,
- invalid_goal("^", ArgTerms0, GoalInfo, Goal, !VarSet,
- !SInfo, !Specs),
- NumAdded = 0,
- qual_info_set_found_syntax_error(yes, !QualInfo)
- )
- ;
- invalid_goal("^", ArgTerms0, GoalInfo, Goal, !VarSet, !SInfo, !Specs),
- NumAdded = 0,
- qual_info_set_found_syntax_error(yes, !QualInfo),
- Pieces = [words("Error: expected `Field =^ field1 ^ ... ^ fieldN'"),
- words("or `^ field1 ^ ... ^ fieldN := Field'"),
- words("in DCG field access goal."), nl],
- Msg = simple_msg(Context, [always(Pieces)]),
- Spec = error_spec(severity_error, phase_parse_tree_to_hlds, [Msg]),
- !:Specs = [Spec | !.Specs]
- ).
-
-:- func dcg_field_error_context_pieces(field_access_type) =
- list(format_component).
-
-dcg_field_error_context_pieces(AccessType) = ContextPieces :-
- (
- AccessType = set,
- ContextPieces = [words("In DCG field update goal:"), nl]
- ;
- AccessType = get,
- ContextPieces = [words("In DCG field extraction goal:"), nl]
- ).
-
- % Produce an invalid goal.
- %
-:- pred invalid_goal(string::in, list(prog_term)::in, hlds_goal_info::in,
- hlds_goal::out, prog_varset::in, prog_varset::out,
- svar_info::in, svar_info::out,
- list(error_spec)::in, list(error_spec)::out) is det.
-
-invalid_goal(UpdateStr, Args0, GoalInfo, Goal, !VarSet, !SInfo, !Specs) :-
- make_fresh_arg_vars(Args0, HeadVars, !VarSet, !SInfo, !Specs),
- MaybeUnifyContext = no,
- GoalExpr = plain_call(invalid_pred_id, invalid_proc_id, HeadVars,
- not_builtin, MaybeUnifyContext, unqualified(UpdateStr)),
- Goal = hlds_goal(GoalExpr, GoalInfo).
-
-:- pred transform_dcg_record_syntax_2(field_access_type::in, field_list::in,
- list(prog_term)::in, prog_context::in, hlds_goal::out,
- num_added_goals::out, prog_varset::in, prog_varset::out,
- module_info::in, module_info::out, qual_info::in, qual_info::out,
- svar_info::in, svar_info::out,
- list(error_spec)::in, list(error_spec)::out) is det.
-
-transform_dcg_record_syntax_2(AccessType, FieldNames, ArgTerms, Context, Goal,
- NumAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs) :-
- make_fresh_arg_vars(ArgTerms, ArgVars, !VarSet, !SInfo, !Specs),
- ( ArgVars = [FieldValueVar, TermInputVar, TermOutputVar] ->
- (
- AccessType = set,
- expand_set_field_function_call(Context, umc_explicit, [],
- FieldNames, FieldValueVar, TermInputVar, TermOutputVar,
- Functor, InnermostFunctor - InnermostSubContext, Goal0,
- SetAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
-
- FieldArgNumber = 2,
- FieldArgContext = ac_functor(InnermostFunctor, umc_explicit,
- InnermostSubContext),
- InputTermArgNumber = 1,
- InputTermArgContext = ac_functor(Functor, umc_explicit, []),
- ( Functor = cons(FuncNamePrime, FuncArityPrime, _TypeCtor) ->
- FuncName = FuncNamePrime,
- FuncArity = FuncArityPrime
- ;
- unexpected($module, $pred, "not cons")
- ),
- % DCG arguments should always be distinct variables,
- % so this context should never be used.
- OutputTermArgNumber = 3,
- SimpleCallId = simple_call_id(pf_function, FuncName, FuncArity),
- OutputTermArgContext = ac_call(plain_call_id(SimpleCallId)),
-
- ArgContexts = [
- FieldArgNumber - FieldArgContext,
- InputTermArgNumber - InputTermArgContext,
- OutputTermArgNumber - OutputTermArgContext
- ],
- insert_arg_unifications_with_supplied_contexts(ArgVars, ArgTerms,
- ArgContexts, Context, Goal0, Goal, ArgAdded, !VarSet,
- !ModuleInfo, !QualInfo, !SInfo, !Specs),
- NumAdded = SetAdded + ArgAdded
- ;
- AccessType = get,
- expand_dcg_field_extraction_goal(Context, umc_explicit, [],
- FieldNames, FieldValueVar, TermInputVar, TermOutputVar,
- Functor, InnermostFunctor - _InnerSubContext, Goal0,
- ExtractAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
- InputTermArgNumber = 1,
- InputTermArgContext = ac_functor(Functor, umc_explicit, []),
-
- ( InnermostFunctor = cons(FuncNamePrime, FuncArityPrime, _TC) ->
- FuncName = FuncNamePrime,
- FuncArity = FuncArityPrime
- ;
- unexpected($module, $pred, "not cons")
- ),
- FieldArgNumber = 2,
- SimpleCallId = simple_call_id(pf_function, FuncName, FuncArity),
- FieldArgContext = ac_call(plain_call_id(SimpleCallId)),
-
- % DCG arguments should always be distinct variables,
- % so this context should never be used.
- OutputTermArgNumber = 1,
- OutputTermArgContext = ac_functor(Functor, umc_explicit, []),
- ArgContexts = [
- FieldArgNumber - FieldArgContext,
- InputTermArgNumber - InputTermArgContext,
- OutputTermArgNumber - OutputTermArgContext
- ],
- insert_arg_unifications_with_supplied_contexts(ArgVars, ArgTerms,
- ArgContexts, Context, Goal0, Goal, ArgAdded, !VarSet,
- !ModuleInfo, !QualInfo, !SInfo, !Specs),
- NumAdded = ExtractAdded + ArgAdded
- )
- ;
- unexpected($module, $pred, "arity != 3")
- ).
-
- % get_rev_conj(Goal, Renaming, RevConj0, RevConj) :
- %
- % Goal is a tree of conjuncts. Flatten it into a list (applying Renaming),
- % reverse it, append RevConj0, and return the result in RevConj.
- %
-:- pred get_rev_conj(goal::in, prog_var_renaming::in,
- list(hlds_goal)::in, list(hlds_goal)::out, int::in, int::out,
- prog_varset::in, prog_varset::out, module_info::in, module_info::out,
- qual_info::in, qual_info::out, svar_info::in, svar_info::out,
- list(error_spec)::in, list(error_spec)::out) is det.
-
-get_rev_conj(Goal, Renaming, RevConj0, RevConj, !NumAdded, !VarSet,
- !ModuleInfo, !QualInfo, !SInfo, !Specs) :-
- ( Goal = conj_expr(A, B) - _Context ->
- get_rev_conj(A, Renaming, RevConj0, RevConj1, !NumAdded,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
- get_rev_conj(B, Renaming, RevConj1, RevConj, !NumAdded,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs)
- ;
- transform_goal_expr_context_to_goal(Goal, Renaming, Goal1, GoalAdded,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
- !:NumAdded = !.NumAdded + GoalAdded,
- goal_to_conj_list(Goal1, ConjList),
- RevConj = list.reverse(ConjList) ++ RevConj0
- ).
-
- % get_rev_par_conj(Goal, Renaming, RevParConj0, RevParConj) :
- %
- % Goal is a tree of conjuncts. Flatten it into a list (applying Renaming),
- % reverse it, append RevParConj0, and return the result in RevParConj.
- %
-:- pred get_rev_par_conj(goal::in, prog_var_renaming::in,
- list(hlds_goal)::in, list(hlds_goal)::out, int::in, int::out,
- prog_varset::in, prog_varset::out, module_info::in, module_info::out,
- qual_info::in, qual_info::out, svar_info::in, svar_info::out,
- list(error_spec)::in, list(error_spec)::out) is det.
-
-get_rev_par_conj(Goal, Renaming, RevParConj0, RevParConj, !NumAdded, !VarSet,
- !ModuleInfo, !QualInfo, !SInfo, !Specs) :-
- ( Goal = par_conj_expr(A, B) - _Context ->
- get_rev_par_conj(A, Renaming, RevParConj0, RevParConj1, !NumAdded,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
- get_rev_par_conj(B, Renaming, RevParConj1, RevParConj, !NumAdded,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs)
- ;
- transform_goal_expr_context_to_goal(Goal, Renaming, Goal1, GoalAdded,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
- !:NumAdded = !.NumAdded + GoalAdded,
- goal_to_par_conj_list(Goal1, ParConjList),
- RevParConj = list.reverse(ParConjList) ++ RevParConj0
- ).
-
- % get_disj(Goal, Renaming, Disj0, Disj):
- %
- % Goal is a tree of disjuncts. Flatten it into a list (applying Renaming),
- % append Disj0, and return the result in Disj.
- %
-:- pred get_disj(goal::in, prog_var_renaming::in,
- list(hlds_goal_svar_info)::in, list(hlds_goal_svar_info)::out,
- int::in, int::out, prog_varset::in, prog_varset::out,
- module_info::in, module_info::out, qual_info::in, qual_info::out,
- svar_info::in, list(error_spec)::in, list(error_spec)::out) is det.
-
-get_disj(Goal, Renaming, DisjInfos0, DisjInfos, !NumAdded, !VarSet,
- !ModuleInfo, !QualInfo, SInfo0, !Specs) :-
- ( Goal = disj_expr(A, B) - _Context ->
- % We recurse on the *second* arm first, so that we will put the
- % disjuncts from *that* arm at the front of DisjInfos0, before
- % putting the disjuncts from the first arm at the front of the
- % resulting DisjInfos1. This way, the overall result, DisjInfos,
- % will have the disjuncts and their svar_infos in the correct order.
- get_disj(B, Renaming, DisjInfos0, DisjInfos1, !NumAdded, !VarSet,
- !ModuleInfo, !QualInfo, SInfo0, !Specs),
- get_disj(A, Renaming, DisjInfos1, DisjInfos, !NumAdded, !VarSet,
- !ModuleInfo, !QualInfo, SInfo0, !Specs)
- ;
- transform_goal_expr_context_to_goal(Goal, Renaming,
- HLDSGoal, GoalAdded, !VarSet, !ModuleInfo,
- !QualInfo, SInfo0, SInfo1, !Specs),
- !:NumAdded = !.NumAdded + GoalAdded,
- DisjInfo = hlds_goal_svar_info(HLDSGoal, SInfo1),
- DisjInfos = [DisjInfo | DisjInfos0]
- ).
-
-:- pred transform_orelse_goals(goals::in, prog_var_renaming::in,
- list(hlds_goal_svar_info)::out, num_added_goals::in, num_added_goals::out,
- prog_varset::in, prog_varset::out, module_info::in, module_info::out,
- qual_info::in, qual_info::out, svar_info::in,
- list(error_spec)::in, list(error_spec)::out) is det.
-
-transform_orelse_goals([], _, [],
- !NumAdded, !VarSet, !ModuleInfo, !QualInfo, _SInfo0, !Specs).
-transform_orelse_goals([Goal | Goals], Renaming, [DisjInfo | DisjInfos],
- !NumAdded, !VarSet, !ModuleInfo, !QualInfo, SInfo0, !Specs) :-
- transform_goal_expr_context_to_goal(Goal, Renaming, HLDSGoal, NumAddedGoal,
- !VarSet, !ModuleInfo, !QualInfo, SInfo0, SInfo1, !Specs),
- DisjInfo = hlds_goal_svar_info(HLDSGoal, SInfo1),
- !:NumAdded = !.NumAdded + NumAddedGoal,
- transform_orelse_goals(Goals, Renaming, DisjInfos,
- !NumAdded, !VarSet, !ModuleInfo, !QualInfo, SInfo0, !Specs).
-
-%----------------------------------------------------------------------------%
-%
-% Try goals
-%
-
- % Transform a try_expr which needs to perform I/O. The end result looks
- % like:
- %
- % magic_exception_result(TryResult),
- % (
- % TryResult = succeeded({}),
- % some [] (
- % !:IO = !.IO,
- % Goal
- % ),
- % some [] ( Then )
- % ;
- % TryResult = exception(Excp),
- % ExcpHandling
- % )
- %
- % Unlike in the non-I/O case, we have to transform the three pieces Goal,
- % Then, ExcpHandling separately then stitch them together into HLDS goals.
- % This is because we need to find out the variable for !.IO at the end of
- % Goal, before entering Then. The variable will be used in the later
- % post-transformation.
- %
-:- pred transform_try_expr_with_io(svar::in, svar::in, goal::in, goal::in,
- list(catch_expr)::in, maybe(catch_any_expr)::in,
- prog_context::in, prog_var_renaming::in, hlds_goal::out, int::out,
- prog_varset::in, prog_varset::out, module_info::in, module_info::out,
- qual_info::in, qual_info::out, svar_info::in, svar_info::out,
- list(error_spec)::in, list(error_spec)::out) is det.
-
-transform_try_expr_with_io(IOStateVarUnrenamed, IOStateVar, Goal0, Then0,
- Catches0, MaybeCatchAny0, Context, Renaming, TryGoal, NumAdded,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs) :-
- varset.new_named_var(!.VarSet, "TryResult", ResultVar, !:VarSet),
- varset.new_var(!.VarSet, ExcpVar, !:VarSet),
-
- ResultVarTerm = variable(ResultVar, Context),
- ExcpVarTerm = variable(ExcpVar, Context),
- NullTupleTerm = functor(atom("{}"), [], Context),
-
- goal_info_init(Context, GoalInfo),
-
- % Make the call to magic_exception_result.
- CallMagic0 = call_expr(magic_exception_result_sym_name, [ResultVarTerm],
- purity_pure) - Context,
- transform_goal_expr_context_to_goal(CallMagic0, Renaming, CallMagic,
- NumAddedA, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
-
- % Get the variable for !.IO before the (eventual) try_io call.
- svar_dot(Context, IOStateVar, IOStateVarBefore, !VarSet, !SInfo, !Specs),
-
- SInfoBeforeDisjunction = !.SInfo,
-
- % Build "TryResult = succeeded({})".
- ResultIsSucceededUnify0 =
- unify_expr(
- ResultVarTerm,
- exception_functor("succeeded", NullTupleTerm, Context),
- purity_pure
- ) - Context,
- transform_goal_expr_context_to_goal(ResultIsSucceededUnify0, Renaming,
- ResultIsSucceededUnify, NumAddedB, !VarSet, !ModuleInfo,
- !QualInfo, !SInfo, !Specs),
-
- % Build "some [] ( !:IO = !.IO, Goal )".
- %
- % The explicit unification avoids a degenerate case where Goal doesn't bind
- % the final !:IO variable, which would lead to trouble later when we move
- % Goal into its own lambda.
- IOUnify = unify_expr(
- functor(atom("!:"), [variable(IOStateVarUnrenamed, Context)], Context),
- functor(atom("!."), [variable(IOStateVarUnrenamed, Context)], Context),
- purity_pure
- ) - Context,
- ScopedGoal0 = some_expr([], conj_expr(IOUnify, Goal0) - Context) - Context,
- transform_goal_expr_context_to_goal(ScopedGoal0, Renaming, ScopedGoal,
- NumAddedC, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
-
- % Remember the variable for !.IO after the (eventual) try_io Goal.
- svar_dot(Context, IOStateVar, IOStateVarAfter, !VarSet, !SInfo, !Specs),
-
- % Build "some [] ( Then )".
- ScopedThen0 = some_expr([], Then0) - Context,
- transform_goal_expr_context_to_goal(ScopedThen0, Renaming, ScopedThen,
- NumAddedD, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
-
- % Build:
- %
- % TryResult = succeeded({}),
- % some [] ( !:IO = !.IO, Goal ),
- % some [] ( Then )
- %
- conj_list_to_goal([ResultIsSucceededUnify, ScopedGoal, ScopedThen],
- GoalInfo, ResultIsSucceededDisjunct),
-
- SInfoAfterResultIsSucceededDisjunct = !.SInfo,
- !:SInfo = SInfoBeforeDisjunction,
-
- % Build the disjunct for "TryResult = exception(Excp), ...".
- make_exception_handling_disjunct(ResultVarTerm, ExcpVarTerm, Catches0,
- MaybeCatchAny0, Context, ResultIsExceptionDisjunct0),
- transform_goal_expr_context_to_goal(ResultIsExceptionDisjunct0, Renaming,
- ResultIsExceptionDisjunct, NumAddedE,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
-
- SInfoAfterResultIsExceptionDisjunct = !.SInfo,
-
- % Get the disjuncts.
- DisjunctSInfos = [
- hlds_goal_svar_info(ResultIsSucceededDisjunct,
- SInfoAfterResultIsSucceededDisjunct),
- hlds_goal_svar_info(ResultIsExceptionDisjunct,
- SInfoAfterResultIsExceptionDisjunct)
- ],
- svar_finish_disjunction(Context, !.VarSet, DisjunctSInfos,
- Disjuncts, !:SInfo),
- disj_list_to_goal(Disjuncts, GoalInfo, Disjunction),
-
- % Build the call to magic_exception_result followed by the disjunction.
- conj_list_to_goal([CallMagic, Disjunction], GoalInfo,
- CallMagicThenDisjunction),
-
- IOStateVars = try_io_state_vars(IOStateVarBefore, IOStateVarAfter),
- GoalExpr = shorthand(try_goal(yes(IOStateVars), ResultVar,
- CallMagicThenDisjunction)),
- TryGoal = hlds_goal(GoalExpr, GoalInfo),
-
- NumAdded = NumAddedA + NumAddedB + NumAddedC + NumAddedD + NumAddedE.
-
- % Transform a try_expr which does not need I/O.
- %
- % If the try goal has an else part, the end result looks like:
- %
- % magic_exception_result(TryResult),
- % (
- % TryResult = succeeded({}),
- % ( Goal ->
- % Then
- % ;
- % Else
- % )
- % ;
- % TryResult = exception(Excp),
- % ExcpHandling
- % )
- %
- % If the try goal does not have an else part, the end result looks like:
- %
- % magic_exception_result(TryResult),
- % (
- % TryResult = succeeded({}),
- % some [] ( Goal ),
- % some [] ( Then )
- % ;
- % TryResult = exception(Excp),
- % ExcpHandling
- % )
- %
-:- pred transform_try_expr_without_io(goal::in, goal::in, maybe(goal)::in,
- list(catch_expr)::in, maybe(catch_any_expr)::in,
- prog_context::in, prog_var_renaming::in, hlds_goal::out, int::out,
- prog_varset::in, prog_varset::out, module_info::in, module_info::out,
- qual_info::in, qual_info::out, svar_info::in, svar_info::out,
- list(error_spec)::in, list(error_spec)::out) is det.
-
-transform_try_expr_without_io(Goal0, Then0, MaybeElse0, Catches0,
- MaybeCatchAny0, Context, Renaming, TryGoal, NumAdded,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs) :-
- varset.new_named_var(!.VarSet, "TryResult", ResultVar, !:VarSet),
- varset.new_var(!.VarSet, ExcpVar, !:VarSet),
-
- ResultVarTerm = variable(ResultVar, Context),
- ExcpVarTerm = variable(ExcpVar, Context),
- NullTupleTerm = functor(atom("{}"), [], Context),
-
- goal_info_init(Context, GoalInfo),
-
- % Build the call to magic_exception_result.
- CallMagic0 = call_expr(magic_exception_result_sym_name, [ResultVarTerm],
- purity_pure) - Context,
-
- % Build "TryResult = succeeded({}), ..." disjunct.
- ResultIsSucceededUnify0 =
- unify_expr(
- ResultVarTerm,
- exception_functor("succeeded", NullTupleTerm, Context),
- purity_pure
- ) - Context,
- (
- MaybeElse0 = yes(Else0),
- SucceededSubGoal =
- if_then_else_expr([], [], Goal0, Then0, Else0) - Context
- ;
- MaybeElse0 = no,
- SucceededSubGoal =
- conj_expr(
- some_expr([], Goal0) - Context,
- some_expr([], Then0) - Context
- ) - Context
- ),
- ResultIsSucceededDisjunct0 =
- conj_expr(ResultIsSucceededUnify0, SucceededSubGoal) - Context,
-
- % Build the disjunct for "TryResult = exception(Excp), ...".
- make_exception_handling_disjunct(ResultVarTerm, ExcpVarTerm, Catches0,
- MaybeCatchAny0, Context, ResultIsExceptionDisjunct0),
-
- % Build the call followed by the disjunction.
- CallMagicThenDisjunction0 =
- conj_expr(
- CallMagic0,
- disj_expr(
- ResultIsSucceededDisjunct0,
- ResultIsExceptionDisjunct0
- ) - Context
- ) - Context,
- transform_goal_expr_context_to_goal(CallMagicThenDisjunction0, Renaming,
- CallMagicThenDisjunction, NumAdded,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
-
- GoalExpr = shorthand(try_goal(no, ResultVar, CallMagicThenDisjunction)),
- TryGoal = hlds_goal(GoalExpr, GoalInfo).
-
-:- pred make_exception_handling_disjunct(prog_term::in, prog_term::in,
- list(catch_expr)::in, maybe(catch_any_expr)::in, prog_context::in,
- goal::out) is det.
-
-make_exception_handling_disjunct(ResultVarTerm, ExcpVarTerm, Catches,
- MaybeCatchAny, Context, Goal) :-
- ResultIsExceptionUnify =
- unify_expr(
- ResultVarTerm,
- exception_functor("exception", ExcpVarTerm, Context),
- purity_pure
- ) - Context,
- make_catch_ite_chain(ResultVarTerm, ExcpVarTerm, Catches, MaybeCatchAny,
- CatchChain),
- Goal = conj_expr(ResultIsExceptionUnify, CatchChain) - Context.
-
-:- pred make_catch_ite_chain(prog_term::in, prog_term::in,
- list(catch_expr)::in, maybe(catch_any_expr)::in, goal::out) is det.
-
-make_catch_ite_chain(ResultVarTerm, ExcpVarTerm, Catches, MaybeCatchAny,
- Goal) :-
- (
- Catches = [catch_expr(FirstPattern, FirstGoal) | RestCatches],
- make_catch_ite_chain(ResultVarTerm, ExcpVarTerm, RestCatches,
- MaybeCatchAny, ElseGoal),
- make_catch_pattern_unify_goal(FirstPattern, ExcpVarTerm,
- FirstPatternGoal),
- Goal = if_then_else_expr([], [], FirstPatternGoal, FirstGoal,
- ElseGoal) - get_term_context(FirstPattern)
- ;
- Catches = [],
- (
- MaybeCatchAny = yes(catch_any_expr(CatchAnyVar, CatchAnyGoal)),
- % With a catch_any part, end the if-then-else chain with:
- % CatchAnyVar = exc_univ_value(Excp),
- % CatchAnyGoal
- CatchAnyGoal = _ - Context,
- GetUnivValue = unify_expr(
- variable(CatchAnyVar, Context),
- exception_functor("exc_univ_value", ExcpVarTerm, Context),
- purity_pure) - Context,
- Goal = conj_expr(GetUnivValue, CatchAnyGoal) - Context
- ;
- MaybeCatchAny = no,
- % Without a catch_any part, end the if-then-else chain
- % by rethrowing the exception.
- Rethrow = qualified(mercury_exception_module, "rethrow"),
- Goal = call_expr(Rethrow, [ResultVarTerm], purity_pure)
- - get_term_context(ExcpVarTerm)
- )
- ).
-
-:- pred make_catch_pattern_unify_goal(prog_term::in, prog_term::in,
- goal::out) is det.
-
-make_catch_pattern_unify_goal(CatchPatternTerm, ExcpVarTerm, Goal) :-
- GoalExpr = call_expr(
- qualified(mercury_exception_module, "exc_univ_to_type"),
- [ExcpVarTerm, CatchPatternTerm], purity_pure),
- Goal = GoalExpr - get_term_context(CatchPatternTerm).
-
-:- func magic_exception_result_sym_name = sym_name.
-
-magic_exception_result_sym_name =
- qualified(mercury_exception_module, "magic_exception_result").
-
-:- func exception_functor(string, prog_term, term.context) = prog_term.
-
-exception_functor(Atom, Arg, Context) = Term :-
- construct_qualified_term(qualified(mercury_exception_module, Atom),
- [Arg], Context, Term).
-
-%----------------------------------------------------------------------------%
Index: compiler/add_pragma.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_pragma.m,v
retrieving revision 1.108
diff -u -b -r1.108 add_pragma.m
--- compiler/add_pragma.m 30 Dec 2010 11:17:52 -0000 1.108
+++ compiler/add_pragma.m 1 Mar 2011 08:47:32 -0000
@@ -1492,7 +1492,7 @@
do_construct_pred_or_func_call(PredId, PredOrFunc,
SymName, Args, GoalInfo, Goal),
Clause = clause(selected_modes(ProcIds), Goal, impl_lang_mercury,
- Context),
+ Context, []),
map.init(TVarNameMap),
ArgsVec = proc_arg_vector_init(PredOrFunc, Args),
set_clause_list([Clause], ClausesRep),
@@ -3118,13 +3118,22 @@
!ClausesInfo, !ModuleInfo, !Specs) :-
module_info_pred_info(!.ModuleInfo, PredId, PredInfo),
( pred_info_is_builtin(PredInfo) ->
- % When bootstrapping a change that redefines a builtin as
- % normal Mercury code, you may need to disable this action.
+ % When bootstrapping a change that defines a builtin using
+ % normal Mercury code, we need to disable the generation
+ % of the error message, and just ignore the definition.
+ module_info_get_globals(!.ModuleInfo, Globals),
+ globals.lookup_bool_option(Globals, allow_defn_of_builtins,
+ AllowDefnOfBuiltin),
+ (
+ AllowDefnOfBuiltin = no,
Msg = simple_msg(Context,
[always([words("Error: foreign_proc for builtin.")])]),
Spec = error_spec(severity_error, phase_parse_tree_to_hlds, [Msg]),
!:Specs = [Spec | !.Specs]
;
+ AllowDefnOfBuiltin = yes
+ )
+ ;
AllProcIds = pred_info_all_procids(PredInfo),
clauses_info_do_add_pragma_foreign_proc(Origin, Purity, Attributes0,
PredId, ProcId, AllProcIds, PVarSet, PVars, OrigArgTypes,
@@ -3274,7 +3283,7 @@
HldsGoal0, HldsGoal, VarSet0, VarSet, EmptyVarTypes, _,
EmptyRttiVarmaps, _),
NewClause = clause(selected_modes([ProcId]), HldsGoal,
- impl_lang_foreign(NewLang), Context),
+ impl_lang_foreign(NewLang), Context, []),
NewClauses = [NewClause | NewClauses0],
HasForeignClauses = yes,
set_clause_list(NewClauses, NewClauseRep),
@@ -3361,7 +3370,8 @@
add_foreign_proc_update_existing_clauses(PredName, Arity, PredOrFunc,
NewContext, Globals, Target, NewLang, AllProcIds, NewClauseProcId,
LaterClauses0, LaterClauses, LaterOverridden, !Specs),
- FirstClause0 = clause(ApplProcIds0, Body, ClauseLang, ClauseContext),
+ FirstClause0 = clause(ApplProcIds0, Body, ClauseLang, ClauseContext,
+ StateVarWarnings),
(
ClauseLang = impl_lang_mercury,
(
@@ -3382,7 +3392,7 @@
% in some modes, so mark it as being applicable only in the
% remaining modes.
FirstClause = clause(selected_modes(ProcIds), Body,
- ClauseLang, ClauseContext),
+ ClauseLang, ClauseContext, StateVarWarnings),
Clauses = [FirstClause | LaterClauses]
)
;
@@ -3422,7 +3432,7 @@
%
% XXX This should not happen.
FirstClause = clause(selected_modes(ProcIds), Body,
- ClauseLang, ClauseContext),
+ ClauseLang, ClauseContext, StateVarWarnings),
Clauses = [FirstClause | LaterClauses],
Overridden = LaterOverridden
),
Index: compiler/add_pred.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_pred.m,v
retrieving revision 1.43
diff -u -b -r1.43 add_pred.m
--- compiler/add_pred.m 15 Dec 2010 06:29:27 -0000 1.43
+++ compiler/add_pred.m 26 Feb 2011 03:36:04 -0000
@@ -340,7 +340,7 @@
Stub = no,
% Construct a clause containing that pseudo-recursive call.
Goal = hlds_goal(GoalExpr, GoalInfo),
- Clause = clause(all_modes, Goal, impl_lang_mercury, Context),
+ Clause = clause(all_modes, Goal, impl_lang_mercury, Context, []),
set_clause_list([Clause], ClausesRep)
;
Stub = yes,
Index: compiler/assertion.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/assertion.m,v
retrieving revision 1.68
diff -u -b -r1.68 assertion.m
--- compiler/assertion.m 15 Dec 2010 06:29:28 -0000 1.68
+++ compiler/assertion.m 26 Feb 2011 04:44:16 -0000
@@ -443,10 +443,11 @@
pred_info_get_clauses_info(PredInfo, ClausesInfo),
clauses_info_get_clauses_rep(ClausesInfo, ClausesRep, _ItemNumbers),
get_clause_list(ClausesRep, Clauses),
- ( Clauses = [clause(_ProcIds, Goal0, _Lang, _Context)] ->
+ ( Clauses = [Clause] ->
+ Goal0 = Clause ^ clause_body,
normalise_goal(Goal0, Goal)
;
- unexpected(this_file, "goal: not an assertion")
+ unexpected($module, $pred, "goal is not an assertion")
).
%-----------------------------------------------------------------------------%
@@ -761,9 +762,3 @@
normalise_goals(Goals0, Goals).
%-----------------------------------------------------------------------------%
-
-:- func this_file = string.
-
-this_file = "assertion.m".
-
-%-----------------------------------------------------------------------------%
Index: compiler/build_mode_constraints.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/build_mode_constraints.m,v
retrieving revision 1.40
diff -u -b -r1.40 build_mode_constraints.m
--- compiler/build_mode_constraints.m 13 Jan 2011 00:36:51 -0000 1.40
+++ compiler/build_mode_constraints.m 26 Feb 2011 04:46:29 -0000
@@ -354,13 +354,11 @@
% goal constraints.
Context = clause_context(FirstClause),
- % All clauses are considered for all procedures.
- % Though some may not be applicable, overall the
- % waste should not be large.
- Goals = list.map((func(clause(_, Body, _, _)) = Body), Clauses),
-
- list.foldl(add_mc_vars_for_goal(PredId, ProgVarset),
- Goals, !VarInfo),
+ % We consider all clauses for all procedures.
+ % Though some may not be applicable, overall the wasted effort
+ % should not be large.
+ Goals = list.map(clause_body, Clauses),
+ list.foldl(add_mc_vars_for_goal(PredId, ProgVarset), Goals, !VarInfo),
% Temporarily form the disjunction implied by the goal path
% annotations.
Index: compiler/clause_to_proc.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/clause_to_proc.m,v
retrieving revision 1.86
diff -u -b -r1.86 clause_to_proc.m
--- compiler/clause_to_proc.m 15 Dec 2010 06:29:29 -0000 1.86
+++ compiler/clause_to_proc.m 26 Feb 2011 04:47:36 -0000
@@ -75,6 +75,7 @@
:- import_module mdbcomp.
:- import_module mdbcomp.prim_data.
:- import_module parse_tree.
+:- import_module parse_tree.error_util.
:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_mode.
:- import_module parse_tree.prog_type_subst.
@@ -192,9 +193,11 @@
ClausesRep, _ItemNumbers, RttiInfo, _HaveForeignClauses),
get_clause_list(ClausesRep, Clauses),
select_matching_clauses(Clauses, ProcId, MatchingClauses),
- get_clause_goals(MatchingClauses, GoalList),
+ get_clause_disjuncts_and_warnings(MatchingClauses, ClausesDisjuncts,
+ StateVarWarnings),
+ proc_info_set_statevar_warnings(StateVarWarnings, !Proc),
(
- GoalList = [SingleGoal],
+ ClausesDisjuncts = [SingleGoal],
SingleGoal = hlds_goal(SingleExpr, _),
(
SingleExpr = call_foreign_proc(_, _, _, Args, ExtraArgs,
@@ -226,11 +229,11 @@
% any clauses at all, in which case we use the context of the
% mode declaration.
(
- GoalList = [FirstGoal, _ | _],
+ ClausesDisjuncts = [FirstGoal, _ | _],
FirstGoal = hlds_goal(_, FirstGoalInfo),
Context = goal_info_get_context(FirstGoalInfo)
;
- GoalList = [],
+ ClausesDisjuncts = [],
proc_info_get_context(!.Proc, Context)
),
@@ -249,15 +252,15 @@
% The disjunction is impure/semipure if any of the disjuncts
% is impure/semipure.
- ( contains_nonpure_goal(GoalList) ->
- PurityList = list.map(goal_get_purity, GoalList),
+ ( contains_nonpure_goal(ClausesDisjuncts) ->
+ PurityList = list.map(goal_get_purity, ClausesDisjuncts),
Purity = list.foldl(worst_purity, PurityList, purity_pure),
goal_info_set_purity(Purity, GoalInfo2, GoalInfo)
;
GoalInfo2 = GoalInfo
),
- Goal = hlds_goal(disj(GoalList), GoalInfo)
+ Goal = hlds_goal(disj(ClausesDisjuncts), GoalInfo)
),
% XXX ARGVEC - when the proc_info is converted to use proc_arg_vectors
% we should just pass the headvar vector in directly.
@@ -292,7 +295,7 @@
select_matching_clauses([], _, []).
select_matching_clauses([Clause | Clauses], ProcId, MatchingClauses) :-
select_matching_clauses(Clauses, ProcId, MatchingClausesTail),
- Clause = clause(ApplicableProcIds, _, _, _),
+ ApplicableProcIds = Clause ^ clause_applicable_procs,
(
ApplicableProcIds = all_modes,
MatchingClauses = [Clause | MatchingClausesTail]
@@ -305,14 +308,17 @@
)
).
-:- pred get_clause_goals(list(clause)::in, list(hlds_goal)::out) is det.
+:- pred get_clause_disjuncts_and_warnings(list(clause)::in,
+ list(hlds_goal)::out, list(error_spec)::out) is det.
-get_clause_goals([], []).
-get_clause_goals([Clause | Clauses], Goals) :-
- get_clause_goals(Clauses, Goals1),
- Clause = clause(_, Goal, _, _),
- goal_to_disj_list(Goal, GoalList),
- list.append(GoalList, Goals1, Goals).
+get_clause_disjuncts_and_warnings([], [], []).
+get_clause_disjuncts_and_warnings([Clause | Clauses], Disjuncts, Warnings) :-
+ Goal = Clause ^ clause_body,
+ goal_to_disj_list(Goal, FirstDisjuncts),
+ FirstWarnings = Clause ^ clause_statevar_warnings,
+ get_clause_disjuncts_and_warnings(Clauses, LaterDisjuncts, LaterWarnings),
+ Disjuncts = FirstDisjuncts ++ LaterDisjuncts,
+ Warnings = FirstWarnings ++ LaterWarnings.
%-----------------------------------------------------------------------------%
Index: compiler/dead_proc_elim.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/dead_proc_elim.m,v
retrieving revision 1.138
diff -u -b -r1.138 dead_proc_elim.m
--- compiler/dead_proc_elim.m 30 Dec 2010 11:17:53 -0000 1.138
+++ compiler/dead_proc_elim.m 26 Feb 2011 03:42:46 -0000
@@ -617,12 +617,12 @@
;
Unification = complicated_unify(_, _, _),
% These should have been replaced with calls by now.
- unexpected(this_file, "dead_proc_examine_goal: complicated_unify")
+ unexpected($module, $pred, "complicated_unify")
)
;
GoalExpr = shorthand(_),
% These should have been expanded out by now.
- unexpected(this_file, "dead_proc_examine_goal: shorthand")
+ unexpected($module, $pred, "shorthand")
).
%-----------------------------------------------------------------------------%
@@ -1053,7 +1053,14 @@
:- pred dead_pred_elim_process_clause(clause::in,
pred_elim_info::in, pred_elim_info::out) is det.
-dead_pred_elim_process_clause(clause(_, Goal, _, _), !DeadInfo) :-
+dead_pred_elim_process_clause(Clause, !DeadInfo) :-
+ pre_modecheck_examine_goal(Clause ^ clause_body, !DeadInfo).
+
+:- pred pre_modecheck_examine_case(case::in,
+ pred_elim_info::in, pred_elim_info::out) is det.
+
+pre_modecheck_examine_case(Case, !DeadInfo) :-
+ Case = case(_, _, Goal),
pre_modecheck_examine_goal(Goal, !DeadInfo).
:- pred pre_modecheck_examine_goal(hlds_goal::in,
@@ -1066,37 +1073,45 @@
:- pred pre_modecheck_examine_goal_expr(hlds_goal_expr::in,
pred_elim_info::in, pred_elim_info::out) is det.
-pre_modecheck_examine_goal_expr(conj(_ConjType, Goals), !DeadInfo) :-
- list.foldl(pre_modecheck_examine_goal, Goals, !DeadInfo).
-pre_modecheck_examine_goal_expr(disj(Goals), !DeadInfo) :-
- list.foldl(pre_modecheck_examine_goal, Goals, !DeadInfo).
-pre_modecheck_examine_goal_expr(if_then_else(_, If, Then, Else), !DeadInfo) :-
- list.foldl(pre_modecheck_examine_goal, [If, Then, Else], !DeadInfo).
-pre_modecheck_examine_goal_expr(switch(_, _, Cases), !DeadInfo) :-
- ExamineCase = (pred(Case::in, Info0::in, Info::out) is det :-
- Case = case(_, _, Goal),
- pre_modecheck_examine_goal(Goal, Info0, Info)
- ),
- list.foldl(ExamineCase, Cases, !DeadInfo).
-pre_modecheck_examine_goal_expr(generic_call(_,_,_,_), !DeadInfo).
-pre_modecheck_examine_goal_expr(negation(SubGoal), !DeadInfo) :-
- pre_modecheck_examine_goal(SubGoal, !DeadInfo).
-pre_modecheck_examine_goal_expr(scope(_, SubGoal), !DeadInfo) :-
- % The invariants that would allow us to optimize from_ground_term_construct
- % scopes haven't been established yet, which is why we must always scan
- % SubGoal.
- pre_modecheck_examine_goal(SubGoal, !DeadInfo).
-pre_modecheck_examine_goal_expr(plain_call(_, _, _, _, _, PredName),
- !DeadInfo) :-
- dead_pred_info_add_pred_name(PredName, !DeadInfo).
-pre_modecheck_examine_goal_expr(call_foreign_proc(_, _, _, _, _, _, _),
- !DeadInfo).
-pre_modecheck_examine_goal_expr(unify(_, Rhs, _, _, _), !DeadInfo) :-
- pre_modecheck_examine_unify_rhs(Rhs, !DeadInfo).
-pre_modecheck_examine_goal_expr(shorthand(ShortHand), !DeadInfo) :-
+pre_modecheck_examine_goal_expr(GoalExpr, !DeadInfo) :-
(
- ShortHand = atomic_goal(_GoalType, _Outer, _Inner, _MaybeOutputVars,
- MainGoal, OrElseGoals, _OrElseInners),
+ GoalExpr = conj(_ConjType, Goals),
+ list.foldl(pre_modecheck_examine_goal, Goals, !DeadInfo)
+ ;
+ GoalExpr = disj(Goals),
+ list.foldl(pre_modecheck_examine_goal, Goals, !DeadInfo)
+ ;
+ GoalExpr = if_then_else(_, Cond, Then, Else),
+ pre_modecheck_examine_goal(Cond, !DeadInfo),
+ pre_modecheck_examine_goal(Then, !DeadInfo),
+ pre_modecheck_examine_goal(Else, !DeadInfo)
+ ;
+ GoalExpr = switch(_, _, Cases),
+ list.foldl(pre_modecheck_examine_case, Cases, !DeadInfo)
+ ;
+ GoalExpr = negation(SubGoal),
+ pre_modecheck_examine_goal(SubGoal, !DeadInfo)
+ ;
+ GoalExpr = scope(_, SubGoal),
+ % The invariants that would allow us to optimize
+ % from_ground_term_construct scopes haven't been established yet,
+ % which is why we must always scan SubGoal.
+ pre_modecheck_examine_goal(SubGoal, !DeadInfo)
+ ;
+ GoalExpr = plain_call(_, _, _, _, _, PredName),
+ dead_pred_info_add_pred_name(PredName, !DeadInfo)
+ ;
+ GoalExpr = generic_call(_, _, _, _)
+ ;
+ GoalExpr = call_foreign_proc(_, _, _, _, _, _, _)
+ ;
+ GoalExpr = unify(_, RHS, _, _, _),
+ pre_modecheck_examine_unify_rhs(RHS, !DeadInfo)
+ ;
+ GoalExpr = shorthand(ShortHand),
+ (
+ ShortHand = atomic_goal(_GoalType, _Outer, _Inner,
+ _MaybeOutputVars, MainGoal, OrElseGoals, _OrElseInners),
pre_modecheck_examine_goal(MainGoal, !DeadInfo),
list.foldl(pre_modecheck_examine_goal, OrElseGoals, !DeadInfo)
;
@@ -1105,23 +1120,27 @@
;
ShortHand = bi_implication(_, _),
% These should have been expanded out by now.
- unexpected(this_file,
- "pre_modecheck_examine_goal_expr: unexpected bi_implication")
+ unexpected($module, $pred, "unexpected bi_implication")
+ )
).
:- pred pre_modecheck_examine_unify_rhs(unify_rhs::in,
pred_elim_info::in, pred_elim_info::out) is det.
-pre_modecheck_examine_unify_rhs(rhs_var(_), !DeadInfo).
-pre_modecheck_examine_unify_rhs(rhs_functor(Functor, _, _), !DeadInfo) :-
+pre_modecheck_examine_unify_rhs(RHS, !DeadInfo) :-
+ (
+ RHS = rhs_var(_)
+ ;
+ RHS = rhs_functor(Functor, _, _),
( Functor = cons(Name, _, _) ->
dead_pred_info_add_pred_name(Name, !DeadInfo)
;
true
+ )
+ ;
+ RHS = rhs_lambda_goal(_, _, _, _, _, _, _, _, Goal),
+ pre_modecheck_examine_goal(Goal, !DeadInfo)
).
-pre_modecheck_examine_unify_rhs(rhs_lambda_goal(_, _, _, _, _, _, _, _, Goal),
- !DeadInfo) :-
- pre_modecheck_examine_goal(Goal, !DeadInfo).
:- pred dead_pred_info_add_pred_name(sym_name::in,
pred_elim_info::in, pred_elim_info::out) is det.
@@ -1149,11 +1168,5 @@
).
%-----------------------------------------------------------------------------%
-
-:- func this_file = string.
-
-this_file = "dead_proc_elim.m".
-
-%-----------------------------------------------------------------------------%
:- end_module dead_proc_elim.
%-----------------------------------------------------------------------------%
Index: compiler/dependency_graph.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/dependency_graph.m,v
retrieving revision 1.106
diff -u -b -r1.106 dependency_graph.m
--- compiler/dependency_graph.m 30 Jul 2010 05:16:09 -0000 1.106
+++ compiler/dependency_graph.m 26 Feb 2011 04:05:48 -0000
@@ -335,7 +335,7 @@
pred_info_get_clauses_info(PredInfo, ClausesInfo),
clauses_info_get_clauses_rep(ClausesInfo, ClausesRep, _ItemNumbers),
get_clause_list_any_order(ClausesRep, Clauses),
- Goals = list.map(func(clause(_, Goal, _, _)) = Goal, Clauses),
+ Goals = list.map(clause_body, Clauses),
digraph.lookup_key(!.DepGraph, PredId, Caller),
add_dependency_arcs_in_list(Caller, Goals, !DepGraph)
),
Index: compiler/field_access.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/field_access.m,v
retrieving revision 1.18
diff -u -b -r1.18 field_access.m
--- compiler/field_access.m 15 Dec 2010 06:29:35 -0000 1.18
+++ compiler/field_access.m 17 Feb 2011 06:50:37 -0000
@@ -46,9 +46,10 @@
unify_main_context::in, unify_sub_contexts::in, field_list::in,
prog_var::in, prog_var::in, prog_var::in, cons_id::out,
pair(cons_id, unify_sub_contexts)::out, hlds_goal::out,
- num_added_goals::out, prog_varset::in, prog_varset::out,
+ num_added_goals::out,
+ svar_state::in, svar_state::out, svar_store::in, svar_store::out,
+ prog_varset::in, prog_varset::out,
module_info::in, module_info::out, qual_info::in, qual_info::out,
- svar_info::in, svar_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
% Expand a field extraction goal into a list of goals which each get one
@@ -67,9 +68,10 @@
unify_main_context::in, unify_sub_contexts::in, field_list::in,
prog_var::in, prog_var::in, prog_var::in, cons_id::out,
pair(cons_id, unify_sub_contexts)::out, hlds_goal::out,
- num_added_goals::out, prog_varset::in, prog_varset::out,
+ num_added_goals::out,
+ svar_state::in, svar_state::out, svar_store::in, svar_store::out,
+ prog_varset::in, prog_varset::out,
module_info::in, module_info::out, qual_info::in, qual_info::out,
- svar_info::in, svar_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
% Expand a field extraction function call into a list of goals which
@@ -86,9 +88,10 @@
unify_main_context::in, unify_sub_contexts::in, field_list::in,
prog_var::in, prog_var::in, purity::in, cons_id::out,
pair(cons_id, unify_sub_contexts)::out,
- hlds_goal::out, num_added_goals::out, prog_varset::in, prog_varset::out,
+ hlds_goal::out, num_added_goals::out,
+ svar_state::in, svar_state::out, svar_store::in, svar_store::out,
+ prog_varset::in, prog_varset::out,
module_info::in, module_info::out, qual_info::in, qual_info::out,
- svar_info::in, svar_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
:- pred maybe_parse_field_list(prog_term::in, prog_varset::in,
@@ -118,11 +121,12 @@
expand_set_field_function_call(Context, MainContext, SubContext0, FieldNames,
FieldValueVar, TermInputVar, TermOutputVar, Functor, FieldSubContext,
- Goal, NumAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs) :-
+ Goal, NumAdded, !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs) :-
expand_set_field_function_call_2(Context, MainContext, SubContext0,
FieldNames, FieldValueVar, TermInputVar, TermOutputVar, Functor,
FieldSubContext, Goals, NumAdded,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
+ !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs),
goal_info_init(Context, GoalInfo),
conj_list_to_goal(Goals, GoalInfo, Goal).
@@ -130,20 +134,21 @@
unify_main_context::in, unify_sub_contexts::in, field_list::in,
prog_var::in, prog_var::in, prog_var::in, cons_id::out,
pair(cons_id, unify_sub_contexts)::out, list(hlds_goal)::out,
- num_added_goals::out, prog_varset::in, prog_varset::out,
+ num_added_goals::out,
+ svar_state::in, svar_state::out, svar_store::in, svar_store::out,
+ prog_varset::in, prog_varset::out,
module_info::in, module_info::out, qual_info::in, qual_info::out,
- svar_info::in, svar_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
expand_set_field_function_call_2(_, _, _, [], _, _, _, _, _, _, _,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs) :-
+ !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs) :-
unexpected(this_file,
"expand_set_field_function_call_2: empty list of field names").
expand_set_field_function_call_2(Context, MainContext, SubContext0,
[FieldName - FieldArgs | FieldNames], FieldValueVar,
TermInputVar, TermOutputVar, Functor, FieldSubContext, Goals, NumAdded,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs) :-
- make_fresh_arg_vars(FieldArgs, FieldArgVars, !VarSet, !SInfo, !Specs),
+ !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs) :-
+ make_fresh_arg_vars(FieldArgs, FieldArgVars, !VarSet, !SVarState, !Specs),
(
FieldNames = [_ | _],
varset.new_var(!.VarSet, SubTermInputVar, !:VarSet),
@@ -157,8 +162,8 @@
% Extract the field containing the field to update.
construct_field_access_function_call(get, Context,
MainContext, SubContext0, FieldName, SubTermInputVar,
- list.append(FieldArgVars, [TermInputVar]), purity_pure, _,
- GetSubFieldGoal, !QualInfo),
+ FieldArgVars ++ [TermInputVar], purity_pure, _, GetSubFieldGoal,
+ !QualInfo),
GetSubFieldAdded = 1,
% Recursively update the field.
@@ -168,7 +173,7 @@
expand_set_field_function_call_2(Context, MainContext,
SubContext, FieldNames, FieldValueVar, SubTermInputVar,
SubTermOutputVar, _, FieldSubContext, Goals0, SetAdded,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
+ !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs),
FieldAdded = GetSubFieldAdded + SetAdded + UpdateAdded,
Goals1 = [GetSubFieldGoal | Goals0] ++ [UpdateGoal]
@@ -186,14 +191,15 @@
goal_info_init(Context, GoalInfo),
conj_list_to_goal(Goals1, GoalInfo, Conj0),
insert_arg_unifications(FieldArgVars, FieldArgs, Context, ArgContext,
- Conj0, Conj, ArgAdded, !VarSet, !ModuleInfo, !QualInfo,
- !SInfo, !Specs),
+ Conj0, Conj, ArgAdded, !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs),
NumAdded = FieldAdded + ArgAdded,
- goal_to_conj_list(Conj, Goals).
+ svar_goal_to_conj_list(Conj, Goals, !SVarStore).
expand_dcg_field_extraction_goal(Context, MainContext, SubContext, FieldNames,
FieldValueVar, TermInputVar, TermOutputVar, Functor, FieldSubContext,
- Goal, NumAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs) :-
+ Goal, NumAdded, !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs) :-
% Unify the DCG input and output variables.
make_atomic_unification(TermOutputVar, rhs_var(TermInputVar), Context,
MainContext, SubContext, UnifyDCG, !QualInfo),
@@ -203,7 +209,7 @@
expand_get_field_function_call_2(Context, MainContext, SubContext,
FieldNames, FieldValueVar, TermOutputVar, purity_pure,
Functor, FieldSubContext, Goals1, GetAdded,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
+ !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs),
NumAdded = UnifyAdded + GetAdded,
Goals = [UnifyDCG | Goals1],
goal_info_init(Context, GoalInfo),
@@ -211,11 +217,12 @@
expand_get_field_function_call(Context, MainContext, SubContext0, FieldNames,
FieldValueVar, TermInputVar, Purity, Functor, FieldSubContext,
- Goal, NumAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs) :-
+ Goal, NumAdded, !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs) :-
expand_get_field_function_call_2(Context, MainContext, SubContext0,
FieldNames, FieldValueVar, TermInputVar, Purity, Functor,
- FieldSubContext, Goals, NumAdded, !VarSet, !ModuleInfo, !QualInfo,
- !SInfo, !Specs),
+ FieldSubContext, Goals, NumAdded, !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs),
goal_info_init(Context, GoalInfo),
conj_list_to_goal(Goals, GoalInfo, Goal).
@@ -223,20 +230,21 @@
unify_main_context::in, unify_sub_contexts::in, field_list::in,
prog_var::in, prog_var::in, purity::in, cons_id::out,
pair(cons_id, unify_sub_contexts)::out, list(hlds_goal)::out,
- num_added_goals::out, prog_varset::in, prog_varset::out,
+ num_added_goals::out,
+ svar_state::in, svar_state::out, svar_store::in, svar_store::out,
+ prog_varset::in, prog_varset::out,
module_info::in, module_info::out, qual_info::in, qual_info::out,
- svar_info::in, svar_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
expand_get_field_function_call_2(_, _, _, [], _, _, _, _, _, _, _,
- !VarSet, !ModuleInfo, !QualInfo, !Sinfo, !Specs) :-
+ !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs) :-
unexpected(this_file,
"expand_get_field_function_call_2: empty list of field names").
expand_get_field_function_call_2(Context, MainContext, SubContext0,
[FieldName - FieldArgs | FieldNames], FieldValueVar, TermInputVar,
Purity, Functor, FieldSubContext, Goals, NumAdded,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs) :-
- make_fresh_arg_vars(FieldArgs, FieldArgVars, !VarSet, !SInfo, !Specs),
+ !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs) :-
+ make_fresh_arg_vars(FieldArgs, FieldArgVars, !VarSet, !SVarState, !Specs),
GetArgVars = FieldArgVars ++ [TermInputVar],
(
FieldNames = [_ | _],
@@ -252,8 +260,8 @@
SubContext = [TermInputContext | SubContext0],
expand_get_field_function_call_2(Context, MainContext,
SubContext, FieldNames, FieldValueVar, SubTermInputVar, Purity,
- _, FieldSubContext, Goals1, ExtractAdded, !VarSet, !ModuleInfo,
- !QualInfo, !SInfo, !Specs),
+ _, FieldSubContext, Goals1, ExtractAdded, !SVarState, !SVarStore,
+ !VarSet, !ModuleInfo, !QualInfo, !Specs),
Goals2 = [Goal | Goals1],
FieldAdded = CallAdded + ExtractAdded
;
@@ -269,19 +277,19 @@
goal_info_init(Context, GoalInfo),
conj_list_to_goal(Goals2, GoalInfo, Conj0),
insert_arg_unifications(FieldArgVars, FieldArgs, Context, ArgContext,
- Conj0, Conj, ArgAdded, !VarSet, !ModuleInfo, !QualInfo,
- !SInfo, !Specs),
+ Conj0, Conj, ArgAdded, !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs),
NumAdded = FieldAdded + ArgAdded,
- goal_to_conj_list(Conj, Goals).
+ svar_goal_to_conj_list(Conj, Goals, !SVarStore).
:- pred construct_field_access_function_call(field_access_type::in,
prog_context::in, unify_main_context::in, unify_sub_contexts::in,
ctor_field_name::in, prog_var::in, list(prog_var)::in, purity::in,
cons_id::out, hlds_goal::out, qual_info::in, qual_info::out) is det.
-construct_field_access_function_call(AccessType, Context, MainContext,
- SubContext, FieldName, RetArg, Args, Purity, Functor, Goal,
- !QualInfo) :-
+construct_field_access_function_call(AccessType, Context,
+ MainContext, SubContext, FieldName, RetArg, Args, Purity, Functor,
+ Goal, !QualInfo) :-
field_access_function_name(AccessType, FieldName, FuncName),
list.length(Args, Arity),
Functor = cons(FuncName, Arity, cons_id_dummy_type_ctor),
Index: compiler/goal_expr_to_goal.m
===================================================================
RCS file: compiler/goal_expr_to_goal.m
diff -N compiler/goal_expr_to_goal.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ compiler/goal_expr_to_goal.m 1 Mar 2011 06:30:38 -0000
@@ -0,0 +1,1294 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2011 The University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+
+:- module hlds.make_hlds.goal_expr_to_goal.
+:- interface.
+
+:- import_module hlds.hlds_goal.
+:- import_module hlds.hlds_module.
+:- import_module hlds.make_hlds.qual_info.
+:- import_module hlds.make_hlds.state_var.
+:- import_module parse_tree.error_util.
+:- import_module parse_tree.prog_data.
+
+:- import_module list.
+
+%-----------------------------------------------------------------------------%
+
+:- type loc_kind
+ ---> loc_whole_goal
+ ; loc_inside_atomic_goal.
+
+ % Convert goals from the prog_data `goal' structure into the HLDS
+ % `hlds_goal' structure. At the same time,
+ %
+ % - convert it to super-homogeneous form by unravelling all the complex
+ % unifications, and annotate those unifications with a unify_context
+ % so that we can still give good error messages;
+ % - apply the given substitution to the goal, to rename it apart
+ % from the other clauses; and
+ % - expand references to state variables.
+ %
+:- pred transform_goal_expr_context_to_goal(loc_kind::in, goal::in,
+ prog_var_renaming::in, hlds_goal::out, int::out,
+ svar_state::in, svar_state::out, svar_store::in, svar_store::out,
+ prog_varset::in, prog_varset::out,
+ module_info::in, module_info::out, qual_info::in, qual_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module check_hlds.clause_to_proc.
+:- import_module check_hlds.mode_errors.
+:- import_module hlds.goal_util.
+:- import_module hlds.hlds_args.
+:- import_module hlds.hlds_data.
+:- import_module hlds.hlds_error_util.
+:- import_module hlds.hlds_out.
+:- import_module hlds.hlds_out.hlds_out_goal.
+:- import_module hlds.hlds_out.hlds_out_util.
+:- import_module hlds.hlds_pred.
+:- import_module hlds.hlds_pred.
+:- import_module hlds.hlds_rtti.
+:- import_module hlds.make_hlds.add_pragma.
+:- import_module hlds.make_hlds.add_pred.
+:- import_module hlds.make_hlds.field_access.
+:- import_module hlds.make_hlds.make_hlds_warn.
+:- import_module hlds.make_hlds.superhomogeneous.
+:- import_module hlds.pred_table.
+:- import_module hlds.quantification.
+:- import_module libs.globals.
+:- import_module libs.options.
+:- import_module mdbcomp.prim_data.
+:- import_module parse_tree.mercury_to_mercury.
+:- import_module parse_tree.module_qual.
+:- import_module parse_tree.prog_data.
+:- import_module parse_tree.prog_io_util.
+:- import_module parse_tree.prog_mode.
+:- import_module parse_tree.prog_out.
+:- import_module parse_tree.prog_util.
+
+:- import_module assoc_list.
+:- import_module bool.
+:- import_module int.
+:- import_module io.
+:- import_module map.
+:- import_module pair.
+:- import_module require.
+:- import_module set.
+:- import_module string.
+:- import_module varset.
+
+%-----------------------------------------------------------------------------%
+
+transform_goal_expr_context_to_goal(LocKind, Goal0 - Context, Renaming, Goal,
+ NumAdded, !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs) :-
+ transform_goal_expr_to_goal(LocKind, Goal0, Context, Renaming, Goal1,
+ NumAdded, !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs),
+ Goal1 = hlds_goal(GoalExpr, GoalInfo1),
+ goal_info_set_context(Context, GoalInfo1, GoalInfo),
+ Goal = hlds_goal(GoalExpr, GoalInfo).
+
+:- pred transform_goal_expr_to_goal(loc_kind::in, goal_expr::in,
+ prog_context::in, prog_var_renaming::in, hlds_goal::out,
+ num_added_goals::out,
+ svar_state::in, svar_state::out, svar_store::in, svar_store::out,
+ prog_varset::in, prog_varset::out,
+ module_info::in, module_info::out, qual_info::in, qual_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+transform_goal_expr_to_goal(LocKind, Expr, Context, Renaming, Goal, !:NumAdded,
+ !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs) :-
+ (
+ (
+ Expr = fail_expr,
+ GoalExpr = disj([])
+ ;
+ Expr = true_expr,
+ GoalExpr = conj(plain_conj, [])
+ ),
+ !:NumAdded = 0,
+ goal_info_init(GoalInfo),
+ Goal = hlds_goal(GoalExpr, GoalInfo)
+ ;
+ % Convert `all [Vars] Goal' into `not some [Vars] not Goal'.
+ (
+ Expr = all_expr(Vars0, Goal0),
+ TransformedExpr = not_expr(some_expr(Vars0,
+ not_expr(Goal0) - Context) - Context)
+ ;
+ Expr = all_state_vars_expr(StateVars, Goal0),
+ TransformedExpr = not_expr(some_state_vars_expr(StateVars,
+ not_expr(Goal0) - Context) - Context)
+ ),
+ transform_goal_expr_to_goal(LocKind, TransformedExpr, Context,
+ Renaming, Goal, !:NumAdded, !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs)
+ ;
+ Expr = some_expr(Vars0, SubExpr),
+ rename_var_list(need_not_rename, Renaming, Vars0, Vars),
+ transform_goal_expr_context_to_goal(LocKind, SubExpr, Renaming,
+ SubGoal, !:NumAdded, !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs),
+ Reason = exist_quant(Vars),
+ GoalExpr = scope(Reason, SubGoal),
+ goal_info_init(GoalInfo),
+ Goal = hlds_goal(GoalExpr, GoalInfo)
+ ;
+ Expr = some_state_vars_expr(StateVars0, SubExpr0),
+ BeforeOutsideSVarState = !.SVarState,
+ rename_var_list(need_not_rename, Renaming, StateVars0, StateVars),
+ svar_prepare_for_local_state_vars(Context, !.VarSet, StateVars,
+ BeforeOutsideSVarState, BeforeInsideSVarState, !Specs),
+ transform_goal_expr_context_to_goal(LocKind, SubExpr0, Renaming,
+ SubGoal, !:NumAdded, BeforeInsideSVarState, AfterInsideSVarState,
+ !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs),
+ svar_finish_local_state_vars(StateVars, BeforeOutsideSVarState,
+ AfterInsideSVarState, AfterOutsideSVarState),
+ !:SVarState = AfterOutsideSVarState,
+ Reason = exist_quant([]),
+ GoalExpr = scope(Reason, SubGoal),
+ goal_info_init(GoalInfo),
+ Goal = hlds_goal(GoalExpr, GoalInfo)
+ ;
+ Expr = promise_purity_expr(Purity, SubExpr0),
+ transform_goal_expr_context_to_goal(LocKind, SubExpr0, Renaming,
+ SubGoal, !:NumAdded, !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs),
+ Reason = promise_purity(Purity),
+ GoalExpr = scope(Reason, SubGoal),
+ goal_info_init(GoalInfo),
+ Goal = hlds_goal(GoalExpr, GoalInfo)
+ ;
+ Expr = promise_equivalent_solutions_expr(Vars0, StateVars0,
+ DotSVars0, ColonSVars0, SubExpr0),
+ transform_promise_eqv_goal(LocKind, Vars0, StateVars0,
+ DotSVars0, ColonSVars0, Context, Renaming, Vars, SubExpr0,
+ SubGoal, GoalInfo, !:NumAdded, !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs),
+ Reason = promise_solutions(Vars, equivalent_solutions),
+ GoalExpr = scope(Reason, SubGoal),
+ Goal = hlds_goal(GoalExpr, GoalInfo)
+ ;
+ Expr = promise_equivalent_solution_sets_expr(Vars0, StateVars0,
+ DotSVars0, ColonSVars0, SubExpr0),
+ transform_promise_eqv_goal(LocKind, Vars0, StateVars0,
+ DotSVars0, ColonSVars0, Context, Renaming, Vars, SubExpr0,
+ SubGoal, GoalInfo, !:NumAdded, !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs),
+ GoalExpr = scope(promise_solutions(Vars, equivalent_solution_sets),
+ SubGoal),
+ Goal = hlds_goal(GoalExpr, GoalInfo)
+ ;
+ Expr = promise_equivalent_solution_arbitrary_expr(Vars0, StateVars0,
+ DotSVars0, ColonSVars0, SubExpr0),
+ transform_promise_eqv_goal(LocKind, Vars0, StateVars0,
+ DotSVars0, ColonSVars0, Context, Renaming, Vars, SubExpr0,
+ SubGoal, GoalInfo, !:NumAdded, !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs),
+ GoalExpr = scope(promise_solutions(Vars,
+ equivalent_solution_sets_arbitrary), SubGoal),
+ Goal = hlds_goal(GoalExpr, GoalInfo)
+ ;
+ Expr = require_detism_expr(Detism, SubExpr),
+ transform_goal_expr_context_to_goal(LocKind, SubExpr, Renaming,
+ SubGoal, !:NumAdded, !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs),
+ GoalExpr = scope(require_detism(Detism), SubGoal),
+ goal_info_init(GoalInfo),
+ Goal = hlds_goal(GoalExpr, GoalInfo)
+ ;
+ Expr = require_complete_switch_expr(Var0, SubExpr),
+ rename_var(need_not_rename, Renaming, Var0, Var),
+ transform_goal_expr_context_to_goal(LocKind, SubExpr, Renaming,
+ SubGoal, !:NumAdded, !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs),
+ GoalExpr = scope(require_complete_switch(Var), SubGoal),
+ goal_info_init(GoalInfo),
+ Goal = hlds_goal(GoalExpr, GoalInfo)
+ ;
+ Expr = atomic_expr(Outer0, Inner0, MaybeOutputVars0,
+ MainExpr, OrElseExprs),
+ (
+ MaybeOutputVars0 = no,
+ MaybeOutputVars = no
+ ;
+ MaybeOutputVars0 = yes(OutputVars0),
+ rename_var_list(need_not_rename, Renaming,
+ OutputVars0, OutputVars),
+ MaybeOutputVars = yes(OutputVars)
+ ),
+ (
+ Outer0 = atomic_state_var(OuterStateVar0),
+ rename_var(need_not_rename, Renaming,
+ OuterStateVar0, OuterStateVar),
+ svar_start_outer_atomic_scope(Context, OuterStateVar,
+ OuterDI, OuterUO, OuterScopeInfo, !SVarState, !VarSet, !Specs),
+ MaybeOuterScopeInfo = yes(OuterScopeInfo),
+ Outer = atomic_interface_vars(OuterDI, OuterUO)
+ ;
+ Outer0 = atomic_var_pair(OuterDI0, OuterUO0),
+ rename_var(need_not_rename, Renaming, OuterDI0, OuterDI),
+ rename_var(need_not_rename, Renaming, OuterUO0, OuterUO),
+ Outer = atomic_interface_vars(OuterDI, OuterUO),
+ MaybeOuterScopeInfo = no
+ ),
+ (
+ Inner0 = atomic_state_var(InnerStateVar0),
+ rename_var(need_not_rename, Renaming,
+ InnerStateVar0, InnerStateVar),
+ svar_start_inner_atomic_scope(Context, InnerStateVar,
+ InnerScopeInfo, !SVarState, !VarSet, !Specs),
+ MaybeInnerScopeInfo = yes(InnerScopeInfo)
+ ;
+ Inner0 = atomic_var_pair(_InnerDI0, _InnerUO0),
+ MaybeInnerScopeInfo = no
+ ),
+ BeforeDisjSVarState = !.SVarState,
+ transform_goal_expr_context_to_goal(LocKind, MainExpr, Renaming,
+ HLDSMainGoal0, !:NumAdded, BeforeDisjSVarState, AfterMainSVarState,
+ !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs),
+ MainDisjState =
+ hlds_goal_svar_state(HLDSMainGoal0, AfterMainSVarState),
+ transform_orelse_goals(LocKind, OrElseExprs, Renaming, OrElseDisjStates,
+ 0, OrElseNumAdded, BeforeDisjSVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs),
+ AllDisjStates = [MainDisjState | OrElseDisjStates],
+ svar_finish_disjunction(Context, AllDisjStates, HLDSGoals, !VarSet,
+ BeforeDisjSVarState, !:SVarState, !SVarStore),
+ (
+ HLDSGoals = [HLDSMainGoal | HLDSOrElseGoals]
+ ;
+ HLDSGoals = [],
+ unexpected($module, $pred, "atomic HLDSGoals = []")
+ ),
+ (
+ Inner0 = atomic_state_var(_),
+ (
+ MaybeInnerScopeInfo = yes(InnerScopeInfo2),
+ svar_finish_inner_atomic_scope(Context, InnerScopeInfo2,
+ InnerDI, InnerUO, !SVarState, !VarSet, !Specs),
+ Inner = atomic_interface_vars(InnerDI, InnerUO)
+ ;
+ MaybeInnerScopeInfo = no,
+ unexpected($module, $pred, "MaybeInnerScopeInfo = no")
+ )
+ ;
+ Inner0 = atomic_var_pair(InnerDI0, InnerUO0),
+ rename_var(need_not_rename, Renaming, InnerDI0, InnerDI),
+ rename_var(need_not_rename, Renaming, InnerUO0, InnerUO),
+ Inner = atomic_interface_vars(InnerDI, InnerUO)
+ ),
+ (
+ MaybeOuterScopeInfo = yes(OuterScopeInfo2),
+ svar_finish_outer_atomic_scope(OuterScopeInfo2, !SVarState)
+ ;
+ MaybeOuterScopeInfo = no
+ ),
+ !:NumAdded = !.NumAdded + 1 + OrElseNumAdded,
+ ShortHand = atomic_goal(unknown_atomic_goal_type, Outer, Inner,
+ MaybeOutputVars, HLDSMainGoal, HLDSOrElseGoals, []),
+ GoalExpr = shorthand(ShortHand),
+ goal_info_init(Context, GoalInfo),
+ Goal = hlds_goal(GoalExpr, GoalInfo),
+ trace [compiletime(flag("atomic_scope_syntax")), io(!IO)] (
+ io.write_string("atomic:\n", !IO),
+ module_info_get_globals(!.ModuleInfo, Globals),
+ OutInfo = init_hlds_out_info(Globals),
+ write_goal(OutInfo, Goal, !.ModuleInfo, !.VarSet, yes, 0, "\n",
+ !IO),
+ io.nl(!IO)
+ )
+ ;
+ Expr = trace_expr(MaybeCompileTime, MaybeRunTime, MaybeIO,
+ Mutables, SubExpr0),
+ list.map4(extract_trace_mutable_var(Context, !.VarSet), Mutables,
+ MutableHLDSs, MutableStateVars, MutableGetExprs, MutableSetExprs),
+ (
+ MaybeIO = yes(IOStateVar),
+ varset.lookup_name(!.VarSet, IOStateVar, IOStateVarName),
+ MaybeIOHLDS = yes(IOStateVarName),
+ extract_trace_io_var(Context, IOStateVar, IOGetExpr, IOSetExpr),
+ StateVars0 = [IOStateVar | MutableStateVars],
+ GetExprs = [IOGetExpr | MutableGetExprs],
+ SetExprs = [IOSetExpr | MutableSetExprs]
+ ;
+ MaybeIO = no,
+ MaybeIOHLDS = no,
+ StateVars0 = MutableStateVars,
+ GetExprs = MutableGetExprs,
+ SetExprs = MutableSetExprs
+ ),
+ SubExpr1 =
+ goal_list_to_conj(Context, GetExprs ++ [SubExpr0] ++ SetExprs),
+ BeforeSVarState = !.SVarState,
+ rename_var_list(need_not_rename, Renaming, StateVars0, StateVars),
+ svar_prepare_for_local_state_vars(Context, !.VarSet, StateVars,
+ BeforeSVarState, BeforeInsideSVarState, !Specs),
+ transform_goal_expr_context_to_goal(LocKind, SubExpr1, Renaming,
+ SubGoal, !:NumAdded, BeforeInsideSVarState, AfterInsideSVarState,
+ !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs),
+ !:NumAdded =
+ list.length(GetExprs) + !.NumAdded + list.length(SetExprs),
+ svar_finish_local_state_vars(StateVars, BeforeSVarState,
+ AfterInsideSVarState, AfterSVarState),
+ !:SVarState = AfterSVarState,
+ % The QuantVars field is a lie, but a white lie.
+ Reason = trace_goal(MaybeCompileTime, MaybeRunTime, MaybeIOHLDS,
+ MutableHLDSs, []),
+ GoalExpr = scope(Reason, SubGoal),
+ goal_info_init(GoalInfo),
+ Goal = hlds_goal(GoalExpr, GoalInfo)
+ ;
+ Expr = try_expr(MaybeIO0, SubExpr0, Then0, MaybeElse0,
+ Catches0, MaybeCatchAny0),
+ (
+ MaybeIO0 = yes(IOStateVar0),
+ (
+ MaybeElse0 = no,
+ rename_var(need_not_rename, Renaming, IOStateVar0, IOStateVar),
+ transform_try_expr_with_io(LocKind, IOStateVar0, IOStateVar,
+ SubExpr0, Then0, Catches0, MaybeCatchAny0, Context,
+ Renaming, Goal, !:NumAdded, !SVarState, !SVarStore,
+ !VarSet, !ModuleInfo, !QualInfo, !Specs)
+ ;
+ MaybeElse0 = yes(_),
+ Pieces = [words("Error: a `try' goal with an `io' parameter"),
+ words("cannot have an else part."), nl],
+ Msg = simple_msg(Context, [always(Pieces)]),
+ Spec = error_spec(severity_error,
+ phase_parse_tree_to_hlds, [Msg]),
+ !:Specs = [Spec | !.Specs],
+ Goal = true_goal,
+ !:NumAdded = 0
+ )
+ ;
+ MaybeIO0 = no,
+ transform_try_expr_without_io(LocKind, SubExpr0, Then0, MaybeElse0,
+ Catches0, MaybeCatchAny0, Context, Renaming, Goal, !:NumAdded,
+ !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs)
+ )
+ ;
+ Expr = if_then_else_expr(Vars0, StateVars0, Cond0, Then0, Else0),
+ BeforeSVarState = !.SVarState,
+ rename_var_list(need_not_rename, Renaming, Vars0, Vars),
+ rename_var_list(need_not_rename, Renaming, StateVars0, StateVars),
+ svar_prepare_for_local_state_vars(Context, !.VarSet, StateVars,
+ BeforeSVarState, BeforeCondSVarState, !Specs),
+ transform_goal_expr_context_to_goal(LocKind, Cond0, Renaming, Cond,
+ CondAdded, BeforeCondSVarState, AfterCondSVarState, !SVarStore,
+ !VarSet, !ModuleInfo, !QualInfo, !Specs),
+ transform_goal_expr_context_to_goal(LocKind, Then0, Renaming, Then1,
+ ThenAdded, AfterCondSVarState, AfterThenSVarState0, !SVarStore,
+ !VarSet, !ModuleInfo, !QualInfo, !Specs),
+ svar_finish_local_state_vars(StateVars, BeforeSVarState,
+ AfterThenSVarState0, AfterThenSVarState),
+ transform_goal_expr_context_to_goal(LocKind, Else0, Renaming, Else1,
+ ElseAdded, BeforeSVarState, AfterElseSVarState, !SVarStore,
+ !VarSet, !ModuleInfo, !QualInfo, !Specs),
+ !:NumAdded = CondAdded + ThenAdded + ElseAdded,
+ goal_info_init(Context, GoalInfo),
+ svar_finish_if_then_else(LocKind, Context, StateVars,
+ Then1, Then, Else1, Else,
+ BeforeSVarState, AfterCondSVarState, AfterThenSVarState,
+ AfterElseSVarState, !:SVarState, !VarSet, !SVarStore, !Specs),
+ GoalExpr = if_then_else(Vars, Cond, Then, Else),
+ Goal = hlds_goal(GoalExpr, GoalInfo)
+ ;
+ Expr = not_expr(SubExpr0),
+ % svar_prepare_for_negation(Context, BeforeOutsideState,
+ % BeforeInsideState),
+ % transform_goal_expr_context_to_goal(SubExpr0, Renaming, SubGoal,
+ % !:NumAdded, BeforeInsideState, AfterInsideState, !SVarStore,
+ % !VarSet, !ModuleInfo, !QualInfo, !Specs),
+ % svar_finish_negation(BeforeOutsideState, AfterInsideState,
+ % AfterOutsideState),
+ % !:SVarState = AfterOutsideState,
+ BeforeOutsideState = !.SVarState,
+ transform_goal_expr_context_to_goal(LocKind, SubExpr0, Renaming,
+ SubGoal, !:NumAdded, !.SVarState, _, !SVarStore,
+ !VarSet, !ModuleInfo, !QualInfo, !Specs),
+ !:SVarState = BeforeOutsideState,
+ GoalExpr = negation(SubGoal),
+ goal_info_init(GoalInfo),
+ Goal = hlds_goal(GoalExpr, GoalInfo)
+ ;
+ Expr = conj_expr(A0, B0),
+ get_rev_conj(LocKind, A0, Renaming, [], R0, 0, !:NumAdded,
+ !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs),
+ get_rev_conj(LocKind, B0, Renaming, R0, R, !NumAdded,
+ !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs),
+ L = list.reverse(R),
+ goal_info_init(GoalInfo),
+ conj_list_to_goal(L, GoalInfo, Goal)
+ ;
+ Expr = par_conj_expr(A0, B0),
+ get_rev_par_conj(LocKind, A0, Renaming, [], R0, 0, !:NumAdded,
+ !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs),
+ get_rev_par_conj(LocKind, B0, Renaming, R0, R, !NumAdded,
+ !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs),
+ L = list.reverse(R),
+ goal_info_init(GoalInfo),
+ par_conj_list_to_goal(L, GoalInfo, Goal)
+ ;
+ Expr = disj_expr(A0, B0),
+ SVarStateBefore = !.SVarState,
+ get_disj(LocKind, B0, Renaming, [], DisjunctsSVarStates1,
+ 0, !:NumAdded, SVarStateBefore, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs),
+ get_disj(LocKind, A0, Renaming,
+ DisjunctsSVarStates1, DisjunctsSVarStates,
+ !NumAdded, SVarStateBefore, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs),
+ svar_finish_disjunction(Context, DisjunctsSVarStates, Disjuncts,
+ !VarSet, SVarStateBefore, SVarStateAfter, !SVarStore),
+ !:SVarState = SVarStateAfter,
+ goal_info_init(Context, GoalInfo),
+ disj_list_to_goal(Disjuncts, GoalInfo, Goal)
+ ;
+ Expr = implies_expr(P, Q),
+ % `P => Q' is defined as `not (P, not Q)'
+ TransformedExpr = not_expr(conj_expr(P, not_expr(Q) - Context)
+ - Context),
+ transform_goal_expr_to_goal(LocKind, TransformedExpr, Context,
+ Renaming, Goal, !:NumAdded, !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs)
+ ;
+ Expr = equivalent_expr(P0, Q0),
+ % `P <=> Q' is defined as `(P => Q), (Q => P)',
+ % but that transformation must not be done until after quantification,
+ % lest the duplication of the goals concerned affect the implicit
+ % quantification of the variables inside them.
+
+ SVarStateBefore = !.SVarState,
+ transform_goal_expr_context_to_goal(LocKind, P0, Renaming, P,
+ NumAddedP, !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs),
+ transform_goal_expr_context_to_goal(LocKind, Q0, Renaming, Q,
+ NumAddedQ, !.SVarState, _, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs),
+ % XXX different from before
+ !:SVarState = SVarStateBefore,
+ !:NumAdded = NumAddedP + NumAddedQ,
+ GoalExpr = shorthand(bi_implication(P, Q)),
+ goal_info_init(GoalInfo),
+ Goal = hlds_goal(GoalExpr, GoalInfo)
+ ;
+ Expr = event_expr(EventName, Args0),
+ expand_bang_states(Args0, Args1),
+ % XXX svar_prepare_for_call(!SInfo),
+ rename_vars_in_term_list(need_not_rename, Renaming, Args1, Args),
+ make_fresh_arg_vars(Args, HeadVars, !VarSet, !SVarState, !Specs),
+ list.length(HeadVars, Arity),
+ list.duplicate(Arity, in_mode, Modes),
+ goal_info_init(Context, GoalInfo),
+ Details = event_call(EventName),
+ GoalExpr0 = generic_call(Details, HeadVars, Modes, detism_det),
+ Goal0 = hlds_goal(GoalExpr0, GoalInfo),
+ CallId = generic_call_id(gcid_event_call(EventName)),
+ insert_arg_unifications(HeadVars, Args, Context, ac_call(CallId),
+ Goal0, Goal, !:NumAdded, !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs),
+ svar_finish_atomic_goal(LocKind, !SVarState)
+ ;
+ Expr = call_expr(Name, Args0, Purity),
+ expand_bang_states(Args0, Args1),
+ (
+ Name = unqualified("\\="),
+ Args1 = [LHS, RHS]
+ ->
+ % XXX svar_prepare_for_call(!SVarState),
+ % `LHS \= RHS' is defined as `not (LHS = RHS)'
+ TransformedExpr = not_expr(unify_expr(LHS, RHS, Purity) - Context),
+ transform_goal_expr_to_goal(LocKind, TransformedExpr, Context,
+ Renaming, Goal, !:NumAdded, !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs)
+ ;
+ % check for a state var record assignment:
+ % !Var ^ field := Value
+ Name = unqualified(":="),
+ Args1 = [LHS0, RHS0],
+ LHS0 = functor(atom("^"), [StateVar0, Remainder],
+ FieldListContext),
+ StateVar0 = functor(atom("!"), Args @ [variable(_, _)],
+ StateVarContext)
+ ->
+ % !Var ^ field := Value is defined as
+ % !:Var = !.Var ^ field := Value.
+ LHS = functor(atom("!:"), Args, StateVarContext),
+ StateVar = functor(atom("!."), Args, StateVarContext),
+ FieldList = functor(atom("^"), [StateVar, Remainder],
+ FieldListContext),
+ RHS = functor(atom(":="), [FieldList, RHS0], Context),
+ TransformedExpr = unify_expr(LHS, RHS, Purity),
+ transform_goal_expr_to_goal(LocKind, TransformedExpr, Context,
+ Renaming, Goal, !:NumAdded, !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs)
+ ;
+ % check for a DCG field access goal:
+ % get: Field =^ field
+ % set: ^ field := Field
+ ( Name = unqualified(Operator) ),
+ ( Operator = "=^"
+ ; Operator = ":="
+ )
+ ->
+ rename_vars_in_term_list(need_not_rename, Renaming, Args1, Args2),
+ transform_dcg_record_syntax(LocKind, Operator, Args2, Context,
+ Goal, !:NumAdded, !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs)
+ ;
+ % XXX svar_prepare_for_call(!SInfo),
+ rename_vars_in_term_list(need_not_rename, Renaming, Args1, Args),
+ make_fresh_arg_vars(Args, HeadVars, !VarSet, !SVarState, !Specs),
+ list.length(Args, Arity),
+ (
+ % Check for a higher-order call,
+ % i.e. a call to either call/N or ''/N.
+ ( Name = unqualified("call")
+ ; Name = unqualified("")
+ ),
+ HeadVars = [PredVar | RealHeadVars]
+ ->
+ % Initialize some fields to junk.
+ Modes = [],
+ Det = detism_erroneous,
+
+ GenericCall = higher_order(PredVar, Purity, pf_predicate,
+ Arity),
+ Call = generic_call(GenericCall, RealHeadVars, Modes, Det),
+
+ hlds_goal.generic_call_id(GenericCall, CallId)
+ ;
+ % Initialize some fields to junk.
+ PredId = invalid_pred_id,
+ ModeId = invalid_proc_id,
+
+ MaybeUnifyContext = no,
+ Call = plain_call(PredId, ModeId, HeadVars, not_builtin,
+ MaybeUnifyContext, Name),
+ CallId =
+ plain_call_id(simple_call_id(pf_predicate, Name, Arity))
+ ),
+ goal_info_init(Context, GoalInfo0),
+ goal_info_set_purity(Purity, GoalInfo0, GoalInfo),
+ Goal0 = hlds_goal(Call, GoalInfo),
+
+ record_called_pred_or_func(pf_predicate, Name, Arity, !QualInfo),
+ insert_arg_unifications(HeadVars, Args, Context, ac_call(CallId),
+ Goal0, Goal, !:NumAdded, !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs)
+ ),
+ svar_finish_atomic_goal(LocKind, !SVarState)
+ ;
+ Expr = unify_expr(A0, B0, Purity),
+ rename_vars_in_term(need_not_rename, Renaming, A0, A),
+ rename_vars_in_term(need_not_rename, Renaming, B0, B),
+ % It is an error for the left or right hand side of a
+ % unification to be !X (it may be !.X or !:X, however).
+ ( A = functor(atom("!"), [variable(StateVarA, _)], _) ->
+ report_svar_unify_error(Context, !.VarSet, StateVarA, !Specs),
+ Goal = true_goal,
+ !:NumAdded = 0
+ ; B = functor(atom("!"), [variable(StateVarB, _)], _) ->
+ report_svar_unify_error(Context, !.VarSet, StateVarB, !Specs),
+ Goal = true_goal,
+ !:NumAdded = 0
+ ;
+ % XXX svar_prepare_for_call(!SInfo),
+ unravel_unification(A, B, Context, umc_explicit, [], Purity, Goal,
+ !:NumAdded, !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs),
+ svar_finish_atomic_goal(LocKind, !SVarState)
+ )
+ ).
+
+:- pred extract_trace_mutable_var(prog_context::in, prog_varset::in,
+ trace_mutable_var::in, trace_mutable_var_hlds::out,
+ prog_var::out, goal::out, goal::out) is det.
+
+extract_trace_mutable_var(Context, VarSet, Mutable, MutableHLDS, StateVar,
+ GetGoal, SetGoal) :-
+ Mutable = trace_mutable_var(MutableName, StateVar),
+ varset.lookup_name(VarSet, StateVar, StateVarName),
+ MutableHLDS = trace_mutable_var_hlds(MutableName, StateVarName),
+ GetPredName = unqualified("get_" ++ MutableName),
+ SetPredName = unqualified("set_" ++ MutableName),
+ SetVar = functor(atom("!:"), [variable(StateVar, Context)], Context),
+ UseVar = functor(atom("!."), [variable(StateVar, Context)], Context),
+ GetPurity = purity_semipure,
+ SetPurity = purity_impure,
+ GetGoal = call_expr(GetPredName, [SetVar], GetPurity) - Context,
+ SetGoal = call_expr(SetPredName, [UseVar], SetPurity) - Context.
+
+:- pred extract_trace_io_var(prog_context::in, prog_var::in,
+ goal::out, goal::out) is det.
+
+extract_trace_io_var(Context, StateVar, GetGoal, SetGoal) :-
+ Builtin = mercury_private_builtin_module,
+ GetPredName = qualified(Builtin, "trace_get_io_state"),
+ SetPredName = qualified(Builtin, "trace_set_io_state"),
+ SetVar = functor(atom("!:"), [variable(StateVar, Context)], Context),
+ UseVar = functor(atom("!."), [variable(StateVar, Context)], Context),
+ GetPurity = purity_semipure,
+ SetPurity = purity_impure,
+ GetGoal = call_expr(GetPredName, [SetVar], GetPurity) - Context,
+ SetGoal = call_expr(SetPredName, [UseVar], SetPurity) - Context.
+
+:- pred transform_promise_eqv_goal(loc_kind::in,
+ list(prog_var)::in, list(prog_var)::in,
+ list(prog_var)::in, list(prog_var)::in,
+ prog_context::in, prog_var_renaming::in, list(prog_var)::out,
+ goal::in, hlds_goal::out, hlds_goal_info::out, int::out,
+ svar_state::in, svar_state::out, svar_store::in, svar_store::out,
+ prog_varset::in, prog_varset::out, module_info::in, module_info::out,
+ qual_info::in, qual_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+transform_promise_eqv_goal(LocKind, Vars0, StateVars0, DotSVars0, ColonSVars0,
+ Context, Renaming, QuantVars, Goal0, Goal, GoalInfo, NumAdded,
+ !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs) :-
+ rename_var_list(need_not_rename, Renaming, Vars0, Vars),
+ rename_var_list(need_not_rename, Renaming, StateVars0, StateVars1),
+ rename_var_list(need_not_rename, Renaming, DotSVars0, DotSVars1),
+ rename_var_list(need_not_rename, Renaming, ColonSVars0, ColonSVars1),
+ list.map_foldl3(lookup_dot_state_var(Context), StateVars1, OldStateVars,
+ !VarSet, !SVarState, !Specs),
+ list.map_foldl3(lookup_dot_state_var(Context), DotSVars1, DotSVars,
+ !VarSet, !SVarState, !Specs),
+ transform_goal_expr_context_to_goal(LocKind, Goal0, Renaming, Goal,
+ NumAdded, !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs),
+ goal_info_init(GoalInfo),
+ list.map_foldl3(lookup_dot_state_var(Context), StateVars1, NewStateVars,
+ !VarSet, !SVarState, !Specs),
+ list.map_foldl3(lookup_dot_state_var(Context), ColonSVars1, ColonSVars,
+ !VarSet, !SVarState, !Specs),
+ QuantVars = Vars ++ OldStateVars ++ NewStateVars ++ DotSVars ++ ColonSVars.
+
+:- pred report_svar_unify_error(prog_context::in, prog_varset::in, svar::in,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+report_svar_unify_error(Context, VarSet, StateVar, !Specs) :-
+ Name = varset.lookup_name(VarSet, StateVar),
+ Pieces = [words("Error:"), fixed("!" ++ Name),
+ words("cannot appear as a unification argument."), nl,
+ words("You probably meant"), fixed("!." ++ Name),
+ words("or"), fixed("!:" ++ Name), suffix(".")],
+ Msg = simple_msg(Context, [always(Pieces)]),
+ Spec = error_spec(severity_error, phase_parse_tree_to_hlds, [Msg]),
+ !:Specs = [Spec | !.Specs].
+
+:- inst dcg_record_syntax_op == bound("=^"; ":=").
+
+:- pred transform_dcg_record_syntax(loc_kind::in,
+ string::in(dcg_record_syntax_op), list(prog_term)::in, prog_context::in,
+ hlds_goal::out, int::out,
+ svar_state::in, svar_state::out, svar_store::in, svar_store::out,
+ prog_varset::in, prog_varset::out,
+ module_info::in, module_info::out, qual_info::in, qual_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+transform_dcg_record_syntax(LocKind, Operator, ArgTerms0, Context, Goal,
+ NumAdded, !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs) :-
+ goal_info_init(Context, GoalInfo),
+ (
+ ArgTerms0 = [LHSTerm, RHSTerm, TermInputTerm, TermOutputTerm],
+ (
+ Operator = "=^",
+ AccessType = get,
+ FieldNameTerm = RHSTerm,
+ FieldValueTerm = LHSTerm
+ ;
+ Operator = ":=",
+ AccessType = set,
+ LHSTerm = term.functor(term.atom("^"), [FieldNameTerm0], _),
+ FieldNameTerm = FieldNameTerm0,
+ FieldValueTerm = RHSTerm
+ )
+ ->
+ ContextPieces = dcg_field_error_context_pieces(AccessType),
+ parse_field_list(FieldNameTerm, !.VarSet, ContextPieces,
+ MaybeFieldNames),
+ (
+ MaybeFieldNames = ok1(FieldNames),
+ ArgTerms = [FieldValueTerm, TermInputTerm, TermOutputTerm],
+ transform_dcg_record_syntax_2(AccessType, FieldNames, ArgTerms,
+ Context, Goal, NumAdded, !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs),
+ svar_finish_atomic_goal(LocKind, !SVarState)
+ ;
+ MaybeFieldNames = error1(FieldNamesSpecs),
+ !:Specs = FieldNamesSpecs ++ !.Specs,
+ invalid_goal("^", ArgTerms0, GoalInfo, Goal, !VarSet,
+ !SVarState, !Specs),
+ NumAdded = 0,
+ qual_info_set_found_syntax_error(yes, !QualInfo)
+ )
+ ;
+ invalid_goal("^", ArgTerms0, GoalInfo, Goal, !VarSet, !SVarState,
+ !Specs),
+ NumAdded = 0,
+ qual_info_set_found_syntax_error(yes, !QualInfo),
+ Pieces = [words("Error: expected `Field =^ field1 ^ ... ^ fieldN'"),
+ words("or `^ field1 ^ ... ^ fieldN := Field'"),
+ words("in DCG field access goal."), nl],
+ Msg = simple_msg(Context, [always(Pieces)]),
+ Spec = error_spec(severity_error, phase_parse_tree_to_hlds, [Msg]),
+ !:Specs = [Spec | !.Specs]
+ ).
+
+:- pred transform_dcg_record_syntax_2(field_access_type::in, field_list::in,
+ list(prog_term)::in, prog_context::in, hlds_goal::out,
+ num_added_goals::out,
+ svar_state::in, svar_state::out, svar_store::in, svar_store::out,
+ prog_varset::in, prog_varset::out,
+ module_info::in, module_info::out, qual_info::in, qual_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+transform_dcg_record_syntax_2(AccessType, FieldNames, ArgTerms, Context, Goal,
+ NumAdded, !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs) :-
+ make_fresh_arg_vars(ArgTerms, ArgVars, !VarSet, !SVarState, !Specs),
+ ( ArgVars = [FieldValueVar, TermInputVar, TermOutputVar] ->
+ (
+ AccessType = set,
+ expand_set_field_function_call(Context, umc_explicit, [],
+ FieldNames, FieldValueVar, TermInputVar, TermOutputVar,
+ Functor, InnermostFunctor - InnermostSubContext, Goal0,
+ SetAdded, !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs),
+
+ FieldArgNumber = 2,
+ FieldArgContext = ac_functor(InnermostFunctor, umc_explicit,
+ InnermostSubContext),
+ InputTermArgNumber = 1,
+ InputTermArgContext = ac_functor(Functor, umc_explicit, []),
+ ( Functor = cons(FuncNamePrime, FuncArityPrime, _TypeCtor) ->
+ FuncName = FuncNamePrime,
+ FuncArity = FuncArityPrime
+ ;
+ unexpected($module, $pred, "not cons")
+ ),
+ % DCG arguments should always be distinct variables,
+ % so this context should never be used.
+ OutputTermArgNumber = 3,
+ SimpleCallId = simple_call_id(pf_function, FuncName, FuncArity),
+ OutputTermArgContext = ac_call(plain_call_id(SimpleCallId)),
+
+ ArgContexts = [
+ FieldArgNumber - FieldArgContext,
+ InputTermArgNumber - InputTermArgContext,
+ OutputTermArgNumber - OutputTermArgContext
+ ],
+ insert_arg_unifications_with_supplied_contexts(ArgVars, ArgTerms,
+ ArgContexts, Context, Goal0, Goal, ArgAdded,
+ !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs),
+ NumAdded = SetAdded + ArgAdded
+ ;
+ AccessType = get,
+ expand_dcg_field_extraction_goal(Context, umc_explicit, [],
+ FieldNames, FieldValueVar, TermInputVar, TermOutputVar,
+ Functor, InnermostFunctor - _InnerSubContext, Goal0,
+ ExtractAdded, !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs),
+ InputTermArgNumber = 1,
+ InputTermArgContext = ac_functor(Functor, umc_explicit, []),
+
+ ( InnermostFunctor = cons(FuncNamePrime, FuncArityPrime, _TC) ->
+ FuncName = FuncNamePrime,
+ FuncArity = FuncArityPrime
+ ;
+ unexpected($module, $pred, "not cons")
+ ),
+ FieldArgNumber = 2,
+ SimpleCallId = simple_call_id(pf_function, FuncName, FuncArity),
+ FieldArgContext = ac_call(plain_call_id(SimpleCallId)),
+
+ % DCG arguments should always be distinct variables,
+ % so this context should never be used.
+ OutputTermArgNumber = 1,
+ OutputTermArgContext = ac_functor(Functor, umc_explicit, []),
+ ArgContexts = [
+ FieldArgNumber - FieldArgContext,
+ InputTermArgNumber - InputTermArgContext,
+ OutputTermArgNumber - OutputTermArgContext
+ ],
+ insert_arg_unifications_with_supplied_contexts(ArgVars, ArgTerms,
+ ArgContexts, Context, Goal0, Goal, ArgAdded,
+ !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs),
+ NumAdded = ExtractAdded + ArgAdded
+ )
+ ;
+ unexpected($module, $pred, "arity != 3")
+ ).
+
+ % get_rev_conj(LocKind, Goal, Renaming, RevConj0, RevConj, ...):
+ %
+ % Goal is a tree of conjuncts. Flatten it into a list (applying Renaming),
+ % reverse it, append RevConj0, and return the result in RevConj.
+ %
+:- pred get_rev_conj(loc_kind::in, goal::in, prog_var_renaming::in,
+ list(hlds_goal)::in, list(hlds_goal)::out,
+ num_added_goals::in, num_added_goals::out,
+ svar_state::in, svar_state::out, svar_store::in, svar_store::out,
+ prog_varset::in, prog_varset::out, module_info::in, module_info::out,
+ qual_info::in, qual_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+get_rev_conj(LocKind, Goal, Renaming, RevConj0, RevConj, !NumAdded,
+ !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs) :-
+ ( Goal = conj_expr(A, B) - _Context ->
+ get_rev_conj(LocKind, A, Renaming, RevConj0, RevConj1, !NumAdded,
+ !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs),
+ get_rev_conj(LocKind, B, Renaming, RevConj1, RevConj, !NumAdded,
+ !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs)
+ ;
+ transform_goal_expr_context_to_goal(LocKind, Goal, Renaming, Goal1,
+ GoalAdded, !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs),
+ !:NumAdded = !.NumAdded + GoalAdded,
+ goal_to_conj_list(Goal1, ConjList),
+ RevConj = list.reverse(ConjList) ++ RevConj0
+ ).
+
+ % get_rev_par_conj(LocKind, Goal, Renaming, RevParConj0, RevParConj, ...):
+ %
+ % Goal is a tree of conjuncts. Flatten it into a list (applying Renaming),
+ % reverse it, append RevParConj0, and return the result in RevParConj.
+ %
+:- pred get_rev_par_conj(loc_kind::in, goal::in, prog_var_renaming::in,
+ list(hlds_goal)::in, list(hlds_goal)::out,
+ num_added_goals::in, num_added_goals::out,
+ svar_state::in, svar_state::out, svar_store::in, svar_store::out,
+ prog_varset::in, prog_varset::out, module_info::in, module_info::out,
+ qual_info::in, qual_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+get_rev_par_conj(LocKind, Goal, Renaming, RevParConj0, RevParConj, !NumAdded,
+ !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs) :-
+ ( Goal = par_conj_expr(A, B) - _Context ->
+ get_rev_par_conj(LocKind, A, Renaming, RevParConj0, RevParConj1,
+ !NumAdded, !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs),
+ get_rev_par_conj(LocKind, B, Renaming, RevParConj1, RevParConj,
+ !NumAdded, !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs)
+ ;
+ transform_goal_expr_context_to_goal(LocKind, Goal, Renaming, Goal1,
+ GoalAdded, !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs),
+ !:NumAdded = !.NumAdded + GoalAdded,
+ goal_to_par_conj_list(Goal1, ParConjList),
+ RevParConj = list.reverse(ParConjList) ++ RevParConj0
+ ).
+
+ % get_disj(LocKind, Goal, Renaming, Disj0, Disj, ...):
+ %
+ % Goal is a tree of disjuncts. Flatten it into a list (applying Renaming),
+ % append Disj0, and return the result in Disj.
+ %
+:- pred get_disj(loc_kind::in, goal::in, prog_var_renaming::in,
+ list(hlds_goal_svar_state)::in, list(hlds_goal_svar_state)::out,
+ num_added_goals::in, num_added_goals::out,
+ svar_state::in, svar_store::in, svar_store::out,
+ prog_varset::in, prog_varset::out,
+ module_info::in, module_info::out, qual_info::in, qual_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+get_disj(LocKind, Goal, Renaming, DisjStates0, DisjStates, !NumAdded,
+ SVarStateBefore, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs) :-
+ ( Goal = disj_expr(A, B) - _Context ->
+ % We recurse on the *second* arm first, so that we will put the
+ % disjuncts from *that* arm at the front of DisjStates0, before
+ % putting the disjuncts from the first arm at the front of the
+ % resulting DisjStates1. This way, the overall result, DisjStates,
+ % will have the disjuncts and their svar_infos in the correct order.
+ get_disj(LocKind, B, Renaming, DisjStates0, DisjStates1, !NumAdded,
+ SVarStateBefore, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs),
+ get_disj(LocKind, A, Renaming, DisjStates1, DisjStates, !NumAdded,
+ SVarStateBefore, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs)
+ ;
+ transform_goal_expr_context_to_goal(LocKind, Goal, Renaming,
+ HLDSGoal, GoalAdded, SVarStateBefore, SVarStateAfterDisjunct,
+ !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs),
+ !:NumAdded = !.NumAdded + GoalAdded,
+ DisjState = hlds_goal_svar_state(HLDSGoal, SVarStateAfterDisjunct),
+ DisjStates = [DisjState | DisjStates0]
+ ).
+
+:- pred transform_orelse_goals(loc_kind::in, list(goal)::in,
+ prog_var_renaming::in, list(hlds_goal_svar_state)::out,
+ num_added_goals::in, num_added_goals::out,
+ svar_state::in, svar_store::in, svar_store::out,
+ prog_varset::in, prog_varset::out, module_info::in, module_info::out,
+ qual_info::in, qual_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+transform_orelse_goals(_, [], _, [], !NumAdded, _SVarStateBefore, !SVarState,
+ !VarSet, !ModuleInfo, !QualInfo, !Specs).
+transform_orelse_goals(LocKind, [Goal | Goals], Renaming,
+ [DisjState | DisjStates], !NumAdded, SVarStateBefore, !SVarStore,
+ !VarSet, !ModuleInfo, !QualInfo, !Specs) :-
+ transform_goal_expr_context_to_goal(LocKind, Goal, Renaming, HLDSGoal,
+ NumAddedGoal, SVarStateBefore, SVarStateAfterDisjunct, !SVarStore,
+ !VarSet, !ModuleInfo, !QualInfo, !Specs),
+ DisjState = hlds_goal_svar_state(HLDSGoal, SVarStateAfterDisjunct),
+ !:NumAdded = !.NumAdded + NumAddedGoal,
+ transform_orelse_goals(LocKind, Goals, Renaming, DisjStates, !NumAdded,
+ SVarStateBefore, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs).
+
+%----------------------------------------------------------------------------%
+%
+% Try goals.
+%
+
+ % Transform a try_expr which needs to perform I/O. The end result looks
+ % like:
+ %
+ % magic_exception_result(TryResult),
+ % (
+ % TryResult = succeeded({}),
+ % some [] (
+ % !:IO = !.IO,
+ % Goal
+ % ),
+ % some [] ( Then )
+ % ;
+ % TryResult = exception(Excp),
+ % ExcpHandling
+ % )
+ %
+ % Unlike in the non-I/O case, we have to transform the three pieces Goal,
+ % Then, ExcpHandling separately then stitch them together into HLDS goals.
+ % This is because we need to find out the variable for !.IO at the end of
+ % Goal, before entering Then. The variable will be used in the later
+ % post-transformation.
+ %
+:- pred transform_try_expr_with_io(loc_kind::in, svar::in, svar::in,
+ goal::in, goal::in, list(catch_expr)::in, maybe(catch_any_expr)::in,
+ prog_context::in, prog_var_renaming::in, hlds_goal::out,
+ num_added_goals::out,
+ svar_state::in, svar_state::out, svar_store::in, svar_store::out,
+ prog_varset::in, prog_varset::out, module_info::in, module_info::out,
+ qual_info::in, qual_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+transform_try_expr_with_io(LocKind, IOStateVarUnrenamed, IOStateVar, Goal0,
+ Then0, Catches0, MaybeCatchAny0, Context, Renaming, TryGoal, NumAdded,
+ !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs) :-
+ varset.new_named_var(!.VarSet, "TryResult", ResultVar, !:VarSet),
+ varset.new_var(!.VarSet, ExcpVar, !:VarSet),
+
+ ResultVarTerm = variable(ResultVar, Context),
+ ExcpVarTerm = variable(ExcpVar, Context),
+ NullTupleTerm = functor(atom("{}"), [], Context),
+
+ goal_info_init(Context, GoalInfo),
+
+ % Make the call to magic_exception_result.
+ CallMagic0 = call_expr(magic_exception_result_sym_name, [ResultVarTerm],
+ purity_pure) - Context,
+ transform_goal_expr_context_to_goal(LocKind, CallMagic0, Renaming,
+ CallMagic, NumAddedA, !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs),
+
+ % Get the variable for !.IO before the (eventual) try_io call.
+ lookup_dot_state_var(Context, IOStateVar, IOStateVarBefore,
+ !VarSet, !SVarState, !Specs),
+
+ SVarStateBeforeDisjunction = !.SVarState,
+
+ % Build "TryResult = succeeded({})".
+ ResultIsSucceededUnify0 =
+ unify_expr(
+ ResultVarTerm,
+ exception_functor("succeeded", NullTupleTerm, Context),
+ purity_pure
+ ) - Context,
+ transform_goal_expr_context_to_goal(LocKind, ResultIsSucceededUnify0,
+ Renaming, ResultIsSucceededUnify, NumAddedB, !SVarState, !SVarStore,
+ !VarSet, !ModuleInfo, !QualInfo, !Specs),
+
+ % Build "some [] ( !:IO = !.IO, Goal )".
+ %
+ % The explicit unification avoids a degenerate case where Goal doesn't bind
+ % the final !:IO variable, which would lead to trouble later when we move
+ % Goal into its own lambda.
+ IOUnify = unify_expr(
+ functor(atom("!:"), [variable(IOStateVarUnrenamed, Context)], Context),
+ functor(atom("!."), [variable(IOStateVarUnrenamed, Context)], Context),
+ purity_pure
+ ) - Context,
+ ScopedGoal0 = some_expr([], conj_expr(IOUnify, Goal0) - Context) - Context,
+ transform_goal_expr_context_to_goal(LocKind, ScopedGoal0, Renaming,
+ ScopedGoal, NumAddedC, !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs),
+
+ % Remember the variable for !.IO after the (eventual) try_io Goal.
+ lookup_dot_state_var(Context, IOStateVar, IOStateVarAfter,
+ !VarSet, !SVarState, !Specs),
+
+ % Build "some [] ( Then )".
+ ScopedThen0 = some_expr([], Then0) - Context,
+ transform_goal_expr_context_to_goal(LocKind, ScopedThen0, Renaming,
+ ScopedThen, NumAddedD, !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs),
+
+ % Build:
+ %
+ % TryResult = succeeded({}),
+ % some [] ( !:IO = !.IO, Goal ),
+ % some [] ( Then )
+ %
+ conj_list_to_goal([ResultIsSucceededUnify, ScopedGoal, ScopedThen],
+ GoalInfo, ResultIsSucceededDisjunct),
+
+ SVarStateAfterResultIsSucceededDisjunct = !.SVarState,
+ !:SVarState = SVarStateBeforeDisjunction,
+
+ % Build the disjunct for "TryResult = exception(Excp), ...".
+ make_exception_handling_disjunct(ResultVarTerm, ExcpVarTerm, Catches0,
+ MaybeCatchAny0, Context, ResultIsExceptionDisjunct0),
+ transform_goal_expr_context_to_goal(LocKind, ResultIsExceptionDisjunct0,
+ Renaming, ResultIsExceptionDisjunct, NumAddedE, !SVarState, !SVarStore,
+ !VarSet, !ModuleInfo, !QualInfo, !Specs),
+
+ SVarStateAfterResultIsExceptionDisjunct = !.SVarState,
+
+ % Get the disjuncts.
+ DisjunctSVarStates = [
+ hlds_goal_svar_state(ResultIsSucceededDisjunct,
+ SVarStateAfterResultIsSucceededDisjunct),
+ hlds_goal_svar_state(ResultIsExceptionDisjunct,
+ SVarStateAfterResultIsExceptionDisjunct)
+ ],
+ svar_finish_disjunction(Context, DisjunctSVarStates, Disjuncts, !VarSet,
+ SVarStateBeforeDisjunction, !:SVarState, !SVarStore),
+ disj_list_to_goal(Disjuncts, GoalInfo, Disjunction),
+
+ % Build the call to magic_exception_result followed by the disjunction.
+ conj_list_to_goal([CallMagic, Disjunction], GoalInfo,
+ CallMagicThenDisjunction),
+
+ IOStateVars = try_io_state_vars(IOStateVarBefore, IOStateVarAfter),
+ GoalExpr = shorthand(try_goal(yes(IOStateVars), ResultVar,
+ CallMagicThenDisjunction)),
+ TryGoal = hlds_goal(GoalExpr, GoalInfo),
+
+ NumAdded = NumAddedA + NumAddedB + NumAddedC + NumAddedD + NumAddedE.
+
+ % Transform a try_expr which does not need I/O.
+ %
+ % If the try goal has an else part, the end result looks like:
+ %
+ % magic_exception_result(TryResult),
+ % (
+ % TryResult = succeeded({}),
+ % ( Goal ->
+ % Then
+ % ;
+ % Else
+ % )
+ % ;
+ % TryResult = exception(Excp),
+ % ExcpHandling
+ % )
+ %
+ % If the try goal does not have an else part, the end result looks like:
+ %
+ % magic_exception_result(TryResult),
+ % (
+ % TryResult = succeeded({}),
+ % some [] ( Goal ),
+ % some [] ( Then )
+ % ;
+ % TryResult = exception(Excp),
+ % ExcpHandling
+ % )
+ %
+:- pred transform_try_expr_without_io(loc_kind::in, goal::in, goal::in,
+ maybe(goal)::in, list(catch_expr)::in, maybe(catch_any_expr)::in,
+ prog_context::in, prog_var_renaming::in, hlds_goal::out,
+ num_added_goals::out,
+ svar_state::in, svar_state::out, svar_store::in, svar_store::out,
+ prog_varset::in, prog_varset::out, module_info::in, module_info::out,
+ qual_info::in, qual_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+transform_try_expr_without_io(LocKind, Goal0, Then0, MaybeElse0, Catches0,
+ MaybeCatchAny0, Context, Renaming, TryGoal, NumAdded,
+ !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs) :-
+ varset.new_named_var(!.VarSet, "TryResult", ResultVar, !:VarSet),
+ varset.new_var(!.VarSet, ExcpVar, !:VarSet),
+
+ ResultVarTerm = variable(ResultVar, Context),
+ ExcpVarTerm = variable(ExcpVar, Context),
+ NullTupleTerm = functor(atom("{}"), [], Context),
+
+ goal_info_init(Context, GoalInfo),
+
+ % Build the call to magic_exception_result.
+ CallMagic0 = call_expr(magic_exception_result_sym_name, [ResultVarTerm],
+ purity_pure) - Context,
+
+ % Build "TryResult = succeeded({}), ..." disjunct.
+ ResultIsSucceededUnify0 =
+ unify_expr(
+ ResultVarTerm,
+ exception_functor("succeeded", NullTupleTerm, Context),
+ purity_pure
+ ) - Context,
+ (
+ MaybeElse0 = yes(Else0),
+ SucceededSubGoal =
+ if_then_else_expr([], [], Goal0, Then0, Else0) - Context
+ ;
+ MaybeElse0 = no,
+ SucceededSubGoal =
+ conj_expr(
+ some_expr([], Goal0) - Context,
+ some_expr([], Then0) - Context
+ ) - Context
+ ),
+ ResultIsSucceededDisjunct0 =
+ conj_expr(ResultIsSucceededUnify0, SucceededSubGoal) - Context,
+
+ % Build the disjunct for "TryResult = exception(Excp), ...".
+ make_exception_handling_disjunct(ResultVarTerm, ExcpVarTerm, Catches0,
+ MaybeCatchAny0, Context, ResultIsExceptionDisjunct0),
+
+ % Build the call followed by the disjunction.
+ CallMagicThenDisjunction0 =
+ conj_expr(
+ CallMagic0,
+ disj_expr(
+ ResultIsSucceededDisjunct0,
+ ResultIsExceptionDisjunct0
+ ) - Context
+ ) - Context,
+ transform_goal_expr_context_to_goal(LocKind, CallMagicThenDisjunction0,
+ Renaming, CallMagicThenDisjunction, NumAdded, !SVarState, !SVarStore,
+ !VarSet, !ModuleInfo, !QualInfo, !Specs),
+
+ GoalExpr = shorthand(try_goal(no, ResultVar, CallMagicThenDisjunction)),
+ TryGoal = hlds_goal(GoalExpr, GoalInfo).
+
+:- pred make_exception_handling_disjunct(prog_term::in, prog_term::in,
+ list(catch_expr)::in, maybe(catch_any_expr)::in, prog_context::in,
+ goal::out) is det.
+
+make_exception_handling_disjunct(ResultVarTerm, ExcpVarTerm, Catches,
+ MaybeCatchAny, Context, Goal) :-
+ ResultIsExceptionUnify =
+ unify_expr(
+ ResultVarTerm,
+ exception_functor("exception", ExcpVarTerm, Context),
+ purity_pure
+ ) - Context,
+ make_catch_ite_chain(ResultVarTerm, ExcpVarTerm, Catches, MaybeCatchAny,
+ CatchChain),
+ Goal = conj_expr(ResultIsExceptionUnify, CatchChain) - Context.
+
+:- pred make_catch_ite_chain(prog_term::in, prog_term::in,
+ list(catch_expr)::in, maybe(catch_any_expr)::in, goal::out) is det.
+
+make_catch_ite_chain(ResultVarTerm, ExcpVarTerm, Catches, MaybeCatchAny,
+ Goal) :-
+ (
+ Catches = [catch_expr(FirstPattern, FirstGoal) | RestCatches],
+ make_catch_ite_chain(ResultVarTerm, ExcpVarTerm, RestCatches,
+ MaybeCatchAny, ElseGoal),
+ make_catch_pattern_unify_goal(FirstPattern, ExcpVarTerm,
+ FirstPatternGoal),
+ Goal = if_then_else_expr([], [], FirstPatternGoal, FirstGoal,
+ ElseGoal) - get_term_context(FirstPattern)
+ ;
+ Catches = [],
+ (
+ MaybeCatchAny = yes(catch_any_expr(CatchAnyVar, CatchAnyGoal)),
+ % With a catch_any part, end the if-then-else chain with:
+ % CatchAnyVar = exc_univ_value(Excp),
+ % CatchAnyGoal
+ CatchAnyGoal = _ - Context,
+ GetUnivValue = unify_expr(
+ variable(CatchAnyVar, Context),
+ exception_functor("exc_univ_value", ExcpVarTerm, Context),
+ purity_pure) - Context,
+ Goal = conj_expr(GetUnivValue, CatchAnyGoal) - Context
+ ;
+ MaybeCatchAny = no,
+ % Without a catch_any part, end the if-then-else chain
+ % by rethrowing the exception.
+ Rethrow = qualified(mercury_exception_module, "rethrow"),
+ Goal = call_expr(Rethrow, [ResultVarTerm], purity_pure)
+ - get_term_context(ExcpVarTerm)
+ )
+ ).
+
+:- pred make_catch_pattern_unify_goal(prog_term::in, prog_term::in,
+ goal::out) is det.
+
+make_catch_pattern_unify_goal(CatchPatternTerm, ExcpVarTerm, Goal) :-
+ GoalExpr = call_expr(
+ qualified(mercury_exception_module, "exc_univ_to_type"),
+ [ExcpVarTerm, CatchPatternTerm], purity_pure),
+ Goal = GoalExpr - get_term_context(CatchPatternTerm).
+
+:- func magic_exception_result_sym_name = sym_name.
+
+magic_exception_result_sym_name =
+ qualified(mercury_exception_module, "magic_exception_result").
+
+:- func exception_functor(string, prog_term, term.context) = prog_term.
+
+exception_functor(Atom, Arg, Context) = Term :-
+ construct_qualified_term(qualified(mercury_exception_module, Atom),
+ [Arg], Context, Term).
+
+%----------------------------------------------------------------------------%
+
+:- func dcg_field_error_context_pieces(field_access_type) =
+ list(format_component).
+
+dcg_field_error_context_pieces(AccessType) = ContextPieces :-
+ (
+ AccessType = set,
+ ContextPieces = [words("In DCG field update goal:"), nl]
+ ;
+ AccessType = get,
+ ContextPieces = [words("In DCG field extraction goal:"), nl]
+ ).
+
+ % Produce an invalid goal.
+ %
+:- pred invalid_goal(string::in, list(prog_term)::in, hlds_goal_info::in,
+ hlds_goal::out, prog_varset::in, prog_varset::out,
+ svar_state::in, svar_state::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+invalid_goal(UpdateStr, Args0, GoalInfo, Goal, !VarSet, !SVarState, !Specs) :-
+ make_fresh_arg_vars(Args0, HeadVars, !VarSet, !SVarState, !Specs),
+ MaybeUnifyContext = no,
+ GoalExpr = plain_call(invalid_pred_id, invalid_proc_id, HeadVars,
+ not_builtin, MaybeUnifyContext, unqualified(UpdateStr)),
+ Goal = hlds_goal(GoalExpr, GoalInfo).
+
+%----------------------------------------------------------------------------%
Index: compiler/goal_path.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/goal_path.m,v
retrieving revision 1.59
diff -u -b -r1.59 goal_path.m
--- compiler/goal_path.m 27 Jan 2011 08:03:52 -0000 1.59
+++ compiler/goal_path.m 26 Feb 2011 04:49:11 -0000
@@ -114,13 +114,13 @@
fill_slots_in_clause(SlotInfo, Clause0, Clause, !GoalNum, !ClauseNum,
!ContainingGoalMap) :-
- Clause0 = clause(ProcIds, Goal0, Lang, Context),
+ Goal0 = Clause0 ^ clause_body,
ContainingGoal = containing_goal(whole_body_goal_id,
step_disj(!.ClauseNum)),
!:ClauseNum = !.ClauseNum + 1,
fill_goal_id_slots(SlotInfo, ContainingGoal, !GoalNum, !ContainingGoalMap,
Goal0, Goal),
- Clause = clause(ProcIds, Goal, Lang, Context).
+ Clause = Clause0 ^ clause_body := Goal.
fill_goal_path_slots_in_proc(ModuleInfo, !Proc) :-
proc_info_get_goal(!.Proc, Goal0),
Index: compiler/goal_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/goal_util.m,v
retrieving revision 1.180
diff -u -b -r1.180 goal_util.m
--- compiler/goal_util.m 13 Jan 2011 00:36:52 -0000 1.180
+++ compiler/goal_util.m 26 Feb 2011 03:48:02 -0000
@@ -974,8 +974,7 @@
:- pred clause_size_increment(clause::in, int::in, int::out) is det.
clause_size_increment(Clause, Size0, Size) :-
- Clause = clause(_, ClauseGoal, _, _),
- goal_size(ClauseGoal, ClauseSize),
+ goal_size(Clause ^ clause_body, ClauseSize),
Size = Size0 + ClauseSize.
:- pred cases_size(list(case)::in, int::out) is det.
Index: compiler/handle_options.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/handle_options.m,v
retrieving revision 1.360
diff -u -b -r1.360 handle_options.m
--- compiler/handle_options.m 6 Feb 2011 07:30:04 -0000 1.360
+++ compiler/handle_options.m 16 Feb 2011 03:08:29 -0000
@@ -3026,9 +3026,7 @@
:- pred convert_dump_alias(string::in, string::out) is semidet.
-%
-% none of the 'all' aliases actually include all the options,
-%
+% None of the 'all' aliases actually include all the options.
convert_dump_alias("ALL", "abcdEfgilmnprstuvzBCDIMPRSTUZ").
convert_dump_alias("allD", "abcdEfgilmnprstuvzBCDMPT").
convert_dump_alias("all", "abcdEfgilmnprstuvzBCMPSTZ").
@@ -3041,11 +3039,12 @@
convert_dump_alias("paths", "cP").
convert_dump_alias("petdr", "din").
convert_dump_alias("detism", "divM").
-convert_dump_alias("mm", "bdgvP"). % for debugging minimal model
-convert_dump_alias("osv", "bcdglmnpruvP"). % for debugging
- % --optimize-saved-vars-cell
+convert_dump_alias("mm", "bdgvP"). % For debugging minimal model.
+convert_dump_alias("osv", "bcdglmnpruvP").
+ % for debugging --optimize-saved-vars-cell
convert_dump_alias("ctgc", "cdinpGDRS").
-convert_dump_alias("vars", "npBis"). % Debug var instantiations, liveness etc.
+convert_dump_alias("vars", "npBis"). % Var instantiations, liveness etc.
+convert_dump_alias("statevar", "gvCP").
%-----------------------------------------------------------------------------%
:- end_module handle_options.
Index: compiler/headvar_names.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/headvar_names.m,v
retrieving revision 1.8
diff -u -b -r1.8 headvar_names.m
--- compiler/headvar_names.m 30 Dec 2010 11:17:54 -0000 1.8
+++ compiler/headvar_names.m 26 Feb 2011 04:50:29 -0000
@@ -70,7 +70,7 @@
Clauses0 = []
;
Clauses0 = [SingleClause0],
- SingleClause0 = clause(ApplicableProcs, Goal0, Language, Context),
+ Goal0 = SingleClause0 ^ clause_body,
Goal0 = hlds_goal(_, GoalInfo0),
goal_to_conj_list(Goal0, Conj0),
@@ -86,7 +86,7 @@
apply_renaming_to_proc_arg_vector(Subst, HeadVars0, HeadVars),
clauses_info_set_headvars(HeadVars, ClausesInfo0, ClausesInfo1),
- SingleClause = clause(ApplicableProcs, Goal, Language, Context),
+ SingleClause = SingleClause0 ^ clause_body := Goal,
set_clause_list([SingleClause], ClausesRep),
clauses_info_set_clauses_rep(ClausesRep, ItemNumbers,
ClausesInfo1, ClausesInfo2),
Index: compiler/hhf.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hhf.m,v
retrieving revision 1.42
diff -u -b -r1.42 hhf.m
--- compiler/hhf.m 4 Jan 2011 03:51:09 -0000 1.42
+++ compiler/hhf.m 26 Feb 2011 04:07:41 -0000
@@ -154,7 +154,7 @@
% Info1 = Info0
%;
% Simple = no,
- list.map_foldl(process_clause(HeadVars),
+ list.map_foldl(convert_clause_to_hhf(HeadVars),
Clauses0, Clauses, Info0, Info1)
),
@@ -189,15 +189,15 @@
hhfi_vartypes :: vartypes
).
-:- pred process_clause(list(prog_var)::in, clause::in, clause::out,
+:- pred convert_clause_to_hhf(list(prog_var)::in, clause::in, clause::out,
hhf_info::in, hhf_info::out) is det.
-process_clause(_HeadVars, clause(ProcIds, Goal0, Lang, Context),
- clause(ProcIds, Goal, Lang, Context), !HI) :-
+convert_clause_to_hhf(_HeadVars, Clause0, Clause, !HI) :-
+ Goal0 = Clause0 ^ clause_body,
Goal0 = hlds_goal(_, GoalInfo0),
NonLocals = goal_info_get_nonlocals(GoalInfo0),
-
- process_goal(NonLocals, Goal0, Goal, !HI).
+ convert_goal_to_hhf(NonLocals, Goal0, Goal, !HI),
+ Clause = Clause0 ^ clause_body := Goal.
% XXX We probably need to requantify, but doing so stuffs up the
% inst_graph.
@@ -209,12 +209,12 @@
% !HI ^ hhfi_varset := VarSet,
% !HI ^ hhfi_vartypes := VarTypes.
-:- pred process_goal(set(prog_var)::in, hlds_goal::in, hlds_goal::out,
+:- pred convert_goal_to_hhf(set(prog_var)::in, hlds_goal::in, hlds_goal::out,
hhf_info::in, hhf_info::out) is det.
-process_goal(NonLocals, Goal0, Goal, !HI) :-
+convert_goal_to_hhf(NonLocals, Goal0, Goal, !HI) :-
Goal0 = hlds_goal(GoalExpr0, GoalInfo),
- process_goal_expr(NonLocals, GoalInfo, GoalExpr0, GoalExpr, !HI),
+ convert_goal_expr_to_hhf(NonLocals, GoalInfo, GoalExpr0, GoalExpr, !HI),
Goal = hlds_goal(GoalExpr, GoalInfo).
:- pred goal_use_own_nonlocals(hlds_goal::in, hlds_goal::out,
@@ -223,18 +223,18 @@
goal_use_own_nonlocals(Goal0, Goal, !HI) :-
Goal0 = hlds_goal(GoalExpr0, GoalInfo),
NonLocals = goal_info_get_nonlocals(GoalInfo),
- process_goal_expr(NonLocals, GoalInfo, GoalExpr0, GoalExpr, !HI),
+ convert_goal_expr_to_hhf(NonLocals, GoalInfo, GoalExpr0, GoalExpr, !HI),
Goal = hlds_goal(GoalExpr, GoalInfo).
-:- pred process_goal_expr(set(prog_var)::in, hlds_goal_info::in,
+:- pred convert_goal_expr_to_hhf(set(prog_var)::in, hlds_goal_info::in,
hlds_goal_expr::in, hlds_goal_expr::out, hhf_info::in, hhf_info::out)
is det.
-process_goal_expr(NonLocals, GoalInfo, GoalExpr0, GoalExpr, !HI) :-
+convert_goal_expr_to_hhf(NonLocals, GoalInfo, GoalExpr0, GoalExpr, !HI) :-
(
GoalExpr0 = unify(Var, RHS, Mode, Unif, Context),
- process_unify(RHS, NonLocals, GoalInfo, Var, Mode, Unif, Context,
- GoalExpr, !HI)
+ convert_unify_to_hhf(RHS, NonLocals, GoalInfo, Var, Mode, Unif,
+ Context, GoalExpr, !HI)
;
GoalExpr0 = plain_call(_, _, _, _, _, _),
GoalExpr = GoalExpr0
@@ -246,7 +246,7 @@
GoalExpr = GoalExpr0
;
GoalExpr0 = conj(ConjType, Goals0),
- list.map_foldl(process_goal(NonLocals), Goals0, Goals1, !HI),
+ list.map_foldl(convert_goal_to_hhf(NonLocals), Goals0, Goals1, !HI),
(
ConjType = plain_conj,
flatten_conj(Goals1, Goals)
@@ -261,45 +261,51 @@
GoalExpr = disj(Goals)
;
GoalExpr0 = switch(_, _, _),
- unexpected(this_file, "hhf_goal_expr: found switch")
+ unexpected($module, $pred, "switch")
;
GoalExpr0 = scope(Reason, SubGoal0),
- process_goal(NonLocals, SubGoal0, SubGoal, !HI),
+ convert_goal_to_hhf(NonLocals, SubGoal0, SubGoal, !HI),
GoalExpr = scope(Reason, SubGoal)
;
GoalExpr0 = negation(SubGoal0),
- process_goal(NonLocals, SubGoal0, SubGoal, !HI),
+ convert_goal_to_hhf(NonLocals, SubGoal0, SubGoal, !HI),
GoalExpr = negation(SubGoal)
;
GoalExpr0 = if_then_else(Vs, Cond0, Then0, Else0),
- process_goal(NonLocals, Cond0, Cond, !HI),
+ convert_goal_to_hhf(NonLocals, Cond0, Cond, !HI),
Then0 = hlds_goal(ThenExpr0, ThenInfo),
ThenNonLocals = goal_info_get_nonlocals(ThenInfo),
- process_goal_expr(ThenNonLocals, ThenInfo, ThenExpr0, ThenExpr, !HI),
+ convert_goal_expr_to_hhf(ThenNonLocals, ThenInfo, ThenExpr0, ThenExpr,
+ !HI),
Then = hlds_goal(ThenExpr, ThenInfo),
Else0 = hlds_goal(ElseExpr0, ElseInfo),
ElseNonLocals = goal_info_get_nonlocals(ElseInfo),
- process_goal_expr(ElseNonLocals, ElseInfo, ElseExpr0, ElseExpr, !HI),
+ convert_goal_expr_to_hhf(ElseNonLocals, ElseInfo, ElseExpr0, ElseExpr,
+ !HI),
Else = hlds_goal(ElseExpr, ElseInfo),
GoalExpr = if_then_else(Vs, Cond, Then, Else)
;
GoalExpr0 = shorthand(_),
- unexpected(this_file, "hhf_goal_expr: found shorthand")
+ unexpected($module, $pred, "shorthand")
).
-:- pred process_unify(unify_rhs::in, set(prog_var)::in, hlds_goal_info::in,
- prog_var::in, unify_mode::in, unification::in, unify_context::in,
- hlds_goal_expr::out, hhf_info::in, hhf_info::out) is det.
-
-process_unify(rhs_var(Y), _, _, X, Mode, Unif, Context, GoalExpr, !HI) :-
- GoalExpr = unify(X, rhs_var(Y), Mode, Unif, Context).
-process_unify(rhs_lambda_goal(A,B,C,D,E,F,G,H,LambdaGoal0), NonLocals, _, X,
- Mode, Unif, Context, GoalExpr, !HI) :-
- process_goal(NonLocals, LambdaGoal0, LambdaGoal, !HI),
- GoalExpr = unify(X, rhs_lambda_goal(A,B,C,D,E,F,G,H,LambdaGoal), Mode,
- Unif, Context).
-process_unify(rhs_functor(ConsId0, IsExistConstruct, ArgsA), NonLocals,
- GoalInfo0, X, Mode, Unif, Context, GoalExpr, !HI) :-
+:- pred convert_unify_to_hhf(unify_rhs::in, set(prog_var)::in,
+ hlds_goal_info::in, prog_var::in, unify_mode::in, unification::in,
+ unify_context::in, hlds_goal_expr::out, hhf_info::in, hhf_info::out)
+ is det.
+
+convert_unify_to_hhf(RHS0, NonLocals, GoalInfo0, X, Mode, Unif, Context,
+ GoalExpr, !HI) :-
+ (
+ RHS0 = rhs_lambda_goal(A, B, C, D, E, F, G, H, LambdaGoal0),
+ convert_goal_to_hhf(NonLocals, LambdaGoal0, LambdaGoal, !HI),
+ RHS = rhs_lambda_goal(A, B, C, D, E, F, G, H, LambdaGoal),
+ GoalExpr = unify(X, RHS, Mode, Unif, Context)
+ ;
+ RHS0 = rhs_var(_),
+ GoalExpr = unify(X, RHS0, Mode, Unif, Context)
+ ;
+ RHS0 = rhs_functor(ConsId0, IsExistConstruct, ArgsA),
qualify_cons_id(ArgsA, ConsId0, _, ConsId),
InstGraph0 = !.HI ^ hhfi_inst_graph,
map.lookup(InstGraph0, X, node(Functors0, MaybeParent)),
@@ -320,10 +326,11 @@
GINonlocals0 = goal_info_get_nonlocals(GoalInfo0),
GINonlocals = set.union(GINonlocals0, list_to_set(Args)),
goal_info_set_nonlocals(GINonlocals, GoalInfo0, GoalInfo),
- UnifyGoalExpr = unify(X, rhs_functor(ConsId, IsExistConstruct, Args),
- Mode, Unif, Context),
+ RHS = rhs_functor(ConsId, IsExistConstruct, Args),
+ UnifyGoalExpr = unify(X, RHS, Mode, Unif, Context),
UnifyGoal = hlds_goal(UnifyGoalExpr, GoalInfo),
- GoalExpr = conj(plain_conj, [UnifyGoal | Unifications]).
+ GoalExpr = conj(plain_conj, [UnifyGoal | Unifications])
+ ).
:- pred make_unifications(list(prog_var)::in, list(prog_var)::in,
hlds_goal_info::in, unify_mode::in, unification::in, unify_context::in,
@@ -331,9 +338,9 @@
make_unifications([], [], _, _, _, _, []).
make_unifications([_ | _], [], _, _, _, _, _) :-
- unexpected(this_file, "hhf_make_unifications: length mismatch (1)").
+ unexpected($module, $pred, "length mismatch (1)").
make_unifications([], [_ | _], _, _, _, _, _) :-
- unexpected(this_file, "hhf_make_unifications: length mismatch (2)").
+ unexpected($module, $pred, "length mismatch (2)").
make_unifications([A | As], [B | Bs], GI0, M, U, C,
[hlds_goal(unify(A, rhs_var(B), M, U, C), GI) | Us]) :-
GINonlocals0 = goal_info_get_nonlocals(GI0),
@@ -397,8 +404,7 @@
TypeCtor = type_ctor(TypeCtorSymName, _),
(
TypeCtorSymName = unqualified(_),
- unexpected(this_file,
- "complete_inst_graph_node: unqualified TypeCtorSymName")
+ unexpected($module, $pred, "unqualified TypeCtorSymName")
;
TypeCtorSymName = qualified(TypeCtorModuleName, _)
),
@@ -546,11 +552,5 @@
% inst_graph_info::in, inst_graph_info::out) is det.
%------------------------------------------------------------------------%
-
-:- func this_file = string.
-
-this_file = "hhf.m".
-
-%------------------------------------------------------------------------%
:- end_module hhf.
%------------------------------------------------------------------------%
Index: compiler/hlds_clauses.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_clauses.m,v
retrieving revision 1.12
diff -u -b -r1.12 hlds_clauses.m
--- compiler/hlds_clauses.m 15 Dec 2010 06:29:37 -0000 1.12
+++ compiler/hlds_clauses.m 26 Feb 2011 04:05:51 -0000
@@ -21,6 +21,7 @@
:- import_module hlds.hlds_pred.
:- import_module hlds.hlds_rtti.
:- import_module parse_tree.prog_data.
+:- import_module parse_tree.error_util.
:- import_module mdbcomp.prim_data.
:- import_module bool.
@@ -171,9 +172,12 @@
clause_applicable_procs :: clause_applicable_modes,
clause_body :: hlds_goal,
clause_lang :: implementation_language,
- clause_context :: prog_context
+ clause_context :: prog_context,
+ clause_statevar_warnings :: list(error_spec)
).
+:- func clause_body(clause) = hlds_goal.
+
:- type clause_applicable_modes
---> all_modes
% This clause is applicable to all modes of the predicate.
Index: compiler/hlds_goal.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_goal.m,v
retrieving revision 1.221
diff -u -b -r1.221 hlds_goal.m
--- compiler/hlds_goal.m 13 Jan 2011 00:36:52 -0000 1.221
+++ compiler/hlds_goal.m 26 Feb 2011 18:33:23 -0000
@@ -26,6 +26,7 @@
:- import_module mdbcomp.prim_data.
:- import_module parse_tree.prog_data.
+:- import_module assoc_list.
:- import_module bool.
:- import_module char.
:- import_module list.
@@ -164,12 +165,12 @@
% pragma_foreign_codes; none for others.
)
- ; conj(conj_type, hlds_goals)
+ ; conj(conj_type, list(hlds_goal))
% A conjunction. NOTE: plain conjunctions must be fully flattened
% before mode analysis. As a general rule, it is a good idea to
% keep them flattened.
- ; disj(hlds_goals)
+ ; disj(list(hlds_goal))
% A disjunction.
% NOTE: disjunctions should be fully flattened.
@@ -1375,8 +1376,9 @@
:- func goal_get_nonlocals(hlds_goal) = set(prog_var).
-:- func goal_get_purity(hlds_goal) = purity.
+:- pred goal_set_goal_id(goal_id::in, hlds_goal::in, hlds_goal::out) is det.
+:- func goal_get_purity(hlds_goal) = purity.
:- pred goal_set_purity(purity::in, hlds_goal::in, hlds_goal::out) is det.
:- pred goal_get_goal_purity(hlds_goal::in,
@@ -1550,7 +1552,7 @@
% The rename_var* predicates take a structure and a mapping from var -> var
% and apply that translation. If a var in the input structure does not
% occur as a key in the mapping, then the variable is left unsubstituted
-% (if Must = no) or we throw an exception (if Must = yes).
+% (if Must = need_not_rename) or we throw an exception (if Must = must_rename).
%
% We keep these predicates here to allow rename_vars_in_goal_info to exploit
% knowledge of the actual representation of hlds_goal_infos; since
@@ -1568,7 +1570,7 @@
hlds_goal::in, hlds_goal::out) is det.
:- pred rename_vars_in_goals(must_rename::in, prog_var_renaming::in,
- hlds_goals::in, hlds_goals::out) is det.
+ list(hlds_goal)::in, list(hlds_goal)::out) is det.
:- pred rename_vars_in_goal_expr(must_rename::in, prog_var_renaming::in,
hlds_goal_expr::in, hlds_goal_expr::out) is det.
@@ -1576,6 +1578,17 @@
:- pred rename_vars_in_goal_info(must_rename::in, prog_var_renaming::in,
hlds_goal_info::in, hlds_goal_info::out) is det.
+ % Rename the variables in the given goal, incrementally updating the
+ % substitution. When we start processing a goal, we look up its goal_id
+ % in the provided map. If we find it, we add the given var to var mappings
+ % to the substitution we apply to that goal. We do not insist on variables
+ % in the goal occurring in the substitution (i.e. we implicitly assume
+ % Must = need_not_rename).
+ %
+:- pred incremental_rename_vars_in_goal(prog_var_renaming::in,
+ map(goal_id, assoc_list(prog_var, prog_var))::in,
+ hlds_goal::in, hlds_goal::out) is det.
+
%-----------------------------------------------------------------------------%
%
% Miscellaneous utility procedures for dealing with HLDS goals.
@@ -1805,9 +1818,10 @@
:- import_module parse_tree.builtin_lib_types.
:- import_module parse_tree.prog_mode.
-:- import_module assoc_list.
+:- import_module io.
:- import_module map.
:- import_module require.
+:- import_module string.
:- import_module svmap.
:- import_module svvarset.
:- import_module varset.
@@ -1839,7 +1853,7 @@
->
Args = []
;
- unexpected(this_file, "make_foreign_args: unmatched lists")
+ unexpected($module, $pred, "unmatched lists")
).
%-----------------------------------------------------------------------------%
@@ -2107,7 +2121,7 @@
MaybeRBMM = yes(RBMM)
;
MaybeRBMM = no,
- unexpected(this_file, "Requesting unavailable RBMM information.")
+ unexpected($module, $pred, "Requesting unavailable RBMM information.")
).
goal_info_get_occurring_vars(GoalInfo, OccurringVars) :-
@@ -2336,7 +2350,7 @@
MaybeLFU = yes(LFU)
;
MaybeLFU = no,
- unexpected(this_file,
+ unexpected($module, $pred,
"Requesting LFU information while CTGC field not set.")
).
@@ -2346,7 +2360,7 @@
MaybeLBU = yes(LBU)
;
MaybeLBU = no,
- unexpected(this_file,
+ unexpected($module, $pred,
"Requesting LBU information while CTGC field not set.")
).
@@ -2356,18 +2370,12 @@
MaybeReuse = yes(Reuse)
;
MaybeReuse = no,
- unexpected(this_file,
+ unexpected($module, $pred,
"Requesting reuse information while CTGC field not set.")
).
%-----------------------------------------------------------------------------%
-goal_get_purity(hlds_goal(_GoalExpr, GoalInfo)) =
- goal_info_get_purity(GoalInfo).
-
-goal_get_nonlocals(hlds_goal(_GoalExpr, GoalInfo)) =
- goal_info_get_nonlocals(GoalInfo).
-
worst_contains_trace(contains_trace_goal, contains_trace_goal) =
contains_trace_goal.
worst_contains_trace(contains_trace_goal, contains_no_trace_goal) =
@@ -2377,12 +2385,24 @@
worst_contains_trace(contains_no_trace_goal, contains_no_trace_goal) =
contains_no_trace_goal.
-goal_set_purity(Purity, hlds_goal(GoalExpr, GoalInfo0),
- hlds_goal(GoalExpr, GoalInfo)) :-
- goal_info_set_purity(Purity, GoalInfo0, GoalInfo).
+goal_get_nonlocals(hlds_goal(_GoalExpr, GoalInfo)) =
+ goal_info_get_nonlocals(GoalInfo).
+
+goal_set_goal_id(GoalId, Goal0, Goal) :-
+ Goal0 = hlds_goal(GoalExpr, GoalInfo0),
+ goal_info_set_goal_id(GoalId, GoalInfo0, GoalInfo),
+ Goal = hlds_goal(GoalExpr, GoalInfo).
+
+goal_get_purity(hlds_goal(_GoalExpr, GoalInfo)) =
+ goal_info_get_purity(GoalInfo).
+
+goal_set_purity(Purity, Goal0, Goal) :-
+ Goal0 = hlds_goal(GoalExpr, GoalInfo0),
+ goal_info_set_purity(Purity, GoalInfo0, GoalInfo),
+ Goal = hlds_goal(GoalExpr, GoalInfo).
-goal_get_goal_purity(hlds_goal(_GoalExpr, GoalInfo),
- Purity, ContainsTraceGoal) :-
+goal_get_goal_purity(Goal, Purity, ContainsTraceGoal) :-
+ Goal = hlds_goal(_GoalExpr, GoalInfo),
goal_info_get_goal_purity(GoalInfo, Purity, ContainsTraceGoal).
goal_info_get_goal_purity(GoalInfo, Purity, ContainsTraceGoal) :-
@@ -2467,6 +2487,16 @@
rename_vars_in_goal(Must, Subn, Goal0, Goal),
rename_vars_in_goals(Must, Subn, Goals0, Goals).
+:- pred rename_vars_in_cases(must_rename::in, prog_var_renaming::in,
+ list(case)::in, list(case)::out) is det.
+
+rename_vars_in_cases(_Must, _Subn, [], []).
+rename_vars_in_cases(Must, Subn, [Case0 | Cases0], [Case | Cases]) :-
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
+ rename_vars_in_goal(Must, Subn, Goal0, Goal),
+ Case = case(MainConsId, OtherConsIds, Goal),
+ rename_vars_in_cases(Must, Subn, Cases0, Cases).
+
%-----------------------------------------------------------------------------%
rename_vars_in_goal_expr(Must, Subn, Expr0, Expr) :-
@@ -2602,6 +2632,273 @@
Expr = shorthand(Shorthand)
).
+:- pred rename_unify_rhs(must_rename::in, prog_var_renaming::in,
+ unify_rhs::in, unify_rhs::out) is det.
+
+rename_unify_rhs(Must, Subn, RHS0, RHS) :-
+ (
+ RHS0 = rhs_var(Var0),
+ rename_var(Must, Subn, Var0, Var),
+ RHS = rhs_var(Var)
+ ;
+ RHS0 = rhs_functor(Functor, E, ArgVars0),
+ rename_var_list(Must, Subn, ArgVars0, ArgVars),
+ RHS = rhs_functor(Functor, E, ArgVars)
+ ;
+ RHS0 = rhs_lambda_goal(Purity, Groundness, PredOrFunc, EvalMethod,
+ NonLocals0, Vars0, Modes, Det, Goal0),
+ rename_var_list(Must, Subn, NonLocals0, NonLocals),
+ rename_var_list(Must, Subn, Vars0, Vars),
+ rename_vars_in_goal(Must, Subn, Goal0, Goal),
+ RHS = rhs_lambda_goal(Purity, Groundness, PredOrFunc, EvalMethod,
+ NonLocals, Vars, Modes, Det, Goal)
+ ).
+
+%-----------------------------------------------------------------------------%
+%
+% Incremental rename predicates.
+%
+
+incremental_rename_vars_in_goal(Subn0, SubnUpdates, Goal0, Goal) :-
+ Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
+ GoalId = goal_info_get_goal_id(GoalInfo0),
+ ( map.search(SubnUpdates, GoalId, GoalSubns) ->
+ trace [compiletime(flag("statevar-subn")), io(!IO)] (
+ GoalId = goal_id(GoalIdNum),
+ io.format("Goal id %d has substitutions\n", [i(GoalIdNum)], !IO),
+ io.write(GoalSubns, !IO),
+ io.nl(!IO)
+ ),
+ % XXX map.det_insert_from_assoc_list(Subn0, GoalSubns, Subn)
+ list.foldl(follow_subn_until_fixpoint, GoalSubns, Subn0, Subn)
+ ;
+ Subn = Subn0
+ ),
+ incremental_rename_vars_in_goal_expr(Subn, SubnUpdates,
+ GoalExpr0, GoalExpr),
+ rename_vars_in_goal_info(need_not_rename, Subn, GoalInfo0, GoalInfo),
+ Goal = hlds_goal(GoalExpr, GoalInfo).
+
+:- pred follow_subn_until_fixpoint(pair(prog_var, prog_var)::in,
+ prog_var_renaming::in, prog_var_renaming::out) is det.
+
+follow_subn_until_fixpoint(FromVar - ToVar, !Subn) :-
+ ( map.search(!.Subn, ToVar, SubstitutedToVar) ->
+ trace [compiletime(flag("statevar-subn")), io(!IO)] (
+ io.write_string("short circuiting ", !IO),
+ io.write(FromVar, !IO),
+ io.write_string(": ", !IO),
+ io.write(ToVar, !IO),
+ io.write_string(" -> ", !IO),
+ io.write(SubstitutedToVar, !IO),
+ io.nl(!IO)
+ ),
+ follow_subn_until_fixpoint(FromVar - SubstitutedToVar, !Subn)
+ ;
+ trace [compiletime(flag("statevar-subn")), io(!IO)] (
+ io.write_string("applied substitution: ", !IO),
+ io.write(FromVar, !IO),
+ io.write_string(" to ", !IO),
+ io.write(ToVar, !IO),
+ io.nl(!IO)
+ ),
+ svmap.det_insert(FromVar, ToVar, !Subn)
+ ).
+
+:- pred incremental_rename_vars_in_goals(prog_var_renaming::in,
+ map(goal_id, assoc_list(prog_var, prog_var))::in,
+ list(hlds_goal)::in, list(hlds_goal)::out) is det.
+
+incremental_rename_vars_in_goals(_, _, [], []).
+incremental_rename_vars_in_goals(Subn, SubnUpdates,
+ [Goal0 | Goals0], [Goal | Goals]) :-
+ incremental_rename_vars_in_goal(Subn, SubnUpdates, Goal0, Goal),
+ incremental_rename_vars_in_goals(Subn, SubnUpdates, Goals0, Goals).
+
+:- pred incremental_rename_vars_in_cases(prog_var_renaming::in,
+ map(goal_id, assoc_list(prog_var, prog_var))::in,
+ list(case)::in, list(case)::out) is det.
+
+incremental_rename_vars_in_cases(_, _, [], []).
+incremental_rename_vars_in_cases(Subn, SubnUpdates,
+ [Case0 | Cases0], [Case | Cases]) :-
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
+ incremental_rename_vars_in_goal(Subn, SubnUpdates, Goal0, Goal),
+ Case = case(MainConsId, OtherConsIds, Goal),
+ incremental_rename_vars_in_cases(Subn, SubnUpdates, Cases0, Cases).
+
+%-----------------------------------------------------------------------------%
+
+:- pred incremental_rename_vars_in_goal_expr(prog_var_renaming::in,
+ map(goal_id, assoc_list(prog_var, prog_var))::in,
+ hlds_goal_expr::in, hlds_goal_expr::out) is det.
+
+incremental_rename_vars_in_goal_expr(Subn, SubnUpdates, Expr0, Expr) :-
+ (
+ Expr0 = conj(ConjType, Goals0),
+ incremental_rename_vars_in_goals(Subn, SubnUpdates, Goals0, Goals),
+ Expr = conj(ConjType, Goals)
+ ;
+ Expr0 = disj(Goals0),
+ incremental_rename_vars_in_goals(Subn, SubnUpdates, Goals0, Goals),
+ Expr = disj(Goals)
+ ;
+ Expr0 = switch(Var0, Det, Cases0),
+ rename_var(need_not_rename, Subn, Var0, Var),
+ incremental_rename_vars_in_cases(Subn, SubnUpdates, Cases0, Cases),
+ Expr = switch(Var, Det, Cases)
+ ;
+ Expr0 = if_then_else(Vars0, Cond0, Then0, Else0),
+ rename_var_list(need_not_rename, Subn, Vars0, Vars),
+ incremental_rename_vars_in_goal(Subn, SubnUpdates, Cond0, Cond),
+ incremental_rename_vars_in_goal(Subn, SubnUpdates, Then0, Then),
+ incremental_rename_vars_in_goal(Subn, SubnUpdates, Else0, Else),
+ Expr = if_then_else(Vars, Cond, Then, Else)
+ ;
+ Expr0 = negation(Goal0),
+ incremental_rename_vars_in_goal(Subn, SubnUpdates, Goal0, Goal),
+ Expr = negation(Goal)
+ ;
+ Expr0 = scope(Reason0, Goal0),
+ (
+ Reason0 = exist_quant(Vars0),
+ rename_var_list(need_not_rename, Subn, Vars0, Vars),
+ Reason = exist_quant(Vars)
+ ;
+ Reason0 = promise_purity(_),
+ Reason = Reason0
+ ;
+ Reason0 = promise_solutions(Vars0, Kind),
+ rename_var_list(need_not_rename, Subn, Vars0, Vars),
+ Reason = promise_solutions(Vars, Kind)
+ ;
+ Reason0 = require_complete_switch(Var0),
+ rename_var(need_not_rename, Subn, Var0, Var),
+ Reason = require_complete_switch(Var)
+ ;
+ Reason0 = require_detism(_),
+ Reason = Reason0
+ ;
+ Reason0 = barrier(_),
+ Reason = Reason0
+ ;
+ Reason0 = commit(_),
+ Reason = Reason0
+ ;
+ Reason0 = from_ground_term(Var0, Kind),
+ rename_var(need_not_rename, Subn, Var0, Var),
+ Reason = from_ground_term(Var, Kind)
+ ;
+ Reason0 = trace_goal(Flag, Grade, Env, Vars, QuantVars0),
+ rename_var_list(need_not_rename, Subn, QuantVars0, QuantVars),
+ Reason = trace_goal(Flag, Grade, Env, Vars, QuantVars)
+ ),
+ incremental_rename_vars_in_goal(Subn, SubnUpdates, Goal0, Goal),
+ Expr = scope(Reason, Goal)
+ ;
+ Expr0 = generic_call(GenericCall0, Args0, Modes, Det),
+ rename_generic_call(need_not_rename, Subn, GenericCall0, GenericCall),
+ rename_var_list(need_not_rename, Subn, Args0, Args),
+ Expr = generic_call(GenericCall, Args, Modes, Det)
+ ;
+ Expr0 = plain_call(PredId, ProcId, Args0, Builtin, Context, Sym),
+ rename_var_list(need_not_rename, Subn, Args0, Args),
+ Expr = plain_call(PredId, ProcId, Args, Builtin, Context, Sym)
+ ;
+ Expr0 = unify(LHS0, RHS0, Mode, Unify0, Context),
+ rename_var(need_not_rename, Subn, LHS0, LHS),
+ incremental_rename_unify_rhs(Subn, SubnUpdates, RHS0, RHS),
+ rename_unify(need_not_rename, Subn, Unify0, Unify),
+ Expr = unify(LHS, RHS, Mode, Unify, Context)
+ ;
+ Expr0 = call_foreign_proc(Attrs, PredId, ProcId, Args0, Extra0,
+ MTRC, Impl),
+ rename_arg_list(need_not_rename, Subn, Args0, Args),
+ rename_arg_list(need_not_rename, Subn, Extra0, Extra),
+ Expr = call_foreign_proc(Attrs, PredId, ProcId, Args, Extra,
+ MTRC, Impl)
+ ;
+ Expr0 = shorthand(Shorthand0),
+ (
+ Shorthand0 = atomic_goal(GoalType0, Outer0, Inner0,
+ MaybeOutputVars0, MainGoal0, OrElseGoals0, OrElseInners),
+ GoalType = GoalType0,
+ Outer0 = atomic_interface_vars(OuterDI0, OuterUO0),
+ rename_var(need_not_rename, Subn, OuterDI0, OuterDI),
+ rename_var(need_not_rename, Subn, OuterUO0, OuterUO),
+ Outer = atomic_interface_vars(OuterDI, OuterUO),
+ Inner0 = atomic_interface_vars(InnerDI0, InnerUO0),
+ rename_var(need_not_rename, Subn, InnerDI0, InnerDI),
+ rename_var(need_not_rename, Subn, InnerUO0, InnerUO),
+ Inner = atomic_interface_vars(InnerDI, InnerUO),
+ (
+ MaybeOutputVars0 = no,
+ MaybeOutputVars = MaybeOutputVars0
+ ;
+ MaybeOutputVars0 = yes(OutputVars0),
+ rename_var_list(need_not_rename, Subn, OutputVars0, OutputVars),
+ MaybeOutputVars = yes(OutputVars)
+ ),
+ incremental_rename_vars_in_goal(Subn, SubnUpdates,
+ MainGoal0, MainGoal),
+ incremental_rename_vars_in_goals(Subn, SubnUpdates,
+ OrElseGoals0, OrElseGoals),
+ Shorthand = atomic_goal(GoalType, Outer, Inner,
+ MaybeOutputVars, MainGoal, OrElseGoals, OrElseInners)
+ ;
+ Shorthand0 = try_goal(MaybeIO0, ResultVar0, SubGoal0),
+ (
+ MaybeIO0 = yes(try_io_state_vars(IOVarInitial0, IOVarFinal0)),
+ rename_var(need_not_rename, Subn, IOVarInitial0, IOVarInitial),
+ rename_var(need_not_rename, Subn, IOVarFinal0, IOVarFinal),
+ MaybeIO = yes(try_io_state_vars(IOVarInitial, IOVarFinal))
+ ;
+ MaybeIO0 = no,
+ MaybeIO = no
+ ),
+ rename_var(need_not_rename, Subn, ResultVar0, ResultVar),
+ incremental_rename_vars_in_goal(Subn, SubnUpdates,
+ SubGoal0, SubGoal),
+ Shorthand = try_goal(MaybeIO, ResultVar, SubGoal)
+ ;
+ Shorthand0 = bi_implication(LeftGoal0, RightGoal0),
+ incremental_rename_vars_in_goal(Subn, SubnUpdates,
+ LeftGoal0, LeftGoal),
+ incremental_rename_vars_in_goal(Subn, SubnUpdates,
+ RightGoal0, RightGoal),
+ Shorthand = bi_implication(LeftGoal, RightGoal)
+ ),
+ Expr = shorthand(Shorthand)
+ ).
+
+:- pred incremental_rename_unify_rhs(prog_var_renaming::in,
+ map(goal_id, assoc_list(prog_var, prog_var))::in,
+ unify_rhs::in, unify_rhs::out) is det.
+
+incremental_rename_unify_rhs(Subn, SubnUpdates, RHS0, RHS) :-
+ (
+ RHS0 = rhs_var(Var0),
+ rename_var(need_not_rename, Subn, Var0, Var),
+ RHS = rhs_var(Var)
+ ;
+ RHS0 = rhs_functor(Functor, E, ArgVars0),
+ rename_var_list(need_not_rename, Subn, ArgVars0, ArgVars),
+ RHS = rhs_functor(Functor, E, ArgVars)
+ ;
+ RHS0 = rhs_lambda_goal(Purity, Groundness, PredOrFunc, EvalMethod,
+ NonLocals0, Vars0, Modes, Det, Goal0),
+ rename_var_list(need_not_rename, Subn, NonLocals0, NonLocals),
+ rename_var_list(need_not_rename, Subn, Vars0, Vars),
+ incremental_rename_vars_in_goal(Subn, SubnUpdates, Goal0, Goal),
+ RHS = rhs_lambda_goal(Purity, Groundness, PredOrFunc, EvalMethod,
+ NonLocals, Vars, Modes, Det, Goal)
+ ).
+
+%-----------------------------------------------------------------------------%
+%
+% Predicates used to implement both incremental and non-incremental renames.
+%
+
:- pred rename_arg_list(must_rename::in, prog_var_renaming::in,
list(foreign_arg)::in, list(foreign_arg)::out) is det.
@@ -2618,33 +2915,6 @@
rename_var(Must, Subn, Var0, Var),
Arg = foreign_arg(Var, B, C, D).
-:- pred rename_vars_in_cases(must_rename::in, prog_var_renaming::in,
- list(case)::in, list(case)::out) is det.
-
-rename_vars_in_cases(_Must, _Subn, [], []).
-rename_vars_in_cases(Must, Subn, [Case0 | Cases0], [Case | Cases]) :-
- Case0 = case(MainConsId, OtherConsIds, Goal0),
- rename_vars_in_goal(Must, Subn, Goal0, Goal),
- Case = case(MainConsId, OtherConsIds, Goal),
- rename_vars_in_cases(Must, Subn, Cases0, Cases).
-
-:- pred rename_unify_rhs(must_rename::in, prog_var_renaming::in,
- unify_rhs::in, unify_rhs::out) is det.
-
-rename_unify_rhs(Must, Subn, rhs_var(Var0), rhs_var(Var)) :-
- rename_var(Must, Subn, Var0, Var).
-rename_unify_rhs(Must, Subn,
- rhs_functor(Functor, E, ArgVars0), rhs_functor(Functor, E, ArgVars)) :-
- rename_var_list(Must, Subn, ArgVars0, ArgVars).
-rename_unify_rhs(Must, Subn,
- rhs_lambda_goal(Purity, Groundness, PredOrFunc, EvalMethod,
- NonLocals0, Vars0, Modes, Det, Goal0),
- rhs_lambda_goal(Purity, Groundness, PredOrFunc, EvalMethod,
- NonLocals, Vars, Modes, Det, Goal)) :-
- rename_var_list(Must, Subn, NonLocals0, NonLocals),
- rename_var_list(Must, Subn, Vars0, Vars),
- rename_vars_in_goal(Must, Subn, Goal0, Goal).
-
:- pred rename_unify(must_rename::in, prog_var_renaming::in,
unification::in, unification::out) is det.
@@ -2906,7 +3176,7 @@
conjoin_goal_and_goal_list(Goal0, Goals, Goal) :-
Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
( GoalExpr0 = conj(plain_conj, GoalList0) ->
- list.append(GoalList0, Goals, GoalList),
+ GoalList = GoalList0 ++ Goals,
GoalExpr = conj(plain_conj, GoalList)
;
GoalExpr = conj(plain_conj, [Goal0 | Goals])
@@ -2946,7 +3216,7 @@
Goals) :-
all_negated(NegatedConj, Goals1),
all_negated(NegatedGoals, Goals2),
- list.append(Goals1, Goals2, Goals).
+ Goals = Goals1 ++ Goals2.
%-----------------------------------------------------------------------------%
@@ -3377,11 +3647,5 @@
get_pragma_foreign_var_names_2(MaybeNames, !Names).
%-----------------------------------------------------------------------------%
-
-:- func this_file = string.
-
-this_file = "hlds_goal.m".
-
-%-----------------------------------------------------------------------------%
:- end_module hlds.hlds_goal.
%-----------------------------------------------------------------------------%
Index: compiler/hlds_out_goal.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_out_goal.m,v
retrieving revision 1.5
diff -u -b -r1.5 hlds_out_goal.m
--- compiler/hlds_out_goal.m 13 Jan 2011 00:36:52 -0000 1.5
+++ compiler/hlds_out_goal.m 18 Feb 2011 04:38:39 -0000
@@ -38,6 +38,12 @@
%-----------------------------------------------------------------------------%
+ % Print a goal in a way that is suitable for debugging the compiler
+ % (but necessarily for anything else).
+ %
+:- pred dump_goal(module_info::in, prog_varset::in, hlds_goal::in,
+ io::di, io::uo) is det.
+
% Print out an HLDS goal. The module_info and prog_varset give
% the context of the goal. The boolean says whether variables should
% have their numbers appended to them. The integer gives the level
@@ -136,9 +142,16 @@
:- import_module varset.
%-----------------------------------------------------------------------------%
-%
-% Write out goal_infos in the form of annotations around goal expressions.
-%
+
+dump_goal(ModuleInfo, VarSet, Goal, !IO) :-
+ module_info_get_globals(ModuleInfo, Globals),
+ Info = init_hlds_out_info(Globals),
+ AppendVarNums = yes,
+ Indent = 0,
+ Follow = "",
+ TypeQual = no_varset_vartypes,
+ do_write_goal(Info, Goal, ModuleInfo, VarSet,
+ AppendVarNums, Indent, Follow, TypeQual, !IO).
write_goal(Info, Goal, ModuleInfo, VarSet,
AppendVarNums, Indent, Follow, !IO) :-
@@ -148,6 +161,8 @@
do_write_goal(Info, Goal, ModuleInfo, VarSet,
AppendVarNums, Indent, Follow, TypeQual, !IO) :-
+ % Write out goal_infos in the form of annotations around goal expressions.
+
Goal = hlds_goal(GoalExpr, GoalInfo),
DumpOptions = Info ^ hoi_dump_hlds_options,
( string.contains_char(DumpOptions, 'c') ->
Index: compiler/hlds_out_module.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_out_module.m,v
retrieving revision 1.4
diff -u -b -r1.4 hlds_out_module.m
--- compiler/hlds_out_module.m 4 Jan 2011 03:51:09 -0000 1.4
+++ compiler/hlds_out_module.m 26 Feb 2011 04:51:45 -0000
@@ -884,7 +884,7 @@
io.write_string("(\n", !IO)
),
- Clause = clause(_Modes, Goal, _Lang, _Context),
+ Goal = Clause ^ clause_body,
do_write_goal(Info, Goal, ModuleInfo, VarSet, AppendVarNums,
Indent+1, ").\n", TypeQual, !IO).
Index: compiler/hlds_out_pred.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_out_pred.m,v
retrieving revision 1.5
diff -u -b -r1.5 hlds_out_pred.m
--- compiler/hlds_out_pred.m 13 Jan 2011 00:36:52 -0000 1.5
+++ compiler/hlds_out_pred.m 26 Feb 2011 03:34:22 -0000
@@ -301,6 +301,11 @@
;
true
),
+ ( string.contains_char(OptionsStr, 'P') ->
+ !:DumpStr = !.DumpStr ++ "P"
+ ;
+ true
+ ),
DumpStr = !.DumpStr
),
ClausesInfo = Info ^ hoi_dump_hlds_options := DumpStr.
@@ -345,7 +350,7 @@
write_clause(Info, Indent, ModuleInfo, PredId, VarSet, AppendVarNums,
HeadTerms, PredOrFunc, Clause, UseDeclaredModes, TypeQual, !IO) :-
- Clause = clause(ApplicableModes, Goal, Lang, Context),
+ Clause = clause(ApplicableModes, Goal, Lang, Context, _StateVarWarnings),
Indent1 = Indent + 1,
DumpOptions = Info ^ hoi_dump_hlds_options,
(
Index: compiler/hlds_out_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_out_util.m,v
retrieving revision 1.2
diff -u -b -r1.2 hlds_out_util.m
--- compiler/hlds_out_util.m 30 Jul 2010 05:16:11 -0000 1.2
+++ compiler/hlds_out_util.m 18 Feb 2011 04:38:43 -0000
@@ -206,12 +206,12 @@
%-----------------------------------------------------------------------------%
-init_hlds_out_info(Globals) = Init :-
+init_hlds_out_info(Globals) = Info :-
globals.lookup_string_option(Globals, dump_hlds_options, DumpOptions),
globals.lookup_accumulating_option(Globals, dump_hlds_pred_id, Ids),
globals.lookup_accumulating_option(Globals, dump_hlds_pred_name, Names),
MercInfo = init_merc_out_info_for_hlds_dump(Globals),
- Init = hlds_out_info(DumpOptions, Ids, Names, MercInfo).
+ Info = hlds_out_info(DumpOptions, Ids, Names, MercInfo).
%-----------------------------------------------------------------------------%
%
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.265
diff -u -b -r1.265 hlds_pred.m
--- compiler/hlds_pred.m 13 Jan 2011 00:36:52 -0000 1.265
+++ compiler/hlds_pred.m 26 Feb 2011 04:29:28 -0000
@@ -35,6 +35,7 @@
:- import_module mdbcomp.prim_data.
:- import_module mdbcomp.program_representation.
:- import_module parse_tree.prog_data.
+:- import_module parse_tree.error_util.
:- import_module transform_hlds.term_constr_main.
:- import_module transform_hlds.term_util.
@@ -1277,34 +1278,50 @@
pred_info_get_clauses_info(PI, PI ^ clauses_info).
pred_info_get_procedures(PI, PI ^ procedures).
-pred_info_set_name(X, PI, PI ^ name := X).
-pred_info_set_orig_arity(X, PI, PI ^ orig_arity := X).
-pred_info_set_is_pred_or_func(X, PI, PI ^ is_pred_or_func := X).
-pred_info_set_origin(X, PI, PI ^ pred_origin := X).
-pred_info_set_import_status(X, PI, PI ^ import_status := X).
-pred_info_set_goal_type(X, PI, PI ^ pred_sub_info ^ goal_type := X).
-pred_info_set_markers(X, PI, PI ^ markers := X).
-pred_info_set_attributes(X, PI, PI ^ pred_sub_info ^ attributes := X).
-pred_info_set_typevarset(X, PI, PI ^ typevarset := X).
-pred_info_set_tvar_kinds(X, PI, PI ^ pred_sub_info ^ tvar_kinds := X).
-pred_info_set_existq_tvar_binding(X, PI,
- PI ^ pred_sub_info ^ existq_tvar_binding := X).
-pred_info_set_head_type_params(X, PI,
- PI ^ pred_sub_info ^ head_type_params := X).
-pred_info_set_class_context(X, PI, PI ^ class_context := X).
-pred_info_set_constraint_proofs(X, PI,
- PI ^ pred_sub_info ^ constraint_proofs := X).
-pred_info_set_constraint_map(X, PI, PI ^ pred_sub_info ^ constraint_map := X).
-pred_info_set_unproven_body_constraints(X, PI,
- PI ^ pred_sub_info ^ unproven_body_constraints := X).
-pred_info_set_inst_graph_info(X, PI,
- PI ^ pred_sub_info ^ inst_graph_info := X).
-pred_info_set_arg_modes_maps(X, PI,
- PI ^ pred_sub_info ^ arg_modes_maps := X).
-pred_info_set_var_name_remap(X, PI, PI ^ pred_sub_info ^ var_name_remap := X).
-pred_info_set_assertions(X, PI, PI ^ pred_sub_info ^ assertions := X).
-pred_info_set_clauses_info(X, PI, PI ^ clauses_info := X).
-pred_info_set_procedures(X, PI, PI ^ procedures := X).
+pred_info_set_name(X, !PI) :-
+ !PI ^ name := X.
+pred_info_set_orig_arity(X, !PI) :-
+ !PI ^ orig_arity := X.
+pred_info_set_is_pred_or_func(X, !PI) :-
+ !PI ^ is_pred_or_func := X.
+pred_info_set_origin(X, !PI) :-
+ !PI ^ pred_origin := X.
+pred_info_set_import_status(X, !PI) :-
+ !PI ^ import_status := X.
+pred_info_set_goal_type(X, !PI) :-
+ !PI ^ pred_sub_info ^ goal_type := X.
+pred_info_set_markers(X, !PI) :-
+ !PI ^ markers := X.
+pred_info_set_attributes(X, !PI) :-
+ !PI ^ pred_sub_info ^ attributes := X.
+pred_info_set_typevarset(X, !PI) :-
+ !PI ^ typevarset := X.
+pred_info_set_tvar_kinds(X, !PI) :-
+ !PI ^ pred_sub_info ^ tvar_kinds := X.
+pred_info_set_existq_tvar_binding(X, !PI) :-
+ !PI ^ pred_sub_info ^ existq_tvar_binding := X.
+pred_info_set_head_type_params(X, !PI) :-
+ !PI ^ pred_sub_info ^ head_type_params := X.
+pred_info_set_class_context(X, !PI) :-
+ !PI ^ class_context := X.
+pred_info_set_constraint_proofs(X, !PI) :-
+ !PI ^ pred_sub_info ^ constraint_proofs := X.
+pred_info_set_constraint_map(X, !PI) :-
+ !PI ^ pred_sub_info ^ constraint_map := X.
+pred_info_set_unproven_body_constraints(X, !PI) :-
+ !PI ^ pred_sub_info ^ unproven_body_constraints := X.
+pred_info_set_inst_graph_info(X, !PI) :-
+ !PI ^ pred_sub_info ^ inst_graph_info := X.
+pred_info_set_arg_modes_maps(X, !PI) :-
+ !PI ^ pred_sub_info ^ arg_modes_maps := X.
+pred_info_set_var_name_remap(X, !PI) :-
+ !PI ^ pred_sub_info ^ var_name_remap := X.
+pred_info_set_assertions(X, !PI) :-
+ !PI ^ pred_sub_info ^ assertions := X.
+pred_info_set_clauses_info(X, !PI) :-
+ !PI ^ clauses_info := X.
+pred_info_set_procedures(X, !PI) :-
+ !PI ^ procedures := X.
%-----------------------------------------------------------------------------%
@@ -1994,6 +2011,8 @@
maybe(untuple_proc_info)::out) is det.
:- pred proc_info_get_var_name_remap(proc_info::in,
map(prog_var, string)::out) is det.
+:- pred proc_info_get_statevar_warnings(proc_info::in, list(error_spec)::out)
+ is det.
% Predicates to set fields of proc_infos.
@@ -2058,6 +2077,8 @@
proc_info::in, proc_info::out) is det.
:- pred proc_info_set_var_name_remap(map(prog_var, string)::in,
proc_info::in, proc_info::out) is det.
+:- pred proc_info_set_statevar_warnings(list(error_spec)::in,
+ proc_info::in, proc_info::out) is det.
:- pred proc_info_get_termination2_info(proc_info::in,
termination2_info::out) is det.
@@ -2381,6 +2402,11 @@
proc_var_name_remap :: map(prog_var, string),
+ % Any warnings generated by the state variable transformation
+ % that we should print only if we find a mode error that could
+ % be caused by the problem being warned about.
+ statevar_warnings :: list(error_spec),
+
% Structure sharing information as obtained by the structure
% sharing analysis.
structure_sharing :: structure_sharing_info,
@@ -2516,7 +2542,7 @@
ReuseInfo = structure_reuse_info_init,
ProcSubInfo = proc_sub_info(DetismDecl, no, no, Term2Info, IsAddressTaken,
StackSlots, ArgInfo, InitialLiveness, no, no, no, no_tail_call_events,
- no, no, no, no, no, no, VarNameRemap, SharingInfo, ReuseInfo),
+ no, no, no, no, no, no, VarNameRemap, [], SharingInfo, ReuseInfo),
ProcInfo = proc_info(MContext, BodyVarSet, BodyTypes, HeadVars, InstVarSet,
DeclaredModes, Modes, no, MaybeArgLives, MaybeDet, InferredDet,
ClauseBody, CanProcess, ModeErrors, RttiVarMaps, eval_normal,
@@ -2548,7 +2574,7 @@
ReuseInfo = structure_reuse_info_init,
ProcSubInfo = proc_sub_info(DetismDecl, no, no, Term2Info, IsAddressTaken,
StackSlots, no, Liveness, no, no, no, no_tail_call_events,
- no, no, no, no, no, no, VarNameRemap, SharingInfo, ReuseInfo),
+ no, no, no, no, no, no, VarNameRemap, [], SharingInfo, ReuseInfo),
ProcInfo = proc_info(Context, VarSet, VarTypes, HeadVars,
InstVarSet, no, HeadModes, no, MaybeHeadLives,
MaybeDeclaredDetism, Detism, Goal, yes, ModeErrors,
@@ -2599,6 +2625,7 @@
PI ^ proc_sub_info ^ maybe_deep_profile_proc_info).
proc_info_get_maybe_untuple_info(PI, PI ^ proc_sub_info ^ maybe_untuple_info).
proc_info_get_var_name_remap(PI, PI ^ proc_sub_info ^ proc_var_name_remap).
+proc_info_get_statevar_warnings(PI, PI ^ proc_sub_info ^ statevar_warnings).
proc_info_set_varset(VS, !PI) :-
!PI ^ prog_varset := VS.
@@ -2660,6 +2687,8 @@
!PI ^ proc_sub_info ^ maybe_untuple_info := MUI.
proc_info_set_var_name_remap(VNR, !PI) :-
!PI ^ proc_sub_info ^ proc_var_name_remap := VNR.
+proc_info_set_statevar_warnings(SVW, !PI) :-
+ !PI ^ proc_sub_info ^ statevar_warnings := SVW.
proc_info_head_modes_constraint(ProcInfo, HeadModesConstraint) :-
MaybeHeadModesConstraint = ProcInfo ^ maybe_head_modes_constraint,
Index: compiler/inlining.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/inlining.m,v
retrieving revision 1.169
diff -u -b -r1.169 inlining.m
--- compiler/inlining.m 15 Dec 2010 06:29:39 -0000 1.169
+++ compiler/inlining.m 26 Feb 2011 04:08:28 -0000
@@ -316,7 +316,8 @@
(
Size < SimpleThreshold
;
- Clauses = [clause(_, Goal, _, _)],
+ Clauses = [Clause],
+ Goal = Clause ^ clause_body,
Size < SimpleThreshold * 3,
% For flat goals, we are more likely to be able to optimize stuff away,
Index: compiler/intermod.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/intermod.m,v
retrieving revision 1.257
diff -u -b -r1.257 intermod.m
--- compiler/intermod.m 2 Jan 2011 14:37:54 -0000 1.257
+++ compiler/intermod.m 26 Feb 2011 04:12:48 -0000
@@ -390,9 +390,11 @@
bool::out, intermod_info::in, intermod_info::out) is det.
intermod_traverse_clauses([], [], yes, !Info).
-intermod_traverse_clauses([clause(P, Goal0, L, C) | Clauses0],
- [clause(P, Goal, L, C) | Clauses], DoWrite, !Info) :-
+intermod_traverse_clauses([Clause0 | Clauses0], [Clause | Clauses],
+ DoWrite, !Info) :-
+ Goal0 = Clause0 ^ clause_body,
intermod_traverse_goal(Goal0, Goal, DoWrite1, !Info),
+ Clause = Clause0 ^ clause_body := Goal,
(
DoWrite1 = yes,
intermod_traverse_clauses(Clauses0, Clauses, DoWrite, !Info)
@@ -431,14 +433,14 @@
clause_list_is_deforestable(PredId, Clauses) :-
some [Clause1] (
list.member(Clause1, Clauses),
- Clause1 = clause(_, Goal1, _, _),
+ Goal1 = Clause1 ^ clause_body,
goal_calls_pred_id(Goal1, PredId)
),
(
Clauses = [_, _ | _]
;
Clauses = [Clause2],
- Clause2 = clause(_, Goal2, _, _),
+ Goal2 = Clause2 ^ clause_body,
goal_to_conj_list(Goal2, GoalList),
goal_contains_one_branched_goal(GoalList)
).
@@ -1771,7 +1773,7 @@
intermod_write_clause(OutInfo, ModuleInfo, PredId, VarSet, HeadVars, PredOrFunc,
SymName, MaybeVarTypes, Clause0, !IO) :-
- Clause0 = clause(ApplicableProcIds, Goal, ImplLang, _),
+ Clause0 = clause(ApplicableProcIds, Goal, ImplLang, _, _),
(
ImplLang = impl_lang_mercury,
strip_headvar_unifications(HeadVars, Clause0, ClauseHeadVars, Clause),
@@ -1860,8 +1862,8 @@
:- pred strip_headvar_unifications(list(prog_var)::in,
clause::in, list(prog_term)::out, clause::out) is det.
-strip_headvar_unifications(HeadVars, clause(ProcIds, Goal0, Lang, Context),
- HeadTerms, clause(ProcIds, Goal, Lang, Context)) :-
+strip_headvar_unifications(HeadVars, Clause0, HeadTerms, Clause) :-
+ Goal0 = Clause0 ^ clause_body,
Goal0 = hlds_goal(_, GoalInfo0),
goal_to_conj_list(Goal0, Goals0),
map.init(HeadVarMap0),
@@ -1874,13 +1876,15 @@
( map.search(HeadVarMap, HeadVar0, HeadTerm0) ->
HeadTerm = HeadTerm0
;
+ Context = Clause0 ^ clause_context,
HeadTerm = term.variable(HeadVar0, Context)
)
), HeadVars, HeadTerms),
- conj_list_to_goal(Goals, GoalInfo0, Goal)
+ conj_list_to_goal(Goals, GoalInfo0, Goal),
+ Clause = Clause0 ^ clause_body := Goal
;
term.var_list_to_term_list(HeadVars, HeadTerms),
- Goal = Goal0
+ Clause = Clause0
).
:- pred strip_headvar_unifications_from_goal_list(list(hlds_goal)::in,
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.532
diff -u -b -r1.532 make_hlds.m
--- compiler/make_hlds.m 15 Sep 2010 04:35:27 -0000 1.532
+++ compiler/make_hlds.m 16 Feb 2011 02:02:07 -0000
@@ -122,6 +122,7 @@
:- include_module add_special_pred.
:- include_module add_type.
:- include_module field_access.
+:- include_module goal_expr_to_goal.
:- include_module make_hlds_error.
:- include_module make_hlds_passes.
:- include_module make_hlds_warn.
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.345
diff -u -b -r1.345 mercury_to_mercury.m
--- compiler/mercury_to_mercury.m 29 Dec 2010 04:52:17 -0000 1.345
+++ compiler/mercury_to_mercury.m 11 Feb 2011 04:59:39 -0000
@@ -2928,20 +2928,22 @@
io.write_string(")", !IO)
)
;
- Expr = promise_equivalent_solutions_expr(Vars,
+ Expr = promise_equivalent_solutions_expr(Vars, StateVars,
DotSVars, ColonSVars, Goal),
- mercury_output_promise_eqv_solutions_goal(Vars, DotSVars, ColonSVars,
- Goal, VarSet, Indent, "promise_equivalent_solutions", !IO)
+ mercury_output_promise_eqv_solutions_goal(Vars, StateVars,
+ DotSVars, ColonSVars, Goal, VarSet, Indent,
+ "promise_equivalent_solutions", !IO)
;
- Expr = promise_equivalent_solution_sets_expr(Vars,
+ Expr = promise_equivalent_solution_sets_expr(Vars, StateVars,
DotSVars, ColonSVars, Goal),
- mercury_output_promise_eqv_solutions_goal(Vars, DotSVars, ColonSVars,
- Goal, VarSet, Indent, "promise_equivalent_solution_sets", !IO)
+ mercury_output_promise_eqv_solutions_goal(Vars, StateVars,
+ DotSVars, ColonSVars, Goal, VarSet, Indent,
+ "promise_equivalent_solution_sets", !IO)
;
- Expr = promise_equivalent_solution_arbitrary_expr(Vars,
+ Expr = promise_equivalent_solution_arbitrary_expr(Vars, StateVars,
DotSVars, ColonSVars, Goal),
- mercury_output_promise_eqv_solutions_goal(Vars, DotSVars, ColonSVars,
- Goal, VarSet, Indent, "arbitrary", !IO)
+ mercury_output_promise_eqv_solutions_goal(Vars, StateVars,
+ DotSVars, ColonSVars, Goal, VarSet, Indent, "arbitrary", !IO)
;
Expr = promise_purity_expr(Purity, Goal),
(
@@ -3185,14 +3187,15 @@
mercury_output_term_nq(VarSet, no, next_to_graphic_token, B, !IO)
).
-:- pred mercury_output_promise_eqv_solutions_goal(prog_vars::in,
- prog_vars::in, prog_vars::in, goal::in, prog_varset::in, int::in,
- string::in, io::di, io::uo) is det.
+:- pred mercury_output_promise_eqv_solutions_goal(list(prog_var)::in,
+ list(prog_var)::in, list(prog_var)::in, list(prog_var)::in,
+ goal::in, prog_varset::in, int::in, string::in, io::di, io::uo) is det.
-mercury_output_promise_eqv_solutions_goal(Vars, DotSVars, ColonSVars,
+mercury_output_promise_eqv_solutions_goal(Vars, StateVars, DotSVars, ColonSVars,
Goal, VarSet, Indent, Keyword, !IO) :-
(
Vars = [],
+ StateVars = [],
DotSVars = [],
ColonSVars = []
->
@@ -3205,6 +3208,18 @@
mercury_output_vars(VarSet, no, Vars, !IO),
(
Vars = [_ | _],
+ StateVars = [_ | _]
+ ->
+ io.write_string(", ", !IO)
+ ;
+ true
+ ),
+ mercury_output_state_vars_using_prefix(StateVars, "!", VarSet, no,
+ !IO),
+ (
+ ( Vars = [_ | _]
+ ; StateVars = [_ | _]
+ ),
DotSVars = [_ | _]
->
io.write_string(", ", !IO)
@@ -3215,6 +3230,7 @@
!IO),
(
( Vars = [_ | _]
+ ; StateVars = [_ | _]
; DotSVars = [_ | _]
),
ColonSVars = [_ | _]
Index: compiler/mode_constraints.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mode_constraints.m,v
retrieving revision 1.60
diff -u -b -r1.60 mode_constraints.m
--- compiler/mode_constraints.m 13 Jan 2011 00:36:53 -0000 1.60
+++ compiler/mode_constraints.m 26 Feb 2011 04:56:40 -0000
@@ -165,9 +165,9 @@
(
Debug = yes,
ConstraintVarset = mc_varset(VarInfo),
- trace [io(!IO)] (
+ trace [io(!TIO)] (
pretty_print_pred_constraints_map(!.ModuleInfo,
- ConstraintVarset, AbstractModeConstraints, !IO)
+ ConstraintVarset, AbstractModeConstraints, !TIO)
)
;
Debug = no
@@ -181,10 +181,10 @@
(
Debug = yes,
- trace [io(!IO)] (
+ trace [io(!TIO)] (
list.foldl(
ordering_mode_constraints.dump_goal_paths(!.ModuleInfo),
- SCCs, !IO)
+ SCCs, !TIO)
)
;
Debug = no
@@ -399,10 +399,10 @@
list.map_foldl(
(pred(Clause0::in, Clause::out, S0::in, S::out) is det :-
- Clause0 = clause(A, Goal0, C, D),
+ Goal0 = Clause0 ^ clause_body,
number_robdd_variables_in_goal(InstGraph,
set.init, _, Goal0, Goal, S0, S),
- Clause = clause(A, Goal, C, D)
+ Clause = Clause0 ^ clause_body := Goal
), Clauses2, Clauses, NRInfo0, NRInfo),
!:MCI = NRInfo ^ mc_info,
@@ -1051,8 +1051,7 @@
InstGraph, !Constraint, !MCI),
clauses_info_clauses(Clauses, _ItemNumbers, !ClausesInfo),
- list.map(pred(clause(_, Goal, _, _)::in, Goal::out) is det,
- Clauses, Goals),
+ Goals = list.map(clause_body, Clauses),
DisjGoal = disj(Goals),
AtomicGoals0 = set.init,
GCInfo0 = goal_constraints_info(ModuleInfo, SCC, InstGraph, HeadVars,
Index: compiler/modes.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/modes.m,v
retrieving revision 1.392
diff -u -b -r1.392 modes.m
--- compiler/modes.m 15 Dec 2010 06:29:51 -0000 1.392
+++ compiler/modes.m 26 Feb 2011 07:39:05 -0000
@@ -603,7 +603,7 @@
get_clause_list(ClausesRep, Clauses),
(
Clauses = [FirstClause | _],
- FirstClause = clause(_, _, _, Context)
+ Context = FirstClause ^ clause_context
;
Clauses = [],
proc_info_get_context(!.ProcInfo, Context)
@@ -660,15 +660,21 @@
(
AllErrorSpecs = [ErrorSpec | _],
- ErrorSpecs = [ErrorSpec]
+ ErrorSpecs = [ErrorSpec],
+ proc_info_get_statevar_warnings(!.ProcInfo,
+ StateVarWarningSpecs)
;
AllErrorSpecs = [],
- ErrorSpecs = []
+ ErrorSpecs = [],
+ % If there were no errors, then ignore the informational
+ % messages generated by the state variable transformation.
+ StateVarWarningSpecs = []
),
mode_info_get_warnings(!.ModeInfo, ModeWarnings),
WarningSpecs = list.map(mode_warning_info_to_spec(!.ModeInfo),
ModeWarnings),
- ErrorAndWarningSpecs = ErrorSpecs ++ WarningSpecs
+ ErrorAndWarningSpecs = ErrorSpecs ++ WarningSpecs ++
+ StateVarWarningSpecs
),
% Save away the results.
Index: compiler/module_imports.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/module_imports.m,v
retrieving revision 1.9
diff -u -b -r1.9 module_imports.m
--- compiler/module_imports.m 29 Dec 2010 04:52:18 -0000 1.9
+++ compiler/module_imports.m 11 Feb 2011 05:00:01 -0000
@@ -667,9 +667,9 @@
; GoalExpr = some_state_vars_expr(_, SubGoal)
; GoalExpr = all_state_vars_expr(_, SubGoal)
; GoalExpr = promise_purity_expr(_, SubGoal)
- ; GoalExpr = promise_equivalent_solutions_expr(_, _, _, SubGoal)
- ; GoalExpr = promise_equivalent_solution_sets_expr(_, _, _, SubGoal)
- ; GoalExpr = promise_equivalent_solution_arbitrary_expr(_, _, _,
+ ; GoalExpr = promise_equivalent_solutions_expr(_, _, _, _, SubGoal)
+ ; GoalExpr = promise_equivalent_solution_sets_expr(_, _, _, _, SubGoal)
+ ; GoalExpr = promise_equivalent_solution_arbitrary_expr(_, _, _, _,
SubGoal)
; GoalExpr = require_detism_expr(_, SubGoal)
; GoalExpr = require_complete_switch_expr(_, SubGoal)
Index: compiler/module_qual.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/module_qual.m,v
retrieving revision 1.180
diff -u -b -r1.180 module_qual.m
--- compiler/module_qual.m 29 Dec 2010 04:52:18 -0000 1.180
+++ compiler/module_qual.m 11 Feb 2011 05:00:15 -0000
@@ -276,8 +276,6 @@
need_qual_flag :: need_qualifier,
maybe_recompilation_info :: maybe(recompilation_info)
-
-
).
:- type partial_qualifier_info
@@ -585,9 +583,9 @@
; GoalExpr = all_expr(_, G)
; GoalExpr = all_state_vars_expr(_, G)
; GoalExpr = promise_purity_expr(_, G)
- ; GoalExpr = promise_equivalent_solutions_expr(_, _, _, G)
- ; GoalExpr = promise_equivalent_solution_sets_expr(_, _, _, G)
- ; GoalExpr = promise_equivalent_solution_arbitrary_expr(_, _, _, G)
+ ; GoalExpr = promise_equivalent_solutions_expr(_, _, _, _, G)
+ ; GoalExpr = promise_equivalent_solution_sets_expr(_, _, _, _, G)
+ ; GoalExpr = promise_equivalent_solution_arbitrary_expr(_, _, _, _, G)
; GoalExpr = require_detism_expr(_, G)
; GoalExpr = require_complete_switch_expr(_, G)
; GoalExpr = trace_expr(_, _, _, _, G)
Index: compiler/modules.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.462
diff -u -b -r1.462 modules.m
--- compiler/modules.m 2 Jan 2011 14:37:56 -0000 1.462
+++ compiler/modules.m 19 Feb 2011 06:41:25 -0000
@@ -2347,11 +2347,12 @@
".trans_opt", TransOptDepsOrdering, !IO),
trace [compiletime(flag("deps_graph")), runtime(env("DEPS_GRAPH")),
- io(!IO)]
+ io(!TIO)]
(
digraph.to_assoc_list(ImplDepsGraph, ImplDepsAL),
- print("ImplDepsAL:\n", !IO),
- write_list(ImplDepsAL, "\n", print, !IO), nl(!IO)
+ io.print("ImplDepsAL:\n", !TIO),
+ io.write_list(ImplDepsAL, "\n", print, !TIO),
+ io.nl(!TIO)
),
% Compute the indirect dependencies: they are equal to the composition
Index: compiler/options.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.689
diff -u -b -r1.689 options.m
--- compiler/options.m 26 Jan 2011 16:07:59 -0000 1.689
+++ compiler/options.m 2 Mar 2011 02:40:51 -0000
@@ -137,6 +137,7 @@
; inform_ite_instead_of_switch
; warn_unresolved_polymorphism
; warn_suspicious_foreign_procs
+ ; warn_state_var_shadowing
% Verbosity options
; verbose
@@ -507,6 +508,17 @@
% Options for internal use only (setting these options to non-default
% values can result in programs that do not link, or programs that dump
% core)
+ ; allow_defn_of_builtins
+ % Do not generate errors for definitions of builtin predicates.
+ % When a new builtin is introduced, the installed compiler won't
+ % know about it, and thus when it sees its declaration, it wants a
+ % definition, but when the modified compiler is bootstrapped,
+ % it would normally generate an error when it sees that very same
+ % definition in the library (usually in builtin.m or
+ % private_builtin.m). When this option is set, it allows such
+ % definitions. Once the modified compiler is installed on all
+ % relevant machines, the option can be turned off again.
+
; special_preds
% Generate unify and compare preds. For measurement only.
% Code generated with this set to `no' is unlikely to actually
@@ -1084,7 +1096,8 @@
warn_unused_imports - bool(no),
inform_ite_instead_of_switch - bool(no),
warn_unresolved_polymorphism - bool(yes),
- warn_suspicious_foreign_procs - bool(no)
+ warn_suspicious_foreign_procs - bool(no),
+ warn_state_var_shadowing - bool(yes)
]).
option_defaults_2(verbosity_option, [
% Verbosity Options
@@ -1353,6 +1366,7 @@
lexically_order_constructors - bool(no),
mutable_always_boxed - bool(yes),
delay_partial_instantiations - bool(no),
+ allow_defn_of_builtins - bool(no),
special_preds - bool(yes),
type_ctor_info - bool(yes),
type_ctor_layout - bool(yes),
@@ -1926,6 +1940,7 @@
long_option("inform-ite-instead-of-switch", inform_ite_instead_of_switch).
long_option("warn-unresolved-polymorphism", warn_unresolved_polymorphism).
long_option("warn-suspicious-foreign-procs", warn_suspicious_foreign_procs).
+long_option("warn-state-var-shadowing", warn_state_var_shadowing).
% verbosity options
long_option("verbose", verbose).
@@ -2231,6 +2246,7 @@
lexically_order_constructors).
long_option("mutable-always-boxed", mutable_always_boxed).
long_option("delay-partial-instantiations", delay_partial_instantiations).
+long_option("allow-defn-of-builtins", allow_defn_of_builtins).
long_option("special-preds", special_preds).
long_option("type-ctor-info", type_ctor_info).
long_option("type-ctor-layout", type_ctor_layout).
@@ -3471,7 +3487,9 @@
"\tDo not warn about unresolved polymorphism.",
"--warn-suspicious-foreign-procs",
"\tWarn about possible errors in the bodies of foreign",
- "\tprocedures."
+ "\tprocedures.",
+ "--no-warn-state-var-shadowing",
+ "\tDo not warn about one state variable shadowing another."
]).
:- pred options_help_verbosity(io::di, io::uo) is det.
@@ -4582,6 +4600,16 @@
% "(This option is not for general use.)",
% For documentation, see delay_partial_inst.m
+ % This is a developer only option.
+% "--allow-defn-of-builtins",
+% "(This option is not for general use.)",
+% For documentation, see the comment in the type declaration.
+
+ % This is a developer only option.
+% "--special-preds",
+% "(This option is not for general use.)",
+% For documentation, see the comment in the type declaration.
+
% All these are developer only options.
% "(These options are not for general use.)",
% For documentation, see runtime/mercury_region.h.
Index: compiler/ordering_mode_constraints.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ordering_mode_constraints.m,v
retrieving revision 1.29
diff -u -b -r1.29 ordering_mode_constraints.m
--- compiler/ordering_mode_constraints.m 13 Jan 2011 00:36:53 -0000 1.29
+++ compiler/ordering_mode_constraints.m 26 Feb 2011 18:12:42 -0000
@@ -139,27 +139,20 @@
%
:- type mode_analysis_failure
---> no_producer_consumer_sols(
+ % The predicate for which the producer/consumer analysis
+ % couldn't be solved.
failing_predicate :: pred_proc_id
- % The predicate for which the
- % producer/consumer analysis
- % failed to be solved
)
-
- ;
- mode_inference_failed(
+ ; mode_inference_failed(
+ % The caller of the predicate for which mode inference
+ % has failed.
caller :: pred_id,
- % The predicate calling the
- % predicate for which mode
- % inference has failed.
+ % The SCC of predicates to be mode inferred for which
+ % mode inference has failed.
scc :: list(pred_id)
- % The SCC of predicates to be
- % mode inferred for which
- % the mode inference failed.
)
-
- ;
- conjunct_ordering_failed(pred_proc_id).
+ ; conjunct_ordering_failed(pred_proc_id).
% A map from program variables to related producer/consumer
% constraint variables' abstract representations. The constraint
@@ -187,7 +180,7 @@
list(pred_id)::in, module_info::in, module_info::out) is det.
scc_reordering(PredConstraintsMap, VarMap, SCC0, !ModuleInfo) :-
- % Process only predicates from this module
+ % Process only predicates from this module.
list.filter(module_info_pred_status_is_imported(!.ModuleInfo),
SCC0, _, SCC),
@@ -199,8 +192,7 @@
(
PredsToInfer = [_ | _],
- % XXX GIVE UP FOR NOW!!!!
- sorry(this_file, "mode inference")
+ sorry($module, $pred, "NYI: mode inference")
;
PredsToInfer = []
),
@@ -217,11 +209,10 @@
pred_reordering(PredConstraintsMap, VarMap, PredId, !ModuleInfo) :-
module_info_pred_info(!.ModuleInfo, PredId, PredInfo0),
-
( pred_info_infer_modes(PredInfo0) ->
% XXX GIVE UP FOR NOW!!!! In reality, execution shouldn't reach here
% if the pred is to be mode inferred, should it?
- sorry(this_file, "mode inference constraints")
+ sorry($module, $pred, "mode inference constraints")
;
% XXX Maybe move this outside of this predicate - then
% the predicate can assume that the correct procedures
@@ -246,7 +237,7 @@
% XXX Deal with mode errors here!
% This is a placeholder error message.
ErrorsString = string.string(Errors),
- sorry(this_file, "mode checking failure: " ++ ErrorsString)
+ sorry($module, $pred, "mode checking failure: " ++ ErrorsString)
)
).
@@ -362,7 +353,7 @@
minimum_reordering(OCInfo, Order),
list.map(list.index1_det(Goals0), Order, Goals1),
- % Then recurse on the reordered goals
+ % Then recurse on the reordered goals.
list.map(
goal_reordering(ContainingGoalMap, PredId, VarMap, Bindings),
Goals1, Goals)
@@ -381,7 +372,7 @@
;
GoalExpr0 = switch(_, _, _),
% We haven't yet even tried to turn disjunctions into switches.
- unexpected(this_file, "goal_expr_reordering: switch")
+ unexpected($module, $pred, "switch")
;
GoalExpr0 = if_then_else(Vars, Cond0, Then0, Else0),
goal_reordering(ContainingGoalMap, PredId, VarMap, Bindings,
@@ -407,7 +398,7 @@
GoalExpr0 = shorthand(_),
% XXX We need to handle atomic goals.
% XXX We need to handle try goals.
- unexpected(this_file, "goal_expr_reordering: NYI: shorthand")
+ unexpected($module, $pred, "NYI: shorthand")
),
Goal = hlds_goal(GoalExpr, GoalInfo).
@@ -453,9 +444,8 @@
ComesAfter = set.filter_map(
func(lt(T, A)::in) = (A::out) is semidet :- T = To, Constraints),
- % Each conjunct in the ComesBefore set and the From conjunct must
- % precede the To conjunct and each of the conjuncts in the
- % ComesAfter set.
+ % Each conjunct in the ComesBefore set and the From conjunct must precede
+ % the To conjunct and each of the conjuncts in the ComesAfter set.
set.fold(insert_lt_constraints(set.insert(ComesAfter, To)),
set.insert(ComesBefore, From), set.init, NewConstraints).
@@ -793,7 +783,7 @@
list.foldl(dump_goal_goal_paths(Globals, SubGoalIndent), Goals, !IO)
;
GoalExpr = switch(_, _, _),
- unexpected(this_file, "switch")
+ unexpected($module, $pred, "switch")
;
GoalExpr = if_then_else(_, CondGoal, ThenGoal, ElseGoal),
Goals = [CondGoal, ThenGoal, ElseGoal],
@@ -813,19 +803,13 @@
!IO)
;
ShortHand = try_goal(_, _, _),
- unexpected(this_file, "try_goal")
+ unexpected($module, $pred, "try_goal")
;
ShortHand = bi_implication(_, _),
- unexpected(this_file, "bi_implication")
+ unexpected($module, $pred, "bi_implication")
)
).
%-----------------------------------------------------------------------------%
-
-:- func this_file = string.
-
-this_file = "ordering_mode_constraints.m".
-
-%-----------------------------------------------------------------------------%
:- end_module ordering_mode_constraints.
%-----------------------------------------------------------------------------%
Index: compiler/post_typecheck.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/post_typecheck.m,v
retrieving revision 1.144
diff -u -b -r1.144 post_typecheck.m
--- compiler/post_typecheck.m 13 Jan 2011 00:36:53 -0000 1.144
+++ compiler/post_typecheck.m 26 Feb 2011 04:53:51 -0000
@@ -663,7 +663,8 @@
pred_info_get_clauses_info(PredInfo, ClausesInfo),
clauses_info_get_clauses_rep(ClausesInfo, ClausesRep, _ItemNumbers),
get_clause_list(ClausesRep, Clauses),
- ( Clauses = [clause(_ProcIds, Goal0, _Lang, _Context)] ->
+ ( Clauses = [Clause] ->
+ Goal0 = Clause ^ clause_body,
assertion.normalise_goal(Goal0, Goal)
;
unexpected(this_file, "promise_ex_goal: not a single clause")
Index: compiler/prog_io_goal.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_io_goal.m,v
retrieving revision 1.63
diff -u -b -r1.63 prog_io_goal.m
--- compiler/prog_io_goal.m 29 Dec 2010 04:52:18 -0000 1.63
+++ compiler/prog_io_goal.m 11 Feb 2011 04:43:36 -0000
@@ -499,23 +499,24 @@
MaybeVars),
parse_goal(SubTerm, ContextPieces, MaybeSubGoal, !VarSet),
(
- MaybeVars = ok3(Vars0, DotSVars0, ColonSVars0),
+ MaybeVars = ok4(Vars0, StateVars0, DotSVars0, ColonSVars0),
MaybeSubGoal = ok1(SubGoal)
->
list.map(term.coerce_var, Vars0, Vars),
+ list.map(term.coerce_var, StateVars0, StateVars),
list.map(term.coerce_var, DotSVars0, DotSVars),
list.map(term.coerce_var, ColonSVars0, ColonSVars),
(
Functor = "promise_equivalent_solutions",
MaybeGoal = ok1(promise_equivalent_solutions_expr(Vars,
- DotSVars, ColonSVars, SubGoal) - Context)
+ StateVars, DotSVars, ColonSVars, SubGoal) - Context)
;
Functor = "promise_equivalent_solution_sets",
MaybeGoal = ok1(promise_equivalent_solution_sets_expr(Vars,
- DotSVars, ColonSVars, SubGoal) - Context)
+ StateVars, DotSVars, ColonSVars, SubGoal) - Context)
)
;
- VarsSpecs = get_any_errors3(MaybeVars),
+ VarsSpecs = get_any_errors4(MaybeVars),
SubGoalSpecs = get_any_errors1(MaybeSubGoal),
MaybeGoal = error1(VarsSpecs ++ SubGoalSpecs)
)
@@ -527,16 +528,17 @@
MaybeVars),
parse_goal(SubTerm, ContextPieces, MaybeSubGoal, !VarSet),
(
- MaybeVars = ok3(Vars0, DotSVars0, ColonSVars0),
+ MaybeVars = ok4(Vars0, StateVars0, DotSVars0, ColonSVars0),
MaybeSubGoal = ok1(SubGoal)
->
list.map(term.coerce_var, Vars0, Vars),
+ list.map(term.coerce_var, StateVars0, StateVars),
list.map(term.coerce_var, DotSVars0, DotSVars),
list.map(term.coerce_var, ColonSVars0, ColonSVars),
MaybeGoal = ok1(promise_equivalent_solution_arbitrary_expr(Vars,
- DotSVars, ColonSVars, SubGoal) - Context)
+ StateVars, DotSVars, ColonSVars, SubGoal) - Context)
;
- VarsSpecs = get_any_errors3(MaybeVars),
+ VarsSpecs = get_any_errors4(MaybeVars),
SubGoalSpecs = get_any_errors1(MaybeSubGoal),
MaybeGoal = error1(VarsSpecs ++ SubGoalSpecs)
)
Index: compiler/prog_io_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_io_util.m,v
retrieving revision 1.69
diff -u -b -r1.69 prog_io_util.m
--- compiler/prog_io_util.m 15 Dec 2010 06:29:57 -0000 1.69
+++ compiler/prog_io_util.m 26 Feb 2011 07:21:33 -0000
@@ -102,7 +102,8 @@
%
:- pred parse_vars_and_state_vars(term(T)::in, varset(T)::in,
list(format_component)::in,
- maybe3(list(var(T)), list(var(T)), list(var(T)))::out) is det.
+ maybe4(list(var(T)), list(var(T)), list(var(T)), list(var(T)))::out)
+ is det.
:- pred parse_name_and_arity(module_name::in, term(T)::in,
sym_name::out, arity::out) is semidet.
@@ -219,7 +220,7 @@
% :- pred p(T) where p(X) : sorted(X).
% or
% :- type sorted_list(T) = list(T) where X : sorted(X).
- % :- pred p(sorted_list(T).
+ % :- pred p(sorted_list(T)).
% There is some code here to support that sort of thing, but
% probably we would now need to use a different syntax, since
% Mercury now uses `where' for different purposes (e.g. specifying
@@ -905,134 +906,223 @@
parse_vars(TailTerm, VarSet, ContextPieces, MaybeVarsTail),
(
MaybeVarsTail = ok1(TailVars),
- Vars = [HeadVar] ++ TailVars,
+ ( list.member(HeadVar, TailVars) ->
+ generate_repeated_var_msg(ContextPieces, VarSet,
+ HeadTerm, Spec),
+ MaybeVars = error1([Spec])
+ ;
+ Vars = [HeadVar | TailVars],
MaybeVars = ok1(Vars)
+ )
;
MaybeVarsTail = error1(_),
MaybeVars = MaybeVarsTail
)
;
HeadTerm = functor(_, _, _),
- TermStr = describe_error_term(VarSet, Term),
- Pieces = ContextPieces ++ [lower_case_next_if_not_first,
- words("Expected variable, not"),
- words(TermStr), suffix("."), nl],
- Spec = error_spec(severity_error, phase_term_to_parse_tree,
- [simple_msg(get_term_context(HeadTerm), [always(Pieces)])]),
+ generate_unexpected_term_message(ContextPieces, VarSet,
+ "variable", HeadTerm, Spec),
MaybeVars = error1([Spec])
)
;
- TermStr = describe_error_term(VarSet, Term),
- Pieces = ContextPieces ++ [lower_case_next_if_not_first,
- words("Expected list of variables, not"),
- words(TermStr), suffix("."), nl],
- Spec = error_spec(severity_error, phase_term_to_parse_tree,
- [simple_msg(get_term_context(Term), [always(Pieces)])]),
+ generate_unexpected_term_message(ContextPieces, VarSet,
+ "list of variables", Term, Spec),
MaybeVars = error1([Spec])
).
+:- type ordinary_state_var(T)
+ ---> os_ordinary_var(var(T))
+ ; os_state_var(var(T)).
+
parse_quantifier_vars(Term, VarSet, ContextPieces, MaybeVars) :-
( Term = functor(atom("[]"), [], _) ->
MaybeVars = ok2([], [])
; Term = functor(atom("[|]"), [HeadTerm, TailTerm], _) ->
(
(
- HeadTerm = functor(atom("!"), [variable(SV, _)], _),
- HeadVars = [],
- HeadStateVars = [SV]
- ;
- HeadTerm = variable(V, _),
- HeadVars = [V],
- HeadStateVars = []
+ HeadTerm = variable(V0, _),
+ VarKind = os_ordinary_var(V0)
+ ;
+ HeadTerm = functor(atom("!"), [variable(SV0, _)], _),
+ VarKind = os_state_var(SV0)
)
->
parse_quantifier_vars(TailTerm, VarSet, ContextPieces,
MaybeVarsTail),
(
MaybeVarsTail = ok2(TailVars, TailStateVars),
- Vars = HeadVars ++ TailVars,
- StateVars = HeadStateVars ++ TailStateVars,
- MaybeVars = ok2(Vars, StateVars)
+ (
+ VarKind = os_ordinary_var(V),
+ ( list.member(V, TailVars) ->
+ generate_repeated_var_msg(ContextPieces, VarSet,
+ HeadTerm, Spec),
+ MaybeVars = error2([Spec])
+ ;
+ Vars = [V | TailVars],
+ MaybeVars = ok2(Vars, TailStateVars)
+ )
+ ;
+ VarKind = os_state_var(SV),
+ ( list.member(SV, TailStateVars) ->
+ generate_repeated_state_var_msg(ContextPieces, VarSet,
+ HeadTerm, Spec),
+ MaybeVars = error2([Spec])
+ ;
+ StateVars = [SV | TailStateVars],
+ MaybeVars = ok2(TailVars, StateVars)
+ )
+ )
;
MaybeVarsTail = error2(_),
MaybeVars = MaybeVarsTail
)
;
- TermStr = describe_error_term(VarSet, Term),
- Pieces = ContextPieces ++ [lower_case_next_if_not_first,
- words("Expected variable or state variable, not"),
- words(TermStr), suffix("."), nl],
- Spec = error_spec(severity_error, phase_term_to_parse_tree,
- [simple_msg(get_term_context(HeadTerm), [always(Pieces)])]),
+ generate_unexpected_term_message(ContextPieces, VarSet,
+ "variable or state variable", HeadTerm, Spec),
MaybeVars = error2([Spec])
)
;
- TermStr = describe_error_term(VarSet, Term),
- Pieces = ContextPieces ++ [lower_case_next_if_not_first,
- words("Expected list of variables and/or state variables, not"),
- words(TermStr), suffix("."), nl],
- Spec = error_spec(severity_error, phase_term_to_parse_tree,
- [simple_msg(get_term_context(Term), [always(Pieces)])]),
+ generate_unexpected_term_message(ContextPieces, VarSet,
+ "list of variables and/or state variables", Term, Spec),
MaybeVars = error2([Spec])
).
+:- type ordinary_state_dot_colon_var(T)
+ ---> osdc_ordinary_var(var(T))
+ ; osdc_state_var(var(T))
+ ; osdc_dot_var(var(T))
+ ; osdc_colon_var(var(T)).
+
parse_vars_and_state_vars(Term, VarSet, ContextPieces, MaybeVars) :-
( Term = functor(atom("[]"), [], _) ->
- MaybeVars = ok3([], [], [])
+ MaybeVars = ok4([], [], [], [])
; Term = functor(atom("[|]"), [HeadTerm, Tail], _) ->
(
(
- HeadTerm = functor(atom("!"), [variable(SV, _)], _),
- HeadVars = [],
- HeadDotVars = [SV],
- HeadColonVars = [SV]
- ;
- HeadTerm = functor(atom("!."), [variable(SV, _)], _),
- HeadVars = [],
- HeadDotVars = [SV],
- HeadColonVars = []
- ;
- HeadTerm = functor(atom("!:"), [variable(SV, _)], _),
- HeadVars = [],
- HeadDotVars = [],
- HeadColonVars = [SV]
- ;
- HeadTerm = variable(V, _),
- HeadVars = [V],
- HeadDotVars = [],
- HeadColonVars = []
+ HeadTerm = variable(V0, _),
+ VarKind = osdc_ordinary_var(V0)
+ ;
+ HeadTerm = functor(atom("!"), [variable(SV0, _)], _),
+ VarKind = osdc_state_var(SV0)
+ ;
+ HeadTerm = functor(atom("!."), [variable(SV0, _)], _),
+ VarKind = osdc_dot_var(SV0)
+ ;
+ HeadTerm = functor(atom("!:"), [variable(SV0, _)], _),
+ VarKind = osdc_colon_var(SV0)
)
->
parse_vars_and_state_vars(Tail, VarSet, ContextPieces,
MaybeVarsTail),
(
- MaybeVarsTail = ok3(TailVars, TailDotVars, TailColonVars),
- Vars = HeadVars ++ TailVars,
- DotVars = HeadDotVars ++ TailDotVars,
- ColonVars = HeadColonVars ++ TailColonVars,
- MaybeVars = ok3(Vars, DotVars, ColonVars)
+ MaybeVarsTail = ok4(TailVars, TailStateVars,
+ TailDotVars, TailColonVars),
+ (
+ VarKind = osdc_ordinary_var(V),
+ ( list.member(V, TailVars) ->
+ generate_repeated_var_msg(ContextPieces, VarSet,
+ HeadTerm, Spec),
+ MaybeVars = error4([Spec])
+ ;
+ Vars = [V | TailVars],
+ MaybeVars = ok4(Vars, TailStateVars,
+ TailDotVars, TailColonVars)
+ )
+ ;
+ VarKind = osdc_state_var(SV),
+ (
+ ( list.member(SV, TailStateVars )
+ ; list.member(SV, TailDotVars )
+ ; list.member(SV, TailColonVars )
+ )
+ ->
+ generate_repeated_var_msg(ContextPieces, VarSet,
+ HeadTerm, Spec),
+ MaybeVars = error4([Spec])
+ ;
+ StateVars = [SV | TailStateVars],
+ MaybeVars = ok4(TailVars, StateVars,
+ TailDotVars, TailColonVars)
+ )
+ ;
+ VarKind = osdc_dot_var(SV),
+ (
+ ( list.member(SV, TailStateVars )
+ ; list.member(SV, TailDotVars )
+ ; list.member(SV, TailColonVars )
+ )
+ ->
+ generate_repeated_var_msg(ContextPieces, VarSet,
+ HeadTerm, Spec),
+ MaybeVars = error4([Spec])
+ ;
+ DotVars = [SV | TailDotVars],
+ MaybeVars = ok4(TailVars, TailStateVars,
+ DotVars, TailColonVars)
+ )
+ ;
+ VarKind = osdc_colon_var(SV),
+ (
+ ( list.member(SV, TailStateVars )
+ ; list.member(SV, TailDotVars )
+ ; list.member(SV, TailColonVars )
+ )
+ ->
+ generate_repeated_var_msg(ContextPieces, VarSet,
+ HeadTerm, Spec),
+ MaybeVars = error4([Spec])
+ ;
+ ColonVars = [SV | TailColonVars],
+ MaybeVars = ok4(TailVars, TailStateVars,
+ TailDotVars, ColonVars)
+ )
+ )
;
- MaybeVarsTail = error3(_),
+ MaybeVarsTail = error4(_),
MaybeVars = MaybeVarsTail
)
;
+ generate_unexpected_term_message(ContextPieces, VarSet,
+ "variable or state variable", HeadTerm, Spec),
+ MaybeVars = error4([Spec])
+ )
+ ;
+ generate_unexpected_term_message(ContextPieces, VarSet,
+ "list of variables and/or state variables", Term, Spec),
+ MaybeVars = error4([Spec])
+ ).
+
+:- pred generate_repeated_var_msg(list(format_component)::in,
+ varset(T)::in, term(T)::in, error_spec::out) is det.
+
+generate_repeated_var_msg(ContextPieces, VarSet, Term, Spec) :-
TermStr = describe_error_term(VarSet, Term),
Pieces = ContextPieces ++ [lower_case_next_if_not_first,
- words("Expected variable or state variable, not"),
- words(TermStr), suffix("."), nl],
+ words("Repeated variable"), words(TermStr), suffix("."), nl],
Spec = error_spec(severity_error, phase_term_to_parse_tree,
- [simple_msg(get_term_context(HeadTerm), [always(Pieces)])]),
- MaybeVars = error3([Spec])
- )
- ;
+ [simple_msg(get_term_context(Term), [always(Pieces)])]).
+
+:- pred generate_repeated_state_var_msg(list(format_component)::in,
+ varset(T)::in, term(T)::in, error_spec::out) is det.
+
+generate_repeated_state_var_msg(ContextPieces, VarSet, Term, Spec) :-
TermStr = describe_error_term(VarSet, Term),
Pieces = ContextPieces ++ [lower_case_next_if_not_first,
- words("Expected list of variables and/or state variables, not"),
- words(TermStr), suffix("."), nl],
+ words("Repeated state variable"), words(TermStr), suffix("."), nl],
Spec = error_spec(severity_error, phase_term_to_parse_tree,
- [simple_msg(get_term_context(Term), [always(Pieces)])]),
- MaybeVars = error3([Spec])
- ).
+ [simple_msg(get_term_context(Term), [always(Pieces)])]).
+
+:- pred generate_unexpected_term_message(list(format_component)::in,
+ varset(T)::in, string::in, term(T)::in, error_spec::out) is det.
+
+generate_unexpected_term_message(ContextPieces, VarSet, Expected, Term,
+ Spec) :-
+ TermStr = describe_error_term(VarSet, Term),
+ Pieces = ContextPieces ++ [lower_case_next_if_not_first,
+ words("Expected"), words(Expected), suffix(","),
+ words("not"), words(TermStr), suffix("."), nl],
+ Spec = error_spec(severity_error, phase_term_to_parse_tree,
+ [simple_msg(get_term_context(Term), [always(Pieces)])]).
%-----------------------------------------------------------------------------%
Index: compiler/prog_item.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_item.m,v
retrieving revision 1.41
diff -u -b -r1.41 prog_item.m
--- compiler/prog_item.m 29 Dec 2010 04:52:18 -0000 1.41
+++ compiler/prog_item.m 26 Feb 2011 06:51:52 -0000
@@ -241,7 +241,7 @@
prom_type :: promise_type,
prom_clause :: goal,
prom_varset :: prog_varset,
- prom_univ_quant_vars :: prog_vars,
+ prom_univ_quant_vars :: list(prog_var),
prom_context :: prog_context,
prom_seq_num :: int
).
@@ -695,7 +695,7 @@
sharing_p_or_f :: pred_or_func,
sharing_name :: sym_name,
sharing_mode :: list(mer_mode),
- sharing_headvars :: prog_vars,
+ sharing_headvars :: list(prog_var),
sharing_headvartypes :: list(mer_type),
sharing_description :: maybe(structure_sharing_domain)
)
@@ -710,7 +710,7 @@
reuse_p_or_f :: pred_or_func,
reuse_name :: sym_name,
reuse_mode :: list(mer_mode),
- reuse_headvars :: prog_vars,
+ reuse_headvars :: list(prog_var),
reuse_headvartypes :: list(mer_type),
reuse_description :: maybe(structure_reuse_domain)
)
@@ -759,34 +759,37 @@
% (non-empty) disjunction
; fail_expr % empty disjunction
- % quantifiers
- ; some_expr(prog_vars, goal)
+ % quantifiers; the list of prog_vars should have no duplicates
+ ; some_expr(list(prog_var), goal)
% existential quantification
- ; all_expr(prog_vars, goal)
+ ; all_expr(list(prog_var), goal)
% universal quantification
- ; some_state_vars_expr(prog_vars, goal)
- ; all_state_vars_expr(prog_vars, goal)
+ ; some_state_vars_expr(list(prog_var), goal)
+ ; all_state_vars_expr(list(prog_var), goal)
% state variables extracted from
% some/2 and all/2 quantifiers.
% other scopes
; promise_purity_expr(purity, goal)
; promise_equivalent_solutions_expr(
- prog_vars, % OrdinaryVars
- prog_vars, % DotStateVars
- prog_vars, % ColonStateVars
+ list(prog_var), % OrdinaryVars
+ list(prog_var), % StateVars (!V)
+ list(prog_var), % DotStateVars (!.V)
+ list(prog_var), % ColonStateVars (!:V)
goal
)
; promise_equivalent_solution_sets_expr(
- prog_vars, % OrdinaryVars
- prog_vars, % DotStateVars
- prog_vars, % ColonStateVars
+ list(prog_var), % OrdinaryVars
+ list(prog_var), % StateVars (!V)
+ list(prog_var), % DotStateVars (!.V)
+ list(prog_var), % ColonStateVars (!:V)
goal
)
; promise_equivalent_solution_arbitrary_expr(
- prog_vars, % OrdinaryVars
- prog_vars, % DotStateVars
- prog_vars, % ColonStateVars
+ list(prog_var), % OrdinaryVars
+ list(prog_var), % StateVars (!V)
+ list(prog_var), % DotStateVars (!.V)
+ list(prog_var), % ColonStateVars (!:V)
goal
)
; require_detism_expr(
@@ -819,7 +822,7 @@
aexpr_inner :: atomic_component_state,
aexpr_output_vars :: maybe(list(prog_var)),
aexpr_main_goal :: goal,
- aexpr_orelse_goals :: goals
+ aexpr_orelse_goals :: list(goal)
)
; try_expr(
tryexpr_maybe_io :: maybe(prog_var),
@@ -838,7 +841,7 @@
% negation and if-then-else
; not_expr(goal)
- ; if_then_else_expr(prog_vars, prog_vars, goal, goal, goal)
+ ; if_then_else_expr(list(prog_var), list(prog_var), goal, goal, goal)
% if_then_else(SomeVars, StateVars, If, Then, Else)
% atomic goals
Index: compiler/prog_mode.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_mode.m,v
retrieving revision 1.23
diff -u -b -r1.23 prog_mode.m
--- compiler/prog_mode.m 15 Dec 2010 06:29:57 -0000 1.23
+++ compiler/prog_mode.m 1 Mar 2011 08:53:43 -0000
@@ -36,6 +36,10 @@
:- func di_mode = mer_mode.
:- pred uo_mode(mer_mode::out) is det.
:- func uo_mode = mer_mode.
+:- pred mdi_mode(mer_mode::out) is det.
+:- func mdi_mode = mer_mode.
+:- pred muo_mode(mer_mode::out) is det.
+:- func muo_mode = mer_mode.
:- pred unused_mode(mer_mode::out) is det.
:- func unused_mode = mer_mode.
:- func in_any_mode = mer_mode.
@@ -147,6 +151,8 @@
out_mode(out_mode).
di_mode(di_mode).
uo_mode(uo_mode).
+mdi_mode(mdi_mode).
+muo_mode(muo_mode).
unused_mode(unused_mode).
in_mode = make_std_mode("in", []).
@@ -155,6 +161,8 @@
out_mode(I) = make_std_mode("out", [I]).
di_mode = make_std_mode("di", []).
uo_mode = make_std_mode("uo", []).
+mdi_mode = make_std_mode("mdi", []).
+muo_mode = make_std_mode("muo", []).
unused_mode = make_std_mode("unused", []).
in_any_mode = make_std_mode("in", [any_inst]).
out_any_mode = make_std_mode("out", [any_inst]).
Index: compiler/prog_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_util.m,v
retrieving revision 1.111
diff -u -b -r1.111 prog_util.m
--- compiler/prog_util.m 29 Dec 2010 04:52:18 -0000 1.111
+++ compiler/prog_util.m 26 Feb 2011 18:00:54 -0000
@@ -315,31 +315,34 @@
rename_in_goal(OldVar, NewVar, Goal0, Goal),
Expr = promise_purity_expr(Purity, Goal)
;
- Expr0 = promise_equivalent_solutions_expr(Vars0,
+ Expr0 = promise_equivalent_solutions_expr(Vars0, StateVars0,
DotSVars0, ColonSVars0, Goal0),
rename_in_vars(OldVar, NewVar, Vars0, Vars),
+ rename_in_vars(OldVar, NewVar, StateVars0, StateVars),
rename_in_vars(OldVar, NewVar, DotSVars0, DotSVars),
rename_in_vars(OldVar, NewVar, ColonSVars0, ColonSVars),
rename_in_goal(OldVar, NewVar, Goal0, Goal),
- Expr = promise_equivalent_solutions_expr(Vars,
+ Expr = promise_equivalent_solutions_expr(Vars, StateVars,
DotSVars, ColonSVars, Goal)
;
- Expr0 = promise_equivalent_solution_sets_expr(Vars0,
+ Expr0 = promise_equivalent_solution_sets_expr(Vars0, StateVars0,
DotSVars0, ColonSVars0, Goal0),
rename_in_vars(OldVar, NewVar, Vars0, Vars),
+ rename_in_vars(OldVar, NewVar, StateVars0, StateVars),
rename_in_vars(OldVar, NewVar, DotSVars0, DotSVars),
rename_in_vars(OldVar, NewVar, ColonSVars0, ColonSVars),
rename_in_goal(OldVar, NewVar, Goal0, Goal),
- Expr = promise_equivalent_solution_sets_expr(Vars,
+ Expr = promise_equivalent_solution_sets_expr(Vars, StateVars,
DotSVars, ColonSVars, Goal)
;
- Expr0 = promise_equivalent_solution_arbitrary_expr(Vars0,
+ Expr0 = promise_equivalent_solution_arbitrary_expr(Vars0, StateVars0,
DotSVars0, ColonSVars0, Goal0),
rename_in_vars(OldVar, NewVar, Vars0, Vars),
+ rename_in_vars(OldVar, NewVar, StateVars0, StateVars),
rename_in_vars(OldVar, NewVar, DotSVars0, DotSVars),
rename_in_vars(OldVar, NewVar, ColonSVars0, ColonSVars),
rename_in_goal(OldVar, NewVar, Goal0, Goal),
- Expr = promise_equivalent_solution_arbitrary_expr(Vars,
+ Expr = promise_equivalent_solution_arbitrary_expr(Vars, StateVars,
DotSVars, ColonSVars, Goal)
;
Expr0 = require_detism_expr(Detism, Goal0),
@@ -619,7 +622,7 @@
; ConsId = deep_profiling_proc_layout(_)
; ConsId = table_io_decl(_)
),
- unexpected(this_file, "cons_id_arity: unexpected cons_id")
+ unexpected($module, $pred, "unexpected cons_id")
).
cons_id_maybe_arity(cons(_, Arity, _)) = yes(Arity).
@@ -674,8 +677,7 @@
FuncArgs = FuncArgs0,
FuncReturn = FuncReturn0
;
- unexpected(this_file,
- "pred_args_to_func_args: function missing return value?")
+ unexpected($module, $pred, "function missing return value?")
).
get_state_args(Args0, Args, State0, State) :-
@@ -689,7 +691,7 @@
State0 = State0A,
State = StateA
;
- unexpected(this_file, "get_state_args_det")
+ unexpected($module, $pred)
).
%-----------------------------------------------------------------------------%
@@ -766,11 +768,5 @@
conj_expr(Goal0, goal_list_to_conj_2(Context, Goal1, Goals)) - Context.
%-----------------------------------------------------------------------------%
-
-:- func this_file = string.
-
-this_file = "prog_util.m".
-
-%-----------------------------------------------------------------------------%
:- end_module prog_util.
%-----------------------------------------------------------------------------%
Index: compiler/purity.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/purity.m,v
retrieving revision 1.141
diff -u -b -r1.141 purity.m
--- compiler/purity.m 2 Jan 2011 14:37:58 -0000 1.141
+++ compiler/purity.m 26 Feb 2011 04:56:54 -0000
@@ -408,7 +408,7 @@
purity::out, purity_info::in, purity_info::out) is det.
compute_purity_for_clause(Clause0, Clause, PredInfo, Purity, !Info) :-
- Clause0 = clause(Ids, Goal0, Lang, Context),
+ Goal0 = Clause0 ^ clause_body,
Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
!Info ^ pi_requant := do_not_need_to_requantify,
compute_expr_purity(GoalExpr0, GoalExpr1, GoalInfo0, BodyPurity0, _,
@@ -460,11 +460,12 @@
NeedToRequantify = do_not_need_to_requantify,
Goal = Goal1
),
- Clause = clause(Ids, Goal, Lang, Context).
+ Clause = Clause0 ^ clause_body := Goal.
:- pred applies_to_all_modes(clause::in, list(proc_id)::in) is semidet.
-applies_to_all_modes(clause(ApplicableProcIds, _, _, _), AllProcIds) :-
+applies_to_all_modes(Clause, AllProcIds) :-
+ ApplicableProcIds = Clause ^ clause_applicable_procs,
(
ApplicableProcIds = all_modes
;
Index: compiler/simplify.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/simplify.m,v
retrieving revision 1.257
diff -u -b -r1.257 simplify.m
--- compiler/simplify.m 6 Feb 2011 07:30:04 -0000 1.257
+++ compiler/simplify.m 1 Mar 2011 23:00:20 -0000
@@ -991,15 +991,6 @@
!.GoalExpr = switch(_, _, _),
simplify_goal_switch(!GoalExpr, !GoalInfo, !Info)
;
- !.GoalExpr = generic_call(_, _, _, _),
- simplify_goal_generic_call(!GoalExpr, !GoalInfo, !Info)
- ;
- !.GoalExpr = plain_call(_, _, _, _, _, _),
- simplify_goal_plain_call(!GoalExpr, !GoalInfo, !Info)
- ;
- !.GoalExpr = unify(_, _, _, _, _),
- simplify_goal_unify(!GoalExpr, !GoalInfo, !Info)
- ;
!.GoalExpr = if_then_else(_, _, _, _),
simplify_goal_ite(!GoalExpr, !GoalInfo, !Info)
;
@@ -1009,6 +1000,15 @@
!.GoalExpr = scope(_, _),
simplify_goal_scope(!GoalExpr, !GoalInfo, !Info)
;
+ !.GoalExpr = unify(_, _, _, _, _),
+ simplify_goal_unify(!GoalExpr, !GoalInfo, !Info)
+ ;
+ !.GoalExpr = plain_call(_, _, _, _, _, _),
+ simplify_goal_plain_call(!GoalExpr, !GoalInfo, !Info)
+ ;
+ !.GoalExpr = generic_call(_, _, _, _),
+ simplify_goal_generic_call(!GoalExpr, !GoalInfo, !Info)
+ ;
!.GoalExpr = call_foreign_proc(_, _, _, _, _, _, _),
simplify_goal_foreign_proc(!GoalExpr, !GoalInfo, !Info)
;
@@ -2573,14 +2573,18 @@
hlds_goal_info::in, hlds_goal_info::out,
simplify_info::in, simplify_info::out) is semidet.
-simplify_library_call("builtin", "compare", _ModeNum, _CrossCompiling,
+simplify_library_call(ModuleName, PredName, _ModeNum, CrossCompiling,
CanCompareCompoundValues, Args, GoalExpr, !GoalInfo, !Info) :-
+ (
+ ModuleName = "builtin",
+ PredName = "compare",
+
% On the Erlang backend, it is faster for us to use builtin comparison
% operators on high level data structures than to deconstruct the data
- % structure and compare the atomic constituents. We can only do this on
- % values of types which we know not to have user-defined equality
+ % structure and compare the atomic constituents. We can only do this
+ % on values of types which we know not to have user-defined equality
% predicates.
- %
+
CanCompareCompoundValues = yes,
list.reverse(Args, [Y, X, Res | _]),
simplify_info_get_module_info(!.Info, ModuleInfo),
@@ -2588,6 +2592,7 @@
map.lookup(VarTypes, Y, Type),
type_definitely_has_no_user_defined_equality_pred(ModuleInfo, Type),
+ require_det (
Context = goal_info_get_context(!.GoalInfo),
goal_util.generate_simple_call(mercury_private_builtin_module,
"builtin_compound_eq", pf_predicate, only_mode, detism_semi,
@@ -2600,44 +2605,52 @@
Builtin = mercury_public_builtin_module,
TypeCtor = type_ctor(
- qualified(mercury_public_builtin_module, "comparison_result"), 0),
- make_const_construction(Res, cons(qualified(Builtin, "="), 0, TypeCtor),
- ReturnEq),
- make_const_construction(Res, cons(qualified(Builtin, "<"), 0, TypeCtor),
- ReturnLt),
- make_const_construction(Res, cons(qualified(Builtin, ">"), 0, TypeCtor),
- ReturnGt),
+ qualified(mercury_public_builtin_module, "comparison_result"),
+ 0),
+ make_const_construction(Res,
+ cons(qualified(Builtin, "="), 0, TypeCtor), ReturnEq),
+ make_const_construction(Res,
+ cons(qualified(Builtin, "<"), 0, TypeCtor), ReturnLt),
+ make_const_construction(Res,
+ cons(qualified(Builtin, ">"), 0, TypeCtor), ReturnGt),
NonLocals = set.from_list([Res, X, Y]),
goal_info_set_nonlocals(NonLocals, !GoalInfo),
- GoalExpr = if_then_else([], CondEq, ReturnEq, Rest),
- Rest = hlds_goal(if_then_else([], CondLt, ReturnLt, ReturnGt), !.GoalInfo).
-
-simplify_library_call("int", PredName, _ModeNum, CrossCompiling,
- _CanCompareCompoundValues, Args, GoalExpr, !GoalInfo, !Info) :-
+ RestExpr = if_then_else([], CondLt, ReturnLt, ReturnGt),
+ Rest = hlds_goal(RestExpr, !.GoalInfo),
+ GoalExpr = if_then_else([], CondEq, ReturnEq, Rest)
+ )
+ ;
+ ModuleName = "int",
simplify_do_const_prop(!.Info),
CrossCompiling = no,
(
PredName = "quot_bits_per_int",
Args = [X, Y],
- % There is no point in checking whether bits_per_int is 0; it isn't.
+ % There is no point in checking whether bits_per_int is 0;
+ % it isn't.
Op = "unchecked_quotient",
- simplify_library_call_int_arity2(Op, X, Y, GoalExpr, !GoalInfo, !Info)
+ simplify_library_call_int_arity2(Op, X, Y, GoalExpr,
+ !GoalInfo, !Info)
;
PredName = "times_bits_per_int",
Args = [X, Y],
Op = "*",
- simplify_library_call_int_arity2(Op, X, Y, GoalExpr, !GoalInfo, !Info)
+ simplify_library_call_int_arity2(Op, X, Y, GoalExpr,
+ !GoalInfo, !Info)
;
PredName = "rem_bits_per_int",
Args = [X, Y],
- % There is no point in checking whether bits_per_int is 0; it isn't.
+ % There is no point in checking whether bits_per_int is 0;
+ % it isn't.
Op = "unchecked_rem",
- simplify_library_call_int_arity2(Op, X, Y, GoalExpr, !GoalInfo, !Info)
+ simplify_library_call_int_arity2(Op, X, Y, GoalExpr,
+ !GoalInfo, !Info)
;
PredName = "bits_per_int",
Args = [X],
+ require_det (
ConstConsId = int_const(int.bits_per_int),
RHS = rhs_functor(ConstConsId, no, []),
ModeOfX = out_mode,
@@ -2646,10 +2659,13 @@
How = construct_dynamically,
IsUnique = cell_is_shared,
Sub = no_construct_sub_info,
- Unification = construct(X, ConstConsId, [], [], How, IsUnique, Sub),
+ Unification = construct(X, ConstConsId, [], [], How,
+ IsUnique, Sub),
UnifyMainContext = umc_implicit("simplify_library_call"),
UnifyContext = unify_context(UnifyMainContext, []),
GoalExpr = unify(X, RHS, UnifyMode, Unification, UnifyContext)
+ )
+ )
).
:- pred simplify_library_call_int_arity2(string::in,
@@ -2707,16 +2723,118 @@
% For some reason, the compiler records the original arity of
% int.unchecked_quotient as 3, not 2. Don't check the arities
% until this is fixed.
-simplify_may_introduce_calls("private_builtin", "builtin_compound_eq", _).
-simplify_may_introduce_calls("private_builtin", "builtin_compound_lt", _).
-simplify_may_introduce_calls("int", "unchecked_quotient", _).
-simplify_may_introduce_calls("int", "unchecked_rem", _).
-simplify_may_introduce_calls("int", "*", _).
-simplify_may_introduce_calls("io", "write_string", _).
-simplify_may_introduce_calls("string", "int_to_string", _).
-simplify_may_introduce_calls("string", "char_to_string", _).
-simplify_may_introduce_calls("string", "float_to_string", _).
-simplify_may_introduce_calls("string", "++", _).
+simplify_may_introduce_calls(ModuleName, PredName, _Arity) :-
+ (
+ ModuleName = "private_builtin",
+ ( PredName = "builtin_compound_eq"
+ ; PredName = "builtin_compound_lt"
+ ; PredName = "state_var_copy"
+ )
+ ;
+ ModuleName = "int",
+ ( PredName = "unchecked_quotient"
+ ; PredName = "unchecked_rem"
+ ; PredName = "*"
+ )
+ ;
+ ModuleName = "io",
+ PredName = "write_string"
+ ;
+ ModuleName = "string",
+ ( PredName = "int_to_string"
+ ; PredName = "char_to_string"
+ ; PredName = "float_to_string"
+ ; PredName = "++"
+ )
+ ;
+ ModuleName = "table_builtin",
+
+ ( PredName = "table_lookup_insert_start_int"
+ ; PredName = "table_lookup_insert_int"
+ ; PredName = "table_lookup_insert_float"
+ ; PredName = "table_lookup_insert_char"
+ ; PredName = "table_lookup_insert_string"
+ ; PredName = "table_lookup_insert_enum"
+ ; PredName = "table_lookup_insert_foreign_enum"
+ ; PredName = "table_lookup_insert_gen"
+ ; PredName = "table_lookup_insert_addr"
+ ; PredName = "table_lookup_insert_poly"
+ ; PredName = "table_lookup_insert_poly_addr"
+ ; PredName = "table_lookup_insert_typeinfo"
+ ; PredName = "table_lookup_insert_typeclassinfo"
+
+ ; PredName = "table_lookup_save_int_answer"
+ ; PredName = "table_lookup_save_char_answer"
+ ; PredName = "table_lookup_save_string_answer"
+ ; PredName = "table_lookup_save_float_answer"
+ ; PredName = "table_lookup_save_io_state_answer"
+ ; PredName = "table_lookup_save_any_answer"
+
+ ; PredName = "table_lookup_restore_int_answer"
+ ; PredName = "table_lookup_restore_char_answer"
+ ; PredName = "table_lookup_restore_string_answer"
+ ; PredName = "table_lookup_restore_float_answer"
+ ; PredName = "table_lookup_restore_io_state_answer"
+ ; PredName = "table_lookup_restore_any_answer"
+
+ ; PredName = "table_loop_setup"
+ ; PredName = "table_loop_setup_shortcut"
+ ; PredName = "table_loop_mark_as_inactive"
+ ; PredName = "table_loop_mark_as_inactive_and_fail"
+ ; PredName = "table_loop_mark_as_active_and_fail"
+
+ ; PredName = "table_memo_det_setup"
+ ; PredName = "table_memo_det_setup_shortcut"
+ ; PredName = "table_memo_semi_setup"
+ ; PredName = "table_memo_semi_setup_shortcut"
+ ; PredName = "table_memo_non_setup"
+ ; PredName = "table_memo_mark_as_failed"
+ ; PredName = "table_memo_mark_as_succeeded"
+ ; PredName = "table_memo_mark_as_incomplete"
+ ; PredName = "table_memo_mark_as_active_and_fail"
+ ; PredName = "table_memo_mark_as_complete_and_fail"
+ ; PredName = "table_memo_create_answer_block"
+ ; PredName = "table_memo_get_answer_block"
+ ; PredName = "table_memo_non_get_answer_table"
+ ; PredName = "table_memo_non_answer_is_not_duplicate"
+ ; PredName = "table_memo_non_answer_is_not_duplicate_shortcut"
+ ; PredName = "table_memo_return_all_answers_nondet"
+ ; PredName = "table_memo_return_all_answers_multi"
+ ; PredName = "table_memo_non_return_all_shortcut"
+
+ ; PredName = "table_io_in_range"
+ ; PredName = "table_io_has_occurred"
+ ; PredName = "table_io_copy_io_state"
+ ; PredName = "table_io_left_bracket_unitized_goal"
+ ; PredName = "table_io_right_bracket_unitized_goal"
+
+ ; PredName = "table_mm_setup"
+ ; PredName = "table_mm_suspend_consumer"
+ ; PredName = "table_mm_completion"
+ ; PredName = "table_mm_get_answer_table"
+ ; PredName = "table_mm_answer_is_not_duplicate"
+ ; PredName = "table_mm_answer_is_not_duplicate_shortcut"
+ ; PredName = "table_mm_create_answer_block"
+ ; PredName = "table_mm_fill_answer_block_shortcut"
+ ; PredName = "table_mm_return_all_nondet"
+ ; PredName = "table_mm_return_all_multi"
+ ; PredName = "table_mm_return_all_shortcut"
+
+ ; PredName = "table_mmos_save_inputs"
+ ; PredName = "table_mmos_setup_consumer"
+ ; PredName = "table_mmos_answer_is_not_duplicate"
+ ; PredName = "table_mmos_answer_is_not_duplicate_shortcut"
+ ; PredName = "table_mmos_consume_next_answer_nondet"
+ ; PredName = "table_mmos_consume_next_answer_multi"
+ ; PredName = "table_mmos_restore_answers"
+ ; PredName = "table_mmos_pickup_inputs"
+ ; PredName = "table_mmos_create_answer_block"
+ ; PredName = "table_mmos_return_answer"
+ ; PredName = "table_mmos_completion"
+
+ ; PredName = "table_error"
+ )
+ ).
%-----------------------------------------------------------------------------%
Index: compiler/state_var.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/state_var.m,v
retrieving revision 1.35
diff -u -b -r1.35 state_var.m
--- compiler/state_var.m 31 Jan 2011 19:30:35 -0000 1.35
+++ compiler/state_var.m 2 Mar 2011 02:43:04 -0000
@@ -15,133 +15,152 @@
:- interface.
:- import_module hlds.hlds_goal.
+:- import_module hlds.make_hlds.goal_expr_to_goal.
:- import_module mdbcomp.prim_data.
:- import_module parse_tree.error_util.
:- import_module parse_tree.prog_data.
:- import_module list.
:- import_module map.
-:- import_module set.
%-----------------------------------------------------------------------------%
- % This synonym improves code legibility.
+ % This synonym improves code legibility. The intention is that we use
+ % svar instead of prog_var in pred type declarations for any variables X
+ % that represent state variables !X.
%
:- type svar == prog_var.
-:- type svars == list(svar).
-
- % A set of state variables.
+ % When collecting the arms of a disjunction, we also need to collect
+ % the resulting svar_states.
%
-:- type svar_set == set(svar).
+:- type hlds_goal_svar_state
+ ---> hlds_goal_svar_state(hlds_goal, svar_state).
- % A mapping from state variables to logical variables.
- %
-:- type svar_map == map(svar, prog_var).
+ % The state of the currently visible state variables. The state gets
+ % updated differently along differently execution paths. When execution
+ % paths rejoin, you need to create the state after the rejoin from the
+ % states being rejoined (which is what we use hlds_goal_svar_state for)
+ % using their last common ancestor state as a basis.
+:- type svar_state.
+
+ % The persistent information needed by the state variable transformation.
+ % The store should always be threaded straight through all computations
+ % involved in the translation of the parse tree to the HLDS, with all
+ % updates being permanent.
+:- type svar_store.
+
+%-----------------------------------------------------------------------------%
- % This controls how state variables are dealt with.
+ % Replace !X args with two args !.X, !:X in that order.
%
-:- type svar_ctxt
- ---> in_head
- % In the head of a clause or lambda.
+:- pred expand_bang_states(list(prog_term)::in, list(prog_term)::out) is det.
+:- pred expand_bang_states_instance_body(instance_body::in,
+ instance_body::out) is det.
- ; in_body
- % In the body of a clause or lambda.
+%-----------------------------------------------------------------------------%
- ; in_atom(
- % In the context of an atomic goal at the level of the
- % source code.
+ % Prepare for processing a clause by processing its head.
+ % If the head contains any references to !.S or !:S or both,
+ % make state variable S known in the body of the clause.
+ % (The head should not contain any references to !S; those should
+ % have been expanded out by calling expand_bang_states BEFORE calling
+ % this predicate.)
+ %
+ % Given the original list of args, we return a version in which state
+ % variable references have been replaced. Since we don't yet know what
+ % the final values of the state variables will be, we create prog_vars
+ % to represent these values, and return a mapping from the state vars
+ % to these designated-final-value prog_vars.
+ %
+:- pred svar_prepare_for_clause_head(list(prog_term)::in, list(prog_term)::out,
+ prog_varset::in, prog_varset::out, map(svar, prog_var)::out,
+ svar_state::out, svar_store::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
- % The set of state variables X that have been referenced as !:X
- % in the parameters of the atomic goal.
- had_colon_reference :: svar_set,
+ % Finish processing a clause. Make the final values of the clause's state
+ % vars match the mapping we decided on when processing the head.
+ %
+:- pred svar_finish_clause_body(prog_context::in, map(svar, prog_var)::in,
+ list(hlds_goal)::in, hlds_goal::out,
+ svar_state::in, svar_state::in, svar_store::in,
+ list(error_spec)::out) is det.
+
+ % Prepare for processing a lambda expression by processing its head.
+ %
+ % In most ways, this is very similar to processing the head of a clause,
+ % but we also need to handle state variables which are visible in the scope
+ % that encloses the lambda expression. We make those state vars read-only
+ % within the lambda expression.
+ %
+:- pred svar_prepare_for_lambda_head(prog_context::in,
+ list(prog_term)::in, list(prog_term)::out,
+ map(svar, prog_var)::out, svar_state::in, svar_state::out,
+ prog_varset::in, prog_varset::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
- % The parent svar_info, used to keep track of nesting
- % in subterms of an atomic formula.
- parent_svar_info :: svar_info
- ).
+ % Finish processing a lambda expression.
+ %
+:- pred svar_finish_lambda_body(prog_context::in, map(svar, prog_var)::in,
+ list(hlds_goal)::in, hlds_goal::out,
+ svar_state::in, svar_state::in, svar_store::in, svar_store::out) is det.
-:- type svar_info.
+%-----------------------------------------------------------------------------%
- % When collecting the arms of a disjunction we also need to
- % collect the resulting svar_infos.
+ % Finish the execution of an atomic goal. If this goal was not inside
+ % another atomic goal, then make any updates to state variables performed
+ % by the atomic goal take effect: make the value assigned to !:S inside
+ % the goal the new !.S.
%
-:- type hlds_goal_svar_info
- ---> hlds_goal_svar_info(hlds_goal, svar_info).
+:- pred svar_finish_atomic_goal(loc_kind::in, svar_state::in, svar_state::out)
+ is det.
-:- type hlds_goal_svar_infos == list(hlds_goal_svar_info).
+%-----------------------------------------------------------------------------%
- % Obtain the mapping for a !.X state variable reference and
- % update the svar_info.
- %
- % If we are processing the head of a clause or lambda, we incrementally
- % accumulate the mappings.
- %
- % Otherwise, the mapping must already be present for a local or `external'
- % state variable (i.e. one that may be visible, but not updatable, in the
- % current context.)
- %
- % Note that if !.X does not appear in the head then !:X must appear
- % before !.X can be referenced.
+ % Add some local state variables.
%
-:- pred svar_dot(prog_context::in, svar::in, prog_var::out,
- prog_varset::in, prog_varset::out, svar_info::in, svar_info::out,
+:- pred svar_prepare_for_local_state_vars(prog_context::in, prog_varset::in,
+ list(svar)::in, svar_state::in, svar_state::out,
list(error_spec)::in, list(error_spec)::out) is det.
- % Obtain the mapping for a !:X state variable reference.
- %
- % If we are processing the head of a clause or lambda, we incrementally
- % accumulate the mappings.
- %
- % Otherwise, the mapping must already be present for a local state variable
- % (`externally' visible state variables cannot be updated.)
- %
- % We also keep track of which state variables have been updated
- % in an atomic context.
+ % Remove some local state variables.
%
-:- pred svar_colon(prog_context::in, svar::in, prog_var::out,
- prog_varset::in, prog_varset::out, svar_info::in, svar_info::out,
- list(error_spec)::in, list(error_spec)::out) is det.
+:- pred svar_finish_local_state_vars(list(svar)::in, svar_state::in,
+ svar_state::in, svar_state::out) is det.
- % Prepare for the head of a new clause.
- %
-:- pred svar_prepare_for_head(svar_info::out) is det.
+%-----------------------------------------------------------------------------%
- % We need to add the current !.Xs to the set of external ("read-only")
- % state variables and clear the !.Xs and !:Xs.
- %
- % While processing the head, any state variables therein are implicitly
- % scoped over the body and have !. and !: mappings set up.
+ % Make sure that all arms of a disjunction produce the same state variable
+ % bindings, by adding unifiers as necessary.
%
-:- pred svar_prepare_for_lambda(svar_info::in, svar_info::out) is det.
+:- pred svar_finish_disjunction(prog_context::in,
+ list(hlds_goal_svar_state)::in, list(hlds_goal)::out,
+ prog_varset::in, prog_varset::out, svar_state::in, svar_state::out,
+ svar_store::in, svar_store::out) is det.
- % Having processed the head of a clause, prepare for the first
- % (source-level) atomic conjunct. We return the final !:
- % mappings identified while processing the head.
- %
-:- pred svar_prepare_for_body(svar_map::out, prog_varset::in, prog_varset::out,
- svar_info::in, svar_info::out) is det.
+%-----------------------------------------------------------------------------%
- % We have to conjoin the goals and add unifiers to tie up all
- % the final values of the state variables to the head variables.
+ % Add unifiers to the Then and Else arms of an if-then-else to make sure
+ % that all the state variables match up.
%
-:- pred svar_finish_goals(prog_context::in, svar_map::in,
- list(hlds_goal)::in, hlds_goal::out, svar_info::in) is det.
-
- % Add some local state variables.
+ % We also add unifiers to the Then arm for any new state variable
+ % mappings produced in the condition.
%
-:- pred prepare_for_local_state_vars(svars::in,
- prog_varset::in, prog_varset::out, svar_info::in, svar_info::out) is det.
+:- pred svar_finish_if_then_else(loc_kind::in, prog_context::in,
+ list(svar)::in,
+ hlds_goal::in, hlds_goal::out, hlds_goal::in, hlds_goal::out,
+ svar_state::in, svar_state::in, svar_state::in, svar_state::in,
+ svar_state::out, prog_varset::in, prog_varset::out,
+ svar_store::in, svar_store::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
- % Remove some local state variables.
- %
-:- pred finish_local_state_vars(svars::in, prog_vars::out,
- svar_info::in, svar_info::in, svar_info::out) is det.
+%-----------------------------------------------------------------------------%
:- type svar_outer_atomic_scope_info.
+:- type svar_inner_atomic_scope_info.
% svar_start_outer_atomic_scope(Context, OuterStateVar, OuterDI, OuterUO,
- % OuterScopeInfo, !VarSet, !SInfo, !Specs):
+ % OuterScopeInfo, !State, !VarSet, !Specs):
%
% This predicate converts a !OuterStateVar specification in an atomic scope
% to a pair of outer state variables, OuterDI and OuterUO. Since
@@ -152,7 +171,7 @@
%
:- pred svar_start_outer_atomic_scope(prog_context::in, prog_var::in,
prog_var::out, prog_var::out, svar_outer_atomic_scope_info::out,
- prog_varset::in, prog_varset::out, svar_info::in, svar_info::out,
+ svar_state::in, svar_state::out, prog_varset::in, prog_varset::out,
list(error_spec)::in, list(error_spec)::out) is det.
% svar_finish_outer_atomic_scope(OuterScopeInfo, !SInfo):
@@ -161,23 +180,21 @@
% svar_start_atomic_scope.
%
:- pred svar_finish_outer_atomic_scope(svar_outer_atomic_scope_info::in,
- svar_info::in, svar_info::out) is det.
-
-:- type svar_inner_atomic_scope_info.
+ svar_state::in, svar_state::out) is det.
% svar_start_inner_atomic_scope(Context, InnerStateVar, InnerScopeInfo,
- % !VarSet, !SInfo, !Specs):
+ % !State, !VarSet, !Specs):
%
% This predicate prepares for an atomic scope with an !InnerStateVar
% specification by making that state var available.
%
:- pred svar_start_inner_atomic_scope(prog_context::in, prog_var::in,
svar_inner_atomic_scope_info::out,
- prog_varset::in, prog_varset::out, svar_info::in, svar_info::out,
+ svar_state::in, svar_state::out, prog_varset::in, prog_varset::out,
list(error_spec)::in, list(error_spec)::out) is det.
% svar_finish_inner_atomic_scope(Context, InnerScopeInfo, InnerDI, InnerUO,
- % !VarSet, !SInfo, !Specs):
+ % !State, !VarSet, !Specs):
%
% This predicate ends an atomic scope with an !InnerStateVar
% specification by making that state var unavailable, and returning
@@ -186,136 +203,74 @@
%
:- pred svar_finish_inner_atomic_scope(prog_context::in,
svar_inner_atomic_scope_info::in, prog_var::out, prog_var::out,
- prog_varset::in, prog_varset::out, svar_info::in, svar_info::out,
+ svar_state::in, svar_state::out, prog_varset::in, prog_varset::out,
list(error_spec)::in, list(error_spec)::out) is det.
- % We have to add unifiers to the Then and Else arms of an
- % if-then-else to make sure all the state variables match up.
- %
- % More to the point, we have to add unifiers to the Then arm
- % for any new state variable mappings produced in the condition.
- %
- % We construct new mappings for the state variables and then
- % add unifiers.
- %
-:- pred svar_finish_if_then_else(prog_context::in,
- hlds_goal::in, hlds_goal::out, hlds_goal::in, hlds_goal::out,
- svar_info::in, svar_info::in, svar_info::in, svar_info::in, svar_info::out,
- prog_varset::in, prog_varset::out) is det.
-
-:- pred svar_finish_if_then_else_goal_condition(svars::in,
- svar_info::in, svar_info::in, svar_info::out, svar_info::out) is det.
-
-:- pred svar_finish_if_then_else_expr_condition(svar_info::in,
- svar_info::in, svar_info::out) is det.
-
-:- pred svar_finish_if_then_else_expr_then_goal(svars::in,
- svar_info::in, svar_info::in, svar_info::out) is det.
-
- % We assume that a negation updates all state variables in scope,
- % so we construct new mappings for the state variables and then
- % add unifiers from their pre-negated goal mappings.
- %
-:- pred svar_finish_negation(svar_info::in, svar_info::in, svar_info::out)
- is det.
+%-----------------------------------------------------------------------------%
- % We have to make sure that all arms of a disjunction produce the
- % same state variable bindings by adding unifiers as necessary.
+ % Given a list of argument terms, substitute !.X and !:X with the
+ % corresponding state variable mappings. Any !X should already have been
+ % expanded into !.X, !:X via a call to expand_bang_states.
%
-:- pred svar_finish_disjunction(prog_context::in, prog_varset::in,
- hlds_goal_svar_infos::in, list(hlds_goal)::out, svar_info::out) is det.
+:- pred substitute_state_var_mappings(list(prog_term)::in,
+ list(prog_term)::out, prog_varset::in, prog_varset::out,
+ svar_state::in, svar_state::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
- % We treat equivalence goals as if they were negations (they are
- % in a negated context after all.)
+ % Same as substitute_state_var_mappings, but for only one term.
%
-:- pred svar_finish_equivalence(svar_info::in, svar_info::in, svar_info::out)
- is det.
+:- pred substitute_state_var_mapping(prog_term::in, prog_term::out,
+ prog_varset::in, prog_varset::out, svar_state::in, svar_state::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
- % We prepare for a call by setting the ctxt to in_atom. If we're
- % already in an atom then we inherit the parent's set of "updated"
- % state variables.
+ % Look up the prog_var that represents the current state of the given
+ % state variable.
%
-:- pred svar_prepare_for_call(svar_info::in, svar_info::out) is det.
+:- pred lookup_dot_state_var(prog_context::in, svar::in, prog_var::out,
+ prog_varset::in, prog_varset::out, svar_state::in, svar_state::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
- % When we finish a call, we're either still inside the
- % atomic formula, in which case we simply propagate the set of
- % "updated" state variables, or we've just emerged, in which case
- % we need to set up the svar_info for the next conjunct.
+ % Look up the prog_var that represents the next state of the given
+ % state variable.
%
- % (We can still be in an atomic context if, for example, we've
- % been processing a function call which must appear as an
- % expression and hence occur inside an atomic context.)
- %
-:- pred svar_finish_call(prog_varset::in, prog_varset::out,
- svar_info::in, svar_info::out) is det.
-
-:- pred svar_prepare_for_if_then_else_goal(svars::in,
- prog_varset::in, prog_varset::out, svar_info::in, svar_info::out) is det.
-
-:- pred svar_finish_if_then_else_goal_then_goal(svars::in,
- svar_info::in, svar_info::in, svar_info::out) is det.
+:- pred lookup_colon_state_var(prog_context::in, svar::in, prog_var::out,
+ prog_varset::in, prog_varset::out, svar_state::in, svar_state::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
- % The condition of an if-then-else expression is a goal in which
- % only !.X state variables in scope are visible (although the goal
- % may use local state variables introduced via an explicit quantifier.)
- % The StateVars are local to the condition and then-goal.
- %
-:- pred svar_prepare_for_if_then_else_expr(svars::in,
- prog_varset::in, prog_varset::out, svar_info::in, svar_info::out) is det.
+%-----------------------------------------------------------------------------%
- % Having finished processing one source-level atomic conjunct, prepare
- % for the next. Note that if !:X was not seen in the conjunct we've
- % just processed, then we can reuse the !.X and !:X mappings.
- %
- % p(!.X) where [!.X -> X0, !:X -> X1]
+ % Flatten a conjunction while preserving the invariants that the state
+ % variable transformation cares about.
%
- % can yield
- %
- % p(X0) and [!.X -> X0, !:X -> X2]
- %
- % but
- %
- % p(!.X, !:X) where [!.X -> X0, !:X -> X1]
- %
- % will yield
- %
- % p(X0, X1) and [!.X -> X1, !:X -> X2]
- %
-:- pred svar_prepare_for_next_conjunct(svar_set::in,
- prog_varset::in, prog_varset::out, svar_info::in, svar_info::out) is det.
+:- pred svar_flatten_conj(prog_context::in,
+ list(hlds_goal)::in, hlds_goal::out,
+ svar_store::in, svar_store::out) is det.
- % Given a list of argument terms, substitute !.X and !:X with
- % the corresponding state variable mappings. Any !X should
- % already have been expanded into !.X, !:X via a call to
- % expand_bang_state_var_args/1.
+ % Flatten a goal into a conjunction while preserving the invariants that
+ % the state variable transformation cares about.
%
-:- pred substitute_state_var_mappings(list(prog_term)::in,
- list(prog_term)::out, prog_varset::in, prog_varset::out,
- svar_info::in, svar_info::out,
- list(error_spec)::in, list(error_spec)::out) is det.
+:- pred svar_goal_to_conj_list(hlds_goal::in, list(hlds_goal)::out,
+ svar_store::in, svar_store::out) is det.
-:- pred substitute_state_var_mapping(prog_term::in, prog_term::out,
- prog_varset::in, prog_varset::out, svar_info::in, svar_info::out,
- list(error_spec)::in, list(error_spec)::out) is det.
+%-----------------------------------------------------------------------------%
- % Replace !X args with two args !.X, !:X in that order.
+ % Does the given argument list have an illegal result term?
%
-:- func expand_bang_state_var_args(list(prog_term)) = list(prog_term).
-
-:- func expand_bang_state_var_args_in_instance_method_heads(instance_body) =
- instance_body.
-
:- pred illegal_state_var_func_result(pred_or_func::in, list(prog_term)::in,
svar::out) is semidet.
- % We do not allow !X to appear as a lambda head argument.
- % We might extend the syntax still further to accommodate
- % this as an option, e.g. !IO::(di, uo).
+ % Does the given lambda argument list have an illegal element?
+ % We currently do not allow !X to appear as a lambda head argument, though
+ % we might later extend the syntax still further to accommodate this
+ % using syntax such as !IO::(di, uo).
%
:- pred lambda_args_contain_bang_state_var(list(prog_term)::in, prog_var::out)
is semidet.
-:- pred report_illegal_state_var_update(prog_context::in, prog_varset::in,
+%-----------------------------------------------------------------------------%
+
+:- pred report_illegal_state_var_update(prog_context::in,
+ string::in, prog_context::in, prog_varset::in,
svar::in, list(error_spec)::in, list(error_spec)::out) is det.
:- pred report_illegal_func_svar_result(prog_context::in, prog_varset::in,
@@ -329,11 +284,16 @@
:- implementation.
+:- import_module libs.options.
+:- import_module mdbcomp.goal_path.
:- import_module parse_tree.prog_util.
+:- import_module assoc_list.
:- import_module char.
+:- import_module counter.
:- import_module int.
:- import_module io.
+:- import_module pair.
:- import_module require.
:- import_module string.
:- import_module svmap.
@@ -341,895 +301,1602 @@
:- import_module varset.
%-----------------------------------------------------------------------------%
+%
+% Define the main data structures used by the implementation of state vars.
+%
+
+ % State vars defined outside a lambda goal become readonly when we move
+ % inside the lambda goal. Inside the lambda goal, it makes sense to access
+ % the current value of such state vars, but not to update it.
+ %
+ % We should make negations behave similarly: it should not be possible
+ % to update an outside state var inside a negation. However, for now,
+ % the language reference manual allows such updates. This type is here
+ % in case that changes.
+:- type readonly_context_kind
+ ---> roc_lambda.
+
+:- type svar_status
+ % The two updated statuses may legally be present in a status map
+ % only DURING the processing of an atomic goal. At the end of each
+ % atomic goal, such statuses are always reset to status_known.
+ ---> status_unknown
+ % We are in a scope that allows use of this state var,
+ % but it has not been given a value yet. This could be because
+ % the scope of the state var was established with !:S, not !S
+ % or !.S, in a clause head, or because it was established
+ % in a `some [!S]' scope.
+
+ ; status_unknown_updated(prog_var)
+ % Before this atomic goal, this state var was status_unknown,
+ % but it was initialized by the current atomic goal to the given
+ % prog_var.
+
+ ; status_known_ro(prog_var, readonly_context_kind, prog_context)
+ % The given prog_var is the current version of this state var,
+ % but the variable is readonly (ro); the program CANNOT create
+ % new versions of the state var. The second argument says WHY
+ % new versions cannot be created, and the third says where
+ % the construct named by the second argument occurs.
+
+ ; status_known(prog_var)
+ % The given prog_var is the current version of this state var;
+ % the program can create new versions of the state var,
+ % but has not done so yet.
+
+ ; status_known_updated(prog_var, prog_var).
+ % The first prog_var is the current version of this state var,
+ % and the second is the new, updated version, which will become
+ % the current version when we finish executing the current
+ % atomic goal.
+
+:- type svar_state
+ ---> svar_state(
+ state_status_map :: map(svar, svar_status)
+ ).
+
+:- type svar_store
+ ---> svar_store(
+ store_next_goal_id :: counter,
+ store_final_remap :: map(goal_id,
+ assoc_list(prog_var, prog_var)),
+ store_warnings :: list(error_spec)
+ ).
+
+ % Create a new svar_state/store set up to start processing a clause head.
+ %
+:- func new_svar_state = svar_state.
+:- func new_svar_store = svar_store.
+
+new_svar_state = svar_state(map.init).
+new_svar_store = svar_store(counter.init(1), map.init, []).
+
+:- type state_var_name_source
+ ---> name_initial
+ ; name_middle
+ ; name_final.
-:- type svar_info
- ---> svar_info(
- svar_ctxt :: svar_ctxt,
-
- % This is used to number state variables and is incremented
- % for each source-level conjunct.
- svar_num :: int,
+:- pred new_state_var_instance(svar::in, state_var_name_source::in,
+ prog_var::out, prog_varset::in, prog_varset::out) is det.
- % The "read only" state variables in scope (e.g. external state
- % variables visible from within a lambda body or condition
- % of an if-then-else expression.)
- svar_readonly_dot :: svar_map,
-
- % The "read/write" state variables in scope.
- svar_dot :: svar_map,
- svar_colon :: svar_map
+new_state_var_instance(StateVar, NameSource, Var, !VarSet) :-
+ SVarName = varset.lookup_name(!.VarSet, StateVar),
+ (
+ NameSource = name_initial,
+ ProgVarName = string.format("STATE_VARIABLE_%s_0", [s(SVarName)]),
+ varset.new_named_var(!.VarSet, ProgVarName, Var, !:VarSet)
+ ;
+ NameSource = name_middle,
+ ProgVarBaseName = string.format("STATE_VARIABLE_%s", [s(SVarName)]),
+ varset.new_uniquely_named_var(!.VarSet, ProgVarBaseName, Var, !:VarSet)
+ ;
+ NameSource = name_final,
+ ProgVarName = string.format("STATE_VARIABLE_%s", [s(SVarName)]),
+ varset.new_named_var(!.VarSet, ProgVarName, Var, !:VarSet)
).
- % Create a new svar_info set up to start processing a clause head.
- %
-:- func new_svar_info = svar_info.
-
-new_svar_info =
- svar_info(in_head, 0, map.init, map.init, map.init).
+%-----------------------------------------------------------------------------%
+%
+% Expand !S into !.S, !:S pairs.
+%
-:- pred has_svar_colon_mapping_for(svar_info::in, svar::in) is semidet.
+expand_bang_states([], []).
+expand_bang_states([HeadArg0 | TailArgs0], Args) :-
+ expand_bang_states(TailArgs0, TailArgs),
+ (
+ HeadArg0 = variable(_, _),
+ Args = [HeadArg0 | TailArgs]
+ ;
+ HeadArg0 = functor(Const, FunctorArgs, Ctxt),
+ (
+ Const = atom("!"),
+ FunctorArgs = [variable(_StateVar, _)]
+ ->
+ HeadArg1 = functor(atom("!."), FunctorArgs, Ctxt),
+ HeadArg2 = functor(atom("!:"), FunctorArgs, Ctxt),
+ Args = [HeadArg1, HeadArg2 | TailArgs]
+ ;
+ Args = [HeadArg0 | TailArgs]
+ )
+ ).
-has_svar_colon_mapping_for(SInfo, StateVar) :-
- map.contains(SInfo ^ svar_colon, StateVar).
-has_svar_colon_mapping_for(SInfo, StateVar) :-
- SInfo ^ svar_ctxt = in_atom(_, ParentSInfo),
- has_svar_colon_mapping_for(ParentSInfo, StateVar).
+expand_bang_states_instance_body(InstanceBody0, InstanceBody) :-
+ (
+ InstanceBody0 = instance_body_abstract,
+ InstanceBody = instance_body_abstract
+ ;
+ InstanceBody0 = instance_body_concrete(Methods0),
+ list.map(expand_bang_states_method, Methods0, Methods),
+ InstanceBody = instance_body_concrete(Methods)
+ ).
-:- pred with_updated_svar(svar::in, svar_info::in, svar_info::out) is det.
+:- pred expand_bang_states_method(instance_method::in, instance_method::out)
+ is det.
-with_updated_svar(StateVar, !SInfo) :-
- SVarContext = !.SInfo ^ svar_ctxt,
+expand_bang_states_method(IM0, IM) :-
+ IM0 = instance_method(PredOrFunc, Method, ProcDef0, Arity0, Ctxt),
(
- SVarContext = in_atom(UpdatedStateVars0, ParentSInfo),
- set.insert(UpdatedStateVars0, StateVar, UpdatedStateVars),
- !SInfo ^ svar_ctxt := in_atom(UpdatedStateVars, ParentSInfo)
+ ProcDef0 = instance_proc_def_name(_),
+ IM = IM0
;
- ( SVarContext = in_head
- ; SVarContext = in_body
- )
+ ProcDef0 = instance_proc_def_clauses(ItemClauses0),
+ list.map(expand_bang_states_clause, ItemClauses0, ItemClauses),
+ % Note that the condition should always succeed...
+ ( ItemClauses = [ItemClause | _] ->
+ Args = ItemClause ^ cl_head_args,
+ adjust_func_arity(PredOrFunc, Arity, list.length(Args))
+ ;
+ Arity = Arity0
+ ),
+ ProcDef = instance_proc_def_clauses(ItemClauses),
+ IM = instance_method(PredOrFunc, Method, ProcDef, Arity, Ctxt)
).
+:- pred expand_bang_states_clause(item_clause_info::in, item_clause_info::out)
+ is det.
+
+expand_bang_states_clause(ItemClause0, ItemClause) :-
+ ItemClause0 = item_clause_info(Origin, VarSet, PredOrFunc, SymName,
+ Args0, Body, Context, SeqNum),
+ expand_bang_states(Args0, Args),
+ ItemClause = item_clause_info(Origin, VarSet, PredOrFunc, SymName,
+ Args, Body, Context, SeqNum).
+
%-----------------------------------------------------------------------------%
+%
+% Handle the start of processing a clause.
+%
+
+svar_prepare_for_clause_head(Args0, Args, !VarSet, FinalMap,
+ !:State, !:Store, !Specs) :-
+ !:State = new_svar_state,
+ !:Store = new_svar_store,
+ svar_prepare_head_terms(Args0, Args, map.init, FinalMap,
+ !State, !VarSet, !Specs).
+
+:- pred svar_prepare_head_terms(list(prog_term)::in, list(prog_term)::out,
+ map(svar, prog_var)::in, map(svar, prog_var)::out,
+ svar_state::in, svar_state::out, prog_varset::in, prog_varset::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
-svar_dot(Context, StateVar, Var, !VarSet, !SInfo, !Specs) :-
- SVarContext = !.SInfo ^ svar_ctxt,
- DotMap = !.SInfo ^ svar_dot,
+svar_prepare_head_terms([], [], !FinalMap, !State, !VarSet, !Specs).
+svar_prepare_head_terms([Term0 | Terms0], [Term | Terms],
+ !FinalMap, !State, !VarSet, !Specs) :-
+ svar_prepare_head_term(Term0, Term, !FinalMap, !State, !VarSet, !Specs),
+ svar_prepare_head_terms(Terms0, Terms, !FinalMap, !State, !VarSet, !Specs).
+
+:- pred svar_prepare_head_term(prog_term::in, prog_term::out,
+ map(svar, prog_var)::in, map(svar, prog_var)::out,
+ svar_state::in, svar_state::out,
+ prog_varset::in, prog_varset::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+svar_prepare_head_term(Term0, Term, !FinalMap, !State, !VarSet, !Specs) :-
(
- SVarContext = in_head,
- ( map.search(DotMap, StateVar, VarPrime) ->
- Var = VarPrime
+ Term0 = variable(_, _),
+ Term = Term0
;
- new_dot_state_var(StateVar, Var, !VarSet, !SInfo)
+ Term0 = functor(Functor, SubTerms0, Context),
+ (
+ Functor = atom("!."),
+ SubTerms0 = [variable(StateVar, _)]
+ ->
+ !.State = svar_state(StatusMap0),
+ ( map.search(StatusMap0, StateVar, OldStatus) ->
+ (
+ OldStatus = status_unknown,
+ % !:S happened to precede !.S in the head, which is ok.
+ new_state_var_instance(StateVar, name_initial, Var,
+ !VarSet),
+ Term = variable(Var, context_init),
+ Status = status_known(Var),
+ map.det_update(StatusMap0, StateVar, Status, StatusMap)
+ ;
+ OldStatus = status_known(Var),
+ Term = variable(Var, context_init),
+ StatusMap = StatusMap0
+ ;
+ OldStatus = status_unknown_updated(_),
+ unexpected($module, $pred, "status_unknown_updated for !.")
+ ;
+ OldStatus = status_known_updated(_, _),
+ unexpected($module, $pred, "status_known_updated for !.")
+ ;
+ OldStatus = status_known_ro(_, _, _),
+ % This can happen if the context outside a lambda
+ % expression has a state variable named StateVar,
+ % which make_svars_read_only has given this status,
+ % and the lambda expression itself also has !.StateVar.
+ new_state_var_instance(StateVar, name_initial, Var,
+ !VarSet),
+ Term = variable(Var, context_init),
+ Status = status_known(Var),
+ map.det_update(StatusMap0, StateVar, Status, StatusMap)
)
;
- ( SVarContext = in_body
- ; SVarContext = in_atom(_, _)
+ new_state_var_instance(StateVar, name_initial, Var, !VarSet),
+ Term = variable(Var, context_init),
+ Status = status_known(Var),
+ map.det_insert(StatusMap0, StateVar, Status, StatusMap)
),
- ( map.search(DotMap, StateVar, VarPrime) ->
- Var = VarPrime
- ; map.search(!.SInfo ^ svar_readonly_dot, StateVar, VarPrime) ->
- Var = VarPrime
- ; has_svar_colon_mapping_for(!.SInfo, StateVar) ->
- new_dot_state_var(StateVar, Var, !VarSet, !SInfo),
- report_uninitialized_state_var(Context, !.VarSet, StateVar, !Specs)
+ !:State = svar_state(StatusMap)
;
- Var = StateVar,
- report_non_visible_state_var(".", Context, !.VarSet, StateVar,
- !Specs)
- )
- ).
-
-%-----------------------------------------------------------------------------%
+ Functor = atom("!:"),
+ SubTerms0 = [variable(StateVar, _)]
+ ->
+ new_state_var_instance(StateVar, name_final, Var, !VarSet),
+ Term = variable(Var, context_init),
+ Status = status_unknown,
-svar_colon(Context, StateVar, Var, !VarSet, !SInfo, !Specs) :-
- SVarContext = !.SInfo ^ svar_ctxt,
- ColonMap0 = !.SInfo ^ svar_colon,
- (
- SVarContext = in_head,
- ( map.search(ColonMap0, StateVar, VarPrime) ->
- Var = VarPrime
- ;
- new_final_state_var(StateVar, Var, !VarSet, !SInfo)
- )
- ;
- ( SVarContext = in_body
- ; SVarContext = in_atom(_, _)
- ),
- ( map.search(ColonMap0, StateVar, VarPrime) ->
- Var = VarPrime,
- with_updated_svar(StateVar, !SInfo)
- ;
- % Return a dummy variable, and set up a dummy mapping: there is
- % no point in mentioning this error twice.
- Var = StateVar,
- map.det_insert(ColonMap0, StateVar, Var, ColonMap),
- !SInfo ^ svar_colon := ColonMap,
- ( map.contains(!.SInfo ^ svar_readonly_dot, StateVar) ->
- report_illegal_state_var_update(Context, !.VarSet, StateVar,
- !Specs)
+ !.State = svar_state(StatusMap0),
+ ( map.search(StatusMap0, StateVar, OldStatus) ->
+ (
+ OldStatus = status_unknown,
+ % This is the second occurrence of !:StateVar.
+ % Since !.FinalMap will contain StateVar, we will generate
+ % the error message below.
+ StatusMap = StatusMap0
+ ;
+ OldStatus = status_known(_),
+ % The !. part of this state var has already been processed.
+ % We have nothing more to do.
+ StatusMap = StatusMap0
+ ;
+ OldStatus = status_unknown_updated(_),
+ unexpected($module, $pred, "status_unknown_updated for !:")
+ ;
+ OldStatus = status_known_updated(_, _),
+ unexpected($module, $pred, "status_known_updated for !:")
+ ;
+ OldStatus = status_known_ro(_, _, _),
+ % This can happen if the context outside a lambda
+ % expression has a state variable named StateVar,
+ % which make_svars_read_only has given this status,
+ % and the lambda expression itself also has !:StateVar.
+ StatusMap = StatusMap0
+ )
;
- report_non_visible_state_var(":", Context, !.VarSet, StateVar,
+ map.det_insert(StatusMap0, StateVar, Status, StatusMap)
+ ),
+ !:State = svar_state(StatusMap),
+ ( map.search(!.FinalMap, StateVar, _) ->
+ report_repeated_head_state_var(Context, !.VarSet, StateVar,
!Specs)
+ ;
+ svmap.det_insert(StateVar, Var, !FinalMap)
)
+ ;
+ svar_prepare_head_terms(SubTerms0, SubTerms,
+ !FinalMap, !State, !VarSet, !Specs),
+ Term = functor(Functor, SubTerms, Context)
)
).
%-----------------------------------------------------------------------------%
+%
+% Handle the start of processing a lambda expression.
+%
+
+svar_prepare_for_lambda_head(Context, Args0, Args, FinalMap,
+ OutsideState, InsideState, !VarSet, !Specs) :-
+ % Make all currently visible state vars readonly, since they cannot
+ % be updated inside the lambda expression.
+ %
+ % Note that some of these state vars may already be readonly, since
+ % we may already be inside e.g. a lambda expression. We must make sure
+ % that readonly references work even from code that is inside two or more
+ % lambda expressions.
+ OutsideState = svar_state(OutsideStatusMap),
+ map.to_sorted_assoc_list(OutsideStatusMap, OutsideStatusList),
+ make_svars_read_only(roc_lambda, Context,
+ OutsideStatusList, InsideStatusList),
+ map.from_sorted_assoc_list(InsideStatusList, InsideStatusMap),
+ InsideState0 = svar_state(InsideStatusMap),
+
+ % Handle the arguments of the lambda expression as if they were the head
+ % of a clause.
+ svar_prepare_head_terms(Args0, Args, map.init, FinalMap,
+ InsideState0, InsideState, !VarSet, !Specs).
- % Construct the initial and final mappings for a state variable.
- %
-:- pred new_local_state_var(svar::in, prog_var::out, prog_var::out,
- prog_varset::in, prog_varset::out, svar_info::in, svar_info::out) is det.
-
-new_local_state_var(StateVar, VarD, VarC, !VarSet, !SInfo) :-
- new_dot_state_var(StateVar, VarD, !VarSet, !SInfo),
- new_final_state_var(StateVar, VarC, !VarSet, !SInfo).
-
- % Construct the initial and final mappings for a state variable.
- %
-:- pred new_dot_state_var(svar::in, prog_var::out,
- prog_varset::in, prog_varset::out, svar_info::in, svar_info::out) is det.
-
-new_dot_state_var(StateVar, VarD, !VarSet, !SInfo) :-
- N = !.SInfo ^ svar_num,
- Name = varset.lookup_name(!.VarSet, StateVar),
- NameD = string.format("STATE_VARIABLE_%s_%d", [s(Name), i(N)]),
- varset.new_named_var(!.VarSet, NameD, VarD, !:VarSet),
- !:SInfo = ( !.SInfo ^ svar_dot ^ elem(StateVar) := VarD ).
-
-:- pred new_colon_state_var(svar::in, prog_var::out,
- prog_varset::in, prog_varset::out, svar_info::in, svar_info::out) is det.
-
-new_colon_state_var(StateVar, VarC, !VarSet, !SInfo) :-
- N = !.SInfo ^ svar_num,
- Name = varset.lookup_name(!.VarSet, StateVar),
- NameC = string.format("STATE_VARIABLE_%s_%d", [s(Name), i(N)]),
- varset.new_named_var(!.VarSet, NameC, VarC, !:VarSet),
- !:SInfo = ( !.SInfo ^ svar_colon ^ elem(StateVar) := VarC ).
-
-:- pred new_final_state_var(svar::in, prog_var::out,
- prog_varset::in, prog_varset::out, svar_info::in, svar_info::out) is det.
-
-new_final_state_var(StateVar, VarC, !VarSet, !SInfo) :-
- Name = varset.lookup_name(!.VarSet, StateVar),
- NameC = string.format("STATE_VARIABLE_%s", [s(Name)]),
- varset.new_named_var(!.VarSet, NameC, VarC, !:VarSet),
- !:SInfo = ( !.SInfo ^ svar_colon ^ elem(StateVar) := VarC ).
-
-%-----------------------------------------------------------------------------%
+:- pred make_svars_read_only(readonly_context_kind::in, prog_context::in,
+ assoc_list(svar, svar_status)::in, assoc_list(svar, svar_status)::out)
+ is det.
-svar_prepare_for_head(new_svar_info).
+make_svars_read_only(_ROC, _Context, [], []).
+make_svars_read_only(ROC, Context, [SVar - CurStatus | CurTail], LambdaList) :-
+ make_svars_read_only(ROC, Context, CurTail, LambdaTail),
+ (
+ ( CurStatus = status_unknown
+ ; CurStatus = status_unknown_updated(_)
+ ),
+ LambdaList = LambdaTail
+ ;
+ CurStatus = status_known_ro(_, _, _),
+ LambdaList = [SVar - CurStatus | LambdaTail]
+ ;
+ ( CurStatus = status_known(Var)
+ ; CurStatus = status_known_updated(Var, _)
+ ),
+ LambdaStatus = status_known_ro(Var, ROC, Context),
+ LambdaList = [SVar - LambdaStatus | LambdaTail]
+ ).
%-----------------------------------------------------------------------------%
+%
+% Handle the end of processing a clause or lambda expression.
+%
-svar_prepare_for_lambda(!SInfo) :-
- % Construct the new readonly_dots mapping by overlaying the current dots
- % mapping onto the existing readonly_dots mapping. We cannot just throw
- % the existing readonly_dots mapping away because otherwise referring to
- % externals from within closures that are nested more than one level deep
- % will not work.
- NewExternals =
- map.overlay(!.SInfo ^ svar_readonly_dot, !.SInfo ^ svar_dot),
- !:SInfo = new_svar_info,
- !SInfo ^ svar_readonly_dot := NewExternals.
+svar_finish_clause_body(Context, FinalMap, Goals0, Goal,
+ InitialSVarState, FinalSVarState,
+ !.SVarStore, Warnings) :-
+ svar_finish_body(Context, FinalMap, Goals0, Goal1,
+ InitialSVarState, FinalSVarState, !SVarStore),
+ !.SVarStore = svar_store(_, DelayedRenamings, Warnings),
+ (
+ map.is_empty(FinalMap),
+ map.is_empty(DelayedRenamings)
+ ->
+ Goal = Goal1
+ ;
+ trace [compiletime(flag("state-var-lambda")), io(!IO)] (
+ some [FinalList, DelayedList] (
+ map.to_assoc_list(FinalMap, FinalList),
+ map.to_assoc_list(DelayedRenamings, DelayedList),
+ io.write_string("\nFINISH CLAUSE BODY in context ", !IO),
+ io.write(Context, !IO),
+ io.nl(!IO),
+ io.write_string("applying subn\n", !IO),
+ io.write(FinalList, !IO),
+ io.nl(!IO),
+ io.write_string("with incremental subn\n", !IO),
+ io.write(DelayedList, !IO),
+ io.nl(!IO)
+ )
+ ),
+ incremental_rename_vars_in_goal(map.init, DelayedRenamings,
+ Goal1, Goal)
+ ).
-%-----------------------------------------------------------------------------%
+svar_finish_lambda_body(Context, FinalMap, Goals0, Goal,
+ InitialSVarState, FinalSVarState, !SVarStore) :-
+ svar_finish_body(Context, FinalMap, Goals0, Goal,
+ InitialSVarState, FinalSVarState, !SVarStore).
+
+:- pred svar_finish_body(prog_context::in, map(svar, prog_var)::in,
+ list(hlds_goal)::in, hlds_goal::out,
+ svar_state::in, svar_state::in, svar_store::in, svar_store::out) is det.
+
+svar_finish_body(Context, FinalMap, Goals0, Goal,
+ InitialSVarState, FinalSVarState, !Store) :-
+ map.to_assoc_list(FinalMap, FinalAssocList),
+ InitialSVarState = svar_state(InitialSVarStatusMap),
+ FinalSVarState = svar_state(FinalSVarStatusMap),
+ svar_find_final_renames_and_copy_goals(FinalAssocList,
+ InitialSVarStatusMap, FinalSVarStatusMap,
+ [], FinalSVarSubn, [], CopyGoals),
+ (
+ CopyGoals = [],
+ Goals1 = Goals0
+ ;
+ CopyGoals = [_ | _],
+ Goals1 = Goals0 ++ CopyGoals
+ ),
+ svar_flatten_conj(Context, Goals1, Goal1, !Store),
-svar_prepare_for_body(FinalMap, !VarSet, !SInfo) :-
- FinalMap = !.SInfo ^ svar_colon,
- N = !.SInfo ^ svar_num + 1,
- ColonKeys = map.keys(!.SInfo ^ svar_colon),
- DotKeys = map.keys(!.SInfo ^ svar_dot),
- StateVars = list.merge_and_remove_dups(ColonKeys, DotKeys),
- next_svar_mappings(N, StateVars, !VarSet, Colon),
- !SInfo ^ svar_ctxt := in_body,
- !SInfo ^ svar_num := N,
- !SInfo ^ svar_colon := Colon.
+ Goal1 = hlds_goal(GoalExpr1, GoalInfo1),
+ GoalId1 = goal_info_get_goal_id(GoalInfo1),
+ !.Store = svar_store(NextGoalId1, DelayedRenamingMap1, Warnings),
+ ( map.search(DelayedRenamingMap1, GoalId1, DelayedRenaming0) ->
+ trace [compiletime(flag("state-var-lambda")), io(!IO)] (
+ io.write_string("\nfinishing body, ", !IO),
+ io.write_string("attaching subn to existing goal_id ", !IO),
+ io.write(GoalId1, !IO),
+ io.nl(!IO),
+ io.write_string("subn is ", !IO),
+ io.write(FinalSVarSubn, !IO),
+ io.nl(!IO)
+ ),
-%-----------------------------------------------------------------------------%
+ svmap.det_update(GoalId1, DelayedRenaming0 ++ FinalSVarSubn,
+ DelayedRenamingMap1, DelayedRenamingMap),
+ NextGoalId = NextGoalId1,
+ Goal = Goal1
+ ;
+ (
+ FinalSVarSubn = [],
+ NextGoalId = NextGoalId1,
+ DelayedRenamingMap = DelayedRenamingMap1,
+ Goal = Goal1
+ ;
+ FinalSVarSubn = [_ | _],
+ counter.allocate(GoalIdNum, NextGoalId1, NextGoalId),
+ GoalId = goal_id(GoalIdNum),
+
+ trace [compiletime(flag("state-var-lambda")), io(!IO)] (
+ io.write_string("\nfinishing body, ", !IO),
+ io.write_string("attaching subn to new goal_id ", !IO),
+ io.write(GoalId, !IO),
+ io.nl(!IO),
+ io.write_string("subn is ", !IO),
+ io.write(FinalSVarSubn, !IO),
+ io.nl(!IO)
+ ),
-svar_finish_goals(Context, FinalSVarMap, Goals0, Goal, SInfo) :-
- goal_info_init(Context, GoalInfo),
- list.map(goal_to_conj_list, Goals0, GoalsAsConjList),
- Unifiers = svar_unifiers(yes(feature_dont_warn_singleton), Context,
- FinalSVarMap, SInfo ^ svar_dot),
- Goals1 = list.condense(GoalsAsConjList),
- Goals = Goals1 ++ Unifiers,
- conj_list_to_goal(Goals, GoalInfo, Goal).
-
-:- func svar_unifiers(maybe(goal_feature), prog_context, svar_map, svar_map)
- = list(hlds_goal).
-
-svar_unifiers(MaybeFeature, Context, LHSMap, RHSMap) = Unifiers :-
- map.foldl(add_svar_unifier(MaybeFeature, RHSMap, Context), LHSMap,
- [], Unifiers).
+ svmap.det_insert(GoalId, FinalSVarSubn,
+ DelayedRenamingMap1, DelayedRenamingMap),
+ goal_info_set_goal_id(GoalId, GoalInfo1, GoalInfo),
+ Goal = hlds_goal(GoalExpr1, GoalInfo)
+ )
+ ),
+ !:Store = svar_store(NextGoalId, DelayedRenamingMap, Warnings).
-:- pred add_svar_unifier(maybe(goal_feature)::in, svar_map::in,
- prog_context::in, svar::in, prog_var::in,
+:- pred svar_find_final_renames_and_copy_goals(assoc_list(svar, prog_var)::in,
+ map(svar, svar_status)::in, map(svar, svar_status)::in,
+ assoc_list(prog_var, prog_var)::in, assoc_list(prog_var, prog_var)::out,
list(hlds_goal)::in, list(hlds_goal)::out) is det.
-add_svar_unifier(MaybeFeature, RHSMap, Context, StateVar, Var, !Unifiers) :-
- ( map.search(RHSMap, StateVar, RHSVar) ->
- Unifier = svar_unification(MaybeFeature, Context, Var, RHSVar),
- !:Unifiers = [Unifier | !.Unifiers]
+svar_find_final_renames_and_copy_goals([], _, _, !FinalSVarSubn, !CopyGoals).
+svar_find_final_renames_and_copy_goals([Head | Tail],
+ InitialStatusMap, FinalStatusMap, !FinalSVarSubn, !CopyGoals) :-
+ Head = SVar - FinalHeadVar,
+ map.lookup(InitialStatusMap, SVar, InitialStatus),
+ map.lookup(FinalStatusMap, SVar, FinalStatus),
+ (
+ FinalStatus = status_known(LastVar),
+ ( FinalStatus = InitialStatus ->
+ % The state variable was not updated by the body.
+ % Leaving the unification between two headvars representing the
+ % initial and final states to the done at the start of the clause
+ % causes problems at the moment for the mode checker in the
+ % presence of unique modes.
+ make_copy_goal(LastVar, FinalHeadVar, CopyGoal),
+ !:CopyGoals = [CopyGoal | !.CopyGoals]
;
- true
- ).
+ !:FinalSVarSubn = [LastVar - FinalHeadVar | !.FinalSVarSubn]
+ )
+ ;
+ FinalStatus = status_unknown
+ % The state variable was never defined.
+ % The clause head already refers to the final version.
+ ;
+ FinalStatus = status_known_ro(_, _, _),
+ unexpected($module, $pred, "readonly status")
+ ;
+ ( FinalStatus = status_known_updated(_, _)
+ ; FinalStatus = status_unknown_updated(_)
+ ),
+ unexpected($module, $pred, "updated status")
+ ),
+ svar_find_final_renames_and_copy_goals(Tail,
+ InitialStatusMap, FinalStatusMap, !FinalSVarSubn, !CopyGoals).
%-----------------------------------------------------------------------------%
+%
+% Handle the completion of an atomic goal. Any variable that was updated in the
+% goal gets the updated value as its new current value. The Loc argument is
+% needed because sometimes what looks like an atomic goal (such as the
+% condition of an if-then-else) is inside another atomic goal (such as an
+% if-then-else expression). In such cases, the end of the inside atomic goal
+% does NOT mean that we finished the containing atomic goal.
+%
-:- func svar_unification(maybe(goal_feature), prog_context, prog_var, prog_var)
- = hlds_goal.
-
-svar_unification(MaybeFeature, Context, SVar, Var) = Unification :-
- create_pure_atomic_complicated_unification(SVar, rhs_var(Var), Context,
- umc_implicit("state variable"), [], Unification0),
+svar_finish_atomic_goal(Loc, !State) :-
(
- MaybeFeature = no,
- Unification = Unification0
+ Loc = loc_whole_goal,
+ !.State = svar_state(StatusMap0),
+ map.map_values_only(reset_updated_status, StatusMap0, StatusMap),
+ !:State = svar_state(StatusMap)
;
- MaybeFeature = yes(Feature),
- goal_add_feature(Feature, Unification0, Unification)
+ Loc = loc_inside_atomic_goal
).
-%-----------------------------------------------------------------------------%
+:- pred reset_updated_status(svar_status::in, svar_status::out) is det.
-prepare_for_local_state_vars(StateVars, !VarSet, !SInfo) :-
- list.map_foldl2(new_colon_state_var, StateVars, _, !VarSet, !SInfo).
+reset_updated_status(!Status) :-
+ (
+ ( !.Status = status_unknown
+ ; !.Status = status_known_ro(_, _, _)
+ ; !.Status = status_known(_)
+ )
+ ;
+ !.Status = status_unknown_updated(NewProgVar),
+ !:Status = status_known(NewProgVar)
+ ;
+ !.Status = status_known_updated(_OldProgVar, NewProgVar),
+ !:Status = status_known(NewProgVar)
+ ).
%-----------------------------------------------------------------------------%
+%
+% Handle scopes that introduce state variables.
+%
-finish_local_state_vars(StateVars, Vars, SInfoBefore, !SInfo) :-
- CurDotMap = !.SInfo ^ svar_dot,
- CurColonMap = !.SInfo ^ svar_colon,
- DotVars = svar_mappings(CurDotMap, StateVars),
- ColonVars = svar_mappings(CurColonMap, StateVars),
- Vars = list.sort_and_remove_dups(DotVars ++ ColonVars),
- NewDotMap = del_locals(StateVars, SInfoBefore ^ svar_dot, CurDotMap),
- NewColonMap = del_locals(StateVars, SInfoBefore ^ svar_colon, CurColonMap),
- !SInfo ^ svar_dot := NewDotMap,
- !SInfo ^ svar_colon := NewColonMap.
+svar_prepare_for_local_state_vars(Context, VarSet, StateVars,
+ OutsideState, InsideState, !Specs) :-
+ OutsideState = svar_state(StatusMapOutside),
+ prepare_svars_for_scope(Context, VarSet, StateVars,
+ StatusMapOutside, StatusMapInside, !Specs),
+ InsideState = svar_state(StatusMapInside).
-:- func svar_mappings(svar_map, svars) = svars.
+:- pred prepare_svars_for_scope(prog_context::in, prog_varset::in,
+ list(svar)::in, map(svar, svar_status)::in, map(svar, svar_status)::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
-svar_mappings(_, []) = [].
-svar_mappings(Map, [StateVar | StateVars]) =
- ( map.search(Map, StateVar, Var) ->
- [Var | svar_mappings(Map, StateVars)]
+prepare_svars_for_scope(_Context, _VarSet, [], !StatusMap, !Specs).
+prepare_svars_for_scope(Context, VarSet, [SVar | SVars],
+ !StatusMap, !Specs) :-
+ ( map.search(!.StatusMap, SVar, _OldStatus) ->
+ report_state_var_shadow(Context, VarSet, SVar, !Specs),
+ svmap.det_update(SVar, status_unknown, !StatusMap)
;
- svar_mappings(Map, StateVars)
- ).
-
-:- func del_locals(svars, svar_map, svar_map) = svar_map.
+ svmap.det_insert(SVar, status_unknown, !StatusMap)
+ ),
+ prepare_svars_for_scope(Context, VarSet, SVars, !StatusMap, !Specs).
-del_locals(StateVars, MapBefore, Map) =
- list.foldl(
- func(K, M0) = M :-
- ( map.search(MapBefore, K, V) ->
- map.set(M0, K, V, M)
+svar_finish_local_state_vars(StateVars, StateBeforeOutside, StateAfterInside,
+ StateAfterOutside) :-
+ StateBeforeOutside = svar_state(StatusMapBeforeOutside),
+ StateAfterInside = svar_state(StatusMapAfterInside),
+ trace [compiletime(flag("state-var-scope")), io(!IO)] (
+ map.to_assoc_list(StatusMapBeforeOutside, BeforeOutsideStatuses),
+ map.to_assoc_list(StatusMapAfterInside, AfterInsideStatuses),
+ io.write_string("Finish of scope\n", !IO),
+ io.write_string("quantified state vars\n", !IO),
+ io.write(StateVars, !IO),
+ io.nl(!IO),
+ io.write_string("status before outside\n", !IO),
+ io.write_list(BeforeOutsideStatuses, "\n", io.write, !IO),
+ io.nl(!IO),
+ io.write_string("status after inside\n", !IO),
+ io.write_list(AfterInsideStatuses, "\n", io.write, !IO),
+ io.nl(!IO)
+ ),
+ % Remove access to the state vars introduced in the scope.
+ % Leave the status of all other state vars unaffected.
+ StatusMapAfterOutside0 = StatusMapAfterInside,
+ finish_svars_for_scope(StateVars, StatusMapBeforeOutside,
+ StatusMapAfterOutside0, StatusMapAfterOutside),
+ StateAfterOutside = svar_state(StatusMapAfterOutside).
+
+:- pred finish_svars_for_scope(list(svar)::in, map(svar, svar_status)::in,
+ map(svar, svar_status)::in, map(svar, svar_status)::out) is det.
+
+finish_svars_for_scope([], _, !StatusMapAfterOutside).
+finish_svars_for_scope([SVar | SVars], StatusMapBeforeOutside,
+ !StatusMapAfterOutside) :-
+ ( map.search(StatusMapBeforeOutside, SVar, BeforeOutsideStatus) ->
+ % The state var was visible before the scope. The outside state var
+ % was shadowed by a state var in the scope. Now that we are leaving
+ % the scope, restore access to the outside state var. Due to the
+ % shadowing, its status couldn't have changed inside the scope.
+ svmap.det_update(SVar, BeforeOutsideStatus, !StatusMapAfterOutside)
;
- map.delete(M0, K, M)
+ % The state var introduced in the scope wasn't visible before it.
+ svmap.det_remove(SVar, _, !StatusMapAfterOutside)
),
- StateVars,
- Map
- ).
+ finish_svars_for_scope(SVars, StatusMapBeforeOutside,
+ !StatusMapAfterOutside).
%-----------------------------------------------------------------------------%
+%
+% Handle disjunctions. The algorithm we use has two passes over the disjuncts.
+%
+% - Pass 1 computes finds out, for each state variable known at the start of
+% the disjunction, whether it was updated by any arms, and if yes, it picks
+% the fina, prog_var from one of the updated arms to represent the state var
+% after the disjunction.
+%
+% - Pass two processes the arms to ensure that the picked prog_var represents
+% the final value of the state variable in all the arms. In arms that do not
+% update the state variable, it introduces unifications to copy the initial
+% value of the state var to be the final value. In arms that do update the
+% state var, it schedules the prog_var representing the final value in
+% that arm to be renamed to the picked prog_var.
+
+svar_finish_disjunction(_Context, DisjStates, Disjs, !VarSet,
+ StateBefore, StateAfter, !Store) :-
+ StateBefore = svar_state(StatusMapBefore),
+ ( map.is_empty(StatusMapBefore) ->
+ % Optimize the common case.
+ get_disjuncts_with_empty_states(DisjStates, [], RevDisjs),
+ list.reverse(RevDisjs, Disjs),
+ StateAfter = StateBefore
+ ;
+ map.to_sorted_assoc_list(StatusMapBefore, StatusListBefore),
+ compute_status_after_arms(StatusListBefore, DisjStates,
+ map.init, ChangedStatusMapAfter, StatusMapBefore, StatusMapAfter),
+ map.to_sorted_assoc_list(ChangedStatusMapAfter,
+ ChangedStatusListAfter),
+ StateAfter = svar_state(StatusMapAfter),
+
+ !.Store = svar_store(NextGoalId0, DelayedRenamings0, Warnings0),
+ merge_changes_made_by_arms(DisjStates, StatusMapBefore,
+ ChangedStatusListAfter, !.VarSet, [], RevDisjs,
+ NextGoalId0, NextGoalId, DelayedRenamings0, DelayedRenamings,
+ Warnings0, Warnings),
+ list.reverse(RevDisjs, Disjs),
+ !:Store = svar_store(NextGoalId, DelayedRenamings, Warnings)
+ ).
-:- type svar_outer_atomic_scope_info
- ---> svar_outer_atomic_scope_info(
- outer_state_var :: prog_var,
- maybe_outer_read_only_dot :: maybe(prog_var),
- maybe_outer_dot :: maybe(prog_var),
- maybe_outer_colon :: maybe(prog_var)
- ).
-
-svar_start_outer_atomic_scope(Context, OuterStateVar, OuterDI, OuterUO,
- OuterScopeInfo, !VarSet, !SInfo, !Specs) :-
- svar_prepare_for_call(!SInfo),
- svar_dot(Context, OuterStateVar, OuterDI, !VarSet, !SInfo, !Specs),
- svar_colon(Context, OuterStateVar, OuterUO, !VarSet, !SInfo, !Specs),
- svar_finish_call(!VarSet, !SInfo),
- !.SInfo = svar_info(SVarContext, SVarNum, RODotMap0, DotMap0, ColonMap0),
- ( map.remove(RODotMap0, OuterStateVar, OuterRODot, RODotMap1) ->
- MaybeOuterRODot = yes(OuterRODot),
- RODotMap = RODotMap1
- ;
- MaybeOuterRODot = no,
- RODotMap = RODotMap0
- ),
- ( map.remove(DotMap0, OuterStateVar, OuterDot, DotMap1) ->
- MaybeOuterDot = yes(OuterDot),
- DotMap = DotMap1
- ;
- MaybeOuterDot = no,
- DotMap = DotMap0
- ),
- ( map.remove(ColonMap0, OuterStateVar, OuterColon, ColonMap1) ->
- MaybeOuterColon = yes(OuterColon),
- ColonMap = ColonMap1
+:- pred get_disjuncts_with_empty_states(list(hlds_goal_svar_state)::in,
+ list(hlds_goal)::in, list(hlds_goal)::out) is det.
+
+get_disjuncts_with_empty_states([], !RevDisjuncts).
+get_disjuncts_with_empty_states([GoalState | GoalStates], !RevDisjuncts) :-
+ GoalState = hlds_goal_svar_state(Goal, State),
+ StatusMapAfterGoal = State ^ state_status_map,
+ expect(map.is_empty(StatusMapAfterGoal), $module,
+ "map after goal not empty"),
+ !:RevDisjuncts = [Goal | !.RevDisjuncts],
+ get_disjuncts_with_empty_states(GoalStates, !RevDisjuncts).
+
+ % Pass 1. Compute the changes in the status map.
+ %
+:- pred compute_status_after_arms(assoc_list(svar, svar_status)::in,
+ list(hlds_goal_svar_state)::in,
+ map(svar, svar_status)::in, map(svar, svar_status)::out,
+ map(svar, svar_status)::in, map(svar, svar_status)::out) is det.
+
+compute_status_after_arms(_StatusListBefore, [],
+ !ChangedStatusMapAfter, !StatusMapAfter).
+compute_status_after_arms(StatusListBefore, [ArmState | ArmStates],
+ !ChangedStatusMapAfter, !StatusMapAfter) :-
+ ArmState = hlds_goal_svar_state(_Armunct, StateAfterArm),
+ StatusMapAfterArm = StateAfterArm ^ state_status_map,
+ find_changes_in_arm_and_update_changed_status_map(StatusListBefore,
+ StatusMapAfterArm, !ChangedStatusMapAfter, !StatusMapAfter),
+ compute_status_after_arms(StatusListBefore, ArmStates,
+ !ChangedStatusMapAfter, !StatusMapAfter).
+
+:- pred find_changes_in_arm_and_update_changed_status_map(
+ assoc_list(svar, svar_status)::in, map(svar, svar_status)::in,
+ map(svar, svar_status)::in, map(svar, svar_status)::out,
+ map(svar, svar_status)::in, map(svar, svar_status)::out) is det.
+
+find_changes_in_arm_and_update_changed_status_map([], _,
+ !ChangedStatusMapAfter, !StatusMapAfter).
+find_changes_in_arm_and_update_changed_status_map([Before | Befores],
+ StatusMapAfterArm, !ChangedStatusMapAfter, !StatusMapAfter) :-
+ Before = SVar - StatusBefore,
+ map.lookup(StatusMapAfterArm, SVar, StatusAfter),
+ ( StatusBefore = StatusAfter ->
+ true
+ ;
+ ( map.search(!.ChangedStatusMapAfter, SVar, _AlreadyUpdated) ->
+ true
;
- MaybeOuterColon = no,
- ColonMap = ColonMap0
+ svmap.det_insert(SVar, StatusAfter, !ChangedStatusMapAfter),
+ svmap.det_update(SVar, StatusAfter, !StatusMapAfter)
+ )
),
- OuterScopeInfo = svar_outer_atomic_scope_info(OuterStateVar,
- MaybeOuterRODot, MaybeOuterDot, MaybeOuterColon),
- !:SInfo = svar_info(SVarContext, SVarNum, RODotMap, DotMap, ColonMap).
+ find_changes_in_arm_and_update_changed_status_map(Befores,
+ StatusMapAfterArm, !ChangedStatusMapAfter, !StatusMapAfter).
-svar_finish_outer_atomic_scope(OuterScopeInfo, !SInfo) :-
- OuterScopeInfo = svar_outer_atomic_scope_info(OuterStateVar,
- MaybeOuterRODot, MaybeOuterDot, MaybeOuterColon),
- !.SInfo = svar_info(SVarContext, SVarNum, RODotMap0, DotMap0, ColonMap0),
- % For each of the "yes" cases below, we deleted the corresponding entry
- % in svar_start_atomic_scope. While a goal inside the atomic state could
- % have introduced a state variable with the same name again, that could
- % have been done only in a scope which also deletes the state variable.
- % Hence the use of det_inserts below.
+ % Pass 2. Effect the computed changes in the status map.
+ %
+:- pred merge_changes_made_by_arms(list(hlds_goal_svar_state)::in,
+ map(svar, svar_status)::in, assoc_list(svar, svar_status)::in,
+ prog_varset::in, list(hlds_goal)::in, list(hlds_goal)::out,
+ counter::in, counter::out,
+ map(goal_id, assoc_list(prog_var, prog_var))::in,
+ map(goal_id, assoc_list(prog_var, prog_var))::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+merge_changes_made_by_arms([], _StatusMapBefore, _ChangedStatusListAfter,
+ _VarSet, !RevArms, !NextGoalId, !DelayedRenamings, !Warnings).
+merge_changes_made_by_arms([ArmState | ArmStates],
+ StatusMapBefore, ChangedStatusListAfter, VarSet, !RevArms,
+ !NextGoalId, !DelayedRenamings, !Warnings) :-
+ ArmState = hlds_goal_svar_state(Arm0, StateAfterArm),
+ StatusMapAfterArm = StateAfterArm ^ state_status_map,
+ counter.allocate(ArmIdNum, !NextGoalId),
+ ArmId = goal_id(ArmIdNum),
+ handle_arm_updated_state_vars(ChangedStatusListAfter, StatusMapBefore,
+ StatusMapAfterArm, VarSet, UninitVarNames, CopyGoals, ArmRenames),
+ svmap.det_insert(ArmId, ArmRenames, !DelayedRenamings),
+ Arm0 = hlds_goal(ArmExpr0, ArmInfo0),
(
- MaybeOuterRODot = yes(OuterRODot),
- map.det_insert(RODotMap0, OuterStateVar, OuterRODot, RODotMap)
+ CopyGoals = [],
+ ArmExpr = ArmExpr0
;
- MaybeOuterRODot = no,
- RODotMap = RODotMap0
+ CopyGoals = [_ | _],
+ svar_goal_to_conj_list_internal(Arm0, ArmGoals0,
+ !NextGoalId, !DelayedRenamings),
+ ArmExpr = conj(plain_conj, ArmGoals0 ++ CopyGoals)
),
(
- MaybeOuterDot = yes(OuterDot),
- map.det_insert(DotMap0, OuterStateVar, OuterDot, DotMap)
+ UninitVarNames = []
;
- MaybeOuterDot = no,
- DotMap = DotMap0
+ UninitVarNames = [_ | _],
+ % It is ok for an arm that cannot succeed not to initialize
+ % a variable, but we record a warning anyway, to be printed
+ % in case the procedure has a mode error.
+ ArmContext = goal_info_get_context(ArmInfo0),
+ report_missing_inits_in_disjunct(ArmContext, UninitVarNames,
+ !Warnings)
),
+ goal_info_set_goal_id(ArmId, ArmInfo0, ArmInfo),
+ Arm = hlds_goal(ArmExpr, ArmInfo),
+ !:RevArms = [Arm | !.RevArms],
+ merge_changes_made_by_arms(ArmStates, StatusMapBefore,
+ ChangedStatusListAfter, VarSet, !RevArms,
+ !NextGoalId, !DelayedRenamings, !Warnings).
+
+:- pred handle_arm_updated_state_vars(assoc_list(svar, svar_status)::in,
+ map(svar, svar_status)::in, map(svar, svar_status)::in,
+ prog_varset::in, list(string)::out,
+ list(hlds_goal)::out, assoc_list(prog_var, prog_var)::out) is det.
+
+handle_arm_updated_state_vars([], _, _, _, [], [], []).
+handle_arm_updated_state_vars([Change | Changes], StatusMapBefore,
+ StatusMapAfterArm, VarSet, UninitVarNames, CopyGoals, Renames) :-
+ handle_arm_updated_state_vars(Changes, StatusMapBefore, StatusMapAfterArm,
+ VarSet, UninitVarNamesTail, CopyGoalsTail, RenamesTail),
+ Change = StateVar - AfterAllArmsStatus,
+ map.lookup(StatusMapBefore, StateVar, BeforeStatus),
+ map.lookup(StatusMapAfterArm, StateVar, AfterArmStatus),
+ ( AfterArmStatus = BeforeStatus ->
+ expect_not(unify(AfterArmStatus, AfterAllArmsStatus),
+ $pred, "AfterArmStatus = AfterAllArmsStatus"),
+ (
+ BeforeStatus = status_known(BeforeVar),
(
- MaybeOuterColon = yes(OuterColon),
- map.det_insert(ColonMap0, OuterStateVar, OuterColon, ColonMap)
+ AfterAllArmsStatus = status_known(AfterAllVar),
+ make_copy_goal(BeforeVar, AfterAllVar, CopyGoal),
+ CopyGoals = [CopyGoal | CopyGoalsTail],
+ UninitVarNames = UninitVarNamesTail,
+ Renames = RenamesTail
+ ;
+ ( AfterAllArmsStatus = status_known_ro(_, _, _)
+ ; AfterAllArmsStatus = status_known_updated(_, _)
+ ; AfterAllArmsStatus = status_unknown
+ ; AfterAllArmsStatus = status_unknown_updated(_)
+ ),
+ unexpected($module, $pred,
+ "AfterAllArmsStatus != status_known (Before == After)")
+ )
;
- MaybeOuterColon = no,
- ColonMap = ColonMap0
+ BeforeStatus = status_unknown,
+ varset.lookup_name(VarSet, StateVar, Name),
+ UninitVarName = "!:" ++ Name,
+ CopyGoals = CopyGoalsTail,
+ UninitVarNames = [UninitVarName | UninitVarNamesTail],
+ Renames = RenamesTail
+ ;
+ ( BeforeStatus = status_known_updated(_, _)
+ ; BeforeStatus = status_unknown_updated(_)
),
- !:SInfo = svar_info(SVarContext, SVarNum, RODotMap, DotMap, ColonMap).
-
-%-----------------------------------------------------------------------------%
-
-:- type svar_inner_atomic_scope_info
- ---> svar_inner_atomic_scope_info(
- inner_state_var :: prog_var,
- inner_di_var :: prog_var,
- before_svar_info :: svar_info
- ).
-
-svar_start_inner_atomic_scope(_Context, InnerStateVar, InnerScopeInfo,
- !VarSet, !SInfo, !Specs) :-
- BeforeSInfo = !.SInfo,
- new_dot_state_var(InnerStateVar, InnerDI, !VarSet, !SInfo),
- new_colon_state_var(InnerStateVar, _, !VarSet, !SInfo),
- InnerScopeInfo = svar_inner_atomic_scope_info(InnerStateVar, InnerDI,
- BeforeSInfo).
-
-svar_finish_inner_atomic_scope(Context, InnerScopeInfo, InnerDI, InnerUO,
- !VarSet, !SInfo, !Specs) :-
- InnerScopeInfo = svar_inner_atomic_scope_info(InnerStateVar, InnerDI,
- BeforeSInfo),
- svar_dot(Context, InnerStateVar, InnerUO, !VarSet, !SInfo, !Specs),
- finish_local_state_vars([InnerStateVar], Vars, BeforeSInfo, !SInfo),
- trace [compiletime(flag("atomic_scope_syntax")), io(!IO)] (
- ( Vars = [Var1, Var2] ->
- io.write_string("dot/colon:\n", !IO),
- io.write(InnerDI, !IO),
- io.nl(!IO),
- io.write(InnerUO, !IO),
- io.nl(!IO),
- io.write_string("finish:\n", !IO),
- io.write(Var1, !IO),
- io.nl(!IO),
- io.write(Var2, !IO),
- io.nl(!IO)
+ % If the state var was updated before this disjunction,
+ % then any reference to !:StateVar should refer to the already
+ % known updated prog_var, and thus AfterAllArmsStatus should be
+ % the same as StatusBefore, which means we shouldn't get here.
+ unexpected($module, $pred, "BeforeStatus is updated")
;
- unexpected($module, $pred, "|Vars| != 2")
+ BeforeStatus = status_known_ro(_, _, _),
+ unexpected($module, $pred, "BeforeStatus = status_known_ro")
)
- ).
-
-%-----------------------------------------------------------------------------%
-
-svar_finish_if_then_else(Context, Then0, Then, Else0, Else,
- SInfo0, SInfoC, SInfoT0, SInfoE, SInfo, !VarSet) :-
- % Add unifiers to the Then arm for state variables that acquired
- % new mappings in the condition, but not in the Them arm itself.
- % This is because the new mappings appear only in a negated context.
- StateVars = list.merge_and_remove_dups(map.keys(SInfoT0 ^ svar_dot),
- map.keys(SInfoE ^ svar_dot)),
- Then0 = hlds_goal(_, GoalInfo),
- goal_to_conj_list(Then0, Thens0),
- add_then_arm_specific_unifiers(Context, StateVars,
- SInfo0, SInfoC, SInfoT0, SInfoT, Thens0, Thens, !VarSet),
- conj_list_to_goal(Thens, GoalInfo, Then1),
-
- % Calculate the svar_info with the highest numbered mappings from each arm.
- DisjSInfos = [hlds_goal_svar_info(Then1, SInfoT),
- hlds_goal_svar_info(Else0, SInfoE)],
- SInfo = reconcile_disj_svar_info(!.VarSet, DisjSInfos),
-
- % Add unifiers to each arm to ensure they both construct the same
- % final state variable mappings.
- Then = add_disj_unifiers(Context, SInfo, StateVars,
- hlds_goal_svar_info(Then1, SInfoT)),
- Else = add_disj_unifiers(Context, SInfo, StateVars,
- hlds_goal_svar_info(Else0, SInfoE)).
-
- % If a new mapping was produced for state variable X in the condition-goal
- % (i.e. the condition refers to !:X), but not in the then-goal, then
- % we have to add a new unifier !:X = !.X to the then-goal because the
- % new mapping was created in a negated context.
- %
-:- pred add_then_arm_specific_unifiers(prog_context::in, svars::in,
- svar_info::in, svar_info::in, svar_info::in, svar_info::out,
- list(hlds_goal)::in, list(hlds_goal)::out,
- prog_varset::in, prog_varset::out) is det.
-
-add_then_arm_specific_unifiers(_, [], _, _, !SInfoT, !Thens, !VarSet).
-add_then_arm_specific_unifiers(Context, [StateVar | StateVars],
- SInfo0, SInfoC, !SInfoT, !Thens, !VarSet) :-
- (
- % The condition refers to !:X, but the then-goal doesn't.
-
- % If the condition refers to !:X, then X will appear in the map after
- % the condition, and therefore in the following map at the end of the
- % else too.
- map.search(SInfoC ^ svar_dot, StateVar, DotC),
- map.search(!.SInfoT ^ svar_dot, StateVar, DotT),
- DotT = DotC,
-
- % We know that the condition refers to !:X if either X did not appear
- % in the map before the if-then-else, or if it did, but with a
- % different program variable than at the end of the condition.
- \+ (
- map.search(SInfo0 ^ svar_dot, StateVar, Dot0),
- DotC = Dot0
+ ;
+ (
+ AfterArmStatus = status_known(AfterArmVar),
+ (
+ AfterAllArmsStatus = status_known(AfterAllVar),
+ CopyGoals = CopyGoalsTail,
+ UninitVarNames = UninitVarNamesTail,
+ ( AfterArmVar = AfterAllVar ->
+ Renames = RenamesTail
+ ;
+ Renames = [AfterArmVar - AfterAllVar | RenamesTail]
)
- ->
- % Add a new unifier !:X = !.X.
- new_colon_state_var(StateVar, NewDotT, !VarSet, !SInfoT),
- ThenUnifier = svar_unification(yes(feature_dont_warn_singleton),
- Context, NewDotT, DotT),
- !:Thens = [ThenUnifier | !.Thens],
- svar_prepare_for_next_conjunct(set.make_singleton_set(StateVar),
- !VarSet, !SInfoT)
;
- true
+ ( AfterAllArmsStatus = status_known_ro(_, _, _)
+ ; AfterAllArmsStatus = status_known_updated(_, _)
+ ; AfterAllArmsStatus = status_unknown
+ ; AfterAllArmsStatus = status_unknown_updated(_)
),
- add_then_arm_specific_unifiers(Context, StateVars,
- SInfo0, SInfoC, !SInfoT, !Thens, !VarSet).
-
-%-----------------------------------------------------------------------------%
-
-:- pred next_svar_mappings(int::in, svars::in,
- prog_varset::in, prog_varset::out, svar_map::out) is det.
-
-next_svar_mappings(N, StateVars, !VarSet, Map) :-
- next_svar_mappings_2(N, StateVars, !VarSet, map.init, Map).
-
-:- pred next_svar_mappings_2(int::in, svars::in,
- prog_varset::in, prog_varset::out, svar_map::in, svar_map::out) is det.
-
-next_svar_mappings_2(_, [], !VarSet, !Map).
-next_svar_mappings_2(N, [StateVar | StateVars], !VarSet, !Map) :-
- next_svar_mapping(N, StateVar, _, !VarSet, !Map),
- next_svar_mappings_2(N, StateVars, !VarSet, !Map).
-
-%-----------------------------------------------------------------------------%
-
-svar_finish_negation(SInfoBefore, SInfoNeg, !:SInfo) :-
- !:SInfo = SInfoBefore,
- !SInfo ^ svar_num := SInfoNeg ^ svar_num,
- !SInfo ^ svar_colon := SInfoNeg ^ svar_colon.
-
-%-----------------------------------------------------------------------------%
-
-svar_finish_disjunction(Context, VarSet, DisjSInfos, Disjs, SInfo) :-
- SInfo = reconcile_disj_svar_info(VarSet, DisjSInfos),
- map.keys(SInfo ^ svar_dot, StateVars),
- Disjs = list.map(add_disj_unifiers(Context, SInfo, StateVars), DisjSInfos).
-
- % Each arm of a disjunction may have a different mapping for
- % !.X and/or !:X. The reconciled svar_info for the disjunction takes
- % the highest numbered mapping for each disjunct (each state variable
- % mapping for !.X or !:X will have a name of the form `STATE_VARIABLE_X_n'
- % for some number `n'.)
- %
-:- func reconcile_disj_svar_info(prog_varset, hlds_goal_svar_infos) =
- svar_info.
-
-reconcile_disj_svar_info(_, []) = _ :-
- unexpected($module, $pred, "empty disjunct list").
-reconcile_disj_svar_info(VarSet, [DisjSInfo | DisjSInfos]) = SInfo :-
- % We compute the set of final !. and !: state variables over the whole
- % disjunction (not all arms will necessarily include !. and !: mappings
- % for all state variables).
- DisjSInfo = hlds_goal_svar_info(_, SInfo0),
- Dots0 = set.sorted_list_to_set(map.keys(SInfo0 ^ svar_dot)),
- Colons0 = set.sorted_list_to_set(map.keys(SInfo0 ^ svar_colon)),
- union_dot_colon_svars(DisjSInfos, Dots0, Dots, Colons0, Colons),
-
- % Then we update SInfo0 to take the highest numbered !. and !: mapping
- % for each state variable.
- list.foldl(reconcile_svar_infos(VarSet, Dots, Colons), DisjSInfos,
- SInfo0, SInfo).
+ unexpected($module, $pred,
+ "AfterAllArmsStatus != status_known (Before != After)")
+ )
+ ;
+ AfterArmStatus = status_known_ro(_, _, _),
+ unexpected($module, $pred, "AfterArmStatus = status_known_ro")
+ ;
+ AfterArmStatus = status_known_updated(_, _),
+ unexpected($module, $pred, "AfterArmStatus = status_known_updated")
+ ;
+ AfterArmStatus = status_unknown,
+ unexpected($module, $pred, "AfterArmStatus = status_unknown")
+ ;
+ AfterArmStatus = status_unknown_updated(_),
+ unexpected($module, $pred, "AfterArmStatus = status_unknown")
+ )
+ ).
-:- pred union_dot_colon_svars(hlds_goal_svar_infos::in,
- svar_set::in, svar_set::out, svar_set::in, svar_set::out) is det.
+:- pred make_copy_goal(prog_var::in, prog_var::in, hlds_goal::out) is det.
-union_dot_colon_svars([], !Dots, !Colons).
-union_dot_colon_svars([DisjSInfo | DisjSInfos], !Dots, !Colons) :-
- DisjSInfo = hlds_goal_svar_info(_, SInfo),
- set.union(set.sorted_list_to_set(map.keys(SInfo ^ svar_dot)), !Dots),
- set.union(set.sorted_list_to_set(map.keys(SInfo ^ svar_colon)), !Colons),
- union_dot_colon_svars(DisjSInfos, !Dots, !Colons).
+make_copy_goal(FromVar, ToVar, CopyGoal) :-
+ % We can do the copying in one of two ways. Using unifications
+ % can cause problems because the (plain, non-unique) mode analysis pass
+ % feels free to schedule them in places where the unique mode analysis pass
+ % does not like them; specifically, it can cause a di reference to a
+ % variable to appear before a ui reference.
+ %
+ % The alternative is to add a builtin predicate to the standard library
+ % that just does copying, and to make make_copy_goal construct a call to
+ % that predicate. That predicate would need to be able to be called in
+ % three modes: di/uo, mdi/muo and in/out. However, it needs to have inst
+ % parameters so that whatever shape information we have about the source
+ % (subtype info, higher order mode info), we copy to the target.
+ %
+ % We generate a unification, and try to ensure that we don't generate
+ % di references to state variables before possible ui references. See the
+ % comment in svar_find_final_renames_and_copy_goals before the call to
+ % make_copy_goal.
+
+ create_pure_atomic_complicated_unification(ToVar, rhs_var(FromVar),
+ term.context_init, umc_implicit("state variable"), [], CopyGoal0),
+ goal_add_feature(feature_dont_warn_singleton,
+ CopyGoal0, CopyGoal).
+
+%-----------------------------------------------------------------------------%
+%
+% Handle if-then-else goals. The basic idea is the same as for
+% disjunctions, but we also have to handle three complications.
+%
+% First, the first disjunct consists of two parts: the condition and the then
+% part, with data flowing between them.
+%
+% Second, variables can be quantified over the condition and the then part.
+%
+% Third, the if-then-else need not be a goal; it can also be an expression.
+% This means that it is ok for variables to have status known_updated or
+% unknown_updated in any of the status maps we handle.
+%
+
+svar_finish_if_then_else(LocKind, Context, QuantStateVars,
+ ThenGoal0, ThenGoal, ElseGoal0, ElseGoal,
+ StateBefore, StateAfterCond, StateAfterThen, StateAfterElse,
+ StateAfterITE, !VarSet, !Store, !Specs) :-
+ StateBefore = svar_state(StatusMapBefore),
+ StatusMapAfterCond = StateAfterCond ^ state_status_map,
+ StatusMapAfterThen = StateAfterThen ^ state_status_map,
+ StatusMapAfterElse = StateAfterElse ^ state_status_map,
+ map.keys(StatusMapBefore, SVarsBefore),
+ map.keys(StatusMapAfterCond, SVarsAfterCond),
+ map.keys(StatusMapAfterThen, SVarsAfterThen),
+ map.keys(StatusMapAfterElse, SVarsAfterElse),
+ expect(list.sublist(SVarsBefore, SVarsAfterCond), $pred,
+ "vars Before not sublist of Cond"),
+ expect(unify(SVarsBefore, SVarsAfterThen), $pred,
+ "vars Before != AfterThen"),
+ expect(unify(SVarsBefore, SVarsAfterElse), $pred,
+ "vars Before != AfterElse"),
+
+ handle_state_vars_in_ite(LocKind, QuantStateVars,
+ SVarsBefore, StatusMapBefore, StatusMapAfterCond,
+ StatusMapAfterThen, StatusMapAfterElse,
+ map.init, StatusMapAfterITE, !VarSet,
+ [], NeckCopyGoals, [], ThenEndCopyGoals, [], ElseEndCopyGoals,
+ [], ThenRenames, [], ElseRenames,
+ [], ThenMissingInits, [], ElseMissingInits),
+ StateAfterITE = svar_state(StatusMapAfterITE),
+
+ % It is ok for an arm that cannot succeed not to initialize a variable,
+ % but we record warnings for them anyway, to be printed in case the
+ % procedure has a mode error.
+ (
+ ThenMissingInits = []
+ ;
+ ThenMissingInits = [_ | _],
+ ThenWarnings0 = !.Store ^ store_warnings,
+ report_missing_inits_in_ite(Context, ThenMissingInits,
+ "succeeds", "fails", ThenWarnings0, ThenWarnings),
+ !Store ^ store_warnings := ThenWarnings
+ ),
+ (
+ ElseMissingInits = []
+ ;
+ ElseMissingInits = [_ | _],
+ ElseWarnings0 = !.Store ^ store_warnings,
+ report_missing_inits_in_ite(Context, ThenMissingInits,
+ "fails", "succeeds", ElseWarnings0, ElseWarnings),
+ !Store ^ store_warnings := ElseWarnings
+ ),
-:- pred reconcile_svar_infos(prog_varset::in, svar_set::in, svar_set::in,
- hlds_goal_svar_info::in, svar_info::in, svar_info::out) is det.
+ svar_goal_to_conj_list(ThenGoal0, ThenGoals0, !Store),
+ svar_goal_to_conj_list(ElseGoal0, ElseGoals0, !Store),
+ ThenGoals = NeckCopyGoals ++ ThenGoals0 ++ ThenEndCopyGoals,
+ ElseGoals = ElseGoals0 ++ ElseEndCopyGoals,
+ ThenGoal0 = hlds_goal(_ThenExpr0, ThenInfo0),
+ ElseGoal0 = hlds_goal(_ElseExpr0, ElseInfo0),
+ conj_list_to_goal(ThenGoals, ThenInfo0, ThenGoal1),
+ conj_list_to_goal(ElseGoals, ElseInfo0, ElseGoal1),
+
+ !.Store = svar_store(NextGoalId0, DelayedRenamings0, Warnings),
+ counter.allocate(ThenGoalIdNum, NextGoalId0, NextGoalId1),
+ counter.allocate(ElseGoalIdNum, NextGoalId1, NextGoalId),
+ ThenGoalId = goal_id(ThenGoalIdNum),
+ ElseGoalId = goal_id(ElseGoalIdNum),
+ goal_set_goal_id(ThenGoalId, ThenGoal1, ThenGoal),
+ goal_set_goal_id(ElseGoalId, ElseGoal1, ElseGoal),
+ svmap.det_insert(ThenGoalId, ThenRenames,
+ DelayedRenamings0, DelayedRenamings1),
+ svmap.det_insert(ElseGoalId, ElseRenames,
+ DelayedRenamings1, DelayedRenamings),
+ !:Store = svar_store(NextGoalId, DelayedRenamings, Warnings).
+
+:- pred handle_state_vars_in_ite(loc_kind::in, list(svar)::in, list(svar)::in,
+ map(svar, svar_status)::in, map(svar, svar_status)::in,
+ map(svar, svar_status)::in, map(svar, svar_status)::in,
+ map(svar, svar_status)::in, map(svar, svar_status)::out,
+ prog_varset::in, prog_varset::out,
+ list(hlds_goal)::in, list(hlds_goal)::out,
+ list(hlds_goal)::in, list(hlds_goal)::out,
+ list(hlds_goal)::in, list(hlds_goal)::out,
+ assoc_list(prog_var, prog_var)::in, assoc_list(prog_var, prog_var)::out,
+ assoc_list(prog_var, prog_var)::in, assoc_list(prog_var, prog_var)::out,
+ list(string)::in, list(string)::out, list(string)::in, list(string)::out)
+ is det.
-reconcile_svar_infos(VarSet, Dots, Colons, GoalSInfoX, !SInfo) :-
- GoalSInfoX = hlds_goal_svar_info(_, SInfoX),
- InitNum = !.SInfo ^ svar_num,
- XNum = SInfoX ^ svar_num,
- set.fold(reconcile_svar_infos_dots(VarSet, SInfoX), Dots, !SInfo),
- set.fold(reconcile_svar_infos_colons(VarSet, SInfoX), Colons, !SInfo),
- !SInfo ^ svar_num := max(InitNum, XNum).
+handle_state_vars_in_ite(_, _, [], _, _, _, _, !StatusMapAfterITE,
+ !VarSet, !NeckCopyGoals, !ThenEndCopyGoals, !ElseEndCopyGoals,
+ !ThenRenames, !ElseRenames, !ThenMissingInits, !ElseMissingInits).
+handle_state_vars_in_ite(LocKind, QuantStateVars, [SVar | SVars],
+ StatusMapBefore, StatusMapAfterCond, StatusMapAfterThen,
+ StatusMapAfterElse, !StatusMapAfterITE,
+ !VarSet, !NeckCopyGoals, !ThenEndCopyGoals, !ElseEndCopyGoals,
+ !ThenRenames, !ElseRenames, !ThenMissingInits, !ElseMissingInits) :-
+ map.lookup(StatusMapBefore, SVar, StatusBefore),
+ map.lookup(StatusMapAfterCond, SVar, StatusAfterCond),
+ map.lookup(StatusMapAfterThen, SVar, StatusAfterThen),
+ map.lookup(StatusMapAfterElse, SVar, StatusAfterElse),
+
+ ( list.member(SVar, QuantStateVars) ->
+ expect(unify(StatusBefore, StatusAfterThen), $module,
+ "state var shadowed in if-then-else is nevertheless updated"),
+ % SVar is quantified in the if-then-else. That means that Cond and Then
+ % may update a state variable with the same name as SVar, but this
+ % won't be SVar itself. The status of SVar itself after Cond and after
+ % Then will thus be unchanged. This is why we pass StatusBefore
+ % not just for itself, but in place of StatusAfterCond and
+ % StatusAfterThen as well.
+ handle_state_var_in_ite(LocKind, SVar, StatusBefore,
+ StatusBefore, StatusBefore, StatusAfterElse, StatusAfterITE,
+ !VarSet, !NeckCopyGoals, !ThenEndCopyGoals, !ElseEndCopyGoals,
+ !ThenRenames, !ElseRenames, !ThenMissingInits, !ElseMissingInits)
+ ;
+ % If StatusBefore = status_known_ro(_, _, _), then we would expect
+ % StatusBefore = StatusAfterCond
+ % StatusBefore = StatusAfterThen
+ % StatusBefore = StatusAfterElse
+ % However, if the user program actually updates a state variable
+ % that should be readonly in this scope, then our recovery from that
+ % error would invalidate these expectations.
+
+ handle_state_var_in_ite(LocKind, SVar, StatusBefore,
+ StatusAfterCond, StatusAfterThen, StatusAfterElse, StatusAfterITE,
+ !VarSet, !NeckCopyGoals, !ThenEndCopyGoals, !ElseEndCopyGoals,
+ !ThenRenames, !ElseRenames, !ThenMissingInits, !ElseMissingInits)
+ ),
+ svmap.det_insert(SVar, StatusAfterITE, !StatusMapAfterITE),
+ handle_state_vars_in_ite(LocKind, QuantStateVars, SVars,
+ StatusMapBefore, StatusMapAfterCond, StatusMapAfterThen,
+ StatusMapAfterElse, !StatusMapAfterITE,
+ !VarSet, !NeckCopyGoals, !ThenEndCopyGoals, !ElseEndCopyGoals,
+ !ThenRenames, !ElseRenames, !ThenMissingInits, !ElseMissingInits).
+
+:- pred handle_state_var_in_ite(loc_kind::in, svar::in,
+ svar_status::in, svar_status::in, svar_status::in, svar_status::in,
+ svar_status::out, prog_varset::in, prog_varset::out,
+ list(hlds_goal)::in, list(hlds_goal)::out,
+ list(hlds_goal)::in, list(hlds_goal)::out,
+ list(hlds_goal)::in, list(hlds_goal)::out,
+ assoc_list(prog_var, prog_var)::in, assoc_list(prog_var, prog_var)::out,
+ assoc_list(prog_var, prog_var)::in, assoc_list(prog_var, prog_var)::out,
+ list(string)::in, list(string)::out, list(string)::in, list(string)::out)
+ is det.
-:- pred reconcile_svar_infos_dots(prog_varset::in, svar_info::in, svar::in,
- svar_info::in, svar_info::out) is det.
+handle_state_var_in_ite(LocKind, SVar, StatusBefore,
+ StatusAfterCond, StatusAfterThen, StatusAfterElse, StatusAfterITE,
+ !VarSet, !NeckCopyGoals, !ThenEndCopyGoals, !ElseEndCopyGoals,
+ !ThenRenames, !ElseRenames, !ThenMissingInits, !ElseMissingInits) :-
+ % There are eight cases depending on which of Cond, Then and Else
+ % update the state variable:
+ %
+ % # Cond Then Else Action
+ % 1 no no no do nothing
+ % 2 no no yes copy at end of then
+ % 3 no yes no copy at end of else
+ % 4 no yes yes rename else to match then
+ % 5 yes no no copy from cond at start of then, copy at end of else
+ % 6 yes no yes copy from cond at start of then
+ % 7 yes yes no copy at end of else
+ % 8 yes yes yes rename else to match then
+
+ trace [compiletime(flag("state-var-ite")), io(!IO)] (
+ io.write_string("state variable ", !IO),
+ io.write(SVar, !IO),
+ io.nl(!IO),
+ io.write_string("status before: ", !IO),
+ io.write(StatusBefore, !IO),
+ io.nl(!IO),
+ io.write_string("status after cond: ", !IO),
+ io.write(StatusAfterCond, !IO),
+ io.nl(!IO),
+ io.write_string("status after then: ", !IO),
+ io.write(StatusAfterThen, !IO),
+ io.nl(!IO),
+ io.write_string("status after else: ", !IO),
+ io.write(StatusAfterElse, !IO),
+ io.nl(!IO)
+ ),
-reconcile_svar_infos_dots(VarSet, SInfoX, StateVar, !SInfo) :-
- DotMapX = SInfoX ^ svar_dot,
- DotMap0 = !.SInfo ^ svar_dot,
+ ( StatusAfterCond = StatusBefore ->
+ % Cases 1-4.
+ ( StatusAfterThen = StatusAfterCond ->
+ % Cases 1-2.
+ ( StatusAfterElse = StatusBefore ->
+ % Case 1.
+ StatusAfterITE = StatusBefore
+ ;
+ % Case 2.
(
- map.search(DotMapX, StateVar, DotX),
- map.search(DotMap0, StateVar, Dot0)
- ->
- varset.lookup_name(VarSet, DotX, NameX),
- varset.lookup_name(VarSet, Dot0, Name0),
- compare_svar_names(RDot, NameX, Name0),
+ StatusBefore = status_known(VarBefore),
+ VarAfterElse =
+ svar_get_current_progvar(LocKind, StatusAfterElse),
+ make_copy_goal(VarBefore, VarAfterElse, CopyGoal),
+ !:ThenEndCopyGoals = [CopyGoal | !.ThenEndCopyGoals],
+ StatusAfterITE = StatusAfterElse
+ ;
+ StatusBefore = status_unknown,
+ varset.lookup_name(!.VarSet, SVar, SVarName),
+ !:ThenMissingInits =
+ ["!:" ++ SVarName | !.ThenMissingInits],
+ % We pretend the then part defines StateVar, since this is
+ % the right thing to do when the then part cannot succeed.
+ % If it can, we will generate an error message during
+ % mode analysis.
+ StatusAfterITE = StatusAfterElse
+ ;
+ StatusBefore = status_known_ro(_, _, _),
+ % The update of !SVar in the else case was an error,
+ % for which we have already generated an error message.
+ % Because of that, this dummy value won't be used.
+ % XXX Returning StatusAfterElse would cause fewer cascading
+ % error messages, but are those messages useful or not?
+ StatusAfterITE = StatusBefore
+ ;
+ ( StatusBefore = status_known_updated(_, _)
+ ; StatusBefore = status_unknown_updated(_)
+ ),
+ % This can happen if LocKind = loc_inside_atomic_goal,
+ % but any reference to !:SVar in the else case should
+ % have just returned the new progvar for SVar.
+ unexpected($module, $pred, "updated before (case 2)")
+ )
+ )
+ ;
+ % Cases 3-4.
+ ( StatusAfterElse = StatusBefore ->
+ % Case 3.
(
- ( RDot = (<)
- ; RDot = (=)
+ StatusBefore = status_known(VarBefore),
+ VarAfterThen =
+ svar_get_current_progvar(LocKind, StatusAfterThen),
+ make_copy_goal(VarBefore, VarAfterThen, CopyGoal),
+ !:ElseEndCopyGoals = [CopyGoal | !.ElseEndCopyGoals],
+ StatusAfterITE = StatusAfterThen
+ ;
+ StatusBefore = status_unknown,
+ varset.lookup_name(!.VarSet, SVar, SVarName),
+ !:ElseMissingInits =
+ ["!:" ++ SVarName | !.ElseMissingInits],
+ % We pretend the else part defines StateVar, since this is
+ % the right thing to do when the else part cannot succeed.
+ % If it can, we will generate an error message during
+ % mode analysis.
+ StatusAfterITE = StatusAfterThen
+ ;
+ StatusBefore = status_known_ro(_, _, _),
+ % The update of !SVar in the then case was an error,
+ % for which we have already generated an error message.
+ % Because of that, this dummy value won't be used.
+ % XXX Returning StatusAfterThen would cause fewer cascading
+ % error messages, but are those messages useful or not?
+ StatusAfterITE = StatusBefore
+ ;
+ ( StatusBefore = status_known_updated(_, _)
+ ; StatusBefore = status_unknown_updated(_)
+ ),
+ % This can happen if LocKind = loc_inside_atomic_goal,
+ % but any reference to !:SVar in the then case should
+ % have just returned the new progvar for SVar.
+ unexpected($module, $pred, "updated before (case 3)")
)
;
- RDot = (>),
- map.det_update(DotMap0, StateVar, DotX, DotMap),
- !SInfo ^ svar_dot := DotMap
+ % Case 4.
+ VarAfterThen =
+ svar_get_current_progvar(LocKind, StatusAfterThen),
+ VarAfterElse =
+ svar_get_current_progvar(LocKind, StatusAfterElse),
+ !:ElseRenames = [VarAfterElse - VarAfterThen | !.ElseRenames],
+ StatusAfterITE = StatusAfterThen
+ )
)
;
- true
- ).
-
-:- pred reconcile_svar_infos_colons(prog_varset::in, svar_info::in, svar::in,
- svar_info::in, svar_info::out) is det.
-
-reconcile_svar_infos_colons(VarSet, SInfoX, StateVar, !SInfo) :-
- ColonMapX = SInfoX ^ svar_colon,
- ColonMap0 = !.SInfo ^ svar_colon,
+ % Cases 5-8.
+ ( StatusAfterThen = StatusAfterCond ->
+ % Cases 5-6.
+ ( StatusAfterElse = StatusBefore ->
+ % Case 5.
(
- map.search(ColonMapX, StateVar, ColonX),
- map.search(ColonMap0, StateVar, Colon0)
- ->
- varset.lookup_name(VarSet, ColonX, NameX),
- varset.lookup_name(VarSet, Colon0, Name0),
- compare_svar_names(RColon, NameX, Name0),
- (
- ( RColon = (<)
- ; RColon = (=)
+ StatusBefore = status_known(VarBefore),
+ new_state_var_instance(SVar, name_middle, FinalVar,
+ !VarSet),
+ VarAfterCond =
+ svar_get_current_progvar(LocKind, StatusAfterCond),
+
+ make_copy_goal(VarAfterCond, FinalVar, NeckCopyGoal),
+ !:NeckCopyGoals = [NeckCopyGoal | !.NeckCopyGoals],
+ make_copy_goal(VarBefore, FinalVar, ElseCopyGoal),
+ !:ElseEndCopyGoals = [ElseCopyGoal | !.ElseEndCopyGoals],
+ StatusAfterITE = status_known(FinalVar)
+ ;
+ StatusBefore = status_unknown,
+ varset.lookup_name(!.VarSet, SVar, SVarName),
+ !:ElseMissingInits =
+ ["!:" ++ SVarName | !.ElseMissingInits],
+ % We pretend the else part defines StateVar, since this is
+ % the right thing to do when the else part cannot succeed.
+ % If it can, we will generate an error message during
+ % mode analysis.
+ new_state_var_instance(SVar, name_middle, FinalVar,
+ !VarSet),
+ VarAfterCond =
+ svar_get_current_progvar(LocKind, StatusAfterCond),
+ make_copy_goal(VarAfterCond, FinalVar, NeckCopyGoal),
+ !:NeckCopyGoals = [NeckCopyGoal | !.NeckCopyGoals],
+ StatusAfterITE = status_known(FinalVar)
+ ;
+ StatusBefore = status_known_ro(_, _, _),
+ % The update of !SVar in the condition was an error,
+ % for which we have already generated an error message.
+ % Because of that, this dummy value won't be used.
+ % XXX Returning StatusAfterCond would cause fewer cascading
+ % error messages, but are those messages useful or not?
+ StatusAfterITE = StatusBefore
+ ;
+ ( StatusBefore = status_known_updated(_, _)
+ ; StatusBefore = status_unknown_updated(_)
+ ),
+ % This can happen if LocKind = loc_inside_atomic_goal,
+ % but any reference to !:SVar in the condition should
+ % have just returned the new progvar for SVar.
+ unexpected($module, $pred, "updated before (case 5)")
)
;
- RColon = (>),
- map.det_update(ColonMap0, StateVar, ColonX, ColonMap),
- !SInfo ^ svar_colon := ColonMap
+ % Case 6.
+ VarAfterCond =
+ svar_get_current_progvar(LocKind, StatusAfterCond),
+ VarAfterElse =
+ svar_get_current_progvar(LocKind, StatusAfterElse),
+ make_copy_goal(VarAfterCond, VarAfterElse, CopyGoal),
+ !:NeckCopyGoals = [CopyGoal | !.NeckCopyGoals],
+ StatusAfterITE = StatusAfterElse
)
;
- true
- ).
-
-:- func add_disj_unifiers(prog_context, svar_info, svars, hlds_goal_svar_info)
- = hlds_goal.
-
-add_disj_unifiers(Context, SInfo, StateVars, GoalSInfoX) = Goal :-
- GoalSInfoX = hlds_goal_svar_info(GoalX, SInfoX),
- Unifiers0 = [],
- list.foldl(add_disj_unifier(Context, SInfo, SInfoX), StateVars,
- Unifiers0, Unifiers),
- GoalX = hlds_goal(_, GoalInfo),
- goal_to_conj_list(GoalX, GoalsX),
- conj_list_to_goal(GoalsX ++ Unifiers, GoalInfo, Goal).
-
-:- pred add_disj_unifier(prog_context::in, svar_info::in, svar_info::in,
- svar::in, list(hlds_goal)::in, list(hlds_goal)::out) is det.
-
-add_disj_unifier(Context, SInfo, SInfoX, StateVar, !Unifiers) :-
- (
- map.search(SInfo ^ svar_dot, StateVar, Dot),
- map.search(SInfoX ^ svar_dot, StateVar, DotX),
- Dot \= DotX
- ->
- Unifier = svar_unification(yes(feature_dont_warn_singleton), Context,
- Dot, DotX),
- !:Unifiers = [Unifier | !.Unifiers]
+ % Cases 7-8.
+ ( StatusAfterElse = StatusBefore ->
+ % Case 7.
+ (
+ StatusBefore = status_known(VarBefore),
+ VarAfterThen =
+ svar_get_current_progvar(LocKind, StatusAfterThen),
+ make_copy_goal(VarBefore, VarAfterThen, CopyGoal),
+ !:ElseEndCopyGoals = [CopyGoal | !.ElseEndCopyGoals],
+ StatusAfterITE = StatusAfterThen
+ ;
+ StatusBefore = status_unknown,
+ varset.lookup_name(!.VarSet, SVar, SVarName),
+ !:ElseMissingInits =
+ ["!:" ++ SVarName | !.ElseMissingInits],
+ % We pretend the else part defines StateVar, since this is
+ % the right thing to do when the else part cannot succeed.
+ % If it can, we will generate an error message during
+ % mode analysis.
+ StatusAfterITE = StatusAfterThen
+ ;
+ StatusBefore = status_known_ro(_, _, _),
+ % The updates of !SVar in the condition and then cases
+ % were errors, for which we already generated messages.
+ % Because of that, this dummy value won't be used.
+ % XXX Returning StatusAfterThen would cause fewer cascading
+ % error messages, but are those messages useful or not?
+ StatusAfterITE = StatusBefore
;
- true
+ ( StatusBefore = status_known_updated(_, _)
+ ; StatusBefore = status_unknown_updated(_)
+ ),
+ % This can happen if LocKind = loc_inside_atomic_goal,
+ % but any reference to !:SVar in the condition and
+ % then case should have just returned the new progvar
+ % for SVar.
+ unexpected($module, $pred, "updated before (case 7)")
+ )
+ ;
+ % Case 8.
+ VarAfterThen =
+ svar_get_current_progvar(LocKind, StatusAfterThen),
+ VarAfterElse =
+ svar_get_current_progvar(LocKind, StatusAfterElse),
+ !:ElseRenames = [VarAfterElse - VarAfterThen | !.ElseRenames],
+ StatusAfterITE = StatusAfterThen
+ )
+ )
).
%-----------------------------------------------------------------------------%
+%
+% Handle atomic goals. Atomic goals are basically a disjunction between
+% the main goal and the orelse goals.
+%
- % We implement a special purpose comparison for state variable names
- % that compares the numbers appended at the right hand ends of the
- % name strings.
- %
- % NOTE State variable names are either "..._X" or "..._X_N" where X is
- % the name of the program variable used for the state variable and
- % N is a decimal number with no leading zeroes.
- %
- % NOTE The code below looks a bit slow, since it extracts the numbers
- % from the ends of variable names repeatedly. I (zs) tried to avoid
- % this cost by making the read_only_dot, dot and colon maps in svar_infos
- % map not just to a variable but a pair of a variable and a number,
- % the number being the one we extract below. This even allowed us to avoid
- % passing varsets in lots of places, since in many predicates varsets
- % are needed only for looking up the variable names passed to
- % compare_svar_names. However, I found that the result was an overall
- % slowdown. Apparently, the overhead of recording the numbers, and of
- % extracting the variables from the variable-number pairs in lookups,
- % is higher than the overhead of compare_svar_names.
- %
-:- pred compare_svar_names(comparison_result::out, string::in, string::in)
- is det.
-
-compare_svar_names(R, A, B) :-
- compare(R, int_suffix_of(A), int_suffix_of(B)).
-
- % Find the number suffix at the end of a string as an int.
- %
-:- func int_suffix_of(string) = int.
-
-int_suffix_of(S) = int_suffix_2(S, length(S) - 1, 1, 0).
-
- % int_suffix_2(String, Index, RadixOfIndexDigit, IntSoFar) = IntSuffix
- %
-:- func int_suffix_2(string, int, int, int) = int.
+:- type svar_outer_atomic_scope_info
+ ---> svar_outer_atomic_scope_info(
+ soasi_state_var :: svar,
+ soasi_before_status :: svar_status,
+ soasi_after_status :: svar_status
+ )
+ ; no_svar_outer_atomic_scope_info.
-int_suffix_2(S, I, R, N) =
+svar_start_outer_atomic_scope(Context, OuterStateVar, OuterDIVar, OuterUOVar,
+ OuterScopeInfo, !State, !VarSet, !Specs) :-
+ StatusMap0 = !.State ^ state_status_map,
+ ( map.remove(StatusMap0, OuterStateVar, BeforeStatus, StatusMap) ->
+ !State ^ state_status_map := StatusMap,
(
- 0 =< I,
- digit_to_int(S `unsafe_index` I, D),
- D < 10
- ->
- int_suffix_2(S, I - 1, 10 * R, (R * D) + N)
+ BeforeStatus = status_unknown,
+ report_uninitialized_state_var(Context, !.VarSet, OuterStateVar,
+ !Specs),
+ new_state_var_instance(OuterStateVar, name_middle, OuterDIVar,
+ !VarSet),
+ new_state_var_instance(OuterStateVar, name_middle, OuterUOVar,
+ !VarSet),
+ OuterScopeInfo = svar_outer_atomic_scope_info(OuterStateVar,
+ BeforeStatus, BeforeStatus)
;
- N
- ).
-
-%-----------------------------------------------------------------------------%
-
-svar_finish_equivalence(SInfoBefore, SInfoEqv, SInfo) :-
- svar_finish_negation(SInfoBefore, SInfoEqv, SInfo).
-
-%-----------------------------------------------------------------------------%
-
-svar_prepare_for_call(ParentSInfo, SInfo) :-
- ( ParentSInfo ^ svar_ctxt = in_atom(UpdatedStateVars, _GrandparentSInfo) ->
- Ctxt = in_atom(UpdatedStateVars, ParentSInfo)
+ BeforeStatus = status_known_ro(OuterDIVar, RO_Construct,
+ RO_Context),
+ report_illegal_state_var_update(Context,
+ ro_construct_name(RO_Construct), RO_Context, !.VarSet,
+ OuterStateVar, !Specs),
+ new_state_var_instance(OuterStateVar, name_middle, OuterUOVar,
+ !VarSet),
+ OuterScopeInfo = svar_outer_atomic_scope_info(OuterStateVar,
+ BeforeStatus, BeforeStatus)
;
- Ctxt = in_atom(set.init, ParentSInfo)
- ),
- SInfo = ParentSInfo ^ svar_ctxt := Ctxt.
-
-%-----------------------------------------------------------------------------%
-
-svar_finish_call(!VarSet, !SInfo) :-
- ( !.SInfo ^ svar_ctxt = in_atom(UpdatedStateVars, ParentSInfo0) ->
- ParentSInfo = ( ParentSInfo0 ^ svar_dot := !.SInfo ^ svar_dot ),
- ( ParentSInfo ^ svar_ctxt = in_atom(_, GrandParentSInfo) ->
- !:SInfo = ( ParentSInfo ^ svar_ctxt :=
- in_atom(UpdatedStateVars, GrandParentSInfo) )
+ BeforeStatus = status_known(OuterDIVar),
+ new_state_var_instance(OuterStateVar, name_middle, OuterUOVar,
+ !VarSet),
+ AfterStatus = status_known(OuterUOVar),
+ OuterScopeInfo = svar_outer_atomic_scope_info(OuterStateVar,
+ BeforeStatus, AfterStatus)
;
- svar_prepare_for_next_conjunct(UpdatedStateVars, !VarSet,
- ParentSInfo, !:SInfo)
+ ( BeforeStatus = status_known_updated(_, _)
+ ; BeforeStatus = status_unknown_updated(_)
+ ),
+ % This status should exist in a status map only when we are in the
+ % middle of processing an atomic goal.
+ unexpected($module, $pred, "status updated")
)
;
- unexpected($module, $pred, "ctxt is not in_atom")
+ report_non_visible_state_var("", Context, !.VarSet, OuterStateVar,
+ !Specs),
+ new_state_var_instance(OuterStateVar, name_middle, OuterDIVar,
+ !VarSet),
+ new_state_var_instance(OuterStateVar, name_middle, OuterUOVar,
+ !VarSet),
+ OuterScopeInfo = no_svar_outer_atomic_scope_info
).
-%-----------------------------------------------------------------------------%
-
-svar_prepare_for_if_then_else_goal(StateVars, !VarSet, !SInfo) :-
- prepare_for_local_state_vars(StateVars, !VarSet, !SInfo).
-
-%-----------------------------------------------------------------------------%
-
-svar_finish_if_then_else_goal_condition(StateVars, SInfoBefore,
- SInfoA0, SInfoA, SInfoB) :-
- SInfoB = SInfoA0,
- finish_local_state_vars(StateVars, _, SInfoBefore, SInfoA0, SInfoA).
-
-%-----------------------------------------------------------------------------%
-
-svar_finish_if_then_else_goal_then_goal(StateVars,
- SInfoBefore, SInfoB0, SInfoB) :-
- finish_local_state_vars(StateVars, _, SInfoBefore, SInfoB0, SInfoB).
-
-%-----------------------------------------------------------------------------%
-
-svar_prepare_for_if_then_else_expr(StateVars, !VarSet, !SInfo) :-
- SInfo0 = !.SInfo,
- !:SInfo = new_svar_info ^ svar_ctxt := in_body,
- !SInfo ^ svar_readonly_dot := SInfo0 ^ svar_dot,
- !SInfo ^ svar_num := SInfo0 ^ svar_num,
- prepare_for_local_state_vars(StateVars, !VarSet, !SInfo).
+svar_finish_outer_atomic_scope(OuterScopeInfo, !State) :-
+ (
+ OuterScopeInfo = svar_outer_atomic_scope_info(OuterStateVar,
+ _BeforeStatus, AfterStatus),
+ StatusMap0 = !.State ^ state_status_map,
+ svmap.det_insert(OuterStateVar, AfterStatus, StatusMap0, StatusMap),
+ !State ^ state_status_map := StatusMap
+ ;
+ OuterScopeInfo = no_svar_outer_atomic_scope_info
+ ).
%-----------------------------------------------------------------------------%
-svar_finish_if_then_else_expr_condition(Before, !SInfo) :-
- SInfo0 = !.SInfo,
- !SInfo ^ svar_readonly_dot := Before ^ svar_readonly_dot,
- !SInfo ^ svar_dot :=
- (SInfo0 ^ svar_dot) `overlay` (Before ^ svar_dot),
- !SInfo ^ svar_colon :=
- (SInfo0 ^ svar_colon) `overlay` (Before ^ svar_colon),
- !SInfo ^ svar_ctxt := Before ^ svar_ctxt.
-
-%-----------------------------------------------------------------------------%
+:- type svar_inner_atomic_scope_info
+ ---> svar_inner_atomic_scope_info(
+ siasi_state_var :: svar,
+ siasi_di_var :: prog_var,
+ siasi_state_before :: svar_state
+ ).
-svar_finish_if_then_else_expr_then_goal(StateVars, SInfoBefore, !SInfo) :-
- finish_local_state_vars(StateVars, _, SInfoBefore, !SInfo).
+svar_start_inner_atomic_scope(_Context, InnerStateVar, InnerScopeInfo,
+ !State, !VarSet, !Specs) :-
+ StateBefore = !.State,
+ new_state_var_instance(InnerStateVar, name_initial, InnerDIVar, !VarSet),
+ StatusMap0 = !.State ^ state_status_map,
+ svmap.set(InnerStateVar, status_known(InnerDIVar), StatusMap0, StatusMap),
+ !State ^ state_status_map := StatusMap,
+ InnerScopeInfo = svar_inner_atomic_scope_info(InnerStateVar, InnerDIVar,
+ StateBefore).
+
+svar_finish_inner_atomic_scope(_Context, InnerScopeInfo,
+ InnerDIVar, InnerUOVar, !State, !VarSet, !Specs) :-
+ InnerScopeInfo = svar_inner_atomic_scope_info(InnerStateVar, InnerDIVar,
+ StateBefore),
+ StatusMap0 = !.State ^ state_status_map,
+ map.lookup(StatusMap0, InnerStateVar, Status),
+ (
+ Status = status_known(InnerUOVar)
+ ;
+ ( Status = status_unknown
+ ; Status = status_unknown_updated(_)
+ ; Status = status_known_ro(_, _, _)
+ ; Status = status_known_updated(_, _)
+ ),
+ unexpected($module, $pred, "status != known")
+ ),
+ !:State = StateBefore.
%-----------------------------------------------------------------------------%
+%
+% Look up prog_vars for a state_var.
+%
-svar_prepare_for_next_conjunct(UpdatedStateVars, !VarSet, !SInfo) :-
- DotMap0 = !.SInfo ^ svar_dot,
- ColonMap0 = !.SInfo ^ svar_colon,
- N = !.SInfo ^ svar_num + 1,
- map.init(Nil),
- map.foldl(next_dot_mapping(UpdatedStateVars, DotMap0, ColonMap0),
- ColonMap0, Nil, DotMap),
- map.foldl2(next_colon_mapping(UpdatedStateVars, ColonMap0, N),
- ColonMap0, !VarSet, Nil, ColonMap),
- !SInfo ^ svar_ctxt := in_body,
- !SInfo ^ svar_num := N,
- !SInfo ^ svar_dot := DotMap,
- !SInfo ^ svar_colon := ColonMap.
-
- % If the state variable has been updated (i.e. there was a !:X reference)
- % then the next !.X mapping will be the current !:X mapping. Otherwise,
- % preserve the current !.X mapping, if any (there may be none if,
- % for example, the head only references !:X and there have been no prior
- % references to !:X in the body.)
- %
-:- pred next_dot_mapping(svar_set::in, svar_map::in, svar_map::in, svar::in,
- prog_var::in, svar_map::in, svar_map::out) is det.
+substitute_state_var_mappings([], [], !VarSet, !State, !Specs).
+substitute_state_var_mappings([Arg0 | Args0], [Arg | Args], !VarSet, !State,
+ !Specs) :-
+ substitute_state_var_mapping(Arg0, Arg, !VarSet, !State, !Specs),
+ substitute_state_var_mappings(Args0, Args, !VarSet, !State, !Specs).
-next_dot_mapping(UpdatedStateVars, OldDotMap, OldColonMap, StateVar, _,
- !DotMap) :-
- % XXX Should either of these svmap.sets be det_update or det_insert?
- ( UpdatedStateVars `contains` StateVar ->
- map.lookup(OldColonMap, StateVar, Var),
- svmap.set(StateVar, Var, !DotMap)
- ; map.search(OldDotMap, StateVar, Var) ->
- svmap.set(StateVar, Var, !DotMap)
+substitute_state_var_mapping(Arg0, Arg, !VarSet, !State, !Specs) :-
+ ( Arg0 = functor(atom("!."), [variable(StateVar, _)], Context) ->
+ lookup_dot_state_var(Context, StateVar, Var, !VarSet, !State, !Specs),
+ Arg = variable(Var, context_init)
+ ; Arg0 = functor(atom("!:"), [variable(StateVar, _)], Context) ->
+ lookup_colon_state_var(Context, StateVar, Var, !VarSet, !State,
+ !Specs),
+ Arg = variable(Var, context_init)
;
- true
+ Arg = Arg0
).
- % If the state variable has been updated (i.e. there was a !:X reference)
- % then create a new mapping for the next !:X. Otherwise, the next !:X
- % mapping is the same as the current !:X mapping.
- %
-:- pred next_colon_mapping(svar_set::in, svar_map::in, int::in, svar::in,
- prog_var::in, prog_varset::in, prog_varset::out,
- svar_map::in, svar_map::out) is det.
-
-next_colon_mapping(UpdatedStateVars, OldColon, N, StateVar, _,
- !VarSet, !ColonMap) :-
- ( UpdatedStateVars `contains` StateVar ->
- next_svar_mapping(N, StateVar, _Var, !VarSet, !ColonMap)
+lookup_dot_state_var(Context, StateVar, Var, !VarSet, !State, !Specs) :-
+ StatusMap0 = !.State ^ state_status_map,
+ ( map.search(StatusMap0, StateVar, Status) ->
+ (
+ Status = status_unknown,
+ report_uninitialized_state_var(Context, !.VarSet, StateVar,
+ !Specs),
+ % We make StateVar known to avoid duplicate reports.
+ new_state_var_instance(StateVar, name_middle, Var, !VarSet),
+ svmap.det_update(StateVar, status_known_updated(Var, Var),
+ StatusMap0, StatusMap),
+ !State ^ state_status_map := StatusMap
+ ;
+ Status = status_unknown_updated(NewVar),
+ report_uninitialized_state_var(Context, !.VarSet, StateVar,
+ !Specs),
+ % We make StateVar known to avoid duplicate reports.
+ new_state_var_instance(StateVar, name_middle, Var, !VarSet),
+ svmap.det_update(StateVar, status_known_updated(Var, NewVar),
+ StatusMap0, StatusMap),
+ !State ^ state_status_map := StatusMap
+ ;
+ ( Status = status_known(Var)
+ ; Status = status_known_ro(Var, _, _)
+ ; Status = status_known_updated(Var, _)
+ )
+ )
;
- map.lookup(OldColon, StateVar, Var),
- % XXX Should this be svmap.det_update?
- svmap.set(StateVar, Var, !ColonMap)
+ report_non_visible_state_var(".", Context, !.VarSet, StateVar,
+ !Specs),
+ Var = StateVar
).
-:- pred next_svar_mapping(int::in, svar::in, prog_var::out,
- prog_varset::in, prog_varset::out, svar_map::in, svar_map::out) is det.
-
-next_svar_mapping(N, StateVar, Var, !VarSet, !Map) :-
- Name = string.format("STATE_VARIABLE_%s_%d",
- [s(varset.lookup_name(!.VarSet, StateVar)), i(N)]),
- varset.new_named_var(!.VarSet, Name, Var, !:VarSet),
- map.set(!.Map, StateVar, Var, !:Map).
-
-%-----------------------------------------------------------------------------%
-
-expand_bang_state_var_args([]) = [].
-expand_bang_state_var_args([HeadArg0 | TailArgs0]) = Args :-
- TailArgs = expand_bang_state_var_args(TailArgs0),
+lookup_colon_state_var(Context, StateVar, Var, !VarSet, !State, !Specs) :-
+ StatusMap0 = !.State ^ state_status_map,
+ ( map.search(StatusMap0, StateVar, Status) ->
(
- HeadArg0 = variable(_, _),
- Args = [HeadArg0 | TailArgs]
+ Status = status_unknown,
+ new_state_var_instance(StateVar, name_middle, Var, !VarSet),
+ svmap.det_update(StateVar, status_unknown_updated(Var),
+ StatusMap0, StatusMap),
+ !State ^ state_status_map := StatusMap
+ ;
+ Status = status_known(OldVar),
+ new_state_var_instance(StateVar, name_middle, Var, !VarSet),
+ svmap.det_update(StateVar, status_known_updated(OldVar, Var),
+ StatusMap0, StatusMap),
+ !State ^ state_status_map := StatusMap
;
- HeadArg0 = functor(Const, FunctorArgs, Ctxt),
+ Status = status_known_ro(OldVar, RO_Construct, RO_Context),
(
- Const = atom("!"),
- FunctorArgs = [variable(_StateVar, _)]
- ->
- HeadArg1 = functor(atom("!."), FunctorArgs, Ctxt),
- HeadArg2 = functor(atom("!:"), FunctorArgs, Ctxt),
- Args = [HeadArg1, HeadArg2 | TailArgs]
+ RO_Construct = roc_lambda,
+ RO_ConstructName = "lambda expression"
+ ),
+ report_illegal_state_var_update(Context, RO_ConstructName,
+ RO_Context, !.VarSet, StateVar, !Specs),
+ % We remove the readonly notation to avoid duplicate reports.
+ new_state_var_instance(StateVar, name_middle, Var, !VarSet),
+ svmap.det_update(StateVar, status_known_updated(OldVar, Var),
+ StatusMap0, StatusMap),
+ !State ^ state_status_map := StatusMap
;
- Args = [HeadArg0 | TailArgs]
+ Status = status_known_updated(_OldVar, Var)
+ ;
+ Status = status_unknown_updated(Var)
)
+ ;
+ report_non_visible_state_var(":", Context, !.VarSet, StateVar, !Specs),
+ % We could make StateVar known to avoid duplicate reports.
+ % new_state_var_instance(StateVar, name_initial, Var, !VarSet),
+ % svmap.det_insert(StateVar, status_known_updated(Var, Var),
+ % StatusMap0, StatusMap),
+ % !State ^ state_status_map := StatusMap
+ Var = StateVar
).
-%-----------------------------------------------------------------------------%
+ % Look up the prog_var representing the current state of the state_var
+ % whose status is given as the second argument.
+ %
+:- func svar_get_current_progvar(loc_kind, svar_status) = prog_var.
-expand_bang_state_var_args_in_instance_method_heads(InstanceBody) = Expanded :-
+svar_get_current_progvar(LocKind, Status) = ProgVar :-
+ (
+ LocKind = loc_whole_goal,
(
- InstanceBody = instance_body_abstract,
- Expanded = instance_body_abstract
+ Status = status_known(ProgVar)
;
- InstanceBody = instance_body_concrete(Methods),
- Expanded = instance_body_concrete(
- list.map(expand_method_bsvs, Methods))
- ).
-
-:- func expand_method_bsvs(instance_method) = instance_method.
-
-expand_method_bsvs(IM) = IM :-
- IM = instance_method(_, _, instance_proc_def_name(_), _, _).
-
-expand_method_bsvs(IM0) = IM :-
- IM0 = instance_method(PredOrFunc, Method, instance_proc_def_clauses(Cs0),
- Arity0, Ctxt),
- Cs = list.map(expand_item_bsvs, Cs0),
- % Note that the condition should always succeed...
- ( Cs = [ItemClause | _] ->
- Args = ItemClause ^ cl_head_args,
- adjust_func_arity(PredOrFunc, Arity, list.length(Args))
+ ( Status = status_known_ro(_, _, _)
+ ; Status = status_known_updated(_, _)
+ ; Status = status_unknown
+ ; Status = status_unknown_updated(_)
+ ),
+ unexpected($module, $pred, "Status not known")
+ )
;
- Arity = Arity0
+ LocKind = loc_inside_atomic_goal,
+ (
+ Status = status_known(ProgVar)
+ ;
+ Status = status_known_updated(_, ProgVar)
+ ;
+ Status = status_unknown_updated(ProgVar)
+ ;
+ ( Status = status_known_ro(_, _, _)
+ ; Status = status_unknown
),
- IM = instance_method(PredOrFunc, Method, instance_proc_def_clauses(Cs),
- Arity, Ctxt).
-
-:- func expand_item_bsvs(item_clause_info) = item_clause_info.
-
-expand_item_bsvs(ItemClause0) = ItemClause :-
- ItemClause0 = item_clause_info(Origin, VarSet, PredOrFunc, SymName,
- Args0, Body, Context, SeqNum),
- Args = expand_bang_state_var_args(Args0),
- ItemClause = item_clause_info(Origin, VarSet, PredOrFunc, SymName,
- Args, Body, Context, SeqNum).
+ unexpected($module, $pred, "Status not known or updated")
+ )
+ ).
%-----------------------------------------------------------------------------%
+%
+% Code to handle the flattening of conjunctions. We need to be careful when we
+% do so, since the goal we flatten could have a goal id, which would mean that
+% the svar_store could have a delayed remapping for that goal_id. Just
+% flattening the goal would remove the goal_info containing the goal_id from
+% the HLDS, and the delayed renaming would not get done.
+%
+% We therefore make sure that when we flatten such a goal, we ensure that
+% its subgoals all have goal_ids (creating new ones if needed), and that
+% the delayed renaming that now won't get done on the conjunction as a whole
+% *will* get done on each conjunct.
+%
+
+svar_flatten_conj(Context, Goals, Goal, !Store) :-
+ list.map_foldl(svar_goal_to_conj_list, Goals, GoalConjuncts, !Store),
+ list.condense(GoalConjuncts, Conjuncts),
+ GoalExpr = conj(plain_conj, Conjuncts),
+ goal_info_init(Context, GoalInfo),
+ Goal = hlds_goal(GoalExpr, GoalInfo).
-substitute_state_var_mappings([], [], !VarSet, !SInfo, !Specs).
-substitute_state_var_mappings([Arg0 | Args0], [Arg | Args], !VarSet, !SInfo,
- !Specs) :-
- substitute_state_var_mapping(Arg0, Arg, !VarSet, !SInfo, !Specs),
- substitute_state_var_mappings(Args0, Args, !VarSet, !SInfo, !Specs).
+svar_goal_to_conj_list(Goal, Conjuncts, !Store) :-
+ % The code here is the same as in svar_goal_to_conj_list_internal,
+ % modulo the differences in the argument list.
+ Goal = hlds_goal(GoalExpr, GoalInfo),
+ ( GoalExpr = conj(plain_conj, Conjuncts0) ->
+ !.Store = svar_store(NextGoalId0, DelayedRenamingMap0, Warnings),
+ GoalId = goal_info_get_goal_id(GoalInfo),
+ ( map.search(DelayedRenamingMap0, GoalId, GoalDelayedRenaming) ->
+ list.map_foldl2(
+ add_conjunct_delayed_renames(GoalDelayedRenaming),
+ Conjuncts0, Conjuncts, NextGoalId0, NextGoalId,
+ DelayedRenamingMap0, DelayedRenamingMap),
+ !:Store = svar_store(NextGoalId, DelayedRenamingMap, Warnings)
+ ;
+ Conjuncts = Conjuncts0
+ )
+ ;
+ Conjuncts = [Goal]
+ ).
-substitute_state_var_mapping(Arg0, Arg, !VarSet, !SInfo, !Specs) :-
- ( Arg0 = functor(atom("!."), [variable(StateVar, _)], Context) ->
- svar_dot(Context, StateVar, Var, !VarSet, !SInfo, !Specs),
- Arg = variable(Var, context_init)
- ; Arg0 = functor(atom("!:"), [variable(StateVar, _)], Context) ->
- svar_colon(Context, StateVar, Var, !VarSet, !SInfo, !Specs),
- Arg = variable(Var, context_init)
+:- pred svar_goal_to_conj_list_internal(hlds_goal::in, list(hlds_goal)::out,
+ counter::in, counter::out,
+ map(goal_id, assoc_list(prog_var, prog_var))::in,
+ map(goal_id, assoc_list(prog_var, prog_var))::out) is det.
+
+svar_goal_to_conj_list_internal(Goal, Conjuncts,
+ !NextGoalId, !DelayedRenamingMap) :-
+ % The code here is the same as in svar_goal_to_conj_list,
+ % modulo the differences in the argument list.
+ Goal = hlds_goal(GoalExpr, GoalInfo),
+ ( GoalExpr = conj(plain_conj, Conjuncts0) ->
+ GoalId = goal_info_get_goal_id(GoalInfo),
+ ( map.search(!.DelayedRenamingMap, GoalId, GoalDelayedRenaming) ->
+ list.map_foldl2(
+ add_conjunct_delayed_renames(GoalDelayedRenaming),
+ Conjuncts0, Conjuncts, !NextGoalId, !DelayedRenamingMap)
;
- Arg = Arg0
+ Conjuncts = Conjuncts0
+ )
+ ;
+ Conjuncts = [Goal]
+ ).
+
+:- pred add_conjunct_delayed_renames(assoc_list(prog_var, prog_var)::in,
+ hlds_goal::in, hlds_goal::out, counter::in, counter::out,
+ map(goal_id, assoc_list(prog_var, prog_var))::in,
+ map(goal_id, assoc_list(prog_var, prog_var))::out) is det.
+
+add_conjunct_delayed_renames(DelayedRenamingToAdd, Goal0, Goal,
+ !NextGoalId, !DelayedRenamingMap) :-
+ Goal0 = hlds_goal(GoalExpr, GoalInfo0),
+ GoalId0 = goal_info_get_goal_id(GoalInfo0),
+ ( map.search(!.DelayedRenamingMap, GoalId0, DelayedRenaming0) ->
+ % The goal id must be valid.
+ DelayedRenaming = DelayedRenamingToAdd ++ DelayedRenaming0,
+ svmap.det_update(GoalId0, DelayedRenaming, !DelayedRenamingMap),
+ Goal = Goal0
+ ;
+ % The goal id must be invalid, since the only thing that attaches goal
+ % ids to goals at this stage of the compilation process is this module,
+ % and it attaches goal_ids to goals only if it also puts them the
+ % delayed renaming map.
+ counter.allocate(GoalIdNum, !NextGoalId),
+ GoalId = goal_id(GoalIdNum),
+ goal_info_set_goal_id(GoalId, GoalInfo0, GoalInfo),
+ svmap.det_insert(GoalId, DelayedRenamingToAdd, !DelayedRenamingMap),
+ Goal = hlds_goal(GoalExpr, GoalInfo)
).
%-----------------------------------------------------------------------------%
+%
+% Test for various kinds of errors.
+%
illegal_state_var_func_result(pf_function, Args, StateVar) :-
list.last(Args, functor(atom("!"), [variable(StateVar, _)], _Ctxt)).
-%-----------------------------------------------------------------------------%
-
lambda_args_contain_bang_state_var([Arg | Args], StateVar) :-
( Arg = functor(atom("!"), [variable(StateVar0, _)], _) ->
StateVar = StateVar0
@@ -1238,12 +1905,47 @@
).
%-----------------------------------------------------------------------------%
+%
+% Report various kinds of errors.
+%
+
+report_illegal_state_var_update(Context, RO_Construct, RO_Context, VarSet,
+ StateVar, !Specs) :-
+ Name = varset.lookup_name(VarSet, StateVar),
+ Pieces1 = [words("Error: cannot use"), fixed("!:" ++ Name),
+ words("here due to the surrounding"), words(RO_Construct), suffix(";"),
+ words("you may only refer to"), fixed("!." ++ Name), suffix("."), nl],
+ Msg1 = simple_msg(Context, [always(Pieces1)]),
+ Pieces2 = [words("Here is the surrounding context that makes"),
+ words("state variable"), fixed(Name), words("readonly."), nl],
+ Msg2 = simple_msg(RO_Context, [always(Pieces2)]),
+ Spec = error_spec(severity_error, phase_parse_tree_to_hlds, [Msg1, Msg2]),
+ !:Specs = [Spec | !.Specs].
+
+:- func ro_construct_name(readonly_context_kind) = string.
+
+ro_construct_name(roc_lambda) = "lambda expression".
+
+%-----------------------------------------------------------------------------%
+
+report_illegal_func_svar_result(Context, VarSet, StateVar, !Specs) :-
+ Name = varset.lookup_name(VarSet, StateVar),
+ Pieces = [words("Error:"), fixed("!" ++ Name),
+ words("cannot be a function result."), nl,
+ words("You probably meant"), fixed("!." ++ Name),
+ words("or"), fixed("!:" ++ Name), suffix("."), nl],
+ Msg = simple_msg(Context, [always(Pieces)]),
+ Spec = error_spec(severity_error, phase_parse_tree_to_hlds, [Msg]),
+ !:Specs = [Spec | !.Specs].
+
+%-----------------------------------------------------------------------------%
-report_illegal_state_var_update(Context, VarSet, StateVar, !Specs) :-
+report_illegal_bang_svar_lambda_arg(Context, VarSet, StateVar, !Specs) :-
Name = varset.lookup_name(VarSet, StateVar),
- Pieces = [words("Error: cannot use"), fixed("!:" ++ Name),
- words("in this context;"), nl,
- words("however"), fixed("!." ++ Name), words("may be used here."), nl],
+ Pieces = [words("Error:"), fixed("!" ++ Name),
+ words("cannot be a lambda argument."), nl,
+ words("Perhaps you meant"), fixed("!." ++ Name),
+ words("or"), fixed("!:" ++ Name), suffix("."), nl],
Msg = simple_msg(Context, [always(Pieces)]),
Spec = error_spec(severity_error, phase_parse_tree_to_hlds, [Msg]),
!:Specs = [Spec | !.Specs].
@@ -1277,26 +1979,59 @@
%-----------------------------------------------------------------------------%
-report_illegal_func_svar_result(Context, VarSet, StateVar, !Specs) :-
+:- pred report_repeated_head_state_var(prog_context::in, prog_varset::in,
+ svar::in, list(error_spec)::in, list(error_spec)::out) is det.
+
+report_repeated_head_state_var(Context, VarSet, StateVar, !Specs) :-
Name = varset.lookup_name(VarSet, StateVar),
- Pieces = [words("Error:"), fixed("!" ++ Name),
- words("cannot be a function result."), nl,
- words("You probably meant"), fixed("!." ++ Name),
- words("or"), fixed("!:" ++ Name), suffix("."), nl],
+ Pieces = [words("Warning: clause head introduces"),
+ words("state variable"), fixed(Name), words("more than once."), nl],
Msg = simple_msg(Context, [always(Pieces)]),
Spec = error_spec(severity_error, phase_parse_tree_to_hlds, [Msg]),
!:Specs = [Spec | !.Specs].
%-----------------------------------------------------------------------------%
-report_illegal_bang_svar_lambda_arg(Context, VarSet, StateVar, !Specs) :-
+:- pred report_state_var_shadow(prog_context::in, prog_varset::in,
+ svar::in, list(error_spec)::in, list(error_spec)::out) is det.
+
+report_state_var_shadow(Context, VarSet, StateVar, !Specs) :-
Name = varset.lookup_name(VarSet, StateVar),
- Pieces = [words("Error:"), fixed("!" ++ Name),
- words("cannot be a lambda argument."), nl,
- words("Perhaps you meant"), fixed("!." ++ Name),
- words("or"), fixed("!:" ++ Name), suffix("."), nl],
+ Pieces = [words("Warning: new state variable"), fixed(Name),
+ words("shadows old one."), nl],
+ Msg = simple_msg(Context, [option_is_set(warn_state_var_shadowing, yes,
+ [always(Pieces)])]),
+ Severity = severity_conditional(warn_state_var_shadowing, yes,
+ severity_warning, no),
+ Spec = error_spec(Severity, phase_parse_tree_to_hlds, [Msg]),
+ !:Specs = [Spec | !.Specs].
+
+%-----------------------------------------------------------------------------%
+
+:- pred report_missing_inits_in_ite(prog_context::in, list(string)::in,
+ string::in, string::in, list(error_spec)::in, list(error_spec)::out)
+ is det.
+
+report_missing_inits_in_ite(Context, NextStateVars,
+ WhenMissing, WhenNotMissing, !Specs) :-
+ Pieces = [words("When the condition"), words(WhenNotMissing), suffix(","),
+ words("the if-then-else defines")] ++
+ list_to_pieces(NextStateVars) ++ [suffix(","),
+ words("but when the condition"), words(WhenMissing), suffix(","),
+ words("it does not."), nl],
Msg = simple_msg(Context, [always(Pieces)]),
- Spec = error_spec(severity_error, phase_parse_tree_to_hlds, [Msg]),
+ Spec = error_spec(severity_informational, phase_parse_tree_to_hlds, [Msg]),
+ !:Specs = [Spec | !.Specs].
+
+:- pred report_missing_inits_in_disjunct(prog_context::in, list(string)::in,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+report_missing_inits_in_disjunct(Context, NextStateVars, !Specs) :-
+ Pieces = [words("Other disjuncts define")] ++
+ list_to_pieces(NextStateVars) ++ [suffix(","),
+ words("but not this one."), nl],
+ Msg = simple_msg(Context, [always(Pieces)]),
+ Spec = error_spec(severity_informational, phase_parse_tree_to_hlds, [Msg]),
!:Specs = [Spec | !.Specs].
%-----------------------------------------------------------------------------%
Index: compiler/structure_reuse.analysis.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/structure_reuse.analysis.m,v
retrieving revision 1.27
diff -u -b -r1.27 structure_reuse.analysis.m
--- compiler/structure_reuse.analysis.m 20 Dec 2010 07:47:38 -0000 1.27
+++ compiler/structure_reuse.analysis.m 19 Feb 2011 06:45:23 -0000
@@ -175,18 +175,18 @@
% Pre-annotate each of the goals with "Local Forward Use" and
% "Local Backward Use" information, and fill in all the goal_id slots
% as well.
- trace [io(!IO)] (
+ trace [io(!TIO)] (
maybe_write_string(VeryVerbose,
- "% Annotating in use information...", !IO)
+ "% Annotating in use information...", !TIO)
),
process_all_nonimported_procs(update_proc(annotate_in_use_information),
!ModuleInfo),
- trace [io(!IO)] (
- maybe_write_string(VeryVerbose, "done.\n", !IO),
+ trace [io(!TIO)] (
+ maybe_write_string(VeryVerbose, "done.\n", !TIO),
maybe_write_string(VeryVerbose,
- "% Reuse table before intermediate reuse:\n", !IO),
+ "% Reuse table before intermediate reuse:\n", !TIO),
reuse_as_table_maybe_dump(VeryVerbose, !.ModuleInfo, !.ReuseTable,
- !IO)
+ !TIO)
),
@@ -197,30 +197,30 @@
_NewPPIds, !ReuseTable, !ModuleInfo),
% Determine information about possible direct reuses.
- trace [io(!IO)] (
+ trace [io(!TIO)] (
maybe_write_string(VeryVerbose,
- "% Reuse table after intermediate reuse:\n", !IO),
+ "% Reuse table after intermediate reuse:\n", !TIO),
reuse_as_table_maybe_dump(VeryVerbose, !.ModuleInfo, !.ReuseTable,
- !IO),
- maybe_write_string(VeryVerbose, "% Direct reuse...\n", !IO)
+ !TIO),
+ maybe_write_string(VeryVerbose, "% Direct reuse...\n", !TIO)
),
direct_reuse_pass(SharingTable, !ModuleInfo, !ReuseTable),
- trace [io(!IO)] (
- maybe_write_string(VeryVerbose, "% Direct reuse: done.\n", !IO),
+ trace [io(!TIO)] (
+ maybe_write_string(VeryVerbose, "% Direct reuse: done.\n", !TIO),
reuse_as_table_maybe_dump(VeryVerbose, !.ModuleInfo, !.ReuseTable,
- !IO)
+ !TIO)
),
% Determine information about possible indirect reuses.
- trace [io(!IO)] (
- maybe_write_string(VeryVerbose, "% Indirect reuse...\n", !IO)
+ trace [io(!TIO)] (
+ maybe_write_string(VeryVerbose, "% Indirect reuse...\n", !TIO)
),
indirect_reuse_pass(SharingTable, !ModuleInfo, !ReuseTable, DepProcs0,
InternalRequests, IntermodRequests0),
- trace [io(!IO)] (
- maybe_write_string(VeryVerbose, "% Indirect reuse: done.\n", !IO),
+ trace [io(!TIO)] (
+ maybe_write_string(VeryVerbose, "% Indirect reuse: done.\n", !TIO),
reuse_as_table_maybe_dump(VeryVerbose, !.ModuleInfo, !.ReuseTable,
- !IO)
+ !TIO)
),
% Handle requests for "intermediate" reuse versions of procedures
Index: compiler/superhomogeneous.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/superhomogeneous.m,v
retrieving revision 1.41
diff -u -b -r1.41 superhomogeneous.m
--- compiler/superhomogeneous.m 31 Jan 2011 19:30:35 -0000 1.41
+++ compiler/superhomogeneous.m 27 Feb 2011 11:48:04 -0000
@@ -60,16 +60,18 @@
%
:- pred insert_arg_unifications(list(prog_var)::in, list(prog_term)::in,
prog_context::in, arg_context::in, hlds_goal::in, hlds_goal::out,
- num_added_goals::out, prog_varset::in, prog_varset::out,
+ num_added_goals::out,
+ svar_state::in, svar_state::out, svar_store::in, svar_store::out,
+ prog_varset::in, prog_varset::out,
module_info::in, module_info::out, qual_info::in, qual_info::out,
- svar_info::in, svar_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
:- pred insert_arg_unifications_with_supplied_contexts(list(prog_var)::in,
list(prog_term)::in, assoc_list(int, arg_context)::in, prog_context::in,
hlds_goal::in, hlds_goal::out, num_added_goals::out,
+ svar_state::in, svar_state::out, svar_store::in, svar_store::out,
prog_varset::in, prog_varset::out, module_info::in, module_info::out,
- qual_info::in, qual_info::out, svar_info::in, svar_info::out,
+ qual_info::in, qual_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
% append_arg_unifications is the same as insert_arg_unifications,
@@ -78,34 +80,36 @@
%
:- pred append_arg_unifications(list(prog_var)::in, list(prog_term)::in,
prog_context::in, arg_context::in, hlds_goal::in, hlds_goal::out,
- num_added_goals::out, prog_varset::in, prog_varset::out,
+ num_added_goals::out,
+ svar_state::in, svar_state::out, svar_store::in, svar_store::out,
+ prog_varset::in, prog_varset::out,
module_info::in, module_info::out, qual_info::in, qual_info::out,
- svar_info::in, svar_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
:- pred unravel_unification(prog_term::in, prog_term::in, prog_context::in,
unify_main_context::in, unify_sub_contexts::in, purity::in,
- hlds_goal::out, num_added_goals::out, prog_varset::in, prog_varset::out,
+ hlds_goal::out, num_added_goals::out,
+ svar_state::in, svar_state::out, svar_store::in, svar_store::out,
+ prog_varset::in, prog_varset::out,
module_info::in, module_info::out, qual_info::in, qual_info::out,
- svar_info::in, svar_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
- % make_fresh_arg_vars(Args, VarSet0, Vars, VarSet, !SInfo, !Specs):
+ % make_fresh_arg_vars(Args, Vars, !VarSet, !SVarState, !Specs):
%
% Vars is a list of distinct variables corresponding to the terms in Args.
% For each term in Args, if the term is a variable V which is distinct
% from the variables already produced, then the corresponding variable
- % in Vars is just V, otherwise a fresh variable is allocated from VarSet0.
- % VarSet is the varset resulting after all the necessary variables
- % have been allocated. !SInfo and !Specs are required to handle
+ % in Vars is just V, otherwise a fresh variable is allocated from !VarSet.
+ % !:VarSet is the varset resulting after all the necessary variables
+ % have been allocated. !SVarState and !Specs are required to handle
% state variables.
%
:- pred make_fresh_arg_vars(list(prog_term)::in, list(prog_var)::out,
- prog_varset::in, prog_varset::out, svar_info::in, svar_info::out,
+ prog_varset::in, prog_varset::out, svar_state::in, svar_state::out,
list(error_spec)::in, list(error_spec)::out) is det.
:- pred make_fresh_arg_var(prog_term::in, prog_var::out, list(prog_var)::in,
- prog_varset::in, prog_varset::out, svar_info::in, svar_info::out,
+ prog_varset::in, prog_varset::out, svar_state::in, svar_state::out,
list(error_spec)::in, list(error_spec)::out) is det.
%-----------------------------------------------------------------------------%
@@ -115,8 +119,11 @@
:- import_module check_hlds.mode_util.
:- import_module hlds.goal_util.
+:- import_module hlds.hlds_out.
+:- import_module hlds.hlds_out.hlds_out_goal.
:- import_module hlds.make_hlds.add_clause.
:- import_module hlds.make_hlds.field_access.
+:- import_module hlds.make_hlds.goal_expr_to_goal.
:- import_module hlds.make_hlds.qual_info.
:- import_module libs.globals. % for get_maybe_from_ground_term_threshold
:- import_module parse_tree.module_qual.
@@ -128,145 +135,156 @@
:- import_module bool.
:- import_module int.
+:- import_module io.
:- import_module map.
:- import_module pair.
:- import_module require.
:- import_module set.
-:- import_module svvarset.
:- import_module svset.
+:- import_module svvarset.
:- import_module term.
:- import_module varset.
%-----------------------------------------------------------------------------%
insert_arg_unifications(HeadVars, Args0, Context, ArgContext, !Goal, NumAdded,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs) :-
+ !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs) :-
do_insert_arg_unifications(HeadVars, Args0, Context, ArgContext, !Goal,
get_maybe_from_ground_term_threshold, NumAdded,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs).
+ !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs).
insert_arg_unifications_with_supplied_contexts(ArgVars, ArgTerms0,
- ArgContexts, Context, !Goal, NumAdded, !VarSet, !ModuleInfo, !QualInfo,
- !SInfo, !Specs) :-
+ ArgContexts, Context, !Goal, NumAdded, !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs) :-
do_insert_arg_unifications_with_supplied_contexts(ArgVars, ArgTerms0,
ArgContexts, Context, !Goal,
get_maybe_from_ground_term_threshold, NumAdded,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs).
+ !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs).
-append_arg_unifications(HeadVars, Args0, Context, ArgContext,
- !Goal, NumAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs) :-
+append_arg_unifications(HeadVars, Args0, Context, ArgContext, !Goal, NumAdded,
+ !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs) :-
do_append_arg_unifications(HeadVars, Args0, Context, ArgContext, !Goal,
get_maybe_from_ground_term_threshold, NumAdded,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs).
+ !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs).
unravel_unification(LHS0, RHS0, Context, MainContext, SubContext, Purity,
- Goal, NumAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs) :-
+ Goal, NumAdded, !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs) :-
do_unravel_unification(LHS0, RHS0, Context, MainContext, SubContext,
Purity, Goal, get_maybe_from_ground_term_threshold, NumAdded,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs).
+ !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs).
%-----------------------------------------------------------------------------%
:- pred do_insert_arg_unifications(list(prog_var)::in, list(prog_term)::in,
prog_context::in, arg_context::in,
hlds_goal::in, hlds_goal::out, maybe(int)::in, num_added_goals::out,
+ svar_state::in, svar_state::out, svar_store::in, svar_store::out,
prog_varset::in, prog_varset::out, module_info::in, module_info::out,
- qual_info::in, qual_info::out, svar_info::in, svar_info::out,
+ qual_info::in, qual_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
do_insert_arg_unifications(HeadVars, Args0, Context, ArgContext,
- !Goal, MaybeThreshold, NumAdded, !VarSet, !ModuleInfo, !QualInfo,
- !SInfo, !Specs) :-
+ !Goal, MaybeThreshold, NumAdded, !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs) :-
(
HeadVars = [],
NumAdded = 0
;
HeadVars = [_ | _],
!.Goal = hlds_goal(_, GoalInfo0),
- goal_to_conj_list(!.Goal, Goals0),
- substitute_state_var_mappings(Args0, Args, !VarSet, !SInfo, !Specs),
- do_insert_arg_unifications_2(HeadVars, Args, Context, ArgContext,
- 0, Goals0, Goals, MaybeThreshold, 0, NumAdded, !VarSet, !ModuleInfo,
- !QualInfo, !SInfo, !Specs),
+ svar_goal_to_conj_list(!.Goal, Goals0, !SVarStore),
+ substitute_state_var_mappings(Args0, Args, !VarSet, !SVarState,
+ !Specs),
+ do_insert_arg_unifications_loop(HeadVars, Args, Context, ArgContext,
+ 1, Goals0, Goals, MaybeThreshold, 0, NumAdded,
+ !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs),
goal_info_set_context(Context, GoalInfo0, GoalInfo),
conj_list_to_goal(Goals, GoalInfo, !:Goal)
).
-:- pred do_insert_arg_unifications_2(list(prog_var)::in, list(prog_term)::in,
- prog_context::in, arg_context::in, int::in,
+:- pred do_insert_arg_unifications_loop(list(prog_var)::in,
+ list(prog_term)::in, prog_context::in, arg_context::in, int::in,
list(hlds_goal)::in, list(hlds_goal)::out,
maybe(int)::in, num_added_goals::in, num_added_goals::out,
+ svar_state::in, svar_state::out, svar_store::in, svar_store::out,
prog_varset::in, prog_varset::out, module_info::in, module_info::out,
- qual_info::in, qual_info::out, svar_info::in, svar_info::out,
+ qual_info::in, qual_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
-do_insert_arg_unifications_2([], [_ | _], _, _, _, _, _, _, !NumAdded, !VarSet,
- !ModuleInfo, !QualInfo, !SInfo, !Specs) :-
+do_insert_arg_unifications_loop([], [_ | _], _, _, _, _, _, _,
+ !NumAdded, !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs) :-
unexpected($module, $pred, "length mismatch").
-do_insert_arg_unifications_2([_ | _], [], _, _, _, _, _, _, !NumAdded, !VarSet,
- !ModuleInfo, !QualInfo, !SInfo, !Specs) :-
+do_insert_arg_unifications_loop([_ | _], [], _, _, _, _, _, _,
+ !NumAdded, !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs) :-
unexpected($module, $pred, "length mismatch").
-do_insert_arg_unifications_2([], [], _, _, _, !Goals, _, !NumAdded, !VarSet,
- !ModuleInfo, !QualInfo, !SInfo, !Specs).
-do_insert_arg_unifications_2([Var | Vars], [Arg | Args], Context, ArgContext,
- N0, !Goals, MaybeThreshold, !NumAdded, !VarSet, !ModuleInfo, !QualInfo,
- !SInfo, !Specs) :-
- N1 = N0 + 1,
- do_insert_arg_unification(Var, Arg, Context, ArgContext, N1, ArgUnifyConj,
- MaybeThreshold, ArgAdded, !VarSet, !ModuleInfo, !QualInfo,
- !SInfo, !Specs),
+do_insert_arg_unifications_loop([], [], _, _, _, !Goals, _,
+ !NumAdded, !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs).
+do_insert_arg_unifications_loop([Var | Vars], [Arg | Args],
+ Context, ArgContext, ArgNum, !Goals, MaybeThreshold,
+ !NumAdded, !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs) :-
+ do_arg_unification(Var, Arg, Context, ArgContext, ArgNum, ArgUnifyConj,
+ MaybeThreshold, ArgAdded, !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs),
!:NumAdded = !.NumAdded + ArgAdded,
(
ArgUnifyConj = [],
% Allow the recursive call to be tail recursive.
- do_insert_arg_unifications_2(Vars, Args, Context, ArgContext, N1,
- !Goals, MaybeThreshold, !NumAdded, !VarSet, !ModuleInfo,
- !QualInfo, !SInfo, !Specs)
+ do_insert_arg_unifications_loop(Vars, Args, Context, ArgContext,
+ ArgNum + 1, !Goals, MaybeThreshold, !NumAdded,
+ !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs)
;
ArgUnifyConj = [_ | _],
- do_insert_arg_unifications_2(Vars, Args, Context, ArgContext, N1,
- !Goals, MaybeThreshold, !NumAdded, !VarSet, !ModuleInfo,
- !QualInfo, !SInfo, !Specs),
- list.append(ArgUnifyConj, !.Goals, !:Goals)
+ do_insert_arg_unifications_loop(Vars, Args, Context, ArgContext,
+ ArgNum + 1, !Goals, MaybeThreshold, !NumAdded,
+ !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs),
+ !:Goals = ArgUnifyConj ++ !.Goals
).
:- pred do_insert_arg_unifications_with_supplied_contexts(list(prog_var)::in,
list(prog_term)::in, assoc_list(int, arg_context)::in, prog_context::in,
hlds_goal::in, hlds_goal::out, maybe(int)::in, num_added_goals::out,
+ svar_state::in, svar_state::out, svar_store::in, svar_store::out,
prog_varset::in, prog_varset::out, module_info::in, module_info::out,
- qual_info::in, qual_info::out, svar_info::in, svar_info::out,
+ qual_info::in, qual_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
do_insert_arg_unifications_with_supplied_contexts(ArgVars, ArgTerms0,
ArgContexts, Context, !Goal, MaybeThreshold, NumAdded,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs) :-
+ !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs) :-
(
ArgVars = [],
NumAdded = 0
;
ArgVars = [_ | _],
!.Goal = hlds_goal(_, GoalInfo0),
- goal_to_conj_list(!.Goal, GoalList0),
- substitute_state_var_mappings(ArgTerms0, ArgTerms, !VarSet, !SInfo,
- !Specs),
- do_insert_arg_unifications_with_supplied_contexts_2(ArgVars, ArgTerms,
- ArgContexts, Context, GoalList0, GoalList, MaybeThreshold,
- 0, NumAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
+ svar_goal_to_conj_list(!.Goal, Goals0, !SVarStore),
+ substitute_state_var_mappings(ArgTerms0, ArgTerms, !VarSet,
+ !SVarState, !Specs),
+ do_insert_arg_unifications_with_supplied_contexts_loop(ArgVars,
+ ArgTerms, ArgContexts, Context, Goals0, Goals,
+ MaybeThreshold, 0, NumAdded, !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs),
goal_info_set_context(Context, GoalInfo0, GoalInfo),
- conj_list_to_goal(GoalList, GoalInfo, !:Goal)
+ conj_list_to_goal(Goals, GoalInfo, !:Goal)
).
-:- pred do_insert_arg_unifications_with_supplied_contexts_2(list(prog_var)::in,
- list(prog_term)::in, assoc_list(int, arg_context)::in, prog_context::in,
- list(hlds_goal)::in, list(hlds_goal)::out,
+:- pred do_insert_arg_unifications_with_supplied_contexts_loop(
+ list(prog_var)::in, list(prog_term)::in, assoc_list(int, arg_context)::in,
+ prog_context::in, list(hlds_goal)::in, list(hlds_goal)::out,
maybe(int)::in, num_added_goals::in, num_added_goals::out,
+ svar_state::in, svar_state::out, svar_store::in, svar_store::out,
prog_varset::in, prog_varset::out, module_info::in, module_info::out,
- qual_info::in, qual_info::out, svar_info::in, svar_info::out,
+ qual_info::in, qual_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
-do_insert_arg_unifications_with_supplied_contexts_2(Vars, Terms, ArgContexts,
- Context, !Goals, MaybeThreshold, !NumAdded, !VarSet, !ModuleInfo,
- !QualInfo, !SInfo, !Specs) :-
+do_insert_arg_unifications_with_supplied_contexts_loop(Vars, Terms,
+ ArgContexts, Context, !Goals, MaybeThreshold, !NumAdded,
+ !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs) :-
(
Vars = [],
Terms = [],
@@ -278,117 +296,97 @@
Terms = [Term | TermsTail],
ArgContexts = [ArgNumber - ArgContext | ArgContextsTail]
->
- do_insert_arg_unification(Var, Term, Context, ArgContext, ArgNumber,
- UnifyConj, MaybeThreshold, ArgAdded, !VarSet, !ModuleInfo,
- !QualInfo, !SInfo, !Specs),
+ do_arg_unification(Var, Term, Context, ArgContext, ArgNumber,
+ ArgUnifyConj, MaybeThreshold, ArgAdded, !SVarState, !SVarStore,
+ !VarSet, !ModuleInfo, !QualInfo, !Specs),
!:NumAdded = !.NumAdded + ArgAdded,
- do_insert_arg_unifications_with_supplied_contexts_2(VarsTail,
+ do_insert_arg_unifications_with_supplied_contexts_loop(VarsTail,
TermsTail, ArgContextsTail, Context, !Goals, MaybeThreshold,
- !NumAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
- list.append(UnifyConj, !.Goals, !:Goals)
+ !NumAdded, !SVarState, !SVarStore,
+ !VarSet, !ModuleInfo, !QualInfo, !Specs),
+ !:Goals = ArgUnifyConj ++ !.Goals
;
unexpected($module, $pred, "length mismatch")
).
-:- pred do_insert_arg_unification(prog_var::in, prog_term::in, prog_context::in,
- arg_context::in, int::in, list(hlds_goal)::out, maybe(int)::in,
- num_added_goals::out, prog_varset::in, prog_varset::out,
- module_info::in, module_info::out, qual_info::in, qual_info::out,
- svar_info::in, svar_info::out,
- list(error_spec)::in, list(error_spec)::out) is det.
-
-do_insert_arg_unification(Var, Arg, Context, ArgContext, N1, ArgUnifyConj,
- MaybeThreshold, NumAdded, !VarSet, !ModuleInfo, !QualInfo,
- !SInfo, !Specs) :-
- ( Arg = term.variable(Var, _) ->
- % Skip unifications of the form `X = X'.
- ArgUnifyConj = [],
- NumAdded = 0
- ;
- arg_context_to_unify_context(ArgContext, N1, UnifyMainContext,
- UnifySubContext),
- do_unravel_unification(term.variable(Var, Context), Arg, Context,
- UnifyMainContext, UnifySubContext, purity_pure, Goal,
- MaybeThreshold, NumAdded, !VarSet, !ModuleInfo, !QualInfo,
- !SInfo, !Specs),
- goal_to_conj_list(Goal, ArgUnifyConj)
- ).
-
:- pred do_append_arg_unifications(list(prog_var)::in, list(prog_term)::in,
prog_context::in, arg_context::in,
hlds_goal::in, hlds_goal::out, maybe(int)::in, num_added_goals::out,
+ svar_state::in, svar_state::out, svar_store::in, svar_store::out,
prog_varset::in, prog_varset::out, module_info::in, module_info::out,
- qual_info::in, qual_info::out, svar_info::in, svar_info::out,
+ qual_info::in, qual_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
do_append_arg_unifications(HeadVars, Args0, Context, ArgContext, !Goal,
- MaybeThreshold, NumAdded, !VarSet, !ModuleInfo, !QualInfo,
- !SInfo, !Specs) :-
+ MaybeThreshold, NumAdded, !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs) :-
(
HeadVars = [],
NumAdded = 0
;
HeadVars = [_ | _],
!.Goal = hlds_goal(_, GoalInfo),
- goal_to_conj_list(!.Goal, GoalList0),
- substitute_state_var_mappings(Args0, Args, !VarSet, !SInfo, !Specs),
- do_append_arg_unifications_2(HeadVars, Args, Context, ArgContext,
- 0, GoalList0, GoalList, MaybeThreshold, 0, NumAdded,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
- conj_list_to_goal(GoalList, GoalInfo, !:Goal)
+ svar_goal_to_conj_list(!.Goal, Goals0, !SVarStore),
+ substitute_state_var_mappings(Args0, Args, !VarSet, !SVarState,
+ !Specs),
+ do_append_arg_unifications_loop(HeadVars, Args, Context, ArgContext,
+ 1, Goals0, Goals, MaybeThreshold, 0, NumAdded,
+ !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs),
+ conj_list_to_goal(Goals, GoalInfo, !:Goal)
).
-:- pred do_append_arg_unifications_2(list(prog_var)::in, list(prog_term)::in,
+:- pred do_append_arg_unifications_loop(list(prog_var)::in, list(prog_term)::in,
prog_context::in, arg_context::in, int::in,
list(hlds_goal)::in, list(hlds_goal)::out,
maybe(int)::in, num_added_goals::in, num_added_goals::out,
+ svar_state::in, svar_state::out, svar_store::in, svar_store::out,
prog_varset::in, prog_varset::out, module_info::in, module_info::out,
- qual_info::in, qual_info::out, svar_info::in, svar_info::out,
+ qual_info::in, qual_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
-do_append_arg_unifications_2([], [_ | _], _, _, _, _, _, _, !NumAdded,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs) :-
+do_append_arg_unifications_loop([], [_ | _], _, _, _, _, _, _, !NumAdded,
+ !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs) :-
unexpected($module, $pred, "length mismatch").
-do_append_arg_unifications_2([_ | _], [], _, _, _, _, _, _, !NumAdded,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs) :-
+do_append_arg_unifications_loop([_ | _], [], _, _, _, _, _, _, !NumAdded,
+ !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs) :-
unexpected($module, $pred, "length mismatch").
-do_append_arg_unifications_2([], [], _, _, _, !GoalList, _, !NumAdded,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs).
-do_append_arg_unifications_2([Var | Vars], [Arg | Args], Context, ArgContext,
- N0, !GoalList, MaybeThreshold, !NumAdded, !VarSet, !ModuleInfo,
- !QualInfo, !SInfo, !Specs) :-
- N1 = N0 + 1,
- do_append_arg_unification(Var, Arg, Context, ArgContext, N1, ConjList,
- MaybeThreshold, ArgAdded, !VarSet, !ModuleInfo, !QualInfo,
- !SInfo, !Specs),
+do_append_arg_unifications_loop([], [], _, _, _, !GoalList, _, !NumAdded,
+ !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs).
+do_append_arg_unifications_loop([Var | Vars], [Arg | Args],
+ Context, ArgContext, ArgNum, !GoalList, MaybeThreshold, !NumAdded,
+ !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs) :-
+ do_arg_unification(Var, Arg, Context, ArgContext, ArgNum, ArgUnifyConj,
+ MaybeThreshold, ArgAdded, !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs),
!:NumAdded = !.NumAdded + ArgAdded,
- list.append(!.GoalList, ConjList, !:GoalList),
- do_append_arg_unifications_2(Vars, Args, Context, ArgContext, N1,
- !GoalList, MaybeThreshold, !NumAdded, !VarSet, !ModuleInfo,
- !QualInfo, !SInfo, !Specs).
+ !:GoalList = !.GoalList ++ ArgUnifyConj,
+ do_append_arg_unifications_loop(Vars, Args, Context, ArgContext,
+ ArgNum + 1, !GoalList, MaybeThreshold, !NumAdded,
+ !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs).
-:- pred do_append_arg_unification(prog_var::in, prog_term::in,
+:- pred do_arg_unification(prog_var::in, prog_term::in,
prog_context::in, arg_context::in, int::in, list(hlds_goal)::out,
maybe(int)::in, num_added_goals::out,
+ svar_state::in, svar_state::out, svar_store::in, svar_store::out,
prog_varset::in, prog_varset::out, module_info::in, module_info::out,
- qual_info::in, qual_info::out, svar_info::in, svar_info::out,
+ qual_info::in, qual_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
-do_append_arg_unification(Var, Arg, Context, ArgContext, N1, ConjList,
- MaybeThreshold, NumAdded, !VarSet, !ModuleInfo, !QualInfo,
- !SInfo, !Specs) :-
+do_arg_unification(Var, Arg, Context, ArgContext, ArgNum, ArgUnifyConj,
+ MaybeThreshold, NumAdded, !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs) :-
( Arg = term.variable(Var, _) ->
% Skip unifications of the form `X = X'.
- ConjList = [],
+ ArgUnifyConj = [],
NumAdded = 0
;
- arg_context_to_unify_context(ArgContext, N1, UnifyMainContext,
+ arg_context_to_unify_context(ArgContext, ArgNum, UnifyMainContext,
UnifySubContext),
do_unravel_unification(term.variable(Var, Context), Arg, Context,
UnifyMainContext, UnifySubContext, purity_pure, Goal,
- MaybeThreshold, NumAdded, !VarSet, !ModuleInfo, !QualInfo,
- !SInfo, !Specs),
- goal_to_conj_list(Goal, ConjList)
+ MaybeThreshold, NumAdded, !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs),
+ svar_goal_to_conj_list(Goal, ArgUnifyConj, !SVarStore)
).
%-----------------------------------------------------------------------------%
@@ -396,18 +394,19 @@
:- pred do_unravel_unification(prog_term::in, prog_term::in, prog_context::in,
unify_main_context::in, unify_sub_contexts::in, purity::in,
hlds_goal::out, maybe(int)::in, num_added_goals::out,
+ svar_state::in, svar_state::out, svar_store::in, svar_store::out,
prog_varset::in, prog_varset::out, module_info::in, module_info::out,
- qual_info::in, qual_info::out, svar_info::in, svar_info::out,
+ qual_info::in, qual_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
do_unravel_unification(LHS0, RHS0, Context, MainContext, SubContext, Purity,
- Goal, MaybeThreshold, NumAdded, !VarSet, !ModuleInfo, !QualInfo,
- !SInfo, !Specs) :-
- substitute_state_var_mapping(LHS0, LHS, !VarSet, !SInfo, !Specs),
- substitute_state_var_mapping(RHS0, RHS, !VarSet, !SInfo, !Specs),
+ Goal, MaybeThreshold, NumAdded, !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs) :-
+ substitute_state_var_mapping(LHS0, LHS, !VarSet, !SVarState, !Specs),
+ substitute_state_var_mapping(RHS0, RHS, !VarSet, !SVarState, !Specs),
classify_unravel_unification(LHS, RHS, Context, MainContext, SubContext,
- Purity, Goal0, NumAdded, !VarSet, !ModuleInfo, !QualInfo,
- !SInfo, !Specs),
+ Purity, Goal0, NumAdded, !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs),
(
MaybeThreshold = yes(Threshold),
NumAdded > Threshold,
@@ -460,13 +459,14 @@
:- pred classify_unravel_unification(prog_term::in, prog_term::in,
prog_context::in, unify_main_context::in, unify_sub_contexts::in,
purity::in, hlds_goal::out, num_added_goals::out,
+ svar_state::in, svar_state::out, svar_store::in, svar_store::out,
prog_varset::in, prog_varset::out, module_info::in, module_info::out,
- qual_info::in, qual_info::out, svar_info::in, svar_info::out,
+ qual_info::in, qual_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
classify_unravel_unification(TermX, TermY, Context, MainContext, SubContext,
- Purity, Goal, NumAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo,
- !Specs) :-
+ Purity, Goal, NumAdded, !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs) :-
(
% `X = Y' needs no unravelling.
TermX = term.variable(X, _),
@@ -479,13 +479,13 @@
TermY = term.functor(F, Args, FunctorContext),
unravel_var_functor_unification(X, F, Args, FunctorContext,
Context, MainContext, SubContext, Purity, Goal, NumAdded,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs)
+ !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs)
;
TermX = term.functor(F, Args, FunctorContext),
TermY = term.variable(Y, _),
unravel_var_functor_unification(Y, F, Args, FunctorContext,
Context, MainContext, SubContext, Purity, Goal, NumAdded,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs)
+ !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs)
;
% If we find a unification of the form `f1(...) = f2(...)',
% then we replace it with `Tmp = f1(...), Tmp = f2(...)',
@@ -497,12 +497,12 @@
varset.new_var(!.VarSet, TmpVar, !:VarSet),
do_unravel_unification(term.variable(TmpVar, Context), TermX,
Context, MainContext, SubContext, Purity, GoalX, no, NumAddedX,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
+ !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs),
do_unravel_unification(term.variable(TmpVar, Context), TermY,
Context, MainContext, SubContext, Purity, GoalY, no, NumAddedY,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
- goal_to_conj_list(GoalX, ConjListX),
- goal_to_conj_list(GoalY, ConjListY),
+ !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs),
+ svar_goal_to_conj_list(GoalX, ConjListX, !SVarStore),
+ svar_goal_to_conj_list(GoalY, ConjListY, !SVarStore),
ConjList = ConjListX ++ ConjListY,
goal_info_init(GoalInfo),
conj_list_to_goal(ConjList, GoalInfo, Goal),
@@ -510,12 +510,12 @@
).
% Given an unification of the form
- % X = f(A1, A2, A3)
+ % X = f(ArgTerm1, ArgTerm2, ArgTerm3)
% we replace it with
% X = f(NewVar1, NewVar2, NewVar3),
- % NewVar1 = A1,
- % NewVar2 = A2,
- % NewVar3 = A3.
+ % NewVar1 = ArgTerm1,
+ % NewVar2 = ArgTerm2,
+ % NewVar3 = ArgTerm3.
% In the trivial case `X = c', no unravelling occurs.
%
% XXX We could do better on the error messages for lambda expressions
@@ -525,20 +525,21 @@
list(prog_term)::in, term.context::in,
prog_context::in, unify_main_context::in, unify_sub_contexts::in,
purity::in, hlds_goal::out, num_added_goals::out,
+ svar_state::in, svar_state::out, svar_store::in, svar_store::out,
prog_varset::in, prog_varset::out, module_info::in, module_info::out,
- qual_info::in, qual_info::out, svar_info::in, svar_info::out,
+ qual_info::in, qual_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
unravel_var_functor_unification(X, F, Args1, FunctorContext,
Context, MainContext, SubContext, Purity, Goal, NumAdded,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs) :-
- substitute_state_var_mappings(Args1, Args, !VarSet, !SInfo, !Specs),
+ !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs) :-
+ substitute_state_var_mappings(Args1, Args, !VarSet, !SVarState, !Specs),
(
F = term.atom(Atom),
maybe_unravel_special_var_functor_unification(X, Atom, Args,
FunctorContext, Context, MainContext, SubContext, Purity,
- GoalPrime, NumAddedPrime,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs)
+ GoalPrime, NumAddedPrime, !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs)
->
Goal = GoalPrime,
NumAdded = NumAddedPrime
@@ -575,7 +576,8 @@
build_lambda_expression(X, Purity, LambdaPurity, Groundness,
PredOrFunc, EvalMethod, Vars1, Modes, Det, ParsedGoal,
Context, MainContext, SubContext, Goal, NumAdded,
- !VarSet, !ModuleInfo, !QualInfo, !.SInfo, !Specs)
+ !.SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs)
;
MaybeParsedGoal = error1(ParsedGoalSpecs),
!:Specs = ParsedGoalSpecs ++ !.Specs,
@@ -611,7 +613,7 @@
Goal = hlds_goal(GoalExpr, GoalInfo)
;
FunctorArgs = [_ | _],
- make_fresh_arg_vars(FunctorArgs, HeadVars, !VarSet, !SInfo,
+ make_fresh_arg_vars(FunctorArgs, HeadVars, !VarSet, !SVarState,
!Specs),
make_atomic_unification(X, rhs_functor(ConsId, no, HeadVars),
Context, MainContext, SubContext, Purity, Goal0, !QualInfo),
@@ -622,17 +624,23 @@
% with type-checking :-(
% But for impure unifications, we need to do this, because
% mode reordering can't reorder around the functor unification.
- ( Purity = purity_pure ->
+ (
+ Purity = purity_pure,
do_append_arg_unifications(HeadVars, FunctorArgs,
FunctorContext, ArgContext, Goal0, Goal, no, ArgAdded,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs)
+ !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs)
;
+ ( Purity = purity_semipure
+ ; Purity = purity_impure
+ ),
Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
goal_info_set_purity(Purity, GoalInfo0, GoalInfo1),
Goal1 = hlds_goal(GoalExpr0, GoalInfo1),
do_insert_arg_unifications(HeadVars, FunctorArgs,
FunctorContext, ArgContext, Goal1, Goal, no, ArgAdded,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs)
+ !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs)
),
NumAdded = MainFunctorAdded + ArgAdded
)
@@ -644,13 +652,15 @@
string::in, list(prog_term)::in, term.context::in,
prog_context::in, unify_main_context::in, unify_sub_contexts::in,
purity::in, hlds_goal::out, num_added_goals::out,
+ svar_state::in, svar_state::out, svar_store::in, svar_store::out,
prog_varset::in, prog_varset::out, module_info::in, module_info::out,
- qual_info::in, qual_info::out, svar_info::in, svar_info::out,
+ qual_info::in, qual_info::out,
list(error_spec)::in, list(error_spec)::out) is semidet.
maybe_unravel_special_var_functor_unification(X, Atom, Args,
- FunctorContext, Context, MainContext, SubContext, Purity,
- Goal, NumAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs) :-
+ FunctorContext, Context, MainContext, SubContext, Purity, Goal,
+ NumAdded, !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs) :-
% Switch on Atom.
% XXX instead of failing if Atom has the wrong number of arguments or
% if the arguments have the wrong shape, we should generate an error
@@ -684,7 +694,8 @@
),
do_unravel_unification(term.variable(X, Context), RVal,
Context, MainContext, SubContext, Purity, Goal, no,
- NumAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs)
+ NumAdded, !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs)
)
;
% Handle unification expressions.
@@ -694,14 +705,16 @@
require_det (
do_unravel_unification(term.variable(X, Context), LVal, Context,
MainContext, SubContext, Purity, GoalL, no, NumAddedL,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
+ !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs),
do_unravel_unification(term.variable(X, Context), RVal, Context,
MainContext, SubContext, Purity, GoalR, no, NumAddedR,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
+ !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs),
NumAdded = NumAddedL + NumAddedR,
goal_info_init(GoalInfo),
- goal_to_conj_list(GoalL, ConjListL),
- goal_to_conj_list(GoalR, ConjListR),
+ svar_goal_to_conj_list(GoalL, ConjListL, !SVarStore),
+ svar_goal_to_conj_list(GoalR, ConjListR, !SVarStore),
ConjList = ConjListL ++ ConjListR,
conj_list_to_goal(ConjList, GoalInfo, Goal)
)
@@ -726,29 +739,35 @@
!VarSet),
(
MaybeVarsCond = ok3(Vars, StateVars, CondParseTree),
- BeforeSInfo = !.SInfo,
- svar_prepare_for_if_then_else_expr(StateVars, !VarSet, !SInfo),
-
+ BeforeSVarState = !.SVarState,
+ svar_prepare_for_local_state_vars(Context, !.VarSet, StateVars,
+ BeforeSVarState, BeforeInsideSVarState, !Specs),
map.init(EmptySubst),
- transform_goal_expr_context_to_goal(CondParseTree, EmptySubst,
- CondGoal, CondAdded, !VarSet, !ModuleInfo,
- !QualInfo, !SInfo, !Specs),
-
- svar_finish_if_then_else_expr_condition(BeforeSInfo,
- !SInfo),
+ transform_goal_expr_context_to_goal(loc_inside_atomic_goal,
+ CondParseTree, EmptySubst, CondGoal, CondAdded,
+ BeforeInsideSVarState, AfterCondInsideSVarState,
+ !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs),
do_unravel_unification(term.variable(X, Context), ThenTerm,
- Context, MainContext, SubContext, Purity, ThenGoal, no,
- ThenAdded, !VarSet, !ModuleInfo,
- !QualInfo, !SInfo, !Specs),
+ Context, MainContext, SubContext, Purity, ThenGoal0, no,
+ ThenAdded,
+ AfterCondInsideSVarState, AfterThenInsideSVarState,
+ !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs),
- svar_finish_if_then_else_expr_then_goal(StateVars,
- BeforeSInfo, !SInfo),
+ svar_finish_local_state_vars(StateVars, BeforeSVarState,
+ AfterThenInsideSVarState, AfterThenSVarState),
do_unravel_unification(term.variable(X, Context), ElseTerm,
- Context, MainContext, SubContext, Purity, ElseGoal, no,
- ElseAdded, !VarSet, !ModuleInfo,
- !QualInfo, !SInfo, !Specs),
+ Context, MainContext, SubContext, Purity, ElseGoal0, no,
+ ElseAdded, BeforeSVarState, AfterElseSVarState,
+ !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs),
+
+ svar_finish_if_then_else(loc_inside_atomic_goal, Context,
+ StateVars, ThenGoal0, ThenGoal, ElseGoal0, ElseGoal,
+ BeforeSVarState, AfterCondInsideSVarState,
+ AfterThenSVarState, AfterElseSVarState, AfterITESVarState,
+ !VarSet, !SVarStore, !Specs),
+ !:SVarState = AfterITESVarState,
NumAdded = CondAdded + ThenAdded + ElseAdded,
GoalExpr = if_then_else(StateVars ++ Vars,
@@ -770,16 +789,17 @@
require_det (
make_fresh_arg_var(InputTerm, InputTermVar, [],
- !VarSet, !SInfo, !Specs),
+ !VarSet, !SVarState, !Specs),
expand_get_field_function_call(Context, MainContext, SubContext,
FieldNames, X, InputTermVar, Purity, Functor, _,
- Goal0, CallAdded, !VarSet, !ModuleInfo,
- !QualInfo, !SInfo, !Specs),
+ Goal0, CallAdded, !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs),
ArgContext = ac_functor(Functor, MainContext, SubContext),
do_insert_arg_unifications([InputTermVar], [InputTerm],
FunctorContext, ArgContext, Goal0, Goal, no, ArgAdded,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
+ !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs),
NumAdded = CallAdded + ArgAdded
)
;
@@ -792,14 +812,15 @@
require_det (
make_fresh_arg_var(InputTerm, InputTermVar, [],
- !VarSet, !SInfo, !Specs),
+ !VarSet, !SVarState, !Specs),
make_fresh_arg_var(FieldValueTerm, FieldValueVar,
- [InputTermVar], !VarSet, !SInfo, !Specs),
+ [InputTermVar], !VarSet, !SVarState, !Specs),
- expand_set_field_function_call(Context, MainContext,
- SubContext, FieldNames, FieldValueVar, InputTermVar, X,
+ expand_set_field_function_call(Context, MainContext, SubContext,
+ FieldNames, FieldValueVar, InputTermVar, X,
Functor, InnerFunctor - FieldSubContext, Goal0, CallAdded,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
+ !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs),
TermArgContext = ac_functor(Functor, MainContext, SubContext),
TermArgNumber = 1,
@@ -810,8 +831,9 @@
FieldArgNumber - FieldArgContext],
do_insert_arg_unifications_with_supplied_contexts(
[InputTermVar, FieldValueVar], [InputTerm, FieldValueTerm],
- ArgContexts, Context, Goal0, Goal, no, ArgAdded, !VarSet,
- !ModuleInfo, !QualInfo, !SInfo, !Specs),
+ ArgContexts, Context, Goal0, Goal, no, ArgAdded,
+ !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs),
NumAdded = CallAdded + ArgAdded
)
;
@@ -840,8 +862,8 @@
build_lambda_expression(X, Purity, DCGLambdaPurity,
Groundness, pf_predicate, EvalMethod, Vars1, Modes, Det,
ParsedGoal, Context, MainContext, SubContext,
- Goal0, NumAdded, !VarSet, !ModuleInfo,
- !QualInfo, !.SInfo, !Specs),
+ Goal0, NumAdded, !.SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs),
Goal0 = hlds_goal(GoalExpr, GoalInfo0),
goal_info_set_purity(Purity, GoalInfo0, GoalInfo),
Goal = hlds_goal(GoalExpr, GoalInfo)
@@ -881,14 +903,17 @@
ho_groundness::in, pred_or_func::in, lambda_eval_method::in,
list(prog_term)::in, list(mer_mode)::in, determinism::in, goal::in,
prog_context::in, unify_main_context::in, unify_sub_contexts::in,
- hlds_goal::out, num_added_goals::out, prog_varset::in, prog_varset::out,
+ hlds_goal::out, num_added_goals::out,
+ svar_state::in, svar_store::in, svar_store::out,
+ prog_varset::in, prog_varset::out,
module_info::in, module_info::out, qual_info::in, qual_info::out,
- svar_info::in, list(error_spec)::in, list(error_spec)::out) is det.
+ list(error_spec)::in, list(error_spec)::out) is det.
build_lambda_expression(X, UnificationPurity, LambdaPurity, Groundness,
PredOrFunc, EvalMethod, Args0, Modes, Det, ParsedGoal,
Context, MainContext, SubContext, Goal, NumAdded,
- !VarSet, !ModuleInfo, !QualInfo, !.SInfo, !Specs) :-
+ OutsideSVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs) :-
% In the parse tree, the lambda arguments can be any terms, but in the HLDS
% they must be distinct variables. So we introduce fresh variables
% for the lambda arguments, and add appropriate unifications.
@@ -927,12 +952,6 @@
% be careful because variables in arguments should similarly be quantified,
% but variables in the function return value term (and not in the
% arguments) should *not* be locally quantified.
- %
- % Create fresh variables, transform the goal to HLDS, and add unifications
- % with the fresh variables. We use varset.new_vars rather than
- % make_fresh_arg_vars, since for functions we need to ensure that
- % the variable corresponding to the function result term is a new variable,
- % to avoid the function result term becoming lambda-quantified.
( illegal_state_var_func_result(PredOrFunc, Args0, StateVar) ->
report_illegal_func_svar_result(Context, !.VarSet, StateVar, !Specs),
@@ -944,13 +963,22 @@
Goal = true_goal,
NumAdded = 0
;
- svar_prepare_for_lambda(!SInfo),
- substitute_state_var_mappings(Args0, Args, !VarSet, !SInfo, !Specs),
+ some [!SVarState] (
+ svar_prepare_for_lambda_head(Context, Args0, Args, FinalSVarMap,
+ OutsideSVarState, !:SVarState, !VarSet, !Specs),
+ InitialSVarState = !.SVarState,
+
+ % Create fresh variables, transform the goal to HLDS, and
+ % add unifications with the fresh variables. We use varset.new_vars
+ % rather than make_fresh_arg_vars, since for functions we need
+ % to ensure that the variable corresponding to the function result
+ % term is a new variable, to avoid the function result term
+ % becoming lambda-quantified.
list.length(Args, NumArgs),
svvarset.new_vars(NumArgs, LambdaVars, !VarSet),
- % Partition the arguments (and their corresponding lambda variables)
+ % Partition the arguments (and their corresponding lambda vars)
% into two sets: those that are not output, i.e. input and unused,
% and those that are output.
(
@@ -970,29 +998,62 @@
ArgContext = ac_head(PredOrFunc, NumArgs),
% Create the unifications that need to come before the body of the
- % lambda expression; those corresponding to args whose mode is input
- % or unused.
+ % lambda expression; those corresponding to args whose mode is
+ % input or unused.
HeadBefore0 = true_goal,
insert_arg_unifications(NonOutputLambdaVars, NonOutputArgs,
Context, ArgContext, HeadBefore0, HeadBefore, NonOutputAdded,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
+ !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs),
+
+ transform_goal_expr_context_to_goal(loc_whole_goal, ParsedGoal,
+ Substitution, Body, BodyAdded, !SVarState, !SVarStore,
+ !VarSet, !ModuleInfo, !QualInfo, !Specs),
% Create the unifications that need to come after the body of the
- % lambda expression; those corresponding to args whose mode is output.
+ % lambda expression; those corresponding to args whose mode is
+ % output.
HeadAfter0 = true_goal,
insert_arg_unifications(OutputLambdaVars, OutputArgs,
Context, ArgContext, HeadAfter0, HeadAfter, OutputAdded,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
+ !SVarState, !SVarStore, !VarSet,
+ !ModuleInfo, !QualInfo, !Specs),
- svar_prepare_for_body(FinalSVarMap, !VarSet, !SInfo),
+ NumAdded = NonOutputAdded + BodyAdded + OutputAdded,
- transform_goal_expr_context_to_goal(ParsedGoal, Substitution, Body,
- BodyAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
- NumAdded = NonOutputAdded + OutputAdded + BodyAdded,
+ trace [compiletime(flag("debug-statevar-lambda")), io(!IO)] (
+ io.write_string("\nLAMBDA EXPRESSION\n", !IO),
+ io.write_string("args before:\n", !IO),
+ io.write_list(Args0, "\n", io.write, !IO),
+ io.nl(!IO),
+ io.write_string("args after:\n", !IO),
+ io.write_list(Args, "\n", io.write, !IO),
+ io.nl(!IO),
+ io.write_string("lambda arg vars:\n", !IO),
+ io.write(LambdaVars, !IO),
+ io.nl(!IO),
+ io.write_string("lambda arg unifies before:\n", !IO),
+ dump_goal(!.ModuleInfo, !.VarSet, HeadBefore, !IO),
+ io.nl(!IO),
+ io.write_string("lambda body:\n", !IO),
+ dump_goal(!.ModuleInfo, !.VarSet, Body, !IO),
+ io.nl(!IO),
+ io.write_string("lambda arg unifies after:\n", !IO),
+ dump_goal(!.ModuleInfo, !.VarSet, HeadAfter, !IO),
+ io.nl(!IO),
+ some [FinalSVarList] (
+ map.to_assoc_list(FinalSVarMap, FinalSVarList),
+ io.write_string("FinalSVarMap:\n", !IO),
+ io.write(FinalSVarList, !IO),
+ io.nl(!IO)
+ )
+ ),
% Fix up any state variable unifications.
- svar_finish_goals(Context, FinalSVarMap, [HeadBefore, Body, HeadAfter],
- HLDS_Goal0, !.SInfo),
+ FinalSVarState = !.SVarState,
+ svar_finish_lambda_body(Context, FinalSVarMap,
+ [HeadBefore, Body, HeadAfter], HLDS_Goal0,
+ InitialSVarState, FinalSVarState, !SVarStore),
% Figure out which variables we need to explicitly existentially
% quantify.
@@ -1007,14 +1068,12 @@
list.sort_and_remove_dups(QuantifiedVars0, QuantifiedVars),
goal_info_init(Context, GoalInfo),
- HLDS_Goal = hlds_goal(
- scope(exist_quant(QuantifiedVars), HLDS_Goal0),
- GoalInfo),
-
- % We set the lambda nonlocals here to anything that could possibly be
- % nonlocal. Quantification will reduce this down to the proper set
- % of nonlocal arguments.
+ HLDS_GoalExpr = scope(exist_quant(QuantifiedVars), HLDS_Goal0),
+ HLDS_Goal = hlds_goal(HLDS_GoalExpr, GoalInfo),
+ % We set the lambda nonlocals here to anything that could
+ % possibly be nonlocal. Quantification will reduce this down
+ % to the proper set of nonlocal arguments.
some [!LambdaGoalVars] (
goal_util.goal_vars(HLDS_Goal, !:LambdaGoalVars),
svset.delete_list(LambdaVars, !LambdaGoalVars),
@@ -1026,6 +1085,7 @@
EvalMethod, LambdaNonLocals, LambdaVars, Modes, Det, HLDS_Goal),
make_atomic_unification(X, LambdaRHS, Context, MainContext,
SubContext, UnificationPurity, Goal, !QualInfo)
+ )
).
% Partition the lists of arguments and variables into lists
@@ -1046,7 +1106,7 @@
% Calling mode_is_output/2 directly will cause the compiler to abort
% if the mode is undefined, so we first check for this. If the mode
% is undefined, it doesn't really matter which partitions we place
- % the arguements/lambda vars into because mode analysis will fail
+ % the arguments/lambda vars into because mode analysis will fail
% anyway.
( mode_is_undefined(ModuleInfo, Mode) ->
@@ -1106,24 +1166,26 @@
%-----------------------------------------------------------------------------%
-make_fresh_arg_vars(Args, Vars, !VarSet, !SInfo, !Specs) :-
+make_fresh_arg_vars(Args, Vars, !VarSet, !SVarState, !Specs) :-
% For efficiency, we construct `Vars' backwards and then reverse it
% to get the correct order.
- make_fresh_arg_vars_2(Args, [], Vars1, !VarSet, !SInfo, !Specs),
+ make_fresh_arg_vars_loop(Args, [], Vars1, !VarSet, !SVarState, !Specs),
list.reverse(Vars1, Vars).
-:- pred make_fresh_arg_vars_2(list(prog_term)::in, list(prog_var)::in,
+:- pred make_fresh_arg_vars_loop(list(prog_term)::in, list(prog_var)::in,
list(prog_var)::out, prog_varset::in,prog_varset::out,
- svar_info::in, svar_info::out,
+ svar_state::in, svar_state::out,
list(error_spec)::in, list(error_spec)::out) is det.
-make_fresh_arg_vars_2([], Vars, Vars, !VarSet, !SInfo, !Specs).
-make_fresh_arg_vars_2([Arg | Args], Vars0, Vars, !VarSet, !SInfo, !Specs) :-
- make_fresh_arg_var(Arg, Var, Vars0, !VarSet, !SInfo, !Specs),
- make_fresh_arg_vars_2(Args, [Var | Vars0], Vars, !VarSet, !SInfo, !Specs).
+make_fresh_arg_vars_loop([], !RevVars, !VarSet, !SVarState, !Specs).
+make_fresh_arg_vars_loop([Arg | Args], !RevVars, !VarSet, !SVarState,
+ !Specs) :-
+ make_fresh_arg_var(Arg, Var, !.RevVars, !VarSet, !SVarState, !Specs),
+ !:RevVars =[Var | !.RevVars],
+ make_fresh_arg_vars_loop(Args, !RevVars, !VarSet, !SVarState, !Specs).
-make_fresh_arg_var(Arg0, Var, Vars0, !VarSet, !SInfo, !Specs) :-
- substitute_state_var_mapping(Arg0, Arg, !VarSet, !SInfo, !Specs),
+make_fresh_arg_var(Arg0, Var, Vars0, !VarSet, !SVarState, !Specs) :-
+ substitute_state_var_mapping(Arg0, Arg, !VarSet, !SVarState, !Specs),
(
Arg = term.variable(ArgVar, _),
\+ list.member(ArgVar, Vars0)
Index: compiler/table_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/table_gen.m,v
retrieving revision 1.157
diff -u -b -r1.157 table_gen.m
--- compiler/table_gen.m 2 Jan 2011 14:37:59 -0000 1.157
+++ compiler/table_gen.m 26 Feb 2011 05:07:15 -0000
@@ -174,7 +174,7 @@
pred_id_to_int(PredId, PredIdInt),
Msg = string.format("I/O procedure pred id %d not model_det",
[i(PredIdInt)]),
- unexpected(this_file, Msg)
+ unexpected($module, $pred, Msg)
),
globals.lookup_bool_option(Globals, trace_table_io_all, TransformAll),
globals.lookup_bool_option(Globals, trace_table_io_require, Require),
@@ -268,7 +268,7 @@
TabledForIoAttrs = [_, _ | _],
% Since table_gen is run before inlining, each procedure
% should contain at most one foreign_proc goal.
- unexpected(this_file, "should_io_procedure_be_transformed: " ++
+ unexpected($module, $pred,
"different tabled_for_io attributes in one procedure")
).
@@ -391,11 +391,11 @@
(
EvalMethod = eval_normal,
% This should have been caught by our caller.
- unexpected(this_file, "table_gen_transform_proc: eval_normal")
+ unexpected($module, $pred, "eval_normal")
;
EvalMethod = eval_table_io(_, _),
- expect(unify(MaybeAttributes, no), this_file,
- "table_gen_transform_proc: eval_table_io and Attributes"),
+ expect(unify(MaybeAttributes, no), $pred,
+ "eval_table_io and Attributes"),
% Since we don't actually create a call table for I/O tabled
% procedures, the value of MaybeSpecMethod doesn't really matter.
MaybeSpecMethod = all_same(arg_value),
@@ -425,9 +425,9 @@
EvalMethod = eval_memo
;
EvalMethod = eval_minimal(_),
- expect(unify(MaybeSizeLimit, no), this_file,
+ expect(unify(MaybeSizeLimit, no), $pred,
"eval_minimal with size limit"),
- expect(unify(MaybeSpecMethod, all_same(arg_value)), this_file,
+ expect(unify(MaybeSpecMethod, all_same(arg_value)), $pred,
"eval_minimal without all_strict")
)
),
@@ -490,7 +490,7 @@
MaybeProcTableStructInfo = yes(ProcTableStructInfo)
;
EvalMethod = eval_minimal(MinimalMethod),
- expect(unify(CodeModel, model_non), this_file,
+ expect(unify(CodeModel, model_non), $pred,
"table_gen_transform_proc: minimal model but not model_non"),
(
MinimalMethod = stack_copy,
@@ -518,8 +518,7 @@
% The own_stacks_generator minimal_method is only ever introduced
% by the transformation in this module; a procedure that hasn't
% been transformed yet should not have this eval_method.
- unexpected(this_file,
- "table_gen_transform_proc: own stacks generator")
+ unexpected($module, $pred, "own stacks generator")
),
MaybeProcTableIOInfo = no
),
@@ -926,7 +925,7 @@
SetupMacroName = "MR_tbl_memo_semi_setup"
;
CodeModel = model_non,
- unexpected(this_file, "create_new_memo_goal: model_non")
+ unexpected($module, $pred, "model_non")
),
generate_simple_call_table_lookup_goal(StatusType,
SetupPredName, SetupMacroName, NumberedInputVars,
@@ -1316,8 +1315,7 @@
;
% The call to proc_info_has_io_state_pair in
% table_gen_process_procs should ensure that we never get here.
- unexpected(this_file,
- "create_new_io_goal: one in / one out violation")
+ unexpected($module, $pred, "one in / one out violation")
),
table_generate_call("table_io_copy_io_state", detism_det,
[IoStateAssignFromVar, IoStateAssignToVar], purity_pure,
@@ -1687,7 +1685,7 @@
; Detism = detism_non ->
ConsumePredName = "table_mmos_consume_next_answer_nondet"
;
- unexpected(this_file, "do_own_stack_transform: invalid determinism")
+ unexpected($module, $pred, "invalid determinism")
),
% XXX consider inlining the predicate being called
table_generate_call(ConsumePredName, Detism, [ConsumerVar, AnswerBlockVar],
@@ -1737,7 +1735,7 @@
MaybeArgNameMode = yes(InputVarName - _InMode)
;
MaybeArgNameMode = no,
- unexpected(this_file, "generate_save_input_vars_code: no InputVarName")
+ unexpected($module, $pred, "no InputVarName")
),
mode_get_insts(ModuleInfo, Mode, InitInst, _FinalInst),
PickupMode = (free -> InitInst),
@@ -2400,8 +2398,7 @@
->
list.length(Ctors, EnumRange)
;
- unexpected(this_file,
- "gen_lookup_call_for_type: enum type is not du_type?")
+ unexpected($module, $pred, "enum type is not du_type?")
),
LookupMacroName = "MR_tbl_lookup_insert_enum",
Step = table_trie_step_enum(EnumRange),
@@ -2495,27 +2492,25 @@
cur_table_node_name ++ ";\n"
;
CtorCat = ctor_cat_void,
- unexpected(this_file, "gen_lookup_call_for_type: void")
+ unexpected($module, $pred, "void")
;
CtorCat = ctor_cat_system(cat_system_typeclass_info),
- unexpected(this_file,
- "gen_lookup_call_for_type: typeclass_info_type")
+ unexpected($module, $pred, "typeclass_info_type")
;
CtorCat = ctor_cat_system(cat_system_base_typeclass_info),
- unexpected(this_file,
- "gen_lookup_call_for_type: base_typeclass_info_type")
+ unexpected($module, $pred, "base_typeclass_info_type")
)
;
ArgTablingMethod = arg_addr,
(
CtorCat = ctor_cat_enum(_),
- unexpected(this_file, "tabling enums by addr")
+ unexpected($module, $pred, "tabling enums by addr")
;
CtorCat = ctor_cat_builtin(cat_builtin_int),
- unexpected(this_file, "tabling ints by addr")
+ unexpected($module, $pred, "tabling ints by addr")
;
CtorCat = ctor_cat_builtin(cat_builtin_char),
- unexpected(this_file, "tabling chars by addr")
+ unexpected($module, $pred, "tabling chars by addr")
;
( CtorCat = ctor_cat_builtin(cat_builtin_string)
; CtorCat = ctor_cat_builtin(cat_builtin_float)
@@ -2533,14 +2528,14 @@
PrefixGoals, LookupCodeStr)
;
CtorCat = ctor_cat_builtin_dummy,
- unexpected(this_file, "tabling dummies by addr")
+ unexpected($module, $pred, "tabling dummies by addr")
;
CtorCat = ctor_cat_void,
- unexpected(this_file, "gen_lookup_call_for_type: void")
+ unexpected($module, $pred, "void")
)
;
ArgTablingMethod = arg_promise_implied,
- unexpected(this_file, "gen_lookup_call_for_type: arg_promise_implied")
+ unexpected($module, $pred, "arg_promise_implied")
),
UpdateCurNodeCodeStr = "\t" ++ cur_table_node_name ++ " = " ++
next_table_node_name ++ ";\n",
@@ -2956,7 +2951,7 @@
; Detism = detism_non ->
ReturnAllAns = "table_memo_return_all_answers_nondet"
;
- unexpected(this_file, "generate_mm_restore_goal: invalid determinism")
+ unexpected($module, $pred, "invalid determinism")
),
generate_new_table_var("AnswerBlock", answer_block_type,
!VarSet, !VarTypes, AnswerBlockVar),
@@ -2999,7 +2994,7 @@
; Detism = detism_non ->
ReturnAllAns = "table_mm_return_all_nondet"
;
- unexpected(this_file, "generate_mm_restore_goal: invalid determinism")
+ unexpected($module, $pred, "invalid determinism")
),
generate_mm_restore_or_suspend_goal(ReturnAllAns, Detism, purity_semipure,
NumberedOutputVars, OrigInstMapDelta, SubgoalVar, Context,
@@ -3101,7 +3096,7 @@
( instmap_delta_search_var(OrigInstmapDelta, Var, InstPrime) ->
Inst = InstPrime
;
- unexpected(this_file, "gen_restore_call_for_type: no inst")
+ unexpected($module, $pred, "no inst")
),
Arg = foreign_arg(Var, yes(Name - (free -> Inst)), ArgType,
native_if_possible),
@@ -3266,9 +3261,9 @@
get_input_output_vars([], [], _, !MaybeSpecMethod, [], []).
get_input_output_vars([_ | _], [], _, !MaybeSpecMethod, _, _) :-
- unexpected(this_file, "get_input_output_vars: lists not same length").
+ unexpected($module, $pred, "lists not same length").
get_input_output_vars([], [_ | _], _, !MaybeSpecMethod, _, _) :-
- unexpected(this_file, "get_input_output_vars: lists not same length").
+ unexpected($module, $pred, "lists not same length").
get_input_output_vars([Var | Vars], [Mode | Modes], ModuleInfo,
!MaybeSpecMethod, InVarModes, OutVarModes) :-
( mode_is_fully_input(ModuleInfo, Mode) ->
@@ -3286,8 +3281,7 @@
LastMaybeArgMethod = yes(ArgMethod)
;
LastMaybeArgMethod = no,
- unexpected(this_file,
- "get_input_output_vars: bad method for input var")
+ unexpected($module, $pred, "bad method for input var")
),
!:MaybeSpecMethod = specified(MaybeArgMethods,
HiddenArgMethod)
@@ -3320,8 +3314,8 @@
list.split_last(MaybeArgMethods0, MaybeArgMethods,
LastMaybeArgMethod)
->
- expect(unify(LastMaybeArgMethod, no), this_file,
- "get_input_output_vars: bad method for output var"),
+ expect(unify(LastMaybeArgMethod, no), $pred,
+ "bad method for output var"),
!:MaybeSpecMethod = specified(MaybeArgMethods,
HiddenArgMethod)
;
@@ -3342,7 +3336,7 @@
;
% We should have caught this when we added the tabling pragma
% to the proc_info.
- unexpected(this_file, "get_input_output_vars: bad var")
+ unexpected($module, $pred, "bad var")
).
%-----------------------------------------------------------------------------%
@@ -3536,7 +3530,7 @@
Name = "enum"
;
CtorCat = ctor_cat_enum(cat_enum_foreign),
- sorry(this_file, "tabling and foreign enumerations NYI.")
+ sorry($module, $pred, "tabling and foreign enumerations NYI.")
;
CtorCat = ctor_cat_builtin(cat_builtin_int),
Name = "int"
@@ -3569,7 +3563,7 @@
; CtorCat = ctor_cat_builtin_dummy
; CtorCat = ctor_cat_void
),
- unexpected(this_file, "type_save_category: unexpected category")
+ unexpected($module, $pred, "unexpected category")
).
%-----------------------------------------------------------------------------%
@@ -3662,7 +3656,7 @@
( TypeInfoVars = [TypeInfoVar0] ->
TypeInfoVar = TypeInfoVar0
;
- unexpected(this_file, "table_gen_make_type_info_var: list length != 1")
+ unexpected($module, $pred, "list length != 1")
).
:- pred table_gen_make_type_info_vars(list(mer_type)::in, term.context::in,
@@ -3971,9 +3965,3 @@
TableInfo = table_info(ModuleInfo, PredInfo, ProcInfo).
%-----------------------------------------------------------------------------%
-
-:- func this_file = string.
-
-this_file = "table_gen.m".
-
-%-----------------------------------------------------------------------------%
Index: compiler/typecheck.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/typecheck.m,v
retrieving revision 1.453
diff -u -b -r1.453 typecheck.m
--- compiler/typecheck.m 13 Jan 2011 00:36:53 -0000 1.453
+++ compiler/typecheck.m 26 Feb 2011 03:46:11 -0000
@@ -436,16 +436,18 @@
pred_info::in, pred_info::out, list(error_spec)::out, bool::out) is det.
typecheck_pred(ModuleInfo, PredId, !PredInfo, Specs, Changed) :-
+ % Handle the --allow-stubs and --warn-stubs options.
+ % If --allow-stubs is set, and there are no clauses, then
+ % - issue a warning (if --warn-stubs is set), and then
+ % - generate a "stub" clause that just throws an exception.
+ % The real work is done by do_typecheck_pred.
+
module_info_get_globals(ModuleInfo, Globals),
- pred_info_get_arg_types(!.PredInfo, _ArgTypeVarSet, ExistQVars0,
+ pred_info_get_arg_types(!.PredInfo, _ArgTypeVarSet, _ExistQVars0,
ArgTypes0),
pred_info_get_clauses_info(!.PredInfo, ClausesInfo0),
clauses_info_get_clauses_rep(ClausesInfo0, ClausesRep0, ItemNumbers0),
pred_info_get_markers(!.PredInfo, Markers0),
- % Handle the --allow-stubs and --warn-stubs options.
- % If --allow-stubs is set, and there are no clauses, then
- % - issue a warning (if --warn-stubs is set), and then
- % - generate a "stub" clause that just throws an exception.
clause_list_is_empty(ClausesRep0) = ClausesRep0IsEmpty,
(
ClausesRep0IsEmpty = yes,
@@ -486,12 +488,11 @@
)
)
),
- some [!ClausesInfo, !Info, !HeadTypeParams] (
+
+ some [!ClausesInfo] (
pred_info_get_clauses_info(!.PredInfo, !:ClausesInfo),
- clauses_info_get_clauses_rep(!.ClausesInfo, ClausesRep1, ItemNumbers),
+ clauses_info_get_clauses_rep(!.ClausesInfo, ClausesRep1, _ItemNumbers),
clauses_info_get_headvar_list(!.ClausesInfo, HeadVars),
- clauses_info_get_varset(!.ClausesInfo, VarSet),
- clauses_info_get_explicit_vartypes(!.ClausesInfo, ExplicitVarTypes0),
clause_list_is_empty(ClausesRep1) = ClausesRep1IsEmpty,
(
ClausesRep1IsEmpty = yes,
@@ -520,14 +521,32 @@
)
;
ClausesRep1IsEmpty = no,
+ do_typecheck_pred(ModuleInfo, PredId, !PredInfo,
+ StartingSpecs, Specs, Changed)
+ )
+ ).
+
+:- pred do_typecheck_pred(module_info::in, pred_id::in,
+ pred_info::in, pred_info::out,
+ list(error_spec)::in, list(error_spec)::out, bool::out) is det.
+
+do_typecheck_pred(ModuleInfo, PredId, !PredInfo, !Specs, Changed) :-
+ some [!Info, !ClausesInfo, !HeadTypeParams] (
+ pred_info_get_clauses_info(!.PredInfo, !:ClausesInfo),
+ clauses_info_get_clauses_rep(!.ClausesInfo, ClausesRep0, ItemNumbers),
+ clauses_info_get_headvar_list(!.ClausesInfo, HeadVars),
+ clauses_info_get_varset(!.ClausesInfo, VarSet),
+ clauses_info_get_explicit_vartypes(!.ClausesInfo, ExplicitVarTypes0),
pred_info_get_import_status(!.PredInfo, Status),
pred_info_get_typevarset(!.PredInfo, TypeVarSet0),
+ pred_info_get_arg_types(!.PredInfo, _ArgTypeVarSet, ExistQVars0,
+ ArgTypes0),
+ pred_info_get_markers(!.PredInfo, Markers0),
( check_marker(Markers0, marker_infer_type) ->
- % For a predicate whose type is inferred, the predicate is
- % allowed to bind the type variables in the head of the
- % predicate's type declaration. Such predicates are given an
- % initial type declaration of `pred foo(T1, T2, ..., TN)'
- % by make_hlds.m.
+ % For a predicate whose type is inferred, the predicate is allowed
+ % to bind the type variables in the head of the predicate's type
+ % declaration. Such predicates are given an initial type
+ % declaration of `pred foo(T1, T2, ..., TN)' by make_hlds.m.
Inferring = yes,
trace [io(!IO)] (
write_pred_progress_message("% Inferring type of ",
@@ -547,8 +566,7 @@
UnivTVars),
list.append(UnivTVars, !HeadTypeParams),
list.sort_and_remove_dups(!HeadTypeParams),
- list.delete_elems(!.HeadTypeParams, ExistQVars0,
- !:HeadTypeParams)
+ list.delete_elems(!.HeadTypeParams, ExistQVars0, !:HeadTypeParams)
),
module_info_get_class_table(ModuleInfo, ClassTable),
@@ -562,19 +580,17 @@
pred_info_get_markers(!.PredInfo, PredMarkers0),
typecheck_info_init(ModuleInfo, PredId, IsFieldAccessFunction,
TypeVarSet0, VarSet, ExplicitVarTypes0, !.HeadTypeParams,
- Constraints, Status, PredMarkers0, StartingSpecs, !:Info),
- get_clause_list(ClausesRep1, Clauses1),
- typecheck_clause_list(HeadVars, ArgTypes0, Clauses1, Clauses,
- !Info),
+ Constraints, Status, PredMarkers0, !.Specs, !:Info),
+ get_clause_list(ClausesRep0, Clauses0),
+ typecheck_clause_list(HeadVars, ArgTypes0, Clauses0, Clauses, !Info),
% We need to perform a final pass of context reduction at the end,
% before checking the typeclass constraints.
perform_context_reduction(!Info),
typecheck_check_for_ambiguity(whole_pred, HeadVars, !Info),
- typecheck_info_get_final_info(!.Info, !.HeadTypeParams,
- ExistQVars0, ExplicitVarTypes0, TypeVarSet,
- !:HeadTypeParams, InferredVarTypes0,
- InferredTypeConstraints0, ConstraintProofs,
- ConstraintMap, TVarRenaming, ExistTypeRenaming),
+ typecheck_info_get_final_info(!.Info, !.HeadTypeParams, ExistQVars0,
+ ExplicitVarTypes0, TypeVarSet, !:HeadTypeParams, InferredVarTypes0,
+ InferredTypeConstraints0, ConstraintProofs, ConstraintMap,
+ TVarRenaming, ExistTypeRenaming),
typecheck_info_get_pred_markers(!.Info, PredMarkers),
map.optimize(InferredVarTypes0, InferredVarTypes),
clauses_info_set_vartypes(InferredVarTypes, !ClausesInfo),
@@ -593,29 +609,28 @@
clauses_info_set_explicit_vartypes(ExplicitVarTypes, !ClausesInfo),
set_clause_list(Clauses, ClausesRep),
- clauses_info_set_clauses_rep(ClausesRep, ItemNumbers,
- !ClausesInfo),
+ clauses_info_set_clauses_rep(ClausesRep, ItemNumbers, !ClausesInfo),
pred_info_set_clauses_info(!.ClausesInfo, !PredInfo),
pred_info_set_typevarset(TypeVarSet, !PredInfo),
pred_info_set_constraint_proofs(ConstraintProofs, !PredInfo),
pred_info_set_constraint_map(ConstraintMap, !PredInfo),
pred_info_set_markers(PredMarkers, !PredInfo),
- % Split the inferred type class constraints into those that
- % apply only to the head variables, and those that apply to
- % type variables which occur only in the body.
+ % Split the inferred type class constraints into those that apply
+ % only to the head variables, and those that apply to type variables
+ % which occur only in the body.
map.apply_to_list(HeadVars, InferredVarTypes, ArgTypes),
type_vars_list(ArgTypes, ArgTypeVars),
restrict_to_head_vars(InferredTypeConstraints0, ArgTypeVars,
InferredTypeConstraints, UnprovenBodyConstraints),
% If there are any as-yet-unproven constraints on type variables
- % in the body, then save these in the pred_info. If it turns out
- % that this pass was the last pass of type inference, the
- % post_typecheck.m will report an error. But we can't report
- % an error now, because a later pass of type inference could cause
- % some type variables to become bound to types that make the
- % constraints satisfiable, causing the error to go away.
+ % in the body, then save these in the pred_info. If it turns out that
+ % this pass was the last pass of type inference, the post_typecheck
+ % pass will report an error. But we can't report an error now, because
+ % a later pass of type inference could cause some type variables
+ % to become bound to types that make the constraints satisfiable,
+ % causing the error to go away.
pred_info_set_unproven_body_constraints(UnprovenBodyConstraints,
!PredInfo),
@@ -623,21 +638,19 @@
Inferring = yes,
% We need to infer which of the head variable types must be
% existentially quantified.
- infer_existential_types(ArgTypeVars, ExistQVars,
- !HeadTypeParams),
+ infer_existential_types(ArgTypeVars, ExistQVars, !HeadTypeParams),
% Now save the information we inferred in the pred_info
pred_info_set_head_type_params(!.HeadTypeParams, !PredInfo),
pred_info_set_arg_types(TypeVarSet, ExistQVars, ArgTypes,
!PredInfo),
pred_info_get_class_context(!.PredInfo, OldTypeConstraints),
- pred_info_set_class_context(InferredTypeConstraints,
- !PredInfo),
+ pred_info_set_class_context(InferredTypeConstraints, !PredInfo),
% Check if anything changed.
(
- % If the argument types and the type constraints are
- % identical up to renaming, then nothing has changed.
+ % If the argument types and the type constraints are identical
+ % up to renaming, then nothing has changed.
pred_info_get_tvar_kinds(!.PredInfo, TVarKinds),
argtypes_identical_up_to_renaming(TVarKinds, ExistQVars0,
ArgTypes0, OldTypeConstraints, ExistQVars, ArgTypes,
@@ -652,14 +665,14 @@
pred_info_set_head_type_params(!.HeadTypeParams, !PredInfo),
pred_info_get_origin(!.PredInfo, Origin0),
- % Leave the original argtypes etc., but apply any substititions
+ % Leave the original argtypes etc., but apply any substitutions
% that map existentially quantified type variables to other
- % type vars, and then rename them all to match the new
- % typevarset, so that the type variables names match up
- % (e.g. with the type variables in the constraint_proofs)
+ % type vars, and then rename them all to match the new typevarset,
+ % so that the type variables names match up (e.g. with the type
+ % variables in the constraint_proofs)
- % Apply any type substititions that map existentially
- % quantified type variables to other type vars.
+ % Apply any type substititions that map existentially quantified
+ % type variables to other type vars.
(
ExistQVars0 = [],
% Optimize common case.
@@ -690,26 +703,24 @@
RenamedOldArgTypes),
apply_variable_renaming_to_prog_constraints(TVarRenaming,
PredConstraints1, RenamedOldConstraints),
- rename_instance_method_constraints(TVarRenaming,
- Origin1, Origin),
+ rename_instance_method_constraints(TVarRenaming, Origin1, Origin),
% Save the results in the pred_info.
- pred_info_set_arg_types(TypeVarSet, ExistQVars,
- RenamedOldArgTypes, !PredInfo),
+ pred_info_set_arg_types(TypeVarSet, ExistQVars, RenamedOldArgTypes,
+ !PredInfo),
pred_info_set_class_context(RenamedOldConstraints, !PredInfo),
pred_info_set_origin(Origin, !PredInfo),
Changed = no
),
- typecheck_info_get_all_errors(!.Info, Specs)
- )
+ typecheck_info_get_all_errors(!.Info, !:Specs)
).
:- func report_any_non_contiguous_clauses(module_info, pred_id, pred_info,
clause_item_numbers, clause_item_number_types) = list(error_spec).
-report_any_non_contiguous_clauses(ModuleInfo, PredId, PredInfo,
- ItemNumbers, Type) = Specs :-
+report_any_non_contiguous_clauses(ModuleInfo, PredId, PredInfo, ItemNumbers,
+ Type) = Specs :-
(
clauses_are_non_contiguous(ItemNumbers, Type,
FirstRegion, SecondRegion, LaterRegions)
@@ -806,7 +817,7 @@
% Combine the unification and call into a conjunction.
goal_info_init(Context, GoalInfo),
Body = hlds_goal(conj(plain_conj, [UnifyGoal, CallGoal]), GoalInfo),
- StubClause = clause(all_modes, Body, impl_lang_mercury, Context).
+ StubClause = clause(all_modes, Body, impl_lang_mercury, Context, []).
:- pred rename_instance_method_constraints(tvar_renaming::in,
pred_origin::in, pred_origin::out) is det.
@@ -1021,7 +1032,7 @@
NonLocals = proc_arg_vector_to_set(HeadVars),
goal_info_set_nonlocals(NonLocals, GoalInfo0, GoalInfo),
Goal = hlds_goal(GoalExpr, GoalInfo),
- Clause = clause(all_modes, Goal, impl_lang_mercury, Context),
+ Clause = clause(all_modes, Goal, impl_lang_mercury, Context, []),
set_clause_list([Clause], ClausesRep),
ItemNumbers = init_clause_item_numbers_comp_gen,
clauses_info_set_clauses_rep(ClausesRep, ItemNumbers,
Index: compiler/unify_proc.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unify_proc.m,v
retrieving revision 1.215
diff -u -b -r1.215 unify_proc.m
--- compiler/unify_proc.m 2 Jan 2011 14:38:00 -0000 1.215
+++ compiler/unify_proc.m 26 Feb 2011 03:46:23 -0000
@@ -2016,7 +2016,7 @@
info_set_varset(Varset, !Info),
info_set_types(Types, !Info),
info_set_rtti_varmaps(RttiVarMaps, !Info),
- Clause = clause(all_modes, Goal, impl_lang_mercury, Context).
+ Clause = clause(all_modes, Goal, impl_lang_mercury, Context, []).
%-----------------------------------------------------------------------------%
Index: compiler/unused_imports.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unused_imports.m,v
retrieving revision 1.25
diff -u -b -r1.25 unused_imports.m
--- compiler/unused_imports.m 2 Jan 2011 14:38:00 -0000 1.25
+++ compiler/unused_imports.m 26 Feb 2011 03:46:50 -0000
@@ -380,8 +380,8 @@
:- pred clause_used_modules(clause::in,
used_modules::in, used_modules::out) is det.
-clause_used_modules(clause(_, Goal, _, _), !UsedModules) :-
- hlds_goal_used_modules(Goal, !UsedModules).
+clause_used_modules(Clause, !UsedModules) :-
+ hlds_goal_used_modules(Clause ^ clause_body, !UsedModules).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
cvs diff: Diffing compiler/notes
Index: compiler/notes/compiler_design.html
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/notes/compiler_design.html,v
retrieving revision 1.150
diff -u -b -r1.150 compiler_design.html
--- compiler/notes/compiler_design.html 4 Jan 2011 05:01:37 -0000 1.150
+++ compiler/notes/compiler_design.html 26 Feb 2011 19:18:10 -0000
@@ -442,16 +442,21 @@
Expands away field access syntax.
<dt>
-add_clause.m
+goal_expr_to_goal.m
<dd>
Converts clauses from parse_tree format to hlds format.
-Handles their addition to procedures,
-which is nontrivial in the presence of mode-specific clauses.
Eliminates universal quantification
(using `all [Vs] G' ===> `not (some [Vs] (not G))')
and implication (using `A => B' ===> `not(A, not B)').
<dt>
+add_clause.m
+<dd>
+Oversees the conversion of clauses from parse_tree format to hlds format.
+Handles their addition to procedures,
+which is nontrivial in the presence of mode-specific clauses.
+
+<dt>
add_pred.m
<dd>
Handles type and mode declarations for predicates.
cvs diff: Diffing deep_profiler
Index: deep_profiler/read_profile.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/deep_profiler/read_profile.m,v
retrieving revision 1.35
diff -u -b -r1.35 read_profile.m
--- deep_profiler/read_profile.m 27 Jan 2011 08:03:53 -0000 1.35
+++ deep_profiler/read_profile.m 19 Feb 2011 10:36:17 -0000
@@ -429,8 +429,8 @@
io::di, io::uo) is det.
read_call_site_static(MaybeCSS, !IO) :-
- trace [compile_time(flag("debug_read_profdeep")), io(!IO)] (
- io.write_string("reading call_site_static.\n", !IO)
+ trace [compile_time(flag("debug_read_profdeep")), io(!TIO)] (
+ io.write_string("reading call_site_static.\n", !TIO)
),
io_combinator.maybe_error_sequence_4(
read_ptr(css),
@@ -450,12 +450,12 @@
MaybeCSS, !IO),
(
MaybeCSS = ok({CallSiteStatic, CSSI}),
- trace [compile_time(flag("debug_read_profdeep")), io(!IO)] (
- io.write_string("read call_site_static ", !IO),
- io.write_int(CSSI, !IO),
- io.write_string(": ", !IO),
- io.write(CallSiteStatic, !IO),
- io.write_string("\n", !IO)
+ trace [compile_time(flag("debug_read_profdeep")), io(!TIO)] (
+ io.write_string("read call_site_static ", !TIO),
+ io.write_int(CSSI, !TIO),
+ io.write_string(": ", !TIO),
+ io.write(CallSiteStatic, !TIO),
+ io.write_string("\n", !TIO)
)
;
MaybeCSS = error(_)
@@ -465,8 +465,8 @@
maybe_error2(proc_static, int)::out, io::di, io::uo) is det.
read_proc_static(ProfileStats, MaybePS, !IO) :-
- trace [compile_time(flag("debug_read_profdeep")), io(!IO)] (
- io.write_string("reading proc_static.\n", !IO)
+ trace [compile_time(flag("debug_read_profdeep")), io(!TIO)] (
+ io.write_string("reading proc_static.\n", !TIO)
),
io_combinator.maybe_error_sequence_6(
read_ptr(ps),
@@ -506,12 +506,12 @@
FileName, LineNumber, IsInInterface,
array(CSSPtrs), CPInfos, MaybeCPs, not_zeroed),
MaybePS = ok2(ProcStatic, PSI),
- trace [compile_time(flag("debug_read_profdeep")), io(!IO)] (
- io.write_string("read proc_static ", !IO),
- io.write_int(PSI, !IO),
- io.write_string(": ", !IO),
- io.write(ProcStatic, !IO),
- io.write_string("\n", !IO)
+ trace [compile_time(flag("debug_read_profdeep")), io(!TIO)] (
+ io.write_string("read proc_static ", !TIO),
+ io.write_int(PSI, !TIO),
+ io.write_string(": ", !TIO),
+ io.write(ProcStatic, !TIO),
+ io.write_string("\n", !TIO)
)
;
MaybeCoveragePoints = error(Error),
@@ -881,8 +881,8 @@
maybe_error2(proc_dynamic, int)::out, io::di, io::uo) is det.
read_proc_dynamic(ProfileStats, MaybePD, !IO) :-
- trace [compile_time(flag("debug_read_profdeep")), io(!IO)] (
- io.write_string("reading proc_dynamic.\n", !IO)
+ trace [compile_time(flag("debug_read_profdeep")), io(!TIO)] (
+ io.write_string("reading proc_dynamic.\n", !TIO)
),
io_combinator.maybe_error_sequence_3(
read_ptr(pd),
@@ -906,12 +906,12 @@
PSPtr = make_psptr(PSI),
ProcDynamic = proc_dynamic(PSPtr, array(Refs), MaybeCPs),
MaybePD = ok2(ProcDynamic, PDI),
- trace [compile_time(flag("debug_read_profdeep")), io(!IO)] (
- io.write_string("read proc_dynamic ", !IO),
- io.write_int(PDI, !IO),
- io.write_string(": ", !IO),
- io.write(ProcDynamic, !IO),
- io.write_string("\n", !IO)
+ trace [compile_time(flag("debug_read_profdeep")), io(!TIO)] (
+ io.write_string("read proc_dynamic ", !TIO),
+ io.write_int(PDI, !TIO),
+ io.write_string(": ", !TIO),
+ io.write(ProcDynamic, !TIO),
+ io.write_string("\n", !TIO)
)
;
MaybeCPsAndSlots = error(Error),
@@ -926,8 +926,8 @@
io::di, io::uo) is det.
read_call_site_dynamic(MaybeCSD, !IO) :-
- trace [compile_time(flag("debug_read_profdeep")), io(!IO)] (
- io.write_string("reading call_site_dynamic.\n", !IO)
+ trace [compile_time(flag("debug_read_profdeep")), io(!TIO)] (
+ io.write_string("reading call_site_dynamic.\n", !TIO)
),
read_ptr(csd, MaybeCSDI, !IO),
(
@@ -943,12 +943,12 @@
CallSiteDynamic = call_site_dynamic(CallerPDPtr, PDPtr,
Profile),
MaybeCSD = ok2(CallSiteDynamic, CSDI),
- trace [compile_time(flag("debug_read_profdeep")), io(!IO)] (
- io.write_string("read call_site_dynamic ", !IO),
- io.write_int(CSDI, !IO),
- io.write_string(": ", !IO),
- io.write(CallSiteDynamic, !IO),
- io.write_string("\n", !IO)
+ trace [compile_time(flag("debug_read_profdeep")), io(!TIO)] (
+ io.write_string("read call_site_dynamic ", !TIO),
+ io.write_int(CSDI, !TIO),
+ io.write_string(": ", !TIO),
+ io.write(CallSiteDynamic, !TIO),
+ io.write_string("\n", !TIO)
)
;
MaybeProfile = error(Error),
@@ -1034,8 +1034,8 @@
io::di, io::uo) is det.
read_call_site_slot(MaybeSlot, !IO) :-
- trace [compile_time(flag("debug_read_profdeep")), io(!IO)] (
- io.write_string("reading call_site_slot.\n", !IO)
+ trace [compile_time(flag("debug_read_profdeep")), io(!TIO)] (
+ io.write_string("reading call_site_slot.\n", !TIO)
),
read_call_site_kind(MaybeKind, !IO),
(
@@ -1047,10 +1047,10 @@
MaybeCSDI = ok(CSDI),
CSDPtr = make_csdptr(CSDI),
MaybeSlot = ok(slot_normal(CSDPtr)),
- trace [compile_time(flag("debug_read_profdeep")), io(!IO)] (
- io.write_string("normal call_site slot ", !IO),
- io.write_int(CSDI, !IO),
- io.write_string("\n", !IO)
+ trace [compile_time(flag("debug_read_profdeep")), io(!TIO)] (
+ io.write_string("normal call_site slot ", !TIO),
+ io.write_int(CSDI, !TIO),
+ io.write_string("\n", !TIO)
)
;
MaybeCSDI = error(Error),
@@ -1075,10 +1075,10 @@
MaybeCSDIs = ok(CSDIs),
CSDPtrs = list.map(make_csdptr, CSDIs),
MaybeSlot = ok(slot_multi(Zeroed, array(CSDPtrs))),
- trace [compile_time(flag("debug_read_profdeep")), io(!IO)] (
- io.write_string("multi call_site slots ", !IO),
- io.write(CSDIs, !IO),
- io.write_string("\n", !IO)
+ trace [compile_time(flag("debug_read_profdeep")), io(!TIO)] (
+ io.write_string("multi call_site slots ", !TIO),
+ io.write(CSDIs, !TIO),
+ io.write_string("\n", !TIO)
)
;
MaybeCSDIs = error(Error),
@@ -1110,8 +1110,8 @@
maybe_error(list(int))::out, io::di, io::uo) is det.
read_multi_call_site_csdis_2(CSDIs0, MaybeCSDIs, !IO) :-
- trace [compile_time(flag("debug_read_profdeep")), io(!IO)] (
- io.format("reading multi_call_site_csdi.\n", [], !IO)
+ trace [compile_time(flag("debug_read_profdeep")), io(!TIO)] (
+ io.format("reading multi_call_site_csdi.\n", [], !TIO)
),
read_deep_byte(MaybeByte, !IO),
(
@@ -1147,10 +1147,10 @@
string.format("unexpected call_site_kind %d", [i(Byte)], Msg),
MaybeKind = error(Msg)
),
- trace [compile_time(flag("debug_read_profdeep")), io(!IO)] (
- io.write_string("call_site_kind ", !IO),
- io.write(MaybeKind, !IO),
- io.write_string("\n", !IO)
+ trace [compile_time(flag("debug_read_profdeep")), io(!TIO)] (
+ io.write_string("call_site_kind ", !TIO),
+ io.write(MaybeKind, !TIO),
+ io.write_string("\n", !TIO)
)
;
MaybeByte = error(Error),
@@ -1201,10 +1201,10 @@
string.format("unexpected call_site_kind %d", [i(Byte)], Msg),
MaybeKindAndCallee = error(Msg)
),
- trace [compile_time(flag("debug_read_profdeep")), io(!IO)] (
- io.write_string("call_site_kind_and_callee ", !IO),
- io.write(MaybeKindAndCallee, !IO),
- io.write_string("\n", !IO)
+ trace [compile_time(flag("debug_read_profdeep")), io(!TIO)] (
+ io.write_string("call_site_kind_and_callee ", !TIO),
+ io.write(MaybeKindAndCallee, !TIO),
+ io.write_string("\n", !TIO)
)
;
MaybeByte = error(Error),
@@ -1326,20 +1326,20 @@
MaybeNBytes = error(Error),
MaybeStr = error(Error)
),
- trace [compile_time(flag("debug_read_profdeep")), io(!IO)] (
- io.write_string("string ", !IO),
- io.write(MaybeStr, !IO),
- io.write_string("\n", !IO)
+ trace [compile_time(flag("debug_read_profdeep")), io(!TIO)] (
+ io.write_string("string ", !TIO),
+ io.write(MaybeStr, !TIO),
+ io.write_string("\n", !TIO)
).
:- pred read_ptr(ptr_kind::in, maybe_error(int)::out, io::di, io::uo) is det.
read_ptr(_Kind, MaybePtr, !IO) :-
read_num(MaybePtr, !IO),
- trace [compile_time(flag("debug_read_profdeep")), io(!IO)] (
- io.write_string("ptr ", !IO),
- io.write(MaybePtr, !IO),
- io.write_string("\n", !IO)
+ trace [compile_time(flag("debug_read_profdeep")), io(!TIO)] (
+ io.write_string("ptr ", !TIO),
+ io.write(MaybePtr, !TIO),
+ io.write_string("\n", !TIO)
).
:- pred read_cp_type(maybe_error(cp_type)::out, io::di, io::uo) is det.
@@ -1368,10 +1368,10 @@
read_num(MaybeNum, !IO) :-
read_num_acc(0, MaybeNum, !IO),
- trace [compile_time(flag("debug_read_profdeep")), io(!IO)] (
- io.write_string("num ", !IO),
- io.write(MaybeNum, !IO),
- io.write_string("\n", !IO)
+ trace [compile_time(flag("debug_read_profdeep")), io(!TIO)] (
+ io.write_string("num ", !TIO),
+ io.write(MaybeNum, !TIO),
+ io.write_string("\n", !TIO)
).
:- pred read_num_acc(int::in, maybe_error(int)::out,
@@ -1408,8 +1408,8 @@
read_fixed_size_int(MaybeInt, !IO) :-
read_fixed_size_int_acc(fixed_size_int_bytes, 0, 0, MaybeInt, !IO),
- trace [compile_time(flag("debug_read_profdeep")), io(!IO)] (
- io.format("fixed size int %s\n", [s(string(MaybeInt))], !IO)
+ trace [compile_time(flag("debug_read_profdeep")), io(!TIO)] (
+ io.format("fixed size int %s\n", [s(string(MaybeInt))], !TIO)
).
:- pred read_fixed_size_int_acc(int::in, int::in, int::in,
@@ -1478,10 +1478,10 @@
io.error_message(Error, Msg),
MaybeByte = error(Msg)
),
- trace [compile_time(flag("debug_read_profdeep")), io(!IO)] (
- io.write_string("byte ", !IO),
- io.write(MaybeByte, !IO),
- io.write_string("\n", !IO)
+ trace [compile_time(flag("debug_read_profdeep")), io(!TIO)] (
+ io.write_string("byte ", !TIO),
+ io.write(MaybeByte, !TIO),
+ io.write_string("\n", !TIO)
).
%------------------------------------------------------------------------------%
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
Index: doc/reference_manual.texi
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/doc/reference_manual.texi,v
retrieving revision 1.458
diff -u -b -r1.458 reference_manual.texi
--- doc/reference_manual.texi 7 Jan 2011 06:58:38 -0000 1.458
+++ doc/reference_manual.texi 27 Feb 2011 11:23:16 -0000
@@ -1000,15 +1000,15 @@
next.
The transformation is applied once for each state variable @var{X}
-with some fresh variables which we shall call @var{ThisX} and
- at var{NextX}.
+with some fresh variables which we shall call @var{ThisX} and @var{NextX}.
The expression
@samp{substitute(@var{Term}, @var{X}, @var{ThisX}, @var{NextX})}
-stands for a copy of @var{Term} with free occurrences of @samp{!. at var{X}}
-replaced with @var{ThisX} and occurrences of @samp{!:@var{X}}
-replaced with @var{NextX} (a free occurrence is one not bound by the
-head of a clause or lambda or by explicit quantification.)
+stands for a copy of @var{Term}
+with free occurrences of @samp{!. at var{X}} replaced with @var{ThisX}
+and free occurrences of @samp{!:@var{X}} replaced with @var{NextX}
+(a free occurrence is one not bound by the head of a clause or lambda
+or by explicit quantification.)
State variables obey the special scope rules.
A state variable @var{X} must be explicitly introduced either in the head of
@@ -1019,20 +1019,39 @@
referred to as @samp{!. at var{X}} (unless the enclosing @var{X} is masked
by a more local state variable of the same name.)
-For instance, the following goal employing an if-then-else expression
+For instance, the following clause employing a lambda expression
@example
- p((if q(!@var{X}), r(!@var{X}) then @var{A} else @var{B}), !@var{X})
+ p(@var{A}, @var{B}, !@var{S}) :-
+ F = (pred(@var{C}::in, @var{D}::out) is det :-
+ q(@var{C}, @var{D}, !@var{S})
+ ),
+ ( F(@var{A}, @var{E}) ->
+ @var{B} = @var{E}
+ ;
+ @var{B} = @var{A}
+ ).
@end example
@noindent
-is illegal because it implicitly refers to @samp{!:@var{X}} in the condition
-of the if-then-else expression. However
- at example
- p((if some[!@var{X}] (q(!@var{X}), r(!@var{X})) then @var{A} else @var{B}), !@var{X})
+is illegal because
+it implicitly refers to @samp{!:@var{S}} inside the lambda expression.
+However
+ at example
+ p(@var{A}, @var{B}, !@var{S}) :-
+ F = (pred(@var{C}::in, @var{D}::out, !. at var{S}::in, !:@var{S}::out) is det :-
+ q(@var{C}, @var{D}, !@var{S})
+ ),
+ ( F(@var{A}, @var{E}, !@var{S}) ->
+ @var{B} = @var{E}
+ ;
+ @var{B} = @var{A}
+ ).
@end example
@noindent
-is acceptable because the state variable @var{X} is locally scoped to the
-condition and then-goal of the if-then-else expression, hence @samp{!:@var{X}}
-may appear therein.
+is acceptable because the state variable @var{S} accessed
+inside the lambda expression is locally scoped to the lambda expression
+(shadowing the state variable of the same name outside the lambda expression),
+and the lambda expression may refer to
+the text version of a local state variable.
There are three restrictions concerning state variables in lambdas: first,
@samp{!@var{X}} is not a legitimate function result, since it stands for two
Index: doc/user_guide.texi
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/doc/user_guide.texi,v
retrieving revision 1.622
diff -u -b -r1.622 user_guide.texi
--- doc/user_guide.texi 26 Jan 2011 16:08:03 -0000 1.622
+++ doc/user_guide.texi 1 Mar 2011 06:48:58 -0000
@@ -6480,6 +6480,11 @@
Note that since the compiler's ability to parse foreign language code
is limited some warnings reported by this option may be spurious and
some actual errors may not be detected at all.
+
+ at sp 1
+ at item --no-warn-state-var-shadowing
+ at findex --no-warn-state-var-shadowing
+Do not warn about one state variable shadowing another.
@end table
@node Verbosity options
@@ -7051,7 +7056,7 @@
G - compile-time garbage collection information,
I - imported predicates,
M - mode and inst information,
-P - path information,
+P - goal id and path information,
R - live forward use, live backward use and reuse possibilities,
S - information about structure sharing,
T - type and typeclass information,
cvs diff: Diffing extras
cvs diff: Diffing extras/base64
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/error
cvs diff: Diffing extras/fixed
cvs diff: Diffing extras/gator
cvs diff: Diffing extras/gator/generations
cvs diff: Diffing extras/gator/generations/1
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/easyx
cvs diff: Diffing extras/graphics/easyx/samples
cvs diff: Diffing extras/graphics/mercury_allegro
cvs diff: Diffing extras/graphics/mercury_allegro/examples
cvs diff: Diffing extras/graphics/mercury_allegro/samples
cvs diff: Diffing extras/graphics/mercury_allegro/samples/demo
cvs diff: Diffing extras/graphics/mercury_allegro/samples/mandel
cvs diff: Diffing extras/graphics/mercury_allegro/samples/pendulum2
cvs diff: Diffing extras/graphics/mercury_allegro/samples/speed
cvs diff: Diffing extras/graphics/mercury_cairo
cvs diff: Diffing extras/graphics/mercury_cairo/samples
cvs diff: Diffing extras/graphics/mercury_cairo/samples/data
cvs diff: Diffing extras/graphics/mercury_cairo/tutorial
cvs diff: Diffing extras/graphics/mercury_glut
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/gears
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
cvs diff: Diffing extras/log4m
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/monte
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/moose/tests
cvs diff: Diffing extras/mopenssl
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/net
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/posix/samples
cvs diff: Diffing extras/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/solver_types
cvs diff: Diffing extras/solver_types/library
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/windows_installer_generator
cvs diff: Diffing extras/windows_installer_generator/sample
cvs diff: Diffing extras/windows_installer_generator/sample/images
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing extras/xml_stylesheets
cvs diff: Diffing java
cvs diff: Diffing java/runtime
cvs diff: Diffing library
Index: library/require.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/require.m,v
retrieving revision 1.43
diff -u -b -r1.43 require.m
--- library/require.m 15 Dec 2010 06:30:36 -0000 1.43
+++ library/require.m 1 Feb 2011 07:27:55 -0000
@@ -94,6 +94,12 @@
%
:- pred expect((pred)::((pred) is semidet), string::in, string::in) is det.
+ % expect_not(Goal, Module, Message):
+ %
+ % Call Goal, and call unexpected(Module, Message) if Goal succeeds.
+ %
+:- pred expect_not((pred)::((pred) is semidet), string::in, string::in) is det.
+
%-----------------------------------------------------------------------------%
% report_lookup_error(Message, Key):
@@ -188,6 +194,13 @@
unexpected(Module, Message)
).
+expect_not(Goal, Module, Message) :-
+ ( Goal ->
+ unexpected(Module, Message)
+ ;
+ true
+ ).
+
%-----------------------------------------------------------------------------%
report_lookup_error(Msg, K) :-
Index: library/varset.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/varset.m,v
retrieving revision 1.85
diff -u -b -r1.85 varset.m
--- library/varset.m 30 Dec 2010 11:18:04 -0000 1.85
+++ library/varset.m 18 Feb 2011 05:17:43 -0000
@@ -326,20 +326,20 @@
).
varset.new_vars(VarSet0, NumVars, NewVars, VarSet) :-
- varset.new_vars_2(VarSet0, NumVars, [], NewVars, VarSet).
+ varset.new_vars_2(NumVars, [], RevNewVars, VarSet0, VarSet),
+ % Return the new variables in order.
+ list.reverse(RevNewVars, NewVars).
-:- pred varset.new_vars_2(varset(T)::in, int::in, list(var(T))::in,
- list(var(T))::out, varset(T)::out) is det.
+:- pred varset.new_vars_2(int::in, list(var(T))::in,
+ list(var(T))::out, varset(T)::in, varset(T)::out) is det.
-varset.new_vars_2(VarSet0, NumVars, NewVars0, NewVars, VarSet) :-
+varset.new_vars_2(NumVars, !RevNewVars, !VarSet) :-
( NumVars > 0 ->
- NumVars1 = NumVars - 1,
- varset.new_var(VarSet0, Var, VarSet1),
- varset.new_vars_2(VarSet1, NumVars1, [Var | NewVars0],
- NewVars, VarSet)
+ varset.new_var(!.VarSet, Var, !:VarSet),
+ !:RevNewVars = [Var | !.RevNewVars],
+ varset.new_vars_2(NumVars - 1, !RevNewVars, !VarSet)
; NumVars = 0 ->
- NewVars = NewVars0,
- VarSet = VarSet0
+ true
;
error("varset.new_vars - invalid call")
).
cvs diff: Diffing mdbcomp
Index: mdbcomp/mdbcomp.goal_path.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/mdbcomp/mdbcomp.goal_path.m,v
retrieving revision 1.4
diff -u -b -r1.4 mdbcomp.goal_path.m
--- mdbcomp/mdbcomp.goal_path.m 20 Jan 2011 13:44:11 -0000 1.4
+++ mdbcomp/mdbcomp.goal_path.m 16 Feb 2011 05:46:30 -0000
@@ -63,6 +63,8 @@
:- type goal_id
---> goal_id(int).
+:- pred is_valid_goal_id(goal_id::in) is semidet.
+
:- type forward_goal_path
---> fgp(list(goal_path_step)).
@@ -305,6 +307,9 @@
:- import_module svbimap.
:- import_module svmap.
+is_valid_goal_id(goal_id(GoalIdNum)) :-
+ GoalIdNum >= 0.
+
whole_body_goal_id = goal_id(0).
goal_path_add_at_end(GoalPath0, GoalPathStep) = GoalPath :-
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/standalone_c
cvs diff: Diffing samples/concurrency
cvs diff: Diffing samples/concurrency/dining_philosophers
cvs diff: Diffing samples/concurrency/midimon
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/java_interface
cvs diff: Diffing samples/java_interface/java_calls_mercury
cvs diff: Diffing samples/java_interface/mercury_calls_java
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/solver_types
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing slice
cvs diff: Diffing ssdb
cvs diff: Diffing tests
cvs diff: Diffing tests/analysis
cvs diff: Diffing tests/analysis/ctgc
cvs diff: Diffing tests/analysis/excp
cvs diff: Diffing tests/analysis/ext
cvs diff: Diffing tests/analysis/sharing
cvs diff: Diffing tests/analysis/table
cvs diff: Diffing tests/analysis/trail
cvs diff: Diffing tests/analysis/unused_args
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
Index: tests/debugger/tailrec1.exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/debugger/tailrec1.exp,v
retrieving revision 1.1
diff -u -b -r1.1 tailrec1.exp
--- tests/debugger/tailrec1.exp 25 Nov 2008 07:46:56 -0000 1.1
+++ tests/debugger/tailrec1.exp 26 Feb 2011 05:40:32 -0000
@@ -53,7 +53,7 @@
mdb> print *
Stream (arg 1) stream(0, input, text, file("tailrec1.data"))
STATE_VARIABLE_Words_0 (arg 2) ["a", "is", "This"]
- STATE_VARIABLE_Words_1 ["list", "a", "is", "This"]
+ STATE_VARIABLE_Words_15 ["list", "a", "is", "This"]
Word "list"
mdb> continue
E15: C10 CALL pred tailrec1.tailrec1_read_line/4-0 (det)
Index: tests/debugger/user_event_2.exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/debugger/user_event_2.exp,v
retrieving revision 1.1
diff -u -b -r1.1 user_event_2.exp
--- tests/debugger/user_event_2.exp 23 Feb 2007 06:35:56 -0000 1.1
+++ tests/debugger/user_event_2.exp 26 Feb 2011 10:15:49 -0000
@@ -3,7 +3,7 @@
Command echo enabled.
mdb> register --quiet
mdb> user
- E2: C2 USER <event_with_zero_arity_defined_type> pred user_event_2.do_something/3-0 (det) c1; user_event_2.m:16
+ E2: C2 USER <event_with_zero_arity_defined_type> pred user_event_2.do_something/3-0 (det) c2; user_event_2.m:16
mdb> print *
arg (attr 0, Data) foo(43)
mdb> continue
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
Index: tests/general/state_var_trace.m
===================================================================
RCS file: tests/general/state_var_trace.m
diff -N tests/general/state_var_trace.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/general/state_var_trace.m 27 Feb 2011 05:09:09 -0000
@@ -0,0 +1,48 @@
+%------------------------------------------------------------------------------%
+% vim: ft=mercury ff=unix ts=4 sw=4 et
+%
+% This test case models some code in g12/common/g12/propagator.m that is
+% a challenge for the state variable transformation.
+%
+%------------------------------------------------------------------------------%
+
+:- module state_var_trace.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+%------------------------------------------------------------------------------%
+%------------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module int.
+:- import_module list.
+:- import_module string.
+
+main(!IO) :-
+ X0 = 10,
+ p(0, B, X0, X),
+ io.format("B = %d\n", [i(B)], !IO),
+ io.format("X = %d\n", [i(X)], !IO).
+
+:- pred p(int::in, int::out, int::di, int::uo) is det.
+
+p(A, B, !X) :-
+ trace [
+ compiletime(flag("state_var_trace")),
+ io(!TIO)
+ ] (
+ ui_format("A ", A, !TIO),
+ ui_format("!.X", !.X, !TIO)
+ ),
+ B = A + 1.
+
+:- pred ui_format(string::in, int::ui, io::di, io::uo) is det.
+
+ui_format(Name, Var, !IO) :-
+ copy(Var, VarCopy),
+ io.format("%s = %d\n", [s(Name), i(VarCopy)], !IO).
Index: tests/general/state_vars_tests.exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/general/state_vars_tests.exp,v
retrieving revision 1.2
diff -u -b -r1.2 state_vars_tests.exp
--- tests/general/state_vars_tests.exp 11 Jul 2002 06:56:52 -0000 1.2
+++ tests/general/state_vars_tests.exp 26 Feb 2011 20:06:55 -0000
@@ -1 +1 @@
-[1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31]
+[1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 31]
Index: tests/general/state_vars_tests.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/general/state_vars_tests.m,v
retrieving revision 1.2
diff -u -b -r1.2 state_vars_tests.m
--- tests/general/state_vars_tests.m 4 Apr 2006 02:39:19 -0000 1.2
+++ tests/general/state_vars_tests.m 26 Feb 2011 17:35:07 -0000
@@ -1,8 +1,9 @@
%------------------------------------------------------------------------------%
+% vim: ft=mercury ff=unix ts=4 sw=4 et
+%------------------------------------------------------------------------------%
% state_vars_tests.m
% Ralph Becket <rafe at cs.mu.oz.au>
% Wed Apr 3 14:19:02 EST 2002
-% vim: ft=mercury ff=unix ts=4 sw=4 et wm=0 tw=0
%
%------------------------------------------------------------------------------%
@@ -12,8 +13,6 @@
:- import_module io.
-
-
:- pred main(io::di, io::uo) is cc_multi.
%------------------------------------------------------------------------------%
@@ -27,8 +26,8 @@
main(!IO) :-
unsorted_solutions(test, S),
- io__print(list__reverse(S) `with_type` list(int), !IO),
- io__nl(!IO).
+ io.print(list.reverse(S) `with_type` list(int), !IO),
+ io.nl(!IO).
%------------------------------------------------------------------------------%
@@ -217,12 +216,13 @@
X = !.A
).
-test(X) :-
- X =
- ( if ( some [!A] !:A = 30 )
- then !.A
- else 0
- ).
+% This use of state variables no longer considered valid.
+% test(X) :-
+% X =
+% ( if ( some [!A] !:A = 30 )
+% then !.A
+% else 0
+% ).
test(X) :-
( if ( some [!A] !:A = 31 )
@@ -236,14 +236,12 @@
add(N, X, X + N).
-
:- pred t(int::in, int::out) is semidet.
t(!X) :-
!:X = !.X + 1,
semidet_succeed.
-
:- pred f(int::in, int::out) is semidet.
f(!X) :-
@@ -251,13 +249,11 @@
!:X = !.X + 1,
!.X = X0.
-
:- func fn_a(int, int) = int.
fn_a(N, !.X) = !:X :-
!:X = !.X + N.
-
:- func fn_b(int, int) = int.
fn_b(N, !.X) = !.X + N.
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/string_format
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/grade_subdirs
cvs diff: Diffing tests/hard_coded
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.396
diff -u -b -r1.396 Mmakefile
--- tests/hard_coded/Mmakefile 29 Dec 2010 04:52:21 -0000 1.396
+++ tests/hard_coded/Mmakefile 16 Feb 2011 02:41:23 -0000
@@ -127,6 +127,7 @@
ho_order2 \
ho_solns \
ho_univ_to_type \
+ if_then_else_expr_state_var \
impl_def_lex \
impl_def_lex_string \
impl_def_literal \
@@ -150,8 +151,8 @@
list_series_int \
lookup_disj \
lookup_switch_simple \
- lookup_switch_simple_cond \
lookup_switch_simple_bitvec \
+ lookup_switch_simple_cond \
lookup_switch_simple_non \
lookup_switch_simple_opt \
loop_inv_test \
Index: tests/hard_coded/bit_buffer_test.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/bit_buffer_test.m,v
retrieving revision 1.2
diff -u -b -r1.2 bit_buffer_test.m
--- tests/hard_coded/bit_buffer_test.m 5 Aug 2009 04:45:59 -0000 1.2
+++ tests/hard_coded/bit_buffer_test.m 26 Feb 2011 06:44:51 -0000
@@ -52,7 +52,7 @@
% Uncomment this to debug read errors.
% bit_buffer.read.set_logging_level(1, !IO),
- some [!Seq, !ShortBM, !ShortSeq, !LongSeq, !ShortBM, !LongBM, !ErrorSeq] (
+ some [!Seq, !ShortSeq, !LongSeq, !ShortBM, !LongBM, !ErrorSeq] (
%
% Test with request sequences that are a minimum of 8 bytes to
% test overflow even on 64-bit machines (buffers are at least
Index: tests/hard_coded/if_then_else_expr_state_var.exp
===================================================================
RCS file: tests/hard_coded/if_then_else_expr_state_var.exp
diff -N tests/hard_coded/if_then_else_expr_state_var.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/if_then_else_expr_state_var.exp 16 Feb 2011 02:40:28 -0000
@@ -0,0 +1,12 @@
+InitX = 1, FinalX = 6
+InitY = 101, FinalY = 101
+
+InitX = 2, FinalX = 7
+InitY = 102, FinalY = 102
+
+InitX = 11, FinalX = 114
+InitY = 111, FinalY = 114
+
+InitX = 12, FinalX = 115
+InitY = 112, FinalY = 115
+
Index: tests/hard_coded/if_then_else_expr_state_var.m
===================================================================
RCS file: tests/hard_coded/if_then_else_expr_state_var.m
diff -N tests/hard_coded/if_then_else_expr_state_var.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/if_then_else_expr_state_var.m 16 Feb 2011 02:46:55 -0000
@@ -0,0 +1,49 @@
+% vim: ft=mercury ts=4 sw=4 et
+
+:- module if_then_else_expr_state_var.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- import_module int.
+:- import_module list.
+:- import_module string.
+
+main(!IO) :-
+ test(1, 101, !IO),
+ test(2, 102, !IO),
+ test(11, 111, !IO),
+ test(12, 112, !IO).
+
+:- pred test(int::in, int::in, io::di, io::uo) is det.
+
+test(InitX, InitY, !IO) :-
+ some [!X, !Y] (
+ !:X = InitX,
+ !:Y = InitY,
+ set( ( if big(!.X) then increment3(!.Y, !:Y) else !.X + 5 ), !:X),
+ FinalX = !.X,
+ FinalY = !.Y
+ ),
+ io.format("InitX = %3d, FinalX = %3d\n", [i(InitX), i(FinalX)], !IO),
+ io.format("InitY = %3d, FinalY = %3d\n", [i(InitY), i(FinalY)], !IO),
+ io.nl(!IO).
+
+:- pred big(int::in) is semidet.
+
+big(N) :-
+ N > 10.
+
+:- func increment3(int::in, int::out) = (int::out) is det.
+
+increment3(N, M) = M :-
+ M = N + 3.
+
+:- pred set(int::in, int::out) is det.
+
+set(X, X).
Index: tests/hard_coded/try_syntax_6.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/try_syntax_6.m,v
retrieving revision 1.1
diff -u -b -r1.1 try_syntax_6.m
--- tests/hard_coded/try_syntax_6.m 10 Mar 2009 05:00:33 -0000 1.1
+++ tests/hard_coded/try_syntax_6.m 1 Mar 2011 06:23:29 -0000
@@ -43,8 +43,8 @@
then
true
catch 4 ->
- trace [io(!IO)] (
- io.write_string("caught 4 (WRONG)\n", !IO)
+ trace [io(!TIO)] (
+ io.write_string("caught 4 (WRONG)\n", !TIO)
)
)
then
@@ -68,15 +68,15 @@
then
true
catch 4 ->
- trace [io(!IO)] (
- io.write_string("caught 4 (WRONG)\n", !IO)
+ trace [io(!TIO)] (
+ io.write_string("caught 4 (WRONG)\n", !TIO)
)
)
else
true
catch 3 ->
- trace [io(!IO)] (
- io.write_string("caught 3 in middle try (WRONG)\n", !IO)
+ trace [io(!TIO)] (
+ io.write_string("caught 3 in middle try (WRONG)\n", !TIO)
)
)
then
@@ -102,8 +102,8 @@
true
)
catch 1 ->
- trace [io(!IO)] (
- io.write_string("caught 1 in inner try (WRONG)\n", !IO)
+ trace [io(!TIO)] (
+ io.write_string("caught 1 in inner try (WRONG)\n", !TIO)
)
)
then
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
Index: tests/invalid/any_passed_as_ground.err_exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/any_passed_as_ground.err_exp,v
retrieving revision 1.5
diff -u -b -r1.5 any_passed_as_ground.err_exp
--- tests/invalid/any_passed_as_ground.err_exp 7 Sep 2006 05:51:24 -0000 1.5
+++ tests/invalid/any_passed_as_ground.err_exp 26 Feb 2011 05:41:35 -0000
@@ -1,6 +1,6 @@
any_passed_as_ground.m:036: In clause for `main(di, uo)':
any_passed_as_ground.m:036: in call to predicate `list.member'/2:
-any_passed_as_ground.m:036: mode error: arguments `TypeInfo_16, V_11, Xs'
+any_passed_as_ground.m:036: mode error: arguments `TypeInfo_15, V_10, Xs'
any_passed_as_ground.m:036: have the following insts:
any_passed_as_ground.m:036: unique(private_builtin.type_info(unique(<type_ctor_info
any_passed_as_ground.m:036: for pair.pair/2>), unique(<type_ctor_info for
Index: tests/invalid/bad_sv_unify_msg.err_exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/bad_sv_unify_msg.err_exp,v
retrieving revision 1.2
diff -u -b -r1.2 bad_sv_unify_msg.err_exp
--- tests/invalid/bad_sv_unify_msg.err_exp 14 Aug 2009 20:37:54 -0000 1.2
+++ tests/invalid/bad_sv_unify_msg.err_exp 26 Feb 2011 05:41:40 -0000
@@ -1,18 +1,18 @@
bad_sv_unify_msg.m:011: In predicate `x'/2:
bad_sv_unify_msg.m:011: warning: unresolved polymorphism.
bad_sv_unify_msg.m:011: The variable with an unbound type was:
-bad_sv_unify_msg.m:011: STATE_VARIABLE_D_1: T
+bad_sv_unify_msg.m:011: STATE_VARIABLE_D_7: T
bad_sv_unify_msg.m:011: The unbound type variable will be implicitly bound to
bad_sv_unify_msg.m:011: the builtin type `void'.
+bad_sv_unify_msg.m:017: Error: !D cannot appear as a unification argument.
+bad_sv_unify_msg.m:017: You probably meant !.D or !:D.
bad_sv_unify_msg.m:017: In clause for `x(di, uo)':
bad_sv_unify_msg.m:017: in argument 1 of call to predicate `io.write'/3:
-bad_sv_unify_msg.m:017: mode error: variable `STATE_VARIABLE_D_1' has
+bad_sv_unify_msg.m:017: mode error: variable `STATE_VARIABLE_D_7' has
bad_sv_unify_msg.m:017: instantiatedness `free',
bad_sv_unify_msg.m:017: expected instantiatedness was `ground'.
-bad_sv_unify_msg.m:017: Error: !D cannot appear as a unification argument.
-bad_sv_unify_msg.m:017: You probably meant !.D or !:D.
bad_sv_unify_msg.m:017: In clause for predicate `bad_sv_unify_msg.x'/2:
-bad_sv_unify_msg.m:017: warning: variable `STATE_VARIABLE_D_1' occurs only
+bad_sv_unify_msg.m:017: warning: variable `STATE_VARIABLE_D_7' occurs only
bad_sv_unify_msg.m:017: once in this scope.
bad_sv_unify_msg.m:018: Warning: reference to uninitialized state variable !.D.
For more information, recompile with `-E'.
Index: tests/invalid/state_vars_test1.err_exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/state_vars_test1.err_exp,v
retrieving revision 1.8
diff -u -b -r1.8 state_vars_test1.err_exp
--- tests/invalid/state_vars_test1.err_exp 14 Aug 2009 20:37:55 -0000 1.8
+++ tests/invalid/state_vars_test1.err_exp 26 Feb 2011 20:27:33 -0000
@@ -1,6 +1,11 @@
-state_vars_test1.m:022: Warning: the condition of this if-then-else cannot
-state_vars_test1.m:022: fail.
-state_vars_test1.m:023: Error: cannot use !:X in this context;
-state_vars_test1.m:023: however !.X may be used here.
-state_vars_test1.m:023: In clause for predicate `state_vars_test1.p'/2:
-state_vars_test1.m:023: warning: variable `X' occurs only once in this scope.
+state_vars_test1.m:023: In clause for `p(in, out)':
+state_vars_test1.m:023: in call to function `int.+'/2:
+state_vars_test1.m:023: mode error: arguments
+state_vars_test1.m:023: `STATE_VARIABLE_X_0, V_7, STATE_VARIABLE_X' have the
+state_vars_test1.m:023: following insts:
+state_vars_test1.m:023: ground,
+state_vars_test1.m:023: free,
+state_vars_test1.m:023: free
+state_vars_test1.m:023: which does not match any of the modes for function
+state_vars_test1.m:023: `int.+'/2.
+For more information, recompile with `-E'.
Index: tests/invalid/state_vars_test1.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/state_vars_test1.m,v
retrieving revision 1.2
diff -u -b -r1.2 state_vars_test1.m
--- tests/invalid/state_vars_test1.m 22 Jul 2002 02:18:01 -0000 1.2
+++ tests/invalid/state_vars_test1.m 26 Feb 2011 17:36:48 -0000
@@ -1,8 +1,9 @@
%------------------------------------------------------------------------------%
+% vim: ft=mercury ff=unix ts=4 sw=4 et
+%------------------------------------------------------------------------------%
% state_vars_test1.m
% Ralph Becket <rafe at cs.mu.oz.au>
% Thu May 30 14:22:14 EST 2002
-% vim: ft=mercury ff=unix ts=4 sw=4 et wm=0 tw=0
%
%------------------------------------------------------------------------------%
Index: tests/invalid/state_vars_test4.err_exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/state_vars_test4.err_exp,v
retrieving revision 1.10
diff -u -b -r1.10 state_vars_test4.err_exp
--- tests/invalid/state_vars_test4.err_exp 7 Sep 2006 05:51:33 -0000 1.10
+++ tests/invalid/state_vars_test4.err_exp 1 Mar 2011 22:13:23 -0000
@@ -1,9 +1,17 @@
+state_vars_test4.m:015: In function `f'/1:
+state_vars_test4.m:015: warning: unresolved polymorphism.
+state_vars_test4.m:015: The variables with unbound types were:
+state_vars_test4.m:015: STATE_VARIABLE_X: V_1
+state_vars_test4.m:015: STATE_VARIABLE_X_0: V_1
+state_vars_test4.m:015: The unbound type variables will be implicitly bound
+state_vars_test4.m:015: to the builtin type `void'.
state_vars_test4.m:021: Error: !X cannot be a lambda argument.
state_vars_test4.m:021: Perhaps you meant !.X or !:X.
state_vars_test4.m:021: In clause for `f(in) = out':
state_vars_test4.m:021: in argument 1 of call to function `list.foldl'/3:
-state_vars_test4.m:021: mode error: variable `V_5' has instantiatedness
+state_vars_test4.m:021: mode error: variable `V_7' has instantiatedness
state_vars_test4.m:021: `free',
state_vars_test4.m:021: expected instantiatedness was `(func((ground >>
state_vars_test4.m:021: ground), (ground >> ground)) = (free >> ground) is
state_vars_test4.m:021: det)'.
+For more information, recompile with `-E'.
Index: tests/invalid/try_bad_params.err_exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/try_bad_params.err_exp,v
retrieving revision 1.3
diff -u -b -r1.3 try_bad_params.err_exp
--- tests/invalid/try_bad_params.err_exp 14 Aug 2009 20:37:55 -0000 1.3
+++ tests/invalid/try_bad_params.err_exp 26 Feb 2011 10:50:47 -0000
@@ -5,13 +5,13 @@
try_bad_params.m:040: In clause for predicate `main_3'/2:
try_bad_params.m:040: in argument 2 of call to predicate
try_bad_params.m:040: `exception.rethrow'/1:
-try_bad_params.m:040: type error: variable `STATE_VARIABLE_Int_0' has type
+try_bad_params.m:040: type error: variable `STATE_VARIABLE_Int' has type
try_bad_params.m:040: `int',
try_bad_params.m:040: expected type was `io.state'.
try_bad_params.m:040: In clause for predicate `main_3'/2:
try_bad_params.m:040: in argument 2 of call to predicate
try_bad_params.m:040: `exception.rethrow'/1:
-try_bad_params.m:040: type error: variable `STATE_VARIABLE_Int_1' has type
+try_bad_params.m:040: type error: variable `STATE_VARIABLE_Int_0' has type
try_bad_params.m:040: `int',
try_bad_params.m:040: expected type was `io.state'.
try_bad_params.m:044: Error: no clauses for predicate `main_4'/1.
Index: tests/invalid/try_detism.err_exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/try_detism.err_exp,v
retrieving revision 1.1
diff -u -b -r1.1 try_detism.err_exp
--- tests/invalid/try_detism.err_exp 15 Feb 2010 01:48:31 -0000 1.1
+++ tests/invalid/try_detism.err_exp 26 Feb 2011 10:50:47 -0000
@@ -3,10 +3,14 @@
try_detism.m:008: Declared `cc_multi', inferred `cc_nondet'.
try_detism.m:015: In argument 1 of call to predicate `try_detism.q'/3:
try_detism.m:015: unification with `X' can fail.
+try_detism.m:019: Error: call to predicate `exception.magic_exception_result'/1
+try_detism.m:019: with determinism `cc_multi' occurs in a context which
+try_detism.m:019: requires all solutions.
+try_detism.m:015: Unification of X and V_20 can fail.
try_detism.m:019: In clause for `p(out, di, uo)':
try_detism.m:019: in call to predicate `exception.try_io'/4:
try_detism.m:019: mode error: arguments
-try_detism.m:019: `TypeInfo_27, TryLambda, TryResult, STATE_VARIABLE_IO_1, TryIOOutput'
+try_detism.m:019: `TypeInfo_26, TryLambda, TryResult, STATE_VARIABLE_IO_10, TryIOOutput'
try_detism.m:019: have the following insts:
try_detism.m:019: unique(private_builtin.type_info(unique(<type_ctor_info
try_detism.m:019: for .tuple/0>), unique(0))),
@@ -17,8 +21,4 @@
try_detism.m:019: free
try_detism.m:019: which does not match any of the modes for predicate
try_detism.m:019: `exception.try_io'/4.
-try_detism.m:019: Error: call to predicate `exception.magic_exception_result'/1
-try_detism.m:019: with determinism `cc_multi' occurs in a context which
-try_detism.m:019: requires all solutions.
-try_detism.m:015: Unification of X and V_21 can fail.
For more information, recompile with `-E'.
cvs diff: Diffing tests/invalid/purity
Index: tests/invalid/purity/impure_pred_t1_fixed.err_exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/purity/impure_pred_t1_fixed.err_exp,v
retrieving revision 1.5
diff -u -b -r1.5 impure_pred_t1_fixed.err_exp
--- tests/invalid/purity/impure_pred_t1_fixed.err_exp 16 Apr 2009 02:09:09 -0000 1.5
+++ tests/invalid/purity/impure_pred_t1_fixed.err_exp 26 Feb 2011 10:51:27 -0000
@@ -3,7 +3,7 @@
impure_pred_t1_fixed.m:022: higher-order predicate call:
impure_pred_t1_fixed.m:022: type error: variable `X' has type `(impure
impure_pred_t1_fixed.m:022: pred(int, int))',
-impure_pred_t1_fixed.m:022: expected type was `pred(V_2, V_1)'.
+impure_pred_t1_fixed.m:022: expected type was `pred(V_1, V_2)'.
impure_pred_t1_fixed.m:022: The partial type assignment was:
impure_pred_t1_fixed.m:022: Y_3: impure_pred_t1_fixed.foo
impure_pred_t1_fixed.m:022: X_4: (impure pred(int, int))
Index: tests/invalid/purity/impure_pred_t2.err_exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/purity/impure_pred_t2.err_exp,v
retrieving revision 1.7
diff -u -b -r1.7 impure_pred_t2.err_exp
--- tests/invalid/purity/impure_pred_t2.err_exp 16 Apr 2009 02:09:09 -0000 1.7
+++ tests/invalid/purity/impure_pred_t2.err_exp 26 Feb 2011 10:51:28 -0000
@@ -3,7 +3,7 @@
impure_pred_t2.m:019: predicate call:
impure_pred_t2.m:019: type error: variable `Y' has type `(impure pred(int,
impure_pred_t2.m:019: int))',
-impure_pred_t2.m:019: expected type was `pred(V_2, V_1)'.
+impure_pred_t2.m:019: expected type was `pred(V_1, V_2)'.
impure_pred_t2.m:019: The partial type assignment was:
impure_pred_t2.m:019: Y_3: (impure pred(int, int))
impure_pred_t2.m:019: DCG_0_5: io.state
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/mmc_make
cvs diff: Diffing tests/mmc_make/lib
cvs diff: Diffing tests/par_conj
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/stm
cvs diff: Diffing tests/stm/orig
cvs diff: Diffing tests/stm/orig/stm-compiler
cvs diff: Diffing tests/stm/orig/stm-compiler/test1
cvs diff: Diffing tests/stm/orig/stm-compiler/test10
cvs diff: Diffing tests/stm/orig/stm-compiler/test2
cvs diff: Diffing tests/stm/orig/stm-compiler/test3
cvs diff: Diffing tests/stm/orig/stm-compiler/test4
cvs diff: Diffing tests/stm/orig/stm-compiler/test5
cvs diff: Diffing tests/stm/orig/stm-compiler/test6
cvs diff: Diffing tests/stm/orig/stm-compiler/test7
cvs diff: Diffing tests/stm/orig/stm-compiler/test8
cvs diff: Diffing tests/stm/orig/stm-compiler/test9
cvs diff: Diffing tests/stm/orig/stm-compiler-par
cvs diff: Diffing tests/stm/orig/stm-compiler-par/bm1
cvs diff: Diffing tests/stm/orig/stm-compiler-par/bm2
cvs diff: Diffing tests/stm/orig/stm-compiler-par/stmqueue
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test1
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test10
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test11
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test2
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test3
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test4
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test5
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test6
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test7
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test8
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test9
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test1
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test2
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test3
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test4
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test5
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test6
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test7
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test8
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test9
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/trailing
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
cvs diff: Diffing util
cvs diff: Diffing vim
cvs diff: Diffing vim/after
cvs diff: Diffing vim/ftplugin
cvs diff: Diffing vim/syntax
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list