From bf64d93c64654f0b9aa0e923e997fca9b44212a6 Mon Sep 17 00:00:00 2001
From: Casey Klein <clklein@racket-lang.org>
Date: Thu, 3 Dec 2009 03:51:41 +0000
Subject: [PATCH] Fixed a case where `term' raised an exception without a
 source location.

svn: r17172
---
 collects/redex/private/term-test.ss | 29 +++++++++++++++++++++++++++++
 collects/redex/private/term.ss      | 10 +++++-----
 2 files changed, 34 insertions(+), 5 deletions(-)

diff --git a/collects/redex/private/term-test.ss b/collects/redex/private/term-test.ss
index fa35933612..6d271f4eaf 100644
--- a/collects/redex/private/term-test.ss
+++ b/collects/redex/private/term-test.ss
@@ -136,6 +136,35 @@
       src)
      src))
   
+  (let ([src 'ellipsis-args])
+    (test
+     (runtime-error-source 
+      '(term-let-fn ((f car))
+                    (term-let ([(x ...) '(a b)]
+                               [(y ...) '(c d e)])
+                              (term (f ((x y) ...)))))
+      src)
+     src))
+  
+  (let ([src 'ellipsis-args/map])
+    (test
+     (runtime-error-source 
+      '(term-let-fn ((f car))
+                    (term-let ([(x ...) '(a b)]
+                               [(y ...) '(c d e)])
+                              (term ((f (x y)) ...))))
+      src)
+     src))
+  
+  (let ([src 'ellipsis-args/in-hole])
+    (test
+     (runtime-error-source 
+      '(term-let ([(x ...) '(a b)]
+                  [(y ...) '(c d e)])
+                 (term ((in-hole hole (x y)) ...)))
+      src)
+     src))
+  
   (let ([src 'term-let-rhs])
     (test
      (runtime-error-source
diff --git a/collects/redex/private/term.ss b/collects/redex/private/term.ss
index 04c0f32927..bda4c28747 100644
--- a/collects/redex/private/term.ss
+++ b/collects/redex/private/term.ss
@@ -32,11 +32,11 @@
       (let ([result-id (car (generate-temporaries '(f-results)))])
         (with-syntax ([fn fn])
           (let loop ([func (syntax (λ (x) (fn (syntax->datum x))))]
-                     [args rewritten]
+                     [args-stx rewritten]
                      [res result-id]
                      [args-depth (min depth max-depth)])
             (with-syntax ([func func]
-                          [args args]
+                          [args args-stx]
                           [res res])
               (if (zero? args-depth)
                   (begin
@@ -45,7 +45,7 @@
                                 outer-bindings))
                     (values result-id (min depth max-depth)))
                   (loop (syntax (λ (l) (map func (syntax->list l))))
-                        (syntax (args (... ...)))
+                        (syntax/loc args-stx (args (... ...)))
                         (syntax (res (... ...)))
                         (sub1 args-depth)))))))))
   
@@ -55,7 +55,7 @@
        (and (identifier? (syntax metafunc-name))
             (term-fn? (syntax-local-value (syntax metafunc-name) (λ () #f))))
        (rewrite-application (term-fn-get-id (syntax-local-value/catch (syntax metafunc-name) (λ (x) #t)))
-                            (syntax (arg ...))
+                            (syntax/loc stx (arg ...))
                             depth)]
       [f
        (and (identifier? (syntax f))
@@ -76,7 +76,7 @@
       [(unquote-splicing . x)
        (raise-syntax-error 'term "malformed unquote splicing" orig-stx stx)]
       [(in-hole id body)
-       (rewrite-application (syntax (λ (x) (apply plug x))) (syntax (id body)) depth)]
+       (rewrite-application (syntax (λ (x) (apply plug x))) (syntax/loc stx (id body)) depth)]
       [(in-hole . x)
        (raise-syntax-error 'term "malformed in-hole" orig-stx stx)]
       [hole (values (syntax (unsyntax the-hole)) 0)]