Zubin pushed to branch wip/25924 at Glasgow Haskell Compiler / GHC Commits: 8bbc4359 by Zubin Duggal at 2026-07-02T15:18:12+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. - - - - - 4 changed files: - changelog.d/fix-absent-dict-projection - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs Changes: ===================================== changelog.d/fix-absent-dict-projection ===================================== @@ -1,5 +1,8 @@ section: compiler -synopsis: Fix a CorePrep miscompilation that could project a field out of an absent dictionary, resulting in a segfault. +synopsis: Fix a miscompilation that could project a field out of an absent dictionary, resulting in a segfault. issues: #25924 mrs: !16219 -description: We no longer speculatively evaluate bindings that we have already discovered are absent. +description: + We no longer make an absent filler (a rubbish literal or error thunk) for an + absent dictionary or other terminating type. We also no longer speculatively + evaluate a binding once we have discovered that it is absent. ===================================== compiler/GHC/Core/Opt/Specialise.hs ===================================== @@ -19,12 +19,13 @@ import GHC.Core.SimpleOpt( defaultSimpleOpts, simpleOptExprWith, exprIsConApp_ma import GHC.Core.Predicate import GHC.Core.Class( classMethods ) import GHC.Core.Coercion( Coercion ) -import GHC.Core.DataCon (dataConTyCon) +import GHC.Core.DataCon (dataConTyCon, StrictnessMark(NotMarkedStrict)) import qualified GHC.Core.Subst as Core import GHC.Core.Unfold.Make import GHC.Core -import GHC.Core.Make ( mkLitRubbish, wrapFloats ) +import GHC.Core.Make ( wrapFloats ) +import GHC.Core.Opt.WorkWrap.Utils ( mkAbsentFiller ) import GHC.Core.Unify ( tcMatchTy ) import GHC.Core.Rules import GHC.Core.Subst (substTickish) @@ -1669,7 +1670,7 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs | otherwise = UnspecArg ; (useful, subst', rule_bndrs, rule_lhs_args, spec_bndrs, dx_binds, spec_args) - <- specHeader subst rhs_bndrs all_call_args + <- specHeader this_mod subst rhs_bndrs all_call_args ; let env' = env { se_subst = subst' } -- Check for (a) usefulness and (b) not already covered @@ -2573,7 +2574,8 @@ isSpecDict _ = False -- , [T1, T2, c, i, dEqT1, dShow1] -- ) specHeader - :: Core.Subst -- This substitution applies to the [InBndr] + :: Module -- The module being compiled, for mkAbsentFiller + -> Core.Subst -- This substitution applies to the [InBndr] -> [InBndr] -- Binders from the original function `f` -> [SpecArg] -- From the CallInfo -> SpecM ( Bool -- True <=> some useful specialisation happened @@ -2598,13 +2600,13 @@ specHeader -- If we run out of binders, stop immediately -- See Note [Specialisation Must Preserve Sharing] -specHeader subst [] _ = pure (False, subst, [], [], [], [], []) -specHeader subst _ [] = pure (False, subst, [], [], [], [], []) +specHeader _ subst [] _ = pure (False, subst, [], [], [], [], []) +specHeader _ subst _ [] = pure (False, subst, [], [], [], [], []) -- We want to specialise on type 'T1', and so we must construct a substitution -- 'a->T1', as well as a LHS argument for the resulting RULE and unfolding -- details. -specHeader subst (bndr:bndrs) (SpecType ty : args) +specHeader mod subst (bndr:bndrs) (SpecType ty : args) = do { -- Find free_tvs, the type variables to add to the binders for the rule -- Namely those deeply free in `ty` that aren't in scope -- See (MP2) in Note [Specialising polymorphic dictionaries] @@ -2617,7 +2619,7 @@ specHeader subst (bndr:bndrs) (SpecType ty : args) ; let subst2 = Core.extendTvSubst subst1 bndr ty ; (useful, subst3, rule_bs, rule_args, spec_bs, dx, spec_args) - <- specHeader subst2 bndrs args + <- specHeader mod subst2 bndrs args ; pure ( useful, subst3 , free_tvs ++ rule_bs, Type ty : rule_args , free_tvs ++ spec_bs, dx, Type ty : spec_args ) } @@ -2626,29 +2628,34 @@ specHeader subst (bndr:bndrs) (SpecType ty : args) -- a substitution on it (in case the type refers to 'a'). Additionally, we need -- to produce a binder, LHS argument and RHS argument for the resulting rule, -- /and/ a binder for the specialised body. -specHeader subst (bndr:bndrs) (UnspecType : args) +specHeader mod subst (bndr:bndrs) (UnspecType : args) = do { let (subst1, bndr') = Core.substBndr subst bndr ; (useful, subst2, rule_bs, rule_es, spec_bs, dx, spec_args) - <- specHeader subst1 bndrs args + <- specHeader mod subst1 bndrs args ; let ty_e' = Type (mkTyVarTy bndr') ; pure ( useful, subst2 , bndr' : rule_bs, ty_e' : rule_es , bndr' : spec_bs, dx, ty_e' : spec_args ) } -specHeader subst (bndr:bndrs) (_ : args) +specHeader mod subst (bndr:bndrs) (_ : args) | isDeadBinder bndr , let (subst1, bndr') = Core.substBndr subst (zapIdOccInfo bndr) - , Just rubbish_lit <- mkLitRubbish (idType bndr') + , Just filler <- mkAbsentFiller mod bndr' NotMarkedStrict + -- NB: mkAbsentFiller returns Nothing for a terminating type (e.g. a + -- dictionary), so this guard fails and we fall through, keeping the + -- argument instead of dropping it. + -- See Note [Don't make fillers for terminating types] + -- in GHC.Core.Opt.WorkWrap.Utils = -- See Note [Drop dead args from specialisations] - do { (useful, subst2, rule_bs, rule_es, spec_bs, dx, spec_args) <- specHeader subst1 bndrs args + do { (useful, subst2, rule_bs, rule_es, spec_bs, dx, spec_args) <- specHeader mod subst1 bndrs args ; pure ( useful, subst2 , bndr' : rule_bs, Var bndr' : rule_es - , spec_bs, dx, rubbish_lit : spec_args ) } + , spec_bs, dx, filler : spec_args ) } -- Next we want to specialise the 'Eq a' dict away. We need to construct -- a wildcard binder to match the dictionary (See Note [Specialising Calls] for -- the nitty-gritty), as a LHS rule and unfolding details. -specHeader subst (bndr:bndrs) (SpecDict dict_arg : args) +specHeader mod subst (bndr:bndrs) (SpecDict dict_arg : args) = do { -- Make up a fresh binder to use in the RULE -- It might turn into a dict binding (via bindAuxiliaryDict) which we -- then float, so we use cloneIdBndr to get a completely fresh binder @@ -2659,7 +2666,7 @@ specHeader subst (bndr:bndrs) (SpecDict dict_arg : args) -- Extend the substitution to map bndr :-> dict_arg, for use in the RHS ; let (subst2, dx_bind, spec_dict) = bindAuxiliaryDict subst1 bndr bndr' dict_arg - ; (_, subst3, rule_bs, rule_es, spec_bs, dx, spec_args) <- specHeader subst2 bndrs args + ; (_, subst3, rule_bs, rule_es, spec_bs, dx, spec_args) <- specHeader mod subst2 bndrs args ; let dx' = case dx_bind of { Nothing -> dx; Just d -> d : dx } ; pure ( True, subst3 -- Ha! A useful specialisation! @@ -2674,10 +2681,10 @@ specHeader subst (bndr:bndrs) (SpecDict dict_arg : args) -- why 'i' doesn't appear in our RULE above. But we have no guarantee that -- there aren't 'UnspecArg's which come /before/ all of the dictionaries, so -- this case must be here. -specHeader subst (bndr:bndrs) (UnspecArg : args) +specHeader mod subst (bndr:bndrs) (UnspecArg : args) = do { let (subst1, bndr') = Core.substBndr subst (zapIdOccInfo bndr) -- zapIdOccInfo: see Note [Zap occ info in rule binders] - ; (useful, subst2, rule_bs, rule_es, spec_bs, dx, spec_args) <- specHeader subst1 bndrs args + ; (useful, subst2, rule_bs, rule_es, spec_bs, dx, spec_args) <- specHeader mod subst1 bndrs args ; let dummy_arg = varToCoreExpr bndr' -- dummy_arg is usually just (Var bndr), ===================================== compiler/GHC/Core/Opt/WorkWrap.hs ===================================== @@ -554,7 +554,7 @@ tryWW ww_opts is_rec fn_id rhs -- See Note [Drop absent bindings] | isAbsDmd (demandInfo fn_info) , not (isJoinId fn_id) - , Just filler <- mkAbsentFiller ww_opts fn_id NotMarkedStrict + , Just filler <- mkAbsentFiller (wo_module ww_opts) fn_id NotMarkedStrict = return [(new_fn_id, filler)] -- See Note [Don't w/w INLINE things] ===================================== compiler/GHC/Core/Opt/WorkWrap/Utils.hs ===================================== @@ -30,7 +30,6 @@ import GHC.Core.Subst import GHC.Core.Type import GHC.Core.Multiplicity import GHC.Core.Coercion -import GHC.Core.Predicate( isDictTy ) import GHC.Core.Reduction import GHC.Core.FamInstEnv import GHC.Core.Predicate( isEqualityClass ) @@ -996,7 +995,7 @@ mkWWstr_one opts arg str_mark = _ | isTyVar arg -> do_nothing DropAbsent - | Just absent_filler <- mkAbsentFiller opts arg str_mark + | Just absent_filler <- mkAbsentFiller (wo_module opts) arg str_mark -- Absent case. Drop the argument from the worker. -- We can't always handle absence for arbitrary -- unlifted types, so we need to choose just the cases we can @@ -1067,14 +1066,20 @@ unbox_one_arg opts arg_var -- -- If @mkAbsentFiller _ id == Just e@, then @e@ is an absent filler with the -- same type as @id@. Otherwise, no suitable filler could be found. -mkAbsentFiller :: WwOpts -> Id -> StrictnessMark -> Maybe CoreExpr -mkAbsentFiller opts arg str +mkAbsentFiller :: Module -> Id -> StrictnessMark -> Maybe CoreExpr +mkAbsentFiller mod arg str + -- We never make a filler for a terminating type: it might be speculatively + -- evaluated or have a field projected out of it. + -- See (AF4) in Note [Absent fillers], and + -- Note [Don't make fillers for terminating types]. + | isTerminatingType arg_ty + = Nothing + -- The lifted case: bind 'absentError'. See (AF1) in Note [Absent fillers] -- We want to use this case if possible, because we get a nice runtime panic message -- if we are wrong (like we were in #11126). Otherwise we fall through to the -- less-desirable mkLitRubbish case. | mightBeLiftedType arg_ty - , not (isDictTy arg_ty) -- See (AF4) in Note [Absent fillers] , not (isStrictDmd (idDemandInfo arg)) -- See (AF2) , not (isMarkedStrict str) -- in Note [Absent fillers] = Just (mkAbsentErrorApp arg_ty msg) @@ -1101,7 +1106,7 @@ mkAbsentFiller opts arg str -- will have different lengths and hence different costs for -- the inliner leading to different inlining. -- See also Note [Unique Determinism] in GHC.Types.Unique - file_msg = text "In module" <+> quotes (ppr $ wo_module opts) + file_msg = text "In module" <+> quotes (ppr mod) {- Note [Worker/wrapper for Strictness and Absence] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1295,27 +1300,8 @@ Needless to say, there are some wrinkles: have to be representation monomorphic. But in the future, we might allow levity polymorphism, e.g. a polymorphic levity variable in 'BoxedRep'. -(AF4) Consider (#24934) - f :: (a~b) => blah {-# INLINE f #-} - f d x = case eq_sel d of co -> body - In #24934 it turned out that `co` was unused; and we discarded the - entire case-scrutinisation via the `exprOkToDiscard` test in - `GHC.Core.Opt.Simplify.Iteration.rebuildCase`. So now `d` is absent. - But in the /unfolding/ for some reason we did not discard the `case`; - so when we inline `f` we end up evaluating that `d` argument. So we had - better not replace it with an error thunk! - - The root of it is this: `exprOkToDiscard` assumes that a dictionary is - non-bottom (Note [exprOkForSpeculation and type classes]); but then we replace - the (a~b) dictionary with an error thunk, breaking the invariant that every - dictionary is non-bottom. (If -XDictsStrict is on, the invariant is even - more important.) - - Simple solution: never use an error thunk for a dictionary; instead fall - through to mkRubbishLit. (The only downside is that we lose the compiler - debugging advantages of (AF1).) - - This is quite delicate. +(AF4) We never make an absent filler for a terminating type. + See Note [Don't make fillers for terminating types]. While (AF1) and (AF2) are simply an optimisation in terms of compiler debugging experience, (AF3) should be irrelevant in most programs, if not all. @@ -1337,6 +1323,47 @@ fragile because `MkT` is strict in its Int# argument, so we get an absentError exception when we shouldn't. Very annoying! +Note [Don't make fillers for terminating types] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We never make an absent filler, error thunk or rubbish literal, for a terminating +type (isTerminatingType): a non-unary class dictionary, a boxed equality, or a +constraint tuple. + +GHC relies on a dictionary value never being bottom (see +Note [NON-BOTTOM-DICTS invariant] in GHC.Core). GHC uses "speculation" to +evaluated guaranteed-non-bottom values: see Note [Speculative evaluation] in +GHC.CoreToStg.Prep. This speculative evaluation is fundamentally incompatible +with replacing a dictionary with an absent filler. Attempts to to do so gave +rise to a succession of bugs including: + + * #24934: we evaluated an absent dictionary + * #25924: we selected a superclass from an absent dictionary + +A terminating type is exactly what speculation will force: see +Note [exprOkForSpeculation and type classes] in GHC.Core.Utils. So we refuse to +make a filler for precisely those types. + +So the safe thing is to make no filler at all for a terminating type. Then there +is no bogus dictionary to evaluate or project from. Specifically + + * `mkAbsentFiller` returns `Nothing` for a terminating type, so worker/wrapper + keeps the real argument. + + * `Specialise.specHeader` calls `mkAbsentFiller` too, so it likewise keeps the + dead dictionary argument rather than dropping it for a filler. + +Prior failed approaches + +We used to paper over this. !13233 replaced the error thunk for an absent +dictionary with a rubbish literal, so that it could at least be evaluated +without complaint. But #25924 showed that this is not enough, because we do not +only evaluate the absent dictionary, we also select a superclass from it. + +We could instead teach speculation to leave absent bindings alone, and we do +that too (see Note [Speculative evaluation] in GHC.CoreToStg.Prep). But that is +not a guarantee. After optimisation a binding that holds an absent filler may no +longer be marked absent, so we cannot rely on the demand to protect us. + Note [Unboxing through unboxed tuples] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We should not to a worker/wrapper split just for unboxing the components of View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8bbc4359a7f2ccb79e5b6310fee00b39... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8bbc4359a7f2ccb79e5b6310fee00b39... You're receiving this email because of your account on gitlab.haskell.org.