repair for nexted splicing forms that define the same name

Nested splicing forms would lead to an "ambigious binding" error
when the nested forms bind the same name, such as in

 (splicing-let ([a 1])
   (splicing-let ([a 2])
     (define x a)))

The problem is that splicing is implemented by adding a scope to
everything in the form's body, but removing it back off the
identifiers of a definition (so the `x` above ends up with no new
scopes). Meanwhile, a splicing form expands to a set of definitions,
where the locally bound identifier keeps the extra scope (unlike
definitions from the body). A local identifier for a nested splicing
form would then keep the inner scope but lose the outer scope, while
a local identifier from the outer splicing form would keep the outer
scope but no have the inner one --- leading to ambiguity.

The solution in this commit is to annotate a local identifier for a
splicing form with a property that says "intended to be local", so the
nested definition will keep the scope for the outer splicing form as
well as the inner one. It's not clear that this is the right approach,
but it's the best idea I have for now.

pkgs/racket-doc/scribblings/reference/splicing.scrbl

@@ -40,10 +40,7 @@ one
 
 When a splicing binding form occurs in a @tech{top-level context} or
 @tech{module context}, its local bindings are treated similarly to
-definitions. In particular, if a reference to one of the splicing
+definitions. In particular, syntax bindings are
-form's bound variables is evaluated before the variable is
-initialized, an unbound variable error is raised, instead of the
-variable evaluating to the undefined value.  Also, syntax bindings are
 evaluated every time the module is @tech{visit}ed, instead of only
 once during compilation as in @racket[let-syntax], etc.
 
@@ -52,7 +49,15 @@ once during compilation as in @racket[let-syntax], etc.
 (splicing-letrec ([x bad]
                   [bad 1])
   x)]
-}
+
+If a definition within a splicing form is intended to be local to the
+splicing body, then the identifier should have a true value for the
+@racket['definition-intended-as-local] @tech{syntax property}. For
+example, @racket[splicing-let] itself adds the property to
+locally-bound identifiers as it expands to a sequence of definitions,
+so that nesting @racket[splicing-let] within a splicing form works as
+expected (without any ambiguous bindings).}
+
 
 @defidform[splicing-syntax-parameterize]{
 

pkgs/racket-test-core/tests/racket/syntax.rktl

@@ -1482,6 +1482,30 @@
                                                           (define x 10))
                                   (abcdefg)))
 
+(test '(1 2)
+      'nested-splicing-expr
+      (splicing-let ([a 1])
+                    (list a
+                          (splicing-let ([a 2])
+                                        a))))
+
+(test '(1 2)
+      'nested-splicing-def
+      (let ()
+        (splicing-let ([a 1])
+                      (define x a)
+                      (splicing-let ([a 2])
+                                    (define y a)))
+        (list x y)))
+
+(test '(1 2)
+      'nested-splicing-syntax
+      (let ()
+        (splicing-let-syntax ([a (syntax-rules () [(_) 1])])
+                             (define x (a))
+                             (splicing-let-syntax ([a (syntax-rules () [(_) 2])])
+                                                  (define y (a))))
+        (list x y)))
 
 ;; ----------------------------------------
 

racket/collects/racket/splicing.rkt

@@ -90,7 +90,10 @@
                (LET ([ids expr] ...)
                  (#%expression body)
                  ...)))
-           (with-syntax ([((id ...) ...) all-ids]
+           (with-syntax ([((id ...) ...)
+                          (for/list ([ids (in-list all-ids)])
+                            (for/list ([id (in-list ids)])
+                              (syntax-property id 'definition-intended-as-local #t)))]
                          [DEF def-id]
                          [rec? rec?]
                          [(marked-id markless-id)
@@ -128,6 +131,11 @@
      (let ([i (make-syntax-delta-introducer #'marked-id #'markless-id)])
        #`(splicing-let-body marked-id markless-id #,(i #'body)))]))
 
+(define-for-syntax ((maybe unintro) form)
+  (if (syntax-property form 'definition-intended-as-local)
+      form
+      (unintro form)))
+
 (define-syntax (splicing-let-body stx)
   (syntax-case stx ()
     [(_ marked-id markless-id body)
@@ -148,10 +156,10 @@
             (begin (splicing-let-body marked-id markless-id form) ...))]
          [(define-values ids rhs)
           (quasisyntax/loc body
-            (define-values #,(unintro #'ids) rhs))]
+            (define-values #,(map (maybe unintro) (syntax->list #'ids)) rhs))]
          [(define-syntaxes ids rhs)
           (quasisyntax/loc body
-            (define-syntaxes #,(unintro #'ids) rhs))]
+            (define-syntaxes #,(map (maybe unintro) (syntax->list #'ids)) rhs))]
          [(begin-for-syntax e ...)
           (syntax/loc body
             (begin-for-syntax (splicing-let-body/et marked-id markless-id e) ...))]
@@ -166,7 +174,7 @@
   (define-syntax (splicing-let-body/et stx)
     (syntax-case stx ()
       [(_ marked-id markless-id body)
-       (let ([unintro (lambda (form)
+       (let* ([unintro (lambda (form)
                          ((make-syntax-delta-introducer #'marked-id #'markless-id) form 'remove))]
               [body (local-expand #'body (syntax-local-context) #f)])
          (syntax-case body (begin
@@ -183,10 +191,10 @@
               (begin (splicing-let-body/et marked-id markless-id form) ...))]
            [(define-values ids rhs)
             (quasisyntax/loc body
-              (define-values #,(unintro #'ids) rhs))]
+              (define-values #,(map (maybe unintro) (syntax->list #'ids)) rhs))]
            [(define-syntaxes ids rhs)
             (quasisyntax/loc body
-              (define-syntaxes #,(unintro #'ids) rhs))]
+              (define-syntaxes #,(map (maybe unintro) (syntax->list #'ids)) rhs))]
            [(begin-for-syntax . es)
             ;; Give up on splicing definitions at phase level 2 and deeper:
             body]