mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-21 20:33:55 +00:00
485 lines
18 KiB
Mathematica
485 lines
18 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%---------------------------------------------------------------------------%
|
|
% Copyright (C) 1996-2012 The University of Melbourne.
|
|
% Copyright (C) 2014-2018 The Mercury team.
|
|
% This file may only be copied under the terms of the GNU General
|
|
% Public License - see the file COPYING in the Mercury distribution.
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% File: cons.m.
|
|
% Main authors: fjh, conway.
|
|
%
|
|
% This module defines the data structures we use to hold information
|
|
% about function symbols.
|
|
%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- module hlds.hlds_cons.
|
|
:- interface.
|
|
|
|
:- import_module hlds.status.
|
|
:- import_module mdbcomp.
|
|
:- import_module mdbcomp.sym_name.
|
|
:- import_module parse_tree.
|
|
:- import_module parse_tree.prog_data.
|
|
|
|
:- import_module assoc_list.
|
|
:- import_module list.
|
|
:- import_module map.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% The symbol table for constructors.
|
|
%
|
|
|
|
% The symbol table for constructors. This table is used by the typechecker
|
|
% to look up the type of functors/constants.
|
|
%
|
|
:- type cons_table.
|
|
|
|
% A cons_defn is the definition of a constructor (i.e. a constant
|
|
% or a functor) for a particular type.
|
|
%
|
|
:- type hlds_cons_defn
|
|
---> hlds_cons_defn(
|
|
% The result type, i.e. the type constructor to which this
|
|
% cons_defn belongs.
|
|
cons_type_ctor :: type_ctor,
|
|
|
|
% These three fields are copies of the first three fields
|
|
% of the hlds_type_defn for cons_type_ctor. They specify
|
|
% the tvarset from which the type variables in the argument
|
|
% types come, the type constructor's type parameter list,
|
|
% and the kinds of the type variables.
|
|
%
|
|
% These copies are here because code that wants to process
|
|
% the types of the cons_id's arguments (the cons_args field)
|
|
% typically needs to know them. Having a copy here avoids
|
|
% a lookup of the type definition.
|
|
cons_type_tvarset :: tvarset,
|
|
cons_type_params :: list(type_param),
|
|
cons_type_kinds :: tvar_kind_map,
|
|
|
|
% Any existential type variables and class constraints.
|
|
% It is an invariant that this will be no_exist_constraints
|
|
% if the list of arguments is empty.
|
|
cons_maybe_exist :: maybe_cons_exist_constraints,
|
|
|
|
% The field names and types of the arguments of this functor
|
|
% (if any).
|
|
cons_args :: list(constructor_arg),
|
|
|
|
% The location of this constructor definition in the
|
|
% original source code.
|
|
cons_context :: prog_context
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Creating and populating the cons_table.
|
|
%
|
|
|
|
:- func init_cons_table = cons_table.
|
|
|
|
% Insert the given hlds_cons_defn into the cons_table as the definition
|
|
% for one or more cons_ids. These cons_ids should represent the full range
|
|
% of possible qualifications of the *same* cons_id, from unqualified
|
|
% through all forms of possible qualification to fully qualified,
|
|
% and with both the actual type_ctor and the dummy type_ctor.
|
|
% The first argument should be the fully qualified version with
|
|
% the actual type_ctor.
|
|
%
|
|
:- pred insert_into_cons_table(cons_id::in, list(cons_id)::in,
|
|
hlds_cons_defn::in, cons_table::in, cons_table::out) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Updating the cons table as a whole.
|
|
%
|
|
|
|
% Transform every hlds_cons_defn in the cons_table using the
|
|
% given predicate.
|
|
%
|
|
:- pred replace_cons_defns_in_cons_table(
|
|
pred(hlds_cons_defn, hlds_cons_defn)::in(pred(in, out) is det),
|
|
cons_table::in, cons_table::out) is det.
|
|
|
|
:- pred cons_table_optimize(cons_table::in, cons_table::out) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Searching the cons table for a given cons_id.
|
|
%
|
|
|
|
% Does the given cons_id occur in the cons_table? If yes, return
|
|
% the list of possible matching hlds_cons_defns, which will be
|
|
% for occurrences of the same cons_id in different type definitions.
|
|
%
|
|
:- pred search_cons_table(cons_table::in, cons_id::in,
|
|
list(hlds_cons_defn)::out) is semidet.
|
|
|
|
% Does the given cons_id occur in the cons_table? This does the same job
|
|
% as search_cons_table, but without constructing and returning the list of
|
|
% possible matching hlds_cons_defns.
|
|
%
|
|
:- pred is_known_data_cons(cons_table::in, cons_id::in) is semidet.
|
|
|
|
% Does the given cons_id occur in the definition of the given type
|
|
% constructor in the cons_table? If yes, return its definition in that
|
|
% type; otherwise, fail.
|
|
%
|
|
:- pred search_cons_table_of_type_ctor(cons_table::in, type_ctor::in,
|
|
cons_id::in, hlds_cons_defn::out) is semidet.
|
|
|
|
% Does the given cons_id occur in the definition of the given type
|
|
% constructor in the cons_table? If yes, return its definition in that
|
|
% type; otherwise, abort.
|
|
%
|
|
:- pred lookup_cons_table_of_type_ctor(cons_table::in, type_ctor::in,
|
|
cons_id::in, hlds_cons_defn::out) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Searching the cons table for things other than a cons_id.
|
|
%
|
|
|
|
% Return the list of arities with which the given sym_name occurs
|
|
% in the cons_table.
|
|
%
|
|
:- pred return_cons_arities(cons_table::in, sym_name::in, list(int)::out)
|
|
is det.
|
|
|
|
:- pred return_cons_defns_with_given_name(cons_table::in, string::in,
|
|
list(hlds_cons_defn)::out) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Returning the entire contents of the cons table.
|
|
%
|
|
|
|
% Return all the constructor definitions in the cons_table.
|
|
%
|
|
:- pred get_all_cons_defns(cons_table::in,
|
|
assoc_list(cons_id, hlds_cons_defn)::out) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% The table for field names.
|
|
%
|
|
|
|
:- type ctor_field_table == map(sym_name, list(hlds_ctor_field_defn)).
|
|
|
|
:- type hlds_ctor_field_defn
|
|
---> hlds_ctor_field_defn(
|
|
% The context of the field definition.
|
|
field_context :: prog_context,
|
|
|
|
field_status :: type_status,
|
|
|
|
% The type containing the field.
|
|
field_type_ctor :: type_ctor,
|
|
|
|
% The constructor containing the field.
|
|
field_cons_id :: cons_id,
|
|
|
|
% Argument number (counting from 1).
|
|
field_arg_num :: int
|
|
).
|
|
|
|
% Field accesses are expanded into inline unifications by post_typecheck.m
|
|
% after typechecking has worked out which field is being referred to.
|
|
%
|
|
% Function declarations and clauses are not generated for these because
|
|
% it would be difficult to work out how to mode them.
|
|
%
|
|
% Users can supply type and mode declarations, for example to export
|
|
% a field of an abstract data type or to allow taking the address
|
|
% of a field access function.
|
|
%
|
|
:- type field_access_type
|
|
---> get
|
|
; set.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module pair.
|
|
:- import_module require.
|
|
:- import_module varset.
|
|
|
|
% Maps the raw, unqualified name of a functor to information about
|
|
% all the functors with that name.
|
|
:- type cons_table == map(string, inner_cons_table).
|
|
|
|
% Every visible constructor will have exactly one entry in the list,
|
|
% and this entry lists all the cons_ids by which that constructor
|
|
% may be known. The cons_ids listed for a given constructor may give
|
|
% fully, partially or not-at-all qualified versions of the symbol name,
|
|
% they must agree on the arity, and may give the actual type_ctor
|
|
% or the standard dummy type_ctor. The main cons_id must give the
|
|
% fully qualified symname and the right type_ctor.
|
|
%
|
|
% The order of the list is not meaningful.
|
|
:- type inner_cons_table == list(inner_cons_entry).
|
|
:- type inner_cons_entry
|
|
---> inner_cons_entry(
|
|
ice_fully_qual_cons_id :: cons_id,
|
|
ice_other_cons_ids :: list(cons_id),
|
|
ice_cons_defn :: hlds_cons_defn
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
init_cons_table = map.init.
|
|
|
|
insert_into_cons_table(MainConsId, OtherConsIds, ConsDefn, !ConsTable) :-
|
|
( if MainConsId = cons(MainSymName, _, _) then
|
|
MainName = unqualify_name(MainSymName),
|
|
Entry = inner_cons_entry(MainConsId, OtherConsIds, ConsDefn),
|
|
( if map.search(!.ConsTable, MainName, InnerConsEntries0) then
|
|
InnerConsEntries = [Entry | InnerConsEntries0],
|
|
map.det_update(MainName, InnerConsEntries, !ConsTable)
|
|
else
|
|
InnerConsEntries = [Entry],
|
|
map.det_insert(MainName, InnerConsEntries, !ConsTable)
|
|
)
|
|
else
|
|
unexpected($pred, "MainConsId is not cons")
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
replace_cons_defns_in_cons_table(Replace, !ConsTable) :-
|
|
map.map_values_only(replace_cons_defns_in_inner_cons_table(Replace),
|
|
!ConsTable).
|
|
|
|
:- pred replace_cons_defns_in_inner_cons_table(
|
|
pred(hlds_cons_defn, hlds_cons_defn)::in(pred(in, out) is det),
|
|
inner_cons_table::in, inner_cons_table::out) is det.
|
|
|
|
replace_cons_defns_in_inner_cons_table(Replace, !InnerConsTable) :-
|
|
list.map(replace_cons_defns_in_inner_cons_entry(Replace), !InnerConsTable).
|
|
|
|
:- pred replace_cons_defns_in_inner_cons_entry(
|
|
pred(hlds_cons_defn, hlds_cons_defn)::in(pred(in, out) is det),
|
|
inner_cons_entry::in, inner_cons_entry::out) is det.
|
|
|
|
replace_cons_defns_in_inner_cons_entry(Replace, !Entry) :-
|
|
ConsDefn0 = !.Entry ^ ice_cons_defn,
|
|
Replace(ConsDefn0, ConsDefn),
|
|
!Entry ^ ice_cons_defn := ConsDefn.
|
|
|
|
%---------------------%
|
|
|
|
cons_table_optimize(!ConsTable) :-
|
|
map.optimize(!ConsTable).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
search_cons_table(ConsTable, ConsId, ConsDefns) :-
|
|
ConsId = cons(SymName, _, _),
|
|
Name = unqualify_name(SymName),
|
|
map.search(ConsTable, Name, InnerConsTable),
|
|
% After post-typecheck, all calls should specify the main cons_id
|
|
% of the searched-for (single) constructor definition. Searching
|
|
% the main cons_ids is sufficient for such calls, and since there are
|
|
% many fewer main cons_ids than other cons_ids, it is fast as well.
|
|
%
|
|
% I (zs) don't think replacing a list with a different structure would
|
|
% help, since these lists should be very short.
|
|
( if search_inner_main_cons_ids(InnerConsTable, ConsId, MainConsDefn) then
|
|
ConsDefns = [MainConsDefn]
|
|
else
|
|
% Before and during typecheck, we may need to look up constructors
|
|
% using cons_ids that may not be even partially module qualified,
|
|
% and which will contain a dummy type_ctor. That is why we search
|
|
% the other cons_ids as well.
|
|
%
|
|
% After post-typecheck, we should get here only if there is a bug
|
|
% in the compiler, since
|
|
%
|
|
% - at that time, all cons_ids should be module-qualified and should
|
|
% have non-dummy type-ctors,
|
|
%
|
|
% - this means that searches that find what they are looking for
|
|
% will take the then-branch above, and
|
|
%
|
|
% - there should be no searches that fail, because mention of
|
|
% an unknown cons_id in the program is a type error, which means
|
|
% the compiler should never get to the passes following
|
|
% post-typecheck.
|
|
search_inner_other_cons_ids(InnerConsTable, ConsId, ConsDefns),
|
|
% Do not return empty lists; let the call fail in that case.
|
|
ConsDefns = [_ | _]
|
|
).
|
|
|
|
:- pred search_inner_main_cons_ids(list(inner_cons_entry)::in, cons_id::in,
|
|
hlds_cons_defn::out) is semidet.
|
|
|
|
search_inner_main_cons_ids([Entry | Entries], ConsId, ConsDefn) :-
|
|
( if ConsId = Entry ^ ice_fully_qual_cons_id then
|
|
ConsDefn = Entry ^ ice_cons_defn
|
|
else
|
|
search_inner_main_cons_ids(Entries, ConsId, ConsDefn)
|
|
).
|
|
|
|
:- pred search_inner_other_cons_ids(list(inner_cons_entry)::in, cons_id::in,
|
|
list(hlds_cons_defn)::out) is det.
|
|
|
|
search_inner_other_cons_ids([], _ConsId, []).
|
|
search_inner_other_cons_ids([Entry | Entries], ConsId, !:ConsDefns) :-
|
|
search_inner_other_cons_ids(Entries, ConsId, !:ConsDefns),
|
|
( if list.member(ConsId, Entry ^ ice_other_cons_ids) then
|
|
!:ConsDefns = [Entry ^ ice_cons_defn | !.ConsDefns]
|
|
else
|
|
true
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
is_known_data_cons(ConsTable, ConsId) :-
|
|
ConsId = cons(SymName, _, _),
|
|
Name = unqualify_name(SymName),
|
|
map.search(ConsTable, Name, InnerConsTable),
|
|
is_known_data_cons_inner(InnerConsTable, ConsId).
|
|
|
|
:- pred is_known_data_cons_inner(list(inner_cons_entry)::in, cons_id::in)
|
|
is semidet.
|
|
|
|
is_known_data_cons_inner([Entry | Entries], ConsId) :-
|
|
( if
|
|
( ConsId = Entry ^ ice_fully_qual_cons_id
|
|
; list.member(ConsId, Entry ^ ice_other_cons_ids)
|
|
)
|
|
then
|
|
true
|
|
else
|
|
is_known_data_cons_inner(Entries, ConsId)
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
search_cons_table_of_type_ctor(ConsTable, TypeCtor, ConsId, ConsDefn) :-
|
|
ConsId = cons(SymName, _, _),
|
|
Name = unqualify_name(SymName),
|
|
map.search(ConsTable, Name, InnerConsTable),
|
|
search_inner_cons_ids_type_ctor(InnerConsTable, TypeCtor, ConsId,
|
|
ConsDefn).
|
|
|
|
:- pred search_inner_cons_ids_type_ctor(list(inner_cons_entry)::in,
|
|
type_ctor::in, cons_id::in, hlds_cons_defn::out) is semidet.
|
|
|
|
search_inner_cons_ids_type_ctor([Entry | Entries], TypeCtor, ConsId,
|
|
ConsDefn) :-
|
|
EntryConsDefn = Entry ^ ice_cons_defn,
|
|
( if
|
|
% If a type has two functors with the same name but different arities,
|
|
% then it is possible for the TypeCtor test to succeed and the ConsId
|
|
% tests to fail (due to the arity mismatch). In such cases, we need
|
|
% to search the rest of the list.
|
|
EntryConsDefn ^ cons_type_ctor = TypeCtor,
|
|
( ConsId = Entry ^ ice_fully_qual_cons_id
|
|
; list.member(ConsId, Entry ^ ice_other_cons_ids)
|
|
)
|
|
then
|
|
ConsDefn = EntryConsDefn
|
|
else
|
|
search_inner_cons_ids_type_ctor(Entries, TypeCtor, ConsId, ConsDefn)
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
lookup_cons_table_of_type_ctor(ConsTable, TypeCtor, ConsId, ConsDefn) :-
|
|
( if
|
|
search_cons_table_of_type_ctor(ConsTable, TypeCtor, ConsId,
|
|
ConsDefnPrime)
|
|
then
|
|
ConsDefn = ConsDefnPrime
|
|
else
|
|
unexpected($pred, "lookup failed")
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
return_cons_arities(ConsTable, SymName, Arities) :-
|
|
Name = unqualify_name(SymName),
|
|
( if map.search(ConsTable, Name, InnerConsTable) then
|
|
return_cons_arities_inner(InnerConsTable, SymName, [], Arities0),
|
|
list.sort_and_remove_dups(Arities0, Arities)
|
|
else
|
|
Arities = []
|
|
).
|
|
|
|
:- pred return_cons_arities_inner(list(inner_cons_entry)::in,
|
|
sym_name::in, list(int)::in, list(int)::out) is det.
|
|
|
|
return_cons_arities_inner([], _, !Arities).
|
|
return_cons_arities_inner([Entry | Entries], SymName, !Arities) :-
|
|
MainConsId = Entry ^ ice_fully_qual_cons_id,
|
|
OtherConsIds = Entry ^ ice_other_cons_ids,
|
|
return_cons_arities_inner_cons_ids([MainConsId | OtherConsIds], SymName,
|
|
!Arities),
|
|
return_cons_arities_inner(Entries, SymName, !Arities).
|
|
|
|
:- pred return_cons_arities_inner_cons_ids(list(cons_id)::in,
|
|
sym_name::in, list(int)::in, list(int)::out) is det.
|
|
|
|
return_cons_arities_inner_cons_ids([], _, !Arities).
|
|
return_cons_arities_inner_cons_ids([ConsId | ConsIds], SymName, !Arities) :-
|
|
( if ConsId = cons(ThisSymName, ThisArity, _) then
|
|
( if ThisSymName = SymName then
|
|
!:Arities = [ThisArity | !.Arities]
|
|
else
|
|
true
|
|
)
|
|
else
|
|
unexpected($pred, "ConsId is not cons")
|
|
),
|
|
return_cons_arities_inner_cons_ids(ConsIds, SymName, !Arities).
|
|
|
|
%---------------------%
|
|
|
|
return_cons_defns_with_given_name(ConsTable, Name, ConsDefns) :-
|
|
( if map.search(ConsTable, Name, InnerConsTable) then
|
|
accumulate_hlds_cons_defns(InnerConsTable, [], ConsDefns)
|
|
else
|
|
ConsDefns = []
|
|
).
|
|
|
|
:- pred accumulate_hlds_cons_defns(list(inner_cons_entry)::in,
|
|
list(hlds_cons_defn)::in, list(hlds_cons_defn)::out) is det.
|
|
|
|
accumulate_hlds_cons_defns([], !ConsDefns).
|
|
accumulate_hlds_cons_defns([Entry | Entries], !ConsDefns) :-
|
|
!:ConsDefns = [Entry ^ ice_cons_defn | !.ConsDefns],
|
|
accumulate_hlds_cons_defns(Entries, !ConsDefns).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
get_all_cons_defns(ConsTable, AllConsDefns) :-
|
|
map.foldl_values(accumulate_all_inner_cons_defns, ConsTable,
|
|
[], AllConsDefns).
|
|
|
|
:- pred accumulate_all_inner_cons_defns(inner_cons_table::in,
|
|
assoc_list(cons_id, hlds_cons_defn)::in,
|
|
assoc_list(cons_id, hlds_cons_defn)::out) is det.
|
|
|
|
accumulate_all_inner_cons_defns(InnerConsTable, !AllConsDefns) :-
|
|
list.map(project_inner_cons_entry, InnerConsTable, InnerConsList),
|
|
!:AllConsDefns = InnerConsList ++ !.AllConsDefns.
|
|
|
|
:- pred project_inner_cons_entry(inner_cons_entry::in,
|
|
pair(cons_id, hlds_cons_defn)::out) is det.
|
|
|
|
project_inner_cons_entry(Entry, Pair) :-
|
|
Entry = inner_cons_entry(MainConsId, _OtherConsIds, ConsDefn),
|
|
Pair = MainConsId - ConsDefn.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
:- end_module hlds.hlds_cons.
|
|
%---------------------------------------------------------------------------%
|