X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/048d0b2d143b6a491ac73eed6ab972e97774391c..b492babc8de898bd22d638d7c25f24356896a3a9:/src/class-make-proto.lisp diff --git a/src/class-make-proto.lisp b/src/class-make-proto.lisp index 2b4463a..7305807 100644 --- a/src/class-make-proto.lisp +++ b/src/class-make-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 @@ -33,8 +33,8 @@ "Construct and return a new SOD class with the given NAME and SUPERCLASSES. This is the main constructor function for classes. The protocol works as - follows. The `:lisp-class' property in PSET is checked: if it exists, it - must be a symbol naming a (CLOS) class, which is used in place of + follows. The `:lisp-metaclass' property in PSET is checked: if it exists, + it must be a symbol naming a (CLOS) class, which is used in place of `sod-class'. All of the arguments are then passed to `make-instance'; further behaviour is left to the standard CLOS instance construction protocol; for example, `sod-class' defines an `:after'-method on @@ -45,8 +45,14 @@ (with-default-error-location (location) (let* ((pset (property-set pset)) - (class (make-instance (get-property pset :lisp-class :symbol - 'sod-class) + (best-class (or (get-property pset :lisp-metaclass :symbol nil) + (if superclasses + (maximum (mapcar #'class-of superclasses) + #'subtypep + (format nil "Lisp metaclass for ~A" + name)) + 'sod-class))) + (class (make-instance best-class :name name :superclasses superclasses :location (file-location location) @@ -71,7 +77,7 @@ This is the main constructor function for slots. This is a generic function primarily so that the CLASS can intervene in the construction - process. The default method uses the `:lisp-class' property (defaulting + process. The default method uses the `:slot-class' property (defaulting to `sod-slot') to choose a (CLOS) class to instantiate. The slot is then constructed by `make-instance' passing the arguments as initargs; further behaviour is left to the standard CLOS instance construction protocol; for @@ -111,11 +117,11 @@ This generic function does the common work for constructing instance and class initializers. It can usefully be specialized according to both the - class and slot types. The default method uses the `:lisp-class' property - (defaulting to INIT-CLASS) to choose a (CLOS) class to instantiate. The - slot is then constructed by `make-instance' passing the arguments as - initargs; further behaviour is left to the standard CLOS instance - construction protocol; for example, `sod-initializer' defines an + class and slot types. The default method uses the `:initializer-class' + property (defaulting to INIT-CLASS) to choose a (CLOS) class to + instantiate. The slot is then constructed by `make-instance' passing the + arguments as initargs; further behaviour is left to the standard CLOS + instance construction protocol; for example, `sod-initializer' defines an `:after'-method on `shared-initialize'. Diagnosing unused properties is left for the caller (usually @@ -136,12 +142,13 @@ This is the main constructor function for messages. This is a generic function primarily so that the CLASS can intervene in the construction - process. The default method uses the `:lisp-class' property (defaulting - to `sod-message') to choose a (CLOS) class to instantiate. The message is - then constructed by `make-instance' passing the arguments as initargs; - further behaviour is left to the standard CLOS instance construction - protocol; for example, `sod-message' defines an `:after'-method on - `shared-initialize'.")) + process. The default method uses the `:message-class' property to choose + a (CLOS) class to instantiate; if no such property is provided but a + `combination' property is present, then `aggregating-message' is chosen; + otherwise `standard-message' is used. The message is then constructed by + `make-instance' passing the arguments as initargs; further behaviour is + left to the standard CLOS instance construction protocol; for example, + `sod-message' defines an `:after'-method on `shared-initialize'.")) (export 'make-sod-method) (defgeneric make-sod-method @@ -167,7 +174,7 @@ This is a generic function so that it can be specialized according to both a class and -- more particularly -- a message. The default method uses - the `:lisp-class' property (defaulting to the result of calling + the `:method-class' property (defaulting to the result of calling `sod-message-method-class') to choose a (CLOS) class to instantiate. The method is then constructed by `make-instance' passing the arguments as initargs; further behaviour is left to the standard CLOS instance @@ -187,9 +194,9 @@ "Return the preferred class for methods on MESSAGE. The message can inspect the PSET to decide on a particular message. A - `:lisp-class' property will usually override this decision: it's then the - programmer's responsibility to ensure that the selected method class is - appropriate.")) + `:method-class' property will usually override this decision: it's then + the programmer's responsibility to ensure that the selected method class + is appropriate.")) (export 'check-message-type) (defgeneric check-message-type (message type) @@ -207,74 +214,4 @@ This is separated out of `shared-initialize', where it's called, so that it can be overridden conveniently by subclasses.")) -;;;-------------------------------------------------------------------------- -;;; Builder macros. - -(export 'define-sod-class) -(defmacro define-sod-class (name (&rest superclasses) &body body) - "Construct a new SOD class called NAME in the current module. - - The new class has the named direct SUPERCLASSES, which should be a list of - strings. - - The BODY begins with a sequence of alternating keyword/value pairs - defining properties for the new class. The keywords are (obviously) not - evaluated, but the value forms are. - - The remainder of the BODY are a sequence of forms to be evaluated as an - implicit `progn'. Additional macros are available to the BODY, to make - defining the class easier. - - In the following, NAME is a string giving a C identifier; NICK is a string - giving the nickname of a superclass; TYPE is a C type using S-expression - notation. - - * message NAME TYPE &rest PLIST - - * method NICK NAME TYPE BODY &rest PLIST - - * slot NAME TYPE &rest PLIST - - * instance-initializer NICK NAME VALUE-KIND VALUE-FORM &rest PLIST - - * class-initializer NICK NAME VALUE-KIND VALUE-FORM &rest PLIST" - - (let ((plist nil) - (classvar (gensym "CLASS-"))) - (loop - (when (or (null body) - (not (keywordp (car body)))) - (return)) - (push (pop body) plist) - (push (pop body) plist)) - `(let ((,classvar (make-sod-class ,name - (mapcar #'find-sod-class - (list ,@superclasses)) - (make-property-set - ,@(nreverse plist))))) - (macrolet ((message (name type &rest plist) - `(make-sod-message ,',classvar ,name (c-type ,type) - (make-property-set ,@plist))) - (method (nick name type body &rest plist) - `(make-sod-method ,',classvar ,nick ,name (c-type ,type) - ,body (make-property-set ,@plist))) - (slot (name type &rest plist) - `(make-sod-slot ,',classvar ,name (c-type ,type) - (make-property-set ,@plist))) - (instance-initializer - (nick name value-kind value-form &rest plist) - `(make-sod-instance-initializer ,',classvar ,nick ,name - ,value-kind ,value-form - (make-property-set - ,@plist))) - (class-initializer - (nick name value-kind value-form &rest plist) - `(make-sod-class-initializer ,',classvar ,nick ,name - ,value-kind ,value-form - (make-property-set - ,@plist)))) - ,@body - (finalize-sod-class ,classvar) - (add-to-module *module* ,classvar))))) - ;;;----- That's all, folks --------------------------------------------------