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
parent
49c0a8d6b6
commit
b734996f9c
|
@ -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)
|
||||||
|
|
|
@ -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))
|
||||||
|
|
Reference in New Issue