8

Custom defn macro - part 2: playing with parse trees

 3 years ago
source link: https://blog.klipse.tech/clojure/2016/10/10/defn-args-2.html
Go to the source link to view the article. You can view the picture content, updated content and better typesetting reading experience. If the link is broken, please click the button below to view the snapshot at that time.
neoserver,ios ssh client

Custom defn macro - part 2: playing with parse trees

Oct 10, 2016 • Yehonathan Sharvit

Custom defn

With clojure.spec, we can parse functions and macros arguments into kind of an Abstract Syntax Tree (AST).

In this two-part series, we are going to show how one can write his custom defn-like macro, using the specs for defn.

In the first part, we showed how one can parse the arguments of the defn macro, modifies the parse tree and converts it back to the format defn expects.

Now, we are going to leverage this idea in order to write a couple of custom defn like macros:

  • defndoc: automatic enrichment of docstring
  • defnlog: automatic logging of function calls
  • defntry: automatic catching of exceptions
Trees

The following pieces of code are inspired form Mark Engleberg better-cond repo.

Requirements

First, we have to require clojure.spec.

I apologise for the fact that it takes a bit of time and might cause page scroll freeze: this is because KLIPSE loads and evaluates code from github while you are reading this article…

xxxxxxxxxx
(ns my.m$macros
  (:require [clojure.spec.alpha :as s]))
the evaluation will appear here (soon)...

As we explained in the first part, we have to redefine ::defn-args - the spec for defn arguments.

Feel free to skip the following code snippet - and come back to it later. The most important part is the last stament where ::defn-args is defined.

