projects
/
ghc-base.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
c713f3f
)
fix strictness of foldr/build rule for take, see #1219
author
Simon Marlow
<simonmar@microsoft.com>
Tue, 27 Mar 2007 10:39:41 +0000
(10:39 +0000)
committer
Simon Marlow
<simonmar@microsoft.com>
Tue, 27 Mar 2007 10:39:41 +0000
(10:39 +0000)
GHC/List.lhs
patch
|
blob
|
history
diff --git
a/GHC/List.lhs
b/GHC/List.lhs
index
e265733
..
ce13f46
100644
(file)
--- 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
#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
#-}
"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#.
{-# 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 #-}
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 #-}
| otherwise = x `c` xs (m -# 1#)
{-# INLINE [0] take #-}