;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Extracted MACROP

(defun macrop (form env)
  (cond
    ((symbolp form)
     (let* ((local-match
              (find form (agnostic-lizard:metaenv-variable-like-entries env)
                    :key #'first))
            (local-content (second local-match)))
       (ecase (first local-content)
         (:plain
          nil)
         ((:macro :macro-from nil)
          t))
       (not (null (member (first local-content) '(:macro :macro-from nil))))))
    ((consp form)
     (let* ((local-match
              (find (first form)
                    (agnostic-lizard:metaenv-function-like-entries env)
                    :key #'first))
            (local-content (second local-match)))
       (ecase (first local-content)
         (:plain
          nil)
         ((:macro :macro-from :macro-function-code :macro-code)
          t)
         ((nil)
          (cond
            ;; A lambda expression.
            ((consp (first form))
             nil)
            ;; Not a macro.
            ((null (macro-function
                    (first form) (agnostic-lizard::metaenv-fallback-env env)))
             nil)
            ;; The fallback is the global environment anyway.
            ((null (agnostic-lizard::metaenv-fallback-env env))
             t)
            ;; No macro defined or an FLET shadows the macro.
            ((null (macro-function
                    (first form) (agnostic-lizard::metaenv-fallback-env env)))
             nil)
            ;; METAENV does not contain anything meaningful.
            ((agnostic-lizard::metaenv-irrelevant-for-macroexpand env)
             t)
            ;; The macro is from the global environment or defined inside the
            ;; walked fragment.
            ((eq (macro-function (first form) nil)
                 (macro-function
                  (first form) (agnostic-lizard::metaenv-fallback-env env)))
             t)
            ;; Policy says not to pass the fallback environment. Need to pull
            ;; the name into the environment used, otherwise the expansion won't
            ;; happen at all.
            ((agnostic-lizard::metaenv-never-pass-fallback-env env)
             t)
            ;; The macro is from a MACROLET reflected in the fallback
            ;; environment. Assume MACROEPAND calls inside the macro function
            ;; expect some other outside MACROLET to be in effect.
            (t
             t))))))
    (t
     nil)))

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

;;; DONE: What about implementing a macro expansion inhibiting code walker by
;;; replacing macro forms with something that is not walked, like QUOTE. The
;;; quoted expression could include the original form and an additional marker
;;; that could be used to later undo the changes.

;;; DONE: Before using MACROP we should check whether the form is a call to a
;;; special or a hardwired operator. This ties into the Agnostic Lizard issue
;;; regarding the relative ordering of checking for macros and checking for
;;; special or hardwired operators within METAENV-MACROEXPAND-ALL.

;;; DONE: We can't do the replacement within :ON-MACROEXPANDED-FORM because by
;;; that point Agnostic Lizard will already have attempted to macro expand the
;;; form. Regardless of discarding the expansions, we don't even want to attempt
;;; macro expansion because it might have side effects.

(defun special-or-hardwired-p (form)
  (and (consp form)
       (or (special-operator-p (car form))
           (and (find (car form) agnostic-lizard::*hardwired-operators*) t))))

(defmacro with-overload-3 (specs &body body &environment env)
  (let ((marker '#:with-overload-marker))
    (agnostic-lizard:walk-form
     `(progn ,@body)
     (make-instance 'agnostic-lizard:walker-metaenv :fallback-env env)
     :on-every-form-pre
     (lambda (f env)
       (if (and (consp f)
                (not (special-or-hardwired-p f))
                (macrop f env))
           `',(list marker f)
           f))
     :on-special-form
     (lambda (f env)
       (declare (ignore env))
       (if (and (eq (car f) 'quote)
                (consp (second f))
                (eq (first (second f)) marker))
           (second (second f))
           f))
     :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)))))