ghc/compiler/typecheck/TcEnv.lhs

   1 \begin{code}
   2 module TcEnv(
   3         TyThing(..), TyThingDetails(..), TcTyThing(..), TcId,
   4
   5         -- Instance environment, and InstInfo type
   6         tcGetInstEnv, tcSetInstEnv,
   7         InstInfo(..), pprInstInfo, pprInstInfoDetails,
   8         simpleInstInfoTy, simpleInstInfoTyCon,
   9         InstBindings(..),
  10
  11         -- Global environment
  12         tcExtendGlobalEnv,
  13         tcExtendGlobalValEnv,
  14         tcExtendGlobalTypeEnv,
  15         tcLookupTyCon, tcLookupClass, tcLookupDataCon,
  16         tcLookupGlobal_maybe, tcLookupGlobal, tcLookupGlobalId,
  17         getInGlobalScope,
  18
  19         -- Local environment
  20         tcExtendKindEnv,
  21         tcExtendTyVarEnv,    tcExtendTyVarEnv2,
  22         tcExtendLocalValEnv, tcExtendLocalValEnv2,
  23         tcLookup, tcLookupLocalIds, tcLookup_maybe,
  24         tcLookupId, tcLookupIdLvl,
  25         getLclEnvElts, getInLocalScope,
  26
  27         -- Instance environment
  28         tcExtendLocalInstEnv, tcExtendInstEnv,
  29
  30         -- Rules
  31         tcExtendRules,
  32
  33         -- Global type variables
  34         tcGetGlobalTyVars,
  35
  36         -- Random useful things
  37         RecTcGblEnv, tcLookupRecId_maybe,
  38
  39         -- Template Haskell stuff
  40         wellStaged, spliceOK, bracketOK, tcMetaTy, metaLevel,
  41
  42         -- New Ids
  43         newLocalName, newDFunName,
  44
  45         -- Misc
  46         isLocalThing
  47   ) where
  48
  49 #include "HsVersions.h"
  50
  51 import RnHsSyn          ( RenamedMonoBinds, RenamedSig )
  52 import HsSyn            ( RuleDecl(..), ifaceRuleDeclName )
  53 import TcRnMonad
  54 import TcMType          ( zonkTcTyVarsAndFV )
  55 import TcType           ( Type, ThetaType, TcKind, TcTyVar, TcTyVarSet,
  56                           tyVarsOfTypes, tcSplitDFunTy, mkGenTyConApp,
  57                           getDFunTyKey, tcTyConAppTyCon,
  58                         )
  59 import Rules            ( extendRuleBase )
  60 import Id               ( idName, isDataConWrapId_maybe )
  61 import Var              ( TyVar, Id, idType )
  62 import VarSet
  63 import CoreSyn          ( IdCoreRule )
  64 import DataCon          ( DataCon )
  65 import TyCon            ( TyCon, DataConDetails )
  66 import Class            ( Class, ClassOpItem )
  67 import Name             ( Name, NamedThing(..),
  68                           getSrcLoc, mkInternalName, nameIsLocalOrFrom
  69                         )
  70 import NameEnv
  71 import OccName          ( mkDFunOcc, occNameString )
  72 import HscTypes         ( DFunId, TypeEnv, extendTypeEnvList,
  73                           TyThing(..), ExternalPackageState(..) )
  74 import Rules            ( RuleBase )
  75 import BasicTypes       ( EP )
  76 import Module           ( Module )
  77 import InstEnv          ( InstEnv, extendInstEnv )
  78 import Maybes           ( seqMaybe )
  79 import SrcLoc           ( SrcLoc )
  80 import Outputable
  81 import Maybe            ( isJust )
  82 import List             ( partition )
  83 \end{code}
  84
  85
  86 %************************************************************************
  87 %*                                                                      *
  88                 Meta level
  89 %*                                                                      *
  90 %************************************************************************
  91
  92 \begin{code}
  93 instance Outputable Stage where
  94    ppr Comp          = text "Comp"
  95    ppr (Brack l _ _) = text "Brack" <+> int l
  96    ppr (Splice l)    = text "Splice" <+> int l
  97
  98
  99 metaLevel :: Stage -> Level
 100 metaLevel Comp          = topLevel
 101 metaLevel (Splice l)    = l
 102 metaLevel (Brack l _ _) = l
 103
 104 wellStaged :: Level     -- Binding level
 105            -> Level     -- Use level
 106            -> Bool
 107 wellStaged bind_stage use_stage
 108   = bind_stage <= use_stage
 109
 110 -- Indicates the legal transitions on bracket( [| |] ).
 111 bracketOK :: Stage -> Maybe Level
 112 bracketOK (Brack _ _ _) = Nothing       -- Bracket illegal inside a bracket
 113 bracketOK stage         = (Just (metaLevel stage + 1))
 114
 115 -- Indicates the legal transitions on splice($).
 116 spliceOK :: Stage -> Maybe Level
 117 spliceOK (Splice _) = Nothing   -- Splice illegal inside splice
 118 spliceOK stage      = Just (metaLevel stage - 1)
 119
 120 tcMetaTy :: Name -> TcM Type
 121 -- Given the name of a Template Haskell data type,
 122 -- return the type
 123 -- E.g. given the name "Expr" return the type "Expr"
 124 tcMetaTy tc_name
 125   = tcLookupTyCon tc_name       `thenM` \ t ->
 126     returnM (mkGenTyConApp t [])
 127         -- Use mkGenTyConApp because it might be a synonym
 128 \end{code}
 129
 130
 131 %************************************************************************
 132 %*                                                                      *
 133 \subsection{TyThingDetails}
 134 %*                                                                      *
 135 %************************************************************************
 136
 137 This data type is used to help tie the knot
 138  when type checking type and class declarations
 139
 140 \begin{code}
 141 data TyThingDetails = SynTyDetails  Type
 142                     | DataTyDetails ThetaType (DataConDetails DataCon) [Id] (Maybe (EP Id))
 143                     | ClassDetails  ThetaType [Id] [ClassOpItem] DataCon Name
 144                                 -- The Name is the Name of the implicit TyCon for the class
 145                     | ForeignTyDetails  -- Nothing yet
 146 \end{code}
 147
 148
 149 %************************************************************************
 150 %*                                                                      *
 151 \subsection{Basic lookups}
 152 %*                                                                      *
 153 %************************************************************************
 154
 155 \begin{code}
 156 type RecTcGblEnv = TcGblEnv
 157 -- This environment is used for getting the 'right' IdInfo
 158 -- on imported things and for looking up Ids in unfoldings
 159 -- The environment doesn't have any local Ids in it
 160
 161 tcLookupRecId_maybe :: RecTcGblEnv -> Name -> Maybe Id
 162 tcLookupRecId_maybe env name = case lookup_global env name of
 163                                    Just (AnId id) -> Just id
 164                                    other          -> Nothing
 165 \end{code}
 166
 167 %************************************************************************
 168 %*                                                                      *
 169 \subsection{Making new Ids}
 170 %*                                                                      *
 171 %************************************************************************
 172
 173 Constructing new Ids
 174
 175 \begin{code}
 176 newLocalName :: Name -> TcM Name
 177 newLocalName name       -- Make a clone
 178   = newUnique           `thenM` \ uniq ->
 179     returnM (mkInternalName uniq (getOccName name) (getSrcLoc name))
 180 \end{code}
 181
 182 Make a name for the dict fun for an instance decl.
 183 It's a *local* name for the moment.  The CoreTidy pass
 184 will externalise it.
 185
 186 \begin{code}
 187 newDFunName :: Class -> [Type] -> SrcLoc -> TcM Name
 188 newDFunName clas (ty:_) loc
 189   = newUnique                   `thenM` \ uniq ->
 190     returnM (mkInternalName uniq (mkDFunOcc dfun_string) loc)
 191   where
 192         -- Any string that is somewhat unique will do
 193     dfun_string = occNameString (getOccName clas) ++ occNameString (getDFunTyKey ty)
 194
 195 newDFunName clas [] loc = pprPanic "newDFunName" (ppr clas <+> ppr loc)
 196 \end{code}
 197
 198 \begin{code}
 199 isLocalThing :: NamedThing a => Module -> a -> Bool
 200 isLocalThing mod thing = nameIsLocalOrFrom mod (getName thing)
 201 \end{code}
 202
 203 %************************************************************************
 204 %*                                                                      *
 205 \subsection{The global environment}
 206 %*                                                                      *
 207 %************************************************************************
 208
 209 \begin{code}
 210 tcExtendGlobalEnv :: [TyThing] -> TcM r -> TcM r
 211   -- Given a mixture of Ids, TyCons, Classes, perhaps from the
 212   -- module being compiled, perhaps from a package module,
 213   -- extend the global environment, and update the EPS
 214 tcExtendGlobalEnv things thing_inside
 215    = do { eps <- getEps
 216         ; hpt <- getHpt
 217         ; env <- getGblEnv
 218         ; let mod = tcg_mod env
 219               (lcl_things, pkg_things) = partition (isLocalThing mod) things
 220               ge'  = extendTypeEnvList (tcg_type_env env) lcl_things
 221               eps' = eps { eps_PTE = extendTypeEnvList (eps_PTE eps) pkg_things }
 222               ist' = mkImpTypeEnv eps' hpt
 223         ; setEps eps'
 224         ; setGblEnv (env {tcg_type_env = ge', tcg_ist = ist'}) thing_inside }
 225
 226 tcExtendGlobalValEnv :: [Id] -> TcM a -> TcM a
 227   -- Same deal as tcExtendGlobalEnv, but for Ids
 228 tcExtendGlobalValEnv ids thing_inside
 229   = tcExtendGlobalEnv [AnId id | id <- ids] thing_inside
 230
 231 tcExtendGlobalTypeEnv :: TypeEnv -> TcM r -> TcM r
 232   -- Top-level things of the interactive context
 233   -- No need to extend the package env
 234 tcExtendGlobalTypeEnv extra_env thing_inside
 235  = do { env <- getGblEnv
 236       ; let ge' = tcg_type_env env `plusNameEnv` extra_env
 237       ; setGblEnv (env {tcg_type_env = ge'}) thing_inside }
 238 \end{code}
 239
 240
 241 \begin{code}
 242 lookup_global :: TcGblEnv -> Name -> Maybe TyThing
 243         -- Try the global envt and then the global symbol table
 244 lookup_global env name
 245   = lookupNameEnv (tcg_type_env env) name
 246         `seqMaybe`
 247     tcg_ist env name
 248
 249 tcLookupGlobal_maybe :: Name -> TcRn m (Maybe TyThing)
 250 tcLookupGlobal_maybe name
 251   = getGblEnv           `thenM` \ env ->
 252     returnM (lookup_global env name)
 253 \end{code}
 254
 255 A variety of global lookups, when we know what we are looking for.
 256
 257 \begin{code}
 258 tcLookupGlobal :: Name -> TcM TyThing
 259 tcLookupGlobal name
 260   = tcLookupGlobal_maybe name   `thenM` \ maybe_thing ->
 261     case maybe_thing of
 262         Just thing -> returnM thing
 263         other      -> notFound "tcLookupGlobal" name
 264
 265 tcLookupGlobalId :: Name -> TcM Id
 266 tcLookupGlobalId name
 267   = tcLookupGlobal_maybe name   `thenM` \ maybe_thing ->
 268     case maybe_thing of
 269         Just (AnId id) -> returnM id
 270         other          -> notFound "tcLookupGlobal" name
 271
 272 tcLookupDataCon :: Name -> TcM DataCon
 273 tcLookupDataCon con_name
 274   = tcLookupGlobalId con_name   `thenM` \ con_id ->
 275     case isDataConWrapId_maybe con_id of
 276         Just data_con -> returnM data_con
 277         Nothing       -> failWithTc (badCon con_id)
 278
 279 tcLookupClass :: Name -> TcM Class
 280 tcLookupClass name
 281   = tcLookupGlobal_maybe name   `thenM` \ maybe_clas ->
 282     case maybe_clas of
 283         Just (AClass clas) -> returnM clas
 284         other              -> notFound "tcLookupClass" name
 285
 286 tcLookupTyCon :: Name -> TcM TyCon
 287 tcLookupTyCon name
 288   = tcLookupGlobal_maybe name   `thenM` \ maybe_tc ->
 289     case maybe_tc of
 290         Just (ATyCon tc) -> returnM tc
 291         other            -> notFound "tcLookupTyCon" name
 292
 293
 294 getInGlobalScope :: TcRn m (Name -> Bool)
 295 getInGlobalScope = do { gbl_env <- getGblEnv ;
 296                         return (\n -> isJust (lookup_global gbl_env n)) }
 297 \end{code}
 298
 299
 300 %************************************************************************
 301 %*                                                                      *
 302 \subsection{The local environment}
 303 %*                                                                      *
 304 %************************************************************************
 305
 306 \begin{code}
 307 tcLookup_maybe :: Name -> TcM (Maybe TcTyThing)
 308 tcLookup_maybe name
 309   = getLclEnv           `thenM` \ local_env ->
 310     case lookupNameEnv (tcl_env local_env) name of
 311         Just thing -> returnM (Just thing)
 312         Nothing    -> tcLookupGlobal_maybe name `thenM` \ mb_res ->
 313                       returnM (case mb_res of
 314                                  Just thing -> Just (AGlobal thing)
 315                                  Nothing    -> Nothing)
 316
 317 tcLookup :: Name -> TcM TcTyThing
 318 tcLookup name
 319   = tcLookup_maybe name         `thenM` \ maybe_thing ->
 320     case maybe_thing of
 321         Just thing -> returnM thing
 322         other      -> notFound "tcLookup" name
 323         -- Extract the IdInfo from an IfaceSig imported from an interface file
 324
 325 tcLookupId :: Name -> TcM Id
 326 -- Used when we aren't interested in the binding level
 327 tcLookupId name
 328   = tcLookup name       `thenM` \ thing ->
 329     case thing of
 330         ATcId tc_id lvl   -> returnM tc_id
 331         AGlobal (AnId id) -> returnM id
 332         other             -> pprPanic "tcLookupId" (ppr name)
 333
 334 tcLookupIdLvl :: Name -> TcM (Id, Level)
 335 tcLookupIdLvl name
 336   = tcLookup name       `thenM` \ thing ->
 337     case thing of
 338         ATcId tc_id lvl   -> returnM (tc_id, lvl)
 339         AGlobal (AnId id) -> returnM (id, impLevel)
 340         other             -> pprPanic "tcLookupIdLvl" (ppr name)
 341
 342 tcLookupLocalIds :: [Name] -> TcM [TcId]
 343 -- We expect the variables to all be bound, and all at
 344 -- the same level as the lookup.  Only used in one place...
 345 tcLookupLocalIds ns
 346   = getLclEnv           `thenM` \ env ->
 347     returnM (map (lookup (tcl_env env) (metaLevel (tcl_level env))) ns)
 348   where
 349     lookup lenv lvl name
 350         = case lookupNameEnv lenv name of
 351                 Just (ATcId id lvl1) -> ASSERT( lvl == lvl1 ) id
 352                 other                -> pprPanic "tcLookupLocalIds" (ppr name)
 353
 354 getLclEnvElts :: TcM [TcTyThing]
 355 getLclEnvElts = getLclEnv       `thenM` \ env ->
 356                 return (nameEnvElts (tcl_env env))
 357
 358 getInLocalScope :: TcM (Name -> Bool)
 359   -- Ids only
 360 getInLocalScope = getLclEnv     `thenM` \ env ->
 361                   let
 362                         lcl_env = tcl_env env
 363                   in
 364                   return (`elemNameEnv` lcl_env)
 365 \end{code}
 366
 367 \begin{code}
 368 tcExtendKindEnv :: [(Name,TcKind)] -> TcM r -> TcM r
 369 tcExtendKindEnv pairs thing_inside
 370   = updLclEnv upd thing_inside
 371   where
 372     upd lcl_env = lcl_env { tcl_env = extend (tcl_env lcl_env) }
 373     extend env = extendNameEnvList env [(n, AThing k) | (n,k) <- pairs]
 374         -- No need to extend global tyvars for kind checking
 375
 376 tcExtendTyVarEnv :: [TyVar] -> TcM r -> TcM r
 377 tcExtendTyVarEnv tvs thing_inside
 378   = tc_extend_tv_env [(getName tv, ATyVar tv) | tv <- tvs] tvs thing_inside
 379
 380 tcExtendTyVarEnv2 :: [(TyVar,TcTyVar)] -> TcM r -> TcM r
 381 tcExtendTyVarEnv2 tv_pairs thing_inside
 382   = tc_extend_tv_env [(getName tv1, ATyVar tv2) | (tv1,tv2) <- tv_pairs]
 383                      [tv | (_,tv) <- tv_pairs]
 384                      thing_inside
 385
 386 tc_extend_tv_env binds tyvars thing_inside
 387   = getLclEnv      `thenM` \ env@(TcLclEnv {tcl_env = le, tcl_tyvars = gtvs}) ->
 388     let
 389         le'        = extendNameEnvList le binds
 390         new_tv_set = mkVarSet tyvars
 391     in
 392         -- It's important to add the in-scope tyvars to the global tyvar set
 393         -- as well.  Consider
 394         --      f (x::r) = let g y = y::r in ...
 395         -- Here, g mustn't be generalised.  This is also important during
 396         -- class and instance decls, when we mustn't generalise the class tyvars
 397         -- when typechecking the methods.
 398     tc_extend_gtvs gtvs new_tv_set              `thenM` \ gtvs' ->
 399     setLclEnv (env {tcl_env = le', tcl_tyvars = gtvs'}) thing_inside
 400 \end{code}
 401
 402
 403 \begin{code}
 404 tcExtendLocalValEnv :: [TcId] -> TcM a -> TcM a
 405 tcExtendLocalValEnv ids thing_inside
 406   = getLclEnv           `thenM` \ env ->
 407     let
 408         extra_global_tyvars = tyVarsOfTypes [idType id | id <- ids]
 409         lvl                 = metaLevel (tcl_level env)
 410         extra_env           = [(idName id, ATcId id lvl) | id <- ids]
 411         le'                 = extendNameEnvList (tcl_env env) extra_env
 412     in
 413     tc_extend_gtvs (tcl_tyvars env) extra_global_tyvars `thenM` \ gtvs' ->
 414     setLclEnv (env {tcl_env = le', tcl_tyvars = gtvs'}) thing_inside
 415
 416 tcExtendLocalValEnv2 :: [(Name,TcId)] -> TcM a -> TcM a
 417 tcExtendLocalValEnv2 names_w_ids thing_inside
 418   = getLclEnv           `thenM` \ env ->
 419     let
 420         extra_global_tyvars = tyVarsOfTypes [idType id | (name,id) <- names_w_ids]
 421         lvl                 = metaLevel (tcl_level env)
 422         extra_env           = [(name, ATcId id lvl) | (name,id) <- names_w_ids]
 423         le'                 = extendNameEnvList (tcl_env env) extra_env
 424     in
 425     tc_extend_gtvs (tcl_tyvars env) extra_global_tyvars `thenM` \ gtvs' ->
 426     setLclEnv (env {tcl_env = le', tcl_tyvars = gtvs'}) thing_inside
 427 \end{code}
 428
 429
 430 %************************************************************************
 431 %*                                                                      *
 432 \subsection{The global tyvars}
 433 %*                                                                      *
 434 %************************************************************************
 435
 436 \begin{code}
 437 tc_extend_gtvs gtvs extra_global_tvs
 438   = readMutVar gtvs             `thenM` \ global_tvs ->
 439     newMutVar (global_tvs `unionVarSet` extra_global_tvs)
 440 \end{code}
 441
 442 @tcGetGlobalTyVars@ returns a fully-zonked set of tyvars free in the environment.
 443 To improve subsequent calls to the same function it writes the zonked set back into
 444 the environment.
 445
 446 \begin{code}
 447 tcGetGlobalTyVars :: TcM TcTyVarSet
 448 tcGetGlobalTyVars
 449   = getLclEnv                                   `thenM` \ (TcLclEnv {tcl_tyvars = gtv_var}) ->
 450     readMutVar gtv_var                          `thenM` \ gbl_tvs ->
 451     zonkTcTyVarsAndFV (varSetElems gbl_tvs)     `thenM` \ gbl_tvs' ->
 452     writeMutVar gtv_var gbl_tvs'                `thenM_`
 453     returnM gbl_tvs'
 454 \end{code}
 455
 456
 457 %************************************************************************
 458 %*                                                                      *
 459 \subsection{The instance environment}
 460 %*                                                                      *
 461 %************************************************************************
 462
 463 \begin{code}
 464 tcGetInstEnv :: TcM InstEnv
 465 tcGetInstEnv = getGblEnv        `thenM` \ env ->
 466                returnM (tcg_inst_env env)
 467
 468 tcSetInstEnv :: InstEnv -> TcM a -> TcM a
 469 tcSetInstEnv ie thing_inside
 470   = getGblEnv   `thenM` \ env ->
 471     setGblEnv (env {tcg_inst_env = ie}) thing_inside
 472
 473 tcExtendInstEnv :: [DFunId] -> TcM a -> TcM a
 474         -- Add instances from local or imported
 475         -- instances, and refresh the instance-env cache
 476 tcExtendInstEnv dfuns thing_inside
 477  = do { dflags <- getDOpts
 478       ; eps <- getEps
 479       ; env <- getGblEnv
 480       ; let
 481           -- Extend the total inst-env with the new dfuns
 482           (inst_env', errs) = extendInstEnv dflags (tcg_inst_env env) dfuns
 483
 484           -- Sort the ones from this module from the others
 485           (lcl_dfuns, pkg_dfuns) = partition (isLocalThing mod) dfuns
 486           mod = tcg_mod env
 487
 488           -- And add the pieces to the right places
 489           (eps_inst_env', _) = extendInstEnv dflags (eps_inst_env eps) pkg_dfuns
 490           eps'               = eps { eps_inst_env = eps_inst_env' }
 491
 492           env'  = env { tcg_inst_env = inst_env',
 493                         tcg_insts = lcl_dfuns ++ tcg_insts env }
 494
 495       ; traceDFuns dfuns
 496       ; addErrs errs
 497       ; setEps eps'
 498       ; setGblEnv env' thing_inside }
 499
 500 tcExtendLocalInstEnv :: [InstInfo] -> TcM a -> TcM a
 501   -- Special case for local instance decls
 502 tcExtendLocalInstEnv infos thing_inside
 503  = do { dflags <- getDOpts
 504       ; env <- getGblEnv
 505       ; let
 506           dfuns             = map iDFunId infos
 507           (inst_env', errs) = extendInstEnv dflags (tcg_inst_env env) dfuns
 508           env'              = env { tcg_inst_env = inst_env',
 509                                     tcg_insts = dfuns ++ tcg_insts env }
 510       ; traceDFuns dfuns
 511       ; addErrs errs
 512       ; setGblEnv env' thing_inside }
 513
 514 traceDFuns dfuns
 515   = traceTc (text "Adding instances:" <+> vcat (map pp dfuns))
 516   where
 517     pp dfun   = ppr dfun <+> dcolon <+> ppr (idType dfun)
 518 \end{code}
 519
 520
 521 %************************************************************************
 522 %*                                                                      *
 523 \subsection{Rules}
 524 %*                                                                      *
 525 %************************************************************************
 526
 527 \begin{code}
 528 tcExtendRules :: [RuleDecl Id] -> TcM a -> TcM a
 529         -- Just pop the new rules into the EPS and envt resp
 530         -- All the rules come from an interface file, not soruce
 531         -- Nevertheless, some may be for this module, if we read
 532         -- its interface instead of its source code
 533 tcExtendRules rules thing_inside
 534  = do { eps <- getEps
 535       ; env <- getGblEnv
 536       ; let
 537           (lcl_rules, pkg_rules) = partition is_local_rule rules
 538           is_local_rule = isLocalThing mod . ifaceRuleDeclName
 539           mod = tcg_mod env
 540
 541           core_rules = [(id,rule) | IfaceRuleOut id rule <- pkg_rules]
 542           eps'   = eps { eps_rule_base = addIfaceRules (eps_rule_base eps) core_rules }
 543                   -- All the rules from an interface are of the IfaceRuleOut form
 544
 545           env' = env { tcg_rules = lcl_rules ++ tcg_rules env }
 546
 547       ; setEps eps'
 548       ; setGblEnv env' thing_inside }
 549
 550 addIfaceRules :: RuleBase -> [IdCoreRule] -> RuleBase
 551 addIfaceRules rule_base rules
 552   = foldl extendRuleBase rule_base rules
 553 \end{code}
 554
 555
 556 %************************************************************************
 557 %*                                                                      *
 558 \subsection{The InstInfo type}
 559 %*                                                                      *
 560 %************************************************************************
 561
 562 The InstInfo type summarises the information in an instance declaration
 563
 564     instance c => k (t tvs) where b
 565
 566 It is used just for *local* instance decls (not ones from interface files).
 567 But local instance decls includes
 568         - derived ones
 569         - generic ones
 570 as well as explicit user written ones.
 571
 572 \begin{code}
 573 data InstInfo
 574   = InstInfo {
 575       iDFunId :: DFunId,                -- The dfun id
 576       iBinds  :: InstBindings
 577     }
 578
 579 data InstBindings
 580   = VanillaInst                 -- The normal case
 581         RenamedMonoBinds        -- Bindings
 582         [RenamedSig]            -- User pragmas recorded for generating
 583                                 -- specialised instances
 584
 585   | NewTypeDerived              -- Used for deriving instances of newtypes, where the
 586         [Type]                  -- witness dictionary is identical to the argument
 587                                 -- dictionary.  Hence no bindings, no pragmas
 588         -- The [Type] are the representation types
 589         -- See notes in TcDeriv
 590
 591 pprInstInfo info = vcat [ptext SLIT("InstInfo:") <+> ppr (idType (iDFunId info))]
 592
 593 pprInstInfoDetails (InstInfo { iBinds = VanillaInst b _ }) = ppr b
 594 pprInstInfoDetails (InstInfo { iBinds = NewTypeDerived _}) = text "Derived from the representation type"
 595
 596 simpleInstInfoTy :: InstInfo -> Type
 597 simpleInstInfoTy info = case tcSplitDFunTy (idType (iDFunId info)) of
 598                           (_, _, _, [ty]) -> ty
 599
 600 simpleInstInfoTyCon :: InstInfo -> TyCon
 601   -- Gets the type constructor for a simple instance declaration,
 602   -- i.e. one of the form       instance (...) => C (T a b c) where ...
 603 simpleInstInfoTyCon inst = tcTyConAppTyCon (simpleInstInfoTy inst)
 604 \end{code}
 605
 606
 607 %************************************************************************
 608 %*                                                                      *
 609 \subsection{Errors}
 610 %*                                                                      *
 611 %************************************************************************
 612
 613 \begin{code}
 614 badCon con_id = quotes (ppr con_id) <+> ptext SLIT("is not a data constructor")
 615
 616 notFound wheRe name = failWithTc (text wheRe <> colon <+> quotes (ppr name) <+>
 617                                   ptext SLIT("is not in scope"))
 618 \end{code}