From c790672cc244ac4caba1bda3572829a6c6862891 Mon Sep 17 00:00:00 2001
From: Ben Sima <ben@bsima.me>
Date: Sun, 27 Oct 2019 09:48:52 -0700
Subject: move everything to namespace directories

---
 com/simatime/core.scm | 73 +++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 73 insertions(+)
 create mode 100644 com/simatime/core.scm

(limited to 'com/simatime/core.scm')

diff --git a/com/simatime/core.scm b/com/simatime/core.scm
new file mode 100644
index 0000000..6a4f09d
--- /dev/null
+++ b/com/simatime/core.scm
@@ -0,0 +1,73 @@
+(define-module (com simatime core))
+
+;;
+;; old core, do i still need this?
+;;
+
+(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 (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))
+
+
+;;
+;; clojure-like stuff
+;;
+
+(define (pr . a)
+  (for-each display args))
+
+(define (prn . a) (apply pr a) (newline))
-- 
cgit v1.2.3