content: module Environment
         (Env, emptyEnv, extendLocal, extendGlobal,
          makeEnv, unmakeEnv, lookupEnv, domEnv, freeTVarEnv)
         where
  
  import Shows
  import Parse
  import Term           (VarId, readsId)
  import Type           (TVarId, TConId, MonoType, PolyType (All), freeTVarPoly)
  import FiniteMap      (FM, emptyFM, lookupFM, extendFM, makeFM, unmakeFM,
                         mapFM, domFM, ranFM)
  data  Env             =   MkEnv (FM VarId PolyType)
  rep                   ::  Env -> FM VarId PolyType
  rep (MkEnv f)         =   f
  emptyEnv              ::  Env
  emptyEnv              =   MkEnv emptyFM
  extendLocal           ::  Env -> VarId -> MonoType -> Env
  extendLocal env x t   =   MkEnv (extendFM (rep env) x (All [] t))
  extendGlobal          ::  Env -> VarId -> PolyType -> Env
  extendGlobal env x t  =   MkEnv (extendFM (rep env) x t)
  makeEnv               ::  [(VarId, PolyType)] -> Env
  makeEnv               =   MkEnv . makeFM
  unmakeEnv             ::  Env -> [(VarId, PolyType)]
  unmakeEnv             =   unmakeFM . rep
  lookupEnv             ::  Env -> VarId -> PolyType
  lookupEnv env x       =   lookupFM (rep env) x
  domEnv                ::  Env -> [VarId]
  domEnv env            =   domFM (rep env)
  freeTVarEnv           ::  Env -> [TVarId]
  freeTVarEnv env       =   concat (map freeTVarPoly (ranFM (rep env)))
  instance  Read Env  where
        readsPrec d  =  readsEnv
  instance  Show Env  where
        showsPrec d  =  showsEnv
  readsEnv              :: Parses Env
  readsEnv              =  listP readsPair `eachP` makeEnv
  readsPair             :: Parses (VarId, PolyType)
  readsPair             =       readsId         `thenP` (\x ->
                                lexP ":"        `thenP` (\_ ->
                                reads           `thenP` (\t ->
                                                returnP (x,t))))
  showsEnv              :: Shows Env
  showsEnv              =  showsSurround "[" (showsStarSep ",\n " showsPair) "]"
                        .  unmakeEnv
  showsPair             :: Shows (VarId, PolyType)
  showsPair (x,t)       =  showsString x . showsString " : " . shows t
  