(define (make-interval a b) (cons a b))

(define (lower-bound i) (car i))

(define (upper-bound i) (cdr i))

(define (mul-interval x y)
  (let ((x1 (lower-bound x))
        (x2 (upper-bound x))
        (y1 (lower-bound y))
        (y2 (upper-bound y))
        (x1-neg (> 0 (lower-bound x)))
        (x1-pos (<= 0 (lower-bound x)))
        (x2-neg (> 0 (upper-bound x)))
        (x2-pos (<= 0 (upper-bound x)))
        (y1-neg (> 0 (lower-bound y)))
        (y1-pos (<= 0 (lower-bound y)))
        (y2-neg (> 0 (upper-bound y)))
        (y2-pos (<= 0 (upper-bound y))))
    (cond ((and x1-neg x2-neg y1-neg y2-neg)
           (make-interval (* x2 y2) (* x1 y1)))
          ((and x1-neg x2-neg y1-neg y2-pos)
           (make-interval (* x1 y2) (* x1 y1)))
          ((and x1-neg x2-neg y1-pos y2-pos)
           (make-interval (* x1 y2) (* x2 y1)))
          ((and x1-neg x2-pos y1-neg y2-neg)
           (make-interval (* x2 y1) (* x1 y2)))
          ((and x1-neg x2-pos y1-pos y2-pos)
           (make-interval (* x1 y2) (* x2 y2)))
          ((and x1-pos x2-pos y1-neg y2-neg)
           (make-interval (* x2 y1) (* x1 y2)))
          ((and x1-pos x2-pos y1-neg y2-pos)
           (make-interval (* x2 y1) (* x2 y2)))
          ((and x1-pos x2-pos y1-pos y2-pos)
           (make-interval (* x1 y1) (* x2 y2)))
          ((and x1-neg x2-pos y1-neg y2-pos)
           (let ((p1 (* x1 y1))
                 (p2 (* x1 y2))
                 (p3 (* x2 y1))
                 (p4 (* x2 y2)))
             (make-interval (min p1 p2 p3 p4)
                            (max p1 p2 p3 p4))))
          (else 0))))
