Add a :-less do for TR

pkgs/typed-racket-pkgs/typed-racket-compatibility/typed/scheme/base.rkt

@@ -4,7 +4,7 @@
                          with-handlers default-continuation-prompt-tag
                          define λ lambda define-struct for for*
                          let let* let-values letrec letrec-values
-                         let/cc let/ec))
+                         let/cc let/ec do))
 	   (basics #%module-begin #%top-interaction))
 
 (require typed-racket/base-env/extra-procs

pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/prims.rkt

@@ -48,6 +48,8 @@ This file defines two sorts of primitives. All of them are provided into any mod
                      [-letrec-values letrec-values:]
                      [-let/cc let/cc:]
                      [-let/ec let/ec:]
+                     [-do do]
+                     [-do do:]
                      [with-handlers: with-handlers]
                      [define-typed-struct/exec define-struct/exec:]
                      [for/annotation for]
@@ -780,20 +782,21 @@ This file defines two sorts of primitives. All of them are provided into any mod
 
   (values (rts #t) (rts #f))))
 
-(define-syntax (do: stx)
+(define-syntax (-do stx)
   (syntax-parse stx #:literals (:)
-    [(_ : ty
+    [(_ (~optional (~seq : ty) #:defaults ([ty #f]))
         ((var:optionally-annotated-name rest ...) ...)
         (stop?:expr ret ...)
         c:expr ...)
-     (quasisyntax/loc
-         stx
-       (ann #,(syntax/loc
-                  stx
-                (do ((var.ann-name rest ...) ...)
-                    (stop? ret ...)
-                  c ...))
-            ty))]))
+     (define do-stx
+       (syntax/loc stx
+         (do ((var.ann-name rest ...) ...)
+             (stop? ret ...)
+           c ...)))
+     (if (attribute ty)
+         (quasisyntax/loc stx
+           (ann #,do-stx #,(attribute ty)))
+         do-stx)]))
 
 ;; wrap the original for with a type annotation
 (define-syntax (for/annotation stx)

pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/with-types.rkt

@@ -4,7 +4,7 @@
          (for-template
           (except-in racket/base for for* with-handlers lambda λ define
                      let let* letrec letrec-values let-values
-                     let/cc let/ec
+                     let/cc let/ec do
                      default-continuation-prompt-tag)
           "../base-env/prims.rkt"
           (prefix-in c: (combine-in racket/contract/region racket/contract/base)))

pkgs/typed-racket-pkgs/typed-racket-lib/typed/racket/base.rkt

@@ -4,7 +4,7 @@
                          with-handlers default-continuation-prompt-tag
                          define λ lambda define-struct for for*
                          let let* let-values letrec letrec-values
-                         let/cc let/ec))
+                         let/cc let/ec do))
            (basics #%module-begin #%top-interaction))
 
 (require typed-racket/base-env/extra-procs

pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt

@@ -2191,6 +2191,11 @@
        [tc-e (let/ec k "foo") -String]
        [tc-e (let/cc k : String (k "foo")) -String]
        [tc-e (let/ec k : String (k "foo")) -String]
+       [tc-e (ann (do ([x : Integer 0 (add1 x)]) ((> x 10) x) (displayln x))
+                  Integer)
+             #:ret (ret -Integer (make-NoFilter) (make-NoObject))]
+       [tc-e (do : Integer ([x : Integer 0 (add1 x)]) ((> x 10) x) (displayln x))
+             #:ret (ret -Integer (make-NoFilter) (make-NoObject))]
         )
   (test-suite
    "tc-literal tests"