aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix/monads.scm46
-rw-r--r--tests/monads.scm13
2 files changed, 35 insertions, 24 deletions
diff --git a/guix/monads.scm b/guix/monads.scm
index f693e99a59..4248525433 100644
--- a/guix/monads.scm
+++ b/guix/monads.scm
@@ -225,8 +225,11 @@ MONAD---i.e., return a monadic function in MONAD."
(return (apply proc args)))))
(define (foldm monad mproc init lst)
- "Fold MPROC over LST, a list of monadic values in MONAD, and return a
-monadic value seeded by INIT."
+ "Fold MPROC over LST and return a monadic value seeded by INIT.
+
+ (foldm %state-monad (lift2 cons %state-monad) '() '(a b c))
+ => '(c b a) ;monadic
+"
(with-monad monad
(let loop ((lst lst)
(result init))
@@ -234,18 +237,21 @@ monadic value seeded by INIT."
(()
(return result))
((head tail ...)
- (mlet* monad ((item head)
- (result (mproc item result)))
- (loop tail result)))))))
+ (>>= (mproc head result)
+ (lambda (result)
+ (loop tail result))))))))
(define (mapm monad mproc lst)
- "Map MPROC over LST, a list of monadic values in MONAD, and return a monadic
-list. LST items are bound from left to right, so effects in MONAD are known
-to happen in that order."
+ "Map MPROC over LST and return a monadic list.
+
+ (mapm %state-monad (lift1 1+ %state-monad) '(0 1 2))
+ => (1 2 3) ;monadic
+"
(mlet monad ((result (foldm monad
(lambda (item result)
- (mlet monad ((item (mproc item)))
- (return (cons item result))))
+ (>>= (mproc item)
+ (lambda (item)
+ (return (cons item result)))))
'()
lst)))
(return (reverse result))))
@@ -268,20 +274,24 @@ evaluating each item of LST in sequence."
(lambda (item)
(seq tail (cons item result)))))))))
-(define (anym monad proc lst)
- "Apply PROC to the list of monadic values LST; return the first value,
-lifted in MONAD, for which PROC returns true."
+(define (anym monad mproc lst)
+ "Apply MPROC to the list of values LST; return as a monadic value the first
+value for which MPROC returns a true monadic value or #f. For example:
+
+ (anym %state-monad (lift1 odd? %state-monad) '(0 1 2))
+ => #t ;monadic
+"
(with-monad monad
(let loop ((lst lst))
(match lst
(()
(return #f))
((head tail ...)
- (mlet* monad ((value head)
- (result -> (proc value)))
- (if result
- (return result)
- (loop tail))))))))
+ (>>= (mproc head)
+ (lambda (result)
+ (if result
+ (return result)
+ (loop tail)))))))))
(define-syntax listm
(lambda (s)
diff --git a/tests/monads.scm b/tests/monads.scm
index 57a8e66797..5529a6188a 100644
--- a/tests/monads.scm
+++ b/tests/monads.scm
@@ -163,7 +163,7 @@
(test-assert "mapm"
(every (lambda (monad run)
(with-monad monad
- (equal? (run (mapm monad (lift1 1+ monad) (map return (iota 10))))
+ (equal? (run (mapm monad (lift1 1+ monad) (iota 10)))
(map 1+ (iota 10)))))
%monads
%monad-run))
@@ -202,11 +202,12 @@
(test-assert "anym"
(every (lambda (monad run)
(eq? (run (with-monad monad
- (let ((lst (list (return 1) (return 2) (return 3))))
- (anym monad
- (lambda (x)
- (and (odd? x) 'odd!))
- lst))))
+ (anym monad
+ (lift1 (lambda (x)
+ (and (odd? x) 'odd!))
+ monad)
+ (append (make-list 1000 0)
+ (list 1 2)))))
'odd!))
%monads
%monad-run))