Skip to content

port Clojure 1.13 alpha destructuring changes #326

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

Open
swannodette wants to merge 9 commits into
base: master
Choose a base branch
from
+180 −96
Open

port Clojure 1.13 alpha destructuring changes #326

Changes from all commits
Commits
Show all changes
9 commits
Select commit Hold shift + click to select a range
eb1eb67
first just lift out the macro helper fns
swannodette Jul 21, 2026
6396989
(wip)
swannodette Aug 3, 2026
856ff07
porting the rest, untested
swannodette Aug 8, 2026
bd9b1a6
fix two obvious typos
swannodette Aug 8, 2026
44508f0
some other missed things
swannodette Aug 8, 2026
5b6ad33
missing changes
swannodette Aug 8, 2026
f2fd219
fix typo
swannodette Aug 8, 2026
3f81d6f
another typo
swannodette Aug 8, 2026
a4f94bc
fully qualify `get and `req! for bootstrapped
swannodette Aug 8, 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
276 changes: 180 additions & 96 deletions src/main/clojure/cljs/core.cljc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -626,108 +626,192 @@
`(when-not (exists? ~qualified)
(def ~x ~init))))

(core/defn ^:private destvec*
[pb bvec b val]
(core/let [gvec (gensym "vec__")
gseq (gensym "seq__")
gfirst (gensym "first__")
has-rest (some #{'&} b)]
(core/loop [ret (core/let [ret (conj bvec gvec val)]
(if has-rest
(conj ret gseq (core/list `seq gvec))
ret))
n 0
bs b
seen-rest? false]
(if (seq bs)
(core/let [firstb (first bs)]
(core/cond
(= firstb '&) (recur (pb ret (second bs) gseq)
n
(nnext bs)
true)
(= firstb :as) (pb ret (second bs) gvec)
:else (if seen-rest?
(throw #?(:clj (new Exception "Unsupported binding form, only :as can follow & parameter")
:cljs (new js/Error "Unsupported binding form, only :as can follow & parameter")))
(recur (pb (if has-rest
(conj ret
gfirst `(first ~gseq)
gseq `(next ~gseq))
ret)
firstb
(if has-rest
gfirst
(core/list `nth gvec n nil)))
(core/inc n)
(next bs)
seen-rest?))))
ret))))

(core/defn ^:private destmap*
[pb bvec b v]
(core/let [gmap (gensym "map__")
gignore (gensym "ignore__")
defaults (:or b)
defaults-as (:defaults b)
_ (core/when (core/and defaults-as (core/not defaults))
#?(:clj (throw (new IllegalArgumentException "Can't specify :defaults without :or"))
:cljs (throw (new js/Error "Can't specify :defaults without :or"))))
b (dissoc b :defaults)
gdefaults (core/when defaults (zipmap (keys defaults) (repeatedly #(gensym "default__"))))
select (:select b)
all (:all b)
xf (core/fn [mk]
(core/let [mkns (namespace mk)
mkn (name mk)]
(core/cond
(.startsWith mkn "keys") #(keyword (core/or mkns (namespace %)) (name %))
(.startsWith mkn "syms") #(core/list `quote (core/symbol (core/or mkns (namespace %)) (name %)))
(.startsWith mkn "strs") core/str
:else (throw #?(:clj (new Exception (core/str "Unsupported map directive: " mk))
:cljs (new js/Error (core/str "Unsupported map directive: " mk)))))))
ret (reduce (core/fn [ret e]
(conj ret (val e) (defaults (key e))))
bvec gdefaults)
ret (core/-> ret (conj gmap) (conj v)
(conj gmap)
(conj `(--destructure-map ~gmap))
((core/fn [ret]
(if (:as b)
(conj ret (:as b) gmap)
ret))))
bes (dissoc b :as :or :select :all)
localize (core/fn [bb]
(if #?(:clj (core/instance? clojure.lang.Named bb)
:cljs (cljs.core/implements? INamed bb))
(with-meta (core/symbol nil (name bb)) (meta bb)) bb))
push1 (core/fn [ret bb bk req?]
(core/let [getter (if req? `cljs.core/req! `cljs.core/get)
local (localize bb)
local-default? (contains? defaults local)
key-default? (contains? defaults bk)
bv (if (core/or local-default? key-default?)
(if (core/and local-default? key-default?)
#?(:clj (throw (new Exception
(core/str "Multiple :or defaults for same key: " bk " '" local "'")))
:cljs (throw (new js/Error
(core/str "Multiple :or defaults for same key: " bk " '" local "'"))))
(if req?
#?(:clj (throw (new Exception
(core/str "Can't supply default value for required key: " bk)))
: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 (ident? bb)
(core/-> ret (conj local bv))
(pb ret bb bv))))
retsel
(core/loop [ret ret, sel #{}, bes bes, b->k {}, subs nil, suba nil]
(if (seq bes)
(core/let [be (first bes), bb (key be), bk (val be)]
(if (core/keyword? bb)
(core/let [dir bb
tr (xf bb)
req? (.endsWith (name bb) "!")
retsel
(core/loop [ret ret, sel sel, bbs (seq bk), preamp? true, b->k b->k]
(if (seq bbs)
(core/let [bb (first bbs)]
(if (= bb '&)
(if preamp?
(recur ret sel (next bbs) false b->k)
#?(: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))
#?(:clj (throw
(new IllegalArgumentException
(core/str "'" bb
"' - binding symbols can only appear before '&', use keys after")))
:cljs (throw
(new js/Error
(core/str "'" bb
"' - 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?)
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))
(core/let [subsel? (core/and select (map? bb))
bb (if (core/or (core/not subsel?) (:select bb))
bb
(assoc bb :select (gensym "select__")))
subs (if subsel? (assoc subs bk (:select bb)) subs)
suball? (core/and all (map? bb))
bb (if (core/or (core/not suball?) (:all bb))
bb
(assoc bb :all (gensym "all__")))
suba (if suball? (assoc suba bk (:all bb)) suba)
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)
new-or-code (core/and defaults (core/or defaults-as select all))
bk #(if (core/symbol? %)
(core/let [bk (b->k %)]
(core/when (core/and new-or-code (core/not bk))
#?(:clj (throw (new IllegalArgumentException (core/str "symbol " % " in :or does not refer to a binding")))
: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))
_ (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")))))
ret (if select
(conj ret select `(when-let [mm# (merge (some-vals ~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))))
ret)
ret (if defaults-as (conj ret defaults-as dm) ret)]
ret))

(core/defn destructure [bindings]
(core/let [bents (partition 2 bindings)
pb (core/fn pb [bvec b v]
(core/let [pvec
(core/fn [bvec b val]
(core/let [gvec (gensym "vec__")
gseq (gensym "seq__")
gfirst (gensym "first__")
has-rest (some #{'&} b)]
(core/loop [ret (core/let [ret (conj bvec gvec val)]
(if has-rest
(conj ret gseq (core/list `seq gvec))
ret))
n 0
bs b
seen-rest? false]
(if (seq bs)
(core/let [firstb (first bs)]
(core/cond
(= firstb '&) (recur (pb ret (second bs) gseq)
n
(nnext bs)
true)
(= firstb :as) (pb ret (second bs) gvec)
:else (if seen-rest?
(throw #?(:clj (new Exception "Unsupported binding form, only :as can follow & parameter")
:cljs (new js/Error "Unsupported binding form, only :as can follow & parameter")))
(recur (pb (if has-rest
(conj ret
gfirst `(first ~gseq)
gseq `(next ~gseq))
ret)
firstb
(if has-rest
gfirst
(core/list `nth gvec n nil)))
(core/inc n)
(next bs)
seen-rest?))))
ret))))
pmap
(core/fn [bvec b v]
(core/let [gmap (gensym "map__")
defaults (:or b)]
(core/loop [ret (core/-> bvec (conj gmap) (conj v)
(conj gmap) (conj `(--destructure-map ~gmap))
((core/fn [ret]
(if (:as b)
(conj ret (:as b) gmap)
ret))))
bes (core/let [transforms
(reduce
(core/fn [transforms mk]
(if (core/keyword? mk)
(core/let [mkns (namespace mk)
mkn (name mk)]
(core/cond (= mkn "keys") (assoc transforms mk #(keyword (core/or mkns (namespace %)) (name %)))
(= mkn "syms") (assoc transforms mk #(core/list `quote (symbol (core/or mkns (namespace %)) (name %))))
(= mkn "strs") (assoc transforms mk core/str)
:else transforms))
transforms))
{}
(keys b))]
(reduce
(core/fn [bes entry]
(reduce #(assoc %1 %2 ((val entry) %2))
(dissoc bes (key entry))
((key entry) bes)))
(dissoc b :as :or)
transforms))]
(if (seq bes)
(core/let [bb (key (first bes))
bk (val (first bes))
local (if #?(:clj (core/instance? clojure.lang.Named bb)
:cljs (cljs.core/implements? INamed bb))
(with-meta (symbol nil (name bb)) (meta bb))
bb)
bv (if (contains? defaults local)
(core/list 'cljs.core/get gmap bk (defaults local))
(core/list 'cljs.core/get gmap bk))]
(recur
(if (core/or (core/keyword? bb) (core/symbol? bb)) ;(ident? bb)
(core/-> ret (conj local bv))
(pb ret bb bv))
(next bes)))
ret))))]
(core/cond
(core/symbol? b) (core/-> bvec (conj (if (namespace b) (symbol (name b)) b)) (conj v))
(core/keyword? b) (core/-> bvec (conj (symbol (name b))) (conj v))
(vector? b) (pvec bvec b v)
(map? b) (pmap bvec b v)
:else (throw
#?(:clj (new Exception (core/str "Unsupported binding form: " b))
:cljs (new js/Error (core/str "Unsupported binding form: " b)))))))
(core/cond
(core/symbol? b) (core/-> bvec (conj b) (conj v))
(core/vector? b) (destvec* pb bvec b v)
(core/map? b) (destmap* pb bvec b v)
:else (throw
#?(:clj (new Exception (core/str "Unsupported binding form: " b))
:cljs (new js/Error (core/str "Unsupported binding form: " b))))))
process-entry (core/fn [bvec b] (pb bvec (first b) (second b)))]
(if (every? core/symbol? (map first bents))
bindings
(core/if-let [kwbs (seq (filter #(core/keyword? (first %)) bents))]
(throw
#?(:clj (new Exception (core/str "Unsupported binding key: " (ffirst kwbs)))
:cljs (new js/Error (core/str "Unsupported binding key: " (ffirst kwbs)))))
(reduce process-entry [] bents)))))
(reduce process-entry [] bents))))

(core/defmacro ^:private return-first
[& body]
Expand Down
Loading