X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=inline;f=ghc%2Flib%2Fstd%2FPrelList.lhs;h=7b85297ee481e5f6b152f63049bbda632463a4cd;hb=a103a9dc0de992716e62c30d7ac81c0bc0dbcdc5;hp=d6514e3b6913a5142be11994d3a3ff43413890dc;hpb=c415cd35368f45739132fc180837fc07f0490921;p=ghc-hetmet.git diff --git a/ghc/lib/std/PrelList.lhs b/ghc/lib/std/PrelList.lhs index d6514e3..7b85297 100644 --- a/ghc/lib/std/PrelList.lhs +++ b/ghc/lib/std/PrelList.lhs @@ -7,7 +7,7 @@ The List data type and its operations \begin{code} -{-# OPTIONS -fno-implicit-prelude #-} +{-# OPTIONS -fcompiling-prelude -fno-implicit-prelude #-} module PrelList ( [] (..), @@ -22,10 +22,16 @@ module PrelList ( maximum, minimum, concatMap, zip, zip3, zipWith, zipWith3, unzip, unzip3, +#ifdef USE_REPORT_PRELUDE + +#else + -- non-standard, but hidden when creating the Prelude -- export list. takeUInt_append +#endif + ) where import {-# SOURCE #-} PrelErr ( error ) @@ -51,7 +57,18 @@ infix 4 `elem`, `notElem` head :: [a] -> a head (x:_) = x -head [] = errorEmptyList "head" +head [] = badHead + +badHead = errorEmptyList "head" + +-- This rule is useful in cases like +-- head [y | (x,y) <- ps, x==t] +{-# RULES +"head/build" forall (g::forall b.(Bool->b->b)->b->b) . + head (build g) = g (\x _ -> x) badHead +"head/augment" forall xs (g::forall b. (a->b->b) -> b -> b) . + head (augment g xs) = g (\x _ -> x) (head xs) + #-} tail :: [a] -> [a] tail (_:xs) = xs @@ -101,14 +118,14 @@ length l = len l 0# -- elements that satisfy the predicate; i.e., -- filter p xs = [ x | x <- xs, p x] filter :: (a -> Bool) -> [a] -> [a] -{-# INLINE filter #-} -filter p xs = build (\c n -> foldr (filterFB c p) n xs) +filter = filterList filterFB c p x r | p x = x `c` r | otherwise = r {-# RULES -"filterFB" forall c,p,q. filterFB (filterFB c p) q = filterFB c (\x -> p x && q x) +"filter" forall p xs. filter p xs = build (\c n -> foldr (filterFB c p) n xs) +"filterFB" forall c p q. filterFB (filterFB c p) q = filterFB c (\x -> p x && q x) "filterList" forall p. foldr (filterFB (:) p) [] = filterList p #-} @@ -168,12 +185,30 @@ scanr1 _ [] = errorEmptyList "scanr1" -- 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 = x : iterate f (f x) +iterate :: (a -> a) -> a -> [a] +iterate = iterateList + +iterateFB c f x = x `c` iterateFB c f (f x) + +iterateList f x = x : iterateList f (f x) + +{-# RULES +"iterate" forall f x. iterate f x = build (\c _n -> iterateFB c f x) +"iterateFB" iterateFB (:) = iterateList + #-} + -- repeat x is an infinite list, with x the value of every element. -repeat :: a -> [a] -repeat x = xs where xs = x:xs +repeat :: a -> [a] +repeat = repeatList + +repeatFB c x = xs where xs = x `c` xs +repeatList x = xs where xs = x : xs + +{-# RULES +"repeat" forall x. repeat x = build (\c _n -> repeatFB c x) +"repeatFB" repeatFB (:) = repeatList + #-} -- replicate n x is a list of length n with x the value of every element replicate :: Int -> a -> [a] @@ -212,20 +247,20 @@ dropWhile p xs@(x:xs') take :: Int -> [a] -> [a] take 0 _ = [] take _ [] = [] -take n (x:xs) | n > 0 = x : take (n-1) xs +take n (x:xs) | n > 0 = x : take (minusInt n 1) xs take _ _ = errorNegativeIdx "take" drop :: Int -> [a] -> [a] drop 0 xs = xs drop _ [] = [] -drop n (_:xs) | n > 0 = drop (n-1) xs +drop n (_:xs) | n > 0 = drop (minusInt n 1) xs drop _ _ = errorNegativeIdx "drop" splitAt :: Int -> [a] -> ([a],[a]) splitAt 0 xs = ([],xs) splitAt _ [] = ([],[]) -splitAt n (x:xs) | n > 0 = (x:xs',xs'') where (xs',xs'') = splitAt (n-1) xs +splitAt n (x:xs) | n > 0 = (x:xs',xs'') where (xs',xs'') = splitAt (minusInt n 1) xs splitAt _ _ = errorNegativeIdx "splitAt" #else /* hack away */ @@ -326,9 +361,9 @@ or [] = False or (x:xs) = x || or xs {-# RULES -"and/build" forall g::forall b.(Bool->b->b)->b->b . +"and/build" forall (g::forall b.(Bool->b->b)->b->b) . and (build g) = g (&&) True -"or/build" forall g::forall b.(Bool->b->b)->b->b . +"or/build" forall (g::forall b.(Bool->b->b)->b->b) . or (build g) = g (||) False #-} #endif @@ -346,10 +381,10 @@ any p (x:xs) = p x || any p xs all _ [] = True all p (x:xs) = p x && all p xs {-# RULES -"any/build" forall p, g::forall b.(a->b->b)->b->b . - any p (build g) = g ((&&) . p) True -"all/build" forall p, g::forall b.(a->b->b)->b->b . - all p (build g) = g ((||) . p) False +"any/build" forall p (g::forall b.(a->b->b)->b->b) . + any p (build g) = g ((||) . p) False +"all/build" forall p (g::forall b.(a->b->b)->b->b) . + all p (build g) = g ((&&) . p) True #-} #endif @@ -400,7 +435,7 @@ concat = foldr (++) [] (!!) :: [a] -> Int -> a #ifdef USE_REPORT_PRELUDE (x:_) !! 0 = x -(_:xs) !! n | n > 0 = xs !! (n-1) +(_:xs) !! n | n > 0 = xs !! (minusInt n 1) (_:_) !! _ = error "Prelude.(!!): negative index" [] !! _ = error "Prelude.(!!): index too large" #else @@ -427,23 +462,23 @@ xs !! (I# n) | n <# 0# = error "Prelude.(!!): negative index\n" %********************************************************* \begin{code} -foldr2 k z [] ys = z -foldr2 k z xs [] = z +foldr2 _k z [] _ys = z +foldr2 _k z _xs [] = z foldr2 k z (x:xs) (y:ys) = k x y (foldr2 k z xs ys) -foldr2_left k z x r [] = z -foldr2_left k z x r (y:ys) = k x y (r ys) +foldr2_left _k z _x _r [] = z +foldr2_left k _z x r (y:ys) = k x y (r ys) -foldr2_right k z y r [] = z -foldr2_right k z y r (x:xs) = k x y (r xs) +foldr2_right _k z _y _r [] = z +foldr2_right k _z y r (x:xs) = k x y (r xs) --- foldr2 k z xs ys = foldr (foldr2_left k z) z xs ys --- foldr2 k z xs ys = foldr (foldr2_right k z) z ys xs +-- foldr2 k z xs ys = foldr (foldr2_left k z) (\_ -> z) xs ys +-- foldr2 k z xs ys = foldr (foldr2_right k z) (\_ -> z) ys xs {-# RULES -"foldr2/left" forall k,z,ys,g::forall b.(a->b->b)->b->b . +"foldr2/left" forall k z ys (g::forall b.(a->b->b)->b->b) . foldr2 k z (build g) ys = g (foldr2_left k z) (\_ -> z) ys -"foldr2/right" forall k,z,xs,g::forall b.(a->b->b)->b->b . +"foldr2/right" forall k z xs (g::forall b.(a->b->b)->b->b) . foldr2 k z xs (build g) = g (foldr2_right k z) (\_ -> z) xs #-} \end{code} @@ -456,8 +491,7 @@ tuples are in the List library \begin{code} ---------------------------------------------- zip :: [a] -> [b] -> [(a,b)] -{-# INLINE zip #-} -zip xs ys = build (\c n -> foldr2 (zipFB c) n xs ys) +zip = zipList zipFB c x y r = (x,y) `c` r @@ -467,7 +501,8 @@ zipList (a:as) (b:bs) = (a,b) : zipList as bs zipList _ _ = [] {-# RULES -"zipList" foldr2 (zipFB (:)) [] = zipList +"zip" forall xs ys. zip xs ys = build (\c n -> foldr2 (zipFB c) n xs ys) +"zipList" foldr2 (zipFB (:)) [] = zipList #-} \end{code} @@ -490,17 +525,18 @@ zip3 _ _ _ = [] \begin{code} ---------------------------------------------- zipWith :: (a->b->c) -> [a]->[b]->[c] -{-# INLINE zipWith #-} -zipWith f xs ys = build (\c n -> foldr2 (zipWithFB c f) n xs ys) +zipWith = zipWithList + zipWithFB c f x y r = (x `f` y) `c` r zipWithList :: (a->b->c) -> [a] -> [b] -> [c] zipWithList f (a:as) (b:bs) = f a b : zipWithList f as bs -zipWithList f _ _ = [] +zipWithList _ _ _ = [] {-# RULES -"zipWithList" forall f. foldr2 (zipWithFB (:) f) [] = zipWithList f +"zipWith" forall f xs ys. zipWith f xs ys = build (\c n -> foldr2 (zipWithFB c f) n xs ys) +"zipWithList" forall f. foldr2 (zipWithFB (:) f) [] = zipWithList f #-} \end{code} @@ -512,9 +548,11 @@ zipWith3 _ _ _ _ = [] -- unzip transforms a list of pairs into a pair of lists. unzip :: [(a,b)] -> ([a],[b]) +{-# INLINE unzip #-} unzip = foldr (\(a,b) ~(as,bs) -> (a:as,b:bs)) ([],[]) unzip3 :: [(a,b,c)] -> ([a],[b],[c]) +{-# INLINE unzip3 #-} unzip3 = foldr (\(a,b,c) ~(as,bs,cs) -> (a:as,b:bs,c:cs)) ([],[],[]) \end{code}