ghc/compiler/types/InstEnv.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
   3 %
   4 \section{Class Instance environments}
   5
   6 \begin{code}
   7 module InstEnv (
   8         InstEnv, emptyInstEnv,  addToInstEnv, lookupInstEnv
   9     ) where
  10
  11 #include "HsVersions.h"
  12
  13 import Var              ( TyVar, Id )
  14 import VarSet
  15 import VarEnv           ( TyVarSubstEnv )
  16 import Type             ( Type, tyVarsOfTypes )
  17 import Unify            ( unifyTyListsX, matchTys )
  18 import Outputable
  19 import Maybes
  20 \end{code}
  21
  22
  23 %************************************************************************
  24 %*                                                                      *
  25 \section{InstEnv}
  26 %*                                                                      *
  27 %************************************************************************
  28
  29 \begin{code}
  30 type InstEnv = [(TyVarSet, [Type], Id)]
  31 \end{code}
  32
  33 In some InstEnvs overlap is prohibited; that is, no pair of templates unify.
  34
  35 In others, overlap is permitted, but only in such a way that one can make
  36 a unique choice when looking up.  That is, overlap is only permitted if
  37 one template matches the other, or vice versa.  So this is ok:
  38
  39   [a]  [Int]
  40
  41 but this is not
  42
  43   (Int,a)  (b,Int)
  44
  45 If overlap is permitted, the list is kept most specific first, so that
  46 the first lookup is the right choice.
  47
  48
  49 For now we just use association lists.
  50
  51 \subsection{Avoiding a problem with overlapping}
  52
  53 Consider this little program:
  54
  55 \begin{pseudocode}
  56      class C a        where c :: a
  57      class C a => D a where d :: a
  58
  59      instance C Int where c = 17
  60      instance D Int where d = 13
  61
  62      instance C a => C [a] where c = [c]
  63      instance ({- C [a], -} D a) => D [a] where d = c
  64
  65      instance C [Int] where c = [37]
  66
  67      main = print (d :: [Int])
  68 \end{pseudocode}
  69
  70 What do you think `main' prints  (assuming we have overlapping instances, and
  71 all that turned on)?  Well, the instance for `D' at type `[a]' is defined to
  72 be `c' at the same type, and we've got an instance of `C' at `[Int]', so the
  73 answer is `[37]', right? (the generic `C [a]' instance shouldn't apply because
  74 the `C [Int]' instance is more specific).
  75
  76 Ghc-4.04 gives `[37]', while ghc-4.06 gives `[17]', so 4.06 is wrong.  That
  77 was easy ;-)  Let's just consult hugs for good measure.  Wait - if I use old
  78 hugs (pre-September99), I get `[17]', and stranger yet, if I use hugs98, it
  79 doesn't even compile!  What's going on!?
  80
  81 What hugs complains about is the `D [a]' instance decl.
  82
  83 \begin{pseudocode}
  84      ERROR "mj.hs" (line 10): Cannot build superclass instance
  85      *** Instance            : D [a]
  86      *** Context supplied    : D a
  87      *** Required superclass : C [a]
  88 \end{pseudocode}
  89
  90 You might wonder what hugs is complaining about.  It's saying that you
  91 need to add `C [a]' to the context of the `D [a]' instance (as appears
  92 in comments).  But there's that `C [a]' instance decl one line above
  93 that says that I can reduce the need for a `C [a]' instance to the
  94 need for a `C a' instance, and in this case, I already have the
  95 necessary `C a' instance (since we have `D a' explicitly in the
  96 context, and `C' is a superclass of `D').
  97
  98 Unfortunately, the above reasoning indicates a premature commitment to the
  99 generic `C [a]' instance.  I.e., it prematurely rules out the more specific
 100 instance `C [Int]'.  This is the mistake that ghc-4.06 makes.  The fix is to
 101 add the context that hugs suggests (uncomment the `C [a]'), effectively
 102 deferring the decision about which instance to use.
 103
 104 Now, interestingly enough, 4.04 has this same bug, but it's covered up
 105 in this case by a little known `optimization' that was disabled in
 106 4.06.  Ghc-4.04 silently inserts any missing superclass context into
 107 an instance declaration.  In this case, it silently inserts the `C
 108 [a]', and everything happens to work out.
 109
 110 (See `basicTypes/MkId:mkDictFunId' for the code in question.  Search for
 111 `Mark Jones', although Mark claims no credit for the `optimization' in
 112 question, and would rather it stopped being called the `Mark Jones
 113 optimization' ;-)
 114
 115 So, what's the fix?  I think hugs has it right.  Here's why.  Let's try
 116 something else out with ghc-4.04.  Let's add the following line:
 117
 118     d' :: D a => [a]
 119     d' = c
 120
 121 Everyone raise their hand who thinks that `d :: [Int]' should give a
 122 different answer from `d' :: [Int]'.  Well, in ghc-4.04, it does.  The
 123 `optimization' only applies to instance decls, not to regular
 124 bindings, giving inconsistent behavior.
 125
 126 Old hugs had this same bug.  Here's how we fixed it: like GHC, the
 127 list of instances for a given class is ordered, so that more specific
 128 instances come before more generic ones.  For example, the instance
 129 list for C might contain:
 130     ..., C Int, ..., C a, ...
 131 When we go to look for a `C Int' instance we'll get that one first.
 132 But what if we go looking for a `C b' (`b' is unconstrained)?  We'll
 133 pass the `C Int' instance, and keep going.  But if `b' is
 134 unconstrained, then we don't know yet if the more specific instance
 135 will eventually apply.  GHC keeps going, and matches on the generic `C
 136 a'.  The fix is to, at each step, check to see if there's a reverse
 137 match, and if so, abort the search.  This prevents hugs from
 138 prematurely chosing a generic instance when a more specific one
 139 exists.
 140
 141 --Jeff
 142
 143 \begin{code}
 144 emptyInstEnv :: InstEnv
 145 emptyInstEnv = []
 146
 147 isEmptyInstEnv env = null env
 148 \end{code}
 149
 150 @lookupInstEnv@ looks up in a @InstEnv@, using a one-way match.  Since the env is kept
 151 ordered, the first match must be the only one.
 152 The thing we are looking up can have an
 153 arbitrary "flexi" part.
 154
 155 \begin{code}
 156 lookupInstEnv :: SDoc           -- For error report
 157               -> InstEnv        -- The envt
 158               -> [Type]         -- Key
 159               -> Maybe (TyVarSubstEnv, Id)
 160
 161 lookupInstEnv doc env key
 162   = find env
 163   where
 164     key_vars = tyVarsOfTypes key
 165     find [] = Nothing
 166     find ((tpl_tyvars, tpl, val) : rest)
 167       = case matchTys tpl_tyvars tpl key of
 168           Nothing                 ->
 169             case matchTys key_vars key tpl of
 170               Nothing             -> find rest
 171               Just (_, _)         -> Nothing
 172           Just (subst, leftovers) -> ASSERT( null leftovers )
 173                                      Just (subst, val)
 174 \end{code}
 175
 176 @addToInstEnv@ extends a @InstEnv@, checking for overlaps.
 177
 178 A boolean flag controls overlap reporting.
 179
 180 True => overlap is permitted, but only if one template matches the other;
 181         not if they unify but neither is
 182
 183 \begin{code}
 184 addToInstEnv :: Bool                            -- True <=> overlap permitted
 185              -> InstEnv                         -- Envt
 186              -> [TyVar] -> [Type] -> Id         -- New item
 187              -> MaybeErr InstEnv                -- Success...
 188                          ([Type], Id)           -- Failure: Offending overlap
 189
 190 addToInstEnv overlap_ok env ins_tvs ins_tys value
 191   = insert env
 192   where
 193     ins_tv_set = mkVarSet ins_tvs
 194     ins_item = (ins_tv_set, ins_tys, value)
 195
 196     insert [] = returnMaB [ins_item]
 197     insert env@(cur_item@(tpl_tvs, tpl_tys, val) : rest)
 198
 199         -- FAIL if:
 200         -- (a) they are the same, or
 201         -- (b) they unify, and any sort of overlap is prohibited,
 202         -- (c) they unify but neither is more specific than t'other
 203       |  identical
 204       || (unifiable && not overlap_ok)
 205       || (unifiable && not (ins_item_more_specific || cur_item_more_specific))
 206       =  failMaB (tpl_tys, val)
 207
 208         -- New item is an instance of current item, so drop it here
 209       | ins_item_more_specific  = returnMaB (ins_item : env)
 210
 211         -- Otherwise carry on
 212       | otherwise  = insert rest     `thenMaB` \ rest' ->
 213                      returnMaB (cur_item : rest')
 214       where
 215         unifiable = maybeToBool (unifyTyListsX (ins_tv_set `unionVarSet` tpl_tvs) tpl_tys ins_tys)
 216         ins_item_more_specific = maybeToBool (matchTys tpl_tvs    tpl_tys ins_tys)
 217         cur_item_more_specific = maybeToBool (matchTys ins_tv_set ins_tys tpl_tys)
 218         identical = ins_item_more_specific && cur_item_more_specific
 219 \end{code}
 220