Saturday, October 19, 2013

defsetf Examples

Have you ever defined a custom class with hash components? Something like, say, a session?

(defclass session ()
  ((started :reader started :initform (get-universal-time))
   (last-poked :accessor last-poked :initform (get-universal-time))
   (token :reader token :initarg :token)
   (session-values :reader session-values :initform (make-hash-table :test 'equal))))

If you have, you probably also figured it would be better to define some sugar for look-ups rather than doing (gethash foo (session-values bar)) every damn time. Something like

(defmethod lookup (key (session session))
  (gethash key (session-values session)))

And if you've gotten that far, you probably noticed that you can't just go ahead and say (setf (lookup :test foo) new-val), because if you tried, you'd get this

The function (COMMON-LISP:SETF COMMON-LISP-USER::LOOKUP) is undefined.
   [Condition of type UNDEFINED-FUNCTION]

Restarts:
 0: [RETRY] Retry SLIME REPL evaluation request.
 1: [*ABORT] Return to SLIME's top level.
 2: [ABORT] Abort thread (#<THREAD "repl-thread" RUNNING {10047D0113}>)

There are two ways of fixing this.

If You Don't Need CLOS Support

For instance, if your lookup is a function rather than a method, you can get away with doing something like this

(defsetf lookup (key session) (new-value)
  `(setf (gethash ,key (session-values ,session)) ,new-value))

or, annotated

(defsetf [name-of-lookup-function] (&rest [lookip-function-args]) (new-value)
  [macro-body])

Once you've defined that as appropriate, you can just

CL-USER> (lookup :test foo)
NIL
NIL
CL-USER> (setf (lookup :test foo) 'new-val)
NEW-VAL
CL-USER> (lookup :test foo)
NEW-VAL
T
CL-USER> 

This isn't satisfying if the lookup abstraction you've defined is a method though. Because then you get into this problem

CL-USER> (defmethod lookup (key (session session))
  (gethash key (session-values session)))

(defmethod lookup (key (hash hash-table))
  (gethash key hash))
STYLE-WARNING: Implicitly creating new generic function LOOKUP.
#<STANDARD-METHOD LOOKUP (T HASH-TABLE) {1005048E03}>
CL-USER> (defsetf lookup (key session) (new-value)
  `(setf (gethash ,key (session-values ,session)) ,new-value))
LOOKUP
CL-USER> (defparameter foo (make-instance 'session))
FOO
CL-USER> (defparameter bar (make-hash-table))
BAR
CL-USER> (lookup :test foo)
NIL
NIL
CL-USER> (lookup :test bar)
NIL
NIL
CL-USER> (setf (lookup :test foo) 'one)
ONE
CL-USER> (setf (lookup :test bar) 'two)

There is no applicable method for the generic function
  #<STANDARD-GENERIC-FUNCTION SESSION-VALUES (1)>
when called with arguments
  (#<HASH-TABLE :TEST EQL :COUNT 0 {10051DC633}>).
   [Condition of type SIMPLE-ERROR]

Restarts:
 0: [RETRY] Retry calling the generic function.
 1: [RETRY] Retry SLIME REPL evaluation request.
 2: [*ABORT] Return to SLIME's top level.
 3: [ABORT] Abort thread (#<THREAD "repl-thread" RUNNING {10047D0113}>)

Backtrace:
  0: ((SB-PCL::FAST-METHOD NO-APPLICABLE-METHOD (T)) #<unused argument> #<unused argument> #<STANDARD-GENERIC-FUNCTION SESSION-VALUES (1)> #<HASH-TABLE :TEST EQL :COUNT 0 {10051DC633}>)
  1: (SB-PCL::CALL-NO-APPLICABLE-METHOD #<STANDARD-GENERIC-FUNCTION SESSION-VALUES (1)> (#<HASH-TABLE :TEST EQL :COUNT 0 {10051DC633}>))
  2: (#:EVAL-THUNK)
  ...

If You Need CLOS Support

Then you'll need to define a setf generic. In the example we've been using, you could do the following:

(defgeneric (setf lookup) (new-value key session)
  (:documentation "Setter for lookup methods"))

(defmethod (setf lookup) (new-value key (session session))
  (setf (gethash key (session-values session)) new-value))

(defmethod (setf lookup) (new-value key (hash hash-table))
  (setf (gethash key hash) new-value))

Which would then let you polymorphically use setf exactly the way you'd expect.

CL-USER> (defparameter foo (make-instance 'session))
FOO
CL-USER> (defparameter bar (make-hash-table))
BAR
CL-USER> (list (lookup :test foo) (lookup :test bar))
(NIL NIL)
CL-USER> (setf (lookup :test foo) 'session (lookup :test bar) 'hash)
HASH
CL-USER> (list (lookup :test foo) (lookup :test bar))
(SESSION HASH)
CL-USER>

There. Hopefully the next person who searches for "defsetf examples" will find something more useful than I did.

2 comments:

  1. Interesting, I was unaware of defsetf, in what way is it related to(defun (setf [name-of-loopkupfunction]) ...) Does defsetf define the macroexpansion for the setf form?

    ReplyDelete
    Replies
    1. According to

      http://stackoverflow.com/a/8874701/190887

      It looks like (defun (setf ...) ...) , (defsetf ...) and (define-setf-expander ...) are three similar constructs that give you increasingly granular control over what you're doing. I've never actually used the other two before, but it looks like you could get the same effect out of (defun (setf ...) ...) as I do out of using (defsetf ...) in the above example.

      Based on my reading of that SO answer, I should prefer (defun (setf ...) ...) for simple cases.

      Delete