- ghc-commits - Haskell.org

[Git][ghc/ghc][wip/fendor/no-code-output-constr] 2 commits: Add 'backendSupportsInfoTableMap' backend predicate
by Hannes Siebenhandl (＠fendor) 24 Jun '26

24 Jun '26

Hannes Siebenhandl pushed to branch wip/fendor/no-code-output-constr at Glasgow Haskell Compiler / GHC Commits: 046418ca by fendor at 2026-06-24T16:16:50+02:00 Add 'backendSupportsInfoTableMap' backend predicate Check whether the backend supports the `-finfo-table-map` flag and ignore it otherwise. - - - - - 61d935d3 by Matthew Pickering at 2026-06-24T16:16:50+02:00 Add failing test for `-finfo-table-map` and bytecode backend If you compile a module using the bytecode backend, with -finfo-table-map, then the info table map doesn't get populated for the module. This is because the -finfo-table-map code path is implemented mostly in the StgToCmm phase which isn't run when creating bytecode. Ticket #27039 - - - - - 7 changed files: - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Session.hs - testsuite/tests/ghci/scripts/all.T - + testsuite/tests/ghci/scripts/bytecodeIPE.hs - + testsuite/tests/ghci/scripts/bytecodeIPE.script - + testsuite/tests/ghci/scripts/bytecodeIPE.stdout Changes: ===================================== compiler/GHC/Driver/Backend.hs ===================================== @@ -99,6 +99,7 @@ module GHC.Driver.Backend , backendPostHscPipeline , backendNormalSuccessorPhase , backendName + , backendSupportsInfoTableMap , backendValidityOfCImport , backendValidityOfCExport @@ -680,6 +681,16 @@ backendSupportsBreakpoints = \case Named Bytecode -> True Named NoBackend -> False +-- | If this flag is unset, then the driver ignores the flag @-finfo-table-map@, +-- since the backend doesn't support generating the info table map. +backendSupportsInfoTableMap :: Backend -> Bool +backendSupportsInfoTableMap (Named NCG) = True +backendSupportsInfoTableMap (Named LLVM) = False +backendSupportsInfoTableMap (Named ViaC) = True +backendSupportsInfoTableMap (Named JavaScript) = False +backendSupportsInfoTableMap (Named Bytecode) = False +backendSupportsInfoTableMap (Named NoBackend) = True -- We are not generating code, so we ignore it any way + -- | If this flag is set, then the driver forces the -- optimization level to 0, issuing a warning message if -- the command line requested a higher optimization level. ===================================== compiler/GHC/Driver/CodeOutput.hs ===================================== @@ -63,6 +63,7 @@ import GHC.Types.Unique.Supply ( UniqueTag(..) ) import System.IO import Data.Set (Set) import qualified Data.Set as Set +import GHC.Plugins (panic) {- ************************************************************************ ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -3903,9 +3903,9 @@ makeDynFlagsConsistent dflags in dflags_c | gopt Opt_InfoTableMap dflags - , LlvmCodeOutput <- backendCodeOutput (backend dflags) + , backendSupportsInfoTableMap (backend dflags) = loop (gopt_unset dflags Opt_InfoTableMap) - "-finfo-table-map is incompatible with -fllvm and is disabled (See #26435)" + $ "-finfo-table-map is incompatible with " ++ show (backend dflags) ++ " and is disabled (See #26435)" | otherwise = (dflags, mempty, mempty) where loc = mkGeneralSrcSpan (fsLit "when making flags consistent") ===================================== testsuite/tests/ghci/scripts/all.T ===================================== @@ -385,6 +385,14 @@ test('ListTuplePunsPpr', normal, ghci_script, ['ListTuplePunsPpr.script']) test('ListTuplePunsPprNoAbbrevTuple', [limit_stdout_lines(14)], ghci_script, ['ListTuplePunsPprNoAbbrevTuple.script']) test('T24459', normal, ghci_script, ['T24459.script']) test('T24632', normal, ghci_script, ['T24632.script']) +# bytecode backend doesn't support '-finfo-table-map' (#27039) +test('bytecodeIPE', + [ extra_hc_opts('-finfo-table-map') + , extra_files(['bytecodeIPE.hs']) + , req_rts_linker + , when(arch('wasm32') or arch('javascript'), skip) + ], + ghci_script, ['bytecodeIPE.script']) # Test package renaming in GHCi session test('GhciPackageRename', ===================================== testsuite/tests/ghci/scripts/bytecodeIPE.hs ===================================== @@ -0,0 +1,12 @@ +module BytecodeIPE where + +import Data.Maybe (isJust) +import GHC.InfoProv (whereFrom) + +marker :: String +marker = id "bytecode-stub-init" +{-# NOINLINE marker #-} + +-- `whereFrom` only succeeds if the module's IPE initializer ran. +probe :: IO Bool +probe = isJust <$> whereFrom marker ===================================== testsuite/tests/ghci/scripts/bytecodeIPE.script ===================================== @@ -0,0 +1,2 @@ +:load bytecodeIPE.hs +probe ===================================== testsuite/tests/ghci/scripts/bytecodeIPE.stdout ===================================== @@ -0,0 +1 @@ +False View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fe056b958602665057dc101c57627b… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fe056b958602665057dc101c57627b… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/fendor/no-code-output-constr] 2 commits: Add 'backendSupportsInfoTableMap' backend predicate
by Hannes Siebenhandl (＠fendor) 24 Jun '26

24 Jun '26

Hannes Siebenhandl pushed to branch wip/fendor/no-code-output-constr at Glasgow Haskell Compiler / GHC Commits: 7cd7dbf8 by fendor at 2026-06-24T16:10:06+02:00 Add 'backendSupportsInfoTableMap' backend predicate Check whether the backend supports the `-finfo-table-map` flag and ignore it otherwise. - - - - - fe056b95 by Matthew Pickering at 2026-06-24T16:11:29+02:00 Add failing test for `-finfo-table-map` and bytecode backend If you compile a module using the bytecode backend, with -finfo-table-map, then the info table map doesn't get populated for the module. This is because the -finfo-table-map code path is implemented mostly in the StgToCmm phase which isn't run when creating bytecode. Ticket #27039 - - - - - 7 changed files: - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Session.hs - testsuite/tests/ghci/scripts/all.T - + testsuite/tests/ghci/scripts/bytecodeIPE.hs - + testsuite/tests/ghci/scripts/bytecodeIPE.script - + testsuite/tests/ghci/scripts/bytecodeIPE.stdout Changes: ===================================== compiler/GHC/Driver/Backend.hs ===================================== @@ -99,6 +99,7 @@ module GHC.Driver.Backend , backendPostHscPipeline , backendNormalSuccessorPhase , backendName + , backendSupportsInfoTableMap , backendValidityOfCImport , backendValidityOfCExport @@ -680,6 +681,16 @@ backendSupportsBreakpoints = \case Named Bytecode -> True Named NoBackend -> False +-- | If this flag is unset, then the driver ignores the flag @-finfo-table-map@, +-- since the backend doesn't support generating the info table map. +backendSupportsInfoTableMap :: Backend -> Bool +backendSupportsInfoTableMap (Named NCG) = True +backendSupportsInfoTableMap (Named LLVM) = False +backendSupportsInfoTableMap (Named ViaC) = True +backendSupportsInfoTableMap (Named JavaScript) = False +backendSupportsInfoTableMap (Named Bytecode) = False +backendSupportsInfoTableMap (Named NoBackend) = True -- We are not generating code, so we ignore it any way + -- | If this flag is set, then the driver forces the -- optimization level to 0, issuing a warning message if -- the command line requested a higher optimization level. ===================================== compiler/GHC/Driver/CodeOutput.hs ===================================== @@ -63,6 +63,7 @@ import GHC.Types.Unique.Supply ( UniqueTag(..) ) import System.IO import Data.Set (Set) import qualified Data.Set as Set +import GHC.Plugins (panic) {- ************************************************************************ ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -3903,7 +3903,7 @@ makeDynFlagsConsistent dflags in dflags_c | gopt Opt_InfoTableMap dflags - , LlvmCodeOutput <- backendCodeOutput (backend dflags) + , backendSupportsInfoTableMap (backend dflags) = loop (gopt_unset dflags Opt_InfoTableMap) "-finfo-table-map is incompatible with -fllvm and is disabled (See #26435)" ===================================== testsuite/tests/ghci/scripts/all.T ===================================== @@ -385,6 +385,14 @@ test('ListTuplePunsPpr', normal, ghci_script, ['ListTuplePunsPpr.script']) test('ListTuplePunsPprNoAbbrevTuple', [limit_stdout_lines(14)], ghci_script, ['ListTuplePunsPprNoAbbrevTuple.script']) test('T24459', normal, ghci_script, ['T24459.script']) test('T24632', normal, ghci_script, ['T24632.script']) +# bytecode backend doesn't support '-finfo-table-map' (#27039) +test('bytecodeIPE', + [ extra_hc_opts('-finfo-table-map') + , extra_files(['bytecodeIPE.hs']) + , req_rts_linker + , when(arch('wasm32') or arch('javascript'), skip) + ], + ghci_script, ['bytecodeIPE.script']) # Test package renaming in GHCi session test('GhciPackageRename', ===================================== testsuite/tests/ghci/scripts/bytecodeIPE.hs ===================================== @@ -0,0 +1,12 @@ +module BytecodeIPE where + +import Data.Maybe (isJust) +import GHC.InfoProv (whereFrom) + +marker :: String +marker = id "bytecode-stub-init" +{-# NOINLINE marker #-} + +-- `whereFrom` only succeeds if the module's IPE initializer ran. +probe :: IO Bool +probe = isJust <$> whereFrom marker ===================================== testsuite/tests/ghci/scripts/bytecodeIPE.script ===================================== @@ -0,0 +1,2 @@ +:load bytecodeIPE.hs +probe ===================================== testsuite/tests/ghci/scripts/bytecodeIPE.stdout ===================================== @@ -0,0 +1 @@ +False View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/04d9678420774db5ce14ff67fa40dc… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/04d9678420774db5ce14ff67fa40dc… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: compiler: refactor error reporting code for ExplicitLevelImports
by Marge Bot (＠marge-bot) 24 Jun '26

24 Jun '26

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 89526177 by mangoiv at 2026-06-24T09:59:20-04:00 compiler: refactor error reporting code for ExplicitLevelImports Refactors error reporting code for ExplicitLevelImports to pass in a RdrName and a GlobalReaderElt to be able to report errors that are faithful to the source and to more precisely distinguish between names that are in scope from different qualifications. Fixes #27385 and #26616 - - - - - 8a195215 by Simon Hengel at 2026-06-24T09:59:22-04:00 Set GHC_VERSION when calling custom pre-processors (see #25952) (so that pre-processors can emit backwards compatible code) - - - - - 72727259 by Simon Hengel at 2026-06-24T09:59:23-04:00 Add a flag to control GHCi specific error hints (close #27409) - - - - - a0f24c8e by Simon Hengel at 2026-06-24T09:59:24-04:00 Reference correct package in error messages for reexported modules (fixes #27417) - - - - - 89 changed files: - + changelog.d/26616 - + changelog.d/interactive-error-hints - + changelog.d/pp-set-ghc-version - + changelog.d/reexported-module-errors - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Iface/Errors.hs - compiler/GHC/Iface/Errors/Ppr.hs - compiler/GHC/Iface/Errors/Types.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Rename/Splice.hs - compiler/GHC/Rename/Splice.hs-boot - compiler/GHC/Rename/Unbound.hs - compiler/GHC/SysTools/Tasks.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/Utils/Env.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Types/Hint/Ppr.hs - compiler/GHC/Types/Name/Reader.hs - compiler/GHC/Unit/Finder.hs - compiler/GHC/Unit/Finder/Types.hs - compiler/GHC/Unit/State.hs - compiler/GHC/Utils/Outputable.hs - docs/users_guide/ghci.rst - docs/users_guide/phases.rst - ghc/GHCi/UI/Exception.hs - ghc/Main.hs - testsuite/tests/annotations/should_fail/annfail03.stderr - testsuite/tests/annotations/should_fail/annfail04.stderr - testsuite/tests/annotations/should_fail/annfail06.stderr - testsuite/tests/annotations/should_fail/annfail09.stderr - testsuite/tests/ghci/prog-mhu002/prog-mhu002c.stdout - testsuite/tests/ghci/scripts/ghci024.stdout - testsuite/tests/ghci/scripts/ghci024.stdout-mingw32 - + testsuite/tests/package/ImportReexport.hs - + testsuite/tests/package/ImportReexport.stderr - testsuite/tests/package/all.T - testsuite/tests/quasiquotation/qq001/qq001.stderr - testsuite/tests/quasiquotation/qq002/qq002.stderr - testsuite/tests/quasiquotation/qq003/qq003.stderr - testsuite/tests/quasiquotation/qq004/qq004.stderr - testsuite/tests/quotes/LiftErrMsg.stderr - testsuite/tests/quotes/LiftErrMsgDefer.stderr - testsuite/tests/quotes/LiftErrMsgTyped.stderr - testsuite/tests/quotes/T10384.stderr - testsuite/tests/quotes/T5721.stderr - testsuite/tests/quotes/TH_localname.stderr - testsuite/tests/splice-imports/SI03.stderr - testsuite/tests/splice-imports/SI05.stderr - testsuite/tests/splice-imports/SI08.stderr - testsuite/tests/splice-imports/SI08_oneshot.stderr - testsuite/tests/splice-imports/SI16.stderr - testsuite/tests/splice-imports/SI18.stderr - testsuite/tests/splice-imports/SI20.stderr - testsuite/tests/splice-imports/SI25.stderr - testsuite/tests/splice-imports/SI28.stderr - testsuite/tests/splice-imports/SI29.stderr - testsuite/tests/splice-imports/SI31.stderr - testsuite/tests/splice-imports/SI36.stderr - testsuite/tests/splice-imports/T26088.stderr - testsuite/tests/splice-imports/T26090.stderr - + testsuite/tests/splice-imports/T26616.hs - + testsuite/tests/splice-imports/T26616.stderr - testsuite/tests/splice-imports/all.T - testsuite/tests/th/T16976z.stderr - testsuite/tests/th/T17820a.stderr - testsuite/tests/th/T17820b.stderr - testsuite/tests/th/T17820c.stderr - testsuite/tests/th/T17820d.stderr - testsuite/tests/th/T17820e.stderr - testsuite/tests/th/T21547.stderr - testsuite/tests/th/T23829_hasty.stderr - testsuite/tests/th/T23829_hasty_b.stderr - testsuite/tests/th/T23829_tardy.ghc.stderr - testsuite/tests/th/T26098_local.stderr - testsuite/tests/th/T26098_quote.stderr - testsuite/tests/th/T26098_splice.stderr - testsuite/tests/th/T26099.stderr - testsuite/tests/th/T26568.stderr - testsuite/tests/th/T5795.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6d436d9c7bbd288f70db91db1b8be5… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6d436d9c7bbd288f70db91db1b8be5… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Deleted branch wip/sol/warning-flags
by Simon Hengel (＠sol) 24 Jun '26

24 Jun '26

Simon Hengel deleted branch wip/sol/warning-flags at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new tag ghc-9.12.5-rc2
by Magnus (＠MangoIV) 24 Jun '26

24 Jun '26

Magnus pushed new tag ghc-9.12.5-rc2 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/ghc-9.12.5-rc2 You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/sjakobi/lazy-field-anns] Add -XLazyFieldAnnotations
by Simon Jakobi (＠sjakobi2) 24 Jun '26

24 Jun '26

