suzanne.soy/typed-racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Allow TR lambda to have a result type annotation

Browse Source 
original commit: 7e09362986ea09bcfd68894c83331ecc0ca7cee4
This commit is contained in:
Asumu Takikawa 2014-01-31 00:25:30 -05:00
parent 91b02494df
commit 4338551c6c
2 changed files with 23 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/prims.rkt
View File

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

12
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt
View File

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