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

schmify: add some unsafe conversions

Browse Source 
Explicitly substitute unsafe some non-primitives, which won't be
automatically substitued in Chez Scheme by compiling in unsafe mode.
This commit is contained in:
Matthew Flatt 2019-01-14 18:38:46 -07:00
parent 94a4f6d703
commit 95367b4b52
4 changed files with 23 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
racket/src/cs/primitive/flfxnum.ss
View File

@ -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)]

20
racket/src/cs/primitive/kernel.ss
View File

@ -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)]

5
racket/src/schemify/known.rkt
View File

@ -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:

6
racket/src/schemify/schemify.rkt
View File

@ -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)))