[commit: ghc] wip/generics-propeq-conservative: Implement sameConstructor (f097b77)

[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/f097b779e215900f4746d3911094f7e599e51b1f/ghc

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

commit f097b779e215900f4746d3911094f7e599e51b1f
Author: Gabor Greif <ggreif at gmail.com>
Date:   Tue Sep 2 12:44:09 2014 +0200

    Implement sameConstructor


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

f097b779e215900f4746d3911094f7e599e51b1f
 libraries/base/GHC/Generics.hs | 15 ++++++++++++++-
 1 file changed, 14 insertions(+), 1 deletion(-)

diff --git a/libraries/base/GHC/Generics.hs b/libraries/base/GHC/Generics.hs
index c8a69d6..3d75c68 100644
--- a/libraries/base/GHC/Generics.hs
+++ b/libraries/base/GHC/Generics.hs
@@ -557,7 +557,7 @@ module GHC.Generics  (
   , Fixity(..), Associativity(..), Arity(..), prec
 
   -- * Propositional equality for meta-information
-  , sameDatatype
+  , sameDatatype, sameConstructor
 
   -- * Generic type classes
   , Generic(..), Generic1(..)
@@ -694,6 +694,19 @@ class Constructor c where
   conIsRecord :: t c (f :: * -> *) a -> Bool
   conIsRecord _ = False
 
+-- | Propositional equality predicate for constructors
+sameConstructor :: (Datatype l, Datatype r, Constructor (cl l), Constructor (cr r))
+                => Proxy (cl l) -> Proxy (cr r) -> Maybe (cl l :~: cr r)
+sameConstructor l r | Just Refl <- pd l ` sameDatatype` pd r
+                    , True <- conName cl == conName cr
+                    = Just (unsafeCoerce Refl)
+    where pd :: Proxy (cm m) -> Proxy m
+          pd Proxy = Proxy
+          dummyC :: Proxy (cm m) -> C1 (cm m) a p
+          dummyC Proxy = undefined
+          cl = dummyC l
+          cr = dummyC r
+
 
 -- | Datatype to represent the arity of a tuple.
 data Arity = NoArity | Arity Int