[commit: ghc] wip/generics-propeq-conservative: Propositional equality for Datatype meta-information (e12a6a8)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/generics-propeq-conservative
Link       : http://ghc.haskell.org/trac/ghc/changeset/e12a6a83851633722e8293e51e09a9c760be84f1/ghc

>---------------------------------------------------------------

commit e12a6a83851633722e8293e51e09a9c760be84f1
Author: Gabor Greif <ggreif at gmail.com>
Date:   Fri Aug 29 15:57:45 2014 +0200

    Propositional equality for Datatype meta-information


>---------------------------------------------------------------

e12a6a83851633722e8293e51e09a9c760be84f1
 libraries/base/GHC/Generics.hs | 19 ++++++++++++++++++-
 1 file changed, 18 insertions(+), 1 deletion(-)

diff --git a/libraries/base/GHC/Generics.hs b/libraries/base/GHC/Generics.hs
index 1c81858..c732a65 100644
--- a/libraries/base/GHC/Generics.hs
+++ b/libraries/base/GHC/Generics.hs
@@ -555,6 +555,9 @@ module GHC.Generics  (
   , Datatype(..), Constructor(..), Selector(..), NoSelector
   , Fixity(..), Associativity(..), Arity(..), prec
 
+  -- * Propositional equality for meta-information
+  , sameDatatype
+
   -- * Generic type classes
   , Generic(..), Generic1(..)
 
@@ -562,11 +565,14 @@ module GHC.Generics  (
 
 -- We use some base types
 import GHC.Types
+import Unsafe.Coerce
 import Data.Maybe ( Maybe(..) )
 import Data.Either ( Either(..) )
+import Data.Type.Equality
+import GHC.Base ( (&&), undefined )
 
 -- Needed for instances
-import GHC.Classes ( Eq, Ord )
+import GHC.Classes ( Eq((==)), Ord )
 import GHC.Read ( Read )
 import GHC.Show ( Show )
 import Data.Proxy
@@ -652,6 +658,17 @@ class Datatype d where
   isNewtype    :: t d (f :: * -> *) a -> Bool
   isNewtype _ = False
 
+-- | Propositional equality predicate for datatypes
+sameDatatype :: (Datatype l, Datatype r) => Proxy l -> Proxy r -> Maybe (l :~: r)
+sameDatatype l r | moduleName dl == moduleName dr
+                 && datatypeName dl == datatypeName dr
+                 = Just (unsafeCoerce Refl)
+    where dummy :: Proxy m -> D1 m a p
+          dummy Proxy = undefined
+          dl = dummy l
+          dr = dummy r
+sameDatatype _ _ = Nothing
+
 
 -- | Class for datatypes that represent records
 class Selector s where