-;;; NESTED-WALK-FORM provides an interface that allows nested macros, each
-;;; of which must walk their body, to just do one walk of the body of the
-;;; inner macro. That inner walk is done with a walk function which is the
-;;; composition of the two walk functions.
-;;;
-;;; This facility works by having the walker annotate the environment that
-;;; it passes to MACROEXPAND-1 to know which form is being macroexpanded.
-;;; If then the &WHOLE argument to the macroexpansion function is eq to
-;;; the ENV-WALK-FORM of the environment, NESTED-WALK-FORM can be certain
-;;; that there are no intervening layers and that a nested walk is OK.
-;;;
-;;; KLUDGE: There are some semantic problems with this facility. In particular,
-;;; if the outer walk function returns T as its WALK-NO-MORE-P value, this will
-;;; prevent the inner walk function from getting a chance to walk the subforms
-;;; of the form. This is almost never what you want, since it destroys the
-;;; equivalence between this NESTED-WALK-FORM function and two separate
-;;; WALK-FORMs.
-(defun nested-walk-form (whole form
- &optional environment
- (walk-function
- #'(lambda (subform context env)
- (declare (ignore context env))
- subform)))
- (if (eq whole (env-walk-form environment))
- (let ((outer-walk-function (env-walk-function environment)))
- (throw whole
- (walk-form
- form
- environment
- #'(lambda (f c e)
- ;; First loop to make sure the inner walk function
- ;; has done all it wants to do with this form.
- ;; Basically, what we are doing here is providing
- ;; the same contract walk-form-internal normally
- ;; provides to the inner walk function.
- (let ((inner-result nil)
- (inner-no-more-p nil)
- (outer-result nil)
- (outer-no-more-p nil))
- (loop
- (multiple-value-setq (inner-result inner-no-more-p)
- (funcall walk-function f c e))
- (cond (inner-no-more-p (return))
- ((not (eq inner-result f)))
- ((not (consp inner-result)) (return))
- ((get-walker-template (car inner-result)) (return))
- (t
- (multiple-value-bind (expansion macrop)
- (walker-environment-bind
- (new-env e :walk-form inner-result)
- (macroexpand-1 inner-result new-env))
- (if macrop
- (setq inner-result expansion)
- (return)))))
- (setq f inner-result))
- (multiple-value-setq (outer-result outer-no-more-p)
- (funcall outer-walk-function
- inner-result
- c
- e))
- (values outer-result
- (and inner-no-more-p outer-no-more-p)))))))
- (walk-form form environment walk-function)))
-
-;;; WALK-FORM-INTERNAL is the main driving function for the code walker. It
-;;; takes a form and the current context and walks the form calling itself or
-;;; the appropriate template recursively.