Skip to content

Commit f276b11

Browse files
committed
Big hammer
1 parent 8563d99 commit f276b11

File tree

2 files changed

+24
-17
lines changed

2 files changed

+24
-17
lines changed

containers/src/Data/Sequence/Internal.hs

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -3351,8 +3351,8 @@ foldWithIndexNode (<+>) f s (Node3 _ a b c) = f s a <+> f sPsa b <+> f sPsab c
33513351
-- element in the sequence.
33523352
--
33533353
-- @since 0.5.8
3354-
foldMapWithIndex :: forall m a. Monoid m => (Int -> a -> m) -> Seq a -> m
33553354
#ifdef __GLASGOW_HASKELL__
3355+
foldMapWithIndex :: forall m a. Monoid m => (Int -> a -> m) -> Seq a -> m
33563356
foldMapWithIndex f (Seq t) = foldMapWithIndexFT Bottom 0 t
33573357
where
33583358
foldMapWithIndexFT :: Depth (Elem a) t -> Int -> FingerTree t -> m
@@ -3401,6 +3401,7 @@ sizeBlob2 Bottom2 = size
34013401
sizeBlob2 (Deeper2 _) = size
34023402

34033403
#else
3404+
foldMapWithIndex :: Monoid m => (Int -> a -> m) -> Seq a -> m
34043405
foldMapWithIndex f' (Seq xs') = foldMapWithIndexTreeE (lift_elem f') 0 xs'
34053406
where
34063407
lift_elem :: (Int -> a -> m) -> (Int -> Elem a -> m)

containers/src/Data/Sequence/Internal/Depth.hs

Lines changed: 22 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,11 @@
33
{-# LANGUAGE KindSignatures #-}
44
{-# LANGUAGE PatternSynonyms #-}
55
{-# LANGUAGE RoleAnnotations #-}
6+
#if defined(MIN_VERSION_GLASGOW_HASKELL) && MIN_VERSION_GLASGOW_HASKELL(9,2,0,0)
67
{-# LANGUAGE Trustworthy #-}
8+
#else
9+
{-# LANGUAGE Safe #-}
10+
#endif
711
{-# LANGUAGE TypeOperators #-}
812
{-# LANGUAGE ViewPatterns #-}
913

@@ -33,8 +37,10 @@ module Data.Sequence.Internal.Depth
3337
, Depth2_ (Bottom2, Deeper2)
3438
) where
3539

40+
#if defined(MIN_VERSION_GLASGOW_HASKELL) && MIN_VERSION_GLASGOW_HASKELL(9,2,0,0)
3641
import Data.Kind (Type)
3742
import Unsafe.Coerce (unsafeCoerce)
43+
#endif
3844

3945
-- @Depth_@ is an optimized representation of the following GADT:
4046
--
@@ -55,6 +61,15 @@ import Unsafe.Coerce (unsafeCoerce)
5561
-- arithmetic overflow on 64-bit systems requires somewhat absurdly long
5662
-- computations on sequences constructed with extensive amounts of internal
5763
-- sharing (e.g., using the '*>' operator repeatedly).
64+
#if !defined(MIN_VERSION_GLASGOW_HASKELL) || !MIN_VERSION_GLASGOW_HASKELL(9,2,0,0)
65+
-- Old versions of GHC would crash out in all sorts of weird ways with the fancy version,
66+
-- so we give a totally plain version here. We also use the plain one for MicroHS, for
67+
-- now, because I don't know what it wants.
68+
data Depth_ node a t where
69+
Bottom :: Depth_ node a a
70+
Deeper :: !(Depth_ node a t) -> Depth_ node a (node t)
71+
72+
#else
5873
newtype Depth_ (node :: Type -> Type) (a :: Type) (t :: Type)
5974
= Depth_ Word
6075
type role Depth_ nominal nominal nominal
@@ -64,9 +79,7 @@ pattern Bottom :: () => t ~ a => Depth_ node a t
6479
pattern Bottom <- (checkBottom -> AtBottom)
6580
where
6681
Bottom = Depth_ 0
67-
#if defined(MIN_VERSION_GLASGOW_HASKELL) && MIN_VERSION_GLASGOW_HASKELL(9,2,0,0)
6882
{-# INLINE Bottom #-}
69-
#endif
7083

7184
-- | The depth is non-zero.
7285
pattern Deeper :: () => t ~ node t' => Depth_ node a t' -> Depth_ node a t
@@ -75,9 +88,7 @@ pattern Deeper d <- (checkBottom -> NotBottom d)
7588
Deeper (Depth_ d)
7689
| d == maxBound = error "Depth overflow"
7790
| otherwise = Depth_ (d + 1)
78-
#if defined(MIN_VERSION_GLASGOW_HASKELL) && MIN_VERSION_GLASGOW_HASKELL(9,2,0,0)
7991
{-# INLINE Deeper #-}
80-
#endif
8192

8293
{-# COMPLETE Bottom, Deeper #-}
8394

@@ -88,20 +99,22 @@ data CheckedBottom node a t where
8899
checkBottom :: Depth_ node a t -> CheckedBottom node a t
89100
checkBottom (Depth_ 0) = unsafeCoerce AtBottom
90101
checkBottom (Depth_ d) = unsafeCoerce (NotBottom (Depth_ (d - 1)))
91-
#if defined(MIN_VERSION_GLASGOW_HASKELL) && MIN_VERSION_GLASGOW_HASKELL(9,2,0,0)
92102
{-# INLINE checkBottom #-}
93-
#else
94-
{-# NOINLINE checkBottom #-}
95-
#endif
96103

104+
#endif
97105

98106
-- | A version of 'Depth_' for implementing traversals. Conceptually,
99107
--
100108
-- @
101109
-- data Depth2_ node a t b u where
102110
-- Bottom2 :: Depth2_ node a a b b
103-
-- Deeper2 :: !(Depth2_ node a t b u) -> Depth_ node a (node t) b (node u)
111+
-- Deeper2 :: !(Depth2_ node a t b u) -> Depth2_ node a (node t) b (node u)
104112
-- @
113+
#if !defined(MIN_VERSION_GLASGOW_HASKELL) || !MIN_VERSION_GLASGOW_HASKELL(9,2,0,0)
114+
data Depth2_ node a t b u where
115+
Bottom2 :: Depth2_ node a a b b
116+
Deeper2 :: !(Depth2_ node a t b u) -> Depth2_ node a (node t) b (node u)
117+
#else
105118
newtype Depth2_ (node :: Type -> Type) (a :: Type) (t :: Type) (b :: Type) (u :: Type)
106119
= Depth2_ Word
107120
type role Depth2_ nominal nominal nominal nominal nominal
@@ -111,9 +124,7 @@ pattern Bottom2 :: () => (t ~ a, u ~ b) => Depth2_ node a t b u
111124
pattern Bottom2 <- (checkBottom2 -> AtBottom2)
112125
where
113126
Bottom2 = Depth2_ 0
114-
#if defined(MIN_VERSION_GLASGOW_HASKELL) && MIN_VERSION_GLASGOW_HASKELL(9,2,0,0)
115127
{-# INLINE Bottom2 #-}
116-
#endif
117128

118129
-- | The depth is non-zero.
119130
pattern Deeper2 :: () => (t ~ node t', u ~ node u') => Depth2_ node a t' b u' -> Depth2_ node a t b u
@@ -122,9 +133,7 @@ pattern Deeper2 d <- (checkBottom2 -> NotBottom2 d)
122133
Deeper2 (Depth2_ d)
123134
| d == maxBound = error "Depth2 overflow"
124135
| otherwise = Depth2_ (d + 1)
125-
#if defined(MIN_VERSION_GLASGOW_HASKELL) && MIN_VERSION_GLASGOW_HASKELL(9,2,0,0)
126136
{-# INLINE Deeper2 #-}
127-
#endif
128137

129138
{-# COMPLETE Bottom2, Deeper2 #-}
130139

@@ -135,8 +144,5 @@ data CheckedBottom2 node a t b u where
135144
checkBottom2 :: Depth2_ node a t b u -> CheckedBottom2 node a t b u
136145
checkBottom2 (Depth2_ 0) = unsafeCoerce AtBottom2
137146
checkBottom2 (Depth2_ d) = unsafeCoerce (NotBottom2 (Depth2_ (d - 1)))
138-
#if MIN_VERSION_GLASGOW_HASKELL(9,2,0,0)
139147
{-# INLINE checkBottom2 #-}
140-
#else
141-
{-# NOINLINE checkBottom2 #-}
142148
#endif

0 commit comments

Comments
 (0)