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:
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 @@ (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)

View file

@ -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))