问题描述
我想使用参数名称获取函数参数值。
以下代码不起作用,因为 symbol-value
仅适用于全局变量:
(defun test1 (&key v1)
(format t "V1: ~A~%" (symbol-value (intern "V1"))))
在 Common Lisp 中是否有一种可移植的方法来做到这一点?
解决方法
您可以使用自定义环境将字符串映射到函数:
(use-package :alexandria)
(defvar *env* nil)
(defun resolve (name &optional (env *env*))
(if-let (entry (assoc name env :test #'string=))
(cdr entry)
(error "~s not found in ~a" name env)))
(defmacro bind (bindings env &body body)
(assert (symbolp env))
(let ((env (or env '*env*)))
(loop
for (n v) in bindings
collect `(cons,n,v) into fresh-list
finally
(return
`(let ((,env (list*,@fresh-list,env))),@body)))))
(defmacro call (name &rest args)
`(funcall (resolve,name),@args))
例如:
(bind (("a" (lambda (u) (+ 3 u)))
("b" (lambda (v) (* 5 v))))
nil
(call "a" (call "b" 10)))
,
这是显式命名绑定黑客的另一个版本。请注意,这并没有经过很好的(或根本没有)测试,还要注意性能不会很好。
(defun named-binding (n)
;; Get a binding by its name: this is an error outside
;; WITH-NAMED-BINDINGS
(declare (ignore n))
(error "out of scope"))
(defun (setf named-binding) (val n)
;; Set a binding by its name: this is an error outside
;; WITH-NAMED-BINDINGS
(declare (ignore val n))
(error "out of scope"))
(defmacro with-named-bindings ((&rest bindings) &body decls/forms)
;; establish a bunch of bindings (as LET) but allow access to them
;; by name
(let ((varnames (mapcar (lambda (b)
(cond
((symbolp b) b)
((and (consp b)
(= (length b) 2)
(symbolp (car b)))
(car b))
(t (error "bad binding ~S" b))))
bindings))
(decls (loop for df in decls/forms
while (and (consp df) (eql (car df) 'declare))
collect df))
(forms (loop for dft on decls/forms
for df = (first dft)
while (and (consp df) (eql (car df) 'declare))
finally (return dft)))
(btabn (make-symbol "BTAB")))
`(let (,@bindings),@decls
(let ((,btabn (list,@(mapcar (lambda (v)
`(cons ',v (lambda (&optional (val nil valp))
(if valp
(setf,v val),v))))
varnames))))
(flet ((named-binding (name)
(let ((found (assoc name,btabn)))
(unless found
(error "no binding ~S" name))
(funcall (cdr found))))
((setf named-binding) (val name)
(let ((found (assoc name,btabn)))
(unless found
(error "no binding ~S" name))
(funcall (cdr found) val))))
(declare (inline named-binding (setf named-binding))),@forms)))))
现在:
> (with-named-bindings ((x 1))
(setf (named-binding 'x) 2)
(named-binding 'x))
2
更好:
(defun amusing (x y)
(with-named-bindings ((x x) (y y))
(values #'named-binding #'(setf named-binding))))
(multiple-value-bind (reader writer) (amusing 1 2)
(funcall writer 2 'x)
(funcall reader 'x))
会起作用。