From: Jose Pedro Magalhaes Date: Tue, 3 May 2011 13:40:33 +0000 (+0200) Subject: Move Eq and Ord for Int from GHC.Base to GHC.Classes, so they are not longer orphan. X-Git-Url: http://git.megacz.com/?p=ghc-base.git;a=commitdiff_plain;h=092841be56472fe1dae12f745df6a72abbf44c40 Move Eq and Ord for Int from GHC.Base to GHC.Classes, so they are not longer orphan. Put Eq and Ord instances for Arity, Associativity, and Fixity in GHC.Classes, Show instances in GHC.Show, and Read instances in GHC.Read. --- diff --git a/GHC/Base.lhs b/GHC/Base.lhs index 98abed5..0a2bcc7 100644 --- a/GHC/Base.lhs +++ b/GHC/Base.lhs @@ -502,26 +502,6 @@ maxInt = I# 0x7FFFFFFF# minInt = I# (-0x8000000000000000#) maxInt = I# 0x7FFFFFFFFFFFFFFF# #endif - -instance Eq Int where - (==) = eqInt - (/=) = neInt - -instance Ord Int where - compare = compareInt - (<) = ltInt - (<=) = leInt - (>=) = geInt - (>) = gtInt - -compareInt :: Int -> Int -> Ordering -(I# x#) `compareInt` (I# y#) = compareInt# x# y# - -compareInt# :: Int# -> Int# -> Ordering -compareInt# x# y# - | x# <# y# = LT - | x# ==# y# = EQ - | otherwise = GT \end{code} @@ -703,12 +683,6 @@ Definitions of the boxed PrimOps; these will be used in the case of partial applications, etc. \begin{code} -{-# INLINE eqInt #-} -{-# INLINE neInt #-} -{-# INLINE gtInt #-} -{-# INLINE geInt #-} -{-# INLINE ltInt #-} -{-# INLINE leInt #-} {-# INLINE plusInt #-} {-# INLINE minusInt #-} {-# INLINE timesInt #-} @@ -739,14 +713,6 @@ plusInt, minusInt, timesInt, quotInt, remInt, divInt, modInt :: Int -> Int -> In negateInt :: Int -> Int negateInt (I# x) = I# (negateInt# x) -gtInt, geInt, eqInt, neInt, ltInt, leInt :: Int -> Int -> Bool -(I# x) `gtInt` (I# y) = x ># y -(I# x) `geInt` (I# y) = x >=# y -(I# x) `eqInt` (I# y) = x ==# y -(I# x) `neInt` (I# y) = x /=# y -(I# x) `ltInt` (I# y) = x <# y -(I# x) `leInt` (I# y) = x <=# y - {-# RULES "x# ># x#" forall x#. x# ># x# = False "x# >=# x#" forall x#. x# >=# x# = True diff --git a/GHC/Classes.hs b/GHC/Classes.hs index 17d0f93..54b36bc 100644 --- a/GHC/Classes.hs +++ b/GHC/Classes.hs @@ -27,6 +27,9 @@ import GHC.Prim import GHC.Tuple import GHC.Types import GHC.Unit +-- For defining instances for the generic deriving mechanism +import GHC.Generics (Arity(..), Associativity(..), Fixity(..)) + infix 4 ==, /=, <, <=, >=, > infixr 3 && @@ -106,6 +109,16 @@ instance Eq Float where instance Eq Double where (D# x) == (D# y) = x ==## y +instance Eq Int where + (==) = eqInt + (/=) = neInt + +{-# INLINE eqInt #-} +{-# INLINE neInt #-} +eqInt, neInt :: Int -> Int -> Bool +(I# x) `eqInt` (I# y) = x ==# y +(I# x) `neInt` (I# y) = x /=# y + -- | The 'Ord' class is used for totally ordered datatypes. -- -- Instances of 'Ord' can be derived for any user-defined @@ -223,6 +236,32 @@ instance Ord Double where (D# x) >= (D# y) = x >=## y (D# x) > (D# y) = x >## y +instance Ord Int where + compare = compareInt + (<) = ltInt + (<=) = leInt + (>=) = geInt + (>) = gtInt + +{-# INLINE gtInt #-} +{-# INLINE geInt #-} +{-# INLINE ltInt #-} +{-# INLINE leInt #-} +gtInt, geInt, ltInt, leInt :: Int -> Int -> Bool +(I# x) `gtInt` (I# y) = x ># y +(I# x) `geInt` (I# y) = x >=# y +(I# x) `ltInt` (I# y) = x <# y +(I# x) `leInt` (I# y) = x <=# y + +compareInt :: Int -> Int -> Ordering +(I# x#) `compareInt` (I# y#) = compareInt# x# y# + +compareInt# :: Int# -> Int# -> Ordering +compareInt# x# y# + | x# <# y# = LT + | x# ==# y# = EQ + | True = GT + -- OK, so they're technically not part of a class...: -- Boolean functions @@ -242,3 +281,17 @@ not :: Bool -> Bool not True = False not False = True + +------------------------------------------------------------------------ +-- Generic deriving +------------------------------------------------------------------------ + +-- We need instances for some basic datatypes, but some of those use Int, +-- so we have to put the instances here +deriving instance Eq Arity +deriving instance Eq Associativity +deriving instance Eq Fixity + +deriving instance Ord Arity +deriving instance Ord Associativity +deriving instance Ord Fixity diff --git a/GHC/Int.hs b/GHC/Int.hs index 146bf66..27ee990 100644 --- a/GHC/Int.hs +++ b/GHC/Int.hs @@ -42,8 +42,7 @@ import GHC.Err import GHC.Word hiding (uncheckedShiftL64#, uncheckedShiftRL64#) import GHC.Show import GHC.Float () -- for RealFrac methods --- For defining instances for the new generic deriving mechanism ---import GHC.Generics (Arity(..), Associativity(..), Fixity(..)) + ------------------------------------------------------------------------ -- type Int8 @@ -911,29 +910,6 @@ instance Ix Int64 where unsafeIndex (m,_) i = fromIntegral i - fromIntegral m inRange (m,n) i = m <= i && i <= n ------------------------------------------------------------------------- --- Generic deriving ------------------------------------------------------------------------- - --- We need instances for some basic datatypes, but some of those use Int, --- so we have to put the instances here -{- -deriving instance Eq Arity -deriving instance Eq Associativity -deriving instance Eq Fixity - -deriving instance Ord Arity -deriving instance Ord Associativity -deriving instance Ord Fixity - -deriving instance Read Arity -deriving instance Read Associativity -deriving instance Read Fixity - -deriving instance Show Arity -deriving instance Show Associativity -deriving instance Show Fixity --} {- Note [Order of tests] diff --git a/GHC/Read.lhs b/GHC/Read.lhs index 77daece..6305276 100644 --- a/GHC/Read.lhs +++ b/GHC/Read.lhs @@ -1,5 +1,5 @@ \begin{code} -{-# LANGUAGE CPP, NoImplicitPrelude #-} +{-# LANGUAGE CPP, NoImplicitPrelude, StandaloneDeriving #-} {-# OPTIONS_HADDOCK hide #-} ----------------------------------------------------------------------------- @@ -72,6 +72,8 @@ import GHC.Float () import GHC.Show import GHC.Base import GHC.Arr +-- For defining instances for the generic deriving mechanism +import GHC.Generics (Arity(..), Associativity(..), Fixity(..)) \end{code} @@ -680,3 +682,10 @@ readp :: Read a => ReadP a readp = readPrec_to_P readPrec minPrec \end{code} +Instances for types of the generic deriving mechanism. + +\begin{code} +deriving instance Read Arity +deriving instance Read Associativity +deriving instance Read Fixity +\end{code} \ No newline at end of file diff --git a/GHC/Show.lhs b/GHC/Show.lhs index 6cb8bf3..bbfe458 100644 --- a/GHC/Show.lhs +++ b/GHC/Show.lhs @@ -1,5 +1,5 @@ \begin{code} -{-# LANGUAGE NoImplicitPrelude, BangPatterns, MagicHash #-} +{-# LANGUAGE NoImplicitPrelude, BangPatterns, MagicHash, StandaloneDeriving #-} {-# OPTIONS_HADDOCK hide #-} ----------------------------------------------------------------------------- @@ -38,6 +38,8 @@ module GHC.Show import GHC.Base import Data.Maybe import GHC.List ((!!), foldr1, break) +-- For defining instances for the generic deriving mechanism +import GHC.Generics (Arity(..), Associativity(..), Fixity(..)) \end{code} @@ -429,3 +431,10 @@ itos n# cs itos' (x# `quotInt#` 10#) (C# c# : cs') } \end{code} +Instances for types of the generic deriving mechanism. + +\begin{code} +deriving instance Show Arity +deriving instance Show Associativity +deriving instance Show Fixity +\end{code}