module CSPM.TypeChecker.Common where
import CSPM.DataStructures.Literals
import CSPM.DataStructures.Types
import CSPM.TypeChecker.Monad
import CSPM.TypeChecker.Unification
class TypeCheckable a b | a -> b where
typeCheck :: a -> TypeCheckMonad b
typeCheck a =
case errorContext a of
Just c -> addErrorContext c (typeCheck' a)
Nothing -> typeCheck' a
typeCheckExpect :: a -> Type -> TypeCheckMonad b
typeCheckExpect _ _ = panic "typeCheckExpect not supported"
typeCheck' :: a -> TypeCheckMonad b
errorContext :: a -> Maybe ErrorContext
instance TypeCheckable Literal Type where
errorContext _ = Nothing
typeCheck' (Int _) = return TInt
typeCheck' (Bool _) = return TBool
typeCheck' (Char _) = return TChar
typeCheck' (String _) = return $ TSeq TChar
ensureAreEqual :: TypeCheckable a Type => [a] -> TypeCheckMonad Type
ensureAreEqual [] = freshTypeVar
ensureAreEqual (e:es) = do
t <- typeCheck e
mapM (\e -> typeCheckExpect e t) es
return t
ensureIsList :: TypeCheckable a b => a -> TypeCheckMonad b
ensureIsList e = do
fv <- freshTypeVar
typeCheckExpect e (TSeq fv)
ensureIsSet :: TypeCheckable a b => a -> TypeCheckMonad b
ensureIsSet e = do
fv <- freshTypeVarWithConstraints [CSet]
typeCheckExpect e (TSet fv)
ensureIsBool :: TypeCheckable a b => a -> TypeCheckMonad b
ensureIsBool e = typeCheckExpect e TBool
ensureIsInt :: TypeCheckable a b => a -> TypeCheckMonad b
ensureIsInt e = typeCheckExpect e TInt
ensureIsChannel :: TypeCheckable a b => a -> TypeCheckMonad b
ensureIsChannel e = ensureIsExtendable e TEvent
ensureIsExtendable :: TypeCheckable a b => a -> Type -> TypeCheckMonad b
ensureIsExtendable e t = do
tvref <- freshTypeVarRef []
typeCheckExpect e (TExtendable t tvref)
ensureIsEvent :: TypeCheckable a b => a -> TypeCheckMonad b
ensureIsEvent e = typeCheckExpect e TEvent
ensureIsProc :: TypeCheckable a b => a -> TypeCheckMonad b
ensureIsProc e = typeCheckExpect e TProc
ensureHasConstraint :: Constraint -> Type -> TypeCheckMonad Type
ensureHasConstraint c t = do
fv1 <- freshTypeVarWithConstraints [c]
unify fv1 t