diff --git a/graphted.cabal b/graphted.cabal
--- a/graphted.cabal
+++ b/graphted.cabal
@@ -1,5 +1,5 @@
 name:                graphted
-version:             0.3.0.0
+version:             0.3.1.0
 synopsis:    Graph indexed monads.
 -- description: TODO
 homepage:            https://github.com/aaronfriel/graphted#readme
diff --git a/src/Control/Applicative/Graph.hs b/src/Control/Applicative/Graph.hs
--- a/src/Control/Applicative/Graph.hs
+++ b/src/Control/Applicative/Graph.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP                   #-}
 {- |
 Module      :  Control.Applicative.Graph
 Description :  Graph indexed applicative functors
@@ -10,16 +11,20 @@
 
 -}
 
+{-# LANGUAGE DataKinds             #-}
 {-# LANGUAGE DefaultSignatures     #-}
 {-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE PolyKinds             #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
 {-# LANGUAGE TypeFamilies          #-}
-{-# LANGUAGE RankNTypes          #-}
-{-# LANGUAGE ImpredicativeTypes          #-}
-{-# LANGUAGE AllowAmbiguousTypes          #-}
+#if MIN_VERSION_GLASGOW_HASKELL(8,0,1,0)
+{-# LANGUAGE AllowAmbiguousTypes   #-}
+{-# LANGUAGE TypeApplications      #-}
+#endif
 
--- For the default Apply, Then, and But instances.
+-- For the default type instances.
 {-# LANGUAGE UndecidableInstances  #-}
 
 module Control.Applicative.Graph where
@@ -29,12 +34,40 @@
 import Data.Functor.Graph
 import Data.Pointed.Graph
 
+#if !MIN_VERSION_GLASGOW_HASKELL(8,0,1,0)
+import Data.Proxy
+#endif
+
+type family DefaultThen (useReplace :: Bool) (f :: p -> * -> *) (i :: p) (j :: p) where
+    DefaultThen 'True  f i j = Apply f (Replace f i) j
+    DefaultThen 'False f i j = LiftA2 f i j
+
+type family DefaultThenCxt (useReplace :: Bool) (f :: p -> * -> *) (i :: p) (j :: p) where
+    DefaultThenCxt 'True  f i j = (Apply f (Replace f i) j ~ Then f i j, ApplyInv f (Replace f i) j)
+    DefaultThenCxt 'False f i j = (LiftA2 f i j ~ Then f i j,            LiftA2Inv f i j)
+
+class GApplicativeThen useReplace (f :: p -> * -> *) where
+    gdefaultThenProxy :: DefaultThenCxt useReplace f i j => proxy useReplace -> f i a -> f j b -> f (Then f i j) b
+    gdefaultThen :: DefaultThenCxt useReplace f i j => f i a -> f j b -> f (Then f i j) b
+
+instance GApplicative f => GApplicativeThen 'True f where
+    {-# INLINE gdefaultThenProxy #-}
+    gdefaultThenProxy _ a b = (id `greplace` a) `gap` b
+    {-# INLINE gdefaultThen #-}
+    gdefaultThen a b = (id `greplace` a) `gap` b
+
+instance GApplicative f => GApplicativeThen 'False f where
+    {-# INLINE gdefaultThenProxy #-}
+    gdefaultThenProxy _ a b = gliftA2 (flip const) a b
+    {-# INLINE gdefaultThen #-}
+    gdefaultThen a b = gliftA2 (flip const) a b
+
 -- | Graph indexed applicative functor.
 class (GFunctor f, GPointed f) => GApplicative (f :: p -> * -> *) where
 
     -- | The apply operation ('<*>') on the graph index.
     --
-    -- Default instance: @Apply f i j = 'Combine' f i j@ 
+    -- Default instance: @Apply f i j = 'Combine' f i j@
     type family Apply f (i :: p) (j :: p) :: p
     type instance Apply f i j = Combine f i j
 
@@ -46,7 +79,7 @@
 
     -- | The 'liftA2' operation on the graph index.
     --
-    -- Default instance: @Lift f i j = 'Apply' f ('Apply' f ('Pure' f) i) j@ 
+    -- Default instance: @Lift f i j = 'Apply' f ('Apply' f ('Pure' f) i) j@
     type family LiftA2 f (i :: p) (j :: p) :: p
     type instance LiftA2 f i j = Apply f (Fmap f i) j
 
@@ -56,11 +89,22 @@
     type family LiftA2Inv f (i :: p) (j :: p) :: Constraint
     type instance LiftA2Inv f i j = ApplyInv f i j
 
+    -- | Whether to use 'gliftA2', or 'gap' and 'greplace' in the definition
+    -- of 'gthen'.
+    --
+    -- If an efficient 'Replace' exists, we should probably use that to reduce
+    -- allocations. But liftA2 might also be appropriate.
+    type family ThenUseReplace f :: Bool
+    type instance ThenUseReplace f = EfficientReplace f
+
     -- | The then operation ('*>') on the graph index.
     --
-    -- Default instance: @'Then' f i j = 'Apply' f ('Replace' f i) j@ 
+    -- Default instance depends on @'ThenUseReplace' f@:
+    --
+    -- * 'True': @'Then' f i j = 'Apply' f ('Replace' f i) j@
+    -- * 'False': @'Then' f i j = 'LiftA2' f i j@
     type family Then f (i :: p) (j :: p) :: p
-    type instance Then f i j = Apply f (Replace f i) j
+    type instance Then f i j = DefaultThen (ThenUseReplace f) f i j
 
     -- | An invariant on the indexes of 'Then'.
     --
@@ -70,7 +114,7 @@
 
     -- | The but operation ('<*') on the graph index.
     --
-    -- Default instance: @But f i j = 'LiftA2' f i j@ 
+    -- Default instance: @But f i j = 'LiftA2' f i j@
     type family But f (i :: p) (j :: p) :: p
     type instance But f i j = LiftA2 f i j
 
@@ -85,7 +129,8 @@
 
     -- | Lift a binary function to actions.
     --
-    gliftA2 :: LiftA2Inv f i j => (a -> b -> c) -> f i a -> f j b -> f (LiftA2 f i j) c 
+    -- Default implementation is defined in terms of 'Apply' and 'Fmap'.
+    gliftA2 :: LiftA2Inv f i j => (a -> b -> c) -> f i a -> f j b -> f (LiftA2 f i j) c
     default gliftA2 :: (Apply f (Fmap f i) j ~ LiftA2 f i j, ApplyInv f (Fmap f i) j)
                     => (a -> b -> c) -> f i a -> f j b -> f (LiftA2 f i j) c
     gliftA2 f x = gap (gmap f x)
@@ -95,9 +140,13 @@
     -- Default implementation requires the default instance of 'Then'.
     {-# INLINE gthen #-}
     gthen :: ThenInv f i j => f i a -> f j b -> f (Then f i j) b
-    default gthen :: (Apply f (Replace f i) j ~ Then f i j, ApplyInv f (Replace f i) j, ThenInv f (Replace f i) j)
-                  => f i a -> f j b -> f (Then f i j) b
-    gthen a b = (id `greplace` a) `gap` b
+    default gthen :: (GApplicativeThen (ThenUseReplace f) f, DefaultThenCxt (ThenUseReplace f) f i j)
+                   => f i a -> f j b -> f (Then f i j) b
+#if MIN_VERSION_GLASGOW_HASKELL(8,0,1,0)
+    gthen a b = gdefaultThen @(ThenUseReplace f) a b
+#else
+    gthen a b = gdefaultThenProxy (Proxy :: Proxy (ThenUseReplace f)) a b
+#endif
 
     -- | Sequence actions, discarding values of the second argument ('<*').
     --
diff --git a/src/Data/Functor/Graph.hs b/src/Data/Functor/Graph.hs
--- a/src/Data/Functor/Graph.hs
+++ b/src/Data/Functor/Graph.hs
@@ -11,6 +11,7 @@
 <module description starting at first column>
 -}
 
+{-# LANGUAGE DataKinds            #-}
 {-# LANGUAGE DefaultSignatures    #-}
 {-# LANGUAGE PolyKinds            #-}
 {-# LANGUAGE TypeFamilies         #-}
@@ -29,10 +30,13 @@
 
     -- | The Replace operation ('<$') on the graph index.
     --
-    -- Default instance: @Replace f i = 'Fmap' f i@ 
+    -- Default instance: @Replace f i = 'Fmap' f i@
     type family Replace f (i :: p) :: p
     type instance Replace f i = Fmap f i
 
+    type family EfficientReplace f :: Bool
+    type instance EfficientReplace f = 'False
+
     -- | Map a function over over the functor ('fmap').
     gmap :: (a -> b) -> f i a -> f (Fmap f i) b
 
@@ -43,3 +47,7 @@
     greplace :: a -> f i b -> f (Replace f i) a
     default greplace :: (Replace f i ~ Fmap f i) => a -> f i b -> f (Replace f i) a
     greplace = gmap . const
+
+-- | This should only be implemented when the replace operation has a more efficient
+-- @'greplace'@ than @'gmap' . const@.
+class GFunctorReplace (f :: p -> * -> *)
diff --git a/src/Prelude/Graphted.hs b/src/Prelude/Graphted.hs
--- a/src/Prelude/Graphted.hs
+++ b/src/Prelude/Graphted.hs
@@ -114,12 +114,12 @@
 liftA f a = pure f <*> a
 
 liftA2 :: (GApplicative f, _) => (a1 -> a2 -> b) -> f i1 a1 -> f i2 a2
-       -> f (Apply f (Apply f (Pure f) i1) i2) b
-liftA2 f a b = pure f <*> a <*> b
+       -> f (LiftA2 f i1 i2) b
+liftA2 f a b = gliftA2 f a b
 
 liftA3 :: (GApplicative f, _) => (a1 -> a2 -> a3 -> b) -> f i1 a1 -> f i2 a2 -> f i3 a3
-       -> f (Apply f (Apply f (Apply f (Pure f) i1) i2) i3) b
-liftA3 f a b c = pure f <*> a <*> b <*> c
+       -> f (Apply f (LiftA2 f i1 i2) i3) b
+liftA3 f a b c = gliftA2 f a b <*> c
 
 liftM :: (GApplicative m, _) => (t -> b) -> m j t -> m (Fmap m j) b
 liftM f m1              = do { x1 <- m1; return (f x1) }