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