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 b1708274d4280ae5a4a9e83475493fc369a9fb05..7e18dcd85603733fc63bf416c58cb44b4fde02c2 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 dbbf2d6a5aa32cf6936a7fde8094c23c1b3fb49f..67e77b234bf73728119d3d3bcdbd2d13b4da4b26 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 dd6a5f515b996743095427f7cd1e923aa22c2a3b..72329a44199b863b7b0d02f1509ce0caf40c587e 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 b96d830cb60eedd4047cc61a7a87f98d971f7be7..1da8bacbab7ac8aeb0c403a7b2b0cfb8b511a83c 100644 (file)
--- a/src/class-make-impl.lisp
+++ b/src/class-make-impl.lisp
@@ -237,9 +237,11 @@ (defmethod make-sod-message
 
 (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 678d4a51fe8bf1a762880b17d6f7e88ad42ee6dd..69df4d1e78270062633083dddc80d03c8401aed2 100644 (file)
--- a/src/classes.lisp
+++ b/src/classes.lisp
@@ -366,11 +366,14 @@ (defmethod print-object ((initarg sod-slot-initarg) stream)
 ;;;--------------------------------------------------------------------------
 ;;; 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 @@ (defclass sod-message ()
      * 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 be33ecd38177d4b74dc27c8b0b309d8f3d9a742f..c1e1b248f3f19981880ff22be25f02ccd93423c1 100644 (file)
--- a/src/method-impl.lisp
+++ b/src/method-impl.lisp
@@ -62,7 +62,8 @@ (defmethod sod-message-method-class
 
 (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 @@ (defmethod compute-method-entry-functions ((method basic-effective-method))
 
         ;; 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 ed15ff20ed833c098d8654bb30152e3f54ee3aed..e72044e2b35d0f3d563c041684ca3c5ca1be3785 100644 (file)
--- a/src/method-proto.lisp
+++ b/src/method-proto.lisp
@@ -54,7 +54,7 @@ (defgeneric sod-message-receiver-type (message class)
   (: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)