core: Stage 3 — the hierarchy system is pure Clojure (canonical port)

make-hierarchy/derive/underive/isa?/parents/ancestors/descendants are now
Clojure in the overlay — Clojure's own pure-map implementation: a hierarchy
is {:parents {tag #{..}} :ancestors {..} :descendants {..}}, the 3-arity
forms are PURE (derive returns a new hierarchy), and the 1/2-arity forms swap
a private global-hierarchy atom.

This fixes three correctness gaps the Janet kernel had: multi-parent derive
(the kernel's :parents held a single parent per tag), TRANSITIVE descendants
(the kernel tracked direct children only), and vector-pair isa?
((isa? [child1 child2] [parent1 parent2])). Cyclic and duplicate derives now
behave like Clojure (throw / no-op).

Multimethod dispatch was the kernel's only internal caller: defmulti-setup's
dispatch closure now calls the overlay's isa? through a lazily-resolved var
(cached per multimethod); a :hierarchy option is an atom (deref per dispatch,
matching Clojure's var semantics) or a plain hierarchy map. The Janet kernel
(types.janet) and the core-* wrappers are deleted.

20 new hierarchy spec rows (pure 3-arity incl. cycle/duplicate edges, global
+ dispatch incl. custom :hierarchy atoms). Gate green: conformance 326x3,
suite 4566 >= 4540, all batteries, bench in the session band.

src/jolt/core.janet

@@ -2313,36 +2313,6 @@
 # intern is a ctx-capturing clojure.core fn now (install-stateful-fns!).
 
 # Hierarchy stubs for sci bootstrap
-(def core-make-hierarchy make-hierarchy)
-(defn core-derive
-  [& args]
-  (case (length args)
-    2 (let [[tag parent] args] (derive* the-global-hierarchy tag parent) nil)
-    3 (let [[h tag parent] args] (derive* h tag parent))))
-(defn core-isa?
-  [& args]
-  (case (length args)
-    2 (let [[child parent] args] (isa? the-global-hierarchy child parent))
-    3 (let [[h child parent] args] (isa? h child parent))))
-(defn core-ancestors
-  [& args]
-  (case (length args)
-    1 (apply make-phs (ancestors the-global-hierarchy (in args 0)))
-    2 (let [[h tag] args] (apply make-phs (ancestors h tag)))))
-(defn core-descendants
-  [& args]
-  (case (length args)
-    1 (apply make-phs (descendants the-global-hierarchy (in args 0)))
-    2 (let [[h tag] args] (apply make-phs (descendants h tag)))))
-(defn core-parents
-  [& args]
-  (let [[h tag] (if (= 1 (length args)) [the-global-hierarchy (in args 0)] args)
-        p (get (h :parents) tag)]
-    (if p (make-phs p) (make-phs))))
-(defn core-underive [& args]
-  (case (length args)
-    2 (let [[tag parent] args] (underive the-global-hierarchy tag parent) nil)
-    3 (let [[h tag parent] args] (underive h tag parent))))
 (def core-get-method (fn [mm-var dispatch-val]
   (let [methods (get mm-var :jolt/methods)]
     (or (get methods dispatch-val) (get methods :default)))))
@@ -3229,13 +3199,6 @@
     "reset!" core-reset!
     "swap!" core-swap!
     "not" core-not
-    "derive" core-derive
-    "isa?" core-isa?
-    "parents" core-parents
-    "ancestors" core-ancestors
-    "descendants" core-descendants
-    "make-hierarchy" core-make-hierarchy
-    "underive" core-underive
     "get-method" core-get-method
     "methods" core-methods
     "remove-method" core-remove-method

src/jolt/evaluator.janet

@@ -865,6 +865,7 @@
       h))
   (def ns (ctx-find-ns ctx (ctx-current-ns ctx)))
   (def methods @{})
+  (def isa-cache @[nil])
   (def dispatch-cache @{})
   (def mm-fn
     (fn [& args]
@@ -875,11 +876,24 @@
           (let [cached (get dispatch-cache dv)]
             (if cached
               (apply cached args)
-              (let [h (or hierarchy the-global-hierarchy)
+              # isa? is the OVERLAY's (the hierarchy system is pure Clojure now,
+              # stage 3); resolve its var lazily, once. A :hierarchy option is an
+              # atom (deref per dispatch, like Clojure's var) or a plain map.
+              (let [isa-fn (do
+                             (when (nil? (isa-cache 0))
+                               (put isa-cache 0
+                                    (var-get (ns-find (ctx-find-ns ctx "clojure.core") "isa?"))))
+                             (isa-cache 0))
+                    h (if hierarchy
+                        (if (and (table? hierarchy) (= :jolt/atom (get hierarchy :jolt/type)))
+                          (hierarchy :value)
+                          hierarchy)
+                        nil)
                     found (do (var f nil) (var i 0)
                             (let [ks (keys methods)]
                               (while (and (nil? f) (< i (length ks)))
-                                (if (isa? h dv (in ks i)) (set f (get methods (in ks i))))
+                                (if (if h (isa-fn h dv (in ks i)) (isa-fn dv (in ks i)))
+                                  (set f (get methods (in ks i))))
                                 (++ i)))
                             f)]
                 (if found

src/jolt/types.janet

@@ -186,64 +186,6 @@
   (put v :meta meta)
   meta)
 
-(defn make-hierarchy
-  "Create a new empty hierarchy for multimethod dispatch."
-  []
-  {:parents @{} :descendants @{} :ancestors @{}})
-
-# The global hierarchy used by the 1/2-arg derive/isa?/parents/ancestors/
-# descendants and by multimethod dispatch when no explicit hierarchy is given.
-(def the-global-hierarchy (make-hierarchy))
-
-(defn derive*
-  "Add a parent relationship to a hierarchy."
-  [h tag parent]
-  (put (h :parents) tag parent)
-  (let [d (get (h :descendants) parent)]
-    (if d (array/push d tag) (put (h :descendants) parent @[tag])))
-  (let [a (get (h :ancestors) tag)]
-    (if a (array/push a parent) (put (h :ancestors) tag @[parent])))
-  h)
-
-(defn- ancestors*
-  "Internal: get all ancestors of a tag via iterative graph walk."
-  [h tag visited]
-  (var stack @[tag])
-  (while (> (length stack) 0)
-    (let [t (array/pop stack)]
-      (when (not (get visited t))
-        (put visited t true)
-        (let [p (get (h :parents) t)]
-          (when (and p (not= p t))
-            (array/push stack p))))))
-  visited)
-
-(defn ancestors
-  "Return all transitive ancestors of a tag in the given hierarchy."
-  [h tag]
-  (let [visited (ancestors* h tag @{})]
-    (var result @[])
-    (loop [[k _] :pairs visited]
-      (when (not= k tag) (array/push result k)))
-    result))
-
-(defn descendants
-  "Return the descendants of a tag in the given hierarchy."
-  [h tag]
-  (let [d (get (h :descendants) tag)] (if d d @[])))
-
-(defn isa?
-  "Check if child is derived from parent in the given hierarchy."
-  [h child parent]
-  (if (= child parent) true
-    (let [p (get (h :parents) child)]
-      (if p (isa? h p parent) false))))
-
-(defn underive
-  "Remove a parent relationship from a hierarchy."
-  [h tag parent]
-  (put (h :parents) tag nil)
-  h)
 
 (defn with-meta
   "Return a new var with updated metadata. The original var is unchanged."