diff --git a/collects/racket/private/class-internal.rkt b/collects/racket/private/class-internal.rkt index d00ef10..0a96cba 100644 --- a/collects/racket/private/class-internal.rkt +++ b/collects/racket/private/class-internal.rkt @@ -3734,19 +3734,30 @@ (let () (define (do-method traced? stx form obj name args rest-arg?) - (with-syntax ([(sym method receiver) - (generate-temporaries (syntax (1 2 3)))]) + (with-syntax ([(sym in-object in-class state method receiver) + (generate-temporaries (syntax (1 2 3 4 5 6)))] + [*cached-state* + (syntax-local-lift-expression + (syntax (cons #f #f)))]) (quasisyntax/loc stx (let*-values ([(sym) (quasiquote (unsyntax (localize name)))] - [(method receiver) - (find-method/who '(unsyntax form) - (unsyntax obj) - sym)]) + [(in-object) (unsyntax obj)] + [(in-class) (and (object? in-object) (object-ref in-object))] + [(state) *cached-state*] + [(method) + (if (and in-class (eq? (car state) in-class)) + (cdr state) + (let-values ([(m r) + (find-method/who '(unsyntax form) + in-object + sym)]) + (set! *cached-state* (cons in-class m)) + m))]) (unsyntax (make-method-call traced? stx - (syntax/loc stx receiver) + (syntax/loc stx in-object) (syntax/loc stx method) (syntax/loc stx sym) args