From a973556261eabad506fe2caccb4e3b0bad8374b1 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Sat, 5 Jul 2014 20:24:27 -0500
Subject: [PATCH] fix metafunction rewriting

in the case that the bad use of the metafunction appears as the first
thing in a good metafunction application

closes PR 14618
---
 pkgs/redex-pkgs/redex-lib/redex/private/term.rkt | 16 +++++++++-------
 .../redex-test/redex/tests/err-loc-test.rkt      |  2 +-
 .../syn-err-tests/metafunction-definition.rktd   | 10 ++++++++++
 3 files changed, 20 insertions(+), 8 deletions(-)

diff --git a/pkgs/redex-pkgs/redex-lib/redex/private/term.rkt b/pkgs/redex-pkgs/redex-lib/redex/private/term.rkt
index ebbb98bc57..e483ea26c9 100644
--- a/pkgs/redex-pkgs/redex-lib/redex/private/term.rkt
+++ b/pkgs/redex-pkgs/redex-lib/redex/private/term.rkt
@@ -123,11 +123,11 @@
     (make-free-identifier-mapping))
   
   (define (rewrite stx)
-    (let-values ([(rewritten _) (rewrite/max-depth stx 0 #f)])
+    (let-values ([(rewritten _) (rewrite/max-depth stx 0 #f #f)])
       rewritten))
   
   (define (rewrite-application fn args depth srcloc-stx)
-    (let-values ([(rewritten max-depth) (rewrite/max-depth args depth #t)])
+    (let-values ([(rewritten max-depth) (rewrite/max-depth args depth #t #t)])
       (let ([result-id (car (generate-temporaries '(f-results)))])
         (with-syntax ([fn fn])
           (let loop ([func (if (judgment-form-id? #'fn)
@@ -150,10 +150,11 @@
                         (syntax (res (... ...)))
                         (sub1 args-depth)))))))))
   
-  (define (rewrite/max-depth stx depth ellipsis-allowed?)
+  (define (rewrite/max-depth stx depth ellipsis-allowed? continuing-an-application?)
     (syntax-case stx (unquote unquote-splicing in-hole hole)
       [(metafunc-name arg ...)
-       (and (identifier? (syntax metafunc-name))
+       (and (not continuing-an-application?)
+            (identifier? (syntax metafunc-name))
             (if names
                 (not (memq (syntax->datum #'metafunc-name) names))
                 #t)
@@ -164,7 +165,8 @@
                                        #t)
          (rewrite-application f (syntax/loc stx (arg ...)) depth stx))]
       [(jf-name arg ...)
-       (and (identifier? (syntax jf-name))
+       (and (not continuing-an-application?)
+            (identifier? (syntax jf-name))
             (if names
                 (not (memq (syntax->datum #'jf-name) names))
                 #t)
@@ -237,7 +239,7 @@
        (let-values ([(x-rewrite max-depth)
                      (let i-loop ([xs (syntax->list (syntax (x ...)))])
                        (cond
-                         [(null? xs) (rewrite/max-depth #'y depth #t)]
+                         [(null? xs) (rewrite/max-depth #'y depth #t #f)]
                          [else
                           (let ([new-depth (if (and (not (null? (cdr xs)))
                                                     (identifier? (cadr xs))
@@ -246,7 +248,7 @@
                                                (+ depth 1)
                                                depth)])
                             (let-values ([(fst fst-max-depth)
-                                          (rewrite/max-depth (car xs) new-depth #t)]
+                                          (rewrite/max-depth (car xs) new-depth #t #f)]
                                          [(rst rst-max-depth)
                                           (i-loop (cdr xs))])
                               (values (cons fst rst)
diff --git a/pkgs/redex-pkgs/redex-test/redex/tests/err-loc-test.rkt b/pkgs/redex-pkgs/redex-test/redex/tests/err-loc-test.rkt
index 0c592e85e4..ea0743312b 100644
--- a/pkgs/redex-pkgs/redex-test/redex/tests/err-loc-test.rkt
+++ b/pkgs/redex-pkgs/redex-test/redex/tests/err-loc-test.rkt
@@ -68,7 +68,7 @@
                (map source-location (syntax->list #'(loc-piece ...)))
                #'(let-syntax ([subst 
                                (λ (stx)
-                                 (syntax-case stx ()
+                                 (syntax-case (syntax-local-introduce stx) ()
                                    [(_ loc-name ... non-loc-name ...)
                                     #'body]))])
                    (subst loc-piece ... non-loc-piece ...)
diff --git a/pkgs/redex-pkgs/redex-test/redex/tests/syn-err-tests/metafunction-definition.rktd b/pkgs/redex-pkgs/redex-test/redex/tests/syn-err-tests/metafunction-definition.rktd
index 50824e18e6..2df3ea0228 100644
--- a/pkgs/redex-pkgs/redex-test/redex/tests/syn-err-tests/metafunction-definition.rktd
+++ b/pkgs/redex-pkgs/redex-test/redex/tests/syn-err-tests/metafunction-definition.rktd
@@ -24,3 +24,13 @@
  (define-metafunction syn-err-lang
   [(func M_1 E_2)
    (M_1 (E_2 not-non-term) M_1)]))
+
+(#rx"metafunction must be in an application"
+ ([z2 z])
+ (let ()
+   (define-metafunction syn-err-lang
+     [(i any) any])
+   (define-metafunction syn-err-lang
+     [(z any) (0)])
+   (let ()
+     (term (i z2 4)))))