(defun pset-get (pset key)
"Look KEY up in PSET and return what we find.
- If there's no property by that name, return NIL."
+ If there's no property by that name, return nil."
(values (gethash key (%pset-hash pset))))
(defun pset-store (pset prop)
((endp list) pset)
(add-property pset (funcall name list) (funcall value list))))))
-(export 'check--unused-properties)
+(export 'check-unused-properties)
(defun check-unused-properties (pset)
"Issue errors about unused properties in PSET."
(when pset
;;; Utility macros.
(defmacro default-slot-from-property
- ((instance slot slot-names)
+ ((instance slot &optional (slot-names t))
(pset property type
&optional (pvar (gensym "PROP-"))
&rest convert-forms)
slot value."
(once-only (instance slot slot-names pset property type)
- (with-gensyms (floc)
- `(multiple-value-bind (,pvar ,floc)
- (get-property ,pset ,property ,type)
- (if ,floc
- (setf (slot-value ,instance ,slot)
- (with-default-error-location (,floc)
- ,@(or convert-forms `(,pvar))))
- (default-slot (,instance ,slot ,slot-names)
- ,@default-forms))))))
+ (multiple-value-bind (docs decls body)
+ (parse-body default-forms :docp nil)
+ (declare (ignore docs))
+ (with-gensyms (floc)
+ `(multiple-value-bind (,pvar ,floc)
+ (get-property ,pset ,property ,type)
+ ,@decls
+ (if ,floc
+ (setf (slot-value ,instance ,slot)
+ (with-default-error-location (,floc)
+ ,@(or convert-forms `(,pvar))))
+ (default-slot (,instance ,slot ,slot-names)
+ ,@body)))))))
;;;----- That's all, folks --------------------------------------------------