mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-19 07:45:09 +00:00
30baaf2e45
varset.nl: Added predicate varset__vars. term.nl: Added predicate term__vars_list. typecheck.nl: Implement two previously unimplemented parts of the typechecker: detect attempts to instantiate type variables which occur in the predicate's type declaration, and detect any failure to bind all other type variables. (That was the last two; apart from prog_util.nl: Fix problem where the expansion of equivalence types was introducing fresh variables into the type varset, which caused problems in relation to the above changes to typecheck.nl. hlds_out.nl: Fix typo in type declaration (found by above fixes to typechecker). options.nl: Fix bug in type definition introduced by last change. make_hlds.nl: Add a missing pred & mode declaration. modes.nl: Don't display the verbose messages unless the very-verbose flag was specified.
1891 lines
66 KiB
Mathematica
1891 lines
66 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% File: modes.nl.
|
|
% Main author: fjh.
|
|
%
|
|
% This file contains a mode-checker.
|
|
% Adapted from the mode-checker; still very incomplete.
|
|
%
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- module modes.
|
|
:- interface.
|
|
:- import_module hlds, io, prog_io.
|
|
|
|
:- pred modecheck(module_info, module_info, bool, io__state, io__state).
|
|
:- mode modecheck(input, output, output, di, uo).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
:- import_module list, map, varset, prog_out, string, require, std_util.
|
|
:- import_module globals, getopt, options.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% XXX need to pass FoundError to all steps
|
|
|
|
modecheck(Module0, Module, FoundError) -->
|
|
lookup_option(very_verbose, bool(VeryVerbose)),
|
|
lookup_option(verbose, bool(Verbose)),
|
|
io__stderr_stream(StdErr),
|
|
io__set_output_stream(StdErr, OldStream),
|
|
maybe_report_stats(VeryVerbose),
|
|
|
|
maybe_write_string(Verbose,
|
|
"% Checking for undefined insts and modes...\n"),
|
|
check_undefined_modes(Module0, Module1),
|
|
maybe_report_stats(VeryVerbose),
|
|
|
|
maybe_write_string(Verbose, "% Mode-checking clauses...\n"),
|
|
check_pred_modes(Module1, Module, FoundError),
|
|
maybe_report_stats(VeryVerbose),
|
|
|
|
io__set_output_stream(OldStream, _).
|
|
|
|
/*****
|
|
{ FoundError = no },
|
|
{ Module = Module1 },
|
|
*****/
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Mode-check the code for all the predicates in a module.
|
|
|
|
:- pred check_pred_modes(module_info, module_info, bool, io__state, io__state).
|
|
:- mode check_pred_modes(input, output, output, di, uo).
|
|
|
|
check_pred_modes(Module0, Module, FoundError) -->
|
|
{ moduleinfo_predids(Module0, PredIds) },
|
|
modecheck_pred_modes_2(PredIds, Module0, no, Module, FoundError).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Iterate over the list of pred_ids in a module.
|
|
|
|
:- pred modecheck_pred_modes_2(list(pred_id), module_info, bool,
|
|
module_info, bool, io__state, io__state).
|
|
:- mode modecheck_pred_modes_2(input, input, input, output, output, di, uo).
|
|
|
|
modecheck_pred_modes_2([], ModuleInfo, Error, ModuleInfo, Error) --> [].
|
|
modecheck_pred_modes_2([PredId | PredIds], ModuleInfo0, Error0,
|
|
ModuleInfo, Error) -->
|
|
{ moduleinfo_preds(ModuleInfo0, Preds0) },
|
|
{ map__search(Preds0, PredId, PredInfo0) },
|
|
{ predinfo_clauses_info(PredInfo0, ClausesInfo0) },
|
|
{ ClausesInfo0 = clauses_info(_, _, _, Clauses0) },
|
|
( { Clauses0 = [] } ->
|
|
{ ModuleInfo1 = ModuleInfo0 }
|
|
;
|
|
lookup_option(very_verbose, bool(VeryVerbose)),
|
|
( { VeryVerbose = yes } ->
|
|
io__write_string("% Mode-checking predicate "),
|
|
write_pred_id(PredId),
|
|
io__write_string("\n")
|
|
;
|
|
[]
|
|
),
|
|
{ copy_clauses_to_procs(PredInfo0, PredInfo) },
|
|
{ map__set(Preds0, PredId, PredInfo, Preds) },
|
|
{ moduleinfo_set_preds(ModuleInfo0, Preds, ModuleInfo1) }
|
|
),
|
|
/******
|
|
% XXX fix here
|
|
{ predinfo_argmodes(PredInfo1, ModeVarSet, ArgModes) },
|
|
modecheck_clause_list(Clauses0, PredId, ModeVarSet, ArgModes,
|
|
ModuleInfo0, Error0, Clauses, Error1),
|
|
*****/
|
|
{ Error1 = Error0 },
|
|
modecheck_pred_modes_2(PredIds, ModuleInfo1, Error1, ModuleInfo, Error).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred copy_clauses_to_procs(pred_info, pred_info).
|
|
:- mode copy_clauses_to_procs(input, output).
|
|
|
|
copy_clauses_to_procs(PredInfo0, PredInfo) :-
|
|
predinfo_clauses_info(PredInfo0, ClausesInfo),
|
|
predinfo_procedures(PredInfo0, Procs0),
|
|
map__keys(Procs0, ProcIds),
|
|
copy_clauses_to_procs_2(ProcIds, ClausesInfo, Procs0, Procs),
|
|
predinfo_set_procedures(PredInfo0, Procs, PredInfo).
|
|
|
|
:- pred copy_clauses_to_procs_2(list(proc_id)::in, clauses_info::in,
|
|
proc_table::in, proc_table::out).
|
|
|
|
copy_clauses_to_procs_2([], _, Procs, Procs).
|
|
copy_clauses_to_procs_2([ProcId | ProcIds], ClausesInfo, Procs0, Procs) :-
|
|
ClausesInfo = clauses_info(VarSet, VarTypes, HeadVars, Clauses),
|
|
select_matching_clauses(Clauses, ProcId, MatchingClauses),
|
|
get_clause_goals(MatchingClauses, GoalList),
|
|
(GoalList = [SingleGoal] ->
|
|
Goal = SingleGoal
|
|
;
|
|
goalinfo_init(GoalInfo),
|
|
Goal = disj(GoalList) - GoalInfo
|
|
),
|
|
map__lookup(Procs0, ProcId, Proc0),
|
|
Proc0 = procedure(DeclaredDet, _, _, _, ArgModes, _, Context, CallInfo,
|
|
InferredDet),
|
|
Proc = procedure(DeclaredDet, VarSet, VarTypes, HeadVars, ArgModes,
|
|
Goal, Context, CallInfo, InferredDet),
|
|
map__set(Procs0, ProcId, Proc, Procs1),
|
|
copy_clauses_to_procs_2(ProcIds, ClausesInfo, Procs1, Procs).
|
|
|
|
:- pred select_matching_clauses(list(clause), proc_id, list(clause)).
|
|
:- mode select_matching_clauses(input, input, output).
|
|
|
|
select_matching_clauses([], _, []).
|
|
select_matching_clauses([Clause | Clauses], ProcId, MatchingClauses) :-
|
|
Clause = clause(ProcIds, _, _),
|
|
( member(ProcId, ProcIds) ->
|
|
MatchingClauses = [Clause | MatchingClauses1]
|
|
;
|
|
MatchingClauses = MatchingClauses1
|
|
),
|
|
select_matching_clauses(Clauses, ProcId, MatchingClauses1).
|
|
|
|
:- pred get_clause_goals(list(clause)::in, list(hlds__goal)::out) is det.
|
|
|
|
get_clause_goals([], []).
|
|
get_clause_goals([Clause | Clauses], [Goal | Goals]) :-
|
|
Clause = clause(_, Goal, _),
|
|
get_clause_goals(Clauses, Goals).
|
|
|
|
|
|
/*********************** ALL THIS IS COMMENTED OUT!
|
|
|
|
% Iterate over the list of clauses for a predicate.
|
|
%
|
|
|
|
:- pred modecheck_clause_list(list(clause), pred_id, tvarset, list(mode),
|
|
module_info, bool, list(clause), bool, io__state, io__state).
|
|
:- mode modecheck_clause_list(input, input, input, input, input, input,
|
|
output, output, di, uo).
|
|
|
|
modecheck_clause_list([], _PredId, _ModeVarSet, _ArgModes, _ModuleInfo, Error,
|
|
[], Error)
|
|
--> [].
|
|
modecheck_clause_list([Clause0|Clauses0], PredId, ModeVarSet, ArgModes,
|
|
ModuleInfo, Error0, [Clause|Clauses], Error) -->
|
|
modecheck_clause(Clause0, PredId, ModeVarSet, ArgModes,
|
|
ModuleInfo, Error0, Clause, Error1),
|
|
modecheck_clause_list(Clauses0, PredId, ModeVarSet, ArgModes,
|
|
ModuleInfo, Error1, Clauses, Error).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Mode-check a single clause.
|
|
|
|
% As we go through a clause, we determine the possible
|
|
% mode assignments for the clause. A mode assignment
|
|
% is an assignment of a mode to each variable in the
|
|
% clause.
|
|
%
|
|
% Note that this may cause exponential time & space usage
|
|
% in the presence of overloading of predicates and/or
|
|
% functors. This is a potentially serious problem, but
|
|
% there's no easy solution apparent.
|
|
%
|
|
% It would be more natural to use non-determinism to write
|
|
% this code, and perhaps even more efficient.
|
|
% But doing it deterministically would make bootstrapping more
|
|
% difficult, and most importantly would make good error
|
|
% messages very difficult.
|
|
|
|
% XXX we should do manual garbage collection here
|
|
|
|
:- pred modecheck_clause(clause, pred_id, tvarset, list(mode), module_info,
|
|
bool, clause, bool, io__state, io__state).
|
|
:- mode modecheck_clause(input, input, input, input, input, input,
|
|
output, output, di, uo).
|
|
|
|
modecheck_clause(Clause0, PredId, ModeVarSet, ArgModes, ModuleInfo, Error0,
|
|
Clause, Error, IOState0, IOState) :-
|
|
|
|
% initialize the modeinfo
|
|
% XXX abstract clause/6
|
|
|
|
Clause0 = clause(Modes, VarSet, _DummyVarModes, HeadVars, Body,
|
|
Context),
|
|
modeinfo_init(IOState0, ModuleInfo, PredId, Context, ModeVarSet,
|
|
VarSet, ModeInfo0),
|
|
|
|
% modecheck the clause - first the head unification, and
|
|
% then the body
|
|
|
|
modecheck_var_has_mode_list(HeadVars, ArgModes, ModeInfo0, ModeInfo1),
|
|
modecheck_goal(Body, ModeInfo1, ModeInfo),
|
|
|
|
% finish up
|
|
|
|
modeinfo_get_mode_assign_set(ModeInfo, ModeAssignSet),
|
|
modeinfo_get_io_state(ModeInfo, IOState1),
|
|
modecheck_finish_up(ModeAssignSet, ModeInfo, Error0, VarModes, Error,
|
|
IOState1, IOState),
|
|
Clause = clause(Modes, VarSet, VarModes, HeadVars, Body, Context).
|
|
|
|
% At this stage, there are three possibilities.
|
|
% There are either zero, one, or multiple mode assignments
|
|
% for the clause. In the first case, we have already
|
|
% issued an error message. In the second case, the
|
|
% clause is mode-correct. In the third case, we have to
|
|
% issue an error message here.
|
|
|
|
:- pred modecheck_finish_up(mode_assign_set, mode_info, bool, map(var, mode),
|
|
bool, io__state, io__state).
|
|
:- mode modecheck_finish_up(input, input, input, output, output, di, uo).
|
|
|
|
modecheck_finish_up([], _ModeInfo, _Error, VarModes, yes) -->
|
|
{ map__init(VarModes) }.
|
|
modecheck_finish_up([ModeAssign], _ModeInfo, Error, VarModes, Error) -->
|
|
{ mode_assign_get_var_modes(ModeAssign, VarModes) }.
|
|
modecheck_finish_up([ModeAssign1, ModeAssign2 | _], ModeInfo, _Error,
|
|
VarModes1, yes) -->
|
|
{ mode_assign_get_var_modes(ModeAssign1, VarModes1) },
|
|
report_ambiguity_error(ModeInfo, ModeAssign1, ModeAssign2).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred modecheck_goal(hlds__goal, mode_info, mode_info).
|
|
:- mode modecheck_goal(input, modeinfo_di, modeinfo_uo).
|
|
|
|
modecheck_goal(Goal - _GoalInfo, ModeInfo0, ModeInfo) :-
|
|
(modecheck_goal_2(Goal, ModeInfo0, ModeInfo)).
|
|
|
|
:- pred modecheck_goal_2(hlds__goal_expr, mode_info, mode_info).
|
|
:- mode modecheck_goal_2(input, modeinfo_di, modeinfo_uo).
|
|
|
|
modecheck_goal_2(conj(List)) -->
|
|
%%% checkpoint("conj"),
|
|
modecheck_goal_list(List).
|
|
modecheck_goal_2(disj(List)) -->
|
|
%%% checkpoint("disj"),
|
|
modecheck_goal_list(List).
|
|
modecheck_goal_2(if_then_else(_Vs, A, B, C)) -->
|
|
%%% checkpoint("if"),
|
|
modecheck_goal(A),
|
|
%%% checkpoint("then"),
|
|
modecheck_goal(B),
|
|
%%% checkpoint("else"),
|
|
modecheck_goal(C).
|
|
modecheck_goal_2(not(_Vs, A)) -->
|
|
%%% checkpoint("not"),
|
|
modecheck_goal(A).
|
|
modecheck_goal_2(some(_Vs, G)) -->
|
|
%%% checkpoint("some"),
|
|
modecheck_goal(G).
|
|
modecheck_goal_2(all(_Vs, G)) -->
|
|
%%% checkpoint("all"),
|
|
modecheck_goal(G).
|
|
modecheck_goal_2(call(PredId, _Mode, Args, _Builtin)) -->
|
|
%%% checkpoint("call"),
|
|
modecheck_call_pred(PredId, Args).
|
|
modecheck_goal_2(unify(A, B, _Mode, _Info)) -->
|
|
%%% checkpoint("unify"),
|
|
modecheck_unification(A, B).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred modecheck_goal_list(list(hlds__goal), mode_info, mode_info).
|
|
:- mode modecheck_goal_list(input, modeinfo_di, modeinfo_uo).
|
|
|
|
modecheck_goal_list([]) --> [].
|
|
modecheck_goal_list([Goal | Goals]) -->
|
|
modecheck_goal(Goal),
|
|
modecheck_goal_list(Goals).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred modecheck_call_pred(pred_id, list(term), mode_info, mode_info).
|
|
:- mode modecheck_call_pred(input, input, modeinfo_di, modeinfo_uo).
|
|
|
|
% XXX we should handle overloading of predicates
|
|
|
|
modecheck_call_pred(PredId, Args, ModeInfo0, ModeInfo) :-
|
|
% look up the called predicate's arg modes
|
|
modeinfo_get_preds(ModeInfo0, Preds),
|
|
( % if some [PredInfo]
|
|
map__search(Preds, PredId, PredInfo)
|
|
->
|
|
predinfo_arg_modes(PredInfo, PredModeVarSet, PredArgModes0),
|
|
|
|
% rename apart the mode variables in called
|
|
% predicate's arg modes
|
|
% (optimize for the common case of
|
|
% a non-polymorphic predicate)
|
|
( varset__is_empty(PredModeVarSet) ->
|
|
PredArgModes = PredArgModes0,
|
|
ModeInfo1 = ModeInfo0
|
|
;
|
|
rename_apart(ModeInfo0, PredModeVarSet, PredArgModes0,
|
|
ModeInfo1, PredArgModes)
|
|
),
|
|
% unify the modes of the call arguments with the
|
|
% called predicates' arg modes
|
|
modecheck_term_has_mode_list(Args, PredArgModes, ModeInfo1,
|
|
ModeInfo)
|
|
;
|
|
modeinfo_get_io_state(ModeInfo0, IOState0),
|
|
modeinfo_get_predid(ModeInfo0, CallingPredId),
|
|
modeinfo_get_context(ModeInfo0, Context),
|
|
report_error_undef_pred(CallingPredId, Context, PredId,
|
|
IOState0, IOState),
|
|
modeinfo_set_io_state(ModeInfo0, IOState, ModeInfoB1),
|
|
modeinfo_set_found_error(ModeInfoB1, yes, ModeInfoB2),
|
|
modeinfo_set_mode_assign_set(ModeInfoB2, [], ModeInfo)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Rename apart the mode variables in called predicate's arg modes.
|
|
%
|
|
% Each mode_assign has it's own set of mode variables, but these
|
|
% are supposed to stay in synch with each other. We need to
|
|
% iterate over the set of mode_assigns, but we check that
|
|
% the resulting renamed apart list of predicate arg modes
|
|
% is the same for each mode_assign (i.e. that the tvarsets
|
|
% were indeed in synch).
|
|
|
|
:- pred rename_apart(mode_info, tvarset, list(mode), mode_info, list(mode)).
|
|
:- mode rename_apart(modeinfo_di, input, input, modeinfo_uo, output).
|
|
|
|
rename_apart(ModeInfo0, PredModeVarSet, PredArgModes0, ModeInfo, PredArgModes)
|
|
:-
|
|
modeinfo_get_mode_assign_set(ModeInfo0, ModeAssignSet0),
|
|
( ModeAssignSet0 = [ModeAssign0 | ModeAssigns0] ->
|
|
% process the first mode_assign and get
|
|
% the resulting PredArgModes
|
|
mode_assign_rename_apart(ModeAssign0, PredModeVarSet,
|
|
PredArgModes0, ModeAssign, PredArgModes),
|
|
% process the remaining mode_assigns and check
|
|
% that they produce matching PredArgModes
|
|
rename_apart_2(ModeAssigns0, PredModeVarSet, PredArgModes0,
|
|
ModeAssigns, PredArgModes),
|
|
ModeAssignSet = [ModeAssign | ModeAssigns],
|
|
modeinfo_set_mode_assign_set(ModeInfo0, ModeAssignSet, ModeInfo)
|
|
;
|
|
ModeInfo = ModeInfo0
|
|
).
|
|
|
|
:- pred rename_apart_2(mode_assign_set, tvarset, list(mode),
|
|
mode_assign_set, list(mode)).
|
|
:- mode rename_apart_2(input, input, input, output, input).
|
|
|
|
rename_apart_2([], _, _, [], _).
|
|
rename_apart_2([ModeAssign0 | ModeAssigns0], PredModeVarSet, PredArgModes0,
|
|
[ModeAssign | ModeAssigns], PredArgModes) :-
|
|
mode_assign_rename_apart(ModeAssign0, PredModeVarSet, PredArgModes0,
|
|
ModeAssign, NewPredArgModes),
|
|
(PredArgModes = NewPredArgModes ->
|
|
true
|
|
;
|
|
error("problem synchronizing mode vars")
|
|
),
|
|
rename_apart_2(ModeAssigns0, PredModeVarSet, PredArgModes0,
|
|
ModeAssigns, PredArgModes).
|
|
|
|
:- pred mode_assign_rename_apart(mode_assign, tvarset, list(mode),
|
|
mode_assign, list(mode)).
|
|
:- mode mode_assign_rename_apart(input, input, input, output, output).
|
|
|
|
mode_assign_rename_apart(ModeAssign0, PredModeVarSet, PredArgModes0,
|
|
ModeAssign, PredArgModes) :-
|
|
mode_assign_get_modevarset(ModeAssign0, ModeVarSet0),
|
|
varset__merge(ModeVarSet0, PredModeVarSet, PredArgModes0,
|
|
ModeVarSet, PredArgModes),
|
|
mode_assign_set_modevarset(ModeAssign0, ModeVarSet, ModeAssign).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Given a list of variables and a list of modes, ensure
|
|
% that each variable has the corresponding mode.
|
|
|
|
:- pred modecheck_var_has_mode_list(list(var), list(mode), mode_info,
|
|
mode_info).
|
|
:- mode modecheck_var_has_mode_list(input, input, input, output).
|
|
|
|
modecheck_var_has_mode_list([], []) --> [].
|
|
modecheck_var_has_mode_list([Var|Vars], [Mode|Modes]) -->
|
|
modecheck_var_has_mode(Var, Mode),
|
|
modecheck_var_has_mode_list(Vars, Modes).
|
|
|
|
:- pred modecheck_var_has_mode(var, mode, mode_info, mode_info).
|
|
:- mode modecheck_var_has_mode(input, input, modeinfo_di, modeinfo_uo).
|
|
|
|
modecheck_var_has_mode(VarId, Mode, ModeInfo0, ModeInfo) :-
|
|
modeinfo_get_mode_assign_set(ModeInfo0, ModeAssignSet0),
|
|
modeinfo_get_varset(ModeInfo0, VarSet),
|
|
modecheck_var_has_mode_2(ModeAssignSet0, VarId, Mode, [],
|
|
ModeAssignSet),
|
|
(
|
|
ModeAssignSet = [],
|
|
(not ModeAssignSet0 = [])
|
|
->
|
|
modeinfo_get_io_state(ModeInfo0, IOState0),
|
|
modeinfo_get_context(ModeInfo0, Context),
|
|
modeinfo_get_predid(ModeInfo0, PredId),
|
|
get_mode_stuff(ModeAssignSet0, VarId, ModeStuffList),
|
|
report_error_var(PredId, Context, VarSet, VarId, ModeStuffList,
|
|
Mode, ModeAssignSet0, IOState0, IOState),
|
|
modeinfo_set_io_state(ModeInfo0, IOState, ModeInfo1),
|
|
modeinfo_set_found_error(ModeInfo1, yes, ModeInfo2),
|
|
modeinfo_set_mode_assign_set(ModeInfo2, ModeAssignSet, ModeInfo)
|
|
;
|
|
modeinfo_set_mode_assign_set(ModeInfo0, ModeAssignSet, ModeInfo)
|
|
).
|
|
|
|
% Given a mode assignment set and a variable id,
|
|
% return the list of possible different modes for the variable.
|
|
|
|
:- mode mode_stuff ---> mode_stuff(mode, tvarset, tsubst).
|
|
|
|
:- pred get_mode_stuff(mode_assign_set, var, list(mode_stuff)).
|
|
:- mode get_mode_stuff(input, input, output).
|
|
get_mode_stuff([], _VarId, []).
|
|
get_mode_stuff([ModeAssign | ModeAssigns], VarId, L) :-
|
|
get_mode_stuff(ModeAssigns, VarId, L0),
|
|
mode_assign_get_mode_bindings(ModeAssign, ModeBindings),
|
|
mode_assign_get_modevarset(ModeAssign, TVarSet),
|
|
mode_assign_get_var_modes(ModeAssign, VarModes),
|
|
( %%% if some [Mode0]
|
|
map__search(VarModes, VarId, Mode0)
|
|
->
|
|
Mode = Mode0
|
|
;
|
|
% this shouldn't happen - how can a variable which has
|
|
% not yet been assigned a mode variable fail to have
|
|
% the correct mode?
|
|
error("problem in mode unification")
|
|
),
|
|
ModeStuff = mode_stuff(Mode, TVarSet, ModeBindings),
|
|
(
|
|
member_chk(ModeStuff, L0)
|
|
->
|
|
L = L0
|
|
;
|
|
L = [ModeStuff | L0]
|
|
).
|
|
|
|
:- pred modecheck_var_has_mode_2(mode_assign_set, var, mode,
|
|
mode_assign_set, mode_assign_set).
|
|
:- mode modecheck_var_has_mode_2(input, input, input, input, output).
|
|
|
|
modecheck_var_has_mode_2([], _, _) --> [].
|
|
modecheck_var_has_mode_2([ModeAssign0 | ModeAssignSet0], VarId, Mode) -->
|
|
mode_assign_var_has_mode(ModeAssign0, VarId, Mode),
|
|
modecheck_var_has_mode_2(ModeAssignSet0, VarId, Mode).
|
|
|
|
:- pred mode_assign_var_has_mode(mode_assign, var, mode,
|
|
mode_assign_set, mode_assign_set).
|
|
:- mode mode_assign_var_has_mode(input, input, input, input, output).
|
|
|
|
mode_assign_var_has_mode(ModeAssign0, VarId, Mode,
|
|
ModeAssignSet0, ModeAssignSet) :-
|
|
mode_assign_get_var_modes(ModeAssign0, VarModes0),
|
|
( %%% if some [VarMode]
|
|
map__search(VarModes0, VarId, VarMode)
|
|
->
|
|
( %%% if some [ModeAssign1]
|
|
mode_assign_unify_mode(ModeAssign0, VarMode, Mode,
|
|
ModeAssign1)
|
|
->
|
|
ModeAssignSet = [ModeAssign1 | ModeAssignSet0]
|
|
;
|
|
ModeAssignSet = ModeAssignSet0
|
|
)
|
|
;
|
|
map__set(VarModes0, VarId, Mode, VarModes),
|
|
mode_assign_set_var_modes(ModeAssign0, VarModes, ModeAssign),
|
|
ModeAssignSet = [ModeAssign | ModeAssignSet0]
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred modecheck_term_has_mode_list(list(term), list(mode),
|
|
mode_info, mode_info).
|
|
:- mode modecheck_term_has_mode_list(input, input, modeinfo_di, modeinfo_uo).
|
|
|
|
modecheck_term_has_mode_list([], []) --> [].
|
|
modecheck_term_has_mode_list([Arg | Args], [Mode | Modes]) -->
|
|
modecheck_term_has_mode(Arg, Mode),
|
|
modecheck_term_has_mode_list(Args, Modes).
|
|
|
|
:- pred modecheck_term_has_mode(term, mode, mode_info, mode_info).
|
|
:- mode modecheck_term_has_mode(input, input, modeinfo_di, modeinfo_uo).
|
|
|
|
modecheck_term_has_mode(term_variable(Var), Mode, ModeInfo0, ModeInfo) :-
|
|
modecheck_var_has_mode(Var, Mode, ModeInfo0, ModeInfo).
|
|
|
|
modecheck_term_has_mode(term_functor(F, As, C), Mode, ModeInfo0, ModeInfo) :-
|
|
length(As, Arity),
|
|
modeinfo_get_ctor_list(ModeInfo0, F, Arity, ConsDefnList),
|
|
(ConsDefnList = [] ->
|
|
modeinfo_get_io_state(ModeInfo0, IOState0),
|
|
modeinfo_get_predid(ModeInfo0, PredId),
|
|
report_error_undef_cons(PredId, C, F, Arity, IOState0, IOState),
|
|
modeinfo_set_io_state(ModeInfo0, IOState, ModeInfo1),
|
|
modeinfo_set_found_error(ModeInfo1, yes, ModeInfo2),
|
|
modeinfo_set_mode_assign_set(ModeInfo2, [], ModeInfo)
|
|
;
|
|
modeinfo_get_mode_assign_set(ModeInfo0, ModeAssignSet0),
|
|
modecheck_cons_has_mode(ModeAssignSet0, ConsDefnList, As, Mode,
|
|
ModeInfo0, [], ModeAssignSet),
|
|
(
|
|
ModeAssignSet = [],
|
|
(\+ ModeAssignSet0 = [])
|
|
->
|
|
modeinfo_get_io_state(ModeInfo0, IOState0),
|
|
modeinfo_get_predid(ModeInfo0, PredId),
|
|
modeinfo_get_varset(ModeInfo0, VarSet),
|
|
report_error_cons(PredId, C, VarSet, F, As, Mode,
|
|
ModeAssignSet, IOState0, IOState),
|
|
modeinfo_set_io_state(ModeInfo0, IOState, ModeInfo1),
|
|
modeinfo_set_found_error(ModeInfo1, yes, ModeInfo2),
|
|
modeinfo_set_mode_assign_set(ModeInfo2, ModeAssignSet, ModeInfo)
|
|
;
|
|
modeinfo_set_mode_assign_set(ModeInfo0, ModeAssignSet, ModeInfo)
|
|
)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Check that a constructor has the specified mode
|
|
% and that the arguments of the constructor have the appropriate
|
|
% modes for that constructor.
|
|
% We do this by iterating over all the possible current
|
|
% mode assignments.
|
|
% For each possible current mode assignment, we produce a
|
|
% list of the possible resulting mode assignments after
|
|
% we have unified the mode of this constructor with
|
|
% the specified mode.
|
|
|
|
:- pred modecheck_cons_has_mode(mode_assign_set, list(hlds__cons_defn),
|
|
list(term), mode, mode_info, mode_assign_set, mode_assign_set).
|
|
:- mode modecheck_cons_has_mode(input, input, input, input,
|
|
modeinfo_ui, input, output).
|
|
|
|
modecheck_cons_has_mode([], _, _, _, _) --> [].
|
|
modecheck_cons_has_mode([ModeAssign|ModeAssigns], ConsDefnList, Args, Mode,
|
|
ModeInfo) -->
|
|
mode_assign_cons_has_mode(ConsDefnList, ModeAssign, Args, Mode,
|
|
ModeInfo),
|
|
modecheck_cons_has_mode(ModeAssigns, ConsDefnList, Args, Mode,
|
|
ModeInfo).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% For each possible constructor which matches the
|
|
% term (overloading means that there may be more than one),
|
|
% if this constructor matches the specified mode and
|
|
% the modes of it's arguments are ok, then add the resulting
|
|
% mode assignment to the mode assignment set.
|
|
|
|
:- pred mode_assign_cons_has_mode(list(hlds__cons_defn), mode_assign,
|
|
list(term), mode, mode_info, mode_assign_set, mode_assign_set).
|
|
:- mode mode_assign_cons_has_mode(input, input, input, input,
|
|
modeinfo_ui, input, output).
|
|
|
|
mode_assign_cons_has_mode([], _ModeAssign0, _Args, _Mode, _ModeInfo) -->
|
|
[].
|
|
mode_assign_cons_has_mode([ConsDefn | ConsDefns], ModeAssign0, Args, Mode,
|
|
ModeInfo) -->
|
|
mode_assign_cons_has_mode_2(ConsDefn, ModeAssign0, Args, Mode,
|
|
ModeInfo),
|
|
mode_assign_cons_has_mode(ConsDefns, ModeAssign0, Args, Mode, ModeInfo).
|
|
|
|
:- pred mode_assign_cons_has_mode_2(hlds__cons_defn, mode_assign, list(term),
|
|
mode, mode_info, mode_assign_set, mode_assign_set).
|
|
:- mode mode_assign_cons_has_mode_2(input, input, input, input,
|
|
modeinfo_ui, input, output).
|
|
|
|
mode_assign_cons_has_mode_2(ConsDefn, ModeAssign0, Args, Mode, ModeInfo,
|
|
ModeAssignSet0, ModeAssignSet) :-
|
|
|
|
get_cons_stuff(ConsDefn, ModeAssign0, ModeInfo,
|
|
ConsMode, ArgModes, ModeAssign1),
|
|
|
|
( mode_assign_unify_mode(ModeAssign1, ConsMode, Mode, ModeAssign2) ->
|
|
% check the modes of the arguments
|
|
mode_assign_term_has_mode_list(Args, ArgModes, ModeAssign2,
|
|
ModeInfo, ModeAssignSet0, ModeAssignSet)
|
|
;
|
|
ModeAssignSet = ModeAssignSet0
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% mode_assign_term_has_mode_list(Terms, Modes, ModeAssign, ModeInfo,
|
|
% ModeAssignSet0, ModeAssignSet):
|
|
% Let TAs = { TA | TA is a an extension of ModeAssign
|
|
% for which the modes of the Terms unify with
|
|
% their respective Modes },
|
|
% append(TAs, ModeAssignSet0, ModeAssignSet).
|
|
|
|
:- pred mode_assign_term_has_mode_list(list(term), list(mode), mode_assign,
|
|
mode_info, mode_assign_set, mode_assign_set).
|
|
:- mode mode_assign_term_has_mode_list(input, input, input,
|
|
modeinfo_ui, input, output).
|
|
|
|
mode_assign_term_has_mode_list([], [], ModeAssign, _,
|
|
ModeAssignSet, [ModeAssign|ModeAssignSet]).
|
|
mode_assign_term_has_mode_list([Arg | Args], [Mode | Modes], ModeAssign0,
|
|
ModeInfo, ModeAssignSet0, ModeAssignSet) :-
|
|
mode_assign_term_has_mode(Arg, Mode, ModeAssign0, ModeInfo,
|
|
[], ModeAssignSet1),
|
|
mode_assign_list_term_has_mode_list(ModeAssignSet1,
|
|
Args, Modes, ModeInfo, ModeAssignSet0, ModeAssignSet).
|
|
|
|
% mode_assign_list_term_has_mode_list(TAs, Terms, Modes,
|
|
% ModeInfo, ModeAssignSet0, ModeAssignSet):
|
|
% Let TAs2 = { TA | TA is a an extension of a member of TAs
|
|
% for which the modes of the Terms unify with
|
|
% their respective Modes },
|
|
% append(TAs, ModeAssignSet0, ModeAssignSet).
|
|
|
|
:- pred mode_assign_list_term_has_mode_list(mode_assign_set, list(term),
|
|
list(mode), mode_info, mode_assign_set, mode_assign_set).
|
|
:- mode mode_assign_list_term_has_mode_list(input, input, input,
|
|
modeinfo_ui, input, output).
|
|
|
|
mode_assign_list_term_has_mode_list([], _, _, _) --> [].
|
|
mode_assign_list_term_has_mode_list([TA | TAs], Args, Modes, ModeInfo) -->
|
|
mode_assign_term_has_mode_list(Args, Modes, TA, ModeInfo),
|
|
mode_assign_list_term_has_mode_list(TAs, Args, Modes, ModeInfo).
|
|
|
|
:- pred mode_assign_term_has_mode(term, mode, mode_assign,
|
|
mode_info, mode_assign_set, mode_assign_set).
|
|
:- mode mode_assign_term_has_mode(input, input, input,
|
|
modeinfo_ui, input, output).
|
|
|
|
mode_assign_term_has_mode(term_variable(V), Mode, ModeAssign, _ModeInfo) -->
|
|
mode_assign_var_has_mode(ModeAssign, V, Mode).
|
|
mode_assign_term_has_mode(term_functor(F, Args, _Context), Mode, ModeAssign,
|
|
ModeInfo) -->
|
|
{ length(Args, Arity) },
|
|
{ modeinfo_get_ctor_list(ModeInfo, F, Arity, ConsDefnList) },
|
|
mode_assign_cons_has_mode(ConsDefnList, ModeAssign, Args, Mode,
|
|
ModeInfo).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% used for debugging
|
|
|
|
:- pred checkpoint(string, mode_info, mode_info).
|
|
:- mode checkpoint(input, modeinfo_di, modeinfo_uo).
|
|
|
|
%%% checkpoint(_, T, T).
|
|
checkpoint(Msg, T0, T) :-
|
|
modeinfo_get_io_state(T0, I0),
|
|
checkpoint_2(Msg, T0, I0, I),
|
|
modeinfo_set_io_state(T0, I, T).
|
|
|
|
:- pred checkpoint_2(string, mode_info, io__state, io__state).
|
|
:- mode checkpoint_2(input, modeinfo_ui, di, uo).
|
|
|
|
checkpoint_2(Msg, T0) -->
|
|
io__write_string("At "),
|
|
io__write_string(Msg),
|
|
io__write_string(": "),
|
|
%%% { report_stats },
|
|
io__write_string("\n"),
|
|
{ modeinfo_get_mode_assign_set(T0, ModeAssignSet) },
|
|
{ modeinfo_get_varset(T0, VarSet) },
|
|
write_mode_assign_set(ModeAssignSet, VarSet).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Mode check a unification.
|
|
% Get the mode assignment set from the mode info and then just
|
|
% iterate over all the possible mode assignments.
|
|
|
|
:- pred modecheck_unification(term, term, mode_info, mode_info).
|
|
:- mode modecheck_unification(input, input, modeinfo_di, modeinfo_uo).
|
|
|
|
modecheck_unification(X, Y, ModeInfo0, ModeInfo) :-
|
|
modeinfo_get_mode_assign_set(ModeInfo0, ModeAssignSet0),
|
|
modecheck_unification_2(ModeAssignSet0, X, Y, ModeInfo0,
|
|
[], ModeAssignSet),
|
|
% XXX report errors properly!!
|
|
( ModeAssignSet = [], not (ModeAssignSet0 = []) ->
|
|
modeinfo_get_predid(ModeInfo0, PredId),
|
|
modeinfo_get_context(ModeInfo0, Context),
|
|
modeinfo_get_varset(ModeInfo0, VarSet),
|
|
modeinfo_get_io_state(ModeInfo0, IOState0),
|
|
report_error_unif(PredId, Context, VarSet, X, Y,
|
|
ModeAssignSet0, IOState0, IOState1),
|
|
modeinfo_set_io_state(ModeInfo0, IOState1, ModeInfo1),
|
|
modeinfo_set_found_error(ModeInfo1, yes, ModeInfo2)
|
|
;
|
|
ModeInfo2 = ModeInfo0
|
|
),
|
|
modeinfo_set_mode_assign_set(ModeInfo2, ModeAssignSet, ModeInfo).
|
|
|
|
|
|
% iterate over all the possible mode assignments.
|
|
|
|
:- pred modecheck_unification_2(mode_assign_set, term, term,
|
|
mode_info, mode_assign_set, mode_assign_set).
|
|
:- mode modecheck_unification_2(input, input, input,
|
|
modeinfo_ui, input, output).
|
|
|
|
modecheck_unification_2([], _, _, _) --> [].
|
|
modecheck_unification_2([ModeAssign0 | ModeAssigns0], X, Y, ModeInfo) -->
|
|
mode_assign_unify_term(X, Y, ModeAssign0, ModeInfo),
|
|
modecheck_unification_2(ModeAssigns0, X, Y, ModeInfo).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Mode-check the unification of two terms,
|
|
% and update the mode assignment.
|
|
% ModeAssign0 is the mode assignment we are updating,
|
|
% ModeAssignSet0 is an accumulator for the list of possible
|
|
% mode assignments so far, and ModeAssignSet is ModeAssignSet plus
|
|
% any mode assignment(s) resulting from ModeAssign0 and this
|
|
% unification.
|
|
|
|
:- pred mode_assign_unify_term(term, term, mode_assign, mode_info,
|
|
mode_assign_set, mode_assign_set).
|
|
:- mode mode_assign_unify_term(input, input, input, modeinfo_ui, input, output).
|
|
|
|
% NU-Prolog indexing
|
|
:- mode_assign_unify_term(T1, T2, _, _, _, _) when T1 and T2.
|
|
|
|
mode_assign_unify_term(term_variable(X), term_variable(Y), ModeAssign0,
|
|
_ModeInfo, ModeAssignSet0, ModeAssignSet) :-
|
|
mode_assign_get_var_modes(ModeAssign0, VarModes0),
|
|
( %%% if some [ModeX]
|
|
map__search(VarModes0, X, ModeX)
|
|
->
|
|
( %%% if some [ModeY]
|
|
map__search(VarModes0, Y, ModeY)
|
|
->
|
|
% both X and Y already have modes - just
|
|
% unify their modes
|
|
( %%% if some [ModeAssign3]
|
|
mode_assign_unify_mode(ModeAssign0, ModeX,
|
|
ModeY, ModeAssign3)
|
|
->
|
|
ModeAssignSet = [ModeAssign3 | ModeAssignSet0]
|
|
;
|
|
ModeAssignSet = ModeAssignSet0
|
|
)
|
|
;
|
|
% Y is a fresh variable which hasn't been
|
|
% assigned a mode yet
|
|
map__set(VarModes0, Y, ModeX, VarModes),
|
|
mode_assign_set_var_modes(ModeAssign0, VarModes,
|
|
ModeAssign),
|
|
ModeAssignSet = [ModeAssign | ModeAssignSet0]
|
|
)
|
|
;
|
|
( %%% if some [ModeY2]
|
|
map__search(VarModes0, Y, ModeY2)
|
|
->
|
|
% X is a fresh variable which hasn't been
|
|
% assigned a mode yet
|
|
map__set(VarModes0, X, ModeY2, VarModes),
|
|
mode_assign_set_var_modes(ModeAssign0, VarModes,
|
|
ModeAssign),
|
|
ModeAssignSet = [ModeAssign | ModeAssignSet0]
|
|
;
|
|
% both X and Y are fresh variables -
|
|
% introduce a fresh mode variable to represent
|
|
% their mode
|
|
mode_assign_get_modevarset(ModeAssign0, ModeVarSet0),
|
|
varset__new_var(ModeVarSet0, ModeVar, ModeVarSet),
|
|
mode_assign_set_modevarset(ModeAssign0, ModeVarSet,
|
|
ModeAssign1),
|
|
Mode = term_variable(ModeVar),
|
|
map__set(VarModes0, X, Mode, VarModes1),
|
|
map__set(VarModes1, Y, Mode, VarModes),
|
|
mode_assign_set_var_modes(ModeAssign1, VarModes,
|
|
ModeAssign),
|
|
ModeAssignSet = [ModeAssign | ModeAssignSet0]
|
|
)
|
|
).
|
|
|
|
mode_assign_unify_term(term_functor(Functor, Args, _), term_variable(Y),
|
|
ModeAssign0, ModeInfo, ModeAssignSet0, ModeAssignSet) :-
|
|
length(Args, Arity),
|
|
modeinfo_get_ctor_list(ModeInfo, Functor, Arity, ConsDefnList),
|
|
mode_assign_unify_var_functor(ConsDefnList, Args, Y, ModeAssign0,
|
|
ModeInfo, ModeAssignSet0, ModeAssignSet).
|
|
|
|
mode_assign_unify_term(term_variable(Y), term_functor(F, As, _), ModeAssign0,
|
|
ModeInfo, ModeAssignSet0, ModeAssignSet) :-
|
|
mode_assign_unify_term(term_functor(F, As, _), term_variable(Y),
|
|
ModeAssign0, ModeInfo, ModeAssignSet0, ModeAssignSet).
|
|
|
|
mode_assign_unify_term(term_functor(FX, AsX, _), term_functor(FY, AsY, _),
|
|
ModeAssign0, ModeInfo, ModeAssignSet0, ModeAssignSet) :-
|
|
% XXX we should handle this properly
|
|
error("XXX not implemented: unification of term with term\n"),
|
|
ModeAssignSet = ModeAssignSet0.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Mode-check the unification of a variable with a functor:
|
|
% for each possible mode of the constructor,
|
|
% unify the mode of the variable with the mode of
|
|
% the constructor and if this succeeds insert that
|
|
% mode assignment into the mode assignment set.
|
|
|
|
:- pred mode_assign_unify_var_functor(list(hlds__cons_defn), list(term),
|
|
var, mode_assign,
|
|
mode_info, mode_assign_set, mode_assign_set).
|
|
:- mode mode_assign_unify_var_functor(input, input, input, input,
|
|
modeinfo_ui, input, output).
|
|
|
|
mode_assign_unify_var_functor([], _, _, _, _, ModeAssignSet, ModeAssignSet).
|
|
mode_assign_unify_var_functor([ConsDefn | ConsDefns], Args, Y, ModeAssign0,
|
|
ModeInfo, ModeAssignSet0, ModeAssignSet) :-
|
|
|
|
get_cons_stuff(ConsDefn, ModeAssign0, ModeInfo,
|
|
ConsMode, ArgModes, ModeAssign1),
|
|
|
|
% unify the mode of Var with the mode of the constructor
|
|
mode_assign_get_var_modes(ModeAssign1, VarModes0),
|
|
( %%% if some [ModeY]
|
|
map__search(VarModes0, Y, ModeY)
|
|
->
|
|
( %%% if some [ModeAssign2]
|
|
mode_assign_unify_mode(ModeAssign1, ConsMode, ModeY,
|
|
ModeAssign2)
|
|
->
|
|
% check that the modes of the arguments matches the
|
|
% specified arg modes for this constructor
|
|
mode_assign_term_has_mode_list(Args, ArgModes,
|
|
ModeAssign2, ModeInfo,
|
|
ModeAssignSet0, ModeAssignSet1)
|
|
;
|
|
% the top-level modes didn't unify - no need to
|
|
% check the modes of the arguments, since this
|
|
% mode-assignment has already been rules out
|
|
ModeAssignSet1 = ModeAssignSet0
|
|
)
|
|
;
|
|
map__set(VarModes0, Y, ConsMode, VarModes),
|
|
mode_assign_set_var_modes(ModeAssign1, VarModes, ModeAssign3),
|
|
|
|
% check that the modes of the arguments matches the
|
|
% specified arg modes for this constructor
|
|
mode_assign_term_has_mode_list(Args, ArgModes, ModeAssign3,
|
|
ModeInfo, ModeAssignSet0, ModeAssignSet1)
|
|
),
|
|
|
|
% recursively handle all the other possible constructors
|
|
% that match this functor.
|
|
mode_assign_unify_var_functor(ConsDefns, Args, Y, ModeAssign0,
|
|
ModeInfo, ModeAssignSet1, ModeAssignSet).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Given an hlds__cons_defn, construct a mode for the
|
|
% constructor and a list of modes of the arguments.
|
|
% First we construct the mode and the arg modes using
|
|
% the information in the hlds__cons_defn and the information
|
|
% in the hlds mode table entry for the cons' mode.
|
|
% Then we rename these apart from the current mode_assign's
|
|
% modevarset.
|
|
%
|
|
% XXX abstract the use of hlds__cons_defn/3 and hlds__mode_defn/5
|
|
|
|
:- pred get_cons_stuff(hlds__cons_defn, mode_assign, mode_info,
|
|
mode, list(mode), mode_assign).
|
|
:- mode get_cons_stuff(input, input, input, output, output, output).
|
|
|
|
get_cons_stuff(ConsDefn, ModeAssign0, ModeInfo, ConsMode, ArgModes,
|
|
ModeAssign) :-
|
|
|
|
ConsDefn = hlds__cons_defn(ArgModes0, ModeId, Context),
|
|
|
|
( is_builtin_mode(ModeId) ->
|
|
% XXX assumes arity = 0
|
|
varset__init(ConsModeVarSet),
|
|
ConsModeParams = []
|
|
;
|
|
modeinfo_get_modes(ModeInfo, Modes),
|
|
map__search(Modes, ModeId, ModeDefn),
|
|
ModeDefn = hlds__mode_defn(ConsModeVarSet, ConsModeParams,
|
|
_, _, _)
|
|
),
|
|
|
|
ModeId = QualifiedName - _Arity,
|
|
unqualify_name(QualifiedName, Name),
|
|
ConsMode0 = term_functor(term_atom(Name), ConsModeParams, Context),
|
|
|
|
% Rename apart the mode vars in the mode of the constructor
|
|
% and the modes of it's arguments.
|
|
% (Optimize the common case of a non-polymorphic mode)
|
|
(ConsModeParams = [] ->
|
|
ConsMode = ConsMode0,
|
|
ArgModes = ArgModes0,
|
|
ModeAssign = ModeAssign0
|
|
;
|
|
mode_assign_rename_apart(ModeAssign0, ConsModeVarSet,
|
|
[ConsMode0 | ArgModes0],
|
|
ModeAssign, [ConsMode | ArgModes])
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Unify (with occurs check) two modes in a mode assignment
|
|
% and update the mode bindings.
|
|
|
|
:- pred mode_assign_unify_mode(mode_assign, mode, mode, mode_assign).
|
|
:- mode mode_assign_unify_mode(input, input, input, output).
|
|
|
|
mode_assign_unify_mode(ModeAssign0, X, Y, ModeAssign) :-
|
|
mode_assign_get_mode_bindings(ModeAssign0, ModeBindings0),
|
|
mode_unify(X, Y, ModeBindings0, ModeBindings),
|
|
mode_assign_set_mode_bindings(ModeAssign0, ModeBindings, ModeAssign).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Unify (with occurs check) two modes with respect to a mode
|
|
% substitution and update the mode bindings.
|
|
% (Modes are represented as terms, but we can't just use term__unify
|
|
% because we need to handle equivalent modes).
|
|
|
|
:- mode_unify(X, Y, _, _) when X and Y. % NU-Prolog indexing
|
|
|
|
:- pred mode_unify(mode, mode, substitution, substitution).
|
|
:- mode mode_unify(input, input, input, output).
|
|
|
|
mode_unify(term_variable(X), term_variable(Y), Bindings0, Bindings) :-
|
|
( %%% if some [BindingOfX]
|
|
map__search(Bindings0, X, BindingOfX)
|
|
->
|
|
( %%% if some [BindingOfY]
|
|
map__search(Bindings0, Y, BindingOfY)
|
|
->
|
|
% both X and Y already have bindings - just
|
|
% unify the modes they are bound to
|
|
mode_unify(BindingOfX, BindingOfY, Bindings0, Bindings)
|
|
;
|
|
term__apply_rec_substitution(BindingOfX,
|
|
Bindings0, SubstBindingOfX),
|
|
% Y is a mode variable which hasn't been bound yet
|
|
( SubstBindingOfX = term_variable(Y) ->
|
|
Bindings = Bindings0
|
|
;
|
|
\+ term__occurs(SubstBindingOfX, Y, Bindings0),
|
|
map__set(Bindings0, Y, SubstBindingOfX,
|
|
Bindings)
|
|
)
|
|
)
|
|
;
|
|
( %%% if some [BindingOfY2]
|
|
map__search(Bindings0, Y, BindingOfY2)
|
|
->
|
|
term__apply_rec_substitution(BindingOfY2,
|
|
Bindings0, SubstBindingOfY2),
|
|
% X is a mode variable which hasn't been bound yet
|
|
( SubstBindingOfY2 = term_variable(X) ->
|
|
Bindings = Bindings0
|
|
;
|
|
\+ term__occurs(SubstBindingOfY2, X, Bindings0),
|
|
map__set(Bindings0, X, SubstBindingOfY2,
|
|
Bindings)
|
|
)
|
|
;
|
|
% both X and Y are unbound mode variables -
|
|
% bind one to the other
|
|
( X = Y ->
|
|
Bindings = Bindings0
|
|
;
|
|
map__set(Bindings0, X, term_variable(Y),
|
|
Bindings)
|
|
)
|
|
)
|
|
).
|
|
|
|
mode_unify(term_variable(X), term_functor(F, As, C), Bindings0, Bindings) :-
|
|
( %%% if some [BindingOfX]
|
|
map__search(Bindings0, X, BindingOfX)
|
|
->
|
|
mode_unify(BindingOfX, term_functor(F, As, C), Bindings0,
|
|
Bindings)
|
|
;
|
|
\+ term__occurs_list(As, X, Bindings0),
|
|
map__set(Bindings0, X, term_functor(F, As, C), Bindings)
|
|
).
|
|
|
|
mode_unify(term_functor(F, As, C), term_variable(X), Bindings0, Bindings) :-
|
|
( %%% if some [BindingOfX]
|
|
map__search(Bindings0, X, BindingOfX)
|
|
->
|
|
\+ term__occurs_list(As, X, Bindings0),
|
|
mode_unify(term_functor(F, As, C), BindingOfX, Bindings0,
|
|
Bindings)
|
|
;
|
|
map__set(Bindings0, X, term_functor(F, As, C), Bindings)
|
|
).
|
|
|
|
mode_unify(term_functor(FX, AsX, _), term_functor(FY, AsY, _), Bindings0,
|
|
Bindings) :-
|
|
length(AsX, ArityX),
|
|
length(AsY, ArityY),
|
|
(
|
|
FX = FY,
|
|
ArityX = ArityY
|
|
->
|
|
mode_unify_list(AsX, AsY, Bindings0, Bindings)
|
|
;
|
|
% XXX check if these modes have been defined to be
|
|
% equivalent using equivalence modes
|
|
fail % XXX stub only!!!
|
|
).
|
|
|
|
:- pred mode_unify_list(list(mode), list(mode), substitution, substitution).
|
|
:- mode mode_unify_list(input, input, input, output).
|
|
|
|
mode_unify_list([], []) --> [].
|
|
mode_unify_list([X | Xs], [Y | Ys]) -->
|
|
mode_unify(X, Y),
|
|
mode_unify_list(Xs, Ys).
|
|
|
|
ALL THIS IS COMMENTED OUT! ***********************/
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% XXX - At the moment we don't check for circular modes.
|
|
% (If they aren't used, the compiler will probably not
|
|
% detect the error; if they are, it will probably go into
|
|
% an infinite loop).
|
|
|
|
:- pred check_circular_modes(module_info, module_info, io__state, io__state).
|
|
:- mode check_circular_modes(input, output, di, uo).
|
|
|
|
check_circular_modes(Module0, Module) -->
|
|
{ Module = Module0 }.
|
|
|
|
/**** JUNK
|
|
{ moduleinfo_modes(Module0, Modes0 },
|
|
{ map__keys(Modes0, ModeIds) },
|
|
check_circular_modes_2(ModeIds, Modes0, Modes),
|
|
{ moduleinfo_set_modes(Module0, Modes, Module) }.
|
|
|
|
check_circular_modes_2([], Modes, Modes) --> [].
|
|
check_circular_modes_2([ModeId | ModeIds], Modes0, Modes) -->
|
|
|
|
JUNK ****/
|
|
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Check for any possible undefined insts/modes.
|
|
% XXX should we add a definition for undefined modes?
|
|
|
|
:- pred check_undefined_modes(module_info, module_info, io__state, io__state).
|
|
:- mode check_undefined_modes(input, output, di, uo).
|
|
check_undefined_modes(Module, Module) -->
|
|
{ moduleinfo_insts(Module, InstDefns) },
|
|
{ map__keys(InstDefns, InstIds) },
|
|
find_undef_inst_bodies(InstIds, InstDefns),
|
|
{ moduleinfo_modes(Module, ModeDefns) },
|
|
{ map__keys(ModeDefns, ModeIds) },
|
|
find_undef_mode_bodies(ModeIds, ModeDefns, InstDefns),
|
|
{ moduleinfo_preds(Module, Preds) },
|
|
{ moduleinfo_predids(Module, PredIds) },
|
|
find_undef_pred_modes(PredIds, Preds, ModeDefns, InstDefns).
|
|
|
|
% Find any undefined insts/modes used in predicate mode declarations.
|
|
|
|
:- pred find_undef_pred_modes(list(pred_id), pred_table, mode_table,
|
|
inst_table, io__state, io__state).
|
|
:- mode find_undef_pred_modes(input, input, input, input, di, uo).
|
|
|
|
find_undef_pred_modes([], _Preds, _ModeDefns, _InstDefns) --> [].
|
|
find_undef_pred_modes([PredId | PredIds], Preds, ModeDefns, InstDefns) -->
|
|
{ map__search(Preds, PredId, PredDefn) },
|
|
{ predinfo_procedures(PredDefn, Procs) },
|
|
{ map__keys(Procs, ProcIds) },
|
|
find_undef_proc_modes(ProcIds, PredId, Procs, ModeDefns, InstDefns),
|
|
find_undef_pred_modes(PredIds, Preds, ModeDefns, InstDefns).
|
|
|
|
:- pred find_undef_proc_modes(list(proc_id), pred_id, proc_table, mode_table,
|
|
inst_table, io__state, io__state).
|
|
:- mode find_undef_proc_modes(input, input, input, input, input, di, uo).
|
|
|
|
find_undef_proc_modes([], _PredId, _Procs, _ModeDefns, _InstDefns) --> [].
|
|
find_undef_proc_modes([ProcId | ProcIds], PredId, Procs, ModeDefns,
|
|
InstDefns) -->
|
|
{ map__search(Procs, ProcId, ProcDefn) },
|
|
{ procinfo_argmodes(ProcDefn, ArgModes) },
|
|
{ procinfo_context(ProcDefn, Context) },
|
|
find_undef_mode_list(ArgModes, pred(PredId) - Context, ModeDefns,
|
|
InstDefns),
|
|
find_undef_proc_modes(ProcIds, PredId, Procs, ModeDefns, InstDefns).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Find any undefined insts/modes used in the bodies of other mode
|
|
% declarations.
|
|
|
|
:- pred find_undef_mode_bodies(list(mode_id), mode_table, inst_table,
|
|
io__state, io__state).
|
|
:- mode find_undef_mode_bodies(input, input, input, di, uo).
|
|
|
|
find_undef_mode_bodies([], _, _) --> [].
|
|
find_undef_mode_bodies([ModeId | ModeIds], ModeDefns, InstDefns) -->
|
|
{ map__search(ModeDefns, ModeId, HLDS_ModeDefn) },
|
|
% XXX abstract hlds__mode_defn/5
|
|
{ HLDS_ModeDefn = hlds__mode_defn(_, _, Mode, _, Context) },
|
|
find_undef_mode_body(Mode, mode(ModeId) - Context, ModeDefns,
|
|
InstDefns),
|
|
find_undef_mode_bodies(ModeIds, ModeDefns, InstDefns).
|
|
|
|
% Find any undefined insts/modes used in the given mode definition.
|
|
|
|
:- pred find_undef_mode_body(hlds__mode_body, mode_error_context,
|
|
mode_table, inst_table, io__state, io__state).
|
|
:- mode find_undef_mode_body(input, input, input, input, di, uo).
|
|
|
|
find_undef_mode_body(eqv_mode(Mode), ErrorContext, ModeDefns, InstDefns) -->
|
|
find_undef_mode(Mode, ErrorContext, ModeDefns, InstDefns).
|
|
|
|
% Find any undefined modes in a list of modes.
|
|
|
|
:- pred find_undef_mode_list(list(mode), mode_error_context,
|
|
mode_table, inst_table, io__state, io__state).
|
|
:- mode find_undef_mode_list(input, input, input, input, di, uo).
|
|
|
|
find_undef_mode_list([], _, _, _) --> [].
|
|
find_undef_mode_list([Mode|Modes], ErrorContext, ModeDefns, InstDefns) -->
|
|
find_undef_mode(Mode, ErrorContext, ModeDefns, InstDefns),
|
|
find_undef_mode_list(Modes, ErrorContext, ModeDefns, InstDefns).
|
|
|
|
% Find any undefined modes/insts used in a mode.
|
|
% The mode itself may be undefined, and also
|
|
% any inst arguments may also be undefined.
|
|
% (eg. the mode `undef1(undef2, undef3)' should generate 3 errors.)
|
|
|
|
:- pred find_undef_mode(mode, mode_error_context, mode_table, inst_table,
|
|
io__state, io__state).
|
|
:- mode find_undef_mode(input, input, input, input, di, uo).
|
|
|
|
find_undef_mode((InstA -> InstB), ErrorContext, _ModeDefns, InstDefns) -->
|
|
find_undef_inst(InstA, ErrorContext, InstDefns),
|
|
find_undef_inst(InstB, ErrorContext, InstDefns).
|
|
find_undef_mode(user_defined_mode(Name, Args), ErrorContext, ModeDefns,
|
|
InstDefns) -->
|
|
{ length(Args, Arity) },
|
|
{ ModeId = Name - Arity },
|
|
(
|
|
{ \+ map__contains(ModeDefns, ModeId)
|
|
%%% \+ is_builtin_mode(ModeId) % no builtin modes as yet
|
|
}
|
|
->
|
|
report_undef_mode(ModeId, ErrorContext)
|
|
;
|
|
[]
|
|
),
|
|
find_undef_inst_list(Args, ErrorContext, InstDefns).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Find any undefined insts used in the bodies of other inst
|
|
% declarations.
|
|
|
|
:- pred find_undef_inst_bodies(list(inst_id), inst_table, io__state, io__state).
|
|
:- mode find_undef_inst_bodies(input, input, di, uo).
|
|
|
|
find_undef_inst_bodies([], _) --> [].
|
|
find_undef_inst_bodies([InstId | InstIds], InstDefns) -->
|
|
{ map__search(InstDefns, InstId, HLDS_InstDefn) },
|
|
% XXX abstract hlds__inst_defn/5
|
|
{ HLDS_InstDefn = hlds__inst_defn(_, _, Inst, _, Context) },
|
|
find_undef_inst_body(Inst, inst(InstId) - Context, InstDefns),
|
|
find_undef_inst_bodies(InstIds, InstDefns).
|
|
|
|
% Find any undefined insts used in the given inst definition.
|
|
|
|
:- pred find_undef_inst_body(hlds__inst_body, mode_error_context, inst_table,
|
|
io__state, io__state).
|
|
:- mode find_undef_inst_body(input, input, input, di, uo).
|
|
|
|
find_undef_inst_body(eqv_inst(Inst), ErrorContext, InstDefns) -->
|
|
find_undef_inst(Inst, ErrorContext, InstDefns).
|
|
find_undef_inst_body(abstract_inst, _, _) --> [].
|
|
|
|
% Find any undefined insts in a list of insts.
|
|
|
|
:- pred find_undef_inst_list(list(inst), mode_error_context, inst_table,
|
|
io__state, io__state).
|
|
:- mode find_undef_inst_list(input, input, input, di, uo).
|
|
|
|
find_undef_inst_list([], _ErrorContext, _InstDefns) --> [].
|
|
find_undef_inst_list([Inst|Insts], ErrorContext, InstDefns) -->
|
|
find_undef_inst(Inst, ErrorContext, InstDefns),
|
|
find_undef_inst_list(Insts, ErrorContext, InstDefns).
|
|
|
|
% Find any undefined insts used in an inst.
|
|
% The inst itself may be undefined, and also
|
|
% any inst arguments may also be undefined.
|
|
% (eg. the inst `undef1(undef2, undef3)' should generate 3 errors.)
|
|
|
|
:- pred find_undef_inst(inst, mode_error_context, inst_table,
|
|
io__state, io__state).
|
|
:- mode find_undef_inst(input, input, input, di, uo).
|
|
|
|
find_undef_inst(free, _, _) --> [].
|
|
find_undef_inst(ground, _, _) --> [].
|
|
find_undef_inst(inst_var(_), _, _) --> [].
|
|
find_undef_inst(bound(BoundInsts), ErrorContext, InstDefns) -->
|
|
find_undef_bound_insts(BoundInsts, ErrorContext, InstDefns).
|
|
find_undef_inst(user_defined_inst(Name, Args), ErrorContext, InstDefns) -->
|
|
{ length(Args, Arity) },
|
|
{ InstId = Name - Arity },
|
|
(
|
|
{ \+ map__contains(InstDefns, InstId) }
|
|
%%% \+ is_builtin_inst(InstId) % no builtin modes as yet
|
|
->
|
|
report_undef_inst(InstId, ErrorContext)
|
|
;
|
|
[]
|
|
),
|
|
find_undef_inst_list(Args, ErrorContext, InstDefns).
|
|
find_undef_inst(abstract_inst(Name, Args), ErrorContext, InstDefns) -->
|
|
find_undef_inst(user_defined_inst(Name, Args), ErrorContext, InstDefns).
|
|
|
|
:- pred find_undef_bound_insts(list(bound_inst), mode_error_context, inst_table,
|
|
io__state, io__state).
|
|
:- mode find_undef_bound_insts(input, input, input, di, uo).
|
|
|
|
find_undef_bound_insts([], _, _) --> [].
|
|
find_undef_bound_insts([functor(_Name, Args) | BoundInsts], ErrorContext,
|
|
InstDefns) -->
|
|
find_undef_inst_list(Args, ErrorContext, InstDefns),
|
|
find_undef_bound_insts(BoundInsts, ErrorContext, InstDefns).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- type mode_error_context == pair(mode_error_context_2, term__context).
|
|
:- type mode_error_context_2 ---> inst(inst_id)
|
|
; mode(mode_id)
|
|
; pred(pred_id).
|
|
|
|
% Output an error message about an undefined mode
|
|
% in the specified context.
|
|
|
|
:- pred report_undef_mode(mode_id, mode_error_context, io__state, io__state).
|
|
:- mode report_undef_mode(input, input, di, uo).
|
|
report_undef_mode(ModeId, ErrorContext - Context) -->
|
|
prog_out__write_context(Context),
|
|
io__write_string("In "),
|
|
write_mode_error_context(ErrorContext),
|
|
io__write_string(":\n"),
|
|
prog_out__write_context(Context),
|
|
io__write_string("error: undefined mode "),
|
|
write_mode_id(ModeId),
|
|
io__write_string(".\n").
|
|
|
|
% Output an error message about an undefined inst
|
|
% in the specified context.
|
|
|
|
:- pred report_undef_inst(inst_id, mode_error_context, io__state, io__state).
|
|
:- mode report_undef_inst(input, input, di, uo).
|
|
report_undef_inst(InstId, ErrorContext - Context) -->
|
|
prog_out__write_context(Context),
|
|
io__write_string("In "),
|
|
write_mode_error_context(ErrorContext),
|
|
io__write_string(":\n"),
|
|
prog_out__write_context(Context),
|
|
io__write_string("error: undefined inst "),
|
|
write_inst_id(InstId),
|
|
io__write_string(".\n").
|
|
|
|
% Output a description of the context where an undefined mode was
|
|
% used.
|
|
|
|
:- pred write_mode_error_context(mode_error_context_2, io__state, io__state).
|
|
:- mode write_mode_error_context(input, di, uo).
|
|
|
|
write_mode_error_context(pred(PredId)) -->
|
|
io__write_string("mode declaration for predicate "),
|
|
write_pred_id(PredId).
|
|
write_mode_error_context(mode(ModeId)) -->
|
|
io__write_string("definition of mode "),
|
|
write_mode_id(ModeId).
|
|
write_mode_error_context(inst(InstId)) -->
|
|
io__write_string("definition of inst "),
|
|
write_inst_id(InstId).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Predicates to output mode_ids and pred_ids.
|
|
% XXX mode_ids should include the module.
|
|
|
|
:- pred write_mode_id(mode_id, io__state, io__state).
|
|
:- mode write_mode_id(input, di, uo).
|
|
|
|
write_mode_id(F - N) -->
|
|
prog_out__write_sym_name(F),
|
|
io__write_string("/"),
|
|
io__write_int(N).
|
|
|
|
% XXX inst_ids should include the module.
|
|
|
|
:- pred write_inst_id(inst_id, io__state, io__state).
|
|
:- mode write_inst_id(input, di, uo).
|
|
|
|
write_inst_id(F - N) -->
|
|
prog_out__write_sym_name(F),
|
|
io__write_string("/"),
|
|
io__write_int(N).
|
|
|
|
|
|
:- pred write_pred_id(pred_id, io__state, io__state).
|
|
:- mode write_pred_id(input, di, uo).
|
|
|
|
/******************** ALL THIS IS COMMENTED OUT
|
|
|
|
write_pred_id(PredId) -->
|
|
% XXX module name
|
|
%%% { predicate_module(PredId, Module) },
|
|
{ predicate_name(PredId, Name) },
|
|
{ predicate_arity(PredId, Arity) },
|
|
%%% io__write_string(Module),
|
|
%%% io__write_string(":"),
|
|
io__write_string(Name),
|
|
io__write_string("/"),
|
|
io__write_int(Arity).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% builtin_mode(Term, Mode)
|
|
% is true iff 'Term' is a constant of the builtin mode 'Mode'.
|
|
|
|
:- pred builtin_mode(const, string).
|
|
:- mode builtin_mode(input, output).
|
|
|
|
builtin_mode(term_integer(_), "int").
|
|
builtin_mode(term_float(_), "float").
|
|
builtin_mode(term_string(_), "string").
|
|
builtin_mode(term_atom(String), "character") :-
|
|
string__char_to_string(_, String).
|
|
|
|
% is_builtin_mode(ModeId)
|
|
% is true iff 'ModeId' is the mode_id of a builting mode
|
|
|
|
:- pred is_builtin_mode(mode_id).
|
|
:- mode is_builtin_mode(input).
|
|
|
|
is_builtin_mode(unqualified("int") - 0).
|
|
is_builtin_mode(unqualified("float") - 0).
|
|
is_builtin_mode(unqualified("string") - 0).
|
|
is_builtin_mode(unqualified("character") - 0).
|
|
is_builtin_mode(qualified(_,"int") - 0).
|
|
is_builtin_mode(qualified(_,"float") - 0).
|
|
is_builtin_mode(qualified(_,"string") - 0).
|
|
is_builtin_mode(qualified(_,"character") - 0).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% The modeinfo data structure and access predicates.
|
|
|
|
:- mode tvarset == varset.
|
|
|
|
:- mode tsubst == map(var, mode).
|
|
|
|
:- mode mode_info ---> modeinfo(
|
|
io__state,
|
|
pred_table,
|
|
mode_table,
|
|
cons_table,
|
|
pred_id,
|
|
term__context,
|
|
int, % XXX this field is never used
|
|
varset, % variables
|
|
mode_assign_set,
|
|
bool % did we find any mode errors?
|
|
).
|
|
|
|
% The normal inst of a mode_info struct: ground, with
|
|
% the io_state and the struct itself unique, but with
|
|
% multiple references allowed for the other parts.
|
|
|
|
:- inst uniq_mode_info = bound_unique(
|
|
modeinfo(
|
|
ground_unique, ground,
|
|
ground, ground, ground, ground,
|
|
ground, ground, ground, ground
|
|
)
|
|
).
|
|
|
|
:- mode modeinfo_di :: uniq_mode_info -> dead.
|
|
:- mode modeinfo_uo :: free -> uniq_mode_info.
|
|
|
|
% Some fiddly modes used when we want to extract
|
|
% the io_state from a modeinfo struct and then put it back again.
|
|
|
|
:- inst mode_info_no_io = bound_unique(
|
|
modeinfo(
|
|
dead, ground,
|
|
ground, ground, ground, ground,
|
|
ground, ground, ground, ground
|
|
)
|
|
).
|
|
|
|
:- mode modeinfo_get_io_state :: uniq_mode_info -> mode_info_no_io.
|
|
:- mode modeinfo_set_io_state :: mode_info_no_io -> dead.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred modeinfo_init(io__state, module_info, pred_id, term__context,
|
|
varset, varset, mode_info).
|
|
:- mode modeinfo_init(di, input, input, input, input, input, modeinfo_uo).
|
|
|
|
modeinfo_init(IOState, ModuleInfo, PredId, Context, ModeVarSet, VarSet,
|
|
ModeInfo) :-
|
|
moduleinfo_preds(ModuleInfo, Preds),
|
|
moduleinfo_modes(ModuleInfo, Modes),
|
|
moduleinfo_ctors(ModuleInfo, Ctors),
|
|
map__init(ModeBindings),
|
|
map__init(VarModes),
|
|
ModeInfo = modeinfo(
|
|
IOState, Preds, Modes, Ctors, PredId, Context, 0,
|
|
VarSet, [mode_assign(VarModes, ModeVarSet, ModeBindings)],
|
|
no
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred modeinfo_get_io_state(mode_info, io__state).
|
|
:- mode modeinfo_get_io_state(modeinfo_get_io_state, uo).
|
|
|
|
modeinfo_get_io_state(modeinfo(IOState,_,_,_,_,_,_,_,_,_), IOState).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred modeinfo_set_io_state(mode_info, io__state, mode_info).
|
|
:- mode modeinfo_set_io_state(modeinfo_set_io_state, ui, modeinfo_uo).
|
|
|
|
modeinfo_set_io_state( modeinfo(_,B,C,D,E,F,G,H,I,J), IOState,
|
|
modeinfo(IOState,B,C,D,E,F,G,H,I,J)).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred modeinfo_get_preds(mode_info, pred_table).
|
|
:- mode modeinfo_get_preds(input, output).
|
|
|
|
modeinfo_get_preds(modeinfo(_,Preds,_,_,_,_,_,_,_,_), Preds).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred modeinfo_get_modes(mode_info, mode_table).
|
|
:- mode modeinfo_get_modes(input, output).
|
|
|
|
modeinfo_get_modes(modeinfo(_,_,Modes,_,_,_,_,_,_,_), Modes).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred modeinfo_get_ctors(mode_info, cons_table).
|
|
:- mode modeinfo_get_ctors(input, output).
|
|
|
|
modeinfo_get_ctors(modeinfo(_,_,_,Ctors,_,_,_,_,_,_), Ctors).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred modeinfo_get_predid(mode_info, pred_id).
|
|
:- mode modeinfo_get_predid(input, output).
|
|
|
|
modeinfo_get_predid(modeinfo(_,_,_,_,PredId,_,_,_,_,_), PredId).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred modeinfo_get_context(mode_info, term__context).
|
|
:- mode modeinfo_get_context(input, output).
|
|
|
|
modeinfo_get_context(modeinfo(_,_,_,_,_,Context,_,_,_,_), Context).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred modeinfo_get_varset(mode_info, varset).
|
|
:- mode modeinfo_get_varset(input, output).
|
|
|
|
modeinfo_get_varset(modeinfo(_,_,_,_,_,_,_,VarSet,_,_), VarSet).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred modeinfo_get_mode_assign_set(mode_info, mode_assign_set).
|
|
:- mode modeinfo_get_mode_assign_set(input, output).
|
|
|
|
modeinfo_get_mode_assign_set(modeinfo(_,_,_,_,_,_,_,_,ModeAssignSet,_),
|
|
ModeAssignSet).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred modeinfo_set_mode_assign_set(mode_info, mode_assign_set, mode_info).
|
|
:- mode modeinfo_set_mode_assign_set(modeinfo_di, input, modeinfo_uo).
|
|
|
|
modeinfo_set_mode_assign_set( modeinfo(A,B,C,D,E,F,G,H,_,J), ModeAssignSet,
|
|
modeinfo(A,B,C,D,E,F,G,H,ModeAssignSet,J)).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred modeinfo_set_found_error(mode_info, bool, mode_info).
|
|
:- mode modeinfo_set_found_error(modeinfo_di, input, modeinfo_uo).
|
|
|
|
modeinfo_set_found_error( modeinfo(A,B,C,D,E,F,G,H,I,_), FoundError,
|
|
modeinfo(A,B,C,D,E,F,G,H,I,FoundError)).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred modeinfo_get_ctor_list(mode_info, const, int, list(hlds__cons_defn)).
|
|
:- mode modeinfo_get_ctor_list(input, input, input, output).
|
|
|
|
modeinfo_get_ctor_list(ModeInfo, Functor, Arity, ConsDefnList) :-
|
|
modeinfo_get_ctors(ModeInfo, Ctors),
|
|
(
|
|
Functor = term_atom(Name),
|
|
map__search(Ctors, cons(Name, Arity), ConsDefnList0)
|
|
->
|
|
ConsDefnList1 = ConsDefnList0
|
|
;
|
|
ConsDefnList1 = []
|
|
),
|
|
(
|
|
Arity = 0,
|
|
builtin_mode(Functor, BuiltInMode)
|
|
->
|
|
term__context_init("<builtin>", 0, Context),
|
|
ModeId = unqualified(BuiltInMode) - 0,
|
|
ConsDefn = hlds__cons_defn([], ModeId, Context),
|
|
ConsDefnList = [ConsDefn | ConsDefnList1]
|
|
;
|
|
ConsDefnList = ConsDefnList1
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% The mode_assign and mode_assign_set data structures.
|
|
|
|
:- mode mode_assign_set == list(mode_assign).
|
|
|
|
:- mode mode_assign ---> mode_assign(
|
|
map(var, mode), % var modes
|
|
tvarset, % mode names
|
|
tsubst % mode bindings
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Access predicates for the mode_assign data structure.
|
|
% Excruciatingly boring code.
|
|
|
|
:- pred mode_assign_get_var_modes(mode_assign, map(var, mode)).
|
|
:- mode mode_assign_get_var_modes(input, output).
|
|
|
|
mode_assign_get_var_modes(mode_assign(VarModes, _, _), VarModes).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred mode_assign_get_modevarset(mode_assign, tvarset).
|
|
:- mode mode_assign_get_modevarset(input, output).
|
|
|
|
mode_assign_get_modevarset(mode_assign(_, ModeVarSet, _), ModeVarSet).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred mode_assign_get_mode_bindings(mode_assign, tsubst).
|
|
:- mode mode_assign_get_mode_bindings(input, output).
|
|
|
|
mode_assign_get_mode_bindings(mode_assign(_, _, ModeBindings), ModeBindings).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred mode_assign_set_var_modes(mode_assign, map(var, mode), mode_assign).
|
|
:- mode mode_assign_set_var_modes(input, input, output).
|
|
|
|
mode_assign_set_var_modes(mode_assign(_, B, C), VarModes,
|
|
mode_assign(VarModes, B, C)).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred mode_assign_set_modevarset(mode_assign, tvarset, mode_assign).
|
|
:- mode mode_assign_set_modevarset(input, input, output).
|
|
|
|
mode_assign_set_modevarset(mode_assign(A, _, C), ModeVarSet,
|
|
mode_assign(A, ModeVarSet, C)).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred mode_assign_set_mode_bindings(mode_assign, tsubst, mode_assign).
|
|
:- mode mode_assign_set_mode_bindings(input, input, output).
|
|
|
|
mode_assign_set_mode_bindings(mode_assign(A, B, _), ModeBindings,
|
|
mode_assign(A, B, ModeBindings)).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% The next section contains predicates for writing error diagnostics.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred report_error_unif(pred_id, term__context, varset, term, term,
|
|
mode_assign_set, io__state, io__state).
|
|
:- mode report_error_unif(input, input, input, input, input, input, di, uo).
|
|
|
|
report_error_unif(PredId, Context, VarSet, X, Y, ModeAssignSet) -->
|
|
write_context_and_predid(Context, PredId),
|
|
prog_out__write_context(Context),
|
|
io__write_string("mode error in unification of `"),
|
|
io__write_term(VarSet, X),
|
|
io__write_string("' and `"),
|
|
io__write_term(VarSet, Y),
|
|
io__write_string("'.\n"),
|
|
write_mode_assign_set_msg(ModeAssignSet, VarSet).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred write_mode_assign_set_msg(mode_assign_set, tvarset,
|
|
io__state, io__state).
|
|
:- mode write_mode_assign_set_msg(input, input, di, uo).
|
|
|
|
write_mode_assign_set_msg(ModeAssignSet, VarSet) -->
|
|
( { ModeAssignSet = [_] } ->
|
|
io__write_string("\tThe partial mode assignment was:\n")
|
|
;
|
|
io__write_string("\tThe possible partial mode assignments were:\n")
|
|
),
|
|
write_mode_assign_set(ModeAssignSet, VarSet).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred write_mode_assign_set(mode_assign_set, tvarset, io__state, io__state).
|
|
:- mode write_mode_assign_set(input, input, di, uo).
|
|
|
|
write_mode_assign_set([], _) --> [].
|
|
write_mode_assign_set([ModeAssign | ModeAssigns], VarSet) -->
|
|
io__write_string("\t"),
|
|
write_mode_assign(ModeAssign, VarSet),
|
|
write_mode_assign_set(ModeAssigns, VarSet).
|
|
|
|
:- pred write_mode_assign(mode_assign, tvarset, io__state, io__state).
|
|
:- mode write_mode_assign(input, input, di, uo).
|
|
|
|
write_mode_assign(ModeAssign, VarSet) -->
|
|
{
|
|
mode_assign_get_var_modes(ModeAssign, VarModes),
|
|
mode_assign_get_mode_bindings(ModeAssign, ModeBindings),
|
|
mode_assign_get_modevarset(ModeAssign, ModeVarSet),
|
|
map__keys(VarModes, Vars),
|
|
Vars = [Var | Vars1]
|
|
},
|
|
(
|
|
{ map__search(VarModes, Var, Mode) },
|
|
{ varset__lookup_name(VarSet, Var, _) }
|
|
->
|
|
io__write_variable(Var, VarSet),
|
|
io__write_string(" :: "),
|
|
write_mode_b(Mode, ModeVarSet, ModeBindings)
|
|
;
|
|
[]
|
|
),
|
|
write_mode_assign_2(Vars1, VarSet, VarModes, ModeBindings, ModeVarSet),
|
|
io__write_string("\n").
|
|
|
|
:- pred write_mode_assign_2(list(var), varset, map(var, mode),
|
|
tsubst, tvarset, io__state, io__state).
|
|
:- mode write_mode_assign_2(input, input, input, input, input, di, uo).
|
|
|
|
write_mode_assign_2([], _, _, _, _) --> [].
|
|
write_mode_assign_2([Var | Vars], VarSet, VarModes, ModeBindings, ModeVarSet)
|
|
-->
|
|
(
|
|
{ map__search(VarModes, Var, Mode) },
|
|
{ varset__lookup_name(VarSet, Var, _) }
|
|
->
|
|
io__write_string(", "),
|
|
io__write_variable(Var, VarSet),
|
|
io__write_string(" :: "),
|
|
write_mode_b(Mode, ModeVarSet, ModeBindings)
|
|
;
|
|
[]
|
|
),
|
|
write_mode_assign_2(Vars, VarSet, VarModes, ModeBindings, ModeVarSet).
|
|
|
|
% write_mode_b writes out a mode after applying the mode bindings.
|
|
|
|
:- pred write_mode_b(mode, tvarset, tsubst, io__state, io__state).
|
|
:- mode write_mode_b(input, input, input, di, uo).
|
|
|
|
write_mode_b(Mode, ModeVarSet, ModeBindings) -->
|
|
{ term__apply_rec_substitution(Mode, ModeBindings, Mode2) },
|
|
io__write_term(ModeVarSet, Mode2).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred report_error_var(pred_id, term__context, varset, var,
|
|
list(mode_stuff), mode, mode_assign_set,
|
|
io__state, io__state).
|
|
:- mode report_error_var(input, input, input, input, input, input, input,
|
|
di, uo).
|
|
|
|
report_error_var(PredId, Context, VarSet, VarId, ModeStuffList, Mode,
|
|
ModeAssignSet0) -->
|
|
write_context_and_predid(Context, PredId),
|
|
prog_out__write_context(Context),
|
|
io__write_string("mode error: "),
|
|
io__write_string("variable `"),
|
|
io__write_variable(VarId, VarSet),
|
|
( { ModeStuffList = [SingleModeStuff] } ->
|
|
{ SingleModeStuff = mode_stuff(VMode, TVarSet, TBinding) },
|
|
io__write_string("' has mode `"),
|
|
write_mode_b(VMode, TVarSet, TBinding),
|
|
io__write_string("',\n"),
|
|
prog_out__write_context(Context),
|
|
io__write_string("expected mode was `"),
|
|
write_mode_b(Mode, TVarSet, TBinding),
|
|
io__write_string("'.\n")
|
|
;
|
|
io__write_string("' has overloaded mode { `"),
|
|
write_mode_stuff_list(ModeStuffList),
|
|
io__write_string(" },\n"),
|
|
io__write_string("which doesn't match the expected mode.\n")
|
|
% XXX improve error message: should output
|
|
% the expected mode.
|
|
),
|
|
write_mode_assign_set_msg(ModeAssignSet0, VarSet).
|
|
|
|
:- pred write_mode_stuff_list(list(mode_stuff), io__state, io__state).
|
|
:- mode write_mode_stuff_list(input, di, uo).
|
|
|
|
write_mode_stuff_list([]) --> [].
|
|
write_mode_stuff_list([mode_stuff(T, TVarSet, TBinding) | Ts]) -->
|
|
write_mode_b(T, TVarSet, TBinding),
|
|
write_mode_stuff_list_2(Ts).
|
|
|
|
:- pred write_mode_stuff_list_2(list(mode_stuff), io__state, io__state).
|
|
:- mode write_mode_stuff_list_2(input, di, uo).
|
|
|
|
write_mode_stuff_list_2([]) --> [].
|
|
write_mode_stuff_list_2([mode_stuff(T, TVarSet, TBinding) | Ts]) -->
|
|
io__write_string(", "),
|
|
write_mode_b(T, TVarSet, TBinding),
|
|
write_mode_stuff_list_2(Ts).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred report_error_undef_pred(pred_id, term__context, pred_id,
|
|
io__state, io__state).
|
|
:- mode report_error_undef_pred(input, input, input, di, uo).
|
|
|
|
report_error_undef_pred(CallingPredId, Context, PredId) -->
|
|
write_context_and_predid(Context, CallingPredId),
|
|
prog_out__write_context(Context),
|
|
io__write_string("error: undefined predicate `"),
|
|
write_pred_id(PredId),
|
|
io__write_string("'.\n").
|
|
|
|
:- pred report_error_undef_cons(pred_id, term__context, const, int,
|
|
io__state, io__state).
|
|
:- mode report_error_undef_cons(input, input, input, input, di, uo).
|
|
|
|
report_error_undef_cons(PredId, Context, Functor, Arity) -->
|
|
write_context_and_predid(Context, PredId),
|
|
prog_out__write_context(Context),
|
|
io__write_string("error: undefined symbol `"),
|
|
io__write_constant(Functor),
|
|
io__write_string("/"),
|
|
io__write_int(Arity),
|
|
io__write_string("'.\n").
|
|
|
|
:- pred report_error_cons(pred_id, term__context, varset, const, list(term),
|
|
mode, mode_assign_set, io__state, io__state).
|
|
:- mode report_error_cons(input, input, input, input, input, input, input,
|
|
di, uo).
|
|
|
|
report_error_cons(PredId, Context, VarSet, Functor, Args, Mode,
|
|
ModeAssignSet) -->
|
|
write_context_and_predid(Context, PredId),
|
|
prog_out__write_context(Context),
|
|
io__write_string("mode error: term `"),
|
|
io__write_term(VarSet, term_functor(Functor, Args, Context)),
|
|
io__write_string("' does not have mode `"),
|
|
write_mode(Mode), % XXX
|
|
io__write_string("'.\n"),
|
|
write_mode_assign_set_msg(ModeAssignSet, VarSet).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred write_context_and_predid(term__context, pred_id, io__state, io__state).
|
|
:- mode write_context_and_predid(input, input, di, uo).
|
|
|
|
write_context_and_predid(Context, PredId) -->
|
|
prog_out__write_context(Context),
|
|
io__write_string("In clause for predicate `"),
|
|
write_pred_id(PredId),
|
|
io__write_string("':\n").
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred report_ambiguity_error(mode_info, mode_assign, mode_assign,
|
|
io__state, io__state).
|
|
:- mode report_ambiguity_error(input, input, input, di, uo).
|
|
|
|
report_ambiguity_error(ModeInfo, ModeAssign1, ModeAssign2) -->
|
|
{ modeinfo_get_context(ModeInfo, Context) },
|
|
{ modeinfo_get_predid(ModeInfo, PredId) },
|
|
write_context_and_predid(Context, PredId),
|
|
prog_out__write_context(Context),
|
|
io__write_string("error: ambiguous overloading causes mode ambiguity.\n"),
|
|
io__write_string("\tpossible mode assignments include:\n"),
|
|
{ modeinfo_get_varset(ModeInfo, VarSet) },
|
|
{ mode_assign_get_var_modes(ModeAssign1, VarModes1) },
|
|
{ map__keys(VarModes1, Vars1) },
|
|
report_ambiguity_error_2(Vars1, VarSet, ModeAssign1, ModeAssign2).
|
|
|
|
:- pred report_ambiguity_error_2(list(var), varset, mode_assign, mode_assign,
|
|
io__state, io__state).
|
|
:- mode report_ambiguity_error_2(input, input, input, input, di, uo).
|
|
|
|
report_ambiguity_error_2([], _VarSet, _ModeAssign1, _ModeAssign2) --> [].
|
|
report_ambiguity_error_2([V | Vs], VarSet, ModeAssign1, ModeAssign2) -->
|
|
{ mode_assign_get_var_modes(ModeAssign1, VarModes1) },
|
|
{ mode_assign_get_var_modes(ModeAssign2, VarModes2) },
|
|
( {
|
|
map__search(VarModes1, V, T1),
|
|
map__search(VarModes2, V, T2),
|
|
not (T1 = T2)
|
|
} ->
|
|
io__write_string("\t"),
|
|
io__write_variable(V, VarSet),
|
|
io__write_string(" :: "),
|
|
{ mode_assign_get_modevarset(ModeAssign1, TVarSet1) },
|
|
{ mode_assign_get_mode_bindings(ModeAssign1, ModeBindings1) },
|
|
write_mode_b(T1, TVarSet1, ModeBindings1),
|
|
io__write_string(" OR "),
|
|
{ mode_assign_get_modevarset(ModeAssign2, TVarSet2) },
|
|
{ mode_assign_get_mode_bindings(ModeAssign2, ModeBindings2) },
|
|
write_mode_b(T2, TVarSet2, ModeBindings2),
|
|
io__write_string("\n")
|
|
;
|
|
[]
|
|
),
|
|
report_ambiguity_error_2(Vs, VarSet, ModeAssign1, ModeAssign2).
|
|
|
|
:- pred write_mode(mode, io__state, io__state).
|
|
:- mode write_mode(input, di, uo).
|
|
|
|
write_mode(Mode) -->
|
|
{ varset__init(TVarSet) }, % XXX mode parameter names
|
|
io__write_term(TVarSet, Mode).
|
|
|
|
ALL THIS IS COMMENTED OUT ********************/
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|