Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tree: 1c805bd0e5
Fetching contributors…

Octocat-spinner-32-eaf2f5

Cannot retrieve contributors at this time

file 150 lines (136 sloc) 6.001 kb
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 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149
;; Copyright (c) Stephen C. Gilardi. All rights reserved. The use and
;; distribution terms for this software are covered by the Eclipse Public
;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
;; be found in the file epl-v10.html at the root of this distribution. By
;; using this software in any fashion, you are agreeing to be bound by the
;; terms of this license. You must not remove this notice, or any other,
;; from this software.
;;
;; File: def.clj
;;
;; def.clj provides variants of def that make including doc strings and
;; making private definitions more succinct.
;;
;; scgilardi (gmail)
;; 17 May 2008

(ns
  #^{:author "Stephen C. Gilardi",
    :doc "def.clj provides variants of def that make including doc strings and
making private definitions more succinct."}
  clojure.contrib.def)

(defmacro defvar
  "Defines a var with an optional intializer and doc string"
  ([name]
     (list `def name))
  ([name init]
     (list `def name init))
  ([name init doc]
     (list `def (with-meta name (assoc (meta name) :doc doc)) init)))

(defmacro defunbound
  "Defines an unbound var with optional doc string"
  ([name]
     (list `def name))
  ([name doc]
     (list `def (with-meta name (assoc (meta name) :doc doc)))))

(defmacro defmacro-
  "Same as defmacro but yields a private definition"
  [name & decls]
  (list* `defmacro (with-meta name (assoc (meta name) :private true)) decls))

(defmacro defvar-
  "Same as defvar but yields a private definition"
  [name & decls]
  (list* `defvar (with-meta name (assoc (meta name) :private true)) decls))

(defmacro defunbound-
  "Same as defunbound but yields a private definition"
  [name & decls]
  (list* `defunbound (with-meta name (assoc (meta name) :private true)) decls))

(defmacro defstruct-
  "Same as defstruct but yields a private definition"
  [name & decls]
  (list* `defstruct (with-meta name (assoc (meta name) :private true)) decls))

(defmacro defonce-
  "Same as defonce but yields a private definition"
  ([name expr]
     (list `defonce (with-meta name (assoc (meta name) :private true)) expr))
  ([name expr doc]
     (list `defonce (with-meta name (assoc (meta name) :private true :doc doc)) expr)))

(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 (.getRoot (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)))

; defhinted by Chouser:
(defmacro defhinted
  "Defines a var with a type hint matching the class of the given
init. Be careful about using any form of 'def' or 'binding' to a
value of a different type. See http://paste.lisp.org/display/73344"
  [sym init]
  `(do
     (def ~sym ~init)
     (alter-meta! (var ~sym) assoc :tag (class ~sym))
     (var ~sym)))

; name-with-attributes by Konrad Hinsen:
(defn name-with-attributes
  "To be used in macro definitions.
Handles optional docstrings and attribute maps for a name to be defined
in a list of macro arguments. If the first macro argument is a string,
it is added as a docstring to name and removed from the macro argument
list. If afterwards the first macro argument is a map, its entries are
added to the name's metadata map and the map is removed from the
macro argument list. The return value is a vector containing the name
with its extended metadata map and the list of unprocessed macro
arguments."
  [name macro-args]
  (let [[docstring macro-args] (if (string? (first macro-args))
                                 [(first macro-args) (next macro-args)]
                                 [nil macro-args])
    [attr macro-args] (if (map? (first macro-args))
                                 [(first macro-args) (next macro-args)]
                                 [{} macro-args])
    attr (if docstring
                                 (assoc attr :doc docstring)
                                 attr)
    attr (if (meta name)
                                 (conj (meta name) attr)
                                 attr)]
    [(with-meta name attr) macro-args]))

; defnk by Meikel Brandmeyer:
(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))))

; defn-memo by Chouser:
(defmacro defn-memo
  "Just like defn, but memoizes the function using clojure.core/memoize"
  [fn-name & defn-stuff]
  `(do
     (defn ~fn-name ~@defn-stuff)
     (alter-var-root (var ~fn-name) memoize)
     (var ~fn-name)))
Something went wrong with that request. Please try again.