From b5503151ac9968e6c24e1f5e9b80b680950ec7ea Mon Sep 17 00:00:00 2001 From: Vincent St-Amour Date: Tue, 8 Mar 2016 16:31:20 -0600 Subject: [PATCH] Split impersonator property into two. To avoid future confusion. --- .../collects/racket/private/class-c-old.rkt | 53 +++++++++---------- 1 file changed, 25 insertions(+), 28 deletions(-) diff --git a/racket/collects/racket/private/class-c-old.rkt b/racket/collects/racket/private/class-c-old.rkt index 3790e11ae9..64b78ecdee 100644 --- a/racket/collects/racket/private/class-c-old.rkt +++ b/racket/collects/racket/private/class-c-old.rkt @@ -1274,7 +1274,7 @@ (get-impersonator-prop:instanceof/c-original-object val) (impersonate-struct val object-ref - (λ (o c) (car (get-impersonator-prop:instanceof/c-wrapped-classes o)))))) + (λ (o c) (get-impersonator-prop:instanceof/c-wrapped-class o))))) ;; this code is doing a fairly complicated dance to @@ -1305,11 +1305,6 @@ (get-impersonator-prop:instanceof/c-projs val) '()))) - (define old-classes - (if (has-impersonator-prop:instanceof/c-wrapped-classes? val) - (get-impersonator-prop:instanceof/c-wrapped-classes val) - '())) - (define-values (reverse-without-redundant-ctcs reverse-without-redundant-projs) (let loop ([prior-ctcs '()] [prior-projs '()] @@ -1327,22 +1322,18 @@ (car next-ctcs) (cdr next-ctcs) (car next-projs) (cdr next-projs)) (loop (cons this-ctc prior-ctcs) (cons this-proj prior-projs) (car next-ctcs) (cdr next-ctcs) (car next-projs) (cdr next-projs)))]))) - - (define wrapped-classes - (reverse - (let loop ([class (if (has-impersonator-prop:instanceof/c-wrapped-classes? val) - (car (reverse - (get-impersonator-prop:instanceof/c-wrapped-classes val))) - (object-ref val))] - [ctcs reverse-without-redundant-ctcs] - [projs reverse-without-redundant-projs] - - [old-ctcs (reverse (cdr all-new-ctcs))] - [old-classes (reverse old-classes)]) - (cond - [(null? projs) (list class)] - [else (cons class - (loop ((car projs) class) (cdr ctcs) (cdr projs) '() '()))])))) + + (define unwrapped-class + (if (has-impersonator-prop:instanceof/c-unwrapped-class? val) + (get-impersonator-prop:instanceof/c-unwrapped-class val) + (object-ref val))) + (define wrapped-class + (let loop ([class unwrapped-class] + [ctcs reverse-without-redundant-ctcs] + [projs reverse-without-redundant-projs]) + (cond + [(null? projs) class] + [else (loop ((car projs) class) (cdr ctcs) (cdr projs))]))) (impersonate-struct interposed-val object-ref @@ -1354,7 +1345,8 @@ impersonator-prop:instanceof/c-original-object interposed-val impersonator-prop:instanceof/c-ctcs (reverse reverse-without-redundant-ctcs) impersonator-prop:instanceof/c-projs (reverse reverse-without-redundant-projs) - impersonator-prop:instanceof/c-wrapped-classes wrapped-classes + impersonator-prop:instanceof/c-wrapped-class wrapped-class + impersonator-prop:instanceof/c-unwrapped-class unwrapped-class impersonator-prop:contracted ctc impersonator-prop:original-object original-obj)])))) @@ -1368,15 +1360,20 @@ get-impersonator-prop:instanceof/c-projs) (make-impersonator-property 'impersonator-prop:instanceof/c-projs)) -(define-values (impersonator-prop:instanceof/c-wrapped-classes - has-impersonator-prop:instanceof/c-wrapped-classes? - get-impersonator-prop:instanceof/c-wrapped-classes) - (make-impersonator-property 'impersonator-prop:instanceof/c-wrapped-classes)) +(define-values (impersonator-prop:instanceof/c-unwrapped-class + has-impersonator-prop:instanceof/c-unwrapped-class? + get-impersonator-prop:instanceof/c-unwrapped-class) + (make-impersonator-property 'impersonator-prop:instanceof/c-unwrapped-class)) + +(define-values (impersonator-prop:instanceof/c-wrapped-class + has-impersonator-prop:instanceof/c-wrapped-class? + get-impersonator-prop:instanceof/c-wrapped-class) + (make-impersonator-property 'impersonator-prop:instanceof/c-wrapped-class)) ;; when an object has the original-object property, ;; then we also know that value of this property is ;; an object whose object-ref has been redirected to -;; use impersonator-prop:instanceof/c-wrapped-classes +;; use impersonator-prop:instanceof/c-wrapped-class (define-values (impersonator-prop:instanceof/c-original-object has-impersonator-prop:instanceof/c-original-object? get-impersonator-prop:instanceof/c-original-object)