Update Guile Knots
This commit is contained in:
parent
d6cfd780e8
commit
c886685e92
3 changed files with 9 additions and 48 deletions
|
|
@ -42,9 +42,9 @@
|
||||||
#:use-module (knots)
|
#:use-module (knots)
|
||||||
#:use-module (knots queue)
|
#:use-module (knots queue)
|
||||||
#:use-module (knots promise)
|
#:use-module (knots promise)
|
||||||
|
#:use-module (knots thread-pool)
|
||||||
#:use-module (knots parallelism)
|
#:use-module (knots parallelism)
|
||||||
#:use-module (knots resource-pool)
|
#:use-module (knots resource-pool)
|
||||||
#:use-module (knots worker-threads)
|
|
||||||
#:use-module (guix monads)
|
#:use-module (guix monads)
|
||||||
#:use-module (guix base32)
|
#:use-module (guix base32)
|
||||||
#:use-module (guix store)
|
#:use-module (guix store)
|
||||||
|
|
@ -2271,19 +2271,17 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
|
||||||
#:key skip-system-tests? parallelism
|
#:key skip-system-tests? parallelism
|
||||||
extra-inferior-environment-variables)
|
extra-inferior-environment-variables)
|
||||||
(define call-with-utility-thread
|
(define call-with-utility-thread
|
||||||
(let* ((worker-thread-set
|
(let* ((thread-pool
|
||||||
(call-with-default-io-waiters
|
(call-with-default-io-waiters
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(make-worker-thread-set
|
(make-thread-pool parallelism))))
|
||||||
(const '())
|
|
||||||
#:parallelism parallelism))))
|
|
||||||
(queued-channel
|
(queued-channel
|
||||||
;; There might be high demand for this, so order the requests
|
;; There might be high demand for this, so order the requests
|
||||||
(spawn-queueing-fiber
|
(spawn-queueing-fiber
|
||||||
(worker-thread-set-channel worker-thread-set))))
|
(thread-pool-channel thread-pool))))
|
||||||
(lambda (thunk)
|
(lambda (thunk)
|
||||||
(call-with-worker-thread
|
(call-with-thread
|
||||||
worker-thread-set
|
thread-pool
|
||||||
thunk
|
thunk
|
||||||
#:channel queued-channel))))
|
#:channel queued-channel))))
|
||||||
|
|
||||||
|
|
@ -2804,7 +2802,7 @@ SKIP LOCKED")
|
||||||
;; instances have the data updated.
|
;; instances have the data updated.
|
||||||
(fix-derivation-output-details-hash-encoding conn)
|
(fix-derivation-output-details-hash-encoding conn)
|
||||||
|
|
||||||
(%worker-thread-default-timeout #f)
|
(%thread-pool-default-timeout #f)
|
||||||
|
|
||||||
(resource-pool-retry-checkout-timeout 120)
|
(resource-pool-retry-checkout-timeout 120)
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -44,8 +44,6 @@
|
||||||
with-time-logging
|
with-time-logging
|
||||||
prevent-inlining-for-tests
|
prevent-inlining-for-tests
|
||||||
|
|
||||||
fiberize
|
|
||||||
|
|
||||||
chunk
|
chunk
|
||||||
chunk!
|
chunk!
|
||||||
chunk-for-each!
|
chunk-for-each!
|
||||||
|
|
@ -77,41 +75,6 @@
|
||||||
(define-syntax-rule (prevent-inlining-for-tests var)
|
(define-syntax-rule (prevent-inlining-for-tests var)
|
||||||
(set! var var))
|
(set! var var))
|
||||||
|
|
||||||
(define* (fiberize proc #:key (parallelism 1))
|
|
||||||
(let ((channel (make-channel)))
|
|
||||||
(for-each
|
|
||||||
(lambda _
|
|
||||||
(spawn-fiber
|
|
||||||
(lambda ()
|
|
||||||
(while #t
|
|
||||||
(let ((reply-channel args (car+cdr
|
|
||||||
(get-message channel))))
|
|
||||||
(put-message
|
|
||||||
reply-channel
|
|
||||||
(with-exception-handler
|
|
||||||
(lambda (exn)
|
|
||||||
(cons 'exception exn))
|
|
||||||
(lambda ()
|
|
||||||
(with-throw-handler #t
|
|
||||||
(lambda ()
|
|
||||||
(call-with-values
|
|
||||||
(lambda ()
|
|
||||||
(apply proc args))
|
|
||||||
(lambda vals
|
|
||||||
(cons 'result vals))))
|
|
||||||
(lambda _
|
|
||||||
(backtrace))))
|
|
||||||
#:unwind? #t)))))
|
|
||||||
#:parallel? #t))
|
|
||||||
(iota parallelism))
|
|
||||||
|
|
||||||
(lambda args
|
|
||||||
(let ((reply-channel (make-channel)))
|
|
||||||
(put-message channel (cons reply-channel args))
|
|
||||||
(match (get-message reply-channel)
|
|
||||||
(('result . vals) (apply values vals))
|
|
||||||
(('exception . exn) (raise-exception exn)))))))
|
|
||||||
|
|
||||||
(define (chunk lst max-length)
|
(define (chunk lst max-length)
|
||||||
(if (> (length lst)
|
(if (> (length lst)
|
||||||
max-length)
|
max-length)
|
||||||
|
|
|
||||||
|
|
@ -42,7 +42,7 @@
|
||||||
(srfi srfi-1))
|
(srfi srfi-1))
|
||||||
|
|
||||||
(define guile-knots
|
(define guile-knots
|
||||||
(let ((commit "6119ece5cba6cbdc638ccfb19aba52ea246dfe50")
|
(let ((commit "d572f591a3c136bfc7b23160e16381c92588f8d9")
|
||||||
(revision "1"))
|
(revision "1"))
|
||||||
(package
|
(package
|
||||||
(name "guile-knots")
|
(name "guile-knots")
|
||||||
|
|
@ -54,7 +54,7 @@
|
||||||
(commit commit)))
|
(commit commit)))
|
||||||
(sha256
|
(sha256
|
||||||
(base32
|
(base32
|
||||||
"1dn9mrla0inhmfcyl725jh6dfwrg6xd56jp7c3n3plmjz3knyfmj"))
|
"0g85frfniblxb2cl81fg558ic3cxvla7fvml08scjgbbxn8151gv"))
|
||||||
(file-name (string-append name "-" version "-checkout"))))
|
(file-name (string-append name "-" version "-checkout"))))
|
||||||
(build-system gnu-build-system)
|
(build-system gnu-build-system)
|
||||||
(native-inputs
|
(native-inputs
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue