rlm@10: ;; Copyright (c) Stephen C. Gilardi. All rights reserved. The use and rlm@10: ;; distribution terms for this software are covered by the Eclipse Public rlm@10: ;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can rlm@10: ;; be found in the file epl-v10.html at the root of this distribution. By rlm@10: ;; using this software in any fashion, you are agreeing to be bound by the rlm@10: ;; terms of this license. You must not remove this notice, or any other, rlm@10: ;; from this software. rlm@10: ;; rlm@10: ;; File: def.clj rlm@10: ;; rlm@10: ;; def.clj provides variants of def that make including doc strings and rlm@10: ;; making private definitions more succinct. rlm@10: ;; rlm@10: ;; scgilardi (gmail) rlm@10: ;; 17 May 2008 rlm@10: rlm@10: (ns rlm@10: ^{:author "Stephen C. Gilardi", rlm@10: :doc "def.clj provides variants of def that make including doc strings and rlm@10: making private definitions more succinct."} rlm@10: clojure.contrib.def) rlm@10: rlm@10: (defmacro defvar rlm@10: "Defines a var with an optional intializer and doc string" rlm@10: ([name] rlm@10: (list `def name)) rlm@10: ([name init] rlm@10: (list `def name init)) rlm@10: ([name init doc] rlm@10: (list `def (with-meta name (assoc (meta name) :doc doc)) init))) rlm@10: rlm@10: (defmacro defunbound rlm@10: "Defines an unbound var with optional doc string" rlm@10: ([name] rlm@10: (list `def name)) rlm@10: ([name doc] rlm@10: (list `def (with-meta name (assoc (meta name) :doc doc))))) rlm@10: rlm@10: (defmacro defmacro- rlm@10: "Same as defmacro but yields a private definition" rlm@10: [name & decls] rlm@10: (list* `defmacro (with-meta name (assoc (meta name) :private true)) decls)) rlm@10: rlm@10: (defmacro defvar- rlm@10: "Same as defvar but yields a private definition" rlm@10: [name & decls] rlm@10: (list* `defvar (with-meta name (assoc (meta name) :private true)) decls)) rlm@10: rlm@10: (defmacro defunbound- rlm@10: "Same as defunbound but yields a private definition" rlm@10: [name & decls] rlm@10: (list* `defunbound (with-meta name (assoc (meta name) :private true)) decls)) rlm@10: rlm@10: (defmacro defstruct- rlm@10: "Same as defstruct but yields a private definition" rlm@10: [name & decls] rlm@10: (list* `defstruct (with-meta name (assoc (meta name) :private true)) decls)) rlm@10: rlm@10: (defmacro defonce- rlm@10: "Same as defonce but yields a private definition" rlm@10: ([name expr] rlm@10: (list `defonce (with-meta name (assoc (meta name) :private true)) expr)) rlm@10: ([name expr doc] rlm@10: (list `defonce (with-meta name (assoc (meta name) :private true :doc doc)) expr))) rlm@10: rlm@10: (defmacro defalias rlm@10: "Defines an alias for a var: a new var with the same root binding (if rlm@10: any) and similar metadata. The metadata of the alias is its initial rlm@10: metadata (as provided by def) merged into the metadata of the original." rlm@10: ([name orig] rlm@10: `(do rlm@10: (alter-meta! rlm@10: (if (.hasRoot (var ~orig)) rlm@10: (def ~name (.getRoot (var ~orig))) rlm@10: (def ~name)) rlm@10: ;; When copying metadata, disregard {:macro false}. rlm@10: ;; Workaround for http://www.assembla.com/spaces/clojure/tickets/273 rlm@10: #(conj (dissoc % :macro) rlm@10: (apply dissoc (meta (var ~orig)) (remove #{:macro} (keys %))))) rlm@10: (var ~name))) rlm@10: ([name orig doc] rlm@10: (list `defalias (with-meta name (assoc (meta name) :doc doc)) orig))) rlm@10: rlm@10: ; defhinted by Chouser: rlm@10: (defmacro defhinted rlm@10: "Defines a var with a type hint matching the class of the given rlm@10: init. Be careful about using any form of 'def' or 'binding' to a rlm@10: value of a different type. See http://paste.lisp.org/display/73344" rlm@10: [sym init] rlm@10: `(do rlm@10: (def ~sym ~init) rlm@10: (alter-meta! (var ~sym) assoc :tag (class ~sym)) rlm@10: (var ~sym))) rlm@10: rlm@10: ; name-with-attributes by Konrad Hinsen: rlm@10: (defn name-with-attributes rlm@10: "To be used in macro definitions. rlm@10: Handles optional docstrings and attribute maps for a name to be defined rlm@10: in a list of macro arguments. If the first macro argument is a string, rlm@10: it is added as a docstring to name and removed from the macro argument rlm@10: list. If afterwards the first macro argument is a map, its entries are rlm@10: added to the name's metadata map and the map is removed from the rlm@10: macro argument list. The return value is a vector containing the name rlm@10: with its extended metadata map and the list of unprocessed macro rlm@10: arguments." rlm@10: [name macro-args] rlm@10: (let [[docstring macro-args] (if (string? (first macro-args)) rlm@10: [(first macro-args) (next macro-args)] rlm@10: [nil macro-args]) rlm@10: [attr macro-args] (if (map? (first macro-args)) rlm@10: [(first macro-args) (next macro-args)] rlm@10: [{} macro-args]) rlm@10: attr (if docstring rlm@10: (assoc attr :doc docstring) rlm@10: attr) rlm@10: attr (if (meta name) rlm@10: (conj (meta name) attr) rlm@10: attr)] rlm@10: [(with-meta name attr) macro-args])) rlm@10: rlm@10: ; defnk by Meikel Brandmeyer: rlm@10: (defmacro defnk rlm@10: "Define a function accepting keyword arguments. Symbols up to the first rlm@10: keyword in the parameter list are taken as positional arguments. Then rlm@10: an alternating sequence of keywords and defaults values is expected. The rlm@10: values of the keyword arguments are available in the function body by rlm@10: virtue of the symbol corresponding to the keyword (cf. :keys destructuring). rlm@10: defnk accepts an optional docstring as well as an optional metadata map." rlm@10: [fn-name & fn-tail] rlm@10: (let [[fn-name [args & body]] (name-with-attributes fn-name fn-tail) rlm@10: [pos kw-vals] (split-with symbol? args) rlm@10: syms (map #(-> % name symbol) (take-nth 2 kw-vals)) rlm@10: values (take-nth 2 (rest kw-vals)) rlm@10: sym-vals (apply hash-map (interleave syms values)) rlm@10: de-map {:keys (vec syms) rlm@10: :or sym-vals}] rlm@10: `(defn ~fn-name rlm@10: [~@pos & options#] rlm@10: (let [~de-map (apply hash-map options#)] rlm@10: ~@body)))) rlm@10: rlm@10: ; defn-memo by Chouser: rlm@10: (defmacro defn-memo rlm@10: "Just like defn, but memoizes the function using clojure.core/memoize" rlm@10: [fn-name & defn-stuff] rlm@10: `(do rlm@10: (defn ~fn-name ~@defn-stuff) rlm@10: (alter-var-root (var ~fn-name) memoize) rlm@10: (var ~fn-name)))