X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Futils%2FUtil.lhs;h=3eff34b3d53824800da7fe69a8d9f9067944c511;hb=449b0be44b3bf53c7d817231df3e754278968440;hp=4ce14ab1b4a7c237967b50d91ca4e94c7100b9cd;hpb=f06f40fb77bc67e87cbb5e7b8b3fca9a18c7a905;p=ghc-hetmet.git

diff --git a/compiler/utils/Util.lhs b/compiler/utils/Util.lhs
index 4ce14ab..3eff34b 100644
--- a/compiler/utils/Util.lhs
+++ b/compiler/utils/Util.lhs
@@ -1,4 +1,5 @@
 %
+% (c) The University of Glasgow 2006
 % (c) The University of Glasgow 1992-2002
 %
 \section[Util]{Highly random utility functions}
@@ -82,26 +83,26 @@ module Util (
 import Panic		( panic, trace )
 import FastTypes
 
-import EXCEPTION	( Exception(..), finally, throwDyn, catchDyn, throw )
-import qualified EXCEPTION as Exception
-import DYNAMIC		( Typeable )
-import DATA_IOREF	( IORef, newIORef )
-import UNSAFE_IO	( unsafePerformIO )
-import DATA_IOREF	( readIORef, writeIORef )
+import Control.Exception ( Exception(..), finally, catchDyn, throw )
+import qualified Control.Exception as Exception
+import Data.Dynamic	( Typeable )
+import Data.IORef	( IORef, newIORef )
+import System.IO.Unsafe	( unsafePerformIO )
+import Data.IORef	( readIORef, writeIORef )
 
-import qualified List	( elem, notElem )
+import qualified Data.List as List ( elem, notElem )
 
 #ifndef DEBUG
-import List		( zipWith4 )
+import Data.List		( zipWith4 )
 #endif
 
-import Monad		( when )
-import IO		( catch, isDoesNotExistError )
-import Directory	( doesDirectoryExist, createDirectory )
-import Char		( isUpper, isAlphaNum, isSpace, ord, isDigit )
-import Ratio		( (%) )
-import Time		( ClockTime )
-import Directory	( getModificationTime )
+import Control.Monad	( when )
+import SYSTEM_IO_ERROR as IO ( catch, isDoesNotExistError )
+import System.Directory	( doesDirectoryExist, createDirectory,
+                          getModificationTime )
+import Data.Char	( isUpper, isAlphaNum, isSpace, ord, isDigit )
+import Data.Ratio	( (%) )
+import System.Time	( ClockTime )
 
 infixr 9 `thenCmp`
 \end{code}
@@ -757,29 +758,45 @@ looksLikeModuleName (c:cs) = isUpper c && go cs
 	go (c:cs)   = (isAlphaNum c || c == '_') && go cs
 \end{code}
 
-Akin to @Prelude.words@, but sensitive to dquoted entities treating
-them as single words.
+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.
 
 \begin{code}
 toArgs :: String -> [String]
 toArgs "" = []
 toArgs s  =
-  case break (\ ch -> isSpace ch || ch == '"') (dropWhile isSpace s) of -- "
-    (w,aft) ->
-       (\ ws -> if null w then ws else w : ws) $
-       case aft of
-	 []           -> []
-	 (x:xs)
-	   | x /= '"'  -> toArgs xs
-	   | otherwise ->
-             case lex aft of
-	       ((str,rs):_) -> stripQuotes str : toArgs rs
-	       _            -> [aft]
+  case dropWhile isSpace s of  -- drop initial spacing
+    [] -> []  -- empty, so no more tokens
+    rem -> let (tok,aft) = token rem [] in tok : toArgs aft
  where
-    -- strip away dquotes; assume first and last chars contain quotes.
-   stripQuotes :: String -> String
-   stripQuotes ('"':xs)  = init xs
-   stripQuotes xs        = xs
+   -- 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'
 \end{code}
 
 -- -----------------------------------------------------------------------------