Commit ae39c5c0 authored by Oleg Grenrus's avatar Oleg Grenrus Committed by Austin Seipp

Add packageName to GHC.Generics.Datatype

Summary: Added packageName to GHC.Generics.Datatype class definition

Reviewers: hvr, dreixel, austin

Reviewed By: dreixel, austin

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D631

GHC Trac Issues: #10030
parent d4f25cb1
......@@ -693,7 +693,7 @@ 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, isNewtypeName_RDR,
datatypeName_RDR, moduleName_RDR, packageName_RDR, isNewtypeName_RDR,
conName_RDR, conFixity_RDR, conIsRecord_RDR,
noArityDataCon_RDR, arityDataCon_RDR, selName_RDR,
prefixDataCon_RDR, infixDataCon_RDR, leftAssocDataCon_RDR,
......@@ -723,6 +723,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")
packageName_RDR = varQual_RDR gHC_GENERICS (fsLit "packageName")
isNewtypeName_RDR = varQual_RDR gHC_GENERICS (fsLit "isNewtype")
selName_RDR = varQual_RDR gHC_GENERICS (fsLit "selName")
conName_RDR = varQual_RDR gHC_GENERICS (fsLit "conName")
......
......@@ -24,7 +24,8 @@ import DataCon
import TyCon
import FamInstEnv ( FamInst, FamFlavor(..), mkSingleCoAxiom )
import FamInst
import Module ( Module, moduleName, moduleNameString )
import Module ( Module, moduleName, moduleNameString
, modulePackageKey, packageKeyString )
import IfaceEnv ( newGlobalBinder )
import Name hiding ( varName )
import RdrName
......@@ -680,7 +681,8 @@ mkBindsMetaD fix_env tycon = (dtBinds, allConBinds, allSelBinds)
[ unitBag (mkRdrFunBind (L loc name) matches)
| (name, matches) <- l ]
dtBinds = mkBag ( [ (datatypeName_RDR, dtName_matches)
, (moduleName_RDR, moduleName_matches)]
, (moduleName_RDR, moduleName_matches)
, (packageName_RDR, pkgName_matches)]
++ ifElseEmpty (isNewTyCon tycon)
[ (isNewtypeName_RDR, isNewtype_matches) ] )
......@@ -716,6 +718,8 @@ mkBindsMetaD fix_env tycon = (dtBinds, allConBinds, allSelBinds)
$ tyConName_user
moduleName_matches = mkStringLHS . moduleNameString . moduleName
. nameModule . tyConName $ tycon
pkgName_matches = mkStringLHS . packageKeyString . modulePackageKey
. nameModule . tyConName $ tycon
isNewtype_matches = [mkSimpleHsAlt nlWildPat (nlHsVar true_RDR)]
conName_matches c = mkStringLHS . occNameString . nameOccName
......
......@@ -12358,6 +12358,7 @@ data C1_1UserTree
instance Datatype D1UserTree where
datatypeName _ = "UserTree"
moduleName _ = "Main"
packageName _ = "main"
instance Constructor C1_0UserTree where
conName _ = "Node"
......
......@@ -648,6 +648,8 @@ class Datatype d where
datatypeName :: t d (f :: * -> *) a -> [Char]
-- | The fully-qualified name of the module where the type is declared
moduleName :: t d (f :: * -> *) a -> [Char]
-- | The package name of the module where the type is declared
packageName :: t d (f :: * -> *) a -> [Char]
-- | Marks if the datatype is actually a newtype
isNewtype :: t d (f :: * -> *) a -> Bool
isNewtype _ = False
......@@ -756,6 +758,7 @@ data C_Int
instance Datatype D_Int where
datatypeName _ = "Int"
moduleName _ = "GHC.Int"
packageName _ = "base"
instance Constructor C_Int where
conName _ = "" -- JPM: I'm not sure this is the right implementation...
......@@ -773,6 +776,7 @@ data C_Float
instance Datatype D_Float where
datatypeName _ = "Float"
moduleName _ = "GHC.Float"
packageName _ = "base"
instance Constructor C_Float where
conName _ = "" -- JPM: I'm not sure this is the right implementation...
......@@ -790,6 +794,7 @@ data C_Double
instance Datatype D_Double where
datatypeName _ = "Double"
moduleName _ = "GHC.Float"
packageName _ = "base"
instance Constructor C_Double where
conName _ = "" -- JPM: I'm not sure this is the right implementation...
......@@ -807,6 +812,7 @@ data C_Char
instance Datatype D_Char where
datatypeName _ = "Char"
moduleName _ = "GHC.Base"
packageName _ = "base"
instance Constructor C_Char where
conName _ = "" -- JPM: I'm not sure this is the right implementation...
......
......@@ -91,6 +91,7 @@ Derived instances:
instance GHC.Generics.Datatype GenDerivOutput.D1List where
GHC.Generics.datatypeName _ = "List"
GHC.Generics.moduleName _ = "GenDerivOutput"
GHC.Generics.packageName _ = "main"
instance GHC.Generics.Constructor GenDerivOutput.C1_0List where
GHC.Generics.conName _ = "Nil"
......@@ -108,6 +109,7 @@ Derived instances:
instance GHC.Generics.Datatype GenDerivOutput.D1Rose where
GHC.Generics.datatypeName _ = "Rose"
GHC.Generics.moduleName _ = "GenDerivOutput"
GHC.Generics.packageName _ = "main"
instance GHC.Generics.Constructor GenDerivOutput.C1_0Rose where
GHC.Generics.conName _ = "Empty"
......
......@@ -24,6 +24,7 @@ Derived instances:
instance GHC.Generics.Datatype GenDerivOutput1_0.D1List where
GHC.Generics.datatypeName _ = "List"
GHC.Generics.moduleName _ = "GenDerivOutput1_0"
GHC.Generics.packageName _ = "main"
instance GHC.Generics.Constructor GenDerivOutput1_0.C1_0List where
GHC.Generics.conName _ = "Nil"
......
......@@ -156,6 +156,7 @@ Derived instances:
instance GHC.Generics.Datatype CanDoRep1_1.D1Da where
GHC.Generics.datatypeName _ = "Da"
GHC.Generics.moduleName _ = "CanDoRep1_1"
GHC.Generics.packageName _ = "main"
instance GHC.Generics.Constructor CanDoRep1_1.C1_0Da where
GHC.Generics.conName _ = "D0"
......@@ -173,6 +174,7 @@ Derived instances:
instance GHC.Generics.Datatype CanDoRep1_1.D1Db where
GHC.Generics.datatypeName _ = "Db"
GHC.Generics.moduleName _ = "CanDoRep1_1"
GHC.Generics.packageName _ = "main"
instance GHC.Generics.Constructor CanDoRep1_1.C1_0Db where
GHC.Generics.conName _ = "D0b"
......@@ -190,6 +192,7 @@ Derived instances:
instance GHC.Generics.Datatype CanDoRep1_1.D1Dc where
GHC.Generics.datatypeName _ = "Dc"
GHC.Generics.moduleName _ = "CanDoRep1_1"
GHC.Generics.packageName _ = "main"
instance GHC.Generics.Constructor CanDoRep1_1.C1_0Dc where
GHC.Generics.conName _ = "D0c"
......@@ -207,6 +210,7 @@ Derived instances:
instance GHC.Generics.Datatype CanDoRep1_1.D1Dd where
GHC.Generics.datatypeName _ = "Dd"
GHC.Generics.moduleName _ = "CanDoRep1_1"
GHC.Generics.packageName _ = "main"
instance GHC.Generics.Constructor CanDoRep1_1.C1_0Dd where
GHC.Generics.conName _ = "D0d"
......
module Main where
import GHC.Generics
main = do
putStrLn $ packageName $ from $ Just True
putStrLn $ packageName $ from $ True
......@@ -40,3 +40,4 @@ test('T7878', extra_clean(['T7878A.o' ,'T7878A.hi'
test('T8468', normal, compile_fail, [''])
test('T8479', normal, compile, [''])
test('T9563', normal, compile, [''])
test('T10030', normal, compile_and_run, [''])
......@@ -247,6 +247,7 @@ module GenBigTypes where
instance Datatype D1BigSum where
datatypeName _ = "BigSum"
moduleName _ = "GenBigTypes"
packageName _ = "main"
instance Constructor C1_0BigSum where
conName _ = "C0"
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment