From 1f8966670071eb0685a7dcee2ee3c70e8fecb051 Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Sat, 23 Mar 2024 10:26:14 +0000 Subject: Remove with-fibers-timeout As it's unused. --- nar-herder/utils.scm | 38 -------------------------------------- 1 file changed, 38 deletions(-) diff --git a/nar-herder/utils.scm b/nar-herder/utils.scm index 26d10bc..4755d33 100644 --- a/nar-herder/utils.scm +++ b/nar-herder/utils.scm @@ -66,7 +66,6 @@ run-server/patched timeout-error? - with-fibers-timeout port-read-timeout-error? port-write-timeout-error? @@ -654,43 +653,6 @@ If already in the worker thread, call PROC immediately." (sigaction SIGPIPE SIG_IGN) (spawn-fiber (lambda () (socket-loop socket handler)))))) -(define &timeout - (make-exception-type '&timeout - &external-error - '(thunk))) - -(define make-timeout-error - (record-constructor &timeout)) - -(define timeout-error? - (record-predicate &timeout)) - -(define* (with-fibers-timeout thunk #:key timeout) - ;; Maybe there's a way of doing this directly with operations, and - ;; without the channel and fiber? - (let ((channel (make-channel))) - (spawn-fiber - (lambda () - (call-with-values - (thunk) - (lambda vals - (perform-operation - (choice-operation - (put-operation channel vals) - ;; I don't know if this is useful to avoid just forever - ;; waiting to write to channel, but maybe it is - (sleep-operation timeout))))))) - (perform-operation - (choice-operation - (wrap-operation - (get-operation channel) - apply) - (wrap-operation - (sleep-operation timeout) - (lambda () - (raise-exception - (make-timeout-error thunk)))))))) - ;; These procedure are subject to spurious wakeups. (define (readable? port) -- cgit v1.2.3