mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-20 08:19:28 +00:00
Estimated hours taken: 12
Branches: main
Replace the some() HLDS goal with a more general scope() goal, which can be
used not just for existential quantification but also for other purposes.
The main such purposes are new goal types that allow the programmer
to annotate arbitrary goals, and not just whole procedure bodies, with the
equivalents of promise_pure/promise_semipure and promise_only_solution:
promise_pure ( <impure/semipure goal> )
promise_semipure ( <impure goal> )
promise_equivalent_solutions [OutVar1, OutVar2] (
<cc_multi/cc_nondet goal that computed OutVar1 & OutVar2>
)
Both are intended to be helpful in writing constraint solvers, as well as in
other situations.
doc/reference_manual.texi:
Document the new constructs.
library/ops.m:
Add the keywords of the new constructs to the list of operators.
Since they work similarly to the "some" operator, they have the same
precedence.
compiler/hlds_goal.m:
Replace the some(Vars, SubGoal) HLDS construct, with its optional
keep_this_commit attribute, with the new scope(Reason, SubGoal)
construct. The Reason argument may say that this scope is an
existential quantification, but it can also say that it represents
a purity promise, the introduction of a single-solution context
with promise_equivalent_solutions, or a decision by a compiler pass.
It can also say that the scope represents a set of goals that all arise
from the unraveling of a unification between a variable and a ground
term. This was intended to speed up mode checking by significantly
reducing the number of delays and wakeups, but the cost of the scopes
themselves turned out to be bigger than the gain in modechecking speed.
Update the goal_path_step type to refer to scope goals instead of just
existential quantification.
compiler/prog_data.m:
Add new function symbols to the type we use to represent goals in items
to stand for the new Mercury constructs.
compiler/prog_io_goal.m:
Add code to read in the new language constructs.
compiler/prog_io_util.m:
Add a utility predicate for use by the new code in prog_io_goal.m.
compiler/make_hlds.m:
Convert the item representation of the new constructs to the HLDS
representation.
Document how the from_ground_term scope reason would work, but do not
enable the code.
compiler/purity.m:
When checking the purity of goals, respect the new promise_pure and
promise_semipure scopes. Generate warnings if such scopes are
redundant.
compiler/det_analysis.m:
Make the insides of promise_equivalent_solutions goals single solution
contexts.
compiler/det_report.m:
Provide mechanisms for reporting inappropriate usage of
promise_equivalent_solutions goals.
compiler/instmap.m:
Add a utility predicate for use by one of the modules above.
compiler/deep_profiling.m:
Use one of the new scope reasons to prevent simplify from optimizing
away commits of goals that have been made impure, instead of the old
keep_this_commit goal feature.
compiler/modes.m:
Handle from_ground_term scopes when present; for now, they won't be
present, since make_hlds isn't creating them.
compiler/options.m:
Add two new compiler options, for use by implementors only, to allow
finer control over the amount of output one gets with --debug-modes.
(I used them when debugging the performance of the from_ground_term
scope reason.) The options are --debug-modes-minimal and
--debug-modes-verbose.
compiler/handle_options.m:
Make the options that are meaningful only in the presence of
--debug-modes imply --debug-modes, since this allows more convenient
(shorter) invocations.
compiler/mode_debug.m:
Respect the new options when deciding how much data to print
when debugging of the mode checking process is enabled.
compiler/switch_detect.m:
Rename a predicate to make it differ from another predicate by more
than just its arity.
compiler/passes_aux.m:
Bring this module up to date with our current style guidelines,
by using state variable syntax where appropriate.
compiler/*.m:
Minor changes to conform to the change in the HLDS and/or parse tree
goal type.
mdbcomp/program_representation.m:
Rename the some goal to the scope goal, and the same for path steps,
to keep them in sync with the HLDS.
browser/declarative_tree.m:
Conform to the change in goal representations.
tests/hard_coded/promise_equivalent_solutions_test.{m,exp}:
A new test case to test the handling of the
promise_equivalent_solutions construct.
tests/hard_coded/Mmakefile:
Enable the new test.
tests/hard_coded/purity/promise_pure_test.{m,exp}:
A new test case to test the handling of the promise_pure and
promise_semipure constructs.
tests/hard_coded/purity/Mmakefile:
Enable the new test.
tests/invalid/promise_equivalent_solutions.{m,err_exp}:
A new test case to test the error messages for improper use of the
promise_pure and promise_semipure constructs.
tests/invalid/Mmakefile:
Enable the new test.
1864 lines
67 KiB
Mathematica
1864 lines
67 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 1998-2005 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: magic.m
|
|
% Main author: stayl
|
|
%
|
|
% This module implements the supplementary magic set transformation,
|
|
% sort of as described in
|
|
% C. Beeri and R. Ramakrishnan,
|
|
% On the power of magic,
|
|
% Journal of Logic Programming,
|
|
% volume 10, 1991, pp. 255-299.
|
|
% The main difference is that the input relation is explicitly passed
|
|
% as a closure.
|
|
%
|
|
% The magic set transformation is used to transform queries into a form
|
|
% suitable for the Aditi deductive database code generator in rl_gen.m.
|
|
% The magic set transformation or the context transformation (defined
|
|
% in context.m) must be applied to all Aditi predicates. The magic sets
|
|
% and context transformations are mutually exclusive.
|
|
%
|
|
% It is important that no optimization which could optimize away calls
|
|
% to Aditi procedures (e.g. simplify.m) be run between magic.m and rl_gen.m.
|
|
% If Aditi calls are removed, the code in dependency_graph.m which merges
|
|
% the SCCs containing Aditi predicates could become confused about which
|
|
% predicates can be compiled together.
|
|
%
|
|
%-----------------------------------------------------------------------------%
|
|
% Short example:
|
|
%
|
|
% :- module a.
|
|
%
|
|
% :- interface.
|
|
%
|
|
% :- import_module aditi.
|
|
%
|
|
% :- pred call_anc(aditi__state::in, int::out) is nondet.
|
|
% :- pragma aditi(call_anc/3).
|
|
%
|
|
% :- implementation.
|
|
%
|
|
% :- pred anc(aditi__state::in, int::in, int::out) is nondet.
|
|
% :- pragma aditi(anc/3).
|
|
%
|
|
% :- pred p(aditi__state::in, int::out, int::out) is nondet.
|
|
% :- pragma base_relation(p/3).
|
|
%
|
|
% anc(DB, X, Y) :-
|
|
% p(DB, X, Y).
|
|
% anc(DB, X, Y) :-
|
|
% p(DB, X, Z),
|
|
% anc(DB, Z, Y).
|
|
%
|
|
%-----------------------------------------------------------------------------%
|
|
% Transformed version:
|
|
%
|
|
% % The original predicate is converted into a goal which
|
|
% % calls do_call_aditi_nondet to do all the work.
|
|
% % The type_infos are used for data conversion.
|
|
% % The base relation p/3 is given an interface procedure
|
|
% % which looks basically the same as this one, except that
|
|
% % there are no inputs and two outputs.
|
|
% % This procedure is compiled to C, not Aditi-RL.
|
|
% anc(HeadVar__1, HeadVar__2, HeadVar__3) :-
|
|
% V_15 = "stayl/a/a__anc__c_interface_2_0/2", % RL proc name
|
|
% V_16 = 1, % number of inputs
|
|
% V_17 = "(:I)", % input relation schema
|
|
% V_18 = 1, % number of outputs
|
|
% TypeInfo_13 = type_ctor_info("", "int", 0), % input type_info
|
|
% TypeInfo_14 = type_ctor_info("", "int", 0), % output type_info
|
|
%
|
|
% % The aditi__state is not needed (it contains no information),
|
|
% % so it is not passed.
|
|
% % aditi_private_builtin__do_nondet_call(PredName,
|
|
% % InputSchema, InputTuple, OutputTuple)
|
|
% aditi_private_builtin__do_nondet_call(
|
|
% TypeInfo_13, TypeInfo_14,
|
|
% "stayl/a/a__anc__c_interface_2_0/2", "(:I)",
|
|
% {HeadVar__2}, {HeadVar__3}).
|
|
%
|
|
% :- pred anc__c_interface(pred(int)::(pred(out) is nondet),
|
|
% int::out) is nondet.
|
|
% :- pragma aditi(anc__c_interface/2).
|
|
%
|
|
% % This predicate calls the Aditi version of anc, joins the result
|
|
% % with the input to the calls and then projects the join result onto
|
|
% % the output arguments.
|
|
% anc__c_interface(InAnc, Y) :-
|
|
% anc__c_interface__supp1(InAnc, X),
|
|
% V_15 = anc__c_interface__supp1(InAnc),
|
|
% anc__aditi0(InAnc, V_1, Y),
|
|
% X == V_1.
|
|
%
|
|
% % The aditi__state arguments are removed and all modes are
|
|
% % converted to output. An input closure is added for each
|
|
% % predicate in the SCC.
|
|
% :- pred anc__aditi0(pred(int)::(pred(out) is nondet),
|
|
% int::out, int::out) is nondet.
|
|
% :- pragma aditi(anc__aditi0/3).
|
|
%
|
|
% anc__aditi0(InAnc, X, Y) :-
|
|
% anc__magic(InAnc, X),
|
|
% p(V_1, Y),
|
|
% V1 == X.
|
|
% anc__aditi0(InAnc, X, Y) :-
|
|
% anc__supp1(InAnc, X),
|
|
% anc__aditi0(InAnc, V1, Y),
|
|
% V1 == X.
|
|
%
|
|
% % `anc__magic' collects all tuples which could be input to
|
|
% % a call to `anc' in a top-down execution.
|
|
% :- pred anc__magic(pred(int)::(pred(out) is nondet), int::out) is nondet.
|
|
% :- pragma aditi(anc__magic/2).
|
|
%
|
|
% anc__magic(InAnc, X) :-
|
|
% % Collect the input from a higher sub-module.
|
|
% call(InAnc, X).
|
|
% anc__magic(InAnc, Z) :-
|
|
% % Collect the input from recursive calls.
|
|
% anc__supp1(InAnc, _, Z).
|
|
%
|
|
% % `anc__supp1' is introduced to do common sub-expression -
|
|
% % this join would otherwise be done in both `anc__aditi0'
|
|
% % and `anc__magic'. This is also necessary because rl_gen.m
|
|
% % only handles rules with at most two database calls.
|
|
% :- pred anc__supp1(pred(int)::(pred(out) is nondet, int::out) is nondet.
|
|
% :- pragma aditi(anc__supp1/2).
|
|
%
|
|
% anc__supp1(InAnc, Z) :-
|
|
% anc__magic(InAnc, X),
|
|
% p(V_1, Z),
|
|
% X == V1.
|
|
%
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% context.m is called to handle predicates with a `:- pragma context'
|
|
% declaration.
|
|
%
|
|
% Input relations are explicitly passed using closures.
|
|
%
|
|
% While it processes the module it checks that there are no higher-order,
|
|
% partially instantiated, polymorphic or abstract arguments since Aditi
|
|
% cannot handle these.
|
|
%
|
|
% Any closures occurring in Aditi procedures must not have curried arguments.
|
|
% Closures may only be used for aggregates.
|
|
%
|
|
% XXX This should attempt to reorder within rules so that no supplementary
|
|
% predicates are created with partially instantiated arguments, since Aditi
|
|
% can only handle ground terms in relations. The problem occurs if there are
|
|
% partially instantiated terms live across a database predicate call. At the
|
|
% moment an error is reported.
|
|
%
|
|
% Note that the transformation introduces new mangled predicate names,
|
|
% but these should not show up in the generated C code so util/mdemangle does
|
|
% not need to handle them.
|
|
%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- module aditi_backend__magic.
|
|
|
|
:- interface.
|
|
|
|
:- import_module hlds__hlds_module.
|
|
|
|
:- import_module io.
|
|
|
|
:- pred magic__process_module(module_info::in, module_info::out,
|
|
io::di, io::uo) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module aditi_backend__aditi_builtin_ops.
|
|
:- import_module aditi_backend__context.
|
|
:- import_module aditi_backend__magic_util.
|
|
:- import_module aditi_backend__rl.
|
|
:- import_module aditi_backend__rl_gen.
|
|
:- import_module check_hlds__mode_util.
|
|
:- import_module check_hlds__polymorphism.
|
|
:- import_module check_hlds__simplify.
|
|
:- import_module check_hlds__type_util.
|
|
:- import_module hlds__goal_util.
|
|
:- import_module hlds__hlds_data.
|
|
:- import_module hlds__hlds_goal.
|
|
:- import_module hlds__hlds_out.
|
|
:- import_module hlds__hlds_pred.
|
|
:- import_module hlds__instmap.
|
|
:- import_module hlds__passes_aux.
|
|
:- import_module hlds__quantification.
|
|
:- import_module libs__globals.
|
|
:- import_module libs__options.
|
|
:- import_module ll_backend.
|
|
:- import_module ll_backend__saved_vars.
|
|
:- import_module mdbcomp__prim_data.
|
|
:- import_module parse_tree__prog_data.
|
|
:- import_module parse_tree__prog_mode.
|
|
:- import_module parse_tree__prog_out.
|
|
:- import_module parse_tree__prog_type.
|
|
:- import_module transform_hlds__dead_proc_elim.
|
|
:- import_module transform_hlds__dependency_graph.
|
|
|
|
:- import_module assoc_list.
|
|
:- import_module bool.
|
|
:- import_module int.
|
|
:- import_module list.
|
|
:- import_module map.
|
|
:- import_module require.
|
|
:- import_module set.
|
|
:- import_module std_util.
|
|
:- import_module string.
|
|
:- import_module term.
|
|
:- import_module varset.
|
|
|
|
magic__process_module(ModuleInfo0, ModuleInfo) -->
|
|
|
|
%
|
|
% Run simplification on Aditi procedures, mainly to get rid of
|
|
% nested explicit quantifications.
|
|
%
|
|
globals__io_get_globals(Globals),
|
|
{ simplify__find_simplifications(no, Globals, Simplifications) },
|
|
process_matching_nonimported_procs(
|
|
update_module_io(
|
|
magic__ite_to_disj_and_simplify(Simplifications)),
|
|
_, hlds_pred__pred_info_is_aditi_relation,
|
|
ModuleInfo0, ModuleInfo1),
|
|
|
|
% We need to run dead_proc_elim before working out the
|
|
% Aditi dependency ordering because any calls from dead
|
|
% procedures could confuse the code to merge SCCs (because
|
|
% procedures called from multiple places are never merged).
|
|
%
|
|
% No optimizations which could optimize away calls to Aditi
|
|
% procedures (e.g. simplify.m) should be run after this is done.
|
|
dead_proc_elim(final_optimization_pass, ModuleInfo1, ModuleInfo2),
|
|
|
|
{ module_info_ensure_aditi_dependency_info(ModuleInfo2, ModuleInfo3) },
|
|
{ module_info_aditi_dependency_ordering(ModuleInfo3, Ordering) },
|
|
{ magic_info_init(ModuleInfo3, Info0) },
|
|
{ module_info_predids(ModuleInfo3, PredIds) },
|
|
|
|
%
|
|
% Only preprocess imported Aditi predicates which are used,
|
|
% to avoid performing error checking (e.g. checking for abstract
|
|
% types) on predicates which are not used. The check for abstract
|
|
% types needs to be done in importing modules because an imported
|
|
% predicate's declaration may use types which are indirectly imported
|
|
% from another module. Discriminated union types are written as
|
|
% abstract types to `.int2' files.
|
|
%
|
|
{ set__init(UsedImportedPreds0) },
|
|
{ list__foldl(magic__find_used_imported_aditi_preds(ModuleInfo3),
|
|
Ordering, UsedImportedPreds0, UsedImportedPreds) },
|
|
{ magic__process_imported_procs(PredIds, UsedImportedPreds,
|
|
Info0, Info1) },
|
|
globals__io_lookup_bool_option(very_verbose, Verbose),
|
|
|
|
% Add magic procedures, do some transformation on the goals.
|
|
maybe_write_string(Verbose, "% preprocessing module\n"),
|
|
maybe_flush_output(Verbose),
|
|
{ list__foldl(magic__check_scc, Ordering, Info1, Info2) },
|
|
{ list__foldl(magic__preprocess_scc, Ordering, Info2, Info3) },
|
|
|
|
% Do the transformation.
|
|
maybe_write_string(Verbose, "% processing module\n"),
|
|
maybe_flush_output(Verbose),
|
|
list__foldl2(magic__process_scc, Ordering, Info3, Info4),
|
|
{ list__foldl(magic__update_pred_status, PredIds, Info4, Info5) },
|
|
|
|
{ magic_info_get_module_info(ModuleInfo4, Info5, Info) },
|
|
{ magic_info_get_errors(Errors, Info, _) },
|
|
{ set__to_sorted_list(Errors, ErrorList) },
|
|
( { ErrorList = [] } ->
|
|
{ ModuleInfo5 = ModuleInfo4 }
|
|
;
|
|
globals__io_lookup_bool_option(verbose_errors, VerboseErrors),
|
|
magic_util__report_errors(ErrorList,
|
|
ModuleInfo4, VerboseErrors),
|
|
{ module_info_incr_errors(ModuleInfo4, ModuleInfo5) },
|
|
io__set_exit_status(1)
|
|
),
|
|
|
|
% New procedures were created, so the dependency_info
|
|
% is out of date.
|
|
{ module_info_clobber_dependency_info(ModuleInfo5, ModuleInfo) }.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
%
|
|
% Convert if-then-elses and switches to disjunctions,
|
|
% then run simplification to flatten goals and remove
|
|
% unnecessary existential quantifications.
|
|
%
|
|
:- pred magic__ite_to_disj_and_simplify(list(simplification)::in, pred_id::in,
|
|
proc_id::in, proc_info::in, proc_info::out, module_info::in,
|
|
module_info::out, io::di, io::uo) is det.
|
|
|
|
magic__ite_to_disj_and_simplify(Simplifications, PredId, ProcId,
|
|
!ProcInfo, !ModuleInfo) -->
|
|
{ proc_info_goal(!.ProcInfo, Goal0) },
|
|
|
|
{ Goal0 = if_then_else(_Vars, Cond, Then, Else) - GoalInfo ->
|
|
goal_util__if_then_else_to_disjunction(Cond, Then, Else,
|
|
GoalInfo, Disj),
|
|
Goal1 = Disj - GoalInfo,
|
|
proc_info_set_goal(Goal1, !ProcInfo),
|
|
|
|
% Requantify the goal to rename apart the variables
|
|
% in the copies of the condition.
|
|
requantify_proc(!ProcInfo)
|
|
; Goal0 = switch(Var, _Canfail, Cases) - GoalInfo ->
|
|
proc_info_varset(!.ProcInfo, VarSet0),
|
|
proc_info_vartypes(!.ProcInfo, VarTypes0),
|
|
proc_info_get_initial_instmap(!.ProcInfo,
|
|
!.ModuleInfo, InstMap),
|
|
% XXX check for existentially typed constructors first -
|
|
% they will cause an abort.
|
|
goal_util__switch_to_disjunction(Var, Cases,
|
|
InstMap, Disjuncts, VarSet0, VarSet1,
|
|
VarTypes0, VarTypes1, !ModuleInfo),
|
|
proc_info_set_varset(VarSet1, !ProcInfo),
|
|
proc_info_set_vartypes(VarTypes1, !ProcInfo),
|
|
Goal1 = disj(Disjuncts) - GoalInfo,
|
|
proc_info_set_goal(Goal1, !ProcInfo)
|
|
;
|
|
true
|
|
},
|
|
|
|
simplify__proc(Simplifications, PredId, ProcId,
|
|
!ModuleInfo, !ProcInfo),
|
|
|
|
%
|
|
% Run saved_vars so that constructions of constants are close
|
|
% to their uses, and constant attributes aren't unnecessarily
|
|
% added to relations. We should be more aggressive about this -
|
|
% constructions of constant compound terms should also be pushed.
|
|
%
|
|
saved_vars_proc(PredId, ProcId, !ProcInfo, !ModuleInfo).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred magic__check_scc(aditi_scc::in,
|
|
magic_info::in, magic_info::out) is det.
|
|
|
|
magic__check_scc(aditi_scc(SCC0, _)) -->
|
|
list__foldl(magic__check_scc_2, SCC0).
|
|
|
|
:- pred magic__check_scc_2(list(pred_proc_id)::in,
|
|
magic_info::in, magic_info::out) is det.
|
|
|
|
magic__check_scc_2(SCC) -->
|
|
magic_info_get_errors(Errors0),
|
|
magic_info_get_module_info(ModuleInfo),
|
|
{ SCC = [_] ->
|
|
Errors1 = Errors0
|
|
;
|
|
% Add errors for context procedures which are mutually
|
|
% recursive with other procedures.
|
|
solutions((pred(ProcAndContext::out) is nondet :-
|
|
list__member(ContextProc, SCC),
|
|
ContextProc = proc(ContextPredId, _),
|
|
module_info_pred_info(ModuleInfo,
|
|
ContextPredId, ContextPredInfo),
|
|
pred_info_get_markers(ContextPredInfo,
|
|
ContextMarkers),
|
|
check_marker(ContextMarkers, context),
|
|
pred_info_context(ContextPredInfo,
|
|
Context),
|
|
ProcAndContext = ContextProc - Context
|
|
), ContextProcs),
|
|
list__map((pred(BadContextProc::in, Error::out) is det :-
|
|
BadContextProc = TheContextProc - TheContext,
|
|
Error = mutually_recursive_context(
|
|
TheContextProc, SCC) - TheContext
|
|
), ContextProcs, ContextErrors),
|
|
set__insert_list(Errors0, ContextErrors, Errors1)
|
|
},
|
|
{
|
|
% Add errors if a procedure compiled to C is mutually
|
|
% recursive with an Aditi procedure.
|
|
list__member(proc(PredId, _), SCC),
|
|
module_info_pred_info(ModuleInfo, PredId, PredInfo),
|
|
pred_info_get_markers(PredInfo, Markers),
|
|
\+ check_marker(Markers, aditi)
|
|
->
|
|
term__context_init(InitContext),
|
|
set__insert(Errors1, mixed_scc(SCC) - InitContext, Errors)
|
|
;
|
|
Errors = Errors1
|
|
},
|
|
magic_info_set_errors(Errors).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% All the procedures which previously had Aditi markers should
|
|
% have been renamed apart, leaving the old versions to be called
|
|
% from C. These old versions must have their aditi/base relation
|
|
% markers removed.
|
|
:- pred magic__update_pred_status(pred_id::in,
|
|
magic_info::in, magic_info::out) is det.
|
|
|
|
magic__update_pred_status(PredId, !MagicInfo) :-
|
|
magic_info_get_module_info(ModuleInfo0, !MagicInfo),
|
|
module_info_pred_info(ModuleInfo0, PredId, PredInfo0),
|
|
pred_info_get_markers(PredInfo0, Markers0),
|
|
( check_marker(Markers0, aditi) ->
|
|
remove_marker(aditi, Markers0, Markers1),
|
|
remove_marker(base_relation, Markers1, Markers),
|
|
pred_info_set_markers(Markers, PredInfo0, PredInfo),
|
|
module_info_set_pred_info(PredId, PredInfo,
|
|
ModuleInfo0, ModuleInfo),
|
|
magic_info_set_module_info(ModuleInfo, !MagicInfo)
|
|
;
|
|
true
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Find all imported procedures which are called within
|
|
% a local Aditi procedure. The magic sets version of their
|
|
% interface must be produced.
|
|
:- pred magic__find_used_imported_aditi_preds(module_info::in,
|
|
aditi_scc::in, set(pred_id)::in, set(pred_id)::out) is det.
|
|
|
|
magic__find_used_imported_aditi_preds(ModuleInfo, SCC, Preds0, Preds) :-
|
|
SCC = aditi_scc(SCCPredProcIds0, _EntryPoints),
|
|
list__condense(SCCPredProcIds0, SCCPredProcIds),
|
|
list__foldl(magic__find_used_imported_aditi_preds_2(ModuleInfo),
|
|
SCCPredProcIds, Preds0, Preds).
|
|
|
|
:- pred magic__find_used_imported_aditi_preds_2(module_info::in,
|
|
pred_proc_id::in, set(pred_id)::in, set(pred_id)::out) is det.
|
|
|
|
magic__find_used_imported_aditi_preds_2(ModuleInfo,
|
|
PredProcId, Preds0, Preds) :-
|
|
module_info_pred_proc_info(ModuleInfo, PredProcId, _, ProcInfo),
|
|
proc_info_goal(ProcInfo, Goal),
|
|
|
|
% Generate all pred_ids called by a goal.
|
|
Generator = (pred(P::out) is nondet :- goal_calls_pred_id(Goal, P)),
|
|
|
|
% Add all used imported Aditi predicates to the accumulator.
|
|
Accumulator =
|
|
(pred(CalledPredId::in, UsedPreds0::in, UsedPreds::out) is det :-
|
|
module_info_pred_info(ModuleInfo,
|
|
CalledPredId, CalledPredInfo),
|
|
(
|
|
pred_info_is_imported(CalledPredInfo),
|
|
pred_info_is_aditi_relation(CalledPredInfo)
|
|
->
|
|
set__insert(UsedPreds0, CalledPredId, UsedPreds)
|
|
;
|
|
UsedPreds = UsedPreds0
|
|
)
|
|
),
|
|
|
|
Preds = promise_only_solution(
|
|
(pred(Preds1::out) is cc_multi :-
|
|
unsorted_aggregate(Generator, Accumulator,
|
|
Preds0, Preds1)
|
|
)).
|
|
|
|
% Convert imported Aditi procedures for the magic sets interface.
|
|
:- pred magic__process_imported_procs(list(pred_id)::in, set(pred_id)::in,
|
|
magic_info::in, magic_info::out) is det.
|
|
|
|
magic__process_imported_procs([], _) --> [].
|
|
magic__process_imported_procs([PredId | PredIds], UsedPreds) -->
|
|
magic_info_get_module_info(ModuleInfo),
|
|
{ module_info_pred_info(ModuleInfo, PredId, PredInfo) },
|
|
(
|
|
{ pred_info_is_imported(PredInfo) },
|
|
{ hlds_pred__is_derived_relation(ModuleInfo, PredId) },
|
|
{ set__member(PredId, UsedPreds) }
|
|
->
|
|
{ ProcIds = pred_info_procids(PredInfo) },
|
|
magic__process_imported_procs_2(PredId, ProcIds)
|
|
;
|
|
{ hlds_pred__pred_info_is_base_relation(PredInfo) },
|
|
{
|
|
% Always preprocess base relations defined in
|
|
% this module.
|
|
module_info_name(ModuleInfo, ModuleName),
|
|
PredModuleName = pred_info_module(PredInfo),
|
|
ModuleName = PredModuleName
|
|
;
|
|
set__member(PredId, UsedPreds)
|
|
}
|
|
->
|
|
{ ProcIds = pred_info_procids(PredInfo) },
|
|
list__foldl(magic__process_base_relation(PredId), ProcIds)
|
|
;
|
|
[]
|
|
),
|
|
magic__process_imported_procs(PredIds, UsedPreds).
|
|
|
|
:- pred magic__process_imported_procs_2(pred_id::in, list(proc_id)::in,
|
|
magic_info::in, magic_info::out) is det.
|
|
|
|
magic__process_imported_procs_2(_, []) --> [].
|
|
magic__process_imported_procs_2(PredId, [ProcId | ProcIds]) -->
|
|
{ PredProcId = proc(PredId, ProcId) },
|
|
magic__get_scc_inputs([PredProcId], InputTypes, InputModes),
|
|
magic__adjust_pred_info([PredProcId], InputTypes,
|
|
InputModes, PredProcId),
|
|
magic__process_imported_procs_2(PredId, ProcIds).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Create a version without the aditi__states, and with
|
|
% all modes output.
|
|
:- pred magic__process_base_relation(pred_id::in, proc_id::in,
|
|
magic_info::in, magic_info::out) is det.
|
|
|
|
magic__process_base_relation(PredId0, ProcId0) -->
|
|
magic__separate_proc(PredId0, ProcId0),
|
|
magic_info_get_pred_map(PredMap),
|
|
{ CPredProcId = proc(PredId0, ProcId0) },
|
|
{ map__lookup(PredMap, CPredProcId, PredProcId) },
|
|
|
|
magic_info_get_module_info(ModuleInfo0),
|
|
{ module_info_pred_proc_info(ModuleInfo0, PredProcId,
|
|
PredInfo0, ProcInfo0) },
|
|
{ pred_info_arg_types(PredInfo0, TVarSet, ExistQVars, ArgTypes0) },
|
|
{ proc_info_argmodes(ProcInfo0, ArgModes0) },
|
|
{ proc_info_headvars(ProcInfo0, HeadVars0) },
|
|
|
|
magic_info_set_error_pred_proc_id(CPredProcId),
|
|
{ set__init(ErrorVars) },
|
|
magic_info_set_error_vars(ErrorVars),
|
|
|
|
(
|
|
{ ModuleName = pred_info_module(PredInfo0) },
|
|
{ module_info_name(ModuleInfo0, ModuleName) }
|
|
->
|
|
{ pred_info_context(PredInfo0, Context) },
|
|
magic_util__check_args(HeadVars0, ArgModes0, ArgTypes0,
|
|
Context, arg_number)
|
|
;
|
|
[]
|
|
),
|
|
|
|
% Remove aditi:states, convert arguments to output.
|
|
{ type_util__remove_aditi_state(ArgTypes0, ArgTypes0, ArgTypes) },
|
|
{ type_util__remove_aditi_state(ArgTypes0, ArgModes0, ArgModes1) },
|
|
{ list__map(magic_util__mode_to_output_mode(ModuleInfo0),
|
|
ArgModes1, ArgModes) },
|
|
{ type_util__remove_aditi_state(ArgTypes0, HeadVars0, HeadVars) },
|
|
{ pred_info_get_indexes(PredInfo0, Indexes0) },
|
|
{ list__map(magic_util__adjust_index(ArgTypes0), Indexes0, Indexes) },
|
|
{ pred_info_set_indexes(Indexes, PredInfo0, PredInfo1) },
|
|
{ pred_info_set_arg_types(TVarSet, ExistQVars, ArgTypes,
|
|
PredInfo1, PredInfo) },
|
|
{ proc_info_set_argmodes(ArgModes, ProcInfo0, ProcInfo1) },
|
|
{ proc_info_set_headvars(HeadVars, ProcInfo1, ProcInfo) },
|
|
{ module_info_set_pred_proc_info(PredProcId, PredInfo, ProcInfo,
|
|
ModuleInfo0, ModuleInfo) },
|
|
magic_info_set_module_info(ModuleInfo),
|
|
magic__interface_from_c([CPredProcId], CPredProcId, PredProcId).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Go over each sub-module adding in the input arguments for each
|
|
% procedure, allocating the magic predicates, filling in the
|
|
% magic_map, pred_map and magic_proc_info fields of the magic_info.
|
|
:- pred magic__preprocess_scc(aditi_scc::in,
|
|
magic_info::in, magic_info::out) is det.
|
|
|
|
magic__preprocess_scc(aditi_scc(SCC0, EntryPoints)) -->
|
|
{ list__condense(SCC0, SCC) },
|
|
magic__get_scc_inputs(EntryPoints, InputTypes, InputModes),
|
|
list__foldl(magic__adjust_pred_info(EntryPoints,
|
|
InputTypes, InputModes), SCC).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Work out the types and modes of the input relations that need
|
|
% to be passed around the sub-module.
|
|
:- pred magic__get_scc_inputs(list(pred_proc_id)::in, list(type)::out,
|
|
list(mode)::out, magic_info::in, magic_info::out) is det.
|
|
|
|
magic__get_scc_inputs([], [], []) --> [].
|
|
magic__get_scc_inputs([PredProcId | PredProcIds],
|
|
[Type | Types], [Mode | Modes]) -->
|
|
magic_info_get_module_info(ModuleInfo),
|
|
{ module_info_pred_proc_info(ModuleInfo, PredProcId,
|
|
PredInfo, ProcInfo) },
|
|
{ proc_info_argmodes(ProcInfo, ArgModes0) },
|
|
{ pred_info_arg_types(PredInfo, ArgTypes0) },
|
|
{ type_util__remove_aditi_state(ArgTypes0, ArgTypes0, ArgTypes) },
|
|
{ type_util__remove_aditi_state(ArgTypes0, ArgModes0, ArgModes) },
|
|
{ partition_args(ModuleInfo, ArgModes, ArgModes, InputModes, _) },
|
|
{ partition_args(ModuleInfo, ArgModes, ArgTypes, InputTypes, _) },
|
|
{ construct_higher_order_type((pure), predicate, (aditi_bottom_up),
|
|
InputTypes, Type) },
|
|
{ GetOutputMode = (pred(ArgMode::in, OutputMode::out) is det :-
|
|
mode_get_insts(ModuleInfo, ArgMode, _, OutputInst),
|
|
OutputMode = (free -> OutputInst)
|
|
) },
|
|
{ list__map(GetOutputMode, InputModes, InputRelModes) },
|
|
{ Inst = ground(unique, higher_order(pred_inst_info(predicate,
|
|
InputRelModes, nondet))) },
|
|
{ Mode = (Inst -> Inst) },
|
|
magic__get_scc_inputs(PredProcIds, Types, Modes).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred magic__adjust_pred_info(list(pred_proc_id)::in, list(type)::in,
|
|
list(mode)::in, pred_proc_id::in,
|
|
magic_info::in, magic_info::out) is det.
|
|
|
|
magic__adjust_pred_info(EntryPoints, MagicTypes,
|
|
MagicModes, PredProcId0) -->
|
|
{ PredProcId0 = proc(PredId0, ProcId0) },
|
|
magic__separate_proc(PredId0, ProcId0),
|
|
magic_info_get_pred_map(PredMap1),
|
|
{ map__lookup(PredMap1, PredProcId0, PredProcId) },
|
|
magic__adjust_proc_info(EntryPoints, PredProcId0, PredProcId,
|
|
MagicTypes, MagicModes).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Separate out the procedures for each predicate so that each
|
|
% pred_info for a derived database predicate contains only one
|
|
% proc_info. This is necessary because the different procedures
|
|
% have different numbers of input arguments and are members of
|
|
% different sub-modules, so the transformed procedures will have
|
|
% different numbers and types of input relation arguments. We also need
|
|
% to leave the original declarations so that predicates compiled
|
|
% to C can call the procedure.
|
|
:- pred magic__separate_proc(pred_id::in, proc_id::in,
|
|
magic_info::in, magic_info::out) is det.
|
|
|
|
magic__separate_proc(PredId, ProcId) -->
|
|
magic_info_get_module_info(ModuleInfo0),
|
|
{ module_info_pred_proc_info(ModuleInfo0, PredId, ProcId,
|
|
PredInfo0, ProcInfo0) },
|
|
magic_info_set_curr_pred_proc_id(proc(PredId, ProcId)),
|
|
magic_info_set_error_pred_proc_id(proc(PredId, ProcId)),
|
|
{ set__init(ErrorVars) },
|
|
magic_info_set_error_vars(ErrorVars),
|
|
|
|
%
|
|
% Create a new pred_info for the procedure.
|
|
%
|
|
|
|
% Produce a unique name for the procedure.
|
|
{ Module = pred_info_module(PredInfo0) },
|
|
{ Name = pred_info_name(PredInfo0) },
|
|
{ pred_info_get_markers(PredInfo0, Markers) },
|
|
|
|
( { check_marker(Markers, base_relation) } ->
|
|
% Base relations must keep the old name.
|
|
{ NewName = qualified(Module, Name) }
|
|
;
|
|
magic_util__make_pred_name(PredInfo0, ProcId,
|
|
"Aditi_Proc_For", no, NewName)
|
|
),
|
|
|
|
{ pred_info_arg_types(PredInfo0, TVarSet, ExistQVars, ArgTypes) },
|
|
{ pred_info_context(PredInfo0, Context) },
|
|
{ pred_info_import_status(PredInfo0, Status) },
|
|
{ PredOrFunc = pred_info_is_pred_or_func(PredInfo0) },
|
|
{ pred_info_get_aditi_owner(PredInfo0, Owner) },
|
|
{ pred_info_get_indexes(PredInfo0, Indexes) },
|
|
% type classes aren't supported in Aditi.
|
|
{ ClassConstraints = constraints([], []) },
|
|
{ set__init(Assertions) },
|
|
{ pred_info_create(Module, NewName, PredOrFunc, Context,
|
|
created(aditi_magic), Status, Markers, ArgTypes, TVarSet,
|
|
ExistQVars, ClassConstraints, Assertions, Owner, ProcInfo0,
|
|
NewProcId, NewPredInfo0) },
|
|
{ pred_info_set_indexes(Indexes, NewPredInfo0, NewPredInfo) },
|
|
|
|
magic_info_get_module_info(ModuleInfo1),
|
|
{ module_info_get_predicate_table(ModuleInfo1, PredTable0) },
|
|
{ predicate_table_insert(NewPredInfo, NewPredId,
|
|
PredTable0, PredTable) },
|
|
{ module_info_set_predicate_table(PredTable,
|
|
ModuleInfo0, ModuleInfo) },
|
|
magic_info_set_module_info(ModuleInfo),
|
|
|
|
%
|
|
% Later we need to convert all calls to the old
|
|
% procedure to calls to the new.
|
|
%
|
|
magic_info_get_pred_map(PredMap0),
|
|
{ map__det_insert(PredMap0, proc(PredId, ProcId),
|
|
proc(NewPredId, NewProcId), PredMap) },
|
|
magic_info_set_pred_map(PredMap).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Preprocess the procedure
|
|
% - preprocess the goal
|
|
% - convert input arguments to output
|
|
% - add input closure arguments
|
|
:- pred magic__adjust_proc_info(list(pred_proc_id)::in, pred_proc_id::in,
|
|
pred_proc_id::in, list(type)::in, list(mode)::in,
|
|
magic_info::in, magic_info::out) is det.
|
|
|
|
magic__adjust_proc_info(EntryPoints, CPredProcId, AditiPredProcId,
|
|
MagicTypes, MagicModes) -->
|
|
magic_info_get_module_info(ModuleInfo0),
|
|
{ module_info_pred_proc_info(ModuleInfo0, AditiPredProcId,
|
|
PredInfo0, ProcInfo0) },
|
|
magic_info_set_error_pred_proc_id(CPredProcId),
|
|
{ set__init(ErrorVars) },
|
|
magic_info_set_error_vars(ErrorVars),
|
|
|
|
magic__preprocess_proc(CPredProcId, PredInfo0,
|
|
ProcInfo0, ProcInfo1),
|
|
|
|
%
|
|
% Find which of the arguments of the SCC carries the
|
|
% input for the current procedure.
|
|
%
|
|
{ list__nth_member_search(EntryPoints, CPredProcId, N) ->
|
|
Index = yes(N),
|
|
( EntryPoints \= [_], pred_info_is_exported(PredInfo0) ->
|
|
InterfaceRequired = yes(N)
|
|
;
|
|
InterfaceRequired = no
|
|
)
|
|
;
|
|
Index = no,
|
|
InterfaceRequired = no
|
|
},
|
|
|
|
{ proc_info_inst_varset(ProcInfo1, InstVarSet) },
|
|
magic__adjust_args(CPredProcId, AditiPredProcId, InterfaceRequired,
|
|
Index, MagicTypes, MagicModes, PredInfo0, ProcInfo1,
|
|
InputArgTypes, InputArgModes, LocalAditiPredProcId),
|
|
|
|
( { pred_info_is_imported(PredInfo0) } ->
|
|
[]
|
|
;
|
|
% Create a new procedure to collect the input
|
|
% for the current procedure.
|
|
magic__create_magic_pred(CPredProcId, LocalAditiPredProcId,
|
|
MagicTypes, MagicModes, InputArgTypes, InputArgModes,
|
|
InstVarSet, Index)
|
|
),
|
|
|
|
%
|
|
% Replace the goal for the C procedure with a goal to
|
|
% interface with the Aditi procedure from C, unless --aditi-only
|
|
% was specified or the procedure is imported.
|
|
%
|
|
magic__interface_from_c(EntryPoints, CPredProcId,
|
|
LocalAditiPredProcId).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Given a pred_info and a proc_info remove `aditi__state's from the
|
|
% arguments and set up the input closure arguments.
|
|
% Create an interface procedure if the SCC has multiple entry points
|
|
% and is exported.
|
|
:- pred magic__adjust_args(pred_proc_id::in, pred_proc_id::in, maybe(int)::in,
|
|
maybe(int)::in, list(type)::in, list(mode)::in,
|
|
pred_info::in, proc_info::in, list(type)::out, list(mode)::out,
|
|
pred_proc_id::out, magic_info::in, magic_info::out) is det.
|
|
|
|
magic__adjust_args(CPredProcId, AditiPredProcId, InterfaceRequired,
|
|
MaybeIndex, MagicTypes, MagicModes, PredInfo0, ProcInfo0,
|
|
InputArgTypes, InputArgModes, LocalAditiPredProcId) -->
|
|
|
|
%
|
|
% Check that the argument types and modes
|
|
% are legal for Aditi procedures.
|
|
%
|
|
{ pred_info_arg_types(PredInfo0, TVarSet, ExistQVars, ArgTypes0) },
|
|
{ proc_info_headvars(ProcInfo0, HeadVars0) },
|
|
{ pred_info_context(PredInfo0, Context) },
|
|
{ proc_info_argmodes(ProcInfo0, ArgModes0) },
|
|
magic_util__check_args(HeadVars0, ArgModes0, ArgTypes0, Context,
|
|
arg_number),
|
|
|
|
%
|
|
% Strip out the aditi__state argument.
|
|
%
|
|
{ type_util__remove_aditi_state(ArgTypes0, ArgTypes0, ArgTypes1) },
|
|
{ type_util__remove_aditi_state(ArgTypes0, HeadVars0, HeadVars1) },
|
|
{ type_util__remove_aditi_state(ArgTypes0, ArgModes0, ArgModes1) },
|
|
|
|
%
|
|
% Convert all of the original modes to output. The input
|
|
% will be carried in with the input closures.
|
|
%
|
|
magic_info_get_module_info(ModuleInfo0),
|
|
{ list__map(magic_util__mode_to_output_mode(ModuleInfo0),
|
|
ArgModes1, ArgModes2) },
|
|
|
|
% Create variables for the magic input.
|
|
{ proc_info_create_vars_from_types(MagicTypes, MagicVars,
|
|
ProcInfo0, ProcInfo1) },
|
|
|
|
%
|
|
% Add the input relation variables to the arguments.
|
|
%
|
|
{ list__append(MagicVars, HeadVars1, HeadVars) },
|
|
{ list__append(MagicModes, ArgModes2, ArgModes) },
|
|
{ list__append(MagicTypes, ArgTypes1, ArgTypes) },
|
|
|
|
%
|
|
% Ensure that the exported interface procedure gets the
|
|
% correct argmodes.
|
|
%
|
|
{ instmap_delta_from_mode_list(HeadVars, ArgModes,
|
|
ModuleInfo0, InstMapDelta) },
|
|
{ proc_info_goal(ProcInfo1, Goal0 - GoalInfo0) },
|
|
{ goal_info_set_instmap_delta(GoalInfo0, InstMapDelta, GoalInfo) },
|
|
{ proc_info_set_goal(Goal0 - GoalInfo, ProcInfo1, ProcInfo2) },
|
|
|
|
% All Aditi procedures are considered nondet. The C interface
|
|
% procedures retain the old determinism, and abort if the number
|
|
% of answers returned doesn't match the determinism.
|
|
{ proc_info_set_inferred_determinism(nondet, ProcInfo2, ProcInfo3) },
|
|
|
|
{ partition_args(ModuleInfo0, ArgModes1,
|
|
ArgModes1, InputArgModes, _) },
|
|
{ partition_args(ModuleInfo0, ArgModes1,
|
|
ArgTypes1, InputArgTypes, _) },
|
|
|
|
{ pred_info_set_arg_types(TVarSet, ExistQVars, ArgTypes,
|
|
PredInfo0, PredInfo) },
|
|
|
|
{ proc_info_set_headvars(HeadVars, ProcInfo3, ProcInfo4) },
|
|
{ proc_info_set_argmodes(ArgModes, ProcInfo4, ProcInfo) },
|
|
|
|
( { InterfaceRequired = yes(Index) } ->
|
|
magic__create_interface_proc(Index, CPredProcId,
|
|
AditiPredProcId, PredInfo0, ProcInfo3, ProcInfo,
|
|
HeadVars1, ArgTypes1, ArgModes2, MagicVars,
|
|
MagicTypes, MagicModes, LocalAditiPredProcId)
|
|
;
|
|
magic_info_get_module_info(ModuleInfo5),
|
|
{ module_info_set_pred_proc_info(AditiPredProcId,
|
|
PredInfo, ProcInfo, ModuleInfo5, ModuleInfo) },
|
|
magic_info_set_module_info(ModuleInfo),
|
|
{ LocalAditiPredProcId = AditiPredProcId }
|
|
),
|
|
|
|
{ ThisProcInfo = magic_proc_info(ArgModes1, MagicVars,
|
|
MagicTypes, MagicModes, MaybeIndex) },
|
|
magic_info_get_magic_proc_info(MagicProcInfo0),
|
|
{ map__det_insert(MagicProcInfo0, LocalAditiPredProcId,
|
|
ThisProcInfo, MagicProcInfo) },
|
|
magic_info_set_magic_proc_info(MagicProcInfo).
|
|
|
|
%
|
|
% Create an interface procedure to a sub-module for a particular
|
|
% entry-point, used by Mercury compiled to C and Aditi procedures
|
|
% in other modules.
|
|
% A local version is created which takes all the input
|
|
% arguments. The exported version calls this version
|
|
% with empty relations for all except one of the
|
|
% input arguments.
|
|
%
|
|
:- pred magic__create_interface_proc(int::in, pred_proc_id::in,
|
|
pred_proc_id::in, pred_info::in, proc_info::in, proc_info::in,
|
|
list(prog_var)::in, list(type)::in, list(mode)::in,
|
|
list(prog_var)::in, list(type)::in, list(mode)::in,
|
|
pred_proc_id::out, magic_info::in, magic_info::out) is det.
|
|
|
|
magic__create_interface_proc(Index, CPredProcId, AditiPredProcId,
|
|
ExportedPredInfo0, ExportedProcInfo0, LocalProcInfo,
|
|
HeadVars1, ArgTypes1, ArgModes1, MagicVars,
|
|
MagicTypes, MagicModes, LocalPredProcId) -->
|
|
|
|
%
|
|
% Create the local version.
|
|
%
|
|
{ proc_info_goal(LocalProcInfo, Goal) },
|
|
magic_info_get_module_info(ModuleInfo1),
|
|
{ proc_info_get_initial_instmap(LocalProcInfo, ModuleInfo1, InstMap) },
|
|
{ PredName0 = pred_info_name(ExportedPredInfo0) },
|
|
{ string__append(PredName0, "__local", PredName) },
|
|
{ proc_info_headvars(LocalProcInfo, HeadVars) },
|
|
{ proc_info_vartypes(LocalProcInfo, VarTypes) },
|
|
{ proc_info_varset(LocalProcInfo, VarSet) },
|
|
{ proc_info_inst_varset(LocalProcInfo, InstVarSet) },
|
|
{ pred_info_get_markers(ExportedPredInfo0, Markers) },
|
|
{ pred_info_get_aditi_owner(ExportedPredInfo0, Owner) },
|
|
|
|
{ ClassContext = constraints([], []) },
|
|
{ map__init(TVarMap) },
|
|
{ map__init(TCVarMap) },
|
|
{ varset__init(TVarSet) },
|
|
{ hlds_pred__define_new_pred(created(aditi_magic_interface),
|
|
Goal, CallGoal, HeadVars, ExtraArgs, InstMap, PredName,
|
|
TVarSet, VarTypes, ClassContext, TVarMap, TCVarMap,
|
|
VarSet, InstVarSet, Markers, Owner, address_is_not_taken,
|
|
ModuleInfo1, ModuleInfo2, LocalPredProcId) },
|
|
{ ExtraArgs = [] ->
|
|
true
|
|
;
|
|
error("magic__create_interface_proc: typeinfo arguments")
|
|
},
|
|
magic_info_set_module_info(ModuleInfo2),
|
|
|
|
% Calls in this module should be redirected to point to
|
|
% the local version.
|
|
magic_info_get_pred_map(PredMap0),
|
|
{ map__det_update(PredMap0, CPredProcId, LocalPredProcId, PredMap) },
|
|
magic_info_set_pred_map(PredMap),
|
|
|
|
%
|
|
% Add the single magic input relation to the argument list of
|
|
% the exported version.
|
|
%
|
|
{ list__index1_det(MagicVars, Index, MagicInputVar) },
|
|
{ list__index1_det(MagicTypes, Index, MagicInputType) },
|
|
{ list__index1_det(MagicModes, Index, MagicInputMode) },
|
|
{ ExportedArgModes = [MagicInputMode | ArgModes1] },
|
|
{ ExportedArgTypes = [MagicInputType | ArgTypes1] },
|
|
{ ExportedHeadVars = [MagicInputVar | HeadVars1] },
|
|
{ proc_info_set_headvars(ExportedHeadVars,
|
|
ExportedProcInfo0, ExportedProcInfo1) },
|
|
{ proc_info_set_argmodes(ExportedArgModes,
|
|
ExportedProcInfo1, ExportedProcInfo2) },
|
|
{ pred_info_set_arg_types(TVarSet, [], ExportedArgTypes,
|
|
ExportedPredInfo0, ExportedPredInfo1) },
|
|
|
|
%
|
|
% Construct the input for the call to the local version.
|
|
%
|
|
magic_info_set_pred_info(ExportedPredInfo1),
|
|
magic_info_set_proc_info(ExportedProcInfo2),
|
|
magic__interface_call_args(MagicVars, MagicTypes, MagicModes,
|
|
Index, 1, InputGoals),
|
|
magic_info_get_pred_info(ExportedPredInfo2),
|
|
magic_info_get_proc_info(ExportedProcInfo3),
|
|
{ CallGoal = _ - CallGoalInfo },
|
|
{ list__append(InputGoals, [CallGoal], ExportedConj) },
|
|
{ conj_list_to_goal(ExportedConj, CallGoalInfo, ExportedGoal) },
|
|
{ proc_info_set_goal(ExportedGoal,
|
|
ExportedProcInfo3, ExportedProcInfo) },
|
|
|
|
{ pred_info_set_import_status(exported,
|
|
ExportedPredInfo2, ExportedPredInfo) },
|
|
magic_info_get_module_info(ModuleInfo5),
|
|
{ module_info_set_pred_proc_info(AditiPredProcId,
|
|
ExportedPredInfo, ExportedProcInfo,
|
|
ModuleInfo5, ModuleInfo6) },
|
|
magic_info_set_module_info(ModuleInfo6).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred magic__interface_call_args(list(prog_var)::in, list(type)::in,
|
|
list(mode)::in, int::in, int::in, list(hlds_goal)::out,
|
|
magic_info::in, magic_info::out) is det.
|
|
|
|
magic__interface_call_args([], _, _, _, _, []) --> [].
|
|
magic__interface_call_args([MagicInput | MagicInputs], MagicTypes, MagicModes,
|
|
CalledPredIndex, CurrVar, InputGoals) -->
|
|
{ NextVar = CurrVar + 1 },
|
|
magic__interface_call_args(MagicInputs, MagicTypes, MagicModes,
|
|
CalledPredIndex, NextVar, InputGoals1),
|
|
( { CurrVar = CalledPredIndex } ->
|
|
%
|
|
% Just pass through the closure passed in
|
|
% from the calling module.
|
|
%
|
|
{ InputGoals = InputGoals1 }
|
|
;
|
|
%
|
|
% Create an empty input closure.
|
|
%
|
|
{ list__index1_det(MagicTypes, CurrVar, MagicType) },
|
|
{
|
|
type_is_higher_order(MagicType, (pure), predicate,
|
|
(aditi_bottom_up), ArgTypes1)
|
|
->
|
|
ArgTypes = ArgTypes1
|
|
;
|
|
error("magic__interface_call_args")
|
|
},
|
|
magic_info_get_proc_info(ProcInfo0),
|
|
{ proc_info_create_vars_from_types(ArgTypes, Args,
|
|
ProcInfo0, ProcInfo) },
|
|
magic_info_set_proc_info(ProcInfo),
|
|
{ fail_goal(LambdaGoal) },
|
|
{ list__index1_det(MagicModes, CurrVar, InputMode) },
|
|
magic_util__create_closure(CurrVar, MagicInput, InputMode,
|
|
LambdaGoal, [], Args, InputGoal),
|
|
{ InputGoals = [InputGoal | InputGoals1] }
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred magic__interface_from_c(list(pred_proc_id)::in, pred_proc_id::in,
|
|
pred_proc_id::in, magic_info::in, magic_info::out) is det.
|
|
|
|
magic__interface_from_c(EntryPoints, CPredProcId, AditiPredProcId) -->
|
|
magic_info_get_module_info(ModuleInfo0),
|
|
{ module_info_globals(ModuleInfo0, Globals) },
|
|
{ globals__lookup_bool_option(Globals, aditi_only, AditiOnly) },
|
|
{ module_info_pred_proc_info(ModuleInfo0,
|
|
CPredProcId, PredInfo0, ProcInfo0) },
|
|
|
|
{ pred_info_get_markers(PredInfo0, Markers) },
|
|
{ module_info_name(ModuleInfo0, ModuleName) },
|
|
(
|
|
{ AditiOnly = no },
|
|
{ check_marker(Markers, base_relation) },
|
|
{ ModuleName = pred_info_module(PredInfo0) }
|
|
->
|
|
{ pred_info_set_import_status(exported,
|
|
PredInfo0, PredInfo1) },
|
|
{ module_info_set_pred_proc_info(CPredProcId,
|
|
PredInfo1, ProcInfo0, ModuleInfo0, ModuleInfo1) },
|
|
magic_info_set_module_info(ModuleInfo1)
|
|
;
|
|
{ PredInfo1 = PredInfo0 },
|
|
{ ModuleInfo1 = ModuleInfo0 }
|
|
),
|
|
magic_info_get_errors(Errors),
|
|
( { pred_info_is_imported(PredInfo1) } ->
|
|
[]
|
|
; { \+ set__empty(Errors) } ->
|
|
[]
|
|
; { AditiOnly = yes ; \+ list__member(CPredProcId, EntryPoints) } ->
|
|
%
|
|
% If no interface procedure is required we just throw
|
|
% away the goal. The predicate is now an ordinary Mercury
|
|
% predicate.
|
|
%
|
|
{ true_goal(Goal) },
|
|
{ proc_info_set_goal(Goal, ProcInfo0, ProcInfo) },
|
|
{ module_info_set_pred_proc_info(CPredProcId,
|
|
PredInfo1, ProcInfo, ModuleInfo1, ModuleInfo) },
|
|
magic_info_set_module_info(ModuleInfo)
|
|
;
|
|
{ magic__create_input_join_proc(CPredProcId, AditiPredProcId,
|
|
_JoinPredProcId, ModuleInfo1, ModuleInfo2) },
|
|
|
|
%
|
|
% Change the goal for the original procedure to
|
|
% call the database procedure.
|
|
%
|
|
{ aditi_builtin_ops__create_aditi_call_proc(CPredProcId,
|
|
ModuleInfo2, ModuleInfo) },
|
|
magic_info_set_module_info(ModuleInfo)
|
|
).
|
|
|
|
% Make a procedure which calls the Aditi predicate, then joins
|
|
% the result with the input and projects out the input arguments.
|
|
:- pred magic__create_input_join_proc(pred_proc_id::in, pred_proc_id::in,
|
|
pred_proc_id::out, module_info::in, module_info::out) is det.
|
|
|
|
magic__create_input_join_proc(CPredProcId, AditiPredProcId, JoinPredProcId,
|
|
ModuleInfo0, ModuleInfo) :-
|
|
module_info_pred_proc_info(ModuleInfo0, CPredProcId,
|
|
CPredInfo, CProcInfo),
|
|
proc_info_argmodes(CProcInfo, ArgModes0),
|
|
pred_info_arg_types(CPredInfo, ArgTypes),
|
|
type_util__remove_aditi_state(ArgTypes, ArgModes0, ArgModes),
|
|
partition_args(ModuleInfo0, ArgModes, ArgModes,
|
|
InputArgModes, OutputArgModes),
|
|
|
|
%
|
|
% The interface procedure on the Aditi side must have
|
|
% only one input closure argument.
|
|
%
|
|
proc_info_vartypes(CProcInfo, VarTypes0),
|
|
proc_info_headvars(CProcInfo, HeadVars0),
|
|
type_util__remove_aditi_state(ArgTypes,
|
|
HeadVars0, HeadVars),
|
|
|
|
partition_args(ModuleInfo0, ArgModes, HeadVars,
|
|
InputArgs, OutputArgs),
|
|
|
|
map__apply_to_list(InputArgs, VarTypes0, InputVarTypes),
|
|
|
|
construct_higher_order_type((pure), predicate, (aditi_bottom_up),
|
|
InputVarTypes, ClosureVarType),
|
|
list__map(magic_util__mode_to_output_mode(ModuleInfo0),
|
|
InputArgModes, MagicArgModes),
|
|
|
|
JoinProcInfo0 = CProcInfo,
|
|
proc_info_create_var_from_type(ClosureVarType, no, ClosureVar,
|
|
JoinProcInfo0, JoinProcInfo1),
|
|
|
|
|
|
%
|
|
% Build a goal to call the input closure.
|
|
%
|
|
|
|
set__list_to_set([ClosureVar | InputArgs], HOCallNonLocals),
|
|
instmap_delta_from_mode_list(InputArgs, MagicArgModes,
|
|
ModuleInfo0, HOCallDelta),
|
|
goal_info_init(HOCallNonLocals, HOCallDelta, nondet, pure,
|
|
InputGoalInfo),
|
|
list__length(InputArgs, Arity),
|
|
InputGoal = generic_call(
|
|
higher_order(ClosureVar, (pure), predicate, Arity),
|
|
InputArgs, MagicArgModes, nondet) - InputGoalInfo,
|
|
|
|
ClosureInst = ground(shared,
|
|
higher_order(pred_inst_info(predicate, MagicArgModes, nondet))),
|
|
ClosureMode = (ClosureInst -> ClosureInst),
|
|
proc_info_set_argmodes([ClosureMode | OutputArgModes],
|
|
JoinProcInfo1, JoinProcInfo2),
|
|
proc_info_set_headvars([ClosureVar | OutputArgs],
|
|
JoinProcInfo2, JoinProcInfo3),
|
|
|
|
magic__build_join_pred_info(CPredProcId, CPredInfo,
|
|
JoinProcInfo3, [ClosureVar | OutputArgs],
|
|
JoinPredProcId, JoinPredInfo, ModuleInfo0, ModuleInfo1),
|
|
|
|
%
|
|
% Build a call to the Aditi procedure.
|
|
%
|
|
|
|
AditiPredProcId = proc(AditiPredId, AditiProcId),
|
|
proc_info_goal(CProcInfo, _ - CallGoalInfo0),
|
|
|
|
% Convert input arguments to output arguments, producing
|
|
% the tests which will make up the join condition.
|
|
magic_util__create_input_test_unifications(ModuleInfo1, HeadVars,
|
|
InputArgs, ArgModes, CallArgs0, [], Tests,
|
|
CallGoalInfo0, CallGoalInfo, JoinProcInfo3, JoinProcInfo4),
|
|
|
|
( hlds_pred__pred_info_is_base_relation(CPredInfo) ->
|
|
CallArgs = CallArgs0
|
|
;
|
|
CallArgs = [ClosureVar | CallArgs0]
|
|
),
|
|
|
|
module_info_pred_info(ModuleInfo1, AditiPredId, AditiPredInfo),
|
|
PredModule = pred_info_module(AditiPredInfo),
|
|
PredName = pred_info_name(AditiPredInfo),
|
|
CallGoal = call(AditiPredId, AditiProcId, CallArgs, not_builtin,
|
|
no, qualified(PredModule, PredName)) - CallGoalInfo,
|
|
|
|
instmap_delta_from_mode_list(OutputArgs, OutputArgModes,
|
|
ModuleInfo1, GoalDelta),
|
|
set__list_to_set([ClosureVar | OutputArgs],
|
|
GoalNonLocals),
|
|
goal_info_init(GoalNonLocals, GoalDelta, nondet, pure, GoalInfo),
|
|
conj_list_to_goal([InputGoal, CallGoal | Tests], GoalInfo,
|
|
JoinGoal),
|
|
proc_info_set_goal(JoinGoal, JoinProcInfo4, JoinProcInfo),
|
|
module_info_set_pred_proc_info(JoinPredProcId,
|
|
JoinPredInfo, JoinProcInfo, ModuleInfo1, ModuleInfo).
|
|
|
|
:- pred magic__build_join_pred_info(pred_proc_id::in, pred_info::in,
|
|
proc_info::in, list(prog_var)::in, pred_proc_id::out,
|
|
pred_info::out, module_info::in, module_info::out) is det.
|
|
|
|
magic__build_join_pred_info(CPredProcId, CPredInfo, JoinProcInfo,
|
|
Args, JoinPredProcId, JoinPredInfo, !ModuleInfo) :-
|
|
proc_info_vartypes(JoinProcInfo, JoinVarTypes),
|
|
map__apply_to_list(Args, JoinVarTypes, NewArgTypes),
|
|
PredModule = pred_info_module(CPredInfo),
|
|
rl__get_c_interface_proc_name(!.ModuleInfo, CPredProcId, NewPredName),
|
|
init_markers(Markers0),
|
|
add_marker(aditi, Markers0, Markers1),
|
|
add_marker(aditi_no_memo, Markers1, Markers2),
|
|
add_marker(naive, Markers2, Markers),
|
|
ClassContext = constraints([], []),
|
|
pred_info_get_aditi_owner(CPredInfo, User),
|
|
varset__init(TVarSet), % must be empty.
|
|
term__context_init(DummyContext),
|
|
ExistQVars = [],
|
|
set__init(Assertions),
|
|
pred_info_create(PredModule, qualified(PredModule, NewPredName),
|
|
predicate, DummyContext, created(aditi_join), exported,
|
|
Markers, NewArgTypes, TVarSet, ExistQVars,
|
|
ClassContext, Assertions, User,
|
|
JoinProcInfo, JoinProcId, JoinPredInfo),
|
|
|
|
module_info_get_predicate_table(!.ModuleInfo, Preds0),
|
|
predicate_table_insert(JoinPredInfo, JoinPredId, Preds0, Preds),
|
|
JoinPredProcId = proc(JoinPredId, JoinProcId),
|
|
module_info_set_predicate_table(Preds, !ModuleInfo).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Allocate a predicate to collect the input for the current predicate.
|
|
:- pred magic__create_magic_pred(pred_proc_id::in, pred_proc_id::in,
|
|
list(type)::in, list(mode)::in, list(type)::in,
|
|
list(mode)::in, inst_varset::in, maybe(int)::in,
|
|
magic_info::in, magic_info::out) is det.
|
|
|
|
magic__create_magic_pred(CPredProcId, PredProcId, MagicTypes, MagicModes,
|
|
InputTypes0, InputModes0, InstVarSet, Index) -->
|
|
|
|
magic_info_get_module_info(ModuleInfo0),
|
|
|
|
{ varset__init(VarSet0) },
|
|
{ map__init(VarTypes0) },
|
|
|
|
% Get some new vars to carry the magic input.
|
|
{ list__length(MagicTypes, NumMagicArgs) },
|
|
{ varset__new_vars(VarSet0, NumMagicArgs, MagicArgs, VarSet1) },
|
|
{ map__det_insert_from_corresponding_lists(VarTypes0, MagicArgs,
|
|
MagicTypes, VarTypes1) },
|
|
|
|
% Get some new vars for the outputs.
|
|
{ list__length(InputModes0, NumInputArgs) },
|
|
{ varset__new_vars(VarSet1, NumInputArgs, InputArgs0, VarSet2) },
|
|
{ map__det_insert_from_corresponding_lists(VarTypes1, InputArgs0,
|
|
InputTypes0, VarTypes2) },
|
|
|
|
{ list__map(magic_util__mode_to_output_mode(ModuleInfo0),
|
|
InputModes0, OutputModes0) },
|
|
|
|
{ module_info_pred_proc_info(ModuleInfo0, PredProcId,
|
|
PredInfo, _) },
|
|
{ pred_info_get_markers(PredInfo, Markers) },
|
|
{ check_marker(Markers, context) ->
|
|
% For magic context predicates, we get two copies of
|
|
% the outputs. (See the paper cited at the top of context.m)
|
|
varset__new_vars(VarSet2, NumInputArgs, InputArgs1, VarSet),
|
|
map__det_insert_from_corresponding_lists(VarTypes2,
|
|
InputArgs1, InputTypes0, VarTypes),
|
|
list__append(InputArgs0, InputArgs1, InputArgs),
|
|
list__append(InputTypes0, InputTypes0, InputTypes),
|
|
list__append(OutputModes0, OutputModes0, OutputModes),
|
|
assoc_list__from_corresponding_lists(InputArgs0, InputArgs1,
|
|
ArgsAL0),
|
|
IsContext = yes(ArgsAL0)
|
|
;
|
|
VarSet = VarSet2,
|
|
VarTypes = VarTypes2,
|
|
InputArgs = InputArgs0,
|
|
InputTypes = InputTypes0,
|
|
OutputModes = OutputModes0,
|
|
IsContext = no
|
|
},
|
|
|
|
{ list__append(MagicArgs, InputArgs, AllArgs) },
|
|
( { Index = yes(N) } ->
|
|
%
|
|
% If this predicate is an entry point to the sub-module,
|
|
% create a rule in the magic predicate to collect
|
|
% the input relation.
|
|
%
|
|
{ list__index1_det(MagicArgs, N, CurrPredVar) },
|
|
{ set__list_to_set([CurrPredVar | InputArgs0], NonLocals0) },
|
|
{ mode_list_get_final_insts(OutputModes0, ModuleInfo0,
|
|
OutputInsts0) },
|
|
{ assoc_list__from_corresponding_lists(InputArgs0,
|
|
OutputInsts0, InstAL0) },
|
|
{ instmap_delta_from_assoc_list(InstAL0, InstMapDelta0) },
|
|
{ goal_info_init(NonLocals0, InstMapDelta0,
|
|
nondet, pure, GoalInfo0) },
|
|
{ list__length(InputArgs0, Arity) },
|
|
{ Goal0 = generic_call(
|
|
higher_order(CurrPredVar, (pure), predicate, Arity),
|
|
InputArgs0, OutputModes0, nondet) - GoalInfo0 },
|
|
( { IsContext = yes(ArgsAL) } ->
|
|
% Create assignments to assign to the extra arguments.
|
|
{ magic__create_assignments(ModuleInfo0, ArgsAL,
|
|
OutputModes0, Assigns) },
|
|
{ list__append(OutputInsts0,
|
|
OutputInsts0, OutputInsts) },
|
|
{ assoc_list__from_corresponding_lists(InputArgs,
|
|
OutputInsts, InstAL) },
|
|
{ instmap_delta_from_assoc_list(InstAL, InstMapDelta) },
|
|
{ set__list_to_set([CurrPredVar | InputArgs],
|
|
NonLocals) },
|
|
{ goal_info_init(NonLocals, InstMapDelta, nondet, pure,
|
|
GoalInfo) },
|
|
{ conj_list_to_goal([Goal0 | Assigns],
|
|
GoalInfo, Goal) }
|
|
;
|
|
{ Goal = Goal0 }
|
|
)
|
|
;
|
|
% This predicate is not an entry point, so there's
|
|
% no input to collect.
|
|
{ fail_goal(Goal) }
|
|
),
|
|
|
|
{ list__append(MagicModes, OutputModes, AllArgModes) },
|
|
|
|
{ term__context_init(Context) },
|
|
|
|
% types must all be ground.
|
|
{ map__init(TVarMap) },
|
|
{ map__init(TCVarMap) },
|
|
|
|
{ proc_info_create(Context, VarSet, VarTypes, AllArgs, InstVarSet,
|
|
AllArgModes, nondet, Goal, TVarMap, TCVarMap,
|
|
address_is_not_taken, ProcInfo) },
|
|
|
|
%
|
|
% Fill in the pred_info.
|
|
%
|
|
|
|
{ CPredProcId = proc(CPredId, CProcId) },
|
|
{ module_info_pred_info(ModuleInfo0, CPredId, CPredInfo) },
|
|
{ ModuleName = pred_info_module(CPredInfo) },
|
|
magic_util__make_pred_name(CPredInfo, CProcId,
|
|
"Magic_Proc_For", no, SymName),
|
|
|
|
{ list__append(MagicTypes, InputTypes, AllArgTypes) },
|
|
{ varset__init(TVarSet) },
|
|
{ pred_info_get_aditi_owner(PredInfo, Owner) },
|
|
{ ClassConstraints = constraints([], []) },
|
|
{ ExistQVars = [] },
|
|
{ set__init(Assertions) },
|
|
{ pred_info_create(ModuleName, SymName, predicate, Context,
|
|
created(aditi_magic), local, Markers, AllArgTypes,
|
|
TVarSet, ExistQVars, ClassConstraints, Assertions, Owner,
|
|
ProcInfo, MagicProcId, MagicPredInfo) },
|
|
|
|
{ module_info_get_predicate_table(ModuleInfo0, PredTable0) },
|
|
{ predicate_table_insert(MagicPredInfo, MagicPredId,
|
|
PredTable0, PredTable) },
|
|
{ module_info_set_predicate_table(PredTable,
|
|
ModuleInfo0, ModuleInfo) },
|
|
magic_info_set_module_info(ModuleInfo),
|
|
|
|
% Record that the magic predicate in the magic_info.
|
|
{ MagicPredProcId = proc(MagicPredId, MagicProcId) },
|
|
magic_info_get_magic_map(MagicMap0),
|
|
{ map__det_insert(MagicMap0, PredProcId, MagicPredProcId, MagicMap) },
|
|
magic_info_set_magic_map(MagicMap).
|
|
|
|
|
|
% Produce assignments to the duplicate outputs
|
|
% of a context magic predicate.
|
|
:- pred magic__create_assignments(module_info::in,
|
|
assoc_list(prog_var, prog_var)::in,
|
|
list(mode)::in, list(hlds_goal)::out) is det.
|
|
|
|
magic__create_assignments(_, [], [], []).
|
|
magic__create_assignments(_, [], [_|_], _) :-
|
|
error("magic__create_assignments").
|
|
magic__create_assignments(_, [_|_], [], _) :-
|
|
error("magic__create_assignments").
|
|
magic__create_assignments(ModuleInfo, [Arg0 - Arg | ArgsAL],
|
|
[Mode | Modes], [Goal - GoalInfo | Assigns]) :-
|
|
mode_get_insts(ModuleInfo, Mode, _, Inst),
|
|
Goal = unify(Arg, var(Arg0), (free -> Inst) - (Inst -> Inst),
|
|
assign(Arg, Arg0), unify_context(explicit, [])),
|
|
set__list_to_set([Arg0, Arg], NonLocals),
|
|
instmap_delta_from_assoc_list([Arg - Inst], Delta),
|
|
goal_info_init(NonLocals, Delta, det, pure, GoalInfo),
|
|
magic__create_assignments(ModuleInfo, ArgsAL, Modes, Assigns).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Put the goal for a procedure in a form suitable for processing.
|
|
:- pred magic__preprocess_proc(pred_proc_id::in, pred_info::in,
|
|
proc_info::in, proc_info::out,
|
|
magic_info::in, magic_info::out) is det.
|
|
|
|
magic__preprocess_proc(PredProcId, PredInfo, !ProcInfo) -->
|
|
{ proc_info_goal(!.ProcInfo, Goal0) },
|
|
magic_info_set_curr_pred_proc_id(PredProcId),
|
|
magic_info_set_pred_info(PredInfo),
|
|
magic_info_set_proc_info(!.ProcInfo),
|
|
{ Goal0 = _ - GoalInfo0 },
|
|
{ goal_to_disj_list(Goal0, GoalList0) },
|
|
list__map_foldl(magic__preprocess_disjunct, GoalList0, GoalList),
|
|
{ disj_list_to_goal(GoalList, GoalInfo0, Goal) },
|
|
magic_info_get_proc_info(!:ProcInfo),
|
|
{ proc_info_set_goal(Goal, !ProcInfo) }.
|
|
|
|
% Undo common structure elimination of higher-order terms in an
|
|
% attempt to avoid creating procedures with higher-order arguments
|
|
% in the case where one closure is used by multiple aggregate calls.
|
|
% Restore superhomogeneous form for database predicates by introducing
|
|
% new variables for duplicate input arguments.
|
|
% Also remove assignments of `aditi:state's and report errors
|
|
% for goals other than database calls which have an `aditi:state'
|
|
% as a nonlocal.
|
|
:- pred magic__preprocess_disjunct(hlds_goal::in, hlds_goal::out,
|
|
magic_info::in, magic_info::out) is det.
|
|
|
|
magic__preprocess_disjunct(Disjunct0, Disjunct) -->
|
|
{ map__init(HOMap0) },
|
|
{ Disjunct0 = _ - DisjInfo },
|
|
magic__preprocess_goal(Disjunct0, Disjunct1, HOMap0, _),
|
|
{ conj_list_to_goal(Disjunct1, DisjInfo, Disjunct) }.
|
|
|
|
:- pred magic__preprocess_goal(hlds_goal::in, list(hlds_goal)::out,
|
|
map(prog_var, hlds_goal)::in, map(prog_var, hlds_goal)::out,
|
|
magic_info::in, magic_info::out) is det.
|
|
|
|
magic__preprocess_goal(Goal, Goals, HOMap0, HOMap) -->
|
|
magic__preprocess_goal_2(Goal, Goals, HOMap0, HOMap),
|
|
list__foldl(magic__check_goal_nonlocals, Goals).
|
|
|
|
:- pred magic__preprocess_goal_2(hlds_goal::in, list(hlds_goal)::out,
|
|
map(prog_var, hlds_goal)::in, map(prog_var, hlds_goal)::out,
|
|
magic_info::in, magic_info::out) is det.
|
|
|
|
% Switches, if-then-elses and disjunctions involving database calls
|
|
% should have been transformed into separate procedures by dnf.m.
|
|
magic__preprocess_goal_2(Goal, [Goal], HOMap, HOMap) -->
|
|
{ Goal = disj(_) - _ }.
|
|
magic__preprocess_goal_2(Goal, [Goal], HOMap, HOMap) -->
|
|
{ Goal = switch(_, _, _) - _ }.
|
|
magic__preprocess_goal_2(Goal, [Goal], HOMap, HOMap) -->
|
|
{ Goal = if_then_else(_, _, _, _) - _ }.
|
|
magic__preprocess_goal_2(par_conj(_) - _, _, _, _) -->
|
|
{ error("Sorry, not yet implemented: parallel conjunction in Aditi procedures") }.
|
|
magic__preprocess_goal_2(generic_call(_, _, _, _) - _, _, _, _) -->
|
|
{ error("Sorry, not yet implemented: higher-order or class-method calls in Aditi procedures") }.
|
|
magic__preprocess_goal_2(foreign_proc(_, _, _, _, _, _) - _, _, _, _) -->
|
|
{ error("Sorry, not yet implemented: foreign_proc calls in Aditi procedures") }.
|
|
magic__preprocess_goal_2(conj(Goals0) - GoalInfo, [conj(Goals) - GoalInfo],
|
|
HOMap0, HOMap) -->
|
|
magic__preprocess_conj(Goals0, [], Goals, HOMap0, HOMap).
|
|
magic__preprocess_goal_2(Goal0, Goals, HOMap, HOMap) -->
|
|
{ Goal0 = call(PredId, B, Args, C, D, E) - GoalInfo },
|
|
magic_info_get_module_info(ModuleInfo),
|
|
( { hlds_pred__is_aditi_aggregate(ModuleInfo, PredId) } ->
|
|
% Put the closures and the aggregate call in a sub-conjunction
|
|
% of the top-level conjunction.
|
|
magic__rename_and_generate_closures(Args, ExtraGoals,
|
|
Goal0, Goal1, HOMap),
|
|
{ list__append(ExtraGoals, [Goal1], Goals1) },
|
|
{ Goal0 = _ - GoalInfo0 },
|
|
{ conj_list_to_goal(Goals1, GoalInfo0, Goal) },
|
|
{ Goals = [Goal] }
|
|
; { hlds_pred__is_aditi_relation(ModuleInfo, PredId) } ->
|
|
% The predicates in magic_util.m to deal with input arguments
|
|
% expect that there are no duplicates.
|
|
{ set__init(SeenArgs) },
|
|
magic__preprocess_call_args(Args, NewArgs, SeenArgs,
|
|
[], IntroducedArgs, [], ExtraGoals),
|
|
{ goal_info_get_nonlocals(GoalInfo, NonLocals) },
|
|
{ set__insert_list(NonLocals, IntroducedArgs, NewNonLocals) },
|
|
{ goal_info_set_nonlocals(GoalInfo,
|
|
NewNonLocals, NewGoalInfo) },
|
|
{ NewCall = call(PredId, B, NewArgs, C, D, E) - NewGoalInfo },
|
|
{ list__append(ExtraGoals, [NewCall], Goals) }
|
|
;
|
|
{ Goals = [Goal0] }
|
|
).
|
|
magic__preprocess_goal_2(scope(Reason, Goal0) - Info,
|
|
[scope(Reason, Goal) - Info], HOMap0, HOMap) -->
|
|
{ Goal0 = _ - SomeGoalInfo },
|
|
magic__preprocess_goal(Goal0, SomeGoals, HOMap0, HOMap),
|
|
{ conj_list_to_goal(SomeGoals, SomeGoalInfo, Goal) }.
|
|
magic__preprocess_goal_2(not(Goal0) - Info, [not(Goal) - Info],
|
|
HOMap0, HOMap) -->
|
|
{ Goal0 = _ - NegGoalInfo },
|
|
magic__preprocess_goal(Goal0, NegGoals, HOMap0, HOMap),
|
|
{ conj_list_to_goal(NegGoals, NegGoalInfo, Goal) }.
|
|
magic__preprocess_goal_2(Goal0, Goals, HOMap0, HOMap) -->
|
|
{ Goal0 = unify(_, _, _, Uni, _) - GoalInfo },
|
|
(
|
|
{ Uni = construct(Var, pred_const(_, _), Args, _, _, _, _) }
|
|
->
|
|
% Collect up the closure construction so that it can be
|
|
% placed next to the aggregate goal that uses it.
|
|
%
|
|
% XXX What about if someone puts a closure inside
|
|
% a structure? At the moment we don't handle it and
|
|
% we don't give an error message.
|
|
magic_info_get_proc_info(ProcInfo),
|
|
(
|
|
{ Args = [] }
|
|
->
|
|
[]
|
|
;
|
|
{ Args = [Arg] },
|
|
{ proc_info_vartypes(ProcInfo, VarTypes) },
|
|
{ map__lookup(VarTypes, Arg, ArgType) },
|
|
{ type_is_aditi_state(ArgType) }
|
|
->
|
|
[]
|
|
;
|
|
% XXX we don't yet allow curried arguments.
|
|
{ goal_info_get_context(GoalInfo, Context) },
|
|
magic_info_get_curr_pred_proc_id(PredProcId),
|
|
magic_info_get_errors(Errors0),
|
|
{ Error = curried_argument(PredProcId) - Context },
|
|
{ set__insert(Errors0, Error, Errors) },
|
|
magic_info_set_errors(Errors)
|
|
),
|
|
{ map__det_insert(HOMap0, Var, Goal0, HOMap) },
|
|
{ Goals = [] }
|
|
;
|
|
{ Uni = assign(Var1, Var2) }
|
|
->
|
|
magic_info_get_proc_info(ProcInfo),
|
|
{ proc_info_vartypes(ProcInfo, VarTypes) },
|
|
{ map__lookup(VarTypes, Var1, Var1Type) },
|
|
( { type_is_aditi_state(Var1Type) } ->
|
|
% Remove assignments of `aditi:state's.
|
|
{ HOMap = HOMap0 },
|
|
{ Goals = [] }
|
|
; { map__search(HOMap0, Var2, Entry) } ->
|
|
{ Goals = [] },
|
|
{ map__det_insert(HOMap0, Var1, Entry, HOMap) }
|
|
;
|
|
{ Goals = [Goal0] },
|
|
{ HOMap = HOMap0 }
|
|
)
|
|
;
|
|
{ Goals = [Goal0] },
|
|
{ HOMap = HOMap0 }
|
|
).
|
|
|
|
magic__preprocess_goal_2(shorthand(_) - _, _, _, _) -->
|
|
% these should have been expanded out by now
|
|
{ error("magic__preprocess_goal_2: unexpected shorthand") }.
|
|
|
|
% Introduce new variables and assignments to them for any
|
|
% duplicates in the list.
|
|
:- pred magic__preprocess_call_args(list(prog_var)::in, list(prog_var)::out,
|
|
set(prog_var)::in, list(prog_var)::in, list(prog_var)::out,
|
|
list(hlds_goal)::in, list(hlds_goal)::out,
|
|
magic_info::in, magic_info::out) is det.
|
|
|
|
magic__preprocess_call_args([], [], _, IntroducedArgs,
|
|
IntroducedArgs, ExtraGoals, ExtraGoals) --> [].
|
|
magic__preprocess_call_args([Arg | Args], [NewArg | NewArgs], SeenArgs,
|
|
IntroducedArgs0, IntroducedArgs, ExtraGoals0, ExtraGoals) -->
|
|
( { set__member(Arg, SeenArgs) } ->
|
|
{ SeenArgs1 = SeenArgs },
|
|
magic_info_get_proc_info(ProcInfo0),
|
|
{ proc_info_vartypes(ProcInfo0, VarTypes) },
|
|
{ map__lookup(VarTypes, Arg, ArgType) },
|
|
{ proc_info_create_var_from_type(ArgType, no, NewArg,
|
|
ProcInfo0, ProcInfo) },
|
|
magic_info_set_proc_info(ProcInfo),
|
|
{ IntroducedArgs1 = [NewArg | IntroducedArgs0] },
|
|
{ in_mode(InMode) },
|
|
{ out_mode(OutMode) },
|
|
{ Inst = ground(shared, none) },
|
|
{ set__list_to_set([Arg, NewArg], NonLocals) },
|
|
{ instmap_delta_from_assoc_list([NewArg - Inst], Delta) },
|
|
{ goal_info_init(NonLocals, Delta, det, pure, GoalInfo) },
|
|
{ ExtraGoal = unify(NewArg, var(Arg), OutMode - InMode,
|
|
assign(NewArg, Arg), unify_context(explicit, []))
|
|
- GoalInfo },
|
|
{ ExtraGoals1 = [ExtraGoal | ExtraGoals0] }
|
|
;
|
|
{ NewArg = Arg },
|
|
{ set__insert(SeenArgs, Arg, SeenArgs1) },
|
|
{ IntroducedArgs1 = IntroducedArgs0 },
|
|
{ ExtraGoals1 = ExtraGoals0 }
|
|
),
|
|
magic__preprocess_call_args(Args, NewArgs, SeenArgs1, IntroducedArgs1,
|
|
IntroducedArgs, ExtraGoals1, ExtraGoals).
|
|
|
|
:- pred magic__preprocess_conj(list(hlds_goal)::in, list(hlds_goal)::in,
|
|
list(hlds_goal)::out, map(prog_var, hlds_goal)::in,
|
|
map(prog_var, hlds_goal)::out, magic_info::in, magic_info::out) is det.
|
|
|
|
magic__preprocess_conj([], RevGoals, Goals, HOMap, HOMap) -->
|
|
{ list__reverse(RevGoals, Goals) }.
|
|
magic__preprocess_conj([Goal0 | Goals0], RevGoals0, Goals, HOMap0, HOMap) -->
|
|
magic__preprocess_goal(Goal0, Goals1, HOMap0, HOMap1),
|
|
{ list__reverse(Goals1, RevGoals1) },
|
|
{ list__append(RevGoals1, RevGoals0, RevGoals) },
|
|
magic__preprocess_conj(Goals0, RevGoals, Goals, HOMap1, HOMap).
|
|
|
|
% If the goal is not a database call and does not contain
|
|
% a database call, it cannot have an `aditi:state' as a non-local.
|
|
:- pred magic__check_goal_nonlocals(hlds_goal::in,
|
|
magic_info::in, magic_info::out) is det.
|
|
|
|
magic__check_goal_nonlocals(Goal) -->
|
|
magic_info_get_module_info(ModuleInfo),
|
|
magic_info_get_pred_map(PredMap),
|
|
(
|
|
% We check inside not, some and conj goals for calls, so don't
|
|
% report errors at the top-level of those goals.
|
|
{
|
|
Goal = not(_) - _
|
|
;
|
|
Goal = scope(_, _) - _
|
|
;
|
|
Goal = conj(_) - _
|
|
;
|
|
Goal = call(_, _, _, _, _, _) - _,
|
|
magic_util__goal_is_aditi_call(ModuleInfo, PredMap,
|
|
Goal, _, _)
|
|
;
|
|
Goal = unify(_, _, _, Uni, _) - _,
|
|
Uni = construct(_, pred_const(ShroudedPredProcId, _),
|
|
_, _, _, _, _),
|
|
PredProcId = unshroud_pred_proc_id(ShroudedPredProcId),
|
|
% XXX once the implementation of aggregates has
|
|
% been updated to use `aditi_bottom_up' closures,
|
|
% this can be done by just checking the eval_method.
|
|
(
|
|
map__contains(PredMap, PredProcId)
|
|
;
|
|
PredProcId = proc(PredId, _),
|
|
hlds_pred__is_aditi_relation(ModuleInfo,
|
|
PredId)
|
|
)
|
|
}
|
|
->
|
|
[]
|
|
;
|
|
{ Goal = _ - GoalInfo },
|
|
% We don't use the non-locals because in some circumstances
|
|
% involving mode analysis or simplification optimizing
|
|
% away unifications that set can be an overestimate.
|
|
{ quantification__goal_vars(Goal, GoalVars0) },
|
|
{ set__to_sorted_list(GoalVars0, GoalVars) },
|
|
magic_info_get_proc_info(ProcInfo),
|
|
{ proc_info_vartypes(ProcInfo, VarTypes) },
|
|
{ IsAditiVar = (pred(Var::in) is semidet :-
|
|
map__lookup(VarTypes, Var, Type),
|
|
type_is_aditi_state(Type)
|
|
) },
|
|
{ list__filter(IsAditiVar, GoalVars, IllegalNonLocals) },
|
|
( { IllegalNonLocals = [] } ->
|
|
[]
|
|
;
|
|
magic_info_get_errors(Errors0),
|
|
{ goal_info_get_context(GoalInfo, Context) },
|
|
magic_info_get_curr_pred_proc_id(PredProcId),
|
|
{ proc_info_varset(ProcInfo, VarSet) },
|
|
{ Error = non_removeable_aditi_state(PredProcId,
|
|
VarSet, IllegalNonLocals) - Context },
|
|
{ set__insert(Errors0, Error, Errors) },
|
|
magic_info_set_errors(Errors)
|
|
)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Generate goals to create the closures needed by this call.
|
|
:- pred magic__rename_and_generate_closures(list(prog_var)::in,
|
|
list(hlds_goal)::out, hlds_goal::in, hlds_goal::out,
|
|
map(prog_var, hlds_goal)::in, magic_info::in, magic_info::out) is det.
|
|
|
|
magic__rename_and_generate_closures([], [], Goal, Goal, _) --> [].
|
|
magic__rename_and_generate_closures([Arg | Args], ExtraGoals,
|
|
Goal0, Goal, HOMap) -->
|
|
magic__rename_and_generate_closures(Args, ExtraGoals1,
|
|
Goal0, Goal1, HOMap),
|
|
( { map__search(HOMap, Arg, ClosureGoal0) } ->
|
|
magic_info_get_proc_info(ProcInfo0),
|
|
{ proc_info_vartypes(ProcInfo0, VarTypes0) },
|
|
{ map__lookup(VarTypes0, Arg, Type) },
|
|
{ proc_info_create_var_from_type(Type, no, NewArg,
|
|
ProcInfo0, ProcInfo) },
|
|
magic_info_set_proc_info(ProcInfo),
|
|
{ map__init(Subn0) },
|
|
{ map__det_insert(Subn0, Arg, NewArg, Subn) },
|
|
{ goal_util__rename_vars_in_goal(ClosureGoal0,
|
|
Subn, ClosureGoal) },
|
|
{ goal_util__rename_vars_in_goal(Goal1, Subn, Goal) },
|
|
{ ExtraGoals = [ClosureGoal | ExtraGoals1] }
|
|
;
|
|
{ ExtraGoals = ExtraGoals1 },
|
|
{ Goal = Goal1 }
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred magic__process_scc(aditi_scc::in, magic_info::in, magic_info::out,
|
|
io::di, io::uo) is det.
|
|
|
|
magic__process_scc(aditi_scc(SCC0, _), Info0, Info) -->
|
|
{ list__condense(SCC0, SCC) },
|
|
{ magic_info_set_scc(SCC, Info0, Info1) },
|
|
{ list__foldl(magic__process_proc, SCC, Info1, Info) }.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred magic__process_proc(pred_proc_id::in,
|
|
magic_info::in, magic_info::out) is det.
|
|
|
|
magic__process_proc(PredProcId0) -->
|
|
magic_info_get_pred_map(PredMap),
|
|
{ map__search(PredMap, PredProcId0, PredProcId1) ->
|
|
PredProcId = PredProcId1
|
|
;
|
|
PredProcId = PredProcId0
|
|
},
|
|
|
|
magic_info_get_module_info(ModuleInfo0),
|
|
{ module_info_pred_proc_info(ModuleInfo0, PredProcId,
|
|
PredInfo0, ProcInfo0) },
|
|
(
|
|
{ pred_info_is_imported(PredInfo0)
|
|
; pred_info_is_pseudo_imported(PredInfo0)
|
|
}
|
|
->
|
|
[]
|
|
;
|
|
magic_info_set_curr_pred_proc_id(PredProcId),
|
|
magic_info_set_pred_info(PredInfo0),
|
|
magic_info_set_proc_info(ProcInfo0),
|
|
magic_info_get_magic_proc_info(MagicProcInfo),
|
|
{ map__lookup(MagicProcInfo, PredProcId, ThisProcInfo) },
|
|
{ ThisProcInfo = magic_proc_info(OldArgModes, MagicInputs,
|
|
_, _, _) },
|
|
magic_info_set_magic_vars(MagicInputs),
|
|
{ set__init(ErrorVars) },
|
|
magic_info_set_error_vars(ErrorVars),
|
|
|
|
{ proc_info_headvars(ProcInfo0, HeadVars) },
|
|
|
|
{ list__length(MagicInputs, NumMagicInputs) },
|
|
{ list__drop(NumMagicInputs, HeadVars, OldHeadVars) ->
|
|
partition_args(ModuleInfo0,
|
|
OldArgModes, OldHeadVars, Inputs, Outputs)
|
|
;
|
|
error("magic__process_proc: list__drop failed")
|
|
},
|
|
|
|
{ pred_info_get_markers(PredInfo0, Markers) },
|
|
{ proc_info_goal(ProcInfo0, Goal0) },
|
|
{ Goal0 = _ - GoalInfo0 },
|
|
{ goal_to_disj_list(Goal0, DisjList0) },
|
|
( { check_marker(Markers, context) } ->
|
|
context__process_disjuncts(PredProcId0, Inputs,
|
|
Outputs, DisjList0, DisjList)
|
|
;
|
|
{ set__list_to_set(HeadVars, HeadVarSet) },
|
|
magic__process_disjuncts(HeadVarSet,
|
|
DisjList0, DisjList)
|
|
),
|
|
|
|
{ disj_list_to_goal(DisjList, GoalInfo0, Goal) },
|
|
magic_info_get_pred_info(PredInfo),
|
|
magic_info_get_proc_info(ProcInfo1),
|
|
{ proc_info_set_goal(Goal, ProcInfo1, ProcInfo) },
|
|
|
|
magic_info_get_module_info(ModuleInfo1),
|
|
{ module_info_set_pred_proc_info(PredProcId,
|
|
PredInfo, ProcInfo, ModuleInfo1, ModuleInfo) },
|
|
magic_info_set_module_info(ModuleInfo)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred magic__process_disjuncts(set(prog_var)::in, list(hlds_goal)::in,
|
|
list(hlds_goal)::out, magic_info::in, magic_info::out) is det.
|
|
|
|
magic__process_disjuncts(_, [], []) --> [].
|
|
magic__process_disjuncts(HeadVars, [Disjunct0 | Disjuncts0],
|
|
[Disjunct | Disjuncts]) -->
|
|
magic__process_disjunct(HeadVars, Disjunct0, Disjunct),
|
|
magic__process_disjuncts(HeadVars, Disjuncts0, Disjuncts).
|
|
|
|
:- pred magic__process_disjunct(set(prog_var)::in, hlds_goal::in,
|
|
hlds_goal::out, magic_info::in, magic_info::out) is det.
|
|
|
|
magic__process_disjunct(HeadVars, Disjunct0, Disjunct) -->
|
|
{ Disjunct0 = _ - DisjInfo },
|
|
{ goal_to_conj_list(Disjunct0, GoalList0) },
|
|
{ list__reverse(GoalList0, RevGoalList0) },
|
|
magic__get_next_db_pred(RevGoalList0, BeforeGoals,
|
|
MaybeDBCall, [], AfterGoals),
|
|
|
|
( { MaybeDBCall = yes(DBCall1) } ->
|
|
{ magic_util__db_call_nonlocals(DBCall1, NonLocals1) },
|
|
{ goal_list_nonlocals(AfterGoals, AfterNonLocals) },
|
|
{ set__union(HeadVars, AfterNonLocals, SubConjNonLocals0) },
|
|
{ set__union(SubConjNonLocals0, NonLocals1,
|
|
SubConjNonLocals1) },
|
|
magic_util__restrict_nonlocals(SubConjNonLocals1,
|
|
SubConjNonLocals),
|
|
magic__process_disjunct_2(BeforeGoals, DBCall1,
|
|
SubConjNonLocals, GoalList1),
|
|
{ list__append(GoalList1, AfterGoals, GoalList) }
|
|
;
|
|
magic__create_magic_call(MagicCall),
|
|
{ GoalList = [MagicCall | GoalList0] }
|
|
),
|
|
{ conj_list_to_goal(GoalList, DisjInfo, Disjunct) }.
|
|
|
|
% Search backwards through the goal list for a disjunct.
|
|
% When a call is found, recursively process the goals before
|
|
% it.
|
|
:- pred magic__process_disjunct_2(list(hlds_goal)::in, db_call::in,
|
|
set(prog_var)::in, list(hlds_goal)::out,
|
|
magic_info::in, magic_info::out) is det.
|
|
|
|
magic__process_disjunct_2(RevBeforeGoals1, DBCall1, NonLocals0, Goals) -->
|
|
|
|
% Find the next database call.
|
|
magic__get_next_db_pred(RevBeforeGoals1, RevBeforeGoals2,
|
|
MaybeDBCall2, [], AfterGoals2),
|
|
|
|
( { MaybeDBCall2 = yes(DBCall2) } ->
|
|
|
|
% Recursively process the goals before the call we just found.
|
|
{ magic_util__db_call_nonlocals(DBCall2, CallNonLocals2) },
|
|
{ goal_list_nonlocals(AfterGoals2, AfterNonLocals) },
|
|
{ set__union(NonLocals0, AfterNonLocals, NonLocals1) },
|
|
{ set__union(NonLocals1, CallNonLocals2, NonLocals2) },
|
|
magic_util__restrict_nonlocals(NonLocals2, NonLocals),
|
|
magic__process_disjunct_2(RevBeforeGoals2, DBCall2,
|
|
NonLocals, Goals2),
|
|
{ list__append(Goals2, AfterGoals2, Goals3) },
|
|
|
|
% Turn those goals into a supplementary predicate, and
|
|
% use that to create the input for the first call.
|
|
magic_util__setup_call(Goals3, DBCall1, NonLocals0, Goals)
|
|
;
|
|
% We've run out of calls to process, so get the magic
|
|
% input for this procedure to feed the other calls.
|
|
magic__create_magic_call(MagicCall),
|
|
{ list__reverse(RevBeforeGoals1, BeforeGoals1) },
|
|
magic_util__setup_call([MagicCall | BeforeGoals1],
|
|
DBCall1, NonLocals0, Goals)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Skip along the reversed list of goals to the first database call,
|
|
% returning the list of goals before and after the call as well.
|
|
:- pred magic__get_next_db_pred(list(hlds_goal)::in, list(hlds_goal)::out,
|
|
maybe(db_call)::out, list(hlds_goal)::in,
|
|
list(hlds_goal)::out, magic_info::in, magic_info::out) is det.
|
|
|
|
magic__get_next_db_pred([], [], no, Goals, Goals) --> [].
|
|
magic__get_next_db_pred([Goal | RevGoals], RevBeforeGoals,
|
|
MaybeCall, AfterGoals0, AfterGoals) -->
|
|
magic_info_get_module_info(ModuleInfo),
|
|
magic_info_get_pred_map(PredMap),
|
|
(
|
|
{ magic_util__goal_is_aditi_call(ModuleInfo, PredMap,
|
|
Goal, Call, AfterGoals1) }
|
|
->
|
|
{ MaybeCall = yes(Call) },
|
|
{ RevBeforeGoals = RevGoals },
|
|
{ list__append(AfterGoals1, AfterGoals0, AfterGoals) }
|
|
;
|
|
magic__get_next_db_pred(RevGoals, RevBeforeGoals,
|
|
MaybeCall, [Goal | AfterGoals0], AfterGoals)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Create a call to the magic procedure for the current procedure.
|
|
:- pred magic__create_magic_call(hlds_goal::out,
|
|
magic_info::in, magic_info::out) is det.
|
|
|
|
magic__create_magic_call(MagicCall) -->
|
|
magic_util__magic_call_info(MagicPredId, MagicProcId, PredName,
|
|
InputRels, InputArgs, MagicOutputModes),
|
|
|
|
{ list__append(InputRels, InputArgs, MagicArgs) },
|
|
|
|
{ set__list_to_set(MagicArgs, NonLocals) },
|
|
magic_info_get_module_info(ModuleInfo),
|
|
{ instmap_delta_from_mode_list(InputArgs, MagicOutputModes,
|
|
ModuleInfo, InstMapDelta) },
|
|
{ goal_info_init(NonLocals, InstMapDelta, nondet, pure, GoalInfo) },
|
|
|
|
{ MagicCall = call(MagicPredId, MagicProcId, MagicArgs,
|
|
not_builtin, no, PredName) - GoalInfo }.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|