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