ghc/compiler/typecheck/TcEnv.lhs

   1 \begin{code}
   2 module TcEnv(
   3         TcId, TcIdSet,
   4         TyThing(..), TyThingDetails(..), TcTyThing(..),
   5
   6         -- Getting stuff from the environment
   7         TcEnv, initTcEnv,
   8         tcEnvTyCons, tcEnvClasses, tcEnvIds, tcEnvTcIds, tcEnvTyVars,
   9         getTcGEnv,
  10
  11         -- Instance environment, and InstInfo type
  12         tcGetInstEnv, tcSetInstEnv,
  13         InstInfo(..), pprInstInfo,
  14         simpleInstInfoTy, simpleInstInfoTyCon,
  15
  16         -- Global environment
  17         tcExtendGlobalEnv, tcExtendGlobalValEnv, tcExtendGlobalTypeEnv,
  18         tcLookupTyCon, tcLookupClass, tcLookupGlobalId, tcLookupDataCon,
  19         tcLookupGlobal_maybe, tcLookupGlobal, tcLookupSyntaxId, tcLookupSyntaxName,
  20
  21         -- Local environment
  22         tcExtendKindEnv,  tcLookupLocalIds, tcInLocalScope,
  23         tcExtendTyVarEnv, tcExtendTyVarEnvForMeths,
  24         tcExtendLocalValEnv, tcLookup, tcLookup_maybe, tcLookupId,
  25
  26         -- Global type variables
  27         tcGetGlobalTyVars, tcExtendGlobalTyVars,
  28
  29         -- Random useful things
  30         RecTcEnv, tcAddImportedIdInfo, tcLookupRecId, tcLookupRecId_maybe,
  31
  32         -- New Ids
  33         newLocalId, newSpecPragmaId,
  34         newDFunName,
  35
  36         -- Misc
  37         isLocalThing, tcSetEnv
  38   ) where
  39
  40 #include "HsVersions.h"
  41
  42 import RnHsSyn          ( RenamedMonoBinds, RenamedSig )
  43 import TcMonad
  44 import TcType           ( TcKind,  TcType, TcTyVar, TcTyVarSet,
  45                           zonkTcTyVarsAndFV
  46                         )
  47 import Id               ( idName, mkSpecPragmaId, mkUserLocal, isDataConWrapId_maybe )
  48 import IdInfo           ( vanillaIdInfo )
  49 import Var              ( TyVar, Id, idType, lazySetIdInfo, idInfo )
  50 import VarSet
  51 import Type             ( Type, ThetaType,
  52                           tyVarsOfTypes, splitDFunTy,
  53                           getDFunTyKey, tyConAppTyCon
  54                         )
  55 import DataCon          ( DataCon )
  56 import TyCon            ( TyCon )
  57 import Class            ( Class, ClassOpItem )
  58 import Name             ( Name, OccName, NamedThing(..),
  59                           nameOccName, getSrcLoc, mkLocalName, isLocalName,
  60                           nameIsLocalOrFrom
  61                         )
  62 import NameEnv          ( NameEnv, lookupNameEnv, nameEnvElts, elemNameEnv,
  63                           extendNameEnvList, emptyNameEnv, plusNameEnv )
  64 import OccName          ( mkDFunOcc, occNameString )
  65 import HscTypes         ( DFunId,
  66                           PackageTypeEnv, TypeEnv,
  67                           extendTypeEnvList, extendTypeEnvWithIds,
  68                           typeEnvTyCons, typeEnvClasses, typeEnvIds,
  69                           HomeSymbolTable
  70                         )
  71 import Module           ( Module )
  72 import InstEnv          ( InstEnv, emptyInstEnv )
  73 import HscTypes         ( lookupType, TyThing(..) )
  74 import Util             ( zipEqual )
  75 import SrcLoc           ( SrcLoc )
  76 import qualified PrelNames
  77 import Outputable
  78
  79 import IOExts           ( newIORef )
  80 \end{code}
  81
  82 %************************************************************************
  83 %*                                                                      *
  84 \subsection{TcEnv}
  85 %*                                                                      *
  86 %************************************************************************
  87
  88 \begin{code}
  89 type TcId    = Id                       -- Type may be a TcType
  90 type TcIdSet = IdSet
  91
  92 data TcEnv
  93   = TcEnv {
  94         tcSyntaxMap :: PrelNames.SyntaxMap,     -- The syntax map (usually the identity)
  95
  96         tcGST    :: Name -> Maybe TyThing,      -- The type environment at the moment we began this compilation
  97
  98         tcInsts  :: InstEnv,            -- All instances (both imported and in this module)
  99
 100         tcGEnv   :: TypeEnv,            -- The global type environment we've accumulated while
 101                  {- NameEnv TyThing-}   -- compiling this module:
 102                                         --      types and classes (both imported and local)
 103                                         --      imported Ids
 104                                         -- (Ids defined in this module start in the local envt,
 105                                         --  though they move to the global envt during zonking)
 106
 107         tcLEnv   :: NameEnv TcTyThing,  -- The local type environment: Ids and TyVars
 108                                         -- defined in this module
 109
 110         tcTyVars :: TcRef TcTyVarSet    -- The "global tyvars"
 111                                         -- Namely, the in-scope TyVars bound in tcLEnv, plus the tyvars
 112                                         -- mentioned in the types of Ids bound in tcLEnv
 113                                         -- Why mutable? see notes with tcGetGlobalTyVars
 114     }
 115
 116 \end{code}
 117
 118 The Global-Env/Local-Env story
 119 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 120 During type checking, we keep in the GlobalEnv
 121         * All types and classes
 122         * All Ids derived from types and classes (constructors, selectors)
 123         * Imported Ids
 124
 125 At the end of type checking, we zonk the local bindings,
 126 and as we do so we add to the GlobalEnv
 127         * Locally defined top-level Ids
 128
 129 Why?  Because they are now Ids not TcIds.  This final GlobalEnv is
 130 used thus:
 131         a) fed back (via the knot) to typechecking the
 132            unfoldings of interface signatures
 133
 134         b) used to augment the GlobalSymbolTable
 135
 136
 137 \begin{code}
 138 data TcTyThing
 139   = AGlobal TyThing     -- Used only in the return type of a lookup
 140   | ATcId  TcId         -- Ids defined in this module
 141   | ATyVar TyVar        -- Type variables
 142   | AThing TcKind       -- Used temporarily, during kind checking
 143 -- Here's an example of how the AThing guy is used
 144 -- Suppose we are checking (forall a. T a Int):
 145 --      1. We first bind (a -> AThink kv), where kv is a kind variable.
 146 --      2. Then we kind-check the (T a Int) part.
 147 --      3. Then we zonk the kind variable.
 148 --      4. Now we know the kind for 'a', and we add (a -> ATyVar a::K) to the environment
 149
 150 initTcEnv :: PrelNames.SyntaxMap -> HomeSymbolTable -> PackageTypeEnv -> IO TcEnv
 151 initTcEnv syntax_map hst pte
 152   = do { gtv_var <- newIORef emptyVarSet ;
 153          return (TcEnv { tcSyntaxMap = syntax_map,
 154                          tcGST    = lookup,
 155                          tcGEnv   = emptyNameEnv,
 156                          tcInsts  = emptyInstEnv,
 157                          tcLEnv   = emptyNameEnv,
 158                          tcTyVars = gtv_var
 159          })}
 160   where
 161     lookup name | isLocalName name = Nothing
 162                 | otherwise        = lookupType hst pte name
 163
 164
 165 tcEnvClasses env = typeEnvClasses (tcGEnv env)
 166 tcEnvTyCons  env = typeEnvTyCons  (tcGEnv env)
 167 tcEnvIds     env = typeEnvIds     (tcGEnv env)
 168 tcEnvTyVars  env = [tv | ATyVar tv <- nameEnvElts (tcLEnv env)]
 169 tcEnvTcIds   env = [id | ATcId  id <- nameEnvElts (tcLEnv env)]
 170
 171 getTcGEnv (TcEnv { tcGEnv = genv }) = genv
 172
 173 tcInLocalScope :: TcEnv -> Name -> Bool
 174 tcInLocalScope env v = v `elemNameEnv` (tcLEnv env)
 175
 176 -- This data type is used to help tie the knot
 177 -- when type checking type and class declarations
 178 data TyThingDetails = SynTyDetails Type
 179                     | DataTyDetails ThetaType [DataCon] [Id]
 180                     | ClassDetails ThetaType [Id] [ClassOpItem] DataCon
 181 \end{code}
 182
 183
 184 %************************************************************************
 185 %*                                                                      *
 186 \subsection{Basic lookups}
 187 %*                                                                      *
 188 %************************************************************************
 189
 190 \begin{code}
 191 lookup_global :: TcEnv -> Name -> Maybe TyThing
 192         -- Try the global envt and then the global symbol table
 193 lookup_global env name
 194   = case lookupNameEnv (tcGEnv env) name of
 195         Just thing -> Just thing
 196         Nothing    -> tcGST env name
 197
 198 lookup_local :: TcEnv -> Name -> Maybe TcTyThing
 199         -- Try the local envt and then try the global
 200 lookup_local env name
 201   = case lookupNameEnv (tcLEnv env) name of
 202         Just thing -> Just thing
 203         Nothing    -> case lookup_global env name of
 204                         Just thing -> Just (AGlobal thing)
 205                         Nothing    -> Nothing
 206 \end{code}
 207
 208 \begin{code}
 209 type RecTcEnv = TcEnv
 210 -- This environment is used for getting the 'right' IdInfo
 211 -- on imported things and for looking up Ids in unfoldings
 212 -- The environment doesn't have any local Ids in it
 213
 214 tcAddImportedIdInfo :: RecTcEnv -> Id -> Id
 215 tcAddImportedIdInfo env id
 216   = id `lazySetIdInfo` new_info
 217         -- The Id must be returned without a data dependency on maybe_id
 218   where
 219     new_info = case tcLookupRecId_maybe env (idName id) of
 220                   Nothing          -> pprTrace "tcAddIdInfo" (ppr id) vanillaIdInfo
 221                   Just imported_id -> idInfo imported_id
 222                 -- ToDo: could check that types are the same
 223
 224 tcLookupRecId_maybe :: RecTcEnv -> Name -> Maybe Id
 225 tcLookupRecId_maybe env name = case lookup_global env name of
 226                                    Just (AnId id) -> Just id
 227                                    other          -> Nothing
 228
 229 tcLookupRecId ::  RecTcEnv -> Name -> Id
 230 tcLookupRecId env name = case lookup_global env name of
 231                                 Just (AnId id) -> id
 232                                 Nothing        -> pprPanic "tcLookupRecId" (ppr name)
 233 \end{code}
 234
 235 %************************************************************************
 236 %*                                                                      *
 237 \subsection{Making new Ids}
 238 %*                                                                      *
 239 %************************************************************************
 240
 241 Constructing new Ids
 242
 243 \begin{code}
 244 newLocalId :: OccName -> TcType -> SrcLoc -> NF_TcM TcId
 245 newLocalId name ty loc
 246   = tcGetUnique         `thenNF_Tc` \ uniq ->
 247     returnNF_Tc (mkUserLocal name uniq ty loc)
 248
 249 newSpecPragmaId :: Name -> TcType -> NF_TcM TcId
 250 newSpecPragmaId name ty
 251   = tcGetUnique         `thenNF_Tc` \ uniq ->
 252     returnNF_Tc (mkSpecPragmaId (nameOccName name) uniq ty (getSrcLoc name))
 253 \end{code}
 254
 255 Make a name for the dict fun for an instance decl.
 256 It's a *local* name for the moment.  The CoreTidy pass
 257 will globalise it.
 258
 259 \begin{code}
 260 newDFunName :: Class -> [Type] -> SrcLoc -> NF_TcM Name
 261 newDFunName clas (ty:_) loc
 262   = tcGetUnique                 `thenNF_Tc` \ uniq ->
 263     returnNF_Tc (mkLocalName uniq (mkDFunOcc dfun_string) loc)
 264   where
 265         -- Any string that is somewhat unique will do
 266     dfun_string = occNameString (getOccName clas) ++ occNameString (getDFunTyKey ty)
 267
 268 newDFunName clas [] loc = pprPanic "newDFunName" (ppr clas <+> ppr loc)
 269 \end{code}
 270
 271 \begin{code}
 272 isLocalThing :: NamedThing a => Module -> a -> Bool
 273 isLocalThing mod thing = nameIsLocalOrFrom mod (getName thing)
 274 \end{code}
 275
 276 %************************************************************************
 277 %*                                                                      *
 278 \subsection{The global environment}
 279 %*                                                                      *
 280 %************************************************************************
 281
 282 \begin{code}
 283 tcExtendGlobalEnv :: [TyThing] -> TcM r -> TcM r
 284 tcExtendGlobalEnv things thing_inside
 285   = tcGetEnv                            `thenNF_Tc` \ env ->
 286     let
 287         ge' = extendTypeEnvList (tcGEnv env) things
 288     in
 289     tcSetEnv (env {tcGEnv = ge'}) thing_inside
 290
 291
 292 tcExtendGlobalTypeEnv :: TypeEnv -> TcM r -> TcM r
 293 tcExtendGlobalTypeEnv extra_env thing_inside
 294   = tcGetEnv                            `thenNF_Tc` \ env ->
 295     let
 296         ge' = tcGEnv env `plusNameEnv` extra_env
 297     in
 298     tcSetEnv (env {tcGEnv = ge'}) thing_inside
 299
 300 tcExtendGlobalValEnv :: [Id] -> TcM a -> TcM a
 301 tcExtendGlobalValEnv ids thing_inside
 302   = tcGetEnv                            `thenNF_Tc` \ env ->
 303     let
 304         ge' = extendTypeEnvWithIds (tcGEnv env) ids
 305     in
 306     tcSetEnv (env {tcGEnv = ge'}) thing_inside
 307 \end{code}
 308
 309
 310 \begin{code}
 311 tcLookupGlobal_maybe :: Name -> NF_TcM (Maybe TyThing)
 312 tcLookupGlobal_maybe name
 313   = tcGetEnv            `thenNF_Tc` \ env ->
 314     returnNF_Tc (lookup_global env name)
 315 \end{code}
 316
 317 A variety of global lookups, when we know what we are looking for.
 318
 319 \begin{code}
 320 tcLookupGlobal :: Name -> NF_TcM TyThing
 321 tcLookupGlobal name
 322   = tcLookupGlobal_maybe name   `thenNF_Tc` \ maybe_thing ->
 323     case maybe_thing of
 324         Just thing -> returnNF_Tc thing
 325         other      -> notFound "tcLookupGlobal" name
 326
 327 tcLookupGlobalId :: Name -> NF_TcM Id
 328 tcLookupGlobalId name
 329   = tcLookupGlobal_maybe name   `thenNF_Tc` \ maybe_id ->
 330     case maybe_id of
 331         Just (AnId id) -> returnNF_Tc id
 332         other          -> notFound "tcLookupGlobalId" name
 333
 334 tcLookupDataCon :: Name -> TcM DataCon
 335 tcLookupDataCon con_name
 336   = tcLookupGlobalId con_name           `thenNF_Tc` \ con_id ->
 337     case isDataConWrapId_maybe con_id of
 338         Just data_con -> returnTc data_con
 339         Nothing       -> failWithTc (badCon con_id)
 340
 341
 342 tcLookupClass :: Name -> NF_TcM Class
 343 tcLookupClass name
 344   = tcLookupGlobal_maybe name   `thenNF_Tc` \ maybe_clas ->
 345     case maybe_clas of
 346         Just (AClass clas) -> returnNF_Tc clas
 347         other              -> notFound "tcLookupClass" name
 348
 349 tcLookupTyCon :: Name -> NF_TcM TyCon
 350 tcLookupTyCon name
 351   = tcLookupGlobal_maybe name   `thenNF_Tc` \ maybe_tc ->
 352     case maybe_tc of
 353         Just (ATyCon tc) -> returnNF_Tc tc
 354         other            -> notFound "tcLookupTyCon" name
 355
 356 tcLookupId :: Name -> NF_TcM Id
 357 tcLookupId name
 358   = tcLookup name       `thenNF_Tc` \ thing ->
 359     case thing of
 360         ATcId tc_id       -> returnNF_Tc tc_id
 361         AGlobal (AnId id) -> returnNF_Tc id
 362         other             -> pprPanic "tcLookupId" (ppr name)
 363
 364 tcLookupLocalIds :: [Name] -> NF_TcM [TcId]
 365 tcLookupLocalIds ns
 366   = tcGetEnv            `thenNF_Tc` \ env ->
 367     returnNF_Tc (map (lookup (tcLEnv env)) ns)
 368   where
 369     lookup lenv name = case lookupNameEnv lenv name of
 370                         Just (ATcId id) -> id
 371                         other           -> pprPanic "tcLookupLocalIds" (ppr name)
 372
 373 tcLookupSyntaxId :: Name -> NF_TcM Id
 374 -- Lookup a name like PrelNum.fromInt, and return the corresponding Id,
 375 -- after mapping through the SyntaxMap.  This may give us the Id for
 376 -- (say) MyPrelude.fromInteger
 377 tcLookupSyntaxId name
 378   = tcGetEnv            `thenNF_Tc` \ env ->
 379     returnNF_Tc (case lookup_global env (tcSyntaxMap env name) of
 380                         Just (AnId id) -> id
 381                         other          -> pprPanic "tcLookupSyntaxId" (ppr name))
 382
 383 tcLookupSyntaxName :: Name -> NF_TcM Name
 384 tcLookupSyntaxName name
 385   = tcGetEnv            `thenNF_Tc` \ env ->
 386     returnNF_Tc (tcSyntaxMap env name)
 387 \end{code}
 388
 389
 390 %************************************************************************
 391 %*                                                                      *
 392 \subsection{The local environment}
 393 %*                                                                      *
 394 %************************************************************************
 395
 396 \begin{code}
 397 tcLookup_maybe :: Name -> NF_TcM (Maybe TcTyThing)
 398 tcLookup_maybe name
 399   = tcGetEnv            `thenNF_Tc` \ env ->
 400     returnNF_Tc (lookup_local env name)
 401
 402 tcLookup :: Name -> NF_TcM TcTyThing
 403 tcLookup name
 404   = tcLookup_maybe name         `thenNF_Tc` \ maybe_thing ->
 405     case maybe_thing of
 406         Just thing -> returnNF_Tc thing
 407         other      -> notFound "tcLookup" name
 408         -- Extract the IdInfo from an IfaceSig imported from an interface file
 409 \end{code}
 410
 411
 412 \begin{code}
 413 tcExtendKindEnv :: [(Name,TcKind)] -> TcM r -> TcM r
 414 tcExtendKindEnv pairs thing_inside
 415   = tcGetEnv                            `thenNF_Tc` \ env ->
 416     let
 417         le' = extendNameEnvList (tcLEnv env) [(n, AThing k) | (n,k) <- pairs]
 418         -- No need to extend global tyvars for kind checking
 419     in
 420     tcSetEnv (env {tcLEnv = le'}) thing_inside
 421
 422 tcExtendTyVarEnv :: [TyVar] -> TcM r -> TcM r
 423 tcExtendTyVarEnv tyvars thing_inside
 424   = tcGetEnv                    `thenNF_Tc` \ env@(TcEnv {tcLEnv = le, tcTyVars = gtvs}) ->
 425     let
 426         le'        = extendNameEnvList le [ (getName tv, ATyVar tv) | tv <- tyvars]
 427         new_tv_set = mkVarSet tyvars
 428     in
 429         -- It's important to add the in-scope tyvars to the global tyvar set
 430         -- as well.  Consider
 431         --      f (x::r) = let g y = y::r in ...
 432         -- Here, g mustn't be generalised.  This is also important during
 433         -- class and instance decls, when we mustn't generalise the class tyvars
 434         -- when typechecking the methods.
 435     tc_extend_gtvs gtvs new_tv_set              `thenNF_Tc` \ gtvs' ->
 436     tcSetEnv (env {tcLEnv = le', tcTyVars = gtvs'}) thing_inside
 437
 438 -- This variant, tcExtendTyVarEnvForMeths, takes *two* bunches of tyvars:
 439 --      the signature tyvars contain the original names
 440 --      the instance  tyvars are what those names should be mapped to
 441 -- It's needed when typechecking the method bindings of class and instance decls
 442 -- It does *not* extend the global tyvars; tcMethodBind does that for itself
 443
 444 tcExtendTyVarEnvForMeths :: [TyVar] -> [TcTyVar] -> TcM r -> TcM r
 445 tcExtendTyVarEnvForMeths sig_tyvars inst_tyvars thing_inside
 446   = tcGetEnv                                    `thenNF_Tc` \ env ->
 447     let
 448         le'   = extendNameEnvList (tcLEnv env) stuff
 449         stuff = [ (getName sig_tv, ATyVar inst_tv)
 450                 | (sig_tv, inst_tv) <- zipEqual "tcMeth" sig_tyvars inst_tyvars
 451                 ]
 452     in
 453     tcSetEnv (env {tcLEnv = le'}) thing_inside
 454 \end{code}
 455
 456
 457 \begin{code}
 458 tcExtendLocalValEnv :: [(Name,TcId)] -> TcM a -> TcM a
 459 tcExtendLocalValEnv names_w_ids thing_inside
 460   = tcGetEnv            `thenNF_Tc` \ env ->
 461     let
 462         extra_global_tyvars = tyVarsOfTypes [idType id | (name,id) <- names_w_ids]
 463         extra_env           = [(name, ATcId id) | (name,id) <- names_w_ids]
 464         le'                 = extendNameEnvList (tcLEnv env) extra_env
 465     in
 466     tc_extend_gtvs (tcTyVars env) extra_global_tyvars   `thenNF_Tc` \ gtvs' ->
 467     tcSetEnv (env {tcLEnv = le', tcTyVars = gtvs'}) thing_inside
 468 \end{code}
 469
 470
 471 %************************************************************************
 472 %*                                                                      *
 473 \subsection{The global tyvars}
 474 %*                                                                      *
 475 %************************************************************************
 476
 477 \begin{code}
 478 tcExtendGlobalTyVars extra_global_tvs thing_inside
 479   = tcGetEnv                                            `thenNF_Tc` \ env ->
 480     tc_extend_gtvs (tcTyVars env) extra_global_tvs      `thenNF_Tc` \ gtvs' ->
 481     tcSetEnv (env {tcTyVars = gtvs'}) thing_inside
 482
 483 tc_extend_gtvs gtvs extra_global_tvs
 484   = tcReadMutVar gtvs                   `thenNF_Tc` \ global_tvs ->
 485     tcNewMutVar (global_tvs `unionVarSet` extra_global_tvs)
 486 \end{code}
 487
 488 @tcGetGlobalTyVars@ returns a fully-zonked set of tyvars free in the environment.
 489 To improve subsequent calls to the same function it writes the zonked set back into
 490 the environment.
 491
 492 \begin{code}
 493 tcGetGlobalTyVars :: NF_TcM TcTyVarSet
 494 tcGetGlobalTyVars
 495   = tcGetEnv                                    `thenNF_Tc` \ (TcEnv {tcTyVars = gtv_var}) ->
 496     tcReadMutVar gtv_var                        `thenNF_Tc` \ gbl_tvs ->
 497     zonkTcTyVarsAndFV (varSetElems gbl_tvs)     `thenNF_Tc` \ gbl_tvs' ->
 498     tcWriteMutVar gtv_var gbl_tvs'              `thenNF_Tc_`
 499     returnNF_Tc gbl_tvs'
 500 \end{code}
 501
 502
 503 %************************************************************************
 504 %*                                                                      *
 505 \subsection{The instance environment}
 506 %*                                                                      *
 507 %************************************************************************
 508
 509 \begin{code}
 510 tcGetInstEnv :: NF_TcM InstEnv
 511 tcGetInstEnv = tcGetEnv         `thenNF_Tc` \ env ->
 512                returnNF_Tc (tcInsts env)
 513
 514 tcSetInstEnv :: InstEnv -> TcM a -> TcM a
 515 tcSetInstEnv ie thing_inside
 516   = tcGetEnv    `thenNF_Tc` \ env ->
 517     tcSetEnv (env {tcInsts = ie}) thing_inside
 518 \end{code}
 519
 520
 521 %************************************************************************
 522 %*                                                                      *
 523 \subsection{The InstInfo type}
 524 %*                                                                      *
 525 %************************************************************************
 526
 527 The InstInfo type summarises the information in an instance declaration
 528
 529     instance c => k (t tvs) where b
 530
 531 \begin{code}
 532 data InstInfo
 533   = InstInfo {
 534       iDFunId :: DFunId,                -- The dfun id
 535       iBinds  :: RenamedMonoBinds,      -- Bindings, b
 536       iPrags  :: [RenamedSig]           -- User pragmas recorded for generating specialised instances
 537     }
 538
 539 pprInstInfo info = vcat [ptext SLIT("InstInfo:") <+> ppr (idType (iDFunId info)),
 540                          nest 4 (ppr (iBinds info))]
 541
 542 simpleInstInfoTy :: InstInfo -> Type
 543 simpleInstInfoTy info = case splitDFunTy (idType (iDFunId info)) of
 544                           (_, _, _, [ty]) -> ty
 545
 546 simpleInstInfoTyCon :: InstInfo -> TyCon
 547   -- Gets the type constructor for a simple instance declaration,
 548   -- i.e. one of the form       instance (...) => C (T a b c) where ...
 549 simpleInstInfoTyCon inst = tyConAppTyCon (simpleInstInfoTy inst)
 550 \end{code}
 551
 552
 553 %************************************************************************
 554 %*                                                                      *
 555 \subsection{Errors}
 556 %*                                                                      *
 557 %************************************************************************
 558
 559 \begin{code}
 560 badCon con_id = quotes (ppr con_id) <+> ptext SLIT("is not a data constructor")
 561
 562 notFound wheRe name = failWithTc (text wheRe <> colon <+> quotes (ppr name) <+>
 563                                   ptext SLIT("is not in scope"))
 564 \end{code}