X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/0f3e4dbfdaf4709e5b713ca60734fd4bad22041b..e895be217c3be6769708da17c9ae87cb22db040e:/src/method-impl.lisp

diff --git a/src/method-impl.lisp b/src/method-impl.lisp
index 7fdceb1..c1e1b24 100644
--- a/src/method-impl.lisp
+++ b/src/method-impl.lisp
@@ -60,6 +60,11 @@
       ((nil) (error "How odd: a primary method slipped through the net"))
       (t (error "Unknown method role ~A" role)))))
 
+(defmethod sod-message-receiver-type ((message sod-message)
+				      (class sod-class))
+  (c-type (* (class class
+		    (and (sod-message-readonly-p message) :const)))))
+
 (export 'simple-message)
 (defclass simple-message (basic-message)
   ()
@@ -149,7 +154,8 @@
     (when (keyword-message-p message)
       (setf method-args (fix-up-keyword-method-args method method-args)))
     (c-type (fun (lisp (c-type-subtype type))
-		 ("me" (* (class (sod-method-class method))))
+		 ("me" (lisp (sod-message-receiver-type
+			      message (sod-method-class method))))
 		 . method-args))))
 
 (defmethod sod-method-description ((method basic-direct-method))
@@ -218,7 +224,8 @@
 			  (t
 			   msgargs))))
     (c-type (fun (lisp return-type)
-		 ("me" (* (class (sod-method-class method))))
+		 ("me" (lisp (sod-message-receiver-type
+			      message (sod-method-class method))))
 		 . arguments))))
 
 (define-on-demand-slot delegating-direct-method function-type (method)
@@ -243,7 +250,8 @@
 	  (t
 	   (push next-method-arg method-args)))
     (c-type (fun (lisp (c-type-subtype type))
-		 ("me" (* (class (sod-method-class method))))
+		 ("me" (lisp (sod-message-receiver-type
+			      message (sod-method-class method))))
 		 . method-args))))
 
 ;;;--------------------------------------------------------------------------
@@ -291,7 +299,7 @@
 
 (export '(basic-effective-method
 	  effective-method-around-methods effective-method-before-methods
-	  effective-method-after-methods))
+	  effective-method-after-methods effective-method-functions))
 (defclass basic-effective-method (effective-method)
   ((around-methods :initarg :around-methods :initform nil
 		   :type list :reader effective-method-around-methods)
@@ -443,7 +451,8 @@
 		 ((nil) raw-tail)
 		 (:valist (reify-variable-argument-tail raw-tail)))))
     (c-type (fun (lisp (c-type-subtype type))
-		 ("me" (* (class (method-entry-chain-tail entry))))
+		 ("me" (lisp (sod-message-receiver-type
+			      message (method-entry-chain-tail entry))))
 		 . tail))))
 
 (defgeneric effective-method-keyword-parser-function-name (method)
@@ -676,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))))
@@ -690,10 +702,11 @@
 	       (deliver-call codegen :void "SOD__IGNORE" "sod__obj")))
 	   (finish-entry (tail)
 	     (let* ((head (sod-class-chain-head tail))
+		    (my-type (sod-message-receiver-type message tail))
 		    (role (if parm-n :valist nil))
 		    (name (method-entry-function-name method head role))
 		    (type (c-type (fun (lisp return-type)
-				       ("me" (* (class tail)))
+				       ("me" (lisp my-type))
 				       . entry-args))))
 	       (codegen-pop-function codegen name type
 		"~@(~@[~A ~]entry~) function ~:_~
@@ -712,7 +725,7 @@
 				    (mapcar #'argument-name entry-args)))
 		       (main (method-entry-function-name method head nil))
 		       (main-type (c-type (fun (lisp return-type)
-					       ("me" (* (class tail)))
+					       ("me" (lisp my-type))
 					       . raw-entry-args))))
 		   (codegen-push codegen)
 		   (ensure-var codegen *sod-ap* c-type-va-list)