me
/
guix
Archived
1
0
Fork 0

monads: Add 'mparameterize'.

* etc/system-tests.scm (mparameterize): Move to...
* guix/monads.scm (mparameterize): ... here.
* tests/monads.scm ("mparameterize"): New test.
* .dir-locals.el (c-mode): Add it.
master
Ludovic Courtès 2022-07-10 12:39:44 +02:00
parent bf0a646a5b
commit 9fdc4b6c28
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
4 changed files with 32 additions and 17 deletions

View File

@ -118,6 +118,7 @@
(eval . (put 'munless 'scheme-indent-function 1))
(eval . (put 'mlet* 'scheme-indent-function 2))
(eval . (put 'mlet 'scheme-indent-function 2))
(eval . (put 'mparameterize 'scheme-indent-function 2))
(eval . (put 'run-with-store 'scheme-indent-function 1))
(eval . (put 'run-with-state 'scheme-indent-function 1))
(eval . (put 'wrap-program 'scheme-indent-function 1))

View File

@ -43,21 +43,6 @@ determined."
(repository-close! repository))
#f))))
(define-syntax mparameterize
(syntax-rules ()
"This form implements dynamic scoping, similar to 'parameterize', but in a
monadic context."
((_ monad ((parameter value) rest ...) body ...)
(let ((old-value (parameter)))
(mbegin monad
;; XXX: Non-local exits are not correctly handled.
(return (parameter value))
(mlet monad ((result (mparameterize monad (rest ...) body ...)))
(parameter old-value)
(return result)))))
((_ monad () body ...)
(mbegin monad body ...))))
(define (tests-for-current-guix source commit)
"Return a list of tests for perform, using Guix built from SOURCE, a channel
instance."

View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014, 2015, 2017, 2022 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -40,6 +40,7 @@
mbegin
mwhen
munless
mparameterize
lift0 lift1 lift2 lift3 lift4 lift5 lift6 lift7 lift
listm
foldm
@ -398,6 +399,21 @@ expression."
(mbegin %current-monad
mexp0 mexp* ...)))))
(define-syntax mparameterize
(syntax-rules ()
"This form implements dynamic scoping, similar to 'parameterize', but in a
monadic context."
((_ monad ((parameter value) rest ...) body ...)
(let ((old-value (parameter)))
(mbegin monad
;; XXX: Non-local exits are not correctly handled.
(return (parameter value))
(mlet monad ((result (mparameterize monad (rest ...) body ...)))
(parameter old-value)
(return result)))))
((_ monad () body ...)
(mbegin monad body ...))))
(define-syntax define-lift
(syntax-rules ()
((_ liftn (args ...))

View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014, 2015, 2016, 2022 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -137,6 +137,19 @@
%monads
%monad-run))
(test-assert "mparameterize"
(let ((parameter (make-parameter 'outside)))
(every (lambda (monad run)
(equal?
(run (mlet monad ((outer (return (parameter)))
(inner
(mparameterize monad ((parameter 'inside))
(return (parameter)))))
(return (list outer inner (parameter)))))
'(outside inside outside)))
%monads
%monad-run)))
(test-assert "mlet* + text-file + package-file"
(run-with-store %store
(mlet* %store-monad ((guile (package-file %bootstrap-guile "bin/guile"))