[m-rev.] for review: full implementation of RTTI for equivalence types
Peter Ross
pro at missioncriticalit.com
Fri Jun 1 12:47:31 AEST 2007
Hi,
===================================================================
Estimated hours taken: 6
Branches: main
Implement the RTTI for describing equivalence types fully. This
required implementing the RTTI for outputting static pseudo and plain
type_infos.
compiler/erl_rtti.m:
Generate the full RTTI for equivalence types, this required
generating RTTI for static pseudo and plain type_infos.
compiler/elds_to_erlang.m:
Fix output_rtti_id to use the routines from rtti.m to generate
unique names for pieces of rtti.
compiler/elds.m:
Use rtti_type_ctor, rtti_type_info and rtti_pseudo_type_info to
identify pieces of rtti.
Rearrange some code.
compiler/erl_unify_gen.m:
Handle changes to elds_rtti_id.
compiler/rtti.m:
Move type_info_to_string and pseudo_type_info_to_string to
the interface so that output_rtti_id could use them.
Index: compiler/elds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/elds.m,v
retrieving revision 1.7
diff -u -r1.7 elds.m
--- compiler/elds.m 1 Jun 2007 02:12:58 -0000 1.7
+++ compiler/elds.m 1 Jun 2007 02:39:16 -0000
@@ -95,14 +95,13 @@
%
:- type elds_rtti_id
---> elds_rtti_type_ctor_id(
- module_name,
- string,
- arity
+ rtti_type_ctor
)
; elds_rtti_type_info_id(
- module_name,
- string,
- arity
+ rtti_type_info
+ )
+ ; elds_rtti_pseudo_type_info_id(
+ rtti_pseudo_type_info
)
; elds_rtti_base_typeclass_id(
tc_name, % identifies the type class
Index: compiler/elds_to_erlang.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/elds_to_erlang.m,v
retrieving revision 1.7
diff -u -r1.7 elds_to_erlang.m
--- compiler/elds_to_erlang.m 31 May 2007 08:12:53 -0000 1.7
+++ compiler/elds_to_erlang.m 1 Jun 2007 02:39:16 -0000
@@ -514,20 +514,35 @@
output_rtti_id(ModuleInfo, RttiId, !IO) :-
module_info_get_name(ModuleInfo, CurModuleName),
(
- (
- RttiId = elds_rtti_type_ctor_id(ModuleName, TypeName, Arity),
- Prefix = "TypeCtorInfo_"
- ;
- RttiId = elds_rtti_type_info_id(ModuleName, TypeName, Arity),
- Prefix = "TypeInfo_"
- ),
+ RttiId = elds_rtti_type_ctor_id(RttiTypeCtor),
+ RttiTypeCtor = rtti_type_ctor(ModuleName, _, _),
+
% The only things with an empty module name should be the builtins.
( ModuleName = unqualified("") ->
InstanceModule = mercury_public_builtin_module
;
InstanceModule = ModuleName
),
- Atom = Prefix ++ TypeName ++ "_" ++ string.from_int(Arity)
+
+ CRttiId = ctor_rtti_id(RttiTypeCtor, type_ctor_type_ctor_info),
+ id_to_c_identifier(CRttiId, Atom)
+ ;
+ RttiId = elds_rtti_type_info_id(TypeInfo),
+
+ % TypeInfos are always local to the current module.
+ InstanceModule = CurModuleName,
+ Atom = type_info_to_string(TypeInfo)
+ ;
+ RttiId = elds_rtti_pseudo_type_info_id(PseudoTypeInfo),
+ ( PseudoTypeInfo = type_var(_) ->
+ Prefix = "type_var_"
+ ;
+ Prefix = ""
+ ),
+
+ % PseudoTypeInfos are always local to the current module.
+ InstanceModule = CurModuleName,
+ Atom = Prefix ++ pseudo_type_info_to_string(PseudoTypeInfo)
;
RttiId = elds_rtti_base_typeclass_id(TCName, InstanceModule,
InstanceStr),
Index: compiler/erl_rtti.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/erl_rtti.m,v
retrieving revision 1.3
diff -u -r1.3 erl_rtti.m
--- compiler/erl_rtti.m 1 Jun 2007 02:12:58 -0000 1.3
+++ compiler/erl_rtti.m 1 Jun 2007 02:39:16 -0000
@@ -230,7 +230,11 @@
rtti_data_list_to_elds(ModuleInfo, RttiDatas, RttiDefns) :-
list.map(rtti_data_to_elds(ModuleInfo), RttiDatas, RttiDefns0),
- RttiDefns = list.condense(RttiDefns0).
+
+ % XXX See mlds_defn_is_potentially_duplicated for how this can
+ % be made more efficient.
+ %
+ RttiDefns = list.sort_and_remove_dups(list.condense(RttiDefns0)).
:- pred rtti_data_to_elds(module_info::in, erlang_rtti_data::in,
list(elds_rtti_defn)::out) is det.
@@ -259,12 +263,12 @@
RttiDefn = elds_rtti_defn(RttiId, IsExported, VarSet,
elds_clause([], elds_term(BaseTypeClassInfoData))).
-rtti_data_to_elds(_ModuleInfo, RttiData, []) :-
- RttiData = erlang_rtti_data_type_info(_TypeInfo),
- unexpected(this_file, "rtti_data_to_elds: rtti_data_type_info").
-rtti_data_to_elds(_ModuleInfo, RttiData, []) :-
- RttiData = erlang_rtti_data_pseudo_type_info(_PseudoTypeInfo),
- unexpected(this_file, "rtti_data_to_elds: rtti_data_pseudo_type_info").
+rtti_data_to_elds(ModuleInfo, RttiData, RttiDefns) :-
+ RttiData = erlang_rtti_data_type_info(TypeInfo),
+ rtti_type_info_to_elds(ModuleInfo, TypeInfo, RttiDefns).
+rtti_data_to_elds(ModuleInfo, RttiData, RttiDefns) :-
+ RttiData = erlang_rtti_data_pseudo_type_info(PseudoTypeInfo),
+ rtti_pseudo_type_info_to_elds(ModuleInfo, PseudoTypeInfo, RttiDefns).
rtti_data_to_elds(_ModuleInfo, RttiData, []) :-
RttiData = erlang_rtti_data_type_class_decl(_TCDecl).
rtti_data_to_elds(_ModuleInfo, RttiData, []) :-
@@ -376,35 +380,178 @@
%-----------------------------------------------------------------------------%
- % XXX This code is dead, but I've left it in until I am sure
- % that we don't need it.
+ %
+ % Generate a representation of a type_info.
+ % The generated type_info will always be local to the module.
+ %
:- pred rtti_type_info_to_elds(module_info::in, rtti_type_info::in,
list(elds_rtti_defn)::out) is det.
rtti_type_info_to_elds(_ModuleInfo, TypeInfo, RttiDefns) :-
TypeInfo = plain_arity_zero_type_info(RttiTypeCtor),
- RttiTypeCtor = rtti_type_ctor(ModuleName, TypeName, Arity),
- TypeCtorRttiId = elds_rtti_type_ctor_id(ModuleName, TypeName, Arity),
- ELDSTypeInfo = elds_tuple([elds_rtti_ref(TypeCtorRttiId)]),
+ TypeCtorRttiId = elds_rtti_type_ctor_id(RttiTypeCtor),
+ ELDSTypeInfo = elds_rtti_ref(TypeCtorRttiId),
+
+ RttiId = elds_rtti_type_info_id(TypeInfo),
+ IsExported = no,
+ RttiDefn = elds_rtti_defn(RttiId, IsExported, varset.init,
+ elds_clause([], ELDSTypeInfo)),
+
+ RttiDefns = [RttiDefn].
+
+rtti_type_info_to_elds(ModuleInfo, TypeInfo, RttiDefns) :-
+ TypeInfo = plain_type_info(TypeCtor, ArgTypeInfos),
+
+ rtti_type_info_to_elds_2(ModuleInfo,
+ ArgTypeInfos, ELDSArgTypeInfos, ArgRttiDefns),
+
+ ELDSTypeInfo = elds_tuple(
+ [elds_rtti_ref(elds_rtti_type_ctor_id(TypeCtor)) | ELDSArgTypeInfos]),
+
+ RttiId = elds_rtti_type_info_id(TypeInfo),
+ IsExported = no,
+ RttiDefn = elds_rtti_defn(RttiId, IsExported, varset.init,
+ elds_clause([], elds_term(ELDSTypeInfo))),
+
+ RttiDefns = [RttiDefn | ArgRttiDefns ].
+
+rtti_type_info_to_elds(ModuleInfo, TypeInfo, RttiDefns) :-
+ TypeInfo = var_arity_type_info(VarCtorId, ArgTypeInfos),
+ TypeCtor = var_arity_id_to_rtti_type_ctor(VarCtorId),
+
+ rtti_type_info_to_elds_2(ModuleInfo,
+ ArgTypeInfos, ELDSArgTypeInfos, ArgRttiDefns),
+
+ ELDSTypeInfo = elds_tuple([
+ elds_rtti_ref(elds_rtti_type_ctor_id(TypeCtor)),
+ elds_term(elds_int(list.length(ArgTypeInfos))) |
+ ELDSArgTypeInfos]),
+
+ RttiId = elds_rtti_type_info_id(TypeInfo),
+ IsExported = no,
+ RttiDefn = elds_rtti_defn(RttiId, IsExported, varset.init,
+ elds_clause([], elds_term(ELDSTypeInfo))),
+ RttiDefns = [RttiDefn | ArgRttiDefns ].
+
+:- pred rtti_type_info_to_elds_2(module_info::in,
+ list(rtti_type_info)::in,
+ list(elds_expr)::out, list(elds_rtti_defn)::out) is det.
+
+rtti_type_info_to_elds_2(ModuleInfo,
+ ArgTypeInfos, ELDSArgTypeInfos, ArgRttiDefns) :-
+ list.map(rtti_type_info_to_elds(ModuleInfo), ArgTypeInfos, ArgRttiDefns0),
+ ArgRttiDefns = list.sort_and_remove_dups(list.condense(ArgRttiDefns0)),
+
+ ELDSArgTypeInfos = list.map(
+ func(TI) = elds_rtti_ref(elds_rtti_type_info_id(TI)), ArgTypeInfos).
+
+
+%-----------------------------------------------------------------------------%
+
+ %
+ % Generate a representation of a pseudo_type_info.
+ % The generated pseudo_type_info will always be local to the module.
+ %
+:- pred rtti_pseudo_type_info_to_elds(module_info::in,
+ rtti_pseudo_type_info::in, list(elds_rtti_defn)::out) is det.
+
+rtti_pseudo_type_info_to_elds(_ModuleInfo, TypeInfo, RttiDefns) :-
+ TypeInfo = plain_arity_zero_pseudo_type_info(RttiTypeCtor),
+
+ TypeCtorRttiId = elds_rtti_type_ctor_id(RttiTypeCtor),
+ ELDSTypeInfo = elds_rtti_ref(TypeCtorRttiId),
- RttiId = elds_rtti_type_info_id(ModuleName, TypeName, Arity),
- IsExported = yes,
+ RttiId = elds_rtti_pseudo_type_info_id(TypeInfo),
+ IsExported = no,
+ RttiDefn = elds_rtti_defn(RttiId, IsExported, varset.init,
+ elds_clause([], ELDSTypeInfo)),
+
+ RttiDefns = [RttiDefn].
+
+rtti_pseudo_type_info_to_elds(ModuleInfo, TypeInfo, RttiDefns) :-
+ TypeInfo = plain_pseudo_type_info(TypeCtor, ArgTypeInfos),
+
+ rtti_pseudo_type_info_to_elds_2(ModuleInfo,
+ ArgTypeInfos, ELDSArgTypeInfos, ArgRttiDefns),
+
+ ELDSTypeInfo = elds_tuple(
+ [elds_rtti_ref(elds_rtti_type_ctor_id(TypeCtor)) | ELDSArgTypeInfos]),
+
+ RttiId = elds_rtti_pseudo_type_info_id(TypeInfo),
+ IsExported = no,
+ RttiDefn = elds_rtti_defn(RttiId, IsExported, varset.init,
+ elds_clause([], elds_term(ELDSTypeInfo))),
+
+ RttiDefns = [RttiDefn | ArgRttiDefns ].
+
+rtti_pseudo_type_info_to_elds(ModuleInfo, TypeInfo, RttiDefns) :-
+ TypeInfo = var_arity_pseudo_type_info(VarCtorId, ArgTypeInfos),
+ TypeCtor = var_arity_id_to_rtti_type_ctor(VarCtorId),
+
+ rtti_pseudo_type_info_to_elds_2(ModuleInfo,
+ ArgTypeInfos, ELDSArgTypeInfos, ArgRttiDefns),
+
+ ELDSTypeInfo = elds_tuple([
+ elds_rtti_ref(elds_rtti_type_ctor_id(TypeCtor)),
+ elds_term(elds_int(list.length(ArgTypeInfos))) |
+ ELDSArgTypeInfos]),
+
+ RttiId = elds_rtti_pseudo_type_info_id(TypeInfo),
+ IsExported = no,
+ RttiDefn = elds_rtti_defn(RttiId, IsExported, varset.init,
+ elds_clause([], elds_term(ELDSTypeInfo))),
+
+ RttiDefns = [RttiDefn | ArgRttiDefns ].
+
+rtti_pseudo_type_info_to_elds(_ModuleInfo, TypeInfo, RttiDefns) :-
+ TypeInfo = type_var(I),
+
+ ELDSTypeInfo = elds_int(I),
+
+ RttiId = elds_rtti_pseudo_type_info_id(TypeInfo),
+ IsExported = no,
RttiDefn = elds_rtti_defn(RttiId, IsExported, varset.init,
elds_clause([], elds_term(ELDSTypeInfo))),
RttiDefns = [RttiDefn].
-rtti_type_info_to_elds(_ModuleInfo, TypeInfo, RttiDefns) :-
- TypeInfo = plain_type_info(_, _),
- RttiDefns = [].
-rtti_type_info_to_elds(_ModuleInfo, TypeInfo, RttiDefns) :-
- TypeInfo = var_arity_type_info(_, _),
- RttiDefns = [].
+
+:- pred rtti_pseudo_type_info_to_elds_2(module_info::in,
+ list(rtti_maybe_pseudo_type_info)::in,
+ list(elds_expr)::out, list(elds_rtti_defn)::out) is det.
+
+rtti_pseudo_type_info_to_elds_2(ModuleInfo,
+ ArgTypeInfos, ELDSArgTypeInfos, ArgRttiDefns) :-
+ list.map(rtti_maybe_pseudo_type_info_to_elds(ModuleInfo),
+ ArgTypeInfos, ArgRttiDefns0),
+ ArgRttiDefns = list.sort_and_remove_dups(list.condense(ArgRttiDefns0)),
+
+ ELDSArgTypeInfos = list.map(
+ (func(MPTI) = elds_rtti_ref(Id) :-
+ (
+ MPTI = pseudo(PTI),
+ Id = elds_rtti_pseudo_type_info_id(PTI)
+ ;
+ MPTI = plain(TI),
+ Id = elds_rtti_type_info_id(TI)
+ )
+ ), ArgTypeInfos).
+
+
+:- pred rtti_maybe_pseudo_type_info_to_elds(module_info::in,
+ rtti_maybe_pseudo_type_info::in, list(elds_rtti_defn)::out) is det.
+
+rtti_maybe_pseudo_type_info_to_elds(ModuleInfo, plain(TypeInfo), Defns) :-
+ rtti_type_info_to_elds(ModuleInfo, TypeInfo, Defns).
+rtti_maybe_pseudo_type_info_to_elds(ModuleInfo, pseudo(TypeInfo), Defns) :-
+ rtti_pseudo_type_info_to_elds(ModuleInfo, TypeInfo, Defns).
%-----------------------------------------------------------------------------%
- % See MR_TypeCtorInfo_Struct in runtime/mercury_type_info.h
+ %
+ % This predicate defines the representation of type_ctor_info
+ % for the erlang backend.
%
:- pred type_ctor_data_to_elds(module_info::in, erlang_type_ctor_data::in,
list(elds_rtti_defn)::out) is det.
@@ -421,6 +568,8 @@
VarSet = !.VarSet
),
+ erlang_type_ctor_details(ModuleInfo, Details, ELDSDetails, RttiDefns0),
+
ELDSTypeCtorData = elds_tuple([
elds_term(elds_int(Arity)),
elds_term(elds_int(Version)),
@@ -428,13 +577,15 @@
CompareExpr,
elds_term(elds_string(sym_name_to_string(ModuleName))),
elds_term(elds_string(TypeName)),
- erlang_type_ctor_rep(Details)
+ erlang_type_ctor_rep(Details),
+ ELDSDetails
]),
- RttiId = elds_rtti_type_ctor_id(ModuleName, TypeName, Arity),
+ TypeCtor = rtti_type_ctor(ModuleName, TypeName, Arity),
+ RttiId = elds_rtti_type_ctor_id(TypeCtor),
IsExported = yes,
RttiDefn = elds_rtti_defn(RttiId, IsExported, VarSet,
elds_clause([], elds_term(ELDSTypeCtorData))),
- RttiDefns = [RttiDefn].
+ RttiDefns = [RttiDefn | RttiDefns0].
:- func erlang_type_ctor_rep(erlang_type_ctor_details) = elds_expr.
@@ -472,14 +623,6 @@
elds_term(make_enum_alternative("pseudo_type_desc")).
erlang_type_ctor_rep(erlang_builtin(builtin_ctor_type_ctor_desc)) =
elds_term(make_enum_alternative("type_ctor_desc")).
-
-erlang_type_ctor_rep(erlang_impl_artifact(erlang_impl_ctor_hp)) =
- elds_term(make_enum_alternative("hp")).
-erlang_type_ctor_rep(erlang_impl_artifact(erlang_impl_ctor_subgoal)) =
- elds_term(make_enum_alternative("subgoal")).
-erlang_type_ctor_rep(erlang_impl_artifact(erlang_impl_ctor_ticket)) =
- elds_term(make_enum_alternative("ticket")).
-
erlang_type_ctor_rep(erlang_impl_artifact(erlang_impl_ctor_type_info)) =
elds_term(make_enum_alternative("type_info")).
erlang_type_ctor_rep(erlang_impl_artifact(erlang_impl_ctor_type_ctor_info)) =
@@ -492,6 +635,16 @@
erlang_type_ctor_rep(erlang_foreign) =
elds_term(make_enum_alternative("foreign")).
+ %
+ % These three types should never actually be used in
+ % an Erlang program.
+ %
+erlang_type_ctor_rep(erlang_impl_artifact(erlang_impl_ctor_hp)) =
+ elds_term(make_enum_alternative("hp")).
+erlang_type_ctor_rep(erlang_impl_artifact(erlang_impl_ctor_subgoal)) =
+ elds_term(make_enum_alternative("subgoal")).
+erlang_type_ctor_rep(erlang_impl_artifact(erlang_impl_ctor_ticket)) =
+ elds_term(make_enum_alternative("ticket")).
:- pred gen_init_special_pred(module_info::in, maybe(rtti_proc_label)::in,
elds_expr::out, prog_varset::in, prog_varset::out) is det.
@@ -559,6 +712,49 @@
WrapperFun = elds_fun(elds_clause(terms_from_vars(WrapperInputVars),
DoCall)).
+
+ %
+ % erlang_type_ctor_details(MI, D, E, Defns)
+ %
+ % will return the expr, E, which evaluates to an erlang term
+ % which describes the type in more detail, plus the extra
+ % definitions, Defns, needed to help define that term.
+ %
+ % Note two calls to this predicate may generate duplicate
+ % definitions, so the user is responsible for getting rid
+ % of duplicate definitions.
+ %
+:- pred erlang_type_ctor_details(module_info::in,
+ erlang_type_ctor_details::in, elds_expr::out,
+ list(elds_rtti_defn)::out) is det.
+
+erlang_type_ctor_details(ModuleInfo, Details, Term, Defns) :-
+ %
+ % XXX Currently we only handle equivalence types,
+ % as this causes type_info's and pseudo_type_info's
+ % to be generated.
+ %
+ ( Details = erlang_eqv(MaybePseudoTypeInfo) ->
+ maybe_pseudo_type_info_to_elds(ModuleInfo, MaybePseudoTypeInfo,
+ RttiId, Defns),
+ Term = elds_rtti_ref(RttiId)
+ ;
+ Term = elds_term(elds_tuple([])),
+ Defns = []
+ ).
+
+:- pred maybe_pseudo_type_info_to_elds(module_info::in,
+ rtti_maybe_pseudo_type_info::in,
+ elds_rtti_id::out, list(elds_rtti_defn)::out) is det.
+
+maybe_pseudo_type_info_to_elds(ModuleInfo, plain(TypeInfo), RttiId, Defns) :-
+ RttiId = elds_rtti_type_info_id(TypeInfo),
+ rtti_type_info_to_elds(ModuleInfo, TypeInfo, Defns).
+maybe_pseudo_type_info_to_elds(ModuleInfo, pseudo(PTypeInfo), RttiId, Defns) :-
+ RttiId = elds_rtti_pseudo_type_info_id(PTypeInfo),
+ rtti_pseudo_type_info_to_elds(ModuleInfo, PTypeInfo, Defns).
+
+%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- func this_file = string.
Index: compiler/erl_unify_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/erl_unify_gen.m,v
retrieving revision 1.4
diff -u -r1.4 erl_unify_gen.m
--- compiler/erl_unify_gen.m 28 May 2007 03:13:52 -0000 1.4
+++ compiler/erl_unify_gen.m 1 Jun 2007 02:39:16 -0000
@@ -259,7 +259,8 @@
pred_const_to_closure(ShroudedPredProcId, Args, Expr, !Info)
;
ConsId = type_ctor_info_const(ModuleName, TypeCtor, Arity),
- RttiId = elds_rtti_type_ctor_id(ModuleName, TypeCtor, Arity),
+ RttiTypeCtor = rtti_type_ctor(ModuleName, TypeCtor, Arity),
+ RttiId = elds_rtti_type_ctor_id(RttiTypeCtor),
Expr = elds_rtti_ref(RttiId)
;
ConsId = base_typeclass_info_const(InstanceModule,
Index: compiler/rtti.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rtti.m,v
retrieving revision 1.81
diff -u -r1.81 rtti.m
--- compiler/rtti.m 22 May 2007 01:00:29 -0000 1.81
+++ compiler/rtti.m 1 Jun 2007 02:39:16 -0000
@@ -727,6 +727,14 @@
%
:- pred type_ctor_rep_to_string(type_ctor_data::in, string::out) is det.
+ % Return a name which identifies the rtti_type_info
+ %
+:- func type_info_to_string(rtti_type_info) = string.
+
+ % Return a name which identifies the pseudo_type_info
+ %
+:- func pseudo_type_info_to_string(rtti_pseudo_type_info) = string.
+
% Return the rtti_data containing the given type_info.
%
:- func type_info_to_rtti_data(rtti_type_info) = rtti_data.
@@ -1442,8 +1450,6 @@
%-----------------------------------------------------------------------------%
-:- func type_info_to_string(rtti_type_info) = string.
-
type_info_to_string(TypeInfo) = Str :-
(
TypeInfo = plain_arity_zero_type_info(RttiTypeCtor),
@@ -1461,8 +1467,6 @@
IdStr = var_arity_ctor_id_to_string(VarArityId),
Str = "__vti_" ++ IdStr ++ "_" ++ int_to_string(RealArity) ++ ArgsStr
).
-
-:- func pseudo_type_info_to_string(rtti_pseudo_type_info) = string.
pseudo_type_info_to_string(PseudoTypeInfo) = Str :-
(
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list