diff options
Diffstat (limited to 'libraries/base/GHC')
40 files changed, 449 insertions, 3 deletions
diff --git a/libraries/base/GHC/Arr.hs b/libraries/base/GHC/Arr.hs index c736f56c66..adfd602d9d 100644 --- a/libraries/base/GHC/Arr.hs +++ b/libraries/base/GHC/Arr.hs @@ -182,6 +182,7 @@ hopelessIndexError :: Int -- Try to use 'indexError' instead! hopelessIndexError = errorWithoutStackTrace "Error in array index" ---------------------------------------------------------------------- +-- | @since 2.01 instance Ix Char where {-# INLINE range #-} range (m,n) = [m..n] @@ -197,6 +198,7 @@ instance Ix Char where inRange (m,n) i = m <= i && i <= n ---------------------------------------------------------------------- +-- | @since 2.01 instance Ix Int where {-# INLINE range #-} -- The INLINE stops the build in the RHS from getting inlined, @@ -214,12 +216,14 @@ instance Ix Int where {-# INLINE inRange #-} inRange (I# m,I# n) (I# i) = isTrue# (m <=# i) && isTrue# (i <=# n) +-- | @since 4.6.0.0 instance Ix Word where range (m,n) = [m..n] unsafeIndex (m,_) i = fromIntegral (i - m) inRange (m,n) i = m <= i && i <= n ---------------------------------------------------------------------- +-- | @since 2.01 instance Ix Integer where {-# INLINE range #-} range (m,n) = [m..n] @@ -235,6 +239,7 @@ instance Ix Integer where inRange (m,n) i = m <= i && i <= n ---------------------------------------------------------------------- +-- | @since 2.01 instance Ix Bool where -- as derived {-# INLINE range #-} range (m,n) = [m..n] @@ -250,6 +255,7 @@ instance Ix Bool where -- as derived inRange (l,u) i = fromEnum i >= fromEnum l && fromEnum i <= fromEnum u ---------------------------------------------------------------------- +-- | @since 2.01 instance Ix Ordering where -- as derived {-# INLINE range #-} range (m,n) = [m..n] @@ -265,6 +271,7 @@ instance Ix Ordering where -- as derived inRange (l,u) i = fromEnum i >= fromEnum l && fromEnum i <= fromEnum u ---------------------------------------------------------------------- +-- | @since 2.01 instance Ix () where {-# INLINE range #-} range ((), ()) = [()] @@ -277,6 +284,7 @@ instance Ix () where index b i = unsafeIndex b i ---------------------------------------------------------------------- +-- | @since 2.01 instance (Ix a, Ix b) => Ix (a, b) where -- as derived {-# SPECIALISE instance Ix (Int,Int) #-} @@ -295,6 +303,7 @@ instance (Ix a, Ix b) => Ix (a, b) where -- as derived -- Default method for index ---------------------------------------------------------------------- +-- | @since 2.01 instance (Ix a1, Ix a2, Ix a3) => Ix (a1,a2,a3) where {-# SPECIALISE instance Ix (Int,Int,Int) #-} @@ -315,6 +324,7 @@ instance (Ix a1, Ix a2, Ix a3) => Ix (a1,a2,a3) where -- Default method for index ---------------------------------------------------------------------- +-- | @since 2.01 instance (Ix a1, Ix a2, Ix a3, Ix a4) => Ix (a1,a2,a3,a4) where range ((l1,l2,l3,l4),(u1,u2,u3,u4)) = [(i1,i2,i3,i4) | i1 <- range (l1,u1), @@ -333,7 +343,7 @@ instance (Ix a1, Ix a2, Ix a3, Ix a4) => Ix (a1,a2,a3,a4) where inRange (l3,u3) i3 && inRange (l4,u4) i4 -- Default method for index - +-- | @since 2.01 instance (Ix a1, Ix a2, Ix a3, Ix a4, Ix a5) => Ix (a1,a2,a3,a4,a5) where range ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) = [(i1,i2,i3,i4,i5) | i1 <- range (l1,u1), @@ -390,6 +400,7 @@ type role Array nominal representational type role STArray nominal nominal representational -- Just pointer equality on mutable arrays: +-- | @since 2.01 instance Eq (STArray s i e) where STArray _ _ _ arr1# == STArray _ _ _ arr2# = isTrue# (sameMutableArray# arr1# arr2#) @@ -788,15 +799,19 @@ cmpIntArray arr1@(Array l1 u1 n1 _) arr2@(Array l2 u2 n2 _) = ---------------------------------------------------------------------- -- Array instances +-- | @since 2.01 instance Functor (Array i) where fmap = amap +-- | @since 2.01 instance (Ix i, Eq e) => Eq (Array i e) where (==) = eqArray +-- | @since 2.01 instance (Ix i, Ord e) => Ord (Array i e) where compare = cmpArray +-- | @since 2.01 instance (Ix a, Show a, Show b) => Show (Array a b) where showsPrec p a = showParen (p > appPrec) $ diff --git a/libraries/base/GHC/Base.hs b/libraries/base/GHC/Base.hs index 618fa05314..9e4467be5e 100644 --- a/libraries/base/GHC/Base.hs +++ b/libraries/base/GHC/Base.hs @@ -237,6 +237,7 @@ class Monoid a where mconcat = foldr mappend mempty +-- | @since 2.01 instance Monoid [a] where {-# INLINE mempty #-} mempty = [] @@ -265,32 +266,38 @@ needed to make foldr/build forms efficient are turned off, we'll get reasonably efficient translations anyway. -} +-- | @since 2.01 instance Monoid b => Monoid (a -> b) where mempty _ = mempty mappend f g x = f x `mappend` g x +-- | @since 2.01 instance Monoid () where -- Should it be strict? mempty = () _ `mappend` _ = () mconcat _ = () +-- | @since 2.01 instance (Monoid a, Monoid b) => Monoid (a,b) where mempty = (mempty, mempty) (a1,b1) `mappend` (a2,b2) = (a1 `mappend` a2, b1 `mappend` b2) +-- | @since 2.01 instance (Monoid a, Monoid b, Monoid c) => Monoid (a,b,c) where mempty = (mempty, mempty, mempty) (a1,b1,c1) `mappend` (a2,b2,c2) = (a1 `mappend` a2, b1 `mappend` b2, c1 `mappend` c2) +-- | @since 2.01 instance (Monoid a, Monoid b, Monoid c, Monoid d) => Monoid (a,b,c,d) where mempty = (mempty, mempty, mempty, mempty) (a1,b1,c1,d1) `mappend` (a2,b2,c2,d2) = (a1 `mappend` a2, b1 `mappend` b2, c1 `mappend` c2, d1 `mappend` d2) +-- | @since 2.01 instance (Monoid a, Monoid b, Monoid c, Monoid d, Monoid e) => Monoid (a,b,c,d,e) where mempty = (mempty, mempty, mempty, mempty, mempty) @@ -299,6 +306,7 @@ instance (Monoid a, Monoid b, Monoid c, Monoid d, Monoid e) => d1 `mappend` d2, e1 `mappend` e2) -- lexicographical ordering +-- | @since 2.01 instance Monoid Ordering where mempty = EQ LT `mappend` _ = LT @@ -311,19 +319,24 @@ instance Monoid Ordering where -- and defining @e*e = e@ and @e*s = s = s*e@ for all @s ∈ S@.\" Since -- there is no \"Semigroup\" typeclass providing just 'mappend', we -- use 'Monoid' instead. +-- +-- @since 2.01 instance Monoid a => Monoid (Maybe a) where mempty = Nothing Nothing `mappend` m = m m `mappend` Nothing = m Just m1 `mappend` Just m2 = Just (m1 `mappend` m2) +-- | @since 2.01 instance Monoid a => Applicative ((,) a) where pure x = (mempty, x) (u, f) <*> (v, x) = (u `mappend` v, f x) +-- | @since 4.9.0.0 instance Monoid a => Monad ((,) a) where (u, a) >>= k = case k a of (v, b) -> (u `mappend` v, b) +-- | @since 4.9.0.0 instance Monoid a => Monoid (IO a) where mempty = pure mempty mappend = liftA2 mappend @@ -635,24 +648,29 @@ ap m1 m2 = do { x1 <- m1; x2 <- m2; return (x1 x2) } -- instances for Prelude types +-- | @since 2.01 instance Functor ((->) r) where fmap = (.) +-- | @since 2.01 instance Applicative ((->) a) where pure = const (<*>) f g x = f x (g x) +-- | @since 2.01 instance Monad ((->) r) where f >>= k = \ r -> k (f r) r +-- | @since 2.01 instance Functor ((,) a) where fmap f (x,y) = (x, f y) - +-- | @since 2.01 instance Functor Maybe where fmap _ Nothing = Nothing fmap f (Just a) = Just (f a) +-- | @since 2.01 instance Applicative Maybe where pure = Just @@ -662,6 +680,7 @@ instance Applicative Maybe where Just _m1 *> m2 = m2 Nothing *> _m2 = Nothing +-- | @since 2.01 instance Monad Maybe where (Just x) >>= k = k x Nothing >>= _ = Nothing @@ -704,6 +723,7 @@ class Applicative f => Alternative f where some_v = (fmap (:) v) <*> many_v +-- | @since 2.01 instance Alternative Maybe where empty = Nothing Nothing <|> r = r @@ -726,16 +746,19 @@ class (Alternative m, Monad m) => MonadPlus m where mplus :: m a -> m a -> m a mplus = (<|>) +-- | @since 2.01 instance MonadPlus Maybe ---------------------------------------------- -- The list type +-- | @since 2.01 instance Functor [] where {-# INLINE fmap #-} fmap = map -- See Note: [List comprehensions and inlining] +-- | @since 2.01 instance Applicative [] where {-# INLINE pure #-} pure x = [x] @@ -745,6 +768,7 @@ instance Applicative [] where xs *> ys = [y | _ <- xs, y <- ys] -- See Note: [List comprehensions and inlining] +-- | @since 2.01 instance Monad [] where {-# INLINE (>>=) #-} xs >>= f = [y | x <- xs, y <- f x] @@ -753,10 +777,12 @@ instance Monad [] where {-# INLINE fail #-} fail _ = [] +-- | @since 2.01 instance Alternative [] where empty = [] (<|>) = (++) +-- | @since 2.01 instance MonadPlus [] {- @@ -1022,7 +1048,6 @@ breakpointCond :: Bool -> a -> a breakpointCond _ r = r data Opaque = forall a. O a - -- | @const x@ is a unary function which evaluates to @x@ for all inputs. -- -- For instance, @@ -1080,9 +1105,11 @@ asTypeOf = const -- Functor/Applicative/Monad instances for IO ---------------------------------------------- +-- | @since 2.01 instance Functor IO where fmap f x = x >>= (pure . f) +-- | @since 2.01 instance Applicative IO where {-# INLINE pure #-} {-# INLINE (*>) #-} @@ -1090,6 +1117,7 @@ instance Applicative IO where (*>) = thenIO (<*>) = ap +-- | @since 2.01 instance Monad IO where {-# INLINE (>>) #-} {-# INLINE (>>=) #-} @@ -1097,10 +1125,12 @@ instance Monad IO where (>>=) = bindIO fail s = failIO s +-- | @since 4.9.0.0 instance Alternative IO where empty = failIO "mzero" (<|>) = mplusIO +-- | @since 4.9.0.0 instance MonadPlus IO returnIO :: a -> IO a diff --git a/libraries/base/GHC/Conc/Sync.hs b/libraries/base/GHC/Conc/Sync.hs index 2a5164b798..5476950ec7 100644 --- a/libraries/base/GHC/Conc/Sync.hs +++ b/libraries/base/GHC/Conc/Sync.hs @@ -145,6 +145,7 @@ This misfeature will hopefully be corrected at a later date. -} +-- | @since 4.2.0.0 instance Show ThreadId where showsPrec d t = showString "ThreadId " . @@ -165,12 +166,14 @@ cmpThread t1 t2 = 0 -> EQ _ -> GT -- must be 1 +-- | @since 4.2.0.0 instance Eq ThreadId where t1 == t2 = case t1 `cmpThread` t2 of EQ -> True _ -> False +-- | @since 4.2.0.0 instance Ord ThreadId where compare = cmpThread @@ -625,9 +628,11 @@ newtype STM a = STM (State# RealWorld -> (# State# RealWorld, a #)) unSTM :: STM a -> (State# RealWorld -> (# State# RealWorld, a #)) unSTM (STM a) = a +-- | @since 4.3.0.0 instance Functor STM where fmap f x = x >>= (pure . f) +-- | @since 4.8.0.0 instance Applicative STM where {-# INLINE pure #-} {-# INLINE (*>) #-} @@ -635,6 +640,7 @@ instance Applicative STM where (<*>) = ap m *> k = thenSTM m k +-- | @since 4.3.0.0 instance Monad STM where {-# INLINE (>>=) #-} m >>= k = bindSTM m k @@ -655,10 +661,12 @@ thenSTM (STM m) k = STM ( \s -> returnSTM :: a -> STM a returnSTM x = STM (\s -> (# s, x #)) +-- | @since 4.8.0.0 instance Alternative STM where empty = retry (<|>) = orElse +-- | @since 4.3.0.0 instance MonadPlus STM -- | Unsafely performs IO in the STM monad. Beware: this is a highly @@ -769,6 +777,7 @@ always i = alwaysSucceeds ( do v <- i -- |Shared memory locations that support atomic memory transactions. data TVar a = TVar (TVar# RealWorld a) +-- | @since 4.8.0.0 instance Eq (TVar a) where (TVar tvar1#) == (TVar tvar2#) = isTrue# (sameTVar# tvar1# tvar2#) diff --git a/libraries/base/GHC/Enum.hs b/libraries/base/GHC/Enum.hs index c0e2f5a783..e09d2a9bfa 100644 --- a/libraries/base/GHC/Enum.hs +++ b/libraries/base/GHC/Enum.hs @@ -154,7 +154,10 @@ predError inst_ty = -- Tuples ------------------------------------------------------------------------ +-- | @since 2.01 deriving instance Bounded () + +-- | @since 2.01 instance Enum () where succ _ = errorWithoutStackTrace "Prelude.Enum.().succ: bad argument" pred _ = errorWithoutStackTrace "Prelude.Enum.().pred: bad argument" @@ -169,44 +172,58 @@ instance Enum () where enumFromThenTo () () () = let many = ():many in many -- Report requires instances up to 15 +-- | @since 2.01 deriving instance (Bounded a, Bounded b) => Bounded (a,b) +-- | @since 2.01 deriving instance (Bounded a, Bounded b, Bounded c) => Bounded (a,b,c) +-- | @since 2.01 deriving instance (Bounded a, Bounded b, Bounded c, Bounded d) => Bounded (a,b,c,d) +-- | @since 2.01 deriving instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e) => Bounded (a,b,c,d,e) +-- | @since 2.01 deriving instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, Bounded f) => Bounded (a,b,c,d,e,f) +-- | @since 2.01 deriving instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, Bounded f, Bounded g) => Bounded (a,b,c,d,e,f,g) +-- | @since 2.01 deriving instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, Bounded f, Bounded g, Bounded h) => Bounded (a,b,c,d,e,f,g,h) +-- | @since 2.01 deriving instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, Bounded f, Bounded g, Bounded h, Bounded i) => Bounded (a,b,c,d,e,f,g,h,i) +-- | @since 2.01 deriving instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, Bounded f, Bounded g, Bounded h, Bounded i, Bounded j) => Bounded (a,b,c,d,e,f,g,h,i,j) +-- | @since 2.01 deriving instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, Bounded f, Bounded g, Bounded h, Bounded i, Bounded j, Bounded k) => Bounded (a,b,c,d,e,f,g,h,i,j,k) +-- | @since 2.01 deriving instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, Bounded f, Bounded g, Bounded h, Bounded i, Bounded j, Bounded k, Bounded l) => Bounded (a,b,c,d,e,f,g,h,i,j,k,l) +-- | @since 2.01 deriving instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, Bounded f, Bounded g, Bounded h, Bounded i, Bounded j, Bounded k, Bounded l, Bounded m) => Bounded (a,b,c,d,e,f,g,h,i,j,k,l,m) +-- | @since 2.01 deriving instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, Bounded f, Bounded g, Bounded h, Bounded i, Bounded j, Bounded k, Bounded l, Bounded m, Bounded n) => Bounded (a,b,c,d,e,f,g,h,i,j,k,l,m,n) +-- | @since 2.01 deriving instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, Bounded f, Bounded g, Bounded h, Bounded i, Bounded j, Bounded k, Bounded l, Bounded m, Bounded n, Bounded o) @@ -216,7 +233,10 @@ deriving instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, -- Bool ------------------------------------------------------------------------ +-- | @since 2.01 deriving instance Bounded Bool + +-- | @since 2.01 instance Enum Bool where succ False = True succ True = errorWithoutStackTrace "Prelude.Enum.Bool.succ: bad argument" @@ -239,7 +259,9 @@ instance Enum Bool where -- Ordering ------------------------------------------------------------------------ +-- | @since 2.01 deriving instance Bounded Ordering +-- | @since 2.01 instance Enum Ordering where succ LT = EQ succ EQ = GT @@ -266,10 +288,12 @@ instance Enum Ordering where -- Char ------------------------------------------------------------------------ +-- | @since 2.01 instance Bounded Char where minBound = '\0' maxBound = '\x10FFFF' +-- | @since 2.01 instance Enum Char where succ (C# c#) | isTrue# (ord# c# /=# 0x10FFFF#) = C# (chr# (ord# c# +# 1#)) @@ -393,10 +417,12 @@ Be careful about these instances. (c) remember that Int is bounded, so [1..] terminates at maxInt -} +-- | @since 2.01 instance Bounded Int where minBound = minInt maxBound = maxInt +-- | @since 2.01 instance Enum Int where succ x | x == maxBound = errorWithoutStackTrace "Prelude.Enum.succ{Int}: tried to take `succ' of maxBound" @@ -559,6 +585,7 @@ efdtIntDnFB c n x1 x2 y -- Be careful about underflow! -- Word ------------------------------------------------------------------------ +-- | @since 2.01 instance Bounded Word where minBound = 0 @@ -572,6 +599,7 @@ instance Bounded Word where #error Unhandled value for WORD_SIZE_IN_BITS #endif +-- | @since 2.01 instance Enum Word where succ x | x /= maxBound = x + 1 @@ -611,6 +639,7 @@ wordToIntegerX (W# x#) = wordToInteger x# -- Integer ------------------------------------------------------------------------ +-- | @since 2.01 instance Enum Integer where succ x = x + 1 pred x = x - 1 diff --git a/libraries/base/GHC/Event/EPoll.hsc b/libraries/base/GHC/Event/EPoll.hsc index 26b6861004..47e69a68e0 100644 --- a/libraries/base/GHC/Event/EPoll.hsc +++ b/libraries/base/GHC/Event/EPoll.hsc @@ -136,6 +136,7 @@ data Event = Event { , eventFd :: Fd } deriving (Show) +-- | @since 4.3.1.0 instance Storable Event where sizeOf _ = #size struct epoll_event alignment _ = alignment (undefined :: CInt) diff --git a/libraries/base/GHC/Event/Internal.hs b/libraries/base/GHC/Event/Internal.hs index a093352ba9..7024714fdf 100644 --- a/libraries/base/GHC/Event/Internal.hs +++ b/libraries/base/GHC/Event/Internal.hs @@ -62,6 +62,7 @@ evtClose = Event 4 eventIs :: Event -> Event -> Bool eventIs (Event a) (Event b) = a .&. b /= 0 +-- | @since 4.3.1.0 instance Show Event where show e = '[' : (intercalate "," . filter (not . null) $ [evtRead `so` "evtRead", @@ -70,6 +71,7 @@ instance Show Event where where ev `so` disp | e `eventIs` ev = disp | otherwise = "" +-- | @since 4.3.1.0 instance Monoid Event where mempty = evtNothing mappend = evtCombine @@ -98,6 +100,8 @@ elSupremum _ _ = MultiShot {-# INLINE elSupremum #-} -- | @mappend@ == @elSupremum@ +-- +-- @since 4.8.0.0 instance Monoid Lifetime where mempty = OneShot mappend = elSupremum @@ -109,6 +113,7 @@ instance Monoid Lifetime where newtype EventLifetime = EL Int deriving (Show, Eq) +-- | @since 4.8.0.0 instance Monoid EventLifetime where mempty = EL 0 EL a `mappend` EL b = EL (a .|. b) diff --git a/libraries/base/GHC/Event/KQueue.hsc b/libraries/base/GHC/Event/KQueue.hsc index 1068ec0136..d6461c2647 100644 --- a/libraries/base/GHC/Event/KQueue.hsc +++ b/libraries/base/GHC/Event/KQueue.hsc @@ -142,6 +142,7 @@ data Event = KEvent { event :: Fd -> Filter -> Flag -> FFlag -> Event event fd filt flag fflag = KEvent (fromIntegral fd) filt flag fflag 0 nullPtr +-- | @since 4.3.1.0 instance Storable Event where sizeOf _ = #size struct kevent alignment _ = alignment (undefined :: CInt) @@ -202,6 +203,7 @@ data TimeSpec = TimeSpec { , tv_nsec :: {-# UNPACK #-} !CLong } +-- | @since 4.3.1.0 instance Storable TimeSpec where sizeOf _ = #size struct timespec alignment _ = alignment (undefined :: CInt) diff --git a/libraries/base/GHC/Event/PSQ.hs b/libraries/base/GHC/Event/PSQ.hs index e61c31b1b4..a4c0ccc23c 100644 --- a/libraries/base/GHC/Event/PSQ.hs +++ b/libraries/base/GHC/Event/PSQ.hs @@ -479,6 +479,7 @@ infixr 5 <> seqToList :: Sequ a -> [a] seqToList (Sequ x) = x [] +-- | @since 4.3.1.0 instance Show a => Show (Sequ a) where showsPrec d a = showsPrec d (seqToList a) diff --git a/libraries/base/GHC/Event/Poll.hsc b/libraries/base/GHC/Event/Poll.hsc index b128572e71..330007c317 100644 --- a/libraries/base/GHC/Event/Poll.hsc +++ b/libraries/base/GHC/Event/Poll.hsc @@ -187,6 +187,7 @@ toEvent e = remap (pollIn .|. pollErr .|. pollHup) E.evtRead `mappend` | e .&. evt /= 0 = to | otherwise = mempty +-- | @since 4.3.1.0 instance Storable PollFd where sizeOf _ = #size struct pollfd alignment _ = alignment (undefined :: CInt) diff --git a/libraries/base/GHC/Event/Unique.hs b/libraries/base/GHC/Event/Unique.hs index d3af627cbd..abdd3fe7f2 100644 --- a/libraries/base/GHC/Event/Unique.hs +++ b/libraries/base/GHC/Event/Unique.hs @@ -27,6 +27,7 @@ newtype UniqueSource = US (TVar Int64) newtype Unique = Unique { asInt64 :: Int64 } deriving (Eq, Ord, Num) +-- | @since 4.3.1.0 instance Show Unique where show = show . asInt64 diff --git a/libraries/base/GHC/Exception.hs b/libraries/base/GHC/Exception.hs index aeaef20805..d2b5e209cc 100644 --- a/libraries/base/GHC/Exception.hs +++ b/libraries/base/GHC/Exception.hs @@ -50,6 +50,7 @@ encapsulated in a @SomeException@. -} data SomeException = forall e . Exception e => SomeException e +-- | @since 3.0 instance Show SomeException where showsPrec p (SomeException e) = showsPrec p e @@ -154,6 +155,7 @@ class (Typeable e, Show e) => Exception e where displayException :: e -> String displayException = show +-- | @since 3.0 instance Exception SomeException where toException se = se fromException = Just @@ -173,8 +175,10 @@ pattern ErrorCall :: String -> ErrorCall pattern ErrorCall err <- ErrorCallWithLocation err _ where ErrorCall err = ErrorCallWithLocation err "" +-- | @since 4.0.0.0 instance Exception ErrorCall +-- | @since 4.0.0.0 instance Show ErrorCall where showsPrec _ (ErrorCallWithLocation err "") = showString err showsPrec _ (ErrorCallWithLocation err loc) = showString (err ++ '\n' : loc) @@ -239,8 +243,10 @@ divZeroException = toException DivideByZero overflowException = toException Overflow ratioZeroDenomException = toException RatioZeroDenominator +-- | @since 4.0.0.0 instance Exception ArithException +-- | @since 4.0.0.0 instance Show ArithException where showsPrec _ Overflow = showString "arithmetic overflow" showsPrec _ Underflow = showString "arithmetic underflow" diff --git a/libraries/base/GHC/Exts.hs b/libraries/base/GHC/Exts.hs index 35d344cb55..2e047e306b 100755 --- a/libraries/base/GHC/Exts.hs +++ b/libraries/base/GHC/Exts.hs @@ -187,6 +187,7 @@ class IsList l where -- It should satisfy fromList . toList = id. toList :: l -> [Item l] +-- | @since 4.7.0.0 instance IsList [a] where type (Item [a]) = a fromList = id diff --git a/libraries/base/GHC/Fingerprint/Type.hs b/libraries/base/GHC/Fingerprint/Type.hs index 73720370dc..1ad34a7791 100644 --- a/libraries/base/GHC/Fingerprint/Type.hs +++ b/libraries/base/GHC/Fingerprint/Type.hs @@ -24,6 +24,7 @@ import Numeric (showHex) data Fingerprint = Fingerprint {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64 deriving (Eq, Ord) +-- | @since 4.7.0.0 instance Show Fingerprint where show (Fingerprint w1 w2) = hex16 w1 ++ hex16 w2 where diff --git a/libraries/base/GHC/Float.hs b/libraries/base/GHC/Float.hs index 7c6995a18d..18dd288dd6 100644 --- a/libraries/base/GHC/Float.hs +++ b/libraries/base/GHC/Float.hs @@ -239,6 +239,7 @@ class (RealFrac a, Floating a) => RealFloat a where -- Float ------------------------------------------------------------------------ +-- | @since 2.01 instance Num Float where (+) x y = plusFloat x y (-) x y = minusFloat x y @@ -254,6 +255,7 @@ instance Num Float where {-# INLINE fromInteger #-} fromInteger i = F# (floatFromInteger i) +-- | @since 2.01 instance Real Float where toRational (F# x#) = case decodeFloat_Int# x# of @@ -266,6 +268,7 @@ instance Real Float where | otherwise -> smallInteger m# :% shiftLInteger 1 (negateInt# e#) +-- | @since 2.01 instance Fractional Float where (/) x y = divideFloat x y {-# INLINE fromRational #-} @@ -299,6 +302,7 @@ rationalToFloat n d "ceiling/Float->Int" ceiling = ceilingFloatInt "round/Float->Int" round = roundFloatInt #-} +-- | @since 2.01 instance RealFrac Float where -- ceiling, floor, and truncate are all small @@ -342,6 +346,7 @@ instance RealFrac Float where floor x = case properFraction x of (n,r) -> if r < 0.0 then n - 1 else n +-- | @since 2.01 instance Floating Float where pi = 3.141592653589793238 exp x = expFloat x @@ -376,6 +381,7 @@ instance Floating Float where | otherwise = a {-# INLINE log1pexp #-} +-- | @since 2.01 instance RealFloat Float where floatRadix _ = FLT_RADIX -- from float.h floatDigits _ = FLT_MANT_DIG -- ditto @@ -406,6 +412,7 @@ instance RealFloat Float where isNegativeZero x = 0 /= isFloatNegativeZero x isIEEE _ = True +-- | @since 2.01 instance Show Float where showsPrec x = showSignedFloat showFloat x showList = showList__ (showsPrec 0) @@ -414,6 +421,7 @@ instance Show Float where -- Double ------------------------------------------------------------------------ +-- | @since 2.01 instance Num Double where (+) x y = plusDouble x y (-) x y = minusDouble x y @@ -431,6 +439,7 @@ instance Num Double where fromInteger i = D# (doubleFromInteger i) +-- | @since 2.01 instance Real Double where toRational (D# x#) = case decodeDoubleInteger x# of @@ -443,6 +452,7 @@ instance Real Double where | otherwise -> m :% shiftLInteger 1 (negateInt# e#) +-- | @since 2.01 instance Fractional Double where (/) x y = divideDouble x y {-# INLINE fromRational #-} @@ -463,6 +473,7 @@ rationalToDouble n d minEx = DBL_MIN_EXP mantDigs = DBL_MANT_DIG +-- | @since 2.01 instance Floating Double where pi = 3.141592653589793238 exp x = expDouble x @@ -510,6 +521,7 @@ instance Floating Double where "ceiling/Double->Int" ceiling = ceilingDoubleInt "round/Double->Int" round = roundDoubleInt #-} +-- | @since 2.01 instance RealFrac Double where -- ceiling, floor, and truncate are all small @@ -546,6 +558,7 @@ instance RealFrac Double where floor x = case properFraction x of (n,r) -> if r < 0.0 then n - 1 else n +-- | @since 2.01 instance RealFloat Double where floatRadix _ = FLT_RADIX -- from float.h floatDigits _ = DBL_MANT_DIG -- ditto @@ -577,6 +590,7 @@ instance RealFloat Double where isNegativeZero x = 0 /= isDoubleNegativeZero x isIEEE _ = True +-- | @since 2.01 instance Show Double where showsPrec x = showSignedFloat showFloat x showList = showList__ (showsPrec 0) @@ -601,6 +615,7 @@ a `non-lossy' conversion to and from Ints. Instead we make use of the for these (@numericEnumFromTo@ and @numericEnumFromThenTo@ below.) -} +-- | @since 2.01 instance Enum Float where succ x = x + 1 pred x = x - 1 @@ -611,6 +626,7 @@ instance Enum Float where enumFromThen = numericEnumFromThen enumFromThenTo = numericEnumFromThenTo +-- | @since 2.01 instance Enum Double where succ x = x + 1 pred x = x - 1 diff --git a/libraries/base/GHC/ForeignPtr.hs b/libraries/base/GHC/ForeignPtr.hs index 6d03967d3b..aaad3c61e0 100644 --- a/libraries/base/GHC/ForeignPtr.hs +++ b/libraries/base/GHC/ForeignPtr.hs @@ -90,12 +90,15 @@ data ForeignPtrContents | MallocPtr (MutableByteArray# RealWorld) !(IORef Finalizers) | PlainPtr (MutableByteArray# RealWorld) +-- | @since 2.01 instance Eq (ForeignPtr a) where p == q = unsafeForeignPtrToPtr p == unsafeForeignPtrToPtr q +-- | @since 2.01 instance Ord (ForeignPtr a) where compare p q = compare (unsafeForeignPtrToPtr p) (unsafeForeignPtrToPtr q) +-- | @since 2.01 instance Show (ForeignPtr a) where showsPrec p f = showsPrec p (unsafeForeignPtrToPtr f) diff --git a/libraries/base/GHC/GHCi.hs b/libraries/base/GHC/GHCi.hs index 514a33cc13..84093afbf1 100644 --- a/libraries/base/GHC/GHCi.hs +++ b/libraries/base/GHC/GHCi.hs @@ -28,22 +28,27 @@ import GHC.Base (IO(), Monad, Functor(fmap), Applicative(..), (>>=), id, (.), ap class (Monad m) => GHCiSandboxIO m where ghciStepIO :: m a -> IO a +-- | @since 4.4.0.0 instance GHCiSandboxIO IO where ghciStepIO = id -- | A monad that doesn't allow any IO. newtype NoIO a = NoIO { noio :: IO a } +-- | @since 4.8.0.0 instance Functor NoIO where fmap f (NoIO a) = NoIO (fmap f a) +-- | @since 4.8.0.0 instance Applicative NoIO where pure a = NoIO (pure a) (<*>) = ap +-- | @since 4.4.0.0 instance Monad NoIO where (>>=) k f = NoIO (noio k >>= noio . f) +-- | @since 4.4.0.0 instance GHCiSandboxIO NoIO where ghciStepIO = noio diff --git a/libraries/base/GHC/Generics.hs b/libraries/base/GHC/Generics.hs index e45b761026..907d56b0bd 100644 --- a/libraries/base/GHC/Generics.hs +++ b/libraries/base/GHC/Generics.hs @@ -756,42 +756,53 @@ deriving instance Show (V1 p) data U1 (p :: k) = U1 deriving (Generic, Generic1) +-- | @since 4.9.0.0 instance Eq (U1 p) where _ == _ = True +-- | @since 4.9.0.0 instance Ord (U1 p) where compare _ _ = EQ +-- | @since 4.9.0.0 instance Read (U1 p) where readsPrec d = readParen (d > 10) (\r -> [(U1, s) | ("U1",s) <- lex r ]) +-- | @since 4.9.0.0 instance Show (U1 p) where showsPrec _ _ = showString "U1" +-- | @since 4.9.0.0 instance Functor U1 where fmap _ _ = U1 +-- | @since 4.9.0.0 instance Applicative U1 where pure _ = U1 _ <*> _ = U1 +-- | @since 4.9.0.0 instance Alternative U1 where empty = U1 _ <|> _ = U1 +-- | @since 4.9.0.0 instance Monad U1 where _ >>= _ = U1 +-- | @since 4.9.0.0 instance MonadPlus U1 -- | Used for marking occurrences of the parameter newtype Par1 p = Par1 { unPar1 :: p } deriving (Eq, Ord, Read, Show, Functor, Generic, Generic1) +-- | @since 4.9.0.0 instance Applicative Par1 where pure a = Par1 a Par1 f <*> Par1 x = Par1 (f x) +-- | @since 4.9.0.0 instance Monad Par1 where Par1 x >>= f = f x @@ -800,34 +811,42 @@ instance Monad Par1 where newtype Rec1 (f :: k -> *) (p :: k) = Rec1 { unRec1 :: f p } deriving (Eq, Ord, Read, Show, Functor, Generic, Generic1) +-- | @since 4.9.0.0 instance Applicative f => Applicative (Rec1 f) where pure a = Rec1 (pure a) Rec1 f <*> Rec1 x = Rec1 (f <*> x) +-- | @since 4.9.0.0 instance Alternative f => Alternative (Rec1 f) where empty = Rec1 empty Rec1 l <|> Rec1 r = Rec1 (l <|> r) +-- | @since 4.9.0.0 instance Monad f => Monad (Rec1 f) where Rec1 x >>= f = Rec1 (x >>= \a -> unRec1 (f a)) +-- | @since 4.9.0.0 instance MonadPlus f => MonadPlus (Rec1 f) -- | Constants, additional parameters and recursion of kind @*@ newtype K1 (i :: *) c (p :: k) = K1 { unK1 :: c } deriving (Eq, Ord, Read, Show, Functor, Generic, Generic1) +-- | @since 4.9.0.0 instance Applicative f => Applicative (M1 i c f) where pure a = M1 (pure a) M1 f <*> M1 x = M1 (f <*> x) +-- | @since 4.9.0.0 instance Alternative f => Alternative (M1 i c f) where empty = M1 empty M1 l <|> M1 r = M1 (l <|> r) +-- | @since 4.9.0.0 instance Monad f => Monad (M1 i c f) where M1 x >>= f = M1 (x >>= \a -> unM1 (f a)) +-- | @since 4.9.0.0 instance MonadPlus f => MonadPlus (M1 i c f) -- | Meta-information (constructor names, etc.) @@ -844,20 +863,24 @@ infixr 6 :*: data (:*:) (f :: k -> *) (g :: k -> *) (p :: k) = f p :*: g p deriving (Eq, Ord, Read, Show, Functor, Generic, Generic1) +-- | @since 4.9.0.0 instance (Applicative f, Applicative g) => Applicative (f :*: g) where pure a = pure a :*: pure a (f :*: g) <*> (x :*: y) = (f <*> x) :*: (g <*> y) +-- | @since 4.9.0.0 instance (Alternative f, Alternative g) => Alternative (f :*: g) where empty = empty :*: empty (x1 :*: y1) <|> (x2 :*: y2) = (x1 <|> x2) :*: (y1 <|> y2) +-- | @since 4.9.0.0 instance (Monad f, Monad g) => Monad (f :*: g) where (m :*: n) >>= f = (m >>= \a -> fstP (f a)) :*: (n >>= \a -> sndP (f a)) where fstP (a :*: _) = a sndP (_ :*: b) = b +-- | @since 4.9.0.0 instance (MonadPlus f, MonadPlus g) => MonadPlus (f :*: g) -- | Composition of functors @@ -866,10 +889,12 @@ newtype (:.:) (f :: k2 -> *) (g :: k1 -> k2) (p :: k1) = Comp1 { unComp1 :: f (g p) } deriving (Eq, Ord, Read, Show, Functor, Generic, Generic1) +-- | @since 4.9.0.0 instance (Applicative f, Applicative g) => Applicative (f :.: g) where pure x = Comp1 (pure (pure x)) Comp1 f <*> Comp1 x = Comp1 (fmap (<*>) f <*> x) +-- | @since 4.9.0.0 instance (Alternative f, Applicative g) => Alternative (f :.: g) where empty = Comp1 empty Comp1 x <|> Comp1 y = Comp1 (x <|> y) @@ -923,18 +948,22 @@ type UAddr = URec (Ptr ()) -- -- @since 4.9.0.0 type UChar = URec Char + -- | Type synonym for @'URec' 'Double#'@ -- -- @since 4.9.0.0 type UDouble = URec Double + -- | Type synonym for @'URec' 'Float#'@ -- -- @since 4.9.0.0 type UFloat = URec Float + -- | Type synonym for @'URec' 'Int#'@ -- -- @since 4.9.0.0 type UInt = URec Int + -- | Type synonym for @'URec' 'Word#'@ -- -- @since 4.9.0.0 @@ -978,6 +1007,7 @@ class Datatype d where isNewtype :: t d (f :: k -> *) (a :: k) -> Bool isNewtype _ = False +-- | @since 4.9.0.0 instance (KnownSymbol n, KnownSymbol m, KnownSymbol p, SingI nt) => Datatype ('MetaData n m p nt) where datatypeName _ = symbolVal (Proxy :: Proxy n) @@ -998,6 +1028,7 @@ class Constructor c where conIsRecord :: t c (f :: k -> *) (a :: k) -> Bool conIsRecord _ = False +-- | @since 4.9.0.0 instance (KnownSymbol n, SingI f, SingI r) => Constructor ('MetaCons n f r) where conName _ = symbolVal (Proxy :: Proxy n) @@ -1103,6 +1134,7 @@ class Selector s where -- @since 4.9.0.0 selDecidedStrictness :: t s (f :: k -> *) (a :: k) -> DecidedStrictness +-- | @since 4.9.0.0 instance (SingI mn, SingI su, SingI ss, SingI ds) => Selector ('MetaSel mn su ss ds) where selName _ = fromMaybe "" (fromSing (sing :: Sing mn)) @@ -1216,8 +1248,10 @@ class (kparam ~ 'KProxy) => SingKind (kparam :: KProxy k) where data instance Sing (s :: Symbol) where SSym :: KnownSymbol s => Sing s +-- | @since 4.9.0.0 instance KnownSymbol a => SingI a where sing = SSym +-- | @since 4.9.0.0 instance SingKind ('KProxy :: KProxy Symbol) where type DemoteRep ('KProxy :: KProxy Symbol) = String fromSing (SSym :: Sing s) = symbolVal (Proxy :: Proxy s) @@ -1227,9 +1261,13 @@ data instance Sing (a :: Bool) where STrue :: Sing 'True SFalse :: Sing 'False +-- | @since 4.9.0.0 instance SingI 'True where sing = STrue + +-- | @since 4.9.0.0 instance SingI 'False where sing = SFalse +-- | @since 4.9.0.0 instance SingKind ('KProxy :: KProxy Bool) where type DemoteRep ('KProxy :: KProxy Bool) = Bool fromSing STrue = True @@ -1240,9 +1278,13 @@ data instance Sing (b :: Maybe a) where SNothing :: Sing 'Nothing SJust :: Sing a -> Sing ('Just a) +-- | @since 4.9.0.0 instance SingI 'Nothing where sing = SNothing + +-- | @since 4.9.0.0 instance SingI a => SingI ('Just a) where sing = SJust sing +-- | @since 4.9.0.0 instance SingKind ('KProxy :: KProxy a) => SingKind ('KProxy :: KProxy (Maybe a)) where type DemoteRep ('KProxy :: KProxy (Maybe a)) = @@ -1255,10 +1297,14 @@ data instance Sing (a :: FixityI) where SPrefix :: Sing 'PrefixI SInfix :: Sing a -> Integer -> Sing ('InfixI a n) +-- | @since 4.9.0.0 instance SingI 'PrefixI where sing = SPrefix + +-- | @since 4.9.0.0 instance (SingI a, KnownNat n) => SingI ('InfixI a n) where sing = SInfix (sing :: Sing a) (natVal (Proxy :: Proxy n)) +-- | @since 4.9.0.0 instance SingKind ('KProxy :: KProxy FixityI) where type DemoteRep ('KProxy :: KProxy FixityI) = Fixity fromSing SPrefix = Prefix @@ -1270,10 +1316,16 @@ data instance Sing (a :: Associativity) where SRightAssociative :: Sing 'RightAssociative SNotAssociative :: Sing 'NotAssociative +-- | @since 4.9.0.0 instance SingI 'LeftAssociative where sing = SLeftAssociative + +-- | @since 4.9.0.0 instance SingI 'RightAssociative where sing = SRightAssociative + +-- | @since 4.9.0.0 instance SingI 'NotAssociative where sing = SNotAssociative +-- | @since 4.0.0.0 instance SingKind ('KProxy :: KProxy Associativity) where type DemoteRep ('KProxy :: KProxy Associativity) = Associativity fromSing SLeftAssociative = LeftAssociative @@ -1286,10 +1338,16 @@ data instance Sing (a :: SourceUnpackedness) where SSourceNoUnpack :: Sing 'SourceNoUnpack SSourceUnpack :: Sing 'SourceUnpack +-- | @since 4.9.0.0 instance SingI 'NoSourceUnpackedness where sing = SNoSourceUnpackedness + +-- | @since 4.9.0.0 instance SingI 'SourceNoUnpack where sing = SSourceNoUnpack + +-- | @since 4.9.0.0 instance SingI 'SourceUnpack where sing = SSourceUnpack +-- | @since 4.9.0.0 instance SingKind ('KProxy :: KProxy SourceUnpackedness) where type DemoteRep ('KProxy :: KProxy SourceUnpackedness) = SourceUnpackedness fromSing SNoSourceUnpackedness = NoSourceUnpackedness @@ -1302,10 +1360,16 @@ data instance Sing (a :: SourceStrictness) where SSourceLazy :: Sing 'SourceLazy SSourceStrict :: Sing 'SourceStrict +-- | @since 4.9.0.0 instance SingI 'NoSourceStrictness where sing = SNoSourceStrictness + +-- | @since 4.9.0.0 instance SingI 'SourceLazy where sing = SSourceLazy + +-- | @since 4.9.0.0 instance SingI 'SourceStrict where sing = SSourceStrict +-- | @since 4.9.0.0 instance SingKind ('KProxy :: KProxy SourceStrictness) where type DemoteRep ('KProxy :: KProxy SourceStrictness) = SourceStrictness fromSing SNoSourceStrictness = NoSourceStrictness @@ -1318,10 +1382,16 @@ data instance Sing (a :: DecidedStrictness) where SDecidedStrict :: Sing 'DecidedStrict SDecidedUnpack :: Sing 'DecidedUnpack +-- | @since 4.9.0.0 instance SingI 'DecidedLazy where sing = SDecidedLazy + +-- | @since 4.9.0.0 instance SingI 'DecidedStrict where sing = SDecidedStrict + +-- | @since 4.9.0.0 instance SingI 'DecidedUnpack where sing = SDecidedUnpack +-- | @since 4.9.0.0 instance SingKind ('KProxy :: KProxy DecidedStrictness) where type DemoteRep ('KProxy :: KProxy DecidedStrictness) = DecidedStrictness fromSing SDecidedLazy = DecidedLazy diff --git a/libraries/base/GHC/IO/Encoding/CodePage/API.hs b/libraries/base/GHC/IO/Encoding/CodePage/API.hs index 5a48a9ee3d..8cf77b0a96 100644 --- a/libraries/base/GHC/IO/Encoding/CodePage/API.hs +++ b/libraries/base/GHC/IO/Encoding/CodePage/API.hs @@ -64,6 +64,7 @@ data CPINFO = CPINFO { leadByte :: [BYTE] -- ^ Always of length mAX_LEADBYTES } +-- | @since 4.7.0.0 instance Storable CPINFO where sizeOf _ = sizeOf (undefined :: UINT) + (mAX_DEFAULTCHAR + mAX_LEADBYTES) * sizeOf (undefined :: BYTE) alignment _ = alignment (undefined :: CInt) diff --git a/libraries/base/GHC/IO/Encoding/Types.hs b/libraries/base/GHC/IO/Encoding/Types.hs index cf32d7f86f..daab9d5157 100644 --- a/libraries/base/GHC/IO/Encoding/Types.hs +++ b/libraries/base/GHC/IO/Encoding/Types.hs @@ -117,6 +117,7 @@ data TextEncoding -- be shared between several character sequences or simultaneously across threads } +-- | @since 4.3.0.0 instance Show TextEncoding where -- | Returns the value of 'textEncodingName' show te = textEncodingName te diff --git a/libraries/base/GHC/IO/Exception.hs b/libraries/base/GHC/IO/Exception.hs index c7bccb0077..69d2c330c9 100644 --- a/libraries/base/GHC/IO/Exception.hs +++ b/libraries/base/GHC/IO/Exception.hs @@ -64,8 +64,10 @@ import Data.Typeable ( cast ) -- to the @MVar@ so it can't ever continue. data BlockedIndefinitelyOnMVar = BlockedIndefinitelyOnMVar +-- | @since 4.1.0.0 instance Exception BlockedIndefinitelyOnMVar +-- | @since 4.1.0.0 instance Show BlockedIndefinitelyOnMVar where showsPrec _ BlockedIndefinitelyOnMVar = showString "thread blocked indefinitely in an MVar operation" @@ -78,8 +80,10 @@ blockedIndefinitelyOnMVar = toException BlockedIndefinitelyOnMVar -- other references to any @TVar@s involved, so it can't ever continue. data BlockedIndefinitelyOnSTM = BlockedIndefinitelyOnSTM +-- | @since 4.1.0.0 instance Exception BlockedIndefinitelyOnSTM +-- | @since 4.1.0.0 instance Show BlockedIndefinitelyOnSTM where showsPrec _ BlockedIndefinitelyOnSTM = showString "thread blocked indefinitely in an STM transaction" @@ -92,8 +96,10 @@ blockedIndefinitelyOnSTM = toException BlockedIndefinitelyOnSTM -- The @Deadlock@ exception is raised in the main thread only. data Deadlock = Deadlock +-- | @since 4.1.0.0 instance Exception Deadlock +-- | @since 4.1.0.0 instance Show Deadlock where showsPrec _ Deadlock = showString "<<deadlock>>" @@ -106,10 +112,12 @@ instance Show Deadlock where -- @since 4.8.0.0 data AllocationLimitExceeded = AllocationLimitExceeded +-- | @since 4.8.0.0 instance Exception AllocationLimitExceeded where toException = asyncExceptionToException fromException = asyncExceptionFromException +-- | @since 4.7.1.0 instance Show AllocationLimitExceeded where showsPrec _ AllocationLimitExceeded = showString "allocation limit exceeded" @@ -122,8 +130,10 @@ allocationLimitExceeded = toException AllocationLimitExceeded -- |'assert' was applied to 'False'. newtype AssertionFailed = AssertionFailed String +-- | @since 4.1.0.0 instance Exception AssertionFailed +-- | @since 4.1.0.0 instance Show AssertionFailed where showsPrec _ (AssertionFailed err) = showString err @@ -134,9 +144,11 @@ instance Show AssertionFailed where -- @since 4.7.0.0 data SomeAsyncException = forall e . Exception e => SomeAsyncException e +-- | @since 4.7.0.0 instance Show SomeAsyncException where show (SomeAsyncException e) = show e +-- | @since 4.7.0.0 instance Exception SomeAsyncException -- |@since 4.7.0.0 @@ -177,6 +189,7 @@ data AsyncException -- via the usual mechanism(s) (e.g. Control-C in the console). deriving (Eq, Ord) +-- | @since 4.7.0.0 instance Exception AsyncException where toException = asyncExceptionToException fromException = asyncExceptionFromException @@ -191,6 +204,7 @@ data ArrayException -- array that had not been initialized. deriving (Eq, Ord) +-- | @since 4.1.0.0 instance Exception ArrayException -- for the RTS @@ -198,12 +212,14 @@ stackOverflow, heapOverflow :: SomeException stackOverflow = toException StackOverflow heapOverflow = toException HeapOverflow +-- | @since 4.1.0.0 instance Show AsyncException where showsPrec _ StackOverflow = showString "stack overflow" showsPrec _ HeapOverflow = showString "heap overflow" showsPrec _ ThreadKilled = showString "thread killed" showsPrec _ UserInterrupt = showString "user interrupt" +-- | @since 4.1.0.0 instance Show ArrayException where showsPrec _ (IndexOutOfBounds s) = showString "array index out of range" @@ -230,6 +246,7 @@ data ExitCode -- may be prohibited (e.g. 0 on a POSIX-compliant system). deriving (Eq, Ord, Read, Show, Generic) +-- | @since 4.1.0.0 instance Exception ExitCode ioException :: IOException -> IO a @@ -265,8 +282,10 @@ data IOException ioe_filename :: Maybe FilePath -- filename the error is related to. } +-- | @since 4.1.0.0 instance Exception IOException +-- | @since 4.1.0.0 instance Eq IOException where (IOError h1 e1 loc1 str1 en1 fn1) == (IOError h2 e2 loc2 str2 en2 fn2) = e1==e2 && str1==str2 && h1==h2 && loc1==loc2 && en1==en2 && fn1==fn2 @@ -295,9 +314,11 @@ data IOErrorType | ResourceVanished | Interrupted +-- | @since 4.1.0.0 instance Eq IOErrorType where x == y = isTrue# (getTag x ==# getTag y) +-- | @since 4.1.0.0 instance Show IOErrorType where showsPrec _ e = showString $ @@ -336,6 +357,7 @@ userError str = IOError Nothing UserError "" str Nothing Nothing -- --------------------------------------------------------------------------- -- Showing IOErrors +-- | @since 4.1.0.0 instance Show IOException where showsPrec p (IOError hdl iot loc s _ fn) = (case fn of diff --git a/libraries/base/GHC/IO/FD.hs b/libraries/base/GHC/IO/FD.hs index 18148ecee1..381f39aabe 100644 --- a/libraries/base/GHC/IO/FD.hs +++ b/libraries/base/GHC/IO/FD.hs @@ -88,15 +88,18 @@ fdIsSocket :: FD -> Bool fdIsSocket fd = fdIsSocket_ fd /= 0 #endif +-- | @since 4.1.0.0 instance Show FD where show fd = show (fdFD fd) +-- | @since 4.1.0.0 instance GHC.IO.Device.RawIO FD where read = fdRead readNonBlocking = fdReadNonBlocking write = fdWrite writeNonBlocking = fdWriteNonBlocking +-- | @since 4.1.0.0 instance GHC.IO.Device.IODevice FD where ready = ready close = close @@ -120,6 +123,7 @@ instance GHC.IO.Device.IODevice FD where dEFAULT_FD_BUFFER_SIZE :: Int dEFAULT_FD_BUFFER_SIZE = 8096 +-- | @since 4.1.0.0 instance BufferedIO FD where newBuffer _dev state = newByteBuffer dEFAULT_FD_BUFFER_SIZE state fillReadBuffer fd buf = readBuf' fd buf diff --git a/libraries/base/GHC/IO/Handle.hs b/libraries/base/GHC/IO/Handle.hs index ca5336955c..ec376cb8d4 100644 --- a/libraries/base/GHC/IO/Handle.hs +++ b/libraries/base/GHC/IO/Handle.hs @@ -316,9 +316,11 @@ hFlushAll handle = withHandle_ "hFlushAll" handle flushBuffer data HandlePosn = HandlePosn Handle HandlePosition +-- | @since 4.1.0.0 instance Eq HandlePosn where (HandlePosn h1 p1) == (HandlePosn h2 p2) = p1==p2 && h1==h2 +-- | @since 4.1.0.0 instance Show HandlePosn where showsPrec p (HandlePosn h pos) = showsPrec p h . showString " at position " . shows pos diff --git a/libraries/base/GHC/IO/Handle/Types.hs b/libraries/base/GHC/IO/Handle/Types.hs index b7de4ab95b..8f739810c4 100644 --- a/libraries/base/GHC/IO/Handle/Types.hs +++ b/libraries/base/GHC/IO/Handle/Types.hs @@ -112,6 +112,7 @@ data Handle -- * A 'FileHandle' is seekable. A 'DuplexHandle' may or may not be -- seekable. +-- | @since 4.1.0.0 instance Eq Handle where (FileHandle _ h1) == (FileHandle _ h2) = h1 == h2 (DuplexHandle _ h1 _) == (DuplexHandle _ h2 _) = h1 == h2 @@ -407,6 +408,7 @@ noNewlineTranslation = NewlineMode { inputNL = LF, outputNL = LF } -- we provide a more user-friendly Show instance for it -- than the derived one. +-- | @since 4.1.0.0 instance Show HandleType where showsPrec _ t = case t of @@ -417,6 +419,7 @@ instance Show HandleType where AppendHandle -> showString "writable (append)" ReadWriteHandle -> showString "read-writable" +-- | @since 4.1.0.0 instance Show Handle where showsPrec _ (FileHandle file _) = showHandle file showsPrec _ (DuplexHandle file _ _) = showHandle file diff --git a/libraries/base/GHC/IOArray.hs b/libraries/base/GHC/IOArray.hs index f089cad933..733e58d976 100644 --- a/libraries/base/GHC/IOArray.hs +++ b/libraries/base/GHC/IOArray.hs @@ -44,6 +44,7 @@ newtype IOArray i e = IOArray (STArray RealWorld i e) type role IOArray nominal representational -- explicit instance because Haddock can't figure out a derived one +-- | @since 4.1.0.0 instance Eq (IOArray i e) where IOArray x == IOArray y = x == y diff --git a/libraries/base/GHC/IORef.hs b/libraries/base/GHC/IORef.hs index a0ed0823ed..0736567975 100644 --- a/libraries/base/GHC/IORef.hs +++ b/libraries/base/GHC/IORef.hs @@ -33,6 +33,7 @@ import GHC.IO newtype IORef a = IORef (STRef RealWorld a) -- explicit instance because Haddock can't figure out a derived one +-- | @since 4.1.0.0 instance Eq (IORef a) where IORef x == IORef y = x == y diff --git a/libraries/base/GHC/Int.hs b/libraries/base/GHC/Int.hs index cad6607a99..ad2a872c39 100644 --- a/libraries/base/GHC/Int.hs +++ b/libraries/base/GHC/Int.hs @@ -58,6 +58,7 @@ data {-# CTYPE "HsInt8" #-} Int8 = I8# Int# -- ^ 8-bit signed integer type -- See GHC.Classes#matching_overloaded_methods_in_rules +-- | @since 2.01 instance Eq Int8 where (==) = eqInt8 (/=) = neInt8 @@ -68,6 +69,7 @@ neInt8 (I8# x) (I8# y) = isTrue# (x /=# y) {-# INLINE [1] eqInt8 #-} {-# INLINE [1] neInt8 #-} +-- | @since 2.01 instance Ord Int8 where (<) = ltInt8 (<=) = leInt8 @@ -84,9 +86,11 @@ gtInt8, geInt8, ltInt8, leInt8 :: Int8 -> Int8 -> Bool (I8# x) `ltInt8` (I8# y) = isTrue# (x <# y) (I8# x) `leInt8` (I8# y) = isTrue# (x <=# y) +-- | @since 2.01 instance Show Int8 where showsPrec p x = showsPrec p (fromIntegral x :: Int) +-- | @since 2.01 instance Num Int8 where (I8# x#) + (I8# y#) = I8# (narrow8Int# (x# +# y#)) (I8# x#) - (I8# y#) = I8# (narrow8Int# (x# -# y#)) @@ -99,9 +103,11 @@ instance Num Int8 where signum _ = -1 fromInteger i = I8# (narrow8Int# (integerToInt i)) +-- | @since 2.01 instance Real Int8 where toRational x = toInteger x % 1 +-- | @since 2.01 instance Enum Int8 where succ x | x /= maxBound = x + 1 @@ -117,6 +123,7 @@ instance Enum Int8 where enumFrom = boundedEnumFrom enumFromThen = boundedEnumFromThen +-- | @since 2.01 instance Integral Int8 where quot x@(I8# x#) y@(I8# y#) | y == 0 = divZeroError @@ -150,18 +157,22 @@ instance Integral Int8 where I8# (narrow8Int# m)) toInteger (I8# x#) = smallInteger x# +-- | @since 2.01 instance Bounded Int8 where minBound = -0x80 maxBound = 0x7F +-- | @since 2.01 instance Ix Int8 where range (m,n) = [m..n] unsafeIndex (m,_) i = fromIntegral i - fromIntegral m inRange (m,n) i = m <= i && i <= n +-- | @since 2.01 instance Read Int8 where readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s] +-- | @since 2.01 instance Bits Int8 where {-# INLINE shift #-} {-# INLINE bit #-} @@ -194,6 +205,7 @@ instance Bits Int8 where bit = bitDefault testBit = testBitDefault +-- | @since 4.6.0.0 instance FiniteBits Int8 where finiteBitSize _ = 8 countLeadingZeros (I8# x#) = I# (word2Int# (clz8# (int2Word# x#))) @@ -246,6 +258,7 @@ data {-# CTYPE "HsInt16" #-} Int16 = I16# Int# -- ^ 16-bit signed integer type -- See GHC.Classes#matching_overloaded_methods_in_rules +-- | @since 2.01 instance Eq Int16 where (==) = eqInt16 (/=) = neInt16 @@ -256,6 +269,7 @@ neInt16 (I16# x) (I16# y) = isTrue# (x /=# y) {-# INLINE [1] eqInt16 #-} {-# INLINE [1] neInt16 #-} +-- | @since 2.01 instance Ord Int16 where (<) = ltInt16 (<=) = leInt16 @@ -272,9 +286,11 @@ gtInt16, geInt16, ltInt16, leInt16 :: Int16 -> Int16 -> Bool (I16# x) `ltInt16` (I16# y) = isTrue# (x <# y) (I16# x) `leInt16` (I16# y) = isTrue# (x <=# y) +-- | @since 2.01 instance Show Int16 where showsPrec p x = showsPrec p (fromIntegral x :: Int) +-- | @since 2.01 instance Num Int16 where (I16# x#) + (I16# y#) = I16# (narrow16Int# (x# +# y#)) (I16# x#) - (I16# y#) = I16# (narrow16Int# (x# -# y#)) @@ -287,9 +303,11 @@ instance Num Int16 where signum _ = -1 fromInteger i = I16# (narrow16Int# (integerToInt i)) +-- | @since 2.01 instance Real Int16 where toRational x = toInteger x % 1 +-- | @since 2.01 instance Enum Int16 where succ x | x /= maxBound = x + 1 @@ -305,6 +323,7 @@ instance Enum Int16 where enumFrom = boundedEnumFrom enumFromThen = boundedEnumFromThen +-- | @since 2.01 instance Integral Int16 where quot x@(I16# x#) y@(I16# y#) | y == 0 = divZeroError @@ -338,18 +357,22 @@ instance Integral Int16 where I16# (narrow16Int# m)) toInteger (I16# x#) = smallInteger x# +-- | @since 2.01 instance Bounded Int16 where minBound = -0x8000 maxBound = 0x7FFF +-- | @since 2.01 instance Ix Int16 where range (m,n) = [m..n] unsafeIndex (m,_) i = fromIntegral i - fromIntegral m inRange (m,n) i = m <= i && i <= n +-- | @since 2.01 instance Read Int16 where readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s] +-- | @since 2.01 instance Bits Int16 where {-# INLINE shift #-} {-# INLINE bit #-} @@ -382,6 +405,7 @@ instance Bits Int16 where bit = bitDefault testBit = testBitDefault +-- | @since 4.6.0.0 instance FiniteBits Int16 where finiteBitSize _ = 16 countLeadingZeros (I16# x#) = I# (word2Int# (clz16# (int2Word# x#))) @@ -439,6 +463,7 @@ data {-# CTYPE "HsInt32" #-} Int32 = I32# Int# -- ^ 32-bit signed integer type -- See GHC.Classes#matching_overloaded_methods_in_rules +-- | @since 2.01 instance Eq Int32 where (==) = eqInt32 (/=) = neInt32 @@ -449,6 +474,7 @@ neInt32 (I32# x) (I32# y) = isTrue# (x /=# y) {-# INLINE [1] eqInt32 #-} {-# INLINE [1] neInt32 #-} +-- | @since 2.01 instance Ord Int32 where (<) = ltInt32 (<=) = leInt32 @@ -465,9 +491,11 @@ gtInt32, geInt32, ltInt32, leInt32 :: Int32 -> Int32 -> Bool (I32# x) `ltInt32` (I32# y) = isTrue# (x <# y) (I32# x) `leInt32` (I32# y) = isTrue# (x <=# y) +-- | @since 2.01 instance Show Int32 where showsPrec p x = showsPrec p (fromIntegral x :: Int) +-- | @since 2.01 instance Num Int32 where (I32# x#) + (I32# y#) = I32# (narrow32Int# (x# +# y#)) (I32# x#) - (I32# y#) = I32# (narrow32Int# (x# -# y#)) @@ -480,6 +508,7 @@ instance Num Int32 where signum _ = -1 fromInteger i = I32# (narrow32Int# (integerToInt i)) +-- | @since 2.01 instance Enum Int32 where succ x | x /= maxBound = x + 1 @@ -499,6 +528,7 @@ instance Enum Int32 where enumFrom = boundedEnumFrom enumFromThen = boundedEnumFromThen +-- | @since 2.01 instance Integral Int32 where quot x@(I32# x#) y@(I32# y#) | y == 0 = divZeroError @@ -540,9 +570,11 @@ instance Integral Int32 where I32# (narrow32Int# m)) toInteger (I32# x#) = smallInteger x# +-- | @since 2.01 instance Read Int32 where readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s] +-- | @since 2.01 instance Bits Int32 where {-# INLINE shift #-} {-# INLINE bit #-} @@ -576,6 +608,7 @@ instance Bits Int32 where bit = bitDefault testBit = testBitDefault +-- | @since 4.6.0.0 instance FiniteBits Int32 where finiteBitSize _ = 32 countLeadingZeros (I32# x#) = I# (word2Int# (clz32# (int2Word# x#))) @@ -621,13 +654,16 @@ instance FiniteBits Int32 where round = (fromIntegral :: Int -> Int32) . (round :: Double -> Int) #-} +-- | @since 2.01 instance Real Int32 where toRational x = toInteger x % 1 +-- | @since 2.01 instance Bounded Int32 where minBound = -0x80000000 maxBound = 0x7FFFFFFF +-- | @since 2.01 instance Ix Int32 where range (m,n) = [m..n] unsafeIndex (m,_) i = fromIntegral i - fromIntegral m @@ -643,6 +679,7 @@ data {-# CTYPE "HsInt64" #-} Int64 = I64# Int64# -- ^ 64-bit signed integer type -- See GHC.Classes#matching_overloaded_methods_in_rules +-- | @since 2.01 instance Eq Int64 where (==) = eqInt64 (/=) = neInt64 @@ -653,6 +690,7 @@ neInt64 (I64# x) (I64# y) = isTrue# (x `neInt64#` y) {-# INLINE [1] eqInt64 #-} {-# INLINE [1] neInt64 #-} +-- | @since 2.01 instance Ord Int64 where (<) = ltInt64 (<=) = leInt64 @@ -669,9 +707,11 @@ gtInt64, geInt64, ltInt64, leInt64 :: Int64 -> Int64 -> Bool (I64# x) `ltInt64` (I64# y) = isTrue# (x `ltInt64#` y) (I64# x) `leInt64` (I64# y) = isTrue# (x `leInt64#` y) +-- | @since 2.01 instance Show Int64 where showsPrec p x = showsPrec p (toInteger x) +-- | @since 2.01 instance Num Int64 where (I64# x#) + (I64# y#) = I64# (x# `plusInt64#` y#) (I64# x#) - (I64# y#) = I64# (x# `minusInt64#` y#) @@ -684,6 +724,7 @@ instance Num Int64 where signum _ = -1 fromInteger i = I64# (integerToInt64 i) +-- | @since 2.01 instance Enum Int64 where succ x | x /= maxBound = x + 1 @@ -701,6 +742,7 @@ instance Enum Int64 where enumFromTo = integralEnumFromTo enumFromThenTo = integralEnumFromThenTo +-- | @since 2.01 instance Integral Int64 where quot x@(I64# x#) y@(I64# y#) | y == 0 = divZeroError @@ -762,9 +804,11 @@ x# `modInt64#` y# !zero = intToInt64# 0# !r# = x# `remInt64#` y# +-- | @since 2.01 instance Read Int64 where readsPrec p s = [(fromInteger x, r) | (x, r) <- readsPrec p s] +-- | @since 2.01 instance Bits Int64 where {-# INLINE shift #-} {-# INLINE bit #-} @@ -835,6 +879,7 @@ data {-# CTYPE "HsInt64" #-} Int64 = I64# Int# -- ^ 64-bit signed integer type -- See GHC.Classes#matching_overloaded_methods_in_rules +-- | @since 2.01 instance Eq Int64 where (==) = eqInt64 (/=) = neInt64 @@ -845,6 +890,7 @@ neInt64 (I64# x) (I64# y) = isTrue# (x /=# y) {-# INLINE [1] eqInt64 #-} {-# INLINE [1] neInt64 #-} +-- | @since 2.01 instance Ord Int64 where (<) = ltInt64 (<=) = leInt64 @@ -861,9 +907,11 @@ gtInt64, geInt64, ltInt64, leInt64 :: Int64 -> Int64 -> Bool (I64# x) `ltInt64` (I64# y) = isTrue# (x <# y) (I64# x) `leInt64` (I64# y) = isTrue# (x <=# y) +-- | @since 2.01 instance Show Int64 where showsPrec p x = showsPrec p (fromIntegral x :: Int) +-- | @since 2.01 instance Num Int64 where (I64# x#) + (I64# y#) = I64# (x# +# y#) (I64# x#) - (I64# y#) = I64# (x# -# y#) @@ -876,6 +924,7 @@ instance Num Int64 where signum _ = -1 fromInteger i = I64# (integerToInt i) +-- | @since 2.01 instance Enum Int64 where succ x | x /= maxBound = x + 1 @@ -888,6 +937,7 @@ instance Enum Int64 where enumFrom = boundedEnumFrom enumFromThen = boundedEnumFromThen +-- | @since 2.01 instance Integral Int64 where quot x@(I64# x#) y@(I64# y#) | y == 0 = divZeroError @@ -927,9 +977,11 @@ instance Integral Int64 where (I64# d, I64# m) toInteger (I64# x#) = smallInteger x# +-- | @since 2.01 instance Read Int64 where readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s] +-- | @since 2.01 instance Bits Int64 where {-# INLINE shift #-} {-# INLINE bit #-} @@ -1004,6 +1056,7 @@ uncheckedIShiftRA64# :: Int# -> Int# -> Int# uncheckedIShiftRA64# = uncheckedIShiftRA# #endif +-- | @since 4.6.0.0 instance FiniteBits Int64 where finiteBitSize _ = 64 #if WORD_SIZE_IN_BITS < 64 @@ -1014,13 +1067,16 @@ instance FiniteBits Int64 where countTrailingZeros (I64# x#) = I# (word2Int# (ctz64# (int2Word# x#))) #endif +-- | @since 2.01 instance Real Int64 where toRational x = toInteger x % 1 +-- | @since 2.01 instance Bounded Int64 where minBound = -0x8000000000000000 maxBound = 0x7FFFFFFFFFFFFFFF +-- | @since 2.01 instance Ix Int64 where range (m,n) = [m..n] unsafeIndex (m,_) i = fromIntegral i - fromIntegral m diff --git a/libraries/base/GHC/MVar.hs b/libraries/base/GHC/MVar.hs index 6cbbe7bfb6..d367f2ba06 100644 --- a/libraries/base/GHC/MVar.hs +++ b/libraries/base/GHC/MVar.hs @@ -42,6 +42,7 @@ as a a box, which may be empty or full. -} -- pull in Eq (Mvar a) too, to avoid GHC.Conc being an orphan-instance module +-- | @since 4.1.0.0 instance Eq (MVar a) where (MVar mvar1#) == (MVar mvar2#) = isTrue# (sameMVar# mvar1# mvar2#) diff --git a/libraries/base/GHC/Natural.hs b/libraries/base/GHC/Natural.hs index e756f0d07f..953b2a4c26 100644 --- a/libraries/base/GHC/Natural.hs +++ b/libraries/base/GHC/Natural.hs @@ -150,14 +150,17 @@ isValidNatural (NatJ# bn) = isTrue# (isValidBigNat# bn) #-} #endif +-- | @since 4.8.0.0 instance Show Natural where showsPrec p (NatS# w#) = showsPrec p (W# w#) showsPrec p (NatJ# bn) = showsPrec p (Jp# bn) +-- | @since 4.8.0.0 instance Read Natural where readsPrec d = map (\(n, s) -> (fromInteger n, s)) . filter ((>= 0) . (\(x,_)->x)) . readsPrec d +-- | @since 4.8.0.0 instance Num Natural where fromInteger (S# i#) | I# i# >= 0 = NatS# (int2Word# i#) fromInteger (Jp# bn) = bigNatToNatural bn @@ -175,6 +178,7 @@ instance Num Natural where negate (NatS# 0##) = NatS# 0## negate _ = throw Underflow +-- | @since 4.8.0.0 instance Real Natural where toRational (NatS# w) = toRational (W# w) toRational (NatJ# bn) = toRational (Jp# bn) @@ -206,6 +210,7 @@ lcmNatural x y = (x `quot` (gcdNatural x y)) * y #endif +-- | @since 4.8.0.0 instance Enum Natural where succ n = n `plusNatural` NatS# 1## pred n = n `minusNatural` NatS# 1## @@ -248,6 +253,7 @@ enumNegDeltaToNatural x0 ndelta lim = go x0 ---------------------------------------------------------------------------- +-- | @since 4.8.0.0 instance Integral Natural where toInteger (NatS# w) = wordToInteger w toInteger (NatJ# bn) = Jp# bn @@ -280,6 +286,7 @@ instance Integral Natural where rem (NatJ# n) (NatS# d) = NatS# (remBigNatWord n d) rem (NatJ# n) (NatJ# d) = bigNatToNatural (remBigNat n d) +-- | @since 4.8.0.0 instance Ix Natural where range (m,n) = [m..n] inRange (m,n) i = m <= i && i <= n @@ -288,6 +295,7 @@ instance Ix Natural where | otherwise = indexError b i "Natural" +-- | @since 4.8.0.0 instance Bits Natural where NatS# n .&. NatS# m = wordToNatural (W# n .&. W# m) NatS# n .&. NatJ# m = wordToNatural (W# n .&. W# (bigNatToWord m)) @@ -444,13 +452,16 @@ newtype Natural = Natural Integer -- ^ __Invariant__: non-negative 'Integer' isValidNatural :: Natural -> Bool isValidNatural (Natural i) = i >= 0 +-- | @since 4.8.0.0 instance Read Natural where readsPrec d = map (\(n, s) -> (Natural n, s)) . filter ((>= 0) . (\(x,_)->x)) . readsPrec d +-- | @since 4.8.0.0 instance Show Natural where showsPrec d (Natural i) = showsPrec d i +-- | @since 4.8.0.0 instance Num Natural where Natural n + Natural m = Natural (n + m) {-# INLINE (+) #-} @@ -477,6 +488,7 @@ minusNaturalMaybe x y | x >= y = Just (x - y) | otherwise = Nothing +-- | @since 4.8.0.0 instance Bits Natural where Natural n .&. Natural m = Natural (n .&. m) {-# INLINE (.&.) #-} @@ -518,10 +530,12 @@ instance Bits Natural where {-# INLINE popCount #-} zeroBits = Natural 0 +-- | @since 4.8.0.0 instance Real Natural where toRational (Natural a) = toRational a {-# INLINE toRational #-} +-- | @since 4.8.0.0 instance Enum Natural where pred (Natural 0) = errorWithoutStackTrace "Natural.pred: 0" pred (Natural n) = Natural (pred n) @@ -543,6 +557,7 @@ instance Enum Natural where enumFromThenTo = coerce (enumFromThenTo :: Integer -> Integer -> Integer -> [Integer]) +-- | @since 4.8.0.0 instance Integral Natural where quot (Natural a) (Natural b) = Natural (quot a b) {-# INLINE quot #-} @@ -593,6 +608,7 @@ naturalToWordMaybe (Natural i) naturalType :: DataType naturalType = mkIntType "Numeric.Natural.Natural" +-- | @since 4.8.0.0 instance Data Natural where toConstr x = mkIntegralConstr naturalType x gunfold _ z c = case constrRep c of diff --git a/libraries/base/GHC/Num.hs b/libraries/base/GHC/Num.hs index 5d46dacedd..fd98c19f20 100644 --- a/libraries/base/GHC/Num.hs +++ b/libraries/base/GHC/Num.hs @@ -64,6 +64,7 @@ class Num a where subtract :: (Num a) => a -> a -> a subtract x y = y - x +-- | @since 2.01 instance Num Int where I# x + I# y = I# (x +# y) I# x - I# y = I# (x -# y) @@ -78,6 +79,7 @@ instance Num Int where {-# INLINE fromInteger #-} -- Just to be sure! fromInteger i = I# (integerToInt i) +-- | @since 2.01 instance Num Word where (W# x#) + (W# y#) = W# (x# `plusWord#` y#) (W# x#) - (W# y#) = W# (x# `minusWord#` y#) @@ -88,6 +90,7 @@ instance Num Word where signum _ = 1 fromInteger i = W# (integerToWord i) +-- | @since 2.01 instance Num Integer where (+) = plusInteger (-) = minusInteger diff --git a/libraries/base/GHC/Ptr.hs b/libraries/base/GHC/Ptr.hs index def63b7613..93f6d64ae5 100644 --- a/libraries/base/GHC/Ptr.hs +++ b/libraries/base/GHC/Ptr.hs @@ -163,6 +163,7 @@ castPtrToFunPtr (Ptr addr) = FunPtr addr ------------------------------------------------------------------------ -- Show instances for Ptr and FunPtr +-- | @since 2.01 instance Show (Ptr a) where showsPrec _ (Ptr a) rs = pad_out (showHex (wordToInteger(int2Word#(addr2Int# a))) "") where @@ -170,5 +171,6 @@ instance Show (Ptr a) where pad_out ls = '0':'x':(replicate (2*SIZEOF_HSPTR - length ls) '0') ++ ls ++ rs +-- | @since 2.01 instance Show (FunPtr a) where showsPrec p = showsPrec p . castFunPtrToPtr diff --git a/libraries/base/GHC/RTS/Flags.hsc b/libraries/base/GHC/RTS/Flags.hsc index 12cead7821..b83963ec4f 100644 --- a/libraries/base/GHC/RTS/Flags.hsc +++ b/libraries/base/GHC/RTS/Flags.hsc @@ -75,6 +75,7 @@ data GiveGCStats | VerboseGCStats deriving (Show) +-- | @since 4.8.0.0 instance Enum GiveGCStats where fromEnum NoGCStats = #{const NO_GC_STATS} fromEnum CollectGCStats = #{const COLLECT_GC_STATS} @@ -173,6 +174,7 @@ data DoCostCentres | CostCentresXML deriving (Show) +-- | @since 4.8.0.0 instance Enum DoCostCentres where fromEnum CostCentresNone = #{const COST_CENTRES_NONE} fromEnum CostCentresSummary = #{const COST_CENTRES_SUMMARY} @@ -210,6 +212,7 @@ data DoHeapProfile | HeapByClosureType deriving (Show) +-- | @since 4.8.0.0 instance Enum DoHeapProfile where fromEnum NoHeapProfiling = #{const NO_HEAP_PROFILING} fromEnum HeapByCCS = #{const HEAP_BY_CCS} @@ -259,6 +262,7 @@ data DoTrace | TraceStderr -- ^ send tracing events to @stderr@ deriving (Show) +-- | @since 4.8.0.0 instance Enum DoTrace where fromEnum TraceNone = #{const TRACE_NONE} fromEnum TraceEventLog = #{const TRACE_EVENTLOG} diff --git a/libraries/base/GHC/Read.hs b/libraries/base/GHC/Read.hs index b4b88c0e9d..54fbc287a8 100644 --- a/libraries/base/GHC/Read.hs +++ b/libraries/base/GHC/Read.hs @@ -314,6 +314,7 @@ choose sps = foldr ((+++) . try_one) pfail sps deriving instance Read GeneralCategory +-- | @since 2.01 instance Read Char where readPrec = parens @@ -331,6 +332,7 @@ instance Read Char where readList = readListDefault +-- | @since 2.01 instance Read Bool where readPrec = parens @@ -344,6 +346,7 @@ instance Read Bool where readListPrec = readListPrecDefault readList = readListDefault +-- | @since 2.01 instance Read Ordering where readPrec = parens @@ -385,6 +388,7 @@ parenthesis-like objects such as (...) and [...] can be an argument to 'Just'. -} +-- | @since 2.01 instance Read a => Read (Maybe a) where readPrec = parens @@ -400,6 +404,7 @@ instance Read a => Read (Maybe a) where readListPrec = readListPrecDefault readList = readListDefault +-- | @since 2.01 instance Read a => Read [a] where {-# SPECIALISE instance Read [String] #-} {-# SPECIALISE instance Read [Char] #-} @@ -408,6 +413,7 @@ instance Read a => Read [a] where readListPrec = readListPrecDefault readList = readListDefault +-- | @since 2.01 instance (Ix a, Read a, Read b) => Read (Array a b) where readPrec = parens $ prec appPrec $ do expectP (L.Ident "array") @@ -418,6 +424,7 @@ instance (Ix a, Read a, Read b) => Read (Array a b) where readListPrec = readListPrecDefault readList = readListDefault +-- | @since 2.01 instance Read L.Lexeme where readPrec = lexP readListPrec = readListPrecDefault @@ -455,29 +462,35 @@ convertFrac (L.Number n) = let resRange = floatRange (undefined :: a) Just rat -> return $ fromRational rat convertFrac _ = pfail +-- | @since 2.01 instance Read Int where readPrec = readNumber convertInt readListPrec = readListPrecDefault readList = readListDefault +-- | @since 4.5.0.0 instance Read Word where readsPrec p s = [(fromInteger x, r) | (x, r) <- readsPrec p s] +-- | @since 2.01 instance Read Integer where readPrec = readNumber convertInt readListPrec = readListPrecDefault readList = readListDefault +-- | @since 2.01 instance Read Float where readPrec = readNumber convertFrac readListPrec = readListPrecDefault readList = readListDefault +-- | @since 2.01 instance Read Double where readPrec = readNumber convertFrac readListPrec = readListPrecDefault readList = readListDefault +-- | @since 2.01 instance (Integral a, Read a) => Read (Ratio a) where readPrec = parens @@ -497,6 +510,7 @@ instance (Integral a, Read a) => Read (Ratio a) where -- Tuple instances of Read, up to size 15 ------------------------------------------------------------------------ +-- | @since 2.01 instance Read () where readPrec = parens @@ -508,6 +522,7 @@ instance Read () where readListPrec = readListPrecDefault readList = readListDefault +-- | @since 2.01 instance (Read a, Read b) => Read (a,b) where readPrec = wrap_tup read_tup2 readListPrec = readListPrecDefault @@ -541,6 +556,7 @@ read_tup8 = do (a,b,c,d) <- read_tup4 return (a,b,c,d,e,f,g,h) +-- | @since 2.01 instance (Read a, Read b, Read c) => Read (a, b, c) where readPrec = wrap_tup (do { (a,b) <- read_tup2; read_comma ; c <- readPrec @@ -548,11 +564,13 @@ instance (Read a, Read b, Read c) => Read (a, b, c) where readListPrec = readListPrecDefault readList = readListDefault +-- | @since 2.01 instance (Read a, Read b, Read c, Read d) => Read (a, b, c, d) where readPrec = wrap_tup read_tup4 readListPrec = readListPrecDefault readList = readListDefault +-- | @since 2.01 instance (Read a, Read b, Read c, Read d, Read e) => Read (a, b, c, d, e) where readPrec = wrap_tup (do { (a,b,c,d) <- read_tup4; read_comma ; e <- readPrec @@ -560,6 +578,7 @@ instance (Read a, Read b, Read c, Read d, Read e) => Read (a, b, c, d, e) where readListPrec = readListPrecDefault readList = readListDefault +-- | @since 2.01 instance (Read a, Read b, Read c, Read d, Read e, Read f) => Read (a, b, c, d, e, f) where readPrec = wrap_tup (do { (a,b,c,d) <- read_tup4; read_comma @@ -568,6 +587,7 @@ instance (Read a, Read b, Read c, Read d, Read e, Read f) readListPrec = readListPrecDefault readList = readListDefault +-- | @since 2.01 instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g) => Read (a, b, c, d, e, f, g) where readPrec = wrap_tup (do { (a,b,c,d) <- read_tup4; read_comma @@ -577,12 +597,14 @@ instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g) readListPrec = readListPrecDefault readList = readListDefault +-- | @since 2.01 instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h) => Read (a, b, c, d, e, f, g, h) where readPrec = wrap_tup read_tup8 readListPrec = readListPrecDefault readList = readListDefault +-- | @since 2.01 instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h, Read i) => Read (a, b, c, d, e, f, g, h, i) where @@ -592,6 +614,7 @@ instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h, readListPrec = readListPrecDefault readList = readListDefault +-- | @since 2.01 instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h, Read i, Read j) => Read (a, b, c, d, e, f, g, h, i, j) where @@ -601,6 +624,7 @@ instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h, readListPrec = readListPrecDefault readList = readListDefault +-- | @since 2.01 instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h, Read i, Read j, Read k) => Read (a, b, c, d, e, f, g, h, i, j, k) where @@ -611,6 +635,7 @@ instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h, readListPrec = readListPrecDefault readList = readListDefault +-- | @since 2.01 instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h, Read i, Read j, Read k, Read l) => Read (a, b, c, d, e, f, g, h, i, j, k, l) where @@ -620,6 +645,7 @@ instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h, readListPrec = readListPrecDefault readList = readListDefault +-- | @since 2.01 instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h, Read i, Read j, Read k, Read l, Read m) => Read (a, b, c, d, e, f, g, h, i, j, k, l, m) where @@ -630,6 +656,7 @@ instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h, readListPrec = readListPrecDefault readList = readListDefault +-- | @since 2.01 instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h, Read i, Read j, Read k, Read l, Read m, Read n) => Read (a, b, c, d, e, f, g, h, i, j, k, l, m, n) where @@ -640,6 +667,7 @@ instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h, readListPrec = readListPrecDefault readList = readListDefault +-- | @since 2.01 instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h, Read i, Read j, Read k, Read l, Read m, Read n, Read o) => Read (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) where diff --git a/libraries/base/GHC/Real.hs b/libraries/base/GHC/Real.hs index 3a97f1f18c..fbd9f16483 100644 --- a/libraries/base/GHC/Real.hs +++ b/libraries/base/GHC/Real.hs @@ -236,9 +236,11 @@ numericEnumFromThenTo e1 e2 e3 -- Instances for Int -------------------------------------------------------------- +-- | @since 2.0.1 instance Real Int where toRational x = toInteger x :% 1 +-- | @since 2.0.1 instance Integral Int where toInteger (I# i) = smallInteger i @@ -286,9 +288,11 @@ instance Integral Int where -- Instances for @Word@ -------------------------------------------------------------- +-- | @since 2.01 instance Real Word where toRational x = toInteger x % 1 +-- | @since 2.01 instance Integral Word where quot (W# x#) y@(W# y#) | y /= 0 = W# (x# `quotWord#` y#) @@ -316,6 +320,7 @@ instance Integral Word where -- Instances for Integer -------------------------------------------------------------- +-- | @since 2.0.1 instance Real Integer where toRational x = x :% 1 @@ -331,6 +336,7 @@ instance Real Integer where -- happen because they are all marked with NOINLINE pragma - see documentation -- of integer-gmp or integer-simple. +-- | @since 2.0.1 instance Integral Integer where toInteger n = n @@ -364,11 +370,13 @@ instance Integral Integer where -- Instances for @Ratio@ -------------------------------------------------------------- +-- | @since 2.0.1 instance (Integral a) => Ord (Ratio a) where {-# SPECIALIZE instance Ord Rational #-} (x:%y) <= (x':%y') = x * y' <= x' * y (x:%y) < (x':%y') = x * y' < x' * y +-- | @since 2.0.1 instance (Integral a) => Num (Ratio a) where {-# SPECIALIZE instance Num Rational #-} (x:%y) + (x':%y') = reduce (x*y' + x'*y) (y*y') @@ -379,6 +387,7 @@ instance (Integral a) => Num (Ratio a) where signum (x:%_) = signum x :% 1 fromInteger x = fromInteger x :% 1 +-- | @since 2.0.1 {-# RULES "fromRational/id" fromRational = id :: Rational -> Rational #-} instance (Integral a) => Fractional (Ratio a) where {-# SPECIALIZE instance Fractional Rational #-} @@ -389,15 +398,18 @@ instance (Integral a) => Fractional (Ratio a) where | otherwise = y :% x fromRational (x:%y) = fromInteger x % fromInteger y +-- | @since 2.0.1 instance (Integral a) => Real (Ratio a) where {-# SPECIALIZE instance Real Rational #-} toRational (x:%y) = toInteger x :% toInteger y +-- | @since 2.0.1 instance (Integral a) => RealFrac (Ratio a) where {-# SPECIALIZE instance RealFrac Rational #-} properFraction (x:%y) = (fromInteger (toInteger q), r:%y) where (q,r) = quotRem x y +-- | @since 2.0.1 instance (Show a) => Show (Ratio a) where {-# SPECIALIZE instance Show Rational #-} showsPrec p (x:%y) = showParen (p > ratioPrec) $ @@ -409,6 +421,7 @@ instance (Show a) => Show (Ratio a) where -- Haskell 98 [Sep 08, #1920] showsPrec ratioPrec1 y +-- | @since 2.0.1 instance (Integral a) => Enum (Ratio a) where {-# SPECIALIZE instance Enum Rational #-} succ x = x + 1 diff --git a/libraries/base/GHC/ST.hs b/libraries/base/GHC/ST.hs index d84dd4d9d1..dc5c71fe68 100644 --- a/libraries/base/GHC/ST.hs +++ b/libraries/base/GHC/ST.hs @@ -52,11 +52,13 @@ default () newtype ST s a = ST (STRep s a) type STRep s a = State# s -> (# State# s, a #) +-- | @since 2.01 instance Functor (ST s) where fmap f (ST m) = ST $ \ s -> case (m s) of { (# new_s, r #) -> (# new_s, f r #) } +-- | @since 4.4.0.0 instance Applicative (ST s) where {-# INLINE pure #-} {-# INLINE (*>) #-} @@ -64,6 +66,7 @@ instance Applicative (ST s) where m *> k = m >>= \ _ -> k (<*>) = ap +-- | @since 2.01 instance Monad (ST s) where {-# INLINE (>>=) #-} (>>) = (*>) @@ -99,6 +102,7 @@ fixST k = ST $ \ s -> in case ans of STret s' x -> (# s', x #) +-- | @since 2.01 instance Show (ST s a) where showsPrec _ _ = showString "<<ST action>>" showList = showList__ (showsPrec 0) diff --git a/libraries/base/GHC/STRef.hs b/libraries/base/GHC/STRef.hs index 9997f72681..22db7f32db 100644 --- a/libraries/base/GHC/STRef.hs +++ b/libraries/base/GHC/STRef.hs @@ -45,5 +45,6 @@ writeSTRef (STRef var#) val = ST $ \s1# -> (# s2#, () #) } -- Just pointer equality on mutable references: +-- | @since 2.01 instance Eq (STRef s a) where STRef v1# == STRef v2# = isTrue# (sameMutVar# v1# v2#) diff --git a/libraries/base/GHC/Show.hs b/libraries/base/GHC/Show.hs index 72a73200b5..46fc8fe307 100644 --- a/libraries/base/GHC/Show.hs +++ b/libraries/base/GHC/Show.hs @@ -165,6 +165,7 @@ appPrec1 = I# 11# -- appPrec + 1 deriving instance Show () +-- | @since 2.01 instance Show a => Show [a] where {-# SPECIALISE instance Show [String] #-} {-# SPECIALISE instance Show [Char] #-} @@ -174,15 +175,18 @@ instance Show a => Show [a] where deriving instance Show Bool deriving instance Show Ordering +-- | @since 2.01 instance Show Char where showsPrec _ '\'' = showString "'\\''" showsPrec _ c = showChar '\'' . showLitChar c . showChar '\'' showList cs = showChar '"' . showLitString cs . showChar '"' +-- | @since 2.01 instance Show Int where showsPrec = showSignedInt +-- | @since 2.01 instance Show Word where showsPrec _ (W# w) = showWord w @@ -195,16 +199,20 @@ showWord w# cs deriving instance Show a => Show (Maybe a) +-- | @since 2.01 instance Show TyCon where showsPrec p (TyCon _ _ _ tc_name) = showsPrec p tc_name +-- | @since 4.9.0.0 instance Show TrName where showsPrec _ (TrNameS s) = showString (unpackCString# s) showsPrec _ (TrNameD s) = showString s +-- | @since 4.9.0.0 instance Show Module where showsPrec _ (Module p m) = shows p . (':' :) . shows m +-- | @since 4.9.0.0 instance Show CallStack where showsPrec _ = shows . getCallStack @@ -220,49 +228,60 @@ deriving instance Show SrcLoc -- showsPrec _ (x,y) = let sx = shows x; sy = shows y in -- \s -> showChar '(' (sx (showChar ',' (sy (showChar ')' s)))) +-- | @since 2.01 instance (Show a, Show b) => Show (a,b) where showsPrec _ (a,b) s = show_tuple [shows a, shows b] s +-- | @since 2.01 instance (Show a, Show b, Show c) => Show (a, b, c) where showsPrec _ (a,b,c) s = show_tuple [shows a, shows b, shows c] s +-- | @since 2.01 instance (Show a, Show b, Show c, Show d) => Show (a, b, c, d) where showsPrec _ (a,b,c,d) s = show_tuple [shows a, shows b, shows c, shows d] s +-- | @since 2.01 instance (Show a, Show b, Show c, Show d, Show e) => Show (a, b, c, d, e) where showsPrec _ (a,b,c,d,e) s = show_tuple [shows a, shows b, shows c, shows d, shows e] s +-- | @since 2.01 instance (Show a, Show b, Show c, Show d, Show e, Show f) => Show (a,b,c,d,e,f) where showsPrec _ (a,b,c,d,e,f) s = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f] s +-- | @since 2.01 instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g) => Show (a,b,c,d,e,f,g) where showsPrec _ (a,b,c,d,e,f,g) s = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g] s +-- | @since 2.01 instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h) => Show (a,b,c,d,e,f,g,h) where showsPrec _ (a,b,c,d,e,f,g,h) s = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h] s +-- | @since 2.01 instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i) => Show (a,b,c,d,e,f,g,h,i) where showsPrec _ (a,b,c,d,e,f,g,h,i) s = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h, shows i] s +-- | @since 2.01 instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j) => Show (a,b,c,d,e,f,g,h,i,j) where showsPrec _ (a,b,c,d,e,f,g,h,i,j) s = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h, shows i, shows j] s +-- | @since 2.01 instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j, Show k) => Show (a,b,c,d,e,f,g,h,i,j,k) where showsPrec _ (a,b,c,d,e,f,g,h,i,j,k) s = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h, shows i, shows j, shows k] s +-- | @since 2.01 instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j, Show k, Show l) => Show (a,b,c,d,e,f,g,h,i,j,k,l) where @@ -270,6 +289,7 @@ instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h, shows i, shows j, shows k, shows l] s +-- | @since 2.01 instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j, Show k, Show l, Show m) => Show (a,b,c,d,e,f,g,h,i,j,k,l,m) where @@ -277,6 +297,7 @@ instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h, shows i, shows j, shows k, shows l, shows m] s +-- | @since 2.01 instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j, Show k, Show l, Show m, Show n) => Show (a,b,c,d,e,f,g,h,i,j,k,l,m,n) where @@ -284,6 +305,7 @@ instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h, shows i, shows j, shows k, shows l, shows m, shows n] s +-- | @since 2.01 instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j, Show k, Show l, Show m, Show n, Show o) => Show (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) where @@ -434,6 +456,7 @@ itos n# cs -- The Integer instances for Show -------------------------------------------------------------- +-- | @since 2.01 instance Show Integer where showsPrec p n r | p > 6 && n < 0 = '(' : integerToString n (')' : r) diff --git a/libraries/base/GHC/Stable.hs b/libraries/base/GHC/Stable.hs index 4ccfd04877..73095bd44a 100644 --- a/libraries/base/GHC/Stable.hs +++ b/libraries/base/GHC/Stable.hs @@ -101,6 +101,7 @@ castStablePtrToPtr (StablePtr s) = Ptr (unsafeCoerce# s) castPtrToStablePtr :: Ptr () -> StablePtr a castPtrToStablePtr (Ptr a) = StablePtr (unsafeCoerce# a) +-- | @since 2.1 instance Eq (StablePtr a) where (StablePtr sp1) == (StablePtr sp2) = case eqStablePtr# sp1 sp2 of diff --git a/libraries/base/GHC/StaticPtr.hs b/libraries/base/GHC/StaticPtr.hs index 1f145201ee..65ec483577 100644 --- a/libraries/base/GHC/StaticPtr.hs +++ b/libraries/base/GHC/StaticPtr.hs @@ -96,6 +96,7 @@ foreign import ccall unsafe hs_spt_lookup :: Ptr () -> IO (Ptr a) class IsStatic p where fromStaticPtr :: StaticPtr a -> p a +-- | @since 4.9.0.0 instance IsStatic StaticPtr where fromStaticPtr = id diff --git a/libraries/base/GHC/TypeLits.hs b/libraries/base/GHC/TypeLits.hs index c32eebb4dc..6d66c1109f 100644 --- a/libraries/base/GHC/TypeLits.hs +++ b/libraries/base/GHC/TypeLits.hs @@ -117,15 +117,19 @@ someSymbolVal n = withSSymbol SomeSymbol (SSymbol n) Proxy +-- | @since 4.7.0.0 instance Eq SomeNat where SomeNat x == SomeNat y = natVal x == natVal y +-- | @since 4.7.0.0 instance Ord SomeNat where compare (SomeNat x) (SomeNat y) = compare (natVal x) (natVal y) +-- | @since 4.7.0.0 instance Show SomeNat where showsPrec p (SomeNat x) = showsPrec p (natVal x) +-- | @since 4.7.0.0 instance Read SomeNat where readsPrec p xs = do (a,ys) <- readsPrec p xs case someNatVal a of @@ -133,15 +137,19 @@ instance Read SomeNat where Just n -> [(n,ys)] +-- | @since 4.7.0.0 instance Eq SomeSymbol where SomeSymbol x == SomeSymbol y = symbolVal x == symbolVal y +-- | @since 4.7.0.0 instance Ord SomeSymbol where compare (SomeSymbol x) (SomeSymbol y) = compare (symbolVal x) (symbolVal y) +-- | @since 4.7.0.0 instance Show SomeSymbol where showsPrec p (SomeSymbol x) = showsPrec p (symbolVal x) +-- | @since 4.7.0.0 instance Read SomeSymbol where readsPrec p xs = [ (someSymbolVal a, ys) | (a,ys) <- readsPrec p xs ] diff --git a/libraries/base/GHC/Word.hs b/libraries/base/GHC/Word.hs index 3424f83f71..d4a5536275 100644 --- a/libraries/base/GHC/Word.hs +++ b/libraries/base/GHC/Word.hs @@ -66,6 +66,7 @@ data {-# CTYPE "HsWord8" #-} Word8 = W8# Word# -- ^ 8-bit unsigned integer type -- See GHC.Classes#matching_overloaded_methods_in_rules +-- | @since 2.01 instance Eq Word8 where (==) = eqWord8 (/=) = neWord8 @@ -76,6 +77,7 @@ neWord8 (W8# x) (W8# y) = isTrue# (x `neWord#` y) {-# INLINE [1] eqWord8 #-} {-# INLINE [1] neWord8 #-} +-- | @since 2.01 instance Ord Word8 where (<) = ltWord8 (<=) = leWord8 @@ -92,9 +94,11 @@ gtWord8, geWord8, ltWord8, leWord8 :: Word8 -> Word8 -> Bool (W8# x) `ltWord8` (W8# y) = isTrue# (x `ltWord#` y) (W8# x) `leWord8` (W8# y) = isTrue# (x `leWord#` y) +-- | @since 2.01 instance Show Word8 where showsPrec p x = showsPrec p (fromIntegral x :: Int) +-- | @since 2.01 instance Num Word8 where (W8# x#) + (W8# y#) = W8# (narrow8Word# (x# `plusWord#` y#)) (W8# x#) - (W8# y#) = W8# (narrow8Word# (x# `minusWord#` y#)) @@ -105,9 +109,11 @@ instance Num Word8 where signum _ = 1 fromInteger i = W8# (narrow8Word# (integerToWord i)) +-- | @since 2.01 instance Real Word8 where toRational x = toInteger x % 1 +-- | @since 2.01 instance Enum Word8 where succ x | x /= maxBound = x + 1 @@ -123,6 +129,7 @@ instance Enum Word8 where enumFrom = boundedEnumFrom enumFromThen = boundedEnumFromThen +-- | @since 2.01 instance Integral Word8 where quot (W8# x#) y@(W8# y#) | y /= 0 = W8# (x# `quotWord#` y#) @@ -146,18 +153,22 @@ instance Integral Word8 where | otherwise = divZeroError toInteger (W8# x#) = smallInteger (word2Int# x#) +-- | @since 2.01 instance Bounded Word8 where minBound = 0 maxBound = 0xFF +-- | @since 2.01 instance Ix Word8 where range (m,n) = [m..n] unsafeIndex (m,_) i = fromIntegral (i - m) inRange (m,n) i = m <= i && i <= n +-- | @since 2.01 instance Read Word8 where readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s] +-- | @since 2.01 instance Bits Word8 where {-# INLINE shift #-} {-# INLINE bit #-} @@ -189,6 +200,7 @@ instance Bits Word8 where bit = bitDefault testBit = testBitDefault +-- | @since 4.6.0.0 instance FiniteBits Word8 where finiteBitSize _ = 8 countLeadingZeros (W8# x#) = I# (word2Int# (clz8# x#)) @@ -242,6 +254,7 @@ data {-# CTYPE "HsWord16" #-} Word16 = W16# Word# -- ^ 16-bit unsigned integer type -- See GHC.Classes#matching_overloaded_methods_in_rules +-- | @since 2.01 instance Eq Word16 where (==) = eqWord16 (/=) = neWord16 @@ -252,6 +265,7 @@ neWord16 (W16# x) (W16# y) = isTrue# (x `neWord#` y) {-# INLINE [1] eqWord16 #-} {-# INLINE [1] neWord16 #-} +-- | @since 2.01 instance Ord Word16 where (<) = ltWord16 (<=) = leWord16 @@ -268,9 +282,11 @@ gtWord16, geWord16, ltWord16, leWord16 :: Word16 -> Word16 -> Bool (W16# x) `ltWord16` (W16# y) = isTrue# (x `ltWord#` y) (W16# x) `leWord16` (W16# y) = isTrue# (x `leWord#` y) +-- | @since 2.01 instance Show Word16 where showsPrec p x = showsPrec p (fromIntegral x :: Int) +-- | @since 2.01 instance Num Word16 where (W16# x#) + (W16# y#) = W16# (narrow16Word# (x# `plusWord#` y#)) (W16# x#) - (W16# y#) = W16# (narrow16Word# (x# `minusWord#` y#)) @@ -281,9 +297,11 @@ instance Num Word16 where signum _ = 1 fromInteger i = W16# (narrow16Word# (integerToWord i)) +-- | @since 2.01 instance Real Word16 where toRational x = toInteger x % 1 +-- | @since 2.01 instance Enum Word16 where succ x | x /= maxBound = x + 1 @@ -299,6 +317,7 @@ instance Enum Word16 where enumFrom = boundedEnumFrom enumFromThen = boundedEnumFromThen +-- | @since 2.01 instance Integral Word16 where quot (W16# x#) y@(W16# y#) | y /= 0 = W16# (x# `quotWord#` y#) @@ -322,18 +341,22 @@ instance Integral Word16 where | otherwise = divZeroError toInteger (W16# x#) = smallInteger (word2Int# x#) +-- | @since 2.01 instance Bounded Word16 where minBound = 0 maxBound = 0xFFFF +-- | @since 2.01 instance Ix Word16 where range (m,n) = [m..n] unsafeIndex (m,_) i = fromIntegral (i - m) inRange (m,n) i = m <= i && i <= n +-- | @since 2.01 instance Read Word16 where readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s] +-- | @since 2.01 instance Bits Word16 where {-# INLINE shift #-} {-# INLINE bit #-} @@ -365,6 +388,7 @@ instance Bits Word16 where bit = bitDefault testBit = testBitDefault +-- | @since 4.6.0.0 instance FiniteBits Word16 where finiteBitSize _ = 16 countLeadingZeros (W16# x#) = I# (word2Int# (clz16# x#)) @@ -461,6 +485,7 @@ data {-# CTYPE "HsWord32" #-} Word32 = W32# Word# -- ^ 32-bit unsigned integer type -- See GHC.Classes#matching_overloaded_methods_in_rules +-- | @since 2.01 instance Eq Word32 where (==) = eqWord32 (/=) = neWord32 @@ -471,6 +496,7 @@ neWord32 (W32# x) (W32# y) = isTrue# (x `neWord#` y) {-# INLINE [1] eqWord32 #-} {-# INLINE [1] neWord32 #-} +-- | @since 2.01 instance Ord Word32 where (<) = ltWord32 (<=) = leWord32 @@ -487,6 +513,7 @@ gtWord32, geWord32, ltWord32, leWord32 :: Word32 -> Word32 -> Bool (W32# x) `ltWord32` (W32# y) = isTrue# (x `ltWord#` y) (W32# x) `leWord32` (W32# y) = isTrue# (x `leWord#` y) +-- | @since 2.01 instance Num Word32 where (W32# x#) + (W32# y#) = W32# (narrow32Word# (x# `plusWord#` y#)) (W32# x#) - (W32# y#) = W32# (narrow32Word# (x# `minusWord#` y#)) @@ -497,6 +524,7 @@ instance Num Word32 where signum _ = 1 fromInteger i = W32# (narrow32Word# (integerToWord i)) +-- | @since 2.01 instance Enum Word32 where succ x | x /= maxBound = x + 1 @@ -526,6 +554,7 @@ instance Enum Word32 where enumFromThen = boundedEnumFromThen #endif +-- | @since 2.01 instance Integral Word32 where quot (W32# x#) y@(W32# y#) | y /= 0 = W32# (x# `quotWord#` y#) @@ -557,6 +586,7 @@ instance Integral Word32 where = smallInteger (word2Int# x#) #endif +-- | @since 2.01 instance Bits Word32 where {-# INLINE shift #-} {-# INLINE bit #-} @@ -588,6 +618,7 @@ instance Bits Word32 where bit = bitDefault testBit = testBitDefault +-- | @since 4.6.0.0 instance FiniteBits Word32 where finiteBitSize _ = 32 countLeadingZeros (W32# x#) = I# (word2Int# (clz32# x#)) @@ -602,6 +633,7 @@ instance FiniteBits Word32 where "fromIntegral/Word32->a" fromIntegral = \(W32# x#) -> fromIntegral (W# x#) #-} +-- | @since 2.01 instance Show Word32 where #if WORD_SIZE_IN_BITS < 33 showsPrec p x = showsPrec p (toInteger x) @@ -610,18 +642,22 @@ instance Show Word32 where #endif +-- | @since 2.01 instance Real Word32 where toRational x = toInteger x % 1 +-- | @since 2.01 instance Bounded Word32 where minBound = 0 maxBound = 0xFFFFFFFF +-- | @since 2.01 instance Ix Word32 where range (m,n) = [m..n] unsafeIndex (m,_) i = fromIntegral (i - m) inRange (m,n) i = m <= i && i <= n +-- | @since 2.01 instance Read Word32 where #if WORD_SIZE_IN_BITS < 33 readsPrec p s = [(fromInteger x, r) | (x, r) <- readsPrec p s] @@ -645,6 +681,7 @@ data {-# CTYPE "HsWord64" #-} Word64 = W64# Word64# -- ^ 64-bit unsigned integer type -- See GHC.Classes#matching_overloaded_methods_in_rules +-- | @since 2.01 instance Eq Word64 where (==) = eqWord64 (/=) = neWord64 @@ -655,6 +692,7 @@ neWord64 (W64# x) (W64# y) = isTrue# (x `neWord64#` y) {-# INLINE [1] eqWord64 #-} {-# INLINE [1] neWord64 #-} +-- | @since 2.01 instance Ord Word64 where (<) = ltWord64 (<=) = leWord64 @@ -671,6 +709,7 @@ gtWord64, geWord64, ltWord64, leWord64 :: Word64 -> Word64 -> Bool (W64# x) `ltWord64` (W64# y) = isTrue# (x `ltWord64#` y) (W64# x) `leWord64` (W64# y) = isTrue# (x `leWord64#` y) +-- | @since 2.01 instance Num Word64 where (W64# x#) + (W64# y#) = W64# (int64ToWord64# (word64ToInt64# x# `plusInt64#` word64ToInt64# y#)) (W64# x#) - (W64# y#) = W64# (int64ToWord64# (word64ToInt64# x# `minusInt64#` word64ToInt64# y#)) @@ -681,6 +720,7 @@ instance Num Word64 where signum _ = 1 fromInteger i = W64# (integerToWord64 i) +-- | @since 2.01 instance Enum Word64 where succ x | x /= maxBound = x + 1 @@ -700,6 +740,7 @@ instance Enum Word64 where enumFromTo = integralEnumFromTo enumFromThenTo = integralEnumFromThenTo +-- | @since 2.01 instance Integral Word64 where quot (W64# x#) y@(W64# y#) | y /= 0 = W64# (x# `quotWord64#` y#) @@ -721,6 +762,7 @@ instance Integral Word64 where | otherwise = divZeroError toInteger (W64# x#) = word64ToInteger x# +-- | @since 2.01 instance Bits Word64 where {-# INLINE shift #-} {-# INLINE bit #-} @@ -781,6 +823,7 @@ data {-# CTYPE "HsWord64" #-} Word64 = W64# Word# -- ^ 64-bit unsigned integer type -- See GHC.Classes#matching_overloaded_methods_in_rules +-- | @since 2.01 instance Eq Word64 where (==) = eqWord64 (/=) = neWord64 @@ -791,6 +834,7 @@ neWord64 (W64# x) (W64# y) = isTrue# (x `neWord#` y) {-# INLINE [1] eqWord64 #-} {-# INLINE [1] neWord64 #-} +-- | @since 2.01 instance Ord Word64 where (<) = ltWord64 (<=) = leWord64 @@ -807,6 +851,7 @@ gtWord64, geWord64, ltWord64, leWord64 :: Word64 -> Word64 -> Bool (W64# x) `ltWord64` (W64# y) = isTrue# (x `ltWord#` y) (W64# x) `leWord64` (W64# y) = isTrue# (x `leWord#` y) +-- | @since 2.01 instance Num Word64 where (W64# x#) + (W64# y#) = W64# (x# `plusWord#` y#) (W64# x#) - (W64# y#) = W64# (x# `minusWord#` y#) @@ -817,6 +862,7 @@ instance Num Word64 where signum _ = 1 fromInteger i = W64# (integerToWord i) +-- | @since 2.01 instance Enum Word64 where succ x | x /= maxBound = x + 1 @@ -836,6 +882,7 @@ instance Enum Word64 where enumFromTo = integralEnumFromTo enumFromThenTo = integralEnumFromThenTo +-- | @since 2.01 instance Integral Word64 where quot (W64# x#) y@(W64# y#) | y /= 0 = W64# (x# `quotWord#` y#) @@ -863,6 +910,7 @@ instance Integral Word64 where where !i# = word2Int# x# +-- | @since 2.01 instance Bits Word64 where {-# INLINE shift #-} {-# INLINE bit #-} @@ -906,26 +954,32 @@ uncheckedShiftRL64# = uncheckedShiftRL# #endif +-- | @since 4.6.0.0 instance FiniteBits Word64 where finiteBitSize _ = 64 countLeadingZeros (W64# x#) = I# (word2Int# (clz64# x#)) countTrailingZeros (W64# x#) = I# (word2Int# (ctz64# x#)) +-- | @since 2.01 instance Show Word64 where showsPrec p x = showsPrec p (toInteger x) +-- | @since 2.01 instance Real Word64 where toRational x = toInteger x % 1 +-- | @since 2.01 instance Bounded Word64 where minBound = 0 maxBound = 0xFFFFFFFFFFFFFFFF +-- | @since 2.01 instance Ix Word64 where range (m,n) = [m..n] unsafeIndex (m,_) i = fromIntegral (i - m) inRange (m,n) i = m <= i && i <= n +-- | @since 2.01 instance Read Word64 where readsPrec p s = [(fromInteger x, r) | (x, r) <- readsPrec p s] |