ghc/compiler/basicTypes/IdInfo.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1996
   3 %
   4 \section[IdInfo]{@IdInfos@: Non-essential information about @Ids@}
   5
   6 (And a pretty good illustration of quite a few things wrong with
   7 Haskell. [WDP 94/11])
   8
   9 \begin{code}
  10 module IdInfo (
  11         IdInfo,         -- Abstract
  12
  13         noIdInfo,
  14         ppIdInfo,
  15
  16         ArityInfo(..),
  17         exactArity, atLeastArity, unknownArity,
  18         arityInfo, addArityInfo, ppArityInfo,
  19
  20         DemandInfo,
  21         noDemandInfo, mkDemandInfo, demandInfo, ppDemandInfo, addDemandInfo, willBeDemanded,
  22
  23         StrictnessInfo(..),                             -- Non-abstract
  24         Demand(..), NewOrData,                          -- Non-abstract
  25
  26         workerExists,
  27         mkStrictnessInfo, mkBottomStrictnessInfo, noStrictnessInfo, bottomIsGuaranteed,
  28         strictnessInfo, ppStrictnessInfo, addStrictnessInfo,
  29
  30         unfoldInfo, addUnfoldInfo,
  31
  32         IdSpecEnv, specInfo, setSpecInfo,
  33
  34         UpdateInfo, UpdateSpec,
  35         mkUpdateInfo, updateInfo, updateInfoMaybe, ppUpdateInfo, addUpdateInfo,
  36
  37         ArgUsageInfo, ArgUsage(..), ArgUsageType,
  38         mkArgUsageInfo, argUsageInfo, addArgUsageInfo, getArgUsage,
  39
  40         FBTypeInfo, FBType(..), FBConsum(..), FBProd(..),
  41         fbTypeInfo, ppFBTypeInfo, addFBTypeInfo, mkFBTypeInfo, getFBType
  42     ) where
  43
  44 #include "HsVersions.h"
  45
  46
  47 import {-# SOURCE #-} CoreUnfold ( Unfolding, noUnfolding )
  48 import {-# SOURCE #-} CoreSyn    ( CoreExpr )
  49
  50 -- for mkdependHS, CoreSyn.hi-boot refers to it:
  51 import BinderInfo ( BinderInfo )
  52
  53 import SpecEnv          ( SpecEnv, emptySpecEnv )
  54 import BasicTypes       ( NewOrData )
  55
  56 import Demand
  57 import Outputable
  58
  59 import Char             ( ord )
  60 \end{code}
  61
  62 An @IdInfo@ gives {\em optional} information about an @Id@.  If
  63 present it never lies, but it may not be present, in which case there
  64 is always a conservative assumption which can be made.
  65
  66 Two @Id@s may have different info even though they have the same
  67 @Unique@ (and are hence the same @Id@); for example, one might lack
  68 the properties attached to the other.
  69
  70 The @IdInfo@ gives information about the value, or definition, of the
  71 @Id@.  It does {\em not} contain information about the @Id@'s usage
  72 (except for @DemandInfo@? ToDo).
  73
  74 \begin{code}
  75 data IdInfo
  76   = IdInfo
  77         ArityInfo               -- Its arity
  78
  79         DemandInfo              -- Whether or not it is definitely
  80                                 -- demanded
  81
  82         IdSpecEnv               -- Specialisations of this function which exist
  83
  84         StrictnessInfo          -- Strictness properties
  85
  86         Unfolding               -- Its unfolding; for locally-defined
  87                                 -- things, this can *only* be NoUnfolding
  88
  89         UpdateInfo              -- Which args should be updated
  90
  91         ArgUsageInfo            -- how this Id uses its arguments
  92
  93         FBTypeInfo              -- the Foldr/Build W/W property of this function.
  94 \end{code}
  95
  96 \begin{code}
  97 noIdInfo = IdInfo UnknownArity UnknownDemand emptySpecEnv NoStrictnessInfo noUnfolding
  98                   NoUpdateInfo NoArgUsageInfo NoFBTypeInfo
  99 \end{code}
 100
 101 \begin{code}
 102 ppIdInfo :: Bool        -- True <=> print specialisations, please
 103          -> IdInfo
 104          -> SDoc
 105
 106 ppIdInfo specs_please
 107          (IdInfo arity demand specenv strictness unfold update arg_usage fbtype)
 108   = hsep [
 109                     -- order is important!:
 110                     ppArityInfo arity,
 111                     ppUpdateInfo update,
 112
 113                     ppStrictnessInfo strictness,
 114
 115                     if specs_please
 116                     then empty -- ToDo -- sty (not (isDataCon for_this_id))
 117                                          -- better_id_fn inline_env (mEnvToList specenv)
 118                     else empty,
 119
 120                     -- DemandInfo needn't be printed since it has no effect on interfaces
 121                     ppDemandInfo demand,
 122                     ppFBTypeInfo fbtype
 123         ]
 124 \end{code}
 125
 126 %************************************************************************
 127 %*                                                                      *
 128 \subsection[arity-IdInfo]{Arity info about an @Id@}
 129 %*                                                                      *
 130 %************************************************************************
 131
 132 \begin{code}
 133 data ArityInfo
 134   = UnknownArity        -- No idea
 135   | ArityExactly Int    -- Arity is exactly this
 136   | ArityAtLeast Int    -- Arity is this or greater
 137 \end{code}
 138
 139 \begin{code}
 140 exactArity   = ArityExactly
 141 atLeastArity = ArityAtLeast
 142 unknownArity = UnknownArity
 143
 144 arityInfo (IdInfo arity _ _ _ _ _ _ _) = arity
 145
 146 addArityInfo (IdInfo _ a b c d e f g) arity          = IdInfo arity a b c d e f g
 147
 148 ppArityInfo UnknownArity             = empty
 149 ppArityInfo (ArityExactly arity) = hsep [ptext SLIT("_A_"), int arity]
 150 ppArityInfo (ArityAtLeast arity) = hsep [ptext SLIT("_A>_"), int arity]
 151 \end{code}
 152
 153 %************************************************************************
 154 %*                                                                      *
 155 \subsection[demand-IdInfo]{Demand info about an @Id@}
 156 %*                                                                      *
 157 %************************************************************************
 158
 159 Whether a value is certain to be demanded or not.  (This is the
 160 information that is computed by the ``front-end'' of the strictness
 161 analyser.)
 162
 163 This information is only used within a module, it is not exported
 164 (obviously).
 165
 166 \begin{code}
 167 data DemandInfo
 168   = UnknownDemand
 169   | DemandedAsPer Demand
 170 \end{code}
 171
 172 \begin{code}
 173 noDemandInfo = UnknownDemand
 174
 175 mkDemandInfo :: Demand -> DemandInfo
 176 mkDemandInfo demand = DemandedAsPer demand
 177
 178 willBeDemanded :: DemandInfo -> Bool
 179 willBeDemanded (DemandedAsPer demand) = isStrict demand
 180 willBeDemanded _                      = False
 181 \end{code}
 182
 183 \begin{code}
 184 demandInfo (IdInfo _ demand _ _ _ _ _ _) = demand
 185
 186 addDemandInfo (IdInfo a _ c d e f g h) demand = IdInfo a demand c d e f g h
 187
 188 ppDemandInfo UnknownDemand            = text "{-# L #-}"
 189 ppDemandInfo (DemandedAsPer info) = hsep [text "{-#", text (showList [info] ""), text "#-}"]
 190 \end{code}
 191
 192 %************************************************************************
 193 %*                                                                      *
 194 \subsection[specialisation-IdInfo]{Specialisation info about an @Id@}
 195 %*                                                                      *
 196 %************************************************************************
 197
 198 A @IdSpecEnv@ holds details of an @Id@'s specialisations.
 199
 200 \begin{code}
 201 type IdSpecEnv = SpecEnv CoreExpr
 202 \end{code}
 203
 204 For example, if \tr{f}'s @SpecEnv@ contains the mapping:
 205 \begin{verbatim}
 206         [List a, b]  ===>  (\d -> f' a b)
 207 \end{verbatim}
 208 then when we find an application of f to matching types, we simply replace
 209 it by the matching RHS:
 210 \begin{verbatim}
 211         f (List Int) Bool ===>  (\d -> f' Int Bool)
 212 \end{verbatim}
 213 All the stuff about how many dictionaries to discard, and what types
 214 to apply the specialised function to, are handled by the fact that the
 215 SpecEnv contains a template for the result of the specialisation.
 216
 217 There is one more exciting case, which is dealt with in exactly the same
 218 way.  If the specialised value is unboxed then it is lifted at its
 219 definition site and unlifted at its uses.  For example:
 220
 221         pi :: forall a. Num a => a
 222
 223 might have a specialisation
 224
 225         [Int#] ===>  (case pi' of Lift pi# -> pi#)
 226
 227 where pi' :: Lift Int# is the specialised version of pi.
 228
 229
 230 \begin{code}
 231 specInfo :: IdInfo -> IdSpecEnv
 232 specInfo (IdInfo _ _ spec _ _ _ _ _) = spec
 233
 234 setSpecInfo (IdInfo a b _ d e f g h) spec   = IdInfo a b spec d e f g h
 235 \end{code}
 236
 237
 238 %************************************************************************
 239 %*                                                                      *
 240 \subsection[strictness-IdInfo]{Strictness info about an @Id@}
 241 %*                                                                      *
 242 %************************************************************************
 243
 244 We specify the strictness of a function by giving information about
 245 each of the ``wrapper's'' arguments (see the description about
 246 worker/wrapper-style transformations in the PJ/Launchbury paper on
 247 unboxed types).
 248
 249 The list of @Demands@ specifies: (a)~the strictness properties
 250 of a function's arguments; (b)~the {\em existence} of a ``worker''
 251 version of the function; and (c)~the type signature of that worker (if
 252 it exists); i.e. its calling convention.
 253
 254 \begin{code}
 255 data StrictnessInfo
 256   = NoStrictnessInfo
 257
 258   | BottomGuaranteed    -- This Id guarantees never to return;
 259                         -- it is bottom regardless of its arguments.
 260                         -- Useful for "error" and other disguised
 261                         -- variants thereof.
 262
 263   | StrictnessInfo [Demand]
 264                    Bool         -- True <=> there is a worker. There might not be, even for a
 265                                 -- strict function, because:
 266                                 --      (a) the function might be small enough to inline,
 267                                 --          so no need for w/w split
 268                                 --      (b) the strictness info might be "SSS" or something, so no w/w split.
 269
 270                                 -- Worker's Id, if applicable, and a list of the constructors
 271                                 -- mentioned by the wrapper.  This is necessary so that the
 272                                 -- renamer can slurp them in.  Without this info, the renamer doesn't
 273                                 -- know which data types to slurp in concretely.  Remember, for
 274                                 -- strict things we don't put the unfolding in the interface file, to save space.
 275                                 -- This constructor list allows the renamer to behave much as if the
 276                                 -- unfolding *was* in the interface file.
 277 \end{code}
 278
 279 \begin{code}
 280 mkStrictnessInfo :: [Demand] -> Bool -> StrictnessInfo
 281
 282 mkStrictnessInfo xs has_wrkr
 283   | all is_lazy xs       = NoStrictnessInfo             -- Uninteresting
 284   | otherwise            = StrictnessInfo xs has_wrkr
 285   where
 286     is_lazy (WwLazy False) = True       -- NB "Absent" args do *not* count!
 287     is_lazy _              = False      -- (as they imply a worker)
 288
 289 noStrictnessInfo       = NoStrictnessInfo
 290 mkBottomStrictnessInfo = BottomGuaranteed
 291
 292 bottomIsGuaranteed BottomGuaranteed = True
 293 bottomIsGuaranteed other            = False
 294
 295 strictnessInfo (IdInfo _ _ _ strict _ _ _ _) = strict
 296
 297 addStrictnessInfo id_info                    NoStrictnessInfo = id_info
 298 addStrictnessInfo (IdInfo a b d _ e f g h) strict             = IdInfo a b d strict e f g h
 299
 300 ppStrictnessInfo NoStrictnessInfo = empty
 301 ppStrictnessInfo BottomGuaranteed = ptext SLIT("_bot_")
 302
 303 ppStrictnessInfo (StrictnessInfo wrapper_args wrkr_maybe)
 304   = hsep [ptext SLIT("_S_"), text (showList wrapper_args "")]
 305 \end{code}
 306
 307
 308 \begin{code}
 309 workerExists :: StrictnessInfo -> Bool
 310 workerExists (StrictnessInfo _ worker_exists) = worker_exists
 311 workerExists other                            = False
 312 \end{code}
 313
 314
 315 %************************************************************************
 316 %*                                                                      *
 317 \subsection[unfolding-IdInfo]{Unfolding info about an @Id@}
 318 %*                                                                      *
 319 %************************************************************************
 320
 321 \begin{code}
 322 unfoldInfo (IdInfo _ _ _ _ unfolding _ _ _) = unfolding
 323
 324 addUnfoldInfo (IdInfo a b d e _ f g h) uf = IdInfo a b d e uf f g h
 325 \end{code}
 326
 327 %************************************************************************
 328 %*                                                                      *
 329 \subsection[update-IdInfo]{Update-analysis info about an @Id@}
 330 %*                                                                      *
 331 %************************************************************************
 332
 333 \begin{code}
 334 data UpdateInfo
 335   = NoUpdateInfo
 336   | SomeUpdateInfo UpdateSpec
 337   deriving (Eq, Ord)
 338       -- we need Eq/Ord to cross-chk update infos in interfaces
 339
 340 -- the form in which we pass update-analysis info between modules:
 341 type UpdateSpec = [Int]
 342 \end{code}
 343
 344 \begin{code}
 345 mkUpdateInfo = SomeUpdateInfo
 346
 347 updateInfoMaybe NoUpdateInfo        = Nothing
 348 updateInfoMaybe (SomeUpdateInfo []) = Nothing
 349 updateInfoMaybe (SomeUpdateInfo  u) = Just u
 350 \end{code}
 351
 352 Text instance so that the update annotations can be read in.
 353
 354 \begin{code}
 355 instance Read UpdateInfo where
 356     readsPrec p s | null s    = panic "IdInfo: empty update pragma?!"
 357                   | otherwise = [(SomeUpdateInfo (map ok_digit s),"")]
 358       where
 359         ok_digit c | c >= '0' && c <= '2' = ord c - ord '0'
 360                    | otherwise = panic "IdInfo: not a digit while reading update pragma"
 361
 362 updateInfo (IdInfo _ _ _ _ _ update _ _) = update
 363
 364 addUpdateInfo id_info                    NoUpdateInfo = id_info
 365 addUpdateInfo (IdInfo a b d e f _ g h) upd_info     = IdInfo a b d e f upd_info g h
 366
 367 ppUpdateInfo NoUpdateInfo              = empty
 368 ppUpdateInfo (SomeUpdateInfo [])   = empty
 369 ppUpdateInfo (SomeUpdateInfo spec) = (<>) (ptext SLIT("_U_ ")) (hcat (map int spec))
 370 \end{code}
 371
 372 %************************************************************************
 373 %*                                                                      *
 374 \subsection[argUsage-IdInfo]{Argument Usage info about an @Id@}
 375 %*                                                                      *
 376 %************************************************************************
 377
 378 \begin{code}
 379 data ArgUsageInfo
 380   = NoArgUsageInfo
 381   | SomeArgUsageInfo ArgUsageType
 382   -- ??? deriving (Eq, Ord)
 383
 384 data ArgUsage = ArgUsage Int    -- number of arguments (is linear!)
 385               | UnknownArgUsage
 386 type ArgUsageType  = [ArgUsage]         -- c_1 -> ... -> BLOB
 387 \end{code}
 388
 389 \begin{code}
 390 mkArgUsageInfo [] = NoArgUsageInfo
 391 mkArgUsageInfo au = SomeArgUsageInfo au
 392
 393 getArgUsage :: ArgUsageInfo -> ArgUsageType
 394 getArgUsage NoArgUsageInfo        = []
 395 getArgUsage (SomeArgUsageInfo u)  = u
 396 \end{code}
 397
 398 \begin{code}
 399 argUsageInfo (IdInfo _ _ _ _ _ _ au _) = au
 400
 401 addArgUsageInfo id_info                    NoArgUsageInfo = id_info
 402 addArgUsageInfo (IdInfo a b d e f g _ h) au_info          = IdInfo a b d e f g au_info h
 403
 404 {- UNUSED:
 405 ppArgUsageInfo NoArgUsageInfo     = empty
 406 ppArgUsageInfo (SomeArgUsageInfo aut) = (<>) (ptext SLIT("_L_ ")) (ppArgUsageType aut)
 407 -}
 408
 409 ppArgUsage (ArgUsage n)      = int n
 410 ppArgUsage (UnknownArgUsage) = char '-'
 411
 412 ppArgUsageType aut = hcat
 413         [ char '"' ,
 414           hcat (punctuate comma (map ppArgUsage aut)),
 415           char '"' ]
 416 \end{code}
 417
 418 %************************************************************************
 419 %*                                                                      *
 420 \subsection[FBType-IdInfo]{Type of an expression through Foldr/build's eyes}
 421 %*                                                                      *
 422 %************************************************************************
 423
 424 \begin{code}
 425 data FBTypeInfo
 426   = NoFBTypeInfo
 427   | SomeFBTypeInfo FBType
 428
 429 data FBType = FBType [FBConsum] FBProd deriving (Eq)
 430
 431 data FBConsum = FBGoodConsum | FBBadConsum deriving(Eq)
 432 data FBProd = FBGoodProd | FBBadProd deriving(Eq)
 433 \end{code}
 434
 435 \begin{code}
 436 mkFBTypeInfo = SomeFBTypeInfo
 437
 438 getFBType :: FBTypeInfo -> Maybe FBType
 439 getFBType NoFBTypeInfo        = Nothing
 440 getFBType (SomeFBTypeInfo u)  = Just u
 441 \end{code}
 442
 443 \begin{code}
 444 fbTypeInfo (IdInfo _ _ _ _ _ _ _ fb) = fb
 445
 446 addFBTypeInfo id_info NoFBTypeInfo = id_info
 447 addFBTypeInfo (IdInfo a b d e f g h _) fb_info = IdInfo a b d e f g h fb_info
 448
 449 ppFBTypeInfo NoFBTypeInfo = empty
 450 ppFBTypeInfo (SomeFBTypeInfo (FBType cons prod))
 451       = (<>) (ptext SLIT("_F_ ")) (ppFBType cons prod)
 452
 453 ppFBType cons prod = hcat
 454         ([ char '"' ] ++ map ppCons cons ++ [ char '-', ppProd prod, char '"' ])
 455   where
 456         ppCons FBGoodConsum = char 'G'
 457         ppCons FBBadConsum  = char 'B'
 458         ppProd FBGoodProd   = char 'G'
 459         ppProd FBBadProd    = char 'B'
 460 \end{code}