Access to function arguments by their names in Common Lisp - common-lisp

Question

I want to get a function argument value, using an argument name.
The following code don't works, because symbol-value working only with global variables:
(defun test1 (&key v1)
(format t "V1: ~A~%" (symbol-value (intern "V1"))))
Is there a portable way to do this in Common Lisp?

Answer 1

You can use a custom environment to map strings to functions:
(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))
For example:
(bind (("a" (lambda (u) (+ 3 u)))
("b" (lambda (v) (* 5 v))))
nil
(call "a" (call "b" 10)))

Answer 2

Here is another version of an explicit named-binding hack. Note this isn't well (or at all) tested, and also note the performance is not going to be great.
(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)))))
And now:
> (with-named-bindings ((x 1))
(setf (named-binding 'x) 2)
(named-binding 'x))
2
Even better:
(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))
will work.