Setf Expander dynamisch definieren

Question

Ich versuche, ein Makro zu definieren, das den Namen einer Struktur, einen Schlüssel und den Namen einer Hashtabelle in der Struktur nimmt und Funktionen definiert, um auf den Wert unter dem Schlüssel zuzugreifen und ihn zu ändern 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)))) 

Um dies zu testen, habe ich:

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

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

Als ich

(make-hash-accessor tester x hash) 

dann

(tester-x too) 

es laufen zurück 3 T, wie es sollte, aber

(setf (tester-x too) 5) 

gibt den Fehler:

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)) zu

erweitert

(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 

ich SBCL bin mit. Was mache ich falsch?

Answer 1

Sie sollten möglichst defun verwenden. Insbesondere hier statt defmacro für accessor-name und statt (setf fdefinition) für Accessoren:

(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))) 

Bitte beachte, dass ich einen konventionelleren Namen für das Makro verwenden: da es accessorts definiert, ist es üblich, zu nennen es define-... (cf. define-condition, defpackage). make-... wird normalerweise für Funktionen zurückgebende Objekte verwendet (vgl.).

Siehe auch Is defun or setf preferred for creating function definitions in common lisp and why? Denken Sie daran, Stil ist wichtig, sowohl in Einrückung und Benennung von Variablen, Funktionen und Makros.