store: Avoid use of `set!'.
* guix/store.scm (operation): New macro. (define-operation): Define in terms of `operation'. (add-text-to-store): Define using `operation', and remove now unnecessary `set!'. (add-to-store): Likewise. (add-text-to-store/cached, add-to-store/cached): Remove.
This commit is contained in:
parent
82c38fe64c
commit
fd060fd30d
|
@ -438,10 +438,11 @@ again until #t is returned or an error is raised."
|
||||||
(let loop ((done? (process-stderr server)))
|
(let loop ((done? (process-stderr server)))
|
||||||
(or done? (process-stderr server)))))
|
(or done? (process-stderr server)))))
|
||||||
|
|
||||||
(define-syntax define-operation
|
(define-syntax operation
|
||||||
(syntax-rules ()
|
(syntax-rules ()
|
||||||
|
"Define a client-side RPC stub for the given operation."
|
||||||
((_ (name (type arg) ...) docstring return ...)
|
((_ (name (type arg) ...) docstring return ...)
|
||||||
(define (name server arg ...)
|
(lambda (server arg ...)
|
||||||
docstring
|
docstring
|
||||||
(let ((s (nix-server-socket server)))
|
(let ((s (nix-server-socket server)))
|
||||||
(write-int (operation-id name) s)
|
(write-int (operation-id name) s)
|
||||||
|
@ -452,6 +453,11 @@ again until #t is returned or an error is raised."
|
||||||
(or done? (loop (process-stderr server))))
|
(or done? (loop (process-stderr server))))
|
||||||
(values (read-arg return s) ...))))))
|
(values (read-arg return s) ...))))))
|
||||||
|
|
||||||
|
(define-syntax-rule (define-operation (name args ...)
|
||||||
|
docstring return ...)
|
||||||
|
(define name
|
||||||
|
(operation (name args ...) docstring return ...)))
|
||||||
|
|
||||||
(define-operation (valid-path? (string path))
|
(define-operation (valid-path? (string path))
|
||||||
"Return #t when PATH is a valid store path."
|
"Return #t when PATH is a valid store path."
|
||||||
boolean)
|
boolean)
|
||||||
|
@ -460,15 +466,14 @@ again until #t is returned or an error is raised."
|
||||||
"Return the SHA256 hash of PATH as a bytevector."
|
"Return the SHA256 hash of PATH as a bytevector."
|
||||||
base16)
|
base16)
|
||||||
|
|
||||||
(define-operation (add-text-to-store (string name) (string text)
|
(define add-text-to-store
|
||||||
(string-list references))
|
;; A memoizing version of `add-to-store', to avoid repeated RPCs with
|
||||||
"Add TEXT under file NAME in the store, and return its store path.
|
;; the very same arguments during a given session.
|
||||||
REFERENCES is the list of store paths referred to by the resulting store
|
(let ((add-text-to-store
|
||||||
path."
|
(operation (add-text-to-store (string name) (string text)
|
||||||
store-path)
|
(string-list references))
|
||||||
|
#f
|
||||||
(define add-text-to-store/cached
|
store-path)))
|
||||||
(let ((add-text-to-store add-text-to-store))
|
|
||||||
(lambda (server name text references)
|
(lambda (server name text references)
|
||||||
"Add TEXT under file NAME in the store, and return its store path.
|
"Add TEXT under file NAME in the store, and return its store path.
|
||||||
REFERENCES is the list of store paths referred to by the resulting store
|
REFERENCES is the list of store paths referred to by the resulting store
|
||||||
|
@ -476,27 +481,21 @@ path."
|
||||||
(let ((args `(,name ,text ,references))
|
(let ((args `(,name ,text ,references))
|
||||||
(cache (nix-server-add-text-to-store-cache server)))
|
(cache (nix-server-add-text-to-store-cache server)))
|
||||||
(or (hash-ref cache args)
|
(or (hash-ref cache args)
|
||||||
(let ((path (add-text-to-store server name text
|
(let ((path (add-text-to-store server name text references)))
|
||||||
references)))
|
|
||||||
(hash-set! cache args path)
|
(hash-set! cache args path)
|
||||||
path))))))
|
path))))))
|
||||||
|
|
||||||
(set! add-text-to-store add-text-to-store/cached)
|
(define add-to-store
|
||||||
|
|
||||||
(define-operation (add-to-store (string basename)
|
|
||||||
(boolean fixed?) ; obsolete, must be #t
|
|
||||||
(boolean recursive?)
|
|
||||||
(string hash-algo)
|
|
||||||
(file file-name))
|
|
||||||
"Add the contents of FILE-NAME under BASENAME to the store. Note that
|
|
||||||
FIXED? is for backward compatibility with old Nix versions and must be #t."
|
|
||||||
store-path)
|
|
||||||
|
|
||||||
(define add-to-store/cached
|
|
||||||
;; A memoizing version of `add-to-store'. This is important because
|
;; A memoizing version of `add-to-store'. This is important because
|
||||||
;; `add-to-store' leads to huge data transfers to the server, and
|
;; `add-to-store' leads to huge data transfers to the server, and
|
||||||
;; because it's often called many times with the very same argument.
|
;; because it's often called many times with the very same argument.
|
||||||
(let ((add-to-store add-to-store))
|
(let ((add-to-store (operation (add-to-store (string basename)
|
||||||
|
(boolean fixed?) ; obsolete, must be #t
|
||||||
|
(boolean recursive?)
|
||||||
|
(string hash-algo)
|
||||||
|
(file file-name))
|
||||||
|
#f
|
||||||
|
store-path)))
|
||||||
(lambda (server basename fixed? recursive? hash-algo file-name)
|
(lambda (server basename fixed? recursive? hash-algo file-name)
|
||||||
"Add the contents of FILE-NAME under BASENAME to the store. Note that
|
"Add the contents of FILE-NAME under BASENAME to the store. Note that
|
||||||
FIXED? is for backward compatibility with old Nix versions and must be #t."
|
FIXED? is for backward compatibility with old Nix versions and must be #t."
|
||||||
|
@ -509,8 +508,6 @@ FIXED? is for backward compatibility with old Nix versions and must be #t."
|
||||||
(hash-set! cache args path)
|
(hash-set! cache args path)
|
||||||
path))))))
|
path))))))
|
||||||
|
|
||||||
(set! add-to-store add-to-store/cached)
|
|
||||||
|
|
||||||
(define-operation (build-derivations (string-list derivations))
|
(define-operation (build-derivations (string-list derivations))
|
||||||
"Build DERIVATIONS, and return when the worker is done building them.
|
"Build DERIVATIONS, and return when the worker is done building them.
|
||||||
Return #t on success."
|
Return #t on success."
|
||||||
|
|
Loading…
Reference in New Issue