- ghc-commits - Haskell.org

[Git][ghc/ghc] Pushed new branch wip/fendor/freeze-throw
by Hannes Siebenhandl (＠fendor) 20 Jan '26

20 Jan '26

Hannes Siebenhandl pushed new branch wip/fendor/freeze-throw at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/fendor/freeze-throw You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/fendor/stack-annotation-ty
by Hannes Siebenhandl (＠fendor) 20 Jan '26

20 Jan '26

Hannes Siebenhandl pushed new branch wip/fendor/stack-annotation-ty at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/fendor/stack-annotation-ty You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/24486
by Zubin (＠wz1000) 20 Jan '26

20 Jan '26

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

1 0

[Git][ghc/ghc] Pushed new branch wip/ext-interp-trace-stderr
by Cheng Shao (＠TerrorJack) 20 Jan '26

20 Jan '26

Cheng Shao pushed new branch wip/ext-interp-trace-stderr at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/ext-interp-trace-stderr You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/24588] ghc-toolchain: Also configure windres on non-windows platforms.
by Zubin (＠wz1000) 20 Jan '26

20 Jan '26

Zubin pushed to branch wip/24588 at Glasgow Haskell Compiler / GHC Commits: 8620a2a6 by Zubin Duggal at 2026-01-20T18:30:12+05:30 ghc-toolchain: Also configure windres on non-windows platforms. It may be needed for cross compilation. Fixes #24588 - - - - - 1 changed file: - utils/ghc-toolchain/exe/Main.hs Changes: ===================================== utils/ghc-toolchain/exe/Main.hs ===================================== @@ -480,13 +480,8 @@ mkTarget opts = do opt <- optional $ findProgram "opt" (optOpt opts) ["opt"] llvmAs <- optional $ findProgram "llvm assembler" (optLlvmAs opts) ["clang"] - -- Windows-specific utilities - windres <- - case archOS_OS archOs of - OSMinGW32 -> do - windres <- findProgram "windres" (optWindres opts) ["windres"] - return (Just windres) - _ -> return Nothing + -- for windows, also used for cross compiling + windres <- optional $ findProgram "windres" (optWindres opts) ["windres"] -- Darwin-specific utilities (otool, installNameTool) <- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8620a2a69c3dd9ece92c86c865728aa… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8620a2a69c3dd9ece92c86c865728aa… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/26738
by Zubin (＠wz1000) 20 Jan '26

20 Jan '26

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

1 0

[Git][ghc/ghc] Pushed new branch wip/24588
by Zubin (＠wz1000) 20 Jan '26

20 Jan '26

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

1 0

[Git][ghc/ghc][wip/26416] DmdAnal: Don't give an absent demand signature to an argument if the argument doesn't
by Zubin (＠wz1000) 20 Jan '26

20 Jan '26

