[m-rev.] for review: avoid passing type infos to C code
David Jeffery
dgj at cs.mu.OZ.AU
Tue Jul 10 17:42:25 AEST 2001
On 09-Jul-2001, Fergus Henderson <fjh at cs.mu.OZ.AU> wrote:
> That change looks OK. I think it's an improvement on the current status
> quo, so I'd be happy for you to commit it as is. But I do have some
> suggestions for improvments.
>
> Shouldn't you do the same thing for the typeclass_info variables,
> as well as for the type_info variables?
Done.
> Also, I'd prefer it if the code which checks whether the foreign code
> references the variable was put in a separate sub-routine.
> As you say, there might possibly be some ramifications for other
> languages, so ideally the foreign_language would be passed in
> as a parameter to this routine, so that it can easily be changed
> to handle different languages differently if need be.
Done.
Revised diff below. I will commit this if there are no objections.
===================================================================
Estimated hours taken: 8
mercury/compiler/polymorphism.m:
Do not pass a type-info or typeclass-info to C code that does not use
the variable.
To check if the C code uses the variable, we simply check for the
occurence of the variable name in the string that represents the C
code. This is potentially unsafe if the user decides to do something
horrible with the preprocessor, but I don't think this needs to be
specially documented --- AFAIK there is no user-visible documentation
about passing type-infos to and from C anyway.
===================================================================
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.211
diff -u -t -r1.211 polymorphism.m
--- compiler/polymorphism.m 2001/05/24 02:32:22 1.211
+++ compiler/polymorphism.m 2001/07/10 07:37:25
@@ -1092,7 +1092,8 @@
;
{ list__length(ExtraVars, NumExtraVars) },
{ polymorphism__process_c_code(PredInfo, NumExtraVars,
- OrigArgTypes0, OrigArgTypes, ArgInfo0, ArgInfo) },
+ PragmaCode0, OrigArgTypes0, OrigArgTypes,
+ ArgInfo0, ArgInfo) },
%
% Add the type info arguments to the list of variables
@@ -1608,11 +1609,12 @@
%-----------------------------------------------------------------------------%
-:- pred polymorphism__process_c_code(pred_info, int, list(type), list(type),
+:- pred polymorphism__process_c_code(pred_info, int, pragma_foreign_code_impl,
+ list(type), list(type),
list(maybe(pair(string, mode))), list(maybe(pair(string, mode)))).
-:- mode polymorphism__process_c_code(in, in, in, out, in, out) is det.
+:- mode polymorphism__process_c_code(in, in, in, in, out, in, out) is det.
-polymorphism__process_c_code(PredInfo, NumExtraVars, OrigArgTypes0,
+polymorphism__process_c_code(PredInfo, NumExtraVars, Impl, OrigArgTypes0,
OrigArgTypes, ArgInfo0, ArgInfo) :-
pred_info_arg_types(PredInfo, PredTypeVarSet, ExistQVars,
PredArgTypes),
@@ -1648,10 +1650,11 @@
"list length mismatch in polymorphism processing pragma_c"),
polymorphism__c_code_add_typeinfos(
- PredTypeVars, PredTypeVarSet, ExistQVars,
+ PredTypeVars, PredTypeVarSet, ExistQVars, Impl,
ArgInfo0, ArgInfo1),
polymorphism__c_code_add_typeclass_infos(
- UnivCs, ExistCs, PredTypeVarSet, ArgInfo1, ArgInfo),
+ UnivCs, ExistCs, PredTypeVarSet, Impl,
+ ArgInfo1, ArgInfo),
%
% insert type_info/typeclass_info types for all the inserted
@@ -1668,29 +1671,33 @@
:- pred polymorphism__c_code_add_typeclass_infos(
list(class_constraint), list(class_constraint),
- tvarset, list(maybe(pair(string, mode))),
+ tvarset, pragma_foreign_code_impl,
+ list(maybe(pair(string, mode))),
list(maybe(pair(string, mode)))).
-:- mode polymorphism__c_code_add_typeclass_infos(in, in, in, in, out) is det.
+:- mode polymorphism__c_code_add_typeclass_infos(in, in, in, in,
+ in, out) is det.
polymorphism__c_code_add_typeclass_infos(UnivCs, ExistCs,
- PredTypeVarSet, ArgInfo0, ArgInfo) :-
+ PredTypeVarSet, Impl, ArgInfo0, ArgInfo) :-
in_mode(In),
out_mode(Out),
polymorphism__c_code_add_typeclass_infos_2(ExistCs, Out,
- PredTypeVarSet, ArgInfo0, ArgInfo1),
+ PredTypeVarSet, Impl, ArgInfo0, ArgInfo1),
polymorphism__c_code_add_typeclass_infos_2(UnivCs, In,
- PredTypeVarSet, ArgInfo1, ArgInfo).
+ PredTypeVarSet, Impl, ArgInfo1, ArgInfo).
:- pred polymorphism__c_code_add_typeclass_infos_2(
list(class_constraint), mode,
- tvarset, list(maybe(pair(string, mode))),
+ tvarset, pragma_foreign_code_impl,
+ list(maybe(pair(string, mode))),
list(maybe(pair(string, mode)))).
-:- mode polymorphism__c_code_add_typeclass_infos_2(in, in, in, in, out) is det.
-polymorphism__c_code_add_typeclass_infos_2([], _, _, ArgNames, ArgNames).
-polymorphism__c_code_add_typeclass_infos_2([C|Cs], Mode, TypeVarSet,
+:- mode polymorphism__c_code_add_typeclass_infos_2(in, in, in, in,
+ in, out) is det.
+polymorphism__c_code_add_typeclass_infos_2([], _, _, _, ArgNames, ArgNames).
+polymorphism__c_code_add_typeclass_infos_2([C|Cs], Mode, TypeVarSet, Impl,
ArgNames0, ArgNames) :-
polymorphism__c_code_add_typeclass_infos_2(Cs, Mode, TypeVarSet,
- ArgNames0, ArgNames1),
+ Impl, ArgNames0, ArgNames1),
C = constraint(Name0, Types),
prog_out__sym_name_to_string(Name0, "__", Name),
term__vars_list(Types, TypeVars),
@@ -1703,39 +1710,79 @@
list__map(GetName, TypeVars, TypeVarNames),
string__append_list(["TypeClassInfo_for_", Name|TypeVarNames],
C_VarName),
- ArgNames = [yes(C_VarName - Mode) | ArgNames1].
+ (
+ % If the variable name corresponding to the
+ % typeclass-info isn't mentioned in the C code
+ % fragment, don't pass the variable to the
+ % C code at all.
+ foreign_code_does_not_use_variable(Impl, C_VarName)
+ ->
+ ArgNames = [no | ArgNames1]
+ ;
+ ArgNames = [yes(C_VarName - Mode) | ArgNames1]
+ ).
+
:- pred polymorphism__c_code_add_typeinfos(list(tvar),
- tvarset, existq_tvars, list(maybe(pair(string, mode))),
+ tvarset, existq_tvars, pragma_foreign_code_impl,
+ list(maybe(pair(string, mode))),
list(maybe(pair(string, mode)))).
-:- mode polymorphism__c_code_add_typeinfos(in, in, in, in, out) is det.
+:- mode polymorphism__c_code_add_typeinfos(in, in, in, in, in, out) is det.
polymorphism__c_code_add_typeinfos(TVars, TypeVarSet,
- ExistQVars, ArgNames0, ArgNames) :-
+ ExistQVars, Impl, ArgNames0, ArgNames) :-
list__filter(lambda([X::in] is semidet, (list__member(X, ExistQVars))),
TVars, ExistUnconstrainedVars, UnivUnconstrainedVars),
in_mode(In),
out_mode(Out),
polymorphism__c_code_add_typeinfos_2(ExistUnconstrainedVars, TypeVarSet,
- Out, ArgNames0, ArgNames1),
+ Out, Impl, ArgNames0, ArgNames1),
polymorphism__c_code_add_typeinfos_2(UnivUnconstrainedVars, TypeVarSet,
- In, ArgNames1, ArgNames).
+ In, Impl, ArgNames1, ArgNames).
:- pred polymorphism__c_code_add_typeinfos_2(list(tvar),
- tvarset, mode, list(maybe(pair(string, mode))),
+ tvarset, mode, pragma_foreign_code_impl,
+ list(maybe(pair(string, mode))),
list(maybe(pair(string, mode)))).
-:- mode polymorphism__c_code_add_typeinfos_2(in, in, in, in, out) is det.
+:- mode polymorphism__c_code_add_typeinfos_2(in, in, in, in, in, out) is det.
-polymorphism__c_code_add_typeinfos_2([], _, _, ArgNames, ArgNames).
-polymorphism__c_code_add_typeinfos_2([TVar|TVars], TypeVarSet, Mode,
+polymorphism__c_code_add_typeinfos_2([], _, _, _, ArgNames, ArgNames).
+polymorphism__c_code_add_typeinfos_2([TVar|TVars], TypeVarSet, Mode, Impl,
ArgNames0, ArgNames) :-
polymorphism__c_code_add_typeinfos_2(TVars, TypeVarSet,
- Mode, ArgNames0, ArgNames1),
+ Mode, Impl, ArgNames0, ArgNames1),
( varset__search_name(TypeVarSet, TVar, TypeVarName) ->
string__append("TypeInfo_for_", TypeVarName, C_VarName),
- ArgNames = [yes(C_VarName - Mode) | ArgNames1]
+ (
+ % If the variable name corresponding to the
+ % type-info isn't mentioned in the C code
+ % fragment, don't pass the variable to the
+ % C code at all.
+
+ foreign_code_does_not_use_variable(Impl, C_VarName)
+ ->
+ ArgNames = [no | ArgNames1]
+ ;
+ ArgNames = [yes(C_VarName - Mode) | ArgNames1]
+ )
;
ArgNames = [no | ArgNames1]
+ ).
+
+:- pred foreign_code_does_not_use_variable(pragma_foreign_code_impl, string).
+:- mode foreign_code_does_not_use_variable(in, in) is semidet.
+
+foreign_code_does_not_use_variable(Impl, VarName) :-
+ (
+ Impl = ordinary(ForeignBody, _),
+ \+ string__sub_string_search(ForeignBody,
+ VarName, _)
+ ;
+ Impl = nondet(FB1,_,FB2,_,FB3,_,_,FB4,_),
+ \+ string__sub_string_search(FB1, VarName, _),
+ \+ string__sub_string_search(FB2, VarName, _),
+ \+ string__sub_string_search(FB3, VarName, _),
+ \+ string__sub_string_search(FB4, VarName, _)
).
dgj
--
David Jeffery (dgj at cs.mu.oz.au) | If you want to build a ship, don't drum up
PhD student, | people together to collect wood or assign
Dept. of Comp. Sci. & Soft. Eng.| them tasks and work, but rather teach them
The University of Melbourne | to long for the endless immensity of the sea.
Australia | -- Antoine de Saint Exupery
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list