[Git][ghc/ghc][wip/VeryMilkyJoe/no-mod-loc-pat] Remove backwards compatability pattern synonym `ModLocation`

25 Feb 2026


      Jana Chadt pushed to branch wip/VeryMilkyJoe/no-mod-loc-pat at Glasgow Haskell Compiler / GHC


Commits:
b2c52978 by Jana Chadt at 2026-02-25T19:07:50+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,38 @@ 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
+{-# INLINE ml_hs_file #-}
+ml_hs_file = fmap unsafeDecodeUtf . ml_hs_file_ospath
+
+ml_hi_file :: ModLocation -> FilePath
+{-# INLINE ml_hi_file #-}
+ml_hi_file = unsafeDecodeUtf . ml_hi_file_ospath
+
+ml_dyn_hi_file :: ModLocation -> FilePath
+{-# INLINE ml_dyn_hi_file #-}
+ml_dyn_hi_file = unsafeDecodeUtf . ml_dyn_hi_file_ospath
+
+ml_obj_file :: ModLocation -> FilePath
+{-# INLINE ml_obj_file #-}
+ml_obj_file = unsafeDecodeUtf . ml_obj_file_ospath
+
+ml_dyn_obj_file :: ModLocation -> FilePath
+{-# INLINE ml_dyn_obj_file #-}
+ml_dyn_obj_file = unsafeDecodeUtf . ml_dyn_obj_file_ospath
+
+ml_hie_file :: ModLocation -> FilePath
+{-# INLINE ml_hie_file #-}
+ml_hie_file = unsafeDecodeUtf . ml_hie_file_ospath
+
+ml_bytecode_file :: ModLocation -> FilePath
+{-# INLINE ml_bytecode_file #-}
+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/b2c529781d420016794d9529608b7e34...

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b2c529781d420016794d9529608b7e34...
You're receiving this email because of your account on gitlab.haskell.org.

    

Jana Chadt (＠VeryMilkyJoe)

tags

participants (1)