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

Remove #%expression in plambda.

Browse Source 
original commit: 379e827070cbfe72c8d099c246e590fb42140257
This commit is contained in:
Eric Dobson 2013-05-26 19:47:50 -07:00
parent 0fa0d624cf
commit 09ecd240d1
3 changed files with 18 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/case-lambda.rkt
View File

@ -38,9 +38,7 @@
(define-syntax (pcase-lambda: stx)
(syntax-parse stx
[(pcase-lambda: tvars:type-variables cl ...)
(quasisyntax/loc stx
(#%expression
#,(plambda-property
(syntax/loc stx (-case-lambda cl ...))
#'(tvars.vars ...))))]))
(plambda-property
(syntax/loc stx (-case-lambda cl ...))
#'(tvars.vars ...))]))

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

@ -389,20 +389,16 @@ This file defines two sorts of primitives. All of them are provided into any mod
(define-syntax (plambda: stx)
(syntax-parse stx
[(plambda: tvars:type-variables formals . body)
(quasisyntax/loc stx
(#%expression
#,(plambda-property
(syntax/loc stx (lambda: formals . body))
#'(tvars.vars ...))))]))
(plambda-property
(syntax/loc stx (lambda: formals . body))
#'(tvars.vars ...)) ]))
(define-syntax (popt-lambda: stx)
(syntax-parse stx
[(popt-lambda: tvars:type-variables formals . body)
(quasisyntax/loc stx
(#%expression
#,(plambda-property
(syntax/loc stx (opt-lambda: formals . body))
#'(tvars.vars ...))))]))
(plambda-property
(syntax/loc stx (opt-lambda: formals . body))
#'(tvars.vars ...))]))
(define-syntax (pdefine: stx)
(syntax-parse stx #:literals (:)

16
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-lambda.rkt
View File

@ -8,7 +8,7 @@
unstable/sequence unstable/syntax
(typecheck signatures find-annotation)
(types abbrev utils generalize type-table)
(private type-annotation)
(private type-annotation syntax-properties)
;; Needed to construct args to tc/let-values
(for-template racket/base)
(for-label racket/base))
@ -30,15 +30,17 @@
#:when (free-identifier=? #'lp #'lp*)
(let-loop-check #'lam #'lp #'actuals #'(args ...) #'body expected))
;; inference for ((lambda
(pattern ((#%plain-lambda (x ...) . body) args ...)
#:when (= (syntax-length #'(x ...))
(syntax-length #'(args ...)))
(pattern ((~and lam (#%plain-lambda (x ...) . body)) args ...)
#:fail-when (plambda-property #'lam) #f
#:fail-unless (= (syntax-length #'(x ...))
(syntax-length #'(args ...))) #f
#:fail-when (andmap type-annotation (syntax->list #'(x ...))) #f
(tc/let-values #'((x) ...) #'(args ...) #'body expected))
;; inference for ((lambda with dotted rest
(pattern ((#%plain-lambda (x ... . rst:id) . body) args ...)
#:when (<= (syntax-length #'(x ...))
(syntax-length #'(args ...)))
(pattern ((~and lam (#%plain-lambda (x ... . rst:id) . body)) args ...)
#:fail-when (plambda-property #'lam) #f
#:fail-unless (<= (syntax-length #'(x ...))
(syntax-length #'(args ...))) #f
;; FIXME - remove this restriction - doesn't work because the annotation
;; on rst is not a normal annotation, may have * or ...
#:fail-when (type-annotation #'rst) #f