[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
02/06: monads: Add 'mwhen' and 'munless'.
From: |
Ludovic Courtès |
Subject: |
02/06: monads: Add 'mwhen' and 'munless'. |
Date: |
Tue, 02 Dec 2014 15:51:50 +0000 |
civodul pushed a commit to branch master
in repository guix.
commit 21caa6deebee28f07467c5fd1dcd5b8997393ca4
Author: Ludovic Courtès <address@hidden>
Date: Tue Dec 2 10:11:11 2014 +0100
monads: Add 'mwhen' and 'munless'.
* guix/monads.scm (mbegin): Add special '%current-monad' syntactic
keyword.
(mwhen, munless): New macros.
---
.dir-locals.el | 2 ++
guix/monads.scm | 30 +++++++++++++++++++++++++++++-
2 files changed, 31 insertions(+), 1 deletions(-)
diff --git a/.dir-locals.el b/.dir-locals.el
index 106c35b..b099068 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -46,6 +46,8 @@
(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 'mwhen 'scheme-indent-function 1))
+ (eval . (put 'munless '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/guix/monads.scm b/guix/monads.scm
index b419ba0..52cb3f5 100644
--- a/guix/monads.scm
+++ b/guix/monads.scm
@@ -39,6 +39,8 @@
mlet
mlet*
mbegin
+ mwhen
+ munless
lift1 lift2 lift3 lift4 lift5 lift6 lift7 lift
listm
foldm
@@ -173,9 +175,15 @@ form is (VAR -> VAL), bind VAR to the non-monadic value
VAL in the same way as
body ...)))))))
(define-syntax mbegin
- (syntax-rules ()
+ (syntax-rules (%current-monad)
"Bind the given monadic expressions in sequence, returning the result of
the last one."
+ ((_ %current-monad mexp)
+ mexp)
+ ((_ %current-monad mexp rest ...)
+ (>>= mexp
+ (lambda (unused-value)
+ (mbegin %current-monad rest ...))))
((_ monad mexp)
(with-monad monad
mexp))
@@ -185,6 +193,26 @@ the last one."
(lambda (unused-value)
(mbegin monad rest ...)))))))
+(define-syntax mwhen
+ (syntax-rules ()
+ "When CONDITION is true, evaluate EXP0..EXP* as in an 'mbegin'. When
+CONDITION is false, return *unspecified* in the current monad."
+ ((_ condition exp0 exp* ...)
+ (if condition
+ (mbegin %current-monad
+ exp0 exp* ...)
+ (return *unspecified*)))))
+
+(define-syntax munless
+ (syntax-rules ()
+ "When CONDITION is false, evaluate EXP0..EXP* as in an 'mbegin'. When
+CONDITION is true, return *unspecified* in the current monad."
+ ((_ condition exp0 exp* ...)
+ (if condition
+ (return *unspecified*)
+ (mbegin %current-monad
+ exp0 exp* ...)))))
+
(define-syntax define-lift
(syntax-rules ()
((_ liftn (args ...))
- branch master updated (f4c4513 -> ec38437), Ludovic Courtès, 2014/12/02
- 05/06: derivations: Export 'derivation-builder'., Ludovic Courtès, 2014/12/02
- 01/06: guix system: Use 'mbegin' for 'install'., Ludovic Courtès, 2014/12/02
- 02/06: monads: Add 'mwhen' and 'munless'.,
Ludovic Courtès <=
- 06/06: packages: Use the target's system Guile when downloading patches., Ludovic Courtès, 2014/12/02
- 03/06: monads: Add 'lift0'., Ludovic Courtès, 2014/12/02
- 04/06: doc: Adjust misleading 'user-account' example., Ludovic Courtès, 2014/12/02