Re: guile fibers - looking for adivce

[Jan Wielkiewicz]

Hello,

Dnia 2020-09-07, o godz. 17:25:38
Aleix Conchillo Flaqué <aconchillo@gmail.com> napisał(a):

> Hi Jan,
> 
> To be honest, I've never used GOOPS so things might be a bit more
> complicated there, I don't know. But it sounds like you have two
> options:
> 
> - Create a fiber with the object and pass data from the object using
> channels to other fibers. Then return data to the main fiber (or the
> fiber that has the object) through a channel and update your object.
> - Make the object global and have fibers that update the object. In
> this case you would need to use mutexes.
> 
> Or maybe you find another way?
> 
> > That said, I might be wrong though.
> > >
> > > Hope this helps,
> > >
> > > Aleix
> >
> > Thanks for explanation, this made my thinking much cleaner. I can
> > get back to experimenting now!
> >
> >
> Cool, let us know!
> Aleix

I actually made a working prototype. Basically I created a new
allocation option for GOOPS slots - #:message.
The default allocation type is #:instance, as explained here:
https://www.gnu.org/software/guile/manual/html_node/Slot-Options.html
The #:message allocation type I introduced treats setting a slot like
sending a message and reading the slot like receiving a message.
I used the example from GOOPS manual as inspiration:
https://www.gnu.org/software/guile/manual/html_node/Customizing-Class-Definition.html

Here's the code. It introduces a new metaclass
<message-allocation-metaclass> to modify the default behavior and
introduces the #:message allocation type.

(define-class <message-allocation-metaclass> (<class>))

(define-method (compute-get-n-set (class
<message-allocation-metaclass>) s) (define set-channel (make-channel))
  (define get-channel (make-channel))
  (define stored-value '())
  (define initialized? #f)
  (define (value-updater ch)
    (spawn-fiber
     (lambda ()
       (let loop ()
         (set! stored-value (get-message ch))
         (loop)))))
  (case (slot-definition-allocation s)
    ((#:message)
     (begin
       (list (lambda (o)
               (if initialized?
                   (begin
                     (spawn-fiber
                      (lambda ()
                        (put-message get-channel stored-value)))
                     (get-message get-channel))))
             (lambda (o v)
               (spawn-fiber
                (lambda ()
                  (if (not initialized?)
                      (begin
                        (set! initialized? #t)
                        (value-updater set-channel)))
                  (put-message set-channel v)))))))
    (else (next-method))))

Using this in practice looks something like this:

(define-class <dog> ()
  (number-of-legs #:setter set-number-of-legs
                  #:getter get-number-of-legs
                  #:allocation #:message)
  (toys #:setter set-toys
        #:getter get-toys
        #:allocation #:message)
  #:metaclass <message-allocation-metaclass>)

(define (main)
  (run-fibers
   (lambda ()
     (define dog1 (make <dog>))
     (spawn-fiber
      (lambda ()
        (set-number-of-legs dog1 4)
        (display "number of legs:\n")
        (display (get-number-of-legs dog1 4))
        (set-toys dog1 (list 'bone 'dead-rat 'something)))))
   #:drain? #t))

(main)

This solution allows setting and getting values safely over fibers
through messages, eliminating the problem of parallely editing the same
slot of an object (thanks to just one fiber being able to edit the real
value (value-updater)). If I'm not missing something important, this is
a real solution for a real problem.
I've already tested it with my toy program.
If you have any suggestions, feel free to tell me, also feel free to
use my code, if you find it useful.

I could push this a bit further by making the
<message-allocation-metaclass> allocate all slots by default
as #:message - this way every object would work safely on fibers,
without the boilerplate code.


Thanks for help, everyone. 

Jan Wielkiewicz