From c44c8b9cc0e1dd301dd888c1c4d59c7389a418c4 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 16 Nov 2018 16:53:54 -0700 Subject: [PATCH] cs: implement best-effort-ordered hash table traversal --- pkgs/racket-test-core/tests/racket/fasl.rktl | 7 ++++-- racket/src/cs/rumble/hash.ss | 24 ++++++++++++++++---- 2 files changed, 25 insertions(+), 6 deletions(-) diff --git a/pkgs/racket-test-core/tests/racket/fasl.rktl b/pkgs/racket-test-core/tests/racket/fasl.rktl index 11078b0f0a..ca74504425 100644 --- a/pkgs/racket-test-core/tests/racket/fasl.rktl +++ b/pkgs/racket-test-core/tests/racket/fasl.rktl @@ -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))) diff --git a/racket/src/cs/rumble/hash.ss b/racket/src/cs/rumble/hash.ss index ab25f2dbd9..7a4417ec0e 100644 --- a/racket/src/cs/rumble/hash.ss +++ b/racket/src/cs/rumble/hash.ss @@ -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