summaryrefslogtreecommitdiff
path: root/ghc/Main.hs
diff options
context:
space:
mode:
authorFendor <power.walross@gmail.com>2020-08-21 11:06:35 +0200
committerFendor <power.walross@gmail.com>2020-10-09 19:46:28 +0200
commit5884fd325248e75d40c9da431b4069e43a2c182c (patch)
tree6d3fe960bcb638867e5a425c59c9bb9a3d155c14 /ghc/Main.hs
parent6a243e9daaa6c17c0859f47ae3a098e680aa28cf (diff)
downloadhaskell-5884fd325248e75d40c9da431b4069e43a2c182c.tar.gz
Move File Target parser to library #18596
Diffstat (limited to 'ghc/Main.hs')
-rw-r--r--ghc/Main.hs72
1 files changed, 2 insertions, 70 deletions
diff --git a/ghc/Main.hs b/ghc/Main.hs
index 122e4dce0c..c079cb6893 100644
--- a/ghc/Main.hs
+++ b/ghc/Main.hs
@@ -16,7 +16,7 @@ module Main (main) where
-- The official GHC API
import qualified GHC
-import GHC ( Ghc, GhcMonad(..), Backend (..),
+import GHC (parseTargetFiles, Ghc, GhcMonad(..), Backend (..),
LoadHowMuch(..) )
import GHC.Driver.CmdLine
@@ -74,7 +74,6 @@ import GHC.Iface.Recomp.Binary ( fingerprintBinMem )
import System.IO
import System.Environment
import System.Exit
-import System.FilePath
import Control.Monad
import Control.Monad.Trans.Class
import Control.Monad.Trans.Except (throwE, runExceptT)
@@ -219,29 +218,7 @@ main' postLoadMode dflags0 args flagWarnings = do
liftIO $ showBanner postLoadMode dflags4
- let
- -- 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 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
- normal_fileish_paths = map (normalise_hyp . unLoc) fileish_args
- (srcs, objs) = partition_args normal_fileish_paths [] []
-
- dflags5 = dflags4 { ldInputs = map (FileOption "") objs
- ++ ldInputs dflags4 }
+ let (dflags5, srcs, objs) = parseTargetFiles dflags4 (map unLoc fileish_args)
-- we've finished manipulating the DynFlags, update the session
_ <- GHC.setSessionDynFlags dflags5
@@ -289,51 +266,6 @@ ghciUI hsc_env dflags0 srcs maybe_expr = do
interactiveUI defaultGhciSettings srcs maybe_expr
#endif
--- -----------------------------------------------------------------------------
--- 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)
-
- {-
- 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.
- -}
-looks_like_an_input :: String -> Bool
-looks_like_an_input m = isSourceFilename m
- || looksLikeModuleName m
- || "-" `isPrefixOf` m
- || not (hasExtension m)
-- -----------------------------------------------------------------------------
-- Option sanity checks