restructuring destructuring

destructuring.clj

(defmulti destruct-type
  (fn [binding value]
    (cond (sequential? binding) clojure.lang.Sequential ; order matters, vector is associative too
          (associative? binding) clojure.lang.Associative
          :else (type binding))))

(defn coerce-binding-type [binding-type]
  (case binding-type
    :strs str
    :syms (fn [sym] `'~sym)
    :keys keyword))

(defmethod destruct-type clojure.lang.Associative
  [binding valmap]
  (let* [x (gensym)
         defaults (get binding :or)
         as-binding (get binding :as)
         shortcut-binding (some #{:strs :syms :keys} (keys binding))
         shortcut-val (get binding shortcut-binding)
         binding (dissoc binding :as :or :keys :strs :syms)
         maybe-map `(if (seq? ~x) (apply hash-map ~x) ~x)]
    (concat [x valmap x maybe-map]
            (when as-binding [as-binding x])
            (when shortcut-binding (mapcat (fn [kb]
                                             [kb `(get ~x ~((coerce-binding-type
                                                             shortcut-binding) kb)
                                                       ~(when defaults
                                                          (get defaults kb)))])
                                           shortcut-val))
            (mapcat (fn [b v]
                      (if (or (sequential? b) (map? b))
                        (destruct-type b `(get ~x ~v)) ; not sure yet if :or defaults needed here
                        [b `(get ~x ~v ~(when defaults
                                          (get defaults (-> v name symbol))))]))
                    (keys binding)
                    (vals binding)))))

(clojure.pprint/pprint (destruct-type '{:syms [a b c x]}
                                      '{'a 9 'x ["1" "2" "*" "?" "?"]}))

(defn handle-special-bindings [bindings]
  (let [special (set (filter #{:as '&} bindings))
        p0 (first bindings)
        p2 (nth bindings 2 nil)
        pneg2 (->> bindings (take-last 2) first)]
    (cond (= special #{:as '&})
          (if (= p0 '&)
            bindings
            (throw (IllegalArgumentException.
                    "& may only be followed by :as bindings")))

          (= special #{'&})
          (if (= pneg2 '&)
            (take-last 2 bindings)
            (throw (IllegalArgumentException.
                    "& may only be followed by :as bindings")))

          (= special #{:as})
          (if (= pneg2 :as)
            (take-last 2 bindings)
            (throw (IllegalArgumentException.
                    ":as bindings may only appear at end of sequential binding form"))))))

(let [[a & {:keys [b c]}] [10 :b 10 :c 20]]
  [a b c])
;; if contains :as, throw error if as not at end
;; else
(handle-special-bindings '[& ds :as all])
(handle-special-bindings '[a & x :as]) ; fix
(handle-special-bindings '[:as all & ds])
(handle-special-bindings '[b c :as all])
(handle-special-bindings '[a c & ds])
(handle-special-bindings '[a b c :as])
(handle-special-bindings '[a c d &])
(handle-special-bindings '[x y z])
(handle-special-bindings '[a :as all b])
(handle-special-bindings  '[a b c &])
(handle-special-bindings  '[a b c :as])
(handle-special-bindings  '[a c & :as])


(defmethod destruct-type clojure.lang.Sequential
  [binding value]
  (let* [x (gensym)
         end-bindings (take-last 4 binding)
         special-bindings? (some #{:as '&} end-bindings)
         special (when special-bindings?
                   (handle-special-bindings end-bindings))
         new-binding (if special
                       (drop-last (count special) binding)
                       binding)
         new-value (if special
                     `(take ~(count new-binding) ~value)
                     value)]
    (concat [x new-value]
            (apply concat
                   (when (= (first special) '&) ; & foo :as all | & foo | :as all
                     (destruct-type (second special) ; if next binding is map, apply hashmap to val
                                    `(nthrest ~value ~(count new-binding)))) ; TODO: bind this?
                   (when (= (first special) :as)
                     [(second special) value])
                   (when (= (nth special 2 nil) :as)
                     [(last special) value])
                   (map-indexed (fn [i b]
                                  (destruct-type b `(nth ~x ~i nil)))
                                new-binding)))))
;; only as after, but if as before silent failure binding
(mylet [[a & x :as] (range 23)]) (let [nil 10]) ;; note this, tries to bind nil after :as
(let [[:as x y] (range 10)] [x ])
(let [[x y z zs :as all] (range 3)] [x y z zs all])
(mylet [[a b & cs :as all] [1 2 3 4]] [a b cs all])
(mylet [[a :as all b] (range 20)] [a b all]) ;; my error is better

(defmethod destruct-type clojure.lang.Symbol
  [binding value]
  (vector binding value))

;; add later to show extension
(defmethod destruct-type java.lang.String
  [binding value]
  (destruct-type (seq binding) value))

(defmethod destruct-type java.lang.Character
  [binding value]
  (vector binding value))

(defn destruct [bindings]
  (vec (mapcat (fn [b] (destruct-type (first b) (second b)))
               (partition 2 bindings))))

(defmacro mylet [bindings & exprs]
  `(let ~(destruct bindings) ~@exprs))

(mylet [{a :a b :b c :c [f g & [h & zs]] :x
         :or {b 2 c 3}}
        {:a 9 :x ["1" "2" "*" "?" "?"]}]
       [a b c f g h zs])

(clojure.pprint/pprint
 (destruct-type '{a :a b :b c :c [f g & [h & zs]] :x
                  :or {b 2 c 3}}
                '{:a 9 :x ["1" "2" "*" "?" "?"]}))

(mylet [{:keys [a b c x]
         :or {b 2 c 3}}
        {:a 9 :x ["1" "2" "*" "?" "?"]}]
       [a b c x])

(mylet [{:syms [a b c x]
         :or {b 2 c 3}}
        {'a 9 'x ["1" "2" "*" "?" "?"]}]
       [a b c x])

(mylet [{:strs [a b c x]
         :or {b 2 c 3}}
        {"a" 9 "x" ["1" "2" "*" "?" "?"]}]
       [a b c x])

(clojure.pprint/pprint
 (macroexpand-1 '(mylet [{:keys [a b c x]
                          :or {b 2 c 3}
                          :as all}
                         {:a 9 :x ["1" "2" "*" "?" "?"]}]
                        [a b c x])))
;; coerce binding val to map if seq for every case when binding form is a map
;; not just when & {:a 1 ..} like keyword args.  Seems this are treated as 2
;; diff implementations - one allowing map destruct of seqs generally, another

(clojure.pprint/pprint
 (macroexpand-1 '(mylet [{:keys [a b c] :or {b 100}} '(:a 1 :c 3)]
                   [a b c])))
(mylet [[x y [z & zs :as all] {:keys [a b c] :or {b 100}}] [10 20 [30 40 50] '(:a 1 :c 3)]]
       [a b c x y z zs all])
(let [[x & {:keys [a b c]}]  [100 :a 1 :b 2 :c 3]]
  [x a b c])
((fn [a & {:keys [a b c]}] [a b c]) 100 :a 1 :b 2 :c 3)
(get '(:a 1 :b 2) :a)
(defmacro defun [fname argv & body]
  `(def ~fname (fn ~argv ~@body)))
(macroexpand-1 '(defun foo [x] (* x 10 3)))
(defun foo [x] (* x 10 3))
(foo 10)
(let [[a b & cs :as all] (range 20)]
  [a b cs all])
(let [[a b & cs :as all] (range 20)]
  [a b cs all])
(mylet [[a b & cs :as all] (range 20)]
  [a b cs all])
(macroexpand-1 '(mylet [[a :as all b] (range 20)]
                  [a b all]))