Added with-asserts, from code from Neil Toronto.

original commit: ea472a9d57b7344e9111bd37663fd7ad0884f0d5

collects/tests/typed-scheme/fail/with-asserts.rkt

@@ -0,0 +1,7 @@
+#;
+(exn-pred exn:fail?)
+#lang typed/racket
+
+(let ([x 1] [y "2"])
+  (with-asserts ([x string?] [y integer?])
+                x))

collects/tests/typed-scheme/fail/with-asserts2.rkt

@@ -0,0 +1,7 @@
+#;
+(exn-pred exn:fail?)
+#lang typed/racket
+
+(let ([x 1] [y "2"])
+  (with-asserts ([x string?])
+                x))

collects/tests/typed-scheme/fail/with-asserts3.rkt

@@ -0,0 +1,7 @@
+#;
+(exn-pred exn:fail?)
+#lang typed/racket
+
+(let ([x #f])
+  (with-asserts ([x])
+                x))

collects/tests/typed-scheme/succeed/with-asserts.rkt

@@ -0,0 +1,20 @@
+#lang typed/racket
+
+(let ([x 1] [y "2"])
+  (with-asserts ([x integer?] [y string?])
+                x))
+(let ([x 1] [y "2"])
+  (with-asserts ([x integer?])
+                x))
+(let ([x 1] [y "2"])
+  (with-asserts ()
+                x))
+(let ([x 1] [y "2"])
+  (with-asserts ([x])
+                x))
+
+(: f : (U Integer String) -> Integer)
+(define (f x)
+  (with-asserts ([x integer?])
+                x))
+(f 1)

collects/typed-scheme/private/prims.rkt

@@ -624,3 +624,22 @@ This file defines two sorts of primitives. All of them are provided into any mod
        [(_ (~var k (param-annotated-name (lambda (s) #`(#,s -> (U))))) . body)
 	(quasisyntax/loc stx (#,l/c k.ann-name . body))]))
     (values (mk #'let/cc) (mk #'let/ec))))
+
+(define-syntax (with-asserts stx)
+  (define-syntax-class with-asserts-clause
+    [pattern [x:id]
+             #:with cond-clause
+             (syntax/loc #'x
+               [(not x)
+                (error "Assertion failed")])]
+    [pattern [x:id pred]
+             #:with cond-clause
+             (syntax/loc #'x
+               [(not (pred x))
+                (error "Assertion failed")])])
+   (syntax-parse stx
+     [(_ (c:with-asserts-clause ...) body:expr ...+)
+      (syntax/loc stx
+        (cond c.cond-clause
+              ...
+              [else body ...]))]))