From 491b44260a15603e9af1fe38cb74e5128bf66905 Mon Sep 17 00:00:00 2001
From: Boris Smilga <boris.smilga@gmail.com>
Date: Tue, 13 Nov 2012 19:40:45 +0400
Subject: [PATCH] Lisp-like initialization options for MAKE-ARRAY.

---
 src/macros.lisp     |   23 +++++++++++++++++++++--
 t/output-tests.lisp |   22 ++++++++++++++++++++++
 2 files changed, 43 insertions(+), 2 deletions(-)

diff --git a/src/macros.lisp b/src/macros.lisp
index 6026015..542e8ef 100644
--- a/src/macros.lisp
+++ b/src/macros.lisp
@@ -84,8 +84,27 @@
 
 ;;; Data structures
 
-(defpsmacro make-array (&rest initial-values)
-  `(new (*array ,@initial-values)))
+(defpsmacro make-array (&rest args)
+  (or (ignore-errors
+        (destructuring-bind (dim &key (initial-element nil initial-element-p)
+                                 initial-contents element-type)
+            args
+          (declare (ignore element-type))
+          (and (or initial-element-p initial-contents)
+               (not (and initial-element-p initial-contents))
+               (let ((arr (ps-gensym)) (init (ps-gensym))
+                     (elt (ps-gensym)) (i (ps-gensym)))
+                 `(let ((,arr (new (*array ,dim))))
+                    ,@(when initial-element-p
+                        `((let ((,elt ,initial-element))
+                            (dotimes (,i (length ,arr))
+                              (setf (aref ,arr ,i) ,elt)))))
+                    ,@(when initial-contents
+                        `((let ((,init ,initial-contents))
+                            (dotimes (,i (min (length ,arr) (length ,init)))
+                              (setf (aref ,arr ,i) (aref ,init ,i))))))
+                    ,arr)))))
+      `(new (*array ,@args))))
 
 (defpsmacro length (a)
   `(getprop ,a 'length))
diff --git a/t/output-tests.lisp b/t/output-tests.lisp
index d97d707..b88c232 100644
--- a/t/output-tests.lisp
+++ b/t/output-tests.lisp
@@ -94,6 +94,28 @@
    (make-array "foobar" "bratzel bub"))
   "new Array(new Array(2, 3), new Array('foobar', 'bratzel bub'));")
 
+(test-ps-js array-init-1
+  (make-array 2 :initial-contents '(10 20))
+  "(function () {
+      var _js1 = new Array(2);
+      var _js2 = [10, 20];
+      for (var _js4 = 0; _js4 < Math.min(_js1.length, _js2.length); _js4 += 1) {
+          _js1[_js4] = _js2[_js4];
+      };
+      return _js1;
+  })();")
+
+(test-ps-js array-init-2
+  (make-array 5 :initial-element 10)
+  "(function () {
+      var _js1 = new Array(5);
+      var _js3 = 10;
+      for (var _js4 = 0; _js4 < _js1.length; _js4 += 1) {
+          _js1[_js4] = _js3;
+      };
+      return _js1;
+  })();")
+
 (test-ps-js object-literals-1
   (create foo "bar" :blorg 1)
   "({ foo : 'bar', 'blorg' : 1 });")
-- 
1.7.3.2