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

Instrument send dispatch for feature-specific profiling.

Browse Source
This commit is contained in:
Vincent St-Amour 2014-01-29 15:19:42 -05:00
parent b474ba765e
commit 584e494d5a
2 changed files with 24 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
racket/collects/racket/private/class-internal.rkt
View File

@ -3591,7 +3591,8 @@ An example
(set! arg-list (reverse arg-list))
(set! let-bindings (reverse let-bindings))
(quasisyntax/loc stx
(syntax-property
(quasisyntax/loc stx
(let*-values ([(sym) (quasiquote (unsyntax (localize name)))]
[(receiver) (unsyntax obj)]
[(method) (find-method/who '(unsyntax form) receiver sym)])
@ -3603,7 +3604,8 @@ An example
(make-method-call-to-possibly-wrapped-object
stx kw-args/var arg-list rest-arg?
#'sym #'method #'receiver
(quasisyntax/loc stx (find-method/who '(unsyntax form) receiver sym)))))))))
(quasisyntax/loc stx (find-method/who '(unsyntax form) receiver sym)))))))
'feature-profile:send-dispatch #t)))
(define (core-send apply? kws?)
(lambda (stx)

36
racket/collects/racket/private/classidmap.rkt
View File

@ -438,24 +438,28 @@
;; as the object to 'make-method-call' so that the
;; arguments end up in the right order.
(unsyntax
(make-method-call
stx
#`(wrapped-object-neg-party receiver)
(syntax/loc stx method)
(syntax/loc stx sym)
#`((wrapped-object-object #,(syntax/loc stx receiver)) #,@arg-list)
rest-arg?
kw-args/var))
(syntax-property
(make-method-call
stx
#`(wrapped-object-neg-party receiver)
(syntax/loc stx method)
(syntax/loc stx sym)
#`((wrapped-object-object #,(syntax/loc stx receiver)) #,@arg-list)
rest-arg?
kw-args/var)
'feature-profile:send-dispatch 'antimark))
(let ([receiver (wrapped-object-object receiver)])
(unsyntax
(make-method-call
stx
(syntax/loc stx receiver)
(syntax/loc stx method-in-wrapper-fallback-case)
(syntax/loc stx sym)
arg-list
rest-arg?
kw-args/var))))
(syntax-property
(make-method-call
stx
(syntax/loc stx receiver)
(syntax/loc stx method-in-wrapper-fallback-case)
(syntax/loc stx sym)
arg-list
rest-arg?
kw-args/var)
'feature-profile:send-dispatch 'antimark))))
(unsyntax
(make-method-call
stx