Define arithmetic functions with functions.
Chris Pressey
4 years ago
| 16 | 16 |
`abs` expects exactly one numeric argument.
|
| 17 | 17 |
|
| 18 | 18 |
| (abs)
|
| 19 | |
? abort (illegal-arguments ())
|
|
19 |
? abort (illegal-arguments
|
| 20 | 20 |
|
| 21 | 21 |
| (abs 14 23)
|
| 22 | |
? abort (illegal-arguments (14 23))
|
|
22 |
? abort (illegal-arguments
|
| 23 | 23 |
|
| 24 | 24 |
| (abs #t)
|
| 25 | 25 |
? abort (expected-number #t)
|
| 26 | 26 |
|
| 27 | 27 |
'<<SPEC'
|
| 28 | 28 |
|
| 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))))
|
| 10 | 10 |
`add` expects exactly two arguments.
|
| 11 | 11 |
|
| 12 | 12 |
| (add 14)
|
| 13 | |
? abort (illegal-arguments (14))
|
|
13 |
? abort (illegal-arguments
|
| 14 | 14 |
|
| 15 | 15 |
| (add 6 7 7)
|
| 16 | |
? abort (illegal-arguments (6 7 7))
|
|
16 |
? abort (illegal-arguments
|
| 17 | 17 |
|
| 18 | 18 |
Both of the arguments to `add` must be numbers.
|
| 19 | 19 |
|
|
| 25 | 25 |
|
| 26 | 26 |
'<<SPEC'
|
| 27 | 27 |
|
| 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))))
|
| 32 | 32 |
`divide` expects exactly two arguments, both numbers.
|
| 33 | 33 |
|
| 34 | 34 |
| (divide 14)
|
| 35 | |
? abort (illegal-arguments (14))
|
|
35 |
? abort (illegal-arguments
|
| 36 | 36 |
|
| 37 | 37 |
| (divide 14 23 57)
|
| 38 | |
? abort (illegal-arguments (14 23 57))
|
|
38 |
? abort (illegal-arguments
|
| 39 | 39 |
|
| 40 | 40 |
| (divide 14 #t)
|
| 41 | 41 |
? abort (expected-number #t)
|
|
| 45 | 45 |
|
| 46 | 46 |
'<<SPEC'
|
| 47 | 47 |
|
| 48 | |
(define divide (fexpr (args env)
|
|
48 |
(define divide (fun (n d)
|
| 49 | 49 |
(bind divide-r-pos (fun (self n d acc) ;(d is positive)
|
| 50 | 50 |
(if (gt? d n)
|
| 51 | 51 |
acc
|
|
| 54 | 54 |
(if (gt? (abs d) n)
|
| 55 | 55 |
(subtract 0 (add 1 acc))
|
| 56 | 56 |
(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)))))))))
|
| 4 | 4 |
`multiply` evaluates both of its arguments to numbers and evaluates to the product
|
| 5 | 5 |
of those two numbers.
|
| 6 | 6 |
|
| 7 | |
| (multiply 6 7)
|
|
7 |
| (multiply 6 7)
|
| 8 | 8 |
= 42
|
| 9 | 9 |
|
| 10 | |
| (multiply (subtract 0 6) 7)
|
|
10 |
| (multiply (subtract 0 6) 7)
|
| 11 | 11 |
= -42
|
| 12 | 12 |
|
| 13 | |
| (multiply 6 (subtract 0 7))
|
|
13 |
| (multiply 6 (subtract 0 7))
|
| 14 | 14 |
= -42
|
| 15 | 15 |
|
| 16 | |
| (multiply (subtract 0 6) (subtract 0 7))
|
|
16 |
| (multiply (subtract 0 6) (subtract 0 7))
|
| 17 | 17 |
= 42
|
| 18 | 18 |
|
| 19 | 19 |
`multiply` expects exactly two arguments.
|
| 20 | 20 |
|
| 21 | |
| (multiply 14)
|
| 22 | |
? abort (illegal-arguments (14))
|
|
21 |
| (multiply 14)
|
|
22 |
? abort (illegal-arguments
|
| 23 | 23 |
|
| 24 | |
| (multiply 6 7 7)
|
| 25 | |
? abort (illegal-arguments (6 7 7))
|
|
24 |
| (multiply 6 7 7)
|
|
25 |
? abort (illegal-arguments
|
| 26 | 26 |
|
| 27 | 27 |
Both of the arguments to `multiply` must be numbers.
|
| 28 | 28 |
|
| 29 | |
| (multiply 14 #t)
|
|
29 |
| (multiply 14 #t)
|
| 30 | 30 |
? abort (expected-number #t)
|
| 31 | 31 |
|
| 32 | |
| (multiply #t 51)
|
|
32 |
| (multiply #t 51)
|
| 33 | 33 |
? abort (expected-number #t)
|
| 34 | 34 |
|
| 35 | 35 |
'<<SPEC'
|
| 36 | 36 |
|
| 37 | |
(define multiply (fexpr (args env)
|
|
37 |
(define multiply (fun (a b)
|
| 38 | 38 |
(bind multiply-r (fun (self a b) ;(b must be positive)
|
| 39 | 39 |
(if (equal? b 1)
|
| 40 | 40 |
a
|
| 41 | 41 |
(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))))))
|
| 33 | 33 |
`remainder` expects exactly two arguments, both numbers.
|
| 34 | 34 |
|
| 35 | 35 |
| (remainder 14)
|
| 36 | |
? abort (illegal-arguments (14))
|
|
36 |
? abort (illegal-arguments
|
| 37 | 37 |
|
| 38 | 38 |
| (remainder 14 23 57)
|
| 39 | |
? abort (illegal-arguments (14 23 57))
|
|
39 |
? abort (illegal-arguments
|
| 40 | 40 |
|
| 41 | 41 |
| (remainder 14 #t)
|
| 42 | 42 |
? abort (expected-number #t)
|
|
| 46 | 46 |
|
| 47 | 47 |
'<<SPEC'
|
| 48 | 48 |
|
| 49 | |
(define remainder (fexpr (args env)
|
|
49 |
(define remainder (fun (n d)
|
| 50 | 50 |
(bind remainder-r-pos (fun (self n d acc) ;(d is positive)
|
| 51 | 51 |
(if (gt? d n)
|
| 52 | 52 |
n
|
|
| 55 | 55 |
(if (gt? (abs d) n)
|
| 56 | 56 |
(add 1 n)
|
| 57 | 57 |
(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)))))))))
|