[project @ 2003-08-20 15:06:23 by simonmar]

[ghc-hetmet.git] / ghc / compiler / utils / Util.lhs

diff --git a/ghc/compiler/utils/Util.lhs b/ghc/compiler/utils/Util.lhs
index 4949515..28880a2 100644 (file)
--- a/ghc/compiler/utils/Util.lhs
+++ b/ghc/compiler/utils/Util.lhs
@@ -34,7 +34,7 @@ module Util (
 
        -- comparisons
        eqListBy, equalLength, compareLength,
-       thenCmp, cmpList, prefixMatch, suffixMatch,
+       thenCmp, cmpList, prefixMatch, suffixMatch, maybePrefixMatch,
 
        -- strictness
        foldl', seqList,
@@ -46,6 +46,8 @@ module Util (
 
        -- module names
        looksLikeModuleName,
+       
+       toArgs
     ) where
 
 #include "../includes/config.h"
@@ -66,7 +68,7 @@ import qualified List ( elem, notElem )
 import List            ( zipWith4 )
 #endif
 
-import Char            ( isUpper, isAlphaNum )
+import Char            ( isUpper, isAlphaNum, isSpace )
 
 infixr 9 `thenCmp`
 \end{code}
@@ -295,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
@@ -313,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}
 
 %************************************************************************
@@ -730,6 +732,13 @@ prefixMatch _pat [] = False
 prefixMatch (p:ps) (s:ss) | p == s    = prefixMatch ps ss
                          | otherwise = False
 
+maybePrefixMatch :: String -> String -> Maybe String
+maybePrefixMatch []    rest = Just rest
+maybePrefixMatch (_:_) []   = Nothing
+maybePrefixMatch (p:pat) (r:rest)
+  | p == r    = maybePrefixMatch pat rest
+  | otherwise = Nothing
+
 suffixMatch :: Eq a => [a] -> [a] -> Bool
 suffixMatch pat str = prefixMatch (reverse pat) (reverse str)
 \end{code}
@@ -792,7 +801,33 @@ Module names:
 
 \begin{code}
 looksLikeModuleName [] = False
-looksLikeModuleName (c:cs) = isUpper c && all isAlphaNumEx cs
+looksLikeModuleName (c:cs) = isUpper c && go cs
+  where go [] = True
+       go ('.':cs) = looksLikeModuleName cs
+       go (c:cs)   = (isAlphaNum c || c == '_') && go cs
+\end{code}
 
-isAlphaNumEx c = isAlphaNum c || c == '_' || c == '.'
+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}