Matthew Pickering pushed to branch wip/mp/9.10.1-memory-backports at Glasgow Haskell Compiler / GHC Commits: c0cce5dc by Fendor at 2026-01-06T12:35:56+00:00 Migrate `Finder` component to `OsPath`, fixed #24616 For each module in a GHCi session, we keep alive one `ModLocation`. A `ModLocation` is fairly inefficiently packed, as `String`s are expensive in memory usage. While benchmarking the agda codebase, we concluded that we keep alive around 11MB of `FilePath`'s, solely retained by `ModLocation`. We provide a more densely packed encoding of `ModLocation`, by moving from `FilePath` to `OsPath`. Further, we migrate the full `Finder` component to `OsPath` to avoid unnecessary transformations. As the `Finder` component is well-encapsulated, this requires only a minimal amount of changes in other modules. We introduce pattern synonym for 'ModLocation' which maintains backwards compatibility and avoids breaking consumers of 'ModLocation'. - - - - - 20 changed files: - compiler/GHC.hs - compiler/GHC/Data/OsPath.hs - compiler/GHC/Data/Strict.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Config/Finder.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/MakeFile.hs - compiler/GHC/Driver/MakeFile/JSON.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Iface/Errors.hs - compiler/GHC/Unit/Finder.hs - compiler/GHC/Unit/Finder/Types.hs - compiler/GHC/Unit/Module/Location.hs - compiler/GHC/Unit/Module/ModSummary.hs - compiler/ghc.cabal.in - ghc/ghc-bin.cabal.in - testsuite/tests/count-deps/CountDepsAst.stdout - testsuite/tests/count-deps/CountDepsParser.stdout Changes: ===================================== compiler/GHC.hs ===================================== @@ -3,7 +3,6 @@ {-# LANGUAGE NondecreasingIndentation, ScopedTypeVariables #-} {-# LANGUAGE TupleSections, NamedFieldPuns #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE ExplicitNamespaces #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE LambdaCase #-} @@ -79,6 +78,7 @@ module GHC ( ModuleGraph, emptyMG, mapMG, mkModuleGraph, mgModSummaries, mgLookupModule, ModSummary(..), ms_mod_name, ModLocation(..), + pattern ModLocation, getModSummary, getModuleGraph, isLoaded, ===================================== compiler/GHC/Data/OsPath.hs ===================================== @@ -12,10 +12,14 @@ module GHC.Data.OsPath , (</>) , (<.>) , splitSearchPath + , splitExtension , isRelative + , makeRelative + , normalise , dropTrailingPathSeparator , takeDirectory - , isSuffixOf + , OS.isSuffixOf + , OS.drop , doesDirectoryExist , doesFileExist , getDirectoryContents @@ -31,8 +35,11 @@ import GHC.Utils.Outputable qualified as Outputable import GHC.Utils.Panic (panic) import System.OsPath -import System.OsString (isSuffixOf) +import qualified System.OsString as OS (isSuffixOf, drop) import System.Directory.OsPath (doesDirectoryExist, doesFileExist, getDirectoryContents, createDirectoryIfMissing) +import GHC.Utils.Panic (panic) + +import System.OsPath import System.Directory.Internal (os) -- | Decode an 'OsPath' to 'FilePath', throwing an 'error' if decoding failed. ===================================== compiler/GHC/Data/Strict.hs ===================================== @@ -9,8 +9,8 @@ module GHC.Data.Strict ( Maybe(Nothing, Just), fromMaybe, + GHC.Data.Strict.maybe, Pair(And), - -- Not used at the moment: -- -- Either(Left, Right), @@ -18,6 +18,7 @@ module GHC.Data.Strict ( ) where import GHC.Prelude hiding (Maybe(..), Either(..)) + import Control.Applicative import Data.Semigroup import Data.Data @@ -29,6 +30,10 @@ fromMaybe :: a -> Maybe a -> a fromMaybe d Nothing = d fromMaybe _ (Just x) = x +maybe :: b -> (a -> b) -> Maybe a -> b +maybe d _ Nothing = d +maybe _ f (Just x) = f x + apMaybe :: Maybe (a -> b) -> Maybe a -> Maybe b apMaybe (Just f) (Just x) = Just (f x) apMaybe _ _ = Nothing ===================================== compiler/GHC/Driver/Backpack.hs ===================================== @@ -72,6 +72,7 @@ import GHC.Linker.Types import qualified GHC.LanguageExtensions as LangExt import GHC.Data.Maybe +import GHC.Data.OsPath (unsafeEncodeUtf, os) import GHC.Data.StringBuffer import GHC.Data.FastString import qualified GHC.Data.OsPath as OsPath @@ -779,7 +780,7 @@ summariseRequirement pn mod_name = do let PackageName pn_fs = pn let location = mkHomeModLocation2 fopts mod_name - (unpackFS pn_fs </> moduleNameSlashes mod_name) "hsig" + (unsafeEncodeUtf $ unpackFS pn_fs </> moduleNameSlashes mod_name) (os "hsig") env <- getBkpEnv src_hash <- liftIO $ getFileHash (bkp_filename env) @@ -863,12 +864,12 @@ hsModuleToModSummary home_keys pn hsc_src modname -- these filenames to figure out where the hi files go. -- A travesty! let location0 = mkHomeModLocation2 fopts modname - (unpackFS unit_fs </> + (unsafeEncodeUtf $ unpackFS unit_fs </> moduleNameSlashes modname) (case hsc_src of - HsigFile -> "hsig" - HsBootFile -> "hs-boot" - HsSrcFile -> "hs") + HsigFile -> os "hsig" + HsBootFile -> os "hs-boot" + HsSrcFile -> os "hs") -- DANGEROUS: bootifying can POISON the module finder cache let location = case hsc_src of HsBootFile -> addBootSuffixLocnOut location0 ===================================== compiler/GHC/Driver/CodeOutput.hs ===================================== @@ -35,6 +35,7 @@ import GHC.Driver.LlvmConfigCache (LlvmConfigCache) import GHC.Driver.Ppr import GHC.Driver.Backend +import GHC.Data.OsPath (unsafeDecodeUtf) import qualified GHC.Data.ShortText as ST import GHC.Data.Stream ( Stream ) import qualified GHC.Data.Stream as Stream @@ -259,7 +260,7 @@ outputForeignStubs Maybe FilePath) -- C file created outputForeignStubs logger tmpfs dflags unit_state mod location stubs = do - let stub_h = mkStubPaths (initFinderOpts dflags) (moduleName mod) location + let stub_h = unsafeDecodeUtf $ mkStubPaths (initFinderOpts dflags) (moduleName mod) location stub_c <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "c" case stubs of ===================================== compiler/GHC/Driver/Config/Finder.hs ===================================== @@ -8,27 +8,27 @@ import GHC.Prelude import GHC.Driver.DynFlags import GHC.Unit.Finder.Types import GHC.Data.FastString - +import GHC.Data.OsPath -- | Create a new 'FinderOpts' from DynFlags. initFinderOpts :: DynFlags -> FinderOpts initFinderOpts flags = FinderOpts - { finder_importPaths = importPaths flags + { finder_importPaths = fmap unsafeEncodeUtf $ importPaths flags , finder_lookupHomeInterfaces = isOneShot (ghcMode flags) , finder_bypassHiFileCheck = MkDepend == (ghcMode flags) , finder_ways = ways flags , finder_enableSuggestions = gopt Opt_HelpfulErrors flags - , finder_workingDirectory = workingDirectory flags + , finder_workingDirectory = fmap unsafeEncodeUtf $ workingDirectory flags , finder_thisPackageName = mkFastString <$> thisPackageName flags , finder_hiddenModules = hiddenModules flags , finder_reexportedModules = reexportedModules flags - , finder_hieDir = hieDir flags - , finder_hieSuf = hieSuf flags - , finder_hiDir = hiDir flags - , finder_hiSuf = hiSuf_ flags - , finder_dynHiSuf = dynHiSuf_ flags - , finder_objectDir = objectDir flags - , finder_objectSuf = objectSuf_ flags - , finder_dynObjectSuf = dynObjectSuf_ flags - , finder_stubDir = stubDir flags + , finder_hieDir = fmap unsafeEncodeUtf $ hieDir flags + , finder_hieSuf = unsafeEncodeUtf $ hieSuf flags + , finder_hiDir = fmap unsafeEncodeUtf $ hiDir flags + , finder_hiSuf = unsafeEncodeUtf $ hiSuf_ flags + , finder_dynHiSuf = unsafeEncodeUtf $ dynHiSuf_ flags + , finder_objectDir = fmap unsafeEncodeUtf $ objectDir flags + , finder_objectSuf = unsafeEncodeUtf $ objectSuf_ flags + , finder_dynObjectSuf = unsafeEncodeUtf $ dynObjectSuf_ flags + , finder_stubDir = fmap unsafeEncodeUtf $ stubDir flags } ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -264,6 +264,7 @@ import qualified GHC.LanguageExtensions as LangExt import GHC.Data.FastString import GHC.Data.Bag +import GHC.Data.OsPath (unsafeEncodeUtf) import GHC.Data.StringBuffer import qualified GHC.Data.Stream as Stream import GHC.Data.Stream (Stream) @@ -2123,12 +2124,13 @@ hscCompileCmmFile hsc_env original_filename filename output_filename = runHsc hs rawCmms return stub_c_exists where - no_loc = ModLocation{ ml_hs_file = Just original_filename, - ml_hi_file = panic "hscCompileCmmFile: no hi file", - ml_obj_file = panic "hscCompileCmmFile: no obj file", - ml_dyn_obj_file = panic "hscCompileCmmFile: no dyn obj file", - ml_dyn_hi_file = panic "hscCompileCmmFile: no dyn obj file", - ml_hie_file = panic "hscCompileCmmFile: no hie file"} + no_loc = OsPathModLocation + { ml_hs_file_ospath = Just $ unsafeEncodeUtf original_filename, + ml_hi_file_ospath = panic "hscCompileCmmFile: no hi file", + ml_obj_file_ospath = panic "hscCompileCmmFile: no obj file", + ml_dyn_obj_file_ospath = panic "hscCompileCmmFile: no dyn obj file", + ml_dyn_hi_file_ospath = panic "hscCompileCmmFile: no dyn obj file", + ml_hie_file_ospath = panic "hscCompileCmmFile: no hie file"} -------------------- Stuff for new code gen --------------------- @@ -2362,12 +2364,13 @@ hscParsedDecls hsc_env decls = runInteractiveHsc hsc_env $ do {- Desugar it -} -- We use a basically null location for iNTERACTIVE - let iNTERACTIVELoc = ModLocation{ ml_hs_file = Nothing, - ml_hi_file = panic "hsDeclsWithLocation:ml_hi_file", - ml_obj_file = panic "hsDeclsWithLocation:ml_obj_file", - ml_dyn_obj_file = panic "hsDeclsWithLocation:ml_dyn_obj_file", - ml_dyn_hi_file = panic "hsDeclsWithLocation:ml_dyn_hi_file", - ml_hie_file = panic "hsDeclsWithLocation:ml_hie_file" } + let iNTERACTIVELoc = OsPathModLocation + { ml_hs_file_ospath = Nothing, + ml_hi_file_ospath = panic "hsDeclsWithLocation:ml_hi_file_ospath", + ml_obj_file_ospath = panic "hsDeclsWithLocation:ml_obj_file_ospath", + ml_dyn_obj_file_ospath = panic "hsDeclsWithLocation:ml_dyn_obj_file_ospath", + ml_dyn_hi_file_ospath = panic "hsDeclsWithLocation:ml_dyn_hi_file_ospath", + ml_hie_file_ospath = panic "hsDeclsWithLocation:ml_hie_file_ospath" } ds_result <- hscDesugar' iNTERACTIVELoc tc_gblenv {- Simplify -} @@ -2647,12 +2650,13 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr = do {- Lint if necessary -} lintInteractiveExpr (text "hscCompileCoreExpr") hsc_env prepd_expr - let this_loc = ModLocation{ ml_hs_file = Nothing, - ml_hi_file = panic "hscCompileCoreExpr':ml_hi_file", - ml_obj_file = panic "hscCompileCoreExpr':ml_obj_file", - ml_dyn_obj_file = panic "hscCompileCoreExpr': ml_obj_file", - ml_dyn_hi_file = panic "hscCompileCoreExpr': ml_dyn_hi_file", - ml_hie_file = panic "hscCompileCoreExpr':ml_hie_file" } + let this_loc = OsPathModLocation + { ml_hs_file_ospath = Nothing, + ml_hi_file_ospath = panic "hscCompileCoreExpr':ml_hi_file_ospath", + ml_obj_file_ospath = panic "hscCompileCoreExpr':ml_obj_file_ospath", + ml_dyn_obj_file_ospath = panic "hscCompileCoreExpr': ml_obj_file_ospath", + ml_dyn_hi_file_ospath = panic "hscCompileCoreExpr': ml_dyn_hi_file_ospath", + ml_hie_file_ospath = panic "hscCompileCoreExpr':ml_hie_file_ospath" } -- Ensure module uniqueness by giving it a name like "GhciNNNN". -- This uniqueness is needed by the JS linker. Without it we break the 1-1 ===================================== compiler/GHC/Driver/Make.hs ===================================== @@ -79,6 +79,7 @@ import GHC.Data.Bag ( listToBag ) import GHC.Data.Graph.Directed import GHC.Data.FastString import GHC.Data.Maybe ( expectJust ) +import GHC.Data.OsPath ( unsafeEncodeUtf ) import GHC.Data.StringBuffer import qualified GHC.LanguageExtensions as LangExt @@ -1915,7 +1916,7 @@ enableCodeGenWhen logger tmpfs staticLife dynLife unit_env mod_graph = tn <- newTempName logger tmpfs (tmpDir dflags) staticLife suf let dyn_tn = tn -<.> dynsuf addFilesToClean tmpfs dynLife [dyn_tn] - return (tn, dyn_tn) + return (unsafeEncodeUtf tn, unsafeEncodeUtf dyn_tn) -- We don't want to create .o or .hi files unless we have been asked -- to by the user. But we need them, so we patch their locations in -- the ModSummary with temporary files. @@ -1924,8 +1925,8 @@ enableCodeGenWhen logger tmpfs staticLife dynLife unit_env mod_graph = -- If ``-fwrite-interface` is specified, then the .o and .hi files -- are written into `-odir` and `-hidir` respectively. #16670 if gopt Opt_WriteInterface dflags - then return ((ml_hi_file ms_location, ml_dyn_hi_file ms_location) - , (ml_obj_file ms_location, ml_dyn_obj_file ms_location)) + then return ((ml_hi_file_ospath ms_location, ml_dyn_hi_file_ospath ms_location) + , (ml_obj_file_ospath ms_location, ml_dyn_obj_file_ospath ms_location)) else (,) <$> (new_temp_file (hiSuf_ dflags) (dynHiSuf_ dflags)) <*> (new_temp_file (objectSuf_ dflags) (dynObjectSuf_ dflags)) let new_dflags = case enable_spec of @@ -1934,10 +1935,10 @@ enableCodeGenWhen logger tmpfs staticLife dynLife unit_env mod_graph = EnableByteCodeAndObject -> (gopt_set dflags Opt_ByteCodeAndObjectCode) { backend = defaultBackendOf ms} let ms' = ms { ms_location = - ms_location { ml_hi_file = hi_file - , ml_obj_file = o_file - , ml_dyn_hi_file = dyn_hi_file - , ml_dyn_obj_file = dyn_o_file } + ms_location { ml_hi_file_ospath = hi_file + , ml_obj_file_ospath = o_file + , ml_dyn_hi_file_ospath = dyn_hi_file + , ml_dyn_obj_file_ospath = dyn_o_file } , ms_hspp_opts = updOptLevel 0 $ new_dflags } -- Recursive call to catch the other cases @@ -2123,7 +2124,7 @@ summariseFile hsc_env' home_unit old_summaries src_fn mb_phase maybe_buf let fopts = initFinderOpts (hsc_dflags hsc_env) -- Make a ModLocation for this file - let location = mkHomeModLocation fopts pi_mod_name src_fn + let location = mkHomeModLocation fopts pi_mod_name (unsafeEncodeUtf src_fn) -- Tell the Finder cache where it is, so that subsequent calls -- to findModule will find it, even if it's not on any search path ===================================== compiler/GHC/Driver/MakeFile.hs ===================================== @@ -32,6 +32,8 @@ import GHC.Driver.Pipeline.Monad (PipelineOutput (NoOutputFile)) import GHC.Driver.Session (pgm_F) import qualified GHC.SysTools as SysTools import GHC.Data.Graph.Directed ( SCC(..) ) +import GHC.Data.OsPath (unsafeDecodeUtf, OsPath, OsString) +import qualified GHC.Data.OsPath as OS import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Types.SourceError @@ -243,15 +245,15 @@ processDeps dflags hsc_env excl_mods root hdl m_dep_json (AcyclicSCC (ModuleNode updateJson m_dep_json (updateDepJSON include_pkg_deps pp dep_node deps) writeDependencies include_pkg_deps root hdl extra_suffixes dep_node deps where - extra_suffixes = depSuffixes dflags + extra_suffixes = map OS.os (depSuffixes dflags) include_pkg_deps = depIncludePkgDeps dflags - src_file = msHsFilePath node + src_file = msHsFileOsPath node dep_node = DepNode { dn_mod = ms_mod node, dn_src = src_file, - dn_obj = msObjFilePath node, - dn_hi = msHiFilePath node, + dn_obj = msObjFileOsPath node, + dn_hi = msHiFileOsPath node, dn_boot = isBootSummary node, dn_options = Set.fromList (ms_opts node) } @@ -285,7 +287,7 @@ processDeps dflags hsc_env excl_mods root hdl m_dep_json (AcyclicSCC (ModuleNode cpp_deps = do session <- Session <$> newIORef hsc_env parsedMod <- reflectGhc (GHC.parseModule node) session - pure (DepCpp <$> GHC.pm_extra_src_files parsedMod) + pure (DepCpp . OS.os <$> GHC.pm_extra_src_files parsedMod) -- Emit a dependency for each import import_deps is_boot idecls = @@ -309,7 +311,7 @@ findDependency hsc_env srcloc pkg imp dep_boot = do Found loc dep_mod -> pure DepHi { dep_mod, - dep_path = ml_hi_file loc, + dep_path = ml_hi_file_ospath loc, dep_unit = lookupUnitId (hsc_units hsc_env) (moduleUnitId dep_mod), dep_local, dep_boot @@ -329,7 +331,7 @@ writeDependencies :: Bool -> FilePath -> Handle -> - [FilePath] -> + [OsString] -> DepNode -> [Dep] -> IO () @@ -373,7 +375,7 @@ writeDependencies include_pkgs root hdl suffixes node deps = DepNode {dn_src, dn_obj, dn_hi, dn_boot} = node ----------------------------- -writeDependency :: FilePath -> Handle -> [FilePath] -> FilePath -> IO () +writeDependency :: FilePath -> Handle -> [OsPath] -> OsPath -> IO () -- (writeDependency r h [t1,t2] dep) writes to handle h the dependency -- t1 t2 : dep writeDependency root hdl targets dep @@ -381,25 +383,25 @@ writeDependency root hdl targets dep -- c:/foo/... -- on cygwin as make gets confused by the : -- Making relative deps avoids some instances of this. - dep' = makeRelative root dep - forOutput = escapeSpaces . reslash Forwards . normalise + dep' = OS.makeRelative (OS.os root) dep + forOutput = escapeSpaces . reslash Forwards . unsafeDecodeUtf . OS.normalise output = unwords (map forOutput targets) ++ " : " ++ forOutput dep' hPutStrLn hdl output ----------------------------- insertSuffixes - :: FilePath -- Original filename; e.g. "foo.o" - -> [String] -- Suffix prefixes e.g. ["x_", "y_"] - -> [FilePath] -- Zapped filenames e.g. ["foo.x_o", "foo.y_o"] + :: OsPath -- Original filename; e.g. "foo.o" + -> [OsString] -- Suffix prefixes e.g. ["x_", "y_"] + -> [OsPath] -- Zapped filenames e.g. ["foo.x_o", "foo.y_o"] -- Note that the extra bit gets inserted *before* the old suffix -- We assume the old suffix contains no dots, so we know where to -- split it insertSuffixes file_name extras - = [ basename <.> (extra ++ suffix) | extra <- extras ] + = [ basename OS.<.> (extra `mappend` suffix) | extra <- extras ] where - (basename, suffix) = case splitExtension file_name of + (basename, suffix) = case OS.splitExtension file_name of -- Drop the "." from the extension - (b, s) -> (b, drop 1 s) + (b, s) -> (b, OS.drop 1 s) ----------------------------------------------------------------- ===================================== compiler/GHC/Driver/MakeFile/JSON.hs ===================================== @@ -31,7 +31,7 @@ import GHC.Unit import GHC.Utils.Json import GHC.Utils.Misc import GHC.Utils.Outputable -import System.FilePath (normalise) +import GHC.Data.OsPath -------------------------------------------------------------------------------- -- Output helpers @@ -92,9 +92,9 @@ writeJsonOutput = data DepNode = DepNode { dn_mod :: Module, - dn_src :: FilePath, - dn_obj :: FilePath, - dn_hi :: FilePath, + dn_src :: OsPath, + dn_obj :: OsPath, + dn_hi :: OsPath, dn_boot :: IsBootInterface, dn_options :: Set.Set String } @@ -102,14 +102,14 @@ data DepNode = data Dep = DepHi { dep_mod :: Module, - dep_path :: FilePath, + dep_path :: OsPath, dep_unit :: Maybe UnitInfo, dep_local :: Bool, dep_boot :: IsBootInterface } | DepCpp { - dep_path :: FilePath + dep_path :: OsPath } -------------------------------------------------------------------------------- @@ -125,10 +125,10 @@ instance Semigroup PackageDeps where data Deps = Deps { - sources :: Set.Set FilePath, + sources :: Set.Set OsPath, modules :: (Set.Set ModuleName, Set.Set ModuleName), packages :: PackageDeps, - cpp :: Set.Set FilePath, + cpp :: Set.Set OsPath, options :: Set.Set String, preprocessor :: Maybe FilePath } @@ -141,7 +141,7 @@ instance ToJson DepJSON where json (DepJSON m) = JSObject [ (moduleNameString target, JSObject [ - ("sources", array sources normalise), + ("sources", array sources (unsafeDecodeUtf . normalise)), ("modules", array (fst modules) moduleNameString), ("modules-boot", array (snd modules) moduleNameString), ("packages", @@ -150,7 +150,7 @@ instance ToJson DepJSON where ((name, unit_id, package_id), mods) <- Map.toList packages ] ), - ("cpp", array cpp id), + ("cpp", array cpp unsafeDecodeUtf), ("options", array options id), ("preprocessor", maybe JSNull JSString preprocessor) ]) ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -58,6 +58,7 @@ import GHC.Iface.Make import GHC.Driver.Config.Parser import GHC.Parser.Header import GHC.Data.StringBuffer +import GHC.Data.OsPath (unsafeEncodeUtf) import GHC.Types.SourceError import GHC.Unit.Finder import Data.IORef @@ -772,7 +773,7 @@ mkOneShotModLocation :: PipeEnv -> DynFlags -> HscSource -> ModuleName -> IO Mod mkOneShotModLocation pipe_env dflags src_flavour mod_name = do let PipeEnv{ src_basename=basename, src_suffix=suff } = pipe_env - let location1 = mkHomeModLocation2 fopts mod_name basename suff + let location1 = mkHomeModLocation2 fopts mod_name (unsafeEncodeUtf basename) (unsafeEncodeUtf suff) -- Boot-ify it if necessary let location2 @@ -784,11 +785,11 @@ mkOneShotModLocation pipe_env dflags src_flavour mod_name = do -- This can't be done in mkHomeModuleLocation because -- it only applies to the module being compiles let ohi = outputHi dflags - location3 | Just fn <- ohi = location2{ ml_hi_file = fn } + location3 | Just fn <- ohi = location2{ ml_hi_file_ospath = unsafeEncodeUtf fn } | otherwise = location2 let dynohi = dynOutputHi dflags - location4 | Just fn <- dynohi = location3{ ml_dyn_hi_file = fn } + location4 | Just fn <- dynohi = location3{ ml_dyn_hi_file_ospath = unsafeEncodeUtf fn } | otherwise = location3 -- Take -o into account if present @@ -802,10 +803,10 @@ mkOneShotModLocation pipe_env dflags src_flavour mod_name = do location5 | Just ofile <- expl_o_file , let dyn_ofile = fromMaybe (ofile -<.> dynObjectSuf_ dflags) expl_dyn_o_file , isNoLink (ghcLink dflags) - = location4 { ml_obj_file = ofile - , ml_dyn_obj_file = dyn_ofile } + = location4 { ml_obj_file_ospath = unsafeEncodeUtf ofile + , ml_dyn_obj_file_ospath = unsafeEncodeUtf dyn_ofile } | Just dyn_ofile <- expl_dyn_o_file - = location4 { ml_dyn_obj_file = dyn_ofile } + = location4 { ml_dyn_obj_file_ospath = unsafeEncodeUtf dyn_ofile } | otherwise = location4 return location5 where ===================================== compiler/GHC/Iface/Errors.hs ===================================== @@ -14,6 +14,7 @@ import GHC.Utils.Panic.Plain import GHC.Driver.DynFlags import GHC.Driver.Env import GHC.Data.Maybe +import GHC.Data.OsPath import GHC.Prelude import GHC.Unit import GHC.Unit.Env @@ -55,13 +56,13 @@ cantFindInstalledErr unit_state mhome_unit profile mod_name find_result InstalledNotFound files mb_pkg | Just pkg <- mb_pkg , notHomeUnitId mhome_unit pkg - -> not_found_in_package pkg files + -> not_found_in_package pkg $ fmap unsafeDecodeUtf files | null files -> NotAModule | otherwise - -> CouldntFindInFiles files + -> CouldntFindInFiles $ fmap unsafeDecodeUtf files _ -> panic "cantFindInstalledErr" ===================================== compiler/GHC/Unit/Finder.hs ===================================== @@ -43,6 +43,9 @@ import GHC.Platform.Ways import GHC.Builtin.Names ( gHC_PRIM ) +import GHC.Data.Maybe ( expectJust ) +import GHC.Data.OsPath + import GHC.Unit.Env import GHC.Unit.Types import GHC.Unit.Module @@ -52,7 +55,6 @@ import qualified GHC.Unit.Home.Graph as HUG import GHC.Unit.State import GHC.Unit.Finder.Types -import GHC.Data.Maybe ( expectJust ) import qualified GHC.Data.ShortText as ST import GHC.Utils.Misc @@ -64,8 +66,7 @@ import GHC.Types.PkgQual import GHC.Fingerprint import Data.IORef -import System.Directory -import System.FilePath +import System.Directory.OsPath import Control.Monad import Data.Time import qualified Data.Map as M @@ -74,9 +75,10 @@ import GHC.Driver.Env import GHC.Driver.Config.Finder import GHC.Unit.Module.Graph (mgHomeModuleMap, ModuleNameHomeMap) import qualified Data.Set as Set +import qualified System.OsPath as OsPath -type FileExt = String -- Filename extension -type BaseName = String -- Basename of file +type FileExt = OsString -- Filename extension +type BaseName = OsPath -- Basename of file -- ----------------------------------------------------------------------------- -- The Finder @@ -329,7 +331,7 @@ findLookupResult fc fopts r = case r of -- implicit locations from the instances InstalledFound loc _ -> return (Found loc m) InstalledNoPackage _ -> return (NoPackage (moduleUnit m)) - InstalledNotFound fp _ -> return (NotFound{ fr_paths = fp, fr_pkg = Just (moduleUnit m) + InstalledNotFound fp _ -> return (NotFound{ fr_paths = fmap unsafeDecodeUtf fp, fr_pkg = Just (moduleUnit m) , fr_pkgs_hidden = [] , fr_mods_hidden = [] , fr_unusables = [] @@ -400,7 +402,7 @@ findHomeModule fc fopts home_unit mod_name = do InstalledFound loc _ -> Found loc (mkHomeModule home_unit mod_name) InstalledNoPackage _ -> NoPackage uid -- impossible InstalledNotFound fps _ -> NotFound { - fr_paths = fps, + fr_paths = fmap unsafeDecodeUtf fps, fr_pkg = Just uid, fr_mods_hidden = [], fr_pkgs_hidden = [], @@ -425,7 +427,7 @@ findHomePackageModule fc fopts home_unit mod_name = do InstalledFound loc _ -> Found loc (mkModule uid mod_name) InstalledNoPackage _ -> NoPackage uid -- impossible InstalledNotFound fps _ -> NotFound { - fr_paths = fps, + fr_paths = fmap unsafeDecodeUtf fps, fr_pkg = Just uid, fr_mods_hidden = [], fr_pkgs_hidden = [], @@ -461,17 +463,17 @@ findInstalledHomeModule fc fopts home_unit mod_name = do hi_dir_path = case finder_hiDir fopts of Just hiDir -> case maybe_working_dir of - Nothing -> [hiDir] - Just fp -> [fp </> hiDir] + Nothing -> [hiDir] + Just fp -> [fp </> hiDir] Nothing -> home_path hisuf = finder_hiSuf fopts mod = mkModule home_unit mod_name source_exts = - [ ("hs", mkHomeModLocationSearched fopts mod_name "hs") - , ("lhs", mkHomeModLocationSearched fopts mod_name "lhs") - , ("hsig", mkHomeModLocationSearched fopts mod_name "hsig") - , ("lhsig", mkHomeModLocationSearched fopts mod_name "lhsig") + [ (os "hs", mkHomeModLocationSearched fopts mod_name $ os "hs") + , (os "lhs", mkHomeModLocationSearched fopts mod_name $ os "lhs") + , (os "hsig", mkHomeModLocationSearched fopts mod_name $ os "hsig") + , (os "lhsig", mkHomeModLocationSearched fopts mod_name $ os "lhsig") ] -- we use mkHomeModHiOnlyLocation instead of mkHiOnlyModLocation so that @@ -496,10 +498,11 @@ findInstalledHomeModule fc fopts home_unit mod_name = do else searchPathExts search_dirs mod exts -- | Prepend the working directory to the search path. -augmentImports :: FilePath -> [FilePath] -> [FilePath] +augmentImports :: OsPath -> [OsPath] -> [OsPath] augmentImports _work_dir [] = [] -augmentImports work_dir (fp:fps) | isAbsolute fp = fp : augmentImports work_dir fps - | otherwise = (work_dir </> fp) : augmentImports work_dir fps +augmentImports work_dir (fp:fps) + | OsPath.isAbsolute fp = fp : augmentImports work_dir fps + | otherwise = (work_dir </> fp) : augmentImports work_dir fps -- | Search for a module in external packages only. findPackageModule :: FinderCache -> UnitState -> FinderOpts -> InstalledModule -> IO InstalledFindResult @@ -531,14 +534,14 @@ findPackageModule_ fc fopts mod pkg_conf = do tag = waysBuildTag (finder_ways fopts) -- hi-suffix for packages depends on the build tag. - package_hisuf | null tag = "hi" - | otherwise = tag ++ "_hi" + package_hisuf | null tag = os "hi" + | otherwise = os (tag ++ "_hi") - package_dynhisuf = waysBuildTag (addWay WayDyn (finder_ways fopts)) ++ "_hi" + package_dynhisuf = os $ waysBuildTag (addWay WayDyn (finder_ways fopts)) ++ "_hi" mk_hi_loc = mkHiOnlyModLocation fopts package_hisuf package_dynhisuf - import_dirs = map ST.unpack $ unitImportDirs pkg_conf + import_dirs = map (unsafeEncodeUtf . ST.unpack) $ unitImportDirs pkg_conf -- we never look for a .hi-boot file in an external package; -- .hi-boot files only make sense for the home package. in @@ -546,7 +549,7 @@ findPackageModule_ fc fopts mod pkg_conf = do [one] | finder_bypassHiFileCheck fopts -> -- there's only one place that this .hi file can be, so -- don't bother looking for it. - let basename = moduleNameSlashes (moduleName mod) + let basename = unsafeEncodeUtf $ moduleNameSlashes (moduleName mod) loc = mk_hi_loc one basename in return $ InstalledFound loc mod _otherwise -> @@ -555,24 +558,24 @@ findPackageModule_ fc fopts mod pkg_conf = do -- ----------------------------------------------------------------------------- -- General path searching -searchPathExts :: [FilePath] -- paths to search +searchPathExts :: [OsPath] -- paths to search -> InstalledModule -- module name -> [ ( - FileExt, -- suffix - FilePath -> BaseName -> ModLocation -- action + FileExt, -- suffix + OsPath -> BaseName -> ModLocation -- action ) ] -> IO InstalledFindResult searchPathExts paths mod exts = search to_search where - basename = moduleNameSlashes (moduleName mod) + basename = unsafeEncodeUtf $ moduleNameSlashes (moduleName mod) - to_search :: [(FilePath, ModLocation)] + to_search :: [(OsPath, ModLocation)] to_search = [ (file, fn path basename) | path <- paths, (ext,fn) <- exts, - let base | path == "." = basename + let base | path == os "." = basename | otherwise = path </> basename file = base <.> ext ] @@ -586,7 +589,7 @@ searchPathExts paths mod exts = search to_search else search rest mkHomeModLocationSearched :: FinderOpts -> ModuleName -> FileExt - -> FilePath -> BaseName -> ModLocation + -> OsPath -> BaseName -> ModLocation mkHomeModLocationSearched fopts mod suff path basename = mkHomeModLocation2 fopts mod (path </> basename) suff @@ -624,18 +627,18 @@ mkHomeModLocationSearched fopts mod suff path basename = -- ext -- The filename extension of the source file (usually "hs" or "lhs"). -mkHomeModLocation :: FinderOpts -> ModuleName -> FilePath -> ModLocation +mkHomeModLocation :: FinderOpts -> ModuleName -> OsPath -> ModLocation mkHomeModLocation dflags mod src_filename = - let (basename,extension) = splitExtension src_filename + let (basename,extension) = OsPath.splitExtension src_filename in mkHomeModLocation2 dflags mod basename extension mkHomeModLocation2 :: FinderOpts -> ModuleName - -> FilePath -- Of source module, without suffix - -> String -- Suffix + -> OsPath -- Of source module, without suffix + -> FileExt -- Suffix -> ModLocation mkHomeModLocation2 fopts mod src_basename ext = - let mod_basename = moduleNameSlashes mod + let mod_basename = unsafeEncodeUtf $ moduleNameSlashes mod obj_fn = mkObjPath fopts src_basename mod_basename dyn_obj_fn = mkDynObjPath fopts src_basename mod_basename @@ -643,51 +646,51 @@ mkHomeModLocation2 fopts mod src_basename ext = dyn_hi_fn = mkDynHiPath fopts src_basename mod_basename hie_fn = mkHiePath fopts src_basename mod_basename - in (ModLocation{ ml_hs_file = Just (src_basename <.> ext), - ml_hi_file = hi_fn, - ml_dyn_hi_file = dyn_hi_fn, - ml_obj_file = obj_fn, - ml_dyn_obj_file = dyn_obj_fn, - ml_hie_file = hie_fn }) + in (OsPathModLocation{ ml_hs_file_ospath = Just (src_basename <.> ext), + ml_hi_file_ospath = hi_fn, + ml_dyn_hi_file_ospath = dyn_hi_fn, + ml_obj_file_ospath = obj_fn, + ml_dyn_obj_file_ospath = dyn_obj_fn, + ml_hie_file_ospath = hie_fn }) mkHomeModHiOnlyLocation :: FinderOpts -> ModuleName - -> FilePath + -> OsPath -> BaseName -> ModLocation mkHomeModHiOnlyLocation fopts mod path basename = - let loc = mkHomeModLocation2 fopts mod (path </> basename) "" - in loc { ml_hs_file = Nothing } + let loc = mkHomeModLocation2 fopts mod (path </> basename) mempty + in loc { ml_hs_file_ospath = Nothing } -- This function is used to make a ModLocation for a package module. Hence why -- we explicitly pass in the interface file suffixes. -mkHiOnlyModLocation :: FinderOpts -> Suffix -> Suffix -> FilePath -> String +mkHiOnlyModLocation :: FinderOpts -> FileExt -> FileExt -> OsPath -> OsPath -> ModLocation mkHiOnlyModLocation fopts hisuf dynhisuf path basename = let full_basename = path </> basename obj_fn = mkObjPath fopts full_basename basename dyn_obj_fn = mkDynObjPath fopts full_basename basename hie_fn = mkHiePath fopts full_basename basename - in ModLocation{ ml_hs_file = Nothing, - ml_hi_file = full_basename <.> hisuf, - -- Remove the .hi-boot suffix from - -- hi_file, if it had one. We always - -- want the name of the real .hi file - -- in the ml_hi_file field. - ml_dyn_obj_file = dyn_obj_fn, - -- MP: TODO - ml_dyn_hi_file = full_basename <.> dynhisuf, - ml_obj_file = obj_fn, - ml_hie_file = hie_fn + in OsPathModLocation{ ml_hs_file_ospath = Nothing, + ml_hi_file_ospath = full_basename <.> hisuf, + -- Remove the .hi-boot suffix from + -- hi_file, if it had one. We always + -- want the name of the real .hi file + -- in the ml_hi_file field. + ml_dyn_obj_file_ospath = dyn_obj_fn, + -- MP: TODO + ml_dyn_hi_file_ospath = full_basename <.> dynhisuf, + ml_obj_file_ospath = obj_fn, + ml_hie_file_ospath = hie_fn } -- | Constructs the filename of a .o file for a given source file. -- Does /not/ check whether the .o file exists mkObjPath :: FinderOpts - -> FilePath -- the filename of the source file, minus the extension - -> String -- the module name with dots replaced by slashes - -> FilePath + -> OsPath -- the filename of the source file, minus the extension + -> OsPath -- the module name with dots replaced by slashes + -> OsPath mkObjPath fopts basename mod_basename = obj_basename <.> osuf where odir = finder_objectDir fopts @@ -700,9 +703,9 @@ mkObjPath fopts basename mod_basename = obj_basename <.> osuf -- Does /not/ check whether the .dyn_o file exists mkDynObjPath :: FinderOpts - -> FilePath -- the filename of the source file, minus the extension - -> String -- the module name with dots replaced by slashes - -> FilePath + -> OsPath -- the filename of the source file, minus the extension + -> OsPath -- the module name with dots replaced by slashes + -> OsPath mkDynObjPath fopts basename mod_basename = obj_basename <.> dynosuf where odir = finder_objectDir fopts @@ -716,9 +719,9 @@ mkDynObjPath fopts basename mod_basename = obj_basename <.> dynosuf -- Does /not/ check whether the .hi file exists mkHiPath :: FinderOpts - -> FilePath -- the filename of the source file, minus the extension - -> String -- the module name with dots replaced by slashes - -> FilePath + -> OsPath -- the filename of the source file, minus the extension + -> OsPath -- the module name with dots replaced by slashes + -> OsPath mkHiPath fopts basename mod_basename = hi_basename <.> hisuf where hidir = finder_hiDir fopts @@ -731,9 +734,9 @@ mkHiPath fopts basename mod_basename = hi_basename <.> hisuf -- Does /not/ check whether the .dyn_hi file exists mkDynHiPath :: FinderOpts - -> FilePath -- the filename of the source file, minus the extension - -> String -- the module name with dots replaced by slashes - -> FilePath + -> OsPath -- the filename of the source file, minus the extension + -> OsPath -- the module name with dots replaced by slashes + -> OsPath mkDynHiPath fopts basename mod_basename = hi_basename <.> dynhisuf where hidir = finder_hiDir fopts @@ -746,9 +749,9 @@ mkDynHiPath fopts basename mod_basename = hi_basename <.> dynhisuf -- Does /not/ check whether the .hie file exists mkHiePath :: FinderOpts - -> FilePath -- the filename of the source file, minus the extension - -> String -- the module name with dots replaced by slashes - -> FilePath + -> OsPath -- the filename of the source file, minus the extension + -> OsPath -- the module name with dots replaced by slashes + -> OsPath mkHiePath fopts basename mod_basename = hie_basename <.> hiesuf where hiedir = finder_hieDir fopts @@ -769,23 +772,23 @@ mkStubPaths :: FinderOpts -> ModuleName -> ModLocation - -> FilePath + -> OsPath mkStubPaths fopts mod location = let stubdir = finder_stubDir fopts - mod_basename = moduleNameSlashes mod - src_basename = dropExtension $ expectJust "mkStubPaths" - (ml_hs_file location) + mod_basename = unsafeEncodeUtf $ moduleNameSlashes mod + src_basename = OsPath.dropExtension $ expectJust "mkStubPaths" + (ml_hs_file_ospath location) stub_basename0 | Just dir <- stubdir = dir </> mod_basename | otherwise = src_basename - stub_basename = stub_basename0 ++ "_stub" + stub_basename = stub_basename0 `mappend` os "_stub" in - stub_basename <.> "h" + stub_basename <.> os "h" -- ----------------------------------------------------------------------------- -- findObjectLinkable isn't related to the other stuff in here, ===================================== compiler/GHC/Unit/Finder/Types.hs ===================================== @@ -9,6 +9,7 @@ where import GHC.Prelude import GHC.Unit +import GHC.Data.OsPath import qualified Data.Map as M import GHC.Fingerprint import GHC.Platform.Ways @@ -31,7 +32,7 @@ data FinderCache = FinderCache { fcModuleCache :: (IORef FinderCacheState) data InstalledFindResult = InstalledFound ModLocation InstalledModule | InstalledNoPackage UnitId - | InstalledNotFound [FilePath] (Maybe UnitId) + | InstalledNotFound [OsPath] (Maybe UnitId) -- | The result of searching for an imported module. -- @@ -70,7 +71,7 @@ data FindResult -- -- Should be taken from 'DynFlags' via 'initFinderOpts'. data FinderOpts = FinderOpts - { finder_importPaths :: [FilePath] + { finder_importPaths :: [OsPath] -- ^ Where are we allowed to look for Modules and Source files , finder_lookupHomeInterfaces :: Bool -- ^ When looking up a home module: @@ -88,17 +89,17 @@ data FinderOpts = FinderOpts , finder_enableSuggestions :: Bool -- ^ If we encounter unknown modules, should we suggest modules -- that have a similar name. - , finder_workingDirectory :: Maybe FilePath + , finder_workingDirectory :: Maybe OsPath , finder_thisPackageName :: Maybe FastString , finder_hiddenModules :: Set.Set ModuleName , finder_reexportedModules :: Set.Set ModuleName - , finder_hieDir :: Maybe FilePath - , finder_hieSuf :: String - , finder_hiDir :: Maybe FilePath - , finder_hiSuf :: String - , finder_dynHiSuf :: String - , finder_objectDir :: Maybe FilePath - , finder_objectSuf :: String - , finder_dynObjectSuf :: String - , finder_stubDir :: Maybe FilePath + , finder_hieDir :: Maybe OsPath + , finder_hieSuf :: OsString + , finder_hiDir :: Maybe OsPath + , finder_hiSuf :: OsString + , finder_dynHiSuf :: OsString + , finder_objectDir :: Maybe OsPath + , finder_objectSuf :: OsString + , finder_dynObjectSuf :: OsString + , finder_stubDir :: Maybe OsPath } deriving Show ===================================== compiler/GHC/Unit/Module/Location.hs ===================================== @@ -1,6 +1,17 @@ +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE ViewPatterns #-} -- | Module location module GHC.Unit.Module.Location - ( ModLocation(..) + ( ModLocation + ( .. + , ml_hs_file + , ml_hi_file + , ml_dyn_hi_file + , ml_obj_file + , ml_dyn_obj_file + , ml_hie_file + ) + , pattern ModLocation , addBootSuffix , addBootSuffix_maybe , addBootSuffixLocn_maybe @@ -11,15 +22,19 @@ module GHC.Unit.Module.Location where import GHC.Prelude + +import GHC.Data.OsPath import GHC.Unit.Types import GHC.Utils.Outputable +import qualified System.OsString as OsString + -- | Module Location -- -- Where a module lives on the file system: the actual locations -- of the .hs, .hi, .dyn_hi, .o, .dyn_o and .hie files, if we have them. -- --- For a module in another unit, the ml_hs_file and ml_obj_file components of +-- For a module in another unit, the ml_hs_file_ospath and ml_obj_file_ospath components of -- ModLocation are undefined. -- -- The locations specified by a ModLocation may or may not @@ -38,31 +53,31 @@ import GHC.Utils.Outputable -- boot suffixes in mkOneShotModLocation. data ModLocation - = ModLocation { - ml_hs_file :: Maybe FilePath, + = OsPathModLocation { + ml_hs_file_ospath :: Maybe OsPath, -- ^ The source file, if we have one. Package modules -- probably don't have source files. - ml_hi_file :: FilePath, + ml_hi_file_ospath :: OsPath, -- ^ Where the .hi file is, whether or not it exists -- yet. Always of form foo.hi, even if there is an -- hi-boot file (we add the -boot suffix later) - ml_dyn_hi_file :: FilePath, + ml_dyn_hi_file_ospath :: OsPath, -- ^ Where the .dyn_hi file is, whether or not it exists -- yet. - ml_obj_file :: FilePath, + ml_obj_file_ospath :: OsPath, -- ^ Where the .o file is, whether or not it exists yet. -- (might not exist either because the module hasn't -- been compiled yet, or because it is part of a -- unit with a .a file) - ml_dyn_obj_file :: FilePath, + ml_dyn_obj_file_ospath :: OsPath, -- ^ Where the .dy file is, whether or not it exists -- yet. - ml_hie_file :: FilePath + ml_hie_file_ospath :: OsPath -- ^ Where the .hie file is, whether or not it exists -- yet. } deriving Show @@ -71,18 +86,18 @@ instance Outputable ModLocation where ppr = text . show -- | Add the @-boot@ suffix to .hs, .hi and .o files -addBootSuffix :: FilePath -> FilePath -addBootSuffix path = path ++ "-boot" +addBootSuffix :: OsPath -> OsPath +addBootSuffix path = path `mappend` os "-boot" -- | Remove the @-boot@ suffix to .hs, .hi and .o files -removeBootSuffix :: FilePath -> FilePath -removeBootSuffix "-boot" = [] -removeBootSuffix (x:xs) = x : removeBootSuffix xs -removeBootSuffix [] = error "removeBootSuffix: no -boot suffix" - +removeBootSuffix :: OsPath -> OsPath +removeBootSuffix pathWithBootSuffix = + case OsString.stripSuffix (os "-boot") pathWithBootSuffix of + Just path -> path + Nothing -> error "removeBootSuffix: no -boot suffix" -- | Add the @-boot@ suffix if the @Bool@ argument is @True@ -addBootSuffix_maybe :: IsBootInterface -> FilePath -> FilePath +addBootSuffix_maybe :: IsBootInterface -> OsPath -> OsPath addBootSuffix_maybe is_boot path = case is_boot of IsBoot -> addBootSuffix path NotBoot -> path @@ -95,22 +110,50 @@ addBootSuffixLocn_maybe is_boot locn = case is_boot of -- | Add the @-boot@ suffix to all file paths associated with the module addBootSuffixLocn :: ModLocation -> ModLocation addBootSuffixLocn locn - = locn { ml_hs_file = fmap addBootSuffix (ml_hs_file locn) - , ml_hi_file = addBootSuffix (ml_hi_file locn) - , ml_dyn_hi_file = addBootSuffix (ml_dyn_hi_file locn) - , ml_obj_file = addBootSuffix (ml_obj_file locn) - , ml_dyn_obj_file = addBootSuffix (ml_dyn_obj_file locn) - , ml_hie_file = addBootSuffix (ml_hie_file locn) } + = locn { ml_hs_file_ospath = fmap addBootSuffix (ml_hs_file_ospath locn) + , ml_hi_file_ospath = addBootSuffix (ml_hi_file_ospath locn) + , ml_dyn_hi_file_ospath = addBootSuffix (ml_dyn_hi_file_ospath locn) + , ml_obj_file_ospath = addBootSuffix (ml_obj_file_ospath locn) + , ml_dyn_obj_file_ospath = addBootSuffix (ml_dyn_obj_file_ospath locn) + , ml_hie_file_ospath = addBootSuffix (ml_hie_file_ospath locn) } -- | Add the @-boot@ suffix to all output file paths associated with the -- module, not including the input file itself addBootSuffixLocnOut :: ModLocation -> ModLocation addBootSuffixLocnOut locn - = locn { ml_hi_file = addBootSuffix (ml_hi_file locn) - , ml_dyn_hi_file = addBootSuffix (ml_dyn_hi_file locn) - , ml_obj_file = addBootSuffix (ml_obj_file locn) - , ml_dyn_obj_file = addBootSuffix (ml_dyn_obj_file locn) - , ml_hie_file = addBootSuffix (ml_hie_file locn) + = locn { ml_hi_file_ospath = addBootSuffix (ml_hi_file_ospath locn) + , ml_dyn_hi_file_ospath = addBootSuffix (ml_dyn_hi_file_ospath locn) + , ml_obj_file_ospath = addBootSuffix (ml_obj_file_ospath locn) + , ml_dyn_obj_file_ospath = addBootSuffix (ml_dyn_obj_file_ospath locn) + , ml_hie_file_ospath = addBootSuffix (ml_hie_file_ospath locn) } - +-- ---------------------------------------------------------------------------- +-- Helpers for backwards compatibility +-- ---------------------------------------------------------------------------- + +pattern ModLocation :: Maybe 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 + } <- 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) + } where + ModLocation ml_hs_file ml_hi_file ml_dyn_hi_file ml_obj_file ml_dyn_obj_file ml_hie_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 + } ===================================== compiler/GHC/Unit/Module/ModSummary.hs ===================================== @@ -17,6 +17,11 @@ module GHC.Unit.Module.ModSummary , msHsFilePath , msObjFilePath , msDynObjFilePath + , msHsFileOsPath + , msHiFileOsPath + , msDynHiFileOsPath + , msObjFileOsPath + , msDynObjFileOsPath , msDeps , isBootSummary , findTarget @@ -38,6 +43,7 @@ import GHC.Types.Target import GHC.Types.PkgQual import GHC.Data.Maybe +import GHC.Data.OsPath (OsPath) import GHC.Data.StringBuffer ( StringBuffer ) import GHC.Utils.Fingerprint @@ -148,6 +154,13 @@ msDynHiFilePath ms = ml_dyn_hi_file (ms_location ms) msObjFilePath ms = ml_obj_file (ms_location ms) msDynObjFilePath ms = ml_dyn_obj_file (ms_location ms) +msHsFileOsPath, msDynHiFileOsPath, msHiFileOsPath, msObjFileOsPath, msDynObjFileOsPath :: ModSummary -> OsPath +msHsFileOsPath ms = expectJust "msHsFilePath" (ml_hs_file_ospath (ms_location ms)) +msHiFileOsPath ms = ml_hi_file_ospath (ms_location ms) +msDynHiFileOsPath ms = ml_dyn_hi_file_ospath (ms_location ms) +msObjFileOsPath ms = ml_obj_file_ospath (ms_location ms) +msDynObjFileOsPath ms = ml_dyn_obj_file_ospath (ms_location ms) + -- | Did this 'ModSummary' originate from a hs-boot file? isBootSummary :: ModSummary -> IsBootInterface isBootSummary ms = if ms_hsc_src ms == HsBootFile then IsBoot else NotBoot ===================================== compiler/ghc.cabal.in ===================================== @@ -117,6 +117,7 @@ Library filepath >= 1 && < 1.6, os-string >= 2.0.1 && < 2.1, template-haskell == 2.22.*, + os-string >= 2.0.1 && < 2.1, hpc >= 0.6 && < 0.8, transformers >= 0.5 && < 0.7, exceptions == 0.10.*, ===================================== ghc/ghc-bin.cabal.in ===================================== @@ -36,7 +36,7 @@ Executable ghc bytestring >= 0.9 && < 0.13, directory >= 1 && < 1.4, process >= 1 && < 1.7, - filepath >= 1 && < 1.6, + filepath >= 1.5 && < 1.6, containers >= 0.5 && < 0.8, transformers >= 0.5 && < 0.7, ghc-boot == @ProjectVersionMunged@, ===================================== testsuite/tests/count-deps/CountDepsAst.stdout ===================================== @@ -70,6 +70,7 @@ GHC.Data.List.Infinite GHC.Data.List.SetOps GHC.Data.Maybe GHC.Data.OrdList +GHC.Data.OsPath GHC.Data.Pair GHC.Data.SmallArray GHC.Data.Strict ===================================== testsuite/tests/count-deps/CountDepsParser.stdout ===================================== @@ -71,6 +71,7 @@ GHC.Data.List.Infinite GHC.Data.List.SetOps GHC.Data.Maybe GHC.Data.OrdList +GHC.Data.OsPath GHC.Data.Pair GHC.Data.SmallArray GHC.Data.Strict View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c0cce5dcdba013e5a040d5780316570b... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c0cce5dcdba013e5a040d5780316570b... You're receiving this email because of your account on gitlab.haskell.org.