Skip to content

add :excess & :missing #329

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
swannodette merged 9 commits into from
Oct 1, 2026
Merged

add :excess & :missing #329

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
9 commits
Select commit Hold shift + click to select a range
0f0ba06
add :excess
swannodette Sep 20, 2026
4efa0c4
(wip) :missing
swannodette Sep 30, 2026
4744c35
two typos
swannodette Sep 30, 2026
8d912d1
missing fully qualified syms
swannodette Sep 30, 2026
1bf386c
missing vec
swannodette Sep 30, 2026
8e3bee1
not -> core/not
swannodette Oct 1, 2026
0b20b26
missed a threading macro
swannodette Oct 1, 2026
527beba
tests for :excess and :missing
swannodette Oct 1, 2026
b4a3ce9
specs for :missing directive
swannodette Oct 1, 2026
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
6 changes: 4 additions & 2 deletions src/main/cljs/cljs/core/specs/alpha.cljc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -45,10 +45,12 @@
(s/def ::as ::local-name)
(s/def ::defaults ::local-name)
(s/def ::select ::local-name)
(s/def ::excess ::local-name)
(s/def ::missing ::local-name)
(s/def ::all ::local-name)

(s/def ::map-special-binding
(s/keys :opt-un [::as ::or ::keys ::syms ::strs ::keys! ::syms! ::strs! ::select ::defaults ::all]))
(s/keys :opt-un [::as ::or ::keys ::syms ::strs ::keys! ::syms! ::strs! ::select ::excess ::missing ::defaults ::all]))

(s/def ::map-binding (s/tuple ::binding-form any?))

Expand All @@ -60,7 +62,7 @@
(s/def ::map-bindings
(s/every (s/or :map-binding ::map-binding
:qualified-keys-or-syms ::ns-keys
:special-binding (s/tuple #{:as :or :keys :syms :strs :keys! :syms! :strs! :select :defaults :all} any?))
:special-binding (s/tuple #{:as :or :keys :syms :strs :keys! :syms! :strs! :select :excess :missing :defaults :all} any?))
:kind map?))

(s/def ::map-binding-form (s/merge ::map-bindings ::map-special-binding))
Expand Down
70 changes: 56 additions & 14 deletions src/main/clojure/cljs/core.cljc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -667,7 +667,7 @@
(core/defn ^:private destmap*
[pb bvec b v]
(core/let [gmap (gensym "map__")
gignore (gensym "ignore__")
gtemp (gensym "temp__")
defaults (:or b)
defaults-as (:defaults b)
_ (core/when (core/and defaults-as (core/not defaults))
Expand All @@ -677,6 +677,10 @@
gdefaults (core/when defaults (zipmap (keys defaults) (repeatedly #(gensym "default__"))))
select (:select b)
all (:all b)
excess (:excess b)
missing (:missing b)
gnotfound (core/when missing (gensym "notfound__"))
gnotfound? (core/when missing (gensym "notfound?__"))
xf (core/fn [mk]
(core/let [mkns (namespace mk)
mkn (name mk)]
Expand All @@ -696,7 +700,12 @@
(if (:as b)
(conj ret (:as b) gmap)
ret))))
bes (dissoc b :as :or :select :all)
ret (if missing
(conj ret
missing nil
gnotfound (core/list 'new 'js/Object))
ret)
bes (dissoc b :as :or :select :all :excess :missing)
localize (core/fn [bb]
(if #?(:clj (core/instance? clojure.lang.Named bb)
:cljs (cljs.core/implements? INamed bb))
Expand All @@ -718,12 +727,22 @@
:cljs (throw (new js/Error
(core/str "Can't supply default value for required key: " bk))))
(core/list `cljs.core/get gmap bk (if local-default? (gdefaults local) (gdefaults bk)))))
(core/list getter gmap bk))]
(if req?
(if missing
(core/list `cljs.core/get gmap bk gnotfound)
(core/list `cljs.core/req! gmap bk))
(core/list `cljs.core/get gmap bk)))]
(if (ident? bb)
(core/-> ret (conj local bv))
(if (core/and req? missing)
(conj ret
gtemp bv
gnotfound? `(identical? ~gtemp ~gnotfound)
missing `(if ~gnotfound? (assoc ~missing ~bk nil) ~missing)
local `(when-not ~gnotfound? ~gtemp))
(core/-> ret (conj local bv)))
(pb ret bb bv))))
retsel
(core/loop [ret ret, sel #{}, bes bes, b->k {}, subs nil, suba nil]
(core/loop [ret ret, sel #{}, bes bes, b->k {}, subs nil, suba nil, subexcess nil submissing nil]
(if (seq bes)
(core/let [be (first bes), bb (key be), bk (val be)]
(if (core/keyword? bb)
Expand All @@ -740,7 +759,7 @@
#?(:clj (throw (new IllegalArgumentException (core/str "& can only appear once in " dir)))
:cljs (throw (new js/Error (core/str "& can only appear once in " dir)))))
(core/let [_
(core/when (core/and (not preamp?) (core/symbol? bb))
(core/when (core/and (core/not preamp?) (core/symbol? bb))
#?(:clj (throw
(new IllegalArgumentException
(core/str "'" bb
Expand All @@ -751,13 +770,13 @@
"' - binding symbols can only appear before '&', use keys after")))))
bk (if preamp? (tr bb) bb)]
(recur (if (core/or preamp? req?)
(push1 ret (if preamp? bb gignore) bk req?)
(push1 ret (if preamp? bb gtemp) bk req?)
ret)
(conj sel bk)
(next bbs) preamp?
(if preamp? (assoc b->k (localize bb) bk) b->k)))))
{:ret ret, :sel sel, :b->k b->k}))]
(recur (:ret retsel) (:sel retsel) (next bes) (:b->k retsel) subs suba))
(recur (:ret retsel) (:sel retsel) (next bes) (:b->k retsel) subs suba subexcess submissing))
(core/let [subsel? (core/and select (map? bb))
bb (if (core/or (core/not subsel?) (:select bb))
bb
Expand All @@ -768,10 +787,23 @@
bb
(assoc bb :all (gensym "all__")))
suba (if suball? (assoc suba bk (:all bb)) suba)

subexcess? (core/and excess (map? bb))
bb (if (core/or (core/not subexcess?) (:excess bb))
bb
(assoc bb :excess (gensym "excess__")))
subexcess (if subexcess? (assoc subexcess bk (:excess bb)) subexcess)

submissing? (core/and missing (map? bb))
bb (if (core/or (core/not submissing?) (:missing bb))
bb
(assoc bb :missing (gensym "missing__")))
submissing (if submissing? (assoc submissing bk (:missing bb)) submissing)

b->k (if (core/symbol? bb) (assoc b->k bb bk) b->k)]
(recur (push1 ret bb bk false) (conj sel bk) (next bes) b->k subs suba))))
{:ret ret, :sel sel, :b->k b->k :subs subs :suba suba}))
ret (:ret retsel), sel (:sel retsel), b->k (:b->k retsel)
(recur (push1 ret bb bk false) (conj sel bk) (next bes) b->k subs suba subexcess submissing))))
{:ret ret, :sel sel, :b->k b->k :subs subs :suba suba :subexcess subexcess :submissing submissing}))
ret (:ret retsel), sel (vec (:sel retsel)), b->k (:b->k retsel)
new-or-code (core/and defaults (core/or defaults-as select all))
bk #(if (core/symbol? %)
(core/let [bk (b->k %)]
Expand All @@ -780,21 +812,31 @@
:cljs (throw (new js/Error (core/str "symbol " % " in :or does not refer to a binding")))))
bk)
%)
dm (core/when defaults (dissoc (zipmap (map bk (keys gdefaults)) (vals gdefaults)) nil))
dm (core/when defaults (zipmap (map bk (keys gdefaults)) (vals gdefaults)))
_ (core/and new-or-code (core/not= (count (select-keys dm sel)) (count defaults))
#?(:clj (throw (new IllegalArgumentException (core/str "keys "
(apply disj (set (keys dm)) sel)
" appear only in :or")))
:cljs (throw (new js/Error (core/str "keys "
(apply disj (set (keys dm)) sel)
" appear only in :or")))))
dm (if (empty? dm) nil dm)
ret (if select
(conj ret select `(when-let [mm# (merge (some-vals ~dm) ~gmap (some-vals ~(:subs retsel)))]
(conj ret select `(when-let [mm# (merge ~dm ~gmap (some-vals ~(:subs retsel)))]
(select-keys mm# ~sel)))
ret)
ret (if all
(conj ret all `(merge (some-vals ~dm) ~gmap (some-vals ~(:suba retsel))))
(conj ret all `(merge ~dm ~gmap (some-vals ~(:suba retsel))))
ret)

ret (if excess
(conj ret excess `(merge (not-empty (apply dissoc ~gmap ~sel)) (some-vals ~(:subexcess retsel))))
ret)

ret (if missing
(conj ret missing `(merge ~missing (some-vals ~(:submissing retsel))))
ret)

ret (if defaults-as (conj ret defaults-as dm) ret)]
ret))

Expand Down
134 changes: 134 additions & 0 deletions src/test/cljs/cljs/destructuring_test.cljs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -424,6 +424,140 @@
(is (= 1 (let [{:keys [a & 'b]} {:a 1}] a)))
(is (= 1 (let [{:keys! [a & 'b "c"]} {:a 1, 'b 2, "c" 3}] a)))))))

(deftest excess
(let [sample-map {:a 1, :b 2, :c {:aa 10},
'd 4 'e 5 'f {'dd 40 'ee 50},
"g" 6 "h" 7 "i" {"gg" 60 "hh" 70}}]
(testing "happy path"
(let [{:keys [a] :excess exa} (select-keys sample-map [:a :b :c])
{:keys [a b c] :excess exnil} (select-keys sample-map [:a :b :c])
{{:excess exnest} :c} sample-map
{:keys [a c] :excess exkws} (select-keys sample-map [:a :b :c])
{:syms [d f] :excess exsyms} (select-keys sample-map '[d e f])
{:strs [g i] :excess exstrs} (select-keys sample-map ["g" "h" "i"])]
(is (= {:b 2 :c {:aa 10}} exa))
(is (= {:aa 10} exnest))
(is (= {:b 2} exkws))
(is (= '{e 5} exsyms))
(is (= {"h" 7} exstrs))

(testing ":excess predicative use"
(is (nil? exnil))
(is (nil? (let [{:excess ex} {}] ex)))
(is (nil? (let [{:keys [a] :excess ex} nil] ex)))

(let [{:keys [a] :excess ex-some} (select-keys sample-map [:a :b :c])
{:keys [a b c] :excess ex-none} (assoc (select-keys sample-map [:a :b :c]) :b nil)]
(is (some-vals ex-some))
(is (not (some-vals ex-none)))))))

(testing ":excess retains nil values"
(let [{:keys [a] :excess ex-nil1} (assoc (select-keys sample-map [:a :b :c]) :b nil)
{{:keys [aa] :excess ex-nil2} :c} (assoc-in sample-map [:c :bb] nil)]
(is (= {:b nil :c {:aa 10}} ex-nil1))
(is (= {:bb nil} ex-nil2))))

(testing ":excess and :or to ensure that defaults do not show up"
(let [{:keys [a z] :or {z 99} :excess exor} (select-keys sample-map [:a :b :c])]
(is (= {:b 2 :c {:aa 10}} exor))))

(testing "nested :excess, also with &"
(let [{:keys [a] {:keys [aa] :excess exc} :c} sample-map
{:keys! [a & :b :c]
:syms! [& 'd 'e 'f]
:strs! [& "g" "h" "i"]
{:keys [zz] :or {:zz 999} :excess exinner1} :c
{:syms [yy] :or {'yy 999} :excess exinner2} 'f
{:strs [xx] :or {"xx" 999} :excess exinner3} "i"
:excess exouter} sample-map]
(is (nil? exc))
(is (= {:aa 10} exinner1))
(is (= {'dd 40 'ee 50} exinner2))
(is (= {"gg" 60 "hh" 70} exinner3))
(is (= '{:c {:aa 10}, f {dd 40, ee 50}, "i" {"gg" 60, "hh" 70}} exouter))))

(testing ":excess with namespace-qualification"
(let [nsmap {:foo/x 1000, :foo/y 2000, ::z 3000}
{:foo/keys [x] :excess exfoo} nsmap
{::keys [z] :excess exauto} nsmap
{:foo/keys [x] ::keys [z] :excess exmix} nsmap
{:foo/keys [x y] ::keys [z] :excess exall} nsmap]
(is (= {:foo/y 2000 ::z 3000} exfoo))
(is (= {:foo/x 1000 :foo/y 2000} exauto))
(is (= {:foo/y 2000} exmix))
(is (nil? exall))))))

(deftest missing-directive
(let [keys-map {:a 1 :b 2 :nest {:aa 10}}
{:keys! [a b], :missing mkeys-nil} keys-map
{:keys! [a b c], :missing mkeys-c} keys-map
{:keys! [a b & :c], :missing mkeys-c&} keys-map

syms-map '{a 1 b 2 nest {aa 10}}
{:syms! [a b], :missing msyms-nil} syms-map
{:syms! [a b c], :missing msyms-c} syms-map
{:syms! [a b & 'c], :missing msyms-c&} syms-map

strs-map {"a" 1 "b" 2 "nest" {"aa" 10}}
{:strs! [a b], :missing mstrs-nil} strs-map
{:strs! [a b c], :missing mstrs-c} strs-map
{:strs! [a b & "c"], :missing mstrs-c&} strs-map

q-map {:foo/a 1 :b 2 :foo/c 3 ::d 4}
{:keys! [foo/a :foo/c] :missing mq-nil} q-map
{:keys! [b & :foo/d] :missing mq-d} q-map
{:keys! [foo/a & :foo/d] :missing mq-d&} q-map
{:foo/keys! [a c] :missing q-nil} q-map
{:foo/keys! [a & :foo/d] :missing q-d} q-map
{:foo/keys! [a & :foo/d] :missing q-d&} q-map
{::keys! [d] :missing aq-nil} q-map]

(testing "1-level :missing keys for keys/qkeys/syms/strs"
(is (nil? mkeys-nil))
(is (= mkeys-c {:c nil}))
(is (= mkeys-c& {:c nil}))

(is (nil? msyms-nil))
(is (= msyms-c '{c nil}))
(is (= msyms-c& '{c nil}))

(is (nil? mstrs-nil))
(is (= mstrs-c {"c" nil}))
(is (= mstrs-c& {"c" nil}))

(is (nil? mq-nil))
(is (= mq-d #:foo{:d nil}))
(is (= mq-d& #:foo{:d nil}))
(is (nil? q-nil))
(is (= q-d #:foo{:d nil}))
(is (= q-d& #:foo{:d nil}))
(is (nil? aq-nil)))

(testing "required nested map that also has required keys, covering the following cases:
- :nest is missing
- :nest is nil
- :nest is a map missing :x and/or :y
- :nest is a map having everything that's required"
(let [sample-nest {:a 0 :b 0}]
(are [input-map expected] (= expected
(let [{:keys! [a b & :nest]
{:keys! [x y]} :nest
:missing mkeys-missing}
input-map]
mkeys-missing))

sample-nest {:nest {:x nil, :y nil}}

(assoc sample-nest :nest nil) {:nest {:x nil, :y nil}}

(assoc sample-nest :nest {:x 1}) {:nest {:y nil}}

(assoc sample-nest :nest {:x 1 :y 2}) nil)))

(testing "that a nested map required keys is captured with the outer :missing"
(let [{:keys! [a b], {:keys! [bb]} :nest :missing mkeys-outer} keys-map]
(is (= mkeys-outer {:nest {:bb nil}}))))))

(comment

(cljs.test/run-tests)
Expand Down
Loading