%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
+% (c) The University of Glasgow 1992-2002
%
\section[Util]{Highly random utility functions}
\begin{code}
-#if defined(COMPILING_GHC)
-# include "HsVersions.h"
-# define IF_NOT_GHC(a) {--}
-#else
-# define panic error
-# define TAG_ Ordering
-# define LT_ LT
-# define EQ_ EQ
-# define GT_ GT
-# define _LT LT
-# define _EQ EQ
-# define _GT GT
-# define GT__ _
-# define tagCmp_ compare
-# define _tagCmp compare
-# define FAST_STRING String
-# define ASSERT(x) {-nothing-}
-# define IF_NOT_GHC(a) a
-# define COMMA ,
-#endif
-
-#ifndef __GLASGOW_HASKELL__
-# undef TAG_
-# undef LT_
-# undef EQ_
-# undef GT_
-# undef tagCmp_
-#endif
-
module Util (
- -- Haskell-version support
-#ifndef __GLASGOW_HASKELL__
- tagCmp_,
- TAG_(..),
-#endif
- -- The Eager monad
- SYN_IE(Eager), thenEager, returnEager, mapEager, appEager, runEager,
-- general list processing
- IF_NOT_GHC(forall COMMA exists COMMA)
zipEqual, zipWithEqual, zipWith3Equal, zipWith4Equal,
- zipLazy,
+ zipLazy, stretchZipWith,
mapAndUnzip, mapAndUnzip3,
- nOfThem, lengthExceeds, isSingleton,
-#if defined(COMPILING_GHC)
- startsWith, endsWith,
- isIn, isn'tIn,
-#endif
+ nOfThem,
+ lengthExceeds, lengthIs, lengthAtLeast, listLengthCmp, atLength,
+ isSingleton, only,
+ notNull, snocView,
- -- association lists
- assoc, assocUsing, assocDefault, assocDefaultUsing,
+ isIn, isn'tIn,
- -- duplicate handling
- hasNoDups, equivClasses, runs, removeDups,
+ -- for-loop
+ nTimes,
-- sorting
- IF_NOT_GHC(quicksort COMMA stableSortLt COMMA mergesort COMMA)
- sortLt,
- IF_NOT_GHC(mergeSort COMMA) naturalMergeSortLe, -- from Carsten
- IF_NOT_GHC(naturalMergeSort COMMA mergeSortLe COMMA)
+ sortLt, naturalMergeSortLe,
-- transitive closures
transitiveClosure,
-- accumulating
- mapAccumL, mapAccumR, mapAccumB,
+ mapAccumL, mapAccumR, mapAccumB,
+ foldl2, count,
+
+ takeList, dropList, splitAtList,
-- comparisons
-#if defined(COMPILING_GHC)
- Ord3(..), thenCmp, cmpList,
- cmpPString, FAST_STRING,
-#else
- cmpString,
-#endif
+ eqListBy, equalLength, compareLength,
+ thenCmp, cmpList, prefixMatch, suffixMatch,
+
+ -- strictness
+ foldl', seqList,
-- pairs
- IF_NOT_GHC(cfst COMMA applyToPair COMMA applyToFst COMMA)
- IF_NOT_GHC(applyToSnd COMMA foldPair COMMA)
- unzipWith
+ unzipWith,
- -- error handling
-#if defined(COMPILING_GHC)
- , panic, panic#, pprPanic, pprPanic#, pprError, pprTrace
- , assertPanic, assertPprPanic
-#endif {- COMPILING_GHC -}
+ global,
+ -- module names
+ looksLikeModuleName,
+
+ toArgs
) where
-#if defined(COMPILING_GHC)
+#include "../includes/config.h"
+#include "HsVersions.h"
-CHK_Ubiq() -- debugging consistency check
-IMPORT_1_3(List(zipWith4))
-import Pretty
+import Panic ( panic, trace )
+import FastTypes
-#else
-import List(zipWith4)
+#if __GLASGOW_HASKELL__ <= 408
+import EXCEPTION ( catchIO, justIoErrors, raiseInThread )
+#endif
+import DATA_IOREF ( IORef, newIORef )
+import UNSAFE_IO ( unsafePerformIO )
+
+import qualified List ( elem, notElem )
+
+#ifndef DEBUG
+import List ( zipWith4 )
#endif
+import Char ( isUpper, isAlphaNum, isSpace )
+
infixr 9 `thenCmp`
\end{code}
space leaks. It's done with a type synonym to save bureaucracy.
\begin{code}
+#if NOT_USED
+
type Eager ans a = (a -> ans) -> ans
runEager :: Eager a a -> a
mapEager f (x:xs) = f x `thenEager` \ y ->
mapEager f xs `thenEager` \ ys ->
returnEager (y:ys)
+#endif
\end{code}
%************************************************************************
%* *
-\subsection[Utils-version-support]{Functions to help pre-1.2 versions of (non-Glasgow) Haskell}
+\subsection{A for loop}
%* *
%************************************************************************
-This is our own idea:
\begin{code}
-#ifndef __GLASGOW_HASKELL__
-data TAG_ = LT_ | EQ_ | GT_
-
-tagCmp_ :: Ord a => a -> a -> TAG_
-tagCmp_ a b = if a == b then EQ_ else if a < b then LT_ else GT_
-#endif
+-- Compose a function with itself n times. (nth rather than twice)
+nTimes :: Int -> (a -> a) -> (a -> a)
+nTimes 0 _ = id
+nTimes 1 f = f
+nTimes n f = f . nTimes (n-1) f
\end{code}
%************************************************************************
%* *
%************************************************************************
-Quantifiers are not standard in Haskell. The following fill in the gap.
-
-\begin{code}
-forall :: (a -> Bool) -> [a] -> Bool
-forall pred [] = True
-forall pred (x:xs) = pred x && forall pred xs
-
-exists :: (a -> Bool) -> [a] -> Bool
-exists pred [] = False
-exists pred (x:xs) = pred x || exists pred xs
-\end{code}
-
A paranoid @zip@ (and some @zipWith@ friends) that checks the lists
are of equal length. Alastair Reid thinks this should only happen if
DEBUGging on; hey, why not?
zipLazy (x:xs) ~(y:ys) = (x,y) : zipLazy xs ys
\end{code}
+
+\begin{code}
+stretchZipWith :: (a -> Bool) -> b -> (a->b->c) -> [a] -> [b] -> [c]
+-- (stretchZipWith p z f xs ys) stretches ys by inserting z in
+-- the places where p returns *True*
+
+stretchZipWith p z f [] ys = []
+stretchZipWith p z f (x:xs) ys
+ | p x = f x z : stretchZipWith p z f xs ys
+ | otherwise = case ys of
+ [] -> []
+ (y:ys) -> f x y : stretchZipWith p z f xs ys
+\end{code}
+
+
\begin{code}
mapAndUnzip :: (a -> (b, c)) -> [a] -> ([b], [c])
\begin{code}
nOfThem :: Int -> a -> [a]
-nOfThem n thing = take n (repeat thing)
+nOfThem n thing = replicate n thing
+
+-- 'atLength atLen atEnd ls n' unravels list 'ls' to position 'n';
+-- specification:
+--
+-- atLength atLenPred atEndPred ls n
+-- | n < 0 = atLenPred n
+-- | length ls < n = atEndPred (n - length ls)
+-- | otherwise = atLenPred (drop n ls)
+--
+atLength :: ([a] -> b)
+ -> (Int -> b)
+ -> [a]
+ -> Int
+ -> b
+atLength atLenPred atEndPred ls n
+ | n < 0 = atEndPred n
+ | otherwise = go n ls
+ where
+ go n [] = atEndPred n
+ go 0 ls = atLenPred ls
+ go n (_:xs) = go (n-1) xs
+-- special cases.
lengthExceeds :: [a] -> Int -> Bool
+-- (lengthExceeds xs n) = (length xs > n)
+lengthExceeds = atLength notNull (const False)
-[] `lengthExceeds` n = 0 > n
-(x:xs) `lengthExceeds` n = (1 > n) || (xs `lengthExceeds` (n - 1))
+lengthAtLeast :: [a] -> Int -> Bool
+lengthAtLeast = atLength notNull (== 0)
-isSingleton :: [a] -> Bool
+lengthIs :: [a] -> Int -> Bool
+lengthIs = atLength null (==0)
-isSingleton [x] = True
-isSingleton _ = False
+listLengthCmp :: [a] -> Int -> Ordering
+listLengthCmp = atLength atLen atEnd
+ where
+ atEnd 0 = EQ
+ atEnd x
+ | x > 0 = LT -- not yet seen 'n' elts, so list length is < n.
+ | otherwise = GT
-startsWith, endsWith :: String -> String -> Maybe String
+ atLen [] = EQ
+ atLen _ = GT
-startsWith [] str = Just str
-startsWith (c:cs) (s:ss)
- = if c /= s then Nothing else startsWith cs ss
-startsWith _ [] = Nothing
+isSingleton :: [a] -> Bool
+isSingleton [x] = True
+isSingleton _ = False
-endsWith cs ss
- = case (startsWith (reverse cs) (reverse ss)) of
- Nothing -> Nothing
- Just rs -> Just (reverse rs)
+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
+#else
+only (a:_) = a
+#endif
\end{code}
Debugging/specialising versions of \tr{elem} and \tr{notElem}
+
\begin{code}
-#if defined(COMPILING_GHC)
isIn, isn'tIn :: (Eq a) => String -> a -> [a] -> Bool
# ifndef DEBUG
# else {- DEBUG -}
isIn msg x ys
- = elem ILIT(0) x ys
+ = elem (_ILIT 0) x ys
where
elem i _ [] = False
elem i x (y:ys)
- | i _GE_ ILIT(100) = panic ("Over-long elem in: " ++ msg)
- | otherwise = x == y || elem (i _ADD_ 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 i x [] = True
notElem i x (y:ys)
- | i _GE_ ILIT(100) = panic ("Over-long notElem in: " ++ msg)
- | otherwise = x /= y && notElem (i _ADD_ ILIT(1)) 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 {- COMPILING_GHC -}
-\end{code}
-
-%************************************************************************
-%* *
-\subsection[Utils-assoc]{Association lists}
-%* *
-%************************************************************************
-
-See also @assocMaybe@ and @mkLookupFun@ in module @Maybes@.
-
-\begin{code}
-assoc :: (Eq a) => String -> [(a, b)] -> a -> b
-assocDefault :: (Eq a) => b -> [(a, b)] -> a -> b
-assocUsing :: (a -> a -> Bool) -> String -> [(a, b)] -> a -> b
-assocDefaultUsing :: (a -> a -> Bool) -> b -> [(a, b)] -> a -> b
-
-assocDefaultUsing eq deflt ((k,v) : rest) key
- | k `eq` key = v
- | otherwise = assocDefaultUsing eq deflt rest key
-
-assocDefaultUsing eq deflt [] key = deflt
-
-assoc crash_msg list key = assocDefaultUsing (==) (panic ("Failed in assoc: " ++ crash_msg)) list key
-assocDefault deflt list key = assocDefaultUsing (==) deflt list key
-assocUsing eq crash_msg list key = assocDefaultUsing eq (panic ("Failed in assoc: " ++ crash_msg)) list key
-\end{code}
-
-%************************************************************************
-%* *
-\subsection[Utils-dups]{Duplicate-handling}
-%* *
-%************************************************************************
-
-\begin{code}
-hasNoDups :: (Eq a) => [a] -> Bool
-
-hasNoDups xs = f [] xs
- where
- f seen_so_far [] = True
- f seen_so_far (x:xs) = if x `is_elem` seen_so_far then
- False
- else
- f (x:seen_so_far) xs
-
-#if defined(COMPILING_GHC)
- is_elem = isIn "hasNoDups"
-#else
- is_elem = elem
-#endif
-\end{code}
-
-\begin{code}
-equivClasses :: (a -> a -> TAG_) -- Comparison
- -> [a]
- -> [[a]]
-
-equivClasses cmp stuff@[] = []
-equivClasses cmp stuff@[item] = [stuff]
-equivClasses cmp items
- = runs eq (sortLt lt items)
- where
- eq a b = case cmp a b of { EQ_ -> True; _ -> False }
- lt a b = case cmp a b of { LT_ -> True; _ -> False }
-\end{code}
-
-The first cases in @equivClasses@ above are just to cut to the point
-more quickly...
-
-@runs@ groups a list into a list of lists, each sublist being a run of
-identical elements of the input list. It is passed a predicate @p@ which
-tells when two elements are equal.
-
-\begin{code}
-runs :: (a -> a -> Bool) -- Equality
- -> [a]
- -> [[a]]
-
-runs p [] = []
-runs p (x:xs) = case (span (p x) xs) of
- (first, rest) -> (x:first) : (runs p rest)
-\end{code}
-
-\begin{code}
-removeDups :: (a -> a -> TAG_) -- Comparison function
- -> [a]
- -> ([a], -- List with no duplicates
- [[a]]) -- List of duplicate groups. One representative from
- -- each group appears in the first result
-
-removeDups cmp [] = ([], [])
-removeDups cmp [x] = ([x],[])
-removeDups cmp xs
- = case (mapAccumR collect_dups [] (equivClasses cmp xs)) of { (dups, xs') ->
- (xs', dups) }
- where
- collect_dups dups_so_far [x] = (dups_so_far, x)
- collect_dups dups_so_far dups@(x:xs) = (dups:dups_so_far, x)
\end{code}
%************************************************************************
%************************************************************************
\begin{code}
+#if NOT_USED
+
-- tail-recursive, etc., "quicker sort" [as per Meira thesis]
quicksort :: (a -> a -> Bool) -- Less-than predicate
-> [a] -- Input list
split x lo hi [] = quicksort lt lo ++ (x : quicksort lt hi)
split x lo hi (y:ys) | y `lt` x = split x (y:lo) hi ys
| True = split x lo (y:hi) ys
+#endif
\end{code}
Quicksort variant from Lennart's Haskell-library contribution. This
is a {\em stable} sort.
\begin{code}
-stableSortLt = sortLt -- synonym; when we want to highlight stable-ness
-
sortLt :: (a -> a -> Bool) -- Less-than predicate
-> [a] -- Input list
-> [a] -- Result list
%************************************************************************
\begin{code}
-mergesort :: (a -> a -> TAG_) -> [a] -> [a]
+#if NOT_USED
+mergesort :: (a -> a -> Ordering) -> [a] -> [a]
mergesort cmp xs = merge_lists (split_into_runs [] xs)
where
- a `le` b = case cmp a b of { LT_ -> True; EQ_ -> True; GT__ -> False }
- a `ge` b = case cmp a b of { LT_ -> False; EQ_ -> True; GT__ -> True }
+ a `le` b = case cmp a b of { LT -> True; EQ -> True; GT -> False }
+ a `ge` b = case cmp a b of { LT -> False; EQ -> True; GT -> True }
split_into_runs [] [] = []
split_into_runs run [] = [run]
merge xs [] = xs
merge xl@(x:xs) yl@(y:ys)
= case cmp x y of
- EQ_ -> x : y : (merge xs ys)
- LT_ -> x : (merge xs yl)
- GT__ -> y : (merge xl ys)
+ EQ -> x : y : (merge xs ys)
+ LT -> x : (merge xs yl)
+ GT -> y : (merge xl ys)
+#endif
\end{code}
%************************************************************************
generalNaturalMergeSort p [] = []
generalNaturalMergeSort p xs = (balancedFold (generalMerge p) . group p) xs
+#if NOT_USED
mergeSort, naturalMergeSort :: Ord a => [a] -> [a]
mergeSort = generalMergeSort (<=)
naturalMergeSort = generalNaturalMergeSort (<=)
mergeSortLe le = generalMergeSort le
+#endif
+
naturalMergeSortLe le = generalNaturalMergeSort le
\end{code}
(a'',b',ys) = mapAccumB f a' b xs
\end{code}
-%************************************************************************
-%* *
-\subsection[Utils-comparison]{Comparisons}
-%* *
-%************************************************************************
+A strict version of foldl.
-See also @tagCmp_@ near the versions-compatibility section.
+\begin{code}
+foldl' :: (a -> b -> a) -> a -> [b] -> a
+foldl' f z xs = lgo z xs
+ where
+ lgo z [] = z
+ lgo z (x:xs) = (lgo $! (f z x)) xs
+\end{code}
-The Ord3 class will be subsumed into Ord in Haskell 1.3.
+A combination of foldl with zip. It works with equal length lists.
\begin{code}
-class Ord3 a where
- cmp :: a -> a -> TAG_
-
-thenCmp :: TAG_ -> TAG_ -> TAG_
-{-# INLINE thenCmp #-}
-thenCmp EQ_ any = any
-thenCmp other any = other
+foldl2 :: (acc -> a -> b -> acc) -> acc -> [a] -> [b] -> acc
+foldl2 k z [] [] = z
+foldl2 k z (a:as) (b:bs) = foldl2 k (k z a b) as bs
+\end{code}
-cmpList :: (a -> a -> TAG_) -> [a] -> [a] -> TAG_
- -- `cmpList' uses a user-specified comparer
+Count the number of times a predicate is true
-cmpList cmp [] [] = EQ_
-cmpList cmp [] _ = LT_
-cmpList cmp _ [] = GT_
-cmpList cmp (a:as) (b:bs)
- = case cmp a b of { EQ_ -> cmpList cmp as bs; xxx -> xxx }
+\begin{code}
+count :: (a -> Bool) -> [a] -> Int
+count p [] = 0
+count p (x:xs) | p x = 1 + count p xs
+ | otherwise = count p xs
\end{code}
+@splitAt@, @take@, and @drop@ but with length of another
+list giving the break-off point:
+
\begin{code}
-instance Ord3 a => Ord3 [a] where
- cmp [] [] = EQ_
- cmp (x:xs) [] = GT_
- cmp [] (y:ys) = LT_
- cmp (x:xs) (y:ys) = (x `cmp` y) `thenCmp` (xs `cmp` ys)
-
-instance Ord3 a => Ord3 (Maybe a) where
- cmp Nothing Nothing = EQ_
- cmp Nothing (Just y) = LT_
- cmp (Just x) Nothing = GT_
- cmp (Just x) (Just y) = x `cmp` y
-
-instance Ord3 Int where
- cmp a b | a < b = LT_
- | a > b = GT_
- | otherwise = EQ_
+takeList :: [b] -> [a] -> [a]
+takeList [] _ = []
+takeList (_:xs) ls =
+ case ls of
+ [] -> []
+ (y:ys) -> y : takeList xs ys
+
+dropList :: [b] -> [a] -> [a]
+dropList [] xs = xs
+dropList _ xs@[] = xs
+dropList (_:xs) (_:ys) = dropList xs ys
+
+
+splitAtList :: [b] -> [a] -> ([a], [a])
+splitAtList [] xs = ([], xs)
+splitAtList _ xs@[] = (xs, xs)
+splitAtList (_:xs) (y:ys) = (y:ys', ys'')
+ where
+ (ys', ys'') = splitAtList xs ys
+
\end{code}
+
+%************************************************************************
+%* *
+\subsection[Utils-comparison]{Comparisons}
+%* *
+%************************************************************************
+
\begin{code}
-cmpString :: String -> String -> TAG_
+eqListBy :: (a->a->Bool) -> [a] -> [a] -> Bool
+eqListBy eq [] [] = True
+eqListBy eq (x:xs) (y:ys) = eq x y && eqListBy eq xs ys
+eqListBy eq xs ys = False
+
+equalLength :: [a] -> [b] -> Bool
+equalLength [] [] = True
+equalLength (_:xs) (_:ys) = equalLength xs ys
+equalLength xs ys = False
+
+compareLength :: [a] -> [b] -> Ordering
+compareLength [] [] = EQ
+compareLength (_:xs) (_:ys) = compareLength xs ys
+compareLength [] _ys = LT
+compareLength _xs [] = GT
+
+thenCmp :: Ordering -> Ordering -> Ordering
+{-# INLINE thenCmp #-}
+thenCmp EQ any = any
+thenCmp other any = other
-cmpString [] [] = EQ_
-cmpString (x:xs) (y:ys) = if x == y then cmpString xs ys
- else if x < y then LT_
- else GT_
-cmpString [] ys = LT_
-cmpString xs [] = GT_
+cmpList :: (a -> a -> Ordering) -> [a] -> [a] -> Ordering
+ -- `cmpList' uses a user-specified comparer
-#ifdef COMPILING_GHC
-cmpString _ _ = panic# "cmpString"
-#else
-cmpString _ _ = error "cmpString"
-#endif
+cmpList cmp [] [] = EQ
+cmpList cmp [] _ = LT
+cmpList cmp _ [] = GT
+cmpList cmp (a:as) (b:bs)
+ = case cmp a b of { EQ -> cmpList cmp as bs; xxx -> xxx }
\end{code}
\begin{code}
-cmpPString :: FAST_STRING -> FAST_STRING -> TAG_
-
-cmpPString x y
- = case (tagCmpFS x y) of { _LT -> LT_ ; _EQ -> EQ_ ; _GT -> GT_ }
+prefixMatch :: Eq a => [a] -> [a] -> Bool
+prefixMatch [] _str = True
+prefixMatch _pat [] = False
+prefixMatch (p:ps) (s:ss) | p == s = prefixMatch ps ss
+ | otherwise = False
+
+suffixMatch :: Eq a => [a] -> [a] -> Bool
+suffixMatch pat str = prefixMatch (reverse pat) (reverse str)
\end{code}
%************************************************************************
The following are curried versions of @fst@ and @snd@.
\begin{code}
+#if NOT_USED
cfst :: a -> b -> a -- stranal-sem only (Note)
cfst x y = x
+#endif
\end{code}
The following provide us higher order functions that, when applied
to a function, operate on pairs.
\begin{code}
+#if NOT_USED
applyToPair :: ((a -> c),(b -> d)) -> (a,b) -> (c,d)
applyToPair (f,g) (x,y) = (f x, g y)
applyToSnd :: (b -> d) -> (a,b) -> (a,d)
applyToSnd f (x,y) = (x,f y)
+#endif
foldPair :: (a->a->a,b->b->b) -> (a,b) -> [(a,b)] -> (a,b)
foldPair fg ab [] = ab
unzipWith f pairs = map ( \ (a, b) -> f a b ) pairs
\end{code}
-%************************************************************************
-%* *
-\subsection[Utils-errors]{Error handling}
-%* *
-%************************************************************************
-
\begin{code}
-#if defined(COMPILING_GHC)
-panic x = error ("panic! (the `impossible' happened):\n\t"
- ++ x ++ "\n\n"
- ++ "Please report it as a compiler bug "
- ++ "to glasgow-haskell-bugs@dcs.gla.ac.uk.\n\n" )
-
-pprPanic heading pretty_msg = panic (heading++ " " ++ (show pretty_msg))
-pprError heading pretty_msg = error (heading++ " " ++ (show pretty_msg))
-#if __GLASGOW_HASKELL__ == 201
-pprTrace heading pretty_msg = GHCbase.trace (heading++" "++(show pretty_msg))
-#elif __GLASGOW_HASKELL__ >= 202
-pprTrace heading pretty_msg = GlaExts.trace (heading++" "++(show pretty_msg))
-#else
-pprTrace heading pretty_msg = trace (heading++" "++(show pretty_msg))
-#endif
+seqList :: [a] -> b -> b
+seqList [] b = b
+seqList (x:xs) b = x `seq` seqList xs b
+\end{code}
--- #-versions because panic can't return an unboxed int, and that's
--- what TAG_ is with GHC at the moment. Ugh. (Simon)
--- No, man -- Too Beautiful! (Will)
+Global variables:
-panic# :: String -> TAG_
-panic# s = case (panic s) of () -> EQ_
+\begin{code}
+global :: a -> IORef a
+global a = unsafePerformIO (newIORef a)
+\end{code}
-pprPanic# heading pretty_msg = panic# (heading++(show pretty_msg))
+Module names:
-assertPanic :: String -> Int -> a
-assertPanic file line = panic ("ASSERT failed! file "++file++", line "++show line)
+\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}
-assertPprPanic :: String -> Int -> Doc -> a
-assertPprPanic file line msg
- = panic (show (sep [hsep[text "ASSERT failed! file",
- text file,
- text "line", int line],
- msg]))
+Akin to @Prelude.words@, but sensitive to dquoted entities treating
+them as single words.
-#endif {- COMPILING_GHC -}
+\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}