[m-dev.] cleanup of type_ctor_infos, relative diff 2
Zoltan Somogyi
zs at cs.mu.OZ.AU
Wed Mar 8 14:33:14 AEDT 2000
This is a diff relative to "relative diff 1"; it handles the renaming and
repartitioning of base_type_info.m and base_type_layout.m into
type_ctor_info.m and pseudo_type_info.m. It is really boring;
the code did not change, only its location and a few module prefixes.
This is the diff I intend to commit.
Zoltan.
diff -rubB --exclude CVS --exclude configure --exclude errs --exclude make_all.log --exclude Mmake.params --exclude Mmake.common --exclude mercury_conf.h --exclude mercury_conf.h --exclude .#* --exclude REDUNDANT_FILES ws15/Log ws15.rename/Log
--- ws15/Log Wed Mar 8 14:13:41 2000
+++ ws15.rename/Log Wed Mar 8 13:51:05 2000
@@ -72,25 +72,27 @@
Rename some predicates to better reflect their purpose.
compiler/base_type_layout.m:
- Complete rewrite for the new data structure; significantly smaller
- than before.
-
- Now invoked from base_type_info for the types for which layout info
- is pertinent, whereas in the old design it was invoked from
- mercury_compile on all types, even types not defined in Mercury.
-
compiler/base_type_info.m:
- Significant rewrite for the new data structure.
-
- Invoke base_type_layout.m as necessary, since the structures it creates
- are parts of the type_ctor_infos.
+ These files are obsoleted by this change. They remain in CVS, but
+ are no longer used. All of base_type_info.m has been moved into
+ type_ctor_info.m, and so have the parts of base_type_layout.m
+ that create the functors and layout structures inside type_ctor_infos;
+ the remaining part of base_type_layout.m is now in pseudo_type_info.m.
+
+compiler/pseudo_type_info.m:
+ New file containing the code to create pseudo_type_infos from
+ base_type_layout.m, slightly updated for the new compiler structure.
+
+compiler/type_ctor_info.m:
+ New module: almost total rewrite of the base_type_info.m and the
+ relevant part of base_type_layout.m for the new data structure.
Do not invoke base_typeclass_info.m, since the structures it creates
are not parts of the type_ctor_infos.
compiler/ml_base_type_info.m:
Comment out obsolete unfinished code. It should be replaced by
- calls to base_type_info, once base_type_info's dependence on LLDS
+ calls to type_ctor_info, once type_ctor_info's dependence on LLDS
has been eliminated.
compiler/hlds_module.m:
@@ -108,8 +110,9 @@
name.
compiler/mercury_compile.m:
- Do not invoke base_type_layouts directly; let base_type_infos do it
- for the types for which it is appropriate.
+ Do not invoke the predicates that used to be in base_type_layouts
+ directly; let type_ctor_info do it for the types for which it is
+ appropriate.
Do invoke base_typeclass_info directly.
diff -rubB --exclude CVS --exclude configure --exclude errs --exclude make_all.log --exclude Mmake.params --exclude Mmake.common --exclude mercury_conf.h --exclude mercury_conf.h --exclude .#* --exclude REDUNDANT_FILES ws15/compiler/base_type_info.m ws15.rename/compiler/base_type_info.m
--- ws15/compiler/base_type_info.m Tue Feb 29 14:07:43 2000
+++ ws15.rename/compiler/base_type_info.m Tue Mar 7 18:55:20 2000
@@ -4,220 +4,6 @@
% Public License - see the file COPYING in the Mercury distribution.
%---------------------------------------------------------------------------%
%
-% File: base_type_info.m.
-% Author: zs.
+% This file is no longer used. Its contents have migrated to type_ctor_info.m.
%
-% This module is responsible for the generation of the static type_ctor_info
-% structures of the types defined by the current module.
-%
-% Since it is possible for the type_ctor_info of a type local to the module
-% not to be referred to anywhere in the module (and therefore, not to be
-% referred to anywhere in the program), this module works in two stages.
-% In the first stage, it inserts type_ctor_gen_info structures describing the
-% type_ctor_infos of all the locally-defined types into the HLDS; some of
-% these type_ctor_gen_infos are later eliminated by dead_proc_elim.m. The
-% second stage then generates low-level descriptions of type_ctor_infos
-% for LLDS (or later MLDS) from the surviving type_ctor_gen_infos.
-%
-% See runtime/mercury_type_info.h for a description of the data structures
-% we build in this module.
-%
-% WARNING: if you change this module, you will probably need to also
-% change ml_base_type_info.m, which does the same thing for the MLDS
-% back-end.
-%
-%---------------------------------------------------------------------------%
-
-:- module base_type_info.
-
-:- interface.
-
-:- import_module hlds_module, llds.
-:- import_module list.
-
-:- pred base_type_info__generate_hlds(module_info::in, module_info::out)
- is det.
-
-:- pred base_type_info__generate_llds(module_info::in, module_info::out,
- list(comp_gen_c_data)::out) is det.
-
-:- implementation.
-
-:- import_module rtti, base_type_layout.
-:- import_module prog_data, prog_util, prog_out.
-:- import_module hlds_data, hlds_pred, hlds_out.
-:- import_module code_util, special_pred, type_util, globals, options.
-
-:- import_module bool, string, map, std_util, require.
-
-%---------------------------------------------------------------------------%
-
-base_type_info__generate_hlds(ModuleInfo0, ModuleInfo) :-
- module_info_name(ModuleInfo0, ModuleName),
- module_info_types(ModuleInfo0, TypeTable),
- map__keys(TypeTable, TypeIds),
- base_type_info__gen_type_ctor_gen_infos(TypeIds, TypeTable, ModuleName,
- ModuleInfo0, TypeCtorGenInfos),
- module_info_set_type_ctor_gen_infos(ModuleInfo0, TypeCtorGenInfos,
- ModuleInfo).
-
- % Given a list of the ids of all the types in the type table,
- % find the types defined in this module, and return a type_ctor_gen_info
- % for each.
-
-:- pred base_type_info__gen_type_ctor_gen_infos(list(type_id)::in,
- type_table::in, module_name::in, module_info::in,
- list(type_ctor_gen_info)::out) is det.
-
-base_type_info__gen_type_ctor_gen_infos([], _, _, _, []).
-base_type_info__gen_type_ctor_gen_infos([TypeId | TypeIds], TypeTable,
- ModuleName, ModuleInfo, TypeCtorGenInfos) :-
- base_type_info__gen_type_ctor_gen_infos(TypeIds, TypeTable, ModuleName,
- ModuleInfo, TypeCtorGenInfos1),
- TypeId = SymName - TypeArity,
- (
- SymName = qualified(TypeModuleName, TypeName),
- (
- TypeModuleName = ModuleName,
- map__lookup(TypeTable, TypeId, TypeDefn),
- hlds_data__get_type_defn_body(TypeDefn, TypeBody),
- TypeBody \= abstract_type,
- \+ type_id_has_hand_defined_rtti(TypeId)
- ->
- base_type_info__gen_type_ctor_gen_info(TypeId,
- TypeName, TypeArity, TypeDefn,
- ModuleName, ModuleInfo, TypeCtorGenInfo),
- TypeCtorGenInfos = [TypeCtorGenInfo | TypeCtorGenInfos1]
- ;
- TypeCtorGenInfos = TypeCtorGenInfos1
- )
- ;
- SymName = unqualified(TypeName),
- string__append_list(["unqualified type ", TypeName,
- "found in type_ctor_info"], Msg),
- error(Msg)
- ).
-
-:- pred base_type_info__gen_type_ctor_gen_info(type_id::in, string::in,
- int::in, hlds_type_defn::in, module_name::in, module_info::in,
- type_ctor_gen_info::out) is det.
-
-base_type_info__gen_type_ctor_gen_info(TypeId, TypeName, TypeArity, TypeDefn,
- ModuleName, ModuleInfo, TypeCtorGenInfo) :-
- hlds_data__get_type_defn_status(TypeDefn, Status),
- module_info_get_special_pred_map(ModuleInfo, SpecMap),
-
- map__lookup(SpecMap, unify - TypeId, UnifyPredId),
- special_pred_mode_num(unify, UnifyProcInt),
- proc_id_to_int(UnifyProcId, UnifyProcInt),
- MaybeUnify = yes(proc(UnifyPredId, UnifyProcId)),
-
- map__lookup(SpecMap, index - TypeId, IndexPredId),
- special_pred_mode_num(index, IndexProcInt),
- proc_id_to_int(IndexProcId, IndexProcInt),
- MaybeIndex = yes(proc(IndexPredId, IndexProcId)),
-
- map__lookup(SpecMap, compare - TypeId, ComparePredId),
- special_pred_mode_num(compare, CompareProcInt),
- proc_id_to_int(CompareProcId, CompareProcInt),
- MaybeCompare = yes(proc(ComparePredId, CompareProcId)),
-
- TypeCtorGenInfo = type_ctor_gen_info(TypeId, ModuleName,
- TypeName, TypeArity, Status, TypeDefn,
- MaybeUnify, MaybeIndex, MaybeCompare,
- no, no, no).
-
-%---------------------------------------------------------------------------%
-
-base_type_info__generate_llds(ModuleInfo0, ModuleInfo, Tables) :-
- module_info_type_ctor_gen_infos(ModuleInfo0, TypeCtorGenInfos),
- base_type_info__construct_type_ctor_infos(TypeCtorGenInfos,
- ModuleInfo0, ModuleInfo, [], Dynamic0, [], Static0),
- list__map(llds__wrap_rtti_data, Dynamic0, Dynamic),
- list__map(llds__wrap_rtti_data, Static0, Static),
- list__append(Dynamic, Static, Tables).
-
-:- pred base_type_info__construct_type_ctor_infos(
- list(type_ctor_gen_info)::in, module_info::in, module_info::out,
- list(rtti_data)::in, list(rtti_data)::out,
- list(rtti_data)::in, list(rtti_data)::out) is det.
-
-base_type_info__construct_type_ctor_infos([], ModuleInfo, ModuleInfo,
- Dynamic, Dynamic, Static, Static).
-base_type_info__construct_type_ctor_infos(
- [TypeCtorGenInfo | TypeCtorGenInfos], ModuleInfo0, ModuleInfo,
- Dynamic0, Dynamic, Static0, Static) :-
- base_type_info__construct_type_ctor_info(TypeCtorGenInfo,
- ModuleInfo0, ModuleInfo1, TypeCtorCModule, TypeCtorTables),
- Dynamic1 = [TypeCtorCModule | Dynamic0],
- list__append(TypeCtorTables, Static0, Static1),
- base_type_info__construct_type_ctor_infos(TypeCtorGenInfos,
- ModuleInfo1, ModuleInfo, Dynamic1, Dynamic, Static1, Static).
-
-:- pred base_type_info__construct_type_ctor_info(type_ctor_gen_info::in,
- module_info::in, module_info::out,
- rtti_data::out, list(rtti_data)::out) is det.
-
-base_type_info__construct_type_ctor_info(TypeCtorGenInfo,
- ModuleInfo0, ModuleInfo, TypeCtorData, TypeCtorTables) :-
- TypeCtorGenInfo = type_ctor_gen_info(_TypeId, ModuleName, TypeName,
- TypeArity, _Status, HldsDefn,
- MaybeUnify, MaybeIndex, MaybeCompare,
- MaybeSolver, MaybeInit, MaybePretty),
- base_type_info__make_pred_addr(MaybeUnify, ModuleInfo, Unify),
- base_type_info__make_pred_addr(MaybeIndex, ModuleInfo, Index),
- base_type_info__make_pred_addr(MaybeCompare, ModuleInfo, Compare),
- base_type_info__make_pred_addr(MaybeSolver, ModuleInfo, Solver),
- base_type_info__make_pred_addr(MaybeInit, ModuleInfo, Init),
- base_type_info__make_pred_addr(MaybePretty, ModuleInfo, Pretty),
-
- module_info_globals(ModuleInfo0, Globals),
- globals__lookup_bool_option(Globals, type_layout, TypeLayoutOption),
- ( TypeLayoutOption = yes ->
- base_type_layout__gen_layout_info(ModuleName,
- TypeName, TypeArity, HldsDefn, ModuleInfo0, ModuleInfo,
- TypeCtorRep, NumFunctors, MaybeFunctors, MaybeLayout,
- NumPtags, TypeCtorTables)
- ;
- % This is for measuring code size only; if this path
- % is ever taken, the resulting executable will not
- % work.
- TypeCtorRep = unknown,
- NumPtags = -1,
- NumFunctors = -1,
- MaybeFunctors = no_functors,
- MaybeLayout = no_layout,
- TypeCtorTables = [],
- ModuleInfo = ModuleInfo0
- ),
- Version = type_ctor_info_rtti_version,
- RttiTypeId = rtti_type_id(ModuleName, TypeName, TypeArity),
- TypeCtorData = type_ctor_info(RttiTypeId, Unify, Index, Compare,
- TypeCtorRep, Solver, Init, Version, NumPtags, NumFunctors,
- MaybeFunctors, MaybeLayout, no, Pretty).
-
-:- pred base_type_info__make_pred_addr(maybe(pred_proc_id)::in,
- module_info::in, maybe(code_addr)::out) is det.
-
-base_type_info__make_pred_addr(no, _ModuleInfo, no).
-base_type_info__make_pred_addr(yes(PredProcId), ModuleInfo, yes(PredAddr)) :-
- PredProcId = proc(PredId, ProcId),
- code_util__make_entry_label(ModuleInfo, PredId, ProcId, no, PredAddr).
-
%---------------------------------------------------------------------------%
-
- % The version of the RTTI data structures -- useful for bootstrapping.
- % If you write runtime code that checks this version number and
- % can at least handle the previous version of the data
- % structure, it makes it easier to bootstrap changes to the data
- % structures used for RTTI.
- %
- % This number should be kept in sync with MR_RTTI_VERSION in
- % runtime/mercury_type_info.h. This means you need to update
- % the handwritten type_ctor_info structures and the code in the
- % runtime that uses RTTI to conform to whatever changes the new
- % version introduces.
-
-:- func type_ctor_info_rtti_version = int.
-
-type_ctor_info_rtti_version = 4.
diff -rubB --exclude CVS --exclude configure --exclude errs --exclude make_all.log --exclude Mmake.params --exclude Mmake.common --exclude mercury_conf.h --exclude mercury_conf.h --exclude .#* --exclude REDUNDANT_FILES ws15/compiler/base_type_layout.m ws15.rename/compiler/base_type_layout.m
--- ws15/compiler/base_type_layout.m Tue Feb 29 14:56:22 2000
+++ ws15.rename/compiler/base_type_layout.m Tue Mar 7 18:55:42 2000
@@ -4,765 +4,7 @@
% Public License - see the file COPYING in the Mercury distribution.
%---------------------------------------------------------------------------%
%
-% This module generates the compiler's internal representation of the
-% RTTI data structures that describe the representation of each type.
-% These structures form the type_ctor_rep, type_num_functors, type_functors
-% and type_layout fields of a type_ctor_info. This RTTI information is
-% used for several purposes: examples include deep copy, tabling, and functor,
-% arg and their cousins.
+% This file is no longer used. Its contents have migrated to
+% pseudo_type_info.m % and type_ctor_info.m.
%
-% The representation we build is designed to be independent of whether
-% the compiler is generating LLDS or MLDS. However, at the moment, we
-% still generate some LLDS rvals to represent typeinfos and pseudotypeinfos.
-% These `create' rvals are expected to be removed by llds_common.m to
-% create static structures.
-%
-% The documentation of the data structures built in this module is in
-% runtime/mercury_type_info.h; that file also contains a list of all
-% the files that depend on these data structures.
-%
-% Authors: trd, zs.
-%
-%---------------------------------------------------------------------------%
-
-:- module base_type_layout.
-
-:- interface.
-
-:- import_module rtti, hlds_module, hlds_data, llds, prog_data.
-:- import_module list.
-
- % base_type_layout__construct_typed_pseudo_type_info(Type,
- % NumUnivQTvars, ExistQVars, Rval, LldsType, LabelNum0, LabelNum)
- %
- % Given a Mercury type (`Type'), this predicate returns an rval
- % (`Rval') giving the pseudo type info for that type, plus the
- % llds_type (`LldsType') of that rval.
- %
- % NumUnivQTvars is either the number of universally quantified type
- % variables of the enclosing type (so that all universally quantified
- % variables in the type have numbers in the range [1..NumUnivQTvars],
- % or is the special value -1, meaning that all variables in the type
- % are universally quantified. ExistQVars is the list of existentially
- % quantified type variables of the constructor in question.
- %
- % The int arguments (`LabelNum0' and `LabelNum') are label numbers for
- % generating `create' rvals with.
-
-:- pred base_type_layout__construct_typed_pseudo_type_info((type)::in,
- int::in, existq_tvars::in,
- rval::out, llds_type::out, int::in, int::out) is det.
-
- % Generate RTTI layout information for the named type.
-:- pred base_type_layout__gen_layout_info(module_name::in,
- string::in, int::in, hlds_type_defn::in,
- module_info::in, module_info::out, type_ctor_rep::out, int::out,
- type_ctor_functors_info::out, type_ctor_layout_info::out,
- int::out, list(rtti_data)::out) is det.
-
-:- implementation.
-
-:- import_module hlds_data, hlds_pred, hlds_out, builtin_ops, type_util.
-:- import_module make_tags, code_util, globals, options, prog_util.
-:- import_module assoc_list, bool, string, int, map, std_util, require.
-:- import_module term.
-
-%---------------------------------------------------------------------------%
-%---------------------------------------------------------------------------%
-
-:- pred base_type_layout__construct_pseudo_type_info((type)::in,
- int::in, existq_tvars::in, rval::out, int::in, int::out) is det.
-
-base_type_layout__construct_pseudo_type_info(Type, NumUnivQTvars,
- ExistQTvars, Pseudo, CNum0, CNum) :-
- base_type_layout__construct_typed_pseudo_type_info(Type, NumUnivQTvars,
- ExistQTvars, Pseudo, _LldsType, CNum0, CNum).
-
-base_type_layout__construct_typed_pseudo_type_info(Type, NumUnivQTvars,
- ExistQTvars, Pseudo, LldsType, CNum0, CNum) :-
- (
- type_to_type_id(Type, TypeId, TypeArgs0)
- ->
- (
- % The argument to typeclass_info types is not
- % a type - it encodes the class constraint.
- mercury_private_builtin_module(PrivateBuiltin),
- TypeId = qualified(PrivateBuiltin, TName) - _,
- ( TName = "typeclass_info"
- ; TName = "base_typeclass_info"
- )
- ->
- TypeArgs = []
- ;
- TypeArgs = TypeArgs0
- ),
- (
- % For higher order types: they all refer to the
- % defined pred_0 type_ctor_info, have an extra
- % argument for their real arity, and then type
- % arguments according to their types.
- % polymorphism.m has a detailed explanation.
- % XXX polymorphism.m does not have a
- % detailed explanation.
- type_is_higher_order(Type, _PredFunc,
- _EvalMethod, _TypeArgs)
- ->
- TypeModule = unqualified(""),
- TypeName = "pred",
- Arity = 0,
- TypeId = _QualTypeName - RealArity,
- RealArityArg = [yes(const(int_const(RealArity)))]
- ;
- TypeId = QualTypeName - Arity,
- unqualify_name(QualTypeName, TypeName),
- sym_name_get_module_name(QualTypeName, unqualified(""),
- TypeModule),
- RealArityArg = []
- ),
- RttiTypeId = rtti_type_id(TypeModule, TypeName, Arity),
- DataAddr = rtti_addr(RttiTypeId, type_ctor_info),
- Pseudo0 = yes(const(data_addr_const(DataAddr))),
- LldsType = data_ptr,
- CNum1 = CNum0 + 1,
-
- % generate args, but remove one level of create()s.
- list__map_foldl((pred(T::in, P::out, C0::in, C::out) is det :-
- base_type_layout__construct_pseudo_type_info(
- T, NumUnivQTvars, ExistQTvars, P, C0, C)
- ), TypeArgs, PseudoArgs0, CNum1, CNum),
- list__map(base_type_layout__remove_create,
- PseudoArgs0, PseudoArgs1),
-
- list__append(RealArityArg, PseudoArgs1, PseudoArgs),
-
- Reuse = no,
- Pseudo = create(0, [Pseudo0 | PseudoArgs], uniform(no),
- must_be_static, CNum1, "type_layout", Reuse)
- ;
- type_util__var(Type, Var)
- ->
- % In the case of a type variable, we need to assign a
- % variable number *for this constructor*, i.e. taking
- % only the existentially quantified variables of
- % this constructor (and not those of other functors in
- % the same type) into account.
-
- % XXX term__var_to_int doesn't guarantee anything
- % about the ints returned (other than that they be
- % distinct for different variables), but here we are
- % relying more, specifically, on the integers being
- % allocated densely (i.e. the first N vars get integers
- % 1 to N).
- term__var_to_int(Var, VarInt0),
- (
- ( VarInt0 =< NumUnivQTvars
- ; NumUnivQTvars < 0
- )
- ->
- % This is a universally quantified variable.
- VarInt = VarInt0
- ;
- % It is existentially quantified.
- (
- list__nth_member_search(ExistQTvars,
- Var, ExistNum0)
- ->
- VarInt = ExistNum0 +
- base_type_layout__pseudo_typeinfo_exist_var_base
- ;
- error("base_type_layout: var not in list")
- )
- ),
- require(VarInt =< base_type_layout__pseudo_typeinfo_max_var,
- "type_ctor_layout: type variable representation exceeds limit"),
- Pseudo = const(int_const(VarInt)),
- LldsType = integer,
- CNum = CNum0
- ;
- error("type_ctor_layout: type neither var nor non-var")
- ).
-
- % Remove a create() from an rval, if present.
-
-:- pred base_type_layout__remove_create(rval::in, maybe(rval)::out) is det.
-
-base_type_layout__remove_create(Rval0, MaybeRval) :-
- ( Rval0 = create(_, [PTI], _, _, _, _, _) ->
- MaybeRval = PTI
- ;
- MaybeRval = yes(Rval0)
- ).
-
-%---------------------------------------------------------------------------%
-
- % This number corresponds to MR_PSEUDOTYPEINFO_MAX_VAR in
- % runtime/mercury_type_info.h, and must be kept in sync with it.
- % The documentation is located there as well.
-
-:- func base_type_layout__pseudo_typeinfo_max_var = int.
-
-base_type_layout__pseudo_typeinfo_max_var = 1024.
-
- % This number corresponds to MR_PSEUDOTYPEINFO_EXIST_VAR_BASE in
- % runtime/mercury_type_info.h, and must be kept in sync with it.
- % The documentation is located there as well.
-:- func base_type_layout__pseudo_typeinfo_exist_var_base = int.
-
-base_type_layout__pseudo_typeinfo_exist_var_base = 512.
-
-%---------------------------------------------------------------------------%
-%---------------------------------------------------------------------------%
-
-base_type_layout__gen_layout_info(ModuleName, TypeName, TypeArity, HldsDefn,
- ModuleInfo0, ModuleInfo, TypeCtorRep, NumFunctors,
- FunctorsInfo, LayoutInfo, NumPtags, TypeTables) :-
- hlds_data__get_type_defn_body(HldsDefn, TypeBody),
- module_info_get_cell_count(ModuleInfo0, CellNumber0),
- (
- TypeBody = uu_type(_Alts),
- error("type_ctor_layout: sorry, undiscriminated union unimplemented\n")
- ;
- TypeBody = abstract_type,
- TypeCtorRep = unknown,
- NumFunctors = -1,
- FunctorsInfo = no_functors,
- LayoutInfo = no_layout,
- TypeTables = [],
- CellNumber = CellNumber0,
- NumPtags = -1
- ;
- TypeBody = eqv_type(Type),
- ( term__is_ground(Type) ->
- TypeCtorRep = equiv(equiv_type_is_ground)
- ;
- TypeCtorRep = equiv(equiv_type_is_not_ground)
- ),
- NumFunctors = -1,
- UnivTvars = TypeArity,
- % There can be no existentially typed args to an
- % equivalence.
- ExistTvars = [],
- base_type_layout__construct_pseudo_type_info(Type,
- UnivTvars, ExistTvars, Rval, CellNumber0, CellNumber),
- FunctorsInfo = no_functors,
- LayoutInfo = equiv_layout(Rval),
- TypeTables = [],
- NumPtags = -1
- ;
- TypeBody = du_type(Ctors, ConsTagMap, Enum, EqualityPred),
- (
- EqualityPred = yes(_),
- EqualityAxioms = user_defined
- ;
- EqualityPred = no,
- EqualityAxioms = standard
- ),
- list__length(Ctors, NumFunctors),
- RttiTypeId = rtti_type_id(ModuleName, TypeName, TypeArity),
- (
- Enum = yes,
- TypeCtorRep = enum(EqualityAxioms),
- base_type_layout__make_enum_tables(Ctors, ConsTagMap,
- RttiTypeId, TypeTables,
- FunctorsInfo, LayoutInfo),
- CellNumber = CellNumber0,
- NumPtags = -1
- ;
- Enum = no,
- ( type_is_no_tag_type(Ctors, Name, ArgType) ->
- ( term__is_ground(ArgType) ->
- Inst = equiv_type_is_ground
- ;
- Inst = equiv_type_is_not_ground
- ),
- TypeCtorRep = notag(EqualityAxioms, Inst),
- base_type_layout__make_notag_tables(Name,
- ArgType, RttiTypeId,
- CellNumber0, CellNumber,
- TypeTables, FunctorsInfo, LayoutInfo),
- NumPtags = -1
- ;
- module_info_globals(ModuleInfo0, Globals),
- globals__lookup_int_option(Globals,
- num_tag_bits, NumTagBits),
- int__pow(2, NumTagBits, NumTags),
- MaxPtag = NumTags - 1,
- TypeCtorRep = du(EqualityAxioms),
- base_type_layout__make_du_tables(Ctors,
- ConsTagMap, MaxPtag, RttiTypeId,
- ModuleInfo0, CellNumber0, CellNumber,
- TypeTables, NumPtags,
- FunctorsInfo, LayoutInfo)
- )
- )
- ),
- module_info_set_cell_count(ModuleInfo0, CellNumber, ModuleInfo).
-
-%---------------------------------------------------------------------------%
-%---------------------------------------------------------------------------%
-
-% Make the functor and notag tables for a notag type.
-
-:- pred base_type_layout__make_notag_tables(sym_name::in, (type)::in,
- rtti_type_id::in, int::in, int::out, list(rtti_data)::out,
- type_ctor_functors_info::out, type_ctor_layout_info::out) is det.
-
-base_type_layout__make_notag_tables(SymName, ArgType, RttiTypeId,
- CellNumber0, CellNumber,
- TypeTables, FunctorsInfo, LayoutInfo) :-
- unqualify_name(SymName, FunctorName),
- RttiTypeId = rtti_type_id(_, _, UnivTvars),
- % There can be no existentially typed args to the functor
- % in a notag type.
- ExistTvars = [],
- base_type_layout__construct_pseudo_type_info(ArgType,
- UnivTvars, ExistTvars, Rval, CellNumber0, CellNumber),
- FunctorDesc = notag_functor_desc(RttiTypeId, FunctorName, Rval),
- FunctorRttiName = notag_functor_desc,
-
- FunctorsInfo = notag_functors(FunctorRttiName),
- LayoutInfo = notag_layout(FunctorRttiName),
- TypeTables = [FunctorDesc].
-
-%---------------------------------------------------------------------------%
-%---------------------------------------------------------------------------%
-
-:- type name_sort_info == assoc_list(pair(string, int), rtti_name).
-
-% Make the functor and notag tables for an enum type.
-
-:- pred base_type_layout__make_enum_tables(list(constructor)::in,
- cons_tag_values::in, rtti_type_id::in, list(rtti_data)::out,
- type_ctor_functors_info::out, type_ctor_layout_info::out) is det.
-
-base_type_layout__make_enum_tables(Ctors, ConsTagMap, RttiTypeId,
- TypeTables, FunctorInfo, LayoutInfo) :-
- base_type_layout__make_enum_functor_tables(Ctors, 0, ConsTagMap,
- RttiTypeId, FunctorDescs, OrdinalOrderRttiNames, SortInfo0),
- list__sort(SortInfo0, SortInfo),
- assoc_list__values(SortInfo, NameOrderedRttiNames),
-
- NameOrderedTable = enum_name_ordered_table(RttiTypeId,
- NameOrderedRttiNames),
- NameOrderedTableRttiName = enum_name_ordered_table,
- FunctorInfo = enum_functors(NameOrderedTableRttiName),
-
- ValueOrderedTable = enum_value_ordered_table(RttiTypeId,
- OrdinalOrderRttiNames),
- ValueOrderedTableRttiName = enum_value_ordered_table,
- LayoutInfo = enum_layout(ValueOrderedTableRttiName),
-
- TypeTables = [NameOrderedTable, ValueOrderedTable | FunctorDescs].
-
-% Create an enum_functor_desc structure for each functor in an enum type.
-% The functors are given to us in ordinal order (since that's how the HLDS
-% stored them), and that is how we return the list of rtti names of the
-% enum_functor_desc structures; that way, it is directly usable in the type
-% layout structure. We also return a structure that allows our caller to
-% sort this list on functor name, which is how the type functors structure
-% is constructed.
-
-:- pred base_type_layout__make_enum_functor_tables(list(constructor)::in,
- int::in, cons_tag_values::in, rtti_type_id::in,
- list(rtti_data)::out, list(rtti_name)::out,
- name_sort_info::out) is det.
-
-base_type_layout__make_enum_functor_tables([], _, _, _, [], [], []).
-base_type_layout__make_enum_functor_tables([Functor | Functors], NextOrdinal0,
- ConsTagMap, RttiTypeId,
- FunctorDescs, RttiNames, SortInfo) :-
- Functor = ctor(ExistTvars, Constraints, SymName, FunctorArgs),
- require(unify(ExistTvars, []),
- "existential arguments in functor in enum"),
- require(unify(Constraints, []),
- "class constraints on functor in enum"),
- list__length(FunctorArgs, Arity),
- require(unify(Arity, 0),
- "functor in enum has nonzero arity"),
- make_cons_id_from_qualified_sym_name(SymName, FunctorArgs, ConsId),
- map__lookup(ConsTagMap, ConsId, ConsTag),
- require(unify(ConsTag, int_constant(NextOrdinal0)),
- "mismatch on constant assigned to functor in enum"),
- unqualify_name(SymName, FunctorName),
- FunctorDesc = enum_functor_desc(RttiTypeId, FunctorName, NextOrdinal0),
- RttiName = enum_functor_desc(NextOrdinal0),
- FunctorSortInfo = (FunctorName - 0) - RttiName,
- base_type_layout__make_enum_functor_tables(Functors, NextOrdinal0 + 1,
- ConsTagMap, RttiTypeId, FunctorDescs1, RttiNames1, SortInfo1),
- FunctorDescs = [FunctorDesc | FunctorDescs1],
- RttiNames = [RttiName | RttiNames1],
- SortInfo = [FunctorSortInfo | SortInfo1].
-
-%---------------------------------------------------------------------------%
-%---------------------------------------------------------------------------%
-
-:- type tag_map == map(int, pair(sectag_locn, map(int, rtti_name))).
-:- type tag_list == assoc_list(int, pair(sectag_locn, map(int, rtti_name))).
-
-% Make the functor and notag tables for a du type.
-
-:- pred base_type_layout__make_du_tables(list(constructor)::in,
- cons_tag_values::in, int::in, rtti_type_id::in, module_info::in,
- int::in, int::out, list(rtti_data)::out, int::out,
- type_ctor_functors_info::out, type_ctor_layout_info::out) is det.
-
-base_type_layout__make_du_tables(Ctors, ConsTagMap, MaxPtag, RttiTypeId,
- ModuleInfo, CellNumber0, CellNumber,
- TypeTables, NumPtags, FunctorInfo, LayoutInfo) :-
- map__init(TagMap0),
- base_type_layout__make_du_functor_tables(Ctors, 0, ConsTagMap,
- RttiTypeId, ModuleInfo, CellNumber0, CellNumber,
- FunctorDescs, SortInfo0, TagMap0, TagMap),
- list__sort(SortInfo0, SortInfo),
- assoc_list__values(SortInfo, NameOrderedRttiNames),
-
- NameOrderedTable = du_name_ordered_table(RttiTypeId,
- NameOrderedRttiNames),
- NameOrderedTableRttiName = du_name_ordered_table,
- FunctorInfo = du_functors(NameOrderedTableRttiName),
-
- base_type_layout__make_du_ptag_ordered_table(TagMap, MaxPtag,
- RttiTypeId, ValueOrderedTableRttiName, ValueOrderedTables,
- NumPtags),
- LayoutInfo = du_layout(ValueOrderedTableRttiName),
- list__append([NameOrderedTable | FunctorDescs], ValueOrderedTables,
- TypeTables).
-
-% Create an enum_functor_desc structure for each functor in a du type.
-% Besides returning a list of the rtti names of their du_functor_desc
-% structures, we return two other items of information. The SortInfo
-% enables our caller to sort these rtti names on functor name and then arity,
-% which is how the type functors structure is constructed. The TagMap
-% groups the rttis into groups depending on their primary tags; this is
-% how the type layout structure is constructed.
-
-:- pred base_type_layout__make_du_functor_tables(list(constructor)::in,
- int::in, cons_tag_values::in, rtti_type_id::in, module_info::in,
- int::in, int::out, list(rtti_data)::out, name_sort_info::out,
- tag_map::in, tag_map::out) is det.
-
-base_type_layout__make_du_functor_tables([], _, _, _, _,
- CellNumber, CellNumber, [], [], TagMap, TagMap).
-base_type_layout__make_du_functor_tables([Functor | Functors], Ordinal,
- ConsTagMap, RttiTypeId, ModuleInfo, CellNumber0, CellNumber,
- Tables, SortInfo, TagMap0, TagMap) :-
- Functor = ctor(ExistTvars, Constraints, SymName, FunctorArgs),
- list__length(FunctorArgs, Arity),
- unqualify_name(SymName, FunctorName),
- RttiName = du_functor_desc(Ordinal),
- make_cons_id_from_qualified_sym_name(SymName, FunctorArgs, ConsId),
- map__lookup(ConsTagMap, ConsId, ConsTag),
- ( ConsTag = unshared_tag(ConsPtag) ->
- Locn = sectag_none,
- Ptag = ConsPtag,
- Stag = 0,
- base_type_layout__update_tag_info(Ptag, Stag, Locn, RttiName,
- TagMap0, TagMap1)
- ; ConsTag = shared_local_tag(ConsPtag, ConsStag) ->
- Locn = sectag_local,
- Ptag = ConsPtag,
- Stag = ConsStag,
- base_type_layout__update_tag_info(Ptag, Stag, Locn, RttiName,
- TagMap0, TagMap1)
- ; ConsTag = shared_remote_tag(ConsPtag, ConsStag) ->
- Locn = sectag_remote,
- Ptag = ConsPtag,
- Stag = ConsStag,
- base_type_layout__update_tag_info(Ptag, Stag, Locn, RttiName,
- TagMap0, TagMap1)
- ;
- error("unexpected cons_tag for du function symbol")
- ),
-
- base_type_layout__generate_arg_info_tables(ModuleInfo,
- RttiTypeId, Ordinal, FunctorArgs, ExistTvars,
- CellNumber0, CellNumber1, MaybeArgNames,
- ArgPseudoTypeInfoVector, FieldTables, ContainsVarBitVector),
- ( ExistTvars = [] ->
- MaybeExistInfo = no,
- ExistTables = []
- ;
- module_info_classes(ModuleInfo, ClassTable),
- base_type_layout__generate_type_info_locns(ExistTvars,
- Constraints, ClassTable, RttiTypeId, Ordinal,
- ExistInfo, ExistTables),
- MaybeExistInfo = yes(ExistInfo)
- ),
- list__append(FieldTables, ExistTables, SubTables),
- FunctorDesc = du_functor_desc(RttiTypeId, FunctorName, Ptag, Stag,
- Locn, Ordinal, Arity, ContainsVarBitVector,
- ArgPseudoTypeInfoVector, MaybeArgNames, MaybeExistInfo),
- FunctorSortInfo = (FunctorName - Arity) - RttiName,
- base_type_layout__make_du_functor_tables(Functors, Ordinal + 1,
- ConsTagMap, RttiTypeId, ModuleInfo, CellNumber1, CellNumber,
- Tables1, SortInfo1, TagMap1, TagMap),
- list__append([FunctorDesc | SubTables], Tables1, Tables),
- SortInfo = [FunctorSortInfo | SortInfo1].
-
-% Generate the tables that describe the arguments of a functor.
-
-:- pred base_type_layout__generate_arg_info_tables(module_info::in,
- rtti_type_id::in, int::in, list(constructor_arg)::in, existq_tvars::in,
- int::in, int::out, maybe(rtti_name)::out, rval::out,
- list(rtti_data)::out, int::out) is det.
-
-base_type_layout__generate_arg_info_tables(
- ModuleInfo, RttiTypeId, Ordinal,
- Args, ExistTvars, CellNumber0, CellNumber,
- MaybeFieldNamesRttiName, Vector, Tables,
- ContainsVarBitVector) :-
- RttiTypeId = rtti_type_id(_TypeModule, _TypeName, TypeArity),
- base_type_layout__generate_arg_infos(Args, TypeArity, ExistTvars,
- ModuleInfo, CellNumber0, CellNumber1,
- MaybeArgNames, LldsTypes, MaybePseudoTypeInfos,
- 0, 0, ContainsVarBitVector),
- list__filter((lambda([MaybeName::in] is semidet, MaybeName = yes(_))),
- MaybeArgNames, FieldNames),
- (
- FieldNames = [],
- MaybeFieldNamesRttiName = no,
- Tables = []
- ;
- FieldNames = [_|_],
- FieldNameTable = field_names(RttiTypeId, Ordinal,
- MaybeArgNames),
- FieldNamesRttiName = field_names(Ordinal),
- MaybeFieldNamesRttiName = yes(FieldNamesRttiName),
- Tables = [FieldNameTable]
- ),
- base_type_layout__get_next_cell_number(CellNumber1, CN, CellNumber),
- Reuse = no,
- Vector = create(0, MaybePseudoTypeInfos, initial(LldsTypes, none),
- must_be_static, CN, "arg_types", Reuse).
-
-% For each argument of a functor, return three items of information:
-% its name (if any), a pseudotypeinfo describing its type (and the llds_type
-% that describes the pseudotypeinfo), and an indication whether the type
-% contains variables or not. The last item is encoded as an integer
-% which contains a 1 bit in the position given by 1 << N if argument N's type
-% contains variables (assuming that arguments are numbered starting from zero).
-% The number of bits in the integer is given by contains_var_bit_vector_size;
-% arguments beyond this limit do not contribute to this bit vector.
-
-:- pred base_type_layout__generate_arg_infos(list(constructor_arg)::in,
- int::in, existq_tvars::in, module_info::in, int::in, int::out,
- list(maybe(string))::out, initial_arg_types::out,
- list(maybe(rval))::out, int::in, int::in, int::out) is det.
-
-base_type_layout__generate_arg_infos([], _, _, _,
- CellNumber, CellNumber, [], [], [],
- _, ContainsVarBitVector, ContainsVarBitVector).
-base_type_layout__generate_arg_infos([MaybeArgSymName - ArgType | Args],
- NumUnivTvars, ExistTvars, ModuleInfo, CellNumber0, CellNumber,
- [MaybeArgName | MaybeArgNames],
- [1 - yes(LldsType) | LldsTypes],
- [yes(PseudoTypeInfo) | MaybePseudoTypeInfos],
- ArgNum, ContainsVarBitVector0, ContainsVarBitVector) :-
- (
- MaybeArgSymName = yes(SymName),
- unqualify_name(SymName, ArgName),
- MaybeArgName = yes(ArgName)
- ;
- MaybeArgSymName = no,
- MaybeArgName = no
- ),
- base_type_layout__construct_typed_pseudo_type_info(ArgType,
- NumUnivTvars, ExistTvars, PseudoTypeInfo, LldsType,
- CellNumber0, CellNumber1),
- (
- ( term__is_ground(ArgType)
- ; ArgNum >= contains_var_bit_vector_size
- )
- ->
- ContainsVarBitVector1 = ContainsVarBitVector0
- ;
- ContainsVarBitVector1 = ContainsVarBitVector0 + (1 << ArgNum)
- ),
- base_type_layout__generate_arg_infos(Args, NumUnivTvars,
- ExistTvars, ModuleInfo, CellNumber1, CellNumber,
- MaybeArgNames, LldsTypes, MaybePseudoTypeInfos,
- ArgNum + 1, ContainsVarBitVector1, ContainsVarBitVector).
-
-% This function gives the size of the MR_du_functor_arg_type_contains_var
-% field of the C type MR_DuFunctorDesc in bits.
-
-:- func base_type_layout__contains_var_bit_vector_size = int.
-
-base_type_layout__contains_var_bit_vector_size = 16.
-
-% Construct the RTTI structures that record information about the locations
-% of the typeinfos describing the types of the existentially typed arguments
-% of a functor.
-
-:- pred base_type_layout__generate_type_info_locns(list(tvar)::in,
- list(class_constraint)::in, class_table::in, rtti_type_id::in, int::in,
- rtti_name::out, list(rtti_data)::out) is det.
-
-base_type_layout__generate_type_info_locns(ExistTvars, Constraints, ClassTable,
- RttiTypeId, Ordinal, exist_info(Ordinal),
- [ExistInfo, ExistLocns]) :-
- list__map((pred(C::in, Ts::out) is det :- C = constraint(_, Ts)),
- Constraints, ConstrainedTvars0),
- list__condense(ConstrainedTvars0, ConstrainedTvars1),
- term__vars_list(ConstrainedTvars1, ConstrainedTvars2),
- list__delete_elems(ExistTvars, ConstrainedTvars2, UnconstrainedTvars),
- % We do this to maintain the ordering of the type variables.
- list__delete_elems(ExistTvars, UnconstrainedTvars, ConstrainedTvars),
- map__init(LocnMap0),
- list__foldl2((pred(T::in, N0::in, N::out, Lm0::in, Lm::out) is det :-
- Locn = plain_typeinfo(N0),
- map__det_insert(Lm0, T, Locn, Lm),
- N = N0 + 1
- ), UnconstrainedTvars, 0, TIsPlain, LocnMap0, LocnMap1),
- list__length(ExistTvars, AllTIs),
- TIsInTCIs = AllTIs - TIsPlain,
- list__foldl(
- find_type_info_index(Constraints, ClassTable, TIsPlain),
- ConstrainedTvars, LocnMap1, LocnMap),
- list__length(Constraints, TCIs),
- ExistInfo = exist_info(RttiTypeId, Ordinal,
- TIsPlain, TIsInTCIs, TCIs, exist_locns(Ordinal)),
- list__map((pred(Tvar::in, Locn::out) is det :-
- map__lookup(LocnMap, Tvar, Locn)),
- ExistTvars, Locns),
- ExistLocns = exist_locns(RttiTypeId, Ordinal, Locns).
-
-:- pred find_type_info_index(list(class_constraint)::in, class_table::in,
- int::in, tvar::in, map(tvar, exist_typeinfo_locn)::in,
- map(tvar, exist_typeinfo_locn)::out) is det.
-
-find_type_info_index(Constraints, ClassTable, StartSlot, Tvar,
- LocnMap0, LocnMap) :-
- first_matching_type_class_info(Constraints, Tvar,
- FirstConstraint, StartSlot, Slot, TypeInfoIndex),
- FirstConstraint = constraint(ClassName, Args),
- list__length(Args, ClassArity),
- map__lookup(ClassTable, class_id(ClassName, ClassArity), ClassDefn),
- ClassDefn = hlds_class_defn(_, SuperClasses, _, _, _, _, _),
- list__length(SuperClasses, NumSuperClasses),
- RealTypeInfoIndex = TypeInfoIndex + NumSuperClasses,
- Locn = typeinfo_in_tci(Slot, RealTypeInfoIndex),
- map__det_insert(LocnMap0, Tvar, Locn, LocnMap).
-
-:- pred first_matching_type_class_info(list(class_constraint)::in, tvar::in,
- class_constraint::out, int::in, int::out, int::out) is det.
-
-first_matching_type_class_info([], _, _, _, _, _) :-
- error("base_type_layout: constrained type info not found").
-first_matching_type_class_info([C|Cs], Tvar, MatchingConstraint, N0, N,
- TypeInfoIndex) :-
- C = constraint(_, Ts),
- term__vars_list(Ts, TVs),
- ( list__nth_member_search(TVs, Tvar, Index) ->
- N = N0,
- MatchingConstraint = C,
- TypeInfoIndex = Index
- ;
- first_matching_type_class_info(Cs, Tvar, MatchingConstraint,
- N0 + 1, N, TypeInfoIndex)
- ).
-
-%---------------------------------------------------------------------------%
-
-:- pred base_type_layout__update_tag_info(int::in, int::in, sectag_locn::in,
- rtti_name::in, tag_map::in, tag_map::out) is det.
-
-base_type_layout__update_tag_info(Ptag, Stag, Locn, RttiName, TagMap0, TagMap)
- :-
- ( map__search(TagMap0, Ptag, OldLocn - OldSharerMap) ->
- ( Locn = sectag_none ->
- error("unshared ptag shared after all")
- ; OldLocn = Locn ->
- true
- ;
- error("disagreement on sectag location for ptag")
- ),
- map__det_insert(OldSharerMap, Stag, RttiName, NewSharerMap),
- map__det_update(TagMap0, Ptag, Locn - NewSharerMap, TagMap)
- ;
- map__init(NewSharerMap0),
- map__det_insert(NewSharerMap0, Stag, RttiName, NewSharerMap),
- map__det_insert(TagMap0, Ptag, Locn - NewSharerMap, TagMap)
- ).
-
-:- pred base_type_layout__make_du_ptag_ordered_table(tag_map::in, int::in,
- rtti_type_id::in, rtti_name::out, list(rtti_data)::out, int::out)
- is det.
-
-base_type_layout__make_du_ptag_ordered_table(TagMap, MaxPtagValue,
- RttiTypeId, PtagOrderedRttiName, Tables, NumPtags) :-
- map__to_assoc_list(TagMap, TagList),
- base_type_layout__make_du_ptag_layouts(TagList, 0, MaxPtagValue,
- RttiTypeId, PtagLayouts, SubTables, NumPtags),
- PtagOrderedTable = du_ptag_ordered_table(RttiTypeId, PtagLayouts),
- PtagOrderedRttiName = du_ptag_ordered_table,
- Tables = [PtagOrderedTable | SubTables].
-
-:- pred base_type_layout__make_du_ptag_layouts(tag_list::in, int::in, int::in,
- rtti_type_id::in, list(du_ptag_layout)::out, list(rtti_data)::out,
- int::out) is det.
-
-base_type_layout__make_du_ptag_layouts(TagList0, CurPtag, MaxPtag,
- RttiTypeId, PtagLayouts, Tables, NumPtags) :-
- (
- TagList0 = [],
- PtagLayouts = [],
- Tables = [],
- NumPtags = CurPtag
- ;
- TagList0 = [Ptag - (Locn - StagMap) | TagList],
- require(unify(CurPtag, Ptag),
- "missing ptag value in make_du_ptag_layout"),
- require(CurPtag =< MaxPtag,
- "ptag value exceeds maximum"),
- map__to_assoc_list(StagMap, StagList),
- list__length(StagList, StagListLength),
- base_type_layout__make_du_stag_table(0, StagListLength - 1,
- StagList, StagRttiNames),
- StagOrderedTable = du_stag_ordered_table(RttiTypeId,
- Ptag, StagRttiNames),
- StagOrderedAddr = du_stag_ordered_table(Ptag),
- PtagLayout = du_ptag_layout(StagListLength, Locn,
- StagOrderedAddr),
- base_type_layout__make_du_ptag_layouts(TagList,
- CurPtag + 1, MaxPtag, RttiTypeId,
- PtagLayouts1, Tables1, NumPtags),
- PtagLayouts = [PtagLayout | PtagLayouts1],
- Tables = [StagOrderedTable | Tables1]
- ).
-
-:- pred base_type_layout__make_du_stag_table(int::in, int::in,
- assoc_list(int, rtti_name)::in, list(rtti_name)::out) is det.
-
-base_type_layout__make_du_stag_table(CurStag, MaxStag, TagList0,
- StagRttiNames) :-
- ( CurStag =< MaxStag ->
- (
- TagList0 = [],
- error("short stag list in make_du_stag_table")
- ;
- TagList0 = [Stag - RttiName | TagList],
- require(unify(CurStag, Stag),
- "missing stag value in make_du_stag_table")
- ),
- base_type_layout__make_du_stag_table(CurStag + 1, MaxStag,
- TagList, StagRttiNames1),
- StagRttiNames = [RttiName | StagRttiNames1]
- ;
- require(unify(TagList0, []),
- "leftover stag values in make_du_stag_table"),
- StagRttiNames = []
- ).
-
-%---------------------------------------------------------------------------%
-%---------------------------------------------------------------------------%
-
-:- pred base_type_layout__get_next_cell_number(int::in, int::out, int::out)
- is det.
-
-base_type_layout__get_next_cell_number(CellNumber0, Next, CellNumber) :-
- CellNumber = CellNumber0 + 1,
- Next = CellNumber.
-
-%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
diff -rubB --exclude CVS --exclude configure --exclude errs --exclude make_all.log --exclude Mmake.params --exclude Mmake.common --exclude mercury_conf.h --exclude mercury_conf.h --exclude .#* --exclude REDUNDANT_FILES ws15/compiler/mercury_compile.m ws15.rename/compiler/mercury_compile.m
--- ws15/compiler/mercury_compile.m Tue Feb 22 13:45:53 2000
+++ ws15.rename/compiler/mercury_compile.m Tue Mar 7 18:38:15 2000
@@ -41,7 +41,7 @@
:- import_module unused_args, lco, saved_vars, liveness.
:- import_module follow_code, live_vars, arg_info, store_alloc, goal_path.
:- import_module code_gen, optimize, export.
-:- import_module base_type_info, base_typeclass_info.
+:- import_module type_ctor_info, base_typeclass_info.
:- import_module rl_gen, rl_opt, rl_out.
:- import_module llds_common, transform_llds, llds_out.
:- import_module continuation_info, stack_layout.
@@ -1610,7 +1610,7 @@
maybe_write_string(Verbose,
"% Generating type_ctor_info structures..."),
maybe_flush_output(Verbose),
- { base_type_info__generate_hlds(HLDS0, HLDS) },
+ { type_ctor_info__generate_hlds(HLDS0, HLDS) },
maybe_write_string(Verbose, " done.\n"),
maybe_report_stats(Stats)
;
@@ -2035,7 +2035,7 @@
globals__io_lookup_bool_option(verbose, Verbose),
globals__io_lookup_bool_option(statistics, Stats),
globals__io_lookup_bool_option(common_data, CommonData),
- { base_type_info__generate_llds(HLDS0, HLDS1, TypeCtorTables) },
+ { type_ctor_info__generate_llds(HLDS0, HLDS1, TypeCtorTables) },
{ base_typeclass_info__generate_llds(HLDS1, TypeClassInfos) },
{ stack_layout__generate_llds(HLDS1, HLDS, GlobalData,
PossiblyDynamicLayouts, StaticLayouts, LayoutLabels) },
diff -rubB --exclude CVS --exclude configure --exclude errs --exclude make_all.log --exclude Mmake.params --exclude Mmake.common --exclude mercury_conf.h --exclude mercury_conf.h --exclude .#* --exclude REDUNDANT_FILES ws15/compiler/ml_base_type_info.m ws15.rename/compiler/ml_base_type_info.m
--- ws15/compiler/ml_base_type_info.m Mon Feb 21 20:32:01 2000
+++ ws15.rename/compiler/ml_base_type_info.m Tue Mar 7 18:41:51 2000
@@ -12,7 +12,7 @@
% type information, including a description of the type_ctor_info structures.
%
% WARNING: if you change this file, you will probably also need to
-% modify base_type_info.m, which does the same thing for the LLDS back-end.
+% modify type_ctor_info.m, which does the same thing for the LLDS back-end.
%
% Author: fjh.
%
@@ -28,7 +28,7 @@
:- mode ml_base_type_info__generate_mlds(in, out) is det.
:- implementation.
-:- import_module base_type_info, ml_code_util.
+:- import_module type_ctor_info, ml_code_util.
:- import_module base_typeclass_info.
:- import_module prog_data, prog_util, prog_out.
diff -rubB --exclude CVS --exclude configure --exclude errs --exclude make_all.log --exclude Mmake.params --exclude Mmake.common --exclude mercury_conf.h --exclude mercury_conf.h --exclude .#* --exclude REDUNDANT_FILES ws15/compiler/notes/compiler_design.html ws15.rename/compiler/notes/compiler_design.html
--- ws15/compiler/notes/compiler_design.html Thu Mar 2 16:10:00 2000
+++ ws15.rename/compiler/notes/compiler_design.html Wed Mar 8 13:55:37 2000
@@ -847,15 +847,12 @@
<h4> 6a. Output C code </h4>
<ul>
-<li> base_type_info.m generates the base_type_info structures that list the
- unification, index and compare predicates associated with each declared
- type constructor. These are added to the LLDS.
-
-<li> base_type_layout.m generates the base_type_layout structures that give
- information on how to interpret values of a given type. It also
- creates base_type_functors structures that give information on
- the functors of a given type. The base_type_layout and base_type_functors
- structures of each declared type constructor are added to the LLDS.
+<li> type_ctor_info.m generates the type_ctor_gen_info structures that list
+ items of information (including unification, index and compare predicates)
+ associated with each declared type constructor that go into the static
+ type_ctor_info data structure. If the type_ctor_gen_info structure is not
+ eliminated as inaccessible, this module adds the corresponding type_ctor_info
+ structure to the LLDS.
<li> base_typeclass_info.m generates the base_typeclass_info structures that
list the methods of a class for each instance declaration. These are added to
@@ -864,6 +861,10 @@
<li> stack_layout.m generates the stack_layout structures for
accurate garbage collection. Tables are created from the data
collected in continuation_info.m.
+
+<li> Type_ctor_info structures and stack_layout structures both contain
+ pseudo_type_infos, which are type_infos with holes for type variables;
+ these are generated by pseudo_type_info.m.
<li> llds_common.m extracts static terms from the main body of the LLDS, and
puts them at the front. If a static term originally appeared several times,
diff -rubB --exclude CVS --exclude configure --exclude errs --exclude make_all.log --exclude Mmake.params --exclude Mmake.common --exclude mercury_conf.h --exclude mercury_conf.h --exclude .#* --exclude REDUNDANT_FILES ws15/compiler/stack_layout.m ws15.rename/compiler/stack_layout.m
--- ws15/compiler/stack_layout.m Tue Feb 29 14:02:33 2000
+++ ws15.rename/compiler/stack_layout.m Tue Mar 7 18:42:34 2000
@@ -253,7 +253,7 @@
:- implementation.
:- import_module globals, options, llds_out, trace.
-:- import_module hlds_data, hlds_pred, base_type_layout, prog_data, prog_out.
+:- import_module hlds_data, hlds_pred, pseudo_type_info, prog_data, prog_out.
:- import_module rtti, (inst), code_util.
:- import_module assoc_list, bool, string, int, require.
:- import_module map, term, set.
@@ -1297,7 +1297,7 @@
ExistQTvars = [],
NumUnivQTvars = -1,
- base_type_layout__construct_typed_pseudo_type_info(Type,
+ pseudo_type_info__construct_typed_pseudo_type_info(Type,
NumUnivQTvars, ExistQTvars, ArgRval, ArgRvalType, CNum0, CNum).
%---------------------------------------------------------------------------%
@@ -1363,7 +1363,7 @@
% variable number directly from the procedure's tvar set.
{ ExistQTvars = [] },
{ NumUnivQTvars = -1 },
- { base_type_layout__construct_typed_pseudo_type_info(Type,
+ { pseudo_type_info__construct_typed_pseudo_type_info(Type,
NumUnivQTvars, ExistQTvars,
Rval, LldsType, CNum0, CNum) },
stack_layout__set_cell_number(CNum).
diff -rubB --exclude CVS --exclude configure --exclude errs --exclude make_all.log --exclude Mmake.params --exclude Mmake.common --exclude mercury_conf.h --exclude mercury_conf.h --exclude .#* --exclude REDUNDANT_FILES ws15/runtime/mercury_type_info.h ws15.rename/runtime/mercury_type_info.h
--- ws15/runtime/mercury_type_info.h Tue Feb 29 17:11:13 2000
+++ ws15.rename/runtime/mercury_type_info.h Wed Mar 8 13:37:01 2000
@@ -14,13 +14,12 @@
** may also require changes in:
**
** compiler/polymorphism.m
+** compiler/pseudo_type_info.m
** compiler/higher_order.m
-** compiler/base_type_layout.m
**
** Changes to the structures of type_ctor_infos may require changes in:
**
-** compiler/base_type_info.m
-** compiler/base_type_layout.m
+** compiler/type_ctor_info.m
** compiler/rtti.m
** compiler/rtti_out.m
** (for updating the compiler-generated RTTI
@@ -37,7 +36,7 @@
** Both kinds of changes will of course also require changes to the code
** that traverses type_infos and type_ctor_infos:
**
-** runtime/mercury_deep_copy*.[ch]
+** runtime/mercury_deep_copy_body.h
** runtime/mercury_tabling.c
** runtime/mercury_type_info.c
** library/std_util.m
::::::::::::::
ws15.rename/compiler/pseudo_type_info.m
::::::::::::::
%---------------------------------------------------------------------------%
% Copyright (C) 1996-2000 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.
%---------------------------------------------------------------------------%
%
% This module generates representations for pseudo-type-infos.
%
% The documentation of the structures of pseudo-type-infos is in
% runtime/mercury_type_info.h; that file also contains a list of all
% the files that depend on such data structures.
%
% Authors: trd, zs.
%
%---------------------------------------------------------------------------%
:- module pseudo_type_info.
:- interface.
:- import_module llds, prog_data.
% pseudo_type_info__construct_typed_pseudo_type_info(Type,
% NumUnivQTvars, ExistQVars, Rval, LldsType, LabelNum0, LabelNum)
%
% Given a Mercury type (`Type'), this predicate returns an rval
% (`Rval') giving the pseudo type info for that type, plus the
% llds_type (`LldsType') of that rval.
%
% NumUnivQTvars is either the number of universally quantified type
% variables of the enclosing type (so that all universally quantified
% variables in the type have numbers in the range [1..NumUnivQTvars],
% or is the special value -1, meaning that all variables in the type
% are universally quantified. ExistQVars is the list of existentially
% quantified type variables of the constructor in question.
%
% The int arguments (`LabelNum0' and `LabelNum') are label numbers for
% generating `create' rvals with.
:- pred pseudo_type_info__construct_typed_pseudo_type_info((type)::in,
int::in, existq_tvars::in, rval::out, llds_type::out,
int::in, int::out) is det.
% This is the same as the previous predicate, but does not return
% the LLDS type.
:- pred pseudo_type_info__construct_pseudo_type_info((type)::in,
int::in, existq_tvars::in, rval::out, int::in, int::out) is det.
:- implementation.
:- import_module hlds_data, hlds_pred, hlds_out, builtin_ops, type_util.
:- import_module rtti, make_tags, code_util, globals, options, prog_util.
:- import_module list, assoc_list, bool, string, int, map, std_util, require.
:- import_module term.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
pseudo_type_info__construct_pseudo_type_info(Type, NumUnivQTvars,
ExistQTvars, Pseudo, CNum0, CNum) :-
pseudo_type_info__construct_typed_pseudo_type_info(Type, NumUnivQTvars,
ExistQTvars, Pseudo, _LldsType, CNum0, CNum).
pseudo_type_info__construct_typed_pseudo_type_info(Type, NumUnivQTvars,
ExistQTvars, Pseudo, LldsType, CNum0, CNum) :-
(
type_to_type_id(Type, TypeId, TypeArgs0)
->
(
% The argument to typeclass_info types is not
% a type - it encodes the class constraint.
mercury_private_builtin_module(PrivateBuiltin),
TypeId = qualified(PrivateBuiltin, TName) - _,
( TName = "typeclass_info"
; TName = "base_typeclass_info"
)
->
TypeArgs = []
;
TypeArgs = TypeArgs0
),
(
% For higher order types: they all refer to the
% defined pred_0 type_ctor_info, have an extra
% argument for their real arity, and then type
% arguments according to their types.
% polymorphism.m has a detailed explanation.
% XXX polymorphism.m does not have a
% detailed explanation.
type_is_higher_order(Type, _PredFunc,
_EvalMethod, _TypeArgs)
->
TypeModule = unqualified(""),
TypeName = "pred",
Arity = 0,
TypeId = _QualTypeName - RealArity,
RealArityArg = [yes(const(int_const(RealArity)))]
;
TypeId = QualTypeName - Arity,
unqualify_name(QualTypeName, TypeName),
sym_name_get_module_name(QualTypeName, unqualified(""),
TypeModule),
RealArityArg = []
),
RttiTypeId = rtti_type_id(TypeModule, TypeName, Arity),
DataAddr = rtti_addr(RttiTypeId, type_ctor_info),
Pseudo0 = yes(const(data_addr_const(DataAddr))),
LldsType = data_ptr,
CNum1 = CNum0 + 1,
% generate args, but remove one level of create()s.
list__map_foldl((pred(T::in, P::out, C0::in, C::out) is det :-
pseudo_type_info__construct_pseudo_type_info(
T, NumUnivQTvars, ExistQTvars, P, C0, C)
), TypeArgs, PseudoArgs0, CNum1, CNum),
list__map(pseudo_type_info__remove_create,
PseudoArgs0, PseudoArgs1),
list__append(RealArityArg, PseudoArgs1, PseudoArgs),
Reuse = no,
Pseudo = create(0, [Pseudo0 | PseudoArgs], uniform(no),
must_be_static, CNum1, "type_layout", Reuse)
;
type_util__var(Type, Var)
->
% In the case of a type variable, we need to assign a
% variable number *for this constructor*, i.e. taking
% only the existentially quantified variables of
% this constructor (and not those of other functors in
% the same type) into account.
% XXX term__var_to_int doesn't guarantee anything
% about the ints returned (other than that they be
% distinct for different variables), but here we are
% relying more, specifically, on the integers being
% allocated densely (i.e. the first N vars get integers
% 1 to N).
term__var_to_int(Var, VarInt0),
(
( VarInt0 =< NumUnivQTvars
; NumUnivQTvars < 0
)
->
% This is a universally quantified variable.
VarInt = VarInt0
;
% It is existentially quantified.
(
list__nth_member_search(ExistQTvars,
Var, ExistNum0)
->
VarInt = ExistNum0 +
pseudo_type_info__pseudo_typeinfo_exist_var_base
;
error("base_type_layout: var not in list")
)
),
require(VarInt =< pseudo_type_info__pseudo_typeinfo_max_var,
"type_ctor_layout: type variable representation exceeds limit"),
Pseudo = const(int_const(VarInt)),
LldsType = integer,
CNum = CNum0
;
error("type_ctor_layout: type neither var nor non-var")
).
% Remove a create() from an rval, if present.
:- pred pseudo_type_info__remove_create(rval::in, maybe(rval)::out) is det.
pseudo_type_info__remove_create(Rval0, MaybeRval) :-
( Rval0 = create(_, [PTI], _, _, _, _, _) ->
MaybeRval = PTI
;
MaybeRval = yes(Rval0)
).
%---------------------------------------------------------------------------%
% This number corresponds to MR_PSEUDOTYPEINFO_MAX_VAR in
% runtime/mercury_type_info.h, and must be kept in sync with it.
% The documentation is located there as well.
:- func pseudo_type_info__pseudo_typeinfo_max_var = int.
pseudo_type_info__pseudo_typeinfo_max_var = 1024.
% This number corresponds to MR_PSEUDOTYPEINFO_EXIST_VAR_BASE in
% runtime/mercury_type_info.h, and must be kept in sync with it.
% The documentation is located there as well.
:- func pseudo_type_info__pseudo_typeinfo_exist_var_base = int.
pseudo_type_info__pseudo_typeinfo_exist_var_base = 512.
%---------------------------------------------------------------------------%
::::::::::::::
ws15.rename/compiler/type_ctor_info.m
::::::::::::::
%---------------------------------------------------------------------------%
% Copyright (C) 1996-2000 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: type_ctor_info.m.
% Authors: zs, trd.
%
% This module is responsible for the generation of the static type_ctor_info
% structures of the types defined by the current module. This includes the
% RTTI data structures that describe the representation of each type.
% These structures form the type_ctor_rep, type_num_functors, type_functors
% and type_layout fields of a type_ctor_info. This RTTI information is
% used for several purposes: examples include deep copy, tabling, and functor,
% arg and their cousins.
%
% Since it is possible for the type_ctor_info of a type local to the module
% not to be referred to anywhere in the module (and therefore, not to be
% referred to anywhere in the program), this module works in two stages.
% In the first stage, it inserts type_ctor_gen_info structures describing the
% type_ctor_infos of all the locally-defined types into the HLDS; some of
% these type_ctor_gen_infos are later eliminated by dead_proc_elim.m. The
% second stage then generates low-level descriptions of type_ctor_infos
% for LLDS (or later MLDS) from the surviving type_ctor_gen_infos.
%
% The representation we build is designed to be independent of whether
% the compiler is generating LLDS or MLDS. However, at the moment, we
% still generate some LLDS rvals to represent typeinfos and pseudotypeinfos.
% These `create' rvals are expected to be removed by llds_common.m to
% create static structures.
%
% The documentation of the data structures built in this module is in
% runtime/mercury_type_info.h; that file also contains a list of all
% the files that depend on these data structures.
%
% WARNING: if you change this module, you will probably need to also
% change ml_base_type_info.m, which does the same thing for the MLDS
% back-end.
%
%---------------------------------------------------------------------------%
:- module type_ctor_info.
:- interface.
:- import_module hlds_module, llds.
:- import_module list.
:- pred type_ctor_info__generate_hlds(module_info::in, module_info::out)
is det.
:- pred type_ctor_info__generate_llds(module_info::in, module_info::out,
list(comp_gen_c_data)::out) is det.
:- implementation.
:- import_module rtti, pseudo_type_info.
:- import_module hlds_data, hlds_pred, hlds_out.
:- import_module make_tags, prog_data, prog_util, prog_out.
:- import_module code_util, special_pred, type_util, globals, options.
:- import_module builtin_ops.
:- import_module bool, string, int, map, std_util, assoc_list, require.
:- import_module term.
%---------------------------------------------------------------------------%
type_ctor_info__generate_hlds(ModuleInfo0, ModuleInfo) :-
module_info_name(ModuleInfo0, ModuleName),
module_info_types(ModuleInfo0, TypeTable),
map__keys(TypeTable, TypeIds),
type_ctor_info__gen_type_ctor_gen_infos(TypeIds, TypeTable, ModuleName,
ModuleInfo0, TypeCtorGenInfos),
module_info_set_type_ctor_gen_infos(ModuleInfo0, TypeCtorGenInfos,
ModuleInfo).
% Given a list of the ids of all the types in the type table,
% find the types defined in this module, and return a type_ctor_gen_info
% for each.
:- pred type_ctor_info__gen_type_ctor_gen_infos(list(type_id)::in,
type_table::in, module_name::in, module_info::in,
list(type_ctor_gen_info)::out) is det.
type_ctor_info__gen_type_ctor_gen_infos([], _, _, _, []).
type_ctor_info__gen_type_ctor_gen_infos([TypeId | TypeIds], TypeTable,
ModuleName, ModuleInfo, TypeCtorGenInfos) :-
type_ctor_info__gen_type_ctor_gen_infos(TypeIds, TypeTable, ModuleName,
ModuleInfo, TypeCtorGenInfos1),
TypeId = SymName - TypeArity,
(
SymName = qualified(TypeModuleName, TypeName),
(
TypeModuleName = ModuleName,
map__lookup(TypeTable, TypeId, TypeDefn),
hlds_data__get_type_defn_body(TypeDefn, TypeBody),
TypeBody \= abstract_type,
\+ type_id_has_hand_defined_rtti(TypeId)
->
type_ctor_info__gen_type_ctor_gen_info(TypeId,
TypeName, TypeArity, TypeDefn,
ModuleName, ModuleInfo, TypeCtorGenInfo),
TypeCtorGenInfos = [TypeCtorGenInfo | TypeCtorGenInfos1]
;
TypeCtorGenInfos = TypeCtorGenInfos1
)
;
SymName = unqualified(TypeName),
string__append_list(["unqualified type ", TypeName,
"found in type_ctor_info"], Msg),
error(Msg)
).
:- pred type_ctor_info__gen_type_ctor_gen_info(type_id::in, string::in,
int::in, hlds_type_defn::in, module_name::in, module_info::in,
type_ctor_gen_info::out) is det.
type_ctor_info__gen_type_ctor_gen_info(TypeId, TypeName, TypeArity, TypeDefn,
ModuleName, ModuleInfo, TypeCtorGenInfo) :-
hlds_data__get_type_defn_status(TypeDefn, Status),
module_info_get_special_pred_map(ModuleInfo, SpecMap),
map__lookup(SpecMap, unify - TypeId, UnifyPredId),
special_pred_mode_num(unify, UnifyProcInt),
proc_id_to_int(UnifyProcId, UnifyProcInt),
MaybeUnify = yes(proc(UnifyPredId, UnifyProcId)),
map__lookup(SpecMap, index - TypeId, IndexPredId),
special_pred_mode_num(index, IndexProcInt),
proc_id_to_int(IndexProcId, IndexProcInt),
MaybeIndex = yes(proc(IndexPredId, IndexProcId)),
map__lookup(SpecMap, compare - TypeId, ComparePredId),
special_pred_mode_num(compare, CompareProcInt),
proc_id_to_int(CompareProcId, CompareProcInt),
MaybeCompare = yes(proc(ComparePredId, CompareProcId)),
TypeCtorGenInfo = type_ctor_gen_info(TypeId, ModuleName,
TypeName, TypeArity, Status, TypeDefn,
MaybeUnify, MaybeIndex, MaybeCompare,
no, no, no).
%---------------------------------------------------------------------------%
type_ctor_info__generate_llds(ModuleInfo0, ModuleInfo, Tables) :-
module_info_type_ctor_gen_infos(ModuleInfo0, TypeCtorGenInfos),
type_ctor_info__construct_type_ctor_infos(TypeCtorGenInfos,
ModuleInfo0, ModuleInfo, [], Dynamic0, [], Static0),
list__map(llds__wrap_rtti_data, Dynamic0, Dynamic),
list__map(llds__wrap_rtti_data, Static0, Static),
list__append(Dynamic, Static, Tables).
:- pred type_ctor_info__construct_type_ctor_infos(
list(type_ctor_gen_info)::in, module_info::in, module_info::out,
list(rtti_data)::in, list(rtti_data)::out,
list(rtti_data)::in, list(rtti_data)::out) is det.
type_ctor_info__construct_type_ctor_infos([], ModuleInfo, ModuleInfo,
Dynamic, Dynamic, Static, Static).
type_ctor_info__construct_type_ctor_infos(
[TypeCtorGenInfo | TypeCtorGenInfos], ModuleInfo0, ModuleInfo,
Dynamic0, Dynamic, Static0, Static) :-
type_ctor_info__construct_type_ctor_info(TypeCtorGenInfo,
ModuleInfo0, ModuleInfo1, TypeCtorCModule, TypeCtorTables),
Dynamic1 = [TypeCtorCModule | Dynamic0],
list__append(TypeCtorTables, Static0, Static1),
type_ctor_info__construct_type_ctor_infos(TypeCtorGenInfos,
ModuleInfo1, ModuleInfo, Dynamic1, Dynamic, Static1, Static).
:- pred type_ctor_info__construct_type_ctor_info(type_ctor_gen_info::in,
module_info::in, module_info::out,
rtti_data::out, list(rtti_data)::out) is det.
type_ctor_info__construct_type_ctor_info(TypeCtorGenInfo,
ModuleInfo0, ModuleInfo, TypeCtorData, TypeCtorTables) :-
TypeCtorGenInfo = type_ctor_gen_info(_TypeId, ModuleName, TypeName,
TypeArity, _Status, HldsDefn,
MaybeUnify, MaybeIndex, MaybeCompare,
MaybeSolver, MaybeInit, MaybePretty),
type_ctor_info__make_pred_addr(MaybeUnify, ModuleInfo, Unify),
type_ctor_info__make_pred_addr(MaybeIndex, ModuleInfo, Index),
type_ctor_info__make_pred_addr(MaybeCompare, ModuleInfo, Compare),
type_ctor_info__make_pred_addr(MaybeSolver, ModuleInfo, Solver),
type_ctor_info__make_pred_addr(MaybeInit, ModuleInfo, Init),
type_ctor_info__make_pred_addr(MaybePretty, ModuleInfo, Pretty),
module_info_globals(ModuleInfo0, Globals),
globals__lookup_bool_option(Globals, type_layout, TypeLayoutOption),
( TypeLayoutOption = yes ->
type_ctor_info__gen_layout_info(ModuleName,
TypeName, TypeArity, HldsDefn, ModuleInfo0, ModuleInfo,
TypeCtorRep, NumFunctors, MaybeFunctors, MaybeLayout,
NumPtags, TypeCtorTables)
;
% This is for measuring code size only; if this path
% is ever taken, the resulting executable will not
% work.
TypeCtorRep = unknown,
NumPtags = -1,
NumFunctors = -1,
MaybeFunctors = no_functors,
MaybeLayout = no_layout,
TypeCtorTables = [],
ModuleInfo = ModuleInfo0
),
Version = type_ctor_info_rtti_version,
RttiTypeId = rtti_type_id(ModuleName, TypeName, TypeArity),
TypeCtorData = type_ctor_info(RttiTypeId, Unify, Index, Compare,
TypeCtorRep, Solver, Init, Version, NumPtags, NumFunctors,
MaybeFunctors, MaybeLayout, no, Pretty).
:- pred type_ctor_info__make_pred_addr(maybe(pred_proc_id)::in,
module_info::in, maybe(code_addr)::out) is det.
type_ctor_info__make_pred_addr(no, _ModuleInfo, no).
type_ctor_info__make_pred_addr(yes(PredProcId), ModuleInfo, yes(PredAddr)) :-
PredProcId = proc(PredId, ProcId),
code_util__make_entry_label(ModuleInfo, PredId, ProcId, no, PredAddr).
%---------------------------------------------------------------------------%
% The version of the RTTI data structures -- useful for bootstrapping.
% If you write runtime code that checks this version number and
% can at least handle the previous version of the data
% structure, it makes it easier to bootstrap changes to the data
% structures used for RTTI.
%
% This number should be kept in sync with MR_RTTI_VERSION in
% runtime/mercury_type_info.h. This means you need to update
% the handwritten type_ctor_info structures and the code in the
% runtime that uses RTTI to conform to whatever changes the new
% version introduces.
:- func type_ctor_info_rtti_version = int.
type_ctor_info_rtti_version = 4.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
% Generate RTTI layout information for the named type.
:- pred type_ctor_info__gen_layout_info(module_name::in,
string::in, int::in, hlds_type_defn::in,
module_info::in, module_info::out, type_ctor_rep::out, int::out,
type_ctor_functors_info::out, type_ctor_layout_info::out,
int::out, list(rtti_data)::out) is det.
type_ctor_info__gen_layout_info(ModuleName, TypeName, TypeArity, HldsDefn,
ModuleInfo0, ModuleInfo, TypeCtorRep, NumFunctors,
FunctorsInfo, LayoutInfo, NumPtags, TypeTables) :-
hlds_data__get_type_defn_body(HldsDefn, TypeBody),
module_info_get_cell_count(ModuleInfo0, CellNumber0),
(
TypeBody = uu_type(_Alts),
error("type_ctor_layout: sorry, undiscriminated union unimplemented\n")
;
TypeBody = abstract_type,
TypeCtorRep = unknown,
NumFunctors = -1,
FunctorsInfo = no_functors,
LayoutInfo = no_layout,
TypeTables = [],
CellNumber = CellNumber0,
NumPtags = -1
;
TypeBody = eqv_type(Type),
( term__is_ground(Type) ->
TypeCtorRep = equiv(equiv_type_is_ground)
;
TypeCtorRep = equiv(equiv_type_is_not_ground)
),
NumFunctors = -1,
UnivTvars = TypeArity,
% There can be no existentially typed args to an
% equivalence.
ExistTvars = [],
pseudo_type_info__construct_pseudo_type_info(Type,
UnivTvars, ExistTvars, Rval, CellNumber0, CellNumber),
FunctorsInfo = no_functors,
LayoutInfo = equiv_layout(Rval),
TypeTables = [],
NumPtags = -1
;
TypeBody = du_type(Ctors, ConsTagMap, Enum, EqualityPred),
(
EqualityPred = yes(_),
EqualityAxioms = user_defined
;
EqualityPred = no,
EqualityAxioms = standard
),
list__length(Ctors, NumFunctors),
RttiTypeId = rtti_type_id(ModuleName, TypeName, TypeArity),
(
Enum = yes,
TypeCtorRep = enum(EqualityAxioms),
type_ctor_info__make_enum_tables(Ctors, ConsTagMap,
RttiTypeId, TypeTables,
FunctorsInfo, LayoutInfo),
CellNumber = CellNumber0,
NumPtags = -1
;
Enum = no,
( type_is_no_tag_type(Ctors, Name, ArgType) ->
( term__is_ground(ArgType) ->
Inst = equiv_type_is_ground
;
Inst = equiv_type_is_not_ground
),
TypeCtorRep = notag(EqualityAxioms, Inst),
type_ctor_info__make_notag_tables(Name,
ArgType, RttiTypeId,
CellNumber0, CellNumber,
TypeTables, FunctorsInfo, LayoutInfo),
NumPtags = -1
;
module_info_globals(ModuleInfo0, Globals),
globals__lookup_int_option(Globals,
num_tag_bits, NumTagBits),
int__pow(2, NumTagBits, NumTags),
MaxPtag = NumTags - 1,
TypeCtorRep = du(EqualityAxioms),
type_ctor_info__make_du_tables(Ctors,
ConsTagMap, MaxPtag, RttiTypeId,
ModuleInfo0, CellNumber0, CellNumber,
TypeTables, NumPtags,
FunctorsInfo, LayoutInfo)
)
)
),
module_info_set_cell_count(ModuleInfo0, CellNumber, ModuleInfo).
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
% Make the functor and notag tables for a notag type.
:- pred type_ctor_info__make_notag_tables(sym_name::in, (type)::in,
rtti_type_id::in, int::in, int::out, list(rtti_data)::out,
type_ctor_functors_info::out, type_ctor_layout_info::out) is det.
type_ctor_info__make_notag_tables(SymName, ArgType, RttiTypeId,
CellNumber0, CellNumber,
TypeTables, FunctorsInfo, LayoutInfo) :-
unqualify_name(SymName, FunctorName),
RttiTypeId = rtti_type_id(_, _, UnivTvars),
% There can be no existentially typed args to the functor
% in a notag type.
ExistTvars = [],
pseudo_type_info__construct_pseudo_type_info(ArgType,
UnivTvars, ExistTvars, Rval, CellNumber0, CellNumber),
FunctorDesc = notag_functor_desc(RttiTypeId, FunctorName, Rval),
FunctorRttiName = notag_functor_desc,
FunctorsInfo = notag_functors(FunctorRttiName),
LayoutInfo = notag_layout(FunctorRttiName),
TypeTables = [FunctorDesc].
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- type name_sort_info == assoc_list(pair(string, int), rtti_name).
% Make the functor and notag tables for an enum type.
:- pred type_ctor_info__make_enum_tables(list(constructor)::in,
cons_tag_values::in, rtti_type_id::in, list(rtti_data)::out,
type_ctor_functors_info::out, type_ctor_layout_info::out) is det.
type_ctor_info__make_enum_tables(Ctors, ConsTagMap, RttiTypeId,
TypeTables, FunctorInfo, LayoutInfo) :-
type_ctor_info__make_enum_functor_tables(Ctors, 0, ConsTagMap,
RttiTypeId, FunctorDescs, OrdinalOrderRttiNames, SortInfo0),
list__sort(SortInfo0, SortInfo),
assoc_list__values(SortInfo, NameOrderedRttiNames),
NameOrderedTable = enum_name_ordered_table(RttiTypeId,
NameOrderedRttiNames),
NameOrderedTableRttiName = enum_name_ordered_table,
FunctorInfo = enum_functors(NameOrderedTableRttiName),
ValueOrderedTable = enum_value_ordered_table(RttiTypeId,
OrdinalOrderRttiNames),
ValueOrderedTableRttiName = enum_value_ordered_table,
LayoutInfo = enum_layout(ValueOrderedTableRttiName),
TypeTables = [NameOrderedTable, ValueOrderedTable | FunctorDescs].
% Create an enum_functor_desc structure for each functor in an enum type.
% The functors are given to us in ordinal order (since that's how the HLDS
% stored them), and that is how we return the list of rtti names of the
% enum_functor_desc structures; that way, it is directly usable in the type
% layout structure. We also return a structure that allows our caller to
% sort this list on functor name, which is how the type functors structure
% is constructed.
:- pred type_ctor_info__make_enum_functor_tables(list(constructor)::in,
int::in, cons_tag_values::in, rtti_type_id::in,
list(rtti_data)::out, list(rtti_name)::out,
name_sort_info::out) is det.
type_ctor_info__make_enum_functor_tables([], _, _, _, [], [], []).
type_ctor_info__make_enum_functor_tables([Functor | Functors], NextOrdinal0,
ConsTagMap, RttiTypeId,
FunctorDescs, RttiNames, SortInfo) :-
Functor = ctor(ExistTvars, Constraints, SymName, FunctorArgs),
require(unify(ExistTvars, []),
"existential arguments in functor in enum"),
require(unify(Constraints, []),
"class constraints on functor in enum"),
list__length(FunctorArgs, Arity),
require(unify(Arity, 0),
"functor in enum has nonzero arity"),
make_cons_id_from_qualified_sym_name(SymName, FunctorArgs, ConsId),
map__lookup(ConsTagMap, ConsId, ConsTag),
require(unify(ConsTag, int_constant(NextOrdinal0)),
"mismatch on constant assigned to functor in enum"),
unqualify_name(SymName, FunctorName),
FunctorDesc = enum_functor_desc(RttiTypeId, FunctorName, NextOrdinal0),
RttiName = enum_functor_desc(NextOrdinal0),
FunctorSortInfo = (FunctorName - 0) - RttiName,
type_ctor_info__make_enum_functor_tables(Functors, NextOrdinal0 + 1,
ConsTagMap, RttiTypeId, FunctorDescs1, RttiNames1, SortInfo1),
FunctorDescs = [FunctorDesc | FunctorDescs1],
RttiNames = [RttiName | RttiNames1],
SortInfo = [FunctorSortInfo | SortInfo1].
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- type tag_map == map(int, pair(sectag_locn, map(int, rtti_name))).
:- type tag_list == assoc_list(int, pair(sectag_locn, map(int, rtti_name))).
% Make the functor and notag tables for a du type.
:- pred type_ctor_info__make_du_tables(list(constructor)::in,
cons_tag_values::in, int::in, rtti_type_id::in, module_info::in,
int::in, int::out, list(rtti_data)::out, int::out,
type_ctor_functors_info::out, type_ctor_layout_info::out) is det.
type_ctor_info__make_du_tables(Ctors, ConsTagMap, MaxPtag, RttiTypeId,
ModuleInfo, CellNumber0, CellNumber,
TypeTables, NumPtags, FunctorInfo, LayoutInfo) :-
map__init(TagMap0),
type_ctor_info__make_du_functor_tables(Ctors, 0, ConsTagMap,
RttiTypeId, ModuleInfo, CellNumber0, CellNumber,
FunctorDescs, SortInfo0, TagMap0, TagMap),
list__sort(SortInfo0, SortInfo),
assoc_list__values(SortInfo, NameOrderedRttiNames),
NameOrderedTable = du_name_ordered_table(RttiTypeId,
NameOrderedRttiNames),
NameOrderedTableRttiName = du_name_ordered_table,
FunctorInfo = du_functors(NameOrderedTableRttiName),
type_ctor_info__make_du_ptag_ordered_table(TagMap, MaxPtag,
RttiTypeId, ValueOrderedTableRttiName, ValueOrderedTables,
NumPtags),
LayoutInfo = du_layout(ValueOrderedTableRttiName),
list__append([NameOrderedTable | FunctorDescs], ValueOrderedTables,
TypeTables).
% Create an enum_functor_desc structure for each functor in a du type.
% Besides returning a list of the rtti names of their du_functor_desc
% structures, we return two other items of information. The SortInfo
% enables our caller to sort these rtti names on functor name and then arity,
% which is how the type functors structure is constructed. The TagMap
% groups the rttis into groups depending on their primary tags; this is
% how the type layout structure is constructed.
:- pred type_ctor_info__make_du_functor_tables(list(constructor)::in,
int::in, cons_tag_values::in, rtti_type_id::in, module_info::in,
int::in, int::out, list(rtti_data)::out, name_sort_info::out,
tag_map::in, tag_map::out) is det.
type_ctor_info__make_du_functor_tables([], _, _, _, _,
CellNumber, CellNumber, [], [], TagMap, TagMap).
type_ctor_info__make_du_functor_tables([Functor | Functors], Ordinal,
ConsTagMap, RttiTypeId, ModuleInfo, CellNumber0, CellNumber,
Tables, SortInfo, TagMap0, TagMap) :-
Functor = ctor(ExistTvars, Constraints, SymName, FunctorArgs),
list__length(FunctorArgs, Arity),
unqualify_name(SymName, FunctorName),
RttiName = du_functor_desc(Ordinal),
make_cons_id_from_qualified_sym_name(SymName, FunctorArgs, ConsId),
map__lookup(ConsTagMap, ConsId, ConsTag),
( ConsTag = unshared_tag(ConsPtag) ->
Locn = sectag_none,
Ptag = ConsPtag,
Stag = 0,
type_ctor_info__update_tag_info(Ptag, Stag, Locn, RttiName,
TagMap0, TagMap1)
; ConsTag = shared_local_tag(ConsPtag, ConsStag) ->
Locn = sectag_local,
Ptag = ConsPtag,
Stag = ConsStag,
type_ctor_info__update_tag_info(Ptag, Stag, Locn, RttiName,
TagMap0, TagMap1)
; ConsTag = shared_remote_tag(ConsPtag, ConsStag) ->
Locn = sectag_remote,
Ptag = ConsPtag,
Stag = ConsStag,
type_ctor_info__update_tag_info(Ptag, Stag, Locn, RttiName,
TagMap0, TagMap1)
;
error("unexpected cons_tag for du function symbol")
),
type_ctor_info__generate_arg_info_tables(ModuleInfo,
RttiTypeId, Ordinal, FunctorArgs, ExistTvars,
CellNumber0, CellNumber1, MaybeArgNames,
ArgPseudoTypeInfoVector, FieldTables, ContainsVarBitVector),
( ExistTvars = [] ->
MaybeExistInfo = no,
ExistTables = []
;
module_info_classes(ModuleInfo, ClassTable),
type_ctor_info__generate_type_info_locns(ExistTvars,
Constraints, ClassTable, RttiTypeId, Ordinal,
ExistInfo, ExistTables),
MaybeExistInfo = yes(ExistInfo)
),
list__append(FieldTables, ExistTables, SubTables),
FunctorDesc = du_functor_desc(RttiTypeId, FunctorName, Ptag, Stag,
Locn, Ordinal, Arity, ContainsVarBitVector,
ArgPseudoTypeInfoVector, MaybeArgNames, MaybeExistInfo),
FunctorSortInfo = (FunctorName - Arity) - RttiName,
type_ctor_info__make_du_functor_tables(Functors, Ordinal + 1,
ConsTagMap, RttiTypeId, ModuleInfo, CellNumber1, CellNumber,
Tables1, SortInfo1, TagMap1, TagMap),
list__append([FunctorDesc | SubTables], Tables1, Tables),
SortInfo = [FunctorSortInfo | SortInfo1].
% Generate the tables that describe the arguments of a functor.
:- pred type_ctor_info__generate_arg_info_tables(module_info::in,
rtti_type_id::in, int::in, list(constructor_arg)::in, existq_tvars::in,
int::in, int::out, maybe(rtti_name)::out, rval::out,
list(rtti_data)::out, int::out) is det.
type_ctor_info__generate_arg_info_tables(
ModuleInfo, RttiTypeId, Ordinal,
Args, ExistTvars, CellNumber0, CellNumber,
MaybeFieldNamesRttiName, Vector, Tables,
ContainsVarBitVector) :-
RttiTypeId = rtti_type_id(_TypeModule, _TypeName, TypeArity),
type_ctor_info__generate_arg_infos(Args, TypeArity, ExistTvars,
ModuleInfo, CellNumber0, CellNumber1,
MaybeArgNames, LldsTypes, MaybePseudoTypeInfos,
0, 0, ContainsVarBitVector),
list__filter((lambda([MaybeName::in] is semidet, MaybeName = yes(_))),
MaybeArgNames, FieldNames),
(
FieldNames = [],
MaybeFieldNamesRttiName = no,
Tables = []
;
FieldNames = [_|_],
FieldNameTable = field_names(RttiTypeId, Ordinal,
MaybeArgNames),
FieldNamesRttiName = field_names(Ordinal),
MaybeFieldNamesRttiName = yes(FieldNamesRttiName),
Tables = [FieldNameTable]
),
type_ctor_info__get_next_cell_number(CellNumber1, CN, CellNumber),
Reuse = no,
Vector = create(0, MaybePseudoTypeInfos, initial(LldsTypes, none),
must_be_static, CN, "arg_types", Reuse).
% For each argument of a functor, return three items of information:
% its name (if any), a pseudotypeinfo describing its type (and the llds_type
% that describes the pseudotypeinfo), and an indication whether the type
% contains variables or not. The last item is encoded as an integer
% which contains a 1 bit in the position given by 1 << N if argument N's type
% contains variables (assuming that arguments are numbered starting from zero).
% The number of bits in the integer is given by contains_var_bit_vector_size;
% arguments beyond this limit do not contribute to this bit vector.
:- pred type_ctor_info__generate_arg_infos(list(constructor_arg)::in,
int::in, existq_tvars::in, module_info::in, int::in, int::out,
list(maybe(string))::out, initial_arg_types::out,
list(maybe(rval))::out, int::in, int::in, int::out) is det.
type_ctor_info__generate_arg_infos([], _, _, _,
CellNumber, CellNumber, [], [], [],
_, ContainsVarBitVector, ContainsVarBitVector).
type_ctor_info__generate_arg_infos([MaybeArgSymName - ArgType | Args],
NumUnivTvars, ExistTvars, ModuleInfo, CellNumber0, CellNumber,
[MaybeArgName | MaybeArgNames],
[1 - yes(LldsType) | LldsTypes],
[yes(PseudoTypeInfo) | MaybePseudoTypeInfos],
ArgNum, ContainsVarBitVector0, ContainsVarBitVector) :-
(
MaybeArgSymName = yes(SymName),
unqualify_name(SymName, ArgName),
MaybeArgName = yes(ArgName)
;
MaybeArgSymName = no,
MaybeArgName = no
),
pseudo_type_info__construct_typed_pseudo_type_info(ArgType,
NumUnivTvars, ExistTvars, PseudoTypeInfo, LldsType,
CellNumber0, CellNumber1),
(
( term__is_ground(ArgType)
; ArgNum >= contains_var_bit_vector_size
)
->
ContainsVarBitVector1 = ContainsVarBitVector0
;
ContainsVarBitVector1 = ContainsVarBitVector0 + (1 << ArgNum)
),
type_ctor_info__generate_arg_infos(Args, NumUnivTvars,
ExistTvars, ModuleInfo, CellNumber1, CellNumber,
MaybeArgNames, LldsTypes, MaybePseudoTypeInfos,
ArgNum + 1, ContainsVarBitVector1, ContainsVarBitVector).
% This function gives the size of the MR_du_functor_arg_type_contains_var
% field of the C type MR_DuFunctorDesc in bits.
:- func type_ctor_info__contains_var_bit_vector_size = int.
type_ctor_info__contains_var_bit_vector_size = 16.
% Construct the RTTI structures that record information about the locations
% of the typeinfos describing the types of the existentially typed arguments
% of a functor.
:- pred type_ctor_info__generate_type_info_locns(list(tvar)::in,
list(class_constraint)::in, class_table::in, rtti_type_id::in, int::in,
rtti_name::out, list(rtti_data)::out) is det.
type_ctor_info__generate_type_info_locns(ExistTvars, Constraints, ClassTable,
RttiTypeId, Ordinal, exist_info(Ordinal),
[ExistInfo, ExistLocns]) :-
list__map((pred(C::in, Ts::out) is det :- C = constraint(_, Ts)),
Constraints, ConstrainedTvars0),
list__condense(ConstrainedTvars0, ConstrainedTvars1),
term__vars_list(ConstrainedTvars1, ConstrainedTvars2),
list__delete_elems(ExistTvars, ConstrainedTvars2, UnconstrainedTvars),
% We do this to maintain the ordering of the type variables.
list__delete_elems(ExistTvars, UnconstrainedTvars, ConstrainedTvars),
map__init(LocnMap0),
list__foldl2((pred(T::in, N0::in, N::out, Lm0::in, Lm::out) is det :-
Locn = plain_typeinfo(N0),
map__det_insert(Lm0, T, Locn, Lm),
N = N0 + 1
), UnconstrainedTvars, 0, TIsPlain, LocnMap0, LocnMap1),
list__length(ExistTvars, AllTIs),
TIsInTCIs = AllTIs - TIsPlain,
list__foldl(
find_type_info_index(Constraints, ClassTable, TIsPlain),
ConstrainedTvars, LocnMap1, LocnMap),
list__length(Constraints, TCIs),
ExistInfo = exist_info(RttiTypeId, Ordinal,
TIsPlain, TIsInTCIs, TCIs, exist_locns(Ordinal)),
list__map((pred(Tvar::in, Locn::out) is det :-
map__lookup(LocnMap, Tvar, Locn)),
ExistTvars, Locns),
ExistLocns = exist_locns(RttiTypeId, Ordinal, Locns).
:- pred find_type_info_index(list(class_constraint)::in, class_table::in,
int::in, tvar::in, map(tvar, exist_typeinfo_locn)::in,
map(tvar, exist_typeinfo_locn)::out) is det.
find_type_info_index(Constraints, ClassTable, StartSlot, Tvar,
LocnMap0, LocnMap) :-
first_matching_type_class_info(Constraints, Tvar,
FirstConstraint, StartSlot, Slot, TypeInfoIndex),
FirstConstraint = constraint(ClassName, Args),
list__length(Args, ClassArity),
map__lookup(ClassTable, class_id(ClassName, ClassArity), ClassDefn),
ClassDefn = hlds_class_defn(_, SuperClasses, _, _, _, _, _),
list__length(SuperClasses, NumSuperClasses),
RealTypeInfoIndex = TypeInfoIndex + NumSuperClasses,
Locn = typeinfo_in_tci(Slot, RealTypeInfoIndex),
map__det_insert(LocnMap0, Tvar, Locn, LocnMap).
:- pred first_matching_type_class_info(list(class_constraint)::in, tvar::in,
class_constraint::out, int::in, int::out, int::out) is det.
first_matching_type_class_info([], _, _, _, _, _) :-
error("base_type_layout: constrained type info not found").
first_matching_type_class_info([C|Cs], Tvar, MatchingConstraint, N0, N,
TypeInfoIndex) :-
C = constraint(_, Ts),
term__vars_list(Ts, TVs),
( list__nth_member_search(TVs, Tvar, Index) ->
N = N0,
MatchingConstraint = C,
TypeInfoIndex = Index
;
first_matching_type_class_info(Cs, Tvar, MatchingConstraint,
N0 + 1, N, TypeInfoIndex)
).
%---------------------------------------------------------------------------%
:- pred type_ctor_info__update_tag_info(int::in, int::in, sectag_locn::in,
rtti_name::in, tag_map::in, tag_map::out) is det.
type_ctor_info__update_tag_info(Ptag, Stag, Locn, RttiName, TagMap0, TagMap)
:-
( map__search(TagMap0, Ptag, OldLocn - OldSharerMap) ->
( Locn = sectag_none ->
error("unshared ptag shared after all")
; OldLocn = Locn ->
true
;
error("disagreement on sectag location for ptag")
),
map__det_insert(OldSharerMap, Stag, RttiName, NewSharerMap),
map__det_update(TagMap0, Ptag, Locn - NewSharerMap, TagMap)
;
map__init(NewSharerMap0),
map__det_insert(NewSharerMap0, Stag, RttiName, NewSharerMap),
map__det_insert(TagMap0, Ptag, Locn - NewSharerMap, TagMap)
).
:- pred type_ctor_info__make_du_ptag_ordered_table(tag_map::in, int::in,
rtti_type_id::in, rtti_name::out, list(rtti_data)::out, int::out)
is det.
type_ctor_info__make_du_ptag_ordered_table(TagMap, MaxPtagValue,
RttiTypeId, PtagOrderedRttiName, Tables, NumPtags) :-
map__to_assoc_list(TagMap, TagList),
type_ctor_info__make_du_ptag_layouts(TagList, 0, MaxPtagValue,
RttiTypeId, PtagLayouts, SubTables, NumPtags),
PtagOrderedTable = du_ptag_ordered_table(RttiTypeId, PtagLayouts),
PtagOrderedRttiName = du_ptag_ordered_table,
Tables = [PtagOrderedTable | SubTables].
:- pred type_ctor_info__make_du_ptag_layouts(tag_list::in, int::in, int::in,
rtti_type_id::in, list(du_ptag_layout)::out, list(rtti_data)::out,
int::out) is det.
type_ctor_info__make_du_ptag_layouts(TagList0, CurPtag, MaxPtag,
RttiTypeId, PtagLayouts, Tables, NumPtags) :-
(
TagList0 = [],
PtagLayouts = [],
Tables = [],
NumPtags = CurPtag
;
TagList0 = [Ptag - (Locn - StagMap) | TagList],
require(unify(CurPtag, Ptag),
"missing ptag value in make_du_ptag_layout"),
require(CurPtag =< MaxPtag,
"ptag value exceeds maximum"),
map__to_assoc_list(StagMap, StagList),
list__length(StagList, StagListLength),
type_ctor_info__make_du_stag_table(0, StagListLength - 1,
StagList, StagRttiNames),
StagOrderedTable = du_stag_ordered_table(RttiTypeId,
Ptag, StagRttiNames),
StagOrderedAddr = du_stag_ordered_table(Ptag),
PtagLayout = du_ptag_layout(StagListLength, Locn,
StagOrderedAddr),
type_ctor_info__make_du_ptag_layouts(TagList,
CurPtag + 1, MaxPtag, RttiTypeId,
PtagLayouts1, Tables1, NumPtags),
PtagLayouts = [PtagLayout | PtagLayouts1],
Tables = [StagOrderedTable | Tables1]
).
:- pred type_ctor_info__make_du_stag_table(int::in, int::in,
assoc_list(int, rtti_name)::in, list(rtti_name)::out) is det.
type_ctor_info__make_du_stag_table(CurStag, MaxStag, TagList0,
StagRttiNames) :-
( CurStag =< MaxStag ->
(
TagList0 = [],
error("short stag list in make_du_stag_table")
;
TagList0 = [Stag - RttiName | TagList],
require(unify(CurStag, Stag),
"missing stag value in make_du_stag_table")
),
type_ctor_info__make_du_stag_table(CurStag + 1, MaxStag,
TagList, StagRttiNames1),
StagRttiNames = [RttiName | StagRttiNames1]
;
require(unify(TagList0, []),
"leftover stag values in make_du_stag_table"),
StagRttiNames = []
).
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- pred type_ctor_info__get_next_cell_number(int::in, int::out, int::out)
is det.
type_ctor_info__get_next_cell_number(CellNumber0, Next, CellNumber) :-
CellNumber = CellNumber0 + 1,
Next = CellNumber.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to: mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions: mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------
More information about the developers
mailing list