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