X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Data%2FTypeable.hs;h=ce602e4999f8d4071f61f84645fcec891fb1ef89;hb=HEAD;hp=40d07aced4a07d73b9305e07f2a707cdb1ed0ea3;hpb=171fcc3ed2f927bd571643d2d27e44d0d72f1d8d;p=ghc-base.git

diff --git a/Data/Typeable.hs b/Data/Typeable.hs
index 40d07ac..ce602e4 100644
--- a/Data/Typeable.hs
+++ b/Data/Typeable.hs
@@ -1,4 +1,14 @@
-{-# OPTIONS_GHC -XNoImplicitPrelude -XOverlappingInstances -funbox-strict-fields #-}
+{-# LANGUAGE CPP
+           , NoImplicitPrelude
+           , OverlappingInstances
+           , ScopedTypeVariables
+           , ForeignFunctionInterface
+           , FlexibleInstances
+  #-}
+{-# OPTIONS_GHC -funbox-strict-fields #-}
+#ifdef __GLASGOW_HASKELL__
+{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}
+#endif
 
 -- The -XOverlappingInstances flag allows the user to over-ride
 -- the instances for Typeable given here.  In particular, we provide an instance
@@ -93,10 +103,10 @@ import GHC.Base
 import GHC.Show         (Show(..), ShowS,
                          shows, showString, showChar, showParen)
 import GHC.Err          (undefined)
-import GHC.Num          (Integer, fromInteger, (+))
+import GHC.Num          (Integer, (+))
 import GHC.Real         ( rem, Ratio )
 import GHC.IORef        (IORef,newIORef)
-import GHC.IO           (unsafePerformIO,block)
+import GHC.IO           (unsafePerformIO,mask_)
 
 -- These imports are so we can define Typeable instances
 -- It'd be better to give Typeable instances in the modules themselves
@@ -570,9 +580,26 @@ gcast2 x = r
 
 INSTANCE_TYPEABLE0((),unitTc,"()")
 INSTANCE_TYPEABLE1([],listTc,"[]")
+#if defined(__GLASGOW_HASKELL__)
+listTc :: TyCon
+listTc = typeRepTyCon (typeOf [()])
+#endif
 INSTANCE_TYPEABLE1(Maybe,maybeTc,"Maybe")
 INSTANCE_TYPEABLE1(Ratio,ratioTc,"Ratio")
+#if defined(__GLASGOW_HASKELL__)
+{-
+TODO: Deriving this instance fails with:
+libraries/base/Data/Typeable.hs:589:1:
+    Can't make a derived instance of `Typeable2 (->)':
+      The last argument of the instance must be a data or newtype application
+    In the stand-alone deriving instance for `Typeable2 (->)'
+-}
+instance Typeable2 (->) where { typeOf2 _ = mkTyConApp funTc [] }
+funTc :: TyCon
+funTc = mkTyCon "->"
+#else
 INSTANCE_TYPEABLE2((->),funTc,"->")
+#endif
 INSTANCE_TYPEABLE1(IO,ioTc,"IO")
 
 #if defined(__GLASGOW_HASKELL__) || defined(__HUGS__)
@@ -644,7 +671,17 @@ INSTANCE_TYPEABLE0(TyCon,tyconTc,"TyCon")
 INSTANCE_TYPEABLE0(TypeRep,typeRepTc,"TypeRep")
 
 #ifdef __GLASGOW_HASKELL__
-INSTANCE_TYPEABLE0(RealWorld,realWorldTc,"RealWorld")
+{-
+TODO: This can't be derived currently:
+libraries/base/Data/Typeable.hs:674:1:
+    Can't make a derived instance of `Typeable RealWorld':
+      The last argument of the instance must be a data or newtype application
+    In the stand-alone deriving instance for `Typeable RealWorld'
+-}
+realWorldTc :: TyCon; \
+realWorldTc = mkTyCon "GHC.Base.RealWorld"; \
+instance Typeable RealWorld where { typeOf _ = mkTyConApp realWorldTc [] }
+
 #endif
 
 ---------------------------------------------
@@ -681,7 +718,7 @@ cache = unsafePerformIO $ do
                                         tc_tbl = empty_tc_tbl, 
                                         ap_tbl = empty_ap_tbl }
 #ifdef __GLASGOW_HASKELL__
-                block $ do
+                mask_ $ do
                         stable_ref <- newStablePtr ret
                         let ref = castStablePtrToPtr stable_ref
                         ref2 <- getOrSetTypeableStore ref