Destructuring in loop bindings

[bobbicodes]

Other than the lazy evaluation stuff, this is currently the biggest weak point, and I've spent several weeks figuring out how it works because Clojure's destructure function is pretty hairy. Fortunately, I managed to gain some traction by breaking it apart into chunks. Once I did that it magically became clear. I'll start from the bottom up:

(defn destructure [bindings]
  (let* [bents (partition 2 bindings)
         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 (str "Unsupported binding key: " (ffirst kwbs)))
            (reduce process-entry [] bents)))))

It begins by initializing an empty vector which will become the output bindings, and passes it to pb ("process builder"? "partitioned bindings"?) which is a reducing function:

(defn pb [bvec b v]
  (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 (str "Unsupported binding form: " b))))

Here it dispatches to various functions depending on whether the binding key is a symbol, keyword, vector or map. I started with pvec because it is the most commonly used (and also the simpler one):

(defn pvec [bvec b val]
  (let [gvec (gensym "vec__")
        gseq (gensym "seq__")
        gfirst (gensym "first__")
        has-rest (has-rest? 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 "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))))

I pretty much didn't have to change anything. I had to make my own has-rest? function which is a hack because (some #{'&} b) doesn't work because it doesn't yet recognize equal symbols as equal. But it's pretty simple, and seems to work when connected to the let macro:

(defmacro let [bindings & body]
  `(let* ~(destructure bindings) ~@body))

Proof:

(let [[a b] [1 2]]
  a)
=> 1

The pmap function for associative destructuring is much more intimidating, which I'm realizing is likely because there are a lot of special features that were probably added over time, like support for keyword arguments, see https://clojure.org/guides/destructuring#_keyword_arguments

That part of the docs was helpfully mentioned in the comment for createAsIfByAssoc (part of the clojure map data structure) which is used by the seq-to-map-for-destructuring function. I'm not sure how it differs from assoc. This confused me for a long time until I realized that this is only to support the special case when you want to be able to pass a seq of keys/values to a function that uses associative destructuring, which I'm perfectly fine with leaving out for now. Here's the pmap function, broken out, with that part removed (and another bit that adds name metadata to locals, since we don't have the INamed protocol or whatever):

(defn pmap [bvec b v]
  (let* [gmap (gensym "map__")
         defaults (:or b)]
        (loop [ret (-> bvec (conj gmap) (conj v)
                       (conj gmap) (conj 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 bb
                   bv (if (contains? defaults local)
                        (list `get gmap bk (defaults local))
                        (list `get gmap bk))]
                  (recur
                   (if (or (keyword? bb) (symbol? bb))
                     (-> ret (conj local bv))
                     (pb ret bb bv))
                   (next bes)))
            ret))))

I haven't even tested it yet but I see no obvious reason why it wouldn't work.

[bobbicodes]

For wiring up destructuring to work in function calls, we're going to need this stuff:

(defn ^{:private true}
  maybe-destructured
  [params body]
  (if (every? symbol? params)
    (cons params body)
    (loop [params params
           new-params (with-meta [] (meta params))
           lets []]
      (if params
        (if (symbol? (first params))
          (recur (next params) (conj new-params (first params)) lets)
          (let [gparam (gensym "p__")]
            (recur (next params) (conj new-params gparam)
                   (-> lets (conj (first params)) (conj gparam)))))
        `(~new-params
          (let ~lets
            ~@body))))))

