diff options
| -rw-r--r-- | doc/guix.texi | 23 | ||||
| -rw-r--r-- | guix/monads.scm | 27 | ||||
| -rw-r--r-- | tests/monads.scm | 13 |
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 |