summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--prelude/primitives.scm21
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))