diff options
| -rw-r--r-- | .dir-locals.el | 1 | ||||
| -rw-r--r-- | doc/guix.texi | 9 | ||||
| -rw-r--r-- | guix/monads.scm | 14 | ||||
| -rw-r--r-- | tests/monads.scm | 17 |
4 files changed, 40 insertions, 1 deletions
diff --git a/.dir-locals.el b/.dir-locals.el index edc964123f..6cd55e7788 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -38,6 +38,7 @@ (eval . (put 'syntax-parameterize 'scheme-indent-function 1)) (eval . (put 'with-monad 'scheme-indent-function 1)) + (eval . (put 'mbegin 'scheme-indent-function 1)) (eval . (put 'mlet* 'scheme-indent-function 2)) (eval . (put 'mlet 'scheme-indent-function 2)) (eval . (put 'run-with-store 'scheme-indent-function 1)) diff --git a/doc/guix.texi b/doc/guix.texi index ed2b81ba33..c9760f5f60 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -2061,6 +2061,15 @@ Bind the variables @var{var} to the monadic values @var{mval} in (@pxref{Local Bindings,,, guile, GNU Guile Reference Manual}). @end deffn +@deffn {Scheme System} mbegin @var{monad} @var{mexp} ... +Bind @var{mexp} and the following monadic expressions in sequence, +returning the result of the last expression. + +This is akin to @code{mlet}, except that the return values of the +monadic expressions are ignored. In that sense, it is analogous to +@code{begin}, but applied to monadic expressions. +@end deffn + The interface to the store monad provided by @code{(guix monads)} is as follows. diff --git a/guix/monads.scm b/guix/monads.scm index 2ab3fb94f0..d9580a7f8e 100644 --- a/guix/monads.scm +++ b/guix/monads.scm @@ -38,6 +38,7 @@ with-monad mlet mlet* + mbegin lift1 lift2 lift3 lift4 lift5 lift6 lift7 lift listm foldm @@ -171,6 +172,19 @@ form is (VAR -> VAL), bind VAR to the non-monadic value VAL in the same way as (let ((var temp) ...) body ...))))))) +(define-syntax mbegin + (syntax-rules () + "Bind the given monadic expressions in sequence, returning the result of +the last one." + ((_ monad mexp) + (with-monad monad + mexp)) + ((_ monad mexp rest ...) + (with-monad monad + (>>= mexp + (lambda (unused-value) + (mbegin monad rest ...))))))) + (define-syntax define-lift (syntax-rules () ((_ liftn (args ...)) diff --git a/tests/monads.scm b/tests/monads.scm index 5514c8386c..6e3dd00f72 100644 --- a/tests/monads.scm +++ b/tests/monads.scm @@ -32,7 +32,7 @@ #:use-module (srfi srfi-26) #:use-module (srfi srfi-64)) -;; Test the (guix store) module. +;; Test the (guix monads) module. (define %store (open-connection-for-tests)) @@ -99,6 +99,21 @@ %monads %monad-run)) +(test-assert "mbegin" + (every (lambda (monad run) + (with-monad monad + (let* ((been-there? #f) + (number (mbegin monad + (return 1) + (begin + (set! been-there? #t) + (return 2)) + (return 3)))) + (and (= (run number) 3) + been-there?)))) + %monads + %monad-run)) + (test-assert "mlet* + text-file + package-file" (run-with-store %store (mlet* %store-monad ((guile (package-file %bootstrap-guile "bin/guile")) |