Zubin pushed to branch wip/26416 at Glasgow Haskell Compiler / GHC Commits: decf94a1 by Zubin Duggal at 2026-01-20T17:30:26+05:30 DmdAnal: Don't give an absent demand signature to an argument if the argument doesn't also have an absent demand signature in its unfolding. Otherwise, in some cases we might mark an argument as absent and generate a LitRubbish for it, but then the function might inline and turn out to actually use this argument, resulting in a run time crash. Partially addresses #26416. There may still be cases where an absent argument turns out to be used due to a rule firing. - - - - - 4 changed files: - compiler/GHC/Core/Opt/DmdAnal.hs - + testsuite/tests/dmdanal/should_run/M1.hs - + testsuite/tests/dmdanal/should_run/T26416.hs - testsuite/tests/dmdanal/should_run/all.T Changes: ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -1106,8 +1106,17 @@ dmdAnalRhsSig top_lvl rec_flag env let_sd id rhs WithDmdType rhs_dmd_ty rhs' = dmdAnal env rhs_sd rhs DmdType rhs_env rhs_dmds = rhs_dmd_ty + + -- See Note [Absence analysis for stable unfoldings and RULES] + -- If there's a stable unfolding, we need to combine argument demands + -- from the unfolding with those from the RHS, because the unfolding + -- might use arguments that the (optimised) RHS doesn't. + -- Any argument with a demand absent in one but not the other can + -- be problematic, see #26416 + combined_rhs_dmds = combineUnfoldingDmds env rhs_sd id rhs_dmds + (final_rhs_dmds, final_rhs) = finaliseArgBoxities env id ww_arity - rhs_dmds (de_div rhs_env) rhs' + combined_rhs_dmds (de_div rhs_env) rhs' dmd_sig_arity = ww_arity + strictCallArity body_sd sig = mkDmdSigForArity dmd_sig_arity (DmdType sig_env final_rhs_dmds) @@ -1144,6 +1153,28 @@ splitWeakDmds :: DmdEnv -> (DmdEnv, WeakDmds) splitWeakDmds (DE fvs div) = (DE sig_fvs div, weak_fvs) where (!weak_fvs, !sig_fvs) = partitionVarEnv isWeakDmd fvs +-- | If there is a stable unfolding, don't let any demand be absent that +-- is also not absent in the unfolding +-- See Note [Absence analysis for stable unfoldings and RULES], Wrinkle (W3). +combineUnfoldingDmds :: AnalEnv -> SubDemand -> Id -> [Demand] -> [Demand] +combineUnfoldingDmds env rhs_sd id rhs_dmds + | not (isStableUnfolding unf) + = rhs_dmds -- No stable unfolding, nothing to do + + | Just unf_body <- maybeUnfoldingTemplate unf + , let WithDmdType (DmdType _ unf_dmds) _ = dmdAnal env rhs_sd unf_body + , let result = go rhs_dmds unf_dmds + = -- pprTrace "lubUnfoldingDmds" (ppr id $$ ppr rhs_dmds $$ ppr unf_dmds $$ ppr result) $ + result + | otherwise = rhs_dmds + where + unf = realIdUnfolding id + go rhs [] = rhs + go [] _ = [] + go (AbsDmd:rhs) (u:unfs) = u : go rhs unfs + go (r:rhs) (AbsDmd:unfs) = r : go rhs unfs + go (r:rhs) (_:unfs) = r : go rhs unfs + -- | The result type after applying 'idArity' many arguments. Returns 'Nothing' -- when the type doesn't have exactly 'idArity' many arrows. resultType_maybe :: Id -> Maybe Type @@ -1523,6 +1554,25 @@ Wrinkles: for `sg`, failing to unleash the signature and hence observed an absent error instead of the `really important message`. + (W3) The SOLUTION above handles /free variables/ of stable unfoldings, but + what about /arguments/? Consider (#25965) + + fromVector :: (Storable a, KnownNat n) => Vector a -> Vector a + fromVector v = ... (uses Storable dictionary) ... + {-# INLINABLE fromVector #-} + + Suppose that the optimised RHS of `fromVector` somehow discards the use of + the Storable dictionary, but the stable unfolding still uses it. Then the + demand signature will say that the Storable dictionary argument is absent, + and worker/wrapper will replace it with `LitRubbish`. But when the + worker's unfolding is inlined, it will use that rubbish value as a real + dictionary, leading to a segfault! + + SOLUTION: in `dmdAnalRhsSig`, if the function has a stable unfolding, + analyse it and drop any AbsDmds which are not absent in the unfolding. + This is done by `combineUnfoldingDmds`. This ensures that if the unfolding + uses an argument, it won't be marked as absent. + Note [DmdAnal for DataCon wrappers] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We give DataCon wrappers a (necessarily flat) demand signature in @@ -2046,8 +2096,11 @@ finaliseArgBoxities env fn ww_arity arg_dmds div rhs arg_triples :: [(Type, StrictnessMark, Demand)] arg_triples = take ww_arity $ - [ (idType bndr, NotMarkedStrict, get_dmd bndr) - | bndr <- bndrs, isRuntimeVar bndr ] + zipWith mk_triple + [ bndr | bndr <- bndrs, isRuntimeVar bndr ] + arg_dmds + where + mk_triple bndr dmd = (idType bndr, NotMarkedStrict, get_dmd dmd) arg_dmds' = ww_arg_dmds ++ map trimBoxity (drop ww_arity arg_dmds) -- If ww_arity < length arg_dmds, the leftover ones @@ -2063,12 +2116,10 @@ finaliseArgBoxities env fn ww_arity arg_dmds div rhs -- This is the budget initialisation step of -- Note [Worker argument budget] - get_dmd :: Id -> Demand - get_dmd bndr + get_dmd :: Demand -> Demand + get_dmd dmd | is_bot_fn = unboxDeeplyDmd dmd -- See Note [Boxity for bottoming functions], | otherwise = dmd -- case (B) - where - dmd = idDemandInfo bndr -- is_bot_fn: see Note [Boxity for bottoming functions] is_bot_fn = div == botDiv ===================================== testsuite/tests/dmdanal/should_run/M1.hs ===================================== @@ -0,0 +1,17 @@ +-- Short module name is essential, or else f doesn't inline +module M1 where +{-# INLINABLE [2] f #-} +f :: Int -> Int -> Float +f !dummy x = if times dummy 0 x == 1 + then 3.0 else 4.0 + +{-# INLINE [0] times #-} +times :: Int -> Int -> Int -> Int +times dummy 0 x = x `seq` ( 0 + big dummy ) +times _ a b = a * b + +{-# RULES "times" [1] forall dummy x. times dummy 0 x = 0 + big dummy #-} + +big :: Int -> Int +big x = succ . succ . succ . succ . succ . succ . succ . succ . succ $ x +{-# INLINE big #-} ===================================== testsuite/tests/dmdanal/should_run/T26416.hs ===================================== @@ -0,0 +1,3 @@ +module Main where +import M1 ( f ) +main = print (f 19 12) ===================================== testsuite/tests/dmdanal/should_run/all.T ===================================== @@ -34,3 +34,4 @@ test('T22475b', normal, compile_and_run, ['']) test('T22549', normal, compile_and_run, ['-fdicts-strict -fno-specialise']) test('T23208', exit_code(1), multimod_compile_and_run, ['T23208_Lib', 'T23208']) test('T25439', normal, compile_and_run, ['']) +test('T26416', normal, compile_and_run, ['T26416','M1.hs']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/decf94a1e1c3b6486f37f32dc2a0a5b… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/decf94a1e1c3b6486f37f32dc2a0a5b… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/26805] Fix buglet in short-cut constraint solving
by Simon Peyton Jones (＠simonpj) 20 Jan '26

