anchor.diff:             (app->cps form k ())))))
   
   ; (lambda (args...) (f args...)) => f
  +; but only for constant, builtin f
   (define (η-reduce form)
     (cond ((or (atom form) (constantp form)) form)
           ((and (eq (car form) 'lambda)
                 (let ((body (caddr form))
  -                    (args (cadr form)))
  +                    (args (cadr form))
  +                    (func (car (caddr form))))
                   (and (consp body)
  -                     (equal (cdr body) args))))
  +                     (equal (cdr body) args)
  +                     (constantp func))))
            (η-reduce (car (caddr form))))
           (T (map η-reduce form))))
   
  -; ((lambda (f) (f arg)) X) => (X arg)
  +(define (contains x form)
  +  (or (eq form x)
  +      (any (lambda (p) (contains x p)) form)))
  +
   (define (β-reduce form)
     (cond ((or (atom form) (constantp form)) form)
  +
  +        ; ((lambda (f) (f arg)) X) => (X arg)
           ((and (= (length form) 2)
                 (consp (car form))
                 (eq (caar form) 'lambda)
                 (let ((args (cadr (car form)))
                       (body (caddr (car form))))
  -                (and (= (length body) 2)
  +                (and (consp body)
  +                     (= (length body) 2)
                        (= (length args) 1)
                        (eq (car body) (car args))
                        (not (eq (cadr body) (car args)))
                        (symbolp (cadr body)))))
            `(,(β-reduce (cadr form))
              ,(cadr (caddr (car form)))))
  +
  +        ; (identity x) => x
  +        ((eq (car form) *top-k*)
  +         (β-reduce (cadr form)))
  +
  +        ; uncurry:
  +        ; ((lambda (p1) ((lambda (args...) body) exprs...)) s) =>
  +        ; ((lambda (p1 args...) body) s exprs...)
  +        ; where exprs... doesn't contain p1
  +        ((and (= (length form) 2)
  +              (consp (car form))
  +              (eq (caar form) 'lambda)
  +              (or (atom (cadr form)) (constantp (cadr form)))
  +              (let ((args (cadr (car form)))
  +                    (s (cadr form))
  +                    (body (β-reduce (caddr (car form)))))
  +                (and (= (length args) 1)
  +                     (consp body)
  +                     (consp (car body))
  +                     (eq (caar body) 'lambda)
  +                     (let ((innerargs (cadr (car body)))
  +                           (innerbody (caddr (car body)))
  +                           (params (cdr body)))
  +                       (and (not (contains (car args) params))
  +                            `((lambda ,(cons (car args) innerargs)
  +                                ,innerbody)
  +                              ,s
  +                              ,@params)))))))
  +
           (T (map β-reduce form))))
   
  -(defmacro with-delimited-continuations (exp) (cps exp))
  +(defmacro with-delimited-continuations code (cps (f-body code)))
   
   (defmacro defgenerator (name args . body)
     (let ((ko  (gensym))
  
positive.code:                `(let ((,g ,k))
                    ,(cps- form g)))))
  
            ((eq (car form) 'setq)
             (let ((var (cadr form))
                   (E   (caddr form)))
               (cps- E `(lambda (,g) (,k (setq ,var ,g))))))
  
            ((eq (car form) 'reset)
             `(,k ,(cps- (cadr form) 'identity)))
  
            ((eq (car form) 'shift)
             (let ((v (cadr form))
                   (E (caddr form)))
               `(let ((,v (lambda (ignored-k val) (,k val))))
                  ,(cps- E 'identity))))
  
            ((and (constantp (car form))
                  (builtinp (eval (car form))))
  
negative.code:   calls to calls to funcall/cc that does the right thing for both
    cc-lambdas and normal lambdas
  
  - handle dotted arglists in lambda
  
   here's an alternate way to transform a while loop:
  
   (let ((x 0))
     (while (< x 10)
       (progn (#.print x) (setq x (+ 1 x)))))
   =>
    (let ((x 0))
      (reset
       (let ((l nil))
         (let ((k (shift k (k k))))
           (if (< x 10)
               (progn (setq l (progn (#.print x)
                                     (setq x (+ 1 x))))
                      (k k))
             l)))))
  |#
  