将变量绑定传递给函数
Passing Variable Bindings to Functions
我有下面的 Javascript 代码。 Common Lisp 中的等价物是什么？
function A () {
}
function B () {
}
var a1 = new A();
var b1 = new B();
a1.done.bind(b1);
我想做什么？我需要为将要执行的函数传递上下文（我在上下文中的意思是 let 创建的变量绑定）。
我有一个函数x1和一个x2，我想让它们访问一个let的变量。问题是我需要将函数作为变量传递。请参阅下面的尝试：
(defmacro create-context (vars &body body)
`(let ,vars
,@body))
(create-context ((x 2) (y 3)) (+ x y))
(defmacro create-suite-context (vars fn)
(with-gensyms (childs)
`(let ((,childs '()))
(create-context
,vars
(push ,fn ,childs)))))
(let* ((a (create-suite-context ((x 2)) (lambda () (+ x 1)))))
(funcall (car a)))
;; return 3 - OK
(let* ((f (lambda () (+ x 1)))
(a (create-suite-context ((x 2)) f)))
(funcall (car a)))
;; The variable X is unbound.
我明白为什么找不到x，这是因为：
(let ((f (lambda () (+ x 1))))
(macroexpand-1 '(create-suite-context
((x 2))
f)))
; in: LET ((F (LAMBDA () (+ X 1))))
; (LET ((F (LAMBDA () (+ X 1))))
; (MACROEXPAND-1 '(CREATE-SUITE-CONTEXT ((X 2)) F)))
;
; caught STYLE-WARNING:
; The variable F is defined but never used.
; in: LET ((F (LAMBDA () (+ X 1))))
; (+ X 1)
;
; caught WARNING:
; undefined variable: X
;
; compilation unit finished
; Undefined variable:
; X
; caught 1 WARNING condition
; caught 1 STYLE-WARNING condition
(LET ((#:G591 'NIL))
(CREATE-CONTEXT ((X 2))
(PUSH F #:G591)))
T
与此不同的是：
(macroexpand-1 '(create-suite-context
((x 2))
(lambda () (+ x 1))))
(LET ((#:G592 'NIL))
(CREATE-CONTEXT ((X 2))
(PUSH (LAMBDA () (+ X 1)) #:G592)))
T
因此，我想我需要一些 "bind" 宏，我可以在其中传递 "vars" 变量，以便函数可以访问。
注意：我知道我不需要 create-context 宏，因为它的作用let 已经做了，但这是为了更好地解释我的意思按上下文表示。
up after @jkiiski response
我想为我的测试框架最初支持两种不同类型的接口：
(set-ui-cacau 'new-tdd)
(suite :suite-1
(let ((x y z))
(test :test-1
(let ((actual nil))
(t-p t))
:timeout 50)
(test :test-2
(let ((actual nil))
(t-p t))
:timeout 70)))
(run-cacau :reporter 'min)
;; or
(set-ui-cacau 'classic)
(in-suite :suite-1
:timeout 30
:parent :root)
(test :test-1
(let ((actual nil))
(t-p actual))
:timeout 50)
(test :test-2
(let ((actual nil)
(expected 1))
(setf actual 1)
(eq-p actual expected))
:timeout 70)
(run-cacau :reporter 'min)
如您所见，第一个界面更容易处理，因为我有可用的绑定。在第二个接口中没有办法做到这一点，我也可以包装在一个 let 中，但这会带走我也选择实现这个接口的原因，这是为了避免嵌套，具体取决于我喜欢阅读的测试在第二个界面上。所以这就是我提出这个问题的原因，真正的问题是如何在不使用显式 let 的情况下将上下文从 suite-1 传递到 test-1 和 test-2。
没有办法用词法变量来做到这一点。根据您的用例，您可以尝试几种替代方案：
首选解决方案是重新考虑问题并找到一种方法，要么在定义函数时使绑定可用，要么将值作为参数传递。
改用特殊绑定。问题当然是绑定将在整个动态范围内可见，但在某些情况下可能没问题。例如，MOP 有一个很少使用的 funcallable 实例特性，你可以用它来定义一种函数，在散列中保持特殊绑定 table.
(ql:quickload :closer-mop)
(defclass context-fn (closer-mop:funcallable-standard-object)
((context :initform (make-hash-table)
:accessor context-fn-context))
(:metaclass closer-mop:funcallable-standard-class))
(defmethod initialize-instance :after ((context-fn context-fn)
&key (fn (error "Must have a :FN")))
(closer-mop:set-funcallable-instance-function
context-fn
(lambda (&rest args)
(let (vars vals)
(maphash (lambda (key value)
(push key vars)
(push value vals))
(context-fn-context context-fn))
(progv vars vals
(apply fn args))))))
(defun context-bind (fn name value)
(check-type fn context-fn)
(check-type name symbol)
(setf (gethash name (context-fn-context fn)) value))
(defmacro bind (fn name value)
`(context-bind ,fn ',name ,value))
(defmacro clambda (lambda-list &body body)
`(make-instance 'context-fn :fn (lambda ,lambda-list ,@body)))
(let ((fn (clambda (y)
(declare (special x))
(+ x y))))
(bind fn x 100)
(funcall fn 10))
;;=> 110
在某些情况下，您可以构建一个列表并使用 COMPILE 来编译带有绑定的 lambda 表达式。在正常的应用程序代码中，这可能是一个坏主意，但对于一个测试框架来说，它可能没问题（您可能希望框架为宏、编译器宏和内联函数编译测试用例以使用当前定义）。
更新后
根据更新，您似乎正在寻找选项 3。您可以将绑定存储在套件中，并且在 运行 测试时，使用 COMPILE 编译注入绑定的 lambda 表达式。一个非常简单的例子（忽略与问题无关的真实测试框架的所有复杂性）：
(defstruct suite
name
bindings
(tests (make-hash-table)))
(defvar *known-suites* (make-hash-table))
(defvar *suite*)
(defmacro suite (name &key bindings)
`(setf (gethash ',name *known-suites*)
(make-suite :name ',name :bindings ',bindings)))
(defmacro in-suite (name)
`(setf *suite* (gethash ',name *known-suites*)))
(defmacro test (name form)
`(setf (gethash ',name (suite-tests *suite*))
',form))
(defun run (&optional (suite *suite*))
(let ((bindings (suite-bindings suite)))
(format t "~s~%" (suite-name suite))
(maphash (lambda (name form)
(format t "~&~10<~:[Fail~;Success~]~> | ~s~%"
(funcall
(compile nil
`(lambda ()
(let ,bindings
(declare (ignorable ,@(mapcar #'first bindings)))
,form))))
name))
(suite-tests suite))))
(suite my-suite
:bindings ((x 10)
(y 20)))
(in-suite my-suite)
(test my-test-1 (= x 15))
(test my-test-2 (evenp (+ x y)))
(run)
;; MY-SUITE
;; Fail | MY-TEST-1
;; Success | MY-TEST-2
这假设虽然所有测试都具有等效绑定，但绑定不需要相同，即一个测试中的 (setf x 100) 不需要对在它之后执行的其他测试可见.
您可以更改 RUN 以围绕所有测试建立动态绑定 PROGV 以使更改对后续测试可见。现在变量当然已经变得特殊而不是词汇了。
(defun run/special (&optional (suite *suite*))
(let ((bindings (suite-bindings suite)))
(format t "~s~%" (suite-name suite))
(progv
(mapcar #'first bindings)
(mapcar #'second bindings)
(maphash (lambda (name form)
(format t "~&~10<~:[Fail~;Success~]~> | ~s~%"
(funcall
(compile nil
`(lambda ()
(declare (special ,@(mapcar #'first bindings)))
,form)))
name))
(suite-tests suite)))))
(suite my-suite-2
:bindings ((x 10)
(y 20)))
(in-suite my-suite-2)
(test my-test-3 (progn (incf x 5)
(= x 15)))
(test my-test-4 (evenp (+ x y)))
(run/special)
;; MY-SUITE-2
;; Success | MY-TEST-3
;; Fail | MY-TEST-4
我有下面的 Javascript 代码。 Common Lisp 中的等价物是什么？
function A () {
}
function B () {
}
var a1 = new A();
var b1 = new B();
a1.done.bind(b1);
我想做什么？我需要为将要执行的函数传递上下文（我在上下文中的意思是 let 创建的变量绑定）。
我有一个函数x1和一个x2，我想让它们访问一个let的变量。问题是我需要将函数作为变量传递。请参阅下面的尝试：
(defmacro create-context (vars &body body)
`(let ,vars
,@body))
(create-context ((x 2) (y 3)) (+ x y))
(defmacro create-suite-context (vars fn)
(with-gensyms (childs)
`(let ((,childs '()))
(create-context
,vars
(push ,fn ,childs)))))
(let* ((a (create-suite-context ((x 2)) (lambda () (+ x 1)))))
(funcall (car a)))
;; return 3 - OK
(let* ((f (lambda () (+ x 1)))
(a (create-suite-context ((x 2)) f)))
(funcall (car a)))
;; The variable X is unbound.
我明白为什么找不到x，这是因为：
(let ((f (lambda () (+ x 1))))
(macroexpand-1 '(create-suite-context
((x 2))
f)))
; in: LET ((F (LAMBDA () (+ X 1))))
; (LET ((F (LAMBDA () (+ X 1))))
; (MACROEXPAND-1 '(CREATE-SUITE-CONTEXT ((X 2)) F)))
;
; caught STYLE-WARNING:
; The variable F is defined but never used.
; in: LET ((F (LAMBDA () (+ X 1))))
; (+ X 1)
;
; caught WARNING:
; undefined variable: X
;
; compilation unit finished
; Undefined variable:
; X
; caught 1 WARNING condition
; caught 1 STYLE-WARNING condition
(LET ((#:G591 'NIL))
(CREATE-CONTEXT ((X 2))
(PUSH F #:G591)))
T
与此不同的是：
(macroexpand-1 '(create-suite-context
((x 2))
(lambda () (+ x 1))))
(LET ((#:G592 'NIL))
(CREATE-CONTEXT ((X 2))
(PUSH (LAMBDA () (+ X 1)) #:G592)))
T
因此，我想我需要一些 "bind" 宏，我可以在其中传递 "vars" 变量，以便函数可以访问。
注意：我知道我不需要 create-context 宏，因为它的作用let 已经做了，但这是为了更好地解释我的意思按上下文表示。
up after @jkiiski response
我想为我的测试框架最初支持两种不同类型的接口：
(set-ui-cacau 'new-tdd)
(suite :suite-1
(let ((x y z))
(test :test-1
(let ((actual nil))
(t-p t))
:timeout 50)
(test :test-2
(let ((actual nil))
(t-p t))
:timeout 70)))
(run-cacau :reporter 'min)
;; or
(set-ui-cacau 'classic)
(in-suite :suite-1
:timeout 30
:parent :root)
(test :test-1
(let ((actual nil))
(t-p actual))
:timeout 50)
(test :test-2
(let ((actual nil)
(expected 1))
(setf actual 1)
(eq-p actual expected))
:timeout 70)
(run-cacau :reporter 'min)
如您所见，第一个界面更容易处理，因为我有可用的绑定。在第二个接口中没有办法做到这一点，我也可以包装在一个 let 中，但这会带走我也选择实现这个接口的原因，这是为了避免嵌套，具体取决于我喜欢阅读的测试在第二个界面上。所以这就是我提出这个问题的原因，真正的问题是如何在不使用显式 let 的情况下将上下文从 suite-1 传递到 test-1 和 test-2。
没有办法用词法变量来做到这一点。根据您的用例，您可以尝试几种替代方案：
首选解决方案是重新考虑问题并找到一种方法，要么在定义函数时使绑定可用，要么将值作为参数传递。
改用特殊绑定。问题当然是绑定将在整个动态范围内可见，但在某些情况下可能没问题。例如，MOP 有一个很少使用的 funcallable 实例特性，你可以用它来定义一种函数，在散列中保持特殊绑定 table.
(ql:quickload :closer-mop) (defclass context-fn (closer-mop:funcallable-standard-object) ((context :initform (make-hash-table) :accessor context-fn-context)) (:metaclass closer-mop:funcallable-standard-class)) (defmethod initialize-instance :after ((context-fn context-fn) &key (fn (error "Must have a :FN"))) (closer-mop:set-funcallable-instance-function context-fn (lambda (&rest args) (let (vars vals) (maphash (lambda (key value) (push key vars) (push value vals)) (context-fn-context context-fn)) (progv vars vals (apply fn args)))))) (defun context-bind (fn name value) (check-type fn context-fn) (check-type name symbol) (setf (gethash name (context-fn-context fn)) value)) (defmacro bind (fn name value) `(context-bind ,fn ',name ,value)) (defmacro clambda (lambda-list &body body) `(make-instance 'context-fn :fn (lambda ,lambda-list ,@body))) (let ((fn (clambda (y) (declare (special x)) (+ x y)))) (bind fn x 100) (funcall fn 10)) ;;=> 110在某些情况下，您可以构建一个列表并使用
COMPILE来编译带有绑定的 lambda 表达式。在正常的应用程序代码中，这可能是一个坏主意，但对于一个测试框架来说，它可能没问题（您可能希望框架为宏、编译器宏和内联函数编译测试用例以使用当前定义）。
更新后
根据更新，您似乎正在寻找选项 3。您可以将绑定存储在套件中，并且在 运行 测试时，使用 COMPILE 编译注入绑定的 lambda 表达式。一个非常简单的例子（忽略与问题无关的真实测试框架的所有复杂性）：
(defstruct suite
name
bindings
(tests (make-hash-table)))
(defvar *known-suites* (make-hash-table))
(defvar *suite*)
(defmacro suite (name &key bindings)
`(setf (gethash ',name *known-suites*)
(make-suite :name ',name :bindings ',bindings)))
(defmacro in-suite (name)
`(setf *suite* (gethash ',name *known-suites*)))
(defmacro test (name form)
`(setf (gethash ',name (suite-tests *suite*))
',form))
(defun run (&optional (suite *suite*))
(let ((bindings (suite-bindings suite)))
(format t "~s~%" (suite-name suite))
(maphash (lambda (name form)
(format t "~&~10<~:[Fail~;Success~]~> | ~s~%"
(funcall
(compile nil
`(lambda ()
(let ,bindings
(declare (ignorable ,@(mapcar #'first bindings)))
,form))))
name))
(suite-tests suite))))
(suite my-suite
:bindings ((x 10)
(y 20)))
(in-suite my-suite)
(test my-test-1 (= x 15))
(test my-test-2 (evenp (+ x y)))
(run)
;; MY-SUITE
;; Fail | MY-TEST-1
;; Success | MY-TEST-2
这假设虽然所有测试都具有等效绑定，但绑定不需要相同，即一个测试中的 (setf x 100) 不需要对在它之后执行的其他测试可见.
您可以更改 RUN 以围绕所有测试建立动态绑定 PROGV 以使更改对后续测试可见。现在变量当然已经变得特殊而不是词汇了。
(defun run/special (&optional (suite *suite*))
(let ((bindings (suite-bindings suite)))
(format t "~s~%" (suite-name suite))
(progv
(mapcar #'first bindings)
(mapcar #'second bindings)
(maphash (lambda (name form)
(format t "~&~10<~:[Fail~;Success~]~> | ~s~%"
(funcall
(compile nil
`(lambda ()
(declare (special ,@(mapcar #'first bindings)))
,form)))
name))
(suite-tests suite)))))
(suite my-suite-2
:bindings ((x 10)
(y 20)))
(in-suite my-suite-2)
(test my-test-3 (progn (incf x 5)
(= x 15)))
(test my-test-4 (evenp (+ x y)))
(run/special)
;; MY-SUITE-2
;; Success | MY-TEST-3
;; Fail | MY-TEST-4