From 28bef1d6c47e765923881fca2a8427228a41d47a 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 --- .../macro-debugger/model/reductions-engine.ss | 6 ++--- collects/macro-debugger/stepper-text.ss | 4 ++-- .../macro-debugger/syntax-browser/display.ss | 6 ++--- .../syntax-browser/partition.ss | 14 +++++------ .../syntax-browser/pretty-helper.ss | 22 ++++++++--------- .../syntax-browser/pretty-printer.ss | 24 +++++++++---------- 6 files changed, 38 insertions(+), 38 deletions(-) diff --git a/collects/macro-debugger/model/reductions-engine.ss b/collects/macro-debugger/model/reductions-engine.ss index ac2e9bf..df14820 100644 --- a/collects/macro-debugger/model/reductions-engine.ss +++ b/collects/macro-debugger/model/reductions-engine.ss @@ -394,10 +394,10 @@ (current-frontier)))))) (define (make-rename-mapping from0 to0) - (define table (make-hash-table)) + (define table (make-hasheq)) (let loop ([from from0] [to to0]) (cond [(syntax? from) - (hash-table-put! table from (flatten-syntaxes to)) + (hash-set! table from (flatten-syntaxes to)) (loop (syntax-e from) to)] [(syntax? to) (loop from (syntax-e to))] @@ -417,7 +417,7 @@ (loop (unbox from) (unbox to))] [else (void)])) (lambda (stx) - (let ([replacement (hash-table-get table stx #f)]) + (let ([replacement (hash-ref table stx #f)]) (if replacement (begin #;(printf " replacing ~s with ~s~n" stx replacement) replacement) diff --git a/collects/macro-debugger/stepper-text.ss b/collects/macro-debugger/stepper-text.ss index 36fb532..73c5776 100644 --- a/collects/macro-debugger/stepper-text.ss +++ b/collects/macro-debugger/stepper-text.ss @@ -78,7 +78,7 @@ (define-values (datum flat=>stx stx=>flat) (table stx partition 0 'always)) (define identifier-list - (filter identifier? (hash-table-map stx=>flat (lambda (k v) k)))) + (filter identifier? (hash-map stx=>flat (lambda (k v) k)))) (define (pp-size-hook obj display-like? port) (cond [(syntax-dummy? obj) (let ((ostring (open-output-string))) @@ -94,7 +94,7 @@ (error 'pretty-print-hook "unexpected special value: ~e" obj)])) (define (pp-extend-style-table) (let* ([ids identifier-list] - [syms (map (lambda (x) (hash-table-get stx=>flat x)) ids)] + [syms (map (lambda (x) (hash-ref stx=>flat x)) ids)] [like-syms (map syntax-e ids)]) (pretty-print-extend-style-table (pp-better-style-table) syms diff --git a/collects/macro-debugger/syntax-browser/display.ss b/collects/macro-debugger/syntax-browser/display.ss index e8c6ae5..626af87 100644 --- a/collects/macro-debugger/syntax-browser/display.ss +++ b/collects/macro-debugger/syntax-browser/display.ss @@ -26,7 +26,7 @@ (define start-anchor (new anchor-snip%)) (define end-anchor (new anchor-snip%)) (define range #f) - (define extra-styles (make-hash-table)) + (define extra-styles (make-hasheq)) ;; render-syntax : syntax -> void (define/public (render-syntax stx) @@ -79,14 +79,14 @@ ;; highlight-syntaxes : (list-of syntax) string -> void (define/public (highlight-syntaxes stxs hi-color) (let ([style-delta (highlight-style-delta hi-color #f)]) - (for-each (lambda (stx) (hash-table-put! extra-styles stx style-delta)) + (for-each (lambda (stx) (hash-set! extra-styles stx style-delta)) stxs)) (refresh)) ;; apply-extra-styles : -> void ;; Applies externally-added styles (such as highlighting) (define/private (apply-extra-styles) - (hash-table-for-each + (hash-for-each extra-styles (lambda (hi-stx style-delta) (let ([rs (send range get-ranges hi-stx)]) diff --git a/collects/macro-debugger/syntax-browser/partition.ss b/collects/macro-debugger/syntax-browser/partition.ss index 9c62aa8..54cb429 100644 --- a/collects/macro-debugger/syntax-browser/partition.ss +++ b/collects/macro-debugger/syntax-browser/partition.ss @@ -29,8 +29,8 @@ (init relation) (define related? (or relation (lambda (a b) #f))) - (field (rep=>num (make-hash-table))) - (field (obj=>rep (make-hash-table 'weak))) + (field (rep=>num (make-hasheq))) + (field (obj=>rep (make-weak-hasheq))) (field (reps null)) (field (next-num 0)) @@ -41,7 +41,7 @@ (= (get-partition A) (get-partition B))) (define/private (obj->rep obj) - (hash-table-get obj=>rep obj (lambda () (obj->rep* obj)))) + (hash-ref obj=>rep obj (lambda () (obj->rep* obj)))) (define/public (count) next-num) @@ -51,23 +51,23 @@ (cond [(null? reps) (new-rep obj)] [(related? obj (car reps)) - (hash-table-put! obj=>rep obj (car reps)) + (hash-set! obj=>rep obj (car reps)) (car reps)] [else (loop (cdr reps))]))) (define/private (new-rep rep) - (hash-table-put! rep=>num rep next-num) + (hash-set! rep=>num rep next-num) (set! next-num (add1 next-num)) (set! reps (cons rep reps)) rep) (define/private (rep->partition rep) - (hash-table-get rep=>num rep)) + (hash-ref rep=>num rep)) ;; Nearly useless as it stands (define/public (dump) - (hash-table-for-each + (hash-for-each rep=>num (lambda (k v) (printf "~s => ~s~n" k v)))) diff --git a/collects/macro-debugger/syntax-browser/pretty-helper.ss b/collects/macro-debugger/syntax-browser/pretty-helper.ss index 73bb361..c672a9a 100644 --- a/collects/macro-debugger/syntax-browser/pretty-helper.ss +++ b/collects/macro-debugger/syntax-browser/pretty-helper.ss @@ -57,10 +57,10 @@ (suffix (syntax-e id) n)))))) (let/ec escape - (let ([flat=>stx (make-hash-table)] - [stx=>flat (make-hash-table)]) + (let ([flat=>stx (make-hasheq)] + [stx=>flat (make-hasheq)]) (define (loop obj) - (cond [(hash-table-get stx=>flat obj (lambda _ #f)) + (cond [(hash-ref stx=>flat obj (lambda _ #f)) => (lambda (datum) datum)] [(and partition (identifier? obj)) (when (and (eq? suffixopt 'all-if-over-limit) @@ -68,8 +68,8 @@ (call-with-values (lambda () (table stx partition #f 'always)) escape)) (let ([lp-datum (make-identifier-proxy obj)]) - (hash-table-put! flat=>stx lp-datum obj) - (hash-table-put! stx=>flat obj lp-datum) + (hash-set! flat=>stx lp-datum obj) + (hash-set! stx=>flat obj lp-datum) lp-datum)] [(and (syntax? obj) (check+convert-special-expression obj)) => (lambda (newobj) @@ -77,16 +77,16 @@ (let* ([inner (cadr newobj)] [lp-inner-datum (loop inner)] [lp-datum (list (car newobj) lp-inner-datum)]) - (hash-table-put! flat=>stx lp-inner-datum inner) - (hash-table-put! stx=>flat inner lp-inner-datum) - (hash-table-put! flat=>stx lp-datum obj) - (hash-table-put! stx=>flat obj lp-datum) + (hash-set! flat=>stx lp-inner-datum inner) + (hash-set! stx=>flat inner lp-inner-datum) + (hash-set! flat=>stx lp-datum obj) + (hash-set! stx=>flat obj lp-datum) lp-datum))] [(syntax? obj) (when partition (send partition get-partition obj)) (let ([lp-datum (loop (syntax-e obj))]) - (hash-table-put! flat=>stx lp-datum obj) - (hash-table-put! stx=>flat obj lp-datum) + (hash-set! flat=>stx lp-datum obj) + (hash-set! stx=>flat obj lp-datum) lp-datum)] [(pair? obj) (pairloop obj)] diff --git a/collects/macro-debugger/syntax-browser/pretty-printer.ss b/collects/macro-debugger/syntax-browser/pretty-printer.ss index fd975d4..bc47431 100644 --- a/collects/macro-debugger/syntax-browser/pretty-printer.ss +++ b/collects/macro-debugger/syntax-browser/pretty-printer.ss @@ -21,11 +21,11 @@ (length (current-colors)) (current-suffix-option))) (define identifier-list - (filter identifier? (hash-table-map ht:stx=>flat (lambda (k v) k)))) + (filter identifier? (hash-map ht:stx=>flat (lambda (k v) k)))) (define (flat=>stx obj) - (hash-table-get ht:flat=>stx obj #f)) + (hash-ref ht:flat=>stx obj #f)) (define (stx=>flat stx) - (hash-table-get ht:stx=>flat stx)) + (hash-ref ht:stx=>flat stx)) (define (current-position) (let-values ([(line column position) (port-next-location port)]) (sub1 position))) @@ -112,20 +112,20 @@ ;; range-builder% (define range-builder% (class object% - (define starts (make-hash-table)) - (define ranges (make-hash-table)) + (define starts (make-hasheq)) + (define ranges (make-hasheq)) (define/public (set-start obj n) - (hash-table-put! starts obj n)) + (hash-set! starts obj n)) (define/public (get-start obj) - (hash-table-get starts obj (lambda _ #f))) + (hash-ref starts obj (lambda _ #f))) (define/public (add-range obj range) - (hash-table-put! ranges obj (cons range (get-ranges obj)))) + (hash-set! ranges obj (cons range (get-ranges obj)))) (define (get-ranges obj) - (hash-table-get ranges obj (lambda () null))) + (hash-ref ranges obj (lambda () null))) (define/public (range:get-ranges) ranges) @@ -138,10 +138,10 @@ (init-field identifier-list) (super-new) - (define ranges (hash-table-copy (send range-builder range:get-ranges))) + (define ranges (hash-copy (send range-builder range:get-ranges))) (define/public (get-ranges obj) - (hash-table-get ranges obj (lambda _ null))) + (hash-ref ranges obj (lambda _ null))) (define/public (all-ranges) sorted-ranges) @@ -152,7 +152,7 @@ (define sorted-ranges (sort (apply append - (hash-table-map + (hash-map ranges (lambda (k vs) (map (lambda (v) (make-range k (car v) (cdr v))) vs))))