unoptimized Slot-value and other things

[kanderso@PEBBLES.BBN.COM]

;;; -*- Package: PCL -*-

In "8/28/88 (beta rev 1) AAAI PCL" on a Symbolics LISPM.

Several things:

1.  In the following 2 methods slot-value gets optimized in the first
and not in the second.  Shouldn't the second one be optimized too?

(pcl:DEFMETHOD :REMPROP ((self PROPERTY-LIST-MIXIN) INDICATOR)
  (CHECK-TYPE INDICATOR SYMBOL)
  (let ((list (slot-value self 'property-list)))
    (remf list indicator)
    (setf (slot-value self 'property-list) list)))

(pcl:DEFMETHOD :REMPROP ((self PROPERTY-LIST-MIXIN) INDICATOR)
  (CHECK-TYPE INDICATOR SYMBOL)
  (remf (slot-value self 'property-list) indicator))

2.  On Symbolics machines "M-X Edit Compiler Warnings" has trouble
finding where to go in the file because "(PCL:TOP-LEVEL-FORM ..."
isn't really there.  Can this be improved on?  M-. seems to know what
to search for!

Here are some example warnings:

Warnings for file CONGER:>pcl>new>floid>vanilla
  
  For Function (PCL:TOP-LEVEL-FORM (PCL:METHOD (CL:SETF :GET)
(FLOID:PROPERTY-LIST-MIXIN T)))
    While compiling FLOID::PROPERTY:
      The variable FLOID::PROPERTY is unknown and has been declared SPECIAL

  
  For Function (:INTERNAL (PCL:TOP-LEVEL-FORM (PCL:METHOD FLOID::GET-HANDLER-FOR
(LIST PCL:OBJECT))) 0)
    FLOID::GBOUNDP was referenced but not defined.

    FLOID::GDEFINITION was referenced but not defined.

3.  When you compile the method below, the compiler complains that
initargs isn't used, although i think of them as being used by
call-next-method.  Does this seem right?

(defmethod *make-instance ((class instances-class-mixin) &rest initargs)
  (let ((instance (call-next-method)))
    (add-instance class instance)
    instance))


4.  The body of the method above expands into:


#'(LAMBDA (#:CLASS &REST #:AMPERSAND-ARGS)
    (LET ((.NEXT-METHOD. (CAR *NEXT-METHODS*))
	  (*NEXT-METHODS* (CDR *NEXT-METHODS*)))
      (FLET ((CALL-NEXT-METHOD (&REST CNM-ARGS)
	       (IF .NEXT-METHOD.
		   (IF CNM-ARGS
		       (APPLY .NEXT-METHOD. CNM-ARGS)
		       (APPLY .NEXT-METHOD. #:CLASS #:AMPERSAND-ARGS))
		   (ERROR "No next method."))))
	(APPLY #'(LAMBDA
		     (CLASS &REST INITARGS)
		   (DECLARE (CLASS CLASS INSTANCES-CLASS-MIXIN))
		   (PROGN CLASS)
		   (BLOCK
		       *MAKE-INSTANCE
		     (LET ((INSTANCE
			    (CALL-NEXT-METHOD)))
		       (ADD-INSTANCE CLASS INSTANCE)
		       INSTANCE)))
	       #:CLASS
	       #:AMPERSAND-ARGS))))))))

with a LITTLE more work on already HAIRY function, couldn't we get
expand-defmethod-internal to expand the call-next-method in line to
something like:

#'(LAMBDA (#:CLASS &REST #:AMPERSAND-ARGS)
    (LET ((.NEXT-METHOD. (CAR *NEXT-METHODS*))
	  (*NEXT-METHODS* (CDR *NEXT-METHODS*)))
	(APPLY #'(LAMBDA
		     (CLASS &REST INITARGS)
		   (DECLARE (CLASS CLASS INSTANCES-CLASS-MIXIN))
		   (PROGN CLASS)
		   (BLOCK
		       *MAKE-INSTANCE
		     (LET ((INSTANCE
			    (if .next-method.
				(apply .next-method. #:class
				       #:ampersand-args)
				(ERROR "No next method.")))
		       (ADD-INSTANCE CLASS INSTANCE)
			   INSTANCE))))
	       #:CLASS
               #:AMPERSAND-ARGS)))))

This would save a funcall and conditional branch in the most common case.
We only need the functional semantics of call-next-method when someone does
something like:

  (return (cons #'call-next-method (call-next-method)))