summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--doc/guix.texi23
-rw-r--r--guix/monads.scm27
-rw-r--r--tests/monads.scm13
3 files changed, 56 insertions, 7 deletions
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 <monad> 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