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

Cleanup kw/opt lambda annotations.

Browse Source
This commit is contained in:
Eric Dobson 2013-02-23 09:27:34 -08:00
parent 74c3c130f0
commit 9f01d26f98
2 changed files with 17 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1051,7 +1051,18 @@ This file defines two sorts of primitives. All of them are provided into any mod
[(_ formals . body)
(define d (datum->syntax stx `(,#'λ ,#'formals . ,#'body)
stx stx))
(syntax-property d 'kw-lambda #t)]))
(define-values (has-kw? has-opt?)
(syntax-parse #'formals
((~or (~and rest:id (~bind ((args 1) null)))
(args ...)
(args ...+ . rest:id))
(define arg-list (syntax->list #'(args ...)))
(values
(ormap keyword? (map syntax-e arg-list))
(ormap syntax->list arg-list)))))
(syntax-property
(syntax-property d 'kw-lambda has-kw?)
'opt-lambda has-opt?)]))
;; do this ourselves so that we don't get the static bindings,
;; which are harder to typecheck

10
collects/typed-racket/typecheck/tc-expr-unit.rkt
View File

@ -376,15 +376,15 @@
(let-values (((_) (~and find-app (#%plain-app find-method/who _ _ _))))
(#%plain-app _ _ args ...))))
(tc/send #'find-app #'rcvr #'meth #'(args ...) expected)]
;; kw function def
;; kw/opt function def
[(let-values ([(_) fun])
. body)
#:when (syntax-property form 'kw-lambda)
#:when (or (syntax-property form 'kw-lambda)
(syntax-property form 'opt-lambda))
(match expected
[(tc-result1: (and f (Function: _)))
[(tc-result1: (and f (or (Function: _)
(Poly: _ (Function: _)))))
(tc-expr/check/type #'fun (kw-convert f #:split #t))]
[(tc-result1: (Poly-names: names (and f (Function: _))))
(tc-expr/check/type #'fun (make-Poly names (kw-convert f #:split #t)))]
[(tc-result1: _) (tc-error/expr "Keyword functions must have function type, given ~a" expected)])
expected]
;; let