Skip to content

Commit

Permalink
optimize seq (&) destructuring
Browse files Browse the repository at this point in the history
  • Loading branch information
@richhickey
richhickey committed May 28, 2016
1 parent acd7c7a commit 0aa3467
Showing 1 changed file with 73 additions and 59 deletions.
132 changes: 73 additions & 59 deletions src/clj/clojure/core.clj
View file
Expand Up @@ -4255,68 +4255,82 @@
([& keyvals]
(clojure.lang.PersistentArrayMap/createAsIfByAssoc (to-array keyvals))))

;redefine let and loop with destructuring
;;redefine let and loop with destructuring
(defn destructure [bindings]
(let [bents (partition 2 bindings)
pb (fn pb [bvec b v]
(let [pvec
(fn [bvec b val]
(let [gvec (gensym "vec__")]
(loop [ret (-> bvec (conj gvec) (conj val))
n 0
bs b
seen-rest? false]
(if (seq bs)
(let [firstb (first bs)]
(cond
(= firstb '&) (recur (pb ret (second bs) (list `nthnext gvec n))
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 ret firstb (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]
(if (:as b)
(conj ret (:as b) gmap)
ret))))
bes (reduce1
(fn [bes entry]
(reduce1 #(assoc %1 %2 ((val entry) %2))
(dissoc bes (key entry))
((key entry) bes)))
(dissoc b :as :or)
{:keys #(if (keyword? %) % (keyword (str %))),
:strs str, :syms #(list `quote %)})]
(if (seq bes)
(let [bb (key (first bes))
bk (val (first bes))
bv (if (contains? defaults bb)
(list `get gmap bk (defaults bb))
(list `get gmap bk))]
(recur (cond
(symbol? bb) (-> ret (conj (if (namespace bb) (symbol (name bb)) bb)) (conj bv))
(keyword? bb) (-> ret (conj (symbol (name bb)) bv))
:else (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))))))
(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]
(if (:as b)
(conj ret (:as b) gmap)
ret))))
bes (reduce1
(fn [bes entry]
(reduce1 #(assoc %1 %2 ((val entry) %2))
(dissoc bes (key entry))
((key entry) bes)))
(dissoc b :as :or)
{:keys #(if (keyword? %) % (keyword (str %))),
:strs str, :syms #(list `quote %)})]
(if (seq bes)
(let [bb (key (first bes))
bk (val (first bes))
bv (if (contains? defaults bb)
(list `get gmap bk (defaults bb))
(list `get gmap bk))]
(recur (cond
(symbol? bb) (-> ret (conj (if (namespace bb) (symbol (name bb)) bb)) (conj bv))
(keyword? bb) (-> ret (conj (symbol (name bb)) bv))
:else (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
Expand Down

1 comment on commit 0aa3467

@Josh-Tilles
Copy link

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

In case anyone else in the future wants to review this commit more easily, here are a couple tips for viewing the diff without the whitespace changes:

Please sign in to comment.