fix macro expansion of property destructuring

src/ast.scm

@@ -122,7 +122,7 @@
                                (string (deparse (cadr e)) (car e) (deparse (caddr e)))))
            ((comparison) (string.join (map deparse (cdr e)) " "))
            ((macrocall) (string (cadr e) " " (deparse-arglist (cddr e) " ")))
-           ((kw)        (string (deparse (cadr e)) " = " (deparse (caddr e))))
+           ((kw renamedkw)     (string (deparse (cadr e)) " = " (deparse (caddr e))))
            ((where)     (string (deparse (cadr e)) " where "
                                 (if (length= e 3)
                                     (deparse (caddr e))
@@ -338,7 +338,7 @@
             (if (nospecialize-meta? v #t)
                 (arg-name (caddr v))
                 (bad-formal-argument v)))
-           ((kw)
+           ((kw renamedkw)
             (arg-name (cadr v)))
            (else (bad-formal-argument v))))))
 
@@ -359,7 +359,7 @@
             (if (nospecialize-meta? v #t)
                 (arg-type (caddr v))
                 (bad-formal-argument v)))
-           ((kw)
+           ((kw renamedkw)
             (arg-type (cadr v)))
            (else (bad-formal-argument v))))))
 
@@ -517,7 +517,7 @@
   (and (pair? e) (is-prec-assignment? (car e))))
 
 (define (kwarg? e)
-  (and (pair? e) (eq? (car e) 'kw)))
+  (and (pair? e) (memq (car e) '(kw renamedkw))))
 
 (define (nospecialize-meta? e (one #f))
   (and (if one (length= e 3) (length> e 2))

src/julia-syntax.scm

@@ -17,7 +17,7 @@
   (if (any vararg? (butlast l))
       (error "invalid \"...\" on non-final argument"))
   (map (lambda (a)
-         (cond ((and (pair? a) (eq? (car a) 'kw))
+         (cond ((kwarg? a)
                 `(kw ,(fill-missing-argname (cadr a) unused) ,(caddr a)))
                ((and (pair? a) (eq? (car a) '...))
                 `(... ,(fill-missing-argname (cadr a) unused)))
@@ -127,7 +127,7 @@
                 (cddr ex)))
         ;; TODO: this probably should not be allowed since keyword args aren't
         ;; positional, but in this context we have just used their positions anyway
-        ((eq? (car ex) 'kw)
+        ((kwarg? ex)
          (list 'kw (cadr ex) (replace-beginend (caddr ex) a n tuples last)))
         (else
          (cons (car ex)
@@ -1801,8 +1801,8 @@
           (cond ((effect-free? x)  x)
                 ((or (eq? (car x) '...) (eq? (car x) '&))
                  `(,(car x) ,(arg-to-temp (cadr x))))
-                ((eq? (car x) 'kw)
-                 `(,(car x) ,(cadr x) ,(arg-to-temp (caddr x))))
+                ((kwarg? x)
+                 `(kw ,(cadr x) ,(arg-to-temp (caddr x))))
                 (else
                  (let ((g (make-ssavalue)))
                    (begin (set! a (cons `(= ,g ,x) a))
@@ -2402,6 +2402,17 @@
          (gensy))
         (else (make-ssavalue))))
 
+(define (extract-dest-prop field lhs)
+  (cond ((symbol? field) (list field field))
+        ((and (pair? field) (eq? (car field) '|::|))
+         (extract-dest-prop (cadr field) lhs))
+        ((globalref? field)
+         (list field (caddr field)))
+        ((and (pair? field) (eq? (car field) 'renamedkw))
+         (cdr field))
+        (else
+         (error (string "invalid assignment location \"" (deparse `(tuple ,lhs)) "\"")))))
+
 (define (expand-property-destruct lhs x (wrap identity))
   (if (not (length= lhs 1))
       (error (string "invalid assignment location \"" (deparse `(tuple ,lhs)) "\"")))
@@ -2412,12 +2423,8 @@
        ,@ini
        ,@(map
            (lambda (field)
-             (let ((prop (cond ((symbol? field) field)
-                               ((and (pair? field) (eq? (car field) '|::|) (symbol? (cadr field)))
-                                (cadr field))
-                               (else
-                                (error (string "invalid assignment location \"" (deparse `(tuple ,lhs)) "\""))))))
-               (expand-forms (wrap `(= ,field (call (top getproperty) ,xx (quote ,prop)))))))
+             (let ((dest-prop (extract-dest-prop field lhs)))
+               (expand-forms (wrap `(= ,(car dest-prop) (call (top getproperty) ,xx (quote ,(cadr dest-prop))))))))
            lhss)
        (unnecessary ,xx))))
 

src/macroexpand.scm

@@ -438,10 +438,10 @@
            ((parameters)
             (cons 'parameters
                   (map (lambda (x)
-                         ;; `x` by itself after ; means `x=x`
+                         ;; outside of function definitions, `x` by itself after ; means `x=x`
                          (let* ((ux (unescape x))
-                                (x (if (and (not inarg) (symbol? ux))
-                                       `(kw ,ux ,x)
+                                (x (if (symbol? ux)
+                                       `(,(if inarg 'renamedkw 'kw) ,ux ,x)
                                        x)))
                            (resolve-expansion-vars- x env m lno parent-scope #f)))
                        (cdr e))))
@@ -456,15 +456,15 @@
                                    (resolve-expansion-vars-with-new-env x env m lno parent-scope inarg))
                                  (cddr e))))
 
-           ((kw)
+           ((kw renamedkw)
             (cond
              ((not (length> e 2)) e)
              ((and (pair? (cadr e))
                    (eq? (caadr e) '|::|))
               (let* ((type-decl (cadr e)) ;; [argname]::type
                      (argname   (and (length> type-decl 2) (cadr type-decl)))
                      (type      (if argname (caddr type-decl) (cadr type-decl))))
-                `(kw (|::|
+                `(,(car e) (|::|
                       ,@(if argname
                             (list (if inarg
                                       (resolve-expansion-vars- argname env m lno parent-scope inarg)
@@ -474,7 +474,7 @@
                       ,(resolve-expansion-vars- type env m lno parent-scope inarg))
                      ,(resolve-expansion-vars-with-new-env (caddr e) env m lno parent-scope inarg))))
              (else
-              `(kw ,(if inarg
+              `(,(car e) ,(if inarg
                         (resolve-expansion-vars- (cadr e) env m lno parent-scope inarg)
                         (unescape (cadr e)))
                    ,(resolve-expansion-vars-with-new-env (caddr e) env m lno parent-scope inarg)))))

test/syntax.jl

@@ -4602,3 +4602,21 @@ end
     @test_throws UndefVarError macroexpand(@__MODULE__, :(@undefined_macro(x)))
     @test_throws UndefVarError macroexpand!(@__MODULE__, :(@undefined_macro(x)))
 end
+
+macro prop_destruct_macroexpand1()
+    :((; foo_prop_destruct1) = (foo_prop_destruct1 = 7,))
+end
+macro prop_destruct_macroexpand2()
+    :(let (; foo_prop_destruct2) = (foo_prop_destruct2 = 8,)
+        foo_prop_destruct2
+    end)
+end
+
+@testset "macro expansion of property destructuring" begin
+    m = @__MODULE__
+    @test @prop_destruct_macroexpand1() == (foo_prop_destruct1 = 7,)
+    @test m.foo_prop_destruct1 == 7
+
+    @test @prop_destruct_macroexpand2() == 8
+    @test !isdefined(m, :foo_prop_destruct2)
+end