[project @ 2005-02-02 13:26:13 by simonpj]

I've moved Typeable instances so that they are
either in the module that defines the type
or in the Typeable module (which defines the class)

GHC dislikes "orphan" instances, and even for humans
this makes it easier to find.

I have continued to use the INSTANCE_TYPEABLE macros,
rather than GHC's deriving( Typeable ) mechanism, so
that it'll still work for Hugs and NHC.  Nevertheless,
I may well have missed some Hugs- or NHC-specific imports,
for which I apologise.  Malcolm, Ross you may want to try
a fresh build.

diff --git a/Control/Concurrent.hs b/Control/Concurrent.hs
index 8df665e..6f183cb 100644 (file)
--- a/Control/Concurrent.hs
+++ b/Control/Concurrent.hs
@@ -96,7 +96,7 @@ import GHC.Conc               ( ThreadId(..), myThreadId, killThread, yield,
 import GHC.TopHandler   ( reportStackOverflow, reportError )
 import GHC.IOBase      ( IO(..) )
 import GHC.IOBase      ( unsafeInterleaveIO )
-import GHC.IOBase   ( newIORef, readIORef, writeIORef )
+import GHC.IOBase      ( newIORef, readIORef, writeIORef )
 import GHC.Base
 
 import Foreign.StablePtr

diff --git a/Control/Exception.hs b/Control/Exception.hs
index 83f37cb..7551e25 100644 (file)
--- a/Control/Exception.hs
+++ b/Control/Exception.hs
@@ -130,13 +130,6 @@ import System.IO.Error     hiding ( catch, try )
 import System.IO.Unsafe (unsafePerformIO)
 import Data.Dynamic
 
-#include "Typeable.h"
-INSTANCE_TYPEABLE0(Exception,exceptionTc,"Exception")
-INSTANCE_TYPEABLE0(IOException,ioExceptionTc,"IOException")
-INSTANCE_TYPEABLE0(ArithException,arithExceptionTc,"ArithException")
-INSTANCE_TYPEABLE0(ArrayException,arrayExceptionTc,"ArrayException")
-INSTANCE_TYPEABLE0(AsyncException,asyncExceptionTc,"AsyncException")
-
 -----------------------------------------------------------------------------
 -- Catching exceptions
 

diff --git a/Control/Monad/ST.hs b/Control/Monad/ST.hs
index 0e34857..c51ea9a 100644 (file)
--- a/Control/Monad/ST.hs
+++ b/Control/Monad/ST.hs
@@ -41,7 +41,6 @@ import Data.Typeable
 import Hugs.ST
 import qualified Hugs.LazyST as LazyST
 
-INSTANCE_TYPEABLE2(ST,sTTc,"ST")
 INSTANCE_TYPEABLE0(RealWorld,realWorldTc,"RealWorld")
 
 fixST :: (a -> ST s a) -> ST s a

diff --git a/Data/Array.hs b/Data/Array.hs
index 263f970..09c4f65 100644 (file)
--- a/Data/Array.hs
+++ b/Data/Array.hs
@@ -73,22 +73,6 @@ import Array         -- Haskell'98 arrays
 #endif
 
 import Data.Typeable
-#include "Typeable.h"
-INSTANCE_TYPEABLE2(Array,arrayTc,"Array")
-
-#ifdef __GLASGOW_HASKELL__
-
--- This instance preserves data abstraction at the cost of inefficiency.
--- We omit reflection services for the sake of data abstraction.
-
-instance (Typeable a, Data b, Ix a) => Data (Array a b)
- where
-  gfoldl f z a = z (listArray (bounds a)) `f` (elems a)
-  toConstr _   = error "toConstr"
-  gunfold _ _  = error "gunfold"
-  dataTypeOf _ = mkNorepType "Data.Array.Array"
-
-#endif
 
 {- $intro
 Haskell provides indexable /arrays/, which may be thought of as functions

diff --git a/Data/Array/Base.hs b/Data/Array/Base.hs
index b284cf4..12dbb8e 100644 (file)
--- a/Data/Array/Base.hs
+++ b/Data/Array/Base.hs
@@ -1072,11 +1072,6 @@ instance MArray (STArray s) e (ST s) where
     unsafeWrite = ArrST.unsafeWriteSTArray
 
 -----------------------------------------------------------------------------
--- Typeable instance for STArray
-
-INSTANCE_TYPEABLE3(STArray,sTArrayTc,"STArray")
-
------------------------------------------------------------------------------
 -- Flat unboxed mutable arrays (ST monad)
 
 -- | A mutable array with unboxed elements, that can be manipulated in

diff --git a/Data/Complex.hs b/Data/Complex.hs
index 20448c7..6b9999b 100644 (file)
--- a/Data/Complex.hs
+++ b/Data/Complex.hs
@@ -120,10 +120,8 @@ phase (x:+y)        = atan2 y x
 -- -----------------------------------------------------------------------------
 -- Instances of Complex
 
-#ifndef __NHC__
 #include "Typeable.h"
 INSTANCE_TYPEABLE1(Complex,complexTc,"Complex")
-#endif
 
 instance  (RealFloat a) => Num (Complex a)  where
     {-# SPECIALISE instance Num (Complex Float) #-}

diff --git a/Data/Generics/Instances.hs b/Data/Generics/Instances.hs
index 1157dc5..293b1e1 100644 (file)
--- a/Data/Generics/Instances.hs
+++ b/Data/Generics/Instances.hs
@@ -38,6 +38,7 @@ import GHC.ForeignPtr      -- So we can give Data instance for ForeignPtr
 import GHC.Stable           -- So we can give Data instance for StablePtr
 import GHC.ST               -- So we can give Data instance for ST
 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"
 
@@ -605,3 +606,12 @@ instance Typeable a => Data (STM a) where
 
 
 ------------------------------------------------------------------------------
+-- The Data instance for Array preserves data abstraction at the cost of inefficiency.
+-- We omit reflection services for the sake of data abstraction.
+instance (Typeable a, Data b, Ix a) => Data (Array a b)
+ where
+  gfoldl f z a = z (listArray (bounds a)) `f` (elems a)
+  toConstr _   = error "toConstr"
+  gunfold _ _  = error "gunfold"
+  dataTypeOf _ = mkNorepType "Data.Array.Array"
+

diff --git a/Data/STRef.hs b/Data/STRef.hs
index 3edfb87..d261cbf 100644 (file)
--- a/Data/STRef.hs
+++ b/Data/STRef.hs
@@ -32,11 +32,6 @@ import GHC.STRef
 import Hugs.ST
 #endif
 
-import Data.Typeable
-
-#include "Typeable.h"
-INSTANCE_TYPEABLE2(STRef,stRefTc,"STRef")
-
 -- |Mutate the contents of an 'STRef'
 modifySTRef :: STRef s a -> (a -> a) -> ST s ()
 modifySTRef ref f = writeSTRef ref . f =<< readSTRef ref

diff --git a/Data/Typeable.hs b/Data/Typeable.hs
index efb020e..a25e7d6 100644 (file)
--- a/Data/Typeable.hs
+++ b/Data/Typeable.hs
@@ -94,12 +94,21 @@ import GHC.Show
 import GHC.Err
 import GHC.Num
 import GHC.Float
-import GHC.Real( rem, Ratio )
-import GHC.IOBase
-import GHC.ST          -- So we can give Typeable instance for ST
-import GHC.Ptr          -- So we can give Typeable instance for Ptr
-import GHC.ForeignPtr   -- So we can give Typeable instance for ForeignPtr
-import GHC.Stable       -- So we can give Typeable instance for StablePtr
+import GHC.Real                ( rem, Ratio )
+import GHC.IOBase      (IORef,newIORef,unsafePerformIO)
+
+-- These imports are so we can define Typeable instances
+-- It'd be better to give Typeable instances in the modules themselves
+-- but they all have to be compiled before Typeable
+import GHC.IOBase      ( IO, MVar, Exception, ArithException, IOException, 
+                         ArrayException, AsyncException, Handle )
+import GHC.ST          ( ST )
+import GHC.STRef       ( STRef )
+import GHC.Ptr          ( Ptr )
+import GHC.ForeignPtr   ( ForeignPtr )
+import GHC.Stable       ( StablePtr )
+import GHC.Arr         ( Array, STArray )
+
 #endif
 
 #ifdef __HUGS__
@@ -107,6 +116,11 @@ import Hugs.Prelude
 import Hugs.IO
 import Hugs.IORef
 import Hugs.IOExts
+       -- For the Typeable instance
+import Hugs.Array       ( Array )
+import Hugs.ST          ( ST, STRef, STArray )
+import Hugs.ForeignPtr  ( ForeignPtr )
+imprt 
 #endif
 
 #ifdef __GLASGOW_HASKELL__
@@ -119,8 +133,9 @@ import NonStdUnsafeCoerce (unsafeCoerce)
 import NHC.IOExtras (IORef,newIORef,readIORef,writeIORef,unsafePerformIO)
 import IO (Handle)
 import Ratio (Ratio)
-import NHC.FFI (Ptr,StablePtr)
-#else
+       -- For the Typeable instance
+import NHC.FFI ( Ptr,StablePtr )
+import Array   ( Array )
 #endif
 
 #include "Typeable.h"
@@ -459,21 +474,42 @@ gcast2 x = r
 --
 -------------------------------------------------------------
 
+INSTANCE_TYPEABLE0((),unitTc,"()")
 INSTANCE_TYPEABLE1([],listTc,"[]")
 INSTANCE_TYPEABLE1(Maybe,maybeTc,"Maybe")
 INSTANCE_TYPEABLE1(Ratio,ratioTc,"Ratio")
 INSTANCE_TYPEABLE2(Either,eitherTc,"Either")
 INSTANCE_TYPEABLE2((->),funTc,"->")
 INSTANCE_TYPEABLE1(IO,ioTc,"IO")
+
 #ifdef __GLASGOW_HASKELL__
-INSTANCE_TYPEABLE2(ST,stTc,"ST")
-INSTANCE_TYPEABLE1(ForeignPtr,foreignPtrTc,"ForeignPtr")
+
+
+-- Types defined in GHC.IOBase
+INSTANCE_TYPEABLE1(MVar,mvarTc,"MVar" )
+INSTANCE_TYPEABLE0(Exception,exceptionTc,"Exception")
+INSTANCE_TYPEABLE0(IOException,ioExceptionTc,"IOException")
+INSTANCE_TYPEABLE0(ArithException,arithExceptionTc,"ArithException")
+INSTANCE_TYPEABLE0(ArrayException,arrayExceptionTc,"ArrayException")
+INSTANCE_TYPEABLE0(AsyncException,asyncExceptionTc,"AsyncException")
+
+-- Types defined in GHC.Arr
+INSTANCE_TYPEABLE2(Array,arrayTc,"Array")
 #endif
-INSTANCE_TYPEABLE0((),unitTc,"()")
+
+
 #ifndef __NHC__
 INSTANCE_TYPEABLE2((,),pairTc,",")
 INSTANCE_TYPEABLE3((,,),tup3Tc,",,")
 
+-- I don't think NHC has ST, STRef, STArray, ForeignPtr
+-- but GHC and Hugs do
+INSTANCE_TYPEABLE2(ST,stTc,"ST")
+INSTANCE_TYPEABLE2(STRef,stRefTc,"STRef")
+INSTANCE_TYPEABLE1(ForeignPtr,foreignPtrTc,"ForeignPtr")
+INSTANCE_TYPEABLE3(STArray,sTArrayTc,"STArray")
+
+
 tup4Tc :: TyCon
 tup4Tc = mkTyCon ",,,"
 
@@ -553,7 +589,7 @@ data KeyPr = KeyPr !Key !Key deriving( Eq )
 hashKP :: KeyPr -> Int32
 hashKP (KeyPr (Key k1) (Key k2)) = (HT.hashInt k1 + HT.hashInt k2) `rem` HT.prime
 
-data Cache = Cache { next_key :: !(IORef Key),
+data Cache = Cache { next_key :: !(IORef Key), -- Not used by GHC (calls genSym instead)
                     tc_tbl   :: !(HT.HashTable String Key),
                     ap_tbl   :: !(HT.HashTable KeyPr Key) }
 

diff --git a/Foreign/ForeignPtr.hs b/Foreign/ForeignPtr.hs
index 50db97d..53275c1 100644 (file)
--- a/Foreign/ForeignPtr.hs
+++ b/Foreign/ForeignPtr.hs
@@ -86,10 +86,6 @@ import GHC.ForeignPtr
 
 #if !defined(__NHC__) && !defined(__GLASGOW_HASKELL__)
 import Foreign.Marshal.Alloc   ( malloc, mallocBytes, finalizerFree )
-import Data.Typeable
-
-#include "Typeable.h"
-INSTANCE_TYPEABLE1(ForeignPtr,foreignPtrTc,"ForeignPtr")
 
 instance Eq (ForeignPtr a) where 
     p == q  =  unsafeForeignPtrToPtr p == unsafeForeignPtrToPtr q

diff --git a/GHC/Conc.lhs b/GHC/Conc.lhs
index 93ffba7..0e74dc7 100644 (file)
--- a/GHC/Conc.lhs
+++ b/GHC/Conc.lhs
@@ -81,7 +81,6 @@ import GHC.Pack               ( packCString# )
 import GHC.Ptr          ( Ptr(..), plusPtr, FunPtr(..) )
 import GHC.STRef
 import Data.Typeable
-#include "Typeable.h"
 
 infixr 0 `par`, `pseq`
 \end{code}
@@ -93,7 +92,7 @@ infixr 0 `par`, `pseq`
 %************************************************************************
 
 \begin{code}
-data ThreadId = ThreadId ThreadId#
+data ThreadId = ThreadId ThreadId# deriving( Typeable )
 -- ToDo: data ThreadId = ThreadId (Weak ThreadId#)
 -- But since ThreadId# is unlifted, the Weak type must use open
 -- type variables.
@@ -115,9 +114,6 @@ This misfeature will hopefully be corrected at a later date.
 it defines 'ThreadId' as a synonym for ().
 -}
 
-INSTANCE_TYPEABLE0(ThreadId,threadIdTc,"ThreadId")
-
-
 --forkIO has now been hoisted out into the Concurrent library.
 
 {- | 'killThread' terminates the given thread (GHC only).
@@ -206,9 +202,7 @@ TVars are shared memory locations which support atomic memory
 transactions.
 
 \begin{code}
-newtype STM a = STM (State# RealWorld -> (# State# RealWorld, a #))
-
-INSTANCE_TYPEABLE1(STM,stmTc,"STM" )
+newtype STM a = STM (State# RealWorld -> (# State# RealWorld, a #)) deriving( Typeable )
 
 unSTM :: STM a -> (State# RealWorld -> (# State# RealWorld, a #))
 unSTM (STM a) = a
@@ -266,9 +260,7 @@ orElse (STM m) e = STM $ \s -> catchRetry# m (unSTM e) s
 catchSTM :: STM a -> (Exception -> STM a) -> STM a
 catchSTM (STM m) k = STM $ \s -> catchSTM# m (\ex -> unSTM (k ex)) s
 
-data TVar a = TVar (TVar# RealWorld a)
-
-INSTANCE_TYPEABLE1(TVar,tvarTc,"TVar" )
+data TVar a = TVar (TVar# RealWorld a) deriving( Typeable )
 
 instance Eq (TVar a) where
        (TVar tvar1#) == (TVar tvar2#) = sameTVar# tvar1# tvar2#
@@ -308,8 +300,6 @@ writes.
 \begin{code}
 --Defined in IOBase to avoid cycle: data MVar a = MVar (SynchVar# RealWorld a)
 
-INSTANCE_TYPEABLE1(MVar,mvarTc,"MVar" )
-
 -- |Create an 'MVar' which is initially empty.
 newEmptyMVar  :: IO (MVar a)
 newEmptyMVar = IO $ \ s# ->

diff --git a/GHC/IOBase.lhs b/GHC/IOBase.lhs
index 233148b..a58ee79 100644 (file)
--- a/GHC/IOBase.lhs
+++ b/GHC/IOBase.lhs
@@ -14,14 +14,40 @@
 --
 -----------------------------------------------------------------------------
 
-module GHC.IOBase where
-
+module GHC.IOBase(
+    IO(..), unIO, failIO, liftIO, bindIO, thenIO, returnIO, 
+    unsafePerformIO, unsafeInterleaveIO,
+  
+       -- To and from from ST
+    stToIO, ioToST, unsafeIOToST,
+
+       -- References
+    IORef(..), newIORef, readIORef, writeIORef, 
+    IOArray(..), newIOArray, readIOArray, writeIOArray, unsafeReadIOArray, unsafeWriteIOArray,
+    MVar(..),
+
+       -- Handles, file descriptors,
+    FilePath,  
+    Handle(..), Handle__(..), HandleType(..), IOMode(..), FD, 
+    isReadableHandleType, isWritableHandleType, showHandle,
+  
+       -- Buffers
+    Buffer(..), RawBuffer, BufferState(..), BufferList(..), BufferMode(..),
+    bufferIsWritable, bufferEmpty, bufferFull, 
+
+       -- Exceptions
+    Exception(..), ArithException(..), AsyncException(..), ArrayException(..),
+    stackOverflow, heapOverflow, throw, throwIO, ioException, 
+    IOError, IOException(..), IOErrorType(..), ioError, userError,
+    ExitCode(..) 
+  ) where
+       
 import GHC.ST
 import GHC.Arr -- to derive Ix class
 import GHC.Enum -- to derive Enum class
 import GHC.STRef
 import GHC.Base
-import GHC.Num -- To get fromInteger etc, needed because of -fno-implicit-prelude
+--  import GHC.Num     -- To get fromInteger etc, needed because of -fno-implicit-prelude
 import Data.Maybe  ( Maybe(..) )
 import GHC.Show
 import GHC.List

diff --git a/GHC/Weak.lhs b/GHC/Weak.lhs
index 7179e3d..cd82b76 100644 (file)
--- a/GHC/Weak.lhs
+++ b/GHC/Weak.lhs
@@ -19,6 +19,7 @@ module GHC.Weak where
 import GHC.Base
 import Data.Maybe
 import GHC.IOBase      ( IO(..), unIO )
+import Data.Typeable   ( Typeable1(..), mkTyCon, mkTyConApp )
 
 {-|
 A weak pointer object with a key and a value.  The value has type @v@.
@@ -62,6 +63,9 @@ for runnable finalizers before declaring the system to be deadlocked.
 -}
 data Weak v = Weak (Weak# v)
 
+#include "Typeable.h"
+INSTANCE_TYPEABLE1(Weak,weakTc,"Weak")
+
 -- | Establishes a weak pointer to @k@, with value @v@ and a finalizer.
 --
 -- This is the most general interface for building a weak pointer.

diff --git a/System/Mem/Weak.hs b/System/Mem/Weak.hs
index 3903557..e5d8d69 100644 (file)
--- a/System/Mem/Weak.hs
+++ b/System/Mem/Weak.hs
@@ -119,8 +119,6 @@ addFinalizer key finalizer = do
 mkWeakPair :: k -> v -> Maybe (IO ()) -> IO (Weak (k,v))
 mkWeakPair key val finalizer = mkWeak key (key,val) finalizer
 
-#include "Typeable.h"
-INSTANCE_TYPEABLE1(Weak,weakTc,"Weak")
 
 {- $precise