diff --git a/guix/monads.scm b/guix/monads.scm index f97f4add5d3aa715747fd149e156e445506bc7fa..62397dae7c36f06b2966f6a1ad2443f99b56a858 100644 --- a/guix/monads.scm +++ b/guix/monads.scm @@ -67,10 +67,6 @@ (define-module (guix monads) ;;; "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 db14f9e0b8e0ed8c69e070256046b78d78f42339..de87681fcdae99ed997d05a575b1139acb8a3c35 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -898,7 +898,7 @@ (define (set-guile-for-build guile) 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 @@ (define compute-derivation (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 6fd34bc64351d9dcaf06050ec2ba72edfbda50fa..c3a1c5794300f782969ea293ca174d8c0061c8a5 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -852,25 +852,15 @@ (define* (register-path path ;;; 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 @@ (define (store-lift proc) (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 @@ (define* (text-file name text) "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 @@ (define* (interned-file file #:optional name 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 @@ (define* (run-with-store store mval connection." (parameterize ((%guile-for-build guile-for-build) (%current-system system)) - (mval store))) + (run-with-state mval store))) ;;;