Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: bd3eba86 by Vladislav Zavialov at 2026-02-27T05:48:01-05:00 Check for negative type literals in the type checker (#26861) GHC disallows negative type literals (e.g., -1), as tested by T8306 and T8412. This check is currently performed in the renamer: rnHsTyLit tyLit@(HsNumTy x i) = do when (i < 0) $ addErr $ TcRnNegativeNumTypeLiteral tyLit However, this check can be bypassed using RequiredTypeArguments (see the new test case T26861). Prior to this patch, such programs caused the compiler to hang instead of reporting a proper error. This patch addresses the issue by adding an equivalent check in the type checker, namely in tcHsType. The diff is deliberately minimal to facilitate backporting. A more comprehensive rework of HsTyLit is planned for a separate commit. - - - - - faf14e0c by Vladislav Zavialov at 2026-02-27T05:48:45-05:00 Consistent pretty-printing of HsString, HsIsString, HsStrTy Factor out a helper to pretty-print string literals, thus fixing newline handling for overloaded string literals and type literals. Test cases: T26860ppr T26860ppr_overloaded T26860ppr_tylit Follow up to ddf1434ff9bb08cfef3c93f23de6b83ec698aa27 - - - - - 688af3fb by Arnaud Spiwack at 2026-02-27T06:22:19-05:00 Make list comprehension completely non-linear Fixes #25081 From the note: The usefulness of list comprehension in conjunction with linear types is dubious. After all, statements are made to be run many times, for instance in ```haskell [u | y <- [0,1], stmts] ``` both `u` and `stmts` are going to be run several times. In principle, though, there are some position in a monad comprehension expression which could be considered linear. We could try and make it so that these positions are considered linear by the typechecker, but in practice the desugarer doesn't take enough care to ensure that these are indeed desugared to linear sites. We tried in the past, and it turned out that we'd miss a desugaring corner case (#25772). Until there's a demand for this very specific improvement, let's instead be conservative, and consider list comprehension to be completely non-linear. - - - - - b22799ca by Simon Jakobi at 2026-02-27T06:22:23-05:00 PmAltConSet: Use Data.Set instead of Data.Map ...to store `PmLit`s. The Map was only used to map keys to themselves. Changing the Map to a Set saves a Word of memory per entry. Resolves #26756. - - - - - 17 changed files: - compiler/GHC/Hs/Lit.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Match.hs - − testsuite/tests/linear/should_compile/LinearListComprehension.hs - testsuite/tests/linear/should_compile/all.T - testsuite/tests/linear/should_fail/T25081.hs - testsuite/tests/linear/should_fail/T25081.stderr - + testsuite/tests/parser/should_fail/T26860ppr_overloaded.hs - + testsuite/tests/parser/should_fail/T26860ppr_overloaded.stderr - + testsuite/tests/parser/should_fail/T26860ppr_tylit.hs - + testsuite/tests/parser/should_fail/T26860ppr_tylit.stderr - testsuite/tests/parser/should_fail/all.T - + testsuite/tests/typecheck/should_fail/T26861.hs - + testsuite/tests/typecheck/should_fail/T26861.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== compiler/GHC/Hs/Lit.hs ===================================== @@ -21,7 +21,7 @@ import GHC.Prelude import {-# SOURCE #-} GHC.Hs.Expr( pprExpr ) -import GHC.Data.FastString (unpackFS) +import GHC.Data.FastString (FastString, unpackFS) import GHC.Types.Basic (PprPrec(..), topPrec ) import GHC.Core.Ppr ( {- instance OutputableBndr TyVar -} ) import GHC.Types.SourceText @@ -209,10 +209,7 @@ Equivalently it's True if instance IsPass p => Outputable (HsLit (GhcPass p)) where ppr (HsChar st c) = pprWithSourceText st (pprHsChar c) ppr (HsCharPrim st c) = pprWithSourceText st (pprPrimChar c) - ppr (HsString st s) = - case st of - NoSourceText -> pprHsString s - SourceText src -> vcat $ map text $ split '\n' (unpackFS src) + ppr (HsString st s) = pprHsStringLit st s ppr (HsStringPrim st s) = pprWithSourceText st (pprHsBytes s) ppr (HsInt _ i) = pprWithSourceText (il_text i) (integer (il_value i)) @@ -233,6 +230,10 @@ instance IsPass p => Outputable (HsLit (GhcPass p)) where (HsInteger st i _) -> pprWithSourceText st (integer i) (HsRat f _) -> ppr f +pprHsStringLit :: SourceText -> FastString -> SDoc +pprHsStringLit NoSourceText s = pprHsString s +pprHsStringLit (SourceText src) _ = vcat $ map text $ split '\n' (unpackFS src) + -- in debug mode, print the expression that it's resolved to, too instance OutputableBndrId p => Outputable (HsOverLit (GhcPass p)) where @@ -242,7 +243,7 @@ instance OutputableBndrId p instance Outputable OverLitVal where ppr (HsIntegral i) = pprWithSourceText (il_text i) (integer (il_value i)) ppr (HsFractional f) = ppr f - ppr (HsIsString st s) = pprWithSourceText st (pprHsString s) + ppr (HsIsString st s) = pprHsStringLit st s negateOverLitVal :: OverLitVal -> OverLitVal negateOverLitVal (HsIntegral i) = HsIntegral (negateIntegralLit i) ===================================== compiler/GHC/Hs/Type.hs ===================================== @@ -116,6 +116,7 @@ import GHC.Core.Ppr ( pprOccWithTick) import GHC.Core.Type import GHC.Core.Multiplicity( pprArrowWithMultiplicity ) import GHC.Hs.Doc +import GHC.Hs.Lit (pprHsStringLit) import GHC.Generics (Generic, Generically(..)) import GHC.Types.Basic import GHC.Types.SrcLoc @@ -1346,7 +1347,7 @@ instance (OutputableBndrId pass) => OutputableBndr (GenLocated SrcSpan (FieldOcc ppr_tylit :: (HsTyLit (GhcPass p)) -> SDoc ppr_tylit (HsNumTy source i) = pprWithSourceText source (integer i) -ppr_tylit (HsStrTy source s) = pprWithSourceText source (text (show s)) +ppr_tylit (HsStrTy source s) = pprHsStringLit source s ppr_tylit (HsCharTy source c) = pprWithSourceText source (text (show c)) pprAnonWildCard :: SDoc ===================================== compiler/GHC/HsToCore/Pmc/Solver/Types.hs ===================================== @@ -75,7 +75,7 @@ import GHC.Generics (Generic, Generically(..)) import Numeric (fromRat) import Data.Ratio import Data.List( find ) -import qualified Data.Map as FM +import qualified Data.Set as Set import GHC.Real (Ratio(..)) import qualified Data.Semigroup as S @@ -388,7 +388,7 @@ data PmLitValue | PmLitOverString FastString -- | Syntactic equality. --- We want (Ord PmLit) so that we can use (Map PmLit x) in `PmAltConSet` +-- We want (Ord PmLit) so that we can use (Set PmLit) in `PmAltConSet` instance Eq PmLit where a == b = (a `compare` b) == EQ instance Ord PmLit where @@ -510,34 +510,34 @@ data PmAltCon = PmAltConLike ConLike | PmAltLit PmLit data PmAltConSet = PACS !(UniqDSet ConLike) - !(FM.Map PmLit PmLit) --- We use a (FM.Map PmLit PmLit) here, at the cost of requiring an Ord + !(Set.Set PmLit) +-- We use a (Data.Set.Set PmLit) here, at the cost of requiring an Ord -- instance for PmLit, because in extreme cases the set of PmLits can be -- very large. See #26514. emptyPmAltConSet :: PmAltConSet -emptyPmAltConSet = PACS emptyUniqDSet FM.empty +emptyPmAltConSet = PACS emptyUniqDSet Set.empty isEmptyPmAltConSet :: PmAltConSet -> Bool isEmptyPmAltConSet (PACS cls lits) - = isEmptyUniqDSet cls && FM.null lits + = isEmptyUniqDSet cls && Set.null lits -- | Whether there is a 'PmAltCon' in the 'PmAltConSet' that compares 'Equal' to -- the given 'PmAltCon' according to 'eqPmAltCon'. elemPmAltConSet :: PmAltCon -> PmAltConSet -> Bool elemPmAltConSet (PmAltConLike cl) (PACS cls _ ) = elementOfUniqDSet cl cls -elemPmAltConSet (PmAltLit lit) (PACS _ lits) = isJust (FM.lookup lit lits) +elemPmAltConSet (PmAltLit lit) (PACS _ lits) = Set.member lit lits extendPmAltConSet :: PmAltConSet -> PmAltCon -> PmAltConSet extendPmAltConSet (PACS cls lits) (PmAltConLike cl) = PACS (addOneToUniqDSet cls cl) lits extendPmAltConSet (PACS cls lits) (PmAltLit lit) - = PACS cls (FM.insert lit lit lits) + = PACS cls (Set.insert lit lits) pmAltConSetElems :: PmAltConSet -> [PmAltCon] pmAltConSetElems (PACS cls lits) = map PmAltConLike (uniqDSetToList cls) ++ - FM.foldr ((:) . PmAltLit) [] lits + map PmAltLit (Set.toList lits) instance Outputable PmAltConSet where ppr = ppr . pmAltConSetElems ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -1264,8 +1264,10 @@ tcHsType _ rn_ty@(HsStarTy _ _) exp_kind = checkExpKind rn_ty liftedTypeKind liftedTypeKind exp_kind --------- Literals -tcHsType _ rn_ty@(HsTyLit _ (HsNumTy _ n)) exp_kind - = do { checkWiredInTyCon naturalTyCon +tcHsType _ rn_ty@(HsTyLit _ (HsNumTy x n)) exp_kind + = do { when (n < 0) $ + addErr $ TcRnNegativeNumTypeLiteral (HsNumTy x n) + ; checkWiredInTyCon naturalTyCon ; checkExpKind rn_ty (mkNumLitTy n) naturalTy exp_kind } tcHsType _ rn_ty@(HsTyLit _ (HsStrTy _ s)) exp_kind ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -543,9 +543,29 @@ tcGuardStmt _ stmt _ _ -- potential for non-trivial coercions in tcMcStmt {- -Note [Binding in list comprehension isn't linear] +Note [List comprehension isn't linear] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -In principle, [ y | () <- xs, y <- [0,1]] could be linear in `xs`. +The usefulness of list comprehension in conjunction with linear types is dubious. +After all, statements are made to be run many times, for instance in + +[u | y <- [0,1], stmts] + +both u and stmts are going to be run several times. + +In principle, though, there are some positions in a monad comprehension +expressions which could be considered linear. We could try and make it so that +these positions are considered linear by the typechecker, but in practice the +desugarer doesn't take enough care to ensure that these are indeed desugared to +linear sites. We tried in the past, and it turned out that we'd miss a +desugaring corner case (#25772). + +Until there's a demand for this very specific improvement, let's instead be +conservative, and consider list comprehension to be completely non-linear. + +Here are the case where list comprehension could be linear, together with the +known challenges. + +(LCL1) [ y | () <- xs, y <- [0,1]] could be linear in `xs`. But, the way the desugaring works, we get something like case xs of @@ -566,21 +586,31 @@ isn't linear in `xs` since the elements of `xs` are ignored. So we'd still have to call `tcScalingUsage` on `xs` in `tcLcStmt`, we'd just have to create a fresh multiplicity variable. We'd also use the same multiplicity variable in the call to `tcCheckPat` instead of `unrestricted`. + +(LCL2) [ y | b, y <- [0,1]] could be linear in `b`. This actually works fine +with -O0 (as far as anybody knows), but -O and higher desugar list comprehension +using the `build` combinator (this was the cause of #25772). But `build` isn't +defined to be linear. The consequences of making `build` linear are +unknown. It's not worth trying until a real need arises. + +(LCL3) [ x | ] could be linear in x. But it's unclear why anybody would want to +write this instead of [ x ]. Besides, this syntax is currently rejected by the +parser. The `build` obstacle of (LCL2) applies here too. -} tcLcStmt :: TyCon -- The list type constructor ([]) -> TcExprStmtChecker tcLcStmt _ _ (LastStmt x body noret _) elt_ty thing_inside - = do { body' <- tcMonoExprNC body elt_ty + = do { -- see (LCL3) in Note [List comprehension isn't linear] + body' <- tcScalingUsage ManyTy $ tcMonoExprNC body elt_ty ; thing <- thing_inside (panic "tcLcStmt: thing_inside") ; return (LastStmt x body' noret noSyntaxExpr, thing) } -- A generator, pat <- rhs tcLcStmt m_tc ctxt (BindStmt _ pat rhs) elt_ty thing_inside = do { pat_ty <- newFlexiTyVarTy liftedTypeKind - -- About the next `tcScalingUsage ManyTy` and unrestricted - -- see Note [Binding in list comprehension isn't linear] + -- see (LCL1) in Note [List comprehension isn't linear] ; rhs' <- tcScalingUsage ManyTy $ tcCheckMonoExpr rhs (mkTyConApp m_tc [pat_ty]) ; (pat', thing) <- tcCheckPat (StmtCtxt ctxt) pat (unrestricted pat_ty) $ tcScalingUsage ManyTy $ @@ -589,7 +619,9 @@ tcLcStmt m_tc ctxt (BindStmt _ pat rhs) elt_ty thing_inside -- A boolean guard tcLcStmt _ _ (BodyStmt _ rhs _ _) elt_ty thing_inside - = do { rhs' <- tcCheckMonoExpr rhs boolTy + = do { -- Regarding the `tcScalingUsage ManyTy` on the `rhs`, + -- see (LCL2) in Note [List comprehension isn't linear] + rhs' <- tcScalingUsage ManyTy $ tcCheckMonoExpr rhs boolTy ; thing <- tcScalingUsage ManyTy $ thing_inside elt_ty ; return (BodyStmt boolTy rhs' noSyntaxExpr noSyntaxExpr, thing) } ===================================== testsuite/tests/linear/should_compile/LinearListComprehension.hs deleted ===================================== @@ -1,14 +0,0 @@ -{-# LANGUAGE LinearTypes #-} - -module LinearListComprehension where - --- Probably nobody actually cares if monad comprehension realised that it can be --- linear in the first statement. But it can, so we might as well. - -guard :: a %1 -> (a %1 -> Bool) %1 -> [Int] -guard x g = [ y | g x, y <- [0,1] ] - --- This isn't correct syntax, but a singleton list comprehension would --- presumably work too --- last :: a %1 -> [a] --- last x = [ x | ] ===================================== testsuite/tests/linear/should_compile/all.T ===================================== @@ -47,7 +47,6 @@ test('LinearRecUpd', normal, compile, ['']) test('T23814', normal, compile, ['']) test('LinearLet', normal, compile, ['']) test('LinearLetPoly', normal, compile, ['']) -test('LinearListComprehension', normal, compile, ['-dlinear-core-lint']) test('OmitFieldPat', normal, compile, ['-dcore-lint']) test('T25515', normal, compile, ['-dcore-lint']) test('T25428', normal, compile, ['']) ===================================== testsuite/tests/linear/should_fail/T25081.hs ===================================== @@ -22,11 +22,16 @@ guard_bind x = [ () | False, _ <- [x]] guard_guard :: a %1 -> (a %1 -> Bool) %1 -> [()] guard_guard x g = [ () | False, g x ] --- This could, in principle, be linear. But see Note [Binding in list +-- This could, in principle, be linear. But see (LCL1) in Note [List -- comprehension isn't linear] in GHC.Tc.Gen.Match. first_bind :: [()] %1 -> [Int] first_bind xs = [ y | () <- xs, y <- [0,1]] +-- This could, in principle, be linear. But see (LCL2) in Note [List +-- comprehension isn't linear] in GHC.Tc.Gen.Match. +first_guard :: a %1 -> (a %1 -> Bool) %1 -> [Int] +first_guard x g = [ y | g x, y <- [0,1] ] + parallel :: a %1 -> [(a, Bool)] parallel x = [(y,z) | y <- [x] | z <- [True]] ===================================== testsuite/tests/linear/should_fail/T25081.stderr ===================================== @@ -44,20 +44,32 @@ T25081.hs:28:12: error: [GHC-18872] • In an equation for ‘first_bind’: first_bind xs = [y | () <- xs, y <- [0, 1]] -T25081.hs:31:10: error: [GHC-18872] +T25081.hs:33:13: error: [GHC-18872] + • Couldn't match type ‘Many’ with ‘One’ + arising from multiplicity of ‘x’ + • In an equation for ‘first_guard’: + first_guard x g = [y | g x, y <- [0, 1]] + +T25081.hs:33:15: error: [GHC-18872] + • Couldn't match type ‘Many’ with ‘One’ + arising from multiplicity of ‘g’ + • In an equation for ‘first_guard’: + first_guard x g = [y | g x, y <- [0, 1]] + +T25081.hs:36:10: error: [GHC-18872] • Couldn't match type ‘Many’ with ‘One’ arising from multiplicity of ‘x’ • In an equation for ‘parallel’: parallel x = [(y, z) | y <- [x] | z <- [True]] -T25081.hs:34:16: error: [GHC-18872] +T25081.hs:39:16: error: [GHC-18872] • Couldn't match type ‘Many’ with ‘One’ arising from multiplicity of ‘x’ • In an equation for ‘parallel_guard’: parallel_guard x g = [(y, z) | g x, y <- [0, 1] | z <- [True, False]] -T25081.hs:37:11: error: [GHC-18872] +T25081.hs:42:11: error: [GHC-18872] • Couldn't match type ‘Many’ with ‘One’ arising from multiplicity of ‘x’ • In an equation for ‘transform’: ===================================== testsuite/tests/parser/should_fail/T26860ppr_overloaded.hs ===================================== @@ -0,0 +1,11 @@ +{-# LANGUAGE OverloadedStrings #-} + +module T26860ppr_overloaded where + +-- Test that the error message containing the string literal is well-formatted. +-- See also: parser/should_fail/MultilineStringsError +x :: Int +x = "first line \ + \asdf\n\ + \second line" + ===================================== testsuite/tests/parser/should_fail/T26860ppr_overloaded.stderr ===================================== @@ -0,0 +1,14 @@ +T26860ppr_overloaded.hs:8:5: error: [GHC-39999] + • No instance for ‘GHC.Internal.Data.String.IsString Int’ + arising from the literal ‘"first line \ + \asdf\n\ + \second line"’ + • In the expression: + "first line \ + \asdf\n\ + \second line" + In an equation for ‘x’: + x = "first line \ + \asdf\n\ + \second line" + ===================================== testsuite/tests/parser/should_fail/T26860ppr_tylit.hs ===================================== @@ -0,0 +1,13 @@ +{-# LANGUAGE DataKinds #-} + +module T26860ppr_tylit where + +import Data.Kind (Type) + +-- Test that the error message containing the string literal is well-formatted. +-- See also: parser/should_fail/MultilineStringsError +type X :: Type +type X = "first line \ + \asdf\n\ + \second line" + ===================================== testsuite/tests/parser/should_fail/T26860ppr_tylit.stderr ===================================== @@ -0,0 +1,11 @@ +T26860ppr_tylit.hs:10:10: error: [GHC-83865] + • Expected a type, + but ‘"first line \ + \asdf\n\ + \second line"’ has kind + ‘GHC.Internal.Types.Symbol’ + • In the type ‘"first line \ + \asdf\n\ + \second line"’ + In the type synonym declaration for ‘X’ + ===================================== testsuite/tests/parser/should_fail/all.T ===================================== @@ -245,3 +245,5 @@ test('T26418', normal, compile_fail, ['']) test('T12488c', normal, compile_fail, ['']) test('T12488d', normal, compile_fail, ['']) test('T26860ppr', normal, compile_fail, ['']) +test('T26860ppr_overloaded', normal, compile_fail, ['']) +test('T26860ppr_tylit', normal, compile_fail, ['']) ===================================== testsuite/tests/typecheck/should_fail/T26861.hs ===================================== @@ -0,0 +1,14 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE NegativeLiterals #-} +{-# LANGUAGE RequiredTypeArguments #-} + +module T26861 where + +import Data.Proxy +import GHC.TypeLits + +main :: IO () +main = print (natVis (-42)) + +natVis :: forall a -> KnownNat a => Integer +natVis n = natVal (Proxy @n) ===================================== testsuite/tests/typecheck/should_fail/T26861.stderr ===================================== @@ -0,0 +1,6 @@ +T26861.hs:11:23: error: [GHC-93632] + • Illegal literal in type (type literals must not be negative): -42 + • In the type ‘-42’ + In the first argument of ‘print’, namely ‘(natVis (-42))’ + In the expression: print (natVis (-42)) + ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -752,3 +752,4 @@ test('T23162a', normal, compile_fail, ['']) test('T23162b', normal, compile_fail, ['']) test('T23162c', normal, compile, ['']) test('T23162d', normal, compile, ['']) +test('T26861', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/21828b5893978bd3e07418599e30a7b... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/21828b5893978bd3e07418599e30a7b... You're receiving this email because of your account on gitlab.haskell.org.