From f033bc314775bab734b7b6c96ac87abd0e946f41 Mon Sep 17 00:00:00 2001 From: davidnolen Date: Wed, 26 Nov 2025 08:46:06 -0500 Subject: [PATCH 1/2] CLJS-3464: `parents` does not walk JavaScript prototype chain - implement `bases` return immediate prototype of arg - implement `supers` returns immediate and indirect protoypes of arg - fix hierarchy code to use js-fn? where Clojure used class - add assertions to derive - uncomment some test assertions --- src/main/cljs/cljs/core.cljs | 68 +++++++++++++++++++++++-------- src/test/cljs/cljs/core_test.cljs | 6 +-- 2 files changed, 53 insertions(+), 21 deletions(-) diff --git a/src/main/cljs/cljs/core.cljs b/src/main/cljs/cljs/core.cljs index 7d8fbeaaf..ae58c5cc6 100644 --- a/src/main/cljs/cljs/core.cljs +++ b/src/main/cljs/cljs/core.cljs @@ -11262,6 +11262,23 @@ reduces them without incurring seq initialization" (defn- swap-global-hierarchy! [f & args] (apply swap! (get-global-hierarchy) f args)) +(defn bases + "Returns the immediate prototype of c" + [c] + (when c + (let [s (.getPrototypeOf js/Object c)] + (when s + (list s))))) + +(defn supers + "Returns the immediate and indirect prototypes of c, if any" + [c] + (loop [ret (set (bases c)) cs ret] + (if (seq cs) + (let [c (first cs) bs (bases c)] + (recur (into ret bs) (into (disj cs c) bs))) + (not-empty ret)))) + (defn ^boolean isa? "Returns true if (= child parent), or child is directly or indirectly derived from parent, either via a JavaScript type inheritance relationship or a @@ -11270,17 +11287,17 @@ reduces them without incurring seq initialization" hierarchy" ([child parent] (isa? @(get-global-hierarchy) child parent)) ([h child parent] - (or (= child parent) - ;; (and (class? parent) (class? child) - ;; (. ^Class parent isAssignableFrom child)) - (contains? ((:ancestors h) child) parent) - ;;(and (class? child) (some #(contains? ((:ancestors h) %) parent) (supers child))) - (and (vector? parent) (vector? child) - (== (count parent) (count child)) - (loop [ret true i 0] - (if (or (not ret) (== i (count parent))) - ret - (recur (isa? h (child i) (parent i)) (inc i)))))))) + (or (= child parent) + (and (js-fn? parent) (js-fn? child) + (instance? parent child)) + (contains? ((:ancestors h) child) parent) + (and (js-fn? child) (some #(contains? ((:ancestors h) %) parent) (supers child))) + (and (vector? parent) (vector? child) + (== (count parent) (count child)) + (loop [ret true i 0] + (if (or (not ret) (== i (count parent))) + ret + (recur (isa? h (child i) (parent i)) (inc i)))))))) (defn parents "Returns the immediate parents of tag, either via a JavaScript type @@ -11288,7 +11305,12 @@ reduces them without incurring seq initialization" must be a hierarchy obtained from make-hierarchy, if not supplied defaults to the global hierarchy" ([tag] (parents @(get-global-hierarchy) tag)) - ([h tag] (not-empty (get (:parents h) tag)))) + ([h tag] + (not-empty + (let [tp (get (:parents h) tag)] + (if (js-fn? tag) + (into (set (bases tag)) tp) + tp))))) (defn ancestors "Returns the immediate and indirect parents of tag, either via a JavaScript type @@ -11296,7 +11318,15 @@ reduces them without incurring seq initialization" must be a hierarchy obtained from make-hierarchy, if not supplied defaults to the global hierarchy" ([tag] (ancestors @(get-global-hierarchy) tag)) - ([h tag] (not-empty (get (:ancestors h) tag)))) + ([h tag] + (not-empty + (let [ta (get (:ancestors h) tag)] + (if (js-fn? tag) + (let [superclasses (set (supers tag))] + (reduce into superclasses + (cons ta + (map #(get (:ancestors h) %) superclasses)))) + ta))))) (defn descendants "Returns the immediate and indirect children of tag, through a @@ -11305,7 +11335,10 @@ reduces them without incurring seq initialization" hierarchy. Note: does not work on JavaScript type inheritance relationships." ([tag] (descendants @(get-global-hierarchy) tag)) - ([h tag] (not-empty (get (:descendants h) tag)))) + ([h tag] + (if (js-fn? tag) + (throw (js/Error. "Can't get descendants of constructors")) + (not-empty (get (:descendants h) tag))))) (defn derive "Establishes a parent/child relationship between parent and @@ -11315,13 +11348,12 @@ reduces them without incurring seq initialization" supplied defaults to, and modifies, the global hierarchy." ([tag parent] (assert (namespace parent)) - ;; (assert (or (class? tag) (and (instance? cljs.core.Named tag) (namespace tag)))) + (assert (or (js-fn? tag) (and (implements? INamed tag) (namespace tag)))) (swap-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.INamed tag)) - ;; (assert (instance? clojure.lang.INamed parent)) + (assert (or (js-fn? tag) (implements? INamed tag))) + (assert (implements? INamed parent)) (let [tp (:parents h) td (:descendants h) ta (:ancestors h) diff --git a/src/test/cljs/cljs/core_test.cljs b/src/test/cljs/cljs/core_test.cljs index 3cd24205a..2286c2cef 100644 --- a/src/test/cljs/cljs/core_test.cljs +++ b/src/test/cljs/cljs/core_test.cljs @@ -197,12 +197,12 @@ (is (= #{:cljs.core-test/rect :cljs.core-test/square} (descendants ::shape))) (is (true? (isa? 42 42))) (is (true? (isa? ::square ::shape))) - ;(derive ObjMap ::collection) + (derive ObjMap ::collection) (derive cljs.core.PersistentHashSet ::collection) - ;(is (true? (isa? ObjMap ::collection))) + (is (true? (isa? ObjMap ::collection))) (is (true? (isa? cljs.core.PersistentHashSet ::collection))) (is (false? (isa? cljs.core.IndexedSeq ::collection))) - ;; ?? (isa? String Object) + (isa? js/String js/Object) (is (true? (isa? [::square ::rect] [::shape ::shape]))) ;; ?? (ancestors java.util.ArrayList) ;; ?? isa? based dispatch tests From 0cd68d246624ed3b7bc4bceb8dc5d82035a554f7 Mon Sep 17 00:00:00 2001 From: davidnolen Date: Wed, 26 Nov 2025 09:14:09 -0500 Subject: [PATCH 2/2] do not mutate the root object --- src/main/cljs/cljs/core.cljs | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/src/main/cljs/cljs/core.cljs b/src/main/cljs/cljs/core.cljs index ae58c5cc6..88e52f31d 100644 --- a/src/main/cljs/cljs/core.cljs +++ b/src/main/cljs/cljs/core.cljs @@ -1483,10 +1483,18 @@ IMeta (-meta [_] nil)) +(defn- root-obj + [] + (->> js/Function + (.getPrototypeOf js/Object) + (.getPrototypeOf js/Object))) + (extend-type default IHash (-hash [o] - (goog/getUid o))) + (if (identical? o (root-obj)) + 0 + (goog/getUid o)))) (extend-type symbol IHash