[m-rev.] for review: avoid passing type infos to C code

[David Jeffery]

Hi,

Tyson might be best to review this one. Perhaps there are ramifications for
other backends?

------------------------------------------------------------------------------

Estimated hours taken: 8

mercury/compiler/polymorphism.m:
	Do not pass a type-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: mercury/compiler/polymorphism.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.211
diff -u -t -r1.211 polymorphism.m
--- mercury/compiler/polymorphism.m	2001/05/24 02:32:22	1.211
+++ mercury/compiler/polymorphism.m	2001/07/09 05:14:41
@@ -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,7 +1650,7 @@
                 "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),
@@ -1706,34 +1708,57 @@
         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 (or in any of the nondet C code
+                                % fragments), don't pass the variable to the
+                                % C code at all.
+                        (
+                                Impl = ordinary(ForeignBody, _),
+                                \+ string__sub_string_search(ForeignBody,
+                                        C_VarName, _)
+                        ;
+                                Impl = nondet(FB1,_,FB2,_,FB3,_,_,FB4,_),
+                                \+ string__sub_string_search(FB1, C_VarName, _),
+                                \+ string__sub_string_search(FB2, C_VarName, _),
+                                \+ string__sub_string_search(FB3, C_VarName, _),
+                                \+ string__sub_string_search(FB4, C_VarName, _)
+                        )
+                ->
+                        ArgNames = [no | ArgNames1]
+                ;
+                        ArgNames = [yes(C_VarName - Mode) | ArgNames1]
+                )
         ;
                 ArgNames = [no | ArgNames1]
         ).

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
--------------------------------------------------------------------------