;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; WITH-OVERLOAD
;;;
;;; Syntactically replaces usages of the specified operators with their
;;; replacements. By syntactically we mean two things:
;;;
;;; 1) The package of the symbol being replaced doesn't matter, only its name.
;;;
;;; 2) The replacement is done within *sublexical scope* (Let Over Lambda's
;;; terminology). This means that any macros used within BODY (whether
;;; introduced in the global scope, the outer lexical scope or within BODY
;;; itself) are not expanded. Therefore, any usage of the specified operator
;;; within those macros is unaffected.
;;;
;;; SPECS is of the form ({(<op> <replacement>)}*). Every symbol <sym> in the
;;; operator position of a form within BODY that satisfies (string-equal <sym>
;;; <op>), where <op> is one of the specified operators, is replaced with the
;;; corresponding <replacement>.
;;;
;;; TODO: Currently, bodies of MACROLETs within the inner lexical scope are
;;; unaffected by the replacement. This is because Agnostic Lizard doesn't walk
;;; them (and it should, I think).

(defmacro with-overload (specs &body body)
  (let ((last-form nil))
    (agnostic-lizard:walk-form
     `(progn ,@body) nil
     :on-every-form-pre
     (lambda (f env)
       (declare (ignore env))
       (setf last-form f))
     :on-macroexpanded-form
     (lambda (f env)
       (declare (ignore f env))
       last-form)
     :on-function-form
     (lambda (f env)
       (declare (ignore env))
       (if (consp f)
           (let ((rep (find (car f) specs :key #'first
                                          :test #'string-equal)))
             (if rep
                 (cons (second rep) (cdr f))
                 f))
           f)))))

;;; WITH-OVERLOAD Example 1

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

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

;;; ->
;;; (values
;;;  (multiple-value-list
;;;   (values (+ 2 2)
;;;           (+ (+ (+ 0 1) 2) 3)))
;;;  (multiple-value-list
;;;   (progn (values (- 2 2) (- (- (- 0 1) 2) 3)))))
;;;
;;; => (4 6), (0 -6)

;;; WITH-OVERLOAD Example 3

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

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

;;; -> (progn (+ 1 2))
;;;
;;; => 3
;;;
;;; Global macros aren't expanded.

;;; WITH-OVERLOAD Example 4

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

;;; ->
;;; (macrolet ((zoz (a b)
;;;              `(format t "zoz: ~a, ~a!~%" ,a ,b)))
;;;   (progn (+ 1 2)))
;;;
;;; => 3
;;;
;;; MACROLETs from the outer lexical scope aren't expanded.

;;; WITH-OVERLOAD Example 5

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

;;; ->
;;; (progn
;;;   (macrolet ((zoz (a b)
;;;                `(format t "zoz: ~a, ~a!~%" ,a ,b)))
;;;     (+ 1 2)))
;;;
;;; => 3
;;;
;;; MACROLETs from the inner lexical scope aren't expanded.

;;; WITH-OVERLOAD Example 6

(with-overload ((+ -))
  (macrolet ((zoz (a b)
               `(list (* ,a ,b) ,(+ 1 2))))
    (values
     (zoz 1 2)
     (+ 1 2))))

;;; ->
;;; (progn
;;;   (macrolet ((zoz (a b)
;;;                `(list (* ,a ,b) ,(+ 1 2))))
;;;     (values (zoz 1 2) (- 1 2))))
;;;
;;; => (2 3), -1
;;;
;;; Usages of the operator within MACROLET bodies aren't replaced.