Dynamically defining setf expanders

Question

I'm trying to define a macro that'll take a struct's name, a key, and the name of a hash table in the struct and define functions to access and modify the value under the key in the hash.

(defmacro make-hash-accessor (struct-name key hash)
  (let ((key-accessor  (gensym))
        (hash-accessor (gensym)))
    `(let ((,key-accessor  (accessor-name ,struct-name ,key))
           (,hash-accessor (accessor-name ,struct-name ,hash)))
       (setf (fdefinition ,key-accessor) ; reads
             (lambda (instance)
               (gethash ',key
                (funcall ,hash-accessor instance))))
       (setf (fdefinition '(setf ,key-accessor)) ; modifies
             (lambda (instance to-value)
               (setf (gethash ',key
                      (funcall ,hash-accessor instance))
                 to-value))))))

;; Returns the symbol that would be the name of an accessor for a struct's slot
(defmacro accessor-name (struct-name slot)
  `(intern
    (concatenate 'string (symbol-name ',struct-name) "-" (symbol-name ',slot))))

To test this I have:

(defstruct tester
  (hash (make-hash-table)))

(defvar too (make-tester))
(setf (gethash 'x (tester-hash too)) 3)

When I run

(make-hash-accessor tester x hash)

then

(tester-x too)

it returns 3 T, as it should, but

(setf (tester-x too) 5)

gives the error:

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

(macroexpand-1 '(make-hash-accessor tester x hash)) expands to

(LET ((#:G690 (ACCESSOR-NAME TESTER X)) (#:G691 (ACCESSOR-NAME TESTER HASH)))
  (SETF (FDEFINITION #:G690)
        (LAMBDA (INSTANCE) (GETHASH 'X (FUNCALL #:G691 INSTANCE))))
  (SETF (FDEFINITION '(SETF #:G690))
        (LAMBDA (INSTANCE TO-VALUE)
          (SETF (GETHASH 'X (FUNCALL #:G691 INSTANCE)) TO-VALUE))))
T

I'm using SBCL. What am I doing wrong?

Answer 1

You should use defun whenever possible. Specifically, here instead of defmacro for accessor-name and instead of (setf fdefinition) for your accessors:

(defmacro define-hash-accessor (struct-name key hash)
  (flet ((concat-symbols (s1 s2)
           (intern (concatenate 'string (symbol-name s1) "-" (symbol-name s2)))))
    (let ((hash-key (concat-symbols struct-name key))
          (get-hash (concat-symbols struct-name hash)))
      `(progn
         (defun ,hash-key (instance)
           (gethash ',key (,get-hash instance)))
         (defun (setf ,hash-key) (to-value instance)
           (setf (gethash ',key (,get-hash instance)) to-value))
         ',hash-key))))
(defstruct tester
  (hash (make-hash-table)))
(defvar too (make-tester))
(setf (gethash 'x (tester-hash too)) 3)
too
==> #S(TESTER :HASH #S(HASH-TABLE :TEST FASTHASH-EQL (X . 3)))
(define-hash-accessor tester x hash)
==> tester-x
(tester-x too)
==> 7; T
(setf (tester-x too) 5)
too
==> #S(TESTER :HASH #S(HASH-TABLE :TEST FASTHASH-EQL (X . 5)))

Note that I use a more conventional name for the macro: since it defines accessorts, it is common to name it define-... (cf. define-condition, defpackage). make-... is usually used for functions returning objects (cf. make-package).

See also Is defun or setf preferred for creating function definitions in common lisp and why? Remember, style is important, both in indentation and in naming variables, functions, and macros.