Check type of expressions in calls to be callable

2 files changed, 31 insertions, 21 deletions

diff --git a/src/Compiler.hs b/src/Compiler.hs
index f106bb2..e69ab77 100644
--- a/src/Compiler.hs
+++ b/src/Compiler.hs
@@ -10,7 +10,7 @@ import Text.Read (Lexeme (String))
 
 type CompState = (Env, [Error])
 
-type CompResult = Either [Error] ()
+type CompResult = Either [Error] (Maybe A.Type)
 
 startState :: CompState
 startState = (emptyEnv, [])
@@ -28,11 +28,11 @@ foldlEither fn init xs =
     init
     xs
 
-compile :: [A.Expr] -> State CompState CompResult
-compile (x : xs) = do
+compile :: A.Expr -> State CompState CompResult
+compile x = do
   case x of
-    (A.Module name pos) -> return $ Right ()
-    (A.BinOp _ a b) -> compile [a, b]
+    (A.Module name pos) -> return $ Right Nothing
+    (A.BinOp _ a b) -> compileAll [a, b] -- XXX
     (A.Func ident params ret body priv pos) -> do
       -- current env
       (ev, errs) <- get
@@ -44,28 +44,38 @@ compile (x : xs) = do
       -- with parameters
       (nev, errs) <- return $ foldlEither addSymUniq (addEnv ev, errs) params
       put (nev, errs)
-      r <- compile body
+      r <- compileAll body
       (_, errs) <- get
       -- store updated errors and the env with the function
       put (ev, errs)
-      return r
+      return $ r
     (A.Call ident args pos) -> do
-      id <- compile [ident]
-      return $ Right ()
+      r <- compile ident
+      case r of
+        p@(Right (Just (A.FuncType _ _))) -> return $ p
+        Right _ -> do
+          (ev, errs) <- get
+          put (ev, Error ("value is not callable") pos : errs)
+          return $ Right Nothing
+        Left r -> return $ Right Nothing
     (A.Return value pos) -> case value of
-      Nothing -> return $ Right ()
-      Just v -> compile [v]
+      Just v -> compile v
+      Nothing -> return $ Right Nothing
     (A.Var ident pos) -> do
       (ev, errs) <- get
-      if existsSym ev ident
-        then return $ Right ()
-        else do
-          put (ev, Error ("undefined \"" ++ ident ++ "\"") pos : errs)
-          return $ Right ()
-    _ -> compile []
-  compile xs
-compile [] = do
+      case getSym ev ident of
+        Just (_, t, _) -> return $ Right $ Just t
+        Nothing -> do
+          put (ev, Error ("undefined variable \"" ++ ident ++ "\"") pos : errs)
+          return $ Right Nothing
+    _ -> return $ Right Nothing
+
+compileAll :: [A.Expr] -> State CompState CompResult
+compileAll (x : xs) = do
+  compile x
+  compileAll xs
+compileAll [] = do
   (_, errs) <- get
   case errs of
-    [] -> return $ Right ()
+    [] -> return $ Right Nothing
     _ -> return $ Left errs
diff --git a/src/Main.hs b/src/Main.hs
index 0b4325c..3c75d02 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -15,7 +15,7 @@ main = do
   case res of
     Left err -> hPutStrLn stderr ("error: " ++ show err) >> exitFailure
     Right ast -> do
-      res <- return $ evalState (compile ast) startState
+      res <- return $ evalState (compileAll ast) startState
       case res of
         Right _ -> print ast
         Left errs -> hPutStrLn stderr $ showErrorList errs