<commit_before>%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
\section[Util]{Highly random utility functions}

\begin{code}
-- IF_NOT_GHC is meant to make this module useful outside the context of GHC
#define IF_NOT_GHC(a)

module Util (
	-- The Eager monad
	Eager, thenEager, returnEager, mapEager, appEager, runEager,

	-- general list processing
	zipEqual, zipWithEqual, zipWith3Equal, zipWith4Equal,
        zipLazy, stretchZipEqual,
	mapAndUnzip, mapAndUnzip3,
	nOfThem, lengthExceeds, isSingleton, only,
	snocView,
	isIn, isn'tIn,

	-- association lists
	assoc, assocUsing, assocDefault, assocDefaultUsing,

	-- duplicate handling
	hasNoDups, equivClasses, runs, removeDups, equivClassesByUniq,

	-- 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)

	-- transitive closures
	transitiveClosure,

	-- accumulating
	mapAccumL, mapAccumR, mapAccumB,

	-- comparisons
	thenCmp, cmpList,

	-- strictness
	seqList, ($!),

	-- pairs
	IF_NOT_GHC(cfst COMMA applyToPair COMMA applyToFst COMMA)
	IF_NOT_GHC(applyToSnd COMMA foldPair COMMA)
	unzipWith
    ) where

#include "HsVersions.h"

import List		( zipWith4 )
import Panic		( panic )
import Unique		( Unique )
import UniqFM		( eltsUFM, emptyUFM, addToUFM_C )

infixr 9 `thenCmp`
\end{code}

%************************************************************************
%*									*
\subsection{The Eager monad}
%*									*
%************************************************************************

The @Eager@ monad is just an encoding of continuation-passing style,
used to allow you to express "do this and then that", mainly to avoid
space leaks. It's done with a type synonym to save bureaucracy.

\begin{code}
type Eager ans a = (a -> ans) -> ans

runEager :: Eager a a -> a
runEager m = m (\x -> x)

appEager :: Eager ans a -> (a -> ans) -> ans
appEager m cont = m cont

thenEager :: Eager ans a -> (a -> Eager ans b) -> Eager ans b
thenEager m k cont = m (\r -> k r cont)

returnEager :: a -> Eager ans a
returnEager v cont = cont v

mapEager :: (a -> Eager ans b) -> [a] -> Eager ans [b]
mapEager f [] = returnEager []
mapEager f (x:xs) = f x			`thenEager` \ y ->
		    mapEager f xs	`thenEager` \ ys ->
		    returnEager (y:ys)
\end{code}

%************************************************************************
%*									*
\subsection[Utils-lists]{General list processing}
%*									*
%************************************************************************

A paranoid @zip@ (and some @zipWith@ friends) that checks the lists
are of equal length.  <NAME> thinks this should only happen if
DEBUGging on; hey, why not?

\begin{code}
zipEqual	:: String -> [a] -> [b] -> [(a,b)]
zipWithEqual	:: String -> (a->b->c) -> [a]->[b]->[c]
zipWith3Equal	:: String -> (a->b->c->d) -> [a]->[b]->[c]->[d]
zipWith4Equal	:: String -> (a->b->c->d->e) -> [a]->[b]->[c]->[d]->[e]

#ifndef DEBUG
zipEqual      _ = zip
zipWithEqual  _ = zipWith
zipWith3Equal _ = zipWith3
zipWith4Equal _ = zipWith4
#else
zipEqual msg []     []     = []
zipEqual msg (a:as) (b:bs) = (a,b) : zipEqual msg as bs
zipEqual msg as     bs     = panic ("zipEqual: unequal lists:"++msg)

zipWithEqual msg z (a:as) (b:bs)=  z a b : zipWithEqual msg z as bs
zipWithEqual msg _ [] []	=  []
zipWithEqual msg _ _ _		=  panic ("zipWithEqual: unequal lists:"++msg)

zipWith3Equal msg z (a:as) (b:bs) (c:cs)
				=  z a b c : zipWith3Equal msg z as bs cs
zipWith3Equal msg _ [] []  []	=  []
zipWith3Equal msg _ _  _   _	=  panic ("zipWith3Equal: unequal lists:"++msg)

zipWith4Equal msg z (a:as) (b:bs) (c:cs) (d:ds)
				=  z a b c d : zipWith4Equal msg z as bs cs ds
zipWith4Equal msg _ [] [] [] []	=  []
zipWith4Equal msg _ _  _  _  _	=  panic ("zipWith4Equal: unequal lists:"++msg)
#endif
\end{code}

\begin{code}
-- zipLazy is lazy in the second list (observe the ~)

zipLazy :: [a] -> [b] -> [(a,b)]
zipLazy [] ys = []
zipLazy (x:xs) ~(y:ys) = (x,y) : zipLazy xs ys
\end{code}
<commit_msg>[project @ 1999-05-05 11:39:09 by keithw] Add a space to panic message from zipWith*Equal.<commit_after>%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
\section[Util]{Highly random utility functions}

