[m-rev.] diff: delay calls to type_ctor_info RTTI functions in Erlang backend
Peter Wang
wangp at students.csse.unimelb.edu.au
Thu Jul 5 12:55:14 AEST 2007
Branches: main
Add an optimisation to the Erlang backend. This change delays the calls to
RTTI functions that return type_ctor_infos. In place of the type_ctor_info
data we pass the thunks that will return type_ctor_infos when called and call
them as required.
In many cases the type_ctor_info won't be needed so the functions won't be
called. On the other hand, it could be the case that a function which would
only have been called once previously will now be called multiple times.
The Mercury compiler built with the Erlang backend, compiled with HiPE at the
default optimisation level, is ~12x faster after this change.
compiler/elds_to_erlang.m:
When generating references to type_ctor_infos, output a function
reference instead of a function call.
library/erlang_rtti_implementation.m:
Add a new type type_ctor_info_evaled (only used in the Erlang backend)
to distinguish between actual type_ctor_infos and the thunks. Change
some type signatures to use type_ctor_info_evaled.
Call the thunk when extracting type_ctor_infos from type_infos.
In create_type_info, wrap the evaluted type_ctor_info data back into a
thunk when creating a type_info.
library/type_desc.m:
Make type_ctor_name_and_arity evaluate type_ctor_info thunks.
Make the Erlang functions that unify and compare type_desc and
type_ctor_descs evaluate thunks if necessary.
Make the Erlang unify and compare functions for pseudo_type_descs into
stubs that throw and exception when called. (I don't think it works
and should be written properly when it's needed.)
Index: compiler/elds_to_erlang.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/elds_to_erlang.m,v
retrieving revision 1.22
diff -u -r1.22 elds_to_erlang.m
--- compiler/elds_to_erlang.m 22 Jun 2007 04:42:21 -0000 1.22
+++ compiler/elds_to_erlang.m 5 Jul 2007 02:41:43 -0000
@@ -584,8 +584,29 @@
io.write_string(")", !IO)
;
Expr = elds_rtti_ref(RttiId),
- output_rtti_id(ModuleInfo, RttiId, !IO),
- io.write_string("()", !IO)
+ (
+ RttiId = elds_rtti_type_ctor_id(_),
+ %
+ % We don't immediately call the function to get the type_ctor_info,
+ % but only reference the function to be called if the
+ % type_ctor_info is actually needed. This is a significant saving
+ % as most of the time we won't need the type_ctor_info anyway. It
+ % does mean that we have to be careful in the places where we could
+ % be passed a function instead of a type_ctor_info. Since zero-
+ % arity type_ctor_infos are also type_infos, it also affects
+ % type_infos.
+ %
+ io.write_string("fun ", !IO),
+ output_rtti_id(ModuleInfo, RttiId, !IO),
+ io.write_string("/0 ", !IO)
+ ;
+ ( RttiId = elds_rtti_type_info_id(_)
+ ; RttiId = elds_rtti_pseudo_type_info_id(_)
+ ; RttiId = elds_rtti_base_typeclass_id(_, _, _)
+ ),
+ output_rtti_id(ModuleInfo, RttiId, !IO),
+ io.write_string("()", !IO)
+ )
;
Expr = elds_foreign_code(Code),
nl(!IO),
Index: library/erlang_rtti_implementation.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/erlang_rtti_implementation.m,v
retrieving revision 1.10
diff -u -r1.10 erlang_rtti_implementation.m
--- library/erlang_rtti_implementation.m 26 Jun 2007 02:08:25 -0000 1.10
+++ library/erlang_rtti_implementation.m 5 Jul 2007 02:41:43 -0000
@@ -25,6 +25,7 @@
:- type type_info.
:- type type_ctor_info.
+:- type type_ctor_info_evaled.
:- func get_type_info(T::unused) = (type_info::out) is det.
@@ -40,10 +41,10 @@
:- pred compare_type_infos(comparison_result::out,
type_info::in, type_info::in) is det.
-:- pred type_ctor_and_args(type_info::in, type_ctor_info::out,
+:- pred type_ctor_and_args(type_info::in, type_ctor_info_evaled::out,
list(type_info)::out) is det.
-:- pred type_ctor_name_and_arity(type_ctor_info::in,
+:- pred type_ctor_name_and_arity(type_ctor_info_evaled::in,
string::out, string::out, int::out) is det.
:- pred deconstruct(T, noncanon_handling, string, int, list(univ)).
@@ -72,17 +73,25 @@
% { TypeCtorInfo, TypeInfo0, ..., TypeInfoN }
% a type with variable arity of size N
% { TypeCtorInfo, N, TypeInfo0, ..., TypeInfoN }
+ %
+ % Note that we usually we pass thunks in place of type_ctor_infos
+ % themselves.
%
:- pragma foreign_type("Erlang", type_info, "").
:- type type_info ---> type_info.
- %
- % For the representation of a type_ctor_info
- % see erlang_rtti:type_ctor_data_to_elds
+ % In the Erlang RTTI implementation, this is actually a thunk returning a
+ % type_ctor_info.
%
:- pragma foreign_type("Erlang", type_ctor_info, "").
:- type type_ctor_info ---> type_ctor_info.
+ % The actual type_ctor_info, i.e. after evaluating the thunk. For the
+ % representation of a type_ctor_info see erl_rtti.type_ctor_data_to_elds.
+ %
+:- pragma foreign_type("Erlang", type_ctor_info_evaled, "").
+:- type type_ctor_info_evaled ---> type_ctor_info_evaled.
+
% The type_ctor_rep needs to be kept up to date with the alternatives
% given by the function erl_rtti.erlang_type_ctor_rep/1
%
@@ -130,7 +139,7 @@
generic_unify(X, Y) :-
TypeInfo = X ^ type_info,
- TypeCtorInfo = TypeInfo ^ type_ctor_info,
+ TypeCtorInfo = TypeInfo ^ type_ctor_info_evaled,
TypeCtorRep = TypeCtorInfo ^ type_ctor_rep,
(
TypeCtorRep = etcr_tuple
@@ -207,7 +216,7 @@
generic_compare(Res, X, Y) :-
TypeInfo = X ^ type_info,
- TypeCtorInfo = TypeInfo ^ type_ctor_info,
+ TypeCtorInfo = TypeInfo ^ type_ctor_info_evaled,
TypeCtorRep = TypeCtorInfo ^ type_ctor_rep,
(
TypeCtorRep = etcr_tuple
@@ -296,7 +305,7 @@
type_ctor_and_args(TypeInfo0, TypeCtorInfo, Args) :-
TypeInfo = collapse_equivalences(TypeInfo0),
- TypeCtorInfo = TypeInfo ^ type_ctor_info,
+ TypeCtorInfo = TypeInfo ^ type_ctor_info_evaled,
( type_ctor_is_variable_arity(TypeCtorInfo) ->
Arity = TypeInfo ^ var_arity_type_info_arity,
Args = list.map(
@@ -306,7 +315,7 @@
Args = list.map(func(L) = TypeInfo ^ type_info_index(L), 1 .. Arity)
).
-:- pred type_ctor_is_variable_arity(type_ctor_info::in) is semidet.
+:- pred type_ctor_is_variable_arity(type_ctor_info_evaled::in) is semidet.
type_ctor_is_variable_arity(TypeCtorInfo) :-
TypeCtorRep = TypeCtorInfo ^ type_ctor_rep,
@@ -329,13 +338,13 @@
deconstruct(Term, NonCanon, Functor, Arity, Arguments) :-
TypeInfo = Term ^ type_info,
- TypeCtorInfo = TypeInfo ^ type_ctor_info,
+ TypeCtorInfo = TypeInfo ^ type_ctor_info_evaled,
TypeCtorRep = TypeCtorInfo ^ type_ctor_rep,
deconstruct_2(Term, TypeInfo, TypeCtorInfo, TypeCtorRep, NonCanon,
Functor, Arity, Arguments).
-:- pred deconstruct_2(T, type_info, type_ctor_info, erlang_type_ctor_rep,
- noncanon_handling, string, int, list(univ)).
+:- pred deconstruct_2(T, type_info, type_ctor_info_evaled,
+ erlang_type_ctor_rep, noncanon_handling, string, int, list(univ)).
:- mode deconstruct_2(in, in, in, in, in(do_not_allow), out, out, out) is det.
:- mode deconstruct_2(in, in, in, in, in(canonicalize), out, out, out) is det.
:- mode deconstruct_2(in, in, in, in,
@@ -391,7 +400,7 @@
;
TypeCtorRep = etcr_eqv,
EqvTypeInfo = collapse_equivalences(TypeInfo),
- EqvTypeCtorInfo = EqvTypeInfo ^ type_ctor_info,
+ EqvTypeCtorInfo = EqvTypeInfo ^ type_ctor_info_evaled,
EqvTypeCtorRep = EqvTypeCtorInfo ^ type_ctor_rep,
deconstruct_2(Term, EqvTypeInfo, EqvTypeCtorInfo, EqvTypeCtorRep,
NonCanon, Functor, Arity, Arguments)
@@ -628,7 +637,7 @@
:- func collapse_equivalences(type_info) = type_info.
collapse_equivalences(TypeInfo0) = TypeInfo :-
- TypeCtorInfo0 = TypeInfo0 ^ type_ctor_info,
+ TypeCtorInfo0 = TypeInfo0 ^ type_ctor_info_evaled,
TypeCtorRep = TypeCtorInfo0 ^ type_ctor_rep,
( TypeCtorRep = etcr_eqv ->
PtiInfo = no : pti_info(int),
@@ -679,38 +688,36 @@
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-:- func type_ctor_info(type_info) = type_ctor_info.
+:- func type_ctor_info_evaled(type_info) = type_ctor_info_evaled.
:- pragma foreign_proc("Erlang",
- type_ctor_info(TypeInfo::in) = (TypeCtorInfo::out),
+ type_ctor_info_evaled(TypeInfo::in) = (TypeCtorInfo::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
%
% If the type_info is for a type with arity 0,
% then the type_info is already the type_ctor info.
- % The first field of a type_ctor_info is the integer
- % zero in this case.
+ % We evaluate the thunk to get the actual type_ctor_info data.
%
- FirstElement = element(?ti_type_ctor_info, TypeInfo),
if
- % XXX is the test FirstElement =:= 0 better?
- is_integer(FirstElement)
- -> TypeCtorInfo = TypeInfo ;
- true
- -> TypeCtorInfo = FirstElement
+ is_function(TypeInfo) ->
+ TypeCtorInfo = TypeInfo();
+ true ->
+ FirstElement = element(?ti_type_ctor_info, TypeInfo),
+ TypeCtorInfo = FirstElement()
end
").
-type_ctor_info(_) = type_ctor_info :-
- det_unimplemented("type_ctor_info").
+type_ctor_info_evaled(_) = type_ctor_info_evaled :-
+ det_unimplemented("type_ctor_info_evaled").
:- func var_arity_type_info_arity(type_info) = int.
:- pragma foreign_proc("Erlang",
- var_arity_type_info_arity(TypeInfo::in) = (TypeCtorInfo::out),
+ var_arity_type_info_arity(TypeInfo::in) = (Arity::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
- TypeCtorInfo = element(?ti_var_arity, TypeInfo)
+ Arity = element(?ti_var_arity, TypeInfo)
").
var_arity_type_info_arity(_) = 0 :-
@@ -755,7 +762,7 @@
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-:- func type_ctor_rep(type_ctor_info) = erlang_type_ctor_rep.
+:- func type_ctor_rep(type_ctor_info_evaled) = erlang_type_ctor_rep.
:- pragma foreign_proc("Erlang",
type_ctor_rep(TypeCtorInfo::in) = (TypeCtorRep::out),
@@ -772,7 +779,7 @@
% matching foreign_proc version.
private_builtin.sorry("type_ctor_rep").
-:- some [P] func type_ctor_unify_pred(type_ctor_info) = P.
+:- some [P] func type_ctor_unify_pred(type_ctor_info_evaled) = P.
:- pragma foreign_proc("Erlang",
type_ctor_unify_pred(TypeCtorInfo::in) = (UnifyPred::out),
@@ -786,7 +793,7 @@
type_ctor_unify_pred(_) = "dummy value" :-
det_unimplemented("type_ctor_unify_pred").
-:- some [P] func type_ctor_compare_pred(type_ctor_info) = P.
+:- some [P] func type_ctor_compare_pred(type_ctor_info_evaled) = P.
:- pragma foreign_proc("Erlang",
type_ctor_compare_pred(TypeCtorInfo::in) = (ComparePred::out),
@@ -800,7 +807,7 @@
type_ctor_compare_pred(_) = "dummy value" :-
det_unimplemented("type_ctor_compare_pred").
-:- func type_ctor_module_name(type_ctor_info) = string.
+:- func type_ctor_module_name(type_ctor_info_evaled) = string.
:- pragma foreign_proc("Erlang",
type_ctor_module_name(TypeCtorInfo::in) = (ModuleName::out),
@@ -812,7 +819,7 @@
type_ctor_module_name(_) = "dummy value" :-
det_unimplemented("type_ctor_module_name").
-:- func type_ctor_type_name(type_ctor_info) = string.
+:- func type_ctor_type_name(type_ctor_info_evaled) = string.
:- pragma foreign_proc("Erlang",
type_ctor_type_name(TypeCtorInfo::in) = (TypeName::out),
@@ -824,7 +831,7 @@
type_ctor_type_name(_) = "dummy value" :-
det_unimplemented("type_ctor_type_name").
-:- func type_ctor_arity(type_ctor_info) = int.
+:- func type_ctor_arity(type_ctor_info_evaled) = int.
:- pragma foreign_proc("Erlang",
type_ctor_arity(TypeCtorInfo::in) = (Arity::out),
@@ -836,7 +843,7 @@
type_ctor_arity(_) = 0 :-
det_unimplemented("type_ctor_arity").
-:- func type_ctor_functors(type_ctor_info) = list(erlang_du_functor).
+:- func type_ctor_functors(type_ctor_info_evaled) = list(erlang_du_functor).
:- pragma foreign_proc("Erlang",
type_ctor_functors(TypeCtorInfo::in) = (Functors::out),
@@ -848,7 +855,7 @@
type_ctor_functors(_) = [] :-
det_unimplemented("type_ctor_functors").
-:- func type_ctor_dummy_functor_name(type_ctor_info) = string.
+:- func type_ctor_dummy_functor_name(type_ctor_info_evaled) = string.
:- pragma foreign_proc("Erlang",
type_ctor_dummy_functor_name(TypeCtorInfo::in) = (Functor::out),
@@ -860,7 +867,7 @@
type_ctor_dummy_functor_name(_) = "dummy value" :-
det_unimplemented("type_ctor_dummy_functor_name").
-:- func type_ctor_eqv_type(type_ctor_info) = maybe_pseudo_type_info.
+:- func type_ctor_eqv_type(type_ctor_info_evaled) = maybe_pseudo_type_info.
:- pragma foreign_proc("Erlang",
type_ctor_eqv_type(TypeCtorInfo::in) = (EqvType::out),
@@ -1272,7 +1279,7 @@
:- func eval_type_info(ti_info(T), type_info) = type_info.
eval_type_info(I, TI) = TypeInfo :-
- TypeCtorInfo = TI ^ type_ctor_info,
+ TypeCtorInfo = TI ^ type_ctor_info_evaled,
( type_ctor_is_variable_arity(TypeCtorInfo) ->
Arity = TI ^ var_arity_type_info_arity,
ArgTypeInfos = list.map(var_arity_arg_type_info(I, TI), 1 .. Arity),
@@ -1300,17 +1307,21 @@
%-----------------------------------------------------------------------------%
-:- func create_type_info(type_ctor_info, list(type_info)) = type_info.
+:- func create_type_info(type_ctor_info_evaled, list(type_info)) = type_info.
:- pragma foreign_proc("Erlang",
create_type_info(TypeCtorInfo::in, Args::in) = (TypeInfo::out),
[promise_pure, will_not_call_mercury, thread_safe], "
+ % TypeCtorInfo was evaluated by eval_type_info, so we wrap it back up in a
+ % thunk. It may or may not be costly to do this, when we could have
+ % already used the one we extracted out of the type_info.
+ TypeCtorInfoFun = fun() -> TypeCtorInfo end,
TypeInfo =
case Args of
[] ->
- TypeCtorInfo;
+ TypeCtorInfoFun;
[_|_] ->
- list_to_tuple([TypeCtorInfo | Args])
+ list_to_tuple([TypeCtorInfoFun | Args])
end
").
@@ -1318,14 +1329,18 @@
det_unimplemented("create_type_info/2").
-:- func create_var_arity_type_info(type_ctor_info,
+:- func create_var_arity_type_info(type_ctor_info_evaled,
int, list(type_info)) = type_info.
:- pragma foreign_proc("Erlang",
create_var_arity_type_info(TypeCtorInfo::in,
Arity::in, Args::in) = (TypeInfo::out),
[promise_pure, will_not_call_mercury, thread_safe], "
- TypeInfo = list_to_tuple([TypeCtorInfo, Arity | Args])
+ % TypeCtorInfo was evaluated by eval_type_info, so we wrap it back up in a
+ % thunk. It may or may not be costly to do this, when we could have
+ % already used the one we extracted out of the type_info.
+ TypeCtorInfoFun = fun() -> TypeCtorInfo end,
+ TypeInfo = list_to_tuple([TypeCtorInfoFun, Arity | Args])
").
create_var_arity_type_info(_, _, _) = type_info :-
Index: library/type_desc.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/type_desc.m,v
retrieving revision 1.49
diff -u -r1.49 type_desc.m
--- library/type_desc.m 18 Jun 2007 04:41:28 -0000 1.49
+++ library/type_desc.m 5 Jul 2007 02:41:43 -0000
@@ -790,10 +790,16 @@
").
:- pragma foreign_proc("Erlang",
- type_ctor_name_and_arity(TypeCtorDesc::in, TypeCtorModuleName::out,
+ type_ctor_name_and_arity(TypeCtorDesc0::in, TypeCtorModuleName::out,
TypeCtorName::out, TypeCtorArity::out),
[will_not_call_mercury, thread_safe, promise_pure],
"
+ if
+ is_function(TypeCtorDesc0) ->
+ TypeCtorDesc = TypeCtorDesc0();
+ true ->
+ TypeCtorDesc = TypeCtorDesc0
+ end,
{TypeCtorModuleName, TypeCtorName, TypeCtorArity} =
mercury__erlang_rtti_implementation:
type_ctor_name_and_arity_4_p_0(TypeCtorDesc)
@@ -882,44 +888,52 @@
").
:- pragma foreign_code("Erlang", "
- '__Unify____type_desc_0_0'(X, Y) ->
+ % XXX in these functions we probably should deconstruct the type_infos and
+ % type_ctor_infos and compare the parts manually, as they can contain
+ % functions.
+
+ '__Unify____type_desc_0_0'(X0, Y0) ->
+ X = eval_if_function(X0),
+ Y = eval_if_function(Y0),
case X =:= Y of
true -> {};
false -> fail
end.
- '__Unify____type_ctor_desc_0_0'(X, Y) ->
+ '__Unify____type_ctor_desc_0_0'(X0, Y0) ->
+ X = eval_if_function(X0),
+ Y = eval_if_function(Y0),
case X =:= Y of
true -> {};
false -> fail
end.
- '__Unify____pseudo_type_desc_0_0'(X, Y) ->
- case X =:= Y of
- true -> {};
- false -> fail
- end.
+ '__Unify____pseudo_type_desc_0_0'(_, _) ->
+ throw(""foreign code for unifying pseudo_type_desc"").
- '__Compare____type_desc_0_0'(X, Y) ->
+ '__Compare____type_desc_0_0'(X0, Y0) ->
+ X = eval_if_function(X0),
+ Y = eval_if_function(Y0),
if
X =:= Y -> {{'='}};
X < Y -> {{'<'}};
true -> {{'>'}}
end.
- '__Compare____type_ctor_desc_0_0'(X, Y) ->
+ '__Compare____type_ctor_desc_0_0'(X0, Y0) ->
+ X = eval_if_function(X0),
+ Y = eval_if_function(Y0),
if
X =:= Y -> {{'='}};
X < Y -> {{'<'}};
true -> {{'>'}}
end.
- '__Compare____pseudo_type_desc_0_0'(X, Y) ->
- if
- X =:= Y -> {{'='}};
- X < Y -> {{'<'}};
- true -> {{'>'}}
- end.
+ '__Compare____pseudo_type_desc_0_0'(_, _) ->
+ throw(""foreign code for comparing pseudo_type_desc"").
+
+ eval_if_function(X) when is_function(X) -> X();
+ eval_if_function(X) -> X.
").
%-----------------------------------------------------------------------------%
--------------------------------------------------------------------------
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