[Git][ghc/ghc][wip/T26868] Wibble order of kind variables
by Simon Peyton Jones (＠simonpj) 24 Feb '26
by Simon Peyton Jones (＠simonpj) 24 Feb '26
24 Feb '26
Simon Peyton Jones pushed to branch wip/T26868 at Glasgow Haskell Compiler / GHC
Commits:
3d06fd06 by Simon Peyton Jones at 2026-02-24T17:37:13+00:00
Wibble order of kind variables
- - - - -
1 changed file:
- compiler/GHC/Core/TyCo/FVs.hs
Changes:
=====================================
compiler/GHC/Core/TyCo/FVs.hs
=====================================
@@ -258,8 +258,10 @@ deepUnitFV fvs_of_kind v
do_it :: BoundVars -> TyCoVarSet -> TyCoVarSet
do_it bvs acc | v `elemVarSet` bvs = acc
| v `elemVarSet` acc = acc
- | otherwise = runFVAcc (fvs_of_kind (varType v)) $
- acc `extendVarSet` v
+ | otherwise = runFVAcc (fvs_of_kind (varType v)) acc
+ `extendVarSet` v
+ -- Left-to-right: add the kind variables to the
+ -- accumulator before v itself
{- *********************************************************************
* *
@@ -395,8 +397,10 @@ deepDetUnitFV fvs_of_kind v
do_it :: BoundVars -> DTyCoVarSet -> DTyCoVarSet
do_it bvs acc | v `elemVarSet` bvs = acc
| v `elemDVarSet` acc = acc
- | otherwise = runFVAcc (fvs_of_kind (varType v)) $
- acc `extendDVarSet` v
+ | otherwise = runFVAcc (fvs_of_kind (varType v)) acc
+ `extendDVarSet` v
+ -- Left-to-right: add the kind variables to the
+ -- accumulator before v itself
{- *********************************************************************
* *
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3d06fd0687fe33a3eee01fcc4c0db3e…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3d06fd0687fe33a3eee01fcc4c0db3e…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/VeryMilkyJoe/no-mod-loc-pat] Remove backwards compatability pattern synonym `ModLocation`
by Jana Chadt (＠VeryMilkyJoe) 24 Feb '26
by Jana Chadt (＠VeryMilkyJoe) 24 Feb '26
24 Feb '26
Jana Chadt pushed to branch wip/VeryMilkyJoe/no-mod-loc-pat at Glasgow Haskell Compiler / GHC
Commits:
61b16e2a by Jana Chadt at 2026-02-24T18:00:17+01:00
Remove backwards compatability pattern synonym `ModLocation`
* Introduce utility to create ShortByteString from an OsString.
* Introduce utility to create StringBuffer for a given OsPath.
* Add mkFastStringOsString, which returns a FastString for a given OsString.
Fixes #24932
- - - - -
12 changed files:
- compiler/GHC.hs
- compiler/GHC/Cmm/DebugBlock.hs
- compiler/GHC/CoreToStg/AddImplicitBinds.hs
- compiler/GHC/Data/FastString.hs
- compiler/GHC/Data/OsPath.hs
- compiler/GHC/Data/StringBuffer.hs
- compiler/GHC/Stg/Debug.hs
- compiler/GHC/Unit/Module/Location.hs
- compiler/GHC/Unit/Module/ModSummary.hs
- compiler/ghc.cabal.in
- testsuite/tests/ghc-api/fixed-nodes/FixedNodes.hs
- testsuite/tests/ghc-api/fixed-nodes/ModuleGraphInvariants.hs
Changes:
=====================================
compiler/GHC.hs
=====================================
@@ -79,7 +79,13 @@ module GHC (
ModuleGraph, emptyMG, mapMG, mkModuleGraph, mgModSummaries,
mgLookupModule,
ModSummary(..), ms_mod_name, ModLocation(..),
- pattern ModLocation,
+ ml_hs_file,
+ ml_hi_file,
+ ml_dyn_hi_file,
+ ml_obj_file,
+ ml_dyn_obj_file,
+ ml_hie_file,
+ ml_bytecode_file,
getModSummary,
getModuleGraph,
isLoaded,
@@ -457,6 +463,7 @@ import System.Environment ( getEnv, getProgName )
import System.Exit ( exitWith, ExitCode(..) )
import System.FilePath
import System.IO.Error ( isDoesNotExistError )
+import GHC.Data.OsPath (OsPath)
#if defined(HAVE_INTERNAL_INTERPRETER)
import Foreign.C
@@ -1575,12 +1582,12 @@ pprParenSymName a = parenSymOcc (getOccName a) (ppr (getName a))
-- a module by using 'getModSummary'
--
-- XXX: Explain pre-conditions
-getModuleSourceAndFlags :: ModSummary -> IO (String, StringBuffer, DynFlags)
+getModuleSourceAndFlags :: ModSummary -> IO (OsPath, StringBuffer, DynFlags)
getModuleSourceAndFlags m = do
- case ml_hs_file $ ms_location m of
+ case ml_hs_file_ospath $ ms_location m of
Nothing -> throwIO $ mkApiErr (ms_hspp_opts m) (text "No source available for module " <+> ppr (ms_mod m))
Just sourceFile -> do
- source <- hGetStringBuffer sourceFile
+ source <- hGetStringBufferOsPath sourceFile
return (sourceFile, source, ms_hspp_opts m)
@@ -1592,7 +1599,7 @@ getModuleSourceAndFlags m = do
getTokenStream :: ModSummary -> IO [Located Token]
getTokenStream mod = do
(sourceFile, source, dflags) <- getModuleSourceAndFlags mod
- let startLoc = mkRealSrcLoc (mkFastString sourceFile) 1 1
+ let startLoc = mkRealSrcLoc (mkFastStringOsString sourceFile) 1 1
case lexTokenStream (initParserOpts dflags) source startLoc of
POk _ ts -> return ts
PFailed pst -> throwErrors (initSourceErrorContext dflags) (GhcPsMessage <$> getPsErrorMessages pst)
@@ -1603,7 +1610,7 @@ getTokenStream mod = do
getRichTokenStream :: ModSummary -> IO [(Located Token, String)]
getRichTokenStream mod = do
(sourceFile, source, dflags) <- getModuleSourceAndFlags mod
- let startLoc = mkRealSrcLoc (mkFastString sourceFile) 1 1
+ let startLoc = mkRealSrcLoc (mkFastStringOsString sourceFile) 1 1
case lexTokenStream (initParserOpts dflags) source startLoc of
POk _ ts -> return $ addSourceToTokens startLoc source ts
PFailed pst -> throwErrors (initSourceErrorContext dflags) (GhcPsMessage <$> getPsErrorMessages pst)
=====================================
compiler/GHC/Cmm/DebugBlock.hs
=====================================
@@ -33,7 +33,7 @@ import GHC.Cmm.CLabel
import GHC.Cmm
import GHC.Cmm.Reg ( pprGlobalReg, pprGlobalRegUse )
import GHC.Cmm.Utils
-import GHC.Data.FastString ( LexicalFastString, nilFS, mkFastString )
+import GHC.Data.FastString ( LexicalFastString, nilFS, mkFastStringOsString )
import GHC.Unit.Module
import GHC.Utils.Outputable
import GHC.Utils.Panic
@@ -156,7 +156,7 @@ cmmDebugGen modLoc decls = map (blocksForScope Nothing) topScopes
rangeRating (span, _)
| srcSpanFile span == thisFile = 1
| otherwise = 2 :: Int
- thisFile = maybe nilFS mkFastString $ ml_hs_file modLoc
+ thisFile = maybe nilFS mkFastStringOsString $ ml_hs_file_ospath modLoc
-- Returns block tree for this scope as well as all nested
-- scopes. Note that if there are multiple blocks in the (exact)
=====================================
compiler/GHC/CoreToStg/AddImplicitBinds.hs
=====================================
@@ -135,15 +135,16 @@ tick_it :: Bool -> ModLocation -> Name -> CoreExpr -> CoreExpr
-- If we want to generate debug info, we put a source note on the
-- worker. This is useful, especially for heap profiling.
tick_it generate_debug_info mod_loc name
- | not generate_debug_info = id
+ | not generate_debug_info = id
| RealSrcSpan span _ <- nameSrcSpan name = tick span
- | Just file <- ml_hs_file mod_loc = tick (span1 file)
- | otherwise = tick (span1 "???")
+ | Just file <- ml_hs_file_ospath mod_loc = tick (span2 file)
+ | otherwise = tick (span1 "???")
where
tick span = Tick $ SourceNote span $
LexicalFastString $ mkFastString $
renderWithContext defaultSDocContext $ ppr name
- span1 file = realSrcLocSpan $ mkRealSrcLoc (mkFastString file) 1 1
+ span1 str = realSrcLocSpan $ mkRealSrcLoc (mkFastString str) 1 1
+ span2 file = realSrcLocSpan $ mkRealSrcLoc (mkFastStringOsString file) 1 1
=====================================
compiler/GHC/Data/FastString.hs
=====================================
@@ -77,6 +77,7 @@ module GHC.Data.FastString
mkFastStringBytes,
mkFastStringByteList,
mkFastString#,
+ mkFastStringOsString,
-- ** Deconstruction
unpackFS, -- :: FastString -> String
@@ -134,12 +135,14 @@ import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC
import qualified Data.ByteString.Unsafe as BS
import qualified Data.ByteString.Short as SBS
-import GHC.Data.ShortText (ShortText(..))
-import Foreign.C
-import System.IO
import Data.Data
import Data.IORef
import Data.Semigroup as Semi
+import Data.Type.Coercion (coerceWith)
+import Foreign.C
+import GHC.Data.ShortText (ShortText (..))
+import System.IO
+import System.OsString.Internal.Types
import Foreign
@@ -547,6 +550,14 @@ mkFastStringShortByteString :: ShortByteString -> FastString
mkFastStringShortByteString sbs =
inlinePerformIO $ mkFastStringWith (mkNewFastStringShortByteString sbs) sbs
+-- | Create a 'FastString' from an 'OsString', without copying.
+mkFastStringOsString :: OsString -> FastString
+mkFastStringOsString os = mkFastStringShortByteString $
+ -- Using 'OsPath''s 'unOS' here will unfortunately lead to cyclic dependencies
+ case coercionToPlatformTypes of
+ Left (_, windowsStringEv) -> unWS $ coerceWith windowsStringEv os
+ Right (_, posixStringEv) -> unPS $ coerceWith posixStringEv os
+
-- | Creates a UTF-8 encoded 'FastString' from a 'String'
mkFastString :: String -> FastString
{-# NOINLINE[1] mkFastString #-}
=====================================
compiler/GHC/Data/OsPath.hs
=====================================
@@ -8,6 +8,7 @@ module GHC.Data.OsPath
, unsafeDecodeUtf
, unsafeEncodeUtf
, os
+ , unOS
-- * Common utility functions
, (</>)
, (<.>)
@@ -28,13 +29,22 @@ import GHC.Prelude
import GHC.Utils.Misc (HasCallStack)
import GHC.Utils.Panic (panic)
+import Data.ByteString.Short (ShortByteString)
+import Data.Type.Coercion (coerceWith)
+import System.Directory.Internal (os)
+import System.Directory.OsPath (createDirectoryIfMissing, doesDirectoryExist, doesFileExist, getDirectoryContents)
import System.OsPath
import System.OsString (isSuffixOf)
-import System.Directory.OsPath (doesDirectoryExist, doesFileExist, getDirectoryContents, createDirectoryIfMissing)
-import System.Directory.Internal (os)
+import System.OsString.Internal.Types (coercionToPlatformTypes, unPS, unWS)
-- | Decode an 'OsPath' to 'FilePath', throwing an 'error' if decoding failed.
-- Prefer 'decodeUtf' and gracious error handling.
unsafeDecodeUtf :: HasCallStack => OsPath -> FilePath
unsafeDecodeUtf p =
either (\err -> panic $ "Failed to decodeUtf \"" ++ show p ++ "\", because: " ++ show err) id (decodeUtf p)
+
+-- | Extracts underlying 'ShortByteString' from the given 'OsString', taking care of platform specifics.
+unOS :: OsString -> ShortByteString
+unOS os = case coercionToPlatformTypes of
+ Left (_, windowsStringEv) -> unWS $ coerceWith windowsStringEv os
+ Right (_, posixStringEv) -> unPS $ coerceWith posixStringEv os
=====================================
compiler/GHC/Data/StringBuffer.hs
=====================================
@@ -21,6 +21,7 @@ module GHC.Data.StringBuffer
-- * Creation\/destruction
hGetStringBuffer,
hGetStringBufferBlock,
+ hGetStringBufferOsPath,
hPutStringBuffer,
appendStringBuffers,
stringToStringBuffer,
@@ -56,17 +57,19 @@ module GHC.Data.StringBuffer
import GHC.Prelude
import GHC.Data.FastString
+import GHC.Data.OsPath (OsPath)
+import GHC.Fingerprint
import GHC.Utils.Encoding
+import GHC.Utils.Exception (bracket_)
import GHC.Utils.IO.Unsafe
import GHC.Utils.Panic.Plain
-import GHC.Utils.Exception ( bracket_ )
-import GHC.Fingerprint
import Data.Maybe
+import GHC.IO.Encoding.Failure (CodingFailureMode (IgnoreCodingFailure))
+import GHC.IO.Encoding.UTF8 (mkUTF8)
+import System.File.OsPath qualified as FileIO
import System.IO
-import System.IO.Unsafe ( unsafePerformIO )
-import GHC.IO.Encoding.UTF8 ( mkUTF8 )
-import GHC.IO.Encoding.Failure ( CodingFailureMode(IgnoreCodingFailure) )
+import System.IO.Unsafe (unsafePerformIO)
import qualified Data.ByteString.Internal as BS
import qualified Data.ByteString as BS
@@ -111,6 +114,15 @@ instance Show StringBuffer where
hGetStringBuffer :: FilePath -> IO StringBuffer
hGetStringBuffer fname = do
h <- openBinaryFile fname ReadMode
+ hGetStringBufferHandle h
+
+hGetStringBufferOsPath :: OsPath -> IO StringBuffer
+hGetStringBufferOsPath fname = do
+ h <- FileIO.openBinaryFile fname ReadMode
+ hGetStringBufferHandle h
+
+hGetStringBufferHandle :: Handle -> IO StringBuffer
+hGetStringBufferHandle h = do
size_i <- hFileSize h
offset_i <- skipBOM h size_i 0 -- offset is 0 initially
let size = fromIntegral $ size_i - offset_i
=====================================
compiler/GHC/Stg/Debug.hs
=====================================
@@ -87,7 +87,7 @@ recordInfo :: Id -> StgExpr -> M ()
recordInfo bndr new_rhs = do
modLoc <- asks rModLocation
let
- thisFile = maybe nilFS mkFastString $ ml_hs_file modLoc
+ thisFile = maybe nilFS mkFastStringOsString $ ml_hs_file_ospath modLoc
-- A span from the ticks surrounding the new_rhs
best_span = quickSourcePos thisFile new_rhs
-- A back-up span if the bndr had a source position, many do not (think internally generated ids)
=====================================
compiler/GHC/Unit/Module/Location.hs
=====================================
@@ -2,31 +2,28 @@
{-# LANGUAGE ViewPatterns #-}
-- | Module location
module GHC.Unit.Module.Location
- ( ModLocation
- ( ..
- , ml_hs_file
- , ml_hi_file
- , ml_dyn_hi_file
- , ml_obj_file
- , ml_dyn_obj_file
- , ml_hie_file
- , ml_bytecode_file
- )
- , pattern ModLocation
+ ( ModLocation(..)
, addBootSuffix
, addBootSuffixLocn
, addBootSuffixLocnOut
, removeBootSuffix
, mkFileSrcSpan
+ , ml_hs_file
+ , ml_hi_file
+ , ml_dyn_hi_file
+ , ml_obj_file
+ , ml_dyn_obj_file
+ , ml_hie_file
+ , ml_bytecode_file
)
where
import GHC.Prelude
+import GHC.Data.FastString (mkFastStringOsString)
import GHC.Data.OsPath
import GHC.Types.SrcLoc
import GHC.Utils.Outputable
-import GHC.Data.FastString (mkFastString)
import qualified System.OsString as OsString
@@ -120,41 +117,31 @@ addBootSuffixLocnOut locn
-- | Compute a 'SrcSpan' from a 'ModLocation'.
mkFileSrcSpan :: ModLocation -> SrcSpan
mkFileSrcSpan mod_loc
- = case ml_hs_file mod_loc of
- Just file_path -> mkGeneralSrcSpan (mkFastString file_path)
+ = case ml_hs_file_ospath mod_loc of
+ Just file_path -> mkGeneralSrcSpan (mkFastStringOsString file_path)
Nothing -> interactiveSrcSpan -- Presumably
-- ----------------------------------------------------------------------------
-- Helpers for backwards compatibility
-- ----------------------------------------------------------------------------
-{-# COMPLETE ModLocation #-}
-
-pattern ModLocation :: Maybe FilePath -> FilePath -> FilePath -> FilePath -> FilePath -> FilePath -> FilePath -> ModLocation
-pattern ModLocation
- { ml_hs_file
- , ml_hi_file
- , ml_dyn_hi_file
- , ml_obj_file
- , ml_dyn_obj_file
- , ml_hie_file
- , ml_bytecode_file
- } <- OsPathModLocation
- { ml_hs_file_ospath = (fmap unsafeDecodeUtf -> ml_hs_file)
- , ml_hi_file_ospath = (unsafeDecodeUtf -> ml_hi_file)
- , ml_dyn_hi_file_ospath = (unsafeDecodeUtf -> ml_dyn_hi_file)
- , ml_obj_file_ospath = (unsafeDecodeUtf -> ml_obj_file)
- , ml_dyn_obj_file_ospath = (unsafeDecodeUtf -> ml_dyn_obj_file)
- , ml_hie_file_ospath = (unsafeDecodeUtf -> ml_hie_file)
- , ml_bytecode_file_ospath = (unsafeDecodeUtf -> ml_bytecode_file)
- } where
- ModLocation ml_hs_file ml_hi_file ml_dyn_hi_file ml_obj_file ml_dyn_obj_file ml_hie_file ml_bytecode_file
- = OsPathModLocation
- { ml_hs_file_ospath = fmap unsafeEncodeUtf ml_hs_file
- , ml_hi_file_ospath = unsafeEncodeUtf ml_hi_file
- , ml_dyn_hi_file_ospath = unsafeEncodeUtf ml_dyn_hi_file
- , ml_obj_file_ospath = unsafeEncodeUtf ml_obj_file
- , ml_dyn_obj_file_ospath = unsafeEncodeUtf ml_dyn_obj_file
- , ml_hie_file_ospath = unsafeEncodeUtf ml_hie_file
- , ml_bytecode_file_ospath = unsafeEncodeUtf ml_bytecode_file
- }
+ml_hs_file :: ModLocation -> Maybe FilePath
+ml_hs_file = fmap unsafeDecodeUtf . ml_hs_file_ospath
+
+ml_hi_file :: ModLocation -> FilePath
+ml_hi_file = unsafeDecodeUtf . ml_hi_file_ospath
+
+ml_dyn_hi_file :: ModLocation -> FilePath
+ml_dyn_hi_file = unsafeDecodeUtf . ml_dyn_hi_file_ospath
+
+ml_obj_file :: ModLocation -> FilePath
+ml_obj_file = unsafeDecodeUtf . ml_obj_file_ospath
+
+ml_dyn_obj_file :: ModLocation -> FilePath
+ml_dyn_obj_file = unsafeDecodeUtf . ml_dyn_obj_file_ospath
+
+ml_hie_file :: ModLocation -> FilePath
+ml_hie_file = unsafeDecodeUtf . ml_hie_file_ospath
+
+ml_bytecode_file :: ModLocation -> FilePath
+ml_bytecode_file = unsafeDecodeUtf . ml_bytecode_file_ospath
=====================================
compiler/GHC/Unit/Module/ModSummary.hs
=====================================
@@ -46,7 +46,7 @@ import GHC.Types.PkgQual
import GHC.Types.Basic
import GHC.Data.Maybe
-import GHC.Data.OsPath (OsPath)
+import GHC.Data.OsPath ( OsPath )
import GHC.Data.StringBuffer ( StringBuffer )
import GHC.Utils.Fingerprint
@@ -214,7 +214,7 @@ findTarget ms ts =
= ms_mod_name summary == m && ms_unitid summary == unitId
summary `matches` Target { targetId = TargetFile f _, targetUnitId = unitid }
| Just f' <- ml_hs_file (ms_location summary)
- = f == f' && ms_unitid summary == unitid
+ = f == f' && ms_unitid summary == unitid
_ `matches` _
= False
=====================================
compiler/ghc.cabal.in
=====================================
@@ -125,6 +125,7 @@ Library
containers >= 0.6.2.1 && < 0.9,
array >= 0.1 && < 0.6,
filepath >= 1.5 && < 1.6,
+ file-io >= 0.1.5 && < 0.3,
os-string >= 2.0.1 && < 2.1,
hpc >= 0.6 && < 0.8,
transformers >= 0.5 && < 0.7,
=====================================
testsuite/tests/ghc-api/fixed-nodes/FixedNodes.hs
=====================================
@@ -31,7 +31,7 @@ convertToFixed (ModuleNodeCompile ms) =
-- with the module summary information
let modName = ms_mod_name ms
modLoc = ms_location ms
- in ModuleNodeFixed (msKey ms) (ms_location ms) { ml_hs_file = Nothing}
+ in ModuleNodeFixed (msKey ms) (ms_location ms) { ml_hs_file_ospath = Nothing }
-- | Load a module graph and report the result
=====================================
testsuite/tests/ghc-api/fixed-nodes/ModuleGraphInvariants.hs
=====================================
@@ -29,7 +29,7 @@ convertToFixed :: ModuleNodeInfo -> ModuleNodeInfo
convertToFixed (ModuleNodeCompile ms) =
let modName = ms_mod_name ms
modLoc = ms_location ms
- in ModuleNodeFixed (msKey ms) (ms_location ms) { ml_hs_file = Nothing}
+ in ModuleNodeFixed (msKey ms) (ms_location ms) { ml_hs_file_ospath = Nothing }
-- | Test a module graph and report if it matches expected invariant violations
testModuleGraph :: String -> ModuleGraph -> [ModuleGraphInvariantError] -> Ghc ()
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/61b16e2ac75640c990f9af4c7522679…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/61b16e2ac75640c990f9af4c7522679…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/VeryMilkyJoe/no-mod-loc-pat] Remove backwards compatability pattern synonym `ModLocation`
by Jana Chadt (＠VeryMilkyJoe) 24 Feb '26
by Jana Chadt (＠VeryMilkyJoe) 24 Feb '26
24 Feb '26
Jana Chadt pushed to branch wip/VeryMilkyJoe/no-mod-loc-pat at Glasgow Haskell Compiler / GHC
Commits:
07405614 by Jana Chadt at 2026-02-24T17:58:22+01:00
Remove backwards compatability pattern synonym `ModLocation`
* Introduce utility to create ShortByteString from an OsString.
* Introduce utility to create StringBuffer for a given OsPath.
* Add mkFastStringOsString, which returns a FastString for a given OsString.
Fixes #24932
- - - - -
12 changed files:
- compiler/GHC.hs
- compiler/GHC/Cmm/DebugBlock.hs
- compiler/GHC/CoreToStg/AddImplicitBinds.hs
- compiler/GHC/Data/FastString.hs
- compiler/GHC/Data/OsPath.hs
- compiler/GHC/Data/StringBuffer.hs
- compiler/GHC/Stg/Debug.hs
- compiler/GHC/Unit/Module/Location.hs
- compiler/GHC/Unit/Module/ModSummary.hs
- compiler/ghc.cabal.in
- testsuite/tests/ghc-api/fixed-nodes/FixedNodes.hs
- testsuite/tests/ghc-api/fixed-nodes/ModuleGraphInvariants.hs
Changes:
=====================================
compiler/GHC.hs
=====================================
@@ -79,7 +79,13 @@ module GHC (
ModuleGraph, emptyMG, mapMG, mkModuleGraph, mgModSummaries,
mgLookupModule,
ModSummary(..), ms_mod_name, ModLocation(..),
- pattern ModLocation,
+ ml_hs_file,
+ ml_hi_file,
+ ml_dyn_hi_file,
+ ml_obj_file,
+ ml_dyn_obj_file,
+ ml_hie_file,
+ ml_bytecode_file,
getModSummary,
getModuleGraph,
isLoaded,
@@ -457,6 +463,7 @@ import System.Environment ( getEnv, getProgName )
import System.Exit ( exitWith, ExitCode(..) )
import System.FilePath
import System.IO.Error ( isDoesNotExistError )
+import GHC.Data.OsPath (OsPath)
#if defined(HAVE_INTERNAL_INTERPRETER)
import Foreign.C
@@ -1575,12 +1582,12 @@ pprParenSymName a = parenSymOcc (getOccName a) (ppr (getName a))
-- a module by using 'getModSummary'
--
-- XXX: Explain pre-conditions
-getModuleSourceAndFlags :: ModSummary -> IO (String, StringBuffer, DynFlags)
+getModuleSourceAndFlags :: ModSummary -> IO (OsPath, StringBuffer, DynFlags)
getModuleSourceAndFlags m = do
- case ml_hs_file $ ms_location m of
+ case ml_hs_file_ospath $ ms_location m of
Nothing -> throwIO $ mkApiErr (ms_hspp_opts m) (text "No source available for module " <+> ppr (ms_mod m))
Just sourceFile -> do
- source <- hGetStringBuffer sourceFile
+ source <- hGetStringBufferOsPath sourceFile
return (sourceFile, source, ms_hspp_opts m)
@@ -1592,7 +1599,7 @@ getModuleSourceAndFlags m = do
getTokenStream :: ModSummary -> IO [Located Token]
getTokenStream mod = do
(sourceFile, source, dflags) <- getModuleSourceAndFlags mod
- let startLoc = mkRealSrcLoc (mkFastString sourceFile) 1 1
+ let startLoc = mkRealSrcLoc (mkFastStringOsString sourceFile) 1 1
case lexTokenStream (initParserOpts dflags) source startLoc of
POk _ ts -> return ts
PFailed pst -> throwErrors (initSourceErrorContext dflags) (GhcPsMessage <$> getPsErrorMessages pst)
@@ -1603,7 +1610,7 @@ getTokenStream mod = do
getRichTokenStream :: ModSummary -> IO [(Located Token, String)]
getRichTokenStream mod = do
(sourceFile, source, dflags) <- getModuleSourceAndFlags mod
- let startLoc = mkRealSrcLoc (mkFastString sourceFile) 1 1
+ let startLoc = mkRealSrcLoc (mkFastStringOsString sourceFile) 1 1
case lexTokenStream (initParserOpts dflags) source startLoc of
POk _ ts -> return $ addSourceToTokens startLoc source ts
PFailed pst -> throwErrors (initSourceErrorContext dflags) (GhcPsMessage <$> getPsErrorMessages pst)
=====================================
compiler/GHC/Cmm/DebugBlock.hs
=====================================
@@ -33,7 +33,7 @@ import GHC.Cmm.CLabel
import GHC.Cmm
import GHC.Cmm.Reg ( pprGlobalReg, pprGlobalRegUse )
import GHC.Cmm.Utils
-import GHC.Data.FastString ( LexicalFastString, nilFS, mkFastString )
+import GHC.Data.FastString ( LexicalFastString, nilFS, mkFastStringOsString )
import GHC.Unit.Module
import GHC.Utils.Outputable
import GHC.Utils.Panic
@@ -156,7 +156,7 @@ cmmDebugGen modLoc decls = map (blocksForScope Nothing) topScopes
rangeRating (span, _)
| srcSpanFile span == thisFile = 1
| otherwise = 2 :: Int
- thisFile = maybe nilFS mkFastString $ ml_hs_file modLoc
+ thisFile = maybe nilFS mkFastStringOsString $ ml_hs_file_ospath modLoc
-- Returns block tree for this scope as well as all nested
-- scopes. Note that if there are multiple blocks in the (exact)
=====================================
compiler/GHC/CoreToStg/AddImplicitBinds.hs
=====================================
@@ -135,15 +135,16 @@ tick_it :: Bool -> ModLocation -> Name -> CoreExpr -> CoreExpr
-- If we want to generate debug info, we put a source note on the
-- worker. This is useful, especially for heap profiling.
tick_it generate_debug_info mod_loc name
- | not generate_debug_info = id
+ | not generate_debug_info = id
| RealSrcSpan span _ <- nameSrcSpan name = tick span
- | Just file <- ml_hs_file mod_loc = tick (span1 file)
- | otherwise = tick (span1 "???")
+ | Just file <- ml_hs_file_ospath mod_loc = tick (span2 file)
+ | otherwise = tick (span1 "???")
where
tick span = Tick $ SourceNote span $
LexicalFastString $ mkFastString $
renderWithContext defaultSDocContext $ ppr name
- span1 file = realSrcLocSpan $ mkRealSrcLoc (mkFastString file) 1 1
+ span1 str = realSrcLocSpan $ mkRealSrcLoc (mkFastString str) 1 1
+ span2 file = realSrcLocSpan $ mkRealSrcLoc (mkFastStringOsString file) 1 1
=====================================
compiler/GHC/Data/FastString.hs
=====================================
@@ -77,6 +77,7 @@ module GHC.Data.FastString
mkFastStringBytes,
mkFastStringByteList,
mkFastString#,
+ mkFastStringOsString,
-- ** Deconstruction
unpackFS, -- :: FastString -> String
@@ -134,12 +135,14 @@ import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC
import qualified Data.ByteString.Unsafe as BS
import qualified Data.ByteString.Short as SBS
-import GHC.Data.ShortText (ShortText(..))
-import Foreign.C
-import System.IO
import Data.Data
import Data.IORef
import Data.Semigroup as Semi
+import Data.Type.Coercion (coerceWith)
+import Foreign.C
+import GHC.Data.ShortText (ShortText (..))
+import System.IO
+import System.OsString.Internal.Types
import Foreign
@@ -547,6 +550,14 @@ mkFastStringShortByteString :: ShortByteString -> FastString
mkFastStringShortByteString sbs =
inlinePerformIO $ mkFastStringWith (mkNewFastStringShortByteString sbs) sbs
+-- | Create a 'FastString' from an 'OsString', without copying.
+mkFastStringOsString :: OsString -> FastString
+mkFastStringOsString os = mkFastStringShortByteString $
+ -- Using 'OsPath''s 'unOS' here will unfortunately lead to cyclic dependencies
+ case coercionToPlatformTypes of
+ Left (_, windowsStringEv) -> unWS $ coerceWith windowsStringEv os
+ Right (_, posixStringEv) -> unPS $ coerceWith posixStringEv os
+
-- | Creates a UTF-8 encoded 'FastString' from a 'String'
mkFastString :: String -> FastString
{-# NOINLINE[1] mkFastString #-}
=====================================
compiler/GHC/Data/OsPath.hs
=====================================
@@ -8,6 +8,7 @@ module GHC.Data.OsPath
, unsafeDecodeUtf
, unsafeEncodeUtf
, os
+ , unOS
-- * Common utility functions
, (</>)
, (<.>)
@@ -28,13 +29,22 @@ import GHC.Prelude
import GHC.Utils.Misc (HasCallStack)
import GHC.Utils.Panic (panic)
+import Data.ByteString.Short (ShortByteString)
+import Data.Type.Coercion (coerceWith)
+import System.Directory.Internal (os)
+import System.Directory.OsPath (createDirectoryIfMissing, doesDirectoryExist, doesFileExist, getDirectoryContents)
import System.OsPath
import System.OsString (isSuffixOf)
-import System.Directory.OsPath (doesDirectoryExist, doesFileExist, getDirectoryContents, createDirectoryIfMissing)
-import System.Directory.Internal (os)
+import System.OsString.Internal.Types (coercionToPlatformTypes, unPS, unWS)
-- | Decode an 'OsPath' to 'FilePath', throwing an 'error' if decoding failed.
-- Prefer 'decodeUtf' and gracious error handling.
unsafeDecodeUtf :: HasCallStack => OsPath -> FilePath
unsafeDecodeUtf p =
either (\err -> panic $ "Failed to decodeUtf \"" ++ show p ++ "\", because: " ++ show err) id (decodeUtf p)
+
+-- | Extracts underlying 'ShortByteString' from the given 'OsString', taking care of platform specifics.
+unOS :: OsString -> ShortByteString
+unOS os = case coercionToPlatformTypes of
+ Left (_, windowsStringEv) -> unWS $ coerceWith windowsStringEv os
+ Right (_, posixStringEv) -> unPS $ coerceWith posixStringEv os
=====================================
compiler/GHC/Data/StringBuffer.hs
=====================================
@@ -21,6 +21,7 @@ module GHC.Data.StringBuffer
-- * Creation\/destruction
hGetStringBuffer,
hGetStringBufferBlock,
+ hGetStringBufferOsPath,
hPutStringBuffer,
appendStringBuffers,
stringToStringBuffer,
@@ -56,17 +57,19 @@ module GHC.Data.StringBuffer
import GHC.Prelude
import GHC.Data.FastString
+import GHC.Data.OsPath (OsPath)
+import GHC.Fingerprint
import GHC.Utils.Encoding
+import GHC.Utils.Exception (bracket_)
import GHC.Utils.IO.Unsafe
import GHC.Utils.Panic.Plain
-import GHC.Utils.Exception ( bracket_ )
-import GHC.Fingerprint
import Data.Maybe
+import GHC.IO.Encoding.Failure (CodingFailureMode (IgnoreCodingFailure))
+import GHC.IO.Encoding.UTF8 (mkUTF8)
+import System.File.OsPath qualified as FileIO
import System.IO
-import System.IO.Unsafe ( unsafePerformIO )
-import GHC.IO.Encoding.UTF8 ( mkUTF8 )
-import GHC.IO.Encoding.Failure ( CodingFailureMode(IgnoreCodingFailure) )
+import System.IO.Unsafe (unsafePerformIO)
import qualified Data.ByteString.Internal as BS
import qualified Data.ByteString as BS
@@ -111,6 +114,15 @@ instance Show StringBuffer where
hGetStringBuffer :: FilePath -> IO StringBuffer
hGetStringBuffer fname = do
h <- openBinaryFile fname ReadMode
+ hGetStringBufferHandle h
+
+hGetStringBufferOsPath :: OsPath -> IO StringBuffer
+hGetStringBufferOsPath fname = do
+ h <- FileIO.openBinaryFile fname ReadMode
+ hGetStringBufferHandle h
+
+hGetStringBufferHandle :: Handle -> IO StringBuffer
+hGetStringBufferHandle h = do
size_i <- hFileSize h
offset_i <- skipBOM h size_i 0 -- offset is 0 initially
let size = fromIntegral $ size_i - offset_i
=====================================
compiler/GHC/Stg/Debug.hs
=====================================
@@ -87,7 +87,7 @@ recordInfo :: Id -> StgExpr -> M ()
recordInfo bndr new_rhs = do
modLoc <- asks rModLocation
let
- thisFile = maybe nilFS mkFastString $ ml_hs_file modLoc
+ thisFile = maybe nilFS mkFastStringOsString $ ml_hs_file_ospath modLoc
-- A span from the ticks surrounding the new_rhs
best_span = quickSourcePos thisFile new_rhs
-- A back-up span if the bndr had a source position, many do not (think internally generated ids)
=====================================
compiler/GHC/Unit/Module/Location.hs
=====================================
@@ -2,31 +2,28 @@
{-# LANGUAGE ViewPatterns #-}
-- | Module location
module GHC.Unit.Module.Location
- ( ModLocation
- ( ..
- , ml_hs_file
- , ml_hi_file
- , ml_dyn_hi_file
- , ml_obj_file
- , ml_dyn_obj_file
- , ml_hie_file
- , ml_bytecode_file
- )
- , pattern ModLocation
+ ( ModLocation(..)
, addBootSuffix
, addBootSuffixLocn
, addBootSuffixLocnOut
, removeBootSuffix
, mkFileSrcSpan
+ , ml_hs_file
+ , ml_hi_file
+ , ml_dyn_hi_file
+ , ml_obj_file
+ , ml_dyn_obj_file
+ , ml_hie_file
+ , ml_bytecode_file
)
where
import GHC.Prelude
+import GHC.Data.FastString (mkFastStringOsString)
import GHC.Data.OsPath
import GHC.Types.SrcLoc
import GHC.Utils.Outputable
-import GHC.Data.FastString (mkFastString)
import qualified System.OsString as OsString
@@ -120,41 +117,31 @@ addBootSuffixLocnOut locn
-- | Compute a 'SrcSpan' from a 'ModLocation'.
mkFileSrcSpan :: ModLocation -> SrcSpan
mkFileSrcSpan mod_loc
- = case ml_hs_file mod_loc of
- Just file_path -> mkGeneralSrcSpan (mkFastString file_path)
+ = case ml_hs_file_ospath mod_loc of
+ Just file_path -> mkGeneralSrcSpan (mkFastStringOsString file_path)
Nothing -> interactiveSrcSpan -- Presumably
-- ----------------------------------------------------------------------------
-- Helpers for backwards compatibility
-- ----------------------------------------------------------------------------
-{-# COMPLETE ModLocation #-}
-
-pattern ModLocation :: Maybe FilePath -> FilePath -> FilePath -> FilePath -> FilePath -> FilePath -> FilePath -> ModLocation
-pattern ModLocation
- { ml_hs_file
- , ml_hi_file
- , ml_dyn_hi_file
- , ml_obj_file
- , ml_dyn_obj_file
- , ml_hie_file
- , ml_bytecode_file
- } <- OsPathModLocation
- { ml_hs_file_ospath = (fmap unsafeDecodeUtf -> ml_hs_file)
- , ml_hi_file_ospath = (unsafeDecodeUtf -> ml_hi_file)
- , ml_dyn_hi_file_ospath = (unsafeDecodeUtf -> ml_dyn_hi_file)
- , ml_obj_file_ospath = (unsafeDecodeUtf -> ml_obj_file)
- , ml_dyn_obj_file_ospath = (unsafeDecodeUtf -> ml_dyn_obj_file)
- , ml_hie_file_ospath = (unsafeDecodeUtf -> ml_hie_file)
- , ml_bytecode_file_ospath = (unsafeDecodeUtf -> ml_bytecode_file)
- } where
- ModLocation ml_hs_file ml_hi_file ml_dyn_hi_file ml_obj_file ml_dyn_obj_file ml_hie_file ml_bytecode_file
- = OsPathModLocation
- { ml_hs_file_ospath = fmap unsafeEncodeUtf ml_hs_file
- , ml_hi_file_ospath = unsafeEncodeUtf ml_hi_file
- , ml_dyn_hi_file_ospath = unsafeEncodeUtf ml_dyn_hi_file
- , ml_obj_file_ospath = unsafeEncodeUtf ml_obj_file
- , ml_dyn_obj_file_ospath = unsafeEncodeUtf ml_dyn_obj_file
- , ml_hie_file_ospath = unsafeEncodeUtf ml_hie_file
- , ml_bytecode_file_ospath = unsafeEncodeUtf ml_bytecode_file
- }
+ml_hs_file :: ModLocation -> Maybe FilePath
+ml_hs_file = fmap unsafeDecodeUtf . ml_hs_file_ospath
+
+ml_hi_file :: ModLocation -> FilePath
+ml_hi_file = unsafeDecodeUtf . ml_hi_file_ospath
+
+ml_dyn_hi_file :: ModLocation -> FilePath
+ml_dyn_hi_file = unsafeDecodeUtf . ml_dyn_hi_file_ospath
+
+ml_obj_file :: ModLocation -> FilePath
+ml_obj_file = unsafeDecodeUtf . ml_obj_file_ospath
+
+ml_dyn_obj_file :: ModLocation -> FilePath
+ml_dyn_obj_file = unsafeDecodeUtf . ml_dyn_obj_file_ospath
+
+ml_hie_file :: ModLocation -> FilePath
+ml_hie_file = unsafeDecodeUtf . ml_hie_file_ospath
+
+ml_bytecode_file :: ModLocation -> FilePath
+ml_bytecode_file = unsafeDecodeUtf . ml_bytecode_file_ospath
=====================================
compiler/GHC/Unit/Module/ModSummary.hs
=====================================
@@ -46,7 +46,7 @@ import GHC.Types.PkgQual
import GHC.Types.Basic
import GHC.Data.Maybe
-import GHC.Data.OsPath (OsPath)
+import GHC.Data.OsPath ( OsPath )
import GHC.Data.StringBuffer ( StringBuffer )
import GHC.Utils.Fingerprint
@@ -214,7 +214,7 @@ findTarget ms ts =
= ms_mod_name summary == m && ms_unitid summary == unitId
summary `matches` Target { targetId = TargetFile f _, targetUnitId = unitid }
| Just f' <- ml_hs_file (ms_location summary)
- = f == f' && ms_unitid summary == unitid
+ = f == f' && ms_unitid summary == unitid
_ `matches` _
= False
=====================================
compiler/ghc.cabal.in
=====================================
@@ -125,6 +125,7 @@ Library
containers >= 0.6.2.1 && < 0.9,
array >= 0.1 && < 0.6,
filepath >= 1.5 && < 1.6,
+ file-io >= 0.1.5 && < 0.3,
os-string >= 2.0.1 && < 2.1,
hpc >= 0.6 && < 0.8,
transformers >= 0.5 && < 0.7,
=====================================
testsuite/tests/ghc-api/fixed-nodes/FixedNodes.hs
=====================================
@@ -31,7 +31,7 @@ convertToFixed (ModuleNodeCompile ms) =
-- with the module summary information
let modName = ms_mod_name ms
modLoc = ms_location ms
- in ModuleNodeFixed (msKey ms) (ms_location ms) { ml_hs_file = Nothing}
+ in ModuleNodeFixed (msKey ms) (ms_location ms) { ml_hs_file_ospath = Nothing }
-- | Load a module graph and report the result
=====================================
testsuite/tests/ghc-api/fixed-nodes/ModuleGraphInvariants.hs
=====================================
@@ -29,7 +29,7 @@ convertToFixed :: ModuleNodeInfo -> ModuleNodeInfo
convertToFixed (ModuleNodeCompile ms) =
let modName = ms_mod_name ms
modLoc = ms_location ms
- in ModuleNodeFixed (msKey ms) (ms_location ms) { ml_hs_file = Nothing}
+ in ModuleNodeFixed (msKey ms) (ms_location ms) { ml_hs_file_ospath = Nothing }
-- | Test a module graph and report if it matches expected invariant violations
testModuleGraph :: String -> ModuleGraph -> [ModuleGraphInvariantError] -> Ghc ()
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0740561449bca25bc6df9b4903589a7…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0740561449bca25bc6df9b4903589a7…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/VeryMilkyJoe/no-mod-loc-pat] Remove backwards compatability pattern synonym `ModLocation`
by Jana Chadt (＠VeryMilkyJoe) 24 Feb '26
by Jana Chadt (＠VeryMilkyJoe) 24 Feb '26
24 Feb '26
Jana Chadt pushed to branch wip/VeryMilkyJoe/no-mod-loc-pat at Glasgow Haskell Compiler / GHC
Commits:
11bdc6ad by Jana Chadt at 2026-02-24T17:13:59+01:00
Remove backwards compatability pattern synonym `ModLocation`
* Introduce utility to create ShortByteString from an OsString.
* Introduce utility to create StringBuffer for a given OsPath.
* Add mkFastStringOsString, which returns a FastString for a given OsString.
Fixes #24932
- - - - -
12 changed files:
- compiler/GHC.hs
- compiler/GHC/Cmm/DebugBlock.hs
- compiler/GHC/CoreToStg/AddImplicitBinds.hs
- compiler/GHC/Data/FastString.hs
- compiler/GHC/Data/OsPath.hs
- compiler/GHC/Data/StringBuffer.hs
- compiler/GHC/Stg/Debug.hs
- compiler/GHC/Unit/Module/Location.hs
- compiler/GHC/Unit/Module/ModSummary.hs
- compiler/ghc.cabal.in
- testsuite/tests/ghc-api/fixed-nodes/FixedNodes.hs
- testsuite/tests/ghc-api/fixed-nodes/ModuleGraphInvariants.hs
Changes:
=====================================
compiler/GHC.hs
=====================================
@@ -79,7 +79,13 @@ module GHC (
ModuleGraph, emptyMG, mapMG, mkModuleGraph, mgModSummaries,
mgLookupModule,
ModSummary(..), ms_mod_name, ModLocation(..),
- pattern ModLocation,
+ ml_hs_file,
+ ml_hi_file,
+ ml_dyn_hi_file,
+ ml_obj_file,
+ ml_dyn_obj_file,
+ ml_hie_file,
+ ml_bytecode_file,
getModSummary,
getModuleGraph,
isLoaded,
@@ -457,6 +463,7 @@ import System.Environment ( getEnv, getProgName )
import System.Exit ( exitWith, ExitCode(..) )
import System.FilePath
import System.IO.Error ( isDoesNotExistError )
+import GHC.Data.OsPath (OsPath)
#if defined(HAVE_INTERNAL_INTERPRETER)
import Foreign.C
@@ -1575,12 +1582,12 @@ pprParenSymName a = parenSymOcc (getOccName a) (ppr (getName a))
-- a module by using 'getModSummary'
--
-- XXX: Explain pre-conditions
-getModuleSourceAndFlags :: ModSummary -> IO (String, StringBuffer, DynFlags)
+getModuleSourceAndFlags :: ModSummary -> IO (OsPath, StringBuffer, DynFlags)
getModuleSourceAndFlags m = do
- case ml_hs_file $ ms_location m of
+ case ml_hs_file_ospath $ ms_location m of
Nothing -> throwIO $ mkApiErr (ms_hspp_opts m) (text "No source available for module " <+> ppr (ms_mod m))
Just sourceFile -> do
- source <- hGetStringBuffer sourceFile
+ source <- hGetStringBufferOsPath sourceFile
return (sourceFile, source, ms_hspp_opts m)
@@ -1592,7 +1599,7 @@ getModuleSourceAndFlags m = do
getTokenStream :: ModSummary -> IO [Located Token]
getTokenStream mod = do
(sourceFile, source, dflags) <- getModuleSourceAndFlags mod
- let startLoc = mkRealSrcLoc (mkFastString sourceFile) 1 1
+ let startLoc = mkRealSrcLoc (mkFastStringOsString sourceFile) 1 1
case lexTokenStream (initParserOpts dflags) source startLoc of
POk _ ts -> return ts
PFailed pst -> throwErrors (initSourceErrorContext dflags) (GhcPsMessage <$> getPsErrorMessages pst)
@@ -1603,7 +1610,7 @@ getTokenStream mod = do
getRichTokenStream :: ModSummary -> IO [(Located Token, String)]
getRichTokenStream mod = do
(sourceFile, source, dflags) <- getModuleSourceAndFlags mod
- let startLoc = mkRealSrcLoc (mkFastString sourceFile) 1 1
+ let startLoc = mkRealSrcLoc (mkFastStringOsString sourceFile) 1 1
case lexTokenStream (initParserOpts dflags) source startLoc of
POk _ ts -> return $ addSourceToTokens startLoc source ts
PFailed pst -> throwErrors (initSourceErrorContext dflags) (GhcPsMessage <$> getPsErrorMessages pst)
=====================================
compiler/GHC/Cmm/DebugBlock.hs
=====================================
@@ -33,7 +33,7 @@ import GHC.Cmm.CLabel
import GHC.Cmm
import GHC.Cmm.Reg ( pprGlobalReg, pprGlobalRegUse )
import GHC.Cmm.Utils
-import GHC.Data.FastString ( LexicalFastString, nilFS, mkFastString )
+import GHC.Data.FastString ( LexicalFastString, nilFS, mkFastStringOsString )
import GHC.Unit.Module
import GHC.Utils.Outputable
import GHC.Utils.Panic
@@ -156,7 +156,7 @@ cmmDebugGen modLoc decls = map (blocksForScope Nothing) topScopes
rangeRating (span, _)
| srcSpanFile span == thisFile = 1
| otherwise = 2 :: Int
- thisFile = maybe nilFS mkFastString $ ml_hs_file modLoc
+ thisFile = maybe nilFS mkFastStringOsString $ ml_hs_file_ospath modLoc
-- Returns block tree for this scope as well as all nested
-- scopes. Note that if there are multiple blocks in the (exact)
=====================================
compiler/GHC/CoreToStg/AddImplicitBinds.hs
=====================================
@@ -135,15 +135,16 @@ tick_it :: Bool -> ModLocation -> Name -> CoreExpr -> CoreExpr
-- If we want to generate debug info, we put a source note on the
-- worker. This is useful, especially for heap profiling.
tick_it generate_debug_info mod_loc name
- | not generate_debug_info = id
+ | not generate_debug_info = id
| RealSrcSpan span _ <- nameSrcSpan name = tick span
- | Just file <- ml_hs_file mod_loc = tick (span1 file)
- | otherwise = tick (span1 "???")
+ | Just file <- ml_hs_file_ospath mod_loc = tick (span2 file)
+ | otherwise = tick (span1 "???")
where
tick span = Tick $ SourceNote span $
LexicalFastString $ mkFastString $
renderWithContext defaultSDocContext $ ppr name
- span1 file = realSrcLocSpan $ mkRealSrcLoc (mkFastString file) 1 1
+ span1 str = realSrcLocSpan $ mkRealSrcLoc (mkFastString str) 1 1
+ span2 file = realSrcLocSpan $ mkRealSrcLoc (mkFastStringOsString file) 1 1
=====================================
compiler/GHC/Data/FastString.hs
=====================================
@@ -77,6 +77,7 @@ module GHC.Data.FastString
mkFastStringBytes,
mkFastStringByteList,
mkFastString#,
+ mkFastStringOsString,
-- ** Deconstruction
unpackFS, -- :: FastString -> String
@@ -134,12 +135,14 @@ import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC
import qualified Data.ByteString.Unsafe as BS
import qualified Data.ByteString.Short as SBS
-import GHC.Data.ShortText (ShortText(..))
-import Foreign.C
-import System.IO
import Data.Data
import Data.IORef
import Data.Semigroup as Semi
+import Data.Type.Coercion (coerceWith)
+import Foreign.C
+import GHC.Data.ShortText (ShortText (..))
+import System.IO
+import System.OsString.Internal.Types
import Foreign
@@ -547,6 +550,14 @@ mkFastStringShortByteString :: ShortByteString -> FastString
mkFastStringShortByteString sbs =
inlinePerformIO $ mkFastStringWith (mkNewFastStringShortByteString sbs) sbs
+-- | Create a 'FastString' from an 'OsString', without copying.
+mkFastStringOsString :: OsString -> FastString
+mkFastStringOsString os = mkFastStringShortByteString $
+ -- Using 'OsPath''s 'unOS' here will unfortunately lead to cyclic dependencies
+ case coercionToPlatformTypes of
+ Left (_, windowsStringEv) -> unWS $ coerceWith windowsStringEv os
+ Right (_, posixStringEv) -> unPS $ coerceWith posixStringEv os
+
-- | Creates a UTF-8 encoded 'FastString' from a 'String'
mkFastString :: String -> FastString
{-# NOINLINE[1] mkFastString #-}
=====================================
compiler/GHC/Data/OsPath.hs
=====================================
@@ -8,6 +8,7 @@ module GHC.Data.OsPath
, unsafeDecodeUtf
, unsafeEncodeUtf
, os
+ , unOS
-- * Common utility functions
, (</>)
, (<.>)
@@ -28,13 +29,22 @@ import GHC.Prelude
import GHC.Utils.Misc (HasCallStack)
import GHC.Utils.Panic (panic)
+import Data.ByteString.Short (ShortByteString)
+import Data.Type.Coercion (coerceWith)
+import System.Directory.Internal (os)
+import System.Directory.OsPath (createDirectoryIfMissing, doesDirectoryExist, doesFileExist, getDirectoryContents)
import System.OsPath
import System.OsString (isSuffixOf)
-import System.Directory.OsPath (doesDirectoryExist, doesFileExist, getDirectoryContents, createDirectoryIfMissing)
-import System.Directory.Internal (os)
+import System.OsString.Internal.Types (coercionToPlatformTypes, unPS, unWS)
-- | Decode an 'OsPath' to 'FilePath', throwing an 'error' if decoding failed.
-- Prefer 'decodeUtf' and gracious error handling.
unsafeDecodeUtf :: HasCallStack => OsPath -> FilePath
unsafeDecodeUtf p =
either (\err -> panic $ "Failed to decodeUtf \"" ++ show p ++ "\", because: " ++ show err) id (decodeUtf p)
+
+-- | Extracts underlying 'ShortByteString' from the given 'OsString', taking care of platform specifics.
+unOS :: OsString -> ShortByteString
+unOS os = case coercionToPlatformTypes of
+ Left (_, windowsStringEv) -> unWS $ coerceWith windowsStringEv os
+ Right (_, posixStringEv) -> unPS $ coerceWith posixStringEv os
=====================================
compiler/GHC/Data/StringBuffer.hs
=====================================
@@ -21,6 +21,7 @@ module GHC.Data.StringBuffer
-- * Creation\/destruction
hGetStringBuffer,
hGetStringBufferBlock,
+ hGetStringBufferOsPath,
hPutStringBuffer,
appendStringBuffers,
stringToStringBuffer,
@@ -56,17 +57,19 @@ module GHC.Data.StringBuffer
import GHC.Prelude
import GHC.Data.FastString
+import GHC.Data.OsPath (OsPath)
+import GHC.Fingerprint
import GHC.Utils.Encoding
+import GHC.Utils.Exception (bracket_)
import GHC.Utils.IO.Unsafe
import GHC.Utils.Panic.Plain
-import GHC.Utils.Exception ( bracket_ )
-import GHC.Fingerprint
import Data.Maybe
+import GHC.IO.Encoding.Failure (CodingFailureMode (IgnoreCodingFailure))
+import GHC.IO.Encoding.UTF8 (mkUTF8)
+import System.File.OsPath qualified as FileIO
import System.IO
-import System.IO.Unsafe ( unsafePerformIO )
-import GHC.IO.Encoding.UTF8 ( mkUTF8 )
-import GHC.IO.Encoding.Failure ( CodingFailureMode(IgnoreCodingFailure) )
+import System.IO.Unsafe (unsafePerformIO)
import qualified Data.ByteString.Internal as BS
import qualified Data.ByteString as BS
@@ -111,6 +114,15 @@ instance Show StringBuffer where
hGetStringBuffer :: FilePath -> IO StringBuffer
hGetStringBuffer fname = do
h <- openBinaryFile fname ReadMode
+ hGetStringBufferHandle h
+
+hGetStringBufferOsPath :: OsPath -> IO StringBuffer
+hGetStringBufferOsPath fname = do
+ h <- FileIO.openBinaryFile fname ReadMode
+ hGetStringBufferHandle h
+
+hGetStringBufferHandle :: Handle -> IO StringBuffer
+hGetStringBufferHandle h = do
size_i <- hFileSize h
offset_i <- skipBOM h size_i 0 -- offset is 0 initially
let size = fromIntegral $ size_i - offset_i
=====================================
compiler/GHC/Stg/Debug.hs
=====================================
@@ -87,7 +87,7 @@ recordInfo :: Id -> StgExpr -> M ()
recordInfo bndr new_rhs = do
modLoc <- asks rModLocation
let
- thisFile = maybe nilFS mkFastString $ ml_hs_file modLoc
+ thisFile = maybe nilFS mkFastStringOsString $ ml_hs_file_ospath modLoc
-- A span from the ticks surrounding the new_rhs
best_span = quickSourcePos thisFile new_rhs
-- A back-up span if the bndr had a source position, many do not (think internally generated ids)
=====================================
compiler/GHC/Unit/Module/Location.hs
=====================================
@@ -2,31 +2,28 @@
{-# LANGUAGE ViewPatterns #-}
-- | Module location
module GHC.Unit.Module.Location
- ( ModLocation
- ( ..
- , ml_hs_file
- , ml_hi_file
- , ml_dyn_hi_file
- , ml_obj_file
- , ml_dyn_obj_file
- , ml_hie_file
- , ml_bytecode_file
- )
- , pattern ModLocation
+ ( ModLocation(..)
, addBootSuffix
, addBootSuffixLocn
, addBootSuffixLocnOut
, removeBootSuffix
, mkFileSrcSpan
+ , ml_hs_file
+ , ml_hi_file
+ , ml_dyn_hi_file
+ , ml_obj_file
+ , ml_dyn_obj_file
+ , ml_hie_file
+ , ml_bytecode_file
)
where
import GHC.Prelude
+import GHC.Data.FastString (mkFastStringOsString)
import GHC.Data.OsPath
import GHC.Types.SrcLoc
import GHC.Utils.Outputable
-import GHC.Data.FastString (mkFastString)
import qualified System.OsString as OsString
@@ -120,41 +117,31 @@ addBootSuffixLocnOut locn
-- | Compute a 'SrcSpan' from a 'ModLocation'.
mkFileSrcSpan :: ModLocation -> SrcSpan
mkFileSrcSpan mod_loc
- = case ml_hs_file mod_loc of
- Just file_path -> mkGeneralSrcSpan (mkFastString file_path)
+ = case ml_hs_file_ospath mod_loc of
+ Just file_path -> mkGeneralSrcSpan (mkFastStringOsString file_path)
Nothing -> interactiveSrcSpan -- Presumably
-- ----------------------------------------------------------------------------
-- Helpers for backwards compatibility
-- ----------------------------------------------------------------------------
-{-# COMPLETE ModLocation #-}
-
-pattern ModLocation :: Maybe FilePath -> FilePath -> FilePath -> FilePath -> FilePath -> FilePath -> FilePath -> ModLocation
-pattern ModLocation
- { ml_hs_file
- , ml_hi_file
- , ml_dyn_hi_file
- , ml_obj_file
- , ml_dyn_obj_file
- , ml_hie_file
- , ml_bytecode_file
- } <- OsPathModLocation
- { ml_hs_file_ospath = (fmap unsafeDecodeUtf -> ml_hs_file)
- , ml_hi_file_ospath = (unsafeDecodeUtf -> ml_hi_file)
- , ml_dyn_hi_file_ospath = (unsafeDecodeUtf -> ml_dyn_hi_file)
- , ml_obj_file_ospath = (unsafeDecodeUtf -> ml_obj_file)
- , ml_dyn_obj_file_ospath = (unsafeDecodeUtf -> ml_dyn_obj_file)
- , ml_hie_file_ospath = (unsafeDecodeUtf -> ml_hie_file)
- , ml_bytecode_file_ospath = (unsafeDecodeUtf -> ml_bytecode_file)
- } where
- ModLocation ml_hs_file ml_hi_file ml_dyn_hi_file ml_obj_file ml_dyn_obj_file ml_hie_file ml_bytecode_file
- = OsPathModLocation
- { ml_hs_file_ospath = fmap unsafeEncodeUtf ml_hs_file
- , ml_hi_file_ospath = unsafeEncodeUtf ml_hi_file
- , ml_dyn_hi_file_ospath = unsafeEncodeUtf ml_dyn_hi_file
- , ml_obj_file_ospath = unsafeEncodeUtf ml_obj_file
- , ml_dyn_obj_file_ospath = unsafeEncodeUtf ml_dyn_obj_file
- , ml_hie_file_ospath = unsafeEncodeUtf ml_hie_file
- , ml_bytecode_file_ospath = unsafeEncodeUtf ml_bytecode_file
- }
+ml_hs_file :: ModLocation -> Maybe FilePath
+ml_hs_file = fmap unsafeDecodeUtf . ml_hs_file_ospath
+
+ml_hi_file :: ModLocation -> FilePath
+ml_hi_file = unsafeDecodeUtf . ml_hi_file_ospath
+
+ml_dyn_hi_file :: ModLocation -> FilePath
+ml_dyn_hi_file = unsafeDecodeUtf . ml_dyn_hi_file_ospath
+
+ml_obj_file :: ModLocation -> FilePath
+ml_obj_file = unsafeDecodeUtf . ml_obj_file_ospath
+
+ml_dyn_obj_file :: ModLocation -> FilePath
+ml_dyn_obj_file = unsafeDecodeUtf . ml_dyn_obj_file_ospath
+
+ml_hie_file :: ModLocation -> FilePath
+ml_hie_file = unsafeDecodeUtf . ml_hie_file_ospath
+
+ml_bytecode_file :: ModLocation -> FilePath
+ml_bytecode_file = unsafeDecodeUtf . ml_bytecode_file_ospath
=====================================
compiler/GHC/Unit/Module/ModSummary.hs
=====================================
@@ -46,7 +46,7 @@ import GHC.Types.PkgQual
import GHC.Types.Basic
import GHC.Data.Maybe
-import GHC.Data.OsPath (OsPath)
+import GHC.Data.OsPath ( OsPath )
import GHC.Data.StringBuffer ( StringBuffer )
import GHC.Utils.Fingerprint
@@ -214,7 +214,7 @@ findTarget ms ts =
= ms_mod_name summary == m && ms_unitid summary == unitId
summary `matches` Target { targetId = TargetFile f _, targetUnitId = unitid }
| Just f' <- ml_hs_file (ms_location summary)
- = f == f' && ms_unitid summary == unitid
+ = f == f' && ms_unitid summary == unitid
_ `matches` _
= False
=====================================
compiler/ghc.cabal.in
=====================================
@@ -125,6 +125,7 @@ Library
containers >= 0.6.2.1 && < 0.9,
array >= 0.1 && < 0.6,
filepath >= 1.5 && < 1.6,
+ file-io >= 0.2.0 && < 0.3,
os-string >= 2.0.1 && < 2.1,
hpc >= 0.6 && < 0.8,
transformers >= 0.5 && < 0.7,
=====================================
testsuite/tests/ghc-api/fixed-nodes/FixedNodes.hs
=====================================
@@ -31,7 +31,7 @@ convertToFixed (ModuleNodeCompile ms) =
-- with the module summary information
let modName = ms_mod_name ms
modLoc = ms_location ms
- in ModuleNodeFixed (msKey ms) (ms_location ms) { ml_hs_file = Nothing}
+ in ModuleNodeFixed (msKey ms) (ms_location ms) { ml_hs_file_ospath = Nothing }
-- | Load a module graph and report the result
=====================================
testsuite/tests/ghc-api/fixed-nodes/ModuleGraphInvariants.hs
=====================================
@@ -29,7 +29,7 @@ convertToFixed :: ModuleNodeInfo -> ModuleNodeInfo
convertToFixed (ModuleNodeCompile ms) =
let modName = ms_mod_name ms
modLoc = ms_location ms
- in ModuleNodeFixed (msKey ms) (ms_location ms) { ml_hs_file = Nothing}
+ in ModuleNodeFixed (msKey ms) (ms_location ms) { ml_hs_file_ospath = Nothing }
-- | Test a module graph and report if it matches expected invariant violations
testModuleGraph :: String -> ModuleGraph -> [ModuleGraphInvariantError] -> Ghc ()
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/11bdc6adbcfcc610756a94df27c4543…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/11bdc6adbcfcc610756a94df27c4543…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/jeltsch/system-io-uncovering] Move `MonadFix IO` instance declaration to `base`
by Wolfgang Jeltsch (＠jeltsch) 24 Feb '26
by Wolfgang Jeltsch (＠jeltsch) 24 Feb '26
24 Feb '26
Wolfgang Jeltsch pushed to branch wip/jeltsch/system-io-uncovering at Glasgow Haskell Compiler / GHC
Commits:
17e88c3f by Wolfgang Jeltsch at 2026-02-24T17:19:22+02:00
Move `MonadFix IO` instance declaration to `base`
- - - - -
7 changed files:
- libraries/base/src/Control/Monad/Fix.hs
- libraries/base/src/Prelude.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad/Fix.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
Changes:
=====================================
libraries/base/src/Control/Monad/Fix.hs
=====================================
@@ -119,3 +119,9 @@ module Control.Monad.Fix
) where
import GHC.Internal.Control.Monad.Fix
+
+import GHC.Internal.System.IO
+
+-- | @since base-2.01
+instance MonadFix IO where
+ mfix = fixIO
=====================================
libraries/base/src/Prelude.hs
=====================================
@@ -183,3 +183,5 @@ import GHC.Internal.Num
import GHC.Internal.Real
import GHC.Internal.Float
import GHC.Internal.Show
+
+import Control.Monad.Fix ()
=====================================
libraries/ghc-internal/src/GHC/Internal/Control/Monad/Fix.hs
=====================================
@@ -39,7 +39,6 @@ import GHC.Internal.Base ( Monad, errorWithoutStackTrace, (.) )
import GHC.Internal.Generics
import GHC.Internal.List ( head, drop )
import GHC.Internal.Control.Monad.ST.Imp
-import GHC.Internal.System.IO
-- | Monads having fixed points with a \'knot-tying\' semantics.
-- Instances of 'MonadFix' should satisfy the following laws:
@@ -98,10 +97,6 @@ instance MonadFix NonEmpty where
neHead ~(a :| _) = a
neTail ~(_ :| as) = as
--- | @since base-2.01
-instance MonadFix IO where
- mfix = fixIO
-
-- | @since base-2.01
instance MonadFix ((->) r) where
mfix f = \ r -> let a = f a r in a
=====================================
testsuite/tests/interface-stability/base-exports.stdout
=====================================
@@ -11544,6 +11544,7 @@ instance forall (f :: * -> *). GHC.Internal.Control.Monad.Fail.MonadFail f => GH
instance GHC.Internal.Control.Monad.Fail.MonadFail GHC.Internal.Text.ParserCombinators.ReadP.P -- Defined in ‘GHC.Internal.Text.ParserCombinators.ReadP’
instance GHC.Internal.Control.Monad.Fail.MonadFail GHC.Internal.Text.ParserCombinators.ReadP.ReadP -- Defined in ‘GHC.Internal.Text.ParserCombinators.ReadP’
instance GHC.Internal.Control.Monad.Fail.MonadFail GHC.Internal.Text.ParserCombinators.ReadPrec.ReadPrec -- Defined in ‘GHC.Internal.Text.ParserCombinators.ReadPrec’
+instance [safe] GHC.Internal.Control.Monad.Fix.MonadFix GHC.Internal.Types.IO -- Defined in ‘Control.Monad.Fix’
instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Control.Monad.Fix.MonadFix f, GHC.Internal.Control.Monad.Fix.MonadFix g) => GHC.Internal.Control.Monad.Fix.MonadFix (f GHC.Internal.Generics.:*: g) -- Defined in ‘GHC.Internal.Control.Monad.Fix’
instance forall (f :: * -> *). GHC.Internal.Control.Monad.Fix.MonadFix f => GHC.Internal.Control.Monad.Fix.MonadFix (GHC.Internal.Data.Semigroup.Internal.Alt f) -- Defined in ‘GHC.Internal.Control.Monad.Fix’
instance forall (f :: * -> *). GHC.Internal.Control.Monad.Fix.MonadFix f => GHC.Internal.Control.Monad.Fix.MonadFix (GHC.Internal.Data.Monoid.Ap f) -- Defined in ‘GHC.Internal.Control.Monad.Fix’
@@ -11552,7 +11553,6 @@ instance GHC.Internal.Control.Monad.Fix.MonadFix GHC.Internal.Data.Semigroup.Int
instance forall e. GHC.Internal.Control.Monad.Fix.MonadFix (GHC.Internal.Data.Either.Either e) -- Defined in ‘GHC.Internal.Control.Monad.Fix’
instance forall r. GHC.Internal.Control.Monad.Fix.MonadFix ((->) r) -- Defined in ‘GHC.Internal.Control.Monad.Fix’
instance GHC.Internal.Control.Monad.Fix.MonadFix GHC.Internal.Data.Monoid.First -- Defined in ‘GHC.Internal.Control.Monad.Fix’
-instance GHC.Internal.Control.Monad.Fix.MonadFix GHC.Internal.Types.IO -- Defined in ‘GHC.Internal.Control.Monad.Fix’
instance GHC.Internal.Control.Monad.Fix.MonadFix GHC.Internal.Data.Monoid.Last -- Defined in ‘GHC.Internal.Control.Monad.Fix’
instance GHC.Internal.Control.Monad.Fix.MonadFix [] -- Defined in ‘GHC.Internal.Control.Monad.Fix’
instance forall (f :: * -> *) i (c :: GHC.Internal.Generics.Meta). GHC.Internal.Control.Monad.Fix.MonadFix f => GHC.Internal.Control.Monad.Fix.MonadFix (GHC.Internal.Generics.M1 i c f) -- Defined in ‘GHC.Internal.Control.Monad.Fix’
=====================================
testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
=====================================
@@ -11571,6 +11571,7 @@ instance forall (f :: * -> *). GHC.Internal.Control.Monad.Fail.MonadFail f => GH
instance GHC.Internal.Control.Monad.Fail.MonadFail GHC.Internal.Text.ParserCombinators.ReadP.P -- Defined in ‘GHC.Internal.Text.ParserCombinators.ReadP’
instance GHC.Internal.Control.Monad.Fail.MonadFail GHC.Internal.Text.ParserCombinators.ReadP.ReadP -- Defined in ‘GHC.Internal.Text.ParserCombinators.ReadP’
instance GHC.Internal.Control.Monad.Fail.MonadFail GHC.Internal.Text.ParserCombinators.ReadPrec.ReadPrec -- Defined in ‘GHC.Internal.Text.ParserCombinators.ReadPrec’
+instance [safe] GHC.Internal.Control.Monad.Fix.MonadFix GHC.Internal.Types.IO -- Defined in ‘Control.Monad.Fix’
instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Control.Monad.Fix.MonadFix f, GHC.Internal.Control.Monad.Fix.MonadFix g) => GHC.Internal.Control.Monad.Fix.MonadFix (f GHC.Internal.Generics.:*: g) -- Defined in ‘GHC.Internal.Control.Monad.Fix’
instance forall (f :: * -> *). GHC.Internal.Control.Monad.Fix.MonadFix f => GHC.Internal.Control.Monad.Fix.MonadFix (GHC.Internal.Data.Semigroup.Internal.Alt f) -- Defined in ‘GHC.Internal.Control.Monad.Fix’
instance forall (f :: * -> *). GHC.Internal.Control.Monad.Fix.MonadFix f => GHC.Internal.Control.Monad.Fix.MonadFix (GHC.Internal.Data.Monoid.Ap f) -- Defined in ‘GHC.Internal.Control.Monad.Fix’
@@ -11579,7 +11580,6 @@ instance GHC.Internal.Control.Monad.Fix.MonadFix GHC.Internal.Data.Semigroup.Int
instance forall e. GHC.Internal.Control.Monad.Fix.MonadFix (GHC.Internal.Data.Either.Either e) -- Defined in ‘GHC.Internal.Control.Monad.Fix’
instance forall r. GHC.Internal.Control.Monad.Fix.MonadFix ((->) r) -- Defined in ‘GHC.Internal.Control.Monad.Fix’
instance GHC.Internal.Control.Monad.Fix.MonadFix GHC.Internal.Data.Monoid.First -- Defined in ‘GHC.Internal.Control.Monad.Fix’
-instance GHC.Internal.Control.Monad.Fix.MonadFix GHC.Internal.Types.IO -- Defined in ‘GHC.Internal.Control.Monad.Fix’
instance GHC.Internal.Control.Monad.Fix.MonadFix GHC.Internal.Data.Monoid.Last -- Defined in ‘GHC.Internal.Control.Monad.Fix’
instance GHC.Internal.Control.Monad.Fix.MonadFix [] -- Defined in ‘GHC.Internal.Control.Monad.Fix’
instance forall (f :: * -> *) i (c :: GHC.Internal.Generics.Meta). GHC.Internal.Control.Monad.Fix.MonadFix f => GHC.Internal.Control.Monad.Fix.MonadFix (GHC.Internal.Generics.M1 i c f) -- Defined in ‘GHC.Internal.Control.Monad.Fix’
=====================================
testsuite/tests/interface-stability/base-exports.stdout-mingw32
=====================================
@@ -11802,6 +11802,7 @@ instance forall (f :: * -> *). GHC.Internal.Control.Monad.Fail.MonadFail f => GH
instance GHC.Internal.Control.Monad.Fail.MonadFail GHC.Internal.Text.ParserCombinators.ReadP.P -- Defined in ‘GHC.Internal.Text.ParserCombinators.ReadP’
instance GHC.Internal.Control.Monad.Fail.MonadFail GHC.Internal.Text.ParserCombinators.ReadP.ReadP -- Defined in ‘GHC.Internal.Text.ParserCombinators.ReadP’
instance GHC.Internal.Control.Monad.Fail.MonadFail GHC.Internal.Text.ParserCombinators.ReadPrec.ReadPrec -- Defined in ‘GHC.Internal.Text.ParserCombinators.ReadPrec’
+instance [safe] GHC.Internal.Control.Monad.Fix.MonadFix GHC.Internal.Types.IO -- Defined in ‘Control.Monad.Fix’
instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Control.Monad.Fix.MonadFix f, GHC.Internal.Control.Monad.Fix.MonadFix g) => GHC.Internal.Control.Monad.Fix.MonadFix (f GHC.Internal.Generics.:*: g) -- Defined in ‘GHC.Internal.Control.Monad.Fix’
instance forall (f :: * -> *). GHC.Internal.Control.Monad.Fix.MonadFix f => GHC.Internal.Control.Monad.Fix.MonadFix (GHC.Internal.Data.Semigroup.Internal.Alt f) -- Defined in ‘GHC.Internal.Control.Monad.Fix’
instance forall (f :: * -> *). GHC.Internal.Control.Monad.Fix.MonadFix f => GHC.Internal.Control.Monad.Fix.MonadFix (GHC.Internal.Data.Monoid.Ap f) -- Defined in ‘GHC.Internal.Control.Monad.Fix’
@@ -11810,7 +11811,6 @@ instance GHC.Internal.Control.Monad.Fix.MonadFix GHC.Internal.Data.Semigroup.Int
instance forall e. GHC.Internal.Control.Monad.Fix.MonadFix (GHC.Internal.Data.Either.Either e) -- Defined in ‘GHC.Internal.Control.Monad.Fix’
instance forall r. GHC.Internal.Control.Monad.Fix.MonadFix ((->) r) -- Defined in ‘GHC.Internal.Control.Monad.Fix’
instance GHC.Internal.Control.Monad.Fix.MonadFix GHC.Internal.Data.Monoid.First -- Defined in ‘GHC.Internal.Control.Monad.Fix’
-instance GHC.Internal.Control.Monad.Fix.MonadFix GHC.Internal.Types.IO -- Defined in ‘GHC.Internal.Control.Monad.Fix’
instance GHC.Internal.Control.Monad.Fix.MonadFix GHC.Internal.Data.Monoid.Last -- Defined in ‘GHC.Internal.Control.Monad.Fix’
instance GHC.Internal.Control.Monad.Fix.MonadFix [] -- Defined in ‘GHC.Internal.Control.Monad.Fix’
instance forall (f :: * -> *) i (c :: GHC.Internal.Generics.Meta). GHC.Internal.Control.Monad.Fix.MonadFix f => GHC.Internal.Control.Monad.Fix.MonadFix (GHC.Internal.Generics.M1 i c f) -- Defined in ‘GHC.Internal.Control.Monad.Fix’
=====================================
testsuite/tests/interface-stability/base-exports.stdout-ws-32
=====================================
@@ -11544,6 +11544,7 @@ instance forall (f :: * -> *). GHC.Internal.Control.Monad.Fail.MonadFail f => GH
instance GHC.Internal.Control.Monad.Fail.MonadFail GHC.Internal.Text.ParserCombinators.ReadP.P -- Defined in ‘GHC.Internal.Text.ParserCombinators.ReadP’
instance GHC.Internal.Control.Monad.Fail.MonadFail GHC.Internal.Text.ParserCombinators.ReadP.ReadP -- Defined in ‘GHC.Internal.Text.ParserCombinators.ReadP’
instance GHC.Internal.Control.Monad.Fail.MonadFail GHC.Internal.Text.ParserCombinators.ReadPrec.ReadPrec -- Defined in ‘GHC.Internal.Text.ParserCombinators.ReadPrec’
+instance [safe] GHC.Internal.Control.Monad.Fix.MonadFix GHC.Internal.Types.IO -- Defined in ‘Control.Monad.Fix’
instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Control.Monad.Fix.MonadFix f, GHC.Internal.Control.Monad.Fix.MonadFix g) => GHC.Internal.Control.Monad.Fix.MonadFix (f GHC.Internal.Generics.:*: g) -- Defined in ‘GHC.Internal.Control.Monad.Fix’
instance forall (f :: * -> *). GHC.Internal.Control.Monad.Fix.MonadFix f => GHC.Internal.Control.Monad.Fix.MonadFix (GHC.Internal.Data.Semigroup.Internal.Alt f) -- Defined in ‘GHC.Internal.Control.Monad.Fix’
instance forall (f :: * -> *). GHC.Internal.Control.Monad.Fix.MonadFix f => GHC.Internal.Control.Monad.Fix.MonadFix (GHC.Internal.Data.Monoid.Ap f) -- Defined in ‘GHC.Internal.Control.Monad.Fix’
@@ -11552,7 +11553,6 @@ instance GHC.Internal.Control.Monad.Fix.MonadFix GHC.Internal.Data.Semigroup.Int
instance forall e. GHC.Internal.Control.Monad.Fix.MonadFix (GHC.Internal.Data.Either.Either e) -- Defined in ‘GHC.Internal.Control.Monad.Fix’
instance forall r. GHC.Internal.Control.Monad.Fix.MonadFix ((->) r) -- Defined in ‘GHC.Internal.Control.Monad.Fix’
instance GHC.Internal.Control.Monad.Fix.MonadFix GHC.Internal.Data.Monoid.First -- Defined in ‘GHC.Internal.Control.Monad.Fix’
-instance GHC.Internal.Control.Monad.Fix.MonadFix GHC.Internal.Types.IO -- Defined in ‘GHC.Internal.Control.Monad.Fix’
instance GHC.Internal.Control.Monad.Fix.MonadFix GHC.Internal.Data.Monoid.Last -- Defined in ‘GHC.Internal.Control.Monad.Fix’
instance GHC.Internal.Control.Monad.Fix.MonadFix [] -- Defined in ‘GHC.Internal.Control.Monad.Fix’
instance forall (f :: * -> *) i (c :: GHC.Internal.Generics.Meta). GHC.Internal.Control.Monad.Fix.MonadFix f => GHC.Internal.Control.Monad.Fix.MonadFix (GHC.Internal.Generics.M1 i c f) -- Defined in ‘GHC.Internal.Control.Monad.Fix’
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/17e88c3f45471ac25c8adcde7f19e3b…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/17e88c3f45471ac25c8adcde7f19e3b…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/jeltsch/system-io-uncovering] Move `MonadFix IO` instance declaration to `base`
by Wolfgang Jeltsch (＠jeltsch) 24 Feb '26
by Wolfgang Jeltsch (＠jeltsch) 24 Feb '26
24 Feb '26
Wolfgang Jeltsch pushed to branch wip/jeltsch/system-io-uncovering at Glasgow Haskell Compiler / GHC
Commits:
f59b6261 by Wolfgang Jeltsch at 2026-02-24T16:47:45+02:00
Move `MonadFix IO` instance declaration to `base`
- - - - -
6 changed files:
- libraries/base/src/Control/Monad/Fix.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad/Fix.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
Changes:
=====================================
libraries/base/src/Control/Monad/Fix.hs
=====================================
@@ -119,3 +119,9 @@ module Control.Monad.Fix
) where
import GHC.Internal.Control.Monad.Fix
+
+import GHC.Internal.System.IO
+
+-- | @since base-2.01
+instance MonadFix IO where
+ mfix = fixIO
=====================================
libraries/ghc-internal/src/GHC/Internal/Control/Monad/Fix.hs
=====================================
@@ -39,7 +39,6 @@ import GHC.Internal.Base ( Monad, errorWithoutStackTrace, (.) )
import GHC.Internal.Generics
import GHC.Internal.List ( head, drop )
import GHC.Internal.Control.Monad.ST.Imp
-import GHC.Internal.System.IO
-- | Monads having fixed points with a \'knot-tying\' semantics.
-- Instances of 'MonadFix' should satisfy the following laws:
@@ -98,10 +97,6 @@ instance MonadFix NonEmpty where
neHead ~(a :| _) = a
neTail ~(_ :| as) = as
--- | @since base-2.01
-instance MonadFix IO where
- mfix = fixIO
-
-- | @since base-2.01
instance MonadFix ((->) r) where
mfix f = \ r -> let a = f a r in a
=====================================
testsuite/tests/interface-stability/base-exports.stdout
=====================================
@@ -11544,6 +11544,7 @@ instance forall (f :: * -> *). GHC.Internal.Control.Monad.Fail.MonadFail f => GH
instance GHC.Internal.Control.Monad.Fail.MonadFail GHC.Internal.Text.ParserCombinators.ReadP.P -- Defined in ‘GHC.Internal.Text.ParserCombinators.ReadP’
instance GHC.Internal.Control.Monad.Fail.MonadFail GHC.Internal.Text.ParserCombinators.ReadP.ReadP -- Defined in ‘GHC.Internal.Text.ParserCombinators.ReadP’
instance GHC.Internal.Control.Monad.Fail.MonadFail GHC.Internal.Text.ParserCombinators.ReadPrec.ReadPrec -- Defined in ‘GHC.Internal.Text.ParserCombinators.ReadPrec’
+instance [safe] GHC.Internal.Control.Monad.Fix.MonadFix GHC.Internal.Types.IO -- Defined in ‘Control.Monad.Fix’
instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Control.Monad.Fix.MonadFix f, GHC.Internal.Control.Monad.Fix.MonadFix g) => GHC.Internal.Control.Monad.Fix.MonadFix (f GHC.Internal.Generics.:*: g) -- Defined in ‘GHC.Internal.Control.Monad.Fix’
instance forall (f :: * -> *). GHC.Internal.Control.Monad.Fix.MonadFix f => GHC.Internal.Control.Monad.Fix.MonadFix (GHC.Internal.Data.Semigroup.Internal.Alt f) -- Defined in ‘GHC.Internal.Control.Monad.Fix’
instance forall (f :: * -> *). GHC.Internal.Control.Monad.Fix.MonadFix f => GHC.Internal.Control.Monad.Fix.MonadFix (GHC.Internal.Data.Monoid.Ap f) -- Defined in ‘GHC.Internal.Control.Monad.Fix’
@@ -11552,7 +11553,6 @@ instance GHC.Internal.Control.Monad.Fix.MonadFix GHC.Internal.Data.Semigroup.Int
instance forall e. GHC.Internal.Control.Monad.Fix.MonadFix (GHC.Internal.Data.Either.Either e) -- Defined in ‘GHC.Internal.Control.Monad.Fix’
instance forall r. GHC.Internal.Control.Monad.Fix.MonadFix ((->) r) -- Defined in ‘GHC.Internal.Control.Monad.Fix’
instance GHC.Internal.Control.Monad.Fix.MonadFix GHC.Internal.Data.Monoid.First -- Defined in ‘GHC.Internal.Control.Monad.Fix’
-instance GHC.Internal.Control.Monad.Fix.MonadFix GHC.Internal.Types.IO -- Defined in ‘GHC.Internal.Control.Monad.Fix’
instance GHC.Internal.Control.Monad.Fix.MonadFix GHC.Internal.Data.Monoid.Last -- Defined in ‘GHC.Internal.Control.Monad.Fix’
instance GHC.Internal.Control.Monad.Fix.MonadFix [] -- Defined in ‘GHC.Internal.Control.Monad.Fix’
instance forall (f :: * -> *) i (c :: GHC.Internal.Generics.Meta). GHC.Internal.Control.Monad.Fix.MonadFix f => GHC.Internal.Control.Monad.Fix.MonadFix (GHC.Internal.Generics.M1 i c f) -- Defined in ‘GHC.Internal.Control.Monad.Fix’
=====================================
testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
=====================================
@@ -11571,6 +11571,7 @@ instance forall (f :: * -> *). GHC.Internal.Control.Monad.Fail.MonadFail f => GH
instance GHC.Internal.Control.Monad.Fail.MonadFail GHC.Internal.Text.ParserCombinators.ReadP.P -- Defined in ‘GHC.Internal.Text.ParserCombinators.ReadP’
instance GHC.Internal.Control.Monad.Fail.MonadFail GHC.Internal.Text.ParserCombinators.ReadP.ReadP -- Defined in ‘GHC.Internal.Text.ParserCombinators.ReadP’
instance GHC.Internal.Control.Monad.Fail.MonadFail GHC.Internal.Text.ParserCombinators.ReadPrec.ReadPrec -- Defined in ‘GHC.Internal.Text.ParserCombinators.ReadPrec’
+instance [safe] GHC.Internal.Control.Monad.Fix.MonadFix GHC.Internal.Types.IO -- Defined in ‘Control.Monad.Fix’
instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Control.Monad.Fix.MonadFix f, GHC.Internal.Control.Monad.Fix.MonadFix g) => GHC.Internal.Control.Monad.Fix.MonadFix (f GHC.Internal.Generics.:*: g) -- Defined in ‘GHC.Internal.Control.Monad.Fix’
instance forall (f :: * -> *). GHC.Internal.Control.Monad.Fix.MonadFix f => GHC.Internal.Control.Monad.Fix.MonadFix (GHC.Internal.Data.Semigroup.Internal.Alt f) -- Defined in ‘GHC.Internal.Control.Monad.Fix’
instance forall (f :: * -> *). GHC.Internal.Control.Monad.Fix.MonadFix f => GHC.Internal.Control.Monad.Fix.MonadFix (GHC.Internal.Data.Monoid.Ap f) -- Defined in ‘GHC.Internal.Control.Monad.Fix’
@@ -11579,7 +11580,6 @@ instance GHC.Internal.Control.Monad.Fix.MonadFix GHC.Internal.Data.Semigroup.Int
instance forall e. GHC.Internal.Control.Monad.Fix.MonadFix (GHC.Internal.Data.Either.Either e) -- Defined in ‘GHC.Internal.Control.Monad.Fix’
instance forall r. GHC.Internal.Control.Monad.Fix.MonadFix ((->) r) -- Defined in ‘GHC.Internal.Control.Monad.Fix’
instance GHC.Internal.Control.Monad.Fix.MonadFix GHC.Internal.Data.Monoid.First -- Defined in ‘GHC.Internal.Control.Monad.Fix’
-instance GHC.Internal.Control.Monad.Fix.MonadFix GHC.Internal.Types.IO -- Defined in ‘GHC.Internal.Control.Monad.Fix’
instance GHC.Internal.Control.Monad.Fix.MonadFix GHC.Internal.Data.Monoid.Last -- Defined in ‘GHC.Internal.Control.Monad.Fix’
instance GHC.Internal.Control.Monad.Fix.MonadFix [] -- Defined in ‘GHC.Internal.Control.Monad.Fix’
instance forall (f :: * -> *) i (c :: GHC.Internal.Generics.Meta). GHC.Internal.Control.Monad.Fix.MonadFix f => GHC.Internal.Control.Monad.Fix.MonadFix (GHC.Internal.Generics.M1 i c f) -- Defined in ‘GHC.Internal.Control.Monad.Fix’
=====================================
testsuite/tests/interface-stability/base-exports.stdout-mingw32
=====================================
@@ -11802,6 +11802,7 @@ instance forall (f :: * -> *). GHC.Internal.Control.Monad.Fail.MonadFail f => GH
instance GHC.Internal.Control.Monad.Fail.MonadFail GHC.Internal.Text.ParserCombinators.ReadP.P -- Defined in ‘GHC.Internal.Text.ParserCombinators.ReadP’
instance GHC.Internal.Control.Monad.Fail.MonadFail GHC.Internal.Text.ParserCombinators.ReadP.ReadP -- Defined in ‘GHC.Internal.Text.ParserCombinators.ReadP’
instance GHC.Internal.Control.Monad.Fail.MonadFail GHC.Internal.Text.ParserCombinators.ReadPrec.ReadPrec -- Defined in ‘GHC.Internal.Text.ParserCombinators.ReadPrec’
+instance [safe] GHC.Internal.Control.Monad.Fix.MonadFix GHC.Internal.Types.IO -- Defined in ‘Control.Monad.Fix’
instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Control.Monad.Fix.MonadFix f, GHC.Internal.Control.Monad.Fix.MonadFix g) => GHC.Internal.Control.Monad.Fix.MonadFix (f GHC.Internal.Generics.:*: g) -- Defined in ‘GHC.Internal.Control.Monad.Fix’
instance forall (f :: * -> *). GHC.Internal.Control.Monad.Fix.MonadFix f => GHC.Internal.Control.Monad.Fix.MonadFix (GHC.Internal.Data.Semigroup.Internal.Alt f) -- Defined in ‘GHC.Internal.Control.Monad.Fix’
instance forall (f :: * -> *). GHC.Internal.Control.Monad.Fix.MonadFix f => GHC.Internal.Control.Monad.Fix.MonadFix (GHC.Internal.Data.Monoid.Ap f) -- Defined in ‘GHC.Internal.Control.Monad.Fix’
@@ -11810,7 +11811,6 @@ instance GHC.Internal.Control.Monad.Fix.MonadFix GHC.Internal.Data.Semigroup.Int
instance forall e. GHC.Internal.Control.Monad.Fix.MonadFix (GHC.Internal.Data.Either.Either e) -- Defined in ‘GHC.Internal.Control.Monad.Fix’
instance forall r. GHC.Internal.Control.Monad.Fix.MonadFix ((->) r) -- Defined in ‘GHC.Internal.Control.Monad.Fix’
instance GHC.Internal.Control.Monad.Fix.MonadFix GHC.Internal.Data.Monoid.First -- Defined in ‘GHC.Internal.Control.Monad.Fix’
-instance GHC.Internal.Control.Monad.Fix.MonadFix GHC.Internal.Types.IO -- Defined in ‘GHC.Internal.Control.Monad.Fix’
instance GHC.Internal.Control.Monad.Fix.MonadFix GHC.Internal.Data.Monoid.Last -- Defined in ‘GHC.Internal.Control.Monad.Fix’
instance GHC.Internal.Control.Monad.Fix.MonadFix [] -- Defined in ‘GHC.Internal.Control.Monad.Fix’
instance forall (f :: * -> *) i (c :: GHC.Internal.Generics.Meta). GHC.Internal.Control.Monad.Fix.MonadFix f => GHC.Internal.Control.Monad.Fix.MonadFix (GHC.Internal.Generics.M1 i c f) -- Defined in ‘GHC.Internal.Control.Monad.Fix’
=====================================
testsuite/tests/interface-stability/base-exports.stdout-ws-32
=====================================
@@ -11544,6 +11544,7 @@ instance forall (f :: * -> *). GHC.Internal.Control.Monad.Fail.MonadFail f => GH
instance GHC.Internal.Control.Monad.Fail.MonadFail GHC.Internal.Text.ParserCombinators.ReadP.P -- Defined in ‘GHC.Internal.Text.ParserCombinators.ReadP’
instance GHC.Internal.Control.Monad.Fail.MonadFail GHC.Internal.Text.ParserCombinators.ReadP.ReadP -- Defined in ‘GHC.Internal.Text.ParserCombinators.ReadP’
instance GHC.Internal.Control.Monad.Fail.MonadFail GHC.Internal.Text.ParserCombinators.ReadPrec.ReadPrec -- Defined in ‘GHC.Internal.Text.ParserCombinators.ReadPrec’
+instance [safe] GHC.Internal.Control.Monad.Fix.MonadFix GHC.Internal.Types.IO -- Defined in ‘Control.Monad.Fix’
instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Control.Monad.Fix.MonadFix f, GHC.Internal.Control.Monad.Fix.MonadFix g) => GHC.Internal.Control.Monad.Fix.MonadFix (f GHC.Internal.Generics.:*: g) -- Defined in ‘GHC.Internal.Control.Monad.Fix’
instance forall (f :: * -> *). GHC.Internal.Control.Monad.Fix.MonadFix f => GHC.Internal.Control.Monad.Fix.MonadFix (GHC.Internal.Data.Semigroup.Internal.Alt f) -- Defined in ‘GHC.Internal.Control.Monad.Fix’
instance forall (f :: * -> *). GHC.Internal.Control.Monad.Fix.MonadFix f => GHC.Internal.Control.Monad.Fix.MonadFix (GHC.Internal.Data.Monoid.Ap f) -- Defined in ‘GHC.Internal.Control.Monad.Fix’
@@ -11552,7 +11553,6 @@ instance GHC.Internal.Control.Monad.Fix.MonadFix GHC.Internal.Data.Semigroup.Int
instance forall e. GHC.Internal.Control.Monad.Fix.MonadFix (GHC.Internal.Data.Either.Either e) -- Defined in ‘GHC.Internal.Control.Monad.Fix’
instance forall r. GHC.Internal.Control.Monad.Fix.MonadFix ((->) r) -- Defined in ‘GHC.Internal.Control.Monad.Fix’
instance GHC.Internal.Control.Monad.Fix.MonadFix GHC.Internal.Data.Monoid.First -- Defined in ‘GHC.Internal.Control.Monad.Fix’
-instance GHC.Internal.Control.Monad.Fix.MonadFix GHC.Internal.Types.IO -- Defined in ‘GHC.Internal.Control.Monad.Fix’
instance GHC.Internal.Control.Monad.Fix.MonadFix GHC.Internal.Data.Monoid.Last -- Defined in ‘GHC.Internal.Control.Monad.Fix’
instance GHC.Internal.Control.Monad.Fix.MonadFix [] -- Defined in ‘GHC.Internal.Control.Monad.Fix’
instance forall (f :: * -> *) i (c :: GHC.Internal.Generics.Meta). GHC.Internal.Control.Monad.Fix.MonadFix f => GHC.Internal.Control.Monad.Fix.MonadFix (GHC.Internal.Generics.M1 i c f) -- Defined in ‘GHC.Internal.Control.Monad.Fix’
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f59b62611d826b0b1cdc396a9b349a8…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f59b62611d826b0b1cdc396a9b349a8…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/jeltsch/system-io-uncovering] 2 commits: Move some `IsString` instance declarations to `base`
by Wolfgang Jeltsch (＠jeltsch) 24 Feb '26
by Wolfgang Jeltsch (＠jeltsch) 24 Feb '26
24 Feb '26
Wolfgang Jeltsch pushed to branch wip/jeltsch/system-io-uncovering at Glasgow Haskell Compiler / GHC
Commits:
a477e479 by Wolfgang Jeltsch at 2026-02-24T16:21:54+02:00
Move some `IsString` instance declarations to `base`
- - - - -
9400aefa by Wolfgang Jeltsch at 2026-02-24T16:23:05+02:00
Move `* -> *` `Heap.Closure` instances into `ghc-heap`
- - - - -
12 changed files:
- libraries/base/src/Data/String.hs
- libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
- libraries/ghc-internal/src/GHC/Internal/Data/String.hs
- libraries/ghc-internal/src/GHC/Internal/Heap/Closures.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/interface-stability/ghc-experimental-exports.stdout
- testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32
- testsuite/tests/plugins/plugins10.stdout
- testsuite/tests/typecheck/should_fail/T12921.stderr
Changes:
=====================================
libraries/base/src/Data/String.hs
=====================================
@@ -1,4 +1,8 @@
-{-# LANGUAGE Safe #-}
+{-# LANGUAGE Trustworthy #-}
+
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE StandaloneDeriving #-}
-- |
--
@@ -23,4 +27,13 @@ module Data.String
unwords
) where
-import GHC.Internal.Data.String
\ No newline at end of file
+import GHC.Internal.Data.String
+
+import GHC.Internal.Data.Functor.Const (Const (Const))
+import GHC.Internal.Data.Functor.Identity (Identity (Identity))
+
+-- | @since base-4.9.0.0
+deriving instance IsString a => IsString (Const a (b :: k))
+
+-- | @since base-4.9.0.0
+deriving instance IsString a => IsString (Identity a)
=====================================
libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
=====================================
@@ -1,10 +1,5 @@
{-# LANGUAGE CPP #-}
-{-# LANGUAGE ForeignFunctionInterface #-}
-{-# LANGUAGE GHCForeignImportPrim #-}
-{-# LANGUAGE MagicHash #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE UnliftedFFITypes #-}
-{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DeriveTraversable #-}
-- Late cost centres introduce a thunk in the asBox function, which leads to
-- an additional wrapper being added to any value placed inside a box.
@@ -42,3 +37,23 @@ module GHC.Exts.Heap.Closures (
) where
import GHC.Internal.Heap.Closures
+
+import GHC.Internal.Data.Functor
+import GHC.Internal.Data.Foldable
+import GHC.Internal.Data.Traversable
+
+deriving instance Functor GenClosure
+deriving instance Foldable GenClosure
+deriving instance Traversable GenClosure
+
+deriving instance Functor GenStgStackClosure
+deriving instance Foldable GenStgStackClosure
+deriving instance Traversable GenStgStackClosure
+
+deriving instance Functor GenStackField
+deriving instance Foldable GenStackField
+deriving instance Traversable GenStackField
+
+deriving instance Functor GenStackFrame
+deriving instance Foldable GenStackFrame
+deriving instance Traversable GenStackFrame
=====================================
libraries/ghc-internal/src/GHC/Internal/Data/String.hs
=====================================
@@ -1,8 +1,5 @@
{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE PolyKinds #-}
-{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
@@ -33,8 +30,6 @@ module GHC.Internal.Data.String (
) where
import GHC.Internal.Base
-import GHC.Internal.Data.Functor.Const (Const (Const))
-import GHC.Internal.Data.Functor.Identity (Identity (Identity))
import GHC.Internal.Data.List (lines, words, unlines, unwords)
-- | `IsString` is used in combination with the @-XOverloadedStrings@
@@ -105,9 +100,3 @@ ensure the good behavior of the above example remains in the future.
instance (a ~ Char) => IsString [a] where
-- See Note [IsString String]
fromString xs = xs
-
--- | @since base-4.9.0.0
-deriving instance IsString a => IsString (Const a (b :: k))
-
--- | @since base-4.9.0.0
-deriving instance IsString a => IsString (Identity a)
=====================================
libraries/ghc-internal/src/GHC/Internal/Heap/Closures.hs
=====================================
@@ -5,7 +5,6 @@
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE UnliftedFFITypes #-}
{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveTraversable #-}
-- Late cost centres introduce a thunk in the asBox function, which leads to
-- an additional wrapper being added to any value placed inside a box.
-- This can be removed once our boot compiler is no longer affected by #25212
@@ -69,8 +68,7 @@ in the profiling way. (#15197)
import GHC.Internal.Heap.ProfInfo.Types
import GHC.Internal.Data.Bits
-import GHC.Internal.Data.Foldable (Foldable, toList)
-import GHC.Internal.Data.Traversable (Traversable)
+import GHC.Internal.Data.Foldable (toList)
import GHC.Internal.Int
import GHC.Internal.Num
import GHC.Internal.Real
@@ -383,7 +381,7 @@ data GenClosure b
-- or an Int#).
| UnknownTypeWordSizedPrimitive
{ wordVal :: !Word }
- deriving (Show, Generic, Functor, Foldable, Traversable)
+ deriving (Show, Generic)
-- | Get the info table for a heap closure, or Nothing for a prim value
--
@@ -500,7 +498,7 @@ data GenStgStackClosure b = GenStgStackClosure
, ssc_stack_size :: !Word32 -- ^ stack size in *words*
, ssc_stack :: ![GenStackFrame b]
}
- deriving (Foldable, Functor, Generic, Show, Traversable)
+ deriving (Generic, Show)
type StackField = GenStackField Box
@@ -510,7 +508,7 @@ data GenStackField b
= StackWord !Word
-- | A pointer field
| StackBox !b
- deriving (Foldable, Functor, Generic, Show, Traversable)
+ deriving (Generic, Show)
type StackFrame = GenStackFrame Box
@@ -579,7 +577,7 @@ data GenStackFrame b =
{ info_tbl :: !StgInfoTable
, annotation :: !b
}
- deriving (Foldable, Functor, Generic, Show, Traversable)
+ deriving (Generic, Show)
data PrimType
= PInt
=====================================
testsuite/tests/interface-stability/base-exports.stdout
=====================================
@@ -1673,7 +1673,7 @@ module Data.Semigroup where
stimesMonoid :: forall b a. (GHC.Internal.Real.Integral b, GHC.Internal.Base.Monoid a) => b -> a -> a
module Data.String where
- -- Safety: Safe
+ -- Safety: Trustworthy
type IsString :: * -> Constraint
class IsString a where
fromString :: String -> a
@@ -11778,8 +11778,8 @@ instance GHC.Internal.Data.Foldable.Foldable Data.Semigroup.First -- Defined in
instance GHC.Internal.Data.Foldable.Foldable Data.Semigroup.Last -- Defined in ‘Data.Semigroup’
instance GHC.Internal.Data.Foldable.Foldable Data.Semigroup.Max -- Defined in ‘Data.Semigroup’
instance GHC.Internal.Data.Foldable.Foldable Data.Semigroup.Min -- Defined in ‘Data.Semigroup’
-instance forall a k (b :: k). GHC.Internal.Data.String.IsString a => GHC.Internal.Data.String.IsString (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.String’
-instance forall a. GHC.Internal.Data.String.IsString a => GHC.Internal.Data.String.IsString (GHC.Internal.Data.Functor.Identity.Identity a) -- Defined in ‘GHC.Internal.Data.String’
+instance forall a k (b :: k). GHC.Internal.Data.String.IsString a => GHC.Internal.Data.String.IsString (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘Data.String’
+instance forall a. GHC.Internal.Data.String.IsString a => GHC.Internal.Data.String.IsString (GHC.Internal.Data.Functor.Identity.Identity a) -- Defined in ‘Data.String’
instance forall a. (a ~ GHC.Internal.Types.Char) => GHC.Internal.Data.String.IsString [a] -- Defined in ‘GHC.Internal.Data.String’
instance GHC.Internal.Data.Traversable.Traversable GHC.Internal.Functor.ZipList.ZipList -- Defined in ‘GHC.Internal.Functor.ZipList’
instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Data.Traversable.Traversable f, GHC.Internal.Data.Traversable.Traversable g) => GHC.Internal.Data.Traversable.Traversable (f GHC.Internal.Generics.:*: g) -- Defined in ‘GHC.Internal.Data.Traversable’
=====================================
testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
=====================================
@@ -1673,7 +1673,7 @@ module Data.Semigroup where
stimesMonoid :: forall b a. (GHC.Internal.Real.Integral b, GHC.Internal.Base.Monoid a) => b -> a -> a
module Data.String where
- -- Safety: Safe
+ -- Safety: Trustworthy
type IsString :: * -> Constraint
class IsString a where
fromString :: String -> a
@@ -11805,8 +11805,8 @@ instance GHC.Internal.Data.Foldable.Foldable Data.Semigroup.First -- Defined in
instance GHC.Internal.Data.Foldable.Foldable Data.Semigroup.Last -- Defined in ‘Data.Semigroup’
instance GHC.Internal.Data.Foldable.Foldable Data.Semigroup.Max -- Defined in ‘Data.Semigroup’
instance GHC.Internal.Data.Foldable.Foldable Data.Semigroup.Min -- Defined in ‘Data.Semigroup’
-instance forall a k (b :: k). GHC.Internal.Data.String.IsString a => GHC.Internal.Data.String.IsString (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.String’
-instance forall a. GHC.Internal.Data.String.IsString a => GHC.Internal.Data.String.IsString (GHC.Internal.Data.Functor.Identity.Identity a) -- Defined in ‘GHC.Internal.Data.String’
+instance forall a k (b :: k). GHC.Internal.Data.String.IsString a => GHC.Internal.Data.String.IsString (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘Data.String’
+instance forall a. GHC.Internal.Data.String.IsString a => GHC.Internal.Data.String.IsString (GHC.Internal.Data.Functor.Identity.Identity a) -- Defined in ‘Data.String’
instance forall a. (a ~ GHC.Internal.Types.Char) => GHC.Internal.Data.String.IsString [a] -- Defined in ‘GHC.Internal.Data.String’
instance GHC.Internal.Data.Traversable.Traversable GHC.Internal.Functor.ZipList.ZipList -- Defined in ‘GHC.Internal.Functor.ZipList’
instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Data.Traversable.Traversable f, GHC.Internal.Data.Traversable.Traversable g) => GHC.Internal.Data.Traversable.Traversable (f GHC.Internal.Generics.:*: g) -- Defined in ‘GHC.Internal.Data.Traversable’
=====================================
testsuite/tests/interface-stability/base-exports.stdout-mingw32
=====================================
@@ -1673,7 +1673,7 @@ module Data.Semigroup where
stimesMonoid :: forall b a. (GHC.Internal.Real.Integral b, GHC.Internal.Base.Monoid a) => b -> a -> a
module Data.String where
- -- Safety: Safe
+ -- Safety: Trustworthy
type IsString :: * -> Constraint
class IsString a where
fromString :: String -> a
@@ -12036,8 +12036,8 @@ instance GHC.Internal.Data.Foldable.Foldable Data.Semigroup.First -- Defined in
instance GHC.Internal.Data.Foldable.Foldable Data.Semigroup.Last -- Defined in ‘Data.Semigroup’
instance GHC.Internal.Data.Foldable.Foldable Data.Semigroup.Max -- Defined in ‘Data.Semigroup’
instance GHC.Internal.Data.Foldable.Foldable Data.Semigroup.Min -- Defined in ‘Data.Semigroup’
-instance forall a k (b :: k). GHC.Internal.Data.String.IsString a => GHC.Internal.Data.String.IsString (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.String’
-instance forall a. GHC.Internal.Data.String.IsString a => GHC.Internal.Data.String.IsString (GHC.Internal.Data.Functor.Identity.Identity a) -- Defined in ‘GHC.Internal.Data.String’
+instance forall a k (b :: k). GHC.Internal.Data.String.IsString a => GHC.Internal.Data.String.IsString (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘Data.String’
+instance forall a. GHC.Internal.Data.String.IsString a => GHC.Internal.Data.String.IsString (GHC.Internal.Data.Functor.Identity.Identity a) -- Defined in ‘Data.String’
instance forall a. (a ~ GHC.Internal.Types.Char) => GHC.Internal.Data.String.IsString [a] -- Defined in ‘GHC.Internal.Data.String’
instance GHC.Internal.Data.Traversable.Traversable GHC.Internal.Functor.ZipList.ZipList -- Defined in ‘GHC.Internal.Functor.ZipList’
instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Data.Traversable.Traversable f, GHC.Internal.Data.Traversable.Traversable g) => GHC.Internal.Data.Traversable.Traversable (f GHC.Internal.Generics.:*: g) -- Defined in ‘GHC.Internal.Data.Traversable’
=====================================
testsuite/tests/interface-stability/base-exports.stdout-ws-32
=====================================
@@ -1673,7 +1673,7 @@ module Data.Semigroup where
stimesMonoid :: forall b a. (GHC.Internal.Real.Integral b, GHC.Internal.Base.Monoid a) => b -> a -> a
module Data.String where
- -- Safety: Safe
+ -- Safety: Trustworthy
type IsString :: * -> Constraint
class IsString a where
fromString :: String -> a
@@ -11778,8 +11778,8 @@ instance GHC.Internal.Data.Foldable.Foldable Data.Semigroup.First -- Defined in
instance GHC.Internal.Data.Foldable.Foldable Data.Semigroup.Last -- Defined in ‘Data.Semigroup’
instance GHC.Internal.Data.Foldable.Foldable Data.Semigroup.Max -- Defined in ‘Data.Semigroup’
instance GHC.Internal.Data.Foldable.Foldable Data.Semigroup.Min -- Defined in ‘Data.Semigroup’
-instance forall a k (b :: k). GHC.Internal.Data.String.IsString a => GHC.Internal.Data.String.IsString (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.String’
-instance forall a. GHC.Internal.Data.String.IsString a => GHC.Internal.Data.String.IsString (GHC.Internal.Data.Functor.Identity.Identity a) -- Defined in ‘GHC.Internal.Data.String’
+instance forall a k (b :: k). GHC.Internal.Data.String.IsString a => GHC.Internal.Data.String.IsString (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘Data.String’
+instance forall a. GHC.Internal.Data.String.IsString a => GHC.Internal.Data.String.IsString (GHC.Internal.Data.Functor.Identity.Identity a) -- Defined in ‘Data.String’
instance forall a. (a ~ GHC.Internal.Types.Char) => GHC.Internal.Data.String.IsString [a] -- Defined in ‘GHC.Internal.Data.String’
instance GHC.Internal.Data.Traversable.Traversable GHC.Internal.Functor.ZipList.ZipList -- Defined in ‘GHC.Internal.Functor.ZipList’
instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Data.Traversable.Traversable f, GHC.Internal.Data.Traversable.Traversable g) => GHC.Internal.Data.Traversable.Traversable (f GHC.Internal.Generics.:*: g) -- Defined in ‘GHC.Internal.Data.Traversable’
=====================================
testsuite/tests/interface-stability/ghc-experimental-exports.stdout
=====================================
@@ -11188,8 +11188,6 @@ instance forall a. GHC.Internal.Classes.Ord (GHC.Internal.Ptr.FunPtr a) -- Defin
instance forall a. GHC.Internal.Classes.Ord (GHC.Internal.Ptr.Ptr a) -- Defined in ‘GHC.Internal.Ptr’
instance forall a. GHC.Internal.Classes.Ord a => GHC.Internal.Classes.Ord (GHC.Internal.Base.NonEmpty a) -- Defined in ‘GHC.Internal.Base’
instance GHC.Internal.Classes.Ord GHC.Internal.Base.Void -- Defined in ‘GHC.Internal.Base’
-instance forall a k (b :: k). GHC.Internal.Data.String.IsString a => GHC.Internal.Data.String.IsString (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.String’
-instance forall a. GHC.Internal.Data.String.IsString a => GHC.Internal.Data.String.IsString (GHC.Internal.Data.Functor.Identity.Identity a) -- Defined in ‘GHC.Internal.Data.String’
instance forall a. (a ~ GHC.Internal.Types.Char) => GHC.Internal.Data.String.IsString [a] -- Defined in ‘GHC.Internal.Data.String’
instance forall a. GHC.Internal.Enum.Bounded a => GHC.Internal.Enum.Bounded (GHC.Internal.Data.Ord.Down a) -- Defined in ‘GHC.Internal.Data.Ord’
instance forall a. (GHC.Internal.Enum.Enum a, GHC.Internal.Enum.Bounded a, GHC.Internal.Classes.Eq a) => GHC.Internal.Enum.Enum (GHC.Internal.Data.Ord.Down a) -- Defined in ‘GHC.Internal.Data.Ord’
=====================================
testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32
=====================================
@@ -11191,8 +11191,6 @@ instance forall a. GHC.Internal.Classes.Ord (GHC.Internal.Ptr.FunPtr a) -- Defin
instance forall a. GHC.Internal.Classes.Ord (GHC.Internal.Ptr.Ptr a) -- Defined in ‘GHC.Internal.Ptr’
instance forall a. GHC.Internal.Classes.Ord a => GHC.Internal.Classes.Ord (GHC.Internal.Base.NonEmpty a) -- Defined in ‘GHC.Internal.Base’
instance GHC.Internal.Classes.Ord GHC.Internal.Base.Void -- Defined in ‘GHC.Internal.Base’
-instance forall a k (b :: k). GHC.Internal.Data.String.IsString a => GHC.Internal.Data.String.IsString (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.String’
-instance forall a. GHC.Internal.Data.String.IsString a => GHC.Internal.Data.String.IsString (GHC.Internal.Data.Functor.Identity.Identity a) -- Defined in ‘GHC.Internal.Data.String’
instance forall a. (a ~ GHC.Internal.Types.Char) => GHC.Internal.Data.String.IsString [a] -- Defined in ‘GHC.Internal.Data.String’
instance forall a. GHC.Internal.Enum.Bounded a => GHC.Internal.Enum.Bounded (GHC.Internal.Data.Ord.Down a) -- Defined in ‘GHC.Internal.Data.Ord’
instance forall a. (GHC.Internal.Enum.Enum a, GHC.Internal.Enum.Bounded a, GHC.Internal.Classes.Eq a) => GHC.Internal.Enum.Enum (GHC.Internal.Data.Ord.Down a) -- Defined in ‘GHC.Internal.Data.Ord’
=====================================
testsuite/tests/plugins/plugins10.stdout
=====================================
@@ -2,6 +2,7 @@ parsePlugin()
interfacePlugin: Prelude
interfacePlugin: Language.Haskell.TH
interfacePlugin: Language.Haskell.TH.Quote
+interfacePlugin: Data.List
interfacePlugin: GHC.Internal.Base
interfacePlugin: GHC.Internal.Data.NonEmpty
interfacePlugin: GHC.Internal.Float
=====================================
testsuite/tests/typecheck/should_fail/T12921.stderr
=====================================
@@ -24,8 +24,6 @@ T12921.hs:4:16: error: [GHC-39999]
Potentially matching instance:
instance (a ~ Char) => GHC.Internal.Data.String.IsString [a]
-- Defined in ‘GHC.Internal.Data.String’
- ...plus two instances involving out-of-scope types
- (use -fprint-potential-instances to see them all)
• In the annotation:
{-# ANN module "HLint: ignore Reduce duplication" #-}
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/04369afe887da192c411418df54ef4…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/04369afe887da192c411418df54ef4…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
24 Feb '26
Cheng Shao pushed new branch wip/wasm-ghci-file-server at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/wasm-ghci-file-server
You're receiving this email because of your account on gitlab.haskell.org.
1
0
24 Feb '26
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
fa88d09a by Wolfgang Jeltsch at 2026-02-24T08:36:47-05:00
Refine the imports of `System.IO.OS`
Commit 68bd08055594b8cbf6148a72d108786deb6c12a1 replaced the
`GHC.Internal.Data.Bool` import by a `GHC.Internal.Base` import.
However, while the `GHC.Internal.Data.Bool` import was conditional and
partial, the `GHC.Internal.Base` import is unconditional and total. As a
result, the import list is not tuned to import only the necessary bits
anymore, and furthermore GHC emits a lot of warnings about redundant
imports.
This commit makes the `GHC.Internal.Base` import conditional and partial
in the same way that the `GHC.Internal.Data.Bool` import was.
- - - - -
1 changed file:
- libraries/ghc-internal/src/GHC/Internal/System/IO/OS.hs
Changes:
=====================================
libraries/ghc-internal/src/GHC/Internal/System/IO/OS.hs
=====================================
@@ -23,7 +23,9 @@ module GHC.Internal.System.IO.OS
)
where
-import GHC.Internal.Base
+#if defined(mingw32_HOST_OS)
+import GHC.Internal.Base (otherwise)
+#endif
import GHC.Internal.Control.Monad (return)
import GHC.Internal.Control.Concurrent.MVar (MVar)
import GHC.Internal.Control.Exception (mask)
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fa88d09aeda395ea6ed773e02f77665…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fa88d09aeda395ea6ed773e02f77665…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/VeryMilkyJoe/no-mod-loc-pat] Remove backwards compatability pattern synonym `ModLocation`
by Jana Chadt (＠VeryMilkyJoe) 24 Feb '26
by Jana Chadt (＠VeryMilkyJoe) 24 Feb '26
24 Feb '26
Jana Chadt pushed to branch wip/VeryMilkyJoe/no-mod-loc-pat at Glasgow Haskell Compiler / GHC
Commits:
1b4867c0 by Jana Chadt at 2026-02-24T14:37:35+01:00
Remove backwards compatability pattern synonym `ModLocation`
* Introduce utility to create ShortByteString from an OsString.
* Introduce utility to create StringBuffer for a given OsPath.
* Add mkFastStringOsString, which returns a FastString for a given OsString.
Fixes #24932
- - - - -
12 changed files:
- compiler/GHC.hs
- compiler/GHC/Cmm/DebugBlock.hs
- compiler/GHC/CoreToStg/AddImplicitBinds.hs
- compiler/GHC/Data/FastString.hs
- compiler/GHC/Data/OsPath.hs
- compiler/GHC/Data/StringBuffer.hs
- compiler/GHC/Stg/Debug.hs
- compiler/GHC/Unit/Module/Location.hs
- compiler/GHC/Unit/Module/ModSummary.hs
- compiler/ghc.cabal.in
- testsuite/tests/ghc-api/fixed-nodes/FixedNodes.hs
- testsuite/tests/ghc-api/fixed-nodes/ModuleGraphInvariants.hs
Changes:
=====================================
compiler/GHC.hs
=====================================
@@ -79,7 +79,13 @@ module GHC (
ModuleGraph, emptyMG, mapMG, mkModuleGraph, mgModSummaries,
mgLookupModule,
ModSummary(..), ms_mod_name, ModLocation(..),
- pattern ModLocation,
+ ml_hs_file,
+ ml_hi_file,
+ ml_dyn_hi_file,
+ ml_obj_file,
+ ml_dyn_obj_file,
+ ml_hie_file,
+ ml_bytecode_file,
getModSummary,
getModuleGraph,
isLoaded,
@@ -457,6 +463,7 @@ import System.Environment ( getEnv, getProgName )
import System.Exit ( exitWith, ExitCode(..) )
import System.FilePath
import System.IO.Error ( isDoesNotExistError )
+import GHC.Data.OsPath (OsPath)
#if defined(HAVE_INTERNAL_INTERPRETER)
import Foreign.C
@@ -1575,12 +1582,12 @@ pprParenSymName a = parenSymOcc (getOccName a) (ppr (getName a))
-- a module by using 'getModSummary'
--
-- XXX: Explain pre-conditions
-getModuleSourceAndFlags :: ModSummary -> IO (String, StringBuffer, DynFlags)
+getModuleSourceAndFlags :: ModSummary -> IO (OsPath, StringBuffer, DynFlags)
getModuleSourceAndFlags m = do
- case ml_hs_file $ ms_location m of
+ case ml_hs_file_ospath $ ms_location m of
Nothing -> throwIO $ mkApiErr (ms_hspp_opts m) (text "No source available for module " <+> ppr (ms_mod m))
Just sourceFile -> do
- source <- hGetStringBuffer sourceFile
+ source <- hGetStringBufferOsPath sourceFile
return (sourceFile, source, ms_hspp_opts m)
@@ -1592,7 +1599,7 @@ getModuleSourceAndFlags m = do
getTokenStream :: ModSummary -> IO [Located Token]
getTokenStream mod = do
(sourceFile, source, dflags) <- getModuleSourceAndFlags mod
- let startLoc = mkRealSrcLoc (mkFastString sourceFile) 1 1
+ let startLoc = mkRealSrcLoc (mkFastStringOsString sourceFile) 1 1
case lexTokenStream (initParserOpts dflags) source startLoc of
POk _ ts -> return ts
PFailed pst -> throwErrors (initSourceErrorContext dflags) (GhcPsMessage <$> getPsErrorMessages pst)
@@ -1603,7 +1610,7 @@ getTokenStream mod = do
getRichTokenStream :: ModSummary -> IO [(Located Token, String)]
getRichTokenStream mod = do
(sourceFile, source, dflags) <- getModuleSourceAndFlags mod
- let startLoc = mkRealSrcLoc (mkFastString sourceFile) 1 1
+ let startLoc = mkRealSrcLoc (mkFastStringOsString sourceFile) 1 1
case lexTokenStream (initParserOpts dflags) source startLoc of
POk _ ts -> return $ addSourceToTokens startLoc source ts
PFailed pst -> throwErrors (initSourceErrorContext dflags) (GhcPsMessage <$> getPsErrorMessages pst)
=====================================
compiler/GHC/Cmm/DebugBlock.hs
=====================================
@@ -33,7 +33,7 @@ import GHC.Cmm.CLabel
import GHC.Cmm
import GHC.Cmm.Reg ( pprGlobalReg, pprGlobalRegUse )
import GHC.Cmm.Utils
-import GHC.Data.FastString ( LexicalFastString, nilFS, mkFastString )
+import GHC.Data.FastString ( LexicalFastString, nilFS, mkFastStringOsString )
import GHC.Unit.Module
import GHC.Utils.Outputable
import GHC.Utils.Panic
@@ -156,7 +156,7 @@ cmmDebugGen modLoc decls = map (blocksForScope Nothing) topScopes
rangeRating (span, _)
| srcSpanFile span == thisFile = 1
| otherwise = 2 :: Int
- thisFile = maybe nilFS mkFastString $ ml_hs_file modLoc
+ thisFile = maybe nilFS mkFastStringOsString $ ml_hs_file_ospath modLoc
-- Returns block tree for this scope as well as all nested
-- scopes. Note that if there are multiple blocks in the (exact)
=====================================
compiler/GHC/CoreToStg/AddImplicitBinds.hs
=====================================
@@ -135,15 +135,16 @@ tick_it :: Bool -> ModLocation -> Name -> CoreExpr -> CoreExpr
-- If we want to generate debug info, we put a source note on the
-- worker. This is useful, especially for heap profiling.
tick_it generate_debug_info mod_loc name
- | not generate_debug_info = id
+ | not generate_debug_info = id
| RealSrcSpan span _ <- nameSrcSpan name = tick span
- | Just file <- ml_hs_file mod_loc = tick (span1 file)
- | otherwise = tick (span1 "???")
+ | Just file <- ml_hs_file_ospath mod_loc = tick (span2 file)
+ | otherwise = tick (span1 "???")
where
tick span = Tick $ SourceNote span $
LexicalFastString $ mkFastString $
renderWithContext defaultSDocContext $ ppr name
- span1 file = realSrcLocSpan $ mkRealSrcLoc (mkFastString file) 1 1
+ span1 str = realSrcLocSpan $ mkRealSrcLoc (mkFastString str) 1 1
+ span2 file = realSrcLocSpan $ mkRealSrcLoc (mkFastStringOsString file) 1 1
=====================================
compiler/GHC/Data/FastString.hs
=====================================
@@ -77,6 +77,7 @@ module GHC.Data.FastString
mkFastStringBytes,
mkFastStringByteList,
mkFastString#,
+ mkFastStringOsString,
-- ** Deconstruction
unpackFS, -- :: FastString -> String
@@ -134,12 +135,14 @@ import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC
import qualified Data.ByteString.Unsafe as BS
import qualified Data.ByteString.Short as SBS
-import GHC.Data.ShortText (ShortText(..))
-import Foreign.C
-import System.IO
import Data.Data
import Data.IORef
import Data.Semigroup as Semi
+import Data.Type.Coercion (coerceWith)
+import Foreign.C
+import GHC.Data.ShortText (ShortText (..))
+import System.IO
+import System.OsString.Internal.Types
import Foreign
@@ -547,6 +550,14 @@ mkFastStringShortByteString :: ShortByteString -> FastString
mkFastStringShortByteString sbs =
inlinePerformIO $ mkFastStringWith (mkNewFastStringShortByteString sbs) sbs
+-- | Create a 'FastString' from an 'OsString', without copying.
+mkFastStringOsString :: OsString -> FastString
+mkFastStringOsString os = mkFastStringShortByteString $
+ -- Using 'OsPath''s 'unOS' here will unfortunately lead to cyclic dependencies
+ case coercionToPlatformTypes of
+ Left (_, windowsStringEv) -> unWS $ coerceWith windowsStringEv os
+ Right (_, posixStringEv) -> unPS $ coerceWith posixStringEv os
+
-- | Creates a UTF-8 encoded 'FastString' from a 'String'
mkFastString :: String -> FastString
{-# NOINLINE[1] mkFastString #-}
=====================================
compiler/GHC/Data/OsPath.hs
=====================================
@@ -8,6 +8,7 @@ module GHC.Data.OsPath
, unsafeDecodeUtf
, unsafeEncodeUtf
, os
+ , unOS
-- * Common utility functions
, (</>)
, (<.>)
@@ -28,13 +29,22 @@ import GHC.Prelude
import GHC.Utils.Misc (HasCallStack)
import GHC.Utils.Panic (panic)
+import Data.ByteString.Short (ShortByteString)
+import Data.Type.Coercion (coerceWith)
+import System.Directory.Internal (os)
+import System.Directory.OsPath (createDirectoryIfMissing, doesDirectoryExist, doesFileExist, getDirectoryContents)
import System.OsPath
import System.OsString (isSuffixOf)
-import System.Directory.OsPath (doesDirectoryExist, doesFileExist, getDirectoryContents, createDirectoryIfMissing)
-import System.Directory.Internal (os)
+import System.OsString.Internal.Types (coercionToPlatformTypes, unPS, unWS)
-- | Decode an 'OsPath' to 'FilePath', throwing an 'error' if decoding failed.
-- Prefer 'decodeUtf' and gracious error handling.
unsafeDecodeUtf :: HasCallStack => OsPath -> FilePath
unsafeDecodeUtf p =
either (\err -> panic $ "Failed to decodeUtf \"" ++ show p ++ "\", because: " ++ show err) id (decodeUtf p)
+
+-- | Extracts underlying 'ShortByteString' from the given 'OsString', taking care of platform specifics.
+unOS :: OsString -> ShortByteString
+unOS os = case coercionToPlatformTypes of
+ Left (_, windowsStringEv) -> unWS $ coerceWith windowsStringEv os
+ Right (_, posixStringEv) -> unPS $ coerceWith posixStringEv os
=====================================
compiler/GHC/Data/StringBuffer.hs
=====================================
@@ -21,6 +21,7 @@ module GHC.Data.StringBuffer
-- * Creation\/destruction
hGetStringBuffer,
hGetStringBufferBlock,
+ hGetStringBufferOsPath,
hPutStringBuffer,
appendStringBuffers,
stringToStringBuffer,
@@ -56,17 +57,19 @@ module GHC.Data.StringBuffer
import GHC.Prelude
import GHC.Data.FastString
+import GHC.Data.OsPath (OsPath)
+import GHC.Fingerprint
import GHC.Utils.Encoding
+import GHC.Utils.Exception (bracket_)
import GHC.Utils.IO.Unsafe
import GHC.Utils.Panic.Plain
-import GHC.Utils.Exception ( bracket_ )
-import GHC.Fingerprint
import Data.Maybe
+import GHC.IO.Encoding.Failure (CodingFailureMode (IgnoreCodingFailure))
+import GHC.IO.Encoding.UTF8 (mkUTF8)
+import System.File.OsPath qualified as FileIO
import System.IO
-import System.IO.Unsafe ( unsafePerformIO )
-import GHC.IO.Encoding.UTF8 ( mkUTF8 )
-import GHC.IO.Encoding.Failure ( CodingFailureMode(IgnoreCodingFailure) )
+import System.IO.Unsafe (unsafePerformIO)
import qualified Data.ByteString.Internal as BS
import qualified Data.ByteString as BS
@@ -111,6 +114,15 @@ instance Show StringBuffer where
hGetStringBuffer :: FilePath -> IO StringBuffer
hGetStringBuffer fname = do
h <- openBinaryFile fname ReadMode
+ hGetStringBufferHandle h
+
+hGetStringBufferOsPath :: OsPath -> IO StringBuffer
+hGetStringBufferOsPath fname = do
+ h <- FileIO.openBinaryFile fname ReadMode
+ hGetStringBufferHandle h
+
+hGetStringBufferHandle :: Handle -> IO StringBuffer
+hGetStringBufferHandle h = do
size_i <- hFileSize h
offset_i <- skipBOM h size_i 0 -- offset is 0 initially
let size = fromIntegral $ size_i - offset_i
=====================================
compiler/GHC/Stg/Debug.hs
=====================================
@@ -87,7 +87,7 @@ recordInfo :: Id -> StgExpr -> M ()
recordInfo bndr new_rhs = do
modLoc <- asks rModLocation
let
- thisFile = maybe nilFS mkFastString $ ml_hs_file modLoc
+ thisFile = maybe nilFS mkFastStringOsString $ ml_hs_file_ospath modLoc
-- A span from the ticks surrounding the new_rhs
best_span = quickSourcePos thisFile new_rhs
-- A back-up span if the bndr had a source position, many do not (think internally generated ids)
=====================================
compiler/GHC/Unit/Module/Location.hs
=====================================
@@ -2,31 +2,28 @@
{-# LANGUAGE ViewPatterns #-}
-- | Module location
module GHC.Unit.Module.Location
- ( ModLocation
- ( ..
- , ml_hs_file
- , ml_hi_file
- , ml_dyn_hi_file
- , ml_obj_file
- , ml_dyn_obj_file
- , ml_hie_file
- , ml_bytecode_file
- )
- , pattern ModLocation
+ ( ModLocation(..)
, addBootSuffix
, addBootSuffixLocn
, addBootSuffixLocnOut
, removeBootSuffix
, mkFileSrcSpan
+ , ml_hs_file
+ , ml_hi_file
+ , ml_dyn_hi_file
+ , ml_obj_file
+ , ml_dyn_obj_file
+ , ml_hie_file
+ , ml_bytecode_file
)
where
import GHC.Prelude
+import GHC.Data.FastString (mkFastStringOsString)
import GHC.Data.OsPath
import GHC.Types.SrcLoc
import GHC.Utils.Outputable
-import GHC.Data.FastString (mkFastString)
import qualified System.OsString as OsString
@@ -120,41 +117,31 @@ addBootSuffixLocnOut locn
-- | Compute a 'SrcSpan' from a 'ModLocation'.
mkFileSrcSpan :: ModLocation -> SrcSpan
mkFileSrcSpan mod_loc
- = case ml_hs_file mod_loc of
- Just file_path -> mkGeneralSrcSpan (mkFastString file_path)
+ = case ml_hs_file_ospath mod_loc of
+ Just file_path -> mkGeneralSrcSpan (mkFastStringOsString file_path)
Nothing -> interactiveSrcSpan -- Presumably
-- ----------------------------------------------------------------------------
-- Helpers for backwards compatibility
-- ----------------------------------------------------------------------------
-{-# COMPLETE ModLocation #-}
-
-pattern ModLocation :: Maybe FilePath -> FilePath -> FilePath -> FilePath -> FilePath -> FilePath -> FilePath -> ModLocation
-pattern ModLocation
- { ml_hs_file
- , ml_hi_file
- , ml_dyn_hi_file
- , ml_obj_file
- , ml_dyn_obj_file
- , ml_hie_file
- , ml_bytecode_file
- } <- OsPathModLocation
- { ml_hs_file_ospath = (fmap unsafeDecodeUtf -> ml_hs_file)
- , ml_hi_file_ospath = (unsafeDecodeUtf -> ml_hi_file)
- , ml_dyn_hi_file_ospath = (unsafeDecodeUtf -> ml_dyn_hi_file)
- , ml_obj_file_ospath = (unsafeDecodeUtf -> ml_obj_file)
- , ml_dyn_obj_file_ospath = (unsafeDecodeUtf -> ml_dyn_obj_file)
- , ml_hie_file_ospath = (unsafeDecodeUtf -> ml_hie_file)
- , ml_bytecode_file_ospath = (unsafeDecodeUtf -> ml_bytecode_file)
- } where
- ModLocation ml_hs_file ml_hi_file ml_dyn_hi_file ml_obj_file ml_dyn_obj_file ml_hie_file ml_bytecode_file
- = OsPathModLocation
- { ml_hs_file_ospath = fmap unsafeEncodeUtf ml_hs_file
- , ml_hi_file_ospath = unsafeEncodeUtf ml_hi_file
- , ml_dyn_hi_file_ospath = unsafeEncodeUtf ml_dyn_hi_file
- , ml_obj_file_ospath = unsafeEncodeUtf ml_obj_file
- , ml_dyn_obj_file_ospath = unsafeEncodeUtf ml_dyn_obj_file
- , ml_hie_file_ospath = unsafeEncodeUtf ml_hie_file
- , ml_bytecode_file_ospath = unsafeEncodeUtf ml_bytecode_file
- }
+ml_hs_file :: ModLocation -> Maybe FilePath
+ml_hs_file = fmap unsafeDecodeUtf . ml_hs_file_ospath
+
+ml_hi_file :: ModLocation -> FilePath
+ml_hi_file = unsafeDecodeUtf . ml_hi_file_ospath
+
+ml_dyn_hi_file :: ModLocation -> FilePath
+ml_dyn_hi_file = unsafeDecodeUtf . ml_dyn_hi_file_ospath
+
+ml_obj_file :: ModLocation -> FilePath
+ml_obj_file = unsafeDecodeUtf . ml_obj_file_ospath
+
+ml_dyn_obj_file :: ModLocation -> FilePath
+ml_dyn_obj_file = unsafeDecodeUtf . ml_dyn_obj_file_ospath
+
+ml_hie_file :: ModLocation -> FilePath
+ml_hie_file = unsafeDecodeUtf . ml_hie_file_ospath
+
+ml_bytecode_file :: ModLocation -> FilePath
+ml_bytecode_file = unsafeDecodeUtf . ml_bytecode_file_ospath
=====================================
compiler/GHC/Unit/Module/ModSummary.hs
=====================================
@@ -46,7 +46,7 @@ import GHC.Types.PkgQual
import GHC.Types.Basic
import GHC.Data.Maybe
-import GHC.Data.OsPath (OsPath)
+import GHC.Data.OsPath ( OsPath )
import GHC.Data.StringBuffer ( StringBuffer )
import GHC.Utils.Fingerprint
@@ -214,7 +214,7 @@ findTarget ms ts =
= ms_mod_name summary == m && ms_unitid summary == unitId
summary `matches` Target { targetId = TargetFile f _, targetUnitId = unitid }
| Just f' <- ml_hs_file (ms_location summary)
- = f == f' && ms_unitid summary == unitid
+ = f == f' && ms_unitid summary == unitid
_ `matches` _
= False
=====================================
compiler/ghc.cabal.in
=====================================
@@ -125,6 +125,7 @@ Library
containers >= 0.6.2.1 && < 0.9,
array >= 0.1 && < 0.6,
filepath >= 1.5 && < 1.6,
+ file-io,
os-string >= 2.0.1 && < 2.1,
hpc >= 0.6 && < 0.8,
transformers >= 0.5 && < 0.7,
=====================================
testsuite/tests/ghc-api/fixed-nodes/FixedNodes.hs
=====================================
@@ -31,7 +31,7 @@ convertToFixed (ModuleNodeCompile ms) =
-- with the module summary information
let modName = ms_mod_name ms
modLoc = ms_location ms
- in ModuleNodeFixed (msKey ms) (ms_location ms) { ml_hs_file = Nothing}
+ in ModuleNodeFixed (msKey ms) (ms_location ms) { ml_hs_file_os_path = Nothing}
-- | Load a module graph and report the result
=====================================
testsuite/tests/ghc-api/fixed-nodes/ModuleGraphInvariants.hs
=====================================
@@ -29,7 +29,7 @@ convertToFixed :: ModuleNodeInfo -> ModuleNodeInfo
convertToFixed (ModuleNodeCompile ms) =
let modName = ms_mod_name ms
modLoc = ms_location ms
- in ModuleNodeFixed (msKey ms) (ms_location ms) { ml_hs_file = Nothing}
+ in ModuleNodeFixed (msKey ms) (ms_location ms) { ml_hs_file_ospath = Nothing}
-- | Test a module graph and report if it matches expected invariant violations
testModuleGraph :: String -> ModuleGraph -> [ModuleGraphInvariantError] -> Ghc ()
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1b4867c021458a9f1e86bd19a18598f…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1b4867c021458a9f1e86bd19a18598f…
You're receiving this email because of your account on gitlab.haskell.org.
1
0