IdInfo.hs 18.2 KB
Newer Older
Austin Seipp's avatar
Austin Seipp committed
1 2 3 4
{-
(c) The University of Glasgow 2006
(c) The GRASP/AQUA Project, Glasgow University, 1993-1998

5 6 7 8
\section[IdInfo]{@IdInfos@: Non-essential information about @Ids@}

(And a pretty good illustration of quite a few things wrong with
Haskell. [WDP 94/11])
Austin Seipp's avatar
Austin Seipp committed
9
-}
10 11

module IdInfo (
12
        -- * The IdDetails type
13
        IdDetails(..), pprIdDetails, coVarDetails, isCoVarDetails,
Matthew Pickering's avatar
Matthew Pickering committed
14
        RecSelParent(..),
15

batterseapower's avatar
batterseapower committed
16
        -- * The IdInfo type
17 18
        IdInfo,         -- Abstract
        vanillaIdInfo, noCafIdInfo,
19

20 21 22
        -- ** The OneShotInfo type
        OneShotInfo(..),
        oneShotInfo, noOneShotInfo, hasNoOneShotInfo,
23
        setOneShotInfo,
24

25 26
        -- ** Zapping various forms of Info
        zapLamInfo, zapFragileInfo,
27
        zapDemandInfo, zapUsageInfo,
28

29 30 31 32
        -- ** The ArityInfo type
        ArityInfo,
        unknownArity,
        arityInfo, setArityInfo, ppArityInfo,
33

34 35
        callArityInfo, setCallArityInfo,

36 37 38
        -- ** Demand and strictness Info
        strictnessInfo, setStrictnessInfo,
        demandInfo, setDemandInfo, pprStrictness,
39

40 41
        -- ** Unfolding Info
        unfoldingInfo, setUnfoldingInfo, setUnfoldingInfoLazily,
42

43 44 45
        -- ** The InlinePragInfo type
        InlinePragInfo,
        inlinePragInfo, setInlinePragInfo,
batterseapower's avatar
batterseapower committed
46

47 48 49 50
        -- ** The OccInfo type
        OccInfo(..),
        isDeadOcc, isStrongLoopBreaker, isWeakLoopBreaker,
        occInfo, setOccInfo,
batterseapower's avatar
batterseapower committed
51

52 53
        InsideLam, OneBranch,
        insideLam, notInsideLam, oneBranch, notOneBranch,
54

55 56 57 58 59 60
        -- ** The RuleInfo type
        RuleInfo(..),
        emptyRuleInfo,
        isEmptyRuleInfo, ruleInfoFreeVars,
        ruleInfoRules, setRuleInfoHead,
        ruleInfo, setRuleInfo,
batterseapower's avatar
batterseapower committed
61

62 63 64 65
        -- ** The CAFInfo type
        CafInfo(..),
        ppCafInfo, mayHaveCafRefs,
        cafInfo, setCafInfo,
batterseapower's avatar
batterseapower committed
66 67

        -- ** Tick-box Info
68
        TickBoxOp(..), TickBoxId,
69 70
    ) where

71
import CoreSyn
batterseapower's avatar
batterseapower committed
72

