CODEWITHSUNDEEP
bindingcommon-lisplet
PerduGames
PerduGames

Reputation: 1228

Passing Variable Bindings to Functions

I have the Javascript code below. What would be equivalent in Common Lisp?

function A () {
}
function B () {
}

var a1 = new A();
var b1 = new B();

a1.done.bind(b1);

What am I trying to do? I need to pass a context(what I mean in context is what let creates, the bindings of variables) for functions that will be executed.

I have a function x1 and a x2, I want them to have access to the variables of a let. The problem is that I need to pass the function as a variable. See my try below:

(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.

I understand why x is not found, this happens because of this:

(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

Which is different from this:

(macroexpand-1 '(create-suite-context
                 ((x 2))
                 (lambda () (+ x 1))))
(LET ((#:G592 'NIL))
  (CREATE-CONTEXT ((X 2))
    (PUSH (LAMBDA () (+ X 1)) #:G592)))
T

So by that I think I would need some "bind" macro where I could pass the "vars" variables so that the functions had access.

Note: I know I do not need the create-context macro because what it doeslet already does, but it was to better explain what I mean by context.

up after @jkiiski response

I'd like to initially support two different types of interfaces for my testing framework:

(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)

As you can see the first interface is easier to handle, because I have the available bindings. In the second interface has no way to do this, I could wrap in a let as well, but that would take away the reason why I also choose to implement this interface, which is to avoid nesting, depending on the tests I prefer to read on the second interface. So that's why I came up with this question where in the real problem is of how I could pass a context from suite-1 to test-1 and test-2 without using an explicit let.

Upvotes: 0

Views: 211

Answers (1)

jkiiski
jkiiski

Reputation: 8421

There is no way to do this with lexical variables. Depending on your use case, there are a couple alternatives you could try:

  1. The preferred solution would be to rethink the problem and find a way to either have the bindings available when the function is defined, or to pass the values as arguments.

  2. Use special bindings instead. The problem of course is that the bindings will be visible in the entire dynamic scope, but in some cases that might be ok. For example, MOP has a rarely used feature of funcallable instances, which you could use to define a type of function keeps special bindings in a hash 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

  3. In some situations you might be able to build a list and use COMPILE to compile a lambda-expression with the bindings. In normal application code this will probably be a bad idea, but for a testing framework for example it could be ok (you might want the framework to compile test-cases anyway for macros, compiler macros and inline functions to use the current definition).

After update

Based on the update it seems like option 3 is what you're looking for. You can store the bindings with the suite, and when running tests, use COMPILE to compile a lambda-expression with the bindings injected into it. A very simple example (ignoring all complexities of a real testing framework that are not relevant to the question):

(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

This assumes that while all tests have equivalent bindings, the bindings don't need to be the same, i.e. (setf x 100) in one test doesn't need to be visible to other tests that are executed after it.

You could change RUN to establish a dynamic binding around all the tests with PROGV to make changes visible to following tests. Now the variables have of course become special rather than lexical though.

(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

Upvotes: 4

Related Questions