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))])