Simon Marlow's avatar
Simon Marlow committed
73
import Class
74
import {-# SOURCE #-} PrimOp (PrimOp)
75
import Name
Simon Marlow's avatar
Simon Marlow committed
76 77 78 79
import VarSet
import BasicTypes
import DataCon
import TyCon
Matthew Pickering's avatar
Matthew Pickering committed
80
import {-# SOURCE #-} PatSyn
Simon Marlow's avatar
Simon Marlow committed
81
import ForeignCall
82
import Outputable
83
import Module
84
import FastString
85
import Demand
86

87
-- infixl so you can say (id `set` a `set` b)
88
infixl  1 `setRuleInfo`,
89 90 91 92 93 94 95 96
          `setArityInfo`,
          `setInlinePragInfo`,
          `setUnfoldingInfo`,
          `setOneShotInfo`,
          `setOccInfo`,
          `setCafInfo`,
          `setStrictnessInfo`,
          `setDemandInfo`
97

Austin Seipp's avatar
Austin Seipp committed
98 99 100
{-
************************************************************************
*                                                                      *
101
                     IdDetails
Austin Seipp's avatar
Austin Seipp committed
102 103 104
*                                                                      *
************************************************************************
-}
105

106 107
-- | The 'IdDetails' of an 'Id' give stable, and necessary,
-- information about the Id.
108
data IdDetails
109
  = VanillaId
110

batterseapower's avatar
batterseapower committed
111
  -- | The 'Id' for a record selector
112
  | RecSelId
Matthew Pickering's avatar
Matthew Pickering committed
113
    { sel_tycon   :: RecSelParent
batterseapower's avatar
batterseapower committed
114
    , sel_naughty :: Bool       -- True <=> a "naughty" selector which can't actually exist, for example @x@ in:
115
                                --    data T = forall a. MkT { x :: a }
116 117 118 119
    }                           -- See Note [Naughty record selectors] in TcTyClsDecls

  | DataConWorkId DataCon       -- ^ The 'Id' is for a data constructor /worker/
  | DataConWrapId DataCon       -- ^ The 'Id' is for a data constructor /wrapper/
120

121 122 123 124
                                -- [the only reasons we need to know is so that
                                --  a) to support isImplicitId
                                --  b) when desugaring a RecordCon we can get
                                --     from the Id back to the data con]
125 126
  | ClassOpId Class             -- ^ The 'Id' is a superclass selector,
                                -- or class operation of a class
batterseapower's avatar
batterseapower committed
127

128 129
  | PrimOpId PrimOp             -- ^ The 'Id' is for a primitive operator
  | FCallId ForeignCall         -- ^ The 'Id' is for a foreign call
130

131
  | TickBoxOpId TickBoxOp       -- ^ The 'Id' is for a HPC tick box (both traditional and binary)
132

133
  | DFunId Bool                 -- ^ A dictionary function.
134 135 136
       -- Bool = True <=> the class has only one method, so may be
       --                  implemented with a newtype, so it might be bad
       --                  to be strict on this dictionary
137

138 139
  | CoVarId                    -- ^ A coercion variable

Matthew Pickering's avatar
Matthew Pickering committed
140 141 142 143 144 145 146 147 148 149 150
data RecSelParent = RecSelData TyCon | RecSelPatSyn PatSyn deriving Eq
  -- Either `TyCon` or `PatSyn` depending
  -- on the origin of the record selector.
  -- For a data type family, this is the
  -- /instance/ 'TyCon' not the family 'TyCon'

instance Outputable RecSelParent where
  ppr p = case p of
            RecSelData ty_con -> ppr ty_con
            RecSelPatSyn ps   -> ppr ps

151 152
-- | Just a synonym for 'CoVarId'. Written separately so it can be
-- exported in the hs-boot file.
153
coVarDetails :: IdDetails
154 155 156 157 158 159
coVarDetails = CoVarId

-- | Check if an 'IdDetails' says 'CoVarId'.
isCoVarDetails :: IdDetails -> Bool
isCoVarDetails CoVarId = True
isCoVarDetails _       = False
160

161 162 163 164
instance Outputable IdDetails where
    ppr = pprIdDetails

pprIdDetails :: IdDetails -> SDoc
165 166 167 168 169 170 171 172 173 174
pprIdDetails VanillaId = empty
pprIdDetails other     = brackets (pp other)
 where
   pp VanillaId         = panic "pprIdDetails"
   pp (DataConWorkId _) = ptext (sLit "DataCon")
   pp (DataConWrapId _) = ptext (sLit "DataConWrapper")
   pp (ClassOpId {})    = ptext (sLit "ClassOp")
   pp (PrimOpId _)      = ptext (sLit "PrimOp")
   pp (FCallId _)       = ptext (sLit "ForeignCall")
   pp (TickBoxOpId _)   = ptext (sLit "TickBoxOp")
175
   pp (DFunId nt)       = ptext (sLit "DFunId") <> ppWhen nt (ptext (sLit "(nt)"))
