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, pprInstEnv,
  13         lookupInstEnv, InstLookupResult(..),
  14         classInstEnv, simpleDFunClassTyCon
  15     ) where
  16
  17 #include "HsVersions.h"
  18
  19 import Class            ( Class, classTvsFds )
  20 import Var              ( TyVar, Id )
  21 import VarSet
  22 import VarEnv
  23 import Maybes           ( MaybeErr(..), returnMaB, failMaB, thenMaB, maybeToBool )
  24 import Name             ( getSrcLoc, nameModule )
  25 import SrcLoc           ( isGoodSrcLoc )
  26 import TcType           ( Type, tcTyConAppTyCon, mkTyVarTy,
  27                           tcSplitDFunTy, tyVarsOfTypes,
  28                           matchTys, unifyTyListsX, allDistinctTyVars
  29                         )
  30 import PprType          ( pprClassPred )
  31 import FunDeps          ( checkClsFD )
  32 import TyCon            ( TyCon )
  33 import Outputable
  34 import UniqFM           ( UniqFM, lookupWithDefaultUFM, addToUFM, emptyUFM, eltsUFM )
  35 import Id               ( idType, idName )
  36 import ErrUtils         ( Message )
  37 import CmdLineOpts
  38 import Util             ( notNull )
  39 \end{code}
  40
  41
  42 %************************************************************************
  43 %*                                                                      *
  44 \subsection{The key types}
  45 %*                                                                      *
  46 %************************************************************************
  47
  48 \begin{code}
  49 type DFunId     = Id
  50
  51 type InstEnv    = UniqFM ClsInstEnv             -- Maps Class to instances for that class
  52
  53 simpleDFunClassTyCon :: DFunId -> (Class, TyCon)
  54 simpleDFunClassTyCon dfun
  55   = (clas, tycon)
  56   where
  57     (_,_,clas,[ty]) = tcSplitDFunTy (idType dfun)
  58     tycon           = tcTyConAppTyCon ty
  59
  60 pprInstEnv :: InstEnv -> SDoc
  61 pprInstEnv env
  62   = vcat [ brackets (pprWithCommas ppr (varSetElems tyvars)) <+>
  63            brackets (pprWithCommas ppr tys) <+> ppr dfun
  64          | cls_inst_env <-  eltsUFM env
  65          , (tyvars, tys, dfun) <- cls_inst_env
  66          ]
  67 \end{code}
  68
  69 %************************************************************************
  70 %*                                                                      *
  71 \subsection{Instance environments: InstEnv and ClsInstEnv}
  72 %*                                                                      *
  73 %************************************************************************
  74
  75 \begin{code}
  76 type ClsInstEnv = [(TyVarSet, [Type], DFunId)]  -- The instances for a particular class
  77         -- INVARIANTs: see notes below
  78
  79 emptyInstEnv :: InstEnv
  80 emptyInstEnv = emptyUFM
  81
  82 classInstEnv :: InstEnv -> Class -> ClsInstEnv
  83 classInstEnv env cls = lookupWithDefaultUFM env [] cls
  84 \end{code}
  85
  86 A @ClsInstEnv@ all the instances of that class.  The @Id@ inside a
  87 ClsInstEnv mapping is the dfun for that instance.
  88
  89 If class C maps to a list containing the item ([a,b], [t1,t2,t3], dfun), then
  90
  91         forall a b, C t1 t2 t3  can be constructed by dfun
  92
  93 or, to put it another way, we have
  94
  95         instance (...) => C t1 t2 t3,  witnessed by dfun
  96
  97 There is an important consistency constraint in the elements of a ClsInstEnv:
  98
  99   * [a,b] must be a superset of the free vars of [t1,t2,t3]
 100
 101   * The dfun must itself be quantified over [a,b]
 102
 103   * More specific instances come before less specific ones,
 104     where they overlap
 105
 106 Thus, the @ClassInstEnv@ for @Eq@ might contain the following entry:
 107         [a] ===> dfun_Eq_List :: forall a. Eq a => Eq [a]
 108 The "a" in the pattern must be one of the forall'd variables in
 109 the dfun type.
 110
 111
 112
 113 Notes on overlapping instances
 114 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 115 In some ClsInstEnvs, overlap is prohibited; that is, no pair of templates unify.
 116
 117 In others, overlap is permitted, but only in such a way that one can make
 118 a unique choice when looking up.  That is, overlap is only permitted if
 119 one template matches the other, or vice versa.  So this is ok:
 120
 121   [a]  [Int]
 122
 123 but this is not
 124
 125   (Int,a)  (b,Int)
 126
 127 If overlap is permitted, the list is kept most specific first, so that
 128 the first lookup is the right choice.
 129
 130
 131 For now we just use association lists.
 132
 133 \subsection{Avoiding a problem with overlapping}
 134
 135 Consider this little program:
 136
 137 \begin{pseudocode}
 138      class C a        where c :: a
 139      class C a => D a where d :: a
 140
 141      instance C Int where c = 17
 142      instance D Int where d = 13
 143
 144      instance C a => C [a] where c = [c]
 145      instance ({- C [a], -} D a) => D [a] where d = c
 146
 147      instance C [Int] where c = [37]
 148
 149      main = print (d :: [Int])
 150 \end{pseudocode}
 151
 152 What do you think `main' prints  (assuming we have overlapping instances, and
 153 all that turned on)?  Well, the instance for `D' at type `[a]' is defined to
 154 be `c' at the same type, and we've got an instance of `C' at `[Int]', so the
 155 answer is `[37]', right? (the generic `C [a]' instance shouldn't apply because
 156 the `C [Int]' instance is more specific).
 157
 158 Ghc-4.04 gives `[37]', while ghc-4.06 gives `[17]', so 4.06 is wrong.  That
 159 was easy ;-)  Let's just consult hugs for good measure.  Wait - if I use old
 160 hugs (pre-September99), I get `[17]', and stranger yet, if I use hugs98, it
 161 doesn't even compile!  What's going on!?
 162
 163 What hugs complains about is the `D [a]' instance decl.
 164
 165 \begin{pseudocode}
 166      ERROR "mj.hs" (line 10): Cannot build superclass instance
 167      *** Instance            : D [a]
 168      *** Context supplied    : D a
 169      *** Required superclass : C [a]
 170 \end{pseudocode}
 171
 172 You might wonder what hugs is complaining about.  It's saying that you
 173 need to add `C [a]' to the context of the `D [a]' instance (as appears
 174 in comments).  But there's that `C [a]' instance decl one line above
 175 that says that I can reduce the need for a `C [a]' instance to the
 176 need for a `C a' instance, and in this case, I already have the
 177 necessary `C a' instance (since we have `D a' explicitly in the
 178 context, and `C' is a superclass of `D').
 179
 180 Unfortunately, the above reasoning indicates a premature commitment to the
 181 generic `C [a]' instance.  I.e., it prematurely rules out the more specific
 182 instance `C [Int]'.  This is the mistake that ghc-4.06 makes.  The fix is to
 183 add the context that hugs suggests (uncomment the `C [a]'), effectively
 184 deferring the decision about which instance to use.
 185
 186 Now, interestingly enough, 4.04 has this same bug, but it's covered up
 187 in this case by a little known `optimization' that was disabled in
 188 4.06.  Ghc-4.04 silently inserts any missing superclass context into
 189 an instance declaration.  In this case, it silently inserts the `C
 190 [a]', and everything happens to work out.
 191
 192 (See `basicTypes/MkId:mkDictFunId' for the code in question.  Search for
 193 `Mark Jones', although Mark claims no credit for the `optimization' in
 194 question, and would rather it stopped being called the `Mark Jones
 195 optimization' ;-)
 196
 197 So, what's the fix?  I think hugs has it right.  Here's why.  Let's try
 198 something else out with ghc-4.04.  Let's add the following line:
 199
 200     d' :: D a => [a]
 201     d' = c
 202
 203 Everyone raise their hand who thinks that `d :: [Int]' should give a
 204 different answer from `d' :: [Int]'.  Well, in ghc-4.04, it does.  The
 205 `optimization' only applies to instance decls, not to regular
 206 bindings, giving inconsistent behavior.
 207
 208 Old hugs had this same bug.  Here's how we fixed it: like GHC, the
 209 list of instances for a given class is ordered, so that more specific
 210 instances come before more generic ones.  For example, the instance
 211 list for C might contain:
 212     ..., C Int, ..., C a, ...
 213 When we go to look for a `C Int' instance we'll get that one first.
 214 But what if we go looking for a `C b' (`b' is unconstrained)?  We'll
 215 pass the `C Int' instance, and keep going.  But if `b' is
 216 unconstrained, then we don't know yet if the more specific instance
 217 will eventually apply.  GHC keeps going, and matches on the generic `C
 218 a'.  The fix is to, at each step, check to see if there's a reverse
 219 match, and if so, abort the search.  This prevents hugs from
 220 prematurely chosing a generic instance when a more specific one
 221 exists.
 222
 223 --Jeff
 224
 225 BUT NOTE [Nov 2001]: we must actually *unify* not reverse-match in
 226 this test.  Suppose the instance envt had
 227     ..., forall a b. C a a b, ..., forall a b c. C a b c, ...
 228 (still most specific first)
 229 Now suppose we are looking for (C x y Int), where x and y are unconstrained.
 230         C x y Int  doesn't match the template {a,b} C a a b
 231 but neither does
 232         C a a b  match the template {x,y} C x y Int
 233 But still x and y might subsequently be unified so they *do* match.
 234
 235 Simple story: unify, don't match.
 236
 237
 238 %************************************************************************
 239 %*                                                                      *
 240 \subsection{Looking up an instance}
 241 %*                                                                      *
 242 %************************************************************************
 243
 244 @lookupInstEnv@ looks up in a @InstEnv@, using a one-way match.  Since
 245 the env is kept ordered, the first match must be the only one.  The
 246 thing we are looking up can have an arbitrary "flexi" part.
 247
 248 \begin{code}
 249 lookupInstEnv :: DynFlags
 250               -> InstEnv                -- The envt
 251               -> Class -> [Type]        -- What we are looking for
 252               -> InstLookupResult
 253
 254 data InstLookupResult
 255   = FoundInst                   -- There is a (template,substitution) pair
 256                                 -- that makes the template match the key,
 257                                 -- and no template is an instance of the key
 258         TyVarSubstEnv Id
 259
 260   | NoMatch Bool        -- Boolean is true iff there is at least one
 261                         -- template that matches the key.
 262                         -- (but there are other template(s) that are
 263                         --  instances of the key, so we don't report
 264                         --  FoundInst)
 265         -- The NoMatch True case happens when we look up
 266         --      Foo [a]
 267         -- in an InstEnv that has entries for
 268         --      Foo [Int]
 269         --      Foo [b]
 270         -- Then which we choose would depend on the way in which 'a'
 271         -- is instantiated.  So we say there is no match, but identify
 272         -- it as ambiguous case in the hope of giving a better error msg.
 273         -- See the notes above from Jeff Lewis
 274
 275 lookupInstEnv dflags env key_cls key_tys
 276   = find (classInstEnv env key_cls)
 277   where
 278     key_vars = tyVarsOfTypes key_tys
 279
 280     find [] = NoMatch False
 281     find ((tpl_tyvars, tpl, dfun_id) : rest)
 282       = case matchTys tpl_tyvars tpl key_tys of
 283           Nothing                 ->
 284                 -- Check whether the things unify, so that
 285                 -- we bale out if a later instantiation of this
 286                 -- predicate might match this instance
 287                 -- [see notes about overlapping instances above]
 288             case unifyTyListsX (key_vars `unionVarSet` tpl_tyvars) key_tys tpl of
 289               Just _ | not (dopt Opt_AllowIncoherentInstances dflags)
 290                      -> NoMatch (any_match rest)
 291                 -- If we allow incoherent instances we don't worry about the
 292                 -- test and just blaze on anyhow.  Requested by John Hughes.
 293               other  -> find rest
 294
 295           Just (subst, leftovers) -> ASSERT( null leftovers )
 296                                      FoundInst subst dfun_id
 297
 298     any_match rest = or [ maybeToBool (matchTys tvs tpl key_tys)
 299                         | (tvs,tpl,_) <- rest
 300                         ]
 301 \end{code}
 302
 303
 304 %************************************************************************
 305 %*                                                                      *
 306 \subsection{Extending an instance environment}
 307 %*                                                                      *
 308 %************************************************************************
 309
 310 @extendInstEnv@ extends a @ClsInstEnv@, checking for overlaps.
 311
 312 A boolean flag controls overlap reporting.
 313
 314 True => overlap is permitted, but only if one template matches the other;
 315         not if they unify but neither is
 316
 317 \begin{code}
 318 extendInstEnv :: DynFlags -> InstEnv -> [DFunId] -> (InstEnv, [Message])
 319   -- Similar, but all we have is the DFuns
 320 extendInstEnv dflags env dfun_ids = foldl (addToInstEnv dflags) (env, []) dfun_ids
 321
 322
 323 addToInstEnv :: DynFlags
 324              -> (InstEnv, [Message])
 325              -> DFunId
 326              -> (InstEnv, [Message])    -- Resulting InstEnv and augmented error messages
 327
 328 addToInstEnv dflags (inst_env, errs) dfun_id
 329         -- Check first that the new instance doesn't
 330         -- conflict with another.  See notes below about fundeps.
 331   | notNull bad_fundeps
 332   = (inst_env, fundep_err : errs)               -- Bad fundeps; report the first only
 333
 334   | otherwise
 335   = case insert_into cls_inst_env of
 336         Failed err        -> (inst_env, err : errs)
 337         Succeeded new_env -> (addToUFM inst_env clas new_env, errs)
 338
 339   where
 340     cls_inst_env = classInstEnv inst_env clas
 341     (ins_tvs, _, clas, ins_tys) = tcSplitDFunTy (idType dfun_id)
 342     bad_fundeps = badFunDeps cls_inst_env clas ins_tv_set ins_tys
 343     fundep_err  = fundepErr dfun_id (head bad_fundeps)
 344
 345     ins_tv_set = mkVarSet ins_tvs
 346     ins_item   = (ins_tv_set, ins_tys, dfun_id)
 347
 348     insert_into [] = returnMaB [ins_item]
 349     insert_into env@(cur_item@(tpl_tvs, tpl_tys, tpl_dfun_id) : rest)
 350       = case unifyTyListsX (ins_tv_set `unionVarSet` tpl_tvs) tpl_tys ins_tys of
 351           Just subst -> insert_unifiable env subst
 352           Nothing    -> carry_on cur_item rest
 353
 354     carry_on cur_item rest = insert_into rest     `thenMaB` \ rest' ->
 355                              returnMaB (cur_item : rest')
 356
 357             -- The two templates unify.  This is acceptable iff
 358             -- (a) -fallow-overlapping-instances is on
 359             -- (b) one is strictly more specific than the other
 360             -- [It's bad if they are identical or incomparable]
 361     insert_unifiable env@(cur_item@(tpl_tvs, tpl_tys, tpl_dfun_id) : rest) subst
 362       |  ins_item_more_specific && cur_item_more_specific
 363       =         -- Duplicates
 364         failMaB (dupInstErr dfun_id tpl_dfun_id)
 365
 366       |  not (dopt Opt_AllowOverlappingInstances dflags)
 367       || not (ins_item_more_specific || cur_item_more_specific)
 368       =         -- Overlap illegal, or the two are incomparable
 369          failMaB (overlapErr dfun_id tpl_dfun_id)
 370
 371       | otherwise
 372       =         -- OK, it's acceptable.  Remaining question is whether
 373                 -- we drop it here or compare it with others
 374         if ins_item_more_specific then
 375                 -- New item is an instance of current item, so drop it here
 376             returnMaB (ins_item : env)
 377         else
 378             carry_on cur_item rest
 379
 380       where
 381         ins_item_more_specific = allVars subst ins_tvs
 382         cur_item_more_specific = allVars subst (varSetElems tpl_tvs)
 383
 384 allVars :: TyVarSubstEnv -> [TyVar] -> Bool
 385 -- True iff all the type vars are mapped to distinct type vars
 386 allVars subst tvs
 387   = allDistinctTyVars (map lookup tvs) emptyVarSet
 388   where
 389     lookup tv = case lookupSubstEnv subst tv of
 390                   Just (DoneTy ty) -> ty
 391                   Nothing          -> mkTyVarTy tv
 392 \end{code}
 393
 394 Functional dependencies
 395 ~~~~~~~~~~~~~~~~~~~~~~~
 396 Here is the bad case:
 397         class C a b | a->b where ...
 398         instance C Int Bool where ...
 399         instance C Int Char where ...
 400
 401 The point is that a->b, so Int in the first parameter must uniquely
 402 determine the second.  In general, given the same class decl, and given
 403
 404         instance C s1 s2 where ...
 405         instance C t1 t2 where ...
 406
 407 Then the criterion is: if U=unify(s1,t1) then U(s2) = U(t2).
 408
 409 Matters are a little more complicated if there are free variables in
 410 the s2/t2.
 411
 412         class D a b c | a -> b
 413         instance D a b => D [(a,a)] [b] Int
 414         instance D a b => D [a]     [b] Bool
 415
 416 The instance decls don't overlap, because the third parameter keeps
 417 them separate.  But we want to make sure that given any constraint
 418         D s1 s2 s3
 419 if s1 matches
 420
 421
 422
 423
 424 \begin{code}
 425 badFunDeps :: ClsInstEnv -> Class
 426            -> TyVarSet -> [Type]        -- Proposed new instance type
 427            -> [DFunId]
 428 badFunDeps cls_inst_env clas ins_tv_set ins_tys
 429   = [ dfun_id | fd <- fds,
 430                (tvs, tys, dfun_id) <- cls_inst_env,
 431                notNull (checkClsFD (tvs `unionVarSet` ins_tv_set) fd clas_tvs tys ins_tys)
 432     ]
 433   where
 434     (clas_tvs, fds) = classTvsFds clas
 435 \end{code}
 436
 437
 438 \begin{code}
 439 dupInstErr dfun1 dfun2 = addInstErr (ptext SLIT("Duplicate instance declarations:"))  dfun1 dfun2
 440 overlapErr dfun1 dfun2 = addInstErr (ptext SLIT("Overlapping instance declarations:")) dfun1 dfun2
 441 fundepErr  dfun1 dfun2 = addInstErr (ptext SLIT("Functional dependencies conflict between instance declarations:"))
 442                                     dfun1 dfun2
 443
 444 addInstErr what dfun1 dfun2
 445  = hang what 2 (ppr_dfun dfun1 $$ ppr_dfun dfun2)
 446   where
 447     ppr_dfun dfun = pp_loc <> colon <+> pprClassPred clas tys
 448       where
 449         (_,_,clas,tys) = tcSplitDFunTy (idType dfun)
 450         loc = getSrcLoc dfun
 451         mod = nameModule (idName dfun)
 452
 453         -- Worth trying to print a good location... imported dfuns
 454         -- don't have a useful SrcLoc but we can say which module they come from
 455         pp_loc | isGoodSrcLoc loc = ppr loc
 456                | otherwise        = ptext SLIT("In module") <+> ppr mod
 457 \end{code}