git @ Cat's Eye Technologies Robin / d532d9b
Define arithmetic functions with functions. Chris Pressey 1 year, 5 months ago
5 changed file(s) with 43 addition(s) and 48 deletion(s). Raw diff Collapse all Expand all
1616 `abs` expects exactly one numeric argument.
1717
1818 | (abs)
19 ? abort (illegal-arguments ())
19 ? abort (illegal-arguments
2020
2121 | (abs 14 23)
22 ? abort (illegal-arguments (14 23))
22 ? abort (illegal-arguments
2323
2424 | (abs #t)
2525 ? abort (expected-number #t)
2626
2727 '<<SPEC'
2828
29 (define abs (fexpr (args env)
30 (bind-args (a) args env
31 (if (equal? (sign a) 1) a (subtract 0 a)))))
29 (define abs (fun (a)
30 (if (equal? (sign a) 1) a (subtract 0 a))))
1010 `add` expects exactly two arguments.
1111
1212 | (add 14)
13 ? abort (illegal-arguments (14))
13 ? abort (illegal-arguments
1414
1515 | (add 6 7 7)
16 ? abort (illegal-arguments (6 7 7))
16 ? abort (illegal-arguments
1717
1818 Both of the arguments to `add` must be numbers.
1919
2525
2626 '<<SPEC'
2727
28 (define add (fexpr (args env)
29 (bind-args (a b) args env
30 (subtract a (subtract 0 b)))))
28 (define add (fun (a b)
29 (subtract a (subtract 0 b))))
3232 `divide` expects exactly two arguments, both numbers.
3333
3434 | (divide 14)
35 ? abort (illegal-arguments (14))
35 ? abort (illegal-arguments
3636
3737 | (divide 14 23 57)
38 ? abort (illegal-arguments (14 23 57))
38 ? abort (illegal-arguments
3939
4040 | (divide 14 #t)
4141 ? abort (expected-number #t)
4545
4646 '<<SPEC'
4747
48 (define divide (fexpr (args env)
48 (define divide (fun (n d)
4949 (bind divide-r-pos (fun (self n d acc) ;(d is positive)
5050 (if (gt? d n)
5151 acc
5454 (if (gt? (abs d) n)
5555 (subtract 0 (add 1 acc))
5656 (self self (add n d) d (add 1 acc))))
57 (bind-args (n d) args env
58 (if (equal? d 0)
59 (abort (list (literal division-by-zero) n))
60 (bind n-prime (if (lt? n 0) (subtract 0 n) n)
61 (bind d-prime (if (lt? n 0) (subtract 0 d) d)
62 (if (gt? d-prime 0)
63 (divide-r-pos divide-r-pos n-prime d-prime 0)
64 (divide-r-neg divide-r-neg n-prime d-prime 0))))))))))
57 (if (equal? d 0)
58 (abort (list (literal division-by-zero) n))
59 (bind n-prime (if (lt? n 0) (subtract 0 n) n)
60 (bind d-prime (if (lt? n 0) (subtract 0 d) d)
61 (if (gt? d-prime 0)
62 (divide-r-pos divide-r-pos n-prime d-prime 0)
63 (divide-r-neg divide-r-neg n-prime d-prime 0)))))))))
44 `multiply` evaluates both of its arguments to numbers and evaluates to the product
55 of those two numbers.
66
7 | (multiply 6 7)
7 | (multiply 6 7)
88 = 42
99
10 | (multiply (subtract 0 6) 7)
10 | (multiply (subtract 0 6) 7)
1111 = -42
1212
13 | (multiply 6 (subtract 0 7))
13 | (multiply 6 (subtract 0 7))
1414 = -42
1515
16 | (multiply (subtract 0 6) (subtract 0 7))
16 | (multiply (subtract 0 6) (subtract 0 7))
1717 = 42
1818
1919 `multiply` expects exactly two arguments.
2020
21 | (multiply 14)
22 ? abort (illegal-arguments (14))
21 | (multiply 14)
22 ? abort (illegal-arguments
2323
24 | (multiply 6 7 7)
25 ? abort (illegal-arguments (6 7 7))
24 | (multiply 6 7 7)
25 ? abort (illegal-arguments
2626
2727 Both of the arguments to `multiply` must be numbers.
2828
29 | (multiply 14 #t)
29 | (multiply 14 #t)
3030 ? abort (expected-number #t)
3131
32 | (multiply #t 51)
32 | (multiply #t 51)
3333 ? abort (expected-number #t)
3434
3535 '<<SPEC'
3636
37 (define multiply (fexpr (args env)
37 (define multiply (fun (a b)
3838 (bind multiply-r (fun (self a b) ;(b must be positive)
3939 (if (equal? b 1)
4040 a
4141 (add a (self self a (subtract b 1)))))
42 (bind-args (a b) args env
43 (if (equal? b 0) 0
44 (if (lt? b 0)
45 (subtract 0 (multiply-r multiply-r a (subtract 0 b)))
46 (multiply-r multiply-r a b)))))))
42 (if (equal? b 0) 0
43 (if (lt? b 0)
44 (subtract 0 (multiply-r multiply-r a (subtract 0 b)))
45 (multiply-r multiply-r a b))))))
3333 `remainder` expects exactly two arguments, both numbers.
3434
3535 | (remainder 14)
36 ? abort (illegal-arguments (14))
36 ? abort (illegal-arguments
3737
3838 | (remainder 14 23 57)
39 ? abort (illegal-arguments (14 23 57))
39 ? abort (illegal-arguments
4040
4141 | (remainder 14 #t)
4242 ? abort (expected-number #t)
4646
4747 '<<SPEC'
4848
49 (define remainder (fexpr (args env)
49 (define remainder (fun (n d)
5050 (bind remainder-r-pos (fun (self n d acc) ;(d is positive)
5151 (if (gt? d n)
5252 n
5555 (if (gt? (abs d) n)
5656 (add 1 n)
5757 (self self (add n d) d (add 1 acc))))
58 (bind-args (n d) args env
59 (if (equal? d 0)
60 (abort (list (literal division-by-zero) n))
61 (bind n-prime (if (lt? n 0) (subtract 0 n) n)
62 (bind d-prime (if (lt? n 0) (subtract 0 d) d)
63 (if (gt? d-prime 0)
64 (remainder-r-pos remainder-r-pos n-prime d-prime 0)
65 (remainder-r-neg remainder-r-neg n-prime d-prime 0))))))))))
58 (if (equal? d 0)
59 (abort (list (literal division-by-zero) n))
60 (bind n-prime (if (lt? n 0) (subtract 0 n) n)
61 (bind d-prime (if (lt? n 0) (subtract 0 d) d)
62 (if (gt? d-prime 0)
63 (remainder-r-pos remainder-r-pos n-prime d-prime 0)
64 (remainder-r-neg remainder-r-neg n-prime d-prime 0)))))))))