176
   pp (RecSelId { sel_naughty = is_naughty })
177 178
                         = brackets $ ptext (sLit "RecSel")
                            <> ppWhen is_naughty (ptext (sLit "(naughty)"))
179
   pp CoVarId           = ptext (sLit "CoVarId")
180

Austin Seipp's avatar
Austin Seipp committed
181 182 183
{-
************************************************************************
*                                                                      *
184
\subsection{The main IdInfo type}
Austin Seipp's avatar
Austin Seipp committed
185 186 187
*                                                                      *
************************************************************************
-}
188

batterseapower's avatar
batterseapower committed
189 190 191
-- | An 'IdInfo' gives /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.
192
--
batterseapower's avatar
batterseapower committed
193 194 195
-- 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.
196
--
Joachim Breitner's avatar
Joachim Breitner committed
197 198 199
-- Most of the 'IdInfo' gives information about the value, or definition, of
-- the 'Id', independent of its usage. Exceptions to this
-- are 'demandInfo', 'occInfo', 'oneShotInfo' and 'callArityInfo'.
200
data IdInfo
201
  = IdInfo {
202
        arityInfo       :: !ArityInfo,          -- ^ 'Id' arity
203
        ruleInfo        :: RuleInfo,            -- ^ Specialisations of the 'Id's function which exist
204 205 206 207 208 209
                                                -- See Note [Specialisations and RULES in IdInfo]
        unfoldingInfo   :: Unfolding,           -- ^ The 'Id's unfolding
        cafInfo         :: CafInfo,             -- ^ 'Id' CAF info
        oneShotInfo     :: OneShotInfo,         -- ^ Info about a lambda-bound variable, if the 'Id' is one
        inlinePragInfo  :: InlinePragma,        -- ^ Any inline pragma atached to the 'Id'
        occInfo         :: OccInfo,             -- ^ How the 'Id' occurs in the program
210

211 212
        strictnessInfo  :: StrictSig,      --  ^ A strictness signature

213 214 215
        demandInfo      :: Demand,       -- ^ ID demand information
        callArityInfo :: !ArityInfo    -- ^ How this is called.
                                         -- n <=> all calls have at least n arguments
216
    }
217

Austin Seipp's avatar
Austin Seipp committed
218
-- Setters
219

220 221
setRuleInfo :: IdInfo -> RuleInfo -> IdInfo
setRuleInfo       info sp = sp `seq` info { ruleInfo = sp }
222
setInlinePragInfo :: IdInfo -> InlinePragma -> IdInfo
223
setInlinePragInfo info pr = pr `seq` info { inlinePragInfo = pr }
Ian Lynagh's avatar
Ian Lynagh committed
224
setOccInfo :: IdInfo -> OccInfo -> IdInfo
225 226
setOccInfo        info oc = oc `seq` info { occInfo = oc }
        -- Try to avoid spack leaks by seq'ing
227

Ian Lynagh's avatar
Ian Lynagh committed
228
setUnfoldingInfoLazily :: IdInfo -> Unfolding -> IdInfo
229 230 231
setUnfoldingInfoLazily info uf  -- Lazy variant to avoid looking at the
  =                             -- unfolding of an imported Id unless necessary
    info { unfoldingInfo = uf } -- (In this case the demand-zapping is redundant.)
232

Ian Lynagh's avatar
Ian Lynagh committed
233
setUnfoldingInfo :: IdInfo -> Unfolding -> IdInfo
234
setUnfoldingInfo info uf
Ian Lynagh's avatar
Ian Lynagh committed
235 236 237 238
  = -- We don't seq the unfolding, as we generate intermediate
    -- unfoldings which are just thrown away, so evaluating them is a
    -- waste of time.
    -- seqUnfolding uf `seq`
239
    info { unfoldingInfo = uf }
240

