summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2014-08-25 19:28:19 -0400
committerDavid Thompson <dthompson2@worcester.edu>2014-08-25 19:30:12 -0400
commit9162ea9ab57e48cfb32216d5b8910252f036457d (patch)
tree95f0b040a0bcb468b2b15a8bb127f93a93ef2550
parent3644d90925422094ff3665488eacba4a7832dbc9 (diff)
Fix memory leak in signal-sample.
* sly/signal.scm (signal-sample): Fix memory leak.
-rw-r--r--sly/signal.scm28
1 files changed, 23 insertions, 5 deletions
diff --git a/sly/signal.scm b/sly/signal.scm
index 3988812..41dddf2 100644
--- a/sly/signal.scm
+++ b/sly/signal.scm
@@ -292,11 +292,29 @@ a side-effect into a signal chain."
(define (signal-sample delay signal)
"Create a new signal that emits the value contained within SIGNAL
every DELAY ticks of the current agenda."
- (let ((sampler (%make-signal (signal-ref signal) #f '())))
- (define (tick)
- (%signal-set! sampler (signal-ref signal)))
- (schedule-interval tick delay)
- (make-signal-box sampler)))
+ ;; To prevent memory leaks, the new signal is stored within a weak
+ ;; value hash table and never bound to a variable within the main
+ ;; body of the procedure. When this signal is GC'd, the sampling
+ ;; will stop.
+ (let ((container (make-weak-value-hash-table 1)))
+ (define (get)
+ (hash-ref container 'signal))
+
+ (define (sample!)
+ (let ((sampler (get)))
+ (if sampler
+ (begin
+ (signal-set! sampler (signal-ref signal))
+ #t)
+ #f)))
+
+ (hash-set! container 'signal (make-signal (signal-ref signal)))
+ (coroutine
+ (let loop ()
+ (wait delay)
+ (when (sample!)
+ (loop))))
+ (get)))
(define (signal-delay delay signal)
"Create a new signal that delays propagation of SIGNAL by DELAY