CLJS-3299: port CLJ-2603 (#122)

Port CLJ-2603: Added support for trailing, conj-able element in map-destructuring support for seqs

Faithfully port over all the relevant Java bits.

* update --destructure-map helper
* move key-test up for use by PAM.createAsIfByAssoc(ComplexPath)
* port new PAM.createAsIfByAssoc - don't copy init, check for trailing & dupes
* add PAM.createAsIfByComplexPath, ported from Java
* add seq-to-map-for-destructuring
* update docstrings
* add tests

Author: swannodette

src/main/cljs/cljs/core.cljs

@@ -4005,8 +4005,14 @@ reduces them without incurring seq initialization"
 
 ;; CLJS-3200: used by destructure macro for maps to reduce amount of repeated code
 ;; placed here because it needs apply and hash-map (only declared at this point)
-(defn --destructure-map [x]
-  (if (implements? ISeq x) (apply cljs.core/hash-map x) x))
+(defn --destructure-map [gmap]
+  (if (implements? ISeq gmap)
+    (if (next gmap)
+      (.createAsIfByAssoc PersistentArrayMap (to-array gmap))
+      (if (seq gmap)
+        (first gmap)
+        (.-EMPTY PersistentArrayMap)))
+    gmap))
 
 (defn vary-meta
  "Returns an object of the same type and value as obj, with
@@ -7057,19 +7063,91 @@ reduces them without incurring seq initialization"
       (let [cnt (/ (alength arr) 2)]
         (PersistentArrayMap. nil cnt arr nil)))))
 
+(defn key-test [key other]
+  (cond
+    (identical? key other) true
+    (keyword-identical? key other) true
+    :else (= key other)))
+
+(defn- ^boolean pam-dupes? [arr]
+  (loop [i 0]
+    (if (< i (alength arr))
+      (let [dupe? (loop [j 0]
+                    (if (< j i)
+                      (or
+                        (key-test (aget arr i) (aget arr j))
+                        (recur (+ 2 j)))
+                      false))]
+        (or dupe? (recur (+ 2 i))))
+      false)))
+
+(defn- pam-new-size [arr]
+  (loop [i 0 n 0]
+    (if (< i (alength arr))
+      (let [dupe? (loop [j 0]
+                    (if (< j i)
+                      (or
+                        (key-test (aget arr i) (aget arr j))
+                        (recur (+ 2 j)))
+                      false))]
+        (recur (+ 2 i) (if dupe? n (+ n 2))))
+      n)))
+
+(defn- pam-grow-seed-array [seed trailing]
+  (let [seed-cnt  (dec (alength seed))
+        extra-kvs (seq trailing)
+        ret       (make-array (+ seed-cnt (* 2 (count extra-kvs))))
+        ret       (array-copy seed 0 ret 0 seed-cnt)]
+    (loop [i seed-cnt extra-kvs extra-kvs]
+      (if extra-kvs
+        (let [kv (first extra-kvs)]
+          (aset ret i (-key kv))
+          (aset ret (inc i) (-val kv))
+          (recur (+ 2 seed-cnt) (next extra-kvs)))
+        ret))))
+
 (set! (.-createAsIfByAssoc PersistentArrayMap)
-  (fn [arr]
-    (let [ret (array)]
-      (loop [i 0]
-        (when (< i (alength arr))
-          (let [k (aget arr i)
-                v (aget arr (inc i))
-                idx (array-index-of ret k)]
-            (if (== idx -1)
-              (doto ret (.push k) (.push v))
-              (aset ret (inc idx) v)))
-          (recur (+ i 2))))
-      (PersistentArrayMap. nil (/ (alength ret) 2) ret nil))))
+  (fn [init]
+    ;; check trailing element
+    (let [len           (alength init)
+          has-trailing? (== 1 (bit-and len  1))]
+      (if-not (or has-trailing? (pam-dupes? init))
+        (PersistentArrayMap. nil (/ len 2) init nil)
+        (.createAsIfByAssocComplexPath PersistentArrayMap init has-trailing?)))))
+
+(set! (.-createAsIfByAssocComplexPath PersistentArrayMap)
+  (fn [init ^boolean has-trailing?]
+    (let [init (if has-trailing?
+                 (pam-grow-seed-array init
+                   ;; into {} in case the final element is not a map but something conj-able
+                   ;; for parity with Clojure implementation of CLJ-2603
+                   (into {} (aget init (dec (alength init)))))
+                 init)
+          n    (pam-new-size init)
+          len  (alength init)]
+      (if (< n len)
+        (let [nodups (make-array n)]
+          (loop [i 0 m 0]
+            (if (< i len)
+              (let [dupe? (loop [j 0]
+                            (if (< j m)
+                              (or
+                                (key-test (aget init i) (aget init j))
+                                (recur (+ 2 j)))
+                              false))]
+                (if-not dupe?
+                  (let [j (loop [j (- len 2)]
+                            (if (>= j i)
+                              (if (key-test (aget init i) (aget init j))
+                                j
+                                (recur (- j 2)))
+                              j))]
+                    (aset nodups m (aget init i))
+                    (aset nodups (inc m) (aget init (inc j)))
+                    (recur (+ 2 i) (+ 2 m)))
+                  (recur (+ 2 i) m)))))
+          (PersistentArrayMap. nil (/ (alength nodups) 2) nodups nil))
+        (PersistentArrayMap. nil (/ (alength init) 2) init nil)))))
 
 (es6-iterable PersistentArrayMap)
 
