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

If you have a `const' instance, it's useful to be able to send it
messages, so add a facility for marking messages as not modifying their
receivers.

diff --git a/doc/SYMBOLS b/doc/SYMBOLS
index b170827..7e18dcd 100644 (file)
--- a/doc/SYMBOLS
+++ b/doc/SYMBOLS
@@ -428,6 +428,7 @@ classes.lisp
   sod-message                                   class
   sod-message-class                             generic
   sod-message-name                              generic
+  sod-message-readonly-p                        generic
   sod-message-type                              generic
   sod-method                                    class
   sod-method-body                               generic
@@ -1731,6 +1732,8 @@ sod-message-method-class
   sod-message sod-class t
 sod-message-name
   sod-message
+sod-message-readonly-p
+  sod-message
 sod-message-receiver-type
   sod-message sod-class
 sod-message-type

diff --git a/doc/meta.tex b/doc/meta.tex
index dbbf2d6..67e77b2 100644 (file)
--- a/doc/meta.tex
+++ b/doc/meta.tex
@@ -216,13 +216,15 @@
                                         \&key :location}}
 \end{describe*}
 
-\begin{describe}{cls}{sod-message () \&key :name :location :class :type}
+\begin{describe}{cls}
+    {sod-message () \&key :name :location :readonly :class :type}
 \end{describe}
 
 \begin{describe*}
     {\dhead{gf}{sod-message-name @<message> @> @<string>}
      \dhead{meth}{sod-message}
        {file-location (@<message> sod-message) @> @<floc>}
+     \dhead{gf}{sod-message-readonly-p @<message> @> @<generalized-boolean>}
      \dhead{gf}{sod-message-class @<message> @> @<class>}
      \dhead{gf}{sod-message-type @<message> @> @<c-type>}}
 \end{describe*}

diff --git a/doc/syntax.tex b/doc/syntax.tex
index dd6a5f5..72329a4 100644 (file)
--- a/doc/syntax.tex
+++ b/doc/syntax.tex
@@ -903,6 +903,9 @@ Properties:
 \begin{description}
 \item[@|message_class|] A symbol naming the Lisp class to use to represent
   the message.
+\item[@|readonly|] A boolean indicating whether the message guarantees not to
+  modify its receiver.  If this is true, the receiver will be declared
+  @"const".
 \item[@|combination|] A keyword naming the aggregating method combination to
   use.
 \item[@|most_specific|] A keyword, either @`first' or @`last', according to

diff --git a/src/class-make-impl.lisp b/src/class-make-impl.lisp
index b96d830..1da8bac 100644 (file)
--- a/src/class-make-impl.lisp
+++ b/src/class-make-impl.lisp
@@ -237,9 +237,11 @@
 
 (defmethod shared-initialize :after
     ((message sod-message) slot-names &key pset)
-  (declare (ignore slot-names pset))
   (with-slots ((type %type)) message
-    (check-message-type message type)))
+    (check-message-type message type))
+  (default-slot-from-property (message 'readonlyp slot-names)
+      (pset :readonly :boolean)
+    nil))
 
 (defmethod check-message-type ((message sod-message) (type c-function-type))
   nil)

diff --git a/src/classes.lisp b/src/classes.lisp
index 678d4a5..69df4d1 100644 (file)
--- a/src/classes.lisp
+++ b/src/classes.lisp
@@ -366,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
@@ -403,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

diff --git a/src/method-impl.lisp b/src/method-impl.lisp
index be33ecd..c1e1b24 100644 (file)
--- a/src/method-impl.lisp
+++ b/src/method-impl.lisp
@@ -62,7 +62,8 @@
 
 (defmethod sod-message-receiver-type ((message sod-message)
                                      (class sod-class))
-  (c-type (* (class class))))
+  (c-type (* (class class
+                   (and (sod-message-readonly-p message) :const)))))
 
 (export 'simple-message)
 (defclass simple-message (basic-message)
@@ -684,7 +685,10 @@
 
         ;; Effective method function details.
         (emf-name (effective-method-function-name method))
-        (ilayout-type (c-type (* (struct (ilayout-struct-tag class)))))
+        (ilayout-type (c-type (* (struct (ilayout-struct-tag class)
+                                         (and (sod-message-readonly-p
+                                               message)
+                                              :const)))))
         (emf-type (c-type (fun (lisp return-type)
                                ("sod__obj" (lisp ilayout-type))
                                . entry-args))))

diff --git a/src/method-proto.lisp b/src/method-proto.lisp
index ed15ff2..e72044e 100644 (file)
--- a/src/method-proto.lisp
+++ b/src/method-proto.lisp
@@ -54,7 +54,7 @@
   (:documentation
    "Return the type of the `me' argument in a MESSAGE received by CLASS.
 
-   Typically this will just be `CLASS *'."))
+   Typically this will just be `CLASS *' or `const CLASS *'."))
 
 (export 'sod-message-applicable-methods)
 (defgeneric sod-message-applicable-methods (message class)