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