動態定義setf擴展器

Question

我試圖定義一個宏，該結構將在結構中使用結構的名稱，鍵和哈希表的名稱，並定義函數以訪問和修改鍵下的值哈希值。

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

爲了驗證這一點，我有：

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

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

當我運行

(make-hash-accessor tester x hash) 

然後

(tester-x too) 

返回3 T，因爲它應該，但

(setf (tester-x too) 5) 

給出了錯誤：

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))擴展到

(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 

我使用SBCL。我究竟做錯了什麼？

Answer 1

您應該儘可能使用defun。 具體來說，在這裏，而不是defmacro爲accessor-name和代替(setf fdefinition)您存取：

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

請注意，我用的是更傳統的名稱爲宏：因爲它定義 accessorts，是很常見的名字它define-...（參見define-condition,defpackage）。 make-...通常用於函數返回對象（參見make-package）。

另請參見Is defun or setf preferred for creating function definitions in common lisp and why? 請記住，樣式在縮進和命名變量，函數和宏中都很重要。