aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
authorJan Tuomi <jans.tuomi@gmail.com>2022-09-26 14:02:28 +0300
committerJan Tuomi <jans.tuomi@gmail.com>2022-12-05 14:21:53 +0200
commit2ea2c405746bfa79d3be478f4c8763dd7dd6ac5f (patch)
tree39be22d6a3b768e42813e2e5dde4a37a301aafb3 /src
parent3f5b15b15fbca3dac18f3f5cb39b7826924ff175 (diff)
Add some concept docs
Diffstat (limited to 'src')
-rw-r--r--src/Builtins.hs22
-rw-r--r--src/Lib.hs7
-rw-r--r--src/Utils.hs8
3 files changed, 34 insertions, 3 deletions
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