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          -> Pretty
 199
 200 ppIdInfo sty specs_please
 201          (IdInfo arity demand specenv strictness unfold update deforest arg_usage fbtype)
 202   = ppCat [
 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 ppNil -- ToDo -- sty (not (isDataCon for_this_id))
 212                                          -- better_id_fn inline_env (mEnvToList specenv)
 213                     else ppNil,
 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 id_info                    UnknownArity = id_info
 242 addArityInfo (IdInfo _ a c d e f g h i) arity        = IdInfo arity a c d e f g h i
 243
 244 ppArityInfo sty UnknownArity         = ppNil
 245 ppArityInfo sty (ArityExactly arity) = ppCat [ppPStr SLIT("_A_"), ppInt arity]
 246 ppArityInfo sty (ArityAtLeast arity) = ppCat [ppPStr SLIT("_A>_"), ppInt arity]
 247 \end{code}
 248
 249 %************************************************************************
 250 %*                                                                      *
 251 \subsection[demand-IdInfo]{Demand info about an @Id@}
 252 %*                                                                      *
 253 %************************************************************************
 254
 255 Whether a value is certain to be demanded or not.  (This is the
 256 information that is computed by the ``front-end'' of the strictness
 257 analyser.)
 258
 259 This information is only used within a module, it is not exported
 260 (obviously).
 261
 262 \begin{code}
 263 data DemandInfo
 264   = UnknownDemand
 265   | DemandedAsPer Demand
 266 \end{code}
 267
 268 \begin{code}
 269 noDemandInfo = UnknownDemand
 270
 271 mkDemandInfo :: Demand -> DemandInfo
 272 mkDemandInfo demand = DemandedAsPer demand
 273
 274 willBeDemanded :: DemandInfo -> Bool
 275 willBeDemanded (DemandedAsPer demand) = isStrict demand
 276 willBeDemanded _                      = False
 277 \end{code}
 278
 279 \begin{code}
 280 demandInfo (IdInfo _ demand _ _ _ _ _ _ _) = demand
 281
 282 addDemandInfo (IdInfo a _ c d e f g h i) demand = IdInfo a demand c d e f g h i
 283
 284 ppDemandInfo PprInterface _           = ppNil
 285 ppDemandInfo sty UnknownDemand        = ppStr "{-# L #-}"
 286 ppDemandInfo sty (DemandedAsPer info) = ppCat [ppStr "{-#", ppStr (showList [info] ""), ppStr "#-}"]
 287 \end{code}
 288
 289 %************************************************************************
 290 %*                                                                      *
 291 \subsection[specialisation-IdInfo]{Specialisation info about an @Id@}
 292 %*                                                                      *
 293 %************************************************************************
 294
 295 See SpecEnv.lhs
 296
 297 \begin{code}
 298 specInfo (IdInfo _ _ spec _ _ _ _ _ _) = spec
 299
 300 addSpecInfo id_info spec | isNullSpecEnv spec = id_info
 301 addSpecInfo (IdInfo a b _ d e f g h i) spec   = IdInfo a b spec d e f g h i
 302 \end{code}
 303
 304 %************************************************************************
 305 %*                                                                      *
 306 \subsection[strictness-IdInfo]{Strictness info about an @Id@}
 307 %*                                                                      *
 308 %************************************************************************
 309
 310 We specify the strictness of a function by giving information about
 311 each of the ``wrapper's'' arguments (see the description about
 312 worker/wrapper-style transformations in the PJ/Launchbury paper on
 313 unboxed types).
 314
 315 The list of @Demands@ specifies: (a)~the strictness properties
 316 of a function's arguments; (b)~the {\em existence} of a ``worker''
 317 version of the function; and (c)~the type signature of that worker (if
 318 it exists); i.e. its calling convention.
 319
 320 \begin{code}
 321 data StrictnessInfo bdee
 322   = NoStrictnessInfo
 323
 324   | BottomGuaranteed    -- This Id guarantees never to return;
 325                         -- it is bottom regardless of its arguments.
 326                         -- Useful for "error" and other disguised
 327                         -- variants thereof.
 328
 329   | StrictnessInfo      [Demand]        -- The main stuff; see below.
 330                         (Maybe bdee)    -- Worker's Id, if applicable.
 331                                         -- (It may not be applicable because the strictness info
 332                                         -- might say just "SSS" or something; so there's no w/w split.)
 333 \end{code}
 334
 335 \begin{code}
 336 mkStrictnessInfo :: [Demand] -> Maybe bdee -> StrictnessInfo bdee
 337
 338 mkStrictnessInfo xs wrkr
 339   | all is_lazy xs       = NoStrictnessInfo             -- Uninteresting
 340   | otherwise            = StrictnessInfo xs wrkr
 341   where
 342     is_lazy (WwLazy False) = True       -- NB "Absent" args do *not* count!
 343     is_lazy _              = False      -- (as they imply a worker)
 344
 345 noStrictnessInfo       = NoStrictnessInfo
 346 mkBottomStrictnessInfo = BottomGuaranteed
 347
 348 bottomIsGuaranteed BottomGuaranteed = True
 349 bottomIsGuaranteed other            = False
 350
 351 strictnessInfo (IdInfo _ _ _ strict _ _ _ _ _) = strict
 352
 353 addStrictnessInfo id_info                    NoStrictnessInfo = id_info
 354 addStrictnessInfo (IdInfo a b d _ e f g h i) strict           = IdInfo a b d strict e f g h i
 355
 356 ppStrictnessInfo sty NoStrictnessInfo = ppNil
 357 ppStrictnessInfo sty BottomGuaranteed = ppPStr SLIT("_bot_")
 358
 359 ppStrictnessInfo sty (StrictnessInfo wrapper_args wrkr_maybe)
 360   = ppCat [ppPStr SLIT("_S_"), ppStr (showList wrapper_args ""), pp_wrkr]
 361   where
 362     pp_wrkr = case wrkr_maybe of
 363                  Nothing   -> ppNil
 364                  Just wrkr -> ppr sty wrkr
 365 \end{code}
 366
 367
 368 \begin{code}
 369 workerExists :: StrictnessInfo bdee -> Bool
 370 workerExists (StrictnessInfo _ (Just worker_id)) = True
 371 workerExists other                               = False
 372
 373 getWorkerId_maybe :: StrictnessInfo bdee -> Maybe bdee
 374 getWorkerId_maybe (StrictnessInfo _ maybe_worker_id) = maybe_worker_id
 375 getWorkerId_maybe other                              = Nothing
 376 \end{code}
 377
 378
 379 %************************************************************************
 380 %*                                                                      *
 381 \subsection[unfolding-IdInfo]{Unfolding info about an @Id@}
 382 %*                                                                      *
 383 %************************************************************************
 384
 385 \begin{code}
 386 unfoldInfo (IdInfo _ _ _ _ unfolding _ _ _ _) = unfolding
 387
 388 addUnfoldInfo (IdInfo a b d e _ f g h i) uf = IdInfo a b d e uf f g h i
 389 \end{code}
 390
 391 %************************************************************************
 392 %*                                                                      *
 393 \subsection[update-IdInfo]{Update-analysis info about an @Id@}
 394 %*                                                                      *
 395 %************************************************************************
 396
 397 \begin{code}
 398 data UpdateInfo
 399   = NoUpdateInfo
 400   | SomeUpdateInfo UpdateSpec
 401   deriving (Eq, Ord)
 402       -- we need Eq/Ord to cross-chk update infos in interfaces
 403
 404 -- the form in which we pass update-analysis info between modules:
 405 type UpdateSpec = [Int]
 406 \end{code}
 407
 408 \begin{code}
 409 mkUpdateInfo = SomeUpdateInfo
 410
 411 updateInfoMaybe NoUpdateInfo        = Nothing
 412 updateInfoMaybe (SomeUpdateInfo []) = Nothing
 413 updateInfoMaybe (SomeUpdateInfo  u) = Just u
 414 \end{code}
 415
 416 Text instance so that the update annotations can be read in.
 417
 418 \begin{code}
 419 #ifdef REALLY_HASKELL_1_3
 420 instance Read UpdateInfo where
 421 #else
 422 instance Text UpdateInfo where
 423 #endif
 424     readsPrec p s | null s    = panic "IdInfo: empty update pragma?!"
 425                   | otherwise = [(SomeUpdateInfo (map ok_digit s),"")]
 426       where
 427         ok_digit c | c >= '0' && c <= '2' = ord c - ord '0'
 428                    | otherwise = panic "IdInfo: not a digit while reading update pragma"
 429
 430 updateInfo (IdInfo _ _ _ _ _ update _ _ _) = update
 431
 432 addUpdateInfo id_info                    NoUpdateInfo = id_info
 433 addUpdateInfo (IdInfo a b d e f _ g h i) upd_info     = IdInfo a b d e f upd_info g h i
 434
 435 ppUpdateInfo sty NoUpdateInfo          = ppNil
 436 ppUpdateInfo sty (SomeUpdateInfo [])   = ppNil
 437 ppUpdateInfo sty (SomeUpdateInfo spec) = ppBeside (ppPStr SLIT("_U_ ")) (ppBesides (map ppInt spec))
 438 \end{code}
 439
 440 %************************************************************************
 441 %*                                                                    *
 442 \subsection[deforest-IdInfo]{Deforestation info about an @Id@}
 443 %*                                                                    *
 444 %************************************************************************
 445
 446 The deforest info says whether this Id is to be unfolded during
 447 deforestation.  Therefore, when the deforest pragma is true, we must
 448 also have the unfolding information available for this Id.
 449
 450 \begin{code}
 451 data DeforestInfo
 452   = Don'tDeforest                     -- just a bool, might extend this
 453   | DoDeforest                                -- later.
 454   -- deriving (Eq, Ord)
 455 \end{code}
 456
 457 \begin{code}
 458 deforestInfo (IdInfo _ _ _ _ _ _ deforest _ _) = deforest
 459
 460 addDeforestInfo id_info                    Don'tDeforest = id_info
 461 addDeforestInfo (IdInfo a b d e f g _ h i) deforest      = IdInfo a b d e f g deforest h i
 462
 463 ppDeforestInfo sty Don'tDeforest = ppNil
 464 ppDeforestInfo sty DoDeforest    = ppPStr SLIT("_DEFOREST_")
 465 \end{code}
 466
 467 %************************************************************************
 468 %*                                                                      *
 469 \subsection[argUsage-IdInfo]{Argument Usage info about an @Id@}
 470 %*                                                                      *
 471 %************************************************************************
 472
 473 \begin{code}
 474 data ArgUsageInfo
 475   = NoArgUsageInfo
 476   | SomeArgUsageInfo ArgUsageType
 477   -- ??? deriving (Eq, Ord)
 478
 479 data ArgUsage = ArgUsage Int    -- number of arguments (is linear!)
 480               | UnknownArgUsage
 481 type ArgUsageType  = [ArgUsage]         -- c_1 -> ... -> BLOB
 482 \end{code}
 483
 484 \begin{code}
 485 mkArgUsageInfo [] = NoArgUsageInfo
 486 mkArgUsageInfo au = SomeArgUsageInfo au
 487
 488 getArgUsage :: ArgUsageInfo -> ArgUsageType
 489 getArgUsage NoArgUsageInfo        = []
 490 getArgUsage (SomeArgUsageInfo u)  = u
 491 \end{code}
 492
 493 \begin{code}
 494 argUsageInfo (IdInfo _ _ _ _ _  _ _ au _) = au
 495
 496 addArgUsageInfo id_info                    NoArgUsageInfo = id_info
 497 addArgUsageInfo (IdInfo a b d e f g h _ i) au_info        = IdInfo a b d e f g h au_info i
 498
 499 ppArgUsageInfo sty NoArgUsageInfo         = ppNil
 500 ppArgUsageInfo sty (SomeArgUsageInfo aut) = ppBeside (ppPStr SLIT("_L_ ")) (ppArgUsageType aut)
 501
 502 ppArgUsage (ArgUsage n)      = ppInt n
 503 ppArgUsage (UnknownArgUsage) = ppChar '-'
 504
 505 ppArgUsageType aut = ppBesides
 506         [ ppChar '"' ,
 507           ppIntersperse ppComma (map ppArgUsage aut),
 508           ppChar '"' ]
 509 \end{code}
 510
 511 %************************************************************************
 512 %*                                                                      *
 513 \subsection[FBType-IdInfo]{Type of an expression through Foldr/build's eyes}
 514 %*                                                                      *
 515 %************************************************************************
 516
 517 \begin{code}
 518 data FBTypeInfo
 519   = NoFBTypeInfo
 520   | SomeFBTypeInfo FBType
 521
 522 data FBType = FBType [FBConsum] FBProd deriving (Eq)
 523
 524 data FBConsum = FBGoodConsum | FBBadConsum deriving(Eq)
 525 data FBProd = FBGoodProd | FBBadProd deriving(Eq)
 526 \end{code}
 527
 528 \begin{code}
 529 mkFBTypeInfo = SomeFBTypeInfo
 530
 531 getFBType :: FBTypeInfo -> Maybe FBType
 532 getFBType NoFBTypeInfo        = Nothing
 533 getFBType (SomeFBTypeInfo u)  = Just u
 534 \end{code}
 535
 536 \begin{code}
 537 fbTypeInfo (IdInfo _ _ _ _ _ _ _ _ fb) = fb
 538
 539 addFBTypeInfo id_info NoFBTypeInfo = id_info
 540 addFBTypeInfo (IdInfo a b d e f g h i _) fb_info = IdInfo a b d e f g h i fb_info
 541
 542 ppFBTypeInfo sty NoFBTypeInfo = ppNil
 543 ppFBTypeInfo sty (SomeFBTypeInfo (FBType cons prod))
 544       = ppBeside (ppPStr SLIT("_F_ ")) (ppFBType cons prod)
 545
 546 ppFBType cons prod = ppBesides
 547         ([ ppChar '"' ] ++ map ppCons cons ++ [ ppChar '-', ppProd prod, ppChar '"' ])
 548   where
 549         ppCons FBGoodConsum = ppChar 'G'
 550         ppCons FBBadConsum  = ppChar 'B'
 551         ppProd FBGoodProd   = ppChar 'G'
 552         ppProd FBBadProd    = ppChar 'B'
 553 \end{code}