IdInfo.lhs 23.8 KB
 partain committed Jan 08, 1996 1 %  simonm committed Dec 02, 1998 2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998  partain committed Jan 08, 1996 3 4 5 6 7 8 9 10 % \section[IdInfo]{@IdInfos@: Non-essential information about @Ids@} (And a pretty good illustration of quite a few things wrong with Haskell. [WDP 94/11]) \begin{code} module IdInfo (  simonpj committed Mar 08, 2001 11  GlobalIdDetails(..), notGlobalId, -- Not abstract  simonpj committed Dec 19, 1996 12   simonpj committed Mar 08, 2001 13  IdInfo, -- Abstract  simonpj committed Jun 28, 2002 14  vanillaIdInfo, noCafIdInfo, hasCafIdInfo,  simonpj committed Mar 08, 2001 15  seqIdInfo, megaSeqIdInfo,  simonpj committed May 18, 1999 16   simonpj committed Nov 01, 1999 17  -- Zapping  simonpj committed Mar 01, 2001 18  zapLamInfo, zapDemandInfo,  simonpj committed Mar 08, 2001 19  shortableIdInfo, copyIdInfo,  partain committed Jan 08, 1996 20   simonpj committed Mar 19, 1998 21  -- Arity  simonpj committed Jul 23, 2001 22  ArityInfo,  simonpj committed Oct 15, 2001 23 24  unknownArity, arityInfo, setArityInfo, ppArityInfo,  partain committed Jan 08, 1996 25   simonpj committed Jul 17, 2001 26  -- New demand and strictness info  simonpj committed Nov 19, 2001 27  newStrictnessInfo, setNewStrictnessInfo,  simonpj committed Sep 13, 2002 28  newDemandInfo, setNewDemandInfo, pprNewStrictness,  simonpj committed Jul 17, 2001 29   simonpj committed Mar 23, 2000 30 31 32  -- Strictness; imported from Demand StrictnessInfo(..), mkStrictnessInfo, noStrictnessInfo,  simonpj committed Mar 27, 2000 33  ppStrictnessInfo,isBottomingStrictness,  simonmar committed Dec 10, 2001 34  setAllStrictnessInfo,  simonpj committed Mar 19, 1998 35   kglynn committed Apr 13, 1999 36  -- Worker  simonpj committed Mar 23, 2000 37  WorkerInfo(..), workerExists, wrapperArity, workerId,  simonpj committed Jul 06, 1999 38  workerInfo, setWorkerInfo, ppWorkerInfo,  kglynn committed Apr 13, 1999 39   simonpj committed Mar 19, 1998 40 41  -- Unfolding unfoldingInfo, setUnfoldingInfo,  partain committed Jan 08, 1996 42   simonmar committed Mar 15, 2002 43 #ifdef OLD_STRICTNESS  simonmar committed Dec 10, 2001 44  -- Old DemandInfo and StrictnessInfo  simonm committed Dec 02, 1998 45  demandInfo, setDemandInfo,  simonmar committed Dec 10, 2001 46 47 48 49 50 51 52 53  strictnessInfo, setStrictnessInfo, cprInfoFromNewStrictness, oldStrictnessFromNew, newStrictnessFromOld, oldDemand, newDemand, -- Constructed Product Result Info CprInfo(..), cprInfo, setCprInfo, ppCprInfo, noCprInfo, #endif  simonm committed Dec 02, 1998 54   simonpj committed Mar 19, 1998 55  -- Inline prags  simonpj committed Oct 15, 2001 56  InlinePragInfo,  simonpj committed Sep 26, 2001 57  inlinePragInfo, setInlinePragInfo,  simonpj committed Nov 01, 1999 58 59  -- Occurrence info  simonpj committed Sep 07, 2000 60  OccInfo(..), isFragileOcc, isDeadOcc, isLoopBreaker,  simonpj committed Mar 23, 2000 61 62  InsideLam, OneBranch, insideLam, notInsideLam, oneBranch, notOneBranch, occInfo, setOccInfo,  partain committed Jan 08, 1996 63   simonpj committed Mar 19, 1998 64  -- Specialisation  simonpj committed May 18, 1999 65  specInfo, setSpecInfo,  partain committed Jan 08, 1996 66   simonmar committed Mar 13, 2001 67  -- CG info  simonpj committed Sep 20, 2001 68  CgInfo(..), cgInfo, setCgInfo, pprCgInfo,  simonpj committed Oct 18, 2001 69  cgCafInfo, vanillaCgInfo,  simonmar committed Mar 13, 2001 70 71  CgInfoEnv, lookupCgInfo,  simonm committed Dec 02, 1998 72  -- CAF info  simonmar committed Mar 13, 2001 73  CafInfo(..), ppCafInfo, setCafInfo, mayHaveCafRefs,  kglynn committed Apr 13, 1999 74   keithw committed May 11, 1999 75  -- Lambda-bound variable info  simonpj committed Mar 01, 2001 76  LBVarInfo(..), lbvarInfo, setLBVarInfo, noLBVarInfo, hasNoLBVarInfo  partain committed Jan 08, 1996 77 78  ) where  simonm committed Jan 08, 1998 79 #include "HsVersions.h"  partain committed Mar 19, 1996 80 81   simonpj committed Mar 27, 2000 82 import CoreSyn  simonpj committed Jun 25, 2001 83 import Type ( Type, usOnce, eqUsage )  simonpj committed Mar 23, 2000 84 import PrimOp ( PrimOp )  simonmar committed Mar 13, 2001 85 86 import NameEnv ( NameEnv, lookupNameEnv ) import Name ( Name )  sof committed Apr 13, 1999 87 import Var ( Id )  simonpj committed Sep 07, 2000 88 import BasicTypes ( OccInfo(..), isFragileOcc, isDeadOcc, seqOccInfo, isLoopBreaker,  simonpj committed Mar 23, 2000 89 90  InsideLam, insideLam, notInsideLam, OneBranch, oneBranch, notOneBranch,  simonpj committed Sep 26, 2001 91 92  Arity, Activation(..)  simonpj committed Mar 23, 2000 93 94  ) import DataCon ( DataCon )  simonpj committed May 22, 2001 95 import ForeignCall ( ForeignCall )  simonpj committed May 18, 1999 96 import FieldLabel ( FieldLabel )  simonpj committed Sep 13, 2002 97 import Type ( usOnce )  simonmar committed Dec 10, 2001 98 import Demand hiding( Demand, seqDemand )  qrczak committed Jul 23, 2001 99 import qualified Demand  simonmar committed Dec 10, 2001 100 import NewDemand  simonm committed Jan 08, 1998 101 import Outputable  simonpj committed Sep 13, 2002 102 import Util ( listLengthCmp )  simonpj committed Apr 04, 2002 103 import Maybe ( isJust )  simonpj committed Jul 17, 2001 104 import List ( replicate )  kglynn committed Apr 13, 1999 105   simonmar committed Dec 10, 2001 106 -- infixl so you can say (id set a set b)  simonpj committed Jun 14, 2002 107 infixl 1 setSpecInfo,  simonpj committed May 18, 1999 108 109 110 111  setArityInfo, setInlinePragInfo, setUnfoldingInfo, setWorkerInfo,  simonmar committed Nov 07, 2000 112  setLBVarInfo,  simonmar committed Mar 13, 2001 113 114  setOccInfo, setCgInfo,  simonpj committed Nov 01, 1999 115  setCafInfo,  simonpj committed Jul 17, 2001 116  setNewStrictnessInfo,  simonpj committed Nov 19, 2001 117  setAllStrictnessInfo,  sewardj committed Dec 11, 2001 118  setNewDemandInfo  simonmar committed Mar 15, 2002 119 #ifdef OLD_STRICTNESS  sewardj committed Dec 11, 2001 120 121 122  , setCprInfo , setDemandInfo , setStrictnessInfo  simonmar committed Dec 10, 2001 123 #endif  partain committed Jan 08, 1996 124 125 \end{code}  simonpj committed Jul 17, 2001 126 127 128 129 130 131 132 133 134 %************************************************************************ %* * \subsection{New strictness info} %* * %************************************************************************ To be removed later \begin{code}  sewardj committed Dec 11, 2001 135 -- setAllStrictnessInfo :: IdInfo -> Maybe StrictSig -> IdInfo  simonpj committed Nov 19, 2001 136 137 -- Set old and new strictness info setAllStrictnessInfo info Nothing  sewardj committed Dec 11, 2001 138  = info { newStrictnessInfo = Nothing  simonmar committed Mar 15, 2002 139 #ifdef OLD_STRICTNESS  sewardj committed Dec 11, 2001 140 141  , strictnessInfo = NoStrictnessInfo , cprInfo = NoCPRInfo  simonmar committed Dec 10, 2001 142 #endif  sewardj committed Dec 11, 2001 143 144  }  simonpj committed Nov 19, 2001 145 setAllStrictnessInfo info (Just sig)  sewardj committed Dec 11, 2001 146  = info { newStrictnessInfo = Just sig  simonmar committed Mar 15, 2002 147 #ifdef OLD_STRICTNESS  sewardj committed Dec 11, 2001 148 149  , strictnessInfo = oldStrictnessFromNew sig , cprInfo = cprInfoFromNewStrictness sig  simonmar committed Dec 10, 2001 150 #endif  sewardj committed Dec 11, 2001 151  }  simonmar committed Dec 10, 2001 152 153 154  seqNewStrictnessInfo Nothing = () seqNewStrictnessInfo (Just ty) = seqStrictSig ty  simonpj committed Nov 19, 2001 155   simonpj committed Sep 13, 2002 156 157 158 pprNewStrictness Nothing = empty pprNewStrictness (Just sig) = ftext FSLIT("Str:") <+> ppr sig  simonmar committed Mar 15, 2002 159 #ifdef OLD_STRICTNESS  simonpj committed Nov 19, 2001 160 161 162 163 164 165 166 167 168 169 170 171 oldStrictnessFromNew :: StrictSig -> Demand.StrictnessInfo oldStrictnessFromNew sig = mkStrictnessInfo (map oldDemand dmds, isBotRes res_info) where (dmds, res_info) = splitStrictSig sig cprInfoFromNewStrictness :: StrictSig -> CprInfo cprInfoFromNewStrictness sig = case strictSigResInfo sig of RetCPR -> ReturnsCPR other -> NoCPRInfo newStrictnessFromOld :: Name -> Arity -> Demand.StrictnessInfo -> CprInfo -> StrictSig newStrictnessFromOld name arity (Demand.StrictnessInfo ds res) cpr  sof committed Oct 25, 2001 172  | listLengthCmp ds arity /= GT -- length ds <= arity  simonpj committed Jul 19, 2001 173 174  -- Sometimes the old strictness analyser has more -- demands than the arity justifies  simonpj committed Nov 19, 2001 175  = mk_strict_sig name arity $ simonpj committed Aug 24, 2001 176 177  mkTopDmdType (map newDemand ds) (newRes res cpr)  simonpj committed Nov 19, 2001 178 newStrictnessFromOld name arity other cpr  simonpj committed Aug 24, 2001 179 180  = -- Either no strictness info, or arity is too small -- In either case we can't say anything useful  simonpj committed Nov 19, 2001 181  mk_strict_sig name arity$  simonpj committed Aug 24, 2001 182  mkTopDmdType (replicate arity lazyDmd) (newRes False cpr)  simonpj committed Jul 17, 2001 183   simonpj committed Nov 19, 2001 184 185 mk_strict_sig name arity dmd_ty = WARN( arity /= dmdTypeDepth dmd_ty, ppr name <+> (ppr arity  ppr dmd_ty) )  simonpj committed Sep 07, 2001 186 187  mkStrictSig dmd_ty  simonpj committed Jul 23, 2001 188 newRes True _ = BotRes  simonpj committed Apr 22, 2002 189 newRes False ReturnsCPR = retCPR  simonpj committed Jul 23, 2001 190 191 192 193 newRes False NoCPRInfo = TopRes newDemand :: Demand.Demand -> NewDemand.Demand newDemand (WwLazy True) = Abs  simonpj committed Nov 19, 2001 194 195 196 197 198 newDemand (WwLazy False) = lazyDmd newDemand WwStrict = evalDmd newDemand (WwUnpack unpk ds) = Eval (Prod (map newDemand ds)) newDemand WwPrim = lazyDmd newDemand WwEnum = evalDmd  simonpj committed Jul 23, 2001 199 200  oldDemand :: NewDemand.Demand -> Demand.Demand  simonpj committed Nov 19, 2001 201 202 203 204 205 206 207 208 209 210 oldDemand Abs = WwLazy True oldDemand Top = WwLazy False oldDemand Bot = WwStrict oldDemand (Box Bot) = WwStrict oldDemand (Box Abs) = WwLazy False oldDemand (Box (Eval _)) = WwStrict -- Pass box only oldDemand (Defer d) = WwLazy False oldDemand (Eval (Prod ds)) = WwUnpack True (map oldDemand ds) oldDemand (Eval (Poly _)) = WwStrict oldDemand (Call _) = WwStrict  simonmar committed Dec 10, 2001 211   simonmar committed Mar 15, 2002 212 #endif /* OLD_STRICTNESS */  simonpj committed Jul 17, 2001 213 214 215 \end{code}  simonpj committed Apr 04, 2002 216 217 218 219 220 221 \begin{code} seqNewDemandInfo Nothing = () seqNewDemandInfo (Just dmd) = seqDemand dmd \end{code}  simonpj committed Mar 08, 2001 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 %************************************************************************ %* * \subsection{GlobalIdDetails %* * %************************************************************************ This type is here (rather than in Id.lhs) mainly because there's an IdInfo.hi-boot, but no Id.hi-boot, and GlobalIdDetails is imported (recursively) by Var.lhs. \begin{code} data GlobalIdDetails = VanillaGlobal -- Imported from elsewhere, a default method Id. | RecordSelId FieldLabel -- The Id for a record selector | DataConId DataCon -- The Id for a data constructor *worker* | DataConWrapId DataCon -- The Id for a data constructor *wrapper* -- [the only reasons we need to know is so that -- a) we can suppress printing a definition in the interface file -- b) when typechecking a pattern we can get from the -- Id back to the data con] | PrimOpId PrimOp -- The Id for a primitive operator  simonpj committed May 22, 2001 245  | FCallId ForeignCall -- The Id for a foreign call  simonpj committed Mar 08, 2001 246 247 248 249 250 251 252 253 254 255 256  | NotGlobalId -- Used as a convenient extra return value from globalIdDetails notGlobalId = NotGlobalId instance Outputable GlobalIdDetails where ppr NotGlobalId = ptext SLIT("[***NotGlobalId***]") ppr VanillaGlobal = ptext SLIT("[GlobalId]") ppr (DataConId _) = ptext SLIT("[DataCon]") ppr (DataConWrapId _) = ptext SLIT("[DataConWrapper]") ppr (PrimOpId _) = ptext SLIT("[PrimOp]")  simonpj committed May 22, 2001 257  ppr (FCallId _) = ptext SLIT("[ForeignCall]")  simonpj committed Mar 08, 2001 258 259 260 261 262 263 264 265 266 267  ppr (RecordSelId _) = ptext SLIT("[RecSel]") \end{code} %************************************************************************ %* * \subsection{The main IdInfo type} %* * %************************************************************************  partain committed Jan 08, 1996 268 269 270 271 272 273 274 275 276 277 An @IdInfo@ gives {\em optional} information about an @Id@. If present it never lies, but it may not be present, in which case there is always a conservative assumption which can be made. Two @Id@s may have different info even though they have the same @Unique@ (and are hence the same @Id@); for example, one might lack the properties attached to the other. The @IdInfo@ gives information about the value, or definition, of the @Id@. It does {\em not} contain information about the @Id@'s usage  keithw committed May 11, 1999 278 279 (except for @DemandInfo@? ToDo). (@lbvarInfo@ is also a marginal case. KSW 1999-04).  partain committed Jan 08, 1996 280 281 282  \begin{code} data IdInfo  simonpj committed Mar 19, 1998 283  = IdInfo {  simonmar committed Dec 10, 2001 284  arityInfo :: !ArityInfo, -- Its arity  simonpj committed May 18, 1999 285  specInfo :: CoreRules, -- Specialisations of this function which exist  simonmar committed Mar 15, 2002 286 #ifdef OLD_STRICTNESS  simonmar committed Dec 10, 2001 287 288  cprInfo :: CprInfo, -- Function always constructs a product result demandInfo :: Demand.Demand, -- Whether or not it is definitely demanded  simonpj committed May 18, 1999 289  strictnessInfo :: StrictnessInfo, -- Strictness properties  simonmar committed Dec 10, 2001 290 #endif  simonpj committed May 18, 1999 291 292  workerInfo :: WorkerInfo, -- Pointer to Worker Function unfoldingInfo :: Unfolding, -- Its unfolding  simonmar committed Mar 13, 2001 293  cgInfo :: CgInfo, -- Code generator info (arity, CAF info)  simonpj committed May 18, 1999 294  lbvarInfo :: LBVarInfo, -- Info about a lambda-bound variable  simonpj committed Nov 01, 1999 295  inlinePragInfo :: InlinePragInfo, -- Inline pragma  simonpj committed Jul 17, 2001 296 297  occInfo :: OccInfo, -- How it occurs  simonpj committed Oct 03, 2001 298 299 300 301  newStrictnessInfo :: Maybe StrictSig, -- Reason for Maybe: the DmdAnal phase needs to -- know whether whether this is the first visit, -- so it can assign botSig. Other customers want -- topSig. So Nothing is good.  simonpj committed Apr 04, 2002 302 303 304 305  newDemandInfo :: Maybe Demand -- Similarly we want to know if there's no -- known demand yet, for when we are looking for -- CPR info  simonpj committed Mar 19, 1998 306  }  simonpj committed Jul 14, 1999 307 308 309 310 311 312  seqIdInfo :: IdInfo -> () seqIdInfo (IdInfo {}) = () megaSeqIdInfo :: IdInfo -> () megaSeqIdInfo info  simonmar committed Dec 10, 2001 313  = seqRules (specInfo info) seq  simonpj committed Mar 23, 2000 314  seqWorker (workerInfo info) seq  simonpj committed Jul 14, 1999 315 316 317  -- Omitting this improves runtimes a little, presumably because -- some unfoldings are not calculated at all  simonmar committed Dec 10, 2001 318 319 -- seqUnfolding (unfoldingInfo info) seq  simonpj committed Apr 04, 2002 320  seqNewDemandInfo (newDemandInfo info) seq  simonmar committed Dec 10, 2001 321 322  seqNewStrictnessInfo (newStrictnessInfo info) seq  simonmar committed Mar 15, 2002 323 #ifdef OLD_STRICTNESS  simonmar committed Dec 10, 2001 324 325 326 327  Demand.seqDemand (demandInfo info) seq seqStrictnessInfo (strictnessInfo info) seq seqCpr (cprInfo info) seq #endif  simonpj committed Jul 14, 1999 328   simonmar committed Mar 13, 2001 329 330 331 -- CgInfo is involved in a loop, so we have to be careful not to seq it -- too early. -- seqCg (cgInfo info) seq  simonpj committed Jul 14, 1999 332  seqLBVar (lbvarInfo info) seq  simonpj committed Nov 01, 1999 333  seqOccInfo (occInfo info)  simonpj committed Mar 19, 1998 334 \end{code}  partain committed Jan 08, 1996 335   simonpj committed Mar 19, 1998 336 Setters  partain committed Jan 08, 1996 337   simonpj committed Mar 19, 1998 338 \begin{code}  simonpj committed Jul 14, 1999 339 setWorkerInfo info wk = wk seq info { workerInfo = wk }  sof committed Oct 23, 2001 340 setSpecInfo info sp = sp seq info { specInfo = sp }  simonpj committed Jul 14, 1999 341 setInlinePragInfo info pr = pr seq info { inlinePragInfo = pr }  simonpj committed Nov 01, 1999 342 setOccInfo info oc = oc seq info { occInfo = oc }  simonmar committed Mar 15, 2002 343 #ifdef OLD_STRICTNESS  simonpj committed Jul 14, 1999 344 setStrictnessInfo info st = st seq info { strictnessInfo = st }  simonmar committed Dec 10, 2001 345 #endif  simonpj committed Jul 14, 1999 346 347  -- Try to avoid spack leaks by seq'ing  simonpj committed Mar 30, 2000 348 setUnfoldingInfo info uf  simonpj committed Sep 11, 2001 349  | isEvaldUnfolding uf  simonpj committed Mar 30, 2000 350 351 352 353 354 355 356 357 358  -- If the unfolding is a value, the demand info may -- go pear-shaped, so we nuke it. Example: -- let x = (a,b) in -- case x of (p,q) -> h p q x -- Here x is certainly demanded. But after we've nuked -- the case, we'll get just -- let x = (a,b) in h a b x -- and now x is not demanded (I'm assuming h is lazy) -- This really happens. The solution here is a bit ad hoc...  simonpj committed Apr 04, 2002 359  = info { unfoldingInfo = uf, newDemandInfo = Nothing }  simonpj committed Mar 30, 2000 360 361  | otherwise  simonpj committed Jul 14, 1999 362 363  -- We do *not* seq on the unfolding info, For some reason, doing so -- actually increases residency significantly.  simonpj committed Mar 30, 2000 364  = info { unfoldingInfo = uf }  simonpj committed Jul 14, 1999 365   simonmar committed Mar 15, 2002 366 #ifdef OLD_STRICTNESS  simonpj committed May 18, 1999 367 setDemandInfo info dd = info { demandInfo = dd }  simonmar committed Dec 10, 2001 368 369 370 setCprInfo info cp = info { cprInfo = cp } #endif  simonpj committed Oct 15, 2001 371 setArityInfo info ar = info { arityInfo = ar }  simonmar committed Mar 13, 2001 372 setCgInfo info cg = info { cgInfo = cg }  simonpj committed Jul 17, 2001 373   simonmar committed Dec 10, 2001 374 375 376 377 setLBVarInfo info lb = {-lb seq-} info { lbvarInfo = lb } setNewDemandInfo info dd = dd seq info { newDemandInfo = dd } setNewStrictnessInfo info dd = dd seq info { newStrictnessInfo = dd }  partain committed Jan 08, 1996 378 379 \end{code}  simonpj committed Mar 19, 1998 380   partain committed Jan 08, 1996 381 \begin{code}  simonpj committed May 18, 1999 382 vanillaIdInfo :: IdInfo  simonpj committed Mar 08, 2001 383 vanillaIdInfo  simonpj committed Dec 08, 2000 384  = IdInfo {  simonmar committed Mar 13, 2001 385  cgInfo = noCgInfo,  simonpj committed Jul 20, 2001 386  arityInfo = unknownArity,  simonmar committed Mar 15, 2002 387 #ifdef OLD_STRICTNESS  simonmar committed Dec 10, 2001 388  cprInfo = NoCPRInfo,  simonpj committed Dec 08, 2000 389  demandInfo = wwLazy,  simonmar committed Dec 10, 2001 390 391  strictnessInfo = NoStrictnessInfo, #endif  simonpj committed Dec 08, 2000 392 393 394 395  specInfo = emptyCoreRules, workerInfo = NoWorker, unfoldingInfo = noUnfolding, lbvarInfo = NoLBVarInfo,  simonpj committed Sep 26, 2001 396  inlinePragInfo = AlwaysActive,  simonpj committed Jul 17, 2001 397  occInfo = NoOccInfo,  simonpj committed Apr 04, 2002 398  newDemandInfo = Nothing,  simonpj committed Jul 17, 2001 399  newStrictnessInfo = Nothing  simonpj committed Mar 19, 1998 400  }  simonpj committed Nov 14, 2000 401   simonpj committed Jun 28, 2002 402 403 hasCafIdInfo = vanillaIdInfo setCgInfo CgInfo MayHaveCafRefs noCafIdInfo = vanillaIdInfo setCgInfo CgInfo NoCafRefs  simonmar committed Mar 13, 2001 404  -- Used for built-in type Ids in MkId.  simonpj committed Jun 28, 2002 405 406  -- These must have a valid CgInfo set, so you can't -- use vanillaIdInfo!  simonpj committed May 18, 1999 407 408 409 \end{code}  partain committed Jan 08, 1996 410 411 412 413 414 415 %************************************************************************ %* * \subsection[arity-IdInfo]{Arity info about an @Id@} %* * %************************************************************************  simonm committed Dec 02, 1998 416 417 418 419 For locally-defined Ids, the code generator maintains its own notion of their arities; so it should not be asking... (but other things besides the code-generator need arity info!)  partain committed Jan 08, 1996 420 \begin{code}  simonpj committed Oct 15, 2001 421 type ArityInfo = Arity  simonpj committed Jul 20, 2001 422 423 424 425  -- A partial application of this Id to up to n-1 value arguments -- does essentially no work. That is not necessarily the -- same as saying that it has n leading lambdas, because coerces -- may get in the way.  simonpj committed Aug 24, 1999 426   simonpj committed Jul 20, 2001 427 428  -- The arity might increase later in the compilation process, if -- an extra lambda floats up to the binding site.  partain committed Jan 08, 1996 429   simonpj committed Oct 15, 2001 430 unknownArity = 0 :: Arity  partain committed Jan 08, 1996 431   simonpj committed Oct 15, 2001 432 433 ppArityInfo 0 = empty ppArityInfo n = hsep [ptext SLIT("Arity"), int n]  partain committed Jan 08, 1996 434 435 436 437 \end{code} %************************************************************************ %* *  simonpj committed Mar 19, 1998 438 \subsection{Inline-pragma information}  partain committed Jan 08, 1996 439 440 441 442 %* * %************************************************************************ \begin{code}  simonpj committed Sep 26, 2001 443 444 445 446 447 448 449 type InlinePragInfo = Activation -- Tells when the inlining is active -- When it is active the thing may be inlined, depending on how -- big it is. -- -- If there was an INLINE pragma, then as a separate matter, the -- RHS will have been made to look small with a CoreSyn Inline Note  simonpj committed Nov 01, 1999 450 \end{code}  simonmar committed Nov 07, 2000 451 452   kglynn committed Apr 13, 1999 453 454 455 456 457 458 459 460 %************************************************************************ %* * \subsection[worker-IdInfo]{Worker info about an @Id@} %* * %************************************************************************ If this Id has a worker then we store a reference to it. Worker functions are generated by the worker/wrapper pass. This uses  simonmar committed Dec 10, 2001 461 information from strictness analysis.  kglynn committed Apr 13, 1999 462 463 464 465 466  There might not be a worker, even for a strict function, because: (a) the function might be small enough to inline, so no need for w/w split (b) the strictness info might be "SSS" or something, so no w/w split.  partain committed Jan 08, 1996 467   simonmar committed Mar 13, 2001 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 Sometimes the arity of a wrapper changes from the original arity from which it was generated, so we always emit the "original" arity into the interface file, as part of the worker info. How can this happen? Sometimes we get f = coerce t (\x y -> $wf x y) at the moment of w/w split; but the eta reducer turns it into f = coerce t$wf which is perfectly fine except that the exposed arity so far as the code generator is concerned (zero) differs from the arity when we did the split (2). All this arises because we use 'arity' to mean "exactly how many top level lambdas are there" in interface files; but during the compilation of this module it means "how many things can I apply this to".  partain committed Jan 08, 1996 485 \begin{code}  kglynn committed Apr 13, 1999 486   simonpj committed Mar 23, 2000 487 488 489 data WorkerInfo = NoWorker | HasWorker Id Arity -- The Arity is the arity of the *wrapper* at the moment of the  simonpj committed Sep 07, 2000 490  -- w/w split. See comments in MkIface.ifaceId, with the 'Worker' code.  kglynn committed Apr 13, 1999 491   simonpj committed Jul 14, 1999 492 seqWorker :: WorkerInfo -> ()  simonmar committed Dec 10, 2001 493 seqWorker (HasWorker id a) = id seq a seq ()  simonpj committed Mar 23, 2000 494 seqWorker NoWorker = ()  simonpj committed Jul 14, 1999 495   simonpj committed Mar 23, 2000 496 497 ppWorkerInfo NoWorker = empty ppWorkerInfo (HasWorker wk_id _) = ptext SLIT("__P") <+> ppr wk_id  sof committed Apr 13, 1999 498   simonpj committed Sep 17, 1999 499 workerExists :: WorkerInfo -> Bool  simonpj committed Mar 23, 2000 500 501 502 503 504 505 506 507 workerExists NoWorker = False workerExists (HasWorker _ _) = True workerId :: WorkerInfo -> Id workerId (HasWorker id _) = id wrapperArity :: WorkerInfo -> Arity wrapperArity (HasWorker _ a) = a  partain committed Jan 08, 1996 508 509 510 511 512 \end{code} %************************************************************************ %* *  simonmar committed Mar 13, 2001 513 \subsection[CG-IdInfo]{Code generator-related information}  partain committed Jan 08, 1996 514 515 516 %* * %************************************************************************  simonmar committed Mar 13, 2001 517 518 519 520 CgInfo encapsulates calling-convention information produced by the code generator. It is pasted into the IdInfo of each emitted Id by CoreTidy, but only as a thunk --- the information is only actually produced further downstream, by the code generator.  partain committed Jan 08, 1996 521 522  \begin{code}  simonmar committed Mar 15, 2002 523 #ifndef OLD_STRICTNESS  simonpj committed Oct 18, 2001 524 525 526 527 newtype CgInfo = CgInfo CafInfo -- We are back to only having CafRefs in CgInfo noCgInfo = panic "NoCgInfo!" #else data CgInfo = CgInfo CafInfo  simonpj committed May 14, 2001 528 529 530 531 532  | NoCgInfo -- In debug mode we don't want a black hole here -- See Id.idCgInfo -- noCgInfo is used for local Ids, which shouldn't need any CgInfo noCgInfo = NoCgInfo #endif  simonmar committed Mar 13, 2001 533   simonpj committed Oct 18, 2001 534 cgCafInfo (CgInfo caf_info) = caf_info  simonmar committed Mar 13, 2001 535   simonpj committed Oct 18, 2001 536 setCafInfo info caf_info = info setCgInfo CgInfo caf_info  simonmar committed Mar 13, 2001 537 538 539  seqCg c = c seq () -- fields are strict anyhow  simonpj committed Oct 18, 2001 540 vanillaCgInfo = CgInfo MayHaveCafRefs -- Definitely safe  simonmar committed Mar 13, 2001 541 542 543  -- CafInfo is used to build Static Reference Tables (see simplStg/SRT.lhs).  simonm committed Dec 02, 1998 544 545 546 547 548 data CafInfo = MayHaveCafRefs -- either: -- (1) A function or static constructor -- that refers to one or more CAFs, -- (2) A real live CAF  partain committed Jan 08, 1996 549   simonm committed Dec 02, 1998 550 551  | NoCafRefs -- A function or static constructor -- that refers to no CAFs.  simonpj committed Dec 19, 1996 552   simonmar committed Mar 13, 2001 553 554 mayHaveCafRefs MayHaveCafRefs = True mayHaveCafRefs _ = False  simonpj committed Mar 19, 1998 555   simonmar committed Mar 13, 2001 556 seqCaf c = c seq ()  partain committed Jan 08, 1996 557   simonpj committed Oct 18, 2001 558 pprCgInfo (CgInfo caf_info) = ppCafInfo caf_info  simonmar committed Dec 20, 2000 559   simonmar committed Mar 13, 2001 560 561 ppArity 0 = empty ppArity n = hsep [ptext SLIT("__A"), int n]  simonpj committed Jul 14, 1999 562   simonm committed Dec 02, 1998 563 564 ppCafInfo NoCafRefs = ptext SLIT("__C") ppCafInfo MayHaveCafRefs = empty  partain committed Jan 08, 1996 565 \end{code}  kglynn committed Apr 13, 1999 566   simonmar committed Mar 13, 2001 567 568 569 570 571 572 573 574 575 \begin{code} type CgInfoEnv = NameEnv CgInfo lookupCgInfo :: NameEnv CgInfo -> Name -> CgInfo lookupCgInfo env n = case lookupNameEnv env n of Just info -> info Nothing -> pprTrace "Urk! Not in CgInfo env" (ppr n) vanillaCgInfo \end{code}  simonpj committed May 18, 1999 576   kglynn committed Apr 13, 1999 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 %************************************************************************ %* * \subsection[cpr-IdInfo]{Constructed Product Result info about an @Id@} %* * %************************************************************************ If the @Id@ is a function then it may have CPR info. A CPR analysis phase detects whether: \begin{enumerate} \item The function's return value has a product type, i.e. an algebraic type with a single constructor. Examples of such types are tuples and boxed primitive values. \item The function always 'constructs' the value that it is returning. It must do this on every path through, and it's OK if it calls another function which constructs the result. \end{enumerate} If this is the case then we store a template which tells us the function has the CPR property and which components of the result are also CPRs. \begin{code}  simonmar committed Mar 15, 2002 602 #ifdef OLD_STRICTNESS  kglynn committed Apr 13, 1999 603 604 data CprInfo = NoCPRInfo  simonpj committed Mar 23, 2000 605 606 607 608 609 610 611 612  | ReturnsCPR -- Yes, this function returns a constructed product -- Implicitly, this means "after the function has been applied -- to all its arguments", so the worker/wrapper builder in -- WwLib.mkWWcpr checks that that it is indeed saturated before -- making use of the CPR info -- We used to keep nested info about sub-components, but -- we never used it so I threw it away  kglynn committed Apr 13, 1999 613   simonpj committed Jul 14, 1999 614 seqCpr :: CprInfo -> ()  simonpj committed Mar 23, 2000 615 616 seqCpr ReturnsCPR = () seqCpr NoCPRInfo = ()  kglynn committed Apr 13, 1999 617 618 619  noCprInfo = NoCPRInfo  simonpj committed Mar 23, 2000 620 621 ppCprInfo NoCPRInfo = empty ppCprInfo ReturnsCPR = ptext SLIT("__M")  kglynn committed Apr 13, 1999 622 623 624 625 626 627  instance Outputable CprInfo where ppr = ppCprInfo instance Show CprInfo where showsPrec p c = showsPrecSDoc p (ppr c)  simonmar committed Dec 10, 2001 628 #endif  kglynn committed Apr 13, 1999 629 630 631 \end{code}  keithw committed May 11, 1999 632 633 634 635 636 %************************************************************************ %* * \subsection[lbvar-IdInfo]{Lambda-bound var info about an @Id@} %* * %************************************************************************  kglynn committed Apr 13, 1999 637   keithw committed May 11, 1999 638 639 640 641 642 643 644 645 646 647 648 649 650 If the @Id@ is a lambda-bound variable then it may have lambda-bound var info. The usage analysis (UsageSP) detects whether the lambda binding this var is a one-shot'' lambda; that is, whether it is applied at most once. This information may be useful in optimisation, as computations may safely be floated inside such a lambda without risk of duplicating work. \begin{code} data LBVarInfo = NoLBVarInfo  simonmar committed Nov 07, 2000 651 652 653 654  | LBVarInfo Type -- The lambda that binds this Id has this usage -- annotation (i.e., if ==usOnce, then the -- lambda is applied at most once). -- The annotation's kind must be \$'  keithw committed May 11, 1999 655 656 657  -- HACK ALERT! placing this info here is a short-term hack, -- but it minimises changes to the rest of the compiler. -- Hack agreed by SLPJ/KSW 1999-04.  simonpj committed Jul 14, 1999 658 659  seqLBVar l = l seq ()  keithw committed May 11, 1999 660 661 662 \end{code} \begin{code}  simonpj committed Mar 01, 2001 663 664 665 hasNoLBVarInfo NoLBVarInfo = True hasNoLBVarInfo other = False  keithw committed May 11, 1999 666 667 668 669 noLBVarInfo = NoLBVarInfo -- not safe to print or parse LBVarInfo because it is not really a -- property of the definition, but a property of the context.  simonpj committed Jun 22, 1999 670 pprLBVarInfo NoLBVarInfo = empty  simonpj committed Jun 25, 2001 671 pprLBVarInfo (LBVarInfo u) | u eqUsage usOnce  simonmar committed Mar 14, 2002 672  = ptext SLIT("OneShot")  simonmar committed Nov 07, 2000 673 674  | otherwise = empty  keithw committed May 11, 1999 675 676  instance Outputable LBVarInfo where  simonpj committed Jun 22, 1999 677  ppr = pprLBVarInfo  keithw committed May 11, 1999 678 679 680 681  instance Show LBVarInfo where showsPrec p c = showsPrecSDoc p (ppr c) \end{code}  simonpj committed Nov 01, 1999 682 683 684 685 686 687 688 689 690 691 692 693 694  %************************************************************************ %* * \subsection{Bulk operations on IdInfo} %* * %************************************************************************ @zapLamInfo@ is used for lambda binders that turn out to to be part of an unsaturated lambda \begin{code} zapLamInfo :: IdInfo -> Maybe IdInfo  simonpj committed Sep 11, 2001 695 zapLamInfo info@(IdInfo {occInfo = occ, newDemandInfo = demand})  simonpj committed Apr 04, 2002 696  | is_safe_occ occ && is_safe_dmd demand  simonpj committed Nov 01, 1999 697 698  = Nothing | otherwise  simonpj committed Apr 04, 2002 699  = Just (info {occInfo = safe_occ, newDemandInfo = Nothing})  simonpj committed Nov 01, 1999 700 701 702  where -- The "unsafe" occ info is the ones that say I'm not in a lambda -- because that might not be true for an unsaturated lambda  simonpj committed Apr 04, 2002 703 704  is_safe_occ (OneOcc in_lam once) = in_lam is_safe_occ other = True  simonpj committed Nov 01, 1999 705 706 707 708  safe_occ = case occ of OneOcc _ once -> OneOcc insideLam once other -> occ  simonpj committed Apr 04, 2002 709 710 711  is_safe_dmd Nothing = True is_safe_dmd (Just dmd) = not (isStrictDmd dmd)  simonpj committed Nov 01, 1999 712 713 \end{code}  simonpj committed Mar 01, 2001 714 715 \begin{code} zapDemandInfo :: IdInfo -> Maybe IdInfo  simonpj committed Apr 04, 2002 716 717 718 zapDemandInfo info@(IdInfo {newDemandInfo = dmd}) | isJust dmd = Just (info {newDemandInfo = Nothing}) | otherwise = Nothing  simonpj committed Mar 01, 2001 719 720 \end{code}  simonpj committed Nov 01, 1999 721 722 723 724 725 726 727 728  copyIdInfo is used when shorting out a top-level binding f_local = BIG f = f_local where f is exported. We are going to swizzle it around to f = BIG f_local = f  simonpj committed Sep 14, 2000 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 BUT (a) we must be careful about messing up rules (b) we must ensure f's IdInfo ends up right (a) Messing up the rules ~~~~~~~~~~~~~~~~~~~~ The example that went bad on me was this one: iterate :: (a -> a) -> a -> [a] iterate = iterateList iterateFB c f x = x c iterateFB c f (f x) iterateList f x = x : iterateList f (f x) {-# RULES "iterate" forall f x. iterate f x = build (\c _n -> iterateFB c f x) "iterateFB" iterateFB (:) = iterateList #-} This got shorted out to: iterateList :: (a -> a) -> a -> [a] iterateList = iterate iterateFB c f x = x c iterateFB c f (f x) iterate f x = x : iterate f (f x) {-# RULES "iterate" forall f x. iterate f x = build (\c _n -> iterateFB c f x) "iterateFB" iterateFB (:) = iterate #-} And now we get an infinite loop in the rule system  simonpj committed May 03, 2001 761  iterate f x -> build (\cn -> iterateFB c f x)  simonpj committed Sep 14, 2000 762 763 764 765 766 767 768 769 770 771  -> iterateFB (:) f x -> iterate f x Tiresome solution: don't do shorting out if f has rewrite rules. Hence shortableIdInfo. (b) Keeping the IdInfo right ~~~~~~~~~~~~~~~~~~~~~~~~ We want to move strictness/worker info from f_local to f, but keep the rest. Hence copyIdInfo.  simonpj committed Nov 01, 1999 772 773  \begin{code}  simonpj committed Sep 14, 2000 774 775 776 777 778 779 shortableIdInfo :: IdInfo -> Bool shortableIdInfo info = isEmptyCoreRules (specInfo info) copyIdInfo :: IdInfo -- f_local -> IdInfo -- f (the exported one) -> IdInfo -- New info for f  simonmar committed Dec 10, 2001 780 copyIdInfo f_local f = f { newStrictnessInfo = newStrictnessInfo f_local,  simonmar committed Mar 15, 2002 781 #ifdef OLD_STRICTNESS  simonmar committed Dec 10, 2001 782  strictnessInfo = strictnessInfo f_local,  simonpj committed Dec 11, 2001 783  cprInfo = cprInfo f_local,  simonmar committed Dec 10, 2001 784 #endif  simonpj committed Dec 11, 2001 785  workerInfo = workerInfo f_local  simonpj committed Nov 01, 1999 786 787  } \end{code}`