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