From 31498d576517970136d097d47c67e542facd02ab Mon Sep 17 00:00:00 2001
From: Ben Sima <ben@bsima.me>
Date: Tue, 19 Nov 2019 10:39:52 -0800
Subject: Fixes to Com.Simatime.Core

- make it actually compile
- add fmt
- export stuff I'm using elsewhere
- comment stuff that doesn't work yet
---
 Com/Simatime/bild.scm |   6 +--
 Com/Simatime/core.scm | 101 +++++++++++++++++++++++++++++++-------------------
 2 files changed, 63 insertions(+), 44 deletions(-)

(limited to 'Com/Simatime')

diff --git a/Com/Simatime/bild.scm b/Com/Simatime/bild.scm
index 6ac09ce..c7ab666 100755
--- a/Com/Simatime/bild.scm
+++ b/Com/Simatime/bild.scm
@@ -121,6 +121,7 @@
   #:use-module ((ice-9 popen) #:prefix popen/)
   #:use-module ((ice-9 format) #:select (format))
   #:use-module ((ice-9 rdelim) #:prefix rdelim/)
+  #:use-module ((Com Simatime core) #:select (fmt))
   #:use-module ((Com Simatime shell) #:prefix sh/)
   #:use-module ((Com Simatime string) #:prefix string/)
   #:export (ns?
@@ -128,11 +129,6 @@
             path->ns
             main))
 
-(define-syntax fmt
-  (syntax-rules ()
-    ((fmt s args ...)
-     (format #f s args ...))))
-
 (define (main args)
   (let* ((root (sh/exec "git rev-parse --show-toplevel"))
          (target (cadr args))
diff --git a/Com/Simatime/core.scm b/Com/Simatime/core.scm
index 4d523ea..a97552f 100644
--- a/Com/Simatime/core.scm
+++ b/Com/Simatime/core.scm
@@ -1,4 +1,12 @@
-(define-module (Com Simatime core))
+(define-module (Com Simatime core)
+  #:use-module ((ice-9 format))
+  #:export (fmt
+
+            first next second
+
+            true? false? nil nil?
+
+            comment ))
 
 (define (flip f)           (lambda (x y) (f y x)))
 (define (curry f a)        (lambda (b) (apply f (cons a (list b)))))
@@ -26,7 +34,7 @@
     (cons init (unfold f (f init) pred))))
 
 (define (sum lst)          (fold + 0 lst))
-(define (produce lst)      (fold * 0 1 lst))
+(define (produce lst)      (fold * 1 lst))
 
 (define count length)
 
@@ -36,26 +44,30 @@
 ;;
 
 (define (pr . a)
-  (for-each display args))
+  (for-each display a))
 
 (define (prn . a) (apply pr a) (newline))
 
-(define first
+(define (first a)
   "Return the first item in the collection."
-  car)
+  (car a))
 
-(define next
+(define (rest a)
   "Returns a list of the items after the first."
-  cadr)
+  (cdr a))
 
-(define (second x)
-  (first (next x)))
+(define (next a)
+  "Returns the next item after the first."
+  (cadr a))
 
-(define (ffirst x)
-  (first (first x)))
+(define (second a)
+  (first (next a)))
 
-(define (nnext x)
-  (next (next)))
+(define (ffirst a)
+  (first (first a)))
+
+(define (nnext a)
+  (next (next a)))
 
 (define (last coll)
   "Return the last time in coll, in linear time."
@@ -74,11 +86,25 @@
 (define (true? x)
   (eq? #t x))
 
-(define nil 'nil)
+(define nil #nil)
 
 (define (nil? x)
   (eq? nil x))
 
+;; Ignores body, returns nil.
+(define-syntax comment
+  (syntax-rules ()
+    ((_ ...) nil)))
+
+(comment
+ ;; nil is different from null. nil is supposed to be more like
+ ;; 'Nothing' in Haskell, it is the absence of any value or type;
+ ;; whereas null is specifically the empty list, which still has a type
+ ;; of 'list'.
+ (null? '()) ;; => #t
+ (nil? '())  ;; => #f
+ )
+
 (define (some pred coll)
   (or (pred (first coll))
       (some pred (next coll))))
@@ -88,39 +114,36 @@
 (define (not-any? pred coll)
   (comp not some))
 
-(define-syntax when-not
-  (syntax-case
-      (())))
+(define-syntax fmt
+  (syntax-rules ()
+    ((_ s args ...)
+     (format #f s args ...))))
 
-#|
+;; If I implement ML-like interface abstractions in scheme, what would it look like?
 
-If I implement ML-like interface abstractions in scheme, what would it look like?
+;; 
+;; ;; seq
 
-
-;; seq
-
-(define-class <seq> () (_first))
+;; (define-class <seq> () (_first))
 
-
-;; Functor
+;; 
+;; ;; Functor
 
-(define-class <functor> ())
+;; (define-class <functor> ())
 
-(define-method (fmap (f <procedure>) (coll <functor>)))
-
-
-;; Applicative
+;; (define-method (fmap (f <procedure>) (coll <functor>)))
 
-;; a -> f a
-(define-method (pure (a <any>)))
+;; 
+;; ;; Applicative
 
-;; f (a -> b) -> f a -> f b
-(define-method (<*> (f <procedure>) (a <applicative>) (b <applicative>)))
+;; ;; a -> f a
+;; (define-method (pure (a <any>)))
 
-;; f a -> f b -> f b
-(define-method (*> (a <applicative>) (b <applicative>)))
+;; ;; f (a -> b) -> f a -> f b
+;; (define-method (<*> (f <procedure>) (a <applicative>) (b <applicative>)))
 
-;; f a -> f b -> f a
-(define-method (<* (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>)))
-- 
cgit v1.2.3