diff options
| -rw-r--r-- | TODO.txt | 2 | ||||
| -rw-r--r-- | examples/do.milch | 7 | ||||
| -rw-r--r-- | examples/try.milch | 7 | ||||
| -rw-r--r-- | src/Interpreter.hs | 16 | ||||
| -rw-r--r-- | src/Utils.hs | 1 | ||||
| -rw-r--r-- | test/Spec.hs | 33 | ||||
| -rw-r--r-- | test/TestUtils.hs | 2 | ||||
| -rw-r--r-- | test/scripts/do1.milch | 7 | ||||
| -rw-r--r-- | test/scripts/try1.milch | 8 |
9 files changed, 64 insertions, 19 deletions
@@ -1,3 +1,3 @@ -add a `do` builtin that runs given exprs and returns the result of the last one +add a `Debug/break` builtin that allows simple interactive debugging add an atom/cell/box data type for storing mutable state write tests diff --git a/examples/do.milch b/examples/do.milch new file mode 100644 index 0000000..d66c122 --- /dev/null +++ b/examples/do.milch @@ -0,0 +1,7 @@ +(let foo + (do (+ 1 2) + (- 10 2) + "foo")) + +foo +; => "foo" diff --git a/examples/try.milch b/examples/try.milch index 561e716..16ac516 100644 --- a/examples/try.milch +++ b/examples/try.milch @@ -6,10 +6,5 @@ ; calls read-file! and wraps the result in a Result/ok on success ; in case of error, calls Result/ex on the error string (safe-read-file! "does-not-exist.txt") -(try! Result/ex (.! Result/ok read-file!) "examples/aoc22_1.txt") - -(let pure-fn (\[x] - (concat "foo" x))) -(print! (pure-fn "bar\n")) -(print! "nice\n") +(try! Result/ex (.! Result/ok read-file!) "examples/aoc22_1.txt") diff --git a/src/Interpreter.hs b/src/Interpreter.hs index 9395ec1..6be5c71 100644 --- a/src/Interpreter.hs +++ b/src/Interpreter.hs @@ -394,6 +394,20 @@ evaluateSymbol ast@AST { an = ASTSymbol sym } = do Nothing -> throwL (astPos ast, "symbol " ++ sym ++ " not defined in environment") evaluateSymbol ast = throwL (astPos ast, "unreachable: evaluateSymbol, ast: " ++ show ast) +evaluateDo :: [AST] -> LContext AST +evaluateDo children = do + let fnAst = head children + args = tail children + + when (length args == 0) $ throwL (astPos fnAst, "do called with 0 arguments") + + let nonRetExprs = init args + let retExpr = last args + + mapM_ evaluate nonRetExprs + + evaluate retExpr + evaluate :: AST -> LContext AST evaluate ast@AST { an = fnc@(ASTFunctionCall args@(x:_)) } = do config <- getConfig @@ -418,6 +432,8 @@ evaluate ast@AST { an = fnc@(ASTFunctionCall args@(x:_)) } = evaluateImport args ASTSymbol "record" -> evaluateRecord args + ASTSymbol "do" -> + evaluateDo args _ -> evaluateFunctionCall args diff --git a/src/Utils.hs b/src/Utils.hs index 379740d..76b3830 100644 --- a/src/Utils.hs +++ b/src/Utils.hs @@ -188,6 +188,7 @@ instance (Eq ASTNode) where ASTVector a == ASTVector b = a == b ASTFunctionCall a == ASTFunctionCall b = a == b ASTHashMap a == ASTHashMap b = a == b + ASTRecord ah _ hma == ASTRecord bh _ hmb = ah == bh && hma == hmb ASTUnit == ASTUnit = True ASTHole == _ = True _ == ASTHole = True diff --git a/test/Spec.hs b/test/Spec.hs index d4d5bf9..4839ace 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -62,16 +62,14 @@ e2eTests = testGroup "e2e" [ do let env = M.empty :: Env let script1 = "(record A foo)\n(let a (A/create 123))\n(A/get-foo a)" - (gotASTs, _) <- expectSuccessL env $ - runInlineScript "<test>" script1 + (gotASTs, _) <- expectSuccessL env $ runInlineScript "<test>" script1 let expectedLastAST = ast $ ASTInteger 123 assertEqual "" expectedLastAST (last gotASTs), do let env = makeEnv [builtinSortByFirst] let script1 = "(sort-by-first [[2 1] [3 2] [1 3]])" - (gotASTs, _) <- expectSuccessL env $ - runInlineScript "<test>" script1 + (gotASTs, _) <- expectSuccessL env $ runInlineScript "<test>" script1 let expectedLastAST = astVector $ [astVector [astInteger 1, astInteger 3], @@ -81,8 +79,7 @@ e2eTests = testGroup "e2e" [ do let env = makeEnv [builtinAdd2, builtinMultiply2] let script1 = "(let f (\\[x] (let y (+ x 1)) (let z (+ 3 y)) (* 2 z)))\n(f 1)" - (gotASTs, _) <- expectSuccessL env $ - runInlineScript "<test>" script1 + (gotASTs, _) <- expectSuccessL env $ runInlineScript "<test>" script1 let expectedLastAST = astInteger 10 assertEqual "" expectedLastAST (last gotASTs), @@ -95,8 +92,7 @@ e2eTests = testGroup "e2e" [ \ _ (+ (fibo (- n 1)) (fibo (- n 2))))))\ \ \ \(fibo 50)" - (gotASTs, _) <- expectSuccessL env $ - runInlineScript "<test>" script1 + (gotASTs, _) <- expectSuccessL env $ runInlineScript "<test>" script1 let expectedLastAST = astInteger 12586269025 assertEqual "" expectedLastAST (last gotASTs), @@ -105,18 +101,31 @@ e2eTests = testGroup "e2e" [ let script1 = "(let a :thing)\ \(let b :thing)\ \(eq? a b)" - (gotASTs, _) <- expectSuccessL env $ - runInlineScript "<test>" script1 + (gotASTs, _) <- expectSuccessL env $ runInlineScript "<test>" script1 let expectedLastAST = astBoolean True assertEqual "" expectedLastAST (last gotASTs), do let env = builtinEnv script1 <- readFile "test/scripts/record1.milch" - (gotASTs, _) <- expectSuccessL env $ - runInlineScript "<test>" script1 + (gotASTs, _) <- expectSuccessL env $ runInlineScript "<test>" script1 let expectedLastAST = astInteger 369 + assertEqual "" expectedLastAST (last gotASTs), + + do let env = builtinEnv + script1 <- readFile "test/scripts/do1.milch" + (gotASTs, _) <- expectSuccessL env $ runInlineScript "<test>" script1 + + let expectedLastAST = astString "foo" + assertEqual "" expectedLastAST (last gotASTs), + + do let env = builtinEnv + script1 <- readFile "test/scripts/try1.milch" + (gotASTs, _) <- expectSuccessL env $ runInlineScript "<test>" script1 + + let expectedLastAST = astRecord "Result/Ex" $ + M.fromList [("value", astString "failed to read file: does-not-exist.txt")] assertEqual "" expectedLastAST (last gotASTs) ] diff --git a/test/TestUtils.hs b/test/TestUtils.hs index f023bb7..ff53310 100644 --- a/test/TestUtils.hs +++ b/test/TestUtils.hs @@ -61,6 +61,8 @@ astFunctionCall :: [AST] -> AST astFunctionCall a = ast $ ASTFunctionCall a astHashMap :: M.Map AST AST -> AST astHashMap a = ast $ ASTHashMap a +astRecord :: String -> LRecord -> AST +astRecord a hmap = ast $ ASTRecord (computeTagN a) a hmap astUnit :: AST astUnit = ast $ ASTUnit astHole :: AST diff --git a/test/scripts/do1.milch b/test/scripts/do1.milch new file mode 100644 index 0000000..d66c122 --- /dev/null +++ b/test/scripts/do1.milch @@ -0,0 +1,7 @@ +(let foo + (do (+ 1 2) + (- 10 2) + "foo")) + +foo +; => "foo" diff --git a/test/scripts/try1.milch b/test/scripts/try1.milch new file mode 100644 index 0000000..32abba2 --- /dev/null +++ b/test/scripts/try1.milch @@ -0,0 +1,8 @@ +(import "core/common") +(import "core/result") + +(let safe-read-file! (Result/safe! read-file!)) + +; calls read-file! and wraps the result in a Result/ok on success +; in case of error, calls Result/ex on the error string +(safe-read-file! "does-not-exist.txt") |