diff --git a/collects/typed-racket/optimizer/hidden-costs.rkt b/collects/typed-racket/optimizer/hidden-costs.rkt index 70110acb89..9f2e6d4720 100644 --- a/collects/typed-racket/optimizer/hidden-costs.rkt +++ b/collects/typed-racket/optimizer/hidden-costs.rkt @@ -6,6 +6,8 @@ (optimizer utils logging) (types abbrev)) +(require (types type-table)) + (provide hidden-cost-log-expr) (define-syntax-class hidden-port-parameter-function @@ -29,4 +31,11 @@ (syntax->list #'(args ...))) #:with opt (begin (log-optimization-info "hidden parameter" #'op) + #`(op #,@(syntax-map (optimize) #'(args ...))))) + ;; Log calls to struct constructors, so that OC can report those used in + ;; hot loops. + (pattern (#%plain-app op:id args ...) + #:when (struct-constructor? #'op) + #:with opt + (begin (log-optimization-info "struct constructor" #'op) #`(op #,@(syntax-map (optimize) #'(args ...)))))) diff --git a/collects/typed-racket/optimizer/tool/mzc.rkt b/collects/typed-racket/optimizer/tool/mzc.rkt index 76a08d97d2..03419e9abe 100644 --- a/collects/typed-racket/optimizer/tool/mzc.rkt +++ b/collects/typed-racket/optimizer/tool/mzc.rkt @@ -388,6 +388,24 @@ '() '() 20)))) ;; TODO have actual badness + (when inside-hot-function? + (for ([TR-entry (in-list TR-log)] + #:when (info-log-entry? TR-entry) + #:when (equal? (log-entry-kind TR-entry) "struct constructor") + #:when (pos-inside-us? (log-entry-pos TR-entry))) + (emit (missed-opt-log-entry + "" ; kind not used at this point + (string-append + "This struct constructor is used in hot code. " + "Allocating structs is expensive, consider using vectors instead. " + "To keep the same interface, consider defining macro wrappers " + "around the vector operations that have the same name as the " + "struct constructor and accessors.") + (log-entry-located-stx TR-entry) (log-entry-located-stx TR-entry) + (log-entry-pos TR-entry) 'typed-racket + '() '() + 20)))) ;; TODO have actual badness + produced-entries) (define (group-badness group)