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)))
(>>= (mproc head)
(lambda (result)
(if result
(return result)
(loop tail))))))))
(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)
(lift1 (lambda (x)
(and (odd? x) 'odd!))
lst))))
monad)
(append (make-list 1000 0)
(list 1 2)))))
'odd!))
%monads
%monad-run))