let mult i j =
  if is_empty i || is_empty j then
    mk_empty
  else
    match d_singleton i, d_singleton j with
      | Some(q), Some(p) ->
          mk_singleton (Q.mult q p)
      | Some(q), None -> 
          multq q j
      | None, Some(p) -> 
          multq p i
      | None, None -> 
          let d = Dom.union i.dom j.dom in
          let (lo, hi) =     (*[min(i.lo*j.lo,i.lo*j.hi,i.hi*j.lo,i.hi*j.hi), max(...)]*)
            match i.lo, i.hi, j.lo, j.hi with
              | None, None, _, _ ->  (* [(-inf,inf) * j = (-inf, inf)] *)
                  (None, None)
              | _, _, None, None ->  (* [i * (-inf,inf) = (-inf, inf)] *)
                  (None, None)
              | None, Some(q, alpha), None, Some(p, beta) -> (* [(-inf,q}*(-inf,p} = {q*p,inf) if q,p<=0 *)
                  if Q.le q Q.zero && Q.le p Q.zero then
                    (Some(alpha && beta, Q.mult q p), None)
                  else 
                    (None, None)
              | Some(alpha1,q1), None, Some(alpha2,q2), None ->
                  if Q.ge q1 Q.zero && Q.ge q2 Q.zero then (* {q1,inf)*{q2,inf)={q1*q2,inf) if q1,q2>=0 *)
                    (Some(alpha1 && alpha2, Q.mult q1 q2), None)
                  else 
                    (None, None)
              | None, Some(p, beta), Some(alpha, q), None -> (* [(-inf,p}*{q,inf) = (-inf,q*p} if p<=0<=q*)
                  if Q.le p Q.zero && Q.le Q.zero p then
                    (None, Some(Q.mult q p, alpha && beta))
                  else 
                    (None, None)
              | Some(alpha, q), None, None, Some(p, beta) -> (* [{q,inf)*(-inf,p} =(-inf,q*p} if p<=0<=q*)
                  if Q.le p Q.zero && Q.le Q.zero p then
                    (None, Some(Q.mult q p, alpha && beta))
                  else 
                    (None, None)
              | Some(alpha1, q1), Some(p1, beta1), Some(alpha2, q2), Some(p2, beta2) ->
                  (None, None)
              | _ ->  (* to do *)
                  (None, None)
          in
            make (d, lo, hi)