[m-dev.] diff: MLDS back-end: generate base_type_infos
Fergus Henderson
fjh at cs.mu.OZ.AU
Thu Dec 2 16:10:25 AEDT 1999
Estimated hours taken: 4
Implement the generation of base_type_info structures
for the MLDS back-end. (Generation of base_type_functors
and base_type_layouts is still not yet implemented, though.)
compiler/ml_base_type_info.m:
New file. This generates the base_type_info structures.
It is similar to base_type_info.m, but for the MLDS back-end.
compiler/ml_code_gen.m:
Change ml_gen_types to call ml_base_type_info__generate_mlds.
Export ml_gen_pred_label, for use by ml_base_type_info.m.
compiler/mlds.m:
Add a new MLDS type `mlds__base_type_info_type',
for base_type_infos.
compiler/mlds_to_c.m:
Add code to handle `mlds__base_type_info_type'.
Handle complex initializers.
Output proper module qualifiers for data names.
compiler/base_type_info.m:
Delete an obsolete comment.
Add a comment warning that any changes here may also require
changes to ml_base_type_info.m.
compiler/notes/compiler_design.html:
Mention the new module.
Workspace: /d-drive/home/hg/fjh/mercury
Index: compiler/base_type_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/base_type_info.m,v
retrieving revision 1.28
diff -u -d -r1.28 base_type_info.m
--- compiler/base_type_info.m 1999/10/28 06:21:54 1.28
+++ compiler/base_type_info.m 1999/12/02 03:29:14
@@ -4,20 +4,19 @@
% Public License - see the file COPYING in the Mercury distribution.
%---------------------------------------------------------------------------%
%
+% File: base_type_info.m.
+% Author: zs.
+%
% This module generates the LLDS code that defines global variables
% to hold the type_ctor_info structures of the types defined by the
% current module.
%
-% These global variables are needed only with when we are using the
-% shared-one-or-two-cell way of representing type information.
-% It is up to the caller to check this. (When using other representations,
-% defining these global variables is harmless except for adding to
-% compilation time and executable size.)
-%
% See polymorphism.m for a description of the various ways to represent
% type information, including a description of the type_ctor_info structures.
%
-% Author: zs.
+% WARNING: if you change this module, you will probably need to also
+% change ml_base_type_info.m, which does the smae thing for the MLDS
+% back-end.
%
%---------------------------------------------------------------------------%
Index: compiler/ml_code_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.19
diff -u -d -r1.19 ml_code_gen.m
--- compiler/ml_code_gen.m 1999/11/19 16:34:18 1.19
+++ compiler/ml_code_gen.m 1999/12/01 11:21:12
@@ -582,7 +582,7 @@
:- interface.
-:- import_module hlds_module, mlds.
+:- import_module hlds_module, hlds_pred, mlds.
:- import_module io.
%-----------------------------------------------------------------------------%
@@ -593,16 +593,21 @@
:- pred ml_code_gen(module_info, mlds, io__state, io__state).
:- mode ml_code_gen(in, out, di, uo) is det.
+ % Generate the mlds__pred_label for a given procedure.
+ %
+:- func ml_gen_pred_label(module_info, pred_id, proc_id) = mlds__pred_label.
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
+:- import_module ml_base_type_info.
:- import_module llds. % XXX needed for `code_model'.
:- import_module code_util. % XXX needed for `code_util__compiler_generated'.
% and `code_util__cons_id_to_tag'.
:- import_module goal_util.
-:- import_module hlds_pred, hlds_goal, hlds_data, prog_data, special_pred.
+:- import_module hlds_goal, hlds_data, prog_data, special_pred.
:- import_module hlds_out, builtin_ops, passes_aux, type_util, mode_util.
:- import_module prog_util.
:- import_module globals, options.
@@ -662,13 +667,8 @@
:- pred ml_gen_types(module_info, mlds__defns, io__state, io__state).
:- mode ml_gen_types(in, out, di, uo) is det.
-ml_gen_types(_ModuleInfo, MLDS_TypeDefns) -->
- /****
- { module_info_types(Module, TypeTable) },
- ...
- ****/
- % XXX not yet implemented
- { MLDS_TypeDefns = [] }.
+ml_gen_types(ModuleInfo, MLDS_BaseTypeInfoDefns) -->
+ { ml_base_type_info__generate_mlds(ModuleInfo, MLDS_BaseTypeInfoDefns) }.
%-----------------------------------------------------------------------------%
%
@@ -3993,7 +3993,6 @@
MLDS_PredLabel = ml_gen_pred_label(ModuleInfo, PredId, ProcId),
MLDS_Name = function(MLDS_PredLabel, ProcId, MaybeSeqNum, PredId).
-:- func ml_gen_pred_label(module_info, pred_id, proc_id) = mlds__pred_label.
ml_gen_pred_label(ModuleInfo, PredId, ProcId) = MLDS_PredLabel :-
module_info_pred_info(ModuleInfo, PredId, PredInfo),
pred_info_module(PredInfo, PredModule),
Index: compiler/mlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds.m,v
retrieving revision 1.13
diff -u -d -r1.13 mlds.m
--- compiler/mlds.m 1999/11/15 10:35:18 1.13
+++ compiler/mlds.m 1999/12/01 10:39:58
@@ -495,7 +495,9 @@
% if the target language doesn't supported
% nested functions, and also for handling
% closures for higher-order code.
- ; mlds__generic_env_ptr_type.
+ ; mlds__generic_env_ptr_type
+
+ ; mlds__base_type_info_type.
:- type mercury_type == prog_data__type.
Index: compiler/mlds_to_c.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.16
diff -u -d -r1.16 mlds_to_c.m
--- compiler/mlds_to_c.m 1999/11/18 18:05:24 1.16
+++ compiler/mlds_to_c.m 1999/12/01 12:03:06
@@ -8,7 +8,7 @@
% Main author: fjh.
% TODO:
-% - RTTI (base_type_info, base_type_layout, base_type_functors,
+% - RTTI (base_type_layout, base_type_functors,
% module_layout, proc_layout)
% - type classes (base_typeclass_info)
% - trail ops
@@ -400,8 +400,9 @@
io__write_string(" = "),
mlds_output_rval(SingleValue)
;
- % XXX we should eventually handle these...
- { error("sorry, complex initializers not yet implemented") }
+ io__write_string(" = {\n\t\t"),
+ io__write_list(Initializer, ",\n\t\t", mlds_output_rval),
+ io__write_string("}")
).
%-----------------------------------------------------------------------------%
@@ -662,8 +663,13 @@
mlds_output_data_name(common(Num)) -->
io__write_string("common_"),
io__write_int(Num).
-mlds_output_data_name(type_ctor(_BaseData, _Name, _Arity)) -->
- { error("mlds_to_c.m: NYI: type_ctor") }.
+mlds_output_data_name(type_ctor(BaseData, Name, Arity)) -->
+ io__write_string("base_type_"),
+ io__write(BaseData),
+ io__write_string("_"),
+ io__write_string(Name),
+ io__write_string("_"),
+ io__write_int(Arity).
mlds_output_data_name(base_typeclass_info(_ClassId, _InstanceId)) -->
{ error("mlds_to_c.m: NYI: basetypeclass_info") }.
mlds_output_data_name(module_layout) -->
@@ -720,6 +726,8 @@
io__write_string("MR_Box").
mlds_output_type(mlds__generic_env_ptr_type) -->
io__write_string("void *").
+mlds_output_type(mlds__base_type_info_type) -->
+ io__write_string("MR_BaseTypeInfo").
mlds_output_type(mlds__cont_type) -->
globals__io_lookup_bool_option(gcc_nested_functions, GCC_NestedFuncs),
( { GCC_NestedFuncs = yes } ->
@@ -1689,8 +1697,9 @@
:- pred mlds_output_data_addr(mlds__data_addr, io__state, io__state).
:- mode mlds_output_data_addr(in, di, uo) is det.
-mlds_output_data_addr(data_addr(_ModuleName, DataName)) -->
- io__write_string("/* XXX ModuleName */"),
+mlds_output_data_addr(data_addr(ModuleName, DataName)) -->
+ mlds_output_module_name(mlds_module_name_to_sym_name(ModuleName)),
+ io__write_string("__"),
mlds_output_data_name(DataName).
%-----------------------------------------------------------------------------%
Index: compiler/ml_base_type_info.m
===================================================================
RCS file: ml_base_type_info.m
diff -N ml_base_type_info.m
--- /dev/null Wed May 6 06:32:27 1998
+++ ml_base_type_info.m Thu Dec 2 14:25:49 1999
@@ -0,0 +1,316 @@
+%---------------------------------------------------------------------------%
+% Copyright (C) 1999 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 the MLDS code that defines the static constants
+% that hold the type_ctor_info structures of the types defined by the
+% current module.
+%
+% See polymorphism.m for a description of the various ways to represent
+% 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.
+%
+% Author: fjh.
+%
+%---------------------------------------------------------------------------%
+
+:- module ml_base_type_info.
+
+:- interface.
+
+:- import_module hlds_module, mlds.
+
+:- pred ml_base_type_info__generate_mlds(module_info, mlds__defns).
+:- mode ml_base_type_info__generate_mlds(in, out) is det.
+
+:- implementation.
+:- import_module base_type_info, ml_code_gen.
+
+:- import_module base_typeclass_info.
+:- 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 list.
+:- import_module bool, string, map, std_util, require.
+
+%---------------------------------------------------------------------------%
+
+ % 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 = 3.
+
+ml_base_type_info__generate_mlds(ModuleInfo, Defns) :-
+ module_info_base_gen_infos(ModuleInfo, BaseGenInfos),
+ ml_base_type_info__construct_type_ctor_infos(BaseGenInfos, ModuleInfo,
+ Defns).
+ /***
+ % XXX type classes are not yet implemented in the MLDS back-end
+ ml_base_typeclass_info__generate_mlds(ModuleInfo, Defns2),
+ % XXX make this use an accumulator
+ list__append(Defns1, Defns2, Defns).
+ ***/
+
+:- pred ml_base_type_info__construct_type_ctor_infos(list(base_gen_info),
+ module_info, mlds__defns).
+:- mode ml_base_type_info__construct_type_ctor_infos(in, in, out) is det.
+
+ml_base_type_info__construct_type_ctor_infos([], _, []).
+ml_base_type_info__construct_type_ctor_infos([BaseGenInfo | BaseGenInfos],
+ ModuleInfo, [Defn | Defns]) :-
+ BaseGenInfo = base_gen_info(_TypeId, ModuleName, TypeName, TypeArity,
+ Status, Elim, Procs, HLDS_TypeDefn),
+
+ status_is_exported(Status, Exported),
+ Flags = ml_gen_base_type_info_decl_flags(Exported),
+
+ ml_base_type_info__construct_pred_addrs(Procs, Elim, ModuleInfo,
+ PredAddrArgs),
+ ArityArg = const(int_const(TypeArity)),
+
+ module_info_globals(ModuleInfo, Globals),
+ globals__lookup_bool_option(Globals, type_layout, TypeLayoutOption),
+ (
+ TypeLayoutOption = yes
+ ->
+ ml_base_type_info__construct_type_ctor_representation(HLDS_TypeDefn,
+ TypeCtorArg),
+ /*****
+ % XXX generation of the base_type_layout and base_type_functors
+ % is not yet implemented for the MLDS back-end
+ ml_base_type_info__construct_layout(ModuleInfo, TypeName,
+ TypeArity, LayoutArg),
+ ml_base_type_info__construct_functors(ModuleInfo, TypeName,
+ TypeArity, FunctorsArg),
+ ******/
+ LayoutArg = const(int_const(0)),
+ FunctorsArg = const(int_const(0)),
+ prog_out__sym_name_to_string(ModuleName, ModuleNameString),
+ ModuleArg = const(string_const(ModuleNameString)),
+ NameArg = const(string_const(TypeName)),
+ VersionArg = const(int_const(type_ctor_info_rtti_version)),
+ list__append(PredAddrArgs, [TypeCtorArg, FunctorsArg, LayoutArg,
+ ModuleArg, NameArg, VersionArg], FinalArgs)
+ ;
+ FinalArgs = PredAddrArgs
+ ),
+
+ DataName = type_ctor(info, TypeName, TypeArity),
+ hlds_data__get_type_defn_context(HLDS_TypeDefn, Context),
+ MLDS_Context = mlds__make_context(Context),
+ Initializer = [ArityArg | FinalArgs],
+ MLDS_Type = mlds__base_type_info_type,
+ DefnBody = mlds__data(MLDS_Type, yes(Initializer)),
+ Defn = mlds__defn(data(DataName), MLDS_Context, Flags, DefnBody),
+
+ ml_base_type_info__construct_type_ctor_infos(BaseGenInfos, ModuleInfo,
+ Defns).
+
+ % Return the declaration flags appropriate for a base_type_info.
+ %
+:- func ml_gen_base_type_info_decl_flags(bool) = mlds__decl_flags.
+ml_gen_base_type_info_decl_flags(Exported) = MLDS_DeclFlags :-
+ ( Exported = yes ->
+ Access = public
+ ;
+ Access = private
+ ),
+ PerInstance = per_instance,
+ Virtuality = non_virtual,
+ Finality = overridable,
+ Constness = const,
+ Abstractness = concrete,
+ MLDS_DeclFlags = init_decl_flags(Access, PerInstance,
+ Virtuality, Finality, Constness, Abstractness).
+
+:- pred ml_base_type_info__construct_layout(module_info, string, int,
+ mlds__rval).
+:- mode ml_base_type_info__construct_layout(in, in, in, out) is det.
+ml_base_type_info__construct_layout(ModuleInfo, TypeName, TypeArity, Rval) :-
+ module_info_name(ModuleInfo, ModuleName),
+ MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName),
+ Rval = const(data_addr_const(data_addr(MLDS_ModuleName,
+ type_ctor(layout, TypeName, TypeArity)))).
+
+:- pred ml_base_type_info__construct_functors(module_info, string, int,
+ mlds__rval).
+:- mode ml_base_type_info__construct_functors(in, in, in, out) is det.
+ml_base_type_info__construct_functors(ModuleInfo, TypeName, TypeArity, Rval) :-
+ module_info_name(ModuleInfo, ModuleName),
+ MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName),
+ Rval = const(data_addr_const(data_addr(MLDS_ModuleName,
+ type_ctor(functors, TypeName, TypeArity)))).
+
+:- pred ml_base_type_info__construct_pred_addrs(list(pred_proc_id), maybe(int),
+ module_info, list(mlds__rval)).
+:- mode ml_base_type_info__construct_pred_addrs(in, in, in, out) is det.
+
+ml_base_type_info__construct_pred_addrs(Procs, Elim, ModuleInfo, PredAddrArgs) :-
+ (
+ % dead_proc_elim has eliminated the procs, we
+ % should just put some padding in.
+
+ Elim = yes(ProcsLength)
+ ->
+ /********
+ module_info_globals(ModuleInfo, Globals),
+ % If eliminated, make procs point to
+ % private_builtin__unused. (Or, if static code
+ % addresses are not available, use NULL
+ % pointers).
+ (
+ globals__have_static_code_addresses(Globals, yes)
+ ->
+ hlds_pred__initial_proc_id(ProcId),
+ mercury_private_builtin_module(MercuryBuiltin),
+ PredAddrArg = const(code_addr_const(
+ imported(proc(MercuryBuiltin, predicate,
+ MercuryBuiltin, "unused", 0,
+ ProcId))))
+ ;
+ PredAddrArg = const(int_const(0))
+ ),
+ *******/
+ PredAddrArg = const(int_const(0)),
+ list__duplicate(ProcsLength, PredAddrArg, PredAddrArgs)
+ ;
+ ml_base_type_info__construct_pred_addrs_2(Procs, ModuleInfo,
+ PredAddrArgs)
+ ).
+
+:- pred ml_base_type_info__construct_pred_addrs_2(list(pred_proc_id),
+ module_info, list(mlds__rval)).
+:- mode ml_base_type_info__construct_pred_addrs_2(in, in, out) is det.
+
+ml_base_type_info__construct_pred_addrs_2([], _, []).
+ml_base_type_info__construct_pred_addrs_2([proc(PredId, ProcId) | Procs],
+ ModuleInfo, [ProcAddrArg | ProcAddrArgs]) :-
+ %
+ % construct an rval for the address of this procedure
+ % (this is similar to ml_gen_proc_addr_rval)
+ %
+ PredLabel = ml_gen_pred_label(ModuleInfo, PredId, ProcId),
+ module_info_pred_info(ModuleInfo, PredId, PredInfo),
+ pred_info_module(PredInfo, PredModule),
+ MLDS_Module = mercury_module_name_to_mlds(PredModule),
+ QualifiedProcLabel = qual(MLDS_Module, PredLabel - ProcId),
+ ProcAddrArg = const(code_addr_const(proc(QualifiedProcLabel))),
+ %
+ % recursively handle the remaining procedures
+ %
+ ml_base_type_info__construct_pred_addrs_2(Procs, ModuleInfo,
+ ProcAddrArgs).
+
+
+:- type type_ctor_representation
+ ---> enum
+ ; enum_usereq
+ ; du
+ ; du_usereq
+ ; notag
+ ; notag_usereq
+ ; equiv
+ ; equiv_var
+ ; int
+ ; char
+ ; float
+ ; string
+ ; (pred)
+ ; univ
+ ; void
+ ; c_pointer
+ ; typeinfo
+ ; typeclassinfo
+ ; array
+ ; unknown.
+
+:- pred ml_base_type_info__type_ctor_rep_to_int(type_ctor_representation::in,
+ int::out) is det.
+ml_base_type_info__type_ctor_rep_to_int(enum, 0).
+ml_base_type_info__type_ctor_rep_to_int(enum_usereq, 1).
+ml_base_type_info__type_ctor_rep_to_int(du, 2).
+ml_base_type_info__type_ctor_rep_to_int(du_usereq, 3).
+ml_base_type_info__type_ctor_rep_to_int(notag, 4).
+ml_base_type_info__type_ctor_rep_to_int(notag_usereq, 5).
+ml_base_type_info__type_ctor_rep_to_int(equiv, 6).
+ml_base_type_info__type_ctor_rep_to_int(equiv_var, 7).
+ml_base_type_info__type_ctor_rep_to_int(int, 8).
+ml_base_type_info__type_ctor_rep_to_int(char, 9).
+ml_base_type_info__type_ctor_rep_to_int(float, 10).
+ml_base_type_info__type_ctor_rep_to_int(string, 11).
+ml_base_type_info__type_ctor_rep_to_int(pred, 12).
+ml_base_type_info__type_ctor_rep_to_int(univ, 13).
+ml_base_type_info__type_ctor_rep_to_int(void, 14).
+ml_base_type_info__type_ctor_rep_to_int(c_pointer, 15).
+ml_base_type_info__type_ctor_rep_to_int(typeinfo, 16).
+ml_base_type_info__type_ctor_rep_to_int(typeclassinfo, 17).
+ml_base_type_info__type_ctor_rep_to_int(array, 18).
+ml_base_type_info__type_ctor_rep_to_int(unknown, 19).
+
+:- pred ml_base_type_info__construct_type_ctor_representation(hlds_type_defn,
+ mlds__rval).
+:- mode ml_base_type_info__construct_type_ctor_representation(in, out) is det.
+
+ml_base_type_info__construct_type_ctor_representation(HldsType, Rvals) :-
+ hlds_data__get_type_defn_body(HldsType, TypeBody),
+ (
+ TypeBody = uu_type(_Alts),
+ error("ml_base_type_info__construct_type_ctor_representation: sorry, undiscriminated union unimplemented\n")
+ ;
+ TypeBody = eqv_type(_Type),
+ TypeCtorRep = equiv
+ ;
+ TypeBody = abstract_type,
+ TypeCtorRep = unknown
+ ;
+ TypeBody = du_type(Ctors, _ConsTagMap, Enum, EqualityPred),
+ (
+ Enum = yes,
+ (
+ EqualityPred = yes(_),
+ TypeCtorRep = enum_usereq
+ ;
+ EqualityPred = no,
+ TypeCtorRep = enum
+ )
+ ;
+ Enum = no,
+ (
+ type_is_no_tag_type(Ctors, _Name, _TypeArg)
+ ->
+ (
+ EqualityPred = yes(_),
+ TypeCtorRep = notag_usereq
+ ;
+ EqualityPred = no,
+ TypeCtorRep = notag
+ )
+ ;
+ (
+ EqualityPred = yes(_),
+ TypeCtorRep = du_usereq
+ ;
+ EqualityPred = no,
+ TypeCtorRep = du
+ )
+ )
+ )
+ ),
+ ml_base_type_info__type_ctor_rep_to_int(TypeCtorRep, TypeCtorRepInt),
+ Rvals = const(int_const(TypeCtorRepInt)).
+
Index: compiler/notes/compiler_design.html
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/notes/compiler_design.html,v
retrieving revision 1.41
diff -u -d -u -r1.41 compiler_design.html
--- compiler/notes/compiler_design.html 1999/11/08 22:27:59 1.41
+++ compiler/notes/compiler_design.html 1999/12/02 05:07:30
@@ -875,6 +875,8 @@
<h4> 4b. MLDS code generation </h4>
<ul>
<li> ml_code_gen.m converts HLDS code to MLDS.
+<li> ml_base_type_info.m generates MLDS declarations for the
+ base_type_info structures used for polymorphism.
</ul>
<h4> 5b. MLDS transformations </h4>
--
Fergus Henderson <fjh at cs.mu.oz.au> | "I have always known that the pursuit
WWW: <http://www.cs.mu.oz.au/~fjh> | of excellence is a lethal habit"
PGP: finger fjh at 128.250.37.3 | -- the last words of T. S. Garp.
--------------------------------------------------------------------------
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