Static typing: Variables

src/Interpreter.hs

@@ -24,7 +24,7 @@ interpretExp (BG.EUnit _) = return RUnit
 interpretExp (BG.EInt _ v) = return $ RInt v
 interpretExp (BG.EBool _ b) = interpretBool b
 
-interpretExp e = Left $ "Checking types of exp: " ++ show e ++ " is not yet implemented"
+interpretExp e = Left $ "Interpretation of exp: " ++ show e ++ " is not yet implemented"
 
 interpretBool :: BG.Bool -> Err Result
 interpretBool (BG.BTrue _)  = return $ RBool True

src/TypeChecker.hs

@@ -3,10 +3,15 @@ module TypeChecker
       checkTypes
   ) where
 
-import           Control.Monad (foldM)
+import qualified Data.Map             as M
 
-import qualified Baalbolge.Abs as BG
+import           Control.Monad.Except
+import           Control.Monad.Reader
+import           Control.Monad.State
 
+import qualified Baalbolge.Abs        as BG
+
+import           Baalbolge.Print
 import           Types
 
 {- | Checks the types in the given program. The check is pefrormed in a static manner.
@@ -17,46 +22,154 @@ For the whole program, any type can be returned.
 -}
 checkTypes :: BG.Exps -> Err BG.Exps
 checkTypes prog@(BG.Program _ exps) = do
-    _ <- checkTypesExps exps
+    _ <- runReader (runExceptT $ checkTypesExps exps) M.empty
     return prog
 
 {- | A function, which checks the return type of the list of Exps. The check is run for
-each element of the list of Exps.
+each element of the list of Exps untill we get a type which terminates computation.
 
 For the list of Exps, any type can be returned.
 -}
-checkTypesExps :: [BG.Exp] -> Err Type
-checkTypesExps = foldM expsMapper TUnit
+checkTypesExps :: [BG.Exp] -> CheckTypeReader
+checkTypesExps exps = do
+    env <- ask
+    case evalState (runExceptT $ checkTypesExpsRec TUnit exps) env of
+        Left l  -> throwError l
+        Right r -> return r
 
 {- | A function, which maps Exps from the list and determines the return type of the whole
 list. In Baalbolge, the first Exp to return a type other than Unit determines the return
 Type of the whole list of Exps.
+
+Since the computation is terminated when we get a first value, which isn't unit, we can
+terminate the type checking when we get such a value. However, var can any type including
+unit, so we continue checking the types until we get a type which definetely isn't unit.
 -}
-expsMapper :: Type -> BG.Exp -> Err Type
-expsMapper TUnit e = checkTypesExp e
-expsMapper t e =
-    case checkTypesExp e of
-        Left err -> Left err
-        _        -> Right t
+checkTypesExpsRec :: Type -> [BG.Exp] -> CheckTypeState
+checkTypesExpsRec TUnit (h:t) = do
+    r <- checkTypesExp h
+    case r of
+        TUnit -> checkTypesExpsRec TUnit t
+        TVar  -> checkTypesExpsRec TVar t
+        tp    -> return tp
+checkTypesExpsRec TVar (h:t) = do
+    r <- checkTypesExp h
+    case r of
+        TUnit -> checkTypesExpsRec TVar t
+        TVar  -> checkTypesExpsRec TVar t
+        _     -> return TVar
+-- | if the type of TUnit or TBool, or the list is empty, we simply return the type
+checkTypesExpsRec tp _ = return tp
 
 {- | A function, which determines the return type of a single Exp.
 
 $setup
 >>> let p = Just (2,2)
 >>> let b = (BG.BTrue p)
+>>> test e = evalState (runExceptT e) M.empty
 
->>> checkTypesExp (BG.EUnit p)
-Right TUnit
+>>> test $ checkTypesExp (BG.EUnit p)
+Right unit
 
->>> checkTypesExp (BG.EInt p 42)
-Right TInt
+>>> test $ checkTypesExp (BG.EInt p 42)
+Right int
 
->>> checkTypesExp (BG.EBool p b)
-Right TBool
+>>> test $ checkTypesExp (BG.EBool p b)
+Right bool
 -}
-checkTypesExp :: BG.Exp -> Err Type
+checkTypesExp :: BG.Exp -> CheckTypeState
 checkTypesExp (BG.EUnit _) = return TUnit
 checkTypesExp (BG.EInt _ _) = return TInt
 checkTypesExp (BG.EBool _ _) = return TBool
