mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-12 04:14:06 +00:00
Estimated hours taken: 5 Branches: main compiler/pred_table.m: The predicates that searched the pred table used to return lists of matching pred_ids, but they never returned empty lists; if there were no matching pred_ids, they failed. This diff changes them from semidet to det, and makes them return empty lists if there are no matches. This change simplifies both the code of these predicates, and the code of the predicates calling them. - Some callers of these predicates were prepared BOTH for the call to fail, and for it to succeed returning an empty list; their types allowed both. - Some pattern-matched the return value againt a one-element list in the call itself, and treated both no matches and multiple matches the same, even though an error message for one will be misleading for the other. - All calls had to have a test for cons to pick up the first match; this test was logically redundant, since they also had a test for success/failure. Change the names of the affected predicates by replacing "search" in their names with "lookup", both to give the right intuition about what they do, and to make sure I didn't miss updating any callers. compiler/add_class.m: compiler/add_clause.m: compiler/add_pragma.m: compiler/add_pred.m: compiler/check_typeclass.m: compiler/dead_proc_elim.m: compiler/deep_profiling.m: compiler/elds_to_erlang.m: compiler/hlds_module.m: compiler/intermod.m: compiler/make_hlds_passes.m: compiler/mmc_analysis.m: compiler/post_typecheck.m: compiler/recompilation.usage.m: compiler/simplify.m: compiler/type_constraints.m: compiler/typecheck.m: compiler/typecheck_errors.m: Conform to the above change.
1258 lines
49 KiB
Mathematica
1258 lines
49 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 1996-2007, 2010-2011 The University of Melbourne.
|
|
% This file may only be copied under the terms of the GNU General
|
|
% Public License - see the file COPYING in the Mercury distribution.
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% File: pred_table.m.
|
|
% Main authors: fjh, conway.
|
|
%
|
|
% This module defines the part of the High Level Data Structure or HLDS
|
|
% that allows the compiler to look up predicates by name (qualified,
|
|
% unqualified or some mixture) and/or arity.
|
|
%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- module hlds.pred_table.
|
|
:- interface.
|
|
|
|
:- import_module hlds.hlds_pred.
|
|
:- import_module hlds.hlds_module.
|
|
:- import_module mdbcomp.prim_data.
|
|
:- import_module parse_tree.module_qual.
|
|
:- import_module parse_tree.prog_data.
|
|
|
|
:- import_module list.
|
|
:- import_module map.
|
|
:- import_module maybe.
|
|
|
|
:- implementation.
|
|
|
|
:- import_module parse_tree.error_util.
|
|
:- import_module parse_tree.prog_out.
|
|
:- import_module parse_tree.prog_type.
|
|
|
|
:- import_module bool.
|
|
:- import_module int.
|
|
:- import_module multi_map.
|
|
:- import_module pair.
|
|
:- import_module require.
|
|
:- import_module string.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- interface.
|
|
|
|
:- type predicate_table.
|
|
|
|
:- type pred_table == map(pred_id, pred_info).
|
|
|
|
% Various predicates for accessing the predicate_table type.
|
|
% The predicate_table holds information about the predicates
|
|
% and functions defined in this module or imported from other modules.
|
|
% The primary key for this table is the `pred_id', but there
|
|
% are also secondary indexes on each of name, name+arity, and
|
|
% module+name+arity, for both functions and predicates.
|
|
|
|
% Initialize the predicate table.
|
|
%
|
|
:- pred predicate_table_init(predicate_table::out) is det.
|
|
|
|
% Balance all the binary trees in the predicate table
|
|
%
|
|
:- pred predicate_table_optimize(predicate_table::in, predicate_table::out)
|
|
is det.
|
|
|
|
% Get the pred_id->pred_info map.
|
|
%
|
|
:- pred predicate_table_get_preds(predicate_table::in, pred_table::out) is det.
|
|
|
|
% Restrict the predicate table to the list of predicates. This predicate
|
|
% should only be used when the set of predicates to restrict the table to
|
|
% is significantly smaller than the predicate_table size, as rather than
|
|
% removing entries from the table it builds a new table from scratch.
|
|
%
|
|
:- pred predicate_table_restrict(partial_qualifier_info::in,
|
|
list(pred_id)::in, predicate_table::in, predicate_table::out) is det.
|
|
|
|
% Set the pred_id->pred_info map.
|
|
% NB You shouldn't modify the keys in this table, only
|
|
% use predicate_table_insert, predicate_table_remove_predid and
|
|
% predicate_table_remove_predicate.
|
|
%
|
|
:- pred predicate_table_set_preds(pred_table::in,
|
|
predicate_table::in, predicate_table::out) is det.
|
|
|
|
% Get a list of all the valid predids in the predicate_table.
|
|
% (Predicates whose definition contains a type error, etc.
|
|
% get removed from this list, so that later passes can rely
|
|
% on the predicates in this list being type-correct, etc.)
|
|
%
|
|
% This operation does not logically change the predicate table,
|
|
% but does update it physically.
|
|
%
|
|
:- pred predicate_table_get_valid_predids(list(pred_id)::out,
|
|
predicate_table::in, predicate_table::out) is det.
|
|
|
|
% Set the list of the pred_ids of all the valid predicates.
|
|
% NOTE: The only approved way to specify the list is to call
|
|
% module_info_get_valid_predids or predicate_table_get_valid_predids,
|
|
% and remove some pred_ids from that list.
|
|
%
|
|
:- pred predicate_table_set_valid_predids(list(pred_id)::in,
|
|
predicate_table::in, predicate_table::out) is det.
|
|
|
|
% Remove a pred_id from the valid list.
|
|
%
|
|
:- pred predicate_table_remove_predid(pred_id::in,
|
|
predicate_table::in, predicate_table::out) is det.
|
|
:- pred predicate_table_remove_predicate(pred_id::in,
|
|
predicate_table::in, predicate_table::out) is det.
|
|
|
|
% Search the table for (a) predicates or functions (b) predicates only
|
|
% or (c) functions only matching this (possibly module-qualified) sym_name.
|
|
%
|
|
:- pred predicate_table_lookup_sym(predicate_table::in, is_fully_qualified::in,
|
|
sym_name::in, list(pred_id)::out) is det.
|
|
|
|
:- pred predicate_table_lookup_pred_sym(predicate_table::in,
|
|
is_fully_qualified::in, sym_name::in, list(pred_id)::out) is det.
|
|
|
|
:- pred predicate_table_lookup_func_sym(predicate_table::in,
|
|
is_fully_qualified::in, sym_name::in, list(pred_id)::out) is det.
|
|
|
|
% Search the table for (a) predicates or functions (b) predicates only
|
|
% or (c) functions only matching this (possibly module-qualified)
|
|
% sym_name & arity.
|
|
%
|
|
:- pred predicate_table_lookup_sym_arity(predicate_table::in,
|
|
is_fully_qualified::in, sym_name::in, arity::in, list(pred_id)::out)
|
|
is det.
|
|
|
|
:- pred predicate_table_lookup_pred_sym_arity(predicate_table::in,
|
|
is_fully_qualified::in, sym_name::in, arity::in, list(pred_id)::out)
|
|
is det.
|
|
|
|
:- pred predicate_table_lookup_func_sym_arity(predicate_table::in,
|
|
is_fully_qualified::in, sym_name::in, arity::in, list(pred_id)::out)
|
|
is det.
|
|
|
|
% Search the table for (a) predicates or functions
|
|
% (b) predicates only or (c) functions only matching this name.
|
|
%
|
|
:- pred predicate_table_lookup_name(predicate_table::in, string::in,
|
|
list(pred_id)::out) is det.
|
|
|
|
:- pred predicate_table_lookup_pred_name(predicate_table::in, string::in,
|
|
list(pred_id)::out) is det.
|
|
|
|
:- pred predicate_table_lookup_func_name(predicate_table::in, string::in,
|
|
list(pred_id)::out) is det.
|
|
|
|
% Search the table for (a) predicates or functions (b) predicates only
|
|
% or (c) functions only matching this name & arity. When searching for
|
|
% functions, the arity used is the arity of the function, not the arity
|
|
% N+1 predicate that it gets converted to.
|
|
%
|
|
:- pred predicate_table_lookup_name_arity(predicate_table::in, string::in,
|
|
arity::in, list(pred_id)::out) is det.
|
|
|
|
:- pred predicate_table_lookup_pred_name_arity(predicate_table::in, string::in,
|
|
arity::in, list(pred_id)::out) is det.
|
|
|
|
:- pred predicate_table_lookup_func_name_arity(predicate_table::in, string::in,
|
|
arity::in, list(pred_id)::out) is det.
|
|
|
|
% Is the item known to be fully qualified? If so, a search for
|
|
% `pred foo.bar/2' will not match `pred baz.foo.bar/2'.
|
|
:- type is_fully_qualified
|
|
---> is_fully_qualified
|
|
; may_be_partially_qualified.
|
|
|
|
% Search the table for (a) predicates or functions (b) predicates only
|
|
% or (c) functions only matching this module, name & arity. When searching
|
|
% for functions, the arity used is the arity of the function, not the arity
|
|
% N+1 predicate that it gets converted to.
|
|
%
|
|
% Note that in cases (b) and (c) it was previously the case that there
|
|
% could only be one matching pred_id, since each predicate or function
|
|
% could be uniquely identified by its module, name, arity, and category
|
|
% (function/predicate). However this is no longer true, due to nested
|
|
% modules. (For example, `pred foo.bar/2' might match both
|
|
% `pred mod1.foo.bar/2' and `pred mod2.foo.bar/2'). I hope it doesn't
|
|
% break anything too badly...
|
|
%
|
|
% (`m_n_a' here is short for "module, name, arity".)
|
|
%
|
|
:- pred predicate_table_lookup_m_n_a(predicate_table::in,
|
|
is_fully_qualified::in, module_name::in, string::in, arity::in,
|
|
list(pred_id)::out) is det.
|
|
|
|
:- pred predicate_table_lookup_pred_m_n_a(predicate_table::in,
|
|
is_fully_qualified::in, module_name::in, string::in, arity::in,
|
|
list(pred_id)::out) is det.
|
|
|
|
:- pred predicate_table_lookup_func_m_n_a(predicate_table::in,
|
|
is_fully_qualified::in, module_name::in, string::in, arity::in,
|
|
list(pred_id)::out) is det.
|
|
|
|
% Search the table for predicates or functions matching this pred_or_func
|
|
% category, module, name, and arity. When searching for functions, the
|
|
% arity used is the arity of the predicate that the function gets converted
|
|
% to, i.e. the arity of the function plus one.
|
|
% NB. This is opposite to what happens with the search predicates
|
|
% declared above!!
|
|
%
|
|
:- pred predicate_table_lookup_pf_m_n_a(predicate_table::in,
|
|
is_fully_qualified::in, pred_or_func::in, module_name::in, string::in,
|
|
arity::in, list(pred_id)::out) is det.
|
|
|
|
% Search the table for predicates or functions matching this pred_or_func
|
|
% category, name, and arity. When searching for functions, the arity used
|
|
% is the arity of the predicate that the function gets converted to,
|
|
% i.e. the arity of the function plus one.
|
|
% NB. This is opposite to what happens with the search predicates
|
|
% declared above!!
|
|
%
|
|
:- pred predicate_table_lookup_pf_name_arity(predicate_table::in,
|
|
pred_or_func::in, string::in, arity::in, list(pred_id)::out) is det.
|
|
|
|
% Search the table for predicates or functions matching this pred_or_func
|
|
% category, sym_name, and arity. When searching for functions, the arity
|
|
% used is the arity of the predicate that the function gets converted to,
|
|
% i.e. the arity of the function plus one.
|
|
% NB. This is opposite to what happens with the search predicates
|
|
% declared above!!
|
|
%
|
|
:- pred predicate_table_lookup_pf_sym_arity(predicate_table::in,
|
|
is_fully_qualified::in, pred_or_func::in, sym_name::in, arity::in,
|
|
list(pred_id)::out) is det.
|
|
|
|
% Search the table for predicates or functions matching
|
|
% this pred_or_func category and sym_name.
|
|
%
|
|
:- pred predicate_table_lookup_pf_sym(predicate_table::in,
|
|
is_fully_qualified::in, pred_or_func::in, sym_name::in,
|
|
list(pred_id)::out) is det.
|
|
|
|
% predicate_table_insert(PredTable0, PredInfo,
|
|
% NeedQual, PartialQualInfo, PredId, PredTable):
|
|
%
|
|
% Insert PredInfo into PredTable0 and assign it a new pred_id.
|
|
% You should check beforehand that the pred doesn't already occur
|
|
% in the table.
|
|
%
|
|
:- pred predicate_table_insert_qual(pred_info::in, need_qualifier::in,
|
|
partial_qualifier_info::in, pred_id::out,
|
|
predicate_table::in, predicate_table::out) is det.
|
|
|
|
% Equivalent to predicate_table_insert_qual/6, except that only the
|
|
% fully-qualified version of the predicate will be inserted into the
|
|
% predicate symbol table. This is useful for creating compiler-generated
|
|
% predicates which will only ever be accessed via fully-qualified names.
|
|
%
|
|
:- pred predicate_table_insert(pred_info::in, pred_id::out,
|
|
predicate_table::in, predicate_table::out) is det.
|
|
|
|
% Find a predicate which matches the given name and argument types.
|
|
% Abort if there is no matching pred.
|
|
% Abort if there are multiple matching preds.
|
|
%
|
|
:- pred resolve_pred_overloading(module_info::in, pred_markers::in,
|
|
tvarset::in, existq_tvars::in, list(mer_type)::in, head_type_params::in,
|
|
prog_context::in, sym_name::in, sym_name::out, pred_id::out) is det.
|
|
|
|
% Find a predicate or function from the list of pred_ids which matches the
|
|
% given name and argument types. If the constraint_search argument is
|
|
% provided then also check that the class context is consistent with what
|
|
% is expected. Fail if there is no matching pred. Abort if there are
|
|
% multiple matching preds.
|
|
%
|
|
:- pred find_matching_pred_id(module_info::in, list(pred_id)::in,
|
|
tvarset::in, existq_tvars::in, list(mer_type)::in, head_type_params::in,
|
|
maybe(constraint_search)::in(maybe(constraint_search)),
|
|
prog_context::in, pred_id::out, sym_name::out) is semidet.
|
|
|
|
% A means to check that the required constraints are available, without
|
|
% knowing in advance how many are required.
|
|
%
|
|
:- type constraint_search == pred(int, list(prog_constraint)).
|
|
:- inst constraint_search == (pred(in, out) is semidet).
|
|
|
|
% Get the pred_id and proc_id matching a higher-order term with
|
|
% the given argument types, aborting with an error if none is found.
|
|
%
|
|
:- pred get_pred_id_and_proc_id_by_types(is_fully_qualified::in, sym_name::in,
|
|
pred_or_func::in, tvarset::in, existq_tvars::in, list(mer_type)::in,
|
|
head_type_params::in, module_info::in, prog_context::in,
|
|
pred_id::out, proc_id::out) is det.
|
|
|
|
% Get the pred_id matching a higher-order term with
|
|
% the given argument types, failing if none is found.
|
|
%
|
|
:- pred get_pred_id_by_types(is_fully_qualified::in, sym_name::in,
|
|
pred_or_func::in, tvarset::in, existq_tvars::in, list(mer_type)::in,
|
|
head_type_params::in, module_info::in, prog_context::in, pred_id::out)
|
|
is semidet.
|
|
|
|
% Given a pred_id, return the single proc_id, aborting
|
|
% if there are no modes or more than one mode.
|
|
%
|
|
:- pred get_proc_id(module_info::in, pred_id::in, proc_id::out) is det.
|
|
|
|
:- type mode_no
|
|
---> only_mode % The pred must have exactly one mode.
|
|
; mode_no(int). % The Nth mode, counting from 0.
|
|
|
|
:- pred lookup_builtin_pred_proc_id(module_info::in, module_name::in,
|
|
string::in, pred_or_func::in, arity::in, mode_no::in,
|
|
pred_id::out, proc_id::out) is det.
|
|
|
|
:-pred get_next_pred_id(predicate_table::in, pred_id::out) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- type predicate_table
|
|
---> predicate_table(
|
|
% Map from pred_id to pred_info.
|
|
preds :: pred_table,
|
|
|
|
% The next available pred_id.
|
|
next_pred_id :: pred_id,
|
|
|
|
% The keys of the pred_table - cached here for efficiency.
|
|
% The old pred_ids are listed in order; the new pred_ids
|
|
% are listed in reverse order. You can get the full list
|
|
% with old_pred_ids ++ reverse(new_rev_pred_ids).
|
|
old_pred_ids :: list(pred_id),
|
|
new_rev_pred_ids :: list(pred_id),
|
|
|
|
% Maps each pred_id to its accessibility by (partially)
|
|
% unqualified names.
|
|
accessibility_table :: accessibility_table,
|
|
|
|
% Indexes on predicates and on functions.
|
|
% - Map from pred/func name to pred_id.
|
|
% - Map from pred/func name & arity to pred_id.
|
|
% - Map from module, pred/func name & arity to pred_id.
|
|
pred_name_index :: name_index,
|
|
pred_name_arity_index :: name_arity_index,
|
|
pred_module_name_arity_index :: module_name_arity_index,
|
|
func_name_index :: name_index,
|
|
func_name_arity_index :: name_arity_index,
|
|
func_module_name_arity_index :: module_name_arity_index
|
|
).
|
|
|
|
:- type accessibility_table == map(pred_id, name_accessibility).
|
|
|
|
:- type name_accessibility
|
|
---> access(
|
|
% Is this predicate accessible by its unqualified name?
|
|
accessible_by_unqualifed_name :: bool,
|
|
|
|
% Is this predicate accessible by any partially qualified
|
|
% names?
|
|
accessible_by_partially_qualified_names :: bool
|
|
).
|
|
|
|
:- type name_index == map(string, list(pred_id)).
|
|
|
|
:- type name_arity_index == map(name_arity, list(pred_id)).
|
|
:- type name_arity
|
|
---> string / arity.
|
|
|
|
% First search on module and name, then search on arity. The two levels
|
|
% are needed because typecheck.m needs to be able to search on module
|
|
% and name only for higher-order terms.
|
|
:- type module_name_arity_index ==
|
|
map(pair(module_name, string), map(arity, list(pred_id))).
|
|
|
|
predicate_table_init(PredicateTable) :-
|
|
map.init(Preds),
|
|
NextPredId = hlds_pred.initial_pred_id,
|
|
OldPredIds = [],
|
|
NewRevPredIds = [],
|
|
map.init(AccessibilityTable),
|
|
map.init(Pred_N_Index),
|
|
map.init(Pred_NA_Index),
|
|
map.init(Pred_MNA_Index),
|
|
map.init(Func_N_Index),
|
|
map.init(Func_NA_Index),
|
|
map.init(Func_MNA_Index),
|
|
PredicateTable = predicate_table(Preds, NextPredId,
|
|
OldPredIds, NewRevPredIds, AccessibilityTable,
|
|
Pred_N_Index, Pred_NA_Index, Pred_MNA_Index,
|
|
Func_N_Index, Func_NA_Index, Func_MNA_Index).
|
|
|
|
predicate_table_optimize(PredicateTable0, PredicateTable) :-
|
|
PredicateTable0 = predicate_table(Preds, NextPredId,
|
|
OldPredIds, NewRevPredIds, Accessibility,
|
|
Pred_N_Index0, Pred_NA_Index0, Pred_MNA_Index0,
|
|
Func_N_Index0, Func_NA_Index0, Func_MNA_Index0),
|
|
map.optimize(Pred_N_Index0, Pred_N_Index),
|
|
map.optimize(Pred_NA_Index0, Pred_NA_Index),
|
|
map.optimize(Pred_MNA_Index0, Pred_MNA_Index),
|
|
map.optimize(Func_N_Index0, Func_N_Index),
|
|
map.optimize(Func_NA_Index0, Func_NA_Index),
|
|
map.optimize(Func_MNA_Index0, Func_MNA_Index),
|
|
PredicateTable = predicate_table(Preds, NextPredId,
|
|
OldPredIds, NewRevPredIds, Accessibility,
|
|
Pred_N_Index, Pred_NA_Index, Pred_MNA_Index,
|
|
Func_N_Index, Func_NA_Index, Func_MNA_Index).
|
|
|
|
predicate_table_get_preds(PredicateTable, PredicateTable ^ preds).
|
|
|
|
predicate_table_set_preds(Preds, !PredicateTable) :-
|
|
!PredicateTable ^ preds := Preds.
|
|
|
|
predicate_table_get_valid_predids(PredIds, !PredicateTable) :-
|
|
OldPredIds = !.PredicateTable ^ old_pred_ids,
|
|
NewRevPredIds = !.PredicateTable ^ new_rev_pred_ids,
|
|
(
|
|
NewRevPredIds = [],
|
|
PredIds = OldPredIds
|
|
;
|
|
NewRevPredIds = [_ | _],
|
|
PredIds = OldPredIds ++ list.reverse(NewRevPredIds)
|
|
),
|
|
!PredicateTable ^ old_pred_ids := PredIds,
|
|
!PredicateTable ^ new_rev_pred_ids := [].
|
|
|
|
predicate_table_set_valid_predids(PredIds, !PredicateTable) :-
|
|
!PredicateTable ^ old_pred_ids := PredIds,
|
|
!PredicateTable ^ new_rev_pred_ids := [].
|
|
|
|
predicate_table_remove_predid(PredId, !PredicateTable) :-
|
|
OldPredIds0 = !.PredicateTable ^ old_pred_ids,
|
|
NewRevPredIds0 = !.PredicateTable ^ new_rev_pred_ids,
|
|
list.delete_all(OldPredIds0, PredId, OldPredIds),
|
|
list.delete_all(NewRevPredIds0, PredId, NewRevPredIds),
|
|
!PredicateTable ^ old_pred_ids := OldPredIds,
|
|
!PredicateTable ^ new_rev_pred_ids := NewRevPredIds.
|
|
|
|
predicate_table_remove_predicate(PredId, PredicateTable0, PredicateTable) :-
|
|
PredicateTable0 = predicate_table(Preds0, NextPredId,
|
|
OldPredIds0, NewRevPredIds0, AccessibilityTable0,
|
|
PredN0, PredNA0, PredMNA0, FuncN0, FuncNA0, FuncMNA0),
|
|
list.delete_all(OldPredIds0, PredId, OldPredIds),
|
|
list.delete_all(NewRevPredIds0, PredId, NewRevPredIds),
|
|
map.det_remove(PredId, PredInfo, Preds0, Preds),
|
|
map.det_remove(PredId, _, AccessibilityTable0, AccessibilityTable),
|
|
Module = pred_info_module(PredInfo),
|
|
Name = pred_info_name(PredInfo),
|
|
Arity = pred_info_orig_arity(PredInfo),
|
|
IsPredOrFunc = pred_info_is_pred_or_func(PredInfo),
|
|
(
|
|
IsPredOrFunc = pf_predicate,
|
|
predicate_table_remove_from_index(Module, Name, Arity, PredId,
|
|
PredN0, PredN, PredNA0, PredNA, PredMNA0, PredMNA),
|
|
PredicateTable = predicate_table(Preds, NextPredId,
|
|
OldPredIds, NewRevPredIds, AccessibilityTable,
|
|
PredN, PredNA, PredMNA, FuncN0, FuncNA0, FuncMNA0)
|
|
;
|
|
IsPredOrFunc = pf_function,
|
|
FuncArity = Arity - 1,
|
|
predicate_table_remove_from_index(Module, Name, FuncArity,
|
|
PredId, FuncN0, FuncN, FuncNA0, FuncNA,
|
|
FuncMNA0, FuncMNA),
|
|
PredicateTable = predicate_table(Preds, NextPredId,
|
|
OldPredIds, NewRevPredIds, AccessibilityTable,
|
|
PredN0, PredNA0, PredMNA0, FuncN, FuncNA, FuncMNA)
|
|
).
|
|
|
|
:- pred predicate_table_remove_from_index(module_name::in, string::in, int::in,
|
|
pred_id::in, name_index::in, name_index::out,
|
|
name_arity_index::in, name_arity_index::out,
|
|
module_name_arity_index::in, module_name_arity_index::out) is det.
|
|
|
|
predicate_table_remove_from_index(Module, Name, Arity, PredId,
|
|
!N, !NA, !MNA) :-
|
|
do_remove_from_index(Name, PredId, !N),
|
|
do_remove_from_index(Name / Arity, PredId, !NA),
|
|
do_remove_from_m_n_a_index(Module, Name, Arity, PredId, !MNA).
|
|
|
|
:- pred do_remove_from_index(T::in, pred_id::in,
|
|
map(T, list(pred_id))::in, map(T, list(pred_id))::out) is det.
|
|
|
|
do_remove_from_index(T, PredId, Index0, Index) :-
|
|
( map.search(Index0, T, NamePredIds0) ->
|
|
list.delete_all(NamePredIds0, PredId, NamePredIds),
|
|
(
|
|
NamePredIds = [],
|
|
map.delete(T, Index0, Index)
|
|
;
|
|
NamePredIds = [_ | _],
|
|
map.det_update(T, NamePredIds, Index0, Index)
|
|
)
|
|
;
|
|
Index = Index0
|
|
).
|
|
|
|
:- pred do_remove_from_m_n_a_index(module_name::in, string::in, int::in,
|
|
pred_id::in, module_name_arity_index::in, module_name_arity_index::out)
|
|
is det.
|
|
|
|
do_remove_from_m_n_a_index(Module, Name, Arity, PredId, MNA0, MNA) :-
|
|
map.lookup(MNA0, Module - Name, Arities0),
|
|
map.lookup(Arities0, Arity, PredIds0),
|
|
list.delete_all(PredIds0, PredId, PredIds),
|
|
(
|
|
PredIds = [],
|
|
map.delete(Arity, Arities0, Arities),
|
|
( map.is_empty(Arities) ->
|
|
map.delete(Module - Name, MNA0, MNA)
|
|
;
|
|
map.det_update(Module - Name, Arities, MNA0, MNA)
|
|
)
|
|
;
|
|
PredIds = [_ | _],
|
|
map.det_update(Arity, PredIds, Arities0, Arities),
|
|
map.det_update(Module - Name, Arities, MNA0, MNA)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
predicate_table_lookup_sym(PredicateTable, IsFullyQualified, SymName,
|
|
PredIds) :-
|
|
(
|
|
SymName = unqualified(Name),
|
|
(
|
|
IsFullyQualified = may_be_partially_qualified,
|
|
predicate_table_lookup_name(PredicateTable, Name, PredIds)
|
|
;
|
|
IsFullyQualified = is_fully_qualified,
|
|
PredIds = []
|
|
)
|
|
;
|
|
SymName = qualified(Module, Name),
|
|
predicate_table_lookup_module_name(PredicateTable, IsFullyQualified,
|
|
Module, Name, PredIds)
|
|
).
|
|
|
|
predicate_table_lookup_pred_sym(PredicateTable, IsFullyQualified, SymName,
|
|
PredIds) :-
|
|
(
|
|
SymName = unqualified(Name),
|
|
(
|
|
IsFullyQualified = may_be_partially_qualified,
|
|
predicate_table_lookup_pred_name(PredicateTable, Name, PredIds)
|
|
;
|
|
IsFullyQualified = is_fully_qualified,
|
|
PredIds = []
|
|
)
|
|
;
|
|
SymName = qualified(Module, Name),
|
|
predicate_table_lookup_pred_module_name(PredicateTable,
|
|
IsFullyQualified, Module, Name, PredIds)
|
|
).
|
|
|
|
predicate_table_lookup_func_sym(PredicateTable, IsFullyQualified, SymName,
|
|
PredIds) :-
|
|
(
|
|
SymName = unqualified(Name),
|
|
(
|
|
IsFullyQualified = may_be_partially_qualified,
|
|
predicate_table_lookup_func_name(PredicateTable, Name, PredIds)
|
|
;
|
|
IsFullyQualified = is_fully_qualified,
|
|
PredIds = []
|
|
)
|
|
;
|
|
SymName = qualified(Module, Name),
|
|
predicate_table_lookup_func_module_name(PredicateTable,
|
|
IsFullyQualified, Module, Name, PredIds)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
predicate_table_lookup_sym_arity(PredicateTable, IsFullyQualified,
|
|
SymName, Arity, PredIds) :-
|
|
(
|
|
SymName = unqualified(Name),
|
|
(
|
|
IsFullyQualified = may_be_partially_qualified,
|
|
predicate_table_lookup_name_arity(PredicateTable, Name, Arity,
|
|
PredIds)
|
|
;
|
|
IsFullyQualified = is_fully_qualified,
|
|
PredIds = []
|
|
)
|
|
;
|
|
SymName = qualified(Module, Name),
|
|
predicate_table_lookup_m_n_a(PredicateTable,
|
|
IsFullyQualified, Module, Name, Arity, PredIds)
|
|
).
|
|
|
|
predicate_table_lookup_pred_sym_arity(PredicateTable, IsFullyQualified,
|
|
SymName, Arity, PredIds) :-
|
|
(
|
|
SymName = unqualified(Name),
|
|
(
|
|
IsFullyQualified = may_be_partially_qualified,
|
|
predicate_table_lookup_pred_name_arity(PredicateTable, Name, Arity,
|
|
PredIds)
|
|
;
|
|
IsFullyQualified = is_fully_qualified,
|
|
PredIds = []
|
|
)
|
|
;
|
|
SymName = qualified(Module, Name),
|
|
predicate_table_lookup_pred_m_n_a(PredicateTable,
|
|
IsFullyQualified, Module, Name, Arity, PredIds)
|
|
).
|
|
|
|
predicate_table_lookup_func_sym_arity(PredicateTable, IsFullyQualified,
|
|
SymName, Arity, PredIds) :-
|
|
(
|
|
SymName = unqualified(Name),
|
|
(
|
|
IsFullyQualified = may_be_partially_qualified,
|
|
predicate_table_lookup_func_name_arity(PredicateTable, Name, Arity,
|
|
PredIds)
|
|
;
|
|
IsFullyQualified = is_fully_qualified,
|
|
PredIds = []
|
|
)
|
|
;
|
|
SymName = qualified(Module, Name),
|
|
predicate_table_lookup_func_m_n_a(PredicateTable,
|
|
IsFullyQualified, Module, Name, Arity, PredIds)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
predicate_table_lookup_name(PredicateTable, Name, PredIds) :-
|
|
predicate_table_lookup_pred_name(PredicateTable, Name, PredPredIds),
|
|
predicate_table_lookup_func_name(PredicateTable, Name, FuncPredIds),
|
|
PredIds = FuncPredIds ++ PredPredIds.
|
|
|
|
predicate_table_lookup_pred_name(PredicateTable, PredName, PredIds) :-
|
|
( map.search(PredicateTable ^ pred_name_index, PredName, PredIdsPrime) ->
|
|
PredIds = PredIdsPrime
|
|
;
|
|
PredIds = []
|
|
).
|
|
|
|
predicate_table_lookup_func_name(PredicateTable, FuncName, PredIds) :-
|
|
( map.search(PredicateTable ^ func_name_index, FuncName, PredIdsPrime) ->
|
|
PredIds = PredIdsPrime
|
|
;
|
|
PredIds = []
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred predicate_table_lookup_module_name(predicate_table::in,
|
|
is_fully_qualified::in, module_name::in, string::in,
|
|
list(pred_id)::out) is det.
|
|
|
|
predicate_table_lookup_module_name(PredicateTable, IsFullyQualified,
|
|
Module, Name, PredIds) :-
|
|
predicate_table_lookup_pred_module_name(PredicateTable,
|
|
IsFullyQualified, Module, Name, PredPredIds),
|
|
predicate_table_lookup_func_module_name(PredicateTable,
|
|
IsFullyQualified, Module, Name, FuncPredIds),
|
|
PredIds = FuncPredIds ++ PredPredIds.
|
|
|
|
:- pred predicate_table_lookup_pred_module_name(predicate_table::in,
|
|
is_fully_qualified::in, module_name::in, string::in,
|
|
list(pred_id)::out) is det.
|
|
|
|
predicate_table_lookup_pred_module_name(PredicateTable, IsFullyQualified,
|
|
Module, PredName, PredIds) :-
|
|
Pred_MNA_Index = PredicateTable ^ pred_module_name_arity_index,
|
|
( map.search(Pred_MNA_Index, Module - PredName, Arities) ->
|
|
map.values(Arities, PredIdLists),
|
|
list.condense(PredIdLists, PredIds0),
|
|
maybe_filter_pred_ids_matching_module(IsFullyQualified,
|
|
Module, PredicateTable, PredIds0, PredIds)
|
|
;
|
|
PredIds = []
|
|
).
|
|
|
|
:- pred predicate_table_lookup_func_module_name(predicate_table::in,
|
|
is_fully_qualified::in, module_name::in, string::in,
|
|
list(pred_id)::out) is det.
|
|
|
|
predicate_table_lookup_func_module_name(PredicateTable, IsFullyQualified,
|
|
Module, FuncName, PredIds) :-
|
|
Func_MNA_Index = PredicateTable ^ func_module_name_arity_index,
|
|
( map.search(Func_MNA_Index, Module - FuncName, Arities) ->
|
|
map.values(Arities, PredIdLists),
|
|
list.condense(PredIdLists, PredIds0),
|
|
maybe_filter_pred_ids_matching_module(IsFullyQualified,
|
|
Module, PredicateTable, PredIds0, PredIds)
|
|
;
|
|
PredIds = []
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
predicate_table_lookup_name_arity(PredicateTable, Name, Arity, PredIds) :-
|
|
predicate_table_lookup_pred_name_arity(PredicateTable,
|
|
Name, Arity, PredPredIds),
|
|
predicate_table_lookup_func_name_arity(PredicateTable,
|
|
Name, Arity, FuncPredIds),
|
|
PredIds = FuncPredIds ++ PredPredIds.
|
|
|
|
predicate_table_lookup_pred_name_arity(PredicateTable, PredName, Arity,
|
|
PredIds) :-
|
|
PredNameArityIndex = PredicateTable ^ pred_name_arity_index,
|
|
( map.search(PredNameArityIndex, PredName / Arity, PredIdsPrime) ->
|
|
PredIds = PredIdsPrime
|
|
;
|
|
PredIds = []
|
|
).
|
|
|
|
predicate_table_lookup_func_name_arity(PredicateTable, FuncName, Arity,
|
|
PredIds) :-
|
|
FuncNameArityIndex = PredicateTable ^ func_name_arity_index,
|
|
( map.search(FuncNameArityIndex, FuncName / Arity, PredIdsPrime) ->
|
|
PredIds = PredIdsPrime
|
|
;
|
|
PredIds = []
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
predicate_table_lookup_m_n_a(PredicateTable, IsFullyQualified,
|
|
Module, Name, Arity, PredIds) :-
|
|
predicate_table_lookup_pred_m_n_a(PredicateTable,
|
|
IsFullyQualified, Module, Name, Arity, PredPredIds),
|
|
predicate_table_lookup_func_m_n_a(PredicateTable,
|
|
IsFullyQualified, Module, Name, Arity, FuncPredIds),
|
|
PredIds = FuncPredIds ++ PredPredIds.
|
|
|
|
predicate_table_lookup_pred_m_n_a(PredicateTable, IsFullyQualified,
|
|
Module, PredName, Arity, !:PredIds) :-
|
|
P_MNA_Index = PredicateTable ^ pred_module_name_arity_index,
|
|
(
|
|
map.search(P_MNA_Index, Module - PredName, ArityIndex),
|
|
map.search(ArityIndex, Arity, !:PredIds)
|
|
->
|
|
maybe_filter_pred_ids_matching_module(IsFullyQualified, Module,
|
|
PredicateTable, !PredIds)
|
|
;
|
|
!:PredIds = []
|
|
).
|
|
|
|
predicate_table_lookup_func_m_n_a(PredicateTable, IsFullyQualified,
|
|
Module, FuncName, Arity, !:PredIds) :-
|
|
F_MNA_Index = PredicateTable ^ func_module_name_arity_index,
|
|
(
|
|
map.search(F_MNA_Index, Module - FuncName, ArityIndex),
|
|
map.search(ArityIndex, Arity, !:PredIds)
|
|
->
|
|
maybe_filter_pred_ids_matching_module(IsFullyQualified, Module,
|
|
PredicateTable, !PredIds)
|
|
;
|
|
!:PredIds = []
|
|
).
|
|
|
|
:- pred maybe_filter_pred_ids_matching_module(is_fully_qualified::in,
|
|
module_name::in, predicate_table::in,
|
|
list(pred_id)::in, list(pred_id)::out) is det.
|
|
|
|
maybe_filter_pred_ids_matching_module(may_be_partially_qualified, _, _,
|
|
!PredIds).
|
|
maybe_filter_pred_ids_matching_module(is_fully_qualified, ModuleName,
|
|
PredicateTable, !PredIds) :-
|
|
predicate_table_get_preds(PredicateTable, Preds),
|
|
list.filter(pred_id_matches_module(Preds, ModuleName), !PredIds).
|
|
|
|
:- pred pred_id_matches_module(pred_table::in, module_name::in, pred_id::in)
|
|
is semidet.
|
|
|
|
pred_id_matches_module(Preds, ModuleName, PredId) :-
|
|
map.lookup(Preds, PredId, PredInfo),
|
|
ModuleName = pred_info_module(PredInfo).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
predicate_table_lookup_pf_m_n_a(PredicateTable, IsFullyQualified,
|
|
PredOrFunc, Module, Name, Arity, PredIds) :-
|
|
(
|
|
PredOrFunc = pf_predicate,
|
|
predicate_table_lookup_pred_m_n_a(PredicateTable, IsFullyQualified,
|
|
Module, Name, Arity, PredIds)
|
|
;
|
|
PredOrFunc = pf_function,
|
|
FuncArity = Arity - 1,
|
|
predicate_table_lookup_func_m_n_a(PredicateTable, IsFullyQualified,
|
|
Module, Name, FuncArity, PredIds)
|
|
).
|
|
|
|
predicate_table_lookup_pf_name_arity(PredicateTable, PredOrFunc, Name, Arity,
|
|
PredIds) :-
|
|
(
|
|
PredOrFunc = pf_predicate,
|
|
predicate_table_lookup_pred_name_arity(PredicateTable, Name, Arity,
|
|
PredIds)
|
|
;
|
|
PredOrFunc = pf_function,
|
|
FuncArity = Arity - 1,
|
|
predicate_table_lookup_func_name_arity(PredicateTable, Name, FuncArity,
|
|
PredIds)
|
|
).
|
|
|
|
predicate_table_lookup_pf_sym_arity(PredicateTable, IsFullyQualified,
|
|
PredOrFunc, SymName, Arity, PredIds) :-
|
|
(
|
|
SymName = qualified(Module, Name),
|
|
predicate_table_lookup_pf_m_n_a(PredicateTable,
|
|
IsFullyQualified, PredOrFunc, Module, Name, Arity, PredIds)
|
|
;
|
|
SymName = unqualified(Name),
|
|
(
|
|
IsFullyQualified = may_be_partially_qualified,
|
|
predicate_table_lookup_pf_name_arity(PredicateTable, PredOrFunc,
|
|
Name, Arity, PredIds)
|
|
;
|
|
IsFullyQualified = is_fully_qualified,
|
|
PredIds = []
|
|
)
|
|
).
|
|
|
|
predicate_table_lookup_pf_sym(PredicateTable, IsFullyQualified, PredOrFunc,
|
|
SymName, PredIds) :-
|
|
(
|
|
PredOrFunc = pf_predicate,
|
|
predicate_table_lookup_pred_sym(PredicateTable, IsFullyQualified,
|
|
SymName, PredIds)
|
|
;
|
|
PredOrFunc = pf_function,
|
|
predicate_table_lookup_func_sym(PredicateTable, IsFullyQualified,
|
|
SymName, PredIds)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
predicate_table_restrict(PartialQualInfo, PredIds, OrigPredicateTable,
|
|
!:PredicateTable) :-
|
|
predicate_table_reset(OrigPredicateTable, !:PredicateTable),
|
|
predicate_table_get_preds(OrigPredicateTable, Preds),
|
|
AccessibilityTable = OrigPredicateTable ^ accessibility_table,
|
|
list.foldl(
|
|
reinsert_for_restrict(PartialQualInfo, Preds, AccessibilityTable),
|
|
PredIds, !PredicateTable),
|
|
predicate_table_get_valid_predids(NewPredIds, !PredicateTable),
|
|
list.sort(NewPredIds, SortedNewPredIds),
|
|
!PredicateTable ^ old_pred_ids := SortedNewPredIds,
|
|
!PredicateTable ^ new_rev_pred_ids := [].
|
|
|
|
:- pred reinsert_for_restrict(partial_qualifier_info::in, pred_table::in,
|
|
accessibility_table::in, pred_id::in,
|
|
predicate_table::in, predicate_table::out) is det.
|
|
|
|
reinsert_for_restrict(PartialQualInfo, Preds, AccessibilityTable, PredId,
|
|
!PredicateTable) :-
|
|
PredInfo = map.lookup(Preds, PredId),
|
|
Access = map.lookup(AccessibilityTable, PredId),
|
|
Access = access(Unqualified, PartiallyQualified),
|
|
(
|
|
Unqualified = yes,
|
|
NeedQual = may_be_unqualified
|
|
;
|
|
Unqualified = no,
|
|
NeedQual = must_be_qualified
|
|
),
|
|
(
|
|
PartiallyQualified = yes,
|
|
MaybeQualInfo = yes(PartialQualInfo)
|
|
;
|
|
PartiallyQualified = no,
|
|
MaybeQualInfo = no
|
|
),
|
|
do_predicate_table_insert(yes(PredId), PredInfo, NeedQual, MaybeQualInfo,
|
|
_, !PredicateTable).
|
|
|
|
:- pred predicate_table_reset(predicate_table::in, predicate_table::out)
|
|
is det.
|
|
|
|
predicate_table_reset(PredicateTable0, PredicateTable) :-
|
|
NextPredId = PredicateTable0 ^ next_pred_id,
|
|
PredicateTable = predicate_table(map.init, NextPredId, [], [], map.init,
|
|
map.init, map.init, map.init, map.init, map.init, map.init).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
predicate_table_insert(PredInfo, PredId, !PredicateTable) :-
|
|
do_predicate_table_insert(no, PredInfo, must_be_qualified, no, PredId,
|
|
!PredicateTable).
|
|
|
|
predicate_table_insert_qual(PredInfo, NeedQual, QualInfo, PredId,
|
|
!PredicateTable) :-
|
|
do_predicate_table_insert(no, PredInfo, NeedQual, yes(QualInfo), PredId,
|
|
!PredicateTable).
|
|
|
|
:- pred do_predicate_table_insert(maybe(pred_id)::in, pred_info::in,
|
|
need_qualifier::in, maybe(partial_qualifier_info)::in, pred_id::out,
|
|
predicate_table::in, predicate_table::out) is det.
|
|
|
|
do_predicate_table_insert(MaybePredId, PredInfo, NeedQual, MaybeQualInfo,
|
|
PredId, !PredicateTable) :-
|
|
!.PredicateTable = predicate_table(Preds0, NextPredId0,
|
|
OldPredIds0, NewRevPredIds0, AccessibilityTable0,
|
|
Pred_N_Index0, Pred_NA_Index0, Pred_MNA_Index0,
|
|
Func_N_Index0, Func_NA_Index0, Func_MNA_Index0),
|
|
Module = pred_info_module(PredInfo),
|
|
Name = pred_info_name(PredInfo),
|
|
Arity = pred_info_orig_arity(PredInfo),
|
|
(
|
|
MaybePredId = yes(PredId),
|
|
NextPredId = NextPredId0
|
|
;
|
|
% Allocate a new pred_id.
|
|
MaybePredId = no,
|
|
PredId = NextPredId0,
|
|
hlds_pred.next_pred_id(PredId, NextPredId)
|
|
),
|
|
% Insert the pred_id into either the function or predicate indices,
|
|
% as appropriate.
|
|
PredOrFunc = pred_info_is_pred_or_func(PredInfo),
|
|
(
|
|
PredOrFunc = pf_predicate,
|
|
predicate_table_do_insert(Module, Name, Arity,
|
|
NeedQual, MaybeQualInfo, PredId,
|
|
AccessibilityTable0, AccessibilityTable,
|
|
Pred_N_Index0, Pred_N_Index,
|
|
Pred_NA_Index0, Pred_NA_Index,
|
|
Pred_MNA_Index0, Pred_MNA_Index),
|
|
|
|
Func_N_Index = Func_N_Index0,
|
|
Func_NA_Index = Func_NA_Index0,
|
|
Func_MNA_Index = Func_MNA_Index0
|
|
;
|
|
PredOrFunc = pf_function,
|
|
FuncArity = Arity - 1,
|
|
predicate_table_do_insert(Module, Name, FuncArity,
|
|
NeedQual, MaybeQualInfo, PredId,
|
|
AccessibilityTable0, AccessibilityTable,
|
|
Func_N_Index0, Func_N_Index,
|
|
Func_NA_Index0, Func_NA_Index,
|
|
Func_MNA_Index0, Func_MNA_Index),
|
|
|
|
Pred_N_Index = Pred_N_Index0,
|
|
Pred_NA_Index = Pred_NA_Index0,
|
|
Pred_MNA_Index = Pred_MNA_Index0
|
|
),
|
|
|
|
% Insert the pred_id into the new pred_id list.
|
|
NewRevPredIds = [PredId | NewRevPredIds0],
|
|
|
|
% Save the pred_info for this pred_id.
|
|
map.det_insert(PredId, PredInfo, Preds0, Preds),
|
|
|
|
!:PredicateTable = predicate_table(Preds, NextPredId,
|
|
OldPredIds0, NewRevPredIds, AccessibilityTable,
|
|
Pred_N_Index, Pred_NA_Index, Pred_MNA_Index,
|
|
Func_N_Index, Func_NA_Index, Func_MNA_Index).
|
|
|
|
:- pred predicate_table_do_insert(module_name::in, string::in, arity::in,
|
|
need_qualifier::in, maybe(partial_qualifier_info)::in, pred_id::in,
|
|
accessibility_table::in, accessibility_table::out,
|
|
name_index::in, name_index::out,
|
|
name_arity_index::in, name_arity_index::out,
|
|
module_name_arity_index::in, module_name_arity_index::out) is det.
|
|
|
|
predicate_table_do_insert(Module, Name, Arity, NeedQual, MaybeQualInfo,
|
|
PredId, !AccessibilityTable, !N_Index, !NA_Index, !MNA_Index) :-
|
|
(
|
|
NeedQual = may_be_unqualified,
|
|
% Insert the unqualified name into the name index.
|
|
multi_map.set(Name, PredId, !N_Index),
|
|
|
|
% Insert the unqualified name/arity into the name/arity index.
|
|
NA = Name / Arity,
|
|
multi_map.set(NA, PredId, !NA_Index),
|
|
|
|
AccessibleByUnqualifiedName = yes
|
|
;
|
|
NeedQual = must_be_qualified,
|
|
AccessibleByUnqualifiedName = no
|
|
),
|
|
(
|
|
MaybeQualInfo = yes(QualInfo),
|
|
|
|
% Insert partially module-qualified versions of the name into the
|
|
% module.name/arity index.
|
|
get_partial_qualifiers(Module, QualInfo, PartialQuals),
|
|
list.foldl(insert_into_mna_index(Name, Arity, PredId), PartialQuals,
|
|
!MNA_Index),
|
|
|
|
AccessibleByPartiallyQualifiedNames = yes
|
|
;
|
|
MaybeQualInfo = no,
|
|
AccessibleByPartiallyQualifiedNames = no
|
|
),
|
|
% Insert the fully-qualified name into the module.name/arity index.
|
|
insert_into_mna_index(Name, Arity, PredId, Module, !MNA_Index),
|
|
Access = access(AccessibleByUnqualifiedName,
|
|
AccessibleByPartiallyQualifiedNames),
|
|
map.set(PredId, Access, !AccessibilityTable).
|
|
|
|
:- pred insert_into_mna_index(string::in, arity::in, pred_id::in,
|
|
module_name::in, module_name_arity_index::in, module_name_arity_index::out)
|
|
is det.
|
|
|
|
insert_into_mna_index(Name, Arity, PredId, Module, !MNA_Index) :-
|
|
( map.search(!.MNA_Index, Module - Name, MN_Arities0) ->
|
|
multi_map.set(Arity, PredId, MN_Arities0, MN_Arities),
|
|
map.det_update(Module - Name, MN_Arities, !MNA_Index)
|
|
;
|
|
MN_Arities = map.singleton(Arity, [PredId]),
|
|
map.det_insert(Module - Name, MN_Arities, !MNA_Index)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
resolve_pred_overloading(ModuleInfo, CallerMarkers, TVarSet, ExistQTVars,
|
|
ArgTypes, HeadTypeParams, Context, PredName0, PredName, PredId) :-
|
|
% Note: calls to preds declared in `.opt' files should always be
|
|
% module qualified, so they should not be considered
|
|
% when resolving overloading.
|
|
|
|
module_info_get_predicate_table(ModuleInfo, PredTable),
|
|
IsFullyQualified = calls_are_fully_qualified(CallerMarkers),
|
|
predicate_table_lookup_pred_sym(PredTable, IsFullyQualified,
|
|
PredName0, PredIds),
|
|
|
|
% Check if there any of the candidate pred_ids have argument/return types
|
|
% which subsume the actual argument/return types of this function call.
|
|
(
|
|
find_matching_pred_id(ModuleInfo, PredIds, TVarSet, ExistQTVars,
|
|
ArgTypes, HeadTypeParams, no, Context, PredId1, PredName1)
|
|
->
|
|
PredId = PredId1,
|
|
PredName = PredName1
|
|
;
|
|
% If there is no matching predicate for this call, then this predicate
|
|
% must have a type error which should have been caught by typechecking.
|
|
unexpected($module, $pred, "type error in pred call: no matching pred")
|
|
).
|
|
|
|
find_matching_pred_id(ModuleInfo, [PredId | PredIds], TVarSet, ExistQTVars,
|
|
ArgTypes, HeadTypeParams, MaybeConstraintSearch, Context,
|
|
ThePredId, PredName) :-
|
|
(
|
|
% Lookup the argument types of the candidate predicate
|
|
% (or the argument types + return type of the candidate function).
|
|
%
|
|
module_info_pred_info(ModuleInfo, PredId, PredInfo),
|
|
pred_info_get_arg_types(PredInfo, PredTVarSet, PredExistQVars0,
|
|
PredArgTypes0),
|
|
pred_info_get_tvar_kinds(PredInfo, PredKindMap),
|
|
|
|
arg_type_list_subsumes(TVarSet, ExistQTVars, ArgTypes, HeadTypeParams,
|
|
PredTVarSet, PredKindMap, PredExistQVars0, PredArgTypes0),
|
|
|
|
(
|
|
MaybeConstraintSearch = no
|
|
;
|
|
MaybeConstraintSearch = yes(ConstraintSearch),
|
|
% Lookup the universal constraints on the condidate predicate.
|
|
pred_info_get_class_context(PredInfo, ProgConstraints),
|
|
ProgConstraints = constraints(UnivConstraints, _),
|
|
list.length(UnivConstraints, NumConstraints),
|
|
ConstraintSearch(NumConstraints, ProvenConstraints),
|
|
univ_constraints_match(ProvenConstraints, UnivConstraints)
|
|
)
|
|
->
|
|
% We've found a matching predicate.
|
|
% Was there was more than one matching predicate/function?
|
|
|
|
PName = pred_info_name(PredInfo),
|
|
Module = pred_info_module(PredInfo),
|
|
PredName = qualified(Module, PName),
|
|
(
|
|
find_matching_pred_id(ModuleInfo, PredIds, TVarSet, ExistQTVars,
|
|
ArgTypes, HeadTypeParams, MaybeConstraintSearch, Context,
|
|
OtherPredId, _OtherPredName)
|
|
->
|
|
module_info_pred_info(ModuleInfo, OtherPredId, OtherPredInfo),
|
|
pred_info_get_call_id(PredInfo, PredCallId),
|
|
pred_info_get_call_id(OtherPredInfo, OtherPredCallId),
|
|
% XXX this is not very nice
|
|
trace [io(!IO)] (
|
|
module_info_get_globals(ModuleInfo, Globals),
|
|
Pieces = [
|
|
words("Error: unresolved predicate overloading, matched"),
|
|
simple_call(PredCallId), words("and"),
|
|
simple_call(OtherPredCallId), suffix("."),
|
|
words("You need to use an explicit module qualifier."),
|
|
nl],
|
|
write_error_pieces(Globals, Context, 0, Pieces, !IO)
|
|
),
|
|
unexpected($module, $pred, "unresolvable predicate overloading")
|
|
;
|
|
ThePredId = PredId
|
|
)
|
|
;
|
|
find_matching_pred_id(ModuleInfo, PredIds, TVarSet, ExistQTVars,
|
|
ArgTypes, HeadTypeParams, MaybeConstraintSearch, Context,
|
|
ThePredId, PredName)
|
|
).
|
|
|
|
% Check that the universal constraints proven in the caller match the
|
|
% constraints on the callee.
|
|
%
|
|
% XXX we should rename apart the callee constraints and check that the
|
|
% proven constraints are instances of them. This would give us better
|
|
% overloading resolution. For the moment, we just check that the names
|
|
% and arities match, which is sufficient to prevent any compiler aborts
|
|
% in later stages.
|
|
%
|
|
:- pred univ_constraints_match(list(prog_constraint)::in,
|
|
list(prog_constraint)::in) is semidet.
|
|
|
|
univ_constraints_match([], []).
|
|
univ_constraints_match([ProvenConstraint | ProvenConstraints],
|
|
[CalleeConstraint | CalleeConstraints]) :-
|
|
ProvenConstraint = constraint(Name, ProvenArgs),
|
|
list.length(ProvenArgs, Arity),
|
|
CalleeConstraint = constraint(Name, CalleeArgs),
|
|
list.length(CalleeArgs, Arity),
|
|
univ_constraints_match(ProvenConstraints, CalleeConstraints).
|
|
|
|
get_pred_id_by_types(IsFullyQualified, SymName, PredOrFunc, TVarSet,
|
|
ExistQTVars, ArgTypes, HeadTypeParams, ModuleInfo, Context, PredId) :-
|
|
module_info_get_predicate_table(ModuleInfo, PredicateTable),
|
|
list.length(ArgTypes, Arity),
|
|
predicate_table_lookup_pf_sym_arity(PredicateTable, IsFullyQualified,
|
|
PredOrFunc, SymName, Arity, PredIds),
|
|
(
|
|
% Resolve overloading using the argument types.
|
|
find_matching_pred_id(ModuleInfo, PredIds, TVarSet, ExistQTVars,
|
|
ArgTypes, HeadTypeParams, no, Context, PredId0, _PredName)
|
|
->
|
|
PredId = PredId0
|
|
;
|
|
% Undefined/invalid pred or func.
|
|
fail
|
|
).
|
|
|
|
get_pred_id_and_proc_id_by_types(IsFullyQualified, SymName, PredOrFunc,
|
|
TVarSet, ExistQTVars, ArgTypes, HeadTypeParams, ModuleInfo, Context,
|
|
PredId, ProcId) :-
|
|
(
|
|
get_pred_id_by_types(IsFullyQualified, SymName, PredOrFunc, TVarSet,
|
|
ExistQTVars, ArgTypes, HeadTypeParams, ModuleInfo, Context,
|
|
PredId0)
|
|
->
|
|
PredId = PredId0
|
|
;
|
|
% Undefined/invalid pred or func. The type-checker should ensure
|
|
% that this never happens
|
|
list.length(ArgTypes, Arity),
|
|
PredOrFuncStr = prog_out.pred_or_func_to_str(PredOrFunc),
|
|
NameStr = sym_name_to_string(SymName),
|
|
string.int_to_string(Arity, ArityString),
|
|
string.append_list(["undefined/invalid ", PredOrFuncStr,
|
|
"\n`", NameStr, "/", ArityString, "'"], Msg),
|
|
unexpected($module, $pred, Msg)
|
|
),
|
|
get_proc_id(ModuleInfo, PredId, ProcId).
|
|
|
|
get_proc_id(ModuleInfo, PredId, ProcId) :-
|
|
module_info_pred_info(ModuleInfo, PredId, PredInfo),
|
|
ProcIds = pred_info_procids(PredInfo),
|
|
( ProcIds = [ProcId0] ->
|
|
ProcId = ProcId0
|
|
;
|
|
Name = pred_info_name(PredInfo),
|
|
PredOrFunc = pred_info_is_pred_or_func(PredInfo),
|
|
Arity = pred_info_orig_arity(PredInfo),
|
|
PredOrFuncStr = prog_out.pred_or_func_to_str(PredOrFunc),
|
|
string.int_to_string(Arity, ArityString),
|
|
(
|
|
ProcIds = [],
|
|
string.append_list([
|
|
"cannot take address of ", PredOrFuncStr,
|
|
"\n`", Name, "/", ArityString, "' with no modes.\n",
|
|
"(Sorry, confused by earlier errors -- bailing out.)"],
|
|
Message)
|
|
;
|
|
ProcIds = [_ | _],
|
|
string.append_list([
|
|
"sorry, not implemented: ",
|
|
"taking address of ", PredOrFuncStr,
|
|
"\n`", Name, "/", ArityString, "' with multiple modes.\n",
|
|
"(use an explicit lambda expression instead)"],
|
|
Message)
|
|
),
|
|
unexpected($module, $pred, Message)
|
|
).
|
|
|
|
lookup_builtin_pred_proc_id(Module, ModuleName, ProcName, PredOrFunc,
|
|
Arity, ModeNo, PredId, ProcId) :-
|
|
module_info_get_predicate_table(Module, PredTable),
|
|
(
|
|
(
|
|
PredOrFunc = pf_predicate,
|
|
predicate_table_lookup_pred_m_n_a(PredTable, is_fully_qualified,
|
|
ModuleName, ProcName, Arity, PredIds)
|
|
;
|
|
PredOrFunc = pf_function,
|
|
predicate_table_lookup_func_m_n_a(PredTable, is_fully_qualified,
|
|
ModuleName, ProcName, Arity, PredIds)
|
|
),
|
|
PredIds = [PredIdPrime]
|
|
->
|
|
PredId = PredIdPrime
|
|
;
|
|
% Some of the table builtins are polymorphic, and for them we need
|
|
% to subtract one from the arity to take into account the type_info
|
|
% argument. XXX The caller should supply us with the exact arity.
|
|
% Guessing how many of the arguments are typeinfos and/or
|
|
% typeclass_infos, as this code here does, is error-prone as well as
|
|
% inefficient.
|
|
(
|
|
PredOrFunc = pf_predicate,
|
|
predicate_table_lookup_pred_m_n_a(PredTable, is_fully_qualified,
|
|
ModuleName, ProcName, Arity - 1, PredIds)
|
|
;
|
|
PredOrFunc = pf_function,
|
|
predicate_table_lookup_func_m_n_a(PredTable, is_fully_qualified,
|
|
ModuleName, ProcName, Arity - 1, PredIds)
|
|
),
|
|
PredIds = [PredIdPrime]
|
|
->
|
|
PredId = PredIdPrime
|
|
;
|
|
string.int_to_string(Arity, ArityStr),
|
|
unexpected($module, $pred,
|
|
"can't locate " ++ ProcName ++ "/" ++ ArityStr)
|
|
),
|
|
module_info_pred_info(Module, PredId, PredInfo),
|
|
ProcIds = pred_info_procids(PredInfo),
|
|
(
|
|
ModeNo = only_mode,
|
|
( ProcIds = [ProcId0] ->
|
|
ProcId = ProcId0
|
|
;
|
|
unexpected($module, $pred,
|
|
string.format("expected single mode for %s/%d",
|
|
[s(ProcName), i(Arity)]))
|
|
)
|
|
;
|
|
ModeNo = mode_no(N),
|
|
( list.index0(ProcIds, N, ProcId0) ->
|
|
ProcId = ProcId0
|
|
;
|
|
unexpected($module, $pred,
|
|
string.format("there is no mode %d for %s/%d",
|
|
[i(N), s(ProcName), i(Arity)]))
|
|
)
|
|
).
|
|
|
|
get_next_pred_id(PredTable, NextPredId) :-
|
|
NextPredId = PredTable ^ next_pred_id.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
:- end_module hlds.pred_table.
|
|
%-----------------------------------------------------------------------------%
|