For GHC, implement the Typeable.hs macros using standalone deriving

[ghc-base.git] / Data / Typeable.hs

diff --git a/Data/Typeable.hs b/Data/Typeable.hs
index 804e853..ce602e4 100644 (file)
--- a/Data/Typeable.hs
+++ b/Data/Typeable.hs
@@ -6,6 +6,9 @@
            , 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
@@ -577,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__)
@@ -651,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
 
 ---------------------------------------------