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