aboutsummaryrefslogtreecommitdiff
path: root/data
diff options
context:
space:
mode:
Diffstat (limited to 'data')
-rw-r--r--data/functor.scm19
-rw-r--r--data/optional.scm28
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)