compiler/typecheck/TcEnv.lhs

   1 %
   2 % (c) The University of Glasgow 2006
   3 %
   4
   5 \begin{code}
   6 module TcEnv(
   7         TyThing(..), TcTyThing(..), TcId,
   8
   9         -- Instance environment, and InstInfo type
  10         InstInfo(..), iDFunId, pprInstInfo, pprInstInfoDetails,
  11         simpleInstInfoClsTy, simpleInstInfoTy, simpleInstInfoTyCon,
  12         InstBindings(..),
  13
  14         -- Global environment
  15         tcExtendGlobalEnv, tcExtendGlobalEnvImplicit, setGlobalTypeEnv,
  16         tcExtendGlobalValEnv,
  17         tcLookupLocatedGlobal,  tcLookupGlobal,
  18         tcLookupField, tcLookupTyCon, tcLookupClass, tcLookupDataCon,
  19         tcLookupLocatedGlobalId, tcLookupLocatedTyCon,
  20         tcLookupLocatedClass,
  21
  22         -- Local environment
  23         tcExtendKindEnv, tcExtendKindEnvTvs,
  24         tcExtendTyVarEnv, tcExtendTyVarEnv2,
  25         tcExtendGhciEnv, tcExtendLetEnv,
  26         tcExtendIdEnv, tcExtendIdEnv1, tcExtendIdEnv2,
  27         tcLookup, tcLookupLocated, tcLookupLocalIds,
  28         tcLookupId, tcLookupTyVar, getScopedTyVarBinds,
  29         getInLocalScope,
  30         wrongThingErr, pprBinders,
  31
  32         tcExtendRecEnv,         -- For knot-tying
  33
  34         -- Rules
  35         tcExtendRules,
  36
  37         -- Defaults
  38         tcGetDefaultTys,
  39
  40         -- Global type variables
  41         tcGetGlobalTyVars,
  42
  43         -- Template Haskell stuff
  44         checkWellStaged, tcMetaTy, thLevel,
  45         topIdLvl, thTopLevelId, thRnBrack, isBrackStage,
  46
  47         -- New Ids
  48         newLocalName, newDFunName, newFamInstTyConName,
  49         mkStableIdFromString, mkStableIdFromName
  50   ) where
  51
  52 #include "HsVersions.h"
  53
  54 import HsSyn
  55 import IfaceEnv
  56 import TcRnMonad
  57 import TcMType
  58 import TcType
  59 import TcIface
  60 import PrelNames
  61 import TysWiredIn
  62 import Id
  63 import Coercion
  64 import Var
  65 import VarSet
  66 import RdrName
  67 import InstEnv
  68 import DataCon
  69 import TyCon
  70 import TypeRep
  71 import Class
  72 import Name
  73 import NameEnv
  74 import HscTypes
  75 import DynFlags
  76 import SrcLoc
  77 import BasicTypes
  78 import Outputable
  79 import Unique
  80 import FastString
  81 \end{code}
  82
  83
  84 %************************************************************************
  85 %*                                                                      *
  86 %*                      tcLookupGlobal                                  *
  87 %*                                                                      *
  88 %************************************************************************
  89
  90 Using the Located versions (eg. tcLookupLocatedGlobal) is preferred,
  91 unless you know that the SrcSpan in the monad is already set to the
  92 span of the Name.
  93
  94 \begin{code}
  95 tcLookupLocatedGlobal :: Located Name -> TcM TyThing
  96 -- c.f. IfaceEnvEnv.tcIfaceGlobal
  97 tcLookupLocatedGlobal name
  98   = addLocM tcLookupGlobal name
  99
 100 tcLookupGlobal :: Name -> TcM TyThing
 101 -- The Name is almost always an ExternalName, but not always
 102 -- In GHCi, we may make command-line bindings (ghci> let x = True)
 103 -- that bind a GlobalId, but with an InternalName
 104 tcLookupGlobal name
 105   = do  { env <- getGblEnv
 106
 107                 -- Try local envt
 108         ; case lookupNameEnv (tcg_type_env env) name of {
 109                 Just thing -> return thing ;
 110                 Nothing    -> do
 111
 112                 -- Try global envt
 113         { hsc_env <- getTopEnv
 114         ; mb_thing <- liftIO (lookupTypeHscEnv hsc_env name)
 115         ; case mb_thing of  {
 116             Just thing -> return thing ;
 117             Nothing    -> do
 118
 119                 -- Should it have been in the local envt?
 120         { case nameModule_maybe name of
 121                 Nothing -> notFound name -- Internal names can happen in GHCi
 122
 123                 Just mod | mod == tcg_mod env   -- Names from this module
 124                          -> notFound name -- should be in tcg_type_env
 125                          | otherwise
 126                          -> tcImportDecl name   -- Go find it in an interface
 127         }}}}}
 128
 129 tcLookupField :: Name -> TcM Id         -- Returns the selector Id
 130 tcLookupField name
 131   = tcLookupId name     -- Note [Record field lookup]
 132
 133 {- Note [Record field lookup]
 134    ~~~~~~~~~~~~~~~~~~~~~~~~~~
 135 You might think we should have tcLookupGlobal here, since record fields
 136 are always top level.  But consider
 137         f = e { f = True }
 138 Then the renamer (which does not keep track of what is a record selector
 139 and what is not) will rename the definition thus
 140         f_7 = e { f_7 = True }
 141 Now the type checker will find f_7 in the *local* type environment, not
 142 the global (imported) one. It's wrong, of course, but we want to report a tidy
 143 error, not in TcEnv.notFound.  -}
 144
 145 tcLookupDataCon :: Name -> TcM DataCon
 146 tcLookupDataCon name = do
 147     thing <- tcLookupGlobal name
 148     case thing of
 149         ADataCon con -> return con
 150         _            -> wrongThingErr "data constructor" (AGlobal thing) name
 151
 152 tcLookupClass :: Name -> TcM Class
 153 tcLookupClass name = do
 154     thing <- tcLookupGlobal name
 155     case thing of
 156         ATyCon tc | Just cls <- tyConClass_maybe tc -> return cls
 157         _                                           -> wrongThingErr "class" (AGlobal thing) name
 158
 159 tcLookupTyCon :: Name -> TcM TyCon
 160 tcLookupTyCon name = do
 161     thing <- tcLookupGlobal name
 162     case thing of
 163         ATyCon tc -> return tc
 164         _         -> wrongThingErr "type constructor" (AGlobal thing) name
 165
 166 tcLookupLocatedGlobalId :: Located Name -> TcM Id
 167 tcLookupLocatedGlobalId = addLocM tcLookupId
 168
 169 tcLookupLocatedClass :: Located Name -> TcM Class
 170 tcLookupLocatedClass = addLocM tcLookupClass
 171
 172 tcLookupLocatedTyCon :: Located Name -> TcM TyCon
 173 tcLookupLocatedTyCon = addLocM tcLookupTyCon
 174 \end{code}
 175
 176 \begin{code}
 177 instance MonadThings (IOEnv (Env TcGblEnv TcLclEnv)) where
 178     lookupThing = tcLookupGlobal
 179 \end{code}
 180
 181 %************************************************************************
 182 %*                                                                      *
 183                 Extending the global environment
 184 %*                                                                      *
 185 %************************************************************************
 186
 187
 188 \begin{code}
 189 setGlobalTypeEnv :: TcGblEnv -> TypeEnv -> TcM TcGblEnv
 190 -- Use this to update the global type env
 191 -- It updates both  * the normal tcg_type_env field
 192 --                  * the tcg_type_env_var field seen by interface files
 193 setGlobalTypeEnv tcg_env new_type_env
 194   = do  {     -- Sync the type-envt variable seen by interface files
 195            writeMutVar (tcg_type_env_var tcg_env) new_type_env
 196          ; return (tcg_env { tcg_type_env = new_type_env }) }
 197
 198
 199 tcExtendGlobalEnv :: [TyThing] -> TcM r -> TcM r
 200   -- Given a mixture of Ids, TyCons, Classes, all defined in the
 201   -- module being compiled, extend the global environment
 202 tcExtendGlobalEnv things thing_inside
 203   = do { env <- getGblEnv
 204        ; let env' = env { tcg_tcs  = [ tc | ATyCon tc <- things,
 205                                             not (isClassTyCon tc)]
 206                                       ++ tcg_tcs env
 207                         , tcg_clss = [ cl | ATyCon tc <- things,
 208                                             Just cl <- [tyConClass_maybe tc]]
 209                                       ++ tcg_clss env }
 210        ; setGblEnv env' $
 211             tcExtendGlobalEnvImplicit things thing_inside
 212        }
 213
 214 tcExtendGlobalEnvImplicit :: [TyThing] -> TcM r -> TcM r
 215   -- Extend the global environment with some TyThings that can be obtained
 216   -- via implicitTyThings from other entities in the environment.  Examples
 217   -- are dfuns, famInstTyCons, data cons, etc.
 218   -- These TyThings are not added to tcg_tcs or tcg_clss.
 219 tcExtendGlobalEnvImplicit things thing_inside
 220    = do { tcg_env <- getGblEnv
 221         ; let ge'  = extendTypeEnvList (tcg_type_env tcg_env) things
 222         ; tcg_env' <- setGlobalTypeEnv tcg_env ge'
 223         ; setGblEnv tcg_env' thing_inside }
 224
 225 tcExtendGlobalValEnv :: [Id] -> TcM a -> TcM a
 226   -- Same deal as tcExtendGlobalEnv, but for Ids
 227 tcExtendGlobalValEnv ids thing_inside
 228   = tcExtendGlobalEnv [AnId id | id <- ids] thing_inside
 229
 230 tcExtendRecEnv :: [(Name,TyThing)] -> TcM r -> TcM r
 231 -- Extend the global environments for the type/class knot tying game
 232 -- Just like tcExtendGlobalEnv, except the argument is a list of pairs
 233 tcExtendRecEnv gbl_stuff thing_inside
 234  = do  { tcg_env <- getGblEnv
 235        ; let ge' = extendNameEnvList (tcg_type_env tcg_env) gbl_stuff
 236        ; tcg_env' <- setGlobalTypeEnv tcg_env ge'
 237        ; setGblEnv tcg_env' thing_inside }
 238 \end{code}
 239
 240
 241 %************************************************************************
 242 %*                                                                      *
 243 \subsection{The local environment}
 244 %*                                                                      *
 245 %************************************************************************
 246
 247 \begin{code}
 248 tcLookupLocated :: Located Name -> TcM TcTyThing
 249 tcLookupLocated = addLocM tcLookup
 250
 251 tcLookup :: Name -> TcM TcTyThing
 252 tcLookup name = do
 253     local_env <- getLclTypeEnv
 254     case lookupNameEnv local_env name of
 255         Just thing -> return thing
 256         Nothing    -> AGlobal <$> tcLookupGlobal name
 257
 258 tcLookupTyVar :: Name -> TcM TcTyVar
 259 tcLookupTyVar name = do
 260     thing <- tcLookup name
 261     case thing of
 262         ATyVar _ ty -> return (tcGetTyVar "tcLookupTyVar" ty)
 263         _           -> pprPanic "tcLookupTyVar" (ppr name)
 264
 265 tcLookupId :: Name -> TcM Id
 266 -- Used when we aren't interested in the binding level, nor refinement.
 267 -- The "no refinement" part means that we return the un-refined Id regardless
 268 --
 269 -- The Id is never a DataCon. (Why does that matter? see TcExpr.tcId)
 270 tcLookupId name = do
 271     thing <- tcLookup name
 272     case thing of
 273         ATcId { tct_id = id} -> return id
 274         AGlobal (AnId id)    -> return id
 275         _                    -> pprPanic "tcLookupId" (ppr name)
 276
 277 tcLookupLocalIds :: [Name] -> TcM [TcId]
 278 -- We expect the variables to all be bound, and all at
 279 -- the same level as the lookup.  Only used in one place...
 280 tcLookupLocalIds ns = do
 281     env <- getLclEnv
 282     return (map (lookup (tcl_env env) (thLevel (tcl_th_ctxt env))) ns)
 283   where
 284     lookup lenv lvl name
 285         = case lookupNameEnv lenv name of
 286                 Just (ATcId { tct_id = id, tct_level = lvl1 })
 287                         -> ASSERT( lvl == lvl1 ) id
 288                 _ -> pprPanic "tcLookupLocalIds" (ppr name)
 289
 290 getInLocalScope :: TcM (Name -> Bool)
 291   -- Ids only
 292 getInLocalScope = do { lcl_env <- getLclTypeEnv
 293                      ; return (`elemNameEnv` lcl_env) }
 294 \end{code}
 295
 296 \begin{code}
 297 tcExtendKindEnv :: [(Name, TcKind)] -> TcM r -> TcM r
 298 tcExtendKindEnv things thing_inside
 299   = updLclEnv upd thing_inside
 300   where
 301     upd lcl_env = lcl_env { tcl_env = extend (tcl_env lcl_env) }
 302     extend env  = extendNameEnvList env [(n, AThing k) | (n,k) <- things]
 303
 304 tcExtendKindEnvTvs :: [LHsTyVarBndr Name] -> ([LHsTyVarBndr Name] -> TcM r) -> TcM r
 305 tcExtendKindEnvTvs bndrs thing_inside
 306   = tcExtendKindEnv (map (hsTyVarNameKind . unLoc) bndrs)
 307                     (thing_inside bndrs)
 308
 309 tcExtendTyVarEnv :: [TyVar] -> TcM r -> TcM r
 310 tcExtendTyVarEnv tvs thing_inside
 311   = tcExtendTyVarEnv2 [(tyVarName tv, mkTyVarTy tv) | tv <- tvs] thing_inside
 312
 313 tcExtendTyVarEnv2 :: [(Name,TcType)] -> TcM r -> TcM r
 314 tcExtendTyVarEnv2 binds thing_inside
 315   = tc_extend_local_env [(name, ATyVar name ty) | (name, ty) <- binds] thing_inside
 316
 317 getScopedTyVarBinds :: TcM [(Name, TcType)]
 318 getScopedTyVarBinds
 319   = do  { lcl_env <- getLclEnv
 320         ; return [(name, ty) | ATyVar name ty <- nameEnvElts (tcl_env lcl_env)] }
 321 \end{code}
 322
 323
 324 \begin{code}
 325 tcExtendLetEnv :: TopLevelFlag -> [TcId] -> TcM a -> TcM a
 326 tcExtendLetEnv closed ids thing_inside
 327   = do  { stage <- getStage
 328         ; tc_extend_local_env [ (idName id, ATcId { tct_id = id
 329                                                   , tct_closed = closed
 330                                                   , tct_level = thLevel stage })
 331                                  | id <- ids]
 332           thing_inside }
 333
 334 tcExtendIdEnv :: [TcId] -> TcM a -> TcM a
 335 tcExtendIdEnv ids thing_inside
 336   = tcExtendIdEnv2 [(idName id, id) | id <- ids] thing_inside
 337
 338 tcExtendIdEnv1 :: Name -> TcId -> TcM a -> TcM a
 339 tcExtendIdEnv1 name id thing_inside
 340   = tcExtendIdEnv2 [(name,id)] thing_inside
 341
 342 tcExtendIdEnv2 :: [(Name,TcId)] -> TcM a -> TcM a
 343 -- Invariant: the TcIds are fully zonked (see tcExtendIdEnv above)
 344 tcExtendIdEnv2 names_w_ids thing_inside
 345   = do  { stage <- getStage
 346         ; tc_extend_local_env [ (name, ATcId { tct_id = id
 347                                              , tct_closed = NotTopLevel
 348                                              , tct_level = thLevel stage })
 349                                  | (name,id) <- names_w_ids]
 350           thing_inside }
 351
 352 tcExtendGhciEnv :: [TcId] -> TcM a -> TcM a
 353 -- Used to bind Ids for GHCi identifiers bound earlier in the user interaction
 354 -- Note especially that we bind them at
 355 --  * TH level 'impLevel'.  That's because it's OK to use a variable bound
 356 --    earlier in the interaction in a splice, because
 357 --    GHCi has already compiled it to bytecode
 358 --  * Closedness flag is TopLevel.  The thing's type is closed
 359
 360 tcExtendGhciEnv ids thing_inside
 361   = tc_extend_local_env [ (idName id, ATcId { tct_id     = id
 362                                             , tct_closed = is_top id
 363                                             , tct_level  = impLevel })
 364                         | id <- ids]
 365     thing_inside
 366   where
 367     is_top id | isEmptyVarSet (tcTyVarsOfType (idType id)) = TopLevel
 368               | otherwise                                  = NotTopLevel
 369
 370
 371 tc_extend_local_env :: [(Name, TcTyThing)] -> TcM a -> TcM a
 372 -- This is the guy who does the work
 373 -- Invariant: the TcIds are fully zonked. Reasons:
 374 --      (a) The kinds of the forall'd type variables are defaulted
 375 --          (see Kind.defaultKind, done in zonkQuantifiedTyVar)
 376 --      (b) There are no via-Indirect occurrences of the bound variables
 377 --          in the types, because instantiation does not look through such things
 378 --      (c) The call to tyVarsOfTypes is ok without looking through refs
 379
 380 tc_extend_local_env extra_env thing_inside
 381   = do  { traceTc "env2" (ppr extra_env)
 382         ; env1 <- getLclEnv
 383         ; let le'      = extendNameEnvList     (tcl_env env1) extra_env
 384               rdr_env' = extendLocalRdrEnvList (tcl_rdr env1) (map fst extra_env)
 385               env2     = env1 {tcl_env = le', tcl_rdr = rdr_env'}
 386         ; env3 <- extend_gtvs env2
 387         ; setLclEnv env3 thing_inside }
 388   where
 389     extend_gtvs env
 390       | isEmptyVarSet extra_tvs
 391       = return env
 392       | otherwise
 393       = do { g_var <- tcExtendGlobalTyVars (tcl_tyvars env) extra_tvs
 394            ; return (env { tcl_tyvars = g_var }) }
 395
 396     extra_tvs = foldr (unionVarSet . get_tvs) emptyVarSet extra_env
 397
 398     get_tvs (_, ATcId { tct_id = id, tct_closed = closed })
 399       = case closed of
 400           TopLevel    -> ASSERT2( isEmptyVarSet id_tvs, ppr id $$ ppr (idType id) )
 401                          emptyVarSet
 402           NotTopLevel -> id_tvs
 403       where
 404         id_tvs = tcTyVarsOfType (idType id)
 405     get_tvs (_, ATyVar _ ty) = tcTyVarsOfType ty        -- See Note [Global TyVars]
 406     get_tvs other = pprPanic "get_tvs" (ppr other)
 407
 408         -- Note [Global TyVars]
 409         -- It's important to add the in-scope tyvars to the global tyvar set
 410         -- as well.  Consider
 411         --      f (_::r) = let g y = y::r in ...
 412         -- Here, g mustn't be generalised.  This is also important during
 413         -- class and instance decls, when we mustn't generalise the class tyvars
 414         -- when typechecking the methods.
 415
 416 tcExtendGlobalTyVars :: IORef VarSet -> VarSet -> TcM (IORef VarSet)
 417 tcExtendGlobalTyVars gtv_var extra_global_tvs
 418   = do { global_tvs <- readMutVar gtv_var
 419        ; newMutVar (global_tvs `unionVarSet` extra_global_tvs) }
 420 \end{code}
 421
 422
 423 %************************************************************************
 424 %*                                                                      *
 425 \subsection{Rules}
 426 %*                                                                      *
 427 %************************************************************************
 428
 429 \begin{code}
 430 tcExtendRules :: [LRuleDecl Id] -> TcM a -> TcM a
 431         -- Just pop the new rules into the EPS and envt resp
 432         -- All the rules come from an interface file, not source
 433         -- Nevertheless, some may be for this module, if we read
 434         -- its interface instead of its source code
 435 tcExtendRules lcl_rules thing_inside
 436  = do { env <- getGblEnv
 437       ; let
 438           env' = env { tcg_rules = lcl_rules ++ tcg_rules env }
 439       ; setGblEnv env' thing_inside }
 440 \end{code}
 441
 442
 443 %************************************************************************
 444 %*                                                                      *
 445                 Meta level
 446 %*                                                                      *
 447 %************************************************************************
 448
 449 \begin{code}
 450 checkWellStaged :: SDoc         -- What the stage check is for
 451                 -> ThLevel      -- Binding level (increases inside brackets)
 452                 -> ThLevel      -- Use stage
 453                 -> TcM ()       -- Fail if badly staged, adding an error
 454 checkWellStaged pp_thing bind_lvl use_lvl
 455   | use_lvl >= bind_lvl         -- OK! Used later than bound
 456   = return ()                   -- E.g.  \x -> [| $(f x) |]
 457
 458   | bind_lvl == outerLevel      -- GHC restriction on top level splices
 459   = failWithTc $
 460     sep [ptext (sLit "GHC stage restriction:") <+>  pp_thing,
 461          nest 2 (vcat [ ptext (sLit "is used in a top-level splice or annotation,")
 462                       , ptext (sLit "and must be imported, not defined locally")])]
 463
 464   | otherwise                   -- Badly staged
 465   = failWithTc $                -- E.g.  \x -> $(f x)
 466     ptext (sLit "Stage error:") <+> pp_thing <+>
 467         hsep   [ptext (sLit "is bound at stage") <+> ppr bind_lvl,
 468                 ptext (sLit "but used at stage") <+> ppr use_lvl]
 469
 470 topIdLvl :: Id -> ThLevel
 471 -- Globals may either be imported, or may be from an earlier "chunk"
 472 -- (separated by declaration splices) of this module.  The former
 473 --  *can* be used inside a top-level splice, but the latter cannot.
 474 -- Hence we give the former impLevel, but the latter topLevel
 475 -- E.g. this is bad:
 476 --      x = [| foo |]
 477 --      $( f x )
 478 -- By the time we are prcessing the $(f x), the binding for "x"
 479 -- will be in the global env, not the local one.
 480 topIdLvl id | isLocalId id = outerLevel
 481             | otherwise    = impLevel
 482
 483 tcMetaTy :: Name -> TcM Type
 484 -- Given the name of a Template Haskell data type,
 485 -- return the type
 486 -- E.g. given the name "Expr" return the type "Expr"
 487 tcMetaTy tc_name = do
 488     t <- tcLookupTyCon tc_name
 489     return (mkTyConApp t [])
 490
 491 thRnBrack :: ThStage
 492 -- Used *only* to indicate that we are inside a TH bracket during renaming
 493 -- Tested by TcEnv.isBrackStage
 494 -- See Note [Top-level Names in Template Haskell decl quotes]
 495 thRnBrack = Brack (panic "thRnBrack1") (panic "thRnBrack2") (panic "thRnBrack3")
 496
 497 isBrackStage :: ThStage -> Bool
 498 isBrackStage (Brack {}) = True
 499 isBrackStage _other     = False
 500
 501 thTopLevelId :: Id -> Bool
 502 -- See Note [What is a top-level Id?] in TcSplice
 503 thTopLevelId id = isGlobalId id || isExternalName (idName id)
 504 \end{code}
 505
 506
 507 %************************************************************************
 508 %*                                                                      *
 509                  getDefaultTys
 510 %*                                                                      *
 511 %************************************************************************
 512
 513 \begin{code}
 514 tcGetDefaultTys :: Bool         -- True <=> interactive context
 515                 -> TcM ([Type], -- Default types
 516                         (Bool,  -- True <=> Use overloaded strings
 517                          Bool)) -- True <=> Use extended defaulting rules
 518 tcGetDefaultTys interactive
 519   = do  { dflags <- getDOpts
 520         ; let ovl_strings = xopt Opt_OverloadedStrings dflags
 521               extended_defaults = interactive
 522                                || xopt Opt_ExtendedDefaultRules dflags
 523                                         -- See also Trac #1974
 524               flags = (ovl_strings, extended_defaults)
 525
 526         ; mb_defaults <- getDeclaredDefaultTys
 527         ; case mb_defaults of {
 528            Just tys -> return (tys, flags) ;
 529                                 -- User-supplied defaults
 530            Nothing  -> do
 531
 532         -- No use-supplied default
 533         -- Use [Integer, Double], plus modifications
 534         { integer_ty <- tcMetaTy integerTyConName
 535         ; checkWiredInTyCon doubleTyCon
 536         ; string_ty <- tcMetaTy stringTyConName
 537         ; let deflt_tys = opt_deflt extended_defaults unitTy  -- Note [Default unitTy]
 538                           ++ [integer_ty, doubleTy]
 539                           ++ opt_deflt ovl_strings string_ty
 540         ; return (deflt_tys, flags) } } }
 541   where
 542     opt_deflt True  ty = [ty]
 543     opt_deflt False _  = []
 544 \end{code}
 545
 546 Note [Default unitTy]
 547 ~~~~~~~~~~~~~~~~~~~~~
 548 In interative mode (or with -XExtendedDefaultRules) we add () as the first type we
 549 try when defaulting.  This has very little real impact, except in the following case.
 550 Consider:
 551         Text.Printf.printf "hello"
 552 This has type (forall a. IO a); it prints "hello", and returns 'undefined'.  We don't
 553 want the GHCi repl loop to try to print that 'undefined'.  The neatest thing is to
 554 default the 'a' to (), rather than to Integer (which is what would otherwise happen;
 555 and then GHCi doesn't attempt to print the ().  So in interactive mode, we add
 556 () to the list of defaulting types.  See Trac #1200.
 557
 558
 559 %************************************************************************
 560 %*                                                                      *
 561 \subsection{The InstInfo type}
 562 %*                                                                      *
 563 %************************************************************************
 564
 565 The InstInfo type summarises the information in an instance declaration
 566
 567     instance c => k (t tvs) where b
 568
 569 It is used just for *local* instance decls (not ones from interface files).
 570 But local instance decls includes
 571         - derived ones
 572         - generic ones
 573 as well as explicit user written ones.
 574
 575 \begin{code}
 576 data InstInfo a
 577   = InstInfo {
 578       iSpec   :: Instance,        -- Includes the dfun id.  Its forall'd type
 579       iBinds  :: InstBindings a   -- variables scope over the stuff in InstBindings!
 580     }
 581
 582 iDFunId :: InstInfo a -> DFunId
 583 iDFunId info = instanceDFunId (iSpec info)
 584
 585 data InstBindings a
 586   = VanillaInst                 -- The normal case
 587         (LHsBinds a)            -- Bindings for the instance methods
 588         [LSig a]                -- User pragmas recorded for generating
 589                                 -- specialised instances
 590         Bool                    -- True <=> This code came from a standalone deriving clause
 591                                 --          Used only to improve error messages
 592
 593   | NewTypeDerived      -- Used for deriving instances of newtypes, where the
 594                         -- witness dictionary is identical to the argument
 595                         -- dictionary.  Hence no bindings, no pragmas.
 596
 597         Coercion        -- The coercion maps from newtype to the representation type
 598                         -- (mentioning type variables bound by the forall'd iSpec variables)
 599                         -- E.g.   newtype instance N [a] = N1 (Tree a)
 600                         --        co : N [a] ~ Tree a
 601
 602         TyCon           -- The TyCon is the newtype N.  If it's indexed, then it's the
 603                         -- representation TyCon, so that tyConDataCons returns [N1],
 604                         -- the "data constructor".
 605                         -- See Note [Newtype deriving and unused constructors]
 606                         -- in TcDeriv
 607
 608 pprInstInfo :: InstInfo a -> SDoc
 609 pprInstInfo info = hang (ptext (sLit "instance"))
 610                       2 (sep [ ifPprDebug (pprForAll tvs)
 611                              , pprThetaArrowTy theta, ppr tau
 612                              , ptext (sLit "where")])
 613   where
 614     (tvs, theta, tau) = tcSplitSigmaTy (idType (iDFunId info))
 615
 616
 617 pprInstInfoDetails :: OutputableBndr a => InstInfo a -> SDoc
 618 pprInstInfoDetails info = pprInstInfo info $$ nest 2 (details (iBinds info))
 619   where
 620     details (VanillaInst b _ _) = pprLHsBinds b
 621     details (NewTypeDerived {}) = text "Derived from the representation type"
 622
 623 simpleInstInfoClsTy :: InstInfo a -> (Class, Type)
 624 simpleInstInfoClsTy info = case instanceHead (iSpec info) of
 625                            (_, _, cls, [ty]) -> (cls, ty)
 626                            _ -> panic "simpleInstInfoClsTy"
 627
 628 simpleInstInfoTy :: InstInfo a -> Type
 629 simpleInstInfoTy info = snd (simpleInstInfoClsTy info)
 630
 631 simpleInstInfoTyCon :: InstInfo a -> TyCon
 632   -- Gets the type constructor for a simple instance declaration,
 633   -- i.e. one of the form       instance (...) => C (T a b c) where ...
 634 simpleInstInfoTyCon inst = tcTyConAppTyCon (simpleInstInfoTy inst)
 635 \end{code}
 636
 637 Make a name for the dict fun for an instance decl.  It's an *external*
 638 name, like otber top-level names, and hence must be made with newGlobalBinder.
 639
 640 \begin{code}
 641 newDFunName :: Class -> [Type] -> SrcSpan -> TcM Name
 642 newDFunName clas tys loc
 643   = do  { is_boot <- tcIsHsBoot
 644         ; mod     <- getModule
 645         ; let info_string = occNameString (getOccName clas) ++
 646                             concatMap (occNameString.getDFunTyKey) tys
 647         ; dfun_occ <- chooseUniqueOccTc (mkDFunOcc info_string is_boot)
 648         ; newGlobalBinder mod dfun_occ loc }
 649 \end{code}
 650
 651 Make a name for the representation tycon of a family instance.  It's an
 652 *external* name, like other top-level names, and hence must be made with
 653 newGlobalBinder.
 654
 655 \begin{code}
 656 newFamInstTyConName :: Located Name -> [Type] -> TcM Name
 657 newFamInstTyConName (L loc tc_name) tys
 658   = do  { mod   <- getModule
 659         ; let info_string = occNameString (getOccName tc_name) ++
 660                             concatMap (occNameString.getDFunTyKey) tys
 661         ; occ   <- chooseUniqueOccTc (mkInstTyTcOcc info_string)
 662         ; newGlobalBinder mod occ loc }
 663 \end{code}
 664
 665 Stable names used for foreign exports and annotations.
 666 For stable names, the name must be unique (see #1533).  If the
 667 same thing has several stable Ids based on it, the
 668 top-level bindings generated must not have the same name.
 669 Hence we create an External name (doesn't change), and we
 670 append a Unique to the string right here.
 671
 672 \begin{code}
 673 mkStableIdFromString :: String -> Type -> SrcSpan -> (OccName -> OccName) -> TcM TcId
 674 mkStableIdFromString str sig_ty loc occ_wrapper = do
 675     uniq <- newUnique
 676     mod <- getModule
 677     let uniq_str = showSDoc (pprUnique uniq) :: String
 678         occ = mkVarOcc (str ++ '_' : uniq_str) :: OccName
 679         gnm = mkExternalName uniq mod (occ_wrapper occ) loc :: Name
 680         id  = mkExportedLocalId gnm sig_ty :: Id
 681     return id
 682
 683 mkStableIdFromName :: Name -> Type -> SrcSpan -> (OccName -> OccName) -> TcM TcId
 684 mkStableIdFromName nm = mkStableIdFromString (getOccString nm)
 685 \end{code}
 686
 687 %************************************************************************
 688 %*                                                                      *
 689 \subsection{Errors}
 690 %*                                                                      *
 691 %************************************************************************
 692
 693 \begin{code}
 694 pprBinders :: [Name] -> SDoc
 695 -- Used in error messages
 696 -- Use quotes for a single one; they look a bit "busy" for several
 697 pprBinders [bndr] = quotes (ppr bndr)
 698 pprBinders bndrs  = pprWithCommas ppr bndrs
 699
 700 notFound :: Name -> TcM TyThing
 701 notFound name
 702   = do { (gbl,lcl) <- getEnvs
 703        ; failWithTc (vcat[ptext (sLit "GHC internal error:") <+> quotes (ppr name) <+>
 704                      ptext (sLit "is not in scope during type checking, but it passed the renamer"),
 705                      ptext (sLit "tcg_type_env of environment:") <+> ppr (tcg_type_env gbl),
 706                      ptext (sLit "tcl_env of environment:") <+> ppr (tcl_env lcl)]
 707                     ) }
 708
 709 wrongThingErr :: String -> TcTyThing -> Name -> TcM a
 710 wrongThingErr expected thing name
 711   = failWithTc (pprTcTyThingCategory thing <+> quotes (ppr name) <+>
 712                 ptext (sLit "used as a") <+> text expected)
 713 \end{code}