diff --git a/Data/Generics/Str.hs b/Data/Generics/Str.hs
--- a/Data/Generics/Str.hs
+++ b/Data/Generics/Str.hs
@@ -25,21 +25,21 @@
     _ == _ = False
 
 instance Functor Str where
-  fmap f Zero = Zero
-  fmap f (One x) = One (f x)
-  fmap f (Two x y) = Two (fmap f x) (fmap f y)
+    fmap f Zero = Zero
+    fmap f (One x) = One (f x)
+    fmap f (Two x y) = Two (fmap f x) (fmap f y)
 
 
 instance Foldable Str where
-  foldMap m Zero = mempty
-  foldMap m (One x) = m x
-  foldMap m (Two l r) = foldMap m l `mappend` foldMap m r
+    foldMap m Zero = mempty
+    foldMap m (One x) = m x
+    foldMap m (Two l r) = foldMap m l `mappend` foldMap m r
 
 
 instance Traversable Str where
-  traverse f Zero = pure Zero
-  traverse f (One x) = One <$> f x
-  traverse f (Two x y) = Two <$> traverse f x <*> traverse f y
+    traverse f Zero = pure Zero
+    traverse f (One x) = One <$> f x
+    traverse f (Two x y) = Two <$> traverse f x <*> traverse f y
 
 
 -- | Take the type of the method, will crash if called
diff --git a/Data/Generics/Uniplate/Direct.hs b/Data/Generics/Uniplate/Direct.hs
--- a/Data/Generics/Uniplate/Direct.hs
+++ b/Data/Generics/Uniplate/Direct.hs
@@ -66,27 +66,44 @@
 -- The following rule can be used for optimisation:
 --
 -- > plate Ctor |- x == plate (Ctor x)
