Start of implementing tests for "Evaluate expression" only.
Chris Pressey
5 years ago
21 | 21 | -> Functionality "Execute Robin Program (with List-Arith)" is implemented by shell command |
22 | 22 | -> "bin/robin --no-builtins pkg/small.robin pkg/list.robin pkg/arith.robin pkg/list-arith.robin %(test-body-file)" |
23 | 23 | |
24 | -> Functionality "Execute Robin Program (with Stdlib)" is implemented by shell command | |
25 | -> "bin/robin --no-builtins pkg/stdlib-no-builtins.robin %(test-body-file)" | |
24 | -> Functionality "Evaluate Robin Expression (with Stdlib)" is implemented by shell command | |
25 | -> "bin/robin --no-builtins pkg/stdlib-no-builtins.robin eval %(test-body-file)" |
21 | 21 | -> Functionality "Execute Robin Program (with List-Arith)" is implemented by shell command |
22 | 22 | -> "bin/robin pkg/list.robin pkg/arith.robin pkg/list-arith.robin %(test-body-file)" |
23 | 23 | |
24 | -> Functionality "Execute Robin Program (with Stdlib)" is implemented by shell command | |
25 | -> "bin/robin pkg/stdlib.robin %(test-body-file)" | |
24 | -> Functionality "Evaluate Robin Expression (with Stdlib)" is implemented by shell command | |
25 | -> "bin/robin pkg/stdlib.robin eval %(test-body-file)" |
0 | 0 | {-# LANGUAGE FlexibleContexts #-} |
1 | 1 | |
2 | module Language.Robin.Parser (parseRobin, insistParse) where | |
2 | module Language.Robin.Parser (parseRobin, parseRobinExpr) where | |
3 | 3 | |
4 | 4 | import Data.Char |
5 | 5 | import Data.Int |
99 | 99 | -- Convenience functions for parsing Robin programs. |
100 | 100 | |
101 | 101 | parseRobin = parse robinProgram "" |
102 | ||
103 | insistParse programText = | |
104 | let | |
105 | Right ast = parseRobin programText | |
106 | in | |
107 | ast | |
102 | parseRobinExpr = parse expr "" |
4 | 4 | import System.Environment |
5 | 5 | import System.Exit |
6 | 6 | |
7 | import Language.Robin.Expr | |
7 | 8 | import Language.Robin.Env (mergeEnvs) |
8 | import Language.Robin.Parser (parseRobin) | |
9 | import Language.Robin.Parser (parseRobin, parseRobinExpr) | |
9 | 10 | import Language.Robin.Intrinsics (robinIntrinsics) |
10 | 11 | import Language.Robin.Builtins (robinBuiltins) |
11 | 12 | import qualified Language.Robin.TopLevel as TopLevel |
16 | 17 | args <- getArgs |
17 | 18 | case args of |
18 | 19 | [] -> do |
19 | abortWith "Usage: robin [--no-builtins] [--show-events] {source.robin}" | |
20 | abortWith "Usage: robin [--no-builtins] [--show-events] {[eval] source.robin}" | |
20 | 21 | _ -> do |
21 | 22 | let (args', env', showEvents) = processFlags args (mergeEnvs robinIntrinsics robinBuiltins) False |
22 | 23 | (_, reactors, results) <- processArgs args' env' |
37 | 38 | |
38 | 39 | processArgs args env = processArgs' args env [] [] where |
39 | 40 | processArgs' [] env reactors results = return (env, reactors, results) |
41 | processArgs' ("eval":filename:rest) env reactors results = do | |
42 | exprText <- readFile filename | |
43 | case parseRobinExpr exprText of | |
44 | Right expr -> do | |
45 | let topExprs = [List [Symbol "display", expr]] | |
46 | (env', reactors', results') <- return $ TopLevel.collect topExprs env reactors results | |
47 | processArgs' rest env' reactors' results' | |
48 | Left problem -> do | |
49 | hPutStr stderr (show problem) | |
50 | exitWith $ ExitFailure 1 | |
40 | 51 | processArgs' (filename:rest) env reactors results = do |
41 | 52 | program <- readFile filename |
42 | 53 | case parseRobin program of |
0 | 0 | ;'<<SPEC' |
1 | 1 | |
2 | -> Tests for functionality "Execute Robin Program (with Stdlib)" | |
2 | -> Tests for functionality "Evaluate Robin Expression (with Stdlib)" | |
3 | 3 | |
4 | 4 | `itoa` evaluates its sole argument to an integer, then evaluates to |
5 | 5 | a string representing that integer in decimal. |
6 | 6 | |
7 | | (display | |
8 | | (itoa 100)) | |
7 | | (itoa 100) | |
9 | 8 | = (49 48 48) |
10 | 9 | |
11 | | (display | |
12 | | (itoa 99)) | |
10 | | (itoa 99) | |
13 | 11 | = (57 57) |
14 | 12 | |
15 | | (display | |
16 | | (itoa 0)) | |
13 | | (itoa 0) | |
17 | 14 | = (48) |
18 | 15 | |
19 | | (display | |
20 | | (itoa (subtract 0 1))) | |
16 | | (itoa (subtract 0 1)) | |
21 | 17 | = (45 49) |
22 | 18 | |
23 | | (display | |
24 | | (itoa (subtract 0 765))) | |
19 | | (itoa (subtract 0 765)) | |
25 | 20 | = (45 55 54 53) |
26 | 21 | |
27 | | (display | |
28 | | (itoa (literal m))) | |
22 | | (itoa (literal m)) | |
29 | 23 | ? uncaught exception: (expected-number m) |
30 | 24 | |
31 | 25 | '<<SPEC' |