daily pastebin goal
56%
SHARE
TWEET

Untitled

a guest Oct 11th, 2018 62 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. (defn procedure-applies-to-animal??*
  2.   [desired-count &
  3.    {:keys [procedure animal]
  4.     :or {procedure (l/lvar)
  5.          animal (l/lvar)}
  6.     :as args}]
  7.   (let [desired-keys  (remove #(contains? (set (keys args)) %) [:animal :procedure])
  8.         qvar (gensym "q-")
  9.         gensyms {:animal (gensym "animal-"), :procedure (gensym "procedure-")}
  10.         setter (case (count desired-keys)
  11.                      0 `(l/== true ~qvar)
  12.                      1 `(l/== ~(gensyms (first desired-keys)) ~qvar)
  13.                        `(l/== (list ~(gensyms :procedure)
  14.                                     ~(gensyms :animal)) ~qvar))
  15.         runner (cond (zero? (count desired-keys))  '(l/run 1)
  16.                      (= :all desired-count)        '(l/run*)
  17.                      :else                         `(l/run ~desired-count))
  18.  
  19.         core-calculation
  20.         `(~@runner [~qvar]
  21.                  (l/fresh [~(gensyms :procedure) ~(gensyms :animal)]
  22.                           (procedure-applies-to-animal-o ~(gensyms :procedure)
  23.                                                          ~(gensyms :animal))
  24.                           (l/== ~(gensyms :procedure) ~procedure)
  25.                           (l/== ~(gensyms :animal) ~animal)
  26.                           ~setter))]
  27.     (if (zero? (count desired-keys))
  28.       `(not (empty? ~core-calculation))
  29.       core-calculation)))
  30.  
  31. (defmacro procedure-applies-to-animal?? [& args]
  32.   ( (partial apply procedure-applies-to-animal??*)
  33.     (if (number? (first args)) args (cons :all args))))
  34.  
  35. (defmacro first-procedure-applies-to-animal?? [& args]
  36.   `(first ~( (partial apply procedure-applies-to-animal??* 1) args)))
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top