mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 21:38:07 -05:00
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.
This commit is contained in:
parent
49c0a8d6b6
commit
b734996f9c
2 changed files with 35 additions and 24 deletions
|
@ -225,8 +225,11 @@ (define (lift proc 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 @@ (define (foldm monad mproc init lst)
|
|||
(()
|
||||
(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 @@ (define-syntax-rule (sequence monad lst)
|
|||
(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)
|
||||
|
|
|
@ -163,7 +163,7 @@ (define (g x)
|
|||
(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 @@ (define (frob i)
|
|||
(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))
|
||||
|
|
Loading…
Reference in a new issue