From 0a8d23b57e59e040f0ad276e51de2f7e8c50edce Mon Sep 17 00:00:00 2001 From: Simon Marlow Date: Tue, 27 Mar 2007 10:39:41 +0000 Subject: [PATCH] fix strictness of foldr/build rule for take, see #1219 --- GHC/List.lhs | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/GHC/List.lhs b/GHC/List.lhs index e265733..ce13f46 100644 --- a/GHC/List.lhs +++ b/GHC/List.lhs @@ -350,10 +350,16 @@ splitAt n xs = (take n xs, drop n xs) #else /* hack away */ {-# RULES -"take" [~1] forall n xs . take n xs = case n of I# n# -> build (\c nil -> foldr (takeFB c nil) (takeConst nil) xs n#) +"take" [~1] forall n xs . take n xs = takeFoldr n xs "takeList" [1] forall n xs . foldr (takeFB (:) []) (takeConst []) xs n = takeUInt n xs #-} +{-# INLINE takeFoldr #-} +takeFoldr :: Int -> [a] -> [a] +takeFoldr (I# n#) xs + = build (\c nil -> if n# <=# 0# then nil else + foldr (takeFB c nil) (takeConst nil) xs n#) + {-# NOINLINE [0] takeConst #-} -- just a version of const that doesn't get inlined too early, so we -- can spot it in rules. Also we need a type sig due to the unboxed Int#. @@ -361,8 +367,8 @@ takeConst :: a -> Int# -> a takeConst x _ = x {-# NOINLINE [0] takeFB #-} -takeFB :: (a -> b -> c) -> c -> a -> (Int# -> b) -> Int# -> c -takeFB c n x xs m | m <=# 0# = n +takeFB :: (a -> b -> b) -> b -> a -> (Int# -> b) -> Int# -> b +takeFB c n x xs m | m <=# 1# = x `c` n | otherwise = x `c` xs (m -# 1#) {-# INLINE [0] take #-} -- 1.7.10.4