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