Commit 7421691c77abc93acc4d5b3175dfb404ed22039e - Robin

+5

-1

src/Language/Robin/Builtins.hs less more

12	12	-- Robin language. (See Intrinsics.lhs for those.)
13	13	--
14	14
	15	{-
15	16	--
16	17	-- Helper functions
17	18	--

166	167	0 -> raise i (errMsg "division-by-zero" (Number xv))
167	168	_ -> cc (Number (abs (xv `mod` yv)))))))
168	169	robinRemainder i env other cc = raise i (errMsg "illegal-arguments" other)
	170	-}
169	171
170	172	--
171	173	-- Mapping of names to our functions, providing an evaluation environment.
172	174	--
173	175
174		robinBuiltins :: Expr
	176	robinBuiltins :: Env.Env Expr
175	177	robinBuiltins = Env.fromList $ map (\(name,bif) -> (name, Intrinsic name bif))
176	178	[
	179	{-
177	180	("literal", literal),
178	181	("list", robinList),
179	182	("bind", bind),

188	191	("multiply", robinMultiply),
189	192	("divide", robinDivide),
190	193	("remainder", robinRemainder)
	194	-}
191	195	]

+16

-19

src/Language/Robin/Env.hs less more

0	0	module Language.Robin.Env where
1
2		import Language.Robin.Expr
3	1
4	2	--
5	3	-- An environment is an alist which associates symbols with
6	4	-- values (arbitrary S-expressions).
7	5	--
8	6
9		empty :: Expr
10		empty = List []
	7	data Env a = Env [(String, a)] deriving (Show, Ord, Eq)
11	8
12		insert :: Expr -> Expr -> Expr -> Expr
13		insert s@(Symbol _) value env =
14		append (List [List [s, value]]) env
	9	empty :: Env a
	10	empty = Env []
15	11
16		find :: Expr -> Expr -> Maybe Expr
17		find s@(Symbol _) (List []) = Nothing
18		find s@(Symbol _) (List (List [first, value]:rest))
19		\| s == first = Just value
20		\| otherwise = find s (List rest)
	12	insert :: String -> a -> Env a -> Env a
	13	insert s value (Env bindings) = Env ((s, value):bindings)
21	14
22		fromList :: [(String,Expr)] -> Expr
23		fromList [] =
24		List []
25		fromList ((id, val):xs) =
26		append (List [List [(Symbol id), val]]) (fromList xs)
	15	find :: String -> Env a -> Maybe a
	16	find _ (Env []) = Nothing
	17	find s (Env ((t, value):rest))
	18	\| s == t = Just value
	19	\| otherwise = find s (Env rest)
27	20
28		mergeEnvs :: Expr -> Expr -> Expr
29		mergeEnvs (List a) (List b) = List (a ++ b)
	21	fromList :: [(String,a)] -> Env a
	22	fromList [] = empty
	23	fromList ((s, val):rest) = insert s val $ fromList rest
	24
	25	mergeEnvs :: Env a -> Env a -> Env a
	26	mergeEnvs (Env a) (Env b) = Env (a ++ b)

+11

-15

src/Language/Robin/Eval.hs less more

8	8	-- Every evaluation function takes a continuation, and is implemented
9	9	-- as a function with this signature:
10	10	--
11		-- Expr -> Expr -> Expr -> (Expr -> Expr) -> Expr
	11	-- IEnv Expr -> Env Expr -> Expr -> (Expr -> Expr) -> Expr
12	12	--
13	13	-- (This is actually the `Evaluable` type from `Robin.Expr`.)
14	14	--

24	24
25	25	eval :: Evaluable
26	26
27		eval i (List []) s@(Symbol _) cc =
28		raise i (errMsg "unbound-identifier" s)
29		eval i (List (b@(List [id@(Symbol _), value]):env)) s@(Symbol _) cc
30		\| id == s = cc value
31		\| otherwise = eval i (List env) s cc
32		eval i (List ((List (other:_)):env)) s@(Symbol _) cc =
33		raise i (errMsg "expected-symbol" other)
34		eval i (List (head:tail)) s@(Symbol _) cc =
35		raise i (errMsg "expected-env-entry" head)
36		eval i env s@(Symbol _) cc =
37		raise i (errMsg "expected-env-alist" env)
	27	eval i env sym@(Symbol s) cc =
	28	case Env.find s env of
	29	Just value ->
	30	cc value
	31	Nothing ->
	32	raise i (errMsg "unbound-identifier" sym)
