From 25f03708f28ee6de49d22323fe4ff5fd7ee74960 Mon Sep 17 00:00:00 2001
From: Jan Tuomi <jans.tuomi@gmail.com>
Date: Tue, 6 Dec 2022 13:43:14 +0200
Subject: Add builtins

---
 src/Builtins.hs | 24 +++++++++++++++++++++++-
 1 file changed, 23 insertions(+), 1 deletion(-)

(limited to 'src')

diff --git a/src/Builtins.hs b/src/Builtins.hs
index 843faa7..ec14c2f 100644
--- a/src/Builtins.hs
+++ b/src/Builtins.hs
@@ -3,6 +3,7 @@ module Builtins where
 
 import qualified Data.Map as M
 import qualified Data.Text as T
+import qualified Text.Read as TR
 import Control.Monad.Except
 import Utils
 
@@ -20,12 +21,14 @@ builtinEnv = M.fromList [
     builtinFmt,
     builtinFloor,
     builtinToDouble,
+    builtinParseInt,
     -- vector operations
     builtinHead,
     builtinTail,
     builtinPrepend,
     -- string operations
     builtinSubstr,
+    builtinStrToVec,
     -- vector & string operations
     builtinConcat,
     -- special
@@ -135,7 +138,7 @@ builtinLt2 = (name, makeNonsenseAST $ ASTFunction True fn1) where
     name = "lt?"
     fn1 ast1 =
         return $ makeNonsenseAST $ ASTFunction True $ fn2 where
-            fn2 ast2 = return $ makeNonsenseAST $ ASTBoolean $ ast1 <= ast2
+            fn2 ast2 = return $ makeNonsenseAST $ ASTBoolean $ ast1 < ast2
 
 builtinFloor :: (String, AST)
 builtinFloor = (name, makeNonsenseAST $ ASTFunction True fn1) where
@@ -143,6 +146,15 @@ builtinFloor = (name, makeNonsenseAST $ ASTFunction True fn1) where
     fn1 AST { astNode = ASTDouble dbl } = return $ makeNonsenseAST $ ASTInteger $ floor dbl
     fn1 ast1 = throwL (astPos ast1) $ argError1 name ast1
 
+builtinParseInt :: (String, AST)
+builtinParseInt = (name, makeNonsenseAST $ ASTFunction True fn1) where
+    name = "parse-int"
+    fn1 ast1@AST { astNode = ASTString str } =
+        case (TR.readMaybe str) of
+            Just val -> return $ makeNonsenseAST $ ASTInteger $ val
+            Nothing -> throwL (astPos ast1) $ argError1 name ast1
+    fn1 ast1 = throwL (astPos ast1) $ argError1 name ast1
+
 builtinToDouble :: (String, AST)
 builtinToDouble = (name, makeNonsenseAST $ ASTFunction True fn1) where
     name = "to-double"
@@ -197,6 +209,16 @@ builtinSubstr = (name, makeNonsenseAST $ ASTFunction True fn1) where
             fn2 ast2 = throwL (astPos ast2) $ argError2 name ast1 ast2
     fn1 ast1 = throwL (astPos ast1) $ argError1 name ast1
 
+builtinStrToVec :: (String, AST)
+builtinStrToVec = (name, makeNonsenseAST $ ASTFunction True fn1) where
+    name = "to-vec"
+    fn1 AST { astNode = ASTString str } =
+        str $> map (\c -> [c])
+            .> map (makeNonsenseAST . ASTString)
+            .> (makeNonsenseAST . ASTVector)
+            .> return
+    fn1 ast1 = throwL (astPos ast1) $ argError1 name ast1
+
 builtinPrepend :: (String, AST)
 builtinPrepend = (name, makeNonsenseAST $ ASTFunction True fn1) where
     name = "prepend"
-- 
cgit v1.3