Re: [plt] Push #29062: master branch updated
Thanks for the extensive internal documentation. -- Matthias
On Jul 19, 2014, at 7:07 PM, gcooper@... wrote:
> gcooper has updated `master' from 45306397cc to 2881b60536.
> =====[ One Commit ]=====================================================
> Directory summary:
> 100.0% pkgs/frtime/
> 2881b60 Gregory Cooper <ghcooper@...> 2014-07-19 16:06
> | Rewrite the delay-by primitive so it's easier to understand.
> | Also, add comments that attempt to explain how it's intended to work.
> M pkgs/frtime/lang-ext.rkt | 139 ++++++++++++++++++++++++++++++++------------
> =====[ Overall Diff ]===================================================
> --- OLD/pkgs/frtime/lang-ext.rkt
> +++ NEW/pkgs/frtime/lang-ext.rkt
> <at> <at> -3,6 +3,7 <at> <at>
> (only-in racket/list first second last-pair empty empty?))
> (only-in racket/list first second cons? empty empty? rest last-pair)
> (only-in racket/function identity)
> + data/queue
> (only-in frtime/core/frp super-lift undefined undefined? behavior? do-in-manager-after
do-in-manager proc->signal set-signal-thunk! register unregister
> signal? signal-depth signal:switching? signal-value value-now signal:compound?
signal:compound-content signal:switching-current signal:switching-trigger
> set-cell! snap? iq-enqueue value-now/no-copy event-receiver event-set? proc->signal:switching
set-signal-producers! set-signal-depth! safe-signal-depth
> <at> <at> -403,46 +404,110 <at> <at>
> (set-signal-value! ret ((signal-thunk ret)))
> -; XXX general efficiency fix for delay
> -; signal[a] signal[num] -> signal[a]
> -(define (delay-by beh ms-b)
> - (letrec ([last (mcons (cons (if (zero? (value-now ms-b))
> - (value-now/no-copy beh)
> - undefined)
> - (current-inexact-milliseconds))
> - empty)]
> - [head last]
> - [consumer #f]
> - [producer (proc->signal
> - (lambda ()
> - (let* ([now (and (signal? consumer) (current-inexact-milliseconds))]
> - [ms (value-now ms-b)])
> - (let loop ()
> - (if (or (empty? (mcdr head))
> - (< now (+ ms (cdr (mcar (mcdr head))))))
> - (let ([val (car (mcar head))])
> - (if (event-set? val)
> - (make-events-now (event-set-events val))
> - val))
> - (begin
> - (set! head (mcdr head))
> - (loop)))))))])
> +;; signal[a] num -> signal[a]
> +;; Returns a signal whose value at (approximately) time (+ t |delay-millis|) is a (deep) snapshot
> +;; of the value of |sig| at time t, for all times t from now on. For earlier times, the value of the
> +;; returned signal is undefined.
> +;; Assumptions: (current-inexact-milliseconds) is monotonically non-decreasing; |delay-millis| is
> +;; positive and finite.
> +(define (delay-by sig delay-millis)
> + ;; Implementation strategy:
> + ;;
> + ;; Maintain a queue of pairs (snapshot . timestamp) of the observed signal going back in
> + ;; time for at least |delay-millis|. Start with (undefined . -inf.0) and (current-value . now), so
> + ;; there should always be at least one item (value . timestamp) in the queue such that
> + ;; (>= now (+ timestamp delay-millis)).
> + ;;
> + ;; |consumer| runs whenever |sig| changes and adds an item with the observed value and current
> + ;; time to the queue; schedules |producer| to run at |delay-millis| in the future, by which
> + ;; time it should be ready to take on that observed value.
> + ;;
> + ;; |producer| has no dependencies recorded in the dataflow graph and only runs when scheduled
> + ;; by the consumer. (This is what allows delay-by to break cycles.) It traverses the queue
> + ;; looking for the latest observation (value . timestamp) such that
> + ;; (>= now (+ timestamp delay-millis)), and takes on the observed value. |producer| is the
> + ;; value returned by this procedure, so it stays alive as long as anything cares about its
> + ;; value.
> + (let* ([queue (make-queue)]
> + ;; finish : (a . num) a -> a
> + ;; Puts |queue-item| back on the front of the queue and returns |val|, updating the
> + ;; occurrence timestamp if |val| represents an event set.
> + ;; TODO(gcooper): We could avoid this if data/queue supported a "peek" operation.
> + [finish! (lambda (queue-item val)
> + (enqueue-front! queue queue-item)
> + (if (event-set? val)
> + (make-events-now (event-set-events val))
> + val))]
> + [now-millis (current-inexact-milliseconds)]
> + [_ (begin
> + ;; Add initial observations to the queue.
> + (enqueue! queue (cons undefined -inf.0))
> + (enqueue! queue (cons (deep-value-now sig empty) now-millis)))]
> + ;; |consumer|'s thunk needs |producer| to be in scope so it can schedule it, and
> + ;; |producer|'s thunk needs |consumer| to be in scope so it can keep it alive. To set up
> + ;; this cycle, we first create |consumer| with a dummy thunk (void), then define
> + ;; |producer|, and finally update |consumer|'s thunk to what we want it to be.
> + [consumer (proc->signal void sig)]
> + [producer (proc->signal
> + (lambda ()
> + (let ([now-millis (current-inexact-milliseconds)])
> + ;; There's no way to "peek" at the next item in the queue, so we have to
> + ;; dequeue it, check whether we're ready for it, and if not, stick it back
> + ;; on the front...
> + (let loop ([front (dequeue! queue)])
> + ;; |val| is our current candidate value; we'll use it if there's no later
> + ;; observation that's at least |delay-millis| old.
> + (let* ([val (car front)])
> + (if (queue-empty? queue)
> + ;; There are no later observations to consider, so use the current
> + ;; one.
> + (finish! front val)
> + ;; Look at the next item in the queue to see if we're ready for it.
> + ;; If so, recur. Otherwise, put it back on the front of the queue
> + ;; and use the previous value.
> + (let* ([next (dequeue! queue)]
> + [timestamp-millis (cdr next)])
> + ;; Kludge: since there's nothing that would otherwise keep
> + ;; |consumer| alive, we retain a reference to it here, and we
> + ;; trick the runtime into not optimizing it away by calling a
> + ;; predicate and using the result in a conditional expression. If
> + ;; the compiler ever gets smart enough to determine that the
> + ;; outcome is provably always true, and therefore that it can
> + ;; optimize away this code, we'll have to come up with a
> + ;; different strategy (e.g., adding a special field to the signal
> + ;; structure).
> + (if (and (signal? consumer)
> + (< now-millis (+ timestamp-millis delay-millis)))
> + ;; We're not ready for the next value yet, so push it back
> + ;; and proceed with the previous value.
> + (begin
> + (enqueue-front! queue next)
> + (finish! front val))
> + (loop next)))))))))])
> - (set! consumer (proc->signal
> - (lambda ()
> - (let* ([now (current-inexact-milliseconds)]
> - [new (deep-value-now beh empty)]
> - [ms (value-now ms-b)])
> - (when (not (equal? new (car (mcar last))))
> - (set-mcdr! last (mcons (cons new now)
> - empty))
> - (set! last (mcdr last))
> - (schedule-alarm (+ now ms) producer))))
> - beh ms-b))
> + (set-signal-thunk!
> + consumer
> + (lambda ()
> + (let* ([now-millis (current-inexact-milliseconds)]
> + [new-value (deep-value-now sig empty)])
> + ;; Record the current observation and schedule |producer| to run when it's time to take
> + ;; on this value.
> + (enqueue! queue (cons new-value now-millis))
> + (schedule-alarm (+ now-millis delay-millis) producer))))
> + ;; Make sure producer is scheduled to run as soon as there's a value ready for it.
> + (schedule-alarm (+ now-millis delay-millis) producer)
> -(define (inf-delay beh)
> - (delay-by beh 0))
> +;; signal[a] -> signal[a]
> +;; Delays |sig| by the smallest possible amount of time.
> +(define (inf-delay sig)
> + (delay-by sig 0))
> ; XXX fix to take arbitrary monotonically increasing number
> ; (instead of milliseconds)
Racket Developers list: