Fix defclass* to accept non-standard slot options
author |
Steve Losh <steve@stevelosh.com> |
date |
Sun, 26 Jul 2020 20:11:23 -0400 |
parents |
54ec08936d37
|
children |
1ca3e16900aa
|
branches/tags |
(none) |
files |
src/clos.lisp |
Changes
--- a/src/clos.lisp Sun Jul 26 20:11:01 2020 -0400
+++ b/src/clos.lisp Sun Jul 26 20:11:23 2020 -0400
@@ -1,23 +1,17 @@
(in-package :losh.clos)
(defun build-slot-definition (conc-name slot-spec)
- (destructuring-bind (name &key
- (type nil type?)
- (documentation nil documentation?)
- (initform nil initform?)
- (allocation nil allocation?)
- (accessor (if conc-name
- (symb conc-name name)
- name))
- (initarg (ensure-keyword name)))
- (ensure-list slot-spec)
+ (destructuring-bind (name &rest slot-options) (ensure-list slot-spec)
`(,name
- :initarg ,initarg
- :accessor ,accessor
- ,@(when initform? `(:initform ,initform))
- ,@(when allocation? `(:allocation ,allocation))
- ,@(when type? `(:type ,type))
- ,@(when documentation? `(:documentation ,documentation)))))
+ ,@(unless (getf slot-options :initarg)
+ `(:initarg ,(ensure-keyword name)))
+ ,@(unless (or (getf slot-options :reader)
+ (getf slot-options :writer)
+ (getf slot-options :accessor))
+ `(:accessor ,(if conc-name
+ (symb conc-name name)
+ name)))
+ ,@slot-args)))
(defmacro defclass* (name-and-options direct-superclasses slots &rest options)
"`defclass` without the tedium.