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:                      (loop (+ 1 i))))))
     lo))
  
  T
  
  #|
  
negative.code:                `(let ((,g ,k))
                    ,(cps- form g)))))
  
            ((eq (car form) 'and)
             (cond ((atom (cdr  form)) `(,k T))
                   ((atom (cddr form)) (cps- (cadr form) k))
                   (T
                    (if (atom k)
                        (cps- (cadr form)
                              `(lambda (,g)
                                 (if ,g ,(cps- `(and ,@(cddr form)) k)
                                   (,k ,g))))
                      `(let ((,g ,k))
                         ,(cps- form g))))))
  
            ((eq (car form) 'or)
             (cond ((atom (cdr  form)) `(,k ()))
                   ((atom (cddr form)) (cps- (cadr form) k))
                   (T
                    (if (atom k)
                        (cps- (cadr form)
                              `(lambda (,g)
                                 (if ,g (,k ,g)
                                   ,(cps- `(or ,@(cddr form)) k))))
                      `(let ((,g ,k))
                         ,(cps- form g))))))
  
            ((eq (car form) 'while)
             (let ((test (cadr form))
                   (body (caddr form))
                   (lastval (gensym)))
               (cps- (macroexpand
                      `(let ((,lastval nil))
                         ((label ,g (lambda ()
                                      (if ,test
                                          (progn (setq ,lastval ,body)
                                                 (,g))
                                        ,lastval))))))
                     k)))
  
            ((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) *top-k*)))
  
            ((eq (car form) 'shift)
             (let ((v (cadr form))
                   (E (caddr form))
                   (val (gensym)))
               `(let ((,v (lambda (,g ,val) (,g (,k ,val)))))
                  ,(cps- E *top-k*))))
  
            ((and (constantp (car form))
                  (builtinp (eval (car form))))
  