From bb376d39426c4ca7c16ec39e9c1ea4b7205a6b8e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Georges=20Dup=C3=A9ron?= <georges.duperon@gmail.com>
Date: Tue, 31 Jan 2017 06:09:25 +0100
Subject: [PATCH] A few small changes, exported make-auto-pvar needed by
 stxparse-info to have some auto-syntax-e-like behaviour

---
 main.rkt           | 50 ++++++++++++++++++++++++++++++++++------------
 test/test-meta.rkt | 26 ++++++++++++++++++++++++
 utils.rkt          |  3 +++
 3 files changed, 66 insertions(+), 13 deletions(-)
 create mode 100644 test/test-meta.rkt
 create mode 100644 utils.rkt

diff --git a/main.rkt b/main.rkt
index 8b520ad..a2b6ecc 100644
--- a/main.rkt
+++ b/main.rkt
@@ -14,13 +14,18 @@
 (provide auto-with-syntax)
 (provide auto-syntax)
 (provide auto-syntax-case)
+(module+ utils
+  (provide (for-syntax make-auto-pvar
+                       auto-pvar?)))
 
 (define (leaves->datum e depth)
-  (if (> depth 0)
-      (map (λ (eᵢ) (leaves->datum eᵢ (sub1 depth))) e)
-      (if (syntax? e)
-          (syntax->datum e)
-          e)))
+  (if (eq? e #f) ;; for attributes with ~optional holes.
+      e
+      (if (> depth 0)
+          (map (λ (eᵢ) (leaves->datum eᵢ (sub1 depth))) e)
+          (if (syntax? e)
+              (syntax->datum e)
+              e))))
         
 
 (define-syntax (to-datum stx)
@@ -36,8 +41,27 @@
              #`(leaves->datum #,valvar #,depth))))]))
 
 (begin-for-syntax
+  (define (auto-pvar-proc self stx)
+    (cond
+      [(identifier? stx)
+       (datum->syntax stx
+                      `(,(quote-syntax to-datum) ,stx)
+                      stx
+                      stx)]
+      [(and (pair? (syntax-e stx))
+            (identifier? (car (syntax-e stx))))
+       (datum->syntax stx
+                      `((,(quote-syntax to-datum) ,(car (syntax-e stx)))
+                        .
+                        ,(cdr (syntax-e stx)))
+                      stx
+                      stx)]
+      [else (raise-syntax-error
+             'auto-syntax-e
+             "Improper use of auto-syntax-e pattern variable"
+             stx)]))
   (define-values (struct:auto-pvar
-                  make-auto-pvar
+                  -make-auto-pvar
                   auto-pvar?
                   auto-pvar-ref
                   auto-pvar-set!)
@@ -49,8 +73,9 @@
                       #f
                       null
                       (current-inspector)
-                      (λ (self stx)
-                        #`(to-datum #,stx)))))
+                      auto-pvar-proc))
+  (define (make-auto-pvar depth valvar)
+    (make-set!-transformer (-make-auto-pvar depth valvar))))
 
 (define-for-syntax (syntax->tree/ids e)
   (cond [(identifier? e) e]
@@ -76,11 +101,10 @@
       (let ()
         (record-disappeared-uses (syntax->list #'(pvar-id ...)))
         #'(let-syntax ([pvar-id
-                        (make-set!-transformer
-                         (let ([mapping (syntax-local-value
-                                         (quote-syntax pvar-id))])
-                           (make-auto-pvar (syntax-mapping-depth mapping)
-                                           (syntax-mapping-valvar mapping))))]
+                        (let ([mapping (syntax-local-value
+                                        (quote-syntax pvar-id))])
+                          (make-auto-pvar (syntax-mapping-depth mapping)
+                                          (syntax-mapping-valvar mapping)))]
                        ...)
             body ...)))]))
 
diff --git a/test/test-meta.rkt b/test/test-meta.rkt
new file mode 100644
index 0000000..df6dfa4
--- /dev/null
+++ b/test/test-meta.rkt
@@ -0,0 +1,26 @@
+#lang racket
+(require auto-syntax-e (for-syntax racket/base))
+(auto-syntax-case #'(1 2 3) ()
+  [(x ...)
+   (map add1 x)])
+
+(begin-for-syntax
+  (require auto-syntax-e (for-syntax racket/base))
+  (auto-syntax-case #'(1 2 3) ()
+    [(x ...)
+     (map add1 x)]))
+
+(begin-for-syntax
+  (begin-for-syntax
+    (require auto-syntax-e (for-syntax racket/base))
+    (auto-syntax-case #'(1 2 3) ()
+      [(x ...)
+       (map add1 x)])))
+
+(begin-for-syntax
+  (begin-for-syntax
+    (begin-for-syntax
+      (require auto-syntax-e (for-syntax racket/base))
+      (auto-syntax-case #'(1 2 3) ()
+        [(x ...)
+         (map add1 x)]))))
\ No newline at end of file
diff --git a/utils.rkt b/utils.rkt
new file mode 100644
index 0000000..d359eff
--- /dev/null
+++ b/utils.rkt
@@ -0,0 +1,3 @@
+#lang racket
+(require (for-template (submod auto-syntax-e utils)))
+(provide (for-template (all-from-out (submod auto-syntax-e utils))))
\ No newline at end of file