diff --git a/racket/src/cs/primitive/flfxnum.ss b/racket/src/cs/primitive/flfxnum.ss index 182278d306..a76514e6df 100644 --- a/racket/src/cs/primitive/flfxnum.ss +++ b/racket/src/cs/primitive/flfxnum.ss @@ -5,7 +5,7 @@ [fl+ (known-procedure -1)] [fl- (known-procedure -2)] [fl->exact-integer (known-procedure 2)] - [fl->fx (known-procedure 2)] + [fl->fx (known-procedure/has-unsafe 2 'unsafe-fl->fx)] [fl/ (known-procedure -2)] [fl< (known-procedure -2)] [fl<= (known-procedure -2)] @@ -40,7 +40,7 @@ [fx* (known-procedure -1)] [fx+ (known-procedure -1)] [fx- (known-procedure -2)] - [fx->fl (known-procedure 2)] + [fx->fl (known-procedure/has-unsafe 2 'unsafe-fx->fl)] [fx< (known-procedure -2)] [fx<= (known-procedure -2)] [fx= (known-procedure -2)] diff --git a/racket/src/cs/primitive/kernel.ss b/racket/src/cs/primitive/kernel.ss index e4c621849d..0e7c7a016e 100644 --- a/racket/src/cs/primitive/kernel.ss +++ b/racket/src/cs/primitive/kernel.ss @@ -42,7 +42,7 @@ [bitwise-xor (known-procedure -1)] [boolean? (known-procedure/pure 2)] [box (known-procedure/pure 2)] - [box-cas! (known-procedure 8)] + [box-cas! (known-procedure/has-unsafe 8 'unsafe-box*-cas!)] [box-immutable (known-procedure/pure 2)] [box? (known-procedure/pure 2)] [break-enabled (known-procedure 3)] @@ -71,10 +71,10 @@ [bytes-copy (known-procedure 2)] [bytes-copy! (known-procedure 56)] [bytes-fill! (known-procedure 4)] - [bytes-length (known-procedure 2)] + [bytes-length (known-procedure/has-unsafe 2 'unsafe-bytes-length)] [bytes-open-converter (known-procedure 4)] - [bytes-ref (known-procedure 4)] - [bytes-set! (known-procedure 8)] + [bytes-ref (known-procedure/has-unsafe 4 'unsafe-bytes-ref)] + [bytes-set! (known-procedure/has-unsafe 8 'unsafe-bytes-set!)] [bytes-utf-8-index (known-procedure 28)] [bytes-utf-8-length (known-procedure 30)] [bytes-utf-8-ref (known-procedure 28)] @@ -755,7 +755,7 @@ [semaphore-wait/enable-break (known-procedure 2)] [semaphore? (known-procedure/pure 2)] [set-box! (known-procedure 4)] - [set-box*! (known-procedure 4)] + [set-box*! (known-procedure/has-unsafe 4 'unsafe-set-box*!)] [set-mcar! (known-procedure 4)] [set-mcdr! (known-procedure 4)] [set-phantom-bytes! (known-procedure 4)] @@ -930,7 +930,7 @@ [true-object? (known-procedure/pure 2)] [truncate (known-procedure 2)] [unbox (known-procedure 2)] - [unbox* (known-procedure 2)] + [unbox* (known-procedure/has-unsafe 2 'unsafe-unbox*)] [uncaught-exception-handler (known-constant)] [unquoted-printing-string (known-procedure 2)] [unquoted-printing-string-value (known-procedure 2)] @@ -942,7 +942,7 @@ [vector->pseudo-random-generator (known-procedure 2)] [vector->pseudo-random-generator! (known-procedure 4)] [vector->values (known-procedure 14)] - [vector-cas! (known-procedure 16)] + [vector-cas! (known-procedure/has-unsafe 16 'unsafe-vector*-cas!)] [vector-copy! (known-procedure 56)] [vector-fill! (known-procedure 4)] [vector-immutable (known-procedure/pure -1)] @@ -951,9 +951,9 @@ [vector-set! (known-procedure 8)] [vector-set-performance-stats! (known-procedure 6)] [vector? (known-procedure/pure 2)] - [vector*-length (known-procedure 2)] - [vector*-ref (known-procedure 4)] - [vector*-set! (known-procedure 8)] + [vector*-length (known-procedure/has-unsafe 2 'unsafe-vector*-length)] + [vector*-ref (known-procedure/has-unsafe 4 'unsafe-vector*-ref)] + [vector*-set! (known-procedure/has-unsafe 8 'unsafe-vector*-set!)] [version (known-procedure/pure 1)] [void (known-procedure/pure -1)] [void? (known-procedure/pure 2)] diff --git a/racket/src/schemify/known.rkt b/racket/src/schemify/known.rkt index f18386c5ab..d6f570cf45 100644 --- a/racket/src/schemify/known.rkt +++ b/racket/src/schemify/known.rkt @@ -13,6 +13,7 @@ known-procedure/can-inline/need-imports-needed known-procedure/succeeds known-procedure/succeeds? known-procedure/pure known-procedure/pure? + known-procedure/has-unsafe known-procedure/has-unsafe? known-procedure/has-unsafe-alternate known-struct-type known-struct-type? known-struct-type-type known-struct-type-field-count known-struct-type-pure-constructor? known-constructor known-constructor? known-constructor-type @@ -57,6 +58,10 @@ ;; procedure that accepts any arguments and is functional so that it can be reordered (struct known-procedure/pure () #:prefab #:omit-define-syntaxes #:super struct:known-procedure/succeeds) +;; procedure with an unsafe variant, especially ones that won't get substituted +;; simply by compiling in unsafe mode +(struct known-procedure/has-unsafe (alternate) #:prefab #:omit-define-syntaxes #:super struct:known-procedure) + (struct known-struct-type (type field-count pure-constructor?) #:prefab #:omit-define-syntaxes #:super struct:known-consistent) ;; procedures with a known connection to a structure type: diff --git a/racket/src/schemify/schemify.rkt b/racket/src/schemify/schemify.rkt index 687a0994cd..f4561de5c2 100644 --- a/racket/src/schemify/schemify.rkt +++ b/racket/src/schemify/schemify.rkt @@ -758,6 +758,12 @@ (known-field-mutator? k) (inline-field-mutate k s-rator im args)) => (lambda (e) e)] + [(and unsafe-mode? + (known-procedure/has-unsafe? k)) + (left-to-right/app (known-procedure/has-unsafe-alternate k) + args + #t for-cify? + prim-knowns knowns imports mutated)] [else (define plain-app? (or (known-procedure? k) (lambda? rator)))