module GHC.Classes where
import GHC.Bool
import GHC.Integer
import GHC.Magic ()
import GHC.Ordering
import GHC.Prim
import GHC.Tuple
import GHC.Types
import GHC.Unit
infix 4 ==, /=, <, <=, >=, >
infixr 3 &&
infixr 2 ||
default ()
class Eq a where
(==), (/=) :: a -> a -> Bool
x /= y = not (x == y)
x == y = not (x /= y)
deriving instance Eq ()
deriving instance (Eq a, Eq b) => Eq (a, b)
deriving instance (Eq a, Eq b, Eq c) => Eq (a, b, c)
deriving instance (Eq a, Eq b, Eq c, Eq d) => Eq (a, b, c, d)
deriving instance (Eq a, Eq b, Eq c, Eq d, Eq e) => Eq (a, b, c, d, e)
deriving instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f)
=> Eq (a, b, c, d, e, f)
deriving instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g)
=> Eq (a, b, c, d, e, f, g)
deriving instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g,
Eq h)
=> Eq (a, b, c, d, e, f, g, h)
deriving instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g,
Eq h, Eq i)
=> Eq (a, b, c, d, e, f, g, h, i)
deriving instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g,
Eq h, Eq i, Eq j)
=> Eq (a, b, c, d, e, f, g, h, i, j)
deriving instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g,
Eq h, Eq i, Eq j, Eq k)
=> Eq (a, b, c, d, e, f, g, h, i, j, k)
deriving instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g,
Eq h, Eq i, Eq j, Eq k, Eq l)
=> Eq (a, b, c, d, e, f, g, h, i, j, k, l)
deriving instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g,
Eq h, Eq i, Eq j, Eq k, Eq l, Eq m)
=> Eq (a, b, c, d, e, f, g, h, i, j, k, l, m)
deriving instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g,
Eq h, Eq i, Eq j, Eq k, Eq l, Eq m, Eq n)
=> Eq (a, b, c, d, e, f, g, h, i, j, k, l, m, n)
deriving instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g,
Eq h, Eq i, Eq j, Eq k, Eq l, Eq m, Eq n, Eq o)
=> Eq (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)
instance (Eq a) => Eq [a] where
[] == [] = True
(x:xs) == (y:ys) = x == y && xs == ys
_xs == _ys = False
deriving instance Eq Bool
deriving instance Eq Ordering
instance Eq Char where
(C# c1) == (C# c2) = c1 `eqChar#` c2
(C# c1) /= (C# c2) = c1 `neChar#` c2
instance Eq Integer where
(==) = eqInteger
(/=) = neqInteger
instance Eq Float where
(F# x) == (F# y) = x `eqFloat#` y
instance Eq Double where
(D# x) == (D# y) = x ==## y
class (Eq a) => Ord a where
compare :: a -> a -> Ordering
(<), (<=), (>), (>=) :: a -> a -> Bool
max, min :: a -> a -> a
compare x y = if x == y then EQ
else if x <= y then LT
else GT
x < y = case compare x y of { LT -> True; _ -> False }
x <= y = case compare x y of { GT -> False; _ -> True }
x > y = case compare x y of { GT -> True; _ -> False }
x >= y = case compare x y of { LT -> False; _ -> True }
max x y = if x <= y then y else x
min x y = if x <= y then x else y
deriving instance Ord ()
deriving instance (Ord a, Ord b) => Ord (a, b)
deriving instance (Ord a, Ord b, Ord c) => Ord (a, b, c)
deriving instance (Ord a, Ord b, Ord c, Ord d) => Ord (a, b, c, d)
deriving instance (Ord a, Ord b, Ord c, Ord d, Ord e) => Ord (a, b, c, d, e)
deriving instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f)
=> Ord (a, b, c, d, e, f)
deriving instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g)
=> Ord (a, b, c, d, e, f, g)
deriving instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g,
Ord h)
=> Ord (a, b, c, d, e, f, g, h)
deriving instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g,
Ord h, Ord i)
=> Ord (a, b, c, d, e, f, g, h, i)
deriving instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g,
Ord h, Ord i, Ord j)
=> Ord (a, b, c, d, e, f, g, h, i, j)
deriving instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g,
Ord h, Ord i, Ord j, Ord k)
=> Ord (a, b, c, d, e, f, g, h, i, j, k)
deriving instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g,
Ord h, Ord i, Ord j, Ord k, Ord l)
=> Ord (a, b, c, d, e, f, g, h, i, j, k, l)
deriving instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g,
Ord h, Ord i, Ord j, Ord k, Ord l, Ord m)
=> Ord (a, b, c, d, e, f, g, h, i, j, k, l, m)
deriving instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g,
Ord h, Ord i, Ord j, Ord k, Ord l, Ord m, Ord n)
=> Ord (a, b, c, d, e, f, g, h, i, j, k, l, m, n)
deriving instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g,
Ord h, Ord i, Ord j, Ord k, Ord l, Ord m, Ord n, Ord o)
=> Ord (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)
instance (Ord a) => Ord [a] where
compare [] [] = EQ
compare [] (_:_) = LT
compare (_:_) [] = GT
compare (x:xs) (y:ys) = case compare x y of
EQ -> compare xs ys
other -> other
deriving instance Ord Bool
deriving instance Ord Ordering
instance Ord Char where
(C# c1) > (C# c2) = c1 `gtChar#` c2
(C# c1) >= (C# c2) = c1 `geChar#` c2
(C# c1) <= (C# c2) = c1 `leChar#` c2
(C# c1) < (C# c2) = c1 `ltChar#` c2
instance Ord Integer where
(<=) = leInteger
(>) = gtInteger
(<) = ltInteger
(>=) = geInteger
compare = compareInteger
instance Ord Float where
(F# x) `compare` (F# y)
= if x `ltFloat#` y then LT
else if x `eqFloat#` y then EQ
else GT
(F# x) < (F# y) = x `ltFloat#` y
(F# x) <= (F# y) = x `leFloat#` y
(F# x) >= (F# y) = x `geFloat#` y
(F# x) > (F# y) = x `gtFloat#` y
instance Ord Double where
(D# x) `compare` (D# y)
= if x <## y then LT
else if x ==## y then EQ
else GT
(D# x) < (D# y) = x <## y
(D# x) <= (D# y) = x <=## y
(D# x) >= (D# y) = x >=## y
(D# x) > (D# y) = x >## y
(&&) :: Bool -> Bool -> Bool
True && x = x
False && _ = False
(||) :: Bool -> Bool -> Bool
True || _ = True
False || x = x
not :: Bool -> Bool
not True = False
not False = True