Cheng Shao pushed to branch wip/terrorjack/asan at Glasgow Haskell Compiler / GHC

Commits:

30 changed files:

Changes:

  • .gitlab/ci.sh
    ... ... @@ -265,6 +265,15 @@ function setup() {
    265 265 
       # testsuite driver!
    266 266 
       git config gc.auto 0
    267 267
    268 
    +  # Some runners still choke at the perf note fetch step, which has to
    269 
    +  # do with slow internet connection, see
    270 
    +  # https://docs.gitlab.com/topics/git/troubleshooting_git/#error-stream-0-was-not-closed-cleanly
    271 
    +  # for the http.postBuffer mitigation. It might seem
    272 
    +  # counter-intuitive that "post buffer" helps with fetching, but git
    273 
    +  # indeed issues post requests when fetching over https, it's a
    274 
    +  # bidirectional negotiation with the remote.
    275 
    +  git config http.postBuffer 52428800
    276 
    +
    268 277 
       info "====================================================="
    269 278 
       info "Toolchain versions"
    270 279 
       info "====================================================="

  • .gitlab/generate-ci/gen_ci.hs
    ... ... @@ -162,6 +162,7 @@ data BuildConfig
    162 162 
                     , tablesNextToCode :: Bool
    163 163 
                     , threadSanitiser :: Bool
    164 164 
                     , ubsan :: Bool
    165 
    +                , asan :: Bool
    165 166 
                     , noSplitSections :: Bool
    166 167 
                     , validateNonmovingGc :: Bool
    167 168 
                     , textWithSIMDUTF :: Bool
    ... ... @@ -173,7 +174,7 @@ configureArgsStr :: BuildConfig -> String
    173 174 
     configureArgsStr bc = unwords $
    174 175 
          ["--enable-unregisterised"| unregisterised bc ]
    175 176 
       ++ ["--disable-tables-next-to-code" | not (tablesNextToCode bc) ]
    176 
    -  ++ ["--with-intree-gmp" | Just _ <- pure (crossTarget bc) ]
    177 
    +  ++ ["--with-intree-gmp" | isJust (crossTarget bc) || ubsan bc || asan bc ]
    177 178 
       ++ ["--with-system-libffi" | crossTarget bc == Just "wasm32-wasi" ]
    178 179 
       ++ ["--enable-ipe-data-compression" | withZstd bc ]
    179 180 
       ++ ["--enable-strict-ghc-toolchain-check"]
    ... ... @@ -188,6 +189,7 @@ mkJobFlavour BuildConfig{..} = Flavour buildFlavour opts
    188 189 
                [HostFullyStatic | hostFullyStatic] ++
    189 190 
                [ThreadSanitiser | threadSanitiser] ++
    190 191 
                [UBSan | ubsan] ++
    192 
    +           [ASan | asan] ++
    191 193 
                [NoSplitSections | noSplitSections, buildFlavour == Release ] ++
    192 194 
                [BootNonmovingGc | validateNonmovingGc ] ++
    193 195 
                [TextWithSIMDUTF | textWithSIMDUTF]
    ... ... @@ -201,6 +203,7 @@ data FlavourTrans =
    201 203 
         | HostFullyStatic
    202 204 
         | ThreadSanitiser
    203 205 
         | UBSan
    206 
    +    | ASan
    204 207 
         | NoSplitSections
    205 208 
         | BootNonmovingGc
    206 209 
         | TextWithSIMDUTF
    ... ... @@ -230,6 +233,7 @@ vanilla = BuildConfig
    230 233 
       , tablesNextToCode = True
    231 234 
       , threadSanitiser = False
    232 235 
       , ubsan = False
    236 
    +  , asan = False
    233 237 
       , noSplitSections = False
    234 238 
       , validateNonmovingGc = False
    235 239 
       , textWithSIMDUTF = False
    ... ... @@ -283,8 +287,8 @@ llvm = vanilla { llvmBootstrap = True }
    283 287 
     tsan :: BuildConfig
    284 288 
     tsan = vanilla { threadSanitiser = True }
    285 289
    286 
    -enableUBSan :: BuildConfig
    287 
    -enableUBSan = vanilla { withDwarf = True, ubsan = True }
    290 
    +enableUBSanASan :: BuildConfig
    291 
    +enableUBSanASan = vanilla { withDwarf = True, ubsan = True, asan = True }
    288 292
    289 293 
     noTntc :: BuildConfig
    290 294 
     noTntc = vanilla { tablesNextToCode = False }
    ... ... @@ -381,6 +385,7 @@ flavourString (Flavour base trans) = base_string base ++ concatMap (("+" ++) . f
    381 385 
         flavour_string HostFullyStatic = "host_fully_static"
    382 386 
         flavour_string ThreadSanitiser = "thread_sanitizer_cmm"
    383 387 
         flavour_string UBSan = "ubsan"
    388 
    +    flavour_string ASan = "asan"
    384 389 
         flavour_string NoSplitSections = "no_split_sections"
    385 390 
         flavour_string BootNonmovingGc = "boot_nonmoving_gc"
    386 391 
         flavour_string TextWithSIMDUTF = "text_simdutf"
    ... ... @@ -1213,15 +1218,24 @@ fedora_x86 =
    1213 1218 
       , hackage_doc_job (disableValidate (standardBuildsWithConfig Amd64 (Linux Fedora43) releaseConfig))
    1214 1219 
       , disableValidate (standardBuildsWithConfig Amd64 (Linux Fedora43) dwarf)
    1215 1220 
       , disableValidate (standardBuilds Amd64 (Linux Fedora43))
    1216 
    -    -- For UBSan jobs, only enable for validate/nightly pipelines.
    1217 
    -    -- Also disable docs since it's not the point for UBSan jobs.
    1221 
    +    -- For UBSan/ASan jobs, only enable for validate/nightly
    1222 
    +    -- pipelines. Also disable docs since it's not the point for
    1223 
    +    -- UBSan/ASan jobs.
    1224 
    +    --
    1225 
    +    -- See
    1226 
    +    -- https://github.com/llvm/llvm-project/blob/llvmorg-21.1.8/compiler-rt/lib/sanitizer_common/sanitizer_flags.inc
    1227 
    +    -- for ASAN options help, for now these are required to pass the
    1228 
    +    -- testsuite
    1218 1229 
       , modifyJobs
    1219 1230 
           ( setVariable "HADRIAN_ARGS" "--docs=none"
    1220 1231 
               . addVariable
    1221 1232 
                 "UBSAN_OPTIONS"
    1222 1233 
                 "suppressions=$CI_PROJECT_DIR/rts/.ubsan-suppressions"
    1234 
    +          . addVariable
    1235 
    +            "ASAN_OPTIONS"
    1236 
    +            "detect_leaks=false:handle_segv=0:handle_sigfpe=0:verify_asan_link_order=false"
    1223 1237 
           )
    1224 
    -      $ validateBuilds Amd64 (Linux Fedora43) enableUBSan
    1238 
    +      $ validateBuilds Amd64 (Linux Fedora43) enableUBSanASan
    1225 1239 
       ]
    1226 1240 
       where
    1227 1241 
         hackage_doc_job = rename (<> "-hackage") . modifyJobs (addVariable "HADRIAN_ARGS" "--haddock-for-hackage")

  • .gitlab/jobs.yaml
    ... ... @@ -3195,7 +3195,7 @@
    3195 3195 
           "XZ_OPT": "-9"
    3196 3196 
         }
    3197 3197 
       },
    3198 
    -  "nightly-x86_64-linux-fedora43-validate+debug_info+ubsan": {
    3198 
    +  "nightly-x86_64-linux-fedora43-validate+debug_info+ubsan+asan": {
    3199 3199 
         "after_script": [
    3200 3200 
           ".gitlab/ci.sh save_cache",
    3201 3201 
           ".gitlab/ci.sh save_test_output",
    ... ... @@ -3206,7 +3206,7 @@
    3206 3206 
         "artifacts": {
    3207 3207 
           "expire_in": "8 weeks",
    3208 3208 
           "paths": [
    3209 
    -        "ghc-x86_64-linux-fedora43-validate+debug_info+ubsan.tar.xz",
    3209 
    +        "ghc-x86_64-linux-fedora43-validate+debug_info+ubsan+asan.tar.xz",
    3210 3210 
             "junit.xml",
    3211 3211 
             "unexpected-test-output.tar.gz"
    3212 3212 
           ],
    ... ... @@ -3248,14 +3248,15 @@
    3248 3248 
           "x86_64-linux"
    3249 3249 
         ],
    3250 3250 
         "variables": {
    3251 
    +      "ASAN_OPTIONS": "detect_leaks=false:handle_segv=0:handle_sigfpe=0:verify_asan_link_order=false",
    3251 3252 
           "BIGNUM_BACKEND": "gmp",
    3252 
    -      "BIN_DIST_NAME": "ghc-x86_64-linux-fedora43-validate+debug_info+ubsan",
    3253 
    -      "BUILD_FLAVOUR": "validate+debug_info+ubsan",
    3254 
    -      "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
    3253 
    +      "BIN_DIST_NAME": "ghc-x86_64-linux-fedora43-validate+debug_info+ubsan+asan",
    3254 
    +      "BUILD_FLAVOUR": "validate+debug_info+ubsan+asan",
    3255 
    +      "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check",
    3255 3256 
           "HADRIAN_ARGS": "--docs=none",
    3256 3257 
           "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
    3257 3258 
           "RUNTEST_ARGS": "",
    3258 
    -      "TEST_ENV": "x86_64-linux-fedora43-validate+debug_info+ubsan",
    3259 
    +      "TEST_ENV": "x86_64-linux-fedora43-validate+debug_info+ubsan+asan",
    3259 3260 
           "UBSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.ubsan-suppressions",
    3260 3261 
           "XZ_OPT": "-9"
    3261 3262 
         }
    ... ... @@ -7346,7 +7347,7 @@
    7346 7347 
           "TEST_ENV": "x86_64-linux-fedora43-validate+debug_info"
    7347 7348 
         }
    7348 7349 
       },
    7349 
    -  "x86_64-linux-fedora43-validate+debug_info+ubsan": {
    7350 
    +  "x86_64-linux-fedora43-validate+debug_info+ubsan+asan": {
    7350 7351 
         "after_script": [
    7351 7352 
           ".gitlab/ci.sh save_cache",
    7352 7353 
           ".gitlab/ci.sh save_test_output",
    ... ... @@ -7357,7 +7358,7 @@
    7357 7358 
         "artifacts": {
    7358 7359 
           "expire_in": "2 weeks",
    7359 7360 
           "paths": [
    7360 
    -        "ghc-x86_64-linux-fedora43-validate+debug_info+ubsan.tar.xz",
    7361 
    +        "ghc-x86_64-linux-fedora43-validate+debug_info+ubsan+asan.tar.xz",
    7361 7362 
             "junit.xml",
    7362 7363 
             "unexpected-test-output.tar.gz"
    7363 7364 
           ],
    ... ... @@ -7383,7 +7384,7 @@
    7383 7384 
         ],
    7384 7385 
         "rules": [
    7385 7386 
           {
    7386 
    -        "if": "((($ONLY_JOBS) && ($ONLY_JOBS =~ /.*\\bx86_64-linux-fedora43-validate\\+debug_info\\+ubsan(\\s|$).*/)) || (($ONLY_JOBS == null) && ((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/) || ($CI_COMMIT_BRANCH == \"master\") || ($CI_COMMIT_BRANCH =~ /ghc-[0-9]+\\.[0-9]+/))))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
    7387 
    +        "if": "((($ONLY_JOBS) && ($ONLY_JOBS =~ /.*\\bx86_64-linux-fedora43-validate\\+debug_info\\+ubsan\\+asan(\\s|$).*/)) || (($ONLY_JOBS == null) && ((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/) || ($CI_COMMIT_BRANCH == \"master\") || ($CI_COMMIT_BRANCH =~ /ghc-[0-9]+\\.[0-9]+/))))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
    7387 7388 
             "when": "on_success"
    7388 7389 
           }
    7389 7390 
         ],
    ... ... @@ -7399,14 +7400,15 @@
    7399 7400 
           "x86_64-linux"
    7400 7401 
         ],
    7401 7402 
         "variables": {
    7403 
    +      "ASAN_OPTIONS": "detect_leaks=false:handle_segv=0:handle_sigfpe=0:verify_asan_link_order=false",
    7402 7404 
           "BIGNUM_BACKEND": "gmp",
    7403 
    -      "BIN_DIST_NAME": "ghc-x86_64-linux-fedora43-validate+debug_info+ubsan",
    7404 
    -      "BUILD_FLAVOUR": "validate+debug_info+ubsan",
    7405 
    -      "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
    7405 
    +      "BIN_DIST_NAME": "ghc-x86_64-linux-fedora43-validate+debug_info+ubsan+asan",
    7406 
    +      "BUILD_FLAVOUR": "validate+debug_info+ubsan+asan",
    7407 
    +      "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check",
    7406 7408 
           "HADRIAN_ARGS": "--docs=none",
    7407 7409 
           "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
    7408 7410 
           "RUNTEST_ARGS": "",
    7409 
    -      "TEST_ENV": "x86_64-linux-fedora43-validate+debug_info+ubsan",
    7411 
    +      "TEST_ENV": "x86_64-linux-fedora43-validate+debug_info+ubsan+asan",
    7410 7412 
           "UBSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.ubsan-suppressions"
    7411 7413 
         }
    7412 7414 
       },

  • compiler/GHC/Builtin/Names.hs
    ... ... @@ -222,12 +222,11 @@ basicKnownKeyNames
    222 222
    223 223 
             -- Type representation types
    224 224 
             trModuleTyConName, trModuleDataConName,
    225 
    -        trNameTyConName, trNameSDataConName, trNameDDataConName,
    225 
    +        trNameSDataConName,
    226 226 
             trTyConTyConName, trTyConDataConName,
    227 227
    228 228 
             -- Typeable
    229 229 
             typeableClassName,
    230 
    -        typeRepTyConName,
    231 230 
             someTypeRepTyConName,
    232 231 
             someTypeRepDataConName,
    233 232 
             kindRepTyConName,
    ... ... @@ -237,13 +236,10 @@ basicKnownKeyNames
    237 236 
             kindRepFunDataConName,
    238 237 
             kindRepTYPEDataConName,
    239 238 
             kindRepTypeLitSDataConName,
    240 
    -        kindRepTypeLitDDataConName,
    241 
    -        typeLitSortTyConName,
    242 239 
             typeLitSymbolDataConName,
    243 240 
             typeLitNatDataConName,
    244 241 
             typeLitCharDataConName,
    245 242 
             typeRepIdName,
    246 
    -        mkTrTypeName,
    247 243 
             mkTrConName,
    248 244 
             mkTrAppCheckedName,
    249 245 
             mkTrFunName,
    ... ... @@ -296,7 +292,7 @@ basicKnownKeyNames
    296 292 
             fmapName,
    297 293
    298 294 
             -- Monad stuff
    299 
    -        thenIOName, bindIOName, returnIOName, failIOName, bindMName, thenMName,
    295 
    +        thenIOName, bindIOName, returnIOName, bindMName, thenMName,
    300 296 
             returnMName, joinMName,
    301 297
    302 298 
             -- MonadFail
    ... ... @@ -409,26 +405,18 @@ basicKnownKeyNames
    409 405 
             naturalQuotName,
    410 406 
             naturalRemName,
    411 407 
             naturalAndName,
    412 
    -        naturalAndNotName,
    413 408 
             naturalOrName,
    414 409 
             naturalXorName,
    415 410 
             naturalTestBitName,
    416 411 
             naturalBitName,
    417 412 
             naturalGcdName,
    418 413 
             naturalLcmName,
    419 
    -        naturalLog2Name,
    420 
    -        naturalLogBaseWordName,
    421 
    -        naturalLogBaseName,
    422 
    -        naturalPowModName,
    423 
    -        naturalSizeInBaseName,
    424 414
    425 415 
             bignatEqName,
    426 416
    427 417 
             -- Float/Double
    428 418 
             integerToFloatName,
    429 419 
             integerToDoubleName,
    430 
    -        naturalToFloatName,
    431 
    -        naturalToDoubleName,
    432 420 
             rationalToFloatName,
    433 421 
             rationalToDoubleName,
    434 422
    ... ... @@ -476,11 +464,9 @@ basicKnownKeyNames
    476 464
    477 465 
             -- Generics
    478 466 
             , genClassName, gen1ClassName
    479 
    -        , datatypeClassName, constructorClassName, selectorClassName
    480 467
    481 468 
             -- Monad comprehensions
    482 469 
             , guardMName
    483 
    -        , liftMName
    484 470 
             , mzipName
    485 471
    486 472 
             -- GHCi Sandbox
    ... ... @@ -492,9 +478,6 @@ basicKnownKeyNames
    492 478 
             , staticPtrDataConName, staticPtrInfoDataConName
    493 479 
             , fromStaticPtrName
    494 480
    495 
    -        -- Fingerprint
    496 
    -        , fingerprintDataConName
    497 
    -
    498 481 
             -- Custom type errors
    499 482 
             , errorMessageTypeErrorFamName
    500 483 
             , typeErrorTextDataConName
    ... ... @@ -517,12 +500,9 @@ basicKnownKeyNames
    517 500
    518 501 
     genericTyConNames :: [Name]
    519 502 
     genericTyConNames = [
    520 
    -    v1TyConName, u1TyConName, par1TyConName, rec1TyConName,
    521 
    -    k1TyConName, m1TyConName, sumTyConName, prodTyConName,
    522 
    -    compTyConName, rTyConName, dTyConName,
    523 
    -    cTyConName, sTyConName, rec0TyConName,
    524 
    -    d1TyConName, c1TyConName, s1TyConName,
    525 
    -    repTyConName, rep1TyConName, uRecTyConName,
    503 
    +    v1TyConName, u1TyConName, par1TyConName, rec1TyConName, sumTyConName,
    504 
    +    prodTyConName, compTyConName, rec0TyConName, d1TyConName, c1TyConName,
    505 
    +    s1TyConName, repTyConName, rep1TyConName,
    526 506 
         uAddrTyConName, uCharTyConName, uDoubleTyConName,
    527 507 
         uFloatTyConName, uIntTyConName, uWordTyConName,
    528 508 
         prefixIDataConName, infixIDataConName, leftAssociativeDataConName,
    ... ... @@ -939,11 +919,8 @@ voidTyConName = tcQual gHC_INTERNAL_BASE (fsLit "Void") voidTyConKey
    939 919
    940 920 
     -- Generics (types)
    941 921 
     v1TyConName, u1TyConName, par1TyConName, rec1TyConName,
    942 
    -  k1TyConName, m1TyConName, sumTyConName, prodTyConName,
    943 
    -  compTyConName, rTyConName, dTyConName,
    944 
    -  cTyConName, sTyConName, rec0TyConName,
    945 
    -  d1TyConName, c1TyConName, s1TyConName,
    946 
    -  repTyConName, rep1TyConName, uRecTyConName,
    922 
    +  sumTyConName, prodTyConName, compTyConName, rec0TyConName, d1TyConName,
    923 
    +  c1TyConName, s1TyConName, repTyConName, rep1TyConName,
    947 924 
       uAddrTyConName, uCharTyConName, uDoubleTyConName,
    948 925 
       uFloatTyConName, uIntTyConName, uWordTyConName,
    949 926 
       prefixIDataConName, infixIDataConName, leftAssociativeDataConName,
    ... ... @@ -958,18 +935,11 @@ v1TyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "V1") v1TyConKey
    958 935 
     u1TyConName  = tcQual gHC_INTERNAL_GENERICS (fsLit "U1") u1TyConKey
    959 936 
     par1TyConName  = tcQual gHC_INTERNAL_GENERICS (fsLit "Par1") par1TyConKey
    960 937 
     rec1TyConName  = tcQual gHC_INTERNAL_GENERICS (fsLit "Rec1") rec1TyConKey
    961 
    -k1TyConName  = tcQual gHC_INTERNAL_GENERICS (fsLit "K1") k1TyConKey
    962 
    -m1TyConName  = tcQual gHC_INTERNAL_GENERICS (fsLit "M1") m1TyConKey
    963 938
    964 939 
     sumTyConName    = tcQual gHC_INTERNAL_GENERICS (fsLit ":+:") sumTyConKey
    965 940 
     prodTyConName   = tcQual gHC_INTERNAL_GENERICS (fsLit ":*:") prodTyConKey
    966 941 
     compTyConName   = tcQual gHC_INTERNAL_GENERICS (fsLit ":.:") compTyConKey
    967 942
    968 
    -rTyConName  = tcQual gHC_INTERNAL_GENERICS (fsLit "R") rTyConKey
    969 
    -dTyConName  = tcQual gHC_INTERNAL_GENERICS (fsLit "D") dTyConKey
    970 
    -cTyConName  = tcQual gHC_INTERNAL_GENERICS (fsLit "C") cTyConKey
    971 
    -sTyConName  = tcQual gHC_INTERNAL_GENERICS (fsLit "S") sTyConKey
    972 
    -
    973 943 
     rec0TyConName  = tcQual gHC_INTERNAL_GENERICS (fsLit "Rec0") rec0TyConKey
    974 944 
     d1TyConName  = tcQual gHC_INTERNAL_GENERICS (fsLit "D1") d1TyConKey
    975 945 
     c1TyConName  = tcQual gHC_INTERNAL_GENERICS (fsLit "C1") c1TyConKey
    ... ... @@ -978,7 +948,6 @@ s1TyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "S1") s1TyConKey
    978 948 
     repTyConName  = tcQual gHC_INTERNAL_GENERICS (fsLit "Rep")  repTyConKey
    979 949 
     rep1TyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "Rep1") rep1TyConKey
    980 950
    981 
    -uRecTyConName      = tcQual gHC_INTERNAL_GENERICS (fsLit "URec") uRecTyConKey
    982 951 
     uAddrTyConName     = tcQual gHC_INTERNAL_GENERICS (fsLit "UAddr") uAddrTyConKey
    983 952 
     uCharTyConName     = tcQual gHC_INTERNAL_GENERICS (fsLit "UChar") uCharTyConKey
    984 953 
     uDoubleTyConName   = tcQual gHC_INTERNAL_GENERICS (fsLit "UDouble") uDoubleTyConKey
    ... ... @@ -1169,18 +1138,12 @@ integerFromNaturalName
    1169 1138 
        , naturalQuotName
    1170 1139 
        , naturalRemName
    1171 1140 
        , naturalAndName
    1172 
    -   , naturalAndNotName
    1173 1141 
        , naturalOrName
    1174 1142 
        , naturalXorName
    1175 1143 
        , naturalTestBitName
    1176 1144 
        , naturalBitName
    1177 1145 
        , naturalGcdName
    1178 1146 
        , naturalLcmName
    1179 
    -   , naturalLog2Name
    1180 
    -   , naturalLogBaseWordName
    1181 
    -   , naturalLogBaseName
    1182 
    -   , naturalPowModName
    1183 
    -   , naturalSizeInBaseName
    1184 1147 
        , bignatEqName
    1185 1148 
        , bignatCompareName
    1186 1149 
        , bignatCompareWordName
    ... ... @@ -1209,18 +1172,12 @@ naturalQuotRemName = bnnVarQual "naturalQuotRem#" naturalQuotRe
    1209 1172 
     naturalQuotName           = bnnVarQual "naturalQuot"               naturalQuotIdKey
    1210 1173 
     naturalRemName            = bnnVarQual "naturalRem"                naturalRemIdKey
    1211 1174 
     naturalAndName            = bnnVarQual "naturalAnd"                naturalAndIdKey
    1212 
    -naturalAndNotName         = bnnVarQual "naturalAndNot"             naturalAndNotIdKey
    1213 1175 
     naturalOrName             = bnnVarQual "naturalOr"                 naturalOrIdKey
    1214 1176 
     naturalXorName            = bnnVarQual "naturalXor"                naturalXorIdKey
    1215 1177 
     naturalTestBitName        = bnnVarQual "naturalTestBit#"           naturalTestBitIdKey
    1216 1178 
     naturalBitName            = bnnVarQual "naturalBit#"               naturalBitIdKey
    1217 1179 
     naturalGcdName            = bnnVarQual "naturalGcd"                naturalGcdIdKey
    1218 1180 
     naturalLcmName            = bnnVarQual "naturalLcm"                naturalLcmIdKey
    1219 
    -naturalLog2Name           = bnnVarQual "naturalLog2#"              naturalLog2IdKey
    1220 
    -naturalLogBaseWordName    = bnnVarQual "naturalLogBaseWord#"       naturalLogBaseWordIdKey
    1221 
    -naturalLogBaseName        = bnnVarQual "naturalLogBase#"           naturalLogBaseIdKey
    1222 
    -naturalPowModName         = bnnVarQual "naturalPowMod"             naturalPowModIdKey
    1223 
    -naturalSizeInBaseName     = bnnVarQual "naturalSizeInBase#"        naturalSizeInBaseIdKey
    1224 1181
    1225 1182 
     integerFromNaturalName    = bniVarQual "integerFromNatural"        integerFromNaturalIdKey
    1226 1183 
     integerToNaturalClampName = bniVarQual "integerToNaturalClamp"     integerToNaturalClampIdKey
    ... ... @@ -1291,12 +1248,9 @@ realFloatClassName = clsQual gHC_INTERNAL_FLOAT (fsLit "RealFloat") realFloatCla
    1291 1248
    1292 1249 
     -- other GHC.Internal.Float functions
    1293 1250 
     integerToFloatName, integerToDoubleName,
    1294 
    -  naturalToFloatName, naturalToDoubleName,
    1295 1251 
       rationalToFloatName, rationalToDoubleName :: Name
    1296 1252 
     integerToFloatName   = varQual gHC_INTERNAL_FLOAT (fsLit "integerToFloat#") integerToFloatIdKey
    1297 1253 
     integerToDoubleName  = varQual gHC_INTERNAL_FLOAT (fsLit "integerToDouble#") integerToDoubleIdKey
    1298 
    -naturalToFloatName   = varQual gHC_INTERNAL_FLOAT (fsLit "naturalToFloat#") naturalToFloatIdKey
    1299 
    -naturalToDoubleName  = varQual gHC_INTERNAL_FLOAT (fsLit "naturalToDouble#") naturalToDoubleIdKey
    1300 1254 
     rationalToFloatName  = varQual gHC_INTERNAL_FLOAT (fsLit "rationalToFloat") rationalToFloatIdKey
    1301 1255 
     rationalToDoubleName = varQual gHC_INTERNAL_FLOAT (fsLit "rationalToDouble") rationalToDoubleIdKey
    1302 1256
    ... ... @@ -1307,17 +1261,13 @@ ixClassName = clsQual gHC_INTERNAL_IX (fsLit "Ix") ixClassKey
    1307 1261 
     -- Typeable representation types
    1308 1262 
     trModuleTyConName
    1309 1263 
       , trModuleDataConName
    1310 
    -  , trNameTyConName
    1311 1264 
       , trNameSDataConName
    1312 
    -  , trNameDDataConName
    1313 1265 
       , trTyConTyConName
    1314 1266 
       , trTyConDataConName
    1315 1267 
       :: Name
    1316 1268 
     trModuleTyConName     = tcQual gHC_TYPES          (fsLit "Module")         trModuleTyConKey
    1317 1269 
     trModuleDataConName   = dcQual gHC_TYPES          (fsLit "Module")         trModuleDataConKey
    1318 
    -trNameTyConName       = tcQual gHC_TYPES          (fsLit "TrName")         trNameTyConKey
    1319 1270 
     trNameSDataConName    = dcQual gHC_TYPES          (fsLit "TrNameS")        trNameSDataConKey
    1320 
    -trNameDDataConName    = dcQual gHC_TYPES          (fsLit "TrNameD")        trNameDDataConKey
    1321 1271 
     trTyConTyConName      = tcQual gHC_TYPES          (fsLit "TyCon")          trTyConTyConKey
    1322 1272 
     trTyConDataConName    = dcQual gHC_TYPES          (fsLit "TyCon")          trTyConDataConKey
    1323 1273
    ... ... @@ -1328,7 +1278,6 @@ kindRepTyConName
    1328 1278 
       , kindRepFunDataConName
    1329 1279 
       , kindRepTYPEDataConName
    1330 1280 
       , kindRepTypeLitSDataConName
    1331 
    -  , kindRepTypeLitDDataConName
    1332 1281 
       :: Name
    1333 1282 
     kindRepTyConName      = tcQual gHC_TYPES          (fsLit "KindRep")        kindRepTyConKey
    1334 1283 
     kindRepTyConAppDataConName = dcQual gHC_TYPES     (fsLit "KindRepTyConApp") kindRepTyConAppDataConKey
    ... ... @@ -1337,24 +1286,19 @@ kindRepAppDataConName = dcQual gHC_TYPES (fsLit "KindRepApp") kindR
    1337 1286 
     kindRepFunDataConName = dcQual gHC_TYPES          (fsLit "KindRepFun")     kindRepFunDataConKey
    1338 1287 
     kindRepTYPEDataConName = dcQual gHC_TYPES         (fsLit "KindRepTYPE")    kindRepTYPEDataConKey
    1339 1288 
     kindRepTypeLitSDataConName = dcQual gHC_TYPES     (fsLit "KindRepTypeLitS") kindRepTypeLitSDataConKey
    1340 
    -kindRepTypeLitDDataConName = dcQual gHC_TYPES     (fsLit "KindRepTypeLitD") kindRepTypeLitDDataConKey
    1341 1289
    1342 
    -typeLitSortTyConName
    1343 
    -  , typeLitSymbolDataConName
    1290 
    +typeLitSymbolDataConName
    1344 1291 
       , typeLitNatDataConName
    1345 1292 
       , typeLitCharDataConName
    1346 1293 
       :: Name
    1347 
    -typeLitSortTyConName     = tcQual gHC_TYPES       (fsLit "TypeLitSort")    typeLitSortTyConKey
    1348 1294 
     typeLitSymbolDataConName = dcQual gHC_TYPES       (fsLit "TypeLitSymbol")  typeLitSymbolDataConKey
    1349 1295 
     typeLitNatDataConName    = dcQual gHC_TYPES       (fsLit "TypeLitNat")     typeLitNatDataConKey
    1350 1296 
     typeLitCharDataConName   = dcQual gHC_TYPES       (fsLit "TypeLitChar")    typeLitCharDataConKey
    1351 1297
    1352 1298 
     -- Class Typeable, and functions for constructing `Typeable` dictionaries
    1353 1299 
     typeableClassName
    1354 
    -  , typeRepTyConName
    1355 1300 
       , someTypeRepTyConName
    1356 1301 
       , someTypeRepDataConName
    1357 
    -  , mkTrTypeName
    1358 1302 
       , mkTrConName
    1359 1303 
       , mkTrAppCheckedName
    1360 1304 
       , mkTrFunName
    ... ... @@ -1365,11 +1309,9 @@ typeableClassName
    1365 1309 
       , trGhcPrimModuleName
    1366 1310 
       :: Name
    1367 1311 
     typeableClassName     = clsQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "Typeable")       typeableClassKey
    1368 
    -typeRepTyConName      = tcQual  gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "TypeRep")        typeRepTyConKey
    1369 1312 
     someTypeRepTyConName   = tcQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "SomeTypeRep")    someTypeRepTyConKey
    1370 1313 
     someTypeRepDataConName = dcQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "SomeTypeRep")    someTypeRepDataConKey
    1371 1314 
     typeRepIdName         = varQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "typeRep#")       typeRepIdKey
    1372 
    -mkTrTypeName          = varQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "mkTrType")       mkTrTypeKey
    1373 1315 
     mkTrConName           = varQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "mkTrCon")        mkTrConKey
    1374 1316 
     mkTrAppCheckedName    = varQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "mkTrAppChecked") mkTrAppCheckedKey
    1375 1317 
     mkTrFunName           = varQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "mkTrFun")        mkTrFunKey
    ... ... @@ -1494,15 +1436,10 @@ readClassName :: Name
    1494 1436 
     readClassName   = clsQual gHC_INTERNAL_READ (fsLit "Read")      readClassKey
    1495 1437
    1496 1438 
     -- Classes Generic and Generic1, Datatype, Constructor and Selector
    1497 
    -genClassName, gen1ClassName, datatypeClassName, constructorClassName,
    1498 
    -  selectorClassName :: Name
    1439 
    +genClassName, gen1ClassName :: Name
    1499 1440 
     genClassName  = clsQual gHC_INTERNAL_GENERICS (fsLit "Generic")  genClassKey
    1500 1441 
     gen1ClassName = clsQual gHC_INTERNAL_GENERICS (fsLit "Generic1") gen1ClassKey
    1501 1442
    1502 
    -datatypeClassName    = clsQual gHC_INTERNAL_GENERICS (fsLit "Datatype")    datatypeClassKey
    1503 
    -constructorClassName = clsQual gHC_INTERNAL_GENERICS (fsLit "Constructor") constructorClassKey
    1504 
    -selectorClassName    = clsQual gHC_INTERNAL_GENERICS (fsLit "Selector")    selectorClassKey
    1505 
    -
    1506 1443 
     genericClassNames :: [Name]
    1507 1444 
     genericClassNames = [genClassName, gen1ClassName]
    1508 1445
    ... ... @@ -1513,13 +1450,12 @@ ghciStepIoMName = varQual gHC_INTERNAL_GHCI (fsLit "ghciStepIO") ghciStepIoMClas
    1513 1450
    1514 1451 
     -- IO things
    1515 1452 
     ioTyConName, ioDataConName,
    1516 
    -  thenIOName, bindIOName, returnIOName, failIOName :: Name
    1453 
    +  thenIOName, bindIOName, returnIOName :: Name
    1517 1454 
     ioTyConName       = tcQual  gHC_TYPES (fsLit "IO")       ioTyConKey
    1518 1455 
     ioDataConName     = dcQual  gHC_TYPES (fsLit "IO")       ioDataConKey
    1519 1456 
     thenIOName        = varQual gHC_INTERNAL_BASE  (fsLit "thenIO")   thenIOIdKey
    1520 1457 
     bindIOName        = varQual gHC_INTERNAL_BASE  (fsLit "bindIO")   bindIOIdKey
    1521 1458 
     returnIOName      = varQual gHC_INTERNAL_BASE  (fsLit "returnIO") returnIOIdKey
    1522 
    -failIOName        = varQual gHC_INTERNAL_IO    (fsLit "failIO")   failIOIdKey
    1523 1459
    1524 1460 
     -- IO things
    1525 1461 
     printName :: Name
    ... ... @@ -1564,9 +1500,8 @@ choiceAName = varQual gHC_INTERNAL_ARROW (fsLit "|||") choiceAIdKey
    1564 1500 
     loopAName          = varQual gHC_INTERNAL_ARROW (fsLit "loop")      loopAIdKey
    1565 1501
    1566 1502 
     -- Monad comprehensions
    1567 
    -guardMName, liftMName, mzipName :: Name
    1503 
    +guardMName, mzipName :: Name
    1568 1504 
     guardMName         = varQual gHC_INTERNAL_MONAD (fsLit "guard")    guardMIdKey
    1569 
    -liftMName          = varQual gHC_INTERNAL_MONAD (fsLit "liftM")    liftMIdKey
    1570 1505 
     mzipName           = varQual gHC_INTERNAL_CONTROL_MONAD_ZIP (fsLit "mzip") mzipIdKey
    1571 1506
    1572 1507
    ... ... @@ -1654,10 +1589,6 @@ fromStaticPtrName :: Name
    1654 1589 
     fromStaticPtrName =
    1655 1590 
         varQual gHC_INTERNAL_STATICPTR (fsLit "fromStaticPtr") fromStaticPtrClassOpKey
    1656 1591
    1657 
    -fingerprintDataConName :: Name
    1658 
    -fingerprintDataConName =
    1659 
    -    dcQual gHC_INTERNAL_FINGERPRINT_TYPE (fsLit "Fingerprint") fingerprintDataConKey
    1660 
    -
    1661 1592 
     constPtrConName :: Name
    1662 1593 
     constPtrConName =
    1663 1594 
         tcQual gHC_INTERNAL_FOREIGN_C_CONSTPTR (fsLit "ConstPtr") constPtrTyConKey
    ... ... @@ -1753,15 +1684,10 @@ applicativeClassKey = mkPreludeClassUnique 34
    1753 1684 
     foldableClassKey        = mkPreludeClassUnique 35
    1754 1685 
     traversableClassKey     = mkPreludeClassUnique 36
    1755 1686
    1756 
    -genClassKey, gen1ClassKey, datatypeClassKey, constructorClassKey,
    1757 
    -  selectorClassKey :: Unique
    1687 
    +genClassKey, gen1ClassKey :: Unique
    1758 1688 
     genClassKey   = mkPreludeClassUnique 37
    1759 1689 
     gen1ClassKey  = mkPreludeClassUnique 38
    1760 1690
    1761 
    -datatypeClassKey    = mkPreludeClassUnique 39
    1762 
    -constructorClassKey = mkPreludeClassUnique 40
    1763 
    -selectorClassKey    = mkPreludeClassUnique 41
    1764 
    -
    1765 1691 
     -- KnownNat: see Note [KnownNat & KnownSymbol and EvLit] in GHC.Tc.Instance.Class
    1766 1692 
     knownNatClassNameKey :: Unique
    1767 1693 
     knownNatClassNameKey = mkPreludeClassUnique 42
    ... ... @@ -1940,21 +1866,16 @@ pluginTyConKey, frontendPluginTyConKey :: Unique
    1940 1866 
     pluginTyConKey                          = mkPreludeTyConUnique 102
    1941 1867 
     frontendPluginTyConKey                  = mkPreludeTyConUnique 103
    1942 1868
    1943 
    -trTyConTyConKey, trModuleTyConKey, trNameTyConKey,
    1944 
    -  kindRepTyConKey, typeLitSortTyConKey :: Unique
    1869 
    +trTyConTyConKey, trModuleTyConKey,
    1870 
    +  kindRepTyConKey :: Unique
    1945 1871 
     trTyConTyConKey                         = mkPreludeTyConUnique 104
    1946 1872 
     trModuleTyConKey                        = mkPreludeTyConUnique 105
    1947 
    -trNameTyConKey                          = mkPreludeTyConUnique 106
    1948 1873 
     kindRepTyConKey                         = mkPreludeTyConUnique 107
    1949 
    -typeLitSortTyConKey                     = mkPreludeTyConUnique 108
    1950 1874
    1951 1875 
     -- Generics (Unique keys)
    1952 1876 
     v1TyConKey, u1TyConKey, par1TyConKey, rec1TyConKey,
    1953 
    -  k1TyConKey, m1TyConKey, sumTyConKey, prodTyConKey,
    1954 
    -  compTyConKey, rTyConKey, dTyConKey,
    1955 
    -  cTyConKey, sTyConKey, rec0TyConKey,
    1956 
    -  d1TyConKey, c1TyConKey, s1TyConKey,
    1957 
    -  repTyConKey, rep1TyConKey, uRecTyConKey,
    1877 
    +  sumTyConKey, prodTyConKey, compTyConKey, rec0TyConKey,
    1878 
    +  d1TyConKey, c1TyConKey, s1TyConKey, repTyConKey, rep1TyConKey,
    1958 1879 
       uAddrTyConKey, uCharTyConKey, uDoubleTyConKey,
    1959 1880 
       uFloatTyConKey, uIntTyConKey, uWordTyConKey :: Unique
    1960 1881
    ... ... @@ -1962,18 +1883,11 @@ v1TyConKey = mkPreludeTyConUnique 135
    1962 1883 
     u1TyConKey    = mkPreludeTyConUnique 136
    1963 1884 
     par1TyConKey  = mkPreludeTyConUnique 137
    1964 1885 
     rec1TyConKey  = mkPreludeTyConUnique 138
    1965 
    -k1TyConKey    = mkPreludeTyConUnique 139
    1966 
    -m1TyConKey    = mkPreludeTyConUnique 140
    1967 1886
    1968 1887 
     sumTyConKey   = mkPreludeTyConUnique 141
    1969 1888 
     prodTyConKey  = mkPreludeTyConUnique 142
    1970 1889 
     compTyConKey  = mkPreludeTyConUnique 143
    1971 1890
    1972 
    -rTyConKey = mkPreludeTyConUnique 144
    1973 
    -dTyConKey = mkPreludeTyConUnique 146
    1974 
    -cTyConKey = mkPreludeTyConUnique 147
    1975 
    -sTyConKey = mkPreludeTyConUnique 148
    1976 
    -
    1977 1891 
     rec0TyConKey  = mkPreludeTyConUnique 149
    1978 1892 
     d1TyConKey    = mkPreludeTyConUnique 151
    1979 1893 
     c1TyConKey    = mkPreludeTyConUnique 152
    ... ... @@ -1982,7 +1896,6 @@ s1TyConKey = mkPreludeTyConUnique 153
    1982 1896 
     repTyConKey  = mkPreludeTyConUnique 155
    1983 1897 
     rep1TyConKey = mkPreludeTyConUnique 156
    1984 1898
    1985 
    -uRecTyConKey    = mkPreludeTyConUnique 157
    1986 1899 
     uAddrTyConKey   = mkPreludeTyConUnique 158
    1987 1900 
     uCharTyConKey   = mkPreludeTyConUnique 159
    1988 1901 
     uDoubleTyConKey = mkPreludeTyConUnique 160
    ... ... @@ -2026,8 +1939,7 @@ callStackTyConKey :: Unique
    2026 1939 
     callStackTyConKey = mkPreludeTyConUnique 191
    2027 1940
    2028 1941 
     -- Typeables
    2029 
    -typeRepTyConKey, someTypeRepTyConKey, someTypeRepDataConKey :: Unique
    2030 
    -typeRepTyConKey       = mkPreludeTyConUnique 192
    1942 
    +someTypeRepTyConKey, someTypeRepDataConKey :: Unique
    2031 1943 
     someTypeRepTyConKey   = mkPreludeTyConUnique 193
    2032 1944 
     someTypeRepDataConKey = mkPreludeTyConUnique 194
    2033 1945
    ... ... @@ -2159,19 +2071,15 @@ staticPtrDataConKey = mkPreludeDataConUnique 33
    2159 2071 
     staticPtrInfoDataConKey :: Unique
    2160 2072 
     staticPtrInfoDataConKey                 = mkPreludeDataConUnique 34
    2161 2073
    2162 
    -fingerprintDataConKey :: Unique
    2163 
    -fingerprintDataConKey                   = mkPreludeDataConUnique 35
    2164 
    -
    2165 2074 
     srcLocDataConKey :: Unique
    2166 2075 
     srcLocDataConKey                        = mkPreludeDataConUnique 37
    2167 2076
    2168 2077 
     trTyConDataConKey, trModuleDataConKey,
    2169 
    -  trNameSDataConKey, trNameDDataConKey,
    2078 
    +  trNameSDataConKey,
    2170 2079 
       trGhcPrimModuleKey :: Unique
    2171 2080 
     trTyConDataConKey                       = mkPreludeDataConUnique 41
    2172 2081 
     trModuleDataConKey                      = mkPreludeDataConUnique 43
    2173 2082 
     trNameSDataConKey                       = mkPreludeDataConUnique 45
    2174 
    -trNameDDataConKey                       = mkPreludeDataConUnique 46
    2175 2083 
     trGhcPrimModuleKey                      = mkPreludeDataConUnique 47
    2176 2084
    2177 2085 
     typeErrorTextDataConKey,
    ... ... @@ -2246,7 +2154,7 @@ vecElemDataConKeys = map mkPreludeDataConUnique [96..105]
    2246 2154 
     -- Typeable things
    2247 2155 
     kindRepTyConAppDataConKey, kindRepVarDataConKey, kindRepAppDataConKey,
    2248 2156 
         kindRepFunDataConKey, kindRepTYPEDataConKey,
    2249 
    -    kindRepTypeLitSDataConKey, kindRepTypeLitDDataConKey
    2157 
    +    kindRepTypeLitSDataConKey
    2250 2158 
         :: Unique
    2251 2159 
     kindRepTyConAppDataConKey = mkPreludeDataConUnique 106
    2252 2160 
     kindRepVarDataConKey      = mkPreludeDataConUnique 107
    ... ... @@ -2254,7 +2162,6 @@ kindRepAppDataConKey = mkPreludeDataConUnique 108
    2254 2162 
     kindRepFunDataConKey      = mkPreludeDataConUnique 109
    2255 2163 
     kindRepTYPEDataConKey     = mkPreludeDataConUnique 110
    2256 2164 
     kindRepTypeLitSDataConKey = mkPreludeDataConUnique 111
    2257 
    -kindRepTypeLitDDataConKey = mkPreludeDataConUnique 112
    2258 2165
    2259 2166 
     typeLitSymbolDataConKey, typeLitNatDataConKey, typeLitCharDataConKey :: Unique
    2260 2167 
     typeLitSymbolDataConKey   = mkPreludeDataConUnique 113
    ... ... @@ -2342,7 +2249,7 @@ cstringLengthIdKey = mkPreludeMiscIdUnique 28
    2342 2249
    2343 2250 
     concatIdKey, filterIdKey, zipIdKey,
    2344 2251 
         bindIOIdKey, returnIOIdKey, newStablePtrIdKey,
    2345 
    -    printIdKey, failIOIdKey, nullAddrIdKey, voidArgIdKey,
    2252 
    +    printIdKey, nullAddrIdKey, voidArgIdKey,
    2346 2253 
         otherwiseIdKey, assertIdKey :: Unique
    2347 2254 
     concatIdKey                   = mkPreludeMiscIdUnique 31
    2348 2255 
     filterIdKey                   = mkPreludeMiscIdUnique 32
    ... ... @@ -2351,7 +2258,6 @@ bindIOIdKey = mkPreludeMiscIdUnique 34
    2351 2258 
     returnIOIdKey                 = mkPreludeMiscIdUnique 35
    2352 2259 
     newStablePtrIdKey             = mkPreludeMiscIdUnique 36
    2353 2260 
     printIdKey                    = mkPreludeMiscIdUnique 37
    2354 
    -failIOIdKey                   = mkPreludeMiscIdUnique 38
    2355 2261 
     nullAddrIdKey                 = mkPreludeMiscIdUnique 39
    2356 2262 
     voidArgIdKey                  = mkPreludeMiscIdUnique 40
    2357 2263 
     otherwiseIdKey                = mkPreludeMiscIdUnique 43
    ... ... @@ -2390,11 +2296,9 @@ considerAccessibleIdKey = mkPreludeMiscIdUnique 125
    2390 2296 
     noinlineIdKey           = mkPreludeMiscIdUnique 126
    2391 2297 
     noinlineConstraintIdKey = mkPreludeMiscIdUnique 127
    2392 2298
    2393 
    -integerToFloatIdKey, integerToDoubleIdKey, naturalToFloatIdKey, naturalToDoubleIdKey :: Unique
    2299 
    +integerToFloatIdKey, integerToDoubleIdKey :: Unique
    2394 2300 
     integerToFloatIdKey    = mkPreludeMiscIdUnique 128
    2395 2301 
     integerToDoubleIdKey   = mkPreludeMiscIdUnique 129
    2396 
    -naturalToFloatIdKey    = mkPreludeMiscIdUnique 130
    2397 
    -naturalToDoubleIdKey   = mkPreludeMiscIdUnique 131
    2398 2302
    2399 2303 
     rationalToFloatIdKey, rationalToDoubleIdKey :: Unique
    2400 2304 
     rationalToFloatIdKey   = mkPreludeMiscIdUnique 132
    ... ... @@ -2472,9 +2376,8 @@ toIntegerClassOpKey = mkPreludeMiscIdUnique 192
    2472 2376 
     toRationalClassOpKey = mkPreludeMiscIdUnique 193
    2473 2377
    2474 2378 
     -- Monad comprehensions
    2475 
    -guardMIdKey, liftMIdKey, mzipIdKey :: Unique
    2379 
    +guardMIdKey, mzipIdKey :: Unique
    2476 2380 
     guardMIdKey     = mkPreludeMiscIdUnique 194
    2477 
    -liftMIdKey      = mkPreludeMiscIdUnique 195
    2478 2381 
     mzipIdKey       = mkPreludeMiscIdUnique 196
    2479 2382
    2480 2383 
     -- GHCi
    ... ... @@ -2497,7 +2400,6 @@ proxyHashKey = mkPreludeMiscIdUnique 502
    2497 2400
    2498 2401 
     -- Used to make `Typeable` dictionaries
    2499 2402 
     mkTyConKey
    2500 
    -  , mkTrTypeKey
    2501 2403 
       , mkTrConKey
    2502 2404 
       , mkTrAppCheckedKey
    2503 2405 
       , mkTrFunKey
    ... ... @@ -2507,7 +2409,6 @@ mkTyConKey
    2507 2409 
       , typeRepIdKey
    2508 2410 
       :: Unique
    2509 2411 
     mkTyConKey            = mkPreludeMiscIdUnique 503
    2510 
    -mkTrTypeKey           = mkPreludeMiscIdUnique 504
    2511 2412 
     mkTrConKey            = mkPreludeMiscIdUnique 505
    2512 2413 
     mkTrAppCheckedKey     = mkPreludeMiscIdUnique 506
    2513 2414 
     typeNatTypeRepKey     = mkPreludeMiscIdUnique 507
    ... ... @@ -2620,18 +2521,12 @@ integerFromNaturalIdKey
    2620 2521 
        , naturalQuotIdKey
    2621 2522 
        , naturalRemIdKey
    2622 2523 
        , naturalAndIdKey
    2623 
    -   , naturalAndNotIdKey
    2624 2524 
        , naturalOrIdKey
    2625 2525 
        , naturalXorIdKey
    2626 2526 
        , naturalTestBitIdKey
    2627 2527 
        , naturalBitIdKey
    2628 2528 
        , naturalGcdIdKey
    2629 2529 
        , naturalLcmIdKey
    2630 
    -   , naturalLog2IdKey
    2631 
    -   , naturalLogBaseWordIdKey
    2632 
    -   , naturalLogBaseIdKey
    2633 
    -   , naturalPowModIdKey
    2634 
    -   , naturalSizeInBaseIdKey
    2635 2530 
        , bignatEqIdKey
    2636 2531 
        , bignatCompareIdKey
    2637 2532 
        , bignatCompareWordIdKey
    ... ... @@ -2686,18 +2581,12 @@ naturalQuotRemIdKey = mkPreludeMiscIdUnique 669
    2686 2581 
     naturalQuotIdKey           = mkPreludeMiscIdUnique 670
    2687 2582 
     naturalRemIdKey            = mkPreludeMiscIdUnique 671
    2688 2583 
     naturalAndIdKey            = mkPreludeMiscIdUnique 672
    2689 
    -naturalAndNotIdKey         = mkPreludeMiscIdUnique 673
    2690 2584 
     naturalOrIdKey             = mkPreludeMiscIdUnique 674
    2691 2585 
     naturalXorIdKey            = mkPreludeMiscIdUnique 675
    2692 2586 
     naturalTestBitIdKey        = mkPreludeMiscIdUnique 676
    2693 2587 
     naturalBitIdKey            = mkPreludeMiscIdUnique 677
    2694 2588 
     naturalGcdIdKey            = mkPreludeMiscIdUnique 678
    2695 2589 
     naturalLcmIdKey            = mkPreludeMiscIdUnique 679
    2696 
    -naturalLog2IdKey           = mkPreludeMiscIdUnique 680
    2697 
    -naturalLogBaseWordIdKey    = mkPreludeMiscIdUnique 681
    2698 
    -naturalLogBaseIdKey        = mkPreludeMiscIdUnique 682
    2699 
    -naturalPowModIdKey         = mkPreludeMiscIdUnique 683
    2700 
    -naturalSizeInBaseIdKey     = mkPreludeMiscIdUnique 684
    2701 2590
    2702 2591 
     bignatEqIdKey              = mkPreludeMiscIdUnique 691
    2703 2592 
     bignatCompareIdKey         = mkPreludeMiscIdUnique 692

  • compiler/GHC/HsToCore/Foreign/Wasm.hs
    ... ... @@ -224,6 +224,25 @@ especially since leaving all the boxing/unboxing business to C unifies
    224 224 
     the implementation of JSFFI imports and exports
    225 225 
     (rts_mkJSVal/rts_getJSVal).
    226 226
    227 
    +We don't support unboxed FFI types like Int# etc. But we do support
    228 
    +one kind of unlifted FFI type for JSFFI import arguments:
    229 
    +ByteArray#/MutableByteArray#. The semantics is the same in C: the
    230 
    +pointer to the ByteArray# payload is passed instead of the ByteArray#
    231 
    +closure itself. This allows efficient zero-copy data exchange between
    232 
    +Haskell and JavaScript using unpinned ByteArray#, and the following
    233 
    +conditions must be met:
    234 
    +
    235 
    +- The JSFFI import itself must be a sync import marked as unsafe
    236 
    +- The JavaScript code must not re-enter Haskell when a ByteArray# is
    237 
    +  passed as argument
    238 
    +
    239 
    +There's no magic in the handling of ByteArray#/MutableByteArray#
    240 
    +arguments. When generating C stub, we treat them like Ptr that points
    241 
    +to the payload, just without the rts_getPtr() unboxing call. After
    242 
    +lowering to C import, the backend takes care of adding the offset, see
    243 
    +add_shim in GHC.StgToCmm.Foreign and
    244 
    +Note [Unlifted boxed arguments to foreign calls].
    245 
    +
    227 246 
     Now, each sync import calls a generated C function with a unique
    228 247 
     symbol. The C function uses rts_get* to unbox the arguments, call into
    229 248 
     JavaScript, then boxes the result with rts_mk* and returns it to
    ... ... @@ -517,8 +536,9 @@ importCStub sync cfun_name arg_tys res_ty js_src = CStub c_doc [] []
    517 536 
         cfun_ret
    518 537 
           | res_ty `eqType` unitTy = cfun_call_import <> semi
    519 538 
           | otherwise = text "return" <+> cfun_call_import <> semi
    520 
    -    cfun_make_arg arg_ty arg_val =
    521 
    -      text ("rts_get" ++ ffiType arg_ty) <> parens arg_val
    539 
    +    cfun_make_arg arg_ty arg_val
    540 
    +      | isByteArrayPrimTy arg_ty = arg_val
    541 
    +      | otherwise = text ("rts_get" ++ ffiType arg_ty) <> parens arg_val
    522 542 
         cfun_make_ret ret_val
    523 543 
           | res_ty `eqType` unitTy = ret_val
    524 544 
           | otherwise =
    ... ... @@ -543,7 +563,11 @@ importCStub sync cfun_name arg_tys res_ty js_src = CStub c_doc [] []
    543 563 
           | res_ty `eqType` unitTy = text "void"
    544 564 
           | otherwise = text "HaskellObj"
    545 565 
         cfun_arg_list =
    546 
    -      [text "HaskellObj" <+> char 'a' <> int n | n <- [1 .. length arg_tys]]
    566 
    +      [ text (if isByteArrayPrimTy arg_ty then "HsPtr" else "HaskellObj")
    567 
    +          <+> char 'a'
    568 
    +          <> int n
    569 
    +      | (arg_ty, n) <- zip arg_tys [1 ..]
    570 
    +      ]
    547 571 
         cfun_args = case cfun_arg_list of
    548 572 
           [] -> text "void"
    549 573 
           _ -> hsep $ punctuate comma cfun_arg_list
    ... ... @@ -746,8 +770,18 @@ lookupGhcInternalTyCon m t = do
    746 770 
       n <- lookupOrig (mkGhcInternalModule m) (mkTcOcc t)
    747 771 
       dsLookupTyCon n
    748 772
    773 
    +isByteArrayPrimTy :: Type -> Bool
    774 
    +isByteArrayPrimTy ty
    775 
    +  | Just tc <- tyConAppTyCon_maybe ty,
    776 
    +    tc == byteArrayPrimTyCon || tc == mutableByteArrayPrimTyCon =
    777 
    +      True
    778 
    +  | otherwise =
    779 
    +      False
    780 
    +
    749 781 
     ffiType :: Type -> String
    750 
    -ffiType = occNameString . getOccName . fst . splitTyConApp
    782 
    +ffiType ty
    783 
    +  | isByteArrayPrimTy ty = "Ptr"
    784 
    +  | otherwise = occNameString $ getOccName $ tyConAppTyCon ty
    751 785
    752 786 
     commonCDecls :: SDoc
    753 787 
     commonCDecls =

  • compiler/GHC/Parser/String.hs
    ... ... @@ -19,6 +19,7 @@ import Data.Char (chr, ord)
    19 19 
     import qualified Data.Foldable1 as Foldable1
    20 20 
     import qualified Data.List.NonEmpty as NonEmpty
    21 21 
     import Data.Maybe (listToMaybe, mapMaybe)
    22 
    +import GHC.Data.OrdList (fromOL, nilOL, snocOL)
    22 23 
     import GHC.Data.StringBuffer (StringBuffer)
    23 24 
     import qualified GHC.Data.StringBuffer as StringBuffer
    24 25 
     import GHC.Parser.CharClass (
    ... ... @@ -167,16 +168,16 @@ collapseGaps = go
    167 168 
           [] -> panic "gap unexpectedly ended"
    168 169
    169 170 
     resolveEscapes :: HasChar c => [c] -> Either (c, LexErr) [c]
    170 
    -resolveEscapes = go dlistEmpty
    171 
    +resolveEscapes = go nilOL
    171 172 
       where
    172 173 
         go !acc = \case
    173 
    -      [] -> pure $ dlistToList acc
    174 
    +      [] -> pure $ fromOL acc
    174 175 
           Char '\\' : Char '&' : cs -> go acc cs
    175 176 
           backslash@(Char '\\') : cs ->
    176 177 
             case resolveEscapeChar cs of
    177 
    -          Right (esc, cs') -> go (acc `dlistSnoc` setChar esc backslash) cs'
    178 
    +          Right (esc, cs') -> go (acc `snocOL` setChar esc backslash) cs'
    178 179 
               Left (c, e) -> Left (c, e)
    179 
    -      c : cs -> go (acc `dlistSnoc` c) cs
    180 
    +      c : cs -> go (acc `snocOL` c) cs
    180 181
    181 182 
     -- -----------------------------------------------------------------------------
    182 183 
     -- Escape characters
    ... ... @@ -420,17 +421,3 @@ It's more precisely defined with the following algorithm:
    420 421 
         * Lines with only whitespace characters
    421 422 
     3. Calculate the longest prefix of whitespace shared by all lines in the remaining list
    422 423 
     -}
    423 
    -
    424 
    --- -----------------------------------------------------------------------------
    425 
    --- DList
    426 
    -
    427 
    -newtype DList a = DList ([a] -> [a])
    428 
    -
    429 
    -dlistEmpty :: DList a
    430 
    -dlistEmpty = DList id
    431 
    -
    432 
    -dlistToList :: DList a -> [a]
    433 
    -dlistToList (DList f) = f []
    434 
    -
    435 
    -dlistSnoc :: DList a -> a -> DList a
    436 
    -dlistSnoc (DList f) x = DList (f . (x :))

  • compiler/GHC/StgToCmm/InfoTableProv.hs
    ... ... @@ -11,6 +11,7 @@ import GHC.IO (unsafePerformIO)
    11 11 
     #endif
    12 12
    13 13 
     import Data.Char
    14 
    +import Data.Foldable
    14 15 
     import GHC.Prelude
    15 16 
     import GHC.Platform
    16 17 
     import GHC.Types.SrcLoc (pprUserRealSpan, srcSpanFile)
    ... ... @@ -18,6 +19,7 @@ import GHC.Types.Unique.DSM
    18 19 
     import GHC.Unit.Module
    19 20 
     import GHC.Utils.Outputable
    20 21 
     import GHC.Data.FastString (fastStringToShortText, unpackFS, LexicalFastString(..))
    22 
    +import GHC.Data.OrdList (OrdList, nilOL, snocOL)
    21 23
    22 24 
     import GHC.Cmm
    23 25 
     import GHC.Cmm.CLabel
    ... ... @@ -286,7 +288,7 @@ data CgInfoProvEnt = CgInfoProvEnt
    286 288 
                                    , ipeSrcSpan :: !StrTabOffset
    287 289 
                                    }
    288 290
    289 
    -data StringTable = StringTable { stStrings :: DList ShortText
    291 
    +data StringTable = StringTable { stStrings :: !(OrdList ShortText)
    290 292 
                                    , stLength :: !Int
    291 293 
                                    , stLookup :: !(M.Map ShortText StrTabOffset)
    292 294 
                                    }
    ... ... @@ -295,7 +297,7 @@ type StrTabOffset = Word32
    295 297
    296 298 
     emptyStringTable :: StringTable
    297 299 
     emptyStringTable =
    298 
    -    StringTable { stStrings = emptyDList
    300 
    +    StringTable { stStrings = nilOL
    299 301 
                     , stLength = 0
    300 302 
                     , stLookup = M.empty
    301 303 
                     }
    ... ... @@ -303,7 +305,7 @@ emptyStringTable =
    303 305 
     getStringTableStrings :: StringTable -> BS.ByteString
    304 306 
     getStringTableStrings st =
    305 307 
         BSL.toStrict $ BSB.toLazyByteString
    306 
    -    $ foldMap f $ dlistToList (stStrings st)
    308 
    +    $ foldMap' f $ stStrings st
    307 309 
       where
    308 310 
         f x = BSB.shortByteString (ST.contents x) `mappend` BSB.word8 0
    309 311
    ... ... @@ -312,7 +314,7 @@ lookupStringTable str = state $ \st ->
    312 314 
         case M.lookup str (stLookup st) of
    313 315 
           Just off -> (off, st)
    314 316 
           Nothing ->
    315 
    -          let !st' = st { stStrings = stStrings st `snoc` str
    317 
    +          let !st' = st { stStrings = stStrings st `snocOL` str
    316 318 
                             , stLength  = stLength st + ST.byteLength str + 1
    317 319 
                             , stLookup  = M.insert str res (stLookup st)
    318 320 
                             }
    ... ... @@ -359,14 +361,3 @@ foreign import ccall unsafe "ZSTD_compressBound"
    359 361
    360 362 
     defaultCompressionLevel :: Int
    361 363 
     defaultCompressionLevel = 3
    362 
    -
    363 
    -newtype DList a = DList ([a] -> [a])
    364 
    -
    365 
    -emptyDList :: DList a
    366 
    -emptyDList = DList id
    367 
    -
    368 
    -snoc :: DList a -> a -> DList a
    369 
    -snoc (DList f) x = DList (f . (x:))
    370 
    -
    371 
    -dlistToList :: DList a -> [a]
    372 
    -dlistToList (DList f) = f []

  • docs/users_guide/wasm.rst
    ... ... @@ -265,7 +265,7 @@ backend’s JavaScript FFI, which we’ll now abbreviate as JSFFI.
    265 265 
     Marshalable types and ``JSVal``
    266 266 
     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    267 267
    268 
    -JSFFI supports all boxed marshalable foreign types in C FFI:
    268 
    +JSFFI supports all lifted marshalable foreign types in C FFI:
    269 269
    270 270 
     -  ``Bool``
    271 271 
     -  ``Char``
    ... ... @@ -298,8 +298,14 @@ types in JSFFI. Some caveats to keep in mind:
    298 298 
        results in type errors, so keep this in mind. As for ``Int`` /
    299 299 
        ``Word``, they are 32-bit since the GHC wasm backend is based on
    300 300 
        ``wasm32`` .
    301 
    --  JSFFI doesn’t support unboxed foreign types like ``Int#``,
    302 
    -   ``ByteArray#``, etc, even when ``UnliftedFFITypes`` is enabled.
    301 
    +-  JSFFI doesn’t support unboxed foreign types like ``Int#``, even
    302 
    +   when ``UnliftedFFITypes`` is enabled. The only supported unlifted
    303 
    +   types are ``ByteArray#`` and ``MutableByteArray#``, they may only
    304 
    +   be used as JSFFI import argument types, with the same semantics in
    305 
    +   C FFI: the pointer to the payload is passed to JavaScript. Be
    306 
    +   careful and avoid calling back into Haskell in such cases,
    307 
    +   otherwise GC may occur and the pointer may be invalidated if it's
    308 
    +   unpinned!
    303 309
    304 310 
     In addition to the above types, JSFFI supports the ``JSVal`` type and
    305 311 
     its ``newtype``\ s as argument/result types. ``JSVal`` is defined in

  • hadrian/doc/flavours.md
    ... ... @@ -242,6 +242,10 @@ The supported transformers are listed below:
    242 242 
             <td><code>ubsan</code></td>
    243 243 
             <td>Build all stage1+ C/C++ code with UndefinedBehaviorSanitizer support</td>
    244 244 
         </tr>
    245 
    +    <tr>
    246 
    +        <td><code>asan</code></td>
    247 
    +        <td>Build all stage1+ C/C++ code with AddressSanitizer support</td>
    248 
    +    </tr>
    245 249 
         <tr>
    246 250 
             <td><code>llvm</code></td>
    247 251 
             <td>Use GHC's LLVM backend (`-fllvm`) for all stage1+ compilation.</td>
    ... ... @@ -249,10 +253,6 @@ The supported transformers are listed below:
    249 253 
         <tr>
    250 254 
             <td><code>profiled_ghc</code></td>
    251 255 
             <td>Build the GHC executable with cost-centre profiling support.
    252 
    -            It is recommended that you use this in conjunction with `no_dynamic_ghc` since
    253 
    -            GHC does not support loading of profiled libraries with the
    254 
    -            dynamic linker. You should use a flavour that builds profiling libs and rts,
    255 
    -            i.e. not <code>quick</code>. <br>
    256 256 
                 This flag adds cost centres with the -fprof-late flag.</td>
    257 257 
         </tr>
    258 258 
         <tr>
    ... ... @@ -274,6 +274,10 @@ The supported transformers are listed below:
    274 274 
             <td><code>text_simdutf</code></td>
    275 275 
             <td>Enable building the <code>text</code> package with <code>simdutf</code> support.</td>
    276 276 
         </tr>
    277 
    +    <tr>
    278 
    +        <td><code>with_profiled_libs</code></td>
    279 
    +        <td>Enables building of stage1+ libraries and the RTS in profiled build ways (the opposite of <code>no_profiled_libs</code>).</td>
    280 
    +    </tr>
    277 281 
         <tr>
    278 282 
             <td><code>no_profiled_libs</code></td>
    279 283 
             <td>Disables building of libraries in profiled build ways.</td>

  • hadrian/src/Flavour.hs
    ... ... @@ -8,6 +8,7 @@ module Flavour
    8 8 
       , splitSections
    9 9 
       , enableThreadSanitizer
    10 10 
       , enableUBSan
    11 
    +  , enableASan
    11 12 
       , enableLateCCS
    12 13 
       , enableHashUnitIds
    13 14 
       , enableDebugInfo, enableTickyGhc
    ... ... @@ -15,6 +16,7 @@ module Flavour
    15 16 
       , enableProfiledGhc
    16 17 
       , disableDynamicGhcPrograms
    17 18 
       , disableDynamicLibs
    19 
    +  , enableProfiledLibs
    18 20 
       , disableProfiledLibs
    19 21 
       , enableLinting
    20 22 
       , enableHaddock
    ... ... @@ -56,12 +58,14 @@ flavourTransformers = M.fromList
    56 58 
         , "thread_sanitizer" =: enableThreadSanitizer False
    57 59 
         , "thread_sanitizer_cmm" =: enableThreadSanitizer True
    58 60 
         , "ubsan"            =: enableUBSan
    61 
    +    , "asan"             =: enableASan
    59 62 
         , "llvm"             =: viaLlvmBackend
    60 63 
         , "profiled_ghc"     =: enableProfiledGhc
    61 64 
         , "no_dynamic_ghc"   =: disableDynamicGhcPrograms
    62 65 
         , "no_dynamic_libs"  =: disableDynamicLibs
    63 66 
         , "native_bignum"    =: useNativeBignum
    64 67 
         , "text_simdutf"     =: enableTextWithSIMDUTF
    68 
    +    , "with_profiled_libs" =: enableProfiledLibs
    65 69 
         , "no_profiled_libs" =: disableProfiledLibs
    66 70 
         , "omit_pragmas"     =: omitPragmas
    67 71 
         , "ipe"              =: enableIPE
    ... ... @@ -169,6 +173,7 @@ enableDebugInfo :: Flavour -> Flavour
    169 173 
     enableDebugInfo = addArgs $ notStage0 ? mconcat
    170 174 
         [ builder (Ghc CompileHs) ? pure ["-g3"]
    171 175 
         , builder (Ghc CompileCWithGhc) ? pure ["-optc-g3"]
    176 
    +    , builder (Ghc CompileCppWithGhc) ? pure ["-optcxx-g3"]
    172 177 
         , builder (Cc CompileC) ? arg "-g3"
    173 178 
         , builder (Cabal Setup) ? arg "--disable-library-stripping"
    174 179 
         , builder (Cabal Setup) ? arg "--disable-executable-stripping"
    ... ... @@ -303,33 +308,51 @@ enableUBSan =
    303 308 
               builder Testsuite ? arg "--config=have_ubsan=True"
    304 309 
             ]
    305 310
    311 
    +-- | Build all stage1+ C/C++ code with AddressSanitizer support:
    312 
    +-- https://clang.llvm.org/docs/AddressSanitizer.html
    313 
    +enableASan :: Flavour -> Flavour
    314 
    +enableASan =
    315 
    +  addArgs $
    316 
    +    notStage0
    317 
    +      ? mconcat
    318 
    +        [ package rts
    319 
    +            ? builder (Cabal Flags)
    320 
    +            ? arg "+asan"
    321 
    +            <> (needSharedLibSAN ? arg "+shared-libsan"),
    322 
    +          builder (Ghc CompileHs)
    323 
    +            ? arg "-optc-Og"
    324 
    +            <> arg "-optc-fno-omit-frame-pointer"
    325 
    +            <> arg "-optc-fsanitize=address",
    326 
    +          builder (Ghc CompileCWithGhc)
    327 
    +            ? ((not <$> input "**/Hash.c") ? arg "-optc-Og")
    328 
    +            <> arg "-optc-fno-omit-frame-pointer"
    329 
    +            <> arg "-optc-fsanitize=address",
    330 
    +          builder (Ghc CompileCppWithGhc)
    331 
    +            ? arg "-optcxx-Og"
    332 
    +            <> arg "-optcxx-fno-omit-frame-pointer"
    333 
    +            <> arg "-optcxx-fsanitize=address",
    334 
    +          builder (Ghc LinkHs)
    335 
    +            ? arg "-optc-Og"
    336 
    +            <> arg "-optc-fno-omit-frame-pointer"
    337 
    +            <> arg "-optc-fsanitize=address"
    338 
    +            <> arg "-optl-fsanitize=address"
    339 
    +            <> (needSharedLibSAN ? arg "-optl-shared-libsan"),
    340 
    +          builder (Cc CompileC)
    341 
    +            ? arg "-Og"
    342 
    +            <> arg "-fno-omit-frame-pointer"
    343 
    +            <> arg "-fsanitize=address",
    344 
    +          builder Testsuite ? arg "--config=have_asan=True"
    345 
    +        ]
    346 
    +
    306 347 
     -- | Use the LLVM backend in stages 1 and later.
    307 348 
     viaLlvmBackend :: Flavour -> Flavour
    308 349 
     viaLlvmBackend = addArgs $ notStage0 ? builder Ghc ? arg "-fllvm"
    309 350
    310 
    --- | Build the GHC executable with profiling enabled in stages 2 and later. It
    311 
    --- is also recommended that you use this with @'dynamicGhcPrograms' = False@
    312 
    --- since GHC does not support loading of profiled libraries with the
    313 
    --- dynamically-linker.
    351 
    +-- | Build the GHC executable with profiling enabled in stages 2 and
    352 
    +-- later.
    314 353 
     enableProfiledGhc :: Flavour -> Flavour
    315 354 
     enableProfiledGhc flavour =
    316 
    -  enableLateCCS flavour
    317 
    -    { rtsWays = do
    318 
    -        ws <- rtsWays flavour
    319 
    -        mconcat
    320 
    -          [ pure ws
    321 
    -          , buildingCompilerStage' (>= Stage2) ? pure (foldMap profiled_ways ws)
    322 
    -          ]
    323 
    -    , libraryWays = mconcat
    324 
    -        [ libraryWays flavour
    325 
    -        , buildingCompilerStage' (>= Stage2) ? pure (Set.singleton profiling)
    326 
    -        ]
    327 
    -    , ghcProfiled = (>= Stage2)
    328 
    -    }
    329 
    -    where
    330 
    -      profiled_ways w
    331 
    -        | wayUnit Dynamic w = Set.empty
    332 
    -        | otherwise         = Set.singleton (w <> profiling)
    355 
    +  enableLateCCS $ enableProfiledLibs flavour { ghcProfiled = (>= Stage2) }
    333 356
    334 357 
     -- | Disable 'dynamicGhcPrograms'.
    335 358 
     disableDynamicGhcPrograms :: Flavour -> Flavour
    ... ... @@ -346,6 +369,20 @@ disableDynamicLibs flavour =
    346 369 
         prune :: Ways -> Ways
    347 370 
         prune = fmap $ Set.filter (not . wayUnit Dynamic)
    348 371
    372 
    +-- | Build libraries and the RTS in profiled ways (opposite of
    373 
    +-- 'disableProfiledLibs').
    374 
    +enableProfiledLibs :: Flavour -> Flavour
    375 
    +enableProfiledLibs flavour =
    376 
    +  flavour
    377 
    +    { libraryWays = addProfilingWays $ libraryWays flavour,
    378 
    +      rtsWays = addProfilingWays $ rtsWays flavour
    379 
    +    }
    380 
    +  where
    381 
    +    addProfilingWays :: Ways -> Ways
    382 
    +    addProfilingWays ways = do
    383 
    +      ws <- ways
    384 
    +      buildProfiled <- notStage0
    385 
    +      pure $ if buildProfiled then ws <> Set.map (<> profiling) ws else ws
    349 386
    350 387 
     -- | Don't build libraries in profiled 'Way's.
    351 388 
     disableProfiledLibs :: Flavour -> Flavour

  • hadrian/src/Settings/Packages.hs
    ... ... @@ -351,7 +351,7 @@ rtsPackageArgs = package rts ? do
    351 351 
               , Debug     `wayUnit` way          ? pure [ "-DDEBUG"
    352 352 
                                                         , "-fno-omit-frame-pointer"
    353 353 
                                                         , "-g3"
    354 
    -                                                    , "-O0" ]
    354 
    +                                                    , "-Og" ]
    355 355 
               -- Set the namespace for the rts fs functions
    356 356 
               , arg $ "-DFS_NAMESPACE=rts"
    357 357

  • libraries/ghc-internal/src/GHC/Internal/IO/Handle.hs
    ... ... @@ -480,7 +480,7 @@ hIsOpen handle =
    480 480 
           SemiClosedHandle     -> return False
    481 481 
           _                    -> return True
    482 482
    483 
    --- | @'hIsOpen' hdl@ returns whether the handle is closed.
    483 
    +-- | @'hIsClosed' hdl@ returns whether the handle is closed.
    484 484 
     -- If the 'haType' of @hdl@ is 'ClosedHandle' this returns 'True'
    485 485 
     -- and 'False' otherwise.
    486 486 
     hIsClosed :: Handle -> IO Bool

  • rts/.ubsan-suppressions
    1 
    +# libraries/bytestring/cbits/is-valid-utf8.c:66:14: runtime load of misaligned address 0x7ae45206f112 for type 'const uint64_t *' (aka 'const unsigned long *'), which requires 8 byte alignment
    2 
    +alignment:libraries/bytestring/cbits/is-valid-utf8.c
    3 
    +
    1 4 
     # libraries/text/cbits/measure_off.c:50:39: runtime left shift of 1 by 31 places cannot be represented in type 'int'
    2 5 
     shift-base:libraries/text/cbits/measure_off.c
    3 6

  • rts/Task.c
    ... ... @@ -183,6 +183,7 @@ freeTask (Task *task)
    183 183 
             stgFree(incall);
    184 184 
         }
    185 185 
         for (incall = task->spare_incalls; incall != NULL; incall = next) {
    186 
    +        __ghc_asan_unpoison_memory_region(incall, sizeof(InCall));
    186 187 
             next = incall->next;
    187 188 
             stgFree(incall);
    188 189 
         }
    ... ... @@ -252,6 +253,7 @@ newInCall (Task *task)
    252 253
    253 254 
         if (task->spare_incalls != NULL) {
    254 255 
             incall = task->spare_incalls;
    256 
    +        __ghc_asan_unpoison_memory_region(incall, sizeof(InCall));
    255 257 
             task->spare_incalls = incall->next;
    256 258 
             task->n_spare_incalls--;
    257 259 
         } else {
    ... ... @@ -283,6 +285,7 @@ endInCall (Task *task)
    283 285 
             stgFree(incall);
    284 286 
         } else {
    285 287 
             incall->next = task->spare_incalls;
    288 
    +        __ghc_asan_poison_memory_region(incall, sizeof(InCall));
    286 289 
             task->spare_incalls = incall;
    287 290 
             task->n_spare_incalls++;
    288 291 
         }

  • rts/include/Stg.h
    ... ... @@ -335,6 +335,7 @@ external prototype return neither of these types to workaround #11395.
    335 335 
     #include "stg/MachRegsForHost.h"
    336 336 
     #include "stg/Regs.h"
    337 337 
     #include "stg/Ticky.h"
    338 
    +#include "rts/ASANUtils.h"
    338 339 
     #include "rts/TSANUtils.h"
    339 340
    340 341 
     #if IN_STG_CODE

  • rts/include/rts/ASANUtils.h
    1 
    +#pragma once
    2 
    +
    3 
    +#if defined(__SANITIZE_ADDRESS__)
    4 
    +#define ASAN_ENABLED
    5 
    +#elif defined(__has_feature)
    6 
    +#if __has_feature(address_sanitizer)
    7 
    +#define ASAN_ENABLED
    8 
    +#endif
    9 
    +#endif
    10 
    +
    11 
    +#if defined(ASAN_ENABLED)
    12 
    +#include <sanitizer/asan_interface.h>
    13 
    +#define USED_IF_ASAN
    14 
    +#else
    15 
    +#include <stdlib.h>
    16 
    +#define USED_IF_ASAN __attribute__((unused))
    17 
    +#endif
    18 
    +
    19 
    +static inline void
    20 
    +__ghc_asan_poison_memory_region(void const volatile *addr USED_IF_ASAN,
    21 
    +                                size_t size USED_IF_ASAN) {
    22 
    +#if defined(ASAN_ENABLED)
    23 
    +  __asan_poison_memory_region(addr, size);
    24 
    +#endif
    25 
    +}
    26 
    +
    27 
    +static inline void
    28 
    +__ghc_asan_unpoison_memory_region(void const volatile *addr USED_IF_ASAN,
    29 
    +                                  size_t size USED_IF_ASAN) {
    30 
    +#if defined(ASAN_ENABLED)
    31 
    +  __asan_unpoison_memory_region(addr, size);
    32 
    +#endif
    33 
    +}

  • rts/linker/InitFini.c
    ... ... @@ -75,7 +75,7 @@ static void sortInitFiniList(struct InitFiniList **slist, enum SortOrder order)
    75 75 
             while (*last != NULL && (*last)->next != NULL) {
    76 76 
                 struct InitFiniList *s0 = *last;
    77 77 
                 struct InitFiniList *s1 = s0->next;
    78 
    -            bool flip;
    78 
    +            bool flip = false;
    79 79 
                 switch (order) {
    80 80 
                     case INCREASING: flip = s0->priority > s1->priority; break;
    81 81 
                     case DECREASING: flip = s0->priority < s1->priority; break;

  • rts/rts.cabal
    ... ... @@ -97,6 +97,12 @@ flag ubsan
    97 97 
         UndefinedBehaviorSanitizer.
    98 98 
       default: False
    99 99 
       manual: True
    100 
    +flag asan
    101 
    +  description:
    102 
    +    Link with -fsanitize=address, to be enabled when building with
    103 
    +    AddressSanitizer.
    104 
    +  default: False
    105 
    +  manual: True
    100 106 
     flag shared-libsan
    101 107 
       description:
    102 108 
         Link with -shared-libsan, to guarantee only one copy of the
    ... ... @@ -216,6 +222,9 @@ library
    216 222 
           if flag(ubsan)
    217 223 
             ld-options: -fsanitize=undefined
    218 224
    225 
    +      if flag(asan)
    226 
    +        ld-options: -fsanitize=address
    227 
    +
    219 228 
           if flag(shared-libsan)
    220 229 
             ld-options: -shared-libsan
    221 230
    ... ... @@ -280,6 +289,7 @@ library
    280 289 
                             -- ^ generated
    281 290 
                             rts/ghc_ffi.h
    282 291 
                             rts/Adjustor.h
    292 
    +                        rts/ASANUtils.h
    283 293 
                             rts/ExecPage.h
    284 294 
                             rts/BlockSignals.h
    285 295 
                             rts/Bytecodes.h

  • rts/sm/MBlock.c
    ... ... @@ -579,6 +579,8 @@ getMBlocks(uint32_t n)
    579 579
    580 580 
         ret = getCommittedMBlocks(n);
    581 581
    582 
    +    __ghc_asan_unpoison_memory_region(ret, (W_)n * MBLOCK_SIZE);
    583 
    +
    582 584 
         debugTrace(DEBUG_gc, "allocated %d megablock(s) at %p",n,ret);
    583 585
    584 586 
         mblocks_allocated += n;
    ... ... @@ -611,6 +613,8 @@ freeMBlocks(void *addr, uint32_t n)
    611 613
    612 614 
         mblocks_allocated -= n;
    613 615
    616 
    +    __ghc_asan_poison_memory_region(addr, (W_)n * MBLOCK_SIZE);
    617 
    +
    614 618 
         decommitMBlocks(addr, n);
    615 619 
     }
    616 620

  • rts/sm/Sanity.c
    ... ... @@ -692,7 +692,7 @@ checkCompactObjects(bdescr *bd)
    692 692 
             ASSERT((W_)str == (W_)block + sizeof(StgCompactNFDataBlock));
    693 693
    694 694 
             StgWord totalW = 0;
    695 
    -        StgCompactNFDataBlock *last;
    695 
    +        StgCompactNFDataBlock *last = block;
    696 696 
             for ( ; block ; block = block->next) {
    697 697 
                 last = block;
    698 698 
                 ASSERT(block->owner == str);

  • testsuite/driver/testglobals.py
    ... ... @@ -189,6 +189,9 @@ class TestConfig:
    189 189 
             # Are we running with UndefinedBehaviorSanitizer enabled?
    190 190 
             self.have_ubsan = False
    191 191
    192 
    +        # Are we running with AddressSanitizer enabled?
    193 
    +        self.have_asan = False
    194 
    +
    192 195 
             # Do symbols use leading underscores?
    193 196 
             self.leading_underscore = False
    194 197

  • testsuite/driver/testlib.py
    ... ... @@ -1093,6 +1093,9 @@ def have_thread_sanitizer( ) -> bool:
    1093 1093 
     def have_ubsan( ) -> bool:
    1094 1094 
         return config.have_ubsan
    1095 1095
    1096 
    +def have_asan( ) -> bool:
    1097 
    +    return config.have_asan
    1098 
    +
    1096 1099 
     def gcc_as_cmmp() -> bool:
    1097 1100 
         return config.cmm_cpp_is_gcc
    1098 1101

  • testsuite/tests/ffi/should_run/all.T
    ... ... @@ -192,6 +192,9 @@ test('rts_clearMemory', [
    192 192 
          extra_ways(['g1', 'nursery_chunks', 'nonmoving', 'compacting_gc', 'sanity']),
    193 193 
          # On windows, nonmoving way fails with bad exit code (2816)
    194 194 
          when(opsys('mingw32'), fragile(23091)),
    195 
    +     # For simplicity, ASAN poisoning/unpoisoning logic is omitted
    196 
    +     # from rts_clearMemory implementation
    197 
    +     when(have_asan(), skip),
    195 198 
          req_c,
    196 199 
          pre_cmd('$MAKE -s --no-print-directory rts_clearMemory_setup') ],
    197 200 
          # Same hack as ffi023

  • testsuite/tests/jsffi/all.T
    ... ... @@ -25,4 +25,6 @@ test('jsffion', [], compile_and_run, ['-optl-Wl,--export=main'])
    25 25
    26 26 
     test('jsffisleep', [], compile_and_run, ['-optl-Wl,--export=testWouldBlock,--export=testLazySleep,--export=testThreadDelay,--export=testInterruptingSleep'])
    27 27
    28 
    +test('bytearrayarg', [], compile_and_run, ['-optl-Wl,--export=main'])
    29 
    +
    28 30 
     test('textconv', [], compile_and_run, ['-optl-Wl,--export=main'])

  • testsuite/tests/jsffi/bytearrayarg.hs
    1 
    +{-# LANGUAGE MagicHash #-}
    2 
    +{-# LANGUAGE UnboxedTuples #-}
    3 
    +{-# LANGUAGE UnliftedFFITypes #-}
    4 
    +
    5 
    +module Test where
    6 
    +
    7 
    +import GHC.Exts
    8 
    +import GHC.IO
    9 
    +import GHC.Word (Word8(W8#))
    10 
    +
    11 
    +foreign import javascript unsafe "(() => { const u8 = new Uint8Array(__exports.memory.buffer, $1, 4); return (u8[0] === 0x12 && u8[1] === 0x34 && u8[2] === 0x56 && u8[3] === 0x78) ? 1 : 0; })()"
    12 
    +  js_check_mba :: MutableByteArray# RealWorld -> IO Int
    13 
    +
    14 
    +foreign import javascript unsafe "(() => { const u8 = new Uint8Array(__exports.memory.buffer, $1, 4); return (u8[0] === 0x12 && u8[1] === 0x34 && u8[2] === 0x56 && u8[3] === 0x78) ? 1 : 0; })()"
    15 
    +  js_check_ba :: ByteArray# -> IO Int
    16 
    +
    17 
    +foreign export javascript "main"
    18 
    +  main :: IO ()
    19 
    +
    20 
    +main :: IO ()
    21 
    +main =
    22 
    +  IO $ \s0 ->
    23 
    +    case newPinnedByteArray# 4# s0 of
    24 
    +      (# s1, mba# #) ->
    25 
    +        case (0x12 :: Word8) of { W8# b0# ->
    26 
    +        case (0x34 :: Word8) of { W8# b1# ->
    27 
    +        case (0x56 :: Word8) of { W8# b2# ->
    28 
    +        case (0x78 :: Word8) of { W8# b3# ->
    29 
    +          let s2 = writeWord8Array# mba# 0# b0# s1
    30 
    +              s3 = writeWord8Array# mba# 1# b1# s2
    31 
    +              s4 = writeWord8Array# mba# 2# b2# s3
    32 
    +              s5 = writeWord8Array# mba# 3# b3# s4
    33 
    +           in case unIO (js_check_mba mba#) s5 of
    34 
    +                (# s6, ok_mba #) -> case unsafeFreezeByteArray# mba# s6 of
    35 
    +                  (# s7, ba# #) -> case unIO (js_check_ba ba#) s7 of
    36 
    +                    (# s8, ok_ba #) -> case unIO (print ok_mba) s8 of
    37 
    +                      (# s9, _ #) -> case unIO (print ok_ba) s9 of
    38 
    +                        (# s10, _ #) -> (# s10, () #)
    39 
    +        }}}}

  • testsuite/tests/jsffi/bytearrayarg.mjs
    1 
    +export default async (__exports) => {
    2 
    +  await __exports.main();
    3 
    +  process.exit();
    4 
    +}

  • testsuite/tests/jsffi/bytearrayarg.stdout
    1 
    +1
    2 
    +1

  • testsuite/tests/perf/should_run/all.T
    ... ... @@ -420,6 +420,7 @@ test('T17949', [collect_stats('bytes allocated', 1), only_ways(['normal'])], com
    420 420 
     test('ByteCodeAsm',
    421 421 
                    [ extra_run_opts('"' + config.libdir + '"')
    422 422 
                    , js_broken(22261)
    423 
    +               , when(arch('wasm32'), run_timeout_multiplier(10))
    423 424 
                    , collect_stats('bytes allocated', 10),
    424 425 
                    ],
    425 426 
                    compile_and_run,

  • testsuite/tests/rts/T18623/all.T
    ... ... @@ -8,6 +8,8 @@ test('T18623',
    8 8 
          # Recent versions of osx report an error when running `ulimit -v`
    9 9 
          when(opsys('darwin'), skip),
    10 10 
          when(arch('powerpc64le'), skip),
    11 
    +     # ASan can't allocate shadow memory
    12 
    +     when(have_asan(), skip),
    11 13 
          cmd_prefix('ulimit -v ' + str(8 * 1024 ** 2) + ' && '),
    12 14 
          ignore_stdout],
    13 15 
         run_command,

  • testsuite/tests/rts/all.T
    ... ... @@ -105,6 +105,8 @@ def remove_parenthesis(s):
    105 105 
         return re.sub(r'\s+\([^)]*\)', '', s)
    106 106
    107 107 
     test('outofmem', [ when(opsys('darwin'), skip),
    108 
    +                   # ASan shadow memory allocation blows up
    109 
    +                   when(have_asan(), skip),
    108 110 
                        # this is believed to cause other processes to die
    109 111 
                        # that happen concurrently while the outofmem test
    110 112 
                        # runs in CI. As such we'll need to disable it on

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