diff options
author | Herbert Valerio Riedel <hvr@gnu.org> | 2013-09-15 23:49:32 +0200 |
---|---|---|
committer | Herbert Valerio Riedel <hvr@gnu.org> | 2013-09-17 10:41:44 +0200 |
commit | 8f9f1009b89a54bcab8354a255f1372803f780ce (patch) | |
tree | 3a70900a5917328421472111aae401d832a6c2ae /libraries | |
parent | 0f5eae0232a86ec57d841a83e6929361e2751270 (diff) | |
download | haskell-8f9f1009b89a54bcab8354a255f1372803f780ce.tar.gz |
Make `<Typeable.h>` obsolete and refactor away its use
With GHC 7.8's PolyKinds the macros in `<Typeable.h>` are no longer of any
use, and their use is clearly obsolete. The sites using those macros are
replaced by auto-derivations of `Typeable` instances.
This reduces reliance on the CPP extension and the compile dependency on
`Typeable.h` in a couple of modules.
Signed-off-by: Herbert Valerio Riedel <hvr@gnu.org>
Diffstat (limited to 'libraries')
-rw-r--r-- | libraries/base/Control/Concurrent/Chan.hs | 6 | ||||
-rw-r--r-- | libraries/base/Control/Exception/Base.hs | 25 | ||||
-rw-r--r-- | libraries/base/Control/Monad/ST/Imp.hs | 3 | ||||
-rw-r--r-- | libraries/base/Data/Complex.hs | 7 | ||||
-rw-r--r-- | libraries/base/Data/Data.hs | 5 | ||||
-rw-r--r-- | libraries/base/Data/Dynamic.hs | 7 | ||||
-rw-r--r-- | libraries/base/Data/Either.hs | 6 | ||||
-rw-r--r-- | libraries/base/Data/Typeable/Internal.hs | 86 | ||||
-rw-r--r-- | libraries/base/Foreign/C/Types.hs | 50 | ||||
-rw-r--r-- | libraries/base/Foreign/Ptr.hs | 4 | ||||
-rw-r--r-- | libraries/base/GHC/Conc.lhs | 2 | ||||
-rw-r--r-- | libraries/base/GHC/Conc/IO.hs | 2 | ||||
-rw-r--r-- | libraries/base/GHC/Conc/Sync.lhs | 8 | ||||
-rw-r--r-- | libraries/base/GHC/ForeignPtr.hs | 8 | ||||
-rw-r--r-- | libraries/base/GHC/Weak.lhs | 8 | ||||
-rw-r--r-- | libraries/base/System/Mem/StableName.hs | 5 | ||||
-rw-r--r-- | libraries/base/System/Posix/Types.hs | 28 | ||||
-rw-r--r-- | libraries/base/System/Timeout.hs | 5 | ||||
-rw-r--r-- | libraries/base/include/CTypes.h | 24 | ||||
-rw-r--r-- | libraries/base/include/Typeable.h | 2 |
20 files changed, 109 insertions, 182 deletions
diff --git a/libraries/base/Control/Concurrent/Chan.hs b/libraries/base/Control/Concurrent/Chan.hs index 0efc1728e0..98c2efd013 100644 --- a/libraries/base/Control/Concurrent/Chan.hs +++ b/libraries/base/Control/Concurrent/Chan.hs @@ -41,8 +41,6 @@ import Control.Concurrent.MVar import Control.Exception (mask_) import Data.Typeable -#include "Typeable.h" - #define _UPK_(x) {-# UNPACK #-} !(x) -- A channel is represented by two @MVar@s keeping track of the two ends @@ -53,9 +51,7 @@ import Data.Typeable data Chan a = Chan _UPK_(MVar (Stream a)) _UPK_(MVar (Stream a)) -- Invariant: the Stream a is always an empty MVar - deriving Eq - -INSTANCE_TYPEABLE1(Chan,chanTc,"Chan") + deriving (Eq,Typeable) type Stream a = MVar (ChItem a) diff --git a/libraries/base/Control/Exception/Base.hs b/libraries/base/Control/Exception/Base.hs index 8ff5482690..d8a0d9635f 100644 --- a/libraries/base/Control/Exception/Base.hs +++ b/libraries/base/Control/Exception/Base.hs @@ -1,9 +1,7 @@ {-# LANGUAGE Trustworthy #-} -{-# LANGUAGE CPP, NoImplicitPrelude, MagicHash #-} +{-# LANGUAGE NoImplicitPrelude, MagicHash #-} {-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-} -#include "Typeable.h" - ----------------------------------------------------------------------------- -- | -- Module : Control.Exception.Base @@ -299,8 +297,7 @@ bracketOnError before after thing = -- |A pattern match failed. The @String@ gives information about the -- source location of the pattern. -data PatternMatchFail = PatternMatchFail String -INSTANCE_TYPEABLE0(PatternMatchFail,patternMatchFailTc,"PatternMatchFail") +data PatternMatchFail = PatternMatchFail String deriving Typeable instance Show PatternMatchFail where showsPrec _ (PatternMatchFail err) = showString err @@ -314,8 +311,7 @@ instance Exception PatternMatchFail -- multiple constructors, where some fields are in one constructor -- but not another. The @String@ gives information about the source -- location of the record selector. -data RecSelError = RecSelError String -INSTANCE_TYPEABLE0(RecSelError,recSelErrorTc,"RecSelError") +data RecSelError = RecSelError String deriving Typeable instance Show RecSelError where showsPrec _ (RecSelError err) = showString err @@ -327,8 +323,7 @@ instance Exception RecSelError -- |An uninitialised record field was used. The @String@ gives -- information about the source location where the record was -- constructed. -data RecConError = RecConError String -INSTANCE_TYPEABLE0(RecConError,recConErrorTc,"RecConError") +data RecConError = RecConError String deriving Typeable instance Show RecConError where showsPrec _ (RecConError err) = showString err @@ -342,8 +337,7 @@ instance Exception RecConError -- multiple constructors, where some fields are in one constructor -- but not another. The @String@ gives information about the source -- location of the record update. -data RecUpdError = RecUpdError String -INSTANCE_TYPEABLE0(RecUpdError,recUpdErrorTc,"RecUpdError") +data RecUpdError = RecUpdError String deriving Typeable instance Show RecUpdError where showsPrec _ (RecUpdError err) = showString err @@ -355,8 +349,7 @@ instance Exception RecUpdError -- |A class method without a definition (neither a default definition, -- nor a definition in the appropriate instance) was called. The -- @String@ gives information about which method it was. -data NoMethodError = NoMethodError String -INSTANCE_TYPEABLE0(NoMethodError,noMethodErrorTc,"NoMethodError") +data NoMethodError = NoMethodError String deriving Typeable instance Show NoMethodError where showsPrec _ (NoMethodError err) = showString err @@ -369,8 +362,7 @@ instance Exception NoMethodError -- guaranteed not to terminate. Note that there is no guarantee that -- the runtime system will notice whether any given computation is -- guaranteed to terminate or not. -data NonTermination = NonTermination -INSTANCE_TYPEABLE0(NonTermination,nonTerminationTc,"NonTermination") +data NonTermination = NonTermination deriving Typeable instance Show NonTermination where showsPrec _ NonTermination = showString "<<loop>>" @@ -381,8 +373,7 @@ instance Exception NonTermination -- |Thrown when the program attempts to call @atomically@, from the @stm@ -- package, inside another call to @atomically@. -data NestedAtomically = NestedAtomically -INSTANCE_TYPEABLE0(NestedAtomically,nestedAtomicallyTc,"NestedAtomically") +data NestedAtomically = NestedAtomically deriving Typeable instance Show NestedAtomically where showsPrec _ NestedAtomically = showString "Control.Concurrent.STM.atomically was nested" diff --git a/libraries/base/Control/Monad/ST/Imp.hs b/libraries/base/Control/Monad/ST/Imp.hs index 1df8628694..1c030e8d6e 100644 --- a/libraries/base/Control/Monad/ST/Imp.hs +++ b/libraries/base/Control/Monad/ST/Imp.hs @@ -1,5 +1,4 @@ {-# LANGUAGE Unsafe #-} -{-# LANGUAGE CPP #-} {-# OPTIONS_HADDOCK hide #-} ----------------------------------------------------------------------------- @@ -35,8 +34,6 @@ module Control.Monad.ST.Imp ( unsafeSTToIO ) where -#include "Typeable.h" - import GHC.ST ( ST, runST, fixST, unsafeInterleaveST ) import GHC.Base ( RealWorld ) import GHC.IO ( stToIO, unsafeIOToST, unsafeSTToIO ) diff --git a/libraries/base/Data/Complex.hs b/libraries/base/Data/Complex.hs index c852df9276..190c598115 100644 --- a/libraries/base/Data/Complex.hs +++ b/libraries/base/Data/Complex.hs @@ -1,5 +1,5 @@ {-# LANGUAGE Trustworthy #-} -{-# LANGUAGE CPP, DeriveDataTypeable #-} +{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE StandaloneDeriving #-} ----------------------------------------------------------------------------- @@ -52,7 +52,7 @@ infix 6 :+ data Complex a = !a :+ !a -- ^ forms a complex number from its real and imaginary -- rectangular components. - deriving (Eq, Show, Read, Data) + deriving (Eq, Show, Read, Data, Typeable) -- ----------------------------------------------------------------------------- -- Functions over Complex @@ -109,9 +109,6 @@ phase (x:+y) = atan2 y x -- ----------------------------------------------------------------------------- -- Instances of Complex -#include "Typeable.h" -INSTANCE_TYPEABLE1(Complex,complexTc,"Complex") - instance (RealFloat a) => Num (Complex a) where {-# SPECIALISE instance Num (Complex Float) #-} {-# SPECIALISE instance Num (Complex Double) #-} diff --git a/libraries/base/Data/Data.hs b/libraries/base/Data/Data.hs index 762d96b32f..6eedd2c222 100644 --- a/libraries/base/Data/Data.hs +++ b/libraries/base/Data/Data.hs @@ -1,5 +1,5 @@ {-# LANGUAGE Trustworthy, FlexibleInstances #-} -{-# LANGUAGE CPP, RankNTypes, ScopedTypeVariables, PolyKinds #-} +{-# LANGUAGE RankNTypes, ScopedTypeVariables, PolyKinds #-} {-# LANGUAGE StandaloneDeriving, DeriveDataTypeable, TypeOperators, GADTs #-} @@ -125,9 +125,6 @@ import GHC.ForeignPtr -- So we can give Data instance for ForeignPtr --import GHC.Conc -- So we can give Data instance for MVar & Co. import GHC.Arr -- So we can give Data instance for Array -#include "Typeable.h" - - ------------------------------------------------------------------------------ -- diff --git a/libraries/base/Data/Dynamic.hs b/libraries/base/Data/Dynamic.hs index ccf78f35d0..7d49a06bc3 100644 --- a/libraries/base/Data/Dynamic.hs +++ b/libraries/base/Data/Dynamic.hs @@ -1,5 +1,5 @@ {-# LANGUAGE Trustworthy #-} -{-# LANGUAGE CPP, NoImplicitPrelude #-} +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-} ----------------------------------------------------------------------------- @@ -51,8 +51,6 @@ import GHC.Base import GHC.Show import GHC.Exception -#include "Typeable.h" - ------------------------------------------------------------- -- -- The type Dynamic @@ -70,8 +68,7 @@ import GHC.Exception of the object\'s type; useful for debugging. -} data Dynamic = Dynamic TypeRep Obj - -INSTANCE_TYPEABLE0(Dynamic,dynamicTc,"Dynamic") + deriving Typeable instance Show Dynamic where -- the instance just prints the type representation. diff --git a/libraries/base/Data/Either.hs b/libraries/base/Data/Either.hs index ac8656e263..5ed041dd31 100644 --- a/libraries/base/Data/Either.hs +++ b/libraries/base/Data/Either.hs @@ -26,8 +26,6 @@ module Data.Either ( partitionEithers, ) where -#include "Typeable.h" - import GHC.Base import GHC.Show import GHC.Read @@ -50,7 +48,7 @@ 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) + deriving (Eq, Ord, Read, Show, Typeable) instance Functor (Either a) where fmap _ (Left x) = Left x @@ -68,8 +66,6 @@ either :: (a -> c) -> (b -> c) -> Either a b -> c either f _ (Left x) = f x either _ g (Right y) = g y -INSTANCE_TYPEABLE2(Either,eitherTc,"Either") - -- | Extracts from a list of 'Either' all the 'Left' elements -- All the 'Left' elements are extracted in order. diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index 4831ce6205..5dd1417228 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -281,39 +281,28 @@ funTc = typeRepTyCon (typeRep (Proxy :: Proxy (->))) -- ------------------------------------------------------------- -#include "Typeable.h" +deriving instance Typeable () +deriving instance Typeable [] +deriving instance Typeable Maybe +deriving instance Typeable Ratio +deriving instance Typeable (->) +deriving instance Typeable IO -INSTANCE_TYPEABLE0((),unitTc,"()") -INSTANCE_TYPEABLE1([],listTc,"[]") -INSTANCE_TYPEABLE1(Maybe,maybeTc,"Maybe") -INSTANCE_TYPEABLE1(Ratio,ratioTc,"Ratio") -INSTANCE_TYPEABLE2((->),funTc,"->") -INSTANCE_TYPEABLE1(IO,ioTc,"IO") +deriving instance Typeable Array --- Types defined in GHC.MVar -{- INSTANCE_TYPEABLE1(MVar,mvarTc,"MVar" ) -} +deriving instance Typeable ST +deriving instance Typeable STRef +deriving instance Typeable STArray -INSTANCE_TYPEABLE2(Array,arrayTc,"Array") -{- INSTANCE_TYPEABLE2(IOArray,iOArrayTc,"IOArray") -} +deriving instance Typeable (,) +deriving instance Typeable (,,) +deriving instance Typeable (,,,) +deriving instance Typeable (,,,,) +deriving instance Typeable (,,,,,) +deriving instance Typeable (,,,,,,) -INSTANCE_TYPEABLE2(ST,stTc,"ST") -INSTANCE_TYPEABLE2(STRef,stRefTc,"STRef") -INSTANCE_TYPEABLE3(STArray,sTArrayTc,"STArray") - -INSTANCE_TYPEABLE2((,),pairTc,"(,)") -INSTANCE_TYPEABLE3((,,),tup3Tc,"(,,)") -INSTANCE_TYPEABLE4((,,,),tup4Tc,"(,,,)") -INSTANCE_TYPEABLE5((,,,,),tup5Tc,"(,,,,)") -INSTANCE_TYPEABLE6((,,,,,),tup6Tc,"(,,,,,)") -INSTANCE_TYPEABLE7((,,,,,,),tup7Tc,"(,,,,,,)") - -INSTANCE_TYPEABLE1(Ptr,ptrTc,"Ptr") -INSTANCE_TYPEABLE1(FunPtr,funPtrTc,"FunPtr") - -{- -INSTANCE_TYPEABLE1(StablePtr,stablePtrTc,"StablePtr") -INSTANCE_TYPEABLE1(IORef,iORefTc,"IORef") --} +deriving instance Typeable Ptr +deriving instance Typeable FunPtr ------------------------------------------------------- -- @@ -321,29 +310,22 @@ INSTANCE_TYPEABLE1(IORef,iORefTc,"IORef") -- ------------------------------------------------------- -INSTANCE_TYPEABLE0(Bool,boolTc,"Bool") -INSTANCE_TYPEABLE0(Char,charTc,"Char") -INSTANCE_TYPEABLE0(Float,floatTc,"Float") -INSTANCE_TYPEABLE0(Double,doubleTc,"Double") -INSTANCE_TYPEABLE0(Int,intTc,"Int") -INSTANCE_TYPEABLE0(Word,wordTc,"Word" ) -INSTANCE_TYPEABLE0(Integer,integerTc,"Integer") -INSTANCE_TYPEABLE0(Ordering,orderingTc,"Ordering") - -{- -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") -INSTANCE_TYPEABLE0(Word32,word32Tc,"Word32") -INSTANCE_TYPEABLE0(Word64,word64Tc,"Word64") - -INSTANCE_TYPEABLE0(TyCon,tyconTc,"TyCon") -INSTANCE_TYPEABLE0(TypeRep,typeRepTc,"TypeRep") +deriving instance Typeable Bool +deriving instance Typeable Char +deriving instance Typeable Float +deriving instance Typeable Double +deriving instance Typeable Int +deriving instance Typeable Word +deriving instance Typeable Integer +deriving instance Typeable Ordering + +deriving instance Typeable Word8 +deriving instance Typeable Word16 +deriving instance Typeable Word32 +deriving instance Typeable Word64 + +deriving instance Typeable TyCon +deriving instance Typeable TypeRep deriving instance Typeable RealWorld deriving instance Typeable Proxy diff --git a/libraries/base/Foreign/C/Types.hs b/libraries/base/Foreign/C/Types.hs index 9951515816..b247b5afcf 100644 --- a/libraries/base/Foreign/C/Types.hs +++ b/libraries/base/Foreign/C/Types.hs @@ -91,31 +91,31 @@ import GHC.Num #include "CTypes.h" -- | Haskell type representing the C @char@ type. -INTEGRAL_TYPE(CChar,tyConCChar,"CChar",HTYPE_CHAR) +INTEGRAL_TYPE(CChar,HTYPE_CHAR) -- | Haskell type representing the C @signed char@ type. -INTEGRAL_TYPE(CSChar,tyConCSChar,"CSChar",HTYPE_SIGNED_CHAR) +INTEGRAL_TYPE(CSChar,HTYPE_SIGNED_CHAR) -- | Haskell type representing the C @unsigned char@ type. -INTEGRAL_TYPE(CUChar,tyConCUChar,"CUChar",HTYPE_UNSIGNED_CHAR) +INTEGRAL_TYPE(CUChar,HTYPE_UNSIGNED_CHAR) -- | Haskell type representing the C @short@ type. -INTEGRAL_TYPE(CShort,tyConCShort,"CShort",HTYPE_SHORT) +INTEGRAL_TYPE(CShort,HTYPE_SHORT) -- | Haskell type representing the C @unsigned short@ type. -INTEGRAL_TYPE(CUShort,tyConCUShort,"CUShort",HTYPE_UNSIGNED_SHORT) +INTEGRAL_TYPE(CUShort,HTYPE_UNSIGNED_SHORT) -- | Haskell type representing the C @int@ type. -INTEGRAL_TYPE(CInt,tyConCInt,"CInt",HTYPE_INT) +INTEGRAL_TYPE(CInt,HTYPE_INT) -- | Haskell type representing the C @unsigned int@ type. -INTEGRAL_TYPE(CUInt,tyConCUInt,"CUInt",HTYPE_UNSIGNED_INT) +INTEGRAL_TYPE(CUInt,HTYPE_UNSIGNED_INT) -- | Haskell type representing the C @long@ type. -INTEGRAL_TYPE(CLong,tyConCLong,"CLong",HTYPE_LONG) +INTEGRAL_TYPE(CLong,HTYPE_LONG) -- | Haskell type representing the C @unsigned long@ type. -INTEGRAL_TYPE(CULong,tyConCULong,"CULong",HTYPE_UNSIGNED_LONG) +INTEGRAL_TYPE(CULong,HTYPE_UNSIGNED_LONG) -- | Haskell type representing the C @long long@ type. -INTEGRAL_TYPE(CLLong,tyConCLLong,"CLLong",HTYPE_LONG_LONG) +INTEGRAL_TYPE(CLLong,HTYPE_LONG_LONG) -- | Haskell type representing the C @unsigned long long@ type. -INTEGRAL_TYPE(CULLong,tyConCULLong,"CULLong",HTYPE_UNSIGNED_LONG_LONG) +INTEGRAL_TYPE(CULLong,HTYPE_UNSIGNED_LONG_LONG) {-# RULES "fromIntegral/a->CChar" fromIntegral = \x -> CChar (fromIntegral x) @@ -144,9 +144,9 @@ INTEGRAL_TYPE(CULLong,tyConCULLong,"CULLong",HTYPE_UNSIGNED_LONG_LONG) #-} -- | Haskell type representing the C @float@ type. -FLOATING_TYPE(CFloat,tyConCFloat,"CFloat",HTYPE_FLOAT) +FLOATING_TYPE(CFloat,HTYPE_FLOAT) -- | Haskell type representing the C @double@ type. -FLOATING_TYPE(CDouble,tyConCDouble,"CDouble",HTYPE_DOUBLE) +FLOATING_TYPE(CDouble,HTYPE_DOUBLE) -- XXX GHC doesn't support CLDouble yet {-# RULES @@ -162,13 +162,13 @@ FLOATING_TYPE(CDouble,tyConCDouble,"CDouble",HTYPE_DOUBLE) -- "realToFrac/CLDouble->a" realToFrac = \(CLDouble x) -> realToFrac x -- | Haskell type representing the C @ptrdiff_t@ type. -INTEGRAL_TYPE(CPtrdiff,tyConCPtrdiff,"CPtrdiff",HTYPE_PTRDIFF_T) +INTEGRAL_TYPE(CPtrdiff,HTYPE_PTRDIFF_T) -- | Haskell type representing the C @size_t@ type. -INTEGRAL_TYPE(CSize,tyConCSize,"CSize",HTYPE_SIZE_T) +INTEGRAL_TYPE(CSize,HTYPE_SIZE_T) -- | Haskell type representing the C @wchar_t@ type. -INTEGRAL_TYPE(CWchar,tyConCWchar,"CWchar",HTYPE_WCHAR_T) +INTEGRAL_TYPE(CWchar,HTYPE_WCHAR_T) -- | Haskell type representing the C @sig_atomic_t@ type. -INTEGRAL_TYPE(CSigAtomic,tyConCSigAtomic,"CSigAtomic",HTYPE_SIG_ATOMIC_T) +INTEGRAL_TYPE(CSigAtomic,HTYPE_SIG_ATOMIC_T) {-# RULES "fromIntegral/a->CPtrdiff" fromIntegral = \x -> CPtrdiff (fromIntegral x) @@ -183,13 +183,13 @@ INTEGRAL_TYPE(CSigAtomic,tyConCSigAtomic,"CSigAtomic",HTYPE_SIG_ATOMIC_T) #-} -- | Haskell type representing the C @clock_t@ type. -ARITHMETIC_TYPE(CClock,tyConCClock,"CClock",HTYPE_CLOCK_T) +ARITHMETIC_TYPE(CClock,HTYPE_CLOCK_T) -- | Haskell type representing the C @time_t@ type. -ARITHMETIC_TYPE(CTime,tyConCTime,"CTime",HTYPE_TIME_T) +ARITHMETIC_TYPE(CTime,HTYPE_TIME_T) -- | Haskell type representing the C @useconds_t@ type. -ARITHMETIC_TYPE(CUSeconds,tyConCUSeconds,"CUSeconds",HTYPE_USECONDS_T) +ARITHMETIC_TYPE(CUSeconds,HTYPE_USECONDS_T) -- | Haskell type representing the C @suseconds_t@ type. -ARITHMETIC_TYPE(CSUSeconds,tyConCSUSeconds,"CSUSeconds",HTYPE_SUSECONDS_T) +ARITHMETIC_TYPE(CSUSeconds,HTYPE_SUSECONDS_T) -- FIXME: Implement and provide instances for Eq and Storable -- | Haskell type representing the C @FILE@ type. @@ -199,10 +199,10 @@ data CFpos = CFpos -- | Haskell type representing the C @jmp_buf@ type. data CJmpBuf = CJmpBuf -INTEGRAL_TYPE(CIntPtr,tyConCIntPtr,"CIntPtr",HTYPE_INTPTR_T) -INTEGRAL_TYPE(CUIntPtr,tyConCUIntPtr,"CUIntPtr",HTYPE_UINTPTR_T) -INTEGRAL_TYPE(CIntMax,tyConCIntMax,"CIntMax",HTYPE_INTMAX_T) -INTEGRAL_TYPE(CUIntMax,tyConCUIntMax,"CUIntMax",HTYPE_UINTMAX_T) +INTEGRAL_TYPE(CIntPtr,HTYPE_INTPTR_T) +INTEGRAL_TYPE(CUIntPtr,HTYPE_UINTPTR_T) +INTEGRAL_TYPE(CIntMax,HTYPE_INTMAX_T) +INTEGRAL_TYPE(CUIntMax,HTYPE_UINTMAX_T) {-# RULES "fromIntegral/a->CIntPtr" fromIntegral = \x -> CIntPtr (fromIntegral x) diff --git a/libraries/base/Foreign/Ptr.hs b/libraries/base/Foreign/Ptr.hs index 808fff636a..f85a7e7699 100644 --- a/libraries/base/Foreign/Ptr.hs +++ b/libraries/base/Foreign/Ptr.hs @@ -79,13 +79,13 @@ foreign import ccall unsafe "freeHaskellFunctionPtr" -- | An unsigned integral type that can be losslessly converted to and from -- @Ptr@. This type is also compatible with the C99 type @uintptr_t@, and -- can be marshalled to and from that type safely. -INTEGRAL_TYPE(WordPtr,tyConWordPtr,"WordPtr",Word) +INTEGRAL_TYPE(WordPtr,Word) -- Word and Int are guaranteed pointer-sized in GHC -- | A signed integral type that can be losslessly converted to and from -- @Ptr@. This type is also compatible with the C99 type @intptr_t@, and -- can be marshalled to and from that type safely. -INTEGRAL_TYPE(IntPtr,tyConIntPtr,"IntPtr",Int) +INTEGRAL_TYPE(IntPtr,Int) -- Word and Int are guaranteed pointer-sized in GHC -- | casts a @Ptr@ to a @WordPtr@ diff --git a/libraries/base/GHC/Conc.lhs b/libraries/base/GHC/Conc.lhs index ded38d541e..02781237df 100644 --- a/libraries/base/GHC/Conc.lhs +++ b/libraries/base/GHC/Conc.lhs @@ -23,8 +23,6 @@ -- bits it exports, we'd rather have Control.Concurrent and the other -- higher level modules be the home. Hence: -#include "Typeable.h" - -- #not-home module GHC.Conc ( ThreadId(..) diff --git a/libraries/base/GHC/Conc/IO.hs b/libraries/base/GHC/Conc/IO.hs index c864fdc2bf..6ee23e5b1e 100644 --- a/libraries/base/GHC/Conc/IO.hs +++ b/libraries/base/GHC/Conc/IO.hs @@ -27,8 +27,6 @@ -- bits it exports, we'd rather have Control.Concurrent and the other -- higher level modules be the home. Hence: -#include "Typeable.h" - -- #not-home module GHC.Conc.IO ( ensureIOManagerIsRunning diff --git a/libraries/base/GHC/Conc/Sync.lhs b/libraries/base/GHC/Conc/Sync.lhs index 7cbc2088b5..0feec12669 100644 --- a/libraries/base/GHC/Conc/Sync.lhs +++ b/libraries/base/GHC/Conc/Sync.lhs @@ -34,8 +34,6 @@ -- bits it exports, we'd rather have Control.Concurrent and the other -- higher level modules be the home. Hence: -#include "Typeable.h" - -- #not-home module GHC.Conc.Sync ( ThreadId(..) @@ -527,12 +525,11 @@ transactions. \begin{code} -- |A monad supporting atomic memory transactions. newtype STM a = STM (State# RealWorld -> (# State# RealWorld, a #)) + deriving Typeable unSTM :: STM a -> (State# RealWorld -> (# State# RealWorld, a #)) unSTM (STM a) = a -INSTANCE_TYPEABLE1(STM,stmTc,"STM") - instance Functor STM where fmap f x = x >>= (return . f) @@ -670,8 +667,7 @@ always i = alwaysSucceeds ( do v <- i -- |Shared memory locations that support atomic memory transactions. data TVar a = TVar (TVar# RealWorld a) - -INSTANCE_TYPEABLE1(TVar,tvarTc,"TVar") + deriving Typeable instance Eq (TVar a) where (TVar tvar1#) == (TVar tvar2#) = sameTVar tvar1# tvar2# diff --git a/libraries/base/GHC/ForeignPtr.hs b/libraries/base/GHC/ForeignPtr.hs index bd26481f07..daa8be9f0e 100644 --- a/libraries/base/GHC/ForeignPtr.hs +++ b/libraries/base/GHC/ForeignPtr.hs @@ -1,6 +1,5 @@ {-# LANGUAGE Unsafe #-} -{-# LANGUAGE CPP - , NoImplicitPrelude +{-# LANGUAGE NoImplicitPrelude , BangPatterns , MagicHash , UnboxedTuples @@ -56,8 +55,6 @@ import GHC.IORef import GHC.STRef ( STRef(..) ) import GHC.Ptr ( Ptr(..), FunPtr(..) ) -#include "Typeable.h" - -- |The type 'ForeignPtr' represents references to objects that are -- maintained in a foreign language, i.e., that are not part of the -- data structures usually managed by the Haskell storage manager. @@ -75,6 +72,7 @@ import GHC.Ptr ( Ptr(..), FunPtr(..) ) -- class 'Storable'. -- data ForeignPtr a = ForeignPtr Addr# ForeignPtrContents + deriving Typeable -- we cache the Addr# in the ForeignPtr object, but attach -- the finalizer to the IORef (or the MutableByteArray# in -- the case of a MallocPtr). The aim of the representation @@ -85,8 +83,6 @@ data ForeignPtr a = ForeignPtr Addr# ForeignPtrContents -- object, because that ensures that whatever the finalizer is -- attached to is kept alive. -INSTANCE_TYPEABLE1(ForeignPtr,foreignPtrTc,"ForeignPtr") - data Finalizers = NoFinalizers | CFinalizers (Weak# ()) diff --git a/libraries/base/GHC/Weak.lhs b/libraries/base/GHC/Weak.lhs index e3109e1e7f..b3ae376f33 100644 --- a/libraries/base/GHC/Weak.lhs +++ b/libraries/base/GHC/Weak.lhs @@ -1,7 +1,6 @@ \begin{code} {-# LANGUAGE Unsafe #-} -{-# LANGUAGE CPP - , NoImplicitPrelude +{-# LANGUAGE NoImplicitPrelude , BangPatterns , MagicHash , UnboxedTuples @@ -95,10 +94,7 @@ finalizer to the box itself fails when the outer box is optimised away by the compiler. -} -data Weak v = Weak (Weak# v) - -#include "Typeable.h" -INSTANCE_TYPEABLE1(Weak,weakTc,"Weak") +data Weak v = Weak (Weak# v) deriving Typeable -- | Establishes a weak pointer to @k@, with value @v@ and a finalizer. -- diff --git a/libraries/base/System/Mem/StableName.hs b/libraries/base/System/Mem/StableName.hs index 2cd09feb79..1633efed83 100644 --- a/libraries/base/System/Mem/StableName.hs +++ b/libraries/base/System/Mem/StableName.hs @@ -78,7 +78,7 @@ import GHC.Base ( Int(..), StableName#, makeStableName# -} data StableName a = StableName (StableName# a) - + deriving Typeable -- | Makes a 'StableName' for an arbitrary object. The object passed as -- the first argument is not evaluated by 'makeStableName'. @@ -124,6 +124,3 @@ eqStableName (StableName sn1) (StableName sn2) = -- Requested by Emil Axelsson on glasgow-haskell-users, who wants to -- use it for implementing observable sharing. -#include "Typeable.h" -INSTANCE_TYPEABLE1(StableName,stableNameTc,"StableName") - diff --git a/libraries/base/System/Posix/Types.hs b/libraries/base/System/Posix/Types.hs index dd5b98771b..aa159155c0 100644 --- a/libraries/base/System/Posix/Types.hs +++ b/libraries/base/System/Posix/Types.hs @@ -106,53 +106,53 @@ import GHC.Show #include "CTypes.h" #if defined(HTYPE_DEV_T) -INTEGRAL_TYPE(CDev,tyConCDev,"CDev",HTYPE_DEV_T) +INTEGRAL_TYPE(CDev,HTYPE_DEV_T) #endif #if defined(HTYPE_INO_T) -INTEGRAL_TYPE(CIno,tyConCIno,"CIno",HTYPE_INO_T) +INTEGRAL_TYPE(CIno,HTYPE_INO_T) #endif #if defined(HTYPE_MODE_T) -INTEGRAL_TYPE_WITH_CTYPE(CMode,mode_t,tyConCMode,"CMode",HTYPE_MODE_T) +INTEGRAL_TYPE_WITH_CTYPE(CMode,mode_t,HTYPE_MODE_T) #endif #if defined(HTYPE_OFF_T) -INTEGRAL_TYPE(COff,tyConCOff,"COff",HTYPE_OFF_T) +INTEGRAL_TYPE(COff,HTYPE_OFF_T) #endif #if defined(HTYPE_PID_T) -INTEGRAL_TYPE(CPid,tyConCPid,"CPid",HTYPE_PID_T) +INTEGRAL_TYPE(CPid,HTYPE_PID_T) #endif #if defined(HTYPE_SSIZE_T) -INTEGRAL_TYPE(CSsize,tyConCSsize,"CSsize",HTYPE_SSIZE_T) +INTEGRAL_TYPE(CSsize,HTYPE_SSIZE_T) #endif #if defined(HTYPE_GID_T) -INTEGRAL_TYPE(CGid,tyConCGid,"CGid",HTYPE_GID_T) +INTEGRAL_TYPE(CGid,HTYPE_GID_T) #endif #if defined(HTYPE_NLINK_T) -INTEGRAL_TYPE(CNlink,tyConCNlink,"CNlink",HTYPE_NLINK_T) +INTEGRAL_TYPE(CNlink,HTYPE_NLINK_T) #endif #if defined(HTYPE_UID_T) -INTEGRAL_TYPE(CUid,tyConCUid,"CUid",HTYPE_UID_T) +INTEGRAL_TYPE(CUid,HTYPE_UID_T) #endif #if defined(HTYPE_CC_T) -ARITHMETIC_TYPE(CCc,tyConCCc,"CCc",HTYPE_CC_T) +ARITHMETIC_TYPE(CCc,HTYPE_CC_T) #endif #if defined(HTYPE_SPEED_T) -ARITHMETIC_TYPE(CSpeed,tyConCSpeed,"CSpeed",HTYPE_SPEED_T) +ARITHMETIC_TYPE(CSpeed,HTYPE_SPEED_T) #endif #if defined(HTYPE_TCFLAG_T) -INTEGRAL_TYPE(CTcflag,tyConCTcflag,"CTcflag",HTYPE_TCFLAG_T) +INTEGRAL_TYPE(CTcflag,HTYPE_TCFLAG_T) #endif #if defined(HTYPE_RLIM_T) -INTEGRAL_TYPE(CRLim,tyConCRlim,"CRLim",HTYPE_RLIM_T) +INTEGRAL_TYPE(CRLim,HTYPE_RLIM_T) #endif -- ToDo: blksize_t, clockid_t, blkcnt_t, fsblkcnt_t, fsfilcnt_t, id_t, key_t -- suseconds_t, timer_t, useconds_t -- Make an Fd type rather than using CInt everywhere -INTEGRAL_TYPE(Fd,tyConFd,"Fd",CInt) +INTEGRAL_TYPE(Fd,CInt) -- nicer names, and backwards compatibility with POSIX library: #if defined(HTYPE_NLINK_T) diff --git a/libraries/base/System/Timeout.hs b/libraries/base/System/Timeout.hs index a7b124abc8..59e6647b0e 100644 --- a/libraries/base/System/Timeout.hs +++ b/libraries/base/System/Timeout.hs @@ -16,8 +16,6 @@ -- ------------------------------------------------------------------------------- -#include "Typeable.h" - module System.Timeout ( timeout ) where #ifndef mingw32_HOST_OS @@ -38,8 +36,7 @@ import Data.Unique (Unique, newUnique) -- interrupt the running IO computation when the timeout has -- expired. -newtype Timeout = Timeout Unique deriving Eq -INSTANCE_TYPEABLE0(Timeout,timeoutTc,"Timeout") +newtype Timeout = Timeout Unique deriving (Eq, Typeable) instance Show Timeout where show _ = "<<timeout>>" diff --git a/libraries/base/include/CTypes.h b/libraries/base/include/CTypes.h index a33d1faab5..77b738c955 100644 --- a/libraries/base/include/CTypes.h +++ b/libraries/base/include/CTypes.h @@ -8,8 +8,6 @@ #ifndef CTYPES__H #define CTYPES__H -#include "Typeable.h" - {- // As long as there is no automatic derivation of classes for newtypes we resort // to extremely dirty cpp-hackery. :-P Some care has to be taken when the @@ -18,33 +16,29 @@ -- // GHC can derive any class for a newtype, so we make use of that here... -#define ARITHMETIC_CLASSES Eq,Ord,Num,Enum,Storable,Real +#define ARITHMETIC_CLASSES Eq,Ord,Num,Enum,Storable,Real,Typeable #define INTEGRAL_CLASSES Bounded,Integral,Bits #define FLOATING_CLASSES Fractional,Floating,RealFrac,RealFloat -#define ARITHMETIC_TYPE(T,C,S,B) \ +#define ARITHMETIC_TYPE(T,B) \ newtype T = T B deriving (ARITHMETIC_CLASSES); \ INSTANCE_READ(T,B); \ -INSTANCE_SHOW(T,B); \ -INSTANCE_TYPEABLE0(T,C,S) ; +INSTANCE_SHOW(T,B); -#define INTEGRAL_TYPE(T,C,S,B) \ +#define INTEGRAL_TYPE(T,B) \ newtype T = T B deriving (ARITHMETIC_CLASSES, INTEGRAL_CLASSES); \ INSTANCE_READ(T,B); \ -INSTANCE_SHOW(T,B); \ -INSTANCE_TYPEABLE0(T,C,S) ; +INSTANCE_SHOW(T,B); -#define INTEGRAL_TYPE_WITH_CTYPE(T,THE_CTYPE,C,S,B) \ +#define INTEGRAL_TYPE_WITH_CTYPE(T,THE_CTYPE,B) \ newtype {-# CTYPE "THE_CTYPE" #-} T = T B deriving (ARITHMETIC_CLASSES, INTEGRAL_CLASSES); \ INSTANCE_READ(T,B); \ -INSTANCE_SHOW(T,B); \ -INSTANCE_TYPEABLE0(T,C,S) ; +INSTANCE_SHOW(T,B); -#define FLOATING_TYPE(T,C,S,B) \ +#define FLOATING_TYPE(T,B) \ newtype T = T B deriving (ARITHMETIC_CLASSES, FLOATING_CLASSES); \ INSTANCE_READ(T,B); \ -INSTANCE_SHOW(T,B); \ -INSTANCE_TYPEABLE0(T,C,S) ; +INSTANCE_SHOW(T,B); #define INSTANCE_READ(T,B) \ instance Read T where { \ diff --git a/libraries/base/include/Typeable.h b/libraries/base/include/Typeable.h index ae04142014..1a3149885d 100644 --- a/libraries/base/include/Typeable.h +++ b/libraries/base/include/Typeable.h @@ -14,6 +14,8 @@ #ifndef TYPEABLE_H #define TYPEABLE_H +#warning <Typeable.h> is obsolete and will be removed in GHC 7.10 + -- // For GHC, we can use DeriveDataTypeable + StandaloneDeriving to -- // generate the instances. |