diff options
| author | Jan Tuomi <jans.tuomi@gmail.com> | 2022-09-26 14:02:28 +0300 |
|---|---|---|
| committer | Jan Tuomi <jans.tuomi@gmail.com> | 2022-12-05 14:21:53 +0200 |
| commit | 2ea2c405746bfa79d3be478f4c8763dd7dd6ac5f (patch) | |
| tree | 39be22d6a3b768e42813e2e5dde4a37a301aafb3 /src | |
| parent | 3f5b15b15fbca3dac18f3f5cb39b7826924ff175 (diff) | |
Add some concept docs
Diffstat (limited to 'src')
| -rw-r--r-- | src/Builtins.hs | 22 | ||||
| -rw-r--r-- | src/Lib.hs | 7 | ||||
| -rw-r--r-- | src/Utils.hs | 8 |
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 @@ -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 |
