Simon Peyton Jones pushed to branch wip/spj-reinstallable-base at Glasgow Haskell Compiler / GHC

Commits:

30 changed files:

Changes:

  • compiler/GHC/Builtin/Names.hs
    ... ... @@ -222,7 +222,7 @@ basicKnownKeyTable
    222 222 
         , (mkTcOcc "Eq",           eqClassKey)
    223 223 
         , (mkVarOcc "==",          eqClassOpKey)
    224 224
    225 
    -    -- Class Num
    225 
    +    -- Numeric operations
    226 226 
         , (mkTcOcc "Num",               numClassKey)
    227 227 
         , (mkVarOcc "-",                minusClassOpKey)
    228 228 
         , (mkVarOcc "negate",           negateClassOpKey)
    ... ... @@ -230,6 +230,8 @@ basicKnownKeyTable
    230 230 
         , (mkVarOcc "fromRational",     fromRationalClassOpKey)
    231 231 
         , (mkVarOcc "mkRationalBase2",  mkRationalBase2IdKey)
    232 232 
         , (mkVarOcc "mkRationalBase10", mkRationalBase10IdKey)
    233 
    +    , (mkVarOcc "divInt#",          divIntIdKey)
    234 
    +    , (mkVarOcc "modInt#",          modIntIdKey)
    233 235
    234 236 
         -- Class Functor
    235 237 
         , (mkTcOcc "Functor",     functorClassKey)
    ... ... @@ -286,6 +288,79 @@ basicKnownKeyTable
    286 288 
         , (mkVarOcc "bindIO",   bindIOIdKey)
    287 289 
         , (mkVarOcc "returnIO", returnIOIdKey)
    288 290 
         , (mkVarOcc "print",    printIdKey)
    291 
    +
    292 
    +    -- Known-key names that have BuiltinRules in ConstantFold
    293 
    +    , (mkVarOcc "unpackFoldrCString#",      unpackCStringFoldrIdKey)
    294 
    +    , (mkVarOcc "unpackFoldrCStringUtf8#",  unpackCStringFoldrUtf8IdKey)
    295 
    +    , (mkVarOcc "unpackAppendCString#",     unpackCStringAppendIdKey)
    296 
    +    , (mkVarOcc "unpackAppendCStringUtf8#", unpackCStringAppendUtf8IdKey)
    297 
    +    , (mkVarOcc "cstringLength#",           cstringLengthIdKey)
    298 
    +
    299 
    +    , (mkVarOcc "eqString",                 eqStringIdKey)
    300 
    +    , (mkVarOcc "inline",                   inlineIdKey)
    301 
    +
    302 
    +    , (mkVarOcc "unsafeEqualityProof",      unsafeEqualityProofIdKey)
    303 
    +    , (mkTcOcc  "UnsafeEquality",           unsafeEqualityTyConKey)
    304 
    +    , (mkDataOcc "UnsafeRefl",              unsafeReflDataConKey)
    305 
    +
    306 
    +    -- Bignum operations, have BuiltinRules in ConstantFold
    307 
    +    , (mkVarOcc "bigNatEq#",                 bignatEqIdKey)
    308 
    +    , (mkVarOcc "bigNatCompare",             bignatCompareIdKey)
    309 
    +    , (mkVarOcc "bigNatCompareWord#",        bignatCompareWordIdKey)
    310 
    +    , (mkVarOcc "naturalToWord#",            naturalToWordIdKey)
    311 
    +    , (mkVarOcc "naturalPopCount#",          naturalPopCountIdKey)
    312 
    +    , (mkVarOcc "naturalShiftR#",            naturalShiftRIdKey)
    313 
    +    , (mkVarOcc "naturalShiftL#",            naturalShiftLIdKey)
    314 
    +    , (mkVarOcc "naturalAdd",                naturalAddIdKey)
    315 
    +    , (mkVarOcc "naturalSub",                naturalSubIdKey)
    316 
    +    , (mkVarOcc "naturalSubThrow",           naturalSubThrowIdKey)
    317 
    +    , (mkVarOcc "naturalSubUnsafe",          naturalSubUnsafeIdKey)
    318 
    +    , (mkVarOcc "naturalMul",                naturalMulIdKey)
    319 
    +    , (mkVarOcc "naturalQuotRem#",           naturalQuotRemIdKey)
    320 
    +    , (mkVarOcc "naturalQuot",               naturalQuotIdKey)
    321 
    +    , (mkVarOcc "naturalRem",                naturalRemIdKey)
    322 
    +    , (mkVarOcc "naturalAnd",                naturalAndIdKey)
    323 
    +    , (mkVarOcc "naturalOr",                 naturalOrIdKey)
    324 
    +    , (mkVarOcc "naturalXor",                naturalXorIdKey)
    325 
    +    , (mkVarOcc "naturalTestBit#",           naturalTestBitIdKey)
    326 
    +    , (mkVarOcc "naturalBit#",               naturalBitIdKey)
    327 
    +    , (mkVarOcc "naturalGcd",                naturalGcdIdKey)
    328 
    +    , (mkVarOcc "naturalLcm",                naturalLcmIdKey)
    329 
    +    , (mkVarOcc "integerFromNatural",        integerFromNaturalIdKey)
    330 
    +    , (mkVarOcc "integerToNaturalClamp",     integerToNaturalClampIdKey)
    331 
    +    , (mkVarOcc "integerToNaturalThrow",     integerToNaturalThrowIdKey)
    332 
    +    , (mkVarOcc "integerToNatural",          integerToNaturalIdKey)
    333 
    +    , (mkVarOcc "integerToWord#",            integerToWordIdKey)
    334 
    +    , (mkVarOcc "integerToInt#",             integerToIntIdKey)
    335 
    +    , (mkVarOcc "integerToWord64#",          integerToWord64IdKey)
    336 
    +    , (mkVarOcc "integerToInt64#",           integerToInt64IdKey)
    337 
    +    , (mkVarOcc "integerFromWord#",          integerFromWordIdKey)
    338 
    +    , (mkVarOcc "integerFromWord64#",        integerFromWord64IdKey)
    339 
    +    , (mkVarOcc "integerFromInt64#",         integerFromInt64IdKey)
    340 
    +    , (mkVarOcc "integerAdd",                integerAddIdKey)
    341 
    +    , (mkVarOcc "integerMul",                integerMulIdKey)
    342 
    +    , (mkVarOcc "integerSub",                integerSubIdKey)
    343 
    +    , (mkVarOcc "integerNegate",             integerNegateIdKey)
    344 
    +    , (mkVarOcc "integerAbs",                integerAbsIdKey)
    345 
    +    , (mkVarOcc "integerPopCount#",          integerPopCountIdKey)
    346 
    +    , (mkVarOcc "integerQuot",               integerQuotIdKey)
    347 
    +    , (mkVarOcc "integerRem",                integerRemIdKey)
    348 
    +    , (mkVarOcc "integerDiv",                integerDivIdKey)
    349 
    +    , (mkVarOcc "integerMod",                integerModIdKey)
    350 
    +    , (mkVarOcc "integerDivMod#",            integerDivModIdKey)
    351 
    +    , (mkVarOcc "integerQuotRem#",           integerQuotRemIdKey)
    352 
    +    , (mkVarOcc "integerEncodeFloat#",       integerEncodeFloatIdKey)
    353 
    +    , (mkVarOcc "integerEncodeDouble#",      integerEncodeDoubleIdKey)
    354 
    +    , (mkVarOcc "integerGcd",                integerGcdIdKey)
    355 
    +    , (mkVarOcc "integerLcm",                integerLcmIdKey)
    356 
    +    , (mkVarOcc "integerAnd",                integerAndIdKey)
    357 
    +    , (mkVarOcc "integerOr",                 integerOrIdKey)
    358 
    +    , (mkVarOcc "integerXor",                integerXorIdKey)
    359 
    +    , (mkVarOcc "integerComplement",         integerComplementIdKey)
    360 
    +    , (mkVarOcc "integerBit#",               integerBitIdKey)
    361 
    +    , (mkVarOcc "integerTestBit#",           integerTestBitIdKey)
    362 
    +    , (mkVarOcc "integerShiftL#",            integerShiftLIdKey)
    363 
    +    , (mkVarOcc "integerShiftR#",            integerShiftRIdKey)
    289 364 
         ]
    290 365
    291 366 
     basicKnownKeyNames :: [Name]  -- See Note [Known-key names]
    ... ... @@ -353,9 +428,6 @@ basicKnownKeyNames
    353 428 
             toIntegerName, toRationalName,
    354 429 
             fromIntegralName, realToFracName,
    355 430
    356 
    -        -- Int# stuff
    357 
    -        divIntName, modIntName,
    358 
    -
    359 431 
             -- String stuff
    360 432 
             fromStringName,
    361 433
    ... ... @@ -370,9 +442,6 @@ basicKnownKeyNames
    370 442 
             bindMName, thenMName,
    371 443 
             returnMName,
    372 444
    373 
    -        -- Ix stuff
    374 
    -        ixClassName,
    375 
    -
    376 445 
             -- Read stuff
    377 446 
             readClassName,
    378 447
    ... ... @@ -384,9 +453,6 @@ basicKnownKeyNames
    384 453
    385 454 
             -- Strings and lists
    386 455 
             unpackCStringName, unpackCStringUtf8Name,
    387 
    -        unpackCStringAppendName, unpackCStringAppendUtf8Name,
    388 
    -        unpackCStringFoldrName, unpackCStringFoldrUtf8Name,
    389 
    -        cstringLengthName,
    390 456
    391 457 
             -- Non-empty lists
    392 458 
             nonEmptyTyConName,
    ... ... @@ -401,71 +467,12 @@ basicKnownKeyNames
    401 467 
             jsvalTyConName,
    402 468
    403 469 
             -- Others
    404 
    -        otherwiseIdName, inlineIdName,
    405 
    -        eqStringName, assertName,
    470 
    +        otherwiseIdName,
    471 
    +        assertName,
    406 472 
             assertErrorName, traceName,
    407 473 
             printName,
    408 474 
             dollarName,
    409 475
    410 
    -        -- ghc-bignum
    411 
    -        integerFromNaturalName,
    412 
    -        integerToNaturalClampName,
    413 
    -        integerToNaturalThrowName,
    414 
    -        integerToNaturalName,
    415 
    -        integerToWordName,
    416 
    -        integerToIntName,
    417 
    -        integerToWord64Name,
    418 
    -        integerToInt64Name,
    419 
    -        integerFromWordName,
    420 
    -        integerFromWord64Name,
    421 
    -        integerFromInt64Name,
    422 
    -        integerAddName,
    423 
    -        integerMulName,
    424 
    -        integerSubName,
    425 
    -        integerNegateName,
    426 
    -        integerAbsName,
    427 
    -        integerPopCountName,
    428 
    -        integerQuotName,
    429 
    -        integerRemName,
    430 
    -        integerDivName,
    431 
    -        integerModName,
    432 
    -        integerDivModName,
    433 
    -        integerQuotRemName,
    434 
    -        integerEncodeFloatName,
    435 
    -        integerEncodeDoubleName,
    436 
    -        integerGcdName,
    437 
    -        integerLcmName,
    438 
    -        integerAndName,
    439 
    -        integerOrName,
    440 
    -        integerXorName,
    441 
    -        integerComplementName,
    442 
    -        integerBitName,
    443 
    -        integerTestBitName,
    444 
    -        integerShiftLName,
    445 
    -        integerShiftRName,
    446 
    -
    447 
    -        naturalToWordName,
    448 
    -        naturalPopCountName,
    449 
    -        naturalShiftRName,
    450 
    -        naturalShiftLName,
    451 
    -        naturalAddName,
    452 
    -        naturalSubName,
    453 
    -        naturalSubThrowName,
    454 
    -        naturalSubUnsafeName,
    455 
    -        naturalMulName,
    456 
    -        naturalQuotRemName,
    457 
    -        naturalQuotName,
    458 
    -        naturalRemName,
    459 
    -        naturalAndName,
    460 
    -        naturalOrName,
    461 
    -        naturalXorName,
    462 
    -        naturalTestBitName,
    463 
    -        naturalBitName,
    464 
    -        naturalGcdName,
    465 
    -        naturalLcmName,
    466 
    -
    467 
    -        bignatEqName,
    468 
    -
    469 476 
             -- Float/Double
    470 477 
             integerToFloatName,
    471 478 
             integerToDoubleName,
    ... ... @@ -535,9 +542,6 @@ basicKnownKeyNames
    535 542 
             , unsatisfiableIdName
    536 543
    537 544 
             -- Unsafe coercion proofs
    538 
    -        , unsafeEqualityProofName
    539 
    -        , unsafeEqualityTyConName
    540 
    -        , unsafeReflDataConName
    541 545 
             , unsafeCoercePrimName
    542 546
    543 547 
             , unsafeUnpackJSStringUtf8ShShName
    ... ... @@ -1020,31 +1024,10 @@ metaDataDataConName = dcQual gHC_INTERNAL_GENERICS (fsLit "MetaData") metaData
    1020 1024 
     metaConsDataConName  = dcQual gHC_INTERNAL_GENERICS (fsLit "MetaCons")  metaConsDataConKey
    1021 1025 
     metaSelDataConName   = dcQual gHC_INTERNAL_GENERICS (fsLit "MetaSel")   metaSelDataConKey
    1022 1026
    1023 
    --- Primitive Int
    1024 
    -divIntName, modIntName :: Name
    1025 
    -divIntName = varQual gHC_CLASSES (fsLit "divInt#") divIntIdKey
    1026 
    -modIntName = varQual gHC_CLASSES (fsLit "modInt#") modIntIdKey
    1027 
    -
    1028 1027 
     -- Base strings Strings
    1029 
    -unpackCStringName, unpackCStringFoldrName,
    1030 
    -    unpackCStringUtf8Name, unpackCStringFoldrUtf8Name,
    1031 
    -    unpackCStringAppendName, unpackCStringAppendUtf8Name,
    1032 
    -    eqStringName, cstringLengthName :: Name
    1033 
    -cstringLengthName       = varQual gHC_CSTRING (fsLit "cstringLength#") cstringLengthIdKey
    1034 
    -eqStringName            = varQual gHC_INTERNAL_BASE (fsLit "eqString")  eqStringIdKey
    1035 
    -
    1028 
    +unpackCStringName, unpackCStringUtf8Name :: Name
    1036 1029 
     unpackCStringName       = varQual gHC_CSTRING (fsLit "unpackCString#") unpackCStringIdKey
    1037 
    -unpackCStringAppendName = varQual gHC_CSTRING (fsLit "unpackAppendCString#") unpackCStringAppendIdKey
    1038 
    -unpackCStringFoldrName  = varQual gHC_CSTRING (fsLit "unpackFoldrCString#") unpackCStringFoldrIdKey
    1039 
    -
    1040 1030 
     unpackCStringUtf8Name       = varQual gHC_CSTRING (fsLit "unpackCStringUtf8#") unpackCStringUtf8IdKey
    1041 
    -unpackCStringAppendUtf8Name = varQual gHC_CSTRING (fsLit "unpackAppendCStringUtf8#") unpackCStringAppendUtf8IdKey
    1042 
    -unpackCStringFoldrUtf8Name  = varQual gHC_CSTRING (fsLit "unpackFoldrCStringUtf8#") unpackCStringFoldrUtf8IdKey
    1043 
    -
    1044 
    -
    1045 
    --- The 'inline' function
    1046 
    -inlineIdName :: Name
    1047 
    -inlineIdName            = varQual gHC_MAGIC (fsLit "inline") inlineIdKey
    1048 1031
    1049 1032 
     -- Base classes (Eq, Ord, Functor)
    1050 1033 
     fmapName, geName, functorClassName :: Name
    ... ... @@ -1108,134 +1091,11 @@ fromStringName = varQual gHC_INTERNAL_DATA_STRING (fsLit "fromString") fromSt
    1108 1091 
     negateName :: Name
    1109 1092 
     negateName        = varQual gHC_INTERNAL_NUM (fsLit "negate")      negateClassOpKey
    1110 1093
    1111 
    ----------------------------------
    1112 
    --- ghc-bignum
    1113 
    ----------------------------------
    1114 
    -integerFromNaturalName
    1115 
    -   , integerToNaturalClampName
    1116 
    -   , integerToNaturalThrowName
    1117 
    -   , integerToNaturalName
    1118 
    -   , integerToWordName
    1119 
    -   , integerToIntName
    1120 
    -   , integerToWord64Name
    1121 
    -   , integerToInt64Name
    1122 
    -   , integerFromWordName
    1123 
    -   , integerFromWord64Name
    1124 
    -   , integerFromInt64Name
    1125 
    -   , integerAddName
    1126 
    -   , integerMulName
    1127 
    -   , integerSubName
    1128 
    -   , integerNegateName
    1129 
    -   , integerAbsName
    1130 
    -   , integerPopCountName
    1131 
    -   , integerQuotName
    1132 
    -   , integerRemName
    1133 
    -   , integerDivName
    1134 
    -   , integerModName
    1135 
    -   , integerDivModName
    1136 
    -   , integerQuotRemName
    1137 
    -   , integerEncodeFloatName
    1138 
    -   , integerEncodeDoubleName
    1139 
    -   , integerGcdName
    1140 
    -   , integerLcmName
    1141 
    -   , integerAndName
    1142 
    -   , integerOrName
    1143 
    -   , integerXorName
    1144 
    -   , integerComplementName
    1145 
    -   , integerBitName
    1146 
    -   , integerTestBitName
    1147 
    -   , integerShiftLName
    1148 
    -   , integerShiftRName
    1149 
    -   , naturalToWordName
    1150 
    -   , naturalPopCountName
    1151 
    -   , naturalShiftRName
    1152 
    -   , naturalShiftLName
    1153 
    -   , naturalAddName
    1154 
    -   , naturalSubName
    1155 
    -   , naturalSubThrowName
    1156 
    -   , naturalSubUnsafeName
    1157 
    -   , naturalMulName
    1158 
    -   , naturalQuotRemName
    1159 
    -   , naturalQuotName
    1160 
    -   , naturalRemName
    1161 
    -   , naturalAndName
    1162 
    -   , naturalOrName
    1163 
    -   , naturalXorName
    1164 
    -   , naturalTestBitName
    1165 
    -   , naturalBitName
    1166 
    -   , naturalGcdName
    1167 
    -   , naturalLcmName
    1168 
    -   , bignatEqName
    1169 
    -   , bignatCompareName
    1170 
    -   , bignatCompareWordName
    1171 
    -   :: Name
    1172 
    -
    1173 1094 
     bnbVarQual, bnnVarQual, bniVarQual :: String -> Unique -> Name
    1174 1095 
     bnbVarQual str key = varQual gHC_INTERNAL_NUM_BIGNAT  (fsLit str) key
    1175 1096 
     bnnVarQual str key = varQual gHC_INTERNAL_NUM_NATURAL (fsLit str) key
    1176 1097 
     bniVarQual str key = varQual gHC_INTERNAL_NUM_INTEGER (fsLit str) key
    1177 1098
    1178 
    --- Types and DataCons
    1179 
    -bignatEqName              = bnbVarQual "bigNatEq#"                 bignatEqIdKey
    1180 
    -bignatCompareName         = bnbVarQual "bigNatCompare"             bignatCompareIdKey
    1181 
    -bignatCompareWordName     = bnbVarQual "bigNatCompareWord#"        bignatCompareWordIdKey
    1182 
    -
    1183 
    -naturalToWordName         = bnnVarQual "naturalToWord#"            naturalToWordIdKey
    1184 
    -naturalPopCountName       = bnnVarQual "naturalPopCount#"          naturalPopCountIdKey
    1185 
    -naturalShiftRName         = bnnVarQual "naturalShiftR#"            naturalShiftRIdKey
    1186 
    -naturalShiftLName         = bnnVarQual "naturalShiftL#"            naturalShiftLIdKey
    1187 
    -naturalAddName            = bnnVarQual "naturalAdd"                naturalAddIdKey
    1188 
    -naturalSubName            = bnnVarQual "naturalSub"                naturalSubIdKey
    1189 
    -naturalSubThrowName       = bnnVarQual "naturalSubThrow"           naturalSubThrowIdKey
    1190 
    -naturalSubUnsafeName      = bnnVarQual "naturalSubUnsafe"          naturalSubUnsafeIdKey
    1191 
    -naturalMulName            = bnnVarQual "naturalMul"                naturalMulIdKey
    1192 
    -naturalQuotRemName        = bnnVarQual "naturalQuotRem#"           naturalQuotRemIdKey
    1193 
    -naturalQuotName           = bnnVarQual "naturalQuot"               naturalQuotIdKey
    1194 
    -naturalRemName            = bnnVarQual "naturalRem"                naturalRemIdKey
    1195 
    -naturalAndName            = bnnVarQual "naturalAnd"                naturalAndIdKey
    1196 
    -naturalOrName             = bnnVarQual "naturalOr"                 naturalOrIdKey
    1197 
    -naturalXorName            = bnnVarQual "naturalXor"                naturalXorIdKey
    1198 
    -naturalTestBitName        = bnnVarQual "naturalTestBit#"           naturalTestBitIdKey
    1199 
    -naturalBitName            = bnnVarQual "naturalBit#"               naturalBitIdKey
    1200 
    -naturalGcdName            = bnnVarQual "naturalGcd"                naturalGcdIdKey
    1201 
    -naturalLcmName            = bnnVarQual "naturalLcm"                naturalLcmIdKey
    1202 
    -
    1203 
    -integerFromNaturalName    = bniVarQual "integerFromNatural"        integerFromNaturalIdKey
    1204 
    -integerToNaturalClampName = bniVarQual "integerToNaturalClamp"     integerToNaturalClampIdKey
    1205 
    -integerToNaturalThrowName = bniVarQual "integerToNaturalThrow"     integerToNaturalThrowIdKey
    1206 
    -integerToNaturalName      = bniVarQual "integerToNatural"          integerToNaturalIdKey
    1207 
    -integerToWordName         = bniVarQual "integerToWord#"            integerToWordIdKey
    1208 
    -integerToIntName          = bniVarQual "integerToInt#"             integerToIntIdKey
    1209 
    -integerToWord64Name       = bniVarQual "integerToWord64#"          integerToWord64IdKey
    1210 
    -integerToInt64Name        = bniVarQual "integerToInt64#"           integerToInt64IdKey
    1211 
    -integerFromWordName       = bniVarQual "integerFromWord#"          integerFromWordIdKey
    1212 
    -integerFromWord64Name     = bniVarQual "integerFromWord64#"        integerFromWord64IdKey
    1213 
    -integerFromInt64Name      = bniVarQual "integerFromInt64#"         integerFromInt64IdKey
    1214 
    -integerAddName            = bniVarQual "integerAdd"                integerAddIdKey
    1215 
    -integerMulName            = bniVarQual "integerMul"                integerMulIdKey
    1216 
    -integerSubName            = bniVarQual "integerSub"                integerSubIdKey
    1217 
    -integerNegateName         = bniVarQual "integerNegate"             integerNegateIdKey
    1218 
    -integerAbsName            = bniVarQual "integerAbs"                integerAbsIdKey
    1219 
    -integerPopCountName       = bniVarQual "integerPopCount#"          integerPopCountIdKey
    1220 
    -integerQuotName           = bniVarQual "integerQuot"               integerQuotIdKey
    1221 
    -integerRemName            = bniVarQual "integerRem"                integerRemIdKey
    1222 
    -integerDivName            = bniVarQual "integerDiv"                integerDivIdKey
    1223 
    -integerModName            = bniVarQual "integerMod"                integerModIdKey
    1224 
    -integerDivModName         = bniVarQual "integerDivMod#"            integerDivModIdKey
    1225 
    -integerQuotRemName        = bniVarQual "integerQuotRem#"           integerQuotRemIdKey
    1226 
    -integerEncodeFloatName    = bniVarQual "integerEncodeFloat#"       integerEncodeFloatIdKey
    1227 
    -integerEncodeDoubleName   = bniVarQual "integerEncodeDouble#"      integerEncodeDoubleIdKey
    1228 
    -integerGcdName            = bniVarQual "integerGcd"                integerGcdIdKey
    1229 
    -integerLcmName            = bniVarQual "integerLcm"                integerLcmIdKey
    1230 
    -integerAndName            = bniVarQual "integerAnd"                integerAndIdKey
    1231 
    -integerOrName             = bniVarQual "integerOr"                 integerOrIdKey
    1232 
    -integerXorName            = bniVarQual "integerXor"                integerXorIdKey
    1233 
    -integerComplementName     = bniVarQual "integerComplement"         integerComplementIdKey
    1234 
    -integerBitName            = bniVarQual "integerBit#"               integerBitIdKey
    1235 
    -integerTestBitName        = bniVarQual "integerTestBit#"           integerTestBitIdKey
    1236 
    -integerShiftLName         = bniVarQual "integerShiftL#"            integerShiftLIdKey
    1237 
    -integerShiftRName         = bniVarQual "integerShiftR#"            integerShiftRIdKey
    1238 
    -
    1239 1099
    1240 1100
    1241 1101 
     ---------------------------------
    ... ... @@ -1262,10 +1122,6 @@ integerToDoubleName = varQual gHC_INTERNAL_FLOAT (fsLit "integerToDouble#") int
    1262 1122 
     rationalToFloatName  = varQual gHC_INTERNAL_FLOAT (fsLit "rationalToFloat#") rationalToFloatIdKey
    1263 1123 
     rationalToDoubleName = varQual gHC_INTERNAL_FLOAT (fsLit "rationalToDouble#") rationalToDoubleIdKey
    1264 1124
    1265 
    --- Class Ix
    1266 
    -ixClassName :: Name
    1267 
    -ixClassName = clsQual gHC_INTERNAL_IX (fsLit "Ix") ixClassKey
    1268 
    -
    1269 1125 
     -- Typeable representation types
    1270 1126 
     trModuleTyConName
    1271 1127 
       , trModuleDataConName
    ... ... @@ -1384,11 +1240,7 @@ unsatisfiableIdName =
    1384 1240 
       varQual gHC_INTERNAL_TYPEERROR (fsLit "unsatisfiable") unsatisfiableIdNameKey
    1385 1241
    1386 1242 
     -- Unsafe coercion proofs
    1387 
    -unsafeEqualityProofName, unsafeEqualityTyConName, unsafeCoercePrimName,
    1388 
    -  unsafeReflDataConName :: Name
    1389 
    -unsafeEqualityProofName = varQual gHC_INTERNAL_UNSAFE_COERCE (fsLit "unsafeEqualityProof") unsafeEqualityProofIdKey
    1390 
    -unsafeEqualityTyConName = tcQual gHC_INTERNAL_UNSAFE_COERCE (fsLit "UnsafeEquality") unsafeEqualityTyConKey
    1391 
    -unsafeReflDataConName   = dcQual gHC_INTERNAL_UNSAFE_COERCE (fsLit "UnsafeRefl")     unsafeReflDataConKey
    1243 
    +unsafeCoercePrimName:: Name
    1392 1244 
     unsafeCoercePrimName    = varQual gHC_INTERNAL_UNSAFE_COERCE (fsLit "unsafeCoerce#") unsafeCoercePrimIdKey
    1393 1245
    1394 1246 
     -- Dynamic

  • compiler/GHC/Core.hs
    ... ... @@ -88,7 +88,7 @@ module GHC.Core (
    88 88 
             RuleName, RuleFun, IdUnfoldingFun, InScopeEnv(..), RuleOpts,
    89 89
    90 90 
             -- ** Operations on 'CoreRule's
    91 
    -        ruleArity, ruleName, ruleIdName, ruleActivation,
    91 
    +        ruleArity, ruleName, ruleKey, ruleActivation,
    92 92 
             setRuleIdName, ruleModule,
    93 93 
             isBuiltinRule, isLocalRule, isAutoRule,
    94 94 
         ) where
    ... ... @@ -96,19 +96,21 @@ module GHC.Core (
    96 96 
     import GHC.Prelude
    97 97 
     import GHC.Platform
    98 98
    99 
    -import GHC.Types.Var.Env( InScopeSet )
    100 
    -import GHC.Types.Var
    101 99 
     import GHC.Core.Type
    102 100 
     import GHC.Core.Coercion
    103 101 
     import GHC.Core.Rules.Config ( RuleOpts )
    102 
    +import GHC.Core.DataCon
    103 
    +import GHC.Unit.Module
    104 
    +
    104 105 
     import GHC.Types.InlinePragma
    105 106 
     import GHC.Types.Name
    106 107 
     import GHC.Types.Name.Set
    108 
    +import GHC.Types.Var.Env( InScopeSet )
    109 
    +import GHC.Types.Var
    107 110 
     import GHC.Types.Literal
    108 111 
     import GHC.Types.Tickish
    109 
    -import GHC.Core.DataCon
    110 
    -import GHC.Unit.Module
    111 112 
     import GHC.Types.Basic
    113 
    +import GHC.Types.Unique
    112 114 
     import GHC.Types.Unique.Set
    113 115
    114 116 
     import GHC.Utils.Binary
    ... ... @@ -1508,14 +1510,17 @@ data CoreRule
    1508 1510 
       -- A built-in rule is always visible (there is no such thing as
    1509 1511 
       -- an orphan built-in rule.)
    1510 1512 
       | BuiltinRule {
    1511 
    -        ru_name  :: RuleName,   -- ^ As above
    1512 
    -        ru_fn    :: Name,       -- ^ As above
    1513 
    +        ru_name  :: RuleName,            -- ^ As above
    1514 
    +        ru_key   :: KnownKeyNameKey,     -- ^ Identifies the function
    1515 
    +                                         -- Not its Name because BuiltInRules are constants
    1516 
    +                                         -- and GHC doesn't know the defining module
    1517 
    +                                         -- See Note [Overview of known-key names]
    1513 1518 
             ru_nargs :: Int,        -- ^ Number of arguments that 'ru_try' consumes,
    1514 1519 
                                     -- if it fires, including type arguments
    1515 1520 
             ru_try   :: RuleFun
    1516 1521 
                     -- ^ This function does the rewrite.  It given too many
    1517 1522 
                     -- arguments, it simply discards them; the returned 'CoreExpr'
    1518 
    -                -- is just the rewrite of 'ru_fn' applied to the first 'ru_nargs' args
    1523 
    +                -- is just the rewrite of function applied to the first 'ru_nargs' args
    1519 1524 
         }
    1520 1525 
                     -- See Note [Extra args in the target] in GHC.Core.Rules
    1521 1526
    ... ... @@ -1538,7 +1543,7 @@ isAutoRule :: CoreRule -> Bool
    1538 1543 
     isAutoRule (BuiltinRule {}) = False
    1539 1544 
     isAutoRule (Rule { ru_auto = is_auto }) = is_auto
    1540 1545
    1541 
    --- | The number of arguments the 'ru_fn' must be applied
    1546 
    +-- | The number of arguments the function must be applied
    1542 1547 
     -- to before the rule can match on it
    1543 1548 
     ruleArity :: CoreRule -> FullArgCount
    1544 1549 
     ruleArity (BuiltinRule {ru_nargs = n}) = n
    ... ... @@ -1555,17 +1560,21 @@ ruleActivation :: CoreRule -> ActivationGhc
    1555 1560 
     ruleActivation (BuiltinRule { })       = AlwaysActive
    1556 1561 
     ruleActivation (Rule { ru_act = act }) = act
    1557 1562
    1558 
    --- | The 'Name' of the 'GHC.Types.Id.Id' at the head of the rule left hand side
    1559 
    -ruleIdName :: CoreRule -> Name
    1560 
    -ruleIdName = ru_fn
    1561 
    -
    1562 1563 
     isLocalRule :: CoreRule -> Bool
    1563 1564 
     isLocalRule (BuiltinRule {})               = False
    1564 1565 
     isLocalRule (Rule { ru_local = is_local }) = is_local
    1565 1566
    1567 
    +-- | The 'Unique' of the function at the head of the rule left hand side
    1568 
    +ruleKey :: CoreRule -> Unique
    1569 
    +ruleKey (Rule { ru_fn = name })        = nameUnique name
    1570 
    +ruleKey (BuiltinRule { ru_key = key }) = key
    1571 
    +
    1566 1572 
     -- | Set the 'Name' of the 'GHC.Types.Id.Id' at the head of the rule left hand side
    1567 1573 
     setRuleIdName :: Name -> CoreRule -> CoreRule
    1568 
    -setRuleIdName nm ru = ru { ru_fn = nm }
    1574 
    +setRuleIdName nm rule
    1575 
    +  = case rule of
    1576 
    +      Rule {}        -> rule { ru_fn = nm }
    1577 
    +      BuiltinRule {} -> rule { ru_key = nameUnique nm }
    1569 1578
    1570 1579 
     {-
    1571 1580 
     ************************************************************************

  • compiler/GHC/Core/DataCon.hs
    ... ... @@ -1810,7 +1810,7 @@ dataConCannotMatch :: [Type] -> DataCon -> Bool
    1810 1810 
     dataConCannotMatch tys con
    1811 1811 
       -- See (U6) in Note [Implementing unsafeCoerce]
    1812 1812 
       -- in base:Unsafe.Coerce
    1813 
    -  | dataConName con == unsafeReflDataConName
    1813 
    +  | con `hasKnownKey` unsafeReflDataConKey
    1814 1814 
                           = False
    1815 1815 
       | null inst_theta   = False   -- Common
    1816 1816 
       | all isTyVarTy tys = False   -- Also common

  • compiler/GHC/Core/Opt/ConstantFold.hs
    ... ... @@ -37,7 +37,7 @@ import GHC.Types.Literal
    37 37 
     import GHC.Types.Literal.Floating
    38 38 
     import GHC.Types.Name.Occurrence ( occNameFS )
    39 39 
     import GHC.Types.Tickish
    40 
    -import GHC.Types.Name ( Name, nameOccName )
    40 
    +import GHC.Types.Name ( Name, KnownKeyNameKey, nameUnique, nameOccName )
    41 41 
     import GHC.Types.Basic
    42 42
    43 43 
     import GHC.Core
    ... ... @@ -870,7 +870,10 @@ primOpRules nm = \case
    870 870
    871 871 
     -- useful shorthands
    872 872 
     mkPrimOpRule :: Name -> Int -> [RuleM CoreExpr] -> Maybe CoreRule
    873 
    -mkPrimOpRule nm arity rules = Just $ mkBasicRule nm arity (msum rules)
    873 
    +mkPrimOpRule nm arity rules
    874 
    +  = Just $ mkBasicRule (occNameFS (nameOccName nm))
    875 
    +                       (nameUnique nm)
    876 
    +                       arity (msum rules)
    874 877
    875 878 
     mkRelOpRule :: Name -> (forall a . Ord a => a -> a -> Bool)
    876 879 
                 -> [RuleM CoreExpr] -> Maybe CoreRule
    ... ... @@ -1679,13 +1682,13 @@ but that is only a historical accident.
    1679 1682 
     ************************************************************************
    1680 1683 
     -}
    1681 1684
    1682 
    -mkBasicRule :: Name -> Int -> RuleM CoreExpr -> CoreRule
    1685 
    +mkBasicRule :: RuleName -> KnownKeyNameKey -> Int -> RuleM CoreExpr -> CoreRule
    1683 1686 
     -- Gives the Rule the same name as the primop itself
    1684 
    -mkBasicRule op_name n_args rm
    1685 
    -  = BuiltinRule { ru_name  = occNameFS (nameOccName op_name),
    1686 
    -                  ru_fn    = op_name,
    1687 
    -                  ru_nargs = n_args,
    1688 
    -                  ru_try   = runRuleM rm }
    1687 
    +mkBasicRule rule_nm op_key n_args rm
    1688 
    +  = BuiltinRule { ru_name  = rule_nm
    1689 
    +                , ru_key   = op_key
    1690 
    +                , ru_nargs = n_args
    1691 
    +                , ru_try   = runRuleM rm }
    1689 1692
    1690 1693 
     newtype RuleM r = RuleM
    1691 1694 
       { runRuleM :: RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe r }
    ... ... @@ -2060,6 +2063,30 @@ dataToTagRule = a `mplus` b
    2060 2063 
           return $ wrapFloats floats (mkIntVal platform (toInteger (dataConTagZ dc)))
    2061 2064
    2062 2065
    2066 
    +{- *********************************************************************
    2067 
    +*                                                                      *
    2068 
    +             div and mod
    2069 
    +*                                                                      *
    2070 
    +********************************************************************* -}
    2071 
    +
    2072 
    +divIntRule :: RuleM CoreExpr
    2073 
    +divIntRule = msum [ nonZeroLit 1 >> binaryLit (intOp2 div)
    2074 
    +                  , leftZero
    2075 
    +                  , do { [arg, Lit (LitNumber LitNumInt d)] <- getArgs
    2076 
    +                       ; Just n <- return $ exactLog2 d
    2077 
    +                       ; platform <- getPlatform
    2078 
    +                       ; return $ Var (primOpId IntSraOp)
    2079 
    +                                  `App` arg `App` mkIntVal platform n } ]
    2080 
    +
    2081 
    +modIntRule :: RuleM CoreExpr
    2082 
    +modIntRule = msum [ nonZeroLit 1 >> binaryLit (intOp2 mod)
    2083 
    +                  , leftZero
    2084 
    +                  , do { [arg, Lit (LitNumber LitNumInt d)] <- getArgs
    2085 
    +                       ; Just _ <- return $ exactLog2 d
    2086 
    +                       ; platform <- getPlatform
    2087 
    +                       ; return $ Var (primOpId IntAndOp)
    2088 
    +                                  `App` arg `App` mkIntVal platform (d-1) } ]
    2089 
    +
    2063 2090 
     {- *********************************************************************
    2064 2091 
     *                                                                      *
    2065 2092 
                  unsafeEqualityProof
    ... ... @@ -2132,55 +2159,47 @@ is fine.
    2132 2159 
     builtinRules :: [CoreRule]
    2133 2160 
     -- Rules for non-primops that can't be expressed using a RULE pragma
    2134 2161 
     builtinRules
    2135 
    -  = [BuiltinRule { ru_name = fsLit "CStringFoldrLit",
    2136 
    -                   ru_fn = unpackCStringFoldrName,
    2137 
    -                   ru_nargs = 4, ru_try = match_cstring_foldr_lit_C },
    2138 
    -     BuiltinRule { ru_name = fsLit "CStringFoldrLitUtf8",
    2139 
    -                   ru_fn = unpackCStringFoldrUtf8Name,
    2140 
    -                   ru_nargs = 4, ru_try = match_cstring_foldr_lit_utf8 },
    2141 
    -     BuiltinRule { ru_name = fsLit "CStringAppendLit",
    2142 
    -                   ru_fn = unpackCStringAppendName,
    2143 
    -                   ru_nargs = 2, ru_try = match_cstring_append_lit_C },
    2144 
    -     BuiltinRule { ru_name = fsLit "CStringAppendLitUtf8",
    2145 
    -                   ru_fn = unpackCStringAppendUtf8Name,
    2146 
    -                   ru_nargs = 2, ru_try = match_cstring_append_lit_utf8 },
    2147 
    -     BuiltinRule { ru_name = fsLit "EqString", ru_fn = eqStringName,
    2148 
    -                   ru_nargs = 2, ru_try = match_eq_string },
    2149 
    -     BuiltinRule { ru_name = fsLit "CStringLength", ru_fn = cstringLengthName,
    2150 
    -                   ru_nargs = 1, ru_try = match_cstring_length },
    2151 
    -     BuiltinRule { ru_name = fsLit "Inline", ru_fn = inlineIdName,
    2152 
    -                   ru_nargs = 2, ru_try = \_ _ _ -> match_inline },
    2153 
    -
    2154 
    -     mkBasicRule unsafeEqualityProofName 3 unsafeEqualityProofRule,
    2155 
    -
    2156 
    -     mkBasicRule divIntName 2 $ msum
    2157 
    -        [ nonZeroLit 1 >> binaryLit (intOp2 div)
    2158 
    -        , leftZero
    2159 
    -        , do
    2160 
    -          [arg, Lit (LitNumber LitNumInt d)] <- getArgs
    2161 
    -          Just n <- return $ exactLog2 d
    2162 
    -          platform <- getPlatform
    2163 
    -          return $ Var (primOpId IntSraOp) `App` arg `App` mkIntVal platform n
    2164 
    -        ],
    2165 
    -
    2166 
    -     mkBasicRule modIntName 2 $ msum
    2167 
    -        [ nonZeroLit 1 >> binaryLit (intOp2 mod)
    2168 
    -        , leftZero
    2169 
    -        , do
    2170 
    -          [arg, Lit (LitNumber LitNumInt d)] <- getArgs
    2171 
    -          Just _ <- return $ exactLog2 d
    2172 
    -          platform <- getPlatform
    2173 
    -          return $ Var (primOpId IntAndOp)
    2174 
    -            `App` arg `App` mkIntVal platform (d - 1)
    2175 
    -        ]
    2176 
    -     ]
    2162 
    +  = [ BuiltinRule { ru_name = fsLit "CStringFoldrLit"
    2163 
    +                  , ru_key = unpackCStringFoldrIdKey
    2164 
    +                  , ru_nargs = 4, ru_try = match_cstring_foldr_lit_C }
    2165 
    +    , BuiltinRule { ru_name = fsLit "CStringFoldrLitUtf8"
    2166 
    +                  , ru_key = unpackCStringFoldrUtf8IdKey
    2167 
    +                  ,ru_nargs = 4, ru_try = match_cstring_foldr_lit_utf8 }
    2168 
    +    , BuiltinRule { ru_name = fsLit "CStringAppendLit"
    2169 
    +                  , ru_key = unpackCStringAppendIdKey
    2170 
    +                  , ru_nargs = 2, ru_try = match_cstring_append_lit_C }
    2171 
    +    , BuiltinRule { ru_name = fsLit "CStringAppendLitUtf8"
    2172 
    +                  , ru_key = unpackCStringAppendUtf8IdKey
    2173 
    +                  , ru_nargs = 2, ru_try = match_cstring_append_lit_utf8 }
    2174 
    +    , BuiltinRule { ru_name = fsLit "CStringLength"
    2175 
    +                  , ru_key = cstringLengthIdKey
    2176 
    +                  , ru_nargs = 1, ru_try = match_cstring_length }
    2177 
    +
    2178 
    +    , BuiltinRule { ru_name = fsLit "EqString"
    2179 
    +                  , ru_key = eqStringIdKey
    2180 
    +                  , ru_nargs = 2, ru_try = match_eq_string }
    2181 
    +
    2182 
    +    , BuiltinRule { ru_name = fsLit "Inline"
    2183 
    +                  , ru_key = inlineIdKey
    2184 
    +                  , ru_nargs = 2, ru_try = \_ _ _ -> match_inline }
    2185 
    +
    2186 
    +    , BuiltinRule { ru_name = fsLit "unsafeEqualityProof"
    2187 
    +                  , ru_key = unsafeEqualityProofIdKey
    2188 
    +                  , ru_nargs = 3, ru_try = runRuleM unsafeEqualityProofRule }
    2189 
    +
    2190 
    +    , BuiltinRule { ru_name = fsLit "divInt#"
    2191 
    +                  , ru_key = divIntIdKey
    2192 
    +                  , ru_nargs = 2, ru_try = runRuleM divIntRule }
    2193 
    +    , BuiltinRule { ru_name = fsLit "modInt#"
    2194 
    +                  , ru_key = modIntIdKey
    2195 
    +                  , ru_nargs = 2, ru_try = runRuleM modIntRule }
    2196 
    +    ]
    2177 2197 
      ++ builtinBignumRules
    2178 2198 
     {-# NOINLINE builtinRules #-}
    2179 
    --- there is no benefit to inlining these yet, despite this, GHC produces
    2199 
    +-- There is no benefit to inlining these yet, despite this, GHC produces
    2180 2200 
     -- unfoldings for this regardless since the floated list entries look small.
    2181 2201
    2182 2202
    2183 
    -
    2184 2203 
     {- Note [Built-in bignum rules]
    2185 2204 
     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    2186 2205 
     We have some built-in rules for operations on bignum types (Integer, Natural,
    ... ... @@ -2219,54 +2238,54 @@ RuleOpts.
    2219 2238 
     builtinBignumRules :: [CoreRule]
    2220 2239 
     builtinBignumRules =
    2221 2240 
       [ -- conversions
    2222 
    -    lit_to_integer "Word# -> Integer"   integerFromWordName
    2223 
    -  , lit_to_integer "Int64# -> Integer"  integerFromInt64Name
    2224 
    -  , lit_to_integer "Word64# -> Integer" integerFromWord64Name
    2225 
    -  , lit_to_integer "Natural -> Integer" integerFromNaturalName
    2241 
    +    lit_to_integer "Word# -> Integer"   integerFromWordIdKey
    2242 
    +  , lit_to_integer "Int64# -> Integer"  integerFromInt64IdKey
    2243 
    +  , lit_to_integer "Word64# -> Integer" integerFromWord64IdKey
    2244 
    +  , lit_to_integer "Natural -> Integer" integerFromNaturalIdKey
    2226 2245
    2227 
    -  , integer_to_lit "Integer -> Word# (wrap)"   integerToWordName   mkWordLitWrap
    2228 
    -  , integer_to_lit "Integer -> Int# (wrap)"    integerToIntName    mkIntLitWrap
    2229 
    -  , integer_to_lit "Integer -> Word64# (wrap)" integerToWord64Name (\_ -> mkWord64LitWord64 . fromInteger)
    2230 
    -  , integer_to_lit "Integer -> Int64# (wrap)"  integerToInt64Name  (\_ -> mkInt64LitInt64 . fromInteger)
    2231 
    -  , integer_to_lit "Integer -> Float#"         integerToFloatName  (\_ -> mkFloatLit  . fromInteger)
    2232 
    -  , integer_to_lit "Integer -> Double#"        integerToDoubleName (\_ -> mkDoubleLit . fromInteger)
    2246 
    +  , integer_to_lit "Integer -> Word# (wrap)"   integerToWordIdKey   mkWordLitWrap
    2247 
    +  , integer_to_lit "Integer -> Int# (wrap)"    integerToIntIdKey    mkIntLitWrap
    2248 
    +  , integer_to_lit "Integer -> Word64# (wrap)" integerToWord64IdKey (\_ -> mkWord64LitWord64 . fromInteger)
    2249 
    +  , integer_to_lit "Integer -> Int64# (wrap)"  integerToInt64IdKey  (\_ -> mkInt64LitInt64 . fromInteger)
    2250 
    +  , integer_to_lit "Integer -> Float#"         integerToFloatIdKey  (\_ -> mkFloatLit  . fromInteger)
    2251 
    +  , integer_to_lit "Integer -> Double#"        integerToDoubleIdKey (\_ -> mkDoubleLit . fromInteger)
    2233 2252
    2234 
    -  , integer_to_natural "Integer -> Natural (clamp)" integerToNaturalClampName False True
    2235 
    -  , integer_to_natural "Integer -> Natural (wrap)"  integerToNaturalName      False False
    2236 
    -  , integer_to_natural "Integer -> Natural (throw)" integerToNaturalThrowName True False
    2253 
    +  , integer_to_natural "Integer -> Natural (clamp)" integerToNaturalClampIdKey False True
    2254 
    +  , integer_to_natural "Integer -> Natural (wrap)"  integerToNaturalIdKey      False False
    2255 
    +  , integer_to_natural "Integer -> Natural (throw)" integerToNaturalThrowIdKey True False
    2237 2256
    2238 
    -  , natural_to_word "Natural -> Word# (wrap)"  naturalToWordName
    2257 
    +  , natural_to_word "Natural -> Word# (wrap)"  naturalToWordIdKey
    2239 2258
    2240 2259 
         -- comparisons (return an unlifted Int#)
    2241 
    -  , bignum_bin_pred "bigNatEq#"  bignatEqName (==)
    2260 
    +  , bignum_bin_pred "bigNatEq#"  bignatEqIdKey (==)
    2242 2261
    2243 2262 
         -- comparisons (return an Ordering)
    2244 
    -  , bignum_compare "bignatCompare"      bignatCompareName
    2245 
    -  , bignum_compare "bignatCompareWord#" bignatCompareWordName
    2263 
    +  , bignum_compare "bignatCompare"      bignatCompareIdKey
    2264 
    +  , bignum_compare "bignatCompareWord#" bignatCompareWordIdKey
    2246 2265
    2247 2266 
         -- binary operations
    2248 
    -  , integer_binop "integerAdd" integerAddName (+)
    2249 
    -  , integer_binop "integerSub" integerSubName (-)
    2250 
    -  , integer_binop "integerMul" integerMulName (*)
    2251 
    -  , integer_binop "integerGcd" integerGcdName gcd
    2252 
    -  , integer_binop "integerLcm" integerLcmName lcm
    2253 
    -  , integer_binop "integerAnd" integerAndName (.&.)
    2254 
    -  , integer_binop "integerOr"  integerOrName  (.|.)
    2255 
    -  , integer_binop "integerXor" integerXorName xor
    2256 
    -
    2257 
    -  , natural_binop "naturalAdd" naturalAddName (+)
    2258 
    -  , natural_binop "naturalMul" naturalMulName (*)
    2259 
    -  , natural_binop "naturalGcd" naturalGcdName gcd
    2260 
    -  , natural_binop "naturalLcm" naturalLcmName lcm
    2261 
    -  , natural_binop "naturalAnd" naturalAndName (.&.)
    2262 
    -  , natural_binop "naturalOr"  naturalOrName  (.|.)
    2263 
    -  , natural_binop "naturalXor" naturalXorName xor
    2267 
    +  , integer_binop "integerAdd" integerAddIdKey (+)
    2268 
    +  , integer_binop "integerSub" integerSubIdKey (-)
    2269 
    +  , integer_binop "integerMul" integerMulIdKey (*)
    2270 
    +  , integer_binop "integerGcd" integerGcdIdKey gcd
    2271 
    +  , integer_binop "integerLcm" integerLcmIdKey lcm
    2272 
    +  , integer_binop "integerAnd" integerAndIdKey (.&.)
    2273 
    +  , integer_binop "integerOr"  integerOrIdKey  (.|.)
    2274 
    +  , integer_binop "integerXor" integerXorIdKey xor
    2275 
    +
    2276 
    +  , natural_binop "naturalAdd" naturalAddIdKey (+)
    2277 
    +  , natural_binop "naturalMul" naturalMulIdKey (*)
    2278 
    +  , natural_binop "naturalGcd" naturalGcdIdKey gcd
    2279 
    +  , natural_binop "naturalLcm" naturalLcmIdKey lcm
    2280 
    +  , natural_binop "naturalAnd" naturalAndIdKey (.&.)
    2281 
    +  , natural_binop "naturalOr"  naturalOrIdKey  (.|.)
    2282 
    +  , natural_binop "naturalXor" naturalXorIdKey xor
    2264 2283
    2265 2284 
         -- Natural subtraction: it's a binop but it can fail because of underflow so
    2266 2285 
         -- we have several primitives to handle here.
    2267 
    -  , natural_sub "naturalSubUnsafe" naturalSubUnsafeName
    2268 
    -  , natural_sub "naturalSubThrow"  naturalSubThrowName
    2269 
    -  , mkRule "naturalSub" naturalSubName 2 $ do
    2286 
    +  , natural_sub "naturalSubUnsafe" naturalSubUnsafeIdKey
    2287 
    +  , natural_sub "naturalSubThrow"  naturalSubThrowIdKey
    2288 
    +  , mkRule "naturalSub" naturalSubIdKey 2 $ do
    2270 2289 
             [a0,a1] <- getArgs
    2271 2290 
             x <- isNaturalLiteral a0
    2272 2291 
             y <- isNaturalLiteral a1
    ... ... @@ -2278,53 +2297,53 @@ builtinBignumRules =
    2278 2297 
                 else ret 2 $ mkNaturalExpr platform (x - y)
    2279 2298
    2280 2299 
         -- unary operations
    2281 
    -  , bignum_unop "integerNegate"     integerNegateName     mkIntegerExpr negate
    2282 
    -  , bignum_unop "integerAbs"        integerAbsName        mkIntegerExpr abs
    2283 
    -  , bignum_unop "integerComplement" integerComplementName mkIntegerExpr complement
    2300 
    +  , bignum_unop "integerNegate"     integerNegateIdKey     mkIntegerExpr negate
    2301 
    +  , bignum_unop "integerAbs"        integerAbsIdKey        mkIntegerExpr abs
    2302 
    +  , bignum_unop "integerComplement" integerComplementIdKey mkIntegerExpr complement
    2284 2303
    2285 
    -  , bignum_popcount "integerPopCount" integerPopCountName mkLitIntWrap
    2286 
    -  , bignum_popcount "naturalPopCount" naturalPopCountName mkLitWordWrap
    2304 
    +  , bignum_popcount "integerPopCount" integerPopCountIdKey mkLitIntWrap
    2305 
    +  , bignum_popcount "naturalPopCount" naturalPopCountIdKey mkLitWordWrap
    2287 2306
    2288 2307 
         -- Bits.bit
    2289 
    -  , bignum_bit "integerBit" integerBitName mkIntegerExpr
    2290 
    -  , bignum_bit "naturalBit" naturalBitName mkNaturalExpr
    2308 
    +  , bignum_bit "integerBit" integerBitIdKey mkIntegerExpr
    2309 
    +  , bignum_bit "naturalBit" naturalBitIdKey mkNaturalExpr
    2291 2310
    2292 2311 
         -- Bits.testBit
    2293 
    -  , bignum_testbit "integerTestBit" integerTestBitName
    2294 
    -  , bignum_testbit "naturalTestBit" naturalTestBitName
    2312 
    +  , bignum_testbit "integerTestBit" integerTestBitIdKey
    2313 
    +  , bignum_testbit "naturalTestBit" naturalTestBitIdKey
    2295 2314
    2296 2315 
         -- Bits.shift
    2297 
    -  , bignum_shift "integerShiftL" integerShiftLName shiftL mkIntegerExpr
    2298 
    -  , bignum_shift "integerShiftR" integerShiftRName shiftR mkIntegerExpr
    2299 
    -  , bignum_shift "naturalShiftL" naturalShiftLName shiftL mkNaturalExpr
    2300 
    -  , bignum_shift "naturalShiftR" naturalShiftRName shiftR mkNaturalExpr
    2316 
    +  , bignum_shift "integerShiftL" integerShiftLIdKey shiftL mkIntegerExpr
    2317 
    +  , bignum_shift "integerShiftR" integerShiftRIdKey shiftR mkIntegerExpr
    2318 
    +  , bignum_shift "naturalShiftL" naturalShiftLIdKey shiftL mkNaturalExpr
    2319 
    +  , bignum_shift "naturalShiftR" naturalShiftRIdKey shiftR mkNaturalExpr
    2301 2320
    2302 2321 
         -- division
    2303 
    -  , divop_one  "integerQuot"    integerQuotName    quot    mkIntegerExpr
    2304 
    -  , divop_one  "integerRem"     integerRemName     rem     mkIntegerExpr
    2305 
    -  , divop_one  "integerDiv"     integerDivName     div     mkIntegerExpr
    2306 
    -  , divop_one  "integerMod"     integerModName     mod     mkIntegerExpr
    2307 
    -  , divop_both "integerDivMod"  integerDivModName  divMod  mkIntegerExpr
    2308 
    -  , divop_both "integerQuotRem" integerQuotRemName quotRem mkIntegerExpr
    2322 
    +  , divop_one  "integerQuot"    integerQuotIdKey    quot    mkIntegerExpr
    2323 
    +  , divop_one  "integerRem"     integerRemIdKey     rem     mkIntegerExpr
    2324 
    +  , divop_one  "integerDiv"     integerDivIdKey     div     mkIntegerExpr
    2325 
    +  , divop_one  "integerMod"     integerModIdKey     mod     mkIntegerExpr
    2326 
    +  , divop_both "integerDivMod"  integerDivModIdKey  divMod  mkIntegerExpr
    2327 
    +  , divop_both "integerQuotRem" integerQuotRemIdKey quotRem mkIntegerExpr
    2309 2328
    2310 
    -  , divop_one  "naturalQuot"    naturalQuotName    quot    mkNaturalExpr
    2311 
    -  , divop_one  "naturalRem"     naturalRemName     rem     mkNaturalExpr
    2312 
    -  , divop_both "naturalQuotRem" naturalQuotRemName quotRem mkNaturalExpr
    2329 
    +  , divop_one  "naturalQuot"    naturalQuotIdKey    quot    mkNaturalExpr
    2330 
    +  , divop_one  "naturalRem"     naturalRemIdKey     rem     mkNaturalExpr
    2331 
    +  , divop_both "naturalQuotRem" naturalQuotRemIdKey quotRem mkNaturalExpr
    2313 2332
    2314 2333 
         -- conversions from Rational for Float/Double literals
    2315 
    -  , rational_to "rationalToFloat#"  rationalToFloatName  LitFloat
    2316 
    -  , rational_to "rationalToDouble#" rationalToDoubleName LitDouble
    2334 
    +  , rational_to "rationalToFloat#"  rationalToFloatIdKey  LitFloat
    2335 
    +  , rational_to "rationalToDouble#" rationalToDoubleIdKey LitDouble
    2317 2336
    2318 2337 
         -- conversions from Integer for Float/Double literals
    2319 
    -  , integer_encode_float "integerEncodeFloat"  integerEncodeFloatName
    2338 
    +  , integer_encode_float "integerEncodeFloat"  integerEncodeFloatIdKey
    2320 2339 
           encodeLitFloat  LitFloat
    2321 
    -  , integer_encode_float "integerEncodeDouble" integerEncodeDoubleName
    2340 
    +  , integer_encode_float "integerEncodeDouble" integerEncodeDoubleIdKey
    2322 2341 
           encodeLitDouble LitDouble
    2323 2342 
       ]
    2324 2343 
       where
    2325 
    -    mkRule str name nargs f = BuiltinRule
    2344 
    +    mkRule str key nargs f = BuiltinRule
    2326 2345 
           { ru_name = fsLit str
    2327 
    -      , ru_fn = name
    2346 
    +      , ru_key = key
    2328 2347 
           , ru_nargs = nargs
    2329 2348 
           , ru_try = runRuleM $ do
    2330 2349 
               env <- getRuleOpts
    ... ... @@ -2470,7 +2489,8 @@ builtinBignumRules =
    2470 2489 
           platform <- getPlatform
    2471 2490 
           pure $ mkCoreUnboxedTuple [mk_lit platform r, mk_lit platform s]
    2472 2491
    2473 
    -    integer_encode_float :: String -> Name -> (Integer -> Int -> LitFloating) -> LitFloatingType -> CoreRule
    2492 
    +    integer_encode_float :: String -> KnownKeyNameKey
    2493 
    +                         -> (Integer -> Int -> LitFloating) -> LitFloatingType -> CoreRule
    2474 2494 
         integer_encode_float str name encode_fun destType = mkRule str name 2 $ do
    2475 2495 
           [a0,a1] <- getArgs
    2476 2496 
           x <- isIntegerLiteral a0
    ... ... @@ -2479,7 +2499,7 @@ builtinBignumRules =
    2479 2499 
           yInt <- liftMaybe (toIntegralSized y :: Maybe Int)
    2480 2500 
           pure $ Lit $ LitFloating destType $ encode_fun x yInt
    2481 2501
    2482 
    -    rational_to :: String -> Name -> LitFloatingType -> CoreRule
    2502 
    +    rational_to :: String -> KnownKeyNameKey -> LitFloatingType -> CoreRule
    2483 2503 
         rational_to str name destType = mkRule str name 2 $ do
    2484 2504 
           -- This turns `rationalToFloat# n d` where `n` and `d` are literals into
    2485 2505 
           -- a literal Float# (and similarly for Double#).

  • compiler/GHC/Core/Ppr.hs
    ... ... @@ -27,25 +27,27 @@ module GHC.Core.Ppr (
    27 27 
     import GHC.Prelude
    28 28
    29 29 
     import GHC.Core
    30 
    +import GHC.Core.DataCon
    31 
    +import GHC.Core.TyCon
    32 
    +import GHC.Core.TyCo.Ppr
    33 
    +import GHC.Core.Coercion
    30 34 
     import GHC.Core.Stats (exprStats)
    35 
    +
    31 36 
     import GHC.Types.Fixity (LexicalFixity(..))
    32 37 
     import GHC.Types.Literal( pprLiteral )
    33 
    -import GHC.Types.Name( pprInfixName, pprPrefixName )
    38 
    +import GHC.Types.Name( pprInfixName, pprPrefixName, pprKnownKey )
    34 39 
     import GHC.Types.Var
    35 40 
     import GHC.Types.Id
    36 41 
     import GHC.Types.Id.Info
    37 42 
     import GHC.Types.InlinePragma
    38 43 
     import GHC.Types.Demand
    39 44 
     import GHC.Types.Cpr
    40 
    -import GHC.Core.DataCon
    41 
    -import GHC.Core.TyCon
    42 
    -import GHC.Core.TyCo.Ppr
    43 
    -import GHC.Core.Coercion
    45 
    +import GHC.Types.SrcLoc ( pprUserRealSpan )
    46 
    +import GHC.Types.Tickish
    44 47 
     import GHC.Types.Basic
    48 
    +
    45 49 
     import GHC.Utils.Misc
    46 50 
     import GHC.Utils.Outputable
    47 
    -import GHC.Types.SrcLoc ( pprUserRealSpan )
    48 
    -import GHC.Types.Tickish
    49 51
    50 52 
     {-
    51 53 
     ************************************************************************
    ... ... @@ -668,8 +670,8 @@ pprRules :: [CoreRule] -> SDoc
    668 670 
     pprRules rules = vcat (map pprRule rules)
    669 671
    670 672 
     pprRule :: CoreRule -> SDoc
    671 
    -pprRule (BuiltinRule { ru_fn = fn, ru_name = name})
    672 
    -  = text "Built in rule for" <+> ppr fn <> colon <+> doubleQuotes (ftext name)
    673 
    +pprRule (BuiltinRule { ru_key = key, ru_name = name})
    674 
    +  = text "Built in rule for" <+> pprKnownKey key <> colon <+> doubleQuotes (ftext name)
    673 675
    674 676 
     pprRule (Rule { ru_name = name, ru_act = act, ru_fn = fn,
    675 677 
                     ru_bndrs = tpl_vars, ru_args = tpl_args,

  • compiler/GHC/Core/Rules.hs
    ... ... @@ -79,8 +79,8 @@ import GHC.Types.Var.Env
    79 79 
     import GHC.Types.Var.Set
    80 80 
     import GHC.Types.Name    ( Name, NamedThing(..), nameIsLocalOrFrom )
    81 81 
     import GHC.Types.Name.Set
    82 
    -import GHC.Types.Name.Env
    83 82 
     import GHC.Types.Name.Occurrence( occNameFS )
    83 
    +import GHC.Types.Unique
    84 84 
     import GHC.Types.Unique.FM
    85 85 
     import GHC.Types.Tickish
    86 86 
     import GHC.Types.Basic
    ... ... @@ -357,7 +357,7 @@ addIdSpecialisations id rules
    357 357 
     addRulesToId :: RuleBase -> Id -> Id
    358 358 
     -- Add rules in the RuleBase to the rules in the Id
    359 359 
     addRulesToId rule_base bndr
    360 
    -  | Just rules <- lookupNameEnv rule_base (idName bndr)
    360 
    +  | Just rules <- lookupRuleBase rule_base (idUnique bndr)
    361 361 
       = bndr `addIdSpecialisations` rules
    362 362 
       | otherwise
    363 363 
       = bndr
    ... ... @@ -376,12 +376,12 @@ rulesOfBinds binds = concatMap (concatMap idCoreRules . bindersOf) binds
    376 376 
     -}
    377 377
    378 378 
     -- | Gathers a collection of 'CoreRule's. Maps (the name of) an 'Id' to its rules
    379 
    -type RuleBase = NameEnv [CoreRule]
    379 
    +type RuleBase = UniqFM Unique [CoreRule]
    380 380 
             -- The rules are unordered;
    381 381 
             -- we sort out any overlaps on lookup
    382 382
    383 383 
     emptyRuleBase :: RuleBase
    384 
    -emptyRuleBase = emptyNameEnv
    384 
    +emptyRuleBase = emptyUFM
    385 385
    386 386 
     mkRuleBase :: [CoreRule] -> RuleBase
    387 387 
     mkRuleBase rules = extendRuleBaseList emptyRuleBase rules
    ... ... @@ -392,7 +392,10 @@ extendRuleBaseList rule_base new_guys
    392 392
    393 393 
     extendRuleBase :: RuleBase -> CoreRule -> RuleBase
    394 394 
     extendRuleBase rule_base rule
    395 
    -  = extendNameEnv_Acc (:) Utils.singleton rule_base (ruleIdName rule) rule
    395 
    +  = addToUFM_Acc (:) Utils.singleton rule_base (ruleKey rule) rule
    396 
    +
    397 
    +lookupRuleBase :: RuleBase -> Unique -> Maybe [CoreRule]
    398 
    +lookupRuleBase = lookupUFM
    396 399
    397 400 
     pprRuleBase :: RuleBase -> SDoc
    398 401 
     pprRuleBase rules = pprUFM rules $ \rss ->
    ... ... @@ -440,9 +443,9 @@ addLocalRules rule_env rules
    440 443 
       = rule_env { re_local_rules = extendRuleBaseList (re_local_rules rule_env) rules }
    441 444
    442 445 
     emptyRuleEnv :: RuleEnv
    443 
    -emptyRuleEnv = RuleEnv { re_local_rules   = emptyNameEnv
    444 
    -                       , re_home_rules    = emptyNameEnv
    445 
    -                       , re_eps_rules     = emptyNameEnv
    446 
    +emptyRuleEnv = RuleEnv { re_local_rules   = emptyRuleBase
    447 
    +                       , re_home_rules    = emptyRuleBase
    448 
    +                       , re_eps_rules     = emptyRuleBase
    446 449 
                            , re_visible_orphs = emptyModuleSet }
    447 450
    448 451 
     getRules :: RuleEnv -> Id -> [CoreRule]
    ... ... @@ -478,10 +481,10 @@ getRules (RuleEnv { re_local_rules = local_rule_base
    478 481 
                                                   drop_orphs eps_rules  ++
    479 482 
                                                   idCoreRules fn
    480 483 
       where
    481 
    -    fn_name = idName fn
    484 
    +    fn_key = idUnique fn
    482 485 
         drop_orphs [] = []  -- Fast path; avoid invoking recursive filter
    483 486 
         drop_orphs xs = filter (ruleIsVisible orphs) xs
    484 
    -    get rb = lookupNameEnv rb fn_name `orElse` []
    487 
    +    get rb = lookupRuleBase rb fn_key `orElse` []
    485 488
    486 489 
     ruleIsVisible :: ModuleSet -> CoreRule -> Bool
    487 490 
     ruleIsVisible _ BuiltinRule{} = True

  • compiler/GHC/HsToCore.hs
    ... ... @@ -715,8 +715,8 @@ magicDefnModules = mkModuleSet $ map (nameModule . getName . fst) magicDefns
    715 715 
     mkUnsafeCoercePrimPair :: Id -> CoreExpr -> DsM (Id, CoreExpr)
    716 716 
     -- See Note [Wiring in unsafeCoerce#] for the defn we are creating here
    717 717 
     mkUnsafeCoercePrimPair _old_id old_expr
    718 
    -  = do { unsafe_equality_proof_id <- dsLookupGlobalId unsafeEqualityProofName
    719 
    -       ; unsafe_equality_tc       <- dsLookupTyCon unsafeEqualityTyConName
    718 
    +  = do { unsafe_equality_proof_id <- dsLookupKnownKeyId unsafeEqualityProofIdKey
    719 
    +       ; unsafe_equality_tc       <- dsLookupKnownKeyTyCon unsafeEqualityTyConKey
    720 720
    721 721 
            ; let [unsafe_refl_data_con] = tyConDataCons unsafe_equality_tc
    722 722

  • compiler/GHC/HsToCore/Match/Literal.hs
    ... ... @@ -609,7 +609,7 @@ matchLiterals (var :| vars) ty sub_groups
    609 609 
                     -- we can use a case expression; for String we need
    610 610 
                     -- a chain of if-then-else
    611 611 
             ; if isStringTy (idType var) then
    612 
    -            do  { eq_str <- dsLookupGlobalId eqStringName
    612 
    +            do  { eq_str <- dsLookupKnownKeyId eqStringIdKey
    613 613 
                     ; mrs <- mapM (wrap_str_guard eq_str) alts
    614 614 
                     ; return (foldr1 combineMatchResults mrs) }
    615 615 
               else

  • compiler/GHC/Tc/Deriv/Generate.hs
    ... ... @@ -213,13 +213,29 @@ produced don't get through the typechecker.
    213 213 
     gen_Eq_binds :: SrcSpan -> DerivInstTys -> TcM (LHsBinds GhcPs, Bag AuxBindSpec)
    214 214 
     gen_Eq_binds loc dit@(DerivInstTys{ dit_rep_tc = tycon
    215 215 
                                       , dit_rep_tc_args = tycon_args }) = do
    216 
    -    do { eq_RDR <- rnLookupKnownKeyRdr eqClassOpKey
    217 
    -       ; return ([mk_eq_bind eq_RDR], emptyBag) }
    216 
    +    do { eq_RDR <- tcLookupKnownKey_RDR eqClassOpKey
    217 
    +       ; ([mk_eq_bind eq_RDR], emptyBag) }
    218 218 
       where
    219 219 
         all_cons = getPossibleDataCons tycon tycon_args
    220 220 
         non_nullary_cons = filter (not . isNullarySrcDataCon) all_cons
    221 221
    222 
    -    ------------------------------------------------------------------
    222 
    +    -- Generate tag check. See #17240
    223 
    +    eq_expr_with_tag_check = nlHsCase
    224 
    +      (nlHsPar (untag_Expr [(a_RDR,ah_RDR), (b_RDR,bh_RDR)]
    225 
    +                    (nlHsOpApp (nlHsVar ah_RDR) neInt_RDR (nlHsVar bh_RDR))))
    226 
    +      [ mkHsCaseAlt (nlLitPat (HsIntPrim NoSourceText 1)) false_Expr
    227 
    +      , mkHsCaseAlt nlWildPat (
    228 
    +          nlHsCase
    229 
    +            (nlHsVar a_RDR)
    230 
    +            -- Only one branch to match all nullary constructors
    231 
    +            -- as we already know the tags match but do not emit
    232 
    +            -- the branch if there are no nullary constructors
    233 
    +            (let non_nullary_pats = map pats_etc non_nullary_cons
    234 
    +             in if null non_nullary_cons
    235 
    +                then non_nullary_pats
    236 
    +                else non_nullary_pats ++ [mkHsCaseAlt nlWildPat true_Expr]))
    237 
    +      ]
    238 
    +
    223 239 
         mk_eq_bind eq_RDR = mkFunBindEC 2 loc eq_RDR (const true_Expr) binds
    224 240 
           where
    225 241 
             binds
    ... ... @@ -239,45 +255,29 @@ gen_Eq_binds loc dit@(DerivInstTys{ dit_rep_tc = tycon
    239 255 
               | otherwise
    240 256 
               = [([a_Pat, b_Pat], eq_expr_with_tag_check)]
    241 257
    242 
    -        -- Generate tag check. See #17240
    243 
    -        eq_expr_with_tag_check = nlHsCase
    244 
    -          (nlHsPar (untag_Expr [(a_RDR,ah_RDR), (b_RDR,bh_RDR)]
    245 
    -                        (nlHsOpApp (nlHsVar ah_RDR) neInt_RDR (nlHsVar bh_RDR))))
    246 
    -          [ mkHsCaseAlt (nlLitPat (HsIntPrim NoSourceText 1)) false_Expr
    247 
    -          , mkHsCaseAlt nlWildPat (
    248 
    -              nlHsCase
    249 
    -                (nlHsVar a_RDR)
    250 
    -                -- Only one branch to match all nullary constructors
    251 
    -                -- as we already know the tags match but do not emit
    252 
    -                -- the branch if there are no nullary constructors
    253 
    -                (let non_nullary_pats = map pats_etc non_nullary_cons
    254 
    -                 in if null non_nullary_cons
    255 
    -                    then non_nullary_pats
    256 
    -                    else non_nullary_pats ++ [mkHsCaseAlt nlWildPat true_Expr]))
    257 
    -          ]
    258 
    -
    259 
    -        nested_eq_expr []  [] [] = true_Expr
    260 
    -        nested_eq_expr tys as bs
    261 
    -          = foldr1 and_Expr $ expectNonEmpty $ zipWith3Equal nested_eq tys as bs
    262 
    -          -- Using 'foldr1' here ensures that the derived code is correctly
    263 
    -          -- associated. See #10859.
    264 
    -          where
    265 
    -            nested_eq ty a b = nlHsPar (eq_Expr eq_RDR ty (nlHsVar a) (nlHsVar b))
    258 
    +    ------------------------------------------------------------------
    259 
    +    nested_eq_expr []  [] [] = true_Expr
    260 
    +    nested_eq_expr tys as bs
    261 
    +      = foldr1 and_Expr $ expectNonEmpty $ zipWith3Equal nested_eq tys as bs
    262 
    +      -- Using 'foldr1' here ensures that the derived code is correctly
    263 
    +      -- associated. See #10859.
    264 
    +      where
    265 
    +        nested_eq ty a b = nlHsPar (eq_Expr ty (nlHsVar a) (nlHsVar b))
    266 266
    267 
    -        gen_con_fields_and_tys data_con
    268 
    -          | tys_needed <- derivDataConInstArgTys data_con dit
    269 
    -          , con_arity <- length tys_needed
    270 
    -          , as_needed <- take con_arity as_RDRs
    271 
    -          , bs_needed <- take con_arity bs_RDRs
    272 
    -          = (as_needed, bs_needed, tys_needed)
    267 
    +    gen_con_fields_and_tys data_con
    268 
    +      | tys_needed <- derivDataConInstArgTys data_con dit
    269 
    +      , con_arity <- length tys_needed
    270 
    +      , as_needed <- take con_arity as_RDRs
    271 
    +      , bs_needed <- take con_arity bs_RDRs
    272 
    +      = (as_needed, bs_needed, tys_needed)
    273 273
    274 
    -        pats_etc data_con
    275 
    -          | (as_needed, bs_needed, tys_needed) <- gen_con_fields_and_tys data_con
    276 
    -          , data_con_RDR <- getRdrName data_con
    277 
    -          , con1_pat <- nlParPat $ nlConVarPat data_con_RDR as_needed
    278 
    -          , con2_pat <- nlParPat $ nlConVarPat data_con_RDR bs_needed
    279 
    -          , fields_eq_expr <- nested_eq_expr tys_needed as_needed bs_needed
    280 
    -          = mkHsCaseAlt con1_pat (nlHsCase (nlHsVar b_RDR) [mkHsCaseAlt con2_pat fields_eq_expr])
    274 
    +    pats_etc data_con
    275 
    +      | (as_needed, bs_needed, tys_needed) <- gen_con_fields_and_tys data_con
    276 
    +      , data_con_RDR <- getRdrName data_con
    277 
    +      , con1_pat <- nlParPat $ nlConVarPat data_con_RDR as_needed
    278 
    +      , con2_pat <- nlParPat $ nlConVarPat data_con_RDR bs_needed
    279 
    +      , fields_eq_expr <- nested_eq_expr tys_needed as_needed bs_needed
    280 
    +      = mkHsCaseAlt con1_pat (nlHsCase (nlHsVar b_RDR) [mkHsCaseAlt con2_pat fields_eq_expr])
    281 281
    282 282 
     {-
    283 283 
     ************************************************************************
    ... ... @@ -650,17 +650,16 @@ gen_Enum_binds loc (DerivInstTys{dit_rep_tc = tycon}) = do
    650 650 
         -- See Note [Auxiliary binders]
    651 651 
         tag2con_RDR <- new_tag2con_rdr_name loc tycon
    652 652 
         maxtag_RDR  <- new_maxtag_rdr_name  loc tycon
    653 
    -    eq_RDR      <- rnLookupKnownKeyRdr eqClassOpKey
    654 653
    655 
    -    return ( method_binds eq_RDR tag2con_RDR maxtag_RDR
    654 
    +    return ( method_binds tag2con_RDR maxtag_RDR
    656 655 
                , aux_binds    tag2con_RDR maxtag_RDR )
    657 656 
       where
    658 
    -    method_binds eq_RDR tag2con_RDR maxtag_RDR =
    659 
    -      [ succ_enum      eq_RDR tag2con_RDR maxtag_RDR
    660 
    -      , pred_enum      eq_RDR tag2con_RDR
    661 
    -      , to_enum               tag2con_RDR maxtag_RDR
    662 
    -      , enum_from             tag2con_RDR maxtag_RDR -- [0 ..]
    663 
    -      , enum_from_then        tag2con_RDR maxtag_RDR -- [0, 1 ..]
    657 
    +    method_binds tag2con_RDR maxtag_RDR =
    658 
    +      [ succ_enum      tag2con_RDR maxtag_RDR
    659 
    +      , pred_enum      tag2con_RDR
    660 
    +      , to_enum        tag2con_RDR maxtag_RDR
    661 
    +      , enum_from      tag2con_RDR maxtag_RDR -- [0 ..]
    662 
    +      , enum_from_then tag2con_RDR maxtag_RDR -- [0, 1 ..]
    664 663 
           , from_enum
    665 664 
           ]
    666 665 
         aux_binds tag2con_RDR maxtag_RDR = listToBag
    ... ... @@ -670,7 +669,7 @@ gen_Enum_binds loc (DerivInstTys{dit_rep_tc = tycon}) = do
    670 669
    671 670 
         occ_nm = getOccString tycon
    672 671
    673 
    -    succ_enum eq_RDR tag2con_RDR maxtag_RDR
    672 
    +    succ_enum tag2con_RDR maxtag_RDR
    674 673 
           = mkSimpleGeneratedFunBind loc succ_RDR (noLocA [a_Pat]) $
    675 674 
             untag_Expr [(a_RDR, ah_RDR)] $
    676 675 
             nlHsIf (nlHsApps eq_RDR [nlHsVar maxtag_RDR,
    ... ... @@ -680,7 +679,7 @@ gen_Enum_binds loc (DerivInstTys{dit_rep_tc = tycon}) = do
    680 679 
                         (nlHsApps plus_RDR [nlHsVarApps intDataCon_RDR [ah_RDR],
    681 680 
                                             nlHsIntLit 1]))
    682 681
    683 
    -    pred_enum eq_RDR tag2con_RDR
    682 
    +    pred_enum tag2con_RDR
    684 683 
           = mkSimpleGeneratedFunBind loc pred_RDR (noLocA [a_Pat]) $
    685 684 
             untag_Expr [(a_RDR, ah_RDR)] $
    686 685 
             nlHsIf (nlHsApps eq_RDR [nlHsIntLit 0,
    ... ... @@ -2487,8 +2486,8 @@ and_Expr a b = genOpApp a and_RDR b
    2487 2486
    2488 2487 
     -----------------------------------------------------------------------
    2489 2488
    2490 
    -eq_Expr :: RdrName -> Type -> LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
    2491 
    -eq_Expr eq_RDR ty a b
    2489 
    +eq_Expr :: Type -> LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
    2490 
    +eq_Expr ty a b
    2492 2491 
         | not (isUnliftedType ty) = genOpApp a eq_RDR b
    2493 2492 
         | otherwise               = genPrimOpApp a prim_eq b
    2494 2493 
      where

  • compiler/GHC/Types/Id/Make.hs
    ... ... @@ -515,7 +515,7 @@ mkDictSelId name clas
    515 515 
         --      op (dfT d1 d2) --->  opT d1 d2
    516 516 
         rule = BuiltinRule { ru_name = fsLit "Class op " `appendFS`
    517 517 
                                          occNameFS (getOccName name)
    518 
    -                       , ru_fn    = name
    518 
    +                       , ru_key   = nameUnique name
    519 519 
                            , ru_nargs = n_ty_args + 1
    520 520 
                            , ru_try   = dictSelRule val_index n_ty_args }
    521 521

  • compiler/GHC/Types/Name.hs
    ... ... @@ -127,6 +127,9 @@ A "known-key" name is one
    127 127 
       * but that's all that GHC knows about it
    128 128 
     In particular, GHC does /not/ know in which module the entity is defined.
    129 129
    130 
    +See Note [Recipe for adding a known-key name] for
    131 
    +how to add a known-key name to GHC.
    132 
    +
    130 133 
     Example: the `Eq` class has OccName "Eq" and unique `eqClassKey`.
    131 134 
     It happens to be defined in ghc-internal:GHC.Internal.Classes,
    132 135 
     but GHC does not know that.
    ... ... @@ -245,6 +248,32 @@ Wrinkles
    245 248 
     (KKN1) We need some special treatment of unused-import warnings.
    246 249 
        See (UI1) in Note [Unused imports] in GHC.Rename.Names
    247 250
    251 
    +Note [Recipe for adding a known-key name]
    252 
    +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    253 
    +To make `wombat` into a known-key name, you must ensure that:
    254 
    +
    255 
    +* The module M that defines `wombat` is compiled with `-fdefines-known-key-names`.
    256 
    +
    257 
    +* If M.hs has an `M.hs-boot` file, it too must be compiled
    258 
    +  with `-fdefines-known-key-names`.
    259 
    +
    260 
    +* The module `GHC.KnownKeyNames` must export `wombat`.
    261 
    +
    262 
    +* The big list `GHC.Builtin.Names.knownKeyTable` must contain an
    263 
    +  entry for `wombat`.
    264 
    +
    265 
    +* In any module in `base` or `ghc-internal` (which are compiled with
    266 
    +  -frebindable-known-key-names), you must ensure that `wombat` is in scope
    267 
    +  by saying `import M( wombat )`.
    268 
    +
    269 
    +  If you just say `import M` you may get a "unused import" warning; that
    270 
    +  warning is suppressed for known-key names if you import `wombat` by name.
    271 
    +
    272 
    +  You do not need to import the module in which `wombat` is /defined/, although
    273 
    +  you may.  It is enough simply to bring `wombat` in scope by importing a
    274 
    +  module that re-exports. You can even import `GHC.KnownKeyNames`, if that does
    275 
    +  not create a module loop!
    276 
    +
    248 277 
     Note [About the NameSorts]
    249 278 
     ~~~~~~~~~~~~~~~~~~~~~~~~~~
    250 279 
     1.  Initially:

  • compiler/GHC/Types/Name/Reader.hs
    ... ... @@ -196,7 +196,7 @@ data RdrName
    196 196 
             -- we want to say \"Use Prelude.map dammit\". One of these
    197 197 
             -- can be created with 'mkOrig'
    198 198
    199 
    -  | Exact Name
    199 
    +  | Exact ExactSpec
    200 200 
             -- ^ Exact name
    201 201 
             --
    202 202 
             -- We know exactly the 'Name'. This is used:
    ... ... @@ -209,6 +209,11 @@ data RdrName
    209 209 
             -- Such a 'RdrName' can be created by using 'getRdrName' on a 'Name'
    210 210 
       deriving Data
    211 211
    212 
    +data ExactSpec
    213 
    +  = ExactName Name             -- Use this when you know the exact Name
    214 
    +  | ExactKey  KnownKeyNameKey  -- Use this for known-key names
    215 
    +  deriving Data
    216 
    +
    212 217 
     {-
    213 218 
     ************************************************************************
    214 219 
     *                                                                      *
    ... ... @@ -287,7 +292,7 @@ getRdrName :: NamedThing thing => thing -> RdrName
    287 292 
     getRdrName name = nameRdrName (getName name)
    288 293
    289 294 
     nameRdrName :: Name -> RdrName
    290 
    -nameRdrName name = Exact name
    295 
    +nameRdrName name = Exact (ExactName name)
    291 296 
     -- Keep the Name even for Internal names, so that the
    292 297 
     -- unique is still there for debug printing, particularly
    293 298 
     -- of Types (which are converted to IfaceTypes before printing)

  • compiler/GHC/Types/Unique/FM.hs
    ... ... @@ -176,6 +176,8 @@ addToUFM_C
    176 176 
       -> UniqFM key elt       -- ^ old
    177 177 
       -> key -> elt           -- ^ new
    178 178 
       -> UniqFM key elt       -- ^ result
    179 
    +{-# SPECIALISE addToUFM_C :: (elt -> elt -> elt) -> UniqFM Unique elt
    180 
    +                          -> Unique -> elt -> UniqFM Unique elt #-}
    179 181 
     -- Arguments of combining function of M.insertWith and addToUFM_C are flipped.
    180 182 
     addToUFM_C f (UFM m) k v =
    181 183 
       UFM (M.insertWith (flip f) (getKey $ getUnique k) v m)
    ... ... @@ -197,6 +199,8 @@ addToUFM_Acc
    197 199 
       -> UniqFM key elts        -- old
    198 200 
       -> key -> elt             -- new
    199 201 
       -> UniqFM key elts        -- result
    202 
    +{-# SPECIALISE addToUFM_Acc :: (elt -> elts -> elts) -> (elt->elts) -> UniqFM Unique elts
    203 
    +                            -> Unique -> elt -> UniqFM Unique elts #-}
    200 204 
     addToUFM_Acc exi new (UFM m) k v =
    201 205 
       UFM (M.insertWith (\_new old -> exi v old) (getKey $ getUnique k) (new v) m)
    202 206

  • libraries/base/src/Data/Functor/Classes.hs
    ... ... @@ -71,6 +71,8 @@ module Data.Functor.Classes (
    71 71 
         showsBinary1,
    72 72 
       ) where
    73 73
    74 
    +import GHC.KnownKeyNames
    75 
    +
    74 76 
     import Control.Applicative (Alternative((<|>)), Const(Const))
    75 77
    76 78 
     import GHC.Internal.Data.Functor.Identity (Identity(Identity))
    ... ... @@ -90,6 +92,7 @@ import GHC.Internal.Text.Read.Lex (Lexeme(..))
    90 92 
     import GHC.Internal.Text.Show (showListWith)
    91 93 
     import Prelude
    92 94
    95 
    +
    93 96 
     -- $setup
    94 97 
     -- >>> import Prelude
    95 98 
     -- >>> import Data.Complex (Complex (..))

  • libraries/base/src/GHC/KnownKeyNames.hs
    1 
    -{-# LANGUAGE Trustworthy, RankNTypes #-}
    1 
    +{-# LANGUAGE MagicHash, Trustworthy, RankNTypes #-}
    2 2
    3 3 
     {-# OPTIONS_GHC -fdefines-known-key-names #-}
    4 4 
         -- See Note [Known-key names and IsList]
    ... ... @@ -32,6 +32,7 @@ module GHC.KnownKeyNames
    32 32 
         , Num, Integral, Real
    33 33 
         , (-), negate, fromInteger, fromRational
    34 34 
         , mkRationalBase2, mkRationalBase10
    35 
    +    , divInt#, modInt#
    35 36
    36 37 
         -- Strings
    37 38 
         , IsString
    ... ... @@ -47,12 +48,37 @@ module GHC.KnownKeyNames
    47 48
    48 49 
         -- IO
    49 50 
         , thenIO, bindIO, returnIO, print
    51 
    +
    52 
    +    -- Names that have BuiltinRules
    53 
    +    , CS.unpackFoldrCString#, CS.unpackFoldrCStringUtf8#, CS.unpackAppendCString#
    54 
    +    , CS.unpackAppendCStringUtf8#, CS.cstringLength#
    55 
    +    , eqString, inline
    56 
    +
    57 
    +    , UnsafeEquality( UnsafeRefl ), unsafeEqualityProof
    58 
    +
    59 
    +    -- Bignums
    60 
    +    , bigNatEq#, bigNatCompare, bigNatCompareWord#
    61 
    +    , naturalToWord#, naturalPopCount#, naturalShiftR#, naturalShiftL#
    62 
    +    , naturalAdd, naturalSub, naturalSubThrow, naturalSubUnsafe
    63 
    +    , naturalMul, naturalQuotRem#, naturalQuot, naturalRem, naturalAnd
    64 
    +    , naturalOr, naturalXor, naturalTestBit#, naturalBit#, naturalGcd, naturalLcm
    65 
    +
    66 
    +    , integerFromNatural, integerToNaturalClamp, integerToNaturalThrow, integerToNatural
    67 
    +    , integerToWord#, integerToInt#, integerToWord64#, integerToInt64#, integerFromWord#
    68 
    +    , integerFromWord64#, integerFromInt64#, integerAdd, integerMul, integerSub
    69 
    +    , integerNegate, integerAbs, integerPopCount#, integerQuot, integerRem, integerDiv
    70 
    +    , integerMod, integerDivMod#, integerQuotRem#, integerEncodeFloat#, integerEncodeDouble#
    71 
    +    , integerGcd, integerLcm, integerAnd, integerOr, integerXor
    72 
    +    , integerComplement, integerBit#, integerTestBit#, integerShiftL#, integerShiftR#
    50 73 
         ) where
    51 74
    52 75 
     import Prelude
    53 76 
     import Data.String( IsString )
    54 
    -import GHC.Internal.Base( Alternative, join, thenIO, bindIO, returnIO )
    77 
    +import GHC.Internal.Base( Alternative, join, thenIO, bindIO, returnIO
    78 
    +                        , eqString )
    79 
    +import GHC.Internal.Classes( divInt#, modInt# )
    55 80 
     import GHC.Internal.Ix( Ix )
    81 
    +import GHC.Internal.Magic( inline )
    56 82 
     import GHC.Internal.Data.Data( Data )
    57 83 
     import GHC.Internal.Data.String( fromString )
    58 84 
     import GHC.Internal.Real( mkRationalBase2, mkRationalBase10 )
    ... ... @@ -62,12 +88,20 @@ import GHC.Internal.Control.Monad.Zip( mzip )
    62 88 
     import GHC.Internal.Control.Arrow( arr, (>>>), first, app, (|||) )
    63 89 
     import GHC.Internal.OverloadedLabels( fromLabel )
    64 90 
     import GHC.Internal.Records( HasField, getField )
    91 
    +import GHC.Internal.CString as CS
    65 92 
     import qualified GHC.Internal.IsList as IL
    66 93
    94 
    +import GHC.Internal.Unsafe.Coerce( UnsafeEquality(..), unsafeEqualityProof )
    95 
    +
    96 
    +import GHC.Internal.Bignum.Integer
    97 
    +import GHC.Internal.Bignum.Natural
    98 
    +import GHC.Internal.Bignum.BigNat
    99 
    +
    67 100 
     {- Note [Known-key names and IsList]
    68 101 
     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    69 102 
     Very annoyingly both the classes Foldable and IsList have a method `toList`.
    70 103 
     we can't have two known-key names with the same OccName.
    104 
    +
    71 105 
     -}
    72 106
    73 107 
     isList_toList :: IL.IsList l => l -> [IL.Item l]

  • libraries/ghc-internal/src/GHC/Internal/Bignum/BigNat.hs
    ... ... @@ -9,6 +9,10 @@
    9 9 
     {-# LANGUAGE PolyKinds #-}
    10 10 
     {-# LANGUAGE KindSignatures #-}
    11 11 
     {-# LANGUAGE BinaryLiterals #-}
    12 
    +
    13 
    +{-# OPTIONS_GHC -fdefines-known-key-names #-}
    14 
    +    -- Defines lots of functions that have BuiltinRules
    15 
    +
    12 16 
     {-# OPTIONS_GHC -Wno-name-shadowing #-}
    13 17
    14 18 
     -- | Multi-precision natural

  • libraries/ghc-internal/src/GHC/Internal/Bignum/BigNat.hs-boot
    ... ... @@ -2,6 +2,9 @@
    2 2 
     {-# LANGUAGE MagicHash #-}
    3 3 
     {-# LANGUAGE UnboxedTuples #-}
    4 4
    5 
    +{-# OPTIONS_GHC -fdefines-known-key-names #-}
    6 
    +    -- Defines lots of functions that have BuiltinRules
    7 
    +
    5 8 
     module GHC.Internal.Bignum.BigNat where
    6 9
    7 10 
     import GHC.Internal.Bignum.WordArray

  • libraries/ghc-internal/src/GHC/Internal/Bignum/Integer.hs
    ... ... @@ -8,6 +8,9 @@
    8 8 
     {-# LANGUAGE BlockArguments #-}
    9 9 
     {-# LANGUAGE LambdaCase #-}
    10 10
    11 
    +{-# OPTIONS_GHC -fdefines-known-key-names #-}
    12 
    +    -- Defines lots of functions that have BuiltinRules
    13 
    +
    11 14 
     -- |
    12 15 
     -- Module      :  GHC.Internal.Bignum.Integer
    13 16 
     -- Copyright   :  (c) Sylvain Henry 2019,

  • libraries/ghc-internal/src/GHC/Internal/Bignum/Integer.hs-boot
    ... ... @@ -2,6 +2,9 @@
    2 2 
     {-# LANGUAGE UnboxedTuples #-}
    3 3 
     {-# LANGUAGE MagicHash #-}
    4 4
    5 
    +{-# OPTIONS_GHC -fdefines-known-key-names #-}
    6 
    +    -- Defines lots of functions that have BuiltinRules
    7 
    +
    5 8 
     module GHC.Internal.Bignum.Integer where
    6 9
    7 10 
     import GHC.Internal.Types

  • libraries/ghc-internal/src/GHC/Internal/Bignum/Natural.hs
    ... ... @@ -5,6 +5,9 @@
    5 5 
     {-# LANGUAGE BangPatterns #-}
    6 6 
     {-# LANGUAGE BlockArguments #-}
    7 7
    8 
    +{-# OPTIONS_GHC -fdefines-known-key-names #-}
    9 
    +    -- Defines lots of functions that have BuiltinRules
    10 
    +
    8 11 
     #include "MachDeps.h"
    9 12 
     #include "WordSize.h"
    10 13

  • libraries/ghc-internal/src/GHC/Internal/Bignum/Natural.hs-boot
    1 1 
     {-# LANGUAGE NoImplicitPrelude #-}
    2 2 
     {-# LANGUAGE MagicHash #-}
    3 3
    4 
    +{-# OPTIONS_GHC -fdefines-known-key-names #-}
    5 
    +    -- Defines lots of functions that have BuiltinRules
    6 
    +
    4 7 
     module GHC.Internal.Bignum.Natural where
    5 8
    6 9 
     import {-# SOURCE #-} GHC.Internal.Bignum.BigNat

  • libraries/ghc-internal/src/GHC/Internal/CString.hs
    1 1 
     {-# LANGUAGE MagicHash, NoImplicitPrelude, BangPatterns, UnliftedFFITypes #-}
    2 
    +
    3 
    +{-# OPTIONS_GHC -fdefines-known-key-names #-}
    4 
    +    -- Defines unpackFoldrCString# etc
    5 
    +
    2 6 
     -----------------------------------------------------------------------------
    3 7 
     -- |
    4 8 
     -- Module      :  GHC.Internal.CString

  • libraries/ghc-internal/src/GHC/Internal/Data/Functor/Const.hs
    ... ... @@ -25,9 +25,7 @@ import GHC.Internal.Data.Foldable (Foldable(foldMap))
    25 25 
     import GHC.Internal.Foreign.Storable (Storable)
    26 26
    27 27 
     import GHC.Internal.Ix (Ix)
    28 
    -import GHC.Internal.Base (
    29 
    -    Applicative(..), Functor(..), Monoid(..), Semigroup(..), ($), (.),
    30 
    -  )
    28 
    +import GHC.Internal.Base
    31 29 
     import GHC.Internal.Classes (Eq(..), Ord(..))
    32 30 
     import GHC.Internal.Enum (Bounded, Enum)
    33 31 
     import GHC.Internal.Float (Floating, RealFloat)
    ... ... @@ -36,6 +34,7 @@ import GHC.Internal.Prim (coerce)
    36 34 
     import GHC.Internal.Real (Fractional, Integral, Real, RealFrac)
    37 35 
     import GHC.Internal.Read (Read(readsPrec), readParen, lex)
    38 36 
     import GHC.Internal.Show (Show(showsPrec), showParen, showString)
    37 
    +
    39 38 
     import GHC.Internal.Num( fromInteger )  -- For known-key names
    40 39
    41 40 
     -- | The 'Const' functor.

  • libraries/ghc-internal/src/GHC/Internal/Data/Functor/Identity.hs
    ... ... @@ -34,12 +34,11 @@ module GHC.Internal.Data.Functor.Identity (
    34 34
    35 35 
     import GHC.Internal.Data.Bits (Bits, FiniteBits)
    36 36 
     import GHC.Internal.Data.Coerce
    37 
    -import GHC.Internal.Data.Foldable
    37 
    +import GHC.Internal.Data.Foldable as Foldable
    38 38 
     import GHC.Internal.Data.Functor.Utils ((#.))
    39 39 
     import GHC.Internal.Foreign.Storable (Storable)
    40 40 
     import GHC.Internal.Ix (Ix)
    41 
    -import GHC.Internal.Base ( Applicative(..), Functor(..), Monad(..)
    42 
    -                         , Semigroup, Monoid, ($), (.) )
    41 
    +import GHC.Internal.Base
    43 42 
     import GHC.Internal.Classes (Eq(..), Ord(..))
    44 43 
     import GHC.Internal.Enum (Bounded, Enum)
    45 44 
     import GHC.Internal.Float (Floating, RealFloat)
    ... ... @@ -117,7 +116,7 @@ instance Foldable Identity where
    117 116 
         foldl'                 = coerce
    118 117 
         foldl1 _               = runIdentity
    119 118 
         foldr f z (Identity x) = f x z
    120 
    -    foldr'                 = foldr
    119 
    +    foldr'                 = Foldable.foldr  -- Not the one from GHC.Internal.Base!
    121 120 
         foldr1 _               = runIdentity
    122 121 
         length _               = 1
    123 122 
         maximum                = runIdentity

  • libraries/ghc-internal/src/GHC/Internal/Data/Ord.hs
    ... ... @@ -28,10 +28,7 @@ import GHC.Internal.Classes (Eq(..), Ord(..))
    28 28 
     import GHC.Internal.Data.Bits (Bits, FiniteBits, complement)
    29 29 
     import GHC.Internal.Foreign.Storable (Storable)
    30 30 
     import GHC.Internal.Ix (Ix)
    31 
    -import GHC.Internal.Base (
    32 
    -    Applicative(..), Functor(..), Monad(..), Monoid, Semigroup, otherwise,
    33 
    -    ($), (.),
    34 
    -  )
    31 
    +import GHC.Internal.Base
    35 32 
     import GHC.Internal.Enum (Bounded(..), Enum(..))
    36 33 
     import GHC.Internal.Float (Floating, RealFloat)
    37 34 
     import GHC.Internal.Num

  • libraries/ghc-internal/src/GHC/Internal/Data/Typeable/Internal.hs
    ... ... @@ -124,6 +124,7 @@ import {-# SOURCE #-} GHC.Internal.Fingerprint
    124 124 
     -- import {-# SOURCE #-} GHC.Internal.Debug.Trace (trace)
    125 125
    126 126 
     import GHC.Internal.Num( fromInteger )  -- For known-key names
    127 
    +import GHC.Internal.Base( eqString )             -- For known-key names
    127 128
    128 129 
     #include "MachDeps.h"
    129 130

  • libraries/ghc-internal/src/GHC/Internal/IO/Encoding.hs
    ... ... @@ -36,7 +36,7 @@ module GHC.Internal.IO.Encoding (
    36 36 
             argvEncoding
    37 37 
         ) where
    38 38
    39 
    -import GHC.Internal.Base (String, return, ($))
    39 
    +import GHC.Internal.Base (String, return, ($), eqString)
    40 40 
     import GHC.Internal.Classes (Eq(..))
    41 41 
     import GHC.Internal.IO.Exception
    42 42 
     import GHC.Internal.IO.Buffer

  • libraries/ghc-internal/src/GHC/Internal/Magic.hs
    ... ... @@ -5,6 +5,10 @@
    5 5 
     {-# LANGUAGE PolyKinds #-}
    6 6 
     {-# LANGUAGE ScopedTypeVariables #-}
    7 7 
     {-# LANGUAGE StandaloneKindSignatures #-}
    8 
    +
    9 
    +{-# OPTIONS_GHC -fdefines-known-key-names #-}
    10 
    +    -- Defines inline etc
    11 
    +
    8 12 
     {-# OPTIONS_HADDOCK print-explicit-runtime-reps #-}
    9 13
    10 14 
     -----------------------------------------------------------------------------

  • libraries/ghc-internal/src/GHC/Internal/Read.hs
    ... ... @@ -83,6 +83,7 @@ import GHC.Internal.Tuple (Solo (..))
    83 83 
     import GHC.Internal.ByteOrder
    84 84
    85 85 
     import GHC.Internal.Control.Monad.Fail( fail )   -- For known-key names
    86 
    +import GHC.Internal.Base( eqString )             -- For known-key names
    86 87
    87 88 
     -- | @'readParen' 'True' p@ parses what @p@ parses, but surrounded with
    88 89 
     -- parentheses.

  • libraries/ghc-internal/src/GHC/Internal/Unsafe/Coerce.hs
    ... ... @@ -3,6 +3,9 @@
    3 3 
     -- Note [Implementing unsafeCoerce]
    4 4 
     {-# OPTIONS_GHC -fno-strictness #-}
    5 5
    6 
    +{-# OPTIONS_GHC -fdefines-known-key-names #-}
    7 
    +    -- Defines unsafeEqualityProof etc
    8 
    +
    6 9 
     {-# LANGUAGE DataKinds #-}
    7 10 
     {-# LANGUAGE GADTs #-}
    8 11 
     {-# LANGUAGE MagicHash #-}

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help