From: Ian Lynagh <igloo@earth.li>
Date: Mon, 21 Jan 2008 10:31:58 +0000 (+0000)
Subject: Fix warnings in main/CmdLineParser
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=296e47fa8a5b16d34abe7d1dc5322308b936b3e8

Fix warnings in main/CmdLineParser
---

diff --git a/compiler/main/CmdLineParser.hs b/compiler/main/CmdLineParser.hs
index fd7a581..c7ad66e 100644
--- a/compiler/main/CmdLineParser.hs
+++ b/compiler/main/CmdLineParser.hs
@@ -1,10 +1,3 @@
-{-# OPTIONS -w #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
--- for details
-
 -----------------------------------------------------------------------------
 --
 -- Command-line parser
@@ -17,119 +10,122 @@
 -----------------------------------------------------------------------------
 
 module CmdLineParser (
-	processArgs, OptKind(..), 
-	CmdLineP(..), getCmdLineState, putCmdLineState
+        processArgs, OptKind(..),
+        CmdLineP(..), getCmdLineState, putCmdLineState
   ) where
 
+-- XXX This define is a bit of a hack, and should be done more nicely
+#define FAST_STRING_NOT_NEEDED 1
 #include "HsVersions.h"
 
-import Util	( maybePrefixMatch, notNull, removeSpaces )
+import Util
 import Panic
 
-data OptKind m		-- Suppose the flag is -f
-	= NoArg (m ())			-- -f all by itself
-	| HasArg    (String -> m ())    -- -farg or -f arg
-	| SepArg    (String -> m ())    -- -f arg
-	| Prefix    (String -> m ())    -- -farg 
-	| OptPrefix (String -> m ())    -- -f or -farg (i.e. the arg is optional)
-	| OptIntSuffix (Maybe Int -> m ())	-- -f or -f=n; pass n to fn
-	| IntSuffix (Int -> m ())		-- -f or -f=n; pass n to fn
-	| PassFlag  (String -> m ())    -- -f; pass "-f" fn
-	| AnySuffix (String -> m ())    -- -f or -farg; pass entire "-farg" to fn
-	| PrefixPred    (String -> Bool) (String -> m ())
-	| AnySuffixPred (String -> Bool) (String -> m ())
- 
+data OptKind m                      -- Suppose the flag is -f
+ = NoArg (m ())                     -- -f all by itself
+ | HasArg    (String -> m ())       -- -farg or -f arg
+ | SepArg    (String -> m ())       -- -f arg
+ | Prefix    (String -> m ())       -- -farg
+ | OptPrefix (String -> m ())       -- -f or -farg (i.e. the arg is optional)
+ | OptIntSuffix (Maybe Int -> m ()) -- -f or -f=n; pass n to fn
+ | IntSuffix (Int -> m ())          -- -f or -f=n; pass n to fn
+ | PassFlag  (String -> m ())       -- -f; pass "-f" fn
+ | AnySuffix (String -> m ())       -- -f or -farg; pass entire "-farg" to fn
+ | PrefixPred    (String -> Bool) (String -> m ())
+ | AnySuffixPred (String -> Bool) (String -> m ())
+
 processArgs :: Monad m
-	    => [(String, OptKind m)]	-- cmdline parser spec
-	    -> [String]			-- args
-	    -> m (
-	        [String],  -- spare args
-                [String]   -- errors
-		)
+            => [(String, OptKind m)] -- cmdline parser spec
+            -> [String]              -- args
+            -> m (
+                  [String],  -- spare args
+                  [String]   -- errors
+                 )
 processArgs spec args = process spec args [] []
   where
     process _spec [] spare errs =
       return (reverse spare, reverse errs)
-    
+
     process spec (dash_arg@('-':arg):args) spare errs =
       case findArg spec arg of
-        Just (rest,action) -> 
+        Just (rest,action) ->
            case processOneArg action rest arg args of
-    	     Left err            -> process spec args spare (err:errs)
-    	     Right (action,rest) -> action >> process spec rest spare errs
+             Left err            -> process spec args spare (err:errs)
+             Right (action,rest) -> action >> process spec rest spare errs
         Nothing -> process spec args (dash_arg:spare) errs
-    
-    process spec (arg:args) spare errs = 
+
+    process spec (arg:args) spare errs =
       process spec args (arg:spare) errs
 
 
 processOneArg :: OptKind m -> String -> String -> [String]
-	      -> Either String (m (), [String])
-processOneArg action rest arg args 
+              -> Either String (m (), [String])
+processOneArg action rest arg args
   = let dash_arg = '-' : arg
-	rest_no_eq = dropEq rest
+        rest_no_eq = dropEq rest
     in case action of
-	NoArg  a -> ASSERT(null rest) Right (a, args)
+        NoArg  a -> ASSERT(null rest) Right (a, args)
+
+        HasArg f | notNull rest_no_eq -> Right (f rest_no_eq, args)
+                 | otherwise    -> case args of
+                                    [] -> missingArgErr dash_arg
+                                    (arg1:args1) -> Right (f arg1, args1)
+
+        SepArg f -> case args of
+                        [] -> unknownFlagErr dash_arg
+                        (arg1:args1) -> Right (f arg1, args1)
 
-	HasArg f | notNull rest_no_eq -> Right (f rest_no_eq, args)
-		 | otherwise    -> case args of
-				    [] -> missingArgErr dash_arg
-				    (arg1:args1) -> Right (f arg1, args1)
+        Prefix f | notNull rest_no_eq -> Right (f rest_no_eq, args)
+                 | otherwise  -> unknownFlagErr dash_arg
 
-	SepArg f -> case args of
-			[] -> unknownFlagErr dash_arg
-			(arg1:args1) -> Right (f arg1, args1)
+        PrefixPred _ f | notNull rest_no_eq -> Right (f rest_no_eq, args)
+                       | otherwise          -> unknownFlagErr dash_arg
 
-	Prefix f | notNull rest_no_eq -> Right (f rest_no_eq, args)
-		 | otherwise  -> unknownFlagErr dash_arg
-	
-	PrefixPred p f | notNull rest_no_eq -> Right (f rest_no_eq, args)
-		       | otherwise          -> unknownFlagErr dash_arg
-	
-	PassFlag f  | notNull rest -> unknownFlagErr dash_arg
-		    | otherwise    -> Right (f dash_arg, args)
+        PassFlag f  | notNull rest -> unknownFlagErr dash_arg
+                    | otherwise    -> Right (f dash_arg, args)
 
-	OptIntSuffix f | null rest 		       -> Right (f Nothing,  args)
-		       | Just n <- parseInt rest_no_eq -> Right (f (Just n), args)
-		       | otherwise -> Left ("malformed integer argument in " ++ dash_arg)
+        OptIntSuffix f | null rest                     -> Right (f Nothing,  args)
+                       | Just n <- parseInt rest_no_eq -> Right (f (Just n), args)
+                       | otherwise -> Left ("malformed integer argument in " ++ dash_arg)
 
-	IntSuffix f | Just n <- parseInt rest_no_eq -> Right (f n, args)
-		    | otherwise -> Left ("malformed integer argument in " ++ dash_arg)
+        IntSuffix f | Just n <- parseInt rest_no_eq -> Right (f n, args)
+                    | otherwise -> Left ("malformed integer argument in " ++ dash_arg)
 
-	OptPrefix f       -> Right (f rest_no_eq, args)
-	AnySuffix f       -> Right (f dash_arg, args)
-	AnySuffixPred p f -> Right (f dash_arg, args)
+        OptPrefix f       -> Right (f rest_no_eq, args)
+        AnySuffix f       -> Right (f dash_arg, args)
+        AnySuffixPred _ f -> Right (f dash_arg, args)
 
 
 findArg :: [(String,OptKind a)] -> String -> Maybe (String,OptKind a)
 findArg spec arg
-  = case [ (removeSpaces rest, k) 
-	 | (pat,k)   <- spec, 
-	   Just rest <- [maybePrefixMatch pat arg],
-	   arg_ok k rest arg ] 
+  = case [ (removeSpaces rest, k)
+         | (pat,k)   <- spec,
+           Just rest <- [maybePrefixMatch pat arg],
+           arg_ok k rest arg ]
     of
-	[]      -> Nothing
-	(one:_) -> Just one
-
-arg_ok (NoArg _)            rest arg = null rest
-arg_ok (HasArg _)           rest arg = True
-arg_ok (SepArg _)           rest arg = null rest
-arg_ok (Prefix _)	    rest arg = notNull rest
-arg_ok (PrefixPred p _)     rest arg = notNull rest && p (dropEq rest)
-arg_ok (OptIntSuffix _)	    rest arg = True
-arg_ok (IntSuffix _)	    rest arg = True
-arg_ok (OptPrefix _)	    rest arg = True
-arg_ok (PassFlag _)         rest arg = null rest 
-arg_ok (AnySuffix _)        rest arg = True
-arg_ok (AnySuffixPred p _)  rest arg = p arg
+        []      -> Nothing
+        (one:_) -> Just one
+
+arg_ok :: OptKind t -> [Char] -> String -> Bool
+arg_ok (NoArg _)            rest _   = null rest
+arg_ok (HasArg _)           _    _   = True
+arg_ok (SepArg _)           rest _   = null rest
+arg_ok (Prefix _)           rest _   = notNull rest
+arg_ok (PrefixPred p _)     rest _   = notNull rest && p (dropEq rest)
+arg_ok (OptIntSuffix _)     _    _   = True
+arg_ok (IntSuffix _)        _    _   = True
+arg_ok (OptPrefix _)        _    _   = True
+arg_ok (PassFlag _)         rest _   = null rest
+arg_ok (AnySuffix _)        _    _   = True
+arg_ok (AnySuffixPred p _)  _    arg = p arg
 
 parseInt :: String -> Maybe Int
 -- Looks for "433" or "=342", with no trailing gubbins
---   n or =n	  => Just n
+--   n or =n      => Just n
 --   gibberish    => Nothing
 parseInt s = case reads s of
-		((n,""):_) -> Just n
-		other	   -> Nothing
+                ((n,""):_) -> Just n
+                _          -> Nothing
 
 dropEq :: String -> String
 -- Discards a leading equals sign
@@ -148,10 +144,12 @@ missingArgErr f = Left ("missing argument for flag: " ++ f)
 newtype CmdLineP s a = CmdLineP { runCmdLine :: s -> (a, s) }
 
 instance Monad (CmdLineP s) where
-	return a = CmdLineP $ \s -> (a, s)
-	m >>= k  = CmdLineP $ \s -> let
-		(a, s') = runCmdLine m s
-		in runCmdLine (k a) s'
+        return a = CmdLineP $ \s -> (a, s)
+        m >>= k  = CmdLineP $ \s -> let
+                (a, s') = runCmdLine m s
+                in runCmdLine (k a) s'
 
+getCmdLineState :: CmdLineP s s
 getCmdLineState   = CmdLineP $ \s -> (s,s)
+putCmdLineState :: s -> CmdLineP s ()
 putCmdLineState s = CmdLineP $ \_ -> ((),s)