From 30a88b59096186f662fc760044f8f45eebc30479 Mon Sep 17 00:00:00 2001
From: Eric Dobson <eric.n.dobson@gmail.com>
Date: Thu, 19 Dec 2013 09:19:28 -0800
Subject: [PATCH] Remove unsound optimizations.

original commit: 895fd4b917defcd2a467ebfb5354a46995914521
---
 .../static-contracts/optimize.rkt             | 14 ++++----
 .../static-contract-optimizer-tests.rkt       | 33 +++++++++----------
 2 files changed, 24 insertions(+), 23 deletions(-)

diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/optimize.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/optimize.rkt
index c0f85ea1..88d27850 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/optimize.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/optimize.rkt
@@ -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]
diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/static-contract-optimizer-tests.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/static-contract-optimizer-tests.rkt
index 267a977f..0047d3c9 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/static-contract-optimizer-tests.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/static-contract-optimizer-tests.rkt
@@ -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))