diff --git a/collects/tests/stress/racket/dict.rkt b/collects/tests/stress/racket/dict.rkt new file mode 100644 index 0000000000..780239a73b --- /dev/null +++ b/collects/tests/stress/racket/dict.rkt @@ -0,0 +1,114 @@ +#lang racket +(require tests/stress/stress) + +(define (make-random-hash-table n) + (for/hasheq ([i (in-range n)]) + (values i (random n)))) + +; dict-keys, dict-values, dict->list +(local [(define ht (make-random-hash-table 100000))] + (stress 20 + ["for/list, in-dict-keys" + (for/list ([k (in-dict-keys ht)]) + k)] + ["dict-keys" + (dict-keys ht)]) + + (stress 20 + ["for/list, in-dict-values" + (for/list ([v (in-dict-values ht)]) + v)] + ["dict-values" + (dict-values ht)]) + + (stress 20 + ["for/list, in-dict" + (for/list ([(k v) (in-dict ht)]) + (cons k v))] + ["for/list, in-dict-pairs" + (for/list ([p (in-dict-pairs ht)]) + p)] + ["dict->list" + (dict->list ht)])) + +; dict-set* +(local [(define ht (hasheq)) + (define-syntax (inlined-dict-set* stx) + (syntax-case stx () + [(_ ht 0) #'ht] + [(_ ht n) #`(dict-set (inlined-dict-set* ht #,(sub1 (syntax->datum #'n))) n #f)])) + (define-syntax (fun-dict-set* stx) + (syntax-case stx () + [(_ ht n) + #`(dict-set* ht #,@(apply append + (for/list ([i (in-range (syntax->datum #'n))]) + (list i #f))))]))] + (stress + 20 + ["inlined, dict-set*" + (inlined-dict-set* ht 4000)] + ["for/fold, dict-set*" + (for/fold ([ht ht]) + ([i (in-range 4000)]) + (dict-set ht i #f))] + ["dict-set*" + (fun-dict-set* ht 4000)])) + +; dict-set*! +(local [(define ht (make-hasheq)) + (define-syntax (inlined-dict-set*! stx) + (syntax-case stx () + [(_ ht 0) #'(void)] + [(_ ht n) #`(begin (inlined-dict-set*! ht #,(sub1 (syntax->datum #'n))) (dict-set! ht n #f))])) + (define-syntax (fun-dict-set*! stx) + (syntax-case stx () + [(_ ht n) + #`(dict-set*! ht #,@(apply append + (for/list ([i (in-range (syntax->datum #'n))]) + (list i #f))))]))] + (stress + 20 + ["inlined dict-set*!" + (inlined-dict-set*! ht 4000)] + ["for, dict-set*!" + (for ([i (in-range 4000)]) + (dict-set! ht i #f))] + ["dict-set*!" + (fun-dict-set*! ht 4000)])) + +; dict-ref! +(local [(define ht (make-hasheq (list (cons 1 #f))))] + (stress + 200 + ["hash-ref! (present)" + (hash-ref! ht 1 #t)] + ["dict-ref! (present)" + (dict-ref! ht 1 #t)])) + +; XXX dict-ref! is clearly slower +(local [] + (stress + 200 + ["hash-ref! (not present)" + (hash-ref! (make-hasheq (list (cons 1 #f))) 2 #t)] + ["dict-ref! (not present)" + (dict-ref! (make-hasheq (list (cons 1 #f))) 2 #t)])) + +; dict-has-key? +; XXX dict functions are slower +(local [(define ht (make-hasheq (list (cons 1 #f))))] + (stress + 200 + ["hash-has-key? (present)" + (hash-has-key? ht 1)] + ["dict-has-key? (present)" + (dict-has-key? ht 1)])) + +(local [(define ht (make-hasheq (list (cons 1 #f))))] + (stress + 200 + ["hash-has-key? (not present)" + (hash-has-key? ht 2)] + ["dict-has-key? (not present)" + (dict-has-key? ht 2)])) + diff --git a/collects/tests/stress/racket/hash.rkt b/collects/tests/stress/racket/hash.rkt new file mode 100644 index 0000000000..cac1c7c137 --- /dev/null +++ b/collects/tests/stress/racket/hash.rkt @@ -0,0 +1,76 @@ +#lang racket +(require tests/stress/stress) + +(define (make-random-hash-table n) + (for/hasheq ([i (in-range n)]) + (values i (random n)))) + +; hash-keys, hash-values, hash->list +(local [(define ht (make-random-hash-table 100000))] + (stress 20 + ["for/list, in-hash-keys" + (for/list ([k (in-hash-keys ht)]) + k)] + ["hash-keys" + (hash-keys ht)]) + + (stress 20 + ["for/list, in-hash-values" + (for/list ([v (in-hash-values ht)]) + v)] + ["hash-values" + (hash-values ht)]) + + (stress 20 + ["for/list, in-hash" + (for/list ([(k v) (in-hash ht)]) + (cons k v))] + ["hash->list" + (hash->list ht)])) + +; hash-set* +(local [(define ht (hasheq)) + (define-syntax (inlined-hash-set* stx) + (syntax-case stx () + [(_ ht 0) #'ht] + [(_ ht n) #`(hash-set (inlined-hash-set* ht #,(sub1 (syntax->datum #'n))) n #f)])) + (define-syntax (fun-hash-set* stx) + (syntax-case stx () + [(_ ht n) + #`(hash-set* ht #,@(apply append + (for/list ([i (in-range (syntax->datum #'n))]) + (list i #f))))]))] + (stress + 20 + ["inlined, hash-set*" + (inlined-hash-set* ht 4000)] + ["for/fold, hash-set*" + (for/fold ([ht ht]) + ([i (in-range 4000)]) + (hash-set ht i #f))] + ["hash-set*" + (fun-hash-set* ht 4000)])) + +; hash-set*! +(local [(define ht (make-hasheq)) + (define-syntax (inlined-hash-set*! stx) + (syntax-case stx () + [(_ ht 0) #'(void)] + [(_ ht n) #`(begin (inlined-hash-set*! ht #,(sub1 (syntax->datum #'n))) (hash-set! ht n #f))])) + (define-syntax (fun-hash-set*! stx) + (syntax-case stx () + [(_ ht n) + #`(hash-set*! ht #,@(apply append + (for/list ([i (in-range (syntax->datum #'n))]) + (list i #f))))]))] + (stress + 20 + ["inlined hash-set*!" + (inlined-hash-set*! ht 4000)] + ["for, hash-set*!" + (for ([i (in-range 4000)]) + (hash-set! ht i #f))] + ["hash-set*!" + (fun-hash-set*! ht 4000)])) + + diff --git a/collects/tests/stress/racket/sequence.rkt b/collects/tests/stress/racket/sequence.rkt new file mode 100644 index 0000000000..c116d10dee --- /dev/null +++ b/collects/tests/stress/racket/sequence.rkt @@ -0,0 +1,113 @@ +#lang racket +(require tests/stress/stress) + +; seqn-first +; This ignores the greater flexiblity of seqn-first to have more than single-valued sequences +(stress + 200 + ["seqn-first" + (seqn-first (in-naturals))] + ["for/or (val)" + (define s (in-naturals)) + (for/or ([n s]) + n)] + ["for/or" + (for/or ([n (in-naturals)]) + n)]) + +; seqn-length +; The for/fold must be rewritten slightly differently for multi-valued +(stress + 20 + ["seqn-length" + (seqn-length (in-range 2000))] + ["for/fold (val)" + (define s (in-range 2000)) + (for/fold ([len 0]) + ([i s]) + (add1 len))] + ["for/fold" + (for/fold ([len 0]) + ([i (in-range 2000)]) + (add1 len))]) + +; seqn-ref +; Ditto +(stress + 20 + ["seqn-ref" + (seqn-ref (in-range 2000) 200)] + ["for/or val" + (define s (in-range 2000)) + (for/or ([e s] + [i (in-naturals)] + #:when (i . = . 199)) + e)] + ["for/or" + (for/or ([e (in-range 2000)] + [i (in-naturals)] + #:when (i . = . 199)) + e)]) + +; seqn-andmap +; ditto +(stress + 20 + ["seqn-andmap" + (seqn-andmap number? (in-range 2000))] + ["for/and val" + (define s (in-range 2000)) + (for/and ([e s]) + (number? e))] + ["for/and" + (for/and ([e (in-range 2000)]) + (number? e))]) + +; seqn-ormap +; ditto +(stress + 20 + ["seqn-ormap" + (seqn-ormap string? (in-range 2000))] + ["for/and val" + (define s (in-range 2000)) + (for/or ([e s]) + (string? e))] + ["for/and" + (for/or ([e (in-range 2000)]) + (string? e))]) + +; seqn-fold +; The for/fold must be rewritten slightly differently for multi-valued +(stress + 20 + ["seqn-fold" + (seqn-fold + 0 (in-range 2000))] + ["for/fold (val)" + (define s (in-range 2000)) + (for/fold ([sum 0]) + ([i s]) + (+ i sum))] + ["for/fold" + (for/fold ([sum 0]) + ([i (in-range 2000)]) + (+ i sum))]) + +; seqn-count +; The for/fold must be rewritten slightly differently for multi-valued +(stress + 20 + ["seqn-count" + (seqn-count even? (in-range 2000))] + ["for/fold (val)" + (define s (in-range 2000)) + (for/fold ([num 0]) + ([i s] + #:when (even? i)) + (add1 num))] + ["for/fold" + (for/fold ([num 0]) + ([i (in-range 2000)] + #:when (even? i)) + (add1 num))]) + diff --git a/collects/tests/stress/racket/vector.rkt b/collects/tests/stress/racket/vector.rkt new file mode 100644 index 0000000000..a5cd79b161 --- /dev/null +++ b/collects/tests/stress/racket/vector.rkt @@ -0,0 +1,32 @@ +#lang racket +(require tests/stress/stress + racket/unsafe/ops) + +; vector-set*! +(local [(define vec (make-vector 8001 #t)) + (define-syntax (inlined-vector-set*! stx) + (syntax-case stx () + [(_ vec 0) #'(void)] + [(_ vec n) #`(begin (inlined-vector-set*! vec #,(sub1 (syntax->datum #'n))) (vector-set! vec n #f))])) + (define-syntax (fun-vector-set*! stx) + (syntax-case stx () + [(_ vec n) + #`(vector-set*! vec #,@(apply append + (for/list ([i (in-range (syntax->datum #'n))]) + (list i #f))))]))] + (stress + 20 + ; XXX if there was an unsafe-vector-set!/bounds, we could test vector? once + ["inlined vector-set*!" + (inlined-vector-set*! vec 8000)] + ["for, vector-set!" + (for ([i (in-range 8000)]) + (vector-set! vec i #f))] + ["for, unsafe-vector-set!" + (for ([i (in-range 8000)]) + (unsafe-vector-set! vec i #f))] + ["for, unsafe-vector*-set!" + (for ([i (in-range 8000)]) + (unsafe-vector*-set! vec i #f))] + ["vector-set*!" + (fun-vector-set*! vec 8000)])) diff --git a/collects/tests/stress/stress.rkt b/collects/tests/stress/stress.rkt new file mode 100644 index 0000000000..b0f30131bf --- /dev/null +++ b/collects/tests/stress/stress.rkt @@ -0,0 +1,46 @@ +#lang racket +(provide stress) + +(define-syntax-rule (stress trials-expr [label body ...] ...) + (stress* trials-expr + (cons label (λ () body ...)) + ...)) + +(define (cumulative-average ca x i) + (+ ca (/ (- x ca) (add1 i)))) + +(define (run-experiment how-many exp) + (match-define (cons label thunk) exp) + (define-values + (cpu real gc) + (for/fold ([cpu0 0.0] + [real0 0.0] + [gc0 0.0]) + ([trial-n (in-range how-many)]) + (define exp-cust (make-custodian)) + (define-values (_ cpu1 real1 gc1) + (parameterize ([current-custodian exp-cust]) + (time-apply thunk empty))) + (custodian-shutdown-all exp-cust) + (when (zero? (modulo trial-n 5)) + (collect-garbage) (collect-garbage)) + (values (cumulative-average cpu0 cpu1 trial-n) + (cumulative-average real0 real1 trial-n) + (cumulative-average gc0 gc1 trial-n)))) + (vector label cpu real gc)) + +(define (stress* how-many . experiments) + (stress-display + how-many + (sort + (for/list ([exp (in-list experiments)]) + (run-experiment how-many exp)) + <= + #:key (λ (v) (vector-ref v 1))))) + +(define (stress-display how-many res) + (for ([v (in-list res)]) + (match-define (vector label cpu real gc) v) + (printf "~a: cpu time: ~a real time: ~a gc time: ~a (averaged over ~a runs)\n" + label cpu real gc how-many)) + (newline)) \ No newline at end of file