Commit fed9dd4911a877a773418f48645340cb2eee7174 - Robin

It builds now, but many tests fail, some spectacularly. Chris Pressey 5 years ago

2 changed file(s) with 28 addition(s) and 18 deletion(s). Raw diff Collapse all Expand all

+10

-7

src/Language/Robin/Reactor.hs less more

17	17
18	18	update :: Reactor -> Expr -> (Reactor, [Expr])
19	19	update reactor@Reactor{rid=rid, env=env, state=state, body=body} event =
20		case eval (setExceptionHandler (Intrinsic "(exception-handler)" catchException) env) (List [body, event, state]) id of
21		command@(List [(Symbol "uncaught-exception"), expr]) ->
22		(reactor, [command])
23		(List (state':commands)) ->
24		(reactor{ state=state' }, applyStop commands)
25		expr ->
26		(reactor, [List [(Symbol "malformed-response"), expr]])
	20	let
	21	env' = setExceptionHandler (Intrinsic "(exception-handler)" catchException) env
	22	in
	23	case eval env' (List [body, event, state]) id of
	24	command@(List [(Symbol "uncaught-exception"), expr]) ->
	25	(reactor, [command])
	26	(List (state':commands)) ->
	27	(reactor{ state=state' }, applyStop commands)
	28	expr ->
	29	(reactor, [List [(Symbol "malformed-response"), expr]])
27	30	where
28	31	catchException env expr k = List [(Symbol "uncaught-exception"), expr]
29	32

+18

-11

src/Language/Robin/TopLevel.hs less more

10	10
11	11	collect ((List [Symbol "display", expr]):rest) env reactors results =
12	12	let
13		result = case eval (IEnv catchException) env expr id of
	13	env' = setExceptionHandler (Intrinsic "(exception-handler)" catchException) env
	14	result = case eval env' expr id of
14	15	-- TODO This is less than fantastic. Should we have a dedicated error Expr?
15	16	e@(List [(Symbol "uncaught-exception"), expr]) -> Left expr
16	17	other -> Right other
17	18	in
18	19	collect rest env reactors (result:results)
19	20	where
20		catchException expr = List [(Symbol "uncaught-exception"), expr]
	21	catchException env expr k = List [(Symbol "uncaught-exception"), expr]
21	22
22	23	collect ((List [Symbol "assert", expr]):rest) env reactors results =
23		case eval (IEnv stop) env expr id of
24		Boolean False ->
25		error ("assertion failed: " ++ show expr)
26		_ ->
27		collect rest env reactors results
	24	let
	25	env' = setExceptionHandler (Intrinsic "(exception-handler)" stop) env
	26	in
	27	case eval env' expr id of
	28	Boolean False ->
	29	error ("assertion failed: " ++ show expr)
	30	_ ->
	31	collect rest env reactors results
28	32
29	33	collect ((List [Symbol "require", sym@(Symbol s)]):rest) env reactors results =
30	34	case find s env of

39	43	error ("symbol already defined: " ++ show sym)
40	44	Nothing ->
41	45	let
42		result = eval (IEnv stop) env expr id
	46	env' = setExceptionHandler (Intrinsic "(exception-handler)" stop) env
	47	result = eval env' expr id
43	48	in
44	49	collect rest (insert s result env) reactors results
45	50

49	54	collect rest env reactors results
50	55	Nothing ->
51	56	let
52		result = eval (IEnv stop) env expr id
	57	env' = setExceptionHandler (Intrinsic "(exception-handler)" stop) env
	58	result = eval env' expr id
53	59	in
54	60	collect rest (insert s result env) reactors results
55	61
56	62	collect ((List [Symbol "reactor", facExpr, stateExpr, bodyExpr]):rest) env reactors results =
57	63	let
58		state = eval (IEnv stop) env stateExpr id
59		body = eval (IEnv stop) env bodyExpr id
	64	env' = setExceptionHandler (Intrinsic "(exception-handler)" stop) env
	65	state = eval env' stateExpr id
	66	body = eval env' bodyExpr id
60	67	newReactor = Reactor{ rid=(fromIntegral $ length reactors), env=env, state=state, body=body }
61	68	in
62	69	collect rest env (newReactor:reactors) results