Paste number 90409: lambda list parsing in Clojure

Index of paste annotations: 1 | 2 | 3

Paste number 90409: lambda list parsing in Clojure
Pasted by: gcv
When:9 months, 3 weeks ago
Share:Tweet this! | http://paste.lisp.org/+1XRD
Channel:None
Paste contents:
Raw Source | XML | Display As
(defn llt1 [req1 req2 & kw-args]
  (lambda-list [[:kw1 "one" kw1-supplied?] [:kw2] [:kw3 "three"]] kw-args
    [req1 req2 kw1 kw1-supplied? kw2 kw3]))


(defmacro lambda-list [ll args & body]
  (let [seq-ll    (map #(if (sequential? %) % [%]) ll)
        keywords  (map first seq-ll)
        symbols   (map #(-> % name symbol) keywords)
        defaults  (map second seq-ll)
        sym-vals  (apply hash-map (interleave symbols defaults))
        de-map    {:keys (vec symbols) :or sym-vals}
        suppl-req (reduce (fn [m [k v]] (assoc m k v)) (sorted-map)
                          (remove
                           (fn [[_ val]] (nil? val))
                           (partition 2 (interleave keywords
                                                    (map (comp second rest)
                                                         seq-ll)))))
        ;; sr-keys   (keys suppl-req)
        ;; sr-vals   (vals suppl-req)
        ]
     ;; XXX This is not working yet:
    `(let [args-map# (apply hash-map ~args)
           ~de-map args-map#]
       ;; TODO: This should be conditional on using supplieds in the first place!
       (apply (fn [~@(map (fn [x] '~'x) (vals suppl-req))] ; [~@sr-vals] ; [] ; [~@(vals suppl-req)]
                ~@body)
              (map #(contains? args-map# %) (keys ~suppl-req))))))

Annotations for this paste:

Annotation number 1: Fixes!
Pasted by: gcv
When:9 months, 3 weeks ago
Share:Tweet this! | http://paste.lisp.org/+1XRD/1
Paste contents:
Raw Source | Display As
;; The older paste sucked. Let's try again:

(defn llt1 [req1 req2 & kw-args]
  (lambda-list [[:kw1 "one" kw1-supplied?] :kw2 [:kw3 "three"]] kw-args
    [req1 req2 kw1 kw1-supplied? kw2 kw3]))

(defmacro lambda-list [ll args & body]
  (let [seq-ll    (map #(if (sequential? %) % [%]) ll)
        keywords  (map first seq-ll)
        symbols   (map #(-> % name symbol) keywords)
        defaults  (map second seq-ll)
        sym-vals  (apply hash-map (interleave symbols defaults))
        de-map    {:keys (vec symbols) :or sym-vals}
        suppl-req (reduce (fn [m [k v]] (assoc m k v)) (sorted-map)
                          (remove
                           (fn [[_ val]] (nil? val))
                           (partition 2 (interleave keywords
                                                    (map (comp second rest)
                                                         seq-ll)))))]
    `(let [args-map# (apply hash-map ~args)
           ~de-map args-map#]
       ;; TODO: This should be conditional on using supplieds in the first place!
       (apply (fn [~@(vals suppl-req)]
                ~@body)
              (map (fn [x#] (contains? args-map# x#)) [~@(keys suppl-req)])))))

Annotation number 2: Basically working now
Pasted by: gcv
When:9 months, 3 weeks ago
Share:Tweet this! | http://paste.lisp.org/+1XRD/2
Paste contents:
Raw Source | Display As
;; lambda list sample usage:
(defn lambda-list-test [req1 req2 & kw-args]
  (lambda-list [[:kw1 "kw1 default" kw1-supplied?]
                [:kw2 "kw2 default"]
                :kw3 ; defaults to nil
                [:kw4 nil kw4-supplied?]]
      kw-args
    ;; function body
    [req1 req2 kw1 kw1-supplied? kw2 kw3 kw4 kw4-supplied?]))


(defmacro lambda-list [ll args & body]
  (let [seq-ll    (map #(if (sequential? %) % [%]) ll)
        keywords  (map first seq-ll)
        symbols   (map #(-> % name symbol) keywords)
        defaults  (map second seq-ll)
        sym-vals  (apply hash-map (interleave symbols defaults))
        de-map    {:keys (vec symbols) :or sym-vals}
        suppl-req (reduce (fn [m [k v]] (assoc m k v)) (sorted-map)
                          (remove
                           (fn [[_ val]] (nil? val))
                           (partition 2 (interleave keywords
                                                    (map (comp second rest)
                                                         seq-ll)))))]
    (if (empty? suppl-req)
        `(let [args-map# (apply hash-map ~args)
               ~de-map args-map#]
           ~@body)
        `(let [args-map# (apply hash-map ~args)
               ~de-map args-map#]
           (apply (fn [~@(vals suppl-req)]
                    ~@body)
                  (map (fn [x#] (contains? args-map# x#)) [~@(keys suppl-req)]))))))

Annotation number 3: Better name
Pasted by: gcv
When:9 months, 3 weeks ago
Share:Tweet this! | http://paste.lisp.org/+1XRD/3
Paste contents:
Raw Source | Display As
;; sample usage:
(defn keyword-test [req1 req2 & kw-args]
  (fn-keywords [[:kw1 "kw1 default" kw1-supplied?]
                [:kw2 "kw2 default"]
                :kw3 ; defaults to nil
                [:kw4 nil kw4-supplied?]]
      kw-args
    ;; function body
    [req1 req2 kw1 kw1-supplied? kw2 kw3 kw4 kw4-supplied?]))


;; sample invocation
(keyword-test 1 2 :kw2 "not default" :kw4 "ok")


(defmacro fn-keywords [ll args & body]
  (let [seq-ll    (map #(if (sequential? %) % [%]) ll)
        keywords  (map first seq-ll)
        symbols   (map #(-> % name symbol) keywords)
        defaults  (map second seq-ll)
        sym-vals  (apply hash-map (interleave symbols defaults))
        de-map    {:keys (vec symbols) :or sym-vals}
        suppl-req (reduce (fn [m [k v]] (assoc m k v)) (sorted-map)
                          (remove
                           (fn [[_ val]] (nil? val))
                           (partition 2 (interleave keywords
                                                    (map (comp second rest)
                                                         seq-ll)))))]
    (if (empty? suppl-req)
        `(let [args-map# (apply hash-map ~args)
               ~de-map args-map#]
           ~@body)
        `(let [args-map# (apply hash-map ~args)
               ~de-map args-map#]
           (apply (fn [~@(vals suppl-req)]
                    ~@body)
                  (map (fn [x#] (contains? args-map# x#)) [~@(keys suppl-req)]))))))

Colorize as:
Show Line Numbers
Index of paste annotations: 1 | 2 | 3

Lisppaste pastes can be made by anyone at any time. Imagine a fearsomely comprehensive disclaimer of liability. Now fear, comprehensively.