1 module Environment 2 (Env, emptyEnv, extendLocal, extendGlobal, 3 makeEnv, unmakeEnv, lookupEnv, domEnv, freeTVarEnv) 4 where 5 6 import Shows 7 import Parse 8 import Term (VarId, readsId) 9 import Type (TVarId, TConId, MonoType, PolyType (All), freeTVarPoly) 10 import FiniteMap (FM, emptyFM, lookupFM, extendFM, makeFM, unmakeFM, 11 mapFM, domFM, ranFM) 12 data Env = MkEnv (FM VarId PolyType) 13 rep :: Env -> FM VarId PolyType 14 rep (MkEnv f) = f 15 emptyEnv :: Env 16 emptyEnv = MkEnv emptyFM 17 extendLocal :: Env -> VarId -> MonoType -> Env 18 extendLocal env x t = MkEnv (extendFM (rep env) x (All [] t)) 19 extendGlobal :: Env -> VarId -> PolyType -> Env 20 extendGlobal env x t = MkEnv (extendFM (rep env) x t) 21 makeEnv :: [(VarId, PolyType)] -> Env 22 makeEnv = MkEnv . makeFM 23 unmakeEnv :: Env -> [(VarId, PolyType)] 24 unmakeEnv = unmakeFM . rep 25 lookupEnv :: Env -> VarId -> PolyType 26 lookupEnv env x = lookupFM (rep env) x 27 domEnv :: Env -> [VarId] 28 domEnv env = domFM (rep env) 29 freeTVarEnv :: Env -> [TVarId] 30 freeTVarEnv env = concat (map freeTVarPoly (ranFM (rep env))) 31 instance Read Env where 32 readsPrec d = readsEnv 33 instance Show Env where 34 showsPrec d = showsEnv 35 readsEnv :: Parses Env 36 readsEnv = listP readsPair `eachP` makeEnv 37 readsPair :: Parses (VarId, PolyType) 38 readsPair = readsId `thenP` (\x -> 39 lexP ":" `thenP` (\_ -> 40 reads `thenP` (\t -> 41 returnP (x,t)))) 42 showsEnv :: Shows Env 43 showsEnv = showsSurround "[" (showsStarSep ",\n " showsPair) "]" 44 . unmakeEnv 45 showsPair :: Shows (VarId, PolyType) 46 showsPair (x,t) = showsString x . showsString " : " . shows t