From ea96e2d3042b1e4ff0d39ef506bb72a2f204d623 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 29 Dec 2020 08:20:57 -0700 Subject: [PATCH] add `unsafe-set-immutable-{car,cdr}!` Reluctantly, with intentionally oxymoronic names, and with the key caveat: using these requires making correct assumptions about Racket's implementation. With BC, a related assumption was that `unsafe-set-mcar!` and `unsafe-set-mcdr!` mutate pairs, but that's not the case with CS. So, adding these functions supports a kind of portability between BC and CS. --- pkgs/base/info.rkt | 2 +- .../scribblings/reference/unsafe.scrbl | 40 ++++++++++++++++++- .../racket-test-core/tests/racket/unsafe.rktl | 9 +++++ racket/src/bc/src/jitinline.c | 7 +++- racket/src/bc/src/list.c | 8 ++++ racket/src/bc/src/schminc.h | 2 +- racket/src/cs/primitive/unsafe.ss | 16 ++++---- racket/src/cs/rumble.sls | 2 + racket/src/cs/rumble/unsafe.ss | 2 + racket/src/version/racket_version.h | 2 +- 10 files changed, 77 insertions(+), 13 deletions(-) diff --git a/pkgs/base/info.rkt b/pkgs/base/info.rkt index 95f8dccdb2..faf0f68646 100644 --- a/pkgs/base/info.rkt +++ b/pkgs/base/info.rkt @@ -14,7 +14,7 @@ ;; In the Racket source repo, this version should change only when ;; "racket_version.h" changes: -(define version "7.9.0.17") +(define version "7.9.0.18") (define deps `("racket-lib" ["racket" #:version ,version])) diff --git a/pkgs/racket-doc/scribblings/reference/unsafe.scrbl b/pkgs/racket-doc/scribblings/reference/unsafe.scrbl index 0c5236936a..d44a03d528 100644 --- a/pkgs/racket-doc/scribblings/reference/unsafe.scrbl +++ b/pkgs/racket-doc/scribblings/reference/unsafe.scrbl @@ -235,7 +235,7 @@ Unchecked versions of @racket[char=?], @racket[char?], -@section{Unsafe Data Extraction} +@section[#:tag "Unsafe Data Extraction"]{Unsafe Compound-Data Operations} @deftogether[( @defproc[(unsafe-car [p pair?]) any/c] @@ -267,6 +267,44 @@ at least @racket[(add1 pos)] (for @racket[unsafe-list-ref]) or @racket[pos] (for @racket[unsafe-list-tail]) pairs.} +@deftogether[( +@defproc[(unsafe-set-immutable-car! [p pair?] [v any/c]) void?] +@defproc[(unsafe-set-immutable-cdr! [p pair?] [v any/c]) void?] +)]{ + +As their oxymoronic names should suggest, there is @emph{no generally +correct way} to use these functions. They may be useful nevertheless, +as a last resort, in settings where pairs are used in a constrained +way and when making correct assumptions about Racket's implementation +(including limits on the compiler's optimizations). + +Some pitfalls of using @racket[unsafe-set-immutable-car!] and +@racket[unsafe-set-immutable-cdr!]: + +@itemlist[ + + @item{Functions that consume a pair may take advantage of + immutability, such as computing a list's length once and + expecting the list to retain that length, or checking a list + against a contract and expecting the contract to hold + thereafter.} + + @item{The result of @racket[list?] for a pair may be cached + internally, so that changing the @racket[cdr] of a pair from a + list to a non-list or vice versa may cause @racket[list?] to + produce the wrong value---for the mutated pair or for another + pair that reaches the mutated pair.} + + @item{The compiler may reorder or even optimize away a call to + @racket[car] or @racket[cdr] on the grounds that pairs are + immutable, in which case a @racket[unsafe-set-immutable-car!] + or @racket[unsafe-set-immutable-cdr!] may not have an effect on + the use of @racket[car] or @racket[cdr].} + +] + +@history[#:added "7.9.0.18"]} + @deftogether[( @defproc[(unsafe-unbox [b box?]) fixnum?] @defproc[(unsafe-set-box! [b box?] [k fixnum?]) void?] diff --git a/pkgs/racket-test-core/tests/racket/unsafe.rktl b/pkgs/racket-test-core/tests/racket/unsafe.rktl index 5da0081923..7d5e670cab 100644 --- a/pkgs/racket-test-core/tests/racket/unsafe.rktl +++ b/pkgs/racket-test-core/tests/racket/unsafe.rktl @@ -526,6 +526,15 @@ (test-un 5 'unsafe-car (cons 5 9)) (test-un 9 'unsafe-cdr (cons 5 9)) + (let ([v (cons 3 7)]) + (test-bin 8 'unsafe-set-immutable-car! v 8 + #:pre (lambda () (unsafe-set-immutable-car! v 0)) + #:post (lambda (x) (car v)) + #:literal-ok? #f) + (test-bin 9 'unsafe-set-immutable-cdr! v 9 + #:pre (lambda () (unsafe-set-immutable-cdr! v 0)) + #:post (lambda (x) (cdr v)) + #:literal-ok? #f)) (test-un 15 'unsafe-mcar (mcons 15 19)) (test-un 19 'unsafe-mcdr (mcons 15 19)) (let ([v (mcons 3 7)]) diff --git a/racket/src/bc/src/jitinline.c b/racket/src/bc/src/jitinline.c index 13093eb3cc..2a8a1c629c 100644 --- a/racket/src/bc/src/jitinline.c +++ b/racket/src/bc/src/jitinline.c @@ -4242,10 +4242,13 @@ int scheme_generate_inlined_binary(mz_jit_state *jitter, Scheme_App3_Rec *app, i return 1; } else if (IS_NAMED_PRIM(rator, "unsafe-set-mcar!") - || IS_NAMED_PRIM(rator, "unsafe-set-mcdr!")) { + || IS_NAMED_PRIM(rator, "unsafe-set-mcdr!") + || IS_NAMED_PRIM(rator, "unsafe-set-immutable-car!") + || IS_NAMED_PRIM(rator, "unsafe-set-immutable-cdr!")) { int set_mcar; - set_mcar = IS_NAMED_PRIM(rator, "unsafe-set-mcar!"); + set_mcar = (IS_NAMED_PRIM(rator, "unsafe-set-mcar!") + || IS_NAMED_PRIM(rator, "unsafe-set-immutable-car!")); LOG_IT(("inlined unsafe-set-mcar!\n")); diff --git a/racket/src/bc/src/list.c b/racket/src/bc/src/list.c index 72e9e7a5cc..4129fedcf4 100644 --- a/racket/src/bc/src/list.c +++ b/racket/src/bc/src/list.c @@ -875,6 +875,14 @@ scheme_init_unsafe_list (Scheme_Startup_Env *env) scheme_addto_prim_instance ("unsafe-cdr", p, env); scheme_unsafe_cdr_proc = p; + p = scheme_make_immed_prim(unsafe_set_mcar, "unsafe-set-immutable-car!", 2, 2); + SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED); + scheme_addto_prim_instance ("unsafe-set-immutable-car!", p, env); + + p = scheme_make_immed_prim(unsafe_set_mcdr, "unsafe-set-immutable-cdr!", 2, 2); + SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED); + scheme_addto_prim_instance ("unsafe-set-immutable-cdr!", p, env); + p = scheme_make_folding_prim(unsafe_list_ref, "unsafe-list-ref", 2, 2, 1); SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED | SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL diff --git a/racket/src/bc/src/schminc.h b/racket/src/bc/src/schminc.h index f2bde91cc3..6ebd1d0957 100644 --- a/racket/src/bc/src/schminc.h +++ b/racket/src/bc/src/schminc.h @@ -15,7 +15,7 @@ #define USE_COMPILED_STARTUP 1 -#define EXPECTED_PRIM_COUNT 1482 +#define EXPECTED_PRIM_COUNT 1484 #ifdef MZSCHEME_SOMETHING_OMITTED # undef USE_COMPILED_STARTUP diff --git a/racket/src/cs/primitive/unsafe.ss b/racket/src/cs/primitive/unsafe.ss index 2e01e6d382..80723c382c 100644 --- a/racket/src/cs/primitive/unsafe.ss +++ b/racket/src/cs/primitive/unsafe.ss @@ -122,8 +122,8 @@ [unsafe-make-os-semaphore (known-procedure 1)] [unsafe-make-security-guard-at-root (known-procedure 15)] [unsafe-make-srcloc (known-procedure/pure 32)] - [unsafe-mcar (known-procedure 2)] - [unsafe-mcdr (known-procedure 2)] + [unsafe-mcar (known-procedure/succeeds 2)] + [unsafe-mcdr (known-procedure/succeeds 2)] [unsafe-mutable-hash-iterate-first (known-procedure 2)] [unsafe-mutable-hash-iterate-key (known-procedure 12)] [unsafe-mutable-hash-iterate-key+value (known-procedure 12)] @@ -145,12 +145,14 @@ [unsafe-register-process-global (known-procedure 4)] [unsafe-remove-collect-callbacks (known-procedure 2)] [unsafe-root-continuation-prompt-tag (known-procedure/pure 1)] - [unsafe-s16vector-ref (known-procedure 4)] - [unsafe-s16vector-set! (known-procedure 8)] + [unsafe-s16vector-ref (known-procedure/succeeds 4)] + [unsafe-s16vector-set! (known-procedure/succeeds 8)] [unsafe-set-box! (known-procedure 4)] - [unsafe-set-box*! (known-procedure 4)] - [unsafe-set-mcar! (known-procedure 4)] - [unsafe-set-mcdr! (known-procedure 4)] + [unsafe-set-box*! (known-procedure/succeeds 4)] + [unsafe-set-immutable-car! (known-procedure/succeeds 4)] + [unsafe-set-immutable-cdr! (known-procedure/succeeds 4)] + [unsafe-set-mcar! (known-procedure/succeeds 4)] + [unsafe-set-mcdr! (known-procedure/succeeds 4)] [unsafe-set-on-atomic-timeout! (known-procedure 2)] [unsafe-set-sleep-in-thread! (known-procedure 4)] [unsafe-signal-received (known-procedure 1)] diff --git a/racket/src/cs/rumble.sls b/racket/src/cs/rumble.sls index b15441d134..88be9eb660 100644 --- a/racket/src/cs/rumble.sls +++ b/racket/src/cs/rumble.sls @@ -511,6 +511,8 @@ unsafe-list-tail unsafe-list-ref unsafe-cons-list + unsafe-set-immutable-car! + unsafe-set-immutable-cdr! unsafe-char=? unsafe-char