Index: src/clj/clojure/core.clj
===================================================================
--- src/clj/clojure/core.clj	(revision 1337)
+++ src/clj/clojure/core.clj	(working copy)
@@ -1033,8 +1033,8 @@
 
   Options are key-value pairs and may be one of:
     :default    the default dispatch value, defaults to :default
-    :hierarchy  the isa? hierarchy to use for dispatching
-                defaults to the global hierarchy"
+    :hierarchy  a reference (var, ref, atom, agent) to the isa? hierarchy
+                to use for dispatching, defaults to the global hierarchy"
   {:arglists '([name docstring? attr-map? dispatch-fn & options])}
   [mm-name & options]
   (let [docstring   (if (string? (first options))
@@ -3276,10 +3276,11 @@
 
 (defn make-hierarchy
   "Creates a hierarchy object for use with derive, isa? etc."
-  [] {:parents {} :descendants {} :ancestors {}})
+  ([] (make-hierarchy nil))
+  ([root-type] {:parents {} :descendants {} :ancestors {} :root root-type}))
 
 (def #^{:private true}
-     global-hierarchy (make-hierarchy))
+     global-hierarchy (make-hierarchy :root))
 
 (defn not-empty
   "If coll is empty, returns nil, else coll"
@@ -3311,6 +3312,7 @@
   ([child parent] (isa? global-hierarchy child parent))
   ([h child parent]
    (or (= child parent)
+       (= parent (:root h))
        (and (class? parent) (class? child)
             (. #^Class parent isAssignableFrom child))
        (contains? ((:ancestors h) child) parent)
@@ -3329,7 +3331,9 @@
   defaults to the global hierarchy"
   ([tag] (parents global-hierarchy tag))
   ([h tag] (not-empty
-            (let [tp (get (:parents h) tag)]
+            (let [tp (get (:parents h) tag #{})
+		  root (:root h)
+		  tp (if (and root (not (= root tag))) (conj tp root) tp)]
               (if (class? tag)
                 (into (set (bases tag)) tp)
                 tp)))))
@@ -3341,7 +3345,9 @@
   defaults to the global hierarchy"
   ([tag] (ancestors global-hierarchy tag))
   ([h tag] (not-empty
-            (let [ta (get (:ancestors h) tag)]
+            (let [ta (get (:ancestors h) tag #{})
+		  root (:root h)
+		  ta (if (and root (not (= root tag))) (conj ta root) ta)]
               (if (class? tag)
                 (let [superclasses (set (supers tag))]
                   (reduce into superclasses
@@ -3356,9 +3362,10 @@
   hierarchy. Note: does not work on Java type inheritance
   relationships."
   ([tag] (descendants global-hierarchy tag))
-  ([h tag] (if (class? tag)
-             (throw (java.lang.UnsupportedOperationException. "Can't get descendants of classes"))
-             (not-empty (get (:descendants h) tag)))))
+  ([h tag] (cond (class? tag) (throw (java.lang.UnsupportedOperationException. "Can't get descendants of classes"))
+		 (= tag :root) (reduce conj (set (keys (:parents h)))
+				            (keys (:ancestors h)))
+		 :else (not-empty (get (:descendants h) tag)))))
 
 (defn derive
   "Establishes a parent/child relationship between parent and
@@ -3392,7 +3399,8 @@
           (throw (Exception. (print-str "Cyclic derivation:" parent "has" tag "as ancestor"))))
         {:parents (assoc (:parents h) tag (conj (get tp tag #{}) parent))
          :ancestors (tf (:ancestors h) tag td parent ta)
-         :descendants (tf (:descendants h) parent ta tag td)})
+         :descendants (tf (:descendants h) parent ta tag td)
+	 :root (:root h)})
       h))))
 
 (defn underive