(define primal cadr)

(define tangent caddr)

(define (bundle primal tangent) (list 'bundle primal tangent))

(define bundle?
 (let ((pair? pair?)) (lambda (x) (and (pair? x) (eq? (car x) 'bundle)))))

(define pair?
 (let ((pair? pair?)) (lambda (x) (and (pair? x) (not (bundle? x))))))

(define (lift-real x) (bundle x 0))

(define (lift-real->real f df/dx)
 (letrec ((self (lambda (x)
		 (if (bundle? x)
		     (bundle (self (primal x))
			     (* (df/dx (primal x)) (tangent x)))
		     (f x)))))
  self))

(define (lift-real*real->real f df/dx1 df/dx2)
 (letrec ((self
	   (lambda (x1 x2)
	    (if (bundle? x1)
		(if (bundle? x2)
		    (bundle
		     (self (primal x1) (primal x2))
		     (+ (* (df/dx1 (primal x1) (primal x2)) (tangent x1))
			(* (df/dx2 (primal x1) (primal x2)) (tangent x2))))
		    (self x1 (lift-real x2)))
		(if (bundle? x2) (self (lift-real x1) x2) (f x1 x2))))))
  self))

(define (lift-real->boolean f)
 (letrec ((self (lambda (x) (if (bundle? x) (self (primal x)) (f x)))))
  self))

(define (lift-real*real->boolean f)
 (letrec ((self (lambda (x1 x2)
		 (if (bundle? x1)
		     (if (bundle? x2)
			 (self (primal x1) (primal x2))
			 (self (primal x1) x2))
		     (if (bundle? x2) (self x1 (primal x2)) (f x1 x2))))))
  self))

(define + (lift-real*real->real + (lambda (x1 x2) 1) (lambda (x1 x2) 1)))

(define - (lift-real*real->real - (lambda (x1 x2) 1) (lambda (x1 x2) -1)))

(define * (lift-real*real->real * (lambda (x1 x2) x2) (lambda (x1 x2) x1)))

(define /
 (lift-real*real->real
  / (lambda (x1 x2) (/ 1 x2)) (lambda (x1 x2) (- 0 (/ x1 (* x2 x2))))))

(define sqrt (lift-real->real sqrt (lambda (x) (/ 1 (* 2 (sqrt x))))))

(define exp (lift-real->real exp (lambda (x) (exp x))))

(define log (lift-real->real log (lambda (x) (/ 1 x))))

(define sin (lift-real->real sin (lambda (x) (cos x))))

(define cos (lift-real->real cos (lambda (x) (- 0 (sin x)))))

(define atan (lift-real*real->real
	      atan
	      (lambda (x1 x2) (/ (- 0 x2) (+ (* x1 x1) (* x2 x2))))
	      (lambda (x1 x2) (/ x1 (+ (* x1 x1) (* x2 x2))))))

(define = (lift-real*real->boolean =))

(define < (lift-real*real->boolean <))

(define > (lift-real*real->boolean >))

(define <= (lift-real*real->boolean <=))

(define >= (lift-real*real->boolean >=))

(define zero? (lift-real->boolean zero?))

(define positive? (lift-real->boolean positive?))

(define negative? (lift-real->boolean negative?))

(define real? (lift-real->boolean real?))

(define (derivative f)
 (lambda (x) (let ((y (f (bundle x 1)))) (if (bundle? y) (tangent y) 0))))

((derivative (lambda (x) (* x ((derivative (lambda (y) (+ x y))) 1)))) 1)