Repository : ssh://darcs.haskell.org//srv/darcs/packages/ghc-prim On branch : master
http://hackage.haskell.org/trac/ghc/changeset/3baa0fc9b4059446c053173ef08e000975882736 >--------------------------------------------------------------- commit 3baa0fc9b4059446c053173ef08e000975882736 Author: Ian Lynagh <[email protected]> Date: Fri Jul 22 19:09:22 2011 +0100 Integer Eq and Ord instances are now in the integer package >--------------------------------------------------------------- GHC/Classes.hs | 12 ------------ 1 files changed, 0 insertions(+), 12 deletions(-) diff --git a/GHC/Classes.hs b/GHC/Classes.hs index 071905c..f362dea 100644 --- a/GHC/Classes.hs +++ b/GHC/Classes.hs @@ -19,7 +19,6 @@ module GHC.Classes where -import GHC.Integer -- GHC.Magic is used in some derived instances import GHC.Magic () import GHC.Ordering @@ -99,10 +98,6 @@ 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 @@ -207,13 +202,6 @@ instance Ord Char where (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 _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
