Simon Peyton Jones pushed to branch wip/T26607 at Glasgow Haskell Compiler / GHC Commits: 8ddc0d55 by Simon Peyton Jones at 2025-11-25T00:29:07+00:00 Wibble - - - - - 1 changed file: - compiler/GHC/Stg/Lint.hs Changes: ===================================== compiler/GHC/Stg/Lint.hs ===================================== @@ -109,7 +109,7 @@ import GHC.Core.Lint ( lintMessage ) import GHC.Types.Basic ( TopLevelFlag(..), isTopLevel, isMarkedCbv ) import GHC.Types.CostCentre ( isCurrentCCS ) import GHC.Types.Id -import GHC.Types.Literal ( isLitRubbish ) +import GHC.Types.Literal ( Literal, isLitRubbish ) import GHC.Types.Var.Set import GHC.Types.Name ( getSrcLoc, nameIsLocalOrFrom ) import GHC.Types.RepType @@ -186,7 +186,7 @@ lintStgConArg arg = do text "Its PrimReps are: " <> ppr badRep case arg of - StgLitArg _ -> pure () + StgLitArg l -> lintStgLit l StgVarArg v -> lintStgVar v lintStgFunArg :: StgArg -> LintM () @@ -201,7 +201,7 @@ lintStgFunArg arg = do text "Its PrimReps are: " <> ppr badRep case arg of - StgLitArg _ -> pure () + StgLitArg l -> lintStgLit l StgVarArg v -> lintStgVar v lintStgVar :: Id -> LintM () @@ -275,9 +275,7 @@ lintStgRhs rhs@(StgRhsCon _ con _ _ args _) = do lintStgExpr :: (OutputablePass a, BinderP a ~ Id) => GenStgExpr a -> LintM () -lintStgExpr (StgLit lit) - | isLitRubbish lit = addErrL (hang (text "Found rubbish literal:") 2 (ppr lit)) - | otherwise = return () +lintStgExpr (StgLit lit) = lintStgLit lit lintStgExpr e@(StgApp fun args) = do lintStgVar fun @@ -285,8 +283,6 @@ lintStgExpr e@(StgApp fun args) = do lintAppCbvMarks e lintStgAppReps fun args - - lintStgExpr app@(StgConApp con _n args _arg_tys) = do -- unboxed sums should vanish during unarise lf <- getLintFlags @@ -324,6 +320,11 @@ lintStgExpr (StgCase scrut bndr alts_type alts) = do addInScopeVars [bndr | in_scope] (mapM_ lintAlt alts) +lintStgLit :: Literal -> LintM () +lintStgLit lit + | isLitRubbish lit = addErrL (hang (text "Found rubbish literal:") 2 (ppr lit)) + | otherwise = return () + lintAlt :: (OutputablePass a, BinderP a ~ Id) => GenStgAlt a -> LintM () View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8ddc0d55449b004c11656c089a4dcd39... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8ddc0d55449b004c11656c089a4dcd39... You're receiving this email because of your account on gitlab.haskell.org.