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

unsafe-{impersonate,chaperone}-procedure: to racket/unsafe/ops

Browse Source 
Move from racket/base, since the functions are unsafe.
This commit is contained in:
Matthew Flatt 2016-01-16 07:25:42 -07:00
parent 48de4101c2
commit 0a266780fe
13 changed files with 1167 additions and 1144 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
pkgs/base/info.rkt
View File

@ -12,7 +12,7 @@
(define collection 'multi)
(define version "6.4.0.3")
(define version "6.4.0.4")
(define deps `("racket-lib"
["racket" #:version ,version]))

80
pkgs/racket-doc/scribblings/reference/chaperones.scrbl
View File

@ -310,77 +310,6 @@ that are overridden by further impersonators, for example.
@history[#:added "6.1.1.5"]}
@defproc[(unsafe-impersonate-procedure [proc procedure?]
[replacement-proc procedure?]
[prop impersonator-property?]
[prop-val any] ... ...)
(and/c procedure? impersonator?)]{
Like @racket[impersonate-procedure], except it assumes that @racket[replacement-proc]
is already properly wrapping @racket[proc] and so when the procedure that
@racket[unsafe-impersonate-procedure] produces is invoked, the
@racket[replacement-proc] is invoked directly, ignoring @racket[proc].
In addition, it does not specially handle @racket[impersonator-prop:application-mark],
instead just treating it as an ordinary property if it is supplied as one of the
@racket[prop] arguments.
This procedure is unsafe only in how it assumes @racket[replacement-proc] is
a proper wrapper for @racket[proc]. It otherwise does all of the checking
that @racket[impersonate-procedure] does.
As an example, this function:
@racketblock[(λ (f)
(unsafe-impersonate-procedure
f
(λ (x)
(if (number? x)
(error 'no-numbers!)
(f x)))))]
is equivalent to this one:
@racketblock[(λ (f)
(impersonate-procedure
f
(λ (x)
(if (number? x)
(error 'no-numbers!)
x))))]
(except that some error messages start with @litchar{unsafe-impersonate-procedure}
instead of @litchar{impersonate-procedure}).
Similarly the two procedures @racket[_wrap-f1] and
@racket[_wrap-f2] are almost equivalent; they differ only
in the error message produced when their arguments are
functions that return multiple values (and that they update
different global variables). The version using @racket[unsafe-impersonate-procedure]
will signal an error in the @racket[let] expression about multiple
value return, whereas the one using @racket[impersonate-procedure] signals
an error from @racket[impersonate-procedure] about multiple value return.
@racketblock[(define log1-args '())
(define log1-results '())
(define wrap-f1
(λ (f)
(impersonate-procedure
f
(λ (arg)
(set! log1-args (cons arg log1-args))
(values (λ (res)
(set! log1-results (cons res log1-results))
res)
arg)))))
(define log2-args '())
(define log2-results '())
(define wrap-f2
(λ (f)
(unsafe-impersonate-procedure
f
(λ (arg)
(set! log2-args (cons arg log2-args))
(let ([res (f arg)])
(set! log2-results (cons res log2-results))
res)))))]
}
@defproc[(impersonate-struct [v any/c]
[struct-type struct-type? _unspecified]
@ -793,15 +722,6 @@ an extra argument as with @racket[impersonate-procedure*].
@history[#:added "6.1.1.5"]}
@defproc[(unsafe-chaperone-procedure [proc procedure?]
[wrapper-proc procedure?]
[prop impersonator-property?]
[prop-val any] ... ...)
(and/c procedure? chaperone?)]{
Like @racket[unsafe-impersonate-procedure], but creates a @tech{chaperone}.
@history[#:added "6.1.1.5"]
}
@defproc[(chaperone-struct [v any/c]
[struct-type struct-type? _unspecified]

2
pkgs/racket-doc/scribblings/reference/procedures.scrbl
View File

@ -246,6 +246,8 @@ list is also in the second list.
(cond
[(zero? (random 10)) '()]
[else (cons 1 (loop))])))))]
@history[#:added "6.4.0.3"]
}
@defproc[(make-keyword-procedure

87
pkgs/racket-doc/scribblings/reference/unsafe.scrbl
View File

@ -434,4 +434,91 @@ fixnum).}
@; ------------------------------------------------------------------------
@section{Unsafe Impersonators and Chaperones}
@defproc[(unsafe-impersonate-procedure [proc procedure?]
[replacement-proc procedure?]
[prop impersonator-property?]
[prop-val any] ... ...)
(and/c procedure? impersonator?)]{
Like @racket[impersonate-procedure], except it assumes that @racket[replacement-proc]
is already properly wrapping @racket[proc] and so when the procedure that
@racket[unsafe-impersonate-procedure] produces is invoked, the
@racket[replacement-proc] is invoked directly, ignoring @racket[proc].
In addition, it does not specially handle @racket[impersonator-prop:application-mark],
instead just treating it as an ordinary property if it is supplied as one of the
@racket[prop] arguments.
This procedure is unsafe only in how it assumes @racket[replacement-proc] is
a proper wrapper for @racket[proc]. It otherwise does all of the checking
that @racket[impersonate-procedure] does.
As an example, this function:
@racketblock[(λ (f)
(unsafe-impersonate-procedure
f
(λ (x)
(if (number? x)
(error 'no-numbers!)
(f x)))))]
is equivalent to this one:
@racketblock[(λ (f)
(impersonate-procedure
f
(λ (x)
(if (number? x)
(error 'no-numbers!)
x))))]
(except that some error messages start with @litchar{unsafe-impersonate-procedure}
instead of @litchar{impersonate-procedure}).
Similarly the two procedures @racket[_wrap-f1] and
@racket[_wrap-f2] are almost equivalent; they differ only
in the error message produced when their arguments are
functions that return multiple values (and that they update
different global variables). The version using @racket[unsafe-impersonate-procedure]
will signal an error in the @racket[let] expression about multiple
value return, whereas the one using @racket[impersonate-procedure] signals
an error from @racket[impersonate-procedure] about multiple value return.
@racketblock[(define log1-args '())
(define log1-results '())
(define wrap-f1
(λ (f)
(impersonate-procedure
f
(λ (arg)
(set! log1-args (cons arg log1-args))
(values (λ (res)
(set! log1-results (cons res log1-results))
res)
arg)))))
(define log2-args '())
(define log2-results '())
(define wrap-f2
(λ (f)
(unsafe-impersonate-procedure
f
(λ (arg)
(set! log2-args (cons arg log2-args))
(let ([res (f arg)])
(set! log2-results (cons res log2-results))
res)))))]
@history[#:added "6.4.0.4"]
}
@defproc[(unsafe-chaperone-procedure [proc procedure?]
[wrapper-proc procedure?]
[prop impersonator-property?]
[prop-val any] ... ...)
(and/c procedure? chaperone?)]{
Like @racket[unsafe-impersonate-procedure], but creates a @tech{chaperone}.
@history[#:added "6.4.0.4"]
}
@; ------------------------------------------------------------------------
@include-section["unsafe-undefined.scrbl"]

4
pkgs/racket-test-core/tests/racket/chaperone.rktl
View File

@ -3,6 +3,10 @@
(load-relative "loadtest.rktl")
(Section 'chaperones)
(require (only-in racket/unsafe/ops
unsafe-impersonate-procedure
unsafe-chaperone-procedure))
;; ----------------------------------------
(define (chaperone-of?/impersonator a b)

5
racket/collects/racket/contract/private/arrow-higher-order.rkt
View File

@ -8,7 +8,10 @@
"misc.rkt"
"prop.rkt"
"guts.rkt"
(prefix-in arrow: "arrow.rkt"))
(prefix-in arrow: "arrow.rkt")
(only-in racket/unsafe/ops
unsafe-chaperone-procedure
unsafe-impersonate-procedure))
(provide (for-syntax build-chaperone-constructor/real)
procedure-arity-exactly/no-kwds

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

@ -2,7 +2,11 @@
(#%require "define.rkt"
"small-scheme.rkt"
"more-scheme.rkt"
(only '#%unsafe
unsafe-chaperone-procedure
unsafe-impersonate-procedure)
(for-syntax '#%kernel
'#%unsafe
"procedure-alias.rkt"
"stx.rkt"
"small-scheme.rkt"
@ -26,9 +30,9 @@
new:procedure->method
new:procedure-rename
new:chaperone-procedure
new:unsafe-chaperone-procedure
(protect new:unsafe-chaperone-procedure)
new:impersonate-procedure
new:unsafe-impersonate-procedure
(protect new:unsafe-impersonate-procedure)
new:chaperone-procedure*
new:impersonate-procedure*
(for-syntax kw-expander? kw-expander-impl kw-expander-proc

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

@ -219,9 +219,7 @@
(rename new:procedure->method procedure->method)
(rename new:procedure-rename procedure-rename)
(rename new:chaperone-procedure chaperone-procedure)
(rename new:unsafe-chaperone-procedure unsafe-chaperone-procedure)
(rename new:impersonate-procedure impersonate-procedure)
(rename new:unsafe-impersonate-procedure unsafe-impersonate-procedure)
(rename new:chaperone-procedure* chaperone-procedure*)
(rename new:impersonate-procedure* impersonate-procedure*)
(rename new:collection-path collection-path)
@ -230,7 +228,6 @@
procedure-arity procedure-reduce-arity raise-arity-error
procedure->method procedure-rename
chaperone-procedure impersonate-procedure
unsafe-chaperone-procedure unsafe-impersonate-procedure
chaperone-procedure* impersonate-procedure*
assq assv assoc
prop:incomplete-arity prop:method-arity-error

9
racket/collects/racket/unsafe/ops.rkt
View File

@ -1,14 +1,19 @@
#lang racket/base
(require '#%unsafe
'#%flfxnum
'#%extfl)
'#%extfl
"../private/kw.rkt")
(provide (except-out (all-from-out '#%unsafe)
unsafe-undefined
check-not-unsafe-undefined
check-not-unsafe-undefined/assign
prop:chaperone-unsafe-undefined
chaperone-struct-unsafe-undefined)
chaperone-struct-unsafe-undefined
unsafe-chaperone-procedure
unsafe-impersonate-procedure)
(rename-out [new:unsafe-impersonate-procedure unsafe-impersonate-procedure]
[new:unsafe-chaperone-procedure unsafe-chaperone-procedure])
(prefix-out unsafe-
(combine-out flsin flcos fltan
flasin flacos flatan

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

File diff suppressed because it is too large Load Diff

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

@ -611,21 +611,11 @@ scheme_init_fun (Scheme_Env *env)
"chaperone-procedure",
2, -1),
env);
scheme_add_global_constant("unsafe-chaperone-procedure",
scheme_make_prim_w_arity(unsafe_chaperone_procedure,
"unsafe-chaperone-procedure",
2, -1),
env);
scheme_add_global_constant("impersonate-procedure",
scheme_make_prim_w_arity(impersonate_procedure,
"impersonate-procedure",
2, -1),
env);
scheme_add_global_constant("unsafe-impersonate-procedure",
scheme_make_prim_w_arity(unsafe_impersonate_procedure,
"unsafe-impersonate-procedure",
2, -1),
env);
scheme_add_global_constant("chaperone-procedure*",
scheme_make_prim_w_arity(chaperone_procedure_star,
"chaperone-procedure*",
@ -763,6 +753,17 @@ scheme_init_unsafe_fun (Scheme_Env *env)
o = scheme_make_prim_w_arity(chaperone_unsafe_undefined, "chaperone-struct-unsafe-undefined", 1, 1);
scheme_add_global_constant("chaperone-struct-unsafe-undefined", o, env);
scheme_add_global_constant("unsafe-chaperone-procedure",
scheme_make_prim_w_arity(unsafe_chaperone_procedure,
"unsafe-chaperone-procedure",
2, -1),
env);
scheme_add_global_constant("unsafe-impersonate-procedure",
scheme_make_prim_w_arity(unsafe_impersonate_procedure,
"unsafe-impersonate-procedure",
2, -1),
env);
}
void

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

@ -14,8 +14,8 @@
#define USE_COMPILED_STARTUP 1
#define EXPECTED_PRIM_COUNT 1144
#define EXPECTED_UNSAFE_COUNT 106
#define EXPECTED_PRIM_COUNT 1142
#define EXPECTED_UNSAFE_COUNT 108
#define EXPECTED_FLFXNUM_COUNT 69
#define EXPECTED_EXTFL_COUNT 45
#define EXPECTED_FUTURES_COUNT 15

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

@ -13,12 +13,12 @@
consistently.)
*/
#define MZSCHEME_VERSION "6.4.0.3"
#define MZSCHEME_VERSION "6.4.0.4"
#define MZSCHEME_VERSION_X 6
#define MZSCHEME_VERSION_Y 4
#define MZSCHEME_VERSION_Z 0
#define MZSCHEME_VERSION_W 3
#define MZSCHEME_VERSION_W 4
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)