@@@ progfmt wip
[sod] / src / class-layout-proto.lisp
index a4ca263..5c755a3 100644 (file)
@@ -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
 (export '(effective-slot effective-slot-class
          effective-slot-direct-slot effective-slot-initializer))
 (defclass effective-slot ()
-  ((class :initarg :class :type sod-slot :reader effective-slot-class)
+  ((%class :initarg :class :type sod-class :reader effective-slot-class)
    (slot :initarg :slot :type sod-slot :reader effective-slot-direct-slot)
    (initializer :initarg :initializer :type (or sod-initializer null)
-               :reader effective-slot-initializer))
+               :reader effective-slot-initializer)
+   (initargs :initarg :initargs :initform nil
+            :type list :reader effective-slot-initargs))
   (:documentation
    "Describes a slot and how it's meant to be initialized.
 
   (:documentation
    "Return the most specific initializer for SLOT, starting from CLASS."))
 
+(export 'find-slot-initargs)
+(defgeneric find-slot-initargs (class slot)
+  (:documentation
+   "Return as a list all of the initargs defined on CLASS to initialize SLOT.
+
+   The list is returned with initargs defined on more specific classes
+   first."))
+
 (export 'compute-effective-slot)
 (defgeneric compute-effective-slot (class slot)
   (:documentation
    SLOT is a direct slot defined on CLASS or one of its superclasses.
    (Metaclass initializers are handled using a different mechanism.)"))
 
+(export 'find-class-initializer)
+(defgeneric find-class-initializer (slot class)
+  (:documentation
+   "Return an initializer value (any printable value) for a class slot SLOT.
+
+   The initializer might come either from the SLOT's defining class (which it
+   already knows), or from the instance CLASS, of which the defining class is
+   be (a superclass of) the metaclass.
+
+   This is used as part of `has-class-initializer-p' and the default output
+   hook for `effective-slot': if you override both of those then you don't
+   need to override this too."))
+
 ;;;--------------------------------------------------------------------------
 ;;; Instance layout.
 
@@ -65,7 +88,7 @@
 
 (export '(islots islots-class islots-subclass islots-slots))
 (defclass islots ()
-  ((class :initarg :class :type sod-class :reader islots-class)
+  ((%class :initarg :class :type sod-class :reader islots-class)
    (subclass :initarg :subclass :type sod-class :reader islots-subclass)
    (slots :initarg :slots :type list :reader islots-slots))
   (:documentation
 (export '(vtable-pointer vtable-pointer-class
          vtable-pointer-chain-head vtable-pointer-chain-tail))
 (defclass vtable-pointer ()
-  ((class :initarg :class :type sod-class :reader vtable-pointer-class)
+  ((%class :initarg :class :type sod-class :reader vtable-pointer-class)
    (chain-head :initarg :chain-head :type sod-class
               :reader vtable-pointer-chain-head)
    (chain-tail :initarg :chain-tail :type sod-class
 
 (export '(ichain ichain-class ichain-head ichain-tail ichain-body))
 (defclass ichain ()
-  ((class :initarg :class :type sod-class :reader ichain-class)
+  ((%class :initarg :class :type sod-class :reader ichain-class)
    (chain-head :initarg :chain-head :type sod-class :reader ichain-head)
    (chain-tail :initarg :chain-tail :type sod-class :reader ichain-tail)
    (body :initarg :body :type list :reader ichain-body))
 
 (export '(ilayout ilayout-class ilayout-ichains))
 (defclass ilayout ()
-  ((class :initarg :class :type sod-class :reader ilayout-class)
+  ((%class :initarg :class :type sod-class :reader ilayout-class)
    (ichains :initarg :ichains :type list :reader ilayout-ichains))
   (:documentation
    "All of the instance layout for a class.
 
 ;;; vtmsgs
 
+(export '(vtmsgs vtmsgs-class vtmsgs-subclass
+         vtmsgs-chain-head vtmsgs-chain-tail vtmsgs-entries))
 (defclass vtmsgs ()
-  ((class :initarg :class :type sod-class :reader vtmsgs-class)
+  ((%class :initarg :class :type sod-class :reader vtmsgs-class)
    (subclass :initarg :subclass :type sod-class :reader vtmsgs-subclass)
    (chain-head :initarg :chain-head :type sod-class
               :reader vtmsgs-chain-head)
 (export '(class-pointer class-pointer-class class-pointer-chain-head
          class-pointer-metaclass class-pointer-meta-chain-head))
 (defclass class-pointer ()
-  ((class :initarg :class :type sod-class :reader class-pointer-class)
+  ((%class :initarg :class :type sod-class :reader class-pointer-class)
    (chain-head :initarg :chain-head :type sod-class
               :reader class-pointer-chain-head)
    (metaclass :initarg :metaclass :type sod-class
 
 (export '(base-offset base-offset-class base-offset-chain-head))
 (defclass base-offset ()
-  ((class :initarg :class :type sod-class :reader base-offset-class)
+  ((%class :initarg :class :type sod-class :reader base-offset-class)
    (chain-head :initarg :chain-head :type sod-class
               :reader base-offset-chain-head))
   (:documentation
 (export '(chain-offset chain-offset-class
          chain-offset-chain-head chain-offset-target-head))
 (defclass chain-offset ()
-  ((class :initarg :class :type sod-class :reader chain-offset-class)
+  ((%class :initarg :class :type sod-class :reader chain-offset-class)
    (chain-head :initarg :chain-head :type sod-class
               :reader chain-offset-chain-head)
    (target-head :initarg :target-head :type sod-class
    object's metadata; but that would either require a search or we'd have to
    be able work out the target chain's index in the table."))
 
+(export 'make-chain-offset)
 (defgeneric make-chain-offset (class chain-head target-head)
   (:documentation
    "Return the offset from CHAIN-HEAD to TARGET-HEAD."))
 (export '(vtable vtable-class vtable-body
          vtable-chain-head vtable-chain-tail))
 (defclass vtable ()
-  ((class :initarg :class :type sod-class :reader vtable-class)
+  ((%class :initarg :class :type sod-class :reader vtable-class)
    (chain-head :initarg :chain-head :type sod-class
               :reader vtable-chain-head)
    (chain-tail :initarg :chain-tail :type sod-class