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 need to
  91 add `C [a]' to the context of the `D [a]' instance (as appears in comments).
  92 But there's that `C [a]' instance decl one line above that says that I can
  93 reduce the need for a `C [a]' instance to the need for a `C a' instance, and
  94 in this case, I already have the necessary `C a' instance (since we have `D a'
  95 explicitly in the context, and `C' is a superclass of `D').
  96
  97 Unfortunately, the above reasoning indicates a premature commitment to the
  98 generic `C [a]' instance.  I.e., it prematurely rules out the more specific
  99 instance `C [Int]'.  This is the mistake that ghc-4.06 makes.  The fix is to
 100 add the context that hugs suggests (uncomment the `C [a]'), effectively
 101 deferring the decision about which instance to use.
 102
 103 Now, interestingly enough, 4.04 has this same bug, but it's covered up in this
 104 case by a little known `optimization' that was disabled in 4.06.  Ghc-4.04
 105 silently inserts any missing superclass context into an instance declaration.
 106 In this case, it silently inserts the `C [a]', and everything happens to work
 107 out.
 108
 109 (See `basicTypes/MkId:mkDictFunId' for the code in question.  Search for
 110 `Mark Jones', although Mark claims no credit for the `optimization' in
 111 question, and would rather it stopped being called the `Mark Jones
 112 optimization' ;-)
 113
 114 So, what's the fix?  I think hugs has it right.  Here's why.  Let's try
 115 something else out with ghc-4.04.  Let's add the following line:
 116
 117     d' :: D a => [a]
 118     d' = c
 119
 120 Everyone raise their hand who thinks that `d :: [Int]' should give a different
 121 answer from `d' :: [Int]'.  Well, in ghc-4.04, it does.  The `optimization'
 122 only applies to instance decls, not to regular bindings, giving inconsistent
 123 behavior.
 124
 125 Old hugs had this same bug.  Here's how we fixed it: like GHC, the list of
 126 instances for a given class is ordered, so that more specific instances come
 127 before more generic ones.  For example, the instance list for C might contain:
 128     ..., C Int, ..., C a, ...
 129 When we go to look for a `C Int' instance we'll get that one first.  But what
 130 if we go looking for a `C b' (`b' is unconstrained)?  We'll pass the `C Int'
 131 instance, and keep going.  But if `b' is unconstrained, then we don't know yet
 132 if the more specific instance will eventually apply.  GHC keeps going, and
 133 matches on the generic `C a'.  The fix is to, at each step, check to see if
 134 there's a reverse match, and if so, abort the search.  This prevents hugs
 135 from prematurely chosing a generic instance when a more specific one exists.
 136
 137 --Jeff
 138
 139 \begin{code}
 140 emptyInstEnv :: InstEnv
 141 emptyInstEnv = []
 142
 143 isEmptyInstEnv env = null env
 144 \end{code}
 145
 146 @lookupInstEnv@ looks up in a @InstEnv@, using a one-way match.  Since the env is kept
 147 ordered, the first match must be the only one.
 148 The thing we are looking up can have an
 149 arbitrary "flexi" part.
 150
 151 \begin{code}
 152 lookupInstEnv :: SDoc           -- For error report
 153               -> InstEnv        -- The envt
 154               -> [Type]         -- Key
 155               -> Maybe (TyVarSubstEnv, Id)
 156
 157 lookupInstEnv doc env key
 158   = find env
 159   where
 160     key_vars = tyVarsOfTypes key
 161     find [] = Nothing
 162     find ((tpl_tyvars, tpl, val) : rest)
 163       = case matchTys tpl_tyvars tpl key of
 164           Nothing                 ->
 165             case matchTys key_vars key tpl of
 166               Nothing             -> find rest
 167               Just (_, _)         -> Nothing
 168           Just (subst, leftovers) -> ASSERT( null leftovers )
 169                                      Just (subst, val)
 170 \end{code}
 171
 172 @addToInstEnv@ extends a @InstEnv@, checking for overlaps.
 173
 174 A boolean flag controls overlap reporting.
 175
 176 True => overlap is permitted, but only if one template matches the other;
 177         not if they unify but neither is
 178
 179 \begin{code}
 180 addToInstEnv :: Bool                            -- True <=> overlap permitted
 181              -> InstEnv                         -- Envt
 182              -> [TyVar] -> [Type] -> Id         -- New item
 183              -> MaybeErr InstEnv                -- Success...
 184                          ([Type], Id)           -- Failure: Offending overlap
 185
 186 addToInstEnv overlap_ok env ins_tvs ins_tys value
 187   = insert env
 188   where
 189     ins_tv_set = mkVarSet ins_tvs
 190     ins_item = (ins_tv_set, ins_tys, value)
 191
 192     insert [] = returnMaB [ins_item]
 193     insert env@(cur_item@(tpl_tvs, tpl_tys, val) : rest)
 194
 195         -- FAIL if:
 196         -- (a) they are the same, or
 197         -- (b) they unify, and any sort of overlap is prohibited,
 198         -- (c) they unify but neither is more specific than t'other
 199       |  identical
 200       || (unifiable && not overlap_ok)
 201       || (unifiable && not (ins_item_more_specific || cur_item_more_specific))
 202       =  failMaB (tpl_tys, val)
 203
 204         -- New item is an instance of current item, so drop it here
 205       | ins_item_more_specific  = returnMaB (ins_item : env)
 206
 207         -- Otherwise carry on
 208       | otherwise  = insert rest     `thenMaB` \ rest' ->
 209                      returnMaB (cur_item : rest')
 210       where
 211         unifiable = maybeToBool (unifyTyListsX (ins_tv_set `unionVarSet` tpl_tvs) tpl_tys ins_tys)
 212         ins_item_more_specific = maybeToBool (matchTys tpl_tvs    tpl_tys ins_tys)
 213         cur_item_more_specific = maybeToBool (matchTys ins_tv_set ins_tys tpl_tys)
 214         identical = ins_item_more_specific && cur_item_more_specific
 215 \end{code}
 216