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

Add instrumentation for optimized struct/dc.

Browse Source
This commit is contained in:
Vincent St-Amour 2015-12-14 13:57:03 -06:00
parent bf1ba809ae
commit b8df0a38a2
1 changed files with 22 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
racket/collects/racket/contract/private/struct-dc.rkt
View File

@ -1432,12 +1432,16 @@
#:exp #:exp
;; if this is #t, when we have to avoid putting the property on here. ;; if this is #t, when we have to avoid putting the property on here.
(if (null? s-chap-code) (if (null? s-chap-code)
#`(if (pred? #,(opt/info-val opt/info)) #`(with-continuation-mark
contract-continuation-mark-key #,(opt/info-blame opt/info)
(if (pred? #,(opt/info-val opt/info))
(begin (begin
#,@s-fo-code #,@s-fo-code
#,(opt/info-val opt/info)) #,(opt/info-val opt/info))
(struct/dc-error blame #,(opt/info-val opt/info) 'struct-name)) (struct/dc-error blame #,(opt/info-val opt/info) 'struct-name)))
#`(if (and (stronger-prop-pred? #,(opt/info-val opt/info)) #`(with-continuation-mark
contract-continuation-mark-key #,(opt/info-blame opt/info)
(if (and (stronger-prop-pred? #,(opt/info-val opt/info))
(let ([v (stronger-prop-get #,(opt/info-val opt/info))]) (let ([v (stronger-prop-get #,(opt/info-val opt/info))])
(and (eq? (vector-ref v index) free-var) ...))) (and (eq? (vector-ref v index) free-var) ...)))
#,(opt/info-val opt/info) #,(opt/info-val opt/info)
@ -1449,7 +1453,7 @@
#,@(reverse s-chap-code) ;; built the last backwards, so reverse it here #,@(reverse s-chap-code) ;; built the last backwards, so reverse it here
stronger-prop-desc stronger-prop-desc
(vector free-var ...))) (vector free-var ...)))
(struct/dc-error #,(opt/info-blame opt/info) #,(opt/info-val opt/info) 'struct-name)))) (struct/dc-error #,(opt/info-blame opt/info) #,(opt/info-val opt/info) 'struct-name)))))
#:lifts #:lifts
s-lifts s-lifts
#:superlifts #:superlifts