38	33
39	34	--
40	35	-- Evaluating a list means we must make several evaluations. We

68	63	errMsg msg term =
69	64	List [(Symbol msg), term]
70	65
	66	makeMacroEnv :: Env.Env Expr -> Expr -> Expr -> Env.Env Expr
71	67	makeMacroEnv env actuals m@(Macro closedEnv argList _) =
72	68	let
73		(List [argSelf@(Symbol _), argFormal@(Symbol _),
74		envFormal@(Symbol _)]) = argList
	69	(List [(Symbol argSelf), (Symbol argFormal),
	70	(Symbol envFormal)]) = argList
75	71	newEnv = Env.insert argSelf m closedEnv
76	72	newEnv' = Env.insert argFormal actuals newEnv
77		newEnv'' = Env.insert envFormal env newEnv'
	73	newEnv'' = Env.insert envFormal (Environment env) newEnv'
78	74	in
79	75	newEnv''
80	76

+13

-3

src/Language/Robin/Expr.hs less more

1	1
2	2	import Data.Char
3	3	import Data.Int
	4
	5	import qualified Language.Robin.Env as Env
4	6
5	7	--
6	8	-- An _evaluable_ is a Haskell object which behaves like a Robin macro.

8	10	-- (perhaps unsurprisingly?) to be the type of the evaluator function.
9	11	--
10	12
11		type Evaluable = IEnv Expr -> Expr -> Expr -> (Expr -> Expr) -> Expr
12		-- internal-env env args continuation result
	13	type Evaluable = IEnv Expr -> Env.Env Expr -> Expr -> (Expr -> Expr) -> Expr
	14	-- internal-env env args continuation result
13	15
14	16	data Expr = Symbol String
15	17	\| Boolean Bool
16	18	\| Number Int32
17		\| Macro Expr Expr Expr
	19	\| Macro (Env.Env Expr) Expr Expr
18	20	\| Intrinsic String Evaluable
19	21	\| List [Expr]
	22	\| Environment (Env.Env Expr)
20	23
21	24	instance Eq Expr where
22	25	(Symbol x) == (Symbol y) = x == y

25	28	(Macro _ _ _) == (Macro _ _ _) = False
26	29	(Intrinsic x _) == (Intrinsic y _) = x == y
27	30	(List x) == (List y) = x == y
	31	(Environment x) == (Environment y) = x == y
28	32	_ == _ = False
29	33
30	34	instance Show Expr where

39	43	showl [] = ""
40	44	showl [expr] = show expr
41	45	showl (expr:exprs) = (show expr) ++ " " ++ (showl exprs)
	46	show (Environment env) = ":" ++ show env
42	47
43	48	--
44	49	-- Helpers

46	51
47	52	append (List x) (List y) =
48	53	List (x ++ y)
	54
	55	exprToEnv :: Expr -> Env.Env Expr
	56	exprToEnv (List []) = Env.empty
	57	exprToEnv (List ((List [(Symbol s), value]):rest)) =
	58	Env.insert s value (exprToEnv (List rest))
49	59
50	60	--
51	61	-- Predicates

+5

-5

src/Language/Robin/Intrinsics.hs less more

73	73
74	74	robinEval :: Evaluable
75	75	robinEval i env (List [envlist, form]) cc =
76		eval i env envlist (\newEnv ->
	76	eval i env envlist (\newEnvVal ->
77	77	eval i env form (\body ->
78		eval i newEnv body cc))
	78	eval i (exprToEnv newEnvVal) body cc))
79	79	robinEval i env other cc = raise i (errMsg "illegal-arguments" other)
80	80
81	81	robinMacro :: Evaluable

