suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Adjust online check syntax's trace replay code so that it:

Browse Source 
- lets other events be handled based on how long it has been
  replaying the current trace (instead of based on the number of
  pieces in the trace that have been seen)

- breaks up the syncheck:add-rename-menu pieces of the trace to
  be more granular (to make the previous point work better)

This should make DrRacket more responsive when the trace is being
replayed
This commit is contained in:
Robby Findler 2012-10-26 09:43:49 -05:00
parent e89a121ae5
commit c6caf11323
2 changed files with 22 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
collects/drracket/private/syncheck/gui.rkt
View File

@ -1582,6 +1582,7 @@ If the namespace does not, they are colored the unbound color.
(send (send defs-text get-tab) add-bkg-running-color 'syncheck "orchid" cs-syncheck-running)
(send defs-text syncheck:init-arrows)
(let loop ([val val]
[start-time (current-inexact-milliseconds)]
[i 0])
(cond
[(null? val)
@ -1589,15 +1590,17 @@ If the namespace does not, they are colored the unbound color.
(send defs-text syncheck:update-drawn-arrows)
(send (send defs-text get-tab) remove-bkg-running-color 'syncheck)
(set-syncheck-running-mode #f)]
[(= i 500)
[(and (i . > . 0) ;; check i just in case things are really strange
(20 . <= . (- (current-inexact-milliseconds) start-time)))
(queue-callback
(λ ()
(when (unbox bx)
(log-timeline "continuing replay-compile-comp-trace" (loop val 0))))
(log-timeline "continuing replay-compile-comp-trace"
(loop val (current-inexact-milliseconds) 0))))
#f)]
[else
(process-trace-element defs-text (car val))
(loop (cdr val) (+ i 1))]))))
(loop (cdr val) start-time (+ i 1))]))))
(define/private (process-trace-element defs-text x)
;; using 'defs-text' all the time is wrong in the case of embedded editors,

20
collects/drracket/private/syncheck/traversals.rkt
View File

@ -1134,10 +1134,22 @@
(for/or ([(level id-set) (in-hash phase-to-map)])
(get-ids id-set new-id))))))))
#t))
(send defs-text syncheck:add-rename-menu
id-as-sym
loc-lst
name-dup?)))))))
(define max-to-send-at-once 30)
(let loop ([loc-lst loc-lst]
[len (length loc-lst)])
(cond
[(<= len max-to-send-at-once)
(send defs-text syncheck:add-rename-menu
id-as-sym
loc-lst
name-dup?)]
[else
(send defs-text syncheck:add-rename-menu
id-as-sym
(take loc-lst max-to-send-at-once)
name-dup?)
(loop (drop loc-lst max-to-send-at-once)
(- len max-to-send-at-once))]))))))))
;; remove-duplicates-stx : (listof syntax[original]) -> (listof syntax[original])
;; removes duplicates, based on the source locations of the identifiers