new hash function names and ops (3.99.0.23)

svn: r9209

original commit: 021d4d7527f39cc01b6b8952f4a90e61e55e8956

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)

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

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)])

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 (rep=>num (make-hasheq)))
-    (field (obj=>rep (make-hash-table 'weak)))
+    (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))))

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)]
+    (let ([flat=>stx (make-hasheq)]
-          [stx=>flat (make-hash-table)])
+          [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-set! flat=>stx lp-datum obj)
-                 (hash-table-put! stx=>flat obj lp-datum)
+                 (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-set! flat=>stx lp-inner-datum inner)
-                      (hash-table-put! stx=>flat inner lp-inner-datum)
+                      (hash-set! stx=>flat inner lp-inner-datum)
-                      (hash-table-put! flat=>stx lp-datum obj)
+                      (hash-set! flat=>stx lp-datum obj)
-                      (hash-table-put! stx=>flat obj lp-datum)
+                      (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-set! flat=>stx lp-datum obj)
-                 (hash-table-put! stx=>flat obj lp-datum)
+                 (hash-set! stx=>flat obj lp-datum)
                  lp-datum)]
               [(pair? obj)
                (pairloop obj)]

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 starts (make-hasheq))
-    (define ranges (make-hash-table))
+    (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))))