ghc/compiler/typecheck/TcInstUtil.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 \section[TcInstUtil]{Utilities for typechecking instance declarations}
   5
   6 The bits common to TcInstDcls and TcDeriv.
   7
   8 \begin{code}
   9 module TcInstUtil (
  10         InstInfo(..),
  11         buildInstanceEnv,
  12         classDataCon
  13     ) where
  14
  15 #include "HsVersions.h"
  16
  17 import RnHsSyn          ( RenamedMonoBinds, RenamedSig )
  18
  19 import CmdLineOpts      ( opt_AllowOverlappingInstances )
  20 import TcMonad
  21 import TcEnv            ( InstEnv, emptyInstEnv, addToInstEnv )
  22 import Bag              ( bagToList, Bag )
  23 import Class            ( Class )
  24 import Var              ( TyVar, Id, idName )
  25 import Maybes           ( MaybeErr(..) )
  26 import Name             ( getSrcLoc, nameModule, isLocallyDefined )
  27 import SrcLoc           ( SrcLoc )
  28 import Type             ( Type, ClassContext )
  29 import PprType          ( pprConstraint )
  30 import Class            ( classTyCon )
  31 import DataCon          ( DataCon )
  32 import TyCon            ( tyConDataCons )
  33 import Outputable
  34 \end{code}
  35
  36     instance c => k (t tvs) where b
  37
  38 \begin{code}
  39 data InstInfo
  40   = InstInfo
  41       Class             -- Class, k
  42       [TyVar]           -- Type variables, tvs
  43       [Type]            -- The types at which the class is being instantiated
  44       ClassContext      -- inst_decl_theta: the original context, c, from the
  45                         --   instance declaration.  It constrains (some of)
  46                         --   the TyVars above
  47       Id                -- The dfun id
  48       RenamedMonoBinds  -- Bindings, b
  49       SrcLoc            -- Source location assoc'd with this instance's defn
  50       [RenamedSig]      -- User pragmas recorded for generating specialised instances
  51 \end{code}
  52
  53
  54 %************************************************************************
  55 %*                                                                      *
  56 \subsection{Creating instance related Ids}
  57 %*                                                                      *
  58 %************************************************************************
  59
  60 A tiny function which doesn't belong anywhere else.
  61 It makes a nasty mutual-recursion knot if you put it in Class.
  62
  63 \begin{code}
  64 classDataCon :: Class -> DataCon
  65 classDataCon clas = case tyConDataCons (classTyCon clas) of
  66                       (dict_constr:no_more) -> ASSERT( null no_more ) dict_constr
  67 \end{code}
  68
  69 %************************************************************************
  70 %*                                                                      *
  71 \subsection{Converting instance info into suitable InstEnvs}
  72 %*                                                                      *
  73 %************************************************************************
  74
  75 \begin{code}
  76 buildInstanceEnv :: Bag InstInfo -> NF_TcM s InstEnv
  77
  78 buildInstanceEnv info = foldrNF_Tc addClassInstance emptyInstEnv (bagToList info)
  79 \end{code}
  80
  81 @addClassInstance@ adds the appropriate stuff to the @ClassInstEnv@
  82 based on information from a single instance declaration.  It complains
  83 about any overlap with an existing instance.
  84
  85 \begin{code}
  86 addClassInstance
  87     :: InstInfo
  88     -> InstEnv
  89     -> NF_TcM s InstEnv
  90
  91 addClassInstance
  92     (InstInfo clas inst_tyvars inst_tys _
  93               dfun_id _ src_loc _)
  94     inst_env
  95   =     -- Add the instance to the class's instance environment
  96     case addToInstEnv opt_AllowOverlappingInstances
  97                       inst_env clas inst_tyvars inst_tys dfun_id of
  98         Failed (tys', dfun_id')    -> addErrTc (dupInstErr clas (inst_tys, dfun_id)
  99                                                                 (tys',     dfun_id'))
 100                                                 `thenNF_Tc_`
 101                                      returnNF_Tc inst_env
 102
 103         Succeeded inst_env' -> returnNF_Tc inst_env'
 104 \end{code}
 105
 106 \begin{code}
 107 dupInstErr clas info1@(tys1, dfun1) info2@(tys2, dfun2)
 108         -- Overlapping/duplicate instances for given class; msg could be more glamourous
 109   = hang (ptext SLIT("Duplicate or overlapping instance declarations"))
 110          4 (sep [ptext SLIT("for") <+> quotes (pprConstraint clas tys1),
 111                  nest 4 (sep [ppr_loc dfun1, ptext SLIT("and") <+> ppr_loc dfun2])])
 112   where
 113     ppr_loc dfun
 114         | isLocallyDefined dfun = ptext SLIT("defined at")           <+> ppr (getSrcLoc dfun)
 115         | otherwise             = ptext SLIT("imported from module") <+> quotes (ppr (nameModule (idName dfun)))
 116 \end{code}