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
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
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
#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
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
-- -----------------------------------------------------------------------------
-- 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) #-}
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"
------------------------------------------------------------------------------
+-- 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"
+
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
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__
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__
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"
--
-------------------------------------------------------------
+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 ",,,"
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) }
#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
import GHC.Ptr ( Ptr(..), plusPtr, FunPtr(..) )
import GHC.STRef
import Data.Typeable
-#include "Typeable.h"
infixr 0 `par`, `pseq`
\end{code}
%************************************************************************
\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.
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).
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
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#
\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# ->
--
-----------------------------------------------------------------------------
-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
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@.
-}
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.
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