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