1 files changed, 117 insertions, 0 deletions
diff --git a/Com/Simatime/core.scm b/Com/Simatime/core.scm
new file mode 100644
index 0000000..dbacd8a
--- /dev/null
+++ b/Com/Simatime/core.scm
@@ -0,0 +1,117 @@
+(define-module (Com Simatime core))
+
+(define (flip f)           (lambda (x y) (f y x)))
+(define (curry f a)        (lambda (b) (apply f (cons a (list b)))))
+(define pos?
+  (curry < 0))
+
+(define neg?
+  (curry > 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 (sum lst)          (fold + 0 lst))
+(define (produce lst)      (fold * 0 1 lst))
+
+(define count length)
+
+
+;;
+;; clojure-like stuff
+;;
+
+(define (pr . a)
+  (for-each display args))
+
+(define (prn . a) (apply pr a) (newline))
+
+(define first
+  "Return the first item in the collection."
+  car)
+
+(define next
+  "Returns a list of the items after the first."
+  cadr)
+
+(define (second x)
+  (first (next x)))
+
+(define (ffirst x)
+  (first (first x)))
+
+(define (nnext x)
+  (next (next)))
+
+(define (last coll)
+  "Return the last time in coll, in linear time."
+  (if (next coll)
+      (last coll)
+      (first coll)))
+
+(define (butlast ls)
+  "Return everthing execpt the last element in ls."
+  (let ((len (length ls)))
+    (list-head ls (- len 1))))
+
+(define (false? x)
+  (eq? #f x))
+
+(define (true? x)
+  (eq? #t x))
+
+(define nil 'nil)
+
+(define (nil? x)
+  (eq? nil x))
+
+(define-syntax when-not
+  (syntax-case
+      (())))
+
+#|
+
+If I implement ML-like interface abstractions in scheme, what would it look like?
+
+
+;; seq
+
+(define-class <seq> () (_first))
+
+
+;; Functor
+
+(define-class <functor> ())
+
+(define-method (fmap (f <procedure>) (coll <functor>)))
+
+
+;; Applicative
+
+;; a -> f a
+(define-method (pure (a <any>)))
+
+;; f (a -> b) -> f a -> f b
+(define-method (<*> (f <procedure>) (a <applicative>) (b <applicative>)))
+
+;; f a -> f b -> f b
+(define-method (*> (a <applicative>) (b <applicative>)))
+
+;; f a -> f b -> f a
+(define-method (<* (a <applicative>) (b <applicative>)))
+
+|#