[Git][ghc/ghc][wip/fendor/os-string-modlocation] Migrate `Finder` component to `OsPath`
Hannes Siebenhandl (@fendor)
gitlab at gitlab.haskell.org
Tue Apr 2 11:59:10 UTC 2024
Hannes Siebenhandl pushed to branch wip/fendor/os-string-modlocation at Glasgow Haskell Compiler / GHC
Commits:
e67e4a42 by Fendor at 2024-04-02T13:58:52+02:00
Migrate `Finder` component to `OsPath`
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-encapsuled, this requires only a
minimal amount of changes in other modules.
Bump to haddock submodule for `ModLocation` changes.
- - - - -
17 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/Pipeline/Execute.hs
- compiler/GHC/Iface/Errors.hs
- compiler/GHC/Iface/Make.hs
- compiler/GHC/Unit/Finder.hs
- compiler/GHC/Unit/Finder/Types.hs
- compiler/GHC/Unit/Module/Location.hs
- compiler/ghc.cabal.in
- utils/haddock
Changes:
=====================================
compiler/GHC.hs
=====================================
@@ -76,6 +76,12 @@ module GHC (
ModuleGraph, emptyMG, mapMG, mkModuleGraph, mgModSummaries,
mgLookupModule,
ModSummary(..), ms_mod_name, ModLocation(..),
+ ml_hs_file,
+ ml_hi_file,
+ ml_dyn_hi_file,
+ ml_obj_file,
+ ml_dyn_obj_file,
+ ml_hie_file,
getModSummary,
getModuleGraph,
isLoaded,
=====================================
compiler/GHC/Data/OsPath.hs
=====================================
@@ -0,0 +1,19 @@
+module GHC.Data.OsPath
+ (
+ -- * OsPath initialisation and transformation
+ OsPath
+ , unsafeDecodeUtf
+ , unsafeEncodeUtf
+ -- * Common utility functions
+ , (</>)
+ , (<.>)
+ )
+ where
+
+import GHC.Prelude
+
+import System.OsPath
+import Data.Either
+
+unsafeDecodeUtf :: OsPath -> FilePath
+unsafeDecodeUtf = fromRight (error "unsafeEncodeUtf: Internal error") . decodeUtf
=====================================
compiler/GHC/Data/Strict.hs
=====================================
@@ -9,8 +9,11 @@
module GHC.Data.Strict (
Maybe(Nothing, Just),
fromMaybe,
+ GHC.Data.Strict.maybe,
Pair(And),
-
+ expectJust,
+ fromLazy,
+ toLazy,
-- Not used at the moment:
--
-- Either(Left, Right),
@@ -18,9 +21,12 @@ module GHC.Data.Strict (
) where
import GHC.Prelude hiding (Maybe(..), Either(..))
+import GHC.Stack.Types
+
import Control.Applicative
import Data.Semigroup
import Data.Data
+import qualified Data.Maybe as Lazy
data Maybe a = Nothing | Just !a
deriving (Eq, Ord, Show, Functor, Foldable, Traversable, Data)
@@ -29,6 +35,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
@@ -37,6 +47,19 @@ altMaybe :: Maybe a -> Maybe a -> Maybe a
altMaybe Nothing r = r
altMaybe l _ = l
+fromLazy :: Lazy.Maybe a -> Maybe a
+fromLazy (Lazy.Just a) = Just a
+fromLazy Lazy.Nothing = Nothing
+
+toLazy :: Maybe a -> Lazy.Maybe a
+toLazy (Just a) = Lazy.Just a
+toLazy Nothing = Lazy.Nothing
+
+expectJust :: HasCallStack => String -> Maybe a -> a
+{-# INLINE expectJust #-}
+expectJust _ (Just x) = x
+expectJust err Nothing = error ("expectJust " ++ err)
+
instance Semigroup a => Semigroup (Maybe a) where
Nothing <> b = b
a <> Nothing = a
=====================================
compiler/GHC/Driver/Backpack.hs
=====================================
@@ -74,6 +74,7 @@ import GHC.Linker.Types
import qualified GHC.LanguageExtensions as LangExt
import GHC.Data.Maybe
+import GHC.Data.OsPath (unsafeEncodeUtf)
import GHC.Data.StringBuffer
import GHC.Data.FastString
import qualified GHC.Data.EnumSet as EnumSet
@@ -772,7 +773,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) (unsafeEncodeUtf "hsig")
env <- getBkpEnv
src_hash <- liftIO $ getFileHash (bkp_filename env)
@@ -855,12 +856,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 -> unsafeEncodeUtf "hsig"
+ HsBootFile -> unsafeEncodeUtf "hs-boot"
+ HsSrcFile -> unsafeEncodeUtf "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
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
=====================================
@@ -5,30 +5,31 @@ module GHC.Driver.Config.Finder (
import GHC.Prelude
+import qualified GHC.Data.Strict as Strict
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 $ Strict.fromLazy $ 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 $ Strict.fromLazy $ hieDir flags
+ , finder_hieSuf = unsafeEncodeUtf $ hieSuf flags
+ , finder_hiDir = fmap unsafeEncodeUtf $ Strict.fromLazy $ hiDir flags
+ , finder_hiSuf = unsafeEncodeUtf $ hiSuf_ flags
+ , finder_dynHiSuf = unsafeEncodeUtf $ dynHiSuf_ flags
+ , finder_objectDir = fmap unsafeEncodeUtf $ Strict.fromLazy $ objectDir flags
+ , finder_objectSuf = unsafeEncodeUtf $ objectSuf_ flags
+ , finder_dynObjectSuf = unsafeEncodeUtf $ dynObjectSuf_ flags
+ , finder_stubDir = fmap unsafeEncodeUtf $ Strict.fromLazy $ stubDir flags
}
=====================================
compiler/GHC/Driver/Main.hs
=====================================
@@ -264,6 +264,8 @@ import qualified GHC.LanguageExtensions as LangExt
import GHC.Data.FastString
import GHC.Data.Bag
+import GHC.Data.OsPath (unsafeEncodeUtf)
+import qualified GHC.Data.Strict as Strict
import GHC.Data.StringBuffer
import qualified GHC.Data.Stream as Stream
import GHC.Data.Stream (Stream)
@@ -2106,12 +2108,12 @@ 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 = ModLocation{ ml_hs_file_ = Strict.Just $ unsafeEncodeUtf 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"}
-------------------- Stuff for new code gen ---------------------
@@ -2346,12 +2348,12 @@ 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 = ModLocation{ ml_hs_file_ = Strict.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" }
ds_result <- hscDesugar' iNTERACTIVELoc tc_gblenv
{- Simplify -}
@@ -2630,12 +2632,12 @@ 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 = ModLocation{ ml_hs_file_ = Strict.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" }
-- 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
=====================================
@@ -72,10 +72,12 @@ import GHC.Iface.Load ( cannotFindModule )
import GHC.IfaceToCore ( typecheckIface )
import GHC.Iface.Recomp ( RecompileRequired(..), CompileReason(..) )
+import qualified GHC.Data.Strict as Strict
import GHC.Data.Bag ( listToBag )
import GHC.Data.Graph.Directed
import GHC.Data.FastString
import GHC.Data.Maybe ( expectJust )
+import GHC.Data.OsPath ( unsafeEncodeUtf, unsafeDecodeUtf )
import GHC.Data.StringBuffer
import qualified GHC.LanguageExtensions as LangExt
@@ -336,12 +338,15 @@ warnMissingHomeModules dflags targets mod_graph =
-> moduleName (ms_mod mod) == name
&& tuid == ms_unitid mod
TargetFile target_file _
- | Just mod_file <- ml_hs_file (ms_location mod)
+ | Strict.Just mod_file <- ml_hs_file_ (ms_location mod)
->
- augmentByWorkingDirectory dflags target_file == mod_file ||
+ let
+ target_os_file = unsafeEncodeUtf target_file
+ in
+ augmentByWorkingDirectory dflags target_file == unsafeDecodeUtf mod_file ||
-- Don't warn on B.hs-boot if B.hs is specified (#16551)
- addBootSuffix target_file == mod_file ||
+ addBootSuffix target_os_file == mod_file ||
-- We can get a file target even if a module name was
-- originally specified in a command line because it can
@@ -1830,7 +1835,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.
@@ -1839,8 +1844,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_ ms_location, ml_dyn_hi_file_ ms_location)
+ , (ml_obj_file_ ms_location, ml_dyn_obj_file_ ms_location))
else (,) <$> (new_temp_file (hiSuf_ dflags) (dynHiSuf_ dflags))
<*> (new_temp_file (objectSuf_ dflags) (dynObjectSuf_ dflags))
let new_dflags = case enable_spec of
@@ -1849,10 +1854,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_ = hi_file
+ , ml_obj_file_ = o_file
+ , ml_dyn_hi_file_ = dyn_hi_file
+ , ml_dyn_obj_file_ = dyn_o_file }
, ms_hspp_opts = updOptLevel 0 $ new_dflags
}
-- Recursive call to catch the other cases
@@ -2037,7 +2042,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
=====================================
@@ -24,6 +24,7 @@ import GHC.Driver.Env
import GHC.Driver.Errors.Types
import qualified GHC.SysTools as SysTools
import GHC.Data.Graph.Directed ( SCC(..) )
+import GHC.Data.OsPath (unsafeDecodeUtf)
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Types.SourceError
@@ -297,7 +298,7 @@ findDependency hsc_env srcloc pkg imp is_boot include_pkg_deps = do
Found loc _
-- Home package: just depend on the .hi or hi-boot file
| isJust (ml_hs_file loc) || include_pkg_deps
- -> return (Just (addBootSuffix_maybe is_boot (ml_hi_file loc)))
+ -> return (Just (unsafeDecodeUtf $ addBootSuffix_maybe is_boot (ml_hi_file_ loc)))
-- Not in this package: we don't need a dependency
| otherwise
=====================================
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
@@ -759,7 +760,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
@@ -771,11 +772,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_ = 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_ = unsafeEncodeUtf fn }
| otherwise = location3
-- Take -o into account if present
@@ -789,10 +790,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_ = unsafeEncodeUtf ofile
+ , ml_dyn_obj_file_ = unsafeEncodeUtf dyn_ofile }
| Just dyn_ofile <- expl_dyn_o_file
- = location4 { ml_dyn_obj_file = dyn_ofile }
+ = location4 { ml_dyn_obj_file_ = 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/Iface/Make.hs
=====================================
@@ -300,7 +300,7 @@ mkIface_ hsc_env
trust_info = setSafeMode safe_mode
annotations = map mkIfaceAnnotation anns
icomplete_matches = map mkIfaceCompleteMatch complete_matches
- !rdrs = maybeGlobalRdrEnv rdr_env
+ _ = maybeGlobalRdrEnv rdr_env
ModIface {
mi_module = this_mod,
@@ -323,7 +323,7 @@ mkIface_ hsc_env
mi_fixities = fixities,
mi_warns = warns,
mi_anns = annotations,
- mi_globals = rdrs,
+ mi_globals = Nothing,
mi_used_th = used_th,
mi_decls = decls,
mi_extra_decls = extra_decls,
=====================================
compiler/GHC/Unit/Finder.hs
=====================================
@@ -42,6 +42,9 @@ import GHC.Platform.Ways
import GHC.Builtin.Names ( gHC_PRIM )
+import qualified GHC.Data.Strict as Strict
+import GHC.Data.OsPath
+
import GHC.Unit.Env
import GHC.Unit.Types
import GHC.Unit.Module
@@ -49,7 +52,6 @@ import GHC.Unit.Home
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
@@ -61,8 +63,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
@@ -70,9 +71,10 @@ import GHC.Driver.Env
( hsc_home_unit_maybe, HscEnv(hsc_FC, hsc_dflags, hsc_unit_env) )
import GHC.Driver.Config.Finder
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 = OsPath -- Filename extension
+type BaseName = OsPath -- Basename of file
-- -----------------------------------------------------------------------------
-- The Finder
@@ -286,7 +288,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 = []
@@ -357,7 +359,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 = [],
@@ -382,7 +384,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 = [],
@@ -413,22 +415,22 @@ findInstalledHomeModule fc fopts home_unit mod_name = do
let
maybe_working_dir = finder_workingDirectory fopts
home_path = case maybe_working_dir of
- Nothing -> finder_importPaths fopts
- Just fp -> augmentImports fp (finder_importPaths fopts)
+ Strict.Nothing -> finder_importPaths fopts
+ Strict.Just fp -> augmentImports fp (finder_importPaths fopts)
hi_dir_path =
case finder_hiDir fopts of
- Just hiDir -> case maybe_working_dir of
- Nothing -> [hiDir]
- Just fp -> [fp </> hiDir]
- Nothing -> home_path
+ Strict.Just hiDir -> case maybe_working_dir of
+ Strict.Nothing -> [hiDir]
+ Strict.Just fp -> [fp </> hiDir]
+ Strict.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")
+ [ (unsafeEncodeUtf "hs", mkHomeModLocationSearched fopts mod_name $ unsafeEncodeUtf "hs")
+ , (unsafeEncodeUtf "lhs", mkHomeModLocationSearched fopts mod_name $ unsafeEncodeUtf "lhs")
+ , (unsafeEncodeUtf "hsig", mkHomeModLocationSearched fopts mod_name $ unsafeEncodeUtf "hsig")
+ , (unsafeEncodeUtf "lhsig", mkHomeModLocationSearched fopts mod_name $ unsafeEncodeUtf "lhsig")
]
-- we use mkHomeModHiOnlyLocation instead of mkHiOnlyModLocation so that
@@ -453,9 +455,9 @@ 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
+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.
@@ -488,14 +490,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 = unsafeEncodeUtf $ "hi"
+ | otherwise = unsafeEncodeUtf $ tag ++ "_hi"
- package_dynhisuf = waysBuildTag (addWay WayDyn (finder_ways fopts)) ++ "_hi"
+ package_dynhisuf = unsafeEncodeUtf $ 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
@@ -503,7 +505,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 ->
@@ -512,24 +514,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
+ 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 == unsafeEncodeUtf "." = basename
| otherwise = path </> basename
file = base <.> ext
]
@@ -543,7 +545,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
@@ -581,18 +583,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
+ -> OsPath -- 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
@@ -600,72 +602,72 @@ 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 (ModLocation{ ml_hs_file_ = Strict.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 })
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_ = Strict.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 -> OsPath -> OsPath -> 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,
+ in ModLocation{ ml_hs_file_ = Strict.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,
+ 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
+ ml_dyn_hi_file_ = full_basename <.> dynhisuf,
+ ml_obj_file_ = obj_fn,
+ ml_hie_file_ = 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
-mkObjPath fopts basename mod_basename = obj_basename <.> osuf
+ -> 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 OsPath.<.> osuf
where
odir = finder_objectDir fopts
osuf = finder_objectSuf fopts
- obj_basename | Just dir <- odir = dir </> mod_basename
+ obj_basename | Strict.Just dir <- odir = dir OsPath.</> mod_basename
| otherwise = basename
-- | Constructs the filename of a .dyn_o file for a given source file.
-- 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
dynosuf = finder_dynObjectSuf fopts
- obj_basename | Just dir <- odir = dir </> mod_basename
+ obj_basename | Strict.Just dir <- odir = dir </> mod_basename
| otherwise = basename
@@ -673,45 +675,45 @@ 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
hisuf = finder_hiSuf fopts
- hi_basename | Just dir <- hidir = dir </> mod_basename
+ hi_basename | Strict.Just dir <- hidir = dir </> mod_basename
| otherwise = basename
-- | Constructs the filename of a .dyn_hi file for a given source file.
-- 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
dynhisuf = finder_dynHiSuf fopts
- hi_basename | Just dir <- hidir = dir </> mod_basename
+ hi_basename | Strict.Just dir <- hidir = dir </> mod_basename
| otherwise = basename
-- | Constructs the filename of a .hie file for a given source file.
-- 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
hiesuf = finder_hieSuf fopts
- hie_basename | Just dir <- hiedir = dir </> mod_basename
+ hie_basename | Strict.Just dir <- hiedir = dir </> mod_basename
| otherwise = basename
@@ -726,23 +728,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 $ Strict.expectJust "mkStubPaths"
+ (ml_hs_file_ location)
stub_basename0
- | Just dir <- stubdir = dir </> mod_basename
+ | Strict.Just dir <- stubdir = dir </> mod_basename
| otherwise = src_basename
- stub_basename = stub_basename0 ++ "_stub"
+ stub_basename = stub_basename0 `mappend` unsafeEncodeUtf "_stub"
in
- stub_basename <.> "h"
+ stub_basename <.> unsafeEncodeUtf "h"
-- -----------------------------------------------------------------------------
-- findLinkable 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 qualified GHC.Data.Strict as Strict
import qualified Data.Map as M
import GHC.Fingerprint
import GHC.Platform.Ways
@@ -16,6 +17,7 @@ import GHC.Platform.Ways
import Data.IORef
import GHC.Data.FastString
import qualified Data.Set as Set
+import System.OsPath (OsPath)
-- | The 'FinderCache' maps modules to the result of
-- searching for that module. It records the results of searching for
@@ -31,7 +33,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 +72,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 +90,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 :: Strict.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 :: Strict.Maybe OsPath
+ , finder_hieSuf :: OsPath
+ , finder_hiDir :: Strict.Maybe OsPath
+ , finder_hiSuf :: OsPath
+ , finder_dynHiSuf :: OsPath
+ , finder_objectDir :: Strict.Maybe OsPath
+ , finder_objectSuf :: OsPath
+ , finder_dynObjectSuf :: OsPath
+ , finder_stubDir :: Strict.Maybe OsPath
} deriving Show
=====================================
compiler/GHC/Unit/Module/Location.hs
=====================================
@@ -7,12 +7,21 @@ module GHC.Unit.Module.Location
, addBootSuffixLocn
, addBootSuffixLocnOut
, removeBootSuffix
+ , ml_hs_file
+ , ml_hi_file
+ , ml_dyn_hi_file
+ , ml_obj_file
+ , ml_dyn_obj_file
+ , ml_hie_file
)
where
import GHC.Prelude
import GHC.Unit.Types
import GHC.Utils.Outputable
+import qualified GHC.Data.Strict as Strict
+import System.OsPath
+import GHC.Data.OsPath
-- | Module Location
--
@@ -39,30 +48,30 @@ import GHC.Utils.Outputable
data ModLocation
= ModLocation {
- ml_hs_file :: Maybe FilePath,
+ ml_hs_file_ :: Strict.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,
-- ^ 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,
-- ^ Where the .dyn_hi file is, whether or not it exists
-- yet.
- ml_obj_file :: FilePath,
+ ml_obj_file_ :: 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,
-- ^ Where the .dy file is, whether or not it exists
-- yet.
- ml_hie_file :: FilePath
+ ml_hie_file_ :: OsPath
-- ^ Where the .hie file is, whether or not it exists
-- yet.
} deriving Show
@@ -71,8 +80,8 @@ 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` unsafeEncodeUtf "-boot"
-- | Remove the @-boot@ suffix to .hs, .hi and .o files
removeBootSuffix :: FilePath -> FilePath
@@ -82,7 +91,7 @@ removeBootSuffix [] = 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 +104,42 @@ 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_ = 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) }
-- | 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_ = 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)
}
+-- ----------------------------------------------------------------------------
+-- Helpers for backwards compatibility
+-- ----------------------------------------------------------------------------
+ml_hs_file :: ModLocation -> Maybe FilePath
+ml_hs_file = fmap unsafeDecodeUtf . Strict.toLazy . ml_hs_file_
+
+ml_hi_file :: ModLocation -> FilePath
+ml_hi_file = unsafeDecodeUtf . ml_hi_file_
+
+ml_dyn_hi_file :: ModLocation -> FilePath
+ml_dyn_hi_file = unsafeDecodeUtf . ml_dyn_hi_file_
+
+ml_obj_file :: ModLocation -> FilePath
+ml_obj_file = unsafeDecodeUtf . ml_obj_file_
+
+ml_dyn_obj_file :: ModLocation -> FilePath
+ml_dyn_obj_file = unsafeDecodeUtf . ml_dyn_obj_file_
+
+ml_hie_file :: ModLocation -> FilePath
+ml_hie_file = unsafeDecodeUtf . ml_hie_file_
=====================================
compiler/ghc.cabal.in
=====================================
@@ -428,6 +428,7 @@ Library
GHC.Data.List.SetOps
GHC.Data.Maybe
GHC.Data.OrdList
+ GHC.Data.OsPath
GHC.Data.Pair
GHC.Data.SmallArray
GHC.Data.Stream
=====================================
utils/haddock
=====================================
@@ -1 +1 @@
-Subproject commit 504d4c1842db93704b4c5e158ecc3af7050ba9fe
+Subproject commit 1ef6c187b31f85dfd7133b150b211ec9140cc84a
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e67e4a42d53d3b37d1bfbed895b070c0bf95bbc8
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e67e4a42d53d3b37d1bfbed895b070c0bf95bbc8
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240402/de375aff/attachment-0001.html>
More information about the ghc-commits
mailing list