From 09ecd240d1569eb8f3c944ae5cbd042066b0db5f Mon Sep 17 00:00:00 2001
From: Eric Dobson <eric.n.dobson@gmail.com>
Date: Sun, 26 May 2013 19:47:50 -0700
Subject: [PATCH] Remove #%expression in plambda.

original commit: 379e827070cbfe72c8d099c246e590fb42140257
---
 .../typed-racket/base-env/case-lambda.rkt        |  8 +++-----
 .../typed-racket/base-env/prims.rkt              | 16 ++++++----------
 .../typecheck/tc-app/tc-app-lambda.rkt           | 16 +++++++++-------
 3 files changed, 18 insertions(+), 22 deletions(-)

diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/case-lambda.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/case-lambda.rkt
index a7296b54..a34f7311 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/case-lambda.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/case-lambda.rkt
@@ -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 ...))]))
 
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 12dd634a..f20acd68 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
@@ -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 (:)
diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-lambda.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-lambda.rkt
index 101803ca..958c35d2 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-lambda.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-lambda.rkt
@@ -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