-{-# INLINE plate #-}
+{-# INLINE[1] plate #-}
 plate :: from -> Type from to
 plate f = (Zero, \_ -> f)
 
 
+{-# RULES
+"plate/-"    forall f x. plate f |- x = plate (f x)
+"plate/+"    forall f x. plate f |+ x = platePlus f x
+"plate/*"    forall f x. plate f |* x = plateStar f x
+  #-}
+
+
+{-# INLINE plateStar #-}
+plateStar :: (to -> from) -> to -> Type from to
+plateStar f x = (One x, \(One x) -> f x)
+
+{-# INLINE platePlus #-}
+platePlus :: Biplate item to => (item -> from) -> item -> Type from to
+platePlus f x = case biplate x of
+                        (ys,y_) -> (ys, \ys -> f $ y_ ys)
+
+
 -- | The field to the right is the target.
-{-# INLINE (|*) #-}
+{-# INLINE[1] (|*) #-}
 (|*) :: Type (to -> from) to -> to -> Type from to
 (|*) (xs,x_) y = (Two xs (One y),\(Two xs (One y)) -> x_ xs y)
 
 
 
 -- | The field to the right may contain the target.
-{-# INLINE (|+) #-}
+{-# INLINE[1] (|+) #-}
 (|+) :: Biplate item to => Type (item -> from) to -> item -> Type from to
 (|+) (xs,x_) y = case biplate y of
                       (ys,y_) -> (Two xs ys, \(Two xs ys) -> x_ xs (y_ ys))
 
 
 -- | The field to the right /does not/ contain the target.
-{-# INLINE (|-) #-}
+{-# INLINE[1] (|-) #-}
 (|-) :: Type (item -> from) to -> item -> Type from to
 (|-) (xs,x_) y = (xs,\xs -> x_ xs y)
 
diff --git a/Data/Generics/Uniplate/Internal/Data.hs b/Data/Generics/Uniplate/Internal/Data.hs
--- a/Data/Generics/Uniplate/Internal/Data.hs
+++ b/Data/Generics/Uniplate/Internal/Data.hs
@@ -322,6 +322,15 @@
     Follow -> gmapT (descendBiData oracle op) x
     Miss -> x
 
+descendDataM :: (Data on, Monad m) => (forall a . Typeable a => a -> Answer on) -> (on -> m on) -> on -> m on
+descendDataM oracle op = gmapM (descendBiDataM oracle op)
+
+descendBiDataM :: (Data on, Data with, Monad m) => (forall a . Typeable a => a -> Answer with) -> (with -> m with) -> on -> m on
+descendBiDataM oracle op x = case oracle x of
+    Hit y -> unsafeCoerce $ op y
+    Follow -> gmapM (descendBiDataM oracle op) x
+    Miss -> return x
+
 
 ---------------------------------------------------------------------
 -- FUSION
diff --git a/Data/Generics/Uniplate/Internal/DataInc.hs b/Data/Generics/Uniplate/Internal/DataInc.hs
--- a/Data/Generics/Uniplate/Internal/DataInc.hs
+++ b/Data/Generics/Uniplate/Internal/DataInc.hs
@@ -8,6 +8,9 @@
     descend = descendData $ fromOracle answer
         where answer = hitTest (undefined :: a) (undefined :: a)
 
+    descendM = descendDataM $ fromOracle answer
+        where answer = hitTest (undefined :: a) (undefined :: a)
+
 instance (Data a, Data b, Uniplate b) => Biplate a b where
     biplate = biplateData $ fromOracle answer
         where answer = hitTest (undefined :: a) (undefined :: b)
@@ -15,3 +18,5 @@
     descendBi = descendBiData $ fromOracle answer
         where answer = hitTest (undefined :: a) (undefined :: b)
 
+    descendBiM = descendBiDataM $ fromOracle answer
+        where answer = hitTest (undefined :: a) (undefined :: b)
diff --git a/Data/Generics/Uniplate/Internal/DataOnlyOperations.hs b/Data/Generics/Uniplate/Internal/DataOnlyOperations.hs
--- a/Data/Generics/Uniplate/Internal/DataOnlyOperations.hs
+++ b/Data/Generics/Uniplate/Internal/DataOnlyOperations.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP, MultiParamTypeClasses #-}
+{-# LANGUAGE CPP, MultiParamTypeClasses, BangPatterns #-}
 
 module Data.Generics.Uniplate.Internal.DataOnlyOperations where
 
diff --git a/Data/Generics/Uniplate/Internal/OperationsInc.hs b/Data/Generics/Uniplate/Internal/OperationsInc.hs
--- a/Data/Generics/Uniplate/Internal/OperationsInc.hs
+++ b/Data/Generics/Uniplate/Internal/OperationsInc.hs
@@ -1,4 +1,4 @@
-import Control.Monad(liftM)
+import Control.Monad(liftM,liftM2)
 import Data.Traversable
 import Prelude hiding (mapM)
 import Data.Generics.Str
@@ -39,16 +39,27 @@
     -- > descend f (Val i  ) = Val i
     -- > descend f (Neg a  ) = Neg (f a)
     -- > descend f (Add a b) = Add (f a) (f b)
+    {-# INLINE descend #-}
     descend :: (on -> on) -> on -> on
-    descend f x = generate $ fmap f current
-        where (current, generate) = uniplate x
+    descend f x = case uniplate x of
+        (current, generate) -> generate $ g current
+        where
+            g Zero = Zero
+            g (One x) = One $ f x
+            g (Two x y) = Two (g x) (g y)
 
-    -- | Monadic variant of 'descend'    
+    -- | Monadic variant of 'descend'
+    {-# INLINE descendM #-}
     descendM :: Monad m => (on -> m on) -> on -> m on
-    descendM f x = liftM generate $ mapM f current
-        where (current, generate) = uniplate x
+    descendM f x = case uniplate x of
+        (current, generate) -> liftM generate $ g SPEC current
+        where
+            g !spec Zero = return Zero
+            g !spec (One x) = liftM One $ f x
+            g !spec (Two x y) = liftM2 Two (g spec x) (g spec y)
 
 
+
 -- | Children are defined as the top-most items of type to
 --   /starting at the root/. All instances must define 'biplate', while
 --   'descendBi' and 'descendBiM' are optional.
@@ -65,14 +76,23 @@
     --   highly unlikely that this function should be used in the recursive case.
     --   A common pattern is to first match the types using 'descendBi', then continue
     --   the recursion with 'descend'.
+    {-# INLINE descendBi #-}
     descendBi :: (to -> to) -> from -> from
-    descendBi f x = generate $ fmap f current
-        where (current, generate) = biplate x
+    descendBi f x = case biplate x of
+        (current, generate) -> generate $ g current
+        where
+            g Zero = Zero
+            g (One x) = One $ f x
+            g (Two x y) = Two (g x) (g y)
 
 
     descendBiM :: Monad m => (to -> m to) -> from -> m from
-    descendBiM f x = liftM generate $ mapM f current
-        where (current, generate) = biplate x
+    descendBiM f x = case biplate x of
+        (current, generate) -> liftM generate $ g SPEC current
+        where
+            g !spec Zero = return Zero
+            g !spec (One x) = liftM One $ f x
+            g !spec (Two x y) = liftM2 Two (g spec x) (g spec y)
 
 
 -- * Single Type Operations
@@ -195,6 +215,7 @@
 
 -- | Return the children of a type. If @to == from@ then it returns the
 -- original element (in contrast to 'children')
+-- FIXME: Was confusing to Roman
 childrenBi :: Biplate from to => from -> [to]
 childrenBi x = builder f
     where
diff --git a/Data/Generics/Uniplate/Internal/Utils.hs b/Data/Generics/Uniplate/Internal/Utils.hs
--- a/Data/Generics/Uniplate/Internal/Utils.hs
+++ b/Data/Generics/Uniplate/Internal/Utils.hs
@@ -1,11 +1,9 @@
 {-# LANGUAGE CPP, Rank2Types, MagicHash, UnboxedTuples, ExistentialQuantification #-}
-
-{- |
-    Internal module, do not import or use.
--}
+{-# OPTIONS_GHC -fno-warn-unused-binds #-} -- SPEC2
 
+-- | Internal module, do not import or use.
 module Data.Generics.Uniplate.Internal.Utils(
-    unsafeCoerce, builder, unsafePerformIO, inlinePerformIO, concatCont
+    unsafeCoerce, builder, unsafePerformIO, inlinePerformIO, concatCont, SPEC(SPEC)
     ) where
 
 #if __GLASGOW_HASKELL__ >= 702
@@ -24,7 +22,12 @@
 #endif
 #endif
 
+#if __GLASGOW_HASKELL__ >= 701
+import GHC.Exts(SpecConstrAnnotation(..))
+{-# ANN type SPEC ForceSpecConstr #-}
+#endif
 
+
 {-# INLINE builder #-}
 -- | GHCs @foldr@\/@build@ system, but on all platforms
 #ifdef __GLASGOW_HASKELL__
@@ -50,3 +53,7 @@
 -- | Perform concatentation of continuations
 concatCont :: [a -> a] -> a -> a
 concatCont xs rest = foldr ($) rest xs
+
+
+-- | Constructor specialisation on newer GHC
+data SPEC = SPEC | SPEC2
diff --git a/Data/Generics/Uniplate/Operations.hs b/Data/Generics/Uniplate/Operations.hs
--- a/Data/Generics/Uniplate/Operations.hs
+++ b/Data/Generics/Uniplate/Operations.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP, MultiParamTypeClasses #-}
+{-# LANGUAGE CPP, MultiParamTypeClasses, BangPatterns #-}
 {- |
 Definitions of 'Uniplate' and 'Biplate' classes, along with all the standard operations.
 
diff --git a/uniplate.cabal b/uniplate.cabal
--- a/uniplate.cabal
+++ b/uniplate.cabal
@@ -1,7 +1,7 @@
 cabal-version:      >= 1.6
 build-type:         Simple
 name:               uniplate
-version:            1.6.7
+version:            1.6.8
 author:             Neil Mitchell <ndmitchell@gmail.com>
 maintainer:         Neil Mitchell <ndmitchell@gmail.com>
 copyright:          Neil Mitchell 2006-2012
@@ -57,7 +57,7 @@
         build-depends:
             base >=4.4 && <5, containers, syb,
             hashable >= 1.1.2.3 && < 1.2,
-            unordered-containers >= 0.1 && < 0.3
+            unordered-containers >= 0.2.1 && < 0.3
     else
         if flag(separate_syb)
             build-depends: base >=4 && <4.4, containers, syb