xxxxxxxxxx
;loaded from gist: https://gist.github.com/viebel/ab64ed95820af42b366889a872dc28ac
(s/def ::local-name (s/and simple-symbol? #(not= '& %)))
(s/def ::binding-form
       (s/or :sym ::local-name
             :seq ::seq-binding-form
             :map ::map-binding-form))
;; sequential destructuring
(s/def ::seq-binding-form
       (s/and vector?
              (s/conformer identity vec)
              (s/cat :elems (s/* ::binding-form)
                     :rest (s/? (s/cat :amp #{'&} :form ::binding-form))
                     :as (s/? (s/cat :as #{:as} :sym ::local-name)))))
;; map destructuring
(s/def ::keys (s/coll-of ident? :kind vector?))
(s/def ::syms (s/coll-of symbol? :kind vector?))
(s/def ::strs (s/coll-of simple-symbol? :kind vector?))
(s/def ::or (s/map-of simple-symbol? any?))
(s/def ::as ::local-name)
(s/def ::map-special-binding
       (s/keys :opt-un [::as ::or ::keys ::syms ::strs]))
(s/def ::map-binding (s/tuple ::binding-form any?))
(s/def ::ns-keys
       (s/tuple
        (s/and qualified-keyword? #(-> % name #{"keys" "syms"}))
        (s/coll-of simple-symbol? :kind vector?)))
(s/def ::map-bindings
       (s/every (s/or :mb ::map-binding
                      :nsk ::ns-keys
                      :msb (s/tuple #{:as :or :keys :syms :strs} any?)) :into {}))
(s/def ::map-binding-form (s/merge ::map-bindings ::map-special-binding))
;; bindings
(s/def ::binding (s/cat :binding ::binding-form :init-expr any?))
(s/def ::bindings (s/and vector? (s/* ::binding)))
;; defn, defn-, fn
(defn arg-list-unformer [a]
  (vec 
   (if (and (coll? (last a)) (= '& (first (last a))))
     (concat (drop-last a) (last a))
     a)))
(s/def ::arg-list
       (s/and
        vector?
        (s/conformer identity arg-list-unformer)
        (s/cat :args (s/* ::binding-form)
               :varargs (s/? (s/cat :amp #{'&} :form ::binding-form)))))
(s/def ::args+body
       (s/cat :args ::arg-list
              :prepost (s/? map?)
              :body (s/* any?)))
(s/def ::defn-args
       (s/cat :name simple-symbol?
              :docstring (s/? string?)
              :meta (s/? map?)
              :bs (s/alt :arity-1 ::args+body
                         :arity-n (s/cat :bodies (s/+ (s/spec ::args+body))
                                         :attr (s/? map?)))))
xxxxxxxxxx
the evaluation will appear here (soon)...

Automatic enrichment of docstring

Let’s say, we want to write a defn like macro with a twist: the docstring will automatically contain the name of the function that is currently defined. Without clojure.spec, you will have to extract manually the optional docstring and reinject it into defn. With clojure.spec, we can do much better by:

  1. Conforming the args into a tree
  2. Modifying the docstring part of the tree
  3. Unforming back

Here is the code in action:

xxxxxxxxxx
(defmacro defndoc [& args]
  (let [conf (s/conform ::defn-args args)
        name (:name conf)
        new-conf (update conf :docstring #(str name " is a cool function. " %))
        new-args (s/unform ::defn-args new-conf)]
    (cons `defn new-args)))
xxxxxxxxxx
the evaluation will appear here (soon)...

When no docstring is provided, a docstring is created:

xxxxxxxxxx
(my.m/defndoc foo [a b] (+ a b))
(:doc (meta #'foo))
xxxxxxxxxx
the evaluation will appear here (soon)...

When a docstring is provided, a enriched docstring is created:

xxxxxxxxxx
(my.m/defndoc foo "sum of a and b." [a b] (+ a b))
(:doc (meta #'foo))
xxxxxxxxxx
the evaluation will appear here (soon)...

This one was pretty easy, because we only had to deal with the docstring. The next one is more challenging - as we are going to deal with the body of the function…

Automatic logging of function calls

defnlog is going to be a macro that defines a function that print a log each time it is called.

In other words, we are going to write a macro that modifies the body of a function. It’s pretty easy, clojure being a homoiconic language: Code is data and it can be manipulated as a regular list.

Our first piece is going to be a function prepend-log that receives a body and a function name and prepend to it a call to (print func-name "has been called):

xxxxxxxxxx
(defn prepend-log [name body]
  (cons `(println ~name "has been called.") body))
xxxxxxxxxx
the evaluation will appear here (soon)...

Our second piece is a function update-conf that updates the body of a conformed ::defn-args. This is a bit tricky because the shape of the confomed object is different if the function is a single-arity or a multi-arity function.

Let’s take a look at the shape of a ::defn-args for a single arity function:

xxxxxxxxxx
(s/conform ::defn-args '(foo [a b] (* a b)))
xxxxxxxxxx
the evaluation will appear here (soon)...

The body path is: [:bs 1 :body].

And now for a multi-arity function:

xxxxxxxxxx
(s/conform ::defn-args '(bar 
                         ([] (* 10 12))
                         ([a b] (* a b))))
xxxxxxxxxx
the evaluation will appear here (soon)...

The bodies path is: [:bs 1 :bodies].

Note that in both cases, the arity type is located at [:bs 0].

Let’s write update-conf:

  • In single-arity, we update the body
  • In multi-arity, we updtate all the bodies

Note how we destructure the conf in order to get the arity.

xxxxxxxxxx
(defn update-conf [{[arity] :bs :as conf} body-update-fn]
  (case arity
    :arity-1 (update-in conf [:bs 1 :body] body-update-fn)
    :arity-n (update-in conf [:bs 1 :bodies] (fn [bodies]
                                               (map (fn [body] (update body :body body-update-fn)) bodies)))))
xxxxxxxxxx
the evaluation will appear here (soon)...

All the pieces are ready to write our defnlog macro:

xxxxxxxxxx
(defmacro defnlog [& args]
  (let [{:keys [name] :as conf} (s/conform ::defn-args args)
        new-conf (update-conf conf (partial prepend-log  (str name)))
        new-args (s/unform ::defn-args new-conf)]
    (cons `defn new-args)))
xxxxxxxxxx
the evaluation will appear here (soon)...

Let’s see defnlog in action.

First, we define a simple function foo:

xxxxxxxxxx
(my.m/defnlog foo "aa" [a b] (+ a b))
xxxxxxxxxx
the evaluation will appear here (soon)...

And when we call it, a log is printed:

xxxxxxxxxx
(with-out-str (foo [55 200]))
xxxxxxxxxx
the evaluation will appear here (soon)...

It works fine with destructuring:

xxxxxxxxxx
(my.m/defnlog baz "aa" [{:keys [a b]}] (+ a b (first c)))
(baz {:a 55 :b 200})
xxxxxxxxxx
the evaluation will appear here (soon)...
xxxxxxxxxx
(with-out-str 
  (baz {:a 55 :b 200}))
xxxxxxxxxx
the evaluation will appear here (soon)...

And also with multi-arity functions:

xxxxxxxxxx
(my.m/defnlog bar 
              ([] (* 10 12))
              ([a b] (* a b)))
(with-out-str
  (bar))
xxxxxxxxxx
the evaluation will appear here (soon)...
xxxxxxxxxx
(with-out-str
  (bar 12 3))
xxxxxxxxxx
the evaluation will appear here (soon)...

Automatic try/catch

We can use exactly the same technique to create a defntry macro that wraps the body into a try/catch block - and throws an exception with the name of the function. (It is especially useful in clojurescript with advanced compilation where function names are not available any more at run time!)

First, let’s write a wrap-try function that wraps a body into a try/catch block:

xxxxxxxxxx
(defn wrap-try [name body]
  `((try ~@body
      (catch :default ~'e
        (throw (str "Exception caught in function " ~name ": " ~'e))))))
xxxxxxxxxx
the evaluation will appear here (soon)...

And now, the code of the defntry macro:

xxxxxxxxxx
(defmacro defntry [& args]
  (let [{:keys [name] :as conf} (s/conform ::defn-args args)
        new-conf (update-conf conf (partial wrap-try  (str name)))
        new-args (s/unform ::defn-args new-conf)]
    (cons `defn new-args)))
xxxxxxxxxx
the evaluation will appear here (soon)...

Let’s see it in action - with a kool function that receives a function and calls it.

xxxxxxxxxx
(my.m/defntry kool "aa" [a] (a))
xxxxxxxxxx
the evaluation will appear here (soon)...
xxxxxxxxxx
(kool #(inc 2))
xxxxxxxxxx
the evaluation will appear here (soon)...

Now, if we pass something that is not a function, we will get a nice exception with the name of the kool function:

xxxxxxxxxx
(kool 2)
xxxxxxxxxx
the evaluation will appear here (soon)...

So beautiful…

And so simple…

Clojure.spec rocks!


About Joyk


Aggregate valuable and interesting links.
Joyk means Joy of geeK