├── .gitignore ├── src ├── package.lisp └── dynamic-mixins.lisp ├── dynamic-mixins.asd └── README.md /.gitignore: -------------------------------------------------------------------------------- 1 | *.fasl 2 | *.lx??fsl 3 | *~ 4 | \#* 5 | .\#* 6 | *.so 7 | -------------------------------------------------------------------------------- /src/package.lisp: -------------------------------------------------------------------------------- 1 | (defpackage :dynamic-mixins 2 | (:use #:closer-common-lisp #:alexandria) 3 | (:export #:mixin-class #:mixin-object 4 | #:ensure-mix #:delete-from-mix #:mix)) 5 | -------------------------------------------------------------------------------- /dynamic-mixins.asd: -------------------------------------------------------------------------------- 1 | (defpackage :dynamic-mixins.asdf 2 | (:use #:cl #:asdf)) 3 | 4 | (in-package :dynamic-mixins.asdf) 5 | 6 | (defsystem :dynamic-mixins 7 | :description "Simple dynamic class mixing without manual permutations" 8 | :author "Ryan Pavlik" 9 | :license "BSD-2-Clause" 10 | :version "0.0" 11 | 12 | :depends-on (:alexandria :closer-mop) 13 | :pathname "src" 14 | :serial t 15 | 16 | :components 17 | ((:file "package") 18 | (:file "dynamic-mixins"))) 19 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # dynamic-mixins 2 | 3 | Dynamic-mixins is for simple, dynamic class combination: 4 | 5 | ```lisp 6 | (in-package :dynamic-mixins) 7 | 8 | (defclass a () ()) 9 | (defclass b () ()) 10 | (defclass c () ()) 11 | 12 | (make-instance (mix 'a 'b)) ;; => # 13 | 14 | (let ((a (make-instance 'a))) 15 | (ensure-mix a 'b 'c) ;; => # 16 | (delete-from-mix a 'a) ;; => # 17 | (delete-from-mix a 'c)) ;; => # 18 | ``` 19 | 20 | This allows objects to be mixed and updated without manually 21 | defining many permutations. 22 | 23 | ## Dictionary 24 | 25 | * `MIX &rest classes`: This produces a "mix 26 | list", which is generally only useful for passing to 27 | `MAKE-INSTANCE`. Note: Order matters! This determines class 28 | precedence. 29 | 30 | * `ENSURE-MIX object &rest name-or-class`: Ensure that classes listed 31 | in `name-or-class` are part of `object`. This will create a new 32 | class and `CHANGE-CLASS object` if necessary. Note: Order matters! 33 | This determines class precedence. 34 | 35 | * `DELETE-FROM-MIX object &rest name-or-class`: Remove classes listed 36 | in `name-or-class` from the object's class. This will create a new 37 | class and `CHANGE-CLASS object` if necessary. However, `object` 38 | must be a `MIXIN-OBJECT` created by `(MAKE-INSTANCE (MIX ...) ...)` 39 | or `ENSURE-MIX`. Otherwise, nothing will be changed. 40 | 41 | ## Notes 42 | 43 | ### Order and Precedence 44 | 45 | Order matters; you are defining a new class which has the specified 46 | classes as direct superclasses. 47 | 48 | `ENSURE-MIX` *prepends* classes in the order specified. (Originally, 49 | it appended classes.) This is simply more useful in practice: 50 | 51 | ```lisp 52 | (defclass general-object () ()) 53 | (defclass specializing-mixin () ()) 54 | 55 | (defgeneric some-operation (x)) 56 | 57 | (defmethod some-operation (x) 58 | "Handle the general case" 59 | ...) 60 | 61 | (defmethod some-operation ((x specializing-mixin)) 62 | "Handle the case for SPECIALIZING-MIXIN" 63 | ...) 64 | 65 | (let ((x (make-instance 'general-object))) 66 | (ensure-mix x 'specializing-mixin) 67 | (some-operation x)) 68 | ``` 69 | 70 | If `SPECIALIZING-MIXIN` were appended, the method which specialized on 71 | it would never be called. In practice, this defeats the point. 72 | Therefore, mixins now get precedence. 73 | 74 | ### Errors 75 | 76 | Errors regarding precendence and circularity are now handled, or 77 | rather, causing such an error will not produce a nearly-unrecoverable 78 | situation. Now you will just get an error. 79 | -------------------------------------------------------------------------------- /src/dynamic-mixins.lisp: -------------------------------------------------------------------------------- 1 | (in-package :dynamic-mixins) 2 | 3 | (defvar *dynamic-mix-classes* (make-hash-table :test 'equal)) 4 | 5 | (defclass mixin-class (standard-class) 6 | ((classes :initform nil :initarg :classes))) 7 | 8 | (defmethod validate-superclass ((class mixin-class) (super standard-class)) t) 9 | 10 | (defmethod print-object ((o mixin-class) stream) 11 | (with-slots (classes) o 12 | (print-unreadable-object (o stream :identity t) 13 | (format stream "~S ~S" 14 | (or (class-name o) 'mixin-class) 15 | (mapcar #'class-name classes))))) 16 | 17 | (defclass mixin-object () ()) 18 | 19 | (defstruct mix-list (list nil)) 20 | 21 | (defun %find-class (name-or-class) 22 | (etypecase name-or-class 23 | (symbol (find-class name-or-class)) 24 | (class name-or-class))) 25 | 26 | (defun %mix (object-or-class &rest class-list) 27 | "Create a MIX-LIST for MAKE-INSTANCE. The first element may be an 28 | instance; further elements must be class names or classes." 29 | (let ((class0 (typecase object-or-class 30 | (symbol (list (find-class object-or-class))) 31 | (mixin-object 32 | (slot-value (class-of object-or-class) 'classes)) 33 | (t (list (class-of object-or-class)))))) 34 | (make-mix-list 35 | :list (remove-duplicates 36 | (append (mapcar #'%find-class class-list) 37 | class0))))) 38 | 39 | (defun mix (&rest classes) 40 | (make-mix-list :list (remove-duplicates (mapcar #'%find-class classes)))) 41 | 42 | (defun set-superclasses (class list) 43 | (reinitialize-instance class :direct-superclasses list)) 44 | 45 | (defun define-mixin (mix-list) 46 | (let ((new-class (make-instance 'mixin-class 47 | :classes (mix-list-list mix-list)))) 48 | (handler-case 49 | (progn 50 | (set-superclasses new-class (list* (find-class 'mixin-object) 51 | (mix-list-list mix-list)))) 52 | (error (e) 53 | (set-superclasses new-class nil) 54 | (error e))) 55 | (setf (gethash (mix-list-list mix-list) *dynamic-mix-classes*) 56 | new-class))) 57 | 58 | (defun ensure-mixin (mix-list) 59 | (if (cdr (mix-list-list mix-list)) 60 | (if-let ((class (gethash (mix-list-list mix-list) 61 | *dynamic-mix-classes*))) 62 | class 63 | (define-mixin mix-list)) 64 | (car (mix-list-list mix-list)))) 65 | 66 | (defun ensure-mix (object &rest classes) 67 | (let ((new-class (ensure-mixin (apply #'%mix object classes)))) 68 | (change-class object new-class))) 69 | 70 | (defun delete-from-mix (object &rest classes) 71 | (if (typep object 'mixin-object) 72 | (let* ((classes (mapcar #'%find-class classes)) 73 | (old-classes (slot-value (class-of object) 'classes)) 74 | (new-classes (remove-if (lambda (x) (member (%find-class x) classes)) 75 | old-classes)) 76 | (new-class (if (cdr new-classes) 77 | (ensure-mixin (apply #'mix new-classes)) 78 | (car new-classes)))) 79 | (change-class object new-class)) 80 | object)) 81 | 82 | (defmethod make-instance ((items mix-list) &rest initargs &key &allow-other-keys) 83 | (apply #'make-instance (ensure-mixin items) initargs)) 84 | --------------------------------------------------------------------------------