X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/57b365324f35a6237602ab840c23f4f06c8c317c..fddbedf7b1b4b19add30eeb62281748cc77e6955:/src/classes.lisp

diff --git a/src/classes.lisp b/src/classes.lisp
index 1856b30..b21f3c0 100644
--- a/src/classes.lisp
+++ b/src/classes.lisp
@@ -48,11 +48,12 @@
 	  sod-class-direct-superclasses sod-class-precedence-list
 	  sod-class-chain-link sod-class-chain-head
 	  sod-class-chain sod-class-chains
-	  sod-class-slots sod-class-initfrags sod-class-tearfrags
+	  sod-class-slots
+	  sod-class-initargs sod-class-initfrags sod-class-tearfrags
 	  sod-class-instance-initializers sod-class-class-initializers
 	  sod-class-messages sod-class-methods
 	  sod-class-state
-	  sod-class-ilayout sod-class-vtables))
+	  sod-class-ilayout sod-class-effective-methods sod-class-vtables))
 (defclass sod-class ()
   ((name :initarg :name :type string :reader sod-class-name)
    (location :initarg :location :initform (file-location nil)
@@ -326,7 +327,8 @@
 
    See `sod-initializer' for more details."))
 
-(export 'sod-initarg)
+(export '(sod-initarg
+	  sod-initarg-class sod-initarg-name sod-initarg-type))
 (defclass sod-initarg ()
   ((%class :initarg :class :type sod-class :reader sod-initarg-class)
    (location :initarg :location :initform (file-location nil)
@@ -336,7 +338,7 @@
   (:documentation
    "Describes a keyword argument accepted by the initialization function."))
 
-(export 'sod-user-initarg)
+(export '(sod-user-initarg sod-initarg-default))
 (defclass sod-user-initarg (sod-initarg)
   ((default :initarg :default :type t :reader sod-initarg-default))
   (:documentation
@@ -349,7 +351,7 @@
     (awhen (sod-initarg-default initarg)
       (format stream " = ~A" it))))
 
-(export 'sod-slot-initarg)
+(export '(sod-slot-initarg sod-initarg-slot))
 (defclass sod-slot-initarg (sod-initarg)
   ((slot :initarg :slot :type sod-slot :reader sod-initarg-slot))
   (:documentation
@@ -364,11 +366,14 @@
 ;;;--------------------------------------------------------------------------
 ;;; Messages and methods.
 
-(export '(sod-message sod-message-name sod-message-class sod-message-type))
+(export '(sod-message sod-message-name sod-message-readonly-p
+	  sod-message-class sod-message-type))
 (defclass sod-message ()
   ((name :initarg :name :type string :reader sod-message-name)
    (location :initarg :location :initform (file-location nil)
 	     :type file-location :reader file-location)
+   (readonlyp :initarg :readonly :initform nil :type t
+	      :reader sod-message-readonly-p)
    (%class :initarg :class :type sod-class :reader sod-message-class)
    (%type :initarg :type :type c-function-type :reader sod-message-type))
   (:documentation
@@ -401,6 +406,10 @@
      * The `location' states where in the user's source the slot was defined.
        It gets used in error messages.
 
+     * The `readonly' flag indicates whether the message receiver can modify
+       itself in response to this message.  If set, the receiver will be
+       declared `const'.
+
      * The `class' states which class defined the message.
 
      * The `type' is a function type describing the message's arguments and
@@ -488,4 +497,57 @@
 	    (sod-method-message method)
 	    (sod-method-class method))))
 
+;;;--------------------------------------------------------------------------
+;;; Instances.
+
+(export '(static-instance static-instance-name static-instance-extern-p
+	  static-instance-const-p static-instance-class
+	  static-instance-initializers))
+(defclass static-instance ()
+  ((name :initarg :name :type string :reader static-instance-name)
+   (location :initarg :location :initform (file-location nil)
+	     :type file-location :reader file-location)
+   (externp :initarg :extern :initform nil :type t
+	    :reader static-instance-extern-p)
+   (constp :initarg :const :initform t :type t
+	   :reader static-instance-const-p)
+   (%class :initarg :class :type sod-class :reader static-instance-class)
+   (initializers :initarg :initializers :initform nil
+		 :type list :accessor static-instance-initializers))
+  (:documentation
+   "A static instance is a class instance built at (C) compile time.
+
+   The slots are as follows.
+
+     * The `name' gives the C identifier naming the instance, as a string.
+
+     * The `externp' flag is non-nil if the instance is to be visible outside
+       of the translation unit.
+
+     * The `location' states where, in the user's source, the instance was
+       defined.  This gets used in error messages.
+
+     * The `class' specifies the class of the instance to construct.
+
+     * The `initializers' are a list of `sod-instance-initializer' objects
+       which override any existing slot initializers defined on the class."))
+
+(defmethod print-object ((instance static-instance) stream)
+  (with-slots (name (class %class) externp constp initializers) instance
+    (maybe-print-unreadable-object (instance stream :type t)
+      (format stream "~:[~;extern ~@_~]~:[~;const ~@_~]~A ~@_~A"
+	      externp constp class name)
+      (when initializers
+	(princ ": " stream)
+	(pprint-indent :block 2 stream)
+	(let ((first t))
+	  (dolist (init initializers)
+	    (if first (setf first nil) (princ ", "))
+	    (pprint-newline :linear stream)
+	    (with-slots (slot (super %class) value) init
+	      (format stream "~@<~A.~A = ~2I~@_~A~:>"
+		      (sod-class-nickname super)
+		      (sod-slot-name slot)
+		      value))))))))
+
 ;;;----- That's all, folks --------------------------------------------------