author | Tony Garnock-Jones <tonygarnockjones@gmail.com> |
Wed, 16 Jan 2019 17:15:58 +0000 | |
changeset 438 | 1fe179d53161 |
parent 412 | e2a28341786a |
permissions | -rw-r--r-- |
390
bfd7d4e7f498
Crude measurement of techniques for patching functions.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
1 |
#lang racket |
bfd7d4e7f498
Crude measurement of techniques for patching functions.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
2 |
;; Crude measurement of techniques for patching functions during runtime. |
bfd7d4e7f498
Crude measurement of techniques for patching functions.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
3 |
;; |
bfd7d4e7f498
Crude measurement of techniques for patching functions.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
4 |
;; 2018-07-17 13:25:34 With Racket v6.90, unboxing is superior to |
bfd7d4e7f498
Crude measurement of techniques for patching functions.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
5 |
;; case-lambda; unboxing is only about 5% slower than not being able |
bfd7d4e7f498
Crude measurement of techniques for patching functions.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
6 |
;; to update the function at all. |
bfd7d4e7f498
Crude measurement of techniques for patching functions.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
7 |
|
bfd7d4e7f498
Crude measurement of techniques for patching functions.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
8 |
(define-namespace-anchor ns-anchor) |
bfd7d4e7f498
Crude measurement of techniques for patching functions.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
9 |
(define ns (namespace-anchor->namespace ns-anchor)) |
bfd7d4e7f498
Crude measurement of techniques for patching functions.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
10 |
|
391
1d4b8c5e18a4
See what automatically invalidating stale procedures might cost.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
390
diff
changeset
|
11 |
(define epoch 0) |
1d4b8c5e18a4
See what automatically invalidating stale procedures might cost.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
390
diff
changeset
|
12 |
|
412
e2a28341786a
Measure unboxing via a struct mutable field
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
393
diff
changeset
|
13 |
(struct quasi-box ([contents #:mutable])) |
e2a28341786a
Measure unboxing via a struct mutable field
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
393
diff
changeset
|
14 |
|
390
bfd7d4e7f498
Crude measurement of techniques for patching functions.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
15 |
(define (main) |
bfd7d4e7f498
Crude measurement of techniques for patching functions.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
16 |
(define N 50000000) |
bfd7d4e7f498
Crude measurement of techniques for patching functions.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
17 |
|
bfd7d4e7f498
Crude measurement of techniques for patching functions.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
18 |
(define (by-immutable) |
bfd7d4e7f498
Crude measurement of techniques for patching functions.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
19 |
(define f (eval '(lambda (x) (+ x 1)) ns)) |
bfd7d4e7f498
Crude measurement of techniques for patching functions.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
20 |
(for/fold [(x 0)] [(n (in-range N))] (f x))) |
bfd7d4e7f498
Crude measurement of techniques for patching functions.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
21 |
|
393
a8aa9b77e495
More bm-box.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
391
diff
changeset
|
22 |
;; (printf "by-immutable\n") |
a8aa9b77e495
More bm-box.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
391
diff
changeset
|
23 |
;; (for [(i 5)] (time (by-immutable))) |
a8aa9b77e495
More bm-box.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
391
diff
changeset
|
24 |
;; (newline) |
390
bfd7d4e7f498
Crude measurement of techniques for patching functions.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
25 |
|
bfd7d4e7f498
Crude measurement of techniques for patching functions.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
26 |
(define (by-unboxing) |
bfd7d4e7f498
Crude measurement of techniques for patching functions.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
27 |
(define f (eval '(box (lambda (x) (+ x 1))) ns)) |
bfd7d4e7f498
Crude measurement of techniques for patching functions.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
28 |
(for/fold [(x 0)] [(n (in-range N))] ((unbox f) x))) |
bfd7d4e7f498
Crude measurement of techniques for patching functions.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
29 |
|
393
a8aa9b77e495
More bm-box.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
391
diff
changeset
|
30 |
(printf "by-unboxing\n") |
390
bfd7d4e7f498
Crude measurement of techniques for patching functions.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
31 |
(for [(i 5)] (time (by-unboxing))) |
bfd7d4e7f498
Crude measurement of techniques for patching functions.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
32 |
(newline) |
bfd7d4e7f498
Crude measurement of techniques for patching functions.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
33 |
|
bfd7d4e7f498
Crude measurement of techniques for patching functions.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
34 |
(define (by-embedding) |
bfd7d4e7f498
Crude measurement of techniques for patching functions.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
35 |
(define f (eval '(let ((inner-f (lambda (x) (+ x 1)))) |
bfd7d4e7f498
Crude measurement of techniques for patching functions.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
36 |
(case-lambda |
bfd7d4e7f498
Crude measurement of techniques for patching functions.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
37 |
[() (lambda (new-f) (set! inner-f new-f))] |
bfd7d4e7f498
Crude measurement of techniques for patching functions.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
38 |
[(x) (inner-f x)])) |
bfd7d4e7f498
Crude measurement of techniques for patching functions.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
39 |
ns)) |
bfd7d4e7f498
Crude measurement of techniques for patching functions.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
40 |
(for/fold [(x 0)] [(n (in-range N))] (f x))) |
bfd7d4e7f498
Crude measurement of techniques for patching functions.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
41 |
|
393
a8aa9b77e495
More bm-box.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
391
diff
changeset
|
42 |
;; (printf "by-embedding\n") |
a8aa9b77e495
More bm-box.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
391
diff
changeset
|
43 |
;; (for [(i 5)] (time (by-embedding))) |
a8aa9b77e495
More bm-box.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
391
diff
changeset
|
44 |
;; (newline) |
391
1d4b8c5e18a4
See what automatically invalidating stale procedures might cost.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
390
diff
changeset
|
45 |
|
412
e2a28341786a
Measure unboxing via a struct mutable field
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
393
diff
changeset
|
46 |
(define (by-unboxing-via-struct) |
e2a28341786a
Measure unboxing via a struct mutable field
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
393
diff
changeset
|
47 |
(define f (eval '(quasi-box (lambda (x) (+ x 1))) ns)) |
e2a28341786a
Measure unboxing via a struct mutable field
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
393
diff
changeset
|
48 |
(for/fold [(x 0)] [(n (in-range N))] ((quasi-box-contents f) x))) |
e2a28341786a
Measure unboxing via a struct mutable field
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
393
diff
changeset
|
49 |
|
e2a28341786a
Measure unboxing via a struct mutable field
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
393
diff
changeset
|
50 |
(printf "by-unboxing-via-struct\n") |
e2a28341786a
Measure unboxing via a struct mutable field
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
393
diff
changeset
|
51 |
(for [(i 5)] (time (by-unboxing-via-struct))) |
e2a28341786a
Measure unboxing via a struct mutable field
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
393
diff
changeset
|
52 |
(newline) |
e2a28341786a
Measure unboxing via a struct mutable field
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
393
diff
changeset
|
53 |
|
391
1d4b8c5e18a4
See what automatically invalidating stale procedures might cost.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
390
diff
changeset
|
54 |
(define (by-unboxing-with-check) |
1d4b8c5e18a4
See what automatically invalidating stale procedures might cost.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
390
diff
changeset
|
55 |
(define f (eval `(letrec ((b (box (lambda (x) |
1d4b8c5e18a4
See what automatically invalidating stale procedures might cost.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
390
diff
changeset
|
56 |
(if (> epoch ,epoch) |
1d4b8c5e18a4
See what automatically invalidating stale procedures might cost.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
390
diff
changeset
|
57 |
(begin (set-box! b (lambda (x) (+ x 2))) |
1d4b8c5e18a4
See what automatically invalidating stale procedures might cost.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
390
diff
changeset
|
58 |
((unbox b) x)) |
1d4b8c5e18a4
See what automatically invalidating stale procedures might cost.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
390
diff
changeset
|
59 |
(+ x 1)))))) |
1d4b8c5e18a4
See what automatically invalidating stale procedures might cost.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
390
diff
changeset
|
60 |
b) |
1d4b8c5e18a4
See what automatically invalidating stale procedures might cost.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
390
diff
changeset
|
61 |
ns)) |
1d4b8c5e18a4
See what automatically invalidating stale procedures might cost.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
390
diff
changeset
|
62 |
(for/fold [(x 0)] [(n (in-range N))] ((unbox f) x))) |
1d4b8c5e18a4
See what automatically invalidating stale procedures might cost.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
390
diff
changeset
|
63 |
|
393
a8aa9b77e495
More bm-box.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
391
diff
changeset
|
64 |
(printf "by-unboxing-with-check\n") |
391
1d4b8c5e18a4
See what automatically invalidating stale procedures might cost.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
390
diff
changeset
|
65 |
(for [(i 5)] (time (by-unboxing-with-check))) |
1d4b8c5e18a4
See what automatically invalidating stale procedures might cost.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
390
diff
changeset
|
66 |
(newline) |
1d4b8c5e18a4
See what automatically invalidating stale procedures might cost.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
390
diff
changeset
|
67 |
|
393
a8aa9b77e495
More bm-box.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
391
diff
changeset
|
68 |
;; TODO: Experiment with hoisting the check out to being on the send |
a8aa9b77e495
More bm-box.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
391
diff
changeset
|
69 |
;; side, rather than the receive side; also consider the idea that |
a8aa9b77e495
More bm-box.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
391
diff
changeset
|
70 |
;; when inlining/partially-evaluating, probably want to residualize |
a8aa9b77e495
More bm-box.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
391
diff
changeset
|
71 |
;; the epoch check for each inlined method! If there's a separate |
a8aa9b77e495
More bm-box.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
391
diff
changeset
|
72 |
;; epoch for each method, that is. (If there's a global epoch, |
a8aa9b77e495
More bm-box.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
391
diff
changeset
|
73 |
;; everything gets invalidated at once, and the check just needs to |
a8aa9b77e495
More bm-box.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
391
diff
changeset
|
74 |
;; live at the top of each method - or every box has to be |
a8aa9b77e495
More bm-box.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
391
diff
changeset
|
75 |
;; discoverable and updateable.) Ultimately, there's some |
a8aa9b77e495
More bm-box.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
391
diff
changeset
|
76 |
;; interesting interaction between the source-ish forms of the |
a8aa9b77e495
More bm-box.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
391
diff
changeset
|
77 |
;; method and the target-ish forms of the method here. |
a8aa9b77e495
More bm-box.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
391
diff
changeset
|
78 |
(define (by-unboxing-with-check-but-no-fixed-box) |
a8aa9b77e495
More bm-box.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
391
diff
changeset
|
79 |
(define f (eval `(box (lambda (b x) |
a8aa9b77e495
More bm-box.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
391
diff
changeset
|
80 |
(if (> epoch ,epoch) |
a8aa9b77e495
More bm-box.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
391
diff
changeset
|
81 |
(begin (set-box! b (lambda (x) (+ x 2))) |
a8aa9b77e495
More bm-box.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
391
diff
changeset
|
82 |
((unbox b) b x)) |
a8aa9b77e495
More bm-box.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
391
diff
changeset
|
83 |
(+ x 1)))) |
a8aa9b77e495
More bm-box.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
391
diff
changeset
|
84 |
ns)) |
a8aa9b77e495
More bm-box.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
391
diff
changeset
|
85 |
(for/fold [(x 0)] [(n (in-range N))] ((unbox f) f x))) |
a8aa9b77e495
More bm-box.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
391
diff
changeset
|
86 |
|
a8aa9b77e495
More bm-box.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
391
diff
changeset
|
87 |
(printf "by-unboxing-with-check-but-no-fixed-box\n") |
a8aa9b77e495
More bm-box.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
391
diff
changeset
|
88 |
(for [(i 5)] (time (by-unboxing-with-check-but-no-fixed-box))) |
a8aa9b77e495
More bm-box.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
391
diff
changeset
|
89 |
(newline) |
a8aa9b77e495
More bm-box.rkt
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
391
diff
changeset
|
90 |
|
391
1d4b8c5e18a4
See what automatically invalidating stale procedures might cost.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
390
diff
changeset
|
91 |
) |
390
bfd7d4e7f498
Crude measurement of techniques for patching functions.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
92 |
|
bfd7d4e7f498
Crude measurement of techniques for patching functions.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
93 |
(module+ main (main)) |