diff options
Diffstat (limited to 'src/clojure')
| -rw-r--r-- | src/clojure/contrib/def.clj | 26 | ||||
| -rw-r--r-- | src/clojure/contrib/types.clj | 23 |
2 files changed, 33 insertions, 16 deletions
diff --git a/src/clojure/contrib/def.clj b/src/clojure/contrib/def.clj index aff4a9d3..9310d367 100644 --- a/src/clojure/contrib/def.clj +++ b/src/clojure/contrib/def.clj @@ -85,3 +85,29 @@ (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])) diff --git a/src/clojure/contrib/types.clj b/src/clojure/contrib/types.clj index c66ed68c..0dbda8f3 100644 --- a/src/clojure/contrib/types.clj +++ b/src/clojure/contrib/types.clj @@ -1,7 +1,7 @@ ;; Data types ;; by Konrad Hinsen -;; last updated April 16, 2009 +;; last updated April 21, 2009 ;; Copyright (c) Konrad Hinsen, 2009. All rights reserved. The use ;; and distribution terms for this software are covered by the Eclipse @@ -15,7 +15,8 @@ "General and algebraic data types NOTE: This library is experimental. It may change significantly - with future release.") + with future release." + (:use [clojure.contrib.def :only (name-with-attributes)])) ; ; Utility functions @@ -65,31 +66,21 @@ [type-tag constructor-name docstring? attr-map? constructor] [type-tag constructor-name docstring? attr-map? constructor deconstructor])} [type-tag constructor-name & options] - (let [[docstring options] (if (string? (first options)) - [(first options) (next options)] - [nil options]) - [attr options] (if (map? (first options)) - [(first options) (next options)] - [{} options]) + (let [[constructor-name options] (name-with-attributes + constructor-name options) [constructor deconstructor] options constructor (if (nil? constructor) 'clojure.core/identity constructor) deconstructor (if (nil? deconstructor) 'clojure.core/list - deconstructor) - attr (if docstring - (assoc attr :doc docstring) - attr) - attr (if (meta constructor-name) - (conj (meta constructor-name) attr) - attr)] + deconstructor)] `(do (derive ~type-tag ::type) (let [meta-map# {:type ~type-tag ::constructor (quote ~(qualified-symbol constructor-name))}] - (def ~(with-meta constructor-name attr) + (def ~constructor-name (comp (fn [~'x] (with-meta ~'x meta-map#)) ~constructor)) (defmethod deconstruct ~type-tag [~'x] (~deconstructor (with-meta ~'x {}))))))) |