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