X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/sod/blobdiff_plain/3dca7758421664a838c54b273bd9221f02072045..8d3d1674f1a0b1dabd5877dcb0bd503fe2bcc1d9:/src/class-make-impl.lisp diff --git a/src/class-make-impl.lisp b/src/class-make-impl.lisp index 878f813..dba6965 100644 --- a/src/class-make-impl.lisp +++ b/src/class-make-impl.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 @@ -28,20 +28,6 @@ (cl:in-package #:sod) ;;;-------------------------------------------------------------------------- ;;; Classes. -(defmethod guess-metaclass ((class sod-class)) - "Default metaclass-guessing function for classes. - - Return the most specific metaclass of any of the CLASS's direct - superclasses." - (do ((supers (sod-class-direct-superclasses class) (cdr supers)) - (meta nil (let ((candidate (sod-class-metaclass (car supers)))) - (cond ((null meta) candidate) - ((sod-subclass-p meta candidate) meta) - ((sod-subclass-p candidate meta) candidate) - (t (error "Unable to choose metaclass for `~A'" - class)))))) - ((endp supers) meta))) - (defmethod shared-initialize :after ((class sod-class) slot-names &key pset) "Specific behaviour for SOD class initialization. @@ -63,10 +49,11 @@ (default-slot-from-property (class 'nickname slot-names) (pset :nick :id) (string-downcase (slot-value class 'name))) - ;; If no metaclass, guess one in a (Lisp) class-specific way. + ;; Set the metaclass if the appropriate property has been provided; + ;; otherwise leave it unbound for now, and we'll sort out the mess during + ;; finalization. (default-slot-from-property (class 'metaclass slot-names) - (pset :metaclass :id meta (find-sod-class meta)) - (guess-metaclass class)) + (pset :metaclass :id meta (find-sod-class meta))) ;; If no chain-link, then start a new chain here. (default-slot-from-property (class 'chain-link slot-names) @@ -137,7 +124,7 @@ (defmethod make-sod-initializer-using-slot :slot slot :value-kind value-kind :value-form value-form - :location location + :location (file-location location) :pset pset)) (defmethod shared-initialize :after @@ -203,7 +190,7 @@ (defmethod make-sod-method-using-message :class class :type type :body body - :location location + :location (file-location location) :pset pset)) (defmethod sod-message-method-class @@ -221,7 +208,8 @@ (defmethod shared-initialize :after (every (lambda (arg) (or (eq arg :ellipsis) (argument-name arg) - (eq (argument-type arg) (c-type void)))) + (c-type-equal-p (argument-type arg) + c-type-void))) (c-function-arguments type))) (error "Abstract declarators not permitted in method definitions")))