Ian Lynagh's avatar
Ian Lynagh committed
241
setArityInfo :: IdInfo -> ArityInfo -> IdInfo
242
setArityInfo      info ar  = info { arityInfo = ar  }
243 244
setCallArityInfo :: IdInfo -> ArityInfo -> IdInfo
setCallArityInfo info ar  = info { callArityInfo = ar  }
Ian Lynagh's avatar
Ian Lynagh committed
245
setCafInfo :: IdInfo -> CafInfo -> IdInfo
246
setCafInfo        info caf = info { cafInfo = caf }
247

248 249
setOneShotInfo :: IdInfo -> OneShotInfo -> IdInfo
setOneShotInfo      info lb = {-lb `seq`-} info { oneShotInfo = lb }
250

251 252
setDemandInfo :: IdInfo -> Demand -> IdInfo
setDemandInfo info dd = dd `seq` info { demandInfo = dd }
253

254
setStrictnessInfo :: IdInfo -> StrictSig -> IdInfo
255
setStrictnessInfo info dd = dd `seq` info { strictnessInfo = dd }
256

batterseapower's avatar
batterseapower committed
257
-- | Basic 'IdInfo' that carries no useful information whatsoever
258
vanillaIdInfo :: IdInfo
259
vanillaIdInfo
260
  = IdInfo {
261 262
            cafInfo             = vanillaCafInfo,
            arityInfo           = unknownArity,
263
            ruleInfo            = emptyRuleInfo,
264 265 266 267 268 269 270 271
            unfoldingInfo       = noUnfolding,
            oneShotInfo         = NoOneShotInfo,
            inlinePragInfo      = defaultInlinePragma,
            occInfo             = NoOccInfo,
            demandInfo          = topDmd,
            strictnessInfo      = nopSig,
            callArityInfo     = unknownArity
           }
272

batterseapower's avatar
batterseapower committed
273
-- | More informative 'IdInfo' we can use when we know the 'Id' has no CAF references
Ian Lynagh's avatar
Ian Lynagh committed
274
noCafIdInfo :: IdInfo
275
noCafIdInfo  = vanillaIdInfo `setCafInfo`    NoCafRefs
276
        -- Used for built-in type Ids in MkId.
277

Austin Seipp's avatar
Austin Seipp committed
278 279 280
{-
************************************************************************
*                                                                      *
281
\subsection[arity-IdInfo]{Arity info about an @Id@}
Austin Seipp's avatar
Austin Seipp committed
282 283
*                                                                      *
************************************************************************
284

285
For locally-defined Ids, the code generator maintains its own notion
286
of their arities; so it should not be asking...  (but other things
287
besides the code-generator need arity info!)
Austin Seipp's avatar
Austin Seipp committed
288
-}
289

290
-- | An 'ArityInfo' of @n@ tells us that partial application of this
batterseapower's avatar
batterseapower committed
291 292
-- 'Id' to up to @n-1@ value arguments does essentially no work.
--
293
-- That is not necessarily the same as saying that it has @n@ leading
batterseapower's avatar
batterseapower committed
294 295 296 297
-- lambdas, because coerces may get in the way.
--
-- The arity might increase later in the compilation process, if
-- an extra lambda floats up to the binding site.
298
type ArityInfo = Arity
299

batterseapower's avatar
batterseapower committed
300
-- | It is always safe to assume that an 'Id' has an arity of 0
Ian Lynagh's avatar
Ian Lynagh committed
301
unknownArity :: Arity
302
unknownArity = 0 :: Arity
303

Ian Lynagh's avatar
Ian Lynagh committed
304
ppArityInfo :: Int -> SDoc
305
ppArityInfo 0 = empty
Ian Lynagh's avatar
Ian Lynagh committed
306
ppArityInfo n = hsep [ptext (sLit "Arity"), int n]
307

Austin Seipp's avatar
Austin Seipp committed
308 309 310
{-
************************************************************************
*                                                                      *
311
\subsection{Inline-pragma information}
Austin Seipp's avatar
Austin Seipp committed
312 313 314
*                                                                      *
************************************************************************
-}
315

batterseapower's avatar
batterseapower committed
316 317 318 319 320 321 322 323 324
-- | 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 Core inline 'Note'
--
-- The default 'InlinePragInfo' is 'AlwaysActive', so the info serves
-- entirely as a way to inhibit inlining until we want it
325
type InlinePragInfo = InlinePragma
326

