aboutsummaryrefslogtreecommitdiff
path: root/control
diff options
context:
space:
mode:
Diffstat (limited to 'control')
-rw-r--r--control/monad.scm46
-rw-r--r--control/monad/procedures.scm13
2 files changed, 55 insertions, 4 deletions
diff --git a/control/monad.scm b/control/monad.scm
index 2ef230c..e964b48 100644
--- a/control/monad.scm
+++ b/control/monad.scm
@@ -1,8 +1,12 @@
(define-module (control monad)
#:use-module (control monad procedures)
+ #:use-module (srfi srfi-1)
#:use-module (ice-9 match)
- #:export (do)
- #:re-export (>> >>=))
+ #:use-module (ice-9 curried-definitions)
+ #:replace (do)
+ #:export (sequence mapM
+ fmap <$> cmap <*>)
+ #:re-export (>> >>= return))
(define-syntax do
(syntax-rules (<- let =)
@@ -11,7 +15,43 @@
(ptrn (do rest ...))))
((_ ptrn <- val rest ...)
(>>= val (match-lambda (ptrn (do rest ...)))))
- ((_ a) a)
+ ((_ a) a) ; Base case
((_ token rest ...)
(>> token (do rest ...)))))
+;;; ----------------------------------------
+
+(define (fmap f m)
+ (>>= m (lambda (x) ((return m) (f x)))))
+
+(define <$> fmap)
+
+;; Curried map
+(define (cmap f)
+ (lambda (m) (fmap f m)))
+
+(define (<*> f_ i_)
+ (do f <- f_
+ i <- i_
+ ((return f_) (f i))))
+
+;;; ----------------------------------------
+
+;; sequence :: (list (M a)) → M (list a)
+(define (sequence in-list)
+ "Evaluate each monadic action in the structure from left to right, and collect
+the results. For a version that ignores the results see sequence_.
+https://hackage.haskell.org/package/base-4.12.0.0/docs/Control-Monad.html#g:4"
+ (define ((f done) item) (append done (list item)))
+ (fold (lambda (m-item m-done)
+ #!curly-infix {{ f <$> m-done } <*> m-item })
+ ((return (car in-list)) '())
+ in-list))
+
+;; mapM :: (a -> M b) x (list a) → M (list b)
+(define (mapM proc items)
+ "Map each element of a structure to a monadic action, evaluate these actions from
+left to right, and collect the results. For a version that ignores the results
+see mapM_.
+https://hackage.haskell.org/package/base-4.12.0.0/docs/Control-Monad.html#g:4"
+ (sequence (map proc items)))
diff --git a/control/monad/procedures.scm b/control/monad/procedures.scm
index 4be85ae..707dc0b 100644
--- a/control/monad/procedures.scm
+++ b/control/monad/procedures.scm
@@ -1,16 +1,27 @@
(define-module (control monad procedures)
#:use-module (oop goops)
#:use-module (srfi srfi-1) ; concatenate!
- #:export (>> >>=))
+ #:export (>> >>= return))
+
+(define-generic return)
+(define-method (return (a <top>)) identity)
+(define-method (return (a <pair>)) list)
(define-generic >>=)
+(define-method (>>= (a <top>) (proc <procedure>))
+ (proc a))
+
(define-method (>>= (this <null>) proc) '())
(define-method (>>= (this <pair>)
(proc <procedure>))
(concatenate! (map proc this)))
(define-generic >>)
+
+(define-method (>> (a <top>) (b <top>))
+ (>>= a (lambda args b)))
+
(define-method (>> (a <null>) (b <null>)) '())
(define-method (>> (a <pair>) (b <null>)) '())
(define-method (>> (a <null>) (b <pair>)) '())