2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1996
4 \section[SpecEnv]{Specialisation info about an @Id@}
9 emptySpecEnv, isEmptySpecEnv,
10 addToSpecEnv, matchSpecEnv, unifySpecEnv
13 #include "HsVersions.h"
15 import Type ( Type, GenType, matchTys, tyVarsOfTypes )
16 import TyVar ( TyVarEnv, lookupTyVarEnv, tyVarSetToList )
17 import Unify ( Subst, unifyTyListsX )
19 import Util ( assertPanic )
24 %************************************************************************
28 %************************************************************************
33 | SpecEnv [([Type], value)] -- No pair of templates unify with each others
36 For now we just use association lists.
39 emptySpecEnv :: SpecEnv a
40 emptySpecEnv = EmptySE
42 isEmptySpecEnv EmptySE = True
43 isEmptySpecEnv _ = False
46 @lookupSpecEnv@ looks up in a @SpecEnv@. Since no pair of templates
47 unify, the first match must be the only one.
50 data SpecEnvResult val
51 = Match Subst val -- Match, instantiating only
52 -- type variables in the template
54 | CouldMatch -- A match could happen if the
55 -- some of the type variables in the key
56 -- were further instantiated.
58 | NoMatch -- No match possible, regardless of how
59 -- the key is further instantiated
61 -- If the key *unifies* with one of the templates, then the
62 -- result is Match or CouldMatch, depending on whether any of the
63 -- type variables in the key had to be instantiated
65 unifySpecEnv :: SpecEnv value -- The envt
67 -> SpecEnvResult value
70 unifySpecEnv EmptySE key = NoMatch
71 unifySpecEnv (SpecEnv alist) key
75 find ((tpl, val) : rest)
76 = case unifyTyListsX tpl key of
78 Just subst | all uninstantiated (tyVarSetToList (tyVarsOfTypes key))
83 uninstantiated tv = case lookupTyVarEnv subst tv of
87 -- matchSpecEnv does a one-way match only, but in return
88 -- it is more polymorphic than unifySpecEnv
90 matchSpecEnv :: SpecEnv value -- The envt
91 -> [GenType flexi] -- Key
92 -> Maybe (TyVarEnv (GenType flexi), value)
94 matchSpecEnv EmptySE key = Nothing
95 matchSpecEnv (SpecEnv alist) key
99 find ((tpl, val) : rest)
100 = case matchTys tpl key of
102 Just (subst, leftovers) -> ASSERT( null leftovers )
106 @addToSpecEnv@ extends a @SpecEnv@, checking for overlaps.
109 addToSpecEnv :: SpecEnv value -- Envt
110 -> [Type] -> value -- New item
111 -> MaybeErr (SpecEnv value) -- Success...
112 ([Type], value) -- Failure: Offending overlap
114 addToSpecEnv EmptySE key value = returnMaB (SpecEnv [(key, value)])
115 addToSpecEnv (SpecEnv alist) key value
116 = case filter matches_key alist of
117 [] -> returnMaB (SpecEnv ((key,value) : alist)) -- No match
118 (bad : _) -> failMaB bad -- At least one match
120 matches_key (tpl, val) = maybeToBool (unifyTyListsX tpl key)