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
57
58
59
60
61
62
63
64
|
(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 >=))
(= . ,(lift-bool =))
(eq? . ,(lift-bool eq?))
(&& . ,and-special)
(|| . ,or-special)
(/= . ,not-fn)
(first . ,car)
(second . ,cadr)
(third . ,caddr)
(fourth . ,cadddr)
(rest . ,cdr)
(cons . ,cons)
(list . ,list)
(map . ,map)
(null? . ,(lift-bool null?))))
(define (primitive-names) (map car primitives))
(define (primitive-objs) (map cdr primitives))
|