;;;----- Licensing notice ---------------------------------------------------
;;;
-;;; This file is part of the Sensble Object Design, an object system for C.
+;;; This file is part of the Sensible Object Design, an object system for C.
;;;
;;; SOD is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
(:constructor %make-property
(name value
&key type location seenp
- &aux (key (property-key name)))))
+ &aux (key (property-key name)) (%type type))))
"A simple structure for holding a property in a property set.
The main useful feature is the ability to tick off properties which have
(name nil :type (or string symbol))
(value nil :type t)
- (type nil :type symbol)
+ (%type nil :type symbol)
(location (file-location nil) :type file-location)
(key nil :type symbol)
(seenp nil :type boolean))
+(define-access-wrapper p-type p-%type)
(export 'decode-property)
(defgeneric decode-property (raw)
;; If the caller asks for type T then give him the raw thing.
(:method (value type (wanted (eql t)))
+ (declare (ignore type))
value))
;;;--------------------------------------------------------------------------
(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 --------------------------------------------------