动态定义 setf 扩展器
Dynamically defining setf expanders
我正在尝试定义一个宏,它将采用结构的名称、键和结构中的散列名称 table,并定义函数来访问和修改键下的值在散列中。
(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)
它returns 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。我做错了什么?
您应该尽可能使用 defun
。
具体来说,这里代替 defmacro
for accessor-name
and instead of (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)))
请注意,我为宏使用了一个更常规的名称:因为它 定义了 访问器,所以通常将其命名为 define-...
(参见 define-condition
, defpackage
).
make-...
通常用于 函数 返回对象(参见 make-package
)。
另见
请记住,风格很重要,无论是缩进还是变量、函数和宏的命名。
我正在尝试定义一个宏,它将采用结构的名称、键和结构中的散列名称 table,并定义函数来访问和修改键下的值在散列中。
(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)
它returns 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。我做错了什么?
您应该尽可能使用 defun
。
具体来说,这里代替 defmacro
for accessor-name
and instead of (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)))
请注意,我为宏使用了一个更常规的名称:因为它 定义了 访问器,所以通常将其命名为 define-...
(参见 define-condition
, defpackage
).
make-...
通常用于 函数 返回对象(参见 make-package
)。
另见