bind.l

(defun resolve-bind-args (bindexpr args)
  (mapcar
   (lambda (x)
     (cond
      ((bind-subexpression-p x) (call (resolve-bind-args x args)))
      ((bind-placeholder-p x) (nth (1- (bind-placeholder-position x)) args))
      (t x)))
   (bind-subexpression-bounds bindexpr)))
(defmacro bind (&rest bounds)
  `(let ((b ,(macroexpand (cons 'bind-internal bounds))))
     (lambda (&rest args)
       (call (resolve-bind-args b args)))))
(defmacro bind-internal (&rest bounds)
  `(make-bind-subexpression
    :bounds
    (list
     ,@(mapcar
        (lambda (x)
          (cond
           ((and (consp x)
                 (symbolp (car x))
                 (string= (symbol-name (car x)) "bind"))
            (macroexpand (cons 'bind-internal (cdr x))))
           ((and (symbolp x)
                 (char= (char (symbol-name x) 0) #\_)
                 (multiple-value-bind (n b)
                     (parse-integer (symbol-name x) :start 1 :radix 10)
                   (and b
                        (= b (length (symbol-name x)))
                        (make-bind-placeholder :position n)))))
           (t x)))
        bounds))))