mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-14 13:23:53 +00:00
367 lines
14 KiB
Mathematica
367 lines
14 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 2012, 2014 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: 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 parse_tree.
|
|
:- import_module parse_tree.prog_data.
|
|
|
|
:- import_module assoc_list.
|
|
:- import_module bool.
|
|
:- 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
|
|
).
|
|
|
|
:- 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 instance number. 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.
|
|
|
|
% 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,
|
|
bool::out) is det.
|
|
:- pred const_struct_db_get_ground_term_enabled(const_struct_db::in,
|
|
bool::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.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module libs.options.
|
|
:- import_module libs.trace_params.
|
|
:- 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_target(Globals, Target),
|
|
(
|
|
Target = target_c,
|
|
globals.lookup_bool_option(Globals, highlevel_data, HighLevelData),
|
|
(
|
|
HighLevelData = no,
|
|
globals.get_tags_method(Globals, Tags),
|
|
(
|
|
Tags = tags_low,
|
|
can_enable_const_struct(Globals, PolyEnabled,
|
|
GroundTermEnabled)
|
|
;
|
|
( Tags = tags_high
|
|
; Tags = tags_none
|
|
),
|
|
PolyEnabled = no,
|
|
GroundTermEnabled = no
|
|
)
|
|
;
|
|
HighLevelData = yes,
|
|
PolyEnabled = no,
|
|
GroundTermEnabled = no
|
|
)
|
|
;
|
|
Target = target_java,
|
|
can_enable_const_struct(Globals, PolyEnabled, _GroundTermEnabled),
|
|
GroundTermEnabled = no
|
|
;
|
|
( Target = target_csharp
|
|
; Target = target_erlang
|
|
),
|
|
PolyEnabled = no,
|
|
GroundTermEnabled = no
|
|
),
|
|
Db = const_struct_db(PolyEnabled, GroundTermEnabled, 0,
|
|
map.init, map.init, map.init, map.init).
|
|
|
|
% Test if constant structures are enabled for polymorphism structures
|
|
% and from ground_term_contexts. The latter is only enabled if tracing
|
|
% does not require procedure bodies to be preserved. The caller
|
|
% (const_struct_db_init/2) must also check if the compilation grade
|
|
% supports constant structures.
|
|
%
|
|
:- pred can_enable_const_struct(globals::in, bool::out, bool::out) is det.
|
|
|
|
can_enable_const_struct(Globals, PolyEnabled, GroundTermEnabled) :-
|
|
globals.lookup_bool_option(Globals, enable_const_struct,
|
|
OptionEnabled),
|
|
PolyEnabled = OptionEnabled,
|
|
|
|
globals.get_trace_level(Globals, TraceLevel),
|
|
globals.get_trace_suppress(Globals, TraceSuppress),
|
|
Bodies = trace_needs_proc_body_reps(TraceLevel, TraceSuppress),
|
|
(
|
|
Bodies = no,
|
|
GroundTermEnabled = OptionEnabled
|
|
;
|
|
Bodies = yes,
|
|
% We generate representations of procedure bodies for the
|
|
% declarative debugger and for the profiler. When traverse_primitives
|
|
% in browser/declarative_tree.m looks for the Nth argument of
|
|
% variable X and X is built with a unification such as
|
|
% X = ground_term_const(...), it crashes. It should be taught not
|
|
% to do that, but in the meantime, we prevent the situation from
|
|
% arising in the first place. (We never look for the original
|
|
% sources of type infos and typeclass infos, so we can use constant
|
|
% structures for them.)
|
|
GroundTermEnabled = no
|
|
).
|
|
|
|
lookup_insert_const_struct(ConstStruct, ConstNum, !Db) :-
|
|
const_struct_db_get_poly_enabled(!.Db, Enabled),
|
|
(
|
|
Enabled = no,
|
|
unexpected($module, $pred, "not enabled")
|
|
;
|
|
Enabled = yes,
|
|
ConstStruct = const_struct(ConsId, Args, Type, Inst),
|
|
( if ConsId = cons(SymName, _, _) then
|
|
Name = unqualify_name(SymName),
|
|
ConsProxyStruct = cons_proxy_struct(Name, Args, ConsId,
|
|
Type, Inst),
|
|
const_struct_db_get_next_num(!.Db, NextConstNum),
|
|
const_struct_db_get_cons_proxy_map(!.Db, ConsMap0),
|
|
map.search_insert(ConsProxyStruct, NextConstNum, MaybeOldConstNum,
|
|
ConsMap0, ConsMap),
|
|
(
|
|
MaybeOldConstNum = yes(ConstNum)
|
|
% ConsMap should be the same as ConsMap0.
|
|
;
|
|
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(ConsMap, !Db),
|
|
const_struct_db_set_num_map(NumMap, !Db)
|
|
)
|
|
else
|
|
const_struct_db_get_next_num(!.Db, NextConstNum),
|
|
const_struct_db_get_other_struct_map(!.Db, OtherMap0),
|
|
map.search_insert(ConstStruct, NextConstNum, MaybeOldConstNum,
|
|
OtherMap0, OtherMap),
|
|
(
|
|
MaybeOldConstNum = yes(ConstNum)
|
|
% OtherMap should be the same as OtherMap0.
|
|
;
|
|
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_other_struct_map(OtherMap, !Db),
|
|
const_struct_db_set_num_map(NumMap, !Db)
|
|
)
|
|
)
|
|
).
|
|
|
|
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),
|
|
( if ConsId = cons(SymName, _, _) then
|
|
Name = unqualify_name(SymName),
|
|
ConsProxyStruct = cons_proxy_struct(Name, Args, ConsId, Type, Inst),
|
|
const_struct_db_get_cons_proxy_map(!.Db, ConsMap0),
|
|
map.det_remove(ConsProxyStruct, _ConstNum, ConsMap0, ConsMap),
|
|
const_struct_db_set_cons_proxy_map(ConsMap, !Db)
|
|
else
|
|
const_struct_db_get_other_struct_map(!.Db, OtherMap0),
|
|
map.det_remove(ConstStruct, _ConstNum, OtherMap0, OtherMap),
|
|
const_struct_db_set_other_struct_map(OtherMap, !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 three as well.
|
|
%
|
|
:- type cons_proxy_struct
|
|
---> cons_proxy_struct(
|
|
cps_name :: string,
|
|
cps_args :: list(const_struct_arg),
|
|
cps_cons_id :: cons_id,
|
|
cps_term_type :: mer_type,
|
|
cps_term_inst :: mer_inst
|
|
).
|
|
|
|
:- type const_struct_db
|
|
---> const_struct_db(
|
|
csdb_poly_enabled :: bool,
|
|
csdb_ground_term_enabled :: bool,
|
|
csdb_next_num :: int,
|
|
csdb_cons_proxy_map :: map(cons_proxy_struct, int),
|
|
csdb_other_struct_map :: map(const_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_other_struct_map(const_struct_db::in,
|
|
map(const_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_other_struct_map(Db, X) :-
|
|
X = Db ^ csdb_other_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_other_struct_map(map(const_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(ConsMap, !Db) :-
|
|
!Db ^ csdb_cons_proxy_map := ConsMap.
|
|
const_struct_db_set_other_struct_map(OtherMap, !Db) :-
|
|
!Db ^ csdb_other_struct_map := OtherMap.
|
|
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.
|
|
%-----------------------------------------------------------------------------%
|