git @ Cat's Eye Technologies Robin / 384080f
Start of implementing tests for "Evaluate expression" only. Chris Pressey 5 years ago
6 changed file(s) with 28 addition(s) and 26 deletion(s). Raw diff Collapse all Expand all
2121 -> Functionality "Execute Robin Program (with List-Arith)" is implemented by shell command
2222 -> "bin/robin --no-builtins pkg/small.robin pkg/list.robin pkg/arith.robin pkg/list-arith.robin %(test-body-file)"
2323
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)"
2121 -> Functionality "Execute Robin Program (with List-Arith)" is implemented by shell command
2222 -> "bin/robin pkg/list.robin pkg/arith.robin pkg/list-arith.robin %(test-body-file)"
2323
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)"
1414 else
1515 echo "hastec not found, not building $PROG.js"
1616 fi
17
18 ./build-packages.sh
00 {-# LANGUAGE FlexibleContexts #-}
11
2 module Language.Robin.Parser (parseRobin, insistParse) where
2 module Language.Robin.Parser (parseRobin, parseRobinExpr) where
33
44 import Data.Char
55 import Data.Int
9999 -- Convenience functions for parsing Robin programs.
100100
101101 parseRobin = parse robinProgram ""
102
103 insistParse programText =
104 let
105 Right ast = parseRobin programText
106 in
107 ast
102 parseRobinExpr = parse expr ""
44 import System.Environment
55 import System.Exit
66
7 import Language.Robin.Expr
78 import Language.Robin.Env (mergeEnvs)
8 import Language.Robin.Parser (parseRobin)
9 import Language.Robin.Parser (parseRobin, parseRobinExpr)
910 import Language.Robin.Intrinsics (robinIntrinsics)
1011 import Language.Robin.Builtins (robinBuiltins)
1112 import qualified Language.Robin.TopLevel as TopLevel
1617 args <- getArgs
1718 case args of
1819 [] -> do
19 abortWith "Usage: robin [--no-builtins] [--show-events] {source.robin}"
20 abortWith "Usage: robin [--no-builtins] [--show-events] {[eval] source.robin}"
2021 _ -> do
2122 let (args', env', showEvents) = processFlags args (mergeEnvs robinIntrinsics robinBuiltins) False
2223 (_, reactors, results) <- processArgs args' env'
3738
3839 processArgs args env = processArgs' args env [] [] where
3940 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
4051 processArgs' (filename:rest) env reactors results = do
4152 program <- readFile filename
4253 case parseRobin program of
00 ;'<<SPEC'
11
2 -> Tests for functionality "Execute Robin Program (with Stdlib)"
2 -> Tests for functionality "Evaluate Robin Expression (with Stdlib)"
33
44 `itoa` evaluates its sole argument to an integer, then evaluates to
55 a string representing that integer in decimal.
66
7 | (display
8 | (itoa 100))
7 | (itoa 100)
98 = (49 48 48)
109
11 | (display
12 | (itoa 99))
10 | (itoa 99)
1311 = (57 57)
1412
15 | (display
16 | (itoa 0))
13 | (itoa 0)
1714 = (48)
1815
19 | (display
20 | (itoa (subtract 0 1)))
16 | (itoa (subtract 0 1))
2117 = (45 49)
2218
23 | (display
24 | (itoa (subtract 0 765)))
19 | (itoa (subtract 0 765))
2520 = (45 55 54 53)
2621
27 | (display
28 | (itoa (literal m)))
22 | (itoa (literal m))
2923 ? uncaught exception: (expected-number m)
3024
3125 '<<SPEC'