在 Common Lisp 中按名称访问函数参数

如何解决在 Common Lisp 中按名称访问函数参数

我想使用参数名称获取函数参数值。 以下代码不起作用，因为 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))

会起作用。