;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; MAP-OPERATORS-2

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defun map-operators-2 (func form &optional env)
    (flet ((lizard-func (func)
             (lambda (f env)
               (if (consp f)
                   (funcall func f env)
                   f))))
      (agnostic-lizard:walk-form
       form env
       :on-special-form
       (lambda (f env)
         (if (consp f)
             (funcall func f :special env)
             f))
       :on-function-form
       (lambda (f env)
         (if (consp f)
             (funcall func f :function env)
             f))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; WITH-OVERLOAD

(defmacro with-overload (specs &body body &environment env)
  (map-operators-2
   (lambda (op type env)
     (declare (ignore env))
     (if (eq type :function)
         (let ((new (find (car op) specs
                          :key #'first :test #'string-equal)))
           (if new
               (cons (second new) (cdr op))
               op))
         op))
   `(progn ,@body) env))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; WITH-OVERLOAD Examples

;;; WITH-OVERLOAD Example 1

(with-overload ((+ -))
  (+ 2 2))

;; => 0

;;; WITH-OVERLOAD Example 2

(values
 (multiple-value-list
  (values (+ 2 2)
          (+ (+ (+ 0 1) 2) 3)))
 (multiple-value-list
  (with-overload ((+ -))
    (values (+ 2 2)
            (+ (+ (+ 0 1) 2) 3)))))

;; => (4 6), (0 -6)

;;; TODO: WITH-OVERLOAD Example 3

(defmacro zoz (a b)
  `(format t "zoz: ~a, ~a!~%" ,a ,b))

(with-overload ((zoz +))
  (zoz 1 2))

;; >> zoz: 1, 2!
;; => NIL

;;; TODO: WITH-OVERLOAD Example 4

(macrolet ((hello (a b)
             `(format t "zoz: ~a, ~a!~%" ,a ,b)))
  (with-overload ((hello +))
    (hello 1 2)))

;; => 3