From 47c2eca7dceae9fb4e6f687f70273fb262fa07a2 Mon Sep 17 00:00:00 2001
From: Jan Tuomi <jans.tuomi@gmail.com>
Date: Fri, 9 Dec 2022 15:53:16 +0200
Subject: Add try! builtin

---
 TODO.txt                    |  4 +++-
 core/common.milch           |  3 +++
 examples/atom-concept.milch | 11 +++++++++++
 examples/try.milch          |  6 ++++++
 src/Builtins.hs             | 25 ++++++++++++++++++++++++-
 5 files changed, 47 insertions(+), 2 deletions(-)
 create mode 100644 examples/atom-concept.milch
 create mode 100644 examples/try.milch

diff --git a/TODO.txt b/TODO.txt
index fc29273..808a4aa 100644
--- a/TODO.txt
+++ b/TODO.txt
@@ -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)
-- 
cgit v1.3