diff options
| -rw-r--r-- | guix/monads.scm | 4 | ||||
| -rw-r--r-- | guix/packages.scm | 9 | ||||
| -rw-r--r-- | guix/store.scm | 38 |
3 files changed, 20 insertions, 31 deletions
diff --git a/guix/monads.scm b/guix/monads.scm index f97f4add5d..62397dae7c 100644 --- a/guix/monads.scm +++ b/guix/monads.scm @@ -67,10 +67,6 @@ ;;; "Monadic Programming in Scheme" (see ;;; <http://okmij.org/ftp/Scheme/monad-in-Scheme.html>). ;;; -;;; The store monad allows us to (1) build sequences of operations in the -;;; store, and (2) make the store an implicit part of the execution context, -;;; rather than a parameter of every single function. -;;; ;;; Code: ;; Record type for monads manipulated at run time. diff --git a/guix/packages.scm b/guix/packages.scm index db14f9e0b8..de87681fcd 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -898,7 +898,7 @@ symbolic output name, such as \"out\". Note that this procedure calls code of derivations to GUILE, a package object." (lambda (store) (let ((guile (package-derivation store guile))) - (%guile-for-build guile)))) + (values (%guile-for-build guile) store)))) (define* (package-file package #:optional file @@ -917,9 +917,10 @@ cross-compilation target triplet." (let* ((system (or system (%current-system))) (drv (compute-derivation store package system)) (out (derivation->output-path drv output))) - (if file - (string-append out "/" file) - out)))) + (values (if file + (string-append out "/" file) + out) + store)))) (define package->derivation (store-lift package-derivation)) diff --git a/guix/store.scm b/guix/store.scm index 6fd34bc643..c3a1c57943 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -852,25 +852,15 @@ be used internally by the daemon's build hook." ;;; Store monad. ;;; -;; return:: a -> StoreM a -(define-inlinable (store-return value) - "Return VALUE from a monadic function." - ;; The monadic value is just this. - (lambda (store) - value)) - -;; >>=:: StoreM a -> (a -> StoreM b) -> StoreM b -(define-inlinable (store-bind mvalue mproc) - "Bind MVALUE in MPROC." - (lambda (store) - (let* ((value (mvalue store)) - (mresult (mproc value))) - (mresult store)))) +(define-syntax-rule (define-alias new old) + (define-syntax new (identifier-syntax old))) -;; This is essentially a state monad -(define-monad %store-monad - (bind store-bind) - (return store-return)) +;; The store monad allows us to (1) build sequences of operations in the +;; store, and (2) make the store an implicit part of the execution context, +;; rather than a parameter of every single function. +(define-alias %store-monad %state-monad) +(define-alias store-return state-return) +(define-alias store-bind state-bind) (define (store-lift proc) "Lift PROC, a procedure whose first argument is a connection to the store, @@ -878,7 +868,7 @@ in the store monad." (define result (lambda args (lambda (store) - (apply proc store args)))) + (values (apply proc store args) store)))) (set-object-property! result 'documentation (procedure-property proc 'documentation)) @@ -898,7 +888,8 @@ taking the store as its first argument." "Return as a monadic value the absolute file name in the store of the file containing TEXT, a string." (lambda (store) - (add-text-to-store store name text '()))) + (values (add-text-to-store store name text '()) + store))) (define* (interned-file file #:optional name #:key (recursive? #t)) @@ -909,8 +900,9 @@ When RECURSIVE? is true, the contents of FILE are added recursively; if FILE designates a flat file and RECURSIVE? is true, its contents are added, and its permission bits are kept." (lambda (store) - (add-to-store store (or name (basename file)) - recursive? "sha256" file))) + (values (add-to-store store (or name (basename file)) + recursive? "sha256" file) + store))) (define %guile-for-build ;; The derivation of the Guile to be used within the build environment, @@ -925,7 +917,7 @@ permission bits are kept." connection." (parameterize ((%guile-for-build guile-for-build) (%current-system system)) - (mval store))) + (run-with-state mval store))) ;;; |