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