Skip to content

Clojure 1.13 destructuring #1068

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
borkdude merged 2 commits into from
Jul 25, 2026
Merged

Clojure 1.13 destructuring #1068

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
c27eb4d
Clojure 1.13 destructuring
borkdude Jul 25, 2026
7285f95
Changelog and upstream sync note
borkdude Jul 25, 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
4 changes: 4 additions & 0 deletions CHANGELOG.md
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -10,6 +10,10 @@ SCI is used in [babashka](https://github.com/babashka/babashka),
[joyride](https://github.com/BetterThanTomorrow/joyride/) and many
[other](https://github.com/babashka/sci#projects-using-sci) projects.

## Unreleased

- Clojure 1.13 map destructuring: `:keys!`, `:syms!`, `:strs!`, `&` inside a directive, `:select`, `:all` and `:defaults`. Adds `req!` and `some-vals` to `clojure.core`.

## 0.15.56

Highlight:
Expand Down
2 changes: 1 addition & 1 deletion script/test/cljd
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -11,7 +11,7 @@ fi

# Test namespaces that compile and pass on ClojureDart. Extend this list as
# more of SCI is ported.
default_namespaces=(sci.core-test sci.error-test sci.vars-test sci.namespaces-test sci.io-test sci.repl-test sci.impl.analyzer-test sci.impl.binding-array-refactor-test sci.multimethods-test sci.protocols-test sci.core-protocols-test sci.defrecords-and-deftype-test sci.reify-test sci.cljd-interop-test sci.parse-test sci.impl.vars-test)
default_namespaces=(sci.core-test sci.destructure-test sci.error-test sci.vars-test sci.namespaces-test sci.io-test sci.repl-test sci.impl.analyzer-test sci.impl.binding-array-refactor-test sci.multimethods-test sci.protocols-test sci.core-protocols-test sci.defrecords-and-deftype-test sci.reify-test sci.cljd-interop-test sci.parse-test sci.impl.vars-test)

if [ $# -gt 0 ]; then
namespaces=("$@")
Expand Down
288 changes: 188 additions & 100 deletions src/sci/impl/destructure.cljc
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,114 +1,202 @@
(ns sci.impl.destructure
"Destructure function, adapted from Clojure and ClojureScript."
{:no-doc true}
(:refer-clojure :exclude [destructure]))
(:refer-clojure :exclude [destructure])
(:require [clojure.string :as str]))

;; destvec* and destmap* track clojure/clojure core.clj at dd006fb9 (2026-07-24),
;; the commit that added the :all directive. Diff against that when syncing.

(defn- destructure-error [msg]
(throw #?(:cljs (new js/Error msg)
:default (new Exception msg))))

;; Emitted as symbols rather than as embedded values. clojure.core/req! and
;; clojure.core/some-vals only exist in sci's own clojure.core, not necessarily
;; in the host, and sci resolves a clojure.core/ prefix on every dialect.
(def ^:private req!-sym 'clojure.core/req!)
(def ^:private some-vals-sym 'clojure.core/some-vals)
(def ^:private merge-sym 'clojure.core/merge)
(def ^:private select-keys-sym 'clojure.core/select-keys)
(def ^:private when-let-sym 'clojure.core/when-let)

(defn- destvec*
[pb bvec b val loc]
(let [gvec (gensym "vec__")
gseq (gensym "seq__")
gfirst (gensym "first__")
has-rest (some #{'&} b)]
(loop [ret (let [ret (conj bvec gvec val)]
(if has-rest
(conj ret gseq (list seq gvec))
ret))
n 0
bs b
seen-rest? false]
(if (seq bs)
(let [firstb (first bs)]
(cond
(= firstb '&) (recur (pb ret (second bs) gseq)
n
(nnext bs)
true)
(= firstb :as) (pb ret (second bs) gvec)
:else (if seen-rest?
(destructure-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
(cond-> (list nth gvec n nil)
loc (with-meta loc))))
(inc n)
(next bs)
seen-rest?))))
ret))))

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

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

(defn destructure
Expand Down
27 changes: 27 additions & 0 deletions src/sci/impl/namespaces.cljc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -993,6 +993,31 @@
(.createAsIfByAssoc PersistentArrayMap (to-array s))
(if (seq s) (first s) (.-EMPTY PersistentArrayMap))))))

;;;; Clojure 1.13 destructuring

(def ^:private req-not-found #?(:cljd ^:unique (Object.)
:clj (Object.)
:cljs (js/Object.)))

(defn req!*
"Like arity-2 'get', but throws if key not present."
[m k]
(let [v (get m k req-not-found)]
(if (identical? v req-not-found)
(throw (new #?(:cljd ArgumentError
:clj IllegalArgumentException
:cljs js/Error)
(str "Missing required key: " (if (string? k) (pr-str k) k))))
v)))

(defn some-vals*
"Returns a map with only the non-nil values of map m. Returns nil if
m has no non-nil vals."
[m]
(reduce-kv
(fn [m k v] (if (some? v) (assoc m k v) m))
nil m))

#?(:clj (def clojure-version-var
(sci.impl.utils/dynamic-var
'*clojure-version* (update clojure.core/*clojure-version*
Expand Down Expand Up @@ -1809,6 +1834,7 @@
'reduce-kv (copy-core-var reduce-kv)
'reduced (copy-core-var reduced)
'reduced? (copy-core-var reduced?)
'req! (copy-var req!* clojure-core-ns {:name 'req!})
'reset! #?(:cljs (copy-core-var reset!)
:default (copy-var core-protocols/reset!* clojure-core-ns {:name 'reset!}))
'reset-thread-binding-frame-impl (new-var 'reset-thread-binding-frame-impl sci.impl.vars/reset-thread-binding-frame)
Expand All @@ -1830,6 +1856,7 @@
'simple-keyword? (copy-core-var simple-keyword?)
'simple-symbol? (copy-core-var simple-symbol?)
'some? (copy-core-var some?)
'some-vals (copy-var some-vals* clojure-core-ns {:name 'some-vals})
'some-> (macrofy 'some-> some->*)
'some->> (macrofy 'some->> some->>*)
'string? (copy-core-var string?)
Expand Down
Loading
Loading