Don't generate rest specification for ->* when not needed.

original commit: aa6ed4d736b2e4486c82a4a1ed4ac7b1f9296a3e
This commit is contained in:
Sam Tobin-Hochstadt 2012-08-10 10:27:18 -04:00
parent da8782fb09
commit 1d6678c2ad

View File

@ -88,20 +88,21 @@
(and rst (t->c/neg rst)))
(exit (fail)))]
[_ (exit (fail))]))
(with-syntax
(with-syntax*
([(dom* ...) (if method? (cons #'any/c dom*) dom*)]
[(opt-dom* ...) opt-dom*]
[rng* (match rngs*
[(list r) r]
[_ #`(values #,@rngs*)])]
[rst* rst])
[rst* rst]
[(rst-spec ...) (if rst #'(#:rest (listof rst*)) #'())])
;; Garr, I hate case->!
(if (and (pair? (syntax-e #'(opt-dom* ...))) case->)
(exit (fail))
(if (or rst (pair? (syntax-e #'(opt-dom* ...))))
(if case->
#'(dom* ... #:rest (listof rst*) . -> . rng*)
#'((dom* ...) (opt-dom* ...) #:rest (listof rst*) . ->* . rng*))
#'(dom* ... rst-spec ... . -> . rng*)
#'((dom* ...) (opt-dom* ...) rst-spec ... . ->* . rng*))
#'(dom* ... . -> . rng*)))))
(unless (no-duplicates (for/list ([t arrs])
(match t