diff --git a/Data/Adaptive/List.hs b/Data/Adaptive/List.hs --- a/Data/Adaptive/List.hs +++ b/Data/Adaptive/List.hs @@ -2,1980 +2,4545 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE OverlappingInstances #-} - --- | --- Module : Data.Adaptive.List --- Copyright : (c) Duncan Coutts 2007 --- (c) Don Stewart 2007 .. 2009 --- License : BSD-style --- Maintainer : dons@galois.com --- Stability : experimental --- --- Self adapting polymorphic lists. --- --- This library statically specializes the polymorphic container --- representation of lists to specific, more efficient representations, --- when instantiated with particular monomorphic types. It does this via --- an associated more efficient data type for each pair of elements you --- wish to store in your container. --- --- The resulting list structures use less space, and functions on them tend to --- be faster, than regular lists. --- --- Instead of representing '[1..5] :: [Int]' as: --- --- > (:) --- > / \ --- > / \ --- > I# 1# (:) --- > / \ --- > / \ --- > I# 2# (:) --- > / \ --- > / \ --- > I# 3# [] --- --- The compiler will select an associated data type that packs better, --- via the class instances, resulting in: --- --- > ConsInt 1# --- > | --- > ConsInt 2# --- > | --- > ConsInt 3# --- > | --- > [] --- --- The user however, still sees a polymorphic list type. --- --- This list type currently doesn't fuse. --- -module Data.Adaptive.List where - -import Data.Adaptive.Tuple - -import qualified Prelude -import Prelude (Eq(..),Ord(..),Ordering(..), (.) - ,Int,Char,Float,Double,Integer,Bool(..),otherwise,(-)) -import Data.Int -import Data.Word - --- * The adaptive list class-associated type --- --- | Representation-improving polymorphic lists. --- -class AdaptList a where - - data List a - - -- | The empty list - empty :: List a - - -- | Prepend a value onto a list - cons :: a -> List a -> List a - - -- | Is the list empty? - null :: List a -> Bool - - -- | The first element of the list - head :: List a -> a - - -- | The tail of the list - tail :: List a -> List a - ------------------------------------------------------------------------- --- * Basic Interface - -infixr 5 ++ -infixr 5 : --- infix 5 \\ -- comment to fool cpp --- infixl 9 !! -infix 4 `elem`, `notElem` - --- | /O(n)/, convert an adaptive list to a regular list -toList :: AdaptList a => List a -> [a] -toList xs - | null xs = [] - | otherwise = head xs : toList (tail xs) - --- | /O(n)/, convert an adaptive list to a regular list -fromList :: AdaptList a => [a] -> List a -fromList [] = empty -fromList (x:xs) = x `cons` fromList xs - --- | /O(n)/, construct a list by enumerating a range -enumFromToList :: (AdaptList a, Ord a, Prelude.Enum a) => a -> a ->List a -enumFromToList x0 y - | x0 > y = empty - | otherwise = go x0 - where - go x = x `cons` if x == y then empty else go (Prelude.succ x) -{-# INLINE enumFromToList #-} - --- | /O(1)/, uncons, take apart a list into the head and tail. --- -uncons :: AdaptList a => List a -> Prelude.Maybe (a, List a) -uncons xs | null xs = Prelude.Nothing - | otherwise = Prelude.Just (head xs, tail xs) - --- | /O(n)/, Append two lists, i.e., --- --- > [x1, ..., xm] ++ [y1, ..., yn] == [x1, ..., xm, y1, ..., yn] --- > [x1, ..., xm] ++ [y1, ...] == [x1, ..., xm, y1, ...] --- --- If the first list is not finite, the result is the first list. --- The spine of the first list argument must be copied. --- -(++) :: AdaptList a => List a -> List a -> List a -(++) xs ys - | null xs = ys - | otherwise = head xs `cons` tail xs ++ ys - --- | /O(n)/, Extract the last element of a list, which must be finite --- and non-empty. -last :: AdaptList a => List a -> a -last xs - | null xs = errorEmptyList "last" - | otherwise = go (head xs) (tail xs) - where - go y z - | null z = y - | otherwise = go (head z) (tail z) -{-# INLINE last #-} - --- | /O(n)/. Return all the elements of a list except the last one. --- The list must be finite and non-empty. -init :: AdaptList a => List a -> List a -init xs - | null xs = errorEmptyList "init" - | otherwise = go (head xs) (tail xs) - where - go y z - | null z = empty - | otherwise = y `cons` go (head z) (tail z) -{-# INLINE init #-} - --- | /O(n)/. 'length' returns the length of a finite list as an 'Int'. --- It is an instance of the more general 'Data.List.genericLength', --- the result type of which may be any kind of number. -length :: AdaptList a => List a -> Int -length xs0 = go xs0 0 - where - go :: AdaptList a => List a -> Int -> Int - go xs !a - | null xs = a - | otherwise = go (tail xs) (a Prelude.+ 1) -{-# INLINE length #-} - --- --------------------------------------------------------------------- --- * List transformations - --- | /O(n)/. 'map' @f xs@ is the list obtained by applying @f@ to each element --- of @xs@, i.e., --- --- > map f [x1, x2, ..., xn] == [f x1, f x2, ..., f xn] --- > map f [x1, x2, ...] == [f x1, f x2, ...] --- --- Properties: --- --- > map f . map g = map (f . g) --- > map f (repeat x) = repeat (f x) --- > map f (replicate n x) = replicate n (f x) - -map :: (AdaptList a, AdaptList b) => (a -> b) -> List a -> List b -map f as = go as - where - go xs - | null xs = empty - | otherwise = f (head xs) `cons` go (tail xs) -{-# INLINE map #-} - --- | /O(n)/. 'reverse' @xs@ returns the elements of @xs@ in reverse order. --- @xs@ must be finite. Will fuse as a consumer only. -reverse :: AdaptList a => List a -> List a -reverse = foldl (Prelude.flip cons) empty -{-# INLINE reverse #-} - --- | /O(n)/. The 'intersperse' function takes an element and a list and --- \`intersperses\' that element between the elements of the list. --- For example, --- --- > intersperse ',' "abcde" == "a,b,c,d,e" --- -intersperse :: AdaptList a => a -> List a -> List a -intersperse sep zs - | null zs = empty - | otherwise = head zs `cons` go (tail zs) - where - go xs - | null xs = empty - | otherwise = sep `cons` (head xs `cons` go (tail xs)) -{-# INLINE intersperse #-} - --- | /O(n)/. 'intercalate' @xs xss@ is equivalent to @('concat' ('intersperse' xs xss))@. --- It inserts the list @xs@ in between the lists in @xss@ and concatenates the --- result. --- --- > intercalate = concat . intersperse --- -intercalate :: (AdaptList (List a), AdaptList a) - => List a -> List (List a) -> List a -intercalate sep xss = go (intersperse sep xss) - where - go ys - | null ys = empty - | otherwise = head ys ++ go (tail ys) -{-# INLINE intercalate #-} - --- --------------------------------------------------------------------- --- * Reducing lists (folds) - --- | /O(n)/. 'foldl', applied to a binary operator, a starting value (typically --- the left-identity of the operator), and a list, reduces the list --- using the binary operator, from left to right: --- --- > foldl f z [x1, x2, ..., xn] == (...((z `f` x1) `f` x2) `f`...) `f` xn --- --- The list must be finite. The accumulator is whnf strict. --- -foldl :: AdaptList b => (a -> b -> a) -> a -> List b -> a -foldl f z0 xs0 = go z0 xs0 - where - go !z xs - | null xs = z - | otherwise = go (f z (head xs)) (tail xs) -{-# INLINE foldl #-} - --- | /O(n)/. 'foldl1' is a variant of 'foldl' that has no starting value argument, --- and thus must be applied to non-empty lists. -foldl1 :: AdaptList a => (a -> a -> a) -> List a -> a -foldl1 f zs - | null zs = errorEmptyList "foldl1" - | otherwise = go (head zs) (tail zs) - where - go !z xs - | null xs = z - | otherwise = go (f z (head xs)) (tail xs) -{-# INLINE foldl1 #-} - --- | /O(n)/. 'foldr', applied to a binary operator, a starting value (typically --- the right-identity of the operator), and a list, reduces the list --- using the binary operator, from right to left: --- --- > foldr f z [x1, x2, ..., xn] == x1 `f` (x2 `f` ... (xn `f` z)...) --- -foldr :: AdaptList a => (a -> b -> b) -> b -> List a -> b -foldr k z xs = go xs - where - go ys - | null xs = z - | otherwise = head ys `k` go (tail ys) -{-# INLINE foldr #-} - --- | /O(n)/. 'foldr1' is a variant of 'foldr' that has no starting value argument, --- and thus must be applied to non-empty lists. -foldr1 :: AdaptList a => (a -> a -> a) -> List a -> a -foldr1 k xs - | null xs = errorEmptyList "foldr1" - | otherwise = go (head xs) (tail xs) - where - go z ys - | null ys = z - | otherwise = z `k` go (head ys) (tail ys) -{-# INLINE foldr1 #-} - --- --------------------------------------------------------------------- --- * Special folds - --- | /O(n)/. Concatenate a list of lists. --- concat :: [[a]] -> [a] -concat :: (AdaptList (List a), AdaptList a) - => List (List a) -> List a -concat xss0 = to xss0 - where - go xs xss - | null xs = to xss - | otherwise = head xs `cons` go (tail xs) xss - to xs - | null xs = empty - | otherwise = go (head xs) (tail xs) -{-# INLINE concat #-} - --- | /O(n)/, /fusion/. Map a function over a list and concatenate the results. -concatMap :: (AdaptList a1, AdaptList a) - => (a -> List a1) -> List a -> List a1 -concatMap f = foldr (\x y -> f x ++ y) empty -{-# INLINE concatMap #-} - --- | /O(n)/. 'and' returns the conjunction of a Boolean list. For the result to be --- 'True', the list must be finite; 'False', however, results from a 'False' --- value at a finite index of a finite or infinite list. --- -and :: List Bool -> Bool -and xs - | null xs = True - | Prelude.not (head xs) = False - | otherwise = and (tail xs) -{-# INLINE and #-} - --- | /O(n)/. 'or' returns the disjunction of a Boolean list. For the result to be --- 'False', the list must be finite; 'True', however, results from a 'True' --- value at a finite index of a finite or infinite list. -or :: List Bool -> Bool -or xs - | null xs = False - | head xs = True - | otherwise = or (tail xs) -{-# INLINE or #-} - --- | /O(n)/. Applied to a predicate and a list, 'any' determines if any element --- of the list satisfies the predicate. -any :: AdaptList a => (a -> Bool) -> List a -> Bool -any p xs0 = go xs0 - where - go xs - | null xs = False - | otherwise = case p (head xs) of - True -> True - _ -> go (tail xs) -{-# INLINE any #-} - --- | Applied to a predicate and a list, 'all' determines if all elements --- of the list satisfy the predicate. -all :: AdaptList a => (a -> Bool) -> List a -> Bool -all p xs0 = go xs0 - where - go xs - | null xs = True - | otherwise = case p (head xs) of - True -> go (tail xs) - _ -> False -{-# INLINE all #-} - --- | /O(n)/, /fusion/. The 'sum' function computes the sum of a finite list of numbers. -sum :: (AdaptList a, Prelude.Num a) => List a -> a -sum l = go l 0 - where - go xs !a - | null xs = a - | otherwise = go (tail xs) (a Prelude.+ head xs) -{-# INLINE sum #-} - --- | /O(n)/,/fusion/. The 'product' function computes the product of a finite list of numbers. -product :: (AdaptList a, Prelude.Num a) => List a -> a -product l = go l 1 - where - go xs !a - | null xs = a - | otherwise = go (tail xs) (a Prelude.* head xs) -{-# INLINE product #-} - --- | /O(n)/. 'maximum' returns the maximum value from a list, --- which must be non-empty, finite, and of an ordered type. --- It is a special case of 'Data.List.maximumBy', which allows the --- programmer to supply their own comparison function. -maximum :: (AdaptList a, Prelude.Ord a) => List a -> a -maximum xs - | null xs = errorEmptyList "maximum" - | otherwise = foldl1 Prelude.max xs -{-# INLINE maximum #-} - --- | /O(n)/. 'minimum' returns the minimum value from a list, --- which must be non-empty, finite, and of an ordered type. --- It is a special case of 'Data.List.minimumBy', which allows the --- programmer to supply their own comparison function. -minimum :: (AdaptList a, Prelude.Ord a) => List a -> a -minimum xs - | null xs = errorEmptyList "minimum" - | otherwise = foldl1 Prelude.min xs -{-# INLINE minimum #-} - --- --------------------------------------------------------------------- --- * Building lists --- ** Scans - --- | /O(n)/. 'scanl' is similar to 'foldl', but returns a list of successive --- reduced values from the left: --- --- > scanl f z [x1, x2, ...] == [z, z `f` x1, (z `f` x1) `f` x2, ...] --- --- Properties: --- --- > last (scanl f z xs) == foldl f z x --- -scanl :: (AdaptList b, AdaptList a) => (a -> b -> a) -> a -> List b -> List a -scanl f q ls = q `cons` if null ls - then empty - else scanl f (f q (head ls)) (tail ls) -{-# INLINE scanl #-} - --- | /O(n)/. 'scanl1' is a variant of 'scanl' that has no starting value argument: --- --- > scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...] --- -scanl1 :: AdaptList a => (a -> a -> a) -> List a -> List a -scanl1 f xs - | null xs = empty - | otherwise = scanl f (head xs) (tail xs) -{-# INLINE scanl1 #-} - --- | /O(n)/. 'scanr' is the right-to-left dual of 'scanl'. --- Properties: --- --- > head (scanr f z xs) == foldr f z xs --- -scanr :: (AdaptList a, AdaptList b) => (a -> b -> b) -> b -> List a -> List b -scanr f q0 xs - | null xs = cons q0 empty - | otherwise = f (head xs) (head qs) `cons` qs - where qs = scanr f q0 (tail xs) -{-# INLINE scanr #-} - --- | 'scanr1' is a variant of 'scanr' that has no starting value argument. -scanr1 :: AdaptList a => (a -> a -> a) -> List a -> List a -scanr1 f xs - | null xs = empty - | null (tail xs) = xs - | otherwise = f (head xs) (head qs) `cons` qs - where qs = scanr1 f (tail xs) - ------------------------------------------------------------------------- --- ** Infinite lists - --- | /O(n)/, 'iterate' @f x@ returns an infinite list of repeated applications --- of @f@ to @x@: --- --- > iterate f x == [x, f x, f (f x), ...] -iterate :: AdaptList a => (a -> a) -> a -> List a -iterate f x = go x - where go z = z `cons` go (f z) -{-# INLINE iterate #-} - --- | /O(n)/. 'repeat' @x@ is an infinite list, with @x@ the value of every element. -repeat :: AdaptList a => a -> List a -repeat x = xs where xs = x `cons` xs -{-# INLINE repeat #-} - --- | /O(n)/. 'replicate' @n x@ is a list of length @n@ with @x@ the value of --- every element. --- It is an instance of the more general 'Data.List.genericReplicate', --- in which @n@ may be of any integral type. --- -replicate :: AdaptList a => Int -> a -> List a -replicate n0 _ | n0 <= 0 = empty -replicate n0 x = go n0 - where - go 0 = empty - go n = x `cons` go (n-1) -{-# INLINE replicate #-} - --- | /fusion/. 'cycle' ties a finite list into a circular one, or equivalently, --- the infinite repetition of the original list. It is the identity --- on infinite lists. --- -cycle :: AdaptList a => List a -> List a -cycle xs0 - | null xs0 = errorEmptyList "cycle" - | otherwise = go xs0 - where - go xs - | null xs = go xs0 - | otherwise = head xs `cons` go (tail xs) -{-# INLINE cycle #-} - --- --------------------------------------------------------------------- --- ** Unfolding - --- | The 'unfoldr' function is a \`dual\' to 'foldr': while 'foldr' --- reduces a list to a summary value, 'unfoldr' builds a list from --- a seed value. The function takes the element and returns 'Nothing' --- if it is done producing the list or returns 'Just' @(a,b)@, in which --- case, @a@ is a prepended to the list and @b@ is used as the next --- element in a recursive call. For example, --- --- > iterate f == unfoldr (\x -> Just (x, f x)) --- --- In some cases, 'unfoldr' can undo a 'foldr' operation: --- --- > unfoldr f' (foldr f z xs) == xs --- --- if the following holds: --- --- > f' (f x y) = Just (x,y) --- > f' z = Nothing --- --- A simple use of unfoldr: --- --- > unfoldr (\b -> if b == 0 then Nothing else Just (b, b-1)) 10 --- > [10,9,8,7,6,5,4,3,2,1] --- --- /TODO/: AdaptPair state. --- -unfoldr :: AdaptList a => (b -> Prelude.Maybe (a, b)) -> b -> List a -unfoldr f b0 = unfold b0 - where - unfold b = case f b of - Prelude.Just (a,b') -> a `cons` unfold b' - Prelude.Nothing -> empty -{-# INLINE unfoldr #-} - ------------------------------------------------------------------------- --- * Sublists --- ** Extracting sublists - --- | /O(n)/. 'take' @n@, applied to a list @xs@, returns the prefix of @xs@ --- of length @n@, or @xs@ itself if @n > 'length' xs@: --- --- > take 5 "Hello World!" == "Hello" --- > take 3 [1,2,3,4,5] == [1,2,3] --- > take 3 [1,2] == [1,2] --- > take 3 [] == [] --- > take (-1) [1,2] == [] --- > take 0 [1,2] == [] --- --- It is an instance of the more general 'Data.List.genericTake', --- in which @n@ may be of any integral type. --- -take :: AdaptList a => Int -> List a -> List a -take i _ | i <= 0 = empty -take i ls = go i ls - where - go :: AdaptList a => Int -> List a -> List a - go 0 _ = empty - go n xs - | null xs = empty - | otherwise = (head xs) `cons` go (n-1) (tail xs) -{-# INLINE take #-} - --- | /O(n)/. 'drop' @n xs@ returns the suffix of @xs@ --- after the first @n@ elements, or @[]@ if @n > 'length' xs@: --- --- > drop 6 "Hello World!" == "World!" --- > drop 3 [1,2,3,4,5] == [4,5] --- > drop 3 [1,2] == [] --- > drop 3 [] == [] --- > drop (-1) [1,2] == [1,2] --- > drop 0 [1,2] == [1,2] --- --- It is an instance of the more general 'Data.List.genericDrop', --- in which @n@ may be of any integral type. --- -drop :: AdaptList a => Int -> List a -> List a -drop n ls - | n Prelude.< 0 = ls - | otherwise = go n ls - where - go :: AdaptList a => Int -> List a -> List a - go 0 xs = xs - go m xs - | null xs = empty - | otherwise = go (m-1) (tail xs) -{-# INLINE drop #-} - --- | 'splitAt' @n xs@ returns a tuple where first element is @xs@ prefix of --- length @n@ and second element is the remainder of the list: --- --- > splitAt 6 "Hello World!" == ("Hello ","World!") --- > splitAt 3 [1,2,3,4,5] == ([1,2,3],[4,5]) --- > splitAt 1 [1,2,3] == ([1],[2,3]) --- > splitAt 3 [1,2,3] == ([1,2,3],[]) --- > splitAt 4 [1,2,3] == ([1,2,3],[]) --- > splitAt 0 [1,2,3] == ([],[1,2,3]) --- > splitAt (-1) [1,2,3] == ([],[1,2,3]) --- --- It is equivalent to @('take' n xs, 'drop' n xs)@. --- 'splitAt' is an instance of the more general 'Data.List.genericSplitAt', --- in which @n@ may be of any integral type. --- -splitAt :: AdaptList a => Int -> List a -> (List a, List a) -splitAt n ls - | n Prelude.< 0 = (empty, ls) - | otherwise = go n ls - where - go :: AdaptList a => Int -> List a -> (List a, List a) - go 0 xs = (empty, xs) - go m xs - | null xs = (empty, empty) - | otherwise = (head xs `cons` xs', xs'') - where - (xs', xs'') = go (m-1) (tail xs) -{-# INLINE splitAt #-} - --- --------------------------------------------------------------------- --- * Searching lists --- ** Searching by equality - --- | /O(n)/. 'elem' is the list membership predicate, usually written --- in infix form, e.g., @x `elem` xs@. --- -elem :: (AdaptList a, Prelude.Eq a) => a -> List a -> Bool -elem x ys - | null ys = False - | x Prelude.== head ys = True - | otherwise = elem x (tail ys) -{-# INLINE elem #-} - --- | /O(n)/. 'notElem' is the negation of 'elem'. -notElem :: (AdaptList a, Prelude.Eq a) => a -> List a -> Bool -notElem x xs = Prelude.not (elem x xs) -{-# INLINE notElem #-} - --- | /O(n)/. 'filter', applied to a predicate and a list, returns the list of --- those elements that satisfy the predicate; i.e., --- --- > filter p xs = [ x | x <- xs, p x] --- --- Properties: --- --- > filter p (filter q s) = filter (\x -> q x && p x) s --- -filter :: AdaptList a => (a -> Bool) -> List a -> List a -filter p xs0 - | null xs0 = empty - | otherwise = go xs0 - where - go xs - | null xs = empty - | p x = x `cons` go ys - | otherwise = go ys - where x = head xs - ys = tail xs -{-# INLINE filter #-} - ------------------------------------------------------------------------- --- * Zipping and unzipping lists - --- | /O(n)/,/fusion/. 'zip' takes two lists and returns a list of --- corresponding pairs. If one input list is short, excess elements of --- the longer list are discarded. --- --- Properties: --- --- > zip a b = zipWith (,) a b --- -zip :: (AdaptPair a b, AdaptList a , AdaptList b, AdaptList (Pair a b)) - => List a -> List b -> List (Pair a b) -zip as bs - | null as = empty - | null bs = empty - | otherwise = pair (head as) (head bs) `cons` zip (tail as) (tail bs) -{-# INLINE zip #-} - ------------------------------------------------------------------------- - -{- - - --- ----------------------------------------------------------------------------- - -{- --- --------------------------------------------------------------------- --- ** Accumulating maps - --- | The 'mapAccumL' function behaves like a combination of 'map' and --- 'foldl'; it applies a function to each element of a list, passing --- an accumulating parameter from left to right, and returning a final --- value of this accumulator together with the new list. --- -mapAccumL :: (acc -> x -> (acc, y)) -> acc -> [x] -> (acc, [y]) -mapAccumL _ s [] = (s, []) -mapAccumL f s (x:xs) = (s'',y:ys) - where (s', y ) = f s x - (s'',ys) = mapAccumL f s' xs - --- TODO fuse - --- | The 'mapAccumR' function behaves like a combination of 'map' and --- 'foldr'; it applies a function to each element of a list, passing --- an accumulating parameter from right to left, and returning a final --- value of this accumulator together with the new list. --- -mapAccumR :: (acc -> x -> (acc, y)) -> acc -> [x] -> (acc, [y]) -mapAccumR _ s [] = (s, []) -mapAccumR f s (x:xs) = (s'', y:ys) - where (s'',y ) = f s' x - (s', ys) = mapAccumR f s xs - --- TODO fuse --} - --- | /O(n)/,/fusion/. 'takeWhile', applied to a predicate @p@ and a list @xs@, returns the --- longest prefix (possibly empty) of @xs@ of elements that satisfy @p@: --- --- > takeWhile (< 3) [1,2,3,4,1,2,3,4] == [1,2] --- > takeWhile (< 9) [1,2,3] == [1,2,3] --- > takeWhile (< 0) [1,2,3] == [] --- -takeWhile :: (a -> Bool) -> [a] -> [a] -takeWhile _ [] = [] -takeWhile p xs0 = go xs0 - where - go [] = [] - go (x:xs) - | p x = x : go xs - | otherwise = [] -{-# NOINLINE [1] takeWhile #-} - -{-# RULES -"takeWhile -> fusible" [~1] forall f xs. - takeWhile f xs = unstream (Stream.takeWhile f (stream xs)) ---"takeWhile -> unfused" [1] forall f xs. --- unstream (Stream.takeWhile f (stream xs)) = takeWhile f xs - #-} - --- | /O(n)/,/fusion/. 'dropWhile' @p xs@ returns the suffix remaining after 'takeWhile' @p xs@: --- --- > dropWhile (< 3) [1,2,3,4,5,1,2,3] == [3,4,5,1,2,3] --- > dropWhile (< 9) [1,2,3] == [] --- > dropWhile (< 0) [1,2,3] == [1,2,3] --- -dropWhile :: (a -> Bool) -> [a] -> [a] -dropWhile _ [] = [] -dropWhile p xs0 = go xs0 - where - go [] = [] - go xs@(x:xs') - | p x = go xs' - | otherwise = xs -{-# NOINLINE [1] dropWhile #-} - -{-# RULES -"dropWhile -> fusible" [~1] forall f xs. - dropWhile f xs = unstream (Stream.dropWhile f (stream xs)) ---"dropWhile -> unfused" [1] forall f xs. --- unstream (Stream.dropWhile f (stream xs)) = dropWhile f xs - #-} - --- | 'span', applied to a predicate @p@ and a list @xs@, returns a tuple where --- first element is longest prefix (possibly empty) of @xs@ of elements that --- satisfy @p@ and second element is the remainder of the list: --- --- > span (< 3) [1,2,3,4,1,2,3,4] == ([1,2],[3,4,1,2,3,4]) --- > span (< 9) [1,2,3] == ([1,2,3],[]) --- > span (< 0) [1,2,3] == ([],[1,2,3]) --- --- 'span' @p xs@ is equivalent to @('takeWhile' p xs, 'dropWhile' p xs)@ -span :: (a -> Bool) -> [a] -> ([a], [a]) -span _ [] = ([], []) -span p xs0 = go xs0 - where - go [] = ([], []) - go xs@(x:xs') - | p x = let (ys,zs) = go xs' - in (x:ys,zs) - | otherwise = ([],xs) - --- TODO fuse --- Hmm, these do a lot of sharing, but is it worth it? - --- | 'break', applied to a predicate @p@ and a list @xs@, returns a tuple where --- first element is longest prefix (possibly empty) of @xs@ of elements that --- /do not satisfy/ @p@ and second element is the remainder of the list: --- --- > break (> 3) [1,2,3,4,1,2,3,4] == ([1,2,3],[4,1,2,3,4]) --- > break (< 9) [1,2,3] == ([],[1,2,3]) --- > break (> 9) [1,2,3] == ([1,2,3],[]) --- --- 'break' @p@ is equivalent to @'span' ('not' . p)@. --- -break :: (a -> Bool) -> [a] -> ([a], [a]) -break _ [] = ([], []) -break p xs0 = go xs0 - where - go [] = ([], []) - go xs@(x:xs') - | p x = ([],xs) - | otherwise = let (ys,zs) = go xs' - in (x:ys,zs) - --- TODO fuse - --- | The 'group' function takes a list and returns a list of lists such --- that the concatenation of the result is equal to the argument. Moreover, --- each sublist in the result contains only equal elements. For example, --- --- > group "Mississippi" = ["M","i","ss","i","ss","i","pp","i"] --- --- It is a special case of 'groupBy', which allows the programmer to supply --- their own equality test. -group :: Eq a => [a] -> [[a]] -group [] = [] -group (x:xs) = (x:ys) : group zs - where (ys,zs) = span (x ==) xs - --- TODO fuse - --- | The 'inits' function returns all initial segments of the argument, --- shortest first. For example, --- --- > inits "abc" == ["","a","ab","abc"] --- -inits :: [a] -> [[a]] -inits [] = [] : [] -inits (x:xs) = [] : map (x:) (inits xs) - --- TODO fuse - --- | The 'tails' function returns all final segments of the argument, --- longest first. For example, --- --- > tails "abc" == ["abc", "bc", "c",""] --- -tails :: [a] -> [[a]] -tails [] = [] : [] -tails xxs@(_:xs) = xxs : tails xs - --- TODO fuse - ------------------------------------------------------------------------- --- * Predicates - --- | /O(n)/,/fusion/. The 'isPrefixOf' function takes two lists and --- returns 'True' iff the first list is a prefix of the second. --- -isPrefixOf :: Eq a => [a] -> [a] -> Bool -isPrefixOf [] _ = True -isPrefixOf _ [] = False -isPrefixOf (x:xs) (y:ys) | x == y = isPrefixOf xs ys - | otherwise = False -{-# NOINLINE [1] isPrefixOf #-} - -{-# RULES -"isPrefixOf -> fusible" [~1] forall xs ys. - isPrefixOf xs ys = Stream.isPrefixOf (stream xs) (stream ys) ---"isPrefixOf -> unfused" [1] forall xs ys. --- Stream.isPrefixOf (stream xs) (stream ys) = isPrefixOf xs ys - #-} - --- | The 'isSuffixOf' function takes two lists and returns 'True' --- iff the first list is a suffix of the second. --- Both lists must be finite. -isSuffixOf :: Eq a => [a] -> [a] -> Bool -isSuffixOf x y = reverse x `isPrefixOf` reverse y - --- TODO fuse - --- | The 'isInfixOf' function takes two lists and returns 'True' --- iff the first list is contained, wholly and intact, --- anywhere within the second. --- --- Example: --- --- > isInfixOf "Haskell" "I really like Haskell." -> True --- > isInfixOf "Ial" "I really like Haskell." -> False --- -isInfixOf :: Eq a => [a] -> [a] -> Bool -isInfixOf needle haystack = any (isPrefixOf needle) (tails haystack) - --- TODO fuse - --- --------------------------------------------------------------------- - --- | /O(n)/,/fusion/. 'lookup' @key assocs@ looks up a key in an association list. -lookup :: Eq a => a -> [(a, b)] -> Maybe b -lookup _ [] = Nothing -lookup key xys0 = go xys0 - where - go [] = Nothing - go ((x,y):xys) - | key == x = Just y - | otherwise = lookup key xys -{-# NOINLINE [1] lookup #-} - ------------------------------------------------------------------------- --- ** Searching with a predicate - --- | /O(n)/,/fusion/. The 'find' function takes a predicate and a list and returns the --- first element in the list matching the predicate, or 'Nothing' if --- there is no such element. -find :: (a -> Bool) -> [a] -> Maybe a -find _ [] = Nothing -find p xs0 = go xs0 - where - go [] = Nothing - go (x:xs) | p x = Just x - | otherwise = go xs -{-# NOINLINE [1] find #-} - -{-# RULES -"find -> fusible" [~1] forall f xs. - find f xs = Stream.find f (stream xs) ---"find -> unfused" [1] forall f xs. --- Stream.find f (stream xs) = find f xs - #-} - --- | The 'partition' function takes a predicate a list and returns --- the pair of lists of elements which do and do not satisfy the --- predicate, respectively; i.e., --- --- > partition p xs == (filter p xs, filter (not . p) xs) -partition :: (a -> Bool) -> [a] -> ([a], [a]) -partition p xs = foldr (select p) ([],[]) xs -{-# INLINE partition #-} - --- TODO fuse - -select :: (a -> Bool) -> a -> ([a], [a]) -> ([a], [a]) -select p x ~(ts,fs) | p x = (x:ts,fs) - | otherwise = (ts, x:fs) - ------------------------------------------------------------------------- --- * Indexing lists - --- | /O(n)/,/fusion/. List index (subscript) operator, starting from 0. --- It is an instance of the more general 'Data.List.genericIndex', --- which takes an index of any integral type. -(!!) :: [a] -> Int -> a -xs0 !! n0 - | n0 < 0 = error "Prelude.(!!): negative index" - | otherwise = index xs0 n0 -#ifndef __HADDOCK__ - where - index [] _ = error "Prelude.(!!): index too large" - index (y:ys) n = if n == 0 then y else index ys (n-1) -#endif -{-# NOINLINE [1] (!!) #-} - -{-# RULES -"!! -> fusible" [~1] forall xs n. - xs !! n = Stream.index (stream xs) n --- "!! -> unfused" [1] forall xs n. --- Stream.index (stream xs) n = xs !! n - #-} - --- | The 'elemIndex' function returns the index of the first element --- in the given list which is equal (by '==') to the query element, --- or 'Nothing' if there is no such element. --- --- Properties: --- --- > elemIndex x xs = listToMaybe [ n | (n,a) <- zip [0..] xs, a == x ] --- > elemIndex x xs = findIndex (x==) xs --- -elemIndex :: Eq a => a -> [a] -> Maybe Int -elemIndex x = findIndex (x==) -{-# INLINE elemIndex #-} -{- -elemIndex :: Eq a => a -> [a] -> Maybe Int -elemIndex y xs0 = loop_elemIndex xs0 0 -#ifndef __HADDOCK__ - where - loop_elemIndex [] !_ = Nothing - loop_elemIndex (x:xs) !n - | p x = Just n - | otherwise = loop_elemIndex xs (n + 1) - p = (y ==) -#endif -{-# NOINLINE [1] elemIndex #-} --} -{- RULES -"elemIndex -> fusible" [~1] forall x xs. - elemIndex x xs = Stream.elemIndex x (stream xs) -"elemIndex -> unfused" [1] forall x xs. - Stream.elemIndex x (stream xs) = elemIndex x xs - -} - --- | /O(n)/,/fusion/. The 'elemIndices' function extends 'elemIndex', by --- returning the indices of all elements equal to the query element, in --- ascending order. --- --- Properties: --- --- > length (filter (==a) xs) = length (elemIndices a xs) --- -elemIndices :: Eq a => a -> [a] -> [Int] -elemIndices x = findIndices (x==) -{-# INLINE elemIndices #-} - -{- -elemIndices :: Eq a => a -> [a] -> [Int] -elemIndices y xs0 = loop_elemIndices xs0 0 -#ifndef __HADDOCK__ - where - loop_elemIndices [] !_ = [] - loop_elemIndices (x:xs) !n - | p x = n : loop_elemIndices xs (n + 1) - | otherwise = loop_elemIndices xs (n + 1) - p = (y ==) -#endif -{-# NOINLINE [1] elemIndices #-} --} -{- RULES -"elemIndices -> fusible" [~1] forall x xs. - elemIndices x xs = unstream (Stream.elemIndices x (stream xs)) -"elemIndices -> unfused" [1] forall x xs. - unstream (Stream.elemIndices x (stream xs)) = elemIndices x xs - -} - --- | The 'findIndex' function takes a predicate and a list and returns --- the index of the first element in the list satisfying the predicate, --- or 'Nothing' if there is no such element. --- --- Properties: --- --- > findIndex p xs = listToMaybe [ n | (n,x) <- zip [0..] xs, p x ] --- -findIndex :: (a -> Bool) -> [a] -> Maybe Int -findIndex p ls = loop_findIndex ls 0# - where - loop_findIndex [] _ = Nothing - loop_findIndex (x:xs) n - | p x = Just (I# n) - | otherwise = loop_findIndex xs (n +# 1#) -{-# NOINLINE [1] findIndex #-} - -{-# RULES -"findIndex -> fusible" [~1] forall f xs. - findIndex f xs = Stream.findIndex f (stream xs) --- "findIndex -> unfused" [1] forall f xs. --- Stream.findIndex f (stream xs) = findIndex f xs - #-} - --- | /O(n)/,/fusion/. The 'findIndices' function extends 'findIndex', by --- returning the indices of all elements satisfying the predicate, in --- ascending order. --- --- Properties: --- --- > length (filter p xs) = length (findIndices p xs) --- -findIndices :: (a -> Bool) -> [a] -> [Int] -findIndices p ls = loop_findIndices ls 0# - where - loop_findIndices [] _ = [] - loop_findIndices (x:xs) n - | p x = I# n : loop_findIndices xs (n +# 1#) - | otherwise = loop_findIndices xs (n +# 1#) -{-# NOINLINE [1] findIndices #-} - --- | /O(n)/,/fusion/. 'zip3' takes three lists and returns a list of --- triples, analogous to 'zip'. --- --- Properties: --- --- > zip3 a b c = zipWith (,,) a b c --- -zip3 :: [a] -> [b] -> [c] -> [(a, b, c)] -zip3 (a:as) (b:bs) (c:cs) = (a,b,c) : zip3 as bs cs -zip3 _ _ _ = [] -{-# NOINLINE [1] zip3 #-} - -{-# RULES -"zip3 -> fusible" [~1] forall xs ys zs. - zip3 xs ys zs = unstream (Stream.zipWith3 (,,) (stream xs) (stream ys) (stream zs)) --- "zip3 -> unfused" [1] forall xs ys zs. --- unstream (Stream.zipWith3 (,,) (stream xs) (stream ys) (stream zs)) = zip3 xs ys zs - #-} - --- | /O(n)/,/fusion/. The 'zip4' function takes four lists and returns a list of --- quadruples, analogous to 'zip'. -zip4 :: [a] -> [b] -> [c] -> [d] -> [(a, b, c, d)] -zip4 = zipWith4 (,,,) -{-# INLINE zip4 #-} - --- | The 'zip5' function takes five lists and returns a list of --- five-tuples, analogous to 'zip'. -zip5 :: [a] -> [b] -> [c] -> [d] -> [e] -> [(a, b, c, d, e)] -zip5 = zipWith5 (,,,,) - --- | The 'zip6' function takes six lists and returns a list of six-tuples, --- analogous to 'zip'. -zip6 :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [(a, b, c, d, e, f)] -zip6 = zipWith6 (,,,,,) - --- | The 'zip7' function takes seven lists and returns a list of --- seven-tuples, analogous to 'zip'. -zip7 :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g] -> [(a, b, c, d, e, f, g)] -zip7 = zipWith7 (,,,,,,) - --- | /O(n)/,/fusion/. 'zipWith' generalises 'zip' by zipping with the --- function given as the first argument, instead of a tupling function. --- For example, @'zipWith' (+)@ is applied to two lists to produce the --- list of corresponding sums. --- Properties: --- --- > zipWith (,) = zip --- -zipWith :: (a -> b -> c) -> [a] -> [b] -> [c] -zipWith f (a:as) (b:bs) = f a b : zipWith f as bs -zipWith _ _ _ = [] -{-# INLINE [1] zipWith #-} - ---FIXME: If we change the above INLINE to NOINLINE then ghc goes into --- a loop, why? Do we have some dodgy recursive rules somewhere? - -{-# RULES -"zipWith -> fusible" [~1] forall f xs ys. - zipWith f xs ys = unstream (Stream.zipWith f (stream xs) (stream ys)) --- "zipWith -> unfused" [1] forall f xs ys. --- unstream (Stream.zipWith f (stream xs) (stream ys)) = zipWith f xs ys - #-} - --- | /O(n)/,/fusion/. The 'zipWith3' function takes a function which --- combines three elements, as well as three lists and returns a list of --- their point-wise combination, analogous to 'zipWith'. --- --- Properties: --- --- > zipWith3 (,,) = zip3 --- -zipWith3 :: (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d] -zipWith3 z (a:as) (b:bs) (c:cs) = z a b c : zipWith3 z as bs cs -zipWith3 _ _ _ _ = [] -{-# NOINLINE [1] zipWith3 #-} - -{-# RULES -"zipWith3 -> fusible" [~1] forall f xs ys zs. - zipWith3 f xs ys zs = unstream (Stream.zipWith3 f (stream xs) (stream ys) (stream zs)) --- "zipWith3 -> unfused" [1] forall f xs ys zs. --- unstream (Stream.zipWith3 f (stream xs) (stream ys) (stream zs)) = zipWith3 f xs ys zs - #-} - --- | /O(n)/,/fusion/. The 'zipWith4' function takes a function which combines four --- elements, as well as four lists and returns a list of their point-wise --- combination, analogous to 'zipWith'. -zipWith4 :: (a -> b -> c -> d -> e) -> [a] -> [b] -> [c] -> [d] -> [e] -zipWith4 z (a:as) (b:bs) (c:cs) (d:ds) - = z a b c d : zipWith4 z as bs cs ds -zipWith4 _ _ _ _ _ = [] -{-# NOINLINE [1] zipWith4 #-} - -{-# RULES -"zipWith4 -> fusible" [~1] forall f ws xs ys zs. - zipWith4 f ws xs ys zs = unstream (Stream.zipWith4 f (stream ws) (stream xs) (stream ys) (stream zs)) --- "zipWith4 -> unfused" [1] forall f ws xs ys zs. --- unstream (Stream.zipWith4 f (stream ws) (stream xs) (stream ys) (stream zs)) = zipWith4 f ws xs ys zs - #-} - --- | The 'zipWith5' function takes a function which combines five --- elements, as well as five lists and returns a list of their point-wise --- combination, analogous to 'zipWith'. -zipWith5 :: (a -> b -> c -> d -> e -> f) - -> [a] -> [b] -> [c] -> [d] -> [e] -> [f] -zipWith5 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) - = z a b c d e : zipWith5 z as bs cs ds es -zipWith5 _ _ _ _ _ _ = [] - --- TODO fuse - --- | The 'zipWith6' function takes a function which combines six --- elements, as well as six lists and returns a list of their point-wise --- combination, analogous to 'zipWith'. -zipWith6 :: (a -> b -> c -> d -> e -> f -> g) - -> [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g] -zipWith6 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) - = z a b c d e f : zipWith6 z as bs cs ds es fs -zipWith6 _ _ _ _ _ _ _ = [] - --- TODO fuse - --- | The 'zipWith7' function takes a function which combines seven --- elements, as well as seven lists and returns a list of their point-wise --- combination, analogous to 'zipWith'. -zipWith7 :: (a -> b -> c -> d -> e -> f -> g -> h) - -> [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g] -> [h] -zipWith7 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) (g:gs) - = z a b c d e f g : zipWith7 z as bs cs ds es fs gs -zipWith7 _ _ _ _ _ _ _ _ = [] - --- TODO fuse - ------------------------------------------------------------------------- --- unzips - --- | 'unzip' transforms a list of pairs into a list of first components --- and a list of second components. -unzip :: [(a, b)] -> ([a], [b]) -unzip = foldr (\(a,b) ~(as,bs) -> (a:as,b:bs)) ([],[]) - --- TODO fuse - --- | The 'unzip3' function takes a list of triples and returns three --- lists, analogous to 'unzip'. -unzip3 :: [(a, b, c)] -> ([a], [b], [c]) -unzip3 = foldr (\(a,b,c) ~(as,bs,cs) -> (a:as,b:bs,c:cs)) ([],[],[]) - --- TODO fuse - --- | The 'unzip4' function takes a list of quadruples and returns four --- lists, analogous to 'unzip'. -unzip4 :: [(a, b, c, d)] -> ([a], [b], [c], [d]) -unzip4 = foldr (\(a,b,c,d) ~(as,bs,cs,ds) -> - (a:as,b:bs,c:cs,d:ds)) - ([],[],[],[]) - --- TODO fuse - --- | The 'unzip5' function takes a list of five-tuples and returns five --- lists, analogous to 'unzip'. -unzip5 :: [(a, b, c, d, e)] -> ([a], [b], [c], [d], [e]) -unzip5 = foldr (\(a,b,c,d,e) ~(as,bs,cs,ds,es) -> - (a:as,b:bs,c:cs,d:ds,e:es)) - ([],[],[],[],[]) - --- TODO fuse - --- | The 'unzip6' function takes a list of six-tuples and returns six --- lists, analogous to 'unzip'. -unzip6 :: [(a, b, c, d, e, f)] -> ([a], [b], [c], [d], [e], [f]) -unzip6 = foldr (\(a,b,c,d,e,f) ~(as,bs,cs,ds,es,fs) -> - (a:as,b:bs,c:cs,d:ds,e:es,f:fs)) - ([],[],[],[],[],[]) - --- TODO fuse - --- | The 'unzip7' function takes a list of seven-tuples and returns --- seven lists, analogous to 'unzip'. -unzip7 :: [(a, b, c, d, e, f, g)] -> ([a], [b], [c], [d], [e], [f], [g]) -unzip7 = foldr (\(a,b,c,d,e,f,g) ~(as,bs,cs,ds,es,fs,gs) -> - (a:as,b:bs,c:cs,d:ds,e:es,f:fs,g:gs)) - ([],[],[],[],[],[],[]) - --- TODO fuse - ------------------------------------------------------------------------- --- * Special lists --- ** Functions on strings - --- | /O(O)/,/fusion/. 'lines' breaks a string up into a list of strings --- at newline characters. The resulting strings do not contain --- newlines. -lines :: String -> [String] -lines [] = [] -lines s = let (l, s') = break (== '\n') s - in l : case s' of - [] -> [] - (_:s'') -> lines s'' ---TODO: can we do better than this and preserve the same strictness? - -{- --- This implementation is fast but too strict :-( --- it doesn't yield each line until it has seen the ending '\n' - -lines :: String -> [String] -lines [] = [] -lines cs0 = go [] cs0 - where - go l [] = reverse l : [] - go l ('\n':cs) = reverse l : case cs of - [] -> [] - _ -> go [] cs - go l ( c :cs) = go (c:l) cs --} -{-# INLINE [1] lines #-} - -{- RULES -"lines -> fusible" [~1] forall xs. - lines xs = unstream (Stream.lines (stream xs)) -"lines -> unfused" [1] forall xs. - unstream (Stream.lines (stream xs)) = lines xs - -} - --- | 'words' breaks a string up into a list of words, which were delimited --- by white space. -words :: String -> [String] -words s = case dropWhile isSpace s of - "" -> [] - s' -> w : words s'' - where (w, s'') = break isSpace s' --- TODO fuse ---TODO: can we do better than this and preserve the same strictness? - -{- --- This implementation is fast but too strict :-( --- it doesn't yield each word until it has seen the ending space - -words cs0 = dropSpaces cs0 - where - dropSpaces :: String -> [String] - dropSpaces [] = [] - dropSpaces (c:cs) - | isSpace c = dropSpaces cs - | otherwise = munchWord [c] cs - - munchWord :: String -> String -> [String] - munchWord w [] = reverse w : [] - munchWord w (c:cs) - | isSpace c = reverse w : dropSpaces cs - | otherwise = munchWord (c:w) cs --} - --- | /O(n)/,/fusion/. 'unlines' is an inverse operation to 'lines'. --- It joins lines, after appending a terminating newline to each. --- --- > unlines xs = concatMap (++"\n") --- -unlines :: [String] -> String -unlines css0 = to css0 - where go [] css = '\n' : to css - go (c:cs) css = c : go cs css - - to [] = [] - to (cs:css) = go cs css -{-# NOINLINE [1] unlines #-} - --- --- fuse via: --- unlines xs = concatMap (snoc xs '\n') --- -{- RULES -"unlines -> fusible" [~1] forall xs. - unlines xs = unstream (Stream.concatMap (\x -> Stream.snoc (stream x) '\n') (stream xs)) -"unlines -> unfused" [1] forall xs. - unstream (Stream.concatMap (\x -> Stream.snoc (stream x) '\n') (stream xs)) = unlines xs - -} - --- | 'unwords' is an inverse operation to 'words'. --- It joins words with separating spaces. -unwords :: [String] -> String -unwords [] = [] -unwords (cs0:css0) = go cs0 css0 - where go [] css = to css - go (c:cs) css = c : go cs css - - to [] = [] - to (cs:ccs) = ' ' : go cs ccs - --- TODO fuse - ------------------------------------------------------------------------- --- ** \"Set\" operations - --- | The 'nub' function removes duplicate elements from a list. --- In particular, it keeps only the first occurrence of each element. --- (The name 'nub' means \`essence\'.) --- It is a special case of 'nubBy', which allows the programmer to supply --- their own equality test. --- -nub :: Eq a => [a] -> [a] -nub l = nub' l [] - where - nub' [] _ = [] - nub' (x:xs) ls - | x `elem` ls = nub' xs ls - | otherwise = x : nub' xs (x:ls) - -{- RULES --- ndm's optimisation -"sort/nub" forall xs. sort (nub xs) = map head (group (sort xs)) - -} - --- TODO fuse - --- | 'delete' @x@ removes the first occurrence of @x@ from its list argument. --- For example, --- --- > delete 'a' "banana" == "bnana" --- --- It is a special case of 'deleteBy', which allows the programmer to --- supply their own equality test. --- -delete :: Eq a => a -> [a] -> [a] -delete = deleteBy (==) - --- TODO fuse - --- | The '\\' function is list difference ((non-associative). --- In the result of @xs@ '\\' @ys@, the first occurrence of each element of --- @ys@ in turn (if any) has been removed from @xs@. Thus --- --- > (xs ++ ys) \\ xs == ys. --- --- It is a special case of 'deleteFirstsBy', which allows the programmer --- to supply their own equality test. -(\\) :: Eq a => [a] -> [a] -> [a] -(\\) = foldl (flip delete) - --- | The 'union' function returns the list union of the two lists. --- For example, --- --- > "dog" `union` "cow" == "dogcw" --- --- Duplicates, and elements of the first list, are removed from the --- the second list, but if the first list contains duplicates, so will --- the result. --- It is a special case of 'unionBy', which allows the programmer to supply --- their own equality test. --- -union :: Eq a => [a] -> [a] -> [a] -union = unionBy (==) - --- TODO fuse - --- | The 'intersect' function takes the list intersection of two lists. --- For example, --- --- > [1,2,3,4] `intersect` [2,4,6,8] == [2,4] --- --- If the first list contains duplicates, so will the result. --- It is a special case of 'intersectBy', which allows the programmer to --- supply their own equality test. --- -intersect :: Eq a => [a] -> [a] -> [a] -intersect = intersectBy (==) - --- TODO fuse - ------------------------------------------------------------------------- --- ** Ordered lists - --- TODO stuff in Ord can use Map/IntMap --- TODO Hooray, an Ord constraint! we could use a better structure. - --- | The 'sort' function implements a stable sorting algorithm. --- It is a special case of 'sortBy', which allows the programmer to supply --- their own comparison function. --- --- Properties: --- --- > not (null x) ==> (head . sort) x = minimum x --- > not (null x) ==> (last . sort) x = maximum x --- -sort :: Ord a => [a] -> [a] -sort l = mergesort compare l - --- TODO fuse, we have an Ord constraint! - --- | /O(n)/,/fusion/. The 'insert' function takes an element and a list and inserts the --- element into the list at the last position where it is still less --- than or equal to the next element. In particular, if the list --- is sorted before the call, the result will also be sorted. --- It is a special case of 'insertBy', which allows the programmer to --- supply their own comparison function. --- -insert :: Ord a => a -> [a] -> [a] -insert e ls = insertBy (compare) e ls -{-# INLINE insert #-} - ------------------------------------------------------------------------- --- * Generalized functions --- ** The \"By\" operations --- *** User-supplied equality (replacing an Eq context) - --- | The 'nubBy' function behaves just like 'nub', except it uses a --- user-supplied equality predicate instead of the overloaded '==' --- function. -nubBy :: (a -> a -> Bool) -> [a] -> [a] -nubBy eq l = nubBy' l [] - where - nubBy' [] _ = [] - nubBy' (y:ys) xs - | elem_by eq y xs = nubBy' ys xs - | otherwise = y : nubBy' ys (y:xs) - --- TODO fuse - --- Not exported: --- Note that we keep the call to `eq` with arguments in the --- same order as in the reference implementation --- 'xs' is the list of things we've seen so far, --- 'y' is the potential new element --- -elem_by :: (a -> a -> Bool) -> a -> [a] -> Bool -elem_by _ _ [] = False -elem_by eq y (x:xs) = if x `eq` y then True else elem_by eq y xs - --- | The 'deleteBy' function behaves like 'delete', but takes a --- user-supplied equality predicate. -deleteBy :: (a -> a -> Bool) -> a -> [a] -> [a] -deleteBy _ _ [] = [] -deleteBy eq x (y:ys) = if x `eq` y then ys else y : deleteBy eq x ys - --- TODO fuse - -deleteFirstsBy :: (a -> a -> Bool) -> [a] -> [a] -> [a] -deleteFirstsBy eq = foldl (flip (deleteBy eq)) - - --- | The 'unionBy' function is the non-overloaded version of 'union'. -unionBy :: (a -> a -> Bool) -> [a] -> [a] -> [a] -unionBy eq xs ys = xs ++ foldl (flip (deleteBy eq)) (nubBy eq ys) xs - --- TODO fuse - --- | The 'intersectBy' function is the non-overloaded version of 'intersect'. -intersectBy :: (a -> a -> Bool) -> [a] -> [a] -> [a] -intersectBy eq xs ys = [x | x <- xs, any (eq x) ys] - --- TODO fuse - --- | The 'groupBy' function is the non-overloaded version of 'group'. -groupBy :: (a -> a -> Bool) -> [a] -> [[a]] -groupBy _ [] = [] -groupBy eq (x:xs) = (x:ys) : groupBy eq zs - where (ys,zs) = span (eq x) xs - --- TODO fuse - ------------------------------------------------------------------------- --- *** User-supplied comparison (replacing an Ord context) - --- | The 'sortBy' function is the non-overloaded version of 'sort'. -sortBy :: (a -> a -> Ordering) -> [a] -> [a] -sortBy cmp l = mergesort cmp l - --- TODO fuse - -mergesort :: (a -> a -> Ordering) -> [a] -> [a] -mergesort cmp xs = mergesort' cmp (map wrap xs) - -mergesort' :: (a -> a -> Ordering) -> [[a]] -> [a] -mergesort' _ [] = [] -mergesort' _ [xs] = xs -mergesort' cmp xss = mergesort' cmp (merge_pairs cmp xss) - -merge_pairs :: (a -> a -> Ordering) -> [[a]] -> [[a]] -merge_pairs _ [] = [] -merge_pairs _ [xs] = [xs] -merge_pairs cmp (xs:ys:xss) = merge cmp xs ys : merge_pairs cmp xss - -merge :: (a -> a -> Ordering) -> [a] -> [a] -> [a] -merge _ xs [] = xs -merge _ [] ys = ys -merge cmp (x:xs) (y:ys) - = case x `cmp` y of - GT -> y : merge cmp (x:xs) ys - _ -> x : merge cmp xs (y:ys) - -wrap :: a -> [a] -wrap x = [x] - --- | /O(n)/,/fusion/. The non-overloaded version of 'insert'. -insertBy :: (a -> a -> Ordering) -> a -> [a] -> [a] -insertBy _ x [] = [x] -insertBy cmp x ys@(y:ys') - = case cmp x y of - GT -> y : insertBy cmp x ys' - _ -> x : ys -{-# NOINLINE [1] insertBy #-} - -{-# RULES -"insertBy -> fusible" [~1] forall f x xs. - insertBy f x xs = unstream (Stream.insertBy f x (stream xs)) --- "insertBy -> unfused" [1] forall f x xs. --- unstream (Stream.insertBy f x (stream xs)) = insertBy f x xs - #-} - --- | /O(n)/,/fusion/. The 'maximumBy' function takes a comparison function and a list --- and returns the greatest element of the list by the comparison function. --- The list must be finite and non-empty. --- -maximumBy :: (a -> a -> Ordering) -> [a] -> a -maximumBy _ [] = error "List.maximumBy: empty list" -maximumBy cmp xs = foldl1 max' xs - where - max' x y = case cmp x y of - GT -> x - _ -> y -{-# NOINLINE [1] maximumBy #-} - -{-# RULES -"maximumBy -> fused" [~1] forall p xs. - maximumBy p xs = Stream.maximumBy p (stream xs) --- "maximumBy -> unfused" [1] forall p xs. --- Stream.maximumBy p (stream xs) = maximumBy p xs - #-} - --- | /O(n)/,/fusion/. The 'minimumBy' function takes a comparison function and a list --- and returns the least element of the list by the comparison function. --- The list must be finite and non-empty. -minimumBy :: (a -> a -> Ordering) -> [a] -> a -minimumBy _ [] = error "List.minimumBy: empty list" -minimumBy cmp xs = foldl1 min' xs - where - min' x y = case cmp x y of - GT -> y - _ -> x -{-# NOINLINE [1] minimumBy #-} - -{-# RULES -"minimumBy -> fused" [~1] forall p xs. - minimumBy p xs = Stream.minimumBy p (stream xs) --- "minimumBy -> unfused" [1] forall p xs. --- Stream.minimumBy p (stream xs) = minimumBy p xs - #-} - ------------------------------------------------------------------------- --- * The \"generic\" operations - --- | The 'genericLength' function is an overloaded version of 'length'. In --- particular, instead of returning an 'Int', it returns any type which is --- an instance of 'Num'. It is, however, less efficient than 'length'. --- -genericLength :: Num i => [b] -> i -genericLength [] = 0 -genericLength (_:l) = 1 + genericLength l -{-# NOINLINE [1] genericLength #-} - -{-# RULES -"genericLength -> fusible" [~1] forall xs. - genericLength xs = Stream.genericLength (stream xs) --- "genericLength -> unfused" [1] forall xs. --- Stream.genericLength (stream xs) = genericLength xs - #-} - -{-# RULES -"genericLength -> length/Int" genericLength = length :: [a] -> Int - #-} - --- | /O(n)/,/fusion/. The 'genericTake' function is an overloaded version of 'take', which --- accepts any 'Integral' value as the number of elements to take. -genericTake :: Integral i => i -> [a] -> [a] -genericTake 0 _ = [] -genericTake _ [] = [] -genericTake n (x:xs) - | n > 0 = x : genericTake (n-1) xs - | otherwise = error "List.genericTake: negative argument" -{-# NOINLINE [1] genericTake #-} - -{-# RULES -"genericTake -> fusible" [~1] forall xs n. - genericTake n xs = unstream (Stream.genericTake n (stream xs)) --- "genericTake -> unfused" [1] forall xs n. --- unstream (Stream.genericTake n (stream xs)) = genericTake n xs - #-} - -{-# RULES -"genericTake -> take/Int" genericTake = take :: Int -> [a] -> [a] - #-} - --- | /O(n)/,/fusion/. The 'genericDrop' function is an overloaded version of 'drop', which --- accepts any 'Integral' value as the number of elements to drop. -genericDrop :: Integral i => i -> [a] -> [a] -genericDrop 0 xs = xs -genericDrop _ [] = [] -genericDrop n (_:xs) | n > 0 = genericDrop (n-1) xs -genericDrop _ _ = error "List.genericDrop: negative argument" -{-# NOINLINE [1] genericDrop #-} - -{-# RULES -"genericDrop -> fusible" [~1] forall xs n. - genericDrop n xs = unstream (Stream.genericDrop n (stream xs)) --- "genericDrop -> unfused" [1] forall xs n. --- unstream (Stream.genericDrop n (stream xs)) = genericDrop n xs - #-} - -{-# RULES -"genericDrop -> drop/Int" genericDrop = drop :: Int -> [a] -> [a] - #-} - --- | /O(n)/,/fusion/. The 'genericIndex' function is an overloaded version of '!!', which --- accepts any 'Integral' value as the index. -genericIndex :: Integral a => [b] -> a -> b -genericIndex (x:_) 0 = x -genericIndex (_:xs) n - | n > 0 = genericIndex xs (n-1) - | otherwise = error "List.genericIndex: negative argument." -genericIndex _ _ = error "List.genericIndex: index too large." -{-# NOINLINE [1] genericIndex #-} - - --- can we pull the n > 0 test out and do it just once? --- probably not since we don't know what n-1 does!! --- can only specialise it for sane Integral instances :-( - -{-# RULES -"genericIndex -> fusible" [~1] forall xs n. - genericIndex xs n = Stream.genericIndex (stream xs) n --- "genericIndex -> unfused" [1] forall xs n. --- Stream.genericIndex (stream xs) n = genericIndex n xs - #-} - -{-# RULES -"genericIndex -> index/Int" genericIndex = (!!) :: [a] -> Int -> a - #-} - --- | /O(n)/,/fusion/. The 'genericSplitAt' function is an overloaded --- version of 'splitAt', which accepts any 'Integral' value as the --- position at which to split. --- -genericSplitAt :: Integral i => i -> [a] -> ([a], [a]) -genericSplitAt 0 xs = ([],xs) -genericSplitAt _ [] = ([],[]) -genericSplitAt n (x:xs) | n > 0 = (x:xs',xs'') - where (xs',xs'') = genericSplitAt (n-1) xs -genericSplitAt _ _ = error "List.genericSplitAt: negative argument" - -{-# RULES -"genericSplitAt -> fusible" [~1] forall xs n. - genericSplitAt n xs = Stream.genericSplitAt n (stream xs) --- "genericSplitAt -> unfused" [1] forall xs n. --- Stream.genericSplitAt n (stream xs) = genericSplitAt n xs - #-} - -{-# RULES -"genericSplitAt -> splitAt/Int" genericSplitAt = splitAt :: Int -> [a] -> ([a], [a]) - #-} - --- | /O(n)/,/fusion/. The 'genericReplicate' function is an overloaded version of 'replicate', --- which accepts any 'Integral' value as the number of repetitions to make. --- -genericReplicate :: Integral i => i -> a -> [a] -genericReplicate n x = genericTake n (repeat x) -{-# INLINE genericReplicate #-} - -{-# RULES -"genericReplicate -> replicate/Int" genericReplicate = replicate :: Int -> a -> [a] - #-} --} - --- --------------------------------------------------------------------- --- Internal utilities - --- Common up near identical calls to `error' to reduce the number --- constant strings created when compiled: -errorEmptyList :: Prelude.String -> a -errorEmptyList fun = moduleError fun "empty list" -{-# NOINLINE errorEmptyList #-} - -moduleError :: Prelude.String -> Prelude.String -> a -moduleError fun msg = Prelude.error ("Data.Adaptive.List." Prelude.++ fun Prelude.++ ':':' ':msg) -{-# NOINLINE moduleError #-} - -bottom :: a -bottom = Prelude.error "Data.List.Stream: bottom" -{-# NOINLINE bottom #-} - ------------------------------------------------------------------------- --- Instances - -instance (AdaptList a, Prelude.Eq a) => Prelude.Eq (List a) where - xs == ys - | null xs Prelude.&& null ys = True - | null xs = False - | null ys = False - | otherwise = (head xs Prelude.== head ys) - Prelude.&& (tail xs Prelude.== tail ys) - -instance (AdaptList a, Prelude.Ord a) => Prelude.Ord (List a) where - compare xs ys - | null xs Prelude.&& null ys = EQ - | null xs = LT - | null ys = GT - | otherwise = case compare (head xs) (head ys) of - EQ -> compare (tail xs) (tail ys) - other -> other - -instance (AdaptList a, Prelude.Show a) => Prelude.Show (List a) where - showsPrec _ = Prelude.showList . toList - ------------------------------------------------------------------------- - --- Generic adaptive pair: won't flatten! - -{- -Data/Adaptive/List.hs:1687:9: - Conflicting family instance declarations: - data instance List (Pair a b) - -- Defined at Data/Adaptive/List.hs:1687:9-12 - data instance List (Pair Int Int) - -- Defined at Data/Adaptive/List.hs:1699:9-12 --} - -{- - -- looks illegal? -instance AdaptPair a b => AdaptList (Pair a b) where - data List (Pair a b) = EmptyPair | ConsPair {-# UNPACK #-}!(Pair a b) (List (Pair a b)) - empty = EmptyPair - cons x xs = ConsPair x xs - null EmptyPair = True - null _ = False - head EmptyPair = errorEmptyList "head" - head (ConsPair x _) = x - tail EmptyPair = errorEmptyList "tail" - tail (ConsPair _ xs) = xs --} - --- Monomorphic, but we have to flatten ourselves. GHC is doing something wrong. -instance AdaptList (Pair Int Int) where - data List (Pair Int Int) - = EmptyPairIntInt --- | ConsPairIntInt {-# UNPACK #-}!(Pair Int Int) (List (Pair Int Int)) - -- this isn't unpacking - | ConsPairIntInt {-# UNPACK #-}!Int {-# UNPACK #-}!Int (List (Pair Int Int)) - - empty = EmptyPairIntInt - cons x xs = ConsPairIntInt (fst x) (snd x) xs - - null EmptyPairIntInt = True - null _ = False - - head EmptyPairIntInt = errorEmptyList "head" - head (ConsPairIntInt x y _) = pair x y - tail EmptyPairIntInt = errorEmptyList "tail" - tail (ConsPairIntInt _ _ xs) = xs - ------------------------------------------------------------------------- - --- | We can unpack bools! -instance AdaptList Bool where - data List Bool = EmptyBool | ConsBool {-# UNPACK #-}!Int (List Bool) - - empty = EmptyBool - cons x xs = ConsBool (Prelude.fromEnum x) xs -- pack - null EmptyBool = True - null _ = False - - head EmptyBool = errorEmptyList "head" - head (ConsBool x _) = Prelude.toEnum x - - tail EmptyBool = errorEmptyList "tail" - tail (ConsBool _ xs) = xs - ------------------------------------------------------------------------- --- Generated by scripts/derive-list.hs - -instance AdaptList Int where - data List Int = EmptyInt | ConsInt {-# UNPACK #-}!Int (List Int) - empty = EmptyInt - cons = ConsInt - null EmptyInt = True - null _ = False - head EmptyInt = errorEmptyList "head" - head (ConsInt x _) = x - tail EmptyInt = errorEmptyList "tail" - tail (ConsInt _ x) = x - -instance AdaptList Integer where - data List Integer = EmptyInteger | ConsInteger {-# UNPACK #-}!Integer (List Integer) - empty = EmptyInteger - cons = ConsInteger - null EmptyInteger = True - null _ = False - head EmptyInteger = errorEmptyList "head" - head (ConsInteger x _) = x - tail EmptyInteger = errorEmptyList "tail" - tail (ConsInteger _ x) = x - -instance AdaptList Int8 where - data List Int8 = EmptyInt8 | ConsInt8 {-# UNPACK #-}!Int8 (List Int8) - empty = EmptyInt8 - cons = ConsInt8 - null EmptyInt8 = True - null _ = False - head EmptyInt8 = errorEmptyList "head" - head (ConsInt8 x _) = x - tail EmptyInt8 = errorEmptyList "tail" - tail (ConsInt8 _ x) = x - -instance AdaptList Int16 where - data List Int16 = EmptyInt16 | ConsInt16 {-# UNPACK #-}!Int16 (List Int16) - empty = EmptyInt16 - cons = ConsInt16 - null EmptyInt16 = True - null _ = False - head EmptyInt16 = errorEmptyList "head" - head (ConsInt16 x _) = x - tail EmptyInt16 = errorEmptyList "tail" - tail (ConsInt16 _ x) = x - -instance AdaptList Int32 where - data List Int32 = EmptyInt32 | ConsInt32 {-# UNPACK #-}!Int32 (List Int32) - empty = EmptyInt32 - cons = ConsInt32 - null EmptyInt32 = True - null _ = False - head EmptyInt32 = errorEmptyList "head" - head (ConsInt32 x _) = x - tail EmptyInt32 = errorEmptyList "tail" - tail (ConsInt32 _ x) = x - -instance AdaptList Int64 where - data List Int64 = EmptyInt64 | ConsInt64 {-# UNPACK #-}!Int64 (List Int64) - empty = EmptyInt64 - cons = ConsInt64 - null EmptyInt64 = True - null _ = False - head EmptyInt64 = errorEmptyList "head" - head (ConsInt64 x _) = x - tail EmptyInt64 = errorEmptyList "tail" - tail (ConsInt64 _ x) = x - -instance AdaptList Word where - data List Word = EmptyWord | ConsWord {-# UNPACK #-}!Word (List Word) - empty = EmptyWord - cons = ConsWord - null EmptyWord = True - null _ = False - head EmptyWord = errorEmptyList "head" - head (ConsWord x _) = x - tail EmptyWord = errorEmptyList "tail" - tail (ConsWord _ x) = x - -instance AdaptList Word8 where - data List Word8 = EmptyWord8 | ConsWord8 {-# UNPACK #-}!Word8 (List Word8) - empty = EmptyWord8 - cons = ConsWord8 - null EmptyWord8 = True - null _ = False - head EmptyWord8 = errorEmptyList "head" - head (ConsWord8 x _) = x - tail EmptyWord8 = errorEmptyList "tail" - tail (ConsWord8 _ x) = x - -instance AdaptList Word16 where - data List Word16 = EmptyWord16 | ConsWord16 {-# UNPACK #-}!Word16 (List Word16) - empty = EmptyWord16 - cons = ConsWord16 - null EmptyWord16 = True - null _ = False - head EmptyWord16 = errorEmptyList "head" - head (ConsWord16 x _) = x - tail EmptyWord16 = errorEmptyList "tail" - tail (ConsWord16 _ x) = x - -instance AdaptList Word32 where - data List Word32 = EmptyWord32 | ConsWord32 {-# UNPACK #-}!Word32 (List Word32) - empty = EmptyWord32 - cons = ConsWord32 - null EmptyWord32 = True - null _ = False - head EmptyWord32 = errorEmptyList "head" - head (ConsWord32 x _) = x - tail EmptyWord32 = errorEmptyList "tail" - tail (ConsWord32 _ x) = x - -instance AdaptList Word64 where - data List Word64 = EmptyWord64 | ConsWord64 {-# UNPACK #-}!Word64 (List Word64) - empty = EmptyWord64 - cons = ConsWord64 - null EmptyWord64 = True - null _ = False - head EmptyWord64 = errorEmptyList "head" - head (ConsWord64 x _) = x - tail EmptyWord64 = errorEmptyList "tail" - tail (ConsWord64 _ x) = x - -instance AdaptList Double where - data List Double = EmptyDouble | ConsDouble {-# UNPACK #-}!Double (List Double) - empty = EmptyDouble - cons = ConsDouble - null EmptyDouble = True - null _ = False - head EmptyDouble = errorEmptyList "head" - head (ConsDouble x _) = x - tail EmptyDouble = errorEmptyList "tail" - tail (ConsDouble _ x) = x - -instance AdaptList Float where - data List Float = EmptyFloat | ConsFloat {-# UNPACK #-}!Float (List Float) - empty = EmptyFloat - cons = ConsFloat - null EmptyFloat = True - null _ = False - head EmptyFloat = errorEmptyList "head" - head (ConsFloat x _) = x - tail EmptyFloat = errorEmptyList "tail" - tail (ConsFloat _ x) = x - -instance AdaptList Char where - data List Char = EmptyChar | ConsChar {-# UNPACK #-}!Char (List Char) - empty = EmptyChar - cons = ConsChar - null EmptyChar = True - null _ = False - head EmptyChar = errorEmptyList "head" - head (ConsChar x _) = x - tail EmptyChar = errorEmptyList "tail" - tail (ConsChar _ x) = x + +-- | +-- Module : Data.Adaptive.List +-- Copyright : (c) Duncan Coutts 2007 +-- (c) Don Stewart 2007 .. 2009 +-- License : BSD-style +-- Maintainer : dons@galois.com +-- Stability : experimental +-- +-- Self adapting polymorphic lists. +-- +-- This library statically specializes the polymorphic container +-- representation of lists to specific, more efficient representations, +-- when instantiated with particular monomorphic types. It does this via +-- an associated more efficient data type for each pair of elements you +-- wish to store in your container. +-- +-- The resulting list structures use less space, and functions on them tend to +-- be faster, than regular lists. +-- +-- Instead of representing '[1..5] :: [Int]' as: +-- +-- > (:) +-- > / \ +-- > / \ +-- > I# 1# (:) +-- > / \ +-- > / \ +-- > I# 2# (:) +-- > / \ +-- > / \ +-- > I# 3# [] +-- +-- The compiler will select an associated data type that packs better, +-- via the class instances, resulting in: +-- +-- > ConsInt 1# +-- > | +-- > ConsInt 2# +-- > | +-- > ConsInt 3# +-- > | +-- > [] +-- +-- The user however, still sees a polymorphic list type. +-- +-- This list type currently doesn't fuse. +-- +module Data.Adaptive.List where + +import Data.Adaptive.Tuple + +import qualified Prelude +import Prelude (Eq(..),Ord(..),Ordering(..), (.) + ,Int,Char,Float,Double,Integer,Bool(..),otherwise,(-)) +import Data.Int +import Data.Word +import Data.String + +-- * The adaptive list class-associated type +-- +-- | Representation-improving polymorphic lists. +-- +class AdaptList a where + + data List a + + -- | The empty list + empty :: List a + + -- | Prepend a value onto a list + cons :: a -> List a -> List a + + -- | Is the list empty? + null :: List a -> Bool + + -- | The first element of the list + head :: List a -> a + + -- | The tail of the list + tail :: List a -> List a + +------------------------------------------------------------------------ +-- * Basic Interface + +infixr 5 ++ +infixr 5 : +-- infix 5 \\ -- comment to fool cpp +-- infixl 9 !! +infix 4 `elem`, `notElem` + +-- | /O(n)/, convert an adaptive list to a regular list +toList :: AdaptList a => List a -> [a] +toList xs + | null xs = [] + | otherwise = head xs : toList (tail xs) + +-- | /O(n)/, convert an adaptive list to a regular list +fromList :: AdaptList a => [a] -> List a +fromList [] = empty +fromList (x:xs) = x `cons` fromList xs + +-- | /O(n)/, construct a list by enumerating a range +enumFromToList :: (AdaptList a, Ord a, Prelude.Enum a) => a -> a ->List a +enumFromToList x0 y + | x0 > y = empty + | otherwise = go x0 + where + go x = x `cons` if x == y then empty else go (Prelude.succ x) +{-# INLINE enumFromToList #-} + +-- | /O(1)/, uncons, take apart a list into the head and tail. +-- +uncons :: AdaptList a => List a -> Prelude.Maybe (a, List a) +uncons xs | null xs = Prelude.Nothing + | otherwise = Prelude.Just (head xs, tail xs) + +-- | /O(n)/, Append two lists, i.e., +-- +-- > [x1, ..., xm] ++ [y1, ..., yn] == [x1, ..., xm, y1, ..., yn] +-- > [x1, ..., xm] ++ [y1, ...] == [x1, ..., xm, y1, ...] +-- +-- If the first list is not finite, the result is the first list. +-- The spine of the first list argument must be copied. +-- +(++) :: AdaptList a => List a -> List a -> List a +(++) xs ys + | null xs = ys + | otherwise = head xs `cons` tail xs ++ ys + +-- | /O(n)/, Extract the last element of a list, which must be finite +-- and non-empty. +last :: AdaptList a => List a -> a +last xs + | null xs = errorEmptyList "last" + | otherwise = go (head xs) (tail xs) + where + go y z + | null z = y + | otherwise = go (head z) (tail z) +{-# INLINE last #-} + +-- | /O(n)/. Return all the elements of a list except the last one. +-- The list must be finite and non-empty. +init :: AdaptList a => List a -> List a +init xs + | null xs = errorEmptyList "init" + | otherwise = go (head xs) (tail xs) + where + go y z + | null z = empty + | otherwise = y `cons` go (head z) (tail z) +{-# INLINE init #-} + +-- | /O(n)/. 'length' returns the length of a finite list as an 'Int'. +-- It is an instance of the more general 'Data.List.genericLength', +-- the result type of which may be any kind of number. +length :: AdaptList a => List a -> Int +length xs0 = go xs0 0 + where + go :: AdaptList a => List a -> Int -> Int + go xs !a + | null xs = a + | otherwise = go (tail xs) (a Prelude.+ 1) +{-# INLINE length #-} + +-- --------------------------------------------------------------------- +-- * List transformations + +-- | /O(n)/. 'map' @f xs@ is the list obtained by applying @f@ to each element +-- of @xs@, i.e., +-- +-- > map f [x1, x2, ..., xn] == [f x1, f x2, ..., f xn] +-- > map f [x1, x2, ...] == [f x1, f x2, ...] +-- +-- Properties: +-- +-- > map f . map g = map (f . g) +-- > map f (repeat x) = repeat (f x) +-- > map f (replicate n x) = replicate n (f x) + +map :: (AdaptList a, AdaptList b) => (a -> b) -> List a -> List b +map f as = go as + where + go xs + | null xs = empty + | otherwise = f (head xs) `cons` go (tail xs) +{-# INLINE map #-} + +-- | /O(n)/. 'reverse' @xs@ returns the elements of @xs@ in reverse order. +-- @xs@ must be finite. Will fuse as a consumer only. +reverse :: AdaptList a => List a -> List a +reverse = foldl (Prelude.flip cons) empty +{-# INLINE reverse #-} + +-- | /O(n)/. The 'intersperse' function takes an element and a list and +-- \`intersperses\' that element between the elements of the list. +-- For example, +-- +-- > intersperse ',' "abcde" == "a,b,c,d,e" +-- +intersperse :: AdaptList a => a -> List a -> List a +intersperse sep zs + | null zs = empty + | otherwise = head zs `cons` go (tail zs) + where + go xs + | null xs = empty + | otherwise = sep `cons` (head xs `cons` go (tail xs)) +{-# INLINE intersperse #-} + +-- | /O(n)/. 'intercalate' @xs xss@ is equivalent to @('concat' ('intersperse' xs xss))@. +-- It inserts the list @xs@ in between the lists in @xss@ and concatenates the +-- result. +-- +-- > intercalate = concat . intersperse +-- +intercalate :: (AdaptList (List a), AdaptList a) + => List a -> List (List a) -> List a +intercalate sep xss = go (intersperse sep xss) + where + go ys + | null ys = empty + | otherwise = head ys ++ go (tail ys) +{-# INLINE intercalate #-} + +-- --------------------------------------------------------------------- +-- * Reducing lists (folds) + +-- | /O(n)/. 'foldl', applied to a binary operator, a starting value (typically +-- the left-identity of the operator), and a list, reduces the list +-- using the binary operator, from left to right: +-- +-- > foldl f z [x1, x2, ..., xn] == (...((z `f` x1) `f` x2) `f`...) `f` xn +-- +-- The list must be finite. The accumulator is whnf strict. +-- +foldl :: AdaptList b => (a -> b -> a) -> a -> List b -> a +foldl f z0 xs0 = go z0 xs0 + where + go !z xs + | null xs = z + | otherwise = go (f z (head xs)) (tail xs) +{-# INLINE foldl #-} + +-- | /O(n)/. 'foldl1' is a variant of 'foldl' that has no starting value argument, +-- and thus must be applied to non-empty lists. +foldl1 :: AdaptList a => (a -> a -> a) -> List a -> a +foldl1 f zs + | null zs = errorEmptyList "foldl1" + | otherwise = go (head zs) (tail zs) + where + go !z xs + | null xs = z + | otherwise = go (f z (head xs)) (tail xs) +{-# INLINE foldl1 #-} + +-- | /O(n)/. 'foldr', applied to a binary operator, a starting value (typically +-- the right-identity of the operator), and a list, reduces the list +-- using the binary operator, from right to left: +-- +-- > foldr f z [x1, x2, ..., xn] == x1 `f` (x2 `f` ... (xn `f` z)...) +-- +foldr :: AdaptList a => (a -> b -> b) -> b -> List a -> b +foldr k z xs = go xs + where + go ys + | null xs = z + | otherwise = head ys `k` go (tail ys) +{-# INLINE foldr #-} + +-- | /O(n)/. 'foldr1' is a variant of 'foldr' that has no starting value argument, +-- and thus must be applied to non-empty lists. +foldr1 :: AdaptList a => (a -> a -> a) -> List a -> a +foldr1 k xs + | null xs = errorEmptyList "foldr1" + | otherwise = go (head xs) (tail xs) + where + go z ys + | null ys = z + | otherwise = z `k` go (head ys) (tail ys) +{-# INLINE foldr1 #-} + +-- --------------------------------------------------------------------- +-- * Special folds + +-- | /O(n)/. Concatenate a list of lists. +-- concat :: [[a]] -> [a] +concat :: (AdaptList (List a), AdaptList a) + => List (List a) -> List a +concat xss0 = to xss0 + where + go xs xss + | null xs = to xss + | otherwise = head xs `cons` go (tail xs) xss + to xs + | null xs = empty + | otherwise = go (head xs) (tail xs) +{-# INLINE concat #-} + +-- | /O(n)/, /fusion/. Map a function over a list and concatenate the results. +concatMap :: (AdaptList a1, AdaptList a) + => (a -> List a1) -> List a -> List a1 +concatMap f = foldr (\x y -> f x ++ y) empty +{-# INLINE concatMap #-} + +-- | /O(n)/. 'and' returns the conjunction of a Boolean list. For the result to be +-- 'True', the list must be finite; 'False', however, results from a 'False' +-- value at a finite index of a finite or infinite list. +-- +and :: List Bool -> Bool +and xs + | null xs = True + | Prelude.not (head xs) = False + | otherwise = and (tail xs) +{-# INLINE and #-} + +-- | /O(n)/. 'or' returns the disjunction of a Boolean list. For the result to be +-- 'False', the list must be finite; 'True', however, results from a 'True' +-- value at a finite index of a finite or infinite list. +or :: List Bool -> Bool +or xs + | null xs = False + | head xs = True + | otherwise = or (tail xs) +{-# INLINE or #-} + +-- | /O(n)/. Applied to a predicate and a list, 'any' determines if any element +-- of the list satisfies the predicate. +any :: AdaptList a => (a -> Bool) -> List a -> Bool +any p xs0 = go xs0 + where + go xs + | null xs = False + | otherwise = case p (head xs) of + True -> True + _ -> go (tail xs) +{-# INLINE any #-} + +-- | Applied to a predicate and a list, 'all' determines if all elements +-- of the list satisfy the predicate. +all :: AdaptList a => (a -> Bool) -> List a -> Bool +all p xs0 = go xs0 + where + go xs + | null xs = True + | otherwise = case p (head xs) of + True -> go (tail xs) + _ -> False +{-# INLINE all #-} + +-- | /O(n)/, /fusion/. The 'sum' function computes the sum of a finite list of numbers. +sum :: (AdaptList a, Prelude.Num a) => List a -> a +sum l = go l 0 + where + go xs !a + | null xs = a + | otherwise = go (tail xs) (a Prelude.+ head xs) +{-# INLINE sum #-} + +-- | /O(n)/,/fusion/. The 'product' function computes the product of a finite list of numbers. +product :: (AdaptList a, Prelude.Num a) => List a -> a +product l = go l 1 + where + go xs !a + | null xs = a + | otherwise = go (tail xs) (a Prelude.* head xs) +{-# INLINE product #-} + +-- | /O(n)/. 'maximum' returns the maximum value from a list, +-- which must be non-empty, finite, and of an ordered type. +-- It is a special case of 'Data.List.maximumBy', which allows the +-- programmer to supply their own comparison function. +maximum :: (AdaptList a, Prelude.Ord a) => List a -> a +maximum xs + | null xs = errorEmptyList "maximum" + | otherwise = foldl1 Prelude.max xs +{-# INLINE maximum #-} + +-- | /O(n)/. 'minimum' returns the minimum value from a list, +-- which must be non-empty, finite, and of an ordered type. +-- It is a special case of 'Data.List.minimumBy', which allows the +-- programmer to supply their own comparison function. +minimum :: (AdaptList a, Prelude.Ord a) => List a -> a +minimum xs + | null xs = errorEmptyList "minimum" + | otherwise = foldl1 Prelude.min xs +{-# INLINE minimum #-} + +-- --------------------------------------------------------------------- +-- * Building lists +-- ** Scans + +-- | /O(n)/. 'scanl' is similar to 'foldl', but returns a list of successive +-- reduced values from the left: +-- +-- > scanl f z [x1, x2, ...] == [z, z `f` x1, (z `f` x1) `f` x2, ...] +-- +-- Properties: +-- +-- > last (scanl f z xs) == foldl f z x +-- +scanl :: (AdaptList b, AdaptList a) => (a -> b -> a) -> a -> List b -> List a +scanl f q ls = q `cons` if null ls + then empty + else scanl f (f q (head ls)) (tail ls) +{-# INLINE scanl #-} + +-- | /O(n)/. 'scanl1' is a variant of 'scanl' that has no starting value argument: +-- +-- > scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...] +-- +scanl1 :: AdaptList a => (a -> a -> a) -> List a -> List a +scanl1 f xs + | null xs = empty + | otherwise = scanl f (head xs) (tail xs) +{-# INLINE scanl1 #-} + +-- | /O(n)/. 'scanr' is the right-to-left dual of 'scanl'. +-- Properties: +-- +-- > head (scanr f z xs) == foldr f z xs +-- +scanr :: (AdaptList a, AdaptList b) => (a -> b -> b) -> b -> List a -> List b +scanr f q0 xs + | null xs = cons q0 empty + | otherwise = f (head xs) (head qs) `cons` qs + where qs = scanr f q0 (tail xs) +{-# INLINE scanr #-} + +-- | 'scanr1' is a variant of 'scanr' that has no starting value argument. +scanr1 :: AdaptList a => (a -> a -> a) -> List a -> List a +scanr1 f xs + | null xs = empty + | null (tail xs) = xs + | otherwise = f (head xs) (head qs) `cons` qs + where qs = scanr1 f (tail xs) + +------------------------------------------------------------------------ +-- ** Infinite lists + +-- | /O(n)/, 'iterate' @f x@ returns an infinite list of repeated applications +-- of @f@ to @x@: +-- +-- > iterate f x == [x, f x, f (f x), ...] +iterate :: AdaptList a => (a -> a) -> a -> List a +iterate f x = go x + where go z = z `cons` go (f z) +{-# INLINE iterate #-} + +-- | /O(n)/. 'repeat' @x@ is an infinite list, with @x@ the value of every element. +repeat :: AdaptList a => a -> List a +repeat x = xs where xs = x `cons` xs +{-# INLINE repeat #-} + +-- | /O(n)/. 'replicate' @n x@ is a list of length @n@ with @x@ the value of +-- every element. +-- It is an instance of the more general 'Data.List.genericReplicate', +-- in which @n@ may be of any integral type. +-- +replicate :: AdaptList a => Int -> a -> List a +replicate n0 _ | n0 <= 0 = empty +replicate n0 x = go n0 + where + go 0 = empty + go n = x `cons` go (n-1) +{-# INLINE replicate #-} + +-- | /fusion/. 'cycle' ties a finite list into a circular one, or equivalently, +-- the infinite repetition of the original list. It is the identity +-- on infinite lists. +-- +cycle :: AdaptList a => List a -> List a +cycle xs0 + | null xs0 = errorEmptyList "cycle" + | otherwise = go xs0 + where + go xs + | null xs = go xs0 + | otherwise = head xs `cons` go (tail xs) +{-# INLINE cycle #-} + +-- --------------------------------------------------------------------- +-- ** Unfolding + +-- | The 'unfoldr' function is a \`dual\' to 'foldr': while 'foldr' +-- reduces a list to a summary value, 'unfoldr' builds a list from +-- a seed value. The function takes the element and returns 'Nothing' +-- if it is done producing the list or returns 'Just' @(a,b)@, in which +-- case, @a@ is a prepended to the list and @b@ is used as the next +-- element in a recursive call. For example, +-- +-- > iterate f == unfoldr (\x -> Just (x, f x)) +-- +-- In some cases, 'unfoldr' can undo a 'foldr' operation: +-- +-- > unfoldr f' (foldr f z xs) == xs +-- +-- if the following holds: +-- +-- > f' (f x y) = Just (x,y) +-- > f' z = Nothing +-- +-- A simple use of unfoldr: +-- +-- > unfoldr (\b -> if b == 0 then Nothing else Just (b, b-1)) 10 +-- > [10,9,8,7,6,5,4,3,2,1] +-- +-- /TODO/: AdaptPair state. +-- +unfoldr :: AdaptList a => (b -> Prelude.Maybe (a, b)) -> b -> List a +unfoldr f b0 = unfold b0 + where + unfold b = case f b of + Prelude.Just (a,b') -> a `cons` unfold b' + Prelude.Nothing -> empty +{-# INLINE unfoldr #-} + +------------------------------------------------------------------------ +-- * Sublists +-- ** Extracting sublists + +-- | /O(n)/. 'take' @n@, applied to a list @xs@, returns the prefix of @xs@ +-- of length @n@, or @xs@ itself if @n > 'length' xs@: +-- +-- > take 5 "Hello World!" == "Hello" +-- > take 3 [1,2,3,4,5] == [1,2,3] +-- > take 3 [1,2] == [1,2] +-- > take 3 [] == [] +-- > take (-1) [1,2] == [] +-- > take 0 [1,2] == [] +-- +-- It is an instance of the more general 'Data.List.genericTake', +-- in which @n@ may be of any integral type. +-- +take :: AdaptList a => Int -> List a -> List a +take i _ | i <= 0 = empty +take i ls = go i ls + where + go :: AdaptList a => Int -> List a -> List a + go 0 _ = empty + go n xs + | null xs = empty + | otherwise = (head xs) `cons` go (n-1) (tail xs) +{-# INLINE take #-} + +-- | /O(n)/. 'drop' @n xs@ returns the suffix of @xs@ +-- after the first @n@ elements, or @[]@ if @n > 'length' xs@: +-- +-- > drop 6 "Hello World!" == "World!" +-- > drop 3 [1,2,3,4,5] == [4,5] +-- > drop 3 [1,2] == [] +-- > drop 3 [] == [] +-- > drop (-1) [1,2] == [1,2] +-- > drop 0 [1,2] == [1,2] +-- +-- It is an instance of the more general 'Data.List.genericDrop', +-- in which @n@ may be of any integral type. +-- +drop :: AdaptList a => Int -> List a -> List a +drop n ls + | n Prelude.< 0 = ls + | otherwise = go n ls + where + go :: AdaptList a => Int -> List a -> List a + go 0 xs = xs + go m xs + | null xs = empty + | otherwise = go (m-1) (tail xs) +{-# INLINE drop #-} + +-- | 'splitAt' @n xs@ returns a tuple where first element is @xs@ prefix of +-- length @n@ and second element is the remainder of the list: +-- +-- > splitAt 6 "Hello World!" == ("Hello ","World!") +-- > splitAt 3 [1,2,3,4,5] == ([1,2,3],[4,5]) +-- > splitAt 1 [1,2,3] == ([1],[2,3]) +-- > splitAt 3 [1,2,3] == ([1,2,3],[]) +-- > splitAt 4 [1,2,3] == ([1,2,3],[]) +-- > splitAt 0 [1,2,3] == ([],[1,2,3]) +-- > splitAt (-1) [1,2,3] == ([],[1,2,3]) +-- +-- It is equivalent to @('take' n xs, 'drop' n xs)@. +-- 'splitAt' is an instance of the more general 'Data.List.genericSplitAt', +-- in which @n@ may be of any integral type. +-- +splitAt :: AdaptList a => Int -> List a -> (List a, List a) +splitAt n ls + | n Prelude.< 0 = (empty, ls) + | otherwise = go n ls + where + go :: AdaptList a => Int -> List a -> (List a, List a) + go 0 xs = (empty, xs) + go m xs + | null xs = (empty, empty) + | otherwise = (head xs `cons` xs', xs'') + where + (xs', xs'') = go (m-1) (tail xs) +{-# INLINE splitAt #-} + +-- --------------------------------------------------------------------- +-- * Searching lists +-- ** Searching by equality + +-- | /O(n)/. 'elem' is the list membership predicate, usually written +-- in infix form, e.g., @x `elem` xs@. +-- +elem :: (AdaptList a, Prelude.Eq a) => a -> List a -> Bool +elem x ys + | null ys = False + | x Prelude.== head ys = True + | otherwise = elem x (tail ys) +{-# INLINE elem #-} + +-- | /O(n)/. 'notElem' is the negation of 'elem'. +notElem :: (AdaptList a, Prelude.Eq a) => a -> List a -> Bool +notElem x xs = Prelude.not (elem x xs) +{-# INLINE notElem #-} + +-- | /O(n)/. 'filter', applied to a predicate and a list, returns the list of +-- those elements that satisfy the predicate; i.e., +-- +-- > filter p xs = [ x | x <- xs, p x] +-- +-- Properties: +-- +-- > filter p (filter q s) = filter (\x -> q x && p x) s +-- +filter :: AdaptList a => (a -> Bool) -> List a -> List a +filter p xs0 + | null xs0 = empty + | otherwise = go xs0 + where + go xs + | null xs = empty + | p x = x `cons` go ys + | otherwise = go ys + where x = head xs + ys = tail xs +{-# INLINE filter #-} + +------------------------------------------------------------------------ +-- * Zipping and unzipping lists + +-- | /O(n)/,/fusion/. 'zip' takes two lists and returns a list of +-- corresponding pairs. If one input list is short, excess elements of +-- the longer list are discarded. +-- +-- Properties: +-- +-- > zip a b = zipWith (,) a b +-- +zip :: (AdaptPair a b, AdaptList a , AdaptList b, AdaptList (Pair a b)) + => List a -> List b -> List (Pair a b) +zip as bs + | null as = empty + | null bs = empty + | otherwise = pair (head as) (head bs) `cons` zip (tail as) (tail bs) +{-# INLINE zip #-} + +------------------------------------------------------------------------ + +{- + + +-- ----------------------------------------------------------------------------- + +{- +-- --------------------------------------------------------------------- +-- ** Accumulating maps + +-- | The 'mapAccumL' function behaves like a combination of 'map' and +-- 'foldl'; it applies a function to each element of a list, passing +-- an accumulating parameter from left to right, and returning a final +-- value of this accumulator together with the new list. +-- +mapAccumL :: (acc -> x -> (acc, y)) -> acc -> [x] -> (acc, [y]) +mapAccumL _ s [] = (s, []) +mapAccumL f s (x:xs) = (s'',y:ys) + where (s', y ) = f s x + (s'',ys) = mapAccumL f s' xs + +-- TODO fuse + +-- | The 'mapAccumR' function behaves like a combination of 'map' and +-- 'foldr'; it applies a function to each element of a list, passing +-- an accumulating parameter from right to left, and returning a final +-- value of this accumulator together with the new list. +-- +mapAccumR :: (acc -> x -> (acc, y)) -> acc -> [x] -> (acc, [y]) +mapAccumR _ s [] = (s, []) +mapAccumR f s (x:xs) = (s'', y:ys) + where (s'',y ) = f s' x + (s', ys) = mapAccumR f s xs + +-- TODO fuse +-} + +-- | /O(n)/,/fusion/. 'takeWhile', applied to a predicate @p@ and a list @xs@, returns the +-- longest prefix (possibly empty) of @xs@ of elements that satisfy @p@: +-- +-- > takeWhile (< 3) [1,2,3,4,1,2,3,4] == [1,2] +-- > takeWhile (< 9) [1,2,3] == [1,2,3] +-- > takeWhile (< 0) [1,2,3] == [] +-- +takeWhile :: (a -> Bool) -> [a] -> [a] +takeWhile _ [] = [] +takeWhile p xs0 = go xs0 + where + go [] = [] + go (x:xs) + | p x = x : go xs + | otherwise = [] +{-# NOINLINE [1] takeWhile #-} + +{-# RULES +"takeWhile -> fusible" [~1] forall f xs. + takeWhile f xs = unstream (Stream.takeWhile f (stream xs)) +--"takeWhile -> unfused" [1] forall f xs. +-- unstream (Stream.takeWhile f (stream xs)) = takeWhile f xs + #-} + +-- | /O(n)/,/fusion/. 'dropWhile' @p xs@ returns the suffix remaining after 'takeWhile' @p xs@: +-- +-- > dropWhile (< 3) [1,2,3,4,5,1,2,3] == [3,4,5,1,2,3] +-- > dropWhile (< 9) [1,2,3] == [] +-- > dropWhile (< 0) [1,2,3] == [1,2,3] +-- +dropWhile :: (a -> Bool) -> [a] -> [a] +dropWhile _ [] = [] +dropWhile p xs0 = go xs0 + where + go [] = [] + go xs@(x:xs') + | p x = go xs' + | otherwise = xs +{-# NOINLINE [1] dropWhile #-} + +{-# RULES +"dropWhile -> fusible" [~1] forall f xs. + dropWhile f xs = unstream (Stream.dropWhile f (stream xs)) +--"dropWhile -> unfused" [1] forall f xs. +-- unstream (Stream.dropWhile f (stream xs)) = dropWhile f xs + #-} + +-- | 'span', applied to a predicate @p@ and a list @xs@, returns a tuple where +-- first element is longest prefix (possibly empty) of @xs@ of elements that +-- satisfy @p@ and second element is the remainder of the list: +-- +-- > span (< 3) [1,2,3,4,1,2,3,4] == ([1,2],[3,4,1,2,3,4]) +-- > span (< 9) [1,2,3] == ([1,2,3],[]) +-- > span (< 0) [1,2,3] == ([],[1,2,3]) +-- +-- 'span' @p xs@ is equivalent to @('takeWhile' p xs, 'dropWhile' p xs)@ +span :: (a -> Bool) -> [a] -> ([a], [a]) +span _ [] = ([], []) +span p xs0 = go xs0 + where + go [] = ([], []) + go xs@(x:xs') + | p x = let (ys,zs) = go xs' + in (x:ys,zs) + | otherwise = ([],xs) + +-- TODO fuse +-- Hmm, these do a lot of sharing, but is it worth it? + +-- | 'break', applied to a predicate @p@ and a list @xs@, returns a tuple where +-- first element is longest prefix (possibly empty) of @xs@ of elements that +-- /do not satisfy/ @p@ and second element is the remainder of the list: +-- +-- > break (> 3) [1,2,3,4,1,2,3,4] == ([1,2,3],[4,1,2,3,4]) +-- > break (< 9) [1,2,3] == ([],[1,2,3]) +-- > break (> 9) [1,2,3] == ([1,2,3],[]) +-- +-- 'break' @p@ is equivalent to @'span' ('not' . p)@. +-- +break :: (a -> Bool) -> [a] -> ([a], [a]) +break _ [] = ([], []) +break p xs0 = go xs0 + where + go [] = ([], []) + go xs@(x:xs') + | p x = ([],xs) + | otherwise = let (ys,zs) = go xs' + in (x:ys,zs) + +-- TODO fuse + +-- | The 'group' function takes a list and returns a list of lists such +-- that the concatenation of the result is equal to the argument. Moreover, +-- each sublist in the result contains only equal elements. For example, +-- +-- > group "Mississippi" = ["M","i","ss","i","ss","i","pp","i"] +-- +-- It is a special case of 'groupBy', which allows the programmer to supply +-- their own equality test. +group :: Eq a => [a] -> [[a]] +group [] = [] +group (x:xs) = (x:ys) : group zs + where (ys,zs) = span (x ==) xs + +-- TODO fuse + +-- | The 'inits' function returns all initial segments of the argument, +-- shortest first. For example, +-- +-- > inits "abc" == ["","a","ab","abc"] +-- +inits :: [a] -> [[a]] +inits [] = [] : [] +inits (x:xs) = [] : map (x:) (inits xs) + +-- TODO fuse + +-- | The 'tails' function returns all final segments of the argument, +-- longest first. For example, +-- +-- > tails "abc" == ["abc", "bc", "c",""] +-- +tails :: [a] -> [[a]] +tails [] = [] : [] +tails xxs@(_:xs) = xxs : tails xs + +-- TODO fuse + +------------------------------------------------------------------------ +-- * Predicates + +-- | /O(n)/,/fusion/. The 'isPrefixOf' function takes two lists and +-- returns 'True' iff the first list is a prefix of the second. +-- +isPrefixOf :: Eq a => [a] -> [a] -> Bool +isPrefixOf [] _ = True +isPrefixOf _ [] = False +isPrefixOf (x:xs) (y:ys) | x == y = isPrefixOf xs ys + | otherwise = False +{-# NOINLINE [1] isPrefixOf #-} + +{-# RULES +"isPrefixOf -> fusible" [~1] forall xs ys. + isPrefixOf xs ys = Stream.isPrefixOf (stream xs) (stream ys) +--"isPrefixOf -> unfused" [1] forall xs ys. +-- Stream.isPrefixOf (stream xs) (stream ys) = isPrefixOf xs ys + #-} + +-- | The 'isSuffixOf' function takes two lists and returns 'True' +-- iff the first list is a suffix of the second. +-- Both lists must be finite. +isSuffixOf :: Eq a => [a] -> [a] -> Bool +isSuffixOf x y = reverse x `isPrefixOf` reverse y + +-- TODO fuse + +-- | The 'isInfixOf' function takes two lists and returns 'True' +-- iff the first list is contained, wholly and intact, +-- anywhere within the second. +-- +-- Example: +-- +-- > isInfixOf "Haskell" "I really like Haskell." -> True +-- > isInfixOf "Ial" "I really like Haskell." -> False +-- +isInfixOf :: Eq a => [a] -> [a] -> Bool +isInfixOf needle haystack = any (isPrefixOf needle) (tails haystack) + +-- TODO fuse + +-- --------------------------------------------------------------------- + +-- | /O(n)/,/fusion/. 'lookup' @key assocs@ looks up a key in an association list. +lookup :: Eq a => a -> [(a, b)] -> Maybe b +lookup _ [] = Nothing +lookup key xys0 = go xys0 + where + go [] = Nothing + go ((x,y):xys) + | key == x = Just y + | otherwise = lookup key xys +{-# NOINLINE [1] lookup #-} + +------------------------------------------------------------------------ +-- ** Searching with a predicate + +-- | /O(n)/,/fusion/. The 'find' function takes a predicate and a list and returns the +-- first element in the list matching the predicate, or 'Nothing' if +-- there is no such element. +find :: (a -> Bool) -> [a] -> Maybe a +find _ [] = Nothing +find p xs0 = go xs0 + where + go [] = Nothing + go (x:xs) | p x = Just x + | otherwise = go xs +{-# NOINLINE [1] find #-} + +{-# RULES +"find -> fusible" [~1] forall f xs. + find f xs = Stream.find f (stream xs) +--"find -> unfused" [1] forall f xs. +-- Stream.find f (stream xs) = find f xs + #-} + +-- | The 'partition' function takes a predicate a list and returns +-- the pair of lists of elements which do and do not satisfy the +-- predicate, respectively; i.e., +-- +-- > partition p xs == (filter p xs, filter (not . p) xs) +partition :: (a -> Bool) -> [a] -> ([a], [a]) +partition p xs = foldr (select p) ([],[]) xs +{-# INLINE partition #-} + +-- TODO fuse + +select :: (a -> Bool) -> a -> ([a], [a]) -> ([a], [a]) +select p x ~(ts,fs) | p x = (x:ts,fs) + | otherwise = (ts, x:fs) + +------------------------------------------------------------------------ +-- * Indexing lists + +-- | /O(n)/,/fusion/. List index (subscript) operator, starting from 0. +-- It is an instance of the more general 'Data.List.genericIndex', +-- which takes an index of any integral type. +(!!) :: [a] -> Int -> a +xs0 !! n0 + | n0 < 0 = error "Prelude.(!!): negative index" + | otherwise = index xs0 n0 +#ifndef __HADDOCK__ + where + index [] _ = error "Prelude.(!!): index too large" + index (y:ys) n = if n == 0 then y else index ys (n-1) +#endif +{-# NOINLINE [1] (!!) #-} + +{-# RULES +"!! -> fusible" [~1] forall xs n. + xs !! n = Stream.index (stream xs) n +-- "!! -> unfused" [1] forall xs n. +-- Stream.index (stream xs) n = xs !! n + #-} + +-- | The 'elemIndex' function returns the index of the first element +-- in the given list which is equal (by '==') to the query element, +-- or 'Nothing' if there is no such element. +-- +-- Properties: +-- +-- > elemIndex x xs = listToMaybe [ n | (n,a) <- zip [0..] xs, a == x ] +-- > elemIndex x xs = findIndex (x==) xs +-- +elemIndex :: Eq a => a -> [a] -> Maybe Int +elemIndex x = findIndex (x==) +{-# INLINE elemIndex #-} +{- +elemIndex :: Eq a => a -> [a] -> Maybe Int +elemIndex y xs0 = loop_elemIndex xs0 0 +#ifndef __HADDOCK__ + where + loop_elemIndex [] !_ = Nothing + loop_elemIndex (x:xs) !n + | p x = Just n + | otherwise = loop_elemIndex xs (n + 1) + p = (y ==) +#endif +{-# NOINLINE [1] elemIndex #-} +-} +{- RULES +"elemIndex -> fusible" [~1] forall x xs. + elemIndex x xs = Stream.elemIndex x (stream xs) +"elemIndex -> unfused" [1] forall x xs. + Stream.elemIndex x (stream xs) = elemIndex x xs + -} + +-- | /O(n)/,/fusion/. The 'elemIndices' function extends 'elemIndex', by +-- returning the indices of all elements equal to the query element, in +-- ascending order. +-- +-- Properties: +-- +-- > length (filter (==a) xs) = length (elemIndices a xs) +-- +elemIndices :: Eq a => a -> [a] -> [Int] +elemIndices x = findIndices (x==) +{-# INLINE elemIndices #-} + +{- +elemIndices :: Eq a => a -> [a] -> [Int] +elemIndices y xs0 = loop_elemIndices xs0 0 +#ifndef __HADDOCK__ + where + loop_elemIndices [] !_ = [] + loop_elemIndices (x:xs) !n + | p x = n : loop_elemIndices xs (n + 1) + | otherwise = loop_elemIndices xs (n + 1) + p = (y ==) +#endif +{-# NOINLINE [1] elemIndices #-} +-} +{- RULES +"elemIndices -> fusible" [~1] forall x xs. + elemIndices x xs = unstream (Stream.elemIndices x (stream xs)) +"elemIndices -> unfused" [1] forall x xs. + unstream (Stream.elemIndices x (stream xs)) = elemIndices x xs + -} + +-- | The 'findIndex' function takes a predicate and a list and returns +-- the index of the first element in the list satisfying the predicate, +-- or 'Nothing' if there is no such element. +-- +-- Properties: +-- +-- > findIndex p xs = listToMaybe [ n | (n,x) <- zip [0..] xs, p x ] +-- +findIndex :: (a -> Bool) -> [a] -> Maybe Int +findIndex p ls = loop_findIndex ls 0# + where + loop_findIndex [] _ = Nothing + loop_findIndex (x:xs) n + | p x = Just (I# n) + | otherwise = loop_findIndex xs (n +# 1#) +{-# NOINLINE [1] findIndex #-} + +{-# RULES +"findIndex -> fusible" [~1] forall f xs. + findIndex f xs = Stream.findIndex f (stream xs) +-- "findIndex -> unfused" [1] forall f xs. +-- Stream.findIndex f (stream xs) = findIndex f xs + #-} + +-- | /O(n)/,/fusion/. The 'findIndices' function extends 'findIndex', by +-- returning the indices of all elements satisfying the predicate, in +-- ascending order. +-- +-- Properties: +-- +-- > length (filter p xs) = length (findIndices p xs) +-- +findIndices :: (a -> Bool) -> [a] -> [Int] +findIndices p ls = loop_findIndices ls 0# + where + loop_findIndices [] _ = [] + loop_findIndices (x:xs) n + | p x = I# n : loop_findIndices xs (n +# 1#) + | otherwise = loop_findIndices xs (n +# 1#) +{-# NOINLINE [1] findIndices #-} + +-- | /O(n)/,/fusion/. 'zip3' takes three lists and returns a list of +-- triples, analogous to 'zip'. +-- +-- Properties: +-- +-- > zip3 a b c = zipWith (,,) a b c +-- +zip3 :: [a] -> [b] -> [c] -> [(a, b, c)] +zip3 (a:as) (b:bs) (c:cs) = (a,b,c) : zip3 as bs cs +zip3 _ _ _ = [] +{-# NOINLINE [1] zip3 #-} + +{-# RULES +"zip3 -> fusible" [~1] forall xs ys zs. + zip3 xs ys zs = unstream (Stream.zipWith3 (,,) (stream xs) (stream ys) (stream zs)) +-- "zip3 -> unfused" [1] forall xs ys zs. +-- unstream (Stream.zipWith3 (,,) (stream xs) (stream ys) (stream zs)) = zip3 xs ys zs + #-} + +-- | /O(n)/,/fusion/. The 'zip4' function takes four lists and returns a list of +-- quadruples, analogous to 'zip'. +zip4 :: [a] -> [b] -> [c] -> [d] -> [(a, b, c, d)] +zip4 = zipWith4 (,,,) +{-# INLINE zip4 #-} + +-- | The 'zip5' function takes five lists and returns a list of +-- five-tuples, analogous to 'zip'. +zip5 :: [a] -> [b] -> [c] -> [d] -> [e] -> [(a, b, c, d, e)] +zip5 = zipWith5 (,,,,) + +-- | The 'zip6' function takes six lists and returns a list of six-tuples, +-- analogous to 'zip'. +zip6 :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [(a, b, c, d, e, f)] +zip6 = zipWith6 (,,,,,) + +-- | The 'zip7' function takes seven lists and returns a list of +-- seven-tuples, analogous to 'zip'. +zip7 :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g] -> [(a, b, c, d, e, f, g)] +zip7 = zipWith7 (,,,,,,) + +-- | /O(n)/,/fusion/. 'zipWith' generalises 'zip' by zipping with the +-- function given as the first argument, instead of a tupling function. +-- For example, @'zipWith' (+)@ is applied to two lists to produce the +-- list of corresponding sums. +-- Properties: +-- +-- > zipWith (,) = zip +-- +zipWith :: (a -> b -> c) -> [a] -> [b] -> [c] +zipWith f (a:as) (b:bs) = f a b : zipWith f as bs +zipWith _ _ _ = [] +{-# INLINE [1] zipWith #-} + +--FIXME: If we change the above INLINE to NOINLINE then ghc goes into +-- a loop, why? Do we have some dodgy recursive rules somewhere? + +{-# RULES +"zipWith -> fusible" [~1] forall f xs ys. + zipWith f xs ys = unstream (Stream.zipWith f (stream xs) (stream ys)) +-- "zipWith -> unfused" [1] forall f xs ys. +-- unstream (Stream.zipWith f (stream xs) (stream ys)) = zipWith f xs ys + #-} + +-- | /O(n)/,/fusion/. The 'zipWith3' function takes a function which +-- combines three elements, as well as three lists and returns a list of +-- their point-wise combination, analogous to 'zipWith'. +-- +-- Properties: +-- +-- > zipWith3 (,,) = zip3 +-- +zipWith3 :: (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d] +zipWith3 z (a:as) (b:bs) (c:cs) = z a b c : zipWith3 z as bs cs +zipWith3 _ _ _ _ = [] +{-# NOINLINE [1] zipWith3 #-} + +{-# RULES +"zipWith3 -> fusible" [~1] forall f xs ys zs. + zipWith3 f xs ys zs = unstream (Stream.zipWith3 f (stream xs) (stream ys) (stream zs)) +-- "zipWith3 -> unfused" [1] forall f xs ys zs. +-- unstream (Stream.zipWith3 f (stream xs) (stream ys) (stream zs)) = zipWith3 f xs ys zs + #-} + +-- | /O(n)/,/fusion/. The 'zipWith4' function takes a function which combines four +-- elements, as well as four lists and returns a list of their point-wise +-- combination, analogous to 'zipWith'. +zipWith4 :: (a -> b -> c -> d -> e) -> [a] -> [b] -> [c] -> [d] -> [e] +zipWith4 z (a:as) (b:bs) (c:cs) (d:ds) + = z a b c d : zipWith4 z as bs cs ds +zipWith4 _ _ _ _ _ = [] +{-# NOINLINE [1] zipWith4 #-} + +{-# RULES +"zipWith4 -> fusible" [~1] forall f ws xs ys zs. + zipWith4 f ws xs ys zs = unstream (Stream.zipWith4 f (stream ws) (stream xs) (stream ys) (stream zs)) +-- "zipWith4 -> unfused" [1] forall f ws xs ys zs. +-- unstream (Stream.zipWith4 f (stream ws) (stream xs) (stream ys) (stream zs)) = zipWith4 f ws xs ys zs + #-} + +-- | The 'zipWith5' function takes a function which combines five +-- elements, as well as five lists and returns a list of their point-wise +-- combination, analogous to 'zipWith'. +zipWith5 :: (a -> b -> c -> d -> e -> f) + -> [a] -> [b] -> [c] -> [d] -> [e] -> [f] +zipWith5 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) + = z a b c d e : zipWith5 z as bs cs ds es +zipWith5 _ _ _ _ _ _ = [] + +-- TODO fuse + +-- | The 'zipWith6' function takes a function which combines six +-- elements, as well as six lists and returns a list of their point-wise +-- combination, analogous to 'zipWith'. +zipWith6 :: (a -> b -> c -> d -> e -> f -> g) + -> [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g] +zipWith6 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) + = z a b c d e f : zipWith6 z as bs cs ds es fs +zipWith6 _ _ _ _ _ _ _ = [] + +-- TODO fuse + +-- | The 'zipWith7' function takes a function which combines seven +-- elements, as well as seven lists and returns a list of their point-wise +-- combination, analogous to 'zipWith'. +zipWith7 :: (a -> b -> c -> d -> e -> f -> g -> h) + -> [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g] -> [h] +zipWith7 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) (g:gs) + = z a b c d e f g : zipWith7 z as bs cs ds es fs gs +zipWith7 _ _ _ _ _ _ _ _ = [] + +-- TODO fuse + +------------------------------------------------------------------------ +-- unzips + +-- | 'unzip' transforms a list of pairs into a list of first components +-- and a list of second components. +unzip :: [(a, b)] -> ([a], [b]) +unzip = foldr (\(a,b) ~(as,bs) -> (a:as,b:bs)) ([],[]) + +-- TODO fuse + +-- | The 'unzip3' function takes a list of triples and returns three +-- lists, analogous to 'unzip'. +unzip3 :: [(a, b, c)] -> ([a], [b], [c]) +unzip3 = foldr (\(a,b,c) ~(as,bs,cs) -> (a:as,b:bs,c:cs)) ([],[],[]) + +-- TODO fuse + +-- | The 'unzip4' function takes a list of quadruples and returns four +-- lists, analogous to 'unzip'. +unzip4 :: [(a, b, c, d)] -> ([a], [b], [c], [d]) +unzip4 = foldr (\(a,b,c,d) ~(as,bs,cs,ds) -> + (a:as,b:bs,c:cs,d:ds)) + ([],[],[],[]) + +-- TODO fuse + +-- | The 'unzip5' function takes a list of five-tuples and returns five +-- lists, analogous to 'unzip'. +unzip5 :: [(a, b, c, d, e)] -> ([a], [b], [c], [d], [e]) +unzip5 = foldr (\(a,b,c,d,e) ~(as,bs,cs,ds,es) -> + (a:as,b:bs,c:cs,d:ds,e:es)) + ([],[],[],[],[]) + +-- TODO fuse + +-- | The 'unzip6' function takes a list of six-tuples and returns six +-- lists, analogous to 'unzip'. +unzip6 :: [(a, b, c, d, e, f)] -> ([a], [b], [c], [d], [e], [f]) +unzip6 = foldr (\(a,b,c,d,e,f) ~(as,bs,cs,ds,es,fs) -> + (a:as,b:bs,c:cs,d:ds,e:es,f:fs)) + ([],[],[],[],[],[]) + +-- TODO fuse + +-- | The 'unzip7' function takes a list of seven-tuples and returns +-- seven lists, analogous to 'unzip'. +unzip7 :: [(a, b, c, d, e, f, g)] -> ([a], [b], [c], [d], [e], [f], [g]) +unzip7 = foldr (\(a,b,c,d,e,f,g) ~(as,bs,cs,ds,es,fs,gs) -> + (a:as,b:bs,c:cs,d:ds,e:es,f:fs,g:gs)) + ([],[],[],[],[],[],[]) + +-- TODO fuse + +------------------------------------------------------------------------ +-- * Special lists +-- ** Functions on strings + +-- | /O(O)/,/fusion/. 'lines' breaks a string up into a list of strings +-- at newline characters. The resulting strings do not contain +-- newlines. +lines :: String -> [String] +lines [] = [] +lines s = let (l, s') = break (== '\n') s + in l : case s' of + [] -> [] + (_:s'') -> lines s'' +--TODO: can we do better than this and preserve the same strictness? + +{- +-- This implementation is fast but too strict :-( +-- it doesn't yield each line until it has seen the ending '\n' + +lines :: String -> [String] +lines [] = [] +lines cs0 = go [] cs0 + where + go l [] = reverse l : [] + go l ('\n':cs) = reverse l : case cs of + [] -> [] + _ -> go [] cs + go l ( c :cs) = go (c:l) cs +-} +{-# INLINE [1] lines #-} + +{- RULES +"lines -> fusible" [~1] forall xs. + lines xs = unstream (Stream.lines (stream xs)) +"lines -> unfused" [1] forall xs. + unstream (Stream.lines (stream xs)) = lines xs + -} + +-- | 'words' breaks a string up into a list of words, which were delimited +-- by white space. +words :: String -> [String] +words s = case dropWhile isSpace s of + "" -> [] + s' -> w : words s'' + where (w, s'') = break isSpace s' +-- TODO fuse +--TODO: can we do better than this and preserve the same strictness? + +{- +-- This implementation is fast but too strict :-( +-- it doesn't yield each word until it has seen the ending space + +words cs0 = dropSpaces cs0 + where + dropSpaces :: String -> [String] + dropSpaces [] = [] + dropSpaces (c:cs) + | isSpace c = dropSpaces cs + | otherwise = munchWord [c] cs + + munchWord :: String -> String -> [String] + munchWord w [] = reverse w : [] + munchWord w (c:cs) + | isSpace c = reverse w : dropSpaces cs + | otherwise = munchWord (c:w) cs +-} + +-- | /O(n)/,/fusion/. 'unlines' is an inverse operation to 'lines'. +-- It joins lines, after appending a terminating newline to each. +-- +-- > unlines xs = concatMap (++"\n") +-- +unlines :: [String] -> String +unlines css0 = to css0 + where go [] css = '\n' : to css + go (c:cs) css = c : go cs css + + to [] = [] + to (cs:css) = go cs css +{-# NOINLINE [1] unlines #-} + +-- +-- fuse via: +-- unlines xs = concatMap (snoc xs '\n') +-- +{- RULES +"unlines -> fusible" [~1] forall xs. + unlines xs = unstream (Stream.concatMap (\x -> Stream.snoc (stream x) '\n') (stream xs)) +"unlines -> unfused" [1] forall xs. + unstream (Stream.concatMap (\x -> Stream.snoc (stream x) '\n') (stream xs)) = unlines xs + -} + +-- | 'unwords' is an inverse operation to 'words'. +-- It joins words with separating spaces. +unwords :: [String] -> String +unwords [] = [] +unwords (cs0:css0) = go cs0 css0 + where go [] css = to css + go (c:cs) css = c : go cs css + + to [] = [] + to (cs:ccs) = ' ' : go cs ccs + +-- TODO fuse + +------------------------------------------------------------------------ +-- ** \"Set\" operations + +-- | The 'nub' function removes duplicate elements from a list. +-- In particular, it keeps only the first occurrence of each element. +-- (The name 'nub' means \`essence\'.) +-- It is a special case of 'nubBy', which allows the programmer to supply +-- their own equality test. +-- +nub :: Eq a => [a] -> [a] +nub l = nub' l [] + where + nub' [] _ = [] + nub' (x:xs) ls + | x `elem` ls = nub' xs ls + | otherwise = x : nub' xs (x:ls) + +{- RULES +-- ndm's optimisation +"sort/nub" forall xs. sort (nub xs) = map head (group (sort xs)) + -} + +-- TODO fuse + +-- | 'delete' @x@ removes the first occurrence of @x@ from its list argument. +-- For example, +-- +-- > delete 'a' "banana" == "bnana" +-- +-- It is a special case of 'deleteBy', which allows the programmer to +-- supply their own equality test. +-- +delete :: Eq a => a -> [a] -> [a] +delete = deleteBy (==) + +-- TODO fuse + +-- | The '\\' function is list difference ((non-associative). +-- In the result of @xs@ '\\' @ys@, the first occurrence of each element of +-- @ys@ in turn (if any) has been removed from @xs@. Thus +-- +-- > (xs ++ ys) \\ xs == ys. +-- +-- It is a special case of 'deleteFirstsBy', which allows the programmer +-- to supply their own equality test. +(\\) :: Eq a => [a] -> [a] -> [a] +(\\) = foldl (flip delete) + +-- | The 'union' function returns the list union of the two lists. +-- For example, +-- +-- > "dog" `union` "cow" == "dogcw" +-- +-- Duplicates, and elements of the first list, are removed from the +-- the second list, but if the first list contains duplicates, so will +-- the result. +-- It is a special case of 'unionBy', which allows the programmer to supply +-- their own equality test. +-- +union :: Eq a => [a] -> [a] -> [a] +union = unionBy (==) + +-- TODO fuse + +-- | The 'intersect' function takes the list intersection of two lists. +-- For example, +-- +-- > [1,2,3,4] `intersect` [2,4,6,8] == [2,4] +-- +-- If the first list contains duplicates, so will the result. +-- It is a special case of 'intersectBy', which allows the programmer to +-- supply their own equality test. +-- +intersect :: Eq a => [a] -> [a] -> [a] +intersect = intersectBy (==) + +-- TODO fuse + +------------------------------------------------------------------------ +-- ** Ordered lists + +-- TODO stuff in Ord can use Map/IntMap +-- TODO Hooray, an Ord constraint! we could use a better structure. + +-- | The 'sort' function implements a stable sorting algorithm. +-- It is a special case of 'sortBy', which allows the programmer to supply +-- their own comparison function. +-- +-- Properties: +-- +-- > not (null x) ==> (head . sort) x = minimum x +-- > not (null x) ==> (last . sort) x = maximum x +-- +sort :: Ord a => [a] -> [a] +sort l = mergesort compare l + +-- TODO fuse, we have an Ord constraint! + +-- | /O(n)/,/fusion/. The 'insert' function takes an element and a list and inserts the +-- element into the list at the last position where it is still less +-- than or equal to the next element. In particular, if the list +-- is sorted before the call, the result will also be sorted. +-- It is a special case of 'insertBy', which allows the programmer to +-- supply their own comparison function. +-- +insert :: Ord a => a -> [a] -> [a] +insert e ls = insertBy (compare) e ls +{-# INLINE insert #-} + +------------------------------------------------------------------------ +-- * Generalized functions +-- ** The \"By\" operations +-- *** User-supplied equality (replacing an Eq context) + +-- | The 'nubBy' function behaves just like 'nub', except it uses a +-- user-supplied equality predicate instead of the overloaded '==' +-- function. +nubBy :: (a -> a -> Bool) -> [a] -> [a] +nubBy eq l = nubBy' l [] + where + nubBy' [] _ = [] + nubBy' (y:ys) xs + | elem_by eq y xs = nubBy' ys xs + | otherwise = y : nubBy' ys (y:xs) + +-- TODO fuse + +-- Not exported: +-- Note that we keep the call to `eq` with arguments in the +-- same order as in the reference implementation +-- 'xs' is the list of things we've seen so far, +-- 'y' is the potential new element +-- +elem_by :: (a -> a -> Bool) -> a -> [a] -> Bool +elem_by _ _ [] = False +elem_by eq y (x:xs) = if x `eq` y then True else elem_by eq y xs + +-- | The 'deleteBy' function behaves like 'delete', but takes a +-- user-supplied equality predicate. +deleteBy :: (a -> a -> Bool) -> a -> [a] -> [a] +deleteBy _ _ [] = [] +deleteBy eq x (y:ys) = if x `eq` y then ys else y : deleteBy eq x ys + +-- TODO fuse + +deleteFirstsBy :: (a -> a -> Bool) -> [a] -> [a] -> [a] +deleteFirstsBy eq = foldl (flip (deleteBy eq)) + + +-- | The 'unionBy' function is the non-overloaded version of 'union'. +unionBy :: (a -> a -> Bool) -> [a] -> [a] -> [a] +unionBy eq xs ys = xs ++ foldl (flip (deleteBy eq)) (nubBy eq ys) xs + +-- TODO fuse + +-- | The 'intersectBy' function is the non-overloaded version of 'intersect'. +intersectBy :: (a -> a -> Bool) -> [a] -> [a] -> [a] +intersectBy eq xs ys = [x | x <- xs, any (eq x) ys] + +-- TODO fuse + +-- | The 'groupBy' function is the non-overloaded version of 'group'. +groupBy :: (a -> a -> Bool) -> [a] -> [[a]] +groupBy _ [] = [] +groupBy eq (x:xs) = (x:ys) : groupBy eq zs + where (ys,zs) = span (eq x) xs + +-- TODO fuse + +------------------------------------------------------------------------ +-- *** User-supplied comparison (replacing an Ord context) + +-- | The 'sortBy' function is the non-overloaded version of 'sort'. +sortBy :: (a -> a -> Ordering) -> [a] -> [a] +sortBy cmp l = mergesort cmp l + +-- TODO fuse + +mergesort :: (a -> a -> Ordering) -> [a] -> [a] +mergesort cmp xs = mergesort' cmp (map wrap xs) + +mergesort' :: (a -> a -> Ordering) -> [[a]] -> [a] +mergesort' _ [] = [] +mergesort' _ [xs] = xs +mergesort' cmp xss = mergesort' cmp (merge_pairs cmp xss) + +merge_pairs :: (a -> a -> Ordering) -> [[a]] -> [[a]] +merge_pairs _ [] = [] +merge_pairs _ [xs] = [xs] +merge_pairs cmp (xs:ys:xss) = merge cmp xs ys : merge_pairs cmp xss + +merge :: (a -> a -> Ordering) -> [a] -> [a] -> [a] +merge _ xs [] = xs +merge _ [] ys = ys +merge cmp (x:xs) (y:ys) + = case x `cmp` y of + GT -> y : merge cmp (x:xs) ys + _ -> x : merge cmp xs (y:ys) + +wrap :: a -> [a] +wrap x = [x] + +-- | /O(n)/,/fusion/. The non-overloaded version of 'insert'. +insertBy :: (a -> a -> Ordering) -> a -> [a] -> [a] +insertBy _ x [] = [x] +insertBy cmp x ys@(y:ys') + = case cmp x y of + GT -> y : insertBy cmp x ys' + _ -> x : ys +{-# NOINLINE [1] insertBy #-} + +{-# RULES +"insertBy -> fusible" [~1] forall f x xs. + insertBy f x xs = unstream (Stream.insertBy f x (stream xs)) +-- "insertBy -> unfused" [1] forall f x xs. +-- unstream (Stream.insertBy f x (stream xs)) = insertBy f x xs + #-} + +-- | /O(n)/,/fusion/. The 'maximumBy' function takes a comparison function and a list +-- and returns the greatest element of the list by the comparison function. +-- The list must be finite and non-empty. +-- +maximumBy :: (a -> a -> Ordering) -> [a] -> a +maximumBy _ [] = error "List.maximumBy: empty list" +maximumBy cmp xs = foldl1 max' xs + where + max' x y = case cmp x y of + GT -> x + _ -> y +{-# NOINLINE [1] maximumBy #-} + +{-# RULES +"maximumBy -> fused" [~1] forall p xs. + maximumBy p xs = Stream.maximumBy p (stream xs) +-- "maximumBy -> unfused" [1] forall p xs. +-- Stream.maximumBy p (stream xs) = maximumBy p xs + #-} + +-- | /O(n)/,/fusion/. The 'minimumBy' function takes a comparison function and a list +-- and returns the least element of the list by the comparison function. +-- The list must be finite and non-empty. +minimumBy :: (a -> a -> Ordering) -> [a] -> a +minimumBy _ [] = error "List.minimumBy: empty list" +minimumBy cmp xs = foldl1 min' xs + where + min' x y = case cmp x y of + GT -> y + _ -> x +{-# NOINLINE [1] minimumBy #-} + +{-# RULES +"minimumBy -> fused" [~1] forall p xs. + minimumBy p xs = Stream.minimumBy p (stream xs) +-- "minimumBy -> unfused" [1] forall p xs. +-- Stream.minimumBy p (stream xs) = minimumBy p xs + #-} + +------------------------------------------------------------------------ +-- * The \"generic\" operations + +-- | The 'genericLength' function is an overloaded version of 'length'. In +-- particular, instead of returning an 'Int', it returns any type which is +-- an instance of 'Num'. It is, however, less efficient than 'length'. +-- +genericLength :: Num i => [b] -> i +genericLength [] = 0 +genericLength (_:l) = 1 + genericLength l +{-# NOINLINE [1] genericLength #-} + +{-# RULES +"genericLength -> fusible" [~1] forall xs. + genericLength xs = Stream.genericLength (stream xs) +-- "genericLength -> unfused" [1] forall xs. +-- Stream.genericLength (stream xs) = genericLength xs + #-} + +{-# RULES +"genericLength -> length/Int" genericLength = length :: [a] -> Int + #-} + +-- | /O(n)/,/fusion/. The 'genericTake' function is an overloaded version of 'take', which +-- accepts any 'Integral' value as the number of elements to take. +genericTake :: Integral i => i -> [a] -> [a] +genericTake 0 _ = [] +genericTake _ [] = [] +genericTake n (x:xs) + | n > 0 = x : genericTake (n-1) xs + | otherwise = error "List.genericTake: negative argument" +{-# NOINLINE [1] genericTake #-} + +{-# RULES +"genericTake -> fusible" [~1] forall xs n. + genericTake n xs = unstream (Stream.genericTake n (stream xs)) +-- "genericTake -> unfused" [1] forall xs n. +-- unstream (Stream.genericTake n (stream xs)) = genericTake n xs + #-} + +{-# RULES +"genericTake -> take/Int" genericTake = take :: Int -> [a] -> [a] + #-} + +-- | /O(n)/,/fusion/. The 'genericDrop' function is an overloaded version of 'drop', which +-- accepts any 'Integral' value as the number of elements to drop. +genericDrop :: Integral i => i -> [a] -> [a] +genericDrop 0 xs = xs +genericDrop _ [] = [] +genericDrop n (_:xs) | n > 0 = genericDrop (n-1) xs +genericDrop _ _ = error "List.genericDrop: negative argument" +{-# NOINLINE [1] genericDrop #-} + +{-# RULES +"genericDrop -> fusible" [~1] forall xs n. + genericDrop n xs = unstream (Stream.genericDrop n (stream xs)) +-- "genericDrop -> unfused" [1] forall xs n. +-- unstream (Stream.genericDrop n (stream xs)) = genericDrop n xs + #-} + +{-# RULES +"genericDrop -> drop/Int" genericDrop = drop :: Int -> [a] -> [a] + #-} + +-- | /O(n)/,/fusion/. The 'genericIndex' function is an overloaded version of '!!', which +-- accepts any 'Integral' value as the index. +genericIndex :: Integral a => [b] -> a -> b +genericIndex (x:_) 0 = x +genericIndex (_:xs) n + | n > 0 = genericIndex xs (n-1) + | otherwise = error "List.genericIndex: negative argument." +genericIndex _ _ = error "List.genericIndex: index too large." +{-# NOINLINE [1] genericIndex #-} + + +-- can we pull the n > 0 test out and do it just once? +-- probably not since we don't know what n-1 does!! +-- can only specialise it for sane Integral instances :-( + +{-# RULES +"genericIndex -> fusible" [~1] forall xs n. + genericIndex xs n = Stream.genericIndex (stream xs) n +-- "genericIndex -> unfused" [1] forall xs n. +-- Stream.genericIndex (stream xs) n = genericIndex n xs + #-} + +{-# RULES +"genericIndex -> index/Int" genericIndex = (!!) :: [a] -> Int -> a + #-} + +-- | /O(n)/,/fusion/. The 'genericSplitAt' function is an overloaded +-- version of 'splitAt', which accepts any 'Integral' value as the +-- position at which to split. +-- +genericSplitAt :: Integral i => i -> [a] -> ([a], [a]) +genericSplitAt 0 xs = ([],xs) +genericSplitAt _ [] = ([],[]) +genericSplitAt n (x:xs) | n > 0 = (x:xs',xs'') + where (xs',xs'') = genericSplitAt (n-1) xs +genericSplitAt _ _ = error "List.genericSplitAt: negative argument" + +{-# RULES +"genericSplitAt -> fusible" [~1] forall xs n. + genericSplitAt n xs = Stream.genericSplitAt n (stream xs) +-- "genericSplitAt -> unfused" [1] forall xs n. +-- Stream.genericSplitAt n (stream xs) = genericSplitAt n xs + #-} + +{-# RULES +"genericSplitAt -> splitAt/Int" genericSplitAt = splitAt :: Int -> [a] -> ([a], [a]) + #-} + +-- | /O(n)/,/fusion/. The 'genericReplicate' function is an overloaded version of 'replicate', +-- which accepts any 'Integral' value as the number of repetitions to make. +-- +genericReplicate :: Integral i => i -> a -> [a] +genericReplicate n x = genericTake n (repeat x) +{-# INLINE genericReplicate #-} + +{-# RULES +"genericReplicate -> replicate/Int" genericReplicate = replicate :: Int -> a -> [a] + #-} +-} + +-- --------------------------------------------------------------------- +-- Internal utilities + +-- Common up near identical calls to `error' to reduce the number +-- constant strings created when compiled: +errorEmptyList :: Prelude.String -> a +errorEmptyList fun = moduleError fun "empty list" +{-# NOINLINE errorEmptyList #-} + +moduleError :: Prelude.String -> Prelude.String -> a +moduleError fun msg = Prelude.error ("Data.Adaptive.List." Prelude.++ fun Prelude.++ ':':' ':msg) +{-# NOINLINE moduleError #-} + +bottom :: a +bottom = Prelude.error "Data.List.Stream: bottom" +{-# NOINLINE bottom #-} + +------------------------------------------------------------------------ +-- Instances + +instance (AdaptList a, Prelude.Eq a) => Prelude.Eq (List a) where + xs == ys + | null xs Prelude.&& null ys = True + | null xs = False + | null ys = False + | otherwise = (head xs Prelude.== head ys) + Prelude.&& (tail xs Prelude.== tail ys) + +instance (AdaptList a, Prelude.Ord a) => Prelude.Ord (List a) where + compare xs ys + | null xs Prelude.&& null ys = EQ + | null xs = LT + | null ys = GT + | otherwise = case compare (head xs) (head ys) of + EQ -> compare (tail xs) (tail ys) + other -> other + +instance (AdaptList a, Prelude.Show a) => Prelude.Show (List a) where + showsPrec _ = Prelude.showList . toList + +instance IsString (List Char) where fromString = fromList + +------------------------------------------------------------------------ + +-- | We can unpack bools! +instance AdaptList Bool where + data List Bool = EmptyBool | ConsBool {-# UNPACK #-}!Int (List Bool) + + empty = EmptyBool + cons x xs = ConsBool (Prelude.fromEnum x) xs -- pack + null EmptyBool = True + null _ = False + + head EmptyBool = errorEmptyList "head" + head (ConsBool x _) = Prelude.toEnum x + + tail EmptyBool = errorEmptyList "tail" + tail (ConsBool _ xs) = xs + +------------------------------------------------------------------------ +-- Generated by scripts/derive-list.hs + +instance AdaptList Int where + data List Int = EmptyInt | ConsInt {-# UNPACK #-}!Int (List Int) + empty = EmptyInt + cons = ConsInt + null EmptyInt = True + null _ = False + head EmptyInt = errorEmptyList "head" + head (ConsInt x _) = x + tail EmptyInt = errorEmptyList "tail" + tail (ConsInt _ x) = x + +instance AdaptList Integer where + data List Integer = EmptyInteger | ConsInteger {-# UNPACK #-}!Integer (List Integer) + empty = EmptyInteger + cons = ConsInteger + null EmptyInteger = True + null _ = False + head EmptyInteger = errorEmptyList "head" + head (ConsInteger x _) = x + tail EmptyInteger = errorEmptyList "tail" + tail (ConsInteger _ x) = x + +instance AdaptList Int8 where + data List Int8 = EmptyInt8 | ConsInt8 {-# UNPACK #-}!Int8 (List Int8) + empty = EmptyInt8 + cons = ConsInt8 + null EmptyInt8 = True + null _ = False + head EmptyInt8 = errorEmptyList "head" + head (ConsInt8 x _) = x + tail EmptyInt8 = errorEmptyList "tail" + tail (ConsInt8 _ x) = x + +instance AdaptList Int16 where + data List Int16 = EmptyInt16 | ConsInt16 {-# UNPACK #-}!Int16 (List Int16) + empty = EmptyInt16 + cons = ConsInt16 + null EmptyInt16 = True + null _ = False + head EmptyInt16 = errorEmptyList "head" + head (ConsInt16 x _) = x + tail EmptyInt16 = errorEmptyList "tail" + tail (ConsInt16 _ x) = x + +instance AdaptList Int32 where + data List Int32 = EmptyInt32 | ConsInt32 {-# UNPACK #-}!Int32 (List Int32) + empty = EmptyInt32 + cons = ConsInt32 + null EmptyInt32 = True + null _ = False + head EmptyInt32 = errorEmptyList "head" + head (ConsInt32 x _) = x + tail EmptyInt32 = errorEmptyList "tail" + tail (ConsInt32 _ x) = x + +instance AdaptList Int64 where + data List Int64 = EmptyInt64 | ConsInt64 {-# UNPACK #-}!Int64 (List Int64) + empty = EmptyInt64 + cons = ConsInt64 + null EmptyInt64 = True + null _ = False + head EmptyInt64 = errorEmptyList "head" + head (ConsInt64 x _) = x + tail EmptyInt64 = errorEmptyList "tail" + tail (ConsInt64 _ x) = x + +instance AdaptList Word where + data List Word = EmptyWord | ConsWord {-# UNPACK #-}!Word (List Word) + empty = EmptyWord + cons = ConsWord + null EmptyWord = True + null _ = False + head EmptyWord = errorEmptyList "head" + head (ConsWord x _) = x + tail EmptyWord = errorEmptyList "tail" + tail (ConsWord _ x) = x + +instance AdaptList Word8 where + data List Word8 = EmptyWord8 | ConsWord8 {-# UNPACK #-}!Word8 (List Word8) + empty = EmptyWord8 + cons = ConsWord8 + null EmptyWord8 = True + null _ = False + head EmptyWord8 = errorEmptyList "head" + head (ConsWord8 x _) = x + tail EmptyWord8 = errorEmptyList "tail" + tail (ConsWord8 _ x) = x + +instance AdaptList Word16 where + data List Word16 = EmptyWord16 | ConsWord16 {-# UNPACK #-}!Word16 (List Word16) + empty = EmptyWord16 + cons = ConsWord16 + null EmptyWord16 = True + null _ = False + head EmptyWord16 = errorEmptyList "head" + head (ConsWord16 x _) = x + tail EmptyWord16 = errorEmptyList "tail" + tail (ConsWord16 _ x) = x + +instance AdaptList Word32 where + data List Word32 = EmptyWord32 | ConsWord32 {-# UNPACK #-}!Word32 (List Word32) + empty = EmptyWord32 + cons = ConsWord32 + null EmptyWord32 = True + null _ = False + head EmptyWord32 = errorEmptyList "head" + head (ConsWord32 x _) = x + tail EmptyWord32 = errorEmptyList "tail" + tail (ConsWord32 _ x) = x + +instance AdaptList Word64 where + data List Word64 = EmptyWord64 | ConsWord64 {-# UNPACK #-}!Word64 (List Word64) + empty = EmptyWord64 + cons = ConsWord64 + null EmptyWord64 = True + null _ = False + head EmptyWord64 = errorEmptyList "head" + head (ConsWord64 x _) = x + tail EmptyWord64 = errorEmptyList "tail" + tail (ConsWord64 _ x) = x + +instance AdaptList Double where + data List Double = EmptyDouble | ConsDouble {-# UNPACK #-}!Double (List Double) + empty = EmptyDouble + cons = ConsDouble + null EmptyDouble = True + null _ = False + head EmptyDouble = errorEmptyList "head" + head (ConsDouble x _) = x + tail EmptyDouble = errorEmptyList "tail" + tail (ConsDouble _ x) = x + +instance AdaptList Float where + data List Float = EmptyFloat | ConsFloat {-# UNPACK #-}!Float (List Float) + empty = EmptyFloat + cons = ConsFloat + null EmptyFloat = True + null _ = False + head EmptyFloat = errorEmptyList "head" + head (ConsFloat x _) = x + tail EmptyFloat = errorEmptyList "tail" + tail (ConsFloat _ x) = x + +instance AdaptList Char where + data List Char = EmptyChar | ConsChar {-# UNPACK #-}!Char (List Char) + empty = EmptyChar + cons = ConsChar + null EmptyChar = True + null _ = False + head EmptyChar = errorEmptyList "head" + head (ConsChar x _) = x + tail EmptyChar = errorEmptyList "tail" + tail (ConsChar _ x) = x + + +------------------------------------------------------------------------ +-- +-- Generic adaptive pair: won't flatten! +-- +-- Unsound +-- Data/Adaptive/List.hs:1687:9: +-- Conflicting family instance declarations: +-- data instance List (Pair a b) +-- -- Defined at Data/Adaptive/List.hs:1687:9-12 +-- data instance List (Pair Int Int) +-- -- Defined at Data/Adaptive/List.hs:1699:9-12 +-- + +{- + -- looks illegal? +instance AdaptPair a b => AdaptList (Pair a b) where + data List (Pair a b) = EmptyPair | ConsPair {-# UNPACK #-}!(Pair a b) (List (Pair a b)) + empty = EmptyPair + cons x xs = ConsPair x xs + null EmptyPair = True + null _ = False + head EmptyPair = errorEmptyList "head" + head (ConsPair x _) = x + tail EmptyPair = errorEmptyList "tail" + tail (ConsPair _ xs) = xs +-} + + +-- Monomorphic, but we have to flatten ourselves. GHC is doing something wrong. +-- +-- | ConsPairIntInt {-# UNPACK #-}!(Pair Int Int) (List (Pair Int Int)) +-- -- this isn't unpacking +-- +-- I think this should be ok, but it doesn't unpack. +-- + +{- +instance AdaptList (Pair Int Int) where + data List (Pair Int Int) + = EmptyPairIntInt + + + | ConsPairIntInt {-# UNPACK #-}!Int {-# UNPACK #-}!Int (List (Pair Int Int)) + + empty = EmptyPairIntInt + cons x xs = ConsPairIntInt (fst x) (snd x) xs + + null EmptyPairIntInt = True + null _ = False + + head EmptyPairIntInt = errorEmptyList "head" + head (ConsPairIntInt x y _) = pair x y + tail EmptyPairIntInt = errorEmptyList "tail" + tail (ConsPairIntInt _ _ xs) = xs +-} + +------------------------------------------------------------------------ +-- auto instances for lists of adaptive pairs +-- + +instance AdaptList (Pair Int Int) where + data List (Pair Int Int) + = EmptyPairIntInt + | ConsPairIntInt {-# UNPACK #-}!Int {-# UNPACK #-}!Int (List (Pair Int Int)) + empty = EmptyPairIntInt + cons x z = ConsPairIntInt (fst x) (snd x) z + null EmptyPairIntInt = True + null _ = False + head EmptyPairIntInt = errorEmptyList "head" + head (ConsPairIntInt x y _) = pair x y + tail EmptyPairIntInt = errorEmptyList "tail" + tail (ConsPairIntInt _ _ x) = x + +instance AdaptList (Pair Int Integer) where + data List (Pair Int Integer) + = EmptyPairIntInteger + | ConsPairIntInteger {-# UNPACK #-}!Int {-# UNPACK #-}!Integer (List (Pair Int Integer)) + empty = EmptyPairIntInteger + cons x z = ConsPairIntInteger (fst x) (snd x) z + null EmptyPairIntInteger = True + null _ = False + head EmptyPairIntInteger = errorEmptyList "head" + head (ConsPairIntInteger x y _) = pair x y + tail EmptyPairIntInteger = errorEmptyList "tail" + tail (ConsPairIntInteger _ _ x) = x + +instance AdaptList (Pair Int Int8) where + data List (Pair Int Int8) + = EmptyPairIntInt8 + | ConsPairIntInt8 {-# UNPACK #-}!Int {-# UNPACK #-}!Int8 (List (Pair Int Int8)) + empty = EmptyPairIntInt8 + cons x z = ConsPairIntInt8 (fst x) (snd x) z + null EmptyPairIntInt8 = True + null _ = False + head EmptyPairIntInt8 = errorEmptyList "head" + head (ConsPairIntInt8 x y _) = pair x y + tail EmptyPairIntInt8 = errorEmptyList "tail" + tail (ConsPairIntInt8 _ _ x) = x + +instance AdaptList (Pair Int Int16) where + data List (Pair Int Int16) + = EmptyPairIntInt16 + | ConsPairIntInt16 {-# UNPACK #-}!Int {-# UNPACK #-}!Int16 (List (Pair Int Int16)) + empty = EmptyPairIntInt16 + cons x z = ConsPairIntInt16 (fst x) (snd x) z + null EmptyPairIntInt16 = True + null _ = False + head EmptyPairIntInt16 = errorEmptyList "head" + head (ConsPairIntInt16 x y _) = pair x y + tail EmptyPairIntInt16 = errorEmptyList "tail" + tail (ConsPairIntInt16 _ _ x) = x + +instance AdaptList (Pair Int Int32) where + data List (Pair Int Int32) + = EmptyPairIntInt32 + | ConsPairIntInt32 {-# UNPACK #-}!Int {-# UNPACK #-}!Int32 (List (Pair Int Int32)) + empty = EmptyPairIntInt32 + cons x z = ConsPairIntInt32 (fst x) (snd x) z + null EmptyPairIntInt32 = True + null _ = False + head EmptyPairIntInt32 = errorEmptyList "head" + head (ConsPairIntInt32 x y _) = pair x y + tail EmptyPairIntInt32 = errorEmptyList "tail" + tail (ConsPairIntInt32 _ _ x) = x + +instance AdaptList (Pair Int Int64) where + data List (Pair Int Int64) + = EmptyPairIntInt64 + | ConsPairIntInt64 {-# UNPACK #-}!Int {-# UNPACK #-}!Int64 (List (Pair Int Int64)) + empty = EmptyPairIntInt64 + cons x z = ConsPairIntInt64 (fst x) (snd x) z + null EmptyPairIntInt64 = True + null _ = False + head EmptyPairIntInt64 = errorEmptyList "head" + head (ConsPairIntInt64 x y _) = pair x y + tail EmptyPairIntInt64 = errorEmptyList "tail" + tail (ConsPairIntInt64 _ _ x) = x + +instance AdaptList (Pair Int Word) where + data List (Pair Int Word) + = EmptyPairIntWord + | ConsPairIntWord {-# UNPACK #-}!Int {-# UNPACK #-}!Word (List (Pair Int Word)) + empty = EmptyPairIntWord + cons x z = ConsPairIntWord (fst x) (snd x) z + null EmptyPairIntWord = True + null _ = False + head EmptyPairIntWord = errorEmptyList "head" + head (ConsPairIntWord x y _) = pair x y + tail EmptyPairIntWord = errorEmptyList "tail" + tail (ConsPairIntWord _ _ x) = x + +instance AdaptList (Pair Int Word8) where + data List (Pair Int Word8) + = EmptyPairIntWord8 + | ConsPairIntWord8 {-# UNPACK #-}!Int {-# UNPACK #-}!Word8 (List (Pair Int Word8)) + empty = EmptyPairIntWord8 + cons x z = ConsPairIntWord8 (fst x) (snd x) z + null EmptyPairIntWord8 = True + null _ = False + head EmptyPairIntWord8 = errorEmptyList "head" + head (ConsPairIntWord8 x y _) = pair x y + tail EmptyPairIntWord8 = errorEmptyList "tail" + tail (ConsPairIntWord8 _ _ x) = x + +instance AdaptList (Pair Int Word16) where + data List (Pair Int Word16) + = EmptyPairIntWord16 + | ConsPairIntWord16 {-# UNPACK #-}!Int {-# UNPACK #-}!Word16 (List (Pair Int Word16)) + empty = EmptyPairIntWord16 + cons x z = ConsPairIntWord16 (fst x) (snd x) z + null EmptyPairIntWord16 = True + null _ = False + head EmptyPairIntWord16 = errorEmptyList "head" + head (ConsPairIntWord16 x y _) = pair x y + tail EmptyPairIntWord16 = errorEmptyList "tail" + tail (ConsPairIntWord16 _ _ x) = x + +instance AdaptList (Pair Int Word32) where + data List (Pair Int Word32) + = EmptyPairIntWord32 + | ConsPairIntWord32 {-# UNPACK #-}!Int {-# UNPACK #-}!Word32 (List (Pair Int Word32)) + empty = EmptyPairIntWord32 + cons x z = ConsPairIntWord32 (fst x) (snd x) z + null EmptyPairIntWord32 = True + null _ = False + head EmptyPairIntWord32 = errorEmptyList "head" + head (ConsPairIntWord32 x y _) = pair x y + tail EmptyPairIntWord32 = errorEmptyList "tail" + tail (ConsPairIntWord32 _ _ x) = x + +instance AdaptList (Pair Int Word64) where + data List (Pair Int Word64) + = EmptyPairIntWord64 + | ConsPairIntWord64 {-# UNPACK #-}!Int {-# UNPACK #-}!Word64 (List (Pair Int Word64)) + empty = EmptyPairIntWord64 + cons x z = ConsPairIntWord64 (fst x) (snd x) z + null EmptyPairIntWord64 = True + null _ = False + head EmptyPairIntWord64 = errorEmptyList "head" + head (ConsPairIntWord64 x y _) = pair x y + tail EmptyPairIntWord64 = errorEmptyList "tail" + tail (ConsPairIntWord64 _ _ x) = x + +instance AdaptList (Pair Int Double) where + data List (Pair Int Double) + = EmptyPairIntDouble + | ConsPairIntDouble {-# UNPACK #-}!Int {-# UNPACK #-}!Double (List (Pair Int Double)) + empty = EmptyPairIntDouble + cons x z = ConsPairIntDouble (fst x) (snd x) z + null EmptyPairIntDouble = True + null _ = False + head EmptyPairIntDouble = errorEmptyList "head" + head (ConsPairIntDouble x y _) = pair x y + tail EmptyPairIntDouble = errorEmptyList "tail" + tail (ConsPairIntDouble _ _ x) = x + +instance AdaptList (Pair Int Float) where + data List (Pair Int Float) + = EmptyPairIntFloat + | ConsPairIntFloat {-# UNPACK #-}!Int {-# UNPACK #-}!Float (List (Pair Int Float)) + empty = EmptyPairIntFloat + cons x z = ConsPairIntFloat (fst x) (snd x) z + null EmptyPairIntFloat = True + null _ = False + head EmptyPairIntFloat = errorEmptyList "head" + head (ConsPairIntFloat x y _) = pair x y + tail EmptyPairIntFloat = errorEmptyList "tail" + tail (ConsPairIntFloat _ _ x) = x + +instance AdaptList (Pair Int Char) where + data List (Pair Int Char) + = EmptyPairIntChar + | ConsPairIntChar {-# UNPACK #-}!Int {-# UNPACK #-}!Char (List (Pair Int Char)) + empty = EmptyPairIntChar + cons x z = ConsPairIntChar (fst x) (snd x) z + null EmptyPairIntChar = True + null _ = False + head EmptyPairIntChar = errorEmptyList "head" + head (ConsPairIntChar x y _) = pair x y + tail EmptyPairIntChar = errorEmptyList "tail" + tail (ConsPairIntChar _ _ x) = x + +instance AdaptList (Pair Integer Int) where + data List (Pair Integer Int) + = EmptyPairIntegerInt + | ConsPairIntegerInt {-# UNPACK #-}!Integer {-# UNPACK #-}!Int (List (Pair Integer Int)) + empty = EmptyPairIntegerInt + cons x z = ConsPairIntegerInt (fst x) (snd x) z + null EmptyPairIntegerInt = True + null _ = False + head EmptyPairIntegerInt = errorEmptyList "head" + head (ConsPairIntegerInt x y _) = pair x y + tail EmptyPairIntegerInt = errorEmptyList "tail" + tail (ConsPairIntegerInt _ _ x) = x + +instance AdaptList (Pair Integer Integer) where + data List (Pair Integer Integer) + = EmptyPairIntegerInteger + | ConsPairIntegerInteger {-# UNPACK #-}!Integer {-# UNPACK #-}!Integer (List (Pair Integer Integer)) + empty = EmptyPairIntegerInteger + cons x z = ConsPairIntegerInteger (fst x) (snd x) z + null EmptyPairIntegerInteger = True + null _ = False + head EmptyPairIntegerInteger = errorEmptyList "head" + head (ConsPairIntegerInteger x y _) = pair x y + tail EmptyPairIntegerInteger = errorEmptyList "tail" + tail (ConsPairIntegerInteger _ _ x) = x + +instance AdaptList (Pair Integer Int8) where + data List (Pair Integer Int8) + = EmptyPairIntegerInt8 + | ConsPairIntegerInt8 {-# UNPACK #-}!Integer {-# UNPACK #-}!Int8 (List (Pair Integer Int8)) + empty = EmptyPairIntegerInt8 + cons x z = ConsPairIntegerInt8 (fst x) (snd x) z + null EmptyPairIntegerInt8 = True + null _ = False + head EmptyPairIntegerInt8 = errorEmptyList "head" + head (ConsPairIntegerInt8 x y _) = pair x y + tail EmptyPairIntegerInt8 = errorEmptyList "tail" + tail (ConsPairIntegerInt8 _ _ x) = x + +instance AdaptList (Pair Integer Int16) where + data List (Pair Integer Int16) + = EmptyPairIntegerInt16 + | ConsPairIntegerInt16 {-# UNPACK #-}!Integer {-# UNPACK #-}!Int16 (List (Pair Integer Int16)) + empty = EmptyPairIntegerInt16 + cons x z = ConsPairIntegerInt16 (fst x) (snd x) z + null EmptyPairIntegerInt16 = True + null _ = False + head EmptyPairIntegerInt16 = errorEmptyList "head" + head (ConsPairIntegerInt16 x y _) = pair x y + tail EmptyPairIntegerInt16 = errorEmptyList "tail" + tail (ConsPairIntegerInt16 _ _ x) = x + +instance AdaptList (Pair Integer Int32) where + data List (Pair Integer Int32) + = EmptyPairIntegerInt32 + | ConsPairIntegerInt32 {-# UNPACK #-}!Integer {-# UNPACK #-}!Int32 (List (Pair Integer Int32)) + empty = EmptyPairIntegerInt32 + cons x z = ConsPairIntegerInt32 (fst x) (snd x) z + null EmptyPairIntegerInt32 = True + null _ = False + head EmptyPairIntegerInt32 = errorEmptyList "head" + head (ConsPairIntegerInt32 x y _) = pair x y + tail EmptyPairIntegerInt32 = errorEmptyList "tail" + tail (ConsPairIntegerInt32 _ _ x) = x + +instance AdaptList (Pair Integer Int64) where + data List (Pair Integer Int64) + = EmptyPairIntegerInt64 + | ConsPairIntegerInt64 {-# UNPACK #-}!Integer {-# UNPACK #-}!Int64 (List (Pair Integer Int64)) + empty = EmptyPairIntegerInt64 + cons x z = ConsPairIntegerInt64 (fst x) (snd x) z + null EmptyPairIntegerInt64 = True + null _ = False + head EmptyPairIntegerInt64 = errorEmptyList "head" + head (ConsPairIntegerInt64 x y _) = pair x y + tail EmptyPairIntegerInt64 = errorEmptyList "tail" + tail (ConsPairIntegerInt64 _ _ x) = x + +instance AdaptList (Pair Integer Word) where + data List (Pair Integer Word) + = EmptyPairIntegerWord + | ConsPairIntegerWord {-# UNPACK #-}!Integer {-# UNPACK #-}!Word (List (Pair Integer Word)) + empty = EmptyPairIntegerWord + cons x z = ConsPairIntegerWord (fst x) (snd x) z + null EmptyPairIntegerWord = True + null _ = False + head EmptyPairIntegerWord = errorEmptyList "head" + head (ConsPairIntegerWord x y _) = pair x y + tail EmptyPairIntegerWord = errorEmptyList "tail" + tail (ConsPairIntegerWord _ _ x) = x + +instance AdaptList (Pair Integer Word8) where + data List (Pair Integer Word8) + = EmptyPairIntegerWord8 + | ConsPairIntegerWord8 {-# UNPACK #-}!Integer {-# UNPACK #-}!Word8 (List (Pair Integer Word8)) + empty = EmptyPairIntegerWord8 + cons x z = ConsPairIntegerWord8 (fst x) (snd x) z + null EmptyPairIntegerWord8 = True + null _ = False + head EmptyPairIntegerWord8 = errorEmptyList "head" + head (ConsPairIntegerWord8 x y _) = pair x y + tail EmptyPairIntegerWord8 = errorEmptyList "tail" + tail (ConsPairIntegerWord8 _ _ x) = x + +instance AdaptList (Pair Integer Word16) where + data List (Pair Integer Word16) + = EmptyPairIntegerWord16 + | ConsPairIntegerWord16 {-# UNPACK #-}!Integer {-# UNPACK #-}!Word16 (List (Pair Integer Word16)) + empty = EmptyPairIntegerWord16 + cons x z = ConsPairIntegerWord16 (fst x) (snd x) z + null EmptyPairIntegerWord16 = True + null _ = False + head EmptyPairIntegerWord16 = errorEmptyList "head" + head (ConsPairIntegerWord16 x y _) = pair x y + tail EmptyPairIntegerWord16 = errorEmptyList "tail" + tail (ConsPairIntegerWord16 _ _ x) = x + +instance AdaptList (Pair Integer Word32) where + data List (Pair Integer Word32) + = EmptyPairIntegerWord32 + | ConsPairIntegerWord32 {-# UNPACK #-}!Integer {-# UNPACK #-}!Word32 (List (Pair Integer Word32)) + empty = EmptyPairIntegerWord32 + cons x z = ConsPairIntegerWord32 (fst x) (snd x) z + null EmptyPairIntegerWord32 = True + null _ = False + head EmptyPairIntegerWord32 = errorEmptyList "head" + head (ConsPairIntegerWord32 x y _) = pair x y + tail EmptyPairIntegerWord32 = errorEmptyList "tail" + tail (ConsPairIntegerWord32 _ _ x) = x + +instance AdaptList (Pair Integer Word64) where + data List (Pair Integer Word64) + = EmptyPairIntegerWord64 + | ConsPairIntegerWord64 {-# UNPACK #-}!Integer {-# UNPACK #-}!Word64 (List (Pair Integer Word64)) + empty = EmptyPairIntegerWord64 + cons x z = ConsPairIntegerWord64 (fst x) (snd x) z + null EmptyPairIntegerWord64 = True + null _ = False + head EmptyPairIntegerWord64 = errorEmptyList "head" + head (ConsPairIntegerWord64 x y _) = pair x y + tail EmptyPairIntegerWord64 = errorEmptyList "tail" + tail (ConsPairIntegerWord64 _ _ x) = x + +instance AdaptList (Pair Integer Double) where + data List (Pair Integer Double) + = EmptyPairIntegerDouble + | ConsPairIntegerDouble {-# UNPACK #-}!Integer {-# UNPACK #-}!Double (List (Pair Integer Double)) + empty = EmptyPairIntegerDouble + cons x z = ConsPairIntegerDouble (fst x) (snd x) z + null EmptyPairIntegerDouble = True + null _ = False + head EmptyPairIntegerDouble = errorEmptyList "head" + head (ConsPairIntegerDouble x y _) = pair x y + tail EmptyPairIntegerDouble = errorEmptyList "tail" + tail (ConsPairIntegerDouble _ _ x) = x + +instance AdaptList (Pair Integer Float) where + data List (Pair Integer Float) + = EmptyPairIntegerFloat + | ConsPairIntegerFloat {-# UNPACK #-}!Integer {-# UNPACK #-}!Float (List (Pair Integer Float)) + empty = EmptyPairIntegerFloat + cons x z = ConsPairIntegerFloat (fst x) (snd x) z + null EmptyPairIntegerFloat = True + null _ = False + head EmptyPairIntegerFloat = errorEmptyList "head" + head (ConsPairIntegerFloat x y _) = pair x y + tail EmptyPairIntegerFloat = errorEmptyList "tail" + tail (ConsPairIntegerFloat _ _ x) = x + +instance AdaptList (Pair Integer Char) where + data List (Pair Integer Char) + = EmptyPairIntegerChar + | ConsPairIntegerChar {-# UNPACK #-}!Integer {-# UNPACK #-}!Char (List (Pair Integer Char)) + empty = EmptyPairIntegerChar + cons x z = ConsPairIntegerChar (fst x) (snd x) z + null EmptyPairIntegerChar = True + null _ = False + head EmptyPairIntegerChar = errorEmptyList "head" + head (ConsPairIntegerChar x y _) = pair x y + tail EmptyPairIntegerChar = errorEmptyList "tail" + tail (ConsPairIntegerChar _ _ x) = x + +instance AdaptList (Pair Int8 Int) where + data List (Pair Int8 Int) + = EmptyPairInt8Int + | ConsPairInt8Int {-# UNPACK #-}!Int8 {-# UNPACK #-}!Int (List (Pair Int8 Int)) + empty = EmptyPairInt8Int + cons x z = ConsPairInt8Int (fst x) (snd x) z + null EmptyPairInt8Int = True + null _ = False + head EmptyPairInt8Int = errorEmptyList "head" + head (ConsPairInt8Int x y _) = pair x y + tail EmptyPairInt8Int = errorEmptyList "tail" + tail (ConsPairInt8Int _ _ x) = x + +instance AdaptList (Pair Int8 Integer) where + data List (Pair Int8 Integer) + = EmptyPairInt8Integer + | ConsPairInt8Integer {-# UNPACK #-}!Int8 {-# UNPACK #-}!Integer (List (Pair Int8 Integer)) + empty = EmptyPairInt8Integer + cons x z = ConsPairInt8Integer (fst x) (snd x) z + null EmptyPairInt8Integer = True + null _ = False + head EmptyPairInt8Integer = errorEmptyList "head" + head (ConsPairInt8Integer x y _) = pair x y + tail EmptyPairInt8Integer = errorEmptyList "tail" + tail (ConsPairInt8Integer _ _ x) = x + +instance AdaptList (Pair Int8 Int8) where + data List (Pair Int8 Int8) + = EmptyPairInt8Int8 + | ConsPairInt8Int8 {-# UNPACK #-}!Int8 {-# UNPACK #-}!Int8 (List (Pair Int8 Int8)) + empty = EmptyPairInt8Int8 + cons x z = ConsPairInt8Int8 (fst x) (snd x) z + null EmptyPairInt8Int8 = True + null _ = False + head EmptyPairInt8Int8 = errorEmptyList "head" + head (ConsPairInt8Int8 x y _) = pair x y + tail EmptyPairInt8Int8 = errorEmptyList "tail" + tail (ConsPairInt8Int8 _ _ x) = x + +instance AdaptList (Pair Int8 Int16) where + data List (Pair Int8 Int16) + = EmptyPairInt8Int16 + | ConsPairInt8Int16 {-# UNPACK #-}!Int8 {-# UNPACK #-}!Int16 (List (Pair Int8 Int16)) + empty = EmptyPairInt8Int16 + cons x z = ConsPairInt8Int16 (fst x) (snd x) z + null EmptyPairInt8Int16 = True + null _ = False + head EmptyPairInt8Int16 = errorEmptyList "head" + head (ConsPairInt8Int16 x y _) = pair x y + tail EmptyPairInt8Int16 = errorEmptyList "tail" + tail (ConsPairInt8Int16 _ _ x) = x + +instance AdaptList (Pair Int8 Int32) where + data List (Pair Int8 Int32) + = EmptyPairInt8Int32 + | ConsPairInt8Int32 {-# UNPACK #-}!Int8 {-# UNPACK #-}!Int32 (List (Pair Int8 Int32)) + empty = EmptyPairInt8Int32 + cons x z = ConsPairInt8Int32 (fst x) (snd x) z + null EmptyPairInt8Int32 = True + null _ = False + head EmptyPairInt8Int32 = errorEmptyList "head" + head (ConsPairInt8Int32 x y _) = pair x y + tail EmptyPairInt8Int32 = errorEmptyList "tail" + tail (ConsPairInt8Int32 _ _ x) = x + +instance AdaptList (Pair Int8 Int64) where + data List (Pair Int8 Int64) + = EmptyPairInt8Int64 + | ConsPairInt8Int64 {-# UNPACK #-}!Int8 {-# UNPACK #-}!Int64 (List (Pair Int8 Int64)) + empty = EmptyPairInt8Int64 + cons x z = ConsPairInt8Int64 (fst x) (snd x) z + null EmptyPairInt8Int64 = True + null _ = False + head EmptyPairInt8Int64 = errorEmptyList "head" + head (ConsPairInt8Int64 x y _) = pair x y + tail EmptyPairInt8Int64 = errorEmptyList "tail" + tail (ConsPairInt8Int64 _ _ x) = x + +instance AdaptList (Pair Int8 Word) where + data List (Pair Int8 Word) + = EmptyPairInt8Word + | ConsPairInt8Word {-# UNPACK #-}!Int8 {-# UNPACK #-}!Word (List (Pair Int8 Word)) + empty = EmptyPairInt8Word + cons x z = ConsPairInt8Word (fst x) (snd x) z + null EmptyPairInt8Word = True + null _ = False + head EmptyPairInt8Word = errorEmptyList "head" + head (ConsPairInt8Word x y _) = pair x y + tail EmptyPairInt8Word = errorEmptyList "tail" + tail (ConsPairInt8Word _ _ x) = x + +instance AdaptList (Pair Int8 Word8) where + data List (Pair Int8 Word8) + = EmptyPairInt8Word8 + | ConsPairInt8Word8 {-# UNPACK #-}!Int8 {-# UNPACK #-}!Word8 (List (Pair Int8 Word8)) + empty = EmptyPairInt8Word8 + cons x z = ConsPairInt8Word8 (fst x) (snd x) z + null EmptyPairInt8Word8 = True + null _ = False + head EmptyPairInt8Word8 = errorEmptyList "head" + head (ConsPairInt8Word8 x y _) = pair x y + tail EmptyPairInt8Word8 = errorEmptyList "tail" + tail (ConsPairInt8Word8 _ _ x) = x + +instance AdaptList (Pair Int8 Word16) where + data List (Pair Int8 Word16) + = EmptyPairInt8Word16 + | ConsPairInt8Word16 {-# UNPACK #-}!Int8 {-# UNPACK #-}!Word16 (List (Pair Int8 Word16)) + empty = EmptyPairInt8Word16 + cons x z = ConsPairInt8Word16 (fst x) (snd x) z + null EmptyPairInt8Word16 = True + null _ = False + head EmptyPairInt8Word16 = errorEmptyList "head" + head (ConsPairInt8Word16 x y _) = pair x y + tail EmptyPairInt8Word16 = errorEmptyList "tail" + tail (ConsPairInt8Word16 _ _ x) = x + +instance AdaptList (Pair Int8 Word32) where + data List (Pair Int8 Word32) + = EmptyPairInt8Word32 + | ConsPairInt8Word32 {-# UNPACK #-}!Int8 {-# UNPACK #-}!Word32 (List (Pair Int8 Word32)) + empty = EmptyPairInt8Word32 + cons x z = ConsPairInt8Word32 (fst x) (snd x) z + null EmptyPairInt8Word32 = True + null _ = False + head EmptyPairInt8Word32 = errorEmptyList "head" + head (ConsPairInt8Word32 x y _) = pair x y + tail EmptyPairInt8Word32 = errorEmptyList "tail" + tail (ConsPairInt8Word32 _ _ x) = x + +instance AdaptList (Pair Int8 Word64) where + data List (Pair Int8 Word64) + = EmptyPairInt8Word64 + | ConsPairInt8Word64 {-# UNPACK #-}!Int8 {-# UNPACK #-}!Word64 (List (Pair Int8 Word64)) + empty = EmptyPairInt8Word64 + cons x z = ConsPairInt8Word64 (fst x) (snd x) z + null EmptyPairInt8Word64 = True + null _ = False + head EmptyPairInt8Word64 = errorEmptyList "head" + head (ConsPairInt8Word64 x y _) = pair x y + tail EmptyPairInt8Word64 = errorEmptyList "tail" + tail (ConsPairInt8Word64 _ _ x) = x + +instance AdaptList (Pair Int8 Double) where + data List (Pair Int8 Double) + = EmptyPairInt8Double + | ConsPairInt8Double {-# UNPACK #-}!Int8 {-# UNPACK #-}!Double (List (Pair Int8 Double)) + empty = EmptyPairInt8Double + cons x z = ConsPairInt8Double (fst x) (snd x) z + null EmptyPairInt8Double = True + null _ = False + head EmptyPairInt8Double = errorEmptyList "head" + head (ConsPairInt8Double x y _) = pair x y + tail EmptyPairInt8Double = errorEmptyList "tail" + tail (ConsPairInt8Double _ _ x) = x + +instance AdaptList (Pair Int8 Float) where + data List (Pair Int8 Float) + = EmptyPairInt8Float + | ConsPairInt8Float {-# UNPACK #-}!Int8 {-# UNPACK #-}!Float (List (Pair Int8 Float)) + empty = EmptyPairInt8Float + cons x z = ConsPairInt8Float (fst x) (snd x) z + null EmptyPairInt8Float = True + null _ = False + head EmptyPairInt8Float = errorEmptyList "head" + head (ConsPairInt8Float x y _) = pair x y + tail EmptyPairInt8Float = errorEmptyList "tail" + tail (ConsPairInt8Float _ _ x) = x + +instance AdaptList (Pair Int8 Char) where + data List (Pair Int8 Char) + = EmptyPairInt8Char + | ConsPairInt8Char {-# UNPACK #-}!Int8 {-# UNPACK #-}!Char (List (Pair Int8 Char)) + empty = EmptyPairInt8Char + cons x z = ConsPairInt8Char (fst x) (snd x) z + null EmptyPairInt8Char = True + null _ = False + head EmptyPairInt8Char = errorEmptyList "head" + head (ConsPairInt8Char x y _) = pair x y + tail EmptyPairInt8Char = errorEmptyList "tail" + tail (ConsPairInt8Char _ _ x) = x + +instance AdaptList (Pair Int16 Int) where + data List (Pair Int16 Int) + = EmptyPairInt16Int + | ConsPairInt16Int {-# UNPACK #-}!Int16 {-# UNPACK #-}!Int (List (Pair Int16 Int)) + empty = EmptyPairInt16Int + cons x z = ConsPairInt16Int (fst x) (snd x) z + null EmptyPairInt16Int = True + null _ = False + head EmptyPairInt16Int = errorEmptyList "head" + head (ConsPairInt16Int x y _) = pair x y + tail EmptyPairInt16Int = errorEmptyList "tail" + tail (ConsPairInt16Int _ _ x) = x + +instance AdaptList (Pair Int16 Integer) where + data List (Pair Int16 Integer) + = EmptyPairInt16Integer + | ConsPairInt16Integer {-# UNPACK #-}!Int16 {-# UNPACK #-}!Integer (List (Pair Int16 Integer)) + empty = EmptyPairInt16Integer + cons x z = ConsPairInt16Integer (fst x) (snd x) z + null EmptyPairInt16Integer = True + null _ = False + head EmptyPairInt16Integer = errorEmptyList "head" + head (ConsPairInt16Integer x y _) = pair x y + tail EmptyPairInt16Integer = errorEmptyList "tail" + tail (ConsPairInt16Integer _ _ x) = x + +instance AdaptList (Pair Int16 Int8) where + data List (Pair Int16 Int8) + = EmptyPairInt16Int8 + | ConsPairInt16Int8 {-# UNPACK #-}!Int16 {-# UNPACK #-}!Int8 (List (Pair Int16 Int8)) + empty = EmptyPairInt16Int8 + cons x z = ConsPairInt16Int8 (fst x) (snd x) z + null EmptyPairInt16Int8 = True + null _ = False + head EmptyPairInt16Int8 = errorEmptyList "head" + head (ConsPairInt16Int8 x y _) = pair x y + tail EmptyPairInt16Int8 = errorEmptyList "tail" + tail (ConsPairInt16Int8 _ _ x) = x + +instance AdaptList (Pair Int16 Int16) where + data List (Pair Int16 Int16) + = EmptyPairInt16Int16 + | ConsPairInt16Int16 {-# UNPACK #-}!Int16 {-# UNPACK #-}!Int16 (List (Pair Int16 Int16)) + empty = EmptyPairInt16Int16 + cons x z = ConsPairInt16Int16 (fst x) (snd x) z + null EmptyPairInt16Int16 = True + null _ = False + head EmptyPairInt16Int16 = errorEmptyList "head" + head (ConsPairInt16Int16 x y _) = pair x y + tail EmptyPairInt16Int16 = errorEmptyList "tail" + tail (ConsPairInt16Int16 _ _ x) = x + +instance AdaptList (Pair Int16 Int32) where + data List (Pair Int16 Int32) + = EmptyPairInt16Int32 + | ConsPairInt16Int32 {-# UNPACK #-}!Int16 {-# UNPACK #-}!Int32 (List (Pair Int16 Int32)) + empty = EmptyPairInt16Int32 + cons x z = ConsPairInt16Int32 (fst x) (snd x) z + null EmptyPairInt16Int32 = True + null _ = False + head EmptyPairInt16Int32 = errorEmptyList "head" + head (ConsPairInt16Int32 x y _) = pair x y + tail EmptyPairInt16Int32 = errorEmptyList "tail" + tail (ConsPairInt16Int32 _ _ x) = x + +instance AdaptList (Pair Int16 Int64) where + data List (Pair Int16 Int64) + = EmptyPairInt16Int64 + | ConsPairInt16Int64 {-# UNPACK #-}!Int16 {-# UNPACK #-}!Int64 (List (Pair Int16 Int64)) + empty = EmptyPairInt16Int64 + cons x z = ConsPairInt16Int64 (fst x) (snd x) z + null EmptyPairInt16Int64 = True + null _ = False + head EmptyPairInt16Int64 = errorEmptyList "head" + head (ConsPairInt16Int64 x y _) = pair x y + tail EmptyPairInt16Int64 = errorEmptyList "tail" + tail (ConsPairInt16Int64 _ _ x) = x + +instance AdaptList (Pair Int16 Word) where + data List (Pair Int16 Word) + = EmptyPairInt16Word + | ConsPairInt16Word {-# UNPACK #-}!Int16 {-# UNPACK #-}!Word (List (Pair Int16 Word)) + empty = EmptyPairInt16Word + cons x z = ConsPairInt16Word (fst x) (snd x) z + null EmptyPairInt16Word = True + null _ = False + head EmptyPairInt16Word = errorEmptyList "head" + head (ConsPairInt16Word x y _) = pair x y + tail EmptyPairInt16Word = errorEmptyList "tail" + tail (ConsPairInt16Word _ _ x) = x + +instance AdaptList (Pair Int16 Word8) where + data List (Pair Int16 Word8) + = EmptyPairInt16Word8 + | ConsPairInt16Word8 {-# UNPACK #-}!Int16 {-# UNPACK #-}!Word8 (List (Pair Int16 Word8)) + empty = EmptyPairInt16Word8 + cons x z = ConsPairInt16Word8 (fst x) (snd x) z + null EmptyPairInt16Word8 = True + null _ = False + head EmptyPairInt16Word8 = errorEmptyList "head" + head (ConsPairInt16Word8 x y _) = pair x y + tail EmptyPairInt16Word8 = errorEmptyList "tail" + tail (ConsPairInt16Word8 _ _ x) = x + +instance AdaptList (Pair Int16 Word16) where + data List (Pair Int16 Word16) + = EmptyPairInt16Word16 + | ConsPairInt16Word16 {-# UNPACK #-}!Int16 {-# UNPACK #-}!Word16 (List (Pair Int16 Word16)) + empty = EmptyPairInt16Word16 + cons x z = ConsPairInt16Word16 (fst x) (snd x) z + null EmptyPairInt16Word16 = True + null _ = False + head EmptyPairInt16Word16 = errorEmptyList "head" + head (ConsPairInt16Word16 x y _) = pair x y + tail EmptyPairInt16Word16 = errorEmptyList "tail" + tail (ConsPairInt16Word16 _ _ x) = x + +instance AdaptList (Pair Int16 Word32) where + data List (Pair Int16 Word32) + = EmptyPairInt16Word32 + | ConsPairInt16Word32 {-# UNPACK #-}!Int16 {-# UNPACK #-}!Word32 (List (Pair Int16 Word32)) + empty = EmptyPairInt16Word32 + cons x z = ConsPairInt16Word32 (fst x) (snd x) z + null EmptyPairInt16Word32 = True + null _ = False + head EmptyPairInt16Word32 = errorEmptyList "head" + head (ConsPairInt16Word32 x y _) = pair x y + tail EmptyPairInt16Word32 = errorEmptyList "tail" + tail (ConsPairInt16Word32 _ _ x) = x + +instance AdaptList (Pair Int16 Word64) where + data List (Pair Int16 Word64) + = EmptyPairInt16Word64 + | ConsPairInt16Word64 {-# UNPACK #-}!Int16 {-# UNPACK #-}!Word64 (List (Pair Int16 Word64)) + empty = EmptyPairInt16Word64 + cons x z = ConsPairInt16Word64 (fst x) (snd x) z + null EmptyPairInt16Word64 = True + null _ = False + head EmptyPairInt16Word64 = errorEmptyList "head" + head (ConsPairInt16Word64 x y _) = pair x y + tail EmptyPairInt16Word64 = errorEmptyList "tail" + tail (ConsPairInt16Word64 _ _ x) = x + +instance AdaptList (Pair Int16 Double) where + data List (Pair Int16 Double) + = EmptyPairInt16Double + | ConsPairInt16Double {-# UNPACK #-}!Int16 {-# UNPACK #-}!Double (List (Pair Int16 Double)) + empty = EmptyPairInt16Double + cons x z = ConsPairInt16Double (fst x) (snd x) z + null EmptyPairInt16Double = True + null _ = False + head EmptyPairInt16Double = errorEmptyList "head" + head (ConsPairInt16Double x y _) = pair x y + tail EmptyPairInt16Double = errorEmptyList "tail" + tail (ConsPairInt16Double _ _ x) = x + +instance AdaptList (Pair Int16 Float) where + data List (Pair Int16 Float) + = EmptyPairInt16Float + | ConsPairInt16Float {-# UNPACK #-}!Int16 {-# UNPACK #-}!Float (List (Pair Int16 Float)) + empty = EmptyPairInt16Float + cons x z = ConsPairInt16Float (fst x) (snd x) z + null EmptyPairInt16Float = True + null _ = False + head EmptyPairInt16Float = errorEmptyList "head" + head (ConsPairInt16Float x y _) = pair x y + tail EmptyPairInt16Float = errorEmptyList "tail" + tail (ConsPairInt16Float _ _ x) = x + +instance AdaptList (Pair Int16 Char) where + data List (Pair Int16 Char) + = EmptyPairInt16Char + | ConsPairInt16Char {-# UNPACK #-}!Int16 {-# UNPACK #-}!Char (List (Pair Int16 Char)) + empty = EmptyPairInt16Char + cons x z = ConsPairInt16Char (fst x) (snd x) z + null EmptyPairInt16Char = True + null _ = False + head EmptyPairInt16Char = errorEmptyList "head" + head (ConsPairInt16Char x y _) = pair x y + tail EmptyPairInt16Char = errorEmptyList "tail" + tail (ConsPairInt16Char _ _ x) = x + +instance AdaptList (Pair Int32 Int) where + data List (Pair Int32 Int) + = EmptyPairInt32Int + | ConsPairInt32Int {-# UNPACK #-}!Int32 {-# UNPACK #-}!Int (List (Pair Int32 Int)) + empty = EmptyPairInt32Int + cons x z = ConsPairInt32Int (fst x) (snd x) z + null EmptyPairInt32Int = True + null _ = False + head EmptyPairInt32Int = errorEmptyList "head" + head (ConsPairInt32Int x y _) = pair x y + tail EmptyPairInt32Int = errorEmptyList "tail" + tail (ConsPairInt32Int _ _ x) = x + +instance AdaptList (Pair Int32 Integer) where + data List (Pair Int32 Integer) + = EmptyPairInt32Integer + | ConsPairInt32Integer {-# UNPACK #-}!Int32 {-# UNPACK #-}!Integer (List (Pair Int32 Integer)) + empty = EmptyPairInt32Integer + cons x z = ConsPairInt32Integer (fst x) (snd x) z + null EmptyPairInt32Integer = True + null _ = False + head EmptyPairInt32Integer = errorEmptyList "head" + head (ConsPairInt32Integer x y _) = pair x y + tail EmptyPairInt32Integer = errorEmptyList "tail" + tail (ConsPairInt32Integer _ _ x) = x + +instance AdaptList (Pair Int32 Int8) where + data List (Pair Int32 Int8) + = EmptyPairInt32Int8 + | ConsPairInt32Int8 {-# UNPACK #-}!Int32 {-# UNPACK #-}!Int8 (List (Pair Int32 Int8)) + empty = EmptyPairInt32Int8 + cons x z = ConsPairInt32Int8 (fst x) (snd x) z + null EmptyPairInt32Int8 = True + null _ = False + head EmptyPairInt32Int8 = errorEmptyList "head" + head (ConsPairInt32Int8 x y _) = pair x y + tail EmptyPairInt32Int8 = errorEmptyList "tail" + tail (ConsPairInt32Int8 _ _ x) = x + +instance AdaptList (Pair Int32 Int16) where + data List (Pair Int32 Int16) + = EmptyPairInt32Int16 + | ConsPairInt32Int16 {-# UNPACK #-}!Int32 {-# UNPACK #-}!Int16 (List (Pair Int32 Int16)) + empty = EmptyPairInt32Int16 + cons x z = ConsPairInt32Int16 (fst x) (snd x) z + null EmptyPairInt32Int16 = True + null _ = False + head EmptyPairInt32Int16 = errorEmptyList "head" + head (ConsPairInt32Int16 x y _) = pair x y + tail EmptyPairInt32Int16 = errorEmptyList "tail" + tail (ConsPairInt32Int16 _ _ x) = x + +instance AdaptList (Pair Int32 Int32) where + data List (Pair Int32 Int32) + = EmptyPairInt32Int32 + | ConsPairInt32Int32 {-# UNPACK #-}!Int32 {-# UNPACK #-}!Int32 (List (Pair Int32 Int32)) + empty = EmptyPairInt32Int32 + cons x z = ConsPairInt32Int32 (fst x) (snd x) z + null EmptyPairInt32Int32 = True + null _ = False + head EmptyPairInt32Int32 = errorEmptyList "head" + head (ConsPairInt32Int32 x y _) = pair x y + tail EmptyPairInt32Int32 = errorEmptyList "tail" + tail (ConsPairInt32Int32 _ _ x) = x + +instance AdaptList (Pair Int32 Int64) where + data List (Pair Int32 Int64) + = EmptyPairInt32Int64 + | ConsPairInt32Int64 {-# UNPACK #-}!Int32 {-# UNPACK #-}!Int64 (List (Pair Int32 Int64)) + empty = EmptyPairInt32Int64 + cons x z = ConsPairInt32Int64 (fst x) (snd x) z + null EmptyPairInt32Int64 = True + null _ = False + head EmptyPairInt32Int64 = errorEmptyList "head" + head (ConsPairInt32Int64 x y _) = pair x y + tail EmptyPairInt32Int64 = errorEmptyList "tail" + tail (ConsPairInt32Int64 _ _ x) = x + +instance AdaptList (Pair Int32 Word) where + data List (Pair Int32 Word) + = EmptyPairInt32Word + | ConsPairInt32Word {-# UNPACK #-}!Int32 {-# UNPACK #-}!Word (List (Pair Int32 Word)) + empty = EmptyPairInt32Word + cons x z = ConsPairInt32Word (fst x) (snd x) z + null EmptyPairInt32Word = True + null _ = False + head EmptyPairInt32Word = errorEmptyList "head" + head (ConsPairInt32Word x y _) = pair x y + tail EmptyPairInt32Word = errorEmptyList "tail" + tail (ConsPairInt32Word _ _ x) = x + +instance AdaptList (Pair Int32 Word8) where + data List (Pair Int32 Word8) + = EmptyPairInt32Word8 + | ConsPairInt32Word8 {-# UNPACK #-}!Int32 {-# UNPACK #-}!Word8 (List (Pair Int32 Word8)) + empty = EmptyPairInt32Word8 + cons x z = ConsPairInt32Word8 (fst x) (snd x) z + null EmptyPairInt32Word8 = True + null _ = False + head EmptyPairInt32Word8 = errorEmptyList "head" + head (ConsPairInt32Word8 x y _) = pair x y + tail EmptyPairInt32Word8 = errorEmptyList "tail" + tail (ConsPairInt32Word8 _ _ x) = x + +instance AdaptList (Pair Int32 Word16) where + data List (Pair Int32 Word16) + = EmptyPairInt32Word16 + | ConsPairInt32Word16 {-# UNPACK #-}!Int32 {-# UNPACK #-}!Word16 (List (Pair Int32 Word16)) + empty = EmptyPairInt32Word16 + cons x z = ConsPairInt32Word16 (fst x) (snd x) z + null EmptyPairInt32Word16 = True + null _ = False + head EmptyPairInt32Word16 = errorEmptyList "head" + head (ConsPairInt32Word16 x y _) = pair x y + tail EmptyPairInt32Word16 = errorEmptyList "tail" + tail (ConsPairInt32Word16 _ _ x) = x + +instance AdaptList (Pair Int32 Word32) where + data List (Pair Int32 Word32) + = EmptyPairInt32Word32 + | ConsPairInt32Word32 {-# UNPACK #-}!Int32 {-# UNPACK #-}!Word32 (List (Pair Int32 Word32)) + empty = EmptyPairInt32Word32 + cons x z = ConsPairInt32Word32 (fst x) (snd x) z + null EmptyPairInt32Word32 = True + null _ = False + head EmptyPairInt32Word32 = errorEmptyList "head" + head (ConsPairInt32Word32 x y _) = pair x y + tail EmptyPairInt32Word32 = errorEmptyList "tail" + tail (ConsPairInt32Word32 _ _ x) = x + +instance AdaptList (Pair Int32 Word64) where + data List (Pair Int32 Word64) + = EmptyPairInt32Word64 + | ConsPairInt32Word64 {-# UNPACK #-}!Int32 {-# UNPACK #-}!Word64 (List (Pair Int32 Word64)) + empty = EmptyPairInt32Word64 + cons x z = ConsPairInt32Word64 (fst x) (snd x) z + null EmptyPairInt32Word64 = True + null _ = False + head EmptyPairInt32Word64 = errorEmptyList "head" + head (ConsPairInt32Word64 x y _) = pair x y + tail EmptyPairInt32Word64 = errorEmptyList "tail" + tail (ConsPairInt32Word64 _ _ x) = x + +instance AdaptList (Pair Int32 Double) where + data List (Pair Int32 Double) + = EmptyPairInt32Double + | ConsPairInt32Double {-# UNPACK #-}!Int32 {-# UNPACK #-}!Double (List (Pair Int32 Double)) + empty = EmptyPairInt32Double + cons x z = ConsPairInt32Double (fst x) (snd x) z + null EmptyPairInt32Double = True + null _ = False + head EmptyPairInt32Double = errorEmptyList "head" + head (ConsPairInt32Double x y _) = pair x y + tail EmptyPairInt32Double = errorEmptyList "tail" + tail (ConsPairInt32Double _ _ x) = x + +instance AdaptList (Pair Int32 Float) where + data List (Pair Int32 Float) + = EmptyPairInt32Float + | ConsPairInt32Float {-# UNPACK #-}!Int32 {-# UNPACK #-}!Float (List (Pair Int32 Float)) + empty = EmptyPairInt32Float + cons x z = ConsPairInt32Float (fst x) (snd x) z + null EmptyPairInt32Float = True + null _ = False + head EmptyPairInt32Float = errorEmptyList "head" + head (ConsPairInt32Float x y _) = pair x y + tail EmptyPairInt32Float = errorEmptyList "tail" + tail (ConsPairInt32Float _ _ x) = x + +instance AdaptList (Pair Int32 Char) where + data List (Pair Int32 Char) + = EmptyPairInt32Char + | ConsPairInt32Char {-# UNPACK #-}!Int32 {-# UNPACK #-}!Char (List (Pair Int32 Char)) + empty = EmptyPairInt32Char + cons x z = ConsPairInt32Char (fst x) (snd x) z + null EmptyPairInt32Char = True + null _ = False + head EmptyPairInt32Char = errorEmptyList "head" + head (ConsPairInt32Char x y _) = pair x y + tail EmptyPairInt32Char = errorEmptyList "tail" + tail (ConsPairInt32Char _ _ x) = x + +instance AdaptList (Pair Int64 Int) where + data List (Pair Int64 Int) + = EmptyPairInt64Int + | ConsPairInt64Int {-# UNPACK #-}!Int64 {-# UNPACK #-}!Int (List (Pair Int64 Int)) + empty = EmptyPairInt64Int + cons x z = ConsPairInt64Int (fst x) (snd x) z + null EmptyPairInt64Int = True + null _ = False + head EmptyPairInt64Int = errorEmptyList "head" + head (ConsPairInt64Int x y _) = pair x y + tail EmptyPairInt64Int = errorEmptyList "tail" + tail (ConsPairInt64Int _ _ x) = x + +instance AdaptList (Pair Int64 Integer) where + data List (Pair Int64 Integer) + = EmptyPairInt64Integer + | ConsPairInt64Integer {-# UNPACK #-}!Int64 {-# UNPACK #-}!Integer (List (Pair Int64 Integer)) + empty = EmptyPairInt64Integer + cons x z = ConsPairInt64Integer (fst x) (snd x) z + null EmptyPairInt64Integer = True + null _ = False + head EmptyPairInt64Integer = errorEmptyList "head" + head (ConsPairInt64Integer x y _) = pair x y + tail EmptyPairInt64Integer = errorEmptyList "tail" + tail (ConsPairInt64Integer _ _ x) = x + +instance AdaptList (Pair Int64 Int8) where + data List (Pair Int64 Int8) + = EmptyPairInt64Int8 + | ConsPairInt64Int8 {-# UNPACK #-}!Int64 {-# UNPACK #-}!Int8 (List (Pair Int64 Int8)) + empty = EmptyPairInt64Int8 + cons x z = ConsPairInt64Int8 (fst x) (snd x) z + null EmptyPairInt64Int8 = True + null _ = False + head EmptyPairInt64Int8 = errorEmptyList "head" + head (ConsPairInt64Int8 x y _) = pair x y + tail EmptyPairInt64Int8 = errorEmptyList "tail" + tail (ConsPairInt64Int8 _ _ x) = x + +instance AdaptList (Pair Int64 Int16) where + data List (Pair Int64 Int16) + = EmptyPairInt64Int16 + | ConsPairInt64Int16 {-# UNPACK #-}!Int64 {-# UNPACK #-}!Int16 (List (Pair Int64 Int16)) + empty = EmptyPairInt64Int16 + cons x z = ConsPairInt64Int16 (fst x) (snd x) z + null EmptyPairInt64Int16 = True + null _ = False + head EmptyPairInt64Int16 = errorEmptyList "head" + head (ConsPairInt64Int16 x y _) = pair x y + tail EmptyPairInt64Int16 = errorEmptyList "tail" + tail (ConsPairInt64Int16 _ _ x) = x + +instance AdaptList (Pair Int64 Int32) where + data List (Pair Int64 Int32) + = EmptyPairInt64Int32 + | ConsPairInt64Int32 {-# UNPACK #-}!Int64 {-# UNPACK #-}!Int32 (List (Pair Int64 Int32)) + empty = EmptyPairInt64Int32 + cons x z = ConsPairInt64Int32 (fst x) (snd x) z + null EmptyPairInt64Int32 = True + null _ = False + head EmptyPairInt64Int32 = errorEmptyList "head" + head (ConsPairInt64Int32 x y _) = pair x y + tail EmptyPairInt64Int32 = errorEmptyList "tail" + tail (ConsPairInt64Int32 _ _ x) = x + +instance AdaptList (Pair Int64 Int64) where + data List (Pair Int64 Int64) + = EmptyPairInt64Int64 + | ConsPairInt64Int64 {-# UNPACK #-}!Int64 {-# UNPACK #-}!Int64 (List (Pair Int64 Int64)) + empty = EmptyPairInt64Int64 + cons x z = ConsPairInt64Int64 (fst x) (snd x) z + null EmptyPairInt64Int64 = True + null _ = False + head EmptyPairInt64Int64 = errorEmptyList "head" + head (ConsPairInt64Int64 x y _) = pair x y + tail EmptyPairInt64Int64 = errorEmptyList "tail" + tail (ConsPairInt64Int64 _ _ x) = x + +instance AdaptList (Pair Int64 Word) where + data List (Pair Int64 Word) + = EmptyPairInt64Word + | ConsPairInt64Word {-# UNPACK #-}!Int64 {-# UNPACK #-}!Word (List (Pair Int64 Word)) + empty = EmptyPairInt64Word + cons x z = ConsPairInt64Word (fst x) (snd x) z + null EmptyPairInt64Word = True + null _ = False + head EmptyPairInt64Word = errorEmptyList "head" + head (ConsPairInt64Word x y _) = pair x y + tail EmptyPairInt64Word = errorEmptyList "tail" + tail (ConsPairInt64Word _ _ x) = x + +instance AdaptList (Pair Int64 Word8) where + data List (Pair Int64 Word8) + = EmptyPairInt64Word8 + | ConsPairInt64Word8 {-# UNPACK #-}!Int64 {-# UNPACK #-}!Word8 (List (Pair Int64 Word8)) + empty = EmptyPairInt64Word8 + cons x z = ConsPairInt64Word8 (fst x) (snd x) z + null EmptyPairInt64Word8 = True + null _ = False + head EmptyPairInt64Word8 = errorEmptyList "head" + head (ConsPairInt64Word8 x y _) = pair x y + tail EmptyPairInt64Word8 = errorEmptyList "tail" + tail (ConsPairInt64Word8 _ _ x) = x + +instance AdaptList (Pair Int64 Word16) where + data List (Pair Int64 Word16) + = EmptyPairInt64Word16 + | ConsPairInt64Word16 {-# UNPACK #-}!Int64 {-# UNPACK #-}!Word16 (List (Pair Int64 Word16)) + empty = EmptyPairInt64Word16 + cons x z = ConsPairInt64Word16 (fst x) (snd x) z + null EmptyPairInt64Word16 = True + null _ = False + head EmptyPairInt64Word16 = errorEmptyList "head" + head (ConsPairInt64Word16 x y _) = pair x y + tail EmptyPairInt64Word16 = errorEmptyList "tail" + tail (ConsPairInt64Word16 _ _ x) = x + +instance AdaptList (Pair Int64 Word32) where + data List (Pair Int64 Word32) + = EmptyPairInt64Word32 + | ConsPairInt64Word32 {-# UNPACK #-}!Int64 {-# UNPACK #-}!Word32 (List (Pair Int64 Word32)) + empty = EmptyPairInt64Word32 + cons x z = ConsPairInt64Word32 (fst x) (snd x) z + null EmptyPairInt64Word32 = True + null _ = False + head EmptyPairInt64Word32 = errorEmptyList "head" + head (ConsPairInt64Word32 x y _) = pair x y + tail EmptyPairInt64Word32 = errorEmptyList "tail" + tail (ConsPairInt64Word32 _ _ x) = x + +instance AdaptList (Pair Int64 Word64) where + data List (Pair Int64 Word64) + = EmptyPairInt64Word64 + | ConsPairInt64Word64 {-# UNPACK #-}!Int64 {-# UNPACK #-}!Word64 (List (Pair Int64 Word64)) + empty = EmptyPairInt64Word64 + cons x z = ConsPairInt64Word64 (fst x) (snd x) z + null EmptyPairInt64Word64 = True + null _ = False + head EmptyPairInt64Word64 = errorEmptyList "head" + head (ConsPairInt64Word64 x y _) = pair x y + tail EmptyPairInt64Word64 = errorEmptyList "tail" + tail (ConsPairInt64Word64 _ _ x) = x + +instance AdaptList (Pair Int64 Double) where + data List (Pair Int64 Double) + = EmptyPairInt64Double + | ConsPairInt64Double {-# UNPACK #-}!Int64 {-# UNPACK #-}!Double (List (Pair Int64 Double)) + empty = EmptyPairInt64Double + cons x z = ConsPairInt64Double (fst x) (snd x) z + null EmptyPairInt64Double = True + null _ = False + head EmptyPairInt64Double = errorEmptyList "head" + head (ConsPairInt64Double x y _) = pair x y + tail EmptyPairInt64Double = errorEmptyList "tail" + tail (ConsPairInt64Double _ _ x) = x + +instance AdaptList (Pair Int64 Float) where + data List (Pair Int64 Float) + = EmptyPairInt64Float + | ConsPairInt64Float {-# UNPACK #-}!Int64 {-# UNPACK #-}!Float (List (Pair Int64 Float)) + empty = EmptyPairInt64Float + cons x z = ConsPairInt64Float (fst x) (snd x) z + null EmptyPairInt64Float = True + null _ = False + head EmptyPairInt64Float = errorEmptyList "head" + head (ConsPairInt64Float x y _) = pair x y + tail EmptyPairInt64Float = errorEmptyList "tail" + tail (ConsPairInt64Float _ _ x) = x + +instance AdaptList (Pair Int64 Char) where + data List (Pair Int64 Char) + = EmptyPairInt64Char + | ConsPairInt64Char {-# UNPACK #-}!Int64 {-# UNPACK #-}!Char (List (Pair Int64 Char)) + empty = EmptyPairInt64Char + cons x z = ConsPairInt64Char (fst x) (snd x) z + null EmptyPairInt64Char = True + null _ = False + head EmptyPairInt64Char = errorEmptyList "head" + head (ConsPairInt64Char x y _) = pair x y + tail EmptyPairInt64Char = errorEmptyList "tail" + tail (ConsPairInt64Char _ _ x) = x + +instance AdaptList (Pair Word Int) where + data List (Pair Word Int) + = EmptyPairWordInt + | ConsPairWordInt {-# UNPACK #-}!Word {-# UNPACK #-}!Int (List (Pair Word Int)) + empty = EmptyPairWordInt + cons x z = ConsPairWordInt (fst x) (snd x) z + null EmptyPairWordInt = True + null _ = False + head EmptyPairWordInt = errorEmptyList "head" + head (ConsPairWordInt x y _) = pair x y + tail EmptyPairWordInt = errorEmptyList "tail" + tail (ConsPairWordInt _ _ x) = x + +instance AdaptList (Pair Word Integer) where + data List (Pair Word Integer) + = EmptyPairWordInteger + | ConsPairWordInteger {-# UNPACK #-}!Word {-# UNPACK #-}!Integer (List (Pair Word Integer)) + empty = EmptyPairWordInteger + cons x z = ConsPairWordInteger (fst x) (snd x) z + null EmptyPairWordInteger = True + null _ = False + head EmptyPairWordInteger = errorEmptyList "head" + head (ConsPairWordInteger x y _) = pair x y + tail EmptyPairWordInteger = errorEmptyList "tail" + tail (ConsPairWordInteger _ _ x) = x + +instance AdaptList (Pair Word Int8) where + data List (Pair Word Int8) + = EmptyPairWordInt8 + | ConsPairWordInt8 {-# UNPACK #-}!Word {-# UNPACK #-}!Int8 (List (Pair Word Int8)) + empty = EmptyPairWordInt8 + cons x z = ConsPairWordInt8 (fst x) (snd x) z + null EmptyPairWordInt8 = True + null _ = False + head EmptyPairWordInt8 = errorEmptyList "head" + head (ConsPairWordInt8 x y _) = pair x y + tail EmptyPairWordInt8 = errorEmptyList "tail" + tail (ConsPairWordInt8 _ _ x) = x + +instance AdaptList (Pair Word Int16) where + data List (Pair Word Int16) + = EmptyPairWordInt16 + | ConsPairWordInt16 {-# UNPACK #-}!Word {-# UNPACK #-}!Int16 (List (Pair Word Int16)) + empty = EmptyPairWordInt16 + cons x z = ConsPairWordInt16 (fst x) (snd x) z + null EmptyPairWordInt16 = True + null _ = False + head EmptyPairWordInt16 = errorEmptyList "head" + head (ConsPairWordInt16 x y _) = pair x y + tail EmptyPairWordInt16 = errorEmptyList "tail" + tail (ConsPairWordInt16 _ _ x) = x + +instance AdaptList (Pair Word Int32) where + data List (Pair Word Int32) + = EmptyPairWordInt32 + | ConsPairWordInt32 {-# UNPACK #-}!Word {-# UNPACK #-}!Int32 (List (Pair Word Int32)) + empty = EmptyPairWordInt32 + cons x z = ConsPairWordInt32 (fst x) (snd x) z + null EmptyPairWordInt32 = True + null _ = False + head EmptyPairWordInt32 = errorEmptyList "head" + head (ConsPairWordInt32 x y _) = pair x y + tail EmptyPairWordInt32 = errorEmptyList "tail" + tail (ConsPairWordInt32 _ _ x) = x + +instance AdaptList (Pair Word Int64) where + data List (Pair Word Int64) + = EmptyPairWordInt64 + | ConsPairWordInt64 {-# UNPACK #-}!Word {-# UNPACK #-}!Int64 (List (Pair Word Int64)) + empty = EmptyPairWordInt64 + cons x z = ConsPairWordInt64 (fst x) (snd x) z + null EmptyPairWordInt64 = True + null _ = False + head EmptyPairWordInt64 = errorEmptyList "head" + head (ConsPairWordInt64 x y _) = pair x y + tail EmptyPairWordInt64 = errorEmptyList "tail" + tail (ConsPairWordInt64 _ _ x) = x + +instance AdaptList (Pair Word Word) where + data List (Pair Word Word) + = EmptyPairWordWord + | ConsPairWordWord {-# UNPACK #-}!Word {-# UNPACK #-}!Word (List (Pair Word Word)) + empty = EmptyPairWordWord + cons x z = ConsPairWordWord (fst x) (snd x) z + null EmptyPairWordWord = True + null _ = False + head EmptyPairWordWord = errorEmptyList "head" + head (ConsPairWordWord x y _) = pair x y + tail EmptyPairWordWord = errorEmptyList "tail" + tail (ConsPairWordWord _ _ x) = x + +instance AdaptList (Pair Word Word8) where + data List (Pair Word Word8) + = EmptyPairWordWord8 + | ConsPairWordWord8 {-# UNPACK #-}!Word {-# UNPACK #-}!Word8 (List (Pair Word Word8)) + empty = EmptyPairWordWord8 + cons x z = ConsPairWordWord8 (fst x) (snd x) z + null EmptyPairWordWord8 = True + null _ = False + head EmptyPairWordWord8 = errorEmptyList "head" + head (ConsPairWordWord8 x y _) = pair x y + tail EmptyPairWordWord8 = errorEmptyList "tail" + tail (ConsPairWordWord8 _ _ x) = x + +instance AdaptList (Pair Word Word16) where + data List (Pair Word Word16) + = EmptyPairWordWord16 + | ConsPairWordWord16 {-# UNPACK #-}!Word {-# UNPACK #-}!Word16 (List (Pair Word Word16)) + empty = EmptyPairWordWord16 + cons x z = ConsPairWordWord16 (fst x) (snd x) z + null EmptyPairWordWord16 = True + null _ = False + head EmptyPairWordWord16 = errorEmptyList "head" + head (ConsPairWordWord16 x y _) = pair x y + tail EmptyPairWordWord16 = errorEmptyList "tail" + tail (ConsPairWordWord16 _ _ x) = x + +instance AdaptList (Pair Word Word32) where + data List (Pair Word Word32) + = EmptyPairWordWord32 + | ConsPairWordWord32 {-# UNPACK #-}!Word {-# UNPACK #-}!Word32 (List (Pair Word Word32)) + empty = EmptyPairWordWord32 + cons x z = ConsPairWordWord32 (fst x) (snd x) z + null EmptyPairWordWord32 = True + null _ = False + head EmptyPairWordWord32 = errorEmptyList "head" + head (ConsPairWordWord32 x y _) = pair x y + tail EmptyPairWordWord32 = errorEmptyList "tail" + tail (ConsPairWordWord32 _ _ x) = x + +instance AdaptList (Pair Word Word64) where + data List (Pair Word Word64) + = EmptyPairWordWord64 + | ConsPairWordWord64 {-# UNPACK #-}!Word {-# UNPACK #-}!Word64 (List (Pair Word Word64)) + empty = EmptyPairWordWord64 + cons x z = ConsPairWordWord64 (fst x) (snd x) z + null EmptyPairWordWord64 = True + null _ = False + head EmptyPairWordWord64 = errorEmptyList "head" + head (ConsPairWordWord64 x y _) = pair x y + tail EmptyPairWordWord64 = errorEmptyList "tail" + tail (ConsPairWordWord64 _ _ x) = x + +instance AdaptList (Pair Word Double) where + data List (Pair Word Double) + = EmptyPairWordDouble + | ConsPairWordDouble {-# UNPACK #-}!Word {-# UNPACK #-}!Double (List (Pair Word Double)) + empty = EmptyPairWordDouble + cons x z = ConsPairWordDouble (fst x) (snd x) z + null EmptyPairWordDouble = True + null _ = False + head EmptyPairWordDouble = errorEmptyList "head" + head (ConsPairWordDouble x y _) = pair x y + tail EmptyPairWordDouble = errorEmptyList "tail" + tail (ConsPairWordDouble _ _ x) = x + +instance AdaptList (Pair Word Float) where + data List (Pair Word Float) + = EmptyPairWordFloat + | ConsPairWordFloat {-# UNPACK #-}!Word {-# UNPACK #-}!Float (List (Pair Word Float)) + empty = EmptyPairWordFloat + cons x z = ConsPairWordFloat (fst x) (snd x) z + null EmptyPairWordFloat = True + null _ = False + head EmptyPairWordFloat = errorEmptyList "head" + head (ConsPairWordFloat x y _) = pair x y + tail EmptyPairWordFloat = errorEmptyList "tail" + tail (ConsPairWordFloat _ _ x) = x + +instance AdaptList (Pair Word Char) where + data List (Pair Word Char) + = EmptyPairWordChar + | ConsPairWordChar {-# UNPACK #-}!Word {-# UNPACK #-}!Char (List (Pair Word Char)) + empty = EmptyPairWordChar + cons x z = ConsPairWordChar (fst x) (snd x) z + null EmptyPairWordChar = True + null _ = False + head EmptyPairWordChar = errorEmptyList "head" + head (ConsPairWordChar x y _) = pair x y + tail EmptyPairWordChar = errorEmptyList "tail" + tail (ConsPairWordChar _ _ x) = x + +instance AdaptList (Pair Word8 Int) where + data List (Pair Word8 Int) + = EmptyPairWord8Int + | ConsPairWord8Int {-# UNPACK #-}!Word8 {-# UNPACK #-}!Int (List (Pair Word8 Int)) + empty = EmptyPairWord8Int + cons x z = ConsPairWord8Int (fst x) (snd x) z + null EmptyPairWord8Int = True + null _ = False + head EmptyPairWord8Int = errorEmptyList "head" + head (ConsPairWord8Int x y _) = pair x y + tail EmptyPairWord8Int = errorEmptyList "tail" + tail (ConsPairWord8Int _ _ x) = x + +instance AdaptList (Pair Word8 Integer) where + data List (Pair Word8 Integer) + = EmptyPairWord8Integer + | ConsPairWord8Integer {-# UNPACK #-}!Word8 {-# UNPACK #-}!Integer (List (Pair Word8 Integer)) + empty = EmptyPairWord8Integer + cons x z = ConsPairWord8Integer (fst x) (snd x) z + null EmptyPairWord8Integer = True + null _ = False + head EmptyPairWord8Integer = errorEmptyList "head" + head (ConsPairWord8Integer x y _) = pair x y + tail EmptyPairWord8Integer = errorEmptyList "tail" + tail (ConsPairWord8Integer _ _ x) = x + +instance AdaptList (Pair Word8 Int8) where + data List (Pair Word8 Int8) + = EmptyPairWord8Int8 + | ConsPairWord8Int8 {-# UNPACK #-}!Word8 {-# UNPACK #-}!Int8 (List (Pair Word8 Int8)) + empty = EmptyPairWord8Int8 + cons x z = ConsPairWord8Int8 (fst x) (snd x) z + null EmptyPairWord8Int8 = True + null _ = False + head EmptyPairWord8Int8 = errorEmptyList "head" + head (ConsPairWord8Int8 x y _) = pair x y + tail EmptyPairWord8Int8 = errorEmptyList "tail" + tail (ConsPairWord8Int8 _ _ x) = x + +instance AdaptList (Pair Word8 Int16) where + data List (Pair Word8 Int16) + = EmptyPairWord8Int16 + | ConsPairWord8Int16 {-# UNPACK #-}!Word8 {-# UNPACK #-}!Int16 (List (Pair Word8 Int16)) + empty = EmptyPairWord8Int16 + cons x z = ConsPairWord8Int16 (fst x) (snd x) z + null EmptyPairWord8Int16 = True + null _ = False + head EmptyPairWord8Int16 = errorEmptyList "head" + head (ConsPairWord8Int16 x y _) = pair x y + tail EmptyPairWord8Int16 = errorEmptyList "tail" + tail (ConsPairWord8Int16 _ _ x) = x + +instance AdaptList (Pair Word8 Int32) where + data List (Pair Word8 Int32) + = EmptyPairWord8Int32 + | ConsPairWord8Int32 {-# UNPACK #-}!Word8 {-# UNPACK #-}!Int32 (List (Pair Word8 Int32)) + empty = EmptyPairWord8Int32 + cons x z = ConsPairWord8Int32 (fst x) (snd x) z + null EmptyPairWord8Int32 = True + null _ = False + head EmptyPairWord8Int32 = errorEmptyList "head" + head (ConsPairWord8Int32 x y _) = pair x y + tail EmptyPairWord8Int32 = errorEmptyList "tail" + tail (ConsPairWord8Int32 _ _ x) = x + +instance AdaptList (Pair Word8 Int64) where + data List (Pair Word8 Int64) + = EmptyPairWord8Int64 + | ConsPairWord8Int64 {-# UNPACK #-}!Word8 {-# UNPACK #-}!Int64 (List (Pair Word8 Int64)) + empty = EmptyPairWord8Int64 + cons x z = ConsPairWord8Int64 (fst x) (snd x) z + null EmptyPairWord8Int64 = True + null _ = False + head EmptyPairWord8Int64 = errorEmptyList "head" + head (ConsPairWord8Int64 x y _) = pair x y + tail EmptyPairWord8Int64 = errorEmptyList "tail" + tail (ConsPairWord8Int64 _ _ x) = x + +instance AdaptList (Pair Word8 Word) where + data List (Pair Word8 Word) + = EmptyPairWord8Word + | ConsPairWord8Word {-# UNPACK #-}!Word8 {-# UNPACK #-}!Word (List (Pair Word8 Word)) + empty = EmptyPairWord8Word + cons x z = ConsPairWord8Word (fst x) (snd x) z + null EmptyPairWord8Word = True + null _ = False + head EmptyPairWord8Word = errorEmptyList "head" + head (ConsPairWord8Word x y _) = pair x y + tail EmptyPairWord8Word = errorEmptyList "tail" + tail (ConsPairWord8Word _ _ x) = x + +instance AdaptList (Pair Word8 Word8) where + data List (Pair Word8 Word8) + = EmptyPairWord8Word8 + | ConsPairWord8Word8 {-# UNPACK #-}!Word8 {-# UNPACK #-}!Word8 (List (Pair Word8 Word8)) + empty = EmptyPairWord8Word8 + cons x z = ConsPairWord8Word8 (fst x) (snd x) z + null EmptyPairWord8Word8 = True + null _ = False + head EmptyPairWord8Word8 = errorEmptyList "head" + head (ConsPairWord8Word8 x y _) = pair x y + tail EmptyPairWord8Word8 = errorEmptyList "tail" + tail (ConsPairWord8Word8 _ _ x) = x + +instance AdaptList (Pair Word8 Word16) where + data List (Pair Word8 Word16) + = EmptyPairWord8Word16 + | ConsPairWord8Word16 {-# UNPACK #-}!Word8 {-# UNPACK #-}!Word16 (List (Pair Word8 Word16)) + empty = EmptyPairWord8Word16 + cons x z = ConsPairWord8Word16 (fst x) (snd x) z + null EmptyPairWord8Word16 = True + null _ = False + head EmptyPairWord8Word16 = errorEmptyList "head" + head (ConsPairWord8Word16 x y _) = pair x y + tail EmptyPairWord8Word16 = errorEmptyList "tail" + tail (ConsPairWord8Word16 _ _ x) = x + +instance AdaptList (Pair Word8 Word32) where + data List (Pair Word8 Word32) + = EmptyPairWord8Word32 + | ConsPairWord8Word32 {-# UNPACK #-}!Word8 {-# UNPACK #-}!Word32 (List (Pair Word8 Word32)) + empty = EmptyPairWord8Word32 + cons x z = ConsPairWord8Word32 (fst x) (snd x) z + null EmptyPairWord8Word32 = True + null _ = False + head EmptyPairWord8Word32 = errorEmptyList "head" + head (ConsPairWord8Word32 x y _) = pair x y + tail EmptyPairWord8Word32 = errorEmptyList "tail" + tail (ConsPairWord8Word32 _ _ x) = x + +instance AdaptList (Pair Word8 Word64) where + data List (Pair Word8 Word64) + = EmptyPairWord8Word64 + | ConsPairWord8Word64 {-# UNPACK #-}!Word8 {-# UNPACK #-}!Word64 (List (Pair Word8 Word64)) + empty = EmptyPairWord8Word64 + cons x z = ConsPairWord8Word64 (fst x) (snd x) z + null EmptyPairWord8Word64 = True + null _ = False + head EmptyPairWord8Word64 = errorEmptyList "head" + head (ConsPairWord8Word64 x y _) = pair x y + tail EmptyPairWord8Word64 = errorEmptyList "tail" + tail (ConsPairWord8Word64 _ _ x) = x + +instance AdaptList (Pair Word8 Double) where + data List (Pair Word8 Double) + = EmptyPairWord8Double + | ConsPairWord8Double {-# UNPACK #-}!Word8 {-# UNPACK #-}!Double (List (Pair Word8 Double)) + empty = EmptyPairWord8Double + cons x z = ConsPairWord8Double (fst x) (snd x) z + null EmptyPairWord8Double = True + null _ = False + head EmptyPairWord8Double = errorEmptyList "head" + head (ConsPairWord8Double x y _) = pair x y + tail EmptyPairWord8Double = errorEmptyList "tail" + tail (ConsPairWord8Double _ _ x) = x + +instance AdaptList (Pair Word8 Float) where + data List (Pair Word8 Float) + = EmptyPairWord8Float + | ConsPairWord8Float {-# UNPACK #-}!Word8 {-# UNPACK #-}!Float (List (Pair Word8 Float)) + empty = EmptyPairWord8Float + cons x z = ConsPairWord8Float (fst x) (snd x) z + null EmptyPairWord8Float = True + null _ = False + head EmptyPairWord8Float = errorEmptyList "head" + head (ConsPairWord8Float x y _) = pair x y + tail EmptyPairWord8Float = errorEmptyList "tail" + tail (ConsPairWord8Float _ _ x) = x + +instance AdaptList (Pair Word8 Char) where + data List (Pair Word8 Char) + = EmptyPairWord8Char + | ConsPairWord8Char {-# UNPACK #-}!Word8 {-# UNPACK #-}!Char (List (Pair Word8 Char)) + empty = EmptyPairWord8Char + cons x z = ConsPairWord8Char (fst x) (snd x) z + null EmptyPairWord8Char = True + null _ = False + head EmptyPairWord8Char = errorEmptyList "head" + head (ConsPairWord8Char x y _) = pair x y + tail EmptyPairWord8Char = errorEmptyList "tail" + tail (ConsPairWord8Char _ _ x) = x + +instance AdaptList (Pair Word16 Int) where + data List (Pair Word16 Int) + = EmptyPairWord16Int + | ConsPairWord16Int {-# UNPACK #-}!Word16 {-# UNPACK #-}!Int (List (Pair Word16 Int)) + empty = EmptyPairWord16Int + cons x z = ConsPairWord16Int (fst x) (snd x) z + null EmptyPairWord16Int = True + null _ = False + head EmptyPairWord16Int = errorEmptyList "head" + head (ConsPairWord16Int x y _) = pair x y + tail EmptyPairWord16Int = errorEmptyList "tail" + tail (ConsPairWord16Int _ _ x) = x + +instance AdaptList (Pair Word16 Integer) where + data List (Pair Word16 Integer) + = EmptyPairWord16Integer + | ConsPairWord16Integer {-# UNPACK #-}!Word16 {-# UNPACK #-}!Integer (List (Pair Word16 Integer)) + empty = EmptyPairWord16Integer + cons x z = ConsPairWord16Integer (fst x) (snd x) z + null EmptyPairWord16Integer = True + null _ = False + head EmptyPairWord16Integer = errorEmptyList "head" + head (ConsPairWord16Integer x y _) = pair x y + tail EmptyPairWord16Integer = errorEmptyList "tail" + tail (ConsPairWord16Integer _ _ x) = x + +instance AdaptList (Pair Word16 Int8) where + data List (Pair Word16 Int8) + = EmptyPairWord16Int8 + | ConsPairWord16Int8 {-# UNPACK #-}!Word16 {-# UNPACK #-}!Int8 (List (Pair Word16 Int8)) + empty = EmptyPairWord16Int8 + cons x z = ConsPairWord16Int8 (fst x) (snd x) z + null EmptyPairWord16Int8 = True + null _ = False + head EmptyPairWord16Int8 = errorEmptyList "head" + head (ConsPairWord16Int8 x y _) = pair x y + tail EmptyPairWord16Int8 = errorEmptyList "tail" + tail (ConsPairWord16Int8 _ _ x) = x + +instance AdaptList (Pair Word16 Int16) where + data List (Pair Word16 Int16) + = EmptyPairWord16Int16 + | ConsPairWord16Int16 {-# UNPACK #-}!Word16 {-# UNPACK #-}!Int16 (List (Pair Word16 Int16)) + empty = EmptyPairWord16Int16 + cons x z = ConsPairWord16Int16 (fst x) (snd x) z + null EmptyPairWord16Int16 = True + null _ = False + head EmptyPairWord16Int16 = errorEmptyList "head" + head (ConsPairWord16Int16 x y _) = pair x y + tail EmptyPairWord16Int16 = errorEmptyList "tail" + tail (ConsPairWord16Int16 _ _ x) = x + +instance AdaptList (Pair Word16 Int32) where + data List (Pair Word16 Int32) + = EmptyPairWord16Int32 + | ConsPairWord16Int32 {-# UNPACK #-}!Word16 {-# UNPACK #-}!Int32 (List (Pair Word16 Int32)) + empty = EmptyPairWord16Int32 + cons x z = ConsPairWord16Int32 (fst x) (snd x) z + null EmptyPairWord16Int32 = True + null _ = False + head EmptyPairWord16Int32 = errorEmptyList "head" + head (ConsPairWord16Int32 x y _) = pair x y + tail EmptyPairWord16Int32 = errorEmptyList "tail" + tail (ConsPairWord16Int32 _ _ x) = x + +instance AdaptList (Pair Word16 Int64) where + data List (Pair Word16 Int64) + = EmptyPairWord16Int64 + | ConsPairWord16Int64 {-# UNPACK #-}!Word16 {-# UNPACK #-}!Int64 (List (Pair Word16 Int64)) + empty = EmptyPairWord16Int64 + cons x z = ConsPairWord16Int64 (fst x) (snd x) z + null EmptyPairWord16Int64 = True + null _ = False + head EmptyPairWord16Int64 = errorEmptyList "head" + head (ConsPairWord16Int64 x y _) = pair x y + tail EmptyPairWord16Int64 = errorEmptyList "tail" + tail (ConsPairWord16Int64 _ _ x) = x + +instance AdaptList (Pair Word16 Word) where + data List (Pair Word16 Word) + = EmptyPairWord16Word + | ConsPairWord16Word {-# UNPACK #-}!Word16 {-# UNPACK #-}!Word (List (Pair Word16 Word)) + empty = EmptyPairWord16Word + cons x z = ConsPairWord16Word (fst x) (snd x) z + null EmptyPairWord16Word = True + null _ = False + head EmptyPairWord16Word = errorEmptyList "head" + head (ConsPairWord16Word x y _) = pair x y + tail EmptyPairWord16Word = errorEmptyList "tail" + tail (ConsPairWord16Word _ _ x) = x + +instance AdaptList (Pair Word16 Word8) where + data List (Pair Word16 Word8) + = EmptyPairWord16Word8 + | ConsPairWord16Word8 {-# UNPACK #-}!Word16 {-# UNPACK #-}!Word8 (List (Pair Word16 Word8)) + empty = EmptyPairWord16Word8 + cons x z = ConsPairWord16Word8 (fst x) (snd x) z + null EmptyPairWord16Word8 = True + null _ = False + head EmptyPairWord16Word8 = errorEmptyList "head" + head (ConsPairWord16Word8 x y _) = pair x y + tail EmptyPairWord16Word8 = errorEmptyList "tail" + tail (ConsPairWord16Word8 _ _ x) = x + +instance AdaptList (Pair Word16 Word16) where + data List (Pair Word16 Word16) + = EmptyPairWord16Word16 + | ConsPairWord16Word16 {-# UNPACK #-}!Word16 {-# UNPACK #-}!Word16 (List (Pair Word16 Word16)) + empty = EmptyPairWord16Word16 + cons x z = ConsPairWord16Word16 (fst x) (snd x) z + null EmptyPairWord16Word16 = True + null _ = False + head EmptyPairWord16Word16 = errorEmptyList "head" + head (ConsPairWord16Word16 x y _) = pair x y + tail EmptyPairWord16Word16 = errorEmptyList "tail" + tail (ConsPairWord16Word16 _ _ x) = x + +instance AdaptList (Pair Word16 Word32) where + data List (Pair Word16 Word32) + = EmptyPairWord16Word32 + | ConsPairWord16Word32 {-# UNPACK #-}!Word16 {-# UNPACK #-}!Word32 (List (Pair Word16 Word32)) + empty = EmptyPairWord16Word32 + cons x z = ConsPairWord16Word32 (fst x) (snd x) z + null EmptyPairWord16Word32 = True + null _ = False + head EmptyPairWord16Word32 = errorEmptyList "head" + head (ConsPairWord16Word32 x y _) = pair x y + tail EmptyPairWord16Word32 = errorEmptyList "tail" + tail (ConsPairWord16Word32 _ _ x) = x + +instance AdaptList (Pair Word16 Word64) where + data List (Pair Word16 Word64) + = EmptyPairWord16Word64 + | ConsPairWord16Word64 {-# UNPACK #-}!Word16 {-# UNPACK #-}!Word64 (List (Pair Word16 Word64)) + empty = EmptyPairWord16Word64 + cons x z = ConsPairWord16Word64 (fst x) (snd x) z + null EmptyPairWord16Word64 = True + null _ = False + head EmptyPairWord16Word64 = errorEmptyList "head" + head (ConsPairWord16Word64 x y _) = pair x y + tail EmptyPairWord16Word64 = errorEmptyList "tail" + tail (ConsPairWord16Word64 _ _ x) = x + +instance AdaptList (Pair Word16 Double) where + data List (Pair Word16 Double) + = EmptyPairWord16Double + | ConsPairWord16Double {-# UNPACK #-}!Word16 {-# UNPACK #-}!Double (List (Pair Word16 Double)) + empty = EmptyPairWord16Double + cons x z = ConsPairWord16Double (fst x) (snd x) z + null EmptyPairWord16Double = True + null _ = False + head EmptyPairWord16Double = errorEmptyList "head" + head (ConsPairWord16Double x y _) = pair x y + tail EmptyPairWord16Double = errorEmptyList "tail" + tail (ConsPairWord16Double _ _ x) = x + +instance AdaptList (Pair Word16 Float) where + data List (Pair Word16 Float) + = EmptyPairWord16Float + | ConsPairWord16Float {-# UNPACK #-}!Word16 {-# UNPACK #-}!Float (List (Pair Word16 Float)) + empty = EmptyPairWord16Float + cons x z = ConsPairWord16Float (fst x) (snd x) z + null EmptyPairWord16Float = True + null _ = False + head EmptyPairWord16Float = errorEmptyList "head" + head (ConsPairWord16Float x y _) = pair x y + tail EmptyPairWord16Float = errorEmptyList "tail" + tail (ConsPairWord16Float _ _ x) = x + +instance AdaptList (Pair Word16 Char) where + data List (Pair Word16 Char) + = EmptyPairWord16Char + | ConsPairWord16Char {-# UNPACK #-}!Word16 {-# UNPACK #-}!Char (List (Pair Word16 Char)) + empty = EmptyPairWord16Char + cons x z = ConsPairWord16Char (fst x) (snd x) z + null EmptyPairWord16Char = True + null _ = False + head EmptyPairWord16Char = errorEmptyList "head" + head (ConsPairWord16Char x y _) = pair x y + tail EmptyPairWord16Char = errorEmptyList "tail" + tail (ConsPairWord16Char _ _ x) = x + +instance AdaptList (Pair Word32 Int) where + data List (Pair Word32 Int) + = EmptyPairWord32Int + | ConsPairWord32Int {-# UNPACK #-}!Word32 {-# UNPACK #-}!Int (List (Pair Word32 Int)) + empty = EmptyPairWord32Int + cons x z = ConsPairWord32Int (fst x) (snd x) z + null EmptyPairWord32Int = True + null _ = False + head EmptyPairWord32Int = errorEmptyList "head" + head (ConsPairWord32Int x y _) = pair x y + tail EmptyPairWord32Int = errorEmptyList "tail" + tail (ConsPairWord32Int _ _ x) = x + +instance AdaptList (Pair Word32 Integer) where + data List (Pair Word32 Integer) + = EmptyPairWord32Integer + | ConsPairWord32Integer {-# UNPACK #-}!Word32 {-# UNPACK #-}!Integer (List (Pair Word32 Integer)) + empty = EmptyPairWord32Integer + cons x z = ConsPairWord32Integer (fst x) (snd x) z + null EmptyPairWord32Integer = True + null _ = False + head EmptyPairWord32Integer = errorEmptyList "head" + head (ConsPairWord32Integer x y _) = pair x y + tail EmptyPairWord32Integer = errorEmptyList "tail" + tail (ConsPairWord32Integer _ _ x) = x + +instance AdaptList (Pair Word32 Int8) where + data List (Pair Word32 Int8) + = EmptyPairWord32Int8 + | ConsPairWord32Int8 {-# UNPACK #-}!Word32 {-# UNPACK #-}!Int8 (List (Pair Word32 Int8)) + empty = EmptyPairWord32Int8 + cons x z = ConsPairWord32Int8 (fst x) (snd x) z + null EmptyPairWord32Int8 = True + null _ = False + head EmptyPairWord32Int8 = errorEmptyList "head" + head (ConsPairWord32Int8 x y _) = pair x y + tail EmptyPairWord32Int8 = errorEmptyList "tail" + tail (ConsPairWord32Int8 _ _ x) = x + +instance AdaptList (Pair Word32 Int16) where + data List (Pair Word32 Int16) + = EmptyPairWord32Int16 + | ConsPairWord32Int16 {-# UNPACK #-}!Word32 {-# UNPACK #-}!Int16 (List (Pair Word32 Int16)) + empty = EmptyPairWord32Int16 + cons x z = ConsPairWord32Int16 (fst x) (snd x) z + null EmptyPairWord32Int16 = True + null _ = False + head EmptyPairWord32Int16 = errorEmptyList "head" + head (ConsPairWord32Int16 x y _) = pair x y + tail EmptyPairWord32Int16 = errorEmptyList "tail" + tail (ConsPairWord32Int16 _ _ x) = x + +instance AdaptList (Pair Word32 Int32) where + data List (Pair Word32 Int32) + = EmptyPairWord32Int32 + | ConsPairWord32Int32 {-# UNPACK #-}!Word32 {-# UNPACK #-}!Int32 (List (Pair Word32 Int32)) + empty = EmptyPairWord32Int32 + cons x z = ConsPairWord32Int32 (fst x) (snd x) z + null EmptyPairWord32Int32 = True + null _ = False + head EmptyPairWord32Int32 = errorEmptyList "head" + head (ConsPairWord32Int32 x y _) = pair x y + tail EmptyPairWord32Int32 = errorEmptyList "tail" + tail (ConsPairWord32Int32 _ _ x) = x + +instance AdaptList (Pair Word32 Int64) where + data List (Pair Word32 Int64) + = EmptyPairWord32Int64 + | ConsPairWord32Int64 {-# UNPACK #-}!Word32 {-# UNPACK #-}!Int64 (List (Pair Word32 Int64)) + empty = EmptyPairWord32Int64 + cons x z = ConsPairWord32Int64 (fst x) (snd x) z + null EmptyPairWord32Int64 = True + null _ = False + head EmptyPairWord32Int64 = errorEmptyList "head" + head (ConsPairWord32Int64 x y _) = pair x y + tail EmptyPairWord32Int64 = errorEmptyList "tail" + tail (ConsPairWord32Int64 _ _ x) = x + +instance AdaptList (Pair Word32 Word) where + data List (Pair Word32 Word) + = EmptyPairWord32Word + | ConsPairWord32Word {-# UNPACK #-}!Word32 {-# UNPACK #-}!Word (List (Pair Word32 Word)) + empty = EmptyPairWord32Word + cons x z = ConsPairWord32Word (fst x) (snd x) z + null EmptyPairWord32Word = True + null _ = False + head EmptyPairWord32Word = errorEmptyList "head" + head (ConsPairWord32Word x y _) = pair x y + tail EmptyPairWord32Word = errorEmptyList "tail" + tail (ConsPairWord32Word _ _ x) = x + +instance AdaptList (Pair Word32 Word8) where + data List (Pair Word32 Word8) + = EmptyPairWord32Word8 + | ConsPairWord32Word8 {-# UNPACK #-}!Word32 {-# UNPACK #-}!Word8 (List (Pair Word32 Word8)) + empty = EmptyPairWord32Word8 + cons x z = ConsPairWord32Word8 (fst x) (snd x) z + null EmptyPairWord32Word8 = True + null _ = False + head EmptyPairWord32Word8 = errorEmptyList "head" + head (ConsPairWord32Word8 x y _) = pair x y + tail EmptyPairWord32Word8 = errorEmptyList "tail" + tail (ConsPairWord32Word8 _ _ x) = x + +instance AdaptList (Pair Word32 Word16) where + data List (Pair Word32 Word16) + = EmptyPairWord32Word16 + | ConsPairWord32Word16 {-# UNPACK #-}!Word32 {-# UNPACK #-}!Word16 (List (Pair Word32 Word16)) + empty = EmptyPairWord32Word16 + cons x z = ConsPairWord32Word16 (fst x) (snd x) z + null EmptyPairWord32Word16 = True + null _ = False + head EmptyPairWord32Word16 = errorEmptyList "head" + head (ConsPairWord32Word16 x y _) = pair x y + tail EmptyPairWord32Word16 = errorEmptyList "tail" + tail (ConsPairWord32Word16 _ _ x) = x + +instance AdaptList (Pair Word32 Word32) where + data List (Pair Word32 Word32) + = EmptyPairWord32Word32 + | ConsPairWord32Word32 {-# UNPACK #-}!Word32 {-# UNPACK #-}!Word32 (List (Pair Word32 Word32)) + empty = EmptyPairWord32Word32 + cons x z = ConsPairWord32Word32 (fst x) (snd x) z + null EmptyPairWord32Word32 = True + null _ = False + head EmptyPairWord32Word32 = errorEmptyList "head" + head (ConsPairWord32Word32 x y _) = pair x y + tail EmptyPairWord32Word32 = errorEmptyList "tail" + tail (ConsPairWord32Word32 _ _ x) = x + +instance AdaptList (Pair Word32 Word64) where + data List (Pair Word32 Word64) + = EmptyPairWord32Word64 + | ConsPairWord32Word64 {-# UNPACK #-}!Word32 {-# UNPACK #-}!Word64 (List (Pair Word32 Word64)) + empty = EmptyPairWord32Word64 + cons x z = ConsPairWord32Word64 (fst x) (snd x) z + null EmptyPairWord32Word64 = True + null _ = False + head EmptyPairWord32Word64 = errorEmptyList "head" + head (ConsPairWord32Word64 x y _) = pair x y + tail EmptyPairWord32Word64 = errorEmptyList "tail" + tail (ConsPairWord32Word64 _ _ x) = x + +instance AdaptList (Pair Word32 Double) where + data List (Pair Word32 Double) + = EmptyPairWord32Double + | ConsPairWord32Double {-# UNPACK #-}!Word32 {-# UNPACK #-}!Double (List (Pair Word32 Double)) + empty = EmptyPairWord32Double + cons x z = ConsPairWord32Double (fst x) (snd x) z + null EmptyPairWord32Double = True + null _ = False + head EmptyPairWord32Double = errorEmptyList "head" + head (ConsPairWord32Double x y _) = pair x y + tail EmptyPairWord32Double = errorEmptyList "tail" + tail (ConsPairWord32Double _ _ x) = x + +instance AdaptList (Pair Word32 Float) where + data List (Pair Word32 Float) + = EmptyPairWord32Float + | ConsPairWord32Float {-# UNPACK #-}!Word32 {-# UNPACK #-}!Float (List (Pair Word32 Float)) + empty = EmptyPairWord32Float + cons x z = ConsPairWord32Float (fst x) (snd x) z + null EmptyPairWord32Float = True + null _ = False + head EmptyPairWord32Float = errorEmptyList "head" + head (ConsPairWord32Float x y _) = pair x y + tail EmptyPairWord32Float = errorEmptyList "tail" + tail (ConsPairWord32Float _ _ x) = x + +instance AdaptList (Pair Word32 Char) where + data List (Pair Word32 Char) + = EmptyPairWord32Char + | ConsPairWord32Char {-# UNPACK #-}!Word32 {-# UNPACK #-}!Char (List (Pair Word32 Char)) + empty = EmptyPairWord32Char + cons x z = ConsPairWord32Char (fst x) (snd x) z + null EmptyPairWord32Char = True + null _ = False + head EmptyPairWord32Char = errorEmptyList "head" + head (ConsPairWord32Char x y _) = pair x y + tail EmptyPairWord32Char = errorEmptyList "tail" + tail (ConsPairWord32Char _ _ x) = x + +instance AdaptList (Pair Word64 Int) where + data List (Pair Word64 Int) + = EmptyPairWord64Int + | ConsPairWord64Int {-# UNPACK #-}!Word64 {-# UNPACK #-}!Int (List (Pair Word64 Int)) + empty = EmptyPairWord64Int + cons x z = ConsPairWord64Int (fst x) (snd x) z + null EmptyPairWord64Int = True + null _ = False + head EmptyPairWord64Int = errorEmptyList "head" + head (ConsPairWord64Int x y _) = pair x y + tail EmptyPairWord64Int = errorEmptyList "tail" + tail (ConsPairWord64Int _ _ x) = x + +instance AdaptList (Pair Word64 Integer) where + data List (Pair Word64 Integer) + = EmptyPairWord64Integer + | ConsPairWord64Integer {-# UNPACK #-}!Word64 {-# UNPACK #-}!Integer (List (Pair Word64 Integer)) + empty = EmptyPairWord64Integer + cons x z = ConsPairWord64Integer (fst x) (snd x) z + null EmptyPairWord64Integer = True + null _ = False + head EmptyPairWord64Integer = errorEmptyList "head" + head (ConsPairWord64Integer x y _) = pair x y + tail EmptyPairWord64Integer = errorEmptyList "tail" + tail (ConsPairWord64Integer _ _ x) = x + +instance AdaptList (Pair Word64 Int8) where + data List (Pair Word64 Int8) + = EmptyPairWord64Int8 + | ConsPairWord64Int8 {-# UNPACK #-}!Word64 {-# UNPACK #-}!Int8 (List (Pair Word64 Int8)) + empty = EmptyPairWord64Int8 + cons x z = ConsPairWord64Int8 (fst x) (snd x) z + null EmptyPairWord64Int8 = True + null _ = False + head EmptyPairWord64Int8 = errorEmptyList "head" + head (ConsPairWord64Int8 x y _) = pair x y + tail EmptyPairWord64Int8 = errorEmptyList "tail" + tail (ConsPairWord64Int8 _ _ x) = x + +instance AdaptList (Pair Word64 Int16) where + data List (Pair Word64 Int16) + = EmptyPairWord64Int16 + | ConsPairWord64Int16 {-# UNPACK #-}!Word64 {-# UNPACK #-}!Int16 (List (Pair Word64 Int16)) + empty = EmptyPairWord64Int16 + cons x z = ConsPairWord64Int16 (fst x) (snd x) z + null EmptyPairWord64Int16 = True + null _ = False + head EmptyPairWord64Int16 = errorEmptyList "head" + head (ConsPairWord64Int16 x y _) = pair x y + tail EmptyPairWord64Int16 = errorEmptyList "tail" + tail (ConsPairWord64Int16 _ _ x) = x + +instance AdaptList (Pair Word64 Int32) where + data List (Pair Word64 Int32) + = EmptyPairWord64Int32 + | ConsPairWord64Int32 {-# UNPACK #-}!Word64 {-# UNPACK #-}!Int32 (List (Pair Word64 Int32)) + empty = EmptyPairWord64Int32 + cons x z = ConsPairWord64Int32 (fst x) (snd x) z + null EmptyPairWord64Int32 = True + null _ = False + head EmptyPairWord64Int32 = errorEmptyList "head" + head (ConsPairWord64Int32 x y _) = pair x y + tail EmptyPairWord64Int32 = errorEmptyList "tail" + tail (ConsPairWord64Int32 _ _ x) = x + +instance AdaptList (Pair Word64 Int64) where + data List (Pair Word64 Int64) + = EmptyPairWord64Int64 + | ConsPairWord64Int64 {-# UNPACK #-}!Word64 {-# UNPACK #-}!Int64 (List (Pair Word64 Int64)) + empty = EmptyPairWord64Int64 + cons x z = ConsPairWord64Int64 (fst x) (snd x) z + null EmptyPairWord64Int64 = True + null _ = False + head EmptyPairWord64Int64 = errorEmptyList "head" + head (ConsPairWord64Int64 x y _) = pair x y + tail EmptyPairWord64Int64 = errorEmptyList "tail" + tail (ConsPairWord64Int64 _ _ x) = x + +instance AdaptList (Pair Word64 Word) where + data List (Pair Word64 Word) + = EmptyPairWord64Word + | ConsPairWord64Word {-# UNPACK #-}!Word64 {-# UNPACK #-}!Word (List (Pair Word64 Word)) + empty = EmptyPairWord64Word + cons x z = ConsPairWord64Word (fst x) (snd x) z + null EmptyPairWord64Word = True + null _ = False + head EmptyPairWord64Word = errorEmptyList "head" + head (ConsPairWord64Word x y _) = pair x y + tail EmptyPairWord64Word = errorEmptyList "tail" + tail (ConsPairWord64Word _ _ x) = x + +instance AdaptList (Pair Word64 Word8) where + data List (Pair Word64 Word8) + = EmptyPairWord64Word8 + | ConsPairWord64Word8 {-# UNPACK #-}!Word64 {-# UNPACK #-}!Word8 (List (Pair Word64 Word8)) + empty = EmptyPairWord64Word8 + cons x z = ConsPairWord64Word8 (fst x) (snd x) z + null EmptyPairWord64Word8 = True + null _ = False + head EmptyPairWord64Word8 = errorEmptyList "head" + head (ConsPairWord64Word8 x y _) = pair x y + tail EmptyPairWord64Word8 = errorEmptyList "tail" + tail (ConsPairWord64Word8 _ _ x) = x + +instance AdaptList (Pair Word64 Word16) where + data List (Pair Word64 Word16) + = EmptyPairWord64Word16 + | ConsPairWord64Word16 {-# UNPACK #-}!Word64 {-# UNPACK #-}!Word16 (List (Pair Word64 Word16)) + empty = EmptyPairWord64Word16 + cons x z = ConsPairWord64Word16 (fst x) (snd x) z + null EmptyPairWord64Word16 = True + null _ = False + head EmptyPairWord64Word16 = errorEmptyList "head" + head (ConsPairWord64Word16 x y _) = pair x y + tail EmptyPairWord64Word16 = errorEmptyList "tail" + tail (ConsPairWord64Word16 _ _ x) = x + +instance AdaptList (Pair Word64 Word32) where + data List (Pair Word64 Word32) + = EmptyPairWord64Word32 + | ConsPairWord64Word32 {-# UNPACK #-}!Word64 {-# UNPACK #-}!Word32 (List (Pair Word64 Word32)) + empty = EmptyPairWord64Word32 + cons x z = ConsPairWord64Word32 (fst x) (snd x) z + null EmptyPairWord64Word32 = True + null _ = False + head EmptyPairWord64Word32 = errorEmptyList "head" + head (ConsPairWord64Word32 x y _) = pair x y + tail EmptyPairWord64Word32 = errorEmptyList "tail" + tail (ConsPairWord64Word32 _ _ x) = x + +instance AdaptList (Pair Word64 Word64) where + data List (Pair Word64 Word64) + = EmptyPairWord64Word64 + | ConsPairWord64Word64 {-# UNPACK #-}!Word64 {-# UNPACK #-}!Word64 (List (Pair Word64 Word64)) + empty = EmptyPairWord64Word64 + cons x z = ConsPairWord64Word64 (fst x) (snd x) z + null EmptyPairWord64Word64 = True + null _ = False + head EmptyPairWord64Word64 = errorEmptyList "head" + head (ConsPairWord64Word64 x y _) = pair x y + tail EmptyPairWord64Word64 = errorEmptyList "tail" + tail (ConsPairWord64Word64 _ _ x) = x + +instance AdaptList (Pair Word64 Double) where + data List (Pair Word64 Double) + = EmptyPairWord64Double + | ConsPairWord64Double {-# UNPACK #-}!Word64 {-# UNPACK #-}!Double (List (Pair Word64 Double)) + empty = EmptyPairWord64Double + cons x z = ConsPairWord64Double (fst x) (snd x) z + null EmptyPairWord64Double = True + null _ = False + head EmptyPairWord64Double = errorEmptyList "head" + head (ConsPairWord64Double x y _) = pair x y + tail EmptyPairWord64Double = errorEmptyList "tail" + tail (ConsPairWord64Double _ _ x) = x + +instance AdaptList (Pair Word64 Float) where + data List (Pair Word64 Float) + = EmptyPairWord64Float + | ConsPairWord64Float {-# UNPACK #-}!Word64 {-# UNPACK #-}!Float (List (Pair Word64 Float)) + empty = EmptyPairWord64Float + cons x z = ConsPairWord64Float (fst x) (snd x) z + null EmptyPairWord64Float = True + null _ = False + head EmptyPairWord64Float = errorEmptyList "head" + head (ConsPairWord64Float x y _) = pair x y + tail EmptyPairWord64Float = errorEmptyList "tail" + tail (ConsPairWord64Float _ _ x) = x + +instance AdaptList (Pair Word64 Char) where + data List (Pair Word64 Char) + = EmptyPairWord64Char + | ConsPairWord64Char {-# UNPACK #-}!Word64 {-# UNPACK #-}!Char (List (Pair Word64 Char)) + empty = EmptyPairWord64Char + cons x z = ConsPairWord64Char (fst x) (snd x) z + null EmptyPairWord64Char = True + null _ = False + head EmptyPairWord64Char = errorEmptyList "head" + head (ConsPairWord64Char x y _) = pair x y + tail EmptyPairWord64Char = errorEmptyList "tail" + tail (ConsPairWord64Char _ _ x) = x + +instance AdaptList (Pair Double Int) where + data List (Pair Double Int) + = EmptyPairDoubleInt + | ConsPairDoubleInt {-# UNPACK #-}!Double {-# UNPACK #-}!Int (List (Pair Double Int)) + empty = EmptyPairDoubleInt + cons x z = ConsPairDoubleInt (fst x) (snd x) z + null EmptyPairDoubleInt = True + null _ = False + head EmptyPairDoubleInt = errorEmptyList "head" + head (ConsPairDoubleInt x y _) = pair x y + tail EmptyPairDoubleInt = errorEmptyList "tail" + tail (ConsPairDoubleInt _ _ x) = x + +instance AdaptList (Pair Double Integer) where + data List (Pair Double Integer) + = EmptyPairDoubleInteger + | ConsPairDoubleInteger {-# UNPACK #-}!Double {-# UNPACK #-}!Integer (List (Pair Double Integer)) + empty = EmptyPairDoubleInteger + cons x z = ConsPairDoubleInteger (fst x) (snd x) z + null EmptyPairDoubleInteger = True + null _ = False + head EmptyPairDoubleInteger = errorEmptyList "head" + head (ConsPairDoubleInteger x y _) = pair x y + tail EmptyPairDoubleInteger = errorEmptyList "tail" + tail (ConsPairDoubleInteger _ _ x) = x + +instance AdaptList (Pair Double Int8) where + data List (Pair Double Int8) + = EmptyPairDoubleInt8 + | ConsPairDoubleInt8 {-# UNPACK #-}!Double {-# UNPACK #-}!Int8 (List (Pair Double Int8)) + empty = EmptyPairDoubleInt8 + cons x z = ConsPairDoubleInt8 (fst x) (snd x) z + null EmptyPairDoubleInt8 = True + null _ = False + head EmptyPairDoubleInt8 = errorEmptyList "head" + head (ConsPairDoubleInt8 x y _) = pair x y + tail EmptyPairDoubleInt8 = errorEmptyList "tail" + tail (ConsPairDoubleInt8 _ _ x) = x + +instance AdaptList (Pair Double Int16) where + data List (Pair Double Int16) + = EmptyPairDoubleInt16 + | ConsPairDoubleInt16 {-# UNPACK #-}!Double {-# UNPACK #-}!Int16 (List (Pair Double Int16)) + empty = EmptyPairDoubleInt16 + cons x z = ConsPairDoubleInt16 (fst x) (snd x) z + null EmptyPairDoubleInt16 = True + null _ = False + head EmptyPairDoubleInt16 = errorEmptyList "head" + head (ConsPairDoubleInt16 x y _) = pair x y + tail EmptyPairDoubleInt16 = errorEmptyList "tail" + tail (ConsPairDoubleInt16 _ _ x) = x + +instance AdaptList (Pair Double Int32) where + data List (Pair Double Int32) + = EmptyPairDoubleInt32 + | ConsPairDoubleInt32 {-# UNPACK #-}!Double {-# UNPACK #-}!Int32 (List (Pair Double Int32)) + empty = EmptyPairDoubleInt32 + cons x z = ConsPairDoubleInt32 (fst x) (snd x) z + null EmptyPairDoubleInt32 = True + null _ = False + head EmptyPairDoubleInt32 = errorEmptyList "head" + head (ConsPairDoubleInt32 x y _) = pair x y + tail EmptyPairDoubleInt32 = errorEmptyList "tail" + tail (ConsPairDoubleInt32 _ _ x) = x + +instance AdaptList (Pair Double Int64) where + data List (Pair Double Int64) + = EmptyPairDoubleInt64 + | ConsPairDoubleInt64 {-# UNPACK #-}!Double {-# UNPACK #-}!Int64 (List (Pair Double Int64)) + empty = EmptyPairDoubleInt64 + cons x z = ConsPairDoubleInt64 (fst x) (snd x) z + null EmptyPairDoubleInt64 = True + null _ = False + head EmptyPairDoubleInt64 = errorEmptyList "head" + head (ConsPairDoubleInt64 x y _) = pair x y + tail EmptyPairDoubleInt64 = errorEmptyList "tail" + tail (ConsPairDoubleInt64 _ _ x) = x + +instance AdaptList (Pair Double Word) where + data List (Pair Double Word) + = EmptyPairDoubleWord + | ConsPairDoubleWord {-# UNPACK #-}!Double {-# UNPACK #-}!Word (List (Pair Double Word)) + empty = EmptyPairDoubleWord + cons x z = ConsPairDoubleWord (fst x) (snd x) z + null EmptyPairDoubleWord = True + null _ = False + head EmptyPairDoubleWord = errorEmptyList "head" + head (ConsPairDoubleWord x y _) = pair x y + tail EmptyPairDoubleWord = errorEmptyList "tail" + tail (ConsPairDoubleWord _ _ x) = x + +instance AdaptList (Pair Double Word8) where + data List (Pair Double Word8) + = EmptyPairDoubleWord8 + | ConsPairDoubleWord8 {-# UNPACK #-}!Double {-# UNPACK #-}!Word8 (List (Pair Double Word8)) + empty = EmptyPairDoubleWord8 + cons x z = ConsPairDoubleWord8 (fst x) (snd x) z + null EmptyPairDoubleWord8 = True + null _ = False + head EmptyPairDoubleWord8 = errorEmptyList "head" + head (ConsPairDoubleWord8 x y _) = pair x y + tail EmptyPairDoubleWord8 = errorEmptyList "tail" + tail (ConsPairDoubleWord8 _ _ x) = x + +instance AdaptList (Pair Double Word16) where + data List (Pair Double Word16) + = EmptyPairDoubleWord16 + | ConsPairDoubleWord16 {-# UNPACK #-}!Double {-# UNPACK #-}!Word16 (List (Pair Double Word16)) + empty = EmptyPairDoubleWord16 + cons x z = ConsPairDoubleWord16 (fst x) (snd x) z + null EmptyPairDoubleWord16 = True + null _ = False + head EmptyPairDoubleWord16 = errorEmptyList "head" + head (ConsPairDoubleWord16 x y _) = pair x y + tail EmptyPairDoubleWord16 = errorEmptyList "tail" + tail (ConsPairDoubleWord16 _ _ x) = x + +instance AdaptList (Pair Double Word32) where + data List (Pair Double Word32) + = EmptyPairDoubleWord32 + | ConsPairDoubleWord32 {-# UNPACK #-}!Double {-# UNPACK #-}!Word32 (List (Pair Double Word32)) + empty = EmptyPairDoubleWord32 + cons x z = ConsPairDoubleWord32 (fst x) (snd x) z + null EmptyPairDoubleWord32 = True + null _ = False + head EmptyPairDoubleWord32 = errorEmptyList "head" + head (ConsPairDoubleWord32 x y _) = pair x y + tail EmptyPairDoubleWord32 = errorEmptyList "tail" + tail (ConsPairDoubleWord32 _ _ x) = x + +instance AdaptList (Pair Double Word64) where + data List (Pair Double Word64) + = EmptyPairDoubleWord64 + | ConsPairDoubleWord64 {-# UNPACK #-}!Double {-# UNPACK #-}!Word64 (List (Pair Double Word64)) + empty = EmptyPairDoubleWord64 + cons x z = ConsPairDoubleWord64 (fst x) (snd x) z + null EmptyPairDoubleWord64 = True + null _ = False + head EmptyPairDoubleWord64 = errorEmptyList "head" + head (ConsPairDoubleWord64 x y _) = pair x y + tail EmptyPairDoubleWord64 = errorEmptyList "tail" + tail (ConsPairDoubleWord64 _ _ x) = x + +instance AdaptList (Pair Double Double) where + data List (Pair Double Double) + = EmptyPairDoubleDouble + | ConsPairDoubleDouble {-# UNPACK #-}!Double {-# UNPACK #-}!Double (List (Pair Double Double)) + empty = EmptyPairDoubleDouble + cons x z = ConsPairDoubleDouble (fst x) (snd x) z + null EmptyPairDoubleDouble = True + null _ = False + head EmptyPairDoubleDouble = errorEmptyList "head" + head (ConsPairDoubleDouble x y _) = pair x y + tail EmptyPairDoubleDouble = errorEmptyList "tail" + tail (ConsPairDoubleDouble _ _ x) = x + +instance AdaptList (Pair Double Float) where + data List (Pair Double Float) + = EmptyPairDoubleFloat + | ConsPairDoubleFloat {-# UNPACK #-}!Double {-# UNPACK #-}!Float (List (Pair Double Float)) + empty = EmptyPairDoubleFloat + cons x z = ConsPairDoubleFloat (fst x) (snd x) z + null EmptyPairDoubleFloat = True + null _ = False + head EmptyPairDoubleFloat = errorEmptyList "head" + head (ConsPairDoubleFloat x y _) = pair x y + tail EmptyPairDoubleFloat = errorEmptyList "tail" + tail (ConsPairDoubleFloat _ _ x) = x + +instance AdaptList (Pair Double Char) where + data List (Pair Double Char) + = EmptyPairDoubleChar + | ConsPairDoubleChar {-# UNPACK #-}!Double {-# UNPACK #-}!Char (List (Pair Double Char)) + empty = EmptyPairDoubleChar + cons x z = ConsPairDoubleChar (fst x) (snd x) z + null EmptyPairDoubleChar = True + null _ = False + head EmptyPairDoubleChar = errorEmptyList "head" + head (ConsPairDoubleChar x y _) = pair x y + tail EmptyPairDoubleChar = errorEmptyList "tail" + tail (ConsPairDoubleChar _ _ x) = x + +instance AdaptList (Pair Float Int) where + data List (Pair Float Int) + = EmptyPairFloatInt + | ConsPairFloatInt {-# UNPACK #-}!Float {-# UNPACK #-}!Int (List (Pair Float Int)) + empty = EmptyPairFloatInt + cons x z = ConsPairFloatInt (fst x) (snd x) z + null EmptyPairFloatInt = True + null _ = False + head EmptyPairFloatInt = errorEmptyList "head" + head (ConsPairFloatInt x y _) = pair x y + tail EmptyPairFloatInt = errorEmptyList "tail" + tail (ConsPairFloatInt _ _ x) = x + +instance AdaptList (Pair Float Integer) where + data List (Pair Float Integer) + = EmptyPairFloatInteger + | ConsPairFloatInteger {-# UNPACK #-}!Float {-# UNPACK #-}!Integer (List (Pair Float Integer)) + empty = EmptyPairFloatInteger + cons x z = ConsPairFloatInteger (fst x) (snd x) z + null EmptyPairFloatInteger = True + null _ = False + head EmptyPairFloatInteger = errorEmptyList "head" + head (ConsPairFloatInteger x y _) = pair x y + tail EmptyPairFloatInteger = errorEmptyList "tail" + tail (ConsPairFloatInteger _ _ x) = x + +instance AdaptList (Pair Float Int8) where + data List (Pair Float Int8) + = EmptyPairFloatInt8 + | ConsPairFloatInt8 {-# UNPACK #-}!Float {-# UNPACK #-}!Int8 (List (Pair Float Int8)) + empty = EmptyPairFloatInt8 + cons x z = ConsPairFloatInt8 (fst x) (snd x) z + null EmptyPairFloatInt8 = True + null _ = False + head EmptyPairFloatInt8 = errorEmptyList "head" + head (ConsPairFloatInt8 x y _) = pair x y + tail EmptyPairFloatInt8 = errorEmptyList "tail" + tail (ConsPairFloatInt8 _ _ x) = x + +instance AdaptList (Pair Float Int16) where + data List (Pair Float Int16) + = EmptyPairFloatInt16 + | ConsPairFloatInt16 {-# UNPACK #-}!Float {-# UNPACK #-}!Int16 (List (Pair Float Int16)) + empty = EmptyPairFloatInt16 + cons x z = ConsPairFloatInt16 (fst x) (snd x) z + null EmptyPairFloatInt16 = True + null _ = False + head EmptyPairFloatInt16 = errorEmptyList "head" + head (ConsPairFloatInt16 x y _) = pair x y + tail EmptyPairFloatInt16 = errorEmptyList "tail" + tail (ConsPairFloatInt16 _ _ x) = x + +instance AdaptList (Pair Float Int32) where + data List (Pair Float Int32) + = EmptyPairFloatInt32 + | ConsPairFloatInt32 {-# UNPACK #-}!Float {-# UNPACK #-}!Int32 (List (Pair Float Int32)) + empty = EmptyPairFloatInt32 + cons x z = ConsPairFloatInt32 (fst x) (snd x) z + null EmptyPairFloatInt32 = True + null _ = False + head EmptyPairFloatInt32 = errorEmptyList "head" + head (ConsPairFloatInt32 x y _) = pair x y + tail EmptyPairFloatInt32 = errorEmptyList "tail" + tail (ConsPairFloatInt32 _ _ x) = x + +instance AdaptList (Pair Float Int64) where + data List (Pair Float Int64) + = EmptyPairFloatInt64 + | ConsPairFloatInt64 {-# UNPACK #-}!Float {-# UNPACK #-}!Int64 (List (Pair Float Int64)) + empty = EmptyPairFloatInt64 + cons x z = ConsPairFloatInt64 (fst x) (snd x) z + null EmptyPairFloatInt64 = True + null _ = False + head EmptyPairFloatInt64 = errorEmptyList "head" + head (ConsPairFloatInt64 x y _) = pair x y + tail EmptyPairFloatInt64 = errorEmptyList "tail" + tail (ConsPairFloatInt64 _ _ x) = x + +instance AdaptList (Pair Float Word) where + data List (Pair Float Word) + = EmptyPairFloatWord + | ConsPairFloatWord {-# UNPACK #-}!Float {-# UNPACK #-}!Word (List (Pair Float Word)) + empty = EmptyPairFloatWord + cons x z = ConsPairFloatWord (fst x) (snd x) z + null EmptyPairFloatWord = True + null _ = False + head EmptyPairFloatWord = errorEmptyList "head" + head (ConsPairFloatWord x y _) = pair x y + tail EmptyPairFloatWord = errorEmptyList "tail" + tail (ConsPairFloatWord _ _ x) = x + +instance AdaptList (Pair Float Word8) where + data List (Pair Float Word8) + = EmptyPairFloatWord8 + | ConsPairFloatWord8 {-# UNPACK #-}!Float {-# UNPACK #-}!Word8 (List (Pair Float Word8)) + empty = EmptyPairFloatWord8 + cons x z = ConsPairFloatWord8 (fst x) (snd x) z + null EmptyPairFloatWord8 = True + null _ = False + head EmptyPairFloatWord8 = errorEmptyList "head" + head (ConsPairFloatWord8 x y _) = pair x y + tail EmptyPairFloatWord8 = errorEmptyList "tail" + tail (ConsPairFloatWord8 _ _ x) = x + +instance AdaptList (Pair Float Word16) where + data List (Pair Float Word16) + = EmptyPairFloatWord16 + | ConsPairFloatWord16 {-# UNPACK #-}!Float {-# UNPACK #-}!Word16 (List (Pair Float Word16)) + empty = EmptyPairFloatWord16 + cons x z = ConsPairFloatWord16 (fst x) (snd x) z + null EmptyPairFloatWord16 = True + null _ = False + head EmptyPairFloatWord16 = errorEmptyList "head" + head (ConsPairFloatWord16 x y _) = pair x y + tail EmptyPairFloatWord16 = errorEmptyList "tail" + tail (ConsPairFloatWord16 _ _ x) = x + +instance AdaptList (Pair Float Word32) where + data List (Pair Float Word32) + = EmptyPairFloatWord32 + | ConsPairFloatWord32 {-# UNPACK #-}!Float {-# UNPACK #-}!Word32 (List (Pair Float Word32)) + empty = EmptyPairFloatWord32 + cons x z = ConsPairFloatWord32 (fst x) (snd x) z + null EmptyPairFloatWord32 = True + null _ = False + head EmptyPairFloatWord32 = errorEmptyList "head" + head (ConsPairFloatWord32 x y _) = pair x y + tail EmptyPairFloatWord32 = errorEmptyList "tail" + tail (ConsPairFloatWord32 _ _ x) = x + +instance AdaptList (Pair Float Word64) where + data List (Pair Float Word64) + = EmptyPairFloatWord64 + | ConsPairFloatWord64 {-# UNPACK #-}!Float {-# UNPACK #-}!Word64 (List (Pair Float Word64)) + empty = EmptyPairFloatWord64 + cons x z = ConsPairFloatWord64 (fst x) (snd x) z + null EmptyPairFloatWord64 = True + null _ = False + head EmptyPairFloatWord64 = errorEmptyList "head" + head (ConsPairFloatWord64 x y _) = pair x y + tail EmptyPairFloatWord64 = errorEmptyList "tail" + tail (ConsPairFloatWord64 _ _ x) = x + +instance AdaptList (Pair Float Double) where + data List (Pair Float Double) + = EmptyPairFloatDouble + | ConsPairFloatDouble {-# UNPACK #-}!Float {-# UNPACK #-}!Double (List (Pair Float Double)) + empty = EmptyPairFloatDouble + cons x z = ConsPairFloatDouble (fst x) (snd x) z + null EmptyPairFloatDouble = True + null _ = False + head EmptyPairFloatDouble = errorEmptyList "head" + head (ConsPairFloatDouble x y _) = pair x y + tail EmptyPairFloatDouble = errorEmptyList "tail" + tail (ConsPairFloatDouble _ _ x) = x + +instance AdaptList (Pair Float Float) where + data List (Pair Float Float) + = EmptyPairFloatFloat + | ConsPairFloatFloat {-# UNPACK #-}!Float {-# UNPACK #-}!Float (List (Pair Float Float)) + empty = EmptyPairFloatFloat + cons x z = ConsPairFloatFloat (fst x) (snd x) z + null EmptyPairFloatFloat = True + null _ = False + head EmptyPairFloatFloat = errorEmptyList "head" + head (ConsPairFloatFloat x y _) = pair x y + tail EmptyPairFloatFloat = errorEmptyList "tail" + tail (ConsPairFloatFloat _ _ x) = x + +instance AdaptList (Pair Float Char) where + data List (Pair Float Char) + = EmptyPairFloatChar + | ConsPairFloatChar {-# UNPACK #-}!Float {-# UNPACK #-}!Char (List (Pair Float Char)) + empty = EmptyPairFloatChar + cons x z = ConsPairFloatChar (fst x) (snd x) z + null EmptyPairFloatChar = True + null _ = False + head EmptyPairFloatChar = errorEmptyList "head" + head (ConsPairFloatChar x y _) = pair x y + tail EmptyPairFloatChar = errorEmptyList "tail" + tail (ConsPairFloatChar _ _ x) = x + +instance AdaptList (Pair Char Int) where + data List (Pair Char Int) + = EmptyPairCharInt + | ConsPairCharInt {-# UNPACK #-}!Char {-# UNPACK #-}!Int (List (Pair Char Int)) + empty = EmptyPairCharInt + cons x z = ConsPairCharInt (fst x) (snd x) z + null EmptyPairCharInt = True + null _ = False + head EmptyPairCharInt = errorEmptyList "head" + head (ConsPairCharInt x y _) = pair x y + tail EmptyPairCharInt = errorEmptyList "tail" + tail (ConsPairCharInt _ _ x) = x + +instance AdaptList (Pair Char Integer) where + data List (Pair Char Integer) + = EmptyPairCharInteger + | ConsPairCharInteger {-# UNPACK #-}!Char {-# UNPACK #-}!Integer (List (Pair Char Integer)) + empty = EmptyPairCharInteger + cons x z = ConsPairCharInteger (fst x) (snd x) z + null EmptyPairCharInteger = True + null _ = False + head EmptyPairCharInteger = errorEmptyList "head" + head (ConsPairCharInteger x y _) = pair x y + tail EmptyPairCharInteger = errorEmptyList "tail" + tail (ConsPairCharInteger _ _ x) = x + +instance AdaptList (Pair Char Int8) where + data List (Pair Char Int8) + = EmptyPairCharInt8 + | ConsPairCharInt8 {-# UNPACK #-}!Char {-# UNPACK #-}!Int8 (List (Pair Char Int8)) + empty = EmptyPairCharInt8 + cons x z = ConsPairCharInt8 (fst x) (snd x) z + null EmptyPairCharInt8 = True + null _ = False + head EmptyPairCharInt8 = errorEmptyList "head" + head (ConsPairCharInt8 x y _) = pair x y + tail EmptyPairCharInt8 = errorEmptyList "tail" + tail (ConsPairCharInt8 _ _ x) = x + +instance AdaptList (Pair Char Int16) where + data List (Pair Char Int16) + = EmptyPairCharInt16 + | ConsPairCharInt16 {-# UNPACK #-}!Char {-# UNPACK #-}!Int16 (List (Pair Char Int16)) + empty = EmptyPairCharInt16 + cons x z = ConsPairCharInt16 (fst x) (snd x) z + null EmptyPairCharInt16 = True + null _ = False + head EmptyPairCharInt16 = errorEmptyList "head" + head (ConsPairCharInt16 x y _) = pair x y + tail EmptyPairCharInt16 = errorEmptyList "tail" + tail (ConsPairCharInt16 _ _ x) = x + +instance AdaptList (Pair Char Int32) where + data List (Pair Char Int32) + = EmptyPairCharInt32 + | ConsPairCharInt32 {-# UNPACK #-}!Char {-# UNPACK #-}!Int32 (List (Pair Char Int32)) + empty = EmptyPairCharInt32 + cons x z = ConsPairCharInt32 (fst x) (snd x) z + null EmptyPairCharInt32 = True + null _ = False + head EmptyPairCharInt32 = errorEmptyList "head" + head (ConsPairCharInt32 x y _) = pair x y + tail EmptyPairCharInt32 = errorEmptyList "tail" + tail (ConsPairCharInt32 _ _ x) = x + +instance AdaptList (Pair Char Int64) where + data List (Pair Char Int64) + = EmptyPairCharInt64 + | ConsPairCharInt64 {-# UNPACK #-}!Char {-# UNPACK #-}!Int64 (List (Pair Char Int64)) + empty = EmptyPairCharInt64 + cons x z = ConsPairCharInt64 (fst x) (snd x) z + null EmptyPairCharInt64 = True + null _ = False + head EmptyPairCharInt64 = errorEmptyList "head" + head (ConsPairCharInt64 x y _) = pair x y + tail EmptyPairCharInt64 = errorEmptyList "tail" + tail (ConsPairCharInt64 _ _ x) = x + +instance AdaptList (Pair Char Word) where + data List (Pair Char Word) + = EmptyPairCharWord + | ConsPairCharWord {-# UNPACK #-}!Char {-# UNPACK #-}!Word (List (Pair Char Word)) + empty = EmptyPairCharWord + cons x z = ConsPairCharWord (fst x) (snd x) z + null EmptyPairCharWord = True + null _ = False + head EmptyPairCharWord = errorEmptyList "head" + head (ConsPairCharWord x y _) = pair x y + tail EmptyPairCharWord = errorEmptyList "tail" + tail (ConsPairCharWord _ _ x) = x + +instance AdaptList (Pair Char Word8) where + data List (Pair Char Word8) + = EmptyPairCharWord8 + | ConsPairCharWord8 {-# UNPACK #-}!Char {-# UNPACK #-}!Word8 (List (Pair Char Word8)) + empty = EmptyPairCharWord8 + cons x z = ConsPairCharWord8 (fst x) (snd x) z + null EmptyPairCharWord8 = True + null _ = False + head EmptyPairCharWord8 = errorEmptyList "head" + head (ConsPairCharWord8 x y _) = pair x y + tail EmptyPairCharWord8 = errorEmptyList "tail" + tail (ConsPairCharWord8 _ _ x) = x + +instance AdaptList (Pair Char Word16) where + data List (Pair Char Word16) + = EmptyPairCharWord16 + | ConsPairCharWord16 {-# UNPACK #-}!Char {-# UNPACK #-}!Word16 (List (Pair Char Word16)) + empty = EmptyPairCharWord16 + cons x z = ConsPairCharWord16 (fst x) (snd x) z + null EmptyPairCharWord16 = True + null _ = False + head EmptyPairCharWord16 = errorEmptyList "head" + head (ConsPairCharWord16 x y _) = pair x y + tail EmptyPairCharWord16 = errorEmptyList "tail" + tail (ConsPairCharWord16 _ _ x) = x + +instance AdaptList (Pair Char Word32) where + data List (Pair Char Word32) + = EmptyPairCharWord32 + | ConsPairCharWord32 {-# UNPACK #-}!Char {-# UNPACK #-}!Word32 (List (Pair Char Word32)) + empty = EmptyPairCharWord32 + cons x z = ConsPairCharWord32 (fst x) (snd x) z + null EmptyPairCharWord32 = True + null _ = False + head EmptyPairCharWord32 = errorEmptyList "head" + head (ConsPairCharWord32 x y _) = pair x y + tail EmptyPairCharWord32 = errorEmptyList "tail" + tail (ConsPairCharWord32 _ _ x) = x + +instance AdaptList (Pair Char Word64) where + data List (Pair Char Word64) + = EmptyPairCharWord64 + | ConsPairCharWord64 {-# UNPACK #-}!Char {-# UNPACK #-}!Word64 (List (Pair Char Word64)) + empty = EmptyPairCharWord64 + cons x z = ConsPairCharWord64 (fst x) (snd x) z + null EmptyPairCharWord64 = True + null _ = False + head EmptyPairCharWord64 = errorEmptyList "head" + head (ConsPairCharWord64 x y _) = pair x y + tail EmptyPairCharWord64 = errorEmptyList "tail" + tail (ConsPairCharWord64 _ _ x) = x + +instance AdaptList (Pair Char Double) where + data List (Pair Char Double) + = EmptyPairCharDouble + | ConsPairCharDouble {-# UNPACK #-}!Char {-# UNPACK #-}!Double (List (Pair Char Double)) + empty = EmptyPairCharDouble + cons x z = ConsPairCharDouble (fst x) (snd x) z + null EmptyPairCharDouble = True + null _ = False + head EmptyPairCharDouble = errorEmptyList "head" + head (ConsPairCharDouble x y _) = pair x y + tail EmptyPairCharDouble = errorEmptyList "tail" + tail (ConsPairCharDouble _ _ x) = x + +instance AdaptList (Pair Char Float) where + data List (Pair Char Float) + = EmptyPairCharFloat + | ConsPairCharFloat {-# UNPACK #-}!Char {-# UNPACK #-}!Float (List (Pair Char Float)) + empty = EmptyPairCharFloat + cons x z = ConsPairCharFloat (fst x) (snd x) z + null EmptyPairCharFloat = True + null _ = False + head EmptyPairCharFloat = errorEmptyList "head" + head (ConsPairCharFloat x y _) = pair x y + tail EmptyPairCharFloat = errorEmptyList "tail" + tail (ConsPairCharFloat _ _ x) = x + +instance AdaptList (Pair Char Char) where + data List (Pair Char Char) + = EmptyPairCharChar + | ConsPairCharChar {-# UNPACK #-}!Char {-# UNPACK #-}!Char (List (Pair Char Char)) + empty = EmptyPairCharChar + cons x z = ConsPairCharChar (fst x) (snd x) z + null EmptyPairCharChar = True + null _ = False + head EmptyPairCharChar = errorEmptyList "head" + head (ConsPairCharChar x y _) = pair x y + tail EmptyPairCharChar = errorEmptyList "tail" + tail (ConsPairCharChar _ _ x) = x diff --git a/Data/Adaptive/Tuple.hs b/Data/Adaptive/Tuple.hs --- a/Data/Adaptive/Tuple.hs +++ b/Data/Adaptive/Tuple.hs @@ -1,7 +1,6 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE OverlappingInstances #-} -- | -- Module : Data.Adaptive.Tuple @@ -98,7 +97,9 @@ ------------------------------------------------------------------------ -- Methods +-- -- standalone deriving crashes here: do not attempt it. +-- -- deriving instance (Eq a, Eq b, AdaptPair a b) => Eq (Pair a b) -- deriving instance (Ord a, Ord b, AdaptPair a b) => Ord (Pair a b) -- deriving instance (Show a, Show b, AdaptPair a b) => Show (Pair a b) @@ -123,14 +124,28 @@ -- -- Generic instance of pairs in terms of (,) -- - - -instance AdaptPair a b where - newtype Pair a b = PairPair { unPair :: (,) a b } - - fst = Prelude.fst . unPair - snd = Prelude.snd . unPair - curry f x y = f (PairPair (x,y)) +-- Courtesy sjanssen: +-- +-- Suspicious on a number of levels: +-- +-- 1 $ ghci-6.10.1 +-- 2 GHCi, version 6.10.1: http://www.haskell.org/ghc/ :? for help +-- 3 Loading package ghc-prim ... linking ... done. +-- 4 Loading package integer ... linking ... done. +-- 5 Loading package base ... linking ... done. +-- 6 Prelude> :m +Data.Adaptive.Tuple +-- 7 Prelude Data.Adaptive.Tuple> case PUnit of PairPair x -> x +-- 8 Loading package adaptive-containers-0.2 ... linking ... done. +-- 9 (Segmentation fault (core dumped) +-- +-- +-- +--instance AdaptPair a b where +-- newtype Pair a b = PairPair { unPair :: (,) a b } +-- +-- fst = Prelude.fst . unPair +-- snd = Prelude.snd . unPair +-- curry f x y = f (PairPair (x,y)) ------------------------------------------------------------------------ -- diff --git a/adaptive-containers.cabal b/adaptive-containers.cabal --- a/adaptive-containers.cabal +++ b/adaptive-containers.cabal @@ -1,5 +1,5 @@ name: adaptive-containers -version: 0.2 +version: 0.2.1 homepage: http://code.haskell.org/~dons/code/adaptive-containers synopsis: Self optimizing container types description: @@ -14,17 +14,19 @@ yielding a representation for (Int,Char) requiring 8 bytes, instead of 24. . - This difference can be visualized, here for the value: + This difference can be visualized. Consider the expression: . > [ (x,y) | x <- [1..3], y <- [x..3] ] . - * A regular list of pairs + * /[(Int,Int)]/: A regular list of pairs . - * An adaptive list of pairs + * /[Pair Int Int]/: An adaptive list of pairs . - * An adaptive list of adaptive pairs + * /List (Pair Int Int)/: An adaptive list of adaptive pairs . - Currently supported adaptive types: pairs, lists + Currently supported adaptive containers: pairs, lists + . + Most unboxed element types are supported. category: Data license: BSD3 @@ -44,8 +46,9 @@ ghc-prof-options: -prof -auto-all extensions: TypeFamilies, + BangPatterns, MultiParamTypeClasses, - FlexibleInstances, - OverlappingInstances + FlexibleContexts, + FlexibleInstances build-depends: base diff --git a/scripts/derive-list-pair.hs b/scripts/derive-list-pair.hs new file mode 100644 --- /dev/null +++ b/scripts/derive-list-pair.hs @@ -0,0 +1,182 @@ + +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# OPTIONS -fglasgow-exts #-} + +module AdaptiveDerive where + +import Data.Generics +import Data.List +import Text.PrettyPrint +import Control.Monad + +import Data.Int +import Data.Word + +{- + +instance Adapt Int Int where + + data Pair Int Int = PIntInt {-# UNPACK #-}!Int {-# UNPACK #-}!Int + + fst (PIntInt a _) = a + snd (PIntInt _ b) = b + curry f x y = f (PIntInt x y) + uncurry f p = f (fst p) (snd p) + + -} + +------------------------------------------------------------------------ + +main = sequence_ . intersperse (putStrLn "") $ + [ deriveM t u + | Box t <- types + , Box u <- types ] + +data Box = forall a. (Typeable a, Data a) => Box a + +types :: [Box] +types = [ Box (undefined :: Int) + , Box (undefined :: Integer) + , Box (undefined :: Int8) + , Box (undefined :: Int16) + , Box (undefined :: Int32) + , Box (undefined :: Int64) + , Box (undefined :: Word) + , Box (undefined :: Word8) + , Box (undefined :: Word16) + , Box (undefined :: Word32) + , Box (undefined :: Word64) + , Box (undefined :: Double) + , Box (undefined :: Float) + , Box (undefined :: Char) + ] + +------------------------------------------------------------------------ + +deriveM :: forall a b . (Typeable a, Data a, Typeable b, Data b) => a -> b -> IO () +deriveM (a :: a) (b :: b) = putStrLn $ derive (undefined :: a) (undefined :: b) + +{- +-- Monomorphic, but we have to flatten ourselves. GHC is doing something wrong. +instance AdaptList (Pair Int Int) where + data List (Pair Int Int) + = EmptyPairIntInt + | ConsPairIntInt {-# UNPACK #-}!Int {-# UNPACK #-}!Int (List (Pair Int Int)) + + empty = EmptyPairIntInt + cons x xs = ConsPairIntInt (fst x) (snd x) xs + + null EmptyPairIntInt = True + null _ = False + + head EmptyPairIntInt = errorEmptyList "head" + head (ConsPairIntInt x y _) = pair x y + tail EmptyPairIntInt = errorEmptyList "tail" + tail (ConsPairIntInt _ _ xs) = xs +-} + + + +derive :: (Typeable a, Data a, Typeable b, Data b) => a -> b -> String +derive x y = render $ + hang + (hsep [text "instance", text "AdaptList", + parens (text "Pair" <+> text type_x <+> text type_y), text "where"]) + 4 + (vcat [ + -- data List (Pair Int Int) + -- = EmptyPairIntInt + -- | ConsPairIntInt {-# UNPACK #-}!Int {-# UNPACK #-}!Int (List (Pair Int Int)) + + hsep [ text "data" + , text "List" + , parens (hsep [text "Pair" + , text type_x + , text type_y + ]) + ], + + (hang empty 4 + (vcat [ hsep [ char '=', text myemptyconstr] + , hsep [ char '|' + , text myconsconstr + , text "{-# UNPACK #-}!" <> text type_x + , text "{-# UNPACK #-}!" <> text type_y + , parens (text "List" <+> + parens (text "Pair" <+> text type_x <+> text type_y)) + ] + ])) + + ,hsep [ text "empty" + ,char '=' + , text myemptyconstr] + + -- cons x xs = ConsPairIntInt (fst x) (snd x) xs + + ,hsep [ text "cons" + , char 'x' + , char 'z' + ,char '=' + , text myconsconstr + , parens (text "fst" <+> char 'x') + , parens (text "snd" <+> char 'x') + , char 'z' + ] + + ,hsep [ text "null" + , text myemptyconstr + ,char '=' + , text "True"] + ,hsep [ text "null" + , char '_' + ,char '=' + , text "False"] + + ,hsep [ text "head" + , text myemptyconstr + ,char '=' + , text "errorEmptyList \"head\"" + ] + ,hsep [ text "head" + , parens (text myconsconstr <+> char 'x' <+> char 'y' <+> char '_') + ,char '=' + , text "pair" <+> char 'x' <+> char 'y'] + + ,hsep [ text "tail" + , text myemptyconstr + ,char '=' + , text "errorEmptyList \"tail\"" + ] + ,hsep [ text "tail" + , parens (text myconsconstr <+> char '_' <+> char '_' <+> char 'x') + ,char '=' + , char 'x'] + + ]) + +{- + +-} + + where + type_x = inst_a + + type_y = inst_b + + myemptyconstr = "EmptyPair" ++ type_x ++ type_y + myconsconstr = "ConsPair" ++ type_x ++ type_y + + inst_a = wrap $ tyConString typeName ++ concatMap (" "++) typeLetters + where (typeName,typeChildren) = splitTyConApp (typeOf x) + typeLetters = take nTypeChildren manyLetters + nTypeChildren = length typeChildren + wrap x = if nTypeChildren > 0 then "("++x++")" else x + + inst_b = wrap $ tyConString typeName ++ concatMap (" "++) typeLetters + where (typeName,typeChildren) = splitTyConApp (typeOf y) + typeLetters = take nTypeChildren manyLetters + nTypeChildren = length typeChildren + wrap x = if nTypeChildren > 0 then "("++x++")" else x + + manyLetters = map (:[]) ['a'..'z']