[Git][ghc/ghc][wip/fendor/linkable-usage] Fix LinkableUsage02 test
by Matthew Pickering (＠mpickering) 19 Mar '26
by Matthew Pickering (＠mpickering) 19 Mar '26
19 Mar '26
Matthew Pickering pushed to branch wip/fendor/linkable-usage at Glasgow Haskell Compiler / GHC
Commits:
6656b289 by Matthew Pickering at 2026-03-19T11:40:56+00:00
Fix LinkableUsage02 test
- - - - -
2 changed files:
- testsuite/tests/bytecode/TLinkable/LinkableUsage02.stderr
- testsuite/tests/bytecode/TLinkable/all.T
Changes:
=====================================
testsuite/tests/bytecode/TLinkable/LinkableUsage02.stderr
=====================================
@@ -1,21 +1,21 @@
-[ 1 of 21] Compiling Module001 ( Module001.hs, Module001.o, Module001.gbc )
-[ 2 of 21] Compiling Module002 ( Module002.hs, Module002.o, Module002.gbc )
-[ 3 of 21] Compiling Module003 ( Module003.hs, Module003.o, Module003.gbc )
-[ 4 of 21] Compiling Module004 ( Module004.hs, Module004.o, Module004.gbc )
-[ 5 of 21] Compiling Module005 ( Module005.hs, Module005.o, Module005.gbc )
-[ 6 of 21] Compiling Module006 ( Module006.hs, Module006.o, Module006.gbc )
-[ 7 of 21] Compiling Module007 ( Module007.hs, Module007.o, Module007.gbc )
-[ 8 of 21] Compiling Module008 ( Module008.hs, Module008.o, Module008.gbc )
-[ 9 of 21] Compiling Module009 ( Module009.hs, Module009.o, Module009.gbc )
-[10 of 21] Compiling Module010 ( Module010.hs, Module010.o, Module010.gbc )
-[11 of 21] Compiling Module011 ( Module011.hs, Module011.o, Module011.gbc )
-[12 of 21] Compiling Module012 ( Module012.hs, Module012.o, Module012.gbc )
-[13 of 21] Compiling Module013 ( Module013.hs, Module013.o, Module013.gbc )
-[14 of 21] Compiling Module014 ( Module014.hs, Module014.o, Module014.gbc )
-[15 of 21] Compiling Module015 ( Module015.hs, Module015.o, Module015.gbc )
-[16 of 21] Compiling Module016 ( Module016.hs, Module016.o, Module016.gbc )
-[17 of 21] Compiling Module017 ( Module017.hs, Module017.o, Module017.gbc )
-[18 of 21] Compiling Module018 ( Module018.hs, Module018.o, Module018.gbc )
-[19 of 21] Compiling Module019 ( Module019.hs, Module019.o, Module019.gbc )
-[20 of 21] Compiling Module020 ( Module020.hs, Module020.o, Module020.gbc )
-[21 of 21] Compiling LinkableUsage02 ( LinkableUsage02.hs, LinkableUsage02.o )
+[ 1 of 21] Compiling Module001 ( Module001.hs, Module001.gbc )
+[ 2 of 21] Compiling Module002 ( Module002.hs, Module002.gbc )
+[ 3 of 21] Compiling Module003 ( Module003.hs, Module003.gbc )
+[ 4 of 21] Compiling Module004 ( Module004.hs, Module004.gbc )
+[ 5 of 21] Compiling Module005 ( Module005.hs, Module005.gbc )
+[ 6 of 21] Compiling Module006 ( Module006.hs, Module006.gbc )
+[ 7 of 21] Compiling Module007 ( Module007.hs, Module007.gbc )
+[ 8 of 21] Compiling Module008 ( Module008.hs, Module008.gbc )
+[ 9 of 21] Compiling Module009 ( Module009.hs, Module009.gbc )
+[10 of 21] Compiling Module010 ( Module010.hs, Module010.gbc )
+[11 of 21] Compiling Module011 ( Module011.hs, Module011.gbc )
+[12 of 21] Compiling Module012 ( Module012.hs, Module012.gbc )
+[13 of 21] Compiling Module013 ( Module013.hs, Module013.gbc )
+[14 of 21] Compiling Module014 ( Module014.hs, Module014.gbc )
+[15 of 21] Compiling Module015 ( Module015.hs, Module015.gbc )
+[16 of 21] Compiling Module016 ( Module016.hs, Module016.gbc )
+[17 of 21] Compiling Module017 ( Module017.hs, Module017.gbc )
+[18 of 21] Compiling Module018 ( Module018.hs, Module018.gbc )
+[19 of 21] Compiling Module019 ( Module019.hs, Module019.gbc )
+[20 of 21] Compiling Module020 ( Module020.hs, Module020.gbc )
+[21 of 21] Compiling LinkableUsage02 ( LinkableUsage02.hs, LinkableUsage02.gbc )
=====================================
testsuite/tests/bytecode/TLinkable/all.T
=====================================
@@ -21,7 +21,7 @@ test('LinkableUsage02'
, req_th
]
, multimod_compile
- , ['LinkableUsage02', '-fwrite-byte-code -fprefer-byte-code'])
+ , ['LinkableUsage02', '-no-link -fbyte-code -fwrite-byte-code -fprefer-byte-code'])
test('linkable-space'
, [ extra_files(['genLinkables.sh', 'BCOTemplate.hs'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6656b28940377c83fbb0f5e292eb9dd…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6656b28940377c83fbb0f5e292eb9dd…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/spj-reinstallable-base] Onward [skip ci]
by Simon Peyton Jones (＠simonpj) 19 Mar '26
by Simon Peyton Jones (＠simonpj) 19 Mar '26
19 Mar '26
Simon Peyton Jones pushed to branch wip/spj-reinstallable-base at Glasgow Haskell Compiler / GHC
Commits:
e65c697c by Simon Peyton Jones at 2026-03-19T00:05:50+00:00
Onward [skip ci]
- - - - -
9 changed files:
- compiler/GHC/Builtin/Names.hs
- compiler/GHC/Builtin/Names/TH.hs
- compiler/GHC/Builtin/Utils.hs
- compiler/GHC/Iface/Binary.hs
- compiler/GHC/Iface/Load.hs
- compiler/GHC/Tc/Module.hs
- compiler/GHC/Types/Name.hs
- libraries/ghc-internal/src/GHC/Internal/Base.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Lift.hs
Changes:
=====================================
compiler/GHC/Builtin/Names.hs
=====================================
@@ -129,7 +129,9 @@ import GHC.Unit.Types
import GHC.Types.Name.Occurrence
import GHC.Types.Name.Reader
import GHC.Types.Unique
+import GHC.Types.Unique.FM
import GHC.Builtin.Uniques
+import GHC.Builtin.Names.TH( thKnownKeyTable )
import GHC.Types.Name
import GHC.Types.SrcLoc
import GHC.Data.FastString
@@ -156,7 +158,7 @@ allNameStringList = Inf.toList allNameStrings
{-
************************************************************************
-* *
+o* *
\subsection{Local Names}
* *
************************************************************************
@@ -187,6 +189,14 @@ names with uniques. These ones are the *non* wired-in ones. The
wired in ones are defined in GHC.Builtin.Types etc.
-}
+-- | `knownKeyOccMap` maps the OccName of a known-key to its Unique
+knownKeyOccMap :: OccEnv KnownKeyNameKey
+knownKeyOccMap = mkOccEnv (basicKnownKeyTable ++ thKnownKeyTable)
+
+knownKeyUniqMap :: UniqFM KnownKeyNameKey OccName
+knownKeyUniqMap = listToUFM [ (uniq, occ)
+ | (occ, uniq) <- basicKnownKeyTable ++ thKnownKeyTable ]
+
basicKnownKeyTable :: [(OccName, KnownKeyNameKey)]
basicKnownKeyTable
= [ (mkTcOcc "Rational", rationalTyConKey)
@@ -1604,11 +1614,6 @@ tcQual modu str unique = mk_known_key_name tcName modu str unique
clsQual modu str unique = mk_known_key_name clsName modu str unique
dcQual modu str unique = mk_known_key_name dataName modu str unique
-mk_known_key_name :: NameSpace -> Module -> FastString -> KnownKeyNameKey -> Name
-{-# INLINE mk_known_key_name #-}
-mk_known_key_name space modu str unique
- = mkExternalName unique modu (mkOccNameFS space str) noSrcSpan
-
{-
************************************************************************
=====================================
compiler/GHC/Builtin/Names/TH.hs
=====================================
@@ -8,9 +8,8 @@ module GHC.Builtin.Names.TH where
import GHC.Prelude ()
-import GHC.Builtin.Names( mk_known_key_name )
import GHC.Unit.Types
-import GHC.Types.Name( Name )
+import GHC.Types.Name( Name, mk_known_key_name )
import GHC.Types.Name.Occurrence( OccName, tcName, clsName, dataName, varName, fieldName )
import GHC.Types.Name.Reader( RdrName, nameRdrName )
import GHC.Types.Unique ( Unique )
=====================================
compiler/GHC/Builtin/Utils.hs
=====================================
@@ -19,16 +19,15 @@
--
module GHC.Builtin.Utils (
-- * Known-key names
- isKnownKeyName,
- lookupKnownKeyName,
- lookupKnownNameInfo,
+ oldIsKnownKeyName,
+ oldLookupKnownKeyName,
+ oldLookupKnownNameInfo,
-- ** Internal use
-- | 'knownKeyNames' is exported to seed the original name cache only;
-- if you find yourself wanting to look at it you might consider using
-- 'lookupKnownKeyName' or 'isKnownKeyName'.
knownKeyNames,
- knownKeyOccMap, knownKeyUniqMap,
-- * Miscellaneous
wiredInIds, ghcPrimIds,
@@ -54,7 +53,7 @@ import GHC.Builtin.PrimOps.Ids
import GHC.Builtin.Types
import GHC.Builtin.Types.Literals ( typeNatTyCons )
import GHC.Builtin.Types.Prim
-import GHC.Builtin.Names.TH ( templateHaskellNames, thKnownKeyTable )
+import GHC.Builtin.Names.TH ( templateHaskellNames )
import GHC.Builtin.Names
import GHC.Core.ConLike ( ConLike(..) )
@@ -193,38 +192,34 @@ knownKeyNamesOkay all_names
text ": " <>
brackets (pprWithCommas (ppr . nameOccName) ns)
+--------------- ToDo: get rid of these old-mechanism functions
+--------------- when we complete the known-key tranitition
+-------------- See #27013
+
-- | Given a 'Unique' lookup its associated 'Name' if it corresponds to a
-- known-key thing.
-lookupKnownKeyName :: Unique -> Maybe Name
-lookupKnownKeyName u =
- knownUniqueName u <|> lookupUFM_Directly knownKeysMap u
+oldLookupKnownKeyName :: Unique -> Maybe Name
+oldLookupKnownKeyName u =
+ knownUniqueName u <|> lookupUFM_Directly oldKnownKeysMap u
-- TODO: remove this once all knownkey names come from providers
-- | Is a 'Name' known-key?
-isKnownKeyName :: Name -> Bool
-isKnownKeyName n =
- isJust (knownUniqueName $ nameUnique n) || elemUFM n knownKeysMap
-
--- | `knownKeyOccMap` maps the OccName of a known-key to its Unique
-knownKeyOccMap :: OccEnv Unique
-knownKeyOccMap = mkOccEnv (basicKnownKeyTable ++ thKnownKeyTable)
-
-knownKeyUniqMap :: UniqFM Unique OccName
-knownKeyUniqMap = listToUFM [ (uniq, occ)
- | (occ, uniq) <- basicKnownKeyTable ++ thKnownKeyTable ]
+oldIsKnownKeyName :: Name -> Bool
+oldIsKnownKeyName n =
+ isJust (knownUniqueName $ nameUnique n) || elemUFM n oldKnownKeysMap
-- | Maps 'Unique's to known-key names.
--
-- The type is @UniqFM Name Name@ to denote that the 'Unique's used
-- in the domain are 'Unique's associated with 'Name's (as opposed
-- to some other namespace of 'Unique's).
-knownKeysMap :: UniqFM Name Name
-knownKeysMap = listToIdentityUFM knownKeyNames
+oldKnownKeysMap :: UniqFM Name Name
+oldKnownKeysMap = listToIdentityUFM knownKeyNames
-- | Given a 'Unique' lookup any associated arbitrary SDoc's to be displayed by
-- GHCi's ':info' command.
-lookupKnownNameInfo :: Name -> SDoc
-lookupKnownNameInfo name = case lookupNameEnv knownNamesInfo name of
+oldLookupKnownNameInfo :: Name -> SDoc
+oldLookupKnownNameInfo name = case lookupNameEnv knownNamesInfo name of
-- If we do find a doc, we add comment delimiters to make the output
-- of ':info' valid Haskell.
Nothing -> empty
=====================================
compiler/GHC/Iface/Binary.hs
=====================================
@@ -32,8 +32,8 @@ module GHC.Iface.Binary (
import GHC.Prelude
-import GHC.Builtin.Utils ( knownKeyOccMap, isKnownKeyName, lookupKnownKeyName )
-
+import GHC.Builtin.Utils ( oldIsKnownKeyName, oldLookupKnownKeyName )
+import GHC.Builtin.Names ( knownKeyOccMap )
import GHC.Utils.Panic
import GHC.Utils.Binary as Binary
import GHC.Utils.Outputable
@@ -725,7 +725,7 @@ putName BinSymbolTable{
bin_symtab_map = symtab_map_ref,
bin_symtab_next = symtab_next }
bh name
- | isKnownKeyName name
+ | oldIsKnownKeyName name
, let (c, u) = unpkUniqueGrimly (nameUnique name) -- INVARIANT: (ord c) fits in 8 bits
= -- assert (u < 2^(22 :: Int))
put_ bh (0x80000000
@@ -758,7 +758,7 @@ getSymtabName symtab bh = do
ix = fromIntegral i .&. 0x003FFFFF
u = mkUniqueGrimilyWithTag tag ix
in
- return $! case lookupKnownKeyName u of
+ return $! case oldLookupKnownKeyName u of
Nothing -> pprPanic "getSymtabName:unknown known-key unique"
(ppr i $$ ppr u $$ char tag $$ ppr ix)
Just n -> n
=====================================
compiler/GHC/Iface/Load.hs
=====================================
@@ -16,7 +16,8 @@ module GHC.Iface.Load (
-- Importing one thing
importDecl,
checkWiredInTyCon, ifCheckWiredInThing,
- lookupKnownKeyThing, loadGlobalName,
+ lookupKnownKeyThing, lookupKnownKeyName,
+ loadGlobalName,
-- RnM/TcM functions
loadModuleInterface, loadModuleInterfaces,
@@ -63,6 +64,9 @@ import GHC.Iface.Rename
import GHC.Iface.Env
import GHC.Iface.Errors as Iface_Errors
+import GHC.Rename.Env( addUsedGRE )
+import GHC.Rename.Utils( DeprecationWarnings(..) )
+
import GHC.Tc.Errors.Types
import GHC.Tc.Utils.Monad
@@ -134,9 +138,16 @@ import qualified GHC.Unit.Home.Graph as HUG
********************************************************************* -}
lookupKnownKeyThing :: HasDebugCallStack
- => Maybe GlobalRdrEnv -> Unique
+ => Maybe GlobalRdrEnv -> KnownKeyNameKey
-> IfM lcl (MaybeErr IfaceMessage TyThing)
-lookupKnownKeyThing Nothing uniq
+lookupKnownKeyThing mb_gbl_rdr_env key
+ = do { name <- lookupKnownKeyName mb_gbl_rdr_env key
+ ; lookupGlobalName name }
+
+lookupKnownKeyName :: HasDebugCallStack
+ => Maybe GlobalRdrEnv -> KnownKeyNameKey
+ -> IfM lcl Name
+lookupKnownKeyName Nothing uniq
= do { known_key_name_map <- loadKnownKeyOccMap
; let name = lookupUFM known_key_name_map uniq
`orElse` pprPanic "lookupKnownKeyThing 1"
@@ -144,17 +155,23 @@ lookupKnownKeyThing Nothing uniq
, text "occ-map" <+> ppr known_key_name_map ])
; traceIf $ hang (text "lookupKnownKeyThing ImplicitKnownKeyNames")
2 (ppr name <+> ppr uniq)
- ; lookupGlobalName name }
+ ; return name }
-lookupKnownKeyThing (Just gbl_rdr_env) uniq
- -- Look up the known-key OccName in the current top-level GlobalRdrEnv
+lookupKnownKeyName (Just gbl_rdr_env) uniq
+ -- Just gbl_rdr_env: we have -frebindable-known-key-names on, and
+ -- here is the top-level GlobalRdrEnv
+ -- Look up the known-key OccName in the GlobalRdrEnv
-- If we get a unique hit, use it; if not, panic.
= case lookupGRE gbl_rdr_env (LookupOccName occ SameNameSpace) of
[gre] -> do { let name = greName gre
+ ; addUsedGRE NoDeprecationWarnings gre
+ -- addUseGRE: don't complain about unused imports
+ -- of known-key names when -frebindable-known-key-names
; traceIf $ hang (text "lookupKnownKeyThing NoImplicitKnownKeyNames")
2 (ppr name <+> ppr uniq)
- ; lookupGlobalName name }
- gres -> pprPanic "lookupKnownKeyOcc" (ppr occ $$ ppr gres)
+ ; return name }
+ [] -> pprPanic "lookupKnownKeyOcc: known-key name is not in scope" (ppr occ)
+ gres -> pprPanic "lookupKnownKeyOcc: known-key name is ambiguously in scope" (ppr gres)
where
occ = lookupUFM knownKeyUniqMap uniq
`orElse` pprPanic "lookupKnownKeyThing 2"
=====================================
compiler/GHC/Tc/Module.hs
=====================================
@@ -2960,7 +2960,7 @@ tcRnGetInfo hsc_env name
; thing <- tcRnLookupName' name
; fixity <- lookupFixityRn name
; (cls_insts, fam_insts) <- lookupInsts thing
- ; let info = lookupKnownNameInfo name
+ ; let info = oldLookupKnownNameInfo name
; return (thing, fixity, cls_insts, fam_insts, info) }
=====================================
compiler/GHC/Types/Name.hs
=====================================
@@ -50,6 +50,8 @@ module GHC.Types.Name (
mkFCallName,
mkExternalName, mkWiredInName, mkKnownKeyName,
+ mk_known_key_name, -- Temporary. ToDo: get rid of me #27013
+
-- ** Manipulating and deconstructing 'Name's
nameUnique, setNameUnique,
nameOccName, nameNameSpace, nameModule, nameModule_maybe, extNamePieces,
@@ -161,15 +163,28 @@ To implement all this, here are the moving parts:
eqClassKey = mkPreludeClassUnique 3
* All the known-key names are gathered in one table:
- basicKnownKeyTable :: [(OccName, KnownKeyNameKey)]
- basicKnownKeyTable
- = [ (mkTcOcc "Rational", rationalTyConKey)
- , (mkTcOcc "Eq", eqClassKey)
- ... etc ...
+ basicKnownKeyTable :: [(OccName, KnownKeyNameKey)]
+ basicKnownKeyTable
+ = [ (mkTcOcc "Rational", rationalTyConKey)
+ , (mkTcOcc "Eq", eqClassKey)
+ ... etc ...
+
+ INVARIANT (KnownKeyInvariant): It is a requirement that all known-key names
+ have distinct OccNames. (We could have multiple name-spaces, but in practice
+ this is not an onerous restriction.)
+
+* Because of (KnownKeyInvariant) we can turn that table into two mappings:
+
+ knownKeyOccMap :: OccEnv KnownKeyNameKey
+ knownKeyOccMap = mkOccEnv (basicKnownKeyTable ++ thKnownKeyTable)
-* INVARIANT: It is a requirement that all known-key names have distinct
- OccNames. (We could have multiple name-spaces, but in practice this is not an
- onerous restriction.)
+ knownKeyUniqMap :: UniqFM KnownKeyNameKey OccName
+
+* There are two flags that control the treatment of known-key names:
+ -frebindable-known-key-names
+ -fdefines-known-key-names
+
+* When processing source code, /without/ -frebindable
Note [About the NameSorts]
~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -360,6 +375,14 @@ hasKnownKey :: Uniquable a => a -> KnownKeyNameKey -> Bool
-- See if a thing has a particular known key
hasKnownKey = hasKey
+-- ToDo: get rid of this function when we complete the known-key name transition
+-- see #27013
+mk_known_key_name :: NameSpace -> Module -> FastString -> KnownKeyNameKey -> Name
+{-# INLINE mk_known_key_name #-}
+mk_known_key_name space modu str unique
+ = mkExternalName unique modu (mkOccNameFS space str) noSrcSpan
+
+
{- *********************************************************************
* *
=====================================
libraries/ghc-internal/src/GHC/Internal/Base.hs
=====================================
@@ -82,6 +82,9 @@ Other Prelude modules are much easier with fewer complex dependencies.
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE Unsafe #-}
+{-# OPTIONS_GHC -fdefines-known-key-names #-}
+ -- Defines Monad
+
-- -Wno-orphans is needed for things like:
-- Orphan rule: "x# -# x#" ALWAYS forall x# :: Int# -# x# x# = 0
{-# OPTIONS_GHC -Wno-orphans #-}
=====================================
libraries/ghc-internal/src/GHC/Internal/TH/Lift.hs
=====================================
@@ -31,7 +31,9 @@ module GHC.Internal.TH.Lift
import GHC.Internal.TH.Syntax
import GHC.Internal.TH.Monad
-import qualified GHC.Internal.TH.Lib as Lib (litE) -- See wrinkle (W4) of Note [Tracking dependencies on primitives]
+import qualified GHC.Internal.TH.Lib as Lib (litE)
+ -- See wrinkle (W4) of Note [Tracking dependencies on primitives]
+import GHC.Internal.Base( Monad ) -- Needed for known-key lookup
import GHC.Internal.Data.Either
import GHC.Internal.Base (String, Void, map, mapM, ord, return, (.))
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e65c697c3dc0d98e5a4df391e55dda3…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e65c697c3dc0d98e5a4df391e55dda3…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/ani/tc-expand] making HsExpansion a new datatype
by Apoorv Ingle (＠ani) 19 Mar '26
by Apoorv Ingle (＠ani) 19 Mar '26
19 Mar '26
Apoorv Ingle pushed to branch wip/ani/tc-expand at Glasgow Haskell Compiler / GHC
Commits:
25625e1e by Apoorv Ingle at 2026-03-18T18:17:17-05:00
making HsExpansion a new datatype
- - - - -
17 changed files:
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Hs/Instances.hs
- compiler/GHC/Hs/Syn/Type.hs
- compiler/GHC/HsToCore/Expr.hs
- compiler/GHC/HsToCore/Match.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/HsToCore/Ticks.hs
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/Rename/Utils.hs
- compiler/GHC/Tc/Gen/App.hs
- compiler/GHC/Tc/Gen/Do.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Gen/Head.hs
- compiler/GHC/Tc/Types/Origin.hs
- compiler/GHC/Tc/Utils/Monad.hs
- compiler/GHC/Tc/Utils/Unify.hs
- compiler/GHC/Tc/Zonk/Type.hs
Changes:
=====================================
compiler/GHC/Hs/Expr.hs
=====================================
@@ -660,10 +660,14 @@ type instance XXExpr GhcTc = XXExprGhcTc
* *
********************************************************************* -}
+-- See Note [Rebindable syntax and XXExprGhcRn]
+-- See Note [Expanding HsDo with XXExprGhcRn] in `GHC.Tc.Gen.Do`
+data HsExpansion p = HSE { hs_ctxt :: HsCtxt -- The original source thing context to be used for error messages
+ , expanded_expr :: LHsExpr p } -- The compiler generated, expanded expression
+ -- This is located because of do statements (TODO ANI : Add Note)
+
data XXExprGhcRn
- = ExpandedThingRn { xrn_orig :: HsCtxt -- The original source thing context to be used for error messages
- , xrn_expanded :: LHsExpr GhcRn } -- The compiler generated, expanded thing
- -- This is located because of do statements (TODO ANI : Add Note)
+ = ExpandedThingRn (HsExpansion GhcRn) -- ^ Renamed/Pre Typecheck expanded expression
| HsRecSelRn (FieldOcc GhcRn) -- ^ Variable pointing to record selector
-- See Note [Non-overloaded record field selectors] and
@@ -673,11 +677,7 @@ data XXExprGhcTc
= WrapExpr -- Type and evidence application and abstractions
HsWrapper (HsExpr GhcTc)
- | ExpandedThingTc -- See Note [Rebindable syntax and XXExprGhcRn]
- -- See Note [Expanding HsDo with XXExprGhcRn] in `GHC.Tc.Gen.Do`
- { xtc_orig :: HsCtxt -- The original user written thing
- , xtc_expanded :: LHsExpr GhcTc } -- The expanded typechecked expression
- -- This is located because of do statements (TODO ANI: Add NOTE)
+ | ExpandedThingTc (HsExpansion GhcTc) -- ^ Typechecked expanded expression
| ConLikeTc
-- ^ A 'ConLike', either a data constructor or pattern synonym
@@ -1019,9 +1019,15 @@ ppr_expr (XExpr x) = case ghcPass @p of
GhcRn -> ppr x
GhcTc -> ppr x
-instance Outputable XXExprGhcRn where
- ppr (HsRecSelRn f) = pprPrefixOcc f
- ppr (ExpandedThingRn o e) = ifPprDebug (braces $ vcat [pprCtxt o, text ";;" , ppr e]) (pprCtxt o)
+
+ppr_hse :: forall p. (IsPass p) => HsExpansion (GhcPass p) -> SDoc
+ppr_hse hse
+ = case ghcPass @p of
+ GhcPs -> empty
+ GhcRn -> case hse of
+ HSE o e -> ifPprDebug (braces $ vcat [pprCtxt o, text ";;" , ppr e]) (pprCtxt o)
+ GhcTc -> case hse of
+ HSE o e -> ifPprDebug (braces $ vcat [pprCtxt o, text ";;" , ppr e]) (pprCtxt o)
where
ppr_builder prefix x = ifPprDebug (braces (text prefix <+> parens x)) x
pprCtxt :: HsCtxt -> SDoc
@@ -1031,26 +1037,17 @@ instance Outputable XXExprGhcRn where
pprCtxt (FunAppCtxt (FunAppCtxtExpr _ e) _) = ppr_builder "<FunAppCtxt>:" (ppr e)
pprCtxt _ = ppr_builder "<MiscHsCtxt>:" empty
+instance Outputable XXExprGhcRn where
+ ppr (HsRecSelRn f) = pprPrefixOcc f
+ ppr (ExpandedThingRn hse) = ppr_hse hse
+
+
instance Outputable XXExprGhcTc where
ppr (WrapExpr co_fn e)
= pprHsWrapper co_fn (\_parens -> pprExpr e)
- ppr (ExpandedThingTc o e)
- = ifPprDebug (braces $ vcat [pprCtxt o, ppr e]) (pprCtxt o)
-
- where
- ppr_builder prefix x = ifPprDebug (braces (text prefix <+> parens x)) x
- pprCtxt :: HsCtxt -> SDoc
- pprCtxt (ExprCtxt e) = ppr_builder "<OrigExpr>:" (ppr e)
- pprCtxt (StmtErrCtxt _ stmt) = ppr_builder "<OrigStmt>:" (ppr stmt)
- pprCtxt (StmtErrCtxtPat pat) = ppr_builder "<OrigPat>:" (ppr pat)
- pprCtxt (FunAppCtxt (FunAppCtxtExpr _ e) _) = ppr_builder "<FunAppCtxt>:" (ppr e)
- pprCtxt _ = ppr_builder "<MiscHsCtxt>:" empty
-
- -- e is the expanded expression, we print the original
- -- expression (HsExpr GhcRn), not the
- -- expanded typechecked one (HsExpr GhcTc),
- -- unless we are in ppr's debug mode printed both
+ ppr (ExpandedThingTc hse)
+ = ppr_hse hse
ppr (ConLikeTc con) = pprPrefixOcc con
-- Used in error messages generated by
@@ -1083,12 +1080,12 @@ ppr_infix_expr (XExpr x) = case ghcPass @p of
ppr_infix_expr _ = Nothing
ppr_infix_expr_rn :: XXExprGhcRn -> Maybe SDoc
-ppr_infix_expr_rn (ExpandedThingRn thing _) = ppr_infix_hs_expansion thing
+ppr_infix_expr_rn (ExpandedThingRn (HSE thing _)) = ppr_infix_hs_expansion thing
ppr_infix_expr_rn (HsRecSelRn f) = Just (pprInfixOcc f)
ppr_infix_expr_tc :: XXExprGhcTc -> Maybe SDoc
ppr_infix_expr_tc (WrapExpr _ e) = ppr_infix_expr e
-ppr_infix_expr_tc (ExpandedThingTc thing _) = ppr_infix_hs_expansion thing
+ppr_infix_expr_tc (ExpandedThingTc (HSE thing _)) = ppr_infix_hs_expansion thing
ppr_infix_expr_tc (ConLikeTc con) = Just (pprInfixOcc (conLikeName con))
ppr_infix_expr_tc (HsTick {}) = Nothing
ppr_infix_expr_tc (HsBinTick {}) = Nothing
@@ -1176,14 +1173,14 @@ hsExprNeedsParens prec = go
go_x_tc :: XXExprGhcTc -> Bool
go_x_tc (WrapExpr _ e) = hsExprNeedsParens prec e
- go_x_tc (ExpandedThingTc thing _) = hsExpandedNeedsParens thing
+ go_x_tc (ExpandedThingTc (HSE thing _)) = hsExpandedNeedsParens thing
go_x_tc (ConLikeTc {}) = False
go_x_tc (HsTick _ (L _ e)) = hsExprNeedsParens prec e
go_x_tc (HsBinTick _ _ (L _ e)) = hsExprNeedsParens prec e
go_x_tc (HsRecSelTc{}) = False
go_x_rn :: XXExprGhcRn -> Bool
- go_x_rn (ExpandedThingRn thing _ ) = hsExpandedNeedsParens thing
+ go_x_rn (ExpandedThingRn (HSE thing _)) = hsExpandedNeedsParens thing
go_x_rn (HsRecSelRn{}) = False
hsExpandedNeedsParens :: HsCtxt -> Bool
@@ -1228,14 +1225,14 @@ isAtomicHsExpr (XExpr x)
where
go_x_tc :: XXExprGhcTc -> Bool
go_x_tc (WrapExpr _ e) = isAtomicHsExpr e
- go_x_tc (ExpandedThingTc thing _) = isAtomicExpandedThingRn thing
+ go_x_tc (ExpandedThingTc (HSE thing _)) = isAtomicExpandedThingRn thing
go_x_tc (ConLikeTc {}) = True
go_x_tc (HsTick {}) = False
go_x_tc (HsBinTick {}) = False
go_x_tc (HsRecSelTc{}) = True
go_x_rn :: XXExprGhcRn -> Bool
- go_x_rn (ExpandedThingRn thing _) = isAtomicExpandedThingRn thing
+ go_x_rn (ExpandedThingRn (HSE thing _)) = isAtomicExpandedThingRn thing
go_x_rn (HsRecSelRn{}) = True
isAtomicExpandedThingRn :: HsCtxt -> Bool
=====================================
compiler/GHC/Hs/Instances.hs
=====================================
@@ -647,6 +647,9 @@ instance Data HsCtxt where
deriving instance Data XXExprGhcRn
+deriving instance Data (HsExpansion GhcRn)
+deriving instance Data (HsExpansion GhcTc)
+
deriving instance Data a => Data (WithUserRdr a)
-- -------------------------------
=====================================
compiler/GHC/Hs/Syn/Type.hs
=====================================
@@ -153,7 +153,7 @@ hsExprType (HsQual x _ _) = dataConCantHappen x
hsExprType (HsForAll x _ _) = dataConCantHappen x
hsExprType (HsFunArr x _ _ _) = dataConCantHappen x
hsExprType (XExpr (WrapExpr wrap e)) = hsWrapperType wrap $ hsExprType e
-hsExprType (XExpr (ExpandedThingTc _ e)) = lhsExprType e
+hsExprType (XExpr (ExpandedThingTc (HSE _ e))) = lhsExprType e
hsExprType (XExpr (ConLikeTc con)) = conLikeType con
hsExprType (XExpr (HsTick _ e)) = lhsExprType e
hsExprType (XExpr (HsBinTick _ _ e)) = lhsExprType e
=====================================
compiler/GHC/HsToCore/Expr.hs
=====================================
@@ -307,7 +307,7 @@ dsExpr e@(XExpr ext_expr_tc)
WrapExpr {} -> dsApp e
ConLikeTc {} -> dsApp e
- ExpandedThingTc _ e -> dsLExpr e
+ ExpandedThingTc (HSE _ e) -> dsLExpr e
-- Hpc Support
HsTick tickish e -> do
=====================================
compiler/GHC/HsToCore/Match.hs
=====================================
@@ -1166,7 +1166,7 @@ viewLExprEq (e1,_) (e2,_) = lexp e1 e2
-- we have to compare the wrappers
exp (XExpr (WrapExpr h e)) (XExpr (WrapExpr h' e')) =
wrap h h' && exp e e'
- exp (XExpr (ExpandedThingTc _ x)) (XExpr (ExpandedThingTc _ x'))
+ exp (XExpr (ExpandedThingTc (HSE _ x))) (XExpr (ExpandedThingTc (HSE _ x')))
= lexp x x'
exp (HsVar _ i) (HsVar _ i') = i == i'
exp (HsIPVar _ i) (HsIPVar _ i') =
=====================================
compiler/GHC/HsToCore/Quote.hs
=====================================
@@ -1735,7 +1735,7 @@ repE (HsFunArr _ mult arg res) = do
arg' <- repLE arg
res' <- repLE res
repApps fun [arg', res']
-repE e@(XExpr (ExpandedThingRn o x))
+repE e@(XExpr (ExpandedThingRn (HSE o x)))
| ExprCtxt e <- o
= do { rebindable_on <- lift $ xoptM LangExt.RebindableSyntax
; if rebindable_on -- See Note [Quotation and rebindable syntax]
=====================================
compiler/GHC/HsToCore/Ticks.hs
=====================================
@@ -415,7 +415,7 @@ addTickLHsExpr e@(L pos e0) = do
d <- getDensity
case d of
TickForBreakPoints | isGoodBreakExpr e0 -> tick_it
- TickForCoverage | XExpr (ExpandedThingTc StmtErrCtxt{} _) <- e0 -- expansion ticks are handled separately
+ TickForCoverage | XExpr (ExpandedThingTc (HSE StmtErrCtxt{} _)) <- e0 -- expansion ticks are handled separately
-> dont_tick_it
| otherwise -> tick_it
TickCallSites | isCallSite e0 -> tick_it
@@ -484,14 +484,14 @@ addTickLHsExprNever (L pos e0) = do
-- General heuristic: expressions which are calls (do not denote
-- values) are good break points.
isGoodBreakExpr :: HsExpr GhcTc -> Bool
-isGoodBreakExpr (XExpr (ExpandedThingTc (StmtErrCtxt{}) _)) = False
+isGoodBreakExpr (XExpr (ExpandedThingTc (HSE StmtErrCtxt{} _))) = False
isGoodBreakExpr e = isCallSite e
isCallSite :: HsExpr GhcTc -> Bool
isCallSite HsApp{} = True
isCallSite HsAppType{} = True
isCallSite HsCase{} = True
-isCallSite (XExpr (ExpandedThingTc _ e))
+isCallSite (XExpr (ExpandedThingTc (HSE _ e)))
= isCallSite (unLoc e)
-- NB: OpApp, SectionL, SectionR are all expanded out
@@ -637,7 +637,7 @@ addTickHsExpr (HsProc x pat cmdtop) =
addTickHsExpr (XExpr (WrapExpr w e)) =
liftM (XExpr . WrapExpr w) $
(addTickHsExpr e) -- Explicitly no tick on inside
-addTickHsExpr (XExpr (ExpandedThingTc o e)) = addTickHsExpanded o e
+addTickHsExpr (XExpr (ExpandedThingTc hse)) = addTickHsExpanded hse
addTickHsExpr e@(XExpr (ConLikeTc {})) = return e
-- We used to do a freeVar on a pat-syn builder, but actually
@@ -660,8 +660,8 @@ addTickHsExpr (HsDo srcloc cxt (L l stmts))
ListComp -> Just $ BinBox QualBinBox
_ -> Nothing
-addTickHsExpanded :: HsCtxt -> LHsExpr GhcTc -> TM (HsExpr GhcTc)
-addTickHsExpanded o e = liftM (XExpr . ExpandedThingTc o) $ case o of
+addTickHsExpanded :: HsExpansion GhcTc -> TM (HsExpr GhcTc)
+addTickHsExpanded (HSE o e) = liftM (XExpr . ExpandedThingTc . HSE o) $ case o of
-- We always want statements to get a tick, so we can step over each one.
-- To avoid duplicates we blacklist SrcSpans we already inserted here.
StmtErrCtxt _ (L pos _) -> do_tick_black pos
=====================================
compiler/GHC/Iface/Ext/Ast.hs
=====================================
@@ -755,7 +755,7 @@ instance HiePass p => HasType (LocatedA (HsExpr (GhcPass p))) where
RecordCon con_expr _ _ -> computeType con_expr
ExprWithTySig _ e _ -> computeLType e
HsPragE _ _ e -> computeLType e
- XExpr (ExpandedThingTc thing e)
+ XExpr (ExpandedThingTc (HSE thing e))
| ExprCtxt (HsGetField{}) <- thing -- for record-dot-syntax
-> Just (lhsExprType e)
| otherwise -> computeLType e
@@ -1352,7 +1352,7 @@ instance HiePass p => ToHie (LocatedA (HsExpr (GhcPass p))) where
WrapExpr w a
-> [ toHie $ L mspan a
, toHie (L mspan w) ]
- ExpandedThingTc _ e
+ ExpandedThingTc (HSE _ e)
-> [ toHie e ]
ConLikeTc con
-> [ toHie $ C Use $ L mspan $ conLikeName con ]
=====================================
compiler/GHC/Rename/Utils.hs
=====================================
@@ -847,8 +847,9 @@ mkExpandedStmt oStmt flav eExpr = mkExpandedRn (StmtErrCtxt (HsDoStmt flav) oStm
mkExpandedRn
:: HsCtxt -- ^ source, user written do statement/expression
-> LHsExpr GhcRn -- ^ expanded typechecked expression
- -> HsExpr GhcRn -- ^ suitably wrapped 'XXExprGhcRn'
-mkExpandedRn orig expr = XExpr (ExpandedThingRn orig expr)
+ -> HsExpr GhcRn -- ^ suitably wrapped 'XXExprGhcRn'
+mkExpandedRn o e = XExpr (ExpandedThingRn (HSE o e))
+
-- | Build a 'XXExprGhcRn' out of an extension constructor,
-- and the two components of the expansion: original and
@@ -862,5 +863,5 @@ mkExpandedExprTc oExpr eExpr = mkExpandedTc (ExprCtxt oExpr) (wrapGenSpan eExpr)
mkExpandedTc
:: HsCtxt -- ^ source, user written do statement/expression
-> LHsExpr GhcTc -- ^ expanded typechecked expression
- -> HsExpr GhcTc -- ^ suitably wrapped 'XXExprGhcRn'
-mkExpandedTc o e = XExpr (ExpandedThingTc o e)
+ -> HsExpr GhcTc -- ^ suitably wrapped 'XXExprGhcTc'
+mkExpandedTc o e = XExpr (ExpandedThingTc (HSE o e))
=====================================
compiler/GHC/Tc/Gen/App.hs
=====================================
@@ -1246,7 +1246,7 @@ expr_to_type earg =
| otherwise = not_in_scope
where occ = occName rdr
not_in_scope = failWith $ TcRnNotInScope NotInScope rdr
- go (L l (XExpr (ExpandedThingRn (ExprCtxt orig) _))) =
+ go (L l (XExpr (ExpandedThingRn (HSE (ExprCtxt orig) _)))) =
-- Use the original, user-written expression (before expansion).
-- Example. Say we have vfun :: forall a -> blah
-- and the call vfun (Maybe [1,2,3])
@@ -1937,7 +1937,7 @@ quickLookArg1 :: Int -> SrcSpan -> (HsExpr GhcRn, SrcSpan) -> LHsExpr GhcRn
-> Scaled TcRhoType -- Deeply skolemised
-> TcM (HsExprArg 'TcpInst)
-- quickLookArg1 implements the "QL Argument" judgement in Fig 5 of the paper
-quickLookArg1 pos app_lspan (fun, fun_lspan) larg@(L arg_loc arg) sc_arg_ty@(Scaled _ orig_arg_rho)
+quickLookArg1 pos app_lspan (fun, fun_lspan) larg@(L _ arg) sc_arg_ty@(Scaled _ orig_arg_rho)
= addArgCtxt pos (fun, fun_lspan) larg $ -- Context needed for constraints
-- generated by calls in arg
do { ((rn_fun_arg, fun_lspan_arg), rn_args) <- splitHsApps arg
@@ -1968,7 +1968,7 @@ quickLookArg1 pos app_lspan (fun, fun_lspan) larg@(L arg_loc arg) sc_arg_ty@(Sca
<- captureConstraints $
tcInstFun do_ql True ds_flag_arg (arg_orig, rn_fun_arg, fun_lspan_arg) tc_fun_arg_head fun_sigma_arg_head rn_args
-- We must capture type-class and equality constraints here, but
- -- not equality constraints. See (QLA6) in Note [Quick Look at
+ -- not usage information. See (QLA6) in Note [Quick Look at
-- value arguments]
; traceTc "quickLookArg 2" $
=====================================
compiler/GHC/Tc/Gen/Do.hs
=====================================
@@ -45,8 +45,8 @@ import Data.List ((\\))
-- so that they can be typechecked.
-- See Note [Expanding HsDo with XXExprGhcRn] below for `HsDo` specific commentary
-- and Note [Handling overloaded and rebindable constructs] for high level commentary
-expandDoStmts :: HsDoFlavour -> [ExprLStmt GhcRn] -> TcM (LHsExpr GhcRn)
-expandDoStmts doFlav stmts = expand_do_stmts doFlav stmts
+expandDoStmts :: HsDoFlavour -> XRec GhcRn [ExprLStmt GhcRn] -> TcM (HsExpansion GhcRn)
+expandDoStmts doFlav lstmts@(L _ stmts) = HSE (ExprCtxt (HsDo noExtField doFlav lstmts)) <$> expand_do_stmts doFlav stmts
-- | The main work horse for expanding do block statements into applications of binds and thens
-- See Note [Expanding HsDo with XXExprGhcRn]
@@ -234,7 +234,7 @@ See Note [Handling overloaded and rebindable constructs] in GHC.Rename.Expr
To disabmiguate desugaring (`HsExpr GhcTc -> Core.Expr`) we use the phrase expansion
(`HsExpr GhcRn -> HsExpr GhcRn`)
-This expansion is done right before typechecking and after renaming
+This expansion is done after renaming and before typechecking
See Part 2. of Note [Doing XXExprGhcRn in the Renamer vs Typechecker] in `GHC.Rename.Expr`
Historical note START
@@ -423,10 +423,10 @@ It stores the original statement (with location) and the expanded expression
‹ExpandedThingRn do { e1; e2; e3 }› -- Original Do Expression
-- Expanded Do Expression
(‹ExpandedThingRn e1› -- Original Statement
- ({(>>) ‹ExpandedThingRn e1› e1} -- Expanded Expression
+ ({(>>) e1} -- Expanded Expression
(‹ExpandedThingRn e2›
- ({(>>) ‹ExpandedThingRn e2› e2}
- (‹ExpandedThingRn e3› {e3})))))
+ ({(>>) e2}
+ (‹ExpandedThingRn e3› {e3})))))
* Whenever the typechecker steps through an `ExpandedThingRn`,
we push the original statement in the error context, set the error location to the
@@ -481,6 +481,4 @@ It stores the original statement (with location) and the expanded expression
mkExpandedPatRn :: LPat GhcRn -> HsExpr GhcRn -> HsExpr GhcRn
-mkExpandedPatRn pat e = XExpr $ ExpandedThingRn
- { xrn_orig = StmtErrCtxtPat pat
- , xrn_expanded = wrapGenSpan e}
+mkExpandedPatRn pat e = mkExpandedRn (StmtErrCtxtPat pat) (wrapGenSpan e)
=====================================
compiler/GHC/Tc/Gen/Expr.hs
=====================================
@@ -316,7 +316,8 @@ tcExpr e@(OpApp {}) res_ty = tcApp e res_ty
tcExpr e@(HsAppType {}) res_ty = tcApp e res_ty
tcExpr e@(ExprWithTySig {}) res_ty = tcApp e res_ty
-tcExpr (XExpr e') res_ty = tcXExpr e' res_ty
+tcExpr (XExpr (ExpandedThingRn hse)) res_ty = tcHsExpansion hse res_ty
+tcExpr e@(XExpr{}) res_ty = tcApp e res_ty
-- Typecheck an occurrence of an unbound Id
--
@@ -557,7 +558,7 @@ tcExpr (HsMultiIf _ alts) res_ty
; res_ty <- readExpType res_ty
; return (HsMultiIf res_ty alts') }
-tcExpr expr@(HsDo _ do_or_lc stmts) res_ty
+tcExpr (HsDo _ do_or_lc stmts) res_ty
| DoExpr{} <- do_or_lc
-- ApplicativeDo are typechecked using tcDoStmts
= do isApplicativeDo <- xoptM LangExt.ApplicativeDo
@@ -565,12 +566,13 @@ tcExpr expr@(HsDo _ do_or_lc stmts) res_ty
then tcDoStmts do_or_lc stmts res_ty
-- Expand expression on the fly otherwise
-- See Note [Typechecking by expansion: overview]
- else do { expr' <- tcExpandExpr expr
- ; tcExpr expr' res_ty }
+ else do { hse <- expandDoStmts do_or_lc stmts
+ ; tcHsExpansion hse res_ty }
| MDoExpr{} <- do_or_lc
- = do expr' <- tcExpandExpr expr
- tcExpr expr' res_ty
+ = do hse <- expandDoStmts do_or_lc stmts
+ tcHsExpansion hse res_ty
| otherwise
+ -- ListComp, MonadComp are handled by tcDoStmts
= tcDoStmts do_or_lc stmts res_ty
tcExpr (HsProc x pat cmd) res_ty
@@ -686,7 +688,7 @@ tcExpr expr@(RecordUpd { rupd_expr = record_expr
; (ds_expr, ds_res_ty, err_msg)
<- expandRecordUpd record_expr possible_parents rbnds res_ty
- ; setInGeneratedCode $ addErrCtxt err_msg $
+ ; addErrCtxt err_msg $
do { -- Typecheck the expanded expression.
expr' <- tcExpr ds_expr (Check ds_res_ty)
-- NB: it's important to use ds_res_ty and not res_ty here.
@@ -815,7 +817,7 @@ The rest of this Note explains how that is done.
hence `RealSrcSpan`.
The `tcl_err_ctxt` is a stack of contexts, each saying something
- like "In the expression: x+y" or "In the record update: r { x=2 }"
+ like "In the expression: x+y" or "In second argument of `$` namely 'r { x=2 }'"
The `tcl_in_gen_code` is a boolean that keeps track of whether
the current expression being typechecked is compiler generated
@@ -847,17 +849,13 @@ The rest of this Note explains how that is done.
-}
-tcXExpr :: XXExprGhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
-tcXExpr (ExpandedThingRn o e) res_ty
+tcHsExpansion :: HsExpansion GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
+tcHsExpansion (HSE o e) res_ty
= mkExpandedTc o <$> -- necessary for hpc ticks
-- Need to call tcExpr and not tcApp
-- as e can be let statement which tcApp cannot gracefully handle
tcMonoLExpr e res_ty
--- For record selection, same as HsVar case
-tcXExpr xe res_ty = tcApp (XExpr xe) res_ty
-
-
{-
************************************************************************
* *
@@ -1859,14 +1857,3 @@ checkMissingFields con_like rbinds arg_tys
field_strs = conLikeImplBangs con_like
fl `elemField` flds = any (\ fl' -> flSelector fl == fl') flds
-
-
--- Expands the expression on the fly
--- See Note [Handling overloaded and rebindable constructs]
--- See Note [Typechecking by expansion: overview]
-tcExpandExpr :: HsExpr GhcRn -> TcM (HsExpr GhcRn)
-tcExpandExpr orig_expr@(HsDo _ flav (L _ stmts))
- = do { expanded_expr <- expandDoStmts flav stmts
- ; return (mkExpandedLExpr orig_expr expanded_expr) }
-
-tcExpandExpr e = return e
=====================================
compiler/GHC/Tc/Gen/Head.hs
=====================================
@@ -462,7 +462,7 @@ tcInferAppHead_maybe fun = case fun of
ExprWithTySig _ e hs_ty -> Just <$> with_get_ds (tcExprWithSig e hs_ty)
HsOverLit _ lit -> Just <$> with_get_ds (tcInferOverLit lit)
XExpr (HsRecSelRn f) -> Just <$> with_get_ds (tcInferRecSelId f)
- XExpr (ExpandedThingRn o (L loc e)) -> setSrcSpan (locA loc) $ Just <$> (
+ XExpr (ExpandedThingRn (HSE o (L loc e))) -> setSrcSpan (locA loc) $ Just <$> (
-- We do not want to instantiate the type of the head as there may be
-- visible type applications in the argument.
-- c.f. T19167
=====================================
compiler/GHC/Tc/Types/Origin.hs
=====================================
@@ -625,7 +625,7 @@ exprCtOrigin (HsIf {}) = IfThenElseOrigin
exprCtOrigin (HsProjection _ p) = RecordFieldProjectionOrigin (FieldLabelStrings $ fmap noLocA p)
exprCtOrigin (RecordUpd{}) = RecordUpdOrigin
exprCtOrigin (HsGetField _ _ f) = GetFieldOrigin (fmap field_label $ dfoLabel (unLoc f))
-exprCtOrigin (XExpr (ExpandedThingRn o _)) = errCtxtCtOrigin o
+exprCtOrigin (XExpr (ExpandedThingRn (HSE o _))) = errCtxtCtOrigin o
exprCtOrigin (XExpr (HsRecSelRn f)) = OccurrenceOfRecSel $ L (getLoc $ foLabel f) (foExt f)
srcCodeOriginCtOrigin :: HsCtxt -> CtOrigin
=====================================
compiler/GHC/Tc/Utils/Monad.hs
=====================================
@@ -1089,7 +1089,7 @@ setSrcSpan :: SrcSpan -> TcRn a -> TcRn a
setSrcSpan (RealSrcSpan loc _) thing_inside
= updLclCtxt (\ctxt -> ctxt {tcl_loc = loc, tcl_in_gen_code = False}) thing_inside
setSrcSpan (GeneratedSrcSpan{}) thing_inside
- = setInGeneratedCode $ thing_inside
+ = updLclCtxt (\ctxt -> ctxt {tcl_in_gen_code = True}) thing_inside
setSrcSpan _ thing_inside
= thing_inside
@@ -1355,8 +1355,8 @@ addLExprCtxt lspan e thing_inside
-- error context. c.f. RecordDotSyntaxFail9
-- Add the original HsCtxt if we are typechecking an expanded expression
ExprWithTySig _ (L _ e') _
- | XExpr (ExpandedThingRn o _) <- e' -> addErrCtxt o thing_inside
- XExpr (ExpandedThingRn o _) -> addErrCtxt o thing_inside
+ | XExpr (ExpandedThingRn (HSE o _)) <- e' -> addErrCtxt o thing_inside
+ XExpr (ExpandedThingRn (HSE o _)) -> addErrCtxt o thing_inside
_ -> addErrCtxt (ExprCtxt e) thing_inside
}
=====================================
compiler/GHC/Tc/Utils/Unify.hs
=====================================
@@ -2047,7 +2047,7 @@ getDeepSubsumptionFlag_DataConHead app_head =
go app_head
| XExpr (ConLikeTc (RealDataCon {})) <- app_head
= Deep TopSub
- | XExpr (ExpandedThingTc _ (L _ f)) <- app_head
+ | XExpr (ExpandedThingTc (HSE _ (L _ f))) <- app_head
= go f
| XExpr (WrapExpr _ f) <- app_head
= go f
=====================================
compiler/GHC/Tc/Zonk/Type.hs
=====================================
@@ -1095,9 +1095,9 @@ zonkExpr (XExpr (WrapExpr co_fn expr))
do new_expr <- zonkExpr expr
return (XExpr (WrapExpr new_co_fn new_expr))
-zonkExpr (XExpr (ExpandedThingTc thing e))
+zonkExpr (XExpr (ExpandedThingTc (HSE thing e)))
= do e' <- zonkLExpr e
- return $ XExpr (ExpandedThingTc thing e')
+ return $ XExpr (ExpandedThingTc (HSE thing e'))
zonkExpr e@(XExpr (ConLikeTc {}))
= return e
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/25625e1e23f81193423092ad1f6fbd4…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/25625e1e23f81193423092ad1f6fbd4…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/spj-apporv-Oct24] make HsExpandedRn and HsExpandedTc payload LExpr,
by Apoorv Ingle (＠ani) 19 Mar '26
by Apoorv Ingle (＠ani) 19 Mar '26
19 Mar '26
Apoorv Ingle pushed to branch wip/spj-apporv-Oct24 at Glasgow Haskell Compiler / GHC
Commits:
5b081f0a by Apoorv Ingle at 2026-03-18T17:58:51-05:00
make HsExpandedRn and HsExpandedTc payload LExpr,
add tcExpand for expanding Do expressions before typechecking in tcExpr
- - - - -
17 changed files:
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Hs/Syn/Type.hs
- compiler/GHC/HsToCore/Expr.hs
- compiler/GHC/HsToCore/Match.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/HsToCore/Ticks.hs
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/Rename/Utils.hs
- compiler/GHC/Tc/Gen/App.hs
- compiler/GHC/Tc/Gen/Do.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Gen/Head.hs
- compiler/GHC/Tc/Gen/Match.hs
- compiler/GHC/Tc/Utils/Monad.hs
- compiler/GHC/Tc/Utils/Unify.hs
- compiler/GHC/Tc/Zonk/Type.hs
- testsuite/tests/ghci/prog-mhu001/prog-mhu001c.stdout
Changes:
=====================================
compiler/GHC/Hs/Expr.hs
=====================================
@@ -661,43 +661,23 @@ type instance XXExpr GhcTc = XXExprGhcTc
********************************************************************* -}
data XXExprGhcRn
- = ExpandedThingRn { xrn_orig :: HsCtxt -- The original source thing context to be used for error messages
- , xrn_expanded :: HsExpr GhcRn -- The compiler generated, expanded thing
- }
+ = ExpandedThingRn { xrn_orig :: HsCtxt -- The original source thing context to be used for error messages
+ , xrn_expanded :: LHsExpr GhcRn } -- The compiler generated, expanded thing
+ -- This is located because of do statements (TODO ANI : Add Note)
| HsRecSelRn (FieldOcc GhcRn) -- ^ Variable pointing to record selector
-- See Note [Non-overloaded record field selectors] and
-- Note [Record selectors in the AST]
--- | Build an expression using the extension constructor `XExpr`,
--- and the two components of the expansion: original expression and
--- expanded expressions.
-mkExpandedExpr
- :: HsExpr GhcRn -- ^ source expression context
- -> HsExpr GhcRn -- ^ expanded expression
- -> HsExpr GhcRn -- ^ suitably wrapped 'XXExprGhcRn'
-mkExpandedExpr oExpr eExpr = XExpr (ExpandedThingRn { xrn_orig = ExprCtxt oExpr
- , xrn_expanded = eExpr })
-
--- | Build an expression using the extension constructor `XExpr`,
--- and the two components of the expansion: original do stmt and
--- expanded expression
-mkExpandedStmt
- :: ExprLStmt GhcRn -- ^ source statement context
- -> HsDoFlavour -- ^ source statements do flavour
- -> HsExpr GhcRn -- ^ expanded expression
- -> HsExpr GhcRn -- ^ suitably wrapped 'XXExprGhcRn'
-mkExpandedStmt oStmt flav eExpr = XExpr (ExpandedThingRn { xrn_orig = StmtErrCtxt (HsDoStmt flav) oStmt
- , xrn_expanded = eExpr })
-
data XXExprGhcTc
= WrapExpr -- Type and evidence application and abstractions
HsWrapper (HsExpr GhcTc)
| ExpandedThingTc -- See Note [Rebindable syntax and XXExprGhcRn]
-- See Note [Expanding HsDo with XXExprGhcRn] in `GHC.Tc.Gen.Do`
- { xtc_orig :: HsCtxt -- The original user written thing
- , xtc_expanded :: HsExpr GhcTc } -- The expanded typechecked expression
+ { xtc_orig :: HsCtxt -- The original user written thing
+ , xtc_expanded :: LHsExpr GhcTc } -- The expanded typechecked expression
+ -- This is located because of do statements (TODO ANI: Add NOTE)
| ConLikeTc
-- ^ A 'ConLike', either a data constructor or pattern synonym
@@ -722,22 +702,6 @@ data XXExprGhcTc
-- See Note [Non-overloaded record field selectors] and
-- Note [Record selectors in the AST]
-
--- | Build a 'XXExprGhcRn' out of an extension constructor,
--- and the two components of the expansion: original and
--- expanded typechecked expressions.
-mkExpandedExprTc
- :: HsExpr GhcRn -- ^ source expression
- -> HsExpr GhcTc -- ^ expanded typechecked expression
- -> HsExpr GhcTc -- ^ suitably wrapped 'XXExprGhcRn'
-mkExpandedExprTc oExpr eExpr = mkExpandedTc (ExprCtxt oExpr) eExpr
-
-mkExpandedTc
- :: HsCtxt -- ^ source, user written do statement/expression
- -> HsExpr GhcTc -- ^ expanded typechecked expression
- -> HsExpr GhcTc -- ^ suitably wrapped 'XXExprGhcRn'
-mkExpandedTc o e = XExpr (ExpandedThingTc o e)
-
{- *********************************************************************
* *
Pretty-printing expressions
=====================================
compiler/GHC/Hs/Syn/Type.hs
=====================================
@@ -153,7 +153,7 @@ hsExprType (HsQual x _ _) = dataConCantHappen x
hsExprType (HsForAll x _ _) = dataConCantHappen x
hsExprType (HsFunArr x _ _ _) = dataConCantHappen x
hsExprType (XExpr (WrapExpr wrap e)) = hsWrapperType wrap $ hsExprType e
-hsExprType (XExpr (ExpandedThingTc _ e)) = hsExprType e
+hsExprType (XExpr (ExpandedThingTc _ e)) = lhsExprType e
hsExprType (XExpr (ConLikeTc con)) = conLikeType con
hsExprType (XExpr (HsTick _ e)) = lhsExprType e
hsExprType (XExpr (HsBinTick _ _ e)) = lhsExprType e
=====================================
compiler/GHC/HsToCore/Expr.hs
=====================================
@@ -41,7 +41,6 @@ import GHC.Hs
-- needs to see source types
import GHC.Tc.Utils.TcType
import GHC.Tc.Types.Evidence
-import GHC.Tc.Types.ErrCtxt
import GHC.Tc.Utils.Monad
import GHC.Tc.Instance.Class (lookupHasFieldLabel)
@@ -308,10 +307,7 @@ dsExpr e@(XExpr ext_expr_tc)
WrapExpr {} -> dsApp e
ConLikeTc {} -> dsApp e
- ExpandedThingTc o e
- | StmtErrCtxt _ (L loc _) <- o -- c.f. T14546d. We have lost the location of the first statement in the GhcRn -> GhcTc
- -> putSrcSpanDsA loc $ dsExpr e
- | otherwise -> dsExpr e
+ ExpandedThingTc _ e -> dsLExpr e
-- Hpc Support
HsTick tickish e -> do
=====================================
compiler/GHC/HsToCore/Match.hs
=====================================
@@ -1167,7 +1167,7 @@ viewLExprEq (e1,_) (e2,_) = lexp e1 e2
exp (XExpr (WrapExpr h e)) (XExpr (WrapExpr h' e')) =
wrap h h' && exp e e'
exp (XExpr (ExpandedThingTc _ x)) (XExpr (ExpandedThingTc _ x'))
- = exp x x'
+ = lexp x x'
exp (HsVar _ i) (HsVar _ i') = i == i'
exp (HsIPVar _ i) (HsIPVar _ i') =
-- the instance for IPName derives using the id, so follow the HsVar case
=====================================
compiler/GHC/HsToCore/Quote.hs
=====================================
@@ -1739,7 +1739,7 @@ repE e@(XExpr (ExpandedThingRn o x))
| ExprCtxt e <- o
= do { rebindable_on <- lift $ xoptM LangExt.RebindableSyntax
; if rebindable_on -- See Note [Quotation and rebindable syntax]
- then repE x
+ then repLE x
else repE e }
| otherwise
= notHandled (ThExpressionForm e)
=====================================
compiler/GHC/HsToCore/Ticks.hs
=====================================
@@ -492,7 +492,7 @@ isCallSite HsApp{} = True
isCallSite HsAppType{} = True
isCallSite HsCase{} = True
isCallSite (XExpr (ExpandedThingTc _ e))
- = isCallSite e
+ = isCallSite (unLoc e)
-- NB: OpApp, SectionL, SectionR are all expanded out
isCallSite _ = False
@@ -660,14 +660,14 @@ addTickHsExpr (HsDo srcloc cxt (L l stmts))
ListComp -> Just $ BinBox QualBinBox
_ -> Nothing
-addTickHsExpanded :: HsCtxt -> HsExpr GhcTc -> TM (HsExpr GhcTc)
+addTickHsExpanded :: HsCtxt -> LHsExpr GhcTc -> TM (HsExpr GhcTc)
addTickHsExpanded o e = liftM (XExpr . ExpandedThingTc o) $ case o of
-- We always want statements to get a tick, so we can step over each one.
-- To avoid duplicates we blacklist SrcSpans we already inserted here.
StmtErrCtxt _ (L pos _) -> do_tick_black pos
_ -> skip
where
- skip = addTickHsExpr e
+ skip = addTickLHsExpr e
do_tick_black pos = do
d <- getDensity
case d of
@@ -675,9 +675,9 @@ addTickHsExpanded o e = liftM (XExpr . ExpandedThingTc o) $ case o of
TickForBreakPoints -> tick_it_black pos
_ -> skip
tick_it_black pos =
- unLoc <$> allocTickBox (ExpBox False) False False (locA pos)
+ allocTickBox (ExpBox False) False False (locA pos)
(withBlackListed (locA pos) $
- addTickHsExpr e)
+ addTickHsExpr (unLoc e))
addTickTupArg :: HsTupArg GhcTc -> TM (HsTupArg GhcTc)
addTickTupArg (Present x e) = do { e' <- addTickLHsExpr e
=====================================
compiler/GHC/Iface/Ext/Ast.hs
=====================================
@@ -757,8 +757,8 @@ instance HiePass p => HasType (LocatedA (HsExpr (GhcPass p))) where
HsPragE _ _ e -> computeLType e
XExpr (ExpandedThingTc thing e)
| ExprCtxt (HsGetField{}) <- thing -- for record-dot-syntax
- -> Just (hsExprType e)
- | otherwise -> computeType e
+ -> Just (lhsExprType e)
+ | otherwise -> computeLType e
XExpr (HsTick _ e) -> computeLType e
XExpr (HsBinTick _ _ e) -> computeLType e
e -> Just (hsExprType e)
@@ -1353,7 +1353,7 @@ instance HiePass p => ToHie (LocatedA (HsExpr (GhcPass p))) where
-> [ toHie $ L mspan a
, toHie (L mspan w) ]
ExpandedThingTc _ e
- -> [ toHie (L mspan e) ]
+ -> [ toHie e ]
ConLikeTc con
-> [ toHie $ C Use $ L mspan $ conLikeName con ]
HsTick _ expr
=====================================
compiler/GHC/Rename/Utils.hs
=====================================
@@ -24,6 +24,8 @@ module GHC.Rename.Utils (
genSimpleFunBind, genFunBind,
genHsLamDoExp, genHsCaseAltDoExp, genSimpleMatch, genHsLet,
+ mkExpandedRn, mkExpandedExpr, mkExpandedStmt, mkExpandedLExpr, mkExpandedTc, mkExpandedExprTc,
+
mkRnSyntaxExpr,
newLocalBndrRn, newLocalBndrsRn,
@@ -45,7 +47,6 @@ import GHC.Core.Type
import GHC.Hs
import GHC.Types.Name.Reader
import GHC.Tc.Errors.Types
--- import GHC.Tc.Utils.Env
import GHC.Tc.Utils.Monad
import GHC.Types.Name
import GHC.Types.Name.Set
@@ -816,3 +817,50 @@ genSimpleMatch ctxt pats rhs
= wrapGenSpan $
Match { m_ext = noExtField, m_ctxt = ctxt, m_pats = noLocA pats
, m_grhss = unguardedGRHSs generatedSrcSpan rhs noAnn }
+
+
+-- | Build an expression using the extension constructor `XExpr`,
+-- and the two components of the expansion: original expression and
+-- expanded expressions.
+mkExpandedExpr
+ :: HsExpr GhcRn -- ^ source expression context
+ -> HsExpr GhcRn -- ^ expanded expression
+ -> HsExpr GhcRn -- ^ suitably wrapped 'XXExprGhcRn'
+mkExpandedExpr oExpr eExpr = mkExpandedRn (ExprCtxt oExpr) (wrapGenSpan eExpr)
+
+mkExpandedLExpr
+ :: HsExpr GhcRn -- ^ source expression context
+ -> LHsExpr GhcRn -- ^ expanded expression
+ -> HsExpr GhcRn -- ^ suitably wrapped 'XXExprGhcRn'
+mkExpandedLExpr oExpr eExpr = mkExpandedRn (ExprCtxt oExpr) eExpr
+
+-- | Build an expression using the extension constructor `XExpr`,
+-- and the two components of the expansion: original do stmt and
+-- expanded expression
+mkExpandedStmt
+ :: ExprLStmt GhcRn -- ^ source statement context
+ -> HsDoFlavour -- ^ source statements do flavour
+ -> HsExpr GhcRn -- ^ expanded expression
+ -> HsExpr GhcRn -- ^ suitably wrapped 'XXExprGhcRn'
+mkExpandedStmt oStmt flav eExpr = mkExpandedRn (StmtErrCtxt (HsDoStmt flav) oStmt) (wrapGenSpan eExpr)
+
+mkExpandedRn
+ :: HsCtxt -- ^ source, user written do statement/expression
+ -> LHsExpr GhcRn -- ^ expanded typechecked expression
+ -> HsExpr GhcRn -- ^ suitably wrapped 'XXExprGhcRn'
+mkExpandedRn orig expr = XExpr (ExpandedThingRn orig expr)
+
+-- | Build a 'XXExprGhcRn' out of an extension constructor,
+-- and the two components of the expansion: original and
+-- expanded typechecked expressions.
+mkExpandedExprTc
+ :: HsExpr GhcRn -- ^ source expression
+ -> HsExpr GhcTc -- ^ expanded typechecked expression
+ -> HsExpr GhcTc -- ^ suitably wrapped 'XXExprGhcRn'
+mkExpandedExprTc oExpr eExpr = mkExpandedTc (ExprCtxt oExpr) (wrapGenSpan eExpr)
+
+mkExpandedTc
+ :: HsCtxt -- ^ source, user written do statement/expression
+ -> LHsExpr GhcTc -- ^ expanded typechecked expression
+ -> HsExpr GhcTc -- ^ suitably wrapped 'XXExprGhcRn'
+mkExpandedTc o e = XExpr (ExpandedThingTc o e)
=====================================
compiler/GHC/Tc/Gen/App.hs
=====================================
@@ -957,8 +957,8 @@ addArgCtxt arg_no (app_head, app_head_lspan) (L arg_loc arg) thing_inside
, ppr arg
, ppr arg_no])
; setSrcSpanA arg_loc $
- addNthFunArgErrCtxt app_head arg arg_no $
- thing_inside
+ addErrCtxt (FunAppCtxt (FunAppCtxtExpr app_head arg) arg_no) $
+ thing_inside
}
| otherwise
= do { traceTc "addArgCtxt" (vcat [text "generated Head"
@@ -969,16 +969,6 @@ addArgCtxt arg_no (app_head, app_head_lspan) (L arg_loc arg) thing_inside
; addLExprCtxt (locA arg_loc) arg $
thing_inside
}
- where
- addNthFunArgErrCtxt :: HsExpr GhcRn -> HsExpr GhcRn -> Int -> TcM a -> TcM a
- addNthFunArgErrCtxt app_head arg arg_no thing_inside
- | XExpr (ExpandedThingRn _ _) <- arg
- = addExpansionErrCtxt (FunAppCtxt (FunAppCtxtExpr app_head arg) arg_no) $
- thing_inside
- | otherwise
- = addErrCtxt (FunAppCtxt (FunAppCtxtExpr app_head arg) arg_no) $
- thing_inside
-
{- *********************************************************************
@@ -1947,16 +1937,13 @@ quickLookArg1 :: Int -> SrcSpan -> (HsExpr GhcRn, SrcSpan) -> LHsExpr GhcRn
-> Scaled TcRhoType -- Deeply skolemised
-> TcM (HsExprArg 'TcpInst)
-- quickLookArg1 implements the "QL Argument" judgement in Fig 5 of the paper
-quickLookArg1 pos app_lspan (fun, fun_lspan) larg@(L arg_loc arg) sc_arg_ty@(Scaled _ orig_arg_rho)
+quickLookArg1 pos app_lspan (fun, fun_lspan) larg@(L _ arg) sc_arg_ty@(Scaled _ orig_arg_rho)
= addArgCtxt pos (fun, fun_lspan) larg $ -- Context needed for constraints
-- generated by calls in arg
- do { ((rn_fun_arg, fun_lspan_arg'), rn_args) <- splitHsApps arg
- ; let fun_lspan_arg | null rn_args = locA arg_loc -- arg is an id (or an XExpr) so use the arg_loc in tcInstFun
- | otherwise = fun_lspan_arg'
+ do { ((rn_fun_arg, fun_lspan_arg), rn_args) <- splitHsApps arg
-- Step 1: get the type of the head of the argument
- ; (fun_ue, mb_fun_ty) <- maybe_update_err_ctxt fun_lspan_arg rn_fun_arg $
- (tcCollectingUsage $ tcInferAppHead_maybe rn_fun_arg)
+ ; (fun_ue, mb_fun_ty) <- (tcCollectingUsage $ tcInferAppHead_maybe rn_fun_arg)
-- tcCollectingUsage: the use of an Id at the head generates usage-info
-- See the call to `tcEmitBindingUsage` in `check_local_id`. So we must
-- capture and save it in the `EValArgQL`. See (QLA6) in
@@ -2025,20 +2012,6 @@ quickLookArg1 pos app_lspan (fun, fun_lspan) larg@(L arg_loc arg) sc_arg_ty@(Sca
, eaql_res_rho = app_res_rho }) }}}
-maybe_update_err_ctxt :: SrcSpan -> HsExpr GhcRn -> TcM a -> TcM a
-maybe_update_err_ctxt fun_lspan_arg rn_fun_arg thing_inside
- | not (isGeneratedSrcSpan fun_lspan_arg)
- , XExpr (ExpandedThingRn{}) <- rn_fun_arg
- = do igc <- inGeneratedCode
- if igc
- then thing_inside
- else addLExprCtxt fun_lspan_arg rn_fun_arg $
- thing_inside
- | otherwise
- = thing_inside
-
-
-
mk_origin :: SrcSpan -- SrcSpan of the argument
-> HsExpr GhcRn -- The head of the expression application chain
-> TcM CtOrigin
=====================================
compiler/GHC/Tc/Gen/Do.hs
=====================================
@@ -14,8 +14,7 @@ module GHC.Tc.Gen.Do (expandDoStmts) where
import GHC.Prelude
-import GHC.Rename.Utils ( wrapGenSpan, genHsExpApps, genHsApp, genHsLet,
- genHsLamDoExp, genHsCaseAltDoExp, genWildPat )
+import GHC.Rename.Utils
import GHC.Rename.Env ( irrefutableConLikeRn )
import GHC.Tc.Utils.Monad
@@ -114,7 +113,7 @@ expand_do_stmts doFlavour (stmt@(L loc (BindStmt xbsrn pat e)): lstmts)
| otherwise
= pprPanic "expand_do_stmts: The impossible happened, missing bind operator from renamer" (text "stmt" <+> ppr stmt)
-expand_do_stmts doFlavour (stmt@(L loc (BodyStmt _ (L e_lspan e) (SyntaxExprRn then_op) _)) : lstmts) =
+expand_do_stmts doFlavour (stmt@(L loc (BodyStmt _ (L _ e) (SyntaxExprRn then_op) _)) : lstmts) =
-- See Note [BodyStmt] in Language.Haskell.Syntax.Expr
-- See Note [Expanding HsDo with XXExprGhcRn] Equation (1) below
-- stmts ~~> stmts'
@@ -122,7 +121,7 @@ expand_do_stmts doFlavour (stmt@(L loc (BodyStmt _ (L e_lspan e) (SyntaxExprRn t
-- e ; stmts ~~> (>>) e stmts'
do expand_stmts_expr <- expand_do_stmts doFlavour lstmts
let expansion = genHsExpApps then_op -- (>>)
- [ L e_lspan (mkExpandedStmt stmt doFlavour e)
+ [ wrapGenSpan e
, expand_stmts_expr ]
return $ L loc (mkExpandedStmt stmt doFlavour expansion)
@@ -484,4 +483,4 @@ It stores the original statement (with location) and the expanded expression
mkExpandedPatRn :: LPat GhcRn -> HsExpr GhcRn -> HsExpr GhcRn
mkExpandedPatRn pat e = XExpr $ ExpandedThingRn
{ xrn_orig = StmtErrCtxtPat pat
- , xrn_expanded = e}
+ , xrn_expanded = wrapGenSpan e}
=====================================
compiler/GHC/Tc/Gen/Expr.hs
=====================================
@@ -36,6 +36,7 @@ import GHC.Rename.Env ( addUsedGRE, getUpdFieldLbls )
import GHC.Tc.Gen.App
import GHC.Tc.Gen.Head
+import GHC.Tc.Gen.Do
import GHC.Tc.Gen.Bind ( tcLocalBinds )
import GHC.Tc.Gen.HsType
import GHC.Tc.Gen.Arrow
@@ -92,6 +93,8 @@ import GHC.Data.Maybe
import Control.Monad
import qualified Data.List.NonEmpty as NE
+import qualified GHC.LanguageExtensions as LangExt
+
{-
************************************************************************
* *
@@ -267,13 +270,6 @@ tcCheckMonoExpr, tcCheckMonoExprNC
tcCheckMonoExpr expr res_ty = tcMonoLExpr expr (mkCheckExpType res_ty)
tcCheckMonoExprNC expr res_ty = tcMonoLExprNC expr (mkCheckExpType res_ty)
-
--- Expand the HsExpr if it is typechecked after expansions
--- See Note [Handling overloaded and rebindable constructs]
--- See Note [Typechecking by expansion: overview]
-expand_expr :: HsExpr GhcRn -> TcM (HsExpr GhcRn)
-expand_expr x = return x
-
---------------
tcMonoLExpr, tcMonoLExprNC
:: LHsExpr GhcRn -- Expression to type check
@@ -282,8 +278,7 @@ tcMonoLExpr, tcMonoLExprNC
-> TcM (LHsExpr GhcTc)
tcMonoLExpr (L loc expr) res_ty
- = do expanded_expr <- expand_expr expr
- addLExprCtxt (locA loc) expanded_expr $ -- Note [Error contexts in generated code]
+ = do addLExprCtxt (locA loc) expr $ -- Note [Error contexts in generated code]
do { expr' <- tcExpr expr res_ty
; return (L loc expr') }
@@ -562,7 +557,20 @@ tcExpr (HsMultiIf _ alts) res_ty
; res_ty <- readExpType res_ty
; return (HsMultiIf res_ty alts') }
-tcExpr (HsDo _ do_or_lc stmts) res_ty
+tcExpr expr@(HsDo _ do_or_lc stmts) res_ty
+ | DoExpr{} <- do_or_lc
+ -- ApplicativeDo are typechecked using tcDoStmts
+ = do isApplicativeDo <- xoptM LangExt.ApplicativeDo
+ if isApplicativeDo
+ then tcDoStmts do_or_lc stmts res_ty
+ -- Expand expression on the fly otherwise
+ -- See Note [Typechecking by expansion: overview]
+ else do { expr' <- tcExpandExpr expr
+ ; tcExpr expr' res_ty }
+ | MDoExpr{} <- do_or_lc
+ = do expr' <- tcExpandExpr expr
+ tcExpr expr' res_ty
+ | otherwise
= tcDoStmts do_or_lc stmts res_ty
tcExpr (HsProc x pat cmd) res_ty
@@ -678,7 +686,7 @@ tcExpr expr@(RecordUpd { rupd_expr = record_expr
; (ds_expr, ds_res_ty, err_msg)
<- expandRecordUpd record_expr possible_parents rbnds res_ty
- ; addExpansionErrCtxt err_msg $
+ ; setInGeneratedCode $ addErrCtxt err_msg $
do { -- Typecheck the expanded expression.
expr' <- tcExpr ds_expr (Check ds_res_ty)
-- NB: it's important to use ds_res_ty and not res_ty here.
@@ -776,12 +784,12 @@ directly, it's much easier to
Example: record updates. The typechecker looks like this:
- tcExpr e@(RecordUpd{}) rho = do { ee <- expandExpr e
- ; tcExpr ee rho }
+ tcExpr e@(HsDo{}) rho = do { ee <- expandExpr e
+ ; tcExpr ee rho }
-The `expandExpr` replaces the record update (e { x = rhs })
+The `expandExpr` replaces the HsDo { x <- e1; return x }
with something like
- case e of { MkT a b _ d -> MkT a b rhs d }
+ e1 >>= \ x -> x
and we then typecheck the latter.
See also Note [Handling overloaded and rebindable constructs]
@@ -798,8 +806,9 @@ The rest of this Note explains how that is done.
, xrn_expanded = ee } ))
where `ee` is the expansion of the user written thing `ue`
-* The type checker context has 2 key fields that describe the context:
+* The type checker context has 3 key fields that describe the context:
TcLclCtxt { tcl_loc :: RealSrcSpan
+ , tcl_in_gen_code :: Bool
, tcl_err_ctxt :: [ErrCtxt]
, ... }
Note `tcl_loc` always points to a real place in the source code,
@@ -808,8 +817,12 @@ The rest of this Note explains how that is done.
The `tcl_err_ctxt` is a stack of contexts, each saying something
like "In the expression: x+y" or "In the record update: r { x=2 }"
+ The `tcl_in_gen_code` is a boolean that keeps track of whether
+ the current expression being typechecked is compiler generated
+ or user generated.
+
* Now, when
- tcMonoLHsExpr :: LHsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
+ tcMonoLExpr :: LHsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
gets a located expression, it does 2 things:
* Calls `addLExprCtxt` to perform error context management
* Calls `tcExpr` to typecheck the expression.
@@ -839,7 +852,7 @@ tcXExpr (ExpandedThingRn o e) res_ty
= mkExpandedTc o <$> -- necessary for hpc ticks
-- Need to call tcExpr and not tcApp
-- as e can be let statement which tcApp cannot gracefully handle
- tcExpr e res_ty
+ tcMonoLExpr e res_ty
-- For record selection, same as HsVar case
tcXExpr xe res_ty = tcApp (XExpr xe) res_ty
@@ -1846,3 +1859,14 @@ checkMissingFields con_like rbinds arg_tys
field_strs = conLikeImplBangs con_like
fl `elemField` flds = any (\ fl' -> flSelector fl == fl') flds
+
+
+-- Expands the expression on the fly
+-- See Note [Handling overloaded and rebindable constructs]
+-- See Note [Typechecking by expansion: overview]
+tcExpandExpr :: HsExpr GhcRn -> TcM (HsExpr GhcRn)
+tcExpandExpr orig_expr@(HsDo _ flav (L _ stmts))
+ = do { expanded_expr <- expandDoStmts flav stmts
+ ; return (mkExpandedLExpr orig_expr expanded_expr) }
+
+tcExpandExpr e = return e
=====================================
compiler/GHC/Tc/Gen/Head.hs
=====================================
@@ -29,6 +29,8 @@ import GHC.Prelude
import GHC.Hs
import GHC.Hs.Syn.Type
+import GHC.Rename.Utils (mkExpandedTc, mkExpandedExprTc)
+
import GHC.Tc.Gen.HsType
import GHC.Tc.Gen.Bind( chooseInferredQuantifiers )
import GHC.Tc.Gen.Sig( tcUserTypeSig, tcInstSig )
@@ -460,12 +462,12 @@ tcInferAppHead_maybe fun = case fun of
ExprWithTySig _ e hs_ty -> Just <$> with_get_ds (tcExprWithSig e hs_ty)
HsOverLit _ lit -> Just <$> with_get_ds (tcInferOverLit lit)
XExpr (HsRecSelRn f) -> Just <$> with_get_ds (tcInferRecSelId f)
- XExpr (ExpandedThingRn o e) -> Just <$> (
+ XExpr (ExpandedThingRn o (L loc e)) -> setSrcSpan (locA loc) $ Just <$> (
-- We do not want to instantiate the type of the head as there may be
-- visible type applications in the argument.
-- c.f. T19167
- (\ (e, ds_flag, ty) -> (mkExpandedTc o e, ds_flag, ty)) <$>
- tcExprSigma False (errCtxtCtOrigin o) e
+ (\ (e, ds_flag, ty) -> (mkExpandedTc o (L loc e), ds_flag, ty)) <$>
+ tcExprSigma False (errCtxtCtOrigin o) e
)
_ -> return Nothing
=====================================
compiler/GHC/Tc/Gen/Match.hs
=====================================
@@ -35,7 +35,7 @@ where
import GHC.Prelude
import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcSyntaxOp, tcInferRho, tcInferRhoFRRNC
- , tcMonoLExprNC, tcMonoLExpr, tcExpr
+ , tcMonoLExprNC, tcExpr
, tcCheckMonoExpr, tcCheckMonoExprNC
, tcCheckPolyExpr, tcPolyLExpr )
@@ -44,7 +44,6 @@ import GHC.Tc.Errors.Types
import GHC.Tc.Utils.Monad
import GHC.Tc.Utils.Env
import GHC.Tc.Gen.Pat
-import GHC.Tc.Gen.Do
import GHC.Tc.Gen.Head( tcCheckId )
import GHC.Tc.Utils.TcMType
import GHC.Tc.Utils.TcType
@@ -391,32 +390,14 @@ tcDoStmts MonadComp (L l stmts) res_ty
; res_ty <- readExpType res_ty
; return (HsDo res_ty MonadComp (L l stmts')) }
-tcDoStmts ctxt@GhciStmtCtxt _ _ = pprPanic "tcDoStmts" (pprHsDoFlavour ctxt)
-
-tcDoStmts doExpr@(DoExpr _) ss@(L l stmts) res_ty
- = do { isApplicativeDo <- xoptM LangExt.ApplicativeDo
- ; if isApplicativeDo
- then do { stmts' <- tcStmts (HsDoStmt doExpr) tcDoStmt stmts res_ty
- ; res_ty <- readExpType res_ty
- ; return (HsDo res_ty doExpr (L l stmts')) }
- else do { expanded_expr <- expandDoStmts doExpr stmts -- Do expansion on the fly
- ; traceTc "tcDoStmts" (ppr expanded_expr)
- ; let orig = HsDo noExtField doExpr ss
- ; mkExpandedExprTc orig <$> (
- -- We lose the location on the first statement location in GhcTc, unfortunately.
- -- It is needed for get the pattern match warnings right cf. T14546d
- -- That location is currently recovered from the location stored in OrigStmt
- -- in dsExpr of ExpandedThingTc
- unLoc <$> tcMonoLExpr expanded_expr res_ty)
- }
- }
-tcDoStmts mDoExpr ss@(L _ stmts) res_ty
- = do { expanded_expr <- expandDoStmts mDoExpr stmts -- Do expansion on the fly
- ; let orig = HsDo noExtField mDoExpr ss
- ; e' <- tcMonoLExpr expanded_expr res_ty
- ; return (mkExpandedExprTc orig (unLoc e'))
- }
+tcDoStmts doExpr@(DoExpr _) (L l stmts) res_ty
+ = do { stmts' <- tcStmts (HsDoStmt doExpr) tcDoStmt stmts res_ty
+ ; res_ty <- readExpType res_ty
+ ; return (HsDo res_ty doExpr (L l stmts')) }
+
+-- NB: ghcistmts should fail, MDoExpr is handled by expansions
+tcDoStmts ctxt _ _ = pprPanic "tcDoStmts" (pprHsDoFlavour ctxt)
tcBody :: LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
tcBody body res_ty
=====================================
compiler/GHC/Tc/Utils/Monad.hs
=====================================
@@ -88,7 +88,7 @@ module GHC.Tc.Utils.Monad(
-- * Context management for the type checker
getErrCtxt, setErrCtxt, addErrCtxt,
- addLExprCtxt, addExpansionErrCtxt,
+ addLExprCtxt,
popErrCtxt, getCtLocM, setCtLocM, mkCtLocEnv,
-- * Diagnostic message generation (type checker)
@@ -1316,11 +1316,16 @@ problem.
Note [Error contexts in generated code]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-* If the `SrcSpan` is a `RealSrcSpan`, `setSrcSpan` updates the `tcl_loc`,
- and makes the `ErrCtxStack` a `UserCodeCtxt`
-* it is a no-op otherwise
-So, it's better to do a `setSrcSpan` /before/ `addErrCtxt`.
+* addLExpr updates updates the ErrCtxt stored in LclEnv with the following logic
+ - If the `SrcSpan` is a `RealSrcSpan`, `setSrcSpan` updates the `tcl_loc` to the given value
+ and sets `tcl_in_gen_code` to `False`. Meaning we are not type checking a compiler generated
+ expression. And thus it can add the expression on to the ErrCtxt Stack
+ - If the `SrcSpan` is a GeneratedSrcSpan then `tcl_in_gen_code` is set to `True`, meaning
+ the expression in hand is compiler generated, and hence it is not added on to the stack.
+
+This ensures that the error messages do not leak compiler generated expressions which can
+be confusing to the users.
- See Note [Rebindable syntax and XXExprGhcRn] in `GHC.Hs.Expr` for
more discussion of this fancy footwork
@@ -1329,33 +1334,32 @@ relation with pattern-match checks
- See Note [ErrCtxtStack Manipulation] in `GHC.Tc.Types.LclEnv` for info about `ErrCtxtStack`
-}
+-- See Note [Error contexts in generated code]
addLExprCtxt :: SrcSpan -> HsExpr GhcRn -> TcRn a -> TcRn a
addLExprCtxt lspan e thing_inside
- | not (isGeneratedSrcSpan lspan)
= setSrcSpan lspan $ add_expr_ctxt e thing_inside
- | otherwise -- no op in generated code
- = thing_inside
where
- add_expr_ctxt :: HsExpr GhcRn -> TcRn a -> TcRn a
- add_expr_ctxt e thing_inside
- = case e of
- -- The HsHole special case addresses situations like
- -- f x = _
- -- when we don't want to say "In the expression: _",
- -- because it is mentioned in the error message itself
- HsHole{} -> thing_inside
-
- -- There is a special case for expressions with signatures to avoid having too verbose
- -- error context. So here we flip the ErrCtxt state to expanded if the expression is expanded.
- -- c.f. RecordDotSyntaxFail9
- ExprWithTySig _ (L _ e') _
- | XExpr (ExpandedThingRn o _) <- e' -> addExpansionErrCtxt o thing_inside
-
- -- Flip error ctxt into expansion mode
- XExpr (ExpandedThingRn o _) -> addExpansionErrCtxt o thing_inside
-
- _ -> addErrCtxt (ExprCtxt e) thing_inside
-
+ add_expr_ctxt :: HsExpr GhcRn -> TcRn a -> TcRn a
+ add_expr_ctxt e thing_inside
+ = do { igc <- inGeneratedCode
+ ; if igc -- generated
+ then thing_inside
+ else case e of
+ -- The HsHole special case addresses situations like
+ -- f x = _
+ -- when we don't want to say "In the expression: _",
+ -- because it is mentioned in the error message itself
+ HsHole{} -> thing_inside
+
+ -- There is a special case for expressions with signatures to avoid having too verbose
+ -- error context. c.f. RecordDotSyntaxFail9
+ -- Add the original HsCtxt if we are typechecking an expanded expression
+ ExprWithTySig _ (L _ e') _
+ | XExpr (ExpandedThingRn o _) <- e' -> addErrCtxt o thing_inside
+ XExpr (ExpandedThingRn o _) -> addErrCtxt o thing_inside
+
+ _ -> addErrCtxt (ExprCtxt e) thing_inside
+ }
getErrCtxt :: TcM [ErrCtxt]
getErrCtxt = do { env <- getLclEnv; return (getLclEnvErrCtxt env) }
@@ -1369,11 +1373,6 @@ addErrCtxt :: HsCtxt -> TcM a -> TcM a
{-# INLINE addErrCtxt #-} -- Note [Inlining addErrCtxt]
addErrCtxt ctxt = pushCtxt ctxt
--- See Note [ErrCtxtStack Manipulation]
-addExpansionErrCtxt :: HsCtxt -> TcM a -> TcM a
-{-# INLINE addExpansionErrCtxt #-} -- Note [Inlining addErrCtxt]
-addExpansionErrCtxt ctxt thing_inside = setInGeneratedCode $ pushCtxt ctxt thing_inside
-
-- See Note [Rebindable syntax and XXExprGhcRn] in GHC.Hs.Expr
pushCtxt :: ErrCtxt -> TcM a -> TcM a
{-# INLINE pushCtxt #-} -- Note [Inlining addErrCtxt]
=====================================
compiler/GHC/Tc/Utils/Unify.hs
=====================================
@@ -105,7 +105,7 @@ import GHC.Types.Var.Set
import GHC.Types.Var.Env
import GHC.Types.Basic
import GHC.Types.Unique.Set (nonDetEltsUniqSet)
-import GHC.Types.SrcLoc (unLoc)
+import GHC.Types.SrcLoc (unLoc, GenLocated (..))
import GHC.Utils.Misc
import GHC.Utils.Outputable as Outputable
@@ -2047,7 +2047,7 @@ getDeepSubsumptionFlag_DataConHead app_head =
go app_head
| XExpr (ConLikeTc (RealDataCon {})) <- app_head
= Deep TopSub
- | XExpr (ExpandedThingTc _ f) <- app_head
+ | XExpr (ExpandedThingTc _ (L _ f)) <- app_head
= go f
| XExpr (WrapExpr _ f) <- app_head
= go f
=====================================
compiler/GHC/Tc/Zonk/Type.hs
=====================================
@@ -1096,7 +1096,7 @@ zonkExpr (XExpr (WrapExpr co_fn expr))
return (XExpr (WrapExpr new_co_fn new_expr))
zonkExpr (XExpr (ExpandedThingTc thing e))
- = do e' <- zonkExpr e
+ = do e' <- zonkLExpr e
return $ XExpr (ExpandedThingTc thing e')
zonkExpr e@(XExpr (ConLikeTc {}))
=====================================
testsuite/tests/ghci/prog-mhu001/prog-mhu001c.stdout
=====================================
@@ -9,6 +9,7 @@ e/E.hs:(15,3)-(15,6): GHC.Internal.Types.Int -> GHC.Internal.Base.String
e/E.hs:(22,3)-(22,6): E.E -> GHC.Internal.Base.String
e/E.hs:(25,3)-(25,10): GHC.Internal.Base.String -> GHC.Internal.Types.IO ()
e/E.hs:(25,12)-(25,37): GHC.Internal.Base.String
+e/E.hs:(25,3)-(25,37): GHC.Internal.Types.IO ()
e/E.hs:(24,16)-(25,37): GHC.Internal.Types.IO ()
e/E.hs:(19,9)-(19,9): E.E
e/E.hs:(5,7)-(5,8): GHC.Internal.Bignum.Integer.Integer
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5b081f0a06cbbc0f94b931536c1cde9…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5b081f0a06cbbc0f94b931536c1cde9…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/jeltsch/text-read-uncovering] 2 commits: Move the implementation of version parsing into `base`
by Wolfgang Jeltsch (＠jeltsch) 19 Mar '26
by Wolfgang Jeltsch (＠jeltsch) 19 Mar '26
19 Mar '26
Wolfgang Jeltsch pushed to branch wip/jeltsch/text-read-uncovering at Glasgow Haskell Compiler / GHC
Commits:
40d2e59f by Wolfgang Jeltsch at 2026-03-18T23:41:54+02:00
Move the implementation of version parsing into `base`
- - - - -
b2122fdb by Wolfgang Jeltsch at 2026-03-18T23:42:09+02:00
Move the implementation of `readConstr` into `base`
- - - - -
9 changed files:
- libraries/base/src/Data/Data.hs
- libraries/base/src/Data/Version.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Data.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Version.hs
- 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/plugins/plugins10.stdout
Changes:
=====================================
libraries/base/src/Data/Data.hs
=====================================
@@ -99,3 +99,38 @@ module Data.Data (
import GHC.Internal.Data.Data
import Data.Typeable
+
+import GHC.Real (toRational)
+import GHC.Float (Double)
+import Data.Eq ((==))
+import Data.Function ((.))
+import Data.Maybe (Maybe (Nothing, Just))
+import Data.List (filter)
+import Data.String (String)
+import Text.Read (Read, reads)
+
+-- | Lookup a constructor via a string
+readConstr :: DataType -> String -> Maybe Constr
+readConstr dt str =
+ case dataTypeRep dt of
+ AlgRep cons -> idx cons
+ IntRep -> mkReadCon (\i -> (mkPrimCon dt str (IntConstr i)))
+ FloatRep -> mkReadCon ffloat
+ CharRep -> mkReadCon (\c -> (mkPrimCon dt str (CharConstr c)))
+ NoRep -> Nothing
+ where
+
+ -- Read a value and build a constructor
+ mkReadCon :: Read t => (t -> Constr) -> Maybe Constr
+ mkReadCon f = case (reads str) of
+ [(t,"")] -> Just (f t)
+ _ -> Nothing
+
+ -- Traverse list of algebraic datatype constructors
+ idx :: [Constr] -> Maybe Constr
+ idx cons = case filter ((==) str . showConstr) cons of
+ [] -> Nothing
+ hd : _ -> Just hd
+
+ ffloat :: Double -> Constr
+ ffloat = mkPrimCon dt str . FloatConstr . toRational
=====================================
libraries/base/src/Data/Version.hs
=====================================
@@ -1,5 +1,7 @@
{-# LANGUAGE Safe #-}
+{-# LANGUAGE StandaloneDeriving #-}
+
-- |
-- Module : Data.Version
-- Copyright : (c) The University of Glasgow 2004
@@ -33,3 +35,25 @@ module Data.Version (
) where
import GHC.Internal.Data.Version
+
+import Control.Applicative (pure, (*>))
+import Data.Functor (fmap)
+import Data.Char (isDigit, isAlphaNum)
+import Text.ParserCombinators.ReadP (ReadP, char, munch1, sepBy1, many)
+import Text.Read (Read, read)
+
+{-NOTE:
+ The following instance is technically an orphan, but practically it is not,
+ since ordinary users should not use @ghc-internal@ directly and thus get
+ 'Version' only through this module.
+-}
+
+-- | @since base-2.01
+deriving instance Read Version
+
+-- | A parser for versions in the format produced by 'showVersion'.
+--
+parseVersion :: ReadP Version
+parseVersion = do branch <- sepBy1 (fmap read (munch1 isDigit)) (char '.')
+ tags <- many (char '-' *> munch1 isAlphaNum)
+ pure Version{versionBranch=branch, versionTags=tags}
=====================================
libraries/ghc-internal/src/GHC/Internal/Data/Data.hs
=====================================
@@ -61,6 +61,7 @@ module GHC.Internal.Data.Data (
mkIntType,
mkFloatType,
mkCharType,
+ mkPrimCon,
mkNoRepType,
-- ** Observers
dataTypeName,
@@ -94,7 +95,6 @@ module GHC.Internal.Data.Data (
constrIndex,
-- ** From strings to constructors and vice versa: all data types
showConstr,
- readConstr,
-- * Convenience functions: take type constructors apart
tyconUQname,
@@ -126,10 +126,8 @@ import GHC.Internal.Base (
import GHC.Internal.Err (errorWithoutStackTrace)
import GHC.Internal.List
import GHC.Internal.Num
-import GHC.Internal.Read
import GHC.Internal.Show
import GHC.Internal.Tuple (Solo (..))
-import GHC.Internal.Text.Read( reads )
import GHC.Internal.Types (
Bool(..), Char, Coercible, Float, Double, Type, type (~), type (~~),
)
@@ -688,32 +686,6 @@ showConstr :: Constr -> String
showConstr = constring
--- | Lookup a constructor via a string
-readConstr :: DataType -> String -> Maybe Constr
-readConstr dt str =
- case dataTypeRep dt of
- AlgRep cons -> idx cons
- IntRep -> mkReadCon (\i -> (mkPrimCon dt str (IntConstr i)))
- FloatRep -> mkReadCon ffloat
- CharRep -> mkReadCon (\c -> (mkPrimCon dt str (CharConstr c)))
- NoRep -> Nothing
- where
-
- -- Read a value and build a constructor
- mkReadCon :: Read t => (t -> Constr) -> Maybe Constr
- mkReadCon f = case (reads str) of
- [(t,"")] -> Just (f t)
- _ -> Nothing
-
- -- Traverse list of algebraic datatype constructors
- idx :: [Constr] -> Maybe Constr
- idx cons = case filter ((==) str . showConstr) cons of
- [] -> Nothing
- hd : _ -> Just hd
-
- ffloat :: Double -> Constr
- ffloat = mkPrimCon dt str . FloatConstr . toRational
-
------------------------------------------------------------------------------
--
-- Convenience functions: algebraic data types
=====================================
libraries/ghc-internal/src/GHC/Internal/Data/Version.hs
=====================================
@@ -10,7 +10,7 @@
--
-- Maintainer : libraries(a)haskell.org
-- Stability : stable
--- Portability : non-portable (local universal quantification in ReadP)
+-- Portability : non-portable
--
-- A general library for representation and manipulation of versions.
--
@@ -31,23 +31,18 @@ module GHC.Internal.Data.Version (
-- * The @Version@ type
Version(..),
-- * A concrete representation of @Version@
- showVersion, parseVersion,
+ showVersion,
-- * Constructor function
makeVersion
) where
-import GHC.Internal.Classes ( Eq(..), (&&) )
-import GHC.Internal.Data.Functor ( Functor(..) )
+import GHC.Internal.Classes ( Eq ((==)), (&&) )
import GHC.Internal.Int ( Int )
import GHC.Internal.Data.List ( map, sort, concat, concatMap, intersperse, (++) )
import GHC.Internal.Data.Ord
-import GHC.Internal.Base ( Applicative(..), String )
+import GHC.Internal.Base ( String )
import GHC.Internal.Generics
-import GHC.Internal.Unicode ( isDigit, isAlphaNum )
-import GHC.Internal.Read
import GHC.Internal.Show
-import GHC.Internal.Text.ParserCombinators.ReadP
-import GHC.Internal.Text.Read ( read )
{- |
A 'Version' represents the version of a software entity.
@@ -69,8 +64,8 @@ operations are the right thing for every 'Version'.
Similarly, concrete representations of versions may differ. One
possible concrete representation is provided (see 'showVersion' and
-'parseVersion'), but depending on the application a different concrete
-representation may be more appropriate.
+'Data.Version.parseVersion'), but depending on the application a
+different concrete representation may be more appropriate.
-}
data Version =
Version { versionBranch :: [Int],
@@ -92,8 +87,7 @@ data Version =
-- The interpretation of the list of tags is entirely dependent
-- on the entity that this version applies to.
}
- deriving ( Read -- ^ @since base-2.01
- , Show -- ^ @since base-2.01
+ deriving ( Show -- ^ @since base-2.01
, Generic -- ^ @since base-4.9.0.0
)
{-# DEPRECATED versionTags "See GHC ticket #2496" #-}
@@ -121,13 +115,6 @@ showVersion (Version branch tags)
= concat (intersperse "." (map show branch)) ++
concatMap ('-':) tags
--- | A parser for versions in the format produced by 'showVersion'.
---
-parseVersion :: ReadP Version
-parseVersion = do branch <- sepBy1 (fmap read (munch1 isDigit)) (char '.')
- tags <- many (char '-' *> munch1 isAlphaNum)
- pure Version{versionBranch=branch, versionTags=tags}
-
-- | Construct tag-less 'Version'
--
-- @since base-4.8.0.0
=====================================
testsuite/tests/interface-stability/base-exports.stdout
=====================================
@@ -12496,7 +12496,7 @@ instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (Data.Semi
instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (Data.Semigroup.Min a) -- Defined in ‘Data.Semigroup’
instance forall m. GHC.Internal.Read.Read m => GHC.Internal.Read.Read (Data.Semigroup.WrappedMonoid m) -- Defined in ‘Data.Semigroup’
instance forall k (a :: k) (b :: k). Coercible a b => GHC.Internal.Read.Read (GHC.Internal.Data.Type.Coercion.Coercion a b) -- Defined in ‘GHC.Internal.Data.Type.Coercion’
-instance GHC.Internal.Read.Read GHC.Internal.Data.Version.Version -- Defined in ‘GHC.Internal.Data.Version’
+instance [safe] GHC.Internal.Read.Read GHC.Internal.Data.Version.Version -- Defined in ‘Data.Version’
instance GHC.Internal.Read.Read GHC.Internal.Foreign.Ptr.IntPtr -- Defined in ‘GHC.Internal.Foreign.Ptr’
instance GHC.Internal.Read.Read GHC.Internal.Foreign.Ptr.WordPtr -- Defined in ‘GHC.Internal.Foreign.Ptr’
instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CBool -- Defined in ‘GHC.Internal.Foreign.C.Types’
=====================================
testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
=====================================
@@ -12525,7 +12525,7 @@ instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (Data.Semi
instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (Data.Semigroup.Min a) -- Defined in ‘Data.Semigroup’
instance forall m. GHC.Internal.Read.Read m => GHC.Internal.Read.Read (Data.Semigroup.WrappedMonoid m) -- Defined in ‘Data.Semigroup’
instance forall k (a :: k) (b :: k). Coercible a b => GHC.Internal.Read.Read (GHC.Internal.Data.Type.Coercion.Coercion a b) -- Defined in ‘GHC.Internal.Data.Type.Coercion’
-instance GHC.Internal.Read.Read GHC.Internal.Data.Version.Version -- Defined in ‘GHC.Internal.Data.Version’
+instance [safe] GHC.Internal.Read.Read GHC.Internal.Data.Version.Version -- Defined in ‘Data.Version’
instance GHC.Internal.Read.Read GHC.Internal.Foreign.Ptr.IntPtr -- Defined in ‘GHC.Internal.Foreign.Ptr’
instance GHC.Internal.Read.Read GHC.Internal.Foreign.Ptr.WordPtr -- Defined in ‘GHC.Internal.Foreign.Ptr’
instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CBool -- Defined in ‘GHC.Internal.Foreign.C.Types’
=====================================
testsuite/tests/interface-stability/base-exports.stdout-mingw32
=====================================
@@ -12767,7 +12767,7 @@ instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (Data.Semi
instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (Data.Semigroup.Min a) -- Defined in ‘Data.Semigroup’
instance forall m. GHC.Internal.Read.Read m => GHC.Internal.Read.Read (Data.Semigroup.WrappedMonoid m) -- Defined in ‘Data.Semigroup’
instance forall k (a :: k) (b :: k). Coercible a b => GHC.Internal.Read.Read (GHC.Internal.Data.Type.Coercion.Coercion a b) -- Defined in ‘GHC.Internal.Data.Type.Coercion’
-instance GHC.Internal.Read.Read GHC.Internal.Data.Version.Version -- Defined in ‘GHC.Internal.Data.Version’
+instance [safe] GHC.Internal.Read.Read GHC.Internal.Data.Version.Version -- Defined in ‘Data.Version’
instance GHC.Internal.Read.Read GHC.Internal.Foreign.Ptr.IntPtr -- Defined in ‘GHC.Internal.Foreign.Ptr’
instance GHC.Internal.Read.Read GHC.Internal.Foreign.Ptr.WordPtr -- Defined in ‘GHC.Internal.Foreign.Ptr’
instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CBool -- Defined in ‘GHC.Internal.Foreign.C.Types’
=====================================
testsuite/tests/interface-stability/base-exports.stdout-ws-32
=====================================
@@ -12496,7 +12496,7 @@ instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (Data.Semi
instance forall a. GHC.Internal.Read.Read a => GHC.Internal.Read.Read (Data.Semigroup.Min a) -- Defined in ‘Data.Semigroup’
instance forall m. GHC.Internal.Read.Read m => GHC.Internal.Read.Read (Data.Semigroup.WrappedMonoid m) -- Defined in ‘Data.Semigroup’
instance forall k (a :: k) (b :: k). Coercible a b => GHC.Internal.Read.Read (GHC.Internal.Data.Type.Coercion.Coercion a b) -- Defined in ‘GHC.Internal.Data.Type.Coercion’
-instance GHC.Internal.Read.Read GHC.Internal.Data.Version.Version -- Defined in ‘GHC.Internal.Data.Version’
+instance [safe] GHC.Internal.Read.Read GHC.Internal.Data.Version.Version -- Defined in ‘Data.Version’
instance GHC.Internal.Read.Read GHC.Internal.Foreign.Ptr.IntPtr -- Defined in ‘GHC.Internal.Foreign.Ptr’
instance GHC.Internal.Read.Read GHC.Internal.Foreign.Ptr.WordPtr -- Defined in ‘GHC.Internal.Foreign.Ptr’
instance GHC.Internal.Read.Read GHC.Internal.Foreign.C.Types.CBool -- Defined in ‘GHC.Internal.Foreign.C.Types’
=====================================
testsuite/tests/plugins/plugins10.stdout
=====================================
@@ -2,6 +2,7 @@ parsePlugin()
interfacePlugin: Prelude
interfacePlugin: Language.Haskell.TH
interfacePlugin: Language.Haskell.TH.Quote
+interfacePlugin: Data.Version
interfacePlugin: System.IO
interfacePlugin: GHC.Internal.Base
interfacePlugin: GHC.Internal.Data.NonEmpty
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a78ea8163e36526842596c5b764a2f…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a78ea8163e36526842596c5b764a2f…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/jeltsch/text-read-uncovering] 58 commits: Apply NOINLINE pragmas to generated Typeable bindings
by Wolfgang Jeltsch (＠jeltsch) 19 Mar '26
by Wolfgang Jeltsch (＠jeltsch) 19 Mar '26
19 Mar '26
Wolfgang Jeltsch pushed to branch wip/jeltsch/text-read-uncovering at Glasgow Haskell Compiler / GHC
Commits:
e659610c by Duncan Coutts at 2026-03-09T12:08:35-04:00
Apply NOINLINE pragmas to generated Typeable bindings
For context, see the existing Note [Grand plan for Typeable]
and the Note [NOINLINE on generated Typeable bindings] added in the
subsequent commit.
This is about reducing the number of exported top level names and
unfoldings, which reduces interface file sizes and reduces the number of
global/dynamic linker symbols.
Also accept the changed test output and metric decreases.
Tests that record the phase output for type checking or for simplifier
end up with different output: the generated bindings now have an
Inline [~] annotation, and many top level names are now local rather
than module-prefixed for export.
Also accept the numerous metric decreases in compile_time/bytes
allocated, and a few in compile_time/max_bytes_used.
There's also one instance of a decrease in runtime/max_bytes_used but
it's a ghci-way test and so presumably the reason is that it loads
smaller .hi files and/or links fewer symbols.
-------------------------
Metric Decrease:
CoOpt_Singletons
MultiLayerModulesTH_OneShot
MultilineStringsPerf
T10421
T10547
T12150
T12227
T12234
T12425
T13035
T13056
T13253
T13253-spj
T15304
T15703
T16875
T17836b
T17977b
T18140
T18223
T18282
T18304
T18698a
T18698b
T18730
T18923
T20049
T21839c
T24471
T24582
T24984
T3064
T4029
T5030
T5642
T5837
T6048
T9020
T9198
T9961
TcPlugin_RewritePerf
WWRec
hard_hole_fits
mhu-perf
-------------------------
- - - - -
67df5161 by Duncan Coutts at 2026-03-09T12:08:35-04:00
Add documentation Note [NOINLINE on generated Typeable bindings]
and refer to it from the code and existing documentation.
- - - - -
c4ad6167 by Duncan Coutts at 2026-03-09T12:08:35-04:00
Switch existing note to "named wrinkle" style, (GPT1)..(GPT7)
GPT = Grand plan for Typeable
- - - - -
dc84f8e2 by Cheng Shao at 2026-03-09T12:09:21-04:00
ci: only build deb13 for validate pipeline aarch64-linux jobs
This patch drops the redundant aarch64-linux deb12 job from validate pipelines
and only keeps deb13; it's still built in nightly/release pipelines. Closes #27004.
- - - - -
23a50772 by Rajkumar Natarajan at 2026-03-10T14:11:37-04:00
chore: Merge GHC.Internal.TH.Quote into GHC.Internal.TH.Monad
Move the QuasiQuoter datatype from GHC.Internal.TH.Quote to
GHC.Internal.TH.Monad and delete the Quote module.
Update submodule template-haskell-quasiquoter to use the merged
upstream version that imports from the correct module.
Co-authored-by: Cursor <cursoragent(a)cursor.com>
- - - - -
a2bb6fc3 by Simon Jakobi at 2026-03-10T14:12:23-04:00
Add regression test for #16122
- - - - -
604e1180 by Cheng Shao at 2026-03-11T15:00:42-04:00
hadrian: remove the broken bench flavour
This patch removes the bench flavour from hadrian which has been
broken for years and not used for actual benchmarking (for which
`perf`/`release` is used instead). Closes #26825.
- - - - -
c3e64915 by Simon Jakobi at 2026-03-11T15:01:31-04:00
Add regression test for #18186
The original TypeInType language extension is replaced with
DataKinds+PolyKinds for compatibility.
Closes #18186.
- - - - -
664996c7 by Andreas Klebinger at 2026-03-11T15:02:16-04:00
Bump nofib submodule.
We accrued a number of nofib fixes we want to have here.
- - - - -
517cf64e by Simon Jakobi at 2026-03-11T15:03:03-04:00
Add regression test for #15907
Closes #15907.
- - - - -
fff362cf by Simon Jakobi at 2026-03-11T15:03:49-04:00
Ensure T14272 is run in optasm way
Closes #16539.
- - - - -
ec81ec2c by Simon Jakobi at 2026-03-11T15:03:49-04:00
Add regression test for #24632
Closes #24632.
- - - - -
cefec47b by Simon Jakobi at 2026-03-11T15:03:50-04:00
Fix module name of T9675: T6975 -> T9675
- - - - -
d3690ae8 by Andreas Klebinger at 2026-03-11T15:04:31-04:00
User guide: Clarify phase control on INLINEABLE[foo] pragmas.
Fixes #26851
- - - - -
e7054934 by Simon Jakobi at 2026-03-11T15:05:16-04:00
Add regression test for #12694
Closes #12694.
- - - - -
4756d9f6 by Simon Jakobi at 2026-03-11T15:05:16-04:00
Add regression test for #16275
Closes #16275.
- - - - -
34b7e2c1 by Simon Jakobi at 2026-03-11T15:05:16-04:00
Add regression test for #14908
Closes #14908.
- - - - -
4243db3d by Simon Jakobi at 2026-03-11T15:05:16-04:00
Add regression test for #14151
Closes #14151.
- - - - -
0e9f1453 by Simon Jakobi at 2026-03-11T15:05:16-04:00
Add regression test for #12640
Closes #12640.
- - - - -
ae606c7f by Simon Jakobi at 2026-03-11T15:05:16-04:00
Add regression test for #15588
Closes #15588.
- - - - -
5a38ce4e by Simon Jakobi at 2026-03-11T15:05:16-04:00
Add regression test for #9445
Closes #9445.
- - - - -
d054b467 by Cheng Shao at 2026-03-11T15:05:59-04:00
compiler: implement string interning logic for BCONPtrFS
This patch adds a `FastStringEnv`-based cache of `MallocStrings`
requests to `Interp`, so that when we load bytecode with many
breakpoints that share the same module names & unit ids, we reuse the
allocated remote pointers instead of issuing duplicte `MallocStrings`
requests and bloating the C heap. Closes #26995.
- - - - -
b85a0293 by Simon Jakobi at 2026-03-11T15:06:41-04:00
Add perf test for #1216
Closes #1216.
- - - - -
cd7f7420 by Sylvain Henry at 2026-03-11T15:07:58-04:00
JS: check that tuple constructors are linked (#23709)
Test js-mk_tup was failing before because tuple constructors weren't
linked in. It's no longer an issue after the linker fixes.
- - - - -
d57f01a4 by Matthew Pickering at 2026-03-11T15:08:40-04:00
testsuite: Add test for foreign import prim with unboxed tuple return
This commit just adds a test that foreign import prim works with unboxed
sums.
- - - - -
23d111ce by Matthew Pickering at 2026-03-11T15:08:41-04:00
Return a valid pointer in advanceStackFrameLocationzh
When there is no next stack chunk, `advanceStackFrameLocationzh` used to
return NULL in the pointer-typed StackSnapshot# result slot.
Even though the caller treats that case as "no next frame", the result is
still materialized in a GC-visible pointer slot. If a GC observes the raw
NULL there, stack decoding can crash.
Fix this by ensuring the dead pointer slot contains a valid closure
pointer. Also make the optional result explicit by returning an unboxed
sum instead of a tuple with a separate tag.
Fixes #27009
- - - - -
4c58a3ae by Cheng Shao at 2026-03-11T15:09:22-04:00
hadrian: build profiled dynamic objects with -dynamic-too
This patch enables hadrian to build profiled dynamic objects with
`-dynamic-too`, addressing a build parallelism bottleneck in release
pipelines. Closes #27010.
- - - - -
870243e4 by Zubin Duggal at 2026-03-12T17:33:28+05:30
DmdAnal: Take stable unfoldings into account when determining argument demands
Previously, demand analysis only looked at the RHS to compute argument demands.
If the optimised RHS discarded uses of an argument that the stable unfolding
still needed, it would be incorrectly marked absent. Worker/wrapper would then
replace it with LitRubbish, and inlining the stable unfolding would use the
rubbish value, causing a segfault.
To fix, we introduce addUnfoldingDemands which analyses the stable unfolding
with dmdAnal and combines its DmdType with the RHS's via the new `maxDmdType`
which combines the demands of the stable unfolding with the rhs, so we can avoid
any situation where we give an absent demand to something which is still used
by the stable unfolding.
Fixes #26416.
- - - - -
669d09f9 by Cheng Shao at 2026-03-13T15:06:07-04:00
hadrian: remove redundant library/rts ways definitions from stock flavours
This patch removes redundant library/rts ways definitions from stock
flavours in hadrian; they can be replaced by applying appropriate
filters on `defaultFlavour`.
- - - - -
a27dc081 by Teo Camarasu at 2026-03-13T15:06:51-04:00
ghc-internal: move bits Weak of finalizer interface to base
We move parts of the Weak finalizer interface to `base` only the parts
that the RTS needs to know about are kept in `ghc-internal`.
This lets us then prune our imports somewhat and get rid of some SOURCE imports.
Resolves #26985
- - - - -
6eef855b by Sylvain Henry at 2026-03-13T15:08:18-04:00
Stg/Unarise: constant-folding during unarisation (#25650)
When building an unboxed sum from a literal argument, mkUbxSum
previously emitted a runtime cast via `case primop [lit] of var -> ...`.
This wrapper prevented GHC from recognising the result as a static
StgRhsCon, causing top-level closures to be allocated as thunks instead
of being statically allocated.
Fix: try to perform the numeric literal cast at compile time using
mkLitNumberWrap (wrapping semantics). If successful, return the cast
literal directly with an identity wrapper (no case expression). The
runtime cast path is kept as fallback for non-literal arguments.
Test: codeGen/should_compile/T25650
- - - - -
905f8723 by Simon Jakobi at 2026-03-13T15:09:09-04:00
Add regression test for #2057
Test that GHC stops after an interface-file error instead of
continuing into the linker.
The test constructs a stale package dependency on purpose. `pkgB` is compiled
against one version of package `A`, then the same unit id is replaced by an
incompatible build of `A`. When `Main` imports `B`, GHC has to read `B.hi`,
finds an unfolding that still mentions the old `A`, and should fail while
loading interfaces.
Closes #2057.
Assisted-by: Codex
- - - - -
a13245a9 by Sylvain Henry at 2026-03-13T15:10:06-04:00
JS: fix recompilation avoidance (#23013)
- we were checking the mtime of the *.jsexe directory, not of a file
- we were not computing the PkgsLoaded at all
- - - - -
07442653 by Cheng Shao at 2026-03-13T15:10:51-04:00
hadrian: bump index state & bootstrap plans
This patch bumps hadrian index state & bootstrap plans:
- The updated index state allows bootstrapping from 9.14 without cabal
allow-newer hacks
- The updated bootstrap plans all contain shake-0.19.9 containing
important bugfix, allowing a subsequent patch to bump shake bound to
ensure the bugfix is included
- ghc 9.14.1 bootstrap plan is added
- - - - -
fdc1dbad by Cheng Shao at 2026-03-13T15:10:51-04:00
ci: add ghc 9.14.1 to bootstrap matrix
This patch adds ghc 9.14.1 to bootstrap matrix, so that we test
bootstrapping from ghc 9.14.1.
- - - - -
91916079 by Sylvain Henry at 2026-03-13T15:11:43-04:00
T17912: wait for opener thread to block before killing it (#24739)
Instead of a fixed 1000ms delay, poll threadStatus until the opener
thread is in BlockedOnForeignCall, ensuring killThread only fires once
the thread is provably inside the blocking open() syscall. This prevents
the test from accidentally passing on Windows due to scheduling races.
- - - - -
baa4ebb4 by Cheng Shao at 2026-03-13T15:12:26-04:00
template-haskell: fix redundant import in Language.Haskell.TH.Quote
This patch fixes a redundant import in `Language.Haskell.TH.Quote`
that causes a ghc build failure when bootstrapping from 9.14 with
validate flavours. Fixes #27014.
- - - - -
02e68a86 by Brandon Simmons at 2026-03-13T15:13:19-04:00
Add a cumulative gc_sync_elapsed_ns counter to GHC.Internal.Stats
This makes it possible to get an accurate view of time spent in sync
phase when using prometheus-style sampling. Previously this was only
available for the most recent GC.
This intentionally leaves GHC.Stats API unchanged since it is marked as
deprecated, and API changes there require CLC approval.
Fixes #26944
- - - - -
a18fa3c1 by Cheng Shao at 2026-03-14T05:12:14-04:00
configure: make $LLVMAS default to $CC when $CcLlvmBackend is YES
This patch changes the $LLVMAS detection logic in configure so that
when it's not manually specified by the user, it defaults to $CC if
$CcLlvmBackend is YES. It's a more sensible default than auto-detected
clang from the environment, especially when cross-compiling, $CC as
the cross target's LLVM assembler is more compatible with the use case
than the system-wide clang. Fixes #26769.
- - - - -
3774086e by Matthew Pickering at 2026-03-14T05:13:00-04:00
exceptions: annotate onException continuation with WhileHandling
Before this patch, an exception thrown in the `onException` handler
would loose track of where the original exception was thrown.
```
import Control.Exception
main :: IO ()
main = failingAction `onException` failingCleanup
where
failingAction = throwIO (ErrorCall "outer failure")
failingCleanup = throwIO (ErrorCall "cleanup failure")
```
would report
```
T28399: Uncaught exception ghc-internal:GHC.Internal.Exception.ErrorCall:
cleanup failure
HasCallStack backtrace:
throwIO, called at T28399.hs:<line>:<column> in <package-id>:Main
```
notice that the "outer failure" exception is not present in the error
message.
With this patch, any exception thrown is in the handler is annotated
with WhileHandling. The resulting message looks like
```
T28399: Uncaught exception ghc-internal:GHC.Internal.Exception.ErrorCall:
cleanup failure
While handling outer failure
HasCallStack backtrace:
throwIO, called at T28399.hs:7:22 in main:Main
```
CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/397
Fixes #26759
- - - - -
63ae8eb3 by Andreas Klebinger at 2026-03-14T05:13:43-04:00
Fix missing profiling header for origin_thunk frame.
Fixes #27007
- - - - -
213d2c0e by Cheng Shao at 2026-03-14T05:14:28-04:00
ci: fix ci-images revision
The current ci-images revision was a commit on the WIP branch of
https://gitlab.haskell.org/ghc/ci-images/-/merge_requests/183, and
it's not on the current ci-images master branch. This patch fixes the
image revision to use the current tip of ci-images master.
- - - - -
fc2b083f by Andreas Klebinger at 2026-03-14T05:15:14-04:00
Revert "hadrian/build-cabal: Better respect and utilize -j"
This reverts commit eab3dbba79650e6046efca79133b4c0a5257613d.
While it's neat this currently isn't well supported on all platforms.
It's time will come, but for now I'm reverting this to avoid issues for
users on slightly unconvential platforms.
This will be tracked at #26977.
- - - - -
12a706cf by Cheng Shao at 2026-03-14T16:37:54-04:00
base: fix redundant imports in GHC.Internal.Weak.Finalize
This patch fixes redundant imports in GHC.Internal.Weak.Finalize that
causes a regression in bootstrapping head from 9.14 with validate
flavours. Fixes #27026.
- - - - -
b5d39cad by Matthew Pickering at 2026-03-14T16:38:37-04:00
Use explicit syntax rather than pure
- - - - -
43638643 by Andreas Klebinger at 2026-03-15T18:15:48-04:00
Configure: Fix check for --target support in stage0 CC
The check FP_PROG_CC_LINKER_TARGET used $CC unconditionally to check for
--target support. However this fails for the stage0 config where the C
compiler used is not $CC but $CC_STAGE0.
Since we already pass the compiler under test into the macro I simply
changed it to use that instead.
Fixes #26999
- - - - -
18fd0df6 by Simon Hengel at 2026-03-15T18:16:33-04:00
Fix typo in recursive_do.rst
- - - - -
86bd9bfc by fendor at 2026-03-17T23:46:09-04:00
Introduce `-fimport-loaded-targets` GHCi flag
This new flag automatically adds all loaded targets to the GHCi session
by adding an `InteractiveImport` for the loaded targets.
By default, this flag is disabled, as it potentially increases memory-usage.
This interacts with the flag `-fno-load-initial-targets` as follows:
* If no module is loaded, no module is added as an interactive import.
* If a reload loads up to a module, all loaded modules are added as
interactive imports.
* Unloading modules removes them from the interactive context.
Fixes #26866 by rendering the use of a `-ghci-script` to achieve the
same thing redundant.
- - - - -
e3d4c1bb by mniip at 2026-03-17T23:47:03-04:00
ghc-internal: Remove GHC.Internal.Data.Eq
It served no purpose other than being a re-export.
- - - - -
6f4f6cf0 by mniip at 2026-03-17T23:47:03-04:00
ghc-internal: Refine GHC.Internal.Base imports
Removed re-exports from GHC.Internal.Base. This reveals some modules
that don't actually use anything *defined* in GHC.Internal.Base, and
that can be pushed down a little in the import graph.
Replaced most imports of GHC.Internal.Base with non-wildcard imports
from modules where the identifiers are actually defined.
Part of #26834
Metric Decrease:
T5321FD
- - - - -
7fb51f54 by mangoiv at 2026-03-17T23:48:00-04:00
ci: clone, don't copy when creating the cabal cache
Also removed WINDOWS_HOST variable detected via uname - we now just
check whether the CI job has windows in its name. This works because we
only ever care about it if the respective job is not a cross job. We
also statically detect darwin cross jobs in the same way. We only ever have
darwin -> darwin cross jobs so this is enough to detect the host
reliably.
- - - - -
f8817879 by mangoiv at 2026-03-17T23:48:44-04:00
ci: mark size_hello_artifact fragile on darwin x86
The size of the x86_64 hello artifact is not stable which results in flaky testruns.
Resolves #26814
- - - - -
31b362ef by Wolfgang Jeltsch at 2026-03-18T22:53:37+02:00
Move most of the `System.IO` implementation into `base`
Metric Increase:
T12227
T12707
T5642
- - - - -
9b387fe1 by Wolfgang Jeltsch at 2026-03-18T22:59:41+02:00
Move I/O-related `Read` instances into `base`
Metric Increase:
T12425
T13035
- - - - -
90a8b1cd by Wolfgang Jeltsch at 2026-03-18T23:03:54+02:00
Move most of the `Numeric` implementation into `base`
The `showHex` operation and the `showIntAtBase` operation, which
underlies it, are kept in `GHC.Internal.Numeric`, because `showHex` is
used in a few places in `ghc-internal`; everything else is moved.
- - - - -
d6669df6 by Wolfgang Jeltsch at 2026-03-18T23:03:56+02:00
Move the instance `Read ByteOrder` into `base`
- - - - -
242c8ed5 by Wolfgang Jeltsch at 2026-03-18T23:14:09+02:00
Move the implementation of version parsing into `base`
- - - - -
a78ea816 by Wolfgang Jeltsch at 2026-03-18T23:21:09+02:00
Move the implementation of `readConstr` into `base`
- - - - -
497 changed files:
- .gitlab-ci.yml
- .gitlab/ci.sh
- .gitlab/generate-ci/gen_ci.hs
- .gitlab/jobs.yaml
- compiler/GHC/Builtin/Names/TH.hs
- compiler/GHC/ByteCode/Linker.hs
- compiler/GHC/Core/Opt/DmdAnal.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Driver/Pipeline.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Iface/Recomp.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Runtime/Interpreter/Init.hs
- compiler/GHC/Runtime/Interpreter/Types.hs
- compiler/GHC/Stg/Pipeline.hs
- compiler/GHC/Stg/Unarise.hs
- compiler/GHC/Tc/Instance/Typeable.hs
- compiler/GHC/Types/Demand.hs
- configure.ac
- distrib/configure.ac.in
- docs/users_guide/exts/pragmas.rst
- docs/users_guide/exts/recursive_do.rst
- docs/users_guide/exts/rewrite_rules.rst
- docs/users_guide/ghci.rst
- ghc/GHCi/UI.hs
- hadrian/bootstrap/generate_bootstrap_plans
- hadrian/bootstrap/plan-9_10_1.json
- hadrian/bootstrap/plan-9_10_2.json
- hadrian/bootstrap/plan-9_10_3.json
- hadrian/bootstrap/plan-9_12_1.json
- hadrian/bootstrap/plan-9_12_2.json
- + hadrian/bootstrap/plan-9_14_1.json
- hadrian/bootstrap/plan-bootstrap-9_10_1.json
- hadrian/bootstrap/plan-bootstrap-9_10_2.json
- hadrian/bootstrap/plan-bootstrap-9_10_3.json
- hadrian/bootstrap/plan-bootstrap-9_12_1.json
- hadrian/bootstrap/plan-bootstrap-9_12_2.json
- + hadrian/bootstrap/plan-bootstrap-9_14_1.json
- hadrian/build-cabal
- hadrian/cabal.project
- hadrian/doc/flavours.md
- hadrian/hadrian.cabal
- hadrian/src/Rules/Compile.hs
- hadrian/src/Settings.hs
- hadrian/src/Settings/Builders/Ghc.hs
- − hadrian/src/Settings/Flavours/Benchmark.hs
- hadrian/src/Settings/Flavours/Development.hs
- hadrian/src/Settings/Flavours/GhcInGhci.hs
- hadrian/src/Settings/Flavours/Quick.hs
- hadrian/src/Settings/Flavours/QuickCross.hs
- hadrian/src/Settings/Flavours/Quickest.hs
- libraries/base/changelog.md
- libraries/base/src/Control/Applicative.hs
- libraries/base/src/Data/Char.hs
- libraries/base/src/Data/Data.hs
- libraries/base/src/Data/Eq.hs
- libraries/base/src/Data/Semigroup.hs
- libraries/base/src/Data/Version.hs
- libraries/base/src/GHC/Base.hs
- libraries/base/src/GHC/ByteOrder.hs
- libraries/base/src/GHC/IO/Handle.hs
- libraries/base/src/GHC/Stats.hs
- libraries/base/src/GHC/Weak.hs
- libraries/base/src/GHC/Weak/Finalize.hs
- − libraries/base/src/GHC/Weak/Finalizehs
- libraries/base/src/Numeric.hs
- libraries/base/src/Prelude.hs
- libraries/base/src/System/IO.hs
- libraries/base/src/System/Mem/Weak.hs
- libraries/base/src/Text/Printf.hs
- libraries/base/tests/IO/T17912.hs
- libraries/base/tests/IO/all.T
- libraries/ghc-boot-th/GHC/Boot/TH/Quote.hs
- libraries/ghc-experimental/src/GHC/Profiling/Eras.hs
- libraries/ghc-internal/CHANGELOG.md
- libraries/ghc-internal/cbits/Stack.cmm
- libraries/ghc-internal/codepages/MakeTable.hs
- libraries/ghc-internal/ghc-internal.cabal.in
- libraries/ghc-internal/src/GHC/Internal/AllocationLimitHandler.hs
- libraries/ghc-internal/src/GHC/Internal/Arr.hs
- libraries/ghc-internal/src/GHC/Internal/Base.hs
- libraries/ghc-internal/src/GHC/Internal/Bits.hs
- libraries/ghc-internal/src/GHC/Internal/ByteOrder.hs
- libraries/ghc-internal/src/GHC/Internal/Char.hs
- libraries/ghc-internal/src/GHC/Internal/Clock.hsc
- libraries/ghc-internal/src/GHC/Internal/ClosureTypes.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/Bound.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/IO.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/POSIX.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/Signal.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/Sync.hs
- − libraries/ghc-internal/src/GHC/Internal/Conc/Sync.hs-boot
- libraries/ghc-internal/src/GHC/Internal/Conc/Windows.hs
- libraries/ghc-internal/src/GHC/Internal/ConsoleHandler.hsc
- libraries/ghc-internal/src/GHC/Internal/Control/Arrow.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Concurrent/MVar.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Exception.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad/Fail.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad/Fix.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad/IO/Class.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad/ST/Imp.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad/ST/Lazy/Imp.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Bits.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Data.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Dynamic.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Either.hs
- − libraries/ghc-internal/src/GHC/Internal/Data/Eq.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/Const.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Functor/Identity.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Functor/Utils.hs
- libraries/ghc-internal/src/GHC/Internal/Data/IORef.hs
- libraries/ghc-internal/src/GHC/Internal/Data/List.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Maybe.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Monoid.hs
- libraries/ghc-internal/src/GHC/Internal/Data/OldList.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Ord.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Proxy.hs
- libraries/ghc-internal/src/GHC/Internal/Data/STRef.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Semigroup/Internal.hs
- libraries/ghc-internal/src/GHC/Internal/Data/String.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Traversable.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Type/Bool.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Type/Coercion.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Type/Equality.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Type/Ord.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Typeable.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Typeable/Internal.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Unique.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Version.hs
- libraries/ghc-internal/src/GHC/Internal/Debug/Trace.hs
- libraries/ghc-internal/src/GHC/Internal/Debug/Trace.hs-boot
- libraries/ghc-internal/src/GHC/Internal/Encoding/UTF8.hs
- libraries/ghc-internal/src/GHC/Internal/Enum.hs
- libraries/ghc-internal/src/GHC/Internal/Environment.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Array.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Control.hs
- libraries/ghc-internal/src/GHC/Internal/Event/EPoll.hsc
- libraries/ghc-internal/src/GHC/Internal/Event/IntVar.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Internal.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Internal/Types.hs
- libraries/ghc-internal/src/GHC/Internal/Event/KQueue.hsc
- libraries/ghc-internal/src/GHC/Internal/Event/Manager.hs
- libraries/ghc-internal/src/GHC/Internal/Event/PSQ.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Poll.hsc
- libraries/ghc-internal/src/GHC/Internal/Event/Thread.hs
- libraries/ghc-internal/src/GHC/Internal/Event/TimeOut.hs
- libraries/ghc-internal/src/GHC/Internal/Event/TimerManager.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Unique.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Windows.hsc
- libraries/ghc-internal/src/GHC/Internal/Event/Windows/Clock.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Windows/ConsoleEvent.hsc
- libraries/ghc-internal/src/GHC/Internal/Event/Windows/FFI.hsc
- libraries/ghc-internal/src/GHC/Internal/Event/Windows/ManagedThreadPool.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Windows/Thread.hs
- libraries/ghc-internal/src/GHC/Internal/Exception.hs
- libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs
- libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs-boot
- libraries/ghc-internal/src/GHC/Internal/Exception/Context.hs
- libraries/ghc-internal/src/GHC/Internal/Exception/Type.hs
- libraries/ghc-internal/src/GHC/Internal/ExecutionStack.hs
- libraries/ghc-internal/src/GHC/Internal/ExecutionStack/Internal.hsc
- libraries/ghc-internal/src/GHC/Internal/Exts.hs
- libraries/ghc-internal/src/GHC/Internal/Fingerprint.hs
- libraries/ghc-internal/src/GHC/Internal/Fingerprint.hs-boot
- libraries/ghc-internal/src/GHC/Internal/Fingerprint/Type.hs
- libraries/ghc-internal/src/GHC/Internal/Float.hs
- libraries/ghc-internal/src/GHC/Internal/Float/ConversionUtils.hs
- libraries/ghc-internal/src/GHC/Internal/Float/RealFracMethods.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/C/ConstPtr.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/C/Error.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/C/String.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/C/String/Encoding.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/C/Types.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/ForeignPtr/Imp.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/Marshal/Alloc.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/Marshal/Array.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/Marshal/Error.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/Marshal/Pool.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/Marshal/Utils.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/Ptr.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/Storable.hs
- libraries/ghc-internal/src/GHC/Internal/ForeignPtr.hs
- libraries/ghc-internal/src/GHC/Internal/ForeignSrcLang.hs
- libraries/ghc-internal/src/GHC/Internal/Functor/ZipList.hs
- libraries/ghc-internal/src/GHC/Internal/GHCi.hs
- libraries/ghc-internal/src/GHC/Internal/GHCi/Helpers.hs
- libraries/ghc-internal/src/GHC/Internal/Generics.hs
- libraries/ghc-internal/src/GHC/Internal/Heap/Closures.hs
- libraries/ghc-internal/src/GHC/Internal/Heap/InfoTable.hsc
- libraries/ghc-internal/src/GHC/Internal/Heap/InfoTable/Types.hsc
- libraries/ghc-internal/src/GHC/Internal/Heap/InfoTableProf.hsc
- libraries/ghc-internal/src/GHC/Internal/Heap/ProfInfo/Types.hs
- libraries/ghc-internal/src/GHC/Internal/IO.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Buffer.hs
- libraries/ghc-internal/src/GHC/Internal/IO/BufferedIO.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Device.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/CodePage.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/CodePage/API.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/CodePage/Table.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/Failure.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/Iconv.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/Latin1.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/Types.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/UTF16.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/UTF32.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/UTF8.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs-boot
- libraries/ghc-internal/src/GHC/Internal/IO/FD.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/FD.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Internals.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/Flock.hsc
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/LinuxOFD.hsc
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/NoOp.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/Windows.hsc
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Text.hs
- − libraries/ghc-internal/src/GHC/Internal/IO/Handle/Text.hs-boot
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Types.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Windows.hs
- libraries/ghc-internal/src/GHC/Internal/IO/IOMode.hs
- libraries/ghc-internal/src/GHC/Internal/IO/SubSystem.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Unsafe.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Windows/Encoding.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Windows/Handle.hsc
- libraries/ghc-internal/src/GHC/Internal/IOArray.hs
- libraries/ghc-internal/src/GHC/Internal/IORef.hs
- libraries/ghc-internal/src/GHC/Internal/InfoProv.hs
- libraries/ghc-internal/src/GHC/Internal/InfoProv/Types.hsc
- libraries/ghc-internal/src/GHC/Internal/Int.hs
- libraries/ghc-internal/src/GHC/Internal/IsList.hs
- libraries/ghc-internal/src/GHC/Internal/Ix.hs
- libraries/ghc-internal/src/GHC/Internal/JS/Foreign/Callback.hs
- libraries/ghc-internal/src/GHC/Internal/JS/Prim/Internal.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/Lexeme.hs
- libraries/ghc-internal/src/GHC/Internal/List.hs
- libraries/ghc-internal/src/GHC/Internal/MVar.hs
- libraries/ghc-internal/src/GHC/Internal/Num.hs
- libraries/ghc-internal/src/GHC/Internal/Numeric.hs
- libraries/ghc-internal/src/GHC/Internal/OverloadedLabels.hs
- libraries/ghc-internal/src/GHC/Internal/Pack.hs
- libraries/ghc-internal/src/GHC/Internal/Profiling.hs
- libraries/ghc-internal/src/GHC/Internal/Ptr.hs
- libraries/ghc-internal/src/GHC/Internal/RTS/Flags.hsc
- libraries/ghc-internal/src/GHC/Internal/RTS/Flags/Test.hsc
- libraries/ghc-internal/src/GHC/Internal/Read.hs
- libraries/ghc-internal/src/GHC/Internal/Real.hs
- libraries/ghc-internal/src/GHC/Internal/ST.hs
- libraries/ghc-internal/src/GHC/Internal/STM.hs
- libraries/ghc-internal/src/GHC/Internal/STRef.hs
- libraries/ghc-internal/src/GHC/Internal/Show.hs
- libraries/ghc-internal/src/GHC/Internal/Stable.hs
- libraries/ghc-internal/src/GHC/Internal/StableName.hs
- libraries/ghc-internal/src/GHC/Internal/Stack.hs
- libraries/ghc-internal/src/GHC/Internal/Stack.hs-boot
- libraries/ghc-internal/src/GHC/Internal/Stack/Annotation.hs
- libraries/ghc-internal/src/GHC/Internal/Stack/CCS.hsc
- libraries/ghc-internal/src/GHC/Internal/Stack/CloneStack.hs
- libraries/ghc-internal/src/GHC/Internal/Stack/Constants.hsc
- libraries/ghc-internal/src/GHC/Internal/Stack/ConstantsProf.hsc
- libraries/ghc-internal/src/GHC/Internal/Stack/Decode.hs
- libraries/ghc-internal/src/GHC/Internal/StaticPtr.hs
- libraries/ghc-internal/src/GHC/Internal/StaticPtr/Internal.hs
- libraries/ghc-internal/src/GHC/Internal/Stats.hsc
- libraries/ghc-internal/src/GHC/Internal/Storable.hs
- libraries/ghc-internal/src/GHC/Internal/System/Environment.hs
- libraries/ghc-internal/src/GHC/Internal/System/Environment/Blank.hsc
- libraries/ghc-internal/src/GHC/Internal/System/Environment/ExecutablePath.hsc
- libraries/ghc-internal/src/GHC/Internal/System/IO.hs
- libraries/ghc-internal/src/GHC/Internal/System/IO/Error.hs
- libraries/ghc-internal/src/GHC/Internal/System/Mem.hs
- libraries/ghc-internal/src/GHC/Internal/System/Posix/Internals.hs
- libraries/ghc-internal/src/GHC/Internal/System/Posix/Types.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Lib.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/TH/Quote.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Syntax.hs
- libraries/ghc-internal/src/GHC/Internal/Text/ParserCombinators/ReadP.hs
- libraries/ghc-internal/src/GHC/Internal/Text/ParserCombinators/ReadPrec.hs
- libraries/ghc-internal/src/GHC/Internal/Text/Read.hs
- libraries/ghc-internal/src/GHC/Internal/Text/Read/Lex.hs
- libraries/ghc-internal/src/GHC/Internal/TopHandler.hs
- libraries/ghc-internal/src/GHC/Internal/TypeLits.hs
- libraries/ghc-internal/src/GHC/Internal/TypeLits/Internal.hs
- libraries/ghc-internal/src/GHC/Internal/TypeNats.hs
- libraries/ghc-internal/src/GHC/Internal/TypeNats/Internal.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode/Bits.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode/Char/DerivedCoreProperties.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode/Char/UnicodeData/GeneralCategory.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode/Char/UnicodeData/SimpleLowerCaseMapping.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode/Char/UnicodeData/SimpleTitleCaseMapping.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode/Char/UnicodeData/SimpleUpperCaseMapping.hs
- libraries/ghc-internal/src/GHC/Internal/Unsafe/Coerce.hs
- libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Conc.hs
- libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Conc/Internal.hs
- libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Exports.hs
- libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Flag.hs
- libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Imports.hs
- libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Types.hs
- libraries/ghc-internal/src/GHC/Internal/Weak.hs
- libraries/ghc-internal/src/GHC/Internal/Weak/Finalize.hs
- libraries/ghc-internal/src/GHC/Internal/Windows.hs
- libraries/ghc-internal/src/GHC/Internal/Word.hs
- libraries/ghc-internal/tools/ucd2haskell/exe/UCD2Haskell/ModuleGenerators.hs
- libraries/ghci/GHCi/CreateBCO.hs
- libraries/template-haskell-quasiquoter
- libraries/template-haskell/Language/Haskell/TH/Quote.hs
- m4/fp_prog_cc_linker_target.m4
- nofib
- rts/Stats.c
- rts/StgMiscClosures.cmm
- rts/include/RtsAPI.h
- testsuite/.gitignore
- testsuite/tests/annotations/should_run/all.T
- testsuite/tests/codeGen/should_compile/Makefile
- + testsuite/tests/codeGen/should_compile/T25650.hs
- + testsuite/tests/codeGen/should_compile/T25650.stdout-ws-32
- + testsuite/tests/codeGen/should_compile/T25650.stdout-ws-64
- testsuite/tests/codeGen/should_compile/all.T
- + testsuite/tests/corelint/T15907.hs
- + testsuite/tests/corelint/T15907A.hs
- testsuite/tests/corelint/all.T
- testsuite/tests/deSugar/should_compile/T16615.stderr
- testsuite/tests/deSugar/should_compile/T2431.stderr
- + testsuite/tests/dependent/should_fail/T15588.hs
- + testsuite/tests/dependent/should_fail/T15588.stderr
- testsuite/tests/dependent/should_fail/all.T
- testsuite/tests/dmdanal/should_compile/T16029.stdout
- testsuite/tests/dmdanal/should_compile/T18894.stderr
- + testsuite/tests/dmdanal/should_run/M1.hs
- + testsuite/tests/dmdanal/should_run/T26416.hs
- + testsuite/tests/dmdanal/should_run/T26416.stdout
- testsuite/tests/dmdanal/should_run/all.T
- testsuite/tests/dmdanal/sigs/T21081.stderr
- − testsuite/tests/driver/OneShotTH.stdout-javascript-unknown-ghcjs
- + testsuite/tests/driver/T2057/Makefile
- + testsuite/tests/driver/T2057/README.md
- + testsuite/tests/driver/T2057/T2057.stderr
- + testsuite/tests/driver/T2057/all.T
- + testsuite/tests/driver/T2057/app/Main.hs
- + testsuite/tests/driver/T2057/pkgA1/A.hs
- + testsuite/tests/driver/T2057/pkgA1/pkg.conf
- + testsuite/tests/driver/T2057/pkgA2/A.hs
- + testsuite/tests/driver/T2057/pkgA2/pkg.conf
- + testsuite/tests/driver/T2057/pkgB/B.hs
- + testsuite/tests/driver/T2057/pkgB/pkg.conf
- + testsuite/tests/driver/T20604/T20604.stdout-javascript-unknown-ghcjs
- testsuite/tests/driver/T20604/all.T
- testsuite/tests/driver/all.T
- testsuite/tests/driver/fat-iface/fat010.stdout-javascript-unknown-ghcjs
- testsuite/tests/driver/recomp011/all.T
- testsuite/tests/driver/recompHash/recompHash.stdout-javascript-unknown-ghcjs
- testsuite/tests/driver/recompNoTH/recompNoTH.stdout-javascript-unknown-ghcjs
- − testsuite/tests/driver/th-new-test/th-new-test.stdout-javascript-unknown-ghcjs
- + testsuite/tests/exceptions/T26759.hs
- + testsuite/tests/exceptions/T26759.stderr
- + testsuite/tests/exceptions/T26759a.hs
- + testsuite/tests/exceptions/T26759a.stderr
- + testsuite/tests/exceptions/T26759a.stdout
- testsuite/tests/exceptions/all.T
- + testsuite/tests/ffi/should_run/PrimFFIUnboxedSum.hs
- + testsuite/tests/ffi/should_run/PrimFFIUnboxedSum.stdout
- + testsuite/tests/ffi/should_run/PrimFFIUnboxedSum_cmm.cmm
- testsuite/tests/ffi/should_run/all.T
- testsuite/tests/ghci/prog-mhu005/Makefile
- testsuite/tests/ghci/prog-mhu005/all.T
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005b.script
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005b.stdout
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005c.script
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005c.stderr
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005c.stdout
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005d.script
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005d.stderr
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005d.stdout
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005e.script
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005e.stderr
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005e.stdout
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005f.script
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005f.stderr
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005f.stdout
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005g.script
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005g.stderr
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005g.stdout
- testsuite/tests/ghci/prog022/Makefile
- testsuite/tests/ghci/prog022/all.T
- + testsuite/tests/ghci/prog022/ghci.prog022c.script
- + testsuite/tests/ghci/prog022/ghci.prog022c.stderr
- + testsuite/tests/ghci/prog022/ghci.prog022c.stdout
- + testsuite/tests/ghci/prog022/ghci.prog022d.script
- + testsuite/tests/ghci/prog022/ghci.prog022d.stderr
- + testsuite/tests/ghci/prog022/ghci.prog022d.stdout
- + testsuite/tests/ghci/prog022/ghci.prog022e.script
- + testsuite/tests/ghci/prog022/ghci.prog022e.stderr
- + testsuite/tests/ghci/prog022/ghci.prog022e.stdout
- + testsuite/tests/ghci/prog022/ghci.prog022f.script
- + testsuite/tests/ghci/prog022/ghci.prog022f.stderr
- + testsuite/tests/ghci/prog022/ghci.prog022f.stdout
- + testsuite/tests/ghci/scripts/T24632.hs
- + testsuite/tests/ghci/scripts/T24632.script
- + testsuite/tests/ghci/scripts/T24632.stdout
- testsuite/tests/ghci/scripts/all.T
- 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/template-haskell-exports.stdout
- testsuite/tests/javascript/js-mk_tup.hs
- testsuite/tests/javascript/js-mk_tup.stdout
- testsuite/tests/linters/Makefile
- testsuite/tests/numeric/should_compile/T14170.stdout
- testsuite/tests/numeric/should_compile/T14465.stdout
- testsuite/tests/numeric/should_compile/T7116.stdout
- testsuite/tests/perf/compiler/T9675.hs
- + testsuite/tests/perf/should_run/T1216.hs
- + testsuite/tests/perf/should_run/T1216.stdout
- testsuite/tests/perf/should_run/all.T
- testsuite/tests/perf/size/all.T
- testsuite/tests/plugins/plugins09.stdout
- testsuite/tests/plugins/plugins10.stdout
- testsuite/tests/plugins/plugins11.stdout
- testsuite/tests/plugins/static-plugins.stdout
- + testsuite/tests/polykinds/T18186.hs
- + testsuite/tests/polykinds/T18186.stderr
- testsuite/tests/polykinds/all.T
- testsuite/tests/profiling/should_run/callstack001.stdout
- testsuite/tests/profiling/should_run/callstack002.stderr
- testsuite/tests/profiling/should_run/callstack002.stdout
- testsuite/tests/quotes/QQError.stderr
- testsuite/tests/roles/should_compile/Roles1.stderr
- testsuite/tests/roles/should_compile/Roles13.stderr
- testsuite/tests/roles/should_compile/Roles14.stderr
- testsuite/tests/roles/should_compile/Roles2.stderr
- testsuite/tests/roles/should_compile/Roles3.stderr
- testsuite/tests/roles/should_compile/Roles4.stderr
- testsuite/tests/roles/should_compile/T8958.stderr
- testsuite/tests/simplCore/should_compile/OpaqueNoCastWW.stderr
- + testsuite/tests/simplCore/should_compile/T12640.hs
- + testsuite/tests/simplCore/should_compile/T12640.stderr
- + testsuite/tests/simplCore/should_compile/T14908.hs
- + testsuite/tests/simplCore/should_compile/T14908_Deps.hs
- + testsuite/tests/simplCore/should_compile/T16122.hs
- + testsuite/tests/simplCore/should_compile/T16122.stderr
- testsuite/tests/simplCore/should_compile/T3717.stderr
- testsuite/tests/simplCore/should_compile/T3772.stdout
- testsuite/tests/simplCore/should_compile/T4908.stderr
- testsuite/tests/simplCore/should_compile/T4930.stderr
- testsuite/tests/simplCore/should_compile/T7360.stderr
- testsuite/tests/simplCore/should_compile/T8274.stdout
- testsuite/tests/simplCore/should_compile/T9400.stderr
- + testsuite/tests/simplCore/should_compile/T9445.hs
- testsuite/tests/simplCore/should_compile/all.T
- testsuite/tests/simplCore/should_compile/noinline01.stderr
- testsuite/tests/simplCore/should_compile/par01.stderr
- testsuite/tests/th/QQTopError.stderr
- testsuite/tests/th/TH_Roles2.stderr
- testsuite/tests/typecheck/should_compile/T13032.stderr
- + testsuite/tests/typecheck/should_compile/T14151.hs
- testsuite/tests/typecheck/should_compile/T18406b.stderr
- testsuite/tests/typecheck/should_compile/T18529.stderr
- testsuite/tests/typecheck/should_compile/T9497a.stderr
- testsuite/tests/typecheck/should_compile/all.T
- testsuite/tests/typecheck/should_compile/holes.stderr
- testsuite/tests/typecheck/should_compile/holes3.stderr
- testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr
- + testsuite/tests/typecheck/should_fail/T12694.hs
- + testsuite/tests/typecheck/should_fail/T12694.stderr
- + testsuite/tests/typecheck/should_fail/T16275.stderr
- + testsuite/tests/typecheck/should_fail/T16275A.hs
- + testsuite/tests/typecheck/should_fail/T16275B.hs
- + testsuite/tests/typecheck/should_fail/T16275B.hs-boot
- testsuite/tests/typecheck/should_fail/T9497d.stderr
- testsuite/tests/typecheck/should_fail/all.T
- testsuite/tests/typecheck/should_run/T9497a-run.stderr
- testsuite/tests/typecheck/should_run/T9497b-run.stderr
- testsuite/tests/typecheck/should_run/T9497c-run.stderr
- utils/haddock/html-test/ref/Bug1004.html
- utils/haddock/html-test/ref/Bug973.html
- utils/haddock/html-test/ref/ConstructorPatternExport.html
- utils/haddock/html-test/ref/DefaultSignatures.html
- utils/haddock/html-test/ref/Hash.html
- utils/haddock/html-test/ref/PatternSyns.html
- utils/haddock/html-test/ref/PatternSyns2.html
- utils/haddock/html-test/ref/QuasiExpr.html
- utils/haddock/html-test/ref/Test.html
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4dd987ff020e3c9eb94065925de21b…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4dd987ff020e3c9eb94065925de21b…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/jeltsch/system-io-implementation-into-base] 53 commits: Apply NOINLINE pragmas to generated Typeable bindings
by Wolfgang Jeltsch (＠jeltsch) 19 Mar '26
by Wolfgang Jeltsch (＠jeltsch) 19 Mar '26
19 Mar '26
Wolfgang Jeltsch pushed to branch wip/jeltsch/system-io-implementation-into-base at Glasgow Haskell Compiler / GHC
Commits:
e659610c by Duncan Coutts at 2026-03-09T12:08:35-04:00
Apply NOINLINE pragmas to generated Typeable bindings
For context, see the existing Note [Grand plan for Typeable]
and the Note [NOINLINE on generated Typeable bindings] added in the
subsequent commit.
This is about reducing the number of exported top level names and
unfoldings, which reduces interface file sizes and reduces the number of
global/dynamic linker symbols.
Also accept the changed test output and metric decreases.
Tests that record the phase output for type checking or for simplifier
end up with different output: the generated bindings now have an
Inline [~] annotation, and many top level names are now local rather
than module-prefixed for export.
Also accept the numerous metric decreases in compile_time/bytes
allocated, and a few in compile_time/max_bytes_used.
There's also one instance of a decrease in runtime/max_bytes_used but
it's a ghci-way test and so presumably the reason is that it loads
smaller .hi files and/or links fewer symbols.
-------------------------
Metric Decrease:
CoOpt_Singletons
MultiLayerModulesTH_OneShot
MultilineStringsPerf
T10421
T10547
T12150
T12227
T12234
T12425
T13035
T13056
T13253
T13253-spj
T15304
T15703
T16875
T17836b
T17977b
T18140
T18223
T18282
T18304
T18698a
T18698b
T18730
T18923
T20049
T21839c
T24471
T24582
T24984
T3064
T4029
T5030
T5642
T5837
T6048
T9020
T9198
T9961
TcPlugin_RewritePerf
WWRec
hard_hole_fits
mhu-perf
-------------------------
- - - - -
67df5161 by Duncan Coutts at 2026-03-09T12:08:35-04:00
Add documentation Note [NOINLINE on generated Typeable bindings]
and refer to it from the code and existing documentation.
- - - - -
c4ad6167 by Duncan Coutts at 2026-03-09T12:08:35-04:00
Switch existing note to "named wrinkle" style, (GPT1)..(GPT7)
GPT = Grand plan for Typeable
- - - - -
dc84f8e2 by Cheng Shao at 2026-03-09T12:09:21-04:00
ci: only build deb13 for validate pipeline aarch64-linux jobs
This patch drops the redundant aarch64-linux deb12 job from validate pipelines
and only keeps deb13; it's still built in nightly/release pipelines. Closes #27004.
- - - - -
23a50772 by Rajkumar Natarajan at 2026-03-10T14:11:37-04:00
chore: Merge GHC.Internal.TH.Quote into GHC.Internal.TH.Monad
Move the QuasiQuoter datatype from GHC.Internal.TH.Quote to
GHC.Internal.TH.Monad and delete the Quote module.
Update submodule template-haskell-quasiquoter to use the merged
upstream version that imports from the correct module.
Co-authored-by: Cursor <cursoragent(a)cursor.com>
- - - - -
a2bb6fc3 by Simon Jakobi at 2026-03-10T14:12:23-04:00
Add regression test for #16122
- - - - -
604e1180 by Cheng Shao at 2026-03-11T15:00:42-04:00
hadrian: remove the broken bench flavour
This patch removes the bench flavour from hadrian which has been
broken for years and not used for actual benchmarking (for which
`perf`/`release` is used instead). Closes #26825.
- - - - -
c3e64915 by Simon Jakobi at 2026-03-11T15:01:31-04:00
Add regression test for #18186
The original TypeInType language extension is replaced with
DataKinds+PolyKinds for compatibility.
Closes #18186.
- - - - -
664996c7 by Andreas Klebinger at 2026-03-11T15:02:16-04:00
Bump nofib submodule.
We accrued a number of nofib fixes we want to have here.
- - - - -
517cf64e by Simon Jakobi at 2026-03-11T15:03:03-04:00
Add regression test for #15907
Closes #15907.
- - - - -
fff362cf by Simon Jakobi at 2026-03-11T15:03:49-04:00
Ensure T14272 is run in optasm way
Closes #16539.
- - - - -
ec81ec2c by Simon Jakobi at 2026-03-11T15:03:49-04:00
Add regression test for #24632
Closes #24632.
- - - - -
cefec47b by Simon Jakobi at 2026-03-11T15:03:50-04:00
Fix module name of T9675: T6975 -> T9675
- - - - -
d3690ae8 by Andreas Klebinger at 2026-03-11T15:04:31-04:00
User guide: Clarify phase control on INLINEABLE[foo] pragmas.
Fixes #26851
- - - - -
e7054934 by Simon Jakobi at 2026-03-11T15:05:16-04:00
Add regression test for #12694
Closes #12694.
- - - - -
4756d9f6 by Simon Jakobi at 2026-03-11T15:05:16-04:00
Add regression test for #16275
Closes #16275.
- - - - -
34b7e2c1 by Simon Jakobi at 2026-03-11T15:05:16-04:00
Add regression test for #14908
Closes #14908.
- - - - -
4243db3d by Simon Jakobi at 2026-03-11T15:05:16-04:00
Add regression test for #14151
Closes #14151.
- - - - -
0e9f1453 by Simon Jakobi at 2026-03-11T15:05:16-04:00
Add regression test for #12640
Closes #12640.
- - - - -
ae606c7f by Simon Jakobi at 2026-03-11T15:05:16-04:00
Add regression test for #15588
Closes #15588.
- - - - -
5a38ce4e by Simon Jakobi at 2026-03-11T15:05:16-04:00
Add regression test for #9445
Closes #9445.
- - - - -
d054b467 by Cheng Shao at 2026-03-11T15:05:59-04:00
compiler: implement string interning logic for BCONPtrFS
This patch adds a `FastStringEnv`-based cache of `MallocStrings`
requests to `Interp`, so that when we load bytecode with many
breakpoints that share the same module names & unit ids, we reuse the
allocated remote pointers instead of issuing duplicte `MallocStrings`
requests and bloating the C heap. Closes #26995.
- - - - -
b85a0293 by Simon Jakobi at 2026-03-11T15:06:41-04:00
Add perf test for #1216
Closes #1216.
- - - - -
cd7f7420 by Sylvain Henry at 2026-03-11T15:07:58-04:00
JS: check that tuple constructors are linked (#23709)
Test js-mk_tup was failing before because tuple constructors weren't
linked in. It's no longer an issue after the linker fixes.
- - - - -
d57f01a4 by Matthew Pickering at 2026-03-11T15:08:40-04:00
testsuite: Add test for foreign import prim with unboxed tuple return
This commit just adds a test that foreign import prim works with unboxed
sums.
- - - - -
23d111ce by Matthew Pickering at 2026-03-11T15:08:41-04:00
Return a valid pointer in advanceStackFrameLocationzh
When there is no next stack chunk, `advanceStackFrameLocationzh` used to
return NULL in the pointer-typed StackSnapshot# result slot.
Even though the caller treats that case as "no next frame", the result is
still materialized in a GC-visible pointer slot. If a GC observes the raw
NULL there, stack decoding can crash.
Fix this by ensuring the dead pointer slot contains a valid closure
pointer. Also make the optional result explicit by returning an unboxed
sum instead of a tuple with a separate tag.
Fixes #27009
- - - - -
4c58a3ae by Cheng Shao at 2026-03-11T15:09:22-04:00
hadrian: build profiled dynamic objects with -dynamic-too
This patch enables hadrian to build profiled dynamic objects with
`-dynamic-too`, addressing a build parallelism bottleneck in release
pipelines. Closes #27010.
- - - - -
870243e4 by Zubin Duggal at 2026-03-12T17:33:28+05:30
DmdAnal: Take stable unfoldings into account when determining argument demands
Previously, demand analysis only looked at the RHS to compute argument demands.
If the optimised RHS discarded uses of an argument that the stable unfolding
still needed, it would be incorrectly marked absent. Worker/wrapper would then
replace it with LitRubbish, and inlining the stable unfolding would use the
rubbish value, causing a segfault.
To fix, we introduce addUnfoldingDemands which analyses the stable unfolding
with dmdAnal and combines its DmdType with the RHS's via the new `maxDmdType`
which combines the demands of the stable unfolding with the rhs, so we can avoid
any situation where we give an absent demand to something which is still used
by the stable unfolding.
Fixes #26416.
- - - - -
669d09f9 by Cheng Shao at 2026-03-13T15:06:07-04:00
hadrian: remove redundant library/rts ways definitions from stock flavours
This patch removes redundant library/rts ways definitions from stock
flavours in hadrian; they can be replaced by applying appropriate
filters on `defaultFlavour`.
- - - - -
a27dc081 by Teo Camarasu at 2026-03-13T15:06:51-04:00
ghc-internal: move bits Weak of finalizer interface to base
We move parts of the Weak finalizer interface to `base` only the parts
that the RTS needs to know about are kept in `ghc-internal`.
This lets us then prune our imports somewhat and get rid of some SOURCE imports.
Resolves #26985
- - - - -
6eef855b by Sylvain Henry at 2026-03-13T15:08:18-04:00
Stg/Unarise: constant-folding during unarisation (#25650)
When building an unboxed sum from a literal argument, mkUbxSum
previously emitted a runtime cast via `case primop [lit] of var -> ...`.
This wrapper prevented GHC from recognising the result as a static
StgRhsCon, causing top-level closures to be allocated as thunks instead
of being statically allocated.
Fix: try to perform the numeric literal cast at compile time using
mkLitNumberWrap (wrapping semantics). If successful, return the cast
literal directly with an identity wrapper (no case expression). The
runtime cast path is kept as fallback for non-literal arguments.
Test: codeGen/should_compile/T25650
- - - - -
905f8723 by Simon Jakobi at 2026-03-13T15:09:09-04:00
Add regression test for #2057
Test that GHC stops after an interface-file error instead of
continuing into the linker.
The test constructs a stale package dependency on purpose. `pkgB` is compiled
against one version of package `A`, then the same unit id is replaced by an
incompatible build of `A`. When `Main` imports `B`, GHC has to read `B.hi`,
finds an unfolding that still mentions the old `A`, and should fail while
loading interfaces.
Closes #2057.
Assisted-by: Codex
- - - - -
a13245a9 by Sylvain Henry at 2026-03-13T15:10:06-04:00
JS: fix recompilation avoidance (#23013)
- we were checking the mtime of the *.jsexe directory, not of a file
- we were not computing the PkgsLoaded at all
- - - - -
07442653 by Cheng Shao at 2026-03-13T15:10:51-04:00
hadrian: bump index state & bootstrap plans
This patch bumps hadrian index state & bootstrap plans:
- The updated index state allows bootstrapping from 9.14 without cabal
allow-newer hacks
- The updated bootstrap plans all contain shake-0.19.9 containing
important bugfix, allowing a subsequent patch to bump shake bound to
ensure the bugfix is included
- ghc 9.14.1 bootstrap plan is added
- - - - -
fdc1dbad by Cheng Shao at 2026-03-13T15:10:51-04:00
ci: add ghc 9.14.1 to bootstrap matrix
This patch adds ghc 9.14.1 to bootstrap matrix, so that we test
bootstrapping from ghc 9.14.1.
- - - - -
91916079 by Sylvain Henry at 2026-03-13T15:11:43-04:00
T17912: wait for opener thread to block before killing it (#24739)
Instead of a fixed 1000ms delay, poll threadStatus until the opener
thread is in BlockedOnForeignCall, ensuring killThread only fires once
the thread is provably inside the blocking open() syscall. This prevents
the test from accidentally passing on Windows due to scheduling races.
- - - - -
baa4ebb4 by Cheng Shao at 2026-03-13T15:12:26-04:00
template-haskell: fix redundant import in Language.Haskell.TH.Quote
This patch fixes a redundant import in `Language.Haskell.TH.Quote`
that causes a ghc build failure when bootstrapping from 9.14 with
validate flavours. Fixes #27014.
- - - - -
02e68a86 by Brandon Simmons at 2026-03-13T15:13:19-04:00
Add a cumulative gc_sync_elapsed_ns counter to GHC.Internal.Stats
This makes it possible to get an accurate view of time spent in sync
phase when using prometheus-style sampling. Previously this was only
available for the most recent GC.
This intentionally leaves GHC.Stats API unchanged since it is marked as
deprecated, and API changes there require CLC approval.
Fixes #26944
- - - - -
a18fa3c1 by Cheng Shao at 2026-03-14T05:12:14-04:00
configure: make $LLVMAS default to $CC when $CcLlvmBackend is YES
This patch changes the $LLVMAS detection logic in configure so that
when it's not manually specified by the user, it defaults to $CC if
$CcLlvmBackend is YES. It's a more sensible default than auto-detected
clang from the environment, especially when cross-compiling, $CC as
the cross target's LLVM assembler is more compatible with the use case
than the system-wide clang. Fixes #26769.
- - - - -
3774086e by Matthew Pickering at 2026-03-14T05:13:00-04:00
exceptions: annotate onException continuation with WhileHandling
Before this patch, an exception thrown in the `onException` handler
would loose track of where the original exception was thrown.
```
import Control.Exception
main :: IO ()
main = failingAction `onException` failingCleanup
where
failingAction = throwIO (ErrorCall "outer failure")
failingCleanup = throwIO (ErrorCall "cleanup failure")
```
would report
```
T28399: Uncaught exception ghc-internal:GHC.Internal.Exception.ErrorCall:
cleanup failure
HasCallStack backtrace:
throwIO, called at T28399.hs:<line>:<column> in <package-id>:Main
```
notice that the "outer failure" exception is not present in the error
message.
With this patch, any exception thrown is in the handler is annotated
with WhileHandling. The resulting message looks like
```
T28399: Uncaught exception ghc-internal:GHC.Internal.Exception.ErrorCall:
cleanup failure
While handling outer failure
HasCallStack backtrace:
throwIO, called at T28399.hs:7:22 in main:Main
```
CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/397
Fixes #26759
- - - - -
63ae8eb3 by Andreas Klebinger at 2026-03-14T05:13:43-04:00
Fix missing profiling header for origin_thunk frame.
Fixes #27007
- - - - -
213d2c0e by Cheng Shao at 2026-03-14T05:14:28-04:00
ci: fix ci-images revision
The current ci-images revision was a commit on the WIP branch of
https://gitlab.haskell.org/ghc/ci-images/-/merge_requests/183, and
it's not on the current ci-images master branch. This patch fixes the
image revision to use the current tip of ci-images master.
- - - - -
fc2b083f by Andreas Klebinger at 2026-03-14T05:15:14-04:00
Revert "hadrian/build-cabal: Better respect and utilize -j"
This reverts commit eab3dbba79650e6046efca79133b4c0a5257613d.
While it's neat this currently isn't well supported on all platforms.
It's time will come, but for now I'm reverting this to avoid issues for
users on slightly unconvential platforms.
This will be tracked at #26977.
- - - - -
12a706cf by Cheng Shao at 2026-03-14T16:37:54-04:00
base: fix redundant imports in GHC.Internal.Weak.Finalize
This patch fixes redundant imports in GHC.Internal.Weak.Finalize that
causes a regression in bootstrapping head from 9.14 with validate
flavours. Fixes #27026.
- - - - -
b5d39cad by Matthew Pickering at 2026-03-14T16:38:37-04:00
Use explicit syntax rather than pure
- - - - -
43638643 by Andreas Klebinger at 2026-03-15T18:15:48-04:00
Configure: Fix check for --target support in stage0 CC
The check FP_PROG_CC_LINKER_TARGET used $CC unconditionally to check for
--target support. However this fails for the stage0 config where the C
compiler used is not $CC but $CC_STAGE0.
Since we already pass the compiler under test into the macro I simply
changed it to use that instead.
Fixes #26999
- - - - -
18fd0df6 by Simon Hengel at 2026-03-15T18:16:33-04:00
Fix typo in recursive_do.rst
- - - - -
86bd9bfc by fendor at 2026-03-17T23:46:09-04:00
Introduce `-fimport-loaded-targets` GHCi flag
This new flag automatically adds all loaded targets to the GHCi session
by adding an `InteractiveImport` for the loaded targets.
By default, this flag is disabled, as it potentially increases memory-usage.
This interacts with the flag `-fno-load-initial-targets` as follows:
* If no module is loaded, no module is added as an interactive import.
* If a reload loads up to a module, all loaded modules are added as
interactive imports.
* Unloading modules removes them from the interactive context.
Fixes #26866 by rendering the use of a `-ghci-script` to achieve the
same thing redundant.
- - - - -
e3d4c1bb by mniip at 2026-03-17T23:47:03-04:00
ghc-internal: Remove GHC.Internal.Data.Eq
It served no purpose other than being a re-export.
- - - - -
6f4f6cf0 by mniip at 2026-03-17T23:47:03-04:00
ghc-internal: Refine GHC.Internal.Base imports
Removed re-exports from GHC.Internal.Base. This reveals some modules
that don't actually use anything *defined* in GHC.Internal.Base, and
that can be pushed down a little in the import graph.
Replaced most imports of GHC.Internal.Base with non-wildcard imports
from modules where the identifiers are actually defined.
Part of #26834
Metric Decrease:
T5321FD
- - - - -
7fb51f54 by mangoiv at 2026-03-17T23:48:00-04:00
ci: clone, don't copy when creating the cabal cache
Also removed WINDOWS_HOST variable detected via uname - we now just
check whether the CI job has windows in its name. This works because we
only ever care about it if the respective job is not a cross job. We
also statically detect darwin cross jobs in the same way. We only ever have
darwin -> darwin cross jobs so this is enough to detect the host
reliably.
- - - - -
f8817879 by mangoiv at 2026-03-17T23:48:44-04:00
ci: mark size_hello_artifact fragile on darwin x86
The size of the x86_64 hello artifact is not stable which results in flaky testruns.
Resolves #26814
- - - - -
31b362ef by Wolfgang Jeltsch at 2026-03-18T22:53:37+02:00
Move most of the `System.IO` implementation into `base`
Metric Increase:
T12227
T12707
T5642
- - - - -
490 changed files:
- .gitlab-ci.yml
- .gitlab/ci.sh
- .gitlab/generate-ci/gen_ci.hs
- .gitlab/jobs.yaml
- compiler/GHC/Builtin/Names/TH.hs
- compiler/GHC/ByteCode/Linker.hs
- compiler/GHC/Core/Opt/DmdAnal.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Driver/Pipeline.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Iface/Recomp.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Runtime/Interpreter/Init.hs
- compiler/GHC/Runtime/Interpreter/Types.hs
- compiler/GHC/Stg/Pipeline.hs
- compiler/GHC/Stg/Unarise.hs
- compiler/GHC/Tc/Instance/Typeable.hs
- compiler/GHC/Types/Demand.hs
- configure.ac
- distrib/configure.ac.in
- docs/users_guide/exts/pragmas.rst
- docs/users_guide/exts/recursive_do.rst
- docs/users_guide/exts/rewrite_rules.rst
- docs/users_guide/ghci.rst
- ghc/GHCi/UI.hs
- hadrian/bootstrap/generate_bootstrap_plans
- hadrian/bootstrap/plan-9_10_1.json
- hadrian/bootstrap/plan-9_10_2.json
- hadrian/bootstrap/plan-9_10_3.json
- hadrian/bootstrap/plan-9_12_1.json
- hadrian/bootstrap/plan-9_12_2.json
- + hadrian/bootstrap/plan-9_14_1.json
- hadrian/bootstrap/plan-bootstrap-9_10_1.json
- hadrian/bootstrap/plan-bootstrap-9_10_2.json
- hadrian/bootstrap/plan-bootstrap-9_10_3.json
- hadrian/bootstrap/plan-bootstrap-9_12_1.json
- hadrian/bootstrap/plan-bootstrap-9_12_2.json
- + hadrian/bootstrap/plan-bootstrap-9_14_1.json
- hadrian/build-cabal
- hadrian/cabal.project
- hadrian/doc/flavours.md
- hadrian/hadrian.cabal
- hadrian/src/Rules/Compile.hs
- hadrian/src/Settings.hs
- hadrian/src/Settings/Builders/Ghc.hs
- − hadrian/src/Settings/Flavours/Benchmark.hs
- hadrian/src/Settings/Flavours/Development.hs
- hadrian/src/Settings/Flavours/GhcInGhci.hs
- hadrian/src/Settings/Flavours/Quick.hs
- hadrian/src/Settings/Flavours/QuickCross.hs
- hadrian/src/Settings/Flavours/Quickest.hs
- libraries/base/changelog.md
- libraries/base/src/Control/Applicative.hs
- libraries/base/src/Data/Char.hs
- libraries/base/src/Data/Eq.hs
- libraries/base/src/Data/Semigroup.hs
- libraries/base/src/GHC/Base.hs
- libraries/base/src/GHC/IO/Handle.hs
- libraries/base/src/GHC/Stats.hs
- libraries/base/src/GHC/Weak.hs
- libraries/base/src/GHC/Weak/Finalize.hs
- − libraries/base/src/GHC/Weak/Finalizehs
- libraries/base/src/Prelude.hs
- libraries/base/src/System/IO.hs
- libraries/base/src/System/Mem/Weak.hs
- libraries/base/src/Text/Printf.hs
- libraries/base/tests/IO/T17912.hs
- libraries/base/tests/IO/all.T
- libraries/ghc-boot-th/GHC/Boot/TH/Quote.hs
- libraries/ghc-experimental/src/GHC/Profiling/Eras.hs
- libraries/ghc-internal/CHANGELOG.md
- libraries/ghc-internal/cbits/Stack.cmm
- libraries/ghc-internal/codepages/MakeTable.hs
- libraries/ghc-internal/ghc-internal.cabal.in
- libraries/ghc-internal/src/GHC/Internal/AllocationLimitHandler.hs
- libraries/ghc-internal/src/GHC/Internal/Arr.hs
- libraries/ghc-internal/src/GHC/Internal/Base.hs
- libraries/ghc-internal/src/GHC/Internal/Bits.hs
- libraries/ghc-internal/src/GHC/Internal/ByteOrder.hs
- libraries/ghc-internal/src/GHC/Internal/Char.hs
- libraries/ghc-internal/src/GHC/Internal/Clock.hsc
- libraries/ghc-internal/src/GHC/Internal/ClosureTypes.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/Bound.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/IO.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/POSIX.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/Signal.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/Sync.hs
- − libraries/ghc-internal/src/GHC/Internal/Conc/Sync.hs-boot
- libraries/ghc-internal/src/GHC/Internal/Conc/Windows.hs
- libraries/ghc-internal/src/GHC/Internal/ConsoleHandler.hsc
- libraries/ghc-internal/src/GHC/Internal/Control/Arrow.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Concurrent/MVar.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Exception.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad/Fail.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad/Fix.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad/IO/Class.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad/ST/Imp.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad/ST/Lazy/Imp.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Bits.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Data.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Dynamic.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Either.hs
- − libraries/ghc-internal/src/GHC/Internal/Data/Eq.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/Const.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Functor/Identity.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Functor/Utils.hs
- libraries/ghc-internal/src/GHC/Internal/Data/IORef.hs
- libraries/ghc-internal/src/GHC/Internal/Data/List.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Maybe.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Monoid.hs
- libraries/ghc-internal/src/GHC/Internal/Data/OldList.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Ord.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Proxy.hs
- libraries/ghc-internal/src/GHC/Internal/Data/STRef.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Semigroup/Internal.hs
- libraries/ghc-internal/src/GHC/Internal/Data/String.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Traversable.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Type/Bool.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Type/Coercion.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Type/Equality.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Type/Ord.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Typeable.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Typeable/Internal.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Unique.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Version.hs
- libraries/ghc-internal/src/GHC/Internal/Debug/Trace.hs
- libraries/ghc-internal/src/GHC/Internal/Debug/Trace.hs-boot
- libraries/ghc-internal/src/GHC/Internal/Encoding/UTF8.hs
- libraries/ghc-internal/src/GHC/Internal/Enum.hs
- libraries/ghc-internal/src/GHC/Internal/Environment.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Array.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Control.hs
- libraries/ghc-internal/src/GHC/Internal/Event/EPoll.hsc
- libraries/ghc-internal/src/GHC/Internal/Event/IntVar.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Internal.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Internal/Types.hs
- libraries/ghc-internal/src/GHC/Internal/Event/KQueue.hsc
- libraries/ghc-internal/src/GHC/Internal/Event/Manager.hs
- libraries/ghc-internal/src/GHC/Internal/Event/PSQ.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Poll.hsc
- libraries/ghc-internal/src/GHC/Internal/Event/Thread.hs
- libraries/ghc-internal/src/GHC/Internal/Event/TimeOut.hs
- libraries/ghc-internal/src/GHC/Internal/Event/TimerManager.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Unique.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Windows.hsc
- libraries/ghc-internal/src/GHC/Internal/Event/Windows/Clock.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Windows/ConsoleEvent.hsc
- libraries/ghc-internal/src/GHC/Internal/Event/Windows/FFI.hsc
- libraries/ghc-internal/src/GHC/Internal/Event/Windows/ManagedThreadPool.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Windows/Thread.hs
- libraries/ghc-internal/src/GHC/Internal/Exception.hs
- libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs
- libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs-boot
- libraries/ghc-internal/src/GHC/Internal/Exception/Context.hs
- libraries/ghc-internal/src/GHC/Internal/Exception/Type.hs
- libraries/ghc-internal/src/GHC/Internal/ExecutionStack.hs
- libraries/ghc-internal/src/GHC/Internal/ExecutionStack/Internal.hsc
- libraries/ghc-internal/src/GHC/Internal/Exts.hs
- libraries/ghc-internal/src/GHC/Internal/Fingerprint.hs
- libraries/ghc-internal/src/GHC/Internal/Fingerprint.hs-boot
- libraries/ghc-internal/src/GHC/Internal/Fingerprint/Type.hs
- libraries/ghc-internal/src/GHC/Internal/Float.hs
- libraries/ghc-internal/src/GHC/Internal/Float/ConversionUtils.hs
- libraries/ghc-internal/src/GHC/Internal/Float/RealFracMethods.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/C/ConstPtr.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/C/Error.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/C/String.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/C/String/Encoding.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/C/Types.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/ForeignPtr/Imp.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/Marshal/Alloc.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/Marshal/Array.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/Marshal/Error.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/Marshal/Pool.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/Marshal/Utils.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/Ptr.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/Storable.hs
- libraries/ghc-internal/src/GHC/Internal/ForeignPtr.hs
- libraries/ghc-internal/src/GHC/Internal/ForeignSrcLang.hs
- libraries/ghc-internal/src/GHC/Internal/Functor/ZipList.hs
- libraries/ghc-internal/src/GHC/Internal/GHCi.hs
- libraries/ghc-internal/src/GHC/Internal/GHCi/Helpers.hs
- libraries/ghc-internal/src/GHC/Internal/Generics.hs
- libraries/ghc-internal/src/GHC/Internal/Heap/Closures.hs
- libraries/ghc-internal/src/GHC/Internal/Heap/InfoTable.hsc
- libraries/ghc-internal/src/GHC/Internal/Heap/InfoTable/Types.hsc
- libraries/ghc-internal/src/GHC/Internal/Heap/InfoTableProf.hsc
- libraries/ghc-internal/src/GHC/Internal/Heap/ProfInfo/Types.hs
- libraries/ghc-internal/src/GHC/Internal/IO.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Buffer.hs
- libraries/ghc-internal/src/GHC/Internal/IO/BufferedIO.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Device.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/CodePage.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/CodePage/API.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/CodePage/Table.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/Failure.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/Iconv.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/Latin1.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/Types.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/UTF16.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/UTF32.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/UTF8.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs-boot
- libraries/ghc-internal/src/GHC/Internal/IO/FD.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/FD.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Internals.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/Flock.hsc
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/LinuxOFD.hsc
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/NoOp.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/Windows.hsc
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Text.hs
- − libraries/ghc-internal/src/GHC/Internal/IO/Handle/Text.hs-boot
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Types.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Windows.hs
- libraries/ghc-internal/src/GHC/Internal/IO/IOMode.hs
- libraries/ghc-internal/src/GHC/Internal/IO/SubSystem.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Unsafe.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Windows/Encoding.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Windows/Handle.hsc
- libraries/ghc-internal/src/GHC/Internal/IOArray.hs
- libraries/ghc-internal/src/GHC/Internal/IORef.hs
- libraries/ghc-internal/src/GHC/Internal/InfoProv.hs
- libraries/ghc-internal/src/GHC/Internal/InfoProv/Types.hsc
- libraries/ghc-internal/src/GHC/Internal/Int.hs
- libraries/ghc-internal/src/GHC/Internal/IsList.hs
- libraries/ghc-internal/src/GHC/Internal/Ix.hs
- libraries/ghc-internal/src/GHC/Internal/JS/Foreign/Callback.hs
- libraries/ghc-internal/src/GHC/Internal/JS/Prim/Internal.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/Lexeme.hs
- libraries/ghc-internal/src/GHC/Internal/List.hs
- libraries/ghc-internal/src/GHC/Internal/MVar.hs
- libraries/ghc-internal/src/GHC/Internal/Num.hs
- libraries/ghc-internal/src/GHC/Internal/Numeric.hs
- libraries/ghc-internal/src/GHC/Internal/OverloadedLabels.hs
- libraries/ghc-internal/src/GHC/Internal/Pack.hs
- libraries/ghc-internal/src/GHC/Internal/Profiling.hs
- libraries/ghc-internal/src/GHC/Internal/Ptr.hs
- libraries/ghc-internal/src/GHC/Internal/RTS/Flags.hsc
- libraries/ghc-internal/src/GHC/Internal/RTS/Flags/Test.hsc
- libraries/ghc-internal/src/GHC/Internal/Read.hs
- libraries/ghc-internal/src/GHC/Internal/Real.hs
- libraries/ghc-internal/src/GHC/Internal/ST.hs
- libraries/ghc-internal/src/GHC/Internal/STM.hs
- libraries/ghc-internal/src/GHC/Internal/STRef.hs
- libraries/ghc-internal/src/GHC/Internal/Show.hs
- libraries/ghc-internal/src/GHC/Internal/Stable.hs
- libraries/ghc-internal/src/GHC/Internal/StableName.hs
- libraries/ghc-internal/src/GHC/Internal/Stack.hs
- libraries/ghc-internal/src/GHC/Internal/Stack.hs-boot
- libraries/ghc-internal/src/GHC/Internal/Stack/Annotation.hs
- libraries/ghc-internal/src/GHC/Internal/Stack/CCS.hsc
- libraries/ghc-internal/src/GHC/Internal/Stack/CloneStack.hs
- libraries/ghc-internal/src/GHC/Internal/Stack/Constants.hsc
- libraries/ghc-internal/src/GHC/Internal/Stack/ConstantsProf.hsc
- libraries/ghc-internal/src/GHC/Internal/Stack/Decode.hs
- libraries/ghc-internal/src/GHC/Internal/StaticPtr.hs
- libraries/ghc-internal/src/GHC/Internal/StaticPtr/Internal.hs
- libraries/ghc-internal/src/GHC/Internal/Stats.hsc
- libraries/ghc-internal/src/GHC/Internal/Storable.hs
- libraries/ghc-internal/src/GHC/Internal/System/Environment.hs
- libraries/ghc-internal/src/GHC/Internal/System/Environment/Blank.hsc
- libraries/ghc-internal/src/GHC/Internal/System/Environment/ExecutablePath.hsc
- libraries/ghc-internal/src/GHC/Internal/System/IO.hs
- libraries/ghc-internal/src/GHC/Internal/System/IO/Error.hs
- libraries/ghc-internal/src/GHC/Internal/System/Mem.hs
- libraries/ghc-internal/src/GHC/Internal/System/Posix/Internals.hs
- libraries/ghc-internal/src/GHC/Internal/System/Posix/Types.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Lib.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/TH/Quote.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Syntax.hs
- libraries/ghc-internal/src/GHC/Internal/Text/ParserCombinators/ReadP.hs
- libraries/ghc-internal/src/GHC/Internal/Text/ParserCombinators/ReadPrec.hs
- libraries/ghc-internal/src/GHC/Internal/Text/Read.hs
- libraries/ghc-internal/src/GHC/Internal/Text/Read/Lex.hs
- libraries/ghc-internal/src/GHC/Internal/TopHandler.hs
- libraries/ghc-internal/src/GHC/Internal/TypeLits.hs
- libraries/ghc-internal/src/GHC/Internal/TypeLits/Internal.hs
- libraries/ghc-internal/src/GHC/Internal/TypeNats.hs
- libraries/ghc-internal/src/GHC/Internal/TypeNats/Internal.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode/Bits.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode/Char/DerivedCoreProperties.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode/Char/UnicodeData/GeneralCategory.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode/Char/UnicodeData/SimpleLowerCaseMapping.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode/Char/UnicodeData/SimpleTitleCaseMapping.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode/Char/UnicodeData/SimpleUpperCaseMapping.hs
- libraries/ghc-internal/src/GHC/Internal/Unsafe/Coerce.hs
- libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Conc.hs
- libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Conc/Internal.hs
- libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Exports.hs
- libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Flag.hs
- libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Imports.hs
- libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Types.hs
- libraries/ghc-internal/src/GHC/Internal/Weak.hs
- libraries/ghc-internal/src/GHC/Internal/Weak/Finalize.hs
- libraries/ghc-internal/src/GHC/Internal/Windows.hs
- libraries/ghc-internal/src/GHC/Internal/Word.hs
- libraries/ghc-internal/tools/ucd2haskell/exe/UCD2Haskell/ModuleGenerators.hs
- libraries/ghci/GHCi/CreateBCO.hs
- libraries/template-haskell-quasiquoter
- libraries/template-haskell/Language/Haskell/TH/Quote.hs
- m4/fp_prog_cc_linker_target.m4
- nofib
- rts/Stats.c
- rts/StgMiscClosures.cmm
- rts/include/RtsAPI.h
- testsuite/.gitignore
- testsuite/tests/annotations/should_run/all.T
- testsuite/tests/codeGen/should_compile/Makefile
- + testsuite/tests/codeGen/should_compile/T25650.hs
- + testsuite/tests/codeGen/should_compile/T25650.stdout-ws-32
- + testsuite/tests/codeGen/should_compile/T25650.stdout-ws-64
- testsuite/tests/codeGen/should_compile/all.T
- + testsuite/tests/corelint/T15907.hs
- + testsuite/tests/corelint/T15907A.hs
- testsuite/tests/corelint/all.T
- testsuite/tests/deSugar/should_compile/T16615.stderr
- testsuite/tests/deSugar/should_compile/T2431.stderr
- + testsuite/tests/dependent/should_fail/T15588.hs
- + testsuite/tests/dependent/should_fail/T15588.stderr
- testsuite/tests/dependent/should_fail/all.T
- testsuite/tests/dmdanal/should_compile/T16029.stdout
- testsuite/tests/dmdanal/should_compile/T18894.stderr
- + testsuite/tests/dmdanal/should_run/M1.hs
- + testsuite/tests/dmdanal/should_run/T26416.hs
- + testsuite/tests/dmdanal/should_run/T26416.stdout
- testsuite/tests/dmdanal/should_run/all.T
- testsuite/tests/dmdanal/sigs/T21081.stderr
- − testsuite/tests/driver/OneShotTH.stdout-javascript-unknown-ghcjs
- + testsuite/tests/driver/T2057/Makefile
- + testsuite/tests/driver/T2057/README.md
- + testsuite/tests/driver/T2057/T2057.stderr
- + testsuite/tests/driver/T2057/all.T
- + testsuite/tests/driver/T2057/app/Main.hs
- + testsuite/tests/driver/T2057/pkgA1/A.hs
- + testsuite/tests/driver/T2057/pkgA1/pkg.conf
- + testsuite/tests/driver/T2057/pkgA2/A.hs
- + testsuite/tests/driver/T2057/pkgA2/pkg.conf
- + testsuite/tests/driver/T2057/pkgB/B.hs
- + testsuite/tests/driver/T2057/pkgB/pkg.conf
- + testsuite/tests/driver/T20604/T20604.stdout-javascript-unknown-ghcjs
- testsuite/tests/driver/T20604/all.T
- testsuite/tests/driver/all.T
- testsuite/tests/driver/fat-iface/fat010.stdout-javascript-unknown-ghcjs
- testsuite/tests/driver/recomp011/all.T
- testsuite/tests/driver/recompHash/recompHash.stdout-javascript-unknown-ghcjs
- testsuite/tests/driver/recompNoTH/recompNoTH.stdout-javascript-unknown-ghcjs
- − testsuite/tests/driver/th-new-test/th-new-test.stdout-javascript-unknown-ghcjs
- + testsuite/tests/exceptions/T26759.hs
- + testsuite/tests/exceptions/T26759.stderr
- + testsuite/tests/exceptions/T26759a.hs
- + testsuite/tests/exceptions/T26759a.stderr
- + testsuite/tests/exceptions/T26759a.stdout
- testsuite/tests/exceptions/all.T
- + testsuite/tests/ffi/should_run/PrimFFIUnboxedSum.hs
- + testsuite/tests/ffi/should_run/PrimFFIUnboxedSum.stdout
- + testsuite/tests/ffi/should_run/PrimFFIUnboxedSum_cmm.cmm
- testsuite/tests/ffi/should_run/all.T
- testsuite/tests/ghci/prog-mhu005/Makefile
- testsuite/tests/ghci/prog-mhu005/all.T
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005b.script
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005b.stdout
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005c.script
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005c.stderr
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005c.stdout
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005d.script
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005d.stderr
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005d.stdout
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005e.script
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005e.stderr
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005e.stdout
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005f.script
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005f.stderr
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005f.stdout
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005g.script
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005g.stderr
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005g.stdout
- testsuite/tests/ghci/prog022/Makefile
- testsuite/tests/ghci/prog022/all.T
- + testsuite/tests/ghci/prog022/ghci.prog022c.script
- + testsuite/tests/ghci/prog022/ghci.prog022c.stderr
- + testsuite/tests/ghci/prog022/ghci.prog022c.stdout
- + testsuite/tests/ghci/prog022/ghci.prog022d.script
- + testsuite/tests/ghci/prog022/ghci.prog022d.stderr
- + testsuite/tests/ghci/prog022/ghci.prog022d.stdout
- + testsuite/tests/ghci/prog022/ghci.prog022e.script
- + testsuite/tests/ghci/prog022/ghci.prog022e.stderr
- + testsuite/tests/ghci/prog022/ghci.prog022e.stdout
- + testsuite/tests/ghci/prog022/ghci.prog022f.script
- + testsuite/tests/ghci/prog022/ghci.prog022f.stderr
- + testsuite/tests/ghci/prog022/ghci.prog022f.stdout
- + testsuite/tests/ghci/scripts/T24632.hs
- + testsuite/tests/ghci/scripts/T24632.script
- + testsuite/tests/ghci/scripts/T24632.stdout
- testsuite/tests/ghci/scripts/all.T
- 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/template-haskell-exports.stdout
- testsuite/tests/javascript/js-mk_tup.hs
- testsuite/tests/javascript/js-mk_tup.stdout
- testsuite/tests/linters/Makefile
- testsuite/tests/numeric/should_compile/T14170.stdout
- testsuite/tests/numeric/should_compile/T14465.stdout
- testsuite/tests/numeric/should_compile/T7116.stdout
- testsuite/tests/perf/compiler/T9675.hs
- + testsuite/tests/perf/should_run/T1216.hs
- + testsuite/tests/perf/should_run/T1216.stdout
- testsuite/tests/perf/should_run/all.T
- testsuite/tests/perf/size/all.T
- testsuite/tests/plugins/plugins10.stdout
- + testsuite/tests/polykinds/T18186.hs
- + testsuite/tests/polykinds/T18186.stderr
- testsuite/tests/polykinds/all.T
- testsuite/tests/profiling/should_run/callstack001.stdout
- testsuite/tests/profiling/should_run/callstack002.stderr
- testsuite/tests/profiling/should_run/callstack002.stdout
- testsuite/tests/quotes/QQError.stderr
- testsuite/tests/roles/should_compile/Roles1.stderr
- testsuite/tests/roles/should_compile/Roles13.stderr
- testsuite/tests/roles/should_compile/Roles14.stderr
- testsuite/tests/roles/should_compile/Roles2.stderr
- testsuite/tests/roles/should_compile/Roles3.stderr
- testsuite/tests/roles/should_compile/Roles4.stderr
- testsuite/tests/roles/should_compile/T8958.stderr
- testsuite/tests/simplCore/should_compile/OpaqueNoCastWW.stderr
- + testsuite/tests/simplCore/should_compile/T12640.hs
- + testsuite/tests/simplCore/should_compile/T12640.stderr
- + testsuite/tests/simplCore/should_compile/T14908.hs
- + testsuite/tests/simplCore/should_compile/T14908_Deps.hs
- + testsuite/tests/simplCore/should_compile/T16122.hs
- + testsuite/tests/simplCore/should_compile/T16122.stderr
- testsuite/tests/simplCore/should_compile/T3717.stderr
- testsuite/tests/simplCore/should_compile/T3772.stdout
- testsuite/tests/simplCore/should_compile/T4908.stderr
- testsuite/tests/simplCore/should_compile/T4930.stderr
- testsuite/tests/simplCore/should_compile/T7360.stderr
- testsuite/tests/simplCore/should_compile/T8274.stdout
- testsuite/tests/simplCore/should_compile/T9400.stderr
- + testsuite/tests/simplCore/should_compile/T9445.hs
- testsuite/tests/simplCore/should_compile/all.T
- testsuite/tests/simplCore/should_compile/noinline01.stderr
- testsuite/tests/simplCore/should_compile/par01.stderr
- testsuite/tests/th/QQTopError.stderr
- testsuite/tests/th/TH_Roles2.stderr
- testsuite/tests/typecheck/should_compile/T13032.stderr
- + testsuite/tests/typecheck/should_compile/T14151.hs
- testsuite/tests/typecheck/should_compile/T18406b.stderr
- testsuite/tests/typecheck/should_compile/T18529.stderr
- testsuite/tests/typecheck/should_compile/T9497a.stderr
- testsuite/tests/typecheck/should_compile/all.T
- testsuite/tests/typecheck/should_compile/holes.stderr
- testsuite/tests/typecheck/should_compile/holes3.stderr
- testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr
- + testsuite/tests/typecheck/should_fail/T12694.hs
- + testsuite/tests/typecheck/should_fail/T12694.stderr
- + testsuite/tests/typecheck/should_fail/T16275.stderr
- + testsuite/tests/typecheck/should_fail/T16275A.hs
- + testsuite/tests/typecheck/should_fail/T16275B.hs
- + testsuite/tests/typecheck/should_fail/T16275B.hs-boot
- testsuite/tests/typecheck/should_fail/T9497d.stderr
- testsuite/tests/typecheck/should_fail/all.T
- testsuite/tests/typecheck/should_run/T9497a-run.stderr
- testsuite/tests/typecheck/should_run/T9497b-run.stderr
- testsuite/tests/typecheck/should_run/T9497c-run.stderr
- utils/haddock/html-test/ref/Bug1004.html
- utils/haddock/html-test/ref/Bug973.html
- utils/haddock/html-test/ref/ConstructorPatternExport.html
- utils/haddock/html-test/ref/DefaultSignatures.html
- utils/haddock/html-test/ref/Hash.html
- utils/haddock/html-test/ref/PatternSyns.html
- utils/haddock/html-test/ref/PatternSyns2.html
- utils/haddock/html-test/ref/QuasiExpr.html
- utils/haddock/html-test/ref/Test.html
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/72e14f1e2c81e16feea971bd68aaf0…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/72e14f1e2c81e16feea971bd68aaf0…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/jeltsch/system-io-implementation-into-base] Move most of the `System.IO` implementation into `base`
by Wolfgang Jeltsch (＠jeltsch) 19 Mar '26
by Wolfgang Jeltsch (＠jeltsch) 19 Mar '26
19 Mar '26
Wolfgang Jeltsch pushed to branch wip/jeltsch/system-io-implementation-into-base at Glasgow Haskell Compiler / GHC
Commits:
72e14f1e by Wolfgang Jeltsch at 2026-03-18T22:46:13+02:00
Move most of the `System.IO` implementation into `base`
Metric Increase:
T12227
T12707
T5642
- - - - -
26 changed files:
- libraries/base/src/GHC/IO/Handle.hs
- libraries/base/src/Prelude.hs
- libraries/base/src/System/IO.hs
- libraries/base/src/Text/Printf.hs
- libraries/ghc-internal/src/GHC/Internal/System/IO.hs
- 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/typecheck/should_compile/T9497a.stderr
- testsuite/tests/typecheck/should_compile/holes.stderr
- testsuite/tests/typecheck/should_compile/holes3.stderr
- testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr
- testsuite/tests/typecheck/should_fail/T9497d.stderr
- testsuite/tests/typecheck/should_run/T9497a-run.stderr
- testsuite/tests/typecheck/should_run/T9497b-run.stderr
- testsuite/tests/typecheck/should_run/T9497c-run.stderr
- utils/haddock/html-test/ref/Bug1004.html
- utils/haddock/html-test/ref/Bug973.html
- utils/haddock/html-test/ref/ConstructorPatternExport.html
- utils/haddock/html-test/ref/DefaultSignatures.html
- utils/haddock/html-test/ref/Hash.html
- utils/haddock/html-test/ref/PatternSyns.html
- utils/haddock/html-test/ref/PatternSyns2.html
- utils/haddock/html-test/ref/QuasiExpr.html
- utils/haddock/html-test/ref/Test.html
Changes:
=====================================
libraries/base/src/GHC/IO/Handle.hs
=====================================
@@ -53,6 +53,7 @@ module GHC.IO.Handle
hGetEcho,
hIsTerminalDevice,
hSetNewlineMode,
+ hGetNewlineMode,
Newline(..),
NewlineMode(..),
nativeNewline,
=====================================
libraries/base/src/Prelude.hs
=====================================
@@ -165,7 +165,7 @@ module Prelude (
) where
import GHC.Internal.Control.Monad
-import GHC.Internal.System.IO
+import System.IO
import GHC.Internal.System.IO.Error
import qualified GHC.Internal.Data.List as List
import GHC.Internal.Data.Either
=====================================
libraries/base/src/System/IO.hs
=====================================
@@ -1,4 +1,5 @@
-{-# LANGUAGE Safe #-}
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE CPP #-}
-- |
--
@@ -184,8 +185,667 @@ module System.IO
nativeNewlineMode
) where
-import GHC.Internal.System.IO
+import GHC.Internal.System.IO (putStrLn, print)
+
+import GHC.Base (Bool (False, True), otherwise, failIO)
+import GHC.Err (errorWithoutStackTrace)
+import GHC.List (null, elem, last, (++), reverse, break)
+import GHC.Num ((+))
+import GHC.IO (IO, FilePath)
+import GHC.IO.IOMode (IOMode (ReadMode, WriteMode, ReadWriteMode, AppendMode))
+import qualified GHC.Internal.IO.FD as FD
+import GHC.IO.Encoding
+ (
+ TextEncoding,
+ mkTextEncoding,
+ getLocaleEncoding,
+ initLocaleEncoding,
+ utf8,
+ utf8_bom,
+ utf16,
+ utf16be,
+ utf16le,
+ utf32,
+ utf32be,
+ utf32le,
+ latin1,
+ char8
+ )
+import GHC.IO.Handle
+ (
+ Handle,
+ hLookAhead,
+ hFlush,
+ hClose,
+ hSetBinaryMode,
+ hSetEncoding,
+ hSetNewlineMode,
+ hSetEcho,
+ hSetFileSize,
+ hGetEncoding,
+ hGetNewlineMode,
+ hGetEcho,
+ hFileSize,
+ hIsOpen,
+ hIsReadable,
+ hIsSeekable,
+ hIsWritable,
+ hIsTerminalDevice,
+ hIsEOF,
+ hIsClosed,
+ hShow,
+ BufferMode (NoBuffering, LineBuffering, BlockBuffering),
+ hSetBuffering,
+ hGetBuffering,
+ HandlePosn,
+ hSetPosn,
+ hGetPosn,
+ SeekMode (AbsoluteSeek, RelativeSeek, SeekFromEnd),
+ hSeek,
+ hTell,
+ Newline (LF, CRLF),
+ nativeNewline,
+ NewlineMode (NewlineMode, inputNL, outputNL),
+ noNewlineTranslation,
+ nativeNewlineMode,
+ universalNewlineMode,
+ isEOF
+ )
+import GHC.IO.Handle.Text
+ (
+ hPutChar,
+ hPutStr,
+ hPutStrLn,
+ hPutBuf,
+ hPutBufNonBlocking,
+ hGetChar,
+ hGetContents,
+ hGetContents',
+ hGetLine,
+ hGetBuf,
+ hGetBufNonBlocking,
+ hGetBufSome,
+ hWaitForInput
+ )
+import qualified GHC.Internal.IO.Handle.FD as POSIX
+import GHC.IO.StdHandles
+ (
+ openBinaryFile,
+ withBinaryFile,
+ openFile,
+ withFile,
+ stdin,
+ stdout,
+ stderr
+ )
+import GHC.IORef (atomicModifyIORef'_)
import GHC.Internal.Control.Monad.Fix (fixIO)
+import Control.Monad (return, (>>=))
+import Control.Exception (ioError)
+import Data.Eq ((==))
+import Data.Ord ((<))
+import Data.Bits ((.|.))
+import Data.Function (($), (.))
+import Data.Maybe (Maybe (Nothing, Just))
+import Data.Char (Char)
+import Data.String (String)
+import Data.Int (Int)
+import Data.IORef (IORef, newIORef)
+import System.IO.Error (userError)
+import System.IO.Unsafe (unsafePerformIO)
+import System.Posix.Internals
+ (
+ c_getpid,
+ c_open,
+ o_CREAT,
+ o_EXCL,
+ o_BINARY,
+ o_NONBLOCK,
+ o_RDWR,
+ o_NOCTTY,
+ withFilePath
+ )
+import System.Posix.Types (CMode)
+import Text.Read (lex, Read, reads)
+import Text.Show (Show, show)
+import Foreign.C.Types (CInt)
+import Foreign.C.Error (Errno, eEXIST, getErrno, errnoToIOError)
+
+#if defined(mingw32_HOST_OS)
+import GHC.IO.SubSystem
+import GHC.IO.Windows.Handle (openFileAsTemp)
+import GHC.IO.Handle.Windows (mkHandleFromHANDLE)
+import GHC.IO.Device as IODevice
+import GHC.Internal.Real (fromIntegral)
+import Foreign.C.Types (CUInt, CWchar)
+import Foreign.C.String
+import Foreign.Ptr
+import Foreign.Marshal.Alloc
+import Foreign.Marshal.Utils (with)
+import Foreign.Storable
+#endif
+
+-----------------------------------------------------------------------------
+-- Standard IO
+
+-- | Write a character to the standard output device
+--
+-- 'putChar' is implemented as @'hPutChar' 'stdout'@.
+--
+-- This operation may fail with the same errors as 'hPutChar'.
+--
+-- ==== __Examples__
+--
+-- Note that the following do not put a newline.
+--
+-- >>> putChar 'x'
+-- x
+--
+-- >>> putChar '\0042'
+-- *
+putChar :: Char -> IO ()
+putChar c = hPutChar stdout c
+
+-- | Write a string to the standard output device
+--
+-- 'putStr' is implemented as @'hPutStr' 'stdout'@.
+--
+-- This operation may fail with the same errors, and has the same issues with concurrency, as 'hPutStr'!
+--
+-- ==== __Examples__
+--
+-- Note that the following do not put a newline.
+--
+-- >>> putStr "Hello, World!"
+-- Hello, World!
+--
+-- >>> putStr "\0052\0042\0050"
+-- 4*2
+--
+putStr :: String -> IO ()
+putStr s = hPutStr stdout s
+
+-- | Read a single character from the standard input device.
+--
+-- 'getChar' is implemented as @'hGetChar' 'stdin'@.
+--
+-- This operation may fail with the same errors as 'hGetChar'.
+--
+-- ==== __Examples__
+--
+-- >>> getChar
+-- a'a'
+--
+-- >>> getChar
+-- >
+-- '\n'
+getChar :: IO Char
+getChar = hGetChar stdin
+
+-- | Read a line from the standard input device.
+--
+-- 'getLine' is implemented as @'hGetLine' 'stdin'@.
+--
+-- This operation may fail with the same errors as 'hGetLine'.
+--
+-- ==== __Examples__
+--
+-- >>> getLine
+-- > Hello World!
+-- "Hello World!"
+--
+-- >>> getLine
+-- >
+-- ""
+getLine :: IO String
+getLine = hGetLine stdin
+
+-- | The 'getContents' operation returns all user input as a single string,
+-- which is read lazily as it is needed.
+--
+-- 'getContents' is implemented as @'hGetContents' 'stdin'@.
+--
+-- This operation may fail with the same errors as 'hGetContents'.
+--
+-- ==== __Examples__
+--
+-- >>> getContents >>= putStr
+-- > aaabbbccc :D
+-- aaabbbccc :D
+-- > I hope you have a great day
+-- I hope you have a great day
+-- > ^D
+--
+-- >>> getContents >>= print . length
+-- > abc
+-- > <3
+-- > def ^D
+-- 11
+getContents :: IO String
+getContents = hGetContents stdin
+
+-- | The 'getContents'' operation returns all user input as a single string,
+-- which is fully read before being returned
+--
+-- 'getContents'' is implemented as @'hGetContents'' 'stdin'@.
+--
+-- This operation may fail with the same errors as 'hGetContents''.
+--
+-- ==== __Examples__
+--
+-- >>> getContents' >>= putStr
+-- > aaabbbccc :D
+-- > I hope you have a great day
+-- aaabbbccc :D
+-- I hope you have a great day
+--
+-- >>> getContents' >>= print . length
+-- > abc
+-- > <3
+-- > def ^D
+-- 11
+--
+-- @since base-4.15.0.0
+getContents' :: IO String
+getContents' = hGetContents' stdin
+
+-- | @'interact' f@ takes the entire input from 'stdin' and applies @f@ to it.
+-- The resulting string is written to the 'stdout' device.
+--
+-- Note that this operation is lazy, which allows to produce output
+-- even before all input has been consumed.
+--
+-- This operation may fail with the same errors as 'getContents' and 'putStr'.
+--
+-- If it doesn't produce output the buffering settings may not be
+-- correct, use ^D (ctrl+D) to close stdin which forces
+-- the buffer to be consumed.
+--
+-- You may wish to set the buffering style appropriate to your program's
+-- needs before using this function, for example:
+--
+-- @
+-- main :: IO ()
+-- main = do
+-- hSetBuffering stdin LineBuffering
+-- hSetBuffering stdout NoBuffering
+-- interact (concatMap (\str -> str ++ str) . L.lines)
+-- @
+--
+-- ==== __Examples__
+--
+-- >>> interact (\str -> str ++ str)
+-- > hi :)
+-- hi :)
+-- > ^D
+-- hi :)
+--
+-- >>> interact (const ":D")
+-- :D
+--
+-- >>> interact (show . words)
+-- > hello world!
+-- > I hope you have a great day
+-- > ^D
+-- ["hello","world!","I","hope","you","have","a","great","day"]
+interact :: (String -> String) -> IO ()
+interact f = do s <- getContents
+ putStr (f s)
+
+-- | The 'readFile' function reads a file and
+-- returns the contents of the file as a string.
+--
+-- The file is read lazily, on demand, as with 'getContents'.
+--
+-- This operation may fail with the same errors as 'hGetContents' and 'openFile'.
+--
+-- ==== __Examples__
+--
+-- >>> readFile "~/hello_world"
+-- "Greetings!"
+--
+-- >>> take 5 <$> readFile "/dev/zero"
+-- "\NUL\NUL\NUL\NUL\NUL"
+readFile :: FilePath -> IO String
+readFile name = openFile name ReadMode >>= hGetContents
+
+-- | The 'readFile'' function reads a file and
+-- returns the contents of the file as a string.
+--
+-- This is identical to 'readFile', but the file is fully read before being returned,
+-- as with 'getContents''.
+--
+-- @since base-4.15.0.0
+readFile' :: FilePath -> IO String
+-- There's a bit of overkill here—both withFile and
+-- hGetContents' will close the file in the end.
+readFile' name = withFile name ReadMode hGetContents'
+
+-- | The computation @'writeFile' file str@ function writes the string @str@,
+-- to the file @file@.
+--
+-- This operation may fail with the same errors as 'hPutStr' and 'withFile'.
+--
+-- ==== __Examples__
+--
+-- >>> writeFile "hello" "world" >> readFile "hello"
+-- "world"
+--
+-- >>> writeFile "~/" "D:"
+-- *** Exception: ~/: withFile: inappropriate type (Is a directory)
+writeFile :: FilePath -> String -> IO ()
+writeFile f txt = withFile f WriteMode (\ hdl -> hPutStr hdl txt)
+
+-- | The computation @'appendFile' file str@ function appends the string @str@,
+-- to the file @file@.
+--
+-- Note that 'writeFile' and 'appendFile' write a literal string
+-- to a file. To write a value of any printable type, as with 'print',
+-- use the 'show' function to convert the value to a string first.
+--
+-- This operation may fail with the same errors as 'hPutStr' and 'withFile'.
+--
+-- ==== __Examples__
+--
+-- The following example could be more efficently written by acquiring a handle
+-- instead with 'openFile' and using the computations capable of writing to handles
+-- such as 'hPutStr'.
+--
+-- >>> let fn = "hello_world"
+-- >>> in writeFile fn "hello" >> appendFile fn " world!" >> (readFile fn >>= putStrLn)
+-- "hello world!"
+--
+-- >>> let fn = "foo"; output = readFile' fn >>= putStrLn
+-- >>> in output >> appendFile fn (show [1,2,3]) >> output
+-- this is what's in the file
+-- this is what's in the file[1,2,3]
+appendFile :: FilePath -> String -> IO ()
+appendFile f txt = withFile f AppendMode (\ hdl -> hPutStr hdl txt)
+
+-- | The 'readLn' function combines 'getLine' and 'readIO'.
+--
+-- This operation may fail with the same errors as 'getLine' and 'readIO'.
+--
+-- ==== __Examples__
+--
+-- >>> fmap (+ 5) readLn
+-- > 25
+-- 30
+--
+-- >>> readLn :: IO String
+-- > this is not a string literal
+-- *** Exception: user error (Prelude.readIO: no parse)
+readLn :: Read a => IO a
+readLn = getLine >>= readIO
+
+-- | The 'readIO' function is similar to 'read' except that it signals
+-- parse failure to the 'IO' monad instead of terminating the program.
+--
+-- This operation may fail with:
+--
+-- * 'GHC.Internal.System.IO.Error.isUserError' if there is no unambiguous parse.
+--
+-- ==== __Examples__
+--
+-- >>> fmap (+ 1) (readIO "1")
+-- 2
+--
+-- >>> readIO "not quite ()" :: IO ()
+-- *** Exception: user error (Prelude.readIO: no parse)
+readIO :: Read a => String -> IO a
+readIO s = case (do { (x,t) <- reads s ;
+ ("","") <- lex t ;
+ return x }) of
+ [x] -> return x
+ [] -> ioError (userError "Prelude.readIO: no parse")
+ _ -> ioError (userError "Prelude.readIO: ambiguous parse")
+
+-- | The encoding of the current locale.
+--
+-- This is the initial locale encoding: if it has been subsequently changed by
+-- 'GHC.Internal.IO.Encoding.setLocaleEncoding' this value will not reflect that change.
+localeEncoding :: TextEncoding
+localeEncoding = initLocaleEncoding
+
+-- | Computation 'hReady' @hdl@ indicates whether at least one item is
+-- available for input from handle @hdl@.
+--
+-- This operation may fail with:
+--
+-- * 'GHC.Internal.System.IO.Error.isEOFError' if the end of file has been reached.
+hReady :: Handle -> IO Bool
+hReady h = hWaitForInput h 0
+
+-- | Computation 'hPrint' @hdl t@ writes the string representation of @t@
+-- given by the 'show' function to the file or channel managed by @hdl@
+-- and appends a newline.
+--
+-- This operation may fail with the same errors as 'hPutStrLn'
+--
+-- ==== __Examples__
+--
+-- >>> hPrint stdout [1,2,3]
+-- [1,2,3]
+--
+-- >>> hPrint stdin [4,5,6]
+-- *** Exception: <stdin>: hPutStr: illegal operation (handle is not open for writing)
+hPrint :: Show a => Handle -> a -> IO ()
+hPrint hdl = hPutStrLn hdl . show
+
+-- | The function creates a temporary file in ReadWrite mode.
+-- The created file isn\'t deleted automatically, so you need to delete it manually.
+--
+-- The file is created with permissions such that only the current
+-- user can read\/write it.
+--
+-- With some exceptions (see below), the file will be created securely
+-- in the sense that an attacker should not be able to cause
+-- openTempFile to overwrite another file on the filesystem using your
+-- credentials, by putting symbolic links (on Unix) in the place where
+-- the temporary file is to be created. On Unix the @O_CREAT@ and
+-- @O_EXCL@ flags are used to prevent this attack, but note that
+-- @O_EXCL@ is sometimes not supported on NFS filesystems, so if you
+-- rely on this behaviour it is best to use local filesystems only.
+openTempFile :: FilePath -- ^ Directory in which to create the file
+ -> String -- ^ File name template. If the template is \"foo.ext\" then
+ -- the created file will be \"fooXXX.ext\" where XXX is some
+ -- random number. Note that this should not contain any path
+ -- separator characters. On Windows, the template prefix may
+ -- be truncated to 3 chars, e.g. \"foobar.ext\" will be
+ -- \"fooXXX.ext\".
+ -> IO (FilePath, Handle)
+openTempFile tmp_dir template
+ = openTempFile' "openTempFile" tmp_dir template False 0o600
+
+-- | Like 'openTempFile', but opens the file in binary mode. See 'openBinaryFile' for more comments.
+openBinaryTempFile :: FilePath -> String -> IO (FilePath, Handle)
+openBinaryTempFile tmp_dir template
+ = openTempFile' "openBinaryTempFile" tmp_dir template True 0o600
+
+-- | Like 'openTempFile', but uses the default file permissions
+openTempFileWithDefaultPermissions :: FilePath -> String
+ -> IO (FilePath, Handle)
+openTempFileWithDefaultPermissions tmp_dir template
+ = openTempFile' "openTempFileWithDefaultPermissions" tmp_dir template False 0o666
+
+-- | Like 'openBinaryTempFile', but uses the default file permissions
+openBinaryTempFileWithDefaultPermissions :: FilePath -> String
+ -> IO (FilePath, Handle)
+openBinaryTempFileWithDefaultPermissions tmp_dir template
+ = openTempFile' "openBinaryTempFileWithDefaultPermissions" tmp_dir template True 0o666
+
+openTempFile' :: String -> FilePath -> String -> Bool -> CMode
+ -> IO (FilePath, Handle)
+openTempFile' loc tmp_dir template binary mode
+ | pathSeparator template
+ = failIO $ "openTempFile': Template string must not contain path separator characters: "++template
+ | otherwise = findTempName
+ where
+ -- We split off the last extension, so we can use .foo.ext files
+ -- for temporary files (hidden on Unix OSes). Unfortunately we're
+ -- below filepath in the hierarchy here.
+ (prefix, suffix) =
+ case break (== '.') $ reverse template of
+ -- First case: template contains no '.'s. Just re-reverse it.
+ (rev_suffix, "") -> (reverse rev_suffix, "")
+ -- Second case: template contains at least one '.'. Strip the
+ -- dot from the prefix and prepend it to the suffix (if we don't
+ -- do this, the unique number will get added after the '.' and
+ -- thus be part of the extension, which is wrong.)
+ (rev_suffix, '.':rest) -> (reverse rest, '.':reverse rev_suffix)
+ -- Otherwise, something is wrong, because (break (== '.')) should
+ -- always return a pair with either the empty string or a string
+ -- beginning with '.' as the second component.
+ _ -> errorWithoutStackTrace "bug in GHC.Internal.System.IO.openTempFile"
+#if defined(mingw32_HOST_OS)
+ findTempName = findTempNamePosix <!> findTempNameWinIO
+
+ findTempNameWinIO = do
+ let label = if null prefix then "ghc" else prefix
+ withCWString tmp_dir $ \c_tmp_dir ->
+ withCWString label $ \c_template ->
+ withCWString suffix $ \c_suffix ->
+ with nullPtr $ \c_ptr -> do
+ res <- c_createUUIDTempFileErrNo c_tmp_dir c_template c_suffix c_ptr
+ if not res
+ then do errno <- getErrno
+ ioError (errnoToIOError loc errno Nothing (Just tmp_dir))
+ else do c_p <- peek c_ptr
+ filename <- peekCWString c_p
+ free c_p
+ let flags = fromIntegral mode .&. o_EXCL
+ handleResultsWinIO filename (flags == o_EXCL)
+
+ findTempNamePosix = do
+ let label = if null prefix then "ghc" else prefix
+ withCWString tmp_dir $ \c_tmp_dir ->
+ withCWString label $ \c_template ->
+ withCWString suffix $ \c_suffix ->
+ allocaBytes (sizeOf (undefined :: CWchar) * 260) $ \c_str -> do
+ res <- c_getTempFileNameErrorNo c_tmp_dir c_template c_suffix 0
+ c_str
+ if not res
+ then do errno <- getErrno
+ ioError (errnoToIOError loc errno Nothing (Just tmp_dir))
+ else do filename <- peekCWString c_str
+ handleResultsPosix filename
+
+ handleResultsPosix filename = do
+ let oflags1 = rw_flags .|. o_EXCL
+ binary_flags
+ | binary = o_BINARY
+ | otherwise = 0
+ oflags = oflags1 .|. binary_flags
+ fd <- withFilePath filename $ \ f -> c_open f oflags mode
+ case fd < 0 of
+ True -> do errno <- getErrno
+ ioError (errnoToIOError loc errno Nothing (Just tmp_dir))
+ False ->
+ do (fD,fd_type) <- FD.mkFD fd ReadWriteMode Nothing{-no stat-}
+ False{-is_socket-}
+ True{-is_nonblock-}
+
+ enc <- getLocaleEncoding
+ h <- POSIX.mkHandleFromFD fD fd_type filename ReadWriteMode
+ False{-set non-block-} (Just enc)
+
+ return (filename, h)
+
+ handleResultsWinIO filename excl = do
+ (hwnd, hwnd_type) <- openFileAsTemp filename True excl
+ mb_codec <- if binary then return Nothing else fmap Just getLocaleEncoding
+
+ -- then use it to make a Handle
+ h <- mkHandleFromHANDLE hwnd hwnd_type filename ReadWriteMode mb_codec
+ `onException` IODevice.close hwnd
+ return (filename, h)
+
+foreign import ccall "getTempFileNameErrorNo" c_getTempFileNameErrorNo
+ :: CWString -> CWString -> CWString -> CUInt -> Ptr CWchar -> IO Bool
+
+foreign import ccall "__createUUIDTempFileErrNo" c_createUUIDTempFileErrNo
+ :: CWString -> CWString -> CWString -> Ptr CWString -> IO Bool
+
+pathSeparator :: String -> Bool
+pathSeparator template = any (\x-> x == '/' || x == '\\') template
+
+output_flags = std_flags
+#else /* else mingw32_HOST_OS */
+ findTempName = do
+ rs <- rand_string
+ let filename = prefix ++ rs ++ suffix
+ filepath = tmp_dir `combine` filename
+ r <- openNewFile filepath binary mode
+ case r of
+ FileExists -> findTempName
+ OpenNewError errno -> ioError (errnoToIOError loc errno Nothing (Just tmp_dir))
+ NewFileCreated fd -> do
+ (fD,fd_type) <- FD.mkFD fd ReadWriteMode Nothing{-no stat-}
+ False{-is_socket-}
+ True{-is_nonblock-}
+
+ enc <- getLocaleEncoding
+ h <- POSIX.mkHandleFromFD fD fd_type filepath ReadWriteMode False{-set non-block-} (Just enc)
+
+ return (filepath, h)
+
+ where
+ -- XXX bits copied from System.FilePath, since that's not available here
+ combine a b
+ | null b = a
+ | null a = b
+ | pathSeparator [last a] = a ++ b
+ | otherwise = a ++ [pathSeparatorChar] ++ b
+
+tempCounter :: IORef Int
+tempCounter = unsafePerformIO $ newIORef 0
+{-# NOINLINE tempCounter #-}
+
+-- build large digit-alike number
+rand_string :: IO String
+rand_string = do
+ r1 <- c_getpid
+ (r2, _) <- atomicModifyIORef'_ tempCounter (+1)
+ return $ show r1 ++ "-" ++ show r2
+
+data OpenNewFileResult
+ = NewFileCreated CInt
+ | FileExists
+ | OpenNewError Errno
+
+openNewFile :: FilePath -> Bool -> CMode -> IO OpenNewFileResult
+openNewFile filepath binary mode = do
+ let oflags1 = rw_flags .|. o_EXCL
+
+ binary_flags
+ | binary = o_BINARY
+ | otherwise = 0
+
+ oflags = oflags1 .|. binary_flags
+ fd <- withFilePath filepath $ \ f ->
+ c_open f oflags mode
+ if fd < 0
+ then do
+ errno <- getErrno
+ case errno of
+ _ | errno == eEXIST -> return FileExists
+ _ -> return (OpenNewError errno)
+ else return (NewFileCreated fd)
+
+-- XXX Should use filepath library
+pathSeparatorChar :: Char
+pathSeparatorChar = '/'
+
+pathSeparator :: String -> Bool
+pathSeparator template = pathSeparatorChar `elem` template
+
+output_flags = std_flags .|. o_CREAT
+#endif /* mingw32_HOST_OS */
+
+-- XXX Copied from GHC.Handle
+std_flags, output_flags, rw_flags :: CInt
+std_flags = o_NONBLOCK .|. o_NOCTTY
+rw_flags = output_flags .|. o_RDWR
-- $locking
-- Implementations should enforce as far as possible, at least locally to the
=====================================
libraries/base/src/Text/Printf.hs
=====================================
@@ -99,7 +99,7 @@ import GHC.Internal.Data.List (stripPrefix)
import GHC.Internal.Word
import GHC.Internal.Numeric
import GHC.Internal.Numeric.Natural
-import GHC.Internal.System.IO
+import System.IO
-- $setup
-- >>> import Prelude
=====================================
libraries/ghc-internal/src/GHC/Internal/System/IO.hs
=====================================
@@ -1,6 +1,4 @@
{-# LANGUAGE Trustworthy #-}
-{-# LANGUAGE CPP, NoImplicitPrelude, CApiFFI #-}
-{-# OPTIONS_GHC -Wno-x-partial #-}
-----------------------------------------------------------------------------
-- |
@@ -16,286 +14,13 @@
--
-----------------------------------------------------------------------------
-module GHC.Internal.System.IO (
- -- * The IO monad
+module GHC.Internal.System.IO (putStrLn, print) where
- IO,
-
- -- * Files and handles
-
- FilePath,
-
- Handle, -- abstract, instance of: Eq, Show.
-
- -- | GHC note: a 'Handle' will be automatically closed when the garbage
- -- collector detects that it has become unreferenced by the program.
- -- However, relying on this behaviour is not generally recommended:
- -- the garbage collector is unpredictable. If possible, use
- -- an explicit 'hClose' to close 'Handle's when they are no longer
- -- required. GHC does not currently attempt to free up file
- -- descriptors when they have run out, it is your responsibility to
- -- ensure that this doesn't happen.
-
- -- ** Standard handles
-
- -- | Three handles are allocated during program initialisation,
- -- and are initially open.
-
- stdin, stdout, stderr,
-
- -- * Opening and closing files
-
- -- ** Opening files
-
- withFile,
- openFile,
- IOMode(ReadMode,WriteMode,AppendMode,ReadWriteMode),
-
- -- ** Closing files
-
- hClose,
-
- -- ** Special cases
-
- -- | These functions are also exported by the "Prelude".
-
- readFile,
- readFile',
- writeFile,
- appendFile,
-
- -- * Operations on handles
-
- -- ** Determining and changing the size of a file
-
- hFileSize,
- hSetFileSize,
-
- -- ** Detecting the end of input
-
- hIsEOF,
- isEOF,
-
- -- ** Buffering operations
-
- BufferMode(NoBuffering,LineBuffering,BlockBuffering),
- hSetBuffering,
- hGetBuffering,
- hFlush,
-
- -- ** Repositioning handles
-
- hGetPosn,
- hSetPosn,
- HandlePosn, -- abstract, instance of: Eq, Show.
-
- hSeek,
- SeekMode(AbsoluteSeek,RelativeSeek,SeekFromEnd),
- hTell,
-
- -- ** Handle properties
-
- hIsOpen, hIsClosed,
- hIsReadable, hIsWritable,
- hIsSeekable,
-
- -- ** Terminal operations (not portable: GHC only)
-
- hIsTerminalDevice,
-
- hSetEcho,
- hGetEcho,
-
- -- ** Showing handle state (not portable: GHC only)
-
- hShow,
-
- -- * Text input and output
-
- -- ** Text input
-
- hWaitForInput,
- hReady,
- hGetChar,
- hGetLine,
- hLookAhead,
- hGetContents,
- hGetContents',
-
- -- ** Text output
-
- hPutChar,
- hPutStr,
- hPutStrLn,
- hPrint,
-
- -- ** Special cases for standard input and output
-
- -- | These functions are also exported by the "Prelude".
-
- interact,
- putChar,
- putStr,
- putStrLn,
- print,
- getChar,
- getLine,
- getContents,
- getContents',
- readIO,
- readLn,
-
- -- * Binary input and output
-
- withBinaryFile,
- openBinaryFile,
- hSetBinaryMode,
- hPutBuf,
- hGetBuf,
- hGetBufSome,
- hPutBufNonBlocking,
- hGetBufNonBlocking,
-
- -- * Temporary files
-
- openTempFile,
- openBinaryTempFile,
- openTempFileWithDefaultPermissions,
- openBinaryTempFileWithDefaultPermissions,
-
- -- * Unicode encoding\/decoding
-
- -- | A text-mode 'Handle' has an associated 'TextEncoding', which
- -- is used to decode bytes into Unicode characters when reading,
- -- and encode Unicode characters into bytes when writing.
- --
- -- The default 'TextEncoding' is the same as the default encoding
- -- on your system, which is also available as 'localeEncoding'.
- -- (GHC note: on Windows, we currently do not support double-byte
- -- encodings; if the console\'s code page is unsupported, then
- -- 'localeEncoding' will be 'latin1'.)
- --
- -- Encoding and decoding errors are always detected and reported,
- -- except during lazy I/O ('hGetContents', 'getContents', and
- -- 'readFile'), where a decoding error merely results in
- -- termination of the character stream, as with other I/O errors.
-
- hSetEncoding,
- hGetEncoding,
-
- -- ** Unicode encodings
- TextEncoding,
- latin1,
- utf8, utf8_bom,
- utf16, utf16le, utf16be,
- utf32, utf32le, utf32be,
- localeEncoding,
- char8,
- mkTextEncoding,
-
- -- * Newline conversion
-
- -- | In Haskell, a newline is always represented by the character
- -- @\'\\n\'@. However, in files and external character streams, a
- -- newline may be represented by another character sequence, such
- -- as @\'\\r\\n\'@.
- --
- -- A text-mode 'Handle' has an associated 'NewlineMode' that
- -- specifies how to translate newline characters. The
- -- 'NewlineMode' specifies the input and output translation
- -- separately, so that for instance you can translate @\'\\r\\n\'@
- -- to @\'\\n\'@ on input, but leave newlines as @\'\\n\'@ on output.
- --
- -- The default 'NewlineMode' for a 'Handle' is
- -- 'nativeNewlineMode', which does no translation on Unix systems,
- -- but translates @\'\\r\\n\'@ to @\'\\n\'@ and back on Windows.
- --
- -- Binary-mode 'Handle's do no newline translation at all.
- --
- hSetNewlineMode,
- hGetNewlineMode,
- Newline(..), nativeNewline,
- NewlineMode(..),
- noNewlineTranslation, universalNewlineMode, nativeNewlineMode,
- ) where
-
-import GHC.Internal.Control.Exception.Base
-
-import GHC.Internal.Data.Bits
-import GHC.Internal.Data.Maybe
-import GHC.Internal.Foreign.C.Error
-#if defined(mingw32_HOST_OS)
-import GHC.Internal.Foreign.C.String
-import GHC.Internal.Foreign.Ptr
-import GHC.Internal.Foreign.Marshal.Alloc
-import GHC.Internal.Foreign.Marshal.Utils (with)
-import GHC.Internal.Foreign.Storable
-import GHC.Internal.IO.SubSystem
-import GHC.Internal.IO.Windows.Handle (openFileAsTemp)
-import GHC.Internal.IO.Handle.Windows (mkHandleFromHANDLE)
-import GHC.Internal.IO.Device as IODevice
-import GHC.Internal.Real (fromIntegral)
-#endif
-import GHC.Internal.Foreign.C.Types
-import GHC.Internal.System.Posix.Internals
-import GHC.Internal.System.Posix.Types
-
-import GHC.Internal.Base
-import GHC.Internal.List
-#if !defined(mingw32_HOST_OS)
-import GHC.Internal.IORef
-#endif
-import GHC.Internal.Num
-import GHC.Internal.IO hiding ( bracket, onException )
-import GHC.Internal.IO.IOMode
-import qualified GHC.Internal.IO.FD as FD
-import GHC.Internal.IO.Handle
-import qualified GHC.Internal.IO.Handle.FD as POSIX
-import GHC.Internal.IO.Handle.Text ( hGetBufSome, hPutStrLn )
-import GHC.Internal.IO.Exception ( userError )
-import GHC.Internal.IO.Encoding
-import GHC.Internal.Text.Read
-import GHC.Internal.IO.StdHandles
-import GHC.Internal.Show
------------------------------------------------------------------------------
--- Standard IO
-
--- | Write a character to the standard output device
---
--- 'putChar' is implemented as @'hPutChar' 'stdout'@.
---
--- This operation may fail with the same errors as 'hPutChar'.
---
--- ==== __Examples__
---
--- Note that the following do not put a newline.
---
--- >>> putChar 'x'
--- x
---
--- >>> putChar '\0042'
--- *
-putChar :: Char -> IO ()
-putChar c = hPutChar stdout c
-
--- | Write a string to the standard output device
---
--- 'putStr' is implemented as @'hPutStr' 'stdout'@.
---
--- This operation may fail with the same errors, and has the same issues with concurrency, as 'hPutStr'!
---
--- ==== __Examples__
---
--- Note that the following do not put a newline.
---
--- >>> putStr "Hello, World!"
--- Hello, World!
---
--- >>> putStr "\0052\0042\0050"
--- 4*2
---
-putStr :: String -> IO ()
-putStr s = hPutStr stdout s
+import GHC.Internal.Base (String)
+import GHC.Internal.IO (IO)
+import GHC.Internal.IO.Handle.Text (hPutStrLn)
+import GHC.Internal.IO.StdHandles (stdout)
+import GHC.Internal.Show (Show, show)
-- | The same as 'putStr', but adds a newline character.
--
@@ -332,485 +57,3 @@ putStrLn s = hPutStrLn stdout s
-- [(0,1),(1,2),(2,4),(3,8),(4,16),(5,32),(6,64),(7,128),(8,256)]
print :: Show a => a -> IO ()
print x = putStrLn (show x)
-
--- | Read a single character from the standard input device.
---
--- 'getChar' is implemented as @'hGetChar' 'stdin'@.
---
--- This operation may fail with the same errors as 'hGetChar'.
---
--- ==== __Examples__
---
--- >>> getChar
--- a'a'
---
--- >>> getChar
--- >
--- '\n'
-getChar :: IO Char
-getChar = hGetChar stdin
-
--- | Read a line from the standard input device.
---
--- 'getLine' is implemented as @'hGetLine' 'stdin'@.
---
--- This operation may fail with the same errors as 'hGetLine'.
---
--- ==== __Examples__
---
--- >>> getLine
--- > Hello World!
--- "Hello World!"
---
--- >>> getLine
--- >
--- ""
-getLine :: IO String
-getLine = hGetLine stdin
-
--- | The 'getContents' operation returns all user input as a single string,
--- which is read lazily as it is needed.
---
--- 'getContents' is implemented as @'hGetContents' 'stdin'@.
---
--- This operation may fail with the same errors as 'hGetContents'.
---
--- ==== __Examples__
---
--- >>> getContents >>= putStr
--- > aaabbbccc :D
--- aaabbbccc :D
--- > I hope you have a great day
--- I hope you have a great day
--- > ^D
---
--- >>> getContents >>= print . length
--- > abc
--- > <3
--- > def ^D
--- 11
-getContents :: IO String
-getContents = hGetContents stdin
-
--- | The 'getContents'' operation returns all user input as a single string,
--- which is fully read before being returned
---
--- 'getContents'' is implemented as @'hGetContents'' 'stdin'@.
---
--- This operation may fail with the same errors as 'hGetContents''.
---
--- ==== __Examples__
---
--- >>> getContents' >>= putStr
--- > aaabbbccc :D
--- > I hope you have a great day
--- aaabbbccc :D
--- I hope you have a great day
---
--- >>> getContents' >>= print . length
--- > abc
--- > <3
--- > def ^D
--- 11
---
--- @since base-4.15.0.0
-getContents' :: IO String
-getContents' = hGetContents' stdin
-
--- | @'interact' f@ takes the entire input from 'stdin' and applies @f@ to it.
--- The resulting string is written to the 'stdout' device.
---
--- Note that this operation is lazy, which allows to produce output
--- even before all input has been consumed.
---
--- This operation may fail with the same errors as 'getContents' and 'putStr'.
---
--- If it doesn't produce output the buffering settings may not be
--- correct, use ^D (ctrl+D) to close stdin which forces
--- the buffer to be consumed.
---
--- You may wish to set the buffering style appropriate to your program's
--- needs before using this function, for example:
---
--- @
--- main :: IO ()
--- main = do
--- hSetBuffering stdin LineBuffering
--- hSetBuffering stdout NoBuffering
--- interact (concatMap (\str -> str ++ str) . L.lines)
--- @
---
--- ==== __Examples__
---
--- >>> interact (\str -> str ++ str)
--- > hi :)
--- hi :)
--- > ^D
--- hi :)
---
--- >>> interact (const ":D")
--- :D
---
--- >>> interact (show . words)
--- > hello world!
--- > I hope you have a great day
--- > ^D
--- ["hello","world!","I","hope","you","have","a","great","day"]
-interact :: (String -> String) -> IO ()
-interact f = do s <- getContents
- putStr (f s)
-
--- | The 'readFile' function reads a file and
--- returns the contents of the file as a string.
---
--- The file is read lazily, on demand, as with 'getContents'.
---
--- This operation may fail with the same errors as 'hGetContents' and 'openFile'.
---
--- ==== __Examples__
---
--- >>> readFile "~/hello_world"
--- "Greetings!"
---
--- >>> take 5 <$> readFile "/dev/zero"
--- "\NUL\NUL\NUL\NUL\NUL"
-readFile :: FilePath -> IO String
-readFile name = openFile name ReadMode >>= hGetContents
-
--- | The 'readFile'' function reads a file and
--- returns the contents of the file as a string.
---
--- This is identical to 'readFile', but the file is fully read before being returned,
--- as with 'getContents''.
---
--- @since base-4.15.0.0
-readFile' :: FilePath -> IO String
--- There's a bit of overkill here—both withFile and
--- hGetContents' will close the file in the end.
-readFile' name = withFile name ReadMode hGetContents'
-
--- | The computation @'writeFile' file str@ function writes the string @str@,
--- to the file @file@.
---
--- This operation may fail with the same errors as 'hPutStr' and 'withFile'.
---
--- ==== __Examples__
---
--- >>> writeFile "hello" "world" >> readFile "hello"
--- "world"
---
--- >>> writeFile "~/" "D:"
--- *** Exception: ~/: withFile: inappropriate type (Is a directory)
-writeFile :: FilePath -> String -> IO ()
-writeFile f txt = withFile f WriteMode (\ hdl -> hPutStr hdl txt)
-
--- | The computation @'appendFile' file str@ function appends the string @str@,
--- to the file @file@.
---
--- Note that 'writeFile' and 'appendFile' write a literal string
--- to a file. To write a value of any printable type, as with 'print',
--- use the 'show' function to convert the value to a string first.
---
--- This operation may fail with the same errors as 'hPutStr' and 'withFile'.
---
--- ==== __Examples__
---
--- The following example could be more efficently written by acquiring a handle
--- instead with 'openFile' and using the computations capable of writing to handles
--- such as 'hPutStr'.
---
--- >>> let fn = "hello_world"
--- >>> in writeFile fn "hello" >> appendFile fn " world!" >> (readFile fn >>= putStrLn)
--- "hello world!"
---
--- >>> let fn = "foo"; output = readFile' fn >>= putStrLn
--- >>> in output >> appendFile fn (show [1,2,3]) >> output
--- this is what's in the file
--- this is what's in the file[1,2,3]
-appendFile :: FilePath -> String -> IO ()
-appendFile f txt = withFile f AppendMode (\ hdl -> hPutStr hdl txt)
-
--- | The 'readLn' function combines 'getLine' and 'readIO'.
---
--- This operation may fail with the same errors as 'getLine' and 'readIO'.
---
--- ==== __Examples__
---
--- >>> fmap (+ 5) readLn
--- > 25
--- 30
---
--- >>> readLn :: IO String
--- > this is not a string literal
--- *** Exception: user error (Prelude.readIO: no parse)
-readLn :: Read a => IO a
-readLn = getLine >>= readIO
-
--- | The 'readIO' function is similar to 'read' except that it signals
--- parse failure to the 'IO' monad instead of terminating the program.
---
--- This operation may fail with:
---
--- * 'GHC.Internal.System.IO.Error.isUserError' if there is no unambiguous parse.
---
--- ==== __Examples__
---
--- >>> fmap (+ 1) (readIO "1")
--- 2
---
--- >>> readIO "not quite ()" :: IO ()
--- *** Exception: user error (Prelude.readIO: no parse)
-readIO :: Read a => String -> IO a
-readIO s = case (do { (x,t) <- reads s ;
- ("","") <- lex t ;
- return x }) of
- [x] -> return x
- [] -> ioError (userError "Prelude.readIO: no parse")
- _ -> ioError (userError "Prelude.readIO: ambiguous parse")
-
--- | The encoding of the current locale.
---
--- This is the initial locale encoding: if it has been subsequently changed by
--- 'GHC.Internal.IO.Encoding.setLocaleEncoding' this value will not reflect that change.
-localeEncoding :: TextEncoding
-localeEncoding = initLocaleEncoding
-
--- | Computation 'hReady' @hdl@ indicates whether at least one item is
--- available for input from handle @hdl@.
---
--- This operation may fail with:
---
--- * 'GHC.Internal.System.IO.Error.isEOFError' if the end of file has been reached.
-hReady :: Handle -> IO Bool
-hReady h = hWaitForInput h 0
-
--- | Computation 'hPrint' @hdl t@ writes the string representation of @t@
--- given by the 'show' function to the file or channel managed by @hdl@
--- and appends a newline.
---
--- This operation may fail with the same errors as 'hPutStrLn'
---
--- ==== __Examples__
---
--- >>> hPrint stdout [1,2,3]
--- [1,2,3]
---
--- >>> hPrint stdin [4,5,6]
--- *** Exception: <stdin>: hPutStr: illegal operation (handle is not open for writing)
-hPrint :: Show a => Handle -> a -> IO ()
-hPrint hdl = hPutStrLn hdl . show
-
--- | The function creates a temporary file in ReadWrite mode.
--- The created file isn\'t deleted automatically, so you need to delete it manually.
---
--- The file is created with permissions such that only the current
--- user can read\/write it.
---
--- With some exceptions (see below), the file will be created securely
--- in the sense that an attacker should not be able to cause
--- openTempFile to overwrite another file on the filesystem using your
--- credentials, by putting symbolic links (on Unix) in the place where
--- the temporary file is to be created. On Unix the @O_CREAT@ and
--- @O_EXCL@ flags are used to prevent this attack, but note that
--- @O_EXCL@ is sometimes not supported on NFS filesystems, so if you
--- rely on this behaviour it is best to use local filesystems only.
-openTempFile :: FilePath -- ^ Directory in which to create the file
- -> String -- ^ File name template. If the template is \"foo.ext\" then
- -- the created file will be \"fooXXX.ext\" where XXX is some
- -- random number. Note that this should not contain any path
- -- separator characters. On Windows, the template prefix may
- -- be truncated to 3 chars, e.g. \"foobar.ext\" will be
- -- \"fooXXX.ext\".
- -> IO (FilePath, Handle)
-openTempFile tmp_dir template
- = openTempFile' "openTempFile" tmp_dir template False 0o600
-
--- | Like 'openTempFile', but opens the file in binary mode. See 'openBinaryFile' for more comments.
-openBinaryTempFile :: FilePath -> String -> IO (FilePath, Handle)
-openBinaryTempFile tmp_dir template
- = openTempFile' "openBinaryTempFile" tmp_dir template True 0o600
-
--- | Like 'openTempFile', but uses the default file permissions
-openTempFileWithDefaultPermissions :: FilePath -> String
- -> IO (FilePath, Handle)
-openTempFileWithDefaultPermissions tmp_dir template
- = openTempFile' "openTempFileWithDefaultPermissions" tmp_dir template False 0o666
-
--- | Like 'openBinaryTempFile', but uses the default file permissions
-openBinaryTempFileWithDefaultPermissions :: FilePath -> String
- -> IO (FilePath, Handle)
-openBinaryTempFileWithDefaultPermissions tmp_dir template
- = openTempFile' "openBinaryTempFileWithDefaultPermissions" tmp_dir template True 0o666
-
-openTempFile' :: String -> FilePath -> String -> Bool -> CMode
- -> IO (FilePath, Handle)
-openTempFile' loc tmp_dir template binary mode
- | pathSeparator template
- = failIO $ "openTempFile': Template string must not contain path separator characters: "++template
- | otherwise = findTempName
- where
- -- We split off the last extension, so we can use .foo.ext files
- -- for temporary files (hidden on Unix OSes). Unfortunately we're
- -- below filepath in the hierarchy here.
- (prefix, suffix) =
- case break (== '.') $ reverse template of
- -- First case: template contains no '.'s. Just re-reverse it.
- (rev_suffix, "") -> (reverse rev_suffix, "")
- -- Second case: template contains at least one '.'. Strip the
- -- dot from the prefix and prepend it to the suffix (if we don't
- -- do this, the unique number will get added after the '.' and
- -- thus be part of the extension, which is wrong.)
- (rev_suffix, '.':rest) -> (reverse rest, '.':reverse rev_suffix)
- -- Otherwise, something is wrong, because (break (== '.')) should
- -- always return a pair with either the empty string or a string
- -- beginning with '.' as the second component.
- _ -> errorWithoutStackTrace "bug in GHC.Internal.System.IO.openTempFile"
-#if defined(mingw32_HOST_OS)
- findTempName = findTempNamePosix <!> findTempNameWinIO
-
- findTempNameWinIO = do
- let label = if null prefix then "ghc" else prefix
- withCWString tmp_dir $ \c_tmp_dir ->
- withCWString label $ \c_template ->
- withCWString suffix $ \c_suffix ->
- with nullPtr $ \c_ptr -> do
- res <- c_createUUIDTempFileErrNo c_tmp_dir c_template c_suffix c_ptr
- if not res
- then do errno <- getErrno
- ioError (errnoToIOError loc errno Nothing (Just tmp_dir))
- else do c_p <- peek c_ptr
- filename <- peekCWString c_p
- free c_p
- let flags = fromIntegral mode .&. o_EXCL
- handleResultsWinIO filename (flags == o_EXCL)
-
- findTempNamePosix = do
- let label = if null prefix then "ghc" else prefix
- withCWString tmp_dir $ \c_tmp_dir ->
- withCWString label $ \c_template ->
- withCWString suffix $ \c_suffix ->
- allocaBytes (sizeOf (undefined :: CWchar) * 260) $ \c_str -> do
- res <- c_getTempFileNameErrorNo c_tmp_dir c_template c_suffix 0
- c_str
- if not res
- then do errno <- getErrno
- ioError (errnoToIOError loc errno Nothing (Just tmp_dir))
- else do filename <- peekCWString c_str
- handleResultsPosix filename
-
- handleResultsPosix filename = do
- let oflags1 = rw_flags .|. o_EXCL
- binary_flags
- | binary = o_BINARY
- | otherwise = 0
- oflags = oflags1 .|. binary_flags
- fd <- withFilePath filename $ \ f -> c_open f oflags mode
- case fd < 0 of
- True -> do errno <- getErrno
- ioError (errnoToIOError loc errno Nothing (Just tmp_dir))
- False ->
- do (fD,fd_type) <- FD.mkFD fd ReadWriteMode Nothing{-no stat-}
- False{-is_socket-}
- True{-is_nonblock-}
-
- enc <- getLocaleEncoding
- h <- POSIX.mkHandleFromFD fD fd_type filename ReadWriteMode
- False{-set non-block-} (Just enc)
-
- return (filename, h)
-
- handleResultsWinIO filename excl = do
- (hwnd, hwnd_type) <- openFileAsTemp filename True excl
- mb_codec <- if binary then return Nothing else fmap Just getLocaleEncoding
-
- -- then use it to make a Handle
- h <- mkHandleFromHANDLE hwnd hwnd_type filename ReadWriteMode mb_codec
- `onException` IODevice.close hwnd
- return (filename, h)
-
-foreign import ccall "getTempFileNameErrorNo" c_getTempFileNameErrorNo
- :: CWString -> CWString -> CWString -> CUInt -> Ptr CWchar -> IO Bool
-
-foreign import ccall "__createUUIDTempFileErrNo" c_createUUIDTempFileErrNo
- :: CWString -> CWString -> CWString -> Ptr CWString -> IO Bool
-
-pathSeparator :: String -> Bool
-pathSeparator template = any (\x-> x == '/' || x == '\\') template
-
-output_flags = std_flags
-#else /* else mingw32_HOST_OS */
- findTempName = do
- rs <- rand_string
- let filename = prefix ++ rs ++ suffix
- filepath = tmp_dir `combine` filename
- r <- openNewFile filepath binary mode
- case r of
- FileExists -> findTempName
- OpenNewError errno -> ioError (errnoToIOError loc errno Nothing (Just tmp_dir))
- NewFileCreated fd -> do
- (fD,fd_type) <- FD.mkFD fd ReadWriteMode Nothing{-no stat-}
- False{-is_socket-}
- True{-is_nonblock-}
-
- enc <- getLocaleEncoding
- h <- POSIX.mkHandleFromFD fD fd_type filepath ReadWriteMode False{-set non-block-} (Just enc)
-
- return (filepath, h)
-
- where
- -- XXX bits copied from System.FilePath, since that's not available here
- combine a b
- | null b = a
- | null a = b
- | pathSeparator [last a] = a ++ b
- | otherwise = a ++ [pathSeparatorChar] ++ b
-
-tempCounter :: IORef Int
-tempCounter = unsafePerformIO $ newIORef 0
-{-# NOINLINE tempCounter #-}
-
--- build large digit-alike number
-rand_string :: IO String
-rand_string = do
- r1 <- c_getpid
- (r2, _) <- atomicModifyIORef'_ tempCounter (+1)
- return $ show r1 ++ "-" ++ show r2
-
-data OpenNewFileResult
- = NewFileCreated CInt
- | FileExists
- | OpenNewError Errno
-
-openNewFile :: FilePath -> Bool -> CMode -> IO OpenNewFileResult
-openNewFile filepath binary mode = do
- let oflags1 = rw_flags .|. o_EXCL
-
- binary_flags
- | binary = o_BINARY
- | otherwise = 0
-
- oflags = oflags1 .|. binary_flags
- fd <- withFilePath filepath $ \ f ->
- c_open f oflags mode
- if fd < 0
- then do
- errno <- getErrno
- case errno of
- _ | errno == eEXIST -> return FileExists
- _ -> return (OpenNewError errno)
- else return (NewFileCreated fd)
-
--- XXX Should use filepath library
-pathSeparatorChar :: Char
-pathSeparatorChar = '/'
-
-pathSeparator :: String -> Bool
-pathSeparator template = pathSeparatorChar `elem` template
-
-output_flags = std_flags .|. o_CREAT
-#endif /* mingw32_HOST_OS */
-
--- XXX Copied from GHC.Handle
-std_flags, output_flags, rw_flags :: CInt
-std_flags = o_NONBLOCK .|. o_NOCTTY
-rw_flags = output_flags .|. o_RDWR
=====================================
testsuite/tests/interface-stability/base-exports.stdout
=====================================
@@ -7848,6 +7848,7 @@ module GHC.IO.Handle where
hGetEcho :: Handle -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
hGetEncoding :: Handle -> GHC.Internal.Types.IO (GHC.Internal.Maybe.Maybe GHC.Internal.IO.Encoding.Types.TextEncoding)
hGetLine :: Handle -> GHC.Internal.Types.IO GHC.Internal.Base.String
+ hGetNewlineMode :: Handle -> GHC.Internal.Types.IO NewlineMode
hGetPosn :: Handle -> GHC.Internal.Types.IO HandlePosn
hIsClosed :: Handle -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
hIsEOF :: Handle -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
@@ -9883,7 +9884,7 @@ module System.Exit where
exitWith :: forall a. ExitCode -> GHC.Internal.Types.IO a
module System.IO where
- -- Safety: Safe
+ -- Safety: Trustworthy
type BufferMode :: *
data BufferMode = NoBuffering | LineBuffering | BlockBuffering (GHC.Internal.Maybe.Maybe GHC.Internal.Types.Int)
type FilePath :: *
=====================================
testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
=====================================
@@ -7820,6 +7820,7 @@ module GHC.IO.Handle where
hGetEcho :: Handle -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
hGetEncoding :: Handle -> GHC.Internal.Types.IO (GHC.Internal.Maybe.Maybe GHC.Internal.IO.Encoding.Types.TextEncoding)
hGetLine :: Handle -> GHC.Internal.Types.IO GHC.Internal.Base.String
+ hGetNewlineMode :: Handle -> GHC.Internal.Types.IO NewlineMode
hGetPosn :: Handle -> GHC.Internal.Types.IO HandlePosn
hIsClosed :: Handle -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
hIsEOF :: Handle -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
@@ -9921,7 +9922,7 @@ module System.Exit where
exitWith :: forall a. ExitCode -> GHC.Internal.Types.IO a
module System.IO where
- -- Safety: Safe
+ -- Safety: Trustworthy
type BufferMode :: *
data BufferMode = NoBuffering | LineBuffering | BlockBuffering (GHC.Internal.Maybe.Maybe GHC.Internal.Types.Int)
type FilePath :: *
=====================================
testsuite/tests/interface-stability/base-exports.stdout-mingw32
=====================================
@@ -8012,6 +8012,7 @@ module GHC.IO.Handle where
hGetEcho :: Handle -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
hGetEncoding :: Handle -> GHC.Internal.Types.IO (GHC.Internal.Maybe.Maybe GHC.Internal.IO.Encoding.Types.TextEncoding)
hGetLine :: Handle -> GHC.Internal.Types.IO GHC.Internal.Base.String
+ hGetNewlineMode :: Handle -> GHC.Internal.Types.IO NewlineMode
hGetPosn :: Handle -> GHC.Internal.Types.IO HandlePosn
hIsClosed :: Handle -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
hIsEOF :: Handle -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
@@ -10163,7 +10164,7 @@ module System.Exit where
exitWith :: forall a. ExitCode -> GHC.Internal.Types.IO a
module System.IO where
- -- Safety: Safe
+ -- Safety: Trustworthy
type BufferMode :: *
data BufferMode = NoBuffering | LineBuffering | BlockBuffering (GHC.Internal.Maybe.Maybe GHC.Internal.Types.Int)
type FilePath :: *
=====================================
testsuite/tests/interface-stability/base-exports.stdout-ws-32
=====================================
@@ -7848,6 +7848,7 @@ module GHC.IO.Handle where
hGetEcho :: Handle -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
hGetEncoding :: Handle -> GHC.Internal.Types.IO (GHC.Internal.Maybe.Maybe GHC.Internal.IO.Encoding.Types.TextEncoding)
hGetLine :: Handle -> GHC.Internal.Types.IO GHC.Internal.Base.String
+ hGetNewlineMode :: Handle -> GHC.Internal.Types.IO NewlineMode
hGetPosn :: Handle -> GHC.Internal.Types.IO HandlePosn
hIsClosed :: Handle -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
hIsEOF :: Handle -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
@@ -9883,7 +9884,7 @@ module System.Exit where
exitWith :: forall a. ExitCode -> GHC.Internal.Types.IO a
module System.IO where
- -- Safety: Safe
+ -- Safety: Trustworthy
type BufferMode :: *
data BufferMode = NoBuffering | LineBuffering | BlockBuffering (GHC.Internal.Maybe.Maybe GHC.Internal.Types.Int)
type FilePath :: *
=====================================
testsuite/tests/typecheck/should_compile/T9497a.stderr
=====================================
@@ -1,4 +1,3 @@
-
T9497a.hs:2:8: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
• Found hole: _main :: IO ()
Or perhaps ‘_main’ is mis-spelled, or not in scope
@@ -8,8 +7,7 @@ T9497a.hs:2:8: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
main :: IO () (bound at T9497a.hs:2:1)
readLn :: forall a. Read a => IO a
with readLn @()
- (imported from ‘Prelude’
- (and originally defined in ‘GHC.Internal.System.IO’))
+ (imported from ‘Prelude’ (and originally defined in ‘System.IO’))
mempty :: forall a. Monoid a => a
with mempty @(IO ())
(imported from ‘Prelude’
=====================================
testsuite/tests/typecheck/should_compile/holes.stderr
=====================================
@@ -45,6 +45,15 @@ holes.hs:11:15: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
y :: [a]
z :: [a] -> [a]
f :: forall {p}. p
+ appendFile :: FilePath -> String -> IO ()
+ getChar :: IO Char
+ getContents :: IO String
+ getLine :: IO String
+ interact :: (String -> String) -> IO ()
+ putChar :: Char -> IO ()
+ putStr :: String -> IO ()
+ readFile :: FilePath -> IO String
+ writeFile :: FilePath -> String -> IO ()
otherwise :: Bool
(&&) :: Bool -> Bool -> Bool
not :: Bool -> Bool
@@ -58,16 +67,7 @@ holes.hs:11:15: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
showChar :: Char -> ShowS
showParen :: Bool -> ShowS -> ShowS
showString :: String -> ShowS
- appendFile :: FilePath -> String -> IO ()
- getChar :: IO Char
- getContents :: IO String
- getLine :: IO String
- interact :: (String -> String) -> IO ()
- putChar :: Char -> IO ()
- putStr :: String -> IO ()
putStrLn :: String -> IO ()
- readFile :: FilePath -> IO String
- writeFile :: FilePath -> String -> IO ()
EQ :: Ordering
GT :: Ordering
LT :: Ordering
=====================================
testsuite/tests/typecheck/should_compile/holes3.stderr
=====================================
@@ -48,6 +48,15 @@ holes3.hs:11:15: error: [GHC-88464]
y :: [a]
z :: [a] -> [a]
f :: forall {p}. p
+ appendFile :: FilePath -> String -> IO ()
+ getChar :: IO Char
+ getContents :: IO String
+ getLine :: IO String
+ interact :: (String -> String) -> IO ()
+ putChar :: Char -> IO ()
+ putStr :: String -> IO ()
+ readFile :: FilePath -> IO String
+ writeFile :: FilePath -> String -> IO ()
otherwise :: Bool
(&&) :: Bool -> Bool -> Bool
not :: Bool -> Bool
@@ -61,16 +70,7 @@ holes3.hs:11:15: error: [GHC-88464]
showChar :: Char -> ShowS
showParen :: Bool -> ShowS -> ShowS
showString :: String -> ShowS
- appendFile :: FilePath -> String -> IO ()
- getChar :: IO Char
- getContents :: IO String
- getLine :: IO String
- interact :: (String -> String) -> IO ()
- putChar :: Char -> IO ()
- putStr :: String -> IO ()
putStrLn :: String -> IO ()
- readFile :: FilePath -> IO String
- writeFile :: FilePath -> String -> IO ()
EQ :: Ordering
GT :: Ordering
LT :: Ordering
=====================================
testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr
=====================================
@@ -234,15 +234,14 @@ valid_hole_fits.hs:41:8: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
Valid hole fits include
ps :: String -> IO () (defined at valid_hole_fits.hs:9:1)
System.IO.putStr :: String -> IO ()
- (imported qualified from ‘System.IO’ at valid_hole_fits.hs:4:29-34
- (and originally defined in ‘GHC.Internal.System.IO’))
+ (imported qualified from ‘System.IO’ at valid_hole_fits.hs:4:29-34)
System.IO.putStrLn :: String -> IO ()
(imported qualified from ‘System.IO’ at valid_hole_fits.hs:4:37-44
(and originally defined in ‘GHC.Internal.System.IO’))
readIO :: forall a. Read a => String -> IO a
with readIO @()
(imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40
- (and originally defined in ‘GHC.Internal.System.IO’))
+ (and originally defined in ‘System.IO’))
fail :: forall (m :: * -> *) a.
(MonadFail m, GHC.Internal.Stack.Types.HasCallStack) =>
String -> m a
=====================================
testsuite/tests/typecheck/should_fail/T9497d.stderr
=====================================
@@ -8,8 +8,7 @@ T9497d.hs:2:8: error: [GHC-88464]
main :: IO () (bound at T9497d.hs:2:1)
readLn :: forall a. Read a => IO a
with readLn @()
- (imported from ‘Prelude’
- (and originally defined in ‘GHC.Internal.System.IO’))
+ (imported from ‘Prelude’ (and originally defined in ‘System.IO’))
mempty :: forall a. Monoid a => a
with mempty @(IO ())
(imported from ‘Prelude’
=====================================
testsuite/tests/typecheck/should_run/T9497a-run.stderr
=====================================
@@ -10,8 +10,7 @@ T9497a-run.hs:2:8: error: [GHC-88464]
main :: IO () (bound at T9497a-run.hs:2:1)
readLn :: forall a. Read a => IO a
with readLn @()
- (imported from ‘Prelude’
- (and originally defined in ‘GHC.Internal.System.IO’))
+ (imported from ‘Prelude’ (and originally defined in ‘System.IO’))
mempty :: forall a. Monoid a => a
with mempty @(IO ())
(imported from ‘Prelude’
=====================================
testsuite/tests/typecheck/should_run/T9497b-run.stderr
=====================================
@@ -10,8 +10,7 @@ T9497b-run.hs:2:8: error: [GHC-88464]
main :: IO () (bound at T9497b-run.hs:2:1)
readLn :: forall a. Read a => IO a
with readLn @()
- (imported from ‘Prelude’
- (and originally defined in ‘GHC.Internal.System.IO’))
+ (imported from ‘Prelude’ (and originally defined in ‘System.IO’))
mempty :: forall a. Monoid a => a
with mempty @(IO ())
(imported from ‘Prelude’
=====================================
testsuite/tests/typecheck/should_run/T9497c-run.stderr
=====================================
@@ -10,8 +10,7 @@ T9497c-run.hs:2:8: error: [GHC-88464]
main :: IO () (bound at T9497c-run.hs:2:1)
readLn :: forall a. Read a => IO a
with readLn @()
- (imported from ‘Prelude’
- (and originally defined in ‘GHC.Internal.System.IO’))
+ (imported from ‘Prelude’ (and originally defined in ‘System.IO’))
mempty :: forall a. Monoid a => a
with mempty @(IO ())
(imported from ‘Prelude’
=====================================
utils/haddock/html-test/ref/Bug1004.html
=====================================
@@ -627,13 +627,13 @@
>liftReadsPrec</a
> :: (<a href="#" title="Data.Int"
>Int</a
- > -> <a href="#" title="Prelude"
+ > -> <a href="#" title="Text.ParserCombinators.ReadP"
>ReadS</a
- > a) -> <a href="#" title="Prelude"
+ > a) -> <a href="#" title="Text.ParserCombinators.ReadP"
>ReadS</a
> [a] -> <a href="#" title="Data.Int"
>Int</a
- > -> <a href="#" title="Prelude"
+ > -> <a href="#" title="Text.ParserCombinators.ReadP"
>ReadS</a
> (<a href="#" title="Bug1004"
>Product</a
@@ -645,11 +645,11 @@
>liftReadList</a
> :: (<a href="#" title="Data.Int"
>Int</a
- > -> <a href="#" title="Prelude"
+ > -> <a href="#" title="Text.ParserCombinators.ReadP"
>ReadS</a
- > a) -> <a href="#" title="Prelude"
+ > a) -> <a href="#" title="Text.ParserCombinators.ReadP"
>ReadS</a
- > [a] -> <a href="#" title="Prelude"
+ > [a] -> <a href="#" title="Text.ParserCombinators.ReadP"
>ReadS</a
> [<a href="#" title="Bug1004"
>Product</a
@@ -735,15 +735,15 @@
>liftShowsPrec</a
> :: (<a href="#" title="Data.Int"
>Int</a
- > -> a -> <a href="#" title="Prelude"
+ > -> a -> <a href="#" title="Text.Show"
>ShowS</a
- >) -> ([a] -> <a href="#" title="Prelude"
+ >) -> ([a] -> <a href="#" title="Text.Show"
>ShowS</a
>) -> <a href="#" title="Data.Int"
>Int</a
> -> <a href="#" title="Bug1004"
>Product</a
- > f g a -> <a href="#" title="Prelude"
+ > f g a -> <a href="#" title="Text.Show"
>ShowS</a
> <a href="#" class="selflink"
>#</a
@@ -753,13 +753,13 @@
>liftShowList</a
> :: (<a href="#" title="Data.Int"
>Int</a
- > -> a -> <a href="#" title="Prelude"
+ > -> a -> <a href="#" title="Text.Show"
>ShowS</a
- >) -> ([a] -> <a href="#" title="Prelude"
+ >) -> ([a] -> <a href="#" title="Text.Show"
>ShowS</a
>) -> [<a href="#" title="Bug1004"
>Product</a
- > f g a] -> <a href="#" title="Prelude"
+ > f g a] -> <a href="#" title="Text.Show"
>ShowS</a
> <a href="#" class="selflink"
>#</a
@@ -2563,15 +2563,15 @@
></span
> <span class="breakable"
>(<span class="unbreakable"
- ><a href="#" title="Prelude"
+ ><a href="#" title="Text.Read"
>Read</a
> (f a)</span
>, <span class="unbreakable"
- ><a href="#" title="Prelude"
+ ><a href="#" title="Text.Read"
>Read</a
> (g a)</span
>)</span
- > => <a href="#" title="Prelude"
+ > => <a href="#" title="Text.Read"
>Read</a
> (<a href="#" title="Bug1004"
>Product</a
@@ -2603,7 +2603,7 @@
>readsPrec</a
> :: <a href="#" title="Data.Int"
>Int</a
- > -> <a href="#" title="Prelude"
+ > -> <a href="#" title="Text.ParserCombinators.ReadP"
>ReadS</a
> (<a href="#" title="Bug1004"
>Product</a
@@ -2613,7 +2613,7 @@
><p class="src"
><a href="#"
>readList</a
- > :: <a href="#" title="Prelude"
+ > :: <a href="#" title="Text.ParserCombinators.ReadP"
>ReadS</a
> [<a href="#" title="Bug1004"
>Product</a
@@ -2651,15 +2651,15 @@
></span
> <span class="breakable"
>(<span class="unbreakable"
- ><a href="#" title="Prelude"
+ ><a href="#" title="Text.Show"
>Show</a
> (f a)</span
>, <span class="unbreakable"
- ><a href="#" title="Prelude"
+ ><a href="#" title="Text.Show"
>Show</a
> (g a)</span
>)</span
- > => <a href="#" title="Prelude"
+ > => <a href="#" title="Text.Show"
>Show</a
> (<a href="#" title="Bug1004"
>Product</a
@@ -2693,7 +2693,7 @@
>Int</a
> -> <a href="#" title="Bug1004"
>Product</a
- > f g a -> <a href="#" title="Prelude"
+ > f g a -> <a href="#" title="Text.Show"
>ShowS</a
> <a href="#" class="selflink"
>#</a
@@ -2713,7 +2713,7 @@
>showList</a
> :: [<a href="#" title="Bug1004"
>Product</a
- > f g a] -> <a href="#" title="Prelude"
+ > f g a] -> <a href="#" title="Text.Show"
>ShowS</a
> <a href="#" class="selflink"
>#</a
=====================================
utils/haddock/html-test/ref/Bug973.html
=====================================
@@ -58,11 +58,11 @@
>showRead</a
> :: <span class="breakable"
>(<span class="unbreakable"
- ><a href="#" title="Prelude"
+ ><a href="#" title="Text.Show"
>Show</a
> a</span
>, <span class="unbreakable"
- ><a href="#" title="Prelude"
+ ><a href="#" title="Text.Read"
>Read</a
> b</span
>)</span
@@ -74,11 +74,11 @@
>forall</span
> b a. <span class="breakable"
>(<span class="unbreakable"
- ><a href="#" title="Prelude"
+ ><a href="#" title="Text.Show"
>Show</a
> a</span
>, <span class="unbreakable"
- ><a href="#" title="Prelude"
+ ><a href="#" title="Text.Read"
>Read</a
> b</span
>)</span
@@ -104,11 +104,11 @@
><td class="src"
>:: <span class="breakable"
>(<span class="unbreakable"
- ><a href="#" title="Prelude"
+ ><a href="#" title="Text.Show"
>Show</a
> a</span
>, <span class="unbreakable"
- ><a href="#" title="Prelude"
+ ><a href="#" title="Text.Read"
>Read</a
> b</span
>)</span
@@ -152,11 +152,11 @@
>forall</span
> b a. <span class="breakable"
>(<span class="unbreakable"
- ><a href="#" title="Prelude"
+ ><a href="#" title="Text.Show"
>Show</a
> a</span
>, <span class="unbreakable"
- ><a href="#" title="Prelude"
+ ><a href="#" title="Text.Read"
>Read</a
> b</span
>)</span
=====================================
utils/haddock/html-test/ref/ConstructorPatternExport.html
=====================================
@@ -95,7 +95,7 @@
>pattern</span
> <a id="v:BlubCons" class="def"
>BlubCons</a
- > :: () => <a href="#" title="Prelude"
+ > :: () => <a href="#" title="Text.Show"
>Show</a
> b => b -> Blub <a href="#" class="selflink"
>#</a
=====================================
utils/haddock/html-test/ref/DefaultSignatures.html
=====================================
@@ -133,7 +133,7 @@
>default</span
> <a id="v:bar" class="def"
>bar</a
- > :: <a href="#" title="Prelude"
+ > :: <a href="#" title="Text.Show"
>Show</a
> a => a -> <a href="#" title="Data.String"
>String</a
@@ -177,7 +177,7 @@
>default</span
> <a id="v:baz-39-" class="def"
>baz'</a
- > :: <a href="#" title="Prelude"
+ > :: <a href="#" title="Text.Read"
>Read</a
> a => <a href="#" title="Data.String"
>String</a
=====================================
utils/haddock/html-test/ref/Hash.html
=====================================
@@ -111,7 +111,7 @@
>)</span
> => <a href="#" title="Data.Int"
>Int</a
- > -> <a href="#" title="Prelude"
+ > -> <a href="#" title="System.IO"
>IO</a
> (<a href="#" title="Hash"
>HashTable</a
@@ -129,7 +129,7 @@
>Hash</a
> key</span
>)</span
- > => key -> val -> <a href="#" title="Prelude"
+ > => key -> val -> <a href="#" title="System.IO"
>IO</a
> ()</li
><li class="src short"
@@ -137,7 +137,7 @@
>lookup</a
> :: <a href="#" title="Hash"
>Hash</a
- > key => key -> <a href="#" title="Prelude"
+ > key => key -> <a href="#" title="System.IO"
>IO</a
> (<a href="#" title="Data.Maybe"
>Maybe</a
@@ -215,7 +215,7 @@
>)</span
> => <a href="#" title="Data.Int"
>Int</a
- > -> <a href="#" title="Prelude"
+ > -> <a href="#" title="System.IO"
>IO</a
> (<a href="#" title="Hash"
>HashTable</a
@@ -241,7 +241,7 @@
>Hash</a
> key</span
>)</span
- > => key -> val -> <a href="#" title="Prelude"
+ > => key -> val -> <a href="#" title="System.IO"
>IO</a
> () <a href="#" class="selflink"
>#</a
@@ -257,7 +257,7 @@
>lookup</a
> :: <a href="#" title="Hash"
>Hash</a
- > key => key -> <a href="#" title="Prelude"
+ > key => key -> <a href="#" title="System.IO"
>IO</a
> (<a href="#" title="Data.Maybe"
>Maybe</a
=====================================
utils/haddock/html-test/ref/PatternSyns.html
=====================================
@@ -104,7 +104,7 @@
>data</span
> <a href="#"
>BlubType</a
- > = <a href="#" title="Prelude"
+ > = <a href="#" title="Text.Show"
>Show</a
> x => <a href="#"
>BlubCtor</a
@@ -114,7 +114,7 @@
>pattern</span
> <a href="#"
>Blub</a
- > :: () => <a href="#" title="Prelude"
+ > :: () => <a href="#" title="Text.Show"
>Show</a
> x => x -> <a href="#" title="PatternSyns"
>BlubType</a
@@ -266,7 +266,7 @@
><table
><tr
><td class="src"
- ><a href="#" title="Prelude"
+ ><a href="#" title="Text.Show"
>Show</a
> x => <a id="v:BlubCtor" class="def"
>BlubCtor</a
@@ -283,7 +283,7 @@
>pattern</span
> <a id="v:Blub" class="def"
>Blub</a
- > :: () => <a href="#" title="Prelude"
+ > :: () => <a href="#" title="Text.Show"
>Show</a
> x => x -> <a href="#" title="PatternSyns"
>BlubType</a
=====================================
utils/haddock/html-test/ref/PatternSyns2.html
=====================================
@@ -145,7 +145,7 @@
>P</a
> :: () => <span class="keyword"
>forall</span
- > k (a :: k) b. <a href="#" title="Prelude"
+ > k (a :: k) b. <a href="#" title="Text.Show"
>Show</a
> b => <a href="#" title="Data.Proxy"
>Proxy</a
=====================================
utils/haddock/html-test/ref/QuasiExpr.html
=====================================
@@ -122,7 +122,7 @@
><span class="inst-left"
><span class="instance details-toggle-control details-toggle" data-details-id="i:id:Expr:Show:1"
></span
- > <a href="#" title="Prelude"
+ > <a href="#" title="Text.Show"
>Show</a
> <a href="#" title="QuasiExpr"
>Expr</a
@@ -152,7 +152,7 @@
>Int</a
> -> <a href="#" title="QuasiExpr"
>Expr</a
- > -> <a href="#" title="Prelude"
+ > -> <a href="#" title="Text.Show"
>ShowS</a
> <a href="#" class="selflink"
>#</a
@@ -172,7 +172,7 @@
>showList</a
> :: [<a href="#" title="QuasiExpr"
>Expr</a
- >] -> <a href="#" title="Prelude"
+ >] -> <a href="#" title="Text.Show"
>ShowS</a
> <a href="#" class="selflink"
>#</a
@@ -244,7 +244,7 @@
><span class="inst-left"
><span class="instance details-toggle-control details-toggle" data-details-id="i:id:BinOp:Show:1"
></span
- > <a href="#" title="Prelude"
+ > <a href="#" title="Text.Show"
>Show</a
> <a href="#" title="QuasiExpr"
>BinOp</a
@@ -274,7 +274,7 @@
>Int</a
> -> <a href="#" title="QuasiExpr"
>BinOp</a
- > -> <a href="#" title="Prelude"
+ > -> <a href="#" title="Text.Show"
>ShowS</a
> <a href="#" class="selflink"
>#</a
@@ -294,7 +294,7 @@
>showList</a
> :: [<a href="#" title="QuasiExpr"
>BinOp</a
- >] -> <a href="#" title="Prelude"
+ >] -> <a href="#" title="Text.Show"
>ShowS</a
> <a href="#" class="selflink"
>#</a
=====================================
utils/haddock/html-test/ref/Test.html
=====================================
@@ -521,7 +521,7 @@
><li
><a href="#"
>a</a
- > :: <a href="#" title="Prelude"
+ > :: <a href="#" title="System.IO"
>IO</a
> a</li
><li
@@ -575,7 +575,7 @@
>a</a
> :: <a href="#" title="Test"
>C</a
- > a => <a href="#" title="Prelude"
+ > a => <a href="#" title="System.IO"
>IO</a
> a</li
><li class="src short"
@@ -591,7 +591,7 @@
>g</a
> :: <a href="#" title="Data.Int"
>Int</a
- > -> <a href="#" title="Prelude"
+ > -> <a href="#" title="System.IO"
>IO</a
> CInt</li
><li class="src short"
@@ -661,7 +661,7 @@
>Float</a
>) -> <a href="#" title="Test"
>T5</a
- > () () -> <a href="#" title="Prelude"
+ > () () -> <a href="#" title="System.IO"
>IO</a
> ()</li
><li class="src short"
@@ -683,7 +683,7 @@
>R</a
> -> <a href="#" title="Test"
>N1</a
- > () -> <a href="#" title="Prelude"
+ > () -> <a href="#" title="System.IO"
>IO</a
> <a href="#" title="Data.Int"
>Int</a
@@ -693,7 +693,7 @@
>o</a
> :: <a href="#" title="Prelude"
>Float</a
- > -> <a href="#" title="Prelude"
+ > -> <a href="#" title="System.IO"
>IO</a
> <a href="#" title="Prelude"
>Float</a
@@ -1674,7 +1674,7 @@
><p class="src"
><a id="v:a" class="def"
>a</a
- > :: <a href="#" title="Prelude"
+ > :: <a href="#" title="System.IO"
>IO</a
> a <a href="#" class="selflink"
>#</a
@@ -1903,7 +1903,7 @@
>a</a
> :: <a href="#" title="Test"
>C</a
- > a => <a href="#" title="Prelude"
+ > a => <a href="#" title="System.IO"
>IO</a
> a <a href="#" class="selflink"
>#</a
@@ -1991,7 +1991,7 @@ using double quotes: <a href="#"
>g</a
> :: <a href="#" title="Data.Int"
>Int</a
- > -> <a href="#" title="Prelude"
+ > -> <a href="#" title="System.IO"
>IO</a
> CInt <a href="#" class="selflink"
>#</a
@@ -2267,7 +2267,7 @@ is at the beginning of the line).</pre
></tr
><tr
><td class="src"
- >-> <a href="#" title="Prelude"
+ >-> <a href="#" title="System.IO"
>IO</a
> ()</td
><td class="doc"
@@ -2355,7 +2355,7 @@ is at the beginning of the line).</pre
></tr
><tr
><td class="src"
- >-> <a href="#" title="Prelude"
+ >-> <a href="#" title="System.IO"
>IO</a
> <a href="#" title="Data.Int"
>Int</a
@@ -2395,7 +2395,7 @@ is at the beginning of the line).</pre
></tr
><tr
><td class="src"
- >-> <a href="#" title="Prelude"
+ >-> <a href="#" title="System.IO"
>IO</a
> <a href="#" title="Prelude"
>Float</a
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/72e14f1e2c81e16feea971bd68aaf0a…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/72e14f1e2c81e16feea971bd68aaf0a…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
19 Mar '26
Cheng Shao pushed new branch wip/validate-fix-werror at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/validate-fix-werror
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: ghci: Mention active language edition in startup banner
by Marge Bot (＠marge-bot) 19 Mar '26
by Marge Bot (＠marge-bot) 19 Mar '26
19 Mar '26
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
264d1cca by Adam Gundry at 2026-03-18T14:59:20-04:00
ghci: Mention active language edition in startup banner
Per GHC proposal 632, this makes the GHCi startup banner include
the active language edition, plus an indication of whether this
was the default (as opposed to being explicitly selected via an
option such as `-XGHC2024`). For example:
```
$ ghci
GHCi, version 9.14.1: https://www.haskell.org/ghc/ :? for help
Using default language edition: GHC2024
ghci>
```
Fixes #26037.
- - - - -
29e6623e by sheaf at 2026-03-18T14:59:26-04:00
Improve incomplete record selector warnings
This commit stops GHC from emitting spurious incomplete record selector
warnings for bare selectors/projections such as .fld
There are two places we currently emit incomplete record selector
warnings:
1. In the desugarer, when we see a record selector or an occurrence
of 'getField'. Here, we can use pattern matching information to
ensure we don't give false positives.
2. In the typechecker, which might sometimes give false positives but
can emit warnings in cases that the pattern match checker would
otherwise miss.
This is explained in Note [Detecting incomplete record selectors]
in GHC.HsToCore.Pmc.
Now, we obviously don't want to emit the same error twice, and generally
we prefer (1), as those messages contain fewer false positives. So we
suppress (2) when we are sure we are going to emit (1); the logic for
doing so is in GHC.Tc.Instance.Class.warnIncompleteRecSel,
and works by looking at the CtOrigin.
Now, the issue was that this logic handled explicit record selectors as
well as overloaded record field selectors such as "x.r" (which turns
into a simple GetFieldOrigin CtOrigin), but it didn't properly handle
record projectors like ".fld" or ".fld1.fld2" (which result in other
CtOrigins such as 'RecordFieldProjectionOrigin').
To solve this problem, we re-use the 'isHasFieldOrigin' introduced in
fbdc623a (slightly adjusted).
On the way, we also had to update the desugarer with special handling
for the 'ExpandedThingTc' case in 'ds_app', to make sure that
'ds_app_var' sees all the type arguments to 'getField' in order for it
to indeed emit warnings like in (1).
Fixes #26686
- - - - -
4562ceff by Cheng Shao at 2026-03-18T14:59:28-04:00
rts: opportunistically grow the MutableByteArray# in-place in resizeMutableByteArray#
Following !15234, this patch improves `resizeMutableByteArray#` memory
efficiency by growing the `MutableByteArray#` in-place if possible,
addressing an old todo comment here. Also adds a new test case
`resizeMutableByteArrayInPlace` that stresses this behavior.
- - - - -
607a3f73 by Sylvain Henry at 2026-03-18T14:59:35-04:00
Core: add constant-folding rules for Addr# eq/ne (#18032)
- - - - -
c5fc7cb6 by Matthew Pickering at 2026-03-18T14:59:37-04:00
Use OsPath rather than FilePath in Downsweep cache
This gets us one step closure to uniformly using `OsPath` in the
compiler.
- - - - -
c257675b by Cheng Shao at 2026-03-18T14:59:37-04:00
hadrian: fix ghc-in-ghci flavour stage0 shared libraries
This patch fixes missing stage0 shared libraries in hadrian
ghc-in-ghci flavour, which was accidentally dropped in
669d09f950a6e88b903d9fd8a7571531774d4d5d and resulted in a regression
in HLS support on linux/macos. Fixes #27057.
- - - - -
19 changed files:
- compiler/GHC/Core/Opt/ConstantFold.hs
- compiler/GHC/Driver/Downsweep.hs
- compiler/GHC/HsToCore/Expr.hs
- compiler/GHC/HsToCore/Pmc.hs
- compiler/GHC/Tc/Errors.hs
- compiler/GHC/Tc/Instance/Class.hs
- compiler/GHC/Tc/Types/Origin.hs
- ghc/GHCi/UI.hs
- ghc/Main.hs
- hadrian/src/Settings/Flavours/GhcInGhci.hs
- rts/PrimOps.cmm
- + testsuite/tests/overloadedrecflds/should_compile/T26686.hs
- + testsuite/tests/overloadedrecflds/should_compile/T26686.stderr
- testsuite/tests/overloadedrecflds/should_compile/all.T
- testsuite/tests/rts/all.T
- + testsuite/tests/rts/resizeMutableByteArrayInPlace.hs
- + testsuite/tests/simplCore/should_compile/T18032.hs
- + testsuite/tests/simplCore/should_compile/T18032.stderr
- testsuite/tests/simplCore/should_compile/all.T
Changes:
=====================================
compiler/GHC/Core/Opt/ConstantFold.hs
=====================================
@@ -847,6 +847,14 @@ primOpRules nm = \case
-- Misc
+ -- See Note [Constant folding for Addr# equality]
+ AddrEqOp -> mkPrimOpRule nm 2 [ equalArgs >> (trueValInt <$> getPlatform)
+ , match_litAddr_eq True
+ ]
+ AddrNeOp -> mkPrimOpRule nm 2 [ equalArgs >> (falseValInt <$> getPlatform)
+ , match_litAddr_eq False
+ ]
+
AddrAddOp -> mkPrimOpRule nm 2 [ rightIdentityPlatform zeroi ]
SparkOp -> mkPrimOpRule nm 4 [ sparkRule ]
@@ -969,6 +977,39 @@ cmpOp platform cmp = go
--------------------------
+-- Note [Constant folding for Addr# equality]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- We constant-fold (eqAddr# "foo"# "bar"#) when both arguments are string
+-- literals with *different* byte content. Because the bytes differ, the two
+-- literals cannot reside at the same address, so the result is definitely
+-- False (or True for neAddr#).
+--
+-- We use exprIsLiteral_maybe (via isLiteral) rather than binaryLit/cmpOp,
+-- because string literals are frequently floated out to the top level as CAF
+-- bindings. That turns them into variables, and we must look through those
+-- variable unfoldings to recover the underlying LitString.
+--
+-- When both literals have the *same* byte content we do NOT fold to True.
+-- Two distinct literal occurrences in the source may end up at different
+-- addresses in the object file (the linker is not required to merge them),
+-- so pointer equality is not guaranteed by equal content alone. The
+-- equalArgs already handles the case where both arguments are the *same*
+-- expression (provably the same pointer).
+
+match_litAddr_eq :: Bool -- ^ True <=> eqAddr# (fold different-content to False)
+ -- False <=> neAddr# (fold different-content to True)
+ -> RuleM CoreExpr
+-- See Note [Constant folding for Addr# equality]
+match_litAddr_eq is_eq = do
+ platform <- getPlatform
+ [e1, e2] <- getArgs
+ LitString s1 <- isLiteral e1
+ LitString s2 <- isLiteral e2
+ guard (s1 /= s2)
+ return $ if is_eq then falseValInt platform else trueValInt platform
+
+--------------------------
+
negOp :: RuleOpts -> Literal -> Maybe CoreExpr -- Negate
negOp env = \case
(LitFloat 0.0) -> Nothing -- can't represent -0.0 as a Rational
=====================================
compiler/GHC/Driver/Downsweep.hs
=====================================
@@ -56,7 +56,7 @@ import GHC.Data.Graph.Directed
import GHC.Data.FastString
import GHC.Data.Maybe ( expectJust )
import qualified GHC.Data.Maybe as M
-import GHC.Data.OsPath ( unsafeEncodeUtf )
+import GHC.Data.OsPath ( OsPath, unsafeEncodeUtf )
import GHC.Data.StringBuffer
import GHC.Data.Graph.Directed.Reachability
import qualified GHC.LanguageExtensions as LangExt
@@ -216,9 +216,9 @@ downsweep hsc_env diag_wrapper msg old_summaries excl_mods allow_dup_roots = do
-- file was used in.
-- Reuse these if we can because the most expensive part of downsweep is
-- reading the headers.
- old_summary_map :: M.Map (UnitId, FilePath) ModSummary
+ old_summary_map :: M.Map (UnitId, OsPath) ModSummary
old_summary_map =
- M.fromList [((ms_unitid ms, msHsFilePath ms), ms) | ms <- old_summaries]
+ M.fromList [((ms_unitid ms, msHsFileOsPath ms), ms) | ms <- old_summaries]
-- Dependencies arising on a unit (backpack and module linking deps)
unitModuleNodes :: [ModuleGraphNode] -> UnitId -> HomeUnitEnv -> [Either (Messages DriverMessage) ModuleGraphNode]
@@ -384,7 +384,7 @@ data DownsweepMode = DownsweepUseCompile | DownsweepUseFixed
-- This function will start at the given roots, and traverse downwards to find
-- all the dependencies, all the way to the leaf units.
downsweepFromRootNodes :: HscEnv
- -> M.Map (UnitId, FilePath) ModSummary
+ -> M.Map (UnitId, OsPath) ModSummary
-> [ModuleName]
-> Bool
-> DownsweepMode -- ^ Whether to create fixed or compile nodes for dependencies
@@ -442,7 +442,7 @@ type DownsweepM a = ReaderT DownsweepEnv IO a
data DownsweepEnv = DownsweepEnv {
downsweep_hsc_env :: HscEnv
, _downsweep_mode :: DownsweepMode
- , _downsweep_old_summaries :: M.Map (UnitId, FilePath) ModSummary
+ , _downsweep_old_summaries :: M.Map (UnitId, OsPath) ModSummary
, _downsweep_excl_mods :: [ModuleName]
}
@@ -715,7 +715,7 @@ linkNodes summaries uid hue =
getRootSummary ::
[ModuleName] ->
- M.Map (UnitId, FilePath) ModSummary ->
+ M.Map (UnitId, OsPath) ModSummary ->
HscEnv ->
Target ->
IO (Either DriverMessages ModSummary)
@@ -1183,7 +1183,7 @@ mkRootMap summaries = Map.fromListWith (flip (++))
summariseFile
:: HscEnv
-> HomeUnit
- -> M.Map (UnitId, FilePath) ModSummary -- old summaries
+ -> M.Map (UnitId, OsPath) ModSummary -- old summaries
-> FilePath -- source file name
-> Maybe Phase -- start phase
-> Maybe (StringBuffer,UTCTime)
@@ -1192,7 +1192,7 @@ summariseFile
summariseFile hsc_env' home_unit old_summaries src_fn mb_phase maybe_buf
-- we can use a cached summary if one is available and the
-- source file hasn't changed,
- | Just old_summary <- M.lookup (homeUnitId home_unit, src_fn) old_summaries
+ | Just old_summary <- M.lookup (homeUnitId home_unit, src_fn_os) old_summaries
= do
let location = ms_location $ old_summary
@@ -1213,6 +1213,7 @@ summariseFile hsc_env' home_unit old_summaries src_fn mb_phase maybe_buf
where
-- change the main active unit so all operations happen relative to the given unit
hsc_env = hscSetActiveHomeUnit home_unit hsc_env'
+ src_fn_os = unsafeEncodeUtf src_fn
-- src_fn does not necessarily exist on the filesystem, so we need to
-- check what kind of target we are dealing with
get_src_hash = case maybe_buf of
@@ -1302,7 +1303,7 @@ data SummariseResult =
-- --make mode.
summariseModule :: HscEnv
-> HomeUnit
- -> M.Map (UnitId, FilePath) ModSummary
+ -> M.Map (UnitId, OsPath) ModSummary
-> IsBootInterface
-> Located ModuleName
-> PkgQual
@@ -1382,7 +1383,7 @@ summariseModuleDispatch k hsc_env' home_unit is_boot (L _ wanted_mod) mb_pkg exc
-- for it and potentially compile it.
summariseModuleWithSource
:: HomeUnit
- -> M.Map (UnitId, FilePath) ModSummary
+ -> M.Map (UnitId, OsPath) ModSummary
-- ^ Map of old summaries
-> IsBootInterface -- True <=> a {-# SOURCE #-} import
-> Maybe (StringBuffer, UTCTime)
@@ -1411,7 +1412,7 @@ summariseModuleWithSource home_unit old_summary_map is_boot maybe_buf hsc_env lo
where
dflags = hsc_dflags hsc_env
new_summary_cache_check loc mod src_fn h
- | Just old_summary <- Map.lookup ((toUnitId (moduleUnit mod), src_fn)) old_summary_map =
+ | Just old_summary <- Map.lookup ((toUnitId (moduleUnit mod), src_fn_os)) old_summary_map =
-- check the hash on the source file, and
-- return the cached summary if it hasn't changed. If the
@@ -1422,6 +1423,8 @@ summariseModuleWithSource home_unit old_summary_map is_boot maybe_buf hsc_env lo
Nothing ->
checkSummaryHash hsc_env (new_summary loc mod src_fn) old_summary loc h
| otherwise = new_summary loc mod src_fn h
+ where
+ src_fn_os = unsafeEncodeUtf src_fn
new_summary :: ModLocation
-> Module
=====================================
compiler/GHC/HsToCore/Expr.hs
=====================================
@@ -721,6 +721,15 @@ ds_app (XExpr (ConLikeTc con)) _hs_args core_args
ds_app (XExpr (HsRecSelTc (FieldOcc { foLabel = L _ sel_id }))) _hs_args core_args
= ds_app_rec_sel sel_id sel_id core_args
+ds_app (XExpr (ExpandedThingTc _orig e)) hs_args core_args
+ = ds_app e hs_args core_args
+ -- NB: this is important for the 'getField' case of 'ds_app_var', which needs
+ -- to see all type arguments to 'getField' at once, while for record field
+ -- projections such as (.fld) we may get:
+ --
+ -- XExpr (ExpandedThingTc (.fld) (getField @Symbol @LiftedRep @LiftedRep "fld"))
+ -- `HsAppType` rec_ty `HsAppType` fld
+
ds_app (HsVar _ lfun) hs_args core_args
= ds_app_var lfun hs_args core_args
@@ -736,8 +745,10 @@ ds_app_var (L loc fun_id) hs_args core_args
-----------------------
-- Deal with getField applications. General form:
-- getField
- -- @GHC.Types.Symbol {k}
- -- @"sel" x_ty
+ -- @Symbol {k}
+ -- @LiftedRep {r_rep}
+ -- @LiftedRep {a_rep}
+ -- @"sel" fld
-- @T r_ty
-- @Int a_ty
-- ($dHasField :: HasField "sel" T Int) dict
=====================================
compiler/GHC/HsToCore/Pmc.hs
=====================================
@@ -375,6 +375,10 @@ Finally, there are two more items addressing -XOverloadedRecordDot:
the (IRS6) warning in the typechecker for a `HasField` constraint that
arises from a record-dot HsGetField occurrence. Happily, this is easy to do
by looking at its `CtOrigin`. Tested in T24891.
+
+ The same applies for record field projection operators such as (.fld) and
+ (.fld1.fld2), which have different 'CtOrigin's. The 'isHasFieldOrigin'
+ function catches those as well. Tested in T26686.
-}
pmcRecSel :: Id -- ^ Id of the selector
=====================================
compiler/GHC/Tc/Errors.hs
=====================================
@@ -97,6 +97,7 @@ import Data.Ord ( comparing )
import Data.Either ( partitionEithers )
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
+import qualified Data.Semigroup as Semi
{-
************************************************************************
@@ -2714,15 +2715,34 @@ hasFieldInfo_maybe rdr_env fam_inst_envs item
-- (HF2e) It's a custom HasField constraint, not the one from GHC.Records.
| Just (tc, _) <- splitTyConApp_maybe (errorItemPred item)
- , getOccString tc == "HasField"
- , isHasFieldOrigin (errorItemOrigin item)
- = return $ Just $ CustomHasField tc
+ = do { rebindable_syntax <- xoptM LangExt.RebindableSyntax
+ ; return $
+ if want_custom_hasfield_msg tc rebindable_syntax
+ then Just $ CustomHasField tc
+ else Nothing
+ }
| otherwise
= return Nothing
where
+ orig = errorItemOrigin item
+
+ want_custom_hasfield_msg tc rebindable_syntax
+ | getOccString tc == "HasField"
+ = Semi.getAny $ foldMapCtOrigin (Semi.Any . is_has_field) orig
+ | otherwise
+ = False
+ where
+ -- Handle custom 'getField'/'setField' with RebindableSyntax.
+ is_has_field (OccurrenceOf n)
+ | rebindable_syntax
+ , getOccString n `elem` ["getField", "setField"]
+ = True
+ is_has_field o
+ = isHasFieldOrigin o
+
get_parent_nm :: Name -> TcM (Maybe (Either PatSyn TyCon))
get_parent_nm nm =
do { fld_id <- tcLookupId nm
@@ -2762,22 +2782,6 @@ hasField_maybe pred =
-- NB: we deliberately don't handle rebound 'HasField' (with -XRebindableSyntax),
-- as GHC only has built-in instances for the built-in 'HasField' class.
--- | Does this constraint arise from GHC internal mechanisms that desugar to
--- usage of the 'HasField' typeclass (e.g. OverloadedRecordDot, etc)?
---
--- Just used heuristically to decide whether to print an informative message to
--- the user (see (H2e) in Note [Error messages for unsolved HasField constraints]).
-isHasFieldOrigin :: CtOrigin -> Bool
-isHasFieldOrigin = \case
- OccurrenceOf n ->
- -- A heuristic...
- getOccString n `elem` ["getField", "setField"]
- OccurrenceOfRecSel {} -> True
- RecordUpdOrigin {} -> True
- RecordFieldProjectionOrigin {} -> True
- GetFieldOrigin {} -> True
- _ -> False
-
-----------------------
-- relevantBindings looks at the value environment and finds values whose
-- types mention any of the offending type variables. It has to be
=====================================
compiler/GHC/Tc/Instance/Class.hs
=====================================
@@ -20,7 +20,7 @@ import GHC.Tc.Instance.Typeable
import GHC.Tc.Utils.TcMType
import GHC.Tc.Types.Evidence
import GHC.Tc.Types.CtLoc
-import GHC.Tc.Types.Origin ( InstanceWhat (..), SafeOverlapping, CtOrigin(GetFieldOrigin) )
+import GHC.Tc.Types.Origin ( InstanceWhat (..), SafeOverlapping, isHasFieldOrigin )
import GHC.Tc.Instance.Family( tcGetFamInstEnvs, tcLookupDataFamInst, FamInstEnvs )
import GHC.Rename.Env( addUsedGRE, addUsedDataCons, DeprecationWarnings (..) )
@@ -1275,8 +1275,8 @@ warnIncompleteRecSel :: DynFlags -> Id -> CtLoc -> TcM ()
-- Warn about incomplete record selectors
-- See (IRS6) in Note [Detecting incomplete record selectors] in GHC.HsToCore.Pmc
warnIncompleteRecSel dflags sel_id ct_loc
- | not (isGetFieldOrigin (ctLocOrigin ct_loc))
- -- isGetFieldOrigin: see (IRS7) in
+ | not $ isHasFieldOrigin (ctLocOrigin ct_loc)
+ -- isHasFieldOrigin: see (IRS7) in
-- Note [Detecting incomplete record selectors] in GHC.HsToCore.Pmc
, RecSelId { sel_cons = RSI { rsi_undef = fallible_cons } } <- idDetails sel_id
, not (null fallible_cons)
@@ -1288,11 +1288,6 @@ warnIncompleteRecSel dflags sel_id ct_loc
where
maxCons = maxUncoveredPatterns dflags
- -- GHC.Tc.Gen.App.tcInstFun arranges that the CtOrigin of (r.x) is GetFieldOrigin,
- -- despite the expansion to (getField @"x" r)
- isGetFieldOrigin (GetFieldOrigin {}) = True
- isGetFieldOrigin _ = False
-
lookupHasFieldLabel
:: FamInstEnvs -> GlobalRdrEnv -> [Type]
-> Maybe ( Name -- Name of the record selector
=====================================
compiler/GHC/Tc/Types/Origin.hs
=====================================
@@ -16,7 +16,8 @@ module GHC.Tc.Types.Origin (
CtOrigin(..), exprCtOrigin, lexprCtOrigin, matchesCtOrigin, grhssCtOrigin,
invisibleOrigin_maybe, isVisibleOrigin, toInvisibleOrigin,
pprCtOrigin, pprCtOriginBriefly, isGivenOrigin,
- defaultReprEqOrigins, isWantedSuperclassOrigin,
+ foldMapCtOrigin,
+ defaultReprEqOrigins, isWantedSuperclassOrigin, isHasFieldOrigin,
ClsInstOrQC(..), NakedScFlag(..), NonLinearPatternReason(..),
HsImplicitLiftSplice(..),
StandaloneDeriv,
@@ -52,6 +53,8 @@ import GHC.Tc.Utils.TcType
import GHC.Hs
+import GHC.Builtin.Names (getFieldName)
+
import GHC.Core.DataCon
import GHC.Core.ConLike
import GHC.Core.TyCon
@@ -79,6 +82,8 @@ import GHC.Types.Unique.Supply
import qualified Data.Kind as Hs
import Data.List.NonEmpty (NonEmpty (..))
import Data.Maybe (isNothing)
+import qualified Data.Semigroup as Semi
+import GHC.Generics
{- *********************************************************************
* *
@@ -993,6 +998,95 @@ pprNonLinearPatternReason PatternSynonymReason = parens (text "pattern synonyms
pprNonLinearPatternReason ViewPatternReason = parens (text "view patterns aren't linear")
pprNonLinearPatternReason OtherPatternReason = empty
+
+{- *********************************************************************
+* *
+ Recursing through CtOrigin
+* *
+********************************************************************* -}
+
+-- | Fold over a 'CtOrigin', looking through all recursive
+-- occurrences of 'CtOrigin' within 'CtOrigin'.
+foldMapCtOrigin :: forall m. Semigroup m => (CtOrigin -> m) -> CtOrigin -> m
+foldMapCtOrigin f = go
+ where
+ go :: CtOrigin -> m
+ go orig =
+ case orig of
+ KindEqOrigin _ _ o _ -> recur o
+ CycleBreakerOrigin o -> recur o
+ WantedSuperclassOrigin _ o -> recur o
+ DefaultReprEqOrigin _ _ o -> recur o
+ ScOrigin cls_or_qc _sc_flag ->
+ case cls_or_qc of
+ IsQC _ o -> recur o
+ IsClsInst -> f orig
+
+ -- Explicit pattern match on remaining constructors, in order to get
+ -- better pattern-match warnings when constructors are changed or
+ -- added/removed. This isn't entirely fool-proof, as someone may still
+ -- change the type of one of the fields and hide a 'CtOrigin' inside.
+ --
+ -- This approach was chosen instead of using 'syb'/'GHC.Generics',
+ -- because those would require deriving 'Data.Data'/'Generic' on
+ -- a huge number of datatypes.
+ GivenOrigin {} -> f orig
+ GivenSCOrigin {} -> f orig
+ OccurrenceOf {} -> f orig
+ OccurrenceOfRecSel {} -> f orig
+ AppOrigin {} -> f orig
+ SpecPragOrigin {} -> f orig
+ TypeEqOrigin {}-> f orig
+ IPOccOrigin {} -> f orig
+ OverLabelOrigin {} -> f orig
+ LiteralOrigin {} -> f orig
+ QualLiteralOrigin {} -> f orig
+ NegateOrigin {} -> f orig
+ ArithSeqOrigin {} -> f orig
+ AssocFamPatOrigin {} -> f orig
+ SectionOrigin {} -> f orig
+ GetFieldOrigin {} -> f orig
+ RecordFieldProjectionOrigin {} -> f orig
+ TupleOrigin {} -> f orig
+ ExprSigOrigin {} -> f orig
+ PatSigOrigin {} -> f orig
+ PatOrigin {} -> f orig
+ ProvCtxtOrigin {} -> f orig
+ RecordUpdOrigin {} -> f orig
+ ViewPatOrigin {} -> f orig
+ DerivOrigin {} -> f orig
+ DerivOriginDC {} -> f orig
+ DerivOriginCoerce {} -> f orig
+ DefaultOrigin {} -> f orig
+ DoOrigin {} -> f orig
+ DoPatOrigin {} -> f orig
+ MCompOrigin {} -> f orig
+ MCompPatOrigin {} -> f orig
+ ProcOrigin {} -> f orig
+ ArrowCmdOrigin {} -> f orig
+ AnnOrigin {} -> f orig
+ FunDepOrigin {} -> f orig
+ ExprHoleOrigin {} -> f orig
+ TypeHoleOrigin {} -> f orig
+ PatCheckOrigin {} -> f orig
+ ListOrigin {} -> f orig
+ IfThenElseOrigin {} -> f orig
+ BracketOrigin {} -> f orig
+ StaticOrigin {} -> f orig
+ ImpedanceMatching {} -> f orig
+ Shouldn'tHappenOrigin {} -> f orig
+ InstProvidedOrigin {} -> f orig
+ NonLinearPatternOrigin {} -> f orig
+ OmittedFieldOrigin {} -> f orig
+ UsageEnvironmentOf {} -> f orig
+ FRROrigin {} -> f orig
+ InstanceSigOrigin {} -> f orig
+ AmbiguityCheckOrigin {} -> f orig
+ ImplicitLiftOrigin {} -> f orig
+
+ where
+ recur o = f orig Semi.<> go o
+
{- *********************************************************************
* *
Defaulting of representational equalities
@@ -1004,21 +1098,10 @@ pprNonLinearPatternReason OtherPatternReason = empty
-- That is, this function extracts all occurrences of the 'DefaultReprEqOrigin'
-- constructor from within a 'CtOrigin'.
defaultReprEqOrigins :: CtOrigin -> [(CtOrigin, (TcType, TcType))]
-defaultReprEqOrigins = go
+defaultReprEqOrigins = foldMapCtOrigin go
where
go = \case
- DefaultReprEqOrigin l r o -> (o, (l, r)) : go o
-
- -- Handle recursive occurrences of 'CtOrigin' within 'CtOrigin'.
- -- TODO: use syb to derive this, so that the following never goes out of date.
- ScOrigin cls_or_qc _ ->
- case cls_or_qc of
- IsClsInst -> []
- IsQC _ o -> go o
- KindEqOrigin _ _ o _ -> go o
- CycleBreakerOrigin o -> go o
- WantedSuperclassOrigin _ o -> go o
-
+ DefaultReprEqOrigin l r o -> [(o, (l, r))]
_ -> []
{- *********************************************************************
@@ -1046,6 +1129,37 @@ isPushCallStackOrigin_maybe orig = Just orig_fs
where
orig_fs = mkFastString (showSDocUnsafe (pprCtOriginBriefly orig))
+{- *********************************************************************
+* *
+ HasField and CtOrigin
+* *
+********************************************************************* -}
+
+-- | Does this constraint arise from GHC internal mechanisms that desugar to
+-- usage of the 'HasField' typeclass (e.g. OverloadedRecordDot, etc)?
+--
+-- Used in two places:
+--
+-- - When reporting an unsolved 'HasField' constraint, to decide whether to
+-- print an informative message to the user.
+-- See (H2e) in Note [Error messages for unsolved HasField constraints]
+-- in GHC.Tc.Errors.
+-- - To avoid emitting a poor "incomplete record selector" warning directly
+-- in typechecker, in cases when the desugarer will be able to emit a better
+-- error message, due to having better pattern match checking information.
+-- See (IRS7) in Note [Detecting incomplete record selectors]
+-- in GHC.HsToCore.Pmc
+isHasFieldOrigin :: CtOrigin -> Bool
+isHasFieldOrigin = Semi.getAny . foldMapCtOrigin (Semi.Any . go)
+ where
+ go = \case
+ OccurrenceOf n -> n == getFieldName
+ OccurrenceOfRecSel {} -> True
+ RecordFieldProjectionOrigin {} -> True
+ GetFieldOrigin {} -> True
+ RecordUpdOrigin {} -> True
+ _ -> False
+
{-
************************************************************************
* *
=====================================
ghc/GHCi/UI.hs
=====================================
@@ -23,7 +23,8 @@ module GHCi.UI (
GhciSettings(..),
defaultGhciSettings,
ghciCommands,
- ghciWelcomeMsg
+ ghciWelcomeMsg,
+ languageEditionMsg
) where
-- GHCi
@@ -199,6 +200,10 @@ versionString = "GHCi, version " ++ cProjectVersion
ghciWelcomeMsg :: String
ghciWelcomeMsg = versionString ++ ": https://www.haskell.org/ghc/ :? for help"
+languageEditionMsg :: Maybe Language -> String
+languageEditionMsg Nothing = "Using default language edition: " ++ show defaultLanguage
+languageEditionMsg (Just lang) = "Using language edition: " ++ show lang
+
ghciCommands :: [Command]
ghciCommands = map mkCmd [
-- Hugs users are accustomed to :e, so make sure it doesn't overlap
=====================================
ghc/Main.hs
=====================================
@@ -37,7 +37,7 @@ import GHC.Platform
import GHC.Platform.Host
#if defined(HAVE_INTERNAL_INTERPRETER)
-import GHCi.UI ( interactiveUI, ghciWelcomeMsg, defaultGhciSettings )
+import GHCi.UI ( interactiveUI, ghciWelcomeMsg, defaultGhciSettings, languageEditionMsg )
#endif
import GHC.Runtime.Loader ( loadFrontendPlugin, initializeSessionPlugins )
@@ -334,7 +334,9 @@ showBanner _postLoadMode dflags = do
#if defined(HAVE_INTERNAL_INTERPRETER)
-- Show the GHCi banner
- when (isInteractiveMode _postLoadMode && verb >= 1) $ putStrLn ghciWelcomeMsg
+ when (isInteractiveMode _postLoadMode && verb >= 1) $
+ do putStrLn ghciWelcomeMsg
+ putStrLn $ languageEditionMsg (language dflags)
#endif
-- Display details of the configuration in verbose mode
=====================================
hadrian/src/Settings/Flavours/GhcInGhci.hs
=====================================
@@ -1,14 +1,22 @@
module Settings.Flavours.GhcInGhci (ghcInGhciFlavour) where
+import qualified Data.Set as Set
import Expression
import Flavour
+import Oracles.Flag
import {-# SOURCE #-} Settings.Default
-- Please update doc/flavours.md when changing this file.
ghcInGhciFlavour :: Flavour
ghcInGhciFlavour = disableProfiledLibs $ defaultFlavour
{ name = "ghc-in-ghci"
- , extraArgs = ghciArgs
+ , extraArgs = ghciArgs
+ , libraryWays =
+ Set.fromList
+ <$> mconcat
+ [ pure [vanilla]
+ , platformSupportsSharedLibs ? pure [dynamic]
+ ]
}
ghciArgs :: Args
=====================================
rts/PrimOps.cmm
=====================================
@@ -200,6 +200,26 @@ stg_isMutableByteArrayWeaklyPinnedzh ( gcptr mba )
* used to as the LDV profiler will essentially ignore arrays anyways.
*/
+/* Note [Resizing arrays in-place]
+ * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ * We try to shrink or grow bd->free when resizing a MutableByteArray in-place,
+ * to reclaim or use slop space at the end of the current block and avoid
+ * unnecessary fragmentation/allocation.
+ *
+ * But we must guarantee that:
+ *
+ * 1. mba is already at the end of current block (check bd->free).
+ * Otherwise we can't move closures that come after it anyway.
+ * 2. It's a nursery block that belongs to the current Capability,
+ * so check rCurrentAlloc (used by allocateMightFail) or
+ * pinned_object_block (used by allocatePinned). There's also no
+ * point if it's an older generation block, the mutator won't
+ * allocate into those blocks anyway.
+ *
+ * If check fails, fall back to the conservative code path: just zero the slop
+ * and return when shrinking, or allocate a new array when growing.
+ */
+
// shrink size of MutableByteArray in-place
stg_shrinkMutableByteArrayzh ( gcptr mba, W_ new_size )
// MutableByteArray# s -> Int# -> State# s -> State# s
@@ -212,20 +232,7 @@ stg_shrinkMutableByteArrayzh ( gcptr mba, W_ new_size )
old_wds = BYTES_TO_WDS(SIZEOF_StgArrBytes) + ROUNDUP_BYTES_TO_WDS(old_size);
new_wds = BYTES_TO_WDS(SIZEOF_StgArrBytes) + ROUNDUP_BYTES_TO_WDS(new_size);
- // Try to shrink bd->free as well, to reclaim slop space at the end
- // of current block and avoid unnecessary fragmentation. But we
- // must guarantee that:
- //
- // 1. mba is already at the end of current block (check bd->free).
- // Otherwise we can't move closures that come after it anyway.
- // 2. It's a nursery block that belongs to the current Capability,
- // so check rCurrentAlloc (used by allocateMightFail) or
- // pinned_object_block (used by allocatePinned). There's also no
- // point if it's an older generation block, the mutator won't
- // allocate into those blocks anyway.
- //
- // If check fails, fall back to the conservative code path: just
- // zero the slop and return.
+ // See Note [Resizing arrays in-place]
bd = Bdescr(mba);
if (bdescr_free(bd) != mba + WDS(old_wds) ||
(bd != StgRegTable_rCurrentAlloc(BaseReg) && bd != Capability_pinned_object_block(MyCapability()))) {
@@ -258,20 +265,33 @@ stg_shrinkMutableByteArrayzh ( gcptr mba, W_ new_size )
stg_resizzeMutableByteArrayzh ( gcptr mba, W_ new_size )
// MutableByteArray# s -> Int# -> State# s -> (# State# s,MutableByteArray# s #)
{
+ W_ old_size, old_wds, new_wds, new_free;
+ W_ bd;
+
ASSERT(new_size `ge` 0);
- if (new_size <= StgArrBytes_bytes(mba)) {
+ old_size = StgArrBytes_bytes(mba);
+ if (new_size <= old_size) {
call stg_shrinkMutableByteArrayzh(mba, new_size);
return (mba);
+ }
+
+ bd = Bdescr(mba);
+ old_wds = BYTES_TO_WDS(SIZEOF_StgArrBytes) + ROUNDUP_BYTES_TO_WDS(old_size);
+ new_wds = BYTES_TO_WDS(SIZEOF_StgArrBytes) + ROUNDUP_BYTES_TO_WDS(new_size);
+ new_free = mba + WDS(new_wds);
+
+ // See Note [Resizing arrays in-place]
+ // we also need to check that we don't grow past the end of current block.
+ if (bdescr_free(bd) == mba + WDS(old_wds) &&
+ (bd == StgRegTable_rCurrentAlloc(BaseReg) || bd == Capability_pinned_object_block(MyCapability())) &&
+ new_free <= bdescr_start(bd) + (TO_W_(bdescr_blocks(bd)) * BLOCK_SIZE)) {
+ bdescr_free(bd) = new_free;
+ StgArrBytes_bytes(mba) = new_size;
+ return (mba);
} else {
(P_ new_mba) = call stg_newByteArrayzh(new_size);
- // maybe at some point in the future we may be able to grow the
- // MBA in-place w/o copying if we know the space after the
- // current MBA is still available, as often we want to grow the
- // MBA shortly after we allocated the original MBA. So maybe no
- // further allocations have occurred by then.
-
// copy over old content
prim %memcpy(BYTE_ARR_CTS(new_mba), BYTE_ARR_CTS(mba),
StgArrBytes_bytes(mba), SIZEOF_W);
=====================================
testsuite/tests/overloadedrecflds/should_compile/T26686.hs
=====================================
@@ -0,0 +1,37 @@
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE GADTs #-}
+
+{-# OPTIONS_GHC -Wincomplete-record-selectors #-}
+
+module T26686 where
+
+import Data.Kind
+
+data A
+data B
+
+data G = G { f2 :: Int }
+
+data T x where
+ TA :: { ta :: G } -> T x
+ TB :: { tb :: G } -> T B
+
+data H a = H { f1 :: T a }
+
+test1_ok :: T A -> G
+test1_ok = (.ta)
+test2_ok :: T A -> Int
+test2_ok = (.ta.f2)
+test3_ok :: H A -> G
+test3_ok = (.f1.ta)
+test4_ok :: H A -> Int
+test4_ok = (.f1.ta.f2)
+
+test1_bad :: T x -> G
+test1_bad = (.ta)
+test2_bad :: T x -> Int
+test2_bad = (.ta.f2)
+test3_bad :: H x -> G
+test3_bad = (.f1.ta)
+test4_bad :: H x -> Int
+test4_bad = (.f1.ta.f2)
=====================================
testsuite/tests/overloadedrecflds/should_compile/T26686.stderr
=====================================
@@ -0,0 +1,16 @@
+T26686.hs:31:13: warning: [GHC-17335] [-Wincomplete-record-selectors (in -Wall)]
+ Selecting the record field ‘ta’ may fail for the following constructors:
+ TB
+
+T26686.hs:33:13: warning: [GHC-17335] [-Wincomplete-record-selectors (in -Wall)]
+ Selecting the record field ‘ta’ may fail for the following constructors:
+ TB
+
+T26686.hs:35:13: warning: [GHC-17335] [-Wincomplete-record-selectors (in -Wall)]
+ Selecting the record field ‘ta’ may fail for the following constructors:
+ TB
+
+T26686.hs:37:13: warning: [GHC-17335] [-Wincomplete-record-selectors (in -Wall)]
+ Selecting the record field ‘ta’ may fail for the following constructors:
+ TB
+
=====================================
testsuite/tests/overloadedrecflds/should_compile/all.T
=====================================
@@ -30,6 +30,7 @@ test('T21720', req_th, compile, [''])
test('T21898', normal, compile, [''])
test('T22160', [extra_files(['T22160_A.hs', 'T22160_B.hs', 'T22160_C.hs'])]
, multimod_compile, ['T22160_A T22160_B T22160_C T22160', '-v0'])
+test('T26686', normal, compile, [''])
test('DupFldFixity3', normal, compile, [''])
test('overloadedrecflds10'
, [extra_files(['OverloadedRecFlds10_A.hs', 'OverloadedRecFlds10_B.hs', 'OverloadedRecFlds10_C.hs'])]
=====================================
testsuite/tests/rts/all.T
=====================================
@@ -669,3 +669,5 @@ test('TimeoutQueue',
test('ClosureTable',
[req_c, only_ways(['normal', 'debug']), extra_files(['ClosureTable_c.c'])], compile_and_run,
['-debug -O0 ClosureTable_c.c -I{top}/../rts -I{top}/../rts/include'])
+
+test('resizeMutableByteArrayInPlace', [req_cmm, extra_ways(['optasm', 'sanity']), only_ways(['optasm', 'sanity'])], compile_and_run, [''])
=====================================
testsuite/tests/rts/resizeMutableByteArrayInPlace.hs
=====================================
@@ -0,0 +1,24 @@
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
+
+import Control.Monad
+import GHC.Exts
+import GHC.IO
+
+-- Given newByteArray#/newPinnedByteArray#, iterate given number of
+-- rounds: first allocate a MutableByteArray# using the first size,
+-- then resize to the new size, then resize back
+{-# INLINE testResize #-}
+testResize :: (Int# -> State# RealWorld -> (# State# RealWorld, MutableByteArray# RealWorld #)) -> Int -> Int -> Int -> IO ()
+testResize alloc# rounds (I# sz0#) (I# sz1#) =
+ replicateM_ rounds $ IO $ \s0 -> case alloc# sz0# s0 of
+ (# s1, mba0# #) -> case resizeMutableByteArray# mba0# sz1# s1 of
+ (# s2, mba1# #) -> case resizeMutableByteArray# mba1# sz0# s2 of
+ (# s3, _ #) -> (# s3, () #)
+
+main :: IO ()
+main = do
+ testResize newByteArray# 100000 8 64
+ testResize newByteArray# 100000 64 8
+ testResize newPinnedByteArray# 100000 8 64
+ testResize newPinnedByteArray# 100000 64 8
=====================================
testsuite/tests/simplCore/should_compile/T18032.hs
=====================================
@@ -0,0 +1,12 @@
+{-# LANGUAGE MagicHash #-}
+module T18032 where
+
+import GHC.Exts
+
+-- Different byte content: eqAddr# must be False (0), neAddr# must be True (1)
+a = I# (eqAddr# "foo"# "bar"#)
+b = I# (neAddr# "foo"# "bar"#)
+
+-- Same variable on both sides: eqAddr# must be True (1), neAddr# must be False (0)
+c = let s = "baz"# in I# (eqAddr# s s)
+d = let s = "baz"# in I# (neAddr# s s)
=====================================
testsuite/tests/simplCore/should_compile/T18032.stderr
=====================================
@@ -0,0 +1,15 @@
+
+==================== Tidy Core ====================
+Result size of Tidy Core
+ = {terms: 10, types: 4, coercions: 0, joins: 0/0}
+
+a = I# 0#
+
+b = I# 1#
+
+c = b
+
+d = a
+
+
+
=====================================
testsuite/tests/simplCore/should_compile/all.T
=====================================
@@ -593,3 +593,4 @@ test('T26722', [grep_errmsg(r'SPEC')], compile, ['-O -dno-typeable-binds'])
test('T26805', [grep_errmsg(r'fromInteger')], compile, ['-O -dno-typeable-binds -ddump-simpl -dsuppress-uniques'])
test('T26826', normal, compile, ['-O'])
test('T26903', [grep_errmsg(r'reverse')], compile, ['-O -dno-typeable-binds -ddump-simpl -dsuppress-uniques -dsuppress-all'])
+test('T18032', normal, compile, ['-O -dsuppress-all -dsuppress-uniques -dno-typeable-binds -ddump-simpl'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f1caa8a26ddbef36c30cf9003c9c12…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f1caa8a26ddbef36c30cf9003c9c12…
You're receiving this email because of your account on gitlab.haskell.org.
1
0