monads: 'foldm', 'mapm', and 'anym' now take a list of regular values.

* guix/monads.scm (foldm, mapm, anym): Change to take a list of regular
  values as is customary.
* tests/monads.scm ("mapm", "anym"): Adjust accordingly.
master
Ludovic Courtès 2015-05-27 09:40:19 +02:00
parent 49c0a8d6b6
commit b734996f9c
2 changed files with 35 additions and 24 deletions

View File

@ -225,8 +225,11 @@ MONAD---i.e., return a monadic function in MONAD."
(return (apply proc args))))) (return (apply proc args)))))
(define (foldm monad mproc init lst) (define (foldm monad mproc init lst)
"Fold MPROC over LST, a list of monadic values in MONAD, and return a "Fold MPROC over LST and return a monadic value seeded by INIT.
monadic value seeded by INIT."
(foldm %state-monad (lift2 cons %state-monad) '() '(a b c))
=> '(c b a) ;monadic
"
(with-monad monad (with-monad monad
(let loop ((lst lst) (let loop ((lst lst)
(result init)) (result init))
@ -234,18 +237,21 @@ monadic value seeded by INIT."
(() (()
(return result)) (return result))
((head tail ...) ((head tail ...)
(mlet* monad ((item head) (>>= (mproc head result)
(result (mproc item result))) (lambda (result)
(loop tail result))))))) (loop tail result))))))))
(define (mapm monad mproc lst) (define (mapm monad mproc lst)
"Map MPROC over LST, a list of monadic values in MONAD, and return a monadic "Map MPROC over LST and return a monadic list.
list. LST items are bound from left to right, so effects in MONAD are known
to happen in that order." (mapm %state-monad (lift1 1+ %state-monad) '(0 1 2))
=> (1 2 3) ;monadic
"
(mlet monad ((result (foldm monad (mlet monad ((result (foldm monad
(lambda (item result) (lambda (item result)
(mlet monad ((item (mproc item))) (>>= (mproc item)
(return (cons item result)))) (lambda (item)
(return (cons item result)))))
'() '()
lst))) lst)))
(return (reverse result)))) (return (reverse result))))
@ -268,20 +274,24 @@ evaluating each item of LST in sequence."
(lambda (item) (lambda (item)
(seq tail (cons item result))))))))) (seq tail (cons item result)))))))))
(define (anym monad proc lst) (define (anym monad mproc lst)
"Apply PROC to the list of monadic values LST; return the first value, "Apply MPROC to the list of values LST; return as a monadic value the first
lifted in MONAD, for which PROC returns true." 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 (with-monad monad
(let loop ((lst lst)) (let loop ((lst lst))
(match lst (match lst
(() (()
(return #f)) (return #f))
((head tail ...) ((head tail ...)
(mlet* monad ((value head) (>>= (mproc head)
(result -> (proc value))) (lambda (result)
(if result (if result
(return result) (return result)
(loop tail)))))))) (loop tail)))))))))
(define-syntax listm (define-syntax listm
(lambda (s) (lambda (s)

View File

@ -163,7 +163,7 @@
(test-assert "mapm" (test-assert "mapm"
(every (lambda (monad run) (every (lambda (monad run)
(with-monad monad (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))))) (map 1+ (iota 10)))))
%monads %monads
%monad-run)) %monad-run))
@ -202,11 +202,12 @@
(test-assert "anym" (test-assert "anym"
(every (lambda (monad run) (every (lambda (monad run)
(eq? (run (with-monad monad (eq? (run (with-monad monad
(let ((lst (list (return 1) (return 2) (return 3)))) (anym monad
(anym monad (lift1 (lambda (x)
(lambda (x) (and (odd? x) 'odd!))
(and (odd? x) 'odd!)) monad)
lst)))) (append (make-list 1000 0)
(list 1 2)))))
'odd!)) 'odd!))
%monads %monads
%monad-run)) %monad-run))