diff options
Diffstat (limited to 'compiler/GHC.hs')
| -rw-r--r-- | compiler/GHC.hs | 88 |
1 files changed, 86 insertions, 2 deletions
diff --git a/compiler/GHC.hs b/compiler/GHC.hs index f0f66ee264..19df839730 100644 --- a/compiler/GHC.hs +++ b/compiler/GHC.hs @@ -29,7 +29,7 @@ module GHC ( -- * Flags and settings DynFlags(..), GeneralFlag(..), Severity(..), Backend(..), gopt, GhcMode(..), GhcLink(..), - parseDynamicFlags, + parseDynamicFlags, parseTargetFiles, getSessionDynFlags, setSessionDynFlags, getProgramDynFlags, setProgramDynFlags, setLogAction, getInteractiveDynFlags, setInteractiveDynFlags, @@ -334,7 +334,8 @@ import GHC.Types.Avail import GHC.Types.SrcLoc import GHC.Core import GHC.Iface.Tidy -import GHC.Driver.Phases ( Phase(..), isHaskellSrcFilename ) +import GHC.Driver.Phases ( Phase(..), isHaskellSrcFilename + , isSourceFilename, startPhase ) import GHC.Driver.Finder import GHC.Driver.Types import GHC.Driver.CmdLine @@ -387,6 +388,7 @@ import GHC.Data.Maybe import System.IO.Error ( isDoesNotExistError ) import System.Environment ( getEnv ) import System.Directory +import Data.List (isPrefixOf) -- %************************************************************************ @@ -729,6 +731,88 @@ parseDynamicFlags dflags cmdline = do dflags2 <- liftIO $ interpretPackageEnv dflags1 return (dflags2, leftovers, warns) +-- | Parse command line arguments that look like files. +-- First normalises its arguments and then splits them into source files +-- and object files. +-- A source file can be turned into a 'Target' via 'guessTarget' +parseTargetFiles :: DynFlags -> [String] -> (DynFlags, [(String, Maybe Phase)], [String]) +parseTargetFiles dflags0 fileish_args = + let + normal_fileish_paths = map normalise_hyp fileish_args + (srcs, objs) = partition_args normal_fileish_paths [] [] + + dflags1 = dflags0 { ldInputs = map (FileOption "") objs + ++ ldInputs dflags0 } + {- + We split out the object files (.o, .dll) and add them + to ldInputs for use by the linker. + + The following things should be considered compilation manager inputs: + + - haskell source files (strings ending in .hs, .lhs or other + haskellish extension), + + - module names (not forgetting hierarchical module names), + + - things beginning with '-' are flags that were not recognised by + the flag parser, and we want them to generate errors later in + checkOptions, so we class them as source files (#5921) + + - and finally we consider everything without an extension to be + a comp manager input, as shorthand for a .hs or .lhs filename. + + Everything else is considered to be a linker object, and passed + straight through to the linker. + -} + in (dflags1, srcs, objs) + +-- ----------------------------------------------------------------------------- + +-- | Splitting arguments into source files and object files. This is where we +-- interpret the -x <suffix> option, and attach a (Maybe Phase) to each source +-- file indicating the phase specified by the -x option in force, if any. +partition_args :: [String] -> [(String, Maybe Phase)] -> [String] + -> ([(String, Maybe Phase)], [String]) +partition_args [] srcs objs = (reverse srcs, reverse objs) +partition_args ("-x":suff:args) srcs objs + | "none" <- suff = partition_args args srcs objs + | StopLn <- phase = partition_args args srcs (slurp ++ objs) + | otherwise = partition_args rest (these_srcs ++ srcs) objs + where phase = startPhase suff + (slurp,rest) = break (== "-x") args + these_srcs = zip slurp (repeat (Just phase)) +partition_args (arg:args) srcs objs + | looks_like_an_input arg = partition_args args ((arg,Nothing):srcs) objs + | otherwise = partition_args args srcs (arg:objs) + + +looks_like_an_input :: String -> Bool +looks_like_an_input m = isSourceFilename m + || looksLikeModuleName m + || "-" `isPrefixOf` m + || not (hasExtension m) + + +-- | To simplify the handling of filepaths, we normalise all filepaths right +-- away. Note the asymmetry of FilePath.normalise: +-- Linux: p\/q -> p\/q; p\\q -> p\\q +-- Windows: p\/q -> p\\q; p\\q -> p\\q +-- #12674: Filenames starting with a hypen get normalised from ./-foo.hs +-- to -foo.hs. We have to re-prepend the current directory. +normalise_hyp :: FilePath -> FilePath +normalise_hyp fp + | strt_dot_sl && "-" `isPrefixOf` nfp = cur_dir ++ nfp + | otherwise = nfp + where +#if defined(mingw32_HOST_OS) + strt_dot_sl = "./" `isPrefixOf` fp || ".\\" `isPrefixOf` fp +#else + strt_dot_sl = "./" `isPrefixOf` fp +#endif + cur_dir = '.' : [pathSeparator] + nfp = normalise fp + +----------------------------------------------------------------------------- -- | Checks the set of new DynFlags for possibly erroneous option -- combinations when invoking 'setSessionDynFlags' and friends, and if |