[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