(defmacro fbind-1 (bindings &body body)
  (let ((bindings (mapcar (lambda (b) (append b (list (gensym))))
                          bindings)))
    (eval
     `(alexandria:once-only ,(mapcar (lambda (b) `(,(third b) ',(second b)))
                                     bindings)
        ;; Dance around with BINDINGS since we're doubly quoted.
        ;; We're using LIST to force double evaluation!
        `(flet ,(list ,@(mapcar (lambda (b) ``(,',(first b) (&rest args)
                                               (apply ,,(third b) args)))
                          bindings))
           ;; Take the value of BODY immediately but fully splice it only later
           ;; on.
           ,@',body)))))

;; --------------------------------------------------------------------------------

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defun zip (&rest seqs)
    (apply #'mapcar #'list seqs)))

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defun gensyms (n)
    (loop :repeat n
          :collect (gensym))))

(defmacro eval-with (bindings &body body)
  ;; Dance around with BINDINGS since we're doubly quoted.
  `(eval `(let ,(list ,@(mapcar (lambda (b) ``(,',b ',,b))
                                bindings))
            ,,@body)))

(defmacro once-only-list-eval ((oo initforms) pass-over &body body)
  "This macro is supposed to be used while writing another macro, just like
ONCE-ONLY. However, it's purpose is to support an arbitrary number of \"specs\",
which is something that's not possible with ONCE-ONLY because of how macros
work. INITFORMS has to be an expression. This macro will expand into code that
will evaluate INITFORMS within the host macro, at macroexpansion-time. The
result should be a list of forms that will then be used with ONCE-ONLY. The call
to ONCE-ONLY is built up dynamically and then EVAL'd. PASS-OVER is a list of
variables that the caller wants to have available within the EVAL (an
unfortunate consequence). OO must be a symbol that will be bound within the host
macro to a list of gensyms which appear in the final expansion (the one that
ONCE-ONLY helped write).
"
  (alexandria:with-gensyms (forms syms)
    ;; ONCE-ONLY takes pairs of the form (SYMBOL INITFORM), where INITFORM is an
    ;; expression that when evaluated gives the form that will be evaluated
    ;; within the expansion. That's why we're quoting the forms (since they
    ;; don't reside in variables as usual).
    `(let* ((,forms (mapcar (lambda (f) `',f) ,initforms))
            (,syms (gensyms (length ,forms))))
       ;; Unforunately, the abstraction (the use of EVAL under the hood) shows
       ;; through. The user has to explicitly list all of the symbols that he
       ;; wishes to use within the EVAL (and whose value will be taken from
       ;; EVAL's outer scope).
       (eval-with ,pass-over
         `(alexandria:once-only ,(zip ,syms ,forms)
            ;; Use LIST to force the evaluation of gensyms given to ONCE-ONLY.
            ;; We're gathering the gensyms that will be used in the expansion
            ;; that ONCE-ONLY helped write, into a list bound to whichever
            ;; symbol was given as OO.
            (let ((,',oo (list ,@,syms)))
              ,@',body))))))

(defmacro fbind-2 (bindings &body body)
  (once-only-list-eval (oo (mapcar #'second bindings))
                       (bindings body)
    (let ((names (mapcar (lambda (b o) (list (first b) o))
                         bindings oo)))
      `(flet ,(mapcar (lambda (n) `(,(first n) (&rest args)
                                    (apply ,(second n) args)))
               names)
         ,@body))))

;; --------------------------------------------------------------------------------

(defmacro once-only-list-macro-function ((oo initforms) env pass-over &body body)
  "The same thing as ONCE-ONLY-LIST-EVAL except that it uses MACRO-FUNCTION to
fetch ONCE-ONLY's macro function and call it. The EVAL cannot be avoided.
Furthermore, along with having to explictily list variables we want to have
available within the EVAL, we also have to take care of the environment as well.
ENV needs to be a form (usually just a symbol naming the &environment parameter
of the host macro) that will be evaluated within the host macro to get an
environment object.
"
  (alexandria:with-gensyms (fun syms forms)
    `(let* ((,fun (macro-function 'alexandria:once-only))
            (,forms (mapcar (lambda (f) `',f) ,initforms))
            (,syms (gensyms (length ,forms))))
       (eval-with ,pass-over
         (funcall ,fun
                  (list 'alexandria:once-only
                        (zip ,syms ,forms)
                        `(let ((,',oo (list ,@,syms)))
                           ,@',body))
                  ,env)))))

(defmacro fbind (&environment env bindings &body body)
  (once-only-list-macro-function (oo (mapcar #'second bindings))
                                 env
                                 (bindings body)
    (let ((names (mapcar (lambda (b o) (list (first b) o))
                         bindings oo)))
      `(flet ,(mapcar (lambda (n) `(,(first n) (&rest args)
                                    (apply ,(second n) args)))
               names)
         ,@body))))

;; --------------------------------------------------------------------------------

;; Bike's version.

;; The ONCE-ONLY within ONCE-ONLY-LIST doesn't have the same function as within
;; my macros. It's only here for the purposes of ONCE-ONLY-LIST's hygiene, not
;; for the sake of reusing the functionality of ONCE-ONLY. Therefore, the macro
;; still reimplements what ONCE-ONLY does, but instead for an arbitrary number
;; of specs.

(defmacro once-only-list-bike ((syms initforms) &body body)
  (alexandria:once-only (initforms)
    `(let ((,syms (gensyms (length ,initforms))))
       `(let (,@(loop for sym in ,syms for initform in ,initforms
                      collect `(,sym ,initform)))
          ,,@body))))

(defmacro fbind-bike ((&rest bindings) &body body)
  (let ((names (mapcar #'first bindings))
        (initforms (mapcar #'second bindings)))
    (once-only-list (funs initforms)
      `(flet ,(mapcar (lambda (name fun)
                        `(,name (&rest args) (apply ,fun args)))
               names funs)
         ,@body))))

;; My addition. Can we write a constant-size version of ONCE-ONLY using the list
;; version? Yes, we can, and it doesn't require EVAL! This is the same thing as
;; Alexandria's ONCE-ONLY.

(defmacro once-only-const-bike (specs &body body)
  (alexandria:with-gensyms (oo)
    (let ((specs (mapcar (lambda (s) (etypecase s
                                       (symbol (list s s))
                                       (list s)))
                         specs)))
      `(once-only-list-bike (,oo (list ,@(mapcar #'second specs)))
         (destructuring-bind ,(mapcar #'first specs) ,oo
           ,@body)))))

(defmacro something (a b c)
  (once-only-const-bike (a b c)
    `(format t "~a ~a ~a~%~a ~a ~a~%~a ~a ~a~%"
             ,a ,a ,a
             ,b ,b ,b
             ,c ,c ,c)))

(let ((counter 0))
  (something (incf counter) (decf counter) 123))

;; >> 1 1 1
;; >> 0 0 0
;; >> 123 123 123

;; --------------------------------------------------------------------------------

(let ((counter 0))
  (flet ((get-function (x) (lambda (a) (+ a x))))
    (format t "counter before: ~a~%" counter)
    (fbind ((fun1 (progn (incf counter) (get-function 5)))
            (fun2 (get-function 10)))
      (format t "counter after: ~a~%" counter)
      (prog1 (list (fun1 5)
                   (fun1 5)
                   (fun2 10)
                   (fun2 10))
        (format t "counter way after: ~a~%" counter)))))

;; >> counter before: 0
;; >> counter after: 1
;; >> counter way after: 1
;; => (10 10 20 20)