Merge pull request #95 from Hoxmot/feature/15-static-typing

[#84] Static typing: print

src/TypeChecker.hs

@@ -16,6 +16,7 @@ import qualified TypeChecker.Memory   as Mem
 import           TypeChecker.Types
 import           TypeChecker.Util
 import           Types                (Err)
+import Util (getExpPos)
 
 
 {- | Checks the types in the given program. The check is pefrormed in a static manner.
@@ -218,6 +219,19 @@ checkTypesIFunc iFunc@(BG.ILambda pos t (BG.AList _ argsList) exps) = do
   where
     argToType (BG.AArg _ at _) = checkTypesType at
 
+{- | For the print function, we check all the arguments and the types to which they'll
+evaluate. If any of the evaluated values is a function, we thorw an error as we can't
+print functions.
+
+The type of the function is unit.
+-}
+checkTypesIFunc iFunc@(BG.IPrint pos exps) =
+    checkTypesPrint exps `catchError` printTypesErrorHandler iFunc pos
+  where
+    checkTypesPrint exps = do
+        mapM_ checkPrintTypeExp exps
+        return TUnit
+
 checkTypesIFunc e = throwError $ "Checking types for internal function: " ++ show e
     ++ " is not yet implemented"
 
@@ -284,3 +298,15 @@ checkTypesType (BG.TVar _) = return TVar
 checkTypesType (BG.TBool _) = return TBool
 checkTypesType e = throwError $ "Checking types of type: " ++ show e
     ++ " is not yet implemented"
+
+{- | Checks the types of each of the arguments for the print function. Only functions
+cannot be printed. The rest of the values can be printed.
+It's worth noting that all the expressions are evaluated, regardless if they return a unit
+or other value.
+-}
+checkPrintTypeExp :: BG.Exp -> CheckTypeState
+checkPrintTypeExp ex = do
+    t <- checkTypesExp ex
+    case t of
+        TFunc _ _ -> throwError (notPrintableError ex $ getExpPos ex)
+        _ -> return t

src/TypeChecker/Util.hs

@@ -1,6 +1,8 @@
 module TypeChecker.Util
     ( -- * Functions
-      varNotFoundHandler
+      notPrintableError
+      , printTypesErrorHandler
+      , varNotFoundHandler
       , typesError
   ) where
 
@@ -18,6 +20,10 @@ for more readability.
 varNotFoundHandler :: Print a => a -> BG.BNFC'Position -> String -> CheckTypeState
 varNotFoundHandler ex pos er = throwError $ varNotFoundError ex er pos
 
+-- | Handler of 'types don't match' error for print function.
+printTypesErrorHandler :: Print a => a -> BG.BNFC'Position -> String -> CheckTypeState
+printTypesErrorHandler ex pos er = throwError $ printTypesError 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
@@ -27,6 +33,16 @@ 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 ++ ")"
 
+-- | Creates a message about types error inside the print internal function.
+notPrintableError :: Print a => a -> BG.BNFC'Position -> String
+notPrintableError ex (Just (line, col)) = "Types don't match! In line " ++ show line
+    ++ ", column " ++ show col
+    ++ ":\n  Expected printable, but got function. You cannot print a function!\n    "
+    ++ printTree ex
+notPrintableError ex Nothing =
+    "Types don't match! At undetermined position:\n  Expected printable, but got function."
+    ++ " You cannot print a function!\n    " ++ printTree ex
+
 {- | Extends a simple information regaring 'variable not found' error with information
 position of the erorr and the code itself.
 -}
@@ -35,3 +51,14 @@ 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
+
+{- | Extends a simple information regarding 'types don't match' for internal function
+print. Nicely wraps the error and adds more information.
+-}
+printTypesError :: Print a => a -> String -> BG.BNFC'Position -> String
+printTypesError ex er (Just (line, col)) =
+    "Types don't match! In operation 'print' in line " ++ show line ++ ", column "
+    ++ show col ++ ":\n  " ++ printTree ex ++ "\nRoot exception:\n" ++ er
+printTypesError ex er Nothing =
+    "Types don't match! In operation 'print' at undetermined position:\n  "
+    ++ printTree ex ++ "Root exception:\n" ++ er

src/Util.hs

@@ -5,6 +5,7 @@ module Util
       -- * Util functions
       , checkParentheses
       , exit
+      , getExpPos
       , showTree
       , printResponse
       , readCommand
@@ -17,6 +18,7 @@ module Util
 import           System.Exit       (ExitCode (ExitFailure), exitFailure,
                                     exitSuccess, exitWith)
 
+import qualified Baalbolge.Abs     as BG
 import           Baalbolge.Print   (Print, printTree)
 import           Interpreter.Types
 
@@ -84,7 +86,7 @@ printResponse :: Result -> IO ()
 printResponse RUnit     = putStrLn ""
 printResponse (RBool b) = print b
 printResponse (RInt v)  = print v
-printResponse RFunc {} = putStrLn "I'm a teapot"
+printResponse RFunc {}  = putStrLn "I'm a teapot"
 printResponse RBFunc {} = putStrLn "I'm a teapot"
 
 exit :: Result -> IO ()
@@ -105,3 +107,13 @@ notImplemented = putStrLn "Not yet implemented..."
 
 notImplementedError :: IO()
 notImplementedError = notImplemented >> putStrLn "Quitting..." >> exitFailure
+
+-- | Gets a position of the expression
+getExpPos :: BG.Exp -> BG.BNFC'Position
+getExpPos (BG.EInt pos _)      = pos
+getExpPos (BG.EBool pos _)     = pos
+getExpPos (BG.EFunc pos _ _)   = pos
+getExpPos (BG.EInternal pos _) = pos
+getExpPos (BG.EVar pos _)      = pos
+getExpPos (BG.EUnit pos)       = pos
+getExpPos (BG.EList pos _)     = pos