diff options
| author | Sylvain Henry <sylvain@haskus.fr> | 2021-05-21 16:51:59 +0200 |
|---|---|---|
| committer | Sylvain Henry <sylvain@haskus.fr> | 2021-06-07 10:35:39 +0200 |
| commit | 4dc681c7c0345ee8ae268749d98b419dabf6a3bc (patch) | |
| tree | ab05546d61b2d90f2fc9e652a13da48ce89096ae /compiler/GHC/Utils/TmpFs.hs | |
| parent | 5e1a224435fc6ebd34d02566f17fe1eaf5475bab (diff) | |
| download | haskell-4dc681c7c0345ee8ae268749d98b419dabf6a3bc.tar.gz | |
Make Logger independent of DynFlags
Introduce LogFlags as a independent subset of DynFlags used for logging.
As a consequence in many places we don't have to pass both Logger and
DynFlags anymore.
The main reason for this refactoring is that I want to refactor the
systools interfaces: for now many systools functions use DynFlags both
to use the Logger and to fetch their parameters (e.g. ldInputs for the
linker). I'm interested in refactoring the way they fetch their
parameters (i.e. use dedicated XxxOpts data types instead of DynFlags)
for #19877. But if I did this refactoring before refactoring the Logger,
we would have duplicate parameters (e.g. ldInputs from DynFlags and
linkerInputs from LinkerOpts). Hence this patch first.
Some flags don't really belong to LogFlags because they are subsystem
specific (e.g. most DumpFlags). For example -ddump-asm should better be
passed in NCGConfig somehow. This patch doesn't fix this tight coupling:
the dump flags are part of the UI but they are passed all the way down
for example to infer the file name for the dumps.
Because LogFlags are a subset of the DynFlags, we must update the former
when the latter changes (not so often). As a consequence we now use
accessors to read/write DynFlags in HscEnv instead of using `hsc_dflags`
directly.
In the process I've also made some subsystems less dependent on DynFlags:
- CmmToAsm: by passing some missing flags via NCGConfig (see new fields
in GHC.CmmToAsm.Config)
- Core.Opt.*:
- by passing -dinline-check value into UnfoldingOpts
- by fixing some Core passes interfaces (e.g. CallArity, FloatIn)
that took DynFlags argument for no good reason.
- as a side-effect GHC.Core.Opt.Pipeline.doCorePass is much less
convoluted.
Diffstat (limited to 'compiler/GHC/Utils/TmpFs.hs')
| -rw-r--r-- | compiler/GHC/Utils/TmpFs.hs | 34 |
1 files changed, 17 insertions, 17 deletions
diff --git a/compiler/GHC/Utils/TmpFs.hs b/compiler/GHC/Utils/TmpFs.hs index fb671ad486..2244a898ff 100644 --- a/compiler/GHC/Utils/TmpFs.hs +++ b/compiler/GHC/Utils/TmpFs.hs @@ -141,7 +141,7 @@ cleanTempDirs logger tmpfs dflags $ mask_ $ do let ref = tmp_dirs_to_clean tmpfs ds <- atomicModifyIORef' ref $ \ds -> (Map.empty, ds) - removeTmpDirs logger dflags (Map.elems ds) + removeTmpDirs logger (Map.elems ds) -- | Delete all files in @tmp_files_to_clean@. cleanTempFiles :: Logger -> TmpFs -> DynFlags -> IO () @@ -155,7 +155,7 @@ cleanTempFiles logger tmpfs dflags , ftcGhcSession = gs_files } -> ( emptyFilesToClean , Set.toList cm_files ++ Set.toList gs_files) - removeTmpFiles logger dflags to_delete + removeTmpFiles logger to_delete -- | Delete all files in @tmp_files_to_clean@. That have lifetime -- TFL_CurrentModule. @@ -169,7 +169,7 @@ cleanCurrentModuleTempFiles logger tmpfs dflags to_delete <- atomicModifyIORef' ref $ \ftc@FilesToClean{ftcCurrentModule = cm_files} -> (ftc {ftcCurrentModule = Set.empty}, Set.toList cm_files) - removeTmpFiles logger dflags to_delete + removeTmpFiles logger to_delete -- | Ensure that new_files are cleaned on the next call of -- 'cleanTempFiles' or 'cleanCurrentModuleTempFiles', depending on lifetime. @@ -294,7 +294,7 @@ getTempDir logger tmpfs dflags = do -- directory we created. Otherwise return the directory we created. case their_dir of Nothing -> do - debugTraceMsg logger dflags 2 $ + debugTraceMsg logger 2 $ text "Created temporary directory:" <+> text our_dir return our_dir Just dir -> do @@ -314,18 +314,18 @@ the process id). This is ok, as the temporary directory used contains the pid (see getTempDir). -} -removeTmpDirs :: Logger -> DynFlags -> [FilePath] -> IO () -removeTmpDirs logger dflags ds - = traceCmd logger dflags "Deleting temp dirs" +removeTmpDirs :: Logger -> [FilePath] -> IO () +removeTmpDirs logger ds + = traceCmd logger "Deleting temp dirs" ("Deleting: " ++ unwords ds) - (mapM_ (removeWith logger dflags removeDirectory) ds) + (mapM_ (removeWith logger removeDirectory) ds) -removeTmpFiles :: Logger -> DynFlags -> [FilePath] -> IO () -removeTmpFiles logger dflags fs +removeTmpFiles :: Logger -> [FilePath] -> IO () +removeTmpFiles logger fs = warnNon $ - traceCmd logger dflags "Deleting temp files" + traceCmd logger "Deleting temp files" ("Deleting: " ++ unwords deletees) - (mapM_ (removeWith logger dflags removeFile) deletees) + (mapM_ (removeWith logger removeFile) deletees) where -- Flat out refuse to delete files that are likely to be source input -- files (is there a worse bug than having a compiler delete your source @@ -336,21 +336,21 @@ removeTmpFiles logger dflags fs warnNon act | null non_deletees = act | otherwise = do - putMsg logger dflags (text "WARNING - NOT deleting source files:" - <+> hsep (map text non_deletees)) + putMsg logger (text "WARNING - NOT deleting source files:" + <+> hsep (map text non_deletees)) act (non_deletees, deletees) = partition isHaskellUserSrcFilename fs -removeWith :: Logger -> DynFlags -> (FilePath -> IO ()) -> FilePath -> IO () -removeWith logger dflags remover f = remover f `Exception.catchIO` +removeWith :: Logger -> (FilePath -> IO ()) -> FilePath -> IO () +removeWith logger remover f = remover f `Exception.catchIO` (\e -> let msg = if isDoesNotExistError e then text "Warning: deleting non-existent" <+> text f else text "Warning: exception raised when deleting" <+> text f <> colon $$ text (show e) - in debugTraceMsg logger dflags 2 msg + in debugTraceMsg logger 2 msg ) #if defined(mingw32_HOST_OS) |
