From 3def8438c14cd9a88c303db64e96a6945f23ffe4 Mon Sep 17 00:00:00 2001
From: Eric Dobson <eric.n.dobson@gmail.com>
Date: Thu, 14 Nov 2013 22:02:54 -0800
Subject: [PATCH] Minor cleanup in prims.

original commit: ee47fe5f259d254fbd47d2a11f6a972342de3f5b
---
 .../typed-racket/base-env/prims.rkt                 | 13 ++++++++-----
 1 file changed, 8 insertions(+), 5 deletions(-)

diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/prims.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/prims.rkt
index f9d2415d..75f7f1fa 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/prims.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/prims.rkt
@@ -89,6 +89,10 @@ This file defines two sorts of primitives. All of them are provided into any mod
                 [typed-racket/private/type-contract (type->contract type->contract-fail)]
                 [typed-racket/env/type-name-env (register-type-name)]))
 
+(define-for-syntax (with-type* expr ty)
+  (with-type #`(ann #,expr #,ty)))
+
+
 (begin-for-syntax
   (define-syntax-class opt-parent
     #:attributes (nm parent)
@@ -278,7 +282,7 @@ This file defines two sorts of primitives. All of them are provided into any mod
        #`(#%expression
            (ann
              #,(ignore-some
-                 #`(let-values (((val) #,(with-type #'(ann v Any))))
+                 #`(let-values (((val) #,(with-type* #'v #'Any)))
                      (contract
                        #,ctc-expr
                        val
@@ -503,10 +507,9 @@ This file defines two sorts of primitives. All of them are provided into any mod
     [(_ ([pred? action] ...) . body)
      (with-syntax ([(pred?* ...)
                     (for/list ([s (in-syntax #'(pred? ...))])
-                      (with-type #`(ann #,s : (Any -> Any))))]
+                      (with-type* s #'(Any -> Any)))]
                    [(action* ...)
-                    (for/list ([s (in-syntax #'(action ...))])
-                      (exn-handler s))]
+                    (stx-map exn-handler #'(action ...))]
                    [body* (exn-body #'(let-values () . body))])
        (exn-handlers #'(with-handlers ([pred?* action*] ...) body*)))]))
 
@@ -524,7 +527,7 @@ This file defines two sorts of primitives. All of them are provided into any mod
   (syntax-parse stx #:literals (:)
     [(_ nm ((~describe "field specification" [fld:optionally-annotated-name]) ...) [proc : proc-ty])
      (with-syntax*
-      ([proc* (with-type #'(ann proc : proc-ty))]
+      ([proc* (with-type* #'proc #'proc-ty)]
        [d-s (ignore-some (syntax/loc stx (define-struct nm (fld.name ...)
                                       #:property prop:procedure proc*)))]
        [dtsi (quasisyntax/loc stx (dtsi/exec* () nm (fld ...) proc-ty))])