ghc/compiler/typecheck/TcEnv.lhs

   1 \begin{code}
   2 module TcEnv(
   3         TyThing(..), TcTyThing(..), TcId,
   4
   5         -- Instance environment, and InstInfo type
   6         InstInfo(..), pprInstInfo, pprInstInfoDetails,
   7         simpleInstInfoTy, simpleInstInfoTyCon,
   8         InstBindings(..),
   9
  10         -- Global environment
  11         tcExtendGlobalEnv,
  12         tcExtendGlobalValEnv,
  13         tcLookupGlobal,
  14         tcLookupGlobalId, tcLookupTyCon, tcLookupClass, tcLookupDataCon,
  15
  16         getInGlobalScope,
  17
  18         -- Local environment
  19         tcExtendTyVarKindEnv,
  20         tcExtendTyVarEnv,    tcExtendTyVarEnv2,
  21         tcExtendLocalValEnv, tcExtendLocalValEnv2,
  22         tcLookup, tcLookupLocalIds,
  23         tcLookupId, tcLookupTyVar,
  24         lclEnvElts, getInLocalScope, findGlobals,
  25
  26         tcExtendRecEnv,         -- For knot-tying
  27
  28         -- Rules
  29         tcExtendRules,
  30
  31         -- Global type variables
  32         tcGetGlobalTyVars,
  33
  34         -- Template Haskell stuff
  35         checkWellStaged, spliceOK, bracketOK, tcMetaTy, thLevel,
  36         topIdLvl,
  37
  38         -- Arrow stuff
  39         checkProcLevel,
  40
  41         -- New Ids
  42         newLocalName, newDFunName
  43   ) where
  44
  45 #include "HsVersions.h"
  46
  47 import RnHsSyn          ( RenamedMonoBinds, RenamedSig )
  48 import HsSyn            ( RuleDecl(..), , HsTyVarBndr(..) )
  49 import TcIface          ( tcImportDecl )
  50 import TcRnMonad
  51 import TcMType          ( zonkTcType, zonkTcTyVar, zonkTcTyVarsAndFV )
  52 import TcType           ( Type, TcTyVar, TcTyVarSet,
  53                           tyVarsOfType, tyVarsOfTypes, tcSplitDFunTy, mkGenTyConApp,
  54                           getDFunTyKey, tcTyConAppTyCon, tyVarBindingInfo,
  55                           tidyOpenType, tidyOpenTyVar
  56                         )
  57 import qualified Type   ( getTyVar_maybe )
  58 import Id               ( idName, isLocalId )
  59 import Var              ( TyVar, Id, mkTyVar, idType )
  60 import VarSet
  61 import VarEnv
  62 import DataCon          ( DataCon )
  63 import TyCon            ( TyCon )
  64 import Class            ( Class )
  65 import Name             ( Name, NamedThing(..),
  66                           getSrcLoc, mkInternalName, nameIsLocalOrFrom
  67                         )
  68 import NameEnv
  69 import OccName          ( mkDFunOcc, occNameString )
  70 import HscTypes         ( DFunId, extendTypeEnvList, lookupType,
  71                           TyThing(..), tyThingId, tyThingTyCon, tyThingClass, tyThingDataCon,
  72                           ExternalPackageState(..) )
  73
  74 import SrcLoc           ( SrcLoc )
  75 import Outputable
  76 import Maybe            ( isJust )
  77 \end{code}
  78
  79
  80 %************************************************************************
  81 %*                                                                      *
  82 %*                      tcLookupGlobal                                  *
  83 %*                                                                      *
  84 %************************************************************************
  85
  86 \begin{code}
  87 tcLookupGlobal :: Name -> TcM TyThing
  88 -- c.f. IfaceEnvEnv.tcIfaceGlobal
  89 tcLookupGlobal name
  90   = do  { env <- getGblEnv
  91         ; if nameIsLocalOrFrom (tcg_mod env) name
  92
  93           then  -- It's defined in this module
  94               case lookupNameEnv (tcg_type_env env) name of
  95                 Just thing -> return thing
  96                 Nothing    -> notFound "tcLookupGlobal" name
  97
  98           else do               -- It's imported
  99         { eps <- getEps
 100         ; hpt <- getHpt
 101         ; case lookupType hpt (eps_PTE eps) name of
 102             Just thing -> return thing
 103             Nothing    -> do { traceIf (text "tcLookupGlobal" <+> ppr name)
 104                              ; initIfaceTcRn (tcImportDecl name) }
 105     }}
 106 \end{code}
 107
 108 \begin{code}
 109 tcLookupGlobalId :: Name -> TcM Id
 110 -- Never used for Haskell-source DataCons, hence no ADataCon case
 111 tcLookupGlobalId name
 112   = tcLookupGlobal name         `thenM` \ thing ->
 113     return (tyThingId thing)
 114
 115 tcLookupDataCon :: Name -> TcM DataCon
 116 tcLookupDataCon con_name
 117   = tcLookupGlobal con_name     `thenM` \ thing ->
 118     return (tyThingDataCon thing)
 119
 120 tcLookupClass :: Name -> TcM Class
 121 tcLookupClass name
 122   = tcLookupGlobal name `thenM` \ thing ->
 123     return (tyThingClass thing)
 124
 125 tcLookupTyCon :: Name -> TcM TyCon
 126 tcLookupTyCon name
 127   = tcLookupGlobal name `thenM` \ thing ->
 128     return (tyThingTyCon thing)
 129 \end{code}
 130
 131 %************************************************************************
 132 %*                                                                      *
 133                 Extending the global environment
 134 %*                                                                      *
 135 %************************************************************************
 136
 137
 138 \begin{code}
 139 tcExtendGlobalEnv :: [TyThing] -> TcM r -> TcM r
 140   -- Given a mixture of Ids, TyCons, Classes, all from the
 141   -- module being compiled, extend the global environment
 142 tcExtendGlobalEnv things thing_inside
 143    = do { env <- getGblEnv
 144         ; let ge'  = extendTypeEnvList (tcg_type_env env) things
 145         ; setGblEnv (env {tcg_type_env = ge'}) thing_inside }
 146
 147 tcExtendGlobalValEnv :: [Id] -> TcM a -> TcM a
 148   -- Same deal as tcExtendGlobalEnv, but for Ids
 149 tcExtendGlobalValEnv ids thing_inside
 150   = tcExtendGlobalEnv [AnId id | id <- ids] thing_inside
 151 \end{code}
 152
 153 A variety of global lookups, when we know what we are looking for.
 154
 155 \begin{code}
 156 getInGlobalScope :: TcM (Name -> Bool)
 157 -- Get all things in the global environment; used for deciding what
 158 -- rules to suck in.  Anything defined in this module (nameIsLocalOrFrom)
 159 -- is certainly in the envt, so we don't bother to look.
 160 getInGlobalScope
 161   = do { mod <- getModule
 162        ; eps <- getEps
 163        ; hpt <- getHpt
 164        ; return (\n -> nameIsLocalOrFrom mod n ||
 165                        isJust (lookupType hpt (eps_PTE eps) n)) }
 166 \end{code}
 167
 168
 169 \begin{code}
 170 tcExtendRecEnv :: [(Name,TyThing)]      -- Global bindings
 171                -> [(Name,TcTyThing)]    -- Local bindings
 172                -> TcM r -> TcM r
 173 -- Extend both local and global environments for the type/class knot tying game
 174 tcExtendRecEnv gbl_stuff lcl_stuff thing_inside
 175  = do { (gbl_env, lcl_env) <- getEnvs
 176       ; let { ge' = extendNameEnvList (tcg_type_env gbl_env) gbl_stuff
 177             ; le' = extendNameEnvList (tcl_env lcl_env)      lcl_stuff }
 178       ; setEnvs (gbl_env {tcg_type_env = ge'}, lcl_env {tcl_env = le'})
 179                 thing_inside }
 180 \end{code}
 181
 182
 183 %************************************************************************
 184 %*                                                                      *
 185 \subsection{The local environment}
 186 %*                                                                      *
 187 %************************************************************************
 188
 189 \begin{code}
 190 tcLookup :: Name -> TcM TcTyThing
 191 tcLookup name
 192   = getLclEnv           `thenM` \ local_env ->
 193     case lookupNameEnv (tcl_env local_env) name of
 194         Just thing -> returnM thing
 195         Nothing    -> tcLookupGlobal name `thenM` \ thing ->
 196                       returnM (AGlobal thing)
 197
 198 tcLookupTyVar :: Name -> TcM Id
 199 tcLookupTyVar name
 200   = tcLookup name       `thenM` \ thing ->
 201     case thing of
 202         ATyVar tv -> returnM tv
 203         other     -> pprPanic "tcLookupTyVar" (ppr name)
 204
 205 tcLookupId :: Name -> TcM Id
 206 -- Used when we aren't interested in the binding level
 207 -- Never a DataCon. (Why does that matter? see TcExpr.tcId)
 208 tcLookupId name
 209   = tcLookup name       `thenM` \ thing ->
 210     case thing of
 211         ATcId tc_id _ _   -> returnM tc_id
 212         AGlobal (AnId id) -> returnM id
 213         other             -> pprPanic "tcLookupId" (ppr name)
 214
 215 tcLookupLocalIds :: [Name] -> TcM [TcId]
 216 -- We expect the variables to all be bound, and all at
 217 -- the same level as the lookup.  Only used in one place...
 218 tcLookupLocalIds ns
 219   = getLclEnv           `thenM` \ env ->
 220     returnM (map (lookup (tcl_env env) (thLevel (tcl_th_ctxt env))) ns)
 221   where
 222     lookup lenv lvl name
 223         = case lookupNameEnv lenv name of
 224                 Just (ATcId id lvl1 _) -> ASSERT( lvl == lvl1 ) id
 225                 other                  -> pprPanic "tcLookupLocalIds" (ppr name)
 226
 227 lclEnvElts :: TcLclEnv -> [TcTyThing]
 228 lclEnvElts env = nameEnvElts (tcl_env env)
 229
 230 getInLocalScope :: TcM (Name -> Bool)
 231   -- Ids only
 232 getInLocalScope = getLclEnv     `thenM` \ env ->
 233                   let
 234                         lcl_env = tcl_env env
 235                   in
 236                   return (`elemNameEnv` lcl_env)
 237 \end{code}
 238
 239 \begin{code}
 240 tcExtendTyVarKindEnv :: [HsTyVarBndr Name] -> TcM r -> TcM r
 241 -- The tyvars are all kinded
 242 tcExtendTyVarKindEnv tvs thing_inside
 243   = updLclEnv upd thing_inside
 244   where
 245     upd lcl_env = lcl_env { tcl_env = extend (tcl_env lcl_env) }
 246     extend env  = extendNameEnvList env [(n, ATyVar (mkTyVar n k))
 247                                         | KindedTyVar n k <- tvs]
 248         -- No need to extend global tyvars for kind checking
 249
 250 tcExtendTyVarEnv :: [TyVar] -> TcM r -> TcM r
 251 tcExtendTyVarEnv tvs thing_inside
 252   = tc_extend_tv_env [(getName tv, ATyVar tv) | tv <- tvs] tvs thing_inside
 253
 254 tcExtendTyVarEnv2 :: [(TyVar,TcTyVar)] -> TcM r -> TcM r
 255 tcExtendTyVarEnv2 tv_pairs thing_inside
 256   = tc_extend_tv_env [(getName tv1, ATyVar tv2) | (tv1,tv2) <- tv_pairs]
 257                      [tv | (_,tv) <- tv_pairs]
 258                      thing_inside
 259
 260 tc_extend_tv_env binds tyvars thing_inside
 261   = getLclEnv      `thenM` \ env@(TcLclEnv {tcl_env = le, tcl_tyvars = gtvs}) ->
 262     let
 263         le'        = extendNameEnvList le binds
 264         new_tv_set = mkVarSet tyvars
 265     in
 266         -- It's important to add the in-scope tyvars to the global tyvar set
 267         -- as well.  Consider
 268         --      f (_::r) = let g y = y::r in ...
 269         -- Here, g mustn't be generalised.  This is also important during
 270         -- class and instance decls, when we mustn't generalise the class tyvars
 271         -- when typechecking the methods.
 272     tc_extend_gtvs gtvs new_tv_set              `thenM` \ gtvs' ->
 273     setLclEnv (env {tcl_env = le', tcl_tyvars = gtvs'}) thing_inside
 274 \end{code}
 275
 276
 277 \begin{code}
 278 tcExtendLocalValEnv :: [TcId] -> TcM a -> TcM a
 279 tcExtendLocalValEnv ids thing_inside
 280   = getLclEnv           `thenM` \ env ->
 281     let
 282         extra_global_tyvars = tyVarsOfTypes [idType id | id <- ids]
 283         th_lvl              = thLevel (tcl_th_ctxt env)
 284         proc_lvl            = proc_level (tcl_arrow_ctxt env)
 285         extra_env           = [(idName id, ATcId id th_lvl proc_lvl) | id <- ids]
 286         le'                 = extendNameEnvList (tcl_env env) extra_env
 287     in
 288     tc_extend_gtvs (tcl_tyvars env) extra_global_tyvars `thenM` \ gtvs' ->
 289     setLclEnv (env {tcl_env = le', tcl_tyvars = gtvs'}) thing_inside
 290
 291 tcExtendLocalValEnv2 :: [(Name,TcId)] -> TcM a -> TcM a
 292 tcExtendLocalValEnv2 names_w_ids thing_inside
 293   = getLclEnv           `thenM` \ env ->
 294     let
 295         extra_global_tyvars = tyVarsOfTypes [idType id | (name,id) <- names_w_ids]
 296         th_lvl              = thLevel    (tcl_th_ctxt   env)
 297         proc_lvl            = proc_level (tcl_arrow_ctxt env)
 298         extra_env           = [(name, ATcId id th_lvl proc_lvl) | (name,id) <- names_w_ids]
 299         le'                 = extendNameEnvList (tcl_env env) extra_env
 300     in
 301     tc_extend_gtvs (tcl_tyvars env) extra_global_tyvars `thenM` \ gtvs' ->
 302     setLclEnv (env {tcl_env = le', tcl_tyvars = gtvs'}) thing_inside
 303 \end{code}
 304
 305
 306 \begin{code}
 307 -----------------------
 308 -- findGlobals looks at the value environment and finds values
 309 -- whose types mention the offending type variable.  It has to be
 310 -- careful to zonk the Id's type first, so it has to be in the monad.
 311 -- We must be careful to pass it a zonked type variable, too.
 312
 313 findGlobals :: TcTyVarSet
 314             -> TidyEnv
 315             -> TcM (TidyEnv, [SDoc])
 316
 317 findGlobals tvs tidy_env
 318   = getLclEnv           `thenM` \ lcl_env ->
 319     go tidy_env [] (lclEnvElts lcl_env)
 320   where
 321     go tidy_env acc [] = returnM (tidy_env, acc)
 322     go tidy_env acc (thing : things)
 323       = find_thing ignore_it tidy_env thing     `thenM` \ (tidy_env1, maybe_doc) ->
 324         case maybe_doc of
 325           Just d  -> go tidy_env1 (d:acc) things
 326           Nothing -> go tidy_env1 acc     things
 327
 328     ignore_it ty = not (tvs `intersectsVarSet` tyVarsOfType ty)
 329
 330 -----------------------
 331 find_thing ignore_it tidy_env (ATcId id _ _)
 332   = zonkTcType  (idType id)     `thenM` \ id_ty ->
 333     if ignore_it id_ty then
 334         returnM (tidy_env, Nothing)
 335     else let
 336         (tidy_env', tidy_ty) = tidyOpenType tidy_env id_ty
 337         msg = sep [ppr id <+> dcolon <+> ppr tidy_ty,
 338                    nest 2 (parens (ptext SLIT("bound at") <+>
 339                                    ppr (getSrcLoc id)))]
 340     in
 341     returnM (tidy_env', Just msg)
 342
 343 find_thing ignore_it tidy_env (ATyVar tv)
 344   = zonkTcTyVar tv              `thenM` \ tv_ty ->
 345     if ignore_it tv_ty then
 346         returnM (tidy_env, Nothing)
 347     else let
 348         (tidy_env1, tv1)     = tidyOpenTyVar tidy_env  tv
 349         (tidy_env2, tidy_ty) = tidyOpenType  tidy_env1 tv_ty
 350         msg = sep [ppr tv1 <+> eq_stuff, nest 2 bound_at]
 351
 352         eq_stuff | Just tv' <- Type.getTyVar_maybe tv_ty,
 353                    tv == tv' = empty
 354                  | otherwise = equals <+> ppr tidy_ty
 355                 -- It's ok to use Type.getTyVar_maybe because ty is zonked by now
 356
 357         bound_at = tyVarBindingInfo tv
 358     in
 359     returnM (tidy_env2, Just msg)
 360 \end{code}
 361
 362
 363 %************************************************************************
 364 %*                                                                      *
 365 \subsection{The global tyvars}
 366 %*                                                                      *
 367 %************************************************************************
 368
 369 \begin{code}
 370 tc_extend_gtvs gtvs extra_global_tvs
 371   = readMutVar gtvs             `thenM` \ global_tvs ->
 372     newMutVar (global_tvs `unionVarSet` extra_global_tvs)
 373 \end{code}
 374
 375 @tcGetGlobalTyVars@ returns a fully-zonked set of tyvars free in the environment.
 376 To improve subsequent calls to the same function it writes the zonked set back into
 377 the environment.
 378
 379 \begin{code}
 380 tcGetGlobalTyVars :: TcM TcTyVarSet
 381 tcGetGlobalTyVars
 382   = getLclEnv                                   `thenM` \ (TcLclEnv {tcl_tyvars = gtv_var}) ->
 383     readMutVar gtv_var                          `thenM` \ gbl_tvs ->
 384     zonkTcTyVarsAndFV (varSetElems gbl_tvs)     `thenM` \ gbl_tvs' ->
 385     writeMutVar gtv_var gbl_tvs'                `thenM_`
 386     returnM gbl_tvs'
 387 \end{code}
 388
 389
 390 %************************************************************************
 391 %*                                                                      *
 392 \subsection{Rules}
 393 %*                                                                      *
 394 %************************************************************************
 395
 396 \begin{code}
 397 tcExtendRules :: [RuleDecl Id] -> TcM a -> TcM a
 398         -- Just pop the new rules into the EPS and envt resp
 399         -- All the rules come from an interface file, not soruce
 400         -- Nevertheless, some may be for this module, if we read
 401         -- its interface instead of its source code
 402 tcExtendRules lcl_rules thing_inside
 403  = do { env <- getGblEnv
 404       ; let
 405           env' = env { tcg_rules = lcl_rules ++ tcg_rules env }
 406       ; setGblEnv env' thing_inside }
 407 \end{code}
 408
 409
 410 %************************************************************************
 411 %*                                                                      *
 412                 Arrow notation proc levels
 413 %*                                                                      *
 414 %************************************************************************
 415
 416 \begin{code}
 417 checkProcLevel :: TcId -> ProcLevel -> TcM ()
 418 checkProcLevel id id_lvl
 419   = do  { banned <- getBannedProcLevels
 420         ; checkTc (not (id_lvl `elem` banned))
 421                   (procLevelErr id id_lvl) }
 422
 423 procLevelErr id id_lvl
 424   = hang (ptext SLIT("Command-bound variable") <+> quotes (ppr id) <+> ptext SLIT("is not in scope here"))
 425          4 (ptext SLIT("Reason: it is used in the left argument of (-<)"))
 426 \end{code}
 427
 428
 429 %************************************************************************
 430 %*                                                                      *
 431                 Meta level
 432 %*                                                                      *
 433 %************************************************************************
 434
 435 \begin{code}
 436 instance Outputable ThStage where
 437    ppr Comp          = text "Comp"
 438    ppr (Brack l _ _) = text "Brack" <+> int l
 439    ppr (Splice l)    = text "Splice" <+> int l
 440
 441
 442 thLevel :: ThStage -> ThLevel
 443 thLevel Comp          = topLevel
 444 thLevel (Splice l)    = l
 445 thLevel (Brack l _ _) = l
 446
 447
 448 checkWellStaged :: SDoc         -- What the stage check is for
 449                 -> ThLevel      -- Binding level
 450                 -> ThStage      -- Use stage
 451                 -> TcM ()       -- Fail if badly staged, adding an error
 452 checkWellStaged pp_thing bind_lvl use_stage
 453   | bind_lvl <= use_lvl         -- OK!
 454   = returnM ()
 455
 456   | bind_lvl == topLevel        -- GHC restriction on top level splices
 457   = failWithTc $
 458     sep [ptext SLIT("GHC stage restriction:") <+>  pp_thing,
 459          nest 2 (ptext SLIT("is used in a top-level splice, and must be imported, not defined locally"))]
 460
 461   | otherwise                   -- Badly staged
 462   = failWithTc $
 463     ptext SLIT("Stage error:") <+> pp_thing <+>
 464         hsep   [ptext SLIT("is bound at stage") <+> ppr bind_lvl,
 465                 ptext SLIT("but used at stage") <+> ppr use_lvl]
 466   where
 467     use_lvl = thLevel use_stage
 468
 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 = topLevel
 481             | otherwise    = impLevel
 482
 483 -- Indicates the legal transitions on bracket( [| |] ).
 484 bracketOK :: ThStage -> Maybe ThLevel
 485 bracketOK (Brack _ _ _) = Nothing       -- Bracket illegal inside a bracket
 486 bracketOK stage         = (Just (thLevel stage + 1))
 487
 488 -- Indicates the legal transitions on splice($).
 489 spliceOK :: ThStage -> Maybe ThLevel
 490 spliceOK (Splice _) = Nothing   -- Splice illegal inside splice
 491 spliceOK stage      = Just (thLevel stage - 1)
 492
 493 tcMetaTy :: Name -> TcM Type
 494 -- Given the name of a Template Haskell data type,
 495 -- return the type
 496 -- E.g. given the name "Expr" return the type "Expr"
 497 tcMetaTy tc_name
 498   = tcLookupTyCon tc_name       `thenM` \ t ->
 499     returnM (mkGenTyConApp t [])
 500         -- Use mkGenTyConApp because it might be a synonym
 501 \end{code}
 502
 503
 504 %************************************************************************
 505 %*                                                                      *
 506 \subsection{Making new Ids}
 507 %*                                                                      *
 508 %************************************************************************
 509
 510 Constructing new Ids
 511
 512 \begin{code}
 513 newLocalName :: Name -> TcM Name
 514 newLocalName name       -- Make a clone
 515   = newUnique           `thenM` \ uniq ->
 516     returnM (mkInternalName uniq (getOccName name) (getSrcLoc name))
 517 \end{code}
 518
 519 Make a name for the dict fun for an instance decl.  It's a *local*
 520 name for the moment.  The CoreTidy pass will externalise it.  Even in
 521 --make and ghci stuff, we rebuild the instance environment each time,
 522 so the dfun id is internal to begin with, and external when compiling
 523 other modules
 524
 525 \begin{code}
 526 newDFunName :: Class -> [Type] -> SrcLoc -> TcM Name
 527 newDFunName clas (ty:_) loc
 528   = newUnique                   `thenM` \ uniq ->
 529     returnM (mkInternalName uniq (mkDFunOcc dfun_string) loc)
 530   where
 531         -- Any string that is somewhat unique will do
 532     dfun_string = occNameString (getOccName clas) ++ occNameString (getDFunTyKey ty)
 533
 534 newDFunName clas [] loc = pprPanic "newDFunName" (ppr clas <+> ppr loc)
 535 \end{code}
 536
 537
 538 %************************************************************************
 539 %*                                                                      *
 540 \subsection{The InstInfo type}
 541 %*                                                                      *
 542 %************************************************************************
 543
 544 The InstInfo type summarises the information in an instance declaration
 545
 546     instance c => k (t tvs) where b
 547
 548 It is used just for *local* instance decls (not ones from interface files).
 549 But local instance decls includes
 550         - derived ones
 551         - generic ones
 552 as well as explicit user written ones.
 553
 554 \begin{code}
 555 data InstInfo
 556   = InstInfo {
 557       iDFunId :: DFunId,                -- The dfun id
 558       iBinds  :: InstBindings
 559     }
 560
 561 data InstBindings
 562   = VanillaInst                 -- The normal case
 563         RenamedMonoBinds        -- Bindings
 564         [RenamedSig]            -- User pragmas recorded for generating
 565                                 -- specialised instances
 566
 567   | NewTypeDerived              -- Used for deriving instances of newtypes, where the
 568         [Type]                  -- witness dictionary is identical to the argument
 569                                 -- dictionary.  Hence no bindings, no pragmas
 570         -- The [Type] are the representation types
 571         -- See notes in TcDeriv
 572
 573 pprInstInfo info = vcat [ptext SLIT("InstInfo:") <+> ppr (idType (iDFunId info))]
 574
 575 pprInstInfoDetails (InstInfo { iBinds = VanillaInst b _ }) = ppr b
 576 pprInstInfoDetails (InstInfo { iBinds = NewTypeDerived _}) = text "Derived from the representation type"
 577
 578 simpleInstInfoTy :: InstInfo -> Type
 579 simpleInstInfoTy info = case tcSplitDFunTy (idType (iDFunId info)) of
 580                           (_, _, _, [ty]) -> ty
 581
 582 simpleInstInfoTyCon :: InstInfo -> TyCon
 583   -- Gets the type constructor for a simple instance declaration,
 584   -- i.e. one of the form       instance (...) => C (T a b c) where ...
 585 simpleInstInfoTyCon inst = tcTyConAppTyCon (simpleInstInfoTy inst)
 586 \end{code}
 587
 588
 589 %************************************************************************
 590 %*                                                                      *
 591 \subsection{Errors}
 592 %*                                                                      *
 593 %************************************************************************
 594
 595 \begin{code}
 596 notFound wheRe name = failWithTc (text wheRe <> colon <+> quotes (ppr name) <+>
 597                                   ptext SLIT("is not in scope"))
 598 \end{code}