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

v5.0.99.2: proxy' -> impersonator'

Browse Source
This commit is contained in:
Matthew Flatt 2010-11-08 06:23:16 -07:00
parent 81488335cd
commit 7f67b6569c
33 changed files with 1479 additions and 1476 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/mzlib/private/contract-arrow.rkt
View File

@ -50,7 +50,7 @@
(apply values res-checker kwd-vals args))
(λ args
(apply values res-checker args)))
proxy-prop:contracted ctc)
impersonator-prop:contracted ctc)
(raise-blame-error blame val "expected a procedure"))))))
(define ctc
(if (and (chaperone-contract? rngs-x) ...)
@ -60,7 +60,7 @@
#:first-order procedure?)
(make-contract
#:name name
#:projection (proj proxy-procedure)
#:projection (proj impersonate-procedure)
#:first-order procedure?)))
ctc)))]))

28
collects/racket/contract/private/arrow.rkt
View File

@ -97,8 +97,8 @@ v4 todo:
#'(p-app-x ...)
(list #'res-checker)
(λ (s) #`(apply values #,@s args)))))
proxy-prop:contracted ctc
proxy-prop:application-mark (cons contract-key (list p-app-x ...)))))))
impersonator-prop:contracted ctc
impersonator-prop:application-mark (cons contract-key (list p-app-x ...)))))))
(define ctc
(if (and (chaperone-contract? rngs-x) ...)
(make-chaperone-contract
@ -107,7 +107,7 @@ v4 todo:
#:first-order procedure?)
(make-contract
#:name name
#:projection (projection proxy-procedure)
#:projection (projection impersonate-procedure)
#:first-order procedure?)))
ctc)))]))
@ -440,10 +440,10 @@ v4 todo:
#:first-order ->-first-order
#:stronger ->-stronger?))
(define-struct (proxy-> base->) ()
(define-struct (impersonator-> base->) ()
#:property prop:contract
(build-contract-property
#:projection (->-proj proxy-procedure)
#:projection (->-proj impersonate-procedure)
#:name ->-name
#:first-order ->-first-order
#:stronger ->-stronger?))
@ -470,7 +470,7 @@ v4 todo:
(make-chaperone-> pre post doms/c opt-doms/c rest/c
kwds/c mandatory-kwds opt-kwds/c optional-kwds
rngs/c rng-any? func)
(make-proxy-> pre post doms/c opt-doms/c rest/c
(make-impersonator-> pre post doms/c opt-doms/c rest/c
kwds/c mandatory-kwds opt-kwds/c optional-kwds
rngs/c rng-any? func)))))
@ -605,8 +605,8 @@ v4 todo:
(syntax->list #'(kwd-names ...)))
null
(if (syntax->datum #'use-any?) #f (syntax->list #'(rng-names ...))))
proxy-prop:contracted ctc
proxy-prop:application-mark (cons contract-key (list rng-names ...)))))])
impersonator-prop:contracted ctc
impersonator-prop:application-mark (cons contract-key (list rng-names ...)))))])
(syntax-property
(syntax
(build--> '->
@ -930,8 +930,8 @@ v4 todo:
(map list (syntax->list #'(optional-dom-kwd ...))
(syntax->list #'(optional-dom-kwd-proj ...)))
(if rng-ctc (syntax->list #'(rng-proj ...)) #f))
proxy-prop:contracted ctc
proxy-prop:application-mark (cons contract-key (list rng-proj ...))))))))))))]))
impersonator-prop:contracted ctc
impersonator-prop:application-mark (cons contract-key (list rng-proj ...))))))))))))]))
(define-syntax (->* stx) #`(syntax-parameterize ((making-a-method #f)) #,(->*/proc/main stx)))
@ -1313,7 +1313,7 @@ v4 todo:
[else (cons (invoke-dep-ctc (car non-kwd-ctcs) dep-pre-args (car args) (blame-swap blame))
(loop (cdr args)
(cdr non-kwd-ctcs)))])))))))
proxy-prop:contracted ->d-stct))))))
impersonator-prop:contracted ->d-stct))))))
(define (build-values-string desc dep-pre-args)
(cond
@ -1377,7 +1377,7 @@ v4 todo:
(append mandatory-kwds optional-kwds)
(append mandatory-kwd-dom-ctcs optional-kwd-dom-ctcs))
(λ (x y) (keyword<? (car x) (car y))))])
(make-proxy-->d mtd?
(make-impersonator-->d mtd?
mandatory-dom-ctcs optional-dom-ctcs
(map cdr kwd/ctc-pairs)
rest-ctc pre-cond range post-cond
@ -1471,10 +1471,10 @@ v4 todo:
;; appropriately. b) might be okay, but we should think about
;; it first. At the very least, the projection function would
;; need to add checks in the appropriate places.
(define-struct (proxy-->d base-->d) ()
(define-struct (impersonator-->d base-->d) ()
#:property prop:contract
(build-contract-property
#:projection (->d-proj proxy-procedure)
#:projection (->d-proj impersonate-procedure)
#:name ->d-name
#:first-order ->d-first-order
#:stronger ->d-stronger?))

8
collects/racket/contract/private/box.rkt
View File

@ -81,7 +81,7 @@
(box-wrapper val
(λ (b v) (pos-elem-proj v))
(λ (b v) (neg-elem-proj v))
proxy-prop:contracted ctc))))))))
impersonator-prop:contracted ctc))))))))
(define-struct (chaperone-box/c base-box/c) ()
#:property prop:chaperone-contract
@ -90,12 +90,12 @@
#:first-order box/c-first-order
#:projection (ho-projection chaperone-box)))
(define-struct (proxy-box/c base-box/c) ()
(define-struct (impersonator-box/c base-box/c) ()
#:property prop:contract
(build-contract-property
#:name box/c-name
#:first-order box/c-first-order
#:projection (ho-projection proxy-box)))
#:projection (ho-projection impersonate-box)))
(define-syntax (wrap-box/c stx)
(syntax-case stx ()
@ -144,5 +144,5 @@
[(chaperone-contract? ctc)
(make-chaperone-box/c ctc immutable)]
[else
(make-proxy-box/c ctc immutable)])))
(make-impersonator-box/c ctc immutable)])))

16
collects/racket/contract/private/guts.rkt
View File

@ -44,7 +44,7 @@
contract-first-order-passes?
prop:contracted
proxy-prop:contracted
impersonator-prop:contracted
has-contract?
value-contract
@ -59,14 +59,14 @@
(define (has-contract? v)
(or (has-prop:contracted? v)
(has-proxy-prop:contracted? v)))
(has-impersonator-prop:contracted? v)))
(define (value-contract v)
(cond
[(has-prop:contracted? v)
(get-prop:contracted v)]
[(has-proxy-prop:contracted? v)
(get-proxy-prop:contracted v)]
[(has-impersonator-prop:contracted? v)
(get-impersonator-prop:contracted v)]
[else #f]))
(define-values (prop:contracted has-prop:contracted? get-prop:contracted)
@ -80,8 +80,8 @@
(lambda (s) v))))])
(values prop pred (λ (v) ((get v) v)))))
(define-values (proxy-prop:contracted has-proxy-prop:contracted? get-proxy-prop:contracted)
(make-proxy-property 'proxy-prop:contracted))
(define-values (impersonator-prop:contracted has-impersonator-prop:contracted? get-impersonator-prop:contracted)
(make-impersonator-property 'impersonator-prop:contracted))
(define-syntax (any stx)
(raise-syntax-error 'any "use of 'any' outside the range of an arrow contract" stx))
@ -339,7 +339,7 @@
#:name and-name
#:first-order and-first-order
#:stronger and-stronger?))
(define-struct (proxy-and/c base-and/c) ()
(define-struct (impersonator-and/c base-and/c) ()
#:property prop:contract
(build-contract-property
#:projection and-proj
@ -358,7 +358,7 @@
(λ (x) (for/and ([pred (in-list preds)]) (pred x)))))]
[(andmap chaperone-contract? contracts)
(make-chaperone-and/c contracts)]
[else (make-proxy-and/c contracts)])))
[else (make-impersonator-and/c contracts)])))
(define (get-any-projection c) any-projection)
(define (any-projection b) any-function)

8
collects/racket/contract/private/hash.rkt
View File

