From 1ffcf1763a5014b9c6dbae578a446d8e41269937 Mon Sep 17 00:00:00 2001
From: AlexKnauth <alexander@knauth.org>
Date: Fri, 3 Jun 2016 16:53:00 -0400
Subject: [PATCH] use ~Any/bvs in type-constructor pattern expanders

---
 tapl/typecheck.rkt | 25 +++++++++++++++----------
 1 file changed, 15 insertions(+), 10 deletions(-)

diff --git a/tapl/typecheck.rkt b/tapl/typecheck.rkt
index c1db34d..3cf8738 100644
--- a/tapl/typecheck.rkt
+++ b/tapl/typecheck.rkt
@@ -552,9 +552,9 @@
                  #:with tycon-expander (format-id #'tycon "~~~a" #'tycon)
                  #'(~and expanded-τ
                          (~parse
-                          ((~literal #%plain-app) (~literal τ-internal)
-                           ((~literal #%plain-lambda) (~and bvs (tv (... (... ...)))) 
-                            skipped-extra-info . rst))
+                          (~Any/bvs (~literal τ-internal)
+                                    (~and bvs (tv (... (... ...))))
+                                    . rst)
                           #'expanded-τ)
                          #,(if (attribute has-bvs?)
                                (if (attribute has-annotations?)
@@ -565,9 +565,9 @@
                 ;; TODO: fix this to handle has-annotations?
                 [(_ (~optional (~and (~fail #:unless #,(attribute has-bvs?)) bvs-pat)
                                #:defaults ([bvs-pat #'()])) . pat)
-                 #'((~literal #%plain-app) (~literal τ-internal)
-                    ((~literal #%plain-lambda) bvs-pat 
-                     skipped-extra-info . pat))])))
+                 #'(~Any/bvs (~literal τ-internal)
+                             bvs-pat
+                             . pat)])))
            (define-syntax τ-expander*
              (pattern-expander
               (syntax-parser
@@ -724,13 +724,18 @@
 
 ; substitution
 (begin-for-syntax
-  (define-syntax ~Any ; matches any tycon
+  (define-syntax ~Any/bvs ; matches any tycon
+    (pattern-expander
+     (syntax-parser
+       [(_ tycons bvs . rst)
+        #'((~literal #%plain-app) tycons
+            ((~literal #%plain-lambda) bvs 
+             skipped-extra-info . rst))])))
+  (define-syntax ~Any
     (pattern-expander
      (syntax-parser
        [(_ tycons x ...)
-        #'((~literal #%plain-app) tycons
-            ((~literal #%plain-lambda) bvs 
-             skipped-extra-info x ...))])))
+        #'(~Any/bvs tycons _ x ...)])))
   (define (merge-type-tags stx)
     (define t (syntax-property stx 'type))
     (or (and (pair? t)