Simon Peyton Jones pushed to branch wip/spj-reinstallable-base at Glasgow Haskell Compiler / GHC
Commits:
-
0a2dbd93
by Simon Peyton Jones at 2026-04-09T00:18:12+01:00
16 changed files:
- compiler/GHC/Builtin/KnownKeys.hs
- compiler/GHC/Builtin/KnownOccs.hs
- compiler/GHC/HsToCore/Binds.hs
- compiler/GHC/HsToCore/Match/Literal.hs
- compiler/GHC/HsToCore/Monad.hs
- compiler/GHC/HsToCore/Pmc/Desugar.hs
- compiler/GHC/Runtime/Eval.hs
- compiler/GHC/Tc/Instance/Class.hs
- compiler/GHC/Tc/Instance/Typeable.hs
- compiler/GHC/Tc/Utils/Env.hs
- compiler/GHC/Tc/Utils/Instantiate.hs
- libraries/base/src/GHC/KnownKeyNames.hs
- libraries/ghc-internal/src/GHC/Internal/IO.hs
- libraries/ghc-internal/src/GHC/Internal/Read.hs
- libraries/ghc-internal/src/GHC/Internal/Real.hs
- libraries/ghc-internal/src/GHC/Internal/Types.hs
Changes:
| ... | ... | @@ -177,7 +177,7 @@ wired in ones are defined in GHC.Builtin.Types etc. |
| 177 | 177 | |
| 178 | 178 | basicKnownKeyTable :: [(OccName, KnownKey)]
|
| 179 | 179 | basicKnownKeyTable
|
| 180 | - = [ (rationalTyConOcc, rationalTyConKey)
|
|
| 180 | + = [ (mkTcOcc "Read", readClassKey)
|
|
| 181 | 181 | , (mkTcOcc "Show", showClassKey)
|
| 182 | 182 | , (mkTcOcc "Foldable", foldableClassKey)
|
| 183 | 183 | , (mkTcOcc "Traversable", traversableClassKey)
|
| ... | ... | @@ -213,15 +213,22 @@ basicKnownKeyTable |
| 213 | 213 | , (mkTcOcc "Real", realClassKey)
|
| 214 | 214 | , (mkTcOcc "Fractional", fractionalClassKey)
|
| 215 | 215 | , (mkTcOcc "RealFloat", realFloatClassKey)
|
| 216 | --- , (mkTcOcc "RealFrac", realFracClassKey)
|
|
| 216 | + , (mkTcOcc "RealFrac", realFracClassKey)
|
|
| 217 | 217 | , (mkVarOcc "-", minusClassOpKey)
|
| 218 | 218 | , (mkVarOcc "negate", negateClassOpKey)
|
| 219 | 219 | , (mkVarOcc "fromInteger", fromIntegerClassOpKey)
|
| 220 | + , (mkVarOcc "divInt#", divIntIdKey)
|
|
| 221 | + , (mkVarOcc "modInt#", modIntIdKey)
|
|
| 222 | + |
|
| 223 | + , (mkTcOcc "Ratio", ratioTyConKey)
|
|
| 224 | + , (mkDataOcc ":%", ratioDataConKey)
|
|
| 225 | + , (mkVarOcc "fromIntegral", fromIntegralIdKey)
|
|
| 220 | 226 | , (mkVarOcc "fromRational", fromRationalClassOpKey)
|
| 227 | + , (mkVarOcc "toInteger", toIntegerClassOpKey)
|
|
| 228 | + , (mkVarOcc "toRational", toRationalClassOpKey)
|
|
| 229 | + , (mkVarOcc "realToFrac", realToFracIdKey)
|
|
| 221 | 230 | , (mkVarOcc "mkRationalBase2", mkRationalBase2IdKey)
|
| 222 | 231 | , (mkVarOcc "mkRationalBase10", mkRationalBase10IdKey)
|
| 223 | - , (mkVarOcc "divInt#", divIntIdKey)
|
|
| 224 | - , (mkVarOcc "modInt#", modIntIdKey)
|
|
| 225 | 232 | |
| 226 | 233 | -- Class Functor
|
| 227 | 234 | , (mkTcOcc "Functor", functorClassKey)
|
| ... | ... | @@ -297,19 +304,23 @@ basicKnownKeyTable |
| 297 | 304 | , (mkVarOcc "fromStaticPtr", fromStaticPtrClassOpKey)
|
| 298 | 305 | , (mkVarOcc "makeStatic", makeStaticKey)
|
| 299 | 306 | |
| 307 | + -- WithDict
|
|
| 308 | + , (mkTcOcc "WithDict", withDictClassKey)
|
|
| 309 | + |
|
| 300 | 310 | -- Unsatisfiable class
|
| 301 | 311 | , (mkTcOcc "Unsatisfiable", unsatisfiableClassKey)
|
| 302 | 312 | , (mkVarOcc "unsatisfiable", unsatisfiableIdKey)
|
| 303 | 313 | |
| 314 | + |
|
| 304 | 315 | -- Known-key names that have BuiltinRules in ConstantFold
|
| 305 | 316 | , (mkVarOcc "unpackFoldrCString#", unpackCStringFoldrIdKey)
|
| 306 | 317 | , (mkVarOcc "unpackFoldrCStringUtf8#", unpackCStringFoldrUtf8IdKey)
|
| 307 | 318 | , (mkVarOcc "unpackAppendCString#", unpackCStringAppendIdKey)
|
| 308 | 319 | , (mkVarOcc "unpackAppendCStringUtf8#", unpackCStringAppendUtf8IdKey)
|
| 309 | 320 | , (mkVarOcc "cstringLength#", cstringLengthIdKey)
|
| 310 | - |
|
| 311 | 321 | , (mkVarOcc "eqString", eqStringIdKey)
|
| 312 | 322 | , (mkVarOcc "inline", inlineIdKey)
|
| 323 | + , (mkVarOcc "seq#", seqHashKey)
|
|
| 313 | 324 | |
| 314 | 325 | -- Unsafe equality proofs
|
| 315 | 326 | , (mkVarOcc "unsafeEqualityProof", unsafeEqualityProofIdKey)
|
| ... | ... | @@ -387,60 +398,19 @@ basicKnownKeyNames |
| 387 | 398 | runMainIOName,
|
| 388 | 399 | runRWName,
|
| 389 | 400 | |
| 390 | - -- Type representation types
|
|
| 391 | - trModuleTyConName, trModuleDataConName,
|
|
| 392 | - trNameSDataConName,
|
|
| 393 | - trTyConTyConName, trTyConDataConName,
|
|
| 394 | - |
|
| 395 | - -- Typeable
|
|
| 396 | - someTypeRepTyConName, -- known-occ
|
|
| 397 | - someTypeRepDataConName, -- ditto
|
|
| 398 | - kindRepTyConName,
|
|
| 399 | - kindRepTyConAppDataConName,
|
|
| 400 | - kindRepVarDataConName,
|
|
| 401 | - kindRepAppDataConName,
|
|
| 402 | - kindRepFunDataConName,
|
|
| 403 | - kindRepTYPEDataConName,
|
|
| 404 | - kindRepTypeLitSDataConName,
|
|
| 405 | - typeLitSymbolDataConName,
|
|
| 406 | - typeLitNatDataConName,
|
|
| 407 | - typeLitCharDataConName,
|
|
| 408 | - typeRepIdName,
|
|
| 409 | - mkTrConName,
|
|
| 410 | - mkTrAppCheckedName,
|
|
| 411 | - mkTrFunName,
|
|
| 412 | - typeSymbolTypeRepName, typeNatTypeRepName, typeCharTypeRepName,
|
|
| 413 | - trGhcPrimModuleName,
|
|
| 414 | - |
|
| 415 | 401 | -- KindReps for common cases
|
| 402 | + trGhcPrimModuleName,
|
|
| 416 | 403 | starKindRepName,
|
| 417 | 404 | starArrStarKindRepName,
|
| 418 | 405 | starArrStarArrStarKindRepName,
|
| 419 | 406 | constraintKindRepName,
|
| 420 | 407 | |
| 421 | - -- WithDict
|
|
| 422 | - withDictClassName,
|
|
| 423 | - |
|
| 424 | - -- seq#
|
|
| 425 | - seqHashName,
|
|
| 426 | - |
|
| 427 | - -- Dynamic
|
|
| 428 | - toDynName,
|
|
| 429 | - |
|
| 430 | - -- Conversion functions
|
|
| 431 | - ratioTyConName, ratioDataConName,
|
|
| 432 | - toIntegerName, toRationalName,
|
|
| 433 | - fromIntegralName, realToFracName,
|
|
| 434 | - |
|
| 435 | 408 | -- String stuff
|
| 436 | 409 | fromStringName,
|
| 437 | 410 | |
| 438 | 411 | -- Monad stuff
|
| 439 | 412 | bindMName,
|
| 440 | 413 | |
| 441 | - -- Read stuff
|
|
| 442 | - readClassName,
|
|
| 443 | - |
|
| 444 | 414 | -- Stable pointers
|
| 445 | 415 | newStablePtrName,
|
| 446 | 416 | |
| ... | ... | @@ -871,17 +841,6 @@ bniVarQual str key = varQual gHC_INTERNAL_NUM_INTEGER (fsLit str) key |
| 871 | 841 | ---------------------------------
|
| 872 | 842 | |
| 873 | 843 | -- GHC.Internal.Real types and classes
|
| 874 | -ratioTyConName, ratioDataConName,
|
|
| 875 | - fromRationalName, toIntegerName, toRationalName, fromIntegralName,
|
|
| 876 | - realToFracName :: Name
|
|
| 877 | -ratioTyConName = tcQual gHC_INTERNAL_REAL (fsLit "Ratio") ratioTyConKey
|
|
| 878 | -ratioDataConName = dcQual gHC_INTERNAL_REAL (fsLit ":%") ratioDataConKey
|
|
| 879 | -fromRationalName = varQual gHC_INTERNAL_REAL (fsLit "fromRational") fromRationalClassOpKey
|
|
| 880 | -toIntegerName = varQual gHC_INTERNAL_REAL (fsLit "toInteger") toIntegerClassOpKey
|
|
| 881 | -toRationalName = varQual gHC_INTERNAL_REAL (fsLit "toRational") toRationalClassOpKey
|
|
| 882 | -fromIntegralName = varQual gHC_INTERNAL_REAL (fsLit "fromIntegral")fromIntegralIdKey
|
|
| 883 | -realToFracName = varQual gHC_INTERNAL_REAL (fsLit "realToFrac") realToFracIdKey
|
|
| 884 | - |
|
| 885 | 844 | -- other GHC.Internal.Float functions
|
| 886 | 845 | integerToFloatName, integerToDoubleName,
|
| 887 | 846 | rationalToFloatName, rationalToDoubleName :: Name
|
| ... | ... | @@ -890,71 +849,12 @@ integerToDoubleName = varQual gHC_INTERNAL_FLOAT (fsLit "integerToDouble#") int |
| 890 | 849 | rationalToFloatName = varQual gHC_INTERNAL_FLOAT (fsLit "rationalToFloat#") rationalToFloatIdKey
|
| 891 | 850 | rationalToDoubleName = varQual gHC_INTERNAL_FLOAT (fsLit "rationalToDouble#") rationalToDoubleIdKey
|
| 892 | 851 | |
| 893 | --- Typeable representation types
|
|
| 894 | -trModuleTyConName
|
|
| 895 | - , trModuleDataConName
|
|
| 896 | - , trNameSDataConName
|
|
| 897 | - , trTyConTyConName
|
|
| 898 | - , trTyConDataConName
|
|
| 899 | - :: Name
|
|
| 900 | -trModuleTyConName = tcQual gHC_TYPES (fsLit "Module") trModuleTyConKey
|
|
| 901 | -trModuleDataConName = dcQual gHC_TYPES (fsLit "Module") trModuleDataConKey
|
|
| 902 | -trNameSDataConName = dcQual gHC_TYPES (fsLit "TrNameS") trNameSDataConKey
|
|
| 903 | -trTyConTyConName = tcQual gHC_TYPES (fsLit "TyCon") trTyConTyConKey
|
|
| 904 | -trTyConDataConName = dcQual gHC_TYPES (fsLit "TyCon") trTyConDataConKey
|
|
| 905 | - |
|
| 906 | -kindRepTyConName
|
|
| 907 | - , kindRepTyConAppDataConName
|
|
| 908 | - , kindRepVarDataConName
|
|
| 909 | - , kindRepAppDataConName
|
|
| 910 | - , kindRepFunDataConName
|
|
| 911 | - , kindRepTYPEDataConName
|
|
| 912 | - , kindRepTypeLitSDataConName
|
|
| 913 | - :: Name
|
|
| 914 | -kindRepTyConName = tcQual gHC_TYPES (fsLit "KindRep") kindRepTyConKey
|
|
| 915 | -kindRepTyConAppDataConName = dcQual gHC_TYPES (fsLit "KindRepTyConApp") kindRepTyConAppDataConKey
|
|
| 916 | -kindRepVarDataConName = dcQual gHC_TYPES (fsLit "KindRepVar") kindRepVarDataConKey
|
|
| 917 | -kindRepAppDataConName = dcQual gHC_TYPES (fsLit "KindRepApp") kindRepAppDataConKey
|
|
| 918 | -kindRepFunDataConName = dcQual gHC_TYPES (fsLit "KindRepFun") kindRepFunDataConKey
|
|
| 919 | -kindRepTYPEDataConName = dcQual gHC_TYPES (fsLit "KindRepTYPE") kindRepTYPEDataConKey
|
|
| 920 | -kindRepTypeLitSDataConName = dcQual gHC_TYPES (fsLit "KindRepTypeLitS") kindRepTypeLitSDataConKey
|
|
| 921 | - |
|
| 922 | -typeLitSymbolDataConName
|
|
| 923 | - , typeLitNatDataConName
|
|
| 924 | - , typeLitCharDataConName
|
|
| 925 | - :: Name
|
|
| 926 | -typeLitSymbolDataConName = dcQual gHC_TYPES (fsLit "TypeLitSymbol") typeLitSymbolDataConKey
|
|
| 927 | -typeLitNatDataConName = dcQual gHC_TYPES (fsLit "TypeLitNat") typeLitNatDataConKey
|
|
| 928 | -typeLitCharDataConName = dcQual gHC_TYPES (fsLit "TypeLitChar") typeLitCharDataConKey
|
|
| 929 | - |
|
| 930 | 852 | -- Class Typeable, and functions for constructing `Typeable` dictionaries
|
| 931 | -someTypeRepTyConName
|
|
| 932 | - , someTypeRepDataConName
|
|
| 933 | - , mkTrConName
|
|
| 934 | - , mkTrAppCheckedName
|
|
| 935 | - , mkTrFunName
|
|
| 936 | - , typeRepIdName
|
|
| 937 | - , typeNatTypeRepName
|
|
| 938 | - , typeSymbolTypeRepName
|
|
| 939 | - , typeCharTypeRepName
|
|
| 940 | - , trGhcPrimModuleName
|
|
| 941 | - :: Name
|
|
| 942 | -someTypeRepTyConName = tcQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "SomeTypeRep") someTypeRepTyConKey
|
|
| 943 | -someTypeRepDataConName = dcQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "SomeTypeRep") someTypeRepDataConKey
|
|
| 944 | -typeRepIdName = varQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "typeRep#") typeRepIdKey
|
|
| 945 | -mkTrConName = varQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "mkTrCon") mkTrConKey
|
|
| 946 | -mkTrAppCheckedName = varQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "mkTrAppChecked") mkTrAppCheckedKey
|
|
| 947 | -mkTrFunName = varQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "mkTrFun") mkTrFunKey
|
|
| 948 | -typeNatTypeRepName = varQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "typeNatTypeRep") typeNatTypeRepKey
|
|
| 949 | -typeSymbolTypeRepName = varQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "typeSymbolTypeRep") typeSymbolTypeRepKey
|
|
| 950 | -typeCharTypeRepName = varQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "typeCharTypeRep") typeCharTypeRepKey
|
|
| 951 | --- this is the Typeable 'Module' for GHC.Prim (which has no code, so we place in GHC.Types)
|
|
| 853 | +trGhcPrimModuleName, starKindRepName, starArrStarKindRepName,
|
|
| 854 | + starArrStarArrStarKindRepName, constraintKindRepName :: Name
|
|
| 855 | +-- This is the Typeable 'Module' for GHC.Prim (which has no code, so we place in GHC.Types)
|
|
| 952 | 856 | -- See Note [Grand plan for Typeable] in GHC.Tc.Instance.Typeable.
|
| 953 | 857 | trGhcPrimModuleName = varQual gHC_TYPES (fsLit "tr$ModuleGHCPrim") trGhcPrimModuleKey
|
| 954 | - |
|
| 955 | --- Typeable KindReps for some common cases
|
|
| 956 | -starKindRepName, starArrStarKindRepName,
|
|
| 957 | - starArrStarArrStarKindRepName, constraintKindRepName :: Name
|
|
| 958 | 858 | starKindRepName = varQual gHC_TYPES (fsLit "krep$*") starKindRepKey
|
| 959 | 859 | starArrStarKindRepName = varQual gHC_TYPES (fsLit "krep$*Arr*") starArrStarKindRepKey
|
| 960 | 860 | starArrStarArrStarKindRepName = varQual gHC_TYPES (fsLit "krep$*->*->*") starArrStarArrStarKindRepKey
|
| ... | ... | @@ -967,10 +867,6 @@ withDictClassName = clsQual gHC_MAGIC_DICT (fsLit "WithDict") withDictClassKey |
| 967 | 867 | nonEmptyTyConName :: Name
|
| 968 | 868 | nonEmptyTyConName = tcQual gHC_INTERNAL_BASE (fsLit "NonEmpty") nonEmptyTyConKey
|
| 969 | 869 | |
| 970 | --- seq#
|
|
| 971 | -seqHashName :: Name
|
|
| 972 | -seqHashName = varQual gHC_INTERNAL_IO (fsLit "seq#") seqHashKey
|
|
| 973 | - |
|
| 974 | 870 | -- Custom type errors
|
| 975 | 871 | errorMessageTypeErrorFamName
|
| 976 | 872 | , typeErrorTextDataConName
|
| ... | ... | @@ -998,10 +894,6 @@ typeErrorShowTypeDataConName = |
| 998 | 894 | unsafeCoercePrimName:: Name
|
| 999 | 895 | unsafeCoercePrimName = varQual gHC_INTERNAL_UNSAFE_COERCE (fsLit "unsafeCoerce#") unsafeCoercePrimIdKey
|
| 1000 | 896 | |
| 1001 | --- Dynamic
|
|
| 1002 | -toDynName :: Name
|
|
| 1003 | -toDynName = varQual gHC_INTERNAL_DYNAMIC (fsLit "toDyn") toDynIdKey
|
|
| 1004 | - |
|
| 1005 | 897 | -- Error module
|
| 1006 | 898 | assertErrorName :: Name
|
| 1007 | 899 | assertErrorName = varQual gHC_INTERNAL_IO_Exception (fsLit "assertError") assertErrorIdKey
|
| ... | ... | @@ -1010,10 +902,6 @@ assertErrorName = varQual gHC_INTERNAL_IO_Exception (fsLit "assertError") asse |
| 1010 | 902 | traceName :: Name
|
| 1011 | 903 | traceName = varQual gHC_INTERNAL_DEBUG_TRACE (fsLit "trace") traceKey
|
| 1012 | 904 | |
| 1013 | --- Class Read
|
|
| 1014 | -readClassName :: Name
|
|
| 1015 | -readClassName = clsQual gHC_INTERNAL_READ (fsLit "Read") readClassKey
|
|
| 1016 | - |
|
| 1017 | 905 | genericClassKeys :: [KnownKey]
|
| 1018 | 906 | genericClassKeys = [genClassKey, gen1ClassKey]
|
| 1019 | 907 | |
| ... | ... | @@ -1157,9 +1045,6 @@ dcQual modu str unique = mk_known_key_name dataName modu str unique |
| 1157 | 1045 | * *
|
| 1158 | 1046 | ********************************************************************* -}
|
| 1159 | 1047 | |
| 1160 | -rationalTyConOcc :: KnownOcc
|
|
| 1161 | -rationalTyConOcc = mkTcOcc "Rational"
|
|
| 1162 | - |
|
| 1163 | 1048 | sappendClassOpOcc, pureAClassOpOcc, thenAClassOpOcc,
|
| 1164 | 1049 | returnMClassOpOcc, thenMClassOpOcc, mappendClassOpOcc :: KnownOcc
|
| 1165 | 1050 | sappendClassOpOcc = mkVarOcc "<>"
|
| ... | ... | @@ -21,6 +21,8 @@ import GHC.Builtin.PrimOps.Ids (primOpId) |
| 21 | 21 | import GHC.Builtin.TH( unsafeCodeCoerceName, liftTypedName )
|
| 22 | 22 | import GHC.Builtin.KnownKeys
|
| 23 | 23 | |
| 24 | +import GHC.Types.Name( KnownOcc )
|
|
| 25 | +import GHC.Types.Name.Occurrence
|
|
| 24 | 26 | import GHC.Types.Name.Reader( RdrName, mkVarUnqual, getRdrName
|
| 25 | 27 | , nameRdrName )
|
| 26 | 28 | import GHC.Types.Id.Make( coerceName ) -- `coerce` is wired-in
|
| ... | ... | @@ -48,6 +50,85 @@ mechanisms: |
| 48 | 50 | -}
|
| 49 | 51 | |
| 50 | 52 | |
| 53 | +{- *********************************************************************
|
|
| 54 | +* *
|
|
| 55 | + Known-occ OccNames
|
|
| 56 | +* *
|
|
| 57 | +********************************************************************* -}
|
|
| 58 | + |
|
| 59 | +rationalTyConOcc :: KnownOcc
|
|
| 60 | +rationalTyConOcc = mkTcOcc "Rational"
|
|
| 61 | + |
|
| 62 | +-- Class Typeable, and functions for constructing `Typeable` dictionaries
|
|
| 63 | +someTypeRepTyConOcc
|
|
| 64 | + , someTypeRepDataConOcc
|
|
| 65 | + , mkTrConOcc
|
|
| 66 | + , mkTrAppCheckedOcc
|
|
| 67 | + , mkTrFunOcc
|
|
| 68 | + , typeRepIdOcc
|
|
| 69 | + , typeNatTypeRepOcc
|
|
| 70 | + , typeSymbolTypeRepOcc
|
|
| 71 | + , typeCharTypeRepOcc
|
|
| 72 | + :: KnownOcc
|
|
| 73 | +someTypeRepTyConOcc = mkTcOcc "SomeTypeRep"
|
|
| 74 | +someTypeRepDataConOcc = mkDataOcc "SomeTypeRep"
|
|
| 75 | +typeRepIdOcc = mkVarOcc "typeRep#"
|
|
| 76 | +mkTrConOcc = mkVarOcc "mkTrCon"
|
|
| 77 | +mkTrAppCheckedOcc = mkVarOcc "mkTrAppChecked"
|
|
| 78 | +mkTrFunOcc = mkVarOcc "mkTrFun"
|
|
| 79 | +typeNatTypeRepOcc = mkVarOcc "typeNatTypeRep"
|
|
| 80 | +typeSymbolTypeRepOcc = mkVarOcc "typeSymbolTypeRep"
|
|
| 81 | +typeCharTypeRepOcc = mkVarOcc "typeCharTypeRep"
|
|
| 82 | + |
|
| 83 | +typeLitSymbolDataConOcc
|
|
| 84 | + , typeLitNatDataConOcc
|
|
| 85 | + , typeLitCharDataConOcc
|
|
| 86 | + :: KnownOcc
|
|
| 87 | +typeLitSymbolDataConOcc = mkDataOcc "TypeLitSymbol"
|
|
| 88 | +typeLitNatDataConOcc = mkDataOcc "TypeLitNat"
|
|
| 89 | +typeLitCharDataConOcc = mkDataOcc "TypeLitChar"
|
|
| 90 | + |
|
| 91 | + |
|
| 92 | +trModuleTyConOcc
|
|
| 93 | + , trModuleDataConOcc
|
|
| 94 | + , trNameSDataConOcc
|
|
| 95 | + , trTyConTyConOcc
|
|
| 96 | + , trTyConDataConOcc
|
|
| 97 | + :: KnownOcc
|
|
| 98 | +trModuleTyConOcc = mkTcOcc "Module"
|
|
| 99 | +trModuleDataConOcc = mkDataOcc "Module"
|
|
| 100 | +trNameSDataConOcc = mkDataOcc "TrNameS"
|
|
| 101 | +trTyConTyConOcc = mkTcOcc "TyCon"
|
|
| 102 | +trTyConDataConOcc = mkDataOcc "TyCon"
|
|
| 103 | + |
|
| 104 | +-- Typeable representation types
|
|
| 105 | +kindRepTyConOcc
|
|
| 106 | + , kindRepTyConAppDataConOcc
|
|
| 107 | + , kindRepVarDataConOcc
|
|
| 108 | + , kindRepAppDataConOcc
|
|
| 109 | + , kindRepFunDataConOcc
|
|
| 110 | + , kindRepTYPEDataConOcc
|
|
| 111 | + , kindRepTypeLitSDataConOcc
|
|
| 112 | + :: KnownOcc
|
|
| 113 | +kindRepTyConOcc = mkTcOcc "KindRep"
|
|
| 114 | +kindRepTyConAppDataConOcc = mkDataOcc "KindRepTyConApp"
|
|
| 115 | +kindRepVarDataConOcc = mkDataOcc "KindRepVar"
|
|
| 116 | +kindRepAppDataConOcc = mkDataOcc "KindRepApp"
|
|
| 117 | +kindRepFunDataConOcc = mkDataOcc "KindRepFun"
|
|
| 118 | +kindRepTYPEDataConOcc = mkDataOcc "KindRepTYPE"
|
|
| 119 | +kindRepTypeLitSDataConOcc = mkDataOcc "KindRepTypeLitS"
|
|
| 120 | + |
|
| 121 | + |
|
| 122 | +{- *********************************************************************
|
|
| 123 | +* *
|
|
| 124 | + Misc global RdrNames
|
|
| 125 | +* *
|
|
| 126 | +********************************************************************* -}
|
|
| 127 | + |
|
| 128 | +toDyn_RDR :: RdrName
|
|
| 129 | +toDyn_RDR = knownVarOccRdrName "toDyn"
|
|
| 130 | + |
|
| 131 | + |
|
| 51 | 132 | {- *********************************************************************
|
| 52 | 133 | * *
|
| 53 | 134 | Global RdrNames used by derived instances
|
| ... | ... | @@ -58,7 +58,8 @@ import GHC.Core.Rules |
| 58 | 58 | import GHC.Core.Ppr( pprCoreBinders )
|
| 59 | 59 | import GHC.Core.TyCo.Compare( eqType )
|
| 60 | 60 | |
| 61 | -import GHC.Builtin.KnownKeys
|
|
| 61 | +import GHC.Builtin.KnownKeys( typeableClassKey )
|
|
| 62 | +import GHC.Builtin.KnownOccs
|
|
| 62 | 63 | import GHC.Builtin.Types ( naturalTy, typeSymbolKind, charTy )
|
| 63 | 64 | |
| 64 | 65 | import GHC.Tc.Types.Evidence
|
| ... | ... | @@ -1761,10 +1762,10 @@ type TypeRepExpr = CoreExpr |
| 1761 | 1762 | -- | Returns a @CoreExpr :: TypeRep ty@
|
| 1762 | 1763 | ds_ev_typeable :: Type -> EvTypeable -> DsM CoreExpr
|
| 1763 | 1764 | ds_ev_typeable ty (EvTypeableTyCon tc kind_ev)
|
| 1764 | - = do { mkTrCon <- dsLookupGlobalId mkTrConName
|
|
| 1765 | + = do { mkTrCon <- dsLookupKnownOccId mkTrConOcc
|
|
| 1765 | 1766 | -- mkTrCon :: forall k (a :: k). TyCon -> TypeRep k -> TypeRep a
|
| 1766 | - ; someTypeRepTyCon <- dsLookupTyCon someTypeRepTyConName
|
|
| 1767 | - ; someTypeRepDataCon <- dsLookupDataCon someTypeRepDataConName
|
|
| 1767 | + ; someTypeRepTyCon <- dsLookupKnownOccTyCon someTypeRepTyConOcc
|
|
| 1768 | + ; someTypeRepDataCon <- dsLookupKnownOccDataCon someTypeRepDataConOcc
|
|
| 1768 | 1769 | -- SomeTypeRep :: forall k (a :: k). TypeRep a -> SomeTypeRep
|
| 1769 | 1770 | |
| 1770 | 1771 | ; tc_rep <- tyConRep tc -- :: TyCon
|
| ... | ... | @@ -1793,7 +1794,7 @@ ds_ev_typeable ty (EvTypeableTyApp ev1 ev2) |
| 1793 | 1794 | | Just (t1,t2) <- splitAppTy_maybe ty
|
| 1794 | 1795 | = do { e1 <- getRep ev1 t1
|
| 1795 | 1796 | ; e2 <- getRep ev2 t2
|
| 1796 | - ; mkTrAppChecked <- dsLookupGlobalId mkTrAppCheckedName
|
|
| 1797 | + ; mkTrAppChecked <- dsLookupKnownOccId mkTrAppCheckedOcc
|
|
| 1797 | 1798 | -- mkTrAppChecked :: forall k1 k2 (a :: k1 -> k2) (b :: k1).
|
| 1798 | 1799 | -- TypeRep a -> TypeRep b -> TypeRep (a b)
|
| 1799 | 1800 | ; let (_, k1, k2) = splitFunTy (typeKind t1) -- drop the multiplicity,
|
| ... | ... | @@ -1809,7 +1810,7 @@ ds_ev_typeable ty (EvTypeableTrFun evm ev1 ev2) |
| 1809 | 1810 | = do { e1 <- getRep ev1 t1
|
| 1810 | 1811 | ; e2 <- getRep ev2 t2
|
| 1811 | 1812 | ; em <- getRep evm m
|
| 1812 | - ; mkTrFun <- dsLookupGlobalId mkTrFunName
|
|
| 1813 | + ; mkTrFun <- dsLookupKnownOccId mkTrFunOcc
|
|
| 1813 | 1814 | -- mkTrFun :: forall (m :: Multiplicity) r1 r2 (a :: TYPE r1) (b :: TYPE r2).
|
| 1814 | 1815 | -- TypeRep m -> TypeRep a -> TypeRep b -> TypeRep (a % m -> b)
|
| 1815 | 1816 | ; let r1 = getRuntimeRep t1
|
| ... | ... | @@ -1820,7 +1821,7 @@ ds_ev_typeable ty (EvTypeableTrFun evm ev1 ev2) |
| 1820 | 1821 | |
| 1821 | 1822 | ds_ev_typeable ty (EvTypeableTyLit ev)
|
| 1822 | 1823 | = -- See Note [Typeable for Nat and Symbol] in GHC.Tc.Instance.Class
|
| 1823 | - do { fun <- dsLookupGlobalId tr_fun
|
|
| 1824 | + do { fun <- dsLookupKnownOccId tr_fun
|
|
| 1824 | 1825 | ; dict <- dsEvTerm ev -- Of type KnownNat/KnownSymbol
|
| 1825 | 1826 | ; return (mkApps (mkTyApps (Var fun) [ty]) [ dict ]) }
|
| 1826 | 1827 | where
|
| ... | ... | @@ -1829,9 +1830,9 @@ ds_ev_typeable ty (EvTypeableTyLit ev) |
| 1829 | 1830 | -- tr_fun is the Name of
|
| 1830 | 1831 | -- typeNatTypeRep :: KnownNat a => TypeRep a
|
| 1831 | 1832 | -- of typeSymbolTypeRep :: KnownSymbol a => TypeRep a
|
| 1832 | - tr_fun | ty_kind `eqType` naturalTy = typeNatTypeRepName
|
|
| 1833 | - | ty_kind `eqType` typeSymbolKind = typeSymbolTypeRepName
|
|
| 1834 | - | ty_kind `eqType` charTy = typeCharTypeRepName
|
|
| 1833 | + tr_fun | ty_kind `eqType` naturalTy = typeNatTypeRepOcc
|
|
| 1834 | + | ty_kind `eqType` typeSymbolKind = typeSymbolTypeRepOcc
|
|
| 1835 | + | ty_kind `eqType` charTy = typeCharTypeRepOcc
|
|
| 1835 | 1836 | | otherwise = panic "dsEvTypeable: unknown type lit kind"
|
| 1836 | 1837 | |
| 1837 | 1838 | ds_ev_typeable ty ev
|
| ... | ... | @@ -1845,7 +1846,7 @@ getRep :: EvTerm -- ^ EvTerm for @Typeable ty@ |
| 1845 | 1846 | -- typeRep# :: forall k (a::k). Typeable k a -> TypeRep a
|
| 1846 | 1847 | getRep ev ty
|
| 1847 | 1848 | = do { typeable_expr <- dsEvTerm ev
|
| 1848 | - ; typeRepId <- dsLookupGlobalId typeRepIdName
|
|
| 1849 | + ; typeRepId <- dsLookupKnownOccId typeRepIdOcc
|
|
| 1849 | 1850 | ; let ty_args = [typeKind ty, ty]
|
| 1850 | 1851 | ; return (mkApps (mkTyApps (Var typeRepId) ty_args) [ typeable_expr ]) }
|
| 1851 | 1852 |
| ... | ... | @@ -238,7 +238,7 @@ dsFractionalLitToRational fl@FL{ fl_signi = signi, fl_exp = exp, fl_exp_base = b |
| 238 | 238 | dsRational :: Rational -> DsM CoreExpr
|
| 239 | 239 | dsRational (n :% d) = do
|
| 240 | 240 | platform <- targetPlatform <$> getDynFlags
|
| 241 | - dcn <- dsLookupDataCon ratioDataConName
|
|
| 241 | + dcn <- dsLookupKnownKeyDataCon ratioDataConKey
|
|
| 242 | 242 | let cn = mkIntegerExpr platform n
|
| 243 | 243 | let dn = mkIntegerExpr platform d
|
| 244 | 244 | return $ mkCoreConApps dcn [Type integerTy, cn, dn]
|
| ... | ... | @@ -27,9 +27,9 @@ module GHC.HsToCore.Monad ( |
| 27 | 27 | -- Looking up in the environment
|
| 28 | 28 | dsLookupGlobal, dsLookupGlobalId, dsLookupTyCon,
|
| 29 | 29 | dsLookupDataCon, dsLookupConLike,
|
| 30 | - dsLookupKnownKeyTyCon, dsLookupKnownKeyId,
|
|
| 30 | + dsLookupKnownKeyTyCon, dsLookupKnownKeyDataCon, dsLookupKnownKeyId,
|
|
| 31 | 31 | dsLookupKnownKeyName,
|
| 32 | - dsLookupKnownOccId, dsLookupKnownOccTyCon,
|
|
| 32 | + dsLookupKnownOccId, dsLookupKnownOccTyCon, dsLookupKnownOccDataCon,
|
|
| 33 | 33 | |
| 34 | 34 | DsMetaEnv, DsMetaVal(..), dsGetMetaEnv, dsLookupMetaEnv, dsExtendMetaEnv,
|
| 35 | 35 | |
| ... | ... | @@ -597,6 +597,9 @@ dsLookupKnownOccThing occ |
| 597 | 597 | dsLookupKnownOccTyCon :: KnownOcc -> DsM TyCon
|
| 598 | 598 | dsLookupKnownOccTyCon uniq = tyThingTyCon <$> dsLookupKnownOccThing uniq
|
| 599 | 599 | |
| 600 | +dsLookupKnownOccDataCon :: KnownOcc -> DsM DataCon
|
|
| 601 | +dsLookupKnownOccDataCon uniq = tyThingDataCon <$> dsLookupKnownOccThing uniq
|
|
| 602 | + |
|
| 600 | 603 | dsLookupKnownOccId :: KnownOcc -> DsM Id
|
| 601 | 604 | dsLookupKnownOccId uniq = tyThingId <$> dsLookupKnownOccThing uniq
|
| 602 | 605 | |
| ... | ... | @@ -624,6 +627,9 @@ dsLookupKnownKeyThing uniq |
| 624 | 627 | dsLookupKnownKeyTyCon :: KnownKey -> DsM TyCon
|
| 625 | 628 | dsLookupKnownKeyTyCon uniq = tyThingTyCon <$> dsLookupKnownKeyThing uniq
|
| 626 | 629 | |
| 630 | +dsLookupKnownKeyDataCon :: KnownKey -> DsM DataCon
|
|
| 631 | +dsLookupKnownKeyDataCon uniq = tyThingDataCon <$> dsLookupKnownKeyThing uniq
|
|
| 632 | + |
|
| 627 | 633 | dsLookupKnownKeyId :: KnownKey -> DsM Id
|
| 628 | 634 | dsLookupKnownKeyId uniq = tyThingId <$> dsLookupKnownKeyThing uniq
|
| 629 | 635 |
| ... | ... | @@ -21,7 +21,8 @@ import GHC.Types.Id |
| 21 | 21 | import GHC.Core.ConLike
|
| 22 | 22 | import GHC.Types.Name
|
| 23 | 23 | import GHC.Builtin.Types
|
| 24 | -import GHC.Builtin.KnownKeys (rationalTyConKey, toListClassOpKey)
|
|
| 24 | +import GHC.Builtin.KnownKeys ( toListClassOpKey )
|
|
| 25 | +import GHC.Builtin.KnownOccs ( rationalTyConOcc )
|
|
| 25 | 26 | import GHC.Types.SrcLoc
|
| 26 | 27 | import GHC.Utils.Outputable
|
| 27 | 28 | import GHC.Utils.Panic
|
| ... | ... | @@ -253,7 +254,7 @@ desugarPat x pat = case pat of |
| 253 | 254 | , (HsFractional f) <- val
|
| 254 | 255 | , negates <- if fl_neg f then 1 else 0
|
| 255 | 256 | -> do
|
| 256 | - rat_tc <- dsLookupKnownKeyTyCon rationalTyConKey
|
|
| 257 | + rat_tc <- dsLookupKnownOccTyCon rationalTyConOcc
|
|
| 257 | 258 | let rat_ty = mkTyConTy rat_tc
|
| 258 | 259 | return $ Just $ PmLit rat_ty (PmLitOverRat negates f)
|
| 259 | 260 | | otherwise
|
| ... | ... | @@ -83,7 +83,7 @@ import GHC.Tc.Utils.TcType |
| 83 | 83 | import GHC.Tc.Types.Constraint
|
| 84 | 84 | import GHC.Tc.Types.Origin
|
| 85 | 85 | |
| 86 | -import GHC.Builtin.KnownKeys ( toDynName )
|
|
| 86 | +import GHC.Builtin.KnownOccs ( toDyn_RDR )
|
|
| 87 | 87 | import GHC.Builtin.Types ( pretendNameIsInScope )
|
| 88 | 88 | |
| 89 | 89 | import GHC.Data.Maybe
|
| ... | ... | @@ -1290,7 +1290,7 @@ dynCompileExpr expr = do |
| 1290 | 1290 | parsed_expr <- parseExpr expr
|
| 1291 | 1291 | -- > Data.Dynamic.toDyn expr
|
| 1292 | 1292 | let loc = getLoc parsed_expr
|
| 1293 | - to_dyn_expr = mkHsApp (L loc . mkHsVar . L (l2l loc) $ getRdrName toDynName)
|
|
| 1293 | + to_dyn_expr = mkHsApp (L loc . mkHsVar . L (l2l loc) toDyn_RDR)
|
|
| 1294 | 1294 | parsed_expr
|
| 1295 | 1295 | hval <- compileParsedExpr to_dyn_expr
|
| 1296 | 1296 | return (unsafeCoerce hval :: Dynamic)
|
| ... | ... | @@ -443,7 +443,7 @@ matchWithDict [cls_ty, mty] |
| 443 | 443 | , [inst_meth_ty] <- dataConInstArgTys dict_dc dict_args
|
| 444 | 444 | = do { sv <- mkSysLocalM (fsLit "withDict_s") ManyTy mty
|
| 445 | 445 | ; k <- mkSysLocalM (fsLit "withDict_k") ManyTy (mkInvisFunTy cls_ty openAlphaTy)
|
| 446 | - ; wd_cls <- tcLookupClass withDictClassName
|
|
| 446 | + ; wd_cls <- tcLookupKnownKeyClass withDictClassKey
|
|
| 447 | 447 | |
| 448 | 448 | -- Given ev_expr : mty ~N# inst_meth_ty, construct the method of
|
| 449 | 449 | -- the WithDict dictionary:
|
| ... | ... | @@ -12,32 +12,41 @@ module GHC.Tc.Instance.Typeable(mkTypeableBinds, tyConIsTypeable) where |
| 12 | 12 | import GHC.Prelude
|
| 13 | 13 | import GHC.Platform
|
| 14 | 14 | |
| 15 | -import GHC.Types.Basic ( TypeOrConstraint(..) )
|
|
| 16 | -import GHC.Types.InlinePragma ( neverInlinePragma )
|
|
| 17 | -import GHC.Types.SourceText ( SourceText(..) )
|
|
| 18 | -import GHC.Iface.Env( newGlobalBinder )
|
|
| 19 | -import GHC.Core.TyCo.Rep( Type(..), TyLit(..) )
|
|
| 15 | +import GHC.Hs
|
|
| 16 | + |
|
| 20 | 17 | import GHC.Tc.Utils.Env
|
| 21 | 18 | import GHC.Tc.Types.Evidence ( mkWpTyApps )
|
| 22 | 19 | import GHC.Tc.Utils.Monad
|
| 23 | 20 | import GHC.Tc.Utils.TcType
|
| 24 | -import GHC.Types.TyThing ( lookupId )
|
|
| 21 | + |
|
| 22 | +import GHC.Iface.Env( newGlobalBinder )
|
|
| 23 | + |
|
| 25 | 24 | import GHC.Builtin.KnownKeys
|
| 25 | +import GHC.Builtin.KnownOccs
|
|
| 26 | 26 | import GHC.Builtin.Types.Prim ( primTyCons )
|
| 27 | 27 | import GHC.Builtin.Types
|
| 28 | 28 | ( runtimeRepTyCon
|
| 29 | 29 | , levityTyCon, vecCountTyCon, vecElemTyCon
|
| 30 | 30 | , nilDataCon, consDataCon )
|
| 31 | + |
|
| 32 | +import GHC.Types.TyThing ( lookupId )
|
|
| 33 | +import GHC.Types.Basic ( TypeOrConstraint(..) )
|
|
| 34 | +import GHC.Types.InlinePragma ( neverInlinePragma )
|
|
| 35 | +import GHC.Types.SourceText ( SourceText(..) )
|
|
| 31 | 36 | import GHC.Types.Name
|
| 32 | 37 | import GHC.Types.Id
|
| 38 | +import GHC.Types.Var ( VarBndr(..) )
|
|
| 39 | + |
|
| 40 | +import GHC.Core.TyCo.Rep( Type(..), TyLit(..) )
|
|
| 33 | 41 | import GHC.Core.Type
|
| 34 | 42 | import GHC.Core.TyCon
|
| 35 | 43 | import GHC.Core.DataCon
|
| 44 | +import GHC.Core.Map.Type
|
|
| 45 | + |
|
| 36 | 46 | import GHC.Unit.Module
|
| 37 | -import GHC.Hs
|
|
| 47 | + |
|
| 38 | 48 | import GHC.Driver.DynFlags
|
| 39 | -import GHC.Types.Var ( VarBndr(..) )
|
|
| 40 | -import GHC.Core.Map.Type
|
|
| 49 | + |
|
| 41 | 50 | import GHC.Utils.Fingerprint(Fingerprint(..), fingerprintString, fingerprintFingerprints)
|
| 42 | 51 | import GHC.Utils.Outputable
|
| 43 | 52 | import GHC.Utils.Panic
|
| ... | ... | @@ -342,7 +351,7 @@ mkModIdBindings |
| 342 | 351 | = do { mod <- getModule
|
| 343 | 352 | ; loc <- getSrcSpanM
|
| 344 | 353 | ; mod_nm <- newGlobalBinder mod (mkVarOccFS (fsLit "$trModule")) Nothing loc
|
| 345 | - ; trModuleTyCon <- tcLookupTyCon trModuleTyConName
|
|
| 354 | + ; trModuleTyCon <- tcLookupKnownOccTyCon trModuleTyConOcc
|
|
| 346 | 355 | ; let mod_id = mkExportedVanillaId mod_nm (mkTyConApp trModuleTyCon [])
|
| 347 | 356 | `setInlinePragma` neverInlinePragma
|
| 348 | 357 | -- See Note [NOINLINE on generated Typeable bindings]
|
| ... | ... | @@ -354,7 +363,7 @@ mkModIdBindings |
| 354 | 363 | |
| 355 | 364 | mkModIdRHS :: Module -> TcM (LHsExpr GhcTc)
|
| 356 | 365 | mkModIdRHS mod
|
| 357 | - = do { trModuleDataCon <- tcLookupDataCon trModuleDataConName
|
|
| 366 | + = do { trModuleDataCon <- tcLookupKnownOccDataCon trModuleDataConOcc
|
|
| 358 | 367 | ; trNameLit <- mkTrNameLit
|
| 359 | 368 | ; return $ nlHsDataCon trModuleDataCon
|
| 360 | 369 | `nlHsApp` trNameLit (unitFS (moduleUnit mod))
|
| ... | ... | @@ -393,7 +402,7 @@ data TyConTodo |
| 393 | 402 | |
| 394 | 403 | todoForTyCons :: Module -> Id -> [TyCon] -> TcM TypeRepTodo
|
| 395 | 404 | todoForTyCons mod mod_id tycons = do
|
| 396 | - trTyConTy <- mkTyConTy <$> tcLookupTyCon trTyConTyConName
|
|
| 405 | + trTyConTy <- mkTyConTy <$> tcLookupKnownOccTyCon trTyConTyConOcc
|
|
| 397 | 406 | let mk_rep_id :: TyConRepName -> Id
|
| 398 | 407 | mk_rep_id rep_name = mkExportedVanillaId rep_name trTyConTy
|
| 399 | 408 | `setInlinePragma` neverInlinePragma
|
| ... | ... | @@ -426,7 +435,7 @@ todoForTyCons mod mod_id tycons = do |
| 426 | 435 | |
| 427 | 436 | todoForExportedKindReps :: [(Kind, Name)] -> TcM TypeRepTodo
|
| 428 | 437 | todoForExportedKindReps kinds = do
|
| 429 | - trKindRepTy <- mkTyConTy <$> tcLookupTyCon kindRepTyConName
|
|
| 438 | + trKindRepTy <- mkTyConTy <$> tcLookupKnownOccTyCon kindRepTyConOcc
|
|
| 430 | 439 | let mkId (k, name) = (k, mkExportedVanillaId name trKindRepTy)
|
| 431 | 440 | return $ ExportedKindRepsTodo $ map mkId kinds
|
| 432 | 441 | |
| ... | ... | @@ -472,7 +481,7 @@ mkPrimTypeableTodos |
| 472 | 481 | = do { mod <- getModule
|
| 473 | 482 | ; if mod == gHC_TYPES
|
| 474 | 483 | then do { -- Build Module binding for GHC.Prim
|
| 475 | - trModuleTyCon <- tcLookupTyCon trModuleTyConName
|
|
| 484 | + trModuleTyCon <- tcLookupKnownOccTyCon trModuleTyConOcc
|
|
| 476 | 485 | ; let ghc_prim_module_id =
|
| 477 | 486 | mkExportedVanillaId trGhcPrimModuleName
|
| 478 | 487 | (mkTyConTy trModuleTyCon)
|
| ... | ... | @@ -547,17 +556,17 @@ data TypeableStuff |
| 547 | 556 | collect_stuff :: TcM TypeableStuff
|
| 548 | 557 | collect_stuff = do
|
| 549 | 558 | platform <- targetPlatform <$> getDynFlags
|
| 550 | - trTyConDataCon <- tcLookupDataCon trTyConDataConName
|
|
| 551 | - kindRepTyCon <- tcLookupTyCon kindRepTyConName
|
|
| 552 | - kindRepTyConAppDataCon <- tcLookupDataCon kindRepTyConAppDataConName
|
|
| 553 | - kindRepVarDataCon <- tcLookupDataCon kindRepVarDataConName
|
|
| 554 | - kindRepAppDataCon <- tcLookupDataCon kindRepAppDataConName
|
|
| 555 | - kindRepFunDataCon <- tcLookupDataCon kindRepFunDataConName
|
|
| 556 | - kindRepTYPEDataCon <- tcLookupDataCon kindRepTYPEDataConName
|
|
| 557 | - kindRepTypeLitSDataCon <- tcLookupDataCon kindRepTypeLitSDataConName
|
|
| 558 | - typeLitSymbolDataCon <- tcLookupDataCon typeLitSymbolDataConName
|
|
| 559 | - typeLitNatDataCon <- tcLookupDataCon typeLitNatDataConName
|
|
| 560 | - typeLitCharDataCon <- tcLookupDataCon typeLitCharDataConName
|
|
| 559 | + trTyConDataCon <- tcLookupKnownOccDataCon trTyConDataConOcc
|
|
| 560 | + kindRepTyCon <- tcLookupKnownOccTyCon kindRepTyConOcc
|
|
| 561 | + kindRepTyConAppDataCon <- tcLookupKnownOccDataCon kindRepTyConAppDataConOcc
|
|
| 562 | + kindRepVarDataCon <- tcLookupKnownOccDataCon kindRepVarDataConOcc
|
|
| 563 | + kindRepAppDataCon <- tcLookupKnownOccDataCon kindRepAppDataConOcc
|
|
| 564 | + kindRepFunDataCon <- tcLookupKnownOccDataCon kindRepFunDataConOcc
|
|
| 565 | + kindRepTYPEDataCon <- tcLookupKnownOccDataCon kindRepTYPEDataConOcc
|
|
| 566 | + kindRepTypeLitSDataCon <- tcLookupKnownOccDataCon kindRepTypeLitSDataConOcc
|
|
| 567 | + typeLitSymbolDataCon <- tcLookupKnownOccDataCon typeLitSymbolDataConOcc
|
|
| 568 | + typeLitNatDataCon <- tcLookupKnownOccDataCon typeLitNatDataConOcc
|
|
| 569 | + typeLitCharDataCon <- tcLookupKnownOccDataCon typeLitCharDataConOcc
|
|
| 561 | 570 | trNameLit <- mkTrNameLit
|
| 562 | 571 | return Stuff {..}
|
| 563 | 572 | |
| ... | ... | @@ -566,7 +575,7 @@ collect_stuff = do |
| 566 | 575 | -- representations.
|
| 567 | 576 | mkTrNameLit :: TcM (FastString -> LHsExpr GhcTc)
|
| 568 | 577 | mkTrNameLit = do
|
| 569 | - trNameSDataCon <- tcLookupDataCon trNameSDataConName
|
|
| 578 | + trNameSDataCon <- tcLookupKnownOccDataCon trNameSDataConOcc
|
|
| 570 | 579 | let trNameLit :: FastString -> LHsExpr GhcTc
|
| 571 | 580 | trNameLit fs = nlHsPar $ nlHsDataCon trNameSDataCon
|
| 572 | 581 | `nlHsApp` nlHsLit (mkHsStringPrimLit fs)
|
| ... | ... | @@ -31,7 +31,7 @@ module GHC.Tc.Utils.Env( |
| 31 | 31 | |
| 32 | 32 | tcLookupKnownKeyGlobal, tcLookupKnownKeyTyCon,
|
| 33 | 33 | tcLookupKnownKeyClass, tcLookupKnownKeyId,
|
| 34 | - tcLookupKnownOccTyCon, tcLookupKnownOccId,
|
|
| 34 | + tcLookupKnownOccTyCon, tcLookupKnownOccDataCon, tcLookupKnownOccId,
|
|
| 35 | 35 | rnLookupKnownKeyName, rnLookupKnownKeyRdr, getKnownKeySource,
|
| 36 | 36 | |
| 37 | 37 | -- Local environment
|
| ... | ... | @@ -304,11 +304,7 @@ tcLookupGlobalOnly name |
| 304 | 304 | Nothing -> pprPanic "tcLookupGlobalOnly" (ppr name) }
|
| 305 | 305 | |
| 306 | 306 | tcLookupDataCon :: Name -> TcM DataCon
|
| 307 | -tcLookupDataCon name = do
|
|
| 308 | - thing <- tcLookupGlobal name
|
|
| 309 | - case thing of
|
|
| 310 | - AConLike (RealDataCon con) -> return con
|
|
| 311 | - _ -> wrongThingErr WrongThingDataCon (AGlobal thing) name
|
|
| 307 | +tcLookupDataCon = get_datacon . tcLookupGlobal
|
|
| 312 | 308 | |
| 313 | 309 | tcLookupPatSyn :: Name -> TcM PatSyn
|
| 314 | 310 | tcLookupPatSyn name = do
|
| ... | ... | @@ -337,18 +333,10 @@ tcLookupRecSelParent (RnRecUpdParent { rnRecUpdCons = cons }) |
| 337 | 333 | -- Any constructor will give the same result here.
|
| 338 | 334 | |
| 339 | 335 | tcLookupClass :: Name -> TcM Class
|
| 340 | -tcLookupClass name = do
|
|
| 341 | - thing <- tcLookupGlobal name
|
|
| 342 | - case thing of
|
|
| 343 | - ATyCon tc | Just cls <- tyConClass_maybe tc -> return cls
|
|
| 344 | - _ -> wrongThingErr WrongThingClass (AGlobal thing) name
|
|
| 336 | +tcLookupClass = get_class . tcLookupGlobal
|
|
| 345 | 337 | |
| 346 | 338 | tcLookupTyCon :: Name -> TcM TyCon
|
| 347 | -tcLookupTyCon name = do
|
|
| 348 | - thing <- tcLookupGlobal name
|
|
| 349 | - case thing of
|
|
| 350 | - ATyCon tc -> return tc
|
|
| 351 | - _ -> wrongThingErr WrongThingTyCon (AGlobal thing) name
|
|
| 339 | +tcLookupTyCon = get_tycon . tcLookupGlobal
|
|
| 352 | 340 | |
| 353 | 341 | tcLookupAxiom :: Name -> TcM (CoAxiom Branched)
|
| 354 | 342 | tcLookupAxiom name = do
|
| ... | ... | @@ -573,6 +561,9 @@ tcLookupKnownOccGlobal = tcrn_wrapper . lookupKnownOccThing |
| 573 | 561 | tcLookupKnownOccTyCon :: HasDebugCallStack => KnownOcc -> TcM TyCon
|
| 574 | 562 | tcLookupKnownOccTyCon = get_tycon . tcLookupKnownOccGlobal
|
| 575 | 563 | |
| 564 | +tcLookupKnownOccDataCon :: HasDebugCallStack => KnownOcc -> TcM DataCon
|
|
| 565 | +tcLookupKnownOccDataCon = get_datacon . tcLookupKnownOccGlobal
|
|
| 566 | + |
|
| 576 | 567 | tcLookupKnownOccId :: HasDebugCallStack => KnownOcc -> TcM Id
|
| 577 | 568 | tcLookupKnownOccId = get_id . tcLookupKnownOccGlobal
|
| 578 | 569 | |
| ... | ... | @@ -592,6 +583,13 @@ get_tycon do_the_lookup |
| 592 | 583 | ATyCon tc -> return tc
|
| 593 | 584 | _ -> wrongThingErr WrongThingClass (AGlobal thing) (getName thing) }
|
| 594 | 585 | |
| 586 | +get_datacon :: TcRn TyThing -> TcRn DataCon
|
|
| 587 | +get_datacon do_the_lookup
|
|
| 588 | + = do { thing <- do_the_lookup
|
|
| 589 | + ; case thing of
|
|
| 590 | + AConLike (RealDataCon con) -> return con
|
|
| 591 | + _ -> wrongThingErr WrongThingClass (AGlobal thing) (getName thing) }
|
|
| 592 | + |
|
| 595 | 593 | get_id :: TcRn TyThing -> TcRn Id
|
| 596 | 594 | get_id do_the_lookup
|
| 597 | 595 | = do { thing <- do_the_lookup
|
| ... | ... | @@ -40,7 +40,7 @@ import GHC.Prelude |
| 40 | 40 | import GHC.Driver.Session
|
| 41 | 41 | import GHC.Driver.Env
|
| 42 | 42 | |
| 43 | -import GHC.Builtin.KnownKeys( rationalTyConOcc )
|
|
| 43 | +import GHC.Builtin.KnownOccs( rationalTyConOcc )
|
|
| 44 | 44 | import GHC.Builtin.Types( integerTy )
|
| 45 | 45 | |
| 46 | 46 | import GHC.Hs
|
| ... | ... | @@ -11,8 +11,7 @@ |
| 11 | 11 | --
|
| 12 | 12 | |
| 13 | 13 | module GHC.KnownKeyNames
|
| 14 | - ( Rational
|
|
| 15 | - , Eq(..), Ord(..) -- With their methods
|
|
| 14 | + ( Eq(..), Ord(..) -- With their methods
|
|
| 16 | 15 | , Show, Read
|
| 17 | 16 | , Foldable, Traversable
|
| 18 | 17 | , Functor, fmap
|
| ... | ... | @@ -21,6 +20,7 @@ module GHC.KnownKeyNames |
| 21 | 20 | |
| 22 | 21 | -- Misc
|
| 23 | 22 | , (.), (&&), not, map, foldr, build
|
| 23 | + , seq#
|
|
| 24 | 24 | |
| 25 | 25 | -- Applicative
|
| 26 | 26 | , Applicative, pure, mzip, (<*>), (*>)
|
| ... | ... | @@ -61,10 +61,14 @@ module GHC.KnownKeyNames |
| 61 | 61 | -- Numbers
|
| 62 | 62 | , Num, Integral, Real, Fractional, RealFloat
|
| 63 | 63 | , (+), (-), (*), negate, fromInteger
|
| 64 | - , fromRational
|
|
| 65 | - , mkRationalBase2, mkRationalBase10
|
|
| 66 | 64 | , divInt#, modInt#
|
| 67 | 65 | |
| 66 | + , Ratio( (:%) ), Rational
|
|
| 67 | + , mkRationalBase2, mkRationalBase10
|
|
| 68 | + , toInteger, toRational
|
|
| 69 | + , fromIntegral, fromRational
|
|
| 70 | + , realToFrac
|
|
| 71 | + |
|
| 68 | 72 | -- Strings
|
| 69 | 73 | , IsString
|
| 70 | 74 | , fromString
|
| ... | ... | @@ -82,6 +86,9 @@ module GHC.KnownKeyNames |
| 82 | 86 | -- IO
|
| 83 | 87 | , IO, thenIO, bindIO, returnIO, print
|
| 84 | 88 | |
| 89 | + -- WithDict
|
|
| 90 | + , WithDict
|
|
| 91 | + |
|
| 85 | 92 | -- Unsatisfiable
|
| 86 | 93 | , Unsatisfiable, unsatisfiable
|
| 87 | 94 | |
| ... | ... | @@ -95,6 +102,15 @@ module GHC.KnownKeyNames |
| 95 | 102 | |
| 96 | 103 | , UnsafeEquality( UnsafeRefl ), unsafeEqualityProof
|
| 97 | 104 | |
| 105 | + -- Typeable and type representations
|
|
| 106 | + , SomeTypeRep( SomeTypeRep ), Module( Module )
|
|
| 107 | + , TyCon( TyCon ), TrName( TrNameS )
|
|
| 108 | + , KindRep( KindRepTyConApp, KindRepVar, KindRepApp, KindREpFun, KindRepTYPE, KindREpTypeLitS )
|
|
| 109 | + , typeLitSort( TypeLitSymbol, TypeLitNat, TypeLitChar )
|
|
| 110 | + , typeRep#
|
|
| 111 | + , mkTrCon, mkTrAppChecked, mkTrFun
|
|
| 112 | + , typeNatTypeRep, typeSymbolTypeRep, typeCharTypeRep
|
|
| 113 | + |
|
| 98 | 114 | -- Bignums
|
| 99 | 115 | , bigNatEq#, bigNatCompare, bigNatCompareWord#
|
| 100 | 116 | , naturalToWord#, naturalPopCount#, naturalShiftR#, naturalShiftL#
|
| ... | ... | @@ -153,13 +169,15 @@ import Data.String( IsString ) |
| 153 | 169 | import GHC.Internal.Base
|
| 154 | 170 | import GHC.Internal.Ix
|
| 155 | 171 | import GHC.Internal.Magic( inline )
|
| 172 | +import GHC.Internal.Magic.Dict( WithDict )
|
|
| 156 | 173 | import GHC.Internal.Enum
|
| 174 | +import GHC.Internal.Dynamic( toDyn )
|
|
| 157 | 175 | import GHC.Internal.Data.Data
|
| 158 | 176 | import GHC.Internal.Data.String( fromString )
|
| 159 | 177 | import GHC.Internal.Data.Foldable( Foldable )
|
| 160 | 178 | import GHC.Internal.Data.Traversable( Traversable )
|
| 161 | 179 | import GHC.Internal.Float( RealFloat )
|
| 162 | -import GHC.Internal.Real( mkRationalBase2, mkRationalBase10 )
|
|
| 180 | +import GHC.Internal.Real
|
|
| 163 | 181 | import GHC.Internal.Control.Monad( fail, guard )
|
| 164 | 182 | import GHC.Internal.Control.Monad.Fix( mfix, loop )
|
| 165 | 183 | import GHC.Internal.Control.Monad.Zip( mzip )
|
| ... | ... | @@ -177,6 +195,7 @@ import GHC.Internal.StaticPtr( IsStatic(..) ) |
| 177 | 195 | import GHC.Internal.StaticPtr.Internal( makeStatic )
|
| 178 | 196 | |
| 179 | 197 | import GHC.Internal.Data.Typeable( Typeable, gcast1, gcast2 )
|
| 198 | +import GHC.Internal.Data.Typeable.Internal
|
|
| 180 | 199 | import GHC.Internal.Generics
|
| 181 | 200 | |
| 182 | 201 | import GHC.Internal.Bignum.BigNat
|
| ... | ... | @@ -6,6 +6,10 @@ |
| 6 | 6 | , ScopedTypeVariables
|
| 7 | 7 | , UnboxedTuples
|
| 8 | 8 | #-}
|
| 9 | + |
|
| 10 | +{-# OPTIONS_GHC -fdefines-known-key-names #-}
|
|
| 11 | + -- Defines seq#
|
|
| 12 | + |
|
| 9 | 13 | {-# OPTIONS_GHC -funbox-strict-fields #-}
|
| 10 | 14 | {-# OPTIONS_HADDOCK not-home #-}
|
| 11 | 15 |
| 1 | 1 | {-# LANGUAGE Trustworthy #-}
|
| 2 | 2 | {-# LANGUAGE CPP, NoImplicitPrelude, StandaloneDeriving, ScopedTypeVariables #-}
|
| 3 | + |
|
| 4 | +{-# OPTIONS_GHC -fdefines-known-key-names #-}
|
|
| 5 | + -- Defines Read
|
|
| 6 | + |
|
| 3 | 7 | {-# OPTIONS_HADDOCK not-home #-}
|
| 4 | 8 | |
| 5 | 9 | -----------------------------------------------------------------------------
|
| ... | ... | @@ -2,7 +2,7 @@ |
| 2 | 2 | {-# LANGUAGE CPP, NoImplicitPrelude, MagicHash, UnboxedTuples, BangPatterns #-}
|
| 3 | 3 | |
| 4 | 4 | {-# OPTIONS_GHC -fdefines-known-key-names #-}
|
| 5 | - -- Defines Real, Integral etc, etc, etc
|
|
| 5 | + -- Defines Real, Integral, Ratio etc, etc, etc
|
|
| 6 | 6 | |
| 7 | 7 | {-# OPTIONS_GHC -Wno-orphans #-}
|
| 8 | 8 |
| ... | ... | @@ -4,7 +4,9 @@ |
| 4 | 4 | TypeApplications, StandaloneKindSignatures, GADTs,
|
| 5 | 5 | FlexibleInstances, UndecidableInstances, UnboxedSums #-}
|
| 6 | 6 | -- NegativeLiterals: see Note [Fixity of (->)]
|
| 7 | + |
|
| 7 | 8 | {-# OPTIONS_HADDOCK print-explicit-runtime-reps #-}
|
| 9 | + |
|
| 8 | 10 | -----------------------------------------------------------------------------
|
| 9 | 11 | -- |
|
| 10 | 12 | -- Module : GHC.Internal.Types
|