### Installation and Loading Source: https://context7.com/pcostanza/closer-mop/llms.txt Instructions on how to install and load the Closer to MOP library using Quicklisp or ASDF, and how to use its packages in your Common Lisp code. ```APIDOC ## Installation and Loading Load Closer to MOP using ASDF or Quicklisp. ```lisp ;; Using Quicklisp (recommended) (ql:quickload :closer-mop) ;; Using ASDF directly (asdf:load-system :closer-mop) ;; Use the package in your code (defpackage :my-mop-code (:use :closer-common-lisp) ; CL + MOP symbols combined (:import-from :closer-mop :ensure-finalized :subclassp)) ;; Or use shadow imports for specific symbols (defpackage :my-package (:use :common-lisp) (:shadowing-import-from :closer-mop :defclass :defgeneric :defmethod :standard-class :standard-generic-function)) ``` ``` -------------------------------- ### Work with EQL Specializers using intern-eql-specializer and eql-specializer-object Source: https://context7.com/pcostanza/closer-mop/llms.txt This example illustrates how to create and use EQL specializers, which match specific objects rather than classes. It shows defining methods with EQL specializers, programmatically interning them, and extracting the object from an EQL specializer. ```lisp ;; Create an EQL specializer (c2mop:defgeneric handle-command (cmd) (:method ((cmd t)) (format nil "Unknown command: ~S" cmd))) ;; Add method with EQL specializer (c2mop:defmethod handle-command ((cmd (eql :quit))) "Goodbye!") (c2mop:defmethod handle-command ((cmd (eql :help))) "Available commands: :quit, :help, :status") ;; Intern an EQL specializer programmatically (let ((status-specializer (c2mop:intern-eql-specializer :status))) ;; Add method using ensure-method (c2mop:ensure-method #'handle-command '(lambda (cmd) "System running normally") :specializers (list status-specializer))) ;; Test the methods (handle-command :quit) ;; => "Goodbye!" (handle-command :help) ;; => "Available commands: ..." (handle-command :status) ;; => "System running normally" (handle-command :other) ;; => "Unknown command: :OTHER" ;; Extract object from EQL specializer (let ((spec (c2mop:intern-eql-specializer :quit))) (c2mop:eql-specializer-object spec)) ;; => :QUIT ``` -------------------------------- ### Compute Applicable Methods Using Classes with compute-applicable-methods-using-classes Source: https://context7.com/pcostanza/closer-mop/llms.txt This example shows how to compute applicable methods for a generic function based on argument classes, rather than actual argument values. It returns the applicable methods and a boolean indicating if the result is definitive. ```lisp (c2mop:defgeneric process (x y) (:method ((x number) (y number)) (+ x y)) (:method ((x string) (y string)) (concatenate 'string x y)) (:method ((x t) (y t)) (list x y))) ;; Find applicable methods for specific classes (multiple-value-bind (methods definitive-p) (c2mop:compute-applicable-methods-using-classes #'process (list (find-class 'integer) (find-class 'integer))) (values (mapcar (lambda (m) (mapcar #'class-name (c2mop:method-specializers m))) methods) definitive-p)) ;; => ((NUMBER NUMBER) (T T)) ;; T ;; With EQL specializers, result may not be definitive ;; (would need actual argument values) ``` -------------------------------- ### Install and Load Closer to MOP Source: https://context7.com/pcostanza/closer-mop/llms.txt Instructions for loading the Closer to MOP library using Quicklisp or ASDF. It also shows how to use the `CLOSER-MOP` package and its extended Common Lisp packages (`CLOSER-COMMON-LISP`, `CLOSER-COMMON-LISP-USER`) in your own code, including package definitions with standard CL symbols combined with MOP functionality or shadowing imports. ```lisp ;; Using Quicklisp (recommended) (ql:quickload :closer-mop) ;; Using ASDF directly (asdf:load-system :closer-mop) ;; Use the package in your code (defpackage :my-mop-code (:use :closer-common-lisp) ; CL + MOP symbols combined (:import-from :closer-mop :ensure-finalized :subclassp)) ;; Or use shadow imports for specific symbols (defpackage :my-package (:use :common-lisp) (:shadowing-import-from :closer-mop :defclass :defgeneric :defmethod :standard-class :standard-generic-function)) ``` -------------------------------- ### Inspect Class Metaobjects in Common Lisp Source: https://context7.com/pcostanza/closer-mop/llms.txt Provides functions to access detailed information about class metaobjects, including direct and all slots, class precedence list, superclasses, subclasses, finalization status, default initialization arguments, and class prototypes. Requires the Common Lisp Metaobject Protocol (MOP). ```lisp (defclass person () ((name :initarg :name :reader person-name :initform "Unknown") (age :initarg :age :accessor person-age :type integer)) (:default-initargs :age 0)) (defclass employee (person) ((employee-id :initarg :id :reader employee-id) (department :initarg :dept :accessor employee-dept))) (c2mop:ensure-finalized (find-class 'employee)) ;; Get direct slots (mapcar #'c2mop:slot-definition-name (c2mop:class-direct-slots (find-class 'employee))) ;; => (EMPLOYEE-ID DEPARTMENT) ;; Get all slots (mapcar #'c2mop:slot-definition-name (c2mop:class-slots (find-class 'employee))) ;; => (NAME AGE EMPLOYEE-ID DEPARTMENT) ;; Get class precedence list (mapcar #'class-name (c2mop:class-precedence-list (find-class 'employee))) ;; => (EMPLOYEE PERSON STANDARD-OBJECT T) ;; Get direct superclasses (mapcar #'class-name (c2mop:class-direct-superclasses (find-class 'employee))) ;; => (PERSON) ;; Get direct subclasses (c2mop:class-direct-subclasses (find-class 'person)) ;; => (#) ;; Check if finalized (c2mop:class-finalized-p (find-class 'employee)) ;; => T ;; Get default initargs (c2mop:class-default-initargs (find-class 'person)) ;; => ((:AGE 0 #)) ;; Get class prototype (c2mop:class-prototype (find-class 'person)) ;; => # ``` -------------------------------- ### required-args Source: https://context7.com/pcostanza/closer-mop/llms.txt Extracts the required arguments from a lambda list. This utility function collects all arguments before any lambda-list keywords (`&optional`, `&rest`, `&key`, etc.). ```APIDOC ## `required-args` Extracts the required arguments from a lambda list. ### Method `REQUIRED-ARGS` ### Endpoint N/A (Function) ### Parameters #### Path Parameters N/A #### Query Parameters N/A #### Request Body N/A ### Request Example ```lisp ;; Basic usage - extract required arguments from a lambda list (c2mop:required-args '(x y z)) ;; => (X Y Z) (c2mop:required-args '(a b &optional c &key d)) ;; => (A B) (c2mop:required-args '(first second &rest others)) ;; => (FIRST SECOND) ;; With a collector function to transform each argument (c2mop:required-args '(x y z) #'string) ;; => ("X" "Y" "Z") ;; Practical use: create default specializers for a generic function (c2mop:required-args '(obj key &optional default) (constantly (find-class 't))) ;; => (# #) ``` ### Response #### Success Response (200) Returns a list of symbols representing the required arguments. #### Response Example ```lisp (X Y Z) ``` #### Error Handling N/A ``` -------------------------------- ### Introspect CLOS Methods and Generic Functions in Lisp Source: https://context7.com/pcostanza/closer-mop/llms.txt Access detailed information about CLOS generic functions and their methods, including specializers, qualifiers, lambda lists, and the method function itself. This is useful for understanding method dispatch and behavior. ```lisp ;; Get methods from a generic function (let* ((gf #'describe-object) (methods (c2mop:generic-function-methods gf))) ;; Find a specific method (let ((string-method (find (find-class 'string) methods :key (lambda (m) (first (c2mop:method-specializers m)))))) ;; Method specializers (mapcar (lambda (s) (if (c2mop:classp s) (class-name s) s)) (c2mop:method-specializers string-method)) ;; => (STRING T) ;; Method qualifiers (e.g., :before, :after, :around) (c2mop:method-qualifiers string-method) ;; => NIL ; primary method ;; Method lambda list (c2mop:method-lambda-list string-method) ;; => (OBJ STREAM) ;; Method function (c2mop:method-function string-method) ;; => # ;; Associated generic function (c2mop:method-generic-function string-method) ;; => # )) ``` -------------------------------- ### Inspect Slot Definitions in Common Lisp Source: https://context7.com/pcostanza/closer-mop/llms.txt Enables detailed inspection of slot definitions within a class, including initargs, readers, writers, allocation type, type specifier, and initial form. This requires the Common Lisp Metaobject Protocol (MOP) and assumes classes are finalized. ```lisp (defclass product () ((id :initarg :id :reader product-id :allocation :instance :type integer :documentation "Unique product identifier") (name :initarg :name :initarg :product-name :accessor product-name :initform "Unnamed") (price :initarg :price :reader product-price :writer set-product-price) (category :allocation :class :initform :general :accessor product-category))) (c2mop:ensure-finalized (find-class 'product)) ;; Get a specific slot definition (let ((slot (find 'name (c2mop:class-slots (find-class 'product)) :key #'c2mop:slot-definition-name))) ;; Slot name (c2mop:slot-definition-name slot) ;; => NAME ;; Initargs (c2mop:slot-definition-initargs slot) ;; => (:NAME :PRODUCT-NAME) ;; Initform (c2mop:slot-definition-initform slot) ;; => "Unnamed" ;; Initfunction (funcall (c2mop:slot-definition-initfunction slot)) ;; => "Unnamed" ;; Readers and writers (c2mop:slot-definition-readers slot) ;; => (PRODUCT-NAME) (c2mop:slot-definition-writers slot) ;; => ((SETF PRODUCT-NAME)) ;; Allocation type (c2mop:slot-definition-allocation slot) ;; => :INSTANCE ;; Type specifier (c2mop:slot-definition-type slot) ;; => T ;; Location (c2mop:slot-definition-location slot)) ;; => 1 ``` -------------------------------- ### Direct CLOS Instance Slot Access with standard-instance-access in Lisp Source: https://context7.com/pcostanza/closer-mop/llms.txt Perform direct and efficient slot access on CLOS instances using their location index. This bypasses the standard slot access protocol and is suitable for performance-critical code. It requires obtaining the slot's location beforehand. ```lisp ;; Get slot location (let* ((class (find-class 'person)) (slot (find 'name (c2mop:class-slots class) :key #'c2mop:slot-definition-name)) (location (c2mop:slot-definition-location slot))) ;; Create an instance (let ((person (make-instance 'person :name "Alice"))) ;; Direct read access (fastest) (c2mop:standard-instance-access person location) ;; => "Alice" ;; Direct write access (setf (c2mop:standard-instance-access person location) "Bob") ;; Verify change (person-name person))) ;; => "Bob" ;; For funcallable instances, use funcallable-standard-instance-access ;; (Works similarly but for funcallable-standard-class instances) ``` -------------------------------- ### Normalize Slot Initargs with fix-slot-initargs Source: https://context7.com/pcostanza/closer-mop/llms.txt This snippet demonstrates the use of `fix-slot-initargs` to normalize slot initialization arguments for portable `direct-slot-definition-class` methods. This is necessary on some implementations where multiple slot options are not correctly combined into lists. ```lisp ;; When defining direct-slot-definition-class, use fix-slot-initargs ;; to ensure portable behavior (defclass my-metaclass (c2mop:standard-class) ()) (c2mop:defmethod c2mop:validate-superclass ((class my-metaclass) (super c2mop:standard-class)) t) (c2mop:defmethod c2mop:direct-slot-definition-class ((class my-metaclass) &rest initargs) ;; Fix initargs for portability across implementations (destructuring-bind (&key my-custom-option &allow-other-keys) (c2mop:fix-slot-initargs initargs) (if my-custom-option (find-class 'my-special-slot-definition) (call-next-method)))) ``` -------------------------------- ### classp Source: https://context7.com/pcostanza/closer-mop/llms.txt Predicate to test if an object is a class metaobject. Works consistently across all supported implementations. ```APIDOC ## `classp` Predicate to test if an object is a class metaobject. ### Method `CLASSP` ### Endpoint N/A (Function) ### Parameters #### Path Parameters N/A #### Query Parameters N/A #### Request Body N/A ### Request Example ```lisp ;; Test various objects (c2mop:classp (find-class 'standard-class)) ;; => T (c2mop:classp (find-class 'integer)) ;; => T (c2mop:classp 'standard-class) ;; => NIL (symbol, not a class) (c2mop:classp (make-instance 'standard-object)) ;; => NIL (instance, not a class) ;; Practical use in validation (defun validate-metaclass (thing) (unless (c2mop:classp thing) (error "Expected a class, got ~S" thing)) thing) ``` ### Response #### Success Response (200) Returns `T` if the object is a class metaobject, otherwise returns `NIL`. #### Response Example ```lisp T ``` #### Error Handling N/A ``` -------------------------------- ### Inspect Generic Function Metaobjects in Common Lisp Source: https://context7.com/pcostanza/closer-mop/llms.txt Allows introspection of generic function metaobjects, including their names, lambda lists, associated methods, method class, method combination strategy, argument precedence order, and declarations. This functionality relies on the Common Lisp Metaobject Protocol (MOP). ```lisp (c2mop:defgeneric describe-object (obj stream) (:documentation "Describe an object to a stream") (:method-combination standard) (:method ((obj t) stream) (format stream "An object: ~S" obj))) (c2mop:defmethod describe-object ((obj string) stream) (format stream "A string of length ~D: ~S" (length obj) obj)) (c2mop:defmethod describe-object :before ((obj sequence) stream) (format stream "[Sequence] ")) ;; Get the generic function object (let ((gf #'describe-object)) ;; Generic function name (c2mop:generic-function-name gf) ;; => DESCRIBE-OBJECT ;; Lambda list (c2mop:generic-function-lambda-list gf) ;; => (OBJ STREAM) ;; All methods (length (c2mop:generic-function-methods gf)) ;; => 3 ;; Method class (c2mop:generic-function-method-class gf) ;; => # ;; Method combination (c2mop:generic-function-method-combination gf) ;; => # ;; Argument precedence order (c2mop:generic-function-argument-precedence-order gf) ;; => (OBJ STREAM) ;; Declarations (c2mop:generic-function-declarations gf)) ;; => NIL ``` -------------------------------- ### Finalize Class Metaobjects with `ensure-finalized` Source: https://context7.com/pcostanza/closer-mop/llms.txt The `ensure-finalized` function ensures that a class metaobject is finalized by calling `finalize-inheritance` if necessary. It returns the class object and is crucial before accessing class slots, precedence lists, or prototypes. The `errorp` argument can be set to `nil` to return `NIL` for non-class objects instead of signaling an error. ```lisp ;; Define a class (defclass my-point () ((x :initarg :x :accessor point-x) (y :initarg :y :accessor point-y))) ;; Ensure it's finalized before introspection (c2mop:ensure-finalized (find-class 'my-point)) ;; => # ;; Now safe to access class information (c2mop:class-slots (find-class 'my-point)) ;; => (# ;; #) ;; With errorp = nil, returns NIL for non-classes instead of signaling (c2mop:ensure-finalized 'not-a-class nil) ;; => NIL ;; Error case (default behavior) (c2mop:ensure-finalized 'not-a-class) ;; Error: NOT-A-CLASS is not a class. ``` -------------------------------- ### Define Valid Metaclass Combinations with validate-superclass Source: https://context7.com/pcostanza/closer-mop/llms.txt This snippet demonstrates how to define custom metaclasses and use the `validate-superclass` method to control which metaclass combinations are valid. It allows `persistent-class` to inherit from `standard-class` and enables mixing `persistent-class` and `audited-class`. ```lisp ;; Define custom metaclasses (defclass persistent-class (c2mop:standard-class) ()) (defclass audited-class (c2mop:standard-class) ()) ;; Allow persistent-class to inherit from standard-class (c2mop:defmethod c2mop:validate-superclass ((class persistent-class) (super c2mop:standard-class)) t) ;; Allow mixing persistent and audited classes (c2mop:defmethod c2mop:validate-superclass ((class persistent-class) (super audited-class)) t) (c2mop:defmethod c2mop:validate-superclass ((class audited-class) (super c2mop:standard-class)) t) ;; Now these class definitions work (defclass base-entity () ((id :initarg :id)) (:metaclass persistent-class)) (defclass audited-entity (base-entity) ((created-at :initform (get-universal-time))) (:metaclass persistent-class)) ; OK, validates against persistent-class ``` -------------------------------- ### ensure-finalized Source: https://context7.com/pcostanza/closer-mop/llms.txt Ensures that a class metaobject is finalized by calling `finalize-inheritance` if needed. Returns the class. This is essential before accessing class slots, precedence list, or prototype. ```APIDOC ## `ensure-finalized` Ensures that a class metaobject is finalized. ### Method `ENSURE-FINALIZED` ### Endpoint N/A (Function) ### Parameters #### Path Parameters N/A #### Query Parameters N/A #### Request Body N/A ### Request Example ```lisp ;; Define a class (defclass my-point () ((x :initarg :x :accessor point-x) (y :initarg :y :accessor point-y))) ;; Ensure it's finalized before introspection (c2mop:ensure-finalized (find-class 'my-point)) ;; => # ;; Now safe to access class information (c2mop:class-slots (find-class 'my-point)) ;; => (# ;; #) ;; With errorp = nil, returns NIL for non-classes instead of signaling (c2mop:ensure-finalized 'not-a-class nil) ;; => NIL ;; Error case (default behavior) (c2mop:ensure-finalized 'not-a-class) ;; Error: NOT-A-CLASS is not a class. ``` ### Response #### Success Response (200) Returns the finalized class metaobject. #### Response Example ```lisp # ``` #### Error Handling Signals an error if the provided object is not a class and `errorp` is not `nil`. ``` -------------------------------- ### Programmatically Add CLOS Methods with ensure-method in Lisp Source: https://context7.com/pcostanza/closer-mop/llms.txt Dynamically add methods to a generic function without using the defmethod macro. This function is essential for runtime method generation and modification. It allows specifying the generic function, method function, qualifiers, and specializers. ```lisp ;; Define a generic function (c2mop:defgeneric greet (person) (:documentation "Generate a greeting")) ;; Add a method programmatically (c2mop:ensure-method #'greet '(lambda (person) (format nil "Hello, ~A!" (person-name person))) :qualifiers '() :specializers (list (find-class 'person))) ;; => # ;; Add a method with qualifiers (c2mop:ensure-method #'greet '(lambda (person) (format t "~&Greeting: ")) :qualifiers '(:before) :specializers (list (find-class 'person))) ;; Verify methods were added (length (c2mop:generic-function-methods #'greet)) ;; => 2 ``` -------------------------------- ### Check for Class Metaobjects with `classp` Source: https://context7.com/pcostanza/closer-mop/llms.txt The `classp` predicate reliably tests if an object is a class metaobject across different Common Lisp implementations. It returns `T` for class objects (like those returned by `find-class`) and `NIL` for symbols or instances. ```lisp ;; Test various objects (c2mop:classp (find-class 'standard-class)) ;; => T (c2mop:classp (find-class 'integer)) ;; => T (c2mop:classp 'standard-class) ;; => NIL (symbol, not a class) (c2mop:classp (make-instance 'standard-object)) ;; => NIL (instance, not a class) ;; Practical use in validation (defun validate-metaclass (thing) (unless (c2mop:classp thing) (error "Expected a class, got ~S" thing)) thing) ``` -------------------------------- ### subclassp Source: https://context7.com/pcostanza/closer-mop/llms.txt Tests whether a class is a subclass of another class. More robust than `subtypep` in some edge cases involving class metaobjects. Accepts either class objects or class names (symbols). ```APIDOC ## `subclassp` Tests whether a class is a subclass of another class. ### Method `SUBCLASSP` ### Endpoint N/A (Function) ### Parameters #### Path Parameters N/A #### Query Parameters N/A #### Request Body N/A ### Request Example ```lisp ;; Define a class hierarchy (defclass animal () ()) (defclass mammal (animal) ()) (defclass dog (mammal) ()) ;; Test subclass relationships with class objects (c2mop:subclassp (find-class 'dog) (find-class 'animal)) ;; => T (c2mop:subclassp (find-class 'mammal) (find-class 'dog)) ;; => NIL ;; Test with symbols (class names) (c2mop:subclassp 'dog 'mammal) ;; => T (c2mop:subclassp 'dog 'dog) ;; => T ; A class is a subclass of itself ;; Mix symbols and class objects (c2mop:subclassp 'dog (find-class 'animal)) ;; => T ``` ### Response #### Success Response (200) Returns `T` if the first class is a subclass of the second class, otherwise returns `NIL`. #### Response Example ```lisp T ``` #### Error Handling N/A ``` -------------------------------- ### Compile Effective Method Function with compute-effective-method-function Source: https://context7.com/pcostanza/closer-mop/llms.txt This snippet demonstrates how to compile an effective method form into a callable function using `compute-effective-method-function`. This is typically used internally for optimizing method dispatch. ```lisp ;; Advanced usage: Custom method combination processing (let* ((gf #'process) (methods (c2mop:compute-applicable-methods gf '(1 2))) (mc (c2mop:generic-function-method-combination gf)))) ;; Compute the effective method form (multiple-value-bind (effective-method options) (c2mop:compute-effective-method gf mc methods) ;; Compile it into a function (let ((emf (c2mop:compute-effective-method-function gf effective-method options))) ;; Call the effective method function directly (funcall emf 10 20)))) ;; => 30 ``` -------------------------------- ### Extract Required Arguments with `required-args` Source: https://context7.com/pcostanza/closer-mop/llms.txt The `required-args` utility function extracts all arguments from a lambda list that appear before any lambda-list keywords like `&optional`, `&rest`, or `&key`. It can optionally take a function to transform each extracted argument. This is useful for tasks like creating default specializers for generic functions. ```lisp ;; Basic usage - extract required arguments from a lambda list (c2mop:required-args '(x y z)) ;; => (X Y Z) (c2mop:required-args '(a b &optional c &key d)) ;; => (A B) (c2mop:required-args '(first second &rest others)) ;; => (FIRST SECOND) ;; With a collector function to transform each argument (c2mop:required-args '(x y z) #'string) ;; => ("X" "Y" "Z") ;; Practical use: create default specializers for a generic function (c2mop:required-args '(obj key &optional default) (constantly (find-class 't))) ;; => (# #) ``` -------------------------------- ### Customize CLOS Slot Access with slot-value-using-class in Lisp Source: https://context7.com/pcostanza/closer-mop/llms.txt Override the low-level slot access protocol by defining methods on the slot-value-using-class generic function. This allows for custom behavior, such as logging or validation, when slots are read or written, especially when using custom metaclasses. ```lisp ;; Define a metaclass that logs slot access (defclass logged-class (c2mop:standard-class) ()) (c2mop:defmethod c2mop:validate-superclass ((class logged-class) (super c2mop:standard-class)) t) ;; Override slot-value-using-class for logging (c2mop:defmethod c2mop:slot-value-using-class :before ((class logged-class) object slot) (format t "~&Reading slot ~A from ~S~%" (c2mop:slot-definition-name slot) object)) (c2mop:defmethod (setf c2mop:slot-value-using-class) :before (new-value (class logged-class) object slot) (format t "~&Writing ~S to slot ~A of ~S~%" new-value (c2mop:slot-definition-name slot) object)) ;; Define a class using the metaclass (defclass logged-point () ((x :initarg :x :accessor point-x) (y :initarg :y :accessor point-y)) (:metaclass logged-class)) ;; Usage demonstrates logging (let ((p (make-instance 'logged-point :x 10 :y 20))) (point-x p) ; Prints: Reading slot X from # (setf (point-y p) 30)) ; Prints: Writing 30 to slot Y of ... ``` -------------------------------- ### Define Custom Metaclass for Validated Slots in Lisp Source: https://context7.com/pcostanza/closer-mop/llms.txt This Lisp code defines a custom metaclass `validated-class` that allows for slots with custom validation logic. It introduces `validated-slot-definition` and `validated-effective-slot-definition` to handle slot validation, and overrides methods like `validate-superclass`, `direct-slot-definition-class`, `effective-slot-definition-class`, `compute-effective-slot-definition`, and `slot-value-using-class` to integrate the validation mechanism. Finally, it demonstrates usage with a `user` class that has an email validation. ```lisp ;; Define a metaclass for validated slots (defclass validated-class (c2mop:standard-class) ()) (c2mop:defmethod c2mop:validate-superclass ((class validated-class) (super c2mop:standard-class)) t) ;; Custom slot definition with validator (defclass validated-slot-definition (c2mop:standard-direct-slot-definition) ((validator :initarg :validator :initform nil :reader slot-validator))) (defclass validated-effective-slot-definition (c2mop:standard-effective-slot-definition) ((validator :initform nil :accessor slot-validator))) ;; Use custom slot definition class when :validator is provided (c2mop:defmethod c2mop:direct-slot-definition-class ((class validated-class) &rest initargs) (if (getf initargs :validator) (find-class 'validated-slot-definition) (call-next-method))) (c2mop:defmethod c2mop:effective-slot-definition-class ((class validated-class) &rest initargs) (declare (ignore initargs)) (find-class 'validated-effective-slot-definition)) ;; Propagate validator to effective slot (c2mop:defmethod c2mop:compute-effective-slot-definition ((class validated-class) name direct-slots) (let ((slot (call-next-method))) (setf (slot-validator slot) (some #'slot-validator direct-slots)) slot)) ;; Validate on write (c2mop:defmethod (setf c2mop:slot-value-using-class) (new-value (class validated-class) object (slot validated-effective-slot-definition)) (let ((validator (slot-validator slot))) (when (and validator (not (funcall validator new-value))) (error "Validation failed for slot ~A: ~S" (c2mop:slot-definition-name slot) new-value))) (call-next-method)) ;; Use the metaclass (defclass user () ((email :initarg :email :accessor user-email :validator (lambda (v) (and (stringp v) (find #\@ v))))) (:metaclass validated-class)) (let ((u (make-instance 'user))) (setf (user-email u) "test@example.com") ; OK (setf (user-email u) "invalid")) ; Error: Validation failed ``` -------------------------------- ### Test Class Hierarchy with `subclassp` Source: https://context7.com/pcostanza/closer-mop/llms.txt The `subclassp` function tests if one class is a subclass of another, accepting either class objects or class names (symbols). It is more robust than `subtypep` in certain edge cases involving class metaobjects. A class is considered a subclass of itself. ```lisp ;; Define a class hierarchy (defclass animal () ()) (defclass mammal (animal) ()) (defclass dog (mammal) ()) ;; Test subclass relationships with class objects (c2mop:subclassp (find-class 'dog) (find-class 'animal)) ;; => T (c2mop:subclassp (find-class 'mammal) (find-class 'dog)) ;; => NIL ;; Test with symbols (class names) (c2mop:subclassp 'dog 'mammal) ;; => T (c2mop:subclassp 'dog 'dog) ;; => T ; A class is a subclass of itself ;; Mix symbols and class objects (c2mop:subclassp 'dog (find-class 'animal)) ;; => T ``` === COMPLETE CONTENT === This response contains all available snippets from this library. No additional content exists. Do not make further requests.