diff options
Diffstat (limited to 'prelude')
-rw-r--r-- | prelude/primitives.scm | 21 |
1 files changed, 20 insertions, 1 deletions
diff --git a/prelude/primitives.scm b/prelude/primitives.scm index 96dd1dd..2e5f5d9 100644 --- a/prelude/primitives.scm +++ b/prelude/primitives.scm | |||
@@ -1,3 +1,13 @@ | |||
1 | (define-module (prelude/primitives) | ||
2 | #: export (primitive-names | ||
3 | primitive-objs | ||
4 | lift-bool | ||
5 | lift-arithmetic | ||
6 | primitives | ||
7 | bool? | ||
8 | true?)) | ||
9 | |||
10 | (define (lift-bool expr) (if expr 'true 'false)) | ||
1 | (define (true? expr) (eq? expr 'true)) | 11 | (define (true? expr) (eq? expr 'true)) |
2 | (define (false? expr) (eq? expr 'false)) | 12 | (define (false? expr) (eq? expr 'false)) |
3 | (define (bool? expr) | 13 | (define (bool? expr) |
@@ -24,13 +34,22 @@ | |||
24 | 34 | ||
25 | (define (not-fn x) (not (true? x))) | 35 | (define (not-fn x) (not (true? x))) |
26 | 36 | ||
37 | (define (lift-arithmetic op) | ||
38 | (lambda vals (lift-bool (apply op vals)))) | ||
39 | |||
27 | (define primitives | 40 | (define primitives |
28 | `((+ . ,+) | 41 | `((+ . ,+) |
29 | (- . ,-) | 42 | (- . ,-) |
30 | (* . ,*) | 43 | (* . ,*) |
44 | (< . ,(lift-arithmetic <)) | ||
45 | (> . ,(lift-arithmetic >)) | ||
46 | (<= . ,(lift-arithmetic <=)) | ||
47 | (>= . ,(lift-arithmetic >=)) | ||
31 | (&& . ,and-special) | 48 | (&& . ,and-special) |
32 | (|| . ,or-special) | 49 | (|| . ,or-special) |
33 | (/= . ,not-fn))) | 50 | (/= . ,not-fn) |
51 | (first . ,car) | ||
52 | (rest . ,cdr))) | ||
34 | 53 | ||
35 | (define (primitive-names) (map car primitives)) | 54 | (define (primitive-names) (map car primitives)) |
36 | (define (primitive-objs) (map cdr primitives)) | 55 | (define (primitive-objs) (map cdr primitives)) |