;redefine fn with destructuring and pre/post conditions
(defmacro fn
  "params => positional-params*, or positional-params* & rest-param
  positional-param => binding-form
  rest-param => binding-form
  binding-form => name, or destructuring-form

  Defines a function.

  See https://clojure.org/reference/special_forms#fn for more information"
  {:added "1.0", :special-form true,
   :forms '[(fn name? [params* ] exprs*) (fn name? ([params* ] exprs*)+)]}
  [& sigs]
    (let [name (if (symbol? (first sigs)) (first sigs) nil)
          sigs (if name (next sigs) sigs)
          sigs (if (vector? (first sigs)) 
                 (list sigs) 
                 (if (seq? (first sigs))
                   sigs
                   ;; Assume single arity syntax
                   (throw (IllegalArgumentException. 
                            (if (seq sigs)
                              (str "Parameter declaration " 
                                   (first sigs)
                                   " should be a vector")
                              (str "Parameter declaration missing"))))))
          psig (fn* [sig]
                 ;; Ensure correct type before destructuring sig
                 (when (not (seq? sig))
                   (throw (IllegalArgumentException.
                            (str "Invalid signature " sig
                                 " should be a list"))))
                 (let [[params & body] sig
                       _ (when (not (vector? params))
                           (throw (IllegalArgumentException. 
                                    (if (seq? (first sigs))
                                      (str "Parameter declaration " params
                                           " should be a vector")
                                      (str "Invalid signature " sig
                                           " should be a list")))))
                       conds (when (and (next body) (map? (first body))) 
                                           (first body))
                       body (if conds (next body) body)
                       conds (or conds (meta params))
                       pre (:pre conds)
                       post (:post conds)                       
                       body (if post
                              `((let [~'% ~(if (< 1 (count body)) 
                                            `(do ~@body) 
                                            (first body))]
                                 ~@(map (fn* [c] `(assert ~c)) post)
                                 ~'%))
                              body)
                       body (if pre
                              (concat (map (fn* [c] `(assert ~c)) pre) 
                                      body)
                              body)]
                   (maybe-destructured params body)))
          new-sigs (map psig sigs)]
      (with-meta
        (if name
          (list* 'fn* name new-sigs)
          (cons 'fn* new-sigs))
        (meta &form))))

[bobbicodes]

Basic map destructuring now works:

(def client {:name "Super Co."
             :location "Philadelphia"
             :description "The worldwide leader in plastic tableware."})

(let [{name :name
       location :location
       description :description} client]
  [name location description])
=> ["Super Co." "Philadelphia" "The worldwide leader in plastic tableware."]

It also works with strings and symbols as map keys. But still need to handle the special transforms

(let [{:keys [w b]} {:w [2 4] :b [6 6]}]
  [w b])
=> 
Error: 'w' not found

[bobbicodes]

This feature is basically done! All I left out was the special keyword arguments syntax, which is mainly just used for CLIs so I don't really care.

There's just a small thing that I discovered while getting the :keys syntax to work that is still a bit of a mystery. For some reason this fails:

((key (first {:keys '[name location description]}))
 {:keys '[name location description]})
=> 
Error: 'location' not found 

So I had to change it to

(get {:keys '[name location description]}
  (key (first {:keys '[name location description]})))
=> [name location description]

Which is weird. But it has nothing to do with destructuring so I'm going to close this and make another issue for that. Go team

[bobbicodes]

Wait... I should leave this open until I actually get it working in functions. We're not done yet.

[bobbicodes]

Alright, seems like we're good to go! Proof:

(def client {:name "Super Co."
             :location "Philadelphia"
             :description "The worldwide leader in plastic tableware."})

(defn destructure-test
  [{:keys [name location description]}]
  (str name location "-" description))

(destructure-test client)
=> "Super Co.Philadelphia-The worldwide leader in plastic tableware."

[bobbicodes]

Just realized I implemented destructuring in fn definitions but I forgot about loop.

Here is the Clojure source, which might just drop in:

(defmacro loop
  "Evaluates the exprs in a lexical context in which the symbols in
  the binding-forms are bound to their respective init-exprs or parts
  therein. Acts as a recur target."
  {:added "1.0", :special-form true, :forms '[(loop [bindings*] exprs*)]}
  [bindings & body]
    (assert-args
      (vector? bindings) "a vector for its binding"
      (even? (count bindings)) "an even number of forms in binding vector")
    (let [db (destructure bindings)]
      (if (= db bindings)
        `(loop* ~bindings ~@body)
        (let [vs (take-nth 2 (drop 1 bindings))
              bs (take-nth 2 bindings)
              gs (map (fn [b] (if (symbol? b) b (gensym))) bs)
              bfs (reduce1 (fn [ret [b v g]]
                            (if (symbol? b)
                              (conj ret g v)
                              (conj ret g v b g)))
                          [] (map vector bs vs gs))]
          `(let ~bfs
             (loop* ~(vec (interleave gs gs))
               (let ~(vec (interleave bs gs))
                 ~@body)))))))

Of course it will take some reorganizing. We'll rename the special form to loop*, and will probably need a temporary bootstrap loop macro without destructuring, since so many core functions use it.

[bobbicodes]

Completed by https://github.com/bobbicodes/bien/commit/af1a3e4a05cebde769730535beb64b4ed8663fba