mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-15 17:33:38 +00:00
349 lines
14 KiB
Mathematica
349 lines
14 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 2012 The University of Melbourne.
|
|
% Copyright (C) 2013-2015, 2017-2022, 2024-2025 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: const_struct.m.
|
|
% Author: zs
|
|
%
|
|
% This module defines the part of the HLDS that stores constant data structures
|
|
% separate from any procedure, for use on backends that support them.
|
|
%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- module hlds.const_struct.
|
|
:- interface.
|
|
|
|
:- import_module libs.
|
|
:- import_module libs.globals.
|
|
:- import_module libs.optimization_options.
|
|
:- import_module parse_tree.
|
|
:- import_module parse_tree.prog_data.
|
|
|
|
:- import_module assoc_list.
|
|
:- import_module list.
|
|
:- import_module map.
|
|
|
|
:- type const_struct
|
|
---> const_struct(
|
|
% The constant structured term: the data constructor,
|
|
% and its arguments.
|
|
cs_cons_id :: cons_id,
|
|
cs_args :: list(const_struct_arg),
|
|
|
|
% The type and inst of the term.
|
|
cs_term_type :: mer_type,
|
|
cs_term_inst :: mer_inst,
|
|
|
|
% Was the code that led to the creation of this const_struct
|
|
% in the current module? If not, then unused_imports.m
|
|
% should *not* consider this const_struct as representing
|
|
% uses of the modules that are referenced in it.
|
|
cs_defined_where :: defined_where
|
|
).
|
|
|
|
:- type defined_where
|
|
---> defined_in_this_module
|
|
; defined_in_other_module.
|
|
|
|
:- type const_struct_arg
|
|
---> csa_const_struct(int)
|
|
% The argument is a reference to another constant structure.
|
|
% The argument gives the id of that structure.
|
|
|
|
; csa_constant(cons_id, mer_type).
|
|
% The argument is an arity-zero cons_id. The second argument
|
|
% gives its type.
|
|
|
|
:- type const_struct_db.
|
|
|
|
:- type const_instance_id
|
|
---> ciid(
|
|
% The number in the instance_id. This field is first
|
|
% because tests on it are cheap.
|
|
int,
|
|
|
|
% The constraint.
|
|
prog_constraint,
|
|
|
|
% The already seen constraints.
|
|
list(prog_constraint)
|
|
).
|
|
|
|
:- type const_instance_map == map(const_instance_id, int).
|
|
|
|
% Initialize the database.
|
|
%
|
|
:- pred const_struct_db_init(globals::in, const_struct_db::out) is det.
|
|
|
|
% Look up a constant structure in the database. If it is not there, add it.
|
|
%
|
|
:- pred lookup_insert_const_struct(const_struct::in, int::out,
|
|
const_struct_db::in, const_struct_db::out) is det.
|
|
|
|
% Look up the number of a constant structure in the database.
|
|
% If it is not there, abort.
|
|
%
|
|
:- pred lookup_const_struct_num(const_struct_db::in, int::in,
|
|
const_struct::out) is det.
|
|
|
|
% Check whether the given constant instance already has a constant
|
|
% structure.
|
|
%
|
|
:- pred search_for_constant_instance(const_struct_db::in,
|
|
const_instance_id::in, int::out) is semidet.
|
|
|
|
% Record that the given constant instance has a constant structure
|
|
% identified by the given integer.
|
|
%
|
|
:- pred insert_constant_instance(const_instance_id::in, int::in,
|
|
const_struct_db::in, const_struct_db::out) is det.
|
|
|
|
% Mark the constant structure with the given number as logically deleted.
|
|
%
|
|
:- pred delete_const_struct(int::in,
|
|
const_struct_db::in, const_struct_db::out) is det.
|
|
|
|
% Get the list of constant structures to generate.
|
|
% If the assoc list contains N elements, the keys are guaranteed to be
|
|
% the integers 0 .. N-1 in ascending order.
|
|
%
|
|
:- pred const_struct_db_get_structs(const_struct_db::in,
|
|
assoc_list(int, const_struct)::out) is det.
|
|
|
|
% Return whether the generation of separate constant structures is enabled
|
|
% for (a) structures created by polymorphism, and (b) for structures
|
|
% created in from_ground_term_construct scopes. If it is not, then
|
|
% lookup_insert_const_struct should not be called from polymorphism.m
|
|
% and simplify.m respectively.
|
|
%
|
|
:- pred const_struct_db_get_poly_enabled(const_struct_db::in,
|
|
maybe_enable_const_struct_poly::out) is det.
|
|
:- pred const_struct_db_get_ground_term_enabled(const_struct_db::in,
|
|
maybe_enable_const_struct_user::out) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module mdbcomp.
|
|
:- import_module mdbcomp.sym_name.
|
|
|
|
:- import_module int.
|
|
:- import_module maybe.
|
|
:- import_module pair.
|
|
:- import_module require.
|
|
|
|
const_struct_db_init(Globals, Db) :-
|
|
globals.get_opt_tuple(Globals, OptTuple),
|
|
PolyEnabled = OptTuple ^ ot_enable_const_struct_poly,
|
|
GroundTermEnabled = OptTuple ^ ot_enable_const_struct_user,
|
|
Db = const_struct_db(PolyEnabled, GroundTermEnabled, 0,
|
|
map.init, map.init, map.init, map.init).
|
|
|
|
lookup_insert_const_struct(ConstStruct, ConstNum, !Db) :-
|
|
const_struct_db_get_poly_enabled(!.Db, Enabled),
|
|
(
|
|
Enabled = do_not_enable_const_struct_poly,
|
|
unexpected($pred, "not enabled")
|
|
;
|
|
Enabled = enable_const_struct_poly,
|
|
ConstStruct = const_struct(ConsId, Args, Type, _Inst, DefinedWhere),
|
|
( if ConsId = du_data_ctor(DuCtor) then
|
|
DuCtor = du_ctor(SymName, _, _),
|
|
Name = unqualify_name(SymName),
|
|
ConsProxyStruct = cons_proxy_struct(Name, Args, DuCtor, Type),
|
|
const_struct_db_get_next_num(!.Db, NextConstNum),
|
|
const_struct_db_get_cons_proxy_map(!.Db, ConsProxyMap0),
|
|
map.search_insert(ConsProxyStruct, NextConstNum, MaybeOldConstNum,
|
|
ConsProxyMap0, ConsProxyMap),
|
|
(
|
|
MaybeOldConstNum = yes(ConstNum),
|
|
% ConsProxyMap should be the same as ConsProxyMap0.
|
|
maybe_update_defined_where(DefinedWhere, ConstNum, !Db)
|
|
;
|
|
MaybeOldConstNum = no,
|
|
ConstNum = NextConstNum,
|
|
const_struct_db_get_num_map(!.Db, NumMap0),
|
|
map.det_insert(ConstNum, ConstStruct, NumMap0, NumMap),
|
|
|
|
const_struct_db_set_next_num(NextConstNum + 1, !Db),
|
|
const_struct_db_set_cons_proxy_map(ConsProxyMap, !Db),
|
|
const_struct_db_set_num_map(NumMap, !Db)
|
|
)
|
|
else
|
|
NonConsProxyStruct = noncons_proxy_struct(ConsId, Args, Type),
|
|
const_struct_db_get_next_num(!.Db, NextConstNum),
|
|
const_struct_db_get_noncons_proxy_map(!.Db, NonConsProxyMap0),
|
|
map.search_insert(NonConsProxyStruct, NextConstNum,
|
|
MaybeOldConstNum, NonConsProxyMap0, NonConsProxyMap),
|
|
(
|
|
MaybeOldConstNum = yes(ConstNum),
|
|
% NonConsProxyMap should be the same as NonConsProxyMap0.
|
|
maybe_update_defined_where(DefinedWhere, ConstNum, !Db)
|
|
;
|
|
MaybeOldConstNum = no,
|
|
ConstNum = NextConstNum,
|
|
const_struct_db_get_num_map(!.Db, NumMap0),
|
|
map.det_insert(ConstNum, ConstStruct, NumMap0, NumMap),
|
|
|
|
const_struct_db_set_next_num(NextConstNum + 1, !Db),
|
|
const_struct_db_set_noncons_proxy_map(NonConsProxyMap, !Db),
|
|
const_struct_db_set_num_map(NumMap, !Db)
|
|
)
|
|
)
|
|
).
|
|
|
|
:- pred maybe_update_defined_where(defined_where::in, int::in,
|
|
const_struct_db::in, const_struct_db::out) is det.
|
|
|
|
maybe_update_defined_where(DefinedWhere, ConstNum, !Db) :-
|
|
const_struct_db_get_num_map(!.Db, NumMap0),
|
|
map.lookup(NumMap0, ConstNum, ConstStruct0),
|
|
DefinedWhere0 = ConstStruct0 ^ cs_defined_where,
|
|
% If the new definition says that this constant is derived from code
|
|
% in this module, then set the constant accordingly, unless its old
|
|
% setting already says the same.
|
|
( if
|
|
DefinedWhere = defined_in_this_module,
|
|
DefinedWhere0 = defined_in_other_module
|
|
then
|
|
ConstStruct = ConstStruct0 ^ cs_defined_where
|
|
:= defined_in_this_module,
|
|
map.det_update(ConstNum, ConstStruct, NumMap0, NumMap),
|
|
const_struct_db_set_num_map(NumMap, !Db)
|
|
else
|
|
% There is nothing to update.
|
|
true
|
|
).
|
|
|
|
lookup_const_struct_num(Db, ConstNum, ConstStruct) :-
|
|
const_struct_db_get_num_map(Db, NumMap),
|
|
map.lookup(NumMap, ConstNum, ConstStruct).
|
|
|
|
search_for_constant_instance(Db, InstanceId, ConstNum) :-
|
|
const_struct_db_get_instance_map(Db, InstanceMap),
|
|
map.search(InstanceMap, InstanceId, ConstNum).
|
|
|
|
insert_constant_instance(InstanceId, ConstNum, !Db) :-
|
|
const_struct_db_get_instance_map(!.Db, InstanceMap0),
|
|
map.det_insert(InstanceId, ConstNum, InstanceMap0, InstanceMap),
|
|
const_struct_db_set_instance_map(InstanceMap, !Db).
|
|
|
|
delete_const_struct(ConstNum, !Db) :-
|
|
const_struct_db_get_num_map(!.Db, NumMap0),
|
|
map.det_remove(ConstNum, ConstStruct, NumMap0, NumMap),
|
|
const_struct_db_set_num_map(NumMap, !Db),
|
|
|
|
ConstStruct = const_struct(ConsId, Args, Type, _Inst, _DefinedWhere),
|
|
( if ConsId = du_data_ctor(DuCtor) then
|
|
DuCtor = du_ctor(SymName, _, _),
|
|
Name = unqualify_name(SymName),
|
|
ConsProxyStruct = cons_proxy_struct(Name, Args, DuCtor, Type),
|
|
const_struct_db_get_cons_proxy_map(!.Db, ConsProxyMap0),
|
|
map.det_remove(ConsProxyStruct, _ConstNum,
|
|
ConsProxyMap0, ConsProxyMap),
|
|
const_struct_db_set_cons_proxy_map(ConsProxyMap, !Db)
|
|
else
|
|
NonConsProxyStruct = noncons_proxy_struct(ConsId, Args, Type),
|
|
const_struct_db_get_noncons_proxy_map(!.Db, NonConsProxyMap0),
|
|
map.det_remove(NonConsProxyStruct, _ConstNum,
|
|
NonConsProxyMap0, NonConsProxyMap),
|
|
const_struct_db_set_noncons_proxy_map(NonConsProxyMap, !Db)
|
|
).
|
|
|
|
const_struct_db_get_structs(Db, Structs) :-
|
|
const_struct_db_get_num_map(Db, NumMap),
|
|
map.to_assoc_list(NumMap, Structs).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Values of this type contain the same information as values of type
|
|
% const_struct, but in a form that should allow significantly faster
|
|
% comparisons, because it copies to the front the data item most useful
|
|
% for comparisons, the name of the function symbol. If two proxy structs
|
|
% match on the first two fields, they are almost certain to match
|
|
% on the other two as well.
|
|
%
|
|
:- type cons_proxy_struct
|
|
---> cons_proxy_struct(
|
|
cps_name :: string,
|
|
cps_args :: list(const_struct_arg),
|
|
cps_du_ctor :: du_ctor,
|
|
cps_term_type :: mer_type
|
|
).
|
|
|
|
:- type noncons_proxy_struct
|
|
---> noncons_proxy_struct(
|
|
ncps_cons_id :: cons_id,
|
|
ncps_args :: list(const_struct_arg),
|
|
ncps_term_type :: mer_type
|
|
).
|
|
|
|
:- type const_struct_db
|
|
---> const_struct_db(
|
|
csdb_poly_enabled :: maybe_enable_const_struct_poly,
|
|
csdb_ground_term_enabled :: maybe_enable_const_struct_user,
|
|
csdb_next_num :: int,
|
|
csdb_cons_proxy_map :: map(cons_proxy_struct, int),
|
|
csdb_noncons_struct_map :: map(noncons_proxy_struct, int),
|
|
csdb_num_map :: map(int, const_struct),
|
|
csdb_instance_map :: const_instance_map
|
|
).
|
|
|
|
:- pred const_struct_db_get_next_num(const_struct_db::in, int::out) is det.
|
|
:- pred const_struct_db_get_cons_proxy_map(const_struct_db::in,
|
|
map(cons_proxy_struct, int)::out) is det.
|
|
:- pred const_struct_db_get_noncons_proxy_map(const_struct_db::in,
|
|
map(noncons_proxy_struct, int)::out) is det.
|
|
:- pred const_struct_db_get_num_map(const_struct_db::in,
|
|
map(int, const_struct)::out) is det.
|
|
:- pred const_struct_db_get_instance_map(const_struct_db::in,
|
|
const_instance_map::out) is det.
|
|
|
|
const_struct_db_get_poly_enabled(Db, X) :-
|
|
X = Db ^ csdb_poly_enabled.
|
|
const_struct_db_get_ground_term_enabled(Db, X) :-
|
|
X = Db ^ csdb_ground_term_enabled.
|
|
const_struct_db_get_next_num(Db, X) :-
|
|
X = Db ^ csdb_next_num.
|
|
const_struct_db_get_cons_proxy_map(Db, X) :-
|
|
X = Db ^ csdb_cons_proxy_map.
|
|
const_struct_db_get_noncons_proxy_map(Db, X) :-
|
|
X = Db ^ csdb_noncons_struct_map.
|
|
const_struct_db_get_num_map(Db, X) :-
|
|
X = Db ^ csdb_num_map.
|
|
const_struct_db_get_instance_map(Db, X) :-
|
|
X = Db ^ csdb_instance_map.
|
|
|
|
:- pred const_struct_db_set_next_num(int::in,
|
|
const_struct_db::in, const_struct_db::out) is det.
|
|
:- pred const_struct_db_set_cons_proxy_map(map(cons_proxy_struct, int)::in,
|
|
const_struct_db::in, const_struct_db::out) is det.
|
|
:- pred const_struct_db_set_noncons_proxy_map(
|
|
map(noncons_proxy_struct, int)::in,
|
|
const_struct_db::in, const_struct_db::out) is det.
|
|
:- pred const_struct_db_set_num_map(map(int, const_struct)::in,
|
|
const_struct_db::in, const_struct_db::out) is det.
|
|
:- pred const_struct_db_set_instance_map(const_instance_map::in,
|
|
const_struct_db::in, const_struct_db::out) is det.
|
|
|
|
const_struct_db_set_next_num(Num, !Db) :-
|
|
!Db ^ csdb_next_num := Num.
|
|
const_struct_db_set_cons_proxy_map(ConsProxyMap, !Db) :-
|
|
!Db ^ csdb_cons_proxy_map := ConsProxyMap.
|
|
const_struct_db_set_noncons_proxy_map(NonConsProxyMap, !Db) :-
|
|
!Db ^ csdb_noncons_struct_map := NonConsProxyMap.
|
|
const_struct_db_set_num_map(NumMap, !Db) :-
|
|
!Db ^ csdb_num_map := NumMap.
|
|
const_struct_db_set_instance_map(InstanceMap, !Db) :-
|
|
!Db ^ csdb_instance_map := InstanceMap.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
:- end_module hlds.const_struct.
|
|
%-----------------------------------------------------------------------------%
|