Add semi-working bs

1 files changed, 61 insertions, 0 deletions

diff --git a/lore/core.scm b/lore/core.scm
new file mode 100644
index 0000000..4cb8100
--- /dev/null
+++ b/lore/core.scm
@@ -0,0 +1,61 @@
+;; standard library for bs
+
+(define (not x)            (if x #f #t))
+
+(define (null? obj)        (if (eqv? obj '()) #t #f))
+(define (list objs)        objs)
+(define (identity obj)     obj)
+(define (flip f)           (lambda (x y) (f y x)))
+(define (curry f a)        (lambda (b) (apply f (cons a (list b)))))
+(define (compose f g)      (lambda (x) (f (apply g x))))
+(define zero?              (curry = 0))
+(define positive?          (curry < 0))
+(define negative?          (curry > 0))
+(define (odd? n)           (= (mod n 2) 1))
+(define (even? n)          (= (mod n 2) 0))
+
+(define (foldr f end lst)
+  (if (null? lst)
+    end
+    (f (car lst) (foldr f end (cdr lst)))))
+
+(define (foldl f acc lst)
+  (if (null? lst)
+    acc
+    (foldl f (f acc (car lst)) (cdr lst))))
+
+(define fold   foldl)
+(define reduce foldr)
+
+(define (unfold f init pred)
+  (if (pred init)
+    (cons init '())
+    (cons init (unfold f (f init) pred))))
+
+(define (mem* pred op)
+  (lambda (acc next)
+    (if (and (not acc) (pred (op next)))
+      next
+      acc)))
+
+(define (sum lst)          (fold + 0 lst))
+(define (produce lst)      (fold * 0 1 lst))
+
+(define (max nums)
+  (fold (lambda (x y) (if (> x y) x y))
+        (car nums) (cdr nums)))
+
+(define (min nums)
+  (fold (lambda (x y) (if (< x y) x y))
+        (car nums) (cdr nums)))
+
+(define (length lst)       (fold (lambda (x y) (+ x 1)) 0 lst))
+(define (reverse lst)      (fold (flip cons) '() lst))
+(define (memq obj lst)     (fold (mem* (curry eq? obj) identity) #f lst))
+(define (memv obj lst)     (fold (mem* (curry eqv? obj) identity) #f lst))
+(define (member obj lst)   (fold (mem* (curry equal? obj) identity) #f lst))
+(define (assq obj alist)   (fold (mem* (curry eq? obj) car) #f alist))
+(define (assv obj alist)   (fold (mem* (curry eqv? obj) car) #f alist))
+(define (assoc obj alist)  (fold (mem* (curry equal? obj) car) #f alist))
+(define (map f lst)        (foldr (lambda (x y) (cons (f x) y)) '() lst))
+(define (filter pred lst)  (foldr (lambda (x y) (if (pred x) (cons x y) y)) '() lst))