Commit 17388ccacdc78c97f4cf4f1c630224972b155086 - Robin

+1

-13

src/Language/Robin/Builtins.hs less more

0	0	module Language.Robin.Builtins where
1
2		import Data.Int
3	1
4	2	import Language.Robin.Expr
5	3	import Language.Robin.Env (Env, fromList, mergeEnvs, empty, insert)

34	32	cc $ insert formal value nenv))
35	33	evalArgs ecc _ _ origActuals env _ =
36	34	errMsg ecc "illegal-arguments" $ List origActuals
37
38
39		evalTwoNumbers :: (Int32 -> Int32 -> (Expr -> Expr) -> Expr) -> Evaluable
40		evalTwoNumbers fn env (List [xexpr, yexpr]) cc =
41		evalB cc env xexpr (\x ->
42		assertNumber cc env x (\(Number xv) ->
43		evalB cc env yexpr (\y ->
44		assertNumber cc env y (\(Number yv) ->
45		(fn xv yv cc)))))
46		evalTwoNumbers fn env other cc = errMsg cc "illegal-arguments" other
47	35
48	36	--
49	37	-- `Small`

137	125
138	126	abs_ :: Evaluable
139	127	abs_ env (List [expr]) cc =
140		eval env expr (\x -> assertNumber (cc) env x (\(Number xv) -> cc (Number $ abs xv)))
	128	evalToNumber cc env expr (\(Number xv) -> cc $ Number $ abs xv)
141	129	abs_ env other cc = errMsg cc "illegal-arguments" other
142	130
143	131	add :: Evaluable

+19

-4

src/Language/Robin/Eval.hs less more

0	0	module Language.Robin.Eval where
	1
	2	import Data.Int
1	3
2	4	import Language.Robin.Expr
3	5	import Language.Robin.Env (Env, find, insert)

99	101	True -> cc expr
100	102	False -> errMsg ecc msg expr
101	103
102		assertSymbol ecc env expr = assert ecc env (isSymbol) "expected-symbol" expr
103		assertBoolean ecc env expr = assert ecc env (isBoolean) "expected-boolean" expr
104	104	assertList ecc env expr = assert ecc env (isList) "expected-list" expr
105		assertNumber ecc env expr = assert ecc env (isNumber) "expected-number" expr
106		assertOperator ecc env expr = assert ecc env (isOperator) "expected-operator" expr
	105
	106	evalExpect pred msg ecc env expr cc =
	107	eval env expr (\value ->
	108	case pred value of
	109	True -> cc value
	110	False -> errMsg ecc msg value)
	111
	112	evalToBoolean = evalExpect (isBoolean) "expected-boolean"
	113	evalToList = evalExpect (isList) "expected-list"
	114	evalToNumber = evalExpect (isNumber) "expected-number"
	115
	116	evalTwoNumbers :: (Int32 -> Int32 -> (Expr -> Expr) -> Expr) -> Evaluable
	117	evalTwoNumbers fn env (List [xexpr, yexpr]) cc =
	118	evalToNumber cc env xexpr (\(Number xv) ->
	119	evalToNumber cc env yexpr (\(Number yv) ->
	120	(fn xv yv cc)))
	121	evalTwoNumbers fn env other cc = errMsg cc "illegal-arguments" other

+7

-18

src/Language/Robin/Intrinsics.hs less more

25	25	prepend :: Evaluable
26	26	prepend env (List [e1, e2]) cc =
27	27	evalB cc env e1 (\x1 ->
28		evalB cc env e2 (\val ->
29		case val of
30		List x2 -> cc $ List (x1:x2)
31		other -> errMsg cc "expected-list" other))
	28	evalToList cc env e2 (\(List x2) -> cc $ List (x1:x2)))
32	29	prepend env other cc = errMsg cc "illegal-arguments" other
33	30
34	31	equalP :: Evaluable

46	43	numberP = predP isNumber
47	44
48	45	subtract_ :: Evaluable
49		subtract_ env (List [xexpr, yexpr]) cc =
50		eval env xexpr (\x ->
51		assertNumber cc env x (\(Number xv) ->
52		eval env yexpr (\y ->
53		assertNumber cc env y (\(Number yv) ->
54		cc (Number (xv - yv))))))
55		subtract_ env other cc = errMsg cc "illegal-arguments" other
	46	subtract_ = evalTwoNumbers (\x y cc -> cc $ Number (x - y))
56	47
57	48	sign :: Evaluable
58	49	sign env (List [expr]) cc =
59	50	let
60	51	sgn x = if x == 0 then 0 else if x < 0 then -1 else 1
61	52	in
62		evalB cc env expr (\x ->
63		assertNumber cc env x (\(Number xv) ->
64		cc $ Number $ sgn xv))
	53	evalToNumber cc env expr (\(Number xv) ->
	54	cc $ Number $ sgn xv)
65	55	sign env other cc = errMsg cc "illegal-arguments" other
66	56
67	57	if_ :: Evaluable
68		if_ env (List [test, texpr, fexpr]) cc =
69		evalB cc env test (\x ->
70		assertBoolean cc env x (\(Boolean b) ->
71		if b then eval env texpr cc else eval env fexpr cc))
	58	if_ env (List [testExpr, trueExpr, falseExpr]) cc =
	59	evalToBoolean cc env testExpr (\(Boolean b) ->
	60	if b then eval env trueExpr cc else eval env falseExpr cc)
72	61	if_ env other cc = errMsg cc "illegal-arguments" other
73	62
74	63	eval_ :: Evaluable