Expanding stress library

collects/tests/stress/racket/vector.rkt

@@ -3,17 +3,18 @@
          racket/unsafe/ops)
 
 ; vector-set*!
-(local [(define vec (make-vector 8001 #t))
+(define-syntax (inlined-vector-set*! stx)
-        (define-syntax (inlined-vector-set*! stx)
+  (syntax-case stx ()
-          (syntax-case stx ()
+    [(_ vec 0) #'(void)]
-            [(_ vec 0) #'(void)]
+    [(_ vec n) #`(begin (inlined-vector-set*! vec #,(sub1 (syntax->datum #'n))) (vector-set! vec n #f))]))
-            [(_ vec n) #`(begin (inlined-vector-set*! vec #,(sub1 (syntax->datum #'n))) (vector-set! vec n #f))]))
+(define-syntax (fun-vector-set*! stx)
-        (define-syntax (fun-vector-set*! stx)
+  (syntax-case stx ()
-          (syntax-case stx ()
+    [(_ vec n)
-            [(_ vec n)
+     #`(vector-set*! vec #,@(apply append
-             #`(vector-set*! vec #,@(apply append
+                                   (for/list ([i (in-range (syntax->datum #'n))])
-                                       (for/list ([i (in-range (syntax->datum #'n))])
+                                     (list i #f))))]))
-                                         (list i #f))))]))]
+
+(local [(define vec (make-vector 8001 #t))]
   (stress
    20
    ; XXX if there was an unsafe-vector-set!/bounds, we could test vector? once
@@ -30,3 +31,12 @@
       (unsafe-vector*-set! vec i #f))]
    ["vector-set*!"
     (fun-vector-set*! vec 8000)]))
+
+(fit "vector-set*!"
+     80000
+     (λ (n)
+       (define vec (make-vector n #t))
+       (apply vector-set*! vec
+              (for/fold ([l empty])
+                ([i (in-range n)])
+                (list* i #f l)))))

collects/tests/stress/stress.rkt

@@ -1,5 +1,31 @@
 #lang racket
-(provide stress)
+(provide stress
+         fit)
+
+(define (fit label max f #:slices [slices 20])
+  (fit-display
+   label
+   (for/list ([slice-n (in-range 1 (add1 slices))])
+     (define i (round (* slice-n (/ max slices))))
+     (define-values (cpu real gc)
+       (isolate slice-n (λ () (f i))))
+     (collect-garbage) (collect-garbage)
+     (vector i cpu))))
+
+(define (fit-display label l)
+  (define baseline (vector-ref (findf (λ (v) (not (zero? (vector-ref v 1)))) l) 1))
+  (printf "~a: baseline = ~a\n" label baseline)
+  (for ([v (in-list l)])
+    (match-define (vector n val) v)
+    (printf "\t~a: ~ax\n" n (/ val baseline))))
+
+(define (isolate trial-n thunk)
+  (define exp-cust (make-custodian))
+  (define-values (_ cpu real gc) 
+    (parameterize ([current-custodian exp-cust])
+      (time-apply thunk empty)))
+  (custodian-shutdown-all exp-cust)
+  (values cpu real gc))
 
 (define-syntax-rule (stress trials-expr [label body ...] ...)
   (stress* trials-expr
@@ -17,11 +43,8 @@
                [real0 0.0]
                [gc0 0.0])
       ([trial-n (in-range how-many)])
-      (define exp-cust (make-custodian))
+      (define-values (cpu1 real1 gc1)
-      (define-values (_ cpu1 real1 gc1) 
+        (isolate trial-n thunk))
-        (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)
@@ -32,15 +55,17 @@
 (define (stress* how-many . experiments)
   (stress-display
    how-many
-   (sort 
+   (sort-experiments 
     (for/list ([exp (in-list experiments)])
-      (run-experiment how-many exp))
+      (run-experiment how-many exp)))))
-    <=
+
-    #:key (λ (v) (vector-ref v 1)))))
+(define (sort-experiments l)
+  (sort l <=
+        #: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"
+    (printf "~a: cpu: ~a real: ~a gc: ~a (averaged over ~a runs)\n"
             label cpu real gc how-many))
   (newline))