[commit: ghc] master: Add isNewtype to GHC.Generics (FIX #7631) (6046b25)

[José Pedro Magalhães]

Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/6046b25ea35291f9fb0b30633f6f8b8d83a7a00a

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

commit 6046b25ea35291f9fb0b30633f6f8b8d83a7a00a
Author: Jose Pedro Magalhaes <jpm at cs.ox.ac.uk>
Date:   Wed Feb 13 10:40:16 2013 +0000

    Add isNewtype to GHC.Generics (FIX #7631)

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

 compiler/prelude/PrelNames.lhs       |    5 +++--
 compiler/typecheck/TcGenGenerics.lhs |    7 +++++--
 2 files changed, 8 insertions(+), 4 deletions(-)

diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs
index d296bee..a67580a 100644
--- a/compiler/prelude/PrelNames.lhs
+++ b/compiler/prelude/PrelNames.lhs
@@ -642,8 +642,8 @@ u1DataCon_RDR, par1DataCon_RDR, rec1DataCon_RDR,
   prodDataCon_RDR, comp1DataCon_RDR,
   unPar1_RDR, unRec1_RDR, unK1_RDR, unComp1_RDR,
   from_RDR, from1_RDR, to_RDR, to1_RDR,
-  datatypeName_RDR, moduleName_RDR, conName_RDR,
-  conFixity_RDR, conIsRecord_RDR,
+  datatypeName_RDR, moduleName_RDR, isNewtypeName_RDR,
+  conName_RDR, conFixity_RDR, conIsRecord_RDR,
   noArityDataCon_RDR, arityDataCon_RDR, selName_RDR,
   prefixDataCon_RDR, infixDataCon_RDR, leftAssocDataCon_RDR,
   rightAssocDataCon_RDR, notAssocDataCon_RDR :: RdrName
@@ -672,6 +672,7 @@ to1_RDR   = varQual_RDR gHC_GENERICS (fsLit "to1")
 
 datatypeName_RDR  = varQual_RDR gHC_GENERICS (fsLit "datatypeName")
 moduleName_RDR    = varQual_RDR gHC_GENERICS (fsLit "moduleName")
+isNewtypeName_RDR = varQual_RDR gHC_GENERICS (fsLit "isNewtype")
 selName_RDR       = varQual_RDR gHC_GENERICS (fsLit "selName")
 conName_RDR       = varQual_RDR gHC_GENERICS (fsLit "conName")
 conFixity_RDR     = varQual_RDR gHC_GENERICS (fsLit "conFixity")
diff --git a/compiler/typecheck/TcGenGenerics.lhs b/compiler/typecheck/TcGenGenerics.lhs
index 2c75243..b058c28 100644
--- a/compiler/typecheck/TcGenGenerics.lhs
+++ b/compiler/typecheck/TcGenGenerics.lhs
@@ -628,8 +628,10 @@ mkBindsMetaD fix_env tycon = (dtBinds, allConBinds, allSelBinds)
         mkBag l = foldr1 unionBags 
                     [ unitBag (L loc (mkFunBind (L loc name) matches)) 
                         | (name, matches) <- l ]
-        dtBinds       = mkBag [ (datatypeName_RDR, dtName_matches)
-                              , (moduleName_RDR, moduleName_matches)]
+        dtBinds       = mkBag ( [ (datatypeName_RDR, dtName_matches)
+                                , (moduleName_RDR, moduleName_matches)]
+                              ++ ifElseEmpty (isNewTyCon tycon)
+                                [ (isNewtypeName_RDR, isNewtype_matches) ] )
 
         allConBinds   = map conBinds datacons
         conBinds c    = mkBag ( [ (conName_RDR, conName_matches c)]
@@ -663,6 +665,7 @@ mkBindsMetaD fix_env tycon = (dtBinds, allConBinds, allSelBinds)
                            $ tyConName_user
         moduleName_matches = mkStringLHS . moduleNameString . moduleName 
                            . nameModule . tyConName $ tycon
+        isNewtype_matches  = [mkSimpleHsAlt nlWildPat (nlHsVar true_RDR)]
 
         conName_matches     c = mkStringLHS . occNameString . nameOccName
                               . dataConName $ c