{-# LANGUAGE CPP, NoImplicitPrelude #-}
#ifdef __GLASGOW_HASKELL__
-{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}
+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, StandaloneDeriving #-}
#endif
-----------------------------------------------------------------------------
#endif
import Data.Typeable
+import GHC.Generics (Generic)
#ifdef __GLASGOW_HASKELL__
{-
used to hold an error value and the 'Right' constructor is used to
hold a correct value (mnemonic: \"right\" also means \"correct\").
-}
-data Either a b = Left a | Right b deriving (Eq, Ord, Read, Show)
+data Either a b = Left a | Right b
+ deriving (Eq, Ord, Read, Show, Generic)
-- | Case analysis for the 'Either' type.
-- If the value is @'Left' a@, apply the first function to @a@;
-{-# LANGUAGE CPP, NoImplicitPrelude #-}
+{-# LANGUAGE CPP, NoImplicitPrelude, DeriveGeneric #-}
-----------------------------------------------------------------------------
-- |
#ifdef __GLASGOW_HASKELL__
import GHC.Base
+import GHC.Generics (Generic)
#endif
#ifdef __NHC__
-- error monad can be built using the 'Data.Either.Either' type.
data Maybe a = Nothing | Just a
- deriving (Eq, Ord)
+ deriving (Eq, Ord, Generic)
instance Functor Maybe where
fmap _ Nothing = Nothing
(
module GHC.Base,
module GHC.Classes,
- module GHC.Generics,
+ module GHC.CString,
+ --module GHC.Generics, -- JPM: We no longer export GHC.Generics
+ -- by default to avoid name clashes
module GHC.Ordering,
module GHC.Types,
module GHC.Prim, -- Re-export GHC.Prim and GHC.Err, to avoid lots
import GHC.Types
import GHC.Classes
-import GHC.Generics
+import GHC.CString
+-- JPM: Since we don't export it, we don't need to import GHC.Generics
+--import GHC.Generics
import GHC.Ordering
import GHC.Prim
import {-# SOURCE #-} GHC.Show
build = error "urk"
foldr = error "urk"
-
-unpackCString# :: Addr# -> [Char]
-unpackFoldrCString# :: Addr# -> (Char -> a -> a) -> a -> a
-unpackAppendCString# :: Addr# -> [Char] -> [Char]
-unpackCStringUtf8# :: Addr# -> [Char]
-unpackCString# a = error "urk"
-unpackFoldrCString# a = error "urk"
-unpackAppendCString# a = error "urk"
-unpackCStringUtf8# a = error "urk"
-}
\end{code}
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}
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 #-}
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
"int2Word2Int" forall x#. int2Word# (word2Int# x#) = x#
"word2Int2Word" forall x#. word2Int# (int2Word# x#) = x#
#-}
-\end{code}
-
-
-%********************************************************
-%* *
-\subsection{Unpacking C strings}
-%* *
-%********************************************************
-
-This code is needed for virtually all programs, since it's used for
-unpacking the strings of error messages.
-\begin{code}
-unpackCString# :: Addr# -> [Char]
-{-# NOINLINE unpackCString# #-}
- -- There's really no point in inlining this, ever, cos
- -- the loop doesn't specialise in an interesting
- -- But it's pretty small, so there's a danger that
- -- it'll be inlined at every literal, which is a waste
-unpackCString# addr
- = unpack 0#
- where
- unpack nh
- | ch `eqChar#` '\0'# = []
- | otherwise = C# ch : unpack (nh +# 1#)
- where
- !ch = indexCharOffAddr# addr nh
-
-unpackAppendCString# :: Addr# -> [Char] -> [Char]
-{-# NOINLINE unpackAppendCString# #-}
- -- See the NOINLINE note on unpackCString#
-unpackAppendCString# addr rest
- = unpack 0#
- where
- unpack nh
- | ch `eqChar#` '\0'# = rest
- | otherwise = C# ch : unpack (nh +# 1#)
- where
- !ch = indexCharOffAddr# addr nh
-
-unpackFoldrCString# :: Addr# -> (Char -> a -> a) -> a -> a
-
--- Usually the unpack-list rule turns unpackFoldrCString# into unpackCString#
-
--- It also has a BuiltInRule in PrelRules.lhs:
--- unpackFoldrCString# "foo" c (unpackFoldrCString# "baz" c n)
--- = unpackFoldrCString# "foobaz" c n
-
-{-# NOINLINE unpackFoldrCString# #-}
--- At one stage I had NOINLINE [0] on the grounds that, unlike
--- unpackCString#, there *is* some point in inlining
--- unpackFoldrCString#, because we get better code for the
--- higher-order function call. BUT there may be a lot of
--- literal strings, and making a separate 'unpack' loop for
--- each is highly gratuitous. See nofib/real/anna/PrettyPrint.
-
-unpackFoldrCString# addr f z
- = unpack 0#
- where
- unpack nh
- | ch `eqChar#` '\0'# = z
- | otherwise = C# ch `f` unpack (nh +# 1#)
- where
- !ch = indexCharOffAddr# addr nh
-
-unpackCStringUtf8# :: Addr# -> [Char]
-unpackCStringUtf8# addr
- = unpack 0#
- where
- unpack nh
- | ch `eqChar#` '\0'# = []
- | ch `leChar#` '\x7F'# = C# ch : unpack (nh +# 1#)
- | ch `leChar#` '\xDF'# =
- C# (chr# (((ord# ch -# 0xC0#) `uncheckedIShiftL#` 6#) +#
- (ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#))) :
- unpack (nh +# 2#)
- | ch `leChar#` '\xEF'# =
- C# (chr# (((ord# ch -# 0xE0#) `uncheckedIShiftL#` 12#) +#
- ((ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#) `uncheckedIShiftL#` 6#) +#
- (ord# (indexCharOffAddr# addr (nh +# 2#)) -# 0x80#))) :
- unpack (nh +# 3#)
- | otherwise =
- C# (chr# (((ord# ch -# 0xF0#) `uncheckedIShiftL#` 18#) +#
- ((ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#) `uncheckedIShiftL#` 12#) +#
- ((ord# (indexCharOffAddr# addr (nh +# 2#)) -# 0x80#) `uncheckedIShiftL#` 6#) +#
- (ord# (indexCharOffAddr# addr (nh +# 3#)) -# 0x80#))) :
- unpack (nh +# 4#)
- where
- !ch = indexCharOffAddr# addr nh
-
-unpackNBytes# :: Addr# -> Int# -> [Char]
-unpackNBytes# _addr 0# = []
-unpackNBytes# addr len# = unpack [] (len# -# 1#)
- where
- unpack acc i#
- | i# <# 0# = acc
- | otherwise =
- case indexCharOffAddr# addr i# of
- ch -> unpack (C# ch : acc) (i# -# 1#)
+-- Rules for C strings (the functions themselves are now in GHC.CString)
{-# RULES
"unpack" [~1] forall a . unpackCString# a = build (unpackFoldrCString# a)
"unpack-list" [1] forall a . unpackFoldrCString# a (:) [] = unpackCString# a
#-}
\end{code}
+
#ifdef __HADDOCK__
\begin{code}
-- | A special argument for the 'Control.Monad.ST.ST' type constructor,
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 &&
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
(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
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
-{-# LANGUAGE CPP, NoImplicitPrelude, BangPatterns, MagicHash #-}
+{-# LANGUAGE CPP, NoImplicitPrelude, BangPatterns, MagicHash,
+ StandaloneDeriving #-}
{-# OPTIONS_HADDOCK hide #-}
-----------------------------------------------------------------------------
-- |
import GHC.Show
import GHC.Float () -- for RealFrac methods
+
------------------------------------------------------------------------
-- type Int8
------------------------------------------------------------------------
unsafeIndex (m,_) i = fromIntegral i - fromIntegral m
inRange (m,n) i = m <= i && i <= n
+
{-
Note [Order of tests]
y == (-1) && x == minBound
order gives us better code in the common case.
-}
-
\begin{code}
-{-# LANGUAGE CPP, NoImplicitPrelude #-}
+{-# LANGUAGE CPP, NoImplicitPrelude, StandaloneDeriving #-}
{-# OPTIONS_HADDOCK hide #-}
-----------------------------------------------------------------------------
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}
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
\begin{code}
-{-# LANGUAGE NoImplicitPrelude, BangPatterns, MagicHash #-}
+{-# LANGUAGE NoImplicitPrelude, BangPatterns, MagicHash, StandaloneDeriving #-}
{-# OPTIONS_HADDOCK hide #-}
-----------------------------------------------------------------------------
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}
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}
projects / ghc-base.git / commitdiff