diff --git a/Data/Graph.hs b/Data/Graph.hs
--- a/Data/Graph.hs
+++ b/Data/Graph.hs
@@ -295,7 +295,7 @@
 newtype SetM s a = SetM { runSetM :: STArray s Vertex Bool -> ST s a }
 
 instance Monad (SetM s) where
-    return x     = SetM $ const (return x)
+    return = pure
     {-# INLINE return #-}
     SetM v >>= f = SetM $ \s -> do { x <- v s; runSetM (f x) s }
     {-# INLINE (>>=) #-}
diff --git a/Data/IntMap/Base.hs b/Data/IntMap/Base.hs
--- a/Data/IntMap/Base.hs
+++ b/Data/IntMap/Base.hs
@@ -216,14 +216,15 @@
     , highestBitMask
     ) where
 
-#if MIN_VERSION_base(4,8,0)
-import Control.Applicative ((<$>))
-#else
+#if !(MIN_VERSION_base(4,8,0))
 import Control.Applicative (Applicative(pure, (<*>)), (<$>))
 import Data.Monoid (Monoid(..))
 import Data.Traversable (Traversable(traverse))
 import Data.Word (Word)
 #endif
+#if MIN_VERSION_base(4,9,0)
+import Data.Semigroup (Semigroup((<>), stimes), stimesIdempotentMonoid)
+#endif
 
 import Control.DeepSeq (NFData(rnf))
 import Control.Monad (liftM)
@@ -307,8 +308,16 @@
 
 instance Monoid (IntMap a) where
     mempty  = empty
-    mappend = union
     mconcat = unions
+#if !(MIN_VERSION_base(4,9,0))
+    mappend = union
+#else
+    mappend = (<>)
+
+instance Semigroup (IntMap a) where
+    (<>)    = union
+    stimes  = stimesIdempotentMonoid
+#endif
 
 instance Foldable.Foldable IntMap where
   fold = go
diff --git a/Data/IntMap/Strict.hs b/Data/IntMap/Strict.hs
--- a/Data/IntMap/Strict.hs
+++ b/Data/IntMap/Strict.hs
@@ -505,7 +505,7 @@
 
 
 
--- | /O(log n)/. The expression (@'alter' f k map@) alters the value @x@ at @k@, or absence thereof.
+-- | /O(min(n,W))/. The expression (@'alter' f k map@) alters the value @x@ at @k@, or absence thereof.
 -- 'alter' can be used to insert, delete, or update a value in an 'IntMap'.
 -- In short : @'lookup' k ('alter' f k m) = f ('lookup' k m)@.
 alter :: (Maybe a -> Maybe a) -> Key -> IntMap a -> IntMap a
diff --git a/Data/IntSet/Base.hs b/Data/IntSet/Base.hs
--- a/Data/IntSet/Base.hs
+++ b/Data/IntSet/Base.hs
@@ -173,6 +173,9 @@
 import Data.Monoid (Monoid(..))
 import Data.Word (Word)
 #endif
+#if MIN_VERSION_base(4,9,0)
+import Data.Semigroup (Semigroup((<>), stimes), stimesIdempotentMonoid)
+#endif
 import Data.Typeable
 import Prelude hiding (filter, foldr, foldl, null, map)
 
@@ -247,9 +250,17 @@
 
 instance Monoid IntSet where
     mempty  = empty
-    mappend = union
     mconcat = unions
+#if !(MIN_VERSION_base(4,9,0))
+    mappend = union
+#else
+    mappend = (<>)
 
+instance Semigroup IntSet where
+    (<>)    = union
+    stimes  = stimesIdempotentMonoid
+#endif
+
 #if __GLASGOW_HASKELL__
 
 {--------------------------------------------------------------------
@@ -882,7 +893,6 @@
                         | otherwise -> go (go z l) r
             _ -> go z t
   where
-    STRICT_1_OF_2(go)
     go z' Nil           = z'
     go z' (Tip kx bm)   = foldlBits kx f z' bm
     go z' (Bin _ _ l r) = go (go z' l) r
diff --git a/Data/Map/Base.hs b/Data/Map/Base.hs
--- a/Data/Map/Base.hs
+++ b/Data/Map/Base.hs
@@ -80,7 +80,7 @@
 
 -- [Note: Local 'go' functions and capturing]
 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--- As opposed to IntMap, when 'go' function captures an argument, increased
+-- As opposed to Map, when 'go' function captures an argument, increased
 -- heap-allocation can occur: sometimes in a polymorphic function, the 'go'
 -- floats out of its enclosing function and then it heap-allocates the
 -- dictionary and the argument. Maybe it floats out too late and strictness
@@ -270,13 +270,14 @@
     , filterLt
     ) where
 
-#if MIN_VERSION_base(4,8,0)
-import Control.Applicative ((<$>))
-#else
+#if !(MIN_VERSION_base(4,8,0))
 import Control.Applicative (Applicative(..), (<$>))
 import Data.Monoid (Monoid(..))
 import Data.Traversable (Traversable(traverse))
 #endif
+#if MIN_VERSION_base(4,9,0)
+import Data.Semigroup (Semigroup((<>), stimes), stimesIdempotentMonoid)
+#endif
 
 import Control.DeepSeq (NFData(rnf))
 import Data.Bits (shiftL, shiftR)
@@ -342,9 +343,17 @@
 
 instance (Ord k) => Monoid (Map k v) where
     mempty  = empty
-    mappend = union
     mconcat = unions
+#if !(MIN_VERSION_base(4,9,0))
+    mappend = union
+#else
+    mappend = (<>)
 
