diff options
author | Ben Sima <ben@bsima.me> | 2019-11-19 10:39:52 -0800 |
---|---|---|
committer | Ben Sima <ben@bsima.me> | 2019-11-19 10:40:56 -0800 |
commit | 31498d576517970136d097d47c67e542facd02ab (patch) | |
tree | 7e7cc69a107afaa47039389cbfa1e1f511c6939c /Com/Simatime | |
parent | d1b1feee48ddced8ebb4872b00250b8e53b8c337 (diff) |
Fixes to Com.Simatime.Core
- make it actually compile
- add fmt
- export stuff I'm using elsewhere
- comment stuff that doesn't work yet
Diffstat (limited to 'Com/Simatime')
-rwxr-xr-x | Com/Simatime/bild.scm | 6 | ||||
-rw-r--r-- | Com/Simatime/core.scm | 101 |
2 files changed, 63 insertions, 44 deletions
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>))) |