2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
4 \section{Class Instance environments}
8 InstEnv, emptyInstEnv, addToInstEnv, lookupInstEnv
11 #include "HsVersions.h"
13 import Var ( TyVar, Id )
15 import VarEnv ( TyVarSubstEnv )
16 import Type ( Type, tyVarsOfTypes )
17 import Unify ( unifyTyListsX, matchTys )
23 %************************************************************************
27 %************************************************************************
30 type InstEnv = [(TyVarSet, [Type], Id)]
33 In some InstEnvs overlap is prohibited; that is, no pair of templates unify.
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:
45 If overlap is permitted, the list is kept most specific first, so that
46 the first lookup is the right choice.
49 For now we just use association lists.
52 emptyInstEnv :: InstEnv
55 isEmptyInstEnv env = null env
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.
64 lookupInstEnv :: SDoc -- For error report
65 -> InstEnv -- The envt
67 -> Maybe (TyVarSubstEnv, Id)
69 lookupInstEnv doc env key
73 find ((tpl_tyvars, tpl, val) : rest)
74 = case matchTys tpl_tyvars tpl key of
76 Just (subst, leftovers) -> ASSERT( null leftovers )
80 @addToInstEnv@ extends a @InstEnv@, checking for overlaps.
82 A boolean flag controls overlap reporting.
84 True => overlap is permitted, but only if one template matches the other;
85 not if they unify but neither is
88 addToInstEnv :: Bool -- True <=> overlap permitted
90 -> [TyVar] -> [Type] -> Id -- New item
91 -> MaybeErr InstEnv -- Success...
92 ([Type], Id) -- Failure: Offending overlap
94 addToInstEnv overlap_ok env ins_tvs ins_tys value
97 ins_tv_set = mkVarSet ins_tvs
98 ins_item = (ins_tv_set, ins_tys, value)
100 insert [] = returnMaB [ins_item]
101 insert env@(cur_item@(tpl_tvs, tpl_tys, val) : rest)
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
108 || (unifiable && not overlap_ok)
109 || (unifiable && not (ins_item_more_specific || cur_item_more_specific))
110 = failMaB (tpl_tys, val)
112 -- New item is an instance of current item, so drop it here
113 | ins_item_more_specific = returnMaB (ins_item : env)
115 -- Otherwise carry on
116 | otherwise = insert rest `thenMaB` \ rest' ->
117 returnMaB (cur_item : rest')
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