+instance (Ord k) => Semigroup (Map k v) where
+    (<>)    = union
+    stimes  = stimesIdempotentMonoid
+#endif
+
 #if __GLASGOW_HASKELL__
 
 {--------------------------------------------------------------------
@@ -1413,7 +1422,7 @@
 -- > myIntersectionWithKey f m1 m2 = mergeWithKey (\k x1 x2 -> Just (f k x1 x2)) (const empty) (const empty) m1 m2
 --
 -- When calling @'mergeWithKey' combine only1 only2@, a function combining two
--- 'IntMap's is created, such that
+-- 'Map's is created, such that
 --
 -- * if a key is present in both maps, it is passed with both corresponding
 --   values to the @combine@ function. Depending on the result, the key is either
@@ -1689,7 +1698,7 @@
 #endif
 
 -- | /O(n)/.
--- @'traverseWithKey' f s == 'fromList' <$> 'traverse' (\(k, v) -> (,) k <$> f k v) ('toList' m)@
+-- @'traverseWithKey' f m == 'fromList' <$> 'traverse' (\(k, v) -> (,) k <$> f k v) ('toList' m)@
 -- That is, behaves exactly like a regular 'traverse' except that the traversing
 -- function also has access to the key associated with a value.
 --
diff --git a/Data/Sequence.hs b/Data/Sequence.hs
--- a/Data/Sequence.hs
+++ b/Data/Sequence.hs
@@ -1,6 +1,8 @@
 {-# LANGUAGE CPP #-}
 #if __GLASGOW_HASKELL__
-{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE FlexibleInstances #-}
 #endif
 #if __GLASGOW_HASKELL__ >= 703
 {-# LANGUAGE Trustworthy #-}
@@ -156,7 +158,7 @@
 import Prelude hiding (
     Functor(..),
 #if MIN_VERSION_base(4,8,0)
-    Applicative, foldMap, Monoid,
+    Applicative, (<$>), foldMap, Monoid,
 #endif
     null, length, take, drop, splitAt, foldl, foldl1, foldr, foldr1,
     scanl, scanl1, scanr, scanr1, replicate, zip, zipWith, zip3, zipWith3,
@@ -173,6 +175,9 @@
 #if MIN_VERSION_base(4,8,0)
 import Data.Foldable (foldr')
 #endif
+#if MIN_VERSION_base(4,9,0)
+import Data.Semigroup (Semigroup((<>)))
+#endif
 import Data.Traversable
 import Data.Typeable
 
@@ -182,6 +187,7 @@
 import Text.Read (Lexeme(Ident), lexP, parens, prec,
     readPrec, readListPrec, readListPrecDefault)
 import Data.Data
+import Data.String (IsString(..))
 #endif
 
 -- Array stuff, with GHC.Arr on GHC
@@ -264,160 +270,158 @@
     rnf (Seq xs) = rnf xs
 
 instance Monad Seq where
-    return = singleton
+    return = pure
     xs >>= f = foldl' add empty xs
       where add ys x = ys >< f x
     (>>) = (*>)
 
 instance Applicative Seq where
     pure = singleton
+    xs *> ys = cycleN (length xs) ys
 
-    Seq Empty <*> xs = xs `seq` empty
-    fs <*> Seq Empty = fs `seq` empty
-    fs <*> Seq (Single (Elem x)) = fmap ($ x) fs
-    fs <*> xs
-      | length fs < 4 = foldl' add empty fs
-      where add ys f = ys >< fmap f xs
-    fs <*> xs | length xs < 4 = apShort fs xs
-    fs <*> xs = apty fs xs
+    fs <*> xs@(Seq xsFT) = case viewl fs of
+      EmptyL -> empty
+      firstf :< fs' -> case viewr fs' of
+        EmptyR -> fmap firstf xs
+        Seq fs''FT :> lastf -> case rigidify xsFT of
+             RigidEmpty -> empty
+             RigidOne (Elem x) -> fmap ($x) fs
+             RigidTwo (Elem x1) (Elem x2) ->
+                Seq $ ap2FT firstf fs''FT lastf (x1, x2)
+             RigidThree (Elem x1) (Elem x2) (Elem x3) ->
+                Seq $ ap3FT firstf fs''FT lastf (x1, x2, x3)
+             RigidFull r@(Rigid s pr _m sf) -> Seq $
+                   Deep (s * length fs)
+                        (fmap (fmap firstf) (nodeToDigit pr))
+                        (aptyMiddle (fmap firstf) (fmap lastf) fmap fs''FT r)
+                        (fmap (fmap lastf) (nodeToDigit sf))
 
-    xs *> ys = replicateSeq (length xs) ys
 
--- <*> when the length of the first argument is at least two and
--- the length of the second is two or three.
-apShort :: Seq (a -> b) -> Seq a -> Seq b
-apShort (Seq fs) xs = Seq $ case toList xs of
-            [a,b] -> ap2FT fs (a,b)
-            [a,b,c] -> ap3FT fs (a,b,c)
-            _ -> error "apShort: not 2-3"
-
-ap2FT :: FingerTree (Elem (a->b)) -> (a,a) -> FingerTree (Elem b)
-ap2FT fs (x,y) = Deep (size fs * 2)
+ap2FT :: (a -> b) -> FingerTree (Elem (a->b)) -> (a -> b) -> (a,a) -> FingerTree (Elem b)
+ap2FT firstf fs lastf (x,y) =
+                 Deep (size fs * 2 + 4)
                       (Two (Elem $ firstf x) (Elem $ firstf y))
-                      (mapMulFT 2 (\(Elem f) -> Node2 2 (Elem (f x)) (Elem (f y))) m)
+                      (mapMulFT 2 (\(Elem f) -> Node2 2 (Elem (f x)) (Elem (f y))) fs)
                       (Two (Elem $ lastf x) (Elem $ lastf y))
-  where
-    (Elem firstf, m, Elem lastf) = trimTree fs
 
-ap3FT :: FingerTree (Elem (a->b)) -> (a,a,a) -> FingerTree (Elem b)
-ap3FT fs (x,y,z) = Deep (size fs * 3)
+ap3FT :: (a -> b) -> FingerTree (Elem (a->b)) -> (a -> b) -> (a,a,a) -> FingerTree (Elem b)
+ap3FT firstf fs lastf (x,y,z) = Deep (size fs * 3 + 6)
                         (Three (Elem $ firstf x) (Elem $ firstf y) (Elem $ firstf z))
-                        (mapMulFT 3 (\(Elem f) -> Node3 3 (Elem (f x)) (Elem (f y)) (Elem (f z))) m)
+                        (mapMulFT 3 (\(Elem f) -> Node3 3 (Elem (f x)) (Elem (f y)) (Elem (f z))) fs)
                         (Three (Elem $ lastf x) (Elem $ lastf y) (Elem $ lastf z))
-  where
-    (Elem firstf, m, Elem lastf) = trimTree fs
 
--- <*> when the length of each argument is at least four.
-apty :: Seq (a -> b) -> Seq a -> Seq b
-apty (Seq fs) (Seq xs@Deep{}) = Seq $
-    Deep (s' * size fs)
-         (fmap (fmap firstf) pr')
-         (aptyMiddle (fmap firstf) (fmap lastf) fmap fs' xs')
-         (fmap (fmap lastf) sf')
-  where
-    (Elem firstf, fs', Elem lastf) = trimTree fs
-    xs'@(Deep s' pr' _m' sf') = rigidify xs
-apty _ _ = error "apty: expects a Deep constructor"
 
--- | 'aptyMiddle' does most of the hard work of computing @fs<*>xs@.
--- It produces the center part of a finger tree, with a prefix corresponding
--- to the prefix of @xs@ and a suffix corresponding to the suffix of @xs@
--- omitted; the missing suffix and prefix are added by the caller.
--- For the recursive call, it squashes the prefix and the suffix into
--- the center tree. Once it gets to the bottom, it turns the tree into
--- a 2-3 tree, applies 'mapMulFT' to produce the main body, and glues all
--- the pieces together.
+data Rigidified a = RigidEmpty
+                  | RigidOne a
+                  | RigidTwo a a
+                  | RigidThree a a a
+                  | RigidFull (Rigid a)
+#ifdef TESTING
+                  deriving Show
+#endif
+
+-- | A finger tree whose top level has only Two and/or Three digits, and whose
+-- other levels have only One and Two digits. A Rigid tree is precisely what one
+-- gets by unzipping/inverting a 2-3 tree, so it is precisely what we need to
+-- turn a finger tree into in order to transform it into a 2-3 tree.
+data Rigid a = Rigid {-# UNPACK #-} !Int !(Digit23 a) (Thin (Node a)) !(Digit23 a)
+#ifdef TESTING
+             deriving Show
+#endif
+
+-- | A finger tree whose digits are all ones and twos
+data Thin a = EmptyTh
+            | SingleTh a
+            | DeepTh {-# UNPACK #-} !Int !(Digit12 a) (Thin (Node a)) !(Digit12 a)
+#ifdef TESTING
+            deriving Show
+#endif
+
+data Digit12 a = One12 a | Two12 a a
+#ifdef TESTING
+        deriving Show
+#endif
+
+-- | Sometimes, we want to emphasize that we are viewing a node as a top-level
+-- digit of a 'Rigid' tree.
+type Digit23 a = Node a
+
+-- | 'aptyMiddle' does most of the hard work of computing @fs<*>xs@.  It
+-- produces the center part of a finger tree, with a prefix corresponding to
+-- the prefix of @xs@ and a suffix corresponding to the suffix of @xs@ omitted;
+-- the missing suffix and prefix are added by the caller.  For the recursive
+-- call, it squashes the prefix and the suffix into the center tree. Once it
+-- gets to the bottom, it turns the tree into a 2-3 tree, applies 'mapMulFT' to
+-- produce the main body, and glues all the pieces together.
+--
+-- 'map23' itself is a bit horrifying because of the nested types involved. Its
+-- job is to map over the *elements* of a 2-3 tree, rather than the subtrees.
+-- If we used a higher-order nested type with MPTC, we could probably use a
+-- class, but as it is we have to build up 'map23' explicitly through the
+-- recursion.
 aptyMiddle
-  :: Sized c =>
-     (c -> d)
+  :: (c -> d)
      -> (c -> d)
      -> ((a -> b) -> c -> d)
      -> FingerTree (Elem (a -> b))
-     -> FingerTree c
+     -> Rigid c
      -> FingerTree (Node d)
+
 -- Not at the bottom yet
+
 aptyMiddle firstf
            lastf
            map23
            fs
-           (Deep s pr (Deep sm prm mm sfm) sf)
+           (Rigid s pr (DeepTh sm prm mm sfm) sf)
     = Deep (sm + s * (size fs + 1)) -- note: sm = s - size pr - size sf
-           (fmap (fmap firstf) prm)
+           (fmap (fmap firstf) (digit12ToDigit prm))
            (aptyMiddle (fmap firstf)
                        (fmap lastf)
-                       (\f -> fmap (map23 f))
+                       (fmap . map23)
                        fs
-                       (Deep s (squashL pr prm) mm (squashR sfm sf)))
-           (fmap (fmap lastf) sfm)
+                       (Rigid s (squashL pr prm) mm (squashR sfm sf)))
+           (fmap (fmap lastf) (digit12ToDigit sfm))
 
--- At the bottom. Note that these appendTree0 calls are very cheap, because in
--- each case, one of the arguments is guaranteed to be Empty or Single.
+-- At the bottom
+
 aptyMiddle firstf
            lastf
            map23
            fs
-           (Deep s pr m sf)
-      = fmap (fmap firstf) m `appendTree0`
-        ((fmap firstf (digitToNode sf)
-            `consTree` middle)
-            `snocTree` fmap lastf (digitToNode pr))
-        `appendTree0`  fmap (fmap lastf) m
-    where middle = case trimTree $ mapMulFT s (\(Elem f) -> fmap (fmap (map23 f)) converted) fs of
-                     (firstMapped, restMapped, lastMapped) ->
-                        Deep (size firstMapped + size restMapped + size lastMapped)
-                             (nodeToDigit firstMapped) restMapped (nodeToDigit lastMapped)
-          converted = case m of
-                                    Empty -> Node2 s lconv rconv
-                                    Single q -> Node3 s lconv q rconv
-                                    Deep{} -> error "aptyMiddle: impossible"
-          lconv = digitToNode pr
-          rconv = digitToNode sf
-
-aptyMiddle _ _ _ _ _ = error "aptyMiddle: expected Deep finger tree"
-
-{-# SPECIALIZE
- aptyMiddle
-  :: (Node c -> d)
-     -> (Node c -> d)
-     -> ((a -> b) -> Node c -> d)
-     -> FingerTree (Elem (a -> b))
-     -> FingerTree (Node c)
-     -> FingerTree (Node d)
- #-}
-{-# SPECIALIZE
- aptyMiddle
-  :: (Elem c -> d)
-     -> (Elem c -> d)
-     -> ((a -> b) -> Elem c -> d)
-     -> FingerTree (Elem (a -> b))
-     -> FingerTree (Elem c)
-     -> FingerTree (Node d)
- #-}
+           (Rigid s pr EmptyTh sf)
+     = deep
+            (One (fmap firstf sf))
+            (mapMulFT s (\(Elem f) -> fmap (fmap (map23 f)) converted) fs)
+            (One (fmap lastf pr))
+   where converted = node2 pr sf
 
-digitToNode :: Sized a => Digit a -> Node a
-digitToNode (Two a b) = node2 a b
-digitToNode (Three a b c) = node3 a b c
-digitToNode _ = error "digitToNode: not representable as a node"
+aptyMiddle firstf
+           lastf
+           map23
+           fs
+           (Rigid s pr (SingleTh q) sf)
+     = deep
+            (Two (fmap firstf q) (fmap firstf sf))
+            (mapMulFT s (\(Elem f) -> fmap (fmap (map23 f)) converted) fs)
+            (Two (fmap lastf pr) (fmap lastf q))
+   where converted = node3 pr q sf
 
-type Digit23 = Digit
-type Digit12 = Digit
+digit12ToDigit :: Digit12 a -> Digit a
+digit12ToDigit (One12 a) = One a
+digit12ToDigit (Two12 a b) = Two a b
 
 -- Squash the first argument down onto the left side of the second.
-squashL :: Sized a => Digit23 a -> Digit12 (Node a) -> Digit23 (Node a)
-squashL (Two a b) (One n) = Two (node2 a b) n
-squashL (Two a b) (Two n1 n2) = Three (node2 a b) n1 n2
-squashL (Three a b c) (One n) = Two (node3 a b c) n
-squashL (Three a b c) (Two n1 n2) = Three (node3 a b c) n1 n2
-squashL _ _ = error "squashL: wrong digit types"
+squashL :: Digit23 a -> Digit12 (Node a) -> Digit23 (Node a)
+squashL m (One12 n) = node2 m n
+squashL m (Two12 n1 n2) = node3 m n1 n2
 
 -- Squash the second argument down onto the right side of the first
-squashR :: Sized a => Digit12 (Node a) -> Digit23 a -> Digit23 (Node a)
-squashR (One n) (Two a b) = Two n (node2 a b)
-squashR (Two n1 n2) (Two a b) = Three n1 n2 (node2 a b)
-squashR (One n) (Three a b c) = Two n (node3 a b c)
-squashR (Two n1 n2) (Three a b c) = Three n1 n2 (node3 a b c)
-squashR _ _ = error "squashR: wrong digit types"
+squashR :: Digit12 (Node a) -> Digit23 a -> Digit23 (Node a)
+squashR (One12 n) m = node2 n m
+squashR (Two12 n1 n2) m = node3 n1 n2 m
 
+
 -- | /O(m*n)/ (incremental) Takes an /O(m)/ function and a finger tree of size
 -- /n/ and maps the function over the tree leaves. Unlike the usual 'fmap', the
 -- function is applied to the "leaves" of the 'FingerTree' (i.e., given a
@@ -434,73 +438,72 @@
 mapMulNode mul f (Node2 s a b)   = Node2 (mul * s) (f a) (f b)
 mapMulNode mul f (Node3 s a b c) = Node3 (mul * s) (f a) (f b) (f c)
 
-
-trimTree :: Sized a => FingerTree a -> (a, FingerTree a, a)
-trimTree Empty = error "trim: empty tree"
-trimTree Single{} = error "trim: singleton"
-trimTree t = case splitTree 0 t of
-                 Split _ hd r ->
-                   case splitTree (size r - 1) r of
-                     Split m tl _ -> (hd, m, tl)
-
 -- | /O(log n)/ (incremental) Takes the extra flexibility out of a 'FingerTree'
 -- to make it a genuine 2-3 finger tree. The result of 'rigidify' will have
--- only 'Two' and 'Three' digits at the top level and only 'One' and 'Two'
--- digits elsewhere.  It gives an error if the tree has fewer than four
--- elements.
-rigidify :: Sized a => FingerTree a -> FingerTree a
--- Note that 'rigidify' may call itself, but it will do so at most
--- once: each call to 'rigidify' will either fix the whole tree or fix one digit
--- and leave the other alone. The patterns below just fix up the top level of
--- the tree; 'rigidify' delegates the hard work to 'thin'.
+-- only two and three digits at the top level and only one and two
+-- digits elsewhere. If the tree has fewer than four elements, 'rigidify'
+-- will simply extract them, and will not build a tree.
+rigidify :: FingerTree (Elem a) -> Rigidified (Elem a)
+-- The patterns below just fix up the top level of the tree; 'rigidify'
+-- delegates the hard work to 'thin'.
 
--- The top of the tree is fine.
-rigidify (Deep s pr@Two{} m sf@Three{}) = Deep s pr (thin m) sf
-rigidify (Deep s pr@Three{} m sf@Three{}) = Deep s pr (thin m) sf
-rigidify (Deep s pr@Two{} m sf@Two{}) = Deep s pr (thin m) sf
-rigidify (Deep s pr@Three{} m sf@Two{}) = Deep s pr (thin m) sf
+rigidify Empty = RigidEmpty
 
--- One of the Digits is a Four.
-rigidify (Deep s (Four a b c d) m sf) =
-   rigidify $ Deep s (Two a b) (node2 c d `consTree` m) sf
-rigidify (Deep s pr m (Four a b c d)) =
-   rigidify $ Deep s pr (m `snocTree` node2 a b) (Two c d)
+rigidify (Single q) = RigidOne q
 
--- One of the Digits is a One. If the middle is empty, we can only rigidify the
--- tree if the other Digit is a Three.
-rigidify (Deep s (One a) Empty (Three b c d)) = Deep s (Two a b) Empty (Two c d)
-rigidify (Deep s (One a) m sf) = rigidify $ case viewLTree m of
-   Just2 (Node2 _ b c) m' -> Deep s (Three a b c) m' sf
-   Just2 (Node3 _ b c d) m' -> Deep s (Two a b) (node2 c d `consTree` m') sf
-   Nothing2 -> error "rigidify: small tree"
-rigidify (Deep s (Three a b c) Empty (One d)) = Deep s (Two a b) Empty (Two c d)
-rigidify (Deep s pr m (One e)) = rigidify $ case viewRTree m of
-   Just2 m' (Node2 _ a b) -> Deep s pr m' (Three a b e)
-   Just2 m' (Node3 _ a b c) -> Deep s pr (m' `snocTree` node2 a b) (Two c e)
-   Nothing2 -> error "rigidify: small tree"
-rigidify Empty = error "rigidify: empty tree"
-rigidify Single{} = error "rigidify: singleton"
+-- The left digit is Two or Three
+rigidify (Deep s (Two a b) m sf) = rigidifyRight s (node2 a b) m sf
+rigidify (Deep s (Three a b c) m sf) = rigidifyRight s (node3 a b c) m sf
 
+-- The left digit is Four
+rigidify (Deep s (Four a b c d) m sf) = rigidifyRight s (node2 a b) (node2 c d `consTree` m) sf
+
+-- The left digit is One
+rigidify (Deep s (One a) m sf) = case viewLTree m of
+   Just2 (Node2 _ b c) m' -> rigidifyRight s (node3 a b c) m' sf
+   Just2 (Node3 _ b c d) m' -> rigidifyRight s (node2 a b) (node2 c d `consTree` m') sf
+   Nothing2 -> case sf of
+     One b -> RigidTwo a b
+     Two b c -> RigidThree a b c
+     Three b c d -> RigidFull $ Rigid s (node2 a b) EmptyTh (node2 c d)
+     Four b c d e -> RigidFull $ Rigid s (node3 a b c) EmptyTh (node2 d e)
+
+-- | /O(log n)/ (incremental) Takes a tree whose left side has been rigidified
+-- and finishes the job.
+rigidifyRight :: Int -> Digit23 (Elem a) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> Rigidified (Elem a)
+
+-- The right digit is Two, Three, or Four
+rigidifyRight s pr m (Two a b) = RigidFull $ Rigid s pr (thin m) (node2 a b)
+rigidifyRight s pr m (Three a b c) = RigidFull $ Rigid s pr (thin m) (node3 a b c)
+rigidifyRight s pr m (Four a b c d) = RigidFull $ Rigid s pr (thin $ m `snocTree` node2 a b) (node2 c d)
+
+-- The right digit is One
+rigidifyRight s pr m (One e) = case viewRTree m of
+    Just2 m' (Node2 _ a b) -> RigidFull $ Rigid s pr (thin m') (node3 a b e)
+    Just2 m' (Node3 _ a b c) -> RigidFull $ Rigid s pr (thin $ m' `snocTree` node2 a b) (node2 c e)
+    Nothing2 -> case pr of
+      Node2 _ a b -> RigidThree a b e
+      Node3 _ a b c -> RigidFull $ Rigid s (node2 a b) EmptyTh (node2 c e)
+
 -- | /O(log n)/ (incremental) Rejigger a finger tree so the digits are all ones
 -- and twos.
-thin :: Sized a => FingerTree a -> FingerTree a
--- Note that 'thin12' will produce a 'Deep' constructor immediately before
+thin :: Sized a => FingerTree a -> Thin a
+-- Note that 'thin12' will produce a 'DeepTh' constructor immediately before
 -- recursively calling 'thin'.
-thin Empty = Empty
-thin (Single a) = Single a
-thin t@(Deep s pr m sf) =
+thin Empty = EmptyTh
+thin (Single a) = SingleTh a
+thin (Deep s pr m sf) =
   case pr of
-    One{} -> thin12 t
-    Two{} -> thin12 t
-    Three a b c  -> thin12 $ Deep s (One a) (node2 b c `consTree` m) sf
-    Four a b c d -> thin12 $ Deep s (Two a b) (node2 c d `consTree` m) sf
+    One a -> thin12 s (One12 a) m sf
+    Two a b -> thin12 s (Two12 a b) m sf
+    Three a b c  -> thin12 s (One12 a) (node2 b c `consTree` m) sf
+    Four a b c d -> thin12 s (Two12 a b) (node2 c d `consTree` m) sf
 
-thin12 :: Sized a => FingerTree a -> FingerTree a
-thin12 (Deep s pr m sf@One{}) = Deep s pr (thin m) sf
-thin12 (Deep s pr m sf@Two{}) = Deep s pr (thin m) sf
-thin12 (Deep s pr m (Three a b c)) = Deep s pr (thin $ m `snocTree` node2 a b) (One c)
-thin12 (Deep s pr m (Four a b c d)) = Deep s pr (thin $ m `snocTree` node2 a b) (Two c d)
-thin12 _ = error "thin12 expects a Deep FingerTree."
+thin12 :: Sized a => Int -> Digit12 a -> FingerTree (Node a) -> Digit a -> Thin a
+thin12 s pr m (One a) = DeepTh s pr (thin m) (One12 a)
+thin12 s pr m (Two a b) = DeepTh s pr (thin m) (Two12 a b)
+thin12 s pr m (Three a b c) = DeepTh s pr (thin $ m `snocTree` node2 a b) (One12 c)
+thin12 s pr m (Four a b c d) = DeepTh s pr (thin $ m `snocTree` node2 a b) (Two12 c d)
 
 
 instance MonadPlus Seq where
@@ -543,8 +546,15 @@
 
 instance Monoid (Seq a) where
     mempty = empty
+#if !(MIN_VERSION_base(4,9,0))
     mappend = (><)
+#else
+    mappend = (<>)
 
+instance Semigroup (Seq a) where
+    (<>)    = (><)
+#endif
+
 INSTANCE_TYPEABLE1(Seq,seqTc,"Seq")
 
 #if __GLASGOW_HASKELL__
@@ -841,12 +851,13 @@
 instance Monad (State s) where
     {-# INLINE return #-}
     {-# INLINE (>>=) #-}
-    return x = State $ \ s -> (s, x)
+    return = pure
     m >>= k = State $ \ s -> case runState m s of
         (s', x) -> runState (k x) s'
 
 instance Applicative (State s) where
-    pure = return
+    {-# INLINE pure #-}
+    pure x = State $ \ s -> (s, x)
     (<*>) = ap
 
 execState :: State s a -> s -> a
@@ -918,19 +929,67 @@
   | n >= 0      = unwrapMonad (replicateA n (WrapMonad x))
   | otherwise   = error "replicateM takes a nonnegative integer argument"
 
--- | @'replicateSeq' n xs@ concatenates @n@ copies of @xs@.
-replicateSeq :: Int -> Seq a -> Seq a
-replicateSeq n s
-  | n < 0     = error "replicateSeq takes a nonnegative integer argument"
+-- | @'cycleN' n xs@ concatenates @n@ copies of @xs@.
+cycleN :: Int -> Seq a -> Seq a
+cycleN n xs
+  | n < 0     = error "cycleN takes a nonnegative integer argument"
   | n == 0    = empty
-  | otherwise = go n s
-  where
-    -- Invariant: k >= 1
-    go 1 xs = xs
-    go k xs | even k    = kxs
-            | otherwise = xs >< kxs
-            where kxs = go (k `quot` 2) $! (xs >< xs)
+  | n == 1    = xs
+cycleN n (Seq xsFT) = case rigidify xsFT of
+             RigidEmpty -> empty
+             RigidOne (Elem x) -> replicate n x
+             RigidTwo x1 x2 -> Seq $
+               Deep (n*2) pair
+                    (runIdentity $ applicativeTree (n-2) 2 (Identity (node2 x1 x2)))
+                    pair
+               where pair = Two x1 x2
+             RigidThree x1 x2 x3 -> Seq $
+               Deep (n*3) triple
+                    (runIdentity $ applicativeTree (n-2) 3 (Identity (node3 x1 x2 x3)))
+                    triple
+               where triple = Three x1 x2 x3
+             RigidFull r@(Rigid s pr _m sf) -> Seq $
+                   Deep (n*s)
+                        (nodeToDigit pr)
+                        (cycleNMiddle (n-2) r)
+                        (nodeToDigit sf)
 
+cycleNMiddle
+  :: Int
+     -> Rigid c
+     -> FingerTree (Node c)
+
+STRICT_1_OF_2(cycleNMiddle)
+
+-- Not at the bottom yet
+
+cycleNMiddle n
+           (Rigid s pr (DeepTh sm prm mm sfm) sf)
+    = Deep (sm + s * (n + 1)) -- note: sm = s - size pr - size sf
+           (digit12ToDigit prm)
+           (cycleNMiddle n
+                       (Rigid s (squashL pr prm) mm (squashR sfm sf)))
+           (digit12ToDigit sfm)
+
+-- At the bottom
+
+cycleNMiddle n
+           (Rigid s pr EmptyTh sf)
+     = deep
+            (One sf)
+            (runIdentity $ applicativeTree n s (Identity converted))
+            (One pr)
+   where converted = node2 pr sf
+
+cycleNMiddle n
+           (Rigid s pr (SingleTh q) sf)
+     = deep
+            (Two q sf)
+            (runIdentity $ applicativeTree n s (Identity converted))
+            (Two pr q)
+   where converted = node3 pr q sf
+
+
 -- | /O(1)/. Add an element to the left end of a sequence.
 -- Mnemonic: a triangle with the single element at the pointy end.
 (<|)            :: a -> Seq a -> Seq a
@@ -975,9 +1034,7 @@
 
 -- The appendTree/addDigits gunk below is machine generated
 
-{-# SPECIALIZE appendTree0 :: FingerTree (Elem a) -> FingerTree (Elem a) -> FingerTree (Elem a) #-}
-{-# SPECIALIZE appendTree0 :: FingerTree (Node a) -> FingerTree (Node a) -> FingerTree (Node a) #-}
-appendTree0 :: Sized a => FingerTree a -> FingerTree a -> FingerTree a
+appendTree0 :: FingerTree (Elem a) -> FingerTree (Elem a) -> FingerTree (Elem a)
 appendTree0 Empty xs =
     xs
 appendTree0 xs Empty =
@@ -2061,6 +2118,11 @@
     toList = toList
 #endif
 
+#ifdef __GLASGOW_HASKELL__
+instance IsString (Seq Char) where
+    fromString = fromList
+#endif
+
 ------------------------------------------------------------------------
 -- Reverse
 ------------------------------------------------------------------------
@@ -2397,28 +2459,28 @@
   where
     {-# INLINE unrollPQ' #-}
     unrollPQ' (PQueue x ts) = x:mergePQs0 ts
-    (<>) = mergePQ cmp
+    (<+>) = mergePQ cmp
     mergePQs0 Nil = []
     mergePQs0 (t :& Nil) = unrollPQ' t
-    mergePQs0 (t1 :& t2 :& ts) = mergePQs (t1 <> t2) ts
+    mergePQs0 (t1 :& t2 :& ts) = mergePQs (t1 <+> t2) ts
     mergePQs t ts = t `seq` case ts of
         Nil             -> unrollPQ' t
-        t1 :& Nil       -> unrollPQ' (t <> t1)
-        t1 :& t2 :& ts' -> mergePQs (t <> (t1 <> t2)) ts'
+        t1 :& Nil       -> unrollPQ' (t <+> t1)
+        t1 :& t2 :& ts' -> mergePQs (t <+> (t1 <+> t2)) ts'
 
 -- | 'toPQ', given an ordering function and a mechanism for queueifying
 -- elements, converts a 'FingerTree' to a 'PQueue'.
 toPQ :: (e -> e -> Ordering) -> (a -> PQueue e) -> FingerTree a -> Maybe (PQueue e)
 toPQ _ _ Empty = Nothing
 toPQ _ f (Single x) = Just (f x)
-toPQ cmp f (Deep _ pr m sf) = Just (maybe (pr' <> sf') ((pr' <> sf') <>) (toPQ cmp fNode m))
+toPQ cmp f (Deep _ pr m sf) = Just (maybe (pr' <+> sf') ((pr' <+> sf') <+>) (toPQ cmp fNode m))
   where
     fDigit digit = case fmap f digit of
         One a           -> a
-        Two a b         -> a <> b
-        Three a b c     -> a <> b <> c
-        Four a b c d    -> (a <> b) <> (c <> d)
-    (<>) = mergePQ cmp
+        Two a b         -> a <+> b
+        Three a b c     -> a <+> b <+> c
+        Four a b c d    -> (a <+> b) <+> (c <+> d)
+    (<+>) = mergePQ cmp
     fNode = fDigit . nodeToDigit
     pr' = fDigit pr
     sf' = fDigit sf
diff --git a/Data/Set/Base.hs b/Data/Set/Base.hs
--- a/Data/Set/Base.hs
+++ b/Data/Set/Base.hs
@@ -199,6 +199,9 @@
 #if !MIN_VERSION_base(4,8,0)
 import Data.Monoid (Monoid(..))
 #endif
+#if MIN_VERSION_base(4,9,0)
+import Data.Semigroup (Semigroup((<>), stimes), stimesIdempotentMonoid)
+#endif
 import qualified Data.Foldable as Foldable
 import Data.Typeable
 import Control.DeepSeq (NFData(rnf))
@@ -245,9 +248,18 @@
 
 instance Ord a => Monoid (Set a) where
     mempty  = empty
-    mappend = union
     mconcat = unions
+#if !(MIN_VERSION_base(4,9,0))
+    mappend = union
+#else
+    mappend = (<>)
 
+instance Ord a => Semigroup (Set a) where
+    (<>)    = union
+    stimes  = stimesIdempotentMonoid
+#endif
+
+
 instance Foldable.Foldable Set where
     fold = go
       where go Tip = mempty
@@ -853,7 +865,7 @@
 
 -- | /O(n*log n)/. Create a set from a list of elements.
 --
--- If the elemens are ordered, linear-time implementation is used,
+-- If the elements are ordered, a linear-time implementation is used,
 -- with the performance equal to 'fromDistinctAscList'.
 
 -- For some reason, when 'singleton' is used in fromList or in
diff --git a/Data/Tree.hs b/Data/Tree.hs
--- a/Data/Tree.hs
+++ b/Data/Tree.hs
@@ -35,7 +35,6 @@
     ) where
 
 #if MIN_VERSION_base(4,8,0)
-import Control.Applicative ((<$>))
 import Data.Foldable (toList)
 #else
 import Control.Applicative (Applicative(..), (<$>))
@@ -92,7 +91,7 @@
         Node (f x) (map (f <$>) txs ++ map (<*> tx) tfs)
 
 instance Monad Tree where
-    return x = Node x []
+    return = pure
     Node x ts >>= f = Node x' (ts' ++ map (>>= f) ts)
       where Node x' ts' = f x
 
diff --git a/benchmarks/Sequence.hs b/benchmarks/Sequence.hs
--- a/benchmarks/Sequence.hs
+++ b/benchmarks/Sequence.hs
@@ -47,8 +47,13 @@
          , bench "nf10000" $ nf (\s -> S.fromFunction s (+1)) 10000
          ]
       , bgroup "<*>"
-         [ bench "ix1000/500000" $
+         [ bench "ix500/1000^2" $
               nf (\s -> ((+) <$> s <*> s) `S.index` (S.length s `div` 2)) (S.fromFunction 1000 (+1))
+         , bench "ix500000/1000^2" $
+              nf (\s -> ((+) <$> s <*> s) `S.index` (S.length s * S.length s `div` 2)) (S.fromFunction 1000 (+1))
+         , bench "ixBIG" $
+              nf (\s -> ((+) <$> s <*> s) `S.index` (S.length s * S.length s `div` 2))
+                 (S.fromFunction (floor (sqrt $ fromIntegral (maxBound::Int))-10) (+1))
          , bench "nf100/2500/rep" $
               nf (\(s,t) -> (,) <$> replicate s () <*> replicate t ()) (100,2500)
          , bench "nf100/2500/ff" $
diff --git a/benchmarks/bench-cmp.sh b/benchmarks/bench-cmp.sh
--- a/benchmarks/bench-cmp.sh
+++ b/benchmarks/bench-cmp.sh
@@ -1,3 +1,3 @@
 #!/bin/sh
 
-./bench-cmp.pl "$@" | column -nts\; | less -SR
+(echo 'Benchmark;Runtime change;Original runtime'; ./bench-cmp.pl "$@") | column -ts\;
diff --git a/containers.cabal b/containers.cabal
--- a/containers.cabal
+++ b/containers.cabal
@@ -1,5 +1,5 @@
 name: containers
-version: 0.5.6.3
+version: 0.5.7.0
 license: BSD3
 license-file: LICENSE
 maintainer: fox@ucw.cz
@@ -238,6 +238,24 @@
 test-suite intmap-strictness-properties
   hs-source-dirs: tests, .
   main-is: intmap-strictness.hs
+  type: exitcode-stdio-1.0
+
+  build-depends:
+    array,
+    base >= 4.2 && < 5,
+    ChasingBottoms,
+    deepseq >= 1.2 && < 1.5,
+    QuickCheck >= 2.4.0.1,
+    ghc-prim,
+    test-framework >= 0.3.3,
+    test-framework-quickcheck2 >= 0.2.9
+
+  ghc-options: -Wall
+  include-dirs: include
+
+test-suite intset-strictness-properties
+  hs-source-dirs: tests, .
+  main-is: intset-strictness.hs
   type: exitcode-stdio-1.0
 
   build-depends:
diff --git a/include/containers.h b/include/containers.h
--- a/include/containers.h
+++ b/include/containers.h
@@ -51,11 +51,30 @@
 /*
  * We use cabal-generated MIN_VERSION_base to adapt to changes of base.
  * Nevertheless, as a convenience, we also allow compiling without cabal by
- * defining trivial MIN_VERSION_base if needed.
+ * defining an approximate MIN_VERSION_base if needed. The alternative version
+ * guesses the version of base using the version of GHC. This is usually
+ * sufficiently accurate. However, it completely ignores minor version numbers,
+ * and it makes the assumption that a pre-release version of GHC will ship with
+ * base libraries with the same version numbers as the final release. This
+ * assumption is violated in certain stages of GHC development, but in practice
+ * this should very rarely matter, and will not affect any released version.
  */
 #ifndef MIN_VERSION_base
-#define MIN_VERSION_base(major1,major2,minor) 0
+#if __GLASGOW_HASKELL__ >= 709
+#define MIN_VERSION_base(major1,major2,minor) (((major1)<4)||(((major1) == 4)&&((major2)<=8)))
+#elif __GLASGOW_HASKELL__ >= 707
+#define MIN_VERSION_base(major1,major2,minor) (((major1)<4)||(((major1) == 4)&&((major2)<=7)))
+#elif __GLASGOW_HASKELL__ >= 705
+#define MIN_VERSION_base(major1,major2,minor) (((major1)<4)||(((major1) == 4)&&((major2)<=6)))
+#elif __GLASGOW_HASKELL__ >= 703
+#define MIN_VERSION_base(major1,major2,minor) (((major1)<4)||(((major1) == 4)&&((major2)<=5)))
+#elif __GLASGOW_HASKELL__ >= 701
+#define MIN_VERSION_base(major1,major2,minor) (((major1)<4)||(((major1) == 4)&&((major2)<=4)))
+#elif __GLASGOW_HASKELL__ >= 700
+#define MIN_VERSION_base(major1,major2,minor) (((major1)<4)||(((major1) == 4)&&((major2)<=3)))
+#else
+#define MIN_VERSION_base(major1,major2,minor) (0)
 #endif
-
+#endif
 
 #endif
diff --git a/tests/intset-strictness.hs b/tests/intset-strictness.hs
new file mode 100644
--- /dev/null
+++ b/tests/intset-strictness.hs
@@ -0,0 +1,46 @@
+{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module Main (main) where
+
+import Prelude hiding (foldl)
+
+import Test.ChasingBottoms.IsBottom
+import Test.Framework (Test, defaultMain, testGroup)
+import Test.Framework.Providers.QuickCheck2 (testProperty)
+
+import Data.IntSet
+
+------------------------------------------------------------------------
+-- * Properties
+
+------------------------------------------------------------------------
+-- ** Lazy module
+
+pFoldlAccLazy :: Int -> Bool
+pFoldlAccLazy k =
+  isn'tBottom $ foldl (\_ x -> x) (bottom :: Int) (singleton k)
+
+------------------------------------------------------------------------
+-- * Test list
+
+tests :: [Test]
+tests =
+    [
+    -- Basic interface
+      testGroup "IntSet"
+      [ testProperty "foldl is lazy in accumulator" pFoldlAccLazy
+      ]
+    ]
+
+------------------------------------------------------------------------
+-- * Test harness
+
+main :: IO ()
+main = defaultMain tests
+
+------------------------------------------------------------------------
+-- * Utilities
+
+isn'tBottom :: a -> Bool
+isn'tBottom = not . isBottom