From 721914ff90326fa82f2aefccffa229a9a2f53408 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 8 Apr 2008 21:42:38 +0000 Subject: [PATCH] new hash function names and ops (3.99.0.23) svn: r9209 original commit: 021d4d7527f39cc01b6b8952f4a90e61e55e8956 --- collects/framework/private/editor.ss | 13 ++++----- collects/framework/private/keymap.ss | 22 ++++++++-------- collects/framework/private/main.ss | 16 ++++++------ collects/framework/private/number-snip.ss | 12 ++++----- collects/framework/private/scheme.ss | 28 ++++++++++---------- collects/framework/private/text.ss | 12 ++++----- collects/mrlib/syntax-browser.ss | 32 +++++++++++------------ 7 files changed, 66 insertions(+), 69 deletions(-) diff --git a/collects/framework/private/editor.ss b/collects/framework/private/editor.ss index e176bc24..ea5e6e90 100644 --- a/collects/framework/private/editor.ss +++ b/collects/framework/private/editor.ss @@ -204,7 +204,7 @@ [else #f])))) [define edit-sequence-queue null] - [define edit-sequence-ht (make-hash-table)] + [define edit-sequence-ht (make-hasheq)] [define in-local-edit-sequence? #f] [define/public local-edit-sequence? (λ () in-local-edit-sequence?)] [define/public run-after-edit-sequence @@ -223,7 +223,7 @@ (if in-local-edit-sequence? (cond [(symbol? sym) - (hash-table-put! edit-sequence-ht sym t)] + (hash-set! edit-sequence-ht sym t)] [else (set! edit-sequence-queue (cons t edit-sequence-queue))]) (let ([snip-admin (get-admin)]) @@ -243,10 +243,7 @@ (void)])] [define/public extend-edit-sequence-queue (λ (l ht) - (hash-table-for-each ht (λ (k t) - (hash-table-put! - edit-sequence-ht - k t))) + (hash-for-each ht (λ (k t) (hash-set! edit-sequence-ht k t))) (set! edit-sequence-queue (append l edit-sequence-queue)))] (define/augment (on-edit-sequence) (set! in-local-edit-sequence? #t) @@ -263,7 +260,7 @@ (send (send (send admin get-snip) get-admin) get-editor)] [else #f])))]) (set! edit-sequence-queue null) - (set! edit-sequence-ht (make-hash-table)) + (set! edit-sequence-ht (make-hash)) (let loop ([editor (find-enclosing-editor this)]) (cond [(and editor @@ -274,7 +271,7 @@ (is-a? editor basic<%>)) (send editor extend-edit-sequence-queue queue ht)] [else - (hash-table-for-each ht (λ (k t) (t))) + (hash-for-each ht (λ (k t) (t))) (for-each (λ (t) (t)) queue)]))) (inner (void) after-edit-sequence)) diff --git a/collects/framework/private/keymap.ss b/collects/framework/private/keymap.ss index 37931480..9dfcf9f5 100644 --- a/collects/framework/private/keymap.ss +++ b/collects/framework/private/keymap.ss @@ -19,10 +19,10 @@ [-get-file get-file])) (init-depend mred^) - (define user-keybindings-files (make-hash-table 'equal)) + (define user-keybindings-files (make-hash)) (define (add-user-keybindings-file spec) - (hash-table-get + (hash-ref user-keybindings-files spec (λ () @@ -32,7 +32,7 @@ (match sexp [`(module ,name (lib "keybinding-lang.ss" "framework") ,@(x ...)) (let ([km (dynamic-require spec '#%keymap)]) - (hash-table-put! user-keybindings-files spec km) + (hash-set! user-keybindings-files spec km) (send global chain-to-keymap km #t))] [else (error 'add-user-keybindings-file (string-constant user-defined-keybinding-malformed-file) @@ -62,9 +62,9 @@ (define (remove-user-keybindings-file spec) (let/ec k - (let ([km (hash-table-get user-keybindings-files spec (λ () (k (void))))]) + (let ([km (hash-ref user-keybindings-files spec (λ () (k (void))))]) (send global remove-chained-keymap km) - (hash-table-remove! user-keybindings-files spec)))) + (hash-remove! user-keybindings-files spec)))) (define (remove-chained-keymap ed keymap-to-remove) (let ([ed-keymap (send ed get-keymap)]) @@ -116,23 +116,23 @@ (super remove-chained-keymap keymap) (set! chained-keymaps (remq keymap chained-keymaps))) - (define function-table (make-hash-table)) + (define function-table (make-hasheq)) (define/public (get-function-table) function-table) (define/override (map-function keyname fname) (super map-function (canonicalize-keybinding-string keyname) fname) - (hash-table-put! function-table (string->symbol keyname) fname)) + (hash-set! function-table (string->symbol keyname) fname)) (define/public (get-map-function-table) - (get-map-function-table/ht (make-hash-table))) + (get-map-function-table/ht (make-hasheq))) (define/public (get-map-function-table/ht table) - (hash-table-for-each + (hash-for-each function-table (λ (keyname fname) - (unless (hash-table-get table keyname (λ () #f)) + (unless (hash-ref table keyname (λ () #f)) (let ([cs (canonicalize-keybinding-string (format "~a" keyname))]) (when (on-this-platform? cs) - (hash-table-put! table keyname fname)))))) + (hash-set! table keyname fname)))))) (for-each (λ (chained-keymap) (when (is-a? chained-keymap aug-keymap<%>) diff --git a/collects/framework/private/main.ss b/collects/framework/private/main.ss index 8f051328..b4f061ff 100644 --- a/collects/framework/private/main.ss +++ b/collects/framework/private/main.ss @@ -167,12 +167,12 @@ (preferences:set-default 'framework:fixup-parens #t boolean?) (preferences:set-default 'framework:fixup-open-parens #t boolean?) (preferences:set-default 'framework:paren-match #t boolean?) - (let ([hash-table (make-hash-table)]) + (let ([hash-table (make-hasheq)]) (for-each (λ (x) - (hash-table-put! hash-table x 'define)) + (hash-set! hash-table x 'define)) '(local)) (for-each (λ (x) - (hash-table-put! hash-table x 'begin)) + (hash-set! hash-table x 'begin)) '(case-lambda match-lambda match-lambda* cond @@ -181,7 +181,7 @@ public private override inherit sequence)) (for-each (λ (x) - (hash-table-put! hash-table x 'lambda)) + (hash-set! hash-table x 'lambda)) '( cases instantiate super-instantiate @@ -225,11 +225,11 @@ (λ (x) (and (list? x) (= (length x) 4) - (hash-table? (car x)) + (hash? (car x)) (andmap (λ (x) (or (regexp? x) (not x))) (cdr x))))) (preferences:set-un/marshall 'framework:tabify - (λ (t) (cons (hash-table-map (car t) list) + (λ (t) (cons (hash-map (car t) list) (cdr t))) (λ (l) (and (list? l) @@ -240,8 +240,8 @@ (= 2 (length x)) (andmap symbol? x))) (car l)) - (let ([h (make-hash-table)]) - (for-each (λ (x) (apply hash-table-put! h x)) (car l)) + (let ([h (make-hasheq)]) + (for-each (λ (x) (apply hash-set! h x)) (car l)) (cons h (cdr l))))))) diff --git a/collects/framework/private/number-snip.ss b/collects/framework/private/number-snip.ss index 58e403ab..4de4dfdf 100644 --- a/collects/framework/private/number-snip.ss +++ b/collects/framework/private/number-snip.ss @@ -146,7 +146,7 @@ ;; digit and new divisor pairs. Use this ;; to read off the decimal expansion. (field - [ht (make-hash-table 'equal)] + [ht (make-hash)] [expansions 0]) ;; this field holds the state of the current computation @@ -223,11 +223,11 @@ (let-values ([(dig next-num) (one-step-division num)]) (if (zero? next-num) (begin - (hash-table-put! ht num (cons dig #t)) + (hash-set! ht num (cons dig #t)) (set! state #f) (set! repeat #f)) (begin - (hash-table-put! ht num (cons dig next-num)) + (hash-set! ht num (cons dig next-num)) (loop next-num (- counter 1)))))])))) ;; update-drawing-fields : -> void @@ -266,7 +266,7 @@ ;; extract-cycle : -> (listof digit) ;; pre: (number? repeat) (define/private (extract-cycle) - (let ([pr (hash-table-get ht repeat)]) + (let ([pr (hash-ref ht repeat)]) (cons (car pr) (extract-helper (cdr pr))))) @@ -278,7 +278,7 @@ (cond [(equal? ind repeat) null] [else - (let* ([iter (hash-table-get ht ind)] + (let* ([iter (hash-ref ht ind)] [dig (car iter)] [next-num (cdr iter)]) (cons dig @@ -515,5 +515,5 @@ ;; hash-table-bound? : hash-table TST -> boolean (define (hash-table-bound? ht key) (let/ec k - (hash-table-get ht key (λ () (k #f))) + (hash-ref ht key (λ () (k #f))) #t)) diff --git a/collects/framework/private/scheme.ss b/collects/framework/private/scheme.ss index d1706083..61efff1e 100644 --- a/collects/framework/private/scheme.ss +++ b/collects/framework/private/scheme.ss @@ -303,14 +303,14 @@ (define (xlate-sym-style sym) (case sym [(sexp-comment) 'comment] [else sym])) -(define sn-hash (make-hash-table)) +(define sn-hash (make-hasheq)) (define (short-sym->style-name sym) - (hash-table-get sn-hash sym - (λ () - (let ([s (format "framework:syntax-color:scheme:~a" - (xlate-sym-style sym))]) - (hash-table-put! sn-hash sym s) - s)))) + (hash-ref sn-hash sym + (λ () + (let ([s (format "framework:syntax-color:scheme:~a" + (xlate-sym-style sym))]) + (hash-set! sn-hash sym s) + s)))) (define (add-coloring-preferences-panel) (color-prefs:add-to-preferences-panel @@ -1171,7 +1171,7 @@ [beg-reg (cadr pref)] [def-reg (caddr pref)] [lam-reg (cadddr pref)]) - (hash-table-get + (hash-ref ht (with-handlers ((exn:fail:read? (λ (x) #f))) (read (open-input-string text))) @@ -1670,7 +1670,7 @@ (define (make-indenting-prefs-panel p) (define get-keywords (λ (hash-table) - (letrec ([all-keywords (hash-table-map hash-table list)] + (letrec ([all-keywords (hash-map hash-table list)] [pick-out (λ (wanted in out) (cond [(null? in) (sort out string<=?)] @@ -1696,15 +1696,15 @@ (read (open-input-string new-one)))]) (cond [(and (symbol? parsed) - (hash-table-get (car (preferences:get 'framework:tabify)) - parsed - (λ () #f))) + (hash-ref (car (preferences:get 'framework:tabify)) + parsed + (λ () #f))) (message-box (string-constant error) (format (string-constant already-used-keyword) parsed))] [(symbol? parsed) (let* ([pref (preferences:get 'framework:tabify)] [ht (car pref)]) - (hash-table-put! ht parsed keyword-symbol) + (hash-set! ht parsed keyword-symbol) (preferences:set 'framework:tabify pref) (update-list-boxes ht))] [else (message-box @@ -1718,7 +1718,7 @@ (for-each (λ (x) (send list-box delete x)) (reverse selections)) (let* ([pref (preferences:get 'framework:tabify)] [ht (car pref)]) - (for-each (λ (x) (hash-table-remove! ht x)) symbols) + (for-each (λ (x) (hash-remove! ht x)) symbols) (preferences:set 'framework:tabify pref)))))) (define main-panel (make-object horizontal-panel% p)) (define make-column diff --git a/collects/framework/private/text.ss b/collects/framework/private/text.ss index 200b5c49..c46f7a74 100644 --- a/collects/framework/private/text.ss +++ b/collects/framework/private/text.ss @@ -667,7 +667,7 @@ WARNING: printf is rebound in the body of the unit to always (let ([new-snip (instantiate small-version-of-snip% () (big-snip snip))]) - (hash-table-put! linked-snips snip new-snip) + (hash-set! linked-snips snip new-snip) new-snip)])]) (send new-snip set-flags (send snip get-flags)) (send new-snip set-style (send snip get-style)) @@ -679,7 +679,7 @@ WARNING: printf is rebound in the body of the unit to always (define/public-final (set-delegate _d) (set! delegate _d) (set! linked-snips (if _d - (make-hash-table) + (make-hasheq) #f)) (refresh-delegate)) @@ -758,7 +758,7 @@ WARNING: printf is rebound in the body of the unit to always (when (and delegate linked-snips (not (is-a? snip string-snip%))) - (let ([delegate-copy (hash-table-get linked-snips snip (λ () #f))]) + (let ([delegate-copy (hash-ref linked-snips snip (λ () #f))]) (when delegate-copy (send delegate resized delegate-copy redraw-now?))))) @@ -2815,7 +2815,7 @@ designates the character that triggers autocompletion (unless xref (set! xref (load-collections-xref))) - (let ([ht (make-hash-table 'equal)]) + (let ([ht (make-hash)]) (for-each (λ (entry) (let ([desc (entry-desc entry)]) @@ -2825,9 +2825,9 @@ designates the character that triggers autocompletion (when (or (not manual-mpis) (ormap (λ (from-lib) (memq from-lib manual-mpis)) (map sym->mpi (exported-index-desc-from-libs desc)))) - (hash-table-put! ht (symbol->string name) #t))))))) + (hash-set! ht (symbol->string name) #t))))))) (xref-index xref)) - (sort (hash-table-map ht (λ (x y) x)) string<=?)))) + (sort (hash-map ht (λ (x y) x)) string<=?)))) ;; ============================================================ ;; auto complete example code diff --git a/collects/mrlib/syntax-browser.ss b/collects/mrlib/syntax-browser.ss index 6cfc5f2f..795e1c81 100644 --- a/collects/mrlib/syntax-browser.ss +++ b/collects/mrlib/syntax-browser.ss @@ -68,10 +68,10 @@ needed to really make this work: (define info-port (make-text-port info-text)) ;; range-start-ht : hash-table[obj -o> number] - (define range-start-ht (make-hash-table)) + (define range-start-ht (make-hasheq)) ;; range-ht : hash-table[obj -o> (listof (cons number number))] - (define range-ht (make-hash-table)) + (define range-ht (make-hasheq)) (define/private (make-modern text) (send text change-style @@ -91,10 +91,10 @@ needed to really make this work: (define/private (syntax-object->datum/record-paths val) (set! path '()) (set! next-push 0) - (let* ([ht (make-hash-table 'equal)] + (let* ([ht (make-hash)] [record (λ (val enclosing-stx) - (hash-table-put! ht path enclosing-stx))]) + (hash-set! ht path enclosing-stx))]) (values (let loop ([val val] [enclosing-stx #f]) @@ -136,21 +136,21 @@ needed to really make this work: (let* ([range-pretty-print-pre-hook (λ (x port) (push!) - (let ([stx-object (hash-table-get paths-ht path (λ () #f))]) - (hash-table-put! range-start-ht stx-object (send output-text last-position))))] + (let ([stx-object (hash-ref paths-ht path (λ () #f))]) + (hash-set! range-start-ht stx-object (send output-text last-position))))] [range-pretty-print-post-hook (λ (x port) - (let ([stx-object (hash-table-get paths-ht path (λ () #f))]) + (let ([stx-object (hash-ref paths-ht path (λ () #f))]) (when stx-object - (let ([range-start (hash-table-get range-start-ht stx-object (λ () #f))]) + (let ([range-start (hash-ref range-start-ht stx-object (λ () #f))]) (when range-start - (hash-table-put! range-ht - stx-object - (cons - (cons - range-start - (send output-text last-position)) - (hash-table-get range-ht stx-object (λ () null)))))))) + (hash-set! range-ht + stx-object + (cons + (cons + range-start + (send output-text last-position)) + (hash-ref range-ht stx-object (λ () null)))))))) (pop!))]) ;; reset `path' and `next-push' for use in pp hooks. @@ -338,7 +338,7 @@ needed to really make this work: (let ([ranges (sort (apply append - (hash-table-map + (hash-map range-ht (λ (k vs) (map (λ (v) (make-range k (car v) (cdr v)))