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