function methods for execution

Author: Chris Zheng  (z@caudate.me)
Date: 27 November 2018
Repository: https://github.com/zcaudate/hara
Version: 3.0.2

1    Introduction

hara.function provides methods for constructing functions.

1.1    Installation

Add to project.clj dependencies:

[hara/base "3.0.2"]

All functions are in the hara.function namespace.

 (use (quote hara.function))

2    General



arg-check ^

counts the number of non-varidic argument types

v 3.0
(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")

arg-count ^

counts the number of non-varidic argument types

v 3.0
(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]

call ^

like `invoke` but reverses the function and first argument

v 3.0
(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

form-apply ^

applies a list as a function to an argument vector

v 3.0
(defn form-apply
  [form args]
  (apply (form-fn form) args))
link
(form-apply '(+ 1 %1 %2) [2 3]) => 6

form-eval ^

evaluates a list as a functions and to a set of arguments.

v 3.0
(defn form-eval
  [form & args]
  (apply (form-fn form) args))
link
(form-eval '(+ 1 %1 %2) 2 3) => 6

form-fn ^

creates a function out of a list

v 3.0
(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"}

invoke ^

executes `(f v1 ... vn)` if `f` is not nil

v 3.0
(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 ^

message dispatch for object orientated type calling convention.

v 3.0
(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

op ^

loose version of apply. Will adjust the arguments to put into a function

v 3.0
(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)

varg-count ^

counts the number of arguments types before variable arguments

v 3.0
(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

vargs? ^

checks that function contain variable arguments

v 3.0
(defn vargs?
  [^Fn f]
  (if (some (fn [^Method mthd]
              (= "getRequiredArity" (.getName mthd)))
            (.getDeclaredMethods (class f)))
    true
    false))
link
(vargs? (fn [x])) => false (vargs? (fn [x & xs])) => true

3    Hook



list-patched ^

returns all functions that have been patched

v 3.0
(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

patch ^

patches the existing function with a given one

v 3.0
(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

patched? ^

checks if an existing function has been patched

v 3.0
(defn patched?
  [var]
  (boolean (get @+original var)))
link
(patched? #'hara.core.base.check/double?) => true

unpatch ^

removes the patch creates for the var

v 3.0
(defn unpatch
  [var]
  (when-let [f (get @+original var)]
    (alter-var-root var (constantly f))
    (state/update +original dissoc var)
    f))
link
(unpatch #'hara.core.base.check/double?) (hara.core.base.check/double? (float 1.0)) => false

4    Invoke



defexecutive ^

creates an executable data type

v 3.0
(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"

definvoke ^

customisable invocation forms

v 3.0
(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])}])

fn ^

macro for an extensible `fn` form

v 3.0
(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

form-arglists ^

returns the arglists of a form

v 3.0
(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]))

5    Macro



applym ^

allow macros to be applied to arguments just like functions

v 3.0
(defmacro applym
  [macro & args]
  (cons macro (#'clojure.core/spread (map eval args))))
link
(applym const '((+ 1 2))) => 3 (macroexpand '(applym const '((+ 1 2)))) => 3

const ^

converts an expression into a constant at compile time

v 3.0
(defmacro const
  [body]
 (eval body))
link
(const (+ 1 2)) => 3 (macroexpand '(const (+ 1 2))) => 3

create-args ^

caches the result of a function

v 3.0
(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))

create-def-form ^

removes a cached result

v 3.0
(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"})))

defcompose ^

used instead of `def` for functional composition

v 3.0
(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

deflookup ^

defines a map based lookup

v 3.0
(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

lookup ^

creates a lookup function based on a map lookup

v 3.0
(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"

6    Memoize



defmemoize ^

defines a cached function

v 3.0
(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}

memoize ^

caches the result of a function

v 3.0
(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

memoize-clear ^

clears all results

v 3.0
(defn memoize-clear
  [^Memoize mem]
  (let [cache (.cache mem)
        v (state/get cache)]
    (state/empty cache {})
    v))
link
(memoize-clear -inc-) => '{(2) 3}

memoize-remove ^

removes a cached result

v 3.0
(defn memoize-remove
  ([^Memoize mem & args]
   (let [cache (.cache mem)
         v (get @cache args)]
     (state/update cache dissoc args)
     v)))
link
(memoize-remove -inc- 1) => 2

7    Multi



multi-add ^

adds an entry to the multimethod

v 3.0
(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

multi-clone ^

creates a multimethod from an existing one

v 3.0
(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)

multi-get ^

returns all entries in the multimethod

v 3.0
(defn multi-get
  [multi dispatch]
  (get (.getMethodTable multi) dispatch))
link
(multi-get world :b) => fn?

multi-has? ^

returns `true` if the multimethod contains a value for dispatch

v 3.0
(defn multi-has?
  [^MultiFn multi val]
  (some #(= % val) (keys (.getMethodTable multi))))
link
(multi-has? print-method Class) => true

multi-keys ^

returns all keys for a given multimethod

v 3.0
(defn multi-keys
  [^MultiFn multi]
  (set (keys (.getMethodTable multi))))
link
(multi-keys world) => #{:a :b}

multi-list ^

returns all entries in the multimethod

v 3.0
(defn multi-list
  [multi]
  (.getMethodTable multi))
link
(multi-list world) => (satisfies [:a :b] (comp vec sort keys))

multi-match? ^

checks if the multi dispatch matches the arguments

v 3.0
(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)

multi-remove ^

removes an entry

v 3.0
(defn multi-remove
  [multi dispatch]
  (let [method (multi-get multi dispatch)]
    (remove-method multi dispatch)
    method))
link
(multi-remove world :b) => fn?

multi? ^

returns `true` if `obj` is a multimethod

v 3.0
(defn multi?
  [obj]
  (instance? MultiFn obj))
link
(multi? print-method) => true (multi? println) => false