ghc/compiler/utils/MatchEnv.lhs

   1 %************************************************************************
   2 %*                                                                      *
   3 \subsection[MatchEnv]{Matching environments}
   4 %*                                                                      *
   5 %************************************************************************
   6
   7 \begin{code}
   8 #include "HsVersions.h"
   9
  10 module MatchEnv (
  11         MatchEnv, nullMEnv, mkMEnv,
  12         isEmptyMEnv, lookupMEnv, insertMEnv,
  13         mEnvToList
  14 ) where
  15
  16 CHK_Ubiq() -- debugging consistency check
  17
  18 import Maybes   ( MaybeErr(..), returnMaB, thenMaB, failMaB )
  19 \end{code}
  20
  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
  23 the template.
  24
  25 \begin{code}
  26 data MatchEnv key value
  27   = EmptyME                     -- Common, so special-cased
  28   | ME [(key, value)]
  29 \end{code}
  30
  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.
  34
  35 \begin{code}
  36 nullMEnv :: MatchEnv a b
  37 nullMEnv = EmptyME
  38
  39 isEmptyMEnv EmptyME = True
  40 isEmptyMEnv _       = False
  41
  42 mkMEnv :: [(key, value)] -> MatchEnv key value
  43 mkMEnv []    = EmptyME
  44 mkMEnv stuff = ME stuff
  45
  46 mEnvToList :: MatchEnv key value -> [(key, value)]
  47 mEnvToList EmptyME    = []
  48 mEnvToList (ME stuff) = stuff
  49 \end{code}
  50
  51 @lookupMEnv@ looks up in a @MatchEnv@.  It simply takes the first
  52 match, which should be the most specific.
  53
  54 \begin{code}
  55 lookupMEnv :: (key1 {- template -} ->   -- Matching function
  56                key2 {- instance -} ->
  57                Maybe match_info)
  58            -> MatchEnv key1 value       -- The envt
  59            -> key2                      -- Key
  60            -> Maybe (value,             -- Value
  61                      match_info)        -- Match info returned by matching fn
  62
  63
  64 lookupMEnv key_match EmptyME    key = Nothing
  65 lookupMEnv key_match (ME alist) key
  66   = find alist
  67   where
  68     find [] = Nothing
  69     find ((tpl, val) : rest)
  70       = case (key_match tpl key) of
  71           Nothing         -> find rest
  72           Just match_info -> Just (val,match_info)
  73 \end{code}
  74
  75 @insertMEnv@ extends a match environment, checking for overlaps.
  76
  77 \begin{code}
  78 insertMEnv :: (key {- template -} ->            -- Matching function
  79                key {- instance -} ->
  80                Maybe match_info)
  81            -> MatchEnv key value                -- Envt
  82            -> key -> value                      -- New item
  83            -> MaybeErr (MatchEnv key value)     -- Success...
  84                        (key, value)             -- Failure: Offending overlap
  85
  86 insertMEnv match_fn EmptyME    key value = returnMaB (ME [(key, value)])
  87 insertMEnv match_fn (ME alist) key value
  88   = insert alist
  89   where
  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
  95     -- that point.
  96
  97     insert [] = returnMaB (ME [(key, value)])
  98     insert ls@(r@(t,v) : rest)
  99       = case (match_fn t key) of
 100           Nothing ->
 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'))
 105
 106           Just match_info ->
 107             -- New key *is* an instance of the old one, so check the
 108             -- other way round in case of identity.
 109
 110             case (match_fn key t) of
 111               Just _  -> failMaB r
 112                          -- Oops; overlap
 113
 114               Nothing -> returnMaB (ME ((key,value):ls))
 115                          -- All ok; insert here
 116 \end{code}