From 64880a4e1fc756ad2e2bb818356b9b3e9ba3c402 Mon Sep 17 00:00:00 2001
From: "Juan J. Martinez" <jjm@usebox.net>
Date: Sun, 14 Aug 2022 07:51:14 +0100
Subject: Check type of expressions in calls to be callable

---
 src/Compiler.hs | 50 ++++++++++++++++++++++++++++++--------------------
 1 file changed, 30 insertions(+), 20 deletions(-)

(limited to 'src/Compiler.hs')

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
-- 
cgit v1.2.3