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?
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.