Re: packaging Bootstrap for Cuirass' web interface

[ludo@gnu.org (Ludovic Courtès)]

Hi Clément!

Clément Lassieur <clement@lassieur.org> skribis:

> The bug is here:
>
> (define (make-critical-section . args)
>   "Return a channel used to implement a critical section.  That channel can
> then be passed to 'join-critical-section', which will ensure sequential
> ordering.  ARGS are the arguments of the critical section.
>
> Critical sections are implemented by passing the procedure to execute to a
> dedicated fiber."
>   (let ((channel (make-channel)))
>     (spawn-fiber
>      (lambda ()
>        (let loop ()
>          (match (get-message channel)
>            ((? procedure? proc)
>             (put-message channel (apply proc args))))
>          (loop))))
>     channel))
>
> (define (call-with-critical-section channel proc)
>   "Call PROC in the critical section corresponding to CHANNEL.  Return the
> result of PROC."
>   (put-message channel proc)
>   (get-message channel))
>
>
> Say I have 2 concurrent fibers (F1 and F2) wanting to serialize
> messages through the critical section.
>
> - F1-PUT-MESSAGE puts F1-MESSAGE to CRITICAL-SECTION
> - CRITICAL-SECTION gets F1-MESSAGE, which unblocks F1-PUT-MESSAGE
> - F1-GET-MESSAGE is called and blocks
>
> - F2-PUT-MESSAGE puts F2-MESSAGE, and the only receiver available
>   is... F1-GET-MESSAGE, because CRITICAL-SECTION is busy
> - F2-GET-MESSAGE is called and block
>
> - CRITICAL-SECTION is done handling F1-MESSAGE, and put
>   F1-MESSAGE-MODIFIED to...  F2-GET-MESSAGE.
>
> F2-MESSAGE is a procedure, whereas F1-MESSAGE-MODIFIED is a list, which
> causes the (map f F2-MESSAGE) error.

D’oh!  Good catch!

> A solution could be to use two channels, in and out:
>
> (define (make-critical-section . args)
>   "Return a pair of channels used to implement a critical section.  It can
> then be passed to 'with-critical-section', which will ensure sequential
> ordering.  ARGS are the arguments of the critical section.
>
> Critical sections are implemented by passing the procedure to execute to a
> dedicated fiber."
>   (let ((channel-in (make-channel))
>         (channel-out (make-channel)))
>     (spawn-fiber
>      (lambda ()
>        (let loop ()
>          (match (get-message channel-in)
>            ((? procedure? proc)
>             (put-message channel-out (apply proc args))))
>          (loop))))
>     (cons channel-in channel-out)))
>
> (define (call-with-critical-section channel proc)
>   "Call PROC in the critical section corresponding to CHANNEL.  Return the
> result of PROC."
>   (match channel
>     ((channel-out . channel-in)
>      (begin
>        (put-message channel-out proc)
>        (get-message channel-in)))))
>
> WDYT?

Or maybe like this:

(define (make-critical-section . args)
  "Return a channel used to implement a critical section.  That channel can
then be passed to 'join-critical-section', which will ensure sequential
ordering.  ARGS are the arguments of the critical section.

Critical sections are implemented by passing the procedure to execute to a
dedicated fiber."
  (let ((channel (make-channel)))
    (spawn-fiber
     (lambda ()
       (let loop ()
         (match (get-message channel)
           (((? channel? reply) . (? procedure? proc))
            (put-message reply (apply proc args))))
         (loop))))
    channel))

(define (call-with-critical-section channel proc)
  "Call PROC in the critical section corresponding to CHANNEL.  Return the
result of PROC."
  (let ((reply (make-channel)))
    (put-message channel (cons reply proc))
    (get-message reply)))

That makes it clear that the reply channel is used only by the calling
fiber.

WDYT?

Thanks for debugging this!

Ludo’.