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