Update Guile Knots

This commit is contained in:
Christopher Baines 2025-01-14 13:49:28 +00:00
parent d6cfd780e8
commit c886685e92
3 changed files with 9 additions and 48 deletions

View file

@ -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)

View file

@ -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)

View file

@ -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