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