[Git][ghc/ghc][master] Move File Target parser to library #18596
Marge Bot
gitlab at gitlab.haskell.org
Sat Oct 10 18:49:27 UTC 2020
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
5884fd32 by Fendor at 2020-10-09T19:46:28+02:00
Move File Target parser to library #18596
- - - - -
2 changed files:
- compiler/GHC.hs
- ghc/Main.hs
Changes:
=====================================
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
=====================================
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
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5884fd325248e75d40c9da431b4069e43a2c182c
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5884fd325248e75d40c9da431b4069e43a2c182c
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20201010/cc2b7830/attachment-0001.html>
More information about the ghc-commits
mailing list