You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 

94 lines
3.3 KiB

{-|
Module: Simple.TC.TypeOps
Description: Defines operations used on typechecker types
This module defines a lot of useful operation over our typechecker monad
-}
module Simple.TC.TypeOps where
import Control.Monad.State hiding (guard)
import Control.Monad.Except hiding (guard)
import Data.Set (Set)
import qualified Data.Map as M
import qualified Data.Set as S
import Lens.Micro
import Simple.TC.Types
import Simple.AST
import Types
import Misc
-- | Change state only for some computation
local :: (CheckEnv -> CheckEnv) -> Check a -> Check a
local f ca = get >>= \s -> put (f s) >> ca >>= \r -> put s >> pure r
-- | Change the state somehow
modState :: (CheckEnv -> CheckEnv) -> Check ()
modState f = get >>= put . f
-- | Get the value level enviornment
getEnv :: Check (Env Type)
getEnv = (^. defs) <$> get
-- | Change value environment only for some computation.
localEnv :: (Env Type -> Env Type) -> Check a -> Check a
localEnv f = local (\env -> env & defs %~ f)
-- | Modify the value environment
modifyEnv :: (Env Type -> Env Type) -> Check ()
modifyEnv f = modState (\env -> env & defs %~ f)
-- | Modify the type environment
modifyTypeEnv :: (Set Identifier -> Set Identifier) -> Check ()
modifyTypeEnv f = modState (\env -> env & types %~ f)
-- | Modify the record environment
modifyRecEnv :: (Env (Env Type) -> Env (Env Type)) -> Check ()
modifyRecEnv f = modState (\env -> env & rec %~ f)
-- | Return the type environment
getTypeEnv :: Check (Set Identifier)
getTypeEnv = (^. types) <$> get
-- | Return the record environment
getRecEnv :: Check (Env (Env Type))
getRecEnv = (^. rec) <$> get
-- | Change type environment only for some computation.
localTypeEnv :: (Set Identifier -> Set Identifier) -> Check a -> Check a
localTypeEnv f = local (\env -> env & types %~ f)
-- | Used to bind local variables.
withBindings :: [(Type, Identifier)] -> Check a -> Check a
withBindings = localEnv . (flip insertMapBindings)
-- | Used to permanently bind variables.
insertBindings :: [(Type, Identifier)] -> Check ()
insertBindings = modifyEnv . (flip insertMapBindings)
-- | Bind some variables and make sure the names were not taken
insertUniqueBindings :: PN -> [(Type, Identifier)] -> Check ()
insertUniqueBindings p ais = getEnv >>= \env -> foldM go env ais >>= modifyEnv . const
where
go :: Env Type -> (Type, Identifier) -> Check (Env Type)
go e (a, i) | M.member i e = throwError (AlreadyBound p i)
| otherwise = pure (M.insert i a e)
-- | Bind some type names and make sure the names were not taken
insertUniqueTypes :: PN -> [Identifier] -> Check ()
insertUniqueTypes p is = getTypeEnv >>= \env -> foldM go env is >>= modifyTypeEnv . const
where
go :: Set Identifier -> Identifier -> Check (Set Identifier)
go s i | S.member i s = throwError (TypeAlreadyBound p i)
| otherwise = pure (S.insert i s)
-- | Insert some stuff into an environment
insertMapBindings :: Env a -> [(a, Identifier)] -> Env a
insertMapBindings = foldr (uncurry (flip M.insert))
-- | Insert record constructors into the environment
insertRecCons :: PN -> Identifier -> [(Type, Identifier)] -> Check ()
insertRecCons p i tis = getRecEnv >>= \renv -> if M.member i renv
then throwError (TypeAlreadyBound p i)
else (modifyRecEnv . M.insert i . M.fromList . map swap) tis