~ruther/guix-local

4e190c2803be09ea7d500087cb1a2e3efeb27ab5 — Ludovic Courtès 11 years ago 81a9773
store: Make '%store-monad' an alias for '%state-monad'.

* guix/store.scm (define-alias): New macro.
  (%store-monad, store-return, store-bind): Define as aliases of the
  corresponding %STATE-MONAD part.
  (store-lift, text-file, interned-file): Return STORE as a second
  value.
  (run-with-store): Use 'run-with-state'.
* guix/packages.scm (set-guile-for-build, package-file): Return STORE as
  a second value.
* guix/monads.scm: Remove part of the module commentary.
3 files changed, 20 insertions(+), 31 deletions(-)

M guix/monads.scm
M guix/packages.scm
M guix/store.scm
M guix/monads.scm => guix/monads.scm +0 -4
@@ 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.

M guix/packages.scm => guix/packages.scm +5 -4
@@ 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))

M guix/store.scm => guix/store.scm +15 -23
@@ 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)))


;;;