Filtered functions provide an extension of generic function invocation that add a simple preprocessing step before the actual method dispatch is performed and thus enable the use of arbitrary predicates for selecting and applying methods.
Filtered functions is written and maintained by Pascal Costanza. See GitHub or the 2008 paper by pcostanza et al for more information. Part of “Closer project”, according to common-lisp.net.
License: MIT
language extension
#|
Transcript for the video
Common Lisp Study Group - Filtered Functions
https://www.youtube.com/channel/UCYg6qFXDE5SGT_YXhuJPU0A
- Is ":filter :something" a method-combination? wasn't aware they can be done that way, but I think because I didn't define ones myself yet
- Those would be method qualifiers.
https://www.lispworks.com/reference/HyperSpec/Body/m_defmet.htm
They are qualifiers for a custom method combination
|#
(ql:quickload :filtered-functions)
(import 'filtered-functions::(define-filtered-function))
;;; instead of (= n 0) (< n 0) (> n 0) I recommend zerop, minusp, plusp. The general rule in programming is to use the most specific constructs that will do the job. But, there is even more specific for the sign, namely SIGNUM. See http://p-cos.blogspot.com/2009/12/filtered-functions.html
(defun sign (n)
(cond ((minusp n) 'neg)
((zerop n) 'zero)
((plusp n) 'pos)))
#| Usually, you would write #'sign rather than (function sign)
Another perspective:
#' has 10 spikes! be careful. I prefer the chubby clouds of (function x)…
and FUNCTION is the only operator that creates closures, so it's very important. I don't think it should be abbreviated.
|#
(define-filtered-function fac (n)
(:filters (:sign #'sign)))
;;; Similarly, (- n 1) is better expressed as (1- n).
(defmethod fac :filter :sign ((n (eql 'pos)))
(* n (fac (1- n))))
(defmethod fac :filter :sign ((n (eql 'neg)))
(error "~A is a negative number, can't compute factorial." n))
(defmethod fac :filter :sign ((n (eql 'zero)))
(declare (ignore n))
1)
#+will-signal-error
(fac -2)
(fac 3) ;=> 6
#| the following example shows that a filter doesn't have to be a function
it can be an arbitrary lisp expression
- "You know what I actually did in my own program? I actually
I actually used a generic function for the filter so I can like.. I've got multiple levels of generic functions just to execute a generic function."
- "That is craziness man"
- "Anything is allowed"
- "That's right. It's so beautiful."
|#
;;; WHEN should be used only in a context where the value is not needed.
;;; (when (oddp n) t) should rather be just (oddp n)
;;; if you wanted to ensure a boolean (since oddp returns a generalized boolean) then (if (oddp n) t nil) should be used. But otherwise, yes, you can work with generalized boolean in general, so just (oddp n) will do
(define-filtered-function print-number-property (n)
(:filters (:odd (oddp n))
(:even (evenp n))))
#|
Internally it generates lambdas for the arbitrary lisp expressions we've used in the filters. Refactoring them to their own named functions is more apropriate when these expressions are long,
|#
(defmethod print-number-property ((n number))
(format t "the number is ~A~%" n))
(defmethod print-number-property :before :filter :odd (n)
(declare (ignore n))
(print "This is an odd number"))
(defmethod print-number-property :before :filter :even (n)
(declare (ignore n))
(print "This is an even number"))
(print-number-property 1) ; "This is an odd number" the number is 1
(print-number-property 2) ; "This is an even number" the number is 2
;;; stack example
(defclass stack ()
((contents :initform (make-array 10) :reader stack-contents)
(index :initform 0 :accessor stack-index)))
;;; I recommend you use with-accessors rather than with-slots. Slots are implementation details and it is best to refer to implementation details as little as possible.
(defun stack-state (stack)
(with-accessors ((index stack-index)
(contents stack-contents)) stack
(cond ((<= index 0) 'empty)
((>= index (length contents)) 'full)
(t 'normal))))
(defmethod print-object ((object stack) stream)
(print-unreadable-object (object stream :type t)
(describe object stream)))
;;; stack interface using filtered methods
(define-filtered-function stack-push (stack value)
(:filters (:state (list #'stack-state #'identity))
(:number (list #'stack-state #'sign))))
#| - All that code that you normally put into a cond for the different situations that you see here, is now just method specialization placed as the types of the arguments that are being passed in.
The predicates are doing all the work to ensure that the proper method gets called in the actual dispatch machinery of CL. That's really really cool because you've isolated that code into a single location. You can test it, make sure everything works ...
- That's really the main thing that makes this nice: it really helps with code separation
stack is still the stack object. It's not equal to the symbol 'empty.
And value is not equal to the symbol 'pos, it's actually the value, the number that you passed in. Those eql predicates are there just to do the dispatch.
It makes the code clearer. This gives you some options on how you do your code, and do proper separation of concerns.
The beauty of it is that it's all built into the machinery: it's just an extension of what's already there using the Metaobject Protocol. It allowed you to create a brand new dispatch mechanism.
With the normal CLOS that doesn't have this extension, unless you were using classes, outside the eql specialization there wasn't any real way to actually say: if the object is of this protocol/type go ahead and dispatch it on it.
I think this opens up a lot of doors for creativity but obviously we want to explore the machinery a little bit more. That's for another time.
In the coming weeks we'll be talking about the Metaobject Protocol in more detail.
|#
(defmethod stack-push :filter :number (stack (value (eql 'pos)))
(setf (aref (stack-contents stack) (stack-index stack)) value)
(incf (stack-index stack)))
(defmethod stack-push :filter :state (stack value)
(declare (ignore stack))
(error "You can only push positive numbers on this stack."))
(defmethod stack-push :filter :number ((stack (eql 'full)) (value (eql 'pos)))
(declare (ignore stack value))
(error "stack is full"))
(defmethod stack-pop :filter :state ((stack (eql 'empty)))
(declare (ignore stack))
(error "stack is empty"))
;;; For stack-pop, you could use prog1 to avoid a temporary variable.
(defmethod stack-pop :filter :state (stack)
(prog1
(aref (stack-contents stack) (stack-index stack))
(decf (stack-index stack))))
(defparameter *test-stack* (make-instance 'stack))
(stack-push *test-stack* 1)
#|
Slots with :INSTANCE allocation:
CONTENTS = #(1 0 0 0 0 0 0 0 0 0)
INDEX = 1
|#
(stack-push *test-stack* 3)
#|
Slots with :INSTANCE allocation:
CONTENTS = #(1 3 0 0 0 0 0 0 0 0)
INDEX = 2
|#
(stack-push *test-stack* -1)
;;; You can only push positive numbers on this stack. [Condition of type SIMPLE-ERROR]
(stack-push *test-stack* 0)
;;; You can only push positive numbers on this stack. [Condition of type SIMPLE-ERROR]