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,
  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,
  52                           tyVarsOfTypes, splitDFunTy,
  53                           getDFunTyKey, tyConAppTyCon
  54                         )
  55 import DataCon          ( DataCon )
  56 import TyCon            ( TyCon )
  57 import Class            ( Class, ClassOpItem, ClassContext )
  58 import Name             ( Name, OccName, NamedThing(..),
  59                           nameOccName, getSrcLoc, mkLocalName, isLocalName,
  60                           nameIsLocalOrFrom
  61                         )
  62 import NameEnv          ( NameEnv, lookupNameEnv, nameEnvElts,
  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 -- This data type is used to help tie the knot
 174 -- when type checking type and class declarations
 175 data TyThingDetails = SynTyDetails Type
 176                     | DataTyDetails ClassContext [DataCon] [Id]
 177                     | ClassDetails ClassContext [Id] [ClassOpItem] DataCon
 178 \end{code}
 179
 180
 181 %************************************************************************
 182 %*                                                                      *
 183 \subsection{Basic lookups}
 184 %*                                                                      *
 185 %************************************************************************
 186
 187 \begin{code}
 188 lookup_global :: TcEnv -> Name -> Maybe TyThing
 189         -- Try the global envt and then the global symbol table
 190 lookup_global env name
 191   = case lookupNameEnv (tcGEnv env) name of
 192         Just thing -> Just thing
 193         Nothing    -> tcGST env name
 194
 195 lookup_local :: TcEnv -> Name -> Maybe TcTyThing
 196         -- Try the local envt and then try the global
 197 lookup_local env name
 198   = case lookupNameEnv (tcLEnv env) name of
 199         Just thing -> Just thing
 200         Nothing    -> case lookup_global env name of
 201                         Just thing -> Just (AGlobal thing)
 202                         Nothing    -> Nothing
 203 \end{code}
 204
 205 \begin{code}
 206 type RecTcEnv = TcEnv
 207 -- This environment is used for getting the 'right' IdInfo
 208 -- on imported things and for looking up Ids in unfoldings
 209 -- The environment doesn't have any local Ids in it
 210
 211 tcAddImportedIdInfo :: RecTcEnv -> Id -> Id
 212 tcAddImportedIdInfo env id
 213   = id `lazySetIdInfo` new_info
 214         -- The Id must be returned without a data dependency on maybe_id
 215   where
 216     new_info = case tcLookupRecId_maybe env (idName id) of
 217                   Nothing          -> pprTrace "tcAddIdInfo" (ppr id) vanillaIdInfo
 218                   Just imported_id -> idInfo imported_id
 219                 -- ToDo: could check that types are the same
 220
 221 tcLookupRecId_maybe :: RecTcEnv -> Name -> Maybe Id
 222 tcLookupRecId_maybe env name = case lookup_global env name of
 223                                    Just (AnId id) -> Just id
 224                                    other          -> Nothing
 225
 226 tcLookupRecId ::  RecTcEnv -> Name -> Id
 227 tcLookupRecId env name = case lookup_global env name of
 228                                 Just (AnId id) -> id
 229                                 Nothing        -> pprPanic "tcLookupRecId" (ppr name)
 230 \end{code}
 231
 232 %************************************************************************
 233 %*                                                                      *
 234 \subsection{Making new Ids}
 235 %*                                                                      *
 236 %************************************************************************
 237
 238 Constructing new Ids
 239
 240 \begin{code}
 241 newLocalId :: OccName -> TcType -> SrcLoc -> NF_TcM TcId
 242 newLocalId name ty loc
 243   = tcGetUnique         `thenNF_Tc` \ uniq ->
 244     returnNF_Tc (mkUserLocal name uniq ty loc)
 245
 246 newSpecPragmaId :: Name -> TcType -> NF_TcM TcId
 247 newSpecPragmaId name ty
 248   = tcGetUnique         `thenNF_Tc` \ uniq ->
 249     returnNF_Tc (mkSpecPragmaId (nameOccName name) uniq ty (getSrcLoc name))
 250 \end{code}
 251
 252 Make a name for the dict fun for an instance decl.
 253 It's a *local* name for the moment.  The CoreTidy pass
 254 will globalise it.
 255
 256 \begin{code}
 257 newDFunName :: Class -> [Type] -> SrcLoc -> NF_TcM Name
 258 newDFunName clas (ty:_) loc
 259   = tcGetUnique                 `thenNF_Tc` \ uniq ->
 260     returnNF_Tc (mkLocalName uniq (mkDFunOcc dfun_string) loc)
 261   where
 262         -- Any string that is somewhat unique will do
 263     dfun_string = occNameString (getOccName clas) ++ occNameString (getDFunTyKey ty)
 264
 265 newDFunName clas [] loc = pprPanic "newDFunName" (ppr clas <+> ppr loc)
 266 \end{code}
 267
 268 \begin{code}
 269 isLocalThing :: NamedThing a => Module -> a -> Bool
 270 isLocalThing mod thing = nameIsLocalOrFrom mod (getName thing)
 271 \end{code}
 272
 273 %************************************************************************
 274 %*                                                                      *
 275 \subsection{The global environment}
 276 %*                                                                      *
 277 %************************************************************************
 278
 279 \begin{code}
 280 tcExtendGlobalEnv :: [TyThing] -> TcM r -> TcM r
 281 tcExtendGlobalEnv things thing_inside
 282   = tcGetEnv                            `thenNF_Tc` \ env ->
 283     let
 284         ge' = extendTypeEnvList (tcGEnv env) things
 285     in
 286     tcSetEnv (env {tcGEnv = ge'}) thing_inside
 287
 288
 289 tcExtendGlobalTypeEnv :: TypeEnv -> TcM r -> TcM r
 290 tcExtendGlobalTypeEnv extra_env thing_inside
 291   = tcGetEnv                            `thenNF_Tc` \ env ->
 292     let
 293         ge' = tcGEnv env `plusNameEnv` extra_env
 294     in
 295     tcSetEnv (env {tcGEnv = ge'}) thing_inside
 296
 297 tcExtendGlobalValEnv :: [Id] -> TcM a -> TcM a
 298 tcExtendGlobalValEnv ids thing_inside
 299   = tcGetEnv                            `thenNF_Tc` \ env ->
 300     let
 301         ge' = extendTypeEnvWithIds (tcGEnv env) ids
 302     in
 303     tcSetEnv (env {tcGEnv = ge'}) thing_inside
 304 \end{code}
 305
 306
 307 \begin{code}
 308 tcLookupGlobal_maybe :: Name -> NF_TcM (Maybe TyThing)
 309 tcLookupGlobal_maybe name
 310   = tcGetEnv            `thenNF_Tc` \ env ->
 311     returnNF_Tc (lookup_global env name)
 312 \end{code}
 313
 314 A variety of global lookups, when we know what we are looking for.
 315
 316 \begin{code}
 317 tcLookupGlobal :: Name -> NF_TcM TyThing
 318 tcLookupGlobal name
 319   = tcLookupGlobal_maybe name   `thenNF_Tc` \ maybe_thing ->
 320     case maybe_thing of
 321         Just thing -> returnNF_Tc thing
 322         other      -> notFound "tcLookupGlobal" name
 323
 324 tcLookupGlobalId :: Name -> NF_TcM Id
 325 tcLookupGlobalId name
 326   = tcLookupGlobal_maybe name   `thenNF_Tc` \ maybe_id ->
 327     case maybe_id of
 328         Just (AnId id) -> returnNF_Tc id
 329         other          -> notFound "tcLookupGlobalId" name
 330
 331 tcLookupDataCon :: Name -> TcM DataCon
 332 tcLookupDataCon con_name
 333   = tcLookupGlobalId con_name           `thenNF_Tc` \ con_id ->
 334     case isDataConWrapId_maybe con_id of
 335         Just data_con -> returnTc data_con
 336         Nothing       -> failWithTc (badCon con_id)
 337
 338
 339 tcLookupClass :: Name -> NF_TcM Class
 340 tcLookupClass name
 341   = tcLookupGlobal_maybe name   `thenNF_Tc` \ maybe_clas ->
 342     case maybe_clas of
 343         Just (AClass clas) -> returnNF_Tc clas
 344         other              -> notFound "tcLookupClass" name
 345
 346 tcLookupTyCon :: Name -> NF_TcM TyCon
 347 tcLookupTyCon name
 348   = tcLookupGlobal_maybe name   `thenNF_Tc` \ maybe_tc ->
 349     case maybe_tc of
 350         Just (ATyCon tc) -> returnNF_Tc tc
 351         other            -> notFound "tcLookupTyCon" name
 352
 353 tcLookupId :: Name -> NF_TcM Id
 354 tcLookupId name
 355   = tcLookup name       `thenNF_Tc` \ thing ->
 356     case thing of
 357         ATcId tc_id       -> returnNF_Tc tc_id
 358         AGlobal (AnId id) -> returnNF_Tc id
 359         other             -> pprPanic "tcLookupId" (ppr name)
 360
 361 tcLookupLocalIds :: [Name] -> NF_TcM [TcId]
 362 tcLookupLocalIds ns
 363   = tcGetEnv            `thenNF_Tc` \ env ->
 364     returnNF_Tc (map (lookup (tcLEnv env)) ns)
 365   where
 366     lookup lenv name = case lookupNameEnv lenv name of
 367                         Just (ATcId id) -> id
 368                         other           -> pprPanic "tcLookupLocalIds" (ppr name)
 369
 370 tcLookupSyntaxId :: Name -> NF_TcM Id
 371 -- Lookup a name like PrelNum.fromInt, and return the corresponding Id,
 372 -- after mapping through the SyntaxMap.  This may give us the Id for
 373 -- (say) MyPrelude.fromInteger
 374 tcLookupSyntaxId name
 375   = tcGetEnv            `thenNF_Tc` \ env ->
 376     returnNF_Tc (case lookup_global env (tcSyntaxMap env name) of
 377                         Just (AnId id) -> id
 378                         other          -> pprPanic "tcLookupSyntaxId" (ppr name))
 379
 380 tcLookupSyntaxName :: Name -> NF_TcM Name
 381 tcLookupSyntaxName name
 382   = tcGetEnv            `thenNF_Tc` \ env ->
 383     returnNF_Tc (tcSyntaxMap env name)
 384 \end{code}
 385
 386
 387 %************************************************************************
 388 %*                                                                      *
 389 \subsection{The local environment}
 390 %*                                                                      *
 391 %************************************************************************
 392
 393 \begin{code}
 394 tcLookup_maybe :: Name -> NF_TcM (Maybe TcTyThing)
 395 tcLookup_maybe name
 396   = tcGetEnv            `thenNF_Tc` \ env ->
 397     returnNF_Tc (lookup_local env name)
 398
 399 tcLookup :: Name -> NF_TcM TcTyThing
 400 tcLookup name
 401   = tcLookup_maybe name         `thenNF_Tc` \ maybe_thing ->
 402     case maybe_thing of
 403         Just thing -> returnNF_Tc thing
 404         other      -> notFound "tcLookup" name
 405         -- Extract the IdInfo from an IfaceSig imported from an interface file
 406 \end{code}
 407
 408
 409 \begin{code}
 410 tcExtendKindEnv :: [(Name,TcKind)] -> TcM r -> TcM r
 411 tcExtendKindEnv pairs thing_inside
 412   = tcGetEnv                            `thenNF_Tc` \ env ->
 413     let
 414         le' = extendNameEnvList (tcLEnv env) [(n, AThing k) | (n,k) <- pairs]
 415         -- No need to extend global tyvars for kind checking
 416     in
 417     tcSetEnv (env {tcLEnv = le'}) thing_inside
 418
 419 tcExtendTyVarEnv :: [TyVar] -> TcM r -> TcM r
 420 tcExtendTyVarEnv tyvars thing_inside
 421   = tcGetEnv                    `thenNF_Tc` \ env@(TcEnv {tcLEnv = le, tcTyVars = gtvs}) ->
 422     let
 423         le'        = extendNameEnvList le [ (getName tv, ATyVar tv) | tv <- tyvars]
 424         new_tv_set = mkVarSet tyvars
 425     in
 426         -- It's important to add the in-scope tyvars to the global tyvar set
 427         -- as well.  Consider
 428         --      f (x::r) = let g y = y::r in ...
 429         -- Here, g mustn't be generalised.  This is also important during
 430         -- class and instance decls, when we mustn't generalise the class tyvars
 431         -- when typechecking the methods.
 432     tc_extend_gtvs gtvs new_tv_set              `thenNF_Tc` \ gtvs' ->
 433     tcSetEnv (env {tcLEnv = le', tcTyVars = gtvs'}) thing_inside
 434
 435 -- This variant, tcExtendTyVarEnvForMeths, takes *two* bunches of tyvars:
 436 --      the signature tyvars contain the original names
 437 --      the instance  tyvars are what those names should be mapped to
 438 -- It's needed when typechecking the method bindings of class and instance decls
 439 -- It does *not* extend the global tyvars; tcMethodBind does that for itself
 440
 441 tcExtendTyVarEnvForMeths :: [TyVar] -> [TcTyVar] -> TcM r -> TcM r
 442 tcExtendTyVarEnvForMeths sig_tyvars inst_tyvars thing_inside
 443   = tcGetEnv                                    `thenNF_Tc` \ env ->
 444     let
 445         le'   = extendNameEnvList (tcLEnv env) stuff
 446         stuff = [ (getName sig_tv, ATyVar inst_tv)
 447                 | (sig_tv, inst_tv) <- zipEqual "tcMeth" sig_tyvars inst_tyvars
 448                 ]
 449     in
 450     tcSetEnv (env {tcLEnv = le'}) thing_inside
 451 \end{code}
 452
 453
 454 \begin{code}
 455 tcExtendLocalValEnv :: [(Name,TcId)] -> TcM a -> TcM a
 456 tcExtendLocalValEnv names_w_ids thing_inside
 457   = tcGetEnv            `thenNF_Tc` \ env ->
 458     let
 459         extra_global_tyvars = tyVarsOfTypes [idType id | (name,id) <- names_w_ids]
 460         extra_env           = [(name, ATcId id) | (name,id) <- names_w_ids]
 461         le'                 = extendNameEnvList (tcLEnv env) extra_env
 462     in
 463     tc_extend_gtvs (tcTyVars env) extra_global_tyvars   `thenNF_Tc` \ gtvs' ->
 464     tcSetEnv (env {tcLEnv = le', tcTyVars = gtvs'}) thing_inside
 465 \end{code}
 466
 467
 468 %************************************************************************
 469 %*                                                                      *
 470 \subsection{The global tyvars}
 471 %*                                                                      *
 472 %************************************************************************
 473
 474 \begin{code}
 475 tcExtendGlobalTyVars extra_global_tvs thing_inside
 476   = tcGetEnv                                            `thenNF_Tc` \ env ->
 477     tc_extend_gtvs (tcTyVars env) extra_global_tvs      `thenNF_Tc` \ gtvs' ->
 478     tcSetEnv (env {tcTyVars = gtvs'}) thing_inside
 479
 480 tc_extend_gtvs gtvs extra_global_tvs
 481   = tcReadMutVar gtvs                   `thenNF_Tc` \ global_tvs ->
 482     tcNewMutVar (global_tvs `unionVarSet` extra_global_tvs)
 483 \end{code}
 484
 485 @tcGetGlobalTyVars@ returns a fully-zonked set of tyvars free in the environment.
 486 To improve subsequent calls to the same function it writes the zonked set back into
 487 the environment.
 488
 489 \begin{code}
 490 tcGetGlobalTyVars :: NF_TcM TcTyVarSet
 491 tcGetGlobalTyVars
 492   = tcGetEnv                                    `thenNF_Tc` \ (TcEnv {tcTyVars = gtv_var}) ->
 493     tcReadMutVar gtv_var                        `thenNF_Tc` \ gbl_tvs ->
 494     zonkTcTyVarsAndFV (varSetElems gbl_tvs)     `thenNF_Tc` \ gbl_tvs' ->
 495     tcWriteMutVar gtv_var gbl_tvs'              `thenNF_Tc_`
 496     returnNF_Tc gbl_tvs'
 497 \end{code}
 498
 499
 500 %************************************************************************
 501 %*                                                                      *
 502 \subsection{The instance environment}
 503 %*                                                                      *
 504 %************************************************************************
 505
 506 \begin{code}
 507 tcGetInstEnv :: NF_TcM InstEnv
 508 tcGetInstEnv = tcGetEnv         `thenNF_Tc` \ env ->
 509                returnNF_Tc (tcInsts env)
 510
 511 tcSetInstEnv :: InstEnv -> TcM a -> TcM a
 512 tcSetInstEnv ie thing_inside
 513   = tcGetEnv    `thenNF_Tc` \ env ->
 514     tcSetEnv (env {tcInsts = ie}) thing_inside
 515 \end{code}
 516
 517
 518 %************************************************************************
 519 %*                                                                      *
 520 \subsection{The InstInfo type}
 521 %*                                                                      *
 522 %************************************************************************
 523
 524 The InstInfo type summarises the information in an instance declaration
 525
 526     instance c => k (t tvs) where b
 527
 528 \begin{code}
 529 data InstInfo
 530   = InstInfo {
 531       iDFunId :: DFunId,                -- The dfun id
 532       iBinds  :: RenamedMonoBinds,      -- Bindings, b
 533       iPrags  :: [RenamedSig]           -- User pragmas recorded for generating specialised instances
 534     }
 535
 536 pprInstInfo info = vcat [ptext SLIT("InstInfo:") <+> ppr (idType (iDFunId info)),
 537                          nest 4 (ppr (iBinds info))]
 538
 539 simpleInstInfoTy :: InstInfo -> Type
 540 simpleInstInfoTy info = case splitDFunTy (idType (iDFunId info)) of
 541                           (_, _, _, [ty]) -> ty
 542
 543 simpleInstInfoTyCon :: InstInfo -> TyCon
 544   -- Gets the type constructor for a simple instance declaration,
 545   -- i.e. one of the form       instance (...) => C (T a b c) where ...
 546 simpleInstInfoTyCon inst = tyConAppTyCon (simpleInstInfoTy inst)
 547 \end{code}
 548
 549
 550 %************************************************************************
 551 %*                                                                      *
 552 \subsection{Errors}
 553 %*                                                                      *
 554 %************************************************************************
 555
 556 \begin{code}
 557 badCon con_id = quotes (ppr con_id) <+> ptext SLIT("is not a data constructor")
 558
 559 notFound wheRe name = failWithTc (text wheRe <> colon <+> quotes (ppr name) <+>
 560                                   ptext SLIT("is not in scope"))
 561 \end{code}