Remove unsound optimizations.

original commit: 895fd4b917defcd2a467ebfb5354a46995914521
This commit is contained in:
Eric Dobson 2013-12-19 09:19:28 -08:00
parent 0409288195
commit 30a88b5909
2 changed files with 24 additions and 23 deletions

View File

@ -23,14 +23,16 @@
;; none/sc cases
[(listof/sc: (none/sc:)) empty-list/sc]
[(list/sc: sc1 ... (none/sc:) sc2 ...) none/sc]
[(vectorof/sc: (none/sc:)) empty-vector/sc]
[(vector/sc: sc1 ... (none/sc:) sc2 ...) none/sc]
[(set/sc: (none/sc:)) empty-set/sc]
[(box/sc: (none/sc:)) none/sc]
[(syntax/sc: (none/sc:)) none/sc]
[(promise/sc: (none/sc:)) none/sc]
[(hash/sc: (none/sc:) value/sc) empty-hash/sc]
[(hash/sc: key/sc (none/sc:)) empty-hash/sc]
;; The following are unsound because chaperones allow operations on these data structures to
;; can call continuations and thus be useful even if they cannot return values.
;[(vectorof/sc: (none/sc:)) empty-vector/sc]
;[(vector/sc: sc1 ... (none/sc:) sc2 ...) none/sc]
;[(box/sc: (none/sc:)) none/sc]
;[(promise/sc: (none/sc:)) none/sc]
;[(hash/sc: (none/sc:) value/sc) empty-hash/sc]
;[(hash/sc: key/sc (none/sc:)) empty-hash/sc]
;; any/sc cases
[(listof/sc: (any/sc:)) list?/sc]

View File

@ -11,12 +11,11 @@
(define-syntax (check-optimize stx)
(syntax-parse stx
[(_ argument* #:pos positive-expected* #:neg negative-expected*)
#'(test-case (~a 'argument*)
(let ([argument argument*]
[positive-expected positive-expected*]
[negative-expected negative-expected*])
(check-optimize-helper argument positive-expected #t #f)
(check-optimize-helper argument negative-expected #f #t)))]))
#'(test-suite (~a 'argument*)
(test-case "Trusted Positive"
(check-optimize-helper argument* positive-expected* #t #f))
(test-case "Trusted Negative"
(check-optimize-helper argument* negative-expected* #f #t)))]))
(define (check-optimize-helper argument expected trusted-positive trusted-negative)
(define trusted-side
@ -75,8 +74,8 @@
#:pos any/sc
#:neg vector?/sc)
(check-optimize (vectorof/sc none/sc)
#:pos any/sc
#:neg empty-vector/sc)
#:pos (vectorof/sc none/sc)
#:neg (vectorof/sc none/sc))
;; Heterogeneous Vectors
;; TODO fix ability to test equality here
@ -85,8 +84,8 @@
#:pos any/sc
#:neg (vector-length/sc 1))
(check-optimize (vector/sc none/sc)
#:pos any/sc
#:neg none/sc)
#:pos (vector/sc none/sc)
#:neg (vector/sc none/sc))
;; TODO fix ability to test equality here
#;
(check-optimize (vector/sc)
@ -101,11 +100,11 @@
#:pos any/sc
#:neg hash?/sc)
(check-optimize (hash/sc none/sc any/sc)
#:pos any/sc
#:neg empty-hash/sc)
#:pos (hash/sc none/sc any/sc)
#:neg (hash/sc none/sc any/sc))
(check-optimize (hash/sc any/sc none/sc)
#:pos any/sc
#:neg empty-hash/sc)
#:pos (hash/sc any/sc none/sc)
#:neg (hash/sc any/sc none/sc))
;; And
(check-optimize (and/sc set?/sc)
@ -152,8 +151,8 @@
#:pos any/sc
#:neg box?/sc)
(check-optimize (box/sc none/sc)
#:pos any/sc
#:neg none/sc)
#:pos (box/sc none/sc)
#:neg (box/sc none/sc))
(check-optimize (box/sc set?/sc)
#:pos (box/sc set?/sc)
#:neg (box/sc set?/sc))
@ -175,7 +174,7 @@
#:neg promise?/sc)
(check-optimize (promise/sc none/sc)
#:pos any/sc
#:neg none/sc)
#:neg (promise/sc none/sc))
(check-optimize (promise/sc set?/sc)
#:pos any/sc
#:neg (promise/sc set?/sc))