1.1--- a/lisp/std/mop.lisp	Thu Oct 03 19:04:57 2024 -0400
     1.2+++ b/lisp/std/mop.lisp	Thu Oct 03 21:54:07 2024 -0400
     1.3@@ -61,3 +61,33 @@
     1.4                       `(,ns ,v))))
     1.5               (when unboundp (list ns))))))
     1.6     slots)))
     1.7+
     1.8+;; closer-mop
     1.9+(defun ensure-finalized (class &optional (errorp t))
    1.10+  (if (typep class 'class)
    1.11+    (unless (class-finalized-p class)
    1.12+      (finalize-inheritance class))
    1.13+    (when errorp (error "~S is not a class." class)))
    1.14+  class)
    1.15+
    1.16+(defun subclassp (class superclass)
    1.17+  (flet ((get-class (class) (etypecase class
    1.18+                              (class class)
    1.19+                              (symbol (find-class class)))))
    1.20+
    1.21+      (loop with class = (get-class class)
    1.22+            with superclass = (get-class superclass)
    1.23+
    1.24+            for superclasses = (list class)
    1.25+            then (set-difference
    1.26+                  (union (class-direct-superclasses current-class) superclasses)
    1.27+                  seen)
    1.28+
    1.29+            for current-class = (first superclasses)
    1.30+
    1.31+            while current-class
    1.32+
    1.33+            if (eq current-class superclass) return t
    1.34+            else collect current-class into seen
    1.35+
    1.36+            finally (return nil))))