diff options
Diffstat (limited to 'data')
-rw-r--r-- | data/functor.scm | 19 | ||||
-rw-r--r-- | data/optional.scm | 28 |
2 files changed, 7 insertions, 40 deletions
diff --git a/data/functor.scm b/data/functor.scm deleted file mode 100644 index 4e4722f..0000000 --- a/data/functor.scm +++ /dev/null @@ -1,19 +0,0 @@ -(define-module (data functor) - #:use-module (oop goops) - #:use-module (srfi srfi-1) - #:use-module (ice-9 curried-definitions) - #:export (fmap <$> cmap)) - -;;; We don't overwrite the default map since that creates way to many -;;; namespace problems. - -(define-generic fmap) -(define <$> fmap) - -;;; Default fallback for fmap is regular (srfi-1) map. -(define-method (fmap f . lists) - (apply map f lists)) - -;; Curried map -(define ((cmap f) item) - (fmap f item)) diff --git a/data/optional.scm b/data/optional.scm index 7ab944c..61543d2 100644 --- a/data/optional.scm +++ b/data/optional.scm @@ -2,18 +2,16 @@ #:use-module (oop goops) #:use-module (ice-9 match) #:use-module (control monad) - #:use-module (data functor) #:use-module (ice-9 curried-definitions) - #:export (nothing just - nothing? just? - from-just wrap-maybe - return-optional) - #:re-export (>>= >> fmap)) + #:export (from-just wrap-maybe + nothing just + nothing? just?) + #:re-export (>>= >> return)) (define-class <optional> () (slot #:init-value #f #:init-keyword #:slot) - (just #:init-value #t + (just #:init-value #t #:init-keyword #:just)) (define (nothing) (make <optional> #:just #f)) @@ -45,23 +43,11 @@ the value embedded in maybe-val" (format port "[Just ~s]" (slot-ref this 'slot)) (format port "[Nothing]"))) -(define return-optional just) - (define-method (>>= (this <optional>) (proc <procedure>)) (cond ((nothing? this) (nothing)) - ((just? this) + ((just? this) (match this (($ <optional> slot) (proc slot)))))) -(define-method (>> (a <optional>) - (b <optional>)) - (if (or (nothing? a) - (nothing? b)) - (nothing) - b)) - -(define-method (fmap (f <procedure>) - (m <optional>)) - (do x <- m - (return-optional (f x)))) +(define-method (return (a <optional>)) just) |