Austin Seipp's avatar
Austin Seipp committed
327 328 329
{-
************************************************************************
*                                                                      *
330
               Strictness
Austin Seipp's avatar
Austin Seipp committed
331 332 333
*                                                                      *
************************************************************************
-}
334

335 336
pprStrictness :: StrictSig -> SDoc
pprStrictness sig = ppr sig
337

Austin Seipp's avatar
Austin Seipp committed
338 339 340
{-
************************************************************************
*                                                                      *
341
        RuleInfo
Austin Seipp's avatar
Austin Seipp committed
342 343
*                                                                      *
************************************************************************
344

345 346
Note [Specialisations and RULES in IdInfo]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
347
Generally speaking, a GlobalId has an *empty* RuleInfo.  All their
348 349 350 351 352 353 354 355
RULES are contained in the globally-built rule-base.  In principle,
one could attach the to M.f the RULES for M.f that are defined in M.
But we don't do that for instance declarations and so we just treat
them all uniformly.

The EXCEPTION is PrimOpIds, which do have rules in their IdInfo. That is
jsut for convenience really.

356
However, LocalIds may have non-empty RuleInfo.  We treat them
357 358 359 360 361 362
differently because:
  a) they might be nested, in which case a global table won't work
  b) the RULE might mention free variables, which we use to keep things alive

In TidyPgm, when the LocalId becomes a GlobalId, its RULES are stripped off
and put in the global list.
Austin Seipp's avatar
Austin Seipp committed
363
-}
364

batterseapower's avatar
batterseapower committed
365 366
-- | Records the specializations of this 'Id' that we know about
-- in the form of rewrite 'CoreRule's that target them
367 368
data RuleInfo
  = RuleInfo
369
        [CoreRule]
370
        DVarSet         -- Locally-defined free vars of *both* LHS and RHS
371 372 373
                        -- of rules.  I don't think it needs to include the
                        -- ru_fn though.
                        -- Note [Rule dependency info] in OccurAnal
374

batterseapower's avatar
batterseapower committed
375
-- | Assume that no specilizations exist: always safe
376
emptyRuleInfo :: RuleInfo
377
emptyRuleInfo = RuleInfo [] emptyDVarSet
378

379 380
isEmptyRuleInfo :: RuleInfo -> Bool
isEmptyRuleInfo (RuleInfo rs _) = null rs
381

batterseapower's avatar
batterseapower committed
382 383
-- | Retrieve the locally-defined free variables of both the left and
-- right hand sides of the specialization rules
384
ruleInfoFreeVars :: RuleInfo -> DVarSet
385
ruleInfoFreeVars (RuleInfo _ fvs) = fvs
386

387 388
ruleInfoRules :: RuleInfo -> [CoreRule]
ruleInfoRules (RuleInfo rules _) = rules
389

batterseapower's avatar
batterseapower committed
390
-- | Change the name of the function the rule is keyed on on all of the 'CoreRule's
391 392 393
setRuleInfoHead :: Name -> RuleInfo -> RuleInfo
setRuleInfoHead fn (RuleInfo rules fvs)
  = RuleInfo (map (setRuleIdName fn) rules) fvs
394

Austin Seipp's avatar
Austin Seipp committed
395 396 397
{-
************************************************************************
*                                                                      *
398
\subsection[CG-IdInfo]{Code generator-related information}
Austin Seipp's avatar
Austin Seipp committed
399 400 401
*                                                                      *
************************************************************************
-}
402

403
-- CafInfo is used to build Static Reference Tables (see simplStg/SRT.hs).
404

batterseapower's avatar
batterseapower committed
405
-- | Records whether an 'Id' makes Constant Applicative Form references
406 407 408 409 410 411 412 413 414 415
data CafInfo
        = MayHaveCafRefs                -- ^ Indicates that the 'Id' is for either:
                                        --
                                        -- 1. A function or static constructor
                                        --    that refers to one or more CAFs, or
                                        --
                                        -- 2. A real live CAF

        | NoCafRefs                     -- ^ A function or static constructor
                                        -- that refers to no CAFs.
