-{-# OPTIONS_GHC -fno-implicit-prelude -fallow-overlapping-instances -funbox-strict-fields #-}
+{-# OPTIONS_GHC -XNoImplicitPrelude -XOverlappingInstances -funbox-strict-fields #-}
--- The -fallow-overlapping-instances flag allows the user to over-ride
+-- The -XOverlappingInstances flag allows the user to over-ride
-- the instances for Typeable given here. In particular, we provide an instance
-- instance ... => Typeable (s a)
-- But a user might want to say
-- and one can in turn define a type-safe cast operation. To this end,
-- an unsafe cast is guarded by a test for type (representation)
-- equivalence. The module "Data.Dynamic" uses Typeable for an
--- implementation of dynamics. The module "Data.Generics" uses Typeable
+-- implementation of dynamics. The module "Data.Data" uses Typeable
-- and type-safe cast (but not dynamics) to support the \"Scrap your
-- boilerplate\" style of generic programming.
--
import qualified Data.HashTable as HT
import Data.Maybe
-import Data.Either
import Data.Int
import Data.Word
import Data.List( foldl, intersperse )
#ifdef __GLASGOW_HASKELL__
import GHC.Base
-import GHC.Show
-import GHC.Err
-import GHC.Num
-import GHC.Float
+import GHC.Show (Show(..), ShowS,
+ shows, showString, showChar, showParen)
+import GHC.Err (undefined)
+import GHC.Num (Integer, fromInteger, (+))
import GHC.Real ( rem, Ratio )
-import GHC.IOBase (IORef,newIORef,unsafePerformIO)
+import GHC.IORef (IORef,newIORef)
+import GHC.IO (unsafePerformIO,block)
-- 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.IOArray
+import GHC.MVar
import GHC.ST ( ST )
import GHC.STRef ( STRef )
import GHC.Ptr ( Ptr, FunPtr )
-import GHC.ForeignPtr ( ForeignPtr )
import GHC.Stable ( StablePtr, newStablePtr, freeStablePtr,
deRefStablePtr, castStablePtrToPtr,
castPtrToStablePtr )
-import GHC.Exception ( block )
import GHC.Arr ( Array, STArray )
#endif
#ifdef __HUGS__
import Hugs.Prelude ( Key(..), TypeRep(..), TyCon(..), Ratio,
- Exception, ArithException, IOException,
- ArrayException, AsyncException, Handle,
- Ptr, FunPtr, ForeignPtr, StablePtr )
+ Handle, Ptr, FunPtr, ForeignPtr, StablePtr )
import Hugs.IORef ( IORef, newIORef, readIORef, writeIORef )
import Hugs.IOExts ( unsafePerformIO )
-- For the Typeable instance
import Hugs.Array ( Array )
+import Hugs.IOArray
import Hugs.ConcBase ( MVar )
#endif
#ifdef __NHC__
-import NHC.IOExtras (IORef,newIORef,readIORef,writeIORef,unsafePerformIO)
+import NHC.IOExtras (IOArray,IORef,newIORef,readIORef,writeIORef,unsafePerformIO)
import IO (Handle)
import Ratio (Ratio)
-- For the Typeable instance
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")
#if defined(__GLASGOW_HASKELL__) || defined(__HUGS__)
--- Types defined in GHC.IOBase
+-- Types defined in GHC.MVar
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")
#endif
--- Types defined in GHC.Arr
INSTANCE_TYPEABLE2(Array,arrayTc,"Array")
+INSTANCE_TYPEABLE2(IOArray,iOArrayTc,"IOArray")
#ifdef __GLASGOW_HASKELL__
-- Hugs has these too, but their Typeable<n> instances are defined
#ifndef __NHC__
INSTANCE_TYPEABLE2((,),pairTc,"(,)")
INSTANCE_TYPEABLE3((,,),tup3Tc,"(,,)")
-
-tup4Tc :: TyCon
-tup4Tc = mkTyCon "(,,,)"
-
-instance Typeable4 (,,,) where
- typeOf4 tu = mkTyConApp tup4Tc []
-
-tup5Tc :: TyCon
-tup5Tc = mkTyCon "(,,,,)"
-
-instance Typeable5 (,,,,) where
- typeOf5 tu = mkTyConApp tup5Tc []
-
-tup6Tc :: TyCon
-tup6Tc = mkTyCon "(,,,,,)"
-
-instance Typeable6 (,,,,,) where
- typeOf6 tu = mkTyConApp tup6Tc []
-
-tup7Tc :: TyCon
-tup7Tc = mkTyCon "(,,,,,,)"
-
-instance Typeable7 (,,,,,,) where
- typeOf7 tu = mkTyConApp tup7Tc []
+INSTANCE_TYPEABLE4((,,,),tup4Tc,"(,,,)")
+INSTANCE_TYPEABLE5((,,,,),tup5Tc,"(,,,,)")
+INSTANCE_TYPEABLE6((,,,,,),tup6Tc,"(,,,,,)")
+INSTANCE_TYPEABLE7((,,,,,,),tup7Tc,"(,,,,,,)")
#endif /* __NHC__ */
INSTANCE_TYPEABLE1(Ptr,ptrTc,"Ptr")
INSTANCE_TYPEABLE1(FunPtr,funPtrTc,"FunPtr")
+#ifndef __GLASGOW_HASKELL__
INSTANCE_TYPEABLE1(ForeignPtr,foreignPtrTc,"ForeignPtr")
+#endif
INSTANCE_TYPEABLE1(StablePtr,stablePtrTc,"StablePtr")
INSTANCE_TYPEABLE1(IORef,iORefTc,"IORef")
#endif
INSTANCE_TYPEABLE0(Integer,integerTc,"Integer")
INSTANCE_TYPEABLE0(Ordering,orderingTc,"Ordering")
+#ifndef __GLASGOW_HASKELL__
INSTANCE_TYPEABLE0(Handle,handleTc,"Handle")
+#endif
INSTANCE_TYPEABLE0(Int8,int8Tc,"Int8")
INSTANCE_TYPEABLE0(Int16,int16Tc,"Int16")
newKey :: IORef Key -> IO Key
#ifdef __GLASGOW_HASKELL__
-newKey kloc = do i <- genSym; return (Key i)
+newKey _ = do i <- genSym; return (Key i)
#else
newKey kloc = do { k@(Key i) <- readIORef kloc ;
writeIORef kloc (Key (i+1)) ;