X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FCmdLineParser.hs;h=64d218d39036a83770d13a9008fa3325649cf1ae;hb=412040168f72d73acfb25b991c0c757a817a4aba;hp=dfdea62f255da2a26337d9a51976481bc12bd93f;hpb=fc9bbbab3fe56cf0ff5723abbdb0f496d257f34e;p=ghc-hetmet.git

diff --git a/compiler/main/CmdLineParser.hs b/compiler/main/CmdLineParser.hs
index dfdea62..64d218d 100644
--- a/compiler/main/CmdLineParser.hs
+++ b/compiler/main/CmdLineParser.hs
@@ -23,6 +23,8 @@ import Outputable
 import Panic
 import SrcLoc
 
+import Data.List
+
 data Flag m = Flag
     {
         flagName :: String,           -- flag, without the leading -
@@ -30,7 +32,9 @@ data Flag m = Flag
         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
@@ -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
+                        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'
@@ -118,7 +124,7 @@ findArg spec arg
   = 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
@@ -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 ]
-   in UsageError (showSDoc errors)
+   in UsageError (showSDoc $ withPprStyle cmdlineParserStyle errors)