module Checker (TypeValue, checker) where import Data.Map as Map import Parser ( SExpr (..), ) data TypeValue = TInt | TString | TBool | TFunction TypeValue TypeValue | TGeneric String (TypeValue -> Either String TypeValue) | TTypeHole | TType TypeValue | TUnion TypeValue TypeValue | TIntersection TypeValue TypeValue instance Show TypeValue where show :: TypeValue -> String show (TIntersection TypeValue a TypeValue b) = String "TIntersection<" String -> ShowS forall a. [a] -> [a] -> [a] ++ TypeValue -> String forall a. Show a => a -> String show TypeValue a String -> ShowS forall a. [a] -> [a] -> [a] ++ String " + " String -> ShowS forall a. [a] -> [a] -> [a] ++ TypeValue -> String forall a. Show a => a -> String show TypeValue b String -> ShowS forall a. [a] -> [a] -> [a] ++ String ">" show (TFunction TypeValue a TypeValue b) = String "TFunction<" String -> ShowS forall a. [a] -> [a] -> [a] ++ TypeValue -> String forall a. Show a => a -> String show TypeValue a String -> ShowS forall a. [a] -> [a] -> [a] ++ String "><" String -> ShowS forall a. [a] -> [a] -> [a] ++ TypeValue -> String forall a. Show a => a -> String show TypeValue b String -> ShowS forall a. [a] -> [a] -> [a] ++ String ">" show (TUnion TypeValue a TypeValue b) = String "TUnion<" String -> ShowS forall a. [a] -> [a] -> [a] ++ TypeValue -> String forall a. Show a => a -> String show TypeValue a String -> ShowS forall a. [a] -> [a] -> [a] ++ String " + " String -> ShowS forall a. [a] -> [a] -> [a] ++ TypeValue -> String forall a. Show a => a -> String show TypeValue b String -> ShowS forall a. [a] -> [a] -> [a] ++ String ">" show (TGeneric String a TypeValue -> Either String TypeValue _) =String "TGeneric<" String -> ShowS forall a. [a] -> [a] -> [a] ++ ShowS forall a. Show a => a -> String show String a String -> ShowS forall a. [a] -> [a] -> [a] ++ String ">" show (TType TypeValue a) = String "TType<" String -> ShowS forall a. [a] -> [a] -> [a] ++ TypeValue -> String forall a. Show a => a -> String show TypeValue a String -> ShowS forall a. [a] -> [a] -> [a] ++ String ">" show TypeValue TInt = String "TInt" show TypeValue TString = String "TString" show TypeValue TBool = String "TBool" show TypeValue TTypeHole = String "TTypeHole" instance Eq TypeValue where TypeValue received == :: TypeValue -> TypeValue -> Bool == TypeValue expected = case (TypeValue received, TypeValue expected) of (TIntersection TypeValue left TypeValue right, TypeValue _) -> TypeValue left TypeValue -> TypeValue -> Bool forall a. Eq a => a -> a -> Bool == TypeValue expected Bool -> Bool -> Bool || TypeValue right TypeValue -> TypeValue -> Bool forall a. Eq a => a -> a -> Bool == TypeValue expected (TUnion TypeValue left TypeValue right, TypeValue _) -> TypeValue left TypeValue -> TypeValue -> Bool forall a. Eq a => a -> a -> Bool == TypeValue expected Bool -> Bool -> Bool && TypeValue right TypeValue -> TypeValue -> Bool forall a. Eq a => a -> a -> Bool == TypeValue expected (TypeValue _, TIntersection TypeValue left TypeValue right) -> TypeValue received TypeValue -> TypeValue -> Bool forall a. Eq a => a -> a -> Bool == TypeValue left Bool -> Bool -> Bool && TypeValue received TypeValue -> TypeValue -> Bool forall a. Eq a => a -> a -> Bool == TypeValue right (TypeValue _, TUnion TypeValue left TypeValue right) -> TypeValue received TypeValue -> TypeValue -> Bool forall a. Eq a => a -> a -> Bool == TypeValue left Bool -> Bool -> Bool || TypeValue received TypeValue -> TypeValue -> Bool forall a. Eq a => a -> a -> Bool == TypeValue right (TFunction TypeValue param TypeValue ret, TFunction TypeValue param' TypeValue ret') -> TypeValue param TypeValue -> TypeValue -> Bool forall a. Eq a => a -> a -> Bool == TypeValue param' Bool -> Bool -> Bool && TypeValue ret TypeValue -> TypeValue -> Bool forall a. Eq a => a -> a -> Bool == TypeValue ret' (TType TypeValue received', TType TypeValue expected') -> TypeValue received' TypeValue -> TypeValue -> Bool forall a. Eq a => a -> a -> Bool == TypeValue expected' (TypeValue TString, TypeValue TString) -> Bool True (TypeValue TBool, TypeValue TBool) -> Bool True (TypeValue TInt, TypeValue TInt) -> Bool True (TType TypeValue _, TypeValue TTypeHole) -> Bool True (TypeValue TTypeHole, TType TypeValue _) -> Bool True (TypeValue, TypeValue) _ -> Bool False type Context = Map String TypeValue checker :: SExpr -> Either String TypeValue checker :: SExpr -> Either String TypeValue checker = Context -> SExpr -> Either String TypeValue typeCheck Context baseCtx where baseCtx :: Context baseCtx = [(String, TypeValue)] -> Context forall k a. Ord k => [(k, a)] -> Map k a fromList [ (String "print", TypeValue -> TypeValue -> TypeValue TFunction TypeValue TString TypeValue TString) ] typeCheck :: Context -> SExpr -> Either String TypeValue typeCheck :: Context -> SExpr -> Either String TypeValue typeCheck Context ctx (SLetInfer String name SExpr value SExpr next) = do TypeValue value' <- Context -> SExpr -> Either String TypeValue typeCheck Context ctx SExpr value let ctx' :: Context ctx' = String -> TypeValue -> Context -> Context forall k a. Ord k => k -> a -> Map k a -> Map k a Map.insert String name TypeValue value' Context ctx Context -> SExpr -> Either String TypeValue typeCheck Context ctx' SExpr next typeCheck Context ctx (SLet String name SExpr expectedT SExpr value SExpr next) = do TypeValue expectedT' <- Context -> SExpr -> Either String TypeValue typeCheck Context ctx SExpr expectedT TypeValue receivedT <- Context -> SExpr -> Either String TypeValue typeCheck Context ctx SExpr value let ctx' :: Context ctx' = String -> TypeValue -> Context -> Context forall k a. Ord k => k -> a -> Map k a -> Map k a Map.insert String name TypeValue receivedT Context ctx if TypeValue receivedT TypeValue -> TypeValue -> Bool forall a. Eq a => a -> a -> Bool == TypeValue expectedT' then Context -> SExpr -> Either String TypeValue typeCheck Context ctx' SExpr next else String -> Either String TypeValue forall a b. a -> Either a b Left (String -> Either String TypeValue) -> String -> Either String TypeValue forall a b. (a -> b) -> a -> b $ String "Var<" String -> ShowS forall a. [a] -> [a] -> [a] ++ String name String -> ShowS forall a. [a] -> [a] -> [a] ++ String "> of type <" String -> ShowS forall a. [a] -> [a] -> [a] ++ TypeValue -> String forall a. Show a => a -> String show TypeValue expectedT' String -> ShowS forall a. [a] -> [a] -> [a] ++ String "> trying to be assigned with <" String -> ShowS forall a. [a] -> [a] -> [a] ++ TypeValue -> String forall a. Show a => a -> String show TypeValue receivedT String -> ShowS forall a. [a] -> [a] -> [a] ++ String ">" typeCheck Context ctx (STypeAlias String name SExpr t SExpr next) = do TypeValue t' <- Context -> SExpr -> Either String TypeValue typeCheck Context ctx SExpr t let ctx' :: Context ctx' = String -> TypeValue -> Context -> Context forall k a. Ord k => k -> a -> Map k a -> Map k a Map.insert String name (TypeValue -> TypeValue TType TypeValue t') Context ctx Context -> SExpr -> Either String TypeValue typeCheck Context ctx' SExpr next typeCheck Context ctx (SDefInfer String param (SType String "Type") SExpr body) = do let body' :: TypeValue -> Either String TypeValue body' TypeValue arg = Context -> SExpr -> Either String TypeValue typeCheck (String -> TypeValue -> Context -> Context forall k a. Ord k => k -> a -> Map k a -> Map k a Map.insert String param TypeValue arg Context ctx) SExpr body TypeValue -> Either String TypeValue forall a. a -> Either String a forall (f :: * -> *) a. Applicative f => a -> f a pure (TypeValue -> Either String TypeValue) -> TypeValue -> Either String TypeValue forall a b. (a -> b) -> a -> b $ String -> (TypeValue -> Either String TypeValue) -> TypeValue TGeneric String param TypeValue -> Either String TypeValue body' typeCheck Context ctx (SDefInfer String param SExpr paramT SExpr body) = do TypeValue paramT' <- Context -> SExpr -> Either String TypeValue typeCheck Context ctx SExpr paramT let ctx' :: Context ctx' = String -> TypeValue -> Context -> Context forall k a. Ord k => k -> a -> Map k a -> Map k a Map.insert String param TypeValue paramT' Context ctx TypeValue receivedT <- Context -> SExpr -> Either String TypeValue typeCheck Context ctx' SExpr body TypeValue -> Either String TypeValue forall a. a -> Either String a forall (f :: * -> *) a. Applicative f => a -> f a pure (TypeValue -> Either String TypeValue) -> TypeValue -> Either String TypeValue forall a b. (a -> b) -> a -> b $ TypeValue -> TypeValue -> TypeValue TFunction TypeValue paramT' TypeValue receivedT typeCheck Context ctx (SDef String param SExpr paramT SExpr retT SExpr body) = do TypeValue paramT' <- Context -> SExpr -> Either String TypeValue typeCheck Context ctx SExpr paramT TypeValue retT' <- Context -> SExpr -> Either String TypeValue typeCheck Context ctx SExpr retT let ctx' :: Context ctx' = String -> TypeValue -> Context -> Context forall k a. Ord k => k -> a -> Map k a -> Map k a Map.insert String param TypeValue paramT' Context ctx TypeValue receivedT <- Context -> SExpr -> Either String TypeValue typeCheck Context ctx' SExpr body if TypeValue receivedT TypeValue -> TypeValue -> Bool forall a. Eq a => a -> a -> Bool == TypeValue retT' then TypeValue -> Either String TypeValue forall a. a -> Either String a forall (f :: * -> *) a. Applicative f => a -> f a pure (TypeValue -> Either String TypeValue) -> TypeValue -> Either String TypeValue forall a b. (a -> b) -> a -> b $ TypeValue -> TypeValue -> TypeValue TFunction TypeValue paramT' TypeValue retT' else String -> Either String TypeValue forall a b. a -> Either a b Left (String -> Either String TypeValue) -> String -> Either String TypeValue forall a b. (a -> b) -> a -> b $ String "Function returning <" String -> ShowS forall a. [a] -> [a] -> [a] ++ TypeValue -> String forall a. Show a => a -> String show TypeValue retT' String -> ShowS forall a. [a] -> [a] -> [a] ++ String "> but body with type <" String -> ShowS forall a. [a] -> [a] -> [a] ++ TypeValue -> String forall a. Show a => a -> String show TypeValue receivedT String -> ShowS forall a. [a] -> [a] -> [a] ++ String ">" typeCheck Context ctx (SConditional SExpr _ SExpr cthen SExpr celse) = do TypeValue cthenT <- Context -> SExpr -> Either String TypeValue typeCheck Context ctx SExpr cthen TypeValue celseT <- Context -> SExpr -> Either String TypeValue typeCheck Context ctx SExpr celse TypeValue -> Either String TypeValue forall a. a -> Either String a forall (f :: * -> *) a. Applicative f => a -> f a pure (TypeValue -> Either String TypeValue) -> TypeValue -> Either String TypeValue forall a b. (a -> b) -> a -> b $ TypeValue -> TypeValue -> TypeValue TUnion TypeValue cthenT TypeValue celseT typeCheck Context ctx (SApp SExpr func SExpr received) = do TypeValue funcT <- Context -> SExpr -> Either String TypeValue typeCheck Context ctx SExpr func case TypeValue funcT of TGeneric String _ TypeValue -> Either String TypeValue body -> do TypeValue receivedT <- Context -> SExpr -> Either String TypeValue typeCheck Context ctx SExpr received TypeValue -> Either String TypeValue body (TypeValue -> Either String TypeValue) -> TypeValue -> Either String TypeValue forall a b. (a -> b) -> a -> b $ TypeValue -> TypeValue TType TypeValue receivedT TFunction TypeValue expectedT TypeValue retT -> do TypeValue receivedT <- Context -> SExpr -> Either String TypeValue typeCheck Context ctx SExpr received if TypeValue receivedT TypeValue -> TypeValue -> Bool forall a. Eq a => a -> a -> Bool == TypeValue expectedT then TypeValue -> Either String TypeValue forall a. a -> Either String a forall (f :: * -> *) a. Applicative f => a -> f a pure TypeValue retT else String -> Either String TypeValue forall a b. a -> Either a b Left (String -> Either String TypeValue) -> String -> Either String TypeValue forall a b. (a -> b) -> a -> b $ String "Trying to call Function<" String -> ShowS forall a. [a] -> [a] -> [a] ++ SExpr -> String forall a. Show a => a -> String show SExpr func String -> ShowS forall a. [a] -> [a] -> [a] ++ String "><" String -> ShowS forall a. [a] -> [a] -> [a] ++ TypeValue -> String forall a. Show a => a -> String show TypeValue expectedT String -> ShowS forall a. [a] -> [a] -> [a] ++ String "> with Param<" String -> ShowS forall a. [a] -> [a] -> [a] ++ TypeValue -> String forall a. Show a => a -> String show TypeValue receivedT String -> ShowS forall a. [a] -> [a] -> [a] ++ String ">" TypeValue t -> String -> Either String TypeValue forall a b. a -> Either a b Left (String -> Either String TypeValue) -> String -> Either String TypeValue forall a b. (a -> b) -> a -> b $ String "Applying invalid variable <" String -> ShowS forall a. [a] -> [a] -> [a] ++ SExpr -> String forall a. Show a => a -> String show SExpr func String -> ShowS forall a. [a] -> [a] -> [a] ++ String "> of type <" String -> ShowS forall a. [a] -> [a] -> [a] ++ TypeValue -> String forall a. Show a => a -> String show TypeValue t String -> ShowS forall a. [a] -> [a] -> [a] ++ String ">" typeCheck Context ctx (SPlus SExpr x SExpr y) = do TypeValue x' <- Context -> SExpr -> Either String TypeValue typeCheck Context ctx SExpr x TypeValue y' <- Context -> SExpr -> Either String TypeValue typeCheck Context ctx SExpr y if TypeValue x' TypeValue -> TypeValue -> Bool forall a. Eq a => a -> a -> Bool == TypeValue TInt Bool -> Bool -> Bool && TypeValue y' TypeValue -> TypeValue -> Bool forall a. Eq a => a -> a -> Bool == TypeValue TInt then TypeValue -> Either String TypeValue forall a. a -> Either String a forall (f :: * -> *) a. Applicative f => a -> f a pure TypeValue TInt else String -> Either String TypeValue forall a b. a -> Either a b Left (String -> Either String TypeValue) -> String -> Either String TypeValue forall a b. (a -> b) -> a -> b $ String "Calling sum with invalid params: [ " String -> ShowS forall a. [a] -> [a] -> [a] ++ TypeValue -> String forall a. Show a => a -> String show TypeValue x' String -> ShowS forall a. [a] -> [a] -> [a] ++ String " - " String -> ShowS forall a. [a] -> [a] -> [a] ++ SExpr -> String forall a. Show a => a -> String show SExpr y String -> ShowS forall a. [a] -> [a] -> [a] ++ String " ]" typeCheck Context ctx (SMinus SExpr x SExpr y) = do TypeValue x' <- Context -> SExpr -> Either String TypeValue typeCheck Context ctx SExpr x TypeValue y' <- Context -> SExpr -> Either String TypeValue typeCheck Context ctx SExpr y if TypeValue x' TypeValue -> TypeValue -> Bool forall a. Eq a => a -> a -> Bool == TypeValue TInt Bool -> Bool -> Bool && TypeValue y' TypeValue -> TypeValue -> Bool forall a. Eq a => a -> a -> Bool == TypeValue TInt then TypeValue -> Either String TypeValue forall a. a -> Either String a forall (f :: * -> *) a. Applicative f => a -> f a pure TypeValue TInt else String -> Either String TypeValue forall a b. a -> Either a b Left (String -> Either String TypeValue) -> String -> Either String TypeValue forall a b. (a -> b) -> a -> b $ String "Calling subtraction with invalid params: [ " String -> ShowS forall a. [a] -> [a] -> [a] ++ TypeValue -> String forall a. Show a => a -> String show TypeValue x' String -> ShowS forall a. [a] -> [a] -> [a] ++ String " - " String -> ShowS forall a. [a] -> [a] -> [a] ++ TypeValue -> String forall a. Show a => a -> String show TypeValue y' String -> ShowS forall a. [a] -> [a] -> [a] ++ String " ]" typeCheck Context ctx (SDiv SExpr x SExpr y) = do TypeValue x' <- Context -> SExpr -> Either String TypeValue typeCheck Context ctx SExpr x TypeValue y' <- Context -> SExpr -> Either String TypeValue typeCheck Context ctx SExpr y if TypeValue x' TypeValue -> TypeValue -> Bool forall a. Eq a => a -> a -> Bool == TypeValue TInt Bool -> Bool -> Bool && TypeValue y' TypeValue -> TypeValue -> Bool forall a. Eq a => a -> a -> Bool == TypeValue TInt then TypeValue -> Either String TypeValue forall a. a -> Either String a forall (f :: * -> *) a. Applicative f => a -> f a pure TypeValue TInt else String -> Either String TypeValue forall a b. a -> Either a b Left (String -> Either String TypeValue) -> String -> Either String TypeValue forall a b. (a -> b) -> a -> b $ String "Calling division with invalid params: [ " String -> ShowS forall a. [a] -> [a] -> [a] ++ TypeValue -> String forall a. Show a => a -> String show TypeValue x' String -> ShowS forall a. [a] -> [a] -> [a] ++ String " - " String -> ShowS forall a. [a] -> [a] -> [a] ++ SExpr -> String forall a. Show a => a -> String show SExpr y String -> ShowS forall a. [a] -> [a] -> [a] ++ String " ]" typeCheck Context ctx (STimes SExpr x SExpr y) = do TypeValue x' <- Context -> SExpr -> Either String TypeValue typeCheck Context ctx SExpr x TypeValue y' <- Context -> SExpr -> Either String TypeValue typeCheck Context ctx SExpr y if TypeValue x' TypeValue -> TypeValue -> Bool forall a. Eq a => a -> a -> Bool == TypeValue TInt Bool -> Bool -> Bool && TypeValue y' TypeValue -> TypeValue -> Bool forall a. Eq a => a -> a -> Bool == TypeValue TInt then TypeValue -> Either String TypeValue forall a. a -> Either String a forall (f :: * -> *) a. Applicative f => a -> f a pure TypeValue TInt else String -> Either String TypeValue forall a b. a -> Either a b Left (String -> Either String TypeValue) -> String -> Either String TypeValue forall a b. (a -> b) -> a -> b $ String "Calling multiplication with invalid params: [ " String -> ShowS forall a. [a] -> [a] -> [a] ++ TypeValue -> String forall a. Show a => a -> String show TypeValue x' String -> ShowS forall a. [a] -> [a] -> [a] ++ String " - " String -> ShowS forall a. [a] -> [a] -> [a] ++ TypeValue -> String forall a. Show a => a -> String show TypeValue y' String -> ShowS forall a. [a] -> [a] -> [a] ++ String " ]" typeCheck Context ctx (SAnd SExpr x SExpr y) = do TypeValue x' <- Context -> SExpr -> Either String TypeValue typeCheck Context ctx SExpr x TypeValue y' <- Context -> SExpr -> Either String TypeValue typeCheck Context ctx SExpr y TypeValue -> Either String TypeValue forall a. a -> Either String a forall (f :: * -> *) a. Applicative f => a -> f a pure (TypeValue -> Either String TypeValue) -> TypeValue -> Either String TypeValue forall a b. (a -> b) -> a -> b $ TypeValue -> TypeValue -> TypeValue TUnion TypeValue x' TypeValue y' typeCheck Context ctx (SOr SExpr x SExpr y) = do TypeValue x' <- Context -> SExpr -> Either String TypeValue typeCheck Context ctx SExpr x TypeValue y' <- Context -> SExpr -> Either String TypeValue typeCheck Context ctx SExpr y TypeValue -> Either String TypeValue forall a. a -> Either String a forall (f :: * -> *) a. Applicative f => a -> f a pure (TypeValue -> Either String TypeValue) -> TypeValue -> Either String TypeValue forall a b. (a -> b) -> a -> b $ TypeValue -> TypeValue -> TypeValue TUnion TypeValue x' TypeValue y' typeCheck Context ctx (SBrack SExpr expr) = Context -> SExpr -> Either String TypeValue typeCheck Context ctx SExpr expr typeCheck Context ctx (SName String name) = case String -> Context -> Maybe TypeValue forall k a. Ord k => k -> Map k a -> Maybe a Map.lookup String name Context ctx of Just TypeValue t -> TypeValue -> Either String TypeValue forall a b. b -> Either a b Right TypeValue t Maybe TypeValue Nothing -> String -> Either String TypeValue forall a b. a -> Either a b Left (String -> Either String TypeValue) -> String -> Either String TypeValue forall a b. (a -> b) -> a -> b $ String "Variable not initialized: " String -> ShowS forall a. [a] -> [a] -> [a] ++ String name typeCheck Context _ (SInt Integer _) = TypeValue -> Either String TypeValue forall a b. b -> Either a b Right TypeValue TInt typeCheck Context _ (SBool Bool _) = TypeValue -> Either String TypeValue forall a b. b -> Either a b Right TypeValue TBool typeCheck Context _ (SString String _) = TypeValue -> Either String TypeValue forall a b. b -> Either a b Right TypeValue TString typeCheck Context ctx (STypeIntersection SExpr l SExpr r) = do TypeValue l' <- Context -> SExpr -> Either String TypeValue typeCheck Context ctx SExpr l TypeValue r' <- Context -> SExpr -> Either String TypeValue typeCheck Context ctx SExpr r TypeValue -> Either String TypeValue forall a. a -> Either String a forall (f :: * -> *) a. Applicative f => a -> f a pure (TypeValue -> Either String TypeValue) -> TypeValue -> Either String TypeValue forall a b. (a -> b) -> a -> b $ TypeValue -> TypeValue -> TypeValue TIntersection TypeValue l' TypeValue r' typeCheck Context ctx (STypeUnion SExpr l SExpr r) = do TypeValue l' <- Context -> SExpr -> Either String TypeValue typeCheck Context ctx SExpr l TypeValue r' <- Context -> SExpr -> Either String TypeValue typeCheck Context ctx SExpr r TypeValue -> Either String TypeValue forall a. a -> Either String a forall (f :: * -> *) a. Applicative f => a -> f a pure (TypeValue -> Either String TypeValue) -> TypeValue -> Either String TypeValue forall a b. (a -> b) -> a -> b $ TypeValue -> TypeValue -> TypeValue TUnion TypeValue l' TypeValue r' typeCheck Context ctx (STypeof SExpr expr) = Context -> SExpr -> Either String TypeValue typeCheck Context ctx SExpr expr typeCheck Context _ (SType String "Int") = TypeValue -> Either String TypeValue forall a b. b -> Either a b Right TypeValue TInt typeCheck Context _ (SType String "String") = TypeValue -> Either String TypeValue forall a b. b -> Either a b Right TypeValue TString typeCheck Context _ (SType String "Bool") = TypeValue -> Either String TypeValue forall a b. b -> Either a b Right TypeValue TBool typeCheck Context _ (SType String "Type") = TypeValue -> Either String TypeValue forall a b. b -> Either a b Right TypeValue TTypeHole typeCheck Context ctx (SType String t) = do case String -> Context -> Maybe TypeValue forall k a. Ord k => k -> Map k a -> Maybe a Map.lookup String t Context ctx of Just (TType TypeValue t') -> TypeValue -> Either String TypeValue forall a b. b -> Either a b Right TypeValue t' Just (TypeValue TTypeHole) -> TypeValue -> Either String TypeValue forall a b. b -> Either a b Right TypeValue TTypeHole Just TypeValue t' -> String -> Either String TypeValue forall a b. a -> Either a b Left (String -> Either String TypeValue) -> String -> Either String TypeValue forall a b. (a -> b) -> a -> b $ String "Trying to type with a value <" String -> ShowS forall a. [a] -> [a] -> [a] ++ String t String -> ShowS forall a. [a] -> [a] -> [a] ++ String "> as: " String -> ShowS forall a. [a] -> [a] -> [a] ++ TypeValue -> String forall a. Show a => a -> String show TypeValue t' Maybe TypeValue Nothing -> String -> Either String TypeValue forall a b. a -> Either a b Left (String -> Either String TypeValue) -> String -> Either String TypeValue forall a b. (a -> b) -> a -> b $ String "Type not implemented: " String -> ShowS forall a. [a] -> [a] -> [a] ++ String t typeCheck Context ctx (STypeFunc SExpr t SExpr r) = do TypeValue t' <- Context -> SExpr -> Either String TypeValue typeCheck Context ctx SExpr t TypeValue r' <- Context -> SExpr -> Either String TypeValue typeCheck Context ctx SExpr r TypeValue -> Either String TypeValue forall a. a -> Either String a forall (f :: * -> *) a. Applicative f => a -> f a pure (TypeValue -> Either String TypeValue) -> TypeValue -> Either String TypeValue forall a b. (a -> b) -> a -> b $ TypeValue -> TypeValue -> TypeValue TFunction TypeValue t' TypeValue r'