From 79b6e5611e3be98998b7032a6f500a67eb690a28 Mon Sep 17 00:00:00 2001
From: Jon Rafkind <rafkind@racket-lang.org>
Date: Thu, 19 Apr 2012 16:34:16 -0600
Subject: [PATCH] [honu] dont confuse identifiers with $. use = in with-syntax

---
 collects/honu/core/private/compile.rkt | 11 ++++++++---
 collects/honu/core/private/honu2.rkt   | 16 ++++++++++++----
 2 files changed, 20 insertions(+), 7 deletions(-)

diff --git a/collects/honu/core/private/compile.rkt b/collects/honu/core/private/compile.rkt
index d391c6b256..8c704234ff 100644
--- a/collects/honu/core/private/compile.rkt
+++ b/collects/honu/core/private/compile.rkt
@@ -121,12 +121,17 @@
   (provide compress-dollars)
   (define (compress-dollars stx)
     (define-literal-set local-literals (honu-$ repeat$))
+    (define-splicing-syntax-class not-dollar
+                                  #:literal-sets (local-literals)
+      [pattern x #:when (and (identifier? #'x)
+                             (not (free-identifier=? #'honu-$ #'x)))
+                 #:with out #'x])
     (syntax-parse stx #:literal-sets (local-literals)
-      [(honu-$ x ... honu-$ rest ...)
+      [(honu-$ x:not-dollar ... honu-$ rest ...)
        (with-syntax ([(rest* ...) (compress-dollars #'(rest ...))])
-         (datum->syntax stx (syntax->list #'((repeat$ x ...) rest* ...))
+         (datum->syntax stx (syntax->list #'((repeat$ x.out ...) rest* ...))
                         stx stx))]
-      [(x rest ...)
+      [(x:not-dollar rest ...)
        (with-syntax ([x* (compress-dollars #'x)]
                      [(rest* ...) (compress-dollars #'(rest ...))])
          (datum->syntax stx
diff --git a/collects/honu/core/private/honu2.rkt b/collects/honu/core/private/honu2.rkt
index 48bc872eb3..4aada85426 100644
--- a/collects/honu/core/private/honu2.rkt
+++ b/collects/honu/core/private/honu2.rkt
@@ -341,12 +341,20 @@
 (provide (rename-out [honu-with-syntax withSyntax]))
 (define-honu-syntax honu-with-syntax
   (lambda (code context)
+    (define-splicing-syntax-class clause
+                                  #:literal-sets (cruft)
+                                  #:literals [(ellipses ...) honu-equal]
+      [pattern (~seq name:id honu-equal data:honu-expression)
+               #:with out #'(name data.result)]
+      [pattern (~seq (#%parens name:id ellipses) honu-equal data:honu-expression)
+               #:with out #'((name ellipses) data.result)])
     (syntax-parse code #:literal-sets (cruft)
-                       #:literals (honu-->)
-      [(_ (~seq name:id honu--> data:honu-expression (~optional honu-comma)) ...
+                       #:literals (honu-equal)
+      [(_ (~seq all:clause (~optional honu-comma)) ...
           (#%braces code ...) . rest)
-       (define out (racket-syntax (with-syntax ([name data.result] ...)
-                                (parse-body code ...))))
+       (define out (racket-syntax
+                     (with-syntax (all.out ...)
+                       (parse-body code ...))))
        (values out #'rest #t)])))
 
 (provide true false)