X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Futils%2FUtil.lhs;h=59f3b4740d8a4d570875dfc1ef6684573faaef03;hb=2b56761f97edb4ceb017a09d2049a6158c1e5e8e;hp=852bb90289e8dafb1dfeaec6ddd2c35044cda938;hpb=1994febdf9ae3d63029a837a6a10bda2690ddb48;p=ghc-hetmet.git

diff --git a/compiler/utils/Util.lhs b/compiler/utils/Util.lhs
index 852bb90..59f3b47 100644
--- a/compiler/utils/Util.lhs
+++ b/compiler/utils/Util.lhs
@@ -53,7 +53,7 @@ module Util (
         -- module names
         looksLikeModuleName,
 
-        toArgs,
+        getCmd, toCmdArgs, toArgs,
 
         -- Floating point stuff
         readRational,
@@ -331,21 +331,21 @@ notElem__ x (y:ys) = x /= y && notElem__ x ys
 
 # else /* DEBUG */
 isIn msg x ys
-  = elem (_ILIT 0) x ys
+  = elem (_ILIT(0)) x ys
   where
     elem _ _ []        = False
     elem i x (y:ys)
-      | i ># _ILIT 100 = trace ("Over-long elem in " ++ msg)
-                               (x `List.elem` (y:ys))
-      | otherwise      = x == y || elem (i +# _ILIT(1)) x ys
+      | i ># _ILIT(100) = trace ("Over-long elem in " ++ msg)
+                                (x `List.elem` (y:ys))
+      | otherwise       = x == y || elem (i +# _ILIT(1)) x ys
 
 isn'tIn msg x ys
-  = notElem (_ILIT 0) x ys
+  = notElem (_ILIT(0)) x ys
   where
     notElem _ _ [] =  True
     notElem i x (y:ys)
-      | i ># _ILIT 100 = trace ("Over-long notElem in " ++ msg)
-                               (x `List.notElem` (y:ys))
+      | i ># _ILIT(100) = trace ("Over-long notElem in " ++ msg)
+                                (x `List.notElem` (y:ys))
       | otherwise      =  x /= y && notElem (i +# _ILIT(1)) x ys
 # endif /* DEBUG */
 \end{code}
@@ -353,7 +353,7 @@ isn'tIn msg x ys
 foldl1' was added in GHC 6.4
 
 \begin{code}
-#if __GLASGOW_HASKELL__ < 604
+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 604
 foldl1'          :: (a -> a -> a) -> [a] -> a
 foldl1' f (x:xs) =  foldl' f x xs
 foldl1' _ []     =  panic "foldl1'"
@@ -657,44 +657,51 @@ looksLikeModuleName (c:cs) = isUpper c && go cs
 \end{code}
 
 Akin to @Prelude.words@, but acts like the Bourne shell, treating
-quoted strings and escaped characters within the input as solid blocks
-of characters.  Doesn't raise any exceptions on malformed escapes or
-quoting.
+quoted strings as Haskell Strings, and also parses Haskell [String]
+syntax.
 
 \begin{code}
-toArgs :: String -> [String]
-toArgs "" = []
-toArgs s  =
-  case dropWhile isSpace s of  -- drop initial spacing
-    [] -> []  -- empty, so no more tokens
-    rem -> let (tok,aft) = token rem [] in tok : toArgs aft
+getCmd :: String -> Either String             -- Error
+                           (String, String) -- (Cmd, Rest)
+getCmd s = case break isSpace $ dropWhile isSpace s of
+           ([], _) -> Left ("Couldn't find command in " ++ show s)
+           res -> Right res
+
+toCmdArgs :: String -> Either String             -- Error
+                              (String, [String]) -- (Cmd, Args)
+toCmdArgs s = case getCmd s of
+              Left err -> Left err
+              Right (cmd, s') -> case toArgs s' of
+                                 Left err -> Left err
+                                 Right args -> Right (cmd, args)
+
+toArgs :: String -> Either String   -- Error
+                           [String] -- Args
+toArgs str
+    = case dropWhile isSpace str of
+      s@('[':_) -> case reads s of
+                   [(args, spaces)]
+                    | all isSpace spaces ->
+                       Right args
+                   _ ->
+                       Left ("Couldn't read " ++ show str ++ "as [String]")
+      s -> toArgs' s
  where
-   -- Grab a token off the string, given that the first character exists and
-   -- isn't whitespace.  The second argument is an accumulator which has to be
-   -- reversed at the end.
-  token [] acc = (reverse acc,[])            -- out of characters
-  token ('\\':c:aft) acc                     -- escapes
-               = token aft ((escape c) : acc)
-  token (q:aft) acc | q == '"' || q == '\''  -- open quotes
-               = let (aft',acc') = quote q aft acc in token aft' acc'
-  token (c:aft) acc | isSpace c              -- unescaped, unquoted spacing
-               = (reverse acc,aft)
-  token (c:aft) acc                          -- anything else goes in the token
-               = token aft (c:acc)
-
-   -- Get the appropriate character for a single-character escape.
-  escape 'n' = '\n'
-  escape 't' = '\t'
-  escape 'r' = '\r'
-  escape c   = c
-
-   -- Read into accumulator until a quote character is found.
-  quote qc =
-    let quote' [] acc                  = ([],acc)
-        quote' ('\\':c:aft) acc        = quote' aft ((escape c) : acc)
-        quote' (c:aft) acc | c == qc   = (aft,acc)
-        quote' (c:aft) acc             = quote' aft (c:acc)
-    in quote'
+  toArgs' s = case dropWhile isSpace s of
+              [] -> Right []
+              ('"' : _) -> case reads s of
+                           [(arg, rest)]
+                              -- rest must either be [] or start with a space
+                            | all isSpace (take 1 rest) ->
+                               case toArgs' rest of
+                               Left err -> Left err
+                               Right args -> Right (arg : args)
+                           _ ->
+                               Left ("Couldn't read " ++ show s ++ "as String")
+              s' -> case break isSpace s' of
+                    (arg, s'') -> case toArgs' s'' of
+                                  Left err -> Left err
+                                  Right args -> Right (arg : args)
 \end{code}
 
 -- -----------------------------------------------------------------------------