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?

sds · Accepted Answer · 2017-07-20T13:34:56.343

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.

It might be clearer to name the macro `DEFINE-HASH-ACCESSOR`, since it's defining functions, not returning them. Maybe also move `ACCESSOR-NAME` to a local function, so one doesn't need to worry about it being available at compile time. — jkiiski, Jul 20 '17 at 06:09
@jkiiski: you are right, I tried to stay with the OP's notation, but I will edit. — sds, Jul 20 '17 at 13:16

Dynamically defining setf expanders

1 Answers1