projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Deprecate NewQualifiedOperators extension (rejected by H')
[ghc-hetmet.git]
/
compiler
/
main
/
CmdLineParser.hs
diff --git
a/compiler/main/CmdLineParser.hs
b/compiler/main/CmdLineParser.hs
index
dfdea62
..
64d218d
100644
(file)
--- a/
compiler/main/CmdLineParser.hs
+++ b/
compiler/main/CmdLineParser.hs
@@
-23,6
+23,8
@@
import Outputable
import Panic
import SrcLoc
import Panic
import SrcLoc
+import Data.List
+
data Flag m = Flag
{
flagName :: String, -- flag, without the leading -
data Flag m = Flag
{
flagName :: String, -- flag, without the leading -
@@
-30,7
+32,9
@@
data Flag m = Flag
flagDeprecated :: Deprecated -- is the flag deprecated?
}
flagDeprecated :: Deprecated -- is the flag deprecated?
}
-data Deprecated = Supported | Deprecated String
+data Deprecated = Supported
+ | Deprecated String
+ | DeprecatedFullText String
data OptKind m -- Suppose the flag is -f
= NoArg (m ()) -- -f all by itself
data OptKind m -- Suppose the flag is -f
= NoArg (m ()) -- -f all by itself
@@
-64,6
+68,8
@@
processArgs spec args = process spec args [] [] []
let warns' = case deprecated of
Deprecated warning ->
L loc ("Warning: " ++ dash_arg ++ " is deprecated: " ++ warning) : warns
let warns' = case deprecated of
Deprecated warning ->
L loc ("Warning: " ++ dash_arg ++ " is deprecated: " ++ warning) : warns
+ DeprecatedFullText warning ->
+ L loc ("Warning: " ++ warning) : warns
Supported -> warns
in case processOneArg action rest arg args of
Left err -> process spec args spare (L loc err : errs) warns'
Supported -> warns
in case processOneArg action rest arg args of
Left err -> process spec args spare (L loc err : errs) warns'
@@
-118,7
+124,7
@@
findArg spec arg
= case [ (removeSpaces rest, optKind, flagDeprecated flag)
| flag <- spec,
let optKind = flagOptKind flag,
= case [ (removeSpaces rest, optKind, flagDeprecated flag)
| flag <- spec,
let optKind = flagOptKind flag,
- Just rest <- [maybePrefixMatch (flagName flag) arg],
+ Just rest <- [stripPrefix (flagName flag) arg],
arg_ok optKind rest arg ]
of
[] -> Nothing
arg_ok optKind rest arg ]
of
[] -> Nothing
@@
-178,5
+184,5
@@
putCmdLineState s = CmdLineP $ \_ -> ((),s)
errorsToGhcException :: [Located String] -> GhcException
errorsToGhcException errs =
let errors = vcat [ ppr l <> text ": " <> text e | L l e <- errs ]
errorsToGhcException :: [Located String] -> GhcException
errorsToGhcException errs =
let errors = vcat [ ppr l <> text ": " <> text e | L l e <- errs ]
- in UsageError (showSDoc errors)
+ in UsageError (showSDoc $ withPprStyle cmdlineParserStyle errors)