From 4338551c6c47762d57964bcca4d3816c8be55f9a Mon Sep 17 00:00:00 2001 From: Asumu Takikawa Date: Fri, 31 Jan 2014 00:25:30 -0500 Subject: [PATCH] Allow TR `lambda` to have a result type annotation original commit: 7e09362986ea09bcfd68894c83331ecc0ca7cee4 --- .../typed-racket/base-env/prims.rkt | 13 +++++++++++-- .../typed-racket/unit-tests/typecheck-tests.rkt | 12 ++++++++++++ 2 files changed, 23 insertions(+), 2 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 d2cd4631..c9bdc5bc 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 @@ -1193,8 +1193,17 @@ This file defines two sorts of primitives. All of them are provided into any mod ;; annotation to help tc-expr pick out keyword functions (define-syntax (-lambda stx) (syntax-parse stx - [(_ formals:lambda-formals . body) - (define d (syntax/loc stx (λ formals.erased . body))) + #:literals (:) + [(_ formals:lambda-formals (~optional (~seq : return-type:expr)) + e ... last-e) + ;; Annotate the last expression with the return type. Should be correct + ;; since if a function returns, it has to do so through the last expression + ;; even with continuations. + (define/with-syntax last-e* + (if (attribute return-type) + #`(ann last-e #,(attribute return-type)) + #'last-e)) + (define d (syntax/loc stx (λ formals.erased e ... last-e*))) (if (attribute formals.kw-property) (kw-lambda-property d (attribute formals.kw-property)) (opt-lambda-property d (attribute formals.opt-property)))])) diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt index 23e848a6..b8e72e30 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt @@ -2065,8 +2065,14 @@ ;; FIXME: support rest args [tc-e (tr:lambda (x [y : String]) (string-append y "b")) #:ret (ret (t:-> Univ -String -String) (-FS -top -bot))] + [tc-e (tr:lambda (x [y : String]) : String (string-append y "b")) + #:ret (ret (t:-> Univ -String -String) (-FS -top -bot))] [tc-e (tr:lambda (x z [y : String]) (string-append y "b")) #:ret (ret (t:-> Univ Univ -String -String) (-FS -top -bot))] + [tc-e (tr:lambda (x z [y : String]) : String (string-append y "b")) + #:ret (ret (t:-> Univ Univ -String -String) (-FS -top -bot))] + [tc-err (tr:lambda (x [y : String]) : Symbol (string-append y "b")) + #:msg "expected: Symbol.*given: String"] [tc-err (tr:lambda (x [y : String "a"] z) (string-append y "b")) #:msg "expected optional lambda argument"] #| FIXME: requires improvement in opt-lambda checker @@ -2075,8 +2081,12 @@ |# [tc-e (tr:lambda (x #:y [y : String]) (string-append y "b")) (->key Univ #:y -String #t -String)] + [tc-e (tr:lambda (x #:y [y : String]) : String (string-append y "b")) + (->key Univ #:y -String #t -String)] [tc-e (tr:lambda (x #:y [y : String "a"]) (string-append y "b")) (->key Univ #:y -String #f -String)] + [tc-e (tr:lambda (x #:y [y : String "a"]) : String (string-append y "b")) + (->key Univ #:y -String #f -String)] [tc-e (tr:lambda (x #:y [y : String] [z "z"]) (string-append y "b")) (->optkey Univ [Univ] #:y -String #t -String)] [tc-e (tr:lambda (x #:y [y : String "a"] [z "z"]) (string-append y "b")) @@ -2085,6 +2095,8 @@ (->optkey Univ [Univ] #:y -String #t -String)] [tc-e (tr:lambda (x [z "z"] #:y [y : String "a"]) (string-append y "b")) (->optkey Univ [Univ] #:y -String #f -String)] + [tc-e (tr:lambda (x [z "z"] #:y [y : String "a"]) : String (string-append y "b")) + (->optkey Univ [Univ] #:y -String #f -String)] [tc-e (tr:lambda (x #:y [y : String] [z : String "z"]) (string-append y z)) (->optkey Univ [-String] #:y -String #t -String)] [tc-e (tr:lambda (x #:y [y : String "y"] [z : String "z"]) (string-append y z))