nOfThem,
lengthExceeds, lengthIs, lengthAtLeast, listLengthCmp, atLength,
isSingleton, only,
- notNull,
+ notNull, snocView,
- snocView,
isIn, isn'tIn,
-- for-loop
-- comparisons
eqListBy, equalLength, compareLength,
- thenCmp, cmpList, prefixMatch, suffixMatch,
+ thenCmp, cmpList, prefixMatch, suffixMatch, maybePrefixMatch,
-- strictness
foldl', seqList,
unzipWith,
global,
+
+ -- module names
+ looksLikeModuleName,
+
+ toArgs
) where
#include "../includes/config.h"
import List ( zipWith4 )
#endif
+import Char ( isUpper, isAlphaNum, isSpace )
+
infixr 9 `thenCmp`
\end{code}
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
#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}
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
| 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}
%************************************************************************
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}
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}