From 9bf26ef69e5b8c067286109afe7401665133ff3b Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Wed, 15 Jun 2011 16:44:10 +0800 Subject: [PATCH] add more caching to avoid calling normalize-path so much; this should affect the test coverage coloring and the stacktrace arrows/stop-sign window --- collects/drracket/private/debug.rkt | 27 +++++++++++++------ collects/drracket/tool-lib.rkt | 32 ++++++++++++++--------- collects/scribblings/framework/text.scrbl | 7 +++-- 3 files changed, 44 insertions(+), 22 deletions(-) diff --git a/collects/drracket/private/debug.rkt b/collects/drracket/private/debug.rkt index 8d5c41eb97..495bd09f47 100644 --- a/collects/drracket/private/debug.rkt +++ b/collects/drracket/private/debug.rkt @@ -286,9 +286,10 @@ profile todo: (if (null? stack) '() (list (car stack))))] - [stack-editions (map (λ (x) (srcloc->edition/pair defs ints x)) stack)] + [port-name-matches-cache (make-hasheq)] + [stack-editions (map (λ (x) (srcloc->edition/pair defs ints x port-name-matches-cache)) stack)] [src-locs-edition (and (pair? src-locs) - (srcloc->edition/pair defs ints (car src-locs)))]) + (srcloc->edition/pair defs ints (car src-locs) port-name-matches-cache))]) (print-planet-icon-to-stderr exn) (unless (exn:fail:user? exn) (unless (null? stack) @@ -310,18 +311,22 @@ profile todo: ;; and still running here? (send ints highlight-errors src-locs stack))))))) - (define (srcloc->edition/pair defs ints srcloc) + (define (srcloc->edition/pair defs ints srcloc [port-name-matches-cache #f]) (let ([src (srcloc-source srcloc)]) (cond [(and (or (symbol? src) (path? src)) ints - (send ints port-name-matches? src)) + (if port-name-matches-cache + (hash-ref! port-name-matches-cache (cons ints src) (λ () (send ints port-name-matches? src))) + (send ints port-name-matches? src))) (cons (make-weak-box ints) (send ints get-edition-number))] [(and (or (symbol? src) (path? src)) defs - (send defs port-name-matches? src)) + (if port-name-matches-cache + (hash-ref! port-name-matches-cache (cons defs src) (λ () (send defs port-name-matches? src))) + (send defs port-name-matches? src))) (cons (make-weak-box defs) (send defs get-edition-number))] [(path? src) (let ([frame (send (group:get-the-frame-group) locate-file src)]) @@ -1072,6 +1077,8 @@ profile todo: [already-frozen-ht (make-hasheq)] [actions-ht (make-hash)] + [port-name-cache (make-hasheq)] + ;; can-annotate : (listof (list boolean srcloc)) ;; boolean is #t => code was run ;; #f => code was not run @@ -1086,7 +1093,7 @@ profile todo: [span (syntax-span stx)]) (and pos span - (send (get-defs) port-name-matches? src) + (hash-ref! port-name-cache src (λ () (send (get-defs) port-name-matches? src))) (list (mcar covered?) (make-srcloc (get-defs) #f #f pos span))))))))] @@ -1743,12 +1750,16 @@ profile todo: [in-edit-sequence (make-hasheq)] [clear-highlight void] [max-value (extract-maximum infos)] + + [port-name-matches-cache (make-hasheq)] [show-highlight (λ (info) (let* ([expr (prof-info-expr info)] [src (and (syntax-source expr) - (send definitions-text port-name-matches? (syntax-source expr)) - definitions-text)] + definitions-text + (hash-ref! port-name-matches-cache + (syntax-source expr) + (λ () (send definitions-text port-name-matches? (syntax-source expr)))))] [pos (syntax-position expr)] [span (syntax-span expr)]) (when (and (is-a? src text:basic<%>) diff --git a/collects/drracket/tool-lib.rkt b/collects/drracket/tool-lib.rkt index 45ad30d265..71078bdee6 100644 --- a/collects/drracket/tool-lib.rkt +++ b/collects/drracket/tool-lib.rkt @@ -522,24 +522,32 @@ all of the names in the tools library, for use defining keybindings (proc-doc/names drracket:debug:srcloc->edition/pair - (-> srcloc? - (or/c #f (is-a?/c drracket:rep:text<%>)) - (or/c #f (is-a?/c drracket:unit:definitions-text<%>)) - (or/c #f (cons/c (let ([weak-box-containing-an-editor? - (λ (x) (and (weak-box? x) - (let ([v (weak-box-value x)]) - (or (not v) - (is-a?/c v editor<%>)))))]) - weak-box-containing-an-editor?) - number?))) - (srcloc ints defs) + (->* (srcloc? + (or/c #f (is-a?/c drracket:rep:text<%>)) + (or/c #f (is-a?/c drracket:unit:definitions-text<%>))) + ((or/c #f (and/c hash? hash-equal?))) + (or/c #f (cons/c (let ([weak-box-containing-an-editor? + (λ (x) (and (weak-box? x) + (let ([v (weak-box-value x)]) + (or (not v) + (is-a?/c v editor<%>)))))]) + weak-box-containing-an-editor?) + number?))) + ((srcloc ints defs) + ((cache #f))) @{Constructs a edition pair from a source location, returning the current edition of the editor editing the source location (if any). The @racket[ints] and @racket[defs] arguments are used to map source locations, in the case that the source location corresponds to the definitions - window (when it has not been saved) or the interactions window. + window (when it has not been saved) or the interactions window. This calls + @racket[normalize-path], so to avoid the severe performance penalty that can + incur on some filesystems, the @racket[cache] argument is consulted and updated, + when it is provided. Use this argument if you're calling + @racket[drracket:debug:srcloc->edition/pair] a number of times in a loop, when you + do not expect the filesystem to change across iterations of the loop. The initial + argument should be an empty equal hash (e.g., @racket[(make-hash)]). }) diff --git a/collects/scribblings/framework/text.scrbl b/collects/scribblings/framework/text.scrbl index a5aa37448b..c913607d1f 100644 --- a/collects/scribblings/framework/text.scrbl +++ b/collects/scribblings/framework/text.scrbl @@ -125,14 +125,17 @@ See also @method[text:basic<%> port-name-matches?]. } - @defmethod*[(((port-name-matches? (id any/c)) boolean?))]{ + @defmethod[(port-name-matches? (id any/c)) boolean?]{ Indicates if @scheme[id] matches the port name of this file. If the file is saved, the port name matches when the save file is the path as @scheme[id]. If the file has not been saved, the port name matches if the symbol is the same as the result of - @method[text:basic<%> port-name-matches?]. + @method[text:basic<%> get-port-name]. + This method calls @racket[normalize-path] and thus can be very + expensive on some filesystems. If it is called many times in a + loop, cache the results to avoid calling it too often. } @defmethod[(get-edition-number) exact-nonnegative-integer?]{ Returns a number that increments every time something in