From aec05f8d92a608f0fb34fd2453a647b43dcb777d Mon Sep 17 00:00:00 2001
From: Jan Tuomi <jan.tuomi@valuemotive.com>
Date: Sat, 24 Sep 2022 15:04:03 +0300
Subject: Separate Builtins module

---
 src/Builtins.hs | 49 +++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 49 insertions(+)
 create mode 100644 src/Builtins.hs

(limited to 'src/Builtins.hs')

diff --git a/src/Builtins.hs b/src/Builtins.hs
new file mode 100644
index 0000000..71401d8
--- /dev/null
+++ b/src/Builtins.hs
@@ -0,0 +1,49 @@
+module Builtins where
+
+import qualified Data.Map as M
+import Control.Monad.Except
+import Types
+
+builtinEnv :: Env
+builtinEnv = M.fromList [
+    ("+", builtinAdd2),
+    ("-", builtinSubtract2),
+    ("head", builtinHead),
+    ("tail", builtinTail)
+    ]
+
+builtinAdd2 :: AST
+builtinAdd2 =
+    let outer ast1 = do
+            (ASTInteger a) <- assertIsASTInteger ast1
+            let inner ast2 = do
+                    (ASTInteger b) <- assertIsASTInteger ast2
+                    return $ ASTInteger $ a + b
+            return $ ASTFunction $ inner
+     in ASTFunction outer
+
+builtinSubtract2 :: AST
+builtinSubtract2 =
+    let outer ast1 = do
+            (ASTInteger a) <- assertIsASTInteger ast1
+            let inner ast2 = do
+                    (ASTInteger b) <- assertIsASTInteger ast2
+                    return $ ASTInteger $ a - b
+            return $ ASTFunction $ inner
+     in ASTFunction outer
+
+builtinHead :: AST
+builtinHead =
+    let outer ast = do
+            (ASTVector vec) <- assertIsASTVector ast
+            when (length vec == 0) $ throwError $ LException $ "head of empty vector"
+            return $ head vec
+     in ASTFunction outer
+
+builtinTail :: AST
+builtinTail =
+    let outer ast = do
+            (ASTVector vec) <- assertIsASTVector ast
+            when (length vec == 0) $ throwError $ LException $ "tail of empty vector"
+            return $ ASTVector $ tail vec
+     in ASTFunction outer
\ No newline at end of file
-- 
cgit v1.3