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

Split impersonator property into two.

Browse Source 
To avoid future confusion.
This commit is contained in:
Vincent St-Amour 2016-03-08 16:31:20 -06:00
parent d80a8244a2
commit b5503151ac
1 changed files with 25 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
racket/collects/racket/private/class-c-old.rkt
View File

@ -1274,7 +1274,7 @@
(get-impersonator-prop:instanceof/c-original-object val) (get-impersonator-prop:instanceof/c-original-object val)
(impersonate-struct (impersonate-struct
val object-ref 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 ;; this code is doing a fairly complicated dance to
@ -1305,11 +1305,6 @@
(get-impersonator-prop:instanceof/c-projs val) (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) (define-values (reverse-without-redundant-ctcs reverse-without-redundant-projs)
(let loop ([prior-ctcs '()] (let loop ([prior-ctcs '()]
[prior-projs '()] [prior-projs '()]
@ -1327,22 +1322,18 @@
(car next-ctcs) (cdr next-ctcs) (car next-projs) (cdr next-projs)) (car next-ctcs) (cdr next-ctcs) (car next-projs) (cdr next-projs))
(loop (cons this-ctc prior-ctcs) (cons this-proj prior-projs) (loop (cons this-ctc prior-ctcs) (cons this-proj prior-projs)
(car next-ctcs) (cdr next-ctcs) (car next-projs) (cdr next-projs)))]))) (car next-ctcs) (cdr next-ctcs) (car next-projs) (cdr next-projs)))])))
(define wrapped-classes (define unwrapped-class
(reverse (if (has-impersonator-prop:instanceof/c-unwrapped-class? val)
(let loop ([class (if (has-impersonator-prop:instanceof/c-wrapped-classes? val) (get-impersonator-prop:instanceof/c-unwrapped-class val)
(car (reverse (object-ref val)))
(get-impersonator-prop:instanceof/c-wrapped-classes val))) (define wrapped-class
(object-ref val))] (let loop ([class unwrapped-class]
[ctcs reverse-without-redundant-ctcs] [ctcs reverse-without-redundant-ctcs]
[projs reverse-without-redundant-projs] [projs reverse-without-redundant-projs])
(cond
[old-ctcs (reverse (cdr all-new-ctcs))] [(null? projs) class]
[old-classes (reverse old-classes)]) [else (loop ((car projs) class) (cdr ctcs) (cdr projs))])))
(cond
[(null? projs) (list class)]
[else (cons class
(loop ((car projs) class) (cdr ctcs) (cdr projs) '() '()))]))))
(impersonate-struct (impersonate-struct
interposed-val object-ref interposed-val object-ref
@ -1354,7 +1345,8 @@
impersonator-prop:instanceof/c-original-object interposed-val impersonator-prop:instanceof/c-original-object interposed-val
impersonator-prop:instanceof/c-ctcs (reverse reverse-without-redundant-ctcs) impersonator-prop:instanceof/c-ctcs (reverse reverse-without-redundant-ctcs)
impersonator-prop:instanceof/c-projs (reverse reverse-without-redundant-projs) 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:contracted ctc
impersonator-prop:original-object original-obj)])))) impersonator-prop:original-object original-obj)]))))
@ -1368,15 +1360,20 @@
get-impersonator-prop:instanceof/c-projs) get-impersonator-prop:instanceof/c-projs)
(make-impersonator-property 'impersonator-prop:instanceof/c-projs)) (make-impersonator-property 'impersonator-prop:instanceof/c-projs))
(define-values (impersonator-prop:instanceof/c-wrapped-classes (define-values (impersonator-prop:instanceof/c-unwrapped-class
has-impersonator-prop:instanceof/c-wrapped-classes? has-impersonator-prop:instanceof/c-unwrapped-class?
get-impersonator-prop:instanceof/c-wrapped-classes) get-impersonator-prop:instanceof/c-unwrapped-class)
(make-impersonator-property 'impersonator-prop:instanceof/c-wrapped-classes)) (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, ;; when an object has the original-object property,
;; then we also know that value of this property is ;; then we also know that value of this property is
;; an object whose object-ref has been redirected to ;; 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 (define-values (impersonator-prop:instanceof/c-original-object
has-impersonator-prop:instanceof/c-original-object? has-impersonator-prop:instanceof/c-original-object?
get-impersonator-prop:instanceof/c-original-object) get-impersonator-prop:instanceof/c-original-object)