-- general list processing
zipEqual, zipWithEqual, zipWith3Equal, zipWith4Equal,
- zipLazy, stretchZipEqual,
+ zipLazy, stretchZipWith,
mapAndUnzip, mapAndUnzip3,
nOfThem, lengthExceeds, isSingleton, only,
snocView,
isIn, isn'tIn,
- -- association lists
- assoc, assocUsing, assocDefault, assocDefaultUsing,
-
- -- duplicate handling
- hasNoDups, equivClasses, runs, removeDups, equivClassesByUniq,
+ -- for-loop
+ nTimes,
-- sorting
IF_NOT_GHC(quicksort COMMA stableSortLt COMMA mergesort COMMA)
mapAccumL, mapAccumR, mapAccumB, foldl2, count,
-- comparisons
- thenCmp, cmpList,
+ thenCmp, cmpList, prefixMatch, postfixMatch,
-- strictness
seqList, ($!),
, bracket
#endif
+ , global
+
) where
#include "HsVersions.h"
import List ( zipWith4 )
import Panic ( panic )
-import Unique ( Unique )
-import UniqFM ( eltsUFM, emptyUFM, addToUFM_C )
+import IOExts ( IORef, newIORef, unsafePerformIO )
infixr 9 `thenCmp`
\end{code}
%************************************************************************
%* *
+\subsection{A for loop}
+%* *
+%************************************************************************
+
+\begin{code}
+-- 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}
+
+
+%************************************************************************
+%* *
\subsection[Utils-lists]{General list processing}
%* *
%************************************************************************
\begin{code}
-stretchZipEqual :: (a -> b -> Maybe a) -> [a] -> [b] -> [a]
--- (stretchZipEqual f xs ys) stretches ys to "fit" the places where f returns a Just
+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*
-stretchZipEqual f [] [] = []
-stretchZipEqual f (x:xs) (y:ys) = case f x y of
- Just x' -> x' : stretchZipEqual f xs ys
- Nothing -> x : stretchZipEqual f xs (y:ys)
+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}
%************************************************************************
%* *
-\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
-
- is_elem = isIn "hasNoDups"
-\end{code}
-
-\begin{code}
-equivClasses :: (a -> a -> Ordering) -- 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 -> Ordering) -- 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}
-equivClassesByUniq :: (a -> Unique) -> [a] -> [[a]]
- -- NB: it's *very* important that if we have the input list [a,b,c],
- -- where a,b,c all have the same unique, then we get back the list
- -- [a,b,c]
- -- not
- -- [c,b,a]
- -- Hence the use of foldr, plus the reversed-args tack_on below
-equivClassesByUniq get_uniq xs
- = eltsUFM (foldr add emptyUFM xs)
- where
- add a ufm = addToUFM_C tack_on ufm (get_uniq a) [a]
- tack_on old new = new++old
-\end{code}
-
-%************************************************************************
-%* *
\subsection[Utils-sorting]{Sorting}
%* *
%************************************************************************
\end{code}
\begin{code}
-cmpString :: String -> String -> Ordering
-
-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
-\end{code}
+prefixMatch :: Eq a => [a] -> [a] -> Bool
+prefixMatch [] _str = True
+prefixMatch _pat [] = False
+prefixMatch (p:ps) (s:ss) | p == s = prefixMatch ps ss
+ | otherwise = False
+postfixMatch :: Eq a => [a] -> [a] -> Bool
+postfixMatch pat str = prefixMatch (reverse pat) (reverse str)
+\end{code}
%************************************************************************
%* *
return r
#endif
\end{code}
+
+Global variables:
+
+\begin{code}
+global :: a -> IORef a
+global a = unsafePerformIO (newIORef a)
+\end{code}
+
projects / ghc-hetmet.git / blobdiff