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         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 mkMEnv :: [(key, value)] -> MatchEnv key value
  40 mkMEnv stuff = ME stuff
  41
  42 mEnvToList :: MatchEnv key value -> [(key, value)]
  43 mEnvToList EmptyME = []
  44 mEnvToList (ME stuff) = stuff
  45 \end{code}
  46
  47 @lookupMEnv@ looks up in a @MatchEnv@.  It simply takes the first
  48 match, which should be the most specific.
  49
  50 \begin{code}
  51 lookupMEnv :: (key1 {- template -} ->   -- Matching function
  52                key2 {- instance -} ->
  53                Maybe match_info)
  54            -> MatchEnv key1 value       -- The envt
  55            -> key2                      -- Key
  56            -> Maybe (value,             -- Value
  57                      match_info)        -- Match info returned by matching fn
  58
  59
  60 lookupMEnv key_match EmptyME    key = Nothing
  61 lookupMEnv key_match (ME alist) key
  62   = find alist
  63   where
  64     find [] = Nothing
  65     find ((tpl, val) : rest)
  66       = case (key_match tpl key) of
  67           Nothing         -> find rest
  68           Just match_info -> Just (val,match_info)
  69 \end{code}
  70
  71 @insertMEnv@ extends a match environment, checking for overlaps.
  72
  73 \begin{code}
  74 insertMEnv :: (key {- template -} ->            -- Matching function
  75                key {- instance -} ->
  76                Maybe match_info)
  77            -> MatchEnv key value                -- Envt
  78            -> key -> value                      -- New item
  79            -> MaybeErr (MatchEnv key value)     -- Success...
  80                        (key, value)             -- Failure: Offending overlap
  81
  82 insertMEnv match_fn EmptyME    key value = returnMaB (ME [(key, value)])
  83 insertMEnv match_fn (ME alist) key value
  84   = insert alist
  85   where
  86     -- insertMEnv has to put the new item in BEFORE any keys which are
  87     -- LESS SPECIFIC than the new key, and AFTER any keys which are
  88     -- MORE SPECIFIC The list is maintained in specific-ness order, so
  89     -- we just stick it in either last, or just before the first key
  90     -- of which the new key is an instance.  We check for overlap at
  91     -- that point.
  92
  93     insert [] = returnMaB (ME [(key, value)])
  94     insert ((t,v) : rest)
  95       = case (match_fn t key) of
  96           Nothing ->
  97             -- New key is not an instance of this existing one, so
  98             -- continue down the list.
  99             insert rest                 `thenMaB` \ (ME rest') ->
 100             returnMaB (ME((t,v):rest'))
 101
 102           Just match_info ->
 103             -- New key *is* an instance of the old one, so check the
 104             -- other way round in case of identity.
 105
 106             case (match_fn key t) of
 107               Just _  -> failMaB (t,v)
 108                          -- Oops; overlap
 109
 110               Nothing -> returnMaB (ME ((key,value):(t,v):rest))
 111                          -- All ok; insert here
 112 \end{code}