Improving.hs

----------------------------------------------------------------------
-- |
-- Module      :  Data.Improving
-- Copyright   :  (c) Conal Elliott 2008
-- License     :  BSD3
-- 
-- Maintainer  :  conal@conal.net
-- Stability   :  experimental
-- 
-- Improving values -- efficient version
----------------------------------------------------------------------

module Data.Improving
  (
    Improving(..), minI
  ) where


import Data.Unamb (unamb,assuming)

{----------------------------------------------------------
    Improving values
----------------------------------------------------------}

-- | An improving value.
data Improving a = IV a (a -> Ordering)

-- | A known improving value (which doesn't really improve)
exactly :: Ord a => a -> Improving a
exactly a = IV a (compare a)

instance Eq a => Eq (Improving a) where
  IV a _ == IV b _ = a == b

instance Ord a => Ord (Improving a) where
  s `min` t = fst (s `minI` t)
  s  <=   t = snd (s `minI` t)

-- | Efficient combination of 'min' and '(<=)'
minI :: Ord a => Improving a -> Improving a -> (Improving a,Bool)
IV u uComp `minI` IV v vComp = (IV uMinV wComp, uLeqV)
 where
   uMinV = if uLeqV then u else v
   -- u <= v: Try @v `compare` u /= LT@ and @u `compare` v /= GT@.
   uLeqV = (vComp u /= LT) `unamb` (uComp v /= GT)
   -- (u `min` v) `compare` t: Try comparing according to whether u <= v,
   -- or go with either answer if they agree, e.g., if both say GT.
   minComp = if uLeqV then uComp else vComp
   wComp t = minComp t `unamb`
	     assuming (uCompT == vCompT) uCompT
    where
       uCompT = uComp t
       vCompT = vComp t