Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Handling :& in destructuring maps
(def ^:private reduce1 @#'clojure.core/reduce1)
(use 'clojure.pprint)
(declare disentangle)
(defn- disentangle-sequential [binding-form]
(let [as (->> binding-form (drop-while #(not= % :as)) second)
more (->> binding-form (drop-while #(not= % '&)) second)
items (->> binding-form (remove (set (remove nil? [:as '& as more])))
vec)]
(->> {:items items :as as :more more}
(filter val)
(into {}))))
(defn- disentangle-associative [binding-form]
(let [as (binding-form :as)
or (binding-form :or)
ks (binding-form :keys)
others (dissoc binding-form :as :or :keys)
items (vec (distinct (concat ks (keys others))))
mapping (merge (zipmap ks (map keyword ks))
others)]
(->> {:items items :as as :or or :mapping mapping}
(filter val)
(into {}))))
(defn disentangle
"Parses one level of destructuring.
```clojure
(disentangle '[a b & [c]])
=> '{:items [a b], :more [c]}
(disentangle '{:keys [a] b :b [c1 c2] :c :or {d 1} :as m})
=> '{:items [a b [c1 c2]],
:as m,
:or {d 1},
:mapping {a :a, b :b, [c1 c2] :c}}
```"
[binding-form]
(cond
(or (sequential? binding-form) (nil? binding-form))
( disentangle-sequential binding-form)
(map? binding-form)
( disentangle-associative binding-form)
:else (throw (Exception. (str "Cannot disentangle " binding-form)))))
;; To highlight modifications ...
(defmacro ---HERE--------------------- [& body]
`(do ~@body))
;; ... to the source code of clojure.core/destructure
;; Note: Here the goal is to support a :& key in destructuring maps.
(defn destructure& [bindings]
(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 (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
(list `nth gvec n nil)))
(inc n)
(next bs)
seen-rest?))))
ret))))
pmap
(fn [bvec b v]
(let [gmap (gensym "map__")
gmapseq (with-meta gmap {:tag 'clojure.lang.ISeq})
defaults (:or b)]
(loop [ret (-> bvec (conj gmap) (conj v)
(conj gmap) (conj `(if (seq? ~gmap) (clojure.lang.PersistentHashMap/create (seq ~gmapseq)) ~gmap))
((fn [ret]
(let [ret (if (:as b)
(conj ret (:as b) gmap)
ret)
ret (---HERE---------------------
(if (:& b)
(conj ret
(:& b)
`(dissoc ~gmap ~@(-> (select-keys b [:keys :syms :strs])
(assoc :inline (-> b disentangle :mapping (dissoc :&) vals))
(->> (mapcat (fn [[k vs]]
(case k
(:inline :keys) (map keyword vs)
:sym (map #(do `(quote ~(symbol (name %)))) vs)
:strs (map name vs))))
vec))))
ret))]
ret))))
bes (let [transforms
(reduce1
(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))]
(reduce1
(fn [bes entry]
(reduce1 #(assoc %1 %2 ((val entry) %2))
(dissoc bes (key entry))
((key entry) bes)))
(dissoc b :as :or
(---HERE---------------------
:&))
transforms))]
(if (seq bes)
(let [bb (key (first bes))
bk (val (first bes))
local (if (instance? clojure.lang.Named 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 (ident? bb)
(-> ret (conj local bv))
(pb ret bb bv))
(next bes)))
ret))))]
(cond
(symbol? b) (-> bvec (conj b) (conj v))
(vector? b) (pvec bvec b v)
(map? b) (pmap bvec b v)
:else (throw (new Exception (str "Unsupported binding form: " b))))))
process-entry (fn [bvec b] (pb bvec (first b) (second b)))]
(if (every? symbol? (map first bents))
bindings
(reduce1 process-entry [] bents))))
(let [destr (destructure& '[{:keys [a b] :& more} {:a 1 :b 2 :c 3 :d 4}])]
; (pprint destr) (newline)
(comment
[map__7307
{:a 1, :b 2, :c 3, :d 4}
map__7307
(if
(clojure.core/seq? map__7307)
(clojure.lang.PersistentHashMap/create (clojure.core/seq map__7307))
map__7307)
more
(clojure.core/dissoc map__7307 [:a :b])
a
(clojure.core/get map__7307 :a)
b
(clojure.core/get map__7307 :b)]))
(defmacro let& [bindings & body]
`(let ~(destructure& bindings)
~@body))
(require '[clojure.spec.alpha :as s])
(s/def ::may-bindings
(s/+ (s/cat
:style (s/? keyword?)
:binding-expr #(or (symbol? %) (map? %) (vector? %))
:bound-expr any?)))
(defn may* [[{:keys [:style :binding-expr :bound-expr]} & more-bindings] body]
`(~(or (some->> (some-> style str
(as-> $ (if (= (first $) \:)
(rest $)
$)))
(apply str) symbol)
'clojure.core/let)
[~binding-expr ~bound-expr]
~@(if (empty? more-bindings)
body
[(may* more-bindings body)])))
(defmacro may [bindings & body]
(let [bds (s/conform ::may-bindings bindings)]
(may* bds body)))
(may [ the-map {:a 1 :b 2 :c [3] :d 4}
:let& {:keys [a] bb :b [c] :c :& more} the-map]
(println "the-map" the-map)
(comment the-map {:a 1, :b 2, :c [3], :d 4})
(println "[a bb c]" [a bb c])
(comment [1 2 3])
(println "more" more)
(comment more {:d 4}))
(newline)(newline)
(let& [{c :c
b :b
:as m
{aa :aa
:as nm} :a}
{:a {:aa :aa :bb :bb} :b :b :c :c}]
(println "[aa b c]" [aa b c])
(comment [aa b c] [:aa :b :c])
(println "[m nm]" [m nm])
(comment [m nm] [{:a {:aa :aa :bb :bb} :b :b :c :c} {:aa :aa :bb :bb}]))
(newline)(newline)
(let& [{:keys [b c] :& m
{:keys [aa] :& nm} :a}
{:a {:aa :aa :bb :bb} :b :b :c :c}]
(println "[aa b c]" [aa b c])
(comment [aa b c] [:aa :b :c])
(println "[m nm]" [m nm])
(comment [m nm] [{} {:bb :bb}]))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.