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 \begin{code}
  52 emptyInstEnv :: InstEnv
  53 emptyInstEnv = []
  54
  55 isEmptyInstEnv env = null env
  56 \end{code}
  57
  58 @lookupInstEnv@ looks up in a @InstEnv@, using a one-way match.  Since the env is kept
  59 ordered, the first match must be the only one.
  60 The thing we are looking up can have an
  61 arbitrary "flexi" part.
  62
  63 \begin{code}
  64 lookupInstEnv :: SDoc           -- For error report
  65               -> InstEnv        -- The envt
  66               -> [Type]         -- Key
  67               -> Maybe (TyVarSubstEnv, Id)
  68
  69 lookupInstEnv doc env key
  70   = find env
  71   where
  72     find [] = Nothing
  73     find ((tpl_tyvars, tpl, val) : rest)
  74       = case matchTys tpl_tyvars tpl key of
  75           Nothing                 -> find rest
  76           Just (subst, leftovers) -> ASSERT( null leftovers )
  77                                      Just (subst, val)
  78 \end{code}
  79
  80 @addToInstEnv@ extends a @InstEnv@, checking for overlaps.
  81
  82 A boolean flag controls overlap reporting.
  83
  84 True => overlap is permitted, but only if one template matches the other;
  85         not if they unify but neither is
  86
  87 \begin{code}
  88 addToInstEnv :: Bool                            -- True <=> overlap permitted
  89              -> InstEnv                         -- Envt
  90              -> [TyVar] -> [Type] -> Id         -- New item
  91              -> MaybeErr InstEnv                -- Success...
  92                          ([Type], Id)           -- Failure: Offending overlap
  93
  94 addToInstEnv overlap_ok env ins_tvs ins_tys value
  95   = insert env
  96   where
  97     ins_tv_set = mkVarSet ins_tvs
  98     ins_item = (ins_tv_set, ins_tys, value)
  99
 100     insert [] = returnMaB [ins_item]
 101     insert env@(cur_item@(tpl_tvs, tpl_tys, val) : rest)
 102
 103         -- FAIL if:
 104         -- (a) they are the same, or
 105         -- (b) they unify, and any sort of overlap is prohibited,
 106         -- (c) they unify but neither is more specific than t'other
 107       |  identical
 108       || (unifiable && not overlap_ok)
 109       || (unifiable && not (ins_item_more_specific || cur_item_more_specific))
 110       =  failMaB (tpl_tys, val)
 111
 112         -- New item is an instance of current item, so drop it here
 113       | ins_item_more_specific  = returnMaB (ins_item : env)
 114
 115         -- Otherwise carry on
 116       | otherwise  = insert rest     `thenMaB` \ rest' ->
 117                      returnMaB (cur_item : rest')
 118       where
 119         unifiable = maybeToBool (unifyTyListsX (ins_tv_set `unionVarSet` tpl_tvs) tpl_tys ins_tys)
 120         ins_item_more_specific = maybeToBool (matchTys tpl_tvs    tpl_tys ins_tys)
 121         cur_item_more_specific = maybeToBool (matchTys ins_tv_set ins_tys tpl_tys)
 122         identical = ins_item_more_specific && cur_item_more_specific
 123 \end{code}
 124