diff --git a/drracket-core-lib/browser/external.rkt b/drracket-core-lib/browser/external.rkt index 2fba81299..7d7a066b0 100644 --- a/drracket-core-lib/browser/external.rkt +++ b/drracket-core-lib/browser/external.rkt @@ -40,10 +40,11 @@ ;; sync-current-proxy-servers : proxy-pref -> void ;; syncs current-proxy-servers parameter with the proxy-pref-val (define (sync-current-proxy-servers pref-val) - (let* ([ops (current-proxy-servers)] - [removed (remove-all-proxies "http" ops)]) - (current-proxy-servers - (if pref-val (cons pref-val removed) removed)))) + (define ops (current-proxy-servers)) + (define removed (remove-all-proxies "http" ops)) + (current-proxy-servers (if pref-val + (cons pref-val removed) + removed))) (define (remove-all-proxies scheme proxies) (filter (lambda (x) (and (pair? x) (not (equal? (car x) scheme)))) @@ -84,9 +85,8 @@ (loop (add1 tries))))))) (define unix-browser-names - (map (lambda (s) - (string-titlecase (regexp-replace* #rx"-" (symbol->string s) " "))) - raw:unix-browser-list)) + (for/list ([s (in-list raw:unix-browser-list)]) + (string-titlecase (regexp-replace* #rx"-" (symbol->string s) " ")))) ;; : (U str #f) -> (U symbol #f) ;; to prompt the user for a browser preference @@ -94,38 +94,37 @@ ;; and in that case, the user can choose to use the internal ;; broswer. (define (choose-browser url) - (let* ([title (string-constant choose-browser)] - [d (make-object dialog% title)] - [main-pane (make-object vertical-pane% d)] - [internal-ok? (not url)] - [ok? #f] - [orig-external (fw:preferences:get 'external-browser)]) - (make-object message% title main-pane) - ;; No need to show the URL (it can be very long) - ;; (when url - ;; (make-object message% (format "URL: ~a" url) main-pane)) - (let-values ([(panel callbacks) (make-help-browser-preference-panel internal-ok? #f (lambda (f) (f main-pane)))]) - (let*-values ([(button-pane) (instantiate horizontal-panel% (main-pane) - (alignment '(right center)))] - [(ok-button cancel-button) - (fw:gui-utils:ok/cancel-buttons - button-pane - (lambda (b e) (set! ok? #t) (send d show #f)) - (lambda (b e) - (fw:preferences:set 'external-browser orig-external) - (send d show #f)))] - [(enable-button) (lambda (_n _v) - (queue-callback - (lambda () - (send ok-button enable (fw:preferences:get 'external-browser)))))]) - (send ok-button enable #f) - (set! callbacks - (cons - (fw:preferences:add-callback 'external-browser enable-button) - callbacks))) - (send d show #t) - (map (lambda (f) (f)) callbacks) - ok?))) + (define title (string-constant choose-browser)) + (define d (make-object dialog% title)) + (define main-pane (make-object vertical-pane% d)) + (define internal-ok? (not url)) + (define ok? #f) + (define orig-external (fw:preferences:get 'external-browser)) + (make-object message% title main-pane) + ;; No need to show the URL (it can be very long) + ;; (when url + ;; (make-object message% (format "URL: ~a" url) main-pane)) + (define-values (panel callbacks) + (make-help-browser-preference-panel internal-ok? #f (lambda (f) (f main-pane)))) + (let*-values ([(button-pane) (instantiate horizontal-panel% (main-pane) + [alignment '(right center)])] + [(ok-button cancel-button) (fw:gui-utils:ok/cancel-buttons + button-pane + (lambda (b e) + (set! ok? #t) + (send d show #f)) + (lambda (b e) + (fw:preferences:set 'external-browser orig-external) + (send d show #f)))] + [(enable-button) + (lambda (_n _v) + (queue-callback + (lambda () (send ok-button enable (fw:preferences:get 'external-browser)))))]) + (send ok-button enable #f) + (set! callbacks (cons (fw:preferences:add-callback 'external-browser enable-button) callbacks))) + (send d show #t) + (map (lambda (f) (f)) callbacks) + ok?) (define panel-installed? #f) (define prefs-panel #f) @@ -140,11 +139,11 @@ (lambda (f) (fw:preferences:add-panel (string-constant browser) (lambda (parent) - (let-values ([(panel cbs) (f parent)]) - (set! prefs-panel panel) - (map (lambda (f) (f panel)) additions) - (set! additions null) - panel))))))) + (define-values (panel cbs) (f parent)) + (set! prefs-panel panel) + (map (lambda (f) (f panel)) additions) + (set! additions null) + panel)))))) (define (add-to-browser-prefs-panel proc) (if prefs-panel @@ -155,150 +154,155 @@ (mk (lambda (parent) (define callbacks null) - (let ([pref-panel (instantiate vertical-panel% () - [parent parent] - [alignment '(left center)])]) - - ;; -------------------- external browser for Unix -------------------- - (when (unix-browser?) - (unless synchronized? - ;; Keep 'external-browser in sync - (fw:preferences:add-callback 'external-browser - (lambda (name browser) - (try-put-preferences (list 'external-browser) (list browser))))) - - (letrec ([v-panel (instantiate group-box-panel% () - (parent pref-panel) - (alignment '(right center)) - (stretchable-height #f) - (label (string-constant external-browser-choice-title)))] - [h-panel (instantiate horizontal-panel% () - (parent v-panel) - (alignment '(center bottom)))] - [none-index (length raw:unix-browser-list)] - [custom-index (add1 none-index)] - [r (instantiate radio-box% () - (label #f) - (choices (append unix-browser-names - (list (string-constant no-browser) - (string-constant browser-command-line-label)))) - (parent h-panel) - (callback - (lambda (radio event) - (let ([n (send radio get-selection)]) - (set-browser! - (cond - [(= n none-index) #f] - [(= n custom-index) (get-custom)] - [else (list-ref raw:unix-browser-list n)]))))))] - [select-custom - (lambda (_ __) - (send r set-selection custom-index) - (set-browser! (get-custom)))] - [get-custom - (lambda () (cons (send pre get-value) (send post get-value)))] - [template-panel (instantiate horizontal-panel% (h-panel) - (spacing 0) - (stretchable-height #f))] - [pre (instantiate text-field% () - (label #f) (parent template-panel) (callback select-custom) - (horiz-margin 0))] - [mess (instantiate message% () (label "") (parent template-panel) - (horiz-margin 0))] - [post (instantiate text-field% () - (label #f) (parent template-panel) (callback select-custom) - (horiz-margin 0))] - [note1 (instantiate message% ((string-constant browser-cmdline-expl-line-1) - v-panel))] - [note2 (instantiate message% ((string-constant browser-cmdline-expl-line-2) - v-panel))] - [refresh-controls (lambda (pref) - (if (pair? pref) - (begin - (send r set-selection custom-index) - (send pre set-value (car pref)) - (send post set-value (cdr pref))) - (let init ([x raw:unix-browser-list] [n 0]) - (cond - [(null? x) (send r set-selection n)] - [else (if (eq? pref (car x)) - (send r set-selection n) - (init (cdr x) (add1 n)))]))))]) - - (unless ask-later? - (send r enable none-index #f)) - - (refresh-controls (fw:preferences:get 'external-browser)) - (set! callbacks - (cons (fw:preferences:add-callback 'external-browser - (lambda (name browser) (refresh-controls browser))) - callbacks)))) - - ;; -------------------- proxy for doc downloads -------------------- - (when set-help? - (letrec ([p (instantiate group-box-panel% () - [label (string-constant http-proxy)] - [parent pref-panel] - [stretchable-height #f] - [alignment '(left top)])] - [rb (make-object radio-box% - #f (list (string-constant proxy-direct-connection) - (string-constant proxy-use-proxy)) - p - (lambda (r e) - (let ([proxy? (= 1 (send r get-selection))]) - (send proxy-spec enable proxy?) - (if proxy? - (update-proxy) - (fw:preferences:set http-proxy-preference #f)))))] - [proxy-spec (instantiate horizontal-panel% (p) - [stretchable-width #f] - [stretchable-height #f] - [alignment '(left center)])] - [update-proxy (lambda () - (let ([host (send host get-value)] - [port (send port get-value)]) - (let ([ok? (and (regexp-match? #rx"^[-0-9a-zA-Z.]+$" host) - (regexp-match? #rx"^[0-9]+$" port) - (string->number port) - (<= 1 (string->number port) 65535))]) - (when ok? - (fw:preferences:set - http-proxy-preference - (list "http" host (string->number port)))) - (send bad-host show (not ok?)))))] - [host (make-object text-field% - (string-constant proxy-host) - proxy-spec (lambda (x y) (update-proxy)) - "www.someplacethatisaproxy.domain.com")] - [port (make-object text-field% - (string-constant proxy-port) - proxy-spec (lambda (x y) (update-proxy)) "65535")] - [bad-host (make-object message% - (string-constant proxy-bad-host) - p)] - [update-gui - (lambda (proxy-val) - (send bad-host show #f) - (if proxy-val - (begin - (send rb set-selection 1) - (send proxy-spec enable #t) - (unless (string=? (cadr proxy-val) (send host get-value)) - (send host set-value (cadr proxy-val))) - (unless (equal? (caddr proxy-val) (string->number (send port get-value))) - (send port set-value (number->string (caddr proxy-val))))) - (begin - (send rb set-selection 0) - (send proxy-spec enable #f) - (send host set-value "") - (send port set-value ""))))]) - - (fw:preferences:add-callback http-proxy-preference - (lambda (name val) - (update-gui val))) - (update-gui (fw:preferences:get http-proxy-preference)) - (send bad-host show #f))) - - (set! synchronized? #t) - (values pref-panel callbacks))))) + (define pref-panel + (new vertical-panel% [parent parent] [alignment '(left center)])) + + ;; -------------------- external browser for Unix -------------------- + (when (unix-browser?) + (unless synchronized? + ;; Keep 'external-browser in sync + (fw:preferences:add-callback + 'external-browser + (lambda (name browser) (try-put-preferences (list 'external-browser) (list browser))))) + + (letrec + ([v-panel (instantiate group-box-panel% () + [parent pref-panel] + [alignment '(right center)] + [stretchable-height #f] + [label (string-constant external-browser-choice-title)])] + [h-panel (instantiate horizontal-panel% () + [parent v-panel] + [alignment '(center bottom)])] + [none-index (length raw:unix-browser-list)] + [custom-index (add1 none-index)] + [r (instantiate radio-box% () + [label #f] + [choices + (append unix-browser-names + (list (string-constant no-browser) + (string-constant browser-command-line-label)))] + [parent h-panel] + [callback + (lambda (radio event) + (let ([n (send radio get-selection)]) + (set-browser! (cond + [(= n none-index) #f] + [(= n custom-index) (get-custom)] + [else (list-ref raw:unix-browser-list n)]))))])] + [select-custom (lambda (_ __) + (send r set-selection custom-index) + (set-browser! (get-custom)))] + [get-custom (lambda () (cons (send pre get-value) (send post get-value)))] + [template-panel (instantiate horizontal-panel% (h-panel) + [spacing 0] + [stretchable-height #f])] + [pre (instantiate text-field% () + [label #f] + [parent template-panel] + [callback select-custom] + [horiz-margin 0])] + [mess (instantiate message% () + [label ""] + [parent template-panel] + [horiz-margin 0])] + [post (instantiate text-field% () + [label #f] + [parent template-panel] + [callback select-custom] + [horiz-margin 0])] + [note1 (instantiate message% ((string-constant browser-cmdline-expl-line-1) v-panel))] + [note2 (instantiate message% ((string-constant browser-cmdline-expl-line-2) v-panel))] + [refresh-controls (lambda (pref) + (if (pair? pref) + (begin + (send r set-selection custom-index) + (send pre set-value (car pref)) + (send post set-value (cdr pref))) + (let init ([x raw:unix-browser-list] + [n 0]) + (cond + [(null? x) (send r set-selection n)] + [else + (if (eq? pref (car x)) + (send r set-selection n) + (init (cdr x) + (add1 n)))]))))]) + + (unless ask-later? + (send r enable none-index #f)) + + (refresh-controls (fw:preferences:get 'external-browser)) + (set! callbacks + (cons (fw:preferences:add-callback 'external-browser + (lambda (name browser) + (refresh-controls browser))) + callbacks)))) + + ;; -------------------- proxy for doc downloads -------------------- + (when set-help? + (letrec ([p (instantiate group-box-panel% () + [label (string-constant http-proxy)] + [parent pref-panel] + [stretchable-height #f] + [alignment '(left top)])] + [rb (make-object radio-box% + #f + (list (string-constant proxy-direct-connection) + (string-constant proxy-use-proxy)) + p + (lambda (r e) + (let ([proxy? (= 1 (send r get-selection))]) + (send proxy-spec enable proxy?) + (if proxy? + (update-proxy) + (fw:preferences:set http-proxy-preference #f)))))] + [proxy-spec (instantiate horizontal-panel% (p) + [stretchable-width #f] + [stretchable-height #f] + [alignment '(left center)])] + [update-proxy (lambda () + (let ([host (send host get-value)] + [port (send port get-value)]) + (let ([ok? (and (regexp-match? #rx"^[-0-9a-zA-Z.]+$" host) + (regexp-match? #rx"^[0-9]+$" port) + (string->number port) + (<= 1 (string->number port) 65535))]) + (when ok? + (fw:preferences:set http-proxy-preference + (list "http" host (string->number port)))) + (send bad-host show (not ok?)))))] + [host (make-object text-field% + (string-constant proxy-host) + proxy-spec + (lambda (x y) (update-proxy)) + "www.someplacethatisaproxy.domain.com")] + [port (make-object text-field% + (string-constant proxy-port) + proxy-spec + (lambda (x y) (update-proxy)) + "65535")] + [bad-host (make-object message% (string-constant proxy-bad-host) p)] + [update-gui (lambda (proxy-val) + (send bad-host show #f) + (if proxy-val + (begin + (send rb set-selection 1) + (send proxy-spec enable #t) + (unless (string=? (cadr proxy-val) (send host get-value)) + (send host set-value (cadr proxy-val))) + (unless (equal? (caddr proxy-val) + (string->number (send port get-value))) + (send port set-value (number->string (caddr proxy-val))))) + (begin + (send rb set-selection 0) + (send proxy-spec enable #f) + (send host set-value "") + (send port set-value ""))))]) + + (fw:preferences:add-callback http-proxy-preference (lambda (name val) (update-gui val))) + (update-gui (fw:preferences:get http-proxy-preference)) + (send bad-host show #f))) + + (set! synchronized? #t) + (values pref-panel callbacks)))) diff --git a/drracket-core-lib/drracket/sprof.rkt b/drracket-core-lib/drracket/sprof.rkt index 695dce023..d10d62c11 100644 --- a/drracket-core-lib/drracket/sprof.rkt +++ b/drracket-core-lib/drracket/sprof.rkt @@ -17,10 +17,8 @@ (define new-traces (map (λ (t) (continuation-mark-set->context (continuation-marks t))) (get-threads))) (for ([trace (in-list new-traces)]) - (for-each - (λ (line) - (hash-set! traces-table line (cons trace (hash-ref traces-table line '())))) - trace)) + (for ([line (in-list trace)]) + (hash-update! traces-table line (λ (v) (cons trace v)) '()))) (cond [(zero? i) (update-gui traces-table) @@ -160,9 +158,9 @@ (hash-set! line-to-source i pr) (insert (format-percentage (/ count denom-count))) (insert (format " ~a" (format-fn-name fn))) - (let ([after (last-position)]) - (when (equal? (car pr) clicked-srcloc-pr) - (set! clear-old-pr (highlight-range before after "NavajoWhite"))))) + (define after (last-position)) + (when (equal? (car pr) clicked-srcloc-pr) + (set! clear-old-pr (highlight-range before after "NavajoWhite")))) (loop (cdr prs) #f (+ i 1))])])) (lock #t) (end-edit-sequence) diff --git a/drracket-tool-text-lib/drracket/private/syncheck/annotate.rkt b/drracket-tool-text-lib/drracket/private/syncheck/annotate.rkt index a1d88c470..6c51cb2c5 100644 --- a/drracket-tool-text-lib/drracket/private/syncheck/annotate.rkt +++ b/drracket-tool-text-lib/drracket/private/syncheck/annotate.rkt @@ -11,12 +11,11 @@ ;; color : syntax[original] str -> void ;; colors the syntax with style-name's style (define (color stx style-name) - (let ([source (find-source-editor stx)]) - (when (and (syntax-position stx) - (syntax-span stx)) - (let ([pos (- (syntax-position stx) 1)] - [span (syntax-span stx)]) - (color-range source pos (+ pos span) style-name))))) + (define source (find-source-editor stx)) + (when (and (syntax-position stx) (syntax-span stx)) + (let ([pos (- (syntax-position stx) 1)] + [span (syntax-span stx)]) + (color-range source pos (+ pos span) style-name)))) ;; color-range : text start finish style-name ;; colors a range in the text based on `style-name' @@ -55,9 +54,8 @@ ;; find-source-editor : stx -> editor or false (define (find-source-editor stx) - (let ([defs-text (current-annotations)]) - (and defs-text - (find-source-editor/defs stx defs-text)))) + (define defs-text (current-annotations)) + (and defs-text (find-source-editor/defs stx defs-text))) ;; find-source-editor : stx text -> editor or false (define (find-source-editor/defs stx defs-text) diff --git a/drracket-tool-text-lib/drracket/private/syncheck/contract-traversal.rkt b/drracket-tool-text-lib/drracket/private/syncheck/contract-traversal.rkt index 3fe3db832..aad09cf07 100644 --- a/drracket-tool-text-lib/drracket/private/syncheck/contract-traversal.rkt +++ b/drracket-tool-text-lib/drracket/private/syncheck/contract-traversal.rkt @@ -29,24 +29,32 @@ [_ (void)])) ;; fill in the coloring-plans table for boundary contracts - (for ([(start-k start-val) (in-hash boundary-start-map)]) - (for ([start-stx (in-list start-val)]) - (do-contract-traversal start-stx #t - coloring-plans already-jumped-ids - low-binders binding-inits - domain-map range-map - #t - binder+mods-binder))) + (for* ([(start-k start-val) (in-hash boundary-start-map)] + [start-stx (in-list start-val)]) + (do-contract-traversal start-stx + #t + coloring-plans + already-jumped-ids + low-binders + binding-inits + domain-map + range-map + #t + binder+mods-binder)) ;; fill in the coloring-plans table for internal contracts - (for ([(start-k start-val) (in-hash internal-start-map)]) - (for ([start-stx (in-list start-val)]) - (do-contract-traversal start-stx #f - coloring-plans already-jumped-ids - low-binders binding-inits - domain-map range-map - #f - binder+mods-binder))) + (for* ([(start-k start-val) (in-hash internal-start-map)] + [start-stx (in-list start-val)]) + (do-contract-traversal start-stx + #f + coloring-plans + already-jumped-ids + low-binders + binding-inits + domain-map + range-map + #f + binder+mods-binder)) ;; enact the coloring plans (for ([(stx colors) (in-hash coloring-plans)]) @@ -210,7 +218,7 @@ (let loop ([val (syntax-property stx prop)]) (cond [(symbol? val) - (hash-set! map val (cons stx (hash-ref map val '())))] + (hash-update! map val (λ (v) (cons stx v)) '())] [(pair? val) (loop (car val)) (loop (cdr val))]))) @@ -221,11 +229,11 @@ ;; approximate this by just asking 'did this identifier come from the core?' (which is known ;; to not bind any contracts (I hope)) (define (known-predicate? id) - (let ([ib (identifier-binding id)]) - (and (list? ib) - (let ([src (list-ref ib 0)]) - (let-values ([(base rel) (module-path-index-split src)]) - (member base '('#%kernel '#%runtime racket racket/base scheme scheme/base))))))) + (define ib (identifier-binding id)) + (and (list? ib) + (let ([src (list-ref ib 0)]) + (let-values ([(base rel) (module-path-index-split src)]) + (member base '('#%kernel '#%runtime racket racket/base scheme scheme/base)))))) (define (give-up stx boundary-contract? coloring-plans) (let loop ([stx stx]) @@ -253,11 +261,7 @@ (make-a-coloring-plan stx unk-obligation-style-name coloring-plans)) (define (make-a-coloring-plan stx plan coloring-plans) - (hash-set! coloring-plans - stx - (cons - plan - (hash-ref coloring-plans stx '())))) + (hash-update! coloring-plans stx (λ (v) (cons plan v)) '())) (module+ test (let () diff --git a/drracket-tool-text-lib/drracket/private/syncheck/traversals.rkt b/drracket-tool-text-lib/drracket/private/syncheck/traversals.rkt index e1dce89c2..648135a1a 100644 --- a/drracket-tool-text-lib/drracket/private/syncheck/traversals.rkt +++ b/drracket-tool-text-lib/drracket/private/syncheck/traversals.rkt @@ -54,60 +54,60 @@ [_ #f])) (cond [is-module? - (let ([phase-to-binders (make-hash)] - [phase-to-varrefs (make-hash)] - [phase-to-varsets (make-hash)] - [phase-to-tops (make-hash)] - [phase-to-requires (make-hash)] - [binding-inits (make-hash)] - [templrefs (make-id-set 0)] - [module-lang-requires (make-hash)] - [requires (make-hash)] - [require-for-syntaxes (make-hash)] - [require-for-templates (make-hash)] - [require-for-labels (make-hash)] - [sub-identifier-binding-directives (make-hash)]) - (annotate-basic sexp - user-namespace - user-directory - phase-to-binders - phase-to-varrefs - phase-to-varsets - phase-to-tops - binding-inits - templrefs - module-lang-requires - phase-to-requires - sub-identifier-binding-directives) - (annotate-variables user-namespace - user-directory - phase-to-binders - phase-to-varrefs - phase-to-varsets - phase-to-tops - templrefs - module-lang-requires - phase-to-requires - sub-identifier-binding-directives) - (annotate-contracts sexp - (hash-ref phase-to-binders 0 (λ () (make-id-set 0))) - (hash-ref binding-inits 0 (λ () (make-id-set 0))) - binder+mods-binder) - (when print-extra-info? - (print-extra-info (list (list 'phase-to-binders phase-to-binders) - (list 'phase-to-varrefs phase-to-varrefs) - (list 'phase-to-varsets phase-to-varsets) - (list 'phase-to-tops phase-to-tops) - (list 'phase-to-requires phase-to-requires) - (list 'binding-inits binding-inits) - (list 'templrefs templrefs) - (list 'module-lang-requires module-lang-requires) - (list 'requires requires) - (list 'require-for-syntaxes require-for-syntaxes) - (list 'require-for-templates require-for-templates) - (list 'require-for-labels require-for-labels) - (list 'sub-identifier-binding-directives - sub-identifier-binding-directives)))))] + (define phase-to-binders (make-hash)) + (define phase-to-varrefs (make-hash)) + (define phase-to-varsets (make-hash)) + (define phase-to-tops (make-hash)) + (define phase-to-requires (make-hash)) + (define binding-inits (make-hash)) + (define templrefs (make-id-set 0)) + (define module-lang-requires (make-hash)) + (define requires (make-hash)) + (define require-for-syntaxes (make-hash)) + (define require-for-templates (make-hash)) + (define require-for-labels (make-hash)) + (define sub-identifier-binding-directives (make-hash)) + (annotate-basic sexp + user-namespace + user-directory + phase-to-binders + phase-to-varrefs + phase-to-varsets + phase-to-tops + binding-inits + templrefs + module-lang-requires + phase-to-requires + sub-identifier-binding-directives) + (annotate-variables user-namespace + user-directory + phase-to-binders + phase-to-varrefs + phase-to-varsets + phase-to-tops + templrefs + module-lang-requires + phase-to-requires + sub-identifier-binding-directives) + (annotate-contracts sexp + (hash-ref phase-to-binders 0 (λ () (make-id-set 0))) + (hash-ref binding-inits 0 (λ () (make-id-set 0))) + binder+mods-binder) + (when print-extra-info? + (print-extra-info (list (list 'phase-to-binders phase-to-binders) + (list 'phase-to-varrefs phase-to-varrefs) + (list 'phase-to-varsets phase-to-varsets) + (list 'phase-to-tops phase-to-tops) + (list 'phase-to-requires phase-to-requires) + (list 'binding-inits binding-inits) + (list 'templrefs templrefs) + (list 'module-lang-requires module-lang-requires) + (list 'requires requires) + (list 'require-for-syntaxes require-for-syntaxes) + (list 'require-for-templates require-for-templates) + (list 'require-for-labels require-for-labels) + (list 'sub-identifier-binding-directives + sub-identifier-binding-directives))))] [else (annotate-basic sexp user-namespace @@ -684,10 +684,7 @@ (vector-ref the-vec 8) (vector-ref the-vec 9))) (define key (list level mods)) - (hash-set! sub-identifier-binding-directives - key - (cons new-entry - (hash-ref sub-identifier-binding-directives key '())))] + (hash-update! sub-identifier-binding-directives key (λ (v) (cons new-entry v)) '())] [(vector? prop) (log-check-syntax-debug "found a vector in a 'sub-range-binders property that is ill-formed ~s" @@ -771,13 +768,13 @@ (for ([(k v) (in-hash requires)]) (hash-set! new-hash k #t))) - (for ([(level binders) (in-hash phase-to-binders)]) - (for ([(_ binder+modss) (in-dict binders)]) - (for ([binder+mods (in-list binder+modss)]) - (define var (binder+mods-binder binder+mods)) - (define varset (lookup-phase-to-mapping phase-to-varsets level)) - (color-variable var level varset) - (document-variable var level)))) + (for* ([(level binders) (in-hash phase-to-binders)] + [(_ binder+modss) (in-dict binders)] + [binder+mods (in-list binder+modss)]) + (define var (binder+mods-binder binder+mods)) + (define varset (lookup-phase-to-mapping phase-to-varsets level)) + (color-variable var level varset) + (document-variable var level)) (for ([(level+mods varrefs) (in-hash phase-to-varrefs)]) (define level (list-ref level+mods 0)) @@ -972,7 +969,7 @@ (define source-id (list-ref source-req-path/pr 1)) (define req-phase+space-shift (list-ref req-path/pr 3)) (define req-phase-level (if (pair? req-phase+space-shift) (car req-phase+space-shift) req-phase+space-shift)) - (define req-space (if (pair? req-phase+space-shift) (cdr req-phase+space-shift) #f)) + (define req-space (and (pair? req-phase+space-shift) (cdr req-phase+space-shift))) (define require-hash-key (list req-phase-level mods)) (define require-ht (hash-ref phase-to-requires require-hash-key #f)) (when id