From a11662957fa688997e6c4befff44e7efe94c2db8 Mon Sep 17 00:00:00 2001
From: "simonpj@microsoft.com" <unknown>
Date: Thu, 2 Apr 2009 15:22:46 +0000
Subject: [PATCH] Use a local interestingDict function instead of importing
 SimplUtils.interestingArg

I'm changing the details of SimplUtils.interstingArg, and don't want to
mess  up the way Specialise works, so this patch makes a specilialised
(ha) function, Specialise.interestingDict, that is used locally.
---
 compiler/specialise/Specialise.lhs |   25 +++++++++++++++++--------
 1 file changed, 17 insertions(+), 8 deletions(-)

diff --git a/compiler/specialise/Specialise.lhs b/compiler/specialise/Specialise.lhs
index 037db7a..64d0cdd 100644
--- a/compiler/specialise/Specialise.lhs
+++ b/compiler/specialise/Specialise.lhs
@@ -14,9 +14,9 @@ module Specialise ( specProgram ) where
 
 #include "HsVersions.h"
 
-import Id		( Id, idName, idType, mkUserLocal, idCoreRules,
+import Id		( Id, idName, idType, mkUserLocal, idCoreRules, idUnfolding,
 			  idInlineActivation, setInlineActivation, setIdUnfolding,
-                          isLocalId, idArity, setIdArity ) 
+                          isLocalId, isDataConWorkId, idArity, setIdArity ) 
 import TcType		( Type, mkTyVarTy, tcSplitSigmaTy, 
 			  tyVarsOfTypes, tyVarsOfTheta, isClassPred,
 			  tcCmpType, isUnLiftedType
@@ -27,7 +27,6 @@ import CoreSubst	( Subst, mkEmptySubst, extendTvSubstList, lookupIdSubst,
 			  extendIdSubst
 			) 
 import CoreUnfold	( mkUnfolding )
-import SimplUtils	( interestingArg )
 import Var		( DictId )
 import VarSet
 import VarEnv
@@ -1200,13 +1199,13 @@ mkCallUDs f args
 	--  *don't* say what the value of the implicit param is!
   || not (spec_tys `lengthIs` n_tyvars)
   || not ( dicts   `lengthIs` n_dicts)
-  || not (any interestingArg dicts)	-- Note [Interesting dictionary arguments]
+  || not (any interestingDict dicts)	-- Note [Interesting dictionary arguments]
   -- See also Note [Specialisations already covered]
-  = -- pprTrace "mkCallUDs: discarding" (vcat [ppr f, ppr args, ppr n_tyvars, ppr n_dicts, ppr (map interestingArg dicts)]) 
+  = -- pprTrace "mkCallUDs: discarding" (vcat [ppr f, ppr args, ppr n_tyvars, ppr n_dicts, ppr (map interestingDict dicts)]) 
     emptyUDs	-- Not overloaded, or no specialisation wanted
 
   | otherwise
-  = -- pprTrace "mkCallUDs: keeping" (vcat [ppr f, ppr args, ppr n_tyvars, ppr n_dicts, ppr (map interestingArg dicts)]) 
+  = -- pprTrace "mkCallUDs: keeping" (vcat [ppr f, ppr args, ppr n_tyvars, ppr n_dicts, ppr (map interestingDict dicts)]) 
     singleCall f spec_tys dicts
   where
     (tyvars, theta, _) = tcSplitSigmaTy (idType f)
@@ -1230,9 +1229,19 @@ There really is not much point in specialising f wrt the dictionary d,
 because the code for the specialised f is not improved at all, because
 d is lambda-bound.  We simply get junk specialisations.
 
-We re-use the function SimplUtils.interestingArg function to determine
-what sort of dictionary arguments have *some* information in them.
+What is "interesting"?  Just that it has *some* structure.
 
+\begin{code}
+interestingDict :: CoreExpr -> Bool
+-- A dictionary argument is interesting if it has *some* structure
+interestingDict (Var v) =  hasSomeUnfolding (idUnfolding v)
+			|| isDataConWorkId v
+interestingDict (Type _)	  = False
+interestingDict (App fn (Type _)) = interestingDict fn
+interestingDict (Note _ a)	  = interestingDict a
+interestingDict (Cast e _)	  = interestingDict e
+interestingDict _                 = True
+\end{code}
 
 \begin{code}
 plusUDs :: UsageDetails -> UsageDetails -> UsageDetails
-- 
1.7.10.4