diff options
| -rw-r--r-- | app/Main.hs | 6 | ||||
| -rw-r--r-- | examples/algebraic-types-concept.lisp | 19 | ||||
| -rw-r--r-- | examples/effects-concept.lisp | 19 | ||||
| -rw-r--r-- | src/Builtins.hs | 22 | ||||
| -rw-r--r-- | src/Lib.hs | 7 | ||||
| -rw-r--r-- | src/Utils.hs | 8 | ||||
| -rw-r--r-- | test/TestUtils.hs | 3 | ||||
| -rw-r--r-- | todo.md | 2 |
8 files changed, 80 insertions, 6 deletions
diff --git a/app/Main.hs b/app/Main.hs index 113a3ba..0fe5551 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -15,6 +15,8 @@ parseArgs config args = config { configVerboseMode = True } rest ("-h":rest) -> parseArgs config { configShowHelp = True } rest + ("-e":rest) -> parseArgs + config { configPrintEvaled = True } rest _ -> config repl :: Config -> Env -> InputT IO () @@ -39,7 +41,8 @@ main = do let initialConfig = Config { configScriptFileName = Nothing, configVerboseMode = False, - configShowHelp = False + configShowHelp = False, + configPrintEvaled = False } let config = parseArgs initialConfig args @@ -48,6 +51,7 @@ main = do putStrLn $ "Usage: " ++ progName ++ " # to open REPL" putStrLn $ " " ++ progName ++ " -i scriptFile # to run script file" putStrLn $ " " ++ progName ++ " -h # to show this help" + putStrLn $ " " ++ progName ++ " -e # to automatically print results of evaluated expressions to stdout" else do when (configVerboseMode config) $ do putStrLn $ "configScriptFileName:\t" ++ (show $ configScriptFileName config) diff --git a/examples/algebraic-types-concept.lisp b/examples/algebraic-types-concept.lisp new file mode 100644 index 0000000..315a693 --- /dev/null +++ b/examples/algebraic-types-concept.lisp @@ -0,0 +1,19 @@ +(let just (\[a] + ["maybe" "just" a])) +(let nothing (\[] + ["maybe" "nothing"])) + +(let at (\[n seq] + (match seq + [] (nothing) + (match n + 0 (head seq) + (at (- n 1) (tail seq)))))) + +(let from-just (at 2)) +(let kind (at 1)) + +(let m (just 10)) +(match (kind m) + "just" (from-just m) + "nothing" "nothing") diff --git a/examples/effects-concept.lisp b/examples/effects-concept.lisp new file mode 100644 index 0000000..efca43e --- /dev/null +++ b/examples/effects-concept.lisp @@ -0,0 +1,19 @@ +; FUNCTIONS + +(let prompt-input (\[] + (let p "> ") + (do get-user-input "prompted" p))) + +; SIGNAL HANDLERS + +(on user-input (\[msg s] + (match msg + "prompted" (batch [ + (do print-line (fmt "You entered: %%" [s])) + (prompt-input)]) + (batch [ + (do fatal-error (fmt "error: unknown signal %%" [msg]))])))) + +;; ENTRYPOINT + +(prompt-input) 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 diff --git a/test/TestUtils.hs b/test/TestUtils.hs index ad31c78..e51d97b 100644 --- a/test/TestUtils.hs +++ b/test/TestUtils.hs @@ -7,7 +7,8 @@ testConfig :: Config testConfig = Config { configScriptFileName = Nothing, configVerboseMode = False, - configShowHelp = False + configShowHelp = False, + configPrintEvaled = False } testRunL :: LContext a -> IO (Either LException a) @@ -7,8 +7,8 @@ In order of priority - Add builtins to convert from int to double and vice versa - Add builtin to convert to string - Add builtins to compare numbers (eq?, lt?) -- Add flag to control whether computed values are automatically printed or not - Add import function with support for qualified imports - Come up with a name for the language - Add auto import for standard library (std) - Add flag to disable auto import of standard library +- Add effects system (see `examples/effects-concept.lisp`) |