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