Implementing thread-operation

[abcdw]

I was working on guile-nrepl (asyncronous network repl for guile) and stumbled upon an issue: we can't do [interruptable] eval inside fiber because it blocks the whole thread until evaluation is complete. So we need to do eval in a separate thread and thus we need to interact with this threads from fibers somehow.

I hacked together an implementation of thread-operation and it works great, but because of my lack of knowledge of fibers internals the implementation consumes unreasonable amounts of memory and probably contains some other flaws. Any ideas on a proper implementation of this operation?

(use-modules (fibers))
(use-modules (fibers channels))
(use-modules (fibers operations))
(use-modules (fibers timers))
(use-modules (fibers conditions))
(use-modules (fibers scheduler))
(use-modules (ice-9 threads))
(use-modules (ice-9 match))
(use-modules (ice-9 atomic))

(define (thread-operation th)
  "Make an operation that will succeed when the thread is
exited.  The operation will succeed with the value returned by thread."
  (define (wrap-fn)
    (join-thread th))
  (define (try-fn) (and (thread-exited? th) values))
  (define (block-fn flag sched resume)
    (define (commit)
       (match (atomic-box-compare-and-swap! flag 'W 'S)
         ('W (resume values))
         ('C (commit))
         ('S #f)))
    (when sched
      (schedule-task
       sched
       (lambda ()
         (perform-operation (thread-operation th))
         (commit)))))
  (make-base-operation wrap-fn try-fn block-fn))

(define (async-program)
  (let ((th (call-with-new-thread (lambda () (sleep 7) 'thread-value)))
        (ch (make-channel))
        (cnd (make-condition)))
    (spawn-fiber
     (lambda ()
       (put-message
        ch
        (perform-operation
         (choice-operation
          (wrap-operation
           (wait-operation cnd)
           (lambda ()
             (format #t "condition signal recieved\n")
             'recieved-cnd-signal))
          (wrap-operation
           (thread-operation th)
           (lambda (. v)
             (format #t "thread finished: ~a\n" v)
             'finished-long-operation)))))))
     (spawn-fiber
      (lambda ()
        (sleep 5)
        (format #t "sending signal\n")
        (signal-condition! cnd)))
     (get-message ch)))

(format #t "return value: ~a\n"
        (run-fibers async-program #:drain? #t))

[emixa-d]

Have you considered not using eval but rather first compile the input, then load it in memory (as a thunk) and lastly invoke the thunk?

IIUC, the first step is interruptible because it is fully implemented in Scheme.
The third step also only involves Scheme so it should be fine too. The second step doesn't benefit from interruption I'd think.

I think that's what the standard Guile REPL does already (maybe 'eval' too)?
If you do all that, Fibers should be able to do the context switching (if that's what you meant by blocking).

That said, a glaring omission is that you don't appear to have implemented interruption anywhere -- I don't see thread-terminate! anywhere, so no control-C equivalent.

Also later more about the operation itself

[emixa-d]

  (define (block-fn flag sched resume)
    (define (commit)
       (match (atomic-box-compare-and-swap! flag 'W 'S)
         ('W (resume values))
         ('C (commit))
         ('S #f)))
    (when sched
      (schedule-task
       sched
       (lambda ()
         (perform-operation (thread-operation th))
         (commit)))))

To my understanding, what 'block-fn' needs to do is to ‘asynchronuously’ wait for ‘try-fn’ to potentially succeed (i.e., it needs to in some way do something like join-thread).

However, I don't see join-thread anywhere.

IIUC, in practical terms, that means Fibers might wait forever as it is never notified that the thread-operation might succeed.

[emixa-d]

Also, 'thread-operation' -> 'thread-join-operation' is a clearer name.

[emixa-d]

    (when sched
      (schedule-task
       sched
       (lambda ()
         (perform-operation (thread-operation th))
         (commit)))))

You are busy-looping here, which is bad for efficiency (CPU time/energy).
You are also forgetting to implement the (not sched) case (i.e., just join-thread, I suppose).

I think I see what causes high-memory usage: you are implementing a (busy) loop by a non-tail recursion!

I think most problems will go away by, for both sched and (not sched), doing something like 'join-thread'.

But important: make sure it's ‘asynchronous’, because another operation (when using choice-operation) might complete earlier! I don't know any ‘concurrent thread waiting’ procedures, though.

[emixa-d]

Have you considered not implementing thread-operation and instead make a condition variable and wrap the thunk of the new thread to signal the condition variable (upon success or otherwise, you can use dynamic-wind's out guard for this)?

Less satisfying and less general perhaps, but much more simple and seems to suit your needs.

[emixa-d]

and stumbled upon an issue: we can't do [interruptable] eval inside fiber

I don't see any fundamental problems with implementing interruption of individual fibers -- it seems a matter of $LOTS_OF_WORK. Needs modifications to Fibers itself though.

[emixa-d]

          (wrap-operation
           (wait-operation cnd)
           (lambda ()
             (format #t "condition signal recieved\n")
             'recieved-cnd-signal))

     (spawn-fiber
      (lambda ()
        (sleep 5)
        (format #t "sending signal\n")
        (signal-condition! cnd)))

You are reimplementing 'sleep-operation' + '(wrap-operation ... (lambda () log stuff))' here.

[abcdw]

Have you considered not implementing thread-operation and instead make a condition variable and wrap the > thunk of the new thread to signal the condition variable (upon success or otherwise, you can use dynamic-> wind's out guard for this)?

Less satisfying and less general perhaps, but much more simple and seems to suit your needs.

@emixa-d I didn't think about using condition variables outside of the fibers, that's actually a very good idea, thank you!

Will make something like this:

(use-modules (fibers))
(use-modules (fibers channels))
(use-modules (fibers operations))
(use-modules (fibers timers))
(use-modules (fibers conditions))
(use-modules (fibers scheduler))
(use-modules (ice-9 threads))
(use-modules (ice-9 match))
(use-modules (ice-9 atomic))
(use-modules (ice-9 exceptions))

(define (eval-thread code finished-cnd)
  (call-with-new-thread
   (lambda ()
     (dynamic-wind
       (lambda () 'hi)
       (lambda ()
         (let ((res (with-exception-handler
                        (lambda (exception)
                          `(exception-value ,exception))
                      (lambda ()
                        `(eval-value . ,(primitive-eval code)) )
                      #:unwind? #t)))
           res))
       (lambda () (signal-condition! finished-cnd))))))

(define (async-program)
  (let ((ch (make-channel))
        (cnd (make-condition)))
    (spawn-fiber
     (lambda ()
       (let* ((eval-cnd (make-condition))
              (eval-th (eval-thread '(begin (sleep 4) 'some-value) eval-cnd)))
         (put-message
          ch
          (perform-operation
           (choice-operation
            (wrap-operation
             (wait-operation cnd)
             (lambda ()
               (cancel-thread eval-th)
               `(inerrupted . #t)))
            (wrap-operation
             (wait-operation eval-cnd)
             (lambda (. v)
               `(thread-value . ,(join-thread eval-th))))))))))

    ;; sending eval interrupt
    (spawn-fiber
     (lambda ()
       (sleep 5)
       (format #t "sending signal\n")
       (signal-condition! cnd)))
     (get-message ch)))

(format #t "return value: ~a\n"
        (run-fibers async-program))

And thank you for other comments too, I found them valuable. I have enough to keep working, will share the results later, probably on guile-users mailing list.

[emixa-d]

         (let ((res (with-exception-handler
                        (lambda (exception)
                          `(exception-value ,exception))
                      (lambda ()
                        `(eval-value . ,(primitive-eval code)) )
                      #:unwind? #t)))

In a REPL, it would be useful to include a backtrace and not only the exception. display-backtrace / backtrace + call-with-output-string may be useful.

[abcdw]

On 2023-09-02 05:47, emixa-d wrote: ``` (let ((res (with-exception-handler (lambda (exception) `(exception-value ,exception)) (lambda () `(eval-value . ,(primitive-eval code)) ) #:unwind? #t))) ``` In a REPL, it would be useful to include a backtrace and not only the exception. display-backtrace / backtrace + call-with-output-string may be useful.

Thank you for the tip, I definitely think about it, and will add it later. If you want you can follow implementation progress here: https://git.sr.ht/~abcdw/guile-nrepl At the moment there is no separate mailing list for the project, so rde-devel can be used.

…

-- Best regards, Andrew Tropin