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.
 
 
 

71 lines
2.5 KiB

{-|
Module: Simple.TC.Types
Description: Types for the simple typechecker.
Types for the simple typechecker.
-}
{-# LANGUAGE GeneralizedNewtypeDeriving, TemplateHaskell, LambdaCase #-}
module Simple.TC.Types where
import Simple.AST
import Types
import Error
import Control.Monad.State
import Control.Monad.Except
import Data.Map (Map)
import Data.Set (Set)
import qualified Data.Map as M
import qualified Data.Set as S
import Lens.Micro.TH
-- | The different kinds of errors which can occur during checking
data TypeError
= Urk
| TypeMismatch PN Type Type -- ^ expected, got
| ArityMismatch PN
| UnboundVar PN Identifier
| AlreadyBound PN Identifier
| TypeAlreadyBound PN Identifier
| NoCase PN
| UnknownPattern PN
| UndefinedType PN Identifier
| InvalidRecordField PN Identifier
| IncompleteInstance PN
deriving (Show)
-- | Generates a fancy error string from a TypeError
errorStr :: FilePath -> String -> TypeError -> String
errorStr fp tx = \case
Urk -> "urk"
TypeMismatch p e g -> errorMessage p fp tx ("Type mismatch, expected '" <> pretty e <> "' got '" <> pretty g <> "'")
ArityMismatch p -> errorMessage p fp tx "Arity mismatch"
UnboundVar p i -> errorMessage p fp tx ("Unbound variable '" <> unId i <> "'")
AlreadyBound p i -> errorMessage p fp tx ("Identifier '" <> unId i <> "' already bound")
TypeAlreadyBound p i -> errorMessage p fp tx ("A type of name'" <> unId i <> "' already exists")
NoCase p -> errorMessage p fp tx "No case"
UnknownPattern p -> errorMessage p fp tx "Unknown pattern"
UndefinedType p i -> errorMessage p fp tx ("Undefined type '" <> unId i <> "'")
InvalidRecordField p i -> errorMessage p fp tx ("Invalid record field '" <> unId i <> "'")
IncompleteInstance p -> errorMessage p fp tx "Incomplete instance"
-- | An enviornment simply maps an identifier to something
type Env a = Map Identifier a
-- | The complete enviornment of the checker
data CheckEnv = CheckEnv { _defs :: Env Type
, _types :: Set Identifier
, _rec :: Env (Env Type)
} deriving Show
makeLenses ''CheckEnv
-- | The initial enviornment of the checker
initialState :: CheckEnv
initialState = CheckEnv M.empty S.empty M.empty
-- | The monad which checking is performed in
newtype Check a = Check { runCheck :: StateT CheckEnv (ExceptT TypeError IO) a }
deriving (Functor, Applicative, Monad, MonadError TypeError, MonadState CheckEnv)