anchor.diff:                     `((funcall ,after  ,@lambda))))))))
   
   
  -(defmacro unadvise (name &environment env)
  -  (declare (ignore env))
  +(defmacro unadvise-macro (name &environment env)
  +  (declare (ignore env)) ;; FIXME
     (let ((%name (gensym "%name-"))
           (%adv (gensym "%adv-"))
  -        (%undef (gensym "%undef-"))
  -        )
  +        (%fn (gensym "%fn-")))
       `(let* ((,%name (quote ,name))
  -            (,%undef (gensym "%_%undef"))
  -            (,%adv (gethash ,%name %advise% ,%undef)))
  -       (cond
  -         ((eq ,%adv ,%undef)
  -          (warn "~S not advised" ,%name))
  -         (t
  -          (remhash ,%name %advise%)
  -          (let ((,%adv (eval ,%adv)))
  -            (setf (macro-function ,%name) ,%adv)
  -            (compile ,%name ,%adv)))
  -         ))))
  +            (,%adv (unregister-advise ,%name))
  +            (,%fn (advised-original-function ,%adv)))
  +       (setf (macro-function ,%name) ,%fn)
  +       (compile ,%name ,%fn)
  +       (values ,%fn))))
   
   #|
   
  
positive.code:     `(let* ((,%name (quote ,name))
              (,%env ,env)
              (,%form
               (function-lambda-expression (macro-function ,%name ,%env))))
  
         ;; FIXME: store ,%FORM on hash of (,%NAME ,%ENV)
         (setf (gethash ,%name  %advise%)
               ,%form)
             
         (defmacro ,name ,lambda
           ,@(when before
  
negative.code: 
  (in-package #:cl-user)
  
  (deftype function-name ()
    '(or symbol (cons symbol t)))
  
  ;; trivial portable prototype of an 'advise' interface
  
  (defstruct (advise-record
               (:conc-name #:advised-)
               (:constructor
                make-advise-record (name original-function)))
    (original-function
     #'(lambda ()
         (error "Default advised-original-function"))
     :type function)
    ;; FIXME: add slot ENV
    (name #:unmamed
          :type function-name))
  
  (defconstant %advise-expand% 8)
  
  (defvar %advise-rec%
    (make-array %advise-expand%
                :element-type 'advise-record
                :adjustable t
                :fill-pointer 0))
  
  (defun get-advise (name &optional (errorp t))
    (declare (type function-name name)
             #+NIL (values (or null advise-record)
                           (or null array-dimension-designator)))
    ;; FIXME: lock %ADVISE-REC% (READ, NON-RECURSIVE) in this function
    (labels ((test (a b)
               (etypecase a
                 (symbol (and (symbolp b)
                              (eq a b)))
                 (cons (and (consp b)
                            (test (car a) (car b))
                            (test (cdr a) (cdr b)))))))
      ;; (test '(a a) '(a b)) ;; => NIL
      ;; (test '(a a) '(a a)) ;; => T
      ;; (test '(a a a) '(a a b)) ;; => NIL
      ;; (test '(a a b) '(a a b)) ;; => T
      (let ((n (position name %advise-rec%
                         :key #'advised-name
                         :test (etypecase name
                                 (symbol #'eq)
                                 (cons #'test)))))
        (cond
          (n (values (aref %advise-rec% n) n))
          (errorp (error "ADVISE-RECORD NOT FOUND: ~S" name))
          (t (values nil nil))))))
  
  (defun register-advise (name form)
    ;; FIXME: lock %ADVISE-REC% (WRITE) in this function
    (multiple-value-bind (adv n)
        (get-advise name nil)
      (declare (ignore n))
      (cond
        ((and adv (not (eq form (advised-original-function adv))))
         (error "ALREAY ADVISED: ~S => ~S" name adv))
        (t (let ((adv (make-advise-record name form)))
             (vector-push-extend adv %advise-rec% %advise-expand%)
             (values adv))))))
  
  (defun unregister-advise (name)
    ;; FIXME: lock %ADVISE-REC% (WRITE) in this function
    (multiple-value-bind (adv n)
        (get-advise name nil)
      (cond
        (adv
         (delete adv %advise-rec% :test #'eq)
         (values adv))
        (t (error "NOT ADVISED: ~S" name)))))
  
  
    
  
  (defmacro defadvise-macro (name lambda &key before after &environment env)
    ;; FIXME: This does not destructure LAMBDA for the BEFORE, AFTER functions,
  