ghc/compiler/envs/TVE.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1994
   3 %
   4 \section[TVE]{Type variable environment}
   5
   6 This environment is not part of the big one that is carried around
   7 monadically.
   8
   9 \begin{code}
  10 #include "HsVersions.h"
  11
  12 module TVE (
  13         TVE(..), UniqFM,
  14
  15         mkTVE, nullTVE, unitTVE,
  16         lookupTVE, lookupTVE_NoFail, plusTVE,
  17
  18         -- and to make the interface self-sufficient...
  19         Maybe, Name, TyVarTemplate, UniType
  20
  21         IF_ATTACK_PRAGMAS(COMMA emptyUFM COMMA plusUFM)
  22         IF_ATTACK_PRAGMAS(COMMA eltsUFM  COMMA singletonDirectlyUFM)
  23         IF_ATTACK_PRAGMAS(COMMA u2i)
  24     ) where
  25
  26 import AbsUniType       ( mkUserTyVarTemplate, mkTyVarTemplateTy,
  27                           getTyVar, TyVarTemplate, TyVar, Class,
  28                           ClassOp, Arity(..), TyCon,
  29                           TauType(..), UniType
  30                           IF_ATTACK_PRAGMAS(COMMA cmpTyCon COMMA cmpClass)
  31                           IF_ATTACK_PRAGMAS(COMMA cmpTyVar)
  32                           IF_ATTACK_PRAGMAS(COMMA cmpUniType)
  33                         )
  34 import Maybes           ( Maybe(..), MaybeErr(..) )
  35 import Name
  36 import Outputable       -- def of ppr
  37 import Pretty           -- to pretty-print error messages
  38 import UniqFM           -- basic environment handling
  39 import Unique           ( Unique )
  40 import Util
  41 \end{code}
  42
  43 \begin{code}
  44 type TVE = UniqFM UniType
  45 #define MkTVE {--}
  46 -- also: export non-abstractly
  47
  48 mkTVE :: [Name] -> (TVE, [TyVarTemplate], [TauType])
  49 mkTVE names
  50   = case (unzip3 (map mk_tve_one names)) of { (env, tyvars, tys) ->
  51     (MkTVE (listToUFM_Directly env), tyvars, tys) }
  52   where
  53     mk_tve_one (Short uniq short_name)
  54       = case (mkUserTyVarTemplate uniq short_name)  of { tyvar ->
  55         case (mkTyVarTemplateTy tyvar)              of { ty ->
  56         ((uniq, ty), tyvar, ty) }}
  57
  58 nullTVE :: TVE
  59 nullTVE = MkTVE emptyUFM
  60
  61 unitTVE u ty = MkTVE (singletonDirectlyUFM u ty)
  62
  63 lookupTVE :: TVE -> Name -> UniType
  64 lookupTVE (MkTVE tve) (Short uniq short_name)
  65  = case (lookupDirectlyUFM tve uniq) of
  66      Just ty -> ty
  67      Nothing -> panic "lookupTVE!"
  68
  69 lookupTVE_NoFail (MkTVE tve) (Short uniq short_name)
  70  = lookupDirectlyUFM tve uniq
  71
  72 plusTVE :: TVE -> TVE -> TVE
  73 plusTVE (MkTVE tve1) (MkTVE tve2) = MkTVE (plusUFM tve1 tve2)
  74 \end{code}