416
        deriving (Eq, Ord)
417

batterseapower's avatar
batterseapower committed
418
-- | Assumes that the 'Id' has CAF references: definitely safe
Ian Lynagh's avatar
Ian Lynagh committed
419
vanillaCafInfo :: CafInfo
batterseapower's avatar
batterseapower committed
420
vanillaCafInfo = MayHaveCafRefs
421

Ian Lynagh's avatar
Ian Lynagh committed
422
mayHaveCafRefs :: CafInfo -> Bool
423
mayHaveCafRefs  MayHaveCafRefs = True
424
mayHaveCafRefs _               = False
425

426 427 428
instance Outputable CafInfo where
   ppr = ppCafInfo

Ian Lynagh's avatar
Ian Lynagh committed
429
ppCafInfo :: CafInfo -> SDoc
Ian Lynagh's avatar
Ian Lynagh committed
430
ppCafInfo NoCafRefs = ptext (sLit "NoCafRefs")
431
ppCafInfo MayHaveCafRefs = empty
432

Austin Seipp's avatar
Austin Seipp committed
433 434 435
{-
************************************************************************
*                                                                      *
436
\subsection{Bulk operations on IdInfo}
Austin Seipp's avatar
Austin Seipp committed
437 438 439
*                                                                      *
************************************************************************
-}
440

batterseapower's avatar
batterseapower committed
441 442 443 444 445
-- | This is used to remove information on lambda binders that we have
-- setup as part of a lambda group, assuming they will be applied all at once,
-- but turn out to be part of an unsaturated lambda as in e.g:
--
-- > (\x1. \x2. e) arg1
446
zapLamInfo :: IdInfo -> Maybe IdInfo
447
zapLamInfo info@(IdInfo {occInfo = occ, demandInfo = demand})
448
  | is_safe_occ occ && is_safe_dmd demand
449 450
  = Nothing
  | otherwise
451
  = Just (info {occInfo = safe_occ, demandInfo = topDmd})
452
  where
453 454
        -- 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
455
    is_safe_occ (OneOcc in_lam _ _) = in_lam
456
    is_safe_occ _other              = True
457 458

    safe_occ = case occ of
459 460
                 OneOcc _ once int_cxt -> OneOcc insideLam once int_cxt
                 _other                -> occ
461

462
    is_safe_dmd dmd = not (isStrictDmd dmd)
463

464
-- | Remove all demand info on the 'IdInfo'
465
zapDemandInfo :: IdInfo -> Maybe IdInfo
466
zapDemandInfo info = Just (info {demandInfo = topDmd})
467

468 469 470 471
-- | Remove usage (but not strictness) info on the 'IdInfo'
zapUsageInfo :: IdInfo -> Maybe IdInfo
zapUsageInfo info = Just (info {demandInfo = zapUsageDemand (demandInfo info)})

472
zapFragileInfo :: IdInfo -> Maybe IdInfo
batterseapower's avatar
batterseapower committed
473
-- ^ Zap info that depends on free variables
474
zapFragileInfo info
475
  = Just (info `setRuleInfo` emptyRuleInfo
476
               `setUnfoldingInfo` noUnfolding
477
               `setOccInfo` zapFragileOcc occ)
478 479
  where
    occ = occInfo info
480

Austin Seipp's avatar
Austin Seipp committed
481 482 483
{-
************************************************************************
*                                                                      *
484
\subsection{TickBoxOp}
Austin Seipp's avatar
Austin Seipp committed
485 486 487
*                                                                      *
************************************************************************
-}
488 489 490

type TickBoxId = Int

batterseapower's avatar
batterseapower committed
491
-- | Tick box for Hpc-style coverage
492
data TickBoxOp
493
   = TickBox Module {-# UNPACK #-} !TickBoxId
494

495
instance Outputable TickBoxOp where
Ian Lynagh's avatar
Ian Lynagh committed
496
    ppr (TickBox mod n)         = ptext (sLit "tick") <+> ppr (mod,n)