@@ -7170,12 +7248,6 @@ reduces them without incurring seq initialization"
 
 (declare create-inode-seq create-array-node-seq reset! create-node atom deref)
 
-(defn key-test [key other]
-  (cond
-    (identical? key other) true
-    (keyword-identical? key other) true
-    :else (= key other)))
-
 (defn- mask [hash shift]
   (bit-and (bit-shift-right-zero-fill hash shift) 0x01f))
 
@@ -8947,7 +9019,17 @@ reduces them without incurring seq initialization"
   (let [arr (if (and (instance? IndexedSeq keyvals) (zero? (.-i keyvals)))
               (.-arr keyvals)
               (into-array keyvals))]
-    (.createAsIfByAssoc PersistentArrayMap arr)))
+    (if (odd? (alength arr))
+      (throw (js/Error. (str "No value supplied for key: " (last arr))))
+      (.createAsIfByAssoc PersistentArrayMap arr))))
+
+(defn seq-to-map-for-destructuring
+  "Builds a map from a seq as described in
+  https://clojure.org/reference/special_forms#keyword-arguments"
+  [s]
+  (if (next s)
+    (.createAsIfByAssoc PersistentArrayMap (to-array s))
+    (if (seq s) (first s) (.-EMPTY PersistentArrayMap))))
 
 (defn obj-map
   "keyval => key val

src/main/clojure/cljs/core.cljc

@@ -267,12 +267,14 @@
 
 #?(:cljs
    (core/defmacro fn
-     "params => positional-params* , or positional-params* & next-param
+     "params => positional-params* , or positional-params* & rest-param
      positional-param => binding-form
-     next-param => binding-form
-     name => symbol
+     rest-param => binding-form
+     binding-form => name, or destructuring-form
 
-     Defines a function"
+     Defines a function
+
+     See https://clojure.org/reference/special_forms#fn for more information"
      {:forms '[(fn name? [params*] exprs*) (fn name? ([params*] exprs*) +)]}
      [& sigs]
      (core/let [name (if (core/symbol? (first sigs)) (first sigs) nil)
@@ -769,10 +771,15 @@
 
 (core/defmacro let
   "binding => binding-form init-expr
+  binding-form => name, or destructuring-form
+  destructuring-form => map-destructure-form, or seq-destructure-form
 
   Evaluates the exprs in a lexical context in which the symbols in
   the binding-forms are bound to their respective init-exprs or parts
-  therein."
+  therein.
+
+  See https://clojure.org/reference/special_forms#binding-forms for
+  more information about destructuring."
   [bindings & body]
   (assert-args let
      (vector? bindings) "a vector for its binding"

src/test/cljs/cljs/destructuring_test.cljs

@@ -185,3 +185,47 @@
     (is (= 1 (f 1)))
     (is (= 1 (f 1 2))))
   (let []))
+
+(deftest test-pam-dupes?
+  (is (false? (#'pam-dupes? #js [:a 1 :b 2 :c 3])))
+  (is (true? (#'pam-dupes? #js [:a 1 :b 2 :a 3]))))
+
+(deftest test-pam-new-size
+  (is (== 6 (#'pam-new-size #js [:a 1 :b 2 :c 3])))
+  (is (== 4 (#'pam-new-size #js [:a 1 :b 2 :a 3]))))
+
+(deftest singleton-map-in-destructure-context
+  (let [sample-map {:a 1 :b 2}
+        {:keys [a] :as m1} (list sample-map)]
+    (is (= m1 sample-map))
+    (is (= a 1))))
+
+(deftest trailing-map-destructuring
+  (let [add  (fn [& {:keys [a b]}] (+ a b))
+        addn (fn [n & {:keys [a b]}] (+ n a b))]
+    (testing "that kwargs are applied properly given a map in place of the key/val pairs"
+      (is (= 3 (add  :a 1 :b 2)))
+      (is (= 3 (add  {:a 1 :b 2})))
+      (is (= 13 (addn 10 :a 1 :b 2)))
+      (is (= 13 (addn 10 {:a 1 :b 2})))
+      (is (= 103 ((partial addn 100) :a 1 {:b 2})))
+      (is (= 103 ((partial addn 100 :a 1) {:b 2})))
+      (is (= 107 ((partial addn 100 :a 1) {:a 5 :b 2}))))
+    (testing "built maps"
+      (let [{:as m1} (list :a 1 :b 2)
+            {:as m2} (list :a 1 :b 2 {:c 3})
+            {:as m3} (list :a 1 :b 2 {:a 0})
+            {:keys [a4] :as m4} (list nil)]
+        (= m1 {:a 1 :b 2})
+        (= m2 {:a 1 :b 2 :c 3})
+        (= m3 {:a 0 :b 2})
+        (= m1 (seq-to-map-for-destructuring (list :a 1 :b 2)))
+        (= m2 (seq-to-map-for-destructuring (list :a 1 :b 2 {:c 3})))
+        (= m3 (seq-to-map-for-destructuring (list :a 1 :b 2 {:a 0})))
+        (= a4 nil)))))
+
+(comment
+
+  (cljs.test/run-tests)
+
+  )