hara.function provides methods for constructing functions.
Add to project.clj dependencies:
[hara/base "3.0.2"]All functions are in the hara.function namespace.
(use (quote hara.function))counts the number of non-varidic argument types
(defn arg-check
[f num]
(or (if-let [vc (varg-count f)]
(<= vc num))
(some #(= num %) (arg-count f))
(throw (ex-info (str "Function must accomodate " num " arguments")
{:function f}))))link
(arg-check (fn [x]) 1) => true (arg-check (fn [x & xs]) 1) => true (arg-check (fn [x & xs]) 0) => (throws Exception "Function must accomodate 0 arguments")
counts the number of non-varidic argument types
(defn arg-count
[f]
(let [ms (filter (fn [^Method mthd]
(= "invoke" (.getName mthd)))
(.getDeclaredMethods (class f)))
ps (map (fn [^Method m]
(.getParameterTypes m)) ms)]
(map alength ps)))link
(arg-count (fn [x])) => [1] (arg-count (fn [x & xs])) => [] (arg-count (fn ([x]) ([x y]))) => [1 2]
like `invoke` but reverses the function and first argument
(defn call
([obj] obj)
([obj f] (if (nil? f) obj (f obj)))
([obj f v1] (if (nil? f) obj (f obj v1)))
([obj f v1 v2] (if (nil? f) obj (f obj v1 v2)))
([obj f v1 v2 v3] (if (nil? f) obj (f obj v1 v2 v3)) )
([obj f v1 v2 v3 v4] (if (nil? f) obj (f obj v1 v2 v3 v4)))
([obj f v1 v2 v3 v4 & vs] (if (nil? f) obj (apply invoke f obj v1 v2 v3 v4 vs))))link
(call 2) => 2 (call 2 + 1 2 3) => 8
applies a list as a function to an argument vector
(defn form-apply
[form args]
(apply (form-fn form) args))link
(form-apply '(+ 1 %1 %2) [2 3]) => 6
evaluates a list as a functions and to a set of arguments.
(defn form-eval
[form & args]
(apply (form-fn form) args))link
(form-eval '(+ 1 %1 %2) 2 3) => 6
creates a function out of a list
(defn form-fn
[form]
(try (let [fform (form-prep form)]
(with-meta (eval fform) (meta fform)))
(catch clojure.lang.Compiler$CompilerException e
(throw (ex-info "Cannot evaluate form." {:input form})))))link
(def my-inc (form-fn '(+ 1 %))) (my-inc 1) => 2 (meta my-inc) => {:source "#(+ 1 %)n"}
executes `(f v1 ... vn)` if `f` is not nil
(defn invoke
([f] (if-not (nil? f) (f)))
([f v1] (if-not (nil? f) (f v1)))
([f v1 v2] (if-not (nil? f) (f v1 v2)))
([f v1 v2 v3] (if-not (nil? f) (f v1 v2 v3)))
([f v1 v2 v3 v4] (if-not (nil? f) (f v1 v2 v3 v4)))
([f v1 v2 v3 v4 & vs] (if-not (nil? f) (apply f v1 v2 v3 v4 vs))))link
(invoke nil 1 2 3) => nil (invoke + 1 2 3) => 6
message dispatch for object orientated type calling convention.
(defn message
([obj kw] (invoke (obj kw) obj))
([obj kw v1] (invoke (obj kw) obj v1))
([obj kw v1 v2] (invoke (obj kw) obj v1 v2))
([obj kw v1 v2 v3] (invoke (obj kw) obj v1 v2 v3))
([obj kw v1 v2 v3 v4] (invoke (obj kw) obj v1 v2 v3 v4))
([obj kw v1 v2 v3 v4 & vs] (apply invoke (obj kw) obj v1 v2 v3 v4 vs)))link
(def obj {:a 10 :b 20 :get-sum (fn [this] (+ (:b this) (:a this)))}) (message obj :get-sum) => 30
loose version of apply. Will adjust the arguments to put into a function
(defn op
[f & args]
(let [nargs (count args)
vargs (arg/varg-count f)]
(if (and vargs (>= nargs vargs))
(apply f args)
(let [fargs (arg/arg-count f)
candidates (filter #(<= % nargs) fargs)]
(if (empty? candidates)
(throw (ex-info "Arguments do not match" {:input args
:function fargs}))
(let [cnt (apply max candidates)]
(apply f (take cnt args))))))))link
(op + 1 2 3 4 5 6) => 21 (op (fn [x] x) 1 2 3) => 1 (op (fn [_ y] y) 1 2 3) => 2 (op (fn [_] nil)) => (throws Exception)
counts the number of arguments types before variable arguments
(defn varg-count
[f]
(if (some (fn [^Method mthd]
(= "getRequiredArity" (.getName mthd)))
(.getDeclaredMethods (class f)))
(.getRequiredArity ^RestFn f)))link
(varg-count (fn [x y & xs])) => 2 (varg-count (fn [x])) => nil
returns all functions that have been patched
(defn list-patched
[]
(set (keys @+original)))link
(patch #'hara.core.base.check/double? hara.core.base.check/double?) (-> (list-patched) (get #'hara.core.base.check/double?) boolean) => true
patches the existing function with a given one
(defn patch
[var f]
(when-not (get @+original var)
(state/update +original assoc var @var))
(doto var
(alter-var-root (constantly f))))link
(patch #'hara.core.base.check/double? (fn [x] (instance? Float x))) (hara.core.base.check/double? (float 1.0)) => true
creates an executable data type
(defmacro defexecutive
[name doc? attrs? & [fields settings & body]]
(let [[doc attrs fields {:keys [keep?] :as settings} & body]
(macro/create-args (concat [doc? attrs? fields settings]
body))]
(create-executive-form name fields settings body)))link
(declare hello-display hello-print) (def hello-invoke (fn [this & args] (str (.name this) " " (apply + args)))) (defexecutive -Hello- [name place date] {:tag "hello" :invoke hello-invoke :display hello-display :print hello-print}) ((-Hello-. "hello" nil nil) 1 2 3 4 5) => "hello 15"
customisable invocation forms
(defmacro definvoke
[name doc? & [attrs? & [params & body :as more]]]
(let [[doc attrs [label {:keys [refresh stable] :as config}] & body]
(macro/create-args (concat [doc? attrs?] more))]
(if (or refresh
(not (true? stable))
(not (resolve name)))
(invoke-intern label name (assoc (merge config attrs) :doc doc) body))))link
(definvoke -another- [:compose {:val (partial + 10) :arglists '([& more])}])
macro for an extensible `fn` form
(defmacro fn
[& body]
(let [type (or (:type (meta &form))
:clojure)]
(protocol.function/-fn-body type body)))link
(fn [x] x) => fn? ^{:type :function} (fn [x] x) => java.util.function.Function ^{:type :predicate} (fn [x] true) => java.util.function.Predicate
returns the arglists of a form
(defn form-arglists
[body]
(cond (list? (first body))
`(quote ~(map first body))
(vector? (first body))
`(quote ~(list (first body)))
:else
(throw (ex-info "Cannot find arglists." {:body body}))))link
(form-arglists '([x] x)) => '(quote ([x])) (form-arglists '(([x] x) ([x y] (+ x y)))) => '(quote ([x] [x y]))
allow macros to be applied to arguments just like functions
(defmacro applym
[macro & args]
(cons macro (#'clojure.core/spread (map eval args))))link
(applym const '((+ 1 2))) => 3 (macroexpand '(applym const '((+ 1 2)))) => 3
converts an expression into a constant at compile time
(defmacro const
[body]
(eval body))link
(const (+ 1 2)) => 3 (macroexpand '(const (+ 1 2))) => 3
caches the result of a function
(defn create-args
([[doc? attr? & more :as arglist]]
(let [[doc attr? more] (if (string? doc?)
[doc? attr? more]
["" doc? (cons attr? more)])
[attr more] (if (map? attr?)
[attr? more]
[{} (cons attr? more)])]
(->> more
(cons attr)
(cons doc)
(keep identity)))))link
(create-args '[[x] (inc x) nil nil]) => '("" {} [x] (inc x))
removes a cached result
(defn create-def-form
([name attrs body]
(let [name (with-meta name attrs)]
`(def ~name ~body)))
([name doc attrs arglist body]
(let [arglists (cond (nil? arglist)
nil
(vector? arglist)
`(quote ~(list arglist))
:else
`(quote ~arglist))]
(create-def-form name
(merge attrs
{:doc doc}
(if arglists {:arglists arglists}))
body))))link
(create-def-form 'hello "doc" {:added "1.3"} '[x] '(inc x)) '(do (def hello (inc x)) (clojure.core/doto (var hello) (clojure.core/alter-meta! clojure.core/merge {:added "1.3"} {:arglists (quote ([x])), :doc "doc"})))
used instead of `def` for functional composition
(defmacro defcompose
[name doc? attrs? & [arglist body]]
(->> (create-args [doc? attrs? arglist body])
(apply create-def-form name)))link
(defcompose -add-10- [x & more] (partial + 10)) (-add-10- 10) => 20
defines a map based lookup
(defmacro deflookup
[name doc? attrs? & [arglist lookup transfer?]]
(let [[doc attrs arglist & lookup-body]
(create-args [doc? attrs? arglist lookup transfer?])
body `(lookup ~@lookup-body)]
(create-def-form name doc attrs arglist body)))link
(deflookup -country- [city] {:kunming :china :melbourne :australia}) (-country- :kunming) => :china
creates a lookup function based on a map lookup
(defn lookup
([m] m)
([m {:keys [in out not-found] :as transfer}]
(cond (not (or in out not-found))
m
:else
(let [in (or in identity)
out (or out identity)]
(fn [input]
(out (get m (in input) not-found)))))))link
(def -opts- {:in (fn [s] (-> s (.toLowerCase) keyword)) :out name :not-found :no-reference}) (def -lookup- (lookup {:kunming :china :melbourne :australia} -opts-)) (-lookup- "MeLBoURne") => "australia"
defines a cached function
(defmacro defmemoize
[name doc? attrs? & body]
(let [[doc attrs & body]
(macro/create-args (concat [doc? attrs?] body))]
(invoke-intern-memoize :memoize name (assoc attrs :doc doc) body)))link
(defmemoize -dec- "decrements" {:added "1.0"} ([x] (dec x))) (-dec- 1) => 0 @+-dec- => '{(1) 0}
caches the result of a function
(defn memoize
([function cache var]
(memoize function cache var +registry (volatile! :enabled)))
([function cache var registry status]
(let [memfunction (fn [& args]
(if-let [e (find @cache args)]
(val e)
(let [ret (apply function args)]
(state/update cache assoc args ret)
ret)))]
(Memoize. function memfunction cache var registry status))))link
(ns-unmap *ns* '+-inc-) (ns-unmap *ns* '-inc-) (def +-inc- (atom {})) (declare -inc-) (def -inc- (memoize inc +-inc- #'-inc-)) (-inc- 1) => 2 (-inc- 2) => 3
adds an entry to the multimethod
(defn multi-add
[multi dispatch-val method]
(let [dispatch-fn (.dispatchFn multi)]
(if (multi-match? dispatch-fn method true)
(doto multi (.addMethod dispatch-val method)))))link
(multi-add world :c (fn [m] (assoc m :c 3))) => world
creates a multimethod from an existing one
(defn multi-clone
[source name]
(let [table (.getMethodTable source)
clone (MultiFn. name
(.dispatchFn source)
(.defaultDispatchVal source)
(.hierarchy source))]
(doseq [[dispatch-val method] table]
(.addMethod clone dispatch-val method))
clone))link
(defmulti hello :type) (defmethod hello :a [m] (assoc m :a 1)) (def world (multi-clone hello "world")) (defmethod world :b [m] (assoc m :b 2)) (world {:type :b}) => {:type :b :b 2} ;; original method should not be changed (hello {:type :b}) => (throws)
returns all entries in the multimethod
(defn multi-get
[multi dispatch]
(get (.getMethodTable multi) dispatch))link
(multi-get world :b) => fn?
returns `true` if the multimethod contains a value for dispatch
(defn multi-has?
[^MultiFn multi val]
(some #(= % val) (keys (.getMethodTable multi))))link
(multi-has? print-method Class) => true
returns all keys for a given multimethod
(defn multi-keys
[^MultiFn multi]
(set (keys (.getMethodTable multi))))link
(multi-keys world) => #{:a :b}
returns all entries in the multimethod
(defn multi-list
[multi]
(.getMethodTable multi))link
(multi-list world) => (satisfies [:a :b] (comp vec sort keys))
checks if the multi dispatch matches the arguments
(defn multi-match?
([multi method]
(multi-match? multi method false))
([multi method throw?]
(let [multi-args (set (arg/arg-count multi))
multi-vargs (arg/varg-count multi)
method-args (set (arg/arg-count method))
method-vargs (arg/varg-count method)]
(boolean (or (seq (set/intersection multi-args method-args))
(and multi-vargs (some #(<= % multi-vargs) method-args))
(and method-vargs (some #(> % method-vargs) multi-args))
(and multi-vargs method-vargs (<= method-vargs multi-vargs))
(if throw?
(throw (ex-info "Function args are not the same."
{:multi {:args multi-args
:vargs multi-vargs}
:method {:args method-args
:vargs method-vargs}}))))))))link
(multi-match? (.dispatchFn string/-from-string) (fn [_ _ _])) => true (multi-match? (.dispatchFn string/-from-string) (fn [_]) true) => (throws)