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