for review: Aditi [6]
Simon Taylor
stayl at cs.mu.OZ.AU
Tue Jul 7 13:44:18 AEST 1998
%-----------------------------------------------------------------------------%
% Copyright (C) 1998 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_util.m
% Main author: stayl
%
% Predicates used by magic.m and context.m to transform Aditi procedures.
%
%-----------------------------------------------------------------------------%
:- module magic_util.
:- interface.
:- import_module hlds_data, hlds_goal, hlds_module, hlds_pred, prog_data.
:- import_module (inst).
:- import_module bool, io, list, map, set, std_util, term, varset.
% Check that the argument types and modes are legal for
% an Aditi relation.
:- pred magic_util__check_args(list(var)::in, list(mode)::in, list(type)::in,
term__context::in, magic_arg_id_type::in,
magic_info::in, magic_info::out) is det.
:- pred magic_util__report_errors(list(magic_error)::in, module_info::in,
bool::in, io__state::di, io__state::uo) is det.
% Determine whether a given goal contains a call to an
% Aditi procedure. Strip out any explicit quantifications
% around Aditi calls, since they just get in the way.
% Multiple nested explicit quantifications should have
% been removed by simplify.m.
:- pred magic_util__goal_is_aditi_call(module_info::in,
map(pred_proc_id, pred_proc_id)::in, hlds_goal::in,
db_call::out, list(hlds_goal)::out) is semidet.
% Information about a database call.
:- type db_call
---> db_call(
maybe(list(hlds_goal)), % aggregate input closures
hlds_goal, % goal containing the call
pred_proc_id,
list(var), % arguments
list(var), % input arguments
list(var), % output arguments
maybe(pair(list(hlds_goal), hlds_goal_info))
% goals after the call in a negation,
% and the goal_info for the negation.
).
:- pred magic_util__db_call_nonlocals(db_call::in, set(var)::out) is det.
:- pred magic_util__db_call_input_args(db_call::in, list(var)::out) is det.
:- pred magic_util__db_call_output_args(db_call::in, list(var)::out) is det.
:- pred magic_util__db_call_context(db_call::in, term__context::out) is det.
:- pred magic_util__db_call_pred_proc_id(db_call::in,
pred_proc_id::out) is det.
:- pred magic_util__rename_vars_in_db_call(db_call::in, map(var, var)::in,
db_call::out) is det.
% Do all the necessary goal fiddling to handle the input
% to an Aditi procedure.
:- pred magic_util__setup_call(list(hlds_goal)::in, db_call::in, set(var)::in,
list(hlds_goal)::out, magic_info::in, magic_info::out) is det.
% Create a closure given the goal and arguments.
:- pred magic_util__create_closure(int::in, var::in, (mode)::in, hlds_goal::in,
list(var)::in, list(var)::in, hlds_goal::out,
magic_info::in, magic_info::out) is det.
% Add the goal as a disjunct of the magic predicate for the
% pred_proc_id. The list of variables is the list of head
% variables of the `clause'.
:- pred magic_util__add_to_magic_predicate(pred_proc_id::in, hlds_goal::in,
list(var)::in, magic_info::in, magic_info::out) is det.
% Get information to build a call to the magic
% predicate for the current procedure.
:- pred magic_util__magic_call_info(pred_id::out, proc_id::out, sym_name::out,
list(var)::out, list(var)::out, list(mode)::out,
magic_info::in, magic_info::out) is det.
% Convert all modes to output, creating test unifications
% where the original mode was input. This will result in
% a join on the input attributes.
:- pred magic_util__create_input_test_unifications(list(var)::in, list(var)::in,
list(mode)::in, list(var)::out, list(hlds_goal)::in,
list(hlds_goal)::out, hlds_goal_info::in, hlds_goal_info::out,
magic_info::in, magic_info::out) is det.
% Convert an input mode to output.
:- pred magic_util__mode_to_output_mode(module_info::in,
(mode)::in, (mode)::out) is det.
% Remove an `aditi:state' from the given list if one is present.
:- pred magic_util__remove_aditi_state(list(type)::in,
list(T)::in, list(T)::out) is det.
% Remove any aditi:states from the set of vars.
:- pred magic_util__restrict_nonlocals(set(var)::in, set(var)::out,
magic_info::in, magic_info::out) is det.
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module hlds_data, code_util, type_util, mode_util, inst_match.
:- import_module instmap, goal_util, prog_out, hlds_out, error_util.
:- import_module assoc_list, int, require, string.
magic_util__db_call_nonlocals(
db_call(MaybeClosures, Call, _, _, _, _, MaybeNegGoals),
NonLocals) :-
( MaybeClosures = yes(Closures) ->
goal_list_nonlocals(Closures, NonLocals0)
;
set__init(NonLocals0)
),
Call = _ - CallInfo,
goal_info_get_nonlocals(CallInfo, NonLocals1),
set__union(NonLocals0, NonLocals1, NonLocals2),
( MaybeNegGoals = yes(_ - NegGoalInfo) ->
goal_info_get_nonlocals(NegGoalInfo, NonLocals3),
set__union(NonLocals2, NonLocals3, NonLocals)
;
NonLocals = NonLocals2
).
magic_util__db_call_context(db_call(_, _ - Info, _, _, _, _, _), Context) :-
goal_info_get_context(Info, Context).
magic_util__db_call_pred_proc_id(db_call(_, _, PredProcId, _, _, _, _),
PredProcId).
magic_util__db_call_input_args(db_call(_, _, _, _, Inputs, _, _), Inputs).
magic_util__db_call_output_args(db_call(_, _, _, _, _, Outputs, _), Outputs).
magic_util__rename_vars_in_db_call(Call0, Subn, Call) :-
Call0 = db_call(MaybeClosures0, Goal0, PredProcId, Args0,
Inputs0, Outputs0, MaybeNegGoals0),
(
MaybeClosures0 = yes(Closures0),
goal_util__rename_vars_in_goals(Closures0, no, Subn, Closures),
MaybeClosures = yes(Closures)
;
MaybeClosures0 = no,
MaybeClosures = no
),
goal_util__rename_vars_in_goal(Goal0, Subn, Goal),
goal_util__rename_var_list(Args0, no, Subn, Args),
goal_util__rename_var_list(Inputs0, no, Subn, Inputs),
goal_util__rename_var_list(Outputs0, no, Subn, Outputs),
(
MaybeNegGoals0 = yes(NegGoals0 - NegGoalInfo0),
goal_util__rename_vars_in_goals(NegGoals0, no, Subn, NegGoals),
goal_util__rename_vars_in_goal(conj([]) - NegGoalInfo0,
Subn, _ - NegGoalInfo),
MaybeNegGoals = yes(NegGoals - NegGoalInfo)
;
MaybeNegGoals0 = no,
MaybeNegGoals = no
),
Call = db_call(MaybeClosures, Goal, PredProcId, Args,
Inputs, Outputs, MaybeNegGoals).
%-----------------------------------------------------------------------------%
magic_util__goal_is_aditi_call(ModuleInfo, PredMap,
Goal0, Call, AfterGoals) :-
%
% Strip off any explicit quantification. There should only
% be one, since simplification removes nested quantifications
% and multiple nested quantifications are not considered
% atomic by dnf.m.
%
( Goal0 = some(_, Goal1) - _ ->
Goal2 = Goal1
;
Goal2 = Goal0
),
goal_to_conj_list(Goal2, Goals2),
Goals2 = [PossibleCallGoal | AfterGoals0],
( PossibleCallGoal = not(NegGoal0) - NegGoalInfo ->
magic_util__neg_goal_is_aditi_call(ModuleInfo, PredMap,
NegGoal0, NegGoalInfo, Call),
AfterGoals = AfterGoals0
;
magic_util__goal_is_aditi_call_2(ModuleInfo, PredMap,
Goals2, Call, AfterGoals)
).
:- pred magic_util__goal_is_aditi_call_2(module_info::in, pred_map::in,
list(hlds_goal)::in, db_call::out, list(hlds_goal)::out) is semidet.
magic_util__goal_is_aditi_call_2(ModuleInfo, PredMap,
Goals, Call, AfterGoals) :-
(
% Is the goal an aggregate?
Goals = [Closure1a, Closure2a, Closure3a,
CallGoal | AfterGoals0],
CallGoal = call(PredId, ProcId, Args, _,_,_) - _,
hlds_pred__is_aditi_aggregate(ModuleInfo, PredId),
magic_util__check_aggregate_closure(Closure1a, Closure1),
magic_util__check_aggregate_closure(Closure2a, Closure2),
magic_util__check_aggregate_closure(Closure3a, Closure3)
->
AfterGoals = AfterGoals0,
Call = db_call(yes([Closure1, Closure2, Closure3]),
CallGoal, proc(PredId, ProcId), Args, [], Args, no)
;
% Is the goal an ordinary database call.
Goals = [Goal0 | AfterGoals],
Goal0 = call(PredId, ProcId, Args, _, _, _) - _,
(
% The original predicate may have been stripped of its
% aditi marker by magic__interface_to_c, so check
% if the procedure was renamed by the preprocessing
% pass, if so it is an Aditi procedure..
map__contains(PredMap, proc(PredId, ProcId))
;
hlds_pred__is_aditi_relation(ModuleInfo, PredId)
),
magic_util__construct_db_call(ModuleInfo, PredId, ProcId,
Args, Goal0, Call)
).
:- pred magic_util__neg_goal_is_aditi_call(module_info::in, pred_map::in,
hlds_goal::in, hlds_goal_info::in, db_call::out) is semidet.
magic_util__neg_goal_is_aditi_call(ModuleInfo, PredMap,
NegGoal0, NegGoalInfo, Call) :-
% This is safe because nested negations should be
% transformed into calls by dnf.m.
magic_util__goal_is_aditi_call(ModuleInfo, PredMap,
NegGoal0, NegCall, AfterGoals),
NegCall = db_call(A, B, C, D, E, F, _),
Call = db_call(A, B, C, D, E, F, yes(AfterGoals - NegGoalInfo)).
:- pred magic_util__check_aggregate_closure(hlds_goal::in,
hlds_goal::out) is semidet.
magic_util__check_aggregate_closure(Goal, Goal) :-
Goal = unify(_, _, _, Uni, _) - _,
Uni = construct(_, pred_const(_, _), _, _).
:- pred magic_util__construct_db_call(module_info::in, pred_id::in, proc_id::in,
list(var)::in, hlds_goal::in, db_call::out) is det.
magic_util__construct_db_call(ModuleInfo, PredId, ProcId,
Args0, Goal0, Call) :-
module_info_pred_proc_info(ModuleInfo, PredId, ProcId,
PredInfo, ProcInfo),
pred_info_arg_types(PredInfo, _, ArgTypes),
proc_info_argmodes(ProcInfo, ArgModes0),
magic_util__remove_aditi_state(ArgTypes, ArgModes0, ArgModes),
magic_util__remove_aditi_state(ArgTypes, Args0, Args),
partition_args(ModuleInfo, ArgModes, Args, InputArgs, OutputArgs),
Call = db_call(no, Goal0, proc(PredId, ProcId), Args,
InputArgs, OutputArgs, no).
%-----------------------------------------------------------------------------%
magic_util__remove_aditi_state([], [], []).
magic_util__remove_aditi_state([], [_|_], _) :-
error("magic_util__remove_aditi_state").
magic_util__remove_aditi_state([_|_], [], _) :-
error("magic_util__remove_aditi_state").
magic_util__remove_aditi_state([Type | Types], [Arg | Args0], Args) :-
( type_is_aditi_state(Type) ->
magic_util__remove_aditi_state(Types, Args0, Args)
;
magic_util__remove_aditi_state(Types, Args0, Args1),
Args = [Arg | Args1]
).
magic_util__restrict_nonlocals(NonLocals0, NonLocals) -->
magic_info_get_proc_info(ProcInfo),
{ proc_info_vartypes(ProcInfo, VarTypes) },
{ set__to_sorted_list(NonLocals0, NonLocals1) },
{ map__apply_to_list(NonLocals1, VarTypes, NonLocalTypes) },
{ magic_util__remove_aditi_state(NonLocalTypes,
NonLocals1, NonLocals2) },
{ set__sorted_list_to_set(NonLocals2, NonLocals) }.
%-----------------------------------------------------------------------------%
magic_util__setup_call(PrevGoals, DBCall1, NonLocals, Goals) -->
{ DBCall1 = db_call(MaybeAggInputs, CallGoal0,
PredProcId0, Args, InputArgs, _, MaybeNegGoals) },
%
% Check whether this procedure was renamed
% during the preprocessing pass.
%
magic_info_get_pred_map(PredMap),
{ map__search(PredMap, PredProcId0, PredProcId1) ->
PredProcId = PredProcId1
;
PredProcId = PredProcId0
},
( { MaybeAggInputs = yes(AggInputs0) } ->
% The preprocessing pass ensures that the closures
% for the aggregate are right next to the call.
% There should be three - one for the query, one to
% compute the initial accumulator and one to update
% the accumulator.
list__map_foldl(magic_util__setup_aggregate_input,
AggInputs0, AggInputs1),
{ list__condense(AggInputs1, AggInputs) },
{ CallGoal0 = _ - CallGoalInfo },
{ goal_info_get_context(CallGoalInfo, Context) },
magic_util__maybe_create_supp_call(PrevGoals, NonLocals, [],
Context, SuppCall),
{ BeforeGoals = [SuppCall | AggInputs] },
{ Tests = [] },
{ CallGoal = CallGoal0 }
;
{ PredProcId = proc(PredId, ProcId) },
magic_info_get_module_info(ModuleInfo0),
( { hlds_pred__is_base_relation(ModuleInfo0, PredId) } ->
{ CallGoal0 = _ - CallGoalInfo0 },
{ goal_info_get_context(CallGoalInfo0, Context) },
magic_util__maybe_create_supp_call(PrevGoals,
NonLocals, [], Context, SuppCall),
{ BeforeGoals = [SuppCall] },
% Convert input args to outputs, and test that
% the input matches the output.
magic_info_get_module_info(ModuleInfo),
{ module_info_pred_proc_info(ModuleInfo, PredProcId,
PredInfo, ProcInfo) },
{ pred_info_module(PredInfo, PredModule) },
{ pred_info_name(PredInfo, PredName) },
{ Name = qualified(PredModule, PredName) },
{ proc_info_argmodes(ProcInfo, ArgModes) },
magic_util__create_input_test_unifications(Args,
InputArgs, ArgModes, NewArgs, [], Tests,
CallGoalInfo0, CallGoalInfo),
{ CallGoal = call(PredId, ProcId, NewArgs,
not_builtin, no, Name)
- CallGoalInfo }
;
% Transform away the input arguments.
magic_util__handle_input_args(PredProcId0, PredProcId,
PrevGoals, NonLocals, Args, InputArgs,
BeforeGoals, CallGoal0, CallGoal, Tests)
)
),
( { MaybeNegGoals = yes(NegAfterGoals - NegGoalInfo) } ->
{ list__append([CallGoal | Tests], NegAfterGoals, NegGoals) },
%
% Compute a goal info for the conjunction
% inside the negation.
%
{ goal_info_get_nonlocals(NegGoalInfo, NegNonLocals0) },
{ goal_list_nonlocals(NegGoals, InnerNonLocals0) },
{ set__intersect(NegNonLocals0, InnerNonLocals0,
InnerNonLocals1) },
magic_util__restrict_nonlocals(InnerNonLocals1,
InnerNonLocals),
{ goal_list_instmap_delta(NegGoals, InnerDelta0) },
{ instmap_delta_restrict(InnerDelta0,
InnerNonLocals, InnerDelta) },
{ goal_list_determinism(NegGoals, InnerDet) },
{ goal_info_init(InnerNonLocals, InnerDelta,
InnerDet, InnerInfo) },
{ conj_list_to_goal(NegGoals, InnerInfo, InnerConj) },
{ list__append(BeforeGoals, [not(InnerConj) - NegGoalInfo],
Goals) }
;
{ list__append(BeforeGoals, [CallGoal | Tests], Goals) }
).
% Construct the input for the query for an aggregate.
:- pred magic_util__setup_aggregate_input(hlds_goal::in, list(hlds_goal)::out,
magic_info::in, magic_info::out) is det.
magic_util__setup_aggregate_input(Closure, InputAndClosure) -->
magic_info_get_module_info(ModuleInfo0),
magic_info_get_pred_map(PredMap),
(
{ Closure = unify(_, _, UniMode, Uni0, Context) - Info },
{ Uni0 = construct(Var, ConsId0, _, Modes) },
{ ConsId0 = pred_const(PredId0, ProcId0) },
%
% Replace the pred_proc_id of the procedure being aggregated
% over with its Aditi version.
%
{ map__search(PredMap, proc(PredId0, ProcId0), PredProcId) ->
PredProcId = proc(PredId, ProcId),
ConsId = pred_const(PredId, ProcId)
;
PredId = PredId0,
ProcId = ProcId0,
ConsId = ConsId0
},
{ hlds_pred__is_derived_relation(ModuleInfo0, PredId) }
->
%
% Create the input relation for the aggregate query.
% This is just `true', since we don't allow curried
% arguments (except for aditi:states).
%
magic_info_get_magic_proc_info(MagicProcInfo),
{ map__lookup(MagicProcInfo, proc(PredId, ProcId),
CallProcInfo) },
{ CallProcInfo = magic_proc_info(_, MagicInputs, _, _, _) },
{ true_goal(InputGoal) },
magic_util__create_input_closures(MagicInputs, [], [],
InputGoal, CallProcInfo, 1, InputGoals, InputVars),
% Update the unify_rhs.
magic_info_get_module_info(ModuleInfo),
{ module_info_pred_info(ModuleInfo, PredId, CallPredInfo) },
{ pred_info_module(CallPredInfo, PredModule) },
{ pred_info_name(CallPredInfo, PredName) },
{ list__length(InputVars, Arity) },
{ Rhs = functor(cons(qualified(PredModule, PredName), Arity),
InputVars) },
{ Uni = construct(Var, ConsId, InputVars, Modes) },
{ Goal1 = unify(Var, Rhs, UniMode, Uni, Context) - Info },
{ list__append(InputGoals, [Goal1], InputAndClosure) }
;
% Base relation. It could actually be another aggregate,
% but if aggregate becomes a new goal type we won't be able to
% handle that, in the same way that call(call(X)) doesn't work.
{ InputAndClosure = [Closure] }
).
%-----------------------------------------------------------------------------%
% Transform away the input arguments to a derived relation.
:- pred magic_util__handle_input_args(pred_proc_id::in, pred_proc_id::in,
list(hlds_goal)::in, set(var)::in, list(var)::in, list(var)::in,
list(hlds_goal)::out, hlds_goal::in, hlds_goal::out,
list(hlds_goal)::out, magic_info::in, magic_info::out) is det.
magic_util__handle_input_args(PredProcId0, PredProcId, PrevGoals, NonLocals,
Args, InputArgs, InputGoals, _ - GoalInfo0,
CallGoal, Tests) -->
magic_info_get_magic_proc_info(MagicProcInfo),
{ map__lookup(MagicProcInfo, PredProcId, CallProcInfo) },
{ CallProcInfo = magic_proc_info(OldArgModes, MagicInputs, _, _, _) },
magic_info_get_module_info(ModuleInfo0),
{ partition_args(ModuleInfo0, OldArgModes,
OldArgModes, InputArgModes, _) },
{ goal_info_get_context(GoalInfo0, Context) },
magic_util__maybe_create_supp_call(PrevGoals, NonLocals, InputArgs,
Context, SuppCall),
% Convert input args to outputs, and test that
% the input matches the output.
magic_util__create_input_test_unifications(Args, InputArgs,
OldArgModes, NewOutputArgs, [], Tests, GoalInfo0, GoalInfo1),
% All database predicates are considered nondet after this.
{ goal_info_set_determinism(GoalInfo1,
nondet, GoalInfo) },
magic_info_get_sub_module(SubModule),
( { list__member(PredProcId0, SubModule) } ->
magic_info_get_magic_vars(MagicVars),
{ list__append(MagicVars, InputArgs, AllMagicVars) },
magic_util__add_to_magic_predicate(PredProcId,
SuppCall, AllMagicVars),
magic_info_get_magic_vars(MagicInputArgs),
{ list__append(MagicInputArgs, NewOutputArgs, AllArgs) },
{ InputGoals0 = [] }
;
magic_util__create_input_closures(MagicInputs,
InputArgs, InputArgModes, SuppCall,
CallProcInfo, 1, InputGoals0, InputVars),
{ list__append(InputVars, NewOutputArgs, AllArgs) }
),
{ InputGoals = [SuppCall | InputGoals0] },
magic_info_get_module_info(ModuleInfo),
{ PredProcId = proc(PredId, ProcId) },
{ module_info_pred_info(ModuleInfo, PredId, PredInfo) },
{ pred_info_module(PredInfo, PredModule) },
{ pred_info_name(PredInfo, PredName) },
{ CallGoal = call(PredId, ProcId, AllArgs, not_builtin, no,
qualified(PredModule, PredName)) - GoalInfo }.
magic_util__create_input_test_unifications([], _, [_|_], _, _, _, _, _) -->
{ error("magic_util__create_input_test_unifications") }.
magic_util__create_input_test_unifications([_|_], _, [], _, _, _, _, _) -->
{ error("magic_util__create_input_test_unifications") }.
magic_util__create_input_test_unifications([], _, [], [], Tests, Tests,
CallInfo, CallInfo) --> [].
magic_util__create_input_test_unifications([Var | Vars], InputArgs,
[Mode | Modes], [OutputVar | OutputVars], Tests0, Tests,
CallInfo0, CallInfo) -->
( { list__member(Var, InputArgs) } ->
magic_util__create_input_test_unification(Var, Mode,
OutputVar, Test, CallInfo0, CallInfo1),
{ Tests1 = [Test | Tests0] }
;
{ OutputVar = Var },
{ CallInfo1 = CallInfo0 },
{ Tests1 = Tests0 }
),
magic_util__create_input_test_unifications(Vars, InputArgs, Modes,
OutputVars, Tests1, Tests, CallInfo1, CallInfo).
:- pred magic_util__create_input_test_unification(var::in, (mode)::in,
var::out, hlds_goal::out, hlds_goal_info::in,
hlds_goal_info::out, magic_info::in, magic_info::out) is det.
magic_util__create_input_test_unification(Var, Mode, OutputVar, Test,
CallInfo0, CallInfo) -->
magic_info_get_module_info(ModuleInfo0),
{ mode_get_insts(ModuleInfo0, Mode, _, FinalInst) },
magic_info_get_proc_info(ProcInfo0),
{ proc_info_varset(ProcInfo0, VarSet0) },
{ varset__new_var(VarSet0, OutputVar, VarSet) },
{ proc_info_vartypes(ProcInfo0, VarTypes0) },
{ map__lookup(VarTypes0, Var, VarType) },
{ map__det_insert(VarTypes0, OutputVar, VarType, VarTypes) },
{ proc_info_set_varset(ProcInfo0, VarSet, ProcInfo1) },
{ proc_info_set_vartypes(ProcInfo1, VarTypes, ProcInfo) },
magic_info_set_proc_info(ProcInfo),
{ set__list_to_set([Var, OutputVar], NonLocals) },
{ instmap_delta_init_reachable(InstMapDelta) },
{ goal_info_init(NonLocals, InstMapDelta, semidet, GoalInfo) },
( { type_is_atomic(VarType, ModuleInfo0) } ->
%
% The type is a builtin, so create a simple_test unification.
%
{ Unification = simple_test(Var, OutputVar) },
{ UnifyMode = ((FinalInst -> FinalInst)
- (FinalInst -> FinalInst)) },
{ Test = unify(Var, var(OutputVar), UnifyMode,
Unification, unify_context(explicit, [])) - GoalInfo }
; { type_to_type_id(VarType, _TypeId, _ArgTypes) } ->
% XXX for now we pretend that the unification is
% a simple test, since otherwise we would have to
% go through the rigmarole of creating type_info variables
% (and then ignoring them in code generation).
{ Unification = simple_test(Var, OutputVar) },
{ UnifyMode = ((FinalInst -> FinalInst)
- (FinalInst -> FinalInst)) },
{ Test = unify(Var, var(OutputVar), UnifyMode,
Unification, unify_context(explicit, [])) - GoalInfo }
/*
%
% The type is non-builtin, so look up the unification
% procedure for the type.
%
{ module_info_get_special_pred_map(ModuleInfo0,
SpecialPredMap) },
{ map__lookup(SpecialPredMap, unify - TypeId, UniPredId) },
% It had better be an in-in unification, since Aditi
% relations cannot have non-ground arguments. This is
% checked elsewhere.
% XXX __Unify__/2 needs to be special cased in rl_exprn.m
% because we don't add the type_info arguments.
{ hlds_pred__in_in_unification_proc_id(UniProcId) },
{ SymName = unqualified("__Unify__") },
{ ArgVars = [Var, OutputVar] },
{ Test = call(UniPredId, UniProcId, ArgVars, not_builtin,
no, SymName) - GoalInfo }
*/
;
{ error("magic_util__create_input_test_unifications: \
type_to_type_id failed") }
),
{ goal_info_get_nonlocals(CallInfo0, CallNonLocals0) },
{ set__delete(CallNonLocals0, Var, CallNonLocals1) },
{ set__insert(CallNonLocals1, OutputVar, CallNonLocals) },
{ goal_info_get_instmap_delta(CallInfo0, CallDelta0) },
{ instmap_delta_insert(CallDelta0, OutputVar, FinalInst, CallDelta) },
{ goal_info_set_nonlocals(CallInfo0, CallNonLocals, CallInfo1) },
{ goal_info_set_instmap_delta(CallInfo1, CallDelta, CallInfo) }.
%-----------------------------------------------------------------------------%
% Create the magic input closures for a call to a lower sub-module.
:- pred magic_util__create_input_closures(list(var)::in, list(var)::in,
list(mode)::in, hlds_goal::in, magic_proc_info::in, int::in,
list(hlds_goal)::out, list(var)::out,
magic_info::in, magic_info::out) is det.
magic_util__create_input_closures([], _, _, _, _, _, [], []) --> [].
magic_util__create_input_closures([_ | MagicVars], InputArgs,
InputArgModes, SuppCall, ThisProcInfo, CurrVar,
[InputGoal | InputGoals], [ClosureVar | ClosureVars]) -->
{ ThisProcInfo = magic_proc_info(_OldArgModes, _MagicInputs,
MagicTypes, MagicModes, MaybeIndex) },
magic_info_get_proc_info(ProcInfo0),
%
% Create a new variable to hold the input.
%
{ magic_util__get_input_var(MagicTypes, CurrVar, ClosureVar, ArgTypes,
ProcInfo0, ProcInfo1) },
( { MaybeIndex = yes(CurrVar) } ->
%
% This argument is the magic input for the call we are
% processing now. Create the input closure by projecting
% the previous database call onto the input arguments.
%
( { SuppCall = conj([]) - _ } ->
{ LambdaGoal = SuppCall },
{ LambdaVars = [] },
{ LambdaInputs = [] },
{ ProcInfo = ProcInfo1 }
;
magic_util__project_supp_call(SuppCall, InputArgs,
ProcInfo1, ProcInfo, LambdaInputs,
LambdaVars, LambdaGoal)
)
;
%
% There is no input for this member of the lower sub-module
% since it is not being directly called, so create an empty
% input relation.
%
{ proc_info_create_vars_from_types(ProcInfo1, ArgTypes,
LambdaVars, ProcInfo) },
{ fail_goal(LambdaGoal) },
{ LambdaInputs = [] }
),
magic_info_set_proc_info(ProcInfo),
{ list__index1_det(MagicModes, CurrVar, ClosureVarMode) },
magic_util__create_closure(CurrVar, ClosureVar, ClosureVarMode,
LambdaGoal, LambdaInputs, LambdaVars, InputGoal),
{ NextIndex is CurrVar + 1 },
magic_util__create_input_closures(MagicVars, InputArgs,
InputArgModes, SuppCall, ThisProcInfo, NextIndex,
InputGoals, ClosureVars).
%-----------------------------------------------------------------------------%
% Create a variable to hold an input closure for a lower sub-module
% call, returning the argument types of the closure.
:- pred magic_util__get_input_var(list(type)::in, int::in, var::out,
list(type)::out, proc_info::in, proc_info::out) is det.
magic_util__get_input_var(MagicTypes, CurrVar, InputVar, ArgTypes,
ProcInfo0, ProcInfo) :-
list__index1_det(MagicTypes, CurrVar, MagicType),
( type_is_higher_order(MagicType, predicate, ArgTypes1) ->
ArgTypes = ArgTypes1
;
error("magic_util__get_input_var")
),
term__context_init(Context),
ClosureType = term__functor(term__atom("pred"), ArgTypes, Context),
proc_info_create_var_from_type(ProcInfo0,
ClosureType, InputVar, ProcInfo).
magic_util__create_closure(_CurrVar, InputVar, InputMode, LambdaGoal,
LambdaInputs, LambdaVars, InputGoal) -->
%
% Create a new predicate to hold the projecting goal,
% unless the arguments match so no projection is needed.
%
(
{ LambdaGoal = call(_, _, CallArgs, _, _, _) - _ },
{ list__append(LambdaInputs, LambdaVars, CallArgs) }
->
{ SuppCall = LambdaGoal }
;
{ term__context_init(Context) },
{ goal_to_conj_list(LambdaGoal, LambdaGoalList) },
magic_util__create_supp_call(LambdaGoalList, LambdaInputs,
LambdaVars, Context, [no_memo, naive, generate_inline],
SuppCall)
),
magic_info_get_module_info(ModuleInfo),
(
{ SuppCall = call(SuppPredId, SuppProcId, _, _, _, _) - _ },
{ mode_get_insts(ModuleInfo, InputMode, Inst, _) },
{ Inst = ground(_, yes(PredInstInfo)) }
->
% Find the mode of the unification.
{ PredInstInfo = pred_inst_info(_, LambdaModes, _) },
{ LambdaInst = ground(shared,
yes(pred_inst_info(predicate, LambdaModes, nondet))) },
{ UnifyMode = (free -> LambdaInst) -
(LambdaInst -> LambdaInst) },
{ mode_util__modes_to_uni_modes(LambdaModes, LambdaModes,
ModuleInfo, UniModes) },
% Construct the unify_rhs.
{ module_info_pred_info(ModuleInfo, SuppPredId, PredInfo) },
{ pred_info_module(PredInfo, SuppModule) },
{ pred_info_name(PredInfo, SuppName) },
{ list__length(LambdaInputs, SuppArity) },
{ Rhs = functor(cons(qualified(SuppModule, SuppName),
SuppArity), LambdaInputs) },
{ Unify = construct(InputVar,
pred_const(SuppPredId, SuppProcId),
LambdaInputs, UniModes) },
{ UnifyContext = unify_context(explicit, []) },
% Construct a goal_info.
{ set__list_to_set([InputVar | LambdaInputs], NonLocals) },
{ instmap_delta_init_reachable(InstMapDelta0) },
{ instmap_delta_insert(InstMapDelta0, InputVar, LambdaInst,
InstMapDelta) },
{ goal_info_init(NonLocals, InstMapDelta, det, GoalInfo) },
{ InputGoal = unify(InputVar, Rhs, UnifyMode,
Unify, UnifyContext) - GoalInfo }
;
{ error("magic_util__create_closure") }
).
%-----------------------------------------------------------------------------%
% Project the supplementary predicate call onto the input
% arguments of the following call.
:- pred magic_util__project_supp_call(hlds_goal::in, list(var)::in,
proc_info::in, proc_info::out, list(var)::out, list(var)::out,
hlds_goal::out, magic_info::in, magic_info::out) is det.
magic_util__project_supp_call(SuppCall, UnrenamedInputVars,
ProcInfo0, ProcInfo, SuppInputArgs, LambdaVars, LambdaGoal) -->
(
{ SuppCall = call(SuppPredId1, SuppProcId1,
SuppArgs1, _, _, _) - _ }
->
{ SuppArgs = SuppArgs1 },
magic_info_get_module_info(ModuleInfo),
{ module_info_pred_proc_info(ModuleInfo, SuppPredId1,
SuppProcId1, _, SuppProcInfo) },
{ proc_info_argmodes(SuppProcInfo, SuppArgModes) },
{ partition_args(ModuleInfo, SuppArgModes,
SuppArgs, SuppInputArgs, SuppOutputArgs) }
;
{ error("magic_util__project_supp_call: not a call") }
),
% Rename the outputs of the supp call,
% but not the magic input relations.
{ proc_info_vartypes(ProcInfo0, VarTypes0) },
{ map__apply_to_list(SuppOutputArgs, VarTypes0, SuppOutputArgTypes) },
{ proc_info_create_vars_from_types(ProcInfo0, SuppOutputArgTypes,
NewArgs, ProcInfo) },
{ map__from_corresponding_lists(SuppOutputArgs, NewArgs, Subn) },
{ map__apply_to_list(UnrenamedInputVars, Subn, LambdaVars) },
{ goal_util__rename_vars_in_goal(SuppCall, Subn, LambdaGoal0) },
{ LambdaGoal0 = LambdaExpr - LambdaInfo0 },
{ list__append(SuppInputArgs, LambdaVars, LambdaNonLocals0) },
{ set__list_to_set(LambdaNonLocals0, LambdaNonLocals) },
{ goal_info_set_nonlocals(LambdaInfo0, LambdaNonLocals, LambdaInfo) },
{ LambdaGoal = LambdaExpr - LambdaInfo }.
%-----------------------------------------------------------------------------%
magic_util__add_to_magic_predicate(PredProcId, Rule, RuleArgs) -->
magic_info_get_magic_map(MagicMap),
{ map__lookup(MagicMap, PredProcId, MagicPred) },
magic_info_get_module_info(ModuleInfo0),
{ MagicPred = proc(MagicPredId, MagicProcId) },
{ module_info_preds(ModuleInfo0, Preds0) },
{ map__lookup(Preds0, MagicPredId, MagicPredInfo0) },
{ pred_info_procedures(MagicPredInfo0, MagicProcs0) },
{ map__lookup(MagicProcs0, MagicProcId, MagicProcInfo0) },
{ proc_info_goal(MagicProcInfo0, MagicGoal0) },
{ proc_info_varset(MagicProcInfo0, MagicVarSet0) },
{ proc_info_vartypes(MagicProcInfo0, MagicVarTypes0) },
{ proc_info_headvars(MagicProcInfo0, MagicProcHeadVars) },
magic_info_get_proc_info(ProcInfo),
{ proc_info_vartypes(ProcInfo, VarTypes) },
{ proc_info_varset(ProcInfo, VarSet) },
%
% Rename the variables in the supp predicate call.
%
{ map__from_corresponding_lists(RuleArgs, MagicProcHeadVars, Subn0) },
{ goal_util__goal_vars(Rule, RuleVars0) },
{ set__to_sorted_list(RuleVars0, RuleVars) },
{ goal_util__create_variables(RuleVars, MagicVarSet0, MagicVarTypes0,
Subn0, VarTypes, VarSet, MagicVarSet, MagicVarTypes, Subn) },
{ Rule = RuleExpr - RuleInfo0 },
{ set__list_to_set(RuleArgs, RuleArgSet) },
{ goal_info_set_nonlocals(RuleInfo0, RuleArgSet, RuleInfo) },
{ goal_util__must_rename_vars_in_goal(RuleExpr - RuleInfo,
Subn, ExtraDisjunct) },
%
% Add in the new disjunct.
%
{ goal_to_disj_list(MagicGoal0, MagicDisjList0) },
{ MagicGoal0 = _ - GoalInfo }, % near enough.
{ disj_list_to_goal([ExtraDisjunct | MagicDisjList0],
GoalInfo, MagicGoal) },
{ proc_info_set_vartypes(MagicProcInfo0,
MagicVarTypes, MagicProcInfo1) },
{ proc_info_set_varset(MagicProcInfo1,
MagicVarSet, MagicProcInfo2) },
{ proc_info_set_goal(MagicProcInfo2, MagicGoal, MagicProcInfo) },
{ map__det_update(MagicProcs0, MagicProcId, MagicProcInfo,
MagicProcs) },
{ pred_info_set_procedures(MagicPredInfo0,
MagicProcs, MagicPredInfo) },
{ map__det_update(Preds0, MagicPredId, MagicPredInfo, Preds) },
{ module_info_set_preds(ModuleInfo0, Preds, ModuleInfo) },
magic_info_set_module_info(ModuleInfo).
%-----------------------------------------------------------------------------%
magic_util__magic_call_info(MagicPredId, MagicProcId,
qualified(PredModule, PredName), InputRels,
InputArgs, MagicOutputModes) -->
magic_info_get_curr_pred_proc_id(PredProcId),
magic_info_get_magic_proc_info(MagicProcInfo),
{ map__lookup(MagicProcInfo, PredProcId, ThisProcInfo) },
{ ThisProcInfo = magic_proc_info(OldArgModes, _, _, _, _) },
magic_info_get_module_info(ModuleInfo),
%
% Get the arguments of the magic call.
%
magic_info_get_proc_info(ProcInfo0),
{ proc_info_headvars(ProcInfo0, HeadVars) },
{ proc_info_argmodes(ProcInfo0, ArgModes) },
{ partition_args(ModuleInfo, ArgModes, HeadVars, _, OldHeadVars) },
{ partition_args(ModuleInfo, OldArgModes, OldHeadVars, InputArgs, _) },
{ partition_args(ModuleInfo, OldArgModes,
OldArgModes, InputArgModes, _) },
{ list__map(magic_util__mode_to_output_mode(ModuleInfo),
InputArgModes, MagicOutputModes) },
magic_info_get_magic_vars(InputRels),
magic_info_get_magic_map(MagicMap),
{ map__lookup(MagicMap, PredProcId, proc(MagicPredId, MagicProcId)) },
{ module_info_pred_info(ModuleInfo, MagicPredId, MagicPredInfo) },
{ pred_info_name(MagicPredInfo, PredName) },
{ pred_info_module(MagicPredInfo, PredModule) }.
%-----------------------------------------------------------------------------%
% Create the supplementary predicate for a part of a goal that
% has been transformed. If the goal is already a single call,
% this is unnecessary.
:- pred magic_util__maybe_create_supp_call(list(hlds_goal)::in, set(var)::in,
list(var)::in, term__context::in, hlds_goal::out,
magic_info::in, magic_info::out) is det.
magic_util__maybe_create_supp_call(PrevGoals, NonLocals, InputArgs,
Context, SuppCall) -->
(
{ PrevGoals = [PrevGoal] },
{ PrevGoal = call(_, _, _, _, _, _) - _ }
->
{ SuppCall = PrevGoal }
;
magic_info_get_magic_vars(MagicVars),
{ magic_util__order_supp_call_outputs(PrevGoals, MagicVars,
NonLocals, InputArgs, SuppOutputArgs) },
magic_util__create_supp_call(PrevGoals, MagicVars,
SuppOutputArgs, Context, [], SuppCall)
).
% If the supplementary call is to be used as input to
% another call, attempt to get the arguments in the right order
% to avoid an unnecessary projection. If this is not
% possible, choose any order.
:- pred magic_util__order_supp_call_outputs(list(hlds_goal)::in, list(var)::in,
set(var)::in, list(var)::in, list(var)::out) is det.
magic_util__order_supp_call_outputs(Goals, MagicVars, NonLocals,
ArgsInOrder, Args) :-
goal_list_nonlocals(Goals, SuppNonLocals),
set__intersect(SuppNonLocals, NonLocals, SuppArgSet0),
set__delete_list(SuppArgSet0, MagicVars, SuppArgSet1),
(
\+ (
set__member(Arg, SuppArgSet1),
\+ list__member(Arg, ArgsInOrder)
)
->
Args = ArgsInOrder
;
set__to_sorted_list(SuppArgSet1, Args)
).
:- pred magic_util__create_supp_call(list(hlds_goal)::in, list(var)::in,
list(var)::in, term__context::in, list(marker)::in, hlds_goal::out,
magic_info::in, magic_info::out) is det.
magic_util__create_supp_call(Goals, MagicVars, SuppOutputArgs, Context,
ExtraMarkers, SuppCall) -->
{ list__append(MagicVars, SuppOutputArgs, SuppArgs) },
%
% Compute a goal_info for the call.
%
{ goal_list_instmap_delta(Goals, Delta0) },
{ set__list_to_set(SuppArgs, SuppArgSet) },
{ instmap_delta_restrict(Delta0, SuppArgSet, Delta) },
{ goal_info_init(SuppArgSet, Delta, nondet, GoalInfo) },
%
% Verify that the supplementary predicate does not have any partially
% instantiated or higher-order arguments other than the input closures.
%
magic_info_get_proc_info(ProcInfo),
{ proc_info_vartypes(ProcInfo, VarTypes) },
{ map__apply_to_list(SuppOutputArgs, VarTypes, SuppOutputTypes) },
{ GetSuppMode =
lambda([Var::in, Mode::out] is det, (
( instmap_delta_search_var(Delta, Var, NewInst) ->
Mode = (free -> NewInst)
;
% This is a lie, but we're only using this to check
% that the output arguments aren't partially
% instantiated. Any arguments that are partially
% instantiated in the initial instmap for the
% procedure will be reported there.
Mode = (ground(shared, no) -> ground(shared, no))
)
)) },
{ list__map(GetSuppMode, SuppOutputArgs, SuppOutputModes) },
magic_util__check_args(SuppOutputArgs, SuppOutputModes,
SuppOutputTypes, Context, var_name),
%
% Fill in the fields of the new predicate.
%
magic_info_get_module_info(ModuleInfo0),
magic_info_get_pred_info(PredInfo),
{ pred_info_name(PredInfo, Name) },
magic_info_get_next_supp_id(SuppId),
{ string__format("%s__supp%i", [s(Name), i(SuppId)], NewName) },
{ proc_info_get_initial_instmap(ProcInfo, ModuleInfo0, InstMap) },
{ pred_info_arg_types(PredInfo, TVarSet, _) },
{ pred_info_get_aditi_owner(PredInfo, Owner) },
{ pred_info_get_markers(PredInfo, Markers0) },
{ AddMarkers = lambda([Marker::in, Ms0::in, Ms::out] is det,
add_marker(Ms0, Marker, Ms)
) },
{ list__foldl(AddMarkers, ExtraMarkers, Markers0, Markers) },
% Add the predicate to the predicate table.
{ conj_list_to_goal(Goals, GoalInfo, SuppGoal) },
{ ClassConstraints = [] },
{ map__init(TVarMap) },
{ map__init(TCVarMap) },
{ proc_info_varset(ProcInfo, VarSet) },
{ hlds_pred__define_new_pred(SuppGoal, SuppCall, SuppArgs, InstMap,
NewName, TVarSet, VarTypes, ClassConstraints, TVarMap,
TCVarMap, VarSet, Markers, Owner, ModuleInfo0, ModuleInfo, _) },
magic_info_set_module_info(ModuleInfo).
%-----------------------------------------------------------------------------%
magic_util__mode_to_output_mode(ModuleInfo, Mode, OutputMode) :-
mode_get_insts(ModuleInfo, Mode, _, FinalInst),
OutputMode = (free -> FinalInst).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
magic_util__check_args(Vars, Modes, Types, Context, IdType) -->
( magic_util__check_args_2(Vars, Modes, Types, Context, 1, IdType) ->
[]
;
{ error("magic_util__check_args") }
).
:- pred magic_util__check_args_2(list(var)::in, list(mode)::in, list(type)::in,
term__context::in, int::in, magic_arg_id_type::in,
magic_info::in, magic_info::out) is semidet.
magic_util__check_args_2([], [], [], _, _, _) --> [].
magic_util__check_args_2([Var | Vars], [ArgMode | ArgModes],
[ArgType | ArgTypes], Context, ArgNo, ArgIdType) -->
magic_info_get_error_vars(ErrorVars0),
( { set__member(Var, ErrorVars0) } ->
[]
;
(
{ ArgIdType = arg_number },
{ ArgId = arg_number(ArgNo) }
;
{ ArgIdType = var_name },
magic_info_get_proc_info(ProcInfo),
{ proc_info_varset(ProcInfo, VarSet) },
{ varset__lookup_name(VarSet, Var, VarName) },
{ ArgId = var_name(VarName) }
),
magic_info_get_curr_pred_proc_id(PredProcId),
magic_info_get_module_info(ModuleInfo),
( { type_is_aditi_state(ArgType) } ->
( { \+ mode_is_input(ModuleInfo, ArgMode) } ->
% aditi__states must be input
{ StateError =
[argument_error(output_aditi_state,
ArgId, PredProcId) - Context] }
;
{ StateError = [] }
)
;
{ StateError = [] }
),
% Check that the argument types are legal.
magic_util__check_type(ArgType, ErrorTypes),
{ set__to_sorted_list(ErrorTypes, ErrorTypeList0) },
% Check that partially instantiated modes are not used.
{ mode_get_insts(ModuleInfo, ArgMode, Inst1, Inst2) },
(
{ inst_is_free(ModuleInfo, Inst1)
; inst_is_ground(ModuleInfo, Inst1)
},
{ inst_is_free(ModuleInfo, Inst2)
; inst_is_ground(ModuleInfo, Inst2)
}
->
{ ErrorTypeList = ErrorTypeList0 }
;
{ ErrorTypeList =
[partially_instantiated | ErrorTypeList0] }
),
{ ConvertError =
lambda([ErrorType::in, MagicError::out] is det, (
MagicError = argument_error(ErrorType,
ArgId, PredProcId) - Context
)) },
{ list__map(ConvertError, ErrorTypeList, TypeErrors) },
( { TypeErrors = [] } ->
{ set__insert(ErrorVars0, Var, ErrorVars) },
magic_info_set_error_vars(ErrorVars)
;
[]
),
magic_info_get_errors(Errors0),
{ set__insert_list(Errors0, TypeErrors, Errors1) },
{ set__insert_list(Errors1, StateError, Errors) },
magic_info_set_errors(Errors),
{ NextArgNo is ArgNo + 1 },
magic_util__check_args_2(Vars, ArgModes, ArgTypes,
Context, NextArgNo, ArgIdType)
).
%-----------------------------------------------------------------------------%
% Go over a type collecting any reasons why that type cannot
% be an argument type of an Aditi relation.
:- pred magic_util__check_type((type)::in, set(argument_error)::out,
magic_info::in, magic_info::out) is det.
magic_util__check_type(ArgType, Errors) -->
{ set__init(Errors0) },
% Polymorphic types are not allowed.
{ map__init(Subn) },
( { term__is_ground(ArgType, Subn) } ->
{ Errors1 = Errors0 }
;
{ set__insert(Errors0, polymorphic, Errors1) }
),
{ set__init(Parents) },
magic_util__traverse_type(yes, Parents, ArgType, Errors1, Errors).
:- pred magic_util__traverse_type(bool::in, set(type_id)::in, (type)::in,
set(argument_error)::in, set(argument_error)::out,
magic_info::in, magic_info::out) is det.
magic_util__traverse_type(IsTopLevel, Parents, ArgType, Errors0, Errors) -->
magic_info_get_module_info(ModuleInfo),
( { type_is_atomic(ArgType, ModuleInfo) } ->
{ Errors = Errors0 }
; { type_is_higher_order(ArgType, _, _) } ->
% Higher-order types are not allowed.
{ set__insert(Errors0, higher_order, Errors) }
; { type_is_aditi_state(ArgType) } ->
( { IsTopLevel = no } ->
{ set__insert(Errors0, embedded_aditi_state, Errors) }
;
{ Errors = Errors0 }
)
;
% The type is user-defined.
( { type_to_type_id(ArgType, TypeId, Args) } ->
magic_util__check_type_id(Parents, TypeId,
Errors0, Errors1),
list__foldl2(magic_util__traverse_type(no, Parents),
Args, Errors1, Errors)
;
% type variable - the type parameters
% are checked separately.
{ Errors = Errors0 }
)
).
:- pred magic_util__check_type_id(set(type_id)::in, type_id::in,
set(argument_error)::in, set(argument_error)::out,
magic_info::in, magic_info::out) is det.
magic_util__check_type_id(Parents, TypeId, Errors0, Errors) -->
magic_info_get_ok_types(OKTypes0),
magic_info_get_bad_types(BadTypes0),
( { set__member(TypeId, Parents) } ->
{ Errors = Errors0 }
; { set__member(TypeId, OKTypes0) } ->
{ Errors = Errors0 }
; { map__search(BadTypes0, TypeId, TypeErrors) } ->
{ set__union(Errors0, TypeErrors, Errors) }
;
magic_info_get_module_info(ModuleInfo),
{ module_info_types(ModuleInfo, Types) },
{ map__lookup(Types, TypeId, TypeDefn) },
{ hlds_data__get_type_defn_body(TypeDefn, TypeBody) },
{ set__init(NewErrors0) },
{ set__insert(Parents, TypeId, Parents1) },
magic_util__check_type_defn(TypeBody, Parents1,
NewErrors0, NewErrors),
( { set__empty(NewErrors) } ->
{ set__insert(OKTypes0, TypeId, OKTypes) },
{ Errors = Errors0 },
magic_info_set_ok_types(OKTypes)
;
{ map__det_insert(BadTypes0, TypeId,
NewErrors, BadTypes) },
{ set__union(Errors0, NewErrors, Errors) },
magic_info_set_bad_types(BadTypes)
)
).
:- pred magic_util__check_type_defn(hlds_type_body::in, set(type_id)::in,
set(argument_error)::in, set(argument_error)::out,
magic_info::in, magic_info::out) is det.
magic_util__check_type_defn(du_type(Ctors, _, _, _),
Parents, Errors0, Errors) -->
list__foldl2(magic_util__check_ctor(Parents), Ctors, Errors0, Errors).
magic_util__check_type_defn(uu_type(_), _, _, _) -->
{ error("magic_util__check_type_defn: uu_type") }.
magic_util__check_type_defn(eqv_type(_), _, _, _) -->
{ error("magic_util__check_type_defn: eqv_type") }.
magic_util__check_type_defn(abstract_type, _, Errors0, Errors) -->
{ set__insert(Errors0, abstract, Errors) }.
:- pred magic_util__check_ctor(set(type_id)::in, constructor::in,
set(argument_error)::in, set(argument_error)::out,
magic_info::in, magic_info::out) is det.
magic_util__check_ctor(Parents, _ - CtorArgs, Errors0, Errors) -->
{ assoc_list__values(CtorArgs, CtorArgTypes) },
list__foldl2(magic_util__traverse_type(no, Parents),
CtorArgTypes, Errors0, Errors).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- interface.
% Information from the preprocessing pass about the magic input
% variables for a procedure.
:- type magic_proc_info
---> magic_proc_info(
list(mode), % pre-transformation arg modes
% (minus aditi__states).
list(var), % magic input vars.
list(type), % types of magic input vars.
list(mode), % modes of magic input vars.
maybe(int) % index of this proc's magic
% input var in the above lists,
% no if the procedure is not
% an entry point of the sub-module.
).
% Map from post-transformation pred_proc_id to the
% corresponding magic predicate. Magic predicates
% collect the tuples which would occur as inputs in
% a top-down execution.
:- type magic_map == map(pred_proc_id, pred_proc_id).
% Map from pre-transformation pred_proc_id to
% post transformation pred_proc_id.
:- type pred_map == map(pred_proc_id, pred_proc_id).
:- type magic_errors == set(magic_error).
:- type magic_info.
:- pred magic_info_init(module_info, magic_info).
:- mode magic_info_init(in, out) is det.
:- pred magic_info_get_module_info(module_info::out, magic_info::in,
magic_info::out) is det.
:- pred magic_info_get_curr_pred_proc_id(pred_proc_id::out, magic_info::in,
magic_info::out) is det.
:- pred magic_info_get_pred_info(pred_info::out, magic_info::in,
magic_info::out) is det.
:- pred magic_info_get_proc_info(proc_info::out, magic_info::in,
magic_info::out) is det.
:- pred magic_info_get_sub_module(list(pred_proc_id)::out, magic_info::in,
magic_info::out) is det.
:- pred magic_info_get_magic_map(magic_map::out, magic_info::in,
magic_info::out) is det.
:- pred magic_info_get_magic_vars(list(var)::out, magic_info::in,
magic_info::out) is det.
:- pred magic_info_get_magic_insts(list(inst)::out, magic_info::in,
magic_info::out) is det.
:- pred magic_info_get_magic_var_map(map(pred_proc_id, var)::out,
magic_info::in, magic_info::out) is det.
:- pred magic_info_get_next_supp_id(int::out, magic_info::in,
magic_info::out) is det.
:- pred magic_info_get_magic_proc_info(map(pred_proc_id, magic_proc_info)::out,
magic_info::in, magic_info::out) is det.
:- pred magic_info_get_pred_map(pred_map::out,
magic_info::in, magic_info::out) is det.
:- pred magic_info_get_error_vars(set(var)::out,
magic_info::in, magic_info::out) is det.
:- pred magic_info_get_errors(magic_errors::out,
magic_info::in, magic_info::out) is det.
:- pred magic_info_get_ok_types(set(type_id)::out,
magic_info::in, magic_info::out) is det.
:- pred magic_info_get_bad_types(map(type_id, set(argument_error))::out,
magic_info::in, magic_info::out) is det.
:- pred magic_info_set_module_info(module_info::in, magic_info::in,
magic_info::out) is det.
:- pred magic_info_set_curr_pred_proc_id(pred_proc_id::in, magic_info::in,
magic_info::out) is det.
:- pred magic_info_set_pred_info(pred_info::in, magic_info::in,
magic_info::out) is det.
:- pred magic_info_set_proc_info(proc_info::in, magic_info::in,
magic_info::out) is det.
:- pred magic_info_set_sub_module(list(pred_proc_id)::in, magic_info::in,
magic_info::out) is det.
:- pred magic_info_set_magic_map(magic_map::in, magic_info::in,
magic_info::out) is det.
:- pred magic_info_set_magic_vars(list(var)::in, magic_info::in,
magic_info::out) is det.
:- pred magic_info_set_magic_insts(list(inst)::in, magic_info::in,
magic_info::out) is det.
:- pred magic_info_set_magic_var_map(map(pred_proc_id, var)::in,
magic_info::in, magic_info::out) is det.
:- pred magic_info_set_magic_proc_info(map(pred_proc_id, magic_proc_info)::in,
magic_info::in, magic_info::out) is det.
:- pred magic_info_set_pred_map(pred_map::in,
magic_info::in, magic_info::out) is det.
:- pred magic_info_set_error_vars(set(var)::in,
magic_info::in, magic_info::out) is det.
:- pred magic_info_set_errors(magic_errors::in,
magic_info::in, magic_info::out) is det.
:- pred magic_info_set_ok_types(set(type_id)::in,
magic_info::in, magic_info::out) is det.
:- pred magic_info_set_bad_types(map(type_id, set(argument_error))::in,
magic_info::in, magic_info::out) is det.
%-----------------------------------------------------------------------------%
:- implementation.
:- type magic_info
---> magic_info(
module_info,
maybe(pred_proc_id),
maybe(pred_info),
maybe(proc_info),
list(pred_proc_id), % preds in the current
% sub-module
magic_map, % magic pred_proc_id for
% each pred_proc_id
list(var), % magic input variables
list(inst), % insts of magic input vars
map(pred_proc_id, var), % magic input variables for
% each entry-point of the
% sub-module
int, % next supp id
map(pred_proc_id, magic_proc_info),
pred_map,
% map from old to transformed
% pred_proc_id
set(var), % vars for which errors have
% been reported.
magic_errors,
set(type_id), % type_ids which are allowed
% as argument types of
% Aditi predicates. A type
% is ok if no part of it is
% higher-order or abstract.
map(type_id, set(argument_error)),
% type_ids which are not ok
% as Aditi argument types.
unit,
unit
).
%-----------------------------------------------------------------------------%
magic_info_init(ModuleInfo, MagicInfo) :-
map__init(MagicMap),
map__init(VarMap),
map__init(MagicProcInfo),
map__init(PredMap),
set__init(Errors),
set__init(OKTypes),
map__init(BadTypes),
set__init(ErrorVars),
MagicInfo = magic_info(ModuleInfo, no, no, no, [], MagicMap, [], [],
VarMap, 1, MagicProcInfo, PredMap, ErrorVars, Errors,
OKTypes, BadTypes, unit, unit).
magic_info_get_module_info(ModuleInfo, Info, Info) :-
Info = magic_info(ModuleInfo,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_).
magic_info_get_curr_pred_proc_id(PredProcId, Info, Info) :-
Info = magic_info(_,MaybePredProcId,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_),
( MaybePredProcId = yes(PredProcId1) ->
PredProcId = PredProcId1
;
error("magic_info_get_pred_info")
).
magic_info_get_pred_info(PredInfo, Info, Info) :-
Info = magic_info(_,_,MaybePredInfo,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_),
( MaybePredInfo = yes(PredInfo1) ->
PredInfo = PredInfo1
;
error("magic_info_get_pred_info")
).
magic_info_get_proc_info(ProcInfo, Info, Info) :-
Info = magic_info(_,_,_,MaybeProcInfo,_,_,_,_,_,_,_,_,_,_,_,_,_,_),
( MaybeProcInfo = yes(ProcInfo1) ->
ProcInfo = ProcInfo1
;
error("magic_info_get_proc_info")
).
magic_info_get_sub_module(SubModule, Info, Info) :-
Info = magic_info(_,_,_,_,SubModule,_,_,_,_,_,_,_,_,_,_,_,_,_).
magic_info_get_magic_map(Map, Info, Info) :-
Info = magic_info(_,_,_,_,_,Map,_,_,_,_,_,_,_,_,_,_,_,_).
magic_info_get_magic_vars(Vars, Info, Info) :-
Info = magic_info(_,_,_,_,_,_,Vars,_,_,_,_,_,_,_,_,_,_,_).
magic_info_get_magic_insts(Insts, Info, Info) :-
Info = magic_info(_,_,_,_,_,_,_,Insts,_,_,_,_,_,_,_,_,_,_).
magic_info_get_magic_var_map(VarMap, Info, Info) :-
Info = magic_info(_,_,_,_,_,_,_,_,VarMap,_,_,_,_,_,_,_,_,_).
magic_info_get_next_supp_id(SuppId0,
magic_info(A,B,C,D,E,F,G,H,I,SuppId0,K,L,M,N,O,P,Q,R),
magic_info(A,B,C,D,E,F,G,H,I,SuppId,K,L,M,N,O,P,Q,R)) :-
SuppId is SuppId0 + 1.
magic_info_get_magic_proc_info(MagicProcInfo, Info, Info) :-
Info = magic_info(_,_,_,_,_,_,_,_,_,_,MagicProcInfo,_,_,_,_,_,_,_).
magic_info_get_pred_map(PredMap, Info, Info) :-
Info = magic_info(_,_,_,_,_,_,_,_,_,_,_, PredMap,_,_,_,_,_,_).
magic_info_get_error_vars(ErrorVars, Info, Info) :-
Info = magic_info(_,_,_,_,_,_,_,_,_,_,_,_,ErrorVars,_,_,_,_,_).
magic_info_get_errors(Errors, Info, Info) :-
Info = magic_info(_,_,_,_,_,_,_,_,_,_,_,_,_,Errors,_,_,_,_).
magic_info_get_ok_types(Types, Info, Info) :-
Info = magic_info(_,_,_,_,_,_,_,_,_,_,_,_,_,_,Types,_,_,_).
magic_info_get_bad_types(Types, Info, Info) :-
Info = magic_info(_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,Types,_,_).
%-----------------------------------------------------------------------------%
magic_info_set_module_info(ModuleInfo, Info0, Info) :-
Info0 = magic_info(_,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R),
Info = magic_info(ModuleInfo,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R).
magic_info_set_curr_pred_proc_id(PredProcId, Info0, Info) :-
Info0 = magic_info(A,_,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R),
Info = magic_info(A,yes(PredProcId),C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R).
magic_info_set_pred_info(PredInfo, Info0, Info) :-
Info0 = magic_info(A,B,_,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R),
Info = magic_info(A,B,yes(PredInfo),D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R).
magic_info_set_proc_info(ProcInfo, Info0, Info) :-
Info0 = magic_info(A,B,C,_,E,F,G,H,I,J,K,L,M,N,O,P,Q,R),
Info = magic_info(A,B,C,yes(ProcInfo),E,F,G,H,I,J,K,L,M,N,O,P,Q,R).
magic_info_set_sub_module(SubModule, Info0, Info) :-
Info0 = magic_info(A,B,C,D,_,F,G,H,I,J,K,L,M,N,O,P,Q,R),
Info = magic_info(A,B,C,D,SubModule,F,G,H,I,J,K,L,M,N,O,P,Q,R).
magic_info_set_magic_map(MagicMap, Info0, Info) :-
Info0 = magic_info(A,B,C,D,E,_,G,H,I,J,K,L,M,N,O,P,Q,R),
Info = magic_info(A,B,C,D,E,MagicMap,G,H,I,J,K,L,M,N,O,P,Q,R).
magic_info_set_magic_vars(Vars, Info0, Info) :-
Info0 = magic_info(A,B,C,D,E,F,_,H,I,J,K,L,M,N,O,P,Q,R),
Info = magic_info(A,B,C,D,E,F,Vars,H,I,J,K,L,M,N,O,P,Q,R).
magic_info_set_magic_insts(Insts, Info0, Info) :-
Info0 = magic_info(A,B,C,D,E,F,G,_,I,J,K,L,M,N,O,P,Q,R),
Info = magic_info(A,B,C,D,E,F,G,Insts,I,J,K,L,M,N,O,P,Q,R).
magic_info_set_magic_var_map(Map, Info0, Info) :-
Info0 = magic_info(A,B,C,D,E,F,G,H,_,J,K,L,M,N,O,P,Q,R),
Info = magic_info(A,B,C,D,E,F,G,H,Map,J,K,L,M,N,O,P,Q,R).
magic_info_set_magic_proc_info(MagicProcInfo, Info0, Info) :-
Info0 = magic_info(A,B,C,D,E,F,G,H,I,J,_,L,M,N,O,P,Q,R),
Info = magic_info(A,B,C,D,E,F,G,H,I,J,MagicProcInfo,L,M,N,O,P,Q,R).
magic_info_set_pred_map(PredMap, Info0, Info) :-
Info0 = magic_info(A,B,C,D,E,F,G,H,I,J,K,_,M,N,O,P,Q,R),
Info = magic_info(A,B,C,D,E,F,G,H,I,J,K,PredMap,M,N,O,P,Q,R).
magic_info_set_error_vars(ErrorVars, Info0, Info) :-
Info0 = magic_info(A,B,C,D,E,F,G,H,I,J,K,L,_,N,O,P,Q,R),
Info = magic_info(A,B,C,D,E,F,G,H,I,J,K,L,ErrorVars,N,O,P,Q,R).
magic_info_set_errors(Errors, Info0, Info) :-
Info0 = magic_info(A,B,C,D,E,F,G,H,I,J,K,L,M,_,O,P,Q,R),
Info = magic_info(A,B,C,D,E,F,G,H,I,J,K,L,M,Errors,O,P,Q,R).
magic_info_set_ok_types(Types, Info0, Info) :-
Info0 = magic_info(A,B,C,D,E,F,G,H,I,J,K,L,M,N,_,P,Q,R),
Info = magic_info(A,B,C,D,E,F,G,H,I,J,K,L,M,N,Types,P,Q,R).
magic_info_set_bad_types(Types, Info0, Info) :-
Info0 = magic_info(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,_,Q,R),
Info = magic_info(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,Types,Q,R).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
% Error handling.
:- interface.
:- type magic_error == pair(magic_error_type, term__context).
:- type magic_arg_id_type
---> arg_number
; var_name
.
:- type magic_arg_id
---> arg_number(int)
; var_name(string)
.
:- type magic_error_type
---> argument_error(argument_error, magic_arg_id, pred_proc_id)
% The maybe(int) here is an argument number.
% If there is no argument number the error
% occurred creating a supplementary predicate.
; curried_argument(pred_proc_id)
% Curried args to an aggregate closure are NYI.
; non_removeable_aditi_state(pred_proc_id, varset, list(var))
% Other than in database calls, `aditi:state'
% variables can only occur in assignment
% unifications, since magic sets needs to
% be able to remove them.
; context_error(linearity_error, pred_proc_id)
; mutually_recursive_context(pred_proc_id, list(pred_proc_id))
% Procedures with a `context' marker must
% not be mutually recursive with other
% predicates.
; mixed_scc(list(pred_proc_id))
% SCC with Aditi and non-Aditi components.
.
:- type argument_error
---> partially_instantiated
; higher_order
; abstract
; polymorphic
; output_aditi_state
; embedded_aditi_state
.
:- type linearity_error
---> end_goals_not_recursive
% For a goal to be linear, either the first or
% the last goal must be a recursive call.
; multi_rec_goal_not_multi_linear
% The last call in a rule with multiple recursive
% calls was not recursive.
; inputs_to_recursive_call
% for the recursive call in a left-linear rule,
% and for the internal recursive calls in
% a multi-linear rule, the inputs must be the
% inputs to the procedure.
% The lists of variables are the list of inputs
% to the procedure and to the erroneous call.
; outputs_of_recursive_call
% for the last recursive call in a right- or
% multi-linear rule, the outputs must be the
% outputs of the procedure.
% The lists of variables are the list of inputs
% to the procedure and to the erroneous call.
; inputs_occur_in_other_goals
% For left-linear rules, the inputs to the procedure
% may only occur in the recursive call.
% For multi-linear rules, the inputs to the procedure
% may only occur as inputs to the interior recursive
% calls.
; multi_inputs_occur_in_last_rec_call
% For multi-linear predicates, the inputs
% to the last recursive call may not include
% any inputs to the procedure.
.
%-----------------------------------------------------------------------------%
:- implementation.
magic_util__report_errors(Errors, ModuleInfo, Verbose) -->
list__foldl(magic_util__report_error(ModuleInfo, Verbose), Errors).
:- pred magic_util__report_error(module_info::in, bool::in, magic_error::in,
io__state::di, io__state::uo) is det.
magic_util__report_error(ModuleInfo, Verbose,
argument_error(Error, Arg, proc(PredId, _)) - Context) -->
{ error_util__describe_one_pred_name(ModuleInfo, PredId, PredName) },
{ string__append_list(["In ", PredName, ":"], PredNamePiece) },
{ magic_util__error_arg_id_piece(Arg, ArgPiece) },
{ magic_util__report_argument_error(Context, Error, ArgPiece,
Verbose, SecondPart) },
write_error_pieces(Context, 0, [fixed(PredNamePiece), nl | SecondPart]).
magic_util__report_error(ModuleInfo, _Verbose,
curried_argument(proc(PredId, _)) - Context) -->
{ error_util__describe_one_pred_name(ModuleInfo, PredId, PredName) },
{ string__append_list(["In ", PredName, ":"], PredNamePiece) },
{ SecondPart = [words("sorry, curried closure arguments are not"),
words("implemented for Aditi procedures."),
words("Construct them within the closure instead.")] },
write_error_pieces(Context, 0, [fixed(PredNamePiece), nl | SecondPart]).
magic_util__report_error(ModuleInfo, _Verbose,
non_removeable_aditi_state(proc(PredId, _), VarSet, Vars)
- Context) -->
{ error_util__describe_one_pred_name(ModuleInfo, PredId, PredName) },
{ string__append_list(["In ", PredName, ":"], PredNamePiece) },
{ Vars = [_] ->
VarPiece = words("variable"),
StatePiece = words("is a non-removable `aditi:state'.")
;
VarPiece = words("variables"),
StatePiece = words("are non-removable `aditi:state's.")
},
{ list__map(varset__lookup_name(VarSet), Vars, VarNames) },
{ error_util__list_to_pieces(VarNames, VarNamePieces) },
{ list__condense([[fixed(PredNamePiece), nl, VarPiece],
VarNamePieces, [StatePiece]], Pieces) },
write_error_pieces(Context, 0, Pieces).
magic_util__report_error(ModuleInfo, Verbose,
context_error(Error, proc(PredId, _ProcId)) - Context) -->
{ error_util__describe_one_pred_name(ModuleInfo, PredId, PredName) },
{ string__append_list(["In ", PredName, ":"], PredNamePiece) },
{ SecondPart = [words("with `:- pragma context(...)' declaration:"),
nl, words("error: recursive rule is not linear.\n")] },
{ magic_util__report_linearity_error(ModuleInfo,
Context, Verbose, Error, LinearityPieces) },
{ list__append([fixed(PredNamePiece), nl | SecondPart],
LinearityPieces, Pieces) },
write_error_pieces(Context, 0, Pieces).
magic_util__report_error(ModuleInfo, _Verbose,
mutually_recursive_context(PredProcId,
OtherPredProcIds) - Context) -->
{ error_util__describe_one_proc_name(ModuleInfo,
PredProcId, ProcPiece) },
{ error_util__describe_several_proc_names(ModuleInfo,
OtherPredProcIds, OtherProcPieces) },
{ list__condense(
[[words("Error: procedure"), words(ProcPiece), words("with a"),
fixed("`:- pragma context(...)"),
words("declaration is mutually recursive with")],
OtherProcPieces, [words(".")]], Pieces) },
write_error_pieces(Context, 0, Pieces).
magic_util__report_error(ModuleInfo, _Verbose,
mixed_scc(PredProcIds) - Context) -->
{ error_util__describe_several_proc_names(ModuleInfo,
PredProcIds, SCCPieces) },
{ list__condense([
[words("In the strongly connected component consisting of")],
SCCPieces,
[words("some, but not all procedures are marked"),
words("for Aditi compilation.")]], Pieces) },
write_error_pieces(Context, 0, Pieces).
:- pred magic_util__error_arg_id_piece(magic_arg_id::in,
format_component::out) is det.
magic_util__error_arg_id_piece(arg_number(ArgNo), words(ArgWords)) :-
string__int_to_string(ArgNo, ArgStr),
string__append("argument ", ArgStr, ArgWords).
magic_util__error_arg_id_piece(var_name(Name), words(Name)).
:- pred magic_util__report_argument_error(term__context::in,
argument_error::in, format_component::in, bool::in,
list(format_component)::out) is det.
magic_util__report_argument_error(_Context, partially_instantiated,
ArgPiece, _Verbose, Pieces) :-
Pieces = [ArgPiece, words("is partially instantiated.")].
magic_util__report_argument_error(_Context, higher_order,
ArgPiece, _, Pieces) :-
Pieces = [words("the type of"), ArgPiece, words("is higher order.")].
magic_util__report_argument_error(_Context, polymorphic, ArgPiece, _, Pieces) :-
Pieces = [words("the type of"), ArgPiece, words("is polymorphic.")].
magic_util__report_argument_error(_Context, abstract, ArgPiece, _, Pieces) :-
Pieces = [words("the type of"), ArgPiece,
words("contains abstract types.")].
magic_util__report_argument_error(_Context, output_aditi_state,
ArgPiece, _, Pieces) :-
Pieces = [ArgPiece, words("is an output `aditi:state'.")].
magic_util__report_argument_error(_Context, embedded_aditi_state,
ArgPiece, _, Pieces) :-
Pieces = [words("the type of"), ArgPiece,
words("contains an embedded `aditi:state'.")].
:- pred magic_util__report_linearity_error(module_info::in, term__context::in,
bool::in, linearity_error::in, list(format_component)::out) is det.
magic_util__report_linearity_error(_ModuleInfo, _Context, _Verbose,
end_goals_not_recursive, Pieces) :-
Pieces = [words("For a rule to be linear, either the first or last"),
words("goal must be a recursive call.")].
magic_util__report_linearity_error(_ModuleInfo, _Context, _Verbose,
multi_rec_goal_not_multi_linear, Pieces) :-
Pieces = [words("The rule contains multiple recursive calls but is"),
words("not multi-linear because the last goal"),
words("is not recursive.")].
magic_util__report_linearity_error(_ModuleInfo, _Context, _Verbose,
inputs_to_recursive_call, Pieces) :-
Pieces = [words("For the rule to be linear, the input variables of"),
words("this recursive call must be the same as the input"),
words("variables of the clause head.")].
magic_util__report_linearity_error(_, _, _,
outputs_of_recursive_call, Pieces) :-
Pieces = [words("For the rule to be linear, the output variables of"),
words("this recursive call must be the same as the output"),
words("variables of the clause head.")].
magic_util__report_linearity_error(_, _, _,
inputs_occur_in_other_goals, Pieces) :-
Pieces = [words("The inputs to the rule may only occur in"),
words("recursive calls, unless the rule is right-linear.")].
magic_util__report_linearity_error(_, _, _,
multi_inputs_occur_in_last_rec_call, Pieces) :-
Pieces = [words("In a multi-linear rule, the inputs to the"),
words("procedure may not occur as arguments of the last"),
words("recursive call.")].
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
More information about the developers
mailing list