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

use ~Any/bvs in type-constructor pattern expanders

Browse Source
This commit is contained in:
AlexKnauth 2016-06-03 16:53:00 -04:00
parent 9a07b46555
commit 1ffcf1763a
1 changed files with 15 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
tapl/typecheck.rkt
View File

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