[Sbcl-help] I've made a working CLOS specializer, but it throws style-warning.

[<wa...@te...>]

Hey, I've made my own CLOS specializer (code will follow), which works, but I 
get this style-warning:

STYLE-WARNING:
   can't find type for specializer (PREFIX "/static/") in
   SB-PCL::PARAMETER-SPECIALIZER-DECLARATION-IN-DEFMETHOD.

I don't recall having this warning before I upgraded SBCL to 1.0.28.gentoo-r0 
(but I don't recall what the old version was, I think it was 1.0.19). This 
specializer partially matches a string, e.g  the argument is string-equal ?x in 
(prefix ?x) up to the length of ?x. Here is the (relevant) code I've used to 
produce the specializer:

;; The string-prefix-specializer code that follows lets me define methods that 
can dispatch on string-start matches.
(defclass string-prefix-specializer (sb-mop:specializer)
  ((prefix :initarg :prefix :reader prefix)
   (direct-methods :initform nil  :reader sb-mop:specializer-direct-methods)))

(defmethod sb-mop:add-direct-method ((s string-prefix-specializer) method)
  (unless (member method (slot-value s 'direct-methods))
    (setf (slot-value s 'direct-methods) (cons method (slot-value s 'direct-
methods)))))
(defmethod sb-mop:remove-direct-method ((s string-prefix-specializer) method)
  (setf (slot-value s 'direct-methods) (remove s (slot-value s 'direct-
methods))))

(let ((prefix-specializer-table (make-hash-table :test #'equal)))
  (defun intern-string-prefix-specializer (prefix)
    (or (gethash prefix prefix-specializer-table)
	(setf (gethash prefix prefix-specializer-table)
	      (make-instance 'string-prefix-specializer :prefix prefix)))))

(defclass string-prefix-method (sb-mop:standard-method)
  ((lambda-expr :initarg :lambda-expr :reader string-prefix-method-lambda-
expr)))

(defclass gf-supporting-string-prefix (sb-mop:standard-generic-function) ()
  (:metaclass sb-mop:funcallable-standard-class)
  (:default-initargs :method-class (find-class 'string-prefix-method)))

(defmethod sb-pcl:make-method-specializers-form ((gf gf-supporting-string-
prefix) method snames env)
  `(list ,@(mapcar (lambda (s) (cond ((atom s) `(find-class ',s))
				((eq (car s) 'eql) `(sb-mop:intern-eql-
specializer ',(second s)))
				((eq (car s) 'prefix) `(intern-string-prefix-
specializer ',(second s)))
				(t (error "Unknown specializer: ~a" s)))) 
snames)))

(defmethod sb-mop:compute-discriminating-function ((gf gf-supporting-string-
prefix))
  (let ((arg-names (sb-mop:generic-function-argument-precedence-order gf))
	(methods (sb-mop:generic-function-methods gf)))
    #'(lambda (&rest args)
	(block entry	  
	  (unless (>= (length args) (length arg-names))	(error "Not enough 
arguments in compute-discriminating-function for gf-supporting-string-prefix"))
	  (dolist (method methods (no-applicable-method gf args))
	    ;; Iterate the specializers and the arguments. Do a string 
comparison on prefix-specializers, regular behavior for eql and class 
specializers.
	    (when (do ((specializers (sb-mop:method-specializers method) (cdr 
specializers))
		       (args args (cdr args)))
		      ((null specializers) t)
		    (let ((specializer (car specializers))
			  (arg (car args)))
		      (or (handler-case (case (type-of specializer)
					  (sb-mop:eql-specializer (eql (sb-
mop:eql-specializer-object specializer) arg))
					  (string-prefix-specializer
					   (let ((prefix (prefix specializer)))
					     (or (null prefix) (and (>= (length 
arg) (length prefix)) (string-equal prefix arg :end2 (length prefix))))))
					  (otherwise (typep arg specializer)))
			    (error () nil))
			  (return))))
	      (return-from entry (funcall (sb-mop:method-function method) args 
nil))))))))


(defgeneric handle (method path operation)  
  (:generic-function-class gf-supporting-string-prefix)
  (:documentation "Handle a request."))

(defmethod handle ((method (eql get)) (path (prefix "/static/")) operation)
  (http-xserve *request* (concatenate 'string +static-dir+  
path) :disposition :inline))


Cheers,
Warren Wilkinson