[project @ 2005-02-02 14:54:18 by ross]

an instance for FunPtr, and minor Hugs fixes:

* for Hugs only, move the instances for ST, STRef and STArray back.
  Having them in Data.Typeable, which is imported by Data.Dynamic,
  would mean that every invocation of runhugs or ffihugs would need
  the -98 option.

* Hugs also has MVar and the exception types.

and NHC has ForeignPtr too.

diff --git a/Control/Monad/ST.hs b/Control/Monad/ST.hs
index c51ea9a..0e34857 100644 (file)
--- a/Control/Monad/ST.hs
+++ b/Control/Monad/ST.hs
@@ -41,6 +41,7 @@ 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/Base.hs b/Data/Array/Base.hs
index 12dbb8e..6864362 100644 (file)
--- a/Data/Array/Base.hs
+++ b/Data/Array/Base.hs
@@ -1071,6 +1071,10 @@ instance MArray (STArray s) e (ST s) where
     {-# INLINE unsafeWrite #-}
     unsafeWrite = ArrST.unsafeWriteSTArray
 
+#ifdef __HUGS__
+INSTANCE_TYPEABLE3(STArray,sTArrayTc,"STArray")
+#endif
+
 -----------------------------------------------------------------------------
 -- Flat unboxed mutable arrays (ST monad)
 

diff --git a/Data/STRef.hs b/Data/STRef.hs
index d261cbf..b185493 100644 (file)
--- a/Data/STRef.hs
+++ b/Data/STRef.hs
@@ -30,6 +30,10 @@ import GHC.STRef
 
 #ifdef __HUGS__
 import Hugs.ST
+import Data.Typeable
+
+#include "Typeable.h"
+INSTANCE_TYPEABLE2(STRef,stRefTc,"STRef")
 #endif
 
 -- |Mutate the contents of an 'STRef'

diff --git a/Data/Typeable.hs b/Data/Typeable.hs
index a25e7d6..159137c 100644 (file)
--- a/Data/Typeable.hs
+++ b/Data/Typeable.hs
@@ -104,7 +104,7 @@ 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.Ptr          ( Ptr, FunPtr )
 import GHC.ForeignPtr   ( ForeignPtr )
 import GHC.Stable       ( StablePtr )
 import GHC.Arr         ( Array, STArray )
@@ -117,10 +117,8 @@ 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 
+import Hugs.Array      ( Array )
+import Hugs.ConcBase   ( MVar )
 #endif
 
 #ifdef __GLASGOW_HASKELL__
@@ -134,7 +132,7 @@ import NHC.IOExtras (IORef,newIORef,readIORef,writeIORef,unsafePerformIO)
 import IO (Handle)
 import Ratio (Ratio)
        -- For the Typeable instance
-import NHC.FFI ( Ptr,StablePtr )
+import NHC.FFI ( Ptr,FunPtr,StablePtr,ForeignPtr )
 import Array   ( Array )
 #endif
 
@@ -482,9 +480,7 @@ INSTANCE_TYPEABLE2(Either,eitherTc,"Either")
 INSTANCE_TYPEABLE2((->),funTc,"->")
 INSTANCE_TYPEABLE1(IO,ioTc,"IO")
 
-#ifdef __GLASGOW_HASKELL__
-
-
+#if defined(__GLASGOW_HASKELL__) || defined(__HUGS__)
 -- Types defined in GHC.IOBase
 INSTANCE_TYPEABLE1(MVar,mvarTc,"MVar" )
 INSTANCE_TYPEABLE0(Exception,exceptionTc,"Exception")
@@ -492,23 +488,24 @@ 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")
-#endif
-
-
-#ifndef __NHC__
-INSTANCE_TYPEABLE2((,),pairTc,",")
-INSTANCE_TYPEABLE3((,,),tup3Tc,",,")
 
--- I don't think NHC has ST, STRef, STArray, ForeignPtr
--- but GHC and Hugs do
+#ifdef __GLASGOW_HASKELL__
+-- Hugs has these too, but their Typeable<n> instances are defined
+-- elsewhere to keep this module within Haskell 98.
+-- This is important because every invocation of runhugs or ffihugs
+-- uses this module via Data.Dynamic.
 INSTANCE_TYPEABLE2(ST,stTc,"ST")
 INSTANCE_TYPEABLE2(STRef,stRefTc,"STRef")
-INSTANCE_TYPEABLE1(ForeignPtr,foreignPtrTc,"ForeignPtr")
 INSTANCE_TYPEABLE3(STArray,sTArrayTc,"STArray")
+#endif
 
+#ifndef __NHC__
+INSTANCE_TYPEABLE2((,),pairTc,",")
+INSTANCE_TYPEABLE3((,,),tup3Tc,",,")
 
 tup4Tc :: TyCon
 tup4Tc = mkTyCon ",,,"
@@ -533,11 +530,13 @@ tup7Tc = mkTyCon ",,,,,,"
 
 instance Typeable7 (,,,,,,) where
   typeOf7 tu = mkTyConApp tup7Tc []
-
 #endif /* __NHC__ */
+
 INSTANCE_TYPEABLE1(Ptr,ptrTc,"Ptr")
-INSTANCE_TYPEABLE1(StablePtr,stableptrTc,"StablePtr")
-INSTANCE_TYPEABLE1(IORef,iorefTc,"IORef")
+INSTANCE_TYPEABLE1(FunPtr,funPtrTc,"FunPtr")
+INSTANCE_TYPEABLE1(ForeignPtr,foreignPtrTc,"ForeignPtr")
+INSTANCE_TYPEABLE1(StablePtr,stablePtrTc,"StablePtr")
+INSTANCE_TYPEABLE1(IORef,iORefTc,"IORef")
 
 -------------------------------------------------------
 --