(derive tag parent)
(derive h tag parent)
Establishes a parent/child relationship between parent and
tag. Parent must be a namespace-qualified symbol or keyword and
child can be either a namespace-qualified symbol or keyword or a
class. h must be a hierarchy obtained from make-hierarchy, if not
supplied defaults to, and modifies, the global hierarchy.
Source
(defn derive
"Establishes a parent/child relationship between parent and
tag. Parent must be a namespace-qualified symbol or keyword and
child can be either a namespace-qualified symbol or keyword or a
class. h must be a hierarchy obtained from make-hierarchy, if not
supplied defaults to, and modifies, the global hierarchy."
{:added "1.0"}
([tag parent]
(assert (namespace parent))
(assert (or (class? tag) (and (instance? clojure.lang.Named tag) (namespace tag))))
(alter-var-root #'global-hierarchy derive tag parent) nil)
([h tag parent]
(assert (not= tag parent))
(assert (or (class? tag) (instance? clojure.lang.Named tag)))
(assert (instance? clojure.lang.Named parent))
(let [tp (:parents h)
td (:descendants h)
ta (:ancestors h)
tf (fn [m source sources target targets]
(reduce1 (fn [ret k]
(assoc ret k
(reduce1 conj (get targets k #{}) (cons target (targets target)))))
m (cons source (sources source))))]
(or
(when-not (contains? (tp tag) parent)
(when (contains? (ta tag) parent)
(throw (Exception. (print-str tag "already has" parent "as ancestor"))))
(when (contains? (ta parent) tag)
(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)})
h))))