ghc/compiler/types/InstEnv.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 \section[InstEnv]{Utilities for typechecking instance declarations}
   5
   6 The bits common to TcInstDcls and TcDeriv.
   7
   8 \begin{code}
   9 module InstEnv (
  10         DFunId, ClsInstEnv, InstEnv,
  11
  12         emptyInstEnv, extendInstEnv,
  13         lookupInstEnv, InstLookupResult(..),
  14         classInstEnv, simpleDFunClassTyCon
  15     ) where
  16
  17 #include "HsVersions.h"
  18
  19 import Class            ( Class )
  20 import Var              ( Id )
  21 import VarSet           ( TyVarSet, unionVarSet, mkVarSet )
  22 import VarEnv           ( TyVarSubstEnv )
  23 import Maybes           ( MaybeErr(..), returnMaB, failMaB, thenMaB, maybeToBool )
  24 import Name             ( getSrcLoc )
  25 import Type             ( Type, splitTyConApp_maybe,
  26                           splitSigmaTy, splitDFunTy, tyVarsOfTypes
  27                         )
  28 import PprType          ( )
  29 import DataCon          ( DataCon )
  30 import TyCon            ( TyCon )
  31 import Outputable
  32 import Unify            ( matchTys, unifyTyListsX )
  33 import UniqFM           ( UniqFM, lookupWithDefaultUFM, addToUFM, emptyUFM )
  34 import Id               ( idType )
  35 import ErrUtils         ( Message )
  36 import CmdLineOpts
  37 \end{code}
  38
  39
  40 %************************************************************************
  41 %*                                                                      *
  42 \subsection{The key types}
  43 %*                                                                      *
  44 %************************************************************************
  45
  46 \begin{code}
  47 type DFunId     = Id
  48
  49 type InstEnv    = UniqFM ClsInstEnv             -- Maps Class to instances for that class
  50
  51 type ClsInstEnv = [(TyVarSet, [Type], DFunId)]  -- The instances for a particular class
  52
  53 simpleDFunClassTyCon :: DFunId -> (Class, TyCon)
  54 simpleDFunClassTyCon dfun
  55   = (clas, tycon)
  56   where
  57     (_,_,clas,[ty]) = splitDFunTy (idType dfun)
  58     tycon           = case splitTyConApp_maybe ty of
  59                         Just (tycon,_) -> tycon
  60 \end{code}
  61
  62 %************************************************************************
  63 %*                                                                      *
  64 \subsection{Instance environments: InstEnv and ClsInstEnv}
  65 %*                                                                      *
  66 %************************************************************************
  67
  68 The actual type declarations are in HscTypes.
  69
  70 \begin{code}
  71 emptyInstEnv :: InstEnv
  72 emptyInstEnv = emptyUFM
  73
  74 classInstEnv :: InstEnv -> Class -> ClsInstEnv
  75 classInstEnv env cls = lookupWithDefaultUFM env [] cls
  76 \end{code}
  77
  78 A @ClsInstEnv@ lives inside a class, and identifies all the instances
  79 of that class.  The @Id@ inside a ClsInstEnv mapping is the dfun for
  80 that instance.
  81
  82 If class C maps to a list containing the item ([a,b], [t1,t2,t3], dfun), then
  83
  84         forall a b, C t1 t2 t3  can be constructed by dfun
  85
  86 or, to put it another way, we have
  87
  88         instance (...) => C t1 t2 t3,  witnessed by dfun
  89
  90 There is an important consistency constraint in the elements of a ClsInstEnv:
  91
  92   * [a,b] must be a superset of the free vars of [t1,t2,t3]
  93
  94   * The dfun must itself be quantified over [a,b]
  95
  96 Thus, the @ClassInstEnv@ for @Eq@ might contain the following entry:
  97         [a] ===> dfun_Eq_List :: forall a. Eq a => Eq [a]
  98 The "a" in the pattern must be one of the forall'd variables in
  99 the dfun type.
 100
 101
 102
 103 Notes on overlapping instances
 104 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 105 In some ClsInstEnvs, overlap is prohibited; that is, no pair of templates unify.
 106
 107 In others, overlap is permitted, but only in such a way that one can make
 108 a unique choice when looking up.  That is, overlap is only permitted if
 109 one template matches the other, or vice versa.  So this is ok:
 110
 111   [a]  [Int]
 112
 113 but this is not
 114
 115   (Int,a)  (b,Int)
 116
 117 If overlap is permitted, the list is kept most specific first, so that
 118 the first lookup is the right choice.
 119
 120
 121 For now we just use association lists.
 122
 123 \subsection{Avoiding a problem with overlapping}
 124
 125 Consider this little program:
 126
 127 \begin{pseudocode}
 128      class C a        where c :: a
 129      class C a => D a where d :: a
 130
 131      instance C Int where c = 17
 132      instance D Int where d = 13
 133
 134      instance C a => C [a] where c = [c]
 135      instance ({- C [a], -} D a) => D [a] where d = c
 136
 137      instance C [Int] where c = [37]
 138
 139      main = print (d :: [Int])
 140 \end{pseudocode}
 141
 142 What do you think `main' prints  (assuming we have overlapping instances, and
 143 all that turned on)?  Well, the instance for `D' at type `[a]' is defined to
 144 be `c' at the same type, and we've got an instance of `C' at `[Int]', so the
 145 answer is `[37]', right? (the generic `C [a]' instance shouldn't apply because
 146 the `C [Int]' instance is more specific).
 147
 148 Ghc-4.04 gives `[37]', while ghc-4.06 gives `[17]', so 4.06 is wrong.  That
 149 was easy ;-)  Let's just consult hugs for good measure.  Wait - if I use old
 150 hugs (pre-September99), I get `[17]', and stranger yet, if I use hugs98, it
 151 doesn't even compile!  What's going on!?
 152
 153 What hugs complains about is the `D [a]' instance decl.
 154
 155 \begin{pseudocode}
 156      ERROR "mj.hs" (line 10): Cannot build superclass instance
 157      *** Instance            : D [a]
 158      *** Context supplied    : D a
 159      *** Required superclass : C [a]
 160 \end{pseudocode}
 161
 162 You might wonder what hugs is complaining about.  It's saying that you
 163 need to add `C [a]' to the context of the `D [a]' instance (as appears
 164 in comments).  But there's that `C [a]' instance decl one line above
 165 that says that I can reduce the need for a `C [a]' instance to the
 166 need for a `C a' instance, and in this case, I already have the
 167 necessary `C a' instance (since we have `D a' explicitly in the
 168 context, and `C' is a superclass of `D').
 169
 170 Unfortunately, the above reasoning indicates a premature commitment to the
 171 generic `C [a]' instance.  I.e., it prematurely rules out the more specific
 172 instance `C [Int]'.  This is the mistake that ghc-4.06 makes.  The fix is to
 173 add the context that hugs suggests (uncomment the `C [a]'), effectively
 174 deferring the decision about which instance to use.
 175
 176 Now, interestingly enough, 4.04 has this same bug, but it's covered up
 177 in this case by a little known `optimization' that was disabled in
 178 4.06.  Ghc-4.04 silently inserts any missing superclass context into
 179 an instance declaration.  In this case, it silently inserts the `C
 180 [a]', and everything happens to work out.
 181
 182 (See `basicTypes/MkId:mkDictFunId' for the code in question.  Search for
 183 `Mark Jones', although Mark claims no credit for the `optimization' in
 184 question, and would rather it stopped being called the `Mark Jones
 185 optimization' ;-)
 186
 187 So, what's the fix?  I think hugs has it right.  Here's why.  Let's try
 188 something else out with ghc-4.04.  Let's add the following line:
 189
 190     d' :: D a => [a]
 191     d' = c
 192
 193 Everyone raise their hand who thinks that `d :: [Int]' should give a
 194 different answer from `d' :: [Int]'.  Well, in ghc-4.04, it does.  The
 195 `optimization' only applies to instance decls, not to regular
 196 bindings, giving inconsistent behavior.
 197
 198 Old hugs had this same bug.  Here's how we fixed it: like GHC, the
 199 list of instances for a given class is ordered, so that more specific
 200 instances come before more generic ones.  For example, the instance
 201 list for C might contain:
 202     ..., C Int, ..., C a, ...
 203 When we go to look for a `C Int' instance we'll get that one first.
 204 But what if we go looking for a `C b' (`b' is unconstrained)?  We'll
 205 pass the `C Int' instance, and keep going.  But if `b' is
 206 unconstrained, then we don't know yet if the more specific instance
 207 will eventually apply.  GHC keeps going, and matches on the generic `C
 208 a'.  The fix is to, at each step, check to see if there's a reverse
 209 match, and if so, abort the search.  This prevents hugs from
 210 prematurely chosing a generic instance when a more specific one
 211 exists.
 212
 213 --Jeff
 214
 215
 216 @lookupInstEnv@ looks up in a @InstEnv@, using a one-way match.  Since
 217 the env is kept ordered, the first match must be the only one.  The
 218 thing we are looking up can have an arbitrary "flexi" part.
 219
 220 \begin{code}
 221 lookupInstEnv :: InstEnv                        -- The envt
 222               -> Class -> [Type]        -- Key
 223               -> InstLookupResult
 224
 225 data InstLookupResult
 226   = FoundInst                   -- There is a (template,substitution) pair
 227                                 -- that makes the template match the key,
 228                                 -- and no template is an instance of the key
 229         TyVarSubstEnv Id
 230
 231   | NoMatch Bool        -- Boolean is true iff there is at least one
 232                         -- template that matches the key.
 233                         -- (but there are other template(s) that are
 234                         --  instances of the key, so we don't report
 235                         --  FoundInst)
 236         -- The NoMatch True case happens when we look up
 237         --      Foo [a]
 238         -- in an InstEnv that has entries for
 239         --      Foo [Int]
 240         --      Foo [b]
 241         -- Then which we choose would depend on the way in which 'a'
 242         -- is instantiated.  So we say there is no match, but identify
 243         -- it as ambiguous case in the hope of giving a better error msg.
 244         -- See the notes above from Jeff Lewis
 245
 246 lookupInstEnv env key_cls key_tys
 247   = find (classInstEnv env key_cls)
 248   where
 249     key_vars = tyVarsOfTypes key_tys
 250
 251     find [] = NoMatch False
 252     find ((tpl_tyvars, tpl, val) : rest)
 253       = case matchTys tpl_tyvars tpl key_tys of
 254           Nothing                 ->
 255             case matchTys key_vars key_tys tpl of
 256               Nothing             -> find rest
 257               Just (_, _)         -> NoMatch (any_match rest)
 258           Just (subst, leftovers) -> ASSERT( null leftovers )
 259                                      FoundInst subst val
 260
 261     any_match rest = or [ maybeToBool (matchTys tvs tpl key_tys)
 262                         | (tvs,tpl,_) <- rest
 263                         ]
 264 \end{code}
 265
 266 @addToClsInstEnv@ extends a @ClsInstEnv@, checking for overlaps.
 267
 268 A boolean flag controls overlap reporting.
 269
 270 True => overlap is permitted, but only if one template matches the other;
 271         not if they unify but neither is
 272
 273 \begin{code}
 274 extendInstEnv :: DynFlags -> InstEnv -> [DFunId] -> (InstEnv, [Message])
 275   -- Similar, but all we have is the DFuns
 276 extendInstEnv dflags env infos
 277   = go env [] infos
 278   where
 279     go env msgs []           = (env, msgs)
 280     go env msgs (dfun:dfuns) = case addToInstEnv dflags env dfun of
 281                                     Succeeded new_env -> go new_env msgs dfuns
 282                                     Failed dfun'      -> go env (msg:msgs) dfuns
 283                                                      where
 284                                                          msg = dupInstErr dfun dfun'
 285
 286
 287 dupInstErr dfun1 dfun2
 288         -- Overlapping/duplicate instances for given class; msg could be more glamourous
 289   = hang (ptext SLIT("Duplicate or overlapping instance declarations:"))
 290        2 (ppr_dfun dfun1 $$ ppr_dfun dfun2)
 291   where
 292     ppr_dfun dfun = ppr (getSrcLoc dfun) <> colon <+> ppr tau
 293                   where
 294                     (_,_,tau) = splitSigmaTy (idType dfun)
 295
 296 addToInstEnv :: DynFlags
 297              -> InstEnv -> DFunId
 298              -> MaybeErr InstEnv        -- Success...
 299                          DFunId         -- Failure: Offending overlap
 300
 301 addToInstEnv dflags inst_env dfun_id
 302   = case insert_into (classInstEnv inst_env clas) of
 303         Failed stuff      -> Failed stuff
 304         Succeeded new_env -> Succeeded (addToUFM inst_env clas new_env)
 305
 306   where
 307     (ins_tvs, _, clas, ins_tys) = splitDFunTy (idType dfun_id)
 308
 309     ins_tv_set = mkVarSet ins_tvs
 310     ins_item = (ins_tv_set, ins_tys, dfun_id)
 311
 312     insert_into [] = returnMaB [ins_item]
 313     insert_into env@(cur_item@(tpl_tvs, tpl_tys, val) : rest)
 314
 315         -- FAIL if:
 316         -- (a) they are the same, or
 317         -- (b) they unify, and any sort of overlap is prohibited,
 318         -- (c) they unify but neither is more specific than t'other
 319       |  identical
 320       || (unifiable && not (dopt Opt_AllowOverlappingInstances dflags))
 321       || (unifiable && not (ins_item_more_specific || cur_item_more_specific))
 322       =  failMaB val
 323
 324         -- New item is an instance of current item, so drop it here
 325       | ins_item_more_specific  = returnMaB (ins_item : env)
 326
 327         -- Otherwise carry on
 328       | otherwise  = insert_into rest     `thenMaB` \ rest' ->
 329                      returnMaB (cur_item : rest')
 330       where
 331         unifiable = maybeToBool (unifyTyListsX (ins_tv_set `unionVarSet` tpl_tvs) tpl_tys ins_tys)
 332         ins_item_more_specific = maybeToBool (matchTys tpl_tvs    tpl_tys ins_tys)
 333         cur_item_more_specific = maybeToBool (matchTys ins_tv_set ins_tys tpl_tys)
 334         identical = ins_item_more_specific && cur_item_more_specific
 335 \end{code}
 336
 337