Simon Jakobi pushed to branch wip/sjakobi/lazy-field-anns at Glasgow Haskell Compiler / GHC Commits: 19e0f321 by Simon Jakobi at 2026-06-24T13:57:54+02:00 Add -XLazyFieldAnnotations Unbundle the prefix `~` lazy field annotation syntax from StrictData. The new LazyFieldAnnotations extension controls only whether `~` is accepted on data and GADT constructor fields; StrictData (and hence Strict) implies it but continues to own the default strictness of unannotated fields. This lets hand-written and generated code write an explicit lazy annotation without flipping the module-wide default. The validity check in checkValidDataCon now keys off LazyFieldAnnotations instead of StrictData. Implements GHC proposal 752 (https://github.com/ghc-proposals/ghc-proposals/pull/752) Closes #24455. Co-Authored-By: Claude Opus 4.8 <noreply(a)anthropic.com> - - - - - 16 changed files: - + changelog.d/lazy-field-annotations - compiler/GHC/Driver/Flags.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/TyCl.hs - docs/users_guide/exts/strict.rst - libraries/ghc-internal/src/GHC/Internal/LanguageExtensions.hs - + testsuite/tests/deSugar/should_run/LazyFieldAnnotationsSemantics.hs - + testsuite/tests/deSugar/should_run/LazyFieldAnnotationsSemantics.stdout - testsuite/tests/deSugar/should_run/all.T - + testsuite/tests/typecheck/should_compile/LazyFieldAnnotations.hs - testsuite/tests/typecheck/should_compile/all.T - testsuite/tests/typecheck/should_fail/LazyFieldsDisabled.stderr - + testsuite/tests/typecheck/should_fail/LazyFieldsDisabledStrictData.hs - + testsuite/tests/typecheck/should_fail/LazyFieldsDisabledStrictData.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== changelog.d/lazy-field-annotations ===================================== @@ -0,0 +1,12 @@ +section: language +synopsis: Add the `LazyFieldAnnotations` extension +issues: #24455 +mrs: !16246 + +description: { + The new :extension:`LazyFieldAnnotations` extension permits the prefix + ``~`` lazy field annotation on data and GADT constructor fields without + enabling :extension:`StrictData`. :extension:`StrictData` (and therefore + :extension:`Strict`) now implies :extension:`LazyFieldAnnotations` and + continues to control the default strictness of unannotated fields. +} ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -261,6 +261,7 @@ extensionName = \case LangExt.ExplicitLevelImports -> "ExplicitLevelImports" LangExt.ImplicitStagePersistence -> "ImplicitStagePersistence" LangExt.QualifiedStrings -> "QualifiedStrings" + LangExt.LazyFieldAnnotations -> "LazyFieldAnnotations" -- | Is this extension known by any other names? For example -- -XGeneralizedNewtypeDeriving is accepted @@ -343,6 +344,7 @@ impliedXFlags , (LangExt.TemplateHaskell, On LangExt.TemplateHaskellQuotes) , (LangExt.Strict, On LangExt.StrictData) + , (LangExt.StrictData, On LangExt.LazyFieldAnnotations) -- Historically only UnboxedTuples was required for unboxed sums to work. -- To avoid breaking code, we make UnboxedTuples imply UnboxedSums. ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -3231,7 +3231,7 @@ instance Diagnostic TcRnMessage where TcRnHasFieldResolvedIncomplete{} -> noHints TcRnBadFieldAnnotation _ _ LazyFieldsDisabled - -> [suggestExtension LangExt.StrictData] + -> [suggestExtension LangExt.LazyFieldAnnotations] TcRnBadFieldAnnotation{} -> noHints TcRnSuperclassCycle{} ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -6355,7 +6355,7 @@ data PatSynInvalidRhsReason data BadFieldAnnotationReason where {-| A lazy data type field annotation (~) was used without enabling the - extension StrictData. + extension LazyFieldAnnotations. Test cases: LazyFieldsDisabled ===================================== compiler/GHC/Tc/TyCl.hs ===================================== @@ -5186,7 +5186,7 @@ checkValidDataCon dflags existential_ok tc con ; let check_bang :: Type -> HsSrcBang -> HsImplBang -> Int -> TcM () check_bang orig_arg_ty bang rep_bang n | HsSrcBang _ _ SrcLazy <- bang - , not (bang_opt_strict_data bang_opts) + , not (xopt LangExt.LazyFieldAnnotations dflags) = addErrTc (bad_bang n LazyFieldsDisabled) -- Warn about UNPACK without "!" ===================================== docs/users_guide/exts/strict.rst ===================================== @@ -155,6 +155,44 @@ Note the following points: for more discussion and examples. +.. _lazy-field-annotations: + +Lazy field annotations +---------------------- + +.. extension:: LazyFieldAnnotations + :shortdesc: Allow the prefix ``~`` lazy field annotation on constructor fields. + + :since: 10.2.1 + + Allow the prefix ``~`` lazy field annotation on data and GADT constructor + fields. + +``LazyFieldAnnotations`` allows a prefix ``~`` lazy annotation in every +constructor-field position where a prefix ``!`` strict annotation is accepted: +Haskell-98 prefix and record fields, and GADT argument types and record +fields. :: + + {-# LANGUAGE LazyFieldAnnotations #-} + + data A = A ~Int Bool + data B = B { b1 :: ~Int, b2 :: !Bool } + + data C where + C1 :: ~Int -> C + C2 :: { c1 :: ~Int, c2 :: !Bool } -> C + +A field annotated with ``~`` is lazy: it is not forced when the constructor is +built, but held as a thunk — the same behaviour as an unannotated field. + +The ``~`` annotation must be written in prefix form:: + + data T = MkT ~Int -- valid + data T = MkT ~ Int -- invalid + +See `GHC Proposal #229 <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0229-w…>`__ +for the precise rules. + .. _strict-data: Strict-by-default data types @@ -163,6 +201,8 @@ Strict-by-default data types .. extension:: StrictData :shortdesc: Treat datatype fields as strict by default. + :implies: :extension:`LazyFieldAnnotations` + :since: 8.0.1 Make fields of data types defined in the current module strict by default. @@ -183,13 +223,8 @@ we interpret it as if they had written :: The extension only affects definitions in this module. -The ``~`` annotation must be written in prefix form:: - - data T = MkT ~Int -- valid - data T = MkT ~ Int -- invalid - -See `GHC Proposal #229 <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0229-w…>`__ -for the precise rules. +The ``~`` lazy field annotation is provided by :extension:`LazyFieldAnnotations` +(which ``StrictData`` implies); see :ref:`lazy-field-annotations`. .. _strict: ===================================== libraries/ghc-internal/src/GHC/Internal/LanguageExtensions.hs ===================================== @@ -169,6 +169,7 @@ data Extension | ExplicitLevelImports | ImplicitStagePersistence | QualifiedStrings + | LazyFieldAnnotations deriving (Eq, Enum, Show, Generic, Bounded) -- 'Ord' and 'Bounded' are provided for GHC API users (see discussions -- in https://gitlab.haskell.org/ghc/ghc/merge_requests/2707 and ===================================== testsuite/tests/deSugar/should_run/LazyFieldAnnotationsSemantics.hs ===================================== @@ -0,0 +1,24 @@ +{-# LANGUAGE LazyFieldAnnotations #-} + +-- | LazyFieldAnnotations does not change the default strictness of fields. +-- Without StrictData an unannotated field stays lazy and a ~ field is lazy +-- too; a ! field is still strict. +module Main where + +import Control.Exception (try, evaluate, SomeException) + +data T = Plain Int -- unannotated: lazy + | Lazy ~Int -- explicit ~: lazy + | Strict !Int -- explicit !: strict + +-- | Does building the constructor force the field? +forcesField :: T -> IO Bool +forcesField x = do + r <- try (evaluate x) :: IO (Either SomeException T) + pure (either (const True) (const False) r) + +main :: IO () +main = do + print =<< forcesField (Plain undefined) -- False: lazy + print =<< forcesField (Lazy undefined) -- False: lazy + print =<< forcesField (Strict undefined) -- True: strict ===================================== testsuite/tests/deSugar/should_run/LazyFieldAnnotationsSemantics.stdout ===================================== @@ -0,0 +1,3 @@ +False +False +True ===================================== testsuite/tests/deSugar/should_run/all.T ===================================== @@ -76,3 +76,5 @@ test('T19680A', normal, compile_and_run, ['']) test('T20024', exit_code(1), compile_and_run, ['']) test('Or5', exit_code(1), compile_and_run, ['']) + +test('LazyFieldAnnotationsSemantics', normal, compile_and_run, ['']) ===================================== testsuite/tests/typecheck/should_compile/LazyFieldAnnotations.hs ===================================== @@ -0,0 +1,15 @@ +{-# LANGUAGE LazyFieldAnnotations #-} +{-# LANGUAGE GADTs #-} + +-- | LazyFieldAnnotations alone accepts the prefix ~ annotation in every +-- constructor-field position, without enabling StrictData. +module LazyFieldAnnotations where + +-- Haskell-98 prefix and record fields +data A = A ~Int Bool +data B = B { b1 :: ~Int, b2 :: !Bool } + +-- GADT argument types and record fields +data C where + C1 :: ~Int -> C + C2 :: { c1 :: ~Int, c2 :: !Bool } -> C ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -967,4 +967,5 @@ test('T26805a', normal, compile, ['']) test('T24464', normal, compile, ['']) test('ExpansionQLIm', normal, compile, ['']) test('T23135', normal, compile, ['']) +test('LazyFieldAnnotations', normal, compile, ['']) ===================================== testsuite/tests/typecheck/should_fail/LazyFieldsDisabled.stderr ===================================== @@ -1,8 +1,8 @@ - LazyFieldsDisabled.hs:3:10: error: [GHC-81601] • Lazy field annotations (~) are disabled on the first argument of ‘A’ • In the definition of data constructor ‘A’ In the data type declaration for ‘A’ Suggested fix: - Perhaps you intended to use the ‘StrictData’ extension (implied by ‘Strict’) + Perhaps you intended to use the ‘LazyFieldAnnotations’ extension (implied by ‘StrictData’) + ===================================== testsuite/tests/typecheck/should_fail/LazyFieldsDisabledStrictData.hs ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE StrictData #-} +{-# LANGUAGE NoLazyFieldAnnotations #-} + +-- | A later NoLazyFieldAnnotations overrides the implication from StrictData, +-- so ~ is rejected even though unannotated fields remain strict. +module LazyFieldsDisabledStrictData where + +data A = A ~Int ===================================== testsuite/tests/typecheck/should_fail/LazyFieldsDisabledStrictData.stderr ===================================== @@ -0,0 +1,8 @@ +LazyFieldsDisabledStrictData.hs:8:10: error: [GHC-81601] + • Lazy field annotations (~) are disabled + on the first argument of ‘A’ + • In the definition of data constructor ‘A’ + In the data type declaration for ‘A’ + Suggested fix: + Perhaps you intended to use the ‘LazyFieldAnnotations’ extension (implied by ‘StrictData’) + ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -690,6 +690,7 @@ test('T21444', normal, compile_fail, ['']) test('T23308', normal, compile_fail, ['']) test('MultiAssocDefaults', normal, compile_fail, ['']) test('LazyFieldsDisabled', normal, compile_fail, ['']) +test('LazyFieldsDisabledStrictData', normal, compile_fail, ['']) test('TyfamsDisabled', normal, compile_fail, ['']) test('CommonFieldResultTypeMismatch', normal, compile_fail, ['']) test('CommonFieldTypeMismatch', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/19e0f321bfe845c409d3b95dadcf583… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/19e0f321bfe845c409d3b95dadcf583… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/sjakobi/lazy-field-anns] Add -XLazyFieldAnnotations
by Simon Jakobi (＠sjakobi2) 24 Jun '26

24 Jun '26

Simon Jakobi pushed to branch wip/sjakobi/lazy-field-anns at Glasgow Haskell Compiler / GHC Commits: 46d5c55a by Simon Jakobi at 2026-06-24T13:50:17+02:00 Add -XLazyFieldAnnotations Unbundle the prefix `~` lazy field annotation syntax from StrictData. The new LazyFieldAnnotations extension controls only whether `~` is accepted on data and GADT constructor fields; StrictData (and hence Strict) implies it but continues to own the default strictness of unannotated fields. This lets hand-written and generated code write an explicit lazy annotation without flipping the module-wide default. The validity check in checkValidDataCon now keys off LazyFieldAnnotations instead of StrictData. Implements GHC proposal 752 (https://github.com/ghc-proposals/ghc-proposals/pull/752) Closes #24455. Co-Authored-By: Claude Opus 4.8 <noreply(a)anthropic.com> - - - - - 16 changed files: - compiler/GHC/Driver/Flags.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/TyCl.hs - + docs/users_guide/changelog.d/lazy-field-annotations - docs/users_guide/exts/strict.rst - libraries/ghc-internal/src/GHC/Internal/LanguageExtensions.hs - + testsuite/tests/deSugar/should_run/LazyFieldAnnotationsSemantics.hs - + testsuite/tests/deSugar/should_run/LazyFieldAnnotationsSemantics.stdout - testsuite/tests/deSugar/should_run/all.T - + testsuite/tests/typecheck/should_compile/LazyFieldAnnotations.hs - testsuite/tests/typecheck/should_compile/all.T - testsuite/tests/typecheck/should_fail/LazyFieldsDisabled.stderr - + testsuite/tests/typecheck/should_fail/LazyFieldsDisabledStrictData.hs - + testsuite/tests/typecheck/should_fail/LazyFieldsDisabledStrictData.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -261,6 +261,7 @@ extensionName = \case LangExt.ExplicitLevelImports -> "ExplicitLevelImports" LangExt.ImplicitStagePersistence -> "ImplicitStagePersistence" LangExt.QualifiedStrings -> "QualifiedStrings" + LangExt.LazyFieldAnnotations -> "LazyFieldAnnotations" -- | Is this extension known by any other names? For example -- -XGeneralizedNewtypeDeriving is accepted @@ -343,6 +344,7 @@ impliedXFlags , (LangExt.TemplateHaskell, On LangExt.TemplateHaskellQuotes) , (LangExt.Strict, On LangExt.StrictData) + , (LangExt.StrictData, On LangExt.LazyFieldAnnotations) -- Historically only UnboxedTuples was required for unboxed sums to work. -- To avoid breaking code, we make UnboxedTuples imply UnboxedSums. ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -3231,7 +3231,7 @@ instance Diagnostic TcRnMessage where TcRnHasFieldResolvedIncomplete{} -> noHints TcRnBadFieldAnnotation _ _ LazyFieldsDisabled - -> [suggestExtension LangExt.StrictData] + -> [suggestExtension LangExt.LazyFieldAnnotations] TcRnBadFieldAnnotation{} -> noHints TcRnSuperclassCycle{} ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -6355,7 +6355,7 @@ data PatSynInvalidRhsReason data BadFieldAnnotationReason where {-| A lazy data type field annotation (~) was used without enabling the - extension StrictData. + extension LazyFieldAnnotations. Test cases: LazyFieldsDisabled ===================================== compiler/GHC/Tc/TyCl.hs ===================================== @@ -5186,7 +5186,7 @@ checkValidDataCon dflags existential_ok tc con ; let check_bang :: Type -> HsSrcBang -> HsImplBang -> Int -> TcM () check_bang orig_arg_ty bang rep_bang n | HsSrcBang _ _ SrcLazy <- bang - , not (bang_opt_strict_data bang_opts) + , not (xopt LangExt.LazyFieldAnnotations dflags) = addErrTc (bad_bang n LazyFieldsDisabled) -- Warn about UNPACK without "!" ===================================== docs/users_guide/changelog.d/lazy-field-annotations ===================================== @@ -0,0 +1,12 @@ +section: language +synopsis: Add the `LazyFieldAnnotations` extension +issues: #24455 +mrs: !16246 + +description: { + The new :extension:`LazyFieldAnnotations` extension permits the prefix + ``~`` lazy field annotation on data and GADT constructor fields without + enabling :extension:`StrictData`. :extension:`StrictData` (and therefore + :extension:`Strict`) now implies :extension:`LazyFieldAnnotations` and + continues to control the default strictness of unannotated fields. +} ===================================== docs/users_guide/exts/strict.rst ===================================== @@ -155,6 +155,44 @@ Note the following points: for more discussion and examples. +.. _lazy-field-annotations: + +Lazy field annotations +---------------------- + +.. extension:: LazyFieldAnnotations + :shortdesc: Allow the prefix ``~`` lazy field annotation on constructor fields. + + :since: 10.2.1 + + Allow the prefix ``~`` lazy field annotation on data and GADT constructor + fields. + +``LazyFieldAnnotations`` allows a prefix ``~`` lazy annotation in every +constructor-field position where a prefix ``!`` strict annotation is accepted: +Haskell-98 prefix and record fields, and GADT argument types and record +fields. :: + + {-# LANGUAGE LazyFieldAnnotations #-} + + data A = A ~Int Bool + data B = B { b1 :: ~Int, b2 :: !Bool } + + data C where + C1 :: ~Int -> C + C2 :: { c1 :: ~Int, c2 :: !Bool } -> C + +A field annotated with ``~`` is lazy: it is not forced when the constructor is +built, but held as a thunk — the same behaviour as an unannotated field. + +The ``~`` annotation must be written in prefix form:: + + data T = MkT ~Int -- valid + data T = MkT ~ Int -- invalid + +See `GHC Proposal #229 <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0229-w…>`__ +for the precise rules. + .. _strict-data: Strict-by-default data types @@ -163,6 +201,8 @@ Strict-by-default data types .. extension:: StrictData :shortdesc: Treat datatype fields as strict by default. + :implies: :extension:`LazyFieldAnnotations` + :since: 8.0.1 Make fields of data types defined in the current module strict by default. @@ -183,13 +223,8 @@ we interpret it as if they had written :: The extension only affects definitions in this module. -The ``~`` annotation must be written in prefix form:: - - data T = MkT ~Int -- valid - data T = MkT ~ Int -- invalid - -See `GHC Proposal #229 <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0229-w…>`__ -for the precise rules. +The ``~`` lazy field annotation is provided by :extension:`LazyFieldAnnotations` +(which ``StrictData`` implies); see :ref:`lazy-field-annotations`. .. _strict: ===================================== libraries/ghc-internal/src/GHC/Internal/LanguageExtensions.hs ===================================== @@ -169,6 +169,7 @@ data Extension | ExplicitLevelImports | ImplicitStagePersistence | QualifiedStrings + | LazyFieldAnnotations deriving (Eq, Enum, Show, Generic, Bounded) -- 'Ord' and 'Bounded' are provided for GHC API users (see discussions -- in https://gitlab.haskell.org/ghc/ghc/merge_requests/2707 and ===================================== testsuite/tests/deSugar/should_run/LazyFieldAnnotationsSemantics.hs ===================================== @@ -0,0 +1,24 @@ +{-# LANGUAGE LazyFieldAnnotations #-} + +-- | LazyFieldAnnotations does not change the default strictness of fields. +-- Without StrictData an unannotated field stays lazy and a ~ field is lazy +-- too; a ! field is still strict. +module Main where + +import Control.Exception (try, evaluate, SomeException) + +data T = Plain Int -- unannotated: lazy + | Lazy ~Int -- explicit ~: lazy + | Strict !Int -- explicit !: strict + +-- | Does building the constructor force the field? +forcesField :: T -> IO Bool +forcesField x = do + r <- try (evaluate x) :: IO (Either SomeException T) + pure (either (const True) (const False) r) + +main :: IO () +main = do + print =<< forcesField (Plain undefined) -- False: lazy + print =<< forcesField (Lazy undefined) -- False: lazy + print =<< forcesField (Strict undefined) -- True: strict ===================================== testsuite/tests/deSugar/should_run/LazyFieldAnnotationsSemantics.stdout ===================================== @@ -0,0 +1,3 @@ +False +False +True ===================================== testsuite/tests/deSugar/should_run/all.T ===================================== @@ -76,3 +76,5 @@ test('T19680A', normal, compile_and_run, ['']) test('T20024', exit_code(1), compile_and_run, ['']) test('Or5', exit_code(1), compile_and_run, ['']) + +test('LazyFieldAnnotationsSemantics', normal, compile_and_run, ['']) ===================================== testsuite/tests/typecheck/should_compile/LazyFieldAnnotations.hs ===================================== @@ -0,0 +1,15 @@ +{-# LANGUAGE LazyFieldAnnotations #-} +{-# LANGUAGE GADTs #-} + +-- | LazyFieldAnnotations alone accepts the prefix ~ annotation in every +-- constructor-field position, without enabling StrictData. +module LazyFieldAnnotations where + +-- Haskell-98 prefix and record fields +data A = A ~Int Bool +data B = B { b1 :: ~Int, b2 :: !Bool } + +-- GADT argument types and record fields +data C where + C1 :: ~Int -> C + C2 :: { c1 :: ~Int, c2 :: !Bool } -> C ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -967,4 +967,5 @@ test('T26805a', normal, compile, ['']) test('T24464', normal, compile, ['']) test('ExpansionQLIm', normal, compile, ['']) test('T23135', normal, compile, ['']) +test('LazyFieldAnnotations', normal, compile, ['']) ===================================== testsuite/tests/typecheck/should_fail/LazyFieldsDisabled.stderr ===================================== @@ -1,8 +1,8 @@ - LazyFieldsDisabled.hs:3:10: error: [GHC-81601] • Lazy field annotations (~) are disabled on the first argument of ‘A’ • In the definition of data constructor ‘A’ In the data type declaration for ‘A’ Suggested fix: - Perhaps you intended to use the ‘StrictData’ extension (implied by ‘Strict’) + Perhaps you intended to use the ‘LazyFieldAnnotations’ extension (implied by ‘StrictData’) + ===================================== testsuite/tests/typecheck/should_fail/LazyFieldsDisabledStrictData.hs ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE StrictData #-} +{-# LANGUAGE NoLazyFieldAnnotations #-} + +-- | A later NoLazyFieldAnnotations overrides the implication from StrictData, +-- so ~ is rejected even though unannotated fields remain strict. +module LazyFieldsDisabledStrictData where + +data A = A ~Int ===================================== testsuite/tests/typecheck/should_fail/LazyFieldsDisabledStrictData.stderr ===================================== @@ -0,0 +1,8 @@ +LazyFieldsDisabledStrictData.hs:8:10: error: [GHC-81601] + • Lazy field annotations (~) are disabled + on the first argument of ‘A’ + • In the definition of data constructor ‘A’ + In the data type declaration for ‘A’ + Suggested fix: + Perhaps you intended to use the ‘LazyFieldAnnotations’ extension (implied by ‘StrictData’) + ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -690,6 +690,7 @@ test('T21444', normal, compile_fail, ['']) test('T23308', normal, compile_fail, ['']) test('MultiAssocDefaults', normal, compile_fail, ['']) test('LazyFieldsDisabled', normal, compile_fail, ['']) +test('LazyFieldsDisabledStrictData', normal, compile_fail, ['']) test('TyfamsDisabled', normal, compile_fail, ['']) test('CommonFieldResultTypeMismatch', normal, compile_fail, ['']) test('CommonFieldTypeMismatch', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/46d5c55a017907ad9e62c5e9dc90e4e… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/46d5c55a017907ad9e62c5e9dc90e4e… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/sjakobi/lazy-field-anns] 20 commits: Desugar a `case` scrutinee only once (#27383, #20251)
by Simon Jakobi (＠sjakobi2) 24 Jun '26

24 Jun '26

Simon Jakobi pushed to branch wip/sjakobi/lazy-field-anns at Glasgow Haskell Compiler / GHC Commits: 67d41299 by Sebastian Graf at 2026-06-18T05:18:24-04:00 Desugar a `case` scrutinee only once (#27383, #20251) In `dsExpr` for `HsCase` we desugared the scrutinee /twice/: once to build the Core `case` itself, and again inside `matchWrapper`, which re-desugared the source scrutinee (via `addHsScrutTmCs`) purely to record long-distance information for the pattern-match checker. For a single `case` that is merely wasteful. But for nested cases it is catastrophic. Consider case (case (case e of ... ) of ... ) of ... Desugaring the outer scrutinee desugars the middle `case` twice, each of which desugars the inner `case` twice, and so on. The work doubles at every level, so desugaring takes O(2^n) time in the nesting depth. That is the blowup reported in #27383; it is also what makes the machine-generated program in #20251 take an age to compile. The fix is simple. `matchWrapper` is handed the scrutinee anyway, so we give it the Core expression we have /already/ desugared, and record the long-distance term constraint with `addCoreScrutTmCs` instead of re-desugaring from source. This is just what `matchSinglePatVar` already does for single-pattern matches. So: * `matchWrapper` now takes `Maybe [CoreExpr]` rather than `Maybe [LHsExpr GhcTc]`. * The `HsCase` equation of `dsExpr` passes the already-desugared `core_discrim`; the arrow desugarer passes its match variables. * `addHsScrutTmCs` had no other use, so it is gone. Desugaring is now linear in the nesting depth. (The coverage checker still runs `simpleOptExpr` over each scrutinee, which leaves the total at O(n^2); that is ample.) The long-distance information itself is unchanged: the checker sees precisely the Core that backs the generated code. Test: deSugar/should_compile/T27383 - - - - - fa5defde by Rodrigo Mesquita at 2026-06-18T05:19:11-04:00 fix: Save FastStrings in the PMC There is no point in adding the unique to the occurrence FastString we create, since it is part of the Id anyway. Adding it to the FastString, meant each FastString was unique unnecessarily! In a separate branch, running the compiler on test `InstanceMatching` observed 30000 `FastString`s created by this code path. Plus, `fsLit "pm"` follows the existing pattern in `mkPmId`. - - - - - 4efb4a66 by Alan Zimmerman at 2026-06-18T14:41:14-04:00 TTG: Add extension points to HsConDetails Extend HsConDetails as data HsConDetails p arg rec = PrefixCon !(XPrefixCon p) [arg] -- C @t1 @t2 p1 p2 p3 | RecCon !(XRecCon p) rec -- C { x = p1, y = p2 } | InfixCon !(XInfixCon p) arg arg -- p1 `C` p2 | XHsConDetails !(XXHsConDetails p) type family XPrefixCon p type family XRecCon p type family XInfixCon p type family XXHsConDetails p - - - - - c8d27dd4 by Simon Jakobi at 2026-06-18T14:41:59-04:00 CI: quiet submodule clean output in after_script and setup The clean and cleanup_submodules functions ran 'git submodule foreach git clean -xdf', flooding the job log with 'Entering ...' and 'Removing ...' lines. Pass --quiet to 'git submodule' and -q to 'git clean' to drop the success output; errors are still reported. Co-Authored-By: Claude Opus 4.8 <noreply(a)anthropic.com> - - - - - 09326ca6 by Matthew Pickering at 2026-06-20T23:41:12+02:00 Add missing req_interp modifier to T18441fail3 and T18441fail19 These tests require the interpreter but they were failing in a different way with the javascript backend because the interpreter was disabled and stderr is ignored by the test. - - - - - 521e55bf by Matthew Pickering at 2026-06-20T23:41:13+02:00 hadrian: Fill in more of the default.host toolchain file When you are building a cross compiler this file will be used to build stage1 and it's libraries, so we need enough information here to work accurately. There is still more work to be done (see for example, word size is still fixed). - - - - - 23c9b6c3 by Matthew Pickering at 2026-06-20T23:42:52+02:00 hadrian: Build stage 2 cross compilers * Most of hadrian is abstracted over the stage in order to remove the assumption that the target of all stages is the same platform. This allows the RTS to be built for two different targets for example. * Abstracts the bindist creation logic to allow building either normal or cross bindists. Normal bindists use stage 1 libraries and a stage 2 compiler. Cross bindists use stage 2 libararies and a stage 2 compiler. * 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 New hadrian target: * `binary-dist-dir-cross`: Build a cross compiler bindist (compiler = stage 1, libraries = stage 2) This commit also contains various changes to make stage2 compilers feasible. ------------------------- Metric Decrease: LinkableUsage02 ManyAlternatives ManyConstructors MultiComponentModulesRecomp MultiLayerModulesRecomp RecordUpdPerf T10421 T12150 T12227 T12425 T12707 T13035 T13379 T13820 T15703 T16577 T18140 T18282 T18698a T18698b T18923 T1969 T20049 T21839c T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T6048 T783 T9020 T9198 T9233 T9630 T9872d T9961 parsing001 T3064 Metric Increase: T26989 hard_hole_fits ------------------------- Co-authored-by: Sven Tennie <sven.tennie(a)gmail.com> - - - - - 26fed8ab by Matthew Pickering at 2026-06-20T23:42:52+02:00 ci: Test cross bindists We remove the special logic for testing in-tree cross compilers and instead test cross compiler bindists, like we do for all other platforms. - - - - - 80c8910e by Matthew Pickering at 2026-06-20T23:42:52+02:00 ci: Introduce CROSS_STAGE variable In preparation for building and testing stage3 bindists we introduce the CROSS_STAGE variable which is used by a CI job to determine what kind of bindist the CI job should produce. At the moment we are only using CROSS_STAGE=2 but in the future we will have some jobs which set CROSS_STAGE=3 to produce native bindists for a target, but produced by a cross compiler, which can be tested on by another CI job on the native platform. CROSS_STAGE=2: Build a normal cross compiler bindist CROSS_STAGE=3: Build a stage 3 bindist, one which is a native compiler and library for the target - - - - - 8215573d by Sven Tennie at 2026-06-20T23:42:52+02:00 ci: Increase timeout for emulators Test runs with emulators naturally take longer than on native machines. Generate jobs.yml - - - - - 5acb7dbc by Matthew Pickering at 2026-06-20T23:42:52+02:00 ci: Javascript don't set CROSS_EMULATOR There is no CROSS_EMULATOR needed to run javascript binaries, so we don't set the CROSS_EMULATOR to some dummy value. - - - - - 48345343 by Sven Tennie at 2026-06-20T23:42:52+02:00 Javascript skip T23697 See #22355 about how HSC2HS and the Javascript target don't play well together. - - - - - 5e44fd05 by Sven Tennie at 2026-06-20T23:42:52+02:00 Mark T24602 as fragile It was skipped before (due to CROSS_EMULATOR being set, which changed for JS), so we don't make things worse by marking it as fragile. - - - - - ab349ec2 by Sven Tennie at 2026-06-20T23:42:52+02:00 Fix T22744 for GHCJS In fact, this test needs Template Haskell, not necessarily an interpreter. - - - - - c73352d8 by Sven Tennie at 2026-06-20T23:42:52+02:00 haddock-test: fix GHCJS haddock test failures Add --ghc-pkg-path flag support so haddock test runner can find cross-prefixed ghc-pkg (e.g. javascript-unknown-ghcjs-ghc-pkg) which is not on $PATH in cross install directories. Skip haddockHtmlTest on GHCJS: Threaded.hs uses forkOS in a TH splice, which GHCJS RTS doesn't support. Mark with js_skip in all.T. - - - - - 5e814e76 by Andreas Klebinger at 2026-06-22T23:00:24-04:00 compiler: Deduplicate hscTidy This function was accidentally duplicated during a refactor. Fixes #27351 - - - - - 473b97eb by sheaf at 2026-06-22T23:01:22-04:00 Avoid mkTick in Core Prep breaking ANF (part II) Hotfix for 2f9579765f55b3920ceb2e04995ff41a9d0e2d4e fixing a small oversight in the call to tickTickedExpr from mkTick, in which we improperly recursively called mkTick without passing on the preserve_anf flag. Fixes #27386 - - - - - 9284a1f7 by Simon Hengel at 2026-06-23T05:55:33-04:00 Don't use global variables to address concurrency bugs! (fixes #27234) This was originally introduce with 88f38b03025386f0f1e8f5861eed67d80495168a to address #17922. In this specific case a better fix would have been to synchronize on stderr: withHandle_ "stderrSupportsAnsiColors" stderr $ \ _ -> do ... But apparently the dependency on `terminfo` was removed in 32ab07bf3d6ce45e8ea5b55e8095174a6b42a7f0, preventing #17922 in the first place. - - - - - 44309cd3 by Alan Zimmerman at 2026-06-23T05:56:20-04:00 EPA: remove LocatedL / SrcSpanAnnL and LocatedLI / SrcSpanAnnLI This is part of a refactor towards only having LocatedA / SrcSpanAnnA It removes the stated items, but has to add back one for BooleanFormula, LocatedBF / SrcSpanAnnBF This commit also use the HsConDetails RecCon extension point to capture the braces in a record constructor - - - - - dc63db45 by Simon Jakobi at 2026-06-24T13:40:25+02:00 Add -XLazyFieldAnnotations Unbundle the prefix `~` lazy field annotation syntax from StrictData. The new LazyFieldAnnotations extension controls only whether `~` is accepted on data and GADT constructor fields; StrictData (and hence Strict) implies it but continues to own the default strictness of unannotated fields. This lets hand-written and generated code write an explicit lazy annotation without flipping the module-wide default. The validity check in checkValidDataCon now keys off LazyFieldAnnotations instead of StrictData. Implements ghc-proposals #752. Closes #24455. Co-Authored-By: Claude Opus 4.8 <noreply(a)anthropic.com> - - - - - 184 changed files: - .gitlab/ci.sh - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - + changelog.d/T27386 - + changelog.d/fix-exponential-case-desugar-27383 - + changelog.d/stage2-cross-compilers - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Data/BooleanFormula.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main/Interactive.hs - compiler/GHC/Driver/Main/Passes.hs - compiler/GHC/Driver/Main/Passes.hs-boot - compiler/GHC/Hs.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Dump.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Stats.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match.hs-boot - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Parser/PostProcess/Haddock.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/SysTools/Terminal.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/Backpack.hs - compiler/GHC/Tc/Zonk/Type.hs - compiler/GHC/ThToHs.hs - compiler/Language/Haskell/Syntax.hs - compiler/Language/Haskell/Syntax/Binds.hs - compiler/Language/Haskell/Syntax/Decls.hs - compiler/Language/Haskell/Syntax/ImpExp.hs - compiler/Language/Haskell/Syntax/Pat.hs - compiler/Language/Haskell/Syntax/Type.hs - configure.ac - distrib/configure.ac.in - + docs/users_guide/changelog.d/lazy-field-annotations - docs/users_guide/exts/strict.rst - ghc/GHCi/UI.hs - hadrian/README.md - hadrian/bindist/config.mk.in - hadrian/cfg/default.host.target.in - + hadrian/cfg/system.config.host.in - hadrian/cfg/system.config.in - + hadrian/cfg/system.config.target.in - hadrian/hadrian.cabal - hadrian/src/Base.hs - + hadrian/src/BindistConfig.hs - hadrian/src/Builder.hs - hadrian/src/Context.hs - hadrian/src/Expression.hs - hadrian/src/Flavour.hs - hadrian/src/Flavour/Type.hs - hadrian/src/Hadrian/Builder.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Hadrian/Oracles/TextFile.hs - hadrian/src/Main.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Flavour.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Oracles/TestSettings.hs - hadrian/src/Packages.hs - hadrian/src/Rules.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/CabalReinstall.hs - hadrian/src/Rules/Changelog.hs - hadrian/src/Rules/Compile.hs - hadrian/src/Rules/Documentation.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Gmp.hs - hadrian/src/Rules/Library.hs - hadrian/src/Rules/Program.hs - hadrian/src/Rules/Register.hs - hadrian/src/Rules/Rts.hs - hadrian/src/Rules/Test.hs - hadrian/src/Settings.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/Common.hs - hadrian/src/Settings/Builders/Configure.hs - hadrian/src/Settings/Builders/DeriveConstants.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Builders/Hsc2Hs.hs - hadrian/src/Settings/Builders/RunTest.hs - hadrian/src/Settings/Builders/SplitSections.hs - hadrian/src/Settings/Default.hs - hadrian/src/Settings/Flavours/GhcInGhci.hs - hadrian/src/Settings/Flavours/Performance.hs - hadrian/src/Settings/Flavours/QuickCross.hs - hadrian/src/Settings/Packages.hs - hadrian/src/Settings/Program.hs - hadrian/src/Settings/Warnings.hs - libraries/base/tests/all.T - libraries/ghc-internal/src/GHC/Internal/LanguageExtensions.hs - m4/fp_find_nm.m4 - m4/prep_target_file.m4 - testsuite/ghc-config/ghc-config.hs - + testsuite/tests/deSugar/should_compile/T27383.hs - testsuite/tests/deSugar/should_compile/all.T - + testsuite/tests/deSugar/should_run/LazyFieldAnnotationsSemantics.hs - + testsuite/tests/deSugar/should_run/LazyFieldAnnotationsSemantics.stdout - testsuite/tests/deSugar/should_run/all.T - testsuite/tests/ghc-api/exactprint/T22919.stderr - testsuite/tests/ghc-api/exactprint/Test20239.stderr - testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr - testsuite/tests/ghc-e/should_fail/all.T - testsuite/tests/haddock/haddock_testsuite/Makefile - testsuite/tests/haddock/haddock_testsuite/all.T - testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr - testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr - testsuite/tests/haddock/should_compile_flag_haddock/T24221.stderr - testsuite/tests/javascript/closure/all.T - testsuite/tests/module/mod185.stderr - testsuite/tests/parser/should_compile/DumpParsedAst.stderr - testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr - testsuite/tests/parser/should_compile/DumpRenamedAst.stderr - testsuite/tests/parser/should_compile/DumpSemis.stderr - testsuite/tests/parser/should_compile/KindSigs.stderr - testsuite/tests/parser/should_compile/T14189.stderr - testsuite/tests/parser/should_compile/T15323.stderr - testsuite/tests/parser/should_compile/T20452.stderr - testsuite/tests/parser/should_compile/T20718.stderr - testsuite/tests/parser/should_compile/T20718b.stderr - testsuite/tests/parser/should_compile/T20846.stderr - testsuite/tests/parser/should_compile/T23315/T23315.stderr - testsuite/tests/perf/compiler/all.T - testsuite/tests/printer/AnnotationNoListTuplePuns.stdout - testsuite/tests/printer/T18791.stderr - testsuite/tests/printer/Test10309.hs - testsuite/tests/printer/Test20297.stdout - testsuite/tests/printer/Test24533.stdout - + testsuite/tests/profiling/should_compile/T27386.hs - testsuite/tests/profiling/should_compile/all.T - + testsuite/tests/typecheck/should_compile/LazyFieldAnnotations.hs - testsuite/tests/typecheck/should_compile/all.T - testsuite/tests/typecheck/should_fail/LazyFieldsDisabled.stderr - + testsuite/tests/typecheck/should_fail/LazyFieldsDisabledStrictData.hs - + testsuite/tests/typecheck/should_fail/LazyFieldsDisabledStrictData.stderr - testsuite/tests/typecheck/should_fail/all.T - utils/check-exact/ExactPrint.hs - utils/check-exact/Main.hs - utils/check-exact/Utils.hs - utils/haddock/haddock-api/src/Haddock/Backends/Hoogle.hs - utils/haddock/haddock-api/src/Haddock/Backends/LaTeX.hs - utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs - utils/haddock/haddock-api/src/Haddock/Convert.hs - utils/haddock/haddock-api/src/Haddock/GhcUtils.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 - utils/haddock/haddock-test/src/Test/Haddock/Config.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5bf8e92af16f5cb675594a4cf26afa… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5bf8e92af16f5cb675594a4cf26afa… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/romes/27401-2] perf: Share Module in Iface Symbol Table
by Rodrigo Mesquita (＠alt-romes) 24 Jun '26

24 Jun '26

Rodrigo Mesquita pushed to branch wip/romes/27401-2 at Glasgow Haskell Compiler / GHC Commits: 36e7c182 by Rodrigo Mesquita at 2026-06-24T12:02:57+01:00 perf: Share Module in Iface Symbol Table This commit modifies the structure of the serialized `SymbolTable Name` to then re-use and share the `Module` (both on disk and in memory) across all `Name`s from the same module. The new structure looks like: <total name count> $modules.size for (mod, names) in $modules: $mod $names.size for table_ix, occ in $names $table_ix $occ i.e. we put the module just once, followed by all names in that module. When deserializing, we deserialize the module just once, and all the following `Name`s are constructed with a pointer to that same decoded `Module`. In `hoogle-test`, we must use `DNameEnv` rather than `Map Name`, otherwise the output fixities order was susceptible to changes in the uniques assigned to each Names, which is not stable. Fixes #27401 ------------------------- Metric Decrease: InstanceMatching LinkableUsage01 ------------------------- - - - - - 12 changed files: - compiler/GHC/Iface/Binary.hs - compiler/GHC/Unit/Module/Env.hs - testsuite/tests/overloadedrecflds/should_compile/DRFPatSynExport.stdout - testsuite/tests/rename/should_compile/T1792_imports.stdout - testsuite/tests/rename/should_compile/T18264.stdout - testsuite/tests/rename/should_compile/T4239.stdout - testsuite/tests/showIface/DocsInHiFile1.stdout - testsuite/tests/showIface/DocsInHiFileTH.stdout - testsuite/tests/showIface/NoExportList.stdout - testsuite/tests/typecheck/should_compile/subsumption_sort_hole_fits.stderr - utils/haddock/haddock-api/src/Haddock/Interface/AttachInstances.hs - utils/haddock/haddock-api/src/Haddock/InterfaceFile.hs Changes: ===================================== compiler/GHC/Iface/Binary.hs ===================================== @@ -37,7 +37,6 @@ import GHC.Unit import GHC.Unit.Module.ModIface import GHC.Types.Name import GHC.Platform.Profile -import GHC.Types.Unique.FM import GHC.Utils.Panic import GHC.Utils.Binary as Binary import GHC.Data.FastMutInt @@ -61,7 +60,8 @@ import System.IO.Unsafe import Data.Typeable (Typeable) import qualified GHC.Data.Strict as Strict import Data.Function ((&)) - +import GHC.Types.Name.Env +import Data.Maybe -- --------------------------------------------------------------------------- -- Reading and writing binary interface files @@ -618,25 +618,27 @@ initNameReaderTable cache = do } data BinSymbolTable = BinSymbolTable { - bin_symtab_next :: !FastMutInt, -- The next index to use - bin_symtab_map :: !(IORef (UniqFM Name (Int,Name))) - -- indexed by Name + bin_symtab_next :: !FastMutInt, + -- ^ The next index to use + bin_symtab_map :: !(IORef (NameEnv Int, ModuleEnv [(Int,Name)])) + -- ^ Deduplication indexed by Name + -- ; Group table data by module for serialization } initNameWriterTable :: IO (WriterTable, BinaryWriter Name) initNameWriterTable = do symtab_next <- newFastMutInt 0 - symtab_map <- newIORef emptyUFM + symtab_map <- newIORef (emptyNameEnv, emptyModuleEnv) let bin_symtab = BinSymbolTable { bin_symtab_next = symtab_next - , bin_symtab_map = symtab_map + , bin_symtab_map = symtab_map } let put_symtab bh = do name_count <- readFastMutInt symtab_next - symtab_map <- readIORef symtab_map - putSymbolTable bh name_count symtab_map + (_, symtab_tbl) <- readIORef symtab_map + putSymbolTable bh name_count symtab_tbl pure name_count return @@ -647,40 +649,53 @@ initNameWriterTable = do ) -putSymbolTable :: WriteBinHandle -> Int -> UniqFM Name (Int,Name) -> IO () +{- | +The symbol table payload will look like: + + <total name count> + $modules.size + for (mod, names) in $modules: + $mod + $names.size + for table_ix, occ in $names + $table_ix + $occ +-} +putSymbolTable :: WriteBinHandle -> Int -> ModuleEnv [(Int, Name)] -> IO () putSymbolTable bh name_count symtab = do put_ bh name_count - let names = elems (array (0,name_count-1) (nonDetEltsUFM symtab)) - -- It's OK to use nonDetEltsUFM here because the elements have - -- indices that array uses to create order - mapM_ (\n -> serialiseName bh n symtab) names - - + put_ bh (sizeModuleEnv symtab) + forM_ (moduleEnvToList symtab) $ \(mod,names) -> do + put_ bh mod + put_ bh (length names) + forM_ names $ \(table_ix, name) -> do + let occ = assertPpr (isExternalName name) (ppr name) (nameOccName name) + put_ bh table_ix + put_ bh occ + +-- | Decode the symbol table -- layout set by 'putSymbolTable'. getSymbolTable :: ReadBinHandle -> NameCache -> IO (SymbolTable Name) getSymbolTable bh name_cache = do sz <- get bh :: IO Int -- create an array of Names for the symbols and add them to the NameCache updateNameCache' name_cache $ \cache0 -> do - mut_arr <- newArray_ (0, sz-1) :: IO (IOArray Int Name) - cache <- foldGet' (fromIntegral sz) bh cache0 $ \i (uid, mod_name, occ) cache -> do - let mod = mkModule uid mod_name - case lookupOrigNameCache cache mod occ of - Just name -> do - writeArray mut_arr (fromIntegral i) name - return cache - Nothing -> do - uniq <- takeUniqFromNameCache name_cache - let name = mkExternalName uniq mod occ noSrcSpan - new_cache = extendOrigNameCache cache mod occ name - writeArray mut_arr (fromIntegral i) name - return new_cache - arr <- unsafeFreeze mut_arr - return (cache, arr) - -serialiseName :: WriteBinHandle -> Name -> UniqFM key (Int,Name) -> IO () -serialiseName bh name _ = do - let mod = assertPpr (isExternalName name) (ppr name) (nameModule name) - put_ bh (moduleUnit mod, moduleName mod, nameOccName name) + mut_arr <- newArray_ (0, sz-1) :: IO (IOArray Int Name) + mods_sz <- get bh :: IO Int + cache <- + foldGet' (fromIntegral mods_sz) bh cache0 $ \_mod_ix (mod,mod_nms_sz) cache1 -> do + foldGet' (fromIntegral (mod_nms_sz::Int)) bh cache1 $ \_mod_nms_ix (table_ix, occ) cache2 -> do + case lookupOrigNameCache cache2 mod occ of + Just name -> do + writeArray mut_arr table_ix name + return cache2 + Nothing -> do + uniq <- takeUniqFromNameCache name_cache + let name = mkExternalName uniq mod occ noSrcSpan + cache3 = extendOrigNameCache cache2 mod occ name + writeArray mut_arr table_ix name + return cache3 + arr <- unsafeFreeze mut_arr + return (cache, arr) -- Note [Symbol table representation of names] @@ -714,16 +729,26 @@ putName BinSymbolTable{ .|. (fromIntegral u :: Word32)) | otherwise - = do symtab_map <- readIORef symtab_map_ref - case lookupUFM symtab_map name of - Just (off,_) -> put_ bh (fromIntegral off :: Word32) + = do (symtab_map,symtab_tbl) <- readIORef symtab_map_ref + case lookupNameEnv symtab_map name of + Just off -> put_ bh (fromIntegral off :: Word32) Nothing -> do - off <- readFastMutInt symtab_next - -- massert (off < 2^(30 :: Int)) - writeFastMutInt symtab_next (off+1) - writeIORef symtab_map_ref - $! addToUFM symtab_map name (off,name) - put_ bh (fromIntegral off :: Word32) + off <- freshIndex + let mod = nameModule name + let mod_nms = fromMaybe [] (lookupModuleEnv symtab_tbl mod) + + let !symtab_map' = extendNameEnv symtab_map name off + let !symtab_tbl' = extendModuleEnv symtab_tbl mod ((off,name):mod_nms) + writeIORef symtab_map_ref $! ( symtab_map', symtab_tbl' ) + + put_ bh (fromIntegral off :: Word32) + where + freshIndex :: IO Int + freshIndex = do + off <- readFastMutInt symtab_next + -- massert (off < 2^(30 :: Int)) + writeFastMutInt symtab_next (off+1) + return off -- See Note [Symbol table representation of names] getSymtabName :: SymbolTable Name ===================================== compiler/GHC/Unit/Module/Env.hs ===================================== @@ -9,7 +9,7 @@ module GHC.Unit.Module.Env , alterModuleEnv , partitionModuleEnv , moduleEnvKeys, moduleEnvElts, moduleEnvToList - , unitModuleEnv, isEmptyModuleEnv + , unitModuleEnv, isEmptyModuleEnv, sizeModuleEnv , extendModuleEnvWith, filterModuleEnv, mapMaybeModuleEnv -- * ModuleName mappings @@ -176,6 +176,9 @@ unitModuleEnv m x = ModuleEnv (Map.singleton (NDModule m) x) isEmptyModuleEnv :: ModuleEnv a -> Bool isEmptyModuleEnv (ModuleEnv e) = Map.null e +sizeModuleEnv :: ModuleEnv a -> Int +sizeModuleEnv (ModuleEnv e) = Map.size e + -- | A set of 'Module's type ModuleSet = Set NDModule ===================================== testsuite/tests/overloadedrecflds/should_compile/DRFPatSynExport.stdout ===================================== @@ -1 +1 @@ -import DRFPatSynExport_A ( MkT, m ) +import DRFPatSynExport_A ( m, MkT ) ===================================== testsuite/tests/rename/should_compile/T1792_imports.stdout ===================================== @@ -1 +1 @@ -import qualified Data.ByteString as B ( putStr, readFile ) +import qualified Data.ByteString as B ( readFile, putStr ) ===================================== testsuite/tests/rename/should_compile/T18264.stdout ===================================== @@ -1,6 +1,6 @@ import Data.Char ( isDigit, isLetter ) import Data.List ( sortOn ) -import Data.Maybe ( fromJust, isJust ) +import Data.Maybe ( isJust, fromJust ) import qualified Data.Char as C ( isLetter, isDigit ) import qualified Data.List as S ( sort ) import qualified Data.List as T ( nub ) ===================================== testsuite/tests/rename/should_compile/T4239.stdout ===================================== @@ -1 +1 @@ -import T4239A ( (·), type (:+++)((:---), (:+++), X) ) +import T4239A ( type (:+++)((:---), (:+++), X), (·) ) ===================================== testsuite/tests/showIface/DocsInHiFile1.stdout ===================================== @@ -19,49 +19,53 @@ docs: export docs: [] declaration docs: - [elem -> [text: - -- | '()', 'elem'. - identifiers: - {DocsInHiFile.hs:14:13-16} - GHC.Internal.Data.Foldable.elem - {DocsInHiFile.hs:14:13-16} - elem], - D -> [text: - -- | A datatype. + [F -> [text: + -- | A type family identifiers:], - D0 -> [text: - -- ^ A constructor for 'D'. ' - identifiers: - {DocsInHiFile.hs:20:32} - D], - D1 -> [text: - -- ^ Another constructor + D:R:FInt -> [text: + -- | A type family instance + identifiers:], + D' -> [text: + -- | Another datatype... + identifiers:, + text: + -- ^ ...with two docstrings. identifiers:], - P -> [text: - -- | A class - identifiers:], - p -> [text: - -- | A class method - identifiers:], $fShowD -> [text: -- ^ 'Show' instance identifiers: {DocsInHiFile.hs:22:25-28} GHC.Internal.Show.Show], - D' -> [text: - -- | Another datatype... - identifiers:, - text: - -- ^ ...with two docstrings. + p -> [text: + -- | A class method + identifiers:], + P -> [text: + -- | A class + identifiers:], + D1 -> [text: + -- ^ Another constructor identifiers:], - D:R:FInt -> [text: - -- | A type family instance - identifiers:], - F -> [text: - -- | A type family - identifiers:]] + D0 -> [text: + -- ^ A constructor for 'D'. ' + identifiers: + {DocsInHiFile.hs:20:32} + D], + D -> [text: + -- | A datatype. + identifiers:], + elem -> [text: + -- | '()', 'elem'. + identifiers: + {DocsInHiFile.hs:14:13-16} + GHC.Internal.Data.Foldable.elem + {DocsInHiFile.hs:14:13-16} + elem]] arg docs: - [add -> 0: + [p -> 0: + text: + -- ^ An argument + identifiers:, + add -> 0: text: -- ^ First summand for 'add' identifiers: @@ -74,11 +78,7 @@ docs: 2: text: -- ^ Sum - identifiers:, - p -> 0: - text: - -- ^ An argument - identifiers:] + identifiers:] documentation structure: avails: [elem] ===================================== testsuite/tests/showIface/DocsInHiFileTH.stdout ===================================== @@ -6,137 +6,153 @@ docs: export docs: [] declaration docs: - [Tup2 -> [text: - -- |Matches a tuple of (a, a) - identifiers:], - f -> [text: - -- |The meaning of life - identifiers:], - g -> [text: - -- |Some documentation - identifiers:], - qux -> [text: - -- |This is qux + [D:R:WD13Foo -> [text: + -- |13 + identifiers:], + D:R:WD11Int0 -> [text: + -- |This is a data instance + identifiers:], + D:R:WD11Foo0 -> [text: + -- |11 + identifiers:], + D:R:WD11Bool0 -> [text: + -- |This is a newtype instance + identifiers:], + D:R:EBool -> [text: + -- |A type family instance + identifiers:], + $fF -> [text: + -- |14 identifiers:], - sin -> [text: - -- |15 + $fDka -> [text: + -- |Another new instance + identifiers:], + $fCTYPEList -> [text: + -- |Another new instance + identifiers:], + $fCTYPEInt -> [text: + -- |A new instance + identifiers:], + $fCTYPEFoo -> [text: + -- |7 + identifiers:], + WD6 -> [text: + -- |6 identifiers:], - wd1 -> [text: - -- |1 + WD5 -> [text: + -- |5 identifiers:], - wd17 -> [text: - -- |17 + WD4 -> [text: + -- |4 + identifiers:], + WD3 -> [text: + -- |3 + identifiers:], + WD12 -> [text: + -- |12 identifiers:], - wd18 -> [text: - -- |18 + WD11Int -> [text: + -- |This is a data instance constructor + identifiers:], + WD11Bool -> [text: + -- |This is a newtype instance constructor + identifiers:], + WD10 -> [text: + -- |10 identifiers:], - wd2 -> [text: - -- |2 - identifiers:], - wd20 -> [text: - -- |20 + quuz1_a -> [text: + -- |This is the record constructor's argument + identifiers:], + Quuz -> [text: + -- |This is a record constructor identifiers:], - wd8 -> [text: - -- |8 + Quux2 -> [text: + -- |This is Quux2 + identifiers:], + Quux1 -> [text: + -- |This is Quux1 + identifiers:], + Quux -> [text: + -- |This is Quux + identifiers:], + prettyPrint -> [text: + -- |Prettily prints the object + identifiers:], + Pretty -> [text: + -- |My cool class + identifiers:], + Foo -> [text: + -- |A new constructor identifiers:], - C -> [text: - -- |A new class + Foo -> [text: + -- |A new data type + identifiers:], + E -> [text: + -- |A type family identifiers:], - Corge -> [text: - -- |This is a newtype record constructor - identifiers:], runCorge -> [text: -- |This is the newtype record constructor's argument identifiers:], - E -> [text: - -- |A type family + Corge -> [text: + -- |This is a newtype record constructor + identifiers:], + C -> [text: + -- |A new class identifiers:], - Foo -> [text: - -- |A new data type - identifiers:], - Foo -> [text: - -- |A new constructor + wd8 -> [text: + -- |8 identifiers:], - Pretty -> [text: - -- |My cool class - identifiers:], - prettyPrint -> [text: - -- |Prettily prints the object - identifiers:], - Quux -> [text: - -- |This is Quux - identifiers:], - Quux1 -> [text: - -- |This is Quux1 - identifiers:], - Quux2 -> [text: - -- |This is Quux2 - identifiers:], - Quuz -> [text: - -- |This is a record constructor + wd20 -> [text: + -- |20 identifiers:], - quuz1_a -> [text: - -- |This is the record constructor's argument - identifiers:], - WD10 -> [text: - -- |10 + wd2 -> [text: + -- |2 + identifiers:], + wd18 -> [text: + -- |18 identifiers:], - WD11Bool -> [text: - -- |This is a newtype instance constructor - identifiers:], - WD11Int -> [text: - -- |This is a data instance constructor - identifiers:], - WD12 -> [text: - -- |12 + wd17 -> [text: + -- |17 identifiers:], - WD3 -> [text: - -- |3 - identifiers:], - WD4 -> [text: - -- |4 - identifiers:], - WD5 -> [text: - -- |5 + wd1 -> [text: + -- |1 identifiers:], - WD6 -> [text: - -- |6 + sin -> [text: + -- |15 identifiers:], - $fCTYPEFoo -> [text: - -- |7 - identifiers:], - $fCTYPEInt -> [text: - -- |A new instance - identifiers:], - $fCTYPEList -> [text: - -- |Another new instance - identifiers:], - $fDka -> [text: - -- |Another new instance - identifiers:], - $fF -> [text: - -- |14 + qux -> [text: + -- |This is qux identifiers:], - D:R:EBool -> [text: - -- |A type family instance - identifiers:], - D:R:WD11Bool0 -> [text: - -- |This is a newtype instance - identifiers:], - D:R:WD11Foo0 -> [text: - -- |11 - identifiers:], - D:R:WD11Int0 -> [text: - -- |This is a data instance - identifiers:], - D:R:WD13Foo -> [text: - -- |13 - identifiers:]] + g -> [text: + -- |Some documentation + identifiers:], + f -> [text: + -- |The meaning of life + identifiers:], + Tup2 -> [text: + -- |Matches a tuple of (a, a) + identifiers:]] arg docs: - [Tup2 -> 0: - text: - -- |The thing to match twice - identifiers:, + [WD11Int -> 0: + text: + -- |This is a data instance constructor argument + identifiers:, + WD11Bool -> 0: + text: + -- |This is a newtype instance constructor argument + identifiers:, + Quux2 -> 1: + text: + -- |I am a bool + identifiers:, + Quux1 -> 0: + text: + -- |I am an integer + identifiers:, + qux -> 1: + text: + -- |Arg dos + identifiers:, h -> 0: text: -- ^Your favourite number @@ -149,26 +165,10 @@ docs: text: -- ^A return value identifiers:, - qux -> 1: - text: - -- |Arg dos - identifiers:, - Quux1 -> 0: - text: - -- |I am an integer - identifiers:, - Quux2 -> 1: - text: - -- |I am a bool - identifiers:, - WD11Bool -> 0: - text: - -- |This is a newtype instance constructor argument - identifiers:, - WD11Int -> 0: - text: - -- |This is a data instance constructor argument - identifiers:] + Tup2 -> 0: + text: + -- |The thing to match twice + identifiers:] documentation structure: avails: [f] ===================================== testsuite/tests/showIface/NoExportList.stdout ===================================== @@ -6,7 +6,10 @@ docs: export docs: [] declaration docs: - [fα -> [text: + [$fEqR -> [text: + -- | A very lazy Eq instance + identifiers:], + fα -> [text: -- ^ Documentation for 'R'\'s 'fα' field. identifiers: {NoExportList.hs:14:38} @@ -14,10 +17,7 @@ docs: {NoExportList.hs:14:38} R {NoExportList.hs:14:45-46} - fα], - $fEqR -> [text: - -- | A very lazy Eq instance - identifiers:]] + fα]] arg docs: [] documentation structure: @@ -99,3 +99,4 @@ docs: ListTuplePuns ImplicitStagePersistence extensible fields: + ===================================== testsuite/tests/typecheck/should_compile/subsumption_sort_hole_fits.stderr ===================================== @@ -5,10 +5,10 @@ subsumption_sort_hole_fits.hs:2:5: warning: [GHC-88464] [-Wtyped-holes (in -Wdef • Relevant bindings include f :: [String] (bound at subsumption_sort_hole_fits.hs:2:1) Valid hole fits include - lines :: String -> [String] + words :: String -> [String] (imported from ‘Prelude’ (and originally defined in ‘GHC.Internal.Data.OldList’)) - words :: String -> [String] + lines :: String -> [String] (imported from ‘Prelude’ (and originally defined in ‘GHC.Internal.Data.OldList’)) repeat :: forall a. a -> [a] ===================================== utils/haddock/haddock-api/src/Haddock/Interface/AttachInstances.hs ===================================== @@ -251,10 +251,12 @@ attachToExportItem cls_index fam_index index expInfo getInstDoc getFixity getIns } where fixities :: [(Name, Fixity)] - !fixities = force . Map.toList $ List.foldl' f Map.empty all_names + -- Use DNameEnv to guarantee a deterministic output regardless of the + -- uniques assigned to each_name e.g. off of the interface file. + !fixities = force . eltsDNameEnv $ List.foldl' f emptyDNameEnv all_names - f :: Map.Map Name Fixity -> Name -> Map.Map Name Fixity - f !fs n = Map.alter (<|> getFixity n) n fs + f :: DNameEnv (Name, Fixity) -> Name -> DNameEnv (Name, Fixity) + f !fs n = alterDNameEnv (<|> ((,) n <$> getFixity n)) fs n patsyn_names :: [Name] patsyn_names = concatMap (getMainDeclBinder emptyOccEnv . fst) patsyns ===================================== utils/haddock/haddock-api/src/Haddock/InterfaceFile.hs ===================================== @@ -40,6 +40,7 @@ import Data.Coerce (coerce) import Data.Function ((&)) import Data.IORef import Data.Map (Map) +import Data.Maybe (fromMaybe) import Data.Version import Data.Word import GHC hiding (NoLink) @@ -50,7 +51,9 @@ import GHC.Iface.Type (IfaceType, putIfaceType) import GHC.Types.Name.Cache import GHC.Types.Unique import GHC.Types.Unique.FM +import GHC.Types.Name.Env import GHC.Unit.State +import GHC.Unit.Module.Env import GHC.Utils.Binary import Haddock.Types import Text.ParserCombinators.ReadP (readP_to_S) @@ -139,7 +142,7 @@ binaryInterfaceMagic = 0xD0Cface -- binaryInterfaceVersion :: Word16 #if MIN_VERSION_ghc(9,11,0) && !MIN_VERSION_ghc(10,2,0) -binaryInterfaceVersion = 46 +binaryInterfaceVersion = 47 binaryInterfaceVersionCompatibility :: [Word16] binaryInterfaceVersionCompatibility = [binaryInterfaceVersion] @@ -170,7 +173,7 @@ writeInterfaceFile filename iface = do -- Make some intial state symtab_next <- newFastMutInt 0 - symtab_map <- newIORef emptyUFM + symtab_map <- newIORef (emptyNameEnv, emptyModuleEnv) let bin_symtab = BinSymbolTable { bin_symtab_next = symtab_next @@ -210,8 +213,8 @@ writeInterfaceFile filename iface = do -- write the symbol table itself symtab_next' <- readFastMutInt symtab_next - symtab_map' <- readIORef symtab_map - putSymbolTable bh symtab_next' symtab_map' + (_, symtab_tbl') <- readIORef symtab_map + putSymbolTable bh symtab_next' symtab_tbl' -- write the dictionary pointer at the fornt of the file dict_p <- tellBinWriter bh @@ -268,20 +271,30 @@ putName bh name = do - symtab_map <- readIORef symtab_map_ref - case lookupUFM symtab_map name of - Just (off, _) -> put_ bh (fromIntegral off :: Word32) + (symtab_map, symtab_tbl) <- readIORef symtab_map_ref + case lookupNameEnv symtab_map name of + Just off -> put_ bh (fromIntegral off :: Word32) Nothing -> do - off <- readFastMutInt symtab_next - writeFastMutInt symtab_next (off + 1) - writeIORef symtab_map_ref $! - addToUFM symtab_map name (off, name) + off <- freshIndex + let mod' = nameModule name + let mod_nms = fromMaybe [] (lookupModuleEnv symtab_tbl mod') + + let !symtab_map' = extendNameEnv symtab_map name off + let !symtab_tbl' = extendModuleEnv symtab_tbl mod' ((off, name):mod_nms) + writeIORef symtab_map_ref $! (symtab_map', symtab_tbl') put_ bh (fromIntegral off :: Word32) + where + freshIndex :: IO Int + freshIndex = do + off <- readFastMutInt symtab_next + writeFastMutInt symtab_next (off + 1) + return off data BinSymbolTable = BinSymbolTable { bin_symtab_next :: !FastMutInt -- The next index to use - , bin_symtab_map :: !(IORef (UniqFM Name (Int, Name))) - -- indexed by Name + , bin_symtab_map :: !(IORef (NameEnv Int, ModuleEnv [(Int, Name)])) + -- ^ Deduplication indexed by Name + -- ; Group table data by module for serialization } putFastString :: BinDictionary -> WriteBinHandle -> FastString -> IO () View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/36e7c18255f450ff9bcc43906f330da… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/36e7c18255f450ff9bcc43906f330da… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/mangoiv/unused-type] compiler: rename ZonkAny to UnusedType and add pretty printing logic
by Magnus (＠MangoIV) 24 Jun '26

24 Jun '26

Magnus pushed to branch wip/mangoiv/unused-type at Glasgow Haskell Compiler / GHC Commits: 514044cb by mangoiv at 2026-06-24T12:17:01+02:00 compiler: rename ZonkAny to UnusedType and add pretty printing logic ZonkAny is a hard to understand name for users who do not know how the compiler works internally. Additionally, it is confusing that ZonkAny, while being a concrete type *represents* a meta variable, espeically in the compiler output. This patch changes the name of ZonkAny to UnusedType which is closer to its intended semantics and adds special pretty printing logic to display this type in the same fashion the compiler displays meta variables in other places, whenever they leak from the implementation to the user. It also exports the type from ghc-internal:GHC.Internal.Types in order to expose documentation. Fixes #27390 Co-Authored-By: Sam Derbyshire <sam.derbyshire(a)gmail.com> - - - - - 27 changed files: - + changelog.d/unused-type - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Zonk/Type.hs - libraries/base/src/GHC/Base.hs - libraries/base/src/GHC/Exts.hs - libraries/ghc-experimental/src/GHC/PrimOps.hs - libraries/ghc-internal/src/GHC/Internal/Types.hs - testsuite/tests/interface-stability/ghc-prim-exports.stdout - testsuite/tests/interface-stability/ghc-prim-exports.stdout-mingw32 - testsuite/tests/perf/compiler/T11068.stdout - testsuite/tests/pmcheck/should_compile/T12957.stderr - testsuite/tests/profiling/should_run/staticcallstack002.stdout - testsuite/tests/simplCore/should_compile/Makefile - testsuite/tests/simplCore/should_compile/T13156.stdout - testsuite/tests/simplCore/should_compile/T26615.stderr - testsuite/tests/typecheck/should_fail/T13292.stderr - + testsuite/tests/typecheck/should_fail/T27390-explicit-kinds.stderr - + testsuite/tests/typecheck/should_fail/T27390.hs - + testsuite/tests/typecheck/should_fail/T27390.stderr - + testsuite/tests/typecheck/should_fail/T27390a.hs - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== changelog.d/unused-type ===================================== @@ -0,0 +1,12 @@ +section: compiler +synopsis: Rename ZonkAny to UnusedType and add pretty printing logic for it. +issues: #27390 +mrs: !16212 + +description: { + After unification, GHC fills in unconstrained type variables such as ``alpha`` in + ``(length :: [alpha] -> Int) ([] :: List alpha) :: Int`` with a fixed type. + This type was, confusingly to the user, called ``ZonkAny``. + This type is now renamed ``UnusedType``, with special pretty-printing logic to make + it display like an ordinary metavariable. +} ===================================== compiler/GHC/Builtin/Names.hs ===================================== @@ -1904,8 +1904,8 @@ unsatisfiableClassNameKey = mkPreludeTyConUnique 170 anyTyConKey :: Unique anyTyConKey = mkPreludeTyConUnique 171 -zonkAnyTyConKey :: Unique -zonkAnyTyConKey = mkPreludeTyConUnique 172 +unusedTypeTyConKey :: Unique +unusedTypeTyConKey = mkPreludeTyConUnique 172 -- Custom user type-errors errorMessageTypeErrorFamKey :: Unique ===================================== compiler/GHC/Builtin/Types.hs ===================================== @@ -93,7 +93,7 @@ module GHC.Builtin.Types ( cTupleSelId, cTupleSelIdName, -- * Any - anyTyCon, anyTy, anyTypeOfKind, zonkAnyTyCon, + anyTyCon, anyTy, anyTypeOfKind, unusedTypeTyCon, -- * Recovery TyCon makeRecoveryTyCon, @@ -300,7 +300,7 @@ wiredInTyCons :: [TyCon] wiredInTyCons = map (dataConTyCon . snd) boxingDataCons ++ [ anyTyCon - , zonkAnyTyCon + , unusedTypeTyCon , boolTyCon , charTyCon , stringTyCon @@ -410,58 +410,89 @@ doubleDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "D#") -- Any {- -Note [Any types] -~~~~~~~~~~~~~~~~ -The type constructors `Any` and `ZonkAny` are closed type families declared thus: +Note [The types Any and UnusedType] +~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~ +The type constructors `Any` and `UnusedType` are closed type families declared as: - type family Any :: forall k. k where { } - type family ZonkAny :: forall k. Nat -> k where { } + type family Any :: forall k. k where { } + type family UnusedType :: forall k. Symbol -> k where { } They are used when we want a type of a particular kind, but we don't really care -what that type is. The leading example is this: `ZonkAny` is used to instantiate -un-constrained type variables after type checking. For example, consider the -term (length [] :: Int), where +what that type is. The leading example that is relevant for GHC itself is this: - length :: forall a. [a] -> Int - [] :: forall a. [a] + `UnusedType` is used to instantiate unconstrained type variables after type + checking. For example, consider the term (length [] :: Int), where -We must type-apply `length` and `[]`, but to what type? It doesn't matter! -The typechecker will end up with + length :: forall a. [a] -> Int + [] :: forall a. [a] - length @alpha ([] @alpha) + We must type-apply `length` and `[]`, but to what type? It doesn't matter! + The typechecker will end up with -where `alpha` is an un-constrained unification variable. The "zonking" process zaps -that unconstrained `alpha` to an arbitrary type (ZonkAny @Type 3), where the `3` is -arbitrary (see wrinkle (Any5) below). This is done in `GHC.Tc.Zonk.Type.commitFlexi`. -So we end up with + length @alpha ([] @alpha) - length @(ZonkAny @Type 3) ([] @(ZonkAny @Type 3)) + where `alpha` is an unconstrained unification variable. The "zonking" process + zaps that unconstrained `alpha` to an arbitrary type (UnusedType @Type "a_3"), + where the `3` is arbitrary (see wrinkle (Any3) below) and "a" is the name string + of the meta variable. This is done in `GHC.Tc.Zonk.Type.commitFlexi`. + So we end up with -`Any` and `ZonkAny` differ only in the presence of the `Nat` argument; see -wrinkle (Any4). + length @(UnusedType @Type "a_3") ([] @(UnusedType @Type "a_3")) -Wrinkles: +`Any` and `UnusedType` differ only in the presence of the `Symbol` argument; see (Any6). -(Any1) `Any` and `ZonkAny` are kind polymorphic since in some program we may - need to use `ZonkAny` to fill in a type variable of some kind other than * - (see #959 for examples). - -(Any2) They are /closed/ type families, with no instances. For example, suppose that +(Any1) They are /closed/ type families, with no instances. For example, suppose that with alpha :: '(k1, k2) we add a given coercion g :: alpha ~ (Fst alpha, Snd alpha) - and we zonked alpha = ZonkAny @(k1,k2) n. Then, if `ZonkAny` was a /data/ type, - we'd get inconsistency because we'd have a Given equality with `ZonkAny` on one + and we zonked alpha = UnusedType @(k1,k2) n. Then, if `UnusedType` was a /data/ type, + we'd get inconsistency because we'd have a Given equality with `UnusedType` on one side and '(,) on the other. See also #9097 and #9636. - See #25244 for a suggestion that we instead use an /open/ type family for which - you cannot provide instances. Probably the difference is not very important. + They are not /data/ types, and that's important for the code generator, + because the code gen may enter a data value. + + A closed type family with no equations behaves differently than an open type + family with no equations due to Note [Insoluble fundeps] IFD0 in + GHC.Tc.Solver.FunDeps, so it was argued in #25244 that perhaps 'Any' should + rather be an open type family for which new equations cannot be written. + +(Any2) `Any` and `UnusedType` are kind polymorphic since in some programs we may + need to use `UnusedType` to fill in a type variable of some kind other than Type + e.g. TYPE r for some r, or types of the form _ -> Type. + +(Any3) `Any` and `UnusedType` are wired-in so we can easily refer to them where we + don't have a name environment. + +(Any4) User facing aspects of the types Any and UnusedType: + + `Any` is defined in ghc-internal:GHC.Internal.Types, and exported. `Any` + is available to users because it is a useful type in userspace and is thus + re-exported from base:GHC.Exts. + + `UnusedType` is exported mainly for documentation in case a user stumbles over + it in debug output of GHC. + + The key property of 'Any' is that it is safe to coerce a type to 'Any' as long + as the representation is unchanged. That is, it is OK to use 'unsafeCoerce#' to + go from 'ty :: TYPE r' to 'Any :: TYPE r' and back. + This can be useful when e.g. implementing dependent maps or similar typed + container types, storing values of type `Any`. + +(Any5) Warnings about unused bindings of type `Any` and `UnusedType` are suppressed, + following the same rationale of supressing warning about the unit type. + + For example, consider (#25895): + + do { forever (return ()); blah } -(Any3) They do not claim to be /data/ types, and that's important for - the code generator, because the code gen may /enter/ a data value - but never enters a function value. + where forever :: forall a b. IO a -> IO b + Nothing constrains `b`, so it will be instantiated with `Any` or `UnusedType`. + But we certainly don't want to complain about a discarded do-binding. -(Any4) `ZonkAny` takes a `Nat` argument so that we can readily make up /distinct/ - types (#24817). Consider +(Any6) Wrinkle - Pattern match checking. + + The first reason why `UnusedType` takes a `Symbol` argument is that + we can readily make up /distinct/ types (#24817) for the Pmc. Consider data SBool a where { STrue :: SBool True; SFalse :: SBool False } @@ -475,53 +506,33 @@ Wrinkles: Now, what are `alpha` and `beta`? If we zonk both of them to the same type `Any @Type`, the pattern-match checker will (wrongly) report that the first branch is inaccessible. So we zonk them to two /different/ types: - alpha := ZonkAny @Type 4 and beta := ZonkAny @Type k 5 + alpha := UnusedType @Type "a_4" and beta := UnusedType @Type k "b_5" (The actual numbers are arbitrary; they just need to differ.) The unique-name generation comes from field `tcg_zany_n` of `TcGblEnv`; and - `GHC.Tc.Zonk.Type.commitFlexi` calls `GHC.Tc.Utils.Monad.newZonkAnyType` to + `GHC.Tc.Zonk.Type.commitFlexi` calls `GHC.Tc.Utils.Monad.newUnusedTypeType` to make up a fresh type. If this example seems unconvincing (e.g. in this case foo must be bottom) see #24817 for larger but more compelling examples. -(Any5) `Any` and `ZonkAny` are wired-in so we can easily refer to it where we - don't have a name environment (e.g. see Rules.matchRule for one example) - -(Any6) `Any` is defined in library module ghc-prim:GHC.Types, and exported so that - it is available to users. For this reason it's treated like any other - wired-in type: - - has a fixed unique, anyTyConKey, - - lives in the global name cache - Currently `ZonkAny` is not available to users; but it could easily be. +(Any7) Wrinkle - Error reporting. -(Any7) Properties of `Any`: - * When `Any` is instantiated at a lifted type it is inhabited by at least one value, - namely bottom. + There's a second reason why `UnusedType` takes a `Symbol` argument, which is that + we use it to neatly display zonked unfilled metavariables without leaking + implementation details of code generation. - * You can safely coerce any /lifted/ type to `Any` and back with `unsafeCoerce`. + `UnusedType` is handled specially in the pretty-printer to avoid confusing + compiler output. For example, `UnusedType "foo_3" :: Type` is displayed as `foo_3`. - * You can safely coerce any /unlifted/ type to `Any` and back with `unsafeCoerceUnlifted`. + That special handling is implemented in GHC.Iface.Type.pprTyTcApp and more + specifically ppr_iface_unused_ty_tycon. - * You can coerce /any/ type to `Any` and back with `unsafeCoerce#`, but it's only safe when - the kinds of both the type and `Any` match. + See testcase T27390 for an example of the pretty-printing in action. - * For lifted/unlifted types `unsafeCoerce[Unlifted]` should be preferred over - `unsafeCoerce#` as they prevent accidentally coercing between types with kinds - that don't match. - - See examples in ghc-prim:GHC.Types - -(Any8) Warning about unused bindings of type `Any` and `ZonkAny` are suppressed, - following the same rationale of supressing warning about the unit type. - - For example, consider (#25895): - - do { forever (return ()); blah } - - where forever :: forall a b. IO a -> IO b - Nothing constrains `b`, so it will be instantiates with `Any` or `ZonkAny`. - But we certainly don't want to complain about a discarded do-binding. + Historical note: in the past, `UnusedType` was called `ZonkAny` (or `Any` before that). + We renamed it to `UnusedType` and added this special treatment in the pretty-printer to avoid + confusing mentions of zonking. The Any tycon used to be quite magic, but we have since been able to implement it merely with an empty kind polymorphic type family. See #10886 for a @@ -534,7 +545,7 @@ anyTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Any") anyTyConKey anyTyCon anyTyCon :: TyCon --- See Note [Any types] +-- See Note [The types Any and UnusedType] anyTyCon = mkFamilyTyCon anyTyConName kind binders 0 res_kind Nothing (ClosedSynFamilyTyCon Nothing) Nothing @@ -550,22 +561,22 @@ anyTy = mkTyConTy anyTyCon anyTypeOfKind :: Kind -> Type anyTypeOfKind kind = mkTyConApp anyTyCon [kind] -zonkAnyTyConName :: Name -zonkAnyTyConName = - mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "ZonkAny") zonkAnyTyConKey zonkAnyTyCon +unusedTypeTyConName :: Name +unusedTypeTyConName = + mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "UnusedType") unusedTypeTyConKey unusedTypeTyCon -zonkAnyTyCon :: TyCon --- ZonkAnyTyCon :: forall k. Nat -> k --- See Note [Any types] -zonkAnyTyCon = mkFamilyTyCon zonkAnyTyConName kind bndrs 0 res_kind +unusedTypeTyCon :: TyCon +-- unusedTypeTyCon :: forall k. Symbol -> k +-- See Note [The types Any and UnusedType] +unusedTypeTyCon = mkFamilyTyCon unusedTypeTyConName kind bndrs 0 res_kind Nothing (ClosedSynFamilyTyCon Nothing) Nothing NotInjective where - [kv,nat_kv] = mkTemplateKindVars [liftedTypeKind, naturalTy] + [kv,sym_kv] = mkTemplateKindVars [liftedTypeKind, typeSymbolKind] bndrs = [ mkNamedTyConBinder Specified kv - , mkAnonTyConBinder nat_kv ] + , mkAnonTyConBinder sym_kv ] res_kind = mkTyVarTy kv kind = mkTyConKind bndrs res_kind ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -1281,11 +1281,11 @@ warnDiscardedDoBindings rhs@(L rhs_loc _) m_ty elt_ty do { fam_inst_envs <- dsGetFamInstEnvs ; let norm_elt_ty = topNormaliseType fam_inst_envs elt_ty supressible_ty = - isUnitTy norm_elt_ty || isAnyTy norm_elt_ty || isZonkAnyTy norm_elt_ty + isUnitTy norm_elt_ty || isAnyTy norm_elt_ty || isUnusedTypeTy norm_elt_ty -- Warn about discarding things in 'monadic' binding, -- however few types are excluded: -- * Unit type `()` - -- * `ZonkAny` or `Any` type see (Any8) of Note [Any types] + -- * `UnusedType` or `Any` type see (Any5) of Note [The types Any and UnusedType] ; if warn_unused && not supressible_ty then diagnosticDs (DsUnusedDoBind rhs elt_ty) else ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -7,7 +7,7 @@ This module defines interface types and binders -} -{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE MultiWayIf, OverloadedRecordDot #-} module GHC.Iface.Type ( IfExtName, IfLclName(..), mkIfLclName, ifLclNameFS, @@ -1740,6 +1740,7 @@ pprTyTcApp ctxt_prec tc tys = sdocOption sdocPrintExplicitKinds $ \print_kinds -> sdocOption sdocPrintTypeAbbreviations $ \print_type_abbreviations -> getPprDebug $ \debug -> + getPprStyle $ \style -> if | ifaceTyConName tc `hasKey` ipClassKey , IA_Arg (IfaceLitTy (IfaceStrTyLit n)) @@ -1791,6 +1792,14 @@ pprTyTcApp ctxt_prec tc tys = | Just doc <- ppr_equality ctxt_prec tc (appArgsIfaceTypes tys) -> doc + -- See Note [The types Any and UnusedType], specifically (Any6) and (Any7) + | ifaceTyConName tc `hasKey` unusedTypeTyConKey + , ((arg_k, _) : (IfaceLitTy (IfaceStrTyLit arg_nm), _) : args_usr) + <- appArgsIfaceTypesForAllTyFlags tys + -- if arg_k is a kind with more than 0 arguments, then _ might not be [] here + , userStyle style + -> ppr_iface_unused_ty_tycon ctxt_prec arg_k arg_nm args_usr + | otherwise -> ppr_iface_tc_app ppr_app_arg ctxt_prec tc $ appArgsIfaceTypesForAllTyFlags $ stripInvisArgs (PrintExplicitKinds print_kinds) tys @@ -1802,6 +1811,23 @@ ppr_kind_type ctxt_prec = sdocOption sdocStarIsType $ \case False -> pprPrefixOcc liftedTypeKindTyConName True -> maybeParen ctxt_prec starPrec starLit +-- | user-style printer that pretty-prints an 'UnusedType @k "foo_3" to foo_3. +-- If -fprint-explicit-kinds or -fprint-explicit-runtime-reps are set, instead +-- prints them to (foo3 :: k). +-- See Note [The types Any and UnusedType], specifically (Any6) and (Any7) for why this is useful. +ppr_iface_unused_ty_tycon :: PprPrec -> IfaceType -> LexicalFastString -> [(IfaceType, ForAllTyFlag)] -> SDoc +ppr_iface_unused_ty_tycon ctxt_prec arg_k arg_nm args_usr + = sdocOption sdocPrintExplicitKinds $ \print_kinds -> + sdocOption sdocPrintExplicitRuntimeReps $ \print_reps -> + if print_kinds || print_reps + then prettyMeta $ \nm -> + maybeParen sig_prec sigPrec $ nm <+> text "::" <+> pprIfaceType arg_k + else prettyMeta id + where sig_prec = if null args_usr then ctxt_prec else appPrec + prettyMeta add_ty + = pprIfacePrefixApp ctxt_prec (add_ty $ ppr arg_nm) + $ map (ppr_app_arg appPrec) args_usr + -- | Pretty-print a type-level equality. -- Returns (Just doc) if the argument is a /saturated/ application -- of eqTyCon (~) @@ -2190,7 +2216,8 @@ instance Binary IfaceTyConSort where 0 -> return IfaceNormalTyCon 1 -> IfaceTupleTyCon <$> get bh <*> get bh 2 -> IfaceSumTyCon <$> get bh - _ -> return IfaceEqualityTyCon + 3 -> return IfaceEqualityTyCon + _ -> panic "get IfaceTyConSort" instance Binary IfaceTyConInfo where put_ bh (IfaceTyConInfo i s) = put_ bh i >> put_ bh s ===================================== compiler/GHC/Tc/Types.hs ===================================== @@ -582,8 +582,8 @@ data TcGblEnv -- ^ Allows us to choose unique DFun names. tcg_zany_n :: TcRef Integer, - -- ^ A source of unique identities for ZonkAny instances - -- See Note [Any types] in GHC.Builtin.Types, wrinkle (Any4) + -- ^ A source of unique identities for UnusedType instances + -- See Note [The types Any and UnusedType] in GHC.Builtin.Types, wrinkle (Any6) tcg_merged :: [(Module, Fingerprint)], -- ^ The requirements we merged with; we always have to recompile ===================================== compiler/GHC/Tc/Utils/Monad.hs ===================================== @@ -154,7 +154,7 @@ module GHC.Tc.Utils.Monad( getCCIndexM, getCCIndexTcM, -- * Zonking - liftZonkM, newZonkAnyType, + liftZonkM, newUnusedType, -- * Complete matches localAndImportedCompleteMatches, getCompleteMatchesTcM, @@ -168,7 +168,7 @@ import GHC.Prelude import GHC.Builtin.Names -import GHC.Builtin.Types( zonkAnyTyCon ) +import GHC.Builtin.Types( unusedTypeTyCon ) import GHC.Tc.Errors.Types import GHC.Tc.Errors.Hole.Plugin ( HoleFitPlugin, HoleFitPluginR (..) ) @@ -197,7 +197,7 @@ import GHC.Core.Coercion ( isReflCo ) import GHC.Core.Multiplicity import GHC.Core.InstEnv import GHC.Core.FamInstEnv -import GHC.Core.Type( mkNumLitTy ) +import GHC.Core.Type( mkStrLitTy ) import GHC.Core.TyCo.Rep( CoercionHole(..) ) import GHC.Core.TyCo.FVs( coVarsOfCo ) import GHC.Core.TyCon ( TyCon ) @@ -2258,17 +2258,24 @@ chooseUniqueOccTc fn = ; writeTcRef dfun_n_var (extendOccSet set occ) ; return occ } -newZonkAnyType :: Kind -> TcM Type --- Return a type (ZonkAny @k n), where n is fresh --- Recall ZonkAny :: forall k. Natural -> k --- See Note [Any types] in GHC.Builtin.Types, wrinkle (Any4) -newZonkAnyType kind +newUnusedType :: Name -> Kind -> TcM Type +-- Return a type (UnusedType @k sym_n), where sym +-- is a name and n is a fresh Integer. +-- Recall UnusedType :: forall k. Symbol -> k +-- See Note [The types Any and UnusedType] in GHC.Builtin.Types, wrinkle (Any6) +newUnusedType name kind = do { env <- getGblEnv ; let zany_n_var = tcg_zany_n env ; i <- readTcRef zany_n_var ; let !i2 = i+1 ; writeTcRef zany_n_var i2 - ; return (mkTyConApp zonkAnyTyCon [kind, mkNumLitTy i]) } + -- Mind that the "_" here is load-bearing: + -- name foo1 with zany_n_var = 1 musn't be equal to + -- name foo with zany_n_var = 11 b/c that way the Pmc + -- would consider them equal. Using "_" suffices because + -- numbers never start with _ and so (legal) identfiers like + -- foo_ would become foo__1 which is distinct from e.g. foo_1 + ; return (mkTyConApp unusedTypeTyCon [kind, mkStrLitTy $ getOccFS name `appendFS` fsLit "_" `appendFS` fsLit (show i) ]) } getConstraintVar :: TcM (TcRef WantedConstraints) getConstraintVar = do { env <- getLclEnv; return (tcl_lie env) } ===================================== compiler/GHC/Tc/Utils/TcType.hs ===================================== @@ -85,7 +85,7 @@ module GHC.Tc.Utils.TcType ( isSigmaTy, isRhoTy, isRhoExpTy, isOverloadedTy, isFloatingPrimTy, isDoubleTy, isFloatTy, isIntTy, isWordTy, isStringTy, isIntegerTy, isNaturalTy, - isBoolTy, isUnitTy, isAnyTy, isZonkAnyTy, isCharTy, + isBoolTy, isUnitTy, isAnyTy, isUnusedTypeTy, isCharTy, isTauTy, isTauTyCon, tcIsTyVarTy, isPredTy, isSimplePredTy, isTyVarClassPred, checkValidClsArgs, hasTyVarHead, @@ -2057,7 +2057,7 @@ isFloatTy, isDoubleTy, isFloatPrimTy, isDoublePrimTy, isIntegerTy, isNaturalTy, isIntTy, isWordTy, isBoolTy, - isUnitTy, isAnyTy, isZonkAnyTy, isCharTy :: Type -> Bool + isUnitTy, isAnyTy, isUnusedTypeTy, isCharTy :: Type -> Bool isFloatTy = is_tc floatTyConKey isDoubleTy = is_tc doubleTyConKey isFloatPrimTy = is_tc floatPrimTyConKey @@ -2069,7 +2069,7 @@ isWordTy = is_tc wordTyConKey isBoolTy = is_tc boolTyConKey isUnitTy = is_tc unitTyConKey isAnyTy = is_tc anyTyConKey -isZonkAnyTy = is_tc zonkAnyTyConKey +isUnusedTypeTy = is_tc unusedTypeTyConKey isCharTy = is_tc charTyConKey -- | Check whether the type is of the form @Any :: k@, ===================================== compiler/GHC/Tc/Zonk/Type.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedRecordDot #-} {- (c) The University of Glasgow 2006 (c) The AQUA Project, Glasgow University, 1996-1998 @@ -43,7 +44,7 @@ import GHC.Tc.Types.TcRef import GHC.Tc.TyCl.Build ( TcMethInfo, MethInfo ) import GHC.Tc.Utils.Env ( tcLookupGlobalOnly ) import GHC.Tc.Utils.TcType -import GHC.Tc.Utils.Monad ( newZonkAnyType, setSrcSpanA, liftZonkM, traceTc, addErr ) +import GHC.Tc.Utils.Monad ( newUnusedType, setSrcSpanA, liftZonkM, traceTc, addErr ) import GHC.Tc.Types.Evidence import GHC.Tc.Errors.Types import GHC.Tc.Zonk.Env @@ -470,11 +471,11 @@ commitFlexi DefaultFlexi tv zonked_kind ; return manyDataConTy } | Just (ConcreteFRR origin) <- isConcreteTyVar_maybe tv = do { addErr $ TcRnZonkerMessage (ZonkerCannotDefaultConcrete origin) - ; newZonkAnyType zonked_kind } + ; newUnusedType tv.varName zonked_kind } | otherwise - = do { traceTc "Defaulting flexi tyvar to ZonkAny:" (pprTyVar tv) - -- See Note [Any types] in GHC.Builtin.Types, esp wrinkle (Any4) - ; newZonkAnyType zonked_kind } + = do { traceTc "Defaulting flexi tyvar to UnusedType:" (pprTyVar tv) + -- See Note [The types Any and UnusedType] in GHC.Builtin.Types, esp wrinkle (Any6) + ; newUnusedType tv.varName zonked_kind } zonkCoVarOcc :: CoVar -> ZonkTcM Coercion zonkCoVarOcc cv ===================================== libraries/base/src/GHC/Base.hs ===================================== @@ -535,4 +535,5 @@ import GHC.Types hiding ( Sum62#, Sum63#, Sum64#, + UnusedType, ) ===================================== libraries/base/src/GHC/Exts.hs ===================================== @@ -374,6 +374,7 @@ import GHC.Types hiding ( Type, -- Exported from "Data.Kind" -- GHC's internal representation of 'TyCon's, for 'Typeable' Module, TrName, TyCon, TypeLitSort, KindRep, KindBndr, + UnusedType, Unit#, Solo#(..), Tuple0#, ===================================== libraries/ghc-experimental/src/GHC/PrimOps.hs ===================================== @@ -29,5 +29,5 @@ module GHC.PrimOps module GHC.Internal.Exts, ) where -import GHC.Internal.Exts +import GHC.Internal.Exts hiding (UnusedType) ===================================== libraries/ghc-internal/src/GHC/Internal/Types.hs ===================================== @@ -35,6 +35,7 @@ module GHC.Internal.Types ( SPEC(..), Symbol, Any, + UnusedType, -- * Type equality type (~), type (~~), Coercible, @@ -284,48 +285,53 @@ data Symbol * * ********************************************************************* -} --- | The type constructor @Any :: forall k. k@ is a type to which you can unsafely coerce any type, and back. +-- | The type constructor @Any :: forall k. k@ allows creating an arbitrary type +-- of the given kind. -- --- For @unsafeCoerce@ this means for all lifted types @t@ that --- @unsafeCoerce (unsafeCoerce x :: Any) :: t@ is equivalent to @x@ and safe. +-- It can be used to create a placeholder type when you only have a kind in hand. -- --- The same is true for *all* types when using --- @ --- unsafeCoerce# :: forall (r1 :: RuntimeRep) (r2 :: RuntimeRep) --- (a :: TYPE r1) (b :: TYPE r2). --- a -> b --- @ --- but /only/ if you instantiate @r1@ and @r2@ to the /same/ runtime representation. --- For example using @(unsafeCoerce# :: forall (a :: TYPE IntRep) (b :: TYPE IntRep). a -> b) x@ --- is fine, but @(unsafeCoerce# :: forall (a :: TYPE IntRep) (b :: TYPE FloatRep). a -> b)@ --- will likely cause seg-faults or worse. --- For this resason, users should always prefer unsafeCoerce over unsafeCoerce# when possible. +-- You can use 'unsafeCoerce#' to unsafely coerce a value from @ty :: k@ to @Any \@k@ +-- and back. As per the documentation of 'unsafeCoerce#', this is only sound if both +-- sides have the __exact same__runtime representation. Some examples: -- --- Here are some more examples: -- @ --- bad_a1 :: Any @(TYPE 'IntRep) --- bad_a1 = unsafeCoerce# True --- --- bad_a2 :: Any @(TYPE ('BoxedRep 'UnliftedRep)) --- bad_a2 = unsafeCoerce# True +-- unsafeCoerce# True :: (Any :: Type) -- OK +-- unsafeCoerce# (1# :: Int#) :: (Any :: TYPE IntRep) -- OK +-- unsafeCoerce# True :: (Any :: Type IntRep) -- INVALID +-- unsafeCoerce True :: (Any :: UnliftedType) -- INVALID +-- unsafeCoerce (ba :: ByteArray#) :: (Any :: Type) -- INVALID -- @ --- Here @bad_a1@ is bad because we started with @True :: (Bool :: Type)@, represented by a boxed heap pointer, --- and coerced it to @a1 :: Any @(TYPE 'IntRep)@, whose representation is a non-pointer integer. --- That's why we had to use `unsafeCoerce#`; it is really unsafe because it can change representations. --- Similarly @bad_a2@ is bad because although both @True@ and @bad_a2@ are represented by a heap pointer, --- @True@ is lifted but @bad_a2@ is not; bugs here may be rather subtle. -- --- If you must use unsafeCoerce# to cast to `Any`, type annotations are recommended --- to make sure that @Any@ has the correct kind. As casting between different runtimereps is --- unsound. For example to cast a @ByteArray#@ to @Any@ you might use: --- @ --- unsafeCoerce# b :: (Any :: TYPE ('BoxedRep 'Unlifted)) --- @ +-- To avoid accidentally unsafe-coercing between different representations, +-- it is recommended to: +-- - use explicit type annotations or type applications at every use-site +-- of 'unsafeCoerce#' +-- - use representation-monomorphic variants such as 'unsafeCoerce' or +-- 'unsafeCoerceUnlifted'. +-- +-- In particular, this also implies it is safe to round-trip unsafe-coercion via 'Any', +-- as long as the kinds line up e.g. @unsafeCoerce (unsafeCoerce (val :: a) :: 'Any') :: a@ +-- is safe in that way. type family Any :: k where { } --- See Note [Any types] in GHC.Builtin.Types. Also, for a bit of history on Any see +-- See Note [The types Any and UnusedType] in GHC.Builtin.Types. Also, for a bit of history on Any see -- #10886. Note that this must be a *closed* type family: we need to ensure -- that this can't reduce to a `data` type for the results discussed in --- Note [Any types]. +-- Note [The types Any and UnusedType]. +-- + +-- | @UnusedType \@k "foo"@ denotes an arbitrary type of kind +-- @k@ and is pretty-printed as @foo@ . +-- +-- This type is used internally by GHC to fill in otherwise +-- unconstrained type variables, such as @a@ in @length \@a []@. +-- It is exported purely for documentation purposes. +-- +-- You shouldn't ever see this type in the compiler's output if +-- you don't specifically ask for it, for instance when viewing +-- core, since the compiler will try hard to output a given +-- @'UnusedType' "m_0"@ simply as @m_0@. +type family UnusedType :: Symbol -> k where { } +-- See Note [The types Any and UnusedType] in GHC.Builtin.Types. {- ********************************************************************* * * ===================================== testsuite/tests/interface-stability/ghc-prim-exports.stdout ===================================== @@ -6975,6 +6975,8 @@ module GHC.Types where type UnliftedRep = BoxedRep Unlifted type UnliftedType :: * type UnliftedType = TYPE UnliftedRep + type UnusedType :: forall k0. Symbol -> k0 + type family UnusedType k1 where type VecCount :: * data VecCount = Vec2 | Vec4 | Vec8 | Vec16 | Vec32 | Vec64 type VecElem :: * ===================================== testsuite/tests/interface-stability/ghc-prim-exports.stdout-mingw32 ===================================== @@ -6978,6 +6978,8 @@ module GHC.Types where type UnliftedRep = BoxedRep Unlifted type UnliftedType :: * type UnliftedType = TYPE UnliftedRep + type UnusedType :: forall k0. Symbol -> k0 + type family UnusedType k1 where type VecCount :: * data VecCount = Vec2 | Vec4 | Vec8 | Vec16 | Vec32 | Vec64 type VecElem :: * ===================================== testsuite/tests/perf/compiler/T11068.stdout ===================================== @@ -23,137 +23,137 @@ `cast` (GHC.Internal.Generics.N:M1 `cast` (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.R1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.R1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.R1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.R1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.L1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 - ((GHC.Internal.Generics.U1 @(*) @(GHC.Internal.Types.ZonkAny 0)) + ((GHC.Internal.Generics.U1 `cast` (Sym (GHC.Internal.Generics.N:M1 = GHC.Internal.Generics.R1 = GHC.Internal.Generics.R1 ===================================== testsuite/tests/pmcheck/should_compile/T12957.stderr ===================================== @@ -1,7 +1,6 @@ T12957.hs:4:5: warning: [GHC-62161] [-Wincomplete-patterns (in -Wextra)] Pattern match(es) are non-exhaustive - In a case alternative: - Patterns of type ‘[GHC.Internal.Types.ZonkAny 0]’ not matched: [] + In a case alternative: Patterns of type ‘[a_0]’ not matched: [] T12957.hs:4:16: warning: [GHC-53633] [-Woverlapping-patterns (in -Wdefault)] Pattern match is redundant ===================================== testsuite/tests/profiling/should_run/staticcallstack002.stdout ===================================== @@ -1,4 +1,4 @@ -Just (InfoProv {ipName = "sat_s1Rh_info", ipDesc = THUNK, ipTyDesc = "ZonkAny 0", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "10:23-39"}) -Just (InfoProv {ipName = "sat_s1RB_info", ipDesc = THUNK, ipTyDesc = "ZonkAny 1", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "11:23-42"}) -Just (InfoProv {ipName = "sat_s1RV_info", ipDesc = THUNK, ipTyDesc = "ZonkAny 2", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "12:23-46"}) -Just (InfoProv {ipName = "sat_s1Sf_info", ipDesc = THUNK, ipTyDesc = "ZonkAny 3", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "13:23-44"}) +Just (InfoProv {ipName = "main_sat_t2fs_info", ipDesc = THUNK, ipTyDesc = "UnusedType \"a_0\"", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "10:23-39"}) +Just (InfoProv {ipName = "main_sat_t2fJ_info", ipDesc = THUNK, ipTyDesc = "UnusedType \"a_1\"", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "11:23-42"}) +Just (InfoProv {ipName = "main_sat_t2g0_info", ipDesc = THUNK, ipTyDesc = "UnusedType \"a_2\"", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "12:23-46"}) +Just (InfoProv {ipName = "main_sat_t2gh_info", ipDesc = THUNK, ipTyDesc = "UnusedType \"a_3\"", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "13:23-44"}) ===================================== testsuite/tests/simplCore/should_compile/Makefile ===================================== @@ -188,7 +188,7 @@ T13155: T13156: $(RM) -f T13156.hi T13156.o - '$(TEST_HC)' $(TEST_HC_OPTS) -c T13156.hs -O -ddump-prep -dsuppress-uniques | grep "case.*Any" + '$(TEST_HC)' $(TEST_HC_OPTS) -c T13156.hs -O -ddump-prep -dsuppress-uniques | grep "case.*UnusedType" # There should be a single 'case r @ GHC.Types.Any' .PHONY: T4138 ===================================== testsuite/tests/simplCore/should_compile/T13156.stdout ===================================== @@ -1,2 +1,2 @@ - case r @(GHC.Internal.Types.ZonkAny 0) of { __DEFAULT -> - case r @(GHC.Internal.Types.ZonkAny 1) of { __DEFAULT -> r @a } + case r @(GHC.Internal.Types.UnusedType "a_0") of { __DEFAULT -> + case r @(GHC.Internal.Types.UnusedType "a_1") of { __DEFAULT -> ===================================== testsuite/tests/simplCore/should_compile/T26615.stderr ===================================== @@ -2,7 +2,7 @@ ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 1,209, types: 1,139, coercions: 18, joins: 17/29} + = {terms: 1,209, types: 1,155, coercions: 18, joins: 17/29} -- RHS size: {terms: 6, types: 8, coercions: 0, joins: 0/0} unArray :: forall a. Array a -> SmallArray# a @@ -15,45 +15,29 @@ unArray :: forall a. Array a -> SmallArray# a unArray = \ (@a) (ds :: Array a) -> case ds of { Array ds1 -> ds1 } -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$trModule4 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 20 0}] -T26615a.$trModule4 = "main"# +$trModule1 :: Addr# +[GblId, Unf=OtherCon []] +$trModule1 = "main"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$trModule3 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$trModule3 = GHC.Internal.Types.TrNameS T26615a.$trModule4 +$trModule2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$trModule2 = GHC.Internal.Types.TrNameS $trModule1 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$trModule2 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 30 0}] -T26615a.$trModule2 = "T26615a"# +$trModule3 :: Addr# +[GblId, Unf=OtherCon []] +$trModule3 = "T26615a"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$trModule1 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$trModule1 = GHC.Internal.Types.TrNameS T26615a.$trModule2 +$trModule4 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$trModule4 = GHC.Internal.Types.TrNameS $trModule3 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T26615a.$trModule :: GHC.Internal.Types.Module -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$trModule - = GHC.Internal.Types.Module T26615a.$trModule3 T26615a.$trModule1 +T26615a.$trModule [InlPrag=[~]] :: GHC.Internal.Types.Module +[GblId, Unf=OtherCon []] +T26615a.$trModule = GHC.Internal.Types.Module $trModule2 $trModule4 -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} $krep :: GHC.Internal.Types.KindRep @@ -104,33 +88,24 @@ $krep6 GHC.Internal.Types.$tcSmallArray# $krep5 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$tcLeaf2 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 20 0}] -T26615a.$tcLeaf2 = "Leaf"# +$tcLeaf1 :: Addr# +[GblId, Unf=OtherCon []] +$tcLeaf1 = "Leaf"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$tcLeaf1 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$tcLeaf1 = GHC.Internal.Types.TrNameS T26615a.$tcLeaf2 +$tcLeaf2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tcLeaf2 = GHC.Internal.Types.TrNameS $tcLeaf1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26615a.$tcLeaf :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26615a.$tcLeaf [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26615a.$tcLeaf = GHC.Internal.Types.TyCon 13798714324392902582#Word64 3237499036029031497#Word64 T26615a.$trModule - T26615a.$tcLeaf1 + $tcLeaf2 0# GHC.Internal.Types.krep$*->*->* @@ -160,372 +135,284 @@ $krep10 :: GHC.Internal.Types.KindRep $krep10 = GHC.Internal.Types.KindRepFun $krep2 $krep9 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'L1 [InlPrag=[~]] :: GHC.Internal.Types.KindRep +$krep11 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -T26615a.$tc'L1 = GHC.Internal.Types.KindRepFun $krep3 $krep10 +$krep11 = GHC.Internal.Types.KindRepFun $krep3 $krep10 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'L3 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 20 0}] -T26615a.$tc'L3 = "'L"# +$tc'L1 :: Addr# +[GblId, Unf=OtherCon []] +$tc'L1 = "'L"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'L2 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$tc'L2 = GHC.Internal.Types.TrNameS T26615a.$tc'L3 +$tc'L2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tc'L2 = GHC.Internal.Types.TrNameS $tc'L1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'L :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26615a.$tc'L [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26615a.$tc'L = GHC.Internal.Types.TyCon 8570419491837374712#Word64 2090006989092642392#Word64 T26615a.$trModule - T26615a.$tc'L2 + $tc'L2 2# - T26615a.$tc'L1 + $krep11 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$tcArray2 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 30 0}] -T26615a.$tcArray2 = "Array"# +$tcArray1 :: Addr# +[GblId, Unf=OtherCon []] +$tcArray1 = "Array"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$tcArray1 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$tcArray1 = GHC.Internal.Types.TrNameS T26615a.$tcArray2 +$tcArray2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tcArray2 = GHC.Internal.Types.TrNameS $tcArray1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26615a.$tcArray :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26615a.$tcArray [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26615a.$tcArray = GHC.Internal.Types.TyCon 10495761415291712389#Word64 7580086293698619153#Word64 T26615a.$trModule - T26615a.$tcArray1 + $tcArray2 0# GHC.Internal.Types.krep$*Arr* -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep11 :: GHC.Internal.Types.KindRep +$krep12 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -$krep11 +$krep12 = GHC.Internal.Types.KindRepTyConApp T26615a.$tcArray $krep4 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Array1 [InlPrag=[~]] :: GHC.Internal.Types.KindRep +$krep13 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -T26615a.$tc'Array1 = GHC.Internal.Types.KindRepFun $krep6 $krep11 +$krep13 = GHC.Internal.Types.KindRepFun $krep6 $krep12 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Array3 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 30 0}] -T26615a.$tc'Array3 = "'Array"# +$tc'Array1 :: Addr# +[GblId, Unf=OtherCon []] +$tc'Array1 = "'Array"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Array2 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$tc'Array2 = GHC.Internal.Types.TrNameS T26615a.$tc'Array3 +$tc'Array2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tc'Array2 = GHC.Internal.Types.TrNameS $tc'Array1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Array :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26615a.$tc'Array [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26615a.$tc'Array = GHC.Internal.Types.TyCon 12424115309881832159#Word64 15542868641947707803#Word64 T26615a.$trModule - T26615a.$tc'Array2 + $tc'Array2 1# - T26615a.$tc'Array1 + $krep13 -- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} -$krep12 :: [GHC.Internal.Types.KindRep] +$krep14 :: [GHC.Internal.Types.KindRep] [GblId, Unf=OtherCon []] -$krep12 +$krep14 = GHC.Internal.Types.: @GHC.Internal.Types.KindRep $krep9 (GHC.Internal.Types.[] @GHC.Internal.Types.KindRep) -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep13 :: GHC.Internal.Types.KindRep +$krep15 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -$krep13 - = GHC.Internal.Types.KindRepTyConApp T26615a.$tcArray $krep12 +$krep15 + = GHC.Internal.Types.KindRepTyConApp T26615a.$tcArray $krep14 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$tcHashMap2 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 30 0}] -T26615a.$tcHashMap2 = "HashMap"# +$tcHashMap1 :: Addr# +[GblId, Unf=OtherCon []] +$tcHashMap1 = "HashMap"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$tcHashMap1 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$tcHashMap1 - = GHC.Internal.Types.TrNameS T26615a.$tcHashMap2 +$tcHashMap2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tcHashMap2 = GHC.Internal.Types.TrNameS $tcHashMap1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26615a.$tcHashMap :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26615a.$tcHashMap [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26615a.$tcHashMap = GHC.Internal.Types.TyCon 2021755758654901686#Word64 8209241086311595496#Word64 T26615a.$trModule - T26615a.$tcHashMap1 + $tcHashMap2 0# GHC.Internal.Types.krep$*->*->* -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Empty1 [InlPrag=[~]] :: GHC.Internal.Types.KindRep +$krep16 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -T26615a.$tc'Empty1 +$krep16 = GHC.Internal.Types.KindRepTyConApp T26615a.$tcHashMap $krep8 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Empty3 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 30 0}] -T26615a.$tc'Empty3 = "'Empty"# +$tc'Empty1 :: Addr# +[GblId, Unf=OtherCon []] +$tc'Empty1 = "'Empty"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Empty2 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$tc'Empty2 = GHC.Internal.Types.TrNameS T26615a.$tc'Empty3 +$tc'Empty2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tc'Empty2 = GHC.Internal.Types.TrNameS $tc'Empty1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Empty :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26615a.$tc'Empty [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26615a.$tc'Empty = GHC.Internal.Types.TyCon 2520556399233147460#Word64 17224648764450205443#Word64 T26615a.$trModule - T26615a.$tc'Empty2 + $tc'Empty2 2# - T26615a.$tc'Empty1 + $krep16 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep14 :: GHC.Internal.Types.KindRep +$krep17 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -$krep14 = GHC.Internal.Types.KindRepFun $krep9 T26615a.$tc'Empty1 +$krep17 = GHC.Internal.Types.KindRepFun $krep9 $krep16 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Leaf1 [InlPrag=[~]] :: GHC.Internal.Types.KindRep +$krep18 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -T26615a.$tc'Leaf1 = GHC.Internal.Types.KindRepFun $krep1 $krep14 +$krep18 = GHC.Internal.Types.KindRepFun $krep1 $krep17 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Leaf3 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 30 0}] -T26615a.$tc'Leaf3 = "'Leaf"# +$tc'Leaf1 :: Addr# +[GblId, Unf=OtherCon []] +$tc'Leaf1 = "'Leaf"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Leaf2 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$tc'Leaf2 = GHC.Internal.Types.TrNameS T26615a.$tc'Leaf3 +$tc'Leaf2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tc'Leaf2 = GHC.Internal.Types.TrNameS $tc'Leaf1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Leaf :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26615a.$tc'Leaf [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26615a.$tc'Leaf = GHC.Internal.Types.TyCon 5773656560257991946#Word64 17028074687139582545#Word64 T26615a.$trModule - T26615a.$tc'Leaf2 + $tc'Leaf2 2# - T26615a.$tc'Leaf1 + $krep18 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep15 :: GHC.Internal.Types.KindRep +$krep19 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -$krep15 = GHC.Internal.Types.KindRepFun $krep13 T26615a.$tc'Empty1 +$krep19 = GHC.Internal.Types.KindRepFun $krep15 $krep16 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Collision1 [InlPrag=[~]] :: GHC.Internal.Types.KindRep +$krep20 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -T26615a.$tc'Collision1 - = GHC.Internal.Types.KindRepFun $krep1 $krep15 +$krep20 = GHC.Internal.Types.KindRepFun $krep1 $krep19 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Collision3 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 40 0}] -T26615a.$tc'Collision3 = "'Collision"# +$tc'Collision1 :: Addr# +[GblId, Unf=OtherCon []] +$tc'Collision1 = "'Collision"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Collision2 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$tc'Collision2 - = GHC.Internal.Types.TrNameS T26615a.$tc'Collision3 +$tc'Collision2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tc'Collision2 = GHC.Internal.Types.TrNameS $tc'Collision1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Collision :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26615a.$tc'Collision [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26615a.$tc'Collision = GHC.Internal.Types.TyCon 18175105753528304021#Word64 13986842878006680511#Word64 T26615a.$trModule - T26615a.$tc'Collision2 + $tc'Collision2 2# - T26615a.$tc'Collision1 + $krep20 -- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} -$krep16 :: [GHC.Internal.Types.KindRep] +$krep21 :: [GHC.Internal.Types.KindRep] [GblId, Unf=OtherCon []] -$krep16 +$krep21 = GHC.Internal.Types.: @GHC.Internal.Types.KindRep - T26615a.$tc'Empty1 + $krep16 (GHC.Internal.Types.[] @GHC.Internal.Types.KindRep) -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep17 :: GHC.Internal.Types.KindRep +$krep22 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -$krep17 - = GHC.Internal.Types.KindRepTyConApp T26615a.$tcArray $krep16 +$krep22 + = GHC.Internal.Types.KindRepTyConApp T26615a.$tcArray $krep21 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Full1 [InlPrag=[~]] :: GHC.Internal.Types.KindRep +$krep23 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -T26615a.$tc'Full1 - = GHC.Internal.Types.KindRepFun $krep17 T26615a.$tc'Empty1 +$krep23 = GHC.Internal.Types.KindRepFun $krep22 $krep16 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Full3 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 30 0}] -T26615a.$tc'Full3 = "'Full"# +$tc'Full1 :: Addr# +[GblId, Unf=OtherCon []] +$tc'Full1 = "'Full"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Full2 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$tc'Full2 = GHC.Internal.Types.TrNameS T26615a.$tc'Full3 +$tc'Full2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tc'Full2 = GHC.Internal.Types.TrNameS $tc'Full1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'Full :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26615a.$tc'Full [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26615a.$tc'Full = GHC.Internal.Types.TyCon 12008762105994325570#Word64 13514145886440831186#Word64 T26615a.$trModule - T26615a.$tc'Full2 + $tc'Full2 2# - T26615a.$tc'Full1 + $krep23 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'BitmapIndexed1 [InlPrag=[~]] - :: GHC.Internal.Types.KindRep +$krep24 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -T26615a.$tc'BitmapIndexed1 - = GHC.Internal.Types.KindRepFun $krep1 T26615a.$tc'Full1 +$krep24 = GHC.Internal.Types.KindRepFun $krep1 $krep23 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'BitmapIndexed3 :: Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 50 0}] -T26615a.$tc'BitmapIndexed3 = "'BitmapIndexed"# +$tc'BitmapIndexed1 :: Addr# +[GblId, Unf=OtherCon []] +$tc'BitmapIndexed1 = "'BitmapIndexed"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'BitmapIndexed2 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615a.$tc'BitmapIndexed2 - = GHC.Internal.Types.TrNameS T26615a.$tc'BitmapIndexed3 +$tc'BitmapIndexed2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tc'BitmapIndexed2 = GHC.Internal.Types.TrNameS $tc'BitmapIndexed1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26615a.$tc'BitmapIndexed :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26615a.$tc'BitmapIndexed [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26615a.$tc'BitmapIndexed = GHC.Internal.Types.TyCon 15226751910432948177#Word64 957331387129868915#Word64 T26615a.$trModule - T26615a.$tc'BitmapIndexed2 + $tc'BitmapIndexed2 2# - T26615a.$tc'BitmapIndexed1 + $krep24 -- RHS size: {terms: 98, types: 109, coercions: 0, joins: 3/4} T26615a.$wdisjointCollisions [InlPrag=INLINABLE[2]] @@ -538,7 +425,7 @@ T26615a.$wdisjointCollisions [InlPrag=INLINABLE[2]] Str=<LP(SC(S,C(1,L)),A)><L><1L><L><L>, Unf=Unf{Src=StableUser, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [30 0 20 0 0] 406 10 + Guidance=IF_ARGS [90 0 20 0 0] 406 10 Tmpl= \ (@k) (@a) (@b) @@ -586,7 +473,7 @@ T26615a.$wdisjointCollisions [InlPrag=INLINABLE[2]] Arity=5, Str=<L><L><L><L><L>, Unf=OtherCon []] - lookupInArrayCont_ _ [Occ=Dead] + lookupInArrayCont_ ($dEq1 [Occ=Dead] :: Eq k) (k1 [Occ=Once1] :: k) (ary1 [Occ=Once1!] :: Array (Leaf k b)) (i1 [Occ=Once1!] :: Int) @@ -654,24 +541,23 @@ T26615a.$wdisjointCollisions $s$wfoldr_ [InlPrag=[2], Occ=LoopBreaker, Dmd=SC(S,C(1,C(1,C(1,L))))] - :: Bool -> Int# -> Int# -> SmallArray# (Leaf k a) -> Bool + :: SmallArray# (Leaf k a) -> Int# -> Int# -> Bool -> Bool [LclId[JoinId(4)(Nothing)], Arity=4, Str=<L><L><L><L>, Unf=OtherCon []] - $s$wfoldr_ (sc :: Bool) + $s$wfoldr_ (sc :: SmallArray# (Leaf k a)) (sc1 :: Int#) (sc2 :: Int#) - (sc3 :: SmallArray# (Leaf k a)) - = case >=# sc1 sc2 of { + (sc3 :: Bool) + = case >=# sc2 sc1 of { __DEFAULT -> - case indexSmallArray# @Lifted @(Leaf k a) sc3 sc1 of - { (# ipv1 #) -> + case indexSmallArray# @Lifted @(Leaf k a) sc sc2 of { (# ipv1 #) -> case ipv1 of { L kA ds1 -> join { $j :: Bool [LclId[JoinId(0)(Nothing)]] - $j = jump $s$wfoldr_ sc (+# sc1 1#) sc2 sc3 } in + $j = jump $s$wfoldr_ sc sc1 (+# sc2 1#) sc3 } in joinrec { $wlookupInArrayCont_ [InlPrag=[2], Occ=LoopBreaker, @@ -703,13 +589,13 @@ T26615a.$wdisjointCollisions jump $wlookupInArrayCont_ kA ww2 0# lvl2 } }; - 1# -> sc + 1# -> sc3 }; } in jump $s$wfoldr_ - GHC.Internal.Types.True - 0# - (sizeofSmallArray# @Lifted @(Leaf k a) ipv) ipv + (sizeofSmallArray# @Lifted @(Leaf k a) ipv) + 0# + GHC.Internal.Types.True } } @@ -728,28 +614,28 @@ Rec { -- RHS size: {terms: 133, types: 126, coercions: 0, joins: 1/2} T26615a.disjointSubtrees_$s$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] - :: forall b a k. - Word# - -> SmallArray# (Leaf k a) -> Int# -> Eq k => HashMap k b -> Bool + :: forall k a b. + Eq k => + Int# -> Word# -> SmallArray# (Leaf k a) -> HashMap k b -> Bool [GblId[StrictWorker([~, ~, ~, ~, !])], Arity=5, - Str=<L><L><L><LP(SC(S,C(1,L)),A)><1L>, + Str=<LP(SC(S,C(1,L)),A)><L><L><L><1L>, Unf=OtherCon []] T26615a.disjointSubtrees_$s$wdisjointSubtrees - = \ (@b) + = \ (@k) (@a) - (@k) - (sc :: Word#) - (sc1 :: SmallArray# (Leaf k a)) - (sc2 :: Int#) - (sc3 :: Eq k) + (@b) + (sc :: Eq k) + (sc1 :: Int#) + (sc2 :: Word#) + (sc3 :: SmallArray# (Leaf k a)) (_b :: HashMap k b) -> case _b of { Empty -> GHC.Internal.Types.True; Leaf bx ds -> case ds of { L kB ds1 -> case kB of k0 { __DEFAULT -> - case eqWord# bx sc of { + case eqWord# bx sc2 of { __DEFAULT -> GHC.Internal.Types.True; 1# -> joinrec { @@ -770,7 +656,7 @@ T26615a.disjointSubtrees_$s$wdisjointSubtrees __DEFAULT -> case indexSmallArray# @Lifted @(Leaf k a) ww ww1 of { (# ipv #) -> case ipv of { L kx v -> - case == @k sc3 k2 kx of { + case == @k sc k2 kx of { False -> jump $wlookupInArrayCont_ k2 ww (+# ww1 1#) ww2; True -> GHC.Internal.Types.False } @@ -780,19 +666,19 @@ T26615a.disjointSubtrees_$s$wdisjointSubtrees } }; } in jump $wlookupInArrayCont_ - k0 sc1 0# (sizeofSmallArray# @Lifted @(Leaf k a) sc1) + k0 sc3 0# (sizeofSmallArray# @Lifted @(Leaf k a) sc3) } } }; Collision bx bx1 -> T26615a.$wdisjointCollisions - @k @a @b sc3 sc (T26615a.Array @(Leaf k a) sc1) bx bx1; + @k @a @b sc sc2 (T26615a.Array @(Leaf k a) sc3) bx bx1; BitmapIndexed bx bx1 -> let { m :: Word# [LclId] m = uncheckedShiftL# - 1## (word2Int# (and# (uncheckedShiftRL# sc sc2) 31##)) } in + 1## (word2Int# (and# (uncheckedShiftRL# sc2 sc1) 31##)) } in case and# m bx of { __DEFAULT -> case indexSmallArray# @@ -803,7 +689,7 @@ T26615a.disjointSubtrees_$s$wdisjointSubtrees of { (# ipv #) -> T26615a.disjointSubtrees_$s$wdisjointSubtrees - @b @a @k sc sc1 (+# sc2 5#) sc3 ipv + @k @a @b sc (+# sc1 5#) sc2 sc3 ipv }; 0## -> GHC.Internal.Types.True }; @@ -812,17 +698,17 @@ T26615a.disjointSubtrees_$s$wdisjointSubtrees @Lifted @(HashMap k b) bx - (word2Int# (and# (uncheckedShiftRL# sc sc2) 31##)) + (word2Int# (and# (uncheckedShiftRL# sc2 sc1) 31##)) of { (# ipv #) -> T26615a.disjointSubtrees_$s$wdisjointSubtrees - @b @a @k sc sc1 (+# sc2 5#) sc3 ipv + @k @a @b sc (+# sc1 5#) sc2 sc3 ipv } } end Rec } Rec { --- RHS size: {terms: 705, types: 732, coercions: 18, joins: 13/23} +-- RHS size: {terms: 705, 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([~, ~, !])], @@ -841,7 +727,7 @@ T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] join { fail [Occ=Once3!T[1]] :: (# #) -> Bool [LclId[JoinId(1)(Nothing)], Arity=1, Str=<L>, Unf=OtherCon []] - fail _ [Occ=Dead, OS=OneShot] + fail (ds1 [Occ=Dead, OS=OneShot] :: (# #)) = case _b of wild [Occ=Once1] { __DEFAULT -> case GHC.Internal.Control.Exception.Base.patError @@ -860,7 +746,7 @@ T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] Arity=5, Str=<L><L><L><L><L>, Unf=OtherCon []] - lookupCont_ _ [Occ=Dead] + lookupCont_ ($dEq1 [Occ=Dead] :: Eq k) (ds4 [Occ=Once1!] :: Word) (ds5 [Occ=Once1] :: k) (ds6 [Occ=Once1!] :: Int) @@ -896,7 +782,7 @@ T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] Arity=5, Str=<L><L><L><L><L>, Unf=OtherCon []] - lookupInArrayCont_ _ [Occ=Dead] + lookupInArrayCont_ ($dEq2 [Occ=Dead] :: Eq k) (k1 [Occ=Once1] :: k) (ary [Occ=Once1!] :: Array (Leaf k a)) (i [Occ=Once1!] :: Int) @@ -1000,7 +886,7 @@ T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] Arity=5, Str=<L><L><L><L><L>, Unf=OtherCon []] - lookupCont_ _ [Occ=Dead] + lookupCont_ ($dEq1 [Occ=Dead] :: Eq k) (ds3 [Occ=Once1!] :: Word) (ds4 [Occ=Once1] :: k) (ds5 [Occ=Once1!] :: Int) @@ -1034,7 +920,7 @@ T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] Arity=5, Str=<L><L><L><L><L>, Unf=OtherCon []] - lookupInArrayCont_ _ [Occ=Dead] + lookupInArrayCont_ ($dEq2 [Occ=Dead] :: Eq k) (k1 [Occ=Once1] :: k) (ary [Occ=Once1!] :: Array (Leaf k b)) (i [Occ=Once1!] :: Int) @@ -1179,23 +1065,23 @@ T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] @(*) @(SmallArray# (HashMap k a) -> SmallArray# (HashMap k b) -> Int#) - @(GHC.Internal.Types.ZonkAny 0 - -> GHC.Internal.Types.ZonkAny 1 -> Int#) + @(GHC.Internal.Types.UnusedType 0 "a" + -> GHC.Internal.Types.UnusedType 1 "b" -> Int#) of { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> case reallyUnsafePtrEquality# @Lifted @Lifted - @(GHC.Internal.Types.ZonkAny 0) - @(GHC.Internal.Types.ZonkAny 1) + @(GHC.Internal.Types.UnusedType 0 "a") + @(GHC.Internal.Types.UnusedType 1 "b") (bx1 `cast` (SelCo:Fun(arg) (Sub (Sym v2)) :: SmallArray# (HashMap k a) - ~R# GHC.Internal.Types.ZonkAny 0)) + ~R# GHC.Internal.Types.UnusedType 0 "a")) (bx3 `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) :: SmallArray# (HashMap k b) - ~R# GHC.Internal.Types.ZonkAny 1)) + ~R# GHC.Internal.Types.UnusedType 1 "b")) of { __DEFAULT -> joinrec { @@ -1324,51 +1210,49 @@ T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] }; } in jump go (GHC.Internal.Types.W# (and# 4294967295## bx1)); Full bx1 -> + joinrec { + go [Occ=LoopBreakerT[1]] :: Int -> Bool + [LclId[JoinId(1)(Nothing)], Arity=1, Str=<L>, Unf=OtherCon []] + go (i :: Int) + = case GHC.Internal.Classes.ltInt i (GHC.Internal.Types.I# 0#) of { + False -> + case i of { I# i# -> + case indexSmallArray# @Lifted @(HashMap k a) bx i# of + { (# ipv [Occ=Once1] #) -> + case indexSmallArray# @Lifted @(HashMap k b) bx1 i# of + { (# ipv1 [Occ=Once1] #) -> + case T26615a.$wdisjointSubtrees @k @a @b $dEq (+# ww 5#) ipv ipv1 + of { + False -> GHC.Internal.Types.False; + True -> jump go (GHC.Internal.Types.I# (-# i# 1#)) + } + } + } + }; + True -> GHC.Internal.Types.True + }; } in case GHC.Internal.Unsafe.Coerce.unsafeEqualityProof @(*) @(SmallArray# (HashMap k a) -> SmallArray# (HashMap k b) -> Int#) - @(GHC.Internal.Types.ZonkAny 0 - -> GHC.Internal.Types.ZonkAny 1 -> Int#) + @(GHC.Internal.Types.UnusedType 0 "a" + -> GHC.Internal.Types.UnusedType 1 "b" -> Int#) of { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> case reallyUnsafePtrEquality# @Lifted @Lifted - @(GHC.Internal.Types.ZonkAny 0) - @(GHC.Internal.Types.ZonkAny 1) + @(GHC.Internal.Types.UnusedType 0 "a") + @(GHC.Internal.Types.UnusedType 1 "b") (bx `cast` (SelCo:Fun(arg) (Sub (Sym v2)) :: SmallArray# (HashMap k a) - ~R# GHC.Internal.Types.ZonkAny 0)) + ~R# GHC.Internal.Types.UnusedType 0 "a")) (bx1 `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) :: SmallArray# (HashMap k b) - ~R# GHC.Internal.Types.ZonkAny 1)) + ~R# GHC.Internal.Types.UnusedType 1 "b")) of { - __DEFAULT -> - joinrec { - go [Occ=LoopBreakerT[1]] :: Int -> Bool - [LclId[JoinId(1)(Nothing)], Arity=1, Str=<L>, Unf=OtherCon []] - go (i :: Int) - = case GHC.Internal.Classes.ltInt i (GHC.Internal.Types.I# 0#) of { - False -> - case i of { I# i# -> - case indexSmallArray# @Lifted @(HashMap k a) bx i# of - { (# ipv [Occ=Once1] #) -> - case indexSmallArray# @Lifted @(HashMap k b) bx1 i# of - { (# ipv1 [Occ=Once1] #) -> - case T26615a.$wdisjointSubtrees - @k @a @b $dEq (+# ww 5#) ipv ipv1 - of { - False -> GHC.Internal.Types.False; - True -> jump go (GHC.Internal.Types.I# (-# i# 1#)) - } - } - } - }; - True -> GHC.Internal.Types.True - }; } in - jump go (GHC.Internal.Types.I# 31#); + __DEFAULT -> jump go (GHC.Internal.Types.I# 31#); 1# -> GHC.Internal.Types.False } } @@ -1385,7 +1269,7 @@ T26615a.$wdisjointSubtrees join { fail [Dmd=MC(1,L)] :: (# #) -> Bool [LclId[JoinId(1)(Nothing)], Arity=1, Str=<A>, Unf=OtherCon []] - fail _ [Occ=Dead, OS=OneShot] + fail (ds1 [Occ=Dead, OS=OneShot] :: (# #)) = case _b of { __DEFAULT -> case lvl1 of {}; Empty -> GHC.Internal.Types.True; @@ -1508,7 +1392,7 @@ T26615a.$wdisjointSubtrees }; Collision bx bx1 -> T26615a.disjointSubtrees_$s$wdisjointSubtrees - @a @b @k bx bx1 ww $dEq ds + @k @b @a $dEq ww bx bx1 ds } } in case ds of { Empty -> GHC.Internal.Types.True; @@ -1661,7 +1545,7 @@ T26615a.$wdisjointSubtrees of { (# ipv #) -> T26615a.disjointSubtrees_$s$wdisjointSubtrees - @b @a @k bx bx1 (+# ww 5#) $dEq ipv + @k @a @b $dEq (+# ww 5#) bx bx1 ipv }; 0## -> GHC.Internal.Types.True }; @@ -1674,7 +1558,7 @@ T26615a.$wdisjointSubtrees of { (# ipv #) -> T26615a.disjointSubtrees_$s$wdisjointSubtrees - @b @a @k bx bx1 (+# ww 5#) $dEq ipv + @k @a @b $dEq (+# ww 5#) bx bx1 ipv } }; BitmapIndexed bx bx1 -> @@ -1686,21 +1570,23 @@ T26615a.$wdisjointSubtrees case GHC.Internal.Unsafe.Coerce.unsafeEqualityProof @(*) @(SmallArray# (HashMap k a) -> SmallArray# (HashMap k b) -> Int#) - @(GHC.Internal.Types.ZonkAny 0 - -> GHC.Internal.Types.ZonkAny 1 -> Int#) + @(GHC.Internal.Types.UnusedType 0 "a" + -> GHC.Internal.Types.UnusedType 1 "b" -> Int#) of { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> case reallyUnsafePtrEquality# @Lifted @Lifted - @(GHC.Internal.Types.ZonkAny 0) - @(GHC.Internal.Types.ZonkAny 1) + @(GHC.Internal.Types.UnusedType 0 "a") + @(GHC.Internal.Types.UnusedType 1 "b") (bx1 `cast` (SelCo:Fun(arg) (Sub (Sym v2)) - :: SmallArray# (HashMap k a) ~R# GHC.Internal.Types.ZonkAny 0)) + :: SmallArray# (HashMap k a) + ~R# GHC.Internal.Types.UnusedType 0 "a")) (bx3 `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) - :: SmallArray# (HashMap k b) ~R# GHC.Internal.Types.ZonkAny 1)) + :: SmallArray# (HashMap k b) + ~R# GHC.Internal.Types.UnusedType 1 "b")) of { __DEFAULT -> let { @@ -1829,21 +1715,23 @@ T26615a.$wdisjointSubtrees case GHC.Internal.Unsafe.Coerce.unsafeEqualityProof @(*) @(SmallArray# (HashMap k a) -> SmallArray# (HashMap k b) -> Int#) - @(GHC.Internal.Types.ZonkAny 0 - -> GHC.Internal.Types.ZonkAny 1 -> Int#) + @(GHC.Internal.Types.UnusedType 0 "a" + -> GHC.Internal.Types.UnusedType 1 "b" -> Int#) of { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> case reallyUnsafePtrEquality# @Lifted @Lifted - @(GHC.Internal.Types.ZonkAny 0) - @(GHC.Internal.Types.ZonkAny 1) + @(GHC.Internal.Types.UnusedType 0 "a") + @(GHC.Internal.Types.UnusedType 1 "b") (bx `cast` (SelCo:Fun(arg) (Sub (Sym v2)) - :: SmallArray# (HashMap k a) ~R# GHC.Internal.Types.ZonkAny 0)) + :: SmallArray# (HashMap k a) + ~R# GHC.Internal.Types.UnusedType 0 "a")) (bx1 `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) - :: SmallArray# (HashMap k b) ~R# GHC.Internal.Types.ZonkAny 1)) + :: SmallArray# (HashMap k b) + ~R# GHC.Internal.Types.UnusedType 1 "b")) of { __DEFAULT -> let { @@ -1910,88 +1798,72 @@ disjointSubtrees ------ Local rules for imported ids -------- "SC:$wdisjointSubtrees1" [1] - forall (@a) + forall (@k) (@b) - (@k) - (sc :: Word#) - (sc1 :: SmallArray# (Leaf k a)) + (@a) + (sc :: Eq k) + (sc1 :: Int#) (sc2 :: Word#) (sc3 :: SmallArray# (Leaf k b)) - (sc4 :: Int#) - (sc5 :: Eq k). + (sc4 :: Word#) + (sc5 :: SmallArray# (Leaf k a)). T26615a.$wdisjointSubtrees @k @b @a - sc5 - sc4 + sc + sc1 (T26615a.Collision @k @b sc2 sc3) - (T26615a.Collision @k @a sc sc1) + (T26615a.Collision @k @a sc4 sc5) = T26615a.$wdisjointCollisions - @k @b @a sc5 sc2 (T26615a.Array @(Leaf k b) sc3) sc sc1 + @k @b @a sc sc2 (T26615a.Array @(Leaf k b) sc3) sc4 sc5 "SC:$wdisjointSubtrees0" [1] - forall (@b) + forall (@k) (@a) - (@k) - (sc :: Word#) - (sc1 :: SmallArray# (Leaf k a)) - (sc2 :: Int#) - (sc3 :: Eq k). + (@b) + (sc :: Eq k) + (sc1 :: Int#) + (sc2 :: Word#) + (sc3 :: SmallArray# (Leaf k a)). T26615a.$wdisjointSubtrees @k @a @b - sc3 - sc2 - (T26615a.Collision @k @a sc sc1) + sc + sc1 + (T26615a.Collision @k @a sc2 sc3) = T26615a.disjointSubtrees_$s$wdisjointSubtrees - @b @a @k sc sc1 sc2 sc3 + @k @a @b sc sc1 sc2 sc3 [2 of 2] Compiling T26615 ( T26615.hs, T26615.o ) ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 614, types: 666, coercions: 18, joins: 8/14} + = {terms: 614, types: 682, coercions: 18, joins: 8/14} -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615.$trModule2 :: GHC.Internal.Prim.Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 30 0}] -T26615.$trModule2 = "T26615"# +$trModule1 :: GHC.Internal.Prim.Addr# +[GblId, Unf=OtherCon []] +$trModule1 = "T26615"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615.$trModule1 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615.$trModule1 = GHC.Internal.Types.TrNameS T26615.$trModule2 +$trModule2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$trModule2 = GHC.Internal.Types.TrNameS $trModule1 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26615.$trModule4 :: GHC.Internal.Prim.Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 20 0}] -T26615.$trModule4 = "main"# +$trModule3 :: GHC.Internal.Prim.Addr# +[GblId, Unf=OtherCon []] +$trModule3 = "main"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26615.$trModule3 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615.$trModule3 = GHC.Internal.Types.TrNameS T26615.$trModule4 +$trModule4 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$trModule4 = GHC.Internal.Types.TrNameS $trModule3 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T26615.$trModule :: GHC.Internal.Types.Module -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26615.$trModule - = GHC.Internal.Types.Module T26615.$trModule3 T26615.$trModule1 +T26615.$trModule [InlPrag=[~]] :: GHC.Internal.Types.Module +[GblId, Unf=OtherCon []] +T26615.$trModule = GHC.Internal.Types.Module $trModule4 $trModule2 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} lvl :: GHC.Internal.Prim.Addr# @@ -2128,7 +2000,7 @@ $wpoly_lookupCont_ end Rec } Rec { --- RHS size: {terms: 448, types: 507, coercions: 18, joins: 8/13} +-- RHS size: {terms: 448, types: 523, coercions: 18, joins: 8/13} T26615.$s$wdisjointSubtrees [InlPrag=[~], Occ=LoopBreaker] :: forall a b. GHC.Internal.Prim.Int# @@ -2143,7 +2015,7 @@ T26615.$s$wdisjointSubtrees join { fail [Dmd=MC(1,L)] :: (# #) -> Bool [LclId[JoinId(1)(Nothing)], Arity=1, Str=<A>, Unf=OtherCon []] - fail _ [Occ=Dead, OS=OneShot] + fail (ds1 [Occ=Dead, OS=OneShot] :: (# #)) = case _b of wild { __DEFAULT -> case lvl1 of {}; T26615a.Empty -> GHC.Internal.Types.True; @@ -2190,30 +2062,28 @@ T26615.$s$wdisjointSubtrees $s$wfoldr_ [InlPrag=[2], Occ=LoopBreaker, Dmd=SC(S,C(1,C(1,C(1,L))))] - :: Bool - -> GHC.Internal.Prim.Int# - -> GHC.Internal.Prim.Int# - -> GHC.Internal.Prim.SmallArray# (T26615a.Leaf [Char] a) - -> Bool + :: GHC.Internal.Prim.SmallArray# (T26615a.Leaf [Char] a) + -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.Int# -> Bool -> Bool [LclId[JoinId(4)(Nothing)], Arity=4, Str=<L><L><L><L>, Unf=OtherCon []] - $s$wfoldr_ (sc :: Bool) + $s$wfoldr_ (sc + :: GHC.Internal.Prim.SmallArray# (T26615a.Leaf [Char] a)) (sc1 :: GHC.Internal.Prim.Int#) (sc2 :: GHC.Internal.Prim.Int#) - (sc3 :: GHC.Internal.Prim.SmallArray# (T26615a.Leaf [Char] a)) - = case GHC.Internal.Prim.>=# sc1 sc2 of { + (sc3 :: Bool) + = case GHC.Internal.Prim.>=# sc2 sc1 of { __DEFAULT -> case GHC.Internal.Prim.indexSmallArray# - @GHC.Internal.Types.Lifted @(T26615a.Leaf String a) sc3 sc1 + @GHC.Internal.Types.Lifted @(T26615a.Leaf String a) sc sc2 of { (# ipv1 #) -> case ipv1 of { T26615a.L kA ds2 -> join { $j :: Bool [LclId[JoinId(0)(Nothing)]] - $j = jump $s$wfoldr_ sc (GHC.Internal.Prim.+# sc1 1#) sc2 sc3 } in + $j = jump $s$wfoldr_ sc sc1 (GHC.Internal.Prim.+# sc2 1#) sc3 } in joinrec { $wlookupInArrayCont_ [InlPrag=[2], Occ=LoopBreaker, @@ -2258,14 +2128,14 @@ T26615.$s$wdisjointSubtrees jump $wlookupInArrayCont_ kA bx3 0# lvl2 } }; - 1# -> sc + 1# -> sc3 }; } in jump $s$wfoldr_ - GHC.Internal.Types.True - 0# + bx1 (GHC.Internal.Prim.sizeofSmallArray# @GHC.Internal.Types.Lifted @(T26615a.Leaf String a) bx1) - bx1 + 0# + GHC.Internal.Types.True }; T26615a.BitmapIndexed bx2 bx3 -> let { @@ -2317,23 +2187,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.ZonkAny 0 - -> GHC.Internal.Types.ZonkAny 1 -> GHC.Internal.Prim.Int#) + @(GHC.Internal.Types.UnusedType 0 "a" + -> GHC.Internal.Types.UnusedType 1 "b" -> 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.ZonkAny 0) - @(GHC.Internal.Types.ZonkAny 1) + @(GHC.Internal.Types.UnusedType 0 "a") + @(GHC.Internal.Types.UnusedType 1 "b") (bx1 `cast` (SelCo:Fun(arg) (Sub (Sym v2)) :: GHC.Internal.Prim.SmallArray# (HashMap String a) - ~R# GHC.Internal.Types.ZonkAny 0)) + ~R# GHC.Internal.Types.UnusedType 0 "a")) (bx3 `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) :: GHC.Internal.Prim.SmallArray# (HashMap String b) - ~R# GHC.Internal.Types.ZonkAny 1)) + ~R# GHC.Internal.Types.UnusedType 1 "b")) of { __DEFAULT -> joinrec { @@ -2495,23 +2365,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.ZonkAny 0 - -> GHC.Internal.Types.ZonkAny 1 -> GHC.Internal.Prim.Int#) + @(GHC.Internal.Types.UnusedType 0 "a" + -> GHC.Internal.Types.UnusedType 1 "b" -> 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.ZonkAny 0) - @(GHC.Internal.Types.ZonkAny 1) + @(GHC.Internal.Types.UnusedType 0 "a") + @(GHC.Internal.Types.UnusedType 1 "b") (bx `cast` (SelCo:Fun(arg) (Sub (Sym v2)) :: GHC.Internal.Prim.SmallArray# (HashMap String a) - ~R# GHC.Internal.Types.ZonkAny 0)) + ~R# GHC.Internal.Types.UnusedType 0 "a")) (bx1 `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) :: GHC.Internal.Prim.SmallArray# (HashMap String b) - ~R# GHC.Internal.Types.ZonkAny 1)) + ~R# GHC.Internal.Types.UnusedType 1 "b")) of { __DEFAULT -> joinrec { @@ -2564,7 +2434,7 @@ f = \ (@a) ------ Local rules for imported ids -------- "SPEC/T26615 $wdisjointSubtrees @String @_ @_" [2] - forall (@a) (@b) ($dEq :: Eq String). + forall (@a) (@b) ($dEq [Occ=Dead] :: Eq String). T26615a.$wdisjointSubtrees @String @a @b $dEq = T26615.$s$wdisjointSubtrees @a @b ===================================== testsuite/tests/typecheck/should_fail/T13292.stderr ===================================== @@ -14,15 +14,15 @@ T13292a.hs:4:12: warning: [GHC-39999] [-Wdeferred-type-errors (in -Wdefault)] In an equation for ‘someFunc’: someFunc = return () T13292.hs:6:1: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)] - • Couldn't match type ‘GHC.Internal.Types.ZonkAny 0’ with ‘IO’ + • Couldn't match type ‘m0_0’ with ‘IO’ Expected: IO () - Actual: GHC.Internal.Types.ZonkAny 0 () + Actual: m0_0 () • When checking the type of the IO action ‘main’ T13292.hs:6:1: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)] - • Couldn't match type ‘GHC.Internal.Types.ZonkAny 0’ with ‘IO’ + • Couldn't match type ‘m0_0’ with ‘IO’ Expected: IO () - Actual: GHC.Internal.Types.ZonkAny 0 () + Actual: m0_0 () • In the expression: main When checking the type of the IO action ‘main’ ===================================== testsuite/tests/typecheck/should_fail/T27390-explicit-kinds.stderr ===================================== @@ -0,0 +1,28 @@ +T27390a.hs:4:12: warning: [GHC-39999] [-Wdeferred-type-errors (in -Wdefault)] + • Ambiguous type variable ‘m0’ arising from a use of ‘return’ + prevents the constraint ‘(Monad m0)’ from being solved. + Relevant bindings include + someFunc :: m0 () (bound at T27390a.hs:4:1) + Probable fix: use a type annotation to specify what ‘m0’ should be. + Potentially matching instances: + instance Monad IO -- Defined in ‘GHC.Internal.Base’ + instance Monad Maybe -- Defined in ‘GHC.Internal.Base’ + ...plus six others + ...plus one instance involving out-of-scope types + (use -fprint-potential-instances to see them all) + • In the expression: return () + In an equation for ‘someFunc’: someFunc = return () + +T27390.hs:6:1: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)] + • Couldn't match type ‘m0_0 :: Type -> Type’ with ‘IO’ + Expected: IO () + Actual: (m0_0 :: Type -> Type) () + • When checking the type of the IO action ‘main’ + +T27390.hs:6:1: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)] + • Couldn't match type ‘m0_0 :: Type -> Type’ with ‘IO’ + Expected: IO () + Actual: (m0_0 :: Type -> Type) () + • In the expression: main + When checking the type of the IO action ‘main’ + ===================================== testsuite/tests/typecheck/should_fail/T27390.hs ===================================== @@ -0,0 +1,6 @@ +{-# language NoStarIsType #-} +module Main where + +import T27390a + +main = someFunc ===================================== testsuite/tests/typecheck/should_fail/T27390.stderr ===================================== @@ -0,0 +1,28 @@ +T27390a.hs:4:12: warning: [GHC-39999] [-Wdeferred-type-errors (in -Wdefault)] + • Ambiguous type variable ‘m0’ arising from a use of ‘return’ + prevents the constraint ‘(Monad m0)’ from being solved. + Relevant bindings include + someFunc :: m0 () (bound at T27390a.hs:4:1) + Probable fix: use a type annotation to specify what ‘m0’ should be. + Potentially matching instances: + instance Monad IO -- Defined in ‘GHC.Internal.Base’ + instance Monad Maybe -- Defined in ‘GHC.Internal.Base’ + ...plus six others + ...plus one instance involving out-of-scope types + (use -fprint-potential-instances to see them all) + • In the expression: return () + In an equation for ‘someFunc’: someFunc = return () + +T27390.hs:6:1: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)] + • Couldn't match type ‘m0_0’ with ‘IO’ + Expected: IO () + Actual: m0_0 () + • When checking the type of the IO action ‘main’ + +T27390.hs:6:1: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)] + • Couldn't match type ‘m0_0’ with ‘IO’ + Expected: IO () + Actual: m0_0 () + • In the expression: main + When checking the type of the IO action ‘main’ + ===================================== testsuite/tests/typecheck/should_fail/T27390a.hs ===================================== @@ -0,0 +1,4 @@ +module T27390a where + + +someFunc = return () ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -448,6 +448,8 @@ test('T13075', normal, compile_fail, ['']) test('LevPolyBounded', normal, compile_fail, ['']) test('T13487', normal, compile, ['']) test('T13292', normal, multimod_compile, ['T13292', '-v0 -fdefer-type-errors']) +test('T27390', normal, multimod_compile, ['T27390', '-v0 -fdefer-type-errors']) +test('T27390-explicit-kinds', [extra_files(['T27390.hs', 'T27390a.hs'])], multimod_compile, ['T27390', '-v0 -fdefer-type-errors -fprint-explicit-kinds']) test('T13300', normal, compile_fail, ['']) test('T13311', normal, compile_fail, ['']) test('T13446', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/514044cbb166a55c91372636dc807bd… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/514044cbb166a55c91372636dc807bd… You're receiving this email because of your account on gitlab.haskell.org.

1 0