[feat:treewide] add comparison operators

Author: uditkarode

src/Evaluator/Evaluator.hs

@@ -24,7 +24,7 @@ evaluateExpression gd ld (Unary op expr) =
   analyseUnaryOp op expr
 -- replace with the result of function call
 evaluateExpression gd ld (FunctionCall name argExprs) =
-  evaluateFunctionCall gd ld name evaluateExpression argExprs evalNative
+  evaluateFunctionCall gd ld name evaluateExpression argExprs (curry evalNative)
 -- replace with the if-true (ift) or if-false (iff) expr
 evaluateExpression gd ld (Conditional cond ift iff) = do
   evaluateExpression gd ld cond >>= \case

src/Evaluator/NativeFns.hs

@@ -38,21 +38,43 @@ getStr x = case x of
   FunctionDef txt vdt x1 exs b -> "nil"
   y -> error $ "could not get string from " <> show y
 
-evalNative :: T.Text -> VDataType -> [Expr] -> IO Expr
-evalNative "+i" Int args = pure $ IntLiteral $ round (sum (map getNumber args))
-evalNative "+f" Float args = pure $ FloatLiteral (sum (map getNumber args))
-evalNative "-i" Int args = pure $ IntLiteral $ round (foldl1 (-) (map getNumber args))
-evalNative "-f" Float args = pure $ FloatLiteral (foldl1 (-) (map getNumber args))
-evalNative "*i" Int args = pure $ IntLiteral $ round (product (map getNumber args))
-evalNative "*f" Float args = pure $ FloatLiteral (product (map getNumber args))
-evalNative "/i" Int args = pure $ IntLiteral $ round (foldl1 (/) (map getNumber args))
-evalNative "/f" Float args = pure $ FloatLiteral (foldl1 (/) (map getNumber args))
-evalNative "str" String args = pure $ StrLiteral (foldl1 (<>) (map getStr args))
-evalNative "print" NilType args = (putStrLn . T.unpack) (foldl1 (<>) (map getStr args)) >> pure Nil
-evalNative ">" Bool exprs =
-  if length exprs == 2
-    then case (head exprs, exprs !! 1) of
-      (IntLiteral iv, IntLiteral iv') -> pure $ BoolLiteral (iv > iv')
-      _ -> undefined -- TODO
-    else error "can only equality check two arguments"
-evalNative name _ _ = error $ "evaluator does not know how to execute the native function '" <> T.unpack name <> "'"
+evalNative :: (T.Text, VDataType) -> [Expr] -> IO Expr
+evalNative nt args
+  | nt == ("+i", Int) = pure $ IntLiteral $ round (sum (map getNumber args))
+  | nt == ("+f", Float) = pure $ FloatLiteral (sum (map getNumber args))
+  | nt == ("-i", Int) = pure $ IntLiteral $ round (foldl1 (-) (map getNumber args))
+  | nt == ("-f", Float) = pure $ FloatLiteral (foldl1 (-) (map getNumber args))
+  | nt == ("*i", Int) = pure $ IntLiteral $ round (product (map getNumber args))
+  | nt == ("*f", Float) = pure $ FloatLiteral (product (map getNumber args))
+  | nt == ("/i", Int) = pure $ IntLiteral $ round (foldl1 (/) (map getNumber args))
+  | nt == ("/f", Float) = pure $ FloatLiteral (foldl1 (/) (map getNumber args))
+  | nt == ("str", String) = pure $ StrLiteral (foldl1 (<>) (map getStr args))
+  | nt == ("print", NilType) = (putStrLn . T.unpack) (foldl1 (<>) (map getStr args)) >> pure Nil
+  | nt == (">", Bool)
+      || nt == (">=", Bool)
+      || nt == ("<", Bool)
+      || nt == ("<=", Bool)
+      || nt == ("/=", Bool)
+      || nt == ("==", Bool) =
+    if length args == 2
+      then case (head args, args !! 1) of
+        (IntLiteral iv, IntLiteral iv') ->
+          pure $
+            BoolLiteral
+              ( ( case fst nt of
+                    ">" -> (>)
+                    ">=" -> (>=)
+                    "<" -> (<)
+                    "<=" -> (<=)
+                    "==" -> (==)
+                    "!=" -> (/=)
+                )
+                  iv
+                  iv'
+              )
+        (FloatLiteral iv, IntLiteral iv') -> pure $ BoolLiteral (iv > fromIntegral iv')
+        (IntLiteral iv, FloatLiteral iv') -> pure $ BoolLiteral (fromIntegral iv > iv')
+        (FloatLiteral iv, FloatLiteral iv') -> pure $ BoolLiteral (iv > iv')
+        (x, y) -> error $ "Can't compare " <> show x <> " with " <> show y
+      else error "can only equality check two arguments"
+  | otherwise = error $ "evaluator does not know how to execute the native function '" <> T.unpack (fst nt) <> "'"

src/Main.hs

@@ -36,7 +36,7 @@ import Transpiler.Backends.JS.JS (jsBackend, jsStdlib)
 import Transpiler.Transpiler (transpile)
 
 axlStdlib :: T.Text
-axlStdlib = B.decodeUtf8 $(embedFile "stdlib/stdlib.axl")
+axlStdlib = "nil\n" <> B.decodeUtf8 $(embedFile "stdlib/stdlib.axl")
 
 makeNativeFunction :: VDataType -> Def
 makeNativeFunction ret = AU.Function ret ([("args", Any)], True) [] True

src/Parser/Combinators.hs

@@ -9,7 +9,7 @@ import Data.Text as T (Text, pack, unpack)
 import qualified Data.Text as T
 import Data.Void (Void)
 import Parser.Ast
-  ( VDataType (ArrayOf, Bool, Float, Inferred, Int, NilType, String, Any),
+  ( VDataType (Any, ArrayOf, Bool, Float, Inferred, Int, NilType, String),
   )
 import Text.Megaparsec
   ( MonadParsec (notFollowedBy, observing, takeWhileP, try),
@@ -102,12 +102,12 @@ rword :: String -> Parser ()
 rword w = (lexeme . try) (string (pack w) *> notFollowedBy alphaNumChar)
 
 mathSymbol :: Parser Char
-mathSymbol = single '+' <|> single '-' <|> single '/' <|> single '%' <|> single '*' <|> single '>'
+mathSymbol = single '+' <|> single '-' <|> single '/' <|> single '%' <|> single '*' <|> single '>' <|> single '<' <|> single '=' <|> single '!'
 
 identifier :: Parser Text
 identifier = (lexeme . try) (p <&> pack)
   where
-    p = (:) <$> (letterChar <|> mathSymbol) <*> many (alphaNumChar <|> single '-' <|> single '?' <|> single '_')
+    p = (:) <$> (letterChar <|> mathSymbol) <*> many (alphaNumChar <|> single '-' <|> single '?' <|> single '_' <|> single '=')
 
 getTypeFromStr :: Text -> Parser VDataType
 getTypeFromStr "string" = pure String

stdlib/stdlib.axl

@@ -1,14 +1,27 @@
+; addition
 (native defun (+i: int) [&(args: int)])
 (native defun (+f: float) [&(args: any)])
 
+; subtraction
 (native defun (-i: int) [&(args: int)])
 (native defun (-f: float) [&(args: any)])
 
+; multiplication
 (native defun (*i: int) [&(args: int)])
 (native defun (*f: float) [&(args: any)])
 
+; division
 (native defun (/i: int) [&(args: int)])
 (native defun (/f: float) [&(args: any)])
 
+; utility
 (native defun (print: nil) [&(args: any)])
 (native defun (str: string) [&(args: any)])
+
+; comparison
+(native defun (>: bool) [(a: int) (b: int)])
+(native defun (>=: bool) [(a: int) (b: int)])
+(native defun (<: bool) [(a: int) (b: int)])
+(native defun (<=: bool) [(a: int) (b: int)])
+(native defun (==: bool) [(a: int) (b: int)])
+(native defun (!=: bool) [(a: int) (b: int)])