Is there a second undocumented evaluation phase for the &env macro? - clojure

This macro returns the values of the "magic" &env as a map, so that
(let [xyz "ZYX"] (get-env)) returns {xyz "ZYX"}, where the key is a Symbol.
(defmacro get-env []
(let [ks (keys &env)]
`(zipmap '~ks [~#ks])))
The expression '~ks evaluates the ks into Symbols at the macro-expansion phase (right?), but then quotes the expansion, so that the Symbols don't get evaluated into their values ("ZYX" in our example), but rather stay as Symbols (xyz). Is that right?
About [~#ks]: It evaluates ks into an seq of Symbols at the macro-expansion phase (right?) (and splices them and forms a vector with []). But how does that allow these Symbols to get further evaluated into their values ("ZYX" in our example) -- is there a second evaluation step, applied immediately after the first?
Another variant is
(defmacro local-env [] (->> (keys &env)
(map (fn [k] [(list 'quote k) k])) (into {})))

Your macro takes all the keys from the env. Then it uses the keys (a
list of symbols) to zip both the list of keys with spliced symbols
inside a vector. So what you get from
(let [x 42]
(get-env))
is
(let [x 42]
(zipmap '(x) [x]))
This is a compile-time transformation of your code (the whole point of
macros). The resulting code at runtime will use the 42 from the bound
x.

Preface
You may also be interested in the book "Clojure Macros", and in this StackOverflow question:
How do I write a Clojure threading macro?
Discussion
When in doubt, ask the compiler. Consider this code using my favorite template project:
(ns tst.demo.core
(:use demo.core tupelo.core tupelo.test))
(defmacro getenv []
(prn :env &env)
(prn :env-meta (meta &env))
(prn :form &form)
(prn :form-meta (meta &form)))
(defn go []
(newline)
(prn :01)
(getenv)
(let [x 1
y "yyy"]
(newline)
(prn :02)
(getenv))
)
(dotest
(go))
with output
:env nil
:env-meta nil
:form (getenv)
:form-meta {:line 15, :column 3}
:env {x #object[clojure.lang.Compiler$LocalBinding 0x1ab07559 "clojure.lang.Compiler$LocalBinding#1ab07559"], y #object[clojure.lang.Compiler$LocalBinding 0x26c79134 "clojure.lang.Compiler$LocalBinding#26c79134"]}
:env-meta nil
:form (getenv)
:form-meta {:line 21, :column 5}
Testing tst.demo.core
:01
:02
so we can see the 4 (prn ...) outputs for each call to getenv. In the case where there are no local bindings, we get
&env ;=> nil
and for the case with the let we get a map like
(let [env-val (quote
{x :compiler-local-1
y :compiler-local-1})
ks (keys env-val)
ks-vec [ks]
]
(spyx env-val)
(spyx ks)
(spyx ks-vec)
)
with result
env-val => {x :compiler-local-1, y :compiler-local-1}
ks => (x y)
ks-vec => [(x y)]
At this point, I'm not quite sure what your desired result is. Could you modify the question to add that?
BTW, there is no hidden 2nd step, if I understand your question correctly.
Also
I rewrite your local-env and got the following result:
(defmacro local-env []
(prn :into-result
(into {}
(mapv
(fn [k] [(list 'quote k) k])
(keys &env)))))
(let [x 1
y "yyy"]
(newline)
(prn :03)
(local-env))
with result
:into-result {(quote x) x,
(quote y) y}
so I think there is some confusion here.

Related

How to convert string into an array in clojure

I want to convert the string into an array,
I have tried some steps but not getting the desired result.
(:require [clojure.string :as str])
(def stringval "fruit==Mango,fruit==Papaya;veggie==Onion,veggie==Potato")
(defn formatting [strFilters]
(let [filters (str/split strFilters #";")]
(for [filter filters]
(let [eachFilter (str/split filter #",")]
(for [each eachFilter]
(let [items (str/split each #"==")]
items
))))))
(formatting stringval)
I am getting below output
((["fruit" "Mango"] ["fruit" "Papaya"]) (["veggie" "Onion"] ["veggie" "Potato"]))
I want clojure function which returns the below array
Array
(
[fruit] => Array
(
[0] => Mango
[1] => Papaya
)
[veggie] => Array
(
[0] => Onion
[1] => Potato
)
)
You want a list of maps, so you have to turn your current intermediate
results into a map. You can do this with group-by and some some
post-processing, or you can use merge-with conj if you shape the
result from the innermost for in preparation for it. Also note, that
for can have :let in it.
(require '[clojure.string :as str])
(def s "fruit==Mango,fruit==Papaya;veggie==Onion,veggie==Potato")
(for [g (str/split s #";")]
(apply merge-with into
(for [kv (str/split g #",")
:let [[k v] (str/split kv #"==")]]
{k [v]})))
; → ({"fruit" ["Mango" "Papaya"]} {"veggie" ["Onion" "Potato"]})
And in case your target-output there is from PHP or some other language,
that got their basic data structures wrong, and you actually just want
a map with the keys to arrays of values, you just have to to shift the
merge-with into out and you can also split for ; and , one swoop.
(apply merge-with into
(for [kv (str/split s #"[;,]")
:let [[k v] (str/split kv #"==")]]
{k [v]}))
; → {"fruit" ["Mango" "Papaya"], "veggie" ["Onion" "Potato"]}
one more option is to get all the pairs with re-seq and reduce it with grouping:
(->> stringval
(re-seq #"([^,;].+?)==([^,;$]+)")
(reduce (fn [acc [_ k v]] (update acc k conj v)) {}))
;;=> {"fruit" ("Papaya" "Mango"), "veggie" ("Potato" "Onion")}

Dispatching function calls on different formats of maps

I'm writing an agar.io clone. I've lately seen a lot of suggestions to limit use of records (like here), so I'm trying to do the whole project only using basic maps.*
I ended up creating constructors for different "types" of bacteria like
(defn new-bacterium [starting-position]
{:mass 0,
:position starting-position})
(defn new-directed-bacterium [starting-position starting-directions]
(-> (new-bacterium starting-position)
(assoc :direction starting-directions)))
The "directed bacterium" has a new entry added to it. The :direction entry will be used to remember what direction it was heading in.
Here's the problem: I want to have one function take-turn that accepts the bacterium and the current state of the world, and returns a vector of [x, y] indicating the offset from the current position to move the bacterium to. I want to have a single function that's called because I can think right now of at least three kinds of bacteria that I'll want to have, and would like to have the ability to add new types later that each define their own take-turn.
A Can-Take-Turn protocol is out the window since I'm just using plain maps.
A take-turn multimethod seemed like it would work at first, but then I realized that I'd have no dispatch values to use in my current setup that would be extensible. I could have :direction be the dispatch function, and then dispatch on nil to use the "directed bacterium"'s take-turn, or default to get the base aimless behavior, but that doesn't give me a way of even having a third "player bacterium" type.
The only solution I can think of it to require that all bacterium have a :type field, and to dispatch on it, like:
(defn new-bacterium [starting-position]
{:type :aimless
:mass 0,
:position starting-position})
(defn new-directed-bacterium [starting-position starting-directions]
(-> (new-bacterium starting-position)
(assoc :type :directed,
:direction starting-directions)))
(defmulti take-turn (fn [b _] (:type b)))
(defmethod take-turn :aimless [this world]
(println "Aimless turn!"))
(defmethod take-turn :directed [this world]
(println "Directed turn!"))
(take-turn (new-bacterium [0 0]) nil)
Aimless turn!
=> nil
(take-turn (new-directed-bacterium [0 0] nil) nil)
Directed turn!
=> nil
But now I'm back to basically dispatching on type, using a slower method than protocols. Is this a legitimate case to use records and protocols, or is there something about mutlimethods that I'm missing? I don't have a lot of practice with them.
* I also decided to try this because I was in the situation where I had a Bacterium record and wanted to create a new "directed" version of the record that had a single field direction added to it (inheritance basically). The original record implemented protocols though, and I didn't want to have to do something like nesting the original record in the new one, and routing all behavior to the nested instance. Every time I created a new type or changed a protocol, I would have to change all the routing, which was a lot of work.
You can use example-based multiple dispatch for this, as explained in this blog post. It is certainly not the most performant way to solve this problem, but arguably more flexible than multi-methods as it does not require you to declare a dispatch-method upfront. So it is open for extension to any data representation, even other things than maps. If you need performance, then multi-methods or protocols as you suggest, is probably the way to go.
First, you need to add a dependency on [bluebell/utils "1.5.0"] and require [bluebell.utils.ebmd :as ebmd]. Then you declare constructors for your data structures (copied from your question) and functions to test those data strucutres:
(defn new-bacterium [starting-position]
{:mass 0
:position starting-position})
(defn new-directed-bacterium [starting-position starting-directions]
(-> (new-bacterium starting-position)
(assoc :direction starting-directions)))
(defn bacterium? [x]
(and (map? x)
(contains? x :position)))
(defn directed-bacterium? [x]
(and (bacterium? x)
(contains? x :direction)))
Now we are going to register those datastructures as so called arg-specs so that we can use them for dispatch:
(ebmd/def-arg-spec ::bacterium {:pred bacterium?
:pos [(new-bacterium [9 8])]
:neg [3 4]})
(ebmd/def-arg-spec ::directed-bacterium {:pred directed-bacterium?
:pos [(new-directed-bacterium [9 8] [3 4])]
:neg [(new-bacterium [3 4])]})
For each arg-spec, we need to declare a few example values under the :pos key, and a few non-examples under the :neg key. Those values are used to resolve the fact that a directed-bacterium is more specific than just a bacterium in order for the dispatch to work properly.
Finally, we are going to define a polymorphic take-turn function. We first declare it, using declare-poly:
(ebmd/declare-poly take-turn)
And then, we can provide different implementations for specific arguments:
(ebmd/def-poly take-turn [::bacterium x
::ebmd/any-arg world]
:aimless)
(ebmd/def-poly take-turn [::directed-bacterium x
::ebmd/any-arg world]
:directed)
Here, the ::ebmd/any-arg is an arg-spec that matches any argument. The above approach is open to extension just like multi-methods, but does not require you to declare a :type field upfront and is thus more flexible. But, as I said, it is also going to be slower than both multimethods and protocols, so ultimately this is a trade-off.
Here is the full solution: https://github.com/jonasseglare/bluebell-utils/blob/archive/2018-11-16-002/test/bluebell/utils/ebmd/bacteria_test.clj
Dispatching a multimethod by a :type field is indeed polymorphic dispatch that could be done with a protocol, but using multimethods allows you to dispatch on different fields. You can add a second multimethod that dispatches on something other than :type, which might be tricky to accomplish with a protocol (or even multiple protocols).
Since a multimethod can dispatch on anything, you could use a set as the dispatch value. Here's an alternative approach. It's not fully extensible, since the keys to select are determined within the dispatch function, but it might give you an idea for a better solution:
(defmulti take-turn (fn [b _] (clojure.set/intersection #{:direction} (set (keys b)))))
(defmethod take-turn #{} [this world]
(println "Aimless turn!"))
(defmethod take-turn #{:direction} [this world]
(println "Directed turn!"))
Fast paths exist for a reason, but Clojure doesn't stop you from doing anything you want to do, per say, including ad hoc predicate dispatch. The world is definitely your oyster. Observe this super quick and dirty example below.
First, we'll start off with an atom to store all of our polymorphic functions:
(def polies (atom {}))
In usage, the internal structure of the polies would look something like this:
{foo ; <- function name
{:dispatch [[pred0 fn0 1 ()] ; <- if (pred0 args) do (fn0 args)
[pred1 fn1 1 ()]
[pred2 fn2 2 '&]]
:prefer {:this-pred #{:that-pred :other-pred}}}
bar
{:dispatch [[pred0 fn0 1 ()]
[pred1 fn1 3 ()]]
:prefer {:some-pred #{:any-pred}}}}
Now, let's make it so that we can prefer predicates (like prefer-method):
(defn- get-parent [pfn x] (->> (parents x) (filter pfn) first))
(defn- in-this-or-parent-prefs? [poly v1 v2 f1 f2]
(if-let [p (-> #polies (get-in [poly :prefer v1]))]
(or (contains? p v2) (get-parent f1 v2) (get-parent f2 v1))))
(defn- default-sort [v1 v2]
(if (= v1 :poly/default)
1
(if (= v2 :poly/default)
-1
0)))
(defn- pref [poly v1 v2]
(if (-> poly (in-this-or-parent-prefs? v1 v2 #(pref poly v1 %) #(pref poly % v2)))
-1
(default-sort v1 v2)))
(defn- sort-disp [poly]
(swap! polies update-in [poly :dispatch] #(->> % (sort-by first (partial pref poly)) vec)))
(defn prefer [poly v1 v2]
(swap! polies update-in [poly :prefer v1] #(-> % (or #{}) (conj v2)))
(sort-disp poly)
nil)
Now, let's create our dispatch lookup system:
(defn- get-disp [poly filter-fn]
(-> #polies (get-in [poly :dispatch]) (->> (filter filter-fn)) first))
(defn- pred->disp [poly pred]
(get-disp poly #(-> % first (= pred))))
(defn- pred->poly-fn [poly pred]
(-> poly (pred->disp pred) second))
(defn- check-args-length [disp args]
((if (= '& (-> disp (nth 3) first)) >= =) (count args) (nth disp 2)))
(defn- args-are? [disp args]
(or (isa? (vec args) (first disp)) (isa? (mapv class args) (first disp))))
(defn- check-dispatch-on-args [disp args]
(if (-> disp first vector?)
(-> disp (args-are? args))
(-> disp first (apply args))))
(defn- disp*args? [disp args]
(and (check-args-length disp args)
(check-dispatch-on-args disp args)))
(defn- args->poly-fn [poly args]
(-> poly (get-disp #(disp*args? % args)) second))
Next, let's prepare our define macro with some initialization and setup functions:
(defn- poly-impl [poly args]
(if-let [poly-fn (-> poly (args->poly-fn args))]
(-> poly-fn (apply args))
(if-let [default-poly-fn (-> poly (pred->poly-fn :poly/default))]
(-> default-poly-fn (apply args))
(throw (ex-info (str "No poly for " poly " with " args) {})))))
(defn- remove-disp [poly pred]
(when-let [disp (pred->disp poly pred)]
(swap! polies update-in [poly :dispatch] #(->> % (remove #{disp}) vec))))
(defn- til& [args]
(count (take-while (partial not= '&) args)))
(defn- add-disp [poly poly-fn pred params]
(swap! polies update-in [poly :dispatch]
#(-> % (or []) (conj [pred poly-fn (til& params) (filter #{'&} params)]))))
(defn- setup-poly [poly poly-fn pred params]
(remove-disp poly pred)
(add-disp poly poly-fn pred params)
(sort-disp poly))
With that, we can finally build our polies by rubbing some macro juice on there:
(defmacro defpoly [poly-name pred params body]
`(do (when-not (-> ~poly-name quote resolve bound?)
(defn ~poly-name [& args#] (poly-impl ~poly-name args#)))
(let [poly-fn# (fn ~(symbol (str poly-name "-poly")) ~params ~body)]
(setup-poly ~poly-name poly-fn# ~pred (quote ~params)))
~poly-name))
Now you can build arbitrary predicate dispatch:
;; use defpoly like defmethod, but without a defmulti declaration
;; unlike defmethods, all params are passed to defpoly's predicate function
(defpoly myinc number? [x] (inc x))
(myinc 1)
;#_=> 2
(myinc "1")
;#_=> Execution error (ExceptionInfo) at user$poly_impl/invokeStatic (REPL:6).
;No poly for user$eval187$myinc__188#5c8eee0f with ("1")
(defpoly myinc :poly/default [x] (inc x))
(myinc "1")
;#_=> Execution error (ClassCastException) at user$eval245$fn__246/invoke (REPL:1).
;java.lang.String cannot be cast to java.lang.Number
(defpoly myinc string? [x] (inc (read-string x)))
(myinc "1")
;#_=> 2
(defpoly myinc
#(and (number? %1) (number? %2) (->> %& (filter (complement number?)) empty?))
[x y & z]
(inc (apply + x y z)))
(myinc 1 2 3)
;#_=> 7
(myinc 1 2 3 "4")
;#_=> Execution error (ArityException) at user$poly_impl/invokeStatic (REPL:5).
;Wrong number of args (4) passed to: user/eval523/fn--524
; ^ took the :poly/default path
And when using your example, we can see:
(defn new-bacterium [starting-position]
{:mass 0,
:position starting-position})
(defn new-directed-bacterium [starting-position starting-directions]
(-> (new-bacterium starting-position)
(assoc :direction starting-directions)))
(defpoly take-turn (fn [b _] (-> b keys set (contains? :direction)))
[this world]
(println "Directed turn!"))
;; or, if you'd rather use spec
(defpoly take-turn (fn [b _] (->> b (s/valid? (s/keys :req-un [::direction])))
[this world]
(println "Directed turn!"))
(take-turn (new-directed-bacterium [0 0] nil) nil)
;#_=> Directed turn!
;nil
(defpoly take-turn :poly/default [this world]
(println "Aimless turn!"))
(take-turn (new-bacterium [0 0]) nil)
;#_=> Aimless turn!
;nil
(defpoly take-turn #(-> %& first :show) [this world]
(println :this this :world world))
(take-turn (assoc (new-bacterium [0 0]) :show true) nil)
;#_=> :this {:mass 0, :position [0 0], :show true} :world nil
;nil
Now, let's try using isa? relationships, a la defmulti:
(derive java.util.Map ::collection)
(derive java.util.Collection ::collection)
;; always wrap classes in a vector to dispatch off of isa? relationships
(defpoly foo [::collection] [c] :a-collection)
(defpoly foo [String] [s] :a-string)
(foo [])
;#_=> :a-collection
(foo "bob")
;#_=> :a-string
And of course we can use prefer to disambiguate relationships:
(derive ::rect ::shape)
(defpoly bar [::rect ::shape] [x y] :rect-shape)
(defpoly bar [::shape ::rect] [x y] :shape-rect)
(bar ::rect ::rect)
;#_=> :rect-shape
(prefer bar [::shape ::rect] [::rect ::shape])
(bar ::rect ::rect)
;#_=> :shape-rect
Again, the world's your oyster! There's nothing stopping you from extending the language in any direction you want.

Why does this clojure macro need `'~?

(Apologies if this is a duplicate of another question, my search for all those fancy special characters didn't yield anything.)
I'm reading Mastering Clojure Macros and have trouble understanding the following example:
(defmacro inspect-caller-locals []
(->> (keys &env)
(map (fn [k] [`'~k k]))
(into {})))
=> #'user/inspect-caller-locals
(let [foo "bar" baz "quux"]
(inspect-caller-locals))
=> {foo "bar", baz "quux"}
What is the difference between the following and the much simpler 'k?
`'~k
As far as I understand, the innermost unquote ~ should simply reverts the effect of the outermost syntax-quote `, but a short experiment reveals that there's more to it:
(defmacro inspect-caller-locals-simple []
(->> (keys &env)
(map (fn [k] ['k k]))
(into {})))
=> #'user/inspect-caller-locals-simple
(let [foo "bar" baz "quux"]
(inspect-caller-locals-simple))
CompilerException java.lang.RuntimeException: Unable to resolve symbol: k in this context, compiling:(/tmp/form-init4400591386630133028.clj:2:3)
Unfortunately, my usual investigation approach doesn't apply here:
(macroexpand '(let [foo "bar" baz "quux"]
(inspect-caller-locals)))
=> (let* [foo "bar" baz "quux"] (inspect-caller-locals))
(let [foo "bar" baz "quux"]
(macroexpand '(inspect-caller-locals)))
=> {}
What am I missing here?
Let's first establish what the k inside the macro is:
(defmacro inspect-caller-locals []
(mapv (fn [k]
(println (class k)))
(keys &env))
nil)
(let [x 1]
(inspect-caller-locals))
;; Prints:
;; clojure.lang.Symbol
So you each k inside the function is a symbol. If you return a symbol from a macro (ie generate code from it), clojure will lookup the value that it refers to and print it. For instance you could do this:
(defmacro inspect-caller-locals []
(mapv (fn [k]
[(quote x) k]) ;; not the "hard coded" x
(keys &env)))
(let [x 1]
(inspect-caller-locals))
;; Prints:
;; [[1 1]]
What you want however is the actual symbol. The problem (as you noted) is that quote is a special form that DOES NOT EVALUTE whatever you pass it. Ie, the k will not obtain the function parameter but stay k which is not usually defined:
(defmacro inspect-caller-locals []
(mapv (fn [k]
[(quote k) k])
(keys &env)))
(let [x 1]
(inspect-caller-locals))
;; => Error
(let [k 1]
(inspect-caller-locals))
;; Prints:
;; [[1 1]]
You somehow need to evaluate what you pass into quote, this is not however possible since that isn't what quote does. Other functions, such as str don't have that problem:
(defmacro inspect-caller-locals []
(mapv (fn [k]
[(str k) k])
(keys &env)))
(let [x 1]
(inspect-caller-locals))
;; Prints:
;; [["x" 1]]
The trick is to go one level deeper and quote the quote itself so you can pass the symbol to it:
(defmacro inspect-caller-locals []
(mapv (fn [k]
[;; This will evaluate k first but then generate code that
;; wraps that symbol with a quote:
(list (quote quote) k)
;; Or equivalently and maybe easier to understand:
(list 'quote k)
k])
(keys &env)))
(let [x 1]
(inspect-caller-locals))
;; Prints:
;; [[x x 1]]
Or by using the reader that can do this for you:
(defmacro inspect-caller-locals []
(mapv (fn [k]
[`(quote ~k)
`'~k
k])
(keys &env)))
(let [x 1]
(inspect-caller-locals))
;; Prints:
;; [[x x 1]]
Because after all:
(read-string "`'~k")
=> (clojure.core/seq (clojure.core/concat (clojure.core/list (quote quote)) (clojure.core/list k)))
(defmacro inspect-caller-locals []
(mapv (fn [k]
[(clojure.core/seq (clojure.core/concat (clojure.core/list (quote quote)) (clojure.core/list k)))
k])
(keys &env)))
(let [x 1]
(inspect-caller-locals))
;; Prints:
;; [[x 1]]
Some alternative, and equivalent, ways of writing
`'~k
are:
`(quote ~k) ;; expands the ' reader macro to the quote special form
(list 'quote k) ;; avoids syntax quote entirely
You are pretty much right to think that
the innermost unquote ~ should simply reverts the effect of the outermost syntax-quote
The only thing missing from your description there is that you can't pull quote outside of a syntax-quoted expression, since quote is a special form and changes the meaning of what's inside. Otherwise,
'`~k
would be equivalent to 'k - and as you noticed, it's not!
I'll echo #amalloy's general advice, that trying syntax-quoted stuff in the REPL, outside of the context of macros/macroexpansion, is the best way to get your head around these things.
p.s. Also, I'll make a note that I need to fix this confusion by explaining better in a future book edition ;)

Clojure macros: quoting, unquoting and evaluation

I have the following code:
(ns macroo)
(def primitives #{::byte ::short ::int})
(defn primitive? [type]
(contains? primitives type))
(def pp clojure.pprint/pprint)
(defn foo [buffer data schema]
(println schema))
(defmacro write-fn [buffer schema schemas]
(let [data (gensym)]
`(fn [~data]
~(cond
(primitive? schema) `(foo ~buffer ~data ~schema)
(vector? schema) (if (= ::some (first schema))
`(do (foo ~buffer (count ~data) ::short)
(map #((write-fn ~buffer ~(second schema) ~schemas) %)
~data))
`(do ~#(for [[i s] (map-indexed vector schema)]
((write-fn buffer s schemas) `(get ~data ~i)))))
:else [schema `(primitive? ~schema) (primitive? schema)])))) ; for debugging
(pp (clojure.walk/macroexpand-all '(write-fn 0 [::int ::int] 0)))
The problem is, upon evaluating the last expression, I get
=>
(fn*
([G__6506]
(do
[:macroo/int :macroo/int true false]
[:macroo/int :macroo/int true false])))
I'll explain the code if necessary, but for now i'll just state the problem (it might be just a newbie error I'm making):
`(primitive? ~schema)
and
(primitive? schema)
in the :else branch return true and false respectively, and since i'm using the second version in the cond expression, it fails where it shouldn't (I'd prefer the second version as it would be evaluated at compile time if i'm not mistaken).
I suspect it might have something to do with symbols being namespace qualified?
After some investigations (see edits), here is a working Clojure alternative. Basically, you rarely need recursive macros. If you
need to build forms recursively, delegate to auxiliary functions and call them from the macro (also, write-fn is not a good name).
(defmacro write-fn [buffer schemas fun]
;; we will evaluate "buffer" and "fun" only once
;; and we need gensym for intermediate variables.
(let [fsym (gensym)
bsym (gensym)]
;; define two mutually recursive function
;; to parse and build a map consisting of two keys
;;
;; - args is the argument list of the generated function
;; - body is a list of generated forms
;;
(letfn [(transformer [schema]
(cond
(primitive? schema)
(let [g (gensym)]
{:args g
:body `(~fsym ~schema ~bsym ~g)})
(sequential? schema)
(if (and(= (count schema) 2)
(= (first schema) ::some)
(primitive? (second schema)))
(let [g (gensym)]
{:args ['& g]
:body
`(doseq [i# ~g]
(~fsym ~(second schema) ~bsym i#))})
(reduce reducer {:args [] :body []} schema))
:else (throw (Exception. "Bad input"))))
(reducer [{:keys [args body]} schema]
(let [{arg :args code :body} (transformer schema)]
{:args (conj args arg)
:body (conj body code)}))]
(let [{:keys [args body]} (transformer schemas)]
`(let [~fsym ~fun
~bsym ~buffer]
(fn [~args] ~#body))))))
The macro takes a buffer (whatever it is), a schema as defined by your language and a function to be called for each value being visited by the generated function.
Example
(pp (macroexpand
'(write-fn 0
[::int [::some ::short] [::int ::short ::int]]
(fn [& more] (apply println more)))))
... produces the following:
(let*
[G__1178 (fn [& more] (apply println more)) G__1179 0]
(clojure.core/fn
[[G__1180 [& G__1181] [G__1182 G__1183 G__1184]]]
(G__1178 :macroo/int G__1179 G__1180)
(clojure.core/doseq
[i__1110__auto__ G__1181]
(G__1178 :macroo/short G__1179 i__1110__auto__))
[(G__1178 :macroo/int G__1179 G__1182)
(G__1178 :macroo/short G__1179 G__1183)
(G__1178 :macroo/int G__1179 G__1184)]))
First, evaluate buffer and fun and bind them to local variables
Return a closure which accept one argument and destructures it according to the given schema, thanks to Clojure's destructuring capabilities.
For each value, call fun with the appropriate arguments.
When the schema is [::some x], accept zero or more values as a vector and call the function fun for each of those values. This needs to be done with a loop, since the size is only know when calling the function.
If we pass the vector [32 [1 3 4 5 6 7] [2 55 1]] to the function generated by the above macroexpansion, the following is printed:
:macroo/int 0 32
:macroo/short 0 1
:macroo/short 0 3
:macroo/short 0 4
:macroo/short 0 5
:macroo/short 0 6
:macroo/short 0 7
:macroo/int 0 2
:macroo/short 0 55
:macroo/int 0 1
In this line:
`(do ~#(for [[i s] (map-indexed vector schema)]
((write-fn buffer s schemas) `(get ~data ~i)))))
you are calling write-fn, the macro, in your current scope, where s is just a symbol, not one of the entries in schema. Instead, you want to emit code that will run in the caller's scope:
`(do ~#(for [[i s] (map-indexed vector schema)]
`((write-fn ~buffer ~s ~schemas) (get ~data ~i)))))
And make a similar change to the other branch of the if, as well.
As an aside, it looks to me at first glance like this doesn't really need to be a macro, but could be a higher-order function instead: take in a schema or whatever, and return a function of data. My guess is you're doing it as a macro for performance, in which case I would counsel you to try it out the slow, easy way first; once you have that working you can make it a macro if necessary. Or, maybe I'm wrong and there's something in here that fundamentally has to be a macro.

Apply defaults to a map

I'm looking for a way to apply some defaults to map. I know the following works:
(defn apply-defaults
[needing-defaults]
(merge {:key1 (fn1 10)
:key2 (fn2 76)}
needing-defaults))
The issue with the above is that the value of fn1 and fn2 are evaluated even though needing-defaults might already have these keys - thus never needing them.
I've tried with merge-with but that doesn't seem to work. I'm quite new at this - any suggestions?
I'm ussually applying defaults with merge-with function:
(merge-with #(or %1 %2) my-map default-map)
But in your case it should be something like:
(reduce (fn [m [k v]]
(if (contains? m k) m (assoc m k (v))))
needing-defaults
defaults)
where defaults is a map of functions:
{ :key1 #(fn1 10)
:key2 #(fn2 76)}
if is a special form, so it newer evaluates its false branch.
See my example for more info.
If I understand your question correctly, how about this?
(defn apply-defaults [nd]
(into {:key1 (sf1 10) :key2 (sf2 76)} nd))
You could use a macro to generate the contains? checks and short circuit the function calls.
(defmacro merge-with-defaults [default-coll coll]
(let [ks (reduce (fn [a k] (conj a
`(not (contains? ~coll ~k))
`(assoc ~k ~(k default-coll))))
[] (keys default-coll))]
`(cond-> ~coll ~#ks)))
(defn apply-defaults [needing-defaults]
(merge-with-defaults {:key1 (fn1 10)
:key2 (fn2 76)}
needing-defaults))
Just remember to keep the function calls inside the call to merge-with-defaults to prevent evaluation.
Since you can merge nil into a map, you can use the if-not macro:
(merge {} nil {:a 1} nil) ;; {:a 1}
Try this:
(defn apply-defaults [col]
(merge col
(if-not (contains? col :key1) {:key1 (some-function1 10)})
(if-not (contains? col :key2) {:key2 (some-function2 76)})))
some-function1 and some-function2 will only be executed when col does not already have the key.