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        ; traceTc "lookupFamInst" ((ppr tycon <+> ppr tys) $$ ppr instEnv)
 207        ; case lookupFamInstEnv instEnv tycon tys of
 208            []                      -> return Nothing
 209            ((fam_inst, rep_tys):_)
 210              -> return $ Just (famInstTyCon fam_inst, rep_tys)
 211        }
 212
 213 tcLookupDataFamInst :: TyCon -> [Type] -> TcM (TyCon, [Type])
 214 -- Find the instance of a data famliy
 215 -- Note [Looking up family instances for deriving]
 216 tcLookupDataFamInst tycon tys
 217   | not (isFamilyTyCon tycon)
 218   = return (tycon, tys)
 219   | otherwise
 220   = ASSERT( isAlgTyCon tycon )
 221     do { maybeFamInst <- tcLookupFamInst tycon tys
 222        ; case maybeFamInst of
 223            Nothing      -> famInstNotFound tycon tys
 224            Just famInst -> return famInst }
 225
 226 famInstNotFound :: TyCon -> [Type] -> TcM a
 227 famInstNotFound tycon tys
 228   = failWithTc (ptext (sLit "No family instance for")
 229                         <+> quotes (pprTypeApp tycon tys))
 230 \end{code}
 231
 232 Note [Looking up family instances for deriving]
 233 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 234 tcLookupFamInstExact is an auxiliary lookup wrapper which requires
 235 that looked-up family instances exist.  If called with a vanilla
 236 tycon, the old type application is simply returned.
 237
 238 If we have
 239   data instance F () = ... deriving Eq
 240   data instance F () = ... deriving Eq
 241 then tcLookupFamInstExact will be confused by the two matches;
 242 but that can't happen because tcInstDecls1 doesn't call tcDeriving
 243 if there are any overlaps.
 244
 245 There are two other things that might go wrong with the lookup.
 246 First, we might see a standalone deriving clause
 247         deriving Eq (F ())
 248 when there is no data instance F () in scope.
 249
 250 Note that it's OK to have
 251   data instance F [a] = ...
 252   deriving Eq (F [(a,b)])
 253 where the match is not exact; the same holds for ordinary data types
 254 with standalone deriving declrations.
 255
 256 \begin{code}
 257 instance MonadThings (IOEnv (Env TcGblEnv TcLclEnv)) where
 258     lookupThing = tcLookupGlobal
 259 \end{code}
 260
 261 %************************************************************************
 262 %*                                                                      *
 263                 Extending the global environment
 264 %*                                                                      *
 265 %************************************************************************
 266
 267
 268 \begin{code}
 269 setGlobalTypeEnv :: TcGblEnv -> TypeEnv -> TcM TcGblEnv
 270 -- Use this to update the global type env
 271 -- It updates both  * the normal tcg_type_env field
 272 --                  * the tcg_type_env_var field seen by interface files
 273 setGlobalTypeEnv tcg_env new_type_env
 274   = do  {     -- Sync the type-envt variable seen by interface files
 275            writeMutVar (tcg_type_env_var tcg_env) new_type_env
 276          ; return (tcg_env { tcg_type_env = new_type_env }) }
 277
 278 tcExtendGlobalEnv :: [TyThing] -> TcM r -> TcM r
 279   -- Given a mixture of Ids, TyCons, Classes, all from the
 280   -- module being compiled, extend the global environment
 281 tcExtendGlobalEnv things thing_inside
 282    = do { tcg_env <- getGblEnv
 283         ; let ge'  = extendTypeEnvList (tcg_type_env tcg_env) things
 284         ; tcg_env' <- setGlobalTypeEnv tcg_env ge'
 285         ; setGblEnv tcg_env' thing_inside }
 286
 287 tcExtendGlobalValEnv :: [Id] -> TcM a -> TcM a
 288   -- Same deal as tcExtendGlobalEnv, but for Ids
 289 tcExtendGlobalValEnv ids thing_inside
 290   = tcExtendGlobalEnv [AnId id | id <- ids] thing_inside
 291
 292 tcExtendRecEnv :: [(Name,TyThing)] -> TcM r -> TcM r
 293 -- Extend the global environments for the type/class knot tying game
 294 -- Just like tcExtendGlobalEnv, except the argument is a list of pairs
 295 tcExtendRecEnv gbl_stuff thing_inside
 296  = do  { tcg_env <- getGblEnv
 297        ; let ge' = extendNameEnvList (tcg_type_env tcg_env) gbl_stuff
 298        ; tcg_env' <- setGlobalTypeEnv tcg_env ge'
 299        ; setGblEnv tcg_env' thing_inside }
 300 \end{code}
 301
 302
 303 %************************************************************************
 304 %*                                                                      *
 305 \subsection{The local environment}
 306 %*                                                                      *
 307 %************************************************************************
 308
 309 \begin{code}
 310 tcLookupLocated :: Located Name -> TcM TcTyThing
 311 tcLookupLocated = addLocM tcLookup
 312
 313 tcLookup :: Name -> TcM TcTyThing
 314 tcLookup name = do
 315     local_env <- getLclTypeEnv
 316     case lookupNameEnv local_env name of
 317         Just thing -> return thing
 318         Nothing    -> AGlobal <$> tcLookupGlobal name
 319
 320 tcLookupTyVar :: Name -> TcM TcTyVar
 321 tcLookupTyVar name = do
 322     thing <- tcLookup name
 323     case thing of
 324         ATyVar _ ty -> return (tcGetTyVar "tcLookupTyVar" ty)
 325         _           -> pprPanic "tcLookupTyVar" (ppr name)
 326
 327 tcLookupId :: Name -> TcM Id
 328 -- Used when we aren't interested in the binding level, nor refinement.
 329 -- The "no refinement" part means that we return the un-refined Id regardless
 330 --
 331 -- The Id is never a DataCon. (Why does that matter? see TcExpr.tcId)
 332 tcLookupId name = do
 333     thing <- tcLookup name
 334     case thing of
 335         ATcId { tct_id = id} -> return id
 336         AGlobal (AnId id)    -> return id
 337         _                    -> pprPanic "tcLookupId" (ppr name)
 338
 339 tcLookupLocalIds :: [Name] -> TcM [TcId]
 340 -- We expect the variables to all be bound, and all at
 341 -- the same level as the lookup.  Only used in one place...
 342 tcLookupLocalIds ns = do
 343     env <- getLclEnv
 344     return (map (lookup (tcl_env env) (thLevel (tcl_th_ctxt env))) ns)
 345   where
 346     lookup lenv lvl name
 347         = case lookupNameEnv lenv name of
 348                 Just (ATcId { tct_id = id, tct_level = lvl1 })
 349                         -> ASSERT( lvl == lvl1 ) id
 350                 _ -> pprPanic "tcLookupLocalIds" (ppr name)
 351
 352 getInLocalScope :: TcM (Name -> Bool)
 353   -- Ids only
 354 getInLocalScope = do { lcl_env <- getLclTypeEnv
 355                      ; return (`elemNameEnv` lcl_env) }
 356 \end{code}
 357
 358 \begin{code}
 359 tcExtendKindEnv :: [(Name, TcKind)] -> TcM r -> TcM r
 360 tcExtendKindEnv things thing_inside
 361   = updLclEnv upd thing_inside
 362   where
 363     upd lcl_env = lcl_env { tcl_env = extend (tcl_env lcl_env) }
 364     extend env  = extendNameEnvList env [(n, AThing k) | (n,k) <- things]
 365
 366 tcExtendKindEnvTvs :: [LHsTyVarBndr Name] -> ([LHsTyVarBndr Name] -> TcM r) -> TcM r
 367 tcExtendKindEnvTvs bndrs thing_inside
 368   = tcExtendKindEnv (map (hsTyVarNameKind . unLoc) bndrs)
 369                     (thing_inside bndrs)
 370
 371 tcExtendTyVarEnv :: [TyVar] -> TcM r -> TcM r
 372 tcExtendTyVarEnv tvs thing_inside
 373   = tcExtendTyVarEnv2 [(tyVarName tv, mkTyVarTy tv) | tv <- tvs] thing_inside
 374
 375 tcExtendTyVarEnv2 :: [(Name,TcType)] -> TcM r -> TcM r
 376 tcExtendTyVarEnv2 binds thing_inside = do
 377     env@(TcLclEnv {tcl_env = le,
 378                    tcl_tyvars = gtvs,
 379                    tcl_rdr = rdr_env}) <- getLclEnv
 380     let
 381         rdr_env'   = extendLocalRdrEnvList rdr_env (map fst binds)
 382         new_tv_set = tcTyVarsOfTypes (map snd binds)
 383         le'        = extendNameEnvList le [(name, ATyVar name ty) | (name, ty) <- binds]
 384
 385         -- It's important to add the in-scope tyvars to the global tyvar set
 386         -- as well.  Consider
 387         --      f (_::r) = let g y = y::r in ...
 388         -- Here, g mustn't be generalised.  This is also important during
 389         -- class and instance decls, when we mustn't generalise the class tyvars
 390         -- when typechecking the methods.
 391     gtvs' <- tcExtendGlobalTyVars gtvs new_tv_set
 392     setLclEnv (env {tcl_env = le', tcl_tyvars = gtvs', tcl_rdr = rdr_env'}) thing_inside
 393
 394 getScopedTyVarBinds :: TcM [(Name, TcType)]
 395 getScopedTyVarBinds
 396   = do  { lcl_env <- getLclEnv
 397         ; return [(name, ty) | ATyVar name ty <- nameEnvElts (tcl_env lcl_env)] }
 398 \end{code}
 399
 400
 401 \begin{code}
 402 tcExtendIdEnv :: [TcId] -> TcM a -> TcM a
 403 tcExtendIdEnv ids thing_inside = tcExtendIdEnv2 [(idName id, id) | id <- ids] thing_inside
 404
 405 tcExtendIdEnv1 :: Name -> TcId -> TcM a -> TcM a
 406 tcExtendIdEnv1 name id thing_inside = tcExtendIdEnv2 [(name,id)] thing_inside
 407
 408 tcExtendIdEnv2 :: [(Name,TcId)] -> TcM a -> TcM a
 409 -- Invariant: the TcIds are fully zonked (see tcExtendIdEnv above)
 410 tcExtendIdEnv2 names_w_ids thing_inside
 411   = do  { env <- getLclEnv
 412         ; tc_extend_local_id_env env (thLevel (tcl_th_ctxt env)) names_w_ids thing_inside }
 413
 414 tcExtendGhciEnv :: [TcId] -> TcM a -> TcM a
 415 -- Used to bind Ids for GHCi identifiers bound earlier in the user interaction
 416 -- Note especially that we bind them at TH level 'impLevel'.  That's because it's
 417 -- OK to use a variable bound earlier in the interaction in a splice, becuase
 418 -- GHCi has already compiled it to bytecode
 419 tcExtendGhciEnv ids thing_inside
 420   = do  { env <- getLclEnv
 421         ; tc_extend_local_id_env env impLevel [(idName id, id) | id <- ids] thing_inside }
 422
 423 tc_extend_local_id_env          -- This is the guy who does the work
 424         :: TcLclEnv
 425         -> ThLevel
 426         -> [(Name,TcId)]
 427         -> TcM a -> TcM a
 428 -- Invariant: the TcIds are fully zonked. Reasons:
 429 --      (a) The kinds of the forall'd type variables are defaulted
 430 --          (see Kind.defaultKind, done in zonkQuantifiedTyVar)
 431 --      (b) There are no via-Indirect occurrences of the bound variables
 432 --          in the types, because instantiation does not look through such things
 433 --      (c) The call to tyVarsOfTypes is ok without looking through refs
 434
 435 tc_extend_local_id_env env th_lvl names_w_ids thing_inside
 436   = do  { traceTc "env2" (ppr extra_env)
 437         ; gtvs' <- tcExtendGlobalTyVars (tcl_tyvars env) extra_global_tyvars
 438         ; let env' = env {tcl_env = le', tcl_tyvars = gtvs', tcl_rdr = rdr_env'}
 439         ; setLclEnv env' thing_inside }
 440   where
 441     extra_global_tyvars = tcTyVarsOfTypes [idType id | (_,id) <- names_w_ids]
 442     extra_env       = [ (name, ATcId { tct_id = id,
 443                                        tct_level = th_lvl })
 444                       | (name,id) <- names_w_ids]
 445     le'             = extendNameEnvList (tcl_env env) extra_env
 446     rdr_env'        = extendLocalRdrEnvList (tcl_rdr env) [name | (name,_) <- names_w_ids]
 447
 448 tcExtendGlobalTyVars :: IORef VarSet -> VarSet -> TcM (IORef VarSet)
 449 tcExtendGlobalTyVars gtv_var extra_global_tvs
 450   = do { global_tvs <- readMutVar gtv_var
 451        ; newMutVar (global_tvs `unionVarSet` extra_global_tvs) }
 452 \end{code}
 453
 454
 455 %************************************************************************
 456 %*                                                                      *
 457 \subsection{Rules}
 458 %*                                                                      *
 459 %************************************************************************
 460
 461 \begin{code}
 462 tcExtendRules :: [LRuleDecl Id] -> TcM a -> TcM a
 463         -- Just pop the new rules into the EPS and envt resp
 464         -- All the rules come from an interface file, not soruce
 465         -- Nevertheless, some may be for this module, if we read
 466         -- its interface instead of its source code
 467 tcExtendRules lcl_rules thing_inside
 468  = do { env <- getGblEnv
 469       ; let
 470           env' = env { tcg_rules = lcl_rules ++ tcg_rules env }
 471       ; setGblEnv env' thing_inside }
 472 \end{code}
 473
 474
 475 %************************************************************************
 476 %*                                                                      *
 477                 Meta level
 478 %*                                                                      *
 479 %************************************************************************
 480
 481 \begin{code}
 482 checkWellStaged :: SDoc         -- What the stage check is for
 483                 -> ThLevel      -- Binding level (increases inside brackets)
 484                 -> ThLevel      -- Use stage
 485                 -> TcM ()       -- Fail if badly staged, adding an error
 486 checkWellStaged pp_thing bind_lvl use_lvl
 487   | use_lvl >= bind_lvl         -- OK! Used later than bound
 488   = return ()                   -- E.g.  \x -> [| $(f x) |]
 489
 490   | bind_lvl == outerLevel      -- GHC restriction on top level splices
 491   = failWithTc $
 492     sep [ptext (sLit "GHC stage restriction:") <+>  pp_thing,
 493          nest 2 (vcat [ ptext (sLit "is used in a top-level splice or annotation,")
 494                       , ptext (sLit "and must be imported, not defined locally")])]
 495
 496   | otherwise                   -- Badly staged
 497   = failWithTc $                -- E.g.  \x -> $(f x)
 498     ptext (sLit "Stage error:") <+> pp_thing <+>
 499         hsep   [ptext (sLit "is bound at stage") <+> ppr bind_lvl,
 500                 ptext (sLit "but used at stage") <+> ppr use_lvl]
 501
 502 topIdLvl :: Id -> ThLevel
 503 -- Globals may either be imported, or may be from an earlier "chunk"
 504 -- (separated by declaration splices) of this module.  The former
 505 --  *can* be used inside a top-level splice, but the latter cannot.
 506 -- Hence we give the former impLevel, but the latter topLevel
 507 -- E.g. this is bad:
 508 --      x = [| foo |]
 509 --      $( f x )
 510 -- By the time we are prcessing the $(f x), the binding for "x"
 511 -- will be in the global env, not the local one.
 512 topIdLvl id | isLocalId id = outerLevel
 513             | otherwise    = impLevel
 514
 515 tcMetaTy :: Name -> TcM Type
 516 -- Given the name of a Template Haskell data type,
 517 -- return the type
 518 -- E.g. given the name "Expr" return the type "Expr"
 519 tcMetaTy tc_name = do
 520     t <- tcLookupTyCon tc_name
 521     return (mkTyConApp t [])
 522
 523 thRnBrack :: ThStage
 524 -- Used *only* to indicate that we are inside a TH bracket during renaming
 525 -- Tested by TcEnv.isBrackStage
 526 -- See Note [Top-level Names in Template Haskell decl quotes]
 527 thRnBrack = Brack (panic "thRnBrack1") (panic "thRnBrack2") (panic "thRnBrack3")
 528
 529 isBrackStage :: ThStage -> Bool
 530 isBrackStage (Brack {}) = True
 531 isBrackStage _other     = False
 532
 533 thTopLevelId :: Id -> Bool
 534 -- See Note [What is a top-level Id?] in TcSplice
 535 thTopLevelId id = isGlobalId id || isExternalName (idName id)
 536 \end{code}
 537
 538
 539 %************************************************************************
 540 %*                                                                      *
 541                  getDefaultTys
 542 %*                                                                      *
 543 %************************************************************************
 544
 545 \begin{code}
 546 tcGetDefaultTys :: Bool         -- True <=> interactive context
 547                 -> TcM ([Type], -- Default types
 548                         (Bool,  -- True <=> Use overloaded strings
 549                          Bool)) -- True <=> Use extended defaulting rules
 550 tcGetDefaultTys interactive
 551   = do  { dflags <- getDOpts
 552         ; let ovl_strings = xopt Opt_OverloadedStrings dflags
 553               extended_defaults = interactive
 554                                || xopt Opt_ExtendedDefaultRules dflags
 555                                         -- See also Trac #1974
 556               flags = (ovl_strings, extended_defaults)
 557
 558         ; mb_defaults <- getDeclaredDefaultTys
 559         ; case mb_defaults of {
 560            Just tys -> return (tys, flags) ;
 561                                 -- User-supplied defaults
 562            Nothing  -> do
 563
 564         -- No use-supplied default
 565         -- Use [Integer, Double], plus modifications
 566         { integer_ty <- tcMetaTy integerTyConName
 567         ; checkWiredInTyCon doubleTyCon
 568         ; string_ty <- tcMetaTy stringTyConName
 569         ; let deflt_tys = opt_deflt extended_defaults unitTy  -- Note [Default unitTy]
 570                           ++ [integer_ty, doubleTy]
 571                           ++ opt_deflt ovl_strings string_ty
 572         ; return (deflt_tys, flags) } } }
 573   where
 574     opt_deflt True  ty = [ty]
 575     opt_deflt False _  = []
 576 \end{code}
 577
 578 Note [Default unitTy]
 579 ~~~~~~~~~~~~~~~~~~~~~
 580 In interative mode (or with -XExtendedDefaultRules) we add () as the first type we
 581 try when defaulting.  This has very little real impact, except in the following case.
 582 Consider:
 583         Text.Printf.printf "hello"
 584 This has type (forall a. IO a); it prints "hello", and returns 'undefined'.  We don't
 585 want the GHCi repl loop to try to print that 'undefined'.  The neatest thing is to
 586 default the 'a' to (), rather than to Integer (which is what would otherwise happen;
 587 and then GHCi doesn't attempt to print the ().  So in interactive mode, we add
 588 () to the list of defaulting types.  See Trac #1200.
 589
 590
 591 %************************************************************************
 592 %*                                                                      *
 593 \subsection{The InstInfo type}
 594 %*                                                                      *
 595 %************************************************************************
 596
 597 The InstInfo type summarises the information in an instance declaration
 598
 599     instance c => k (t tvs) where b
 600
 601 It is used just for *local* instance decls (not ones from interface files).
 602 But local instance decls includes
 603         - derived ones
 604         - generic ones
 605 as well as explicit user written ones.
 606
 607 \begin{code}
 608 data InstInfo a
 609   = InstInfo {
 610       iSpec   :: Instance,        -- Includes the dfun id.  Its forall'd type
 611       iBinds  :: InstBindings a   -- variables scope over the stuff in InstBindings!
 612     }
 613
 614 iDFunId :: InstInfo a -> DFunId
 615 iDFunId info = instanceDFunId (iSpec info)
 616
 617 data InstBindings a
 618   = VanillaInst                 -- The normal case
 619         (LHsBinds a)            -- Bindings for the instance methods
 620         [LSig a]                -- User pragmas recorded for generating
 621                                 -- specialised instances
 622         Bool                    -- True <=> This code came from a standalone deriving clause
 623                                 --          Used only to improve error messages
 624
 625   | NewTypeDerived      -- Used for deriving instances of newtypes, where the
 626                         -- witness dictionary is identical to the argument
 627                         -- dictionary.  Hence no bindings, no pragmas.
 628
 629           -- BAY* : should this be a CoAxiom?
 630         Coercion        -- The coercion maps from newtype to the representation type
 631                         -- (mentioning type variables bound by the forall'd iSpec variables)
 632                         -- E.g.   newtype instance N [a] = N1 (Tree a)
 633                         --        co : N [a] ~ Tree a
 634
 635         TyCon           -- The TyCon is the newtype N.  If it's indexed, then it's the
 636                         -- representation TyCon, so that tyConDataCons returns [N1],
 637                         -- the "data constructor".
 638                         -- See Note [Newtype deriving and unused constructors]
 639                         -- in TcDeriv
 640
 641 pprInstInfo :: InstInfo a -> SDoc
 642 pprInstInfo info = hang (ptext (sLit "instance"))
 643                       2 (sep [ ifPprDebug (pprForAll tvs)
 644                              , pprThetaArrowTy theta, ppr tau
 645                              , ptext (sLit "where")])
 646   where
 647     (tvs, theta, tau) = tcSplitSigmaTy (idType (iDFunId info))
 648
 649
 650 pprInstInfoDetails :: OutputableBndr a => InstInfo a -> SDoc
 651 pprInstInfoDetails info = pprInstInfo info $$ nest 2 (details (iBinds info))
 652   where
 653     details (VanillaInst b _ _) = pprLHsBinds b
 654     details (NewTypeDerived {}) = text "Derived from the representation type"
 655
 656 simpleInstInfoClsTy :: InstInfo a -> (Class, Type)
 657 simpleInstInfoClsTy info = case instanceHead (iSpec info) of
 658                            (_, _, cls, [ty]) -> (cls, ty)
 659                            _ -> panic "simpleInstInfoClsTy"
 660
 661 simpleInstInfoTy :: InstInfo a -> Type
 662 simpleInstInfoTy info = snd (simpleInstInfoClsTy info)
 663
 664 simpleInstInfoTyCon :: InstInfo a -> TyCon
 665   -- Gets the type constructor for a simple instance declaration,
 666   -- i.e. one of the form       instance (...) => C (T a b c) where ...
 667 simpleInstInfoTyCon inst = tcTyConAppTyCon (simpleInstInfoTy inst)
 668 \end{code}
 669
 670 Make a name for the dict fun for an instance decl.  It's an *external*
 671 name, like otber top-level names, and hence must be made with newGlobalBinder.
 672
 673 \begin{code}
 674 newDFunName :: Class -> [Type] -> SrcSpan -> TcM Name
 675 newDFunName clas tys loc
 676   = do  { is_boot <- tcIsHsBoot
 677         ; mod     <- getModule
 678         ; let info_string = occNameString (getOccName clas) ++
 679                             concatMap (occNameString.getDFunTyKey) tys
 680         ; dfun_occ <- chooseUniqueOccTc (mkDFunOcc info_string is_boot)
 681         ; newGlobalBinder mod dfun_occ loc }
 682 \end{code}
 683
 684 Make a name for the representation tycon of a family instance.  It's an
 685 *external* name, like otber top-level names, and hence must be made with
 686 newGlobalBinder.
 687
 688 \begin{code}
 689 newFamInstTyConName :: Name -> [Type] -> SrcSpan -> TcM Name
 690 newFamInstTyConName tc_name tys loc
 691   = do  { mod   <- getModule
 692         ; let info_string = occNameString (getOccName tc_name) ++
 693                             concatMap (occNameString.getDFunTyKey) tys
 694         ; occ   <- chooseUniqueOccTc (mkInstTyTcOcc info_string)
 695         ; newGlobalBinder mod occ loc }
 696 \end{code}
 697
 698 Stable names used for foreign exports and annotations.
 699 For stable names, the name must be unique (see #1533).  If the
 700 same thing has several stable Ids based on it, the
 701 top-level bindings generated must not have the same name.
 702 Hence we create an External name (doesn't change), and we
 703 append a Unique to the string right here.
 704
 705 \begin{code}
 706 mkStableIdFromString :: String -> Type -> SrcSpan -> (OccName -> OccName) -> TcM TcId
 707 mkStableIdFromString str sig_ty loc occ_wrapper = do
 708     uniq <- newUnique
 709     mod <- getModule
 710     let uniq_str = showSDoc (pprUnique uniq) :: String
 711         occ = mkVarOcc (str ++ '_' : uniq_str) :: OccName
 712         gnm = mkExternalName uniq mod (occ_wrapper occ) loc :: Name
 713         id  = mkExportedLocalId gnm sig_ty :: Id
 714     return id
 715
 716 mkStableIdFromName :: Name -> Type -> SrcSpan -> (OccName -> OccName) -> TcM TcId
 717 mkStableIdFromName nm = mkStableIdFromString (getOccString nm)
 718 \end{code}
 719
 720 %************************************************************************
 721 %*                                                                      *
 722 \subsection{Errors}
 723 %*                                                                      *
 724 %************************************************************************
 725
 726 \begin{code}
 727 pprBinders :: [Name] -> SDoc
 728 -- Used in error messages
 729 -- Use quotes for a single one; they look a bit "busy" for several
 730 pprBinders [bndr] = quotes (ppr bndr)
 731 pprBinders bndrs  = pprWithCommas ppr bndrs
 732
 733 notFound :: Name -> TcM TyThing
 734 notFound name
 735   = do { (gbl,lcl) <- getEnvs
 736        ; failWithTc (vcat[ptext (sLit "GHC internal error:") <+> quotes (ppr name) <+>
 737                      ptext (sLit "is not in scope during type checking, but it passed the renamer"),
 738                      ptext (sLit "tcg_type_env of environment:") <+> ppr (tcg_type_env gbl),
 739                      ptext (sLit "tcl_env of environment:") <+> ppr (tcl_env lcl)]
 740                     ) }
 741
 742 wrongThingErr :: String -> TcTyThing -> Name -> TcM a
 743 wrongThingErr expected thing name
 744   = failWithTc (pprTcTyThingCategory thing <+> quotes (ppr name) <+>
 745                 ptext (sLit "used as a") <+> text expected)
 746 \end{code}