suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add instrumentation to profile generic sequence overhead.

Browse Source
This commit is contained in:
Vincent St-Amour 2014-01-22 16:19:42 -05:00
parent 9d7b6a1c89
commit b474ba765e
1 changed files with 18 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
racket/collects/racket/private/for.rkt
View File

@ -317,14 +317,26 @@
(syntax-local-introduce
(introducer
#`(([(pos->vals pos-next init pos-cont? val-cont? all-cont?)
(make-sequence '(id ...) rhs)])
#,(syntax-property
(syntax/loc #'rhs (make-sequence '(id ...) rhs))
'feature-profile:generic-sequence #t)])
(void)
([pos init])
(if pos-cont? (pos-cont? pos) #t)
([(id ...) (pos->vals pos)])
(if val-cont? (val-cont? id ...) #t)
(if all-cont? (all-cont? pos id ...) #t)
((pos-next pos)))))
#,(syntax-property
(syntax/loc #'rhs (if pos-cont? (pos-cont? pos) #t))
'feature-profile:generic-sequence #t)
([(id ...) #,(syntax-property
(syntax/loc #'rhs (pos->vals pos))
'feature-profile:generic-sequence #t)])
#,(syntax-property
(syntax/loc #'rhs (if val-cont? (val-cont? id ...) #t))
'feature-profile:generic-sequence #t)
#,(syntax-property
(syntax/loc #'rhs (if all-cont? (all-cont? pos id ...) #t))
'feature-profile:generic-sequence #t)
#,(syntax-property
(syntax/loc #'rhs ((pos-next pos)))
'feature-profile:generic-sequence #t))))
(make-rearm))))]
[_
(raise-syntax-error #f