compiler/types/InstEnv.lhs

   1 %
   2 % (c) The University of Glasgow 2006
   3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   4 %
   5 \section[InstEnv]{Utilities for typechecking instance declarations}
   6
   7 The bits common to TcInstDcls and TcDeriv.
   8
   9 \begin{code}
  10 module InstEnv (
  11         DFunId, OverlapFlag(..),
  12         Instance(..), pprInstance, pprInstanceHdr, pprInstances,
  13         instanceHead, mkLocalInstance, mkImportedInstance,
  14         instanceDFunId, setInstanceDFunId, instanceRoughTcs,
  15
  16         InstEnv, emptyInstEnv, extendInstEnv,
  17         extendInstEnvList, lookupInstEnv, instEnvElts,
  18         classInstances,
  19         instanceCantMatch, roughMatchTcs
  20     ) where
  21
  22 #include "HsVersions.h"
  23
  24 import Class
  25 import Var
  26 import VarSet
  27 import Name
  28 import OccName
  29 import NameSet
  30 import Type
  31 import TcType
  32 import TyCon
  33 import TcGadt
  34 import Unify
  35 import Outputable
  36 import BasicTypes
  37 import UniqFM
  38 import Id
  39 import SrcLoc
  40
  41 import Data.Maybe       ( isJust, isNothing )
  42 \end{code}
  43
  44
  45 %************************************************************************
  46 %*                                                                      *
  47 \subsection{The key types}
  48 %*                                                                      *
  49 %************************************************************************
  50
  51 \begin{code}
  52 type DFunId = Id
  53 data Instance
  54   = Instance { is_cls  :: Name          -- Class name
  55
  56                 -- Used for "rough matching"; see note below
  57              , is_tcs  :: [Maybe Name]  -- Top of type args
  58
  59                 -- Used for "proper matching"; see note
  60              , is_tvs  :: TyVarSet      -- Template tyvars for full match
  61              , is_tys  :: [Type]        -- Full arg types
  62
  63              , is_dfun :: DFunId
  64              , is_flag :: OverlapFlag   -- See detailed comments with
  65                                         -- the decl of BasicTypes.OverlapFlag
  66
  67              , is_orph :: Maybe OccName }
  68 \end{code}
  69
  70 The "rough-match" fields
  71 ~~~~~~~~~~~~~~~~~~~~~~~~~
  72 The is_cls, is_args fields allow a "rough match" to be done
  73 without poking inside the DFunId.  Poking the DFunId forces
  74 us to suck in all the type constructors etc it involves,
  75 which is a total waste of time if it has no chance of matching
  76 So the Name, [Maybe Name] fields allow us to say "definitely
  77 does not match", based only on the Name.
  78
  79 In is_tcs,
  80     Nothing  means that this type arg is a type variable
  81
  82     (Just n) means that this type arg is a
  83                 TyConApp with a type constructor of n.
  84                 This is always a real tycon, never a synonym!
  85                 (Two different synonyms might match, but two
  86                 different real tycons can't.)
  87                 NB: newtypes are not transparent, though!
  88
  89 The "proper-match" fields
  90 ~~~~~~~~~~~~~~~~~~~~~~~~~
  91 The is_tvs, is_tys fields are simply cahced values, pulled
  92 out (lazily) from the dfun id. They are cached here simply so
  93 that we don't need to decompose the DFunId each time we want
  94 to match it.  The hope is that the fast-match fields mean
  95 that we often never poke th proper-match fields
  96
  97 However, note that:
  98  * is_tvs must be a superset of the free vars of is_tys
  99
 100  * The is_dfun must itself be quantified over exactly is_tvs
 101    (This is so that we can use the matching substitution to
 102     instantiate the dfun's context.)
 103
 104
 105 Note [Orphans]: the "is_orph" field
 106 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 107 An instance is an orphan if its head (after the =>) mentions
 108 nothing defined in this module.
 109
 110    Just n       The head mentions n, which is defined in this module
 111                 This is used for versioning; the instance decl is
 112                 considered part of the defn of n when computing versions
 113
 114    Nothing      The head mentions nothing defined in this module
 115
 116 If a module contains any orphans, then its interface file is read
 117 regardless, so that its instances are not missed.
 118
 119 Functional dependencies worsen the situation a bit. Consider
 120         class C a b | a -> b
 121 In some other module we might have
 122    module M where
 123         data T = ...
 124         instance C Int T where ...
 125 This isn't considered an orphan, so we will only read M's interface
 126 if something from M is used (e.g. T).  So there's a risk we'll
 127 miss the improvement from the instance.  Workaround: import M.
 128
 129 Rules are orphans and versioned in much the same way.
 130
 131 \begin{code}
 132 instanceDFunId :: Instance -> DFunId
 133 instanceDFunId = is_dfun
 134
 135 setInstanceDFunId :: Instance -> DFunId -> Instance
 136 setInstanceDFunId ispec dfun
 137    = ASSERT( idType dfun `tcEqType` idType (is_dfun ispec) )
 138         -- We need to create the cached fields afresh from
 139         -- the new dfun id.  In particular, the is_tvs in
 140         -- the Instance must match those in the dfun!
 141         -- We assume that the only thing that changes is
 142         -- the quantified type variables, so the other fields
 143         -- are ok; hence the assert
 144      ispec { is_dfun = dfun, is_tvs = mkVarSet tvs, is_tys = tys }
 145    where
 146      (tvs, _, _, tys) = tcSplitDFunTy (idType dfun)
 147
 148 instanceRoughTcs :: Instance -> [Maybe Name]
 149 instanceRoughTcs = is_tcs
 150 \end{code}
 151
 152 \begin{code}
 153 instance NamedThing Instance where
 154    getName ispec = getName (is_dfun ispec)
 155
 156 instance Outputable Instance where
 157    ppr = pprInstance
 158
 159 pprInstance :: Instance -> SDoc
 160 -- Prints the Instance as an instance declaration
 161 pprInstance ispec@(Instance { is_flag = flag })
 162   = hang (pprInstanceHdr ispec)
 163         2 (ptext SLIT("--") <+> (pprDefnLoc (getSrcLoc ispec)))
 164
 165 -- * pprInstanceHdr is used in VStudio to populate the ClassView tree
 166 pprInstanceHdr :: Instance -> SDoc
 167 -- Prints the Instance as an instance declaration
 168 pprInstanceHdr ispec@(Instance { is_flag = flag })
 169   = ptext SLIT("instance") <+> ppr flag
 170     <+> sep [pprThetaArrow theta, pprClassPred clas tys]
 171   where
 172     (_, theta, clas, tys) = instanceHead ispec
 173         -- Print without the for-all, which the programmer doesn't write
 174
 175 pprInstances :: [Instance] -> SDoc
 176 pprInstances ispecs = vcat (map pprInstance ispecs)
 177
 178 instanceHead :: Instance -> ([TyVar], [PredType], Class, [Type])
 179 instanceHead ispec = tcSplitDFunTy (idType (is_dfun ispec))
 180
 181 mkLocalInstance :: DFunId -> OverlapFlag -> Instance
 182 -- Used for local instances, where we can safely pull on the DFunId
 183 mkLocalInstance dfun oflag
 184   = Instance {  is_flag = oflag, is_dfun = dfun,
 185                 is_tvs = mkVarSet tvs, is_tys = tys,
 186                 is_cls = cls_name, is_tcs = roughMatchTcs tys,
 187                 is_orph = orph }
 188   where
 189     (tvs, _, cls, tys) = tcSplitDFunTy (idType dfun)
 190     mod = nameModule (idName dfun)
 191     cls_name = getName cls
 192     tycl_names = foldr (unionNameSets . tyClsNamesOfType)
 193                        (unitNameSet cls_name) tys
 194     orph = case filter (nameIsLocalOrFrom mod) (nameSetToList tycl_names) of
 195                 []     -> Nothing
 196                 (n:ns) -> Just (getOccName n)
 197
 198 mkImportedInstance :: Name -> [Maybe Name] -> Maybe OccName
 199                    -> DFunId -> OverlapFlag -> Instance
 200 -- Used for imported instances, where we get the rough-match stuff
 201 -- from the interface file
 202 mkImportedInstance cls mb_tcs orph dfun oflag
 203   = Instance {  is_flag = oflag, is_dfun = dfun,
 204                 is_tvs = mkVarSet tvs, is_tys = tys,
 205                 is_cls = cls, is_tcs = mb_tcs, is_orph = orph }
 206   where
 207     (tvs, _, _, tys) = tcSplitDFunTy (idType dfun)
 208
 209 roughMatchTcs :: [Type] -> [Maybe Name]
 210 roughMatchTcs tys = map rough tys
 211   where
 212     rough ty = case tcSplitTyConApp_maybe ty of
 213                   Just (tc,_) -> Just (tyConName tc)
 214                   Nothing     -> Nothing
 215
 216 instanceCantMatch :: [Maybe Name] -> [Maybe Name] -> Bool
 217 -- (instanceCantMatch tcs1 tcs2) returns True if tcs1 cannot
 218 -- possibly be instantiated to actual, nor vice versa;
 219 -- False is non-committal
 220 instanceCantMatch (Just t : ts) (Just a : as) = t/=a || instanceCantMatch ts as
 221 instanceCantMatch ts            as            =  False  -- Safe
 222 \end{code}
 223
 224
 225 Note [Overlapping instances]
 226 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 227 Overlap is permitted, but only in such a way that one can make
 228 a unique choice when looking up.  That is, overlap is only permitted if
 229 one template matches the other, or vice versa.  So this is ok:
 230
 231   [a]  [Int]
 232
 233 but this is not
 234
 235   (Int,a)  (b,Int)
 236
 237 If overlap is permitted, the list is kept most specific first, so that
 238 the first lookup is the right choice.
 239
 240
 241 For now we just use association lists.
 242
 243 \subsection{Avoiding a problem with overlapping}
 244
 245 Consider this little program:
 246
 247 \begin{pseudocode}
 248      class C a        where c :: a
 249      class C a => D a where d :: a
 250
 251      instance C Int where c = 17
 252      instance D Int where d = 13
 253
 254      instance C a => C [a] where c = [c]
 255      instance ({- C [a], -} D a) => D [a] where d = c
 256
 257      instance C [Int] where c = [37]
 258
 259      main = print (d :: [Int])
 260 \end{pseudocode}
 261
 262 What do you think `main' prints  (assuming we have overlapping instances, and
 263 all that turned on)?  Well, the instance for `D' at type `[a]' is defined to
 264 be `c' at the same type, and we've got an instance of `C' at `[Int]', so the
 265 answer is `[37]', right? (the generic `C [a]' instance shouldn't apply because
 266 the `C [Int]' instance is more specific).
 267
 268 Ghc-4.04 gives `[37]', while ghc-4.06 gives `[17]', so 4.06 is wrong.  That
 269 was easy ;-)  Let's just consult hugs for good measure.  Wait - if I use old
 270 hugs (pre-September99), I get `[17]', and stranger yet, if I use hugs98, it
 271 doesn't even compile!  What's going on!?
 272
 273 What hugs complains about is the `D [a]' instance decl.
 274
 275 \begin{pseudocode}
 276      ERROR "mj.hs" (line 10): Cannot build superclass instance
 277      *** Instance            : D [a]
 278      *** Context supplied    : D a
 279      *** Required superclass : C [a]
 280 \end{pseudocode}
 281
 282 You might wonder what hugs is complaining about.  It's saying that you
 283 need to add `C [a]' to the context of the `D [a]' instance (as appears
 284 in comments).  But there's that `C [a]' instance decl one line above
 285 that says that I can reduce the need for a `C [a]' instance to the
 286 need for a `C a' instance, and in this case, I already have the
 287 necessary `C a' instance (since we have `D a' explicitly in the
 288 context, and `C' is a superclass of `D').
 289
 290 Unfortunately, the above reasoning indicates a premature commitment to the
 291 generic `C [a]' instance.  I.e., it prematurely rules out the more specific
 292 instance `C [Int]'.  This is the mistake that ghc-4.06 makes.  The fix is to
 293 add the context that hugs suggests (uncomment the `C [a]'), effectively
 294 deferring the decision about which instance to use.
 295
 296 Now, interestingly enough, 4.04 has this same bug, but it's covered up
 297 in this case by a little known `optimization' that was disabled in
 298 4.06.  Ghc-4.04 silently inserts any missing superclass context into
 299 an instance declaration.  In this case, it silently inserts the `C
 300 [a]', and everything happens to work out.
 301
 302 (See `basicTypes/MkId:mkDictFunId' for the code in question.  Search for
 303 `Mark Jones', although Mark claims no credit for the `optimization' in
 304 question, and would rather it stopped being called the `Mark Jones
 305 optimization' ;-)
 306
 307 So, what's the fix?  I think hugs has it right.  Here's why.  Let's try
 308 something else out with ghc-4.04.  Let's add the following line:
 309
 310     d' :: D a => [a]
 311     d' = c
 312
 313 Everyone raise their hand who thinks that `d :: [Int]' should give a
 314 different answer from `d' :: [Int]'.  Well, in ghc-4.04, it does.  The
 315 `optimization' only applies to instance decls, not to regular
 316 bindings, giving inconsistent behavior.
 317
 318 Old hugs had this same bug.  Here's how we fixed it: like GHC, the
 319 list of instances for a given class is ordered, so that more specific
 320 instances come before more generic ones.  For example, the instance
 321 list for C might contain:
 322     ..., C Int, ..., C a, ...
 323 When we go to look for a `C Int' instance we'll get that one first.
 324 But what if we go looking for a `C b' (`b' is unconstrained)?  We'll
 325 pass the `C Int' instance, and keep going.  But if `b' is
 326 unconstrained, then we don't know yet if the more specific instance
 327 will eventually apply.  GHC keeps going, and matches on the generic `C
 328 a'.  The fix is to, at each step, check to see if there's a reverse
 329 match, and if so, abort the search.  This prevents hugs from
 330 prematurely chosing a generic instance when a more specific one
 331 exists.
 332
 333 --Jeff
 334
 335 BUT NOTE [Nov 2001]: we must actually *unify* not reverse-match in
 336 this test.  Suppose the instance envt had
 337     ..., forall a b. C a a b, ..., forall a b c. C a b c, ...
 338 (still most specific first)
 339 Now suppose we are looking for (C x y Int), where x and y are unconstrained.
 340         C x y Int  doesn't match the template {a,b} C a a b
 341 but neither does
 342         C a a b  match the template {x,y} C x y Int
 343 But still x and y might subsequently be unified so they *do* match.
 344
 345 Simple story: unify, don't match.
 346
 347
 348 %************************************************************************
 349 %*                                                                      *
 350                 InstEnv, ClsInstEnv
 351 %*                                                                      *
 352 %************************************************************************
 353
 354 A @ClsInstEnv@ all the instances of that class.  The @Id@ inside a
 355 ClsInstEnv mapping is the dfun for that instance.
 356
 357 If class C maps to a list containing the item ([a,b], [t1,t2,t3], dfun), then
 358
 359         forall a b, C t1 t2 t3  can be constructed by dfun
 360
 361 or, to put it another way, we have
 362
 363         instance (...) => C t1 t2 t3,  witnessed by dfun
 364
 365 \begin{code}
 366 ---------------------------------------------------
 367 type InstEnv = UniqFM ClsInstEnv        -- Maps Class to instances for that class
 368
 369 data ClsInstEnv
 370   = ClsIE [Instance]    -- The instances for a particular class, in any order
 371           Bool          -- True <=> there is an instance of form C a b c
 372                         --      If *not* then the common case of looking up
 373                         --      (C a b c) can fail immediately
 374
 375 -- INVARIANTS:
 376 --  * The is_tvs are distinct in each Instance
 377 --      of a ClsInstEnv (so we can safely unify them)
 378
 379 -- Thus, the @ClassInstEnv@ for @Eq@ might contain the following entry:
 380 --      [a] ===> dfun_Eq_List :: forall a. Eq a => Eq [a]
 381 -- The "a" in the pattern must be one of the forall'd variables in
 382 -- the dfun type.
 383
 384 emptyInstEnv :: InstEnv
 385 emptyInstEnv = emptyUFM
 386
 387 instEnvElts :: InstEnv -> [Instance]
 388 instEnvElts ie = [elt | ClsIE elts _ <- eltsUFM ie, elt <- elts]
 389
 390 classInstances :: (InstEnv,InstEnv) -> Class -> [Instance]
 391 classInstances (pkg_ie, home_ie) cls
 392   = get home_ie ++ get pkg_ie
 393   where
 394     get env = case lookupUFM env cls of
 395                 Just (ClsIE insts _) -> insts
 396                 Nothing              -> []
 397
 398 extendInstEnvList :: InstEnv -> [Instance] -> InstEnv
 399 extendInstEnvList inst_env ispecs = foldl extendInstEnv inst_env ispecs
 400
 401 extendInstEnv :: InstEnv -> Instance -> InstEnv
 402 extendInstEnv inst_env ins_item@(Instance { is_cls = cls_nm, is_tcs = mb_tcs })
 403   = addToUFM_C add inst_env cls_nm (ClsIE [ins_item] ins_tyvar)
 404   where
 405     add (ClsIE cur_insts cur_tyvar) _ = ClsIE (ins_item : cur_insts)
 406                                               (ins_tyvar || cur_tyvar)
 407     ins_tyvar = not (any isJust mb_tcs)
 408 \end{code}
 409
 410
 411 %************************************************************************
 412 %*                                                                      *
 413 \subsection{Looking up an instance}
 414 %*                                                                      *
 415 %************************************************************************
 416
 417 @lookupInstEnv@ looks up in a @InstEnv@, using a one-way match.  Since
 418 the env is kept ordered, the first match must be the only one.  The
 419 thing we are looking up can have an arbitrary "flexi" part.
 420
 421 \begin{code}
 422 lookupInstEnv :: (InstEnv       -- External package inst-env
 423                  ,InstEnv)      -- Home-package inst-env
 424               -> Class -> [Type]                -- What we are looking for
 425               -> ([(TvSubst, Instance)],        -- Successful matches
 426                   [Instance])                   -- These don't match but do unify
 427         -- The second component of the tuple happens when we look up
 428         --      Foo [a]
 429         -- in an InstEnv that has entries for
 430         --      Foo [Int]
 431         --      Foo [b]
 432         -- Then which we choose would depend on the way in which 'a'
 433         -- is instantiated.  So we report that Foo [b] is a match (mapping b->a)
 434         -- but Foo [Int] is a unifier.  This gives the caller a better chance of
 435         -- giving a suitable error messagen
 436
 437 lookupInstEnv (pkg_ie, home_ie) cls tys
 438   = (pruned_matches, all_unifs)
 439   where
 440     rough_tcs  = roughMatchTcs tys
 441     all_tvs    = all isNothing rough_tcs
 442     (home_matches, home_unifs) = lookup home_ie
 443     (pkg_matches,  pkg_unifs)  = lookup pkg_ie
 444     all_matches = home_matches ++ pkg_matches
 445     all_unifs   = home_unifs   ++ pkg_unifs
 446     pruned_matches
 447         | null all_unifs = foldr insert_overlapping [] all_matches
 448         | otherwise      = all_matches  -- Non-empty unifs is always an error situation,
 449                                         -- so don't attempt to pune the matches
 450
 451     --------------
 452     lookup env = case lookupUFM env cls of
 453                    Nothing -> ([],[])   -- No instances for this class
 454                    Just (ClsIE insts has_tv_insts)
 455                         | all_tvs && not has_tv_insts
 456                         -> ([],[])      -- Short cut for common case
 457                         -- The thing we are looking up is of form (C a b c), and
 458                         -- the ClsIE has no instances of that form, so don't bother to search
 459
 460                         | otherwise
 461                         -> find [] [] insts
 462
 463     --------------
 464     find ms us [] = (ms, us)
 465     find ms us (item@(Instance { is_tcs = mb_tcs, is_tvs = tpl_tvs,
 466                                  is_tys = tpl_tys, is_flag = oflag,
 467                                  is_dfun = dfun }) : rest)
 468         -- Fast check for no match, uses the "rough match" fields
 469       | instanceCantMatch rough_tcs mb_tcs
 470       = find ms us rest
 471
 472       | Just subst <- tcMatchTys tpl_tvs tpl_tys tys
 473       = find ((subst,item):ms) us rest
 474
 475         -- Does not match, so next check whether the things unify
 476         -- See Note [overlapping instances] above
 477       | Incoherent <- oflag
 478       = find ms us rest
 479
 480       | otherwise
 481       = ASSERT2( tyVarsOfTypes tys `disjointVarSet` tpl_tvs,
 482                  (ppr cls <+> ppr tys <+> ppr all_tvs) $$
 483                  (ppr dfun <+> ppr tpl_tvs <+> ppr tpl_tys)
 484                 )
 485                 -- Unification will break badly if the variables overlap
 486                 -- They shouldn't because we allocate separate uniques for them
 487         case tcUnifyTys bind_fn tpl_tys tys of
 488             Just _   -> find ms (item:us) rest
 489             Nothing  -> find ms us         rest
 490
 491 ---------------
 492 bind_fn tv | isTcTyVar tv && isExistentialTyVar tv = Skolem
 493            | otherwise                             = BindMe
 494         -- The key_tys can contain skolem constants, and we can guarantee that those
 495         -- are never going to be instantiated to anything, so we should not involve
 496         -- them in the unification test.  Example:
 497         --      class Foo a where { op :: a -> Int }
 498         --      instance Foo a => Foo [a]       -- NB overlap
 499         --      instance Foo [Int]              -- NB overlap
 500         --      data T = forall a. Foo a => MkT a
 501         --      f :: T -> Int
 502         --      f (MkT x) = op [x,x]
 503         -- The op [x,x] means we need (Foo [a]).  Without the filterVarSet we'd
 504         -- complain, saying that the choice of instance depended on the instantiation
 505         -- of 'a'; but of course it isn't *going* to be instantiated.
 506         --
 507         -- We do this only for pattern-bound skolems.  For example we reject
 508         --      g :: forall a => [a] -> Int
 509         --      g x = op x
 510         -- on the grounds that the correct instance depends on the instantiation of 'a'
 511
 512 ---------------
 513 insert_overlapping :: (TvSubst, Instance) -> [(TvSubst, Instance)]
 514                    -> [(TvSubst, Instance)]
 515 -- Add a new solution, knocking out strictly less specific ones
 516 insert_overlapping new_item [] = [new_item]
 517 insert_overlapping new_item (item:items)
 518   | new_beats_old && old_beats_new = item : insert_overlapping new_item items
 519         -- Duplicate => keep both for error report
 520   | new_beats_old = insert_overlapping new_item items
 521         -- Keep new one
 522   | old_beats_new = item : items
 523         -- Keep old one
 524   | otherwise     = item : insert_overlapping new_item items
 525         -- Keep both
 526   where
 527     new_beats_old = new_item `beats` item
 528     old_beats_new = item `beats` new_item
 529
 530     (_, instA) `beats` (_, instB)
 531         = overlap_ok &&
 532           isJust (tcMatchTys (is_tvs instB) (is_tys instB) (is_tys instA))
 533                 -- A beats B if A is more specific than B, and B admits overlap
 534                 -- I.e. if B can be instantiated to match A
 535         where
 536           overlap_ok = case is_flag instB of
 537                         NoOverlap -> False
 538                         other     -> True
 539 \end{code}
 540