diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,9 +1,13 @@
+0.2.8
+-----------------------------------------------------
+* Improved performance considerably
+
 0.2.7
 -----------------------------------------------------
 * Added `accessing`
 * Added `decFields` and `decFieldsDeriving`
 * Renamed `Position` to `Membership`
-*
+
 0.2.6
 -----------------------------------------------------
 * Right-associated `(++)`
diff --git a/benchmarks/AtoZ.hs b/benchmarks/AtoZ.hs
new file mode 100644
--- /dev/null
+++ b/benchmarks/AtoZ.hs
@@ -0,0 +1,71 @@
+{-# LANGUAGE DataKinds, TypeOperators, GADTs, BangPatterns #-}
+module AtoZ where
+import Data.Extensible
+import Data.Coerce
+data A = A Int deriving Show
+data B = B Int deriving Show
+data C = C Int deriving Show
+data D = D Int deriving Show
+data E = E Int deriving Show
+data F = F Int deriving Show
+data G = G Int deriving Show
+data H = H Int deriving Show
+data I = I Int deriving Show
+data J = J Int deriving Show
+data K = K Int deriving Show
+data L = L Int deriving Show
+data M = M Int deriving Show
+data N = N Int deriving Show
+data O = O Int deriving Show
+data P = P Int deriving Show
+data Q = Q Int deriving Show
+data R = R Int deriving Show
+data S = S Int deriving Show
+data T = T Int deriving Show
+data U = U Int deriving Show
+data V = V Int deriving Show
+data W = W Int deriving Show
+data X = X Int deriving Show
+data Y = Y Int deriving Show
+data Z = Z Int deriving Show
+
+type AtoZ = [A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, P, Q, R, S, T, U, V, W, X, Y, Z]
+
+blah26 :: K0 :* AtoZ
+blah26 = A 0 <% B 1 <% C 2 <% D 3 <% E 4 <% F 5 <% G 6
+    <% H 7 <% I 8 <% J 9 <% K 10 <% L 11 <% M 12 <% N 13
+    <% O 14 <% P 15 <% Q 16 <% R 17 <% S 18 <% T 19 <% U 20
+    <% V 21 <% W 22 <% X 23 <% Y 24 <% Z 25 <% Nil
+
+tuple26 :: (A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, P, Q, R, S, T, U, V, W, X, Y, Z)
+tuple26 = (A 0, B 1, C 2, D 3, E 4, F 5, G 6, H 7, I 8, J 9, K 10, L 11, M 12
+  , N 13, O 14, P 15, Q 16, R 17, S 18, T 19, U 20, V 21, W 22, X 23, Y 24, Z 25)
+
+match26 :: Match K0 Int :* AtoZ
+match26 = (\(A n) -> n)
+  <?% (\(B n) -> n)
+  <?% (\(C n) -> n)
+  <?% (\(D n) -> n)
+  <?% (\(E n) -> n)
+  <?% (\(F n) -> n)
+  <?% (\(G n) -> n)
+  <?% (\(H n) -> n)
+  <?% (\(I n) -> n)
+  <?% (\(J n) -> n)
+  <?% (\(K n) -> n)
+  <?% (\(L n) -> n)
+  <?% (\(M n) -> n)
+  <?% (\(N n) -> n)
+  <?% (\(O n) -> n)
+  <?% (\(P n) -> n)
+  <?% (\(Q n) -> n)
+  <?% (\(R n) -> n)
+  <?% (\(S n) -> n)
+  <?% (\(T n) -> n)
+  <?% (\(U n) -> n)
+  <?% (\(V n) -> n)
+  <?% (\(W n) -> n)
+  <?% (\(X n) -> n)
+  <?% (\(Y n) -> n)
+  <?% (\(Z n) -> n)
+  <?% Nil
diff --git a/benchmarks/membership.hs b/benchmarks/membership.hs
new file mode 100644
--- /dev/null
+++ b/benchmarks/membership.hs
@@ -0,0 +1,63 @@
+{-# LANGUAGE ViewPatterns, TypeOperators, GADTs #-}
+import Data.Extensible
+import Data.Extensible.Internal
+import Criterion.Main
+import AtoZ
+import Unsafe.Coerce
+
+data Sum = C0 A|C1 B|C2 C|C3 D|C4 E|C5 F|C6 G|C7 H|C8 I|C9 J|C10 K |C11 L|C12 M
+  |C13 N|C14 O|C15 P|C16 Q|C17 R|C18 S|C19 T|C20 U|C21 V|C22 W|C23 X|C24 Y|C25 Z
+
+testNaive :: Sum -> Int
+testNaive (C0 (A n)) = n
+testNaive (C1 (B n)) = n
+testNaive (C2 (C n)) = n
+testNaive (C3 (D n)) = n
+testNaive (C4 (E n)) = n
+testNaive (C5 (F n)) = n
+testNaive (C6 (G n)) = n
+testNaive (C7 (H n)) = n
+testNaive (C8 (I n)) = n
+testNaive (C9 (J n)) = n
+testNaive (C10 (K n)) = n
+testNaive (C11 (L n)) = n
+testNaive (C12 (M n)) = n
+testNaive (C13 (N n)) = n
+testNaive (C14 (O n)) = n
+testNaive (C15 (P n)) = n
+testNaive (C16 (Q n)) = n
+testNaive (C17 (R n)) = n
+testNaive (C18 (S n)) = n
+testNaive (C19 (T n)) = n
+testNaive (C20 (U n)) = n
+testNaive (C21 (V n)) = n
+testNaive (C22 (W n)) = n
+testNaive (C23 (X n)) = n
+testNaive (C24 (Y n)) = n
+testNaive (C25 (Z n)) = n
+
+testExt :: K0 :| AtoZ -> Int
+testExt = match match26
+
+main = defaultMain [
+  bgroup "sum" [
+     bench "A" $ whnf testExt (bury (A 0))
+    , bench "M" $ whnf testExt (bury (M 0))
+    , bench "T" $ whnf testExt (bury (T 0))
+    , bench "Z" $ whnf testExt (bury (Z 0))
+    , bench "A_" $ whnf testNaive  (C0 (A 0))
+    , bench "M_" $ whnf testNaive (C12 (M 0))
+    , bench "T_" $ whnf testNaive (C19 (T 0))
+    , bench "Z_" $ whnf testNaive (C25 (Z 0))
+    ]
+  , bgroup "product" [
+      bench "A" $ whnf (\(pluck -> A x) -> x) blah26
+    , bench "G"  $ whnf (\(pluck -> G x) -> x) blah26
+    , bench "N"  $ whnf (\(pluck -> N x) -> x) blah26
+    , bench "T"  $ whnf (\(pluck -> T x) -> x) blah26
+    , bench "Z" $ whnf (\(pluck -> Z x) -> x) blah26
+    ]
+  , bgroup "tuple" [
+      bench "A" $ whnf (\(a,b,c,d,e,f,g,h,i,j,k,l,M res,n,o,p,q,r,s,t,u,v,w,x,y,z) -> res) tuple26
+    ]
+  ]
diff --git a/extensible.cabal b/extensible.cabal
--- a/extensible.cabal
+++ b/extensible.cabal
@@ -1,5 +1,5 @@
 name:                extensible
-version:             0.2.7
+version:             0.2.8
 synopsis:            Extensible, efficient, lens-friendly data types
 homepage:            https://github.com/fumieval/extensible
 bug-reports:         http://github.com/fumieval/extensible/issues
@@ -15,6 +15,7 @@
 
 extra-source-files:
   examples/*.hs
+  benchmarks/*.hs
   .gitignore
   .travis.yml
   README.md
@@ -50,7 +51,7 @@
     , FlexibleContexts
     , FlexibleInstances
     , PolyKinds
-  build-depends:       base >= 4.7 && <5, template-haskell
+  build-depends:       base >= 4.7 && <5, template-haskell, deepseq
   hs-source-dirs:      src
-  ghc-options: -Wall
+  ghc-options: -Wall -O2
   default-language:    Haskell2010
diff --git a/src/Data/Extensible/Dictionary.hs b/src/Data/Extensible/Dictionary.hs
--- a/src/Data/Extensible/Dictionary.hs
+++ b/src/Data/Extensible/Dictionary.hs
@@ -16,6 +16,7 @@
 import Data.Monoid
 import Data.Extensible.Product
 import Data.Extensible.Sum
+import Data.Extensible.Match
 import Data.Extensible.Internal
 import Data.Extensible.Internal.Rig
 
diff --git a/src/Data/Extensible/Internal.hs b/src/Data/Extensible/Internal.hs
--- a/src/Data/Extensible/Internal.hs
+++ b/src/Data/Extensible/Internal.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses, UndecidableInstances #-}
 {-# LANGUAGE ScopedTypeVariables, BangPatterns #-}
 {-# LANGUAGE TemplateHaskell #-}
@@ -18,7 +19,7 @@
   , runMembership
   , compareMembership
   , ord
-  , Nav(..)
+  , NavHere(..)
   , navigate
   , here
   , navNext
@@ -53,6 +54,9 @@
 import Unsafe.Coerce
 import Data.Typeable
 import Language.Haskell.TH
+import Control.DeepSeq
+import Data.Word
+import Data.Bits
 
 -- | Generates a 'Membership' that corresponds to the given ordinal (0-origin).
 ord :: Int -> Q Exp
@@ -66,8 +70,11 @@
     $ conT ''Membership `appT` pure t `appT` varT (names !! n)
 
 -- | The position of @x@ in the type level set @xs@.
-newtype Membership (xs :: [k]) (x :: k) = Membership Int deriving Typeable
+newtype Membership (xs :: [k]) (x :: k) = Membership Word8 deriving Typeable
 
+instance NFData (Membership xs x) where
+  rnf (Membership a) = rnf a
+
 instance Show (Membership xs x) where
   show (Membership n) = "$(ord " ++ show n ++ ")"
 
@@ -83,22 +90,29 @@
 runMembership (Membership n) = Right (Membership (n - 1))
 {-# INLINE runMembership #-}
 
+-- | PRIVILEGED: Compare two 'Membership's.
 compareMembership :: Membership xs x -> Membership xs y -> Either Ordering (x :~: y)
 compareMembership (Membership m) (Membership n) = case compare m n of
   EQ -> Right (unsafeCoerce Refl)
   x -> Left x
 {-# INLINE compareMembership #-}
 
-navigate :: Membership xs x -> Nav xs x
-navigate (Membership 0) = unsafeCoerce Here
-navigate (Membership n) = let (m, r) = divMod (n - 1) 2 in case r of
-  0 -> unsafeCoerce $ NavL $ Membership m
-  _ -> unsafeCoerce $ NavR $ Membership m
+-- | PRIVILEGED: Navigate a tree.
+navigate :: (NavHere xs x -> r)
+  -> (Membership (Half (Tail xs)) x -> r)
+  -> (Membership (Half (Tail (Tail xs))) x -> r)
+  -> Membership xs x
+  -> r
+navigate h nl nr = \case
+  Membership 0 -> h (unsafeCoerce Here)
+  Membership n -> let !x = n - 1 in if testBit x 0
+    then nr (Membership (shiftR x 1))
+    else nl (Membership (shiftR x 1))
+{-# INLINE navigate #-}
 
-data Nav xs x where
-  Here :: Nav (x ': xs) x
-  NavL :: Membership (Half xs) x -> Nav (e ': xs) x
-  NavR :: Membership (Half (Tail xs)) x -> Nav (e ': xs) x
+-- | Ensure that the first element of @xs@ is @x@
+data NavHere xs x where
+  Here :: NavHere (x ': xs) x
 
 here :: Membership (x ': xs) x
 here = Membership 0
@@ -138,7 +152,7 @@
   Check x xs = Ambiguous x
 
 instance (Check x (Lookup x xs) ~ Expecting one, ToInt one) => Member xs x where
-  membership = Membership $ theInt (Proxy :: Proxy one)
+  membership = Membership (theInt (Proxy :: Proxy one))
   {-# INLINE membership #-}
 
 type family Half (xs :: [k]) :: [k] where
@@ -152,27 +166,19 @@
 
 data Nat = Zero | DNat Nat | SDNat Nat
 
-retagD :: (Proxy n -> a) -> proxy (DNat n) -> a
-retagD f _ = f Proxy
-{-# INLINE retagD #-}
-
-retagSD :: (Proxy n -> a) -> proxy (SDNat n) -> a
-retagSD f _ = f Proxy
-{-# INLINE retagSD #-}
-
 class ToInt n where
-  theInt :: proxy n -> Int
+  theInt :: proxy n -> Word8
 
 instance ToInt Zero where
   theInt _ = 0
   {-# INLINE theInt #-}
 
 instance ToInt n => ToInt (DNat n) where
-  theInt = (*2) <$> retagD theInt
+  theInt _ = theInt (Proxy :: Proxy n) `shiftL` 1
   {-# INLINE theInt #-}
 
 instance ToInt n => ToInt (SDNat n) where
-  theInt = (+1) <$> (*2) <$> retagSD theInt
+  theInt _ = (theInt (Proxy :: Proxy n) `shiftL` 1) + 1
   {-# INLINE theInt #-}
 
 type family Lookup (x :: k) (xs :: [k]) :: [Nat] where
@@ -194,6 +200,7 @@
 lemmaHalfTail _ = unsafeCoerce
 {-# INLINE lemmaHalfTail #-}
 
+-- | GHC can't prove this
 lemmaMerging :: p (Merge (Half xs) (Half (Tail xs))) -> p xs
 lemmaMerging = unsafeCoerce
 
diff --git a/src/Data/Extensible/Match.hs b/src/Data/Extensible/Match.hs
--- a/src/Data/Extensible/Match.hs
+++ b/src/Data/Extensible/Match.hs
@@ -33,7 +33,7 @@
 
 -- | /O(log n)/ Perform pattern matching.
 match :: Match h a :* xs -> h :| xs -> a
-match p (UnionAt pos h) = runMatch (hlookup pos p) h
+match p = \(UnionAt pos h) -> views (sectorAt pos) runMatch p h
 {-# INLINE match #-}
 
 -- | Flipped `match`
diff --git a/src/Data/Extensible/Plain.hs b/src/Data/Extensible/Plain.hs
--- a/src/Data/Extensible/Plain.hs
+++ b/src/Data/Extensible/Plain.hs
@@ -51,7 +51,7 @@
 
 -- | Extract a plain value.
 pluck :: (x ∈ xs) => AllOf xs -> x
-pluck = getK0 . hlookup membership
+pluck = views sector getK0
 {-# INLINE pluck #-}
 
 -- | Embed a plain value.
diff --git a/src/Data/Extensible/Product.hs b/src/Data/Extensible/Product.hs
--- a/src/Data/Extensible/Product.hs
+++ b/src/Data/Extensible/Product.hs
@@ -140,14 +140,14 @@
 {-# INLINE sector #-}
 
 -- | /O(log n)/ A lens for a value in a known position.
-sectorAt :: forall h x xs f. Functor f => Membership xs x -> (h x -> f (h x)) -> h :* xs -> f (h :* xs)
-sectorAt pos0 f = go pos0 where
-  go :: forall t. Membership t x -> h :* t -> f (h :* t)
-  go pos (Tree h a b) = case navigate pos of
-    Here -> fmap (\h' -> Tree h' a b) (f h)
-    NavL p -> fmap (\a' -> Tree h a' b) $ go p a
-    NavR p -> fmap (\b' -> Tree h a b') $ go p b
-  go _ Nil = error "Impossible"
+sectorAt :: forall f h x xs. Functor f => Membership xs x -> (h x -> f (h x)) -> h :* xs -> f (h :* xs)
+sectorAt pos f = flip go pos where
+  go :: forall t. h :* t -> Membership t x -> f (h :* t)
+  go (Tree h a b) = navigate
+    (\Here -> fmap (\h' -> Tree h' a b) (f h))
+    (fmap (\a' -> Tree h a' b) . go a)
+    (fmap (\b' -> Tree h a b') . go b)
+  go Nil = error "Impossible"
 {-# INLINE sectorAt #-}
 
 -- | Given a function that maps types to values, we can "collect" entities all you want.
diff --git a/src/Data/Extensible/Sum.hs b/src/Data/Extensible/Sum.hs
--- a/src/Data/Extensible/Sum.hs
+++ b/src/Data/Extensible/Sum.hs
@@ -27,7 +27,7 @@
 
 -- | The extensible sum type
 data (h :: k -> *) :| (s :: [k]) where
-  UnionAt :: Membership xs x -> h x -> h :| xs
+  UnionAt :: !(Membership xs x) -> h x -> h :| xs
 deriving instance Typeable (:|)
 
 -- | Change the wrapper.