From 2ea2c405746bfa79d3be478f4c8763dd7dd6ac5f Mon Sep 17 00:00:00 2001
From: Jan Tuomi <jans.tuomi@gmail.com>
Date: Mon, 26 Sep 2022 14:02:28 +0300
Subject: Add some concept docs

---
 src/Builtins.hs | 22 +++++++++++++++++++++-
 src/Lib.hs      |  7 ++++++-
 src/Utils.hs    |  8 +++++++-
 3 files changed, 34 insertions(+), 3 deletions(-)

(limited to 'src')

diff --git a/src/Builtins.hs b/src/Builtins.hs
index a4676b8..2eedbed 100644
--- a/src/Builtins.hs
+++ b/src/Builtins.hs
@@ -13,7 +13,9 @@ builtinEnv = M.fromList [
     ("/", builtinDivide2),
     ("head", builtinHead),
     ("tail", builtinTail),
-    ("prepend", builtinPrepend)
+    ("prepend", builtinPrepend),
+    ("print!", builtinPrint),
+    ("string-concat", builtinStringConcat2)
     ]
 
 -- maybe make a builtinBinaryFunction?
@@ -93,3 +95,21 @@ builtinPrepend =
                     return $ ASTVector $ ast1 : vec
             return $ ASTFunction $ inner
      in ASTFunction outer
+
+builtinPrint :: AST
+builtinPrint =
+    let outer _ ast =
+         do (ASTString str) <- assertIsASTString ast
+            liftIO $ putStr $ str
+            return ASTUnit
+     in ASTFunction outer
+
+builtinStringConcat2 :: AST
+builtinStringConcat2 =
+    let outer _ ast1 = do
+            (ASTString str1) <- assertIsASTString ast1
+            let inner _ ast2 = do
+                    (ASTString str2) <- assertIsASTString ast2
+                    return $ ASTString $ str1 ++ str2
+            return $ ASTFunction $ inner
+     in ASTFunction outer
diff --git a/src/Lib.hs b/src/Lib.hs
index 00d9f37..a2c65c6 100644
--- a/src/Lib.hs
+++ b/src/Lib.hs
@@ -23,11 +23,16 @@ runInlineScript env src = do
     config <- ask
     when (configVerboseMode config) $ liftIO $ putStrLn $ "tokenized:\t\t" ++ show tokenized
     parsed <- parse tokenized
+
     when (configVerboseMode config) $ do
         let output = "parsed:\t\t\t" ++ (map show parsed $> L.intercalate "\n\t\t\t")
         liftIO $ putStrLn output
+
     (newEnv, evaluated) <- foldEvaluate env parsed
-    liftIO $ mapM_ putStrLn (map show evaluated)
+
+    when (configPrintEvaled config) $ do
+        liftIO $ mapM_ putStrLn (map show evaluated)
+
     return (newEnv, evaluated)
         where
             foldEvaluate :: Env -> [AST] -> LContext (Env, [AST])
diff --git a/src/Utils.hs b/src/Utils.hs
index 76f1524..e0695c3 100644
--- a/src/Utils.hs
+++ b/src/Utils.hs
@@ -13,7 +13,8 @@ newtype LException = LException String
 data Config = Config {
     configScriptFileName :: Maybe String,
     configVerboseMode :: Bool,
-    configShowHelp :: Bool
+    configShowHelp :: Bool,
+    configPrintEvaled :: Bool
 }
 
 type LContext a = ReaderT Config (ExceptT LException IO) a
@@ -95,6 +96,11 @@ assertIsASTVector ast = case ast of
     (ASTVector _) -> return ast
     _ -> throwL $ show ast ++ " is not a vector"
 
+assertIsASTString :: AST -> LContext AST
+assertIsASTString ast = case ast of
+    (ASTString _) -> return ast
+    _ -> throwL $ show ast ++ " is not a string"
+
 assertIsASTFunctionCall :: AST -> LContext AST
 assertIsASTFunctionCall ast = case ast of
     (ASTFunctionCall _) -> return ast
-- 
cgit v1.3