From e0403713c6502d3267b868601a311999ff12c486 Mon Sep 17 00:00:00 2001
From: Eric Dobson <eric.n.dobson@gmail.com>
Date: Thu, 20 Mar 2014 10:12:04 -0700
Subject: [PATCH] Simplify typechecking of extend-parameterization.

original commit: ca867bc97f3cca1381d331f30cb14f3b9555ffdf
---
 .../typecheck/tc-app/tc-app-special.rkt       | 26 +++++++++----------
 1 file changed, 12 insertions(+), 14 deletions(-)

diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-special.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-special.rkt
index d6f515ff..0ab5caa6 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-special.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-special.rkt
@@ -5,6 +5,7 @@
          "utils.rkt"
          syntax/parse racket/match
          unstable/list syntax/stx
+         unstable/sequence
          (typecheck signatures tc-funapp)
          (types abbrev utils)
          (private type-annotation)
@@ -23,20 +24,17 @@
 (define-tc/app-syntax-class (tc/app-special expected)
   #:literal-sets (kernel-literals special-literals)
   ;; parameterize
-  (pattern (extend-parameterization pmz args ...)
-    (let loop ([args (syntax->list #'(args ...))])
-      (if (null? args) (ret Univ)
-          (let* ([p (car args)]
-                 [pt (single-value p)]
-                 [v (cadr args)])
-            (match pt
-              [(tc-result1: (Param: a b))
-               (tc-expr/check v (ret a))
-               (loop (cddr args))]
-              [(tc-result1: t)
-               (single-value v)
-               (tc-error/expr #:return (or expected (ret Univ)) "expected Parameter, but got ~a" t)
-               (loop (cddr args))])))))
+  (pattern (extend-parameterization pmz (~seq params args) ...)
+    (begin
+      (for ([param (in-syntax #'(params ...))]
+            [arg (in-syntax #'(args ...))])
+        (match (single-value param)
+          [(tc-result1: (Param: a b))
+           (tc-expr/check arg (ret a))]
+          [(tc-result1: t)
+           (single-value arg)
+           (tc-error/delayed "expected Parameter, but got ~a" t)]))
+      (ret Univ)))
   ;; use the additional but normally ignored first argument to make-sequence
   ;; to provide a better instantiation
   (pattern ((~var op (id-from 'make-sequence 'racket/private/for))