Jana Chadt pushed to branch wip/VeryMilkyJoe/no-mod-loc-pat at Glasgow Haskell Compiler / GHC Commits: f30bcf60 by VeryMilkyJoe at 2026-03-16T13:46:20+01:00 Remove backwards compatibility pattern synonym `ModLocation` Fixes #24932 - - - - - 9 changed files: - compiler/GHC.hs - compiler/GHC/CoreToStg/AddImplicitBinds.hs - compiler/GHC/Data/StringBuffer.hs - compiler/GHC/Unit/Module/Location.hs - compiler/GHC/Unit/Module/ModSummary.hs - compiler/ghc.cabal.in - + hadrian/cabal.project.local - 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,7 +1582,7 @@ 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 (FilePath, StringBuffer, DynFlags) getModuleSourceAndFlags m = do case ml_hs_file $ ms_location m of Nothing -> throwIO $ mkApiErr (ms_hspp_opts m) (text "No source available for module " <+> ppr (ms_mod m)) ===================================== compiler/GHC/CoreToStg/AddImplicitBinds.hs ===================================== @@ -10,7 +10,7 @@ import GHC.Prelude import GHC.CoreToStg.Prep( CorePrepPgmConfig(..) ) -import GHC.Unit( ModLocation(..) ) +import GHC.Unit( ModLocation(..), ml_hs_file ) import GHC.Core import GHC.Core.DataCon( DataCon, dataConWorkId, dataConWrapId ) ===================================== compiler/GHC/Data/StringBuffer.hs ===================================== @@ -56,17 +56,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 ===================================== compiler/GHC/Unit/Module/Location.hs ===================================== @@ -2,22 +2,19 @@ {-# 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 @@ -128,33 +125,30 @@ mkFileSrcSpan mod_loc -- 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 ===================================== 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, ===================================== hadrian/cabal.project.local ===================================== @@ -0,0 +1,2 @@ +ignore-project: False +with-compiler: ghc-9.10.3 ===================================== 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/f30bcf60a840004a0d8fc292c8b2f9f1... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f30bcf60a840004a0d8fc292c8b2f9f1... You're receiving this email because of your account on gitlab.haskell.org.