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

As well as being more pleasant, this fixes #1841:
    Data.Typeable: Instances of basic types don't provide qualified
    strings to mkTyCon

diff --git a/Control/Concurrent/Chan.hs b/Control/Concurrent/Chan.hs
index 2255c4e..d6be913 100644 (file)
--- a/Control/Concurrent/Chan.hs
+++ b/Control/Concurrent/Chan.hs
@@ -1,4 +1,7 @@
 {-# LANGUAGE CPP #-}
+#ifdef __GLASGOW_HASKELL__
+{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}
+#endif
 
 -----------------------------------------------------------------------------
 -- |

diff --git a/Control/Concurrent/QSem.hs b/Control/Concurrent/QSem.hs
index 22f6c0c..6b9a059 100644 (file)
--- a/Control/Concurrent/QSem.hs
+++ b/Control/Concurrent/QSem.hs
@@ -1,4 +1,7 @@
 {-# LANGUAGE CPP #-}
+#ifdef __GLASGOW_HASKELL__
+{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}
+#endif
 
 -----------------------------------------------------------------------------
 -- |

diff --git a/Control/Concurrent/QSemN.hs b/Control/Concurrent/QSemN.hs
index cfcff7f..43fe288 100644 (file)
--- a/Control/Concurrent/QSemN.hs
+++ b/Control/Concurrent/QSemN.hs
@@ -1,4 +1,7 @@
 {-# LANGUAGE CPP #-}
+#ifdef __GLASGOW_HASKELL__
+{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}
+#endif
 
 -----------------------------------------------------------------------------
 -- |

diff --git a/Control/Concurrent/SampleVar.hs b/Control/Concurrent/SampleVar.hs
index ca68a38..615a0bf 100644 (file)
--- a/Control/Concurrent/SampleVar.hs
+++ b/Control/Concurrent/SampleVar.hs
@@ -1,4 +1,7 @@
 {-# LANGUAGE CPP #-}
+#ifdef __GLASGOW_HASKELL__
+{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}
+#endif
 
 -----------------------------------------------------------------------------
 -- |

diff --git a/Control/Exception/Base.hs b/Control/Exception/Base.hs
index cb5321b..a5d72ce 100644 (file)
--- a/Control/Exception/Base.hs
+++ b/Control/Exception/Base.hs
@@ -1,4 +1,7 @@
 {-# LANGUAGE CPP, NoImplicitPrelude, MagicHash #-}
+#ifdef __GLASGOW_HASKELL__
+{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}
+#endif
 
 #include "Typeable.h"
 

diff --git a/Control/OldException.hs b/Control/OldException.hs
index 0284899..6442d67 100644 (file)
--- a/Control/OldException.hs
+++ b/Control/OldException.hs
@@ -3,6 +3,9 @@
            , ForeignFunctionInterface
            , ExistentialQuantification
   #-}
+#ifdef __GLASGOW_HASKELL__
+{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}
+#endif
 
 #include "Typeable.h"
 

diff --git a/Data/Complex.hs b/Data/Complex.hs
index 9765eda..9ea8a41 100644 (file)
--- a/Data/Complex.hs
+++ b/Data/Complex.hs
@@ -1,4 +1,7 @@
 {-# LANGUAGE CPP, DeriveDataTypeable #-}
+#ifdef __GLASGOW_HASKELL__
+{-# LANGUAGE StandaloneDeriving #-}
+#endif
 
 -----------------------------------------------------------------------------
 -- |

diff --git a/Data/Dynamic.hs b/Data/Dynamic.hs
index b83bbfa..df64c38 100644 (file)
--- a/Data/Dynamic.hs
+++ b/Data/Dynamic.hs
@@ -1,4 +1,7 @@
 {-# LANGUAGE CPP, NoImplicitPrelude #-}
+#ifdef __GLASGOW_HASKELL__
+{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}
+#endif
 
 -----------------------------------------------------------------------------
 -- |

diff --git a/Data/Either.hs b/Data/Either.hs
index 1c12897..b45609b 100644 (file)
--- a/Data/Either.hs
+++ b/Data/Either.hs
@@ -1,4 +1,7 @@
 {-# LANGUAGE CPP, NoImplicitPrelude #-}
+#ifdef __GLASGOW_HASKELL__
+{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}
+#endif
 
 -----------------------------------------------------------------------------
 -- |

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
 
 ---------------------------------------------

diff --git a/Foreign/C/Types.hs b/Foreign/C/Types.hs
index 22bae5c..98113c8 100644 (file)
--- a/Foreign/C/Types.hs
+++ b/Foreign/C/Types.hs
@@ -4,6 +4,9 @@
            , GeneralizedNewtypeDeriving
   #-}
 {-# OPTIONS_GHC -fno-warn-unused-binds #-}
+#ifdef __GLASGOW_HASKELL__
+{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}
+#endif
 -- XXX -fno-warn-unused-binds stops us warning about unused constructors,
 -- but really we should just remove them if we don't want them
 
@@ -91,7 +94,7 @@ import Foreign.Storable
 import Data.Bits        ( Bits(..) )
 import Data.Int         ( Int8,  Int16,  Int32,  Int64  )
 import Data.Word        ( Word8, Word16, Word32, Word64 )
-import {-# SOURCE #-} Data.Typeable (Typeable(typeOf), TyCon, mkTyCon, mkTyConApp)
+import {-# SOURCE #-} Data.Typeable
 
 #ifdef __GLASGOW_HASKELL__
 import GHC.Base

diff --git a/Foreign/Ptr.hs b/Foreign/Ptr.hs
index b46acc1..26dda5c 100644 (file)
--- a/Foreign/Ptr.hs
+++ b/Foreign/Ptr.hs
@@ -4,6 +4,9 @@
            , MagicHash
            , GeneralizedNewtypeDeriving
   #-}
+#ifdef __GLASGOW_HASKELL__
+{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}
+#endif
 
 -----------------------------------------------------------------------------
 -- |

diff --git a/GHC/Conc/Sync.lhs b/GHC/Conc/Sync.lhs
index af69a63..0214a56 100644 (file)
--- a/GHC/Conc/Sync.lhs
+++ b/GHC/Conc/Sync.lhs
@@ -7,6 +7,7 @@
            , UnliftedFFITypes
            , ForeignFunctionInterface
            , DeriveDataTypeable
+           , StandaloneDeriving
            , RankNTypes
   #-}
 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}

diff --git a/GHC/ForeignPtr.hs b/GHC/ForeignPtr.hs
index 2e737f0..dbf6c2c 100644 (file)
--- a/GHC/ForeignPtr.hs
+++ b/GHC/ForeignPtr.hs
@@ -5,6 +5,7 @@
            , UnboxedTuples
   #-}
 {-# OPTIONS_HADDOCK hide #-}
+{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}
 
 -----------------------------------------------------------------------------
 -- |

diff --git a/GHC/Weak.lhs b/GHC/Weak.lhs
index 67046f8..92e1eb8 100644 (file)
--- a/GHC/Weak.lhs
+++ b/GHC/Weak.lhs
@@ -4,6 +4,8 @@
            , BangPatterns
            , MagicHash
            , UnboxedTuples
+           , DeriveDataTypeable
+           , StandaloneDeriving
   #-}
 {-# OPTIONS_HADDOCK hide #-}
 

diff --git a/System/Mem/StableName.hs b/System/Mem/StableName.hs
index d7d27a3..2bce839 100644 (file)
--- a/System/Mem/StableName.hs
+++ b/System/Mem/StableName.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE CPP #-}
 #ifdef __GLASGOW_HASKELL__
+{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}
 {-# LANGUAGE MagicHash #-}
 #if !defined(__PARALLEL_HASKELL__)
 {-# LANGUAGE UnboxedTuples #-}

diff --git a/System/Posix/Types.hs b/System/Posix/Types.hs
index 676fead..d5d26c6 100644 (file)
--- a/System/Posix/Types.hs
+++ b/System/Posix/Types.hs
@@ -4,6 +4,9 @@
            , GeneralizedNewtypeDeriving
   #-}
 {-# OPTIONS_GHC -fno-warn-unused-binds #-}
+#ifdef __GLASGOW_HASKELL__
+{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}
+#endif
 
 -----------------------------------------------------------------------------
 -- |

diff --git a/System/Timeout.hs b/System/Timeout.hs
index dbd7181..df33625 100644 (file)
--- a/System/Timeout.hs
+++ b/System/Timeout.hs
@@ -1,4 +1,7 @@
 {-# LANGUAGE CPP #-}
+#ifdef __GLASGOW_HASKELL__
+{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}
+#endif
 
 -------------------------------------------------------------------------------
 -- |

diff --git a/include/Typeable.h b/include/Typeable.h
index e9a6c7a..38fe90f 100644 (file)
--- a/include/Typeable.h
+++ b/include/Typeable.h
@@ -14,52 +14,26 @@
 #ifndef TYPEABLE_H
 #define TYPEABLE_H
 
-#define INSTANCE_TYPEABLE0(tycon,tcname,str) \
-tcname :: TyCon; \
-tcname = mkTyCon str; \
-instance Typeable tycon where { typeOf _ = mkTyConApp tcname [] }
-
 #ifdef __GLASGOW_HASKELL__
 
---  // For GHC, the extra instances follow from general instance declarations
---  // defined in Data.Typeable.
+--  // For GHC, we can use DeriveDataTypeable + StandaloneDeriving to
+--  // generate the instances.
 
-#define INSTANCE_TYPEABLE1(tycon,tcname,str) \
-tcname :: TyCon; \
-tcname = mkTyCon str; \
-instance Typeable1 tycon where { typeOf1 _ = mkTyConApp tcname [] }
+#define INSTANCE_TYPEABLE0(tycon,tcname,str) deriving instance Typeable tycon
+#define INSTANCE_TYPEABLE1(tycon,tcname,str) deriving instance Typeable1 tycon
+#define INSTANCE_TYPEABLE2(tycon,tcname,str) deriving instance Typeable2 tycon
+#define INSTANCE_TYPEABLE3(tycon,tcname,str) deriving instance Typeable3 tycon
+#define INSTANCE_TYPEABLE4(tycon,tcname,str) deriving instance Typeable4 tycon
+#define INSTANCE_TYPEABLE5(tycon,tcname,str) deriving instance Typeable5 tycon
+#define INSTANCE_TYPEABLE6(tycon,tcname,str) deriving instance Typeable6 tycon
+#define INSTANCE_TYPEABLE7(tycon,tcname,str) deriving instance Typeable7 tycon
 
-#define INSTANCE_TYPEABLE2(tycon,tcname,str) \
-tcname :: TyCon; \
-tcname = mkTyCon str; \
-instance Typeable2 tycon where { typeOf2 _ = mkTyConApp tcname [] }
-
-#define INSTANCE_TYPEABLE3(tycon,tcname,str) \
-tcname :: TyCon; \
-tcname = mkTyCon str; \
-instance Typeable3 tycon where { typeOf3 _ = mkTyConApp tcname [] }
-
-#define INSTANCE_TYPEABLE4(tycon,tcname,str) \
-tcname :: TyCon; \
-tcname = mkTyCon str; \
-instance Typeable4 tycon where { typeOf4 _ = mkTyConApp tcname [] }
-
-#define INSTANCE_TYPEABLE5(tycon,tcname,str) \
-tcname :: TyCon; \
-tcname = mkTyCon str; \
-instance Typeable5 tycon where { typeOf5 _ = mkTyConApp tcname [] }
-
-#define INSTANCE_TYPEABLE6(tycon,tcname,str) \
-tcname :: TyCon; \
-tcname = mkTyCon str; \
-instance Typeable6 tycon where { typeOf6 _ = mkTyConApp tcname [] }
+#else /* !__GLASGOW_HASKELL__ */
 
-#define INSTANCE_TYPEABLE7(tycon,tcname,str) \
+#define INSTANCE_TYPEABLE0(tycon,tcname,str) \
 tcname :: TyCon; \
 tcname = mkTyCon str; \
-instance Typeable7 tycon where { typeOf7 _ = mkTyConApp tcname [] }
-
-#else /* !__GLASGOW_HASKELL__ */
+instance Typeable tycon where { typeOf _ = mkTyConApp tcname [] }
 
 #define INSTANCE_TYPEABLE1(tycon,tcname,str) \
 tcname = mkTyCon str; \