adaptive-containers 0.1 → 0.2

raw patch · 9 files changed

+2514/−336 lines, 9 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Data/Adaptive/List.hs +1981/−0
• Data/Adaptive/Tuple.hs +222/−213
• adaptive-containers.cabal +23/−8
• scripts/derive-list.hs +143/−0
• scripts/derive-pair.hs +115/−0
• scripts/derive.hs +0/−115
• tests/A.hs +11/−0
• tests/B.hs +9/−0
• tests/list.hs +10/−0

@@ -0,0 +1,1981 @@+{-# LANGUAGE TypeFamilies         #-}+{-# 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

@@ -1,5 +1,7 @@-{-# LANGUAGE TypeFamilies       #-}-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, OverlappingInstances #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE OverlappingInstances  #-}  -- | -- Module      : Data.Adaptive.Tuple@@ -62,7 +64,7 @@ -- -- | Representation-improving polymorphic tuples. ---class Adapt a b where+class AdaptPair a b where    data Pair a b @@ -78,43 +80,43 @@ ------------------------------------------------------------------------  -- | Construct a new pair.-pair :: Adapt a b => a -> b -> Pair a b+pair :: AdaptPair a b => a -> b -> Pair a b pair = curry id  -- | 'uncurry' converts a curried function to a function on pairs.-uncurry :: Adapt a b => (a -> b -> c) -> (Pair a b -> c)+uncurry :: AdaptPair a b => (a -> b -> c) -> (Pair a b -> c) uncurry f p =  f (fst p) (snd p)  -- | Convert an adaptive pair to a regular polymorphic tuple-fromPair :: Adapt a b => Pair a b -> (a, b)+fromPair :: AdaptPair a b => Pair a b -> (a, b) fromPair = uncurry (,)  -- | Convert a regular polymorphic tuple to an adaptive pair-toPair   :: Adapt a b => (a,b) -> Pair a b+toPair   :: AdaptPair a b => (a,b) -> Pair a b toPair (a,b) = pair a b  ------------------------------------------------------------------------ -- Methods  -- standalone deriving crashes here: do not attempt it.--- deriving instance (Eq a, Eq b, Adapt a b) => Eq (Pair a b)--- deriving instance (Ord a, Ord b, Adapt a b) => Ord (Pair a b)--- deriving instance (Show a, Show b, Adapt a b) => Show (Pair a b)+-- 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) -instance (Bounded a, Bounded b, Adapt a b) => Bounded (Pair a b) where+instance (Bounded a, Bounded b, AdaptPair a b) => Bounded (Pair a b) where     minBound = pair minBound minBound     maxBound = pair maxBound maxBound -instance (Eq a, Eq b, Adapt a b) => Eq (Pair a b) where+instance (Eq a, Eq b, AdaptPair a b) => Eq (Pair a b) where     p == q = fst p == fst q && snd p == snd q -instance (Ord a, Ord b, Adapt a b) => Ord (Pair a b) where+instance (Ord a, Ord b, AdaptPair a b) => Ord (Pair a b) where     compare p q =         compare (fst p) (fst q)       `compare`         compare (snd p) (snd q) -instance (Show a, Show b, Adapt a b) => Show (Pair a b) where+instance (Show a, Show b, AdaptPair a b) => Show (Pair a b) where     show p = "Pair " ++ show (fst p) ++ " "++ show (snd p)  ------------------------------------------------------------------------@@ -123,7 +125,7 @@ --  -instance Adapt a b where+instance AdaptPair a b where   newtype Pair a b = PairPair { unPair :: (,) a b }    fst     = Prelude.fst . unPair@@ -135,1192 +137,1199 @@ -- Hand written instances: -- -instance Adapt () () where+instance AdaptPair () () where   data Pair () () = PUnit    fst PUnit = ()   snd PUnit = ()   curry f _ _    =  f PUnit +instance AdaptPair Bool Bool where+  data Pair Bool Bool = PBool {-# UNPACK #-}!Int {-# UNPACK #-}!Int++  fst (PBool x _) = Prelude.toEnum x+  snd (PBool _ x) = Prelude.toEnum x+  curry f x y    =  f (PBool (Prelude.fromEnum x) (Prelude.fromEnum y))+ -- TODO: sums:     Bool -- TODO: products: pairs  ------------------------------------------------------------------------ ----- Generated by scripts/derive.hs+-- Generated by scripts/derive-pair.hs -- -instance Adapt Int Int where+instance AdaptPair Int Int where     data Pair Int Int = PairIntInt {-# UNPACK #-}!Int {-# UNPACK #-}!Int     fst (PairIntInt a _) = a     snd (PairIntInt _ b) = b     curry f x y = f (PairIntInt x y) -instance Adapt Int Integer where+instance AdaptPair Int Integer where     data Pair Int Integer = PairIntInteger {-# UNPACK #-}!Int {-# UNPACK #-}!Integer     fst (PairIntInteger a _) = a     snd (PairIntInteger _ b) = b     curry f x y = f (PairIntInteger x y) -instance Adapt Int Int8 where+instance AdaptPair Int Int8 where     data Pair Int Int8 = PairIntInt8 {-# UNPACK #-}!Int {-# UNPACK #-}!Int8     fst (PairIntInt8 a _) = a     snd (PairIntInt8 _ b) = b     curry f x y = f (PairIntInt8 x y) -instance Adapt Int Int16 where+instance AdaptPair Int Int16 where     data Pair Int Int16 = PairIntInt16 {-# UNPACK #-}!Int {-# UNPACK #-}!Int16     fst (PairIntInt16 a _) = a     snd (PairIntInt16 _ b) = b     curry f x y = f (PairIntInt16 x y) -instance Adapt Int Int32 where+instance AdaptPair Int Int32 where     data Pair Int Int32 = PairIntInt32 {-# UNPACK #-}!Int {-# UNPACK #-}!Int32     fst (PairIntInt32 a _) = a     snd (PairIntInt32 _ b) = b     curry f x y = f (PairIntInt32 x y) -instance Adapt Int Int64 where+instance AdaptPair Int Int64 where     data Pair Int Int64 = PairIntInt64 {-# UNPACK #-}!Int {-# UNPACK #-}!Int64     fst (PairIntInt64 a _) = a     snd (PairIntInt64 _ b) = b     curry f x y = f (PairIntInt64 x y) -instance Adapt Int Word where+instance AdaptPair Int Word where     data Pair Int Word = PairIntWord {-# UNPACK #-}!Int {-# UNPACK #-}!Word     fst (PairIntWord a _) = a     snd (PairIntWord _ b) = b     curry f x y = f (PairIntWord x y) -instance Adapt Int Word8 where+instance AdaptPair Int Word8 where     data Pair Int Word8 = PairIntWord8 {-# UNPACK #-}!Int {-# UNPACK #-}!Word8     fst (PairIntWord8 a _) = a     snd (PairIntWord8 _ b) = b     curry f x y = f (PairIntWord8 x y) -instance Adapt Int Word16 where+instance AdaptPair Int Word16 where     data Pair Int Word16 = PairIntWord16 {-# UNPACK #-}!Int {-# UNPACK #-}!Word16     fst (PairIntWord16 a _) = a     snd (PairIntWord16 _ b) = b     curry f x y = f (PairIntWord16 x y) -instance Adapt Int Word32 where+instance AdaptPair Int Word32 where     data Pair Int Word32 = PairIntWord32 {-# UNPACK #-}!Int {-# UNPACK #-}!Word32     fst (PairIntWord32 a _) = a     snd (PairIntWord32 _ b) = b     curry f x y = f (PairIntWord32 x y) -instance Adapt Int Word64 where+instance AdaptPair Int Word64 where     data Pair Int Word64 = PairIntWord64 {-# UNPACK #-}!Int {-# UNPACK #-}!Word64     fst (PairIntWord64 a _) = a     snd (PairIntWord64 _ b) = b     curry f x y = f (PairIntWord64 x y) -instance Adapt Int Double where+instance AdaptPair Int Double where     data Pair Int Double = PairIntDouble {-# UNPACK #-}!Int {-# UNPACK #-}!Double     fst (PairIntDouble a _) = a     snd (PairIntDouble _ b) = b     curry f x y = f (PairIntDouble x y) -instance Adapt Int Float where+instance AdaptPair Int Float where     data Pair Int Float = PairIntFloat {-# UNPACK #-}!Int {-# UNPACK #-}!Float     fst (PairIntFloat a _) = a     snd (PairIntFloat _ b) = b     curry f x y = f (PairIntFloat x y) -instance Adapt Int Char where+instance AdaptPair Int Char where     data Pair Int Char = PairIntChar {-# UNPACK #-}!Int {-# UNPACK #-}!Char     fst (PairIntChar a _) = a     snd (PairIntChar _ b) = b     curry f x y = f (PairIntChar x y) -instance Adapt Integer Int where+instance AdaptPair Integer Int where     data Pair Integer Int = PairIntegerInt {-# UNPACK #-}!Integer {-# UNPACK #-}!Int     fst (PairIntegerInt a _) = a     snd (PairIntegerInt _ b) = b     curry f x y = f (PairIntegerInt x y) -instance Adapt Integer Integer where+instance AdaptPair Integer Integer where     data Pair Integer Integer = PairIntegerInteger {-# UNPACK #-}!Integer {-# UNPACK #-}!Integer     fst (PairIntegerInteger a _) = a     snd (PairIntegerInteger _ b) = b     curry f x y = f (PairIntegerInteger x y) -instance Adapt Integer Int8 where+instance AdaptPair Integer Int8 where     data Pair Integer Int8 = PairIntegerInt8 {-# UNPACK #-}!Integer {-# UNPACK #-}!Int8     fst (PairIntegerInt8 a _) = a     snd (PairIntegerInt8 _ b) = b     curry f x y = f (PairIntegerInt8 x y) -instance Adapt Integer Int16 where+instance AdaptPair Integer Int16 where     data Pair Integer Int16 = PairIntegerInt16 {-# UNPACK #-}!Integer {-# UNPACK #-}!Int16     fst (PairIntegerInt16 a _) = a     snd (PairIntegerInt16 _ b) = b     curry f x y = f (PairIntegerInt16 x y) -instance Adapt Integer Int32 where+instance AdaptPair Integer Int32 where     data Pair Integer Int32 = PairIntegerInt32 {-# UNPACK #-}!Integer {-# UNPACK #-}!Int32     fst (PairIntegerInt32 a _) = a     snd (PairIntegerInt32 _ b) = b     curry f x y = f (PairIntegerInt32 x y) -instance Adapt Integer Int64 where+instance AdaptPair Integer Int64 where     data Pair Integer Int64 = PairIntegerInt64 {-# UNPACK #-}!Integer {-# UNPACK #-}!Int64     fst (PairIntegerInt64 a _) = a     snd (PairIntegerInt64 _ b) = b     curry f x y = f (PairIntegerInt64 x y) -instance Adapt Integer Word where+instance AdaptPair Integer Word where     data Pair Integer Word = PairIntegerWord {-# UNPACK #-}!Integer {-# UNPACK #-}!Word     fst (PairIntegerWord a _) = a     snd (PairIntegerWord _ b) = b     curry f x y = f (PairIntegerWord x y) -instance Adapt Integer Word8 where+instance AdaptPair Integer Word8 where     data Pair Integer Word8 = PairIntegerWord8 {-# UNPACK #-}!Integer {-# UNPACK #-}!Word8     fst (PairIntegerWord8 a _) = a     snd (PairIntegerWord8 _ b) = b     curry f x y = f (PairIntegerWord8 x y) -instance Adapt Integer Word16 where+instance AdaptPair Integer Word16 where     data Pair Integer Word16 = PairIntegerWord16 {-# UNPACK #-}!Integer {-# UNPACK #-}!Word16     fst (PairIntegerWord16 a _) = a     snd (PairIntegerWord16 _ b) = b     curry f x y = f (PairIntegerWord16 x y) -instance Adapt Integer Word32 where+instance AdaptPair Integer Word32 where     data Pair Integer Word32 = PairIntegerWord32 {-# UNPACK #-}!Integer {-# UNPACK #-}!Word32     fst (PairIntegerWord32 a _) = a     snd (PairIntegerWord32 _ b) = b     curry f x y = f (PairIntegerWord32 x y) -instance Adapt Integer Word64 where+instance AdaptPair Integer Word64 where     data Pair Integer Word64 = PairIntegerWord64 {-# UNPACK #-}!Integer {-# UNPACK #-}!Word64     fst (PairIntegerWord64 a _) = a     snd (PairIntegerWord64 _ b) = b     curry f x y = f (PairIntegerWord64 x y) -instance Adapt Integer Double where+instance AdaptPair Integer Double where     data Pair Integer Double = PairIntegerDouble {-# UNPACK #-}!Integer {-# UNPACK #-}!Double     fst (PairIntegerDouble a _) = a     snd (PairIntegerDouble _ b) = b     curry f x y = f (PairIntegerDouble x y) -instance Adapt Integer Float where+instance AdaptPair Integer Float where     data Pair Integer Float = PairIntegerFloat {-# UNPACK #-}!Integer {-# UNPACK #-}!Float     fst (PairIntegerFloat a _) = a     snd (PairIntegerFloat _ b) = b     curry f x y = f (PairIntegerFloat x y) -instance Adapt Integer Char where+instance AdaptPair Integer Char where     data Pair Integer Char = PairIntegerChar {-# UNPACK #-}!Integer {-# UNPACK #-}!Char     fst (PairIntegerChar a _) = a     snd (PairIntegerChar _ b) = b     curry f x y = f (PairIntegerChar x y) -instance Adapt Int8 Int where+instance AdaptPair Int8 Int where     data Pair Int8 Int = PairInt8Int {-# UNPACK #-}!Int8 {-# UNPACK #-}!Int     fst (PairInt8Int a _) = a     snd (PairInt8Int _ b) = b     curry f x y = f (PairInt8Int x y) -instance Adapt Int8 Integer where+instance AdaptPair Int8 Integer where     data Pair Int8 Integer = PairInt8Integer {-# UNPACK #-}!Int8 {-# UNPACK #-}!Integer     fst (PairInt8Integer a _) = a     snd (PairInt8Integer _ b) = b     curry f x y = f (PairInt8Integer x y) -instance Adapt Int8 Int8 where+instance AdaptPair Int8 Int8 where     data Pair Int8 Int8 = PairInt8Int8 {-# UNPACK #-}!Int8 {-# UNPACK #-}!Int8     fst (PairInt8Int8 a _) = a     snd (PairInt8Int8 _ b) = b     curry f x y = f (PairInt8Int8 x y) -instance Adapt Int8 Int16 where+instance AdaptPair Int8 Int16 where     data Pair Int8 Int16 = PairInt8Int16 {-# UNPACK #-}!Int8 {-# UNPACK #-}!Int16     fst (PairInt8Int16 a _) = a     snd (PairInt8Int16 _ b) = b     curry f x y = f (PairInt8Int16 x y) -instance Adapt Int8 Int32 where+instance AdaptPair Int8 Int32 where     data Pair Int8 Int32 = PairInt8Int32 {-# UNPACK #-}!Int8 {-# UNPACK #-}!Int32     fst (PairInt8Int32 a _) = a     snd (PairInt8Int32 _ b) = b     curry f x y = f (PairInt8Int32 x y) -instance Adapt Int8 Int64 where+instance AdaptPair Int8 Int64 where     data Pair Int8 Int64 = PairInt8Int64 {-# UNPACK #-}!Int8 {-# UNPACK #-}!Int64     fst (PairInt8Int64 a _) = a     snd (PairInt8Int64 _ b) = b     curry f x y = f (PairInt8Int64 x y) -instance Adapt Int8 Word where+instance AdaptPair Int8 Word where     data Pair Int8 Word = PairInt8Word {-# UNPACK #-}!Int8 {-# UNPACK #-}!Word     fst (PairInt8Word a _) = a     snd (PairInt8Word _ b) = b     curry f x y = f (PairInt8Word x y) -instance Adapt Int8 Word8 where+instance AdaptPair Int8 Word8 where     data Pair Int8 Word8 = PairInt8Word8 {-# UNPACK #-}!Int8 {-# UNPACK #-}!Word8     fst (PairInt8Word8 a _) = a     snd (PairInt8Word8 _ b) = b     curry f x y = f (PairInt8Word8 x y) -instance Adapt Int8 Word16 where+instance AdaptPair Int8 Word16 where     data Pair Int8 Word16 = PairInt8Word16 {-# UNPACK #-}!Int8 {-# UNPACK #-}!Word16     fst (PairInt8Word16 a _) = a     snd (PairInt8Word16 _ b) = b     curry f x y = f (PairInt8Word16 x y) -instance Adapt Int8 Word32 where+instance AdaptPair Int8 Word32 where     data Pair Int8 Word32 = PairInt8Word32 {-# UNPACK #-}!Int8 {-# UNPACK #-}!Word32     fst (PairInt8Word32 a _) = a     snd (PairInt8Word32 _ b) = b     curry f x y = f (PairInt8Word32 x y) -instance Adapt Int8 Word64 where+instance AdaptPair Int8 Word64 where     data Pair Int8 Word64 = PairInt8Word64 {-# UNPACK #-}!Int8 {-# UNPACK #-}!Word64     fst (PairInt8Word64 a _) = a     snd (PairInt8Word64 _ b) = b     curry f x y = f (PairInt8Word64 x y) -instance Adapt Int8 Double where+instance AdaptPair Int8 Double where     data Pair Int8 Double = PairInt8Double {-# UNPACK #-}!Int8 {-# UNPACK #-}!Double     fst (PairInt8Double a _) = a     snd (PairInt8Double _ b) = b     curry f x y = f (PairInt8Double x y) -instance Adapt Int8 Float where+instance AdaptPair Int8 Float where     data Pair Int8 Float = PairInt8Float {-# UNPACK #-}!Int8 {-# UNPACK #-}!Float     fst (PairInt8Float a _) = a     snd (PairInt8Float _ b) = b     curry f x y = f (PairInt8Float x y) -instance Adapt Int8 Char where+instance AdaptPair Int8 Char where     data Pair Int8 Char = PairInt8Char {-# UNPACK #-}!Int8 {-# UNPACK #-}!Char     fst (PairInt8Char a _) = a     snd (PairInt8Char _ b) = b     curry f x y = f (PairInt8Char x y) -instance Adapt Int16 Int where+instance AdaptPair Int16 Int where     data Pair Int16 Int = PairInt16Int {-# UNPACK #-}!Int16 {-# UNPACK #-}!Int     fst (PairInt16Int a _) = a     snd (PairInt16Int _ b) = b     curry f x y = f (PairInt16Int x y) -instance Adapt Int16 Integer where+instance AdaptPair Int16 Integer where     data Pair Int16 Integer = PairInt16Integer {-# UNPACK #-}!Int16 {-# UNPACK #-}!Integer     fst (PairInt16Integer a _) = a     snd (PairInt16Integer _ b) = b     curry f x y = f (PairInt16Integer x y) -instance Adapt Int16 Int8 where+instance AdaptPair Int16 Int8 where     data Pair Int16 Int8 = PairInt16Int8 {-# UNPACK #-}!Int16 {-# UNPACK #-}!Int8     fst (PairInt16Int8 a _) = a     snd (PairInt16Int8 _ b) = b     curry f x y = f (PairInt16Int8 x y) -instance Adapt Int16 Int16 where+instance AdaptPair Int16 Int16 where     data Pair Int16 Int16 = PairInt16Int16 {-# UNPACK #-}!Int16 {-# UNPACK #-}!Int16     fst (PairInt16Int16 a _) = a     snd (PairInt16Int16 _ b) = b     curry f x y = f (PairInt16Int16 x y) -instance Adapt Int16 Int32 where+instance AdaptPair Int16 Int32 where     data Pair Int16 Int32 = PairInt16Int32 {-# UNPACK #-}!Int16 {-# UNPACK #-}!Int32     fst (PairInt16Int32 a _) = a     snd (PairInt16Int32 _ b) = b     curry f x y = f (PairInt16Int32 x y) -instance Adapt Int16 Int64 where+instance AdaptPair Int16 Int64 where     data Pair Int16 Int64 = PairInt16Int64 {-# UNPACK #-}!Int16 {-# UNPACK #-}!Int64     fst (PairInt16Int64 a _) = a     snd (PairInt16Int64 _ b) = b     curry f x y = f (PairInt16Int64 x y) -instance Adapt Int16 Word where+instance AdaptPair Int16 Word where     data Pair Int16 Word = PairInt16Word {-# UNPACK #-}!Int16 {-# UNPACK #-}!Word     fst (PairInt16Word a _) = a     snd (PairInt16Word _ b) = b     curry f x y = f (PairInt16Word x y) -instance Adapt Int16 Word8 where+instance AdaptPair Int16 Word8 where     data Pair Int16 Word8 = PairInt16Word8 {-# UNPACK #-}!Int16 {-# UNPACK #-}!Word8     fst (PairInt16Word8 a _) = a     snd (PairInt16Word8 _ b) = b     curry f x y = f (PairInt16Word8 x y) -instance Adapt Int16 Word16 where+instance AdaptPair Int16 Word16 where     data Pair Int16 Word16 = PairInt16Word16 {-# UNPACK #-}!Int16 {-# UNPACK #-}!Word16     fst (PairInt16Word16 a _) = a     snd (PairInt16Word16 _ b) = b     curry f x y = f (PairInt16Word16 x y) -instance Adapt Int16 Word32 where+instance AdaptPair Int16 Word32 where     data Pair Int16 Word32 = PairInt16Word32 {-# UNPACK #-}!Int16 {-# UNPACK #-}!Word32     fst (PairInt16Word32 a _) = a     snd (PairInt16Word32 _ b) = b     curry f x y = f (PairInt16Word32 x y) -instance Adapt Int16 Word64 where+instance AdaptPair Int16 Word64 where     data Pair Int16 Word64 = PairInt16Word64 {-# UNPACK #-}!Int16 {-# UNPACK #-}!Word64     fst (PairInt16Word64 a _) = a     snd (PairInt16Word64 _ b) = b     curry f x y = f (PairInt16Word64 x y) -instance Adapt Int16 Double where+instance AdaptPair Int16 Double where     data Pair Int16 Double = PairInt16Double {-# UNPACK #-}!Int16 {-# UNPACK #-}!Double     fst (PairInt16Double a _) = a     snd (PairInt16Double _ b) = b     curry f x y = f (PairInt16Double x y) -instance Adapt Int16 Float where+instance AdaptPair Int16 Float where     data Pair Int16 Float = PairInt16Float {-# UNPACK #-}!Int16 {-# UNPACK #-}!Float     fst (PairInt16Float a _) = a     snd (PairInt16Float _ b) = b     curry f x y = f (PairInt16Float x y) -instance Adapt Int16 Char where+instance AdaptPair Int16 Char where     data Pair Int16 Char = PairInt16Char {-# UNPACK #-}!Int16 {-# UNPACK #-}!Char     fst (PairInt16Char a _) = a     snd (PairInt16Char _ b) = b     curry f x y = f (PairInt16Char x y) -instance Adapt Int32 Int where+instance AdaptPair Int32 Int where     data Pair Int32 Int = PairInt32Int {-# UNPACK #-}!Int32 {-# UNPACK #-}!Int     fst (PairInt32Int a _) = a     snd (PairInt32Int _ b) = b     curry f x y = f (PairInt32Int x y) -instance Adapt Int32 Integer where+instance AdaptPair Int32 Integer where     data Pair Int32 Integer = PairInt32Integer {-# UNPACK #-}!Int32 {-# UNPACK #-}!Integer     fst (PairInt32Integer a _) = a     snd (PairInt32Integer _ b) = b     curry f x y = f (PairInt32Integer x y) -instance Adapt Int32 Int8 where+instance AdaptPair Int32 Int8 where     data Pair Int32 Int8 = PairInt32Int8 {-# UNPACK #-}!Int32 {-# UNPACK #-}!Int8     fst (PairInt32Int8 a _) = a     snd (PairInt32Int8 _ b) = b     curry f x y = f (PairInt32Int8 x y) -instance Adapt Int32 Int16 where+instance AdaptPair Int32 Int16 where     data Pair Int32 Int16 = PairInt32Int16 {-# UNPACK #-}!Int32 {-# UNPACK #-}!Int16     fst (PairInt32Int16 a _) = a     snd (PairInt32Int16 _ b) = b     curry f x y = f (PairInt32Int16 x y) -instance Adapt Int32 Int32 where+instance AdaptPair Int32 Int32 where     data Pair Int32 Int32 = PairInt32Int32 {-# UNPACK #-}!Int32 {-# UNPACK #-}!Int32     fst (PairInt32Int32 a _) = a     snd (PairInt32Int32 _ b) = b     curry f x y = f (PairInt32Int32 x y) -instance Adapt Int32 Int64 where+instance AdaptPair Int32 Int64 where     data Pair Int32 Int64 = PairInt32Int64 {-# UNPACK #-}!Int32 {-# UNPACK #-}!Int64     fst (PairInt32Int64 a _) = a     snd (PairInt32Int64 _ b) = b     curry f x y = f (PairInt32Int64 x y) -instance Adapt Int32 Word where+instance AdaptPair Int32 Word where     data Pair Int32 Word = PairInt32Word {-# UNPACK #-}!Int32 {-# UNPACK #-}!Word     fst (PairInt32Word a _) = a     snd (PairInt32Word _ b) = b     curry f x y = f (PairInt32Word x y) -instance Adapt Int32 Word8 where+instance AdaptPair Int32 Word8 where     data Pair Int32 Word8 = PairInt32Word8 {-# UNPACK #-}!Int32 {-# UNPACK #-}!Word8     fst (PairInt32Word8 a _) = a     snd (PairInt32Word8 _ b) = b     curry f x y = f (PairInt32Word8 x y) -instance Adapt Int32 Word16 where+instance AdaptPair Int32 Word16 where     data Pair Int32 Word16 = PairInt32Word16 {-# UNPACK #-}!Int32 {-# UNPACK #-}!Word16     fst (PairInt32Word16 a _) = a     snd (PairInt32Word16 _ b) = b     curry f x y = f (PairInt32Word16 x y) -instance Adapt Int32 Word32 where+instance AdaptPair Int32 Word32 where     data Pair Int32 Word32 = PairInt32Word32 {-# UNPACK #-}!Int32 {-# UNPACK #-}!Word32     fst (PairInt32Word32 a _) = a     snd (PairInt32Word32 _ b) = b     curry f x y = f (PairInt32Word32 x y) -instance Adapt Int32 Word64 where+instance AdaptPair Int32 Word64 where     data Pair Int32 Word64 = PairInt32Word64 {-# UNPACK #-}!Int32 {-# UNPACK #-}!Word64     fst (PairInt32Word64 a _) = a     snd (PairInt32Word64 _ b) = b     curry f x y = f (PairInt32Word64 x y) -instance Adapt Int32 Double where+instance AdaptPair Int32 Double where     data Pair Int32 Double = PairInt32Double {-# UNPACK #-}!Int32 {-# UNPACK #-}!Double     fst (PairInt32Double a _) = a     snd (PairInt32Double _ b) = b     curry f x y = f (PairInt32Double x y) -instance Adapt Int32 Float where+instance AdaptPair Int32 Float where     data Pair Int32 Float = PairInt32Float {-# UNPACK #-}!Int32 {-# UNPACK #-}!Float     fst (PairInt32Float a _) = a     snd (PairInt32Float _ b) = b     curry f x y = f (PairInt32Float x y) -instance Adapt Int32 Char where+instance AdaptPair Int32 Char where     data Pair Int32 Char = PairInt32Char {-# UNPACK #-}!Int32 {-# UNPACK #-}!Char     fst (PairInt32Char a _) = a     snd (PairInt32Char _ b) = b     curry f x y = f (PairInt32Char x y) -instance Adapt Int64 Int where+instance AdaptPair Int64 Int where     data Pair Int64 Int = PairInt64Int {-# UNPACK #-}!Int64 {-# UNPACK #-}!Int     fst (PairInt64Int a _) = a     snd (PairInt64Int _ b) = b     curry f x y = f (PairInt64Int x y) -instance Adapt Int64 Integer where+instance AdaptPair Int64 Integer where     data Pair Int64 Integer = PairInt64Integer {-# UNPACK #-}!Int64 {-# UNPACK #-}!Integer     fst (PairInt64Integer a _) = a     snd (PairInt64Integer _ b) = b     curry f x y = f (PairInt64Integer x y) -instance Adapt Int64 Int8 where+instance AdaptPair Int64 Int8 where     data Pair Int64 Int8 = PairInt64Int8 {-# UNPACK #-}!Int64 {-# UNPACK #-}!Int8     fst (PairInt64Int8 a _) = a     snd (PairInt64Int8 _ b) = b     curry f x y = f (PairInt64Int8 x y) -instance Adapt Int64 Int16 where+instance AdaptPair Int64 Int16 where     data Pair Int64 Int16 = PairInt64Int16 {-# UNPACK #-}!Int64 {-# UNPACK #-}!Int16     fst (PairInt64Int16 a _) = a     snd (PairInt64Int16 _ b) = b     curry f x y = f (PairInt64Int16 x y) -instance Adapt Int64 Int32 where+instance AdaptPair Int64 Int32 where     data Pair Int64 Int32 = PairInt64Int32 {-# UNPACK #-}!Int64 {-# UNPACK #-}!Int32     fst (PairInt64Int32 a _) = a     snd (PairInt64Int32 _ b) = b     curry f x y = f (PairInt64Int32 x y) -instance Adapt Int64 Int64 where+instance AdaptPair Int64 Int64 where     data Pair Int64 Int64 = PairInt64Int64 {-# UNPACK #-}!Int64 {-# UNPACK #-}!Int64     fst (PairInt64Int64 a _) = a     snd (PairInt64Int64 _ b) = b     curry f x y = f (PairInt64Int64 x y) -instance Adapt Int64 Word where+instance AdaptPair Int64 Word where     data Pair Int64 Word = PairInt64Word {-# UNPACK #-}!Int64 {-# UNPACK #-}!Word     fst (PairInt64Word a _) = a     snd (PairInt64Word _ b) = b     curry f x y = f (PairInt64Word x y) -instance Adapt Int64 Word8 where+instance AdaptPair Int64 Word8 where     data Pair Int64 Word8 = PairInt64Word8 {-# UNPACK #-}!Int64 {-# UNPACK #-}!Word8     fst (PairInt64Word8 a _) = a     snd (PairInt64Word8 _ b) = b     curry f x y = f (PairInt64Word8 x y) -instance Adapt Int64 Word16 where+instance AdaptPair Int64 Word16 where     data Pair Int64 Word16 = PairInt64Word16 {-# UNPACK #-}!Int64 {-# UNPACK #-}!Word16     fst (PairInt64Word16 a _) = a     snd (PairInt64Word16 _ b) = b     curry f x y = f (PairInt64Word16 x y) -instance Adapt Int64 Word32 where+instance AdaptPair Int64 Word32 where     data Pair Int64 Word32 = PairInt64Word32 {-# UNPACK #-}!Int64 {-# UNPACK #-}!Word32     fst (PairInt64Word32 a _) = a     snd (PairInt64Word32 _ b) = b     curry f x y = f (PairInt64Word32 x y) -instance Adapt Int64 Word64 where+instance AdaptPair Int64 Word64 where     data Pair Int64 Word64 = PairInt64Word64 {-# UNPACK #-}!Int64 {-# UNPACK #-}!Word64     fst (PairInt64Word64 a _) = a     snd (PairInt64Word64 _ b) = b     curry f x y = f (PairInt64Word64 x y) -instance Adapt Int64 Double where+instance AdaptPair Int64 Double where     data Pair Int64 Double = PairInt64Double {-# UNPACK #-}!Int64 {-# UNPACK #-}!Double     fst (PairInt64Double a _) = a     snd (PairInt64Double _ b) = b     curry f x y = f (PairInt64Double x y) -instance Adapt Int64 Float where+instance AdaptPair Int64 Float where     data Pair Int64 Float = PairInt64Float {-# UNPACK #-}!Int64 {-# UNPACK #-}!Float     fst (PairInt64Float a _) = a     snd (PairInt64Float _ b) = b     curry f x y = f (PairInt64Float x y) -instance Adapt Int64 Char where+instance AdaptPair Int64 Char where     data Pair Int64 Char = PairInt64Char {-# UNPACK #-}!Int64 {-# UNPACK #-}!Char     fst (PairInt64Char a _) = a     snd (PairInt64Char _ b) = b     curry f x y = f (PairInt64Char x y) -instance Adapt Word Int where+instance AdaptPair Word Int where     data Pair Word Int = PairWordInt {-# UNPACK #-}!Word {-# UNPACK #-}!Int     fst (PairWordInt a _) = a     snd (PairWordInt _ b) = b     curry f x y = f (PairWordInt x y) -instance Adapt Word Integer where+instance AdaptPair Word Integer where     data Pair Word Integer = PairWordInteger {-# UNPACK #-}!Word {-# UNPACK #-}!Integer     fst (PairWordInteger a _) = a     snd (PairWordInteger _ b) = b     curry f x y = f (PairWordInteger x y) -instance Adapt Word Int8 where+instance AdaptPair Word Int8 where     data Pair Word Int8 = PairWordInt8 {-# UNPACK #-}!Word {-# UNPACK #-}!Int8     fst (PairWordInt8 a _) = a     snd (PairWordInt8 _ b) = b     curry f x y = f (PairWordInt8 x y) -instance Adapt Word Int16 where+instance AdaptPair Word Int16 where     data Pair Word Int16 = PairWordInt16 {-# UNPACK #-}!Word {-# UNPACK #-}!Int16     fst (PairWordInt16 a _) = a     snd (PairWordInt16 _ b) = b     curry f x y = f (PairWordInt16 x y) -instance Adapt Word Int32 where+instance AdaptPair Word Int32 where     data Pair Word Int32 = PairWordInt32 {-# UNPACK #-}!Word {-# UNPACK #-}!Int32     fst (PairWordInt32 a _) = a     snd (PairWordInt32 _ b) = b     curry f x y = f (PairWordInt32 x y) -instance Adapt Word Int64 where+instance AdaptPair Word Int64 where     data Pair Word Int64 = PairWordInt64 {-# UNPACK #-}!Word {-# UNPACK #-}!Int64     fst (PairWordInt64 a _) = a     snd (PairWordInt64 _ b) = b     curry f x y = f (PairWordInt64 x y) -instance Adapt Word Word where+instance AdaptPair Word Word where     data Pair Word Word = PairWordWord {-# UNPACK #-}!Word {-# UNPACK #-}!Word     fst (PairWordWord a _) = a     snd (PairWordWord _ b) = b     curry f x y = f (PairWordWord x y) -instance Adapt Word Word8 where+instance AdaptPair Word Word8 where     data Pair Word Word8 = PairWordWord8 {-# UNPACK #-}!Word {-# UNPACK #-}!Word8     fst (PairWordWord8 a _) = a     snd (PairWordWord8 _ b) = b     curry f x y = f (PairWordWord8 x y) -instance Adapt Word Word16 where+instance AdaptPair Word Word16 where     data Pair Word Word16 = PairWordWord16 {-# UNPACK #-}!Word {-# UNPACK #-}!Word16     fst (PairWordWord16 a _) = a     snd (PairWordWord16 _ b) = b     curry f x y = f (PairWordWord16 x y) -instance Adapt Word Word32 where+instance AdaptPair Word Word32 where     data Pair Word Word32 = PairWordWord32 {-# UNPACK #-}!Word {-# UNPACK #-}!Word32     fst (PairWordWord32 a _) = a     snd (PairWordWord32 _ b) = b     curry f x y = f (PairWordWord32 x y) -instance Adapt Word Word64 where+instance AdaptPair Word Word64 where     data Pair Word Word64 = PairWordWord64 {-# UNPACK #-}!Word {-# UNPACK #-}!Word64     fst (PairWordWord64 a _) = a     snd (PairWordWord64 _ b) = b     curry f x y = f (PairWordWord64 x y) -instance Adapt Word Double where+instance AdaptPair Word Double where     data Pair Word Double = PairWordDouble {-# UNPACK #-}!Word {-# UNPACK #-}!Double     fst (PairWordDouble a _) = a     snd (PairWordDouble _ b) = b     curry f x y = f (PairWordDouble x y) -instance Adapt Word Float where+instance AdaptPair Word Float where     data Pair Word Float = PairWordFloat {-# UNPACK #-}!Word {-# UNPACK #-}!Float     fst (PairWordFloat a _) = a     snd (PairWordFloat _ b) = b     curry f x y = f (PairWordFloat x y) -instance Adapt Word Char where+instance AdaptPair Word Char where     data Pair Word Char = PairWordChar {-# UNPACK #-}!Word {-# UNPACK #-}!Char     fst (PairWordChar a _) = a     snd (PairWordChar _ b) = b     curry f x y = f (PairWordChar x y) -instance Adapt Word8 Int where+instance AdaptPair Word8 Int where     data Pair Word8 Int = PairWord8Int {-# UNPACK #-}!Word8 {-# UNPACK #-}!Int     fst (PairWord8Int a _) = a     snd (PairWord8Int _ b) = b     curry f x y = f (PairWord8Int x y) -instance Adapt Word8 Integer where+instance AdaptPair Word8 Integer where     data Pair Word8 Integer = PairWord8Integer {-# UNPACK #-}!Word8 {-# UNPACK #-}!Integer     fst (PairWord8Integer a _) = a     snd (PairWord8Integer _ b) = b     curry f x y = f (PairWord8Integer x y) -instance Adapt Word8 Int8 where+instance AdaptPair Word8 Int8 where     data Pair Word8 Int8 = PairWord8Int8 {-# UNPACK #-}!Word8 {-# UNPACK #-}!Int8     fst (PairWord8Int8 a _) = a     snd (PairWord8Int8 _ b) = b     curry f x y = f (PairWord8Int8 x y) -instance Adapt Word8 Int16 where+instance AdaptPair Word8 Int16 where     data Pair Word8 Int16 = PairWord8Int16 {-# UNPACK #-}!Word8 {-# UNPACK #-}!Int16     fst (PairWord8Int16 a _) = a     snd (PairWord8Int16 _ b) = b     curry f x y = f (PairWord8Int16 x y) -instance Adapt Word8 Int32 where+instance AdaptPair Word8 Int32 where     data Pair Word8 Int32 = PairWord8Int32 {-# UNPACK #-}!Word8 {-# UNPACK #-}!Int32     fst (PairWord8Int32 a _) = a     snd (PairWord8Int32 _ b) = b     curry f x y = f (PairWord8Int32 x y) -instance Adapt Word8 Int64 where+instance AdaptPair Word8 Int64 where     data Pair Word8 Int64 = PairWord8Int64 {-# UNPACK #-}!Word8 {-# UNPACK #-}!Int64     fst (PairWord8Int64 a _) = a     snd (PairWord8Int64 _ b) = b     curry f x y = f (PairWord8Int64 x y) -instance Adapt Word8 Word where+instance AdaptPair Word8 Word where     data Pair Word8 Word = PairWord8Word {-# UNPACK #-}!Word8 {-# UNPACK #-}!Word     fst (PairWord8Word a _) = a     snd (PairWord8Word _ b) = b     curry f x y = f (PairWord8Word x y) -instance Adapt Word8 Word8 where+instance AdaptPair Word8 Word8 where     data Pair Word8 Word8 = PairWord8Word8 {-# UNPACK #-}!Word8 {-# UNPACK #-}!Word8     fst (PairWord8Word8 a _) = a     snd (PairWord8Word8 _ b) = b     curry f x y = f (PairWord8Word8 x y) -instance Adapt Word8 Word16 where+instance AdaptPair Word8 Word16 where     data Pair Word8 Word16 = PairWord8Word16 {-# UNPACK #-}!Word8 {-# UNPACK #-}!Word16     fst (PairWord8Word16 a _) = a     snd (PairWord8Word16 _ b) = b     curry f x y = f (PairWord8Word16 x y) -instance Adapt Word8 Word32 where+instance AdaptPair Word8 Word32 where     data Pair Word8 Word32 = PairWord8Word32 {-# UNPACK #-}!Word8 {-# UNPACK #-}!Word32     fst (PairWord8Word32 a _) = a     snd (PairWord8Word32 _ b) = b     curry f x y = f (PairWord8Word32 x y) -instance Adapt Word8 Word64 where+instance AdaptPair Word8 Word64 where     data Pair Word8 Word64 = PairWord8Word64 {-# UNPACK #-}!Word8 {-# UNPACK #-}!Word64     fst (PairWord8Word64 a _) = a     snd (PairWord8Word64 _ b) = b     curry f x y = f (PairWord8Word64 x y) -instance Adapt Word8 Double where+instance AdaptPair Word8 Double where     data Pair Word8 Double = PairWord8Double {-# UNPACK #-}!Word8 {-# UNPACK #-}!Double     fst (PairWord8Double a _) = a     snd (PairWord8Double _ b) = b     curry f x y = f (PairWord8Double x y) -instance Adapt Word8 Float where+instance AdaptPair Word8 Float where     data Pair Word8 Float = PairWord8Float {-# UNPACK #-}!Word8 {-# UNPACK #-}!Float     fst (PairWord8Float a _) = a     snd (PairWord8Float _ b) = b     curry f x y = f (PairWord8Float x y) -instance Adapt Word8 Char where+instance AdaptPair Word8 Char where     data Pair Word8 Char = PairWord8Char {-# UNPACK #-}!Word8 {-# UNPACK #-}!Char     fst (PairWord8Char a _) = a     snd (PairWord8Char _ b) = b     curry f x y = f (PairWord8Char x y) -instance Adapt Word16 Int where+instance AdaptPair Word16 Int where     data Pair Word16 Int = PairWord16Int {-# UNPACK #-}!Word16 {-# UNPACK #-}!Int     fst (PairWord16Int a _) = a     snd (PairWord16Int _ b) = b     curry f x y = f (PairWord16Int x y) -instance Adapt Word16 Integer where+instance AdaptPair Word16 Integer where     data Pair Word16 Integer = PairWord16Integer {-# UNPACK #-}!Word16 {-# UNPACK #-}!Integer     fst (PairWord16Integer a _) = a     snd (PairWord16Integer _ b) = b     curry f x y = f (PairWord16Integer x y) -instance Adapt Word16 Int8 where+instance AdaptPair Word16 Int8 where     data Pair Word16 Int8 = PairWord16Int8 {-# UNPACK #-}!Word16 {-# UNPACK #-}!Int8     fst (PairWord16Int8 a _) = a     snd (PairWord16Int8 _ b) = b     curry f x y = f (PairWord16Int8 x y) -instance Adapt Word16 Int16 where+instance AdaptPair Word16 Int16 where     data Pair Word16 Int16 = PairWord16Int16 {-# UNPACK #-}!Word16 {-# UNPACK #-}!Int16     fst (PairWord16Int16 a _) = a     snd (PairWord16Int16 _ b) = b     curry f x y = f (PairWord16Int16 x y) -instance Adapt Word16 Int32 where+instance AdaptPair Word16 Int32 where     data Pair Word16 Int32 = PairWord16Int32 {-# UNPACK #-}!Word16 {-# UNPACK #-}!Int32     fst (PairWord16Int32 a _) = a     snd (PairWord16Int32 _ b) = b     curry f x y = f (PairWord16Int32 x y) -instance Adapt Word16 Int64 where+instance AdaptPair Word16 Int64 where     data Pair Word16 Int64 = PairWord16Int64 {-# UNPACK #-}!Word16 {-# UNPACK #-}!Int64     fst (PairWord16Int64 a _) = a     snd (PairWord16Int64 _ b) = b     curry f x y = f (PairWord16Int64 x y) -instance Adapt Word16 Word where+instance AdaptPair Word16 Word where     data Pair Word16 Word = PairWord16Word {-# UNPACK #-}!Word16 {-# UNPACK #-}!Word     fst (PairWord16Word a _) = a     snd (PairWord16Word _ b) = b     curry f x y = f (PairWord16Word x y) -instance Adapt Word16 Word8 where+instance AdaptPair Word16 Word8 where     data Pair Word16 Word8 = PairWord16Word8 {-# UNPACK #-}!Word16 {-# UNPACK #-}!Word8     fst (PairWord16Word8 a _) = a     snd (PairWord16Word8 _ b) = b     curry f x y = f (PairWord16Word8 x y) -instance Adapt Word16 Word16 where+instance AdaptPair Word16 Word16 where     data Pair Word16 Word16 = PairWord16Word16 {-# UNPACK #-}!Word16 {-# UNPACK #-}!Word16     fst (PairWord16Word16 a _) = a     snd (PairWord16Word16 _ b) = b     curry f x y = f (PairWord16Word16 x y) -instance Adapt Word16 Word32 where+instance AdaptPair Word16 Word32 where     data Pair Word16 Word32 = PairWord16Word32 {-# UNPACK #-}!Word16 {-# UNPACK #-}!Word32     fst (PairWord16Word32 a _) = a     snd (PairWord16Word32 _ b) = b     curry f x y = f (PairWord16Word32 x y) -instance Adapt Word16 Word64 where+instance AdaptPair Word16 Word64 where     data Pair Word16 Word64 = PairWord16Word64 {-# UNPACK #-}!Word16 {-# UNPACK #-}!Word64     fst (PairWord16Word64 a _) = a     snd (PairWord16Word64 _ b) = b     curry f x y = f (PairWord16Word64 x y) -instance Adapt Word16 Double where+instance AdaptPair Word16 Double where     data Pair Word16 Double = PairWord16Double {-# UNPACK #-}!Word16 {-# UNPACK #-}!Double     fst (PairWord16Double a _) = a     snd (PairWord16Double _ b) = b     curry f x y = f (PairWord16Double x y) -instance Adapt Word16 Float where+instance AdaptPair Word16 Float where     data Pair Word16 Float = PairWord16Float {-# UNPACK #-}!Word16 {-# UNPACK #-}!Float     fst (PairWord16Float a _) = a     snd (PairWord16Float _ b) = b     curry f x y = f (PairWord16Float x y) -instance Adapt Word16 Char where+instance AdaptPair Word16 Char where     data Pair Word16 Char = PairWord16Char {-# UNPACK #-}!Word16 {-# UNPACK #-}!Char     fst (PairWord16Char a _) = a     snd (PairWord16Char _ b) = b     curry f x y = f (PairWord16Char x y) -instance Adapt Word32 Int where+instance AdaptPair Word32 Int where     data Pair Word32 Int = PairWord32Int {-# UNPACK #-}!Word32 {-# UNPACK #-}!Int     fst (PairWord32Int a _) = a     snd (PairWord32Int _ b) = b     curry f x y = f (PairWord32Int x y) -instance Adapt Word32 Integer where+instance AdaptPair Word32 Integer where     data Pair Word32 Integer = PairWord32Integer {-# UNPACK #-}!Word32 {-# UNPACK #-}!Integer     fst (PairWord32Integer a _) = a     snd (PairWord32Integer _ b) = b     curry f x y = f (PairWord32Integer x y) -instance Adapt Word32 Int8 where+instance AdaptPair Word32 Int8 where     data Pair Word32 Int8 = PairWord32Int8 {-# UNPACK #-}!Word32 {-# UNPACK #-}!Int8     fst (PairWord32Int8 a _) = a     snd (PairWord32Int8 _ b) = b     curry f x y = f (PairWord32Int8 x y) -instance Adapt Word32 Int16 where+instance AdaptPair Word32 Int16 where     data Pair Word32 Int16 = PairWord32Int16 {-# UNPACK #-}!Word32 {-# UNPACK #-}!Int16     fst (PairWord32Int16 a _) = a     snd (PairWord32Int16 _ b) = b     curry f x y = f (PairWord32Int16 x y) -instance Adapt Word32 Int32 where+instance AdaptPair Word32 Int32 where     data Pair Word32 Int32 = PairWord32Int32 {-# UNPACK #-}!Word32 {-# UNPACK #-}!Int32     fst (PairWord32Int32 a _) = a     snd (PairWord32Int32 _ b) = b     curry f x y = f (PairWord32Int32 x y) -instance Adapt Word32 Int64 where+instance AdaptPair Word32 Int64 where     data Pair Word32 Int64 = PairWord32Int64 {-# UNPACK #-}!Word32 {-# UNPACK #-}!Int64     fst (PairWord32Int64 a _) = a     snd (PairWord32Int64 _ b) = b     curry f x y = f (PairWord32Int64 x y) -instance Adapt Word32 Word where+instance AdaptPair Word32 Word where     data Pair Word32 Word = PairWord32Word {-# UNPACK #-}!Word32 {-# UNPACK #-}!Word     fst (PairWord32Word a _) = a     snd (PairWord32Word _ b) = b     curry f x y = f (PairWord32Word x y) -instance Adapt Word32 Word8 where+instance AdaptPair Word32 Word8 where     data Pair Word32 Word8 = PairWord32Word8 {-# UNPACK #-}!Word32 {-# UNPACK #-}!Word8     fst (PairWord32Word8 a _) = a     snd (PairWord32Word8 _ b) = b     curry f x y = f (PairWord32Word8 x y) -instance Adapt Word32 Word16 where+instance AdaptPair Word32 Word16 where     data Pair Word32 Word16 = PairWord32Word16 {-# UNPACK #-}!Word32 {-# UNPACK #-}!Word16     fst (PairWord32Word16 a _) = a     snd (PairWord32Word16 _ b) = b     curry f x y = f (PairWord32Word16 x y) -instance Adapt Word32 Word32 where+instance AdaptPair Word32 Word32 where     data Pair Word32 Word32 = PairWord32Word32 {-# UNPACK #-}!Word32 {-# UNPACK #-}!Word32     fst (PairWord32Word32 a _) = a     snd (PairWord32Word32 _ b) = b     curry f x y = f (PairWord32Word32 x y) -instance Adapt Word32 Word64 where+instance AdaptPair Word32 Word64 where     data Pair Word32 Word64 = PairWord32Word64 {-# UNPACK #-}!Word32 {-# UNPACK #-}!Word64     fst (PairWord32Word64 a _) = a     snd (PairWord32Word64 _ b) = b     curry f x y = f (PairWord32Word64 x y) -instance Adapt Word32 Double where+instance AdaptPair Word32 Double where     data Pair Word32 Double = PairWord32Double {-# UNPACK #-}!Word32 {-# UNPACK #-}!Double     fst (PairWord32Double a _) = a     snd (PairWord32Double _ b) = b     curry f x y = f (PairWord32Double x y) -instance Adapt Word32 Float where+instance AdaptPair Word32 Float where     data Pair Word32 Float = PairWord32Float {-# UNPACK #-}!Word32 {-# UNPACK #-}!Float     fst (PairWord32Float a _) = a     snd (PairWord32Float _ b) = b     curry f x y = f (PairWord32Float x y) -instance Adapt Word32 Char where+instance AdaptPair Word32 Char where     data Pair Word32 Char = PairWord32Char {-# UNPACK #-}!Word32 {-# UNPACK #-}!Char     fst (PairWord32Char a _) = a     snd (PairWord32Char _ b) = b     curry f x y = f (PairWord32Char x y) -instance Adapt Word64 Int where+instance AdaptPair Word64 Int where     data Pair Word64 Int = PairWord64Int {-# UNPACK #-}!Word64 {-# UNPACK #-}!Int     fst (PairWord64Int a _) = a     snd (PairWord64Int _ b) = b     curry f x y = f (PairWord64Int x y) -instance Adapt Word64 Integer where+instance AdaptPair Word64 Integer where     data Pair Word64 Integer = PairWord64Integer {-# UNPACK #-}!Word64 {-# UNPACK #-}!Integer     fst (PairWord64Integer a _) = a     snd (PairWord64Integer _ b) = b     curry f x y = f (PairWord64Integer x y) -instance Adapt Word64 Int8 where+instance AdaptPair Word64 Int8 where     data Pair Word64 Int8 = PairWord64Int8 {-# UNPACK #-}!Word64 {-# UNPACK #-}!Int8     fst (PairWord64Int8 a _) = a     snd (PairWord64Int8 _ b) = b     curry f x y = f (PairWord64Int8 x y) -instance Adapt Word64 Int16 where+instance AdaptPair Word64 Int16 where     data Pair Word64 Int16 = PairWord64Int16 {-# UNPACK #-}!Word64 {-# UNPACK #-}!Int16     fst (PairWord64Int16 a _) = a     snd (PairWord64Int16 _ b) = b     curry f x y = f (PairWord64Int16 x y) -instance Adapt Word64 Int32 where+instance AdaptPair Word64 Int32 where     data Pair Word64 Int32 = PairWord64Int32 {-# UNPACK #-}!Word64 {-# UNPACK #-}!Int32     fst (PairWord64Int32 a _) = a     snd (PairWord64Int32 _ b) = b     curry f x y = f (PairWord64Int32 x y) -instance Adapt Word64 Int64 where+instance AdaptPair Word64 Int64 where     data Pair Word64 Int64 = PairWord64Int64 {-# UNPACK #-}!Word64 {-# UNPACK #-}!Int64     fst (PairWord64Int64 a _) = a     snd (PairWord64Int64 _ b) = b     curry f x y = f (PairWord64Int64 x y) -instance Adapt Word64 Word where+instance AdaptPair Word64 Word where     data Pair Word64 Word = PairWord64Word {-# UNPACK #-}!Word64 {-# UNPACK #-}!Word     fst (PairWord64Word a _) = a     snd (PairWord64Word _ b) = b     curry f x y = f (PairWord64Word x y) -instance Adapt Word64 Word8 where+instance AdaptPair Word64 Word8 where     data Pair Word64 Word8 = PairWord64Word8 {-# UNPACK #-}!Word64 {-# UNPACK #-}!Word8     fst (PairWord64Word8 a _) = a     snd (PairWord64Word8 _ b) = b     curry f x y = f (PairWord64Word8 x y) -instance Adapt Word64 Word16 where+instance AdaptPair Word64 Word16 where     data Pair Word64 Word16 = PairWord64Word16 {-# UNPACK #-}!Word64 {-# UNPACK #-}!Word16     fst (PairWord64Word16 a _) = a     snd (PairWord64Word16 _ b) = b     curry f x y = f (PairWord64Word16 x y) -instance Adapt Word64 Word32 where+instance AdaptPair Word64 Word32 where     data Pair Word64 Word32 = PairWord64Word32 {-# UNPACK #-}!Word64 {-# UNPACK #-}!Word32     fst (PairWord64Word32 a _) = a     snd (PairWord64Word32 _ b) = b     curry f x y = f (PairWord64Word32 x y) -instance Adapt Word64 Word64 where+instance AdaptPair Word64 Word64 where     data Pair Word64 Word64 = PairWord64Word64 {-# UNPACK #-}!Word64 {-# UNPACK #-}!Word64     fst (PairWord64Word64 a _) = a     snd (PairWord64Word64 _ b) = b     curry f x y = f (PairWord64Word64 x y) -instance Adapt Word64 Double where+instance AdaptPair Word64 Double where     data Pair Word64 Double = PairWord64Double {-# UNPACK #-}!Word64 {-# UNPACK #-}!Double     fst (PairWord64Double a _) = a     snd (PairWord64Double _ b) = b     curry f x y = f (PairWord64Double x y) -instance Adapt Word64 Float where+instance AdaptPair Word64 Float where     data Pair Word64 Float = PairWord64Float {-# UNPACK #-}!Word64 {-# UNPACK #-}!Float     fst (PairWord64Float a _) = a     snd (PairWord64Float _ b) = b     curry f x y = f (PairWord64Float x y) -instance Adapt Word64 Char where+instance AdaptPair Word64 Char where     data Pair Word64 Char = PairWord64Char {-# UNPACK #-}!Word64 {-# UNPACK #-}!Char     fst (PairWord64Char a _) = a     snd (PairWord64Char _ b) = b     curry f x y = f (PairWord64Char x y) -instance Adapt Double Int where+instance AdaptPair Double Int where     data Pair Double Int = PairDoubleInt {-# UNPACK #-}!Double {-# UNPACK #-}!Int     fst (PairDoubleInt a _) = a     snd (PairDoubleInt _ b) = b     curry f x y = f (PairDoubleInt x y) -instance Adapt Double Integer where+instance AdaptPair Double Integer where     data Pair Double Integer = PairDoubleInteger {-# UNPACK #-}!Double {-# UNPACK #-}!Integer     fst (PairDoubleInteger a _) = a     snd (PairDoubleInteger _ b) = b     curry f x y = f (PairDoubleInteger x y) -instance Adapt Double Int8 where+instance AdaptPair Double Int8 where     data Pair Double Int8 = PairDoubleInt8 {-# UNPACK #-}!Double {-# UNPACK #-}!Int8     fst (PairDoubleInt8 a _) = a     snd (PairDoubleInt8 _ b) = b     curry f x y = f (PairDoubleInt8 x y) -instance Adapt Double Int16 where+instance AdaptPair Double Int16 where     data Pair Double Int16 = PairDoubleInt16 {-# UNPACK #-}!Double {-# UNPACK #-}!Int16     fst (PairDoubleInt16 a _) = a     snd (PairDoubleInt16 _ b) = b     curry f x y = f (PairDoubleInt16 x y) -instance Adapt Double Int32 where+instance AdaptPair Double Int32 where     data Pair Double Int32 = PairDoubleInt32 {-# UNPACK #-}!Double {-# UNPACK #-}!Int32     fst (PairDoubleInt32 a _) = a     snd (PairDoubleInt32 _ b) = b     curry f x y = f (PairDoubleInt32 x y) -instance Adapt Double Int64 where+instance AdaptPair Double Int64 where     data Pair Double Int64 = PairDoubleInt64 {-# UNPACK #-}!Double {-# UNPACK #-}!Int64     fst (PairDoubleInt64 a _) = a     snd (PairDoubleInt64 _ b) = b     curry f x y = f (PairDoubleInt64 x y) -instance Adapt Double Word where+instance AdaptPair Double Word where     data Pair Double Word = PairDoubleWord {-# UNPACK #-}!Double {-# UNPACK #-}!Word     fst (PairDoubleWord a _) = a     snd (PairDoubleWord _ b) = b     curry f x y = f (PairDoubleWord x y) -instance Adapt Double Word8 where+instance AdaptPair Double Word8 where     data Pair Double Word8 = PairDoubleWord8 {-# UNPACK #-}!Double {-# UNPACK #-}!Word8     fst (PairDoubleWord8 a _) = a     snd (PairDoubleWord8 _ b) = b     curry f x y = f (PairDoubleWord8 x y) -instance Adapt Double Word16 where+instance AdaptPair Double Word16 where     data Pair Double Word16 = PairDoubleWord16 {-# UNPACK #-}!Double {-# UNPACK #-}!Word16     fst (PairDoubleWord16 a _) = a     snd (PairDoubleWord16 _ b) = b     curry f x y = f (PairDoubleWord16 x y) -instance Adapt Double Word32 where+instance AdaptPair Double Word32 where     data Pair Double Word32 = PairDoubleWord32 {-# UNPACK #-}!Double {-# UNPACK #-}!Word32     fst (PairDoubleWord32 a _) = a     snd (PairDoubleWord32 _ b) = b     curry f x y = f (PairDoubleWord32 x y) -instance Adapt Double Word64 where+instance AdaptPair Double Word64 where     data Pair Double Word64 = PairDoubleWord64 {-# UNPACK #-}!Double {-# UNPACK #-}!Word64     fst (PairDoubleWord64 a _) = a     snd (PairDoubleWord64 _ b) = b     curry f x y = f (PairDoubleWord64 x y) -instance Adapt Double Double where+instance AdaptPair Double Double where     data Pair Double Double = PairDoubleDouble {-# UNPACK #-}!Double {-# UNPACK #-}!Double     fst (PairDoubleDouble a _) = a     snd (PairDoubleDouble _ b) = b     curry f x y = f (PairDoubleDouble x y) -instance Adapt Double Float where+instance AdaptPair Double Float where     data Pair Double Float = PairDoubleFloat {-# UNPACK #-}!Double {-# UNPACK #-}!Float     fst (PairDoubleFloat a _) = a     snd (PairDoubleFloat _ b) = b     curry f x y = f (PairDoubleFloat x y) -instance Adapt Double Char where+instance AdaptPair Double Char where     data Pair Double Char = PairDoubleChar {-# UNPACK #-}!Double {-# UNPACK #-}!Char     fst (PairDoubleChar a _) = a     snd (PairDoubleChar _ b) = b     curry f x y = f (PairDoubleChar x y) -instance Adapt Float Int where+instance AdaptPair Float Int where     data Pair Float Int = PairFloatInt {-# UNPACK #-}!Float {-# UNPACK #-}!Int     fst (PairFloatInt a _) = a     snd (PairFloatInt _ b) = b     curry f x y = f (PairFloatInt x y) -instance Adapt Float Integer where+instance AdaptPair Float Integer where     data Pair Float Integer = PairFloatInteger {-# UNPACK #-}!Float {-# UNPACK #-}!Integer     fst (PairFloatInteger a _) = a     snd (PairFloatInteger _ b) = b     curry f x y = f (PairFloatInteger x y) -instance Adapt Float Int8 where+instance AdaptPair Float Int8 where     data Pair Float Int8 = PairFloatInt8 {-# UNPACK #-}!Float {-# UNPACK #-}!Int8     fst (PairFloatInt8 a _) = a     snd (PairFloatInt8 _ b) = b     curry f x y = f (PairFloatInt8 x y) -instance Adapt Float Int16 where+instance AdaptPair Float Int16 where     data Pair Float Int16 = PairFloatInt16 {-# UNPACK #-}!Float {-# UNPACK #-}!Int16     fst (PairFloatInt16 a _) = a     snd (PairFloatInt16 _ b) = b     curry f x y = f (PairFloatInt16 x y) -instance Adapt Float Int32 where+instance AdaptPair Float Int32 where     data Pair Float Int32 = PairFloatInt32 {-# UNPACK #-}!Float {-# UNPACK #-}!Int32     fst (PairFloatInt32 a _) = a     snd (PairFloatInt32 _ b) = b     curry f x y = f (PairFloatInt32 x y) -instance Adapt Float Int64 where+instance AdaptPair Float Int64 where     data Pair Float Int64 = PairFloatInt64 {-# UNPACK #-}!Float {-# UNPACK #-}!Int64     fst (PairFloatInt64 a _) = a     snd (PairFloatInt64 _ b) = b     curry f x y = f (PairFloatInt64 x y) -instance Adapt Float Word where+instance AdaptPair Float Word where     data Pair Float Word = PairFloatWord {-# UNPACK #-}!Float {-# UNPACK #-}!Word     fst (PairFloatWord a _) = a     snd (PairFloatWord _ b) = b     curry f x y = f (PairFloatWord x y) -instance Adapt Float Word8 where+instance AdaptPair Float Word8 where     data Pair Float Word8 = PairFloatWord8 {-# UNPACK #-}!Float {-# UNPACK #-}!Word8     fst (PairFloatWord8 a _) = a     snd (PairFloatWord8 _ b) = b     curry f x y = f (PairFloatWord8 x y) -instance Adapt Float Word16 where+instance AdaptPair Float Word16 where     data Pair Float Word16 = PairFloatWord16 {-# UNPACK #-}!Float {-# UNPACK #-}!Word16     fst (PairFloatWord16 a _) = a     snd (PairFloatWord16 _ b) = b     curry f x y = f (PairFloatWord16 x y) -instance Adapt Float Word32 where+instance AdaptPair Float Word32 where     data Pair Float Word32 = PairFloatWord32 {-# UNPACK #-}!Float {-# UNPACK #-}!Word32     fst (PairFloatWord32 a _) = a     snd (PairFloatWord32 _ b) = b     curry f x y = f (PairFloatWord32 x y) -instance Adapt Float Word64 where+instance AdaptPair Float Word64 where     data Pair Float Word64 = PairFloatWord64 {-# UNPACK #-}!Float {-# UNPACK #-}!Word64     fst (PairFloatWord64 a _) = a     snd (PairFloatWord64 _ b) = b     curry f x y = f (PairFloatWord64 x y) -instance Adapt Float Double where+instance AdaptPair Float Double where     data Pair Float Double = PairFloatDouble {-# UNPACK #-}!Float {-# UNPACK #-}!Double     fst (PairFloatDouble a _) = a     snd (PairFloatDouble _ b) = b     curry f x y = f (PairFloatDouble x y) -instance Adapt Float Float where+instance AdaptPair Float Float where     data Pair Float Float = PairFloatFloat {-# UNPACK #-}!Float {-# UNPACK #-}!Float     fst (PairFloatFloat a _) = a     snd (PairFloatFloat _ b) = b     curry f x y = f (PairFloatFloat x y) -instance Adapt Float Char where+instance AdaptPair Float Char where     data Pair Float Char = PairFloatChar {-# UNPACK #-}!Float {-# UNPACK #-}!Char     fst (PairFloatChar a _) = a     snd (PairFloatChar _ b) = b     curry f x y = f (PairFloatChar x y) -instance Adapt Char Int where+instance AdaptPair Char Int where     data Pair Char Int = PairCharInt {-# UNPACK #-}!Char {-# UNPACK #-}!Int     fst (PairCharInt a _) = a     snd (PairCharInt _ b) = b     curry f x y = f (PairCharInt x y) -instance Adapt Char Integer where+instance AdaptPair Char Integer where     data Pair Char Integer = PairCharInteger {-# UNPACK #-}!Char {-# UNPACK #-}!Integer     fst (PairCharInteger a _) = a     snd (PairCharInteger _ b) = b     curry f x y = f (PairCharInteger x y) -instance Adapt Char Int8 where+instance AdaptPair Char Int8 where     data Pair Char Int8 = PairCharInt8 {-# UNPACK #-}!Char {-# UNPACK #-}!Int8     fst (PairCharInt8 a _) = a     snd (PairCharInt8 _ b) = b     curry f x y = f (PairCharInt8 x y) -instance Adapt Char Int16 where+instance AdaptPair Char Int16 where     data Pair Char Int16 = PairCharInt16 {-# UNPACK #-}!Char {-# UNPACK #-}!Int16     fst (PairCharInt16 a _) = a     snd (PairCharInt16 _ b) = b     curry f x y = f (PairCharInt16 x y) -instance Adapt Char Int32 where+instance AdaptPair Char Int32 where     data Pair Char Int32 = PairCharInt32 {-# UNPACK #-}!Char {-# UNPACK #-}!Int32     fst (PairCharInt32 a _) = a     snd (PairCharInt32 _ b) = b     curry f x y = f (PairCharInt32 x y) -instance Adapt Char Int64 where+instance AdaptPair Char Int64 where     data Pair Char Int64 = PairCharInt64 {-# UNPACK #-}!Char {-# UNPACK #-}!Int64     fst (PairCharInt64 a _) = a     snd (PairCharInt64 _ b) = b     curry f x y = f (PairCharInt64 x y) -instance Adapt Char Word where+instance AdaptPair Char Word where     data Pair Char Word = PairCharWord {-# UNPACK #-}!Char {-# UNPACK #-}!Word     fst (PairCharWord a _) = a     snd (PairCharWord _ b) = b     curry f x y = f (PairCharWord x y) -instance Adapt Char Word8 where+instance AdaptPair Char Word8 where     data Pair Char Word8 = PairCharWord8 {-# UNPACK #-}!Char {-# UNPACK #-}!Word8     fst (PairCharWord8 a _) = a     snd (PairCharWord8 _ b) = b     curry f x y = f (PairCharWord8 x y) -instance Adapt Char Word16 where+instance AdaptPair Char Word16 where     data Pair Char Word16 = PairCharWord16 {-# UNPACK #-}!Char {-# UNPACK #-}!Word16     fst (PairCharWord16 a _) = a     snd (PairCharWord16 _ b) = b     curry f x y = f (PairCharWord16 x y) -instance Adapt Char Word32 where+instance AdaptPair Char Word32 where     data Pair Char Word32 = PairCharWord32 {-# UNPACK #-}!Char {-# UNPACK #-}!Word32     fst (PairCharWord32 a _) = a     snd (PairCharWord32 _ b) = b     curry f x y = f (PairCharWord32 x y) -instance Adapt Char Word64 where+instance AdaptPair Char Word64 where     data Pair Char Word64 = PairCharWord64 {-# UNPACK #-}!Char {-# UNPACK #-}!Word64     fst (PairCharWord64 a _) = a     snd (PairCharWord64 _ b) = b     curry f x y = f (PairCharWord64 x y) -instance Adapt Char Double where+instance AdaptPair Char Double where     data Pair Char Double = PairCharDouble {-# UNPACK #-}!Char {-# UNPACK #-}!Double     fst (PairCharDouble a _) = a     snd (PairCharDouble _ b) = b     curry f x y = f (PairCharDouble x y) -instance Adapt Char Float where+instance AdaptPair Char Float where     data Pair Char Float = PairCharFloat {-# UNPACK #-}!Char {-# UNPACK #-}!Float     fst (PairCharFloat a _) = a     snd (PairCharFloat _ b) = b     curry f x y = f (PairCharFloat x y) -instance Adapt Char Char where+instance AdaptPair Char Char where     data Pair Char Char = PairCharChar {-# UNPACK #-}!Char {-# UNPACK #-}!Char     fst (PairCharChar a _) = a     snd (PairCharChar _ b) = b

@@ -1,18 +1,30 @@ name:               adaptive-containers-version:            0.1+version:            0.2 homepage:           http://code.haskell.org/~dons/code/adaptive-containers synopsis:           Self optimizing container types description:     Self optimizing polymorphic container types.-    -    We use type families to specialize polymorphic container types to-    specific representations via class-associated data types.-+    .+    Adaptive containers are polymorphic container types that use+    class associated data types to specialize particular element types+    to a more efficient container representation. The resulting+    structures tend to be both more time and space efficient.+    .     A self-optimizing pair, for example, will unpack the constructors,     yielding a representation for (Int,Char) requiring 8 bytes, instead     of 24.--    Currently supported adaptive types: pairs+    . +    This difference can be visualized, here for the value:+    .+    > [ (x,y) | x <- [1..3], y <- [x..3] ]+    .+    * A regular list of pairs <http://code.haskell.org/~dons/images/vacuum/tuple-list.png>+    .+    * An adaptive list of pairs <http://code.haskell.org/~dons/images/vacuum/pair-list.png>+    .+    * An adaptive list of adaptive pairs <http://code.haskell.org/~dons/images/vacuum/list-pair.png>+    .+    Currently supported adaptive types: pairs, lists  category:           Data license:            BSD3@@ -24,8 +36,11 @@  library     exposed-modules:    Data.Adaptive.Tuple+                        Data.Adaptive.List -    ghc-options:        -O2 -funbox-strict-fields -Wall+    ghc-options:        -O2+                        -fdicts-cheap+                        -Wall     ghc-prof-options:   -prof -auto-all      extensions:         TypeFamilies,

@@ -0,0 +1,143 @@++{-# 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 | Box t <- 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 . (Typeable a, Data a) => a -> IO ()+deriveM (a :: a) = putStrLn $ derive (undefined :: a)++{-+instance AdaptList Int where+    data List Int = EmptyInt | ConsInt {-# UNPACK #-}!Int (List Int)++    empty               = EmptyInt+    cons x xs           = ConsInt x xs+    null EmptyInt       = True+    null _              = False+    head EmptyInt       = errorEmptyList "head"+    head (ConsInt x _)  = x+    tail EmptyInt       = errorEmptyList "tail"+    tail (ConsInt _ xs) = xs+-}++derive :: (Typeable a, Data a) => a  -> String+derive x = render $++   hang+    (hsep [text "instance", text "AdaptList", text type_x, text "where"])+    4+    (vcat [+        hsep [ text "data"+             ,      text "List"+             ,      text type_x+             , char '='+             ,      text myemptyconstr+             , char '|'+             ,      text myconsconstr+             ,      text "{-# UNPACK #-}!" <> text type_x+             ,      parens (text "List" <+> text type_x)+             ]++       ,hsep [  text "empty"+             ,char '='+             ,  text myemptyconstr]++       ,hsep [  text "cons"+             ,char '='+             ,  text myconsconstr]++       ,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 '_')+             ,char '='+             ,  char 'x']++       ,hsep [  text "tail"+             ,  text myemptyconstr+             ,char '='+             ,  text "errorEmptyList \"tail\""+             ]+       ,hsep [  text "tail"+             ,  parens (text myconsconstr <+> char '_' <+> char 'x')+             ,char '='+             ,  char 'x']+++        ])+++ where+    type_x = inst_a++    myemptyconstr = "Empty" ++ type_x+    myconsconstr = "Cons" ++ type_x++    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++    manyLetters = map (:[]) ['a'..'z']

@@ -0,0 +1,115 @@++{-# 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)+++derive :: (Typeable a, Data a, Typeable b, Data b) => a  -> b -> String+derive x y = render $++   hang+    (hsep [text "instance", text "AdaptPair", text type_x, text type_y, text "where"])+    4+    (vcat [+        hsep [ text "data"+             ,      text "Pair"+             ,      text type_x+             ,      text type_y+             , char '='+             ,      text myconstr+             ,      text "{-# UNPACK #-}!" <> text type_x+             ,      text "{-# UNPACK #-}!" <> text type_y+             ]++       ,hsep [text "fst"+             ,  parens (text myconstr <+> text "a _")+             ,  char '=' ,  char 'a' ]++       ,hsep [text "snd"+             ,  parens (text myconstr <+> text "_ b")+             ,  char '=' ,  char 'b' ]++       ,hsep [ text "curry"+             ,      char 'f'+             ,      char 'x'+             ,      char 'y'+             ,  char '='+             ,      char 'f' <+> parens (text myconstr <+> text "x y")+             ]++          ])++ where+    type_x = inst_a++    type_y = inst_b++    myconstr = "Pair" ++ 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']

@@ -1,115 +0,0 @@--{-# 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)---derive :: (Typeable a, Data a, Typeable b, Data b) => a  -> b -> String-derive x y = render $--   hang-    (hsep [text "instance", text "Adapt", text type_x, text type_y, text "where"])-    4-    (vcat [-        hsep [ text "data"-             ,      text "Pair"-             ,      text type_x-             ,      text type_y-             , char '='-             ,      text myconstr-             ,      text "{-# UNPACK #-}!" <> text type_x-             ,      text "{-# UNPACK #-}!" <> text type_y-             ]--       ,hsep [text "fst"-             ,  parens (text myconstr <+> text "a _")-             ,  char '=' ,  char 'a' ]--       ,hsep [text "snd"-             ,  parens (text myconstr <+> text "_ b")-             ,  char '=' ,  char 'b' ]--       ,hsep [ text "curry"-             ,      char 'f'-             ,      char 'x'-             ,      char 'y'-             ,  char '='-             ,      char 'f' <+> parens (text myconstr <+> text "x y")-             ]--          ])-- where-    type_x = inst_a--    type_y = inst_b--    myconstr = "Pair" ++ 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']

@@ -0,0 +1,11 @@+import System.Environment+import qualified Data.Adaptive.List as L+import qualified Data.Adaptive.Tuple as L++main = do+    [n] <- mapM readIO =<< getArgs+    print $ L.maximum . L.take (n-1) . L.map (\p -> L.pair (L.fst p *2) (L.snd p *4)) $+        L.zip+            (L.replicate n n     :: L.List Int)+            (L.replicate (n-1) n :: L.List Int)+

@@ -0,0 +1,9 @@+import System.Environment++main = do+    [n] <- mapM readIO =<< getArgs+    print $ maximum . take (n-1) . map (\(a,b) -> ((a *2),(b *4))) $+        zip+            (replicate n n     :: [Int])+            (replicate (n-1) n :: [Int])+

@@ -0,0 +1,10 @@++module M where++import Prelude hiding (last, replicate, zip)+import Data.Adaptive.List+import Data.Adaptive.Tuple++f :: List (Pair Int Int)+f = zip (replicate 10 (8 :: Int))+        (replicate 10 (7 :: Int))