summaryrefslogtreecommitdiff
path: root/compiler/main/DriverPipeline.hs
diff options
context:
space:
mode:
authorSylvain Henry <sylvain@haskus.fr>2020-02-18 11:08:48 +0100
committerMarge Bot <ben+marge-bot@smart-cactus.org>2020-02-21 20:46:40 -0500
commit240f5bf6f53515535be5bf3ef7632aa69ae21e3e (patch)
treedc7be78ca126c66af0aeb9f7944ebfc0ac5a211c /compiler/main/DriverPipeline.hs
parentbe7068a6130f394dcefbcb5d09c2944deca2270d (diff)
downloadhaskell-240f5bf6f53515535be5bf3ef7632aa69ae21e3e.tar.gz
Modules: Driver (#13009)
submodule updates: nofib, haddock
Diffstat (limited to 'compiler/main/DriverPipeline.hs')
-rw-r--r--compiler/main/DriverPipeline.hs2340
1 files changed, 0 insertions, 2340 deletions
diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
deleted file mode 100644
index 99a3ae9b70..0000000000
--- a/compiler/main/DriverPipeline.hs
+++ /dev/null
@@ -1,2340 +0,0 @@
-{-# LANGUAGE CPP, NamedFieldPuns, NondecreasingIndentation, BangPatterns, MultiWayIf #-}
-
-{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
-
------------------------------------------------------------------------------
---
--- GHC Driver
---
--- (c) The University of Glasgow 2005
---
------------------------------------------------------------------------------
-
-module DriverPipeline (
- -- Run a series of compilation steps in a pipeline, for a
- -- collection of source files.
- oneShot, compileFile,
-
- -- Interfaces for the batch-mode driver
- linkBinary,
-
- -- Interfaces for the compilation manager (interpreted/batch-mode)
- preprocess,
- compileOne, compileOne',
- link,
-
- -- Exports for hooks to override runPhase and link
- PhasePlus(..), CompPipeline(..), PipeEnv(..), PipeState(..),
- phaseOutputFilename, getOutputFilename, getPipeState, getPipeEnv,
- hscPostBackendPhase, getLocation, setModLocation, setDynFlags,
- runPhase, exeFileName,
- maybeCreateManifest,
- doCpp,
- linkingNeeded, checkLinkInfo, writeInterfaceOnlyMode
- ) where
-
-#include <ghcplatform.h>
-#include "HsVersions.h"
-
-import GhcPrelude
-
-import PipelineMonad
-import Packages
-import HeaderInfo
-import DriverPhases
-import SysTools
-import SysTools.ExtraObj
-import HscMain
-import Finder
-import HscTypes hiding ( Hsc )
-import Outputable
-import Module
-import ErrUtils
-import DynFlags
-import Panic
-import Util
-import StringBuffer ( hGetStringBuffer, hPutStringBuffer )
-import BasicTypes ( SuccessFlag(..) )
-import Maybes ( expectJust )
-import SrcLoc
-import GHC.CmmToLlvm ( llvmFixupAsm, llvmVersionList )
-import MonadUtils
-import GHC.Platform
-import TcRnTypes
-import ToolSettings
-import Hooks
-import qualified GHC.LanguageExtensions as LangExt
-import FileCleanup
-import Ar
-import Bag ( unitBag )
-import FastString ( mkFastString )
-import GHC.Iface.Utils ( mkFullIface )
-import UpdateCafInfos ( updateModDetailsCafInfos )
-
-import Exception
-import System.Directory
-import System.FilePath
-import System.IO
-import Control.Monad
-import Data.List ( isInfixOf, intercalate )
-import Data.Maybe
-import Data.Version
-import Data.Either ( partitionEithers )
-
-import Data.Time ( UTCTime )
-
--- ---------------------------------------------------------------------------
--- Pre-process
-
--- | Just preprocess a file, put the result in a temp. file (used by the
--- compilation manager during the summary phase).
---
--- We return the augmented DynFlags, because they contain the result
--- of slurping in the OPTIONS pragmas
-
-preprocess :: HscEnv
- -> FilePath -- ^ input filename
- -> Maybe InputFileBuffer
- -- ^ optional buffer to use instead of reading the input file
- -> Maybe Phase -- ^ starting phase
- -> IO (Either ErrorMessages (DynFlags, FilePath))
-preprocess hsc_env input_fn mb_input_buf mb_phase =
- handleSourceError (\err -> return (Left (srcErrorMessages err))) $
- ghandle handler $
- fmap Right $ do
- MASSERT2(isJust mb_phase || isHaskellSrcFilename input_fn, text input_fn)
- (dflags, fp, mb_iface) <- runPipeline anyHsc hsc_env (input_fn, mb_input_buf, fmap RealPhase mb_phase)
- Nothing
- -- We keep the processed file for the whole session to save on
- -- duplicated work in ghci.
- (Temporary TFL_GhcSession)
- Nothing{-no ModLocation-}
- []{-no foreign objects-}
- -- We stop before Hsc phase so we shouldn't generate an interface
- MASSERT(isNothing mb_iface)
- return (dflags, fp)
- where
- srcspan = srcLocSpan $ mkSrcLoc (mkFastString input_fn) 1 1
- handler (ProgramError msg) = return $ Left $ unitBag $
- mkPlainErrMsg (hsc_dflags hsc_env) srcspan $ text msg
- handler ex = throwGhcExceptionIO ex
-
--- ---------------------------------------------------------------------------
-
--- | Compile
---
--- Compile a single module, under the control of the compilation manager.
---
--- This is the interface between the compilation manager and the
--- compiler proper (hsc), where we deal with tedious details like
--- reading the OPTIONS pragma from the source file, converting the
--- C or assembly that GHC produces into an object file, and compiling
--- FFI stub files.
---
--- NB. No old interface can also mean that the source has changed.
-
-compileOne :: HscEnv
- -> ModSummary -- ^ summary for module being compiled
- -> Int -- ^ module N ...
- -> Int -- ^ ... of M
- -> Maybe ModIface -- ^ old interface, if we have one
- -> Maybe Linkable -- ^ old linkable, if we have one
- -> SourceModified
- -> IO HomeModInfo -- ^ the complete HomeModInfo, if successful
-
-compileOne = compileOne' Nothing (Just batchMsg)
-
-compileOne' :: Maybe TcGblEnv
- -> Maybe Messager
- -> HscEnv
- -> ModSummary -- ^ summary for module being compiled
- -> Int -- ^ module N ...
- -> Int -- ^ ... of M
- -> Maybe ModIface -- ^ old interface, if we have one
- -> Maybe Linkable -- ^ old linkable, if we have one
- -> SourceModified
- -> IO HomeModInfo -- ^ the complete HomeModInfo, if successful
-
-compileOne' m_tc_result mHscMessage
- hsc_env0 summary mod_index nmods mb_old_iface mb_old_linkable
- source_modified0
- = do
-
- debugTraceMsg dflags1 2 (text "compile: input file" <+> text input_fnpp)
-
- -- Run the pipeline up to codeGen (so everything up to, but not including, STG)
- (status, plugin_dflags) <- hscIncrementalCompile
- always_do_basic_recompilation_check
- m_tc_result mHscMessage
- hsc_env summary source_modified mb_old_iface (mod_index, nmods)
-
- let flags = hsc_dflags hsc_env0
- in do unless (gopt Opt_KeepHiFiles flags) $
- addFilesToClean flags TFL_CurrentModule $
- [ml_hi_file $ ms_location summary]
- unless (gopt Opt_KeepOFiles flags) $
- addFilesToClean flags TFL_GhcSession $
- [ml_obj_file $ ms_location summary]
-
- -- Use an HscEnv with DynFlags updated with the plugin info (returned from
- -- hscIncrementalCompile)
- let hsc_env' = hsc_env{ hsc_dflags = plugin_dflags }
-
- case (status, hsc_lang) of
- (HscUpToDate iface hmi_details, _) ->
- -- TODO recomp014 triggers this assert. What's going on?!
- -- ASSERT( isJust mb_old_linkable || isNoLink (ghcLink dflags) )
- return $! HomeModInfo iface hmi_details mb_old_linkable
- (HscNotGeneratingCode iface hmi_details, HscNothing) ->
- let mb_linkable = if isHsBootOrSig src_flavour
- then Nothing
- -- TODO: Questionable.
- else Just (LM (ms_hs_date summary) this_mod [])
- in return $! HomeModInfo iface hmi_details mb_linkable
- (HscNotGeneratingCode _ _, _) -> panic "compileOne HscNotGeneratingCode"
- (_, HscNothing) -> panic "compileOne HscNothing"
- (HscUpdateBoot iface hmi_details, HscInterpreted) -> do
- return $! HomeModInfo iface hmi_details Nothing
- (HscUpdateBoot iface hmi_details, _) -> do
- touchObjectFile dflags object_filename
- return $! HomeModInfo iface hmi_details Nothing
- (HscUpdateSig iface hmi_details, HscInterpreted) -> do
- let !linkable = LM (ms_hs_date summary) this_mod []
- return $! HomeModInfo iface hmi_details (Just linkable)
- (HscUpdateSig iface hmi_details, _) -> do
- output_fn <- getOutputFilename next_phase
- (Temporary TFL_CurrentModule) basename dflags
- next_phase (Just location)
-
- -- #10660: Use the pipeline instead of calling
- -- compileEmptyStub directly, so -dynamic-too gets
- -- handled properly
- _ <- runPipeline StopLn hsc_env'
- (output_fn,
- Nothing,
- Just (HscOut src_flavour
- mod_name (HscUpdateSig iface hmi_details)))
- (Just basename)
- Persistent
- (Just location)
- []
- o_time <- getModificationUTCTime object_filename
- let !linkable = LM o_time this_mod [DotO object_filename]
- return $! HomeModInfo iface hmi_details (Just linkable)
- (HscRecomp { hscs_guts = cgguts,
- hscs_mod_location = mod_location,
- hscs_mod_details = hmi_details,
- hscs_partial_iface = partial_iface,
- hscs_old_iface_hash = mb_old_iface_hash,
- hscs_iface_dflags = iface_dflags }, HscInterpreted) -> do
- -- In interpreted mode the regular codeGen backend is not run so we
- -- generate a interface without codeGen info.
- final_iface <- mkFullIface hsc_env'{hsc_dflags=iface_dflags} partial_iface Nothing
- liftIO $ hscMaybeWriteIface dflags final_iface mb_old_iface_hash (ms_location summary)
-
- (hasStub, comp_bc, spt_entries) <- hscInteractive hsc_env' cgguts mod_location
-
- stub_o <- case hasStub of
- Nothing -> return []
- Just stub_c -> do
- stub_o <- compileStub hsc_env' stub_c
- return [DotO stub_o]
-
- let hs_unlinked = [BCOs comp_bc spt_entries]
- unlinked_time = ms_hs_date summary
- -- Why do we use the timestamp of the source file here,
- -- rather than the current time? This works better in
- -- the case where the local clock is out of sync
- -- with the filesystem's clock. It's just as accurate:
- -- if the source is modified, then the linkable will
- -- be out of date.
- let !linkable = LM unlinked_time (ms_mod summary)
- (hs_unlinked ++ stub_o)
- return $! HomeModInfo final_iface hmi_details (Just linkable)
- (HscRecomp{}, _) -> do
- output_fn <- getOutputFilename next_phase
- (Temporary TFL_CurrentModule)
- basename dflags next_phase (Just location)
- -- We're in --make mode: finish the compilation pipeline.
- (_, _, Just (iface, details)) <- runPipeline StopLn hsc_env'
- (output_fn,
- Nothing,
- Just (HscOut src_flavour mod_name status))
- (Just basename)
- Persistent
- (Just location)
- []
- -- The object filename comes from the ModLocation
- o_time <- getModificationUTCTime object_filename
- let !linkable = LM o_time this_mod [DotO object_filename]
- return $! HomeModInfo iface details (Just linkable)
-
- where dflags0 = ms_hspp_opts summary
- this_mod = ms_mod summary
- location = ms_location summary
- input_fn = expectJust "compile:hs" (ml_hs_file location)
- input_fnpp = ms_hspp_file summary
- mod_graph = hsc_mod_graph hsc_env0
- needsLinker = needsTemplateHaskellOrQQ mod_graph
- isDynWay = any (== WayDyn) (ways dflags0)
- isProfWay = any (== WayProf) (ways dflags0)
- internalInterpreter = not (gopt Opt_ExternalInterpreter dflags0)
-
- src_flavour = ms_hsc_src summary
- mod_name = ms_mod_name summary
- next_phase = hscPostBackendPhase src_flavour hsc_lang
- object_filename = ml_obj_file location
-
- -- #8180 - when using TemplateHaskell, switch on -dynamic-too so
- -- the linker can correctly load the object files. This isn't necessary
- -- when using -fexternal-interpreter.
- dflags1 = if dynamicGhc && internalInterpreter &&
- not isDynWay && not isProfWay && needsLinker
- then gopt_set dflags0 Opt_BuildDynamicToo
- else dflags0
-
- -- #16331 - when no "internal interpreter" is available but we
- -- need to process some TemplateHaskell or QuasiQuotes, we automatically
- -- turn on -fexternal-interpreter.
- dflags2 = if not internalInterpreter && needsLinker
- then gopt_set dflags1 Opt_ExternalInterpreter
- else dflags1
-
- basename = dropExtension input_fn
-
- -- We add the directory in which the .hs files resides) to the import
- -- path. This is needed when we try to compile the .hc file later, if it
- -- imports a _stub.h file that we created here.
- current_dir = takeDirectory basename
- old_paths = includePaths dflags2
- !prevailing_dflags = hsc_dflags hsc_env0
- dflags =
- dflags2 { includePaths = addQuoteInclude old_paths [current_dir]
- , log_action = log_action prevailing_dflags }
- -- use the prevailing log_action / log_finaliser,
- -- not the one cached in the summary. This is so
- -- that we can change the log_action without having
- -- to re-summarize all the source files.
- hsc_env = hsc_env0 {hsc_dflags = dflags}
-
- -- Figure out what lang we're generating
- hsc_lang = hscTarget dflags
-
- -- -fforce-recomp should also work with --make
- force_recomp = gopt Opt_ForceRecomp dflags
- source_modified
- | force_recomp = SourceModified
- | otherwise = source_modified0
-
- always_do_basic_recompilation_check = case hsc_lang of
- HscInterpreted -> True
- _ -> False
-
------------------------------------------------------------------------------
--- stub .h and .c files (for foreign export support), and cc files.
-
--- The _stub.c file is derived from the haskell source file, possibly taking
--- into account the -stubdir option.
---
--- The object file created by compiling the _stub.c file is put into a
--- temporary file, which will be later combined with the main .o file
--- (see the MergeForeigns phase).
---
--- Moreover, we also let the user emit arbitrary C/C++/ObjC/ObjC++ files
--- from TH, that are then compiled and linked to the module. This is
--- useful to implement facilities such as inline-c.
-
-compileForeign :: HscEnv -> ForeignSrcLang -> FilePath -> IO FilePath
-compileForeign _ RawObject object_file = return object_file
-compileForeign hsc_env lang stub_c = do
- let phase = case lang of
- LangC -> Cc
- LangCxx -> Ccxx
- LangObjc -> Cobjc
- LangObjcxx -> Cobjcxx
- LangAsm -> As True -- allow CPP
- RawObject -> panic "compileForeign: should be unreachable"
- (_, stub_o, _) <- runPipeline StopLn hsc_env
- (stub_c, Nothing, Just (RealPhase phase))
- Nothing (Temporary TFL_GhcSession)
- Nothing{-no ModLocation-}
- []
- return stub_o
-
-compileStub :: HscEnv -> FilePath -> IO FilePath
-compileStub hsc_env stub_c = compileForeign hsc_env LangC stub_c
-
-compileEmptyStub :: DynFlags -> HscEnv -> FilePath -> ModLocation -> ModuleName -> IO ()
-compileEmptyStub dflags hsc_env basename location mod_name = do
- -- To maintain the invariant that every Haskell file
- -- compiles to object code, we make an empty (but
- -- valid) stub object file for signatures. However,
- -- we make sure this object file has a unique symbol,
- -- so that ranlib on OS X doesn't complain, see
- -- https://gitlab.haskell.org/ghc/ghc/issues/12673
- -- and https://github.com/haskell/cabal/issues/2257
- empty_stub <- newTempName dflags TFL_CurrentModule "c"
- let src = text "int" <+> ppr (mkModule (thisPackage dflags) mod_name) <+> text "= 0;"
- writeFile empty_stub (showSDoc dflags (pprCode CStyle src))
- _ <- runPipeline StopLn hsc_env
- (empty_stub, Nothing, Nothing)
- (Just basename)
- Persistent
- (Just location)
- []
- return ()
-
--- ---------------------------------------------------------------------------
--- Link
-
-link :: GhcLink -- interactive or batch
- -> DynFlags -- dynamic flags
- -> Bool -- attempt linking in batch mode?
- -> HomePackageTable -- what to link
- -> IO SuccessFlag
-
--- For the moment, in the batch linker, we don't bother to tell doLink
--- which packages to link -- it just tries all that are available.
--- batch_attempt_linking should only be *looked at* in batch mode. It
--- should only be True if the upsweep was successful and someone
--- exports main, i.e., we have good reason to believe that linking
--- will succeed.
-
-link ghcLink dflags
- = lookupHook linkHook l dflags ghcLink dflags
- where
- l LinkInMemory _ _ _
- = if platformMisc_ghcWithInterpreter $ platformMisc dflags
- then -- Not Linking...(demand linker will do the job)
- return Succeeded
- else panicBadLink LinkInMemory
-
- l NoLink _ _ _
- = return Succeeded
-
- l LinkBinary dflags batch_attempt_linking hpt
- = link' dflags batch_attempt_linking hpt
-
- l LinkStaticLib dflags batch_attempt_linking hpt
- = link' dflags batch_attempt_linking hpt
-
- l LinkDynLib dflags batch_attempt_linking hpt
- = link' dflags batch_attempt_linking hpt
-
-panicBadLink :: GhcLink -> a
-panicBadLink other = panic ("link: GHC not built to link this way: " ++
- show other)
-
-link' :: DynFlags -- dynamic flags
- -> Bool -- attempt linking in batch mode?
- -> HomePackageTable -- what to link
- -> IO SuccessFlag
-
-link' dflags batch_attempt_linking hpt
- | batch_attempt_linking
- = do
- let
- staticLink = case ghcLink dflags of
- LinkStaticLib -> True
- _ -> False
-
- home_mod_infos = eltsHpt hpt
-
- -- the packages we depend on
- pkg_deps = concatMap (map fst . dep_pkgs . mi_deps . hm_iface) home_mod_infos
-
- -- the linkables to link
- linkables = map (expectJust "link".hm_linkable) home_mod_infos
-
- debugTraceMsg dflags 3 (text "link: linkables are ..." $$ vcat (map ppr linkables))
-
- -- check for the -no-link flag
- if isNoLink (ghcLink dflags)
- then do debugTraceMsg dflags 3 (text "link(batch): linking omitted (-c flag given).")
- return Succeeded
- else do
-
- let getOfiles (LM _ _ us) = map nameOfObject (filter isObject us)
- obj_files = concatMap getOfiles linkables
-
- exe_file = exeFileName staticLink dflags
-
- linking_needed <- linkingNeeded dflags staticLink linkables pkg_deps
-
- if not (gopt Opt_ForceRecomp dflags) && not linking_needed
- then do debugTraceMsg dflags 2 (text exe_file <+> text "is up to date, linking not required.")
- return Succeeded
- else do
-
- compilationProgressMsg dflags ("Linking " ++ exe_file ++ " ...")
-
- -- Don't showPass in Batch mode; doLink will do that for us.
- let link = case ghcLink dflags of
- LinkBinary -> linkBinary
- LinkStaticLib -> linkStaticLib
- LinkDynLib -> linkDynLibCheck
- other -> panicBadLink other
- link dflags obj_files pkg_deps
-
- debugTraceMsg dflags 3 (text "link: done")
-
- -- linkBinary only returns if it succeeds
- return Succeeded
-
- | otherwise
- = do debugTraceMsg dflags 3 (text "link(batch): upsweep (partially) failed OR" $$
- text " Main.main not exported; not linking.")
- return Succeeded
-
-
-linkingNeeded :: DynFlags -> Bool -> [Linkable] -> [InstalledUnitId] -> IO Bool
-linkingNeeded dflags staticLink linkables pkg_deps = do
- -- if the modification time on the executable is later than the
- -- modification times on all of the objects and libraries, then omit
- -- linking (unless the -fforce-recomp flag was given).
- let exe_file = exeFileName staticLink dflags
- e_exe_time <- tryIO $ getModificationUTCTime exe_file
- case e_exe_time of
- Left _ -> return True
- Right t -> do
- -- first check object files and extra_ld_inputs
- let extra_ld_inputs = [ f | FileOption _ f <- ldInputs dflags ]
- e_extra_times <- mapM (tryIO . getModificationUTCTime) extra_ld_inputs
- let (errs,extra_times) = partitionEithers e_extra_times
- let obj_times = map linkableTime linkables ++ extra_times
- if not (null errs) || any (t <) obj_times
- then return True
- else do
-
- -- next, check libraries. XXX this only checks Haskell libraries,
- -- not extra_libraries or -l things from the command line.
- let pkg_hslibs = [ (collectLibraryPaths dflags [c], lib)
- | Just c <- map (lookupInstalledPackage dflags) pkg_deps,
- lib <- packageHsLibs dflags c ]
-
- pkg_libfiles <- mapM (uncurry (findHSLib dflags)) pkg_hslibs
- if any isNothing pkg_libfiles then return True else do
- e_lib_times <- mapM (tryIO . getModificationUTCTime)
- (catMaybes pkg_libfiles)
- let (lib_errs,lib_times) = partitionEithers e_lib_times
- if not (null lib_errs) || any (t <) lib_times
- then return True
- else checkLinkInfo dflags pkg_deps exe_file
-
-findHSLib :: DynFlags -> [String] -> String -> IO (Maybe FilePath)
-findHSLib dflags dirs lib = do
- let batch_lib_file = if WayDyn `notElem` ways dflags
- then "lib" ++ lib <.> "a"
- else mkSOName (targetPlatform dflags) lib
- found <- filterM doesFileExist (map (</> batch_lib_file) dirs)
- case found of
- [] -> return Nothing
- (x:_) -> return (Just x)
-
--- -----------------------------------------------------------------------------
--- Compile files in one-shot mode.
-
-oneShot :: HscEnv -> Phase -> [(String, Maybe Phase)] -> IO ()
-oneShot hsc_env stop_phase srcs = do
- o_files <- mapM (compileFile hsc_env stop_phase) srcs
- doLink (hsc_dflags hsc_env) stop_phase o_files
-
-compileFile :: HscEnv -> Phase -> (FilePath, Maybe Phase) -> IO FilePath
-compileFile hsc_env stop_phase (src, mb_phase) = do
- exists <- doesFileExist src
- when (not exists) $
- throwGhcExceptionIO (CmdLineError ("does not exist: " ++ src))
-
- let
- dflags = hsc_dflags hsc_env
- mb_o_file = outputFile dflags
- ghc_link = ghcLink dflags -- Set by -c or -no-link
-
- -- When linking, the -o argument refers to the linker's output.
- -- otherwise, we use it as the name for the pipeline's output.
- output
- -- If we are doing -fno-code, then act as if the output is
- -- 'Temporary'. This stops GHC trying to copy files to their
- -- final location.
- | HscNothing <- hscTarget dflags = Temporary TFL_CurrentModule
- | StopLn <- stop_phase, not (isNoLink ghc_link) = Persistent
- -- -o foo applies to linker
- | isJust mb_o_file = SpecificFile
- -- -o foo applies to the file we are compiling now
- | otherwise = Persistent
-
- ( _, out_file, _) <- runPipeline stop_phase hsc_env
- (src, Nothing, fmap RealPhase mb_phase)
- Nothing
- output
- Nothing{-no ModLocation-} []
- return out_file
-
-
-doLink :: DynFlags -> Phase -> [FilePath] -> IO ()
-doLink dflags stop_phase o_files
- | not (isStopLn stop_phase)
- = return () -- We stopped before the linking phase
-
- | otherwise
- = case ghcLink dflags of
- NoLink -> return ()
- LinkBinary -> linkBinary dflags o_files []
- LinkStaticLib -> linkStaticLib dflags o_files []
- LinkDynLib -> linkDynLibCheck dflags o_files []
- other -> panicBadLink other
-
-
--- ---------------------------------------------------------------------------
-
--- | Run a compilation pipeline, consisting of multiple phases.
---
--- This is the interface to the compilation pipeline, which runs
--- a series of compilation steps on a single source file, specifying
--- at which stage to stop.
---
--- The DynFlags can be modified by phases in the pipeline (eg. by
--- OPTIONS_GHC pragmas), and the changes affect later phases in the
--- pipeline.
-runPipeline
- :: Phase -- ^ When to stop
- -> HscEnv -- ^ Compilation environment
- -> (FilePath, Maybe InputFileBuffer, Maybe PhasePlus)
- -- ^ Pipeline input file name, optional
- -- buffer and maybe -x suffix
- -> Maybe FilePath -- ^ original basename (if different from ^^^)
- -> PipelineOutput -- ^ Output filename
- -> Maybe ModLocation -- ^ A ModLocation, if this is a Haskell module
- -> [FilePath] -- ^ foreign objects
- -> IO (DynFlags, FilePath, Maybe (ModIface, ModDetails))
- -- ^ (final flags, output filename, interface)
-runPipeline stop_phase hsc_env0 (input_fn, mb_input_buf, mb_phase)
- mb_basename output maybe_loc foreign_os
-
- = do let
- dflags0 = hsc_dflags hsc_env0
-
- -- Decide where dump files should go based on the pipeline output
- dflags = dflags0 { dumpPrefix = Just (basename ++ ".") }
- hsc_env = hsc_env0 {hsc_dflags = dflags}
-
- (input_basename, suffix) = splitExtension input_fn
- suffix' = drop 1 suffix -- strip off the .
- basename | Just b <- mb_basename = b
- | otherwise = input_basename
-
- -- If we were given a -x flag, then use that phase to start from
- start_phase = fromMaybe (RealPhase (startPhase suffix')) mb_phase
-
- isHaskell (RealPhase (Unlit _)) = True
- isHaskell (RealPhase (Cpp _)) = True
- isHaskell (RealPhase (HsPp _)) = True
- isHaskell (RealPhase (Hsc _)) = True
- isHaskell (HscOut {}) = True
- isHaskell _ = False
-
- isHaskellishFile = isHaskell start_phase
-
- env = PipeEnv{ stop_phase,
- src_filename = input_fn,
- src_basename = basename,
- src_suffix = suffix',
- output_spec = output }
-
- when (isBackpackishSuffix suffix') $
- throwGhcExceptionIO (UsageError
- ("use --backpack to process " ++ input_fn))
-
- -- We want to catch cases of "you can't get there from here" before
- -- we start the pipeline, because otherwise it will just run off the
- -- end.
- let happensBefore' = happensBefore dflags
- case start_phase of
- RealPhase start_phase' ->
- -- See Note [Partial ordering on phases]
- -- Not the same as: (stop_phase `happensBefore` start_phase')
- when (not (start_phase' `happensBefore'` stop_phase ||
- start_phase' `eqPhase` stop_phase)) $
- throwGhcExceptionIO (UsageError
- ("cannot compile this file to desired target: "
- ++ input_fn))
- HscOut {} -> return ()
-
- -- Write input buffer to temp file if requested
- input_fn' <- case (start_phase, mb_input_buf) of
- (RealPhase real_start_phase, Just input_buf) -> do
- let suffix = phaseInputExt real_start_phase
- fn <- newTempName dflags TFL_CurrentModule suffix
- hdl <- openBinaryFile fn WriteMode
- -- Add a LINE pragma so reported source locations will
- -- mention the real input file, not this temp file.
- hPutStrLn hdl $ "{-# LINE 1 \""++ input_fn ++ "\"#-}"
- hPutStringBuffer hdl input_buf
- hClose hdl
- return fn
- (_, _) -> return input_fn
-
- debugTraceMsg dflags 4 (text "Running the pipeline")
- r <- runPipeline' start_phase hsc_env env input_fn'
- maybe_loc foreign_os
-
- -- If we are compiling a Haskell module, and doing
- -- -dynamic-too, but couldn't do the -dynamic-too fast
- -- path, then rerun the pipeline for the dyn way
- let dflags = hsc_dflags hsc_env
- -- NB: Currently disabled on Windows (ref #7134, #8228, and #5987)
- when (not $ platformOS (targetPlatform dflags) == OSMinGW32) $ do
- when isHaskellishFile $ whenCannotGenerateDynamicToo dflags $ do
- debugTraceMsg dflags 4
- (text "Running the pipeline again for -dynamic-too")
- let dflags' = dynamicTooMkDynamicDynFlags dflags
- hsc_env' <- newHscEnv dflags'
- _ <- runPipeline' start_phase hsc_env' env input_fn'
- maybe_loc foreign_os
- return ()
- return r
-
-runPipeline'
- :: PhasePlus -- ^ When to start
- -> HscEnv -- ^ Compilation environment
- -> PipeEnv
- -> FilePath -- ^ Input filename
- -> Maybe ModLocation -- ^ A ModLocation, if this is a Haskell module
- -> [FilePath] -- ^ foreign objects, if we have one
- -> IO (DynFlags, FilePath, Maybe (ModIface, ModDetails))
- -- ^ (final flags, output filename, interface)
-runPipeline' start_phase hsc_env env input_fn
- maybe_loc foreign_os
- = do
- -- Execute the pipeline...
- let state = PipeState{ hsc_env, maybe_loc, foreign_os = foreign_os, iface = Nothing }
- (pipe_state, fp) <- evalP (pipeLoop start_phase input_fn) env state
- return (pipeStateDynFlags pipe_state, fp, pipeStateModIface pipe_state)
-
--- ---------------------------------------------------------------------------
--- outer pipeline loop
-
--- | pipeLoop runs phases until we reach the stop phase
-pipeLoop :: PhasePlus -> FilePath -> CompPipeline FilePath
-pipeLoop phase input_fn = do
- env <- getPipeEnv
- dflags <- getDynFlags
- -- See Note [Partial ordering on phases]
- let happensBefore' = happensBefore dflags
- stopPhase = stop_phase env
- case phase of
- RealPhase realPhase | realPhase `eqPhase` stopPhase -- All done
- -> -- Sometimes, a compilation phase doesn't actually generate any output
- -- (eg. the CPP phase when -fcpp is not turned on). If we end on this
- -- stage, but we wanted to keep the output, then we have to explicitly
- -- copy the file, remembering to prepend a {-# LINE #-} pragma so that
- -- further compilation stages can tell what the original filename was.
- case output_spec env of
- Temporary _ ->
- return input_fn
- output ->
- do pst <- getPipeState
- final_fn <- liftIO $ getOutputFilename
- stopPhase output (src_basename env)
- dflags stopPhase (maybe_loc pst)
- when (final_fn /= input_fn) $ do
- let msg = ("Copying `" ++ input_fn ++"' to `" ++ final_fn ++ "'")
- line_prag = Just ("{-# LINE 1 \"" ++ src_filename env ++ "\" #-}\n")
- liftIO $ copyWithHeader dflags msg line_prag input_fn final_fn
- return final_fn
-
-
- | not (realPhase `happensBefore'` stopPhase)
- -- Something has gone wrong. We'll try to cover all the cases when
- -- this could happen, so if we reach here it is a panic.
- -- eg. it might happen if the -C flag is used on a source file that
- -- has {-# OPTIONS -fasm #-}.
- -> panic ("pipeLoop: at phase " ++ show realPhase ++
- " but I wanted to stop at phase " ++ show stopPhase)
-
- _
- -> do liftIO $ debugTraceMsg dflags 4
- (text "Running phase" <+> ppr phase)
- (next_phase, output_fn) <- runHookedPhase phase input_fn dflags
- case phase of
- HscOut {} -> do
- -- We don't pass Opt_BuildDynamicToo to the backend
- -- in DynFlags.
- -- Instead it's run twice with flags accordingly set
- -- per run.
- let noDynToo = pipeLoop next_phase output_fn
- let dynToo = do
- setDynFlags $ gopt_unset dflags Opt_BuildDynamicToo
- r <- pipeLoop next_phase output_fn
- setDynFlags $ dynamicTooMkDynamicDynFlags dflags
- -- TODO shouldn't ignore result:
- _ <- pipeLoop phase input_fn
- return r
- ifGeneratingDynamicToo dflags dynToo noDynToo
- _ -> pipeLoop next_phase output_fn
-
-runHookedPhase :: PhasePlus -> FilePath -> DynFlags
- -> CompPipeline (PhasePlus, FilePath)
-runHookedPhase pp input dflags =
- lookupHook runPhaseHook runPhase dflags pp input dflags
-
--- -----------------------------------------------------------------------------
--- In each phase, we need to know into what filename to generate the
--- output. All the logic about which filenames we generate output
--- into is embodied in the following function.
-
--- | Computes the next output filename after we run @next_phase@.
--- Like 'getOutputFilename', but it operates in the 'CompPipeline' monad
--- (which specifies all of the ambient information.)
-phaseOutputFilename :: Phase{-next phase-} -> CompPipeline FilePath
-phaseOutputFilename next_phase = do
- PipeEnv{stop_phase, src_basename, output_spec} <- getPipeEnv
- PipeState{maybe_loc, hsc_env} <- getPipeState
- let dflags = hsc_dflags hsc_env
- liftIO $ getOutputFilename stop_phase output_spec
- src_basename dflags next_phase maybe_loc
-
--- | Computes the next output filename for something in the compilation
--- pipeline. This is controlled by several variables:
---
--- 1. 'Phase': the last phase to be run (e.g. 'stopPhase'). This
--- is used to tell if we're in the last phase or not, because
--- in that case flags like @-o@ may be important.
--- 2. 'PipelineOutput': is this intended to be a 'Temporary' or
--- 'Persistent' build output? Temporary files just go in
--- a fresh temporary name.
--- 3. 'String': what was the basename of the original input file?
--- 4. 'DynFlags': the obvious thing
--- 5. 'Phase': the phase we want to determine the output filename of.
--- 6. @Maybe ModLocation@: the 'ModLocation' of the module we're
--- compiling; this can be used to override the default output
--- of an object file. (TODO: do we actually need this?)
-getOutputFilename
- :: Phase -> PipelineOutput -> String
- -> DynFlags -> Phase{-next phase-} -> Maybe ModLocation -> IO FilePath
-getOutputFilename stop_phase output basename dflags next_phase maybe_location
- | is_last_phase, Persistent <- output = persistent_fn
- | is_last_phase, SpecificFile <- output = case outputFile dflags of
- Just f -> return f
- Nothing ->
- panic "SpecificFile: No filename"
- | keep_this_output = persistent_fn
- | Temporary lifetime <- output = newTempName dflags lifetime suffix
- | otherwise = newTempName dflags TFL_CurrentModule
- suffix
- where
- hcsuf = hcSuf dflags
- odir = objectDir dflags
- osuf = objectSuf dflags
- keep_hc = gopt Opt_KeepHcFiles dflags
- keep_hscpp = gopt Opt_KeepHscppFiles dflags
- keep_s = gopt Opt_KeepSFiles dflags
- keep_bc = gopt Opt_KeepLlvmFiles dflags
-
- myPhaseInputExt HCc = hcsuf
- myPhaseInputExt MergeForeign = osuf
- myPhaseInputExt StopLn = osuf
- myPhaseInputExt other = phaseInputExt other
-
- is_last_phase = next_phase `eqPhase` stop_phase
-
- -- sometimes, we keep output from intermediate stages
- keep_this_output =
- case next_phase of
- As _ | keep_s -> True
- LlvmOpt | keep_bc -> True
- HCc | keep_hc -> True
- HsPp _ | keep_hscpp -> True -- See #10869
- _other -> False
-
- suffix = myPhaseInputExt next_phase
-
- -- persistent object files get put in odir
- persistent_fn
- | StopLn <- next_phase = return odir_persistent
- | otherwise = return persistent
-
- persistent = basename <.> suffix
-
- odir_persistent
- | Just loc <- maybe_location = ml_obj_file loc
- | Just d <- odir = d </> persistent
- | otherwise = persistent
-
-
--- | The fast LLVM Pipeline skips the mangler and assembler,
--- emitting object code directly from llc.
---
--- slow: opt -> llc -> .s -> mangler -> as -> .o
--- fast: opt -> llc -> .o
---
--- hidden flag: -ffast-llvm
---
--- if keep-s-files is specified, we need to go through
--- the slow pipeline (Kavon Farvardin requested this).
-fastLlvmPipeline :: DynFlags -> Bool
-fastLlvmPipeline dflags
- = not (gopt Opt_KeepSFiles dflags) && gopt Opt_FastLlvm dflags
-
--- | LLVM Options. These are flags to be passed to opt and llc, to ensure
--- consistency we list them in pairs, so that they form groups.
-llvmOptions :: DynFlags
- -> [(String, String)] -- ^ pairs of (opt, llc) arguments
-llvmOptions dflags =
- [("-enable-tbaa -tbaa", "-enable-tbaa") | gopt Opt_LlvmTBAA dflags ]
- ++ [("-relocation-model=" ++ rmodel
- ,"-relocation-model=" ++ rmodel) | not (null rmodel)]
- ++ [("-stack-alignment=" ++ (show align)
- ,"-stack-alignment=" ++ (show align)) | align > 0 ]
- ++ [("", "-filetype=obj") | fastLlvmPipeline dflags ]
-
- -- Additional llc flags
- ++ [("", "-mcpu=" ++ mcpu) | not (null mcpu)
- , not (any (isInfixOf "-mcpu") (getOpts dflags opt_lc)) ]
- ++ [("", "-mattr=" ++ attrs) | not (null attrs) ]
-
- where target = platformMisc_llvmTarget $ platformMisc dflags
- Just (LlvmTarget _ mcpu mattr) = lookup target (llvmTargets $ llvmConfig dflags)
-
- -- Relocation models
- rmodel | gopt Opt_PIC dflags = "pic"
- | positionIndependent dflags = "pic"
- | WayDyn `elem` ways dflags = "dynamic-no-pic"
- | otherwise = "static"
-
- align :: Int
- align = case platformArch (targetPlatform dflags) of
- ArchX86_64 | isAvxEnabled dflags -> 32
- _ -> 0
-
- attrs :: String
- attrs = intercalate "," $ mattr
- ++ ["+sse42" | isSse4_2Enabled dflags ]
- ++ ["+sse2" | isSse2Enabled dflags ]
- ++ ["+sse" | isSseEnabled dflags ]
- ++ ["+avx512f" | isAvx512fEnabled dflags ]
- ++ ["+avx2" | isAvx2Enabled dflags ]
- ++ ["+avx" | isAvxEnabled dflags ]
- ++ ["+avx512cd"| isAvx512cdEnabled dflags ]
- ++ ["+avx512er"| isAvx512erEnabled dflags ]
- ++ ["+avx512pf"| isAvx512pfEnabled dflags ]
- ++ ["+bmi" | isBmiEnabled dflags ]
- ++ ["+bmi2" | isBmi2Enabled dflags ]
-
--- -----------------------------------------------------------------------------
--- | Each phase in the pipeline returns the next phase to execute, and the
--- name of the file in which the output was placed.
---
--- We must do things dynamically this way, because we often don't know
--- what the rest of the phases will be until part-way through the
--- compilation: for example, an {-# OPTIONS -fasm #-} at the beginning
--- of a source file can change the latter stages of the pipeline from
--- taking the LLVM route to using the native code generator.
---
-runPhase :: PhasePlus -- ^ Run this phase
- -> FilePath -- ^ name of the input file
- -> DynFlags -- ^ for convenience, we pass the current dflags in
- -> CompPipeline (PhasePlus, -- next phase to run
- FilePath) -- output filename
-
- -- Invariant: the output filename always contains the output
- -- Interesting case: Hsc when there is no recompilation to do
- -- Then the output filename is still a .o file
-
-
--------------------------------------------------------------------------------
--- Unlit phase
-
-runPhase (RealPhase (Unlit sf)) input_fn dflags
- = do
- output_fn <- phaseOutputFilename (Cpp sf)
-
- let flags = [ -- The -h option passes the file name for unlit to
- -- put in a #line directive
- SysTools.Option "-h"
- -- See Note [Don't normalise input filenames].
- , SysTools.Option $ escape input_fn
- , SysTools.FileOption "" input_fn
- , SysTools.FileOption "" output_fn
- ]
-
- liftIO $ SysTools.runUnlit dflags flags
-
- return (RealPhase (Cpp sf), output_fn)
- where
- -- escape the characters \, ", and ', but don't try to escape
- -- Unicode or anything else (so we don't use Util.charToC
- -- here). If we get this wrong, then in
- -- GHC.HsToCore.Coverage.isGoodTickSrcSpan where we check that the filename in
- -- a SrcLoc is the same as the source filenaame, the two will
- -- look bogusly different. See test:
- -- libraries/hpc/tests/function/subdir/tough2.hs
- escape ('\\':cs) = '\\':'\\': escape cs
- escape ('\"':cs) = '\\':'\"': escape cs
- escape ('\'':cs) = '\\':'\'': escape cs
- escape (c:cs) = c : escape cs
- escape [] = []
-
--------------------------------------------------------------------------------
--- Cpp phase : (a) gets OPTIONS out of file
--- (b) runs cpp if necessary
-
-runPhase (RealPhase (Cpp sf)) input_fn dflags0
- = do
- src_opts <- liftIO $ getOptionsFromFile dflags0 input_fn
- (dflags1, unhandled_flags, warns)
- <- liftIO $ parseDynamicFilePragma dflags0 src_opts
- setDynFlags dflags1
- liftIO $ checkProcessArgsResult dflags1 unhandled_flags
-
- if not (xopt LangExt.Cpp dflags1) then do
- -- we have to be careful to emit warnings only once.
- unless (gopt Opt_Pp dflags1) $
- liftIO $ handleFlagWarnings dflags1 warns
-
- -- no need to preprocess CPP, just pass input file along
- -- to the next phase of the pipeline.
- return (RealPhase (HsPp sf), input_fn)
- else do
- output_fn <- phaseOutputFilename (HsPp sf)
- liftIO $ doCpp dflags1 True{-raw-}
- input_fn output_fn
- -- re-read the pragmas now that we've preprocessed the file
- -- See #2464,#3457
- src_opts <- liftIO $ getOptionsFromFile dflags0 output_fn
- (dflags2, unhandled_flags, warns)
- <- liftIO $ parseDynamicFilePragma dflags0 src_opts
- liftIO $ checkProcessArgsResult dflags2 unhandled_flags
- unless (gopt Opt_Pp dflags2) $
- liftIO $ handleFlagWarnings dflags2 warns
- -- the HsPp pass below will emit warnings
-
- setDynFlags dflags2
-
- return (RealPhase (HsPp sf), output_fn)
-
--------------------------------------------------------------------------------
--- HsPp phase
-
-runPhase (RealPhase (HsPp sf)) input_fn dflags
- = do
- if not (gopt Opt_Pp dflags) then
- -- no need to preprocess, just pass input file along
- -- to the next phase of the pipeline.
- return (RealPhase (Hsc sf), input_fn)
- else do
- PipeEnv{src_basename, src_suffix} <- getPipeEnv
- let orig_fn = src_basename <.> src_suffix
- output_fn <- phaseOutputFilename (Hsc sf)
- liftIO $ SysTools.runPp dflags
- ( [ SysTools.Option orig_fn
- , SysTools.Option input_fn
- , SysTools.FileOption "" output_fn
- ]
- )
-
- -- re-read pragmas now that we've parsed the file (see #3674)
- src_opts <- liftIO $ getOptionsFromFile dflags output_fn
- (dflags1, unhandled_flags, warns)
- <- liftIO $ parseDynamicFilePragma dflags src_opts
- setDynFlags dflags1
- liftIO $ checkProcessArgsResult dflags1 unhandled_flags
- liftIO $ handleFlagWarnings dflags1 warns
-
- return (RealPhase (Hsc sf), output_fn)
-
------------------------------------------------------------------------------
--- Hsc phase
-
--- Compilation of a single module, in "legacy" mode (_not_ under
--- the direction of the compilation manager).
-runPhase (RealPhase (Hsc src_flavour)) input_fn dflags0
- = do -- normal Hsc mode, not mkdependHS
-
- PipeEnv{ stop_phase=stop,
- src_basename=basename,
- src_suffix=suff } <- getPipeEnv
-
- -- we add the current directory (i.e. the directory in which
- -- the .hs files resides) to the include path, since this is
- -- what gcc does, and it's probably what you want.
- let current_dir = takeDirectory basename
- new_includes = addQuoteInclude paths [current_dir]
- paths = includePaths dflags0
- dflags = dflags0 { includePaths = new_includes }
-
- setDynFlags dflags
-
- -- gather the imports and module name
- (hspp_buf,mod_name,imps,src_imps) <- liftIO $ do
- do
- buf <- hGetStringBuffer input_fn
- eimps <- getImports dflags buf input_fn (basename <.> suff)
- case eimps of
- Left errs -> throwErrors errs
- Right (src_imps,imps,L _ mod_name) -> return
- (Just buf, mod_name, imps, src_imps)
-
- -- Take -o into account if present
- -- Very like -ohi, but we must *only* do this if we aren't linking
- -- (If we're linking then the -o applies to the linked thing, not to
- -- the object file for one module.)
- -- Note the nasty duplication with the same computation in compileFile above
- location <- getLocation src_flavour mod_name
-
- let o_file = ml_obj_file location -- The real object file
- hi_file = ml_hi_file location
- hie_file = ml_hie_file location
- dest_file | writeInterfaceOnlyMode dflags
- = hi_file
- | otherwise
- = o_file
-
- -- Figure out if the source has changed, for recompilation avoidance.
- --
- -- Setting source_unchanged to True means that M.o (or M.hie) seems
- -- to be up to date wrt M.hs; so no need to recompile unless imports have
- -- changed (which the compiler itself figures out).
- -- Setting source_unchanged to False tells the compiler that M.o is out of
- -- date wrt M.hs (or M.o doesn't exist) so we must recompile regardless.
- src_timestamp <- liftIO $ getModificationUTCTime (basename <.> suff)
-
- source_unchanged <- liftIO $
- if not (isStopLn stop)
- -- SourceModified unconditionally if
- -- (a) recompilation checker is off, or
- -- (b) we aren't going all the way to .o file (e.g. ghc -S)
- then return SourceModified
- -- Otherwise look at file modification dates
- else do dest_file_mod <- sourceModified dest_file src_timestamp
- hie_file_mod <- if gopt Opt_WriteHie dflags
- then sourceModified hie_file
- src_timestamp
- else pure False
- if dest_file_mod || hie_file_mod
- then return SourceModified
- else return SourceUnmodified
-
- PipeState{hsc_env=hsc_env'} <- getPipeState
-
- -- Tell the finder cache about this module
- mod <- liftIO $ addHomeModuleToFinder hsc_env' mod_name location
-
- -- Make the ModSummary to hand to hscMain
- let
- mod_summary = ModSummary { ms_mod = mod,
- ms_hsc_src = src_flavour,
- ms_hspp_file = input_fn,
- ms_hspp_opts = dflags,
- ms_hspp_buf = hspp_buf,
- ms_location = location,
- ms_hs_date = src_timestamp,
- ms_obj_date = Nothing,
- ms_parsed_mod = Nothing,
- ms_iface_date = Nothing,
- ms_hie_date = Nothing,
- ms_textual_imps = imps,
- ms_srcimps = src_imps }
-
- -- run the compiler!
- let msg hsc_env _ what _ = oneShotMsg hsc_env what
- (result, plugin_dflags) <-
- liftIO $ hscIncrementalCompile True Nothing (Just msg) hsc_env'
- mod_summary source_unchanged Nothing (1,1)
-
- -- In the rest of the pipeline use the dflags with plugin info
- setDynFlags plugin_dflags
-
- return (HscOut src_flavour mod_name result,
- panic "HscOut doesn't have an input filename")
-
-runPhase (HscOut src_flavour mod_name result) _ dflags = do
- location <- getLocation src_flavour mod_name
- setModLocation location
-
- let o_file = ml_obj_file location -- The real object file
- hsc_lang = hscTarget dflags
- next_phase = hscPostBackendPhase src_flavour hsc_lang
-
- case result of
- HscNotGeneratingCode _ _ ->
- return (RealPhase StopLn,
- panic "No output filename from Hsc when no-code")
- HscUpToDate _ _ ->
- do liftIO $ touchObjectFile dflags o_file
- -- The .o file must have a later modification date
- -- than the source file (else we wouldn't get Nothing)
- -- but we touch it anyway, to keep 'make' happy (we think).
- return (RealPhase StopLn, o_file)
- HscUpdateBoot _ _ ->
- do -- In the case of hs-boot files, generate a dummy .o-boot
- -- stamp file for the benefit of Make
- liftIO $ touchObjectFile dflags o_file
- return (RealPhase StopLn, o_file)
- HscUpdateSig _ _ ->
- do -- We need to create a REAL but empty .o file
- -- because we are going to attempt to put it in a library
- PipeState{hsc_env=hsc_env'} <- getPipeState
- let input_fn = expectJust "runPhase" (ml_hs_file location)
- basename = dropExtension input_fn
- liftIO $ compileEmptyStub dflags hsc_env' basename location mod_name
- return (RealPhase StopLn, o_file)
- HscRecomp { hscs_guts = cgguts,
- hscs_mod_location = mod_location,
- hscs_mod_details = mod_details,
- hscs_partial_iface = partial_iface,
- hscs_old_iface_hash = mb_old_iface_hash,
- hscs_iface_dflags = iface_dflags }
- -> do output_fn <- phaseOutputFilename next_phase
-
- PipeState{hsc_env=hsc_env'} <- getPipeState
-
- (outputFilename, mStub, foreign_files, caf_infos) <- liftIO $
- hscGenHardCode hsc_env' cgguts mod_location output_fn
-
- final_iface <- liftIO (mkFullIface hsc_env'{hsc_dflags=iface_dflags} partial_iface (Just caf_infos))
- let final_mod_details = {-# SCC updateModDetailsCafInfos #-}
- updateModDetailsCafInfos caf_infos mod_details
- setIface final_iface final_mod_details
-
- -- See Note [Writing interface files]
- let if_dflags = dflags `gopt_unset` Opt_BuildDynamicToo
- liftIO $ hscMaybeWriteIface if_dflags final_iface mb_old_iface_hash mod_location
-
- stub_o <- liftIO (mapM (compileStub hsc_env') mStub)
- foreign_os <- liftIO $
- mapM (uncurry (compileForeign hsc_env')) foreign_files
- setForeignOs (maybe [] return stub_o ++ foreign_os)
-
- return (RealPhase next_phase, outputFilename)
-
------------------------------------------------------------------------------
--- Cmm phase
-
-runPhase (RealPhase CmmCpp) input_fn dflags
- = do output_fn <- phaseOutputFilename Cmm
- liftIO $ doCpp dflags False{-not raw-}
- input_fn output_fn
- return (RealPhase Cmm, output_fn)
-
-runPhase (RealPhase Cmm) input_fn dflags
- = do let hsc_lang = hscTarget dflags
- let next_phase = hscPostBackendPhase HsSrcFile hsc_lang
- output_fn <- phaseOutputFilename next_phase
- PipeState{hsc_env} <- getPipeState
- liftIO $ hscCompileCmmFile hsc_env input_fn output_fn
- return (RealPhase next_phase, output_fn)
-
------------------------------------------------------------------------------
--- Cc phase
-
-runPhase (RealPhase cc_phase) input_fn dflags
- | any (cc_phase `eqPhase`) [Cc, Ccxx, HCc, Cobjc, Cobjcxx]
- = do
- let platform = targetPlatform dflags
- hcc = cc_phase `eqPhase` HCc
-
- let cmdline_include_paths = includePaths dflags
-
- -- HC files have the dependent packages stamped into them
- pkgs <- if hcc then liftIO $ getHCFilePackages input_fn else return []
-
- -- add package include paths even if we're just compiling .c
- -- files; this is the Value Add(TM) that using ghc instead of
- -- gcc gives you :)
- pkg_include_dirs <- liftIO $ getPackageIncludePath dflags pkgs
- let include_paths_global = foldr (\ x xs -> ("-I" ++ x) : xs) []
- (includePathsGlobal cmdline_include_paths ++ pkg_include_dirs)
- let include_paths_quote = foldr (\ x xs -> ("-iquote" ++ x) : xs) []
- (includePathsQuote cmdline_include_paths)
- let include_paths = include_paths_quote ++ include_paths_global
-
- -- pass -D or -optP to preprocessor when compiling foreign C files
- -- (#16737). Doing it in this way is simpler and also enable the C
- -- compiler to perform preprocessing and parsing in a single pass,
- -- but it may introduce inconsistency if a different pgm_P is specified.
- let more_preprocessor_opts = concat
- [ ["-Xpreprocessor", i]
- | not hcc
- , i <- getOpts dflags opt_P
- ]
-
- let gcc_extra_viac_flags = extraGccViaCFlags dflags
- let pic_c_flags = picCCOpts dflags
-
- let verbFlags = getVerbFlags dflags
-
- -- cc-options are not passed when compiling .hc files. Our
- -- hc code doesn't not #include any header files anyway, so these
- -- options aren't necessary.
- pkg_extra_cc_opts <- liftIO $
- if hcc
- then return []
- else getPackageExtraCcOpts dflags pkgs
-
- framework_paths <-
- if platformUsesFrameworks platform
- then do pkgFrameworkPaths <- liftIO $ getPackageFrameworkPath dflags pkgs
- let cmdlineFrameworkPaths = frameworkPaths dflags
- return $ map ("-F"++)
- (cmdlineFrameworkPaths ++ pkgFrameworkPaths)
- else return []
-
- let cc_opt | optLevel dflags >= 2 = [ "-O2" ]
- | optLevel dflags >= 1 = [ "-O" ]
- | otherwise = []
-
- -- Decide next phase
- let next_phase = As False
- output_fn <- phaseOutputFilename next_phase
-
- let
- more_hcc_opts =
- -- on x86 the floating point regs have greater precision
- -- than a double, which leads to unpredictable results.
- -- By default, we turn this off with -ffloat-store unless
- -- the user specified -fexcess-precision.
- (if platformArch platform == ArchX86 &&
- not (gopt Opt_ExcessPrecision dflags)
- then [ "-ffloat-store" ]
- else []) ++
-
- -- gcc's -fstrict-aliasing allows two accesses to memory
- -- to be considered non-aliasing if they have different types.
- -- This interacts badly with the C code we generate, which is
- -- very weakly typed, being derived from C--.
- ["-fno-strict-aliasing"]
-
- ghcVersionH <- liftIO $ getGhcVersionPathName dflags
-
- liftIO $ SysTools.runCc (phaseForeignLanguage cc_phase) dflags (
- [ SysTools.FileOption "" input_fn
- , SysTools.Option "-o"
- , SysTools.FileOption "" output_fn
- ]
- ++ map SysTools.Option (
- pic_c_flags
-
- -- Stub files generated for foreign exports references the runIO_closure
- -- and runNonIO_closure symbols, which are defined in the base package.
- -- These symbols are imported into the stub.c file via RtsAPI.h, and the
- -- way we do the import depends on whether we're currently compiling
- -- the base package or not.
- ++ (if platformOS platform == OSMinGW32 &&
- thisPackage dflags == baseUnitId
- then [ "-DCOMPILING_BASE_PACKAGE" ]
- else [])
-
- -- We only support SparcV9 and better because V8 lacks an atomic CAS
- -- instruction. Note that the user can still override this
- -- (e.g., -mcpu=ultrasparc) as GCC picks the "best" -mcpu flag
- -- regardless of the ordering.
- --
- -- This is a temporary hack. See #2872, commit
- -- 5bd3072ac30216a505151601884ac88bf404c9f2
- ++ (if platformArch platform == ArchSPARC
- then ["-mcpu=v9"]
- else [])
-
- -- GCC 4.6+ doesn't like -Wimplicit when compiling C++.
- ++ (if (cc_phase /= Ccxx && cc_phase /= Cobjcxx)
- then ["-Wimplicit"]
- else [])
-
- ++ (if hcc
- then gcc_extra_viac_flags ++ more_hcc_opts
- else [])
- ++ verbFlags
- ++ [ "-S" ]
- ++ cc_opt
- ++ [ "-include", ghcVersionH ]
- ++ framework_paths
- ++ include_paths
- ++ more_preprocessor_opts
- ++ pkg_extra_cc_opts
- ))
-
- return (RealPhase next_phase, output_fn)
-
------------------------------------------------------------------------------
--- As, SpitAs phase : Assembler
-
--- This is for calling the assembler on a regular assembly file
-runPhase (RealPhase (As with_cpp)) input_fn dflags
- = do
- -- LLVM from version 3.0 onwards doesn't support the OS X system
- -- assembler, so we use clang as the assembler instead. (#5636)
- let as_prog | hscTarget dflags == HscLlvm &&
- platformOS (targetPlatform dflags) == OSDarwin
- = SysTools.runClang
- | otherwise = SysTools.runAs
-
- let cmdline_include_paths = includePaths dflags
- let pic_c_flags = picCCOpts dflags
-
- next_phase <- maybeMergeForeign
- output_fn <- phaseOutputFilename next_phase
-
- -- we create directories for the object file, because it
- -- might be a hierarchical module.
- liftIO $ createDirectoryIfMissing True (takeDirectory output_fn)
-
- ccInfo <- liftIO $ getCompilerInfo dflags
- let global_includes = [ SysTools.Option ("-I" ++ p)
- | p <- includePathsGlobal cmdline_include_paths ]
- let local_includes = [ SysTools.Option ("-iquote" ++ p)
- | p <- includePathsQuote cmdline_include_paths ]
- let runAssembler inputFilename outputFilename
- = liftIO $ do
- withAtomicRename outputFilename $ \temp_outputFilename -> do
- as_prog
- dflags
- (local_includes ++ global_includes
- -- See Note [-fPIC for assembler]
- ++ map SysTools.Option pic_c_flags
- -- See Note [Produce big objects on Windows]
- ++ [ SysTools.Option "-Wa,-mbig-obj"
- | platformOS (targetPlatform dflags) == OSMinGW32
- , not $ target32Bit (targetPlatform dflags)
- ]
-
- -- We only support SparcV9 and better because V8 lacks an atomic CAS
- -- instruction so we have to make sure that the assembler accepts the
- -- instruction set. Note that the user can still override this
- -- (e.g., -mcpu=ultrasparc). GCC picks the "best" -mcpu flag
- -- regardless of the ordering.
- --
- -- This is a temporary hack.
- ++ (if platformArch (targetPlatform dflags) == ArchSPARC
- then [SysTools.Option "-mcpu=v9"]
- else [])
- ++ (if any (ccInfo ==) [Clang, AppleClang, AppleClang51]
- then [SysTools.Option "-Qunused-arguments"]
- else [])
- ++ [ SysTools.Option "-x"
- , if with_cpp
- then SysTools.Option "assembler-with-cpp"
- else SysTools.Option "assembler"
- , SysTools.Option "-c"
- , SysTools.FileOption "" inputFilename
- , SysTools.Option "-o"
- , SysTools.FileOption "" temp_outputFilename
- ])
-
- liftIO $ debugTraceMsg dflags 4 (text "Running the assembler")
- runAssembler input_fn output_fn
-
- return (RealPhase next_phase, output_fn)
-
-
------------------------------------------------------------------------------
--- LlvmOpt phase
-runPhase (RealPhase LlvmOpt) input_fn dflags
- = do
- output_fn <- phaseOutputFilename LlvmLlc
-
- liftIO $ SysTools.runLlvmOpt dflags
- ( optFlag
- ++ defaultOptions ++
- [ SysTools.FileOption "" input_fn
- , SysTools.Option "-o"
- , SysTools.FileOption "" output_fn]
- )
-
- return (RealPhase LlvmLlc, output_fn)
- where
- -- we always (unless -optlo specified) run Opt since we rely on it to
- -- fix up some pretty big deficiencies in the code we generate
- optIdx = max 0 $ min 2 $ optLevel dflags -- ensure we're in [0,2]
- llvmOpts = case lookup optIdx $ llvmPasses $ llvmConfig dflags of
- Just passes -> passes
- Nothing -> panic ("runPhase LlvmOpt: llvm-passes file "
- ++ "is missing passes for level "
- ++ show optIdx)
-
- -- don't specify anything if user has specified commands. We do this
- -- for opt but not llc since opt is very specifically for optimisation
- -- passes only, so if the user is passing us extra options we assume
- -- they know what they are doing and don't get in the way.
- optFlag = if null (getOpts dflags opt_lo)
- then map SysTools.Option $ words llvmOpts
- else []
-
- defaultOptions = map SysTools.Option . concat . fmap words . fst
- $ unzip (llvmOptions dflags)
-
------------------------------------------------------------------------------
--- LlvmLlc phase
-
-runPhase (RealPhase LlvmLlc) input_fn dflags
- = do
- next_phase <- if | fastLlvmPipeline dflags -> maybeMergeForeign
- -- hidden debugging flag '-dno-llvm-mangler' to skip mangling
- | gopt Opt_NoLlvmMangler dflags -> return (As False)
- | otherwise -> return LlvmMangle
-
- output_fn <- phaseOutputFilename next_phase
-
- liftIO $ SysTools.runLlvmLlc dflags
- ( optFlag
- ++ defaultOptions
- ++ [ SysTools.FileOption "" input_fn
- , SysTools.Option "-o"
- , SysTools.FileOption "" output_fn
- ]
- )
-
- return (RealPhase next_phase, output_fn)
- where
- -- Note [Clamping of llc optimizations]
- --
- -- See #13724
- --
- -- we clamp the llc optimization between [1,2]. This is because passing -O0
- -- to llc 3.9 or llc 4.0, the naive register allocator can fail with
- --
- -- Error while trying to spill R1 from class GPR: Cannot scavenge register
- -- without an emergency spill slot!
- --
- -- Observed at least with target 'arm-unknown-linux-gnueabihf'.
- --
- --
- -- With LLVM4, llc -O3 crashes when ghc-stage1 tries to compile
- -- rts/HeapStackCheck.cmm
- --
- -- llc -O3 '-mtriple=arm-unknown-linux-gnueabihf' -enable-tbaa /var/folders/fv/xqjrpfj516n5xq_m_ljpsjx00000gn/T/ghc33674_0/ghc_6.bc -o /var/folders/fv/xqjrpfj516n5xq_m_ljpsjx00000gn/T/ghc33674_0/ghc_7.lm_s
- -- 0 llc 0x0000000102ae63e8 llvm::sys::PrintStackTrace(llvm::raw_ostream&) + 40
- -- 1 llc 0x0000000102ae69a6 SignalHandler(int) + 358
- -- 2 libsystem_platform.dylib 0x00007fffc23f4b3a _sigtramp + 26
- -- 3 libsystem_c.dylib 0x00007fffc226498b __vfprintf + 17876
- -- 4 llc 0x00000001029d5123 llvm::SelectionDAGISel::LowerArguments(llvm::Function const&) + 5699
- -- 5 llc 0x0000000102a21a35 llvm::SelectionDAGISel::SelectAllBasicBlocks(llvm::Function const&) + 3381
- -- 6 llc 0x0000000102a202b1 llvm::SelectionDAGISel::runOnMachineFunction(llvm::MachineFunction&) + 1457
- -- 7 llc 0x0000000101bdc474 (anonymous namespace)::ARMDAGToDAGISel::runOnMachineFunction(llvm::MachineFunction&) + 20
- -- 8 llc 0x00000001025573a6 llvm::MachineFunctionPass::runOnFunction(llvm::Function&) + 134
- -- 9 llc 0x000000010274fb12 llvm::FPPassManager::runOnFunction(llvm::Function&) + 498
- -- 10 llc 0x000000010274fd23 llvm::FPPassManager::runOnModule(llvm::Module&) + 67
- -- 11 llc 0x00000001027501b8 llvm::legacy::PassManagerImpl::run(llvm::Module&) + 920
- -- 12 llc 0x000000010195f075 compileModule(char**, llvm::LLVMContext&) + 12133
- -- 13 llc 0x000000010195bf0b main + 491
- -- 14 libdyld.dylib 0x00007fffc21e5235 start + 1
- -- Stack dump:
- -- 0. Program arguments: llc -O3 -mtriple=arm-unknown-linux-gnueabihf -enable-tbaa /var/folders/fv/xqjrpfj516n5xq_m_ljpsjx00000gn/T/ghc33674_0/ghc_6.bc -o /var/folders/fv/xqjrpfj516n5xq_m_ljpsjx00000gn/T/ghc33674_0/ghc_7.lm_s
- -- 1. Running pass 'Function Pass Manager' on module '/var/folders/fv/xqjrpfj516n5xq_m_ljpsjx00000gn/T/ghc33674_0/ghc_6.bc'.
- -- 2. Running pass 'ARM Instruction Selection' on function '@"stg_gc_f1$def"'
- --
- -- Observed at least with -mtriple=arm-unknown-linux-gnueabihf -enable-tbaa
- --
- llvmOpts = case optLevel dflags of
- 0 -> "-O1" -- required to get the non-naive reg allocator. Passing -regalloc=greedy is not sufficient.
- 1 -> "-O1"
- _ -> "-O2"
-
- optFlag = if null (getOpts dflags opt_lc)
- then map SysTools.Option $ words llvmOpts
- else []
-
- defaultOptions = map SysTools.Option . concatMap words . snd
- $ unzip (llvmOptions dflags)
-
-
------------------------------------------------------------------------------
--- LlvmMangle phase
-
-runPhase (RealPhase LlvmMangle) input_fn dflags
- = do
- let next_phase = As False
- output_fn <- phaseOutputFilename next_phase
- liftIO $ llvmFixupAsm dflags input_fn output_fn
- return (RealPhase next_phase, output_fn)
-
------------------------------------------------------------------------------
--- merge in stub objects
-
-runPhase (RealPhase MergeForeign) input_fn dflags
- = do
- PipeState{foreign_os} <- getPipeState
- output_fn <- phaseOutputFilename StopLn
- liftIO $ createDirectoryIfMissing True (takeDirectory output_fn)
- if null foreign_os
- then panic "runPhase(MergeForeign): no foreign objects"
- else do
- liftIO $ joinObjectFiles dflags (input_fn : foreign_os) output_fn
- return (RealPhase StopLn, output_fn)
-
--- warning suppression
-runPhase (RealPhase other) _input_fn _dflags =
- panic ("runPhase: don't know how to run phase " ++ show other)
-
-maybeMergeForeign :: CompPipeline Phase
-maybeMergeForeign
- = do
- PipeState{foreign_os} <- getPipeState
- if null foreign_os then return StopLn else return MergeForeign
-
-getLocation :: HscSource -> ModuleName -> CompPipeline ModLocation
-getLocation src_flavour mod_name = do
- dflags <- getDynFlags
-
- PipeEnv{ src_basename=basename,
- src_suffix=suff } <- getPipeEnv
- PipeState { maybe_loc=maybe_loc} <- getPipeState
- case maybe_loc of
- -- Build a ModLocation to pass to hscMain.
- -- The source filename is rather irrelevant by now, but it's used
- -- by hscMain for messages. hscMain also needs
- -- the .hi and .o filenames. If we already have a ModLocation
- -- then simply update the extensions of the interface and object
- -- files to match the DynFlags, otherwise use the logic in Finder.
- Just l -> return $ l
- { ml_hs_file = Just $ basename <.> suff
- , ml_hi_file = ml_hi_file l -<.> hiSuf dflags
- , ml_obj_file = ml_obj_file l -<.> objectSuf dflags
- }
- _ -> do
- location1 <- liftIO $ mkHomeModLocation2 dflags mod_name basename suff
-
- -- Boot-ify it if necessary
- let location2
- | HsBootFile <- src_flavour = addBootSuffixLocnOut location1
- | otherwise = location1
-
-
- -- Take -ohi into account if present
- -- 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 }
- | otherwise = location2
-
- -- Take -o into account if present
- -- Very like -ohi, but we must *only* do this if we aren't linking
- -- (If we're linking then the -o applies to the linked thing, not to
- -- the object file for one module.)
- -- Note the nasty duplication with the same computation in compileFile
- -- above
- let expl_o_file = outputFile dflags
- location4 | Just ofile <- expl_o_file
- , isNoLink (ghcLink dflags)
- = location3 { ml_obj_file = ofile }
- | otherwise = location3
- return location4
-
------------------------------------------------------------------------------
--- Look for the /* GHC_PACKAGES ... */ comment at the top of a .hc file
-
-getHCFilePackages :: FilePath -> IO [InstalledUnitId]
-getHCFilePackages filename =
- Exception.bracket (openFile filename ReadMode) hClose $ \h -> do
- l <- hGetLine h
- case l of
- '/':'*':' ':'G':'H':'C':'_':'P':'A':'C':'K':'A':'G':'E':'S':rest ->
- return (map stringToInstalledUnitId (words rest))
- _other ->
- return []
-
------------------------------------------------------------------------------
--- Static linking, of .o files
-
--- The list of packages passed to link is the list of packages on
--- which this program depends, as discovered by the compilation
--- manager. It is combined with the list of packages that the user
--- specifies on the command line with -package flags.
---
--- In one-shot linking mode, we can't discover the package
--- dependencies (because we haven't actually done any compilation or
--- read any interface files), so the user must explicitly specify all
--- the packages.
-
-{-
-Note [-Xlinker -rpath vs -Wl,-rpath]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
--Wl takes a comma-separated list of options which in the case of
--Wl,-rpath -Wl,some,path,with,commas parses the path with commas
-as separate options.
-Buck, the build system, produces paths with commas in them.
-
--Xlinker doesn't have this disadvantage and as far as I can tell
-it is supported by both gcc and clang. Anecdotally nvcc supports
--Xlinker, but not -Wl.
--}
-
-linkBinary :: DynFlags -> [FilePath] -> [InstalledUnitId] -> IO ()
-linkBinary = linkBinary' False
-
-linkBinary' :: Bool -> DynFlags -> [FilePath] -> [InstalledUnitId] -> IO ()
-linkBinary' staticLink dflags o_files dep_packages = do
- let platform = targetPlatform dflags
- toolSettings' = toolSettings dflags
- verbFlags = getVerbFlags dflags
- output_fn = exeFileName staticLink dflags
-
- -- get the full list of packages to link with, by combining the
- -- explicit packages with the auto packages and all of their
- -- dependencies, and eliminating duplicates.
-
- full_output_fn <- if isAbsolute output_fn
- then return output_fn
- else do d <- getCurrentDirectory
- return $ normalise (d </> output_fn)
- pkg_lib_paths <- getPackageLibraryPath dflags dep_packages
- let pkg_lib_path_opts = concatMap get_pkg_lib_path_opts pkg_lib_paths
- get_pkg_lib_path_opts l
- | osElfTarget (platformOS platform) &&
- dynLibLoader dflags == SystemDependent &&
- WayDyn `elem` ways dflags
- = let libpath = if gopt Opt_RelativeDynlibPaths dflags
- then "$ORIGIN" </>
- (l `makeRelativeTo` full_output_fn)
- else l
- -- See Note [-Xlinker -rpath vs -Wl,-rpath]
- rpath = if gopt Opt_RPath dflags
- then ["-Xlinker", "-rpath", "-Xlinker", libpath]
- else []
- -- Solaris 11's linker does not support -rpath-link option. It silently
- -- ignores it and then complains about next option which is -l<some
- -- dir> as being a directory and not expected object file, E.g
- -- ld: elf error: file
- -- /tmp/ghc-src/libraries/base/dist-install/build:
- -- elf_begin: I/O error: region read: Is a directory
- rpathlink = if (platformOS platform) == OSSolaris2
- then []
- else ["-Xlinker", "-rpath-link", "-Xlinker", l]
- in ["-L" ++ l] ++ rpathlink ++ rpath
- | osMachOTarget (platformOS platform) &&
- dynLibLoader dflags == SystemDependent &&
- WayDyn `elem` ways dflags &&
- gopt Opt_RPath dflags
- = let libpath = if gopt Opt_RelativeDynlibPaths dflags
- then "@loader_path" </>
- (l `makeRelativeTo` full_output_fn)
- else l
- in ["-L" ++ l] ++ ["-Xlinker", "-rpath", "-Xlinker", libpath]
- | otherwise = ["-L" ++ l]
-
- pkg_lib_path_opts <-
- if gopt Opt_SingleLibFolder dflags
- then do
- libs <- getLibs dflags dep_packages
- tmpDir <- newTempDir dflags
- sequence_ [ copyFile lib (tmpDir </> basename)
- | (lib, basename) <- libs]
- return [ "-L" ++ tmpDir ]
- else pure pkg_lib_path_opts
-
- let
- dead_strip
- | gopt Opt_WholeArchiveHsLibs dflags = []
- | otherwise = if osSubsectionsViaSymbols (platformOS platform)
- then ["-Wl,-dead_strip"]
- else []
- let lib_paths = libraryPaths dflags
- let lib_path_opts = map ("-L"++) lib_paths
-
- extraLinkObj <- mkExtraObjToLinkIntoBinary dflags
- noteLinkObjs <- mkNoteObjsToLinkIntoBinary dflags dep_packages
-
- let
- (pre_hs_libs, post_hs_libs)
- | gopt Opt_WholeArchiveHsLibs dflags
- = if platformOS platform == OSDarwin
- then (["-Wl,-all_load"], [])
- -- OS X does not have a flag to turn off -all_load
- else (["-Wl,--whole-archive"], ["-Wl,--no-whole-archive"])
- | otherwise
- = ([],[])
-
- pkg_link_opts <- do
- (package_hs_libs, extra_libs, other_flags) <- getPackageLinkOpts dflags dep_packages
- return $ if staticLink
- then package_hs_libs -- If building an executable really means making a static
- -- library (e.g. iOS), then we only keep the -l options for
- -- HS packages, because libtool doesn't accept other options.
- -- In the case of iOS these need to be added by hand to the
- -- final link in Xcode.
- else other_flags ++ dead_strip
- ++ pre_hs_libs ++ package_hs_libs ++ post_hs_libs
- ++ extra_libs
- -- -Wl,-u,<sym> contained in other_flags
- -- needs to be put before -l<package>,
- -- otherwise Solaris linker fails linking
- -- a binary with unresolved symbols in RTS
- -- which are defined in base package
- -- the reason for this is a note in ld(1) about
- -- '-u' option: "The placement of this option
- -- on the command line is significant.
- -- This option must be placed before the library
- -- that defines the symbol."
-
- -- frameworks
- pkg_framework_opts <- getPkgFrameworkOpts dflags platform dep_packages
- let framework_opts = getFrameworkOpts dflags platform
-
- -- probably _stub.o files
- let extra_ld_inputs = ldInputs dflags
-
- rc_objs <- maybeCreateManifest dflags output_fn
-
- let link = if staticLink
- then SysTools.runLibtool
- else SysTools.runLink
- link dflags (
- map SysTools.Option verbFlags
- ++ [ SysTools.Option "-o"
- , SysTools.FileOption "" output_fn
- ]
- ++ libmLinkOpts
- ++ map SysTools.Option (
- []
-
- -- See Note [No PIE when linking]
- ++ picCCOpts dflags
-
- -- Permit the linker to auto link _symbol to _imp_symbol.
- -- This lets us link against DLLs without needing an "import library".
- ++ (if platformOS platform == OSMinGW32
- then ["-Wl,--enable-auto-import"]
- else [])
-
- -- '-no_compact_unwind'
- -- C++/Objective-C exceptions cannot use optimised
- -- stack unwinding code. The optimised form is the
- -- default in Xcode 4 on at least x86_64, and
- -- without this flag we're also seeing warnings
- -- like
- -- ld: warning: could not create compact unwind for .LFB3: non-standard register 5 being saved in prolog
- -- on x86.
- ++ (if toolSettings_ldSupportsCompactUnwind toolSettings' &&
- not staticLink &&
- (platformOS platform == OSDarwin) &&
- case platformArch platform of
- ArchX86 -> True
- ArchX86_64 -> True
- ArchARM {} -> True
- ArchARM64 -> True
- _ -> False
- then ["-Wl,-no_compact_unwind"]
- else [])
-
- -- '-Wl,-read_only_relocs,suppress'
- -- ld gives loads of warnings like:
- -- ld: warning: text reloc in _base_GHCziArr_unsafeArray_info to _base_GHCziArr_unsafeArray_closure
- -- when linking any program. We're not sure
- -- whether this is something we ought to fix, but
- -- for now this flags silences them.
- ++ (if platformOS platform == OSDarwin &&
- platformArch platform == ArchX86 &&
- not staticLink
- then ["-Wl,-read_only_relocs,suppress"]
- else [])
-
- ++ (if toolSettings_ldIsGnuLd toolSettings' &&
- not (gopt Opt_WholeArchiveHsLibs dflags)
- then ["-Wl,--gc-sections"]
- else [])
-
- ++ o_files
- ++ lib_path_opts)
- ++ extra_ld_inputs
- ++ map SysTools.Option (
- rc_objs
- ++ framework_opts
- ++ pkg_lib_path_opts
- ++ extraLinkObj:noteLinkObjs
- ++ pkg_link_opts
- ++ pkg_framework_opts
- ++ (if platformOS platform == OSDarwin
- then [ "-Wl,-dead_strip_dylibs" ]
- else [])
- ))
-
-exeFileName :: Bool -> DynFlags -> FilePath
-exeFileName staticLink dflags
- | Just s <- outputFile dflags =
- case platformOS (targetPlatform dflags) of
- OSMinGW32 -> s <?.> "exe"
- _ -> if staticLink
- then s <?.> "a"
- else s
- | otherwise =
- if platformOS (targetPlatform dflags) == OSMinGW32
- then "main.exe"
- else if staticLink
- then "liba.a"
- else "a.out"
- where s <?.> ext | null (takeExtension s) = s <.> ext
- | otherwise = s
-
-maybeCreateManifest
- :: DynFlags
- -> FilePath -- filename of executable
- -> IO [FilePath] -- extra objects to embed, maybe
-maybeCreateManifest dflags exe_filename
- | platformOS (targetPlatform dflags) == OSMinGW32 &&
- gopt Opt_GenManifest dflags
- = do let manifest_filename = exe_filename <.> "manifest"
-
- writeFile manifest_filename $
- "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"yes\"?>\n"++
- " <assembly xmlns=\"urn:schemas-microsoft-com:asm.v1\" manifestVersion=\"1.0\">\n"++
- " <assemblyIdentity version=\"1.0.0.0\"\n"++
- " processorArchitecture=\"X86\"\n"++
- " name=\"" ++ dropExtension exe_filename ++ "\"\n"++
- " type=\"win32\"/>\n\n"++
- " <trustInfo xmlns=\"urn:schemas-microsoft-com:asm.v3\">\n"++
- " <security>\n"++
- " <requestedPrivileges>\n"++
- " <requestedExecutionLevel level=\"asInvoker\" uiAccess=\"false\"/>\n"++
- " </requestedPrivileges>\n"++
- " </security>\n"++
- " </trustInfo>\n"++
- "</assembly>\n"
-
- -- Windows will find the manifest file if it is named
- -- foo.exe.manifest. However, for extra robustness, and so that
- -- we can move the binary around, we can embed the manifest in
- -- the binary itself using windres:
- if not (gopt Opt_EmbedManifest dflags) then return [] else do
-
- rc_filename <- newTempName dflags TFL_CurrentModule "rc"
- rc_obj_filename <-
- newTempName dflags TFL_GhcSession (objectSuf dflags)
-
- writeFile rc_filename $
- "1 24 MOVEABLE PURE " ++ show manifest_filename ++ "\n"
- -- magic numbers :-)
- -- show is a bit hackish above, but we need to escape the
- -- backslashes in the path.
-
- runWindres dflags $ map SysTools.Option $
- ["--input="++rc_filename,
- "--output="++rc_obj_filename,
- "--output-format=coff"]
- -- no FileOptions here: windres doesn't like seeing
- -- backslashes, apparently
-
- removeFile manifest_filename
-
- return [rc_obj_filename]
- | otherwise = return []
-
-
-linkDynLibCheck :: DynFlags -> [String] -> [InstalledUnitId] -> IO ()
-linkDynLibCheck dflags o_files dep_packages
- = do
- when (haveRtsOptsFlags dflags) $ do
- putLogMsg dflags NoReason SevInfo noSrcSpan
- (defaultUserStyle dflags)
- (text "Warning: -rtsopts and -with-rtsopts have no effect with -shared." $$
- text " Call hs_init_ghc() from your main() function to set these options.")
-
- linkDynLib dflags o_files dep_packages
-
--- | Linking a static lib will not really link anything. It will merely produce
--- a static archive of all dependent static libraries. The resulting library
--- will still need to be linked with any remaining link flags.
-linkStaticLib :: DynFlags -> [String] -> [InstalledUnitId] -> IO ()
-linkStaticLib dflags o_files dep_packages = do
- let extra_ld_inputs = [ f | FileOption _ f <- ldInputs dflags ]
- modules = o_files ++ extra_ld_inputs
- output_fn = exeFileName True dflags
-
- full_output_fn <- if isAbsolute output_fn
- then return output_fn
- else do d <- getCurrentDirectory
- return $ normalise (d </> output_fn)
- output_exists <- doesFileExist full_output_fn
- (when output_exists) $ removeFile full_output_fn
-
- pkg_cfgs <- getPreloadPackagesAnd dflags dep_packages
- archives <- concatMapM (collectArchives dflags) pkg_cfgs
-
- ar <- foldl mappend
- <$> (Archive <$> mapM loadObj modules)
- <*> mapM loadAr archives
-
- if toolSettings_ldIsGnuLd (toolSettings dflags)
- then writeGNUAr output_fn $ afilter (not . isGNUSymdef) ar
- else writeBSDAr output_fn $ afilter (not . isBSDSymdef) ar
-
- -- run ranlib over the archive. write*Ar does *not* create the symbol index.
- runRanlib dflags [SysTools.FileOption "" output_fn]
-
--- -----------------------------------------------------------------------------
--- Running CPP
-
-doCpp :: DynFlags -> Bool -> FilePath -> FilePath -> IO ()
-doCpp dflags raw input_fn output_fn = do
- let hscpp_opts = picPOpts dflags
- let cmdline_include_paths = includePaths dflags
-
- pkg_include_dirs <- getPackageIncludePath dflags []
- let include_paths_global = foldr (\ x xs -> ("-I" ++ x) : xs) []
- (includePathsGlobal cmdline_include_paths ++ pkg_include_dirs)
- let include_paths_quote = foldr (\ x xs -> ("-iquote" ++ x) : xs) []
- (includePathsQuote cmdline_include_paths)
- let include_paths = include_paths_quote ++ include_paths_global
-
- let verbFlags = getVerbFlags dflags
-
- let cpp_prog args | raw = SysTools.runCpp dflags args
- | otherwise = SysTools.runCc Nothing dflags (SysTools.Option "-E" : args)
-
- let targetArch = stringEncodeArch $ platformArch $ targetPlatform dflags
- targetOS = stringEncodeOS $ platformOS $ targetPlatform dflags
- let target_defs =
- [ "-D" ++ HOST_OS ++ "_BUILD_OS",
- "-D" ++ HOST_ARCH ++ "_BUILD_ARCH",
- "-D" ++ targetOS ++ "_HOST_OS",
- "-D" ++ targetArch ++ "_HOST_ARCH" ]
- -- remember, in code we *compile*, the HOST is the same our TARGET,
- -- and BUILD is the same as our HOST.
-
- let sse_defs =
- [ "-D__SSE__" | isSseEnabled dflags ] ++
- [ "-D__SSE2__" | isSse2Enabled dflags ] ++
- [ "-D__SSE4_2__" | isSse4_2Enabled dflags ]
-
- let avx_defs =
- [ "-D__AVX__" | isAvxEnabled dflags ] ++
- [ "-D__AVX2__" | isAvx2Enabled dflags ] ++
- [ "-D__AVX512CD__" | isAvx512cdEnabled dflags ] ++
- [ "-D__AVX512ER__" | isAvx512erEnabled dflags ] ++
- [ "-D__AVX512F__" | isAvx512fEnabled dflags ] ++
- [ "-D__AVX512PF__" | isAvx512pfEnabled dflags ]
-
- backend_defs <- getBackendDefs dflags
-
- let th_defs = [ "-D__GLASGOW_HASKELL_TH__" ]
- -- Default CPP defines in Haskell source
- ghcVersionH <- getGhcVersionPathName dflags
- let hsSourceCppOpts = [ "-include", ghcVersionH ]
-
- -- MIN_VERSION macros
- let uids = explicitPackages (pkgState dflags)
- pkgs = catMaybes (map (lookupUnit dflags) uids)
- mb_macro_include <-
- if not (null pkgs) && gopt Opt_VersionMacros dflags
- then do macro_stub <- newTempName dflags TFL_CurrentModule "h"
- writeFile macro_stub (generatePackageVersionMacros pkgs)
- -- Include version macros for every *exposed* package.
- -- Without -hide-all-packages and with a package database
- -- size of 1000 packages, it takes cpp an estimated 2
- -- milliseconds to process this file. See #10970
- -- comment 8.
- return [SysTools.FileOption "-include" macro_stub]
- else return []
-
- cpp_prog ( map SysTools.Option verbFlags
- ++ map SysTools.Option include_paths
- ++ map SysTools.Option hsSourceCppOpts
- ++ map SysTools.Option target_defs
- ++ map SysTools.Option backend_defs
- ++ map SysTools.Option th_defs
- ++ map SysTools.Option hscpp_opts
- ++ map SysTools.Option sse_defs
- ++ map SysTools.Option avx_defs
- ++ mb_macro_include
- -- Set the language mode to assembler-with-cpp when preprocessing. This
- -- alleviates some of the C99 macro rules relating to whitespace and the hash
- -- operator, which we tend to abuse. Clang in particular is not very happy
- -- about this.
- ++ [ SysTools.Option "-x"
- , SysTools.Option "assembler-with-cpp"
- , SysTools.Option input_fn
- -- We hackily use Option instead of FileOption here, so that the file
- -- name is not back-slashed on Windows. cpp is capable of
- -- dealing with / in filenames, so it works fine. Furthermore
- -- if we put in backslashes, cpp outputs #line directives
- -- with *double* backslashes. And that in turn means that
- -- our error messages get double backslashes in them.
- -- In due course we should arrange that the lexer deals
- -- with these \\ escapes properly.
- , SysTools.Option "-o"
- , SysTools.FileOption "" output_fn
- ])
-
-getBackendDefs :: DynFlags -> IO [String]
-getBackendDefs dflags | hscTarget dflags == HscLlvm = do
- llvmVer <- figureLlvmVersion dflags
- return $ case fmap llvmVersionList llvmVer of
- Just [m] -> [ "-D__GLASGOW_HASKELL_LLVM__=" ++ format (m,0) ]
- Just (m:n:_) -> [ "-D__GLASGOW_HASKELL_LLVM__=" ++ format (m,n) ]
- _ -> []
- where
- format (major, minor)
- | minor >= 100 = error "getBackendDefs: Unsupported minor version"
- | otherwise = show $ (100 * major + minor :: Int) -- Contract is Int
-
-getBackendDefs _ =
- return []
-
--- ---------------------------------------------------------------------------
--- Macros (cribbed from Cabal)
-
-generatePackageVersionMacros :: [UnitInfo] -> String
-generatePackageVersionMacros pkgs = concat
- -- Do not add any C-style comments. See #3389.
- [ generateMacros "" pkgname version
- | pkg <- pkgs
- , let version = packageVersion pkg
- pkgname = map fixchar (packageNameString pkg)
- ]
-
-fixchar :: Char -> Char
-fixchar '-' = '_'
-fixchar c = c
-
-generateMacros :: String -> String -> Version -> String
-generateMacros prefix name version =
- concat
- ["#define ", prefix, "VERSION_",name," ",show (showVersion version),"\n"
- ,"#define MIN_", prefix, "VERSION_",name,"(major1,major2,minor) (\\\n"
- ," (major1) < ",major1," || \\\n"
- ," (major1) == ",major1," && (major2) < ",major2," || \\\n"
- ," (major1) == ",major1," && (major2) == ",major2," && (minor) <= ",minor,")"
- ,"\n\n"
- ]
- where
- (major1:major2:minor:_) = map show (versionBranch version ++ repeat 0)
-
--- ---------------------------------------------------------------------------
--- join object files into a single relocatable object file, using ld -r
-
-{-
-Note [Produce big objects on Windows]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-The Windows Portable Executable object format has a limit of 32k sections, which
-we tend to blow through pretty easily. Thankfully, there is a "big object"
-extension, which raises this limit to 2^32. However, it must be explicitly
-enabled in the toolchain:
-
- * the assembler accepts the -mbig-obj flag, which causes it to produce a
- bigobj-enabled COFF object.
-
- * the linker accepts the --oformat pe-bigobj-x86-64 flag. Despite what the name
- suggests, this tells the linker to produce a bigobj-enabled COFF object, no a
- PE executable.
-
-We must enable bigobj output in a few places:
-
- * When merging object files (DriverPipeline.joinObjectFiles)
-
- * When assembling (DriverPipeline.runPhase (RealPhase As ...))
-
-Unfortunately the big object format is not supported on 32-bit targets so
-none of this can be used in that case.
--}
-
-joinObjectFiles :: DynFlags -> [FilePath] -> FilePath -> IO ()
-joinObjectFiles dflags o_files output_fn = do
- let toolSettings' = toolSettings dflags
- ldIsGnuLd = toolSettings_ldIsGnuLd toolSettings'
- osInfo = platformOS (targetPlatform dflags)
- ld_r args cc = SysTools.runLink dflags ([
- SysTools.Option "-nostdlib",
- SysTools.Option "-Wl,-r"
- ]
- -- See Note [No PIE while linking] in DynFlags
- ++ (if toolSettings_ccSupportsNoPie toolSettings'
- then [SysTools.Option "-no-pie"]
- else [])
-
- ++ (if any (cc ==) [Clang, AppleClang, AppleClang51]
- then []
- else [SysTools.Option "-nodefaultlibs"])
- ++ (if osInfo == OSFreeBSD
- then [SysTools.Option "-L/usr/lib"]
- else [])
- -- gcc on sparc sets -Wl,--relax implicitly, but
- -- -r and --relax are incompatible for ld, so
- -- disable --relax explicitly.
- ++ (if platformArch (targetPlatform dflags)
- `elem` [ArchSPARC, ArchSPARC64]
- && ldIsGnuLd
- then [SysTools.Option "-Wl,-no-relax"]
- else [])
- -- See Note [Produce big objects on Windows]
- ++ [ SysTools.Option "-Wl,--oformat,pe-bigobj-x86-64"
- | OSMinGW32 == osInfo
- , not $ target32Bit (targetPlatform dflags)
- ]
- ++ map SysTools.Option ld_build_id
- ++ [ SysTools.Option "-o",
- SysTools.FileOption "" output_fn ]
- ++ args)
-
- -- suppress the generation of the .note.gnu.build-id section,
- -- which we don't need and sometimes causes ld to emit a
- -- warning:
- ld_build_id | toolSettings_ldSupportsBuildId toolSettings' = ["-Wl,--build-id=none"]
- | otherwise = []
-
- ccInfo <- getCompilerInfo dflags
- if ldIsGnuLd
- then do
- script <- newTempName dflags TFL_CurrentModule "ldscript"
- cwd <- getCurrentDirectory
- let o_files_abs = map (\x -> "\"" ++ (cwd </> x) ++ "\"") o_files
- writeFile script $ "INPUT(" ++ unwords o_files_abs ++ ")"
- ld_r [SysTools.FileOption "" script] ccInfo
- else if toolSettings_ldSupportsFilelist toolSettings'
- then do
- filelist <- newTempName dflags TFL_CurrentModule "filelist"
- writeFile filelist $ unlines o_files
- ld_r [SysTools.Option "-Wl,-filelist",
- SysTools.FileOption "-Wl," filelist] ccInfo
- else do
- ld_r (map (SysTools.FileOption "") o_files) ccInfo
-
--- -----------------------------------------------------------------------------
--- Misc.
-
-writeInterfaceOnlyMode :: DynFlags -> Bool
-writeInterfaceOnlyMode dflags =
- gopt Opt_WriteInterface dflags &&
- HscNothing == hscTarget dflags
-
--- | Figure out if a source file was modified after an output file (or if we
--- anyways need to consider the source file modified since the output is gone).
-sourceModified :: FilePath -- ^ destination file we are looking for
- -> UTCTime -- ^ last time of modification of source file
- -> IO Bool -- ^ do we need to regenerate the output?
-sourceModified dest_file src_timestamp = do
- dest_file_exists <- doesFileExist dest_file
- if not dest_file_exists
- then return True -- Need to recompile
- else do t2 <- getModificationUTCTime dest_file
- return (t2 <= src_timestamp)
-
--- | What phase to run after one of the backend code generators has run
-hscPostBackendPhase :: HscSource -> HscTarget -> Phase
-hscPostBackendPhase HsBootFile _ = StopLn
-hscPostBackendPhase HsigFile _ = StopLn
-hscPostBackendPhase _ hsc_lang =
- case hsc_lang of
- HscC -> HCc
- HscAsm -> As False
- HscLlvm -> LlvmOpt
- HscNothing -> StopLn
- HscInterpreted -> StopLn
-
-touchObjectFile :: DynFlags -> FilePath -> IO ()
-touchObjectFile dflags path = do
- createDirectoryIfMissing True $ takeDirectory path
- SysTools.touch dflags "Touching object file" path
-
--- | Find out path to @ghcversion.h@ file
-getGhcVersionPathName :: DynFlags -> IO FilePath
-getGhcVersionPathName dflags = do
- candidates <- case ghcVersionFile dflags of
- Just path -> return [path]
- Nothing -> (map (</> "ghcversion.h")) <$>
- (getPackageIncludePath dflags [toInstalledUnitId rtsUnitId])
-
- found <- filterM doesFileExist candidates
- case found of
- [] -> throwGhcExceptionIO (InstallationError
- ("ghcversion.h missing; tried: "
- ++ intercalate ", " candidates))
- (x:_) -> return x
-
--- Note [-fPIC for assembler]
--- When compiling .c source file GHC's driver pipeline basically
--- does the following two things:
--- 1. ${CC} -S 'PIC_CFLAGS' source.c
--- 2. ${CC} -x assembler -c 'PIC_CFLAGS' source.S
---
--- Why do we need to pass 'PIC_CFLAGS' both to C compiler and assembler?
--- Because on some architectures (at least sparc32) assembler also chooses
--- the relocation type!
--- Consider the following C module:
---
--- /* pic-sample.c */
--- int v;
--- void set_v (int n) { v = n; }
--- int get_v (void) { return v; }
---
--- $ gcc -S -fPIC pic-sample.c
--- $ gcc -c pic-sample.s -o pic-sample.no-pic.o # incorrect binary
--- $ gcc -c -fPIC pic-sample.s -o pic-sample.pic.o # correct binary
---
--- $ objdump -r -d pic-sample.pic.o > pic-sample.pic.o.od
--- $ objdump -r -d pic-sample.no-pic.o > pic-sample.no-pic.o.od
--- $ diff -u pic-sample.pic.o.od pic-sample.no-pic.o.od
---
--- Most of architectures won't show any difference in this test, but on sparc32
--- the following assembly snippet:
---
--- sethi %hi(_GLOBAL_OFFSET_TABLE_-8), %l7
---
--- generates two kinds or relocations, only 'R_SPARC_PC22' is correct:
---
--- 3c: 2f 00 00 00 sethi %hi(0), %l7
--- - 3c: R_SPARC_PC22 _GLOBAL_OFFSET_TABLE_-0x8
--- + 3c: R_SPARC_HI22 _GLOBAL_OFFSET_TABLE_-0x8
-
-{- Note [Don't normalise input filenames]
-
-Summary
- We used to normalise input filenames when starting the unlit phase. This
- broke hpc in `--make` mode with imported literate modules (#2991).
-
-Introduction
- 1) --main
- When compiling a module with --main, GHC scans its imports to find out which
- other modules it needs to compile too. It turns out that there is a small
- difference between saying `ghc --make A.hs`, when `A` imports `B`, and
- specifying both modules on the command line with `ghc --make A.hs B.hs`. In
- the former case, the filename for B is inferred to be './B.hs' instead of
- 'B.hs'.
-
- 2) unlit
- When GHC compiles a literate haskell file, the source code first needs to go
- through unlit, which turns it into normal Haskell source code. At the start
- of the unlit phase, in `Driver.Pipeline.runPhase`, we call unlit with the
- option `-h` and the name of the original file. We used to normalise this
- filename using System.FilePath.normalise, which among other things removes
- an initial './'. unlit then uses that filename in #line directives that it
- inserts in the transformed source code.
-
- 3) SrcSpan
- A SrcSpan represents a portion of a source code file. It has fields
- linenumber, start column, end column, and also a reference to the file it
- originated from. The SrcSpans for a literate haskell file refer to the
- filename that was passed to unlit -h.
-
- 4) -fhpc
- At some point during compilation with -fhpc, in the function
- `GHC.HsToCore.Coverage.isGoodTickSrcSpan`, we compare the filename that a
- `SrcSpan` refers to with the name of the file we are currently compiling.
- For some reason I don't yet understand, they can sometimes legitimally be
- different, and then hpc ignores that SrcSpan.
-
-Problem
- When running `ghc --make -fhpc A.hs`, where `A.hs` imports the literate
- module `B.lhs`, `B` is inferred to be in the file `./B.lhs` (1). At the
- start of the unlit phase, the name `./B.lhs` is normalised to `B.lhs` (2).
- Therefore the SrcSpans of `B` refer to the file `B.lhs` (3), but we are
- still compiling `./B.lhs`. Hpc thinks these two filenames are different (4),
- doesn't include ticks for B, and we have unhappy customers (#2991).
-
-Solution
- Do not normalise `input_fn` when starting the unlit phase.
-
-Alternative solution
- Another option would be to not compare the two filenames on equality, but to
- use System.FilePath.equalFilePath. That function first normalises its
- arguments. The problem is that by the time we need to do the comparison, the
- filenames have been turned into FastStrings, probably for performance
- reasons, so System.FilePath.equalFilePath can not be used directly.
-
-Archeology
- The call to `normalise` was added in a commit called "Fix slash
- direction on Windows with the new filePath code" (c9b6b5e8). The problem
- that commit was addressing has since been solved in a different manner, in a
- commit called "Fix the filename passed to unlit" (1eedbc6b). So the
- `normalise` is no longer necessary.
--}
View Lorry Controller Status