1 %************************************************************************
3 \subsection[MatchEnv]{Matching environments}
5 %************************************************************************
8 #include "HsVersions.h"
11 MatchEnv, nullMEnv, mkMEnv,
12 isEmptyMEnv, lookupMEnv, insertMEnv,
16 CHK_Ubiq() -- debugging consistency check
18 import Maybes ( MaybeErr(..), returnMaB, thenMaB, failMaB )
21 ``Matching'' environments allow you to bind a template to a value;
22 when you look up in it, you supply a value which is matched against
26 data MatchEnv key value
27 = EmptyME -- Common, so special-cased
31 For now we just use association lists. The list is maintained sorted
32 in order of {\em decreasing specificness} of @key@, so that the first
33 match will be the most specific.
36 nullMEnv :: MatchEnv a b
39 isEmptyMEnv EmptyME = True
42 mkMEnv :: [(key, value)] -> MatchEnv key value
44 mkMEnv stuff = ME stuff
46 mEnvToList :: MatchEnv key value -> [(key, value)]
47 mEnvToList EmptyME = []
48 mEnvToList (ME stuff) = stuff
51 @lookupMEnv@ looks up in a @MatchEnv@. It simply takes the first
52 match, which should be the most specific.
55 lookupMEnv :: (key1 {- template -} -> -- Matching function
56 key2 {- instance -} ->
58 -> MatchEnv key1 value -- The envt
60 -> Maybe (value, -- Value
61 match_info) -- Match info returned by matching fn
64 lookupMEnv key_match EmptyME key = Nothing
65 lookupMEnv key_match (ME alist) key
69 find ((tpl, val) : rest)
70 = case (key_match tpl key) of
72 Just match_info -> Just (val,match_info)
75 @insertMEnv@ extends a match environment, checking for overlaps.
78 insertMEnv :: (key {- template -} -> -- Matching function
81 -> MatchEnv key value -- Envt
82 -> key -> value -- New item
83 -> MaybeErr (MatchEnv key value) -- Success...
84 (key, value) -- Failure: Offending overlap
86 insertMEnv match_fn EmptyME key value = returnMaB (ME [(key, value)])
87 insertMEnv match_fn (ME alist) key value
90 -- insertMEnv has to put the new item in BEFORE any keys which are
91 -- LESS SPECIFIC than the new key, and AFTER any keys which are
92 -- MORE SPECIFIC The list is maintained in specific-ness order, so
93 -- we just stick it in either last, or just before the first key
94 -- of which the new key is an instance. We check for overlap at
97 insert [] = returnMaB (ME [(key, value)])
98 insert ls@(r@(t,v) : rest)
99 = case (match_fn t key) of
101 -- New key is not an instance of this existing one, so
102 -- continue down the list.
103 insert rest `thenMaB` \ (ME rest') ->
104 returnMaB (ME(r:rest'))
107 -- New key *is* an instance of the old one, so check the
108 -- other way round in case of identity.
110 case (match_fn key t) of
114 Nothing -> returnMaB (ME ((key,value):ls))
115 -- All ok; insert here