[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: Make list comprehension completely non-linear
by Marge Bot (＠marge-bot) 27 Feb '26
by Marge Bot (＠marge-bot) 27 Feb '26
27 Feb '26
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
f108a972 by Arnaud Spiwack at 2026-02-27T12:53:01-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.
- - - - -
ae799cab by Simon Jakobi at 2026-02-27T12:53:54-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.
- - - - -
18b64c1e by Vladislav Zavialov at 2026-02-27T13:25:34-05:00
Drop HsTyLit in favor of HsLit (#26862, #25121)
This patch is a small step towards unification of HsExpr and HsType,
taking care of literals (HsLit) and type literals (HsTyLit).
Additionally, it improves error messages for unsupported type literals,
such as unboxed or fractional literals (test cases: T26862, T26862_th).
Changes to the AST:
* Use HsLit where HsTyLit was previously used
* Use HsChar where HsCharTy was previously used
* Use HsString where HsStrTy was previously used
* Use HsNatural (NEW) where HsNumTy was previously used
* Use HsDouble (NEW) to represent unsupported fractional type literals
Changes to logic:
* Parse unboxed and fractional type literals (to be rejected later)
* Drop the check for negative literals in the renamer (rnHsTyLit)
in favor of checking in the type checker (tc_hs_lit_ty)
* Check for invalid type literals in TH (repTyLit) and report
unrepresentable literals with ThUnsupportedTyLit
* Allow negative type literals in TH (numTyLit). This is fine as
these will be taken care of at splice time (test case: T8306_th)
- - - - -
e24239a1 by Vladislav Zavialov at 2026-02-27T13:25:35-05:00
Increase test coverage of diagnostics
Add test cases for the previously untested diagnostics:
[GHC-01239] PsErrIfInFunAppExpr
[GHC-04807] PsErrProcInFunAppExpr
[GHC-08195] PsErrInvalidRecordCon
[GHC-16863] PsErrUnsupportedBoxedSumPat
[GHC-18910] PsErrSemiColonsInCondCmd
[GHC-24737] PsErrInvalidWhereBindInPatSynDecl
[GHC-25037] PsErrCaseInFunAppExpr
[GHC-25078] PsErrPrecedenceOutOfRange
[GHC-28021] PsErrRecordSyntaxInPatSynDecl
[GHC-35827] TcRnNonOverloadedSpecialisePragma
[GHC-40845] PsErrUnpackDataCon
[GHC-45106] PsErrInvalidInfixHole
[GHC-50396] PsErrInvalidRuleActivationMarker
[GHC-63930] MultiWayIfWithoutAlts
[GHC-65536] PsErrNoSingleWhereBindInPatSynDecl
[GHC-67630] PsErrMDoInFunAppExpr
[GHC-70526] PsErrLetCmdInFunAppCmd
[GHC-77808] PsErrDoCmdInFunAppCmd
[GHC-86934] ClassPE
[GHC-90355] PsErrLetInFunAppExpr
[GHC-91745] CasesExprWithoutAlts
[GHC-92971] PsErrCaseCmdInFunAppCmd
[GHC-95644] PsErrBangPatWithoutSpace
[GHC-97005] PsErrIfCmdInFunAppCmd
Remove unused error constructors:
[GHC-44524] PsErrExpectedHyphen
[GHC-91382] TcRnIllegalKindSignature
- - - - -
c7f6b7d3 by Torsten Schmits at 2026-02-27T13:25:36-05:00
Avoid expensive computation for debug logging in `mergeDatabases` when log level is low
This computed and traversed a set intersection for every single
dependency unconditionally.
- - - - -
98 changed files:
- compiler/GHC/Hs/Instances.hs
- compiler/GHC/Hs/Lit.hs
- compiler/GHC/Hs/Syn/Type.hs
- compiler/GHC/Hs/Type.hs
- compiler/GHC/HsToCore/Errors/Ppr.hs
- compiler/GHC/HsToCore/Errors/Types.hs
- compiler/GHC/HsToCore/Match/Literal.hs
- compiler/GHC/HsToCore/Pmc/Solver/Types.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/Errors/Ppr.hs
- compiler/GHC/Parser/Errors/Types.hs
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Rename/Expr.hs
- compiler/GHC/Rename/HsType.hs
- compiler/GHC/Rename/Pat.hs
- compiler/GHC/Rename/Utils.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Tc/Gen/App.hs
- compiler/GHC/Tc/Gen/HsType.hs
- compiler/GHC/Tc/Gen/Match.hs
- compiler/GHC/Tc/Gen/Pat.hs
- compiler/GHC/ThToHs.hs
- compiler/GHC/Types/Error/Codes.hs
- compiler/GHC/Types/SourceText.hs
- compiler/GHC/Unit/State.hs
- compiler/Language/Haskell/Syntax/Expr.hs
- compiler/Language/Haskell/Syntax/Extension.hs
- compiler/Language/Haskell/Syntax/Lit.hs
- compiler/Language/Haskell/Syntax/Type.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Lib.hs
- + testsuite/tests/dependent/should_fail/SelfDepCls.hs
- + testsuite/tests/dependent/should_fail/SelfDepCls.stderr
- testsuite/tests/dependent/should_fail/all.T
- testsuite/tests/diagnostic-codes/codes.stdout
- testsuite/tests/ghc-api/annotations-literals/parsed.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/module/all.T
- + testsuite/tests/module/mod70b.hs
- + testsuite/tests/module/mod70b.stderr
- + testsuite/tests/parser/should_fail/NoBlockArgumentsFail4.hs
- + testsuite/tests/parser/should_fail/NoBlockArgumentsFail4.stderr
- testsuite/tests/parser/should_fail/NoBlockArgumentsFailArrowCmds.hs
- testsuite/tests/parser/should_fail/NoBlockArgumentsFailArrowCmds.stderr
- + testsuite/tests/parser/should_fail/NoDoAndIfThenElseArrowCmds.hs
- + testsuite/tests/parser/should_fail/NoDoAndIfThenElseArrowCmds.stderr
- testsuite/tests/parser/should_fail/all.T
- + testsuite/tests/parser/should_fail/badRuleMarker.hs
- + testsuite/tests/parser/should_fail/badRuleMarker.stderr
- + testsuite/tests/parser/should_fail/patFail010.hs
- + testsuite/tests/parser/should_fail/patFail010.stderr
- + testsuite/tests/parser/should_fail/patFail011.hs
- + testsuite/tests/parser/should_fail/patFail011.stderr
- + testsuite/tests/parser/should_fail/precOutOfRange.hs
- + testsuite/tests/parser/should_fail/precOutOfRange.stderr
- + testsuite/tests/parser/should_fail/unpack_data_con.hs
- + testsuite/tests/parser/should_fail/unpack_data_con.stderr
- testsuite/tests/patsyn/should_fail/T10426.stderr
- testsuite/tests/patsyn/should_fail/all.T
- + testsuite/tests/patsyn/should_fail/patsyn_where_fail1.hs
- + testsuite/tests/patsyn/should_fail/patsyn_where_fail1.stderr
- + testsuite/tests/patsyn/should_fail/patsyn_where_fail2.hs
- + testsuite/tests/patsyn/should_fail/patsyn_where_fail2.stderr
- + testsuite/tests/patsyn/should_fail/patsyn_where_fail3.hs
- + testsuite/tests/patsyn/should_fail/patsyn_where_fail3.stderr
- + testsuite/tests/patsyn/should_fail/patsyn_where_fail4.hs
- + testsuite/tests/patsyn/should_fail/patsyn_where_fail4.stderr
- + testsuite/tests/th/T26862_th.script
- + testsuite/tests/th/T26862_th.stderr
- + testsuite/tests/th/T8306_th.script
- + testsuite/tests/th/T8306_th.stderr
- + testsuite/tests/th/T8306_th.stdout
- testsuite/tests/th/T8412.stderr
- + testsuite/tests/th/TH_EmptyLamCases.hs
- + testsuite/tests/th/TH_EmptyLamCases.stderr
- + testsuite/tests/th/TH_EmptyMultiIf.hs
- + testsuite/tests/th/TH_EmptyMultiIf.stderr
- testsuite/tests/th/all.T
- + testsuite/tests/typecheck/should_fail/T26862.hs
- + testsuite/tests/typecheck/should_fail/T26862.stderr
- testsuite/tests/typecheck/should_fail/T8306.stderr
- testsuite/tests/typecheck/should_fail/all.T
- testsuite/tests/unboxedsums/all.T
- + testsuite/tests/unboxedsums/unboxedsums4p.hs
- + testsuite/tests/unboxedsums/unboxedsums4p.stderr
- + testsuite/tests/warnings/should_compile/SpecMultipleTysMono.hs
- + testsuite/tests/warnings/should_compile/SpecMultipleTysMono.stderr
- testsuite/tests/warnings/should_compile/all.T
- utils/check-exact/ExactPrint.hs
- utils/haddock/haddock-api/src/Haddock/Backends/LaTeX.hs
- utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
- utils/haddock/haddock-api/src/Haddock/Convert.hs
- utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs
- utils/haddock/haddock-api/src/Haddock/Types.hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b22799ca3aaf4ead355a668cd95c3f…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b22799ca3aaf4ead355a668cd95c3f…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][master] PmAltConSet: Use Data.Set instead of Data.Map
by Marge Bot (＠marge-bot) 27 Feb '26
by Marge Bot (＠marge-bot) 27 Feb '26
27 Feb '26
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
ae799cab by Simon Jakobi at 2026-02-27T12:53:54-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.
- - - - -
1 changed file:
- compiler/GHC/HsToCore/Pmc/Solver/Types.hs
Changes:
=====================================
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
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ae799cabf9b2dce116b0dc9a747cd68…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ae799cabf9b2dce116b0dc9a747cd68…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][master] Make list comprehension completely non-linear
by Marge Bot (＠marge-bot) 27 Feb '26
by Marge Bot (＠marge-bot) 27 Feb '26
27 Feb '26
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
f108a972 by Arnaud Spiwack at 2026-02-27T12:53:01-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.
- - - - -
5 changed files:
- 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
Changes:
=====================================
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’:
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f108a9722b8ff80d2462fb6835a3944…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f108a9722b8ff80d2462fb6835a3944…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/jeltsch/system-io-uncovering] Remove in-package dependencies on `GHC.Internal.System.IO`
by Wolfgang Jeltsch (＠jeltsch) 27 Feb '26
by Wolfgang Jeltsch (＠jeltsch) 27 Feb '26
27 Feb '26
Wolfgang Jeltsch pushed to branch wip/jeltsch/system-io-uncovering at Glasgow Haskell Compiler / GHC
Commits:
1559b00d by Wolfgang Jeltsch at 2026-02-27T18:19:44+02:00
Remove in-package dependencies on `GHC.Internal.System.IO`
This contribution eliminates all dependencies on
`GHC.Internal.System.IO` from within `ghc-internal`. It comprises the
following changes:
* Make `GHC.Internal.Fingerprint` independent of I/O support
* Tighten the dependencies of `GHC.Internal.Data.Version`
* Tighten the dependencies of `GHC.Internal.TH.Monad`
* Tighten the dependencies of `GHCi.Helpers`
* Move the `* -> *` `Heap.Closure` instances into `ghc-heap`
* Move some code that needs `System.IO` to `template-haskell`
* Move the `GHC.ResponseFile` implementation into `base`
* Move the `System.Exit` implementation into `base`
* Move the `System.IO.OS` implementation into `base`
- - - - -
19 changed files:
- libraries/base/src/GHC/Fingerprint.hs
- libraries/base/src/GHC/ResponseFile.hs
- libraries/base/src/System/Exit.hs
- libraries/base/src/System/IO/OS.hs
- libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
- libraries/ghc-internal/ghc-internal.cabal.in
- libraries/ghc-internal/src/GHC/Internal/Data/Version.hs
- libraries/ghc-internal/src/GHC/Internal/Fingerprint.hs
- libraries/ghc-internal/src/GHC/Internal/GHCi/Helpers.hs
- libraries/ghc-internal/src/GHC/Internal/Heap/Closures.hs
- − libraries/ghc-internal/src/GHC/Internal/ResponseFile.hs
- − libraries/ghc-internal/src/GHC/Internal/System/Exit.hs
- − libraries/ghc-internal/src/GHC/Internal/System/IO/OS.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Monad.hs
- libraries/template-haskell/Language/Haskell/TH/Syntax.hs
- testsuite/tests/interface-stability/ghc-experimental-exports.stdout
- testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32
- testsuite/tests/plugins/plugins10.stdout
- testsuite/tests/typecheck/should_fail/T12921.stderr
Changes:
=====================================
libraries/base/src/GHC/Fingerprint.hs
=====================================
@@ -9,3 +9,45 @@ module GHC.Fingerprint (
) where
import GHC.Internal.Fingerprint
+
+import Data.Function (($))
+import Control.Monad (return, when)
+import Data.Bool (not, (&&))
+import Data.List ((++))
+import Data.Maybe (Maybe (Nothing, Just))
+import Data.Int (Int)
+import Data.Word (Word8)
+import Data.Eq ((/=))
+import Text.Show (show)
+import System.IO
+ (
+ IO,
+ FilePath,
+ IOMode (ReadMode),
+ withBinaryFile,
+ hGetBuf,
+ hIsEOF
+ )
+import Foreign.Ptr (Ptr)
+import GHC.Err (errorWithoutStackTrace)
+
+-- | Computes the hash of a given file.
+-- This function runs in constant memory.
+--
+-- @since base-4.7.0.0
+getFileHash :: FilePath -> IO Fingerprint
+getFileHash path = withBinaryFile path ReadMode $ \ hdl ->
+ let
+ readChunk :: Ptr Word8 -> Int -> IO (Maybe Int)
+ readChunk bufferPtr bufferSize = do
+ chunkSize <- hGetBuf hdl bufferPtr bufferSize
+ isFinished <- hIsEOF hdl
+ when (chunkSize /= bufferSize && not isFinished)
+ (
+ errorWithoutStackTrace $
+ "GHC.Fingerprint.getFileHash: could only read " ++
+ show chunkSize ++
+ " bytes, but more are available"
+ )
+ return (if isFinished then Just chunkSize else Nothing)
+ in fingerprintBufferedStream readChunk
=====================================
libraries/base/src/GHC/ResponseFile.hs
=====================================
@@ -1,3 +1,4 @@
+{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Safe #-}
-- |
@@ -19,4 +20,145 @@ module GHC.ResponseFile (
expandResponse
) where
-import GHC.Internal.ResponseFile
+import Control.Monad (return, (>>=), mapM)
+import Control.Exception (IOException, catch)
+import Data.Function (($), (.))
+import Data.Bool (Bool (False, True), otherwise, not, (||))
+import Data.Char (Char, isSpace)
+import Data.List ((++), map, filter, concat, reverse)
+import Data.String (String, unlines)
+import Data.Functor (fmap)
+import Data.Foldable (null, foldl')
+import Data.Eq ((==))
+import Text.Show (show)
+import System.Environment (getArgs)
+import System.IO (IO, hPutStrLn, readFile, stderr)
+import System.Exit (exitFailure)
+
+{-|
+Like 'getArgs', but can also read arguments supplied via response files.
+
+
+For example, consider a program @foo@:
+
+@
+main :: IO ()
+main = do
+ args <- getArgsWithResponseFiles
+ putStrLn (show args)
+@
+
+
+And a response file @args.txt@:
+
+@
+--one 1
+--\'two\' 2
+--"three" 3
+@
+
+Then the result of invoking @foo@ with @args.txt@ is:
+
+> > ./foo @args.txt
+> ["--one","1","--two","2","--three","3"]
+
+-}
+getArgsWithResponseFiles :: IO [String]
+getArgsWithResponseFiles = getArgs >>= expandResponse
+
+-- | Given a string of concatenated strings, separate each by removing
+-- a layer of /quoting/ and\/or /escaping/ of certain characters.
+--
+-- These characters are: any whitespace, single quote, double quote,
+-- and the backslash character. The backslash character always
+-- escapes (i.e., passes through without further consideration) the
+-- character which follows. Characters can also be escaped in blocks
+-- by quoting (i.e., surrounding the blocks with matching pairs of
+-- either single- or double-quotes which are not themselves escaped).
+--
+-- Any whitespace which appears outside of either of the quoting and
+-- escaping mechanisms, is interpreted as having been added by this
+-- special concatenation process to designate where the boundaries
+-- are between the original, un-concatenated list of strings. These
+-- added whitespace characters are removed from the output.
+--
+-- > unescapeArgs "hello\\ \\\"world\\\"\n" == ["hello \"world\""]
+unescapeArgs :: String -> [String]
+unescapeArgs = filter (not . null) . unescape
+
+-- | Given a list of strings, concatenate them into a single string
+-- with escaping of certain characters, and the addition of a newline
+-- between each string. The escaping is done by adding a single
+-- backslash character before any whitespace, single quote, double
+-- quote, or backslash character, so this escaping character must be
+-- removed. Unescaped whitespace (in this case, newline) is part
+-- of this "transport" format to indicate the end of the previous
+-- string and the start of a new string.
+--
+-- While 'unescapeArgs' allows using quoting (i.e., convenient
+-- escaping of many characters) by having matching sets of single- or
+-- double-quotes,'escapeArgs' does not use the quoting mechanism,
+-- and thus will always escape any whitespace, quotes, and
+-- backslashes.
+--
+-- > escapeArgs ["hello \"world\""] == "hello\\ \\\"world\\\"\n"
+escapeArgs :: [String] -> String
+escapeArgs = unlines . map escapeArg
+
+-- | Arguments which look like @\@foo@ will be replaced with the
+-- contents of file @foo@. A gcc-like syntax for response files arguments
+-- is expected. This must re-constitute the argument list by doing an
+-- inverse of the escaping mechanism done by the calling-program side.
+--
+-- We quit if the file is not found or reading somehow fails.
+-- (A convenience routine for haddock or possibly other clients)
+expandResponse :: [String] -> IO [String]
+expandResponse = fmap concat . mapM expand
+ where
+ expand :: String -> IO [String]
+ expand ('@':f) = readFileExc f >>= return . unescapeArgs
+ expand x = return [x]
+
+ readFileExc f =
+ readFile f `catch` \(e :: IOException) -> do
+ hPutStrLn stderr $ "Error while expanding response file: " ++ show e
+ exitFailure
+
+data Quoting = NoneQ | SngQ | DblQ
+
+unescape :: String -> [String]
+unescape args = reverse . map reverse $ go args NoneQ False [] []
+ where
+ -- n.b., the order of these cases matters; these are cribbed from gcc
+ -- case 1: end of input
+ go [] _q _bs a as = a:as
+ -- case 2: back-slash escape in progress
+ go (c:cs) q True a as = go cs q False (c:a) as
+ -- case 3: no back-slash escape in progress, but got a back-slash
+ go (c:cs) q False a as
+ | '\\' == c = go cs q True a as
+ -- case 4: single-quote escaping in progress
+ go (c:cs) SngQ False a as
+ | '\'' == c = go cs NoneQ False a as
+ | otherwise = go cs SngQ False (c:a) as
+ -- case 5: double-quote escaping in progress
+ go (c:cs) DblQ False a as
+ | '"' == c = go cs NoneQ False a as
+ | otherwise = go cs DblQ False (c:a) as
+ -- case 6: no escaping is in progress
+ go (c:cs) NoneQ False a as
+ | isSpace c = go cs NoneQ False [] (a:as)
+ | '\'' == c = go cs SngQ False a as
+ | '"' == c = go cs DblQ False a as
+ | otherwise = go cs NoneQ False (c:a) as
+
+escapeArg :: String -> String
+escapeArg = reverse . foldl' escape []
+
+escape :: String -> Char -> String
+escape cs c
+ | isSpace c
+ || '\\' == c
+ || '\'' == c
+ || '"' == c = c:'\\':cs -- n.b., our caller must reverse the result
+ | otherwise = c:cs
=====================================
libraries/base/src/System/Exit.hs
=====================================
@@ -21,4 +21,67 @@ module System.Exit
die
) where
-import GHC.Internal.System.Exit
\ No newline at end of file
+import GHC.IO.Exception
+ (
+ IOErrorType (InvalidArgument),
+ IOException (IOError),
+ ExitCode (ExitSuccess, ExitFailure)
+ )
+import Control.Monad ((>>))
+import Control.Exception (throwIO, ioError)
+import Data.Bool (otherwise)
+import Data.Maybe (Maybe (Nothing))
+import Data.String (String)
+import Data.Eq ((/=))
+import System.IO (IO, hPutStrLn, stderr)
+
+-- ---------------------------------------------------------------------------
+-- exitWith
+
+-- | Computation 'exitWith' @code@ throws 'ExitCode' @code@.
+-- Normally this terminates the program, returning @code@ to the
+-- program's caller.
+--
+-- On program termination, the standard 'Handle's 'stdout' and
+-- 'stderr' are flushed automatically; any other buffered 'Handle's
+-- need to be flushed manually, otherwise the buffered data will be
+-- discarded.
+--
+-- A program that fails in any other way is treated as if it had
+-- called 'exitFailure'.
+-- A program that terminates successfully without calling 'exitWith'
+-- explicitly is treated as if it had called 'exitWith' 'ExitSuccess'.
+--
+-- As an 'ExitCode' is an 'Control.Exception.Exception', it can be
+-- caught using the functions of "Control.Exception". This means that
+-- cleanup computations added with 'GHC.Internal.Control.Exception.bracket' (from
+-- "Control.Exception") are also executed properly on 'exitWith'.
+--
+-- Note: in GHC, 'exitWith' should be called from the main program
+-- thread in order to exit the process. When called from another
+-- thread, 'exitWith' will throw an 'ExitCode' as normal, but the
+-- exception will not cause the process itself to exit.
+--
+exitWith :: ExitCode -> IO a
+exitWith ExitSuccess = throwIO ExitSuccess
+exitWith code@(ExitFailure n)
+ | n /= 0 = throwIO code
+ | otherwise = ioError (IOError Nothing InvalidArgument "exitWith" "ExitFailure 0" Nothing Nothing)
+
+-- | The computation 'exitFailure' is equivalent to
+-- 'exitWith' @(@'ExitFailure' /exitfail/@)@,
+-- where /exitfail/ is implementation-dependent.
+exitFailure :: IO a
+exitFailure = exitWith (ExitFailure 1)
+
+-- | The computation 'exitSuccess' is equivalent to
+-- 'exitWith' 'ExitSuccess', It terminates the program
+-- successfully.
+exitSuccess :: IO a
+exitSuccess = exitWith ExitSuccess
+
+-- | Write given error message to `stderr` and terminate with `exitFailure`.
+--
+-- @since base-4.8.0.0
+die :: String -> IO a
+die err = hPutStrLn stderr err >> exitFailure
=====================================
libraries/base/src/System/IO/OS.hs
=====================================
@@ -1,4 +1,6 @@
{-# LANGUAGE Safe #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE RankNTypes #-}
{-|
This module bridges between Haskell handles and underlying operating-system
@@ -21,17 +23,293 @@ module System.IO.OS
)
where
-import GHC.Internal.System.IO.OS
+import Control.Monad (return)
+import Control.Concurrent.MVar (MVar)
+import Control.Exception (mask)
+import Data.Function (const, (.), ($))
+import Data.Functor (fmap)
+import Data.Maybe (Maybe (Nothing), maybe)
+#if defined(mingw32_HOST_OS)
+import Data.Bool (otherwise)
+import Data.Maybe (Maybe (Just))
+#endif
+import Data.List ((++))
+import Data.String (String)
+import Data.Typeable (Typeable, cast)
+import System.IO (IO)
+import GHC.IO.FD (fdFD)
+#if defined(mingw32_HOST_OS)
+import GHC.IO.Windows.Handle
(
- withFileDescriptorReadingBiased,
- withFileDescriptorWritingBiased,
- withWindowsHandleReadingBiased,
- withWindowsHandleWritingBiased,
- withFileDescriptorReadingBiasedRaw,
- withFileDescriptorWritingBiasedRaw,
- withWindowsHandleReadingBiasedRaw,
- withWindowsHandleWritingBiasedRaw
+ NativeHandle,
+ ConsoleHandle,
+ IoHandle,
+ toHANDLE
)
+#endif
+import GHC.IO.Handle.Types
+ (
+ Handle (FileHandle, DuplexHandle),
+ Handle__ (Handle__, haDevice)
+ )
+import GHC.IO.Handle.Internals (withHandle_', flushBuffer)
+import GHC.IO.Exception
+ (
+ IOErrorType (InappropriateType),
+ IOException (IOError),
+ ioException
+ )
+import Foreign.Ptr (Ptr)
+import Foreign.C.Types (CInt)
+
+-- * Obtaining POSIX file descriptors and Windows handles
+
+{-|
+ Executes a user-provided action on an operating-system handle that underlies
+ a Haskell handle. Before the user-provided action is run, user-defined
+ preparation based on the handle state that contains the operating-system
+ handle is performed. While the user-provided action is executed, further
+ operations on the Haskell handle are blocked to a degree that interference
+ with this action is prevented.
+
+ See [below](#with-ref-caveats) for caveats regarding this operation.
+-}
+withOSHandle :: String
+ -- ^ The name of the overall operation
+ -> (Handle -> MVar Handle__)
+ {-^
+ Obtaining of the handle state variable that holds the
+ operating-system handle
+ -}
+ -> (forall d. Typeable d => d -> IO a)
+ -- ^ Conversion of a device into an operating-system handle
+ -> (Handle__ -> IO ())
+ -- ^ The preparation
+ -> Handle
+ -- ^ The Haskell handle to use
+ -> (a -> IO r)
+ -- ^ The action to execute on the operating-system handle
+ -> IO r
+withOSHandle opName handleStateVar getOSHandle prepare handle act
+ = mask $ \ withOriginalMaskingState ->
+ withHandleState $ \ handleState@Handle__ {haDevice = dev} -> do
+ osHandle <- getOSHandle dev
+ prepare handleState
+ withOriginalMaskingState $ act osHandle
+ where
+
+ withHandleState = withHandle_' opName handle (handleStateVar handle)
+{-
+ The 'withHandle_'' operation, which we use here, already performs masking.
+ Still, we have to employ 'mask', in order do obtain the operation that
+ restores the original masking state. The user-provided action should be
+ executed with this original masking state, as there is no inherent reason to
+ generally perform it with masking in place. The masking that 'withHandle_''
+ performs is only for safely accessing handle state and thus constitutes an
+ implementation detail; it has nothing to do with the user-provided action.
+-}
+{-
+ The order of actions in 'withOSHandle' is such that any exception from
+ 'getOSHandle' is thrown before the user-defined preparation is performed.
+-}
+
+{-|
+ Obtains the handle state variable that underlies a handle or specifically
+ the handle state variable for reading if the handle uses different state
+ variables for reading and writing.
+-}
+handleStateVarReadingBiased :: Handle -> MVar Handle__
+handleStateVarReadingBiased (FileHandle _ var) = var
+handleStateVarReadingBiased (DuplexHandle _ readingVar _) = readingVar
+
+{-|
+ Obtains the handle state variable that underlies a handle or specifically
+ the handle state variable for writing if the handle uses different state
+ variables for reading and writing.
+-}
+handleStateVarWritingBiased :: Handle -> MVar Handle__
+handleStateVarWritingBiased (FileHandle _ var) = var
+handleStateVarWritingBiased (DuplexHandle _ _ writingVar) = writingVar
+
+{-|
+ Yields the result of another operation if that operation succeeded, and
+ otherwise throws an exception that signals that the other operation failed
+ because some Haskell handle does not use an operating-system handle of a
+ required type.
+-}
+requiringOSHandleOfType :: String
+ -- ^ The name of the operating-system handle type
+ -> Maybe a
+ {-^
+ The result of the other operation if it succeeded
+ -}
+ -> IO a
+requiringOSHandleOfType osHandleTypeName
+ = maybe (ioException osHandleOfTypeRequired) return
+ where
+
+ osHandleOfTypeRequired :: IOException
+ osHandleOfTypeRequired
+ = IOError Nothing
+ InappropriateType
+ ""
+ ("handle does not use " ++ osHandleTypeName ++ "s")
+ Nothing
+ Nothing
+
+{-|
+ Obtains the POSIX file descriptor of a device if the device contains one,
+ and throws an exception otherwise.
+-}
+getFileDescriptor :: Typeable d => d -> IO CInt
+getFileDescriptor = requiringOSHandleOfType "POSIX file descriptor" .
+ fmap fdFD . cast
+
+{-|
+ Obtains the Windows handle of a device if the device contains one, and
+ throws an exception otherwise.
+-}
+getWindowsHandle :: Typeable d => d -> IO (Ptr ())
+getWindowsHandle = requiringOSHandleOfType "Windows handle" .
+ toMaybeWindowsHandle
+ where
+
+ toMaybeWindowsHandle :: Typeable d => d -> Maybe (Ptr ())
+#if defined(mingw32_HOST_OS)
+ toMaybeWindowsHandle dev
+ | Just nativeHandle <- cast dev :: Maybe (IoHandle NativeHandle)
+ = Just (toHANDLE nativeHandle)
+ | Just consoleHandle <- cast dev :: Maybe (IoHandle ConsoleHandle)
+ = Just (toHANDLE consoleHandle)
+ | otherwise
+ = Nothing
+ {-
+ This is inspired by the implementation of
+ 'System.Win32.Types.withHandleToHANDLENative'.
+ -}
+#else
+ toMaybeWindowsHandle _ = Nothing
+#endif
+
+{-|
+ Executes a user-provided action on the POSIX file descriptor that underlies
+ a handle or specifically on the POSIX file descriptor for reading if the
+ handle uses different file descriptors for reading and writing. The
+ Haskell-managed buffers related to the file descriptor are flushed before
+ the user-provided action is run. While this action is executed, further
+ operations on the handle are blocked to a degree that interference with this
+ action is prevented.
+
+ If the handle does not use POSIX file descriptors, an exception is thrown.
+
+ See [below](#with-ref-caveats) for caveats regarding this operation.
+-}
+withFileDescriptorReadingBiased :: Handle -> (CInt -> IO r) -> IO r
+withFileDescriptorReadingBiased = withOSHandle "withFileDescriptorReadingBiased"
+ handleStateVarReadingBiased
+ getFileDescriptor
+ flushBuffer
+
+{-|
+ Executes a user-provided action on the POSIX file descriptor that underlies
+ a handle or specifically on the POSIX file descriptor for writing if the
+ handle uses different file descriptors for reading and writing. The
+ Haskell-managed buffers related to the file descriptor are flushed before
+ the user-provided action is run. While this action is executed, further
+ operations on the handle are blocked to a degree that interference with this
+ action is prevented.
+
+ If the handle does not use POSIX file descriptors, an exception is thrown.
+
+ See [below](#with-ref-caveats) for caveats regarding this operation.
+-}
+withFileDescriptorWritingBiased :: Handle -> (CInt -> IO r) -> IO r
+withFileDescriptorWritingBiased = withOSHandle "withFileDescriptorWritingBiased"
+ handleStateVarWritingBiased
+ getFileDescriptor
+ flushBuffer
+
+{-|
+ Executes a user-provided action on the Windows handle that underlies a
+ Haskell handle or specifically on the Windows handle for reading if the
+ Haskell handle uses different Windows handles for reading and writing. The
+ Haskell-managed buffers related to the Windows handle are flushed before the
+ user-provided action is run. While this action is executed, further
+ operations on the Haskell handle are blocked to a degree that interference
+ with this action is prevented.
+
+ If the Haskell handle does not use Windows handles, an exception is thrown.
+
+ See [below](#with-ref-caveats) for caveats regarding this operation.
+-}
+withWindowsHandleReadingBiased :: Handle -> (Ptr () -> IO r) -> IO r
+withWindowsHandleReadingBiased = withOSHandle "withWindowsHandleReadingBiased"
+ handleStateVarReadingBiased
+ getWindowsHandle
+ flushBuffer
+
+{-|
+ Executes a user-provided action on the Windows handle that underlies a
+ Haskell handle or specifically on the Windows handle for writing if the
+ Haskell handle uses different Windows handles for reading and writing. The
+ Haskell-managed buffers related to the Windows handle are flushed before the
+ user-provided action is run. While this action is executed, further
+ operations on the Haskell handle are blocked to a degree that interference
+ with this action is prevented.
+
+ If the Haskell handle does not use Windows handles, an exception is thrown.
+
+ See [below](#with-ref-caveats) for caveats regarding this operation.
+-}
+withWindowsHandleWritingBiased :: Handle -> (Ptr () -> IO r) -> IO r
+withWindowsHandleWritingBiased = withOSHandle "withWindowsHandleWritingBiased"
+ handleStateVarWritingBiased
+ getWindowsHandle
+ flushBuffer
+
+{-|
+ Like 'withFileDescriptorReadingBiased' except that Haskell-managed buffers
+ are not flushed.
+-}
+withFileDescriptorReadingBiasedRaw :: Handle -> (CInt -> IO r) -> IO r
+withFileDescriptorReadingBiasedRaw
+ = withOSHandle "withFileDescriptorReadingBiasedRaw"
+ handleStateVarReadingBiased
+ getFileDescriptor
+ (const $ return ())
+
+{-|
+ Like 'withFileDescriptorWritingBiased' except that Haskell-managed buffers
+ are not flushed.
+-}
+withFileDescriptorWritingBiasedRaw :: Handle -> (CInt -> IO r) -> IO r
+withFileDescriptorWritingBiasedRaw
+ = withOSHandle "withFileDescriptorWritingBiasedRaw"
+ handleStateVarWritingBiased
+ getFileDescriptor
+ (const $ return ())
+
+{-|
+ Like 'withWindowsHandleReadingBiased' except that Haskell-managed buffers
+ are not flushed.
+-}
+withWindowsHandleReadingBiasedRaw :: Handle -> (Ptr () -> IO r) -> IO r
+withWindowsHandleReadingBiasedRaw
+ = withOSHandle "withWindowsHandleReadingBiasedRaw"
+ handleStateVarReadingBiased
+ getWindowsHandle
+ (const $ return ())
+
+{-|
+ Like 'withWindowsHandleWritingBiased' except that Haskell-managed buffers
+ are not flushed.
+-}
+withWindowsHandleWritingBiasedRaw :: Handle -> (Ptr () -> IO r) -> IO r
+withWindowsHandleWritingBiasedRaw
+ = withOSHandle "withWindowsHandleWritingBiasedRaw"
+ handleStateVarWritingBiased
+ getWindowsHandle
+ (const $ return ())
-- ** Caveats
=====================================
libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
=====================================
@@ -1,10 +1,5 @@
{-# LANGUAGE CPP #-}
-{-# LANGUAGE ForeignFunctionInterface #-}
-{-# LANGUAGE GHCForeignImportPrim #-}
-{-# LANGUAGE MagicHash #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE UnliftedFFITypes #-}
-{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DeriveTraversable #-}
-- Late cost centres introduce a thunk in the asBox function, which leads to
-- an additional wrapper being added to any value placed inside a box.
@@ -42,3 +37,23 @@ module GHC.Exts.Heap.Closures (
) where
import GHC.Internal.Heap.Closures
+
+import GHC.Internal.Data.Functor
+import GHC.Internal.Data.Foldable
+import GHC.Internal.Data.Traversable
+
+deriving instance Functor GenClosure
+deriving instance Foldable GenClosure
+deriving instance Traversable GenClosure
+
+deriving instance Functor GenStgStackClosure
+deriving instance Foldable GenStgStackClosure
+deriving instance Traversable GenStgStackClosure
+
+deriving instance Functor GenStackField
+deriving instance Foldable GenStackField
+deriving instance Traversable GenStackField
+
+deriving instance Functor GenStackFrame
+deriving instance Foldable GenStackFrame
+deriving instance Traversable GenStackFrame
=====================================
libraries/ghc-internal/ghc-internal.cabal.in
=====================================
@@ -284,7 +284,6 @@ Library
GHC.Internal.Read
GHC.Internal.Real
GHC.Internal.Records
- GHC.Internal.ResponseFile
GHC.Internal.RTS.Flags
GHC.Internal.RTS.Flags.Test
GHC.Internal.ST
@@ -323,10 +322,8 @@ Library
GHC.Internal.Numeric.Natural
GHC.Internal.System.Environment
GHC.Internal.System.Environment.Blank
- GHC.Internal.System.Exit
GHC.Internal.System.IO
GHC.Internal.System.IO.Error
- GHC.Internal.System.IO.OS
GHC.Internal.System.Mem
GHC.Internal.System.Mem.StableName
GHC.Internal.System.Posix.Internals
=====================================
libraries/ghc-internal/src/GHC/Internal/Data/Version.hs
=====================================
@@ -41,8 +41,7 @@ import GHC.Internal.Data.Eq
import GHC.Internal.Int ( Int )
import GHC.Internal.Data.List ( map, sort, concat, concatMap, intersperse, (++) )
import GHC.Internal.Data.Ord
-import GHC.Internal.Data.String ( String )
-import GHC.Internal.Base ( Applicative(..), (&&) )
+import GHC.Internal.Base ( Applicative(..), (&&), String )
import GHC.Internal.Generics
import GHC.Internal.Unicode ( isDigit, isAlphaNum )
import GHC.Internal.Read
=====================================
libraries/ghc-internal/src/GHC/Internal/Fingerprint.hs
=====================================
@@ -16,23 +16,22 @@ module GHC.Internal.Fingerprint (
fingerprintData,
fingerprintString,
fingerprintFingerprints,
- getFileHash
+ fingerprintBufferedStream
) where
import GHC.Internal.IO
import GHC.Internal.Base
import GHC.Internal.Bits
import GHC.Internal.Num
+import GHC.Internal.Data.Maybe
import GHC.Internal.List
import GHC.Internal.Real
import GHC.Internal.Word
-import GHC.Internal.Show
import GHC.Internal.Ptr
import GHC.Internal.Foreign.C.Types
import GHC.Internal.Foreign.Marshal.Alloc
import GHC.Internal.Foreign.Marshal.Array
import GHC.Internal.Foreign.Storable
-import GHC.Internal.System.IO
import GHC.Internal.Fingerprint.Type
@@ -71,41 +70,27 @@ fingerprintString str = unsafeDupablePerformIO $
fromIntegral (w32 `shiftR` 8),
fromIntegral w32]
--- | Computes the hash of a given file.
--- This function loops over the handle, running in constant memory.
---
--- @since base-4.7.0.0
-getFileHash :: FilePath -> IO Fingerprint
-getFileHash path = withBinaryFile path ReadMode $ \h ->
+-- | Reads data in chunks and computes its hash.
+-- This function runs in constant memory.
+fingerprintBufferedStream :: (Ptr Word8 -> Int -> IO (Maybe Int))
+ -> IO Fingerprint
+fingerprintBufferedStream readChunk =
allocaBytes SIZEOF_STRUCT_MD5CONTEXT $ \pctxt -> do
c_MD5Init pctxt
-
- processChunks h (\buf size -> c_MD5Update pctxt buf (fromIntegral size))
-
+ allocaBytes _BUFSIZE $ \arrPtr ->
+ let loop = do
+ maybeRemainderSize <- readChunk arrPtr _BUFSIZE
+ c_MD5Update pctxt
+ arrPtr
+ (fromIntegral (fromMaybe _BUFSIZE maybeRemainderSize))
+ when (isNothing maybeRemainderSize) loop
+ in loop
allocaBytes 16 $ \pdigest -> do
c_MD5Final pdigest pctxt
peek (castPtr pdigest :: Ptr Fingerprint)
-
where
_BUFSIZE = 4096
- -- Loop over _BUFSIZE sized chunks read from the handle,
- -- passing the callback a block of bytes and its size.
- processChunks :: Handle -> (Ptr Word8 -> Int -> IO ()) -> IO ()
- processChunks h f = allocaBytes _BUFSIZE $ \arrPtr ->
-
- let loop = do
- count <- hGetBuf h arrPtr _BUFSIZE
- eof <- hIsEOF h
- when (count /= _BUFSIZE && not eof) $ errorWithoutStackTrace $
- "GHC.Internal.Fingerprint.getFileHash: only read " ++ show count ++ " bytes"
-
- f arrPtr count
-
- when (not eof) loop
-
- in loop
-
data MD5Context
foreign import ccall unsafe "__hsbase_MD5Init"
=====================================
libraries/ghc-internal/src/GHC/Internal/GHCi/Helpers.hs
=====================================
@@ -24,9 +24,10 @@ module GHC.Internal.GHCi.Helpers
, evalWrapper
) where
-import GHC.Internal.Base
-import GHC.Internal.System.IO
-import GHC.Internal.System.Environment
+import GHC.Internal.Base (String, IO)
+import GHC.Internal.IO.Handle (BufferMode (NoBuffering), hSetBuffering, hFlush)
+import GHC.Internal.IO.StdHandles (stdin, stdout, stderr)
+import GHC.Internal.System.Environment (withProgName, withArgs)
disableBuffering :: IO ()
disableBuffering = do
=====================================
libraries/ghc-internal/src/GHC/Internal/Heap/Closures.hs
=====================================
@@ -5,7 +5,6 @@
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE UnliftedFFITypes #-}
{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveTraversable #-}
-- Late cost centres introduce a thunk in the asBox function, which leads to
-- an additional wrapper being added to any value placed inside a box.
-- This can be removed once our boot compiler is no longer affected by #25212
@@ -69,8 +68,7 @@ in the profiling way. (#15197)
import GHC.Internal.Heap.ProfInfo.Types
import GHC.Internal.Data.Bits
-import GHC.Internal.Data.Foldable (Foldable, toList)
-import GHC.Internal.Data.Traversable (Traversable)
+import GHC.Internal.Data.Foldable (toList)
import GHC.Internal.Int
import GHC.Internal.Num
import GHC.Internal.Real
@@ -383,7 +381,7 @@ data GenClosure b
-- or an Int#).
| UnknownTypeWordSizedPrimitive
{ wordVal :: !Word }
- deriving (Show, Generic, Functor, Foldable, Traversable)
+ deriving (Show, Generic)
-- | Get the info table for a heap closure, or Nothing for a prim value
--
@@ -500,7 +498,7 @@ data GenStgStackClosure b = GenStgStackClosure
, ssc_stack_size :: !Word32 -- ^ stack size in *words*
, ssc_stack :: ![GenStackFrame b]
}
- deriving (Foldable, Functor, Generic, Show, Traversable)
+ deriving (Generic, Show)
type StackField = GenStackField Box
@@ -510,7 +508,7 @@ data GenStackField b
= StackWord !Word
-- | A pointer field
| StackBox !b
- deriving (Foldable, Functor, Generic, Show, Traversable)
+ deriving (Generic, Show)
type StackFrame = GenStackFrame Box
@@ -579,7 +577,7 @@ data GenStackFrame b =
{ info_tbl :: !StgInfoTable
, annotation :: !b
}
- deriving (Foldable, Functor, Generic, Show, Traversable)
+ deriving (Generic, Show)
data PrimType
= PInt
=====================================
libraries/ghc-internal/src/GHC/Internal/ResponseFile.hs deleted
=====================================
@@ -1,163 +0,0 @@
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE Trustworthy #-}
-
------------------------------------------------------------------------------
--- |
--- Module : GHC.Internal.ResponseFile
--- License : BSD-style (see the file LICENSE)
---
--- Maintainer : libraries(a)haskell.org
--- Stability : internal
--- Portability : portable
---
--- GCC style response files.
---
--- @since base-4.12.0.0
-----------------------------------------------------------------------------
-
--- Migrated from Haddock.
-
-module GHC.Internal.ResponseFile (
- getArgsWithResponseFiles,
- unescapeArgs,
- escapeArgs, escapeArg,
- expandResponse
- ) where
-
-import GHC.Internal.Control.Exception
-import GHC.Internal.Data.Foldable (Foldable(..))
-import GHC.Internal.Base
-import GHC.Internal.Unicode (isSpace)
-import GHC.Internal.Data.List (filter, unlines, concat, reverse)
-import GHC.Internal.Text.Show (show)
-import GHC.Internal.System.Environment (getArgs)
-import GHC.Internal.System.Exit (exitFailure)
-import GHC.Internal.System.IO
-
-{-|
-Like 'getArgs', but can also read arguments supplied via response files.
-
-
-For example, consider a program @foo@:
-
-@
-main :: IO ()
-main = do
- args <- getArgsWithResponseFiles
- putStrLn (show args)
-@
-
-
-And a response file @args.txt@:
-
-@
---one 1
---\'two\' 2
---"three" 3
-@
-
-Then the result of invoking @foo@ with @args.txt@ is:
-
-> > ./foo @args.txt
-> ["--one","1","--two","2","--three","3"]
-
--}
-getArgsWithResponseFiles :: IO [String]
-getArgsWithResponseFiles = getArgs >>= expandResponse
-
--- | Given a string of concatenated strings, separate each by removing
--- a layer of /quoting/ and\/or /escaping/ of certain characters.
---
--- These characters are: any whitespace, single quote, double quote,
--- and the backslash character. The backslash character always
--- escapes (i.e., passes through without further consideration) the
--- character which follows. Characters can also be escaped in blocks
--- by quoting (i.e., surrounding the blocks with matching pairs of
--- either single- or double-quotes which are not themselves escaped).
---
--- Any whitespace which appears outside of either of the quoting and
--- escaping mechanisms, is interpreted as having been added by this
--- special concatenation process to designate where the boundaries
--- are between the original, un-concatenated list of strings. These
--- added whitespace characters are removed from the output.
---
--- > unescapeArgs "hello\\ \\\"world\\\"\n" == ["hello \"world\""]
-unescapeArgs :: String -> [String]
-unescapeArgs = filter (not . null) . unescape
-
--- | Given a list of strings, concatenate them into a single string
--- with escaping of certain characters, and the addition of a newline
--- between each string. The escaping is done by adding a single
--- backslash character before any whitespace, single quote, double
--- quote, or backslash character, so this escaping character must be
--- removed. Unescaped whitespace (in this case, newline) is part
--- of this "transport" format to indicate the end of the previous
--- string and the start of a new string.
---
--- While 'unescapeArgs' allows using quoting (i.e., convenient
--- escaping of many characters) by having matching sets of single- or
--- double-quotes,'escapeArgs' does not use the quoting mechanism,
--- and thus will always escape any whitespace, quotes, and
--- backslashes.
---
--- > escapeArgs ["hello \"world\""] == "hello\\ \\\"world\\\"\n"
-escapeArgs :: [String] -> String
-escapeArgs = unlines . map escapeArg
-
--- | Arguments which look like @\@foo@ will be replaced with the
--- contents of file @foo@. A gcc-like syntax for response files arguments
--- is expected. This must re-constitute the argument list by doing an
--- inverse of the escaping mechanism done by the calling-program side.
---
--- We quit if the file is not found or reading somehow fails.
--- (A convenience routine for haddock or possibly other clients)
-expandResponse :: [String] -> IO [String]
-expandResponse = fmap concat . mapM expand
- where
- expand :: String -> IO [String]
- expand ('@':f) = readFileExc f >>= return . unescapeArgs
- expand x = return [x]
-
- readFileExc f =
- readFile f `catch` \(e :: IOException) -> do
- hPutStrLn stderr $ "Error while expanding response file: " ++ show e
- exitFailure
-
-data Quoting = NoneQ | SngQ | DblQ
-
-unescape :: String -> [String]
-unescape args = reverse . map reverse $ go args NoneQ False [] []
- where
- -- n.b., the order of these cases matters; these are cribbed from gcc
- -- case 1: end of input
- go [] _q _bs a as = a:as
- -- case 2: back-slash escape in progress
- go (c:cs) q True a as = go cs q False (c:a) as
- -- case 3: no back-slash escape in progress, but got a back-slash
- go (c:cs) q False a as
- | '\\' == c = go cs q True a as
- -- case 4: single-quote escaping in progress
- go (c:cs) SngQ False a as
- | '\'' == c = go cs NoneQ False a as
- | otherwise = go cs SngQ False (c:a) as
- -- case 5: double-quote escaping in progress
- go (c:cs) DblQ False a as
- | '"' == c = go cs NoneQ False a as
- | otherwise = go cs DblQ False (c:a) as
- -- case 6: no escaping is in progress
- go (c:cs) NoneQ False a as
- | isSpace c = go cs NoneQ False [] (a:as)
- | '\'' == c = go cs SngQ False a as
- | '"' == c = go cs DblQ False a as
- | otherwise = go cs NoneQ False (c:a) as
-
-escapeArg :: String -> String
-escapeArg = reverse . foldl' escape []
-
-escape :: String -> Char -> String
-escape cs c
- | isSpace c
- || '\\' == c
- || '\'' == c
- || '"' == c = c:'\\':cs -- n.b., our caller must reverse the result
- | otherwise = c:cs
=====================================
libraries/ghc-internal/src/GHC/Internal/System/Exit.hs deleted
=====================================
@@ -1,81 +0,0 @@
-{-# LANGUAGE Trustworthy #-}
-
------------------------------------------------------------------------------
--- |
--- Module : GHC.Internal.System.Exit
--- Copyright : (c) The University of Glasgow 2001
--- License : BSD-style (see the file libraries/base/LICENSE)
---
--- Maintainer : libraries(a)haskell.org
--- Stability : provisional
--- Portability : portable
---
--- Exiting the program.
---
------------------------------------------------------------------------------
-
-module GHC.Internal.System.Exit
- (
- ExitCode(ExitSuccess,ExitFailure)
- , exitWith
- , exitFailure
- , exitSuccess
- , die
- ) where
-
-import GHC.Internal.System.IO
-
-import GHC.Internal.Base
-import GHC.Internal.IO
-import GHC.Internal.IO.Exception
-
--- ---------------------------------------------------------------------------
--- exitWith
-
--- | Computation 'exitWith' @code@ throws 'ExitCode' @code@.
--- Normally this terminates the program, returning @code@ to the
--- program's caller.
---
--- On program termination, the standard 'Handle's 'stdout' and
--- 'stderr' are flushed automatically; any other buffered 'Handle's
--- need to be flushed manually, otherwise the buffered data will be
--- discarded.
---
--- A program that fails in any other way is treated as if it had
--- called 'exitFailure'.
--- A program that terminates successfully without calling 'exitWith'
--- explicitly is treated as if it had called 'exitWith' 'ExitSuccess'.
---
--- As an 'ExitCode' is an 'Control.Exception.Exception', it can be
--- caught using the functions of "Control.Exception". This means that
--- cleanup computations added with 'GHC.Internal.Control.Exception.bracket' (from
--- "Control.Exception") are also executed properly on 'exitWith'.
---
--- Note: in GHC, 'exitWith' should be called from the main program
--- thread in order to exit the process. When called from another
--- thread, 'exitWith' will throw an 'ExitCode' as normal, but the
--- exception will not cause the process itself to exit.
---
-exitWith :: ExitCode -> IO a
-exitWith ExitSuccess = throwIO ExitSuccess
-exitWith code@(ExitFailure n)
- | n /= 0 = throwIO code
- | otherwise = ioError (IOError Nothing InvalidArgument "exitWith" "ExitFailure 0" Nothing Nothing)
-
--- | The computation 'exitFailure' is equivalent to
--- 'exitWith' @(@'ExitFailure' /exitfail/@)@,
--- where /exitfail/ is implementation-dependent.
-exitFailure :: IO a
-exitFailure = exitWith (ExitFailure 1)
-
--- | The computation 'exitSuccess' is equivalent to
--- 'exitWith' 'ExitSuccess', It terminates the program
--- successfully.
-exitSuccess :: IO a
-exitSuccess = exitWith ExitSuccess
-
--- | Write given error message to `stderr` and terminate with `exitFailure`.
---
--- @since base-4.8.0.0
-die :: String -> IO a
-die err = hPutStrLn stderr err >> exitFailure
=====================================
libraries/ghc-internal/src/GHC/Internal/System/IO/OS.hs deleted
=====================================
@@ -1,323 +0,0 @@
-{-# LANGUAGE Trustworthy #-}
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE RankNTypes #-}
-
-{-|
- This module bridges between Haskell handles and underlying operating-system
- features.
--}
-module GHC.Internal.System.IO.OS
-(
- -- * Obtaining file descriptors and Windows handles
- withFileDescriptorReadingBiased,
- withFileDescriptorWritingBiased,
- withWindowsHandleReadingBiased,
- withWindowsHandleWritingBiased,
- withFileDescriptorReadingBiasedRaw,
- withFileDescriptorWritingBiasedRaw,
- withWindowsHandleReadingBiasedRaw,
- withWindowsHandleWritingBiasedRaw
-
- -- ** Caveats
- -- $with-ref-caveats
-)
-where
-
-#if defined(mingw32_HOST_OS)
-import GHC.Internal.Base (otherwise)
-#endif
-import GHC.Internal.Control.Monad (return)
-import GHC.Internal.Control.Concurrent.MVar (MVar)
-import GHC.Internal.Control.Exception (mask)
-import GHC.Internal.Data.Function (const, (.), ($))
-import GHC.Internal.Data.Functor (fmap)
-import GHC.Internal.Data.Maybe (Maybe (Nothing), maybe)
-#if defined(mingw32_HOST_OS)
-import GHC.Internal.Data.Maybe (Maybe (Just))
-#endif
-import GHC.Internal.Data.List ((++))
-import GHC.Internal.Data.String (String)
-import GHC.Internal.Data.Typeable (Typeable, cast)
-import GHC.Internal.System.IO (IO)
-import GHC.Internal.IO.FD (fdFD)
-#if defined(mingw32_HOST_OS)
-import GHC.Internal.IO.Windows.Handle
- (
- NativeHandle,
- ConsoleHandle,
- IoHandle,
- toHANDLE
- )
-#endif
-import GHC.Internal.IO.Handle.Types
- (
- Handle (FileHandle, DuplexHandle),
- Handle__ (Handle__, haDevice)
- )
-import GHC.Internal.IO.Handle.Internals (withHandle_', flushBuffer)
-import GHC.Internal.IO.Exception
- (
- IOErrorType (InappropriateType),
- IOException (IOError),
- ioException
- )
-import GHC.Internal.Foreign.Ptr (Ptr)
-import GHC.Internal.Foreign.C.Types (CInt)
-
--- * Obtaining POSIX file descriptors and Windows handles
-
-{-|
- Executes a user-provided action on an operating-system handle that underlies
- a Haskell handle. Before the user-provided action is run, user-defined
- preparation based on the handle state that contains the operating-system
- handle is performed. While the user-provided action is executed, further
- operations on the Haskell handle are blocked to a degree that interference
- with this action is prevented.
-
- See [below](#with-ref-caveats) for caveats regarding this operation.
--}
-withOSHandle :: String
- -- ^ The name of the overall operation
- -> (Handle -> MVar Handle__)
- {-^
- Obtaining of the handle state variable that holds the
- operating-system handle
- -}
- -> (forall d. Typeable d => d -> IO a)
- -- ^ Conversion of a device into an operating-system handle
- -> (Handle__ -> IO ())
- -- ^ The preparation
- -> Handle
- -- ^ The Haskell handle to use
- -> (a -> IO r)
- -- ^ The action to execute on the operating-system handle
- -> IO r
-withOSHandle opName handleStateVar getOSHandle prepare handle act
- = mask $ \ withOriginalMaskingState ->
- withHandleState $ \ handleState@Handle__ {haDevice = dev} -> do
- osHandle <- getOSHandle dev
- prepare handleState
- withOriginalMaskingState $ act osHandle
- where
-
- withHandleState = withHandle_' opName handle (handleStateVar handle)
-{-
- The 'withHandle_'' operation, which we use here, already performs masking.
- Still, we have to employ 'mask', in order do obtain the operation that
- restores the original masking state. The user-provided action should be
- executed with this original masking state, as there is no inherent reason to
- generally perform it with masking in place. The masking that 'withHandle_''
- performs is only for safely accessing handle state and thus constitutes an
- implementation detail; it has nothing to do with the user-provided action.
--}
-{-
- The order of actions in 'withOSHandle' is such that any exception from
- 'getOSHandle' is thrown before the user-defined preparation is performed.
--}
-
-{-|
- Obtains the handle state variable that underlies a handle or specifically
- the handle state variable for reading if the handle uses different state
- variables for reading and writing.
--}
-handleStateVarReadingBiased :: Handle -> MVar Handle__
-handleStateVarReadingBiased (FileHandle _ var) = var
-handleStateVarReadingBiased (DuplexHandle _ readingVar _) = readingVar
-
-{-|
- Obtains the handle state variable that underlies a handle or specifically
- the handle state variable for writing if the handle uses different state
- variables for reading and writing.
--}
-handleStateVarWritingBiased :: Handle -> MVar Handle__
-handleStateVarWritingBiased (FileHandle _ var) = var
-handleStateVarWritingBiased (DuplexHandle _ _ writingVar) = writingVar
-
-{-|
- Yields the result of another operation if that operation succeeded, and
- otherwise throws an exception that signals that the other operation failed
- because some Haskell handle does not use an operating-system handle of a
- required type.
--}
-requiringOSHandleOfType :: String
- -- ^ The name of the operating-system handle type
- -> Maybe a
- {-^
- The result of the other operation if it succeeded
- -}
- -> IO a
-requiringOSHandleOfType osHandleTypeName
- = maybe (ioException osHandleOfTypeRequired) return
- where
-
- osHandleOfTypeRequired :: IOException
- osHandleOfTypeRequired
- = IOError Nothing
- InappropriateType
- ""
- ("handle does not use " ++ osHandleTypeName ++ "s")
- Nothing
- Nothing
-
-{-|
- Obtains the POSIX file descriptor of a device if the device contains one,
- and throws an exception otherwise.
--}
-getFileDescriptor :: Typeable d => d -> IO CInt
-getFileDescriptor = requiringOSHandleOfType "POSIX file descriptor" .
- fmap fdFD . cast
-
-{-|
- Obtains the Windows handle of a device if the device contains one, and
- throws an exception otherwise.
--}
-getWindowsHandle :: Typeable d => d -> IO (Ptr ())
-getWindowsHandle = requiringOSHandleOfType "Windows handle" .
- toMaybeWindowsHandle
- where
-
- toMaybeWindowsHandle :: Typeable d => d -> Maybe (Ptr ())
-#if defined(mingw32_HOST_OS)
- toMaybeWindowsHandle dev
- | Just nativeHandle <- cast dev :: Maybe (IoHandle NativeHandle)
- = Just (toHANDLE nativeHandle)
- | Just consoleHandle <- cast dev :: Maybe (IoHandle ConsoleHandle)
- = Just (toHANDLE consoleHandle)
- | otherwise
- = Nothing
- {-
- This is inspired by the implementation of
- 'System.Win32.Types.withHandleToHANDLENative'.
- -}
-#else
- toMaybeWindowsHandle _ = Nothing
-#endif
-
-{-|
- Executes a user-provided action on the POSIX file descriptor that underlies
- a handle or specifically on the POSIX file descriptor for reading if the
- handle uses different file descriptors for reading and writing. The
- Haskell-managed buffers related to the file descriptor are flushed before
- the user-provided action is run. While this action is executed, further
- operations on the handle are blocked to a degree that interference with this
- action is prevented.
-
- If the handle does not use POSIX file descriptors, an exception is thrown.
-
- See [below](#with-ref-caveats) for caveats regarding this operation.
--}
-withFileDescriptorReadingBiased :: Handle -> (CInt -> IO r) -> IO r
-withFileDescriptorReadingBiased = withOSHandle "withFileDescriptorReadingBiased"
- handleStateVarReadingBiased
- getFileDescriptor
- flushBuffer
-
-{-|
- Executes a user-provided action on the POSIX file descriptor that underlies
- a handle or specifically on the POSIX file descriptor for writing if the
- handle uses different file descriptors for reading and writing. The
- Haskell-managed buffers related to the file descriptor are flushed before
- the user-provided action is run. While this action is executed, further
- operations on the handle are blocked to a degree that interference with this
- action is prevented.
-
- If the handle does not use POSIX file descriptors, an exception is thrown.
-
- See [below](#with-ref-caveats) for caveats regarding this operation.
--}
-withFileDescriptorWritingBiased :: Handle -> (CInt -> IO r) -> IO r
-withFileDescriptorWritingBiased = withOSHandle "withFileDescriptorWritingBiased"
- handleStateVarWritingBiased
- getFileDescriptor
- flushBuffer
-
-{-|
- Executes a user-provided action on the Windows handle that underlies a
- Haskell handle or specifically on the Windows handle for reading if the
- Haskell handle uses different Windows handles for reading and writing. The
- Haskell-managed buffers related to the Windows handle are flushed before the
- user-provided action is run. While this action is executed, further
- operations on the Haskell handle are blocked to a degree that interference
- with this action is prevented.
-
- If the Haskell handle does not use Windows handles, an exception is thrown.
-
- See [below](#with-ref-caveats) for caveats regarding this operation.
--}
-withWindowsHandleReadingBiased :: Handle -> (Ptr () -> IO r) -> IO r
-withWindowsHandleReadingBiased = withOSHandle "withWindowsHandleReadingBiased"
- handleStateVarReadingBiased
- getWindowsHandle
- flushBuffer
-
-{-|
- Executes a user-provided action on the Windows handle that underlies a
- Haskell handle or specifically on the Windows handle for writing if the
- Haskell handle uses different Windows handles for reading and writing. The
- Haskell-managed buffers related to the Windows handle are flushed before the
- user-provided action is run. While this action is executed, further
- operations on the Haskell handle are blocked to a degree that interference
- with this action is prevented.
-
- If the Haskell handle does not use Windows handles, an exception is thrown.
-
- See [below](#with-ref-caveats) for caveats regarding this operation.
--}
-withWindowsHandleWritingBiased :: Handle -> (Ptr () -> IO r) -> IO r
-withWindowsHandleWritingBiased = withOSHandle "withWindowsHandleWritingBiased"
- handleStateVarWritingBiased
- getWindowsHandle
- flushBuffer
-
-{-|
- Like 'withFileDescriptorReadingBiased' except that Haskell-managed buffers
- are not flushed.
--}
-withFileDescriptorReadingBiasedRaw :: Handle -> (CInt -> IO r) -> IO r
-withFileDescriptorReadingBiasedRaw
- = withOSHandle "withFileDescriptorReadingBiasedRaw"
- handleStateVarReadingBiased
- getFileDescriptor
- (const $ return ())
-
-{-|
- Like 'withFileDescriptorWritingBiased' except that Haskell-managed buffers
- are not flushed.
--}
-withFileDescriptorWritingBiasedRaw :: Handle -> (CInt -> IO r) -> IO r
-withFileDescriptorWritingBiasedRaw
- = withOSHandle "withFileDescriptorWritingBiasedRaw"
- handleStateVarWritingBiased
- getFileDescriptor
- (const $ return ())
-
-{-|
- Like 'withWindowsHandleReadingBiased' except that Haskell-managed buffers
- are not flushed.
--}
-withWindowsHandleReadingBiasedRaw :: Handle -> (Ptr () -> IO r) -> IO r
-withWindowsHandleReadingBiasedRaw
- = withOSHandle "withWindowsHandleReadingBiasedRaw"
- handleStateVarReadingBiased
- getWindowsHandle
- (const $ return ())
-
-{-|
- Like 'withWindowsHandleWritingBiased' except that Haskell-managed buffers
- are not flushed.
--}
-withWindowsHandleWritingBiasedRaw :: Handle -> (Ptr () -> IO r) -> IO r
-withWindowsHandleWritingBiasedRaw
- = withOSHandle "withWindowsHandleWritingBiasedRaw"
- handleStateVarWritingBiased
- getWindowsHandle
- (const $ return ())
-
--- ** Caveats
-
-{-$with-ref-caveats
- #with-ref-caveats#This subsection is just a dummy, whose purpose is to serve
- as the target of the hyperlinks above. The real documentation of the caveats
- is in the /Caveats/ subsection in the @base@ module @System.IO.OS@, which
- re-exports the above operations.
--}
=====================================
libraries/ghc-internal/src/GHC/Internal/TH/Monad.hs
=====================================
@@ -26,17 +26,19 @@ module GHC.Internal.TH.Monad
import Prelude
import Data.Data hiding (Fixity(..))
import Data.IORef
-import System.IO.Unsafe ( unsafePerformIO )
+import System.IO.Unsafe (unsafePerformIO)
import Control.Monad.IO.Class (MonadIO (..))
-import System.IO ( hPutStrLn, stderr )
+import System.IO (FilePath, hPutStrLn, stderr)
import qualified Data.Kind as Kind (Type)
-import GHC.Types (TYPE, RuntimeRep(..))
+import GHC.Types (TYPE, RuntimeRep(..))
#else
import GHC.Internal.Base hiding (NonEmpty(..),Type, Module, sequence)
import GHC.Internal.Data.Data hiding (Fixity(..))
import GHC.Internal.Data.Traversable
import GHC.Internal.IORef
-import GHC.Internal.System.IO
+import GHC.Internal.IO (FilePath)
+import GHC.Internal.IO.Handle.Text (hPutStrLn)
+import GHC.Internal.IO.StdHandles (stderr)
import GHC.Internal.Data.Foldable
import GHC.Internal.Data.Typeable
import GHC.Internal.Control.Monad.IO.Class
@@ -819,38 +821,6 @@ addTempFile suffix = Q (qAddTempFile suffix)
addTopDecls :: [Dec] -> Q ()
addTopDecls ds = Q (qAddTopDecls ds)
-
--- | Emit a foreign file which will be compiled and linked to the object for
--- the current module. Currently only languages that can be compiled with
--- the C compiler are supported, and the flags passed as part of -optc will
--- be also applied to the C compiler invocation that will compile them.
---
--- Note that for non-C languages (for example C++) @extern "C"@ directives
--- must be used to get symbols that we can access from Haskell.
---
--- To get better errors, it is recommended to use #line pragmas when
--- emitting C files, e.g.
---
--- > {-# LANGUAGE CPP #-}
--- > ...
--- > addForeignSource LangC $ unlines
--- > [ "#line " ++ show (__LINE__ + 1) ++ " " ++ show __FILE__
--- > , ...
--- > ]
-addForeignSource :: ForeignSrcLang -> String -> Q ()
-addForeignSource lang src = do
- let suffix = case lang of
- LangC -> "c"
- LangCxx -> "cpp"
- LangObjc -> "m"
- LangObjcxx -> "mm"
- LangAsm -> "s"
- LangJs -> "js"
- RawObject -> "a"
- path <- addTempFile suffix
- runIO $ writeFile path src
- addForeignFilePath lang path
-
-- | Same as 'addForeignSource', but expects to receive a path pointing to the
-- foreign file instead of a 'String' of its contents. Consider using this in
-- conjunction with 'addTempFile'.
=====================================
libraries/template-haskell/Language/Haskell/TH/Syntax.hs
=====================================
@@ -209,7 +209,7 @@ import Data.List.NonEmpty (NonEmpty(..))
import GHC.Lexeme ( startsVarSym, startsVarId )
-- This module completely re-exports 'GHC.Boot.TH.Syntax',
--- and exports additionally functions that depend on filepath.
+-- and exports additionally functions that depend on @filepath@ or @System.IO@.
-- |
addForeignFile :: ForeignSrcLang -> String -> Q ()
@@ -218,6 +218,37 @@ addForeignFile = addForeignSource
"Use 'Language.Haskell.TH.Syntax.addForeignSource' instead"
#-} -- deprecated in 8.6
+-- | Emit a foreign file which will be compiled and linked to the object for
+-- the current module. Currently only languages that can be compiled with
+-- the C compiler are supported, and the flags passed as part of -optc will
+-- be also applied to the C compiler invocation that will compile them.
+--
+-- Note that for non-C languages (for example C++) @extern "C"@ directives
+-- must be used to get symbols that we can access from Haskell.
+--
+-- To get better errors, it is recommended to use #line pragmas when
+-- emitting C files, e.g.
+--
+-- > {-# LANGUAGE CPP #-}
+-- > ...
+-- > addForeignSource LangC $ unlines
+-- > [ "#line " ++ show (__LINE__ + 1) ++ " " ++ show __FILE__
+-- > , ...
+-- > ]
+addForeignSource :: ForeignSrcLang -> String -> Q ()
+addForeignSource lang src = do
+ let suffix = case lang of
+ LangC -> "c"
+ LangCxx -> "cpp"
+ LangObjc -> "m"
+ LangObjcxx -> "mm"
+ LangAsm -> "s"
+ LangJs -> "js"
+ RawObject -> "a"
+ path <- addTempFile suffix
+ runIO $ writeFile path src
+ addForeignFilePath lang path
+
-- | The input is a filepath, which if relative is offset by the package root.
makeRelativeToProject :: FilePath -> Q FilePath
makeRelativeToProject fp | isRelative fp = do
=====================================
testsuite/tests/interface-stability/ghc-experimental-exports.stdout
=====================================
@@ -11190,8 +11190,6 @@ instance forall a. GHC.Internal.Classes.Ord (GHC.Internal.Ptr.FunPtr a) -- Defin
instance forall a. GHC.Internal.Classes.Ord (GHC.Internal.Ptr.Ptr a) -- Defined in ‘GHC.Internal.Ptr’
instance forall a. GHC.Internal.Classes.Ord a => GHC.Internal.Classes.Ord (GHC.Internal.Base.NonEmpty a) -- Defined in ‘GHC.Internal.Base’
instance GHC.Internal.Classes.Ord GHC.Internal.Base.Void -- Defined in ‘GHC.Internal.Base’
-instance forall a k (b :: k). GHC.Internal.Data.String.IsString a => GHC.Internal.Data.String.IsString (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.String’
-instance forall a. GHC.Internal.Data.String.IsString a => GHC.Internal.Data.String.IsString (GHC.Internal.Data.Functor.Identity.Identity a) -- Defined in ‘GHC.Internal.Data.String’
instance forall a. (a ~ GHC.Internal.Types.Char) => GHC.Internal.Data.String.IsString [a] -- Defined in ‘GHC.Internal.Data.String’
instance forall a. GHC.Internal.Enum.Bounded a => GHC.Internal.Enum.Bounded (GHC.Internal.Data.Ord.Down a) -- Defined in ‘GHC.Internal.Data.Ord’
instance forall a. (GHC.Internal.Enum.Enum a, GHC.Internal.Enum.Bounded a, GHC.Internal.Classes.Eq a) => GHC.Internal.Enum.Enum (GHC.Internal.Data.Ord.Down a) -- Defined in ‘GHC.Internal.Data.Ord’
=====================================
testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32
=====================================
@@ -11193,8 +11193,6 @@ instance forall a. GHC.Internal.Classes.Ord (GHC.Internal.Ptr.FunPtr a) -- Defin
instance forall a. GHC.Internal.Classes.Ord (GHC.Internal.Ptr.Ptr a) -- Defined in ‘GHC.Internal.Ptr’
instance forall a. GHC.Internal.Classes.Ord a => GHC.Internal.Classes.Ord (GHC.Internal.Base.NonEmpty a) -- Defined in ‘GHC.Internal.Base’
instance GHC.Internal.Classes.Ord GHC.Internal.Base.Void -- Defined in ‘GHC.Internal.Base’
-instance forall a k (b :: k). GHC.Internal.Data.String.IsString a => GHC.Internal.Data.String.IsString (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.String’
-instance forall a. GHC.Internal.Data.String.IsString a => GHC.Internal.Data.String.IsString (GHC.Internal.Data.Functor.Identity.Identity a) -- Defined in ‘GHC.Internal.Data.String’
instance forall a. (a ~ GHC.Internal.Types.Char) => GHC.Internal.Data.String.IsString [a] -- Defined in ‘GHC.Internal.Data.String’
instance forall a. GHC.Internal.Enum.Bounded a => GHC.Internal.Enum.Bounded (GHC.Internal.Data.Ord.Down a) -- Defined in ‘GHC.Internal.Data.Ord’
instance forall a. (GHC.Internal.Enum.Enum a, GHC.Internal.Enum.Bounded a, GHC.Internal.Classes.Eq a) => GHC.Internal.Enum.Enum (GHC.Internal.Data.Ord.Down a) -- Defined in ‘GHC.Internal.Data.Ord’
=====================================
testsuite/tests/plugins/plugins10.stdout
=====================================
@@ -2,6 +2,7 @@ parsePlugin()
interfacePlugin: Prelude
interfacePlugin: Language.Haskell.TH
interfacePlugin: Language.Haskell.TH.Quote
+interfacePlugin: Data.List
interfacePlugin: GHC.Internal.Base
interfacePlugin: GHC.Internal.Data.NonEmpty
interfacePlugin: GHC.Internal.Float
=====================================
testsuite/tests/typecheck/should_fail/T12921.stderr
=====================================
@@ -24,8 +24,6 @@ T12921.hs:4:16: error: [GHC-39999]
Potentially matching instance:
instance (a ~ Char) => GHC.Internal.Data.String.IsString [a]
-- Defined in ‘GHC.Internal.Data.String’
- ...plus two instances involving out-of-scope types
- (use -fprint-potential-instances to see them all)
• In the annotation:
{-# ANN module "HLint: ignore Reduce duplication" #-}
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1559b00d3406e0f227ddd45dcaf92d0…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1559b00d3406e0f227ddd45dcaf92d0…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc] Pushed new branch wip/torsten.schmits/merge-databases-debug-traversal
by Torsten Schmits (＠torsten.schmits) 27 Feb '26
by Torsten Schmits (＠torsten.schmits) 27 Feb '26
27 Feb '26
Torsten Schmits pushed new branch wip/torsten.schmits/merge-databases-debug-traversal at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/torsten.schmits/merge-databas…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Check for negative type literals in the type checker (#26861)
by Marge Bot (＠marge-bot) 27 Feb '26
by Marge Bot (＠marge-bot) 27 Feb '26
27 Feb '26
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/21828b5893978bd3e07418599e30a7…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/21828b5893978bd3e07418599e30a7…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/int-index/drop-tylit] 5 commits: wasm: add /assets endpoint to serve user-specified assets
by Vladislav Zavialov (＠int-index) 27 Feb '26
by Vladislav Zavialov (＠int-index) 27 Feb '26
27 Feb '26
Vladislav Zavialov pushed to branch wip/int-index/drop-tylit at Glasgow Haskell Compiler / GHC
Commits:
c951fef1 by Cheng Shao at 2026-02-25T20:58:28+00:00
wasm: add /assets endpoint to serve user-specified assets
This patch adds an `/assets` endpoint to the wasm dyld http server, so
that users can also fetch assets from the same host with sensible
default MIME types, without needing a separate http server for assets
that also introduces CORS headaches:
- A `-fghci-browser-assets-dir` driver flag is added to specify the
assets root directory (defaults to `$PWD`)
- The dyld http server fetches `mime-db` on demand and uses it as
source of truth for mime types.
Closes #26951.
- - - - -
dde22f97 by Sylvain Henry at 2026-02-26T13:14:03-05:00
Fix -fcheck-prim-bounds for non constant args (#26958)
Previously we were only checking bounds for constant (literal)
arguments!
I've refactored the code to simplify the generation of out-of-line Cmm
code for the primop composed of some inline code + some call to an
external Cmm function.
- - - - -
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
- - - - -
a5e26628 by Vladislav Zavialov at 2026-02-27T14:15:28+03:00
Drop HsTyLit in favor of HsLit (#26862, #25121)
This patch is a small step towards unification of HsExpr and HsType,
taking care of literals (HsLit) and type literals (HsTyLit).
Additionally, it improves error messages for unsupported type literals,
such as unboxed or fractional literals (test cases: T26862, T26862_th).
Changes to the AST:
* Use HsLit where HsTyLit was previously used
* Use HsChar where HsCharTy was previously used
* Use HsString where HsStrTy was previously used
* Use HsNatural (NEW) where HsNumTy was previously used
* Use HsDouble (NEW) to represent unsupported fractional type literals
Changes to logic:
* Parse unboxed and fractional type literals (to be rejected later)
* Drop the check for negative literals in the renamer (rnHsTyLit)
in favor of checking in the type checker (tc_hs_lit_ty)
* Check for invalid type literals in TH (repTyLit) and report
unrepresentable literals with ThUnsupportedTyLit
* Allow negative type literals in TH (numTyLit). This is fine as
these will be taken care of at splice time (test case: T8306_th)
- - - - -
63 changed files:
- compiler/GHC/Driver/Config/Interpreter.hs
- compiler/GHC/Driver/DynFlags.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Hs/Instances.hs
- compiler/GHC/Hs/Lit.hs
- compiler/GHC/Hs/Syn/Type.hs
- compiler/GHC/Hs/Type.hs
- compiler/GHC/HsToCore/Errors/Ppr.hs
- compiler/GHC/HsToCore/Errors/Types.hs
- compiler/GHC/HsToCore/Match/Literal.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Rename/Expr.hs
- compiler/GHC/Rename/HsType.hs
- compiler/GHC/Rename/Pat.hs
- compiler/GHC/Rename/Utils.hs
- compiler/GHC/Runtime/Interpreter/Init.hs
- compiler/GHC/Runtime/Interpreter/Types.hs
- compiler/GHC/Runtime/Interpreter/Wasm.hs
- compiler/GHC/StgToCmm/Prim.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Tc/Gen/App.hs
- compiler/GHC/Tc/Gen/HsType.hs
- compiler/GHC/Tc/Gen/Pat.hs
- compiler/GHC/ThToHs.hs
- compiler/GHC/Types/Error/Codes.hs
- compiler/GHC/Types/SourceText.hs
- compiler/Language/Haskell/Syntax/Expr.hs
- compiler/Language/Haskell/Syntax/Extension.hs
- compiler/Language/Haskell/Syntax/Lit.hs
- compiler/Language/Haskell/Syntax/Type.hs
- docs/users_guide/wasm.rst
- libraries/ghc-internal/src/GHC/Internal/TH/Lib.hs
- + testsuite/tests/codeGen/should_fail/T26958.hs
- testsuite/tests/codeGen/should_fail/all.T
- testsuite/tests/ghc-api/annotations-literals/parsed.hs
- + 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/th/T26862_th.script
- + testsuite/tests/th/T26862_th.stderr
- + testsuite/tests/th/T8306_th.script
- + testsuite/tests/th/T8306_th.stderr
- + testsuite/tests/th/T8306_th.stdout
- testsuite/tests/th/T8412.stderr
- testsuite/tests/th/all.T
- + testsuite/tests/typecheck/should_fail/T26861.hs
- + testsuite/tests/typecheck/should_fail/T26861.stderr
- + testsuite/tests/typecheck/should_fail/T26862.hs
- + testsuite/tests/typecheck/should_fail/T26862.stderr
- testsuite/tests/typecheck/should_fail/T8306.stderr
- testsuite/tests/typecheck/should_fail/all.T
- utils/check-exact/ExactPrint.hs
- utils/haddock/haddock-api/src/Haddock/Backends/LaTeX.hs
- utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
- utils/haddock/haddock-api/src/Haddock/Convert.hs
- utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs
- utils/haddock/haddock-api/src/Haddock/Types.hs
- utils/jsffi/dyld.mjs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/13228aaffad76c9e2162464ea7a01a…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/13228aaffad76c9e2162464ea7a01a…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][master] Consistent pretty-printing of HsString, HsIsString, HsStrTy
by Marge Bot (＠marge-bot) 27 Feb '26
by Marge Bot (＠marge-bot) 27 Feb '26
27 Feb '26
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
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
- - - - -
7 changed files:
- compiler/GHC/Hs/Lit.hs
- compiler/GHC/Hs/Type.hs
- + 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
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
=====================================
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, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/faf14e0c020e9fb66207026110cce2f…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/faf14e0c020e9fb66207026110cce2f…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][master] Check for negative type literals in the type checker (#26861)
by Marge Bot (＠marge-bot) 27 Feb '26
by Marge Bot (＠marge-bot) 27 Feb '26
27 Feb '26
Marge Bot pushed to branch master 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.
- - - - -
4 changed files:
- compiler/GHC/Tc/Gen/HsType.hs
- + testsuite/tests/typecheck/should_fail/T26861.hs
- + testsuite/tests/typecheck/should_fail/T26861.stderr
- testsuite/tests/typecheck/should_fail/all.T
Changes:
=====================================
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
=====================================
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/-/commit/bd3eba86180083a3bd1633994b9e6cd…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bd3eba86180083a3bd1633994b9e6cd…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc] Pushed new branch wip/int-index/test-diagnostics
by Vladislav Zavialov (＠int-index) 27 Feb '26
by Vladislav Zavialov (＠int-index) 27 Feb '26
27 Feb '26
Vladislav Zavialov pushed new branch wip/int-index/test-diagnostics at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/int-index/test-diagnostics
You're receiving this email because of your account on gitlab.haskell.org.
1
0