89	89	robinRaise i env other cc = raise i (errMsg "illegal-arguments" other)
90	90
91	91	robinCatch :: Evaluable
92		robinCatch i env (List [id@(Symbol _), handler, body]) cc =
	92	robinCatch i env (List [(Symbol s), handler, body]) cc =
93	93	let
94	94	handlerContinuation = (\errvalue ->
95		eval i (Env.insert id errvalue env) handler cc)
	95	eval i (Env.insert s errvalue env) handler cc)
96	96	i' = setExceptionHandler handlerContinuation i
97	97	in
98	98	eval i' env body cc
99	99	robinCatch i env other cc = raise i (errMsg "illegal-arguments" other)
100	100
101		robinIntrinsics :: Expr
	101	robinIntrinsics :: Env.Env Expr
102	102	robinIntrinsics = Env.fromList $ map (\(name,bif) -> (name, Intrinsic name bif))
103	103	[
104	104	("head", robinHead),

+2

-1

src/Language/Robin/Reactor.hs less more

4	4	import System.IO
5	5	import System.Random
6	6
	7	import qualified Language.Robin.Env as Env
7	8	import Language.Robin.Expr
8	9	import Language.Robin.Eval
9	10
10	11	data Reactor = Reactor {
11	12	rid :: Int32,
12		env :: Expr,
	13	env :: Env.Env Expr,
13	14	state :: Expr,
14	15	body :: Expr -- body takes three arguments: event state
15	16	} deriving (Show, Eq)

+12

-12

src/Language/Robin/TopLevel.hs less more

0	0	module Language.Robin.TopLevel (collect) where
1	1
	2	import qualified Language.Robin.Env as Env
2	3	import Language.Robin.Expr
3		import qualified Language.Robin.Env as Env
4	4	import Language.Robin.Eval
5	5	import Language.Robin.Reactor
6	6
7	7
8		collect :: [Expr] -> Expr -> [Reactor] -> [Either Expr Expr] -> (Expr, [Reactor], [Either Expr Expr])
	8	collect :: [Expr] -> Env.Env Expr -> [Reactor] -> [Either Expr Expr] -> (Env.Env Expr, [Reactor], [Either Expr Expr])
9	9
10	10	collect [] env reactors results = (env, reactors, results)
11	11

27	27	_ ->
28	28	collect rest env reactors results
29	29
30		collect ((List [Symbol "require", expr]):rest) env reactors results =
31		case Env.find expr env of
	30	collect ((List [Symbol "require", sym@(Symbol s)]):rest) env reactors results =
	31	case Env.find s env of
32	32	Nothing ->
33		error ("assertion failed: (bound? " ++ show expr ++ ")")
	33	error ("assertion failed: (bound? " ++ show sym ++ ")")
34	34	_ ->
35	35	collect rest env reactors results
36	36
37		collect ((List [Symbol "define", name@(Symbol _), expr]):rest) env reactors results =
38		case Env.find name env of
	37	collect ((List [Symbol "define", sym@(Symbol s), expr]):rest) env reactors results =
	38	case Env.find s env of
39	39	Just _ ->
40		error ("symbol already defined: " ++ show name)
	40	error ("symbol already defined: " ++ show sym)
41	41	Nothing ->
42	42	let
43	43	result = eval (IEnv stop) env expr id
44	44	in
45		collect rest (Env.insert name result env) reactors results
	45	collect rest (Env.insert s result env) reactors results
46	46
47		collect ((List [Symbol "define-if-absent", name@(Symbol _), expr]):rest) env reactors results =
48		case Env.find name env of
	47	collect ((List [Symbol "define-if-absent", sym@(Symbol s), expr]):rest) env reactors results =
	48	case Env.find s env of
49	49	Just _ ->
50	50	collect rest env reactors results
51	51	Nothing ->
52	52	let
53	53	result = eval (IEnv stop) env expr id
54	54	in
55		collect rest (Env.insert name result env) reactors results
	55	collect rest (Env.insert s result env) reactors results
56	56
57	57	collect ((List [Symbol "reactor", facExpr, stateExpr, bodyExpr]):rest) env reactors results =
58	58	let