me
/
guix
Archived
1
0
Fork 0
Code

inferior: Move initialization bits away from 'inferior-eval-with-store'. 

* guix/inferior.scm (port->inferior): In the inferior, define
'cached-store-connection', 'store-protocol-error?', and
'store-protocol-error-message'.
(inferior-eval-with-store): Use them.
Ludovic Courtès 2022-01-27 09:20:40 +01:00
parent c71910a095
commit e778910bdf
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 42 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

76
guix/inferior.scm
View File

@ -225,7 +225,39 @@ inferior."
(inferior-eval '(use-modules (srfi srfi-34)) result)
(inferior-eval '(define %package-table (make-hash-table))
result)
(inferior-eval '(define %store-table (make-hash-table))
(inferior-eval '(begin
(define %store-table (make-hash-table))
(define (cached-store-connection store-id version)
;; Cache connections to store ID. This ensures that
;; the caches within <store-connection> (in
;; particular the object cache) are reused across
;; calls to 'inferior-eval-with-store', which makes a
;; significant difference when it is called
;; repeatedly.
(or (hashv-ref %store-table store-id)
;; 'port->connection' appeared in June 2018 and
;; we can hardly emulate it on older versions.
;; Thus fall back to 'open-connection', at the
;; risk of talking to the wrong daemon or having
;; our build result reclaimed (XXX).
(let ((store (if (defined? 'port->connection)
(port->connection %bridge-socket
#:version
version)
(open-connection))))
(hashv-set! %store-table store-id store)
store))))
result)
(inferior-eval '(begin
(define store-protocol-error?
(if (defined? 'store-protocol-error?)
store-protocol-error?
nix-protocol-error?))
(define store-protocol-error-message
(if (defined? 'store-protocol-error-message)
store-protocol-error-message
nix-protocol-error-message)))
result)
result))
(_
@ -627,39 +659,15 @@ thus be the code of a one-argument procedure that accepts a store."
(store-id (object-address (store-connection-socket store))))
(ensure-store-bridge! inferior)
(send-inferior-request
`(let ((proc ,code)
(error? (if (defined? 'store-protocol-error?)
store-protocol-error?
nix-protocol-error?))
(error-message (if (defined? 'store-protocol-error-message)
store-protocol-error-message
nix-protocol-error-message)))
;; Cache connections to STORE-ID. This ensures that the caches within
;; <store-connection> (in particular the object cache) are reused
;; across calls to 'inferior-eval-with-store', which makes a
;; significant difference when it is called repeatedly.
(let ((store (or (hashv-ref %store-table ,store-id)
;; 'port->connection' appeared in June 2018 and we
;; can hardly emulate it on older versions. Thus
;; fall back to 'open-connection', at the risk of
;; talking to the wrong daemon or having our build
;; result reclaimed (XXX).
(let ((store (if (defined? 'port->connection)
(port->connection %bridge-socket
#:version ,proto)
(open-connection))))
(hashv-set! %store-table ,store-id store)
store))))
;; Serialize '&store-protocol-error' conditions. The
;; exception serialization mechanism that
;; 'read-repl-response' expects is unsuitable for SRFI-35
;; error conditions, hence this special case.
(guard (c ((error? c)
`(store-protocol-error ,(error-message c))))
`(result ,(proc store)))))
`(let ((proc ,code)
(store (cached-store-connection ,store-id ,proto)))
;; Serialize '&store-protocol-error' conditions. The exception
;; serialization mechanism that 'read-repl-response' expects is
;; unsuitable for SRFI-35 error conditions, hence this special case.
(guard (c ((store-protocol-error? c)
`(store-protocol-error
,(store-protocol-error-message c))))
`(result ,(proc store))))
inferior)
(proxy inferior store)