[racket-dev] [plt] Push #29062: master branch updated

Thanks for the extensive internal documentation. -- Matthias



On Jul 19, 2014, at 7:07 PM, gcooper at racket-lang.org wrote:

> gcooper has updated `master' from 45306397cc to 2881b60536.
>  http://git.racket-lang.org/plt/45306397cc..2881b60536
> 
> =====[ One Commit ]=====================================================
> Directory summary:
> 100.0% pkgs/frtime/
> 
> ~~~~~~~~~~
> 
> 2881b60 Gregory Cooper <ghcooper at gmail.com> 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 ]===================================================
> 
> pkgs/frtime/lang-ext.rkt
> ~~~~~~~~~~~~~~~~~~~~~~~~
> --- OLD/pkgs/frtime/lang-ext.rkt
> +++ NEW/pkgs/frtime/lang-ext.rkt
> @@ -3,6 +3,7 @@
>                      (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 
> @@ -403,46 +404,110 @@
>     (set-signal-value! ret ((signal-thunk ret)))
>     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)))))))))])
>     (begin
> -      (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)
>       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)