From d08042be1e0ae158f124bb6848f5843a804a6544 Mon Sep 17 00:00:00 2001
From: "Juan J. Martinez" <jjm@usebox.net>
Date: Tue, 6 Sep 2022 22:22:32 +0100
Subject: Assignation

---
 src/Ast.hs       |  5 +++--
 src/Compiler.hs  | 13 ++++++++++++-
 src/Error.hs     |  3 ++-
 src/Parser.hs    | 12 ++++++++++--
 test/Language.hs | 35 ++++++++++++++++++++++++++++++++++-
 5 files changed, 61 insertions(+), 7 deletions(-)

diff --git a/src/Ast.hs b/src/Ast.hs
index 075b9f8..4f4a2f9 100644
--- a/src/Ast.hs
+++ b/src/Ast.hs
@@ -22,7 +22,7 @@ type FuncParam = (Ident, Type, Bool, SourcePos)
 data Expr
   = Num Integer SourcePos
   | Bool' Bool SourcePos
-  | BinOp Op Expr Expr
+  | BinOp Op SourcePos Expr Expr
   | Variable Ident SourcePos
   | -- v type value private pos
     Var Ident Type Expr Bool SourcePos
@@ -34,7 +34,8 @@ data Expr
   deriving (Eq, Ord, Show)
 
 data Op
-  = Plus
+  = Assign
+  | Plus
   | Minus
   | Mul
   | Div
diff --git a/src/Compiler.hs b/src/Compiler.hs
index 38b5227..ce68c16 100644
--- a/src/Compiler.hs
+++ b/src/Compiler.hs
@@ -110,7 +110,18 @@ 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 b) -> do
+    (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 _ _) ->
+      addError $ Error InvalidTarget "invalid assignment target" pos
+    (A.BinOp _ _ a b) -> do
       l <- compile a
       r <- compile b
       return $ l -- TODO: placeholder
diff --git a/src/Error.hs b/src/Error.hs
index 9aad85d..d128d32 100644
--- a/src/Error.hs
+++ b/src/Error.hs
@@ -4,7 +4,7 @@ import Data.List (sort)
 import Text.Parsec (SourcePos, errorPos)
 import Text.Parsec.Error (ParseError, errorMessages, showErrorMessages)
 
-data ErrorType = GenericError | TypeError | UnexpectedReturn | AlreadyDefined | NonCallable | Undefined | UndefinedType deriving (Show)
+data ErrorType = GenericError | TypeError | UnexpectedReturn | AlreadyDefined | NonCallable | Undefined | UndefinedType | InvalidTarget deriving (Show)
 
 instance Enum ErrorType where
   fromEnum GenericError = 0
@@ -14,6 +14,7 @@ instance Enum ErrorType where
   fromEnum NonCallable = 4
   fromEnum Undefined = 5
   fromEnum UndefinedType = 6
+  fromEnum InvalidTarget = 7
   toEnum _ = error "toEnum is undefined for Error"
 
 data Error = Error ErrorType String SourcePos
diff --git a/src/Parser.hs b/src/Parser.hs
index 5ee6de9..12f04d9 100644
--- a/src/Parser.hs
+++ b/src/Parser.hs
@@ -7,10 +7,18 @@ import Text.Parsec
 import qualified Text.Parsec.Expr as E
 import Text.Parsec.String (Parser)
 
-binary s f assoc = E.Infix (reservedOp s >> return (BinOp f)) assoc
+binary s f assoc =
+  E.Infix
+    ( reservedOp s
+        >> do
+          pos <- getPosition
+          return $ BinOp f pos
+    )
+    assoc
 
 opTable =
-  [ [ binary "*" Mul E.AssocLeft,
+  [ [binary "=" Assign E.AssocLeft],
+    [ binary "*" Mul E.AssocLeft,
       binary "/" Div E.AssocLeft
     ],
     [ binary "+" Plus E.AssocLeft,
diff --git a/test/Language.hs b/test/Language.hs
index 5c1bb57..0b7d6ac 100644
--- a/test/Language.hs
+++ b/test/Language.hs
@@ -228,6 +228,18 @@ testCase16 =
           A.Var "b" (A.Type "bool") (A.Bool' True $ newPos "test" 3 11) True $ newPos "test" 3 1
         ]
 
+testCase17 =
+  TestLabel "parse assignation" $
+    TestCase $
+      assertAst
+        "module main\n\
+        \var a: u8 = 0;\n\
+        \a = 10;"
+        [ A.Module "main" $ newPos "test" 1 1,
+          A.Var "a" (A.Type "u8") (A.Num 0 $ newPos "test" 2 13) False $ newPos "test" 2 5,
+          A.BinOp A.Assign (newPos "test" 3 5) (A.Variable "a" $ newPos "test" 3 1) (A.Num 10 $ newPos "test" 3 5)
+        ]
+
 -- test errors
 
 testCaseE1 =
@@ -349,6 +361,24 @@ testCaseE14 =
         \var a: bool = (a:u8): u8 { return a; };\n"
         E.TypeError
 
+testCaseE15 =
+  TestLabel "invalid assignation target" $
+    TestCase $
+      expectError
+        "module main\n\
+        \def fn() { return; }\n\
+        \fn() = 10;"
+        E.InvalidTarget
+
+testCaseE16 =
+  TestLabel "type mismatch in assignation" $
+    TestCase $
+      expectError
+        "module main\n\
+        \var a: u8 = 0;\n\
+        \a = false;"
+        E.TypeError
+
 language =
   [ testCase2,
     testCase3,
@@ -365,6 +395,7 @@ language =
     testCase14,
     testCase15,
     testCase16,
+    testCase17,
     -- errors
     testCaseE1,
     testCaseE2,
@@ -379,5 +410,7 @@ language =
     testCaseE11,
     testCaseE12,
     testCaseE13,
-    testCaseE14
+    testCaseE14,
+    testCaseE15,
+    testCaseE16
   ]
-- 
cgit v1.2.3