anchor.diff:          (apply #'kontinue (first arguments) (cdr arguments)))
         (arguments func) '()
         env))
  +
  +    ((and (eql 'call-next-method (operator func))
  +	  (second (multiple-value-list (lookup env :next-method t))))
  +     (aif (lookup env :next-method t)
  +	  (evaluate-arguments-then-apply
  +	   (lambda (arguments)
  +	     (apply-lambda/cc it arguments k))
  +	   (arguments func) '() env)
  +	  (error "no next method")))
  +
  +    ((and (eql 'next-method-p (operator func))
  +	  (second (multiple-value-list (lookup env :next-method t))))
  +     (kontinue k (lookup env :next-method t)))
       
       ((eql 'funcall (operator func))
        (evaluate-funcall/cc (arguments func) env k))
  
positive.code:     ;; remaining-parameters have been modified)
      (dolist (parameter remaining-parameters)
        (typecase parameter
          (optional-function-argument-form
           (if remaining-arguments
               (progn
                 (setf env (register env :let (name parameter) (pop remaining-arguments)))
  
negative.code:        (declare (ignorable ,@(extract-argument-names arguments :allow-specializers nil)))
         (error "Sorry, /CC function are not callable outside of with-call/cc."))))
  
  ; for emacs:  (setf (get 'defmethod/cc 'common-lisp-indent-function) 'lisp-indent-defmethod)
  
  (defmacro defmethod/cc (name &rest args)
    (let ((qlist (if (symbolp (car args))
  		   (prog1 
  		       (list (car args))
  		     (setf args (cdr args))))))
      (destructuring-bind (arguments &body body) args
        `(progn
  	 (setf (get ',name 'defmethod/cc) t)
  	 (defmethod ,name ,@qlist ,arguments
  	   (declare (ignorable ,@(extract-argument-names arguments :allow-specializers t)))
  	   (make-instance 'closure/cc
  			  :code (walk-form '(lambda ,(extract-argument-names arguments :allow-specializers t
  									     :keep-lambda-keywords t)
  					     ,@body)
  					   nil nil)
  			  :env nil))))))
  
  
  (defmacro defgeneric/cc (name args &rest options)
    "Trivial wrapper around defgeneric designed to alert readers that these methods are cc methods."
    `(defgeneric ,name ,args ,@options))
  
  
  (defun closure-with-nextmethod (closure next)
    (make-instance 'closure/cc 
  		 :code (code closure)
  		 :env (register (env closure) :next-method t next)))
  
  (defun closure-with-befores (closure befores)
    (make-instance 'closure/cc 
  		 :code (walk-form `(lambda (&rest args)
  				     ,@(loop 
  					  for before in befores
  					  collect `(apply ,before args))
  				     (apply ,closure args)))
  		 :env nil))
  
  (defun closure-with-afters (closure afters)
    (make-instance 'closure/cc 
  		 :code (walk-form `(lambda (&rest args)
  				     (prog1 
  					 (apply ,closure args)
  				       ,@(loop 
  					    for after in afters
  					    collect `(apply ,after args)))))
  		 :env nil))
  
  (define-method-combination cc-standard
      (&key (around-order :most-specific-first)
            (before-order :most-specific-first)
            (primary-order :most-specific-first)
            (after-order :most-specific-last))
    ((around (:around))
     (before (:before))
     (primary () :required t)
     (after (:after)))
    
    (labels ((effective-order (methods order)
               (ecase order
                 (:most-specific-first methods)
                 (:most-specific-last (reverse methods))))
  	   (primary-wrap (methods &optional nextmethod)
  	     (case (length methods)
  	       (1 `(closure-with-nextmethod 
  		    (call-method ,(first methods))
  		    ,nextmethod))
  	       (t `(closure-with-nextmethod 
  		    (call-method ,(first methods))
  		    ,(primary-wrap (cdr methods) nextmethod)))))
  	   (call-methods (methods)
  	     `(list ,@(loop 
  			 for m in methods
  			 collect `(call-method ,m)))))
      (let* (;; reorder the methods based on the -order arguments
             (around  (effective-order around around-order))
             (before  (effective-order before before-order))
             (primary (effective-order primary primary-order))
             (after   (effective-order after after-order))
             (form    (primary-wrap primary)))
        (when after 
  	(setf form `(closure-with-afters ,form ,(call-methods after))))
        (when before 
  	(setf form `(closure-with-befores ,form ,(call-methods before))))
        (when around
  	(setf form (primary-wrap around form)))
        form)))
  
  
  
  
  ;; Copyright (c) 2002-2005, Edward Marco Baringer
  ;; All rights reserved. 
  