+checkTypesExp var@(BG.EVar pos v) = checkTypesVar v `catchError` varNotFoundHandler var pos
+checkTypesExp (BG.EInternal _ d) = checkTypesIFunc d
+checkTypesExp e = throwError $ "Checking types of exp: " ++ show e ++ " is not yet implemented"
+
+{- | Checks the type for internal function usage in Baalbolge.
+-}
+checkTypesIFunc :: BG.InternalFunc -> CheckTypeState
+checkTypesIFunc iFunc@(BG.IVarDecl pos t (BG.Var v) e) = do
+    tDecl <- checkTypesType t
+    tExp <- checkTypesExp e
+    st <- get
+    if tDecl == tExp
+      then put (M.insert v tDecl st) >> return TUnit
+      else throwError $ typesError iFunc "VariableDeclaration" pos tDecl tExp
+checkTypesIFunc e = throwError $ "Checking types for internal function: " ++ show e
+    ++ " is not yet implemented"
+
+{- | Returns the type of variable from the state. If there's no variable of the given name
+in the state, an error is thrown.
+
+$setup
+>>> test st e = evalState (runExceptT e) st
+
+>>> test (M.singleton "x" TBool) $ checkTypesVar (BG.Var "x")
+Right bool
+
+>>> test (M.singleton "x" TInt) $ checkTypesVar (BG.Var "x")
+Right int
+
+>>> test (M.singleton "x" TUnit) $ checkTypesVar (BG.Var "x")
+Right unit
+
+>>> test (M.singleton "x" TVar) $ checkTypesVar (BG.Var "x")
+Right var
+-}
+checkTypesVar :: BG.Var -> CheckTypeState
+checkTypesVar (BG.Var v) = do
+    st <- get
+    case M.lookup v st of
+        Just t -> return t
+        Nothing -> throwError $ "variable '" ++ v ++ "' not found!"
+
+{- | Maps a type from code generated by BNF Converter to internal type of the type checker
+implementation.
 
-checkTypesExp e = Left $ "Checking types of exp: " ++ show e ++ " is not yet implemented"
+$setup
+>>> let p = Just (2,2)
+>>> test e = evalState (runExceptT e) M.empty
+
+>>> test $ checkTypesType (BG.TInt p)
+Right int
+
+>>> test $ checkTypesType (BG.TUnit p)
+Right unit
+
+>>> test $ checkTypesType (BG.TVar p)
+Right var
+
+>>> test $ checkTypesType (BG.TBool p)
+Right bool
+-}
+checkTypesType :: BG.Type -> CheckTypeState
+checkTypesType (BG.TInt _) = return TInt
+checkTypesType (BG.TUnit _) = return TUnit
+checkTypesType (BG.TVar _) = return TVar
+checkTypesType (BG.TBool _) = return TBool
+checkTypesType e = throwError $ "Checking types of type: " ++ show e
+    ++ " is not yet implemented"
+
+{- | Handler of 'variable not found' error, which adds details about the error
+for more readability.
+-}
+varNotFoundHandler :: Print a => a -> BG.BNFC'Position -> String -> CheckTypeState
+varNotFoundHandler ex pos er = throwError $ varNotFoundError ex er pos
+
+-- | Creates a message about types error in the code.
+typesError :: Print a => a -> String -> BG.BNFC'Position -> Type -> Type -> String
+typesError ex op (Just (line, col)) t1 t2 = "Types don't match! In operation '" ++ op
+    ++ "' in line " ++ show line ++ ", column " ++ show col ++ ":\n  Expected '"
+    ++ show t1 ++ "' but got '" ++ show t2 ++ "'!\n    (" ++ printTree ex ++ ")"
+typesError ex op Nothing t1 t2 = "Types don't match! In operation '" ++ op
+    ++ "' at undetermined position:\n  Expected '" ++ show t1
+    ++ "' but got '" ++ show t2 ++ "'!\n    (" ++ printTree ex ++ ")"
+
+{- | Extends a simple information regaring 'variable not found' error with information
+position of the erorr and the code itself.
+-}
+varNotFoundError :: Print a => a -> String -> BG.BNFC'Position -> String
+varNotFoundError ex er (Just (line, col)) = er ++ "\n  In line " ++ show line
+    ++ ", column " ++ show col ++ ":\n    " ++ printTree ex
+varNotFoundError ex er Nothing = er ++ "\n  At undetermined position:\n    "
+    ++ printTree ex

src/Types.hs

@@ -1,14 +1,52 @@
 module Types
     ( -- * Data types
       Err
-
+      , CheckTypeReader
+      , CheckTypeState
+
       -- * Data structures
       , Result (..)
       , Type (..)
   ) where
 
+import Control.Monad.Reader
+import Control.Monad.Except
+import Control.Monad.State
+
+import qualified Data.Map as M
+
 type Err = Either String
+type ExT = ExceptT String
+
+type Name = String
+type CheckTypeEnv = M.Map Name Type
 
--- | The representation of types used in Baalbolge
-data Type = TUnit | TInt | TBool | TVar deriving (Show)
+type CheckTypeReader = ExT (Reader CheckTypeEnv) Type
+type CheckTypeState =  ExT (State CheckTypeEnv) Type
+
+-- | The representation of types used in Baalbolge for the purpose of type checking
+data Type = TUnit | TInt | TBool | TVar
+
+{- | The representation of types used in Baalbolge for the purpose of computing the result
+of computation.
+-}
 data Result = RUnit | RInt Integer | RBool Bool deriving (Show)
+
+instance Show Type
+  where
+    show TUnit = "unit"
+    show TInt  = "int"
+    show TBool = "bool"
+    show TVar  = "var"
+
+{- | Specific implementation of Eq for types in type checker. TVar is equal to any type
+in Baalbolge.
+-}
+instance Eq Type
+  where
+    TVar == _ = True
+    _ == TVar = True
+    TUnit == TUnit = True
+    TInt == TInt = True
+    TBool == TBool = True
+    _ == _ = False