From 10384cb70d8a551ff1a2bf80b6793dcb55f5ee87 Mon Sep 17 00:00:00 2001
From: Mike Nolta <mike@nolta.net>
Date: Mon, 8 Dec 2014 20:21:33 -0500
Subject: [PATCH] add default kw constructor for immutables

For example, the type

    immutable X
        a::Int
        b::Int
    end

now comes with the extra constructor:

    X(x::X; a=x.a, b=x.b) = new(a,b)

Closes #5333.
---
 src/julia-syntax.scm | 39 ++++++++++++++++++++++-----------------
 test/core.jl         | 16 ++++++++++++++++
 2 files changed, 38 insertions(+), 17 deletions(-)

diff --git a/src/julia-syntax.scm b/src/julia-syntax.scm
index 4448ad853d5ec..1c08842d05c43 100644
--- a/src/julia-syntax.scm
+++ b/src/julia-syntax.scm
@@ -726,22 +726,27 @@
       (map (lambda (x) (gensy)) field-names)
       field-names))
 
-(define (default-inner-ctors name field-names field-types gen-specific?)
-  (let* ((field-names (safe-field-names field-names field-types))
-	 (any-ctor
-	  ;; definition with Any for all arguments
-	  `(function (call ,name ,@field-names)
-		     (block
-		      (call new ,@field-names)))))
-    (if (and gen-specific? (any (lambda (t) (not (eq? t 'Any))) field-types))
-	(list
-	 ;; definition with field types for all arguments
-	 `(function (call ,name
-			  ,@(map make-decl field-names field-types))
-		    (block
-		     (call new ,@field-names)))
-	 any-ctor)
-	(list any-ctor))))
+(define (default-inner-ctors name field-names field-types gen-specific? mutabl)
+  (let* ((arg-names (safe-field-names field-names field-types))
+         (any-ctor `(function (call ,name ,@arg-names)
+                              (block (call new ,@arg-names))))
+         (ctors (if (and gen-specific? (any (lambda (t) (not (eq? t 'Any))) field-types))
+	            (list
+                     ;; definition with field types for all arguments
+	             `(function (call ,name ,@(map make-decl arg-names field-types))
+		                (block (call new ,@arg-names)))
+	             any-ctor)
+	            (list any-ctor))))
+    (if (and (not mutabl)
+             (length> field-names 1)
+             (eq? arg-names field-names))
+        (let ((g (gensy)))
+          (cons `(function (call ,name
+                                 (parameters ,@(map (lambda (k) `(kw ,k (|.| ,g ',k))) field-names))
+                                 (|::| ,g ,name))
+                           (block (call new ,@field-names)))
+                ctors))
+        ctors)))
 
 (define (default-outer-ctor name field-names field-types params bounds)
   (let ((field-names (safe-field-names field-names field-types)))
@@ -889,7 +894,7 @@
 	  (field-names (map decl-var fields))
 	  (field-types (map decl-type fields))
 	  (defs2 (if (null? defs)
-		     (default-inner-ctors name field-names field-types (null? params))
+		     (default-inner-ctors name field-names field-types (null? params) mut)
 		     defs))
 	  (min-initialized (min (ctors-min-initialized defs) (length fields))))
      (for-each (lambda (v)
diff --git a/test/core.jl b/test/core.jl
index 6a4be9aa81e0d..1fc6326197032 100644
--- a/test/core.jl
+++ b/test/core.jl
@@ -1974,3 +1974,19 @@ function f9134()
     end
 end
 @test_throws UndefVarError f9134()
+
+# issue #5333
+immutable I5333
+    a::Int
+    b::Int
+end
+type T5333
+    a::Int
+    b::Int
+end
+let i = I5333(1,2), t = T5333(1,2)
+    @test I5333(i;b=3) === I5333(1,3)
+    @test I5333(i;a=3) === I5333(3,2)
+    @test_throws MethodError T5333(t;a=3)
+    @test_throws MethodError T5333(t;b=3)
+end