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