X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Futils%2FUtil.lhs;h=f3350627568def001b73fc27147f741b829e8a54;hb=affe92132329afa642bc83d74d5b07d14187e968;hp=119ae82059b70fa4ba607cc1b30efbbbecffcbf7;hpb=fb1b5b0773c7efd0fba32e580afd91f99b9fcc89;p=ghc-hetmet.git

diff --git a/ghc/compiler/utils/Util.lhs b/ghc/compiler/utils/Util.lhs
index 119ae82..f335062 100644
--- a/ghc/compiler/utils/Util.lhs
+++ b/ghc/compiler/utils/Util.lhs
@@ -13,9 +13,8 @@ module Util (
 	nOfThem, 
 	lengthExceeds, lengthIs, lengthAtLeast, listLengthCmp, atLength,
 	isSingleton, only,
-	notNull,
+	notNull, snocView,
 
-	snocView,
 	isIn, isn'tIn,
 
 	-- for-loop
@@ -44,6 +43,11 @@ module Util (
 	unzipWith,
 
 	global,
+
+	-- module names
+	looksLikeModuleName,
+	
+	toArgs
     ) where
 
 #include "../includes/config.h"
@@ -64,6 +68,8 @@ import qualified List	( elem, notElem )
 import List		( zipWith4 )
 #endif
 
+import Char		( isUpper, isAlphaNum, isSpace )
+
 infixr 9 `thenCmp`
 \end{code}
 
@@ -258,6 +264,15 @@ notNull :: [a] -> Bool
 notNull [] = False
 notNull _  = True
 
+snocView :: [a] -> Maybe ([a],a)
+	-- Split off the last element
+snocView [] = Nothing
+snocView xs = go [] xs
+	    where
+		-- Invariant: second arg is non-empty
+	      go acc [x]    = Just (reverse acc, x)
+	      go acc (x:xs) = go (x:acc) xs
+
 only :: [a] -> a
 #ifdef DEBUG
 only [a] = a
@@ -266,14 +281,6 @@ only (a:_) = a
 #endif
 \end{code}
 
-\begin{code}
-snocView :: [a] -> ([a], a)	-- Split off the last element
-snocView xs = go xs []
-	    where
-	      go [x]    acc = (reverse acc, x)
-	      go (x:xs) acc = go xs (x:acc)
-\end{code}
-
 Debugging/specialising versions of \tr{elem} and \tr{notElem}
 
 \begin{code}
@@ -290,7 +297,7 @@ elem__ x (y:ys)	= x==y || elem__ x ys
 notElem__ x []	   =  True
 notElem__ x (y:ys) =  x /= y && notElem__ x ys
 
-# else {- DEBUG -}
+# else /* DEBUG */
 isIn msg x ys
   = elem (_ILIT 0) x ys
   where
@@ -308,7 +315,7 @@ isn'tIn msg x 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 -}
+# endif /* DEBUG */
 \end{code}
 
 %************************************************************************
@@ -782,3 +789,38 @@ Global variables:
 global :: a -> IORef a
 global a = unsafePerformIO (newIORef a)
 \end{code}
+
+Module names:
+
+\begin{code}
+looksLikeModuleName [] = False
+looksLikeModuleName (c:cs) = isUpper c && go cs
+  where go [] = True
+	go ('.':cs) = looksLikeModuleName 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.
+
+\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]
+ where
+    -- strip away dquotes; assume first and last chars contain quotes.
+   stripQuotes :: String -> String
+   stripQuotes ('"':xs)  = init xs
+   stripQuotes xs        = xs
+\end{code}