- ghc-commits - Haskell.org

[Git][ghc/ghc][wip/T27455] base: Don't drop exception context in SomeException(toException)
by sheaf (＠sheaf) 03 Jul '26

03 Jul '26

sheaf pushed to branch wip/T27455 at Glasgow Haskell Compiler / GHC Commits: b808fef3 by Ben Gamari at 2026-07-03T11:33:55+02:00 base: Don't drop exception context in SomeException(toException) For reasons that are lost to time, the implementation of [CLC #200] that was merged inappropriately dropped `ExceptionContext` in the `toException` implementation given to `SomeException`. Fix this infelicity. [CLC #200]: https://github.com/haskell/core-libraries-committee/issues/200 - - - - - 3 changed files: - + changelog.d/T27455 - libraries/base/changelog.md - libraries/ghc-internal/src/GHC/Internal/Exception/Type.hs Changes: ===================================== changelog.d/T27455 ===================================== @@ -0,0 +1,8 @@ +section: base +issues: #27455 +mrs: !16274 +synopsis: + Don't drop `ExceptionContext` in `SomeException(toException)` +description: + Previously the implementation of ``Exception(toException)`` given to `SomeException` would inappropriately drop the carried `ExceptionContext`. Now ``toException = id``, faithfully implementing the semantics proposed in :ref:`CLC Proposal #200 <https://github.com/haskell/core-libraries-committee/issues/200>`. + ===================================== libraries/base/changelog.md ===================================== @@ -33,6 +33,7 @@ * Evaluate backtraces for "error" exceptions at the moment they are thrown. ([CLC proposal #383](https://github.com/haskell/core-libraries-committee/issues/383)) * Hide implementation details when throwing exceptions in throw and throwSTM. ([CLC proposal #387](https://github.com/haskell/core-libraries-committee/issues/387)) * Change `hIsReadable` and `hIsWritable` such that they always throw a respective exception when encountering a closed or semi-closed handle, not just in the case of a file handle. ([CLC proposal #371](github.com/haskell/core-libraries-committee/issues/371)) + * The implementation of `toException` in `SomeException`'s `Exception` instance no longer drops exception context, in keeping with the behavior originally proposed in [CLC Proposal #200](https://github.com/haskell/core-libraries-committee/issues/200). * Annotate `onException` continuation with `WhileHandling`. ([CLC Proposal #397](https://github.com/haskell/core-libraries-committee/issues/397)) * Improve error message for `Data.Char.chr`. ([CLC Proposal #384](https://github.com/haskell/core-libraries-committee/issues/384)) ===================================== libraries/ghc-internal/src/GHC/Internal/Exception/Type.hs ===================================== @@ -55,7 +55,7 @@ import GHC.Internal.Data.Maybe import GHC.Internal.Data.Typeable (Typeable, TypeRep, cast) import qualified GHC.Internal.Data.Typeable as Typeable -- loop: GHC.Internal.Data.Typeable -> GHC.Internal.Err -> GHC.Internal.Exception -import GHC.Internal.Base (String, Void, fmap, return, ($), (.), (++)) +import GHC.Internal.Base (String, Void, fmap, return, ($), (.), (++), id) import GHC.Internal.Show import GHC.Internal.Types (Bool(..)) import GHC.Internal.Exception.Context @@ -231,13 +231,11 @@ class (Typeable e, Show e) => Exception e where -- | @since base-4.8.0.0 instance Exception Void --- | This drops any attached 'ExceptionContext'. +-- | NB: this instance preserves the attached 'ExceptionContext'. -- -- @since base-3.0 instance Exception SomeException where - toException (SomeException e) = - let ?exceptionContext = emptyExceptionContext - in SomeException e + toException = id fromException = Just backtraceDesired (SomeException e) = backtraceDesired e displayException (SomeException e) = displayException e View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b808fef384e2d17c353d74be61e9a69… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b808fef384e2d17c353d74be61e9a69… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T27455] base: Don't drop exception context in SomeException(toException)
by sheaf (＠sheaf) 03 Jul '26

03 Jul '26

sheaf pushed to branch wip/T27455 at Glasgow Haskell Compiler / GHC Commits: 80573530 by Ben Gamari at 2026-07-03T11:33:27+02:00 base: Don't drop exception context in SomeException(toException) For reasons that are lost to time, the implementation of [CLC #200] that was merged inappropriately dropped `ExceptionContext` in the `toException` implementation given to `SomeException`. Fix this infelicity. [CLC #200]: https://github.com/haskell/core-libraries-committee/issues/200 - - - - - 3 changed files: - + changelog.d/T27455 - libraries/base/changelog.md - libraries/ghc-internal/src/GHC/Internal/Exception/Type.hs Changes: ===================================== changelog.d/T27455 ===================================== @@ -0,0 +1,8 @@ +section: base +issues: #27455 +mrs: +synopsis: + Don't drop `ExceptionContext` in `SomeException(toException)` +description: + Previously the implementation of ``Exception(toException)`` given to `SomeException` would inappropriately drop the carried `ExceptionContext`. Now ``toException = id``, faithfully implementing the semantics proposed in :ref:`CLC Proposal #200 <https://github.com/haskell/core-libraries-committee/issues/200>`. + ===================================== libraries/base/changelog.md ===================================== @@ -33,6 +33,7 @@ * Evaluate backtraces for "error" exceptions at the moment they are thrown. ([CLC proposal #383](https://github.com/haskell/core-libraries-committee/issues/383)) * Hide implementation details when throwing exceptions in throw and throwSTM. ([CLC proposal #387](https://github.com/haskell/core-libraries-committee/issues/387)) * Change `hIsReadable` and `hIsWritable` such that they always throw a respective exception when encountering a closed or semi-closed handle, not just in the case of a file handle. ([CLC proposal #371](github.com/haskell/core-libraries-committee/issues/371)) + * The implementation of `toException` in `SomeException`'s `Exception` instance no longer drops exception context, in keeping with the behavior originally proposed in [CLC Proposal #200](https://github.com/haskell/core-libraries-committee/issues/200). * Annotate `onException` continuation with `WhileHandling`. ([CLC Proposal #397](https://github.com/haskell/core-libraries-committee/issues/397)) * Improve error message for `Data.Char.chr`. ([CLC Proposal #384](https://github.com/haskell/core-libraries-committee/issues/384)) ===================================== libraries/ghc-internal/src/GHC/Internal/Exception/Type.hs ===================================== @@ -55,7 +55,7 @@ import GHC.Internal.Data.Maybe import GHC.Internal.Data.Typeable (Typeable, TypeRep, cast) import qualified GHC.Internal.Data.Typeable as Typeable -- loop: GHC.Internal.Data.Typeable -> GHC.Internal.Err -> GHC.Internal.Exception -import GHC.Internal.Base (String, Void, fmap, return, ($), (.), (++)) +import GHC.Internal.Base (String, Void, fmap, return, ($), (.), (++), id) import GHC.Internal.Show import GHC.Internal.Types (Bool(..)) import GHC.Internal.Exception.Context @@ -231,13 +231,11 @@ class (Typeable e, Show e) => Exception e where -- | @since base-4.8.0.0 instance Exception Void --- | This drops any attached 'ExceptionContext'. +-- | NB: this instance preserves the attached 'ExceptionContext'. -- -- @since base-3.0 instance Exception SomeException where - toException (SomeException e) = - let ?exceptionContext = emptyExceptionContext - in SomeException e + toException = id fromException = Just backtraceDesired (SomeException e) = backtraceDesired e displayException (SomeException e) = displayException e View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/80573530c3d2229cd65fd5bdd151180… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/80573530c3d2229cd65fd5bdd151180… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/andreask/arm-ffi] 2 commits: cmm: Add machop width info with -dppr-debug for infix ops.
by Andreas Klebinger (＠AndreasK) 03 Jul '26

03 Jul '26

Andreas Klebinger pushed to branch wip/andreask/arm-ffi at Glasgow Haskell Compiler / GHC Commits: d5e68fa2 by Andreas Klebinger at 2026-07-03T10:43:04+02:00 cmm: Add machop width info with -dppr-debug for infix ops. - - - - - bfe529ea by Andreas Klebinger at 2026-07-03T10:47:32+02:00 Add test for #27430. - - - - - 5 changed files: - compiler/GHC/Cmm/Expr.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - + testsuite/tests/codeGen/should_run/T27430.hs - + testsuite/tests/codeGen/should_run/T27430_c.c - testsuite/tests/ffi/should_run/all.T Changes: ===================================== compiler/GHC/Cmm/Expr.hs ===================================== @@ -443,6 +443,11 @@ pprExpr platform e CmmLit lit -> pprLit platform lit _other -> pprExpr1 platform e +-- `exp` usually, but (expr[width]) with -dppr-debug +withDebugWidth :: Width -> SDoc -> SDoc +withDebugWidth w exp = + ifPprDebug (parens (exp <> brackets (ppr w))) exp + -- Here's the precedence table from GHC.Cmm.Parser: -- %nonassoc '>=' '>' '<=' '<' '!=' '==' -- %left '|' @@ -465,15 +470,17 @@ pprExpr1 platform e = pprExpr7 platform e infixMachOp1, infixMachOp7, infixMachOp8 :: MachOp -> Maybe SDoc -infixMachOp1 (MO_Eq _) = Just (text "==") -infixMachOp1 (MO_Ne _) = Just (text "!=") -infixMachOp1 (MO_Shl _) = Just (text "<<") -infixMachOp1 (MO_U_Shr _) = Just (text ">>") -infixMachOp1 (MO_U_Ge _) = Just (text ">=") -infixMachOp1 (MO_U_Le _) = Just (text "<=") -infixMachOp1 (MO_U_Gt _) = Just (char '>') -infixMachOp1 (MO_U_Lt _) = Just (char '<') -infixMachOp1 _ = Nothing +infixMachOp1 mop = case mop of + (MO_Eq w) -> Just $ withDebugWidth w (text "==") + (MO_Ne w) -> Just $ withDebugWidth w (text "!=") + (MO_Shl w) -> Just $ withDebugWidth w (text "<<") + (MO_U_Shr w) -> Just $ withDebugWidth w (text ">>") + (MO_U_Ge w) -> Just $ withDebugWidth w (text ">=") + (MO_U_Le w) -> Just $ withDebugWidth w (text "<=") + (MO_U_Gt w) -> Just $ withDebugWidth w (char '>') + (MO_U_Lt w) -> Just $ withDebugWidth w (char '<') + _ -> Nothing + where -- %left '-' '+' pprExpr7 platform (CmmMachOp (MO_Add rep1) [x, CmmLit (CmmInt i rep2)]) | i < 0 @@ -483,8 +490,8 @@ pprExpr7 platform (CmmMachOp op [x,y]) = pprExpr7 platform x <+> doc <+> pprExpr8 platform y pprExpr7 platform e = pprExpr8 platform e -infixMachOp7 (MO_Add _) = Just (char '+') -infixMachOp7 (MO_Sub _) = Just (char '-') +infixMachOp7 (MO_Add w) = Just $ withDebugWidth w (char '+') +infixMachOp7 (MO_Sub w) = Just $ withDebugWidth w (char '-') infixMachOp7 _ = Nothing -- %left '/' '*' '%' @@ -493,9 +500,9 @@ pprExpr8 platform (CmmMachOp op [x,y]) = pprExpr8 platform x <+> doc <+> pprExpr9 platform y pprExpr8 platform e = pprExpr9 platform e -infixMachOp8 (MO_U_Quot _) = Just (char '/') -infixMachOp8 (MO_Mul _) = Just (char '*') -infixMachOp8 (MO_U_Rem _) = Just (char '%') +infixMachOp8 (MO_U_Quot w) = Just $ withDebugWidth w (char '/') +infixMachOp8 (MO_Mul w) = Just $ withDebugWidth w (char '*') +infixMachOp8 (MO_U_Rem w) = Just $ withDebugWidth w (char '%') infixMachOp8 _ = Nothing pprExpr9 :: Platform -> CmmExpr -> SDoc ===================================== compiler/GHC/CmmToAsm/AArch64/CodeGen.hs ===================================== @@ -2898,6 +2898,7 @@ genCCall target dest_regs arg_regs = do passArguments _ _ _ _ _ _ _ = pprPanic "passArguments" (text "invalid state") + -- | readResults gpArgs fpArgs dest_regs reg_acc code_acc readResults :: [Reg] -> [Reg] -> [LocalReg] -> [Reg]-> InstrBlock -> NatM (InstrBlock) readResults _ _ [] _ accumCode = return accumCode readResults [] _ _ _ _ = do ===================================== testsuite/tests/codeGen/should_run/T27430.hs ===================================== @@ -0,0 +1,23 @@ +{-# LANGUAGE MagicHash #-} +{-# OPTIONS_GHC -dno-typeable-binds -ddump-to-file -dsuppress-ticks -dsuppress-timestamps -ddump-stg-from-core -ddump-stg-final -ddump-cmm -ddump-cmm-raw -ddump-asm #-} + +import GHC.Exts +import Data.Word (Word64) +import GHC.Word (Word8(..)) +import System.Environment (getArgs) + +foreign import ccall unsafe "u64_to_u8" u64_to_u8 :: Word64 -> Word8 +foreign import ccall unsafe "u64_to_u16" u64_to_u16 :: Word64 -> Word8 +foreign import ccall unsafe "u64_to_u32" u64_to_u32 :: Word64 -> Word8 + +x :: Word64 +x = 5 + +y :: Word64 +y = 65541 + +eq8 :: Word8 -> Word8 -> Int +eq8 (W8# a) (W8# b) = I# (eqWord8# a b) + +main :: IO () +main = print (eq8 (u64_to_u8 x) (u64_to_u8 y)) ===================================== testsuite/tests/codeGen/should_run/T27430_c.c ===================================== @@ -0,0 +1,5 @@ +#include <stdint.h> + +uint8_t u64_to_u8(uint64_t v) { return (uint8_t)v; } +uint8_t u64_to_u16(uint64_t v) { return (uint16_t)v; } +uint8_t u64_to_u32(uint64_t v) { return (uint32_t)v; } ===================================== testsuite/tests/ffi/should_run/all.T ===================================== @@ -264,3 +264,5 @@ test('T24598', req_cmm, compile_and_run, ['T24598_cmm.cmm']) test('T24598b', req_cmm, compile_and_run, ['T24598b_cmm.cmm']) test('T24598c', req_cmm, compile_and_run, ['T24598c_cmm.cmm']) test('T24818', [req_cmm, req_c], compile_and_run, ['-XUnliftedFFITypes T24818_cmm.cmm T24818_c.c']) + +test('T27430', [req_c], compile_and_run, ['T27430_c.c']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/98fa02eb0e652dee1eb9bbd670a2f2… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/98fa02eb0e652dee1eb9bbd670a2f2… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: Decoupling 'L.H.S' from 'GHC.Hs.Doc'
by Marge Bot (＠marge-bot) 03 Jul '26

03 Jul '26

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: ab17a30e by Recursion Ninja at 2026-07-03T03:15:44-04:00 Decoupling 'L.H.S' from 'GHC.Hs.Doc' * Migrated 'GHC.Hs.Doc' and 'GHC.Hs.DocString' AST defintions from 'GHC.*' namespace, to new 'Language.Haskell.Syntax.Doc' module in the 'L.H.S' "namespace." * Updated 'HsDocString to be TTG-parameterised as 'HsDocString pass'. * Added 'GHC.Hs.Extension.Pass': splits 'GhcPass'/'Pass' and all 'HsDocString' TTG instances out of 'GHC.Hs.Extension', which re-exports it unchanged (this is backwards compatible and prevents the introduction of a boot file). * Deleted 'GHC.Hs.Doc.hs-boot'; removed all 'L.H.S.*' imports of 'GHC.Hs.Doc'. * Updated 'GHC.Hs.DocString' to be TTG pass-parameterised throughout; moved 'mkHsDocStringChunk'/'unpackHDSC' here (require 'GHC.Utils.Encoding'). * Split 'GHC.Rename.Doc.rnHsDoc' from 'rnHsDocIdentifiersOnly'. * Updated parser, renamer, typechecker, HIE, and exact-print for new types. * Added 'HsDocString' TTG instances for 'DocNameI' to 'Haddock.Types'. * Killed the last module loop between GHC.* and LHS.*. - Only edges from LHS.* to GHC.Data.FastString now! Resolves #26971 - - - - - effbd380 by mangoiv at 2026-07-03T03:15:45-04:00 ci: retry fetching test metrics Retry fetching test metrics to make the CI not fail if the services is temporarily unavailable - - - - - bdabaff2 by sheaf at 2026-07-03T03:15:46-04:00 Remove outdated comment in GHC.Data.ShortText There was a long comment in GHC.Data.ShortText about a workaround that was necessary when bootstrapping with GHC 9.2 and below. The actual logic has since been dropped, but the comment remained. This commit removes the vestigial comment. - - - - - 48 changed files: - .gitlab/test-metrics.sh - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Hs.hs - compiler/GHC/Hs/Doc.hs - − compiler/GHC/Hs/Doc.hs-boot - compiler/GHC/Hs/DocString.hs - compiler/GHC/Hs/Extension.hs - + compiler/GHC/Hs/Extension/Pass.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/HaddockLex.x - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess/Haddock.hs - compiler/GHC/Rename/Doc.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Tc/Errors/Hole.hs - compiler/GHC/Tc/Errors/Hole/FitTypes.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Types/Basic.hs - compiler/Language/Haskell/Syntax.hs - compiler/Language/Haskell/Syntax/Decls.hs - + compiler/Language/Haskell/Syntax/Doc.hs - compiler/Language/Haskell/Syntax/Expr.hs-boot - compiler/Language/Haskell/Syntax/Extension.hs - compiler/Language/Haskell/Syntax/ImpExp.hs - compiler/Language/Haskell/Syntax/Type.hs - − compiler/Language/Haskell/Syntax/Type.hs-boot - compiler/ghc.cabal.in - libraries/ghc-boot/GHC/Data/ShortText.hs - testsuite/tests/count-deps/CountDepsAst.stdout - testsuite/tests/count-deps/CountDepsParser.stdout - testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr - testsuite/tests/haddock/should_compile_flag_haddock/T24221.stderr - testsuite/tests/parser/should_compile/T23315/T23315.stderr - testsuite/tests/showIface/DocsInHiFile1.stdout - testsuite/tests/showIface/HaddockSpanIssueT24378.stdout - testsuite/tests/showIface/MagicHashInHaddocks.stdout - testsuite/tests/showIface/NoExportList.stdout - utils/check-exact/ExactPrint.hs - utils/check-exact/Utils.hs - utils/haddock/haddock-api/src/Haddock/Interface/Create.hs - utils/haddock/haddock-api/src/Haddock/Interface/LexParseRn.hs - utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs - utils/haddock/haddock-api/src/Haddock/Types.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/adc9fa864e2c883ac27420a72935b7… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/adc9fa864e2c883ac27420a72935b7… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/hadrian-target] 2 commits: hadrian: binary-dist-dir should not be the default target
by Zubin (＠wz1000) 03 Jul '26

03 Jul '26

Zubin pushed to branch wip/hadrian-target at Glasgow Haskell Compiler / GHC Commits: 000ec2be by Zubin Duggal at 2026-07-02T22:57:59+05:30 hadrian: binary-dist-dir should not be the default target Revert behaviour to pre 23c9b6c392f52ec9d7a8618b204ff6b885f5fba2 In 23c9b6c392f52ec9d7a8618b204ff6b885f5fba2, we applied the following behaviour change: ``` hadrian: Build stage 2 cross compilers ... * hadrian: Make binary-dist-dir the default build target. This allows us to have the logic in one place about which libraries/stages to build with cross compilers. Fixes #24192 ``` This is a major regression to development experience, a plain hadrian/build --freeze1 now takes ages because we rebuild all docs (which need to go in the binary dist dir). `binary-dist-dir` is the wrong default target for regular GHC development work Fixes #27445 - - - - - 366a4168 by Zubin Duggal at 2026-07-02T22:58:51+05:30 .gitignore: Add the hadrian system.config introduced by commit 23c9b6c392f52ec9d7a8618b204ff6b885f5fba2 Since commit 23c9b6c392f52ec9d7a8618b204ff6b885f5fba2 Author: Matthew Pickering <matthewtpickering(a)gmail.com> Date: Thu Dec 21 16:17:41 2023 +0000 hadrian: Build stage 2 cross compilers ./configure produces /hadrian/cfg/system.config.{host,target} Add these to .gitignore - - - - - 3 changed files: - .gitignore - hadrian/src/Rules.hs - hadrian/src/Rules/BinaryDist.hs Changes: ===================================== .gitignore ===================================== @@ -64,6 +64,8 @@ _* .hadrian_ghci_multi/ .hie-bios hadrian/bootstrap/jq-bin +/hadrian/cfg/system.config.host +/hadrian/cfg/system.config.target # ----------------------------------------------------------------------------- # Ignore any overlapped darcs repos and back up files ===================================== hadrian/src/Rules.hs ===================================== @@ -10,6 +10,7 @@ import qualified Hadrian.Oracles.Path import qualified Hadrian.Oracles.TextFile import qualified Hadrian.Haskell.Hash +import BindistConfig import Expression import qualified Oracles.Flavour import qualified Oracles.ModuleFiles @@ -32,17 +33,51 @@ import Settings.Program (programContext) import Target import UserSettings --- | This rule defines what the default build configuration is when no targets --- are selected. +-- | This rule calls 'need' on all top-level build targets that Hadrian builds +-- by default, respecting the 'finalStage' flag. topLevelTargets :: Rules () topLevelTargets = action $ do - let targets = ["binary-dist-dir"] + verbosity <- getVerbosity + forM_ [ Stage1, Stage2, Stage3] $ \stage -> do + when (verbosity >= Verbose) $ do + (libraries, programs) <- partition isLibrary <$> stagePackages stage + libNames <- mapM (name stage) libraries + pgmNames <- mapM (name stage) programs + let stageHeader t ps = + "| Building " ++ show stage ++ " " + ++ t ++ ": " ++ intercalate ", " ps + putInfo . unlines $ + [ stageHeader "libraries" libNames + , stageHeader "programs" pgmNames ] + let buildStages = [ s | s <- allStages, s < finalStage ] + targets <- concatForM buildStages $ \stage -> do + packages <- stagePackages stage + mapM (path stage) packages + + -- For cross compilers, also build the target (stage 2) libraries. They + -- are built by and ship with the executable_stage compiler, so include + -- them iff that compiler is built. + cfg <- implicitBindistConfig + lib_targets <- if executable_stage cfg < finalStage + then map snd . fst <$> Rules.BinaryDist.bindistPackageTargets cfg + else return [] -- Why we need wrappers: https://gitlab.haskell.org/ghc/ghc/issues/16534. root <- buildRoot let wrappers = [ root -/- ("ghc-" ++ stageString s) | s <- [Stage1, Stage2, Stage3] , s < finalStage ] - need (targets ++ wrappers) + need (targets ++ lib_targets ++ wrappers) + where + -- either the package database config file for libraries or + -- the programPath for programs. However this still does + -- not support multiple targets, where a cabal package has + -- a library /and/ a program. + path :: Stage -> Package -> Action FilePath + path stage pkg | isLibrary pkg = pkgConfFile (vanillaContext stage pkg) + | otherwise = programPath =<< programContext stage pkg + name :: Stage -> Package -> Action String + name stage pkg | isLibrary pkg = return (pkgName pkg) + | otherwise = programName (vanillaContext stage pkg) -- | Return the list of targets associated with a given 'Stage' and 'Package'. packageTargets :: Stage -> Package -> Action [FilePath] ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -124,11 +124,8 @@ installTo relocatable prefix = do runBuilderWithCmdOptions env (Make bindistFilesDir) ["install"] [] [] -buildBinDistDir :: FilePath -> BindistConfig -> Action () -buildBinDistDir root conf@BindistConfig{..} = do - - verbosity <- getVerbosity - -- We 'need' all binaries and libraries +bindistPackageTargets :: BindistConfig -> Action ([(Package, FilePath)], [(Package, FilePath)]) +bindistPackageTargets conf@BindistConfig{..} = do lib_pkgs <- stagePackages library_stage (lib_targets, _) <- partitionEithers <$> mapM (pkgTarget conf) lib_pkgs @@ -137,6 +134,14 @@ buildBinDistDir root conf@BindistConfig{..} = do let excluded_packages = [ genapply ] bin_pkgs = filter (`notElem` excluded_packages) bin_pkgs_all (_, bin_targets) <- partitionEithers <$> mapM (pkgTarget conf) bin_pkgs + return (lib_targets, bin_targets) + +buildBinDistDir :: FilePath -> BindistConfig -> Action () +buildBinDistDir root conf@BindistConfig{..} = do + + verbosity <- getVerbosity + -- We 'need' all binaries and libraries + (lib_targets, bin_targets) <- bindistPackageTargets conf when (verbosity >= Verbose) $ do let libNames = map (pkgName . fst) lib_targets View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0e0203528dfbad75f2d6ae79404a84… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0e0203528dfbad75f2d6ae79404a84… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/semaphore-compat-2.0.1] Bump semaphore-compat submodule to 2.0.1
by Zubin (＠wz1000) 03 Jul '26

03 Jul '26

Zubin pushed to branch wip/semaphore-compat-2.0.1 at Glasgow Haskell Compiler / GHC Commits: b2ef5205 by Zubin Duggal at 2026-07-03T10:39:10+05:30 Bump semaphore-compat submodule to 2.0.1 This versions includes some cruicial fixes for darwin - - - - - 3 changed files: - changelog.d/semaphore-v2 - hadrian/src/Settings/Warnings.hs - libraries/semaphore-compat Changes: ===================================== changelog.d/semaphore-v2 ===================================== @@ -2,7 +2,7 @@ section: compiler issues: #25087 mrs: !15729 synopsis: - Update to semaphore-compat 2.0.0 (``-jsem`` protocol v2) + Update to semaphore-compat 2.0.1 (``-jsem`` protocol v2) description: On Linux and other POSIX platforms, GHC's ``-jsem`` jobserver client now speaks v2 of the semaphore-compat protocol, which uses Unix ===================================== hadrian/src/Settings/Warnings.hs ===================================== @@ -97,4 +97,5 @@ ghcWarningsArgs = do ] , package xhtml ? pure [ "-Wno-unused-imports" ] , package containers ? pure [ "-Wno-unused-imports" ] + , package semaphoreCompat ? pure [ "-Wno-unused-imports" ] ] ] ===================================== libraries/semaphore-compat ===================================== @@ -1 +1 @@ -Subproject commit 44e7488dd93cbf333ceca1319a60146898f6224f +Subproject commit ebcb68506e67de9c8190c0394e10c913593d85da View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b2ef5205e17e8484e7a0bbb3eec47fe… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b2ef5205e17e8484e7a0bbb3eec47fe… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/25924] Don't make absent fillers for terminating types
by Zubin (＠wz1000) 03 Jul '26

03 Jul '26

Zubin pushed to branch wip/25924 at Glasgow Haskell Compiler / GHC Commits: 98766eff by Zubin Duggal at 2026-07-03T10:32:47+05:30 Don't make absent fillers for terminating types In #25924 we discovered that we could speculatively evaluate an absent filler for a dictionary, and project a field (a superclass selector) out of it, resulting in segfaults. Solution: Never make an absent filler or rubbish literal for a terminating type like a dictionary. mkAbsentFiller returns Nothing for isTerminatingType, so worker/wrapper and the specialiser keep the real argument instead. Some small metric decreases because we do a little less work in the simplifier now. Metric Decrease: T9872a T9872b T9872c TcPlugin_RewritePerf - - - - - 9 changed files: - changelog.d/fix-absent-dict-projection - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Types/Literal.hs - testsuite/tests/dmdanal/should_compile/T18982.stderr - testsuite/tests/simplCore/should_compile/T26615.stderr Changes: ===================================== changelog.d/fix-absent-dict-projection ===================================== @@ -1,5 +1,8 @@ section: compiler -synopsis: Fix a CorePrep miscompilation that could project a field out of an absent dictionary, resulting in a segfault. +synopsis: Fix a miscompilation that could project a field out of an absent dictionary, resulting in a segfault. issues: #25924 mrs: !16219 -description: We no longer speculatively evaluate bindings that we have already discovered are absent. +description: + We no longer make an absent filler (a rubbish literal or error thunk) for an + absent dictionary or other terminating type. We also no longer speculatively + evaluate a binding once we have discovered that it is absent. ===================================== compiler/GHC/Core/Make.hs ===================================== @@ -227,13 +227,16 @@ mkLitRubbish :: Type -> Maybe CoreExpr -- Fail (returning Nothing) if -- * the RuntimeRep of the Type is not monomorphic; -- * the type is (a ~# b), the type of coercion --- See INVARIANT 1 and 2 of item (2) in Note [Rubbish literals] +-- * the type is terminating (isTerminatingType), e.g. a dictionary +-- See INVARIANT 1, 2 and 3 of item (2) in Note [Rubbish literals] -- in GHC.Types.Literal mkLitRubbish ty | not (noFreeVarsOfType rep) = Nothing -- Satisfy INVARIANT 1 | isEqPred ty = Nothing -- Satisfy INVARIANT 2 + | isTerminatingType ty + = Nothing -- Satisfy INVARIANT 3 | otherwise = Just (Lit (LitRubbish torc rep) `mkTyApps` [ty]) where ===================================== compiler/GHC/Core/Opt/Specialise.hs ===================================== @@ -19,12 +19,13 @@ import GHC.Core.SimpleOpt( defaultSimpleOpts, simpleOptExprWith, exprIsConApp_ma import GHC.Core.Predicate import GHC.Core.Class( classMethods ) import GHC.Core.Coercion( Coercion ) -import GHC.Core.DataCon (dataConTyCon) +import GHC.Core.DataCon (dataConTyCon, StrictnessMark(NotMarkedStrict)) import qualified GHC.Core.Subst as Core import GHC.Core.Unfold.Make import GHC.Core -import GHC.Core.Make ( mkLitRubbish, wrapFloats ) +import GHC.Core.Make ( wrapFloats ) +import GHC.Core.Opt.WorkWrap.Utils ( mkAbsentFiller ) import GHC.Core.Unify ( tcMatchTy ) import GHC.Core.Rules import GHC.Core.Subst (substTickish) @@ -1669,7 +1670,7 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs | otherwise = UnspecArg ; (useful, subst', rule_bndrs, rule_lhs_args, spec_bndrs, dx_binds, spec_args) - <- specHeader subst rhs_bndrs all_call_args + <- specHeader this_mod subst rhs_bndrs all_call_args ; let env' = env { se_subst = subst' } -- Check for (a) usefulness and (b) not already covered @@ -2573,7 +2574,8 @@ isSpecDict _ = False -- , [T1, T2, c, i, dEqT1, dShow1] -- ) specHeader - :: Core.Subst -- This substitution applies to the [InBndr] + :: Module -- The module being compiled, for mkAbsentFiller + -> Core.Subst -- This substitution applies to the [InBndr] -> [InBndr] -- Binders from the original function `f` -> [SpecArg] -- From the CallInfo -> SpecM ( Bool -- True <=> some useful specialisation happened @@ -2598,13 +2600,13 @@ specHeader -- If we run out of binders, stop immediately -- See Note [Specialisation Must Preserve Sharing] -specHeader subst [] _ = pure (False, subst, [], [], [], [], []) -specHeader subst _ [] = pure (False, subst, [], [], [], [], []) +specHeader _ subst [] _ = pure (False, subst, [], [], [], [], []) +specHeader _ subst _ [] = pure (False, subst, [], [], [], [], []) -- We want to specialise on type 'T1', and so we must construct a substitution -- 'a->T1', as well as a LHS argument for the resulting RULE and unfolding -- details. -specHeader subst (bndr:bndrs) (SpecType ty : args) +specHeader mod subst (bndr:bndrs) (SpecType ty : args) = do { -- Find free_tvs, the type variables to add to the binders for the rule -- Namely those deeply free in `ty` that aren't in scope -- See (MP2) in Note [Specialising polymorphic dictionaries] @@ -2617,7 +2619,7 @@ specHeader subst (bndr:bndrs) (SpecType ty : args) ; let subst2 = Core.extendTvSubst subst1 bndr ty ; (useful, subst3, rule_bs, rule_args, spec_bs, dx, spec_args) - <- specHeader subst2 bndrs args + <- specHeader mod subst2 bndrs args ; pure ( useful, subst3 , free_tvs ++ rule_bs, Type ty : rule_args , free_tvs ++ spec_bs, dx, Type ty : spec_args ) } @@ -2626,29 +2628,34 @@ specHeader subst (bndr:bndrs) (SpecType ty : args) -- a substitution on it (in case the type refers to 'a'). Additionally, we need -- to produce a binder, LHS argument and RHS argument for the resulting rule, -- /and/ a binder for the specialised body. -specHeader subst (bndr:bndrs) (UnspecType : args) +specHeader mod subst (bndr:bndrs) (UnspecType : args) = do { let (subst1, bndr') = Core.substBndr subst bndr ; (useful, subst2, rule_bs, rule_es, spec_bs, dx, spec_args) - <- specHeader subst1 bndrs args + <- specHeader mod subst1 bndrs args ; let ty_e' = Type (mkTyVarTy bndr') ; pure ( useful, subst2 , bndr' : rule_bs, ty_e' : rule_es , bndr' : spec_bs, dx, ty_e' : spec_args ) } -specHeader subst (bndr:bndrs) (_ : args) +specHeader mod subst (bndr:bndrs) (_ : args) | isDeadBinder bndr , let (subst1, bndr') = Core.substBndr subst (zapIdOccInfo bndr) - , Just rubbish_lit <- mkLitRubbish (idType bndr') + , Just filler <- mkAbsentFiller mod bndr' NotMarkedStrict + -- NB: mkAbsentFiller returns Nothing for a terminating type (e.g. a + -- dictionary), so this guard fails and we fall through, keeping the + -- argument instead of dropping it. + -- See Note [Don't make fillers for terminating types] + -- in GHC.Core.Opt.WorkWrap.Utils = -- See Note [Drop dead args from specialisations] - do { (useful, subst2, rule_bs, rule_es, spec_bs, dx, spec_args) <- specHeader subst1 bndrs args + do { (useful, subst2, rule_bs, rule_es, spec_bs, dx, spec_args) <- specHeader mod subst1 bndrs args ; pure ( useful, subst2 , bndr' : rule_bs, Var bndr' : rule_es - , spec_bs, dx, rubbish_lit : spec_args ) } + , spec_bs, dx, filler : spec_args ) } -- Next we want to specialise the 'Eq a' dict away. We need to construct -- a wildcard binder to match the dictionary (See Note [Specialising Calls] for -- the nitty-gritty), as a LHS rule and unfolding details. -specHeader subst (bndr:bndrs) (SpecDict dict_arg : args) +specHeader mod subst (bndr:bndrs) (SpecDict dict_arg : args) = do { -- Make up a fresh binder to use in the RULE -- It might turn into a dict binding (via bindAuxiliaryDict) which we -- then float, so we use cloneIdBndr to get a completely fresh binder @@ -2659,7 +2666,7 @@ specHeader subst (bndr:bndrs) (SpecDict dict_arg : args) -- Extend the substitution to map bndr :-> dict_arg, for use in the RHS ; let (subst2, dx_bind, spec_dict) = bindAuxiliaryDict subst1 bndr bndr' dict_arg - ; (_, subst3, rule_bs, rule_es, spec_bs, dx, spec_args) <- specHeader subst2 bndrs args + ; (_, subst3, rule_bs, rule_es, spec_bs, dx, spec_args) <- specHeader mod subst2 bndrs args ; let dx' = case dx_bind of { Nothing -> dx; Just d -> d : dx } ; pure ( True, subst3 -- Ha! A useful specialisation! @@ -2674,10 +2681,10 @@ specHeader subst (bndr:bndrs) (SpecDict dict_arg : args) -- why 'i' doesn't appear in our RULE above. But we have no guarantee that -- there aren't 'UnspecArg's which come /before/ all of the dictionaries, so -- this case must be here. -specHeader subst (bndr:bndrs) (UnspecArg : args) +specHeader mod subst (bndr:bndrs) (UnspecArg : args) = do { let (subst1, bndr') = Core.substBndr subst (zapIdOccInfo bndr) -- zapIdOccInfo: see Note [Zap occ info in rule binders] - ; (useful, subst2, rule_bs, rule_es, spec_bs, dx, spec_args) <- specHeader subst1 bndrs args + ; (useful, subst2, rule_bs, rule_es, spec_bs, dx, spec_args) <- specHeader mod subst1 bndrs args ; let dummy_arg = varToCoreExpr bndr' -- dummy_arg is usually just (Var bndr), ===================================== compiler/GHC/Core/Opt/WorkWrap.hs ===================================== @@ -554,7 +554,7 @@ tryWW ww_opts is_rec fn_id rhs -- See Note [Drop absent bindings] | isAbsDmd (demandInfo fn_info) , not (isJoinId fn_id) - , Just filler <- mkAbsentFiller ww_opts fn_id NotMarkedStrict + , Just filler <- mkAbsentFiller (wo_module ww_opts) fn_id NotMarkedStrict = return [(new_fn_id, filler)] -- See Note [Don't w/w INLINE things] ===================================== compiler/GHC/Core/Opt/WorkWrap/Utils.hs ===================================== @@ -30,7 +30,6 @@ import GHC.Core.Subst import GHC.Core.Type import GHC.Core.Multiplicity import GHC.Core.Coercion -import GHC.Core.Predicate( isDictTy ) import GHC.Core.Reduction import GHC.Core.FamInstEnv import GHC.Core.Predicate( isEqualityClass ) @@ -996,7 +995,7 @@ mkWWstr_one opts arg str_mark = _ | isTyVar arg -> do_nothing DropAbsent - | Just absent_filler <- mkAbsentFiller opts arg str_mark + | Just absent_filler <- mkAbsentFiller (wo_module opts) arg str_mark -- Absent case. Drop the argument from the worker. -- We can't always handle absence for arbitrary -- unlifted types, so we need to choose just the cases we can @@ -1067,14 +1066,20 @@ unbox_one_arg opts arg_var -- -- If @mkAbsentFiller _ id == Just e@, then @e@ is an absent filler with the -- same type as @id@. Otherwise, no suitable filler could be found. -mkAbsentFiller :: WwOpts -> Id -> StrictnessMark -> Maybe CoreExpr -mkAbsentFiller opts arg str +mkAbsentFiller :: Module -> Id -> StrictnessMark -> Maybe CoreExpr +mkAbsentFiller mod arg str + -- We never make a filler for a terminating type: it might be speculatively + -- evaluated or have a field projected out of it. + -- See (AF4) in Note [Absent fillers], and + -- Note [Don't make fillers for terminating types]. + | isTerminatingType arg_ty + = Nothing + -- The lifted case: bind 'absentError'. See (AF1) in Note [Absent fillers] -- We want to use this case if possible, because we get a nice runtime panic message -- if we are wrong (like we were in #11126). Otherwise we fall through to the -- less-desirable mkLitRubbish case. | mightBeLiftedType arg_ty - , not (isDictTy arg_ty) -- See (AF4) in Note [Absent fillers] , not (isStrictDmd (idDemandInfo arg)) -- See (AF2) , not (isMarkedStrict str) -- in Note [Absent fillers] = Just (mkAbsentErrorApp arg_ty msg) @@ -1101,7 +1106,7 @@ mkAbsentFiller opts arg str -- will have different lengths and hence different costs for -- the inliner leading to different inlining. -- See also Note [Unique Determinism] in GHC.Types.Unique - file_msg = text "In module" <+> quotes (ppr $ wo_module opts) + file_msg = text "In module" <+> quotes (ppr mod) {- Note [Worker/wrapper for Strictness and Absence] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1295,27 +1300,8 @@ Needless to say, there are some wrinkles: have to be representation monomorphic. But in the future, we might allow levity polymorphism, e.g. a polymorphic levity variable in 'BoxedRep'. -(AF4) Consider (#24934) - f :: (a~b) => blah {-# INLINE f #-} - f d x = case eq_sel d of co -> body - In #24934 it turned out that `co` was unused; and we discarded the - entire case-scrutinisation via the `exprOkToDiscard` test in - `GHC.Core.Opt.Simplify.Iteration.rebuildCase`. So now `d` is absent. - But in the /unfolding/ for some reason we did not discard the `case`; - so when we inline `f` we end up evaluating that `d` argument. So we had - better not replace it with an error thunk! - - The root of it is this: `exprOkToDiscard` assumes that a dictionary is - non-bottom (Note [exprOkForSpeculation and type classes]); but then we replace - the (a~b) dictionary with an error thunk, breaking the invariant that every - dictionary is non-bottom. (If -XDictsStrict is on, the invariant is even - more important.) - - Simple solution: never use an error thunk for a dictionary; instead fall - through to mkRubbishLit. (The only downside is that we lose the compiler - debugging advantages of (AF1).) - - This is quite delicate. +(AF4) We never make an absent filler for a terminating type. + See Note [Don't make fillers for terminating types]. While (AF1) and (AF2) are simply an optimisation in terms of compiler debugging experience, (AF3) should be irrelevant in most programs, if not all. @@ -1337,6 +1323,47 @@ fragile because `MkT` is strict in its Int# argument, so we get an absentError exception when we shouldn't. Very annoying! +Note [Don't make fillers for terminating types] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We never make an absent filler, error thunk or rubbish literal, for a terminating +type (isTerminatingType): a non-unary class dictionary, a boxed equality, or a +constraint tuple. + +GHC relies on a dictionary value never being bottom (see +Note [NON-BOTTOM-DICTS invariant] in GHC.Core). GHC uses "speculation" to +evaluated guaranteed-non-bottom values: see Note [Speculative evaluation] in +GHC.CoreToStg.Prep. This speculative evaluation is fundamentally incompatible +with replacing a dictionary with an absent filler. Attempts to to do so gave +rise to a succession of bugs including: + + * #24934: we evaluated an absent dictionary + * #25924: we selected a superclass from an absent dictionary + +A terminating type is exactly what speculation will force: see +Note [exprOkForSpeculation and type classes] in GHC.Core.Utils. So we refuse to +make a filler for precisely those types. + +So the safe thing is to make no filler at all for a terminating type. Then there +is no bogus dictionary to evaluate or project from. Specifically + + * `mkAbsentFiller` returns `Nothing` for a terminating type, so worker/wrapper + keeps the real argument. + + * `Specialise.specHeader` calls `mkAbsentFiller` too, so it likewise keeps the + dead dictionary argument rather than dropping it for a filler. + +Prior failed approaches + +We used to paper over this. !13233 replaced the error thunk for an absent +dictionary with a rubbish literal, so that it could at least be evaluated +without complaint. But #25924 showed that this is not enough, because we do not +only evaluate the absent dictionary, we also select a superclass from it. + +We could instead teach speculation to leave absent bindings alone, and we do +that too (see Note [Speculative evaluation] in GHC.CoreToStg.Prep). But that is +not a guarantee. After optimisation a binding that holds an absent filler may no +longer be marked absent, so we cannot rely on the demand to protect us. + Note [Unboxing through unboxed tuples] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We should not to a worker/wrapper split just for unboxing the components of ===================================== compiler/GHC/CoreToStg/Prep.hs ===================================== @@ -1995,20 +1995,19 @@ It is also similar to Note [Do not strictify a DFun's parameter dictionaries], where marking recursive DFuns (of undecidable *instances*) strict in dictionary *parameters* leads to quite the same change in termination as above. -Another Nasty Wrinkle: do not speculate absent bindings +Belt and braces: do not speculate absent bindings -Speculative evaluation is in conflict with absent fillers (see Note [Absent -fillers] in GHC.Core.Opt.WorkWrap.Utils). +In 'decideFloatInfo' we decline to speculate a binding whose demand is absent. +There is no point in speculating an absent binding, since its value is +(presumably) not needed. -When an argument is found to be absent, worker/wrapper drops it and binds an -absent filler in its place. This is supposed to be OK because the filler is -absent (i.e. not evaluated by the program). - -But speculation can force it anyway! See #25924 for how this goes wrong. - -So in 'decideFloatInfo' we decline to speculate a binding whose demand is -absent. An absent value is by definition never needed, so we lose nothing by not -speculating it. +This used to matter more. Worker/wrapper would bind an absent dictionary to a +rubbish literal filler, and speculation could force a superclass selection out +of that rubbish literal, causing a segfault (#25924). Nowadays we never make a +filler for a dictionary in the first place, so this can no longer happen and +the guard is merely belt and braces. +See Note [Don't make fillers for terminating types] +in GHC.Core.Opt.WorkWrap.Utils. Note [BindInfo and FloatInfo] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -2277,7 +2276,7 @@ decideFloatInfo FIA{fia_levity=lev, fia_demand=dmd, fia_is_hnf=is_hnf, -- (where it is actually bound lazily). -- -- Don't speculate an absent binding. See #25924 and - -- "Another Nasty Wrinkle" in Note [Speculative evaluation]. + -- "Belt and braces" in Note [Speculative evaluation]. | Unlifted <- lev = (CaseBound, StrictContextFloatable) | isStrUsedDmd dmd = (CaseBound, StrictContextFloatable) -- These will never be floated out of a lazy RHS context ===================================== compiler/GHC/Types/Literal.hs ===================================== @@ -1003,6 +1003,14 @@ data type. Here are the moving parts: This is sad, though: see #18983. + INVARIANT 3: we never make a rubbish literal of a terminating type + (isTerminatingType), such as a class dictionary. GHC relies on a value of + a terminating type never being bottom, and so may speculatively evaluate + a dictionary or select a superclass from it. Either would crash on a + rubbish literal (#24934, #25924). + See Note [Don't make fillers for terminating types] + in GHC.Core.Opt.WorkWrap.Utils. + 3. STG: The type app in `RUBBISH[IntRep] @Int# :: Int#` is erased and we get the (untyped) 'StgLit' `RUBBISH[IntRep] :: Int#` in STG. ===================================== testsuite/tests/dmdanal/should_compile/T18982.stderr ===================================== @@ -1,38 +1,26 @@ ==================== Tidy Core ==================== -Result size of Tidy Core = {terms: 295, types: 206, coercions: 4, joins: 0/0} - --- RHS size: {terms: 8, types: 9, coercions: 1, joins: 0/0} -T18982.$WExGADT :: forall e. (e ~ Int) => e %1 -> Int %1 -> ExGADT Int -T18982.$WExGADT = \ (@e) (conrep :: e ~ Int) (conrep1 :: e) (conrep2 :: Int) -> T18982.ExGADT @Int @e @~(<Int>_N :: Int GHC.Internal.Prim.~# Int) conrep conrep1 conrep2 - --- RHS size: {terms: 3, types: 2, coercions: 1, joins: 0/0} -T18982.$WGADT :: Int %1 -> GADT Int -T18982.$WGADT = \ (conrep :: Int) -> T18982.GADT @Int @~(<Int>_N :: Int GHC.Internal.Prim.~# Int) conrep - --- RHS size: {terms: 7, types: 6, coercions: 0, joins: 0/0} -T18982.$WEx :: forall e a. e %1 -> a %1 -> Ex a -T18982.$WEx = \ (@e) (@a) (conrep :: e) (conrep1 :: a) -> T18982.Ex @a @e conrep conrep1 +Result size of Tidy Core = {terms: 276, types: 179, coercions: 2, joins: 0/0} -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T18982.$trModule4 :: GHC.Internal.Prim.Addr# -T18982.$trModule4 = "main"# +$trModule1 :: GHC.Internal.Prim.Addr# +$trModule1 = "main"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T18982.$trModule3 :: GHC.Internal.Types.TrName -T18982.$trModule3 = GHC.Internal.Types.TrNameS T18982.$trModule4 +$trModule2 :: GHC.Internal.Types.TrName +$trModule2 = GHC.Internal.Types.TrNameS $trModule1 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T18982.$trModule2 :: GHC.Internal.Prim.Addr# -T18982.$trModule2 = "T18982"# +$trModule3 :: GHC.Internal.Prim.Addr# +$trModule3 = "T18982"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T18982.$trModule1 :: GHC.Internal.Types.TrName -T18982.$trModule1 = GHC.Internal.Types.TrNameS T18982.$trModule2 +$trModule4 :: GHC.Internal.Types.TrName +$trModule4 = GHC.Internal.Types.TrNameS $trModule3 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} T18982.$trModule :: GHC.Internal.Types.Module -T18982.$trModule = GHC.Internal.Types.Module T18982.$trModule3 T18982.$trModule1 +T18982.$trModule = GHC.Internal.Types.Module $trModule2 $trModule4 -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} $krep :: GHC.Internal.Types.KindRep @@ -47,16 +35,16 @@ $krep2 :: GHC.Internal.Types.KindRep $krep2 = GHC.Internal.Types.KindRepVar 0# -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T18982.$tcBox2 :: GHC.Internal.Prim.Addr# -T18982.$tcBox2 = "Box"# +$tcBox1 :: GHC.Internal.Prim.Addr# +$tcBox1 = "Box"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T18982.$tcBox1 :: GHC.Internal.Types.TrName -T18982.$tcBox1 = GHC.Internal.Types.TrNameS T18982.$tcBox2 +$tcBox2 :: GHC.Internal.Types.TrName +$tcBox2 = GHC.Internal.Types.TrNameS $tcBox1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} T18982.$tcBox :: GHC.Internal.Types.TyCon -T18982.$tcBox = GHC.Internal.Types.TyCon 16948648223906549518#Word64 2491460178135962649#Word64 T18982.$trModule T18982.$tcBox1 0# GHC.Internal.Types.krep$*Arr* +T18982.$tcBox = GHC.Internal.Types.TyCon 16948648223906549518#Word64 2491460178135962649#Word64 T18982.$trModule $tcBox2 0# GHC.Internal.Types.krep$*Arr* -- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} $krep3 :: [GHC.Internal.Types.KindRep] @@ -67,140 +55,140 @@ $krep4 :: GHC.Internal.Types.KindRep $krep4 = GHC.Internal.Types.KindRepTyConApp T18982.$tcBox $krep3 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T18982.$tc'Box1 :: GHC.Internal.Types.KindRep -T18982.$tc'Box1 = GHC.Internal.Types.KindRepFun $krep2 $krep4 +$krep5 :: GHC.Internal.Types.KindRep +$krep5 = GHC.Internal.Types.KindRepFun $krep2 $krep4 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T18982.$tc'Box3 :: GHC.Internal.Prim.Addr# -T18982.$tc'Box3 = "'Box"# +$tc'Box1 :: GHC.Internal.Prim.Addr# +$tc'Box1 = "'Box"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T18982.$tc'Box2 :: GHC.Internal.Types.TrName -T18982.$tc'Box2 = GHC.Internal.Types.TrNameS T18982.$tc'Box3 +$tc'Box2 :: GHC.Internal.Types.TrName +$tc'Box2 = GHC.Internal.Types.TrNameS $tc'Box1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} T18982.$tc'Box :: GHC.Internal.Types.TyCon -T18982.$tc'Box = GHC.Internal.Types.TyCon 1412068769125067428#Word64 8727214667407894081#Word64 T18982.$trModule T18982.$tc'Box2 1# T18982.$tc'Box1 +T18982.$tc'Box = GHC.Internal.Types.TyCon 1412068769125067428#Word64 8727214667407894081#Word64 T18982.$trModule $tc'Box2 1# $krep5 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T18982.$tcEx2 :: GHC.Internal.Prim.Addr# -T18982.$tcEx2 = "Ex"# +$tcEx1 :: GHC.Internal.Prim.Addr# +$tcEx1 = "Ex"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T18982.$tcEx1 :: GHC.Internal.Types.TrName -T18982.$tcEx1 = GHC.Internal.Types.TrNameS T18982.$tcEx2 +$tcEx2 :: GHC.Internal.Types.TrName +$tcEx2 = GHC.Internal.Types.TrNameS $tcEx1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} T18982.$tcEx :: GHC.Internal.Types.TyCon -T18982.$tcEx = GHC.Internal.Types.TyCon 4376661818164435927#Word64 18005417598910668817#Word64 T18982.$trModule T18982.$tcEx1 0# GHC.Internal.Types.krep$*Arr* +T18982.$tcEx = GHC.Internal.Types.TyCon 4376661818164435927#Word64 18005417598910668817#Word64 T18982.$trModule $tcEx2 0# GHC.Internal.Types.krep$*Arr* -- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} -$krep5 :: [GHC.Internal.Types.KindRep] -$krep5 = GHC.Internal.Types.: @GHC.Internal.Types.KindRep $krep1 (GHC.Internal.Types.[] @GHC.Internal.Types.KindRep) +$krep6 :: [GHC.Internal.Types.KindRep] +$krep6 = GHC.Internal.Types.: @GHC.Internal.Types.KindRep $krep1 (GHC.Internal.Types.[] @GHC.Internal.Types.KindRep) -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep6 :: GHC.Internal.Types.KindRep -$krep6 = GHC.Internal.Types.KindRepTyConApp T18982.$tcEx $krep5 +$krep7 :: GHC.Internal.Types.KindRep +$krep7 = GHC.Internal.Types.KindRepTyConApp T18982.$tcEx $krep6 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep7 :: GHC.Internal.Types.KindRep -$krep7 = GHC.Internal.Types.KindRepFun $krep1 $krep6 +$krep8 :: GHC.Internal.Types.KindRep +$krep8 = GHC.Internal.Types.KindRepFun $krep1 $krep7 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T18982.$tc'Ex1 :: GHC.Internal.Types.KindRep -T18982.$tc'Ex1 = GHC.Internal.Types.KindRepFun $krep2 $krep7 +$krep9 :: GHC.Internal.Types.KindRep +$krep9 = GHC.Internal.Types.KindRepFun $krep2 $krep8 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T18982.$tc'Ex3 :: GHC.Internal.Prim.Addr# -T18982.$tc'Ex3 = "'Ex"# +$tc'Ex1 :: GHC.Internal.Prim.Addr# +$tc'Ex1 = "'Ex"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T18982.$tc'Ex2 :: GHC.Internal.Types.TrName -T18982.$tc'Ex2 = GHC.Internal.Types.TrNameS T18982.$tc'Ex3 +$tc'Ex2 :: GHC.Internal.Types.TrName +$tc'Ex2 = GHC.Internal.Types.TrNameS $tc'Ex1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} T18982.$tc'Ex :: GHC.Internal.Types.TyCon -T18982.$tc'Ex = GHC.Internal.Types.TyCon 14609381081172201359#Word64 3077219645053200509#Word64 T18982.$trModule T18982.$tc'Ex2 2# T18982.$tc'Ex1 +T18982.$tc'Ex = GHC.Internal.Types.TyCon 14609381081172201359#Word64 3077219645053200509#Word64 T18982.$trModule $tc'Ex2 2# $krep9 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T18982.$tcGADT2 :: GHC.Internal.Prim.Addr# -T18982.$tcGADT2 = "GADT"# +$tcGADT1 :: GHC.Internal.Prim.Addr# +$tcGADT1 = "GADT"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T18982.$tcGADT1 :: GHC.Internal.Types.TrName -T18982.$tcGADT1 = GHC.Internal.Types.TrNameS T18982.$tcGADT2 +$tcGADT2 :: GHC.Internal.Types.TrName +$tcGADT2 = GHC.Internal.Types.TrNameS $tcGADT1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} T18982.$tcGADT :: GHC.Internal.Types.TyCon -T18982.$tcGADT = GHC.Internal.Types.TyCon 9243924476135839950#Word64 5096619276488416461#Word64 T18982.$trModule T18982.$tcGADT1 0# GHC.Internal.Types.krep$*Arr* +T18982.$tcGADT = GHC.Internal.Types.TyCon 9243924476135839950#Word64 5096619276488416461#Word64 T18982.$trModule $tcGADT2 0# GHC.Internal.Types.krep$*Arr* -- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} -$krep8 :: [GHC.Internal.Types.KindRep] -$krep8 = GHC.Internal.Types.: @GHC.Internal.Types.KindRep $krep (GHC.Internal.Types.[] @GHC.Internal.Types.KindRep) +$krep10 :: [GHC.Internal.Types.KindRep] +$krep10 = GHC.Internal.Types.: @GHC.Internal.Types.KindRep $krep (GHC.Internal.Types.[] @GHC.Internal.Types.KindRep) -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep9 :: GHC.Internal.Types.KindRep -$krep9 = GHC.Internal.Types.KindRepTyConApp T18982.$tcGADT $krep8 +$krep11 :: GHC.Internal.Types.KindRep +$krep11 = GHC.Internal.Types.KindRepTyConApp T18982.$tcGADT $krep10 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T18982.$tc'GADT1 :: GHC.Internal.Types.KindRep -T18982.$tc'GADT1 = GHC.Internal.Types.KindRepFun $krep $krep9 +$krep12 :: GHC.Internal.Types.KindRep +$krep12 = GHC.Internal.Types.KindRepFun $krep $krep11 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T18982.$tc'GADT3 :: GHC.Internal.Prim.Addr# -T18982.$tc'GADT3 = "'GADT"# +$tc'GADT1 :: GHC.Internal.Prim.Addr# +$tc'GADT1 = "'GADT"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T18982.$tc'GADT2 :: GHC.Internal.Types.TrName -T18982.$tc'GADT2 = GHC.Internal.Types.TrNameS T18982.$tc'GADT3 +$tc'GADT2 :: GHC.Internal.Types.TrName +$tc'GADT2 = GHC.Internal.Types.TrNameS $tc'GADT1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} T18982.$tc'GADT :: GHC.Internal.Types.TyCon -T18982.$tc'GADT = GHC.Internal.Types.TyCon 2077850259354179864#Word64 16731205864486799217#Word64 T18982.$trModule T18982.$tc'GADT2 0# T18982.$tc'GADT1 +T18982.$tc'GADT = GHC.Internal.Types.TyCon 2077850259354179864#Word64 16731205864486799217#Word64 T18982.$trModule $tc'GADT2 0# $krep12 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T18982.$tcExGADT2 :: GHC.Internal.Prim.Addr# -T18982.$tcExGADT2 = "ExGADT"# +$tcExGADT1 :: GHC.Internal.Prim.Addr# +$tcExGADT1 = "ExGADT"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T18982.$tcExGADT1 :: GHC.Internal.Types.TrName -T18982.$tcExGADT1 = GHC.Internal.Types.TrNameS T18982.$tcExGADT2 +$tcExGADT2 :: GHC.Internal.Types.TrName +$tcExGADT2 = GHC.Internal.Types.TrNameS $tcExGADT1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} T18982.$tcExGADT :: GHC.Internal.Types.TyCon -T18982.$tcExGADT = GHC.Internal.Types.TyCon 6470898418160489500#Word64 10361108917441214060#Word64 T18982.$trModule T18982.$tcExGADT1 0# GHC.Internal.Types.krep$*Arr* +T18982.$tcExGADT = GHC.Internal.Types.TyCon 6470898418160489500#Word64 10361108917441214060#Word64 T18982.$trModule $tcExGADT2 0# GHC.Internal.Types.krep$*Arr* -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep10 :: GHC.Internal.Types.KindRep -$krep10 = GHC.Internal.Types.KindRepTyConApp T18982.$tcExGADT $krep8 +$krep13 :: GHC.Internal.Types.KindRep +$krep13 = GHC.Internal.Types.KindRepTyConApp T18982.$tcExGADT $krep10 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep11 :: GHC.Internal.Types.KindRep -$krep11 = GHC.Internal.Types.KindRepFun $krep $krep10 +$krep14 :: GHC.Internal.Types.KindRep +$krep14 = GHC.Internal.Types.KindRepFun $krep $krep13 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T18982.$tc'ExGADT1 :: GHC.Internal.Types.KindRep -T18982.$tc'ExGADT1 = GHC.Internal.Types.KindRepFun $krep2 $krep11 +$krep15 :: GHC.Internal.Types.KindRep +$krep15 = GHC.Internal.Types.KindRepFun $krep2 $krep14 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T18982.$tc'ExGADT3 :: GHC.Internal.Prim.Addr# -T18982.$tc'ExGADT3 = "'ExGADT"# +$tc'ExGADT1 :: GHC.Internal.Prim.Addr# +$tc'ExGADT1 = "'ExGADT"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T18982.$tc'ExGADT2 :: GHC.Internal.Types.TrName -T18982.$tc'ExGADT2 = GHC.Internal.Types.TrNameS T18982.$tc'ExGADT3 +$tc'ExGADT2 :: GHC.Internal.Types.TrName +$tc'ExGADT2 = GHC.Internal.Types.TrNameS $tc'ExGADT1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} T18982.$tc'ExGADT :: GHC.Internal.Types.TyCon -T18982.$tc'ExGADT = GHC.Internal.Types.TyCon 8468257409157161049#Word64 5503123603717080600#Word64 T18982.$trModule T18982.$tc'ExGADT2 1# T18982.$tc'ExGADT1 +T18982.$tc'ExGADT = GHC.Internal.Types.TyCon 8468257409157161049#Word64 5503123603717080600#Word64 T18982.$trModule $tc'ExGADT2 1# $krep15 --- RHS size: {terms: 11, types: 10, coercions: 0, joins: 0/0} -T18982.$wi :: forall a e. (a GHC.Internal.Prim.~# Int) => e -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.Int# -T18982.$wi = \ (@a) (@e) (ww :: a GHC.Internal.Prim.~# Int) (ww1 :: e) (ww2 :: GHC.Internal.Prim.Int#) -> case ww1 of { __DEFAULT -> GHC.Internal.Prim.+# ww2 1# } +-- RHS size: {terms: 12, types: 14, coercions: 0, joins: 0/0} +T18982.$wi :: forall a e. (a GHC.Internal.Prim.~# Int, e ~ Int) => e -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.Int# +T18982.$wi = \ (@a) (@e) (ww :: a GHC.Internal.Prim.~# Int) (ww1 :: e ~ Int) (ww2 :: e) (ww3 :: GHC.Internal.Prim.Int#) -> case ww2 of { __DEFAULT -> GHC.Internal.Prim.+# ww3 1# } --- RHS size: {terms: 15, types: 22, coercions: 1, joins: 0/0} +-- RHS size: {terms: 16, types: 22, coercions: 1, joins: 0/0} i :: forall a. ExGADT a -> Int -i = \ (@a) (ds :: ExGADT a) -> case ds of { ExGADT @e ww ww1 ww2 ww3 -> case ww3 of { GHC.Internal.Types.I# ww4 -> case T18982.$wi @a @e @~(ww :: a GHC.Internal.Prim.~# Int) ww2 ww4 of ww5 { __DEFAULT -> GHC.Internal.Types.I# ww5 } } } +i = \ (@a) (ds :: ExGADT a) -> case ds of { ExGADT @e ww ww1 ww2 ww3 -> case ww3 of { GHC.Internal.Types.I# ww4 -> case T18982.$wi @a @e @~(ww :: a GHC.Internal.Prim.~# Int) ww1 ww2 ww4 of ww5 { __DEFAULT -> GHC.Internal.Types.I# ww5 } } } -- RHS size: {terms: 6, types: 7, coercions: 0, joins: 0/0} T18982.$wh :: forall a. (a GHC.Internal.Prim.~# Int) => GHC.Internal.Prim.Int# -> GHC.Internal.Prim.Int# ===================================== testsuite/tests/simplCore/should_compile/T26615.stderr ===================================== @@ -2,7 +2,7 @@ ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 1,209, types: 1,155, coercions: 18, joins: 17/29} + = {terms: 1,229, types: 1,163, coercions: 18, joins: 17/29} -- RHS size: {terms: 6, types: 8, coercions: 0, joins: 0/0} unArray :: forall a. Array a -> SmallArray# a @@ -414,7 +414,7 @@ T26615a.$tc'BitmapIndexed 2# $krep24 --- RHS size: {terms: 98, types: 109, coercions: 0, joins: 3/4} +-- RHS size: {terms: 101, types: 113, coercions: 0, joins: 3/4} T26615a.$wdisjointCollisions [InlPrag=INLINABLE[2]] :: forall k a b. Eq k => @@ -561,13 +561,14 @@ T26615a.$wdisjointCollisions joinrec { $wlookupInArrayCont_ [InlPrag=[2], Occ=LoopBreaker, - Dmd=SC(S,C(1,C(1,C(1,L))))] - :: k -> SmallArray# (Leaf k b) -> Int# -> Int# -> Bool - [LclId[JoinId(4)(Just [!])], - Arity=4, - Str=<1L><L><L><L>, + Dmd=SC(S,C(1,C(1,C(1,C(1,L)))))] + :: Eq k => k -> SmallArray# (Leaf k b) -> Int# -> Int# -> Bool + [LclId[JoinId(5)(Just [~, !])], + Arity=5, + Str=<A><1L><L><L><L>, Unf=OtherCon []] - $wlookupInArrayCont_ (k1 :: k) + $wlookupInArrayCont_ ($dEq1 [Occ=Dead] :: Eq k) + (k1 :: k) (ww3 :: SmallArray# (Leaf k b)) (ww4 :: Int#) (ww5 :: Int#) @@ -578,7 +579,7 @@ T26615a.$wdisjointCollisions { (# ipv2 #) -> case ipv2 of { L kx v -> case == @k $dEq k2 kx of { - False -> jump $wlookupInArrayCont_ k2 ww3 (+# ww4 1#) ww5; + False -> jump $wlookupInArrayCont_ $dEq k2 ww3 (+# ww4 1#) ww5; True -> GHC.Internal.Types.False } } @@ -586,7 +587,7 @@ T26615a.$wdisjointCollisions 1# -> jump $j } }; } in - jump $wlookupInArrayCont_ kA ww2 0# lvl2 + jump $wlookupInArrayCont_ $dEq kA ww2 0# lvl2 } }; 1# -> sc3 @@ -611,7 +612,7 @@ lvl1 = GHC.Internal.Control.Exception.Base.patError @LiftedRep @() lvl Rec { --- RHS size: {terms: 133, types: 126, coercions: 0, joins: 1/2} +-- RHS size: {terms: 136, types: 130, coercions: 0, joins: 1/2} T26615a.disjointSubtrees_$s$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] :: forall k a b. @@ -641,13 +642,14 @@ T26615a.disjointSubtrees_$s$wdisjointSubtrees joinrec { $wlookupInArrayCont_ [InlPrag=[2], Occ=LoopBreaker, - Dmd=SC(S,C(1,C(1,C(1,L))))] - :: k -> SmallArray# (Leaf k a) -> Int# -> Int# -> Bool - [LclId[JoinId(4)(Just [!])], - Arity=4, - Str=<1L><L><L><L>, + Dmd=SC(S,C(1,C(1,C(1,C(1,L)))))] + :: Eq k => k -> SmallArray# (Leaf k a) -> Int# -> Int# -> Bool + [LclId[JoinId(5)(Just [~, !])], + Arity=5, + Str=<A><1L><L><L><L>, Unf=OtherCon []] - $wlookupInArrayCont_ (k1 :: k) + $wlookupInArrayCont_ ($dEq [Occ=Dead] :: Eq k) + (k1 :: k) (ww :: SmallArray# (Leaf k a)) (ww1 :: Int#) (ww2 :: Int#) @@ -657,7 +659,7 @@ T26615a.disjointSubtrees_$s$wdisjointSubtrees case indexSmallArray# @Lifted @(Leaf k a) ww ww1 of { (# ipv #) -> case ipv of { L kx v -> case == @k sc k2 kx of { - False -> jump $wlookupInArrayCont_ k2 ww (+# ww1 1#) ww2; + False -> jump $wlookupInArrayCont_ sc k2 ww (+# ww1 1#) ww2; True -> GHC.Internal.Types.False } } @@ -666,7 +668,7 @@ T26615a.disjointSubtrees_$s$wdisjointSubtrees } }; } in jump $wlookupInArrayCont_ - k0 sc3 0# (sizeofSmallArray# @Lifted @(Leaf k a) sc3) + sc k0 sc3 0# (sizeofSmallArray# @Lifted @(Leaf k a) sc3) } } }; @@ -708,7 +710,7 @@ T26615a.disjointSubtrees_$s$wdisjointSubtrees end Rec } Rec { --- RHS size: {terms: 705, types: 748, coercions: 18, joins: 13/23} +-- RHS size: {terms: 719, types: 748, coercions: 18, joins: 13/23} T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] :: forall k a b. Eq k => Int# -> HashMap k a -> HashMap k b -> Bool [GblId[StrictWorker([~, ~, !])], @@ -1065,23 +1067,23 @@ T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] @(*) @(SmallArray# (HashMap k a) -> SmallArray# (HashMap k b) -> Int#) - @(GHC.Internal.Types.UnusedType 0 "a" - -> GHC.Internal.Types.UnusedType 1 "b" -> Int#) + @(GHC.Internal.Types.UnusedType "a_0" + -> GHC.Internal.Types.UnusedType "b_1" -> Int#) of { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> case reallyUnsafePtrEquality# @Lifted @Lifted - @(GHC.Internal.Types.UnusedType 0 "a") - @(GHC.Internal.Types.UnusedType 1 "b") + @(GHC.Internal.Types.UnusedType "a_0") + @(GHC.Internal.Types.UnusedType "b_1") (bx1 `cast` (SelCo:Fun(arg) (Sub (Sym v2)) :: SmallArray# (HashMap k a) - ~R# GHC.Internal.Types.UnusedType 0 "a")) + ~R# GHC.Internal.Types.UnusedType "a_0")) (bx3 `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) :: SmallArray# (HashMap k b) - ~R# GHC.Internal.Types.UnusedType 1 "b")) + ~R# GHC.Internal.Types.UnusedType "b_1")) of { __DEFAULT -> joinrec { @@ -1234,23 +1236,23 @@ T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] case GHC.Internal.Unsafe.Coerce.unsafeEqualityProof @(*) @(SmallArray# (HashMap k a) -> SmallArray# (HashMap k b) -> Int#) - @(GHC.Internal.Types.UnusedType 0 "a" - -> GHC.Internal.Types.UnusedType 1 "b" -> Int#) + @(GHC.Internal.Types.UnusedType "a_0" + -> GHC.Internal.Types.UnusedType "b_1" -> Int#) of { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> case reallyUnsafePtrEquality# @Lifted @Lifted - @(GHC.Internal.Types.UnusedType 0 "a") - @(GHC.Internal.Types.UnusedType 1 "b") + @(GHC.Internal.Types.UnusedType "a_0") + @(GHC.Internal.Types.UnusedType "b_1") (bx `cast` (SelCo:Fun(arg) (Sub (Sym v2)) :: SmallArray# (HashMap k a) - ~R# GHC.Internal.Types.UnusedType 0 "a")) + ~R# GHC.Internal.Types.UnusedType "a_0")) (bx1 `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) :: SmallArray# (HashMap k b) - ~R# GHC.Internal.Types.UnusedType 1 "b")) + ~R# GHC.Internal.Types.UnusedType "b_1")) of { __DEFAULT -> jump go (GHC.Internal.Types.I# 31#); 1# -> GHC.Internal.Types.False @@ -1310,13 +1312,14 @@ T26615a.$wdisjointSubtrees joinrec { $wlookupInArrayCont_ [InlPrag=[2], Occ=LoopBreaker, - Dmd=SC(S,C(1,C(1,C(1,L))))] - :: k -> SmallArray# (Leaf k a) -> Int# -> Int# -> Bool - [LclId[JoinId(4)(Just [!])], - Arity=4, - Str=<1L><L><L><L>, + Dmd=SC(S,C(1,C(1,C(1,C(1,L)))))] + :: Eq k => k -> SmallArray# (Leaf k a) -> Int# -> Int# -> Bool + [LclId[JoinId(5)(Just [~, !])], + Arity=5, + Str=<A><1L><L><L><L>, Unf=OtherCon []] - $wlookupInArrayCont_ (k1 :: k) + $wlookupInArrayCont_ ($dEq1 [Occ=Dead] :: Eq k) + (k1 :: k) (ww2 :: SmallArray# (Leaf k a)) (ww3 :: Int#) (ww4 :: Int#) @@ -1327,7 +1330,8 @@ T26615a.$wdisjointSubtrees { (# ipv #) -> case ipv of { L kx v -> case == @k $dEq k2 kx of { - False -> jump $wlookupInArrayCont_ k2 ww2 (+# ww3 1#) ww4; + False -> + jump $wlookupInArrayCont_ $dEq k2 ww2 (+# ww3 1#) ww4; True -> GHC.Internal.Types.False } } @@ -1336,18 +1340,19 @@ T26615a.$wdisjointSubtrees } }; } in jump $wlookupInArrayCont_ - ds4 bx2 0# (sizeofSmallArray# @Lifted @(Leaf k a) bx2) + $dEq ds4 bx2 0# (sizeofSmallArray# @Lifted @(Leaf k a) bx2) } } in joinrec { $wlookupCont_ [InlPrag=[2], Occ=LoopBreaker, - Dmd=SC(S,C(1,C(1,C(1,L))))] - :: Word# -> k -> Int# -> HashMap k a -> Bool - [LclId[JoinId(4)(Just [~, !, ~, !])], - Arity=4, - Str=<L><1L><L><1L>, + Dmd=SC(S,C(1,C(1,C(1,C(1,L)))))] + :: Eq k => Word# -> k -> Int# -> HashMap k a -> Bool + [LclId[JoinId(5)(Just [~, ~, !, ~, !])], + Arity=5, + Str=<A><L><1L><L><1L>, Unf=OtherCon []] - $wlookupCont_ (ww1 :: Word#) + $wlookupCont_ ($dEq1 [Occ=Dead] :: Eq k) + (ww1 :: Word#) (ds4 :: k) (ww2 :: Int#) (ds5 :: HashMap k a) @@ -1371,7 +1376,7 @@ T26615a.$wdisjointSubtrees (word2Int# (popCnt# (and# bx1 (minusWord# m 1##)))) of { (# ipv #) -> - jump $wlookupCont_ ww1 ds6 (+# ww2 5#) ipv + jump $wlookupCont_ $dEq ww1 ds6 (+# ww2 5#) ipv }; 0## -> GHC.Internal.Types.True }; @@ -1383,11 +1388,11 @@ T26615a.$wdisjointSubtrees (word2Int# (and# (uncheckedShiftRL# ww1 ww2) 31##)) of { (# ipv #) -> - jump $wlookupCont_ ww1 ds6 (+# ww2 5#) ipv + jump $wlookupCont_ $dEq ww1 ds6 (+# ww2 5#) ipv } } }; } in - jump $wlookupCont_ bx k0 ww ds + jump $wlookupCont_ $dEq bx k0 ww ds } }; Collision bx bx1 -> @@ -1435,13 +1440,14 @@ T26615a.$wdisjointSubtrees joinrec { $wlookupInArrayCont_ [InlPrag=[2], Occ=LoopBreaker, - Dmd=SC(S,C(1,C(1,C(1,L))))] - :: k -> SmallArray# (Leaf k b) -> Int# -> Int# -> Bool - [LclId[JoinId(4)(Just [!])], - Arity=4, - Str=<1L><L><L><L>, + Dmd=SC(S,C(1,C(1,C(1,C(1,L)))))] + :: Eq k => k -> SmallArray# (Leaf k b) -> Int# -> Int# -> Bool + [LclId[JoinId(5)(Just [~, !])], + Arity=5, + Str=<A><1L><L><L><L>, Unf=OtherCon []] - $wlookupInArrayCont_ (k1 :: k) + $wlookupInArrayCont_ ($dEq1 [Occ=Dead] :: Eq k) + (k1 :: k) (ww2 :: SmallArray# (Leaf k b)) (ww3 :: Int#) (ww4 :: Int#) @@ -1452,7 +1458,7 @@ T26615a.$wdisjointSubtrees { (# ipv #) -> case ipv of { L kx v -> case == @k $dEq k2 kx of { - False -> jump $wlookupInArrayCont_ k2 ww2 (+# ww3 1#) ww4; + False -> jump $wlookupInArrayCont_ $dEq k2 ww2 (+# ww3 1#) ww4; True -> GHC.Internal.Types.False } } @@ -1461,18 +1467,19 @@ T26615a.$wdisjointSubtrees } }; } in jump $wlookupInArrayCont_ - ds3 bx2 0# (sizeofSmallArray# @Lifted @(Leaf k b) bx2) + $dEq ds3 bx2 0# (sizeofSmallArray# @Lifted @(Leaf k b) bx2) } } in joinrec { $wlookupCont_ [InlPrag=[2], Occ=LoopBreaker, - Dmd=SC(S,C(1,C(1,C(1,L))))] - :: Word# -> k -> Int# -> HashMap k b -> Bool - [LclId[JoinId(4)(Just [~, !, ~, !])], - Arity=4, - Str=<L><1L><L><1L>, + Dmd=SC(S,C(1,C(1,C(1,C(1,L)))))] + :: Eq k => Word# -> k -> Int# -> HashMap k b -> Bool + [LclId[JoinId(5)(Just [~, ~, !, ~, !])], + Arity=5, + Str=<A><L><1L><L><1L>, Unf=OtherCon []] - $wlookupCont_ (ww1 :: Word#) + $wlookupCont_ ($dEq1 [Occ=Dead] :: Eq k) + (ww1 :: Word#) (ds3 :: k) (ww2 :: Int#) (ds4 :: HashMap k b) @@ -1496,7 +1503,7 @@ T26615a.$wdisjointSubtrees (word2Int# (popCnt# (and# bx1 (minusWord# m 1##)))) of { (# ipv #) -> - jump $wlookupCont_ ww1 ds5 (+# ww2 5#) ipv + jump $wlookupCont_ $dEq ww1 ds5 (+# ww2 5#) ipv }; 0## -> GHC.Internal.Types.True }; @@ -1508,11 +1515,11 @@ T26615a.$wdisjointSubtrees (word2Int# (and# (uncheckedShiftRL# ww1 ww2) 31##)) of { (# ipv #) -> - jump $wlookupCont_ ww1 ds5 (+# ww2 5#) ipv + jump $wlookupCont_ $dEq ww1 ds5 (+# ww2 5#) ipv } } }; } in - jump $wlookupCont_ bx k0 ww wild2 + jump $wlookupCont_ $dEq bx k0 ww wild2 }; Leaf bx1 ds3 -> case ds3 of { L kB ds4 -> @@ -1570,23 +1577,23 @@ T26615a.$wdisjointSubtrees case GHC.Internal.Unsafe.Coerce.unsafeEqualityProof @(*) @(SmallArray# (HashMap k a) -> SmallArray# (HashMap k b) -> Int#) - @(GHC.Internal.Types.UnusedType 0 "a" - -> GHC.Internal.Types.UnusedType 1 "b" -> Int#) + @(GHC.Internal.Types.UnusedType "a_0" + -> GHC.Internal.Types.UnusedType "b_1" -> Int#) of { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> case reallyUnsafePtrEquality# @Lifted @Lifted - @(GHC.Internal.Types.UnusedType 0 "a") - @(GHC.Internal.Types.UnusedType 1 "b") + @(GHC.Internal.Types.UnusedType "a_0") + @(GHC.Internal.Types.UnusedType "b_1") (bx1 `cast` (SelCo:Fun(arg) (Sub (Sym v2)) :: SmallArray# (HashMap k a) - ~R# GHC.Internal.Types.UnusedType 0 "a")) + ~R# GHC.Internal.Types.UnusedType "a_0")) (bx3 `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) :: SmallArray# (HashMap k b) - ~R# GHC.Internal.Types.UnusedType 1 "b")) + ~R# GHC.Internal.Types.UnusedType "b_1")) of { __DEFAULT -> let { @@ -1715,23 +1722,23 @@ T26615a.$wdisjointSubtrees case GHC.Internal.Unsafe.Coerce.unsafeEqualityProof @(*) @(SmallArray# (HashMap k a) -> SmallArray# (HashMap k b) -> Int#) - @(GHC.Internal.Types.UnusedType 0 "a" - -> GHC.Internal.Types.UnusedType 1 "b" -> Int#) + @(GHC.Internal.Types.UnusedType "a_0" + -> GHC.Internal.Types.UnusedType "b_1" -> Int#) of { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> case reallyUnsafePtrEquality# @Lifted @Lifted - @(GHC.Internal.Types.UnusedType 0 "a") - @(GHC.Internal.Types.UnusedType 1 "b") + @(GHC.Internal.Types.UnusedType "a_0") + @(GHC.Internal.Types.UnusedType "b_1") (bx `cast` (SelCo:Fun(arg) (Sub (Sym v2)) :: SmallArray# (HashMap k a) - ~R# GHC.Internal.Types.UnusedType 0 "a")) + ~R# GHC.Internal.Types.UnusedType "a_0")) (bx1 `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) :: SmallArray# (HashMap k b) - ~R# GHC.Internal.Types.UnusedType 1 "b")) + ~R# GHC.Internal.Types.UnusedType "b_1")) of { __DEFAULT -> let { @@ -1838,7 +1845,7 @@ disjointSubtrees ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 614, types: 682, coercions: 18, joins: 8/14} + = {terms: 622, types: 674, coercions: 18, joins: 8/14} -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} $trModule1 :: GHC.Internal.Prim.Addr# @@ -1878,20 +1885,22 @@ lvl1 @GHC.Internal.Types.LiftedRep @() lvl Rec { --- RHS size: {terms: 37, types: 30, coercions: 0, joins: 0/0} +-- RHS size: {terms: 39, types: 32, coercions: 0, joins: 0/0} $wpoly_lookupInArrayCont_ :: forall a. + Eq String => String -> GHC.Internal.Prim.SmallArray# (T26615a.Leaf String a) -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.Int# -> Bool -[GblId[StrictWorker([!])], - Arity=4, - Str=<1L><L><L><L>, +[GblId[StrictWorker([~, !])], + Arity=5, + Str=<A><1L><L><L><L>, Unf=OtherCon []] $wpoly_lookupInArrayCont_ = \ (@a) + ($dEq2 [Occ=Dead] :: Eq String) (k1 :: String) (ww :: GHC.Internal.Prim.SmallArray# (T26615a.Leaf String a)) (ww1 :: GHC.Internal.Prim.Int#) @@ -1907,7 +1916,12 @@ $wpoly_lookupInArrayCont_ case GHC.Internal.Base.eqString k2 kx of { False -> $wpoly_lookupInArrayCont_ - @a k2 ww (GHC.Internal.Prim.+# ww1 1#) ww2; + @a + GHC.Internal.Classes.$fEqList_$s$fEqList1 + k2 + ww + (GHC.Internal.Prim.+# ww1 1#) + ww2; True -> GHC.Internal.Types.False } } @@ -1918,17 +1932,19 @@ $wpoly_lookupInArrayCont_ end Rec } Rec { --- RHS size: {terms: 98, types: 73, coercions: 0, joins: 0/1} +-- RHS size: {terms: 102, types: 75, coercions: 0, joins: 0/1} $wpoly_lookupCont_ :: forall a. + Eq String => GHC.Internal.Prim.Word# -> String -> GHC.Internal.Prim.Int# -> HashMap String a -> Bool -[GblId[StrictWorker([~, !, ~, !])], - Arity=4, - Str=<L><1L><L><1L>, +[GblId[StrictWorker([~, ~, !, ~, !])], + Arity=5, + Str=<A><L><1L><L><1L>, Unf=OtherCon []] $wpoly_lookupCont_ = \ (@a) + ($dEq1 [Occ=Dead] :: Eq String) (ww :: GHC.Internal.Prim.Word#) (ds5 :: String) (ww1 :: GHC.Internal.Prim.Int#) @@ -1953,6 +1969,7 @@ $wpoly_lookupCont_ 1# -> $wpoly_lookupInArrayCont_ @a + GHC.Internal.Classes.$fEqList_$s$fEqList1 ds9 bx2 0# @@ -1979,7 +1996,13 @@ $wpoly_lookupCont_ (GHC.Internal.Prim.and# bx1 (GHC.Internal.Prim.minusWord# m 1##)))) of { (# ipv2 #) -> - $wpoly_lookupCont_ @a ww ds9 (GHC.Internal.Prim.+# ww1 5#) ipv2 + $wpoly_lookupCont_ + @a + GHC.Internal.Classes.$fEqList_$s$fEqList1 + ww + ds9 + (GHC.Internal.Prim.+# ww1 5#) + ipv2 }; 0## -> GHC.Internal.Types.True }; @@ -1993,14 +2016,20 @@ $wpoly_lookupCont_ (GHC.Internal.Prim.uncheckedShiftRL# ww ww1) 31##)) of { (# ipv2 #) -> - $wpoly_lookupCont_ @a ww ds9 (GHC.Internal.Prim.+# ww1 5#) ipv2 + $wpoly_lookupCont_ + @a + GHC.Internal.Classes.$fEqList_$s$fEqList1 + ww + ds9 + (GHC.Internal.Prim.+# ww1 5#) + ipv2 } } } end Rec } Rec { --- RHS size: {terms: 448, types: 523, coercions: 18, joins: 8/13} +-- RHS size: {terms: 450, types: 507, coercions: 18, joins: 8/13} T26615.$s$wdisjointSubtrees [InlPrag=[~], Occ=LoopBreaker] :: forall a b. GHC.Internal.Prim.Int# @@ -2021,7 +2050,8 @@ T26615.$s$wdisjointSubtrees T26615a.Empty -> GHC.Internal.Types.True; T26615a.Leaf bx ds2 -> case ds2 of { T26615a.L kB ds3 -> - $wpoly_lookupCont_ @a bx kB ww ds + $wpoly_lookupCont_ + @a GHC.Internal.Classes.$fEqList_$s$fEqList1 bx kB ww ds }; T26615a.Collision bx bx1 -> T26615.$s$wdisjointSubtrees @b @a ww wild ds @@ -2031,7 +2061,9 @@ T26615.$s$wdisjointSubtrees T26615a.Leaf bx ds1 -> case ds1 of { T26615a.L kA ds2 -> case _b of wild2 { - __DEFAULT -> $wpoly_lookupCont_ @b bx kA ww wild2; + __DEFAULT -> + $wpoly_lookupCont_ + @b GHC.Internal.Classes.$fEqList_$s$fEqList1 bx kA ww wild2; T26615a.Leaf bx1 ds3 -> case ds3 of { T26615a.L kB ds4 -> case GHC.Internal.Prim.neWord# bx bx1 of { @@ -2085,9 +2117,9 @@ T26615.$s$wdisjointSubtrees [LclId[JoinId(0)(Nothing)]] $j = jump $s$wfoldr_ sc sc1 (GHC.Internal.Prim.+# sc2 1#) sc3 } in joinrec { - $wlookupInArrayCont_ [InlPrag=[2], - Occ=LoopBreaker, - Dmd=SC(S,C(1,C(1,C(1,L))))] + $w$slookupInArrayCont_ [InlPrag=[2], + Occ=LoopBreaker, + Dmd=SC(S,C(1,C(1,C(1,L))))] :: String -> GHC.Internal.Prim.SmallArray# (T26615a.Leaf String b) -> GHC.Internal.Prim.Int# @@ -2097,12 +2129,12 @@ T26615.$s$wdisjointSubtrees Arity=4, Str=<1L><L><L><L>, Unf=OtherCon []] - $wlookupInArrayCont_ (k1 :: String) - (ww1 - :: GHC.Internal.Prim.SmallArray# - (T26615a.Leaf String b)) - (ww2 :: GHC.Internal.Prim.Int#) - (ww3 :: GHC.Internal.Prim.Int#) + $w$slookupInArrayCont_ (k1 :: String) + (ww1 + :: GHC.Internal.Prim.SmallArray# + (T26615a.Leaf String b)) + (ww2 :: GHC.Internal.Prim.Int#) + (ww3 :: GHC.Internal.Prim.Int#) = case k1 of k2 { __DEFAULT -> case GHC.Internal.Prim.>=# ww2 ww3 of { __DEFAULT -> @@ -2116,7 +2148,7 @@ T26615.$s$wdisjointSubtrees case ipv5 of { T26615a.L kx v -> case GHC.Internal.Base.eqString k2 kx of { False -> - jump $wlookupInArrayCont_ + jump $w$slookupInArrayCont_ k2 ww1 (GHC.Internal.Prim.+# ww2 1#) ww3; True -> GHC.Internal.Types.False } @@ -2125,7 +2157,7 @@ T26615.$s$wdisjointSubtrees 1# -> jump $j } }; } in - jump $wlookupInArrayCont_ kA bx3 0# lvl2 + jump $w$slookupInArrayCont_ kA bx3 0# lvl2 } }; 1# -> sc3 @@ -2187,23 +2219,23 @@ T26615.$s$wdisjointSubtrees @(GHC.Internal.Prim.SmallArray# (HashMap String a) -> GHC.Internal.Prim.SmallArray# (HashMap String b) -> GHC.Internal.Prim.Int#) - @(GHC.Internal.Types.UnusedType 0 "a" - -> GHC.Internal.Types.UnusedType 1 "b" -> GHC.Internal.Prim.Int#) + @(GHC.Internal.Types.UnusedType "a_0" + -> GHC.Internal.Types.UnusedType "b_1" -> GHC.Internal.Prim.Int#) of { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> case GHC.Internal.Prim.reallyUnsafePtrEquality# @GHC.Internal.Types.Lifted @GHC.Internal.Types.Lifted - @(GHC.Internal.Types.UnusedType 0 "a") - @(GHC.Internal.Types.UnusedType 1 "b") + @(GHC.Internal.Types.UnusedType "a_0") + @(GHC.Internal.Types.UnusedType "b_1") (bx1 `cast` (SelCo:Fun(arg) (Sub (Sym v2)) :: GHC.Internal.Prim.SmallArray# (HashMap String a) - ~R# GHC.Internal.Types.UnusedType 0 "a")) + ~R# GHC.Internal.Types.UnusedType "a_0")) (bx3 `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) :: GHC.Internal.Prim.SmallArray# (HashMap String b) - ~R# GHC.Internal.Types.UnusedType 1 "b")) + ~R# GHC.Internal.Types.UnusedType "b_1")) of { __DEFAULT -> joinrec { @@ -2365,23 +2397,23 @@ T26615.$s$wdisjointSubtrees @(GHC.Internal.Prim.SmallArray# (HashMap String a) -> GHC.Internal.Prim.SmallArray# (HashMap String b) -> GHC.Internal.Prim.Int#) - @(GHC.Internal.Types.UnusedType 0 "a" - -> GHC.Internal.Types.UnusedType 1 "b" -> GHC.Internal.Prim.Int#) + @(GHC.Internal.Types.UnusedType "a_0" + -> GHC.Internal.Types.UnusedType "b_1" -> GHC.Internal.Prim.Int#) of { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> case GHC.Internal.Prim.reallyUnsafePtrEquality# @GHC.Internal.Types.Lifted @GHC.Internal.Types.Lifted - @(GHC.Internal.Types.UnusedType 0 "a") - @(GHC.Internal.Types.UnusedType 1 "b") + @(GHC.Internal.Types.UnusedType "a_0") + @(GHC.Internal.Types.UnusedType "b_1") (bx `cast` (SelCo:Fun(arg) (Sub (Sym v2)) :: GHC.Internal.Prim.SmallArray# (HashMap String a) - ~R# GHC.Internal.Types.UnusedType 0 "a")) + ~R# GHC.Internal.Types.UnusedType "a_0")) (bx1 `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) :: GHC.Internal.Prim.SmallArray# (HashMap String b) - ~R# GHC.Internal.Types.UnusedType 1 "b")) + ~R# GHC.Internal.Types.UnusedType "b_1")) of { __DEFAULT -> joinrec { View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/98766eff496f8f53822854295de4d6e… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/98766eff496f8f53822854295de4d6e… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/25924] Don't make absent fillers for terminating types
by Zubin (＠wz1000) 03 Jul '26

03 Jul '26

Zubin pushed to branch wip/25924 at Glasgow Haskell Compiler / GHC Commits: 0d938a44 by Zubin Duggal at 2026-07-03T10:26:32+05:30 Don't make absent fillers for terminating types In #25924 we discovered that we could speculatively evaluate an absent filler for a dictionary, and project a field (a superclass selector) out of it, resulting in segfaults. Solution: Never make an absent filler or rubbish literal for a terminating type like a dictionary. mkAbsentFiller returns Nothing for isTerminatingType, so worker/wrapper and the specialiser keep the real argument instead. Some small metric decreases because we do a little less work in the simplifier now. Metric Decrease: T9872a T9872b T9872c TcPlugin_RewritePerf - - - - - 6 changed files: - changelog.d/fix-absent-dict-projection - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - testsuite/tests/dmdanal/should_compile/T18982.stderr - testsuite/tests/simplCore/should_compile/T26615.stderr Changes: ===================================== changelog.d/fix-absent-dict-projection ===================================== @@ -1,5 +1,8 @@ section: compiler -synopsis: Fix a CorePrep miscompilation that could project a field out of an absent dictionary, resulting in a segfault. +synopsis: Fix a miscompilation that could project a field out of an absent dictionary, resulting in a segfault. issues: #25924 mrs: !16219 -description: We no longer speculatively evaluate bindings that we have already discovered are absent. +description: + We no longer make an absent filler (a rubbish literal or error thunk) for an + absent dictionary or other terminating type. We also no longer speculatively + evaluate a binding once we have discovered that it is absent. ===================================== compiler/GHC/Core/Opt/Specialise.hs ===================================== @@ -19,12 +19,13 @@ import GHC.Core.SimpleOpt( defaultSimpleOpts, simpleOptExprWith, exprIsConApp_ma import GHC.Core.Predicate import GHC.Core.Class( classMethods ) import GHC.Core.Coercion( Coercion ) -import GHC.Core.DataCon (dataConTyCon) +import GHC.Core.DataCon (dataConTyCon, StrictnessMark(NotMarkedStrict)) import qualified GHC.Core.Subst as Core import GHC.Core.Unfold.Make import GHC.Core -import GHC.Core.Make ( mkLitRubbish, wrapFloats ) +import GHC.Core.Make ( wrapFloats ) +import GHC.Core.Opt.WorkWrap.Utils ( mkAbsentFiller ) import GHC.Core.Unify ( tcMatchTy ) import GHC.Core.Rules import GHC.Core.Subst (substTickish) @@ -1669,7 +1670,7 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs | otherwise = UnspecArg ; (useful, subst', rule_bndrs, rule_lhs_args, spec_bndrs, dx_binds, spec_args) - <- specHeader subst rhs_bndrs all_call_args + <- specHeader this_mod subst rhs_bndrs all_call_args ; let env' = env { se_subst = subst' } -- Check for (a) usefulness and (b) not already covered @@ -2573,7 +2574,8 @@ isSpecDict _ = False -- , [T1, T2, c, i, dEqT1, dShow1] -- ) specHeader - :: Core.Subst -- This substitution applies to the [InBndr] + :: Module -- The module being compiled, for mkAbsentFiller + -> Core.Subst -- This substitution applies to the [InBndr] -> [InBndr] -- Binders from the original function `f` -> [SpecArg] -- From the CallInfo -> SpecM ( Bool -- True <=> some useful specialisation happened @@ -2598,13 +2600,13 @@ specHeader -- If we run out of binders, stop immediately -- See Note [Specialisation Must Preserve Sharing] -specHeader subst [] _ = pure (False, subst, [], [], [], [], []) -specHeader subst _ [] = pure (False, subst, [], [], [], [], []) +specHeader _ subst [] _ = pure (False, subst, [], [], [], [], []) +specHeader _ subst _ [] = pure (False, subst, [], [], [], [], []) -- We want to specialise on type 'T1', and so we must construct a substitution -- 'a->T1', as well as a LHS argument for the resulting RULE and unfolding -- details. -specHeader subst (bndr:bndrs) (SpecType ty : args) +specHeader mod subst (bndr:bndrs) (SpecType ty : args) = do { -- Find free_tvs, the type variables to add to the binders for the rule -- Namely those deeply free in `ty` that aren't in scope -- See (MP2) in Note [Specialising polymorphic dictionaries] @@ -2617,7 +2619,7 @@ specHeader subst (bndr:bndrs) (SpecType ty : args) ; let subst2 = Core.extendTvSubst subst1 bndr ty ; (useful, subst3, rule_bs, rule_args, spec_bs, dx, spec_args) - <- specHeader subst2 bndrs args + <- specHeader mod subst2 bndrs args ; pure ( useful, subst3 , free_tvs ++ rule_bs, Type ty : rule_args , free_tvs ++ spec_bs, dx, Type ty : spec_args ) } @@ -2626,29 +2628,34 @@ specHeader subst (bndr:bndrs) (SpecType ty : args) -- a substitution on it (in case the type refers to 'a'). Additionally, we need -- to produce a binder, LHS argument and RHS argument for the resulting rule, -- /and/ a binder for the specialised body. -specHeader subst (bndr:bndrs) (UnspecType : args) +specHeader mod subst (bndr:bndrs) (UnspecType : args) = do { let (subst1, bndr') = Core.substBndr subst bndr ; (useful, subst2, rule_bs, rule_es, spec_bs, dx, spec_args) - <- specHeader subst1 bndrs args + <- specHeader mod subst1 bndrs args ; let ty_e' = Type (mkTyVarTy bndr') ; pure ( useful, subst2 , bndr' : rule_bs, ty_e' : rule_es , bndr' : spec_bs, dx, ty_e' : spec_args ) } -specHeader subst (bndr:bndrs) (_ : args) +specHeader mod subst (bndr:bndrs) (_ : args) | isDeadBinder bndr , let (subst1, bndr') = Core.substBndr subst (zapIdOccInfo bndr) - , Just rubbish_lit <- mkLitRubbish (idType bndr') + , Just filler <- mkAbsentFiller mod bndr' NotMarkedStrict + -- NB: mkAbsentFiller returns Nothing for a terminating type (e.g. a + -- dictionary), so this guard fails and we fall through, keeping the + -- argument instead of dropping it. + -- See Note [Don't make fillers for terminating types] + -- in GHC.Core.Opt.WorkWrap.Utils = -- See Note [Drop dead args from specialisations] - do { (useful, subst2, rule_bs, rule_es, spec_bs, dx, spec_args) <- specHeader subst1 bndrs args + do { (useful, subst2, rule_bs, rule_es, spec_bs, dx, spec_args) <- specHeader mod subst1 bndrs args ; pure ( useful, subst2 , bndr' : rule_bs, Var bndr' : rule_es - , spec_bs, dx, rubbish_lit : spec_args ) } + , spec_bs, dx, filler : spec_args ) } -- Next we want to specialise the 'Eq a' dict away. We need to construct -- a wildcard binder to match the dictionary (See Note [Specialising Calls] for -- the nitty-gritty), as a LHS rule and unfolding details. -specHeader subst (bndr:bndrs) (SpecDict dict_arg : args) +specHeader mod subst (bndr:bndrs) (SpecDict dict_arg : args) = do { -- Make up a fresh binder to use in the RULE -- It might turn into a dict binding (via bindAuxiliaryDict) which we -- then float, so we use cloneIdBndr to get a completely fresh binder @@ -2659,7 +2666,7 @@ specHeader subst (bndr:bndrs) (SpecDict dict_arg : args) -- Extend the substitution to map bndr :-> dict_arg, for use in the RHS ; let (subst2, dx_bind, spec_dict) = bindAuxiliaryDict subst1 bndr bndr' dict_arg - ; (_, subst3, rule_bs, rule_es, spec_bs, dx, spec_args) <- specHeader subst2 bndrs args + ; (_, subst3, rule_bs, rule_es, spec_bs, dx, spec_args) <- specHeader mod subst2 bndrs args ; let dx' = case dx_bind of { Nothing -> dx; Just d -> d : dx } ; pure ( True, subst3 -- Ha! A useful specialisation! @@ -2674,10 +2681,10 @@ specHeader subst (bndr:bndrs) (SpecDict dict_arg : args) -- why 'i' doesn't appear in our RULE above. But we have no guarantee that -- there aren't 'UnspecArg's which come /before/ all of the dictionaries, so -- this case must be here. -specHeader subst (bndr:bndrs) (UnspecArg : args) +specHeader mod subst (bndr:bndrs) (UnspecArg : args) = do { let (subst1, bndr') = Core.substBndr subst (zapIdOccInfo bndr) -- zapIdOccInfo: see Note [Zap occ info in rule binders] - ; (useful, subst2, rule_bs, rule_es, spec_bs, dx, spec_args) <- specHeader subst1 bndrs args + ; (useful, subst2, rule_bs, rule_es, spec_bs, dx, spec_args) <- specHeader mod subst1 bndrs args ; let dummy_arg = varToCoreExpr bndr' -- dummy_arg is usually just (Var bndr), ===================================== compiler/GHC/Core/Opt/WorkWrap.hs ===================================== @@ -554,7 +554,7 @@ tryWW ww_opts is_rec fn_id rhs -- See Note [Drop absent bindings] | isAbsDmd (demandInfo fn_info) , not (isJoinId fn_id) - , Just filler <- mkAbsentFiller ww_opts fn_id NotMarkedStrict + , Just filler <- mkAbsentFiller (wo_module ww_opts) fn_id NotMarkedStrict = return [(new_fn_id, filler)] -- See Note [Don't w/w INLINE things] ===================================== compiler/GHC/Core/Opt/WorkWrap/Utils.hs ===================================== @@ -30,7 +30,6 @@ import GHC.Core.Subst import GHC.Core.Type import GHC.Core.Multiplicity import GHC.Core.Coercion -import GHC.Core.Predicate( isDictTy ) import GHC.Core.Reduction import GHC.Core.FamInstEnv import GHC.Core.Predicate( isEqualityClass ) @@ -996,7 +995,7 @@ mkWWstr_one opts arg str_mark = _ | isTyVar arg -> do_nothing DropAbsent - | Just absent_filler <- mkAbsentFiller opts arg str_mark + | Just absent_filler <- mkAbsentFiller (wo_module opts) arg str_mark -- Absent case. Drop the argument from the worker. -- We can't always handle absence for arbitrary -- unlifted types, so we need to choose just the cases we can @@ -1067,14 +1066,20 @@ unbox_one_arg opts arg_var -- -- If @mkAbsentFiller _ id == Just e@, then @e@ is an absent filler with the -- same type as @id@. Otherwise, no suitable filler could be found. -mkAbsentFiller :: WwOpts -> Id -> StrictnessMark -> Maybe CoreExpr -mkAbsentFiller opts arg str +mkAbsentFiller :: Module -> Id -> StrictnessMark -> Maybe CoreExpr +mkAbsentFiller mod arg str + -- We never make a filler for a terminating type: it might be speculatively + -- evaluated or have a field projected out of it. + -- See (AF4) in Note [Absent fillers], and + -- Note [Don't make fillers for terminating types]. + | isTerminatingType arg_ty + = Nothing + -- The lifted case: bind 'absentError'. See (AF1) in Note [Absent fillers] -- We want to use this case if possible, because we get a nice runtime panic message -- if we are wrong (like we were in #11126). Otherwise we fall through to the -- less-desirable mkLitRubbish case. | mightBeLiftedType arg_ty - , not (isDictTy arg_ty) -- See (AF4) in Note [Absent fillers] , not (isStrictDmd (idDemandInfo arg)) -- See (AF2) , not (isMarkedStrict str) -- in Note [Absent fillers] = Just (mkAbsentErrorApp arg_ty msg) @@ -1101,7 +1106,7 @@ mkAbsentFiller opts arg str -- will have different lengths and hence different costs for -- the inliner leading to different inlining. -- See also Note [Unique Determinism] in GHC.Types.Unique - file_msg = text "In module" <+> quotes (ppr $ wo_module opts) + file_msg = text "In module" <+> quotes (ppr mod) {- Note [Worker/wrapper for Strictness and Absence] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1295,27 +1300,8 @@ Needless to say, there are some wrinkles: have to be representation monomorphic. But in the future, we might allow levity polymorphism, e.g. a polymorphic levity variable in 'BoxedRep'. -(AF4) Consider (#24934) - f :: (a~b) => blah {-# INLINE f #-} - f d x = case eq_sel d of co -> body - In #24934 it turned out that `co` was unused; and we discarded the - entire case-scrutinisation via the `exprOkToDiscard` test in - `GHC.Core.Opt.Simplify.Iteration.rebuildCase`. So now `d` is absent. - But in the /unfolding/ for some reason we did not discard the `case`; - so when we inline `f` we end up evaluating that `d` argument. So we had - better not replace it with an error thunk! - - The root of it is this: `exprOkToDiscard` assumes that a dictionary is - non-bottom (Note [exprOkForSpeculation and type classes]); but then we replace - the (a~b) dictionary with an error thunk, breaking the invariant that every - dictionary is non-bottom. (If -XDictsStrict is on, the invariant is even - more important.) - - Simple solution: never use an error thunk for a dictionary; instead fall - through to mkRubbishLit. (The only downside is that we lose the compiler - debugging advantages of (AF1).) - - This is quite delicate. +(AF4) We never make an absent filler for a terminating type. + See Note [Don't make fillers for terminating types]. While (AF1) and (AF2) are simply an optimisation in terms of compiler debugging experience, (AF3) should be irrelevant in most programs, if not all. @@ -1337,6 +1323,47 @@ fragile because `MkT` is strict in its Int# argument, so we get an absentError exception when we shouldn't. Very annoying! +Note [Don't make fillers for terminating types] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We never make an absent filler, error thunk or rubbish literal, for a terminating +type (isTerminatingType): a non-unary class dictionary, a boxed equality, or a +constraint tuple. + +GHC relies on a dictionary value never being bottom (see +Note [NON-BOTTOM-DICTS invariant] in GHC.Core). GHC uses "speculation" to +evaluated guaranteed-non-bottom values: see Note [Speculative evaluation] in +GHC.CoreToStg.Prep. This speculative evaluation is fundamentally incompatible +with replacing a dictionary with an absent filler. Attempts to to do so gave +rise to a succession of bugs including: + + * #24934: we evaluated an absent dictionary + * #25924: we selected a superclass from an absent dictionary + +A terminating type is exactly what speculation will force: see +Note [exprOkForSpeculation and type classes] in GHC.Core.Utils. So we refuse to +make a filler for precisely those types. + +So the safe thing is to make no filler at all for a terminating type. Then there +is no bogus dictionary to evaluate or project from. Specifically + + * `mkAbsentFiller` returns `Nothing` for a terminating type, so worker/wrapper + keeps the real argument. + + * `Specialise.specHeader` calls `mkAbsentFiller` too, so it likewise keeps the + dead dictionary argument rather than dropping it for a filler. + +Prior failed approaches + +We used to paper over this. !13233 replaced the error thunk for an absent +dictionary with a rubbish literal, so that it could at least be evaluated +without complaint. But #25924 showed that this is not enough, because we do not +only evaluate the absent dictionary, we also select a superclass from it. + +We could instead teach speculation to leave absent bindings alone, and we do +that too (see Note [Speculative evaluation] in GHC.CoreToStg.Prep). But that is +not a guarantee. After optimisation a binding that holds an absent filler may no +longer be marked absent, so we cannot rely on the demand to protect us. + Note [Unboxing through unboxed tuples] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We should not to a worker/wrapper split just for unboxing the components of ===================================== testsuite/tests/dmdanal/should_compile/T18982.stderr ===================================== @@ -1,38 +1,26 @@ ==================== Tidy Core ==================== -Result size of Tidy Core = {terms: 295, types: 206, coercions: 4, joins: 0/0} - --- RHS size: {terms: 8, types: 9, coercions: 1, joins: 0/0} -T18982.$WExGADT :: forall e. (e ~ Int) => e %1 -> Int %1 -> ExGADT Int -T18982.$WExGADT = \ (@e) (conrep :: e ~ Int) (conrep1 :: e) (conrep2 :: Int) -> T18982.ExGADT @Int @e @~(<Int>_N :: Int GHC.Internal.Prim.~# Int) conrep conrep1 conrep2 - --- RHS size: {terms: 3, types: 2, coercions: 1, joins: 0/0} -T18982.$WGADT :: Int %1 -> GADT Int -T18982.$WGADT = \ (conrep :: Int) -> T18982.GADT @Int @~(<Int>_N :: Int GHC.Internal.Prim.~# Int) conrep - --- RHS size: {terms: 7, types: 6, coercions: 0, joins: 0/0} -T18982.$WEx :: forall e a. e %1 -> a %1 -> Ex a -T18982.$WEx = \ (@e) (@a) (conrep :: e) (conrep1 :: a) -> T18982.Ex @a @e conrep conrep1 +Result size of Tidy Core = {terms: 276, types: 179, coercions: 2, joins: 0/0} -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T18982.$trModule4 :: GHC.Internal.Prim.Addr# -T18982.$trModule4 = "main"# +$trModule1 :: GHC.Internal.Prim.Addr# +$trModule1 = "main"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T18982.$trModule3 :: GHC.Internal.Types.TrName -T18982.$trModule3 = GHC.Internal.Types.TrNameS T18982.$trModule4 +$trModule2 :: GHC.Internal.Types.TrName +$trModule2 = GHC.Internal.Types.TrNameS $trModule1 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T18982.$trModule2 :: GHC.Internal.Prim.Addr# -T18982.$trModule2 = "T18982"# +$trModule3 :: GHC.Internal.Prim.Addr# +$trModule3 = "T18982"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T18982.$trModule1 :: GHC.Internal.Types.TrName -T18982.$trModule1 = GHC.Internal.Types.TrNameS T18982.$trModule2 +$trModule4 :: GHC.Internal.Types.TrName +$trModule4 = GHC.Internal.Types.TrNameS $trModule3 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} T18982.$trModule :: GHC.Internal.Types.Module -T18982.$trModule = GHC.Internal.Types.Module T18982.$trModule3 T18982.$trModule1 +T18982.$trModule = GHC.Internal.Types.Module $trModule2 $trModule4 -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} $krep :: GHC.Internal.Types.KindRep @@ -47,16 +35,16 @@ $krep2 :: GHC.Internal.Types.KindRep $krep2 = GHC.Internal.Types.KindRepVar 0# -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T18982.$tcBox2 :: GHC.Internal.Prim.Addr# -T18982.$tcBox2 = "Box"# +$tcBox1 :: GHC.Internal.Prim.Addr# +$tcBox1 = "Box"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T18982.$tcBox1 :: GHC.Internal.Types.TrName -T18982.$tcBox1 = GHC.Internal.Types.TrNameS T18982.$tcBox2 +$tcBox2 :: GHC.Internal.Types.TrName +$tcBox2 = GHC.Internal.Types.TrNameS $tcBox1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} T18982.$tcBox :: GHC.Internal.Types.TyCon -T18982.$tcBox = GHC.Internal.Types.TyCon 16948648223906549518#Word64 2491460178135962649#Word64 T18982.$trModule T18982.$tcBox1 0# GHC.Internal.Types.krep$*Arr* +T18982.$tcBox = GHC.Internal.Types.TyCon 16948648223906549518#Word64 2491460178135962649#Word64 T18982.$trModule $tcBox2 0# GHC.Internal.Types.krep$*Arr* -- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} $krep3 :: [GHC.Internal.Types.KindRep] @@ -67,140 +55,140 @@ $krep4 :: GHC.Internal.Types.KindRep $krep4 = GHC.Internal.Types.KindRepTyConApp T18982.$tcBox $krep3 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T18982.$tc'Box1 :: GHC.Internal.Types.KindRep -T18982.$tc'Box1 = GHC.Internal.Types.KindRepFun $krep2 $krep4 +$krep5 :: GHC.Internal.Types.KindRep +$krep5 = GHC.Internal.Types.KindRepFun $krep2 $krep4 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T18982.$tc'Box3 :: GHC.Internal.Prim.Addr# -T18982.$tc'Box3 = "'Box"# +$tc'Box1 :: GHC.Internal.Prim.Addr# +$tc'Box1 = "'Box"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T18982.$tc'Box2 :: GHC.Internal.Types.TrName -T18982.$tc'Box2 = GHC.Internal.Types.TrNameS T18982.$tc'Box3 +$tc'Box2 :: GHC.Internal.Types.TrName +$tc'Box2 = GHC.Internal.Types.TrNameS $tc'Box1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} T18982.$tc'Box :: GHC.Internal.Types.TyCon -T18982.$tc'Box = GHC.Internal.Types.TyCon 1412068769125067428#Word64 8727214667407894081#Word64 T18982.$trModule T18982.$tc'Box2 1# T18982.$tc'Box1 +T18982.$tc'Box = GHC.Internal.Types.TyCon 1412068769125067428#Word64 8727214667407894081#Word64 T18982.$trModule $tc'Box2 1# $krep5 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T18982.$tcEx2 :: GHC.Internal.Prim.Addr# -T18982.$tcEx2 = "Ex"# +$tcEx1 :: GHC.Internal.Prim.Addr# +$tcEx1 = "Ex"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T18982.$tcEx1 :: GHC.Internal.Types.TrName -T18982.$tcEx1 = GHC.Internal.Types.TrNameS T18982.$tcEx2 +$tcEx2 :: GHC.Internal.Types.TrName +$tcEx2 = GHC.Internal.Types.TrNameS $tcEx1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} T18982.$tcEx :: GHC.Internal.Types.TyCon -T18982.$tcEx = GHC.Internal.Types.TyCon 4376661818164435927#Word64 18005417598910668817#Word64 T18982.$trModule T18982.$tcEx1 0# GHC.Internal.Types.krep$*Arr* +T18982.$tcEx = GHC.Internal.Types.TyCon 4376661818164435927#Word64 18005417598910668817#Word64 T18982.$trModule $tcEx2 0# GHC.Internal.Types.krep$*Arr* -- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} -$krep5 :: [GHC.Internal.Types.KindRep] -$krep5 = GHC.Internal.Types.: @GHC.Internal.Types.KindRep $krep1 (GHC.Internal.Types.[] @GHC.Internal.Types.KindRep) +$krep6 :: [GHC.Internal.Types.KindRep] +$krep6 = GHC.Internal.Types.: @GHC.Internal.Types.KindRep $krep1 (GHC.Internal.Types.[] @GHC.Internal.Types.KindRep) -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep6 :: GHC.Internal.Types.KindRep -$krep6 = GHC.Internal.Types.KindRepTyConApp T18982.$tcEx $krep5 +$krep7 :: GHC.Internal.Types.KindRep +$krep7 = GHC.Internal.Types.KindRepTyConApp T18982.$tcEx $krep6 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep7 :: GHC.Internal.Types.KindRep -$krep7 = GHC.Internal.Types.KindRepFun $krep1 $krep6 +$krep8 :: GHC.Internal.Types.KindRep +$krep8 = GHC.Internal.Types.KindRepFun $krep1 $krep7 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T18982.$tc'Ex1 :: GHC.Internal.Types.KindRep -T18982.$tc'Ex1 = GHC.Internal.Types.KindRepFun $krep2 $krep7 +$krep9 :: GHC.Internal.Types.KindRep +$krep9 = GHC.Internal.Types.KindRepFun $krep2 $krep8 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T18982.$tc'Ex3 :: GHC.Internal.Prim.Addr# -T18982.$tc'Ex3 = "'Ex"# +$tc'Ex1 :: GHC.Internal.Prim.Addr# +$tc'Ex1 = "'Ex"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T18982.$tc'Ex2 :: GHC.Internal.Types.TrName -T18982.$tc'Ex2 = GHC.Internal.Types.TrNameS T18982.$tc'Ex3 +$tc'Ex2 :: GHC.Internal.Types.TrName +$tc'Ex2 = GHC.Internal.Types.TrNameS $tc'Ex1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} T18982.$tc'Ex :: GHC.Internal.Types.TyCon -T18982.$tc'Ex = GHC.Internal.Types.TyCon 14609381081172201359#Word64 3077219645053200509#Word64 T18982.$trModule T18982.$tc'Ex2 2# T18982.$tc'Ex1 +T18982.$tc'Ex = GHC.Internal.Types.TyCon 14609381081172201359#Word64 3077219645053200509#Word64 T18982.$trModule $tc'Ex2 2# $krep9 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T18982.$tcGADT2 :: GHC.Internal.Prim.Addr# -T18982.$tcGADT2 = "GADT"# +$tcGADT1 :: GHC.Internal.Prim.Addr# +$tcGADT1 = "GADT"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T18982.$tcGADT1 :: GHC.Internal.Types.TrName -T18982.$tcGADT1 = GHC.Internal.Types.TrNameS T18982.$tcGADT2 +$tcGADT2 :: GHC.Internal.Types.TrName +$tcGADT2 = GHC.Internal.Types.TrNameS $tcGADT1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} T18982.$tcGADT :: GHC.Internal.Types.TyCon -T18982.$tcGADT = GHC.Internal.Types.TyCon 9243924476135839950#Word64 5096619276488416461#Word64 T18982.$trModule T18982.$tcGADT1 0# GHC.Internal.Types.krep$*Arr* +T18982.$tcGADT = GHC.Internal.Types.TyCon 9243924476135839950#Word64 5096619276488416461#Word64 T18982.$trModule $tcGADT2 0# GHC.Internal.Types.krep$*Arr* -- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} -$krep8 :: [GHC.Internal.Types.KindRep] -$krep8 = GHC.Internal.Types.: @GHC.Internal.Types.KindRep $krep (GHC.Internal.Types.[] @GHC.Internal.Types.KindRep) +$krep10 :: [GHC.Internal.Types.KindRep] +$krep10 = GHC.Internal.Types.: @GHC.Internal.Types.KindRep $krep (GHC.Internal.Types.[] @GHC.Internal.Types.KindRep) -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep9 :: GHC.Internal.Types.KindRep -$krep9 = GHC.Internal.Types.KindRepTyConApp T18982.$tcGADT $krep8 +$krep11 :: GHC.Internal.Types.KindRep +$krep11 = GHC.Internal.Types.KindRepTyConApp T18982.$tcGADT $krep10 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T18982.$tc'GADT1 :: GHC.Internal.Types.KindRep -T18982.$tc'GADT1 = GHC.Internal.Types.KindRepFun $krep $krep9 +$krep12 :: GHC.Internal.Types.KindRep +$krep12 = GHC.Internal.Types.KindRepFun $krep $krep11 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T18982.$tc'GADT3 :: GHC.Internal.Prim.Addr# -T18982.$tc'GADT3 = "'GADT"# +$tc'GADT1 :: GHC.Internal.Prim.Addr# +$tc'GADT1 = "'GADT"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T18982.$tc'GADT2 :: GHC.Internal.Types.TrName -T18982.$tc'GADT2 = GHC.Internal.Types.TrNameS T18982.$tc'GADT3 +$tc'GADT2 :: GHC.Internal.Types.TrName +$tc'GADT2 = GHC.Internal.Types.TrNameS $tc'GADT1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} T18982.$tc'GADT :: GHC.Internal.Types.TyCon -T18982.$tc'GADT = GHC.Internal.Types.TyCon 2077850259354179864#Word64 16731205864486799217#Word64 T18982.$trModule T18982.$tc'GADT2 0# T18982.$tc'GADT1 +T18982.$tc'GADT = GHC.Internal.Types.TyCon 2077850259354179864#Word64 16731205864486799217#Word64 T18982.$trModule $tc'GADT2 0# $krep12 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T18982.$tcExGADT2 :: GHC.Internal.Prim.Addr# -T18982.$tcExGADT2 = "ExGADT"# +$tcExGADT1 :: GHC.Internal.Prim.Addr# +$tcExGADT1 = "ExGADT"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T18982.$tcExGADT1 :: GHC.Internal.Types.TrName -T18982.$tcExGADT1 = GHC.Internal.Types.TrNameS T18982.$tcExGADT2 +$tcExGADT2 :: GHC.Internal.Types.TrName +$tcExGADT2 = GHC.Internal.Types.TrNameS $tcExGADT1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} T18982.$tcExGADT :: GHC.Internal.Types.TyCon -T18982.$tcExGADT = GHC.Internal.Types.TyCon 6470898418160489500#Word64 10361108917441214060#Word64 T18982.$trModule T18982.$tcExGADT1 0# GHC.Internal.Types.krep$*Arr* +T18982.$tcExGADT = GHC.Internal.Types.TyCon 6470898418160489500#Word64 10361108917441214060#Word64 T18982.$trModule $tcExGADT2 0# GHC.Internal.Types.krep$*Arr* -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep10 :: GHC.Internal.Types.KindRep -$krep10 = GHC.Internal.Types.KindRepTyConApp T18982.$tcExGADT $krep8 +$krep13 :: GHC.Internal.Types.KindRep +$krep13 = GHC.Internal.Types.KindRepTyConApp T18982.$tcExGADT $krep10 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep11 :: GHC.Internal.Types.KindRep -$krep11 = GHC.Internal.Types.KindRepFun $krep $krep10 +$krep14 :: GHC.Internal.Types.KindRep +$krep14 = GHC.Internal.Types.KindRepFun $krep $krep13 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T18982.$tc'ExGADT1 :: GHC.Internal.Types.KindRep -T18982.$tc'ExGADT1 = GHC.Internal.Types.KindRepFun $krep2 $krep11 +$krep15 :: GHC.Internal.Types.KindRep +$krep15 = GHC.Internal.Types.KindRepFun $krep2 $krep14 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T18982.$tc'ExGADT3 :: GHC.Internal.Prim.Addr# -T18982.$tc'ExGADT3 = "'ExGADT"# +$tc'ExGADT1 :: GHC.Internal.Prim.Addr# +$tc'ExGADT1 = "'ExGADT"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T18982.$tc'ExGADT2 :: GHC.Internal.Types.TrName -T18982.$tc'ExGADT2 = GHC.Internal.Types.TrNameS T18982.$tc'ExGADT3 +$tc'ExGADT2 :: GHC.Internal.Types.TrName +$tc'ExGADT2 = GHC.Internal.Types.TrNameS $tc'ExGADT1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} T18982.$tc'ExGADT :: GHC.Internal.Types.TyCon -T18982.$tc'ExGADT = GHC.Internal.Types.TyCon 8468257409157161049#Word64 5503123603717080600#Word64 T18982.$trModule T18982.$tc'ExGADT2 1# T18982.$tc'ExGADT1 +T18982.$tc'ExGADT = GHC.Internal.Types.TyCon 8468257409157161049#Word64 5503123603717080600#Word64 T18982.$trModule $tc'ExGADT2 1# $krep15 --- RHS size: {terms: 11, types: 10, coercions: 0, joins: 0/0} -T18982.$wi :: forall a e. (a GHC.Internal.Prim.~# Int) => e -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.Int# -T18982.$wi = \ (@a) (@e) (ww :: a GHC.Internal.Prim.~# Int) (ww1 :: e) (ww2 :: GHC.Internal.Prim.Int#) -> case ww1 of { __DEFAULT -> GHC.Internal.Prim.+# ww2 1# } +-- RHS size: {terms: 12, types: 14, coercions: 0, joins: 0/0} +T18982.$wi :: forall a e. (a GHC.Internal.Prim.~# Int, e ~ Int) => e -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.Int# +T18982.$wi = \ (@a) (@e) (ww :: a GHC.Internal.Prim.~# Int) (ww1 :: e ~ Int) (ww2 :: e) (ww3 :: GHC.Internal.Prim.Int#) -> case ww2 of { __DEFAULT -> GHC.Internal.Prim.+# ww3 1# } --- RHS size: {terms: 15, types: 22, coercions: 1, joins: 0/0} +-- RHS size: {terms: 16, types: 22, coercions: 1, joins: 0/0} i :: forall a. ExGADT a -> Int -i = \ (@a) (ds :: ExGADT a) -> case ds of { ExGADT @e ww ww1 ww2 ww3 -> case ww3 of { GHC.Internal.Types.I# ww4 -> case T18982.$wi @a @e @~(ww :: a GHC.Internal.Prim.~# Int) ww2 ww4 of ww5 { __DEFAULT -> GHC.Internal.Types.I# ww5 } } } +i = \ (@a) (ds :: ExGADT a) -> case ds of { ExGADT @e ww ww1 ww2 ww3 -> case ww3 of { GHC.Internal.Types.I# ww4 -> case T18982.$wi @a @e @~(ww :: a GHC.Internal.Prim.~# Int) ww1 ww2 ww4 of ww5 { __DEFAULT -> GHC.Internal.Types.I# ww5 } } } -- RHS size: {terms: 6, types: 7, coercions: 0, joins: 0/0} T18982.$wh :: forall a. (a GHC.Internal.Prim.~# Int) => GHC.Internal.Prim.Int# -> GHC.Internal.Prim.Int# ===================================== testsuite/tests/simplCore/should_compile/T26615.stderr ===================================== @@ -2,7 +2,7 @@ ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 1,209, types: 1,155, coercions: 18, joins: 17/29} + = {terms: 1,229, types: 1,163, coercions: 18, joins: 17/29} -- RHS size: {terms: 6, types: 8, coercions: 0, joins: 0/0} unArray :: forall a. Array a -> SmallArray# a @@ -414,7 +414,7 @@ T26615a.$tc'BitmapIndexed 2# $krep24 --- RHS size: {terms: 98, types: 109, coercions: 0, joins: 3/4} +-- RHS size: {terms: 101, types: 113, coercions: 0, joins: 3/4} T26615a.$wdisjointCollisions [InlPrag=INLINABLE[2]] :: forall k a b. Eq k => @@ -561,13 +561,14 @@ T26615a.$wdisjointCollisions joinrec { $wlookupInArrayCont_ [InlPrag=[2], Occ=LoopBreaker, - Dmd=SC(S,C(1,C(1,C(1,L))))] - :: k -> SmallArray# (Leaf k b) -> Int# -> Int# -> Bool - [LclId[JoinId(4)(Just [!])], - Arity=4, - Str=<1L><L><L><L>, + Dmd=SC(S,C(1,C(1,C(1,C(1,L)))))] + :: Eq k => k -> SmallArray# (Leaf k b) -> Int# -> Int# -> Bool + [LclId[JoinId(5)(Just [~, !])], + Arity=5, + Str=<A><1L><L><L><L>, Unf=OtherCon []] - $wlookupInArrayCont_ (k1 :: k) + $wlookupInArrayCont_ ($dEq1 [Occ=Dead] :: Eq k) + (k1 :: k) (ww3 :: SmallArray# (Leaf k b)) (ww4 :: Int#) (ww5 :: Int#) @@ -578,7 +579,7 @@ T26615a.$wdisjointCollisions { (# ipv2 #) -> case ipv2 of { L kx v -> case == @k $dEq k2 kx of { - False -> jump $wlookupInArrayCont_ k2 ww3 (+# ww4 1#) ww5; + False -> jump $wlookupInArrayCont_ $dEq k2 ww3 (+# ww4 1#) ww5; True -> GHC.Internal.Types.False } } @@ -586,7 +587,7 @@ T26615a.$wdisjointCollisions 1# -> jump $j } }; } in - jump $wlookupInArrayCont_ kA ww2 0# lvl2 + jump $wlookupInArrayCont_ $dEq kA ww2 0# lvl2 } }; 1# -> sc3 @@ -611,7 +612,7 @@ lvl1 = GHC.Internal.Control.Exception.Base.patError @LiftedRep @() lvl Rec { --- RHS size: {terms: 133, types: 126, coercions: 0, joins: 1/2} +-- RHS size: {terms: 136, types: 130, coercions: 0, joins: 1/2} T26615a.disjointSubtrees_$s$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] :: forall k a b. @@ -641,13 +642,14 @@ T26615a.disjointSubtrees_$s$wdisjointSubtrees joinrec { $wlookupInArrayCont_ [InlPrag=[2], Occ=LoopBreaker, - Dmd=SC(S,C(1,C(1,C(1,L))))] - :: k -> SmallArray# (Leaf k a) -> Int# -> Int# -> Bool - [LclId[JoinId(4)(Just [!])], - Arity=4, - Str=<1L><L><L><L>, + Dmd=SC(S,C(1,C(1,C(1,C(1,L)))))] + :: Eq k => k -> SmallArray# (Leaf k a) -> Int# -> Int# -> Bool + [LclId[JoinId(5)(Just [~, !])], + Arity=5, + Str=<A><1L><L><L><L>, Unf=OtherCon []] - $wlookupInArrayCont_ (k1 :: k) + $wlookupInArrayCont_ ($dEq [Occ=Dead] :: Eq k) + (k1 :: k) (ww :: SmallArray# (Leaf k a)) (ww1 :: Int#) (ww2 :: Int#) @@ -657,7 +659,7 @@ T26615a.disjointSubtrees_$s$wdisjointSubtrees case indexSmallArray# @Lifted @(Leaf k a) ww ww1 of { (# ipv #) -> case ipv of { L kx v -> case == @k sc k2 kx of { - False -> jump $wlookupInArrayCont_ k2 ww (+# ww1 1#) ww2; + False -> jump $wlookupInArrayCont_ sc k2 ww (+# ww1 1#) ww2; True -> GHC.Internal.Types.False } } @@ -666,7 +668,7 @@ T26615a.disjointSubtrees_$s$wdisjointSubtrees } }; } in jump $wlookupInArrayCont_ - k0 sc3 0# (sizeofSmallArray# @Lifted @(Leaf k a) sc3) + sc k0 sc3 0# (sizeofSmallArray# @Lifted @(Leaf k a) sc3) } } }; @@ -708,7 +710,7 @@ T26615a.disjointSubtrees_$s$wdisjointSubtrees end Rec } Rec { --- RHS size: {terms: 705, types: 748, coercions: 18, joins: 13/23} +-- RHS size: {terms: 719, types: 748, coercions: 18, joins: 13/23} T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] :: forall k a b. Eq k => Int# -> HashMap k a -> HashMap k b -> Bool [GblId[StrictWorker([~, ~, !])], @@ -1065,23 +1067,23 @@ T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] @(*) @(SmallArray# (HashMap k a) -> SmallArray# (HashMap k b) -> Int#) - @(GHC.Internal.Types.UnusedType 0 "a" - -> GHC.Internal.Types.UnusedType 1 "b" -> Int#) + @(GHC.Internal.Types.UnusedType "a_0" + -> GHC.Internal.Types.UnusedType "b_1" -> Int#) of { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> case reallyUnsafePtrEquality# @Lifted @Lifted - @(GHC.Internal.Types.UnusedType 0 "a") - @(GHC.Internal.Types.UnusedType 1 "b") + @(GHC.Internal.Types.UnusedType "a_0") + @(GHC.Internal.Types.UnusedType "b_1") (bx1 `cast` (SelCo:Fun(arg) (Sub (Sym v2)) :: SmallArray# (HashMap k a) - ~R# GHC.Internal.Types.UnusedType 0 "a")) + ~R# GHC.Internal.Types.UnusedType "a_0")) (bx3 `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) :: SmallArray# (HashMap k b) - ~R# GHC.Internal.Types.UnusedType 1 "b")) + ~R# GHC.Internal.Types.UnusedType "b_1")) of { __DEFAULT -> joinrec { @@ -1234,23 +1236,23 @@ T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] case GHC.Internal.Unsafe.Coerce.unsafeEqualityProof @(*) @(SmallArray# (HashMap k a) -> SmallArray# (HashMap k b) -> Int#) - @(GHC.Internal.Types.UnusedType 0 "a" - -> GHC.Internal.Types.UnusedType 1 "b" -> Int#) + @(GHC.Internal.Types.UnusedType "a_0" + -> GHC.Internal.Types.UnusedType "b_1" -> Int#) of { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> case reallyUnsafePtrEquality# @Lifted @Lifted - @(GHC.Internal.Types.UnusedType 0 "a") - @(GHC.Internal.Types.UnusedType 1 "b") + @(GHC.Internal.Types.UnusedType "a_0") + @(GHC.Internal.Types.UnusedType "b_1") (bx `cast` (SelCo:Fun(arg) (Sub (Sym v2)) :: SmallArray# (HashMap k a) - ~R# GHC.Internal.Types.UnusedType 0 "a")) + ~R# GHC.Internal.Types.UnusedType "a_0")) (bx1 `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) :: SmallArray# (HashMap k b) - ~R# GHC.Internal.Types.UnusedType 1 "b")) + ~R# GHC.Internal.Types.UnusedType "b_1")) of { __DEFAULT -> jump go (GHC.Internal.Types.I# 31#); 1# -> GHC.Internal.Types.False @@ -1310,13 +1312,14 @@ T26615a.$wdisjointSubtrees joinrec { $wlookupInArrayCont_ [InlPrag=[2], Occ=LoopBreaker, - Dmd=SC(S,C(1,C(1,C(1,L))))] - :: k -> SmallArray# (Leaf k a) -> Int# -> Int# -> Bool - [LclId[JoinId(4)(Just [!])], - Arity=4, - Str=<1L><L><L><L>, + Dmd=SC(S,C(1,C(1,C(1,C(1,L)))))] + :: Eq k => k -> SmallArray# (Leaf k a) -> Int# -> Int# -> Bool + [LclId[JoinId(5)(Just [~, !])], + Arity=5, + Str=<A><1L><L><L><L>, Unf=OtherCon []] - $wlookupInArrayCont_ (k1 :: k) + $wlookupInArrayCont_ ($dEq1 [Occ=Dead] :: Eq k) + (k1 :: k) (ww2 :: SmallArray# (Leaf k a)) (ww3 :: Int#) (ww4 :: Int#) @@ -1327,7 +1330,8 @@ T26615a.$wdisjointSubtrees { (# ipv #) -> case ipv of { L kx v -> case == @k $dEq k2 kx of { - False -> jump $wlookupInArrayCont_ k2 ww2 (+# ww3 1#) ww4; + False -> + jump $wlookupInArrayCont_ $dEq k2 ww2 (+# ww3 1#) ww4; True -> GHC.Internal.Types.False } } @@ -1336,18 +1340,19 @@ T26615a.$wdisjointSubtrees } }; } in jump $wlookupInArrayCont_ - ds4 bx2 0# (sizeofSmallArray# @Lifted @(Leaf k a) bx2) + $dEq ds4 bx2 0# (sizeofSmallArray# @Lifted @(Leaf k a) bx2) } } in joinrec { $wlookupCont_ [InlPrag=[2], Occ=LoopBreaker, - Dmd=SC(S,C(1,C(1,C(1,L))))] - :: Word# -> k -> Int# -> HashMap k a -> Bool - [LclId[JoinId(4)(Just [~, !, ~, !])], - Arity=4, - Str=<L><1L><L><1L>, + Dmd=SC(S,C(1,C(1,C(1,C(1,L)))))] + :: Eq k => Word# -> k -> Int# -> HashMap k a -> Bool + [LclId[JoinId(5)(Just [~, ~, !, ~, !])], + Arity=5, + Str=<A><L><1L><L><1L>, Unf=OtherCon []] - $wlookupCont_ (ww1 :: Word#) + $wlookupCont_ ($dEq1 [Occ=Dead] :: Eq k) + (ww1 :: Word#) (ds4 :: k) (ww2 :: Int#) (ds5 :: HashMap k a) @@ -1371,7 +1376,7 @@ T26615a.$wdisjointSubtrees (word2Int# (popCnt# (and# bx1 (minusWord# m 1##)))) of { (# ipv #) -> - jump $wlookupCont_ ww1 ds6 (+# ww2 5#) ipv + jump $wlookupCont_ $dEq ww1 ds6 (+# ww2 5#) ipv }; 0## -> GHC.Internal.Types.True }; @@ -1383,11 +1388,11 @@ T26615a.$wdisjointSubtrees (word2Int# (and# (uncheckedShiftRL# ww1 ww2) 31##)) of { (# ipv #) -> - jump $wlookupCont_ ww1 ds6 (+# ww2 5#) ipv + jump $wlookupCont_ $dEq ww1 ds6 (+# ww2 5#) ipv } } }; } in - jump $wlookupCont_ bx k0 ww ds + jump $wlookupCont_ $dEq bx k0 ww ds } }; Collision bx bx1 -> @@ -1435,13 +1440,14 @@ T26615a.$wdisjointSubtrees joinrec { $wlookupInArrayCont_ [InlPrag=[2], Occ=LoopBreaker, - Dmd=SC(S,C(1,C(1,C(1,L))))] - :: k -> SmallArray# (Leaf k b) -> Int# -> Int# -> Bool - [LclId[JoinId(4)(Just [!])], - Arity=4, - Str=<1L><L><L><L>, + Dmd=SC(S,C(1,C(1,C(1,C(1,L)))))] + :: Eq k => k -> SmallArray# (Leaf k b) -> Int# -> Int# -> Bool + [LclId[JoinId(5)(Just [~, !])], + Arity=5, + Str=<A><1L><L><L><L>, Unf=OtherCon []] - $wlookupInArrayCont_ (k1 :: k) + $wlookupInArrayCont_ ($dEq1 [Occ=Dead] :: Eq k) + (k1 :: k) (ww2 :: SmallArray# (Leaf k b)) (ww3 :: Int#) (ww4 :: Int#) @@ -1452,7 +1458,7 @@ T26615a.$wdisjointSubtrees { (# ipv #) -> case ipv of { L kx v -> case == @k $dEq k2 kx of { - False -> jump $wlookupInArrayCont_ k2 ww2 (+# ww3 1#) ww4; + False -> jump $wlookupInArrayCont_ $dEq k2 ww2 (+# ww3 1#) ww4; True -> GHC.Internal.Types.False } } @@ -1461,18 +1467,19 @@ T26615a.$wdisjointSubtrees } }; } in jump $wlookupInArrayCont_ - ds3 bx2 0# (sizeofSmallArray# @Lifted @(Leaf k b) bx2) + $dEq ds3 bx2 0# (sizeofSmallArray# @Lifted @(Leaf k b) bx2) } } in joinrec { $wlookupCont_ [InlPrag=[2], Occ=LoopBreaker, - Dmd=SC(S,C(1,C(1,C(1,L))))] - :: Word# -> k -> Int# -> HashMap k b -> Bool - [LclId[JoinId(4)(Just [~, !, ~, !])], - Arity=4, - Str=<L><1L><L><1L>, + Dmd=SC(S,C(1,C(1,C(1,C(1,L)))))] + :: Eq k => Word# -> k -> Int# -> HashMap k b -> Bool + [LclId[JoinId(5)(Just [~, ~, !, ~, !])], + Arity=5, + Str=<A><L><1L><L><1L>, Unf=OtherCon []] - $wlookupCont_ (ww1 :: Word#) + $wlookupCont_ ($dEq1 [Occ=Dead] :: Eq k) + (ww1 :: Word#) (ds3 :: k) (ww2 :: Int#) (ds4 :: HashMap k b) @@ -1496,7 +1503,7 @@ T26615a.$wdisjointSubtrees (word2Int# (popCnt# (and# bx1 (minusWord# m 1##)))) of { (# ipv #) -> - jump $wlookupCont_ ww1 ds5 (+# ww2 5#) ipv + jump $wlookupCont_ $dEq ww1 ds5 (+# ww2 5#) ipv }; 0## -> GHC.Internal.Types.True }; @@ -1508,11 +1515,11 @@ T26615a.$wdisjointSubtrees (word2Int# (and# (uncheckedShiftRL# ww1 ww2) 31##)) of { (# ipv #) -> - jump $wlookupCont_ ww1 ds5 (+# ww2 5#) ipv + jump $wlookupCont_ $dEq ww1 ds5 (+# ww2 5#) ipv } } }; } in - jump $wlookupCont_ bx k0 ww wild2 + jump $wlookupCont_ $dEq bx k0 ww wild2 }; Leaf bx1 ds3 -> case ds3 of { L kB ds4 -> @@ -1570,23 +1577,23 @@ T26615a.$wdisjointSubtrees case GHC.Internal.Unsafe.Coerce.unsafeEqualityProof @(*) @(SmallArray# (HashMap k a) -> SmallArray# (HashMap k b) -> Int#) - @(GHC.Internal.Types.UnusedType 0 "a" - -> GHC.Internal.Types.UnusedType 1 "b" -> Int#) + @(GHC.Internal.Types.UnusedType "a_0" + -> GHC.Internal.Types.UnusedType "b_1" -> Int#) of { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> case reallyUnsafePtrEquality# @Lifted @Lifted - @(GHC.Internal.Types.UnusedType 0 "a") - @(GHC.Internal.Types.UnusedType 1 "b") + @(GHC.Internal.Types.UnusedType "a_0") + @(GHC.Internal.Types.UnusedType "b_1") (bx1 `cast` (SelCo:Fun(arg) (Sub (Sym v2)) :: SmallArray# (HashMap k a) - ~R# GHC.Internal.Types.UnusedType 0 "a")) + ~R# GHC.Internal.Types.UnusedType "a_0")) (bx3 `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) :: SmallArray# (HashMap k b) - ~R# GHC.Internal.Types.UnusedType 1 "b")) + ~R# GHC.Internal.Types.UnusedType "b_1")) of { __DEFAULT -> let { @@ -1715,23 +1722,23 @@ T26615a.$wdisjointSubtrees case GHC.Internal.Unsafe.Coerce.unsafeEqualityProof @(*) @(SmallArray# (HashMap k a) -> SmallArray# (HashMap k b) -> Int#) - @(GHC.Internal.Types.UnusedType 0 "a" - -> GHC.Internal.Types.UnusedType 1 "b" -> Int#) + @(GHC.Internal.Types.UnusedType "a_0" + -> GHC.Internal.Types.UnusedType "b_1" -> Int#) of { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> case reallyUnsafePtrEquality# @Lifted @Lifted - @(GHC.Internal.Types.UnusedType 0 "a") - @(GHC.Internal.Types.UnusedType 1 "b") + @(GHC.Internal.Types.UnusedType "a_0") + @(GHC.Internal.Types.UnusedType "b_1") (bx `cast` (SelCo:Fun(arg) (Sub (Sym v2)) :: SmallArray# (HashMap k a) - ~R# GHC.Internal.Types.UnusedType 0 "a")) + ~R# GHC.Internal.Types.UnusedType "a_0")) (bx1 `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) :: SmallArray# (HashMap k b) - ~R# GHC.Internal.Types.UnusedType 1 "b")) + ~R# GHC.Internal.Types.UnusedType "b_1")) of { __DEFAULT -> let { @@ -1838,7 +1845,7 @@ disjointSubtrees ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 614, types: 682, coercions: 18, joins: 8/14} + = {terms: 622, types: 674, coercions: 18, joins: 8/14} -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} $trModule1 :: GHC.Internal.Prim.Addr# @@ -1878,20 +1885,22 @@ lvl1 @GHC.Internal.Types.LiftedRep @() lvl Rec { --- RHS size: {terms: 37, types: 30, coercions: 0, joins: 0/0} +-- RHS size: {terms: 39, types: 32, coercions: 0, joins: 0/0} $wpoly_lookupInArrayCont_ :: forall a. + Eq String => String -> GHC.Internal.Prim.SmallArray# (T26615a.Leaf String a) -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.Int# -> Bool -[GblId[StrictWorker([!])], - Arity=4, - Str=<1L><L><L><L>, +[GblId[StrictWorker([~, !])], + Arity=5, + Str=<A><1L><L><L><L>, Unf=OtherCon []] $wpoly_lookupInArrayCont_ = \ (@a) + ($dEq2 [Occ=Dead] :: Eq String) (k1 :: String) (ww :: GHC.Internal.Prim.SmallArray# (T26615a.Leaf String a)) (ww1 :: GHC.Internal.Prim.Int#) @@ -1907,7 +1916,12 @@ $wpoly_lookupInArrayCont_ case GHC.Internal.Base.eqString k2 kx of { False -> $wpoly_lookupInArrayCont_ - @a k2 ww (GHC.Internal.Prim.+# ww1 1#) ww2; + @a + GHC.Internal.Classes.$fEqList_$s$fEqList1 + k2 + ww + (GHC.Internal.Prim.+# ww1 1#) + ww2; True -> GHC.Internal.Types.False } } @@ -1918,17 +1932,19 @@ $wpoly_lookupInArrayCont_ end Rec } Rec { --- RHS size: {terms: 98, types: 73, coercions: 0, joins: 0/1} +-- RHS size: {terms: 102, types: 75, coercions: 0, joins: 0/1} $wpoly_lookupCont_ :: forall a. + Eq String => GHC.Internal.Prim.Word# -> String -> GHC.Internal.Prim.Int# -> HashMap String a -> Bool -[GblId[StrictWorker([~, !, ~, !])], - Arity=4, - Str=<L><1L><L><1L>, +[GblId[StrictWorker([~, ~, !, ~, !])], + Arity=5, + Str=<A><L><1L><L><1L>, Unf=OtherCon []] $wpoly_lookupCont_ = \ (@a) + ($dEq1 [Occ=Dead] :: Eq String) (ww :: GHC.Internal.Prim.Word#) (ds5 :: String) (ww1 :: GHC.Internal.Prim.Int#) @@ -1953,6 +1969,7 @@ $wpoly_lookupCont_ 1# -> $wpoly_lookupInArrayCont_ @a + GHC.Internal.Classes.$fEqList_$s$fEqList1 ds9 bx2 0# @@ -1979,7 +1996,13 @@ $wpoly_lookupCont_ (GHC.Internal.Prim.and# bx1 (GHC.Internal.Prim.minusWord# m 1##)))) of { (# ipv2 #) -> - $wpoly_lookupCont_ @a ww ds9 (GHC.Internal.Prim.+# ww1 5#) ipv2 + $wpoly_lookupCont_ + @a + GHC.Internal.Classes.$fEqList_$s$fEqList1 + ww + ds9 + (GHC.Internal.Prim.+# ww1 5#) + ipv2 }; 0## -> GHC.Internal.Types.True }; @@ -1993,14 +2016,20 @@ $wpoly_lookupCont_ (GHC.Internal.Prim.uncheckedShiftRL# ww ww1) 31##)) of { (# ipv2 #) -> - $wpoly_lookupCont_ @a ww ds9 (GHC.Internal.Prim.+# ww1 5#) ipv2 + $wpoly_lookupCont_ + @a + GHC.Internal.Classes.$fEqList_$s$fEqList1 + ww + ds9 + (GHC.Internal.Prim.+# ww1 5#) + ipv2 } } } end Rec } Rec { --- RHS size: {terms: 448, types: 523, coercions: 18, joins: 8/13} +-- RHS size: {terms: 450, types: 507, coercions: 18, joins: 8/13} T26615.$s$wdisjointSubtrees [InlPrag=[~], Occ=LoopBreaker] :: forall a b. GHC.Internal.Prim.Int# @@ -2021,7 +2050,8 @@ T26615.$s$wdisjointSubtrees T26615a.Empty -> GHC.Internal.Types.True; T26615a.Leaf bx ds2 -> case ds2 of { T26615a.L kB ds3 -> - $wpoly_lookupCont_ @a bx kB ww ds + $wpoly_lookupCont_ + @a GHC.Internal.Classes.$fEqList_$s$fEqList1 bx kB ww ds }; T26615a.Collision bx bx1 -> T26615.$s$wdisjointSubtrees @b @a ww wild ds @@ -2031,7 +2061,9 @@ T26615.$s$wdisjointSubtrees T26615a.Leaf bx ds1 -> case ds1 of { T26615a.L kA ds2 -> case _b of wild2 { - __DEFAULT -> $wpoly_lookupCont_ @b bx kA ww wild2; + __DEFAULT -> + $wpoly_lookupCont_ + @b GHC.Internal.Classes.$fEqList_$s$fEqList1 bx kA ww wild2; T26615a.Leaf bx1 ds3 -> case ds3 of { T26615a.L kB ds4 -> case GHC.Internal.Prim.neWord# bx bx1 of { @@ -2085,9 +2117,9 @@ T26615.$s$wdisjointSubtrees [LclId[JoinId(0)(Nothing)]] $j = jump $s$wfoldr_ sc sc1 (GHC.Internal.Prim.+# sc2 1#) sc3 } in joinrec { - $wlookupInArrayCont_ [InlPrag=[2], - Occ=LoopBreaker, - Dmd=SC(S,C(1,C(1,C(1,L))))] + $w$slookupInArrayCont_ [InlPrag=[2], + Occ=LoopBreaker, + Dmd=SC(S,C(1,C(1,C(1,L))))] :: String -> GHC.Internal.Prim.SmallArray# (T26615a.Leaf String b) -> GHC.Internal.Prim.Int# @@ -2097,12 +2129,12 @@ T26615.$s$wdisjointSubtrees Arity=4, Str=<1L><L><L><L>, Unf=OtherCon []] - $wlookupInArrayCont_ (k1 :: String) - (ww1 - :: GHC.Internal.Prim.SmallArray# - (T26615a.Leaf String b)) - (ww2 :: GHC.Internal.Prim.Int#) - (ww3 :: GHC.Internal.Prim.Int#) + $w$slookupInArrayCont_ (k1 :: String) + (ww1 + :: GHC.Internal.Prim.SmallArray# + (T26615a.Leaf String b)) + (ww2 :: GHC.Internal.Prim.Int#) + (ww3 :: GHC.Internal.Prim.Int#) = case k1 of k2 { __DEFAULT -> case GHC.Internal.Prim.>=# ww2 ww3 of { __DEFAULT -> @@ -2116,7 +2148,7 @@ T26615.$s$wdisjointSubtrees case ipv5 of { T26615a.L kx v -> case GHC.Internal.Base.eqString k2 kx of { False -> - jump $wlookupInArrayCont_ + jump $w$slookupInArrayCont_ k2 ww1 (GHC.Internal.Prim.+# ww2 1#) ww3; True -> GHC.Internal.Types.False } @@ -2125,7 +2157,7 @@ T26615.$s$wdisjointSubtrees 1# -> jump $j } }; } in - jump $wlookupInArrayCont_ kA bx3 0# lvl2 + jump $w$slookupInArrayCont_ kA bx3 0# lvl2 } }; 1# -> sc3 @@ -2187,23 +2219,23 @@ T26615.$s$wdisjointSubtrees @(GHC.Internal.Prim.SmallArray# (HashMap String a) -> GHC.Internal.Prim.SmallArray# (HashMap String b) -> GHC.Internal.Prim.Int#) - @(GHC.Internal.Types.UnusedType 0 "a" - -> GHC.Internal.Types.UnusedType 1 "b" -> GHC.Internal.Prim.Int#) + @(GHC.Internal.Types.UnusedType "a_0" + -> GHC.Internal.Types.UnusedType "b_1" -> GHC.Internal.Prim.Int#) of { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> case GHC.Internal.Prim.reallyUnsafePtrEquality# @GHC.Internal.Types.Lifted @GHC.Internal.Types.Lifted - @(GHC.Internal.Types.UnusedType 0 "a") - @(GHC.Internal.Types.UnusedType 1 "b") + @(GHC.Internal.Types.UnusedType "a_0") + @(GHC.Internal.Types.UnusedType "b_1") (bx1 `cast` (SelCo:Fun(arg) (Sub (Sym v2)) :: GHC.Internal.Prim.SmallArray# (HashMap String a) - ~R# GHC.Internal.Types.UnusedType 0 "a")) + ~R# GHC.Internal.Types.UnusedType "a_0")) (bx3 `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) :: GHC.Internal.Prim.SmallArray# (HashMap String b) - ~R# GHC.Internal.Types.UnusedType 1 "b")) + ~R# GHC.Internal.Types.UnusedType "b_1")) of { __DEFAULT -> joinrec { @@ -2365,23 +2397,23 @@ T26615.$s$wdisjointSubtrees @(GHC.Internal.Prim.SmallArray# (HashMap String a) -> GHC.Internal.Prim.SmallArray# (HashMap String b) -> GHC.Internal.Prim.Int#) - @(GHC.Internal.Types.UnusedType 0 "a" - -> GHC.Internal.Types.UnusedType 1 "b" -> GHC.Internal.Prim.Int#) + @(GHC.Internal.Types.UnusedType "a_0" + -> GHC.Internal.Types.UnusedType "b_1" -> GHC.Internal.Prim.Int#) of { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> case GHC.Internal.Prim.reallyUnsafePtrEquality# @GHC.Internal.Types.Lifted @GHC.Internal.Types.Lifted - @(GHC.Internal.Types.UnusedType 0 "a") - @(GHC.Internal.Types.UnusedType 1 "b") + @(GHC.Internal.Types.UnusedType "a_0") + @(GHC.Internal.Types.UnusedType "b_1") (bx `cast` (SelCo:Fun(arg) (Sub (Sym v2)) :: GHC.Internal.Prim.SmallArray# (HashMap String a) - ~R# GHC.Internal.Types.UnusedType 0 "a")) + ~R# GHC.Internal.Types.UnusedType "a_0")) (bx1 `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) :: GHC.Internal.Prim.SmallArray# (HashMap String b) - ~R# GHC.Internal.Types.UnusedType 1 "b")) + ~R# GHC.Internal.Types.UnusedType "b_1")) of { __DEFAULT -> joinrec { View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0d938a44dbd69b6e04411539d51a64e… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0d938a44dbd69b6e04411539d51a64e… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/sjakobi/cpr-docs
by Simon Jakobi (＠sjakobi2) 03 Jul '26

03 Jul '26

Simon Jakobi pushed new branch wip/sjakobi/cpr-docs at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/sjakobi/cpr-docs You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T27466] Honour -dsuppress-coercions in GHC.Core.TyCo.pprCo
by Simon Peyton Jones (＠simonpj) 03 Jul '26

03 Jul '26

Simon Peyton Jones pushed to branch wip/T27466 at Glasgow Haskell Compiler / GHC Commits: 397b8c44 by Simon Peyton Jones at 2026-07-03T03:31:35+01:00 Honour -dsuppress-coercions in GHC.Core.TyCo.pprCo Fixes #27467 - - - - - 1 changed file: - compiler/GHC/Core/Ppr.hs Changes: ===================================== compiler/GHC/Core/Ppr.hs ===================================== @@ -292,14 +292,14 @@ noParens :: SDoc -> SDoc noParens pp = pp pprOptCo :: Coercion -> SDoc --- Print a coercion with its type +-- Print a coercion with its type (unless suppressed by -dsuppress-coercion-types) -- Honour -dsuppress-coercions -- Placed here because it needs GHC.Core.Coercion.coercionType -pprOptCo co = sep [pprCo co, dcolon <+> co_type] - where - co_type = sdocOption sdocSuppressCoercionTypes $ \case - True -> ellipsis - False -> ppr (coercionType co) +pprOptCo co = sdocOption sdocSuppressCoercionTypes $ \case + True -> pprParendCo co + False -> parens (sep [pprCo co, dcolon <+> pp_co_type]) + where + pp_co_type = ppr (coercionType co) ppr_id_occ :: (SDoc -> SDoc) -> Id -> SDoc ppr_id_occ add_par id View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/397b8c44db6f1e59dfb54e8cf6c2dde… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/397b8c44db6f1e59dfb54e8cf6c2dde… You're receiving this email because of your account on gitlab.haskell.org.

1 0