anchor.diff:  ;; }
   
   
  -(defparameter *nearest-continue* nil)
  -(defparameter *nearest-break* nil)
  -
  -
  -(defmethod transform ((xform (eql 'cps)) (elm while))
  +(defparameter *nearest-continue* nil
  +  "Name of the continue continuation function for the nearest enclosing loop")
  +(defparameter *nearest-break* nil
  +  "Name of the break continuation function for the nearest enclosing loop")
  +
  +(defmethod tx-cps ((elm while) statement-tail)
     (with-added-environment 
       (let* ((break-k (genvar "break"))
              (continue-k (genvar "continue"))
              (break-k-fn  (make-function-decl 
                            :name break-k
  -                         :body (consume-statement-tail (statement-tail) (transform xform statement-tail))))
  +                         :body (tx-cps statement-tail nil)))
              (*nearest-break* break-k)
              (*nearest-continue* continue-k))
  -      (awhen (source-element-label elm)
  -        (add-binding (concatenate 'string it "$break") break-k)
  -        (add-binding (concatenate 'string it "$continue") continue-k))
  -      (single-statement
  -       (make-function-decl :name continue-k :body (transform xform (statement-block-statements (while-body elm))))
  -       break-k-fn
  -       (make-resume-statement :target (make-identifier :name continue-k))))))
  -
  -(defmethod transform ((xform (eql 'cps)) (elm break-statement))
  +      (when-let (label (source-element-label elm))
  +        (add-binding (concatenate 'string label "$break") break-k)
  +        (add-binding (concatenate 'string label "$continue") continue-k))
  +      (values
  +       (single-statement
  +        (make-function-decl :name continue-k :body (tx-cps (statement-block-statements (while-body elm)) nil))
  +        break-k-fn
  +        (make-resume-statement :target (make-identifier :name continue-k)))
  +       t))))
  +
  +(defmethod tx-cps ((elm break-statement) statement-tail)
  +  (declare (ignore statement-tail))
     (let ((break-name (aif (break-statement-target-label elm)
                            (find-binding (concatenate 'string it "$break"))
                            *nearest-break*)))
  -    (make-resume-statement :target (make-identifier :name break-name))))
  -    
  -
  -(defmethod transform ((xform (eql 'cps)) (elm continue-statement))
  +    (values
  +     (make-resume-statement :target (make-identifier :name break-name))
  +     t)))
  +
  +(defmethod tx-cps ((elm continue-statement) statement-tail)
  +  (declare (ignore statement-tail))
     (let ((continue-name (aif (continue-statement-target-label elm)
                               (find-binding (concatenate 'string it "$continue"))
                               *nearest-continue*)))
  -    (make-resume-statement :target (make-identifier :name continue-name))))
  -
  -
  -
  -
  -
  -
  -
  +    (values
  +     (make-resume-statement :target (make-identifier :name continue-name))
  +     t)))
  +
  +
  +;;;================================================================================
  +;;;; default behaviour 
  +;;;
  +;;; We have to re-implement the default behaviour that is normally provided by the
  +;;; TRANSFORM generic function, since we are using a special generic function of
  +;;; our own.
  +
  +;; The default behaviour for any element is to do nothing
  +(defmethod tx-cps (elm statement-tail)
  +  (declare (ignore statement-tail))
  +  (values elm nil))
  +
  +(defun make-keyword (x)
  +  "Makes a keyword out of a symbol."
  +  (if (keywordp x)
  +    x
  +    (intern (symbol-name x) 'keyword)))
  +
  +(defmethod tx-cps ((elm source-element) statement-tail)
  +  (let ((consumed nil))
  +    (flet ((slot-tx (slot-elm)
  +             (if consumed
  +               (tx-cps slot-elm nil)
  +               (multiple-value-bind (new-arg slot-consumed)
  +                   (tx-cps slot-elm statement-tail)
  +                 (setf consumed slot-consumed)
  +                 new-arg))))
  +      (values
  +       (apply
  +        (get-constructor elm)
  +        (loop for slot in (structure-slots elm)
  +              collect (make-keyword slot)
  +              collect (slot-tx (slot-value elm slot))))
  +       consumed))))
  +
  +;; Special case for object-literals to account for the fact that object-literal-properties
  +;; is an alist rather than a list of structures.
  +(defmethod tx-cps ((elm object-literal) statement-tail)
  +  (let ((consumed nil))
  +    (flet ((slot-tx (slot-elm)
  +             (if consumed
  +               (tx-cps slot-elm nil)
  +               (multiple-value-bind (new-arg slot-consumed)
  +                   (tx-cps slot-elm statement-tail)
  +                 (setf consumed slot-consumed)
  +                 new-arg))))
  +      (values
  +       (make-object-literal :properties
  +                            (loop for (prop-name . prop-value) in (object-literal-properties elm)
  +                                  collect (cons (slot-tx prop-name)
  +                                                (slot-tx prop-value))))
  +       consumed))))
  
positive.code:              :and-equals :or-equals :xor-equals))))
  
  (defparameter *cont-name* "$k"
    "The name of the standard continuation parameter.  See SBCL-DEFPARAMETER-NOTE")
  
  (defparameter *cont-id* (make-identifier :name *cont-name*)
    "An identifier whose name is *cont-name*.  See SBCL-DEFPARAMETER-NOTE")
  
  ;;;; Runtime parameters 
  ;;; When we refer to runtime functions, we indirect through parameters to make it easy to
  ;;; factor the runtime (and also to save having to contantly type (MAKE-STRING-LITERAL ...))
  
  ;;;; Statement tails 
  ;;;
  
negative.code: ;;; Basically, the statement-tail contains all of the statements that should go into a continuation,
  ;;; should we need to generate a continuation at this point.
  ;;;
  
  ;;;================================================================================
  ;;;; TRANSFORM method
  ;;;
  ;;; As with the explicitization transformation, the cps transformation has a fairly
  ;;; complicated protocol, so the TRANSFORM method is just a thin wrapper over the
  ;;; TX-CPS generic function.
  
  (defmethod transform ((xform (eql 'cps)) elm)
    (values
     (tx-cps elm nil)))
      
  ;;;================================================================================
  ;;;; TX-CPS
  ;;;
  ;;; Previously we bound the *STATEMENT-TAIL* special variable in order to provide
  ;;; it to "downstream" functions, but now we pass it as a parameter.
  ;;;
  ;;; The first return value of the TX-CPS function is the transformed source element.
  ;;; The second return value indicates whether the statement-tail has been consumed
  ;;; or not.
  
  (defgeneric tx-cps (elm statement-tail)
    (:documentation
     "Converts ELM (which should be explicitized) into CPS form and returns the
      new version as its first return value.  The second return value is T if
      STATEMENT-TAIL was consumed or NIL otherwise."))
  
  (defmethod tx-cps ((elm function-decl) statement-tail)
    (declare (ignore statement-tail))
    ;; The body has an empty return statement appended if not every control path
    ;; has an explicit return.
    (let ((body (if (explicit-return-p (function-decl-body elm))
                  (function-decl-body elm)
                  (postpend (function-decl-body elm) #s(return-statement)))))
      (values
       (make-function-decl :name (function-decl-name elm)
                           :parameters (cons *cont-name* (function-decl-parameters elm))
                           :body (in-local-scope
                                   (tx-cps body nil))) ; Each function starts with a fresh statement-tail
       nil)))
  
  (defmethod tx-cps ((elm function-expression) statement-tail)
    (declare (ignore statement-tail))
    ;; The body has an empty return statement appended if not every control path
    ;; has an explicit return.
    (let ((new-parameters (cons *cont-name* (function-expression-parameters elm)))
          (body (if (explicit-return-p (function-expression-body elm))
                  (function-expression-body elm)
                  (postpend (function-expression-body elm) #s(return-statement)))))
      (values
       (make-function-expression :name (function-expression-name elm)
                                  :parameters new-parameters
                                  :body (in-local-scope
                                          (tx-cps body nil))) ; Each function starts with a fresh statement-tail
       nil)))
  
  (defmethod tx-cps ((elm return-statement) statement-tail)
    (with-slots (arg) elm
      (let ((new-fn-call
             (if (fn-call-p arg)
               ;; Tail call
               (make-fn-call :fn (fn-call-fn arg)
                             :args (cons *cont-id*
                                         (mapcar (lambda (item)
                                                   (tx-cps item nil))
                                                 (fn-call-args arg))))
               ;; Simple return
               (make-fn-call :fn *cont-id*
                             :args (unless (null (return-statement-arg elm))
                                     (list (tx-cps (return-statement-arg elm) nil)))))))
        (values
         (make-return-statement :arg new-fn-call)
         nil))))
        
  
  (defun make-void-continuation (current-cont)
    "Returns a function expression that accepts an argument (which it ignores),
  