27 Feb '26
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
c927954f by Vladislav Zavialov at 2026-02-27T18:46:50-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
- - - - -
50 changed files:
- compiler/GHC/Parser/Errors/Ppr.hs
- compiler/GHC/Parser/Errors/Types.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Types/Error/Codes.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/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/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/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
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c927954fae3f058f5a616672e7f8a1e…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c927954fae3f058f5a616672e7f8a1e…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][master] Drop HsTyLit in favor of HsLit (#26862, #25121)
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:
dcd7819c by Vladislav Zavialov at 2026-02-27T18:46:03-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)
- - - - -
45 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/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/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
- libraries/ghc-internal/src/GHC/Internal/TH/Lib.hs
- testsuite/tests/ghc-api/annotations-literals/parsed.hs
- + 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/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
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dcd7819c25da268a45142ad7ca27ce2…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dcd7819c25da268a45142ad7ca27ce2…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/reduce-type-in-stg] 3 commits: Fix issues and remove Type from StgFCallOp
by Jaro Reinders (@jaro) 27 Feb '26
by Jaro Reinders (@jaro) 27 Feb '26
27 Feb '26
Jaro Reinders pushed to branch wip/reduce-type-in-stg at Glasgow Haskell Compiler / GHC
Commits:
f7411bb6 by Jaro Reinders at 2026-02-27T12:01:45+00:00
Fix issues and remove Type from StgFCallOp
- - - - -
e8ccf617 by Jaro Reinders at 2026-02-27T12:57:32+00:00
Remove Type from StgRhsClosure
- - - - -
14f8cd8d by Jaro Reinders at 2026-02-27T17:58:58+00:00
Remove redundant whitespace
- - - - -
10 changed files:
- compiler/GHC/CoreToStg.hs
- compiler/GHC/Stg/BcPrep.hs
- compiler/GHC/Stg/Make.hs
- compiler/GHC/Stg/Syntax.hs
- compiler/GHC/Stg/Unarise.hs
- compiler/GHC/StgToByteCode.hs
- compiler/GHC/StgToCmm/Expr.hs
- compiler/GHC/StgToCmm/Foreign.hs
- compiler/GHC/StgToCmm/Prim.hs
- compiler/GHC/StgToJS/Expr.hs
Changes:
=====================================
compiler/GHC/CoreToStg.hs
=====================================
@@ -566,7 +566,7 @@ mkStgApp f how_bound core_args stg_args res_ty
-- A regular foreign call.
FCallId call -> assert exactly_saturated $
- StgOpApp (StgFCallOp call (idType f)) stg_args res_kind
+ StgOpApp (StgFCallOp call (collectStgFArgTypes (idType f))) stg_args res_kind
TickBoxOpId {} -> pprPanic "coreToStg TickBox" $ ppr (f,stg_args)
@@ -722,7 +722,7 @@ coreToMkStgRhs bndr expr = do
let mk_rhs = MkStgRhs
{ rhs_args = args'
, rhs_expr = body'
- , rhs_type = exprType body
+ , rhs_kind = MkStgKind (typeKind (exprType body))
, rhs_is_join = isJoinId bndr
}
pure mk_rhs
=====================================
compiler/GHC/Stg/BcPrep.hs
=====================================
@@ -50,7 +50,7 @@ bcPrepRHS con@StgRhsCon{} = pure con
bcPrepExpr :: StgExpr -> BcPrepM StgExpr
-- explicitly match all constructors so we get a warning if we miss any
bcPrepExpr (StgTick bp@(Breakpoint tick_ty _ _) rhs)
- | isLiftedTypeKind (typeKind tick_ty) = do
+ | isLiftedTypeKind tick_kind = do
id <- newId tick_ty
rhs' <- bcPrepExpr rhs
let expr' = StgTick bp rhs'
@@ -59,7 +59,7 @@ bcPrepExpr (StgTick bp@(Breakpoint tick_ty _ _) rhs)
ReEntrant
[]
expr'
- tick_ty
+ (MkStgKind tick_kind)
)
letExp = StgLet noExtFieldSilent bnd (StgApp id [])
pure letExp
@@ -72,9 +72,10 @@ bcPrepExpr (StgTick bp@(Breakpoint tick_ty _ _) rhs)
ReEntrant
[voidArgId]
expr'
- tick_ty
+ (MkStgKind tick_kind)
)
pure $ StgLet noExtFieldSilent bnd (StgApp id [StgVarArg realWorldPrimId])
+ where tick_kind = typeKind tick_ty
bcPrepExpr (StgTick tick rhs) =
StgTick tick <$> bcPrepExpr rhs
bcPrepExpr (StgLet xlet bnds expr) =
=====================================
compiler/GHC/Stg/Make.hs
=====================================
@@ -11,7 +11,6 @@ import GHC.Prelude
import GHC.Unit.Module
import GHC.Core.DataCon
-import GHC.Core.Type (Type)
import GHC.Stg.Syntax
import GHC.Stg.Utils (stripStgTicksTop)
@@ -27,7 +26,7 @@ import GHC.Types.Tickish
data MkStgRhs = MkStgRhs
{ rhs_args :: [Id] -- ^ Empty for thunks
, rhs_expr :: StgExpr -- ^ RHS expression
- , rhs_type :: Type -- ^ RHS type (only used in the JS backend: layering violation)
+ , rhs_kind :: StgKind -- ^ RHS kind (only used in the JS backend: layering violation)
, rhs_is_join :: !Bool -- ^ Is it a RHS for a join-point?
}
@@ -37,7 +36,7 @@ data MkStgRhs = MkStgRhs
mkTopStgRhs :: (Module -> DataCon -> [StgArg] -> Bool)
-> Bool -> Module -> CollectedCCs
-> Id -> MkStgRhs -> (StgRhs, CollectedCCs)
-mkTopStgRhs allow_toplevel_con_app opt_AutoSccsOnIndividualCafs this_mod ccs bndr mk_rhs@(MkStgRhs bndrs rhs typ _)
+mkTopStgRhs allow_toplevel_con_app opt_AutoSccsOnIndividualCafs this_mod ccs bndr mk_rhs@(MkStgRhs bndrs rhs kind _)
-- try to make a StgRhsCon first
| Just rhs_con <- mkTopStgRhsCon_maybe (allow_toplevel_con_app this_mod) mk_rhs
= ( rhs_con, ccs )
@@ -47,20 +46,20 @@ mkTopStgRhs allow_toplevel_con_app opt_AutoSccsOnIndividualCafs this_mod ccs bnd
( StgRhsClosure noExtFieldSilent
dontCareCCS
ReEntrant
- bndrs rhs typ
+ bndrs rhs kind
, ccs )
-- Otherwise it's a CAF, see Note [Cost-centre initialization plan].
| opt_AutoSccsOnIndividualCafs
= ( StgRhsClosure noExtFieldSilent
caf_ccs
- upd_flag [] rhs typ
+ upd_flag [] rhs kind
, collectCC caf_cc caf_ccs ccs )
| otherwise
= ( StgRhsClosure noExtFieldSilent
all_cafs_ccs
- upd_flag [] rhs typ
+ upd_flag [] rhs kind
, ccs )
where
@@ -82,7 +81,7 @@ mkTopStgRhs allow_toplevel_con_app opt_AutoSccsOnIndividualCafs this_mod ccs bnd
-- Generate a non-top-level RHS. Cost-centre is always currentCCS,
-- see Note [Cost-centre initialization plan].
mkStgRhs :: Id -> MkStgRhs -> StgRhs
-mkStgRhs bndr mk_rhs@(MkStgRhs bndrs rhs typ is_join)
+mkStgRhs bndr mk_rhs@(MkStgRhs bndrs rhs kind is_join)
-- try to make a StgRhsCon first
| Just rhs_con <- mkStgRhsCon_maybe mk_rhs
= rhs_con
@@ -90,7 +89,7 @@ mkStgRhs bndr mk_rhs@(MkStgRhs bndrs rhs typ is_join)
| otherwise
= StgRhsClosure noExtFieldSilent
currentCCS
- upd_flag bndrs rhs typ
+ upd_flag bndrs rhs kind
where
upd_flag | is_join = JumpedTo
| not (null bndrs) = ReEntrant
@@ -151,22 +150,22 @@ isPAP env _ = False
-- | Try to make a non top-level StgRhsCon if appropriate
mkStgRhsCon_maybe :: MkStgRhs -> Maybe StgRhs
-mkStgRhsCon_maybe (MkStgRhs bndrs rhs typ is_join)
+mkStgRhsCon_maybe (MkStgRhs bndrs rhs kind is_join)
| [] <- bndrs
, not is_join
, (ticks, StgConApp con mn args _) <- stripStgTicksTop (not . tickishIsCode) rhs
- = Just (StgRhsCon currentCCS con mn ticks args typ)
+ = Just (StgRhsCon currentCCS con mn ticks args kind)
| otherwise = Nothing
-- | Try to make a top-level StgRhsCon if appropriate
mkTopStgRhsCon_maybe :: (DataCon -> [StgArg] -> Bool) -> MkStgRhs -> Maybe StgRhs
-mkTopStgRhsCon_maybe allow_static_con_app (MkStgRhs bndrs rhs typ is_join)
+mkTopStgRhsCon_maybe allow_static_con_app (MkStgRhs bndrs rhs kind is_join)
| [] <- bndrs
, not is_join -- shouldn't happen at top-level
, (ticks, StgConApp con mn args _) <- stripStgTicksTop (not . tickishIsCode) rhs
, allow_static_con_app con args
- = Just (StgRhsCon dontCareCCS con mn ticks args typ)
+ = Just (StgRhsCon dontCareCCS con mn ticks args kind)
| otherwise = Nothing
=====================================
compiler/GHC/Stg/Syntax.hs
=====================================
@@ -16,6 +16,9 @@ generation.
module GHC.Stg.Syntax (
StgKind(..),
+ StgFArgType(..),
+ collectStgFArgTypes,
+
StgArg(..),
GenStgTopBinding(..), GenStgBinding(..), GenStgExpr(..), GenStgRhs(..),
@@ -77,7 +80,7 @@ import GHC.Types.CostCentre ( CostCentreStack )
import GHC.Core ( AltCon )
import GHC.Core.DataCon
import GHC.Core.TyCon ( PrimRep(..), PrimOrVoidRep(..), TyCon )
-import GHC.Core.Type ( Type )
+import GHC.Core.Type ( Type, tyConAppTyCon )
import GHC.Core.Ppr( {- instances -} )
import GHC.Types.ForeignCall ( ForeignCall )
@@ -85,7 +88,7 @@ import GHC.Types.Id
import GHC.Types.Tickish ( StgTickish )
import GHC.Types.Var.Set
import GHC.Types.Literal ( Literal, literalType )
-import GHC.Types.RepType ( typePrimRep, typePrimRep1, typePrimRepU, typePrimRep_maybe )
+import GHC.Types.RepType ( typePrimRep, typePrimRep1, typePrimRepU, typePrimRep_maybe, unwrapType )
import GHC.Utils.Outputable
import GHC.Utils.Panic.Plain
@@ -96,6 +99,14 @@ import Data.ByteString ( ByteString )
import Data.Data ( Data )
import Data.List ( intersperse )
import GHC.Tc.Utils.TcType (Kind)
+import GHC.Core.TyCo.Rep (Type(..))
+import GHC.Builtin.Types.Prim
+ ( arrayPrimTyCon,
+ byteArrayPrimTyCon,
+ mutableArrayPrimTyCon,
+ mutableByteArrayPrimTyCon,
+ smallArrayPrimTyCon,
+ smallMutableArrayPrimTyCon )
newtype StgKind = MkStgKind { getStgKind :: Kind }
@@ -414,7 +425,7 @@ data GenStgRhs pass
[BinderP pass] -- ^ arguments; if empty, then not a function;
-- as above, order is important.
(GenStgExpr pass) -- ^ body
- Type -- ^ result type
+ StgKind -- ^ result kind
{-
An example may be in order. Consider:
@@ -444,7 +455,7 @@ important):
ConstructorNumber
[StgTickish]
[StgArg] -- Saturated Args. See Note [Constructor applications in STG]
- Type -- Type, for rewriting to an StgRhsClosure
+ StgKind -- Kind, for rewriting to an StgRhsClosure
-- | Like 'GHC.Hs.Extension.NoExtField', but with an 'Outputable' instance that
-- returns 'empty'.
@@ -701,6 +712,51 @@ isUpdatable SingleEntry = False
isUpdatable Updatable = True
isUpdatable JumpedTo = False
+-- The minimum amount of information needed to determine
+-- the offset to apply to an argument to a foreign call.
+-- See Note [Unlifted boxed arguments to foreign calls]
+data StgFArgType
+ = StgPlainType
+ | StgArrayType
+ | StgSmallArrayType
+ | StgByteArrayType
+
+-- From a function, extract information needed to determine
+-- the offset of each argument when used as a C FFI argument.
+-- See Note [Unlifted boxed arguments to foreign calls]
+collectStgFArgTypes :: Type -> [StgFArgType]
+collectStgFArgTypes = go []
+ where
+ -- Skip foralls
+ go bs (ForAllTy _ res) = go bs res
+ go bs (AppTy{}) = reverse bs
+ go bs (TyConApp{}) = reverse bs
+ go bs (LitTy{}) = reverse bs
+ go bs (TyVarTy{}) = reverse bs
+ go _ (CastTy{}) = panic "myCollectTypeArgs: CastTy"
+ go _ (CoercionTy{}) = panic "myCollectTypeArgs: CoercionTy"
+ go bs (FunTy {ft_arg = arg, ft_res=res}) =
+ go (typeToStgFArgType arg:bs) res
+
+-- Choose the offset based on the type. For anything other
+-- than an unlifted boxed type, there is no offset.
+-- See Note [Unlifted boxed arguments to foreign calls]
+typeToStgFArgType :: Type -> StgFArgType
+typeToStgFArgType typ
+ | tycon == arrayPrimTyCon = StgArrayType
+ | tycon == mutableArrayPrimTyCon = StgArrayType
+ | tycon == smallArrayPrimTyCon = StgSmallArrayType
+ | tycon == smallMutableArrayPrimTyCon = StgSmallArrayType
+ | tycon == byteArrayPrimTyCon = StgByteArrayType
+ | tycon == mutableByteArrayPrimTyCon = StgByteArrayType
+ | otherwise = StgPlainType
+ where
+ -- Should be a tycon app, since this is a foreign call. We look
+ -- through newtypes so the offset does not change if a user replaces
+ -- a type in a foreign function signature with a representationally
+ -- equivalent newtype.
+ tycon = tyConAppTyCon (unwrapType typ)
+
{-
************************************************************************
* *
@@ -717,11 +773,12 @@ data StgOp
| StgPrimCallOp PrimCall
- | StgFCallOp ForeignCall Type
- -- The Type, which is obtained from the foreign import declaration
- -- itself, is needed by the stg-to-cmm pass to determine the offset to
- -- apply to unlifted boxed arguments in GHC.StgToCmm.Foreign. See Note
- -- [Unlifted boxed arguments to foreign calls]
+ | StgFCallOp ForeignCall [StgFArgType]
+ -- The foreign argument types, which are obtained from the foreign
+ -- import declaration itself, areneeded by the stg-to-cmm pass to
+ -- determine the offset to apply to unlifted boxed arguments in
+ -- GHC.StgToCmm.Foreign.
+ -- See Note [Unlifted boxed arguments to foreign calls]
| StgTagToEnumOp TyCon
@@ -915,6 +972,8 @@ pprStgOp :: StgOp -> SDoc
pprStgOp (StgPrimOp op) = ppr op
pprStgOp (StgPrimCallOp op)= ppr op
pprStgOp (StgFCallOp op _) = ppr op
+-- TODO: how do we want to pretty print this?
+pprStgOp (StgTagToEnumOp tyc) = text "TagToEnumOp" <+> ppr tyc
instance Outputable StgOp where
ppr = pprStgOp
=====================================
compiler/GHC/Stg/Unarise.hs
=====================================
@@ -494,7 +494,7 @@ unariseBinding rho top_level (StgRec xrhss)
= StgRec <$> mapM (\(x, rhs) -> (x,) <$> unariseRhs rho top_level rhs) xrhss
unariseRhs :: UnariseEnv -> Bool -> StgRhs -> UniqSM StgRhs
-unariseRhs rho top_level (StgRhsClosure ext ccs update_flag args expr typ)
+unariseRhs rho top_level (StgRhsClosure ext ccs update_flag args expr kind)
= do (rho', args1) <- unariseFunArgBinders rho args
expr' <- unariseExpr rho' expr
-- Unarisation can lead to a StgRhsClosure becoming a StgRhsCon.
@@ -515,7 +515,7 @@ unariseRhs rho top_level (StgRhsClosure ext ccs update_flag args expr typ)
let mk_rhs = MkStgRhs
{ rhs_args = args1
, rhs_expr = expr'
- , rhs_type = typ
+ , rhs_kind = kind
, rhs_is_join = update_flag == JumpedTo
}
if | top_level
@@ -527,7 +527,7 @@ unariseRhs rho top_level (StgRhsClosure ext ccs update_flag args expr typ)
-> pure rhs_con
| otherwise
- -> pure (StgRhsClosure ext ccs update_flag args1 expr' typ)
+ -> pure (StgRhsClosure ext ccs update_flag args1 expr' kind)
unariseRhs rho _top (StgRhsCon ccs con mu ts args typ)
= assert (not (isUnboxedTupleDataCon con || isUnboxedSumDataCon con))
=====================================
compiler/GHC/StgToByteCode.hs
=====================================
@@ -47,7 +47,6 @@ import GHC.Utils.Misc
import GHC.Utils.Logger
import GHC.Types.Var.Set
import GHC.Builtin.Types.Prim
-import GHC.Core.TyCo.Ppr ( pprType )
import GHC.Utils.Error
import GHC.Builtin.Uniques
import GHC.Data.FastString
@@ -2171,7 +2170,7 @@ mkDummyLiteral platform pr
maybe_is_tagToEnum_call :: CgStgExpr -> Maybe (StgArg, [Name])
-- Detect and extract relevant info for the tagToEnum kludge.
-maybe_is_tagToEnum_call (StgOpApp (StgTagToEnumOp tyc) args t)
+maybe_is_tagToEnum_call (StgOpApp (StgTagToEnumOp tyc) args _)
| [v] <- args
= Just (v, extract_constr_Names tyc)
| otherwise
=====================================
compiler/GHC/StgToCmm/Expr.hs
=====================================
@@ -688,6 +688,7 @@ isSimpleOp (StgPrimOp op) stg_args = do
-- See Note [Inlining out-of-line primops and heap checks]
return $! shouldInlinePrimOp cfg op arg_exprs
isSimpleOp (StgPrimCallOp _) _ = return False
+isSimpleOp (StgTagToEnumOp _) _ = return True
-----------------
chooseReturnBndrs :: Id -> AltType -> [CgStgAlt] -> [NonVoid Id]
=====================================
compiler/GHC/StgToCmm/Foreign.hs
=====================================
@@ -42,7 +42,6 @@ import GHC.Cmm.Reg ( GlobalArgRegs(..) )
import GHC.Cmm.Utils
import GHC.Cmm.Graph
import GHC.Cmm.CallConv
-import GHC.Core.Type
import GHC.Types.RepType
import GHC.Cmm.CLabel
import GHC.Runtime.Heap.Layout
@@ -53,8 +52,6 @@ import GHC.Types.Basic
import GHC.Types.Unique.DSM
import GHC.Unit.Types
-import GHC.Core.TyCo.Rep
-import GHC.Builtin.Types.Prim
import GHC.Utils.Misc (zipEqual)
import Control.Monad
@@ -67,13 +64,13 @@ import Control.Monad
-- Precondition: the length of the arguments list is the same as the
-- arity of the foreign function.
cgForeignCall :: ForeignCall -- the op
- -> Type -- type of foreign function
+ -> [StgFArgType]
-> [StgArg] -- x,y arguments
-> StgKind -- result kind
-> FCode ReturnKind
-cgForeignCall (CCall (CCallSpec target cconv safety)) typ stg_args res_kind
- = do { cmm_args <- getFCallArgs stg_args typ
+cgForeignCall (CCall (CCallSpec target cconv safety)) arg_tys stg_args res_kind
+ = do { cmm_args <- getFCallArgs stg_args arg_tys
-- ; traceM $ show cmm_args
; (res_regs, res_hints) <- newUnboxedTupleRegs (getStgKind res_kind)
; let ((call_args, arg_hints), cmm_target)
@@ -711,15 +708,15 @@ closureField profile off = off + fixedHdrSize profile
getFCallArgs ::
[StgArg]
- -> Type -- the type of the foreign function
+ -> [StgFArgType]
-> FCode [(CmmExpr, ForeignHint)]
-- (a) Drop void args
-- (b) Add foreign-call shim code
-- It's (b) that makes this differ from getNonVoidArgAmodes
-- Precondition: args and typs have the same length
-- See Note [Unlifted boxed arguments to foreign calls]
-getFCallArgs args typ
- = do { mb_cmms <- mapM get (zipEqual args (collectStgFArgTypes typ))
+getFCallArgs args arg_tys
+ = do { mb_cmms <- mapM get (zipEqual args arg_tys)
; return (catMaybes mb_cmms) }
where
get (arg,typ)
@@ -734,15 +731,6 @@ getFCallArgs args typ
arg_reps = typePrimRep arg_ty
hint = typeForeignHint arg_ty
--- The minimum amount of information needed to determine
--- the offset to apply to an argument to a foreign call.
--- See Note [Unlifted boxed arguments to foreign calls]
-data StgFArgType
- = StgPlainType
- | StgArrayType
- | StgSmallArrayType
- | StgByteArrayType
-
-- See Note [Unlifted boxed arguments to foreign calls]
add_shim :: Profile -> StgFArgType -> CmmExpr -> CmmExpr
add_shim profile ty expr = case ty of
@@ -752,39 +740,3 @@ add_shim profile ty expr = case ty of
StgByteArrayType -> cmmOffsetB platform expr (arrWordsHdrSize profile)
where
platform = profilePlatform profile
-
--- From a function, extract information needed to determine
--- the offset of each argument when used as a C FFI argument.
--- See Note [Unlifted boxed arguments to foreign calls]
-collectStgFArgTypes :: Type -> [StgFArgType]
-collectStgFArgTypes = go []
- where
- -- Skip foralls
- go bs (ForAllTy _ res) = go bs res
- go bs (AppTy{}) = reverse bs
- go bs (TyConApp{}) = reverse bs
- go bs (LitTy{}) = reverse bs
- go bs (TyVarTy{}) = reverse bs
- go _ (CastTy{}) = panic "myCollectTypeArgs: CastTy"
- go _ (CoercionTy{}) = panic "myCollectTypeArgs: CoercionTy"
- go bs (FunTy {ft_arg = arg, ft_res=res}) =
- go (typeToStgFArgType arg:bs) res
-
--- Choose the offset based on the type. For anything other
--- than an unlifted boxed type, there is no offset.
--- See Note [Unlifted boxed arguments to foreign calls]
-typeToStgFArgType :: Type -> StgFArgType
-typeToStgFArgType typ
- | tycon == arrayPrimTyCon = StgArrayType
- | tycon == mutableArrayPrimTyCon = StgArrayType
- | tycon == smallArrayPrimTyCon = StgSmallArrayType
- | tycon == smallMutableArrayPrimTyCon = StgSmallArrayType
- | tycon == byteArrayPrimTyCon = StgByteArrayType
- | tycon == mutableByteArrayPrimTyCon = StgByteArrayType
- | otherwise = StgPlainType
- where
- -- Should be a tycon app, since this is a foreign call. We look
- -- through newtypes so the offset does not change if a user replaces
- -- a type in a foreign function signature with a representationally
- -- equivalent newtype.
- tycon = tyConAppTyCon (unwrapType typ)
=====================================
compiler/GHC/StgToCmm/Prim.hs
=====================================
@@ -36,6 +36,7 @@ import GHC.Stg.Syntax
import GHC.Cmm
import GHC.Unit ( rtsUnit )
import GHC.Core.Type ( typeKind )
+import GHC.Core.TyCon ( isEnumerationTyCon )
import GHC.Cmm.CLabel
import GHC.Cmm.Info ( closureInfoPtr )
import GHC.Cmm.Utils
@@ -85,6 +86,22 @@ cgOpApp (StgPrimCallOp primcall) args _res_ty
; let fun = CmmLit (CmmLabel (mkPrimCallLabel primcall))
; emitCall (NativeNodeCall, NativeReturn) fun cmm_args }
+-- tagToEnum# is special: we need to pull the constructor
+-- out of the table, and perform an appropriate return.
+cgOpApp (StgTagToEnumOp tyc) args _ = do
+ amodes <- getNonVoidArgAmodes args
+ case amodes of
+ [amode] -> do
+ -- If you're reading this code in the attempt to figure
+ -- out why the compiler panic'ed here, it is probably because
+ -- you used tagToEnum# in a non-monomorphic setting, e.g.,
+ -- intToTg :: Enum a => Int -> a ; intToTg (I# x#) = tagToEnum# x#
+ -- That won't work.
+ massert (isEnumerationTyCon tyc)
+ platform <- getPlatform
+ emitReturn [tagToClosure platform tyc amode]
+ _ -> pprPanic "cgOpApp: tagToEnum# should be applied to exactly one argument" (ppr args)
+
cmmPrimOpApp :: StgToCmmConfig -> PrimOp -> [CmmExpr] -> Maybe StgKind -> FCode ReturnKind
cmmPrimOpApp cfg primop cmm_args mres_ty =
case emitPrimOp cfg primop cmm_args of
@@ -1670,7 +1687,7 @@ emitPrimOp cfg primop =
-- tagToEnum# is removed in CoreToStg and rewritten to a special StgTagToEnumOp
-- See Note [?]
- TagToEnumOp -> panic "emitPrimOp: TagToEnumOp should have been gone by now"
+ TagToEnumOp -> panic "emitPrimOp: TagToEnumOp should have been gone by now"
-- Out of line primops.
-- TODO compiler need not know about these
=====================================
compiler/GHC/StgToJS/Expr.hs
=====================================
@@ -307,9 +307,9 @@ genBody :: HasDebugCallStack
-> StgReg
-> [Id]
-> CgStgExpr
- -> Type
+ -> StgKind
-> G JStgStat
-genBody ctx startReg args e typ = do
+genBody ctx startReg args e kind = do
-- load arguments into local variables
la <- do
args' <- concatMapM genIdArgI args
@@ -320,7 +320,7 @@ genBody ctx startReg args e typ = do
-- compute PrimReps and their number of slots required to return the result of
-- i applied to args.
- let res_vars = resultSize typ
+ let res_vars = resultSize kind
-- compute typed expressions for each slot and assign registers
let go_var regs = \case
@@ -338,6 +338,12 @@ genBody ctx startReg args e typ = do
return $ la <> lav <> e <> returnStack
+-- TODO: move to a proper place
+stgKindPrimRep :: StgKind -> [PrimRep]
+stgKindPrimRep (MkStgKind kind) = case kindPrimRep_maybe kind of
+ Just rs -> rs
+ r -> pprPanic "stgKindPrimRep" (ppr r)
+
-- | Find the result type after applying the function to the arguments
--
-- It's trickier than it looks because:
@@ -361,12 +367,12 @@ genBody ctx startReg args e typ = do
-- In case of failure to determine the type, we default to LiftedRep as it's
-- probably what it is.
--
-resultSize :: HasDebugCallStack => Type -> [(PrimRep, Int)]
-resultSize ty = result
+resultSize :: HasDebugCallStack => StgKind -> [(PrimRep, Int)]
+resultSize kind = result
where
result = result_reps `zip` result_slots
result_slots = fmap (slotCount . primRepSize) result_reps
- result_reps = typePrimRep ty
+ result_reps = stgKindPrimRep kind
-- | Ensure that the set of identifiers has valid 'RuntimeRep's. This function
-- returns a no-op when 'csRuntimeAssert' in 'StgToJSConfig' is False.
@@ -1121,6 +1127,8 @@ genPrimOp ctx op args = do
genTagToEnumOp :: ExprCtx -> TyCon -> StgArg -> State.StateT GenState IO (JStgStat, ExprResult)
genTagToEnumOp ctx tyc arg = do
- [tag] <- genArg arg
- let [v] = concatMap typex_expr $ ctxTarget ctx
- pure (v |= if tyc == boolTyCon then IfExpr tag true_ false_ else app hdTagToEnum [tag], ExprInline)
\ No newline at end of file
+ tags <- genArg arg
+ case (tags, concatMap typex_expr $ ctxTarget ctx) of
+ ([tag], [v]) ->
+ pure (v |= if tyc == boolTyCon then IfExpr tag true_ false_ else app hdTagToEnum [tag], ExprInline)
+ _ -> pprPanic "genTagToEnumOp: should be applied to exactly one argument and have one result" (ppr ctx <+> ppr tyc <+> ppr arg)
\ No newline at end of file
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/21a9e5b729e6026545c3c2f46dfa67…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/21a9e5b729e6026545c3c2f46dfa67…
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:
bff2afde by Wolfgang Jeltsch at 2026-02-27T20:47:08+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`
- - - - -
15 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
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
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bff2afdef8ee9769ef13e5431b6309a…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bff2afdef8ee9769ef13e5431b6309a…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/T26503] 56 commits: driver: Hide source paths at verbosity level 1 by default
by Brandon Chinn (@brandonchinn178) 27 Feb '26
by Brandon Chinn (@brandonchinn178) 27 Feb '26
27 Feb '26
Brandon Chinn pushed to branch wip/T26503 at Glasgow Haskell Compiler / GHC
Commits:
aa9c5e2c by Hécate Kleidukos at 2026-02-03T15:58:35-05:00
driver: Hide source paths at verbosity level 1 by default
- - - - -
c64cca1e by mangoiv at 2026-02-03T15:59:29-05:00
ExplicitLevelImports: check staging for types just like for values
Previously, imported types were entirely exempted from staging checks as
the implicit stage persistance assumed to be all imported types to be
well staged. ExplicitLevelImports' change specification, however, does
not do such an exemption. Thus we want to introduce such a check, just
like we have for values.
ExplicitLevelImports does not, however, talk about local names - from
its perspective, we could theoretically keep treating locally introduced
types specially - e.g. an ill-staged used in a quote would only emit a
warning, not an error. To allow for a potential future migration away
from such wrinkles as the staging check in notFound
(see Note [Out of scope might be a staging error]) we consistently do
the strict staging check that we also do for value if ExplicitLevelImports
is on.
Closes #26098
- - - - -
5f0dbeb6 by Simon Hengel at 2026-02-03T16:00:12-05:00
Use Haddock formatting in deprecation message of `initNameCache`
- - - - -
01ecb612 by Andreas Klebinger at 2026-02-04T09:56:25-05:00
testsuite: Explicitly use utf-8 encoding in rts-includes linter.
Not doing so caused failures on windows, as python failed to pick a
reasonable encoding even with locale set.
Fixes #26850
- - - - -
ea0d1317 by Zubin Duggal at 2026-02-04T09:57:06-05:00
Bump transformers submodule to 0.6.3.0
Fixes #26790
- - - - -
cbe4300e by Simon Peyton Jones at 2026-02-05T04:31:04-05:00
Fix subtle bug in GHC.Core.Utils.mkTick
This patch fixes a decade-old bug in `mkTick`, which
could generate type-incorrect code! See the diagnosis
in #26772.
The new code is simpler and easier to understand.
(As #26772 says, I think it could be improved further.)
- - - - -
a193a8da by Simon Peyton Jones at 2026-02-05T04:31:04-05:00
Modify a debug-trace in the Simplifier
...just to show a bit more information.
- - - - -
b579dfdc by Simon Peyton Jones at 2026-02-05T04:31:04-05:00
Fix long-standing interaction between ticks and casts
The code for Note [Eliminate Identity Cases] was simply wrong when
ticks and casts interacted. This patch fixes the interaction.
It was shown up when validating #26772, although it's not the exactly
the bug that's reported by #26772. Nor is it easy to reproduce, hence
no regression test.
- - - - -
fac0de1e by Cheng Shao at 2026-02-05T04:31:49-05:00
libraries: bump Cabal submodule to 3.16.1.0
- - - - -
00589122 by Cheng Shao at 2026-02-05T04:31:49-05:00
libraries: bump deepseq submodule to 1.5.2.0
Also:
- Get rid of usage of deprecated `NFData` function instance in the
compiler
- `T21391` still relies on `NFData` function instance, add
`-Wno-deprecations` for the time being.
- - - - -
84474c71 by Cheng Shao at 2026-02-05T04:31:50-05:00
libraries: bump directory submodule to 1.3.10.1
- - - - -
1a9f4662 by Cheng Shao at 2026-02-05T04:31:50-05:00
libraries: bump exceptions submodule to 0.10.12
- - - - -
2e39a340 by Peng Fan at 2026-02-07T03:42:01-05:00
NCG/LA64: adjust register usage to avoid src-register being clobbered
- - - - -
9faf1b35 by Teo Camarasu at 2026-02-07T03:42:43-05:00
ghc-internal: Delete unnecessary GHC.Internal.Data.Ix
This module merely re-exports GHC.Internal.Ix. It was copied from
`base` when `ghc-internal` was split, but there is no reason to have
this now. So, let's delete it.
Resolves #26848
- - - - -
d112b440 by Sven Tennie at 2026-02-07T10:47:56-05:00
Add cabal.project file to generate-ci
This fixes the HLS setup for our CI code generation script
(generate-ci).
The project file simply makes `generate-ci` of the cabal file
discoverable.
- - - - -
5339f6f0 by Andreas Klebinger at 2026-02-07T10:48:40-05:00
CI: Don't collapse test results.
This puts test output back into the primary test log instead of a
subsection removing the need to expand a section to see test results.
While the intention was good in practice the old behaviour mostly wastes time
by requiring expansion of the section.
Fixes #26882
- - - - -
0e1cd2e0 by Evan Piro at 2026-02-08T10:35:16-08:00
Linker.MacOS reduce dynflags import
- - - - -
1c79a4cd by Michael Alan Dorman at 2026-02-09T08:11:51-05:00
Remove `extra_src_files` variable from `testsuite/driver/testlib.py`
While reading through the test harness code, I noticed this variable
with a TODO attached that referenced #12223. Although that bug is
closed, it strongly implied that this special-case variable that only
affected a single test was expected to be removed at some point.
I also looked at 3415bcaa0b1903b5e12dfaadb5b774718e406eab---where it
was added---whose commit message suggested that it would have been
desirable to remove it, but that there were special circumstances that
meant it had to remain (though it doesn't elucidate what those special
circumstances are).
However, the special circumstances were mentioned as if the test was
in a different location than is currently is, so I decided to try
changing the test to use the standard `extra_files` mechanism, which
works in local testing.
This also seems like a reasonable time to remove the script that was
originally used in the transition, since it doesn't really serve a
purpose anymore.
- - - - -
0020e38a by Matthew Pickering at 2026-02-09T17:29:14-05:00
determinism: Use a stable sort in WithHsDocIdentifiers binary instance
`WithHsDocIdentifiers` is defined as
```
71 data WithHsDocIdentifiers a pass = WithHsDocIdentifiers
72 { hsDocString :: !a
73 , hsDocIdentifiers :: ![Located (IdP pass)]
74 }
```
This list of names is populated from `rnHsDocIdentifiers`, which calls
`lookupGRE`, which calls `lookupOccEnv_AllNameSpaces`, which calls
`nonDetEltsUFM` and returns the results in an order depending on
uniques.
Sorting the list with a stable sort before returning the interface makes
the output deterministic and follows the approach taken by other fields
in `Docs`.
Fixes #26858
- - - - -
89898ce6 by echoumcp1 at 2026-02-09T17:30:01-05:00
Replace putstrln with logMsg in handleSeqHValueStatus
Fixes #26549
- - - - -
7c52c4f9 by John Paul Adrian Glaubitz at 2026-02-10T13:52:43-05:00
rts: Switch prim to use modern atomic compiler builtins
The __sync_*() atomic compiler builtins have been deprecated in GCC
for a while now and also don't provide variants for 64-bit values
such as __sync_fetch_and_add_8().
Thus, replace them with the modern __atomic_*() compiler builtins and
while we're at it, also drop the helper macro CAS_NAND() which is now
no longer needed since we stopped using the __sync_*() compiler builtins
altogether.
Co-authored-by: Ilias Tsitsimpis <iliastsi(a)debian.org>
Fixes #26729
- - - - -
cf60850a by Recursion Ninja at 2026-02-10T13:53:27-05:00
Decoupling L.H.S.Decls from GHC.Types.ForeignCall
- Adding TTG extension point for 'CCallTarget'
- Adding TTG extension point for 'CType'
- Adding TTG extension point for 'Header'
- Moving ForeignCall types that do not need extension
to new L.H.S.Decls.Foreign module
- Replacing 'Bool' parameters with descriptive data-types
to increase clairty and prevent "Boolean Blindness"
- - - - -
11a04cbb by Eric Lee at 2026-02-11T09:20:46-05:00
Derive Semigroup/Monoid for instances believed could be derived in #25871
- - - - -
15d9ce44 by Eric Lee at 2026-02-11T09:20:46-05:00
add Ghc.Data.Pair deriving
- - - - -
c85dc170 by Evan Piro at 2026-02-11T09:21:45-05:00
Linker.MacOS reduce options import
- - - - -
a541dd83 by Chris Wendt at 2026-02-11T16:06:41-05:00
Initialize plugins for `:set +c` in GHCi
Fixes #23110.
- - - - -
0f5a73bc by Cheng Shao at 2026-02-11T16:07:27-05:00
compiler: add Binary Text instance
This patch adds `Binary` instance for strict `Text`, in preparation of
making `Text` usable in certain GHC API use cases (e.g. haddock). This
also introduces `text` as a direct dependency of the `ghc` package.
- - - - -
9e58b8a1 by Cheng Shao at 2026-02-11T16:08:10-05:00
ghc-toolchain: add C11 check
This patch partially reverts commit
b8307eab80c5809df5405d76c822bf86877f5960 that removed C99 check in
autoconf/ghc-toolchain. Now we:
- No longer re-implement `FP_SET_CFLAGS_C11` similar to
`FP_SET_CFLAGS_C99` in the past, since autoconf doesn't provide a
convenient `AC_PROG_CC_C11` function. ghc-toolchain will handle it
anyway.
- The Cmm CPP C99 check is relanded and repurposed for C11.
- The C99 logic in ghc-toolchain is relanded and repurposed for C11.
- The C99 check in Stg.h is corrected to check for C11. The obsolete
_ISOC99_SOURCE trick is dropped.
- Usages of `-std=gnu99` in the testsuite are corrected to use
`-std=gnu11`.
Closes #26908.
- - - - -
4df0adf6 by Simon Peyton Jones at 2026-02-11T21:50:13-05:00
Simplify the treatment of static forms
This MR implements GHC proposal 732: simplify static forms,
https://github.com/ghc-proposals/ghc-proposals/pull/732
thereby addressing #26556.
See `Note [Grand plan for static forms]` in GHC.Iface.Tidy.StaticPtrTable
The main changes are:
* There is a new, simple rule for (static e), namely that the free
term variables of `e` must be bound at top level. The check is
done in the `HsStatic` case of `GHC.Rename.Expr.rnExpr`
* That in turn substantially simplifies the info that the typechecker
carries around in its type environment. Hooray.
* The desugarer emits static bindings to top level directly; see the
`HsStatic` case of `dsExpr`.
* There is no longer any special static-related magic in the FloatOut
pass. And the main Simplifier pipeline no longer needs a special case
to run FloatOut even with -O0. Hooray.
All this forced an unexpected change to the pattern match checker. It
recursively invokes the main Hs desugarer when it wants to take a look
at a term to spot some special cases (notably constructor applications).
We don't want to emit any nested (static e) bindings to top level a
second time! Yikes.
That forced a modest refactor in GHC.HsToCore.Pmc:
* The `dsl_nablas` field of `DsLclEnv` now has a `NoPmc` case, which says
"I'm desugaring just for pattern-match checking purposes".
* When that flag is set we don't emit static binds.
That in turn forces a cascade of refactoring, but the net effect is an
improvement; less risk of duplicated (even exponential?) work.
See Note [Desugaring HsExpr during pattern-match checking].
10% metric decrease, on some architectures, of compile-time max-bytes-used on T15304.
Metric Decrease:
T15304
- - - - -
7922f728 by Teo Camarasu at 2026-02-11T21:50:58-05:00
ghc-internal: avoid depending on GHC.Internal.Exts
This module is mostly just re-exports. It made sense as a user-facing
module, but there's no good reason ghc-internal modules should depend on
it and doing so linearises the module graph
- move considerAccessible to GHC.Internal.Magic
Previously it lived in GHC.Internal.Exts, but it really deserves to live
along with the other magic function, which are already re-exported from .Exts
- move maxTupleSize to GHC.Internal.Tuple
This previously lived in GHC.Internal.Exts but a comment already said it
should be moved to .Tuple
Resolves #26832
- - - - -
b6a4a29b by Eric Lee at 2026-02-11T21:51:55-05:00
Remove unused Semigroup imports to fix GHC 9.14 bootstrapping
- - - - -
99d8c146 by Simon Peyton Jones at 2026-02-12T17:36:59+00:00
Fix subtle bug in cast worker/wrapper
See (CWw4) in Note [Cast worker/wrapper].
The true payload is in the change to the definition of
GHC.Types.Id.Info.hasInlineUnfolding
Everthing else is just documentation.
There is a 2% compile time decrease for T13056;
I'll take the win!
Metric Decrease:
T13056
- - - - -
530e8e58 by Simon Peyton Jones at 2026-02-12T20:17:23-05:00
Add regression tests for four StaticPtr bugs
Tickets #26545, #24464, #24773, #16981 are all solved by the
recently-landed MR
commit 318ee13bcffa6aa8df42ba442ccd92aa0f7e210c
Author: Simon Peyton Jones <simon.peytonjones(a)gmail.com>
Date: Mon Oct 20 23:07:20 2025 +0100
Simplify the treatment of static forms
This MR just adds regression tests for them.
- - - - -
4157160f by Cheng Shao at 2026-02-13T06:27:04-05:00
ci: remove unused hlint-ghc-and-base job definition
This patch removes the unused `hlint-ghc-and-base` job definition,
it's never run since !9806. Note that hadrian lint rules still work
locally, so anyone that wishes to run hlint on the codebase can
continue to do so in their local worktree.
- - - - -
039f1977 by Cheng Shao at 2026-02-13T06:27:47-05:00
wasm: use import.meta.main for proper distinction of nodejs main modules
This patch uses `import.meta.main` for proper distinction of nodejs
main modules, especially when the main module might be installed as a
symlink. Fixes #26916.
- - - - -
14f485ee by ARATA Mizuki at 2026-02-17T09:09:24+09:00
Support more x86 extensions: AVX-512 {BW,DQ,VL} and GFNI
Also, mark AVX-512 ER and PF as deprecated.
AVX-512 instructions can be used for certain 64-bit integer vector operations.
GFNI can be used to implement bitReverse (currently not used by NCG, but LLVM may use it).
Closes #26406
Addresses #26509
- - - - -
016f79d5 by fendor at 2026-02-17T09:16:16-05:00
Hide implementation details from base exception stack traces
Ensure we hide the implementation details of the exception throwing mechanisms:
* `undefined`
* `throwSTM`
* `throw`
* `throwIO`
* `error`
The `HasCallStackBacktrace` should always have a length of exactly 1,
not showing internal implementation details in the stack trace, as these
are vastly distracting to end users.
CLC proposal [#387](https://github.com/haskell/core-libraries-committee/issues/387)
- - - - -
4f2840f2 by Brian J. Cardiff at 2026-02-17T17:04:08-05:00
configure: Accept happy-2.2
In Jan 2026 happy-2.2 was released. The most sensible change is https://github.com/haskell/happy/issues/335 which didn't trigger in a fresh build
- - - - -
10b4d364 by Duncan Coutts at 2026-02-17T17:04:52-05:00
Fix errors in the documentation of the eventlog STOP_THREAD status codes
Fix the code for BlockedOnMsgThrowTo.
Document all the known historical warts.
Fixes issue #26867
- - - - -
c5e15b8b by Phil de Joux at 2026-02-18T05:07:36-05:00
haddock: use snippets for all list examples
- generate snippet output for docs
- reduce font size to better fit snippets
- Use only directive to guard html snippets
- Add latex snippets for lists
- - - - -
d388bac1 by Phil de Joux at 2026-02-18T05:07:36-05:00
haddock: Place the snippet input and output together
- Put the output seemingly inside the example box
- - - - -
016fa306 by Samuel Thibault at 2026-02-18T05:08:35-05:00
Fix linking against libm by moving the -lm option
For those systems that need -lm for getting math functions, this is
currently added on the link line very early, before the object files being
linked together. Newer toolchains enable --as-needed by default, which means
-lm is ignored at that point because no object requires a math function
yet. With such toolchains, we thus have to add -lm after the objects, so the
linker actually includes libm in the link.
- - - - -
68bd0805 by Teo Camarasu at 2026-02-18T05:09:19-05:00
ghc-internal: Move GHC.Internal.Data.Bool to base
This is a tiny module that only defines bool :: Bool -> a -> a -> a. We can just move this to base and delete it from ghc-internal. If we want this functionality there we can just use a case statement or if-then expression.
Resolves 26865
- - - - -
4c40df3d by fendor at 2026-02-20T10:24:48-05:00
Add optional `SrcLoc` to `StackAnnotation` class
`StackAnnotation`s give access to an optional `SrcLoc` field that
user-added stack annotations can use to provide better backtraces in both error
messages and when decoding the callstack.
We update builtin stack annotations such as `StringAnnotation` and
`ShowAnnotation` to also capture the `SrcLoc` of the current `CallStack`
to improve backtraces by default (if stack annotations are used).
This change is backwards compatible with GHC 9.14.1.
- - - - -
fd9aaa28 by Simon Hengel at 2026-02-20T10:25:33-05:00
docs: Fix grammar in explicit_namespaces.rst
- - - - -
44354255 by Vo Minh Thu at 2026-02-20T18:53:06-05:00
GHCi: add a :version command.
This looks like:
ghci> :version
GHCi, version 9.11.20240322
This closes #24576.
Co-Author: Markus Läll <markus.l2ll(a)gmail.com>
- - - - -
eab3dbba by Andreas Klebinger at 2026-02-20T18:53:51-05:00
hadrian/build-cabal: Better respect and utilize -j
* We now respect -j<n> for the cabal invocation to build hadrian rather
than hardcoding -j
* We use the --semaphore flag to ensure cabal/ghc build the hadrian
executable in parallel using the -jsem mechanism.
Saves 10-15s on fresh builds for me.
Fixes #26876
- - - - -
17839248 by Teo Camarasu at 2026-02-24T08:36:03-05:00
ghc-internal: avoid depending on GHC.Internal.Control.Monad.Fix
This module contains the definition of MonadFix, since we want an
instance for IO, that instance requires a lot of machinery and we want
to avoid an orphan instance, this will naturally be quite high up in the
dependency graph.
So we want to avoid other modules depending on it as far as possible.
On Windows, the IO manager depends on the RTSFlags type, which
transtively depends on MonadFix. We refactor things to avoid this
dependency, which would have caused a regression.
Resolves #26875
Metric Decrease:
T12227
- - - - -
fa88d09a by Wolfgang Jeltsch at 2026-02-24T08:36:47-05:00
Refine the imports of `System.IO.OS`
Commit 68bd08055594b8cbf6148a72d108786deb6c12a1 replaced the
`GHC.Internal.Data.Bool` import by a `GHC.Internal.Base` import.
However, while the `GHC.Internal.Data.Bool` import was conditional and
partial, the `GHC.Internal.Base` import is unconditional and total. As a
result, the import list is not tuned to import only the necessary bits
anymore, and furthermore GHC emits a lot of warnings about redundant
imports.
This commit makes the `GHC.Internal.Base` import conditional and partial
in the same way that the `GHC.Internal.Data.Bool` import was.
- - - - -
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
- - - - -
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.
- - - - -
e80a9f24 by Brandon Chinn at 2026-02-27T10:43:42-08:00
Implement QualifiedStrings (#26503)
See Note [Implementation of QualifiedStrings]
- - - - -
435 changed files:
- .gitlab-ci.yml
- .gitlab/ci.sh
- + .gitlab/generate-ci/cabal.project
- compiler/GHC/Builtin/Names.hs
- compiler/GHC/Builtin/Types.hs
- compiler/GHC/CmmToAsm/Config.hs
- compiler/GHC/CmmToAsm/LA64/CodeGen.hs
- compiler/GHC/CmmToAsm/X86/CodeGen.hs
- compiler/GHC/CmmToAsm/X86/Instr.hs
- compiler/GHC/CmmToAsm/X86/Ppr.hs
- compiler/GHC/CmmToLlvm/CodeGen.hs
- compiler/GHC/Core/Lint.hs
- compiler/GHC/Core/Opt/Pipeline.hs
- compiler/GHC/Core/Opt/SetLevels.hs
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Core/Opt/Simplify/Utils.hs
- compiler/GHC/Core/Opt/WorkWrap.hs
- compiler/GHC/Core/TyCon.hs
- compiler/GHC/Core/Utils.hs
- compiler/GHC/CoreToStg.hs
- compiler/GHC/CoreToStg/AddImplicitBinds.hs
- compiler/GHC/Data/Pair.hs
- compiler/GHC/Driver/Config/CmmToAsm.hs
- compiler/GHC/Driver/Config/Core/Lint.hs
- compiler/GHC/Driver/Config/Interpreter.hs
- compiler/GHC/Driver/DynFlags.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Pipeline/Execute.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Hs/Binds.hs
- compiler/GHC/Hs/Decls.hs
- compiler/GHC/Hs/Doc.hs
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Hs/Instances.hs
- compiler/GHC/Hs/Lit.hs
- compiler/GHC/Hs/Pat.hs
- compiler/GHC/Hs/Syn/Type.hs
- compiler/GHC/Hs/Type.hs
- compiler/GHC/Hs/Utils.hs
- compiler/GHC/HsToCore.hs
- compiler/GHC/HsToCore/Docs.hs
- compiler/GHC/HsToCore/Errors/Types.hs
- compiler/GHC/HsToCore/Expr.hs
- compiler/GHC/HsToCore/Foreign/C.hs
- compiler/GHC/HsToCore/Foreign/Call.hs
- compiler/GHC/HsToCore/Foreign/Decl.hs
- compiler/GHC/HsToCore/Foreign/JavaScript.hs
- compiler/GHC/HsToCore/Foreign/Utils.hs
- compiler/GHC/HsToCore/Foreign/Wasm.hs
- compiler/GHC/HsToCore/GuardedRHSs.hs
- compiler/GHC/HsToCore/Match.hs
- compiler/GHC/HsToCore/Monad.hs
- compiler/GHC/HsToCore/Pmc.hs
- compiler/GHC/HsToCore/Pmc/Desugar.hs
- compiler/GHC/HsToCore/Pmc/Solver.hs
- compiler/GHC/HsToCore/Pmc/Solver/Types.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/HsToCore/Ticks.hs
- compiler/GHC/HsToCore/Types.hs
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/Iface/Syntax.hs
- compiler/GHC/Iface/Tidy.hs
- compiler/GHC/Iface/Tidy/StaticPtrTable.hs
- compiler/GHC/Linker/Dynamic.hs
- compiler/GHC/Linker/MacOS.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/Errors/Ppr.hs
- compiler/GHC/Parser/Errors/Types.hs
- compiler/GHC/Parser/Lexer.x
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Parser/PostProcess/Haddock.hs
- compiler/GHC/Parser/String.hs
- compiler/GHC/Rename/Bind.hs
- compiler/GHC/Rename/Expr.hs
- compiler/GHC/Rename/HsType.hs
- + compiler/GHC/Rename/Lit.hs
- compiler/GHC/Rename/Module.hs
- compiler/GHC/Rename/Pat.hs
- compiler/GHC/Rename/Splice.hs-boot
- compiler/GHC/Runtime/Heap/Inspect.hs
- compiler/GHC/Runtime/Interpreter.hs
- compiler/GHC/Runtime/Interpreter/Init.hs
- compiler/GHC/Runtime/Interpreter/Types.hs
- compiler/GHC/Runtime/Interpreter/Wasm.hs
- compiler/GHC/StgToByteCode.hs
- compiler/GHC/StgToCmm/Foreign.hs
- compiler/GHC/StgToCmm/Prim.hs
- compiler/GHC/StgToJS/FFI.hs
- compiler/GHC/SysTools/Cpp.hs
- compiler/GHC/Tc/Deriv.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Tc/Gen/Bind.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Gen/Foreign.hs
- compiler/GHC/Tc/Gen/Head.hs
- compiler/GHC/Tc/Gen/HsType.hs
- compiler/GHC/Tc/Gen/Match.hs
- compiler/GHC/Tc/Gen/Pat.hs
- compiler/GHC/Tc/Gen/Sig.hs
- compiler/GHC/Tc/Instance/Class.hs
- compiler/GHC/Tc/Module.hs
- compiler/GHC/Tc/Solver.hs
- compiler/GHC/Tc/Solver/Monad.hs
- compiler/GHC/Tc/TyCl.hs
- compiler/GHC/Tc/TyCl/Instance.hs
- compiler/GHC/Tc/TyCl/PatSyn.hs
- compiler/GHC/Tc/TyCl/Utils.hs
- compiler/GHC/Tc/Types.hs
- compiler/GHC/Tc/Types/BasicTypes.hs
- compiler/GHC/Tc/Types/Constraint.hs
- compiler/GHC/Tc/Types/ErrCtxt.hs
- compiler/GHC/Tc/Types/Evidence.hs
- compiler/GHC/Tc/Types/Origin.hs
- compiler/GHC/Tc/Utils/Env.hs
- compiler/GHC/Tc/Utils/Monad.hs
- compiler/GHC/Tc/Utils/TcMType.hs
- − compiler/GHC/Tc/Utils/TcMType.hs-boot
- compiler/GHC/Tc/Zonk/TcType.hs
- compiler/GHC/Tc/Zonk/Type.hs
- compiler/GHC/ThToHs.hs
- compiler/GHC/Types/Error/Codes.hs
- compiler/GHC/Types/ForeignCall.hs
- compiler/GHC/Types/Id/Info.hs
- compiler/GHC/Types/Id/Make.hs
- compiler/GHC/Types/Name/Cache.hs
- compiler/GHC/Types/Unique/DSet.hs
- compiler/GHC/Unit/Module/ModIface.hs
- compiler/GHC/Utils/Binary.hs
- compiler/GHC/Utils/Ppr/Colour.hs
- compiler/Language/Haskell/Syntax/Decls.hs
- + compiler/Language/Haskell/Syntax/Decls/Foreign.hs
- compiler/Language/Haskell/Syntax/Expr.hs
- compiler/Language/Haskell/Syntax/Extension.hs
- compiler/Language/Haskell/Syntax/Lit.hs
- compiler/Language/Haskell/Syntax/Pat.hs
- compiler/ghc.cabal.in
- configure.ac
- distrib/configure.ac.in
- + docs/users_guide/10.0.1-notes.rst
- docs/users_guide/9.16.1-notes.rst
- docs/users_guide/eventlog-formats.rst
- docs/users_guide/exts/explicit_namespaces.rst
- + docs/users_guide/exts/qualified_strings.rst
- docs/users_guide/ghci.rst
- docs/users_guide/phases.rst
- docs/users_guide/using.rst
- docs/users_guide/wasm.rst
- ghc/GHCi/UI.hs
- ghc/GHCi/UI/Info.hs
- hadrian/build-cabal
- hadrian/src/Settings/Builders/RunTest.hs
- libraries/Cabal
- libraries/base/changelog.md
- libraries/base/src/Control/Arrow.hs
- libraries/base/src/Data/Bool.hs
- libraries/base/src/Data/Ix.hs
- libraries/base/src/Data/List.hs
- libraries/base/src/Data/List/NubOrdSet.hs
- libraries/base/src/GHC/Exts.hs
- libraries/base/src/System/IO.hs
- libraries/deepseq
- libraries/directory
- libraries/exceptions
- libraries/ghc-experimental/CHANGELOG.md
- libraries/ghc-experimental/src/GHC/Stack/Annotation/Experimental.hs
- + libraries/ghc-experimental/tests/Makefile
- + libraries/ghc-experimental/tests/all.T
- + libraries/ghc-experimental/tests/backtraces/Makefile
- + libraries/ghc-experimental/tests/backtraces/T26806a.hs
- + libraries/ghc-experimental/tests/backtraces/T26806a.stderr
- + libraries/ghc-experimental/tests/backtraces/T26806b.hs
- + libraries/ghc-experimental/tests/backtraces/T26806b.stderr
- + libraries/ghc-experimental/tests/backtraces/T26806c.hs
- + libraries/ghc-experimental/tests/backtraces/T26806c.stderr
- + libraries/ghc-experimental/tests/backtraces/all.T
- libraries/ghc-internal/ghc-internal.cabal.in
- libraries/ghc-internal/src/GHC/Internal/Control/Arrow.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad/Fix.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad/ST/Lazy/Imp.hs
- − libraries/ghc-internal/src/GHC/Internal/Data/Bool.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Foldable.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Function.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Functor/Identity.hs
- − libraries/ghc-internal/src/GHC/Internal/Data/Ix.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Type/Bool.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Type/Ord.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Version.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Windows/ManagedThreadPool.hs
- libraries/ghc-internal/src/GHC/Internal/Exception.hs
- libraries/ghc-internal/src/GHC/Internal/Exts.hs
- libraries/ghc-internal/src/GHC/Internal/Heap/Closures.hs
- libraries/ghc-internal/src/GHC/Internal/IO/FD.hs
- libraries/ghc-internal/src/GHC/Internal/JS/Foreign/Callback.hs
- libraries/ghc-internal/src/GHC/Internal/JS/Prim.hs
- libraries/ghc-internal/src/GHC/Internal/JS/Prim/Internal/Build.hs
- libraries/ghc-internal/src/GHC/Internal/LanguageExtensions.hs
- libraries/ghc-internal/src/GHC/Internal/Magic.hs
- libraries/ghc-internal/src/GHC/Internal/RTS/Flags/Test.hsc
- libraries/ghc-internal/src/GHC/Internal/STM.hs
- libraries/ghc-internal/src/GHC/Internal/Stack/Annotation.hs
- libraries/ghc-internal/src/GHC/Internal/Stack/Decode.hs
- libraries/ghc-internal/src/GHC/Internal/System/IO.hs
- libraries/ghc-internal/src/GHC/Internal/System/IO/OS.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Lift.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Monad.hs
- libraries/ghc-internal/src/GHC/Internal/Tuple.hs
- libraries/ghc-internal/src/GHC/Internal/TypeError.hs
- libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Exports.hs
- libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Imports.hs
- libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Types.hs
- + libraries/ghc-internal/tests/backtraces/T15395.hs
- + libraries/ghc-internal/tests/backtraces/T15395.stdout
- libraries/ghc-internal/tests/backtraces/all.T
- libraries/ghc-internal/tests/stack-annotation/ann_frame001.stdout
- libraries/ghc-internal/tests/stack-annotation/ann_frame002.stdout
- libraries/ghc-internal/tests/stack-annotation/ann_frame003.stdout
- libraries/ghc-internal/tests/stack-annotation/ann_frame004.stdout
- libraries/ghc-internal/tests/stack-annotation/ann_frame005.stdout
- libraries/transformers
- m4/fp_cmm_cpp_cmd_with_args.m4
- m4/fptools_happy.m4
- rts/include/Stg.h
- rts/prim/atomic.c
- testsuite/driver/cpu_features.py
- − testsuite/driver/kill_extra_files.py
- testsuite/driver/testlib.py
- testsuite/mk/test.mk
- testsuite/tests/arrows/should_compile/T21301.stderr
- testsuite/tests/backpack/cabal/bkpcabal08/bkpcabal08.stdout
- + testsuite/tests/codeGen/should_fail/T26958.hs
- testsuite/tests/codeGen/should_fail/all.T
- testsuite/tests/codeGen/should_gen_asm/all.T
- + testsuite/tests/codeGen/should_gen_asm/avx512-int64-minmax.asm
- + testsuite/tests/codeGen/should_gen_asm/avx512-int64-minmax.hs
- + testsuite/tests/codeGen/should_gen_asm/avx512-int64-mul.asm
- + testsuite/tests/codeGen/should_gen_asm/avx512-int64-mul.hs
- + testsuite/tests/codeGen/should_gen_asm/avx512-word64-minmax.asm
- + testsuite/tests/codeGen/should_gen_asm/avx512-word64-minmax.hs
- testsuite/tests/codeGen/should_run/CgStaticPointers.hs
- testsuite/tests/codeGen/should_run/CgStaticPointersNoFullLazyness.hs
- testsuite/tests/count-deps/CountDepsAst.stdout
- testsuite/tests/count-deps/CountDepsParser.stdout
- testsuite/tests/deSugar/should_fail/DsStrictFail.stderr
- testsuite/tests/deSugar/should_run/T20024.stderr
- testsuite/tests/deSugar/should_run/dsrun005.stderr
- testsuite/tests/deSugar/should_run/dsrun007.stderr
- testsuite/tests/deSugar/should_run/dsrun008.stderr
- testsuite/tests/deriving/should_run/T9576.stderr
- testsuite/tests/driver/T20030/test1/all.T
- testsuite/tests/driver/T20030/test2/all.T
- testsuite/tests/driver/T20030/test3/all.T
- testsuite/tests/driver/T20030/test4/all.T
- testsuite/tests/driver/T20030/test5/all.T
- testsuite/tests/driver/T20030/test6/all.T
- testsuite/tests/driver/T4437.hs
- testsuite/tests/driver/T8526/T8526.script
- testsuite/tests/driver/bytecode-object/Makefile
- testsuite/tests/driver/bytecode-object/bytecode_object19.stdout
- testsuite/tests/driver/dynamicToo/dynamicToo001/Makefile
- testsuite/tests/driver/fat-iface/fat014.script
- testsuite/tests/driver/implicit-dyn-too/Makefile
- testsuite/tests/driver/multipleHomeUnits/all.T
- testsuite/tests/driver/multipleHomeUnits/multipleHomeUnits_recomp_th.stdout
- testsuite/tests/ffi/should_run/all.T
- testsuite/tests/ghc-api/annotations-literals/literals.stdout
- testsuite/tests/ghci.debugger/scripts/T26042b.stdout
- testsuite/tests/ghci.debugger/scripts/T26042c.stdout
- testsuite/tests/ghci.debugger/scripts/T26042d2.stdout
- testsuite/tests/ghci.debugger/scripts/T26042f2.stdout
- − testsuite/tests/ghci/linking/T11531.stderr
- testsuite/tests/ghci/prog018/prog018.script
- testsuite/tests/ghci/scripts/Defer02.stderr
- testsuite/tests/ghci/scripts/ListTuplePunsPpr.stdout
- testsuite/tests/ghci/scripts/T10963.stderr
- testsuite/tests/ghci/scripts/T13869.script
- testsuite/tests/ghci/scripts/T13997.script
- testsuite/tests/ghci/scripts/T15325.stderr
- testsuite/tests/ghci/scripts/T17669.script
- testsuite/tests/ghci/scripts/T18330.script
- testsuite/tests/ghci/scripts/T18330.stdout
- testsuite/tests/ghci/scripts/T1914.script
- testsuite/tests/ghci/scripts/T20150.stdout
- testsuite/tests/ghci/scripts/T20217.script
- testsuite/tests/ghci/scripts/T4175.stdout
- testsuite/tests/ghci/scripts/T6105.script
- testsuite/tests/ghci/scripts/T8042.script
- testsuite/tests/ghci/scripts/T8042recomp.script
- testsuite/tests/ghci/should_run/Makefile
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- testsuite/tests/interface-stability/base-exports.stdout-ws-32
- testsuite/tests/interface-stability/ghc-experimental-exports.stdout
- testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32
- testsuite/tests/interface-stability/ghc-prim-exports.stdout
- testsuite/tests/interface-stability/ghc-prim-exports.stdout-mingw32
- testsuite/tests/interface-stability/template-haskell-exports.stdout
- − 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/linters/regex-linters/check-rts-includes.py
- testsuite/tests/mdo/should_fail/mdofail006.stderr
- testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
- testsuite/tests/parser/should_compile/T14189.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/patsyn/should_run/ghci.stderr
- + testsuite/tests/plugins/T23110.hs
- + testsuite/tests/plugins/T23110.script
- + testsuite/tests/plugins/T23110.stdout
- testsuite/tests/plugins/all.T
- testsuite/tests/process/all.T
- + testsuite/tests/qualified-strings/Makefile
- + testsuite/tests/qualified-strings/should_compile/Example/Length.hs
- + testsuite/tests/qualified-strings/should_compile/all.T
- + testsuite/tests/qualified-strings/should_compile/qstrings_redundant_pattern.hs
- + testsuite/tests/qualified-strings/should_compile/qstrings_redundant_pattern.stderr
- + testsuite/tests/qualified-strings/should_fail/Example/Length.hs
- + testsuite/tests/qualified-strings/should_fail/Makefile
- + testsuite/tests/qualified-strings/should_fail/all.T
- + testsuite/tests/qualified-strings/should_fail/qstrings_bad_expr.hs
- + testsuite/tests/qualified-strings/should_fail/qstrings_bad_expr.stderr
- + testsuite/tests/qualified-strings/should_fail/qstrings_bad_pat.hs
- + testsuite/tests/qualified-strings/should_fail/qstrings_bad_pat.stderr
- + testsuite/tests/qualified-strings/should_fail/qstrings_multiline_no_ext.hs
- + testsuite/tests/qualified-strings/should_fail/qstrings_multiline_no_ext.stderr
- + testsuite/tests/qualified-strings/should_run/Example/ByteStringAscii.hs
- + testsuite/tests/qualified-strings/should_run/Example/ByteStringUtf8.hs
- + testsuite/tests/qualified-strings/should_run/Example/Text.hs
- + testsuite/tests/qualified-strings/should_run/Makefile
- + testsuite/tests/qualified-strings/should_run/all.T
- + testsuite/tests/qualified-strings/should_run/qstrings_expr.hs
- + testsuite/tests/qualified-strings/should_run/qstrings_expr.stdout
- + testsuite/tests/qualified-strings/should_run/qstrings_pat.hs
- + testsuite/tests/qualified-strings/should_run/qstrings_pat.stdout
- + testsuite/tests/qualified-strings/should_run/qstrings_th.hs
- + testsuite/tests/qualified-strings/should_run/qstrings_th.stdout
- testsuite/tests/quotes/LiftErrMsgDefer.stderr
- testsuite/tests/rename/should_fail/RnStaticPointersFail01.stderr
- testsuite/tests/rename/should_fail/RnStaticPointersFail03.stderr
- + testsuite/tests/rename/should_fail/T26545.hs
- + testsuite/tests/rename/should_fail/T26545.stderr
- testsuite/tests/rename/should_fail/all.T
- testsuite/tests/rts/T13676.script
- testsuite/tests/safeHaskell/safeLanguage/SafeLang15.stderr
- testsuite/tests/showIface/DocsInHiFile1.stdout
- testsuite/tests/showIface/HaddockSpanIssueT24378.stdout
- testsuite/tests/showIface/MagicHashInHaddocks.stdout
- testsuite/tests/simd/should_run/all.T
- testsuite/tests/simplCore/should_compile/T21391.hs
- + testsuite/tests/simplCore/should_compile/T26903.hs
- + testsuite/tests/simplCore/should_compile/T26903.stderr
- testsuite/tests/simplCore/should_compile/T8331.stderr
- testsuite/tests/simplCore/should_compile/all.T
- + testsuite/tests/th/T26098A_quote.hs
- + testsuite/tests/th/T26098A_splice.hs
- + testsuite/tests/th/T26098_local.hs
- + testsuite/tests/th/T26098_local.stderr
- + testsuite/tests/th/T26098_quote.hs
- + testsuite/tests/th/T26098_quote.stderr
- + testsuite/tests/th/T26098_splice.hs
- + testsuite/tests/th/T26098_splice.stderr
- testsuite/tests/th/all.T
- testsuite/tests/type-data/should_run/T22332a.stderr
- + testsuite/tests/typecheck/should_compile/T24464.hs
- testsuite/tests/typecheck/should_compile/all.T
- + testsuite/tests/typecheck/should_fail/T26861.hs
- + testsuite/tests/typecheck/should_fail/T26861.stderr
- testsuite/tests/typecheck/should_fail/all.T
- testsuite/tests/typecheck/should_run/T10284.stderr
- testsuite/tests/typecheck/should_run/T13838.stderr
- + testsuite/tests/typecheck/should_run/T16981.hs
- + testsuite/tests/typecheck/should_run/T16981.stdout
- + testsuite/tests/typecheck/should_run/T24773.hs
- + testsuite/tests/typecheck/should_run/T24773.stdout
- testsuite/tests/typecheck/should_run/T9497a-run.stderr
- testsuite/tests/typecheck/should_run/T9497b-run.stderr
- testsuite/tests/typecheck/should_run/T9497c-run.stderr
- testsuite/tests/typecheck/should_run/all.T
- testsuite/tests/unsatisfiable/T23816.stderr
- testsuite/tests/unsatisfiable/UnsatDefer.stderr
- testsuite/tests/warnings/should_fail/CaretDiagnostics1.stderr
- utils/check-exact/ExactPrint.hs
- utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cc.hs
- utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cpp.hs
- utils/haddock/doc/.gitignore
- utils/haddock/doc/Makefile
- + utils/haddock/doc/_static/haddock-custom.css
- utils/haddock/doc/conf.py
- utils/haddock/doc/markup.rst
- + utils/haddock/doc/snippets/.gitignore
- + utils/haddock/doc/snippets/Lists.hs
- + utils/haddock/doc/snippets/Makefile
- + utils/haddock/doc/snippets/Snippet-List-Bulleted.html
- + utils/haddock/doc/snippets/Snippet-List-Bulleted.tex
- + utils/haddock/doc/snippets/Snippet-List-Definition.html
- + utils/haddock/doc/snippets/Snippet-List-Definition.tex
- + utils/haddock/doc/snippets/Snippet-List-Enumerated.html
- + utils/haddock/doc/snippets/Snippet-List-Enumerated.tex
- + utils/haddock/doc/snippets/Snippet-List-Indentation.html
- + utils/haddock/doc/snippets/Snippet-List-Indentation.tex
- + utils/haddock/doc/snippets/Snippet-List-Multiline-Item.html
- + utils/haddock/doc/snippets/Snippet-List-Multiline-Item.tex
- + utils/haddock/doc/snippets/Snippet-List-Nested-Item.html
- + utils/haddock/doc/snippets/Snippet-List-Nested-Item.tex
- + utils/haddock/doc/snippets/Snippet-List-Not-Newline.html
- + utils/haddock/doc/snippets/Snippet-List-Not-Newline.tex
- + utils/haddock/doc/snippets/Snippet-List-Not-Separated.html
- + utils/haddock/doc/snippets/Snippet-List-Not-Separated.tex
- utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
- utils/haddock/haddock-api/src/Haddock/Interface/LexParseRn.hs
- utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs
- utils/haddock/haddock-api/src/Haddock/Types.hs
- utils/haddock/html-test/ref/A.html
- utils/haddock/html-test/ref/Bug1004.html
- utils/haddock/html-test/ref/Bug1033.html
- utils/haddock/html-test/ref/Bug1103.html
- utils/haddock/html-test/ref/Bug548.html
- utils/haddock/html-test/ref/Bug923.html
- utils/haddock/html-test/ref/ConstructorPatternExport.html
- utils/haddock/html-test/ref/FunArgs.html
- utils/haddock/html-test/ref/Hash.html
- utils/haddock/html-test/ref/Instances.html
- utils/haddock/html-test/ref/LinearTypes.html
- utils/haddock/html-test/ref/RedactTypeSynonyms.html
- utils/haddock/html-test/ref/T23616.html
- utils/haddock/html-test/ref/Test.html
- utils/haddock/html-test/ref/TypeFamilies3.html
- utils/jsffi/dyld.mjs
- utils/jsffi/post-link.mjs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1cb47b6d07c34006ec64be7c364d19…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1cb47b6d07c34006ec64be7c364d19…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[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