src/method-impl.lisp, etc.: Add a `readonly' message property.

[sod] / src / classes.lisp

diff --git a/src/classes.lisp b/src/classes.lisp
index a59a47c..69df4d1 100644 (file)
--- 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,26 +338,42 @@
   (: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
    "Describes an initialization argument defined by the user."))
 
-(export 'sod-slot-initarg)
+(defmethod print-object ((initarg sod-user-initarg) stream)
+  (maybe-print-unreadable-object (initarg stream :type t)
+    (pprint-c-type (sod-initarg-type initarg) stream
+                  (sod-initarg-name initarg))
+    (awhen (sod-initarg-default initarg)
+      (format stream " = ~A" it))))
+
+(export '(sod-slot-initarg sod-initarg-slot))
 (defclass sod-slot-initarg (sod-initarg)
   ((slot :initarg :slot :type sod-slot :reader sod-initarg-slot))
   (:documentation
    "Describes an initialization argument used to initialize a slot."))
 
+(defmethod print-object ((initarg sod-slot-initarg) stream)
+  (maybe-print-unreadable-object (initarg stream :type t)
+    (pprint-c-type (sod-initarg-type initarg) stream
+                  (sod-initarg-name initarg))
+    (format stream " for ~A" (sod-initarg-slot initarg))))
+
 ;;;--------------------------------------------------------------------------
 ;;; 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
@@ -388,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