- ghc-commits - Haskell.org

[Git][ghc/ghc][wip/davide/windows-dlls] WIP place SRT info tables into .rdata on windows
by David Eichmann (＠DavidEichmann) 18 Jun '26

18 Jun '26

David Eichmann pushed to branch wip/davide/windows-dlls at Glasgow Haskell Compiler / GHC Commits: 87282f89 by David Eichmann at 2026-06-18T17:07:56+01:00 WIP place SRT info tables into .rdata on windows - - - - - 2 changed files: - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs Changes: ===================================== compiler/GHC/Cmm/CLabel.hs ===================================== @@ -106,6 +106,7 @@ module GHC.Cmm.CLabel ( labelDynamic, isLocalCLabel, mayRedirectTo, + isSRTInfoLabel, isInfoTableLabel, isCmmInfoTableLabel, isConInfoTableLabel, @@ -730,6 +731,27 @@ mkOutOfBoundsAccessLabel = mkForeignLabel (fsLit "rtsOutOfBoundsAccess") mkMemcpyRangeOverlapLabel = mkForeignLabel (fsLit "rtsMemcpyRangeOverlap") ForeignLabelInExternalPackage ForeignLabelIsFunction mkMUT_VAR_CLEAN_infoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_MUT_VAR_CLEAN") CmmInfo +isSRTInfoLabel :: CLabel -> Bool +isSRTInfoLabel clbl = case clbl of + CmmLabel _ _ lbl CmmInfo -> + lbl == fsLit "stg_SRT_1" + || lbl == fsLit "stg_SRT_2" + || lbl == fsLit "stg_SRT_3" + || lbl == fsLit "stg_SRT_4" + || lbl == fsLit "stg_SRT_5" + || lbl == fsLit "stg_SRT_6" + || lbl == fsLit "stg_SRT_7" + || lbl == fsLit "stg_SRT_8" + || lbl == fsLit "stg_SRT_9" + || lbl == fsLit "stg_SRT_10" + || lbl == fsLit "stg_SRT_11" + || lbl == fsLit "stg_SRT_12" + || lbl == fsLit "stg_SRT_13" + || lbl == fsLit "stg_SRT_14" + || lbl == fsLit "stg_SRT_15" + || lbl == fsLit "stg_SRT_16" + _ -> False + mkSRTInfoLabel :: Int -> CLabel mkSRTInfoLabel n = CmmLabel rtsUnitId (NeedExternDecl False) lbl CmmInfo where ===================================== compiler/GHC/CmmToAsm/X86/Ppr.hs ===================================== @@ -33,7 +33,7 @@ import GHC.CmmToAsm.Ppr import GHC.Cmm hiding (topInfoTable) import GHC.Cmm.Dataflow.Label import GHC.Cmm.BlockId -import GHC.Cmm.CLabel +import GHC.Cmm.CLabel as CLabel import GHC.Cmm.InitFini import GHC.Cmm.DebugBlock (pprUnwindTable) @@ -96,10 +96,18 @@ pprNatCmmDecl config proc@(CmmProc top_info entry_lbl _ (ListGraph blocks)) = ) | otherwise = (empty,empty) + section = case top_info_table of + Just (CmmStaticsRaw info_lbl _) + | platformOS platform == OSMinGW32 + && externallyVisibleCLabel info_lbl + && isSRTInfoLabel info_lbl + -> ReadOnlyData + _ -> Text + in vcat [ -- section directive. Requires proc_lbl when split-section is enabled to -- use as a subsection name. - pprSectionAlign config (Section Text proc_lbl) + pprSectionAlign config (Section section proc_lbl) -- section alignment. Note that when there is an info table, we align the -- info table and not the entry code! View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/87282f890746b47beeac32620da58b2… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/87282f890746b47beeac32620da58b2… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/dcoutts/io-manager-tidy
by Duncan Coutts (＠dcoutts) 18 Jun '26

18 Jun '26

Duncan Coutts pushed new branch wip/dcoutts/io-manager-tidy at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/dcoutts/io-manager-tidy 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: Desugar a `case` scrutinee only once (#27383, #20251)
by Marge Bot (＠marge-bot) 18 Jun '26

18 Jun '26

Marge Bot pushed to branch wip/marge_bot_batch_merge_job 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`. - - - - - 86128b91 by Alan Zimmerman at 2026-06-18T10:00:50-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 - - - - - 4cc795c7 by Simon Jakobi at 2026-06-18T10:00:51-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> - - - - - 58 changed files: - .gitlab/ci.sh - + changelog.d/fix-exponential-case-desugar-27383 - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.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/PostProcess.hs - compiler/GHC/Parser/PostProcess/Haddock.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Zonk/Type.hs - compiler/GHC/ThToHs.hs - compiler/Language/Haskell/Syntax/Binds.hs - compiler/Language/Haskell/Syntax/Decls.hs - compiler/Language/Haskell/Syntax/Pat.hs - compiler/Language/Haskell/Syntax/Type.hs - + testsuite/tests/deSugar/should_compile/T27383.hs - testsuite/tests/deSugar/should_compile/all.T - testsuite/tests/ghc-api/exactprint/Test20239.stderr - testsuite/tests/haddock/should_compile_flag_haddock/T24221.stderr - testsuite/tests/parser/should_compile/DumpParsedAst.stderr - testsuite/tests/parser/should_compile/DumpRenamedAst.stderr - testsuite/tests/parser/should_compile/T14189.stderr - testsuite/tests/parser/should_compile/T20452.stderr - testsuite/tests/printer/Test24533.stdout - utils/check-exact/ExactPrint.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 The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0c3f3bc8d7bb1e385ed92761c185ba… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0c3f3bc8d7bb1e385ed92761c185ba… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/andreask/fix-prof-segv] Add test for T27123
by Andreas Klebinger (＠AndreasK) 18 Jun '26

18 Jun '26

Andreas Klebinger pushed to branch wip/andreask/fix-prof-segv at Glasgow Haskell Compiler / GHC Commits: 7b2cd708 by Andreas Klebinger at 2026-06-18T13:22:24+00:00 Add test for T27123 - - - - - 2 changed files: - + testsuite/tests/rts/T27123.hs - testsuite/tests/rts/all.T Changes: ===================================== testsuite/tests/rts/T27123.hs ===================================== @@ -0,0 +1,65 @@ +{-# OPTIONS_GHC -fno-full-laziness -fno-worker-wrapper #-} +{-# LANGUAGE MagicHash, UnboxedTuples #-} + +-- This test checks that the auto-apply code (stg_ap_0_fast, stg_ap_p) is robust +-- against another thread or the GC evaluating a closure at the same time. + +module Main + -- (main) +where + +import Control.Monad +import Control.Concurrent +import System.IO +import GHC.Data.SmallArray +import GHC.Exts +import GHC.IO + +type Arr = SmallMutableArray RealWorld (Int->Int) + +io :: (State# RealWorld -> (# State# RealWorld, a #)) -> IO a +io f = IO f + +io_ :: (State# RealWorld -> State# RealWorld ) -> IO () +io_ f = IO (\s -> case f s of s2 -> (# s2, () #)) + +{-# NOINLINE readSmallArray #-} +readSmallArray (SmallMutableArray arr) (I# idx) = IO $ \s -> case readSmallArray# arr idx s of + (# s2, r #) -> (# s2, r #) + +-- Continually overwrites the array with unevaluated thunks that will evaluated to +-- a PAP under profiling. +{-# NOINLINE mkThunks #-} +mkThunks :: Arr -> IO () +mkThunks arr = do + forever $ do + yield + forM_ [0..100] $ \_j -> do + forM_ [0..5 :: Int] $ \i -> do + -- With profiling results in a thunk that will evaluate to a PAP capturing the SCC + let g = {-# SCC g #-} succ + io_ (writeSmallArray arr i g) + +-- Evaluate the array repeatedly in the given order. +{-# NOINLINE evaluateThunks #-} +evaluateThunks :: Arr -> [Int] -> IO () +evaluateThunks arr idxs = do + forever $ do + yield + -- putStr "." >> hFlush stdout + forM [0..5000::Int] $ \j -> do + forM_ idxs $ \i -> do + !g <- readSmallArray arr i + seq (g i) (pure ()) + +main :: IO () +main = do + -- We spawn three threads. Two are evaluating the thunks in the array in opposite directions + -- One thread is + arr <- io (newSmallArray 6 (id)) + _ <- forkIO $ do + evaluateThunks arr [0..5] + _ <- forkIO $ do + evaluateThunks arr [5,4..0] + forkIO $ mkThunks arr + threadDelay 30_000_000 ===================================== testsuite/tests/rts/all.T ===================================== @@ -687,3 +687,5 @@ test('ClosureTable', ['-debug -O0 ClosureTable_c.c -I{top}/../rts -I{top}/../rts/include']) test('resizeMutableByteArrayInPlace', [req_cmm, extra_ways(['optasm', 'sanity']), only_ways(['optasm', 'sanity'])], compile_and_run, ['']) + +test('T27123', [extra_ways(['optasm', 'prof'])], compile_and_run, ['']) \ No newline at end of file View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7b2cd708432924f5ed1be2d519097c0… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7b2cd708432924f5ed1be2d519097c0… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/andreask/fix-prof-segv] 3 commits: StgToCmm: Don't assume tagged FUN closures in closureCodeBody
by Andreas Klebinger (＠AndreasK) 18 Jun '26

18 Jun '26

Andreas Klebinger pushed to branch wip/andreask/fix-prof-segv at Glasgow Haskell Compiler / GHC Commits: 208b1d42 by Andreas Klebinger at 2026-06-18T12:36:24+00:00 StgToCmm: Don't assume tagged FUN closures in closureCodeBody When entering a closure the self/node pointer might not be tagged. So AND the tag bits away rather than subtracting the expected tag. - - - - - 688fea6e by Andreas Klebinger at 2026-06-18T12:36:24+00:00 profiling: Fix a segfault from a closure evaluating race condition. In stg_ap_0_fast when might need to run GC before entering a thunk. If this happens another thread or the GC itself might mutate the closure making entering it no longer valid. We now check for this. - - - - - 223819ab by Andreas Klebinger at 2026-06-18T12:36:24+00:00 Add test for T27123 - - - - - 4 changed files: - compiler/GHC/StgToCmm/Bind.hs - rts/Apply.cmm - + testsuite/tests/rts/T27123.hs - testsuite/tests/rts/all.T Changes: ===================================== compiler/GHC/StgToCmm/Bind.hs ===================================== @@ -587,9 +587,8 @@ closureCodeBody top_lvl bndr cl_info cc args@(arg0:_) body fv_details -- ticky after heap check to avoid double counting ; tickyEnterFun cl_info ; enterCostCentreFun cc - (CmmMachOp (mo_wordSub platform) - [ CmmReg (CmmLocal node) -- See [NodeReg clobbered with loopification] - , mkIntExpr platform (toTargetInt (fromDynTag (funTag platform cl_info))) ]) + (cmmUntag platform (CmmReg (CmmLocal node))) -- See [NodeReg clobbered with loopification] + ; fv_bindings <- mapM bind_fv fv_details -- Load free vars out of closure *after* -- heap check, to reduce live vars over check ===================================== rts/Apply.cmm ===================================== @@ -99,12 +99,14 @@ again: W_ info; P_ untaggedfun; W_ arity; + W_ closure_type; // We must obey the correct heap object observation pattern in // Note [Heap memory barriers] in SMP.h. untaggedfun = UNTAG(fun); info = %INFO_PTR(untaggedfun); + closure_type = TO_W_( %INFO_TYPE(%STD_INFO(info)) ); switch [INVALID_OBJECT .. N_CLOSURE_TYPES] - (TO_W_( %INFO_TYPE(%STD_INFO(info)) )) { + (closure_type) { case IND, IND_STATIC: @@ -212,10 +214,19 @@ again: // We can't use the value of 'info' any more, because if // STK_CHK_GEN() did a GC then the closure we're looking // at may have changed, e.g. a THUNK_SELECTOR may have - // been evaluated by the GC. So we reload the info - // pointer now. + // been evaluated by the GC. + // We always reload reload the info pointer now. And if + // the closure type changed we need to take a different case + // alt altogether so we retry from the start in that case. + untaggedfun = UNTAG(fun); info = %INFO_PTR(untaggedfun); + if(closure_type != TO_W_( %INFO_TYPE(%STD_INFO(info)) ) ) + { + // ccall printf("closure type changed! (%d, %d)\n" + // , closure_type, TO_W_( %INFO_TYPE(%STD_INFO(info)) )); + goto again; + } jump %ENTRY_CODE(info) (stg_restore_cccs_eval_info, CCCS) ===================================== testsuite/tests/rts/T27123.hs ===================================== @@ -0,0 +1,66 @@ +{-# OPTIONS_GHC -ddump-cmm -ddump-stg-final -ddump-to-file -dsuppress-ticks #-} +{-# OPTIONS_GHC -fno-full-laziness -fno-worker-wrapper #-} +{-# LANGUAGE MagicHash, UnboxedTuples #-} + +-- This test checks that the auto-apply code (stg_ap_0_fast, stg_ap_p) is robust +-- against another thread or the GC evaluating a closure at the same time. + +module Main + -- (main) +where + +import Control.Monad +import Control.Concurrent +import System.IO +import GHC.Data.SmallArray +import GHC.Exts +import GHC.IO + +type Arr = SmallMutableArray RealWorld (Int->Int) + +io :: (State# RealWorld -> (# State# RealWorld, a #)) -> IO a +io f = IO f + +io_ :: (State# RealWorld -> State# RealWorld ) -> IO () +io_ f = IO (\s -> case f s of s2 -> (# s2, () #)) + +{-# NOINLINE readSmallArray #-} +readSmallArray (SmallMutableArray arr) (I# idx) = IO $ \s -> case readSmallArray# arr idx s of + (# s2, r #) -> (# s2, r #) + +-- Continually overwrites the array with unevaluated thunks that will evaluated to +-- a PAP under profiling. +{-# NOINLINE mkThunks #-} +mkThunks :: Arr -> IO () +mkThunks arr = do + forever $ do + yield + forM_ [0..100] $ \_j -> do + forM_ [0..5 :: Int] $ \i -> do + -- With profiling results in a thunk that will evaluate to a PAP capturing the SCC + let g = {-# SCC g #-} succ + io_ (writeSmallArray arr i g) + +-- Evaluate the array repeatedly in the given order. +{-# NOINLINE evaluateThks #-} +evaluateThks :: Arr -> [Int] -> IO () +evaluateThks arr idxs = do + forever $ do + yield + -- putStr "." >> hFlush stdout + forM [0..5000::Int] $ \j -> do + forM_ idxs $ \i -> do + !g <- readSmallArray arr i + seq (g i) (pure ()) + +main :: IO () +main = do + -- We spawn three threads. Two are evaluating the thunks in the array in opposite directions + -- One thread is + arr <- io (newSmallArray 6 (id)) + _ <- forkIO $ do + evaluateThks arr [0..5] + _ <- forkIO $ do + evaluateThks arr [5,4..0] + forkIO $ mkThunks arr + threadDelay 30_000_000 ===================================== testsuite/tests/rts/all.T ===================================== @@ -687,3 +687,5 @@ test('ClosureTable', ['-debug -O0 ClosureTable_c.c -I{top}/../rts -I{top}/../rts/include']) test('resizeMutableByteArrayInPlace', [req_cmm, extra_ways(['optasm', 'sanity']), only_ways(['optasm', 'sanity'])], compile_and_run, ['']) + +test('T27123', [extra_ways(['optasm', 'prof'])], compile_and_run, ['']) \ No newline at end of file View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/23401b4321946170c117be02ded140… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/23401b4321946170c117be02ded140… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/mangoiv/backport-unused-type] backport unused type
by Magnus (＠MangoIV) 18 Jun '26

18 Jun '26

Magnus pushed to branch wip/mangoiv/backport-unused-type at Glasgow Haskell Compiler / GHC Commits: b158f89b by mangoiv at 2026-06-18T13:35:00+02:00 backport unused type - - - - - 8 changed files: - 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 Changes: ===================================== compiler/GHC/Builtin/Names.hs ===================================== @@ -2007,8 +2007,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 ===================================== @@ -92,7 +92,7 @@ module GHC.Builtin.Types ( cTupleSelId, cTupleSelIdName, -- * Any - anyTyCon, anyTy, anyTypeOfKind, zonkAnyTyCon, + anyTyCon, anyTy, anyTypeOfKind, unusedTypeTyCon, -- * Recovery TyCon makeRecoveryTyCon, @@ -310,7 +310,7 @@ wiredInTyCons = map (dataConTyCon . snd) boxingDataCons , soloTyCon , anyTyCon - , zonkAnyTyCon + , unusedTypeTyCon , boolTyCon , charTyCon , stringTyCon @@ -421,13 +421,13 @@ doubleDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "D#") {- Note [Any types] ~~~~~~~~~~~~~~~~ -The type constructors `Any` and `ZonkAny` are closed type families declared thus: +The type constructors `Any` and `UnusedType` are closed type families declared thus: - 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. Nat -> 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 +what that type is. The leading example is this: `UnusedType` is used to instantiate un-constrained type variables after type checking. For example, consider the term (length [] :: Int), where @@ -440,26 +440,26 @@ The typechecker will end up with length @alpha ([] @alpha) 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 +that unconstrained `alpha` to an arbitrary type (UnusedType @Type 3 "a"), where the `3` is +arbitrary (see wrinkle (Any5) below). and `a` is the original name, if we have one. +This is done in `GHC.Tc.Zonk.Type.commitFlexi`. So we end up with - length @(ZonkAny @Type 3) ([] @(ZonkAny @Type 3)) + length @(UnusedType @Type 3 "a") ([] @(UnusedType @Type 3 "a")) -`Any` and `ZonkAny` differ only in the presence of the `Nat` argument; see -wrinkle (Any4). +`Any` and `UnusedType` differ only in the presence of the `Nat` and the `Symbol` arguments; +see wrinkle (Any4). Wrinkles: -(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 * +(Any1) `Any` and `UnusedType` are kind polymorphic since in some program we may + need to use `UnusedType` 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 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 @@ -469,7 +469,7 @@ Wrinkles: the code generator, because the code gen may /enter/ a data value but never enters a function value. -(Any4) `ZonkAny` takes a `Nat` argument so that we can readily make up /distinct/ +(Any4) `UnusedType` takes a `Nat` argument so that we can readily make up /distinct/ types (#24817). Consider data SBool a where { STrue :: SBool True; SFalse :: SBool False } @@ -484,17 +484,29 @@ 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 4 "a" and beta := UnusedType @Type k 5 "b" (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 + `UnusedType` takes a `Symbol` argument so we can neatly display the type to the user. + While `UnusedType` ought to be an implementation detail, we sometimes leak it to the + user, especially in consumers of the GHC api like haskell-language-server. + The user does not know what an `UnusedType` is and just expects a meta variable. + However, since the process of zonking should remove all meta variables, we just try to + reconstruct it when pretty printing, e.g. + `UnusedType 3 "foo" :: Type` becomes `foo_3` + + Historical note: `UnusedType` was called `ZonkAny` in older versions of the compiler + but since this is a leaky abstractions (see above) we give it this improved name + and handle it specially in the pretty printer to avoid confusion of the user. + +(Any5) `Any` and `UnusedType` 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 @@ -502,7 +514,7 @@ Wrinkles: 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. + Currently `UnusedType` is not available to users; but it could easily be. (Any7) Properties of `Any`: * When `Any` is instantiated at a lifted type it is inhabited by at least one value, @@ -521,6 +533,17 @@ Wrinkles: See examples in ghc-prim:GHC.Types +(Any8) Warning 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 } + + where forever :: forall a b. IO a -> IO b + Nothing constrains `b`, so it will be instantiates with `Any` or `UnusedType`. + But we certainly don't want to complain about a discarded do-binding. + 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 bit of history. @@ -547,23 +570,25 @@ 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 +unusedTypeTyCon :: TyCon +-- unusedTypeTyCon :: forall k. Nat -> Symbol -> k -- See Note [Any types] -zonkAnyTyCon = mkFamilyTyCon zonkAnyTyConName - [ mkNamedTyConBinder Specified kv - , mkAnonTyConBinder nat_kv ] - (mkTyVarTy kv) +unusedTypeTyCon = mkFamilyTyCon unusedTypeTyConName bndrs res_kind Nothing (ClosedSynFamilyTyCon Nothing) Nothing NotInjective where - [kv,nat_kv] = mkTemplateKindVars [liftedTypeKind, naturalTy] + [kv,nat_kv,sym_kv] = mkTemplateKindVars [liftedTypeKind, naturalTy, typeSymbolKind] + bndrs = [ mkNamedTyConBinder Specified kv + , mkAnonTyConBinder nat_kv + , mkAnonTyConBinder sym_kv ] + res_kind = mkTyVarTy kv + kind = mkTyConKind bndrs res_kind -- | Make a fake, recovery 'TyCon' from an existing one. -- Used when recovering from errors in type declarations ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -985,9 +985,13 @@ warnDiscardedDoBindings rhs rhs_ty ; when (warn_unused || warn_wrong) $ do { fam_inst_envs <- dsGetFamInstEnvs ; let norm_elt_ty = topNormaliseType fam_inst_envs elt_ty - - -- Warn about discarding non-() things in 'monadic' binding - ; if warn_unused && not (isUnitTy norm_elt_ty) + supressible_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 `()` + -- * `UnusedType` or `Any` type see (Any8) of Note [Any types] + ; 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 #-} {-# LANGUAGE LambdaCase #-} module GHC.Iface.Type ( IfExtName, @@ -1664,6 +1664,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)) @@ -1715,6 +1716,12 @@ pprTyTcApp ctxt_prec tc tys = | Just doc <- ppr_equality ctxt_prec tc (appArgsIfaceTypes tys) -> doc + | ifaceTyConName tc `hasKey` unusedTypeTyConKey + , (arg_k : IfaceLitTy (IfaceNumTyLit arg_n) : IfaceLitTy (IfaceStrTyLit arg_nm) : _) <- appArgsIfaceTypes 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_n arg_nm + | otherwise -> ppr_iface_tc_app ppr_app_arg ctxt_prec tc $ appArgsIfaceTypesForAllTyFlags $ stripInvisArgs (PrintExplicitKinds print_kinds) tys @@ -1727,6 +1734,15 @@ ppr_kind_type ctxt_prec = sdocOption sdocStarIsType $ \case True -> maybeParen ctxt_prec starPrec $ unicodeSyntax (char '★') (char '*') +ppr_iface_unused_ty_tycon :: PprPrec -> IfaceType -> Integer -> LexicalFastString -> SDoc +ppr_iface_unused_ty_tycon ctxt_prec arg_k arg_n arg_nm + = sdocOption sdocPrintExplicitKinds $ \print_kinds -> + sdocOption sdocPrintExplicitRuntimeReps $ \print_reps -> + if print_kinds || print_reps + then maybeParen ctxt_prec sigPrec $ prettyMeta <+> text "::" <+> pprIfaceType arg_k + else prettyMeta + where prettyMeta = ppr arg_nm <> ppr arg_n + -- | Pretty-print a type-level equality. -- Returns (Just doc) if the argument is a /saturated/ application -- of eqTyCon (~) @@ -2113,7 +2129,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 ===================================== @@ -569,7 +569,7 @@ data TcGblEnv -- ^ Allows us to choose unique DFun names. tcg_zany_n :: TcRef Integer, - -- ^ A source of unique identities for ZonkAny instances + -- ^ A source of unique identities for UnusedType instances -- See Note [Any types] in GHC.Builtin.Types, wrinkle (Any4) tcg_merged :: [(Module, Fingerprint)], ===================================== compiler/GHC/Tc/Utils/Monad.hs ===================================== @@ -142,7 +142,7 @@ module GHC.Tc.Utils.Monad( getCCIndexM, getCCIndexTcM, -- * Zonking - liftZonkM, newZonkAnyType, + liftZonkM, newUnusedType, -- * Complete matches localAndImportedCompleteMatches, getCompleteMatchesTcM, @@ -156,7 +156,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.Types -- Re-export all @@ -180,7 +180,7 @@ import GHC.Core.UsageEnv import GHC.Core.Multiplicity import GHC.Core.InstEnv import GHC.Core.FamInstEnv -import GHC.Core.Type( mkNumLitTy ) +import GHC.Core.Type( mkNumLitTy, mkStrLitTy ) import GHC.Driver.Env import GHC.Driver.Session @@ -1792,17 +1792,17 @@ 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 +newUnusedType :: Name -> Kind -> TcM Type +-- Return a type (UnusedType @k n sym), where n is fresh +-- Recall UnusedType :: forall k. Natural -> Symbol -> k -- See Note [Any types] in GHC.Builtin.Types, wrinkle (Any4) -newZonkAnyType kind +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]) } + ; return (mkTyConApp unusedTypeTyCon [kind, mkNumLitTy i, mkStrLitTy $ getOccFS name ]) } getConstraintVar :: TcM (TcRef WantedConstraints) getConstraintVar = do { env <- getLclEnv; return (tcl_lie env) } ===================================== compiler/GHC/Tc/Utils/TcType.hs ===================================== @@ -88,7 +88,7 @@ module GHC.Tc.Utils.TcType ( isSigmaTy, isRhoTy, isRhoExpTy, isOverloadedTy, isFloatingPrimTy, isDoubleTy, isFloatTy, isIntTy, isWordTy, isStringTy, isIntegerTy, isNaturalTy, - isBoolTy, isUnitTy, isCharTy, + isBoolTy, isUnitTy, isAnyTy, isUnusedTypeTy, isCharTy, isTauTy, isTauTyCon, tcIsTyVarTy, isPredTy, isTyVarClassPred, checkValidClsArgs, hasTyVarHead, @@ -2005,7 +2005,7 @@ isFloatTy, isDoubleTy, isFloatPrimTy, isDoublePrimTy, isIntegerTy, isNaturalTy, isIntTy, isWordTy, isBoolTy, - isUnitTy, isCharTy :: Type -> Bool + isUnitTy, isAnyTy, isUnusedTypeTy, isCharTy :: Type -> Bool isFloatTy = is_tc floatTyConKey isDoubleTy = is_tc doubleTyConKey isFloatPrimTy = is_tc floatPrimTyConKey @@ -2016,6 +2016,8 @@ isIntTy = is_tc intTyConKey isWordTy = is_tc wordTyConKey isBoolTy = is_tc boolTyConKey isUnitTy = is_tc unitTyConKey +isAnyTy = is_tc anyTyConKey +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 #-} {-# LANGUAGE GADTs #-} {- @@ -54,7 +55,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.Constraint import GHC.Tc.Types.Evidence import GHC.Tc.Errors.Types @@ -471,7 +472,7 @@ commitFlexi tv 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 } + ; newUnusedType name zonked_kind } RuntimeUnkFlexi -> do { traceTc "Defaulting flexi tyvar to RuntimeUnk:" (pprTyVar tv) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b158f89b9c768379ce0346ef5ee3719… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b158f89b9c768379ce0346ef5ee3719… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/mangoiv/backport-unused-type] cherrypick unused-type
by Magnus (＠MangoIV) 18 Jun '26

18 Jun '26

Magnus pushed to branch wip/mangoiv/backport-unused-type at Glasgow Haskell Compiler / GHC Commits: 03caad93 by mangoiv at 2026-06-18T13:21:53+02:00 cherrypick unused-type - - - - - 15 changed files: - 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 - 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 Changes: ===================================== compiler/GHC/Builtin/Names.hs ===================================== @@ -2007,8 +2007,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 ===================================== @@ -92,7 +92,7 @@ module GHC.Builtin.Types ( cTupleSelId, cTupleSelIdName, -- * Any - anyTyCon, anyTy, anyTypeOfKind, zonkAnyTyCon, + anyTyCon, anyTy, anyTypeOfKind, unusedTypeTyCon, -- * Recovery TyCon makeRecoveryTyCon, @@ -310,7 +310,7 @@ wiredInTyCons = map (dataConTyCon . snd) boxingDataCons , soloTyCon , anyTyCon - , zonkAnyTyCon + , unusedTypeTyCon , boolTyCon , charTyCon , stringTyCon @@ -421,13 +421,13 @@ doubleDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "D#") {- Note [Any types] ~~~~~~~~~~~~~~~~ -The type constructors `Any` and `ZonkAny` are closed type families declared thus: +The type constructors `Any` and `UnusedType` are closed type families declared thus: - 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. Nat -> 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 +what that type is. The leading example is this: `UnusedType` is used to instantiate un-constrained type variables after type checking. For example, consider the term (length [] :: Int), where @@ -440,26 +440,26 @@ The typechecker will end up with length @alpha ([] @alpha) 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 +that unconstrained `alpha` to an arbitrary type (UnusedType @Type 3 "a"), where the `3` is +arbitrary (see wrinkle (Any5) below). and `a` is the original name, if we have one. +This is done in `GHC.Tc.Zonk.Type.commitFlexi`. So we end up with - length @(ZonkAny @Type 3) ([] @(ZonkAny @Type 3)) + length @(UnusedType @Type 3 "a") ([] @(UnusedType @Type 3 "a")) -`Any` and `ZonkAny` differ only in the presence of the `Nat` argument; see -wrinkle (Any4). +`Any` and `UnusedType` differ only in the presence of the `Nat` and the `Symbol` arguments; +see wrinkle (Any4). Wrinkles: -(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 * +(Any1) `Any` and `UnusedType` are kind polymorphic since in some program we may + need to use `UnusedType` 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 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 @@ -469,7 +469,7 @@ Wrinkles: the code generator, because the code gen may /enter/ a data value but never enters a function value. -(Any4) `ZonkAny` takes a `Nat` argument so that we can readily make up /distinct/ +(Any4) `UnusedType` takes a `Nat` argument so that we can readily make up /distinct/ types (#24817). Consider data SBool a where { STrue :: SBool True; SFalse :: SBool False } @@ -484,17 +484,29 @@ 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 4 "a" and beta := UnusedType @Type k 5 "b" (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 + `UnusedType` takes a `Symbol` argument so we can neatly display the type to the user. + While `UnusedType` ought to be an implementation detail, we sometimes leak it to the + user, especially in consumers of the GHC api like haskell-language-server. + The user does not know what an `UnusedType` is and just expects a meta variable. + However, since the process of zonking should remove all meta variables, we just try to + reconstruct it when pretty printing, e.g. + `UnusedType 3 "foo" :: Type` becomes `foo_3` + + Historical note: `UnusedType` was called `ZonkAny` in older versions of the compiler + but since this is a leaky abstractions (see above) we give it this improved name + and handle it specially in the pretty printer to avoid confusion of the user. + +(Any5) `Any` and `UnusedType` 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 @@ -502,7 +514,7 @@ Wrinkles: 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. + Currently `UnusedType` is not available to users; but it could easily be. (Any7) Properties of `Any`: * When `Any` is instantiated at a lifted type it is inhabited by at least one value, @@ -521,6 +533,17 @@ Wrinkles: See examples in ghc-prim:GHC.Types +(Any8) Warning 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 } + + where forever :: forall a b. IO a -> IO b + Nothing constrains `b`, so it will be instantiates with `Any` or `UnusedType`. + But we certainly don't want to complain about a discarded do-binding. + 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 bit of history. @@ -547,23 +570,25 @@ 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 +unusedTypeTyCon :: TyCon +-- unusedTypeTyCon :: forall k. Nat -> Symbol -> k -- See Note [Any types] -zonkAnyTyCon = mkFamilyTyCon zonkAnyTyConName - [ mkNamedTyConBinder Specified kv - , mkAnonTyConBinder nat_kv ] - (mkTyVarTy kv) +unusedTypeTyCon = mkFamilyTyCon unusedTypeTyConName bndrs res_kind Nothing (ClosedSynFamilyTyCon Nothing) Nothing NotInjective where - [kv,nat_kv] = mkTemplateKindVars [liftedTypeKind, naturalTy] + [kv,nat_kv,sym_kv] = mkTemplateKindVars [liftedTypeKind, naturalTy, typeSymbolKind] + bndrs = [ mkNamedTyConBinder Specified kv + , mkAnonTyConBinder nat_kv + , mkAnonTyConBinder sym_kv ] + res_kind = mkTyVarTy kv + kind = mkTyConKind bndrs res_kind -- | Make a fake, recovery 'TyCon' from an existing one. -- Used when recovering from errors in type declarations ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -985,9 +985,13 @@ warnDiscardedDoBindings rhs rhs_ty ; when (warn_unused || warn_wrong) $ do { fam_inst_envs <- dsGetFamInstEnvs ; let norm_elt_ty = topNormaliseType fam_inst_envs elt_ty - - -- Warn about discarding non-() things in 'monadic' binding - ; if warn_unused && not (isUnitTy norm_elt_ty) + supressible_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 `()` + -- * `UnusedType` or `Any` type see (Any8) of Note [Any types] + ; 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 #-} {-# LANGUAGE LambdaCase #-} module GHC.Iface.Type ( IfExtName, @@ -1664,6 +1664,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)) @@ -1715,6 +1716,12 @@ pprTyTcApp ctxt_prec tc tys = | Just doc <- ppr_equality ctxt_prec tc (appArgsIfaceTypes tys) -> doc + | ifaceTyConName tc `hasKey` unusedTypeTyConKey + , (arg_k : IfaceLitTy (IfaceNumTyLit arg_n) : IfaceLitTy (IfaceStrTyLit arg_nm) : _) <- appArgsIfaceTypes 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_n arg_nm + | otherwise -> ppr_iface_tc_app ppr_app_arg ctxt_prec tc $ appArgsIfaceTypesForAllTyFlags $ stripInvisArgs (PrintExplicitKinds print_kinds) tys @@ -1727,6 +1734,15 @@ ppr_kind_type ctxt_prec = sdocOption sdocStarIsType $ \case True -> maybeParen ctxt_prec starPrec $ unicodeSyntax (char '★') (char '*') +ppr_iface_unused_ty_tycon :: PprPrec -> IfaceType -> Integer -> LexicalFastString -> SDoc +ppr_iface_unused_ty_tycon ctxt_prec arg_k arg_n arg_nm + = sdocOption sdocPrintExplicitKinds $ \print_kinds -> + sdocOption sdocPrintExplicitRuntimeReps $ \print_reps -> + if print_kinds || print_reps + then maybeParen ctxt_prec sigPrec $ prettyMeta <+> text "::" <+> pprIfaceType arg_k + else prettyMeta + where prettyMeta = ppr arg_nm <> ppr arg_n + -- | Pretty-print a type-level equality. -- Returns (Just doc) if the argument is a /saturated/ application -- of eqTyCon (~) @@ -2113,7 +2129,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 ===================================== @@ -569,7 +569,7 @@ data TcGblEnv -- ^ Allows us to choose unique DFun names. tcg_zany_n :: TcRef Integer, - -- ^ A source of unique identities for ZonkAny instances + -- ^ A source of unique identities for UnusedType instances -- See Note [Any types] in GHC.Builtin.Types, wrinkle (Any4) tcg_merged :: [(Module, Fingerprint)], ===================================== compiler/GHC/Tc/Utils/Monad.hs ===================================== @@ -142,7 +142,7 @@ module GHC.Tc.Utils.Monad( getCCIndexM, getCCIndexTcM, -- * Zonking - liftZonkM, newZonkAnyType, + liftZonkM, newUnusedType, -- * Complete matches localAndImportedCompleteMatches, getCompleteMatchesTcM, @@ -156,7 +156,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.Types -- Re-export all @@ -180,7 +180,7 @@ import GHC.Core.UsageEnv import GHC.Core.Multiplicity import GHC.Core.InstEnv import GHC.Core.FamInstEnv -import GHC.Core.Type( mkNumLitTy ) +import GHC.Core.Type( mkNumLitTy, mkStrLitTy ) import GHC.Driver.Env import GHC.Driver.Session @@ -1792,17 +1792,17 @@ 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 +newUnusedType :: Name -> Kind -> TcM Type +-- Return a type (UnusedType @k n sym), where n is fresh +-- Recall UnusedType :: forall k. Natural -> Symbol -> k -- See Note [Any types] in GHC.Builtin.Types, wrinkle (Any4) -newZonkAnyType kind +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]) } + ; return (mkTyConApp unusedTypeTyCon [kind, mkNumLitTy i, mkStrLitTy $ getOccFS name ]) } getConstraintVar :: TcM (TcRef WantedConstraints) getConstraintVar = do { env <- getLclEnv; return (tcl_lie env) } ===================================== compiler/GHC/Tc/Utils/TcType.hs ===================================== @@ -88,7 +88,7 @@ module GHC.Tc.Utils.TcType ( isSigmaTy, isRhoTy, isRhoExpTy, isOverloadedTy, isFloatingPrimTy, isDoubleTy, isFloatTy, isIntTy, isWordTy, isStringTy, isIntegerTy, isNaturalTy, - isBoolTy, isUnitTy, isCharTy, + isBoolTy, isUnitTy, isAnyTy, isUnusedTypeTy, isCharTy, isTauTy, isTauTyCon, tcIsTyVarTy, isPredTy, isTyVarClassPred, checkValidClsArgs, hasTyVarHead, @@ -2005,7 +2005,7 @@ isFloatTy, isDoubleTy, isFloatPrimTy, isDoublePrimTy, isIntegerTy, isNaturalTy, isIntTy, isWordTy, isBoolTy, - isUnitTy, isCharTy :: Type -> Bool + isUnitTy, isAnyTy, isUnusedTypeTy, isCharTy :: Type -> Bool isFloatTy = is_tc floatTyConKey isDoubleTy = is_tc doubleTyConKey isFloatPrimTy = is_tc floatPrimTyConKey @@ -2016,6 +2016,8 @@ isIntTy = is_tc intTyConKey isWordTy = is_tc wordTyConKey isBoolTy = is_tc boolTyConKey isUnitTy = is_tc unitTyConKey +isAnyTy = is_tc anyTyConKey +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 #-} {-# LANGUAGE GADTs #-} {- @@ -54,7 +55,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.Constraint import GHC.Tc.Types.Evidence import GHC.Tc.Errors.Types @@ -471,7 +472,7 @@ commitFlexi tv 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 } + ; newUnusedType name zonked_kind } RuntimeUnkFlexi -> do { traceTc "Defaulting flexi tyvar to RuntimeUnk:" (pprTyVar tv) ===================================== 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.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.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.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.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.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.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.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.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.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.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.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.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.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.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.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.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.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.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.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.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.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.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.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.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.Types.ZonkAny 0]’ not matched: [] + In a case alternative: Patterns of type ‘[a0]’ 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 0 \"a\"", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "10:23-39"}) +Just (InfoProv {ipName = "main_sat_t2fJ_info", ipDesc = THUNK, ipTyDesc = "UnusedType 1 \"a\"", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "11:23-42"}) +Just (InfoProv {ipName = "main_sat_t2g0_info", ipDesc = THUNK, ipTyDesc = "UnusedType 2 \"a\"", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "12:23-46"}) +Just (InfoProv {ipName = "main_sat_t2gh_info", ipDesc = THUNK, ipTyDesc = "UnusedType 3 \"a\"", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "13:23-44"}) ===================================== testsuite/tests/simplCore/should_compile/Makefile ===================================== @@ -178,7 +178,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.Types.ZonkAny 0) of { __DEFAULT -> - case r @(GHC.Types.ZonkAny 1) of { __DEFAULT -> r @a } + case r @(GHC.Internal.Types.UnusedType 0 "a") of { __DEFAULT -> + case r @(GHC.Internal.Types.UnusedType 1 "a") of { __DEFAULT -> ===================================== testsuite/tests/simplCore/should_compile/T26615.stderr ===================================== @@ -0,0 +1,2441 @@ +[1 of 2] Compiling T26615a ( T26615a.hs, T26615a.o ) + +==================== Tidy Core ==================== +Result size of Tidy Core + = {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 +[GblId[[RecSel]], + Arity=1, + Str=<1!P(1L)>, + Unf=Unf{Src=<vanilla>, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=True)}] +unArray = \ (@a) (ds :: Array a) -> case ds of { Array ds1 -> ds1 } + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule1 :: Addr# +[GblId, Unf=OtherCon []] +$trModule1 = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$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} +$trModule3 :: Addr# +[GblId, Unf=OtherCon []] +$trModule3 = "T26615a"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$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 [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 +[GblId, Unf=OtherCon []] +$krep + = GHC.Internal.Types.KindRepTyConApp + GHC.Internal.Types.$tc'Lifted + (GHC.Internal.Types.[] @GHC.Internal.Types.KindRep) + +-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} +$krep1 :: GHC.Internal.Types.KindRep +[GblId, Unf=OtherCon []] +$krep1 + = GHC.Internal.Types.KindRepTyConApp + GHC.Internal.Types.$tcWord + (GHC.Internal.Types.[] @GHC.Internal.Types.KindRep) + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$krep2 :: GHC.Internal.Types.KindRep +[GblId, Unf=OtherCon []] +$krep2 = GHC.Internal.Types.KindRepVar 1# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$krep3 :: GHC.Internal.Types.KindRep +[GblId, Unf=OtherCon []] +$krep3 = GHC.Internal.Types.KindRepVar 0# + +-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} +$krep4 :: [GHC.Internal.Types.KindRep] +[GblId, Unf=OtherCon []] +$krep4 + = GHC.Internal.Types.: + @GHC.Internal.Types.KindRep + $krep3 + (GHC.Internal.Types.[] @GHC.Internal.Types.KindRep) + +-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} +$krep5 :: [GHC.Internal.Types.KindRep] +[GblId, Unf=OtherCon []] +$krep5 + = GHC.Internal.Types.: @GHC.Internal.Types.KindRep $krep $krep4 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep6 :: GHC.Internal.Types.KindRep +[GblId, Unf=OtherCon []] +$krep6 + = GHC.Internal.Types.KindRepTyConApp + GHC.Internal.Types.$tcSmallArray# $krep5 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$tcLeaf1 :: Addr# +[GblId, Unf=OtherCon []] +$tcLeaf1 = "Leaf"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$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 [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] +T26615a.$tcLeaf + = GHC.Internal.Types.TyCon + 13798714324392902582#Word64 + 3237499036029031497#Word64 + T26615a.$trModule + $tcLeaf2 + 0# + GHC.Internal.Types.krep$*->*->* + +-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} +$krep7 :: [GHC.Internal.Types.KindRep] +[GblId, Unf=OtherCon []] +$krep7 + = GHC.Internal.Types.: + @GHC.Internal.Types.KindRep + $krep2 + (GHC.Internal.Types.[] @GHC.Internal.Types.KindRep) + +-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} +$krep8 :: [GHC.Internal.Types.KindRep] +[GblId, Unf=OtherCon []] +$krep8 + = GHC.Internal.Types.: @GHC.Internal.Types.KindRep $krep3 $krep7 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep9 :: GHC.Internal.Types.KindRep +[GblId, Unf=OtherCon []] +$krep9 = GHC.Internal.Types.KindRepTyConApp T26615a.$tcLeaf $krep8 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep10 :: GHC.Internal.Types.KindRep +[GblId, Unf=OtherCon []] +$krep10 = GHC.Internal.Types.KindRepFun $krep2 $krep9 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep11 :: GHC.Internal.Types.KindRep +[GblId, Unf=OtherCon []] +$krep11 = GHC.Internal.Types.KindRepFun $krep3 $krep10 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$tc'L1 :: Addr# +[GblId, Unf=OtherCon []] +$tc'L1 = "'L"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$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 [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] +T26615a.$tc'L + = GHC.Internal.Types.TyCon + 8570419491837374712#Word64 + 2090006989092642392#Word64 + T26615a.$trModule + $tc'L2 + 2# + $krep11 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$tcArray1 :: Addr# +[GblId, Unf=OtherCon []] +$tcArray1 = "Array"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$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 [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] +T26615a.$tcArray + = GHC.Internal.Types.TyCon + 10495761415291712389#Word64 + 7580086293698619153#Word64 + T26615a.$trModule + $tcArray2 + 0# + GHC.Internal.Types.krep$*Arr* + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep12 :: GHC.Internal.Types.KindRep +[GblId, Unf=OtherCon []] +$krep12 + = GHC.Internal.Types.KindRepTyConApp T26615a.$tcArray $krep4 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep13 :: GHC.Internal.Types.KindRep +[GblId, Unf=OtherCon []] +$krep13 = GHC.Internal.Types.KindRepFun $krep6 $krep12 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$tc'Array1 :: Addr# +[GblId, Unf=OtherCon []] +$tc'Array1 = "'Array"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$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 [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] +T26615a.$tc'Array + = GHC.Internal.Types.TyCon + 12424115309881832159#Word64 + 15542868641947707803#Word64 + T26615a.$trModule + $tc'Array2 + 1# + $krep13 + +-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} +$krep14 :: [GHC.Internal.Types.KindRep] +[GblId, Unf=OtherCon []] +$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} +$krep15 :: GHC.Internal.Types.KindRep +[GblId, Unf=OtherCon []] +$krep15 + = GHC.Internal.Types.KindRepTyConApp T26615a.$tcArray $krep14 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$tcHashMap1 :: Addr# +[GblId, Unf=OtherCon []] +$tcHashMap1 = "HashMap"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$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 [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] +T26615a.$tcHashMap + = GHC.Internal.Types.TyCon + 2021755758654901686#Word64 + 8209241086311595496#Word64 + T26615a.$trModule + $tcHashMap2 + 0# + GHC.Internal.Types.krep$*->*->* + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep16 :: GHC.Internal.Types.KindRep +[GblId, Unf=OtherCon []] +$krep16 + = GHC.Internal.Types.KindRepTyConApp T26615a.$tcHashMap $krep8 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$tc'Empty1 :: Addr# +[GblId, Unf=OtherCon []] +$tc'Empty1 = "'Empty"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$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 [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] +T26615a.$tc'Empty + = GHC.Internal.Types.TyCon + 2520556399233147460#Word64 + 17224648764450205443#Word64 + T26615a.$trModule + $tc'Empty2 + 2# + $krep16 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep17 :: GHC.Internal.Types.KindRep +[GblId, Unf=OtherCon []] +$krep17 = GHC.Internal.Types.KindRepFun $krep9 $krep16 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep18 :: GHC.Internal.Types.KindRep +[GblId, Unf=OtherCon []] +$krep18 = GHC.Internal.Types.KindRepFun $krep1 $krep17 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$tc'Leaf1 :: Addr# +[GblId, Unf=OtherCon []] +$tc'Leaf1 = "'Leaf"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$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 [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] +T26615a.$tc'Leaf + = GHC.Internal.Types.TyCon + 5773656560257991946#Word64 + 17028074687139582545#Word64 + T26615a.$trModule + $tc'Leaf2 + 2# + $krep18 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep19 :: GHC.Internal.Types.KindRep +[GblId, Unf=OtherCon []] +$krep19 = GHC.Internal.Types.KindRepFun $krep15 $krep16 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep20 :: GHC.Internal.Types.KindRep +[GblId, Unf=OtherCon []] +$krep20 = GHC.Internal.Types.KindRepFun $krep1 $krep19 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$tc'Collision1 :: Addr# +[GblId, Unf=OtherCon []] +$tc'Collision1 = "'Collision"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$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 [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] +T26615a.$tc'Collision + = GHC.Internal.Types.TyCon + 18175105753528304021#Word64 + 13986842878006680511#Word64 + T26615a.$trModule + $tc'Collision2 + 2# + $krep20 + +-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} +$krep21 :: [GHC.Internal.Types.KindRep] +[GblId, Unf=OtherCon []] +$krep21 + = GHC.Internal.Types.: + @GHC.Internal.Types.KindRep + $krep16 + (GHC.Internal.Types.[] @GHC.Internal.Types.KindRep) + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep22 :: GHC.Internal.Types.KindRep +[GblId, Unf=OtherCon []] +$krep22 + = GHC.Internal.Types.KindRepTyConApp T26615a.$tcArray $krep21 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep23 :: GHC.Internal.Types.KindRep +[GblId, Unf=OtherCon []] +$krep23 = GHC.Internal.Types.KindRepFun $krep22 $krep16 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$tc'Full1 :: Addr# +[GblId, Unf=OtherCon []] +$tc'Full1 = "'Full"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$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 [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] +T26615a.$tc'Full + = GHC.Internal.Types.TyCon + 12008762105994325570#Word64 + 13514145886440831186#Word64 + T26615a.$trModule + $tc'Full2 + 2# + $krep23 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep24 :: GHC.Internal.Types.KindRep +[GblId, Unf=OtherCon []] +$krep24 = GHC.Internal.Types.KindRepFun $krep1 $krep23 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$tc'BitmapIndexed1 :: Addr# +[GblId, Unf=OtherCon []] +$tc'BitmapIndexed1 = "'BitmapIndexed"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$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 [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] +T26615a.$tc'BitmapIndexed + = GHC.Internal.Types.TyCon + 15226751910432948177#Word64 + 957331387129868915#Word64 + T26615a.$trModule + $tc'BitmapIndexed2 + 2# + $krep24 + +-- RHS size: {terms: 98, types: 109, coercions: 0, joins: 3/4} +T26615a.$wdisjointCollisions [InlPrag=INLINABLE[2]] + :: forall k a b. + Eq k => + Word# + -> Array (Leaf k a) -> Word# -> SmallArray# (Leaf k b) -> Bool +[GblId[StrictWorker([~, ~, !])], + Arity=5, + 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 [90 0 20 0 0] 406 10 + Tmpl= \ (@k) + (@a) + (@b) + ($dEq :: Eq k) + (ww [Occ=Once1] :: Word#) + (aryA [Occ=Once1!] :: Array (Leaf k a)) + (ww1 [Occ=Once1] :: Word#) + (ww2 :: SmallArray# (Leaf k b)) -> + case aryA of aryA1 [Occ=Once1] { Array ipv [Occ=Once1] -> + let { + aryB [Occ=OnceL1] :: Array (Leaf k b) + [LclId, Unf=OtherCon []] + aryB = T26615a.Array @(Leaf k b) ww2 } in + case GHC.Internal.Classes.eqWord + (GHC.Internal.Types.W# ww) (GHC.Internal.Types.W# ww1) + of { + False -> GHC.Internal.Types.True; + True -> + joinrec { + foldr_ [Occ=LoopBreakerT[4]] + :: Array (Leaf k a) -> Int -> Int -> Bool -> Bool + [LclId[JoinId(4)(Nothing)], + Arity=4, + Str=<L><L><L><L>, + Unf=OtherCon []] + foldr_ (ary [Occ=Once1!] :: Array (Leaf k a)) + (n :: Int) + (i :: Int) + (z [Occ=Once2] :: Bool) + = case GHC.Internal.Classes.geInt i n of { + False -> + case i of { I# i# -> + case ary of wild3 [Occ=Once1] { Array ds [Occ=Once1] -> + case indexSmallArray# @Lifted @(Leaf k a) ds i# of + { (# ipv1 [Occ=Once1!] #) -> + case ipv1 of { L kA [Occ=Once1] _ [Occ=Dead] -> + join { + $j [Occ=OnceL1T[0]] :: Bool + [LclId[JoinId(0)(Nothing)]] + $j = jump foldr_ wild3 n (GHC.Internal.Types.I# (+# i# 1#)) z } in + joinrec { + lookupInArrayCont_ [Occ=LoopBreakerT[5]] + :: Eq k => k -> Array (Leaf k b) -> Int -> Int -> Bool + [LclId[JoinId(5)(Nothing)], + Arity=5, + Str=<L><L><L><L><L>, + Unf=OtherCon []] + lookupInArrayCont_ ($dEq1 [Occ=Dead] :: Eq k) + (k1 [Occ=Once1] :: k) + (ary1 [Occ=Once1!] :: Array (Leaf k b)) + (i1 [Occ=Once1!] :: Int) + (n1 [Occ=Once1!] :: Int) + = case k1 of k2 { __DEFAULT -> + case ary1 of ary2 [Occ=Once1] { Array ipv2 [Occ=Once1] -> + case i1 of i2 [Occ=Once1] { I# ipv3 -> + case n1 of n2 { I# _ [Occ=Dead] -> + case GHC.Internal.Classes.geInt i2 n2 of { + False -> + case indexSmallArray# @Lifted @(Leaf k b) ipv2 ipv3 of + { (# ipv5 [Occ=Once1!] #) -> + case ipv5 of { L kx [Occ=Once1] _ [Occ=Dead] -> + case == @k $dEq k2 kx of { + False -> + jump lookupInArrayCont_ + $dEq k2 ary2 (GHC.Internal.Types.I# (+# ipv3 1#)) n2; + True -> GHC.Internal.Types.False + } + } + }; + True -> jump $j + } + } + } + } + }; } in + jump lookupInArrayCont_ + $dEq + kA + aryB + (GHC.Internal.Types.I# 0#) + (GHC.Internal.Types.I# (sizeofSmallArray# @Lifted @(Leaf k b) ww2)) + } + } + } + }; + True -> z + }; } in + jump foldr_ + aryA1 + (GHC.Internal.Types.I# (sizeofSmallArray# @Lifted @(Leaf k a) ipv)) + (GHC.Internal.Types.I# 0#) + GHC.Internal.Types.True + } + }}] +T26615a.$wdisjointCollisions + = \ (@k) + (@a) + (@b) + ($dEq :: Eq k) + (ww :: Word#) + (aryA :: Array (Leaf k a)) + (ww1 :: Word#) + (ww2 :: SmallArray# (Leaf k b)) -> + case aryA of { Array ipv -> + case eqWord# ww ww1 of { + __DEFAULT -> GHC.Internal.Types.True; + 1# -> + let { + lvl2 :: Int# + [LclId] + lvl2 = sizeofSmallArray# @Lifted @(Leaf k b) ww2 } in + joinrec { + $s$wfoldr_ [InlPrag=[2], + Occ=LoopBreaker, + Dmd=SC(S,C(1,C(1,C(1,L))))] + :: SmallArray# (Leaf k a) -> Int# -> Int# -> Bool -> Bool + [LclId[JoinId(4)(Nothing)], + Arity=4, + Str=<L><L><L><L>, + Unf=OtherCon []] + $s$wfoldr_ (sc :: SmallArray# (Leaf k a)) + (sc1 :: Int#) + (sc2 :: Int#) + (sc3 :: Bool) + = case >=# sc2 sc1 of { + __DEFAULT -> + 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 (+# sc2 1#) sc3 } in + joinrec { + $wlookupInArrayCont_ [InlPrag=[2], + Occ=LoopBreaker, + Dmd=SC(S,C(1,C(1,C(1,L))))] + :: k -> SmallArray# (Leaf k b) -> Int# -> Int# -> Bool + [LclId[JoinId(4)(Just [!])], + Arity=4, + Str=<1L><L><L><L>, + Unf=OtherCon []] + $wlookupInArrayCont_ (k1 :: k) + (ww3 :: SmallArray# (Leaf k b)) + (ww4 :: Int#) + (ww5 :: Int#) + = case k1 of k2 { __DEFAULT -> + case >=# ww4 ww5 of { + __DEFAULT -> + case indexSmallArray# @Lifted @(Leaf k b) ww3 ww4 of + { (# ipv2 #) -> + case ipv2 of { L kx v -> + case == @k $dEq k2 kx of { + False -> jump $wlookupInArrayCont_ k2 ww3 (+# ww4 1#) ww5; + True -> GHC.Internal.Types.False + } + } + }; + 1# -> jump $j + } + }; } in + jump $wlookupInArrayCont_ kA ww2 0# lvl2 + } + }; + 1# -> sc3 + }; } in + jump $s$wfoldr_ + ipv + (sizeofSmallArray# @Lifted @(Leaf k a) ipv) + 0# + GHC.Internal.Types.True + } + } + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +lvl :: Addr# +[GblId, Unf=OtherCon []] +lvl = "T26615a.hs:(26,1)-(65,59)|function disjointSubtrees"# + +-- RHS size: {terms: 2, types: 2, coercions: 0, joins: 0/0} +lvl1 :: () +[GblId, Str=b, Cpr=b] +lvl1 + = GHC.Internal.Control.Exception.Base.patError @LiftedRep @() lvl + +Rec { +-- RHS size: {terms: 133, types: 126, coercions: 0, joins: 1/2} +T26615a.disjointSubtrees_$s$wdisjointSubtrees [InlPrag=INLINABLE[2], + Occ=LoopBreaker] + :: forall k a b. + Eq k => + Int# -> Word# -> SmallArray# (Leaf k a) -> HashMap k b -> Bool +[GblId[StrictWorker([~, ~, ~, ~, !])], + Arity=5, + Str=<LP(SC(S,C(1,L)),A)><L><L><L><1L>, + Unf=OtherCon []] +T26615a.disjointSubtrees_$s$wdisjointSubtrees + = \ (@k) + (@a) + (@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 sc2 of { + __DEFAULT -> GHC.Internal.Types.True; + 1# -> + joinrec { + $wlookupInArrayCont_ [InlPrag=[2], + Occ=LoopBreaker, + Dmd=SC(S,C(1,C(1,C(1,L))))] + :: k -> SmallArray# (Leaf k a) -> Int# -> Int# -> Bool + [LclId[JoinId(4)(Just [!])], + Arity=4, + Str=<1L><L><L><L>, + Unf=OtherCon []] + $wlookupInArrayCont_ (k1 :: k) + (ww :: SmallArray# (Leaf k a)) + (ww1 :: Int#) + (ww2 :: Int#) + = case k1 of k2 { __DEFAULT -> + case >=# ww1 ww2 of { + __DEFAULT -> + case indexSmallArray# @Lifted @(Leaf k a) ww ww1 of { (# ipv #) -> + case ipv of { L kx v -> + case == @k sc k2 kx of { + False -> jump $wlookupInArrayCont_ k2 ww (+# ww1 1#) ww2; + True -> GHC.Internal.Types.False + } + } + }; + 1# -> GHC.Internal.Types.True + } + }; } in + jump $wlookupInArrayCont_ + k0 sc3 0# (sizeofSmallArray# @Lifted @(Leaf k a) sc3) + } + } + }; + Collision bx bx1 -> + T26615a.$wdisjointCollisions + @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# sc2 sc1) 31##)) } in + case and# m bx of { + __DEFAULT -> + case indexSmallArray# + @Lifted + @(HashMap k b) + bx1 + (word2Int# (popCnt# (and# bx (minusWord# m 1##)))) + of + { (# ipv #) -> + T26615a.disjointSubtrees_$s$wdisjointSubtrees + @k @a @b sc (+# sc1 5#) sc2 sc3 ipv + }; + 0## -> GHC.Internal.Types.True + }; + Full bx -> + case indexSmallArray# + @Lifted + @(HashMap k b) + bx + (word2Int# (and# (uncheckedShiftRL# sc2 sc1) 31##)) + of + { (# ipv #) -> + T26615a.disjointSubtrees_$s$wdisjointSubtrees + @k @a @b sc (+# sc1 5#) sc2 sc3 ipv + } + } +end Rec } + +Rec { +-- 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([~, ~, !])], + Arity=4, + Str=<LP(LC(L,C(1,L)),LC(S,C(1,L)))><L><SL><L>, + Unf=Unf{Src=StableUser, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=NEVER + Tmpl= \ (@k) + (@a) + (@b) + ($dEq :: Eq k) + (ww :: Int#) + (ds :: HashMap k a) + (_b :: HashMap k b) -> + join { + fail [Occ=Once3!T[1]] :: (# #) -> Bool + [LclId[JoinId(1)(Nothing)], Arity=1, Str=<L>, Unf=OtherCon []] + fail (ds1 [Occ=Dead, OS=OneShot] :: (# #)) + = case _b of wild [Occ=Once1] { + __DEFAULT -> + case GHC.Internal.Control.Exception.Base.patError + @LiftedRep + @() + "T26615a.hs:(26,1)-(65,59)|function disjointSubtrees"# + of {}; + Empty -> GHC.Internal.Types.True; + Leaf bx [Occ=Once1] ds2 [Occ=Once1!] -> + case ds2 of { L kB [Occ=Once1] _ [Occ=Dead] -> + case kB of k0 [Occ=Once1] { __DEFAULT -> + joinrec { + lookupCont_ [Occ=LoopBreakerT[5]] + :: Eq k => Word -> k -> Int -> HashMap k a -> Bool + [LclId[JoinId(5)(Nothing)], + Arity=5, + Str=<L><L><L><L><L>, + Unf=OtherCon []] + lookupCont_ ($dEq1 [Occ=Dead] :: Eq k) + (ds4 [Occ=Once1!] :: Word) + (ds5 [Occ=Once1] :: k) + (ds6 [Occ=Once1!] :: Int) + (ds7 [Occ=Once1!] :: HashMap k a) + = case ds4 of ds8 [Occ=Once4] { W# ipv [Occ=Once2] -> + case ds5 of ds9 [Occ=Once4] { __DEFAULT -> + case ds6 of { I# ipv1 -> + case ds7 of { + Empty -> GHC.Internal.Types.True; + Leaf bx1 [Occ=Once1] ds11 [Occ=Once1!] -> + case ds11 of { L kx [Occ=Once1] _ [Occ=Dead] -> + case GHC.Internal.Classes.eqWord + ds8 (GHC.Internal.Types.W# bx1) + of { + False -> GHC.Internal.Types.True; + True -> + case == @k $dEq ds9 kx of { + False -> GHC.Internal.Types.True; + True -> GHC.Internal.Types.False + } + } + }; + Collision bx1 [Occ=Once1] bx2 -> + case GHC.Internal.Classes.eqWord + ds8 (GHC.Internal.Types.W# bx1) + of { + False -> GHC.Internal.Types.True; + True -> + joinrec { + lookupInArrayCont_ [Occ=LoopBreakerT[5]] + :: Eq k => k -> Array (Leaf k a) -> Int -> Int -> Bool + [LclId[JoinId(5)(Nothing)], + Arity=5, + Str=<L><L><L><L><L>, + Unf=OtherCon []] + lookupInArrayCont_ ($dEq2 [Occ=Dead] :: Eq k) + (k1 [Occ=Once1] :: k) + (ary [Occ=Once1!] :: Array (Leaf k a)) + (i [Occ=Once1!] :: Int) + (n [Occ=Once1!] :: Int) + = case k1 of k2 { __DEFAULT -> + case ary of ary1 [Occ=Once1] + { Array ipv2 [Occ=Once1] -> + case i of i1 [Occ=Once1] { I# ipv3 -> + case n of n1 { I# _ [Occ=Dead] -> + case GHC.Internal.Classes.geInt i1 n1 of { + False -> + case indexSmallArray# + @Lifted @(Leaf k a) ipv2 ipv3 + of + { (# ipv5 [Occ=Once1!] #) -> + case ipv5 of { L kx [Occ=Once1] _ [Occ=Dead] -> + case == @k $dEq k2 kx of { + False -> + jump lookupInArrayCont_ + $dEq + k2 + ary1 + (GHC.Internal.Types.I# (+# ipv3 1#)) + n1; + True -> GHC.Internal.Types.False + } + } + }; + True -> GHC.Internal.Types.True + } + } + } + } + }; } in + jump lookupInArrayCont_ + $dEq + ds9 + (T26615a.Array @(Leaf k a) bx2) + (GHC.Internal.Types.I# 0#) + (GHC.Internal.Types.I# + (sizeofSmallArray# @Lifted @(Leaf k a) bx2)) + }; + BitmapIndexed bx1 bx2 [Occ=Once1] -> + let { + m :: Word# + [LclId] + m = uncheckedShiftL# + 1## + (word2Int# + (and# (uncheckedShiftRL# ipv ipv1) 31##)) } in + case GHC.Internal.Classes.eqWord + (GHC.Internal.Types.W# (and# bx1 m)) + (GHC.Internal.Types.W# 0##) + of { + False -> + case indexSmallArray# + @Lifted + @(HashMap k a) + bx2 + (word2Int# (popCnt# (and# bx1 (minusWord# m 1##)))) + of + { (# ipv2 [Occ=Once1] #) -> + jump lookupCont_ + $dEq ds8 ds9 (GHC.Internal.Types.I# (+# ipv1 5#)) ipv2 + }; + True -> GHC.Internal.Types.True + }; + Full bx1 [Occ=Once1] -> + case indexSmallArray# + @Lifted + @(HashMap k a) + bx1 + (word2Int# (and# (uncheckedShiftRL# ipv ipv1) 31##)) + of + { (# ipv2 [Occ=Once1] #) -> + jump lookupCont_ + $dEq ds8 ds9 (GHC.Internal.Types.I# (+# ipv1 5#)) ipv2 + } + } + } + } + }; } in + jump lookupCont_ + $dEq (GHC.Internal.Types.W# bx) k0 (GHC.Internal.Types.I# ww) ds + } + }; + Collision _ [Occ=Dead] _ [Occ=Dead] -> + T26615a.$wdisjointSubtrees @k @b @a $dEq ww wild ds + } } in + case ds of wild [Occ=Once2] { + Empty -> GHC.Internal.Types.True; + Leaf bx [Occ=Once2] ds1 [Occ=Once1!] -> + case ds1 of { L kA [Occ=Once2] _ [Occ=Dead] -> + case _b of wild2 [Occ=Once1] { + __DEFAULT -> + case kA of k0 [Occ=Once1] { __DEFAULT -> + joinrec { + lookupCont_ [Occ=LoopBreakerT[5]] + :: Eq k => Word -> k -> Int -> HashMap k b -> Bool + [LclId[JoinId(5)(Nothing)], + Arity=5, + Str=<L><L><L><L><L>, + Unf=OtherCon []] + lookupCont_ ($dEq1 [Occ=Dead] :: Eq k) + (ds3 [Occ=Once1!] :: Word) + (ds4 [Occ=Once1] :: k) + (ds5 [Occ=Once1!] :: Int) + (ds6 [Occ=Once1!] :: HashMap k b) + = case ds3 of ds7 [Occ=Once4] { W# ipv [Occ=Once2] -> + case ds4 of ds8 [Occ=Once4] { __DEFAULT -> + case ds5 of { I# ipv1 -> + case ds6 of { + Empty -> GHC.Internal.Types.True; + Leaf bx1 [Occ=Once1] ds10 [Occ=Once1!] -> + case ds10 of { L kx [Occ=Once1] _ [Occ=Dead] -> + case GHC.Internal.Classes.eqWord ds7 (GHC.Internal.Types.W# bx1) + of { + False -> GHC.Internal.Types.True; + True -> + case == @k $dEq ds8 kx of { + False -> GHC.Internal.Types.True; + True -> GHC.Internal.Types.False + } + } + }; + Collision bx1 [Occ=Once1] bx2 -> + case GHC.Internal.Classes.eqWord ds7 (GHC.Internal.Types.W# bx1) + of { + False -> GHC.Internal.Types.True; + True -> + joinrec { + lookupInArrayCont_ [Occ=LoopBreakerT[5]] + :: Eq k => k -> Array (Leaf k b) -> Int -> Int -> Bool + [LclId[JoinId(5)(Nothing)], + Arity=5, + Str=<L><L><L><L><L>, + Unf=OtherCon []] + lookupInArrayCont_ ($dEq2 [Occ=Dead] :: Eq k) + (k1 [Occ=Once1] :: k) + (ary [Occ=Once1!] :: Array (Leaf k b)) + (i [Occ=Once1!] :: Int) + (n [Occ=Once1!] :: Int) + = case k1 of k2 { __DEFAULT -> + case ary of ary1 [Occ=Once1] + { Array ipv2 [Occ=Once1] -> + case i of i1 [Occ=Once1] { I# ipv3 -> + case n of n1 { I# _ [Occ=Dead] -> + case GHC.Internal.Classes.geInt i1 n1 of { + False -> + case indexSmallArray# @Lifted @(Leaf k b) ipv2 ipv3 + of + { (# ipv5 [Occ=Once1!] #) -> + case ipv5 of { L kx [Occ=Once1] _ [Occ=Dead] -> + case == @k $dEq k2 kx of { + False -> + jump lookupInArrayCont_ + $dEq + k2 + ary1 + (GHC.Internal.Types.I# (+# ipv3 1#)) + n1; + True -> GHC.Internal.Types.False + } + } + }; + True -> GHC.Internal.Types.True + } + } + } + } + }; } in + jump lookupInArrayCont_ + $dEq + ds8 + (T26615a.Array @(Leaf k b) bx2) + (GHC.Internal.Types.I# 0#) + (GHC.Internal.Types.I# + (sizeofSmallArray# @Lifted @(Leaf k b) bx2)) + }; + BitmapIndexed bx1 bx2 [Occ=Once1] -> + let { + m :: Word# + [LclId] + m = uncheckedShiftL# + 1## + (word2Int# (and# (uncheckedShiftRL# ipv ipv1) 31##)) } in + case GHC.Internal.Classes.eqWord + (GHC.Internal.Types.W# (and# bx1 m)) + (GHC.Internal.Types.W# 0##) + of { + False -> + case indexSmallArray# + @Lifted + @(HashMap k b) + bx2 + (word2Int# (popCnt# (and# bx1 (minusWord# m 1##)))) + of + { (# ipv2 [Occ=Once1] #) -> + jump lookupCont_ + $dEq ds7 ds8 (GHC.Internal.Types.I# (+# ipv1 5#)) ipv2 + }; + True -> GHC.Internal.Types.True + }; + Full bx1 [Occ=Once1] -> + case indexSmallArray# + @Lifted + @(HashMap k b) + bx1 + (word2Int# (and# (uncheckedShiftRL# ipv ipv1) 31##)) + of + { (# ipv2 [Occ=Once1] #) -> + jump lookupCont_ + $dEq ds7 ds8 (GHC.Internal.Types.I# (+# ipv1 5#)) ipv2 + } + } + } + } + }; } in + jump lookupCont_ + $dEq (GHC.Internal.Types.W# bx) k0 (GHC.Internal.Types.I# ww) wild2 + }; + Leaf bx1 [Occ=Once1] ds3 [Occ=Once1!] -> + case ds3 of { L kB [Occ=Once1] _ [Occ=Dead] -> + case GHC.Internal.Classes.neWord + (GHC.Internal.Types.W# bx) (GHC.Internal.Types.W# bx1) + of { + False -> /= @k $dEq kA kB; + True -> GHC.Internal.Types.True + } + } + } + }; + Collision bx [Occ=Once3] bx1 [Occ=Once1] -> + case _b of { + __DEFAULT -> jump fail GHC.Internal.Types.(##); + Collision bx2 [Occ=Once1] bx3 [Occ=Once1] -> + T26615a.$wdisjointCollisions + @k @a @b $dEq bx (T26615a.Array @(Leaf k a) bx1) bx2 bx3; + BitmapIndexed bx2 bx3 [Occ=Once1] -> + let { + m :: Word# + [LclId] + m = uncheckedShiftL# + 1## (word2Int# (and# (uncheckedShiftRL# bx ww) 31##)) } in + case GHC.Internal.Classes.eqWord + (GHC.Internal.Types.W# (and# m bx2)) (GHC.Internal.Types.W# 0##) + of { + False -> + case indexSmallArray# + @Lifted + @(HashMap k b) + bx3 + (word2Int# (popCnt# (and# bx2 (minusWord# m 1##)))) + of + { (# ipv [Occ=Once1] #) -> + T26615a.$wdisjointSubtrees @k @a @b $dEq (+# ww 5#) wild ipv + }; + True -> GHC.Internal.Types.True + }; + Full bx2 [Occ=Once1] -> + case indexSmallArray# + @Lifted + @(HashMap k b) + bx2 + (word2Int# (and# (uncheckedShiftRL# bx ww) 31##)) + of + { (# ipv [Occ=Once1] #) -> + T26615a.$wdisjointSubtrees @k @a @b $dEq (+# ww 5#) wild ipv + } + }; + BitmapIndexed bx bx1 -> + case _b of { + __DEFAULT -> jump fail GHC.Internal.Types.(##); + BitmapIndexed bx2 bx3 -> + case GHC.Internal.Classes.eqWord + (GHC.Internal.Types.W# (and# bx bx2)) (GHC.Internal.Types.W# 0##) + of { + False -> + case GHC.Internal.Unsafe.Coerce.unsafeEqualityProof + @(*) + @(SmallArray# (HashMap k a) + -> SmallArray# (HashMap k b) -> Int#) + @(GHC.Internal.Types.UnusedType 0 "a" + -> GHC.Internal.Types.UnusedType 1 "b" -> Int#) + of + { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> + case reallyUnsafePtrEquality# + @Lifted + @Lifted + @(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.UnusedType 0 "a")) + (bx3 + `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) + :: SmallArray# (HashMap k b) + ~R# GHC.Internal.Types.UnusedType 1 "b")) + of { + __DEFAULT -> + joinrec { + go [Occ=LoopBreakerT[1]] :: Word -> Bool + [LclId[JoinId(1)(Nothing)], Arity=1, Str=<L>, Unf=OtherCon []] + go (ds1 [Occ=Once1!] :: Word) + = case ds1 of { W# ds2 [Occ=Once1!] -> + case ds2 of ds3 { + __DEFAULT -> + let { + m :: Word# + [LclId] + m = and# + ds3 (int2Word# (negateInt# (word2Int# ds3))) } in + case indexSmallArray# + @Lifted + @(HashMap k a) + bx1 + (word2Int# (popCnt# (and# bx (minusWord# m 1##)))) + of + { (# ipv [Occ=Once1] #) -> + case indexSmallArray# + @Lifted + @(HashMap k b) + bx3 + (word2Int# + (popCnt# (and# bx2 (minusWord# m 1##)))) + 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.W# (and# ds3 (not# m))) + } + } + }; + 0## -> GHC.Internal.Types.True + } + }; } in + jump go (GHC.Internal.Types.W# (and# bx bx2)); + 1# -> GHC.Internal.Types.False + } + }; + True -> GHC.Internal.Types.True + }; + Full bx2 [Occ=OnceL1] -> + joinrec { + go [Occ=LoopBreakerT[1]] :: Word -> Bool + [LclId[JoinId(1)(Nothing)], Arity=1, Str=<L>, Unf=OtherCon []] + go (ds1 [Occ=Once1!] :: Word) + = case ds1 of { W# ds2 [Occ=Once1!] -> + case ds2 of ds3 { + __DEFAULT -> + let { + m :: Word# + [LclId] + m = and# ds3 (int2Word# (negateInt# (word2Int# ds3))) } in + case indexSmallArray# + @Lifted + @(HashMap k a) + bx1 + (word2Int# (popCnt# (and# bx (minusWord# m 1##)))) + of + { (# ipv [Occ=Once1] #) -> + case indexSmallArray# + @Lifted + @(HashMap k b) + bx2 + (word2Int# + (popCnt# (and# 4294967295## (minusWord# m 1##)))) + 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.W# (and# ds3 (not# m))) + } + } + }; + 0## -> GHC.Internal.Types.True + } + }; } in + jump go (GHC.Internal.Types.W# (and# bx 4294967295##)) + }; + Full bx -> + case _b of { + __DEFAULT -> jump fail GHC.Internal.Types.(##); + BitmapIndexed bx1 bx2 [Occ=OnceL1] -> + joinrec { + go [Occ=LoopBreakerT[1]] :: Word -> Bool + [LclId[JoinId(1)(Nothing)], Arity=1, Str=<L>, Unf=OtherCon []] + go (ds1 [Occ=Once1!] :: Word) + = case ds1 of { W# ds2 [Occ=Once1!] -> + case ds2 of ds3 { + __DEFAULT -> + let { + m :: Word# + [LclId] + m = and# ds3 (int2Word# (negateInt# (word2Int# ds3))) } in + case indexSmallArray# + @Lifted + @(HashMap k a) + bx + (word2Int# + (popCnt# (and# 4294967295## (minusWord# m 1##)))) + of + { (# ipv [Occ=Once1] #) -> + case indexSmallArray# + @Lifted + @(HashMap k b) + bx2 + (word2Int# (popCnt# (and# bx1 (minusWord# m 1##)))) + 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.W# (and# ds3 (not# m))) + } + } + }; + 0## -> GHC.Internal.Types.True + } + }; } 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.UnusedType 0 "a" + -> GHC.Internal.Types.UnusedType 1 "b" -> Int#) + of + { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> + case reallyUnsafePtrEquality# + @Lifted + @Lifted + @(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.UnusedType 0 "a")) + (bx1 + `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) + :: SmallArray# (HashMap k b) + ~R# GHC.Internal.Types.UnusedType 1 "b")) + of { + __DEFAULT -> jump go (GHC.Internal.Types.I# 31#); + 1# -> GHC.Internal.Types.False + } + } + } + }}] +T26615a.$wdisjointSubtrees + = \ (@k) + (@a) + (@b) + ($dEq :: Eq k) + (ww :: Int#) + (ds :: HashMap k a) + (_b :: HashMap k b) -> + join { + fail [Dmd=MC(1,L)] :: (# #) -> Bool + [LclId[JoinId(1)(Nothing)], Arity=1, Str=<A>, Unf=OtherCon []] + fail (ds1 [Occ=Dead, OS=OneShot] :: (# #)) + = case _b of { + __DEFAULT -> case lvl1 of {}; + Empty -> GHC.Internal.Types.True; + Leaf bx ds2 -> + case ds2 of { L kB ds3 -> + case kB of k0 { __DEFAULT -> + join { + exit [Dmd=LC(S,C(1,C(1,C(1,L))))] + :: Word# -> k -> Word# -> Leaf k a -> Bool + [LclId[JoinId(4)(Just [~, ~, ~, !])], + Arity=4, + Str=<L><L><L><1P(L,A)>] + exit (ww1 [OS=OneShot] :: Word#) + (ds4 [OS=OneShot] :: k) + (bx1 [OS=OneShot] :: Word#) + (ds5 [OS=OneShot] :: Leaf k a) + = case ds5 of { L kx x -> + case eqWord# ww1 bx1 of { + __DEFAULT -> GHC.Internal.Types.True; + 1# -> + case == @k $dEq ds4 kx of { + False -> GHC.Internal.Types.True; + True -> GHC.Internal.Types.False + } + } + } } in + join { + exit1 [Dmd=LC(S,C(1,C(1,C(1,L))))] + :: Word# -> k -> Word# -> SmallArray# (Leaf k a) -> Bool + [LclId[JoinId(4)(Nothing)], Arity=4, Str=<L><ML><L><L>] + exit1 (ww1 [OS=OneShot] :: Word#) + (ds4 [OS=OneShot] :: k) + (bx1 [OS=OneShot] :: Word#) + (bx2 [OS=OneShot] :: SmallArray# (Leaf k a)) + = case eqWord# ww1 bx1 of { + __DEFAULT -> GHC.Internal.Types.True; + 1# -> + joinrec { + $wlookupInArrayCont_ [InlPrag=[2], + Occ=LoopBreaker, + Dmd=SC(S,C(1,C(1,C(1,L))))] + :: k -> SmallArray# (Leaf k a) -> Int# -> Int# -> Bool + [LclId[JoinId(4)(Just [!])], + Arity=4, + Str=<1L><L><L><L>, + Unf=OtherCon []] + $wlookupInArrayCont_ (k1 :: k) + (ww2 :: SmallArray# (Leaf k a)) + (ww3 :: Int#) + (ww4 :: Int#) + = case k1 of k2 { __DEFAULT -> + case >=# ww3 ww4 of { + __DEFAULT -> + case indexSmallArray# @Lifted @(Leaf k a) ww2 ww3 of + { (# ipv #) -> + case ipv of { L kx v -> + case == @k $dEq k2 kx of { + False -> jump $wlookupInArrayCont_ k2 ww2 (+# ww3 1#) ww4; + True -> GHC.Internal.Types.False + } + } + }; + 1# -> GHC.Internal.Types.True + } + }; } in + jump $wlookupInArrayCont_ + ds4 bx2 0# (sizeofSmallArray# @Lifted @(Leaf k a) bx2) + } } in + joinrec { + $wlookupCont_ [InlPrag=[2], + Occ=LoopBreaker, + Dmd=SC(S,C(1,C(1,C(1,L))))] + :: Word# -> k -> Int# -> HashMap k a -> Bool + [LclId[JoinId(4)(Just [~, !, ~, !])], + Arity=4, + Str=<L><1L><L><1L>, + Unf=OtherCon []] + $wlookupCont_ (ww1 :: Word#) + (ds4 :: k) + (ww2 :: Int#) + (ds5 :: HashMap k a) + = case ds4 of ds6 { __DEFAULT -> + case ds5 of { + Empty -> GHC.Internal.Types.True; + Leaf bx1 ds7 -> jump exit ww1 ds6 bx1 ds7; + Collision bx1 bx2 -> jump exit1 ww1 ds6 bx1 bx2; + BitmapIndexed bx1 bx2 -> + let { + m :: Word# + [LclId] + m = uncheckedShiftL# + 1## (word2Int# (and# (uncheckedShiftRL# ww1 ww2) 31##)) } in + case and# bx1 m of { + __DEFAULT -> + case indexSmallArray# + @Lifted + @(HashMap k a) + bx2 + (word2Int# (popCnt# (and# bx1 (minusWord# m 1##)))) + of + { (# ipv #) -> + jump $wlookupCont_ ww1 ds6 (+# ww2 5#) ipv + }; + 0## -> GHC.Internal.Types.True + }; + Full bx1 -> + case indexSmallArray# + @Lifted + @(HashMap k a) + bx1 + (word2Int# (and# (uncheckedShiftRL# ww1 ww2) 31##)) + of + { (# ipv #) -> + jump $wlookupCont_ ww1 ds6 (+# ww2 5#) ipv + } + } + }; } in + jump $wlookupCont_ bx k0 ww ds + } + }; + Collision bx bx1 -> + T26615a.disjointSubtrees_$s$wdisjointSubtrees + @k @b @a $dEq ww bx bx1 ds + } } in + case ds of { + Empty -> GHC.Internal.Types.True; + Leaf bx ds1 -> + case ds1 of { L kA ds2 -> + case _b of wild2 { + __DEFAULT -> + case kA of k0 { __DEFAULT -> + join { + exit [Dmd=LC(S,C(1,C(1,C(1,L))))] + :: Word# -> k -> Word# -> Leaf k b -> Bool + [LclId[JoinId(4)(Just [~, ~, ~, !])], + Arity=4, + Str=<L><L><L><1P(L,A)>] + exit (ww1 [OS=OneShot] :: Word#) + (ds3 [OS=OneShot] :: k) + (bx1 [OS=OneShot] :: Word#) + (ds4 [OS=OneShot] :: Leaf k b) + = case ds4 of { L kx x -> + case eqWord# ww1 bx1 of { + __DEFAULT -> GHC.Internal.Types.True; + 1# -> + case == @k $dEq ds3 kx of { + False -> GHC.Internal.Types.True; + True -> GHC.Internal.Types.False + } + } + } } in + join { + exit1 [Dmd=LC(S,C(1,C(1,C(1,L))))] + :: Word# -> k -> Word# -> SmallArray# (Leaf k b) -> Bool + [LclId[JoinId(4)(Nothing)], Arity=4, Str=<L><ML><L><L>] + exit1 (ww1 [OS=OneShot] :: Word#) + (ds3 [OS=OneShot] :: k) + (bx1 [OS=OneShot] :: Word#) + (bx2 [OS=OneShot] :: SmallArray# (Leaf k b)) + = case eqWord# ww1 bx1 of { + __DEFAULT -> GHC.Internal.Types.True; + 1# -> + joinrec { + $wlookupInArrayCont_ [InlPrag=[2], + Occ=LoopBreaker, + Dmd=SC(S,C(1,C(1,C(1,L))))] + :: k -> SmallArray# (Leaf k b) -> Int# -> Int# -> Bool + [LclId[JoinId(4)(Just [!])], + Arity=4, + Str=<1L><L><L><L>, + Unf=OtherCon []] + $wlookupInArrayCont_ (k1 :: k) + (ww2 :: SmallArray# (Leaf k b)) + (ww3 :: Int#) + (ww4 :: Int#) + = case k1 of k2 { __DEFAULT -> + case >=# ww3 ww4 of { + __DEFAULT -> + case indexSmallArray# @Lifted @(Leaf k b) ww2 ww3 of + { (# ipv #) -> + case ipv of { L kx v -> + case == @k $dEq k2 kx of { + False -> jump $wlookupInArrayCont_ k2 ww2 (+# ww3 1#) ww4; + True -> GHC.Internal.Types.False + } + } + }; + 1# -> GHC.Internal.Types.True + } + }; } in + jump $wlookupInArrayCont_ + ds3 bx2 0# (sizeofSmallArray# @Lifted @(Leaf k b) bx2) + } } in + joinrec { + $wlookupCont_ [InlPrag=[2], + Occ=LoopBreaker, + Dmd=SC(S,C(1,C(1,C(1,L))))] + :: Word# -> k -> Int# -> HashMap k b -> Bool + [LclId[JoinId(4)(Just [~, !, ~, !])], + Arity=4, + Str=<L><1L><L><1L>, + Unf=OtherCon []] + $wlookupCont_ (ww1 :: Word#) + (ds3 :: k) + (ww2 :: Int#) + (ds4 :: HashMap k b) + = case ds3 of ds5 { __DEFAULT -> + case ds4 of { + Empty -> GHC.Internal.Types.True; + Leaf bx1 ds6 -> jump exit ww1 ds5 bx1 ds6; + Collision bx1 bx2 -> jump exit1 ww1 ds5 bx1 bx2; + BitmapIndexed bx1 bx2 -> + let { + m :: Word# + [LclId] + m = uncheckedShiftL# + 1## (word2Int# (and# (uncheckedShiftRL# ww1 ww2) 31##)) } in + case and# bx1 m of { + __DEFAULT -> + case indexSmallArray# + @Lifted + @(HashMap k b) + bx2 + (word2Int# (popCnt# (and# bx1 (minusWord# m 1##)))) + of + { (# ipv #) -> + jump $wlookupCont_ ww1 ds5 (+# ww2 5#) ipv + }; + 0## -> GHC.Internal.Types.True + }; + Full bx1 -> + case indexSmallArray# + @Lifted + @(HashMap k b) + bx1 + (word2Int# (and# (uncheckedShiftRL# ww1 ww2) 31##)) + of + { (# ipv #) -> + jump $wlookupCont_ ww1 ds5 (+# ww2 5#) ipv + } + } + }; } in + jump $wlookupCont_ bx k0 ww wild2 + }; + Leaf bx1 ds3 -> + case ds3 of { L kB ds4 -> + case neWord# bx bx1 of { + __DEFAULT -> /= @k $dEq kA kB; + 1# -> GHC.Internal.Types.True + } + } + } + }; + Collision bx bx1 -> + case _b of { + __DEFAULT -> jump fail GHC.Internal.Types.(##); + Collision bx2 bx3 -> + T26615a.$wdisjointCollisions + @k @a @b $dEq bx (T26615a.Array @(Leaf k a) bx1) bx2 bx3; + BitmapIndexed bx2 bx3 -> + let { + m :: Word# + [LclId] + m = uncheckedShiftL# + 1## (word2Int# (and# (uncheckedShiftRL# bx ww) 31##)) } in + case and# m bx2 of { + __DEFAULT -> + case indexSmallArray# + @Lifted + @(HashMap k b) + bx3 + (word2Int# (popCnt# (and# bx2 (minusWord# m 1##)))) + of + { (# ipv #) -> + T26615a.disjointSubtrees_$s$wdisjointSubtrees + @k @a @b $dEq (+# ww 5#) bx bx1 ipv + }; + 0## -> GHC.Internal.Types.True + }; + Full bx2 -> + case indexSmallArray# + @Lifted + @(HashMap k b) + bx2 + (word2Int# (and# (uncheckedShiftRL# bx ww) 31##)) + of + { (# ipv #) -> + T26615a.disjointSubtrees_$s$wdisjointSubtrees + @k @a @b $dEq (+# ww 5#) bx bx1 ipv + } + }; + BitmapIndexed bx bx1 -> + case _b of { + __DEFAULT -> jump fail GHC.Internal.Types.(##); + BitmapIndexed bx2 bx3 -> + case and# bx bx2 of wild2 { + __DEFAULT -> + case GHC.Internal.Unsafe.Coerce.unsafeEqualityProof + @(*) + @(SmallArray# (HashMap k a) -> SmallArray# (HashMap k b) -> Int#) + @(GHC.Internal.Types.UnusedType 0 "a" + -> GHC.Internal.Types.UnusedType 1 "b" -> Int#) + of + { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> + case reallyUnsafePtrEquality# + @Lifted + @Lifted + @(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.UnusedType 0 "a")) + (bx3 + `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) + :: SmallArray# (HashMap k b) + ~R# GHC.Internal.Types.UnusedType 1 "b")) + of { + __DEFAULT -> + let { + lvl2 :: Int# + [LclId] + lvl2 = +# ww 5# } in + joinrec { + $wgo [InlPrag=[2], Occ=LoopBreaker, Dmd=SC(S,L)] :: Word# -> Bool + [LclId[JoinId(1)(Nothing)], Arity=1, Str=<1L>, Unf=OtherCon []] + $wgo (ww1 :: Word#) + = case ww1 of ds1 { + __DEFAULT -> + let { + m :: Word# + [LclId] + m = and# ds1 (int2Word# (negateInt# (word2Int# ds1))) } in + case indexSmallArray# + @Lifted + @(HashMap k a) + bx1 + (word2Int# (popCnt# (and# bx (minusWord# m 1##)))) + of + { (# ipv #) -> + case indexSmallArray# + @Lifted + @(HashMap k b) + bx3 + (word2Int# (popCnt# (and# bx2 (minusWord# m 1##)))) + of + { (# ipv1 #) -> + case T26615a.$wdisjointSubtrees @k @a @b $dEq lvl2 ipv ipv1 of { + False -> GHC.Internal.Types.False; + True -> jump $wgo (and# ds1 (not# m)) + } + } + }; + 0## -> GHC.Internal.Types.True + }; } in + jump $wgo wild2; + 1# -> GHC.Internal.Types.False + } + }; + 0## -> GHC.Internal.Types.True + }; + Full bx2 -> + let { + lvl2 :: Int# + [LclId] + lvl2 = +# ww 5# } in + joinrec { + $wgo [InlPrag=[2], Occ=LoopBreaker, Dmd=SC(S,L)] :: Word# -> Bool + [LclId[JoinId(1)(Nothing)], Arity=1, Str=<1L>, Unf=OtherCon []] + $wgo (ww1 :: Word#) + = case ww1 of ds1 { + __DEFAULT -> + let { + m :: Word# + [LclId] + m = and# ds1 (int2Word# (negateInt# (word2Int# ds1))) } in + case indexSmallArray# + @Lifted + @(HashMap k a) + bx1 + (word2Int# (popCnt# (and# bx (minusWord# m 1##)))) + of + { (# ipv #) -> + case indexSmallArray# + @Lifted + @(HashMap k b) + bx2 + (word2Int# (popCnt# (and# 4294967295## (minusWord# m 1##)))) + of + { (# ipv1 #) -> + case T26615a.$wdisjointSubtrees @k @a @b $dEq lvl2 ipv ipv1 of { + False -> GHC.Internal.Types.False; + True -> jump $wgo (and# ds1 (not# m)) + } + } + }; + 0## -> GHC.Internal.Types.True + }; } in + jump $wgo (and# bx 4294967295##) + }; + Full bx -> + case _b of { + __DEFAULT -> jump fail GHC.Internal.Types.(##); + BitmapIndexed bx1 bx2 -> + let { + lvl2 :: Int# + [LclId] + lvl2 = +# ww 5# } in + joinrec { + $wgo [InlPrag=[2], Occ=LoopBreaker, Dmd=SC(S,L)] :: Word# -> Bool + [LclId[JoinId(1)(Nothing)], Arity=1, Str=<1L>, Unf=OtherCon []] + $wgo (ww1 :: Word#) + = case ww1 of ds1 { + __DEFAULT -> + let { + m :: Word# + [LclId] + m = and# ds1 (int2Word# (negateInt# (word2Int# ds1))) } in + case indexSmallArray# + @Lifted + @(HashMap k a) + bx + (word2Int# (popCnt# (and# 4294967295## (minusWord# m 1##)))) + of + { (# ipv #) -> + case indexSmallArray# + @Lifted + @(HashMap k b) + bx2 + (word2Int# (popCnt# (and# bx1 (minusWord# m 1##)))) + of + { (# ipv1 #) -> + case T26615a.$wdisjointSubtrees @k @a @b $dEq lvl2 ipv ipv1 of { + False -> GHC.Internal.Types.False; + True -> jump $wgo (and# ds1 (not# m)) + } + } + }; + 0## -> GHC.Internal.Types.True + }; } in + jump $wgo (and# 4294967295## bx1); + Full bx1 -> + case GHC.Internal.Unsafe.Coerce.unsafeEqualityProof + @(*) + @(SmallArray# (HashMap k a) -> SmallArray# (HashMap k b) -> Int#) + @(GHC.Internal.Types.UnusedType 0 "a" + -> GHC.Internal.Types.UnusedType 1 "b" -> Int#) + of + { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> + case reallyUnsafePtrEquality# + @Lifted + @Lifted + @(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.UnusedType 0 "a")) + (bx1 + `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) + :: SmallArray# (HashMap k b) + ~R# GHC.Internal.Types.UnusedType 1 "b")) + of { + __DEFAULT -> + let { + lvl2 :: Int# + [LclId] + lvl2 = +# ww 5# } in + joinrec { + $wgo [InlPrag=[2], Occ=LoopBreaker, Dmd=SC(S,L)] :: Int# -> Bool + [LclId[JoinId(1)(Nothing)], Arity=1, Str=<L>, Unf=OtherCon []] + $wgo (ww1 :: Int#) + = case <# ww1 0# of { + __DEFAULT -> + case indexSmallArray# @Lifted @(HashMap k a) bx ww1 of + { (# ipv #) -> + case indexSmallArray# @Lifted @(HashMap k b) bx1 ww1 of + { (# ipv1 #) -> + case T26615a.$wdisjointSubtrees @k @a @b $dEq lvl2 ipv ipv1 of { + False -> GHC.Internal.Types.False; + True -> jump $wgo (-# ww1 1#) + } + } + }; + 1# -> GHC.Internal.Types.True + }; } in + jump $wgo 31#; + 1# -> GHC.Internal.Types.False + } + } + } + } +end Rec } + +-- RHS size: {terms: 15, types: 17, coercions: 0, joins: 0/0} +disjointSubtrees [InlPrag=INLINABLE[2]] + :: forall k a b. Eq k => Int -> HashMap k a -> HashMap k b -> Bool +[GblId, + Arity=4, + Str=<LP(LC(L,C(1,L)),LC(S,C(1,L)))><1!P(L)><SL><L>, + Unf=Unf{Src=StableSystem, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=4,unsat_ok=True,boring_ok=False) + Tmpl= \ (@k) + (@a) + (@b) + ($dEq [Occ=Once1] :: Eq k) + (_s [Occ=Once1!] :: Int) + (ds [Occ=Once1] :: HashMap k a) + (_b [Occ=Once1] :: HashMap k b) -> + case _s of { I# ww [Occ=Once1] -> + T26615a.$wdisjointSubtrees @k @a @b $dEq ww ds _b + }}] +disjointSubtrees + = \ (@k) + (@a) + (@b) + ($dEq :: Eq k) + (_s :: Int) + (ds :: HashMap k a) + (_b :: HashMap k b) -> + case _s of { I# ww -> + T26615a.$wdisjointSubtrees @k @a @b $dEq ww ds _b + } + + +------ Local rules for imported ids -------- +"SC:$wdisjointSubtrees1" [1] + forall (@k) + (@b) + (@a) + (sc :: Eq k) + (sc1 :: Int#) + (sc2 :: Word#) + (sc3 :: SmallArray# (Leaf k b)) + (sc4 :: Word#) + (sc5 :: SmallArray# (Leaf k a)). + T26615a.$wdisjointSubtrees @k + @b + @a + sc + sc1 + (T26615a.Collision @k @b sc2 sc3) + (T26615a.Collision @k @a sc4 sc5) + = T26615a.$wdisjointCollisions + @k @b @a sc sc2 (T26615a.Array @(Leaf k b) sc3) sc4 sc5 +"SC:$wdisjointSubtrees0" [1] + forall (@k) + (@a) + (@b) + (sc :: Eq k) + (sc1 :: Int#) + (sc2 :: Word#) + (sc3 :: SmallArray# (Leaf k a)). + T26615a.$wdisjointSubtrees @k + @a + @b + sc + sc1 + (T26615a.Collision @k @a sc2 sc3) + = T26615a.disjointSubtrees_$s$wdisjointSubtrees + @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: 682, coercions: 18, joins: 8/14} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule1 :: GHC.Internal.Prim.Addr# +[GblId, Unf=OtherCon []] +$trModule1 = "T26615"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$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} +$trModule3 :: GHC.Internal.Prim.Addr# +[GblId, Unf=OtherCon []] +$trModule3 = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$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 [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# +[GblId, Unf=OtherCon []] +lvl = "T26615a.hs:(26,1)-(65,59)|function disjointSubtrees"# + +-- RHS size: {terms: 2, types: 2, coercions: 0, joins: 0/0} +lvl1 :: () +[GblId, Str=b, Cpr=b] +lvl1 + = GHC.Internal.Control.Exception.Base.patError + @GHC.Internal.Types.LiftedRep @() lvl + +Rec { +-- RHS size: {terms: 37, types: 30, coercions: 0, joins: 0/0} +$wpoly_lookupInArrayCont_ + :: forall a. + String + -> GHC.Internal.Prim.SmallArray# (T26615a.Leaf String a) + -> GHC.Internal.Prim.Int# + -> GHC.Internal.Prim.Int# + -> Bool +[GblId[StrictWorker([!])], + Arity=4, + Str=<1L><L><L><L>, + Unf=OtherCon []] +$wpoly_lookupInArrayCont_ + = \ (@a) + (k1 :: String) + (ww :: GHC.Internal.Prim.SmallArray# (T26615a.Leaf String a)) + (ww1 :: GHC.Internal.Prim.Int#) + (ww2 :: GHC.Internal.Prim.Int#) -> + case k1 of k2 { __DEFAULT -> + case GHC.Internal.Prim.>=# ww1 ww2 of { + __DEFAULT -> + case GHC.Internal.Prim.indexSmallArray# + @GHC.Internal.Types.Lifted @(T26615a.Leaf String a) ww ww1 + of + { (# ipv5 #) -> + case ipv5 of { T26615a.L kx v -> + case GHC.Internal.Base.eqString k2 kx of { + False -> + $wpoly_lookupInArrayCont_ + @a k2 ww (GHC.Internal.Prim.+# ww1 1#) ww2; + True -> GHC.Internal.Types.False + } + } + }; + 1# -> GHC.Internal.Types.True + } + } +end Rec } + +Rec { +-- RHS size: {terms: 98, types: 73, coercions: 0, joins: 0/1} +$wpoly_lookupCont_ + :: forall a. + GHC.Internal.Prim.Word# + -> String -> GHC.Internal.Prim.Int# -> HashMap String a -> Bool +[GblId[StrictWorker([~, !, ~, !])], + Arity=4, + Str=<L><1L><L><1L>, + Unf=OtherCon []] +$wpoly_lookupCont_ + = \ (@a) + (ww :: GHC.Internal.Prim.Word#) + (ds5 :: String) + (ww1 :: GHC.Internal.Prim.Int#) + (ds7 :: HashMap String a) -> + case ds5 of ds9 { __DEFAULT -> + case ds7 of { + T26615a.Empty -> GHC.Internal.Types.True; + T26615a.Leaf bx1 ds11 -> + case ds11 of { T26615a.L kx x -> + case GHC.Internal.Prim.eqWord# ww bx1 of { + __DEFAULT -> GHC.Internal.Types.True; + 1# -> + case GHC.Internal.Base.eqString ds9 kx of { + False -> GHC.Internal.Types.True; + True -> GHC.Internal.Types.False + } + } + }; + T26615a.Collision bx1 bx2 -> + case GHC.Internal.Prim.eqWord# ww bx1 of { + __DEFAULT -> GHC.Internal.Types.True; + 1# -> + $wpoly_lookupInArrayCont_ + @a + ds9 + bx2 + 0# + (GHC.Internal.Prim.sizeofSmallArray# + @GHC.Internal.Types.Lifted @(T26615a.Leaf String a) bx2) + }; + T26615a.BitmapIndexed bx1 bx2 -> + let { + m :: GHC.Internal.Prim.Word# + [LclId] + m = GHC.Internal.Prim.uncheckedShiftL# + 1## + (GHC.Internal.Prim.word2Int# + (GHC.Internal.Prim.and# + (GHC.Internal.Prim.uncheckedShiftRL# ww ww1) 31##)) } in + case GHC.Internal.Prim.and# bx1 m of { + __DEFAULT -> + case GHC.Internal.Prim.indexSmallArray# + @GHC.Internal.Types.Lifted + @(HashMap String a) + bx2 + (GHC.Internal.Prim.word2Int# + (GHC.Internal.Prim.popCnt# + (GHC.Internal.Prim.and# bx1 (GHC.Internal.Prim.minusWord# m 1##)))) + of + { (# ipv2 #) -> + $wpoly_lookupCont_ @a ww ds9 (GHC.Internal.Prim.+# ww1 5#) ipv2 + }; + 0## -> GHC.Internal.Types.True + }; + T26615a.Full bx1 -> + case GHC.Internal.Prim.indexSmallArray# + @GHC.Internal.Types.Lifted + @(HashMap String a) + bx1 + (GHC.Internal.Prim.word2Int# + (GHC.Internal.Prim.and# + (GHC.Internal.Prim.uncheckedShiftRL# ww ww1) 31##)) + of + { (# ipv2 #) -> + $wpoly_lookupCont_ @a ww ds9 (GHC.Internal.Prim.+# ww1 5#) ipv2 + } + } + } +end Rec } + +Rec { +-- RHS size: {terms: 448, types: 523, coercions: 18, joins: 8/13} +T26615.$s$wdisjointSubtrees [InlPrag=[~], Occ=LoopBreaker] + :: forall a b. + GHC.Internal.Prim.Int# + -> HashMap String a -> HashMap String b -> Bool +[GblId, Arity=3, Str=<L><SL><L>, Unf=OtherCon []] +T26615.$s$wdisjointSubtrees + = \ (@a) + (@b) + (ww :: GHC.Internal.Prim.Int#) + (ds :: HashMap String a) + (_b :: HashMap String b) -> + join { + fail [Dmd=MC(1,L)] :: (# #) -> Bool + [LclId[JoinId(1)(Nothing)], Arity=1, Str=<A>, Unf=OtherCon []] + fail (ds1 [Occ=Dead, OS=OneShot] :: (# #)) + = case _b of wild { + __DEFAULT -> case lvl1 of {}; + T26615a.Empty -> GHC.Internal.Types.True; + T26615a.Leaf bx ds2 -> + case ds2 of { T26615a.L kB ds3 -> + $wpoly_lookupCont_ @a bx kB ww ds + }; + T26615a.Collision bx bx1 -> + T26615.$s$wdisjointSubtrees @b @a ww wild ds + } } in + case ds of wild { + T26615a.Empty -> GHC.Internal.Types.True; + T26615a.Leaf bx ds1 -> + case ds1 of { T26615a.L kA ds2 -> + case _b of wild2 { + __DEFAULT -> $wpoly_lookupCont_ @b bx kA ww wild2; + T26615a.Leaf bx1 ds3 -> + case ds3 of { T26615a.L kB ds4 -> + case GHC.Internal.Prim.neWord# bx bx1 of { + __DEFAULT -> + case GHC.Internal.Classes.$fEqList_$s$c==1 kA kB of { + False -> GHC.Internal.Types.True; + True -> GHC.Internal.Types.False + }; + 1# -> GHC.Internal.Types.True + } + } + } + }; + T26615a.Collision bx bx1 -> + case _b of { + __DEFAULT -> jump fail GHC.Internal.Types.(##); + T26615a.Collision bx2 bx3 -> + case GHC.Internal.Prim.eqWord# bx bx2 of { + __DEFAULT -> GHC.Internal.Types.True; + 1# -> + let { + lvl2 :: GHC.Internal.Prim.Int# + [LclId] + lvl2 + = GHC.Internal.Prim.sizeofSmallArray# + @GHC.Internal.Types.Lifted @(T26615a.Leaf String b) bx3 } in + joinrec { + $s$wfoldr_ [InlPrag=[2], + Occ=LoopBreaker, + Dmd=SC(S,C(1,C(1,C(1,L))))] + :: 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 + :: GHC.Internal.Prim.SmallArray# (T26615a.Leaf [Char] a)) + (sc1 :: GHC.Internal.Prim.Int#) + (sc2 :: GHC.Internal.Prim.Int#) + (sc3 :: Bool) + = case GHC.Internal.Prim.>=# sc2 sc1 of { + __DEFAULT -> + case GHC.Internal.Prim.indexSmallArray# + @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 sc1 (GHC.Internal.Prim.+# sc2 1#) sc3 } in + joinrec { + $wlookupInArrayCont_ [InlPrag=[2], + Occ=LoopBreaker, + Dmd=SC(S,C(1,C(1,C(1,L))))] + :: String + -> GHC.Internal.Prim.SmallArray# (T26615a.Leaf String b) + -> GHC.Internal.Prim.Int# + -> GHC.Internal.Prim.Int# + -> Bool + [LclId[JoinId(4)(Just [!])], + Arity=4, + Str=<1L><L><L><L>, + Unf=OtherCon []] + $wlookupInArrayCont_ (k1 :: String) + (ww1 + :: GHC.Internal.Prim.SmallArray# + (T26615a.Leaf String b)) + (ww2 :: GHC.Internal.Prim.Int#) + (ww3 :: GHC.Internal.Prim.Int#) + = case k1 of k2 { __DEFAULT -> + case GHC.Internal.Prim.>=# ww2 ww3 of { + __DEFAULT -> + case GHC.Internal.Prim.indexSmallArray# + @GHC.Internal.Types.Lifted + @(T26615a.Leaf String b) + ww1 + ww2 + of + { (# ipv5 #) -> + case ipv5 of { T26615a.L kx v -> + case GHC.Internal.Base.eqString k2 kx of { + False -> + jump $wlookupInArrayCont_ + k2 ww1 (GHC.Internal.Prim.+# ww2 1#) ww3; + True -> GHC.Internal.Types.False + } + } + }; + 1# -> jump $j + } + }; } in + jump $wlookupInArrayCont_ kA bx3 0# lvl2 + } + }; + 1# -> sc3 + }; } in + jump $s$wfoldr_ + bx1 + (GHC.Internal.Prim.sizeofSmallArray# + @GHC.Internal.Types.Lifted @(T26615a.Leaf String a) bx1) + 0# + GHC.Internal.Types.True + }; + T26615a.BitmapIndexed bx2 bx3 -> + let { + m :: GHC.Internal.Prim.Word# + [LclId] + m = GHC.Internal.Prim.uncheckedShiftL# + 1## + (GHC.Internal.Prim.word2Int# + (GHC.Internal.Prim.and# + (GHC.Internal.Prim.uncheckedShiftRL# bx ww) 31##)) } in + case GHC.Internal.Prim.and# m bx2 of { + __DEFAULT -> + case GHC.Internal.Prim.indexSmallArray# + @GHC.Internal.Types.Lifted + @(HashMap String b) + bx3 + (GHC.Internal.Prim.word2Int# + (GHC.Internal.Prim.popCnt# + (GHC.Internal.Prim.and# bx2 (GHC.Internal.Prim.minusWord# m 1##)))) + of + { (# ipv #) -> + T26615.$s$wdisjointSubtrees + @a @b (GHC.Internal.Prim.+# ww 5#) wild ipv + }; + 0## -> GHC.Internal.Types.True + }; + T26615a.Full bx2 -> + case GHC.Internal.Prim.indexSmallArray# + @GHC.Internal.Types.Lifted + @(HashMap String b) + bx2 + (GHC.Internal.Prim.word2Int# + (GHC.Internal.Prim.and# + (GHC.Internal.Prim.uncheckedShiftRL# bx ww) 31##)) + of + { (# ipv #) -> + T26615.$s$wdisjointSubtrees + @a @b (GHC.Internal.Prim.+# ww 5#) wild ipv + } + }; + T26615a.BitmapIndexed bx bx1 -> + case _b of { + __DEFAULT -> jump fail GHC.Internal.Types.(##); + T26615a.BitmapIndexed bx2 bx3 -> + case GHC.Internal.Prim.and# bx bx2 of wild2 { + __DEFAULT -> + case GHC.Internal.Unsafe.Coerce.unsafeEqualityProof + @(*) + @(GHC.Internal.Prim.SmallArray# (HashMap String a) + -> GHC.Internal.Prim.SmallArray# (HashMap String b) + -> GHC.Internal.Prim.Int#) + @(GHC.Internal.Types.UnusedType 0 "a" + -> GHC.Internal.Types.UnusedType 1 "b" -> GHC.Internal.Prim.Int#) + of + { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> + case GHC.Internal.Prim.reallyUnsafePtrEquality# + @GHC.Internal.Types.Lifted + @GHC.Internal.Types.Lifted + @(GHC.Internal.Types.UnusedType 0 "a") + @(GHC.Internal.Types.UnusedType 1 "b") + (bx1 + `cast` (SelCo:Fun(arg) (Sub (Sym v2)) + :: GHC.Internal.Prim.SmallArray# (HashMap String a) + ~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.UnusedType 1 "b")) + of { + __DEFAULT -> + joinrec { + $wgo [InlPrag=[2], Occ=LoopBreaker, Dmd=SC(S,L)] + :: GHC.Internal.Prim.Word# -> Bool + [LclId[JoinId(1)(Nothing)], Arity=1, Str=<1L>, Unf=OtherCon []] + $wgo (ww1 :: GHC.Internal.Prim.Word#) + = case ww1 of ds3 { + __DEFAULT -> + let { + m :: GHC.Internal.Prim.Word# + [LclId] + m = GHC.Internal.Prim.and# + ds3 + (GHC.Internal.Prim.int2Word# + (GHC.Internal.Prim.negateInt# + (GHC.Internal.Prim.word2Int# ds3))) } in + case GHC.Internal.Prim.indexSmallArray# + @GHC.Internal.Types.Lifted + @(HashMap String a) + bx1 + (GHC.Internal.Prim.word2Int# + (GHC.Internal.Prim.popCnt# + (GHC.Internal.Prim.and# + bx (GHC.Internal.Prim.minusWord# m 1##)))) + of + { (# ipv #) -> + case GHC.Internal.Prim.indexSmallArray# + @GHC.Internal.Types.Lifted + @(HashMap String b) + bx3 + (GHC.Internal.Prim.word2Int# + (GHC.Internal.Prim.popCnt# + (GHC.Internal.Prim.and# + bx2 (GHC.Internal.Prim.minusWord# m 1##)))) + of + { (# ipv1 #) -> + case T26615.$s$wdisjointSubtrees + @a @b (GHC.Internal.Prim.+# ww 5#) ipv ipv1 + of { + False -> GHC.Internal.Types.False; + True -> + jump $wgo + (GHC.Internal.Prim.and# ds3 (GHC.Internal.Prim.not# m)) + } + } + }; + 0## -> GHC.Internal.Types.True + }; } in + jump $wgo wild2; + 1# -> GHC.Internal.Types.False + } + }; + 0## -> GHC.Internal.Types.True + }; + T26615a.Full bx2 -> + joinrec { + $wgo [InlPrag=[2], Occ=LoopBreaker, Dmd=SC(S,L)] + :: GHC.Internal.Prim.Word# -> Bool + [LclId[JoinId(1)(Nothing)], Arity=1, Str=<1L>, Unf=OtherCon []] + $wgo (ww1 :: GHC.Internal.Prim.Word#) + = case ww1 of ds3 { + __DEFAULT -> + let { + m :: GHC.Internal.Prim.Word# + [LclId] + m = GHC.Internal.Prim.and# + ds3 + (GHC.Internal.Prim.int2Word# + (GHC.Internal.Prim.negateInt# + (GHC.Internal.Prim.word2Int# ds3))) } in + case GHC.Internal.Prim.indexSmallArray# + @GHC.Internal.Types.Lifted + @(HashMap String a) + bx1 + (GHC.Internal.Prim.word2Int# + (GHC.Internal.Prim.popCnt# + (GHC.Internal.Prim.and# + bx (GHC.Internal.Prim.minusWord# m 1##)))) + of + { (# ipv #) -> + case GHC.Internal.Prim.indexSmallArray# + @GHC.Internal.Types.Lifted + @(HashMap String b) + bx2 + (GHC.Internal.Prim.word2Int# + (GHC.Internal.Prim.popCnt# + (GHC.Internal.Prim.and# + 4294967295## (GHC.Internal.Prim.minusWord# m 1##)))) + of + { (# ipv1 #) -> + case T26615.$s$wdisjointSubtrees + @a @b (GHC.Internal.Prim.+# ww 5#) ipv ipv1 + of { + False -> GHC.Internal.Types.False; + True -> + jump $wgo (GHC.Internal.Prim.and# ds3 (GHC.Internal.Prim.not# m)) + } + } + }; + 0## -> GHC.Internal.Types.True + }; } in + jump $wgo (GHC.Internal.Prim.and# bx 4294967295##) + }; + T26615a.Full bx -> + case _b of { + __DEFAULT -> jump fail GHC.Internal.Types.(##); + T26615a.BitmapIndexed bx1 bx2 -> + joinrec { + $wgo [InlPrag=[2], Occ=LoopBreaker, Dmd=SC(S,L)] + :: GHC.Internal.Prim.Word# -> Bool + [LclId[JoinId(1)(Nothing)], Arity=1, Str=<1L>, Unf=OtherCon []] + $wgo (ww1 :: GHC.Internal.Prim.Word#) + = case ww1 of ds3 { + __DEFAULT -> + let { + m :: GHC.Internal.Prim.Word# + [LclId] + m = GHC.Internal.Prim.and# + ds3 + (GHC.Internal.Prim.int2Word# + (GHC.Internal.Prim.negateInt# + (GHC.Internal.Prim.word2Int# ds3))) } in + case GHC.Internal.Prim.indexSmallArray# + @GHC.Internal.Types.Lifted + @(HashMap String a) + bx + (GHC.Internal.Prim.word2Int# + (GHC.Internal.Prim.popCnt# + (GHC.Internal.Prim.and# + 4294967295## (GHC.Internal.Prim.minusWord# m 1##)))) + of + { (# ipv #) -> + case GHC.Internal.Prim.indexSmallArray# + @GHC.Internal.Types.Lifted + @(HashMap String b) + bx2 + (GHC.Internal.Prim.word2Int# + (GHC.Internal.Prim.popCnt# + (GHC.Internal.Prim.and# + bx1 (GHC.Internal.Prim.minusWord# m 1##)))) + of + { (# ipv1 #) -> + case T26615.$s$wdisjointSubtrees + @a @b (GHC.Internal.Prim.+# ww 5#) ipv ipv1 + of { + False -> GHC.Internal.Types.False; + True -> + jump $wgo (GHC.Internal.Prim.and# ds3 (GHC.Internal.Prim.not# m)) + } + } + }; + 0## -> GHC.Internal.Types.True + }; } in + jump $wgo (GHC.Internal.Prim.and# 4294967295## bx1); + T26615a.Full bx1 -> + case GHC.Internal.Unsafe.Coerce.unsafeEqualityProof + @(*) + @(GHC.Internal.Prim.SmallArray# (HashMap String a) + -> GHC.Internal.Prim.SmallArray# (HashMap String b) + -> GHC.Internal.Prim.Int#) + @(GHC.Internal.Types.UnusedType 0 "a" + -> GHC.Internal.Types.UnusedType 1 "b" -> GHC.Internal.Prim.Int#) + of + { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> + case GHC.Internal.Prim.reallyUnsafePtrEquality# + @GHC.Internal.Types.Lifted + @GHC.Internal.Types.Lifted + @(GHC.Internal.Types.UnusedType 0 "a") + @(GHC.Internal.Types.UnusedType 1 "b") + (bx + `cast` (SelCo:Fun(arg) (Sub (Sym v2)) + :: GHC.Internal.Prim.SmallArray# (HashMap String a) + ~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.UnusedType 1 "b")) + of { + __DEFAULT -> + joinrec { + $wgo [InlPrag=[2], Occ=LoopBreaker, Dmd=SC(S,L)] + :: GHC.Internal.Prim.Int# -> Bool + [LclId[JoinId(1)(Nothing)], Arity=1, Str=<L>, Unf=OtherCon []] + $wgo (ww1 :: GHC.Internal.Prim.Int#) + = case GHC.Internal.Prim.<# ww1 0# of { + __DEFAULT -> + case GHC.Internal.Prim.indexSmallArray# + @GHC.Internal.Types.Lifted @(HashMap String a) bx ww1 + of + { (# ipv #) -> + case GHC.Internal.Prim.indexSmallArray# + @GHC.Internal.Types.Lifted @(HashMap String b) bx1 ww1 + of + { (# ipv1 #) -> + case T26615.$s$wdisjointSubtrees + @a @b (GHC.Internal.Prim.+# ww 5#) ipv ipv1 + of { + False -> GHC.Internal.Types.False; + True -> jump $wgo (GHC.Internal.Prim.-# ww1 1#) + } + } + }; + 1# -> GHC.Internal.Types.True + }; } in + jump $wgo 31#; + 1# -> GHC.Internal.Types.False + } + } + } + } +end Rec } + +-- RHS size: {terms: 8, types: 10, coercions: 0, joins: 0/0} +f :: forall a b. HashMap String a -> HashMap String b -> Bool +[GblId, + Arity=2, + Str=<SL><L>, + Unf=Unf{Src=<vanilla>, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=IF_ARGS [0 0] 40 0}] +f = \ (@a) + (@b) + (ds :: HashMap String a) + (_b :: HashMap String b) -> + T26615.$s$wdisjointSubtrees @a @b 0# ds _b + + +------ Local rules for imported ids -------- +"SPEC/T26615 $wdisjointSubtrees @String @_ @_" [2] + 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.Types.ZonkAny 0’ with ‘IO’ + • Couldn't match type ‘m00’ with ‘IO’ Expected: IO () - Actual: GHC.Types.ZonkAny 0 () + Actual: m00 • 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.Types.ZonkAny 0’ with ‘IO’ + • Couldn't match type ‘m00’ with ‘IO’ Expected: IO () - Actual: GHC.Types.ZonkAny 0 () + Actual: m00 • In the expression: main When checking the type of the IO action ‘main’ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/03caad93a9367947fb8cff4623d9e09… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/03caad93a9367947fb8cff4623d9e09… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/mangoiv/backport-unused-type] cherrypick unused-type
by Magnus (＠MangoIV) 18 Jun '26

18 Jun '26

Magnus pushed to branch wip/mangoiv/backport-unused-type at Glasgow Haskell Compiler / GHC Commits: 1fbacc81 by mangoiv at 2026-06-18T13:06:00+02:00 cherrypick unused-type - - - - - 15 changed files: - 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 - 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 Changes: ===================================== compiler/GHC/Builtin/Names.hs ===================================== @@ -2007,8 +2007,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 ===================================== @@ -92,7 +92,7 @@ module GHC.Builtin.Types ( cTupleSelId, cTupleSelIdName, -- * Any - anyTyCon, anyTy, anyTypeOfKind, zonkAnyTyCon, + anyTyCon, anyTy, anyTypeOfKind, unusedTypeTyCon, -- * Recovery TyCon makeRecoveryTyCon, @@ -310,7 +310,7 @@ wiredInTyCons = map (dataConTyCon . snd) boxingDataCons , soloTyCon , anyTyCon - , zonkAnyTyCon + , unusedTypeTyCon , boolTyCon , charTyCon , stringTyCon @@ -421,13 +421,13 @@ doubleDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "D#") {- Note [Any types] ~~~~~~~~~~~~~~~~ -The type constructors `Any` and `ZonkAny` are closed type families declared thus: +The type constructors `Any` and `UnusedType` are closed type families declared thus: - 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. Nat -> 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 +what that type is. The leading example is this: `UnusedType` is used to instantiate un-constrained type variables after type checking. For example, consider the term (length [] :: Int), where @@ -440,26 +440,26 @@ The typechecker will end up with length @alpha ([] @alpha) 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 +that unconstrained `alpha` to an arbitrary type (UnusedType @Type 3 "a"), where the `3` is +arbitrary (see wrinkle (Any5) below). and `a` is the original name, if we have one. +This is done in `GHC.Tc.Zonk.Type.commitFlexi`. So we end up with - length @(ZonkAny @Type 3) ([] @(ZonkAny @Type 3)) + length @(UnusedType @Type 3 "a") ([] @(UnusedType @Type 3 "a")) -`Any` and `ZonkAny` differ only in the presence of the `Nat` argument; see -wrinkle (Any4). +`Any` and `UnusedType` differ only in the presence of the `Nat` and the `Symbol` arguments; +see wrinkle (Any4). Wrinkles: -(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 * +(Any1) `Any` and `UnusedType` are kind polymorphic since in some program we may + need to use `UnusedType` 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 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 @@ -469,7 +469,7 @@ Wrinkles: the code generator, because the code gen may /enter/ a data value but never enters a function value. -(Any4) `ZonkAny` takes a `Nat` argument so that we can readily make up /distinct/ +(Any4) `UnusedType` takes a `Nat` argument so that we can readily make up /distinct/ types (#24817). Consider data SBool a where { STrue :: SBool True; SFalse :: SBool False } @@ -484,17 +484,29 @@ 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 4 "a" and beta := UnusedType @Type k 5 "b" (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 + `UnusedType` takes a `Symbol` argument so we can neatly display the type to the user. + While `UnusedType` ought to be an implementation detail, we sometimes leak it to the + user, especially in consumers of the GHC api like haskell-language-server. + The user does not know what an `UnusedType` is and just expects a meta variable. + However, since the process of zonking should remove all meta variables, we just try to + reconstruct it when pretty printing, e.g. + `UnusedType 3 "foo" :: Type` becomes `foo_3` + + Historical note: `UnusedType` was called `ZonkAny` in older versions of the compiler + but since this is a leaky abstractions (see above) we give it this improved name + and handle it specially in the pretty printer to avoid confusion of the user. + +(Any5) `Any` and `UnusedType` 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 @@ -502,7 +514,7 @@ Wrinkles: 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. + Currently `UnusedType` is not available to users; but it could easily be. (Any7) Properties of `Any`: * When `Any` is instantiated at a lifted type it is inhabited by at least one value, @@ -521,6 +533,17 @@ Wrinkles: See examples in ghc-prim:GHC.Types +(Any8) Warning 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 } + + where forever :: forall a b. IO a -> IO b + Nothing constrains `b`, so it will be instantiates with `Any` or `UnusedType`. + But we certainly don't want to complain about a discarded do-binding. + 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 bit of history. @@ -547,23 +570,25 @@ 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 +unusedTypeTyCon :: TyCon +-- unusedTypeTyCon :: forall k. Nat -> Symbol -> k -- See Note [Any types] -zonkAnyTyCon = mkFamilyTyCon zonkAnyTyConName - [ mkNamedTyConBinder Specified kv - , mkAnonTyConBinder nat_kv ] - (mkTyVarTy kv) +unusedTypeTyCon = mkFamilyTyCon unusedTypeTyConName kind bndrs 0 res_kind Nothing (ClosedSynFamilyTyCon Nothing) Nothing NotInjective where - [kv,nat_kv] = mkTemplateKindVars [liftedTypeKind, naturalTy] + [kv,nat_kv,sym_kv] = mkTemplateKindVars [liftedTypeKind, naturalTy, typeSymbolKind] + bndrs = [ mkNamedTyConBinder Specified kv + , mkAnonTyConBinder nat_kv + , mkAnonTyConBinder sym_kv ] + res_kind = mkTyVarTy kv + kind = mkTyConKind bndrs res_kind -- | Make a fake, recovery 'TyCon' from an existing one. -- Used when recovering from errors in type declarations ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -985,9 +985,13 @@ warnDiscardedDoBindings rhs rhs_ty ; when (warn_unused || warn_wrong) $ do { fam_inst_envs <- dsGetFamInstEnvs ; let norm_elt_ty = topNormaliseType fam_inst_envs elt_ty - - -- Warn about discarding non-() things in 'monadic' binding - ; if warn_unused && not (isUnitTy norm_elt_ty) + supressible_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 `()` + -- * `UnusedType` or `Any` type see (Any8) of Note [Any types] + ; 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 #-} {-# LANGUAGE LambdaCase #-} module GHC.Iface.Type ( IfExtName, @@ -1664,6 +1664,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)) @@ -1715,6 +1716,12 @@ pprTyTcApp ctxt_prec tc tys = | Just doc <- ppr_equality ctxt_prec tc (appArgsIfaceTypes tys) -> doc + | ifaceTyConName tc `hasKey` unusedTypeTyConKey + , (arg_k : IfaceLitTy (IfaceNumTyLit arg_n) : IfaceLitTy (IfaceStrTyLit arg_nm) : _) <- appArgsIfaceTypes 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_n arg_nm + | otherwise -> ppr_iface_tc_app ppr_app_arg ctxt_prec tc $ appArgsIfaceTypesForAllTyFlags $ stripInvisArgs (PrintExplicitKinds print_kinds) tys @@ -1727,6 +1734,15 @@ ppr_kind_type ctxt_prec = sdocOption sdocStarIsType $ \case True -> maybeParen ctxt_prec starPrec $ unicodeSyntax (char '★') (char '*') +ppr_iface_unused_ty_tycon :: PprPrec -> IfaceType -> Integer -> LexicalFastString -> SDoc +ppr_iface_unused_ty_tycon ctxt_prec arg_k arg_n arg_nm + = sdocOption sdocPrintExplicitKinds $ \print_kinds -> + sdocOption sdocPrintExplicitRuntimeReps $ \print_reps -> + if print_kinds || print_reps + then maybeParen ctxt_prec sigPrec $ prettyMeta <+> text "::" <+> pprIfaceType arg_k + else prettyMeta + where prettyMeta = ppr arg_nm <> ppr arg_n + -- | Pretty-print a type-level equality. -- Returns (Just doc) if the argument is a /saturated/ application -- of eqTyCon (~) @@ -2113,7 +2129,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 ===================================== @@ -569,7 +569,7 @@ data TcGblEnv -- ^ Allows us to choose unique DFun names. tcg_zany_n :: TcRef Integer, - -- ^ A source of unique identities for ZonkAny instances + -- ^ A source of unique identities for UnusedType instances -- See Note [Any types] in GHC.Builtin.Types, wrinkle (Any4) tcg_merged :: [(Module, Fingerprint)], ===================================== compiler/GHC/Tc/Utils/Monad.hs ===================================== @@ -142,7 +142,7 @@ module GHC.Tc.Utils.Monad( getCCIndexM, getCCIndexTcM, -- * Zonking - liftZonkM, newZonkAnyType, + liftZonkM, newUnusedType, -- * Complete matches localAndImportedCompleteMatches, getCompleteMatchesTcM, @@ -156,7 +156,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.Types -- Re-export all @@ -180,7 +180,7 @@ import GHC.Core.UsageEnv import GHC.Core.Multiplicity import GHC.Core.InstEnv import GHC.Core.FamInstEnv -import GHC.Core.Type( mkNumLitTy ) +import GHC.Core.Type( mkNumLitTy, mkStrLitTy ) import GHC.Driver.Env import GHC.Driver.Session @@ -1792,17 +1792,17 @@ 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 +newUnusedType :: Name -> Kind -> TcM Type +-- Return a type (UnusedType @k n sym), where n is fresh +-- Recall UnusedType :: forall k. Natural -> Symbol -> k -- See Note [Any types] in GHC.Builtin.Types, wrinkle (Any4) -newZonkAnyType kind +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]) } + ; return (mkTyConApp unusedTypeTyCon [kind, mkNumLitTy i, mkStrLitTy $ getOccFS name ]) } getConstraintVar :: TcM (TcRef WantedConstraints) getConstraintVar = do { env <- getLclEnv; return (tcl_lie env) } ===================================== compiler/GHC/Tc/Utils/TcType.hs ===================================== @@ -88,7 +88,7 @@ module GHC.Tc.Utils.TcType ( isSigmaTy, isRhoTy, isRhoExpTy, isOverloadedTy, isFloatingPrimTy, isDoubleTy, isFloatTy, isIntTy, isWordTy, isStringTy, isIntegerTy, isNaturalTy, - isBoolTy, isUnitTy, isCharTy, + isBoolTy, isUnitTy, isAnyTy, isUnusedTypeTy, isCharTy, isTauTy, isTauTyCon, tcIsTyVarTy, isPredTy, isTyVarClassPred, checkValidClsArgs, hasTyVarHead, @@ -2005,7 +2005,7 @@ isFloatTy, isDoubleTy, isFloatPrimTy, isDoublePrimTy, isIntegerTy, isNaturalTy, isIntTy, isWordTy, isBoolTy, - isUnitTy, isCharTy :: Type -> Bool + isUnitTy, isAnyTy, isUnusedTypeTy, isCharTy :: Type -> Bool isFloatTy = is_tc floatTyConKey isDoubleTy = is_tc doubleTyConKey isFloatPrimTy = is_tc floatPrimTyConKey @@ -2016,6 +2016,8 @@ isIntTy = is_tc intTyConKey isWordTy = is_tc wordTyConKey isBoolTy = is_tc boolTyConKey isUnitTy = is_tc unitTyConKey +isAnyTy = is_tc anyTyConKey +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 #-} {-# LANGUAGE GADTs #-} {- @@ -54,7 +55,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.Constraint import GHC.Tc.Types.Evidence import GHC.Tc.Errors.Types @@ -471,7 +472,7 @@ commitFlexi tv 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 } + ; newUnusedType zonked_kind } RuntimeUnkFlexi -> do { traceTc "Defaulting flexi tyvar to RuntimeUnk:" (pprTyVar tv) ===================================== 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.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.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.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.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.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.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.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.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.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.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.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.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.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.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.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.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.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.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.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.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.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.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.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.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.Types.ZonkAny 0]’ not matched: [] + In a case alternative: Patterns of type ‘[a0]’ 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 0 \"a\"", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "10:23-39"}) +Just (InfoProv {ipName = "main_sat_t2fJ_info", ipDesc = THUNK, ipTyDesc = "UnusedType 1 \"a\"", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "11:23-42"}) +Just (InfoProv {ipName = "main_sat_t2g0_info", ipDesc = THUNK, ipTyDesc = "UnusedType 2 \"a\"", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "12:23-46"}) +Just (InfoProv {ipName = "main_sat_t2gh_info", ipDesc = THUNK, ipTyDesc = "UnusedType 3 \"a\"", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "13:23-44"}) ===================================== testsuite/tests/simplCore/should_compile/Makefile ===================================== @@ -178,7 +178,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.Types.ZonkAny 0) of { __DEFAULT -> - case r @(GHC.Types.ZonkAny 1) of { __DEFAULT -> r @a } + case r @(GHC.Internal.Types.UnusedType 0 "a") of { __DEFAULT -> + case r @(GHC.Internal.Types.UnusedType 1 "a") of { __DEFAULT -> ===================================== testsuite/tests/simplCore/should_compile/T26615.stderr ===================================== @@ -0,0 +1,2441 @@ +[1 of 2] Compiling T26615a ( T26615a.hs, T26615a.o ) + +==================== Tidy Core ==================== +Result size of Tidy Core + = {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 +[GblId[[RecSel]], + Arity=1, + Str=<1!P(1L)>, + Unf=Unf{Src=<vanilla>, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=True)}] +unArray = \ (@a) (ds :: Array a) -> case ds of { Array ds1 -> ds1 } + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule1 :: Addr# +[GblId, Unf=OtherCon []] +$trModule1 = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$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} +$trModule3 :: Addr# +[GblId, Unf=OtherCon []] +$trModule3 = "T26615a"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$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 [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 +[GblId, Unf=OtherCon []] +$krep + = GHC.Internal.Types.KindRepTyConApp + GHC.Internal.Types.$tc'Lifted + (GHC.Internal.Types.[] @GHC.Internal.Types.KindRep) + +-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} +$krep1 :: GHC.Internal.Types.KindRep +[GblId, Unf=OtherCon []] +$krep1 + = GHC.Internal.Types.KindRepTyConApp + GHC.Internal.Types.$tcWord + (GHC.Internal.Types.[] @GHC.Internal.Types.KindRep) + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$krep2 :: GHC.Internal.Types.KindRep +[GblId, Unf=OtherCon []] +$krep2 = GHC.Internal.Types.KindRepVar 1# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$krep3 :: GHC.Internal.Types.KindRep +[GblId, Unf=OtherCon []] +$krep3 = GHC.Internal.Types.KindRepVar 0# + +-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} +$krep4 :: [GHC.Internal.Types.KindRep] +[GblId, Unf=OtherCon []] +$krep4 + = GHC.Internal.Types.: + @GHC.Internal.Types.KindRep + $krep3 + (GHC.Internal.Types.[] @GHC.Internal.Types.KindRep) + +-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} +$krep5 :: [GHC.Internal.Types.KindRep] +[GblId, Unf=OtherCon []] +$krep5 + = GHC.Internal.Types.: @GHC.Internal.Types.KindRep $krep $krep4 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep6 :: GHC.Internal.Types.KindRep +[GblId, Unf=OtherCon []] +$krep6 + = GHC.Internal.Types.KindRepTyConApp + GHC.Internal.Types.$tcSmallArray# $krep5 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$tcLeaf1 :: Addr# +[GblId, Unf=OtherCon []] +$tcLeaf1 = "Leaf"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$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 [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] +T26615a.$tcLeaf + = GHC.Internal.Types.TyCon + 13798714324392902582#Word64 + 3237499036029031497#Word64 + T26615a.$trModule + $tcLeaf2 + 0# + GHC.Internal.Types.krep$*->*->* + +-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} +$krep7 :: [GHC.Internal.Types.KindRep] +[GblId, Unf=OtherCon []] +$krep7 + = GHC.Internal.Types.: + @GHC.Internal.Types.KindRep + $krep2 + (GHC.Internal.Types.[] @GHC.Internal.Types.KindRep) + +-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} +$krep8 :: [GHC.Internal.Types.KindRep] +[GblId, Unf=OtherCon []] +$krep8 + = GHC.Internal.Types.: @GHC.Internal.Types.KindRep $krep3 $krep7 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep9 :: GHC.Internal.Types.KindRep +[GblId, Unf=OtherCon []] +$krep9 = GHC.Internal.Types.KindRepTyConApp T26615a.$tcLeaf $krep8 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep10 :: GHC.Internal.Types.KindRep +[GblId, Unf=OtherCon []] +$krep10 = GHC.Internal.Types.KindRepFun $krep2 $krep9 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep11 :: GHC.Internal.Types.KindRep +[GblId, Unf=OtherCon []] +$krep11 = GHC.Internal.Types.KindRepFun $krep3 $krep10 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$tc'L1 :: Addr# +[GblId, Unf=OtherCon []] +$tc'L1 = "'L"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$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 [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] +T26615a.$tc'L + = GHC.Internal.Types.TyCon + 8570419491837374712#Word64 + 2090006989092642392#Word64 + T26615a.$trModule + $tc'L2 + 2# + $krep11 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$tcArray1 :: Addr# +[GblId, Unf=OtherCon []] +$tcArray1 = "Array"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$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 [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] +T26615a.$tcArray + = GHC.Internal.Types.TyCon + 10495761415291712389#Word64 + 7580086293698619153#Word64 + T26615a.$trModule + $tcArray2 + 0# + GHC.Internal.Types.krep$*Arr* + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep12 :: GHC.Internal.Types.KindRep +[GblId, Unf=OtherCon []] +$krep12 + = GHC.Internal.Types.KindRepTyConApp T26615a.$tcArray $krep4 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep13 :: GHC.Internal.Types.KindRep +[GblId, Unf=OtherCon []] +$krep13 = GHC.Internal.Types.KindRepFun $krep6 $krep12 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$tc'Array1 :: Addr# +[GblId, Unf=OtherCon []] +$tc'Array1 = "'Array"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$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 [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] +T26615a.$tc'Array + = GHC.Internal.Types.TyCon + 12424115309881832159#Word64 + 15542868641947707803#Word64 + T26615a.$trModule + $tc'Array2 + 1# + $krep13 + +-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} +$krep14 :: [GHC.Internal.Types.KindRep] +[GblId, Unf=OtherCon []] +$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} +$krep15 :: GHC.Internal.Types.KindRep +[GblId, Unf=OtherCon []] +$krep15 + = GHC.Internal.Types.KindRepTyConApp T26615a.$tcArray $krep14 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$tcHashMap1 :: Addr# +[GblId, Unf=OtherCon []] +$tcHashMap1 = "HashMap"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$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 [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] +T26615a.$tcHashMap + = GHC.Internal.Types.TyCon + 2021755758654901686#Word64 + 8209241086311595496#Word64 + T26615a.$trModule + $tcHashMap2 + 0# + GHC.Internal.Types.krep$*->*->* + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep16 :: GHC.Internal.Types.KindRep +[GblId, Unf=OtherCon []] +$krep16 + = GHC.Internal.Types.KindRepTyConApp T26615a.$tcHashMap $krep8 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$tc'Empty1 :: Addr# +[GblId, Unf=OtherCon []] +$tc'Empty1 = "'Empty"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$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 [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] +T26615a.$tc'Empty + = GHC.Internal.Types.TyCon + 2520556399233147460#Word64 + 17224648764450205443#Word64 + T26615a.$trModule + $tc'Empty2 + 2# + $krep16 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep17 :: GHC.Internal.Types.KindRep +[GblId, Unf=OtherCon []] +$krep17 = GHC.Internal.Types.KindRepFun $krep9 $krep16 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep18 :: GHC.Internal.Types.KindRep +[GblId, Unf=OtherCon []] +$krep18 = GHC.Internal.Types.KindRepFun $krep1 $krep17 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$tc'Leaf1 :: Addr# +[GblId, Unf=OtherCon []] +$tc'Leaf1 = "'Leaf"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$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 [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] +T26615a.$tc'Leaf + = GHC.Internal.Types.TyCon + 5773656560257991946#Word64 + 17028074687139582545#Word64 + T26615a.$trModule + $tc'Leaf2 + 2# + $krep18 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep19 :: GHC.Internal.Types.KindRep +[GblId, Unf=OtherCon []] +$krep19 = GHC.Internal.Types.KindRepFun $krep15 $krep16 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep20 :: GHC.Internal.Types.KindRep +[GblId, Unf=OtherCon []] +$krep20 = GHC.Internal.Types.KindRepFun $krep1 $krep19 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$tc'Collision1 :: Addr# +[GblId, Unf=OtherCon []] +$tc'Collision1 = "'Collision"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$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 [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] +T26615a.$tc'Collision + = GHC.Internal.Types.TyCon + 18175105753528304021#Word64 + 13986842878006680511#Word64 + T26615a.$trModule + $tc'Collision2 + 2# + $krep20 + +-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} +$krep21 :: [GHC.Internal.Types.KindRep] +[GblId, Unf=OtherCon []] +$krep21 + = GHC.Internal.Types.: + @GHC.Internal.Types.KindRep + $krep16 + (GHC.Internal.Types.[] @GHC.Internal.Types.KindRep) + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep22 :: GHC.Internal.Types.KindRep +[GblId, Unf=OtherCon []] +$krep22 + = GHC.Internal.Types.KindRepTyConApp T26615a.$tcArray $krep21 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep23 :: GHC.Internal.Types.KindRep +[GblId, Unf=OtherCon []] +$krep23 = GHC.Internal.Types.KindRepFun $krep22 $krep16 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$tc'Full1 :: Addr# +[GblId, Unf=OtherCon []] +$tc'Full1 = "'Full"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$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 [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] +T26615a.$tc'Full + = GHC.Internal.Types.TyCon + 12008762105994325570#Word64 + 13514145886440831186#Word64 + T26615a.$trModule + $tc'Full2 + 2# + $krep23 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep24 :: GHC.Internal.Types.KindRep +[GblId, Unf=OtherCon []] +$krep24 = GHC.Internal.Types.KindRepFun $krep1 $krep23 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$tc'BitmapIndexed1 :: Addr# +[GblId, Unf=OtherCon []] +$tc'BitmapIndexed1 = "'BitmapIndexed"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$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 [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] +T26615a.$tc'BitmapIndexed + = GHC.Internal.Types.TyCon + 15226751910432948177#Word64 + 957331387129868915#Word64 + T26615a.$trModule + $tc'BitmapIndexed2 + 2# + $krep24 + +-- RHS size: {terms: 98, types: 109, coercions: 0, joins: 3/4} +T26615a.$wdisjointCollisions [InlPrag=INLINABLE[2]] + :: forall k a b. + Eq k => + Word# + -> Array (Leaf k a) -> Word# -> SmallArray# (Leaf k b) -> Bool +[GblId[StrictWorker([~, ~, !])], + Arity=5, + 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 [90 0 20 0 0] 406 10 + Tmpl= \ (@k) + (@a) + (@b) + ($dEq :: Eq k) + (ww [Occ=Once1] :: Word#) + (aryA [Occ=Once1!] :: Array (Leaf k a)) + (ww1 [Occ=Once1] :: Word#) + (ww2 :: SmallArray# (Leaf k b)) -> + case aryA of aryA1 [Occ=Once1] { Array ipv [Occ=Once1] -> + let { + aryB [Occ=OnceL1] :: Array (Leaf k b) + [LclId, Unf=OtherCon []] + aryB = T26615a.Array @(Leaf k b) ww2 } in + case GHC.Internal.Classes.eqWord + (GHC.Internal.Types.W# ww) (GHC.Internal.Types.W# ww1) + of { + False -> GHC.Internal.Types.True; + True -> + joinrec { + foldr_ [Occ=LoopBreakerT[4]] + :: Array (Leaf k a) -> Int -> Int -> Bool -> Bool + [LclId[JoinId(4)(Nothing)], + Arity=4, + Str=<L><L><L><L>, + Unf=OtherCon []] + foldr_ (ary [Occ=Once1!] :: Array (Leaf k a)) + (n :: Int) + (i :: Int) + (z [Occ=Once2] :: Bool) + = case GHC.Internal.Classes.geInt i n of { + False -> + case i of { I# i# -> + case ary of wild3 [Occ=Once1] { Array ds [Occ=Once1] -> + case indexSmallArray# @Lifted @(Leaf k a) ds i# of + { (# ipv1 [Occ=Once1!] #) -> + case ipv1 of { L kA [Occ=Once1] _ [Occ=Dead] -> + join { + $j [Occ=OnceL1T[0]] :: Bool + [LclId[JoinId(0)(Nothing)]] + $j = jump foldr_ wild3 n (GHC.Internal.Types.I# (+# i# 1#)) z } in + joinrec { + lookupInArrayCont_ [Occ=LoopBreakerT[5]] + :: Eq k => k -> Array (Leaf k b) -> Int -> Int -> Bool + [LclId[JoinId(5)(Nothing)], + Arity=5, + Str=<L><L><L><L><L>, + Unf=OtherCon []] + lookupInArrayCont_ ($dEq1 [Occ=Dead] :: Eq k) + (k1 [Occ=Once1] :: k) + (ary1 [Occ=Once1!] :: Array (Leaf k b)) + (i1 [Occ=Once1!] :: Int) + (n1 [Occ=Once1!] :: Int) + = case k1 of k2 { __DEFAULT -> + case ary1 of ary2 [Occ=Once1] { Array ipv2 [Occ=Once1] -> + case i1 of i2 [Occ=Once1] { I# ipv3 -> + case n1 of n2 { I# _ [Occ=Dead] -> + case GHC.Internal.Classes.geInt i2 n2 of { + False -> + case indexSmallArray# @Lifted @(Leaf k b) ipv2 ipv3 of + { (# ipv5 [Occ=Once1!] #) -> + case ipv5 of { L kx [Occ=Once1] _ [Occ=Dead] -> + case == @k $dEq k2 kx of { + False -> + jump lookupInArrayCont_ + $dEq k2 ary2 (GHC.Internal.Types.I# (+# ipv3 1#)) n2; + True -> GHC.Internal.Types.False + } + } + }; + True -> jump $j + } + } + } + } + }; } in + jump lookupInArrayCont_ + $dEq + kA + aryB + (GHC.Internal.Types.I# 0#) + (GHC.Internal.Types.I# (sizeofSmallArray# @Lifted @(Leaf k b) ww2)) + } + } + } + }; + True -> z + }; } in + jump foldr_ + aryA1 + (GHC.Internal.Types.I# (sizeofSmallArray# @Lifted @(Leaf k a) ipv)) + (GHC.Internal.Types.I# 0#) + GHC.Internal.Types.True + } + }}] +T26615a.$wdisjointCollisions + = \ (@k) + (@a) + (@b) + ($dEq :: Eq k) + (ww :: Word#) + (aryA :: Array (Leaf k a)) + (ww1 :: Word#) + (ww2 :: SmallArray# (Leaf k b)) -> + case aryA of { Array ipv -> + case eqWord# ww ww1 of { + __DEFAULT -> GHC.Internal.Types.True; + 1# -> + let { + lvl2 :: Int# + [LclId] + lvl2 = sizeofSmallArray# @Lifted @(Leaf k b) ww2 } in + joinrec { + $s$wfoldr_ [InlPrag=[2], + Occ=LoopBreaker, + Dmd=SC(S,C(1,C(1,C(1,L))))] + :: SmallArray# (Leaf k a) -> Int# -> Int# -> Bool -> Bool + [LclId[JoinId(4)(Nothing)], + Arity=4, + Str=<L><L><L><L>, + Unf=OtherCon []] + $s$wfoldr_ (sc :: SmallArray# (Leaf k a)) + (sc1 :: Int#) + (sc2 :: Int#) + (sc3 :: Bool) + = case >=# sc2 sc1 of { + __DEFAULT -> + 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 (+# sc2 1#) sc3 } in + joinrec { + $wlookupInArrayCont_ [InlPrag=[2], + Occ=LoopBreaker, + Dmd=SC(S,C(1,C(1,C(1,L))))] + :: k -> SmallArray# (Leaf k b) -> Int# -> Int# -> Bool + [LclId[JoinId(4)(Just [!])], + Arity=4, + Str=<1L><L><L><L>, + Unf=OtherCon []] + $wlookupInArrayCont_ (k1 :: k) + (ww3 :: SmallArray# (Leaf k b)) + (ww4 :: Int#) + (ww5 :: Int#) + = case k1 of k2 { __DEFAULT -> + case >=# ww4 ww5 of { + __DEFAULT -> + case indexSmallArray# @Lifted @(Leaf k b) ww3 ww4 of + { (# ipv2 #) -> + case ipv2 of { L kx v -> + case == @k $dEq k2 kx of { + False -> jump $wlookupInArrayCont_ k2 ww3 (+# ww4 1#) ww5; + True -> GHC.Internal.Types.False + } + } + }; + 1# -> jump $j + } + }; } in + jump $wlookupInArrayCont_ kA ww2 0# lvl2 + } + }; + 1# -> sc3 + }; } in + jump $s$wfoldr_ + ipv + (sizeofSmallArray# @Lifted @(Leaf k a) ipv) + 0# + GHC.Internal.Types.True + } + } + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +lvl :: Addr# +[GblId, Unf=OtherCon []] +lvl = "T26615a.hs:(26,1)-(65,59)|function disjointSubtrees"# + +-- RHS size: {terms: 2, types: 2, coercions: 0, joins: 0/0} +lvl1 :: () +[GblId, Str=b, Cpr=b] +lvl1 + = GHC.Internal.Control.Exception.Base.patError @LiftedRep @() lvl + +Rec { +-- RHS size: {terms: 133, types: 126, coercions: 0, joins: 1/2} +T26615a.disjointSubtrees_$s$wdisjointSubtrees [InlPrag=INLINABLE[2], + Occ=LoopBreaker] + :: forall k a b. + Eq k => + Int# -> Word# -> SmallArray# (Leaf k a) -> HashMap k b -> Bool +[GblId[StrictWorker([~, ~, ~, ~, !])], + Arity=5, + Str=<LP(SC(S,C(1,L)),A)><L><L><L><1L>, + Unf=OtherCon []] +T26615a.disjointSubtrees_$s$wdisjointSubtrees + = \ (@k) + (@a) + (@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 sc2 of { + __DEFAULT -> GHC.Internal.Types.True; + 1# -> + joinrec { + $wlookupInArrayCont_ [InlPrag=[2], + Occ=LoopBreaker, + Dmd=SC(S,C(1,C(1,C(1,L))))] + :: k -> SmallArray# (Leaf k a) -> Int# -> Int# -> Bool + [LclId[JoinId(4)(Just [!])], + Arity=4, + Str=<1L><L><L><L>, + Unf=OtherCon []] + $wlookupInArrayCont_ (k1 :: k) + (ww :: SmallArray# (Leaf k a)) + (ww1 :: Int#) + (ww2 :: Int#) + = case k1 of k2 { __DEFAULT -> + case >=# ww1 ww2 of { + __DEFAULT -> + case indexSmallArray# @Lifted @(Leaf k a) ww ww1 of { (# ipv #) -> + case ipv of { L kx v -> + case == @k sc k2 kx of { + False -> jump $wlookupInArrayCont_ k2 ww (+# ww1 1#) ww2; + True -> GHC.Internal.Types.False + } + } + }; + 1# -> GHC.Internal.Types.True + } + }; } in + jump $wlookupInArrayCont_ + k0 sc3 0# (sizeofSmallArray# @Lifted @(Leaf k a) sc3) + } + } + }; + Collision bx bx1 -> + T26615a.$wdisjointCollisions + @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# sc2 sc1) 31##)) } in + case and# m bx of { + __DEFAULT -> + case indexSmallArray# + @Lifted + @(HashMap k b) + bx1 + (word2Int# (popCnt# (and# bx (minusWord# m 1##)))) + of + { (# ipv #) -> + T26615a.disjointSubtrees_$s$wdisjointSubtrees + @k @a @b sc (+# sc1 5#) sc2 sc3 ipv + }; + 0## -> GHC.Internal.Types.True + }; + Full bx -> + case indexSmallArray# + @Lifted + @(HashMap k b) + bx + (word2Int# (and# (uncheckedShiftRL# sc2 sc1) 31##)) + of + { (# ipv #) -> + T26615a.disjointSubtrees_$s$wdisjointSubtrees + @k @a @b sc (+# sc1 5#) sc2 sc3 ipv + } + } +end Rec } + +Rec { +-- 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([~, ~, !])], + Arity=4, + Str=<LP(LC(L,C(1,L)),LC(S,C(1,L)))><L><SL><L>, + Unf=Unf{Src=StableUser, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=NEVER + Tmpl= \ (@k) + (@a) + (@b) + ($dEq :: Eq k) + (ww :: Int#) + (ds :: HashMap k a) + (_b :: HashMap k b) -> + join { + fail [Occ=Once3!T[1]] :: (# #) -> Bool + [LclId[JoinId(1)(Nothing)], Arity=1, Str=<L>, Unf=OtherCon []] + fail (ds1 [Occ=Dead, OS=OneShot] :: (# #)) + = case _b of wild [Occ=Once1] { + __DEFAULT -> + case GHC.Internal.Control.Exception.Base.patError + @LiftedRep + @() + "T26615a.hs:(26,1)-(65,59)|function disjointSubtrees"# + of {}; + Empty -> GHC.Internal.Types.True; + Leaf bx [Occ=Once1] ds2 [Occ=Once1!] -> + case ds2 of { L kB [Occ=Once1] _ [Occ=Dead] -> + case kB of k0 [Occ=Once1] { __DEFAULT -> + joinrec { + lookupCont_ [Occ=LoopBreakerT[5]] + :: Eq k => Word -> k -> Int -> HashMap k a -> Bool + [LclId[JoinId(5)(Nothing)], + Arity=5, + Str=<L><L><L><L><L>, + Unf=OtherCon []] + lookupCont_ ($dEq1 [Occ=Dead] :: Eq k) + (ds4 [Occ=Once1!] :: Word) + (ds5 [Occ=Once1] :: k) + (ds6 [Occ=Once1!] :: Int) + (ds7 [Occ=Once1!] :: HashMap k a) + = case ds4 of ds8 [Occ=Once4] { W# ipv [Occ=Once2] -> + case ds5 of ds9 [Occ=Once4] { __DEFAULT -> + case ds6 of { I# ipv1 -> + case ds7 of { + Empty -> GHC.Internal.Types.True; + Leaf bx1 [Occ=Once1] ds11 [Occ=Once1!] -> + case ds11 of { L kx [Occ=Once1] _ [Occ=Dead] -> + case GHC.Internal.Classes.eqWord + ds8 (GHC.Internal.Types.W# bx1) + of { + False -> GHC.Internal.Types.True; + True -> + case == @k $dEq ds9 kx of { + False -> GHC.Internal.Types.True; + True -> GHC.Internal.Types.False + } + } + }; + Collision bx1 [Occ=Once1] bx2 -> + case GHC.Internal.Classes.eqWord + ds8 (GHC.Internal.Types.W# bx1) + of { + False -> GHC.Internal.Types.True; + True -> + joinrec { + lookupInArrayCont_ [Occ=LoopBreakerT[5]] + :: Eq k => k -> Array (Leaf k a) -> Int -> Int -> Bool + [LclId[JoinId(5)(Nothing)], + Arity=5, + Str=<L><L><L><L><L>, + Unf=OtherCon []] + lookupInArrayCont_ ($dEq2 [Occ=Dead] :: Eq k) + (k1 [Occ=Once1] :: k) + (ary [Occ=Once1!] :: Array (Leaf k a)) + (i [Occ=Once1!] :: Int) + (n [Occ=Once1!] :: Int) + = case k1 of k2 { __DEFAULT -> + case ary of ary1 [Occ=Once1] + { Array ipv2 [Occ=Once1] -> + case i of i1 [Occ=Once1] { I# ipv3 -> + case n of n1 { I# _ [Occ=Dead] -> + case GHC.Internal.Classes.geInt i1 n1 of { + False -> + case indexSmallArray# + @Lifted @(Leaf k a) ipv2 ipv3 + of + { (# ipv5 [Occ=Once1!] #) -> + case ipv5 of { L kx [Occ=Once1] _ [Occ=Dead] -> + case == @k $dEq k2 kx of { + False -> + jump lookupInArrayCont_ + $dEq + k2 + ary1 + (GHC.Internal.Types.I# (+# ipv3 1#)) + n1; + True -> GHC.Internal.Types.False + } + } + }; + True -> GHC.Internal.Types.True + } + } + } + } + }; } in + jump lookupInArrayCont_ + $dEq + ds9 + (T26615a.Array @(Leaf k a) bx2) + (GHC.Internal.Types.I# 0#) + (GHC.Internal.Types.I# + (sizeofSmallArray# @Lifted @(Leaf k a) bx2)) + }; + BitmapIndexed bx1 bx2 [Occ=Once1] -> + let { + m :: Word# + [LclId] + m = uncheckedShiftL# + 1## + (word2Int# + (and# (uncheckedShiftRL# ipv ipv1) 31##)) } in + case GHC.Internal.Classes.eqWord + (GHC.Internal.Types.W# (and# bx1 m)) + (GHC.Internal.Types.W# 0##) + of { + False -> + case indexSmallArray# + @Lifted + @(HashMap k a) + bx2 + (word2Int# (popCnt# (and# bx1 (minusWord# m 1##)))) + of + { (# ipv2 [Occ=Once1] #) -> + jump lookupCont_ + $dEq ds8 ds9 (GHC.Internal.Types.I# (+# ipv1 5#)) ipv2 + }; + True -> GHC.Internal.Types.True + }; + Full bx1 [Occ=Once1] -> + case indexSmallArray# + @Lifted + @(HashMap k a) + bx1 + (word2Int# (and# (uncheckedShiftRL# ipv ipv1) 31##)) + of + { (# ipv2 [Occ=Once1] #) -> + jump lookupCont_ + $dEq ds8 ds9 (GHC.Internal.Types.I# (+# ipv1 5#)) ipv2 + } + } + } + } + }; } in + jump lookupCont_ + $dEq (GHC.Internal.Types.W# bx) k0 (GHC.Internal.Types.I# ww) ds + } + }; + Collision _ [Occ=Dead] _ [Occ=Dead] -> + T26615a.$wdisjointSubtrees @k @b @a $dEq ww wild ds + } } in + case ds of wild [Occ=Once2] { + Empty -> GHC.Internal.Types.True; + Leaf bx [Occ=Once2] ds1 [Occ=Once1!] -> + case ds1 of { L kA [Occ=Once2] _ [Occ=Dead] -> + case _b of wild2 [Occ=Once1] { + __DEFAULT -> + case kA of k0 [Occ=Once1] { __DEFAULT -> + joinrec { + lookupCont_ [Occ=LoopBreakerT[5]] + :: Eq k => Word -> k -> Int -> HashMap k b -> Bool + [LclId[JoinId(5)(Nothing)], + Arity=5, + Str=<L><L><L><L><L>, + Unf=OtherCon []] + lookupCont_ ($dEq1 [Occ=Dead] :: Eq k) + (ds3 [Occ=Once1!] :: Word) + (ds4 [Occ=Once1] :: k) + (ds5 [Occ=Once1!] :: Int) + (ds6 [Occ=Once1!] :: HashMap k b) + = case ds3 of ds7 [Occ=Once4] { W# ipv [Occ=Once2] -> + case ds4 of ds8 [Occ=Once4] { __DEFAULT -> + case ds5 of { I# ipv1 -> + case ds6 of { + Empty -> GHC.Internal.Types.True; + Leaf bx1 [Occ=Once1] ds10 [Occ=Once1!] -> + case ds10 of { L kx [Occ=Once1] _ [Occ=Dead] -> + case GHC.Internal.Classes.eqWord ds7 (GHC.Internal.Types.W# bx1) + of { + False -> GHC.Internal.Types.True; + True -> + case == @k $dEq ds8 kx of { + False -> GHC.Internal.Types.True; + True -> GHC.Internal.Types.False + } + } + }; + Collision bx1 [Occ=Once1] bx2 -> + case GHC.Internal.Classes.eqWord ds7 (GHC.Internal.Types.W# bx1) + of { + False -> GHC.Internal.Types.True; + True -> + joinrec { + lookupInArrayCont_ [Occ=LoopBreakerT[5]] + :: Eq k => k -> Array (Leaf k b) -> Int -> Int -> Bool + [LclId[JoinId(5)(Nothing)], + Arity=5, + Str=<L><L><L><L><L>, + Unf=OtherCon []] + lookupInArrayCont_ ($dEq2 [Occ=Dead] :: Eq k) + (k1 [Occ=Once1] :: k) + (ary [Occ=Once1!] :: Array (Leaf k b)) + (i [Occ=Once1!] :: Int) + (n [Occ=Once1!] :: Int) + = case k1 of k2 { __DEFAULT -> + case ary of ary1 [Occ=Once1] + { Array ipv2 [Occ=Once1] -> + case i of i1 [Occ=Once1] { I# ipv3 -> + case n of n1 { I# _ [Occ=Dead] -> + case GHC.Internal.Classes.geInt i1 n1 of { + False -> + case indexSmallArray# @Lifted @(Leaf k b) ipv2 ipv3 + of + { (# ipv5 [Occ=Once1!] #) -> + case ipv5 of { L kx [Occ=Once1] _ [Occ=Dead] -> + case == @k $dEq k2 kx of { + False -> + jump lookupInArrayCont_ + $dEq + k2 + ary1 + (GHC.Internal.Types.I# (+# ipv3 1#)) + n1; + True -> GHC.Internal.Types.False + } + } + }; + True -> GHC.Internal.Types.True + } + } + } + } + }; } in + jump lookupInArrayCont_ + $dEq + ds8 + (T26615a.Array @(Leaf k b) bx2) + (GHC.Internal.Types.I# 0#) + (GHC.Internal.Types.I# + (sizeofSmallArray# @Lifted @(Leaf k b) bx2)) + }; + BitmapIndexed bx1 bx2 [Occ=Once1] -> + let { + m :: Word# + [LclId] + m = uncheckedShiftL# + 1## + (word2Int# (and# (uncheckedShiftRL# ipv ipv1) 31##)) } in + case GHC.Internal.Classes.eqWord + (GHC.Internal.Types.W# (and# bx1 m)) + (GHC.Internal.Types.W# 0##) + of { + False -> + case indexSmallArray# + @Lifted + @(HashMap k b) + bx2 + (word2Int# (popCnt# (and# bx1 (minusWord# m 1##)))) + of + { (# ipv2 [Occ=Once1] #) -> + jump lookupCont_ + $dEq ds7 ds8 (GHC.Internal.Types.I# (+# ipv1 5#)) ipv2 + }; + True -> GHC.Internal.Types.True + }; + Full bx1 [Occ=Once1] -> + case indexSmallArray# + @Lifted + @(HashMap k b) + bx1 + (word2Int# (and# (uncheckedShiftRL# ipv ipv1) 31##)) + of + { (# ipv2 [Occ=Once1] #) -> + jump lookupCont_ + $dEq ds7 ds8 (GHC.Internal.Types.I# (+# ipv1 5#)) ipv2 + } + } + } + } + }; } in + jump lookupCont_ + $dEq (GHC.Internal.Types.W# bx) k0 (GHC.Internal.Types.I# ww) wild2 + }; + Leaf bx1 [Occ=Once1] ds3 [Occ=Once1!] -> + case ds3 of { L kB [Occ=Once1] _ [Occ=Dead] -> + case GHC.Internal.Classes.neWord + (GHC.Internal.Types.W# bx) (GHC.Internal.Types.W# bx1) + of { + False -> /= @k $dEq kA kB; + True -> GHC.Internal.Types.True + } + } + } + }; + Collision bx [Occ=Once3] bx1 [Occ=Once1] -> + case _b of { + __DEFAULT -> jump fail GHC.Internal.Types.(##); + Collision bx2 [Occ=Once1] bx3 [Occ=Once1] -> + T26615a.$wdisjointCollisions + @k @a @b $dEq bx (T26615a.Array @(Leaf k a) bx1) bx2 bx3; + BitmapIndexed bx2 bx3 [Occ=Once1] -> + let { + m :: Word# + [LclId] + m = uncheckedShiftL# + 1## (word2Int# (and# (uncheckedShiftRL# bx ww) 31##)) } in + case GHC.Internal.Classes.eqWord + (GHC.Internal.Types.W# (and# m bx2)) (GHC.Internal.Types.W# 0##) + of { + False -> + case indexSmallArray# + @Lifted + @(HashMap k b) + bx3 + (word2Int# (popCnt# (and# bx2 (minusWord# m 1##)))) + of + { (# ipv [Occ=Once1] #) -> + T26615a.$wdisjointSubtrees @k @a @b $dEq (+# ww 5#) wild ipv + }; + True -> GHC.Internal.Types.True + }; + Full bx2 [Occ=Once1] -> + case indexSmallArray# + @Lifted + @(HashMap k b) + bx2 + (word2Int# (and# (uncheckedShiftRL# bx ww) 31##)) + of + { (# ipv [Occ=Once1] #) -> + T26615a.$wdisjointSubtrees @k @a @b $dEq (+# ww 5#) wild ipv + } + }; + BitmapIndexed bx bx1 -> + case _b of { + __DEFAULT -> jump fail GHC.Internal.Types.(##); + BitmapIndexed bx2 bx3 -> + case GHC.Internal.Classes.eqWord + (GHC.Internal.Types.W# (and# bx bx2)) (GHC.Internal.Types.W# 0##) + of { + False -> + case GHC.Internal.Unsafe.Coerce.unsafeEqualityProof + @(*) + @(SmallArray# (HashMap k a) + -> SmallArray# (HashMap k b) -> Int#) + @(GHC.Internal.Types.UnusedType 0 "a" + -> GHC.Internal.Types.UnusedType 1 "b" -> Int#) + of + { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> + case reallyUnsafePtrEquality# + @Lifted + @Lifted + @(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.UnusedType 0 "a")) + (bx3 + `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) + :: SmallArray# (HashMap k b) + ~R# GHC.Internal.Types.UnusedType 1 "b")) + of { + __DEFAULT -> + joinrec { + go [Occ=LoopBreakerT[1]] :: Word -> Bool + [LclId[JoinId(1)(Nothing)], Arity=1, Str=<L>, Unf=OtherCon []] + go (ds1 [Occ=Once1!] :: Word) + = case ds1 of { W# ds2 [Occ=Once1!] -> + case ds2 of ds3 { + __DEFAULT -> + let { + m :: Word# + [LclId] + m = and# + ds3 (int2Word# (negateInt# (word2Int# ds3))) } in + case indexSmallArray# + @Lifted + @(HashMap k a) + bx1 + (word2Int# (popCnt# (and# bx (minusWord# m 1##)))) + of + { (# ipv [Occ=Once1] #) -> + case indexSmallArray# + @Lifted + @(HashMap k b) + bx3 + (word2Int# + (popCnt# (and# bx2 (minusWord# m 1##)))) + 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.W# (and# ds3 (not# m))) + } + } + }; + 0## -> GHC.Internal.Types.True + } + }; } in + jump go (GHC.Internal.Types.W# (and# bx bx2)); + 1# -> GHC.Internal.Types.False + } + }; + True -> GHC.Internal.Types.True + }; + Full bx2 [Occ=OnceL1] -> + joinrec { + go [Occ=LoopBreakerT[1]] :: Word -> Bool + [LclId[JoinId(1)(Nothing)], Arity=1, Str=<L>, Unf=OtherCon []] + go (ds1 [Occ=Once1!] :: Word) + = case ds1 of { W# ds2 [Occ=Once1!] -> + case ds2 of ds3 { + __DEFAULT -> + let { + m :: Word# + [LclId] + m = and# ds3 (int2Word# (negateInt# (word2Int# ds3))) } in + case indexSmallArray# + @Lifted + @(HashMap k a) + bx1 + (word2Int# (popCnt# (and# bx (minusWord# m 1##)))) + of + { (# ipv [Occ=Once1] #) -> + case indexSmallArray# + @Lifted + @(HashMap k b) + bx2 + (word2Int# + (popCnt# (and# 4294967295## (minusWord# m 1##)))) + 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.W# (and# ds3 (not# m))) + } + } + }; + 0## -> GHC.Internal.Types.True + } + }; } in + jump go (GHC.Internal.Types.W# (and# bx 4294967295##)) + }; + Full bx -> + case _b of { + __DEFAULT -> jump fail GHC.Internal.Types.(##); + BitmapIndexed bx1 bx2 [Occ=OnceL1] -> + joinrec { + go [Occ=LoopBreakerT[1]] :: Word -> Bool + [LclId[JoinId(1)(Nothing)], Arity=1, Str=<L>, Unf=OtherCon []] + go (ds1 [Occ=Once1!] :: Word) + = case ds1 of { W# ds2 [Occ=Once1!] -> + case ds2 of ds3 { + __DEFAULT -> + let { + m :: Word# + [LclId] + m = and# ds3 (int2Word# (negateInt# (word2Int# ds3))) } in + case indexSmallArray# + @Lifted + @(HashMap k a) + bx + (word2Int# + (popCnt# (and# 4294967295## (minusWord# m 1##)))) + of + { (# ipv [Occ=Once1] #) -> + case indexSmallArray# + @Lifted + @(HashMap k b) + bx2 + (word2Int# (popCnt# (and# bx1 (minusWord# m 1##)))) + 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.W# (and# ds3 (not# m))) + } + } + }; + 0## -> GHC.Internal.Types.True + } + }; } 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.UnusedType 0 "a" + -> GHC.Internal.Types.UnusedType 1 "b" -> Int#) + of + { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> + case reallyUnsafePtrEquality# + @Lifted + @Lifted + @(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.UnusedType 0 "a")) + (bx1 + `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) + :: SmallArray# (HashMap k b) + ~R# GHC.Internal.Types.UnusedType 1 "b")) + of { + __DEFAULT -> jump go (GHC.Internal.Types.I# 31#); + 1# -> GHC.Internal.Types.False + } + } + } + }}] +T26615a.$wdisjointSubtrees + = \ (@k) + (@a) + (@b) + ($dEq :: Eq k) + (ww :: Int#) + (ds :: HashMap k a) + (_b :: HashMap k b) -> + join { + fail [Dmd=MC(1,L)] :: (# #) -> Bool + [LclId[JoinId(1)(Nothing)], Arity=1, Str=<A>, Unf=OtherCon []] + fail (ds1 [Occ=Dead, OS=OneShot] :: (# #)) + = case _b of { + __DEFAULT -> case lvl1 of {}; + Empty -> GHC.Internal.Types.True; + Leaf bx ds2 -> + case ds2 of { L kB ds3 -> + case kB of k0 { __DEFAULT -> + join { + exit [Dmd=LC(S,C(1,C(1,C(1,L))))] + :: Word# -> k -> Word# -> Leaf k a -> Bool + [LclId[JoinId(4)(Just [~, ~, ~, !])], + Arity=4, + Str=<L><L><L><1P(L,A)>] + exit (ww1 [OS=OneShot] :: Word#) + (ds4 [OS=OneShot] :: k) + (bx1 [OS=OneShot] :: Word#) + (ds5 [OS=OneShot] :: Leaf k a) + = case ds5 of { L kx x -> + case eqWord# ww1 bx1 of { + __DEFAULT -> GHC.Internal.Types.True; + 1# -> + case == @k $dEq ds4 kx of { + False -> GHC.Internal.Types.True; + True -> GHC.Internal.Types.False + } + } + } } in + join { + exit1 [Dmd=LC(S,C(1,C(1,C(1,L))))] + :: Word# -> k -> Word# -> SmallArray# (Leaf k a) -> Bool + [LclId[JoinId(4)(Nothing)], Arity=4, Str=<L><ML><L><L>] + exit1 (ww1 [OS=OneShot] :: Word#) + (ds4 [OS=OneShot] :: k) + (bx1 [OS=OneShot] :: Word#) + (bx2 [OS=OneShot] :: SmallArray# (Leaf k a)) + = case eqWord# ww1 bx1 of { + __DEFAULT -> GHC.Internal.Types.True; + 1# -> + joinrec { + $wlookupInArrayCont_ [InlPrag=[2], + Occ=LoopBreaker, + Dmd=SC(S,C(1,C(1,C(1,L))))] + :: k -> SmallArray# (Leaf k a) -> Int# -> Int# -> Bool + [LclId[JoinId(4)(Just [!])], + Arity=4, + Str=<1L><L><L><L>, + Unf=OtherCon []] + $wlookupInArrayCont_ (k1 :: k) + (ww2 :: SmallArray# (Leaf k a)) + (ww3 :: Int#) + (ww4 :: Int#) + = case k1 of k2 { __DEFAULT -> + case >=# ww3 ww4 of { + __DEFAULT -> + case indexSmallArray# @Lifted @(Leaf k a) ww2 ww3 of + { (# ipv #) -> + case ipv of { L kx v -> + case == @k $dEq k2 kx of { + False -> jump $wlookupInArrayCont_ k2 ww2 (+# ww3 1#) ww4; + True -> GHC.Internal.Types.False + } + } + }; + 1# -> GHC.Internal.Types.True + } + }; } in + jump $wlookupInArrayCont_ + ds4 bx2 0# (sizeofSmallArray# @Lifted @(Leaf k a) bx2) + } } in + joinrec { + $wlookupCont_ [InlPrag=[2], + Occ=LoopBreaker, + Dmd=SC(S,C(1,C(1,C(1,L))))] + :: Word# -> k -> Int# -> HashMap k a -> Bool + [LclId[JoinId(4)(Just [~, !, ~, !])], + Arity=4, + Str=<L><1L><L><1L>, + Unf=OtherCon []] + $wlookupCont_ (ww1 :: Word#) + (ds4 :: k) + (ww2 :: Int#) + (ds5 :: HashMap k a) + = case ds4 of ds6 { __DEFAULT -> + case ds5 of { + Empty -> GHC.Internal.Types.True; + Leaf bx1 ds7 -> jump exit ww1 ds6 bx1 ds7; + Collision bx1 bx2 -> jump exit1 ww1 ds6 bx1 bx2; + BitmapIndexed bx1 bx2 -> + let { + m :: Word# + [LclId] + m = uncheckedShiftL# + 1## (word2Int# (and# (uncheckedShiftRL# ww1 ww2) 31##)) } in + case and# bx1 m of { + __DEFAULT -> + case indexSmallArray# + @Lifted + @(HashMap k a) + bx2 + (word2Int# (popCnt# (and# bx1 (minusWord# m 1##)))) + of + { (# ipv #) -> + jump $wlookupCont_ ww1 ds6 (+# ww2 5#) ipv + }; + 0## -> GHC.Internal.Types.True + }; + Full bx1 -> + case indexSmallArray# + @Lifted + @(HashMap k a) + bx1 + (word2Int# (and# (uncheckedShiftRL# ww1 ww2) 31##)) + of + { (# ipv #) -> + jump $wlookupCont_ ww1 ds6 (+# ww2 5#) ipv + } + } + }; } in + jump $wlookupCont_ bx k0 ww ds + } + }; + Collision bx bx1 -> + T26615a.disjointSubtrees_$s$wdisjointSubtrees + @k @b @a $dEq ww bx bx1 ds + } } in + case ds of { + Empty -> GHC.Internal.Types.True; + Leaf bx ds1 -> + case ds1 of { L kA ds2 -> + case _b of wild2 { + __DEFAULT -> + case kA of k0 { __DEFAULT -> + join { + exit [Dmd=LC(S,C(1,C(1,C(1,L))))] + :: Word# -> k -> Word# -> Leaf k b -> Bool + [LclId[JoinId(4)(Just [~, ~, ~, !])], + Arity=4, + Str=<L><L><L><1P(L,A)>] + exit (ww1 [OS=OneShot] :: Word#) + (ds3 [OS=OneShot] :: k) + (bx1 [OS=OneShot] :: Word#) + (ds4 [OS=OneShot] :: Leaf k b) + = case ds4 of { L kx x -> + case eqWord# ww1 bx1 of { + __DEFAULT -> GHC.Internal.Types.True; + 1# -> + case == @k $dEq ds3 kx of { + False -> GHC.Internal.Types.True; + True -> GHC.Internal.Types.False + } + } + } } in + join { + exit1 [Dmd=LC(S,C(1,C(1,C(1,L))))] + :: Word# -> k -> Word# -> SmallArray# (Leaf k b) -> Bool + [LclId[JoinId(4)(Nothing)], Arity=4, Str=<L><ML><L><L>] + exit1 (ww1 [OS=OneShot] :: Word#) + (ds3 [OS=OneShot] :: k) + (bx1 [OS=OneShot] :: Word#) + (bx2 [OS=OneShot] :: SmallArray# (Leaf k b)) + = case eqWord# ww1 bx1 of { + __DEFAULT -> GHC.Internal.Types.True; + 1# -> + joinrec { + $wlookupInArrayCont_ [InlPrag=[2], + Occ=LoopBreaker, + Dmd=SC(S,C(1,C(1,C(1,L))))] + :: k -> SmallArray# (Leaf k b) -> Int# -> Int# -> Bool + [LclId[JoinId(4)(Just [!])], + Arity=4, + Str=<1L><L><L><L>, + Unf=OtherCon []] + $wlookupInArrayCont_ (k1 :: k) + (ww2 :: SmallArray# (Leaf k b)) + (ww3 :: Int#) + (ww4 :: Int#) + = case k1 of k2 { __DEFAULT -> + case >=# ww3 ww4 of { + __DEFAULT -> + case indexSmallArray# @Lifted @(Leaf k b) ww2 ww3 of + { (# ipv #) -> + case ipv of { L kx v -> + case == @k $dEq k2 kx of { + False -> jump $wlookupInArrayCont_ k2 ww2 (+# ww3 1#) ww4; + True -> GHC.Internal.Types.False + } + } + }; + 1# -> GHC.Internal.Types.True + } + }; } in + jump $wlookupInArrayCont_ + ds3 bx2 0# (sizeofSmallArray# @Lifted @(Leaf k b) bx2) + } } in + joinrec { + $wlookupCont_ [InlPrag=[2], + Occ=LoopBreaker, + Dmd=SC(S,C(1,C(1,C(1,L))))] + :: Word# -> k -> Int# -> HashMap k b -> Bool + [LclId[JoinId(4)(Just [~, !, ~, !])], + Arity=4, + Str=<L><1L><L><1L>, + Unf=OtherCon []] + $wlookupCont_ (ww1 :: Word#) + (ds3 :: k) + (ww2 :: Int#) + (ds4 :: HashMap k b) + = case ds3 of ds5 { __DEFAULT -> + case ds4 of { + Empty -> GHC.Internal.Types.True; + Leaf bx1 ds6 -> jump exit ww1 ds5 bx1 ds6; + Collision bx1 bx2 -> jump exit1 ww1 ds5 bx1 bx2; + BitmapIndexed bx1 bx2 -> + let { + m :: Word# + [LclId] + m = uncheckedShiftL# + 1## (word2Int# (and# (uncheckedShiftRL# ww1 ww2) 31##)) } in + case and# bx1 m of { + __DEFAULT -> + case indexSmallArray# + @Lifted + @(HashMap k b) + bx2 + (word2Int# (popCnt# (and# bx1 (minusWord# m 1##)))) + of + { (# ipv #) -> + jump $wlookupCont_ ww1 ds5 (+# ww2 5#) ipv + }; + 0## -> GHC.Internal.Types.True + }; + Full bx1 -> + case indexSmallArray# + @Lifted + @(HashMap k b) + bx1 + (word2Int# (and# (uncheckedShiftRL# ww1 ww2) 31##)) + of + { (# ipv #) -> + jump $wlookupCont_ ww1 ds5 (+# ww2 5#) ipv + } + } + }; } in + jump $wlookupCont_ bx k0 ww wild2 + }; + Leaf bx1 ds3 -> + case ds3 of { L kB ds4 -> + case neWord# bx bx1 of { + __DEFAULT -> /= @k $dEq kA kB; + 1# -> GHC.Internal.Types.True + } + } + } + }; + Collision bx bx1 -> + case _b of { + __DEFAULT -> jump fail GHC.Internal.Types.(##); + Collision bx2 bx3 -> + T26615a.$wdisjointCollisions + @k @a @b $dEq bx (T26615a.Array @(Leaf k a) bx1) bx2 bx3; + BitmapIndexed bx2 bx3 -> + let { + m :: Word# + [LclId] + m = uncheckedShiftL# + 1## (word2Int# (and# (uncheckedShiftRL# bx ww) 31##)) } in + case and# m bx2 of { + __DEFAULT -> + case indexSmallArray# + @Lifted + @(HashMap k b) + bx3 + (word2Int# (popCnt# (and# bx2 (minusWord# m 1##)))) + of + { (# ipv #) -> + T26615a.disjointSubtrees_$s$wdisjointSubtrees + @k @a @b $dEq (+# ww 5#) bx bx1 ipv + }; + 0## -> GHC.Internal.Types.True + }; + Full bx2 -> + case indexSmallArray# + @Lifted + @(HashMap k b) + bx2 + (word2Int# (and# (uncheckedShiftRL# bx ww) 31##)) + of + { (# ipv #) -> + T26615a.disjointSubtrees_$s$wdisjointSubtrees + @k @a @b $dEq (+# ww 5#) bx bx1 ipv + } + }; + BitmapIndexed bx bx1 -> + case _b of { + __DEFAULT -> jump fail GHC.Internal.Types.(##); + BitmapIndexed bx2 bx3 -> + case and# bx bx2 of wild2 { + __DEFAULT -> + case GHC.Internal.Unsafe.Coerce.unsafeEqualityProof + @(*) + @(SmallArray# (HashMap k a) -> SmallArray# (HashMap k b) -> Int#) + @(GHC.Internal.Types.UnusedType 0 "a" + -> GHC.Internal.Types.UnusedType 1 "b" -> Int#) + of + { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> + case reallyUnsafePtrEquality# + @Lifted + @Lifted + @(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.UnusedType 0 "a")) + (bx3 + `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) + :: SmallArray# (HashMap k b) + ~R# GHC.Internal.Types.UnusedType 1 "b")) + of { + __DEFAULT -> + let { + lvl2 :: Int# + [LclId] + lvl2 = +# ww 5# } in + joinrec { + $wgo [InlPrag=[2], Occ=LoopBreaker, Dmd=SC(S,L)] :: Word# -> Bool + [LclId[JoinId(1)(Nothing)], Arity=1, Str=<1L>, Unf=OtherCon []] + $wgo (ww1 :: Word#) + = case ww1 of ds1 { + __DEFAULT -> + let { + m :: Word# + [LclId] + m = and# ds1 (int2Word# (negateInt# (word2Int# ds1))) } in + case indexSmallArray# + @Lifted + @(HashMap k a) + bx1 + (word2Int# (popCnt# (and# bx (minusWord# m 1##)))) + of + { (# ipv #) -> + case indexSmallArray# + @Lifted + @(HashMap k b) + bx3 + (word2Int# (popCnt# (and# bx2 (minusWord# m 1##)))) + of + { (# ipv1 #) -> + case T26615a.$wdisjointSubtrees @k @a @b $dEq lvl2 ipv ipv1 of { + False -> GHC.Internal.Types.False; + True -> jump $wgo (and# ds1 (not# m)) + } + } + }; + 0## -> GHC.Internal.Types.True + }; } in + jump $wgo wild2; + 1# -> GHC.Internal.Types.False + } + }; + 0## -> GHC.Internal.Types.True + }; + Full bx2 -> + let { + lvl2 :: Int# + [LclId] + lvl2 = +# ww 5# } in + joinrec { + $wgo [InlPrag=[2], Occ=LoopBreaker, Dmd=SC(S,L)] :: Word# -> Bool + [LclId[JoinId(1)(Nothing)], Arity=1, Str=<1L>, Unf=OtherCon []] + $wgo (ww1 :: Word#) + = case ww1 of ds1 { + __DEFAULT -> + let { + m :: Word# + [LclId] + m = and# ds1 (int2Word# (negateInt# (word2Int# ds1))) } in + case indexSmallArray# + @Lifted + @(HashMap k a) + bx1 + (word2Int# (popCnt# (and# bx (minusWord# m 1##)))) + of + { (# ipv #) -> + case indexSmallArray# + @Lifted + @(HashMap k b) + bx2 + (word2Int# (popCnt# (and# 4294967295## (minusWord# m 1##)))) + of + { (# ipv1 #) -> + case T26615a.$wdisjointSubtrees @k @a @b $dEq lvl2 ipv ipv1 of { + False -> GHC.Internal.Types.False; + True -> jump $wgo (and# ds1 (not# m)) + } + } + }; + 0## -> GHC.Internal.Types.True + }; } in + jump $wgo (and# bx 4294967295##) + }; + Full bx -> + case _b of { + __DEFAULT -> jump fail GHC.Internal.Types.(##); + BitmapIndexed bx1 bx2 -> + let { + lvl2 :: Int# + [LclId] + lvl2 = +# ww 5# } in + joinrec { + $wgo [InlPrag=[2], Occ=LoopBreaker, Dmd=SC(S,L)] :: Word# -> Bool + [LclId[JoinId(1)(Nothing)], Arity=1, Str=<1L>, Unf=OtherCon []] + $wgo (ww1 :: Word#) + = case ww1 of ds1 { + __DEFAULT -> + let { + m :: Word# + [LclId] + m = and# ds1 (int2Word# (negateInt# (word2Int# ds1))) } in + case indexSmallArray# + @Lifted + @(HashMap k a) + bx + (word2Int# (popCnt# (and# 4294967295## (minusWord# m 1##)))) + of + { (# ipv #) -> + case indexSmallArray# + @Lifted + @(HashMap k b) + bx2 + (word2Int# (popCnt# (and# bx1 (minusWord# m 1##)))) + of + { (# ipv1 #) -> + case T26615a.$wdisjointSubtrees @k @a @b $dEq lvl2 ipv ipv1 of { + False -> GHC.Internal.Types.False; + True -> jump $wgo (and# ds1 (not# m)) + } + } + }; + 0## -> GHC.Internal.Types.True + }; } in + jump $wgo (and# 4294967295## bx1); + Full bx1 -> + case GHC.Internal.Unsafe.Coerce.unsafeEqualityProof + @(*) + @(SmallArray# (HashMap k a) -> SmallArray# (HashMap k b) -> Int#) + @(GHC.Internal.Types.UnusedType 0 "a" + -> GHC.Internal.Types.UnusedType 1 "b" -> Int#) + of + { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> + case reallyUnsafePtrEquality# + @Lifted + @Lifted + @(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.UnusedType 0 "a")) + (bx1 + `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) + :: SmallArray# (HashMap k b) + ~R# GHC.Internal.Types.UnusedType 1 "b")) + of { + __DEFAULT -> + let { + lvl2 :: Int# + [LclId] + lvl2 = +# ww 5# } in + joinrec { + $wgo [InlPrag=[2], Occ=LoopBreaker, Dmd=SC(S,L)] :: Int# -> Bool + [LclId[JoinId(1)(Nothing)], Arity=1, Str=<L>, Unf=OtherCon []] + $wgo (ww1 :: Int#) + = case <# ww1 0# of { + __DEFAULT -> + case indexSmallArray# @Lifted @(HashMap k a) bx ww1 of + { (# ipv #) -> + case indexSmallArray# @Lifted @(HashMap k b) bx1 ww1 of + { (# ipv1 #) -> + case T26615a.$wdisjointSubtrees @k @a @b $dEq lvl2 ipv ipv1 of { + False -> GHC.Internal.Types.False; + True -> jump $wgo (-# ww1 1#) + } + } + }; + 1# -> GHC.Internal.Types.True + }; } in + jump $wgo 31#; + 1# -> GHC.Internal.Types.False + } + } + } + } +end Rec } + +-- RHS size: {terms: 15, types: 17, coercions: 0, joins: 0/0} +disjointSubtrees [InlPrag=INLINABLE[2]] + :: forall k a b. Eq k => Int -> HashMap k a -> HashMap k b -> Bool +[GblId, + Arity=4, + Str=<LP(LC(L,C(1,L)),LC(S,C(1,L)))><1!P(L)><SL><L>, + Unf=Unf{Src=StableSystem, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=4,unsat_ok=True,boring_ok=False) + Tmpl= \ (@k) + (@a) + (@b) + ($dEq [Occ=Once1] :: Eq k) + (_s [Occ=Once1!] :: Int) + (ds [Occ=Once1] :: HashMap k a) + (_b [Occ=Once1] :: HashMap k b) -> + case _s of { I# ww [Occ=Once1] -> + T26615a.$wdisjointSubtrees @k @a @b $dEq ww ds _b + }}] +disjointSubtrees + = \ (@k) + (@a) + (@b) + ($dEq :: Eq k) + (_s :: Int) + (ds :: HashMap k a) + (_b :: HashMap k b) -> + case _s of { I# ww -> + T26615a.$wdisjointSubtrees @k @a @b $dEq ww ds _b + } + + +------ Local rules for imported ids -------- +"SC:$wdisjointSubtrees1" [1] + forall (@k) + (@b) + (@a) + (sc :: Eq k) + (sc1 :: Int#) + (sc2 :: Word#) + (sc3 :: SmallArray# (Leaf k b)) + (sc4 :: Word#) + (sc5 :: SmallArray# (Leaf k a)). + T26615a.$wdisjointSubtrees @k + @b + @a + sc + sc1 + (T26615a.Collision @k @b sc2 sc3) + (T26615a.Collision @k @a sc4 sc5) + = T26615a.$wdisjointCollisions + @k @b @a sc sc2 (T26615a.Array @(Leaf k b) sc3) sc4 sc5 +"SC:$wdisjointSubtrees0" [1] + forall (@k) + (@a) + (@b) + (sc :: Eq k) + (sc1 :: Int#) + (sc2 :: Word#) + (sc3 :: SmallArray# (Leaf k a)). + T26615a.$wdisjointSubtrees @k + @a + @b + sc + sc1 + (T26615a.Collision @k @a sc2 sc3) + = T26615a.disjointSubtrees_$s$wdisjointSubtrees + @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: 682, coercions: 18, joins: 8/14} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule1 :: GHC.Internal.Prim.Addr# +[GblId, Unf=OtherCon []] +$trModule1 = "T26615"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$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} +$trModule3 :: GHC.Internal.Prim.Addr# +[GblId, Unf=OtherCon []] +$trModule3 = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$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 [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# +[GblId, Unf=OtherCon []] +lvl = "T26615a.hs:(26,1)-(65,59)|function disjointSubtrees"# + +-- RHS size: {terms: 2, types: 2, coercions: 0, joins: 0/0} +lvl1 :: () +[GblId, Str=b, Cpr=b] +lvl1 + = GHC.Internal.Control.Exception.Base.patError + @GHC.Internal.Types.LiftedRep @() lvl + +Rec { +-- RHS size: {terms: 37, types: 30, coercions: 0, joins: 0/0} +$wpoly_lookupInArrayCont_ + :: forall a. + String + -> GHC.Internal.Prim.SmallArray# (T26615a.Leaf String a) + -> GHC.Internal.Prim.Int# + -> GHC.Internal.Prim.Int# + -> Bool +[GblId[StrictWorker([!])], + Arity=4, + Str=<1L><L><L><L>, + Unf=OtherCon []] +$wpoly_lookupInArrayCont_ + = \ (@a) + (k1 :: String) + (ww :: GHC.Internal.Prim.SmallArray# (T26615a.Leaf String a)) + (ww1 :: GHC.Internal.Prim.Int#) + (ww2 :: GHC.Internal.Prim.Int#) -> + case k1 of k2 { __DEFAULT -> + case GHC.Internal.Prim.>=# ww1 ww2 of { + __DEFAULT -> + case GHC.Internal.Prim.indexSmallArray# + @GHC.Internal.Types.Lifted @(T26615a.Leaf String a) ww ww1 + of + { (# ipv5 #) -> + case ipv5 of { T26615a.L kx v -> + case GHC.Internal.Base.eqString k2 kx of { + False -> + $wpoly_lookupInArrayCont_ + @a k2 ww (GHC.Internal.Prim.+# ww1 1#) ww2; + True -> GHC.Internal.Types.False + } + } + }; + 1# -> GHC.Internal.Types.True + } + } +end Rec } + +Rec { +-- RHS size: {terms: 98, types: 73, coercions: 0, joins: 0/1} +$wpoly_lookupCont_ + :: forall a. + GHC.Internal.Prim.Word# + -> String -> GHC.Internal.Prim.Int# -> HashMap String a -> Bool +[GblId[StrictWorker([~, !, ~, !])], + Arity=4, + Str=<L><1L><L><1L>, + Unf=OtherCon []] +$wpoly_lookupCont_ + = \ (@a) + (ww :: GHC.Internal.Prim.Word#) + (ds5 :: String) + (ww1 :: GHC.Internal.Prim.Int#) + (ds7 :: HashMap String a) -> + case ds5 of ds9 { __DEFAULT -> + case ds7 of { + T26615a.Empty -> GHC.Internal.Types.True; + T26615a.Leaf bx1 ds11 -> + case ds11 of { T26615a.L kx x -> + case GHC.Internal.Prim.eqWord# ww bx1 of { + __DEFAULT -> GHC.Internal.Types.True; + 1# -> + case GHC.Internal.Base.eqString ds9 kx of { + False -> GHC.Internal.Types.True; + True -> GHC.Internal.Types.False + } + } + }; + T26615a.Collision bx1 bx2 -> + case GHC.Internal.Prim.eqWord# ww bx1 of { + __DEFAULT -> GHC.Internal.Types.True; + 1# -> + $wpoly_lookupInArrayCont_ + @a + ds9 + bx2 + 0# + (GHC.Internal.Prim.sizeofSmallArray# + @GHC.Internal.Types.Lifted @(T26615a.Leaf String a) bx2) + }; + T26615a.BitmapIndexed bx1 bx2 -> + let { + m :: GHC.Internal.Prim.Word# + [LclId] + m = GHC.Internal.Prim.uncheckedShiftL# + 1## + (GHC.Internal.Prim.word2Int# + (GHC.Internal.Prim.and# + (GHC.Internal.Prim.uncheckedShiftRL# ww ww1) 31##)) } in + case GHC.Internal.Prim.and# bx1 m of { + __DEFAULT -> + case GHC.Internal.Prim.indexSmallArray# + @GHC.Internal.Types.Lifted + @(HashMap String a) + bx2 + (GHC.Internal.Prim.word2Int# + (GHC.Internal.Prim.popCnt# + (GHC.Internal.Prim.and# bx1 (GHC.Internal.Prim.minusWord# m 1##)))) + of + { (# ipv2 #) -> + $wpoly_lookupCont_ @a ww ds9 (GHC.Internal.Prim.+# ww1 5#) ipv2 + }; + 0## -> GHC.Internal.Types.True + }; + T26615a.Full bx1 -> + case GHC.Internal.Prim.indexSmallArray# + @GHC.Internal.Types.Lifted + @(HashMap String a) + bx1 + (GHC.Internal.Prim.word2Int# + (GHC.Internal.Prim.and# + (GHC.Internal.Prim.uncheckedShiftRL# ww ww1) 31##)) + of + { (# ipv2 #) -> + $wpoly_lookupCont_ @a ww ds9 (GHC.Internal.Prim.+# ww1 5#) ipv2 + } + } + } +end Rec } + +Rec { +-- RHS size: {terms: 448, types: 523, coercions: 18, joins: 8/13} +T26615.$s$wdisjointSubtrees [InlPrag=[~], Occ=LoopBreaker] + :: forall a b. + GHC.Internal.Prim.Int# + -> HashMap String a -> HashMap String b -> Bool +[GblId, Arity=3, Str=<L><SL><L>, Unf=OtherCon []] +T26615.$s$wdisjointSubtrees + = \ (@a) + (@b) + (ww :: GHC.Internal.Prim.Int#) + (ds :: HashMap String a) + (_b :: HashMap String b) -> + join { + fail [Dmd=MC(1,L)] :: (# #) -> Bool + [LclId[JoinId(1)(Nothing)], Arity=1, Str=<A>, Unf=OtherCon []] + fail (ds1 [Occ=Dead, OS=OneShot] :: (# #)) + = case _b of wild { + __DEFAULT -> case lvl1 of {}; + T26615a.Empty -> GHC.Internal.Types.True; + T26615a.Leaf bx ds2 -> + case ds2 of { T26615a.L kB ds3 -> + $wpoly_lookupCont_ @a bx kB ww ds + }; + T26615a.Collision bx bx1 -> + T26615.$s$wdisjointSubtrees @b @a ww wild ds + } } in + case ds of wild { + T26615a.Empty -> GHC.Internal.Types.True; + T26615a.Leaf bx ds1 -> + case ds1 of { T26615a.L kA ds2 -> + case _b of wild2 { + __DEFAULT -> $wpoly_lookupCont_ @b bx kA ww wild2; + T26615a.Leaf bx1 ds3 -> + case ds3 of { T26615a.L kB ds4 -> + case GHC.Internal.Prim.neWord# bx bx1 of { + __DEFAULT -> + case GHC.Internal.Classes.$fEqList_$s$c==1 kA kB of { + False -> GHC.Internal.Types.True; + True -> GHC.Internal.Types.False + }; + 1# -> GHC.Internal.Types.True + } + } + } + }; + T26615a.Collision bx bx1 -> + case _b of { + __DEFAULT -> jump fail GHC.Internal.Types.(##); + T26615a.Collision bx2 bx3 -> + case GHC.Internal.Prim.eqWord# bx bx2 of { + __DEFAULT -> GHC.Internal.Types.True; + 1# -> + let { + lvl2 :: GHC.Internal.Prim.Int# + [LclId] + lvl2 + = GHC.Internal.Prim.sizeofSmallArray# + @GHC.Internal.Types.Lifted @(T26615a.Leaf String b) bx3 } in + joinrec { + $s$wfoldr_ [InlPrag=[2], + Occ=LoopBreaker, + Dmd=SC(S,C(1,C(1,C(1,L))))] + :: 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 + :: GHC.Internal.Prim.SmallArray# (T26615a.Leaf [Char] a)) + (sc1 :: GHC.Internal.Prim.Int#) + (sc2 :: GHC.Internal.Prim.Int#) + (sc3 :: Bool) + = case GHC.Internal.Prim.>=# sc2 sc1 of { + __DEFAULT -> + case GHC.Internal.Prim.indexSmallArray# + @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 sc1 (GHC.Internal.Prim.+# sc2 1#) sc3 } in + joinrec { + $wlookupInArrayCont_ [InlPrag=[2], + Occ=LoopBreaker, + Dmd=SC(S,C(1,C(1,C(1,L))))] + :: String + -> GHC.Internal.Prim.SmallArray# (T26615a.Leaf String b) + -> GHC.Internal.Prim.Int# + -> GHC.Internal.Prim.Int# + -> Bool + [LclId[JoinId(4)(Just [!])], + Arity=4, + Str=<1L><L><L><L>, + Unf=OtherCon []] + $wlookupInArrayCont_ (k1 :: String) + (ww1 + :: GHC.Internal.Prim.SmallArray# + (T26615a.Leaf String b)) + (ww2 :: GHC.Internal.Prim.Int#) + (ww3 :: GHC.Internal.Prim.Int#) + = case k1 of k2 { __DEFAULT -> + case GHC.Internal.Prim.>=# ww2 ww3 of { + __DEFAULT -> + case GHC.Internal.Prim.indexSmallArray# + @GHC.Internal.Types.Lifted + @(T26615a.Leaf String b) + ww1 + ww2 + of + { (# ipv5 #) -> + case ipv5 of { T26615a.L kx v -> + case GHC.Internal.Base.eqString k2 kx of { + False -> + jump $wlookupInArrayCont_ + k2 ww1 (GHC.Internal.Prim.+# ww2 1#) ww3; + True -> GHC.Internal.Types.False + } + } + }; + 1# -> jump $j + } + }; } in + jump $wlookupInArrayCont_ kA bx3 0# lvl2 + } + }; + 1# -> sc3 + }; } in + jump $s$wfoldr_ + bx1 + (GHC.Internal.Prim.sizeofSmallArray# + @GHC.Internal.Types.Lifted @(T26615a.Leaf String a) bx1) + 0# + GHC.Internal.Types.True + }; + T26615a.BitmapIndexed bx2 bx3 -> + let { + m :: GHC.Internal.Prim.Word# + [LclId] + m = GHC.Internal.Prim.uncheckedShiftL# + 1## + (GHC.Internal.Prim.word2Int# + (GHC.Internal.Prim.and# + (GHC.Internal.Prim.uncheckedShiftRL# bx ww) 31##)) } in + case GHC.Internal.Prim.and# m bx2 of { + __DEFAULT -> + case GHC.Internal.Prim.indexSmallArray# + @GHC.Internal.Types.Lifted + @(HashMap String b) + bx3 + (GHC.Internal.Prim.word2Int# + (GHC.Internal.Prim.popCnt# + (GHC.Internal.Prim.and# bx2 (GHC.Internal.Prim.minusWord# m 1##)))) + of + { (# ipv #) -> + T26615.$s$wdisjointSubtrees + @a @b (GHC.Internal.Prim.+# ww 5#) wild ipv + }; + 0## -> GHC.Internal.Types.True + }; + T26615a.Full bx2 -> + case GHC.Internal.Prim.indexSmallArray# + @GHC.Internal.Types.Lifted + @(HashMap String b) + bx2 + (GHC.Internal.Prim.word2Int# + (GHC.Internal.Prim.and# + (GHC.Internal.Prim.uncheckedShiftRL# bx ww) 31##)) + of + { (# ipv #) -> + T26615.$s$wdisjointSubtrees + @a @b (GHC.Internal.Prim.+# ww 5#) wild ipv + } + }; + T26615a.BitmapIndexed bx bx1 -> + case _b of { + __DEFAULT -> jump fail GHC.Internal.Types.(##); + T26615a.BitmapIndexed bx2 bx3 -> + case GHC.Internal.Prim.and# bx bx2 of wild2 { + __DEFAULT -> + case GHC.Internal.Unsafe.Coerce.unsafeEqualityProof + @(*) + @(GHC.Internal.Prim.SmallArray# (HashMap String a) + -> GHC.Internal.Prim.SmallArray# (HashMap String b) + -> GHC.Internal.Prim.Int#) + @(GHC.Internal.Types.UnusedType 0 "a" + -> GHC.Internal.Types.UnusedType 1 "b" -> GHC.Internal.Prim.Int#) + of + { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> + case GHC.Internal.Prim.reallyUnsafePtrEquality# + @GHC.Internal.Types.Lifted + @GHC.Internal.Types.Lifted + @(GHC.Internal.Types.UnusedType 0 "a") + @(GHC.Internal.Types.UnusedType 1 "b") + (bx1 + `cast` (SelCo:Fun(arg) (Sub (Sym v2)) + :: GHC.Internal.Prim.SmallArray# (HashMap String a) + ~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.UnusedType 1 "b")) + of { + __DEFAULT -> + joinrec { + $wgo [InlPrag=[2], Occ=LoopBreaker, Dmd=SC(S,L)] + :: GHC.Internal.Prim.Word# -> Bool + [LclId[JoinId(1)(Nothing)], Arity=1, Str=<1L>, Unf=OtherCon []] + $wgo (ww1 :: GHC.Internal.Prim.Word#) + = case ww1 of ds3 { + __DEFAULT -> + let { + m :: GHC.Internal.Prim.Word# + [LclId] + m = GHC.Internal.Prim.and# + ds3 + (GHC.Internal.Prim.int2Word# + (GHC.Internal.Prim.negateInt# + (GHC.Internal.Prim.word2Int# ds3))) } in + case GHC.Internal.Prim.indexSmallArray# + @GHC.Internal.Types.Lifted + @(HashMap String a) + bx1 + (GHC.Internal.Prim.word2Int# + (GHC.Internal.Prim.popCnt# + (GHC.Internal.Prim.and# + bx (GHC.Internal.Prim.minusWord# m 1##)))) + of + { (# ipv #) -> + case GHC.Internal.Prim.indexSmallArray# + @GHC.Internal.Types.Lifted + @(HashMap String b) + bx3 + (GHC.Internal.Prim.word2Int# + (GHC.Internal.Prim.popCnt# + (GHC.Internal.Prim.and# + bx2 (GHC.Internal.Prim.minusWord# m 1##)))) + of + { (# ipv1 #) -> + case T26615.$s$wdisjointSubtrees + @a @b (GHC.Internal.Prim.+# ww 5#) ipv ipv1 + of { + False -> GHC.Internal.Types.False; + True -> + jump $wgo + (GHC.Internal.Prim.and# ds3 (GHC.Internal.Prim.not# m)) + } + } + }; + 0## -> GHC.Internal.Types.True + }; } in + jump $wgo wild2; + 1# -> GHC.Internal.Types.False + } + }; + 0## -> GHC.Internal.Types.True + }; + T26615a.Full bx2 -> + joinrec { + $wgo [InlPrag=[2], Occ=LoopBreaker, Dmd=SC(S,L)] + :: GHC.Internal.Prim.Word# -> Bool + [LclId[JoinId(1)(Nothing)], Arity=1, Str=<1L>, Unf=OtherCon []] + $wgo (ww1 :: GHC.Internal.Prim.Word#) + = case ww1 of ds3 { + __DEFAULT -> + let { + m :: GHC.Internal.Prim.Word# + [LclId] + m = GHC.Internal.Prim.and# + ds3 + (GHC.Internal.Prim.int2Word# + (GHC.Internal.Prim.negateInt# + (GHC.Internal.Prim.word2Int# ds3))) } in + case GHC.Internal.Prim.indexSmallArray# + @GHC.Internal.Types.Lifted + @(HashMap String a) + bx1 + (GHC.Internal.Prim.word2Int# + (GHC.Internal.Prim.popCnt# + (GHC.Internal.Prim.and# + bx (GHC.Internal.Prim.minusWord# m 1##)))) + of + { (# ipv #) -> + case GHC.Internal.Prim.indexSmallArray# + @GHC.Internal.Types.Lifted + @(HashMap String b) + bx2 + (GHC.Internal.Prim.word2Int# + (GHC.Internal.Prim.popCnt# + (GHC.Internal.Prim.and# + 4294967295## (GHC.Internal.Prim.minusWord# m 1##)))) + of + { (# ipv1 #) -> + case T26615.$s$wdisjointSubtrees + @a @b (GHC.Internal.Prim.+# ww 5#) ipv ipv1 + of { + False -> GHC.Internal.Types.False; + True -> + jump $wgo (GHC.Internal.Prim.and# ds3 (GHC.Internal.Prim.not# m)) + } + } + }; + 0## -> GHC.Internal.Types.True + }; } in + jump $wgo (GHC.Internal.Prim.and# bx 4294967295##) + }; + T26615a.Full bx -> + case _b of { + __DEFAULT -> jump fail GHC.Internal.Types.(##); + T26615a.BitmapIndexed bx1 bx2 -> + joinrec { + $wgo [InlPrag=[2], Occ=LoopBreaker, Dmd=SC(S,L)] + :: GHC.Internal.Prim.Word# -> Bool + [LclId[JoinId(1)(Nothing)], Arity=1, Str=<1L>, Unf=OtherCon []] + $wgo (ww1 :: GHC.Internal.Prim.Word#) + = case ww1 of ds3 { + __DEFAULT -> + let { + m :: GHC.Internal.Prim.Word# + [LclId] + m = GHC.Internal.Prim.and# + ds3 + (GHC.Internal.Prim.int2Word# + (GHC.Internal.Prim.negateInt# + (GHC.Internal.Prim.word2Int# ds3))) } in + case GHC.Internal.Prim.indexSmallArray# + @GHC.Internal.Types.Lifted + @(HashMap String a) + bx + (GHC.Internal.Prim.word2Int# + (GHC.Internal.Prim.popCnt# + (GHC.Internal.Prim.and# + 4294967295## (GHC.Internal.Prim.minusWord# m 1##)))) + of + { (# ipv #) -> + case GHC.Internal.Prim.indexSmallArray# + @GHC.Internal.Types.Lifted + @(HashMap String b) + bx2 + (GHC.Internal.Prim.word2Int# + (GHC.Internal.Prim.popCnt# + (GHC.Internal.Prim.and# + bx1 (GHC.Internal.Prim.minusWord# m 1##)))) + of + { (# ipv1 #) -> + case T26615.$s$wdisjointSubtrees + @a @b (GHC.Internal.Prim.+# ww 5#) ipv ipv1 + of { + False -> GHC.Internal.Types.False; + True -> + jump $wgo (GHC.Internal.Prim.and# ds3 (GHC.Internal.Prim.not# m)) + } + } + }; + 0## -> GHC.Internal.Types.True + }; } in + jump $wgo (GHC.Internal.Prim.and# 4294967295## bx1); + T26615a.Full bx1 -> + case GHC.Internal.Unsafe.Coerce.unsafeEqualityProof + @(*) + @(GHC.Internal.Prim.SmallArray# (HashMap String a) + -> GHC.Internal.Prim.SmallArray# (HashMap String b) + -> GHC.Internal.Prim.Int#) + @(GHC.Internal.Types.UnusedType 0 "a" + -> GHC.Internal.Types.UnusedType 1 "b" -> GHC.Internal.Prim.Int#) + of + { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> + case GHC.Internal.Prim.reallyUnsafePtrEquality# + @GHC.Internal.Types.Lifted + @GHC.Internal.Types.Lifted + @(GHC.Internal.Types.UnusedType 0 "a") + @(GHC.Internal.Types.UnusedType 1 "b") + (bx + `cast` (SelCo:Fun(arg) (Sub (Sym v2)) + :: GHC.Internal.Prim.SmallArray# (HashMap String a) + ~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.UnusedType 1 "b")) + of { + __DEFAULT -> + joinrec { + $wgo [InlPrag=[2], Occ=LoopBreaker, Dmd=SC(S,L)] + :: GHC.Internal.Prim.Int# -> Bool + [LclId[JoinId(1)(Nothing)], Arity=1, Str=<L>, Unf=OtherCon []] + $wgo (ww1 :: GHC.Internal.Prim.Int#) + = case GHC.Internal.Prim.<# ww1 0# of { + __DEFAULT -> + case GHC.Internal.Prim.indexSmallArray# + @GHC.Internal.Types.Lifted @(HashMap String a) bx ww1 + of + { (# ipv #) -> + case GHC.Internal.Prim.indexSmallArray# + @GHC.Internal.Types.Lifted @(HashMap String b) bx1 ww1 + of + { (# ipv1 #) -> + case T26615.$s$wdisjointSubtrees + @a @b (GHC.Internal.Prim.+# ww 5#) ipv ipv1 + of { + False -> GHC.Internal.Types.False; + True -> jump $wgo (GHC.Internal.Prim.-# ww1 1#) + } + } + }; + 1# -> GHC.Internal.Types.True + }; } in + jump $wgo 31#; + 1# -> GHC.Internal.Types.False + } + } + } + } +end Rec } + +-- RHS size: {terms: 8, types: 10, coercions: 0, joins: 0/0} +f :: forall a b. HashMap String a -> HashMap String b -> Bool +[GblId, + Arity=2, + Str=<SL><L>, + Unf=Unf{Src=<vanilla>, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=IF_ARGS [0 0] 40 0}] +f = \ (@a) + (@b) + (ds :: HashMap String a) + (_b :: HashMap String b) -> + T26615.$s$wdisjointSubtrees @a @b 0# ds _b + + +------ Local rules for imported ids -------- +"SPEC/T26615 $wdisjointSubtrees @String @_ @_" [2] + 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.Types.ZonkAny 0’ with ‘IO’ + • Couldn't match type ‘m00’ with ‘IO’ Expected: IO () - Actual: GHC.Types.ZonkAny 0 () + Actual: m00 • 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.Types.ZonkAny 0’ with ‘IO’ + • Couldn't match type ‘m00’ with ‘IO’ Expected: IO () - Actual: GHC.Types.ZonkAny 0 () + Actual: m00 • In the expression: main When checking the type of the IO action ‘main’ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1fbacc81145f5910cac689aa4dc5483… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1fbacc81145f5910cac689aa4dc5483… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/romes/27401
by Rodrigo Mesquita (＠alt-romes) 18 Jun '26

18 Jun '26

Rodrigo Mesquita pushed new branch wip/romes/27401 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/romes/27401 You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/mangoiv/backport-unused-type
by Magnus (＠MangoIV) 18 Jun '26

18 Jun '26

Magnus pushed new branch wip/mangoiv/backport-unused-type at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/mangoiv/backport-unused-type You're receiving this email because of your account on gitlab.haskell.org.

1 0