\begin{code}
-- IF_NOT_GHC is meant to make this module useful outside the context of GHC
#define IF_NOT_GHC(a)

module Util (
	-- The Eager monad
	Eager, thenEager, returnEager, mapEager, appEager, runEager,

	-- general list processing
	zipEqual, zipWithEqual, zipWith3Equal, zipWith4Equal,
        zipLazy, stretchZipEqual,
	mapAndUnzip, mapAndUnzip3,
	nOfThem, lengthExceeds, isSingleton, only,
	snocView,
	isIn, isn'tIn,

	-- association lists
	assoc, assocUsing, assocDefault, assocDefaultUsing,

	-- duplicate handling
	hasNoDups, equivClasses, runs, removeDups, equivClassesByUniq,

	-- 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)

	-- transitive closures
	transitiveClosure,

	-- accumulating
	mapAccumL, mapAccumR, mapAccumB,

	-- comparisons
	thenCmp, cmpList,

	-- strictness
	seqList, ($!),

	-- pairs
	IF_NOT_GHC(cfst COMMA applyToPair COMMA applyToFst COMMA)
	IF_NOT_GHC(applyToSnd COMMA foldPair COMMA)
	unzipWith
    ) where

#include "HsVersions.h"

import List		( zipWith4 )
import Panic		( panic )
import Unique		( Unique )
import UniqFM		( eltsUFM, emptyUFM, addToUFM_C )

infixr 9 `thenCmp`
\end{code}

%************************************************************************
%*									*
\subsection{The Eager monad}
%*									*
%************************************************************************

The @Eager@ monad is just an encoding of continuation-passing style,
used to allow you to express "do this and then that", mainly to avoid
space leaks. It's done with a type synonym to save bureaucracy.

\begin{code}
type Eager ans a = (a -> ans) -> ans

runEager :: Eager a a -> a
runEager m = m (\x -> x)

appEager :: Eager ans a -> (a -> ans) -> ans
appEager m cont = m cont

thenEager :: Eager ans a -> (a -> Eager ans b) -> Eager ans b
thenEager m k cont = m (\r -> k r cont)

returnEager :: a -> Eager ans a
returnEager v cont = cont v

mapEager :: (a -> Eager ans b) -> [a] -> Eager ans [b]
mapEager f [] = returnEager []
mapEager f (x:xs) = f x			`thenEager` \ y ->
		    mapEager f xs	`thenEager` \ ys ->
		    returnEager (y:ys)
\end{code}

%************************************************************************
%*									*
\subsection[Utils-lists]{General list processing}
%*									*
%************************************************************************

A paranoid @zip@ (and some @zipWith@ friends) that checks the lists
are of equal length.  <NAME> thinks this should only happen if
DEBUGging on; hey, why not?

\begin{code}
zipEqual	:: String -> [a] -> [b] -> [(a,b)]
zipWithEqual	:: String -> (a->b->c) -> [a]->[b]->[c]
zipWith3Equal	:: String -> (a->b->c->d) -> [a]->[b]->[c]->[d]
zipWith4Equal	:: String -> (a->b->c->d->e) -> [a]->[b]->[c]->[d]->[e]

#ifndef DEBUG
zipEqual      _ = zip
zipWithEqual  _ = zipWith
zipWith3Equal _ = zipWith3
zipWith4Equal _ = zipWith4
#else
zipEqual msg []     []     = []
zipEqual msg (a:as) (b:bs) = (a,b) : zipEqual msg as bs
zipEqual msg as     bs     = panic ("zipEqual: unequal lists: "++msg)

zipWithEqual msg z (a:as) (b:bs)=  z a b : zipWithEqual msg z as bs
zipWithEqual msg _ [] []	=  []
zipWithEqual msg _ _ _		=  panic ("zipWithEqual: unequal lists: "++msg)

zipWith3Equal msg z (a:as) (b:bs) (c:cs)
				=  z a b c : zipWith3Equal msg z as bs cs
zipWith3Equal msg _ [] []  []	=  []
zipWith3Equal msg _ _  _   _	=  panic ("zipWith3Equal: unequal lists: "++msg)

zipWith4Equal msg z (a:as) (b:bs) (c:cs) (d:ds)
				=  z a b c d : zipWith4Equal msg z as bs cs ds
zipWith4Equal msg _ [] [] [] []	=  []
zipWith4Equal msg _ _  _  _  _	=  panic ("zipWith4Equal: unequal lists: "++msg)
#endif
\end{code}

\begin{code}
-- zipLazy is lazy in the second list (observe the ~)

zipLazy :: [a] -> [b] -> [(a,b)]
zipLazy [] ys = []
zipLazy (x:xs) ~(y:ys) = (x,y) : zipLazy xs ys
\end{code}

{'fraction_non_alphanumeric': 0.20063268037474144, 'fraction_numerical': 0.008760189804112422, 'mean_word_length': 3.8098303101228788, 'pattern_counts': {'":': 0, '<': 5, '<?xml version=': 0, '>': 97, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '2331789', 'n_tokens_mistral': 3195, 'n_tokens_neox': 2977, 'n_words': 882}