compiler/basicTypes/NameEnv.lhs

   1 %
   2 % (c) The University of Glasgow 2006
   3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   4 %
   5 \section[NameEnv]{@NameEnv@: name environments}
   6
   7 \begin{code}
   8 module NameEnv (
   9         NameEnv, mkNameEnv,
  10         emptyNameEnv, unitNameEnv, nameEnvElts, nameEnvUniqueElts,
  11         extendNameEnv_C, extendNameEnv_Acc, extendNameEnv,
  12         extendNameEnvList, extendNameEnvList_C,
  13         foldNameEnv, filterNameEnv,
  14         plusNameEnv, plusNameEnv_C,
  15         lookupNameEnv, lookupNameEnv_NF, delFromNameEnv, delListFromNameEnv,
  16         elemNameEnv, mapNameEnv
  17     ) where
  18
  19 -- XXX This define is a bit of a hack, and should be done more nicely
  20 #define FAST_STRING_NOT_NEEDED 1
  21 #include "HsVersions.h"
  22
  23 import Name
  24 import Unique
  25 import LazyUniqFM
  26 import Maybes
  27 import Outputable
  28 \end{code}
  29
  30 %************************************************************************
  31 %*                                                                      *
  32 \subsection{Name environment}
  33 %*                                                                      *
  34 %************************************************************************
  35
  36 \begin{code}
  37 newtype NameEnv a = A (UniqFM a)        -- Domain is Name
  38
  39 emptyNameEnv       :: NameEnv a
  40 mkNameEnv          :: [(Name,a)] -> NameEnv a
  41 nameEnvElts        :: NameEnv a -> [a]
  42 nameEnvUniqueElts  :: NameEnv a -> [(Unique, a)]
  43 extendNameEnv_C    :: (a->a->a) -> NameEnv a -> Name -> a -> NameEnv a
  44 extendNameEnv_Acc  :: (a->b->b) -> (a->b) -> NameEnv b -> Name -> a -> NameEnv b
  45 extendNameEnv      :: NameEnv a -> Name -> a -> NameEnv a
  46 plusNameEnv        :: NameEnv a -> NameEnv a -> NameEnv a
  47 plusNameEnv_C      :: (a->a->a) -> NameEnv a -> NameEnv a -> NameEnv a
  48 extendNameEnvList  :: NameEnv a -> [(Name,a)] -> NameEnv a
  49 extendNameEnvList_C :: (a->a->a) -> NameEnv a -> [(Name,a)] -> NameEnv a
  50 delFromNameEnv     :: NameEnv a -> Name -> NameEnv a
  51 delListFromNameEnv :: NameEnv a -> [Name] -> NameEnv a
  52 elemNameEnv        :: Name -> NameEnv a -> Bool
  53 unitNameEnv        :: Name -> a -> NameEnv a
  54 lookupNameEnv      :: NameEnv a -> Name -> Maybe a
  55 lookupNameEnv_NF   :: NameEnv a -> Name -> a
  56 foldNameEnv        :: (a -> b -> b) -> b -> NameEnv a -> b
  57 filterNameEnv      :: (elt -> Bool) -> NameEnv elt -> NameEnv elt
  58 mapNameEnv         :: (elt1 -> elt2) -> NameEnv elt1 -> NameEnv elt2
  59
  60 nameEnvElts (A x) = eltsUFM x
  61 emptyNameEnv     = A emptyUFM
  62 unitNameEnv x y = A $ unitUFM x y
  63 extendNameEnv (A x) y z = A $ addToUFM x y z
  64 extendNameEnvList (A x) l = A $ addListToUFM x l
  65 lookupNameEnv (A x) y = lookupUFM x y
  66 mkNameEnv     l    = A $ listToUFM l
  67 elemNameEnv x (A y)      = elemUFM x y
  68 foldNameEnv a b (A c)    = foldUFM a b c
  69 plusNameEnv (A x) (A y)  = A $ plusUFM x y
  70 plusNameEnv_C f (A x) (A y)      = A $ plusUFM_C f x y
  71 extendNameEnv_C f (A x) y z   = A $ addToUFM_C f x y z
  72 mapNameEnv f (A x)       = A $ mapUFM f x
  73 nameEnvUniqueElts (A x)  = ufmToList x
  74 extendNameEnv_Acc x y (A z) a b  = A $ addToUFM_Acc x y z a b
  75 extendNameEnvList_C x (A y) z = A $ addListToUFM_C x y z
  76 delFromNameEnv (A x) y    = A $ delFromUFM x y
  77 delListFromNameEnv (A x) y  = A $ delListFromUFM x y
  78 filterNameEnv x (A y)       = A $ filterUFM x y
  79
  80 lookupNameEnv_NF env n = expectJust "lookupNameEnv_NF" (lookupNameEnv env n)
  81
  82 instance Outputable a => Outputable (NameEnv a) where
  83     ppr (A x) = ppr x
  84 \end{code}
  85