X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/048d0b2d143b6a491ac73eed6ab972e97774391c..ecdf14f08ed32423aceb7feca0a20971003957e5:/src/pset-proto.lisp diff --git a/src/pset-proto.lisp b/src/pset-proto.lisp index 91668ed..332bcef 100644 --- a/src/pset-proto.lisp +++ b/src/pset-proto.lisp @@ -45,7 +45,7 @@ (: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 @@ -57,10 +57,11 @@ (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) @@ -70,7 +71,8 @@ (:method ((raw string)) (values :string raw)) (:method ((raw character)) (values :char raw)) (:method ((raw property)) (values (p-type raw) (p-value raw))) - (:method ((raw cons)) (values (car raw) (cdr raw)))) + (:method ((raw cons)) (values (car raw) (cdr raw))) + (:method ((raw function)) (values :func raw))) (export 'make-property) (defun make-property (name raw-value &key type location seenp) @@ -146,6 +148,7 @@ ;; If the caller asks for type T then give him the raw thing. (:method (value type (wanted (eql t))) + (declare (ignore type)) value)) ;;;-------------------------------------------------------------------------- @@ -170,7 +173,7 @@ (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) @@ -224,7 +227,10 @@ Otherwise the value is coerced to the right kind of thing (where possible) and returned. - If PSET is nil, then return DEFAULT." + The file location at which the property was defined is returned as a + second value. + + If PSET is nil, then return DEFAULT and nil." (let ((prop (and pset (pset-get pset (property-key name))))) (with-default-error-location ((and prop (p-location prop))) @@ -284,7 +290,7 @@ ((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 @@ -300,7 +306,7 @@ ;;; 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)