forked from racket/racket
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathstress.rkt
254 lines (227 loc) · 7.5 KB
/
stress.rkt
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
#lang racket
(begin
(require syntax/parse)
(define (mkstx n) (datum->syntax #f (for/list ([i (in-range n)]) #'hello)))
(define stx1 (mkstx 10))
(define stx2 (mkstx 100))
(define stx3 (mkstx 1000))
(define stx4 (mkstx 10000))
(define bad-stx (datum->syntax #f (append (for/list ([i (in-range 10000)]) #'hello) (list #'#f))))
(define-syntax-class plain-id
#:attributes ()
(pattern x #:when (identifier? #'x)))
(define-syntax-class commit-id #:commit
#:attributes ()
(pattern x #:when (identifier? #'x)))
(define (parse/id x n)
(for ([i (in-range n)])
(syntax-parse x [(z:id ...) 'ok] [_ 'bad!])))
(define (parse/plain-id x n)
(for ([i (in-range n)])
(syntax-parse x [(z:plain-id ...) 'ok] [_ 'bad!])))
(define (parse/commit-id x n)
(for ([i (in-range n)])
(syntax-parse x [(z:commit-id ...) 'ok] [_ 'bad!])))
(define (parse/listpred x n)
(for ([i (in-range n)])
(syntax-case x ()
[(x ...) (andmap identifier? (syntax->list #'(x ...))) 'ok]
[_ 'bad!])))
(define (parse/pred x n)
(for ([i (in-range n)])
(let loop ([x x])
(syntax-case x ()
[(x . y) (identifier? #'x) (loop #'y)]
[() 'ok])))))
(begin
(define (stx->list1 x)
(cond [(syntax? x)
(stx->list1 (syntax-e x))]
[(pair? x)
(cons (car x) (stx->list1 (cdr x)))]
[(null? x)
null]))
(define (stx->list2 x)
(let ([d (syntax-e x)])
(cond [(pair? d)
(cons (car d) (stx->list2 (datum->syntax x (cdr d) x)))]
[(null? d)
null])))
(define (stx->list3 x)
(cond [(syntax? x)
(stx->list3 (syntax-e x))]
[(box? x)
(stx->list3 (unbox x))]
[(pair? x)
(cons (car x) (stx->list3 (box (cdr x))))]
[(null? x)
null])))
#|
> (time (parse/id stx 10))
cpu time: 2829 real time: 2826 gc time: 20
> (time (parse/plain-id stx 10))
cpu time: 3072 real time: 3090 gc time: 40
> (time (parse/commit-id stx 10))
cpu time: 3076 real time: 3125 gc time: 24
> (time (parse/listpred stx 10))
cpu time: 4 real time: 7 gc time: 0
> (time (parse/pred stx 10))
cpu time: 2760 real time: 2757 gc time: 8
> (collect-garbage)
> (collect-garbage)
> (time (parse/pred stx 10))
cpu time: 2808 real time: 2813 gc time: 64
> (collect-garbage)
> (collect-garbage)
> (time (parse/id stx 10))
cpu time: 2880 real time: 2876 gc time: 84
> (time (parse/id stx 10))
cpu time: 2821 real time: 2810 gc time: 8
> (time (parse/id stx 10))
cpu time: 2816 real time: 2812 gc time: 16
> (time (parse/plain-id stx 10))
cpu time: 2912 real time: 2906 gc time: 24
> (time (parse/plain-id stx 10))
cpu time: 2908 real time: 2910 gc time: 24
> (time (parse/plain-id stx 10))
cpu time: 3128 real time: 3144 gc time: 32
> (time (parse/plain-id stx 10))
cpu time: 2925 real time: 2922 gc time: 36
> (time (parse/plain-id stx 10))
cpu time: 2908 real time: 2901 gc time: 12
|#
#|
given pattern (E ...) where E = A _ | A
the sequence (A A B A A B A A B ...)
causes each E to backtrack
|#
(begin
(define-syntax-class id/nat
#:attributes ()
(pattern x:id)
(pattern n:nat))
(define-splicing-syntax-class trip
#:attributes ()
(pattern (~seq #:a _))
(pattern (~seq #:a)))
(define (mktripstx n)
(apply append (for/list ([i (in-range n)]) (list #'#:a #'#:a #'#:b))))
(define tripstx3 (mktripstx 1000))
(define tripstx4 (mktripstx 10000))
(define (parse/trip x n)
(for ([i (in-range n)])
(syntax-parse x
[(t:trip ...) 'ok])))
(define (mknatstx n)
(datum->syntax #f (for/list ([i (in-range n)]) (add1 i))))
(define (solve n rep)
(let ([stx (mknatstx n)])
(for ([i (in-range rep)])
(syntax-parse stx
[((~or x:nat y:nat) ...)
#:when (= (apply + (syntax->datum #'(x ...)))
(apply + (syntax->datum #'(y ...))))
(syntax->datum #'(y ...))])))))
;; (solve 35 _) and (solve 36 _) seem manageable
#|
#| before markparams |#
> (time (parse/trip tripstx3 100))
cpu time: 812 real time: 817 gc time: 92
> (time (parse/trip tripstx3 100))
cpu time: 788 real time: 791 gc time: 76
> (time (parse/trip tripstx3 100))
cpu time: 772 real time: 774 gc time: 52
> (time (parse/trip tripstx4 10))
cpu time: 1148 real time: 1147 gc time: 436
> (time (parse/trip tripstx4 10))
cpu time: 1368 real time: 1385 gc time: 520
> (time (parse/trip tripstx4 10))
cpu time: 1240 real time: 1240 gc time: 516
> (time (solve 35 20))
cpu time: 1572 real time: 1568 gc time: 332
> (time (solve 35 20))
cpu time: 1548 real time: 1551 gc time: 304
> (time (solve 35 20))
cpu time: 1548 real time: 1548 gc time: 304
> (time (solve 36 20))
cpu time: 716 real time: 714 gc time: 80
> (time (solve 36 20))
cpu time: 704 real time: 703 gc time: 64
> (time (solve 36 20))
cpu time: 700 real time: 701 gc time: 72
#| with partial defunctionalization (failures-so-far) |#
> (time (parse/trip tripstx3 100))
cpu time: 1932 real time: 1933 gc time: 88
> (time (parse/trip tripstx3 100))
cpu time: 1900 real time: 1903 gc time: 76
> (time (parse/trip tripstx3 100))
cpu time: 2052 real time: 2052 gc time: 224
> (time (parse/trip tripstx4 10))
cpu time: 2536 real time: 2535 gc time: 708
> (time (parse/trip tripstx4 10))
cpu time: 2620 real time: 2622 gc time: 756
> (time (parse/trip tripstx4 10))
cpu time: 2372 real time: 2372 gc time: 556
> (time (solve 35 20))
cpu time: 3409 real time: 3404 gc time: 340
> (time (solve 35 20))
cpu time: 3244 real time: 3244 gc time: 312
> (time (solve 35 20))
cpu time: 3240 real time: 3242 gc time: 312
> (time (solve 36 20))
cpu time: 1588 real time: 1589 gc time: 76
> (time (solve 36 20))
cpu time: 1576 real time: 1579 gc time: 64
> (time (solve 36 20))
cpu time: 1580 real time: 1575 gc time: 52
#| with failure function as markparam |#
> (time (parse/trip tripstx3 100))
cpu time: 1840 real time: 1843 gc time: 116
> (time (parse/trip tripstx3 100))
cpu time: 1792 real time: 1789 gc time: 48
> (time (parse/trip tripstx3 100))
cpu time: 1956 real time: 1960 gc time: 228
> (time (parse/trip tripstx4 10))
cpu time: 2352 real time: 2353 gc time: 608
> (time (parse/trip tripstx4 10))
cpu time: 2488 real time: 2495 gc time: 748
> (time (parse/trip tripstx4 10))
cpu time: 2416 real time: 2415 gc time: 684
> (time (solve 35 20))
cpu time: 3205 real time: 3201 gc time: 324
> (time (solve 35 20))
cpu time: 3208 real time: 3203 gc time: 316
> (time (solve 35 20))
cpu time: 3048 real time: 3050 gc time: 184
> (time (solve 36 20))
cpu time: 1692 real time: 1695 gc time: 208
> (time (solve 36 20))
cpu time: 1564 real time: 1566 gc time: 84
> (time (solve 36 20))
cpu time: 1540 real time: 1542 gc time: 64
#| with fail & cut-prompt as stxparams |#
> (time (parse/trip tripstx3 100))
cpu time: 532 real time: 534 gc time: 68
> (time (parse/trip tripstx3 100))
cpu time: 524 real time: 524 gc time: 48
> (time (parse/trip tripstx3 100))
cpu time: 656 real time: 657 gc time: 168
> (time (parse/trip tripstx4 10))
cpu time: 992 real time: 993 gc time: 512
> (time (parse/trip tripstx4 10))
cpu time: 860 real time: 861 gc time: 380
> (time (parse/trip tripstx4 10))
cpu time: 1004 real time: 999 gc time: 516
> (time (solve 35 20))
cpu time: 1132 real time: 1129 gc time: 140
> (time (solve 35 20))
cpu time: 1320 real time: 1316 gc time: 340
> (time (solve 35 20))
cpu time: 1300 real time: 1299 gc time: 296
> (time (solve 36 20))
cpu time: 588 real time: 588 gc time: 76
> (time (solve 36 20))
cpu time: 580 real time: 584 gc time: 68
> (time (solve 36 20))
cpu time: 580 real time: 586 gc time: 56
|#