mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-20 20:03:44 +00:00
df9420c3e6
compiler/hlds_goal.m:
Change the unify_mode structure from
unify_modes_lhs_rhs(from_to_insts(LI, LF), from_to_insts(RI, RF))
to
unify_modes_li_lf_ri_rf(LI, LF, RI, RF)
This requires fewer memory allocations (1 vs 3) and less memory
(4 words vs 6), though the performance improvement is too small
to measure.
It should also require writing fewer function symbols in code.
compiler/instmap.m:
compiler/mode_util.m:
For each utility predicate that works with from_to_insts, provide
a version that works with the separate insts contained in it.
Delete the from_to_insts version if no longer needed.
compiler/prog_mode.m:
Delete utility predicates on from_to_insts that are not needed anymore.
compiler/accumulator.m:
compiler/add_pred.m:
compiler/bytecode_gen.m:
compiler/common.m:
compiler/const_prop.m:
compiler/deep_profiling.m:
compiler/delay_partial_inst.m:
compiler/dep_par_conj.m:
compiler/equiv_type_hlds.m:
compiler/erl_unify_gen.m:
compiler/float_regs.m:
compiler/format_call.m:
compiler/goal_util.m:
compiler/higher_order.m:
compiler/hlds_out_goal.m:
compiler/hlds_out_mode.m:
compiler/interval.m:
compiler/lambda.m:
compiler/lco.m:
compiler/make_goal.m:
compiler/ml_unify_gen_construct.m:
compiler/ml_unify_gen_util.m:
compiler/modecheck_goal.m:
compiler/modecheck_unify.m:
compiler/polymorphism.m:
compiler/proc_requests.m:
compiler/prog_rep.m:
compiler/rbmm.region_transformation.m:
compiler/simplify_goal_call.m:
compiler/simplify_goal_scope.m:
compiler/simplify_goal_switch.m:
compiler/size_prof.m:
compiler/stm_expand.m:
compiler/term_util.m:
compiler/unify_gen_construct.m:
compiler/unify_gen_util.m:
compiler/unused_args.m:
Conform to the changes above.
2574 lines
96 KiB
Mathematica
2574 lines
96 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 1995-2012 The University of Melbourne.
|
|
% Copyright (C) 2015 The Mercury team.
|
|
% This file may only be copied under the terms of the GNU General
|
|
% Public License - see the file COPYING in the Mercury distribution.
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% File: goal_util.m.
|
|
% Main author: conway.
|
|
%
|
|
% This module provides various utility procedures for manipulating HLDS goals,
|
|
% e.g. attaching features to goals.
|
|
%
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- module hlds.goal_util.
|
|
:- interface.
|
|
|
|
:- import_module hlds.hlds_clauses.
|
|
:- import_module hlds.hlds_goal.
|
|
:- import_module hlds.hlds_module.
|
|
:- import_module hlds.hlds_pred.
|
|
:- import_module hlds.hlds_rtti.
|
|
:- import_module hlds.instmap.
|
|
:- import_module hlds.pred_table.
|
|
:- import_module hlds.vartypes.
|
|
:- import_module mdbcomp.
|
|
:- import_module mdbcomp.goal_path.
|
|
:- import_module mdbcomp.prim_data.
|
|
:- import_module mdbcomp.sym_name.
|
|
:- import_module parse_tree.
|
|
:- import_module parse_tree.prog_data.
|
|
:- import_module parse_tree.prog_data_foreign.
|
|
:- import_module parse_tree.set_of_var.
|
|
|
|
:- import_module bool.
|
|
:- import_module list.
|
|
:- import_module maybe.
|
|
:- import_module set.
|
|
:- import_module term.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Given a goal and an initial instmap, compute the final instmap that
|
|
% results from the initial instmap after execution of the goal.
|
|
%
|
|
:- pred update_instmap(hlds_goal::in, instmap::in, instmap::out) is det.
|
|
|
|
% create_renaming(OutputVars, InstMapDelta, !VarTypes, !VarSet,
|
|
% UnifyGoals, NewVars, Renaming):
|
|
%
|
|
% This predicate is intended for use in program transformations
|
|
% that need to wrap up semidet goals, replacing Goal with
|
|
% ( if Goal' then UnifyGoals, ... else ...), where Goal' has its output
|
|
% variables (OutputVars) replaced with new variables (NewVars),
|
|
% with the mapping from OutputVars to NewVars being Renaming.
|
|
% VarTypes and VarSet are updated for the new variables. The final
|
|
% insts of NewVar are taken from the insts of the corresponding
|
|
% OutputVar in InstMapDelta (the initial inst is free).
|
|
%
|
|
:- pred create_renaming(list(prog_var)::in, instmap_delta::in,
|
|
prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
|
|
list(hlds_goal)::out, list(prog_var)::out, prog_var_renaming::out) is det.
|
|
|
|
% clone_variable(OldVar, OldVarSet, OldVarTypes,
|
|
% !VarSet, !VarTypes, !Renaming, CloneVar):
|
|
%
|
|
% clone_variable typically takes an old variable OldVar, and creates a
|
|
% clone of it, adding the clone variable to !VarSet and !VarType, and
|
|
% adding a mapping from the old variable to its clone in !Renaming.
|
|
% The name and type of the clone are taken from OldVarSet and OldVarTypes.
|
|
% However, if OldVar already has a clone, as shown by it already being a
|
|
% key in !.Renaming, clone_variable does nothing. Either way, the identity
|
|
% of the clone variable is returned in CloneVar.
|
|
%
|
|
% (This interface will not easily admit uniqueness in the varset and
|
|
% vartypes arguments; such is the sacrifice for generality.)
|
|
%
|
|
:- pred clone_variable(prog_var::in, prog_varset::in, vartypes::in,
|
|
prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
|
|
prog_var_renaming::in, prog_var_renaming::out, prog_var::out) is det.
|
|
|
|
% clone_variables(OldVars, OldVarSet, OldVarTypes,
|
|
% !VarSet, !VarTypes, !Renaming):
|
|
%
|
|
% Invoke clone_variable on each variable in OldVars.
|
|
%
|
|
% The caller can find the identity of the clone of each variable in OldVars
|
|
% by looking it up in !:Renaming.
|
|
%
|
|
:- pred clone_variables(list(prog_var)::in, prog_varset::in, vartypes::in,
|
|
prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
|
|
prog_var_renaming::in, prog_var_renaming::out) is det.
|
|
|
|
% Return all the variables in the goal or goal expression.
|
|
% Unlike quantification.goal_vars, this predicate returns
|
|
% even the explicitly quantified variables.
|
|
%
|
|
% Warning: the complexity of this predicate is proportional to the
|
|
% size of the goal. Goals can be pretty big. Whatever you want to do,
|
|
% if you have a way to do it *without* calling the predicate, you will
|
|
% probably want to it that way.
|
|
%
|
|
:- pred goal_vars(hlds_goal::in, set_of_progvar::out) is det.
|
|
|
|
% Do the same job as goal_vars, but for a list of goals.
|
|
%
|
|
:- pred goals_goal_vars(list(hlds_goal)::in, set_of_progvar::out) is det.
|
|
|
|
% Return all the variables in a generic call.
|
|
%
|
|
:- pred generic_call_vars(generic_call::in, list(prog_var)::out) is det.
|
|
|
|
:- type attach_in_from_ground_term
|
|
---> attach_in_from_ground_term
|
|
; do_not_attach_in_from_ground_term.
|
|
|
|
% Attach the given goal features to the given goal and all its subgoals,
|
|
% except possibly in from_ground_term scopes.
|
|
%
|
|
:- pred attach_features_to_all_goals(list(goal_feature),
|
|
attach_in_from_ground_term, hlds_goal, hlds_goal).
|
|
:- mode attach_features_to_all_goals(in,
|
|
in(bound(attach_in_from_ground_term)),
|
|
in, out) is det.
|
|
:- mode attach_features_to_all_goals(in,
|
|
in(bound(do_not_attach_in_from_ground_term)), in, out) is det.
|
|
|
|
% extra_nonlocal_typeinfos(TypeInfoMap, TypeClassInfoMap,
|
|
% VarTypes, ExistQVars, NonLocals, NonLocalTypeInfos):
|
|
%
|
|
% Compute which type-info and type-class-info variables may need to be
|
|
% non-local to a goal.
|
|
%
|
|
% A type-info variable may be non-local to a goal if any of the ordinary
|
|
% non-local variables for that goal are polymorphically typed with a type
|
|
% that depends on that type-info variable, or if the type-info is for an
|
|
% existentially quantified type variable.
|
|
%
|
|
% In addition, a typeclass-info may be non-local to a goal if any of the
|
|
% non-local variables for that goal are polymorphically typed and are
|
|
% constrained by the typeclass constraints for that typeclass-info
|
|
% variable, or if the type-class-info is for an existential constraint,
|
|
% i.e. a constraint which constrains an existentially quantified type
|
|
% variable.
|
|
%
|
|
:- pred extra_nonlocal_typeinfos(rtti_varmaps::in, vartypes::in,
|
|
existq_tvars::in, set_of_progvar::in, set_of_progvar::out) is det.
|
|
|
|
:- type is_leaf
|
|
---> is_leaf
|
|
; is_not_leaf.
|
|
|
|
% See whether the given procedure body is that of a leaf procedure.
|
|
%
|
|
:- func proc_body_is_leaf(hlds_goal) = is_leaf.
|
|
|
|
% See whether the goal is a branched structure.
|
|
%
|
|
:- pred goal_is_branched(hlds_goal_expr::in) is semidet.
|
|
|
|
% Return an indication of the size of the goal.
|
|
%
|
|
:- pred goal_size(hlds_goal::in, int::out) is det.
|
|
|
|
% Return an indication of the size of the list of goals.
|
|
%
|
|
:- pred goals_size(list(hlds_goal)::in, int::out) is det.
|
|
|
|
% Return an indication of the size of the list of clauses.
|
|
%
|
|
:- pred clause_list_size(list(clause)::in, int::out) is det.
|
|
|
|
% Return a set of all the procedures referred to by the given goal or
|
|
% goals. Differs from goal_calls not just in the fact that it returns
|
|
% a set of pred_proc_ids all at once, but also in that it also returns
|
|
% procedures which are not CALLED in the given goal or goals but which
|
|
% are referred to in other ways (e.g. by having their address taken).
|
|
%
|
|
:- func goals_proc_refs(list(hlds_goal)) = set(pred_proc_id).
|
|
:- func goal_proc_refs(hlds_goal) = set(pred_proc_id).
|
|
|
|
% Test whether the goal calls the given procedure.
|
|
%
|
|
:- pred goal_calls(hlds_goal, pred_proc_id).
|
|
:- mode goal_calls(in, in) is semidet.
|
|
:- mode goal_calls(in, out) is nondet.
|
|
|
|
% Test whether the goal calls the given predicate.
|
|
% This is useful before mode analysis when the proc_ids
|
|
% have not been determined.
|
|
%
|
|
:- pred goal_calls_pred_id(hlds_goal, pred_id).
|
|
:- mode goal_calls_pred_id(in, in) is semidet.
|
|
:- mode goal_calls_pred_id(in, out) is nondet.
|
|
|
|
% goal_calls_proc_in_set(Goal, PredProcIds):
|
|
%
|
|
% Returns the subset of PredProcIds that are called from somewhere inside
|
|
% Goal via plain_call.
|
|
%
|
|
:- func goal_calls_proc_in_set(hlds_goal, set(pred_proc_id))
|
|
= set(pred_proc_id).
|
|
|
|
% goal_list_calls_proc_in_list(Goal, PredProcIds):
|
|
%
|
|
% Returns the subset of PredProcIds that are called from somewhere inside
|
|
% Goals via plain_call.
|
|
%
|
|
:- func goal_list_calls_proc_in_set(list(hlds_goal), set(pred_proc_id))
|
|
= set(pred_proc_id).
|
|
|
|
% Test whether the goal contains a reconstruction
|
|
% (a construction where the `construct_how' field is `cell_to_reuse(_)').
|
|
%
|
|
:- pred goal_contains_reconstruction(hlds_goal::in, bool::out) is det.
|
|
|
|
% goal_contains_goal(Goal, SubGoal) is true iff Goal contains SubGoal,
|
|
% i.e. iff Goal = SubGoal or Goal contains SubGoal as a direct
|
|
% or indirect sub-goal.
|
|
%
|
|
:- pred goal_contains_goal(hlds_goal::in, hlds_goal::out) is multi.
|
|
|
|
% direct_subgoal(Goal, DirectSubGoal) is true iff DirectSubGoal is
|
|
% a direct sub-goal of Goal.
|
|
%
|
|
:- pred direct_subgoal(hlds_goal_expr::in, hlds_goal::out) is nondet.
|
|
|
|
% Returns all the pred_ids that are called from a list of goals.
|
|
%
|
|
:- pred pred_ids_called_from_goals(list(hlds_goal)::in,
|
|
list(pred_id)::out) is det.
|
|
|
|
% Returns all the pred_ids that are called from a goal.
|
|
%
|
|
:- pred pred_ids_called_from_goal(hlds_goal::in, list(pred_id)::out) is det.
|
|
|
|
% Returns all the pred_id/arg_list pairs that are called from a goal.
|
|
%
|
|
:- pred pred_ids_args_called_from_goal(hlds_goal::in,
|
|
list({pred_id, list(prog_var)})::out) is det.
|
|
|
|
% Returns all the pred_proc_ids that are called from a goal.
|
|
%
|
|
:- pred pred_proc_ids_called_from_goal(hlds_goal::in,
|
|
list(pred_proc_id)::out) is det.
|
|
|
|
:- type goal_is_atomic
|
|
---> goal_is_atomic
|
|
; goal_is_nonatomic.
|
|
|
|
% Returns whether a goal is atomic. This is undefined for shorthand goals.
|
|
%
|
|
:- pred goal_is_atomic(hlds_goal::in, goal_is_atomic::out) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Convert a switch back into a disjunction. This is needed
|
|
% for the magic set transformation.
|
|
% This aborts if any of the constructors are existentially typed.
|
|
%
|
|
:- pred switch_to_disjunction(prog_var::in, list(case)::in,
|
|
instmap::in, list(hlds_goal)::out, prog_varset::in, prog_varset::out,
|
|
vartypes::in, vartypes::out, module_info::in, module_info::out) is det.
|
|
|
|
% Convert a case into a conjunction by adding a tag test
|
|
% (deconstruction unification) to the case goal.
|
|
% This aborts if the constructor is existentially typed.
|
|
%
|
|
:- pred case_to_disjunct(prog_var::in, hlds_goal::in, instmap::in,
|
|
cons_id::in, hlds_goal::out, prog_varset::in, prog_varset::out,
|
|
vartypes::in, vartypes::out, module_info::in, module_info::out) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Flatten the conjuncts of a conjunction.
|
|
% Flattens only one level.
|
|
% XXX Why not all levels recursively, as flatten_disj does?
|
|
%
|
|
:- pred flatten_conj(list(hlds_goal)::in, list(hlds_goal)::out) is det.
|
|
|
|
% Flatten the disjuncts of a disjunction.
|
|
% Flattens all levels recursively.
|
|
%
|
|
:- pred flatten_disj(list(hlds_goal)::in, list(hlds_goal)::out) is det.
|
|
|
|
% Create a conjunction of the specified type using the specified goals,
|
|
% This fills in the hlds_goal_info.
|
|
%
|
|
:- pred create_conj_from_list(list(hlds_goal)::in, conj_type::in,
|
|
hlds_goal::out) is det.
|
|
|
|
% Create a conjunction of the specified type using the specified two goals.
|
|
% This fills in the hlds_goal_info.
|
|
%
|
|
:- pred create_conj(hlds_goal::in, hlds_goal::in, conj_type::in,
|
|
hlds_goal::out) is det.
|
|
|
|
% can_reorder_goals_old(ModuleInfo, VarTypes, FullyStrict,
|
|
% InstmapBeforeGoal1, Goal1, InstmapBeforeGoal2, Goal2).
|
|
%
|
|
% Goals can be reordered if
|
|
% - the goals are independent
|
|
% - the goals are not impure
|
|
% - any possible change in termination behaviour is allowed according
|
|
% to the semantics options.
|
|
%
|
|
% NOTE: this version is deprecated; new code should use the following
|
|
% version because it supports the intermodule-analysis framework.
|
|
%
|
|
:- pred can_reorder_goals_old(module_info::in, vartypes::in, bool::in,
|
|
instmap::in, hlds_goal::in, instmap::in, hlds_goal::in) is semidet.
|
|
|
|
% can_reorder_goals(VarTypes, FullyStrict, InstmapBeforeGoal1, Goal1,
|
|
% InstmapBeforeGoal2, Goal2, Result, !ModuleInfo).
|
|
%
|
|
% Result is `yes' if the goals can be reordered; no otherwise.
|
|
%
|
|
% Goals can be reordered if
|
|
% - the goals are independent
|
|
% - the goals are not impure
|
|
% - any possible change in termination behaviour is allowed according
|
|
% to the semantics options.
|
|
%
|
|
% NOTE: new code should use this version as it supports the
|
|
% intermodule-analysis framework.
|
|
%
|
|
:- pred can_reorder_goals(vartypes::in, bool::in, instmap::in,
|
|
hlds_goal::in, instmap::in, hlds_goal::in, bool::out,
|
|
module_info::in, module_info::out) is det.
|
|
|
|
% reordering_maintains_termination_old(ModuleInfo, FullyStrict,
|
|
% Goal1, Goal2).
|
|
%
|
|
% Succeeds if any possible change in termination behaviour from reordering
|
|
% the goals is allowed according to the semantics options.
|
|
% The information computed by termination and exception analyses is used
|
|
% when making this decision.
|
|
%
|
|
% NOTE: this version is deprecated; new code should use the following
|
|
% version because it supports the intermodule-analysis framework.
|
|
%
|
|
:- pred reordering_maintains_termination_old(module_info::in, bool::in,
|
|
hlds_goal::in, hlds_goal::in) is semidet.
|
|
|
|
% reordering_maintains_termination(FullyStrict, Goal1, Goal2, Result,
|
|
% !ModuleInfo, !IO).
|
|
%
|
|
% Result is `yes' if any possible change in termination behaviour from
|
|
% reordering the goals is allowed according to the semantics options.
|
|
% The information computed by termination and exception analyses is used
|
|
% when making this decision.
|
|
%
|
|
% NOTE: new code should use this version as it supports the
|
|
% intermodule-analysis framework.
|
|
%
|
|
:- pred reordering_maintains_termination(bool::in, hlds_goal::in,
|
|
hlds_goal::in, bool::out, module_info::in, module_info::out) is det.
|
|
|
|
% generate_simple_call(ModuleInfo, ModuleName, ProcName, PredOrFunc,
|
|
% ModeNo, Detism, Purity, Args, Features, InstMapDelta, Context,
|
|
% CallGoal):
|
|
%
|
|
% Generate a call to a builtin procedure (e.g. from the private_builtin
|
|
% or table_builtin module). This is used by HLDS->HLDS transformation
|
|
% passes that introduce calls to builtin procedures.
|
|
%
|
|
% If ModeNo = only_mode, then the predicate must have exactly one
|
|
% procedure; an error is raised if this is not the case.
|
|
%
|
|
% If ModeNo = mode_no(N) then the Nth procedure is used, counting from 0.
|
|
%
|
|
:- pred generate_simple_call(module_info::in, module_name::in, string::in,
|
|
pred_or_func::in, mode_no::in, determinism::in, purity::in,
|
|
list(prog_var)::in, list(goal_feature)::in, instmap_delta::in,
|
|
term.context::in, hlds_goal::out) is det.
|
|
|
|
% generate_foreign_proc(ModuleInfo, ModuleName, ProcName, PredOrFunc,
|
|
% ModeNo, Detism, Purity, Attributes, Args, ExtraArgs,
|
|
% MaybeTraceRuntimeCond, Code, Features, InstMapDelta, Context,
|
|
% CallGoal):
|
|
%
|
|
% generate_foreign_proc is similar to generate_simple_call,
|
|
% but also assumes that the called predicate is defined via a
|
|
% foreign_proc, that the foreign_proc's arguments are as given in
|
|
% Args, its attributes are Attributes, and its code is Code.
|
|
% As well as returning a foreign_code instead of a call, effectively
|
|
% inlining the call, generate_foreign_proc also passes ExtraArgs
|
|
% as well as Args.
|
|
%
|
|
:- pred generate_foreign_proc(module_info::in, module_name::in, string::in,
|
|
pred_or_func::in, mode_no::in, determinism::in, purity::in,
|
|
pragma_foreign_proc_attributes::in,
|
|
list(foreign_arg)::in, list(foreign_arg)::in,
|
|
maybe(trace_expr(trace_runtime))::in, string::in,
|
|
list(goal_feature)::in, instmap_delta::in,
|
|
term.context::in, hlds_goal::out) is det.
|
|
|
|
% Generate a cast goal. The input and output insts are just ground.
|
|
%
|
|
:- pred generate_cast(cast_kind::in, prog_var::in, prog_var::in,
|
|
prog_context::in, hlds_goal::out) is det.
|
|
|
|
% This version takes input and output inst arguments, which may be
|
|
% necessary when casting, say, solver type values with inst any,
|
|
% or casting between enumeration types and ints.
|
|
%
|
|
:- pred generate_cast_with_insts(cast_kind::in, prog_var::in, prog_var::in,
|
|
mer_inst::in, mer_inst::in, prog_context::in, hlds_goal::out) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred foreign_proc_uses_variable(pragma_foreign_proc_impl::in, string::in)
|
|
is semidet.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- func maybe_strip_equality_pretest(hlds_goal) = hlds_goal.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- type maybe_transformed_goal
|
|
---> ok(hlds_goal)
|
|
; error(string)
|
|
; goal_not_found.
|
|
|
|
% Locate the goal described by the goal path and use its first argument to
|
|
% transform that goal before rebuilding the goal tree and returning.
|
|
% If the goal is not found, the result is no. If the result of the higher
|
|
% order argument is no, then the result is no.
|
|
%
|
|
:- pred maybe_transform_goal_at_goal_path(
|
|
pred(hlds_goal, maybe_error(hlds_goal))::in(pred(in, out) is det),
|
|
forward_goal_path::in, hlds_goal::in, maybe_transformed_goal::out) is det.
|
|
|
|
% As above, except that we also compute the instmap during the traversal so
|
|
% that the transformation expressed by the higher order value can use the
|
|
% instmap at that point within the goal tree.
|
|
%
|
|
:- pred maybe_transform_goal_at_goal_path_with_instmap(
|
|
pred(instmap, hlds_goal, maybe_error(hlds_goal))::
|
|
in(pred(in, in, out) is det),
|
|
forward_goal_path::in, instmap::in, hlds_goal::in,
|
|
maybe_transformed_goal::out) is det.
|
|
|
|
% Transform the given goal and all its children according to the higher
|
|
% order argument. Children are transformed before their parents, therefore
|
|
% the higher order argument will receive a goal with children that have
|
|
% already been transformed.
|
|
%
|
|
:- pred transform_all_goals(
|
|
pred(hlds_goal, hlds_goal)::in(pred(in, out) is det),
|
|
hlds_goal::in, hlds_goal::out) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module check_hlds.
|
|
:- import_module check_hlds.inst_util.
|
|
:- import_module check_hlds.type_util.
|
|
:- import_module hlds.goal_form.
|
|
:- import_module parse_tree.prog_detism.
|
|
:- import_module parse_tree.prog_mode.
|
|
:- import_module parse_tree.prog_type.
|
|
:- import_module parse_tree.prog_util.
|
|
|
|
:- import_module int.
|
|
:- import_module map.
|
|
:- import_module pair.
|
|
:- import_module require.
|
|
:- import_module solutions.
|
|
:- import_module string.
|
|
:- import_module varset.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
update_instmap(hlds_goal(_GoalExpr0, GoalInfo0), !InstMap) :-
|
|
DeltaInstMap = goal_info_get_instmap_delta(GoalInfo0),
|
|
apply_instmap_delta(DeltaInstMap, !InstMap).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
create_renaming(OrigVars, InstMapDelta, !VarSet, !VarTypes, Unifies, NewVars,
|
|
Renaming) :-
|
|
create_renaming_2(OrigVars, InstMapDelta, !VarSet, !VarTypes,
|
|
[], RevUnifies, [], RevNewVars, map.init, Renaming),
|
|
list.reverse(RevNewVars, NewVars),
|
|
list.reverse(RevUnifies, Unifies).
|
|
|
|
:- pred create_renaming_2(list(prog_var)::in, instmap_delta::in,
|
|
prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
|
|
list(hlds_goal)::in, list(hlds_goal)::out,
|
|
list(prog_var)::in, list(prog_var)::out,
|
|
prog_var_renaming::in, prog_var_renaming::out) is det.
|
|
|
|
create_renaming_2([], _, !VarSet, !VarTypes, !RevUnifies, !RevNewVars,
|
|
!Renaming).
|
|
create_renaming_2([OrigVar | OrigVars], InstMapDelta, !VarSet, !VarTypes,
|
|
!RevUnifies, !RevNewVars, !Renaming) :-
|
|
varset.new_var(NewVar, !VarSet),
|
|
lookup_var_type(!.VarTypes, OrigVar, Type),
|
|
add_var_type(NewVar, Type, !VarTypes),
|
|
instmap_delta_lookup_var(InstMapDelta, OrigVar, NewInst),
|
|
UnifyMode = unify_modes_li_lf_ri_rf(NewInst, NewInst, free, NewInst),
|
|
Unification = assign(OrigVar, NewVar),
|
|
UnifyContext = unify_context(umc_explicit, []),
|
|
GoalExpr = unify(OrigVar, rhs_var(NewVar), UnifyMode, Unification,
|
|
UnifyContext),
|
|
set_of_var.list_to_set([OrigVar, NewVar], NonLocals),
|
|
UnifyInstMapDelta = instmap_delta_from_assoc_list([OrigVar - NewInst]),
|
|
goal_info_init(NonLocals, UnifyInstMapDelta, detism_det, purity_pure,
|
|
term.context_init, GoalInfo),
|
|
Goal = hlds_goal(GoalExpr, GoalInfo),
|
|
!:RevUnifies = [Goal | !.RevUnifies],
|
|
map.det_insert(OrigVar, NewVar, !Renaming),
|
|
!:RevNewVars = [NewVar | !.RevNewVars],
|
|
create_renaming_2(OrigVars, InstMapDelta, !VarSet, !VarTypes,
|
|
!RevUnifies, !RevNewVars, !Renaming).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
clone_variable(Var, OldVarNames, OldVarTypes, !VarSet, !VarTypes, !Renaming,
|
|
CloneVar) :-
|
|
( if map.search(!.Renaming, Var, CloneVarPrime) then
|
|
CloneVar = CloneVarPrime
|
|
else
|
|
( if varset.search_name(OldVarNames, Var, Name) then
|
|
varset.new_named_var(Name, CloneVar, !VarSet)
|
|
else
|
|
varset.new_var(CloneVar, !VarSet)
|
|
),
|
|
map.det_insert(Var, CloneVar, !Renaming),
|
|
( if search_var_type(OldVarTypes, Var, VarType) then
|
|
add_var_type(CloneVar, VarType, !VarTypes)
|
|
else
|
|
% This should never happen after typechecking, but may happen
|
|
% before it.
|
|
true
|
|
)
|
|
).
|
|
|
|
clone_variables([], _, _, !VarSet, !VarTypes, !Renaming).
|
|
clone_variables([Var | Vars], OldVarNames, OldVarTypes, !VarSet, !VarTypes,
|
|
!Renaming) :-
|
|
clone_variable(Var, OldVarNames, OldVarTypes, !VarSet, !VarTypes,
|
|
!Renaming, _CloneVar),
|
|
clone_variables(Vars, OldVarNames, OldVarTypes, !VarSet, !VarTypes,
|
|
!Renaming).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
goal_vars(Goal, !:Set) :-
|
|
!:Set = set_of_var.init,
|
|
goal_vars_acc(Goal, !Set).
|
|
|
|
goals_goal_vars(Goals, !:Set) :-
|
|
!:Set = set_of_var.init,
|
|
goals_goal_vars_acc(Goals, !Set).
|
|
|
|
:- pred goal_vars_acc(hlds_goal::in,
|
|
set_of_progvar::in, set_of_progvar::out) is det.
|
|
|
|
goal_vars_acc(Goal, !Set) :-
|
|
Goal = hlds_goal(GoalExpr, _GoalInfo),
|
|
(
|
|
GoalExpr = unify(Var, RHS, _, Unif, _),
|
|
set_of_var.insert(Var, !Set),
|
|
(
|
|
Unif = construct(_, _, _, _, CellToReuse, _, _),
|
|
( if CellToReuse = reuse_cell(cell_to_reuse(Var, _, _)) then
|
|
set_of_var.insert(Var, !Set)
|
|
else
|
|
true
|
|
)
|
|
;
|
|
( Unif = deconstruct(_, _, _, _, _, _)
|
|
; Unif = assign(_, _)
|
|
; Unif = simple_test(_, _)
|
|
; Unif = complicated_unify(_, _, _)
|
|
)
|
|
),
|
|
rhs_goal_vars_acc(RHS, !Set)
|
|
;
|
|
GoalExpr = generic_call(GenericCall, ArgVars, _, _, _),
|
|
generic_call_vars(GenericCall, GenericCallVars),
|
|
set_of_var.insert_list(GenericCallVars, !Set),
|
|
set_of_var.insert_list(ArgVars, !Set)
|
|
;
|
|
GoalExpr = plain_call(_, _, ArgVars, _, _, _),
|
|
set_of_var.insert_list(ArgVars, !Set)
|
|
;
|
|
( GoalExpr = conj(_, Goals)
|
|
; GoalExpr = disj(Goals)
|
|
),
|
|
goals_goal_vars_acc(Goals, !Set)
|
|
;
|
|
GoalExpr = switch(Var, _Det, Cases),
|
|
set_of_var.insert(Var, !Set),
|
|
cases_goal_vars_acc(Cases, !Set)
|
|
;
|
|
GoalExpr = scope(Reason, SubGoal),
|
|
(
|
|
Reason = exist_quant(Vars),
|
|
set_of_var.insert_list(Vars, !Set)
|
|
;
|
|
Reason = promise_solutions(Vars, _),
|
|
set_of_var.insert_list(Vars, !Set)
|
|
;
|
|
Reason = from_ground_term(Var, _),
|
|
set_of_var.insert(Var, !Set)
|
|
;
|
|
( Reason = require_complete_switch(Var)
|
|
; Reason = require_switch_arms_detism(Var, _)
|
|
),
|
|
set_of_var.insert(Var, !Set)
|
|
;
|
|
Reason = loop_control(LCVar, LCSVar, _),
|
|
set_of_var.insert(LCVar, !Set),
|
|
set_of_var.insert(LCSVar, !Set)
|
|
;
|
|
( Reason = disable_warnings(_, _)
|
|
; Reason = promise_purity(_)
|
|
; Reason = require_detism(_)
|
|
; Reason = commit(_)
|
|
; Reason = barrier(_)
|
|
; Reason = trace_goal(_, _, _, _, _)
|
|
)
|
|
),
|
|
goal_vars_acc(SubGoal, !Set)
|
|
;
|
|
GoalExpr = negation(SubGoal),
|
|
goal_vars_acc(SubGoal, !Set)
|
|
;
|
|
GoalExpr = if_then_else(Vars, Cond, Then, Else),
|
|
set_of_var.insert_list(Vars, !Set),
|
|
goal_vars_acc(Cond, !Set),
|
|
goal_vars_acc(Then, !Set),
|
|
goal_vars_acc(Else, !Set)
|
|
;
|
|
GoalExpr = call_foreign_proc(_, _, _, Args, ExtraArgs, _, _),
|
|
ArgVars = list.map(foreign_arg_var, Args),
|
|
ExtraVars = list.map(foreign_arg_var, ExtraArgs),
|
|
set_of_var.insert_list(ArgVars, !Set),
|
|
set_of_var.insert_list(ExtraVars, !Set)
|
|
;
|
|
GoalExpr = shorthand(Shorthand),
|
|
(
|
|
Shorthand = atomic_goal(_, Outer, Inner, MaybeOutputVars,
|
|
MainGoal, OrElseGoals, _),
|
|
Outer = atomic_interface_vars(OuterDI, OuterUO),
|
|
set_of_var.insert(OuterDI, !Set),
|
|
set_of_var.insert(OuterUO, !Set),
|
|
Inner = atomic_interface_vars(InnerDI, InnerUO),
|
|
set_of_var.insert(InnerDI, !Set),
|
|
set_of_var.insert(InnerUO, !Set),
|
|
(
|
|
MaybeOutputVars = no
|
|
;
|
|
MaybeOutputVars = yes(OutputVars),
|
|
set_of_var.insert_list(OutputVars, !Set)
|
|
),
|
|
goal_vars_acc(MainGoal, !Set),
|
|
goals_goal_vars_acc(OrElseGoals, !Set)
|
|
;
|
|
Shorthand = try_goal(_, _, SubGoal),
|
|
% The IO and Result variables would be in SubGoal.
|
|
goal_vars_acc(SubGoal, !Set)
|
|
;
|
|
Shorthand = bi_implication(LeftGoal, RightGoal),
|
|
goal_vars_acc(LeftGoal, !Set),
|
|
goal_vars_acc(RightGoal, !Set)
|
|
)
|
|
).
|
|
|
|
:- pred goals_goal_vars_acc(list(hlds_goal)::in,
|
|
set_of_progvar::in, set_of_progvar::out) is det.
|
|
|
|
goals_goal_vars_acc([], !Set).
|
|
goals_goal_vars_acc([Goal | Goals], !Set) :-
|
|
goal_vars_acc(Goal, !Set),
|
|
goals_goal_vars_acc(Goals, !Set).
|
|
|
|
:- pred cases_goal_vars_acc(list(case)::in,
|
|
set_of_progvar::in, set_of_progvar::out) is det.
|
|
|
|
cases_goal_vars_acc([], !Set).
|
|
cases_goal_vars_acc([case(_, _, Goal) | Cases], !Set) :-
|
|
goal_vars_acc(Goal, !Set),
|
|
cases_goal_vars_acc(Cases, !Set).
|
|
|
|
:- pred rhs_goal_vars_acc(unify_rhs::in,
|
|
set_of_progvar::in, set_of_progvar::out) is det.
|
|
|
|
rhs_goal_vars_acc(RHS, !Set) :-
|
|
(
|
|
RHS = rhs_var(X),
|
|
set_of_var.insert(X, !Set)
|
|
;
|
|
RHS = rhs_functor(_Functor, _, ArgVars),
|
|
set_of_var.insert_list(ArgVars, !Set)
|
|
;
|
|
RHS = rhs_lambda_goal(_, _, _, _, NonLocals, LambdaVars, _, _, Goal),
|
|
set_of_var.insert_list(NonLocals, !Set),
|
|
set_of_var.insert_list(LambdaVars, !Set),
|
|
goal_vars_acc(Goal, !Set)
|
|
).
|
|
|
|
generic_call_vars(higher_order(Var, _, _, _), [Var]).
|
|
generic_call_vars(class_method(Var, _, _, _), [Var]).
|
|
generic_call_vars(event_call(_), []).
|
|
generic_call_vars(cast(_), []).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
attach_features_to_all_goals(Features, InFromGroundTerm, Goal0, Goal) :-
|
|
Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
|
|
attach_features_to_goal_expr(Features, InFromGroundTerm,
|
|
GoalExpr0, GoalExpr),
|
|
list.foldl(goal_info_add_feature, Features, GoalInfo0, GoalInfo),
|
|
Goal = hlds_goal(GoalExpr, GoalInfo).
|
|
|
|
:- pred attach_features_to_goals(list(goal_feature),
|
|
attach_in_from_ground_term, list(hlds_goal), list(hlds_goal)).
|
|
:- mode attach_features_to_goals(in,
|
|
in(bound(attach_in_from_ground_term)), in, out) is det.
|
|
:- mode attach_features_to_goals(in,
|
|
in(bound(do_not_attach_in_from_ground_term)), in, out) is det.
|
|
|
|
attach_features_to_goals(_Features, _InFromGroundTerm, [], []).
|
|
attach_features_to_goals(Features, InFromGroundTerm,
|
|
[Goal0 | Goals0], [Goal | Goals]) :-
|
|
attach_features_to_all_goals(Features, InFromGroundTerm, Goal0, Goal),
|
|
attach_features_to_goals(Features, InFromGroundTerm, Goals0, Goals).
|
|
|
|
:- pred attach_features_to_cases(list(goal_feature),
|
|
attach_in_from_ground_term, list(case), list(case)).
|
|
:- mode attach_features_to_cases(in,
|
|
in(bound(attach_in_from_ground_term)), in, out) is det.
|
|
:- mode attach_features_to_cases(in,
|
|
in(bound(do_not_attach_in_from_ground_term)), in, out) is det.
|
|
|
|
attach_features_to_cases(_Features, _InFromGroundTerm, [], []).
|
|
attach_features_to_cases(Features, InFromGroundTerm,
|
|
[Case0 | Cases0], [Case | Cases]) :-
|
|
Case0 = case(MainConsId, OtherConsIds, Goal0),
|
|
attach_features_to_all_goals(Features, InFromGroundTerm, Goal0, Goal),
|
|
Case = case(MainConsId, OtherConsIds, Goal),
|
|
attach_features_to_cases(Features, InFromGroundTerm, Cases0, Cases).
|
|
|
|
:- pred attach_features_to_goal_expr(list(goal_feature),
|
|
attach_in_from_ground_term, hlds_goal_expr, hlds_goal_expr).
|
|
:- mode attach_features_to_goal_expr(in,
|
|
in(bound(attach_in_from_ground_term)), in, out) is det.
|
|
:- mode attach_features_to_goal_expr(in,
|
|
in(bound(do_not_attach_in_from_ground_term)), in, out) is det.
|
|
|
|
attach_features_to_goal_expr(Features, InFromGroundTerm,
|
|
GoalExpr0, GoalExpr) :-
|
|
(
|
|
( GoalExpr0 = plain_call(_, _, _, _, _, _)
|
|
; GoalExpr0 = generic_call(_, _, _, _, _)
|
|
; GoalExpr0 = unify(_, _, _, _, _)
|
|
; GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _)
|
|
),
|
|
GoalExpr = GoalExpr0
|
|
;
|
|
GoalExpr0 = conj(ConjType, Goals0),
|
|
attach_features_to_goals(Features, InFromGroundTerm, Goals0, Goals),
|
|
GoalExpr = conj(ConjType, Goals)
|
|
;
|
|
GoalExpr0 = disj(Goals0),
|
|
attach_features_to_goals(Features, InFromGroundTerm, Goals0, Goals),
|
|
GoalExpr = disj(Goals)
|
|
;
|
|
GoalExpr0 = switch(Var, CanFail, Cases0),
|
|
attach_features_to_cases(Features, InFromGroundTerm, Cases0, Cases),
|
|
GoalExpr = switch(Var, CanFail, Cases)
|
|
;
|
|
GoalExpr0 = if_then_else(Vars, Cond0, Then0, Else0),
|
|
attach_features_to_all_goals(Features, InFromGroundTerm, Cond0, Cond),
|
|
attach_features_to_all_goals(Features, InFromGroundTerm, Then0, Then),
|
|
attach_features_to_all_goals(Features, InFromGroundTerm, Else0, Else),
|
|
GoalExpr = if_then_else(Vars, Cond, Then, Else)
|
|
;
|
|
GoalExpr0 = negation(SubGoal0),
|
|
attach_features_to_all_goals(Features, InFromGroundTerm,
|
|
SubGoal0, SubGoal),
|
|
GoalExpr = negation(SubGoal)
|
|
;
|
|
GoalExpr0 = scope(Reason, SubGoal0),
|
|
( if Reason = from_ground_term(_, _) then
|
|
(
|
|
InFromGroundTerm = do_not_attach_in_from_ground_term,
|
|
SubGoal = SubGoal0
|
|
;
|
|
InFromGroundTerm = attach_in_from_ground_term,
|
|
attach_features_to_all_goals(Features, InFromGroundTerm,
|
|
SubGoal0, SubGoal)
|
|
)
|
|
else
|
|
attach_features_to_all_goals(Features, InFromGroundTerm,
|
|
SubGoal0, SubGoal)
|
|
),
|
|
GoalExpr = scope(Reason, SubGoal)
|
|
;
|
|
GoalExpr0 = shorthand(ShortHand0),
|
|
(
|
|
ShortHand0 = atomic_goal(GoalType, Outer, Inner, MaybeOutputVars,
|
|
MainGoal0, OrElseGoals0, OrElseInners),
|
|
attach_features_to_all_goals(Features, InFromGroundTerm,
|
|
MainGoal0, MainGoal),
|
|
attach_features_to_goals(Features, InFromGroundTerm,
|
|
OrElseGoals0, OrElseGoals),
|
|
ShortHand = atomic_goal(GoalType, Outer, Inner, MaybeOutputVars,
|
|
MainGoal, OrElseGoals, OrElseInners)
|
|
;
|
|
ShortHand0 = try_goal(MaybeIO, ResultVar, SubGoal0),
|
|
attach_features_to_all_goals(Features, InFromGroundTerm,
|
|
SubGoal0, SubGoal),
|
|
ShortHand = try_goal(MaybeIO, ResultVar, SubGoal)
|
|
;
|
|
ShortHand0 = bi_implication(GoalA0, GoalB0),
|
|
attach_features_to_all_goals(Features, InFromGroundTerm,
|
|
GoalA0, GoalA),
|
|
attach_features_to_all_goals(Features, InFromGroundTerm,
|
|
GoalB0, GoalB),
|
|
ShortHand = bi_implication(GoalA, GoalB)
|
|
),
|
|
GoalExpr = shorthand(ShortHand)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
extra_nonlocal_typeinfos(RttiVarMaps, VarTypes, ExistQVars,
|
|
NonLocals, NonLocalTypeInfos) :-
|
|
% Find all non-local type vars. That is, type vars that are existentially
|
|
% quantified or type vars that appear in the type of a non-local prog_var.
|
|
|
|
set_of_var.to_sorted_list(NonLocals, NonLocalsList),
|
|
lookup_var_types(VarTypes, NonLocalsList, NonLocalsTypes),
|
|
type_vars_list(NonLocalsTypes, NonLocalTypeVarsList0),
|
|
NonLocalTypeVarsList = ExistQVars ++ NonLocalTypeVarsList0,
|
|
set_of_var.list_to_set(NonLocalTypeVarsList, NonLocalTypeVars),
|
|
|
|
% Find all the type_infos that are non-local, that is, type_infos for
|
|
% type vars that are non-local in the above sense.
|
|
|
|
TypeVarToProgVar = (func(TypeVar) = ProgVar :-
|
|
rtti_lookup_type_info_locn(RttiVarMaps, TypeVar, Locn),
|
|
type_info_locn_var(Locn, ProgVar)
|
|
),
|
|
NonLocalTypeInfoVars = set_of_var.list_to_set(
|
|
list.map(TypeVarToProgVar, NonLocalTypeVarsList)),
|
|
|
|
% Find all the typeclass_infos that are non-local. These include
|
|
% all typeclass_infos that constrain a type variable that is non-local
|
|
% in the above sense.
|
|
|
|
solutions.solutions(
|
|
( pred(Var::out) is nondet :-
|
|
% Search through all arguments of all constraints
|
|
% that the goal could have used.
|
|
rtti_varmaps_reusable_constraints(RttiVarMaps, Constraints),
|
|
list.member(Constraint, Constraints),
|
|
Constraint = constraint(_ClassName, ArgTypes),
|
|
type_list_contains_var(ArgTypes, TypeVar),
|
|
set_of_var.member(NonLocalTypeVars, TypeVar),
|
|
|
|
% We found a constraint that is non-local. Include the variable
|
|
% holding its typeclass_info.
|
|
rtti_lookup_typeclass_info_var(RttiVarMaps, Constraint, Var)
|
|
), NonLocalTypeClassInfoVarsList),
|
|
set_of_var.sorted_list_to_set(NonLocalTypeClassInfoVarsList,
|
|
NonLocalTypeClassInfoVars),
|
|
NonLocalTypeInfos = set_of_var.union(NonLocalTypeInfoVars,
|
|
NonLocalTypeClassInfoVars).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
proc_body_is_leaf(hlds_goal(GoalExpr, _)) = IsLeaf :-
|
|
(
|
|
GoalExpr = unify(_, _, _, UnifyKind, _),
|
|
(
|
|
UnifyKind = complicated_unify(_, _, _),
|
|
IsLeaf = is_not_leaf
|
|
;
|
|
( UnifyKind = construct(_, _, _, _, _, _, _)
|
|
; UnifyKind = deconstruct(_, _, _, _, _, _)
|
|
; UnifyKind = assign(_, _)
|
|
; UnifyKind = simple_test(_, _)
|
|
),
|
|
IsLeaf = is_leaf
|
|
)
|
|
;
|
|
( GoalExpr = plain_call(_, _, _, _, _, _)
|
|
; GoalExpr = generic_call(_, _, _, _, _)
|
|
; GoalExpr = call_foreign_proc(_, _, _, _, _, _, _)
|
|
),
|
|
IsLeaf = is_not_leaf
|
|
;
|
|
( GoalExpr = conj(_, Goals)
|
|
; GoalExpr = disj(Goals)
|
|
),
|
|
IsLeaf = proc_body_is_leaf_goals(Goals)
|
|
;
|
|
GoalExpr = negation(SubGoal),
|
|
IsLeaf = proc_body_is_leaf(SubGoal)
|
|
;
|
|
GoalExpr = scope(Reason, SubGoal),
|
|
( if
|
|
Reason = from_ground_term(_, FGT),
|
|
( FGT = from_ground_term_construct
|
|
; FGT = from_ground_term_deconstruct
|
|
)
|
|
then
|
|
IsLeaf = is_leaf
|
|
else
|
|
IsLeaf = proc_body_is_leaf(SubGoal)
|
|
)
|
|
;
|
|
GoalExpr = switch(_, _, Cases),
|
|
IsLeaf = proc_body_is_leaf_cases(Cases)
|
|
;
|
|
GoalExpr = if_then_else(_, Cond, Then, Else),
|
|
( if
|
|
proc_body_is_leaf(Cond) = is_leaf,
|
|
proc_body_is_leaf(Then) = is_leaf,
|
|
proc_body_is_leaf(Else) = is_leaf
|
|
then
|
|
IsLeaf = is_leaf
|
|
else
|
|
IsLeaf = is_not_leaf
|
|
)
|
|
;
|
|
GoalExpr = shorthand(ShortHand),
|
|
(
|
|
( ShortHand = atomic_goal(_, _, _, _, _, _, _)
|
|
; ShortHand = try_goal(_, _, _)
|
|
),
|
|
IsLeaf = is_not_leaf
|
|
;
|
|
ShortHand = bi_implication(GoalA, GoalB),
|
|
( if
|
|
proc_body_is_leaf(GoalA) = is_leaf,
|
|
proc_body_is_leaf(GoalB) = is_leaf
|
|
then
|
|
IsLeaf = is_leaf
|
|
else
|
|
IsLeaf = is_not_leaf
|
|
)
|
|
)
|
|
).
|
|
|
|
:- func proc_body_is_leaf_goals(list(hlds_goal)) = is_leaf.
|
|
|
|
proc_body_is_leaf_goals([]) = is_leaf.
|
|
proc_body_is_leaf_goals([Goal | Goals]) = IsLeaf :-
|
|
( if
|
|
proc_body_is_leaf(Goal) = is_leaf,
|
|
proc_body_is_leaf_goals(Goals) = is_leaf
|
|
then
|
|
IsLeaf = is_leaf
|
|
else
|
|
IsLeaf = is_not_leaf
|
|
).
|
|
|
|
:- func proc_body_is_leaf_cases(list(case)) = is_leaf.
|
|
|
|
proc_body_is_leaf_cases([]) = is_leaf.
|
|
proc_body_is_leaf_cases([Case | Cases]) = IsLeaf :-
|
|
Case = case(_, _, Goal),
|
|
( if
|
|
proc_body_is_leaf(Goal) = is_leaf,
|
|
proc_body_is_leaf_cases(Cases) = is_leaf
|
|
then
|
|
IsLeaf = is_leaf
|
|
else
|
|
IsLeaf = is_not_leaf
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
goal_is_branched(if_then_else(_, _, _, _)).
|
|
goal_is_branched(switch(_, _, _)).
|
|
goal_is_branched(disj(_)).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
goal_size(hlds_goal(GoalExpr, _), Size) :-
|
|
goal_expr_size(GoalExpr, Size).
|
|
|
|
goals_size([], 0).
|
|
goals_size([Goal | Goals], Size) :-
|
|
goal_size(Goal, Size1),
|
|
goals_size(Goals, Size2),
|
|
Size = Size1 + Size2.
|
|
|
|
clause_list_size(Clauses, GoalSize) :-
|
|
list.foldl(clause_size_increment, Clauses, 0, GoalSize0),
|
|
( if Clauses = [_] then
|
|
GoalSize = GoalSize0
|
|
else
|
|
% Add one for the disjunction.
|
|
GoalSize = GoalSize0 + 1
|
|
).
|
|
|
|
:- pred clause_size_increment(clause::in, int::in, int::out) is det.
|
|
|
|
clause_size_increment(Clause, Size0, Size) :-
|
|
goal_size(Clause ^ clause_body, ClauseSize),
|
|
Size = Size0 + ClauseSize.
|
|
|
|
:- pred cases_size(list(case)::in, int::out) is det.
|
|
|
|
cases_size([], 0).
|
|
cases_size([case(_, _, Goal) | Cases], Size) :-
|
|
goal_size(Goal, Size1),
|
|
cases_size(Cases, Size2),
|
|
Size = Size1 + Size2.
|
|
|
|
:- pred goal_expr_size(hlds_goal_expr::in, int::out) is det.
|
|
|
|
goal_expr_size(GoalExpr, Size) :-
|
|
(
|
|
( GoalExpr = plain_call(_, _, _, _, _, _)
|
|
; GoalExpr = generic_call(_, _, _, _, _)
|
|
; GoalExpr = unify(_, _, _, _, _)
|
|
; GoalExpr = call_foreign_proc(_, _, _, _, _, _, _)
|
|
),
|
|
Size = 1
|
|
;
|
|
GoalExpr = conj(ConjType, Goals),
|
|
goals_size(Goals, InnerSize),
|
|
(
|
|
ConjType = plain_conj,
|
|
Size = InnerSize
|
|
;
|
|
ConjType = parallel_conj,
|
|
Size = InnerSize + 1
|
|
)
|
|
;
|
|
GoalExpr = disj(Goals),
|
|
goals_size(Goals, Size1),
|
|
Size = Size1 + 1
|
|
;
|
|
GoalExpr = switch(_, _, Cases),
|
|
cases_size(Cases, Size1),
|
|
Size = Size1 + 1
|
|
;
|
|
GoalExpr = if_then_else(_, Cond, Then, Else),
|
|
goal_size(Cond, Size1),
|
|
goal_size(Then, Size2),
|
|
goal_size(Else, Size3),
|
|
Size = Size1 + Size2 + Size3 + 1
|
|
;
|
|
GoalExpr = negation(SubGoal),
|
|
goal_size(SubGoal, Size1),
|
|
Size = Size1 + 1
|
|
;
|
|
GoalExpr = scope(Reason, SubGoal),
|
|
( if Reason = from_ground_term(_, from_ground_term_construct) then
|
|
% These scopes get turned into a single assignment.
|
|
Size = 1
|
|
else
|
|
goal_size(SubGoal, Size1),
|
|
Size = Size1 + 1
|
|
)
|
|
;
|
|
GoalExpr = shorthand(ShortHand),
|
|
(
|
|
ShortHand = atomic_goal(_, _, _, _, MainGoal, OrElseGoals, _),
|
|
goal_size(MainGoal, Size1),
|
|
goals_size(OrElseGoals, Size2),
|
|
Size = Size1 + Size2 + 1
|
|
;
|
|
ShortHand = try_goal(_, _, SubGoal),
|
|
% Hopefully this size isn't too important as the SubGoal is not yet
|
|
% in the final form.
|
|
goal_size(SubGoal, Size)
|
|
;
|
|
ShortHand = bi_implication(GoalA, GoalB),
|
|
goal_size(GoalA, Size1),
|
|
goal_size(GoalB, Size2),
|
|
Size = Size1 + Size2 + 1
|
|
)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
goals_proc_refs(Goals) = ReferredToProcs :-
|
|
list.foldl(goal_proc_refs_acc, Goals, set.init, ReferredToProcs).
|
|
|
|
goal_proc_refs(Goal) = ReferredToProcs :-
|
|
goal_proc_refs_acc(Goal, set.init, ReferredToProcs).
|
|
|
|
:- pred goal_proc_refs_acc(hlds_goal::in,
|
|
set(pred_proc_id)::in, set(pred_proc_id)::out) is det.
|
|
|
|
goal_proc_refs_acc(Goal, !ReferredToProcs) :-
|
|
Goal = hlds_goal(GoalExpr, _GoalInfo),
|
|
(
|
|
GoalExpr = conj(_ConjType, Conjuncts),
|
|
list.foldl(goal_proc_refs_acc, Conjuncts, !ReferredToProcs)
|
|
;
|
|
GoalExpr = disj(Disjuncts),
|
|
list.foldl(goal_proc_refs_acc, Disjuncts, !ReferredToProcs)
|
|
;
|
|
GoalExpr = switch(_, _, Cases),
|
|
list.foldl(case_proc_refs_acc, Cases, !ReferredToProcs)
|
|
;
|
|
GoalExpr = if_then_else(_, Cond, Then, Else),
|
|
goal_proc_refs_acc(Cond, !ReferredToProcs),
|
|
goal_proc_refs_acc(Then, !ReferredToProcs),
|
|
goal_proc_refs_acc(Else, !ReferredToProcs)
|
|
;
|
|
GoalExpr = negation(SubGoal),
|
|
goal_proc_refs_acc(SubGoal, !ReferredToProcs)
|
|
;
|
|
GoalExpr = scope(Reason, SubGoal),
|
|
( if
|
|
Reason = from_ground_term(_, FGT),
|
|
( FGT = from_ground_term_construct
|
|
; FGT = from_ground_term_deconstruct
|
|
)
|
|
then
|
|
% These goals contain only construction and deconstruction
|
|
% unifications respectively.
|
|
true
|
|
else
|
|
goal_proc_refs_acc(SubGoal, !ReferredToProcs)
|
|
)
|
|
;
|
|
GoalExpr = shorthand(Shorthand),
|
|
(
|
|
Shorthand = bi_implication(SubGoalA, SubGoalB),
|
|
goal_proc_refs_acc(SubGoalA, !ReferredToProcs),
|
|
goal_proc_refs_acc(SubGoalB, !ReferredToProcs)
|
|
;
|
|
Shorthand = atomic_goal(_, _, _, _, MainGoal, OrElseGoals, _),
|
|
goal_proc_refs_acc(MainGoal, !ReferredToProcs),
|
|
list.foldl(goal_proc_refs_acc, OrElseGoals, !ReferredToProcs)
|
|
;
|
|
Shorthand = try_goal(_, _, SubGoal),
|
|
goal_proc_refs_acc(SubGoal, !ReferredToProcs)
|
|
)
|
|
;
|
|
( GoalExpr = plain_call(PredId, ProcId, _, _, _, _)
|
|
; GoalExpr = call_foreign_proc(_, PredId, ProcId, _, _, _, _)
|
|
),
|
|
PredProcId = proc(PredId, ProcId),
|
|
set.insert(PredProcId, !ReferredToProcs)
|
|
;
|
|
GoalExpr = unify(_LHS, RHS, _, Unification, _),
|
|
(
|
|
RHS = rhs_var(_)
|
|
;
|
|
RHS = rhs_functor(RHSConsId, _IsExistConstruct, _ArgVars),
|
|
cons_id_proc_refs_acc(RHSConsId, !ReferredToProcs)
|
|
;
|
|
RHS = rhs_lambda_goal(_, _, _, _, _, _, _, _, SubGoal),
|
|
goal_proc_refs_acc(SubGoal, !ReferredToProcs)
|
|
),
|
|
(
|
|
Unification = construct(_LHSVar, ConstructConsId, _RHSVars,
|
|
_ArgModes, _How, _IsUnique, _SubInfo),
|
|
cons_id_proc_refs_acc(ConstructConsId, !ReferredToProcs)
|
|
;
|
|
( Unification = deconstruct(_, _, _, _, _, _)
|
|
; Unification = assign(_, _)
|
|
; Unification = simple_test(_, _)
|
|
; Unification = complicated_unify(_, _, _)
|
|
)
|
|
)
|
|
;
|
|
GoalExpr = generic_call(_, _, _, _, _)
|
|
).
|
|
|
|
:- pred case_proc_refs_acc(case::in,
|
|
set(pred_proc_id)::in, set(pred_proc_id)::out) is det.
|
|
|
|
case_proc_refs_acc(Case, !ReferredToProcs) :-
|
|
Case = case(_MainConsId, _OtherConsIds, Goal),
|
|
goal_proc_refs_acc(Goal, !ReferredToProcs).
|
|
|
|
:- pred cons_id_proc_refs_acc(cons_id::in,
|
|
set(pred_proc_id)::in, set(pred_proc_id)::out) is det.
|
|
|
|
cons_id_proc_refs_acc(ConsId, !ReferredToProcs) :-
|
|
(
|
|
( ConsId = cons(_, _, _)
|
|
; ConsId = tuple_cons(_)
|
|
; ConsId = int_const(_)
|
|
; ConsId = uint_const(_)
|
|
; ConsId = int8_const(_)
|
|
; ConsId = uint8_const(_)
|
|
; ConsId = int16_const(_)
|
|
; ConsId = uint16_const(_)
|
|
; ConsId = int32_const(_)
|
|
; ConsId = uint32_const(_)
|
|
; ConsId = int64_const(_)
|
|
; ConsId = uint64_const(_)
|
|
; ConsId = float_const(_)
|
|
; ConsId = char_const(_)
|
|
; ConsId = string_const(_)
|
|
; ConsId = impl_defined_const(_)
|
|
; ConsId = type_ctor_info_const(_, _, _)
|
|
; ConsId = base_typeclass_info_const(_, _, _, _)
|
|
; ConsId = type_info_cell_constructor(_)
|
|
; ConsId = typeclass_info_cell_constructor
|
|
; ConsId = type_info_const(_)
|
|
; ConsId = typeclass_info_const(_)
|
|
; ConsId = ground_term_const(_, _)
|
|
; ConsId = tabling_info_const(_)
|
|
; ConsId = table_io_entry_desc(_)
|
|
; ConsId = deep_profiling_proc_layout(_)
|
|
)
|
|
;
|
|
ConsId = closure_cons(ShroudedPredProcId, _LambdaMethod),
|
|
PredProcId = unshroud_pred_proc_id(ShroudedPredProcId),
|
|
set.insert(PredProcId, !ReferredToProcs)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% We could implement goal_calls as
|
|
% goal_calls(Goal, proc(PredId, ProcId)) :-
|
|
% goal_contains_subgoal(Goal, plain_call(PredId, ProcId, _, _, _, _)).
|
|
% but the following is more efficient in the (in, in) mode
|
|
% since it avoids creating any choice points.
|
|
%
|
|
|
|
% XXX STM
|
|
% split this predicate into two:
|
|
% goal_calls_this_proc(Goal, PredProcId) = bool
|
|
% all_called_procs_in_goal(Goal) = cord(pred_proc_id)
|
|
|
|
goal_calls(hlds_goal(GoalExpr, _), PredProcId) :-
|
|
goal_expr_calls(GoalExpr, PredProcId).
|
|
|
|
:- pred goals_calls(list(hlds_goal), pred_proc_id).
|
|
:- mode goals_calls(in, in) is semidet.
|
|
:- mode goals_calls(in, out) is nondet.
|
|
|
|
goals_calls([Goal | Goals], PredProcId) :-
|
|
(
|
|
goal_calls(Goal, PredProcId)
|
|
;
|
|
goals_calls(Goals, PredProcId)
|
|
).
|
|
|
|
:- pred cases_calls(list(case), pred_proc_id).
|
|
:- mode cases_calls(in, in) is semidet.
|
|
:- mode cases_calls(in, out) is nondet.
|
|
|
|
cases_calls([case(_, _, Goal) | Cases], PredProcId) :-
|
|
(
|
|
goal_calls(Goal, PredProcId)
|
|
;
|
|
cases_calls(Cases, PredProcId)
|
|
).
|
|
|
|
:- pred goal_expr_calls(hlds_goal_expr, pred_proc_id).
|
|
:- mode goal_expr_calls(in, in) is semidet.
|
|
:- mode goal_expr_calls(in, out) is nondet.
|
|
|
|
goal_expr_calls(GoalExpr, PredProcId) :-
|
|
require_complete_switch [GoalExpr]
|
|
(
|
|
GoalExpr = conj(_ConjType, Conjuncts),
|
|
goals_calls(Conjuncts, PredProcId)
|
|
;
|
|
GoalExpr = disj(Disjuncts),
|
|
goals_calls(Disjuncts, PredProcId)
|
|
;
|
|
GoalExpr = switch(_, _, Cases),
|
|
cases_calls(Cases, PredProcId)
|
|
;
|
|
GoalExpr = if_then_else(_, Cond, Then, Else),
|
|
( goal_calls(Cond, PredProcId)
|
|
; goal_calls(Then, PredProcId)
|
|
; goal_calls(Else, PredProcId)
|
|
)
|
|
;
|
|
GoalExpr = negation(SubGoal),
|
|
goal_calls(SubGoal, PredProcId)
|
|
;
|
|
GoalExpr = scope(Reason, SubGoal),
|
|
( if
|
|
Reason = from_ground_term(_, FGT),
|
|
( FGT = from_ground_term_construct
|
|
; FGT = from_ground_term_deconstruct
|
|
)
|
|
then
|
|
% These goals contain only construction and deconstruction
|
|
% unifications respectively.
|
|
fail
|
|
else
|
|
goal_calls(SubGoal, PredProcId)
|
|
)
|
|
;
|
|
GoalExpr = plain_call(PredId, ProcId, _, _, _, _),
|
|
PredProcId = proc(PredId, ProcId)
|
|
;
|
|
( GoalExpr = generic_call(_, _, _, _, _)
|
|
; GoalExpr = call_foreign_proc(_, _, _, _, _, _, _)
|
|
; GoalExpr = unify(_, _, _, _, _)
|
|
; GoalExpr = shorthand(_)
|
|
),
|
|
fail
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% We could implement goal_calls_pred_id as
|
|
% goal_calls_pred_id(Goal, PredId) :-
|
|
% goal_contains_subgoal(Goal, plain_call(PredId, _, _, _, _, _)).
|
|
% but the following is more efficient in the (in, in) mode
|
|
% since it avoids creating any choice points.
|
|
%
|
|
|
|
goal_calls_pred_id(hlds_goal(GoalExpr, _), PredId) :-
|
|
goal_expr_calls_pred_id(GoalExpr, PredId).
|
|
|
|
:- pred goals_calls_pred_id(list(hlds_goal), pred_id).
|
|
:- mode goals_calls_pred_id(in, in) is semidet.
|
|
:- mode goals_calls_pred_id(in, out) is nondet.
|
|
|
|
goals_calls_pred_id([Goal | Goals], PredId) :-
|
|
(
|
|
goal_calls_pred_id(Goal, PredId)
|
|
;
|
|
goals_calls_pred_id(Goals, PredId)
|
|
).
|
|
|
|
:- pred cases_calls_pred_id(list(case), pred_id).
|
|
:- mode cases_calls_pred_id(in, in) is semidet.
|
|
:- mode cases_calls_pred_id(in, out) is nondet.
|
|
|
|
cases_calls_pred_id([case(_, _, Goal) | Cases], PredId) :-
|
|
(
|
|
goal_calls_pred_id(Goal, PredId)
|
|
;
|
|
cases_calls_pred_id(Cases, PredId)
|
|
).
|
|
|
|
:- pred goal_expr_calls_pred_id(hlds_goal_expr, pred_id).
|
|
:- mode goal_expr_calls_pred_id(in, in) is semidet.
|
|
:- mode goal_expr_calls_pred_id(in, out) is nondet.
|
|
|
|
goal_expr_calls_pred_id(GoalExpr, PredId) :-
|
|
require_complete_switch [GoalExpr]
|
|
(
|
|
GoalExpr = conj(_ConjType, Conjuncts),
|
|
goals_calls_pred_id(Conjuncts, PredId)
|
|
;
|
|
GoalExpr = disj(Disjuncts),
|
|
goals_calls_pred_id(Disjuncts, PredId)
|
|
;
|
|
GoalExpr = switch(_, _, Cases),
|
|
cases_calls_pred_id(Cases, PredId)
|
|
;
|
|
GoalExpr = if_then_else(_, Cond, Then, Else),
|
|
( goal_calls_pred_id(Cond, PredId)
|
|
; goal_calls_pred_id(Then, PredId)
|
|
; goal_calls_pred_id(Else, PredId)
|
|
)
|
|
;
|
|
GoalExpr = negation(SubGoal),
|
|
goal_calls_pred_id(SubGoal, PredId)
|
|
;
|
|
GoalExpr = scope(Reason, SubGoal),
|
|
( if
|
|
Reason = from_ground_term(_, FGT),
|
|
( FGT = from_ground_term_construct
|
|
; FGT = from_ground_term_deconstruct
|
|
)
|
|
then
|
|
% These goals contain only construction and deconstruction
|
|
% unifications respectively.
|
|
fail
|
|
else
|
|
goal_calls_pred_id(SubGoal, PredId)
|
|
)
|
|
;
|
|
GoalExpr = plain_call(PredId, _, _, _, _, _)
|
|
;
|
|
( GoalExpr = generic_call(_, _, _, _, _)
|
|
; GoalExpr = call_foreign_proc(_, _, _, _, _, _, _)
|
|
; GoalExpr = unify(_, _, _, _, _)
|
|
; GoalExpr = shorthand(_)
|
|
),
|
|
fail
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
goal_calls_proc_in_set(Goal, PredProcIds) = CalledPredProcIds :-
|
|
goal_calls_proc_in_set_acc(Goal, PredProcIds,
|
|
set.init, CalledPredProcIds).
|
|
|
|
goal_list_calls_proc_in_set(Goals, PredProcIds) = CalledPredProcIds :-
|
|
goal_list_calls_proc_in_set_acc(Goals, PredProcIds,
|
|
set.init, CalledPredProcIds).
|
|
|
|
:- pred goal_calls_proc_in_set_acc(hlds_goal::in, set(pred_proc_id)::in,
|
|
set(pred_proc_id)::in, set(pred_proc_id)::out) is det.
|
|
|
|
goal_calls_proc_in_set_acc(hlds_goal(GoalExpr, _GoalInfo), PredProcIds,
|
|
!CalledSet) :-
|
|
(
|
|
GoalExpr = unify(_, _, _, _, _)
|
|
;
|
|
GoalExpr = plain_call(PredId, ProcId, _, _, _, _),
|
|
( if set.member(proc(PredId, ProcId), PredProcIds) then
|
|
set.insert(proc(PredId, ProcId), !CalledSet)
|
|
else
|
|
true
|
|
)
|
|
;
|
|
GoalExpr = generic_call(_, _, _, _, _)
|
|
;
|
|
GoalExpr = call_foreign_proc(_, _, _, _, _, _, _)
|
|
;
|
|
GoalExpr = conj(_, Goals),
|
|
goal_list_calls_proc_in_set_acc(Goals, PredProcIds, !CalledSet)
|
|
;
|
|
GoalExpr = disj(Goals),
|
|
goal_list_calls_proc_in_set_acc(Goals, PredProcIds, !CalledSet)
|
|
;
|
|
GoalExpr = switch(_, _, Cases),
|
|
case_list_calls_proc_in_list_acc(Cases, PredProcIds, !CalledSet)
|
|
;
|
|
GoalExpr = if_then_else(_, Cond, Then, Else),
|
|
goal_calls_proc_in_set_acc(Cond, PredProcIds, !CalledSet),
|
|
goal_calls_proc_in_set_acc(Then, PredProcIds, !CalledSet),
|
|
goal_calls_proc_in_set_acc(Else, PredProcIds, !CalledSet)
|
|
;
|
|
GoalExpr = negation(Goal),
|
|
goal_calls_proc_in_set_acc(Goal, PredProcIds, !CalledSet)
|
|
;
|
|
GoalExpr = scope(Reason, Goal),
|
|
( if
|
|
Reason = from_ground_term(_, FGT),
|
|
( FGT = from_ground_term_construct
|
|
; FGT = from_ground_term_deconstruct
|
|
)
|
|
then
|
|
% These goals contain only construction unifications.
|
|
true
|
|
else
|
|
goal_calls_proc_in_set_acc(Goal, PredProcIds, !CalledSet)
|
|
)
|
|
;
|
|
GoalExpr = shorthand(ShortHand),
|
|
(
|
|
ShortHand = atomic_goal(_, _, _, _, MainGoal, OrElseGoals, _),
|
|
goal_calls_proc_in_set_acc(MainGoal, PredProcIds, !CalledSet),
|
|
goal_list_calls_proc_in_set_acc(OrElseGoals, PredProcIds,
|
|
!CalledSet)
|
|
;
|
|
ShortHand = try_goal(_, _, SubGoal),
|
|
goal_calls_proc_in_set_acc(SubGoal, PredProcIds, !CalledSet)
|
|
;
|
|
ShortHand = bi_implication(_, _),
|
|
unexpected($pred, "bi_implication")
|
|
)
|
|
).
|
|
|
|
:- pred goal_list_calls_proc_in_set_acc(list(hlds_goal)::in,
|
|
set(pred_proc_id)::in, set(pred_proc_id)::in, set(pred_proc_id)::out)
|
|
is det.
|
|
|
|
goal_list_calls_proc_in_set_acc([], _, !CalledSet).
|
|
goal_list_calls_proc_in_set_acc([Goal | Goals], PredProcIds, !CalledSet) :-
|
|
goal_calls_proc_in_set_acc(Goal, PredProcIds, !CalledSet),
|
|
goal_list_calls_proc_in_set_acc(Goals, PredProcIds, !CalledSet).
|
|
|
|
:- pred case_list_calls_proc_in_list_acc(list(case)::in, set(pred_proc_id)::in,
|
|
set(pred_proc_id)::in, set(pred_proc_id)::out) is det.
|
|
|
|
case_list_calls_proc_in_list_acc([], _, !CalledSet).
|
|
case_list_calls_proc_in_list_acc([Case | Cases], PredProcIds, !CalledSet) :-
|
|
Case = case(_, _, Goal),
|
|
goal_calls_proc_in_set_acc(Goal, PredProcIds, !CalledSet),
|
|
case_list_calls_proc_in_list_acc(Cases, PredProcIds, !CalledSet).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
goal_contains_reconstruction(Goal, ContainsReconstruction) :-
|
|
Goal = hlds_goal(GoalExpr, _),
|
|
(
|
|
GoalExpr = conj(_ConjType, Conjuncts),
|
|
goals_contain_reconstruction(Conjuncts, ContainsReconstruction)
|
|
;
|
|
GoalExpr = disj(Disjuncts),
|
|
goals_contain_reconstruction(Disjuncts, ContainsReconstruction)
|
|
;
|
|
GoalExpr = switch(_, _, Cases),
|
|
cases_contain_reconstruction(Cases, ContainsReconstruction)
|
|
;
|
|
GoalExpr = if_then_else(_, Cond, Then, Else),
|
|
( if
|
|
( goal_contains_reconstruction(Cond, yes)
|
|
; goal_contains_reconstruction(Then, yes)
|
|
; goal_contains_reconstruction(Else, yes)
|
|
)
|
|
then
|
|
ContainsReconstruction = yes
|
|
else
|
|
ContainsReconstruction = no
|
|
)
|
|
;
|
|
GoalExpr = negation(SubGoal),
|
|
goal_contains_reconstruction(SubGoal, ContainsReconstruction)
|
|
;
|
|
GoalExpr = scope(Reason, SubGoal),
|
|
( if
|
|
Reason = from_ground_term(_, FGT),
|
|
( FGT = from_ground_term_construct
|
|
; FGT = from_ground_term_deconstruct
|
|
)
|
|
then
|
|
% Construct scopes contain only construction unifications
|
|
% that do no reuse. Deconstruct scopes do not contain
|
|
% any constructions at all.
|
|
ContainsReconstruction = no
|
|
else
|
|
goal_contains_reconstruction(SubGoal, ContainsReconstruction)
|
|
)
|
|
;
|
|
GoalExpr = unify(_, _, _, Unify, _),
|
|
( if
|
|
Unify = construct(_, _, _, _, HowToConstruct, _, _),
|
|
HowToConstruct = reuse_cell(_)
|
|
then
|
|
ContainsReconstruction = yes
|
|
else
|
|
ContainsReconstruction = no
|
|
)
|
|
;
|
|
( GoalExpr = plain_call(_, _, _, _, _, _)
|
|
; GoalExpr = generic_call(_, _, _, _, _)
|
|
; GoalExpr = call_foreign_proc(_, _, _, _, _, _, _)
|
|
),
|
|
ContainsReconstruction = no
|
|
;
|
|
GoalExpr = shorthand(Shorthand),
|
|
(
|
|
Shorthand = bi_implication(GoalA, GoalB),
|
|
( if
|
|
goal_contains_reconstruction(GoalA, yes),
|
|
goal_contains_reconstruction(GoalB, yes)
|
|
then
|
|
ContainsReconstruction = yes
|
|
else
|
|
ContainsReconstruction = no
|
|
)
|
|
;
|
|
Shorthand = atomic_goal(_AtomicGoalType, _OuterVars, _InnerVars,
|
|
_OutputVars, MainGoal, OrElseGoals, _Inners),
|
|
( if
|
|
goal_contains_reconstruction(MainGoal, yes),
|
|
goals_contain_reconstruction(OrElseGoals, yes)
|
|
then
|
|
ContainsReconstruction = yes
|
|
else
|
|
ContainsReconstruction = no
|
|
)
|
|
;
|
|
Shorthand = try_goal(_MaybeTryIOStateVars, _ResultVar, SubGoal),
|
|
goal_contains_reconstruction(SubGoal, ContainsReconstruction)
|
|
)
|
|
).
|
|
|
|
:- pred goals_contain_reconstruction(list(hlds_goal)::in, bool::out) is det.
|
|
|
|
goals_contain_reconstruction([], no).
|
|
goals_contain_reconstruction([Goal | Goals], ContainsReconstruction) :-
|
|
goal_contains_reconstruction(Goal, HeadContainsReconstruction),
|
|
(
|
|
HeadContainsReconstruction = yes,
|
|
ContainsReconstruction = yes
|
|
;
|
|
HeadContainsReconstruction = no,
|
|
goals_contain_reconstruction(Goals, ContainsReconstruction)
|
|
).
|
|
|
|
:- pred cases_contain_reconstruction(list(case)::in, bool::out) is det.
|
|
|
|
cases_contain_reconstruction([], no).
|
|
cases_contain_reconstruction([Case | Cases], ContainsReconstruction) :-
|
|
Case = case(_, _, CaseGoal),
|
|
goal_contains_reconstruction(CaseGoal, HeadContainsReconstruction),
|
|
(
|
|
HeadContainsReconstruction = yes,
|
|
ContainsReconstruction = yes
|
|
;
|
|
HeadContainsReconstruction = no,
|
|
cases_contain_reconstruction(Cases, ContainsReconstruction)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
goal_contains_goal(Goal, Goal).
|
|
goal_contains_goal(hlds_goal(GoalExpr, _), SubGoal) :-
|
|
direct_subgoal(GoalExpr, DirectSubGoal),
|
|
goal_contains_goal(DirectSubGoal, SubGoal).
|
|
|
|
direct_subgoal(scope(_, Goal), Goal).
|
|
direct_subgoal(negation(Goal), Goal).
|
|
direct_subgoal(if_then_else(_, Cond, Then, Else), Goal) :-
|
|
( Goal = Cond
|
|
; Goal = Then
|
|
; Goal = Else
|
|
).
|
|
direct_subgoal(conj(_ConjType, ConjList), Goal) :-
|
|
list.member(Goal, ConjList).
|
|
direct_subgoal(disj(DisjList), Goal) :-
|
|
list.member(Goal, DisjList).
|
|
direct_subgoal(switch(_, _, CaseList), Goal) :-
|
|
list.member(Case, CaseList),
|
|
Case = case(_, _, Goal).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
switch_to_disjunction(_, [], _, [], !VarSet, !VarTypes, !ModuleInfo).
|
|
switch_to_disjunction(Var, [Case | Cases], InstMap, Goals,
|
|
!VarSet, !VarTypes, !ModuleInfo) :-
|
|
Case = case(MainConsId, OtherConsIds, CaseGoal),
|
|
case_to_disjunct(Var, CaseGoal, InstMap, MainConsId, MainDisjunctGoal,
|
|
!VarSet, !VarTypes, !ModuleInfo),
|
|
list.map_foldl3(case_to_disjunct(Var, CaseGoal, InstMap),
|
|
OtherConsIds, OtherDisjunctGoals, !VarSet, !VarTypes, !ModuleInfo),
|
|
switch_to_disjunction(Var, Cases, InstMap, CasesGoals, !VarSet, !VarTypes,
|
|
!ModuleInfo),
|
|
Goals = [MainDisjunctGoal | OtherDisjunctGoals] ++ CasesGoals.
|
|
|
|
case_to_disjunct(Var, CaseGoal, InstMap, ConsId, Disjunct, !VarSet, !VarTypes,
|
|
!ModuleInfo) :-
|
|
ConsArity = cons_id_arity(ConsId),
|
|
varset.new_vars(ConsArity, ArgVars, !VarSet),
|
|
lookup_var_type(!.VarTypes, Var, VarType),
|
|
type_util.get_cons_id_arg_types(!.ModuleInfo, VarType, ConsId, ArgTypes),
|
|
vartypes_add_corresponding_lists(ArgVars, ArgTypes, !VarTypes),
|
|
instmap_lookup_var(InstMap, Var, Inst0),
|
|
( if
|
|
inst_expand(!.ModuleInfo, Inst0, Inst1),
|
|
get_arg_insts(Inst1, ConsId, ConsArity, ArgInsts1)
|
|
then
|
|
ArgInsts = ArgInsts1
|
|
else
|
|
unexpected($pred, "get_arg_insts failed")
|
|
),
|
|
InstToArgUnifyMode =
|
|
( pred(ArgInst::in, ArgUnfyiMode::out) is det :-
|
|
ArgUnfyiMode = unify_modes_li_lf_ri_rf(ArgInst, ArgInst,
|
|
free, ArgInst)
|
|
),
|
|
list.map(InstToArgUnifyMode, ArgInsts, UniModes),
|
|
UnifyMode = unify_modes_li_lf_ri_rf(Inst0, Inst0, Inst0, Inst0),
|
|
UnifyContext = unify_context(umc_explicit, []),
|
|
Unification = deconstruct(Var, ConsId, ArgVars, UniModes, can_fail,
|
|
cannot_cgc),
|
|
RHS = rhs_functor(ConsId, is_not_exist_constr, ArgVars),
|
|
ExtraGoalExpr = unify(Var, RHS, UnifyMode, Unification, UnifyContext),
|
|
NonLocals = set_of_var.make_singleton(Var),
|
|
instmap_delta_init_reachable(ExtraInstMapDelta0),
|
|
instmap_delta_bind_var_to_functor(Var, VarType, ConsId, InstMap,
|
|
ExtraInstMapDelta0, ExtraInstMapDelta, !ModuleInfo),
|
|
goal_info_init(NonLocals, ExtraInstMapDelta,
|
|
detism_semi, purity_pure, ExtraGoalInfo),
|
|
|
|
% Conjoin the test and the rest of the case.
|
|
goal_to_conj_list(CaseGoal, CaseGoalConj),
|
|
GoalList = [hlds_goal(ExtraGoalExpr, ExtraGoalInfo) | CaseGoalConj],
|
|
|
|
% Work out the nonlocals, instmap_delta and determinism
|
|
% of the entire conjunction.
|
|
CaseGoal = hlds_goal(_, CaseGoalInfo),
|
|
CaseNonLocals0 = goal_info_get_nonlocals(CaseGoalInfo),
|
|
set_of_var.insert(Var, CaseNonLocals0, CaseNonLocals),
|
|
CaseInstMapDelta = goal_info_get_instmap_delta(CaseGoalInfo),
|
|
instmap_delta_apply_instmap_delta(ExtraInstMapDelta, CaseInstMapDelta,
|
|
test_size, InstMapDelta),
|
|
CaseDetism0 = goal_info_get_determinism(CaseGoalInfo),
|
|
det_conjunction_detism(detism_semi, CaseDetism0, Detism),
|
|
CasePurity = goal_info_get_purity(CaseGoalInfo),
|
|
goal_info_init(CaseNonLocals, InstMapDelta, Detism, CasePurity,
|
|
CombinedGoalInfo),
|
|
Disjunct = hlds_goal(conj(plain_conj, GoalList), CombinedGoalInfo).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
flatten_conj([], []).
|
|
flatten_conj([Goal | Goals0], FlatConj) :-
|
|
flatten_conj(Goals0, FlatConjTail),
|
|
( if Goal = hlds_goal(conj(plain_conj, SubGoals), _) then
|
|
FlatConj = SubGoals ++ FlatConjTail
|
|
else
|
|
FlatConj = [Goal | FlatConjTail]
|
|
).
|
|
|
|
flatten_disj(Disjuncts, FlatDisjuncts) :-
|
|
list.foldr(flatten_disj_acc, Disjuncts, [], FlatDisjuncts).
|
|
|
|
:- pred flatten_disj_acc(hlds_goal::in,
|
|
list(hlds_goal)::in, list(hlds_goal)::out) is det.
|
|
|
|
flatten_disj_acc(Disjunct, !FlatDisjuncts) :-
|
|
( if Disjunct = hlds_goal(disj(SubDisjs), _GoalInfo) then
|
|
list.foldr(flatten_disj_acc, SubDisjs, !FlatDisjuncts)
|
|
else
|
|
!:FlatDisjuncts = [Disjunct | !.FlatDisjuncts]
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
create_conj(GoalA, GoalB, Type, ConjGoal) :-
|
|
create_conj_from_list([GoalA, GoalB], Type, ConjGoal).
|
|
|
|
create_conj_from_list(Conjuncts, ConjType, ConjGoal) :-
|
|
(
|
|
Conjuncts = [HeadGoal | TailGoals],
|
|
(
|
|
TailGoals = [ _ | _ ],
|
|
ConjGoalExpr = conj(ConjType, Conjuncts),
|
|
goal_list_nonlocals(Conjuncts, NonLocals),
|
|
goal_list_instmap_delta(Conjuncts, InstMapDelta),
|
|
goal_list_determinism(Conjuncts, Detism),
|
|
goal_list_purity(Conjuncts, Purity),
|
|
HeadGoal = hlds_goal(_, HeadGoalInfo),
|
|
Context = goal_info_get_context(HeadGoalInfo),
|
|
goal_info_init(NonLocals, InstMapDelta, Detism, Purity, Context,
|
|
ConjGoalInfo),
|
|
ConjGoal = hlds_goal(ConjGoalExpr, ConjGoalInfo)
|
|
;
|
|
TailGoals = [],
|
|
ConjGoal = HeadGoal
|
|
)
|
|
;
|
|
Conjuncts = [],
|
|
unexpected($pred, "empty conjunction")
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
can_reorder_goals_old(ModuleInfo, VarTypes, FullyStrict,
|
|
InstmapBeforeEarlierGoal, EarlierGoal,
|
|
InstmapBeforeLaterGoal, LaterGoal) :-
|
|
% The logic here is mostly duplicated in can_reorder_goals below
|
|
% and in pd_can_reorder_goals in pd_util.m.
|
|
|
|
EarlierGoal = hlds_goal(_, EarlierGoalInfo),
|
|
LaterGoal = hlds_goal(_, LaterGoalInfo),
|
|
|
|
% Impure goals and trace goals cannot be reordered.
|
|
goal_info_get_goal_purity(EarlierGoalInfo, EarlierPurity, EarlierTrace),
|
|
goal_info_get_goal_purity(LaterGoalInfo, LaterPurity, LaterTrace),
|
|
EarlierPurity \= purity_impure,
|
|
LaterPurity \= purity_impure,
|
|
EarlierTrace = contains_no_trace_goal,
|
|
LaterTrace = contains_no_trace_goal,
|
|
|
|
reordering_maintains_termination_old(ModuleInfo, FullyStrict,
|
|
EarlierGoal, LaterGoal),
|
|
|
|
% Don't reorder the goals if the later goal depends on the outputs
|
|
% of the current goal.
|
|
not goal_depends_on_earlier_goal(LaterGoal, EarlierGoal,
|
|
InstmapBeforeEarlierGoal, VarTypes, ModuleInfo),
|
|
|
|
% Don't reorder the goals if the later goal changes the instantiatedness
|
|
% of any of the non-locals of the earlier goal. This is necessary if the
|
|
% later goal clobbers any of the non-locals of the earlier goal, and
|
|
% avoids rerunning full mode analysis in other cases.
|
|
not goal_depends_on_earlier_goal(EarlierGoal, LaterGoal,
|
|
InstmapBeforeLaterGoal, VarTypes, ModuleInfo).
|
|
|
|
can_reorder_goals(VarTypes, FullyStrict, InstmapBeforeEarlierGoal,
|
|
EarlierGoal, InstmapBeforeLaterGoal, LaterGoal, CanReorder,
|
|
!ModuleInfo) :-
|
|
% The logic here is mostly duplicated in can_reorder_goals_old above
|
|
% and in pd_can_reorder_goals in pd_util.m.
|
|
|
|
EarlierGoal = hlds_goal(_, EarlierGoalInfo),
|
|
LaterGoal = hlds_goal(_, LaterGoalInfo),
|
|
|
|
% Impure goals and trace goals cannot be reordered.
|
|
goal_info_get_goal_purity(EarlierGoalInfo, EarlierPurity, EarlierTrace),
|
|
goal_info_get_goal_purity(LaterGoalInfo, LaterPurity, LaterTrace),
|
|
( if
|
|
( EarlierPurity = purity_impure
|
|
; LaterPurity = purity_impure
|
|
; EarlierTrace = contains_trace_goal
|
|
; LaterTrace = contains_trace_goal
|
|
)
|
|
then
|
|
CanReorder = no
|
|
else
|
|
reordering_maintains_termination(FullyStrict,
|
|
EarlierGoal, LaterGoal, MaintainsTermination, !ModuleInfo),
|
|
(
|
|
MaintainsTermination = no,
|
|
CanReorder = no
|
|
;
|
|
MaintainsTermination = yes,
|
|
( if
|
|
% Don't reorder the goals if the later goal depends on the
|
|
% outputs of the current goal.
|
|
%
|
|
goal_depends_on_earlier_goal(LaterGoal, EarlierGoal,
|
|
InstmapBeforeEarlierGoal, VarTypes, !.ModuleInfo)
|
|
then
|
|
CanReorder = no
|
|
else if
|
|
% Don't reorder the goals if the later goal changes the
|
|
% instantiatedness of any of the non-locals of the earlier
|
|
% goal. This is necessary if the later goal clobbers any of
|
|
% the non-locals of the earlier goal, and avoids rerunning
|
|
% full mode analysis in other cases.
|
|
%
|
|
goal_depends_on_earlier_goal(EarlierGoal, LaterGoal,
|
|
InstmapBeforeLaterGoal, VarTypes, !.ModuleInfo)
|
|
then
|
|
CanReorder = no
|
|
else
|
|
CanReorder = yes
|
|
)
|
|
)
|
|
).
|
|
|
|
reordering_maintains_termination_old(ModuleInfo, FullyStrict,
|
|
EarlierGoal, LaterGoal) :-
|
|
EarlierGoal = hlds_goal(_, EarlierGoalInfo),
|
|
LaterGoal = hlds_goal(_, LaterGoalInfo),
|
|
|
|
EarlierDetism = goal_info_get_determinism(EarlierGoalInfo),
|
|
determinism_components(EarlierDetism, EarlierCanFail, _),
|
|
LaterDetism = goal_info_get_determinism(LaterGoalInfo),
|
|
determinism_components(LaterDetism, LaterCanFail, _),
|
|
|
|
% If --fully-strict was specified, don't convert (can_loop, can_fail)
|
|
% into (can_fail, can_loop).
|
|
( if
|
|
FullyStrict = yes,
|
|
not goal_cannot_loop_or_throw(EarlierGoal)
|
|
then
|
|
LaterCanFail = cannot_fail
|
|
else
|
|
true
|
|
),
|
|
% Don't convert (can_fail, can_loop) into (can_loop, can_fail), since
|
|
% this could worsen the termination properties of the program.
|
|
(
|
|
EarlierCanFail = can_fail,
|
|
goal_cannot_loop_or_throw(ModuleInfo, LaterGoal)
|
|
;
|
|
EarlierCanFail = cannot_fail
|
|
).
|
|
|
|
reordering_maintains_termination(FullyStrict, EarlierGoal, LaterGoal,
|
|
MaintainsTermination, !ModuleInfo) :-
|
|
EarlierGoal = hlds_goal(_, EarlierGoalInfo),
|
|
LaterGoal = hlds_goal(_, LaterGoalInfo),
|
|
|
|
EarlierDetism = goal_info_get_determinism(EarlierGoalInfo),
|
|
determinism_components(EarlierDetism, EarlierCanFail, _),
|
|
LaterDetism = goal_info_get_determinism(LaterGoalInfo),
|
|
determinism_components(LaterDetism, LaterCanFail, _),
|
|
|
|
% If --fully-strict was specified, don't convert (can_loop, can_fail) into
|
|
% (can_fail, can_loop).
|
|
goal_can_loop_or_throw(EarlierGoal, EarlierCanLoopOrThrow, !ModuleInfo),
|
|
( if
|
|
FullyStrict = yes,
|
|
EarlierCanLoopOrThrow = can_loop_or_throw,
|
|
LaterCanFail = can_fail
|
|
then
|
|
MaintainsTermination = no
|
|
else
|
|
% Don't convert (can_fail, can_loop) into (can_loop, can_fail), since
|
|
% this could worsen the termination properties of the program.
|
|
%
|
|
goal_can_loop_or_throw(LaterGoal, LaterCanLoopOrThrow,
|
|
!ModuleInfo),
|
|
( if
|
|
EarlierCanFail = can_fail,
|
|
LaterCanLoopOrThrow = can_loop_or_throw
|
|
then
|
|
MaintainsTermination = no
|
|
else
|
|
MaintainsTermination = yes
|
|
)
|
|
).
|
|
|
|
% If the earlier goal changes the instantiatedness of a variable
|
|
% that is used in the later goal, then the later goal depends on
|
|
% the earlier goal.
|
|
%
|
|
% This code does work on the alias branch.
|
|
%
|
|
:- pred goal_depends_on_earlier_goal(hlds_goal::in, hlds_goal::in, instmap::in,
|
|
vartypes::in, module_info::in) is semidet.
|
|
|
|
goal_depends_on_earlier_goal(LaterGoal, EarlierGoal, InstMapBeforeEarlierGoal,
|
|
VarTypes, ModuleInfo) :-
|
|
LaterGoal = hlds_goal(_, LaterGoalInfo),
|
|
EarlierGoal = hlds_goal(_, EarlierGoalInfo),
|
|
EarlierInstMapDelta = goal_info_get_instmap_delta(EarlierGoalInfo),
|
|
apply_instmap_delta(EarlierInstMapDelta,
|
|
InstMapBeforeEarlierGoal, InstMapAfterEarlierGoal),
|
|
|
|
instmap_changed_vars(ModuleInfo, VarTypes,
|
|
InstMapBeforeEarlierGoal, InstMapAfterEarlierGoal, EarlierChangedVars),
|
|
|
|
LaterGoalNonLocals = goal_info_get_nonlocals(LaterGoalInfo),
|
|
set_of_var.intersect(EarlierChangedVars, LaterGoalNonLocals, Intersection),
|
|
not set_of_var.is_empty(Intersection).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
generate_simple_call(ModuleInfo, ModuleName, ProcName, PredOrFunc, ModeNo,
|
|
Detism, Purity, Args, Features, InstMapDelta0, Context, Goal) :-
|
|
list.length(Args, Arity),
|
|
lookup_builtin_pred_proc_id(ModuleInfo, ModuleName, ProcName,
|
|
PredOrFunc, Arity, ModeNo, PredId, ProcId),
|
|
|
|
% builtin_state only uses this to work out whether
|
|
% this is the "recursive" clause generated for the compiler
|
|
% for each builtin, so an invalid pred_id won't cause problems.
|
|
InvalidPredId = invalid_pred_id,
|
|
BuiltinState = builtin_state(ModuleInfo, InvalidPredId, PredId, ProcId),
|
|
|
|
GoalExpr = plain_call(PredId, ProcId, Args, BuiltinState, no,
|
|
qualified(ModuleName, ProcName)),
|
|
set_of_var.list_to_set(Args, NonLocals),
|
|
determinism_components(Detism, _CanFail, NumSolns),
|
|
(
|
|
NumSolns = at_most_zero,
|
|
instmap_delta_init_unreachable(InstMapDelta)
|
|
;
|
|
( NumSolns = at_most_one
|
|
; NumSolns = at_most_many
|
|
; NumSolns = at_most_many_cc
|
|
),
|
|
InstMapDelta = InstMapDelta0
|
|
),
|
|
module_info_pred_info(ModuleInfo, PredId, PredInfo),
|
|
pred_info_get_purity(PredInfo, PredPurity),
|
|
expect(unify(Purity, PredPurity), $pred, "purity disagreement"),
|
|
goal_info_init(NonLocals, InstMapDelta, Detism, Purity, Context,
|
|
GoalInfo0),
|
|
list.foldl(goal_info_add_feature, Features, GoalInfo0, GoalInfo),
|
|
Goal = hlds_goal(GoalExpr, GoalInfo).
|
|
|
|
generate_foreign_proc(ModuleInfo, ModuleName, ProcName, PredOrFunc, ModeNo,
|
|
Detism, Purity, Attributes, Args, ExtraArgs, MaybeTraceRuntimeCond,
|
|
Code, Features, InstMapDelta0, Context, Goal) :-
|
|
list.length(Args, Arity),
|
|
lookup_builtin_pred_proc_id(ModuleInfo, ModuleName, ProcName,
|
|
PredOrFunc, Arity, ModeNo, PredId, ProcId),
|
|
|
|
GoalExpr = call_foreign_proc(Attributes, PredId, ProcId, Args, ExtraArgs,
|
|
MaybeTraceRuntimeCond, fp_impl_ordinary(Code, no)),
|
|
ArgVars = list.map(foreign_arg_var, Args),
|
|
ExtraArgVars = list.map(foreign_arg_var, ExtraArgs),
|
|
Vars = ArgVars ++ ExtraArgVars,
|
|
set_of_var.list_to_set(Vars, NonLocals),
|
|
determinism_components(Detism, _CanFail, NumSolns),
|
|
(
|
|
NumSolns = at_most_zero,
|
|
instmap_delta_init_unreachable(InstMapDelta)
|
|
;
|
|
( NumSolns = at_most_one
|
|
; NumSolns = at_most_many
|
|
; NumSolns = at_most_many_cc
|
|
),
|
|
InstMapDelta = InstMapDelta0
|
|
),
|
|
module_info_pred_info(ModuleInfo, PredId, PredInfo),
|
|
pred_info_get_purity(PredInfo, PredPurity),
|
|
expect(unify(Purity, PredPurity), $pred, "purity disagreement"),
|
|
goal_info_init(NonLocals, InstMapDelta, Detism, Purity, Context,
|
|
GoalInfo0),
|
|
list.foldl(goal_info_add_feature, Features, GoalInfo0, GoalInfo),
|
|
Goal = hlds_goal(GoalExpr, GoalInfo).
|
|
|
|
generate_cast(CastType, InArg, OutArg, Context, Goal) :-
|
|
Ground = ground_inst,
|
|
generate_cast_with_insts(CastType, InArg, OutArg, Ground, Ground, Context,
|
|
Goal).
|
|
|
|
generate_cast_with_insts(CastType, InArg, OutArg, InInst, OutInst, Context,
|
|
Goal) :-
|
|
set_of_var.list_to_set([InArg, OutArg], NonLocals),
|
|
InstMapDelta = instmap_delta_from_assoc_list([OutArg - OutInst]),
|
|
goal_info_init(NonLocals, InstMapDelta, detism_det, purity_pure, Context,
|
|
GoalInfo),
|
|
GoalExpr = generic_call(cast(CastType), [InArg, OutArg],
|
|
[in_mode(InInst), out_mode(OutInst)], arg_reg_types_unset, detism_det),
|
|
Goal = hlds_goal(GoalExpr, GoalInfo).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
pred_ids_called_from_goals(Goals, PredIds) :-
|
|
(
|
|
Goals = [],
|
|
PredIds = []
|
|
;
|
|
Goals = [HeadGoal | TailGoals],
|
|
pred_ids_called_from_goal(HeadGoal, HeadPredIds),
|
|
pred_ids_called_from_goals(TailGoals, TailPredIds),
|
|
PredIds = HeadPredIds ++ TailPredIds
|
|
).
|
|
|
|
pred_ids_called_from_goal(Goal, PredIds) :-
|
|
% Explicit lambda expression needed since goal_calls_pred_id
|
|
% has multiple modes.
|
|
P = ( pred(PredId::out) is nondet :-
|
|
goal_contains_goal(Goal, SubGoal),
|
|
SubGoal = hlds_goal(SubGoalExpr, _),
|
|
SubGoalExpr = plain_call(PredId, _, _, _, _, _)
|
|
),
|
|
solutions.solutions(P, PredIds).
|
|
|
|
pred_ids_args_called_from_goal(Goal, List) :-
|
|
P = ( pred({PredId, Args}::out) is nondet :-
|
|
goal_contains_goal(Goal, SubGoal),
|
|
SubGoal = hlds_goal(SubGoalExpr, _),
|
|
SubGoalExpr = plain_call(PredId, _, Args, _, _, _)
|
|
),
|
|
solutions(P, List).
|
|
|
|
pred_proc_ids_called_from_goal(Goal, PredProcIds) :-
|
|
P = ( pred(PredProcId::out) is nondet :-
|
|
goal_contains_goal(Goal, SubGoal),
|
|
SubGoal = hlds_goal(SubGoalExpr, _),
|
|
SubGoalExpr = plain_call(PredId, ProcId, _, _, _, _),
|
|
PredProcId = proc(PredId, ProcId)
|
|
),
|
|
solutions.solutions(P, PredProcIds).
|
|
|
|
goal_is_atomic(Goal, GoalIsAtomic) :-
|
|
Goal = hlds_goal(GoalExpr, _),
|
|
(
|
|
( GoalExpr = unify(_, _, _, _, _)
|
|
; GoalExpr = plain_call(_, _, _, _, _, _)
|
|
; GoalExpr = generic_call(_, _, _, _, _)
|
|
; GoalExpr = call_foreign_proc(_, _, _, _, _, _, _)
|
|
),
|
|
GoalIsAtomic = goal_is_atomic
|
|
;
|
|
( GoalExpr = conj(_, _)
|
|
; GoalExpr = disj(_)
|
|
; GoalExpr = switch(_, _, _)
|
|
; GoalExpr = negation(_)
|
|
; GoalExpr = scope(_, _)
|
|
; GoalExpr = if_then_else(_, _, _, _)
|
|
),
|
|
GoalIsAtomic = goal_is_nonatomic
|
|
;
|
|
GoalExpr = shorthand(_),
|
|
unexpected($pred, "shorthand")
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
foreign_proc_uses_variable(Impl, VarName) :-
|
|
Impl = fp_impl_ordinary(ForeignBody, _),
|
|
string.sub_string_search(ForeignBody, VarName, _).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
maybe_strip_equality_pretest(Goal0) = Goal :-
|
|
% The if_then_else constructed by unify_proc is sometimes wrapped up
|
|
% in conjunctions.
|
|
Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
|
|
(
|
|
( GoalExpr0 = unify(_, _, _, _, _)
|
|
; GoalExpr0 = plain_call(_, _, _, _, _, _)
|
|
; GoalExpr0 = generic_call(_, _, _, _, _)
|
|
; GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _)
|
|
),
|
|
Goal = Goal0
|
|
;
|
|
GoalExpr0 = conj(ConjType, Goals0),
|
|
Goals = list.map(maybe_strip_equality_pretest, Goals0),
|
|
GoalExpr = conj(ConjType, Goals),
|
|
Goal = hlds_goal(GoalExpr, GoalInfo0)
|
|
;
|
|
GoalExpr0 = disj(SubGoals0),
|
|
SubGoals = list.map(maybe_strip_equality_pretest, SubGoals0),
|
|
GoalExpr = disj(SubGoals),
|
|
Goal = hlds_goal(GoalExpr, GoalInfo0)
|
|
;
|
|
GoalExpr0 = switch(Var, CanFail, Cases0),
|
|
Cases = list.map(maybe_strip_equality_pretest_case, Cases0),
|
|
GoalExpr = switch(Var, CanFail, Cases),
|
|
Goal = hlds_goal(GoalExpr, GoalInfo0)
|
|
;
|
|
GoalExpr0 = if_then_else(Vars, Cond0, Then0, Else0),
|
|
( if goal_info_has_feature(GoalInfo0, feature_pretest_equality) then
|
|
Goal = Else0
|
|
else
|
|
Cond = maybe_strip_equality_pretest(Cond0),
|
|
Then = maybe_strip_equality_pretest(Then0),
|
|
Else = maybe_strip_equality_pretest(Else0),
|
|
GoalExpr = if_then_else(Vars, Cond, Then, Else),
|
|
Goal = hlds_goal(GoalExpr, GoalInfo0)
|
|
)
|
|
;
|
|
GoalExpr0 = negation(SubGoal0),
|
|
SubGoal = maybe_strip_equality_pretest(SubGoal0),
|
|
GoalExpr = negation(SubGoal),
|
|
Goal = hlds_goal(GoalExpr, GoalInfo0)
|
|
;
|
|
GoalExpr0 = scope(Reason, SubGoal0),
|
|
( if
|
|
Reason = from_ground_term(_, FGT),
|
|
( FGT = from_ground_term_construct
|
|
; FGT = from_ground_term_deconstruct
|
|
)
|
|
then
|
|
Goal = Goal0
|
|
else
|
|
SubGoal = maybe_strip_equality_pretest(SubGoal0),
|
|
GoalExpr = scope(Reason, SubGoal),
|
|
Goal = hlds_goal(GoalExpr, GoalInfo0)
|
|
)
|
|
;
|
|
GoalExpr0 = shorthand(ShortHand0),
|
|
(
|
|
ShortHand0 = atomic_goal(GoalType, Outer, Inner, MaybeOutputVars,
|
|
MainGoal0, OrElseGoals0, OrElseInners),
|
|
MainGoal = maybe_strip_equality_pretest(MainGoal0),
|
|
OrElseGoals = list.map(maybe_strip_equality_pretest, OrElseGoals0),
|
|
ShortHand = atomic_goal(GoalType, Outer, Inner, MaybeOutputVars,
|
|
MainGoal, OrElseGoals, OrElseInners),
|
|
GoalExpr = shorthand(ShortHand),
|
|
Goal = hlds_goal(GoalExpr, GoalInfo0)
|
|
;
|
|
ShortHand0 = try_goal(MaybeIO, ResultVar, SubGoal0),
|
|
SubGoal = maybe_strip_equality_pretest(SubGoal0),
|
|
ShortHand = try_goal(MaybeIO, ResultVar, SubGoal),
|
|
GoalExpr = shorthand(ShortHand),
|
|
Goal = hlds_goal(GoalExpr, GoalInfo0)
|
|
;
|
|
ShortHand0 = bi_implication(_, _),
|
|
unexpected($pred, "bi_implication")
|
|
)
|
|
).
|
|
|
|
:- func maybe_strip_equality_pretest_case(case) = case.
|
|
|
|
maybe_strip_equality_pretest_case(Case0) = Case :-
|
|
Case0 = case(MainConsId, OtherConsIds, Goal0),
|
|
Goal = maybe_strip_equality_pretest(Goal0),
|
|
Case = case(MainConsId, OtherConsIds, Goal).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
maybe_transform_goal_at_goal_path(TransformP, TargetGoalPath,
|
|
Goal0, MaybeGoal) :-
|
|
(
|
|
TargetGoalPath = fgp_nil,
|
|
TransformP(Goal0, MaybeGoal0),
|
|
maybe_error_to_maybe_transformed_goal(MaybeGoal0, MaybeGoal)
|
|
;
|
|
TargetGoalPath = fgp_cons(FirstStep, LaterPath),
|
|
Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
|
|
(
|
|
( GoalExpr0 = unify(_, _, _, _, _)
|
|
; GoalExpr0 = plain_call(_, _, _, _, _, _)
|
|
; GoalExpr0 = generic_call(_, _, _, _, _)
|
|
; GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _)
|
|
),
|
|
% This search should never reach an atomic goal.
|
|
MaybeGoal = goal_not_found
|
|
;
|
|
GoalExpr0 = conj(ConjType, Conjs0),
|
|
( if
|
|
FirstStep = step_conj(ConjNum),
|
|
list.index1(Conjs0, ConjNum, Conj0)
|
|
then
|
|
maybe_transform_goal_at_goal_path(TransformP, LaterPath,
|
|
Conj0, MaybeConj),
|
|
(
|
|
MaybeConj = ok(Conj),
|
|
list.det_replace_nth(Conjs0, ConjNum, Conj, Conjs),
|
|
GoalExpr = conj(ConjType, Conjs),
|
|
MaybeGoal = ok(hlds_goal(GoalExpr, GoalInfo0))
|
|
;
|
|
( MaybeConj = error(_)
|
|
; MaybeConj = goal_not_found
|
|
),
|
|
MaybeGoal = MaybeConj
|
|
)
|
|
else
|
|
MaybeGoal = goal_not_found
|
|
)
|
|
;
|
|
GoalExpr0 = disj(Disjs0),
|
|
( if
|
|
FirstStep = step_disj(DisjNum),
|
|
list.index1(Disjs0, DisjNum, Disj0)
|
|
then
|
|
maybe_transform_goal_at_goal_path(TransformP, LaterPath,
|
|
Disj0, MaybeDisj),
|
|
(
|
|
MaybeDisj = ok(Disj),
|
|
list.det_replace_nth(Disjs0, DisjNum, Disj, Disjs),
|
|
GoalExpr = disj(Disjs),
|
|
MaybeGoal = ok(hlds_goal(GoalExpr, GoalInfo0))
|
|
;
|
|
( MaybeDisj = error(_)
|
|
; MaybeDisj = goal_not_found
|
|
),
|
|
MaybeGoal = MaybeDisj
|
|
)
|
|
else
|
|
MaybeGoal = goal_not_found
|
|
)
|
|
;
|
|
GoalExpr0 = switch(Var, CanFail, Cases0),
|
|
( if
|
|
FirstStep = step_switch(CaseNum, _MaybeNumConstructors),
|
|
list.index1(Cases0, CaseNum, Case0)
|
|
then
|
|
CaseGoal0 = Case0 ^ case_goal,
|
|
maybe_transform_goal_at_goal_path(TransformP, LaterPath,
|
|
CaseGoal0, MaybeCaseGoal),
|
|
(
|
|
MaybeCaseGoal = ok(CaseGoal),
|
|
Case = Case0 ^ case_goal := CaseGoal,
|
|
list.det_replace_nth(Cases0, CaseNum, Case, Cases),
|
|
GoalExpr = switch(Var, CanFail, Cases),
|
|
MaybeGoal = ok(hlds_goal(GoalExpr, GoalInfo0))
|
|
;
|
|
( MaybeCaseGoal = error(_)
|
|
; MaybeCaseGoal = goal_not_found
|
|
),
|
|
MaybeGoal = MaybeCaseGoal
|
|
)
|
|
else
|
|
MaybeGoal = goal_not_found
|
|
)
|
|
;
|
|
GoalExpr0 = negation(SubGoal0),
|
|
( if FirstStep = step_neg then
|
|
maybe_transform_goal_at_goal_path(TransformP, LaterPath,
|
|
SubGoal0, MaybeSubGoal),
|
|
(
|
|
MaybeSubGoal = ok(SubGoal),
|
|
GoalExpr = negation(SubGoal),
|
|
MaybeGoal = ok(hlds_goal(GoalExpr, GoalInfo0))
|
|
;
|
|
( MaybeSubGoal = error(_)
|
|
; MaybeSubGoal = goal_not_found
|
|
),
|
|
MaybeGoal = MaybeSubGoal
|
|
)
|
|
else
|
|
MaybeGoal = goal_not_found
|
|
)
|
|
;
|
|
GoalExpr0 = scope(Reason, SubGoal0),
|
|
( if FirstStep = step_scope(_MaybeCut) then
|
|
maybe_transform_goal_at_goal_path(TransformP, LaterPath,
|
|
SubGoal0, MaybeSubGoal),
|
|
(
|
|
MaybeSubGoal = ok(SubGoal),
|
|
GoalExpr = scope(Reason, SubGoal),
|
|
MaybeGoal = ok(hlds_goal(GoalExpr, GoalInfo0))
|
|
;
|
|
( MaybeSubGoal = error(_)
|
|
; MaybeSubGoal = goal_not_found
|
|
),
|
|
MaybeGoal = MaybeSubGoal
|
|
)
|
|
else
|
|
MaybeGoal = goal_not_found
|
|
)
|
|
;
|
|
GoalExpr0 = if_then_else(ExistVars, Cond0, Then0, Else0),
|
|
( if FirstStep = step_ite_cond then
|
|
maybe_transform_goal_at_goal_path(TransformP, LaterPath,
|
|
Cond0, MaybeCond),
|
|
(
|
|
MaybeCond = ok(Cond),
|
|
GoalExpr = if_then_else(ExistVars, Cond, Then0, Else0),
|
|
MaybeGoal = ok(hlds_goal(GoalExpr, GoalInfo0))
|
|
;
|
|
( MaybeCond = error(_)
|
|
; MaybeCond = goal_not_found
|
|
),
|
|
MaybeGoal = MaybeCond
|
|
)
|
|
else if FirstStep = step_ite_then then
|
|
maybe_transform_goal_at_goal_path(TransformP, LaterPath,
|
|
Then0, MaybeThen),
|
|
(
|
|
MaybeThen = ok(Then),
|
|
GoalExpr = if_then_else(ExistVars, Cond0, Then, Else0),
|
|
MaybeGoal = ok(hlds_goal(GoalExpr, GoalInfo0))
|
|
;
|
|
( MaybeThen = error(_)
|
|
; MaybeThen = goal_not_found
|
|
),
|
|
MaybeGoal = MaybeThen
|
|
)
|
|
else if FirstStep = step_ite_else then
|
|
maybe_transform_goal_at_goal_path(TransformP, LaterPath,
|
|
Else0, MaybeElse),
|
|
(
|
|
MaybeElse = ok(Else),
|
|
GoalExpr = if_then_else(ExistVars, Cond0, Then0, Else),
|
|
MaybeGoal = ok(hlds_goal(GoalExpr, GoalInfo0))
|
|
;
|
|
( MaybeElse = error(_)
|
|
; MaybeElse = goal_not_found
|
|
),
|
|
MaybeGoal = MaybeElse
|
|
)
|
|
else
|
|
MaybeGoal = goal_not_found
|
|
)
|
|
;
|
|
GoalExpr0 = shorthand(_),
|
|
unexpected($pred, "shorthand")
|
|
)
|
|
).
|
|
|
|
maybe_transform_goal_at_goal_path_with_instmap(TransformP, TargetGoalPath,
|
|
Instmap0, Goal0, MaybeGoal) :-
|
|
(
|
|
TargetGoalPath = fgp_nil,
|
|
TransformP(Instmap0, Goal0, MaybeGoal0),
|
|
maybe_error_to_maybe_transformed_goal(MaybeGoal0, MaybeGoal)
|
|
;
|
|
TargetGoalPath = fgp_cons(FirstStep, LaterPath),
|
|
Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
|
|
(
|
|
( GoalExpr0 = unify(_, _, _, _, _)
|
|
; GoalExpr0 = plain_call(_, _, _, _, _, _)
|
|
; GoalExpr0 = generic_call(_, _, _, _, _)
|
|
; GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _)
|
|
),
|
|
% This search should never reach an atomic goal.
|
|
MaybeGoal = goal_not_found
|
|
;
|
|
GoalExpr0 = conj(ConjType, Conjs0),
|
|
( if
|
|
FirstStep = step_conj(ConjNum),
|
|
list.index1(Conjs0, ConjNum, Conj0)
|
|
then
|
|
list.take_upto(ConjNum - 1, Conjs0, HeadConjs),
|
|
HeadInstdeltas = map(
|
|
(func(G) = goal_info_get_instmap_delta(G ^ hg_info)),
|
|
HeadConjs),
|
|
list.foldl(apply_instmap_delta, HeadInstdeltas,
|
|
Instmap0, Instmap),
|
|
maybe_transform_goal_at_goal_path_with_instmap(TransformP,
|
|
LaterPath, Instmap, Conj0, MaybeConj),
|
|
(
|
|
MaybeConj = ok(Conj),
|
|
list.det_replace_nth(Conjs0, ConjNum, Conj, Conjs),
|
|
GoalExpr = conj(ConjType, Conjs),
|
|
MaybeGoal = ok(hlds_goal(GoalExpr, GoalInfo0))
|
|
;
|
|
( MaybeConj = error(_)
|
|
; MaybeConj = goal_not_found
|
|
),
|
|
MaybeGoal = MaybeConj
|
|
)
|
|
else
|
|
MaybeGoal = goal_not_found
|
|
)
|
|
;
|
|
GoalExpr0 = disj(Disjs0),
|
|
( if
|
|
FirstStep = step_disj(DisjNum),
|
|
list.index1(Disjs0, DisjNum, Disj0)
|
|
then
|
|
maybe_transform_goal_at_goal_path_with_instmap(TransformP,
|
|
LaterPath, Instmap0, Disj0, MaybeDisj),
|
|
(
|
|
MaybeDisj = ok(Disj),
|
|
list.det_replace_nth(Disjs0, DisjNum, Disj, Disjs),
|
|
GoalExpr = disj(Disjs),
|
|
MaybeGoal = ok(hlds_goal(GoalExpr, GoalInfo0))
|
|
;
|
|
( MaybeDisj = error(_)
|
|
; MaybeDisj = goal_not_found
|
|
),
|
|
MaybeGoal = MaybeDisj
|
|
)
|
|
else
|
|
MaybeGoal = goal_not_found
|
|
)
|
|
;
|
|
GoalExpr0 = switch(Var, CanFail, Cases0),
|
|
( if
|
|
FirstStep = step_switch(CaseNum, _MaybeNumConstructors),
|
|
list.index1(Cases0, CaseNum, Case0)
|
|
then
|
|
CaseGoal0 = Case0 ^ case_goal,
|
|
maybe_transform_goal_at_goal_path_with_instmap(TransformP,
|
|
LaterPath, Instmap0, CaseGoal0, MaybeCaseGoal),
|
|
(
|
|
MaybeCaseGoal = ok(CaseGoal),
|
|
Case = Case0 ^ case_goal := CaseGoal,
|
|
list.det_replace_nth(Cases0, CaseNum, Case, Cases),
|
|
GoalExpr = switch(Var, CanFail, Cases),
|
|
MaybeGoal = ok(hlds_goal(GoalExpr, GoalInfo0))
|
|
;
|
|
( MaybeCaseGoal = error(_)
|
|
; MaybeCaseGoal = goal_not_found
|
|
),
|
|
MaybeGoal = MaybeCaseGoal
|
|
)
|
|
else
|
|
MaybeGoal = goal_not_found
|
|
)
|
|
;
|
|
GoalExpr0 = negation(SubGoal0),
|
|
( if FirstStep = step_neg then
|
|
maybe_transform_goal_at_goal_path_with_instmap(TransformP,
|
|
LaterPath, Instmap0, SubGoal0, MaybeSubGoal),
|
|
(
|
|
MaybeSubGoal = ok(SubGoal),
|
|
GoalExpr = negation(SubGoal),
|
|
MaybeGoal = ok(hlds_goal(GoalExpr, GoalInfo0))
|
|
;
|
|
( MaybeSubGoal = error(_)
|
|
; MaybeSubGoal = goal_not_found
|
|
),
|
|
MaybeGoal = MaybeSubGoal
|
|
)
|
|
else
|
|
MaybeGoal = goal_not_found
|
|
)
|
|
;
|
|
GoalExpr0 = scope(Reason, SubGoal0),
|
|
( if FirstStep = step_scope(_MaybeCut) then
|
|
maybe_transform_goal_at_goal_path_with_instmap(TransformP,
|
|
LaterPath, Instmap0, SubGoal0, MaybeSubGoal),
|
|
(
|
|
MaybeSubGoal = ok(SubGoal),
|
|
GoalExpr = scope(Reason, SubGoal),
|
|
MaybeGoal = ok(hlds_goal(GoalExpr, GoalInfo0))
|
|
;
|
|
( MaybeSubGoal = error(_)
|
|
; MaybeSubGoal = goal_not_found
|
|
),
|
|
MaybeGoal = MaybeSubGoal
|
|
)
|
|
else
|
|
MaybeGoal = goal_not_found
|
|
)
|
|
;
|
|
GoalExpr0 = if_then_else(ExistVars, Cond0, Then0, Else0),
|
|
( if FirstStep = step_ite_cond then
|
|
maybe_transform_goal_at_goal_path_with_instmap(TransformP,
|
|
LaterPath, Instmap0, Cond0, MaybeCond),
|
|
(
|
|
MaybeCond = ok(Cond),
|
|
GoalExpr = if_then_else(ExistVars, Cond, Then0, Else0),
|
|
MaybeGoal = ok(hlds_goal(GoalExpr, GoalInfo0))
|
|
;
|
|
( MaybeCond = error(_)
|
|
; MaybeCond = goal_not_found
|
|
),
|
|
MaybeGoal = MaybeCond
|
|
)
|
|
else if FirstStep = step_ite_then then
|
|
apply_instmap_delta(
|
|
goal_info_get_instmap_delta(Cond0 ^ hg_info),
|
|
Instmap0, Instmap),
|
|
maybe_transform_goal_at_goal_path_with_instmap(TransformP,
|
|
LaterPath, Instmap, Then0, MaybeThen),
|
|
(
|
|
MaybeThen = ok(Then),
|
|
GoalExpr = if_then_else(ExistVars, Cond0, Then, Else0),
|
|
MaybeGoal = ok(hlds_goal(GoalExpr, GoalInfo0))
|
|
;
|
|
( MaybeThen = error(_)
|
|
; MaybeThen = goal_not_found
|
|
),
|
|
MaybeGoal = MaybeThen
|
|
)
|
|
else if FirstStep = step_ite_else then
|
|
maybe_transform_goal_at_goal_path_with_instmap(TransformP,
|
|
LaterPath, Instmap0, Else0, MaybeElse),
|
|
(
|
|
MaybeElse = ok(Else),
|
|
GoalExpr = if_then_else(ExistVars, Cond0, Then0, Else),
|
|
MaybeGoal = ok(hlds_goal(GoalExpr, GoalInfo0))
|
|
;
|
|
( MaybeElse = error(_)
|
|
; MaybeElse = goal_not_found
|
|
),
|
|
MaybeGoal = MaybeElse
|
|
)
|
|
else
|
|
MaybeGoal = goal_not_found
|
|
)
|
|
;
|
|
GoalExpr0 = shorthand(_),
|
|
unexpected($pred, "shorthand")
|
|
)
|
|
).
|
|
|
|
:- pred maybe_error_to_maybe_transformed_goal(maybe_error(hlds_goal)::in,
|
|
maybe_transformed_goal::out) is det.
|
|
|
|
maybe_error_to_maybe_transformed_goal(ok(Goal), ok(Goal)).
|
|
maybe_error_to_maybe_transformed_goal(error(Error), error(Error)).
|
|
|
|
transform_all_goals(TransformP, Goal0, Goal) :-
|
|
Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
|
|
(
|
|
( GoalExpr0 = unify(_, _, _, _, _)
|
|
; GoalExpr0 = plain_call(_, _, _, _, _, _)
|
|
; GoalExpr0 = generic_call(_, _, _, _, _)
|
|
; GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _)
|
|
),
|
|
GoalExpr = GoalExpr0
|
|
;
|
|
GoalExpr0 = conj(ConjType, Conjs0),
|
|
list.map(transform_all_goals(TransformP), Conjs0, Conjs),
|
|
GoalExpr = conj(ConjType, Conjs)
|
|
;
|
|
GoalExpr0 = disj(Disjs0),
|
|
list.map(transform_all_goals(TransformP), Disjs0, Disjs),
|
|
GoalExpr = disj(Disjs)
|
|
;
|
|
GoalExpr0 = switch(Var, CanFail, Cases0),
|
|
list.map(
|
|
( pred(Case0::in, Case::out) is det :-
|
|
GoalI0 = Case0 ^ case_goal,
|
|
transform_all_goals(TransformP, GoalI0, GoalI),
|
|
Case = Case0 ^ case_goal := GoalI
|
|
), Cases0, Cases),
|
|
GoalExpr = switch(Var, CanFail, Cases)
|
|
;
|
|
GoalExpr0 = negation(SubGoal0),
|
|
transform_all_goals(TransformP, SubGoal0, SubGoal),
|
|
GoalExpr = negation(SubGoal)
|
|
;
|
|
GoalExpr0 = scope(Reason, SubGoal0),
|
|
transform_all_goals(TransformP, SubGoal0, SubGoal),
|
|
GoalExpr = scope(Reason, SubGoal)
|
|
;
|
|
GoalExpr0 = if_then_else(ExistVars, Cond0, Then0, Else0),
|
|
transform_all_goals(TransformP, Cond0, Cond),
|
|
transform_all_goals(TransformP, Then0, Then),
|
|
transform_all_goals(TransformP, Else0, Else),
|
|
GoalExpr = if_then_else(ExistVars, Cond, Then, Else)
|
|
;
|
|
GoalExpr0 = shorthand(_),
|
|
unexpected($pred, "shorthand")
|
|
),
|
|
Goal1 = hlds_goal(GoalExpr, GoalInfo0),
|
|
TransformP(Goal1, Goal).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
:- end_module hlds.goal_util.
|
|
%-----------------------------------------------------------------------------%
|