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.
48 lines
1.3 KiB
48 lines
1.3 KiB
{-# LANGUAGE DeriveAnyClass #-}
|
|
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
|
{-# LANGUAGE DerivingVia #-}
|
|
module Elab.Monad where
|
|
|
|
import Control.Monad.Reader
|
|
import Control.Exception
|
|
|
|
import qualified Data.Map.Strict as Map
|
|
import Data.Map.Strict (Map)
|
|
import Data.Typeable
|
|
|
|
import Syntax
|
|
|
|
newtype ElabEnv = ElabEnv { getEnv :: Map Name (NFType, Value) }
|
|
|
|
newtype ElabM a = ElabM { runElab :: ElabEnv -> IO a }
|
|
deriving (Functor, Applicative, Monad, MonadReader ElabEnv, MonadIO)
|
|
via ReaderT ElabEnv IO
|
|
|
|
newtype NotInScope = NotInScope { getName :: Name }
|
|
deriving (Show, Typeable)
|
|
deriving anyclass (Exception)
|
|
|
|
emptyEnv :: ElabEnv
|
|
emptyEnv = ElabEnv mempty
|
|
|
|
assume :: Name -> Value -> ElabM a -> ElabM a
|
|
assume nm ty = local go where
|
|
go = ElabEnv . Map.insert nm (ty, VVar nm) . getEnv
|
|
|
|
define :: Name -> Value -> Value -> ElabM a -> ElabM a
|
|
define nm ty vl = local go where
|
|
go = ElabEnv . Map.insert nm (ty, vl) . getEnv
|
|
|
|
getValue :: Name -> ElabM Value
|
|
getValue nm = do
|
|
vl <- asks (Map.lookup nm . getEnv)
|
|
case vl of
|
|
Just v -> pure (snd v)
|
|
Nothing -> liftIO . throwIO $ NotInScope nm
|
|
|
|
getNfType :: Name -> ElabM NFType
|
|
getNfType nm = do
|
|
vl <- asks (Map.lookup nm . getEnv)
|
|
case vl of
|
|
Just v -> pure (fst v)
|
|
Nothing -> liftIO . throwIO $ NotInScope nm
|