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
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
|
|
|