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

cs: implement best-effort-ordered hash table traversal

Browse Source
This commit is contained in:
Matthew Flatt 2018-11-16 16:53:54 -07:00
parent a6e37fc947
commit c44c8b9cc0
2 changed files with 25 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
pkgs/racket-test-core/tests/racket/fasl.rktl
View File

@ -29,16 +29,19 @@
43/100
44+100i
45.0+100.0i
46f0
;; 46f0 <- test separately, because RacketCS doesn't support single-precision
(srcloc "x" 1 2 3 4)))
;; The fasl format is meant to be forward-compatible:
(define immutables-regression-bstr
#"racket/fasl:\0\200\"\1\34$n\4\3\6\ao\r2\16\5three\23\4four\25\4five\21\3six\"u \3vwx\36yz\35\2{|\16\afifteen%\1\2\16\bnineteen\200\16\asixteen\177%\0\2\202\23\ntwenty-one\204\23\ftwenty-three%\2\2\206\207\210\211#\16\ftwenty-eight\3\213\214\23\00231\b\340\b\200\344\f\b\201\320\204\0\0\b\2010W\5\0\b\201\200\3566\0\b\201\200\300\r\26\b\202\0\374\371\330\b\0\0\0\b\202\0`v\363\263b\1\0\b\202\0\0\220\235\316\332\2027\b\203\25cd4a0619fb0907bc00000\t\0\0\0\0\0\200D@\t\315\314\314\314\314\314\20@\v\231\322\f\232\322\f\t\0\0\0\0\0\200F@\t\0\0\0\0\0\0Y@\n\0\08B\34\6\16\6srcloc\23\1xopqr")
#"racket/fasl:\0\200\35\1\34#n\4\3\6\ao\r2\16\5three\23\4four\25\4five\21\3six\"u \3vwx\36yz\35\2{|\16\afifteen%\1\2\16\bnineteen\200\16\asixteen\177%\0\2\202\23\ntwenty-one\204\23\ftwenty-three%\2\2\206\207\210\211#\16\ftwenty-eight\3\213\214\23\00231\b\340\b\200\344\f\b\201\320\204\0\0\b\2010W\5\0\b\201\200\3566\0\b\201\200\300\r\26\b\202\0\374\371\330\b\0\0\0\b\202\0`v\363\263b\1\0\b\202\0\0\220\235\316\332\2027\b\203\25cd4a0619fb0907bc00000\t\0\0\0\0\0\200D@\t\315\314\314\314\314\314\20@\v\231\322\f\232\322\f\t\0\0\0\0\0\200F@\t\0\0\0\0\0\0Y@\34\6\16\6srcloc\23\1xopqr")
(for ([i (in-list immutables)])
(test i fasl->s-exp (s-exp->fasl i)))
(test 46f0 fasl->s-exp (s-exp->fasl 46f0))
(test (vector #t 46f0) fasl->s-exp (s-exp->fasl (vector #t 46f0)))
(test immutables fasl->s-exp (s-exp->fasl immutables))
(test (list immutables immutables) fasl->s-exp (s-exp->fasl (list immutables immutables)))

24
racket/src/cs/rumble/hash.ss
View File

@ -282,6 +282,9 @@
(check who hash? ht)
(check who (procedure-arity-includes/c 2) proc)
(cond
[try-order?
(for-each (lambda (p) (proc (car p) (cdr p)))
(try-sort-keys (hash-map ht cons)))]
[(intmap? ht) (intmap-for-each ht proc)]
[else
;; mutable, impersonated, and weak-equal:
@ -293,10 +296,14 @@
(define/who hash-map
(case-lambda
[(ht proc)
[(ht proc) (hash-map ht proc #f)]
[(ht proc try-order?)
(check who hash? ht)
(check who (procedure-arity-includes/c 2) proc)
(cond
[try-order?
(map (lambda (p) (proc (car p) (cdr p)))
(try-sort-keys (hash-map ht cons)))]
[(intmap? ht) (intmap-map ht proc)]
[else
;; mutable, impersonated, and weak-equal:
@ -306,9 +313,18 @@
(cons
(let-values ([(key val) (hash-iterate-key+value ht i)])
(|#%app| proc key val))
(loop (hash-iterate-next ht i)))))])]
[(ht proc try-order?)
(hash-map ht proc)]))
(loop (hash-iterate-next ht i)))))])]))
;; In sorted hash-table travesals, make some effort to sort the key.
;; This attempt is useful for making hash-table traversals more
;; deterministic, especially for marshaling operations.
(define (try-sort-keys ps)
(cond
[(#%andmap (lambda (p) (symbol? (car p))) ps)
(#%list-sort (lambda (a b) (symbol<? (car a) (car b))) ps)]
[(#%andmap (lambda (p) (real? (car p))) ps)
(#%list-sort (lambda (a b) (< (car a) (car b))) ps)]
[else ps]))
(define (hash-count ht)
(cond