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