动态定义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尽可能使用.具体来说,这里代替defmacrofor 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).

另请参阅defun或setf首选用于在常见的lisp中创建函数定义以及为什么？ 请记住,样式在缩进和命名变量,函数和宏中都很重要.