Skip to content

Commit 53fa967

Browse files
richhickeyrichhickey
committed
add :excess directive to map destructuring, yields (deep, set logic) input - select, nil when no excess
1 parent 2cea692 commit 53fa967

1 file changed

Lines changed: 38 additions & 25 deletions

File tree

‎src/clj/clojure/core.clj‎

Lines changed: 38 additions & 25 deletions
Original file line numberDiff line numberDiff line change
@@ -4434,6 +4434,22 @@
44344434
([f] (lazy-seq (cons (f) (repeatedly f))))
44354435
([n f] (take n (repeatedly f))))
44364436

4437+
(defn counted?
4438+
"Returns true if coll implements count in constant time"
4439+
{:added "1.0"
4440+
:static true}
4441+
[coll] (instance? clojure.lang.Counted coll))
4442+
4443+
(defn empty?
4444+
"Returns true if coll has no items. To check the emptiness of a seq,
4445+
please use the idiom (seq x) rather than (not (empty? x))"
4446+
{:added "1.0"
4447+
:static true}
4448+
[coll]
4449+
(if (counted? coll)
4450+
(zero? (count coll))
4451+
(not (seq coll))))
4452+
44374453
(declare reduce-kv)
44384454

44394455
(defn some-vals
@@ -4506,6 +4522,7 @@
45064522
gdefaults (when defaults (zipmap (keys defaults) (repeatedly #(gensym "default__"))))
45074523
select (:select b)
45084524
all (:all b)
4525+
excess (:excess b)
45094526
xf (fn [mk]
45104527
(let [mkns (namespace mk)
45114528
mkn (name mk)]
@@ -4529,7 +4546,7 @@
45294546
(if (:as b)
45304547
(conj ret (:as b) gmap)
45314548
ret))))
4532-
bes (dissoc b :as :or :select :all)
4549+
bes (dissoc b :as :or :select :all :excess)
45334550
localize (fn [bb] (if (instance? clojure.lang.Named bb)
45344551
(with-meta (symbol nil (name bb)) (meta bb)) bb))
45354552
push1 (fn [ret bb bk req?]
@@ -4550,7 +4567,7 @@
45504567
(-> ret (conj local bv))
45514568
(pb ret bb bv))))
45524569
retsel
4553-
(loop [ret ret, sel #{}, bes bes, b->k {}, subs nil, suba nil]
4570+
(loop [ret ret, sel #{}, bes bes, b->k {}, subs nil, suba nil, subd nil]
45544571
(if (seq bes)
45554572
(let [be (first bes), bb (key be), bk (val be)]
45564573
(if (keyword? bb)
@@ -4579,7 +4596,7 @@
45794596
(next bbs) preamp?
45804597
(if preamp? (assoc b->k (localize bb) bk) b->k)))))
45814598
{:ret ret, :sel sel, :b->k b->k}))]
4582-
(recur (:ret retsel) (:sel retsel) (next bes) (:b->k retsel) subs suba))
4599+
(recur (:ret retsel) (:sel retsel) (next bes) (:b->k retsel) subs suba subd))
45834600
(let [subsel? (and select (map? bb))
45844601
bb (if (or (not subsel?) (:select bb))
45854602
bb
@@ -4591,10 +4608,16 @@
45914608
bb
45924609
(assoc bb :all (gensym "all__")))
45934610
suba (if suball? (assoc suba bk (:all bb)) suba)
4594-
4611+
4612+
subexcess? (and excess (map? bb))
4613+
bb (if (or (not subexcess?) (:excess bb))
4614+
bb
4615+
(assoc bb :excess (gensym "excess__")))
4616+
subd (if subexcess? (assoc subd bk (:excess bb)) subd)
4617+
45954618
b->k (if (symbol? bb) (assoc b->k bb bk) b->k)]
4596-
(recur (push1 ret bb bk false) (conj sel bk) (next bes) b->k subs suba))))
4597-
{:ret ret, :sel sel, :b->k b->k :subs subs :suba suba}))
4619+
(recur (push1 ret bb bk false) (conj sel bk) (next bes) b->k subs suba subd))))
4620+
{:ret ret, :sel sel, :b->k b->k :subs subs :suba suba :subd subd}))
45984621
ret (:ret retsel), sel (:sel retsel), b->k (:b->k retsel)
45994622
new-or-code (and defaults (or defaults-as select all))
46004623
bk #(if (symbol? %)
@@ -4603,18 +4626,24 @@
46034626
(throw (new IllegalArgumentException (str "symbol " % " in :or does not refer to a binding"))))
46044627
bk)
46054628
%)
4606-
dm (when defaults (dissoc (zipmap (map bk (keys gdefaults)) (vals gdefaults)) nil))
4629+
dm (when defaults (zipmap (map bk (keys gdefaults)) (vals gdefaults)))
46074630
_ (and new-or-code (not= (count (select-keys dm sel)) (count defaults))
46084631
(throw (new IllegalArgumentException (str "keys "
46094632
(apply disj (set (keys dm)) sel)
46104633
" appear only in :or"))))
4634+
dm (if (empty? dm) nil dm)
46114635
ret (if select
4612-
(conj ret select `(when-let [mm# (merge (some-vals ~dm) ~gmap (some-vals ~(:subs retsel)))]
4636+
(conj ret select `(when-let [mm# (merge ~dm ~gmap (some-vals ~(:subs retsel)))]
46134637
(select-keys mm# ~sel)))
46144638
ret)
46154639
ret (if all
4616-
(conj ret all `(merge (some-vals ~dm) ~gmap (some-vals ~(:suba retsel))))
4640+
(conj ret all `(merge ~dm ~gmap (some-vals ~(:suba retsel))))
46174641
ret)
4642+
4643+
ret (if excess
4644+
(conj ret excess `(merge (some-vals (apply dissoc ~gmap ~sel)) (some-vals ~(:subd retsel))))
4645+
ret)
4646+
46184647
ret (if defaults-as (conj ret defaults-as dm) ret)]
46194648
ret))
46204649

@@ -6417,22 +6446,6 @@ fails, attempts to require sym's namespace and retries."
64176446
:static true}
64186447
[coll] (instance? clojure.lang.Sorted coll))
64196448

6420-
(defn counted?
6421-
"Returns true if coll implements count in constant time"
6422-
{:added "1.0"
6423-
:static true}
6424-
[coll] (instance? clojure.lang.Counted coll))
6425-
6426-
(defn empty?
6427-
"Returns true if coll has no items. To check the emptiness of a seq,
6428-
please use the idiom (seq x) rather than (not (empty? x))"
6429-
{:added "1.0"
6430-
:static true}
6431-
[coll]
6432-
(if (counted? coll)
6433-
(zero? (count coll))
6434-
(not (seq coll))))
6435-
64366449
(defn reversible?
64376450
"Returns true if coll implements Reversible"
64386451
{:added "1.0"

0 commit comments

Comments
 (0)