@@ -183,7 +183,6 @@ import Data.Data
183
183
184
184
-- Array stuff, with GHC.Arr on GHC
185
185
import Data.Array (Ix , Array )
186
- import qualified Data.Array
187
186
#ifdef __GLASGOW_HASKELL__
188
187
import qualified GHC.Arr
189
188
#endif
@@ -200,6 +199,15 @@ import qualified GHC.Exts
200
199
import Data.Functor.Identity (Identity (.. ))
201
200
#endif
202
201
202
+
203
+ -- Use macros to define strictness of functions.
204
+ -- STRICT_x_OF_y denotes an y-ary function strict in the x-th parameter.
205
+ -- We do not use BangPatterns, because they are not in any standard and we
206
+ -- want the compilers to be compiled by as many compilers as possible.
207
+ #define STRICT_1_OF_2(fn) fn arg _ | arg `seq` False = undefined
208
+ #define STRICT_1_OF_3(fn) fn arg _ _ | arg `seq` False = undefined
209
+
210
+
203
211
infixr 5 `consTree`
204
212
infixl 5 `snocTree`
205
213
@@ -1783,27 +1791,27 @@ findIndicesR p xs = foldlWithIndex g [] xs
1783
1791
-- There is a function 'toList' in the opposite direction for all
1784
1792
-- instances of the 'Foldable' class, including 'Seq'.
1785
1793
fromList :: [a ] -> Seq a
1786
- fromList xs = Seq $ mkTree 1 $ map_elem xs
1794
+ fromList = Seq . mkTree 1 . map_elem
1787
1795
where
1788
1796
{-# SPECIALIZE mkTree :: Int -> [Elem a] -> FingerTree (Elem a) #-}
1789
1797
{-# SPECIALIZE mkTree :: Int -> [Node a] -> FingerTree (Node a) #-}
1790
1798
mkTree :: (Sized a ) => Int -> [a ] -> FingerTree a
1791
- mkTree s [] = s `seq` Empty
1792
- mkTree s [x1] = s `seq` Single x1
1799
+ STRICT_1_OF_2 (mkTree)
1800
+ mkTree _ [] = Empty
1801
+ mkTree _ [x1] = Single x1
1793
1802
mkTree s [x1, x2] = Deep (2 * s) (One x1) Empty (One x2)
1794
1803
mkTree s [x1, x2, x3] = Deep (3 * s) (One x1) Empty (Two x2 x3)
1795
- mkTree s (x1: x2: x3: xs) = s `seq` case getNodes (3 * s) xs of
1796
- (ns, sf) -> m `seq` deep' (Three x1 x2 x3) m sf
1797
- where m = mkTree (3 * s) ns
1798
-
1799
- deep' pr@ (Three x1 _ _) m sf = Deep (3 * size x1 + size m + size sf) pr m sf
1800
-
1801
- getNodes :: Int -> [a ] -> ([Node a ], Digit a )
1802
- getNodes s [x1] = s `seq` ([] , One x1)
1803
- getNodes s [x1, x2] = s `seq` ([] , Two x1 x2)
1804
- getNodes s [x1, x2, x3] = s `seq` ([] , Three x1 x2 x3)
1805
- getNodes s (x1: x2: x3: xs) = s `seq` (Node3 s x1 x2 x3: ns, d)
1806
- where (ns, d) = getNodes s xs
1804
+ mkTree s (x1: x2: x3: x4: xs) = case getNodes (3 * s) x4 xs of
1805
+ (ns, sf) -> case mkTree (3 * s) ns of
1806
+ m -> m `seq` Deep (3 * size x1 + size m + size sf) (Three x1 x2 x3) m sf
1807
+
1808
+ getNodes :: Int -> a -> [a ] -> ([Node a ], Digit a )
1809
+ STRICT_1_OF_3 (getNodes)
1810
+ getNodes _ x1 [] = ([] , One x1)
1811
+ getNodes _ x1 [x2] = ([] , Two x1 x2)
1812
+ getNodes _ x1 [x2, x3] = ([] , Three x1 x2 x3)
1813
+ getNodes s x1 (x2: x3: x4: xs) = (Node3 s x1 x2 x3: ns, d)
1814
+ where (ns, d) = getNodes s x4 xs
1807
1815
1808
1816
map_elem :: [a ] -> [Elem a ]
1809
1817
#if __GLASGOW_HASKELL__ >= 708
0 commit comments