PasteRack.org
Paste # 51502
2018-12-05 15:56:11

Fork as a new paste.

Paste viewed 696 times.


Embed:

custom event what is a good implementation?

  1. #lang racket
  2.  
  3. (define undefined (gensym))
  4.  
  5. ;; singleassingmentvariable
  6. (struct sav (val)
  7.   #:mutable
  8.   #:transparent
  9.   #:property prop:evt
  10.   (λ (sav)
  11.     (define val (sav-val sav))
  12.     (if (eq? undefined val)
  13.         never-evt
  14.         #t)))
  15.  
  16. (define (new-var)
  17.   (sav undefined))
  18.  
  19. (define (sav-bind sav val)
  20.   (if (eq? undefined (sav-val sav))
  21.       (set-sav-val! sav val)
  22.       (raise (~a "attempted to bind sav a second time"))))
  23.  
  24. ;; second implementation with a semaphore
  25. (struct sav2 (val)
  26.   #:mutable
  27.   #:transparent
  28.   #:property prop:evt
  29.   (λ (sav)
  30.     (define val (sav2-val sav))
  31.     (if (semaphore? val)
  32.         (wrap-evt val (λ (ignore) sav))
  33.         #t)))
  34.  
  35. (define (new-var2)
  36.   (sav2 (make-semaphore)))
  37.  
  38. (define (sav2-bind sav val)
  39.   (define old-val (sav2-val sav))
  40.   (if (semaphore? old-val)
  41.       (begin
  42.         (set-sav2-val! sav val)
  43.         (semaphore-post old-val))
  44.       (raise (~a "attempted to bind sav a second time"))))
  45.  
  46. (define-syntax-rule (report var)
  47.   (displayln (~a (quote var) ": " var)))
  48.  
  49. (define (event-example)
  50.   (define s1 (new-var))
  51.  
  52.   (define r1 (sync/timeout 0.1 s1))
  53.   (report r1)
  54.  
  55.   (sav-bind s1 "foo")
  56.  
  57.   (define r2 (sync s1))      ;; works because s1 is already ready for syncronization
  58.   (report r2)
  59.  
  60.   (define s2 (new-var))
  61.   (thread (thunk (sleep 1)
  62.                  (sav-bind s2 "bar")))
  63.  
  64.   ;; hangs indefinitely because sync waits on the never-evt
  65.   ;; returned by savs prop:evt procedure and does not see that sav was mutated
  66.   ;; what is a good and simple solution for this?
  67.   ;; system idle event uses a semaphore for this:
  68.   ;; https://github.com/racket/racket/blob/862c05d64aded62457978b6e4a35dcf0df6edd66/racket/src/thread/system-idle-evt.rkt
  69.   ;; but it seems to me that I might be missing a simpler alternative?
  70.   (define t
  71.     (thread
  72.      (thunk
  73.       (define r3 (sync s2))
  74.       (report r3))))
  75.  
  76.   (sleep 2)
  77.   (kill-thread t)
  78.  
  79.  
  80.   (define (resync . args)  ;; stupidly retries all the time
  81.     (define (loop)
  82.       (apply sync/timeout loop args))
  83.     (loop))
  84.  
  85.   (define s3 (new-var))
  86.   (thread (thunk (sleep 1)
  87.                  (sav-bind s3 "baz")))
  88.  
  89.   (define r4 (resync s3))
  90.   (report r4)
  91.  
  92.   ;; semaphore based implementation works, but is it a good solution?
  93.   (define s4 (new-var2))
  94.   (thread (thunk (sleep 1)
  95.                  (sav2-bind s4 "buz")))
  96.  
  97.   (define r5 (sync s4))
  98.   (report r5))
  99.  
  100. (module+ main
  101.   (event-example))

=>