ghc/compiler/typecheck/TcRnTypes.lhs

   1 %
   2 % (c) The GRASP Project, Glasgow University, 1992-2002
   3 %
   4 \begin{code}
   5 module TcRnTypes(
   6         TcRn, TcM, RnM, -- The monad is opaque outside this module
   7
   8         -- Standard monadic operations
   9         thenM, thenM_, returnM, failM,
  10
  11         -- Non-standard operations
  12         runTcRn, fixM, recoverM, ioToTcRn, ioToTcRn_no_fail,
  13         newMutVar, readMutVar, writeMutVar,
  14         getEnv, setEnv, updEnv, unsafeInterleaveM,
  15
  16         -- The environment types
  17         Env(..), TopEnv(..), TcGblEnv(..),
  18         TcLclEnv(..), RnLclEnv(..),
  19
  20         -- Ranamer types
  21         RnMode(..), isInterfaceMode, isCmdLineMode,
  22         Usages(..), emptyUsages, ErrCtxt,
  23         ImportAvails(..), emptyImportAvails, plusImportAvails, mkImportAvails,
  24         plusAvail, pruneAvails,
  25         AvailEnv, emptyAvailEnv, unitAvailEnv, plusAvailEnv, lookupAvailEnv, availEnvElts, addAvail,
  26         WhereFrom(..),
  27
  28         -- Typechecker types
  29         TcTyThing(..),
  30
  31         -- Template Haskell
  32         Stage(..), topStage, topSpliceStage,
  33         Level, impLevel, topLevel,
  34
  35         -- Insts
  36         Inst(..), InstOrigin(..), InstLoc, pprInstLoc,
  37         LIE, emptyLIE, unitLIE, plusLIE, consLIE,
  38         plusLIEs, mkLIE, isEmptyLIE, lieToList, listToLIE,
  39
  40         -- Misc other types
  41         TcRef, TcId, TcIdSet
  42   ) where
  43
  44 #include "HsVersions.h"
  45
  46 import HsSyn            ( PendingSplice, HsOverLit, MonoBinds, RuleDecl, ForeignDecl )
  47 import RnHsSyn          ( RenamedHsExpr, RenamedPat, RenamedArithSeqInfo )
  48 import HscTypes         ( GhciMode, ExternalPackageState, HomePackageTable, NameCache,
  49                           GlobalRdrEnv, LocalRdrEnv, FixityEnv, TypeEnv, TyThing,
  50                           Avails, GenAvailInfo(..), AvailInfo, availName,
  51                           IsBootInterface, Deprecations, unQualInScope )
  52 import TcType           ( TcTyVarSet, TcType, TcTauType, TcThetaType, TcPredType, TcKind,
  53                           tcCmpPred, tcCmpType, tcCmpTypes )
  54 import InstEnv          ( DFunId, InstEnv )
  55 import Name             ( Name )
  56 import NameEnv
  57 import NameSet          ( NameSet, emptyNameSet )
  58 import Type             ( Type )
  59 import Class            ( Class )
  60 import Var              ( Id, TyVar )
  61 import VarEnv           ( TidyEnv )
  62 import Module
  63 import SrcLoc           ( SrcLoc )
  64 import VarSet           ( IdSet )
  65 import ErrUtils         ( Messages, Message )
  66 import CmdLineOpts      ( DynFlags )
  67 import UniqSupply       ( UniqSupply )
  68 import BasicTypes       ( IPName )
  69 import Util             ( thenCmp )
  70 import Bag
  71 import Outputable
  72 import DATA_IOREF       ( IORef, newIORef, readIORef, writeIORef )
  73 import UNSAFE_IO        ( unsafeInterleaveIO )
  74 import FIX_IO           ( fixIO )
  75 import Maybe            ( mapMaybe )
  76 import List             ( nub )
  77 \end{code}
  78
  79
  80 \begin{code}
  81 type TcRef a = IORef a
  82 type TcId    = Id                       -- Type may be a TcType
  83 type TcIdSet = IdSet
  84 \end{code}
  85
  86 %************************************************************************
  87 %*                                                                      *
  88                Standard monad definition for TcRn
  89     All the combinators for the monad can be found in TcRnMonad
  90 %*                                                                      *
  91 %************************************************************************
  92
  93 The monad itself has to be defined here,
  94 because it is mentioned by ErrCtxt
  95
  96 \begin{code}
  97 newtype TcRn m a = TcRn (Env m -> IO a)
  98 unTcRn (TcRn f) = f
  99
 100 type TcM a = TcRn TcLclEnv a
 101 type RnM a = TcRn RnLclEnv a
 102
 103 returnM :: a -> TcRn m a
 104 returnM a = TcRn (\ env -> return a)
 105
 106 thenM :: TcRn m a -> (a -> TcRn m b) -> TcRn m b
 107 thenM (TcRn m) f = TcRn (\ env -> do { r <- m env ;
 108                                        unTcRn (f r) env })
 109
 110 thenM_ :: TcRn m a -> TcRn m b -> TcRn m b
 111 thenM_ (TcRn m) f = TcRn (\ env -> do { m env ; unTcRn f env })
 112
 113 failM :: TcRn m a
 114 failM = TcRn (\ env -> ioError (userError "TcRn failure"))
 115
 116 instance Monad (TcRn m) where
 117   (>>=)  = thenM
 118   (>>)   = thenM_
 119   return = returnM
 120   fail s = failM        -- Ignore the string
 121 \end{code}
 122
 123
 124 %************************************************************************
 125 %*                                                                      *
 126         Fundmantal combinators specific to the monad
 127 %*                                                                      *
 128 %************************************************************************
 129
 130 Running it
 131
 132 \begin{code}
 133 runTcRn :: Env m -> TcRn m a -> IO a
 134 runTcRn env (TcRn m) = m env
 135 \end{code}
 136
 137 The fixpoint combinator
 138
 139 \begin{code}
 140 {-# NOINLINE fixM #-}
 141   -- Aargh!  Not inlining fixTc alleviates a space leak problem.
 142   -- Normally fixTc is used with a lazy tuple match: if the optimiser is
 143   -- shown the definition of fixTc, it occasionally transforms the code
 144   -- in such a way that the code generator doesn't spot the selector
 145   -- thunks.  Sigh.
 146
 147 fixM :: (a -> TcRn m a) -> TcRn m a
 148 fixM f = TcRn (\ env -> fixIO (\ r -> unTcRn (f r) env))
 149 \end{code}
 150
 151 Error recovery
 152
 153 \begin{code}
 154 recoverM :: TcRn m r    -- Recovery action; do this if the main one fails
 155          -> TcRn m r    -- Main action: do this first
 156          -> TcRn m r
 157 recoverM (TcRn recover) (TcRn m)
 158   = TcRn (\ env -> catch (m env) (\ _ -> recover env))
 159 \end{code}
 160
 161 Lazy interleave
 162
 163 \begin{code}
 164 unsafeInterleaveM :: TcRn m a -> TcRn m a
 165 unsafeInterleaveM (TcRn m) = TcRn (\ env -> unsafeInterleaveIO (m env))
 166 \end{code}
 167
 168 \end{code}
 169
 170 Performing arbitrary I/O, plus the read/write var (for efficiency)
 171
 172 \begin{code}
 173 ioToTcRn :: IO a -> TcRn m a
 174 ioToTcRn io = TcRn (\ env -> io)
 175
 176 ioToTcRn_no_fail :: IO a -> TcRn m (Either IOError a)
 177 -- Catch any IO error and embody it in the result
 178 ioToTcRn_no_fail io = TcRn (\ env -> catch (io >>= \r -> return (Right r))
 179                                            (\ exn -> return (Left exn)))
 180
 181 newMutVar :: a -> TcRn m (TcRef a)
 182 newMutVar val = TcRn (\ env -> newIORef val)
 183
 184 writeMutVar :: TcRef a -> a -> TcRn m ()
 185 writeMutVar var val = TcRn (\ env -> writeIORef var val)
 186
 187 readMutVar :: TcRef a -> TcRn m a
 188 readMutVar var = TcRn (\ env -> readIORef var)
 189 \end{code}
 190
 191 Getting the environment
 192
 193 \begin{code}
 194 getEnv :: TcRn m (Env m)
 195 {-# INLINE getEnv #-}
 196 getEnv = TcRn (\ env -> return env)
 197
 198 setEnv :: Env n -> TcRn n a -> TcRn m a
 199 {-# INLINE setEnv #-}
 200 setEnv new_env (TcRn m) = TcRn (\ env -> m new_env)
 201
 202 updEnv :: (Env m -> Env n) -> TcRn n a -> TcRn m a
 203 {-# INLINE updEnv #-}
 204 updEnv upd (TcRn m) = TcRn (\ env -> m (upd env))
 205 \end{code}
 206
 207
 208 %************************************************************************
 209 %*                                                                      *
 210                 The main environment types
 211 %*                                                                      *
 212 %************************************************************************
 213
 214 \begin{code}
 215 data Env a      -- Changes as we move into an expression
 216   = Env {
 217         env_top  :: TopEnv,     -- Top-level stuff that never changes
 218                                 --   Mainly a bunch of updatable refs
 219                                 --   Includes all info about imported things
 220         env_gbl  :: TcGblEnv,   -- Info about things defined at the top leve
 221                                 --   of the module being compiled
 222
 223         env_lcl  :: a,          -- Different for the type checker
 224                                 -- and the renamer
 225
 226         env_loc  :: SrcLoc      -- Source location
 227     }
 228
 229 data TopEnv     -- Built once at top level then does not change
 230                 -- Concerns imported stuff
 231                 -- Exceptions: error recovery points, meta computation points
 232    = TopEnv {
 233         top_mode    :: GhciMode,
 234         top_dflags  :: DynFlags,
 235
 236         -- Stuff about imports
 237         top_eps    :: TcRef ExternalPackageState,
 238                 -- PIT, ImportedModuleInfo
 239                 -- DeclsMap, IfaceRules, IfaceInsts, InstGates
 240                 -- TypeEnv, InstEnv, RuleBase
 241
 242         top_hpt  :: HomePackageTable,
 243                 -- The home package table that we've accumulated while
 244                 -- compiling the home package,
 245                 -- *excluding* the module we are compiling right now.
 246                 -- (In one-shot mode the current module is the only
 247                 --  home-package module, so tc_hpt is empty.  All other
 248                 --  modules count as "external-package" modules.)
 249                 -- tc_hpt is not mutable because we only demand-load
 250                 -- external packages; the home package is eagerly
 251                 -- loaded by the compilation manager.
 252
 253         -- The global name supply
 254         top_nc     :: TcRef NameCache,          -- Maps original names to Names
 255         top_us     :: TcRef UniqSupply,         -- Unique supply for this module
 256         top_errs   :: TcRef Messages
 257    }
 258
 259 -- TcGblEnv describes the top-level of the module at the
 260 -- point at which the typechecker is finished work.
 261 -- It is this structure that is handed on to the desugarer
 262
 263 data TcGblEnv
 264   = TcGblEnv {
 265         tcg_mod    :: Module,           -- Module being compiled
 266         tcg_usages :: TcRef Usages,     -- What version of what entities
 267                                         -- have been used from other modules
 268                                         -- (whether home or ext-package modules)
 269         tcg_rdr_env :: GlobalRdrEnv,    -- Top level envt; used during renaming
 270         tcg_fix_env :: FixityEnv,       -- Ditto
 271         tcg_default :: [Type],          -- Types used for defaulting
 272
 273         tcg_type_env :: TypeEnv,        -- Global type env for the module we are compiling now
 274                 -- All TyCons and Classes (for this module) end up in here right away,
 275                 -- along with their derived constructors, selectors.
 276                 --
 277                 -- (Ids defined in this module start in the local envt,
 278                 --  though they move to the global envt during zonking)
 279
 280                 -- Cached things
 281         tcg_ist :: Name -> Maybe TyThing,       -- Imported symbol table
 282                 -- Global type env: a combination of tcg_eps, tcg_hpt
 283                 --      (but *not* tcg_type_env; no deep reason)
 284                 -- When the PCS changes this must be refreshed,
 285                 -- notably after running some compile-time code
 286
 287         tcg_inst_env :: InstEnv,        -- Global instance env: a combination of
 288                                         --      tc_pcs, tc_hpt, *and* tc_insts
 289
 290                 -- Now a bunch of things about this module that are simply
 291                 -- accumulated, but never consulted until the end.
 292                 -- Nevertheless, it's convenient to accumulate them along
 293                 -- with the rest of the info from this module.
 294         tcg_exports :: Avails,                  -- What is exported
 295         tcg_imports :: ImportAvails,            -- Information about what was imported
 296                                                 --    from where, including things bound
 297                                                 --    in this module
 298                 -- The next fields are always fully zonked
 299         tcg_binds   :: MonoBinds Id,            -- Value bindings in this module
 300         tcg_deprecs :: Deprecations,            -- ...Deprecations
 301         tcg_insts   :: [DFunId],                -- ...Instances
 302         tcg_rules   :: [RuleDecl Id],           -- ...Rules
 303         tcg_fords   :: [ForeignDecl Id]         -- ...Foreign import & exports
 304     }
 305 \end{code}
 306
 307
 308 %************************************************************************
 309 %*                                                                      *
 310                 The local typechecker environment
 311 %*                                                                      *
 312 %************************************************************************
 313
 314 The Global-Env/Local-Env story
 315 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 316 During type checking, we keep in the tcg_type_env
 317         * All types and classes
 318         * All Ids derived from types and classes (constructors, selectors)
 319
 320 At the end of type checking, we zonk the local bindings,
 321 and as we do so we add to the tcg_type_env
 322         * Locally defined top-level Ids
 323
 324 Why?  Because they are now Ids not TcIds.  This final GlobalEnv is
 325         a) fed back (via the knot) to typechecking the
 326            unfoldings of interface signatures
 327         b) used in the ModDetails of this module
 328
 329 \begin{code}
 330 data TcLclEnv
 331   = TcLclEnv {
 332         tcl_ctxt :: ErrCtxt,    -- Error context
 333
 334         tcl_level  :: Stage,            -- Template Haskell context
 335
 336         tcl_env    :: NameEnv TcTyThing,  -- The local type environment: Ids and TyVars
 337                                           -- defined in this module
 338
 339         tcl_tyvars :: TcRef TcTyVarSet, -- The "global tyvars"
 340                                         -- Namely, the in-scope TyVars bound in tcl_lenv,
 341                                         -- plus the tyvars mentioned in the types of
 342                                         -- Ids bound in tcl_lenv
 343                                         -- Why mutable? see notes with tcGetGlobalTyVars
 344
 345         tcl_lie :: TcRef LIE            -- Place to accumulate type constraints
 346     }
 347
 348 type Level = Int
 349
 350 data Stage
 351   = Comp                                -- Ordinary compiling, at level topLevel
 352   | Splice Level                        -- Inside a splice
 353   | Brack  Level                        -- Inside brackets;
 354            (TcRef [PendingSplice])      --   accumulate pending splices here
 355            (TcRef LIE)                  --   and type constraints here
 356 topStage, topSpliceStage :: Stage
 357 topStage       = Comp
 358 topSpliceStage = Splice (topLevel - 1)  -- Stage for the body of a top-level splice
 359
 360
 361 impLevel, topLevel :: Level
 362 topLevel = 1    -- Things dedined at top level of this module
 363 impLevel = 0    -- Imported things; they can be used inside a top level splice
 364 --
 365 -- For example:
 366 --      f = ...
 367 --      g1 = $(map ...)         is OK
 368 --      g2 = $(f ...)           is not OK; because we havn't compiled f yet
 369
 370 data TcTyThing
 371   = AGlobal TyThing             -- Used only in the return type of a lookup
 372   | ATcId   TcId Level          -- Ids defined in this module; may not be fully zonked
 373   | ATyVar  TyVar               -- Type variables
 374   | AThing  TcKind              -- Used temporarily, during kind checking
 375 -- Here's an example of how the AThing guy is used
 376 -- Suppose we are checking (forall a. T a Int):
 377 --      1. We first bind (a -> AThink kv), where kv is a kind variable.
 378 --      2. Then we kind-check the (T a Int) part.
 379 --      3. Then we zonk the kind variable.
 380 --      4. Now we know the kind for 'a', and we add (a -> ATyVar a::K) to the environment
 381 \end{code}
 382
 383 \begin{code}
 384 type ErrCtxt = [TidyEnv -> TcM (TidyEnv, Message)]
 385                         -- Innermost first.  Monadic so that we have a chance
 386                         -- to deal with bound type variables just before error
 387                         -- message construction
 388 \end{code}
 389
 390
 391 %************************************************************************
 392 %*                                                                      *
 393                 The local renamer environment
 394 %*                                                                      *
 395 %************************************************************************
 396
 397 \begin{code}
 398 data RnLclEnv
 399   = RnLclEnv {
 400         rn_mode :: RnMode,
 401         rn_lenv :: LocalRdrEnv          -- Local name envt
 402                 --   Does *not* include global name envt; may shadow it
 403                 --   Includes both ordinary variables and type variables;
 404                 --   they are kept distinct because tyvar have a different
 405                 --   occurrence contructor (Name.TvOcc)
 406                 -- We still need the unsullied global name env so that
 407                 --   we can look up record field names
 408      }
 409
 410 data RnMode = SourceMode                -- Renaming source code
 411             | InterfaceMode Module      -- Renaming interface declarations from M
 412             | CmdLineMode               -- Renaming a command-line expression
 413
 414 isInterfaceMode (InterfaceMode _) = True
 415 isInterfaceMode _                 = False
 416
 417 isCmdLineMode CmdLineMode = True
 418 isCmdLineMode _ = False
 419 \end{code}
 420
 421
 422 %************************************************************************
 423 %*                                                                      *
 424                         Usages
 425 %*                                                                      *
 426 %************************************************************************
 427
 428 Usages tells what things are actually need in order to compile this
 429 module.  It is used
 430         * for generating the usages field of the ModIface
 431         * for reporting unused things in scope
 432
 433 \begin{code}
 434 data Usages
 435   = Usages {
 436         usg_ext :: ModuleSet,
 437                 -- The non-home-package modules from which we have
 438                 -- slurped at least one name.
 439
 440         usg_home :: NameSet
 441                 -- The Names are all the (a) home-package
 442                 --                       (b) "big" (i.e. no data cons, class ops)
 443                 --                       (c) non-locally-defined
 444                 --                       (d) non-wired-in
 445                 -- names that have been slurped in so far.
 446                 -- This is used to generate the "usage" information for this module.
 447     }
 448
 449 emptyUsages :: Usages
 450 emptyUsages = Usages { usg_ext = emptyModuleSet,
 451                        usg_home = emptyNameSet }
 452 \end{code}
 453
 454
 455 %************************************************************************
 456 %*                                                                      *
 457         Operations over ImportAvails
 458 %*                                                                      *
 459 %************************************************************************
 460
 461 ImportAvails summarises what was imported from where, irrespective
 462 of whether the imported htings are actually used or not
 463 It is used      * when porcessing the export list
 464                 * when constructing usage info for the inteface file
 465                 * to identify the list of directly imported modules
 466                         for initialisation purposes
 467
 468 \begin{code}
 469 data ImportAvails
 470    = ImportAvails {
 471         imp_env :: AvailEnv,
 472                 -- All the things that are available from the import
 473                 -- Its domain is all the "main" things;
 474                 -- i.e. *excluding* class ops and constructors
 475                 --      (which appear inside their parent AvailTC)
 476
 477         imp_unqual :: ModuleEnv Avails,
 478                 -- Used to figure out "module M" export specifiers
 479                 -- Domain is only modules with *unqualified* imports
 480                 -- (see 1.4 Report Section 5.1.1)
 481
 482         imp_mods :: ModuleEnv (Module, Bool)
 483                 -- Domain is all directly-imported modules
 484                 -- Bool is True if there was an unrestricted import
 485                 --      (i.e. not a selective list)
 486                 -- We need the Module in the range because we can't get
 487                 --      the keys of a ModuleEnv
 488                 -- Used
 489                 --   (a) to help construct the usage information in
 490                 --       the interface file; if we import everything we
 491                 --       need to recompile if the module version changes
 492                 --   (b) to specify what child modules to initialise
 493       }
 494
 495 emptyImportAvails :: ImportAvails
 496 emptyImportAvails = ImportAvails { imp_env    = emptyAvailEnv,
 497                                    imp_unqual = emptyModuleEnv,
 498                                    imp_mods   = emptyModuleEnv }
 499
 500 plusImportAvails ::  ImportAvails ->  ImportAvails ->  ImportAvails
 501 plusImportAvails
 502   (ImportAvails { imp_env = env1, imp_unqual = unqual1, imp_mods = mods1 })
 503   (ImportAvails { imp_env = env2, imp_unqual = unqual2, imp_mods = mods2 })
 504   = ImportAvails { imp_env    = env1 `plusAvailEnv` env2,
 505                    imp_unqual = unqual1 `plusModuleEnv` unqual2,
 506                    imp_mods   = mods1 `plusModuleEnv` mods2 }
 507
 508 mkImportAvails :: ModuleName -> Bool
 509                -> GlobalRdrEnv -> [AvailInfo] -> ImportAvails
 510 mkImportAvails mod_name unqual_imp gbl_env avails
 511   = ImportAvails { imp_unqual = mod_avail_env,
 512                    imp_env    = entity_avail_env,
 513                    imp_mods   = emptyModuleEnv }-- Stays empty for module being compiled;
 514                                                 -- gets updated for imported modules
 515   where
 516     mod_avail_env = unitModuleEnvByName mod_name unqual_avails
 517
 518         -- unqual_avails is the Avails that are visible in *unqualified* form
 519         -- We need to know this so we know what to export when we see
 520         --      module M ( module P ) where ...
 521         -- Then we must export whatever came from P unqualified.
 522
 523     unqual_avails | not unqual_imp = [] -- Short cut when no unqualified imports
 524                   | otherwise      = pruneAvails (unQualInScope gbl_env) avails
 525
 526     entity_avail_env = foldl insert emptyAvailEnv avails
 527     insert env avail = extendNameEnv_C plusAvail env (availName avail) avail
 528         -- 'avails' may have several items with the same availName
 529         -- E.g  import Ix( Ix(..), index )
 530         -- will give Ix(Ix,index,range) and Ix(index)
 531         -- We want to combine these
 532 \end{code}
 533
 534 %************************************************************************
 535 %*                                                                      *
 536         Avails, AvailEnv, etc
 537 %*                                                                      *
 538 v%************************************************************************
 539
 540 \begin{code}
 541 plusAvail (Avail n1)       (Avail n2)       = Avail n1
 542 plusAvail (AvailTC n1 ns1) (AvailTC n2 ns2) = AvailTC n2 (nub (ns1 ++ ns2))
 543 -- Added SOF 4/97
 544 #ifdef DEBUG
 545 plusAvail a1 a2 = pprPanic "RnEnv.plusAvail" (hsep [ppr a1,ppr a2])
 546 #endif
 547
 548 -------------------------
 549 pruneAvails :: (Name -> Bool)   -- Keep if this is True
 550             -> [AvailInfo]
 551             -> [AvailInfo]
 552 pruneAvails keep avails
 553   = mapMaybe del avails
 554   where
 555     del :: AvailInfo -> Maybe AvailInfo -- Nothing => nothing left!
 556     del (Avail n) | keep n    = Just (Avail n)
 557                   | otherwise = Nothing
 558     del (AvailTC n ns) | null ns'  = Nothing
 559                        | otherwise = Just (AvailTC n ns')
 560                        where
 561                          ns' = filter keep ns
 562 \end{code}
 563
 564 ---------------------------------------
 565         AvailEnv and friends
 566 ---------------------------------------
 567
 568 \begin{code}
 569 type AvailEnv = NameEnv AvailInfo       -- Maps a Name to the AvailInfo that contains it
 570
 571 emptyAvailEnv :: AvailEnv
 572 emptyAvailEnv = emptyNameEnv
 573
 574 unitAvailEnv :: AvailInfo -> AvailEnv
 575 unitAvailEnv a = unitNameEnv (availName a) a
 576
 577 plusAvailEnv :: AvailEnv -> AvailEnv -> AvailEnv
 578 plusAvailEnv = plusNameEnv_C plusAvail
 579
 580 lookupAvailEnv = lookupNameEnv
 581
 582 availEnvElts = nameEnvElts
 583
 584 addAvail :: AvailEnv -> AvailInfo -> AvailEnv
 585 addAvail avails avail = extendNameEnv_C plusAvail avails (availName avail) avail
 586 \end{code}
 587
 588 %************************************************************************
 589 %*                                                                      *
 590 \subsection{Where from}
 591 %*                                                                      *
 592 %************************************************************************
 593
 594 The @WhereFrom@ type controls where the renamer looks for an interface file
 595
 596 \begin{code}
 597 data WhereFrom
 598   = ImportByUser IsBootInterface        -- Ordinary user import (perhaps {-# SOURCE #-})
 599
 600   | ImportForUsage IsBootInterface      -- Import when chasing usage info from an interaface file
 601                                         --      Failure in this case is not an error
 602
 603   | ImportBySystem                      -- Non user import.  Use eps_mod_info to decide whether
 604                                         -- the module this module depends on, or is a system-ish module;
 605                                         -- M.hi-boot otherwise
 606
 607 instance Outputable WhereFrom where
 608   ppr (ImportByUser is_boot) | is_boot     = ptext SLIT("{- SOURCE -}")
 609                              | otherwise   = empty
 610   ppr (ImportForUsage is_boot) | is_boot   = ptext SLIT("{- USAGE SOURCE -}")
 611                                | otherwise = ptext SLIT("{- USAGE -}")
 612   ppr ImportBySystem                       = ptext SLIT("{- SYSTEM -}")
 613 \end{code}
 614
 615
 616 %************************************************************************
 617 %*                                                                      *
 618 \subsection[Inst-types]{@Inst@ types}
 619 %*                                                                      *
 620 v%************************************************************************
 621
 622 An @Inst@ is either a dictionary, an instance of an overloaded
 623 literal, or an instance of an overloaded value.  We call the latter a
 624 ``method'' even though it may not correspond to a class operation.
 625 For example, we might have an instance of the @double@ function at
 626 type Int, represented by
 627
 628         Method 34 doubleId [Int] origin
 629
 630 \begin{code}
 631 data Inst
 632   = Dict
 633         Id
 634         TcPredType
 635         InstLoc
 636
 637   | Method
 638         Id
 639
 640         TcId    -- The overloaded function
 641                         -- This function will be a global, local, or ClassOpId;
 642                         --   inside instance decls (only) it can also be an InstId!
 643                         -- The id needn't be completely polymorphic.
 644                         -- You'll probably find its name (for documentation purposes)
 645                         --        inside the InstOrigin
 646
 647         [TcType]        -- The types to which its polymorphic tyvars
 648                         --      should be instantiated.
 649                         -- These types must saturate the Id's foralls.
 650
 651         TcThetaType     -- The (types of the) dictionaries to which the function
 652                         -- must be applied to get the method
 653
 654         TcTauType       -- The type of the method
 655
 656         InstLoc
 657
 658         -- INVARIANT: in (Method u f tys theta tau loc)
 659         --      type of (f tys dicts(from theta)) = tau
 660
 661   | LitInst
 662         Id
 663         HsOverLit       -- The literal from the occurrence site
 664                         --      INVARIANT: never a rebindable-syntax literal
 665                         --      Reason: tcSyntaxName does unification, and we
 666                         --              don't want to deal with that during tcSimplify
 667         TcType          -- The type at which the literal is used
 668         InstLoc
 669 \end{code}
 670
 671 @Insts@ are ordered by their class/type info, rather than by their
 672 unique.  This allows the context-reduction mechanism to use standard finite
 673 maps to do their stuff.
 674
 675 \begin{code}
 676 instance Ord Inst where
 677   compare = cmpInst
 678
 679 instance Eq Inst where
 680   (==) i1 i2 = case i1 `cmpInst` i2 of
 681                  EQ    -> True
 682                  other -> False
 683
 684 cmpInst (Dict _ pred1 _)          (Dict _ pred2 _)          = pred1 `tcCmpPred` pred2
 685 cmpInst (Dict _ _ _)              other                     = LT
 686
 687 cmpInst (Method _ _ _ _ _ _)      (Dict _ _ _)              = GT
 688 cmpInst (Method _ id1 tys1 _ _ _) (Method _ id2 tys2 _ _ _) = (id1 `compare` id2) `thenCmp` (tys1 `tcCmpTypes` tys2)
 689 cmpInst (Method _ _ _ _ _ _)      other                     = LT
 690
 691 cmpInst (LitInst _ _ _ _)         (Dict _ _ _)              = GT
 692 cmpInst (LitInst _ _ _ _)         (Method _ _ _ _ _ _)      = GT
 693 cmpInst (LitInst _ lit1 ty1 _)    (LitInst _ lit2 ty2 _)    = (lit1 `compare` lit2) `thenCmp` (ty1 `tcCmpType` ty2)
 694 \end{code}
 695
 696
 697 %************************************************************************
 698 %*                                                                      *
 699 \subsection[Inst-collections]{LIE: a collection of Insts}
 700 %*                                                                      *
 701 %************************************************************************
 702
 703 \begin{code}
 704 type LIE = Bag Inst
 705
 706 isEmptyLIE        = isEmptyBag
 707 emptyLIE          = emptyBag
 708 unitLIE inst      = unitBag inst
 709 mkLIE insts       = listToBag insts
 710 plusLIE lie1 lie2 = lie1 `unionBags` lie2
 711 consLIE inst lie  = inst `consBag` lie
 712 plusLIEs lies     = unionManyBags lies
 713 lieToList         = bagToList
 714 listToLIE         = listToBag
 715 \end{code}
 716
 717
 718 %************************************************************************
 719 %*                                                                      *
 720 \subsection[Inst-origin]{The @InstOrigin@ type}
 721 %*                                                                      *
 722 %************************************************************************
 723
 724 The @InstOrigin@ type gives information about where a dictionary came from.
 725 This is important for decent error message reporting because dictionaries
 726 don't appear in the original source code.  Doubtless this type will evolve...
 727
 728 It appears in TcMonad because there are a couple of error-message-generation
 729 functions that deal with it.
 730
 731 \begin{code}
 732 type InstLoc = (InstOrigin, SrcLoc, ErrCtxt)
 733
 734 data InstOrigin
 735   = OccurrenceOf Name           -- Occurrence of an overloaded identifier
 736
 737   | IPOcc (IPName Name)         -- Occurrence of an implicit parameter
 738   | IPBind (IPName Name)        -- Binding site of an implicit parameter
 739
 740   | RecordUpdOrigin
 741
 742   | DataDeclOrigin              -- Typechecking a data declaration
 743
 744   | InstanceDeclOrigin          -- Typechecking an instance decl
 745
 746   | LiteralOrigin HsOverLit     -- Occurrence of a literal
 747
 748   | PatOrigin RenamedPat
 749
 750   | ArithSeqOrigin RenamedArithSeqInfo -- [x..], [x..y] etc
 751   | PArrSeqOrigin  RenamedArithSeqInfo -- [:x..y:] and [:x,y..z:]
 752
 753   | SignatureOrigin             -- A dict created from a type signature
 754   | Rank2Origin                 -- A dict created when typechecking the argument
 755                                 -- of a rank-2 typed function
 756
 757   | DoOrigin                    -- The monad for a do expression
 758
 759   | ClassDeclOrigin             -- Manufactured during a class decl
 760
 761   | InstanceSpecOrigin  Class   -- in a SPECIALIZE instance pragma
 762                         Type
 763
 764         -- When specialising instances the instance info attached to
 765         -- each class is not yet ready, so we record it inside the
 766         -- origin information.  This is a bit of a hack, but it works
 767         -- fine.  (Patrick is to blame [WDP].)
 768
 769   | ValSpecOrigin       Name    -- in a SPECIALIZE pragma for a value
 770
 771         -- Argument or result of a ccall
 772         -- Dictionaries with this origin aren't actually mentioned in the
 773         -- translated term, and so need not be bound.  Nor should they
 774         -- be abstracted over.
 775
 776   | CCallOrigin         String                  -- CCall label
 777                         (Maybe RenamedHsExpr)   -- Nothing if it's the result
 778                                                 -- Just arg, for an argument
 779
 780   | LitLitOrigin        String  -- the litlit
 781
 782   | UnknownOrigin       -- Help! I give up...
 783 \end{code}
 784
 785 \begin{code}
 786 pprInstLoc :: InstLoc -> SDoc
 787 pprInstLoc (orig, locn, ctxt)
 788   = hsep [text "arising from", pp_orig orig, text "at", ppr locn]
 789   where
 790     pp_orig (OccurrenceOf name)
 791         = hsep [ptext SLIT("use of"), quotes (ppr name)]
 792     pp_orig (IPOcc name)
 793         = hsep [ptext SLIT("use of implicit parameter"), quotes (ppr name)]
 794     pp_orig (IPBind name)
 795         = hsep [ptext SLIT("binding for implicit parameter"), quotes (ppr name)]
 796     pp_orig RecordUpdOrigin
 797         = ptext SLIT("a record update")
 798     pp_orig DataDeclOrigin
 799         = ptext SLIT("the data type declaration")
 800     pp_orig InstanceDeclOrigin
 801         = ptext SLIT("the instance declaration")
 802     pp_orig (LiteralOrigin lit)
 803         = hsep [ptext SLIT("the literal"), quotes (ppr lit)]
 804     pp_orig (PatOrigin pat)
 805         = hsep [ptext SLIT("the pattern"), quotes (ppr pat)]
 806     pp_orig (ArithSeqOrigin seq)
 807         = hsep [ptext SLIT("the arithmetic sequence"), quotes (ppr seq)]
 808     pp_orig (PArrSeqOrigin seq)
 809         = hsep [ptext SLIT("the parallel array sequence"), quotes (ppr seq)]
 810     pp_orig (SignatureOrigin)
 811         =  ptext SLIT("a type signature")
 812     pp_orig (Rank2Origin)
 813         =  ptext SLIT("a function with an overloaded argument type")
 814     pp_orig (DoOrigin)
 815         =  ptext SLIT("a do statement")
 816     pp_orig (ClassDeclOrigin)
 817         =  ptext SLIT("a class declaration")
 818     pp_orig (InstanceSpecOrigin clas ty)
 819         = hsep [text "a SPECIALIZE instance pragma; class",
 820                 quotes (ppr clas), text "type:", ppr ty]
 821     pp_orig (ValSpecOrigin name)
 822         = hsep [ptext SLIT("a SPECIALIZE user-pragma for"), quotes (ppr name)]
 823     pp_orig (CCallOrigin clabel Nothing{-ccall result-})
 824         = hsep [ptext SLIT("the result of the _ccall_ to"), quotes (text clabel)]
 825     pp_orig (CCallOrigin clabel (Just arg_expr))
 826         = hsep [ptext SLIT("an argument in the _ccall_ to"), quotes (text clabel) <> comma,
 827                 text "namely", quotes (ppr arg_expr)]
 828     pp_orig (LitLitOrigin s)
 829         = hsep [ptext SLIT("the ``literal-literal''"), quotes (text s)]
 830     pp_orig (UnknownOrigin)
 831         = ptext SLIT("...oops -- I don't know where the overloading came from!")
 832 \end{code}