From cd9bd7decd25301a6da01fd97feed1cc33cfabbf Mon Sep 17 00:00:00 2001
From: "Juan J. Martinez" <jjm@usebox.net>
Date: Tue, 6 Sep 2022 22:53:08 +0100
Subject: Typecheck binary operator

---
 src/Compiler.hs | 32 ++++++++++++++++++--------------
 1 file changed, 18 insertions(+), 14 deletions(-)

(limited to 'src/Compiler.hs')

diff --git a/src/Compiler.hs b/src/Compiler.hs
index ce68c16..2a836ee 100644
--- a/src/Compiler.hs
+++ b/src/Compiler.hs
@@ -81,6 +81,19 @@ typecheckReturn Nothing Nothing = return $ Nothing
 typecheckReturn Nothing fret = return $ Just $ "invalid return value\n     found: ()\n  expected: " ++ showMaybet fret
 typecheckReturn (Just value) fret = typecheckVal value fret
 
+-- | @typecheckBinOp a b pos@ resolves @a@ (left) and compares it to the type
+-- of @b@ via typecheckVal.
+typecheckBinOp :: A.Expr -> A.Expr -> SourcePos -> State CompState CompResult
+typecheckBinOp a b pos = do
+  l <- compile a
+  case l of
+    Right tl -> do
+      tr <- typecheckVal b $ tl
+      case tr of
+        Just err -> addError $ Error TypeError err pos
+        Nothing -> return $ Right $ tl
+    _ -> return $ Right Nothing -- error resolving left
+
 -- built-in types
 types = ["bool", "u8", "s8", "u16", "s16"]
 
@@ -110,21 +123,12 @@ compile x = do
     (A.Module name pos) -> return $ Right Nothing
     (A.Num _ _) -> return $ Right $ Just $ A.Type "u8" -- TODO: placeholder
     (A.Bool' _ _) -> return $ Right $ Just $ A.Type "bool"
-    (A.BinOp A.Assign pos a@(A.Variable _ _) b) -> do
-      l <- compile a
-      case l of
-        Right tl -> do
-          tr <- typecheckVal b $ tl
-          case tr of
-            Just err -> addError $ Error TypeError err pos
-            Nothing -> return $ Right $ tl
-        _ -> return $ Right Nothing -- error resolving left
-    (A.BinOp A.Assign pos _ _) ->
+    (A.BinOp A.Assign pos a@(A.Variable _ _) b) ->
+      typecheckBinOp a b pos
+    (A.BinOp A.Assign pos _ b) ->
       addError $ Error InvalidTarget "invalid assignment target" pos
-    (A.BinOp _ _ a b) -> do
-      l <- compile a
-      r <- compile b
-      return $ l -- TODO: placeholder
+    (A.BinOp op pos a b) ->
+      typecheckBinOp a b pos
     (A.Func ident params ret body priv anon pos) -> do
       -- current env
       (ev, errs) <- get
-- 
cgit v1.2.3