blob: cd7f1bf89197100fac971d880564fbd80c8c5348 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
|
(define-module (prelude/primitives)
#: export (primitive-names
primitive-objs
lift-bool
lift-arithmetic
primitives
bool?
true?))
(define (convert-bool expr) (if expr 'true 'false))
(define (true? expr) (eq? expr 'true))
(define (false? expr) (eq? expr 'false))
(define (bool? expr)
(or (true? expr)
(false? expr)))
(define (and-special . items)
(if (null? items)
'false
(let ([first (car items)])
(cond
[(true? first) (apply and-special (cdr items))]
[(false? first) 'false]
[else (error "AND: unable to evaluate non-boolean form" first)]))))
(define (or-special . items)
(if (null? items)
'false
(let ([first (car items)])
(cond
[(true? first) 'true]
[(false? first) (apply or-special (cdr items))]
[else (error "OR: unable to evaluate non-boolean form" first)]))))
(define (not-fn x) (not (true? x)))
(define (lift-bool op)
(lambda vals (convert-bool (apply op vals))))
(define primitives
`((+ . ,+)
(- . ,-)
(* . ,*)
(< . ,(lift-bool <))
(> . ,(lift-bool >))
(<= . ,(lift-bool <=))
(>= . ,(lift-bool >=))
(eq? . ,(lift-bool eq?))
(&& . ,and-special)
(|| . ,or-special)
(/= . ,not-fn)
(first . ,car)
(rest . ,cdr)))
(define (primitive-names) (map car primitives))
(define (primitive-objs) (map cdr primitives))
|
