diff --git a/Data/OldTypeable.hs b/Data/OldTypeable.hs index 58d4f33e..32372a1f 100644 --- a/Data/OldTypeable.hs +++ b/Data/OldTypeable.hs @@ -97,7 +97,6 @@ import Data.Maybe #ifdef __GLASGOW_HASKELL__ import GHC.Base -import GHC.Err (undefined) import GHC.Fingerprint.Type import GHC.Fingerprint diff --git a/Data/Typeable.hs b/Data/Typeable.hs index e1a0e3c5..2a88cb1d 100644 --- a/Data/Typeable.hs +++ b/Data/Typeable.hs @@ -83,9 +83,7 @@ import Data.Typeable.Internal hiding (mkTyCon) import Unsafe.Coerce import Data.Maybe - import GHC.Base -import GHC.Err (undefined) ------------------------------------------------------------- -- @@ -100,14 +98,12 @@ cast x = if typeRep (Proxy :: Proxy a) == typeRep (Proxy :: Proxy b) else Nothing -- | A flexible variation parameterised in a type constructor -gcast :: (Typeable (a :: *), Typeable b) => c a -> Maybe (c b) +gcast :: forall a b c. (Typeable (a :: *), Typeable b) => c a -> Maybe (c b) gcast x = r where - r = if typeRep (getArg x) == typeRep (getArg (fromJust r)) + r = if typeRep (Proxy :: Proxy a) == typeRep (Proxy :: Proxy b) then Just $ unsafeCoerce x else Nothing - getArg :: c x -> Proxy x - getArg = undefined -- | Cast for * -> * gcast1 :: forall c t t' a. (Typeable (t :: * -> *), Typeable t') diff --git a/Data/Typeable.hs-boot b/Data/Typeable.hs-boot deleted file mode 100644 index 976c7075..00000000 --- a/Data/Typeable.hs-boot +++ /dev/null @@ -1,10 +0,0 @@ -{-# LANGUAGE Trustworthy #-} -{-# LANGUAGE NoImplicitPrelude #-} - -module Data.Typeable (Typeable, mkTyConApp, cast) where - -import Data.Maybe -import {-# SOURCE #-} Data.Typeable.Internal - -cast :: (Typeable a, Typeable b) => a -> Maybe b - diff --git a/Data/Typeable/Internal.hs b/Data/Typeable/Internal.hs index 6fbd522d..e98d3c13 100644 --- a/Data/Typeable/Internal.hs +++ b/Data/Typeable/Internal.hs @@ -50,18 +50,17 @@ import GHC.Base import GHC.Word import GHC.Show import Data.Maybe -import Data.List import GHC.Num import GHC.Real -import GHC.IORef -import GHC.IOArray -import GHC.MVar +-- import GHC.IORef +-- import GHC.IOArray +-- import GHC.MVar import GHC.ST ( ST ) import GHC.STRef ( STRef ) import GHC.Ptr ( Ptr, FunPtr ) -import GHC.Stable +-- import GHC.Stable import GHC.Arr ( Array, STArray ) -import Data.Int +-- import Data.Int import GHC.Fingerprint.Type import {-# SOURCE #-} GHC.Fingerprint @@ -165,7 +164,7 @@ mkTyCon3 :: String -- ^ package name -> String -- ^ the name of the type constructor -> TyCon -- ^ A unique 'TyCon' object mkTyCon3 pkg modl name = - TyCon (fingerprintString (unwords [pkg, modl, name])) pkg modl name + TyCon (fingerprintString (pkg ++ (' ':modl) ++ (' ':name))) pkg modl name ----------------- Observation --------------------- @@ -249,7 +248,7 @@ instance Show TypeRep where showParen (p > 9) $ showsPrec p tycon . showChar ' ' . - showArgs tys + showArgs (showChar ' ') tys showsTypeRep :: TypeRep -> ShowS showsTypeRep = shows @@ -263,15 +262,14 @@ isTupleTyCon _ = False -- Some (Show.TypeRep) helpers: -showArgs :: Show a => [a] -> ShowS -showArgs [] = id -showArgs [a] = showsPrec 10 a -showArgs (a:as) = showsPrec 10 a . showString " " . showArgs as +showArgs :: Show a => ShowS -> [a] -> ShowS +showArgs _ [] = id +showArgs _ [a] = showsPrec 10 a +showArgs sep (a:as) = showsPrec 10 a . sep . showArgs sep as showTuple :: [TypeRep] -> ShowS showTuple args = showChar '(' - . (foldr (.) id $ intersperse (showChar ',') - $ map (showsPrec 10) args) + . showArgs (showChar ',') args . showChar ')' listTc :: TyCon @@ -297,11 +295,11 @@ INSTANCE_TYPEABLE1(IO,ioTc,"IO") #if defined(__GLASGOW_HASKELL__) || defined(__HUGS__) -- Types defined in GHC.MVar -INSTANCE_TYPEABLE1(MVar,mvarTc,"MVar" ) +{- INSTANCE_TYPEABLE1(MVar,mvarTc,"MVar" ) -} #endif INSTANCE_TYPEABLE2(Array,arrayTc,"Array") -INSTANCE_TYPEABLE2(IOArray,iOArrayTc,"IOArray") +{- INSTANCE_TYPEABLE2(IOArray,iOArrayTc,"IOArray") -} #ifdef __GLASGOW_HASKELL__ -- Hugs has these too, but their Typeable instances are defined @@ -325,8 +323,10 @@ INSTANCE_TYPEABLE1(FunPtr,funPtrTc,"FunPtr") #ifndef __GLASGOW_HASKELL__ INSTANCE_TYPEABLE1(ForeignPtr,foreignPtrTc,"ForeignPtr") #endif +{- INSTANCE_TYPEABLE1(StablePtr,stablePtrTc,"StablePtr") -INSTANCE_TYPEABLE1(IORef,iORefTc,"IORef") +INSTANCE_TYPEABLE1(IORef,iORefTc,"IORef") +-} ------------------------------------------------------- -- @@ -346,10 +346,12 @@ INSTANCE_TYPEABLE0(Ordering,orderingTc,"Ordering") INSTANCE_TYPEABLE0(Handle,handleTc,"Handle") #endif +{- INSTANCE_TYPEABLE0(Int8,int8Tc,"Int8") INSTANCE_TYPEABLE0(Int16,int16Tc,"Int16") INSTANCE_TYPEABLE0(Int32,int32Tc,"Int32") INSTANCE_TYPEABLE0(Int64,int64Tc,"Int64") +-} INSTANCE_TYPEABLE0(Word8,word8Tc,"Word8" ) INSTANCE_TYPEABLE0(Word16,word16Tc,"Word16") diff --git a/Foreign/C/Types.hs b/Foreign/C/Types.hs index 234b4edd..5f296d5f 100644 --- a/Foreign/C/Types.hs +++ b/Foreign/C/Types.hs @@ -80,9 +80,7 @@ import Foreign.Storable import Data.Bits ( Bits(..) ) import Data.Int ( Int8, Int16, Int32, Int64 ) import Data.Word ( Word8, Word16, Word32, Word64 ) -import {-# SOURCE #-} Data.Typeable - -- loop: Data.Typeable -> Data.List -> Data.Char -> GHC.Unicode - -- -> Foreign.C.Type +import Data.Typeable #ifdef __GLASGOW_HASKELL__ import GHC.Base diff --git a/Foreign/ForeignPtr/Imp.hs b/Foreign/ForeignPtr/Imp.hs index f2c019ea..19d31b85 100644 --- a/Foreign/ForeignPtr/Imp.hs +++ b/Foreign/ForeignPtr/Imp.hs @@ -64,7 +64,6 @@ import Foreign.Storable ( Storable(sizeOf) ) #ifdef __GLASGOW_HASKELL__ import GHC.Base import GHC.Num -import GHC.Err ( undefined ) import GHC.ForeignPtr #endif diff --git a/Foreign/Marshal/Alloc.hs b/Foreign/Marshal/Alloc.hs index dc4e399e..6b0bcfb4 100644 --- a/Foreign/Marshal/Alloc.hs +++ b/Foreign/Marshal/Alloc.hs @@ -74,7 +74,6 @@ import Foreign.ForeignPtr ( FinalizerPtr ) import GHC.IO.Exception import GHC.Real import GHC.Ptr -import GHC.Err import GHC.Base #else import Control.Exception.Base ( bracket ) diff --git a/Foreign/Marshal/Array.hs b/Foreign/Marshal/Array.hs index 60121796..d6a00410 100644 --- a/Foreign/Marshal/Array.hs +++ b/Foreign/Marshal/Array.hs @@ -72,7 +72,6 @@ import Foreign.Marshal.Utils (copyBytes, moveBytes) #ifdef __GLASGOW_HASKELL__ import GHC.Num import GHC.List -import GHC.Err import GHC.Base #else import Control.Monad (zipWithM_) diff --git a/Foreign/Storable.hs b/Foreign/Storable.hs index 40d5fda5..53ca168f 100644 --- a/Foreign/Storable.hs +++ b/Foreign/Storable.hs @@ -46,7 +46,7 @@ import GHC.Num import GHC.Int import GHC.Word import GHC.Ptr -import GHC.Err +import GHC.Exception import GHC.Base import GHC.Fingerprint.Type import Data.Bits diff --git a/GHC/Arr.lhs b/GHC/Arr.lhs index 48bb4143..acae5a8a 100644 --- a/GHC/Arr.lhs +++ b/GHC/Arr.lhs @@ -47,7 +47,7 @@ import GHC.Num import GHC.ST import GHC.Base import GHC.List -import GHC.Real +import GHC.Real( fromIntegral ) import GHC.Show infixl 9 !, // @@ -185,7 +185,7 @@ can do better, so we override the default method for index. -- Abstract these errors from the relevant index functions so that -- the guts of the function will be small enough to inline. -{-# NOINLINE indexError #-} +{- # NOINLINE indexError #-} indexError :: Show a => (a,a) -> a -> String -> b indexError rng i tp = error (showString "Ix{" . showString tp . showString "}.index: Index " . diff --git a/GHC/Base.lhs b/GHC/Base.lhs index 075f21d6..ec162efd 100644 --- a/GHC/Base.lhs +++ b/GHC/Base.lhs @@ -101,8 +101,8 @@ module GHC.Base module GHC.CString, module GHC.Magic, module GHC.Types, - module GHC.Prim, -- Re-export GHC.Prim and GHC.Err, to avoid lots - module GHC.Err -- of people having to import it explicitly + module GHC.Prim, -- Re-export GHC.Prim and [boot] GHC.Err, to avoid lots + module GHC.Err -- of people having to import it explicitly ) where @@ -111,7 +111,7 @@ import GHC.Classes import GHC.CString import GHC.Magic import GHC.Prim -import {-# SOURCE #-} GHC.Err +import GHC.Err import {-# SOURCE #-} GHC.IO (failIO) -- This is not strictly speaking required by this module, but is an diff --git a/GHC/Err.lhs b/GHC/Err.lhs index 964bc0cd..0837f2e6 100644 --- a/GHC/Err.lhs +++ b/GHC/Err.lhs @@ -1,6 +1,6 @@ \begin{code} {-# LANGUAGE Trustworthy #-} -{-# LANGUAGE CPP, NoImplicitPrelude #-} +{-# LANGUAGE CPP, NoImplicitPrelude, MagicHash #-} {-# OPTIONS_HADDOCK hide #-} ----------------------------------------------------------------------------- @@ -23,20 +23,10 @@ ----------------------------------------------------------------------------- -- #hide -module GHC.Err - ( - absentErr - , divZeroError - , ratioZeroDenominatorError - , overflowError - - , error - - , undefined - ) where - +module GHC.Err( absentErr, error, undefined ) where import GHC.Types -import GHC.Exception +import GHC.Prim +import {-# SOURCE #-} GHC.Exception( errorCallException ) \end{code} %********************************************************* @@ -48,7 +38,7 @@ import GHC.Exception \begin{code} -- | 'error' stops execution and displays an error message. error :: [Char] -> a -error s = throw (ErrorCall s) +error s = raise# (errorCallException s) -- | A special case of 'error'. -- It is expected that compilers will recognize this and insert error @@ -70,25 +60,6 @@ encoding saves bytes of string junk. \begin{code} absentErr :: a - absentErr = error "Oops! The program has entered an `absent' argument!\n" \end{code} -Divide by zero and arithmetic overflow. -We put them here because they are needed relatively early -in the libraries before the Exception type has been defined yet. - -\begin{code} -{-# NOINLINE divZeroError #-} -divZeroError :: a -divZeroError = throw DivideByZero - -{-# NOINLINE ratioZeroDenominatorError #-} -ratioZeroDenominatorError :: a -ratioZeroDenominatorError = throw RatioZeroDenominator - -{-# NOINLINE overflowError #-} -overflowError :: a -overflowError = throw Overflow -\end{code} - diff --git a/GHC/Err.lhs-boot b/GHC/Err.lhs-boot index cc39bc8e..1b9467e3 100644 --- a/GHC/Err.lhs-boot +++ b/GHC/Err.lhs-boot @@ -6,17 +6,17 @@ -- Ghc.Err.hs-boot --------------------------------------------------------------------------- -module GHC.Err( error ) where +module GHC.Err ( error, undefined ) where +import GHC.Types( Char ) --- The type signature for 'error' is a gross hack. --- First, we can't give an accurate type for error, because it mentions +-- The type signature for 'error'/'undefined' is a gross hack: +-- we can't give an accurate type for error, because it mentions -- an open type variable. --- Second, we can't even say error :: [Char] -> a, because Char is defined --- in GHC.Base, and that would make Err.lhs-boot mutually recursive --- with GHC.Base. -- Fortunately it doesn't matter what type we give here because the -- compiler will use its wired-in version. But we have -- to mention 'error' so that it gets exported from this .hi-boot -- file. -error :: a + +error :: [Char] -> a +undefined :: a \end{code} diff --git a/GHC/Event/Array.hs b/GHC/Event/Array.hs index 5b811ef7..fbc2a971 100644 --- a/GHC/Event/Array.hs +++ b/GHC/Event/Array.hs @@ -33,7 +33,6 @@ import Foreign.ForeignPtr (ForeignPtr, withForeignPtr) import Foreign.Ptr (Ptr, nullPtr, plusPtr) import Foreign.Storable (Storable(..)) import GHC.Base -import GHC.Err (undefined) import GHC.ForeignPtr (mallocPlainForeignPtrBytes, newForeignPtr_) import GHC.Num (Num(..)) import GHC.Real (fromIntegral) diff --git a/GHC/Event/EPoll.hsc b/GHC/Event/EPoll.hsc index 44c8bd97..e253671a 100644 --- a/GHC/Event/EPoll.hsc +++ b/GHC/Event/EPoll.hsc @@ -52,7 +52,6 @@ import Foreign.Marshal.Utils (with) import Foreign.Ptr (Ptr) import Foreign.Storable (Storable(..)) import GHC.Base -import GHC.Err (undefined) import GHC.Num (Num(..)) import GHC.Real (ceiling, fromIntegral) import GHC.Show (Show) diff --git a/GHC/Event/Poll.hsc b/GHC/Event/Poll.hsc index c5003ff2..fc4b011d 100644 --- a/GHC/Event/Poll.hsc +++ b/GHC/Event/Poll.hsc @@ -37,7 +37,6 @@ import Foreign.Ptr (Ptr) import Foreign.Storable (Storable(..)) import GHC.Base import GHC.Conc.Sync (withMVar) -import GHC.Err (undefined) import GHC.Num (Num(..)) import GHC.Real (ceiling, fromIntegral) import GHC.Show (Show) diff --git a/GHC/Exception.lhs b/GHC/Exception.lhs index ba40a89a..7d40a943 100644 --- a/GHC/Exception.lhs +++ b/GHC/Exception.lhs @@ -22,10 +22,16 @@ ----------------------------------------------------------------------------- -- #hide -module GHC.Exception where +module GHC.Exception + ( Exception(..) -- Class + , throw + , SomeException(..), ErrorCall(..), ArithException(..) + , divZeroException, overflowException, ratioZeroDenomException + , errorCallException + ) where import Data.Maybe -import {-# SOURCE #-} Data.Typeable (Typeable, cast) +import Data.Typeable (Typeable, cast) -- loop: Data.Typeable -> GHC.Err -> GHC.Exception import GHC.Base import GHC.Show @@ -173,6 +179,9 @@ instance Exception ErrorCall instance Show ErrorCall where showsPrec _ (ErrorCall err) = showString err +errorCallException :: String -> SomeException +errorCallException s = toException (ErrorCall s) + ----- -- |Arithmetic exceptions. @@ -185,6 +194,11 @@ data ArithException | RatioZeroDenominator deriving (Eq, Ord, Typeable) +divZeroException, overflowException, ratioZeroDenomException :: SomeException +divZeroException = toException DivideByZero +overflowException = toException Overflow +ratioZeroDenomException = toException RatioZeroDenominator + instance Exception ArithException instance Show ArithException where @@ -194,5 +208,4 @@ instance Show ArithException where showsPrec _ DivideByZero = showString "divide by zero" showsPrec _ Denormal = showString "denormal" showsPrec _ RatioZeroDenominator = showString "Ratio has zero denominator" - \end{code} diff --git a/GHC/Exception.lhs-boot b/GHC/Exception.lhs-boot new file mode 100644 index 00000000..9c3b0bf4 --- /dev/null +++ b/GHC/Exception.lhs-boot @@ -0,0 +1,19 @@ +\begin{code} +{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE NoImplicitPrelude #-} + +--------------------------------------------------------------------------- +-- Ghc.Exception.hs-boot +--------------------------------------------------------------------------- + +module GHC.Exception ( SomeException, errorCallException, + divZeroException, overflowException, ratioZeroDenomException + ) where +import GHC.Types( Char ) + +-- These exports are nice, well-behaved, non-bottom values + +data SomeException +divZeroException, overflowException, ratioZeroDenomException :: SomeException +errorCallException :: [Char] -> SomeException +\end{code} diff --git a/GHC/ForeignPtr.hs b/GHC/ForeignPtr.hs index a9c859a1..e8e23e5c 100644 --- a/GHC/ForeignPtr.hs +++ b/GHC/ForeignPtr.hs @@ -56,7 +56,6 @@ import GHC.Base import GHC.IORef import GHC.STRef ( STRef(..) ) import GHC.Ptr ( Ptr(..), FunPtr(..) ) -import GHC.Err #include "Typeable.h" diff --git a/GHC/IOArray.hs b/GHC/IOArray.hs index 800b5969..8594e2ad 100644 --- a/GHC/IOArray.hs +++ b/GHC/IOArray.hs @@ -1,5 +1,5 @@ {-# LANGUAGE Unsafe #-} -{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE NoImplicitPrelude, DeriveDataTypeable #-} {-# OPTIONS_GHC -funbox-strict-fields #-} {-# OPTIONS_HADDOCK hide #-} @@ -27,6 +27,7 @@ module GHC.IOArray ( import GHC.Base import GHC.IO import GHC.Arr +import Data.Typeable.Internal -- --------------------------------------------------------------------------- -- | An 'IOArray' is a mutable, boxed, non-strict array in the 'IO' monad. @@ -38,7 +39,7 @@ import GHC.Arr -- -- -newtype IOArray i e = IOArray (STArray RealWorld i e) +newtype IOArray i e = IOArray (STArray RealWorld i e) deriving( Typeable ) -- explicit instance because Haddock can't figure out a derived one instance Eq (IOArray i e) where diff --git a/GHC/IORef.hs b/GHC/IORef.hs index a0ed0823..bb618341 100644 --- a/GHC/IORef.hs +++ b/GHC/IORef.hs @@ -1,5 +1,5 @@ {-# LANGUAGE Unsafe #-} -{-# LANGUAGE NoImplicitPrelude, MagicHash #-} +{-# LANGUAGE NoImplicitPrelude, MagicHash, DeriveDataTypeable #-} {-# OPTIONS_GHC -funbox-strict-fields #-} {-# OPTIONS_HADDOCK hide #-} @@ -25,12 +25,13 @@ module GHC.IORef ( import GHC.Base import GHC.STRef import GHC.IO +import Data.Typeable.Internal( Typeable ) -- --------------------------------------------------------------------------- -- IORefs -- |A mutable variable in the 'IO' monad -newtype IORef a = IORef (STRef RealWorld a) +newtype IORef a = IORef (STRef RealWorld a) deriving( Typeable ) -- explicit instance because Haddock can't figure out a derived one instance Eq (IORef a) where diff --git a/GHC/Int.hs b/GHC/Int.hs index cad79815..206a25b5 100644 --- a/GHC/Int.hs +++ b/GHC/Int.hs @@ -1,6 +1,6 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE CPP, NoImplicitPrelude, BangPatterns, MagicHash, UnboxedTuples, - StandaloneDeriving #-} + StandaloneDeriving, DeriveDataTypeable #-} {-# OPTIONS_HADDOCK hide #-} ----------------------------------------------------------------------------- @@ -38,10 +38,10 @@ import GHC.Num import GHC.Real import GHC.Read import GHC.Arr -import GHC.Err import GHC.Word hiding (uncheckedShiftL64#, uncheckedShiftRL64#) import GHC.Show import GHC.Float () -- for RealFrac methods +import Data.Typeable ------------------------------------------------------------------------ @@ -51,7 +51,7 @@ import GHC.Float () -- for RealFrac methods -- Int8 is represented in the same way as Int. Operations may assume -- and must ensure that it holds only values from its logical range. -data {-# CTYPE "HsInt8" #-} Int8 = I8# Int# deriving (Eq, Ord) +data {-# CTYPE "HsInt8" #-} Int8 = I8# Int# deriving (Eq, Ord, Typeable) -- ^ 8-bit signed integer type instance Show Int8 where @@ -210,7 +210,7 @@ instance FiniteBits Int8 where -- Int16 is represented in the same way as Int. Operations may assume -- and must ensure that it holds only values from its logical range. -data {-# CTYPE "HsInt16" #-} Int16 = I16# Int# deriving (Eq, Ord) +data {-# CTYPE "HsInt16" #-} Int16 = I16# Int# deriving (Eq, Ord, Typeable) -- ^ 16-bit signed integer type instance Show Int16 where @@ -374,7 +374,7 @@ instance FiniteBits Int16 where -- from its logical range. #endif -data {-# CTYPE "HsInt32" #-} Int32 = I32# Int# deriving (Eq, Ord) +data {-# CTYPE "HsInt32" #-} Int32 = I32# Int# deriving (Eq, Ord, Typeable) -- ^ 32-bit signed integer type instance Show Int32 where @@ -549,7 +549,7 @@ instance Ix Int32 where #if WORD_SIZE_IN_BITS < 64 -data {-# CTYPE "HsInt64" #-} Int64 = I64# Int64# +data {-# CTYPE "HsInt64" #-} Int64 = I64# Int64# deriving( Typeable ) -- ^ 64-bit signed integer type instance Eq Int64 where @@ -724,7 +724,7 @@ a `iShiftRA64#` b | b >=# 64# = if a `ltInt64#` (intToInt64# 0#) -- Operations may assume and must ensure that it holds only values -- from its logical range. -data {-# CTYPE "HsInt64" #-} Int64 = I64# Int# deriving (Eq, Ord) +data {-# CTYPE "HsInt64" #-} Int64 = I64# Int# deriving (Eq, Ord, Typeable) -- ^ 64-bit signed integer type instance Show Int64 where diff --git a/GHC/MVar.hs b/GHC/MVar.hs index cd2ca33d..b256c592 100644 --- a/GHC/MVar.hs +++ b/GHC/MVar.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE Unsafe #-} +{-# LANGUAGE Unsafe, DeriveDataTypeable #-} {-# LANGUAGE NoImplicitPrelude, MagicHash, UnboxedTuples #-} {-# OPTIONS_GHC -funbox-strict-fields #-} {-# OPTIONS_HADDOCK hide #-} @@ -32,8 +32,9 @@ module GHC.MVar ( import GHC.Base import Data.Maybe +import Data.Typeable -data MVar a = MVar (MVar# RealWorld a) +data MVar a = MVar (MVar# RealWorld a) deriving( Typeable ) {- ^ An 'MVar' (pronounced \"em-var\") is a synchronising variable, used for communication between concurrent threads. It can be thought of diff --git a/GHC/Read.lhs b/GHC/Read.lhs index 5ad95273..0729ff21 100644 --- a/GHC/Read.lhs +++ b/GHC/Read.lhs @@ -68,7 +68,6 @@ import GHC.Real import GHC.Float import GHC.Show import GHC.Base -import GHC.Err import GHC.Arr \end{code} diff --git a/GHC/Real.lhs b/GHC/Real.lhs index d380c4aa..87e78450 100644 --- a/GHC/Real.lhs +++ b/GHC/Real.lhs @@ -26,7 +26,7 @@ import GHC.Num import GHC.List import GHC.Enum import GHC.Show -import GHC.Err +import {-# SOURCE #-} GHC.Exception( divZeroException, overflowException, ratioZeroDenomException ) #ifdef OPTIMISE_INTEGER_GCD_LCM import GHC.Integer.GMP.Internals @@ -41,6 +41,29 @@ default () -- Double isn't available yet, \end{code} +%********************************************************* +%* * + Divide by zero and arithmetic overflow +%* * +%********************************************************* + +We put them here because they are needed relatively early +in the libraries before the Exception type has been defined yet. + +\begin{code} +{-# NOINLINE divZeroError #-} +divZeroError :: a +divZeroError = raise# divZeroException + +{-# NOINLINE ratioZeroDenominatorError #-} +ratioZeroDenominatorError :: a +ratioZeroDenominatorError = raise# ratioZeroDenomException + +{-# NOINLINE overflowError #-} +overflowError :: a +overflowError = raise# overflowException +\end{code} + %********************************************************* %* * \subsection{The @Ratio@ and @Rational@ types} diff --git a/GHC/Stable.lhs b/GHC/Stable.lhs index 43968958..ba720541 100644 --- a/GHC/Stable.lhs +++ b/GHC/Stable.lhs @@ -1,5 +1,5 @@ \begin{code} -{-# LANGUAGE Unsafe #-} +{-# LANGUAGE Unsafe, DeriveDataTypeable #-} {-# LANGUAGE NoImplicitPrelude , MagicHash , UnboxedTuples @@ -33,6 +33,7 @@ module GHC.Stable ( import GHC.Ptr import GHC.Base +import Data.Typeable.Internal ----------------------------------------------------------------------------- -- Stable Pointers @@ -49,6 +50,7 @@ A value of type @StablePtr a@ is a stable pointer to a Haskell expression of type @a@. -} data {-# CTYPE "HsStablePtr" #-} StablePtr a = StablePtr (StablePtr# a) + deriving( Typeable ) -- | -- Create a stable pointer referring to the given Haskell value. diff --git a/GHC/Word.hs b/GHC/Word.hs index d319333e..75957df7 100644 --- a/GHC/Word.hs +++ b/GHC/Word.hs @@ -33,6 +33,7 @@ import Data.Maybe import GHC.IntWord64 #endif +-- import {-# SOURCE #-} GHC.Exception import GHC.Base import GHC.Enum import GHC.Num @@ -40,7 +41,6 @@ import GHC.Real import GHC.Read import GHC.Arr import GHC.Show -import GHC.Err import GHC.Float () -- for RealFrac methods ------------------------------------------------------------------------