diff options
| -rw-r--r-- | TODO.txt | 4 | ||||
| -rw-r--r-- | core/common.milch | 3 | ||||
| -rw-r--r-- | examples/atom-concept.milch | 11 | ||||
| -rw-r--r-- | examples/try.milch | 6 | ||||
| -rw-r--r-- | src/Builtins.hs | 25 |
5 files changed, 47 insertions, 2 deletions
@@ -1,2 +1,4 @@ -add a `catch` builtin for catching fatal errors +fix impure context issues +add a `do` builtin that runs given exprs and returns the result of the last one +add an atom/cell/box data type for storing mutable state write tests diff --git a/core/common.milch b/core/common.milch index 25bf95a..cddf02f 100644 --- a/core/common.milch +++ b/core/common.milch @@ -41,6 +41,9 @@ ;; Math ;;;;;;;;;;;;;;;;;;;;;;;;; +(let inc (+ 1)) +(let dec (\[n] (- n 1))) + (let PI 3.141592653589793238) (let E 2.718281828459045235) diff --git a/examples/atom-concept.milch b/examples/atom-concept.milch new file mode 100644 index 0000000..4158b45 --- /dev/null +++ b/examples/atom-concept.milch @@ -0,0 +1,11 @@ +(let state (atom! 10)) + +(let do-loop! (\![i n] + (match true + (lt? i n) (do (update! dec state) + (do-loop! (inc i) n)) + otherwise unit))) + +(do-loop! 0 5) +(get! state) +; => 5 diff --git a/examples/try.milch b/examples/try.milch new file mode 100644 index 0000000..68d6cc2 --- /dev/null +++ b/examples/try.milch @@ -0,0 +1,6 @@ +(import "core/common") +(import "core/result") + +; calls read-file! and wraps the result in a Result/ok on success +; in case of error, calls Result/ex on the error string +(try! Result/ex (. Result/ok read-file!) "does-not-exist.txt") diff --git a/src/Builtins.hs b/src/Builtins.hs index 292e344..ec70956 100644 --- a/src/Builtins.hs +++ b/src/Builtins.hs @@ -6,7 +6,7 @@ import qualified Data.Text as T import qualified Text.Read as TR import qualified Data.List as L import qualified Data.Bifunctor as B -import Control.Monad.Except +import Control.Monad.State import Utils builtinEnv :: Env @@ -41,6 +41,7 @@ builtinEnv = M.fromList $ map (B.second Regular) [ builtinAppendFile, -- special builtinPrint, + builtinTry, ("unit", makeNonsenseAST ASTUnit), ("_", makeNonsenseAST ASTHole), ("otherwise", makeNonsenseAST ASTHole), @@ -331,3 +332,25 @@ builtinSortByFirst = (name, makeNonsenseAST $ ASTFunction Pure fn1) where itemsToPair items elemToPair ast2 = throwL (astPos ast2, argError1 name ast1) fn1 ast1 = throwL (astPos ast1, argError1 name ast1) + +builtinTry :: (String, AST) +builtinTry = (name, makeNonsenseAST $ ASTFunction Impure fn1) where + name = "try!" + fn1 :: LFunction + fn1 ast1@AST { an = ASTFunction Pure catchFn } = + return $ makeNonsenseAST $ ASTFunction Impure $ fn2 where + fn2 ast2@AST { an = ASTFunction _ tryFn } = + return $ makeNonsenseAST $ ASTFunction Impure $ fn3 where + fn3 ast3 = do + s <- get + let tryRet = tryFn ast3 + tryRetE <- liftIO $ runL s tryRet + case tryRetE of + Right (val, state') -> do + put state' + return val + Left (LException stack) -> do + let es = snd $ last stack + catchFn $ ast2 { an = ASTString $ es } + fn2 ast2 = throwL (astPos ast2, argError2 name ast1 ast2) + fn1 ast1 = throwL (astPos ast1, argError1 name ast1) |