From b734996f9cf395705860703422d5e92565dd3a13 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 27 May 2015 09:40:19 +0200 Subject: 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. --- guix/monads.scm | 46 ++++++++++++++++++++++++++++------------------ 1 file changed, 28 insertions(+), 18 deletions(-) (limited to 'guix/monads.scm') diff --git a/guix/monads.scm b/guix/monads.scm index f693e99a59..4248525433 100644 --- a/guix/monads.scm +++ b/guix/monads.scm @@ -225,8 +225,11 @@ MONAD---i.e., return a monadic function in 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 @@ monadic value seeded by INIT." (() (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 @@ evaluating each item of LST in sequence." (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) -- cgit v1.2.3 From 751630c9c3f7f3e87dfccc5f5ba8cf61cdd6f8fd Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 8 Jun 2015 22:49:50 +0200 Subject: monads: Allow n-ary '>>=' expressions. Suggested by Federico Beffa . * guix/monads.scm (bind-syntax): New macro. (with-monad): Use it instead of 'identifier-syntax'. * tests/monads.scm (">>= with more than two arguments"): New test. * doc/guix.texi (The Store Monad): Explain that there can be several MPROC. Add an example. --- doc/guix.texi | 23 ++++++++++++++++++----- guix/monads.scm | 27 +++++++++++++++++++++++++-- tests/monads.scm | 13 +++++++++++++ 3 files changed, 56 insertions(+), 7 deletions(-) (limited to 'guix/monads.scm') diff --git a/doc/guix.texi b/doc/guix.texi index bcfa52d5b1..85ccd4057e 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -2773,12 +2773,25 @@ in @var{monad}. Return a monadic value that encapsulates @var{val}. @end deffn -@deffn {Scheme Syntax} >>= @var{mval} @var{mproc} +@deffn {Scheme Syntax} >>= @var{mval} @var{mproc} ... @dfn{Bind} monadic value @var{mval}, passing its ``contents'' to monadic -procedure @var{mproc}@footnote{This operation is commonly referred to as -``bind'', but that name denotes an unrelated procedure in Guile. Thus -we use this somewhat cryptic symbol inherited from the Haskell -language.}. +procedures @var{mproc}@dots{}@footnote{This operation is commonly +referred to as ``bind'', but that name denotes an unrelated procedure in +Guile. Thus we use this somewhat cryptic symbol inherited from the +Haskell language.}. There can be one @var{mproc} or several of them, as +in this example: + +@example +(run-with-state + (with-monad %state-monad + (>>= (return 1) + (lambda (x) (return (+ 1 x))) + (lambda (x) (return (* 2 x))))) + 'some-state) + +@result{} 4 +@result{} some-state +@end example @end deffn @deffn {Scheme Syntax} mlet @var{monad} ((@var{var} @var{mval}) ...) @ diff --git a/guix/monads.scm b/guix/monads.scm index 4248525433..2196a9c991 100644 --- a/guix/monads.scm +++ b/guix/monads.scm @@ -112,6 +112,29 @@ (lambda (s) (syntax-violation 'return "return used outside of 'with-monad'" s))) +(define-syntax-rule (bind-syntax bind) + "Return a macro transformer that handles the expansion of '>>=' expressions +using BIND as the binary bind operator. + +This macro exists to allow the expansion of n-ary '>>=' expressions, even +though BIND is simply binary, as in: + + (with-monad %state-monad + (>>= (return 1) + (lift 1+ %state-monad) + (lift 1+ %state-monad))) +" + (lambda (stx) + (define (expand body) + (syntax-case body () + ((_ mval mproc) + #'(bind mval mproc)) + ((x mval mproc0 mprocs (... ...)) + (expand #'(>>= (>>= mval mproc0) + mprocs (... ...)))))) + + (expand stx))) + (define-syntax with-monad (lambda (s) "Evaluate BODY in the context of MONAD, and return its result." @@ -120,13 +143,13 @@ (eq? 'macro (syntax-local-binding #'monad)) ;; MONAD is a syntax transformer, so we can obtain the bind and return ;; methods by directly querying it. - #'(syntax-parameterize ((>>= (identifier-syntax (monad %bind))) + #'(syntax-parameterize ((>>= (bind-syntax (monad %bind))) (return (identifier-syntax (monad %return)))) body ...)) ((_ monad body ...) ;; MONAD refers to the record that represents the monad at run ;; time, so use the slow method. - #'(syntax-parameterize ((>>= (identifier-syntax + #'(syntax-parameterize ((>>= (bind-syntax (monad-bind monad))) (return (identifier-syntax (monad-return monad)))) diff --git a/tests/monads.scm b/tests/monads.scm index 5529a6188a..d3ef065f24 100644 --- a/tests/monads.scm +++ b/tests/monads.scm @@ -103,6 +103,19 @@ %monads %monad-run)) +(test-assert ">>= with more than two arguments" + (every (lambda (monad run) + (let ((1+ (lift1 1+ monad)) + (2* (lift1 (cut * 2 <>) monad))) + (with-monad monad + (let ((number (random 777))) + (= (run (>>= (return number) + 1+ 1+ 1+ + 2* 2* 2*)) + (* 8 (+ number 3))))))) + %monads + %monad-run)) + (test-assert "mbegin" (every (lambda (monad run) (with-monad monad -- cgit v1.2.3