suzanne.soy/macro-debugger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

new hash function names and ops (3.99.0.23)

Browse Source 
svn: r9209

original commit: 021d4d7527f39cc01b6b8952f4a90e61e55e8956
This commit is contained in:
Matthew Flatt 2008-04-08 21:42:38 +00:00
parent b5e5c83b91
commit 28bef1d6c4
6 changed files with 38 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
collects/macro-debugger/model/reductions-engine.ss
View File

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

4
collects/macro-debugger/stepper-text.ss
View File

@ -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

6
collects/macro-debugger/syntax-browser/display.ss
View File

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

14
collects/macro-debugger/syntax-browser/partition.ss
View File

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

22
collects/macro-debugger/syntax-browser/pretty-helper.ss
View File

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

24
collects/macro-debugger/syntax-browser/pretty-printer.ss
View File

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