summaryrefslogtreecommitdiff
path: root/Com/Simatime/core.scm
diff options
context:
space:
mode:
authorBen Sima <ben@bsima.me>2019-11-02 15:33:13 -0700
committerBen Sima <ben@bsima.me>2019-11-02 15:33:13 -0700
commit9d114cfc773171b0a95bd4d2c39f1bb0eb783c8d (patch)
tree20766a760ed0141cf39153565e8552f6739c632d /Com/Simatime/core.scm
parentd2a37f5de160160eadbacd7b8dc2567f78a0543d (diff)
rename everything back to caps to appease ghc
Diffstat (limited to 'Com/Simatime/core.scm')
-rw-r--r--Com/Simatime/core.scm117
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>)))
+
+|#