Fixes bug: (ddd #'yᵢ) used to generate different ids each time, because the value of yᵢ was attached to the shadowed xᵢ, not to the “main” xᵢ.

private/ddd.rkt

@@ -22,7 +22,6 @@
 
 (define-for-syntax x-pvar-scope (make-syntax-introducer))
 (define-for-syntax x-pvar-present-marker (make-syntax-introducer))
-(define-for-syntax x-lifted-pvar-marker (make-syntax-introducer))
 
 (begin-for-syntax
   (define/contract (attribute-real-valvar attr)
@@ -135,11 +134,13 @@
   (define lifted-variables
     (map (λ (id)
            (define prop (syntax-property id 'lifted-pvar))
-           (unless ((cons/c symbol? syntax?) prop)
+           (unless ((cons/c symbol? stx-list?) prop)
+             (displayln id)
+             (displayln prop)
              (raise-syntax-error 'ddd
                                  (string-append
-                                  "internal error: 'lifted-pvar property was"
+                                  "internal error: 'lifted-pvar property was "
-                                  " missing or not a (cons/c symbol? syntax?).")
+                                  "missing or not a (cons/c symbol? stx-list?)")
                                  stx))
            prop)
          (filter (λ (id) (all-scopes-in? x-lifted-pvar-marker id))
@@ -262,9 +263,10 @@
   (define-values (present-variables lifted-variables)
     (extract-present-variables #'expanded-f stx))
 
-  (displayln lifted-variables)
+  (define/with-syntax ([lifted-key lifted-macro+args …] …) lifted-variables)
 
-  (unless (ormap identity present-variables)
+  (unless (or (ormap identity present-variables)
+              (not (null? lifted-variables)))
     (raise-syntax-error 'ddd
                         "no pattern variables were found in the body"
                         stx))
@@ -286,7 +288,8 @@
     (define/with-syntax ((_ iterated-pvar iterated-pvarᵢ _ _) …)
       (filter car present?+pvars))
 
-    (when (stx-null? #'(iterated-pvar …))
+    (when (and (stx-null? #'(iterated-pvar …))
+               (null? lifted-variables))
       (no-pvar-to-iterate-error present?+pvars))
     
     ;; If the pvar is iterated, use the iterated pvarᵢ 
@@ -297,12 +300,13 @@
                     [(list #f pv pvᵢ #f _) #'#f])
            present?+pvars)))
 
-  #'(map#f* (λ (iterated-pvarᵢ …)
+  #'(map#f* (λ (iterated-pvarᵢ … lifted-key …)
-              (expanded-f filling-pvar … #false)) ;; TODO: the lifted pvars here …………………………………………
+              (expanded-f filling-pvar …
-            (list (quote-syntax iterated-pvar)
+                          (make-hash (list (cons 'lifted-key lifted-key) …))))
-                  …)
+            (list (quote-syntax iterated-pvar) …
-            (list (attribute* iterated-pvar)
+                  (quote-syntax lifted-key) …) ;; TODO!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! not the real variable
-                  …)))
+            (list (attribute* iterated-pvar) …
+                  (lifted-macro+args … 1 #;depth?????????????????????????????????????????????????) …)))
 
 (define-syntax/case (shadow pvar new-value) ()
   (match (attribute-info #'pvar '(pvar attr))

private/lifted-variables-communication.rkt

@@ -1,7 +1,9 @@
 #lang racket/base
 
 (provide lift-late-pvars-param
-         (for-syntax lift-late-pvars-target))
+         (for-syntax lift-late-pvars-target
+                     lifted-pvar
+                     x-lifted-pvar-marker))
 
 (require racket/stxparam
          (for-syntax racket/base
@@ -11,16 +13,18 @@
 (define-syntax-parameter lift-late-pvars-param #f)
 
 (define-for-syntax (lift-late-pvars-target)
-  (syntax-parameter-value #'must-lift-late-pvars?-param))
+  (syntax-parameter-value #'lift-late-pvars-param))
+
+(define-for-syntax x-lifted-pvar-marker (make-syntax-introducer))
 
 ;; Returns two values, the syntax to insert, and a symbol to use at run-time
 ;; to access the value of that lifted pvar.
 (begin-for-syntax
-  (define/contract (lifted-pvar name expr-stx)
+  (define/contract (lifted-pvar name macro+args-stx)
-    (-> symbol? syntax? (values symbol? syntax?))
+    (-> symbol? syntax? (cons/c symbol? syntax?))
     (define lifted-symbol (gensym (format "lifted-~a" name)))
     (define lifted-hint-id (generate-temporary lifted-symbol))
-    (values (syntax-property lifted-hint-id
+    (cons lifted-symbol
-                             'late-pvar
+          (syntax-property (x-lifted-pvar-marker lifted-hint-id)
-                             (cons lifted-symbol expr-stx))
+                           'lifted-pvar
-            lifted-symbol)))
+                           (cons lifted-symbol macro+args-stx)))))

private/template-subscripts.rkt

@@ -114,10 +114,7 @@
                                           (sub1 depth)))
                    l*)))))
 
-(define-for-syntax (sub*template self-form tmpl-form)
+(define-for-syntax (sub*template self-form tmpl-form get-attribute*)
-  (sub*template-impl self-form tmpl-form))
-
-(define-for-syntax (sub*template-impl self-form tmpl-form)
   (syntax-parser
     [(self {~optional {~and #:force-no-stxinfo force-no-stxinfo}}
            {~optkw #:props (prop:id ...)}
@@ -181,21 +178,53 @@
 
      (define/with-syntax whole-form-id (generate-temporary 'whole-subtemplate))
 
+     (define lift-target (lift-late-pvars-target))
+     (if lift-target
+         (let ()
+           (define/with-syntax ([token . to-insert] …)
+             (stx-map lifted-pvar
+                      (stx-map syntax-e #'(bound …)) ;; name
+                      #`([lifted-var-macro bound] …)))
+           #`(let-values ()
+               (quote-syntax (to-insert …))
+               (copy-raw-syntax-attribute bound
+                                          (hash-ref #,lift-target 'token)
+                                          ellipsis-depth
+                                          #t)
+               …
+               #,(if get-attribute*
+                   #'(list (attribute* bound ) …)
+                   result)))
          #`(let-values ()
              (define-values (whole-form-id) (quote-syntax #,this-syntax))
-         (derive
+             (derive bound
-          bound (binder …) unique-at-runtime-ids ellipsis-depth whole-form-id)
+                     (binder …)
+                     unique-at-runtime-ids
+                     ellipsis-depth
+                     whole-form-id)
+             …
+             #,(if get-attribute*
+                   #'(list (attribute* bound ) …)
+                   #`(let-values ()
+                       ;; check that all the binders for a given bound are
+                       ;; compatible.
+                       ((ellipsis-count/c ellipsis-depth)
+                        (list (attribute* binder) …))
                        …
-         (let-values ()
-           ;; check that all the binders for a given bound are compatible.
-           ((ellipsis-count/c ellipsis-depth) (list (attribute* binder) …)) …
                        ;; actually call template or quasitemplate
-           #,result))]))
+                       #,result))))]))
 
+(define-syntax (lifted-var-macro stx)
+  (syntax-case stx ()
+    [(_ bound depth)
+     #`(car (subtemplate/attribute* bound))]))
+
+(define-syntax subtemplate/attribute*
+  (sub*template 'subtemplate #'template #t))
 (define-syntax subtemplate
-  (sub*template 'subtemplate #'template))
+  (sub*template 'subtemplate #'template #f))
 (define-syntax quasisubtemplate
-  (sub*template 'quasisubtemplate #'quasitemplate))
+  (sub*template 'quasisubtemplate #'quasitemplate #f))
 
 (define/contract (multi-hash-ref! h keys)
   ;; This assumes that the hash does not get mutated during the execution of
@@ -341,7 +370,10 @@
                                      (quote-syntax whole-form-id)
                                      (quote-syntax bound))
        
-       (copy-raw-syntax-attribute bound temp-cached ellipsis-depth #t))))
+       (copy-raw-syntax-attribute bound
+                                  temp-cached
+                                  ellipsis-depth
+                                  #t))))
 
 (define (check-derived-ellipsis-shape ellipsis-depth
                                       temp-generated

test/assumption-local-expand-reuse-let-bound-id.rkt

@@ -0,0 +1,36 @@
+#lang racket
+(require (for-syntax racket/syntax))
+;; x is first bound with a let inside the local-expanded code.
+;; The identifier is extracted (presumably with that let's scope,
+;; and re-uesd as a definition outside of the let.
+;; Check that this is okay (no "ambiguous identifier" or "identifier
+;; used out of context" error.
+(define-syntax (test stx)
+  (syntax-case stx ()
+    [(_ e)
+     (let ()
+       (define/with-syntax whole
+         (local-expand #'(let-values ([(e) 2]) e) 'expression '()))
+       (define/with-syntax (_ _ xx) #'whole)
+       #'(let-values ()
+           (define xx 3)
+           (list xx
+                 whole)))]))
+
+(let ([x 1])
+  (test x))
+
+(define-syntax (test2 stx)
+  (syntax-case stx ()
+    [(_ e)
+     (let ()
+       (define/with-syntax whole
+         (local-expand #'(let-values ([(e) 2]) e) 'expression '()))
+       (define/with-syntax (_ _ xx) #'whole)
+       #'(let-values ([(xx) xx])
+           (list xx
+                 whole)))]))
+
+;; This does produce an error. The xxx must not be used as an expression.
+#;(let ([x 1])
+    (test2 x))

test/test-ddd-top.rkt

@@ -2,6 +2,7 @@
 
 (require subtemplate/private/top-subscripts
          subtemplate/private/ddd-forms
+         (only-in subtemplate/private/ddd ddd)
          (except-in subtemplate/private/override ?? ?@)
          stxparse-info/case
          stxparse-info/parse
@@ -41,6 +42,66 @@
                       (list #'yᵢ …)]))
               '(a/y b/y c/y))
 
+(check-match (syntax-case #'([a b c] [d e]) ()
+               [((xᵢ …) …)
+                (list (list #'yᵢ …) …)])
+             (list (list (? syntax?) (? syntax?) (? syntax?))
+                   (list (? syntax?) (? syntax?))))
+
+(check-equal? (map (curry map syntax->datum)
+                   (syntax-case #'([a b c] [d e]) ()
+                     [((xᵢ …) …)
+                      (list (list #'yᵢ …) …)]))
+              '([a/y b/y c/y] [d/y e/y]))
+
+(check-match (syntax-case #'([(a1 a2) (b1) (c1 c2 c3)]
+                             [(d1 d2 d3 d4) (e1 e2 e3 e4 e5)]) ()
+               [(((xᵢ …) …) …)
+                (list (list (list #'yᵢ …) …) …)])
+             (list (list (list (? syntax?) (? syntax?))
+                         (list (? syntax?))
+                         (list (? syntax?) (? syntax?) (? syntax?)))
+                   (list (list (? syntax?) (? syntax?) (? syntax?) (? syntax?))
+                         (list (? syntax?) (? syntax?) (? syntax?)
+                               (? syntax?) (? syntax?)))))
+
+(check-equal? (map (curry map (curry map syntax->datum))
+                   (syntax-case #'([(a1 a2) (b1) (c1 c2 c3)]
+                                   [(d1 d2 d3 d4) (e1 e2 e3 e4 e5)]) ()
+                     [(((xᵢ …) …) …)
+                      (list (list (list #'yᵢ …) …) …)]))
+              '([(a1/y a2/y) (b1/y) (c1/y c2/y c3/y)]
+                [(d1/y d2/y d3/y d4/y) (e1/y e2/y e3/y e4/y e5/y)]))
+
+;; CHeck that the same ids are produced.
+(check-true (let ([ids (flatten
+                        (syntax-case #'(id) ()
+                          [(_aᵢ …)
+                           (list
+                            (ddd #'bᵢ)
+                            (list #'bᵢ …)
+                            (syntax->list #'(bᵢ …)))]))])
+              (andmap (curry apply free-identifier=?)
+                      (cartesian-product ids ids))))
+
+(check-true (let ([ids (flatten
+                        (syntax-case #'((id)) ()
+                          [((aᵢ …) …)
+                           (list
+                            (ddd (ddd #'bᵢ))
+                            (list (list #'bᵢ …) …)
+                            (stx-map syntax->list #'((bᵢ …) …))
+                            (syntax->list #'(bᵢ … …))
+                            (map syntax->list (list #'(bᵢ …) …)))]))])
+              (andmap (curry apply free-identifier=?)
+                      (cartesian-product ids ids))))
+
+(check-equal? (map (curry map syntax->datum)
+                   (syntax-case #'([a b c] [d e]) ()
+                     [((xᵢ …) …)
+                      (list (list #'yᵢ …) …)]))
+              '([a/y b/y c/y] [d/y e/y]))
+
 (check-match (syntax-case #'(a b c) ()
                [(xᵢ …)
                 ([list xᵢ #'yᵢ] …)])