From e895be217c3be6769708da17c9ae87cb22db040e Mon Sep 17 00:00:00 2001 From: Mark Wooding Date: Sun, 6 Oct 2019 22:41:42 +0100 Subject: [PATCH] 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. --- doc/SYMBOLS | 3 +++ doc/meta.tex | 4 +++- doc/syntax.tex | 3 +++ src/class-make-impl.lisp | 6 ++++-- src/classes.lisp | 9 ++++++++- src/method-impl.lisp | 8 ++++++-- src/method-proto.lisp | 2 +- 7 files changed, 28 insertions(+), 7 deletions(-) diff --git a/doc/SYMBOLS b/doc/SYMBOLS index b170827..7e18dcd 100644 --- 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 --- 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 @ @> @} \dhead{meth}{sod-message} {file-location (@ sod-message) @> @} + \dhead{gf}{sod-message-readonly-p @ @> @} \dhead{gf}{sod-message-class @ @> @} \dhead{gf}{sod-message-type @ @> @}} \end{describe*} diff --git a/doc/syntax.tex b/doc/syntax.tex index dd6a5f5..72329a4 100644 --- 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 --- 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 --- 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 --- 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 --- 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) -- 2.11.0