From 4e987026148fe65c323afbc93cd560c07bf06b3f Mon Sep 17 00:00:00 2001
From: Yale AI Dept <ai@nebula.cs.yale.edu>
Date: Wed, 14 Jul 1993 13:08:00 -0500
Subject: Import to github.

---
 progs/prelude/PreludeList.hs | 585 +++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 585 insertions(+)
 create mode 100644 progs/prelude/PreludeList.hs

(limited to 'progs/prelude/PreludeList.hs')

diff --git a/progs/prelude/PreludeList.hs b/progs/prelude/PreludeList.hs
new file mode 100644
index 0000000..3e445c3
--- /dev/null
+++ b/progs/prelude/PreludeList.hs
@@ -0,0 +1,585 @@
+-- Standard list functions
+
+-- build really shouldn't be exported, but what the heck.
+-- some of the helper functions in this file shouldn't be
+-- exported either!
+
+module PreludeList (PreludeList.., foldr, build) where
+
+import PreludePrims(build, foldr)
+
+{-#Prelude#-}  -- Indicates definitions of compiler prelude symbols
+
+infixl 9  !!
+infix  5  \\
+infixr 5  ++
+infix  4 `elem`, `notElem`
+
+
+-- These are primitives used by the deforestation stuff in the optimizer.
+-- the optimizer will turn references to foldr and build into
+-- inlineFoldr and inlineBuild, respectively, but doesn't want to
+-- necessarily inline all references immediately.
+
+inlineFoldr :: (a -> b -> b) -> b -> [a] -> b
+inlineFoldr f z l =
+  let foldr' []	 	= z
+      foldr' (x:xs)	= f x (foldr' xs)
+  in foldr' l
+{-# inlineFoldr :: Inline #-}
+
+
+inlineBuild :: ((a -> [a] -> [a]) -> [b] -> [c]) -> [c]
+inlineBuild g           = g (:) []
+{-# inlineBuild :: Inline #-}
+
+
+-- head and tail extract the first element and remaining elements,
+-- respectively, of a list, which must be non-empty.  last and init
+-- are the dual functions working from the end of a finite list,
+-- rather than the beginning.
+
+head			:: [a] -> a
+head (x:_)		=  x
+head []			=  error "head{PreludeList}: head []"
+
+last			:: [a] -> a
+last [x]		=  x
+last (_:xs)		=  last xs
+last []			=  error "last{PreludeList}: last []"
+
+tail			:: [a] -> [a]
+tail (_:xs)		=  xs
+tail []			=  error "tail{PreludeList}: tail []"
+
+init			:: [a] -> [a]
+init [x]		=  []
+init (x:xs)		=  x : init xs
+init []			=  error "init{PreludeList}: init []"
+
+-- null determines if a list is empty.
+null			:: [a] -> Bool
+null []			=  True
+null (_:_)		=  False
+
+
+-- list concatenation (right-associative)
+
+(++)			:: [a] -> [a] -> [a]
+xs ++ ys		= build (\ c n -> foldr c (foldr c n ys) xs)
+{-# (++) :: Inline #-}
+
+
+-- the first occurrence of each element of ys in turn (if any)
+-- has been removed from xs.  Thus, (xs ++ ys) \\ xs == ys.
+(\\)			:: (Eq a) => [a] -> [a] -> [a]
+(\\)			=  foldl del
+			   where [] `del` _	    = []
+				 (x:xs) `del` y
+					| x == y    = xs
+					| otherwise = x : xs `del` y
+
+-- length returns the length of a finite list as an Int; it is an instance
+-- of the more general genericLength, the result type of which may be
+-- any kind of number.
+
+genericLength		:: (Num a) => [b] -> a
+genericLength l         = foldr (\ x n -> 1 + n) 0 l
+--genericLength []	=  0
+--genericLength (x:xs)    =  1 + genericLength xs
+{-# genericLength :: Inline #-}
+
+
+length			:: [a] -> Int
+length l		= foldr (\ x n -> 1 + n) 0 l
+--length []               = 0
+--length (x:xs)           = 1 + length xs
+{-# length :: Inline #-}
+
+-- List index (subscript) operator, 0-origin
+(!!)			:: (Integral a) => [b] -> a -> b
+l !! i			=  nth l (fromIntegral i)
+{-# (!!)  :: Inline #-}
+
+nth                     :: [b] -> Int -> b
+nth l m	= let f x g 0 = x
+	      f x g i = g (i - 1)
+	      fail _ = error "(!!){PreludeList}: index too large"
+	  in foldr f fail l m
+{-# nth  :: Inline #-}
+--nth _ n  | n < 0	= error "(!!){PreludeList}: negative index"
+--nth [] n		= error "(!!){PreludeList}: index too large"
+--nth (x:xs) n 
+--	| n == 0	= x
+--	| otherwise     = nth xs (n - 1)
+--{-# nth  :: Strictness("S,S") #-}
+
+-- map f xs applies f to each element of xs; i.e., map f xs == [f x | x <- xs].
+map			:: (a -> b) -> [a] -> [b]
+map f xs		= build (\ c n -> foldr (\ a b -> c (f a) b) n xs)
+--map f []		=  []
+--map f (x:xs)		=  f x : map f xs
+{-# map  :: Inline #-}
+
+
+-- 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].
+filter			:: (a -> Bool) -> [a] -> [a]
+filter f xs		= build (\ c n ->
+                                  foldr (\ a b -> if f a then c a b else b)
+				  n xs)
+--filter p		=  foldr (\x xs -> if p x then x:xs else xs) []
+{-# filter  :: Inline #-}
+
+ 
+-- partition takes a predicate and a list and returns a pair of lists:
+-- those elements of the argument list that 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		=  foldr select ([],[])
+			   where select x (ts,fs) | p x	      = (x:ts,fs)
+						  | otherwise = (ts,x:fs)
+{-# partition  :: Inline #-}
+
+
+-- 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
+-- foldl1 is a variant that has no starting value argument, and  thus must
+-- be applied to non-empty lists.  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, ...]
+-- Note that  last (scanl f z xs) == foldl f z xs.
+-- scanl1 is similar, again without the starting element:
+--	scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...]
+
+foldl			:: (a -> b -> a) -> a -> [b] -> a
+foldl f z xs            = foldr (\ b g a -> g (f a b)) id xs z
+--foldl f z []		=  z
+--foldl f z (x:xs)	=  foldl f (f z x) xs
+{-# foldl  :: Inline #-}
+
+foldl1			:: (a -> a -> a) -> [a] -> a
+foldl1 f (x:xs)		=  foldl f x xs
+foldl1 _ []		=  error "foldl1{PreludeList}: empty list"
+{-# foldl1  :: Inline #-}
+
+scanl			:: (a -> b -> a) -> a -> [b] -> [a]
+scanl f q xs		=  q : (case xs of
+				[]   -> []
+				x:xs -> scanl f (f q x) xs)
+{-# scanl  :: Inline #-}
+
+scanl1			:: (a -> a -> a) -> [a] -> [a]
+scanl1 f (x:xs)		=  scanl f x xs
+scanl1 _ []		=  error "scanl1{PreludeList}: empty list"
+{-# scanl1 :: Inline #-}
+
+
+-- foldr, foldr1, scanr, and scanr1 are the right-to-left duals of the
+-- above functions.
+
+--foldr			:: (a -> b -> b) -> b -> [a] -> b
+--foldr f z []		=  z
+--foldr f z (x:xs)	=  f x (foldr f z xs)
+
+
+foldr1			:: (a -> a -> a) -> [a] -> a
+foldr1 f [x]		=  x
+foldr1 f (x:xs)		=  f x (foldr1 f xs)
+foldr1 _ []		=  error "foldr1{PreludeList}: empty list"
+{-# foldr1  :: Inline #-}
+
+
+-- I'm not sure the build/foldr expansion wins.
+
+scanr			:: (a -> b -> b) -> b -> [a] -> [b]
+--scanr f q0 l = build (\ c n ->
+--                        let g x qs@(q:_) = c (f x q) qs
+--			in foldr g (c q0 n) l)
+scanr f q0 []		=  [q0]
+scanr f q0 (x:xs)	=  f x q : qs
+			   where qs@(q:_) = scanr f q0 xs 
+{-# scanr  :: Inline #-}
+
+scanr1			:: (a -> a -> a) -> [a] -> [a]
+scanr1 f  [x]		=  [x]
+scanr1 f  (x:xs)	=  f x q : qs
+			   where qs@(q:_) = scanr1 f xs 
+scanr1 _ []		=  error "scanr1{PreludeList}: empty list"
+{-# scanr1  :: Inline #-}
+
+
+-- iterate f x returns an infinite list of repeated applications of f to x:
+-- iterate f x == [x, f x, f (f x), ...]
+iterate			:: (a -> a) -> a -> [a]
+iterate f x	= build (\ c n ->
+                          let iterate' x' = c x' (iterate' (f x'))
+			  in iterate' x)
+--iterate f x		=  x : iterate f (f x)
+{-# iterate  :: Inline #-}
+
+
+-- repeat x is an infinite list, with x the value of every element.
+repeat			:: a -> [a]
+repeat x		= build (\ c n -> let r = c x r in r)
+--repeat x		=  xs where xs = x:xs
+{-# repeat  :: Inline #-}
+
+-- 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			:: [a] -> [a]
+cycle xs		=  xs' where xs' = xs ++ xs'
+
+
+-- take n, applied to a list xs, returns the prefix of xs of length n,
+-- or xs itself if n > length xs.  drop n xs returns the suffix of xs
+-- after the first n elements, or [] if n > length xs.  splitAt n xs
+-- is equivalent to (take n xs, drop n xs).
+
+take			:: (Integral a) => a -> [b] -> [b]
+take n l		= takeInt (fromIntegral n) l
+{-# take  :: Inline #-}
+
+takeInt                 :: Int -> [b] -> [b]
+takeInt m l = 
+  build (\ c n ->
+           let f x g i | i <= 0		= n
+	               | otherwise      = c x (g (i - 1))
+           in foldr f (\ _ -> n) l m)
+--takeInt  0     _	=  []
+--takeInt  _     []	=  []
+--takeInt  n l | n > 0    = primTake n l
+{-# takeInt  :: Inline #-}
+
+
+
+-- Writing drop and friends in terms of build/foldr seems to lose
+-- way big since they cause an extra traversal of the list tail
+-- (except when the calls are being deforested).
+
+drop			:: (Integral a) => a -> [b] -> [b]
+drop n l		= dropInt (fromIntegral n) l
+{-# drop  :: Inline #-}
+{-# drop  :: Strictness("S,S") #-}
+
+
+dropInt                 :: Int -> [b] -> [b]
+dropInt  0     xs	=  xs
+dropInt  _     []	=  []
+dropInt (n+1) (_:xs)	=  dropInt n xs
+{-# dropInt  :: Inline #-}
+
+splitAt			:: (Integral a) => a -> [b] -> ([b],[b])
+splitAt n l		= splitAtInt (fromIntegral n) l
+{-# splitAt  :: Inline #-}
+
+splitAtInt		:: Int -> [b] -> ([b],[b])
+splitAtInt  0     xs	=  ([],xs)
+splitAtInt  _     []	=  ([],[])
+splitAtInt (n+1) (x:xs)	=  (x:xs',xs'') where (xs',xs'') = splitAtInt n xs
+{-# splitAtInt  :: Inline #-}
+
+-- takeWhile, applied to a predicate p and a list xs, returns the longest
+-- prefix (possibly empty) of xs of elements that satisfy p.  dropWhile p xs
+-- returns the remaining suffix.  Span p xs is equivalent to
+-- (takeWhile p xs, dropWhile p xs), while break p uses the negation of p.
+
+takeWhile		:: (a -> Bool) -> [a] -> [a]
+takeWhile p l = build (\ c n -> foldr (\ a b -> if p a then c a b else n) n l)
+--takeWhile p []		=  []
+--takeWhile p (x:xs) 
+--            | p x       =  x : takeWhile p xs
+--            | otherwise =  []
+{-# takeWhile  :: Inline #-}
+
+
+dropWhile		:: (a -> Bool) -> [a] -> [a]
+dropWhile p []		=  []
+dropWhile p xs@(x:xs')
+	    | p x       =  dropWhile p xs'
+	    | otherwise =  xs
+{-# dropWhile  :: Inline #-}
+
+span, break		:: (a -> Bool) -> [a] -> ([a],[a])
+span p []		=  ([],[])
+span p xs@(x:xs')
+	   | p x	=  let (ys,zs) = span p xs' in (x:ys,zs)
+	   | otherwise	=  ([],xs)
+break p			=  span (not . p)
+
+{-# span  :: Inline #-}
+{-# break  :: Inline #-}
+
+
+-- lines breaks a string up into a list of strings at newline characters.
+-- The resulting strings do not contain newlines.  Similary, words
+-- breaks a string up into a list of words, which were delimited by
+-- white space.  unlines and unwords are the inverse operations.
+-- unlines joins lines with terminating newlines, and unwords joins
+-- words with separating spaces.
+
+lines			:: String -> [String]
+lines ""		=  []
+lines s			=  let (l, s') = break (== '\n') s
+			   in  l : case s' of
+					[]     	-> []
+					(_:s'') -> lines s''
+
+words			:: String -> [String]
+words s			=  case dropWhile isSpace s of
+				"" -> []
+				s' -> w : words s''
+				      where (w, s'') = break isSpace s'
+
+unlines			:: [String] -> String
+unlines			=  concat . map (++ "\n")
+{-# unlines  :: Inline #-}
+
+
+unwords			:: [String] -> String
+unwords []		=  ""
+unwords ws		=  foldr1 (\w s -> w ++ ' ':s) ws
+
+-- nub (meaning "essence") removes duplicate elements from its list argument.
+nub			:: (Eq a) => [a] -> [a]
+nub l = build (\ c n ->
+                 let f x g [] = c x (g [x])
+		     f x g xs = if elem x xs
+		                   then (g xs)
+				   else c x (g (x:xs))
+                 in foldr f (\ _ -> n) l [])
+{-# nub  :: Inline #-}
+--nub []			=  []
+--nub (x:xs)		=  x : nub (filter (/= x) xs)
+
+-- reverse xs returns the elements of xs in reverse order.  xs must be finite.
+reverse			:: [a] -> [a]
+reverse l = build (\ c n ->
+                     let f x g tail = g (c x tail)
+		     in foldr f id l n)
+{-# reverse  :: Inline #-}
+--reverse x               =  reverse1 x [] where
+--  reverse1 [] a     = a
+--  reverse1 (x:xs) a = reverse1 xs (x:a)
+
+-- 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.  or is the
+-- disjunctive dual of and.
+and, or			:: [Bool] -> Bool
+and			=  foldr (&&) True
+or			=  foldr (||) False
+{-# and :: Inline #-}
+{-# or  :: Inline #-}
+
+-- Applied to a predicate and a list, any determines if any element
+-- of the list satisfies the predicate.  Similarly, for all.
+any, all		:: (a -> Bool) -> [a] -> Bool
+any p			=  or . map p
+all p			=  and . map p
+{-# any :: Inline #-}
+{-# all :: Inline #-}
+
+-- elem is the list membership predicate, usually written in infix form,
+-- e.g., x `elem` xs.  notElem is the negation.
+elem, notElem		:: (Eq a) => a -> [a] -> Bool
+
+elem x ys = foldr (\ y t -> (x == y) || t) False ys
+--x `elem` []		=  False
+--x `elem` (y:ys)         =  x == y || x `elem` ys
+{-# elem :: Inline #-}
+notElem	x y		=  not (x `elem` y)
+
+-- sum and product compute the sum or product of a finite list of numbers.
+sum, product		:: (Num a) => [a] -> a
+sum			=  foldl (+) 0	
+product			=  foldl (*) 1
+{-# sum :: Inline #-}
+{-# product :: Inline #-}
+
+-- sums and products give a list of running sums or products from
+-- a list of numbers.  For example,  sums [1,2,3] == [0,1,3,6].
+sums, products		:: (Num a) => [a] -> [a]
+sums			=  scanl (+) 0
+products		=  scanl (*) 1
+
+-- maximum and minimum return the maximum or minimum value from a list,
+-- which must be non-empty, finite, and of an ordered type.
+maximum, minimum	:: (Ord a) => [a] -> a
+maximum			=  foldl1 max
+minimum			=  foldl1 min
+{-# maximum :: Inline #-}
+{-# minimum :: Inline #-}
+
+-- concat, applied to a list of lists, returns their flattened concatenation.
+concat			:: [[a]] -> [a]
+concat xs	= build (\ c n -> foldr (\ x y -> foldr c y x) n xs)
+--concat []               =  []
+--concat (l:ls)           =  l ++ concat ls
+{-# concat :: Inline #-}
+
+
+-- transpose, applied to a list of lists, returns that list with the
+-- "rows" and "columns" interchanged.  The input need not be rectangular
+-- (a list of equal-length lists) to be completely transposable, but can
+-- be "triangular":  Each successive component list must be not longer
+-- than the previous one; any elements outside of the "triangular"
+-- transposable region are lost.  The input can be infinite in either
+-- dimension or both.
+transpose		:: [[a]] -> [[a]]
+transpose		=  foldr 
+			     (\xs xss -> zipWith (:) xs (xss ++ repeat []))
+			     []
+{-# transpose :: Inline #-}
+
+-- 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.
+-- zip3 takes three lists and returns a list of triples, etc.  Versions
+-- of zip producing up to septuplets are defined here.
+
+zip			:: [a] -> [b] -> [(a,b)]
+zip			=  zipWith (\a b -> (a,b))
+{-# zip :: Inline #-}
+
+zip3			:: [a] -> [b] -> [c] -> [(a,b,c)]
+zip3			=  zipWith3 (\a b c -> (a,b,c))
+{-# zip3 :: Inline #-}
+
+zip4			:: [a] -> [b] -> [c] -> [d] -> [(a,b,c,d)]
+zip4			=  zipWith4 (\a b c d -> (a,b,c,d))
+{-# zip4 :: Inline #-}
+
+zip5			:: [a] -> [b] -> [c] -> [d] -> [e] -> [(a,b,c,d,e)]
+zip5			=  zipWith5 (\a b c d e -> (a,b,c,d,e))
+{-# zip5 :: Inline #-}
+
+zip6			:: [a] -> [b] -> [c] -> [d] -> [e] -> [f]
+			   -> [(a,b,c,d,e,f)]
+zip6			=  zipWith6 (\a b c d e f -> (a,b,c,d,e,f))
+{-# zip6 :: Inline #-}
+
+zip7			:: [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g]
+			   -> [(a,b,c,d,e,f,g)]
+zip7			=  zipWith7 (\a b c d e f g -> (a,b,c,d,e,f,g))
+{-# zip7 :: Inline #-}
+
+-- The zipWith family generalises the zip family 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.
+
+zipWith			:: (a->b->c) -> [a]->[b]->[c]
+zipWith z as bs =
+  build (\ c' n' ->
+           let f' a g' (b:bs) = c' (z a b) (g' bs)
+	       f' a g' _ = n'
+           in foldr f' (\ _ -> n') as bs)
+--zipWith z (a:as) (b:bs)	=  z a b : zipWith z as bs
+--zipWith _ _ _		=  []
+{-# zipWith :: Inline #-}
+
+zipWith3		:: (a->b->c->d) -> [a]->[b]->[c]->[d]
+zipWith3 z as bs cs =
+  build (\ c' n' ->
+          let f' a g' (b:bs) (c:cs) = c' (z a b c) (g' bs cs)
+              f' a g' _ _ = n'
+          in foldr f' (\ _ _ -> n') as bs cs)
+{-# zipWith3 :: Inline #-}
+--zipWith3 z (a:as) (b:bs) (c:cs)
+--			=  z a b c : zipWith3 z as bs cs
+--zipWith3 _ _ _ _	=  []
+
+zipWith4		:: (a->b->c->d->e) -> [a]->[b]->[c]->[d]->[e]
+zipWith4 z as bs cs ds =
+  build (\ c' n' ->
+          let f' a g' (b:bs) (c:cs) (d:ds) = c' (z a b c d) (g' bs cs ds)
+              f' a g' _ _ _ = n'
+          in foldr f' (\ _ _ _ -> n') as bs cs ds)
+{-# zipWith4 :: Inline #-}
+--zipWith4 z (a:as) (b:bs) (c:cs) (d:ds)
+--			=  z a b c d : zipWith4 z as bs cs ds
+--zipWith4 _ _ _ _ _	=  []
+
+zipWith5		:: (a->b->c->d->e->f)
+			   -> [a]->[b]->[c]->[d]->[e]->[f]
+zipWith5 z as bs cs ds es=
+  build (\ c' n' ->
+          let f' a g' (b:bs) (c:cs) (d:ds) (e:es) =
+	        c' (z a b c d e) (g' bs cs ds es)
+              f' a g' _ _ _ _ = n'
+          in foldr f' (\ _ _ _ _ -> n') as bs cs ds es)
+{-# zipWith5 :: Inline #-}
+--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 _ _ _ _ _ _	=  []
+
+zipWith6		:: (a->b->c->d->e->f->g)
+			   -> [a]->[b]->[c]->[d]->[e]->[f]->[g]
+zipWith6 z as bs cs ds es fs =
+  build (\ c' n' ->
+          let f' a g' (b:bs) (c:cs) (d:ds) (e:es) (f:fs) =
+	        c' (z a b c d e f) (g' bs cs ds es fs)
+              f' a g' _ _ _ _ _ = n'
+          in foldr f' (\ _ _ _ _ _ -> n') as bs cs ds es fs)
+{-# zipWith6 :: Inline #-}
+--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 _ _ _ _ _ _ _	=  []
+
+zipWith7		:: (a->b->c->d->e->f->g->h)
+			   -> [a]->[b]->[c]->[d]->[e]->[f]->[g]->[h]
+zipWith7 z as bs cs ds es fs gs =
+  build (\ c' n' ->
+          let f' a g' (b:bs) (c:cs) (d:ds) (e:es) (f:fs) (g:gs) =
+	        c' (z a b c d e f g) (g' bs cs ds es fs gs)
+              f' a g' _ _ _ _ _ _ = n'
+          in foldr f' (\ _ _ _ _ _ _ -> n') as bs cs ds es fs gs)
+{-# zipWith7 :: Inline #-}
+--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 _ _ _ _ _ _ _ _ =  []
+
+
+-- unzip transforms a list of pairs into a pair of lists.  As with zip,
+-- a family of such functions up to septuplets is provided.
+
+unzip			:: [(a,b)] -> ([a],[b])
+unzip			=  foldr (\(a,b) ~(as,bs) -> (a:as,b:bs)) ([],[])
+{-# unzip :: Inline #-}
+
+
+unzip3			:: [(a,b,c)] -> ([a],[b],[c])
+unzip3			=  foldr (\(a,b,c) ~(as,bs,cs) -> (a:as,b:bs,c:cs))
+				 ([],[],[])
+{-# unzip3 :: Inline #-}
+
+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))
+				 ([],[],[],[])
+{-# unzip4 :: Inline #-}
+
+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))
+				 ([],[],[],[],[])
+{-# unzip5 :: Inline #-}
+
+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))
+				 ([],[],[],[],[],[])
+{-# unzip6 :: Inline #-}
+
+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))
+				 ([],[],[],[],[],[],[])
+{-# unzip7 :: Inline #-}
+
-- 
cgit v1.2.3