@ -71,7 +71,7 @@
[(chaperone-contract? rng-ctc)
(make-chaperone-hash/c dom-ctc rng-ctc immutable)]
[else
(make-proxy-hash/c dom-ctc rng-ctc immutable)])))
(make-impersonator-hash/c dom-ctc rng-ctc immutable)])))
(define (check-hash/c ctc)
(let ([dom-ctc (base-hash/c-dom ctc)]
@ -180,7 +180,7 @@
(neg-dom-proj k))
(λ (h k)
(pos-dom-proj k))
proxy-prop:contracted ctc))))))))
impersonator-prop:contracted ctc))))))))
(define-struct (chaperone-hash/c base-hash/c) ()
#:omit-define-syntaxes
@ -190,10 +190,10 @@
#:first-order hash/c-first-order
#:projection (ho-projection chaperone-hash)))
(define-struct (proxy-hash/c base-hash/c) ()
(define-struct (impersonator-hash/c base-hash/c) ()
#:omit-define-syntaxes
#:property prop:contract
(build-contract-property
#:name hash/c-name
#:first-order hash/c-first-order
#:projection (ho-projection proxy-hash)))
#:projection (ho-projection impersonate-hash)))

8
collects/racket/contract/private/misc.rkt
View File

@ -119,11 +119,11 @@
[(null? (cdr ho-contracts))
(if (chaperone-contract? (car ho-contracts))
(make-chaperone-single-or/c pred flat-contracts (car ho-contracts))
(make-proxy-single-or/c pred flat-contracts (car ho-contracts)))]
(make-impersonator-single-or/c pred flat-contracts (car ho-contracts)))]
[else
(if (andmap chaperone-contract? ho-contracts)
(make-chaperone-multi-or/c flat-contracts ho-contracts)
(make-proxy-multi-or/c flat-contracts ho-contracts))]))))]))
(make-impersonator-multi-or/c flat-contracts ho-contracts))]))))]))
(define (single-or/c-projection ctc)
(let ([c-proc (contract-projection (single-or/c-ho-ctc ctc))]
@ -167,7 +167,7 @@
#:first-order single-or/c-first-order
#:stronger single-or/c-stronger?))
(define-struct (proxy-single-or/c single-or/c) ()
(define-struct (impersonator-single-or/c single-or/c) ()
#:property prop:contract
(build-contract-property
#:projection single-or/c-projection
@ -253,7 +253,7 @@
#:first-order multi-or/c-first-order
#:stronger multi-or/c-stronger?))
(define-struct (proxy-multi-or/c multi-or/c) ()
(define-struct (impersonator-multi-or/c multi-or/c) ()
#:property prop:contract
(build-contract-property
#:projection multi-or/c-proj

16
collects/racket/contract/private/vector.rkt
View File

@ -85,7 +85,7 @@
(elem-pos-proj val))
(λ (vec i val)
(elem-neg-proj val))
proxy-prop:contracted ctc))))))))
impersonator-prop:contracted ctc))))))))
(define-struct (chaperone-vectorof base-vectorof) ()
#:property prop:chaperone-contract
@ -94,12 +94,12 @@
#:first-order vectorof-first-order
#:projection (vectorof-ho-projection chaperone-vector)))
(define-struct (proxy-vectorof base-vectorof) ()
(define-struct (impersonator-vectorof base-vectorof) ()
#:property prop:contract
(build-contract-property
#:name vectorof-name
#:first-order vectorof-first-order
#:projection (vectorof-ho-projection proxy-vector)))
#:projection (vectorof-ho-projection impersonate-vector)))
(define-syntax (wrap-vectorof stx)
(syntax-case stx ()
@ -149,7 +149,7 @@
[(chaperone-contract? ctc)
(make-chaperone-vectorof ctc immutable)]
[else
(make-proxy-vectorof ctc immutable)])))
(make-impersonator-vectorof ctc immutable)])))
(define/subexpression-pos-prop (vector-immutableof c)
(vectorof c #:immutable #t))
@ -239,7 +239,7 @@
((vector-ref elem-pos-projs i) val))
(λ (vec i val)
((vector-ref elem-neg-projs i) val))
proxy-prop:contracted ctc))))))))
impersonator-prop:contracted ctc))))))))
(define-struct (chaperone-vector/c base-vector/c) ()
#:property prop:chaperone-contract
@ -248,12 +248,12 @@
#:first-order vector/c-first-order
#:projection (vector/c-ho-projection chaperone-vector)))
(define-struct (proxy-vector/c base-vector/c) ()
(define-struct (impersonator-vector/c base-vector/c) ()
#:property prop:contract
(build-contract-property
#:name vector/c-name
#:first-order vector/c-first-order
#:projection (vector/c-ho-projection proxy-vector)))
#:projection (vector/c-ho-projection impersonate-vector)))
(define-syntax (wrap-vector/c stx)
(syntax-case stx ()
@ -303,7 +303,7 @@
[(andmap chaperone-contract? ctcs)
(make-chaperone-vector/c ctcs immutable)]
[else
(make-proxy-vector/c ctcs immutable)])))
(make-impersonator-vector/c ctcs immutable)])))
(define/subexpression-pos-prop (vector-immutable/c . args)
(apply vector/c args #:immutable #t))

62
collects/racket/private/kw.rkt
View File

@ -23,22 +23,22 @@
new:procedure->method
new:procedure-rename
new:chaperone-procedure
new:proxy-procedure)
new:impersonate-procedure)
;; ----------------------------------------
(define-values (prop:keyword-proxy keyword-proxy? keyword-proxy-ref)
(make-struct-type-property 'keyword-proxy))
(define (keyword-procedure-proxy-of v)
(define-values (prop:keyword-impersonator keyword-impersonator? keyword-impersonator-ref)
(make-struct-type-property 'keyword-impersonator))
(define (keyword-procedure-impersonator-of v)
(cond
[(keyword-proxy? v) ((keyword-proxy-ref v) v)]
[(keyword-impersonator? v) ((keyword-impersonator-ref v) v)]
[else #f]))
(define-values (struct:keyword-procedure mk-kw-proc keyword-procedure?
keyword-procedure-ref keyword-procedure-set!)
(make-struct-type 'keyword-procedure #f 4 0 #f
(list (cons prop:checked-procedure #t)
(cons prop:proxy-of keyword-procedure-proxy-of))
(cons prop:impersonator-of keyword-procedure-impersonator-of))
(current-inspector)
#f
'(0 1 2 3)))
@ -131,13 +131,13 @@
;; is used for each evaluation of a keyword lambda.)
;; The `procedure' property is a per-type method that has exactly
;; the right arity, and that sends all arguments to `missing-kw'.
(define (make-required name fail-proc method? proxy?)
(define (make-required name fail-proc method? impersonator?)
(let-values ([(s: mk ? -ref -set!)
(make-struct-type (or name 'unknown)
(if proxy?
(if impersonator?
(if method?
struct:keyword-method-proxy
struct:keyword-procedure-proxy)
struct:keyword-method-impersonator
struct:keyword-procedure-impersonator)
(if method?
struct:keyword-method
struct:keyword-procedure))
@ -156,26 +156,26 @@
;; Proxies
(define-values (struct:keyword-procedure-proxy make-kpp keyword-procedure-proxy? kpp-ref kpp-set!)
(define-values (struct:keyword-procedure-impersonator make-kpp keyword-procedure-impersonator? kpp-ref kpp-set!)
(make-struct-type 'procedure
struct:keyword-procedure
1 0 #f
(list (cons prop:keyword-proxy (lambda (v) (kpp-ref v 0))))))
(define-values (struct:keyword-method-proxy make-kmp keyword-method-proxy? kmp-ref kmp-set!)
(list (cons prop:keyword-impersonator (lambda (v) (kpp-ref v 0))))))
(define-values (struct:keyword-method-impersonator make-kmp keyword-method-impersonator? kmp-ref kmp-set!)
(make-struct-type 'procedure
struct:keyword-method
1 0 #f
(list (cons prop:keyword-proxy (lambda (v) (kmp-ref v 0))))))
(define-values (struct:okpp make-optional-keyword-procedure-proxy okpp? okpp-ref okpp-set!)
(list (cons prop:keyword-impersonator (lambda (v) (kmp-ref v 0))))))
(define-values (struct:okpp make-optional-keyword-procedure-impersonator okpp? okpp-ref okpp-set!)
(make-struct-type 'procedure
struct:okp
1 0 #f
(list (cons prop:keyword-proxy (lambda (v) (okpp-ref v 0))))))
(define-values (struct:okmp make-optional-keyword-method-proxy okmp? okmp-ref okmp-set!)
(list (cons prop:keyword-impersonator (lambda (v) (okpp-ref v 0))))))
(define-values (struct:okmp make-optional-keyword-method-impersonator okmp? okmp-ref okmp-set!)
(make-struct-type 'procedure
struct:okp
1 0 #f
(list (cons prop:keyword-proxy (lambda (v) (okmp-ref v 0))))))
(list (cons prop:keyword-impersonator (lambda (v) (okmp-ref v 0))))))
;; ----------------------------------------
@ -1179,20 +1179,20 @@
(do-chaperone-procedure #f chaperone-procedure 'chaperone-procedure proc wrap-proc props))])
chaperone-procedure))
(define new:proxy-procedure
(let ([proxy-procedure
(define new:impersonate-procedure
(let ([impersonate-procedure
(lambda (proc wrap-proc . props)
(do-chaperone-procedure #t proxy-procedure 'proxy-procedure proc wrap-proc props))])
proxy-procedure))
(do-chaperone-procedure #t impersonate-procedure 'impersonate-procedure proc wrap-proc props))])
impersonate-procedure))
(define (do-chaperone-procedure is-proxy? chaperone-procedure name proc wrap-proc props)
(define (do-chaperone-procedure is-impersonator? chaperone-procedure name proc wrap-proc props)
(if (or (not (keyword-procedure? proc))
(not (procedure? wrap-proc))
;; if any bad prop, let `chaperone-procedure' complain
(let loop ([props props])
(cond
[(null? props) #f]
[(proxy-property? (car props))
[(impersonator-property? (car props))
(let ([props (cdr props)])
(or (null? props)
(loop (cdr props))))]
@ -1225,7 +1225,7 @@
name
(format
"~a procedure requires more keywords than original procedure: "
(if is-proxy? "proxying" "chaperoning"))
(if is-impersonator? "impersonating" "chaperoning"))
proc))
(unless (or (not b-allow)
(and a-allow
@ -1234,7 +1234,7 @@
name
(format
"~a procedure does not accept all keywords of original procedure: "
(if is-proxy? "proxying" "chaperoning"))
(if is-impersonator? "impersonating" "chaperoning"))
proc))
(let* ([kw-chaperone
(let ([p (keyword-procedure-proc wrap-proc)])
@ -1266,7 +1266,7 @@
wrap-proc))
(for-each
(lambda (kw new-arg arg)
(unless is-proxy?
(unless is-impersonator?
(unless (chaperone-of? new-arg arg)
(raise-mismatch-error
'|keyword procedure chaperone|
@ -1283,10 +1283,10 @@
[new-proc
(cond
[(okp? proc)
(if is-proxy?
(if is-impersonator?
((if (okm? proc)
make-optional-keyword-method-proxy
make-optional-keyword-procedure-proxy)
make-optional-keyword-method-impersonator
make-optional-keyword-procedure-impersonator)
(keyword-procedure-checker proc)
(chaperone-procedure (keyword-procedure-proc proc)
kw-chaperone)
@ -1305,7 +1305,7 @@
(chaperone-procedure proc
(okp-ref wrap-proc 0)))))]
[else
(if is-proxy?
(if is-impersonator?
;; Constructor must be from `make-required':
(let* ([name+fail (keyword-procedure-name+fail proc)]
[mk (make-required (car name+fail) (cdr name+fail) (keyword-method? proc) #t)])

4
collects/racket/private/pre-base.rkt
View File

@ -126,11 +126,11 @@
(rename new:procedure->method procedure->method)
(rename new:procedure-rename procedure-rename)
(rename new:chaperone-procedure chaperone-procedure)
(rename new:proxy-procedure proxy-procedure)
(rename new:impersonate-procedure impersonate-procedure)
(all-from-except '#%kernel lambda λ #%app #%module-begin apply prop:procedure
procedure-arity procedure-reduce-arity raise-arity-error
procedure->method procedure-rename
chaperone-procedure proxy-procedure)
chaperone-procedure impersonate-procedure)
(all-from "reqprov.rkt")
(all-from "for.rkt")
(all-from "kernstruct.rkt")

6
collects/scribblings/reference/booleans.scrbl
View File

@ -44,7 +44,7 @@ strings, byte strings, numbers, pairs, mutable pairs, vectors, boxes, hash
tables, and inspectable structures. In the last five cases, equality
is recursively defined; if both @scheme[v1] and @scheme[v2] contain
reference cycles, they are equal when the infinite unfoldings of the
values would be equal. See also @scheme[prop:equal+hash] and @racket[prop:proxy-of].
values would be equal. See also @scheme[prop:equal+hash] and @racket[prop:impersonator-of].
@examples[
(equal? 'yes 'yes)
@ -183,8 +183,8 @@ transparent structures, @scheme[equal-hash-code] and
values. For opaque structure types, @scheme[equal?] is the same as
@scheme[eq?], and @scheme[equal-hash-code] and
@scheme[equal-secondary-hash-code] results are based only on
@scheme[eq-hash-code]. If a structure has a @racket[prop:proxy-of]
property, then the @racket[prop:proxy-of] property takes precedence over
@scheme[eq-hash-code]. If a structure has a @racket[prop:impersonator-of]
property, then the @racket[prop:impersonator-of] property takes precedence over
@racket[prop:equal+hash] if the property value's procedure returns a
non-@racket[#f] value when applied to the structure.

264
collects/scribblings/reference/chaperones.scrbl
View File

@ -8,16 +8,16 @@
@(define-syntax-rule (operations i ...)
(itemlist #:style 'compact @item{@op[i]} ...))
@title[#:tag "chaperones"]{Proxies and Chaperones}
@title[#:tag "chaperones"]{Impersonators and Chaperones}
A @deftech{proxy} is a wrapper for a value where the wrapper
redirects certain of the value's operations. Proxies apply only to procedures,
An @deftech{impersonator} is a wrapper for a value where the wrapper
redirects certain of the value's operations. Impersonators apply only to procedures,
@tech{structures} for which an accessor or mutator is available,
@tech{structure types}, @tech{hash tables}, @tech{vectors},
and @tech{box}es. A proxied value is @scheme[equal?] to the original
and @tech{box}es. An impersonator is @scheme[equal?] to the original
value, but not @scheme[eq?] to the original value.
A @deftech{chaperone} is a kind of proxy whose refinement of a value's
A @deftech{chaperone} is a kind of impersonator whose refinement of a value's
operation is restricted to side effects (including, in particular,
raising an exception) or chaperoning values supplied to or produced by
the operation. For example, a vector chaperone can redirect
@ -27,16 +27,16 @@ to be a chaperoned variant of the value that is in the accessed vector
slot, but it cannot redirect @scheme[vector-ref] to produce a value
that is arbitrarily different from the value in the vector slot.
A non-@tech{chaperone} @tech{proxy}, in contrast, can refine an operation to swap one
value for any another. A proxy cannot be applied to an immutable value
A non-@tech{chaperone} @tech{impersonator}, in contrast, can refine an operation to swap one
value for any another. An impersonator cannot be applied to an immutable value
or refine the access to an immutable field in an instance of a @tech{structure
type}, since arbitrary replacement of an operation's value amounts to
mutation of the proxied value.
mutation of the impersonated value.
Beware that each of the following operations can be redirected to
arbitrary procedure through proxies on the operation's
arbitrary procedure through impersonators on the operation's
argument---assuming that the operation is available to the creator of
the proxy:
the impersonator:
@operations[@t{a structure-field accesor}
@t{a structure-field mutator}
@ -47,50 +47,50 @@ the proxy:
hash-ref hash-set hash-set! hash-remove hash-remove!]
Derived operations, such as printing a value, can be redirected
through proxies due to their use of accessor functions. The
through impersonators due to their use of accessor functions. The
@scheme[equal?], @scheme[equal-hash-code], and
@scheme[equal-secondary-hash-code] operations, in contrast, may bypass
proxies (but they are not obliged to).
impersonators (but they are not obliged to).
In addition to redirecting operations that work on a value, a
proxy can include @deftech{proxy properties} for a proxied
value. A @tech{proxy property} is similar to a @tech{structure
type property}, but it applies to chaperones instead of structure
impersonator can include @deftech{impersonator properties} for an impersonated
value. An @tech{impersonator property} is similar to a @tech{structure
type property}, but it applies to impersonators instead of structure
types and their instances.
@defproc[(proxy? [v any/c]) boolean?]{
@defproc[(impersonator? [v any/c]) boolean?]{
Returns @scheme[#t] if @scheme[v] is a proxy, @scheme[#f] otherwise.
Returns @scheme[#t] if @scheme[v] is an @tech{impersonator}, @scheme[#f] otherwise.
Programs and libraries generally should avoid @scheme[proxy?] and
treat proxies the same as unproxied values. In rare cases,
@scheme[proxy?] may be needed to guard against redirection by a
proxy of an operation to an arbitrary procedure.}
Programs and libraries generally should avoid @scheme[impersonator?] and
treat impersonators the same as non-impersonator values. In rare cases,
@scheme[impersonator?] may be needed to guard against redirection by an
impersonator of an operation to an arbitrary procedure.}
@defproc[(chaperone? [v any/c]) boolean?]{
Returns @scheme[#t] if @scheme[v] is a chaperone, @scheme[#f] otherwise.
Returns @scheme[#t] if @scheme[v] is a @tech{chaperone}, @scheme[#f] otherwise.
Programs and libraries generally should avoid @scheme[chaperone?] for
the same reason that they should avoid @racket[proxy?].}
the same reason that they should avoid @racket[impersonator?].}
@defproc[(proxy-of? [v1 any/c] [v2 any/c]) boolean?]{
@defproc[(impersonator-of? [v1 any/c] [v2 any/c]) boolean?]{
Indicates whether @scheme[v1] can be considered equivalent modulo
proxies to @scheme[v2].
impersonators to @scheme[v2].
For values that include no proxies, @scheme[v1] and @scheme[v2] can
be considered proxies of each other if they are @scheme[equal?].
For values that include no impersonators, @scheme[v1] and @scheme[v2] can
be considered impersonators of each other if they are @scheme[equal?].
Otherwise, all proxies of @scheme[v2] must be intact in @scheme[v1],
Otherwise, all impersonators of @scheme[v2] must be intact in @scheme[v1],
in the sense that parts of @scheme[v2] must be derived from
@scheme[v1] through one of the proxy constructors (e.g.,
@scheme[proxy-procedure] or @racket[chaperone-procedure]).
@scheme[v1] through one of the impersonator constructors (e.g.,
@scheme[impersonate-procedure] or @racket[chaperone-procedure]).
See also @racket[prop:proxy-of].}
See also @racket[prop:impersonator-of].}
@defproc[(chaperone-of? [v1 any/c] [v2 any/c]) boolean?]{
@ -109,16 +109,16 @@ from @scheme[v1] through one of the chaperone constructors (e.g.,
@scheme[chaperone-procedure]).}
@; ------------------------------------------------------------
@section{Proxy Constructors}
@section{Impersonator Constructors}
@defproc[(proxy-procedure [proc procedure?]
@defproc[(impersonate-procedure [proc procedure?]
[wrapper-proc procedure?]
[prop proxy-property?]
[prop impersonator-property?]
[prop-val any] ... ...)
(and/c procedure? proxy?)]{
(and/c procedure? impersonator?)]{
Returns a proxied procedure that has the same arity, name, and
other attributes as @scheme[proc]. When the proxied procedure is
Returns an impersonator procedure that has the same arity, name, and
other attributes as @scheme[proc]. When the impersonator procedure is
applied, the arguments are first passed to @scheme[wrapper-proc], and
then the results from @scheme[wrapper-proc] are passed to
@scheme[proc]. The @scheme[wrapper-proc] can also supply a procedure
@ -137,44 +137,44 @@ before the others. The additional result, if any, must be a procedure
that accepts as many results as produced by @scheme[proc]; it must
return the same number of results. If @scheme[wrapper-proc] returns
the same number of values as it is given (i.e., it does not return a
procedure to proxy @scheme[proc]'s result), then @scheme[proc] is
called in @tech{tail position} with respect to the call to the proxy.
procedure to impersonator @scheme[proc]'s result), then @scheme[proc] is
called in @tech{tail position} with respect to the call to the impersonator.
For applications that include keyword arguments, @scheme[wrapper-proc]
must return an additional value before any other values but after the
result-proxying procedure (if any). The additional value must be a
list of proxys of the keyword arguments that were supplied to the
proxied procedure (i.e., not counting optional arguments that were
result-impersonating procedure (if any). The additional value must be a
list of replacements for the keyword arguments that were supplied to the
impersonator (i.e., not counting optional arguments that were
not supplied). The arguments must be ordered according to the sorted
order of the supplied arguments' keywords.
Pairs of @scheme[prop] and @scheme[prop-val] (the number of arguments
to @scheme[procedure-proxy] must be even) add proxy properties
or override proxy-property values of @scheme[proc].
to @scheme[procedure-impersonator] must be even) add impersonator properties
or override impersonator-property values of @scheme[proc].
If any @scheme[prop] is @racket[proxy-prop:application-mark] and if the
If any @scheme[prop] is @racket[impersonator-prop:application-mark] and if the
associated @racket[prop-val] is a pair, then the call to @racket[proc]
is wrapped with @racket[with-continuation-mark] using @racket[(car
prop-val)] as the mark key and @racket[(cdr prop-val)] as the mark
value. In addition, if @racket[continuation-mark-set-first] with
@racket[(car prop-val)] produces a value for the immediate
continuation frame of the call to the proxied procedure, the value is
continuation frame of the call to the impersonated procedure, the value is
also installed as an immediate value for @racket[(car prop-val)] as a
mark during the call to @racket[wrapper-proc] (which allows tail-calls
of proxies with respect to wrapping proxies to be detected within
of impersonators with respect to wrapping impersonators to be detected within
@racket[wrapper-proc]).}
@defproc[(proxy-struct [v any/c]
@defproc[(impersonate-struct [v any/c]
[orig-proc (or/c struct-accessor-procedure?
struct-mutator-procedure?)]
[redirect-proc procedure?] ... ...
[prop proxy-property?]
[prop impersonator-property?]
[prop-val any] ... ...)
any/c]{
Returns a proxied value like @scheme[v], but with certain
operations on the proxied redirected. The @scheme[orig-proc]s
Returns an impersonator of @scheme[v], with redirect certain
operations on the impersonated value. The @scheme[orig-proc]s
indicate the operations to redirect, and the corresponding
@scheme[redirect-proc]s supply the redirections.
@ -183,14 +183,14 @@ The protocol for a @scheme[redirect-proc] depends on the corresponding
@itemlist[
@item{A structure-field: @scheme[redirect-proc]
@item{A structure-field accessor: @scheme[redirect-proc]
must accept two arguments, @scheme[v] and the value
@scheme[_field-v] that @scheme[orig-proc] produces for
@scheme[v]; it must return a replacement for
@scheme[_field-v]. The corresponding field must not be
immutable.}
@item{A structure field mutator: @scheme[redirect-proc] must accept
@item{A structure-field mutator: @scheme[redirect-proc] must accept
two arguments, @scheme[v] and the value @scheme[_field-v]
supplied to the mutator; it must return a replacement for
@scheme[_field-v] to be propagated to @scheme[orig-proc] and
@ -199,25 +199,24 @@ The protocol for a @scheme[redirect-proc] depends on the corresponding
]
Pairs of @scheme[prop] and @scheme[prop-val] (the number of arguments
to @scheme[proxy-procedure] must be odd) add proxy properties
or override proxy-property values of @scheme[v].}
to @scheme[impersonate-struct] must be odd) add impersonator properties
or override impersonator-property values of @scheme[v].}
@defproc[(proxy-vector [vec (and/c vector? (not/c immutable?))]
@defproc[(impersonate-vector [vec (and/c vector? (not/c immutable?))]
[ref-proc (vector? exact-nonnegative-integer? any/c . -> . any/c)]
[set-proc (vector? exact-nonnegative-integer? any/c . -> . any/c)]
[prop proxy-property?]
[prop impersonator-property?]
[prop-val any] ... ...)
(and/c vector? proxy?)]{
(and/c vector? impersonator?)]{
Returns a proxied value like @scheme[vec], but with
@scheme[vector-ref] and @scheme[vector-set!] operations on the
proxied vector redirected.
Returns an impersonator of @scheme[vec], which redirects the
@scheme[vector-ref] and @scheme[vector-set!] operations.
The @scheme[ref-proc] must accept @scheme[vec], an index passed to
@scheme[vector-ref], and the value that @scheme[vector-ref] on
@scheme[vec] produces for the given index; it must produce a
replacement for the value, which is the result of @scheme[vector-ref]
on the proxy.
on the impersonator.
The @scheme[set-proc] must accept @scheme[vec], an index passed to
@scheme[vector-set!], and the value passed to @scheme[vector-set!]; it
@ -226,24 +225,23 @@ with @scheme[vector-set!] on the original @scheme[vec] to install the
value.
Pairs of @scheme[prop] and @scheme[prop-val] (the number of arguments
to @scheme[proxy-vector] must be odd) add proxy properties
or override proxy-property values of @scheme[vec].}
to @scheme[impersonate-vector] must be odd) add impersonator properties
or override impersonator-property values of @scheme[vec].}
@defproc[(proxy-box [box (and/c box? (not/c immutable?))]
@defproc[(impersonate-box [box (and/c box? (not/c immutable?))]
[unbox-proc (box? any/c . -> . any/c)]
[set-proc (box? any/c . -> . any/c)]
[prop proxy-property?]
[prop impersonator-property?]
[prop-val any] ... ...)
(and/c box? proxy?)]{
(and/c box? impersonator?)]{
Returns a proxied value like @scheme[bx], but with
@scheme[unbox] and @scheme[set-box!] operations on the
proxied box redirected.
Returns an impersonator of @scheme[bx], which redirects the
@scheme[unbox] and @scheme[set-box!] operations.
The @scheme[unbox-proc] must accept @scheme[bx] and the value that
@scheme[unbox] on @scheme[bx] produces index; it must produce a replacement
value, which is the result of
@scheme[unbox] on the proxy.
@scheme[unbox] on the impersonator.
The @scheme[set-proc] must accept @scheme[bx] and the value passed to
@scheme[set-box!]; it must produce a replacement
@ -251,28 +249,28 @@ value, which is used with @scheme[set-box!] on the original
@scheme[bx] to install the value.
Pairs of @scheme[prop] and @scheme[prop-val] (the number of arguments
to @scheme[proxy-box] must be odd) add proxy properties
or override proxy-property values of @scheme[bx].}
to @scheme[impersonate-box] must be odd) add impersonator properties
or override impersonator-property values of @scheme[bx].}
@defproc[(proxy-hash [hash (and/c hash? (not/c immutable?))]
@defproc[(impersonate-hash [hash (and/c hash? (not/c immutable?))]
[ref-proc (hash? any/c . -> . (values
any/c
(hash? any/c any/c . -> . any/c)))]
[set-proc (hash? any/c any/c . -> . (values any/c any/c))]
[remove-proc (hash? any/c . -> . any/c)]
[key-proc (hash? any/c . -> . any/c)]
[prop proxy-property?]
[prop impersonator-property?]
[prop-val any] ... ...)
(and/c hash? proxy?)]{
(and/c hash? impersonator?)]{
Returns a proxied value like @scheme[hash], but with
Returns an impersonator of @scheme[hash], which redirects the
@scheme[hash-ref], @scheme[hash-set!] or @scheme[hash-set] (as
applicable) and @scheme[hash-remove] or @scheme[hash-remove!] (as
application) operations on the proxied hash table redirected. When
@scheme[hash-set] or @scheme[hash-remove] is used on a proxied hash
table, the resulting hash table is given all of the proxys of the
given hash table. In addition, operations like
applicable), and @scheme[hash-remove] or @scheme[hash-remove!] (as
application) operations. When
@scheme[hash-set] or @scheme[hash-remove] is used on an impersonator of a hash
table, the result is an impersonator with the same redirecting procedures.
In addition, operations like
@scheme[hash-iterate-key] or @scheme[hash-map], which extract
keys from the table, use @scheme[key-proc] to filter keys extracted
from the table. Operations like @scheme[hash-iterate-value] or
@ -285,7 +283,7 @@ as well as a procedure. The returned procedure is called only if the
returned key is found in @scheme[hash] via @scheme[hash-ref], in which
case the procedure is called with @scheme[hash], the previously
returned key, and the found value. The returned procedure must itself
return a replecement for the found value.
return a replacement for the found value.
The @scheme[set-proc] must accept @scheme[hash], a key passed to
@scheme[hash-set!] or @scheme[hash-set], and the value passed to
@ -298,7 +296,7 @@ The @scheme[remove-proc] must accept @scheme[hash] and a key passed to
@scheme[hash-remove!] or @scheme[hash-remove]; it must produce the a
replacement for the key, which is used with @scheme[hash-remove!] or
@scheme[hash-remove] on the original @scheme[hash] to remove any
mapping using the (proxy-replaced) key.
mapping using the (impersonator-replaced) key.
The @scheme[key-proc] must accept @scheme[hash] and a key that has
been extracted from @scheme[hash] (by @scheme[hash-iterate-key] or
@ -313,38 +311,38 @@ produced by @scheme[key-proc] does not yield a value through
@racket[hash-ref], then the @exnraise[exn:fail:contract].
Pairs of @scheme[prop] and @scheme[prop-val] (the number of arguments
to @scheme[proxy-hash] must be odd) add proxy properties
or override proxy-property values of @scheme[hash].}
to @scheme[impersonate-hash] must be odd) add impersonator properties
or override impersonator-property values of @scheme[hash].}
@defthing[prop:proxy-of struct-type-property?]{
@defthing[prop:impersonator-of struct-type-property?]{
A @tech{structure type property} (see @secref["structprops"]) that
supplies a procedure for extracting a proxied value from a structure
that represents a proxy. The property is used for @racket[proxy-of]
supplies a procedure for extracting an impersonated value from a structure
that represents an impersonator. The property is used for @racket[impersonator-of]
as well as @racket[equal?].
The property value must be a procedure of one argument, which is a
structure whose structure type has the property. The result can be
@scheme[#f] to indicate the structure does not represent a proxy,
otherwise the result is a value for which the original structure is a
proxy (so the original structure is a @racket[proxy-of?] and it is
@scheme[#f] to indicate the structure does not represent an impersonator,
otherwise the result is a value for which the original structure is an
impersonator (so the original structure is an @racket[impersonator-of?] and
@racket[equal?] to the result value). The result value must have the
same @racket[prop:proxy-of] and @racket[prop:equal+hash] property
same @racket[prop:impersonator-of] and @racket[prop:equal+hash] property
values as the original structure, and the property values must be
inherited from the same structure type (which ensures some consistency
between @racket[proxy-of?] and @racket[equal?]).}
between @racket[impersonator-of?] and @racket[equal?]).}
@; ------------------------------------------------------------
@section{Chaperone Constructors}
@defproc[(chaperone-procedure [proc procedure?]
[wrapper-proc procedure?]
[prop proxy-property?]
[prop impersonator-property?]
[prop-val any] ... ...)
(and/c procedure? chaperone?)]{
Like @racket[proxy-procedure], but for each value supplied to
Like @racket[impersonate-procedure], but for each value supplied to
@scheme[wrapper-proc], the corresponding result must be the same or a
chaperone of (in the sense of @scheme[chaperone-of?]) the supplied
value. The additional result, if any, that precedes the chaperoned
@ -356,7 +354,7 @@ For applications that include keyword arguments, @scheme[wrapper-proc]
must return an additional value before any other values but after the
result-chaperoning procedure (if any). The additional value must be a
list of chaperones of the keyword arguments that were supplied to the
chaperoned procedure (i.e., not counting optional arguments that were
chaperone procedure (i.e., not counting optional arguments that were
not supplied). The arguments must be ordered according to the sorted
order of the supplied arguments' keywords.}
@ -366,18 +364,18 @@ order of the supplied arguments' keywords.}
struct-type-property-accessor-procedure?
(one-of/c struct-info))]
[redirect-proc procedure?] ... ...
[prop proxy-property?]
[prop impersonator-property?]
[prop-val any] ... ...)
any/c]{
Like @racket[proxy-struct], but with the following refinements:
Like @racket[impersonate-struct], but with the following refinements:
@itemlist[
@item{With a structure-field accessor as @racket[orig-proc],
@scheme[redirect-proc] must accept two arguments, @scheme[v] and
the value @scheme[_field-v] that @scheme[orig-proc] produces for
@scheme[v]; it must return chaperone of @scheme[_field-v]. The
@scheme[v]; it must return a chaperone of @scheme[_field-v]. The
corresponding field may be immutable.}
@item{A property accessor can be supplied as @racket[orig-proc]. The
@ -387,7 +385,7 @@ Like @racket[proxy-struct], but with the following refinements:
@item{With structure-field mutator as @racket[orig-proc],
@scheme[redirect-proc] must accept two arguments, @scheme[v] and
the value @scheme[_field-v] supplied to the mutator; it must
return chaperone of @scheme[_field-v] to be propagated to
return a chaperone of @scheme[_field-v] to be propagated to
@scheme[orig-proc] and @scheme[v].}
@item{With @scheme[struct-info] as @racket[orig-proc], the
@ -408,11 +406,11 @@ unchaperoned.}
@defproc[(chaperone-vector [vec vector?]
[ref-proc (vector? exact-nonnegative-integer? any/c . -> . any/c)]
[set-proc (vector? exact-nonnegative-integer? any/c . -> . any/c)]
[prop proxy-property?]
[prop impersonator-property?]
[prop-val any] ... ...)
(and/c vector? chaperone?)]{
Like @racket[proxy-vector], but with support for mutable vectors. The
Like @racket[impersonate-vector], but with support for immutable vectors. The
@scheme[ref-proc] procedure must produce the same value or a chaperone
of the original value, and @scheme[set-proc] must produce the value
that is given or a chaperone of the value. The @scheme[set-proc] will
@ -421,7 +419,7 @@ not be used if @scheme[vec] is immutable.}
@defproc[(chaperone-box [bx box?]
[unbox-proc (box? any/c . -> . any/c)]
[set-proc (box? any/c . -> . any/c)]
[prop proxy-property?]
[prop impersonator-property?]
[prop-val any] ... ...)
(and/c box? chaperone?)]{
@ -439,11 +437,11 @@ the same value or a chaperone of the value that it is given. The
[set-proc (hash? any/c any/c . -> . (values any/c any/c))]
[remove-proc (hash? any/c . -> . any/c)]
[key-proc (hash? any/c . -> . any/c)]
[prop proxy-property?]
[prop impersonator-property?]
[prop-val any] ... ...)
(and/c hash? chaperone?)]{
Like @racket[proxy-hash], but with constraints on the given functions
Like @racket[impersonate-hash], but with constraints on the given functions
and support for immutable hashes. The @scheme[ref-proc] procedure must
return a found value or a chaperone of the value. The
@scheme[set-proc] procedure must produce two values: the key that it
@ -455,7 +453,7 @@ procedures must produce the given key or a chaperone of the key.}
[struct-info-proc procedure?]
[make-constructor-proc (procedure? . -> . procedure?)]
[guard-proc procedure?]
[prop proxy-property?]
[prop impersonator-property?]
[prop-val any] ... ...)
(and/c struct-type? chaperone?)]{
@ -486,12 +484,12 @@ each the same or a chaperone of the corresponding argument. The
created of the chaperoned structure type.
Pairs of @scheme[prop] and @scheme[prop-val] (the number of arguments
to @scheme[chaperone-struct-type] must be even) add proxy properties
or override proxy-property values of @scheme[struct-type].}
to @scheme[chaperone-struct-type] must be even) add impersonator properties
or override impersonator-property values of @scheme[struct-type].}
@defproc[(chaperone-evt [evt evt?]
[proc (evt? . -> . (values evt? (any/c . -> . any/c)))]
[prop proxy-property?]
[prop impersonator-property?]
[prop-val any] ... ...)
(and/c evt? chaperone?)]{
@ -508,52 +506,52 @@ a selection. The latter procedure accepts the result of @racket[evt],
and it must return a chaperone of that value.
Pairs of @scheme[prop] and @scheme[prop-val] (the number of arguments
to @scheme[chaperone-struct-type] must be even) add proxy properties
or override proxy-property values of @scheme[evt].}
to @scheme[chaperone-evt] must be even) add impersonator properties
or override impersonator-property values of @scheme[evt].}
@; ------------------------------------------------------------
@section{Proxy Properties}
@section{Impersonator Properties}
@defproc[(make-proxy-property [name symbol?])
(values proxy-property?
@defproc[(make-impersonator-property [name symbol?])
(values impersonator-property?
(-> any/c boolean?)
(-> chaperone? any))]{
(-> impersonator? any))]{
Creates a new @tech{proxy property} and returns three values:
Creates a new @tech{impersonator property} and returns three values:
@itemize[
@item{a @deftech{proxy property descriptor}, for use with
@scheme[chaperone-procedure], @scheme[chaperone-struct], and
other chaperone constructors;}
@item{an @deftech{impersonator property descriptor}, for use with
@scheme[impersonate-procedure], @scheme[chaperone-procedure],
and other impersonator constructors;}
@item{a @deftech{proxy property predicate} procedure, which takes
an arbitrary value and returns @scheme[#t] if the value is a
chaperone with a value for the property, @scheme[#f]
@item{an @deftech{impersonator property predicate} procedure, which takes
an arbitrary value and returns @scheme[#t] if the value is an
impersonator with a value for the property, @scheme[#f]
otherwise;}
@item{an @deftech{proxy property accessor} procedure, which
returns the value associated with a chaperone for the property;
if a value given to the accessor is not a chaperone or does not
have a value for the property (ie if the corresponding chaperone
@item{an @deftech{impersonator property accessor} procedure, which
returns the value associated with an impersonator for the property;
if a value given to the accessor is not an impersonator or does not
have a value for the property (i.e. if the corresponding impersonator
property predicate returns @racket[#f]), the accessor raises
@exnraise[exn:fail:contract].}
]}
@defproc[(proxy-property? [v any/c]) boolean?]{
@defproc[(impersonator-property? [v any/c]) boolean?]{
Returns @scheme[#t] if @scheme[v] is a @tech{proxy property
Returns @scheme[#t] if @scheme[v] is a @tech{impersonator property
descriptor} value, @scheme[#f] otherwise.}
@defproc[(proxy-property-accessor-procedure? [v any/c]) boolean?]{
@defproc[(impersonator-property-accessor-procedure? [v any/c]) boolean?]{
Returns @scheme[#t] if @scheme[v] is an accessor procedure produced
by @scheme[make-proxy-property], @scheme[#f] otherwise.}
by @scheme[make-impersonator-property], @scheme[#f] otherwise.}
@defthing[proxy-prop:application-mark proxy-property?]{
@defthing[impersonator-prop:application-mark impersonator-property?]{
A @tech{proxy property} that is recognized by @racket[proxy-procedure]
An @tech{impersonator property} that is recognized by @racket[impersonate-procedure]
and @racket[chaperone-procedure].}

8
collects/scribblings/reference/contracts.scrbl
View File

@ -246,7 +246,7 @@ is a chaperone contract, then the result will be a chaperone contract.
When a higher-order @racket[vectorof] contract is applied to a vector, the result
is not @racket[eq?] to the input. The result will be a copy for immutable vectors
and a @tech{chaperone} or @tech{proxy} of the input for mutable vectors.}
and a @tech{chaperone} or @tech{impersonator} of the input for mutable vectors.}
@defproc[(vector-immutableof [c contract?]) contract?]{
@ -272,7 +272,7 @@ are chaperone contracts, then the result will be a chaperone contract.
When a higher-order @racket[vector/c] contract is applied to a vector, the result
is not @racket[eq?] to the input. The result will be a copy for immutable vectors
and a @tech{chaperone} or @tech{proxy} of the input for mutable vectors.}
and a @tech{chaperone} or @tech{impersonator} of the input for mutable vectors.}
@defproc[(vector-immutable/c [c contract?] ...) contract?]{
@ -298,7 +298,7 @@ a chaperone contract, then the result will be a chaperone contract.
When a higher-order @racket[box/c] contract is applied to a box, the result
is not @racket[eq?] to the input. The result will be a copy for immutable boxes
and either a @tech{chaperone} or @tech{proxy} of the input for mutable boxes.}
and either a @tech{chaperone} or @tech{impersonator} of the input for mutable boxes.}
@defproc[(box-immutable/c [c contract?]) contract?]{
@ -377,7 +377,7 @@ If the @racket[key] argument is a chaperone contract, then the resulting contrac
can only be applied to @racket[equal?]-based hash tables. When a higher-order
@racket[hash/c] contract is applied to a hash table, the result is not @racket[eq?]
to the input. The result will be a copy for immutable hash tables, and either a
@tech{chaperone} or @tech{proxy} of the input for mutable hash tables.
@tech{chaperone} or @tech{impersonator} of the input for mutable hash tables.
}

14
collects/scribblings/reference/unsafe.scrbl
View File

@ -194,8 +194,8 @@ Unsafe variants of @scheme[car], @scheme[cdr], @scheme[mcar],
@deftogether[(
@defproc[(unsafe-unbox [b box?]) fixnum?]
@defproc[(unsafe-set-box! [b box?] [k fixnum?]) void?]
@defproc[(unsafe-unbox* [v (and/c box? (not/c chaperone?))]) any/c]
@defproc[(unsafe-set-box*! [v (and/c box? (not/c chaperone?))] [val any/c]) void?]
@defproc[(unsafe-unbox* [v (and/c box? (not/c impersonator?))]) any/c]
@defproc[(unsafe-set-box*! [v (and/c box? (not/c impersonator?))] [val any/c]) void?]
)]{
Unsafe versions of @scheme[unbox] and @scheme[set-box!].}
@ -205,9 +205,9 @@ Unsafe versions of @scheme[unbox] and @scheme[set-box!].}
@defproc[(unsafe-vector-length [v vector?]) fixnum?]
@defproc[(unsafe-vector-ref [v vector?] [k fixnum?]) any/c]
@defproc[(unsafe-vector-set! [v vector?] [k fixnum?] [val any/c]) void?]
@defproc[(unsafe-vector*-length [v (and/c vector? (not/c chaperone?))]) fixnum?]
@defproc[(unsafe-vector*-ref [v (and/c vector? (not/c chaperone?))] [k fixnum?]) any/c]
@defproc[(unsafe-vector*-set! [v (and/c vector? (not/c chaperone?))] [k fixnum?] [val any/c]) void?]
@defproc[(unsafe-vector*-length [v (and/c vector? (not/c impersonator?))]) fixnum?]
@defproc[(unsafe-vector*-ref [v (and/c vector? (not/c impersonator?))] [k fixnum?]) any/c]
@defproc[(unsafe-vector*-set! [v (and/c vector? (not/c impersonator?))] [k fixnum?] [val any/c]) void?]
)]{
Unsafe versions of @scheme[vector-length], @scheme[vector-ref], and
@ -284,8 +284,8 @@ Unsafe versions of @scheme[u16vector-ref] and
@deftogether[(
@defproc[(unsafe-struct-ref [v any/c] [k fixnum?]) any/c]
@defproc[(unsafe-struct-set! [v any/c] [k fixnum?] [val any/c]) void?]
@defproc[(unsafe-struct*-ref [v (not/c chaperone?)] [k fixnum?]) any/c]
@defproc[(unsafe-struct*-set! [v (not/c chaperone?)] [k fixnum?] [val any/c]) void?]
@defproc[(unsafe-struct*-ref [v (not/c impersonator?)] [k fixnum?]) any/c]
@defproc[(unsafe-struct*-set! [v (not/c impersonator?)] [k fixnum?] [val any/c]) void?]
)]{
Unsafe field access and update for an instance of a structure

260
collects/tests/racket/chaperone.rktl
View File

@ -5,41 +5,41 @@
;; ----------------------------------------
(define (chaperone-of?/proxy a b)
(test #t proxy-of? a b)
(define (chaperone-of?/impersonator a b)
(test #t impersonator-of? a b)
(chaperone-of? a b))
(define (chaperone?/proxy a)
(test #t proxy? a)
(define (chaperone?/impersonator a)
(test #t impersonator? a)
(chaperone? a))
(define-syntax-rule (as-chaperone-or-proxy ([orig proxy] ...) body ...)
(define-syntax-rule (as-chaperone-or-impersonator ([orig impersonator] ...) body ...)
(for-each (lambda (orig ...)
body ...)
(list orig proxy) ...))
(list orig impersonator) ...))
;; ----------------------------------------
(test #t chaperone-of?/proxy 10 10)
(test #t chaperone-of?/proxy '(10) '(10))
(test #t chaperone-of?/proxy '#(1 2 3) '#(1 2 3))
(test #t chaperone-of?/proxy '#&(1 2 3) '#&(1 2 3))
(test #t chaperone-of?/impersonator 10 10)
(test #t chaperone-of?/impersonator '(10) '(10))
(test #t chaperone-of?/impersonator '#(1 2 3) '#(1 2 3))
(test #t chaperone-of?/impersonator '#&(1 2 3) '#&(1 2 3))
(test #f chaperone-of?/proxy (make-string 1 #\x) (make-string 1 #\x))
(test #t chaperone-of?/proxy
(test #f chaperone-of?/impersonator (make-string 1 #\x) (make-string 1 #\x))
(test #t chaperone-of?/impersonator
(string->immutable-string (make-string 1 #\x))
(string->immutable-string (make-string 1 #\x)))
(define (either-chaperone-of?/proxy a b)
(or (chaperone-of?/proxy a b)
(chaperone-of?/proxy b a)))
(test #f either-chaperone-of?/proxy
(define (either-chaperone-of?/impersonator a b)
(or (chaperone-of?/impersonator a b)
(chaperone-of?/impersonator b a)))
(test #f either-chaperone-of?/impersonator
(string->immutable-string "x")
(make-string 1 #\x))
(test #f either-chaperone-of?/proxy
(test #f either-chaperone-of?/impersonator
'#(1 2 3)
(vector 1 2 3))
(test #f either-chaperone-of?/proxy
(test #f either-chaperone-of?/impersonator
'#&17
(box 17))
@ -50,19 +50,19 @@
(define-struct q (u [w #:mutable]) #:transparent)
(define-struct (q2 q) (v) #:transparent)
(test #f chaperone-of? (make-o 1 2) (make-o 1 2))
(test #f proxy-of? (make-o 1 2) (make-o 1 2))
(test #t chaperone-of?/proxy (make-p 1 2) (make-p 1 2))
(test #f chaperone-of?/proxy (make-p 1 (box 2)) (make-p 1 (box 2)))
(test #t chaperone-of?/proxy (make-p2 1 2 3) (make-p2 1 2 3))
(test #f chaperone-of?/proxy (make-q 1 2) (make-q 1 2))
(test #f chaperone-of?/proxy (make-q2 1 2 3) (make-q2 1 2 3)))
(test #f impersonator-of? (make-o 1 2) (make-o 1 2))
(test #t chaperone-of?/impersonator (make-p 1 2) (make-p 1 2))
(test #f chaperone-of?/impersonator (make-p 1 (box 2)) (make-p 1 (box 2)))
(test #t chaperone-of?/impersonator (make-p2 1 2 3) (make-p2 1 2 3))
(test #f chaperone-of?/impersonator (make-q 1 2) (make-q 1 2))
(test #f chaperone-of?/impersonator (make-q2 1 2 3) (make-q2 1 2 3)))
(let* ([p (lambda (x) x)]
[p1 (proxy-procedure p (lambda (y) y))]
[p1 (impersonate-procedure p (lambda (y) y))]
[p2 (chaperone-procedure p1 (lambda (y) y))])
(test #t proxy-of? p2 p)
(test #t proxy-of? p2 p1)
(test #t proxy? p1)
(test #t impersonator-of? p2 p)
(test #t impersonator-of? p2 p1)
(test #t impersonator? p1)
(test #f chaperone? p1)
(test #t chaperone? p2)
(test #f chaperone-of? p2 p)
@ -70,18 +70,18 @@
;; ----------------------------------------
(test #t chaperone?/proxy (chaperone-box (box 10) (lambda (b v) v) (lambda (b v) v)))
(test #f chaperone?/proxy (proxy-box (box 10) (lambda (b v) v) (lambda (b v) v)))
(test #t chaperone?/impersonator (chaperone-box (box 10) (lambda (b v) v) (lambda (b v) v)))
(test #f chaperone?/impersonator (impersonate-box (box 10) (lambda (b v) v) (lambda (b v) v)))
(test #t box? (chaperone-box (box 10) (lambda (b v) v) (lambda (b v) v)))
(test #t box? (proxy-box (box 10) (lambda (b v) v) (lambda (b v) v)))
(test #t box? (impersonate-box (box 10) (lambda (b v) v) (lambda (b v) v)))
(test #t (lambda (x) (box? x)) (chaperone-box (box 10) (lambda (b v) v) (lambda (b v) v)))
(test #t (lambda (x) (box? x)) (proxy-box (box 10) (lambda (b v) v) (lambda (b v) v)))
(test #t chaperone?/proxy (chaperone-box (box-immutable 10) (lambda (b v) v) (lambda (b v) v)))
(err/rt-test (proxy-box (box-immutable 10) (lambda (b v) v) (lambda (b v) v)))
(test #t (lambda (x) (box? x)) (impersonate-box (box 10) (lambda (b v) v) (lambda (b v) v)))
(test #t chaperone?/impersonator (chaperone-box (box-immutable 10) (lambda (b v) v) (lambda (b v) v)))
(err/rt-test (impersonate-box (box-immutable 10) (lambda (b v) v) (lambda (b v) v)))
(as-chaperone-or-proxy
([chaperone-box proxy-box]
[chaperone-of? proxy-of?])
(as-chaperone-or-impersonator
([chaperone-box impersonate-box]
[chaperone-of? impersonator-of?])
(let* ([b (box 0)]
[b2 (chaperone-box b
(lambda (b v)
@ -114,9 +114,9 @@
(test #f unbox b2)
(err/rt-test (set-box! b2 0)))))
;; no proxy-of checks in a proxy:
;; no impersonator-of checks in a impersonator:
(let ([b (box 0)])
(let ([b2 (proxy-box b
(let ([b2 (impersonate-box b
(lambda (b v) #f)
(lambda (b v) #f))])
(test #f unbox b2)
@ -126,19 +126,19 @@
;; ----------------------------------------
(test #t chaperone?/proxy (chaperone-vector (vector 1 2 3) (lambda (b i v) v) (lambda (b i v) v)))
(test #t chaperone?/impersonator (chaperone-vector (vector 1 2 3) (lambda (b i v) v) (lambda (b i v) v)))
(test #t vector? (chaperone-vector (vector 1 2 3) (lambda (b i v) v) (lambda (b i v) v)))
(test #t vector? (proxy-vector (vector 1 2 3) (lambda (b i v) v) (lambda (b i v) v)))
(test #t vector? (impersonate-vector (vector 1 2 3) (lambda (b i v) v) (lambda (b i v) v)))
(test #t (lambda (x) (vector? x)) (chaperone-vector (vector 1 2 3) (lambda (b i v) v) (lambda (b i v) v)))
(test #t (lambda (x) (vector? x)) (proxy-vector (vector 1 2 3) (lambda (b i v) v) (lambda (b i v) v)))
(test #t chaperone?/proxy (chaperone-vector (vector-immutable 1 2 3) (lambda (b i v) v) (lambda (b i v) v)))
(err/rt-test (proxy-vector (vector-immutable 1 2 3) (lambda (b i v) v) (lambda (b i v) v)))
(test #t (lambda (x) (vector? x)) (impersonate-vector (vector 1 2 3) (lambda (b i v) v) (lambda (b i v) v)))
(test #t chaperone?/impersonator (chaperone-vector (vector-immutable 1 2 3) (lambda (b i v) v) (lambda (b i v) v)))
(err/rt-test (impersonate-vector (vector-immutable 1 2 3) (lambda (b i v) v) (lambda (b i v) v)))
(test #(1 2 3) make-reader-graph (chaperone-vector (vector 1 2 3) (lambda (b i v) v) (lambda (b i v) v)))
(as-chaperone-or-proxy
([chaperone-vector proxy-vector]
[chaperone-of? proxy-of?])
(as-chaperone-or-impersonator
([chaperone-vector impersonate-vector]
[chaperone-of? impersonator-of?])
(let* ([b (vector 1 2 3)]
[b2 (chaperone-vector b
(lambda (b i v)
@ -176,9 +176,9 @@
(test #f vector-ref b2 0)
(err/rt-test (vector-set! b2 0 0))))
;; no proxy-of checks in a proxy:
;; no impersonator-of checks in a impersonator:
(let ([b (vector 0)])
(let ([b2 (proxy-vector b
(let ([b2 (impersonate-vector b
(lambda (b i v) #f)
(lambda (b i v) #f))])
(test #f vector-ref b2 0)
@ -188,26 +188,26 @@
;; ----------------------------------------
(test #t chaperone?/proxy (chaperone-procedure (lambda (x) x) (lambda (y) y)))
(test #t proxy? (proxy-procedure (lambda (x) x) (lambda (y) y)))
(test #t chaperone?/impersonator (chaperone-procedure (lambda (x) x) (lambda (y) y)))
(test #t impersonator? (impersonate-procedure (lambda (x) x) (lambda (y) y)))
(test #t procedure? (chaperone-procedure (lambda (x) x) (lambda (y) y)))
(test #t procedure? (proxy-procedure (lambda (x) x) (lambda (y) y)))
(test #t procedure? (impersonate-procedure (lambda (x) x) (lambda (y) y)))
(test #t (lambda (x) (procedure? x)) (chaperone-procedure (lambda (x) x) (lambda (y) y)))
(test #t (lambda (x) (procedure? x)) (proxy-procedure (lambda (x) x) (lambda (y) y)))
(test #t (lambda (x) (procedure? x)) (impersonate-procedure (lambda (x) x) (lambda (y) y)))
(err/rt-test (chaperone-procedure (lambda (x) x) (lambda (y z) y)))
(err/rt-test (proxy-procedure (lambda (x) x) (lambda (y z) y)))
(err/rt-test (impersonate-procedure (lambda (x) x) (lambda (y z) y)))
(err/rt-test (chaperone-procedure (case-lambda [() 0] [(x) x]) (lambda (y) y)))
(err/rt-test (proxy-procedure (case-lambda [() 0] [(x) x]) (lambda (y) y)))
(err/rt-test (impersonate-procedure (case-lambda [() 0] [(x) x]) (lambda (y) y)))
(test 88 (proxy-procedure (lambda (x) x) (lambda (y) 88)) 10)
(test 88 (impersonate-procedure (lambda (x) x) (lambda (y) 88)) 10)
(err/rt-test ((chaperone-procedure (lambda (x) x) (lambda (y) 88)) 10))
(test 89 (proxy-procedure (lambda (x) x) (lambda (y) (values (lambda (z) 89) y))) 10)
(test 89 (impersonate-procedure (lambda (x) x) (lambda (y) (values (lambda (z) 89) y))) 10)
(err/rt-test ((chaperone-procedure (lambda (x) x) (lambda (y) (values (lambda (z) 89) y))) 10))
;; Single argument, no post filter:
(as-chaperone-or-proxy
([chaperone-procedure proxy-procedure])
(as-chaperone-or-impersonator
([chaperone-procedure impersonate-procedure])
(let* ([f (lambda (x) (list x x))]
[in #f]
[f2 (chaperone-procedure
@ -221,8 +221,8 @@
(test 111 values in)))
;; Multiple arguments, no post filter:
(as-chaperone-or-proxy
([chaperone-procedure proxy-procedure])
(as-chaperone-or-impersonator
([chaperone-procedure impersonate-procedure])
(let* ([f (lambda (x y) (list x y))]
[in #f]
[f2 (chaperone-procedure
@ -236,8 +236,8 @@
(test (vector 1110 1111) values in)))
;; Single argument, post filter on single value:
(as-chaperone-or-proxy
([chaperone-procedure proxy-procedure])
(as-chaperone-or-impersonator
([chaperone-procedure impersonate-procedure])
(let* ([f (lambda (x) (list x x))]
[in #f]
[out #f]
@ -257,8 +257,8 @@
(test '(11 11) values out)))
;; Multiple arguments, post filter on multiple values:
(as-chaperone-or-proxy
([chaperone-procedure proxy-procedure])
(as-chaperone-or-impersonator
([chaperone-procedure impersonate-procedure])
(let* ([f (lambda (x y z) (values y (list x z)))]
[in #f]
[out #f]
@ -278,8 +278,8 @@
(test (vector 'b '(a c)) values out)))
;; Optional keyword arguments:
(as-chaperone-or-proxy
([chaperone-procedure proxy-procedure])
(as-chaperone-or-impersonator
([chaperone-procedure impersonate-procedure])
(let* ([f (lambda (x #:a [a 'a] #:b [b 'b]) (list x a b))]
[in #f]
[f2 (chaperone-procedure
@ -305,8 +305,8 @@
(test-values '(() (#:a #:b)) (lambda () (procedure-keywords f2)))))
;; Optional keyword arguments with result chaperone:
(as-chaperone-or-proxy
([chaperone-procedure proxy-procedure])
(as-chaperone-or-impersonator
([chaperone-procedure impersonate-procedure])
(let* ([f (lambda (x #:a [a 'a] #:b [b 'b]) (list x a b))]
[in #f]
[out #f]
@ -338,8 +338,8 @@
(test-values '(() (#:a #:b)) (lambda () (procedure-keywords f2)))))
;; Required keyword arguments:
(as-chaperone-or-proxy
([chaperone-procedure proxy-procedure])
(as-chaperone-or-impersonator
([chaperone-procedure impersonate-procedure])
(let* ([f (lambda (x #:a [a 'a] #:b b) (list x a b))]
[in #f]
[f2 (chaperone-procedure
@ -365,8 +365,8 @@
(test-values '((#:b) (#:a #:b)) (lambda () (procedure-keywords f2)))))
;; Required keyword arguments:
(as-chaperone-or-proxy
([chaperone-procedure proxy-procedure])
(as-chaperone-or-impersonator
([chaperone-procedure impersonate-procedure])
(let* ([f (lambda (x #:a [a 'a] #:b b) (list x a b))]
[in #f]
[out #f]
@ -396,33 +396,33 @@
(test-values '((#:b) (#:a #:b)) (lambda () (procedure-keywords f2)))))
(err/rt-test ((chaperone-procedure (lambda (x) x) (lambda (y) (values y y))) 1))
(err/rt-test ((proxy-procedure (lambda (x) x) (lambda (y) (values y y))) 1))
(err/rt-test ((impersonate-procedure (lambda (x) x) (lambda (y) (values y y))) 1))
(err/rt-test ((chaperone-procedure (lambda (x) x) (lambda (y) (values y y y))) 1))
(err/rt-test ((proxy-procedure (lambda (x) x) (lambda (y) (values y y y))) 1))
(err/rt-test ((impersonate-procedure (lambda (x) x) (lambda (y) (values y y y))) 1))
;; ----------------------------------------
(define is-chaperone #t)
(define is-not-chaperone #f)
(as-chaperone-or-proxy
([chaperone-struct proxy-struct]
(as-chaperone-or-impersonator
([chaperone-struct impersonate-struct]
[is-chaperone is-not-chaperone]
[chaperone?/proxy proxy?])
[chaperone?/impersonator impersonator?])
(let ()
(define-values (prop:blue blue? blue-ref) (make-proxy-property 'blue))
(define-values (prop:blue blue? blue-ref) (make-impersonator-property 'blue))
(define-values (prop:green green? green-ref) (make-struct-type-property 'green))
(define-struct a ([x #:mutable] y))
(define-struct (b a) ([z #:mutable]))
(define-struct p (u) #:property prop:green 'green)
(define-struct (q p) (v w))
(test #t chaperone?/proxy (chaperone-struct (make-a 1 2) a-x (lambda (a v) v)))
(test #t chaperone?/proxy (chaperone-struct (make-b 1 2 3) a-x (lambda (a v) v)))
(test #t chaperone?/impersonator (chaperone-struct (make-a 1 2) a-x (lambda (a v) v)))
(test #t chaperone?/impersonator (chaperone-struct (make-b 1 2 3) a-x (lambda (a v) v)))
(when is-chaperone
(test #t chaperone?/proxy (chaperone-struct (make-p 1) green-ref (lambda (a v) v))))
(test #t chaperone?/proxy (chaperone-struct (make-a 1 2) a-x (lambda (a v) v) prop:blue 'blue))
(test #t chaperone?/impersonator (chaperone-struct (make-p 1) green-ref (lambda (a v) v))))
(test #t chaperone?/impersonator (chaperone-struct (make-a 1 2) a-x (lambda (a v) v) prop:blue 'blue))
(when is-chaperone
(test #t chaperone?/proxy (chaperone-struct
(test #t chaperone?/impersonator (chaperone-struct
(chaperone-struct (make-a 1 2) a-x (lambda (a v) v) prop:blue 'blue)
a-x (lambda (a v) v)
prop:blue 'blue)))
@ -550,10 +550,10 @@
;; ----------------------------------------
(as-chaperone-or-proxy
([chaperone-struct proxy-struct])
(as-chaperone-or-proxy
([chaperone-procedure proxy-procedure])
(as-chaperone-or-impersonator
([chaperone-struct impersonate-struct])
(as-chaperone-or-impersonator
([chaperone-procedure impersonate-procedure])
(let ()
(define (test-sub linear? rev?)
(define-struct a (x [y #:mutable]) #:property prop:procedure 0)
@ -607,7 +607,7 @@
;; ----------------------------------------
(let ()
(define-values (prop:blue blue? blue-ref) (make-proxy-property 'blue))
(define-values (prop:blue blue? blue-ref) (make-impersonator-property 'blue))
(let* ([v1 (vector 1 2 3)]
[v2 (chaperone-vector v1 (lambda (vec i v) v) (lambda (vec i v) v)
prop:blue 89)]
@ -641,7 +641,7 @@
(lambda (h k) (values k (lambda (h k v) v)))
(lambda (h k v) (values k v))
(lambda (h k) k) (lambda (h k) k))])
(test #t chaperone?/proxy h)
(test #t chaperone?/impersonator h)
(test #t hash? h)
(test #t (lambda (x) (hash? x)) h)))
(list
@ -651,11 +651,11 @@
(for-each
(lambda (make-hash)
(let ([h (proxy-hash (make-hash)
(let ([h (impersonate-hash (make-hash)
(lambda (h k) (values k (lambda (h k v) v)))
(lambda (h k v) (values k v))
(lambda (h k) k) (lambda (h k) k))])
(test #t proxy? h)
(test #t impersonator? h)
(test #t hash? h)
(test #t (lambda (x) (hash? x)) h)))
(list
@ -665,14 +665,14 @@
(for-each
(lambda (make-hash)
(err/rt-test
(proxy-hash (make-hash)
(impersonator-hash (make-hash)
(lambda (h k) (values k (lambda (h k v) v)))
(lambda (h k v) (values k v))
(lambda (h k) k) (lambda (h k) k))))
(list (lambda () #hash()) (lambda () #hasheq()) (lambda () #hasheqv())))
(as-chaperone-or-proxy
([chaperone-hash proxy-hash])
(as-chaperone-or-impersonator
([chaperone-hash impersonate-hash])
(for-each
(lambda (make-hash)
(let* ([h1 (make-hash)]
@ -796,9 +796,9 @@
;; ----------------------------------------
(as-chaperone-or-proxy
([chaperone-hash proxy-hash]
[chaperone-procedure proxy-procedure])
(as-chaperone-or-impersonator
([chaperone-hash impersonate-hash]
[chaperone-procedure impersonate-procedure])
(letrec ([wrap
(lambda (v)
(cond
@ -830,11 +830,11 @@
;; ----------------------------------------
;; Check broken key proxy:
;; Check broken key impersonator:
(let ([check
(lambda (orig)
(let ([h (proxy-hash
(let ([h (impersonate-hash
orig
(λ (h k)
(values 'bad1
@ -930,8 +930,8 @@
;; ----------------------------------------
(as-chaperone-or-proxy
([chaperone-procedure proxy-procedure])
(as-chaperone-or-impersonator
([chaperone-procedure impersonate-procedure])
(let ()
(define (check-param current-directory)
(parameterize ([current-directory (current-directory)])
@ -982,20 +982,20 @@
(chaperone-procedure add1 void)
(chaperone-procedure add1 void))
(test #t equal?
(proxy-procedure add1 void)
(impersonate-procedure add1 void)
(chaperone-procedure add1 void))
(test #t equal?
(chaperone-procedure add1 void)
(proxy-procedure add1 void))
(impersonate-procedure add1 void))
;; ----------------------------------------
;; evt chaperones
(test #t evt? (chaperone-evt always-evt void))
(test #t chaperone-of?/proxy (chaperone-evt always-evt void) always-evt)
(test #t chaperone-of?/impersonator (chaperone-evt always-evt void) always-evt)
(test #f chaperone-of? (chaperone-evt always-evt void) (chaperone-evt always-evt void))
(test #t chaperone-of?/proxy (chaperone-evt (chaperone-evt always-evt void) void) always-evt)
(test #t chaperone-of?/impersonator (chaperone-evt (chaperone-evt always-evt void) void) always-evt)
(test always-evt sync (chaperone-evt always-evt (lambda (e) (values e values))))
(test #f sync/timeout 0 (chaperone-evt never-evt (lambda (e) (values e (lambda (v) (error "bad"))))))
@ -1050,7 +1050,7 @@
;; ----------------------------------------
(let ()
(define (a-proxy-of v) (a-x v))
(define (a-impersonator-of v) (a-x v))
(define a-equal+hash (list
(lambda (v1 v2 equal?)
(equal? (a-y v1) (a-y v2)))
@ -1059,29 +1059,29 @@
(lambda (v2 hash)
(hash (a-y v2)))))
(define-struct a (x y)
#:property prop:proxy-of a-proxy-of
#:property prop:impersonator-of a-impersonator-of
#:property prop:equal+hash a-equal+hash)
(define-struct (a-more a) (z))
(define-struct (a-new-proxy a) ()
#:property prop:proxy-of a-proxy-of)
(define-struct (a-new-impersonator a) ()
#:property prop:impersonator-of a-impersonator-of)
(define-struct (a-new-equal a) ()
#:property prop:equal+hash a-equal+hash)
(let ([a1 (make-a #f 2)])
(test #t equal? (make-a #f 2) a1)
(test #t equal? (make-a-more #f 2 7) a1)
(test #t equal? (make-a-new-proxy #f 2) a1)
(test #t equal? (make-a-new-impersonator #f 2) a1)
(test #f equal? (make-a-new-equal #f 2) a1)
(test #f equal? (make-a #f 3) a1)
(test #f proxy-of? (make-a #f 2) a1)
(test #t proxy-of? (make-a a1 3) a1)
(test #t proxy-of? (make-a-more a1 3 8) a1)
(test #f impersonator-of? (make-a #f 2) a1)
(test #t impersonator-of? (make-a a1 3) a1)
(test #t impersonator-of? (make-a-more a1 3 8) a1)
(test #f chaperone-of? (make-a a1 3) a1)
(test #t equal? (make-a a1 3) a1)
(test #t equal? (make-a-more a1 3 9) a1)
(err/rt-test (equal? (make-a 0 1) (make-a 0 1)))
(err/rt-test (proxy-of? (make-a-new-proxy a1 1) a1))
(err/rt-test (proxy-of? (make-a-new-equal a1 1) a1))
(err/rt-test (impersonator-of? (make-a-new-impersonator a1 1) a1))
(err/rt-test (impersonator-of? (make-a-new-equal a1 1) a1))
(err/rt-test (equal? (make-a-new-equal a1 1) a1))
(void)))
@ -1100,9 +1100,9 @@
(define g1 (chaperone-procedure f1 wrapper))
(define g2 (chaperone-procedure f2 wrapper))
(define g3 (chaperone-procedure f2 wrapper))
(define h1 (proxy-procedure f1 wrapper))
(define h2 (proxy-procedure f2 wrapper))
(define h3 (proxy-procedure f2 wrapper))
(define h1 (impersonate-procedure f1 wrapper))
(define h2 (impersonate-procedure f2 wrapper))
(define h3 (impersonate-procedure f2 wrapper))
(test #t chaperone-of? g1 f1)
(test #t chaperone-of? g2 f2)
@ -1114,10 +1114,10 @@
(test #t equal? g3 f2)
(test #t equal? g3 g2)
(test #t proxy-of? h1 f1)
(test #t proxy-of? h2 f2)
(test #t proxy-of? h3 f2)
(test #f proxy-of? h3 h2)
(test #t impersonator-of? h1 f1)
(test #t impersonator-of? h2 f2)
(test #t impersonator-of? h3 f2)
(test #f impersonator-of? h3 h2)
(test #t equal? h1 f1)
(test #t equal? h2 f2)
@ -1136,16 +1136,16 @@
;; ----------------------------------------
;; A regression test mixing `procedure-rename',
;; chaperones, and proxy properties:
;; chaperones, and impersonator properties:
(let ()
(define (f #:key k) k)
(define null-checker
(make-keyword-procedure
(λ (kwds kwd-vals . args) (apply values kwd-vals args))
(λ args (apply values args))))
(define-values (proxy-prop:p p? p-ref) (make-proxy-property 'p))
(define-values (impersonator-prop:p p? p-ref) (make-impersonator-property 'p))
(define new-f
(chaperone-procedure f null-checker proxy-prop:p #t))
(chaperone-procedure f null-checker impersonator-prop:p #t))
(test #t procedure? (procedure-rename new-f 'g)))
@ -1166,14 +1166,14 @@
saved))
(values (lambda (r) r)
a))
proxy-prop:application-mark
impersonator-prop:application-mark
(cons 'z 12)))
(define h (chaperone-procedure
g
(lambda (a)
(values (lambda (r) r)
a))
proxy-prop:application-mark
impersonator-prop:application-mark
(cons 'z 9)))
(define i (chaperone-procedure
f
@ -1181,12 +1181,12 @@
(set! saved (cons (continuation-mark-set-first #f 'z)
saved))
a)
proxy-prop:application-mark
impersonator-prop:application-mark
(cons 'z 11)))
(define j (chaperone-procedure
i
(lambda (a) a)
proxy-prop:application-mark
impersonator-prop:application-mark
(cons 'z 12)))
(test (list 12 '(12)) g 10)
(test '(#f) values saved)

4
doc/release-notes/racket/HISTORY.txt
View File

@ -1,3 +1,7 @@
5.0.99.2
proxy => impersonator
5.0.99.1
Internal: weak boxes are cleared before non-will-like
finalizers; use late-weak boxes to get the old behavior

2
src/racket/include/mzwin.def
View File

@ -536,7 +536,7 @@ EXPORTS
scheme_eqv
scheme_equal
scheme_chaperone_of
scheme_proxy_of
scheme_impersonator_of
scheme_equal_hash_key
scheme_equal_hash_key2
scheme_recur_equal_hash_key

2
src/racket/include/mzwin3m.def
View File

@ -551,7 +551,7 @@ EXPORTS
scheme_eqv
scheme_equal
scheme_chaperone_of
scheme_proxy_of
scheme_impersonator_of
scheme_hash_key
scheme_equal_hash_key
scheme_equal_hash_key2

2
src/racket/include/racket.exp
View File

@ -553,7 +553,7 @@ scheme_eq
scheme_eqv
scheme_equal
scheme_chaperone_of
scheme_proxy_of
scheme_impersonator_of
scheme_equal_hash_key
scheme_equal_hash_key2
scheme_recur_equal_hash_key

2
src/racket/include/racket3m.exp
View File

@ -559,7 +559,7 @@ scheme_eq
scheme_eqv
scheme_equal
scheme_chaperone_of
scheme_proxy_of
scheme_impersonator_of
scheme_hash_key
scheme_equal_hash_key
scheme_equal_hash_key2

50
src/racket/src/bool.c
View File

@ -47,9 +47,9 @@ static Scheme_Object *eqv_prim (int argc, Scheme_Object *argv[]);
static Scheme_Object *equal_prim (int argc, Scheme_Object *argv[]);
static Scheme_Object *equalish_prim (int argc, Scheme_Object *argv[]);
static Scheme_Object *chaperone_p (int argc, Scheme_Object *argv[]);
static Scheme_Object *proxy_p (int argc, Scheme_Object *argv[]);
static Scheme_Object *impersonator_p (int argc, Scheme_Object *argv[]);
static Scheme_Object *chaperone_of (int argc, Scheme_Object *argv[]);
static Scheme_Object *proxy_of (int argc, Scheme_Object *argv[]);
static Scheme_Object *impersonator_of (int argc, Scheme_Object *argv[]);
typedef struct Equal_Info {
long depth; /* always odd, so it looks like a fixnum */
@ -57,13 +57,13 @@ typedef struct Equal_Info {
Scheme_Hash_Table *ht;
Scheme_Object *recur;
Scheme_Object *next, *next_next;
int for_chaperone; /* 2 => for proxy */
int for_chaperone; /* 2 => for impersonator */
} Equal_Info;
static int is_equal (Scheme_Object *obj1, Scheme_Object *obj2, Equal_Info *eql);
static int vector_equal (Scheme_Object *vec1, Scheme_Object *vec2, Equal_Info *eql);
static int struct_equal (Scheme_Object *s1, Scheme_Object *s2, Equal_Info *eql);
static Scheme_Object *apply_proxy_of(int for_chaperone, Scheme_Object *procs, Scheme_Object *obj);
static Scheme_Object *apply_impersonator_of(int for_chaperone, Scheme_Object *procs, Scheme_Object *obj);
void scheme_init_true_false(void)
{
@ -109,15 +109,15 @@ void scheme_init_bool (Scheme_Env *env)
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
scheme_add_global_constant("chaperone?", p, env);
p = scheme_make_immed_prim(proxy_p, "proxy?", 1, 1);
p = scheme_make_immed_prim(impersonator_p, "impersonator?", 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
scheme_add_global_constant("proxy?", p, env);
scheme_add_global_constant("impersonator?", p, env);
scheme_add_global_constant("chaperone-of?",
scheme_make_prim_w_arity(chaperone_of, "chaperone-of?", 2, 2),
env);
scheme_add_global_constant("proxy-of?",
scheme_make_prim_w_arity(proxy_of, "proxy-of?", 2, 2),
scheme_add_global_constant("impersonator-of?",
scheme_make_prim_w_arity(impersonator_of, "impersonator-of?", 2, 2),
env);
}
@ -382,7 +382,7 @@ int is_equal (Scheme_Object *obj1, Scheme_Object *obj2, Equal_Info *eql)
return 1;
else if (eql->for_chaperone
&& SCHEME_CHAPERONEP(obj1)
&& (!(SCHEME_CHAPERONE_FLAGS((Scheme_Chaperone *)obj1) & SCHEME_CHAPERONE_IS_PROXY)
&& (!(SCHEME_CHAPERONE_FLAGS((Scheme_Chaperone *)obj1) & SCHEME_CHAPERONE_IS_IMPERSONATOR)
|| (eql->for_chaperone > 1))) {
obj1 = ((Scheme_Chaperone *)obj1)->prev;
goto top;
@ -475,19 +475,19 @@ int is_equal (Scheme_Object *obj1, Scheme_Object *obj2, Equal_Info *eql)
if (eql->for_chaperone == 1)
procs1 = NULL;
else
procs1 = scheme_struct_type_property_ref(scheme_proxy_of_property, (Scheme_Object *)st1);
procs1 = scheme_struct_type_property_ref(scheme_impersonator_of_property, (Scheme_Object *)st1);
if (procs1)
procs1 = apply_proxy_of(eql->for_chaperone, procs1, obj1);
procs1 = apply_impersonator_of(eql->for_chaperone, procs1, obj1);
if (eql->for_chaperone)
procs2 = NULL;
else {
procs2 = scheme_struct_type_property_ref(scheme_proxy_of_property, (Scheme_Object *)st2);
procs2 = scheme_struct_type_property_ref(scheme_impersonator_of_property, (Scheme_Object *)st2);
if (procs2)
procs2 = apply_proxy_of(eql->for_chaperone, procs2, obj2);
procs2 = apply_impersonator_of(eql->for_chaperone, procs2, obj2);
}
if (procs1 || procs2) {
/* proxy-of property trumps other forms of checking */
/* impersonator-of property trumps other forms of checking */
if (procs1) obj1 = procs1;
if (procs2) obj2 = procs2;
goto top;
@ -663,12 +663,12 @@ Scheme_Object * scheme_make_false (void)
static Scheme_Object *chaperone_p(int argc, Scheme_Object *argv[])
{
return ((SCHEME_CHAPERONEP(argv[0])
&& !(SCHEME_CHAPERONE_FLAGS(((Scheme_Chaperone *)argv[0])) & SCHEME_CHAPERONE_IS_PROXY))
&& !(SCHEME_CHAPERONE_FLAGS(((Scheme_Chaperone *)argv[0])) & SCHEME_CHAPERONE_IS_IMPERSONATOR))
? scheme_true
: scheme_false);
}
static Scheme_Object *proxy_p(int argc, Scheme_Object *argv[])
static Scheme_Object *impersonator_p(int argc, Scheme_Object *argv[])
{
return (SCHEME_CHAPERONEP(argv[0]) ? scheme_true : scheme_false);
}
@ -678,9 +678,9 @@ static Scheme_Object *chaperone_of(int argc, Scheme_Object *argv[])
return (scheme_chaperone_of(argv[0], argv[1]) ? scheme_true : scheme_false);
}
static Scheme_Object *proxy_of(int argc, Scheme_Object *argv[])
static Scheme_Object *impersonator_of(int argc, Scheme_Object *argv[])
{
return (scheme_proxy_of(argv[0], argv[1]) ? scheme_true : scheme_false);
return (scheme_impersonator_of(argv[0], argv[1]) ? scheme_true : scheme_false);
}
int scheme_chaperone_of(Scheme_Object *obj1, Scheme_Object *obj2)
@ -698,7 +698,7 @@ int scheme_chaperone_of(Scheme_Object *obj1, Scheme_Object *obj2)
return is_equal(obj1, obj2, &eql);
}
int scheme_proxy_of(Scheme_Object *obj1, Scheme_Object *obj2)
int scheme_impersonator_of(Scheme_Object *obj1, Scheme_Object *obj2)
{
Equal_Info eql;
@ -713,7 +713,7 @@ int scheme_proxy_of(Scheme_Object *obj1, Scheme_Object *obj2)
return is_equal(obj1, obj2, &eql);
}
static Scheme_Object *apply_proxy_of(int for_chaperone, Scheme_Object *procs, Scheme_Object *obj)
static Scheme_Object *apply_impersonator_of(int for_chaperone, Scheme_Object *procs, Scheme_Object *obj)
{
Scheme_Object *a[1], *v, *oprocs;
@ -723,10 +723,10 @@ static Scheme_Object *apply_proxy_of(int for_chaperone, Scheme_Object *procs, Sc
if (SCHEME_FALSEP(v))
return NULL;
oprocs = scheme_struct_type_property_ref(scheme_proxy_of_property, v);
oprocs = scheme_struct_type_property_ref(scheme_impersonator_of_property, v);
if (!oprocs || !SAME_OBJ(SCHEME_CAR(oprocs), SCHEME_CAR(procs)))
scheme_arg_mismatch((for_chaperone ? "proxy-of?" : "equal?"),
"proxy-of property procedure returned a value with a different prop:proxy-of source: ",
scheme_arg_mismatch((for_chaperone ? "impersonator-of?" : "equal?"),
"impersonator-of property procedure returned a value with a different prop:impersonator-of source: ",
v);
procs = scheme_struct_type_property_ref(scheme_equal_property, obj);
@ -734,8 +734,8 @@ static Scheme_Object *apply_proxy_of(int for_chaperone, Scheme_Object *procs, Sc
if (procs || oprocs)
if (!procs || !oprocs || !SAME_OBJ(SCHEME_VEC_ELS(oprocs)[0],
SCHEME_VEC_ELS(procs)[0]))
scheme_arg_mismatch((for_chaperone ? "proxy-of?" : "equal?"),
"proxy-of property procedure returned a value with a different prop:equal+hash source: ",
scheme_arg_mismatch((for_chaperone ? "impersonator-of?" : "equal?"),
"impersonator-of property procedure returned a value with a different prop:equal+hash source: ",
v);
return v;

1743
src/racket/src/cstartup.inc
View File

File diff suppressed because it is too large Load Diff

28
src/racket/src/fun.c
View File

@ -174,7 +174,7 @@ static Scheme_Object *procedure_rename(int argc, Scheme_Object *argv[]);
static Scheme_Object *procedure_to_method(int argc, Scheme_Object *argv[]);
static Scheme_Object *procedure_equal_closure_p(int argc, Scheme_Object *argv[]);
static Scheme_Object *chaperone_procedure(int argc, Scheme_Object *argv[]);
static Scheme_Object *proxy_procedure(int argc, Scheme_Object *argv[]);
static Scheme_Object *impersonate_procedure(int argc, Scheme_Object *argv[]);
static Scheme_Object *primitive_p(int argc, Scheme_Object *argv[]);
static Scheme_Object *primitive_closure_p(int argc, Scheme_Object *argv[]);
static Scheme_Object *primitive_result_arity (int argc, Scheme_Object *argv[]);
@ -530,9 +530,9 @@ scheme_init_fun (Scheme_Env *env)
"chaperone-procedure",
2, -1),
env);
scheme_add_global_constant("proxy-procedure",
scheme_make_prim_w_arity(proxy_procedure,
"proxy-procedure",
scheme_add_global_constant("impersonate-procedure",
scheme_make_prim_w_arity(impersonate_procedure,
"impersonate-procedure",
2, -1),
env);
@ -4084,7 +4084,7 @@ static Scheme_Object *procedure_equal_closure_p(int argc, Scheme_Object *argv[])
}
static Scheme_Object *do_chaperone_procedure(const char *name, const char *whating,
int is_proxy, int argc, Scheme_Object *argv[])
int is_impersonator, int argc, Scheme_Object *argv[])
{
Scheme_Chaperone *px;
Scheme_Object *val = argv[0], *orig, *naya;
@ -4118,8 +4118,8 @@ static Scheme_Object *do_chaperone_procedure(const char *name, const char *whati
px->props = props;
px->redirects = argv[1];
if (is_proxy)
SCHEME_CHAPERONE_FLAGS(px) |= SCHEME_CHAPERONE_IS_PROXY;
if (is_impersonator)
SCHEME_CHAPERONE_FLAGS(px) |= SCHEME_CHAPERONE_IS_IMPERSONATOR;
return (Scheme_Object *)px;
}
@ -4129,9 +4129,9 @@ static Scheme_Object *chaperone_procedure(int argc, Scheme_Object *argv[])
return do_chaperone_procedure("chaperone-procedure", "chaperoning", 0, argc, argv);
}
static Scheme_Object *proxy_procedure(int argc, Scheme_Object *argv[])
static Scheme_Object *impersonate_procedure(int argc, Scheme_Object *argv[])
{
return do_chaperone_procedure("proxy-procedure", "proxying", 1, argc, argv);
return do_chaperone_procedure("impersonate-procedure", "impersonating", 1, argc, argv);
}
static Scheme_Object *apply_chaperone_k(void)
@ -4206,10 +4206,10 @@ Scheme_Object *scheme_apply_chaperone(Scheme_Object *o, int argc, Scheme_Object
}
px = (Scheme_Chaperone *)o;
if (!(SCHEME_CHAPERONE_FLAGS(px) & SCHEME_CHAPERONE_IS_PROXY))
if (!(SCHEME_CHAPERONE_FLAGS(px) & SCHEME_CHAPERONE_IS_IMPERSONATOR))
what = "chaperone";
else
what = "proxy";
what = "impersonator";
/* Ensure that the original procedure accepts `argc' arguments: */
a[0] = px->prev;
@ -4224,7 +4224,7 @@ Scheme_Object *scheme_apply_chaperone(Scheme_Object *o, int argc, Scheme_Object
}
if (px->props) {
app_mark = scheme_hash_tree_get(px->props, scheme_app_mark_proxy_property);
app_mark = scheme_hash_tree_get(px->props, scheme_app_mark_impersonator_property);
/* app_mark should be (cons mark val) */
if (app_mark && !SCHEME_PAIRP(app_mark))
app_mark = NULL;
@ -4267,7 +4267,7 @@ Scheme_Object *scheme_apply_chaperone(Scheme_Object *o, int argc, Scheme_Object
memmove(argv2, argv2 + 1, sizeof(Scheme_Object*)*argc);
} else
post = NULL;
if (!(SCHEME_CHAPERONE_FLAGS(px) & SCHEME_CHAPERONE_IS_PROXY)) {
if (!(SCHEME_CHAPERONE_FLAGS(px) & SCHEME_CHAPERONE_IS_IMPERSONATOR)) {
for (i = 0; i < argc; i++) {
if (!scheme_chaperone_of(argv2[i], argv[i])) {
if (argc == 1)
@ -4390,7 +4390,7 @@ Scheme_Object *scheme_apply_chaperone(Scheme_Object *o, int argc, Scheme_Object
}
if (c == argc) {
if (!(SCHEME_CHAPERONE_FLAGS(px) & SCHEME_CHAPERONE_IS_PROXY)) {
if (!(SCHEME_CHAPERONE_FLAGS(px) & SCHEME_CHAPERONE_IS_IMPERSONATOR)) {
for (i = 0; i < argc; i++) {
if (!scheme_chaperone_of(argv2[i], argv[i])) {
if (argc == 1)

6
src/racket/src/jit.c
View File

@ -6602,9 +6602,9 @@ static int generate_inlined_type_test(mz_jit_state *jitter, Scheme_App2_Rec *app
ref4 = jit_bgti_p(jit_forward(), JIT_R1, hi_ty);
}
if (can_chaperone < 0) {
/* Make sure it's not a proxy */
/* Make sure it's not a impersonator */
jit_ldxi_s(JIT_R1, JIT_R0, (long)&SCHEME_CHAPERONE_FLAGS((Scheme_Chaperone *)0x0));
ref5 = jit_bmsi_i(jit_forward(), JIT_R1, SCHEME_CHAPERONE_IS_PROXY);
ref5 = jit_bmsi_i(jit_forward(), JIT_R1, SCHEME_CHAPERONE_IS_IMPERSONATOR);
} else
ref5 = NULL;
if (int_ok) {
@ -6785,7 +6785,7 @@ static int generate_inlined_unary(mz_jit_state *jitter, Scheme_App2_Rec *app, in
} else if (IS_NAMED_PRIM(rator, "chaperone?")) {
generate_inlined_type_test(jitter, app, scheme_proc_chaperone_type, scheme_chaperone_type, -1, for_branch, branch_short, need_sync);
return 1;
} else if (IS_NAMED_PRIM(rator, "proxy?")) {
} else if (IS_NAMED_PRIM(rator, "impersonator?")) {
generate_inlined_type_test(jitter, app, scheme_proc_chaperone_type, scheme_chaperone_type, 0, for_branch, branch_short, need_sync);
return 1;
} else if (IS_NAMED_PRIM(rator, "vector?")) {

60
src/racket/src/list.c
View File

@ -90,7 +90,7 @@ static Scheme_Object *box_p (int argc, Scheme_Object *argv[]);
static Scheme_Object *unbox (int argc, Scheme_Object *argv[]);
static Scheme_Object *set_box (int argc, Scheme_Object *argv[]);
static Scheme_Object *chaperone_box(int argc, Scheme_Object **argv);
static Scheme_Object *proxy_box(int argc, Scheme_Object **argv);
static Scheme_Object *impersonate_box(int argc, Scheme_Object **argv);
static Scheme_Object *make_hash(int argc, Scheme_Object *argv[]);
static Scheme_Object *make_hasheq(int argc, Scheme_Object *argv[]);
@ -127,7 +127,7 @@ static Scheme_Object *equal_hash_code(int argc, Scheme_Object *argv[]);
static Scheme_Object *equal_hash2_code(int argc, Scheme_Object *argv[]);
static Scheme_Object *eqv_hash_code(int argc, Scheme_Object *argv[]);
static Scheme_Object *chaperone_hash(int argc, Scheme_Object **argv);
static Scheme_Object *proxy_hash(int argc, Scheme_Object **argv);
static Scheme_Object *impersonate_hash(int argc, Scheme_Object **argv);
static Scheme_Object *make_weak_box(int argc, Scheme_Object *argv[]);
static Scheme_Object *weak_box_value(int argc, Scheme_Object *argv[]);
@ -473,9 +473,9 @@ scheme_init_list (Scheme_Env *env)
"chaperone-box",
3, -1),
env);
scheme_add_global_constant("proxy-box",
scheme_make_prim_w_arity(proxy_box,
"proxy-box",
scheme_add_global_constant("impersonate-box",
scheme_make_prim_w_arity(impersonate_box,
"impersonate-box",
3, -1),
env);
@ -636,9 +636,9 @@ scheme_init_list (Scheme_Env *env)
"chaperone-hash",
5, -1),
env);
scheme_add_global_constant("proxy-hash",
scheme_make_prim_w_arity(proxy_hash,
"proxy-hash",
scheme_add_global_constant("impersonate-hash",
scheme_make_prim_w_arity(impersonate_hash,
"impersonate-hash",
5, -1),
env);
@ -1563,7 +1563,7 @@ static Scheme_Object *chaperone_unbox(Scheme_Object *obj)
a[1] = orig;
obj = _scheme_apply(SCHEME_CAR(px->redirects), 2, a);
if (!(SCHEME_CHAPERONE_FLAGS(px) & SCHEME_CHAPERONE_IS_PROXY))
if (!(SCHEME_CHAPERONE_FLAGS(px) & SCHEME_CHAPERONE_IS_IMPERSONATOR))
if (!scheme_chaperone_of(obj, orig))
scheme_raise_exn(MZEXN_FAIL_CONTRACT,
"unbox: chaperone produced a result: %V that is not a chaperone of the original result: %V",
@ -1603,7 +1603,7 @@ static void chaperone_set_box(Scheme_Object *obj, Scheme_Object *v)
a[1] = v;
v = _scheme_apply(SCHEME_CDR(px->redirects), 2, a);
if (!(SCHEME_CHAPERONE_FLAGS(px) & SCHEME_CHAPERONE_IS_PROXY))
if (!(SCHEME_CHAPERONE_FLAGS(px) & SCHEME_CHAPERONE_IS_IMPERSONATOR))
if (!scheme_chaperone_of(v, a[1]))
scheme_raise_exn(MZEXN_FAIL_CONTRACT,
"vector-set!: chaperone produced a result: %V that is not a chaperone of the original result: %V",
@ -1658,7 +1658,7 @@ static Scheme_Object *set_box(int c, Scheme_Object *p[])
return scheme_void;
}
static Scheme_Object *do_chaperone_box(const char *name, int is_proxy, int argc, Scheme_Object **argv)
static Scheme_Object *do_chaperone_box(const char *name, int is_impersonator, int argc, Scheme_Object **argv)
{
Scheme_Chaperone *px;
Scheme_Object *val = argv[0];
@ -1668,8 +1668,8 @@ static Scheme_Object *do_chaperone_box(const char *name, int is_proxy, int argc,
if (SCHEME_CHAPERONEP(val))
val = SCHEME_CHAPERONE_VAL(val);
if (!SCHEME_BOXP(val) || (is_proxy && !SCHEME_MUTABLEP(val)))
scheme_wrong_type(name, is_proxy ? "mutable box" : "box", 0, argc, argv);
if (!SCHEME_BOXP(val) || (is_impersonator && !SCHEME_MUTABLEP(val)))
scheme_wrong_type(name, is_impersonator ? "mutable box" : "box", 0, argc, argv);
scheme_check_proc_arity(name, 2, 1, argc, argv);
scheme_check_proc_arity(name, 2, 2, argc, argv);
@ -1684,8 +1684,8 @@ static Scheme_Object *do_chaperone_box(const char *name, int is_proxy, int argc,
px->props = props;
px->redirects = redirects;
if (is_proxy)
SCHEME_CHAPERONE_FLAGS(px) |= SCHEME_CHAPERONE_IS_PROXY;
if (is_impersonator)
SCHEME_CHAPERONE_FLAGS(px) |= SCHEME_CHAPERONE_IS_IMPERSONATOR;
return (Scheme_Object *)px;
}
@ -1695,9 +1695,9 @@ static Scheme_Object *chaperone_box(int argc, Scheme_Object **argv)
return do_chaperone_box("chaperone-box", 0, argc, argv);
}
static Scheme_Object *proxy_box(int argc, Scheme_Object **argv)
static Scheme_Object *impersonate_box(int argc, Scheme_Object **argv)
{
return do_chaperone_box("proxy-box", 1, argc, argv);
return do_chaperone_box("impersonate-box", 1, argc, argv);
}
static int compare_equal(void *v1, void *v2)
@ -2335,7 +2335,7 @@ static Scheme_Object *do_map_hash_table(int argc,
v = scheme_chaperone_hash_get(chaperone, v);
if (!v)
scheme_raise_exn(MZEXN_FAIL_CONTRACT,
"%s: no value found for post-proxy key: %V",
"%s: no value found for post-impersonator key: %V",
name,
p[0]);
} else
@ -2369,7 +2369,7 @@ static Scheme_Object *do_map_hash_table(int argc,
v = scheme_chaperone_hash_get(chaperone, v);
if (!v)
scheme_raise_exn(MZEXN_FAIL_CONTRACT,
"%s: no value found for post-proxy key: %V",
"%s: no value found for post-impersonator key: %V",
name,
p[0]);
} else {
@ -2574,7 +2574,7 @@ static Scheme_Object *hash_table_index(const char *name, int argc, Scheme_Object
obj = scheme_chaperone_hash_get(chaperone, key);
if (!obj)
scheme_raise_exn(MZEXN_FAIL_CONTRACT,
"hash-iterate-value: no value found for post-proxy key: %V",
"hash-iterate-value: no value found for post-impersonator key: %V",
key);
return obj;
} else
@ -2626,7 +2626,7 @@ static Scheme_Object *hash_table_index(const char *name, int argc, Scheme_Object
obj = scheme_chaperone_hash_get(chaperone, key);
if (!obj)
scheme_raise_exn(MZEXN_FAIL_CONTRACT,
"hash-iterate-value: no value found for post-proxy key: %V",
"hash-iterate-value: no value found for post-impersonator key: %V",
key);
return obj;
} else
@ -2663,7 +2663,7 @@ static Scheme_Object *hash_table_iterate_key(int argc, Scheme_Object *argv[])
return hash_table_index("hash-iterate-key", argc, argv, 0);
}
static Scheme_Object *do_chaperone_hash(const char *name, int is_proxy, int argc, Scheme_Object **argv)
static Scheme_Object *do_chaperone_hash(const char *name, int is_impersonator, int argc, Scheme_Object **argv)
{
Scheme_Chaperone *px;
Scheme_Object *val = argv[0];
@ -2674,9 +2674,9 @@ static Scheme_Object *do_chaperone_hash(const char *name, int is_proxy, int argc
val = SCHEME_CHAPERONE_VAL(val);
if (!SCHEME_HASHTP(val)
&& (is_proxy || !SCHEME_HASHTRP(val))
&& (is_impersonator || !SCHEME_HASHTRP(val))
&& !SCHEME_BUCKTP(val))
scheme_wrong_type(name, is_proxy ? "mutable hash" : "hash", 0, argc, argv);
scheme_wrong_type(name, is_impersonator ? "mutable hash" : "hash", 0, argc, argv);
scheme_check_proc_arity(name, 2, 1, argc, argv); /* ref */
scheme_check_proc_arity(name, 3, 2, argc, argv); /* set! */
scheme_check_proc_arity(name, 2, 3, argc, argv); /* remove */
@ -2698,8 +2698,8 @@ static Scheme_Object *do_chaperone_hash(const char *name, int is_proxy, int argc
px->props = props;
px->redirects = redirects;
if (is_proxy)
SCHEME_CHAPERONE_FLAGS(px) |= SCHEME_CHAPERONE_IS_PROXY;
if (is_impersonator)
SCHEME_CHAPERONE_FLAGS(px) |= SCHEME_CHAPERONE_IS_IMPERSONATOR;
return (Scheme_Object *)px;
}
@ -2709,9 +2709,9 @@ static Scheme_Object *chaperone_hash(int argc, Scheme_Object **argv)
return do_chaperone_hash("chaperone-hash", 0, argc, argv);
}
static Scheme_Object *proxy_hash(int argc, Scheme_Object **argv)
static Scheme_Object *impersonate_hash(int argc, Scheme_Object **argv)
{
return do_chaperone_hash("proxy-hash", 1, argc, argv);
return do_chaperone_hash("impersonate-hash", 1, argc, argv);
}
static Scheme_Object *transfer_chaperone(Scheme_Object *chaperone, Scheme_Object *v)
@ -2871,7 +2871,7 @@ static Scheme_Object *chaperone_hash_op(const char *who, Scheme_Object *o, Schem
red,
cnt);
if (!(SCHEME_CHAPERONE_FLAGS(px) & SCHEME_CHAPERONE_IS_PROXY))
if (!(SCHEME_CHAPERONE_FLAGS(px) & SCHEME_CHAPERONE_IS_IMPERSONATOR))
if (!scheme_chaperone_of(vals[0], k))
scheme_raise_exn(MZEXN_FAIL_CONTRACT,
"%s: chaperone produced a key: %V that is not a chaperone of the original key: %V",
@ -2907,7 +2907,7 @@ static Scheme_Object *chaperone_hash_op(const char *who, Scheme_Object *o, Schem
what = "key";
}
if (!(SCHEME_CHAPERONE_FLAGS(px) & SCHEME_CHAPERONE_IS_PROXY))
if (!(SCHEME_CHAPERONE_FLAGS(px) & SCHEME_CHAPERONE_IS_IMPERSONATOR))
if (!scheme_chaperone_of(o, orig))
scheme_raise_exn(MZEXN_FAIL_CONTRACT,
"%s: chaperone produced a %s: %V that is not a chaperone of the original %s: %V",

2
src/racket/src/print.c
View File

@ -1813,7 +1813,7 @@ print(Scheme_Object *obj, int notdisplay, int compact, Scheme_Hash_Table *ht,
|| SAME_TYPE(scheme_always_evt_type, SCHEME_TYPE(obj))
|| SAME_TYPE(scheme_never_evt_type, SCHEME_TYPE(obj))
|| SAME_TYPE(scheme_struct_property_type, SCHEME_TYPE(obj))
|| SAME_OBJ(scheme_app_mark_proxy_property, obj))) {
|| SAME_OBJ(scheme_app_mark_impersonator_property, obj))) {
/* Check whether this is a global constant */
Scheme_Object *val;
val = scheme_hash_get(global_constants_ht, obj);

2
src/racket/src/schemef.h
View File

@ -1050,7 +1050,7 @@ XFORM_NONGCING MZ_EXTERN int scheme_eq(Scheme_Object *obj1, Scheme_Object *obj2)
XFORM_NONGCING MZ_EXTERN int scheme_eqv(Scheme_Object *obj1, Scheme_Object *obj2);
MZ_EXTERN int scheme_equal(Scheme_Object *obj1, Scheme_Object *obj2);
MZ_EXTERN int scheme_chaperone_of(Scheme_Object *obj1, Scheme_Object *obj2);
MZ_EXTERN int scheme_proxy_of(Scheme_Object *obj1, Scheme_Object *obj2);
MZ_EXTERN int scheme_impersonator_of(Scheme_Object *obj1, Scheme_Object *obj2);
#ifdef MZ_PRECISE_GC
XFORM_NONGCING MZ_EXTERN long scheme_hash_key(Scheme_Object *o);

2
src/racket/src/schemex.h
View File

@ -872,7 +872,7 @@ int (*scheme_eq)(Scheme_Object *obj1, Scheme_Object *obj2);
int (*scheme_eqv)(Scheme_Object *obj1, Scheme_Object *obj2);
int (*scheme_equal)(Scheme_Object *obj1, Scheme_Object *obj2);
int (*scheme_chaperone_of)(Scheme_Object *obj1, Scheme_Object *obj2);
int (*scheme_proxy_of)(Scheme_Object *obj1, Scheme_Object *obj2);
int (*scheme_impersonator_of)(Scheme_Object *obj1, Scheme_Object *obj2);
#ifdef MZ_PRECISE_GC
long (*scheme_hash_key)(Scheme_Object *o);
#endif

2
src/racket/src/schemex.inc
View File

@ -605,7 +605,7 @@
scheme_extension_table->scheme_eqv = scheme_eqv;
scheme_extension_table->scheme_equal = scheme_equal;
scheme_extension_table->scheme_chaperone_of = scheme_chaperone_of;
scheme_extension_table->scheme_proxy_of = scheme_proxy_of;
scheme_extension_table->scheme_impersonator_of = scheme_impersonator_of;
#ifdef MZ_PRECISE_GC
scheme_extension_table->scheme_hash_key = scheme_hash_key;
#endif

2
src/racket/src/schemexm.h
View File

@ -605,7 +605,7 @@
#define scheme_eqv (scheme_extension_table->scheme_eqv)
#define scheme_equal (scheme_extension_table->scheme_equal)
#define scheme_chaperone_of (scheme_extension_table->scheme_chaperone_of)
#define scheme_proxy_of (scheme_extension_table->scheme_proxy_of)
#define scheme_impersonator_of (scheme_extension_table->scheme_impersonator_of)
#ifdef MZ_PRECISE_GC
#define scheme_hash_key (scheme_extension_table->scheme_hash_key)
#endif

8
src/racket/src/schpriv.h
View File

@ -384,9 +384,9 @@ THREAD_LOCAL_DECL(extern Scheme_Object *scheme_system_idle_channel);
extern Scheme_Object *scheme_input_port_property, *scheme_output_port_property;
extern Scheme_Object *scheme_equal_property;
extern Scheme_Object *scheme_proxy_of_property;
extern Scheme_Object *scheme_impersonator_of_property;
extern Scheme_Object *scheme_app_mark_proxy_property;
extern Scheme_Object *scheme_app_mark_impersonator_property;
extern Scheme_Object *scheme_reduced_procedure_struct;
@ -763,7 +763,7 @@ Scheme_Object *scheme_extract_checked_procedure(int argc, Scheme_Object **argv);
Scheme_Object *scheme_rename_struct_proc(Scheme_Object *p, Scheme_Object *sym);
typedef struct Scheme_Chaperone {
Scheme_Inclhash_Object iso; /* 0x1 => proxy, rather than a checking chaperone */
Scheme_Inclhash_Object iso; /* 0x1 => impersonator, rather than a checking chaperone */
Scheme_Object *val; /* root object */
Scheme_Object *prev; /* immediately chaperoned object */
Scheme_Hash_Tree *props;
@ -771,7 +771,7 @@ typedef struct Scheme_Chaperone {
} Scheme_Chaperone;
#define SCHEME_CHAPERONE_FLAGS(c) MZ_OPT_HASH_KEY(&(c)->iso)
#define SCHEME_CHAPERONE_IS_PROXY 0x1
#define SCHEME_CHAPERONE_IS_IMPERSONATOR 0x1
#define SCHEME_CHAPERONE_VAL(obj) (((Scheme_Chaperone *)obj)->val)

4
src/racket/src/schvers.h
View File

@ -13,12 +13,12 @@
consistently.)
*/
#define MZSCHEME_VERSION "5.0.99.1"
#define MZSCHEME_VERSION "5.0.99.2"
#define MZSCHEME_VERSION_X 5
#define MZSCHEME_VERSION_Y 0
#define MZSCHEME_VERSION_Z 99
#define MZSCHEME_VERSION_W 1
#define MZSCHEME_VERSION_W 2
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)

140
src/racket/src/struct.c
View File

@ -32,13 +32,13 @@ READ_ONLY Scheme_Object *scheme_source_property;
READ_ONLY Scheme_Object *scheme_input_port_property;
READ_ONLY Scheme_Object *scheme_output_port_property;
READ_ONLY Scheme_Object *scheme_equal_property;
READ_ONLY Scheme_Object *scheme_proxy_of_property;
READ_ONLY Scheme_Object *scheme_impersonator_of_property;
READ_ONLY Scheme_Object *scheme_make_struct_type_proc;
READ_ONLY Scheme_Object *scheme_current_inspector_proc;
READ_ONLY Scheme_Object *scheme_recur_symbol;
READ_ONLY Scheme_Object *scheme_display_symbol;
READ_ONLY Scheme_Object *scheme_write_special_symbol;
READ_ONLY Scheme_Object *scheme_app_mark_proxy_property;
READ_ONLY Scheme_Object *scheme_app_mark_impersonator_property;
READ_ONLY static Scheme_Object *location_struct;
READ_ONLY static Scheme_Object *write_property;
@ -89,7 +89,7 @@ static Scheme_Object *struct_type_property_p(int argc, Scheme_Object *argv[]);
static Scheme_Object *chaperone_property_p(int argc, Scheme_Object *argv[]);
static Scheme_Object *check_evt_property_value_ok(int argc, Scheme_Object *argv[]);
static Scheme_Object *check_equal_property_value_ok(int argc, Scheme_Object *argv[]);
static Scheme_Object *check_proxy_of_property_value_ok(int argc, Scheme_Object *argv[]);
static Scheme_Object *check_impersonator_of_property_value_ok(int argc, Scheme_Object *argv[]);
static Scheme_Object *check_write_property_value_ok(int argc, Scheme_Object *argv[]);
static Scheme_Object *check_print_attribute_property_value_ok(int argc, Scheme_Object *argv[]);
static Scheme_Object *check_input_port_property_value_ok(int argc, Scheme_Object *argv[]);
@ -167,7 +167,7 @@ static Scheme_Object *procedure_extract_target(int argc, Scheme_Object **argv);
static Scheme_Struct_Type *hash_prefab(Scheme_Struct_Type *type);
static Scheme_Object *chaperone_struct(int argc, Scheme_Object **argv);
static Scheme_Object *proxy_struct(int argc, Scheme_Object **argv);
static Scheme_Object *impersonate_struct(int argc, Scheme_Object **argv);
static Scheme_Object *chaperone_struct_type(int argc, Scheme_Object **argv);
static Scheme_Object *make_chaperone_property(int argc, Scheme_Object *argv[]);
@ -351,13 +351,13 @@ scheme_init_struct (Scheme_Env *env)
}
{
guard = scheme_make_prim_w_arity(check_proxy_of_property_value_ok,
"guard-for-prop:proxy-of",
guard = scheme_make_prim_w_arity(check_impersonator_of_property_value_ok,
"guard-for-prop:impersonator-of",
2, 2);
REGISTER_SO(scheme_proxy_of_property);
scheme_proxy_of_property = scheme_make_struct_type_property_w_guard(scheme_intern_symbol("proxy-of"),
REGISTER_SO(scheme_impersonator_of_property);
scheme_impersonator_of_property = scheme_make_struct_type_property_w_guard(scheme_intern_symbol("impersonator-of"),
guard);
scheme_add_global_constant("prop:proxy-of", scheme_proxy_of_property, env);
scheme_add_global_constant("prop:impersonator-of", scheme_impersonator_of_property, env);
}
{
@ -608,9 +608,9 @@ scheme_init_struct (Scheme_Env *env)
"struct-type-property-accessor-procedure?",
1, 1),
env);
scheme_add_global_constant("proxy-property-accessor-procedure?",
scheme_add_global_constant("impersonator-property-accessor-procedure?",
scheme_make_prim_w_arity(chaperone_prop_getter_p,
"proxy-property-accessor-procedure?",
"impersonator-property-accessor-procedure?",
1, 1),
env);
@ -703,9 +703,9 @@ scheme_init_struct (Scheme_Env *env)
"chaperone-struct",
1, -1),
env);
scheme_add_global_constant("proxy-struct",
scheme_make_prim_w_arity(proxy_struct,
"proxy-struct",
scheme_add_global_constant("impersonate-struct",
scheme_make_prim_w_arity(impersonate_struct,
"impersonate-struct",
1, -1),
env);
scheme_add_global_constant("chaperone-struct-type",
@ -713,23 +713,23 @@ scheme_init_struct (Scheme_Env *env)
"chaperone-struct-type",
1, -1),
env);
scheme_add_global_constant("make-proxy-property",
scheme_add_global_constant("make-impersonator-property",
scheme_make_prim_w_arity2(make_chaperone_property,
"make-proxy-property",
"make-impersonator-property",
1, 1,
3, 3),
env);
scheme_add_global_constant("proxy-property?",
scheme_add_global_constant("impersonator-property?",
scheme_make_folding_prim(chaperone_property_p,
"proxy-property?",
"impersonator-property?",
1, 1, 1),
env);
{
REGISTER_SO(scheme_app_mark_proxy_property);
scheme_app_mark_proxy_property = make_chaperone_property_from_c(scheme_intern_symbol("application-mark"));
scheme_add_global_constant("proxy-prop:application-mark",
scheme_app_mark_proxy_property,
REGISTER_SO(scheme_app_mark_impersonator_property);
scheme_app_mark_impersonator_property = make_chaperone_property_from_c(scheme_intern_symbol("application-mark"));
scheme_add_global_constant("impersonator-prop:application-mark",
scheme_app_mark_impersonator_property,
env);
}
}
@ -981,7 +981,7 @@ static Scheme_Object *do_chaperone_prop_accessor(const char *who, Scheme_Object
a[1] = orig;
v = _scheme_apply(red, 2, a);
if (!(SCHEME_CHAPERONE_FLAGS(px) & SCHEME_CHAPERONE_IS_PROXY))
if (!(SCHEME_CHAPERONE_FLAGS(px) & SCHEME_CHAPERONE_IS_IMPERSONATOR))
if (!scheme_chaperone_of(v, orig))
scheme_raise_exn(MZEXN_FAIL_CONTRACT,
"%s: chaperone produced a result: %V that is not a chaperone of the original result: %V",
@ -1030,7 +1030,7 @@ static Scheme_Object *make_struct_type_property_from_c(int argc, Scheme_Object *
if (type == scheme_struct_property_type)
who = "make-struct-type-property";
else
who = "make-proxy-property";
who = "make-impersonator-property";
if (!SCHEME_SYMBOLP(argv[0]))
scheme_wrong_type(who, "symbol", 0, argc, argv);
@ -1138,7 +1138,7 @@ Scheme_Object *scheme_make_struct_type_property(Scheme_Object *name)
Scheme_Object *scheme_chaperone_struct_type_property_ref(Scheme_Object *prop, Scheme_Object *s)
{
if (SCHEME_CHAPERONEP(s))
return do_chaperone_prop_accessor("proxy-property-ref", prop, s);
return do_chaperone_prop_accessor("impersonator-property-ref", prop, s);
else
return do_prop_accessor(prop, s);
}
@ -1517,20 +1517,20 @@ static Scheme_Object *check_equal_property_value_ok(int argc, Scheme_Object *arg
return v;
}
static Scheme_Object *check_proxy_of_property_value_ok(int argc, Scheme_Object *argv[])
static Scheme_Object *check_impersonator_of_property_value_ok(int argc, Scheme_Object *argv[])
{
/* This is the guard for prop:proxy-of */
/* This is the guard for prop:impersonator-of */
Scheme_Object *v;
v = argv[0];
if (!scheme_check_proc_arity(NULL, 1, 0, argc, argv)) {
scheme_arg_mismatch("guard-for-prop:proxy-of",
scheme_arg_mismatch("guard-for-prop:impersonator-of",
"not a procedure of arity 1: ",
v);
}
/* Add a tag to track origin of the proxy-of property: */
/* Add a tag to track origin of the impersonator-of property: */
v = scheme_make_pair(scheme_make_symbol("tag"), v);
return v;
@ -1860,7 +1860,7 @@ static Scheme_Object *chaperone_struct_ref(const char *who, Scheme_Object *o, in
red = SCHEME_VEC_ELS(px->redirects)[PRE_REDIRECTS + i];
o = _scheme_apply(red, 2, a);
if (!(SCHEME_CHAPERONE_FLAGS(px) & SCHEME_CHAPERONE_IS_PROXY))
if (!(SCHEME_CHAPERONE_FLAGS(px) & SCHEME_CHAPERONE_IS_IMPERSONATOR))
if (!scheme_chaperone_of(o, orig))
scheme_raise_exn(MZEXN_FAIL_CONTRACT,
"%s: chaperone produced a result: %V that is not a chaperone of the original result: %V",
@ -1905,7 +1905,7 @@ static void chaperone_struct_set(const char *who, Scheme_Object *o, int i, Schem
a[1] = v;
v = _scheme_apply(red, 2, a);
if (!(SCHEME_CHAPERONE_FLAGS(px) & SCHEME_CHAPERONE_IS_PROXY))
if (!(SCHEME_CHAPERONE_FLAGS(px) & SCHEME_CHAPERONE_IS_IMPERSONATOR))
if (!scheme_chaperone_of(v, a[1]))
scheme_raise_exn(MZEXN_FAIL_CONTRACT,
"%s: chaperone produced a result: %V that is not a chaperone of the original result: %V",
@ -2377,16 +2377,16 @@ static Scheme_Object *proc_struct_type_p(int argc, Scheme_Object *argv[])
static Scheme_Object *apply_chaperones(const char *who, Scheme_Object *procs, int argc, Scheme_Object **a)
{
Scheme_Object *v, **vals, *v1[1];
int cnt, i, is_proxy;
int cnt, i, is_impersonator;
Scheme_Thread *p;
while (SCHEME_PAIRP(procs)) {
v = SCHEME_CAR(procs);
if (SCHEME_BOXP(v)) {
is_proxy = 1;
is_impersonator = 1;
v = SCHEME_BOX_VAL(v);
} else
is_proxy = 0;
is_impersonator = 0;
v = _scheme_apply_multi(v, argc, a);
@ -2412,7 +2412,7 @@ static Scheme_Object *apply_chaperones(const char *who, Scheme_Object *procs, in
cnt, argc);
}
if (!is_proxy) {
if (!is_impersonator) {
for (i = 0; i < argc; i++) {
if (!scheme_chaperone_of(vals[i], a[i]))
scheme_raise_exn(MZEXN_FAIL_CONTRACT,
@ -2440,7 +2440,7 @@ static Scheme_Object *struct_info_chaperone(Scheme_Object *o, Scheme_Object *si,
if (SCHEME_VECTORP(px->redirects)) {
if (SCHEME_VEC_ELS(px->redirects)[1]) {
proc = SCHEME_VEC_ELS(px->redirects)[1];
if (SCHEME_CHAPERONE_FLAGS(px) & SCHEME_CHAPERONE_IS_PROXY)
if (SCHEME_CHAPERONE_FLAGS(px) & SCHEME_CHAPERONE_IS_IMPERSONATOR)
proc = scheme_box(proc);
procs = scheme_make_pair(proc, procs);
}
@ -2586,7 +2586,7 @@ static Scheme_Object *struct_type_info_chaperone(Scheme_Object *o, Scheme_Object
px = (Scheme_Chaperone *)o;
if (SCHEME_PAIRP(px->redirects)) {
proc = SCHEME_CAR(px->redirects);
if (SCHEME_CHAPERONE_FLAGS(px) & SCHEME_CHAPERONE_IS_PROXY)
if (SCHEME_CHAPERONE_FLAGS(px) & SCHEME_CHAPERONE_IS_IMPERSONATOR)
proc = scheme_box(proc);
procs = scheme_make_pair(proc, procs);
}
@ -2635,7 +2635,7 @@ static Scheme_Object *type_constr_chaperone(Scheme_Object *o, Scheme_Object *v)
px = (Scheme_Chaperone *)o;
if (SCHEME_PAIRP(px->redirects)) {
proc = SCHEME_CADR(px->redirects);
if (SCHEME_CHAPERONE_FLAGS(px) & SCHEME_CHAPERONE_IS_PROXY)
if (SCHEME_CHAPERONE_FLAGS(px) & SCHEME_CHAPERONE_IS_IMPERSONATOR)
proc = scheme_box(proc);
procs = scheme_make_pair(proc, procs);
}
@ -3120,14 +3120,14 @@ Scheme_Object *handle_evt_p(int argc, Scheme_Object *argv[])
return NULL;
}
static Scheme_Object *do_chaperone_result_guard_proc(int is_proxy, void *data, int argc, Scheme_Object *argv[])
static Scheme_Object *do_chaperone_result_guard_proc(int is_impersonator, void *data, int argc, Scheme_Object *argv[])
{
Scheme_Object *proc = (Scheme_Object *)data, *o, *a[1];
a[0] = argv[0];
o = _scheme_apply(proc, 1, a);
if (!is_proxy)
if (!is_impersonator)
if (!scheme_chaperone_of(o, a[0]))
scheme_raise_exn(MZEXN_FAIL_CONTRACT,
"evt result chaperone: chaperone produced a value: %V that is not a chaperone of the original result: %V",
@ -3142,12 +3142,12 @@ static Scheme_Object *chaperone_result_guard_proc(void *data, int argc, Scheme_O
return do_chaperone_result_guard_proc(0, data, argc, argv);
}
static Scheme_Object *proxy_result_guard_proc(void *data, int argc, Scheme_Object *argv[])
static Scheme_Object *impersonator_result_guard_proc(void *data, int argc, Scheme_Object *argv[])
{
return do_chaperone_result_guard_proc(1, data, argc, argv);
}
static Scheme_Object *do_chaperone_guard_proc(int is_proxy, void *data, int argc, Scheme_Object *argv[])
static Scheme_Object *do_chaperone_guard_proc(int is_impersonator, void *data, int argc, Scheme_Object *argv[])
{
Scheme_Object *evt = SCHEME_CAR((Scheme_Object *)data);
Scheme_Object *proc = SCHEME_CDR((Scheme_Object *)data);
@ -3175,11 +3175,11 @@ static Scheme_Object *do_chaperone_guard_proc(int is_proxy, void *data, int argc
if (cnt != 2)
scheme_raise_exn(MZEXN_FAIL_CONTRACT_ARITY,
"evt %s: %V: returned %d values, expected 2",
(is_proxy ? "proxy" : "chaperone"),
(is_impersonator ? "impersonator" : "chaperone"),
proc,
cnt);
if (!is_proxy)
if (!is_impersonator)
if (!scheme_chaperone_of(vals[0], evt))
scheme_raise_exn(MZEXN_FAIL_CONTRACT,
"evt chaperone: chaperone produced a value: %V that is not a chaperone of the original event: %V",
@ -3188,13 +3188,13 @@ static Scheme_Object *do_chaperone_guard_proc(int is_proxy, void *data, int argc
if (!scheme_check_proc_arity(NULL, 1, 1, 1, vals))
scheme_raise_exn(MZEXN_FAIL_CONTRACT,
"evt %s: expected a value of type <procedure (arity 2)> as second %s result, received: %V",
(is_proxy ? "proxy" : "chaperone"),
(is_proxy ? "proxy" : "chaperone"),
(is_impersonator ? "impersonator" : "chaperone"),
(is_impersonator ? "impersonator" : "chaperone"),
vals[1]);
a[0] = vals[0];
o = scheme_make_closed_prim_w_arity((is_proxy
? proxy_result_guard_proc
o = scheme_make_closed_prim_w_arity((is_impersonator
? impersonator_result_guard_proc
: chaperone_result_guard_proc),
(void *)vals[1],
"evt-result-chaperone",
@ -3209,12 +3209,12 @@ static Scheme_Object *chaperone_guard_proc(void *data, int argc, Scheme_Object *
return do_chaperone_guard_proc(0, data, argc, argv);
}
static Scheme_Object *proxy_guard_proc(void *data, int argc, Scheme_Object *argv[])
static Scheme_Object *impersonator_guard_proc(void *data, int argc, Scheme_Object *argv[])
{
return do_chaperone_guard_proc(1, data, argc, argv);
}
static Scheme_Object *do_chaperone_evt(const char *name, int is_proxy, int argc, Scheme_Object *argv[])
static Scheme_Object *do_chaperone_evt(const char *name, int is_impersonator, int argc, Scheme_Object *argv[])
{
Scheme_Chaperone *px;
Scheme_Object *o, *val, *a[1];
@ -3231,13 +3231,13 @@ static Scheme_Object *do_chaperone_evt(const char *name, int is_proxy, int argc,
props = scheme_parse_chaperone_props(name, 2, argc, argv);
o = scheme_make_pair(argv[0], argv[1]);
o = scheme_make_closed_prim_w_arity((is_proxy
? proxy_guard_proc
o = scheme_make_closed_prim_w_arity((is_impersonator
? impersonator_guard_proc
: chaperone_guard_proc),
(void *)o,
(is_proxy
? "evt-chaperone"
: "evt-proxy"),
(is_impersonator
? "chaperone-evt"
: "impersonate-evt"),
1, 1);
a[0] = o;
o = nack_evt(1, a);
@ -3252,8 +3252,8 @@ static Scheme_Object *do_chaperone_evt(const char *name, int is_proxy, int argc,
px->props = props;
px->redirects = o;
if (is_proxy)
SCHEME_CHAPERONE_FLAGS(px) |= SCHEME_CHAPERONE_IS_PROXY;
if (is_impersonator)
SCHEME_CHAPERONE_FLAGS(px) |= SCHEME_CHAPERONE_IS_IMPERSONATOR;
return (Scheme_Object *)px;
}
@ -5121,7 +5121,7 @@ static Scheme_Object *check_exn_source_property_value_ok(int argc, Scheme_Object
/**********************************************************************/
static Scheme_Object *do_chaperone_struct(const char *name, int is_proxy, int argc, Scheme_Object **argv)
static Scheme_Object *do_chaperone_struct(const char *name, int is_impersonator, int argc, Scheme_Object **argv)
/* (chaperone-struct v mutator/selector replacement ...) */
{
Scheme_Chaperone *px;
@ -5166,15 +5166,15 @@ static Scheme_Object *do_chaperone_struct(const char *name, int is_proxy, int ar
} else if (SCHEME_TRUEP(struct_getter_p(1, a))) {
kind = "accessor";
offset = 0;
} else if (!is_proxy && SCHEME_TRUEP(struct_prop_getter_p(1, a))) {
} else if (!is_impersonator && SCHEME_TRUEP(struct_prop_getter_p(1, a))) {
kind = "struct-type property accessor";
offset = -1;
} else if (!is_proxy && SAME_OBJ(proc, struct_info_proc)) {
} else if (!is_impersonator && SAME_OBJ(proc, struct_info_proc)) {
kind = "struct-info";
offset = -2;
} else {
scheme_wrong_type(name,
(is_proxy
(is_impersonator
? "structure accessor or structure mutator"
: "structure accessor, structure mutator, struct-type property accessor, or `struct-info'"),
i, argc, argv);
@ -5228,7 +5228,7 @@ static Scheme_Object *do_chaperone_struct(const char *name, int is_proxy, int ar
name,
kind, kind,
a[0]);
if (is_proxy) {
if (is_impersonator) {
/* Must not be an immutable field. */
if (stype->immutables) {
if (stype->immutables[pi->field - (pi->struct_type->name_pos
@ -5289,8 +5289,8 @@ static Scheme_Object *do_chaperone_struct(const char *name, int is_proxy, int ar
px->props = props;
px->redirects = redirects;
if (is_proxy)
SCHEME_CHAPERONE_FLAGS(px) |= SCHEME_CHAPERONE_IS_PROXY;
if (is_impersonator)
SCHEME_CHAPERONE_FLAGS(px) |= SCHEME_CHAPERONE_IS_IMPERSONATOR;
return (Scheme_Object *)px;
}
@ -5300,12 +5300,12 @@ static Scheme_Object *chaperone_struct(int argc, Scheme_Object **argv)
return do_chaperone_struct("chaperone-struct", 0, argc, argv);
}
static Scheme_Object *proxy_struct(int argc, Scheme_Object **argv)
static Scheme_Object *impersonate_struct(int argc, Scheme_Object **argv)
{
return do_chaperone_struct("proxy-struct", 1, argc, argv);
return do_chaperone_struct("impersonate-struct", 1, argc, argv);
}
static Scheme_Object *do_chaperone_struct_type(const char *name, int is_proxy, int argc, Scheme_Object **argv)
static Scheme_Object *do_chaperone_struct_type(const char *name, int is_impersonator, int argc, Scheme_Object **argv)
{
Scheme_Chaperone *px;
Scheme_Object *val = argv[0];
@ -5344,8 +5344,8 @@ static Scheme_Object *do_chaperone_struct_type(const char *name, int is_proxy, i
px->prev = argv[0];
px->redirects = redirects;
if (is_proxy)
SCHEME_CHAPERONE_FLAGS(px) |= SCHEME_CHAPERONE_IS_PROXY;
if (is_impersonator)
SCHEME_CHAPERONE_FLAGS(px) |= SCHEME_CHAPERONE_IS_IMPERSONATOR;
return (Scheme_Object *)px;
}
@ -5368,7 +5368,7 @@ Scheme_Hash_Tree *scheme_parse_chaperone_props(const char *who, int start_at, in
while (start_at < argc) {
v = argv[start_at];
if (!SAME_TYPE(SCHEME_TYPE(v), scheme_chaperone_property_type))
scheme_wrong_type(who, "proxy-property", start_at, argc, argv);
scheme_wrong_type(who, "impersonator-property", start_at, argc, argv);
if (start_at + 1 >= argc)
scheme_arg_mismatch(who,

26
src/racket/src/vector.c
View File

@ -45,7 +45,7 @@ static Scheme_Object *vector_copy_bang(int argc, Scheme_Object *argv[]);
static Scheme_Object *vector_to_immutable (int argc, Scheme_Object *argv[]);
static Scheme_Object *vector_to_values (int argc, Scheme_Object *argv[]);
static Scheme_Object *chaperone_vector(int argc, Scheme_Object **argv);
static Scheme_Object *proxy_vector(int argc, Scheme_Object **argv);
static Scheme_Object *impersonate_vector(int argc, Scheme_Object **argv);
static Scheme_Object *unsafe_vector_len (int argc, Scheme_Object *argv[]);
static Scheme_Object *unsafe_vector_ref (int argc, Scheme_Object *argv[]);
@ -147,9 +147,9 @@ scheme_init_vector (Scheme_Env *env)
"chaperone-vector",
3, -1),
env);
scheme_add_global_constant("proxy-vector",
scheme_make_prim_w_arity(proxy_vector,
"proxy-vector",
scheme_add_global_constant("impersonate-vector",
scheme_make_prim_w_arity(impersonate_vector,
"impersonate-vector",
3, -1),
env);
}
@ -425,7 +425,7 @@ Scheme_Object *scheme_chaperone_vector_ref(Scheme_Object *o, int i)
red = SCHEME_CAR(px->redirects);
o = _scheme_apply(red, 3, a);
if (!(SCHEME_CHAPERONE_FLAGS(px) & SCHEME_CHAPERONE_IS_PROXY))
if (!(SCHEME_CHAPERONE_FLAGS(px) & SCHEME_CHAPERONE_IS_IMPERSONATOR))
if (!scheme_chaperone_of(o, orig))
scheme_raise_exn(MZEXN_FAIL_CONTRACT,
"vector-ref: chaperone produced a result: %V that is not a chaperone of the original result: %V",
@ -480,7 +480,7 @@ void scheme_chaperone_vector_set(Scheme_Object *o, int i, Scheme_Object *v)
red = SCHEME_CDR(px->redirects);
v = _scheme_apply(red, 3, a);
if (!(SCHEME_CHAPERONE_FLAGS(px) & SCHEME_CHAPERONE_IS_PROXY))
if (!(SCHEME_CHAPERONE_FLAGS(px) & SCHEME_CHAPERONE_IS_IMPERSONATOR))
if (!scheme_chaperone_of(v, a[2]))
scheme_raise_exn(MZEXN_FAIL_CONTRACT,
"vector-set!: chaperone produced a result: %V that is not a chaperone of the original result: %V",
@ -802,7 +802,7 @@ static Scheme_Object *vector_to_values (int argc, Scheme_Object *argv[])
return SCHEME_MULTIPLE_VALUES;
}
static Scheme_Object *do_chaperone_vector(const char *name, int is_proxy, int argc, Scheme_Object **argv)
static Scheme_Object *do_chaperone_vector(const char *name, int is_impersonator, int argc, Scheme_Object **argv)
{
Scheme_Chaperone *px;
Scheme_Object *val = argv[0];
@ -813,8 +813,8 @@ static Scheme_Object *do_chaperone_vector(const char *name, int is_proxy, int ar
val = SCHEME_CHAPERONE_VAL(val);
if (!SCHEME_VECTORP(val)
|| (is_proxy && !SCHEME_MUTABLEP(val)))
scheme_wrong_type(name, is_proxy ? "mutable vector" : "vector", 0, argc, argv);
|| (is_impersonator && !SCHEME_MUTABLEP(val)))
scheme_wrong_type(name, is_impersonator ? "mutable vector" : "vector", 0, argc, argv);
scheme_check_proc_arity(name, 3, 1, argc, argv);
scheme_check_proc_arity(name, 3, 2, argc, argv);
@ -829,8 +829,8 @@ static Scheme_Object *do_chaperone_vector(const char *name, int is_proxy, int ar
px->prev = argv[0];
px->redirects = redirects;
if (is_proxy)
SCHEME_CHAPERONE_FLAGS(px) |= SCHEME_CHAPERONE_IS_PROXY;
if (is_impersonator)
SCHEME_CHAPERONE_FLAGS(px) |= SCHEME_CHAPERONE_IS_IMPERSONATOR;
return (Scheme_Object *)px;
}
@ -840,9 +840,9 @@ static Scheme_Object *chaperone_vector(int argc, Scheme_Object **argv)
return do_chaperone_vector("chaperone-vector", 0, argc, argv);
}
static Scheme_Object *proxy_vector(int argc, Scheme_Object **argv)
static Scheme_Object *impersonate_vector(int argc, Scheme_Object **argv)
{
return do_chaperone_vector("proxy-vector", 1, argc, argv);
return do_chaperone_vector("impersonate-vector", 1, argc, argv);
}
/************************************************************/