Make `<Typeable.h>` obsolete and refactor away its use
authorHerbert Valerio Riedel <hvr@gnu.org>
Sun, 15 Sep 2013 21:49:32 +0000 (23:49 +0200)
committerHerbert Valerio Riedel <hvr@gnu.org>
Tue, 17 Sep 2013 08:41:44 +0000 (10:41 +0200)
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>
20 files changed:
Control/Concurrent/Chan.hs
Control/Exception/Base.hs
Control/Monad/ST/Imp.hs
Data/Complex.hs
Data/Data.hs
Data/Dynamic.hs
Data/Either.hs
Data/Typeable/Internal.hs
Foreign/C/Types.hs
Foreign/Ptr.hs
GHC/Conc.lhs
GHC/Conc/IO.hs
GHC/Conc/Sync.lhs
GHC/ForeignPtr.hs
GHC/Weak.lhs
System/Mem/StableName.hs
System/Posix/Types.hs
System/Timeout.hs
include/CTypes.h
include/Typeable.h

index 0efc172..98c2efd 100644 (file)
@@ -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)
 
index 8ff5482..d8a0d96 100644 (file)
@@ -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"
index 1df8628..1c030e8 100644 (file)
@@ -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 )
index c852df9..190c598 100644 (file)
@@ -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) #-}
index 762d96b..6eedd2c 100644 (file)
@@ -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"
-
-
 
 ------------------------------------------------------------------------------
 --
index ccf78f3..7d49a06 100644 (file)
@@ -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.
index ac8656e..5ed041d 100644 (file)
@@ -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.
 
index 4831ce6..5dd1417 100644 (file)
@@ -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
index 9951515..b247b5a 100644 (file)
@@ -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)
index 808fff6..f85a7e7 100644 (file)
@@ -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@
index ded38d5..0278123 100644 (file)
@@ -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(..)
index c864fdc..6ee23e5 100644 (file)
@@ -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
index 7cbc208..0feec12 100644 (file)
@@ -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#
index bd26481..daa8be9 100644 (file)
@@ -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# ())
index e3109e1..b3ae376 100644 (file)
@@ -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.
 --
index 2cd09fe..1633efe 100644 (file)
@@ -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")
-
index dd5b987..aa15915 100644 (file)
@@ -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)
index a7b124a..59e6647 100644 (file)
@@ -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>>"
index a33d1fa..77b738c 100644 (file)
@@ -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
 
 --  // 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 { \
index ae04142..1a31498 100644 (file)
@@ -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.