20 Jan '26

Simon Peyton Jones pushed to branch wip/26805 at Glasgow Haskell Compiler / GHC Commits: 198f7eeb by Simon Peyton Jones at 2026-01-20T11:42:51+00:00 Fix buglet in short-cut constraint solving This MR address #26805 by using `isSolvedWC`, rather than `isEmptyWC`, in the short-cut constraint solver. See `GHC.Tc.Solver.Dict.tryShortCutSolver`. Easy fix! - - - - - 6 changed files: - compiler/GHC/Tc/Gen/Default.hs - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/Types/Constraint.hs - + testsuite/tests/simplCore/should_compile/T26805.hs - + testsuite/tests/simplCore/should_compile/T26805.stderr - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Tc/Gen/Default.hs ===================================== @@ -22,7 +22,7 @@ import GHC.Tc.Errors.Types import GHC.Tc.Gen.HsType import GHC.Tc.Solver.Monad ( runTcS ) import GHC.Tc.Solver.Solve ( solveWanteds ) -import GHC.Tc.Types.Constraint ( isEmptyWC, andWC, mkSimpleWC ) +import GHC.Tc.Types.Constraint ( isSolvedWC, andWC, mkSimpleWC ) import GHC.Tc.Types.Origin ( CtOrigin(DefaultOrigin) ) import GHC.Tc.Utils.Env import GHC.Tc.Utils.Monad @@ -296,7 +296,7 @@ simplifyDefault cls dflt_ty@(L l _) , text "inst_pred:" <+> ppr inst_pred , text "all_wanteds " <+> ppr all_wanteds , text "unsolved:" <+> ppr unsolved ] - ; let is_instance = isEmptyWC unsolved + ; let is_instance = isSolvedWC unsolved ; return $ if | is_instance , ClassPred _ tys <- classifyPredType inst_pred ===================================== compiler/GHC/Tc/Solver/Dict.hs ===================================== @@ -663,6 +663,12 @@ Some wrinkles: of the caller (#15164). You might worry about having a solved-dict that uses a Given -- but that too will have been subject to short-cut solving so it's fine. +(SCS4) In `tryShortCutSolver`, when deciding if we have "completely solved" the + constraint, we must use `isSolvedWC` not `isEmptyWC`. The latter says "False" + if the residual constraint has any implications, even solved ones; and we + don't want to reject short-cut solving just because we have some leftover + /solved/ implications. #26805 was a case in point. + Note [Shortcut solving: incoherence] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ This optimization relies on coherence of dictionaries to be correct. When we @@ -798,7 +804,11 @@ tryShortCutSolver try_short_cut dict_w@(DictCt { di_ev = ev_w }) -> tryShortCutTcS $ -- tryTcS tries to completely solve some contraints do { residual <- solveSimpleWanteds (unitBag (CDictCan dict_w)) - ; return (isEmptyWC residual) } + ; return (isSolvedWC residual) } + -- NB: isSolvedWC, not isEmptyWC (#26805). We might succeed + -- in fully-solving the constraint but still leave some + -- /solved/ implications in the residual. + -- See (SCS4) in Note [Shortcut solving] | otherwise -> return False } ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -1055,6 +1055,13 @@ mkImplicWC :: Bag Implication -> WantedConstraints mkImplicWC implic = emptyWC { wc_impl = implic } +-- | `isEmptyWC` sess if a `WantedConstraints` is truly empty, including +-- having no implications. +-- +-- It's possible that it might have /solved/ implications, which are left around +-- just so we can report unreachable code. So: +-- isEmptyWC implies isSolvedWC- +-- but not vice versa isEmptyWC :: WantedConstraints -> Bool isEmptyWC (WC { wc_simple = f, wc_impl = i, wc_errors = errors }) = isEmptyBag f && isEmptyBag i && isEmptyBag errors ===================================== testsuite/tests/simplCore/should_compile/T26805.hs ===================================== @@ -0,0 +1,29 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE ImpredicativeTypes #-} +{-# LANGUAGE TypeData #-} +module T26805( interpret ) where + +import Data.Kind (Type) + +data Phantom (sh :: Type) = Phantom -- newtype fails to specialise as well + +instance Show (Phantom sh) where + show Phantom = "show" + +type Foo r = (forall sh. Show (Phantom sh), Num r) +-- this specialises fine: +-- type Foo r = (Num r) + +type data TK = TKScalar Type + +data AstTensor :: TK -> Type where + AstInt :: Int -> AstTensor (TKScalar Int) + AstPlus :: Foo r => AstTensor (TKScalar r) -> AstTensor (TKScalar r) + +plusConcrete :: Foo r => r -> r +plusConcrete = (+ 1) + +interpret :: AstTensor (TKScalar Int) -> Int +interpret v0 = case v0 of + AstInt n -> n + AstPlus u -> plusConcrete (interpret u) ===================================== testsuite/tests/simplCore/should_compile/T26805.stderr ===================================== @@ -0,0 +1 @@ + \ No newline at end of file ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -578,3 +578,4 @@ test('T26615', [grep_errmsg(r'fEqList')], multimod_compile, ['T26615', '-O -fsp # T26722: there should be no reboxing in $wg test('T26722', [grep_errmsg(r'SPEC')], compile, ['-O -dno-typeable-binds']) +test('T26805', [grep_errmsg(r'fromInteger')], compile, ['-O -dno-typeable-binds -ddump-simpl -dsuppress-uniques']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/198f7eeb27e9bca95b7f0b9afc44830… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/198f7eeb27e9bca95b7f0b9afc44830… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/26805
by Simon Peyton Jones (＠simonpj) 20 Jan '26

20 Jan '26

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

1 0