-
Notifications
You must be signed in to change notification settings - Fork 4
/
def.clj
58 lines (55 loc) · 2.45 KB
/
def.clj
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
(ns jackknife.def
(:require [clojure.tools.macro :refer (name-with-attributes)]
[jackknife.meta :refer (meta-conj)]))
(defmacro defmain
"Defines an AOT-compiled function with the supplied
`name`. Containing namespace must be marked for AOT compilation to
have any effect."
[name & forms]
(let [classname (namespace-munge (str *ns* "." name))
sym (with-meta
(symbol (str name "-main"))
(meta name))]
`(do (gen-class :name ~classname
:main true
:prefix ~(str name "-"))
(defn ~(meta-conj sym {:no-doc true
:skip-wiki true})
~@forms)
(defn ~name ~@forms))))
(defmacro defalias
"Defines an alias for a var: a new var with the same root binding (if
any) and similar metadata. The metadata of the alias is its initial
metadata (as provided by def) merged into the metadata of the original."
([name orig]
`(do
(alter-meta!
(if (.hasRoot (var ~orig))
(def ~name (.getRawRoot (var ~orig)))
(def ~name))
;; When copying metadata, disregard {:macro false}.
;; Workaround for http://www.assembla.com/spaces/clojure/tickets/273
#(conj (dissoc % :macro)
(apply dissoc (meta (var ~orig)) (remove #{:macro} (keys %)))))
(var ~name)))
([name orig doc]
(list `defalias (with-meta name (assoc (meta name) :doc doc)) orig)))
(defmacro defnk
"Define a function accepting keyword arguments. Symbols up to the first
keyword in the parameter list are taken as positional arguments. Then
an alternating sequence of keywords and defaults values is expected. The
values of the keyword arguments are available in the function body by
virtue of the symbol corresponding to the keyword (cf. :keys destructuring).
defnk accepts an optional docstring as well as an optional metadata map."
[fn-name & fn-tail]
(let [[fn-name [args & body]] (name-with-attributes fn-name fn-tail)
[pos kw-vals] (split-with symbol? args)
syms (map #(-> % name symbol) (take-nth 2 kw-vals))
values (take-nth 2 (rest kw-vals))
sym-vals (apply hash-map (interleave syms values))
de-map {:keys (vec syms)
:or sym-vals}]
`(defn ~fn-name
[~@pos & options#]
(let [~de-map (apply hash-map options#)]
~@body))))