{-# OPTIONS -fno-implicit-prelude #-}
module Algebra.Real (
   C(abs, signum),
   ) where

import qualified Algebra.Ring         as Ring
import qualified Algebra.Additive     as Additive
import qualified Algebra.ZeroTestable as ZeroTestable

import Algebra.Ring (one, ) -- fromInteger
import Algebra.Additive (zero, negate,)

import PreludeBase
import Prelude(Int,Integer,Float,Double)


{- |
This is the type class of an ordered ring, satisfying the laws

>              a * b === b * a
>      a + (max b c) === max (a+b) (a+c)
>   negate (max b c) === min (negate b) (negate c)
>      a * (max b c) === max (a*b) (a*c) where a >= 0

Note that abs is in a rather different place than it is in the Haskell
98 Prelude.  In particular,

>   abs :: Complex -> Complex

is not defined.  To me, this seems to have the wrong type anyway;
Complex.magnitude has the correct type.
-}
class (Ring.C a, ZeroTestable.C a, Ord a) => C a where
    abs    :: a -> a
    signum :: a -> a

      -- Minimal definition: nothing
    abs x    = max x (negate x)
    signum x = case compare x zero of
                 GT ->        one
                 EQ ->        zero
                 LT -> negate one


instance C Integer
instance C Int
instance C Float
instance C Double