module Feldspar.Core.Functions.Ord where

import qualified Prelude
import Data.Int
import Data.Word

import Feldspar.Prelude
import Feldspar.Range
import Feldspar.Core.Types
import Feldspar.Core.Representation
import Feldspar.Core.Constructs
import Feldspar.Core.Functions.Eq

infix 4 <
infix 4 >
infix 4 <=
infix 4 >=

-- | Redefinition of the standard 'Prelude.Ord' class for Feldspar
class (Eq a, Prelude.Ord a) => Ord a where
  (<)  :: Data a -> Data a -> Data Bool
  (<)  =  defaultLT
  (>)  :: Data a -> Data a -> Data Bool
  (>)  =  defaultGT

  (<=) :: Data a -> Data a -> Data Bool
  (<=) =  defaultLTE
  (>=) :: Data a -> Data a -> Data Bool
  (>=) =  defaultGTE

  min :: Data a -> Data a -> Data a
  min a b = a<b ? (a,b)
  max :: Data a -> Data a -> Data a
  max a b = a>b ? (a,b)

defaultLT a b
    | a Prelude.== b = false
    | otherwise      = function2 "(<)" fullProp (Prelude.<) a b

defaultGT a b
    | a Prelude.== b = false
    | otherwise      = function2 "(>)" fullProp (Prelude.>) a b

defaultLTE a b
    | a Prelude.== b = true
    | otherwise      = function2 "(<=)" fullProp (Prelude.<=) a b

defaultGTE a b
    | a Prelude.== b = true
    | otherwise      = function2 "(>=)" fullProp (Prelude.>=) a b

optLT :: (Ord a, BoundedInt b, Size a ~ Range b) =>
         Data a -> Data a -> Data Bool
optLT a b
    | a Prelude.== b      = false
    | sa `rangeLess`   sb = true
    | sb `rangeLessEq` sa = false
    | otherwise           = defaultLT a b
    where
      sa = dataSize a
      sb = dataSize b

optGT :: (Ord a, BoundedInt b, Size a ~ Range b) =>
         Data a -> Data a -> Data Bool
optGT a b
    | a Prelude.== b      = false
    | sb `rangeLess`   sa = true
    | sa `rangeLessEq` sb = false
    | otherwise           = defaultGT a b
    where
      sa = dataSize a
      sb = dataSize b

optLTE :: (Ord a, BoundedInt b, Size a ~ Range b) =>
          Data a -> Data a -> Data Bool
optLTE a b
    | a Prelude.== b      = true
    | sa `rangeLessEq` sb = true
    | sb `rangeLess`   sa = false
    | otherwise           = defaultLTE a b
    where
      sa = dataSize a
      sb = dataSize b

optGTE :: (Ord a, BoundedInt b, Size a ~ Range b) =>
          Data a -> Data a -> Data Bool
optGTE a b
    | a Prelude.== b      = true
    | sb `rangeLessEq` sa = true
    | sa `rangeLess`   sb = false
    | otherwise           = defaultGTE a b
    where
      sa = dataSize a
      sb = dataSize b

optMin :: (Ord a, BoundedInt b, Size a ~ Range b) => Data a -> Data a -> Data a
optMin a b = cap (rangeMin ra rb) $
    case viewLiteral cond1 of
      Just _ -> cond1 ? (a,b)
      _      -> cond2 ? (b,a)
  where
    cond1 = a<b
    cond2 = b<a
    ra    = dataSize a
    rb    = dataSize b

optMax :: (Ord a, BoundedInt b, Size a ~ Range b) => Data a -> Data a -> Data a
optMax a b = cap (rangeMax ra rb) $
    case viewLiteral cond1 of
      Just _ -> cond1 ? (a,b)
      _      -> cond2 ? (b,a)
  where
    cond1 = a>b
    cond2 = b>a
    ra    = dataSize a
    rb    = dataSize b

instance Ord ()
instance Ord Bool
instance Ord Float

instance Ord Word8 where
  (<)  = optLT
  (>)  = optGT
  (<=) = optLTE
  (>=) = optGTE
  min  = optMin
  max  = optMax

instance Ord Int8 where
  (<)  = optLT
  (>)  = optGT
  (<=) = optLTE
  (>=) = optGTE
  min  = optMin
  max  = optMax

instance Ord Word16 where
  (<)  = optLT
  (>)  = optGT
  (<=) = optLTE
  (>=) = optGTE
  min  = optMin
  max  = optMax

instance Ord Int16 where
  (<)  = optLT
  (>)  = optGT
  (<=) = optLTE
  (>=) = optGTE
  min  = optMin
  max  = optMax

instance Ord Word32 where
  (<)  = optLT
  (>)  = optGT
  (<=) = optLTE
  (>=) = optGTE
  min  = optMin
  max  = optMax

instance Ord Int32 where
  (<)  = optLT
  (>)  = optGT
  (<=) = optLTE
  (>=) = optGTE
  min  = optMin
  max  = optMax

instance Ord DefaultWord where
  (<)  = optLT
  (>)  = optGT
  (<=) = optLTE
  (>=) = optGTE
  min  = optMin
  max  = optMax

instance Ord DefaultInt where
  (<)  = optLT
  (>)  = optGT
  (<=) = optLTE
  (>=) = optGTE
  min  = optMin
  max  = optMax