X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/b8c698eeb25ff564145079e4310b0bd71f84155b..3aab0efa423fe20713c8cc02e8aabdf7fe84056b:/src/pset-proto.lisp diff --git a/src/pset-proto.lisp b/src/pset-proto.lisp index 2326eba..61793b5 100644 --- a/src/pset-proto.lisp +++ b/src/pset-proto.lisp @@ -7,7 +7,7 @@ ;;;----- 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 @@ -55,13 +55,13 @@ distinctly about identifiers, strings and symbols, and we've only got two obvious Lisp types to play with. Sad, but true." - (name nil :type (or string symbol)) - (value nil :type t) - (%type nil :type symbol) - (location (file-location nil) :type file-location) - (key nil :type symbol) + (name nil :type (or string symbol) :read-only t) + (value nil :type t :read-only t) + (%type nil :type symbol :read-only t) + (location (file-location nil) :type file-location :read-only t) + (key nil :type symbol :read-only t) (seenp nil :type boolean)) -(define-access-wrapper p-type p-%type) +(define-access-wrapper p-type p-%type :read-only t) (export 'decode-property) (defgeneric decode-property (raw) @@ -72,7 +72,8 @@ (: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 function)) (values :func raw))) + (:method ((raw function)) (values :func raw)) + (:method ((raw c-type)) (values :type raw))) (export 'make-property) (defun make-property (name raw-value &key type location seenp) @@ -316,7 +317,8 @@ We initialize SLOT in INSTANCE. In full: if PSET contains a property called NAME, then convert it to TYPE, bind the value to PVAR and evaluate CONVERT-FORMS -- these default to just using the property value. If - there's no property, and the slot is named in SLOT-NAMES and currently + there's no property, and DEFAULT-FORMS contains at least one non- + declaration form, and the slot is named in SLOT-NAMES and currently unbound, then evaluate DEFAULT-FORMS and use their value to compute the slot value." @@ -332,7 +334,8 @@ (setf (slot-value ,instance ,slot) (with-default-error-location (,floc) ,@(or convert-forms `(,pvar)))) - (default-slot (,instance ,slot ,slot-names) - ,@body))))))) + ,@(and body + `((default-slot (,instance ,slot ,slot-names) + ,@body))))))))) ;;;----- That's all, folks --------------------------------------------------