diff --git a/Changelog.md b/Changelog.md
new file mode 100644
--- /dev/null
+++ b/Changelog.md
@@ -0,0 +1,13 @@
+[0.2.0.0] — July 2025 
+
+* __Breaking Changes__:
+  * Complete rewrite of the 'NeedsBuilder'
+    * Please refer to the examples to see how to build packed data
+  * Dropping support for GHC < 9.10. 
+    * 'NeedsBuilder' relies on linear types and type inference is broken before that version
+
+* Features:
+  * 'PackedReader' has been rewritten, however the API should be retro-compatible
+  * The code generator defines pattern synonyms, allowing one to pattern-match on packed data using a native 'case' expression
+    * Refer to the examples (e.g. Sum) to see how it works
+    * The generated 'case' functions are still generated, but they use these pattern synonyms under the hood
diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -25,6 +25,7 @@
 ```haskell
 
 import qualified Data.Packed.Reader as R
+import Data.Packed.Reader
 import Data.Packed
 
 data Tree a = Leaf a | Node (Tree a) (Tree a)
@@ -32,6 +33,7 @@
 $(mkPacked ''Tree '[])
 
 -- Compute sum of values in the tree
+-- Using the generated 'caseTree' function
 sumPacked :: PackedReader '[Tree Int] r Int
 sumPacked =
     caseTree -- Generated by Template Haskell
@@ -45,7 +47,16 @@
             let !res = left + right
             R.return res
         )
+-- Alternatively, you can use generated pattern synonyms
+sumPacked = PackedReader $ \case
+    PackedLeaf l -> reader `with` l
+    PackedNode n -> threadedWith n $ R.do
+        !left <- sumPacked2
+        !right <- sumPacked2
+        let !res = left + right
+        R.return res
 
+
 getSum :: Packed '[Tree Int] -> IO Int
 getSum = runReader sumPacked
 
@@ -62,10 +73,10 @@
 To run benchmarks, run the following command:
 
 ```
-stack bench
+stack bench packed-data:bench:tree-bench
 # Saves the report as CSV
-stack bench --ba --csv bench.csv
+stack bench packed-data:bench:tree-bench --ba --csv bench.csv
 # Saves the report, and runs a specific test
-stach bench --ba '--csv bench.csv sums'
+stach bench packed-data:bench:tree-bench --ba '--csv bench.csv sums'
 ```
 
diff --git a/benchmark/tree/AST.hs b/benchmark/tree/AST.hs
--- a/benchmark/tree/AST.hs
+++ b/benchmark/tree/AST.hs
@@ -37,7 +37,7 @@
         (depthGroupName n)
         [ envWithCleanup (c_build_ast $ fromIntegral n) c_free_ast $ bench cTestName . nfAppIO c_eval
         , bench nativeTestName $ nf eval nativeAST
-        , bench packedTestName $ nfAppIO (runReader evalPacked) packedAST
+        , bench packedTestName $ nf (runReader evalPacked) packedAST
         , bench packedWithUnpackTestName $ whnf (eval . fst . unpack) packedAST
         , bench nonMonadicPackedTestName $ nfAppIO evalPackedNonMonadic packedAST
         ]
@@ -54,7 +54,7 @@
 evalPacked :: PackedReader '[AST] r Int32
 evalPacked =
     caseAST
-        reader
+        (reader R.>>= \(!n) -> R.return n)
         (opLambda (+))
         (opLambda (-))
         (opLambda (*))
@@ -64,9 +64,10 @@
         (Int32 -> Int32 -> Int32) ->
         PackedReader '[AST, AST] r Int32
     opLambda f = R.do
-        left <- evalPacked
-        right <- evalPacked
-        R.return (f left right)
+        !left <- evalPacked
+        !right <- evalPacked
+        let !res = f left right
+        R.return res
 
 evalPackedNonMonadic :: Packed (AST ': r) -> IO Int32
 evalPackedNonMonadic packed = fst <$> go (unsafeForeignPtrToPtr fptr)
diff --git a/benchmark/tree/Build.hs b/benchmark/tree/Build.hs
--- a/benchmark/tree/Build.hs
+++ b/benchmark/tree/Build.hs
@@ -30,7 +30,7 @@
     bgroup
         (depthGroupName n)
         [ bench nativeTestName $ nf buildNativeTree n
-        , bench packedTestName $ nf (\p -> finish (buildPackedTree p)) n
+        , bench packedTestName $ nf (runBuilder . buildPackedTree) n
         ]
 
 buildNativeTree :: Int -> Tree1 Int
@@ -39,8 +39,9 @@
   where
     !subTree = buildNativeTree (n - 1)
 
-buildPackedTree :: Int -> Needs '[] '[Tree1 Int]
-buildPackedTree 0 = withEmptyNeeds (writeConLeaf1 (1 :: Int))
-buildPackedTree n = withEmptyNeeds (startNode1 N.>> applyNeeds subTree N.>> applyNeeds subTree)
+buildPackedTree :: Int -> NeedsBuilder (Tree1 Int ': r) '[Tree1 Int] r '[Tree1 Int]
+buildPackedTree 0 = writeConLeaf1 (1 :: Int)
+buildPackedTree n = \needs -> startNode1 needs N.>>= subTree N.>>= subTree
   where
+    subTree :: NeedsBuilder (Tree1 Int ': r1) '[Tree1 Int] r1 '[Tree1 Int]
     !subTree = buildPackedTree (n - 1)
diff --git a/benchmark/tree/Increment.hs b/benchmark/tree/Increment.hs
--- a/benchmark/tree/Increment.hs
+++ b/benchmark/tree/Increment.hs
@@ -9,7 +9,6 @@
 import Criterion.Main
 import Data.List (intercalate)
 import Data.Packed
-import Data.Packed.Needs (applyNeeds)
 import qualified Data.Packed.Needs as N
 import qualified Data.Packed.Reader as R
 import Data.Void
@@ -50,11 +49,11 @@
         , bench nativeTestName $
             nf increment nativeTree
         , bench (intercalate "-" [packedTestName, "needsbuilder"]) $
-            nfAppIO incrementPackedRunner packedTree
+            nf incrementPackedRunner packedTree
         , bench (intercalate "-" ["unpack", "repack"]) $
             nf (pack . increment . fst . unpack) packedTree
         , bench (intercalate "-" [packedTestName, "rebuild-repack"]) $
-            nfAppIO repackingIncrementPackedRunner packedTree
+            nf repackingIncrementPackedRunner packedTree
         ]
   where
     !packedTree = pack nativeTree
@@ -68,12 +67,10 @@
     !res2 = increment t2
 
 -- Produces an needsbuilder for a tree alread incremented, and finishes it
-incrementPackedRunner :: Packed '[Tree1 Int] -> IO (Packed '[Tree1 Int])
-incrementPackedRunner packed = do
-    (!needs, _) <- runReader incrementPacked packed
-    return $ finish needs
+incrementPackedRunner :: Packed '[Tree1 Int] -> Packed '[Tree1 Int]
+incrementPackedRunner packed = runBuilder . fst $ runReader incrementPacked packed
 
-incrementPacked :: PackedReader '[Tree1 Int] r (Needs '[] '[Tree1 Int])
+incrementPacked :: PackedReader '[Tree1 Int] r (N.NeedsBuilder (Tree1 Int ': r1) '[Tree1 Int] r1 '[Tree1 Int])
 incrementPacked =
     transformTree1
         ( R.do
@@ -83,7 +80,7 @@
         ( R.do
             left <- incrementPacked
             right <- incrementPacked
-            R.return (applyNeeds left N.>> applyNeeds right)
+            R.return (left N.>=> right)
         )
 
 buildNativeTree :: Int -> Tree1 Int
@@ -93,11 +90,13 @@
     !subTree = buildNativeTree (n - 1)
 
 -- Produces an unpacked tree alread incremented, and packs it
-repackingIncrementPackedRunner :: Packed '[Tree1 Int] -> IO (Packed '[Tree1 Int])
-repackingIncrementPackedRunner packed = do
-    (!tree, _) <- runReader repackingIncrementPacked packed
-    let !repacked = pack tree
-    return repacked
+repackingIncrementPackedRunner :: Packed '[Tree1 Int] -> Packed '[Tree1 Int]
+repackingIncrementPackedRunner packed =
+    let
+        (!tree, _) = runReader repackingIncrementPacked packed
+        !repacked = pack tree
+     in
+        repacked
 
 repackingIncrementPacked :: PackedReader '[Tree1 Int] r (Tree1 Int)
 repackingIncrementPacked =
diff --git a/benchmark/tree/List.hs b/benchmark/tree/List.hs
--- a/benchmark/tree/List.hs
+++ b/benchmark/tree/List.hs
@@ -5,13 +5,9 @@
 
 import Control.DeepSeq
 import Criterion.Main
-import qualified Data.ByteString.Internal as BS
 import Data.Packed
-import Data.Packed.Needs (Needs (Needs))
-import qualified Data.Packed.Needs as N
 import qualified Data.Packed.Reader as R
 import Foreign
-import Utils
 import Prelude hiding (sum)
 
 data Tree1 a = Leaf1 | Node1 (Tree1 a) a (Tree1 a)
@@ -23,7 +19,7 @@
 $(mkPacked ''Tree1 [InsertFieldSize])
 
 benchmark :: [Int] -> Benchmark
-benchmark depths =
+benchmark _ =
     bgroup
         "list"
         []
diff --git a/benchmark/tree/Sum.hs b/benchmark/tree/Sum.hs
--- a/benchmark/tree/Sum.hs
+++ b/benchmark/tree/Sum.hs
@@ -1,5 +1,15 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE CApiFFI #-}
+{-# LANGUAGE ExtendedLiterals #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE UnliftedNewtypes #-}
+{-# LANGUAGE ViewPatterns #-}
 
 module Sum (benchmark) where
 
@@ -8,7 +18,7 @@
 import Data.Packed
 import qualified Data.Packed.Reader as R
 import Data.Void (Void)
-import Foreign
+import Foreign hiding (with)
 import Foreign.C
 import Foreign.ForeignPtr.Unsafe
 import GHC.IO
@@ -39,9 +49,9 @@
         (depthGroupName n)
         [ envWithCleanup (c_build_tree (fromIntegral n)) c_free_tree $ bench cTestName . nfAppIO c_sum
         , bench nativeTestName $ nf sum nativeTree
-        , bench packedTestName $ whnfAppIO (R.runReader sumPacked) packedTree
+        , bench packedTestName $ whnf (R.runReader sumPacked) packedTree
         , bench packedWithUnpackTestName $ whnf (sum . fst . unpack) packedTree
-        , bench packedWithFieldSizeTestName $ whnfAppIO (R.runReader sumPacked2) packedTree2
+        , bench packedWithFieldSizeTestName $ whnf (R.runReader sumPacked2) packedTree2
         , bench nonMonadicPackedTestName $ nfAppIO sumPackedNonMonadic packedTree
         , bench nonMonadicPackedWithSizeTestName $ nfAppIO sumPackedNonMonadic2 packedTree2
         ]
diff --git a/benchmark/tree/Traversals.hs b/benchmark/tree/Traversals.hs
--- a/benchmark/tree/Traversals.hs
+++ b/benchmark/tree/Traversals.hs
@@ -43,11 +43,11 @@
         (depthGroupName n)
         [ envWithCleanup (c_build_tree (fromIntegral n)) c_free_tree $ bench cTestName . nfAppIO c_get_right_most
         , bench nativeTestName $ nf getRightMostNodeNative nativeTree
-        , bench packedTestName $ nfAppIO (runReader getRightMostNodePacked) packedTree
+        , bench packedTestName $ nf (runReader getRightMostNodePacked) packedTree
         , bench packedWithUnpackTestName $ whnf (getRightMostNodeNative . fst . unpack) packedTree
         , bench nonMonadicPackedTestName $ nfAppIO getRightMostNodePackedNonMonadic packedTree
         , bench packedWithFieldSizeTestName $
-            nfAppIO (runReader getRightMostNodePacked2) packedTreeWithSize
+            nf (runReader getRightMostNodePacked2) packedTreeWithSize
         , bench nonMonadicPackedWithSizeTestName $ nfAppIO getRightMostNodePacked2NonMonadic packedTreeWithSize
         ]
   where
@@ -128,10 +128,10 @@
     bgroup
         (depthGroupName n)
         [ bench nativeTestName $ nf (containsNative value) nativeTree
-        , bench packedTestName $ nfAppIO (runReader (containsPacked value)) packedTree
+        , bench packedTestName $ nf (runReader (containsPacked value)) packedTree
         , bench nonMonadicPackedTestName $ nfAppIO (containsNonMonadic value) packedTree
         , bench packedWithFieldSizeTestName $
-            nfAppIO (runReader (containsPacked2 value)) packedTreeWithSize
+            nf (runReader (containsPacked2 value)) packedTreeWithSize
         , bench nonMonadicPackedWithSizeTestName $ nfAppIO (containsNonMonadic2 value) packedTreeWithSize
         ]
   where
diff --git a/examples/Increment.hs b/examples/Increment.hs
--- a/examples/Increment.hs
+++ b/examples/Increment.hs
@@ -1,3 +1,7 @@
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+
 -- | Showcase how to 'mutate' packed data
 module Increment (incrementRunner) where
 
@@ -9,13 +13,11 @@
 
 $(mkPacked ''Tree [])
 
-incrementRunner :: Packed '[Tree Int] -> IO (Packed '[Tree Int])
-incrementRunner p = do
-    (incremented, _) <- runReader incrementPacked p
-    return $ finish incremented
+incrementRunner :: Packed '[Tree Int] -> Packed '[Tree Int]
+incrementRunner p = runBuilder . fst $ runReader incrementPacked p
 
--- The workhouse of the incrementation
-incrementPacked :: PackedReader '[Tree Int] r (Needs '[] '[Tree Int])
+-- -- The workhouse of the incrementation
+incrementPacked :: PackedReader '[Tree Int] r (NeedsBuilder (Tree Int ': r1) '[Tree Int] r1 '[Tree Int])
 incrementPacked =
     transformTree
         ( R.do
@@ -25,5 +27,5 @@
         ( R.do
             left <- incrementPacked
             right <- incrementPacked
-            R.return (applyNeeds left N.>> applyNeeds right)
+            R.return (\needs -> left needs N.>>= right)
         )
diff --git a/examples/Pack.hs b/examples/Pack.hs
--- a/examples/Pack.hs
+++ b/examples/Pack.hs
@@ -10,13 +10,9 @@
 myTree :: Tree Int
 myTree = Node (Leaf 1) (Leaf 2)
 
-packedTree :: Packed '[Tree Int]
-packedTree = pack myTree
-
 buildTree :: Packed '[Tree Int]
 buildTree =
-    finish $
-        withEmptyNeeds $ N.do
-            startNode
-            startLeaf N.>> write (1 :: Int)
-            startLeaf N.>> write 2
+    runBuilder $ \needs -> N.do
+        node <- startNode needs
+        leaf1 <- startLeaf node N.>>= write (1 :: Int)
+        startLeaf leaf1 N.>>= write 2
diff --git a/examples/Traversal.hs b/examples/Traversal.hs
--- a/examples/Traversal.hs
+++ b/examples/Traversal.hs
@@ -3,6 +3,7 @@
 module Traversal () where
 
 import Data.Packed
+import Data.Packed.Reader
 import qualified Data.Packed.Reader as R
 import Tree
 
@@ -14,21 +15,30 @@
 packedTree :: Packed '[Tree Int]
 packedTree = pack myTree
 
-sumPacked :: PackedReader '[Tree Int] r Int
-sumPacked =
+-- The two following functions do the same thing
+
+sumPacked1 :: PackedReader '[Tree Int] r Int
+sumPacked1 =
     caseTree
         ( R.do
             !n <- reader
             R.return n
         )
         ( R.do
-            !left <- sumPacked
-            !right <- sumPacked
+            !left <- sumPacked1
+            !right <- sumPacked1
             let !res = left + right
             R.return res
         )
 
-runSum :: IO Int
-runSum = do
-    (res, _) <- runReader sumPacked packedTree
-    return res
+sumPacked2 :: PackedReader '[Tree Int] r Int
+sumPacked2 = PackedReader $ \case
+    PackedLeaf l -> reader `with` l
+    PackedNode n -> threadedWith n $ R.do
+        !left <- sumPacked2
+        !right <- sumPacked2
+        let !res = left + right
+        R.return res
+
+runSum :: Int
+runSum = fst $ runReader sumPacked1 packedTree
diff --git a/examples/Unpack.hs b/examples/Unpack.hs
--- a/examples/Unpack.hs
+++ b/examples/Unpack.hs
@@ -12,4 +12,4 @@
 packedTree = pack myTree
 
 unpackedTree :: Tree Int
-unpackedTree = fst $ unpack packedTree
+unpackedTree = fst . unpack $ packedTree
diff --git a/packed-data.cabal b/packed-data.cabal
--- a/packed-data.cabal
+++ b/packed-data.cabal
@@ -1,11 +1,11 @@
 cabal-version: 2.2
 
--- This file has been generated from package.yaml by hpack version 0.37.0.
+-- This file has been generated from package.yaml by hpack version 0.38.0.
 --
 -- see: https://github.com/sol/hpack
 
 name:           packed-data
-version:        0.1.0.3
+version:        0.2.0.0
 description:    Build, traverse and deserialise packed data in Haskell
 category:       Data
 homepage:       https://github.com/Arthi-chaud/packed-haskell#readme
@@ -17,14 +17,11 @@
 license-file:   LICENSE
 build-type:     Simple
 tested-with:
-    GHC ==9.2.8
-  , GHC ==9.4.8
-  , GHC ==9.6.6
-  , GHC ==9.8.4
-  , GHC ==9.10.1
+    GHC ==9.10.1
   , GHC ==9.12.1
 extra-source-files:
     README.md
+    Changelog.md
 
 source-repository head
   type: git
@@ -35,18 +32,19 @@
       Data.Packed
       Data.Packed.Reader
       Data.Packed.Needs
-      Data.Packed.Instances
       Data.Packed.TH
       Data.Packed.TH.Utils
       Data.Packed.Skippable
-  other-modules:
       Data.Packed.FieldSize
+  other-modules:
+      Data.Packed.Internal
       Data.Packed.Packable
       Data.Packed.Packed
       Data.Packed.TH.Case
       Data.Packed.TH.Flag
       Data.Packed.TH.Packable
       Data.Packed.TH.PackCon
+      Data.Packed.TH.Pattern
       Data.Packed.TH.Read
       Data.Packed.TH.RepackCon
       Data.Packed.TH.Skip
@@ -58,7 +56,6 @@
       Data.Packed.TH.WriteCon
       Data.Packed.Unpackable
       Data.Packed.Utils
-      Tree
       Paths_packed_data
   autogen-modules:
       Paths_packed_data
@@ -74,13 +71,16 @@
       TemplateHaskellQuotes
       TupleSections
       QualifiedDo
+      ViewPatterns
+      PatternSynonyms
+      UnboxedTuples
   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints
   build-depends:
       base >=4.7 && <5
     , bytestring >=0.11.0.0 && <0.13
-    , bytestring-strict-builder >=0.4.5 && <0.5
     , deepseq >=1.4.6.1 && <1.6
     , extra >=1.0 && <2.0
+    , linear-base >=0.4.0 && <0.5.0
     , mtl >=2.2.2 && <2.4
     , template-haskell >=2.18.0.0 && <=2.24.0.0
   default-language: Haskell2010
@@ -108,7 +108,10 @@
       TemplateHaskellQuotes
       TupleSections
       QualifiedDo
-  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N -Wno-unused-top-binds
+      ViewPatterns
+      PatternSynonyms
+      UnboxedTuples
+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N -Wno-unused-top-binds -Wno-orphans
   build-depends:
       base >=4.7 && <5
     , packed-data
@@ -138,6 +141,9 @@
       TemplateHaskellQuotes
       TupleSections
       QualifiedDo
+      ViewPatterns
+      PatternSynonyms
+      UnboxedTuples
   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N -Wno-unused-top-binds -Wno-orphans -Wno-redundant-constraints
   build-depends:
       base >=4.7 && <5
@@ -166,6 +172,9 @@
       TemplateHaskellQuotes
       TupleSections
       QualifiedDo
+      ViewPatterns
+      PatternSynonyms
+      UnboxedTuples
   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-T -O2 -Wno-unused-top-binds -Wno-orphans -Wno-redundant-constraints
   build-depends:
       base >=4.7 && <5
@@ -194,6 +203,9 @@
       TemplateHaskellQuotes
       TupleSections
       QualifiedDo
+      ViewPatterns
+      PatternSynonyms
+      UnboxedTuples
   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-T -O2 -Wno-unused-top-binds -Wno-orphans -Wno-redundant-constraints
   build-depends:
       aeson
@@ -227,6 +239,9 @@
       TemplateHaskellQuotes
       TupleSections
       QualifiedDo
+      ViewPatterns
+      PatternSynonyms
+      UnboxedTuples
   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-T -O2 -Wno-unused-top-binds -Wno-orphans -Wno-redundant-constraints
   build-depends:
       base >=4.7 && <5
@@ -266,6 +281,9 @@
       TemplateHaskellQuotes
       TupleSections
       QualifiedDo
+      ViewPatterns
+      PatternSynonyms
+      UnboxedTuples
   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-T -O2 -Wno-unused-top-binds -Wno-orphans -Wno-redundant-constraints
   cc-options: -O2
   include-dirs:
diff --git a/src/Data/Packed.hs b/src/Data/Packed.hs
--- a/src/Data/Packed.hs
+++ b/src/Data/Packed.hs
@@ -1,3 +1,70 @@
+-- |
+--
+-- Packed data is data serialised into a binary format that is usable as-is, meaning there is no need to parse it to be able to use it. Another perk of such format is that it can be stored in files easily.
+--
+-- `packed-data` allows using packed data type-safely, without explicit pointer arithmetic.
+--
+-- Check out examples here: https://github.com/Arthi-chaud/packed-data/tree/main/examples
+--
+-- Example of a tree traversal:
+--
+-- @
+-- {-# LANGUAGE DataKinds #-}
+-- {-# LANGUAGE TypeOperators #-}
+-- {-# LANGUAGE KindSignatures #-}
+-- {-# LANGUAGE LambdaCase #-}
+-- {-# LANGUAGE GADTs #-}
+-- {-# LANGUAGE LambdaCase #-}
+-- {-# LANGUAGE TemplateHaskell #-}
+-- {-# LANGUAGE TemplateHaskellQuotes #-}
+-- {-# LANGUAGE TupleSections #-}
+-- {-# LANGUAGE QualifiedDo #-}
+-- {-# LANGUAGE ViewPatterns #-}
+-- {-# LANGUAGE PatternSynonyms #-}
+-- {-# LANGUAGE UnboxedTuples #-}
+--
+-- import Data.Packed
+-- import Data.Packed.Reader
+-- import qualified Data.Packed.Reader as R
+--
+-- data Tree a = Leaf a | Node (Tree a) (Tree a)
+-- \$('Data.Packed.mkPacked' ''Tree [])
+--
+-- myTree :: Tree Int
+-- myTree = Node (Leaf 1) (Leaf 2)
+--
+-- packedTree :: 'Data.Packed.Packed' '[Tree Int]
+-- packedTree = 'pack' myTree
+--
+-- -- The two following functions do th same thing
+--
+-- sumPacked1 :: 'Data.Packed.Reader.PackedReader' '[Tree Int] r Int
+-- sumPacked1 =
+--     caseTree -- Generated
+--         ( R.do
+--             !n <- 'reader'
+--             R.'Data.Packed.Reader.return' n
+--         )
+--         ( R.do
+--             !left <- sumPacked1
+--             !right <- sumPacked1
+--             let !res = left + right
+--             R.'Data.Packed.Reader.return' res
+--         )
+--
+-- -- The patterns 'PackedLead' and 'PackedNode' are generated
+-- sumPacked2 :: 'Data.Packed.Reader.PackedReader' '[Tree Int] r Int
+-- sumPacked2 = 'Data.Packed.Reader.mkPackedReader' $ \case
+--     PackedLeaf l -> 'reader' `Data.Packed.Reader.with` l
+--     PackedNode n -> 'Data.Packed.Reader.threadedWith' n $ R.do
+--         !left <- sumPacked2
+--         !right <- sumPacked2
+--         let !res = left + right
+--         R.'return' res
+--
+-- runSum :: Int
+-- runSum = fst $ 'Data.Packed.Reader.runReader' sumPacked1 packedTree
+-- @
 module Data.Packed (
     -- * Classes
     Packable (..),
@@ -9,9 +76,8 @@
 
     -- * Needs
     Needs,
-    withEmptyNeeds,
+    runBuilder,
     writeWithFieldSize,
-    finish,
     unsafeCastNeeds,
 
     -- * Packed
@@ -20,9 +86,7 @@
     isolate,
     fromPacked,
     unsafeToPacked,
-    unsafeToPacked',
     unsafeCastPacked,
-    getPtr,
 
     -- * PackedReader
     PackedReader,
@@ -41,7 +105,6 @@
 ) where
 
 import Data.Packed.FieldSize
-import Data.Packed.Instances ()
 import Data.Packed.Needs
 import Data.Packed.Packable
 import Data.Packed.Packed
diff --git a/src/Data/Packed/FieldSize.hs b/src/Data/Packed/FieldSize.hs
--- a/src/Data/Packed/FieldSize.hs
+++ b/src/Data/Packed/FieldSize.hs
@@ -1,4 +1,10 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LinearTypes #-}
+{-# LANGUAGE MagicHash #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE UnboxedTuples #-}
 
 module Data.Packed.FieldSize (
     FieldSize (..),
@@ -10,12 +16,11 @@
     applyNeedsWithFieldSize,
 ) where
 
-import ByteString.StrictBuilder (builderLength)
-import Control.Monad
+import qualified Control.Functor.Linear as L
+import Control.Monad.Identity (Identity (Identity))
 import qualified Data.ByteString as BS
-import Data.Int (Int32)
+import Data.Packed.Internal
 import Data.Packed.Needs
-import qualified Data.Packed.Needs as N
 import Data.Packed.Packable
 import Data.Packed.Packed
 import Data.Packed.Reader hiding (return)
@@ -24,21 +29,29 @@
 import Data.Packed.Unpackable
 import Foreign.Ptr
 import Foreign.Storable
+import GHC.Exts
+import GHC.Int
+import qualified System.IO.Linear as L
+import Unsafe.Linear
 import Prelude hiding (read)
 
 -- | Type representation for the size of a packed data.
 -- The size is in bytes.
 --
 -- __Note__: Take a look at the 'Data.Packed.TH.PackingFlag's to understand how to use it
-newtype FieldSize = FieldSize Int32
+newtype FieldSize = FieldSize Int32 deriving (Num, Enum, Real, Ord, Eq)
 
+deriving instance Integral FieldSize
+
 instance {-# OVERLAPPING #-} Packable FieldSize where
-    write (FieldSize value) = mkNeedsBuilder unsafeCastNeeds N.>> write value
+    write (FieldSize value) needs = write value (unsafeCastNeeds needs)
 
 instance {-# OVERLAPPING #-} Unpackable FieldSize where
-    reader = mkPackedReader $ \packed l -> do
-        (fieldSize, rest, l1) <- runPackedReader reader packed l
-        return (FieldSize fieldSize, rest, l1)
+    reader = mkPackedReader $ \pf ->
+        let
+            Identity !(!fieldSize, !pf1) = runReaderStep reader (castPackedFragment pf)
+         in
+            return (FieldSize fieldSize, pf1)
 
 instance {-# OVERLAPPING #-} Skippable FieldSize where
     skip = unsafeSkipN (sizeOf (1 :: Int32))
@@ -55,10 +68,12 @@
 
 -- | Allows skipping over a field without having to unpack it
 skipWithFieldSize :: PackedReader '[FieldSize, a] r ()
-skipWithFieldSize = mkPackedReader $ \packed l -> do
-    (FieldSize s, packed1, l1) <- runPackedReader reader packed l
-    let size64 = fromIntegral s
-    return ((), packed1 `plusPtr` size64, l1 - size64)
+skipWithFieldSize = mkPackedReader $ \pf ->
+    let
+        Identity !(FieldSize s, PF packed1 l1) = runReaderStep reader pf
+        !size64 = fromIntegral s
+     in
+        return ((), PF (packed1 `plusPtr` size64) (l1 - size64))
 
 {-# INLINE writeWithFieldSize #-}
 
@@ -66,15 +81,41 @@
 --
 -- Note: Universal quantifier is nedded for GHC < 9.10, because of ScopedTypeVariables
 writeWithFieldSize :: forall a r t. (Packable a) => a -> NeedsWriter' '[FieldSize, a] r t
-writeWithFieldSize a = write (FieldSize size) N.>> applyNeeds aNeeds
-  where
-    size = fromIntegral (builderLength aBuilder)
-    aNeeds :: Needs '[] '[a]
-    aNeeds@(Needs aBuilder) = withEmptyNeeds (write a)
+writeWithFieldSize a = withFieldSize (write a)
 
+{-# INLINE withFieldSize #-}
+withFieldSize :: NeedsBuilder (a ': r) t r t -> NeedsBuilder (FieldSize ': a ': r) t r t
+withFieldSize cont needs = L.do
+    let !indirectionSize = sizeOf (0 :: Int32)
+    -- Reallocating the buffer so that the fieldsize can fit
+    !newNeeds <- guardRealloc indirectionSize needs
+    -- Get the position of the buffer where the FS will be
+    let !(# fieldSizeOffset, newNeeds1 #) = getOffset newNeeds
+    -- Shift the cursor
+    !writtenNeeds <- cont (unsafeShiftNeedsPtr indirectionSize newNeeds1)
+    -- Get the final position of the cursor
+    let !(# finalCursor, writtenNeeds1 #) = getOffset writtenNeeds
+        !(# og, writtenNeeds2 #) = getOrigin writtenNeeds1
+    () <-
+        toLinear3
+            ( \finalCursor' fsPosition og' fsSize ->
+                let
+                    -- Count the number of bytes that were written
+                    !writtenBytes = intToInt32# (finalCursor' -# (fsPosition +# unInt fsSize))
+                 in
+                    -- And write it
+
+                    L.fromSystemIO (poke (Ptr $ og' `plusAddr#` fsPosition) (I32# writtenBytes))
+            )
+            finalCursor
+            fieldSizeOffset
+            og
+            indirectionSize
+    L.return writtenNeeds2
+
 {-# INLINE applyNeedsWithFieldSize #-}
 applyNeedsWithFieldSize :: Needs '[] '[a] -> NeedsWriter' (FieldSize ': a ': '[]) r t
-applyNeedsWithFieldSize n@(Needs builder) = write (FieldSize (fromIntegral (builderLength builder))) N.>> applyNeeds n
+applyNeedsWithFieldSize n = withFieldSize (applyNeeds n)
 
 {-# INLINE readerWithFieldSize #-}
 
@@ -85,8 +126,10 @@
 {-# INLINE isolate #-}
 
 -- | Splits the 'Packed' value, and isolate the first encoded value.
-isolate :: PackedReader '[FieldSize, a] r (Packed '[a])
-isolate = mkPackedReader $ \packed l -> do
-    (FieldSize s, packed1, l1) <- runPackedReader reader packed l
-    let sizeInt = fromIntegral s
-    return (unsafeToPacked' packed1 sizeInt, packed1 `plusPtr` sizeInt, l1 - sizeInt)
+isolate :: PackedReader '[FieldSize, a] r (PackedFragment '[a])
+isolate = mkPackedReader $ \pf ->
+    let
+        Identity !(FieldSize s, PF packed1 l1) = runReaderStep reader pf
+        !sizeInt = fromIntegral s
+     in
+        return (PF packed1 sizeInt, PF (packed1 `plusPtr` sizeInt) (l1 - sizeInt))
diff --git a/src/Data/Packed/Instances.hs b/src/Data/Packed/Instances.hs
deleted file mode 100644
--- a/src/Data/Packed/Instances.hs
+++ /dev/null
@@ -1,16 +0,0 @@
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# OPTIONS_GHC -Wno-missing-export-lists #-}
-{-# OPTIONS_GHC -Wno-orphans #-}
-{-# OPTIONS_GHC -Wno-redundant-constraints #-}
-{-# OPTIONS_GHC -Wno-unused-top-binds #-}
-
--- | This module provides instances of 'Data.Packed.Packable' and 'Data.Packed.Unpackable' for basic types like 'Prelude.List' and 'Prelude.Maybe'
-module Data.Packed.Instances where
-
-import Data.Packed.TH
-import Data.Packed.Unpackable
-import Prelude hiding (readList)
-
-$(mkPacked ''[] [])
-$(mkPacked ''Maybe [])
-$(mkPacked ''Either [])
diff --git a/src/Data/Packed/Internal.hs b/src/Data/Packed/Internal.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Packed/Internal.hs
@@ -0,0 +1,22 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE LinearTypes #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-# OPTIONS_GHC -Wno-missing-export-lists #-}
+
+module Data.Packed.Internal where
+
+import GHC.Base
+import GHC.Exts
+
+{-# INLINE unPtr #-}
+unPtr :: Ptr a %1 -> Addr#
+unPtr (Ptr a) = a
+
+{-# INLINE unInt #-}
+unInt :: Int %1 -> Int#
+unInt (I# i) = i
+
+{-# INLINE unsafeDupablePerformIO #-}
+unsafeDupablePerformIO :: IO a -> a
+unsafeDupablePerformIO (IO m) = case runRW# m of (# _, !a #) -> a
diff --git a/src/Data/Packed/Needs.hs b/src/Data/Packed/Needs.hs
--- a/src/Data/Packed/Needs.hs
+++ b/src/Data/Packed/Needs.hs
@@ -1,45 +1,90 @@
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE LinearTypes #-}
+{-# LANGUAGE MagicHash #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UnboxedTuples #-}
 
 module Data.Packed.Needs (
     -- * Type
     Needs (..),
-    withEmptyNeeds,
-    finish,
 
     -- * Builders
-    NeedsBuilder (..),
+    NeedsBuilder,
+    runBuilder,
+    (>>=),
+    (>=>),
     NeedsWriter,
     NeedsWriter',
-    (>>),
-    mkNeedsBuilder,
-    withNeeds,
 
     -- * Mixing Needs together
     concatNeeds,
     applyNeeds,
 
     -- * Internal
+    getCursor,
+    getOffset,
+    getOrigin,
+    writeStorable,
+
+    -- * Dangerous
+    unsafeWriteTag,
     unsafeCastNeeds,
-    (:++:),
+    guardRealloc,
+    unsafeShiftNeedsPtr,
 ) where
 
-import ByteString.StrictBuilder
+import qualified Control.Functor.Linear as L
+import Data.ByteString.Internal
+import Data.Int
 import Data.Kind
+import qualified Data.Num.Linear as L
+import qualified Data.Ord.Linear as L
+import Data.Packed.Internal
 import Data.Packed.Packed
-import Data.Packed.Utils
-import Prelude hiding ((>>))
+import Data.Packed.Utils ((:++:))
+import Data.Unrestricted.Linear
+import Foreign (Storable (..))
+import GHC.Exts
+import GHC.ForeignPtr
+import GHC.IO (IO (..))
+import qualified System.IO.Linear as L
+import Unsafe.Linear
+import Prelude hiding ((>>=))
 
 -- | A buffer where packed values can be written
 -- The order to write these values is defined by the 'l' type list
 --
 -- If 'p' is an empty list, then a value of type 't' can be extracted from that buffer.
--- (See 'finish')
-newtype Needs (p :: [Type]) (t :: [Type]) = Needs Builder
+-- (See the signature of 'runReader')
+data Needs (p :: [Type]) (t :: [Type])
+    = Needs
+        {-# UNPACK #-} !(MutableByteArray# RealWorld)
+        {-# UNPACK #-} !Addr#
+        {-# UNPACK #-} !Int
 
-unsafeCastNeeds :: Needs a b -> Needs c d
-unsafeCastNeeds (Needs b) = Needs b
+{-# INLINE getCursor #-}
+getCursor :: Needs a b %1 -> (# Addr#, Needs a b #)
+getCursor = toLinear (\n@(Needs _ cursor _) -> (# cursor, n #))
 
+{-# INLINE getOffset #-}
+getOffset :: Needs a b %1 -> (# Int#, Needs a b #)
+getOffset = toLinear (\n@(Needs origin cursor _) -> (# cursor `minusAddr#` mutableByteArrayContents# origin, n #))
+
+{-# INLINE getOrigin #-}
+getOrigin :: Needs a b %1 -> (# Addr#, Needs a b #)
+getOrigin = toLinear (\n@(Needs origin _ _) -> (# mutableByteArrayContents# origin, n #))
+
+{-# INLINE getSpaceLeft #-}
+getSpaceLeft :: Needs a b %1 -> (# Int, Needs a b #)
+getSpaceLeft = toLinear (\n@(Needs _ _ spaceLeft) -> (# spaceLeft, n #))
+
+-- | Casts a 'Data.Packed.Needs'
+{-# INLINE unsafeCastNeeds #-}
+unsafeCastNeeds :: Needs a b %1 -> Needs c d
+unsafeCastNeeds (Needs a b c) = Needs a b c
+
+--- Needs Builder
+
 -- | A wrapper around a function that builds a 'Needs'
 --
 -- 'ps': The type of the expected input of the source 'Needs'
@@ -51,34 +96,122 @@
 -- 'td': The type of the final packed data of the resulting 'Needs'
 --
 -- __Note:__ It is an indexed monad.
-newtype NeedsBuilder ps ts pd td = NeedsBuilder
-    { runBuilder :: Needs ps ts -> Needs pd td
-    }
+type NeedsBuilder p1 t1 p2 t2 = Needs p1 t1 %1 -> L.IO (Needs p2 t2)
 
-(>>) :: NeedsBuilder p1 t1 p2 t2 -> NeedsBuilder p2 t2 p3 t3 -> NeedsBuilder p1 t1 p3 t3
-(NeedsBuilder !b1) >> (NeedsBuilder !b2) = mkNeedsBuilder (\n -> b2 (b1 n))
+-- | Similar to 'Prelude.>>='
+{-# INLINE (>>=) #-}
+(>>=) :: L.IO (Needs p1 t1) %1 -> (Needs p1 t1 %1 -> L.IO (Needs p2 t2)) -> L.IO (Needs p2 t2)
+(>>=) a b = L.do
+    !x <- a
+    !x1 <- b x
+    L.return x1
 
+-- | Similar to 'Control.Monad.>=>'
+{-# INLINE (>=>) #-}
+(>=>) :: (a %1 -> L.IO t) %1 -> (t %1 -> L.IO b) -> a %1 -> L.IO b
+(>=>) a b !c = L.do
+    !x <- a c
+    !x1 <- b x
+    L.return x1
+
 -- | Shortcut type for 'NeedsBuilder'\'s that simply write a value to a 'Needs' without changing the final packed type
 type NeedsWriter a r t = NeedsBuilder (a ': r) t r t
 
 -- | Shortcut type for 'NeedsBuilder'\'s that simply write multiple values to a 'Needs' without changing the final packed type
 type NeedsWriter' a r t = NeedsBuilder (a :++: r) t r t
 
-mkNeedsBuilder :: (Needs ps ts -> Needs pd td) -> NeedsBuilder ps ts pd td
-mkNeedsBuilder = NeedsBuilder
+baseBufferSize :: Int
+baseBufferSize = 1000
 
-withEmptyNeeds :: NeedsBuilder a b x y -> Needs x y
-withEmptyNeeds (NeedsBuilder !b) = b (Needs mempty)
+-- | Runs a 'Data.Packed.Needs.NeedsBuilder' computation. Produces a 'Data.Packed.Packed'
+{-# INLINE runBuilder #-}
+runBuilder :: NeedsBuilder p1 r '[] r -> Packed r
+runBuilder builder = unsafeDupablePerformIO $ do
+    srcNeeds <- IO $ \s -> case newAlignedPinnedByteArray# (unInt baseBufferSize) 0# s of
+        (# s', byteArray #) -> (# s', Needs byteArray (mutableByteArrayContents# byteArray) baseBufferSize #)
+    !finalNeeds <- L.withLinearIO $ L.fmap (toLinear Ur) (builder srcNeeds)
+    finish finalNeeds
 
-withNeeds :: Needs x y -> NeedsBuilder x y x1 y1 -> Needs x1 y1
-withNeeds needs (NeedsBuilder !next) = next needs
+{-# INLINE finish #-}
+finish :: Needs '[] a -> IO (Packed a)
+finish (Needs og cursor _) = do
+    let !contentLen = cursor `minusAddr#` mutableByteArrayContents# og
+    () <- IO $ \s -> case shrinkMutableByteArray# og contentLen s of
+        s' -> (# s', () #)
+    -- SRC: https://hackage.haskell.org/package/ghc-internal-9.1201.0/docs/src/GHC.Internal.ForeignPtr.html#mallocPlainForeignPtrBytes
+    let !fptr = ForeignPtr (mutableByteArrayContents# og) (PlainPtr og)
+    -- BS calls this function when alloacting an ForeignPtr, let's do that too
+    -- https://hackage-content.haskell.org/package/bytestring-0.12.2.0/docs/src/Data.ByteString.Internal.Type.html#mkDeferredByteString
+    !bs <- mkDeferredByteString fptr (I# contentLen)
+    return $! unsafeToPacked bs
 
-concatNeeds :: Needs p t -> NeedsBuilder '[] t1 p (t1 :++: t)
-concatNeeds (Needs !b) = NeedsBuilder (\(Needs s) -> Needs (s <> b))
+-- | Appends a 'Data.Needs.Needs'
+{-# INLINE concatNeeds #-}
+concatNeeds :: Needs p t %1 -> NeedsBuilder '[] t1 p (t1 :++: t)
+concatNeeds = toLinear2 appendNeeds
 
-applyNeeds :: Needs '[] t1 -> NeedsBuilder (t1 :++: r) t r t
-applyNeeds (Needs b) = NeedsBuilder (\(Needs s) -> Needs (s <> b))
+-- | Uses a 'Data.Packed.Needs.Needs' to fill in the required values for the other 'Data.Packed.Needs.Needs'
+{-# INLINE applyNeeds #-}
+applyNeeds :: Needs '[] t1 %1 -> NeedsBuilder (t1 :++: r) t r t
+applyNeeds = toLinear2 appendNeeds
 
--- | Turns a 'Needs' value (that does not expect to be written to) to a 'Data.Packed.Packed'
-finish :: Needs '[] t -> Packed t
-finish (Needs !b) = Packed (builderBytes b)
+-- | Writes a 'Storable'
+{-# INLINE writeStorable #-}
+writeStorable :: (Storable a) => a -> NeedsBuilder (a ': r) t r t
+writeStorable !a !needs = L.do
+    !newNeeds <- guardRealloc (sizeOf a) needs
+    let !(# cursor, newNeeds1 #) = getCursor newNeeds
+    () <- toLinear (\cursor' -> L.fromSystemIO (poke (Ptr cursor') a)) cursor
+    L.return (unsafeShiftNeedsPtr (sizeOf a) newNeeds1)
+
+-- Internal
+
+{-# INLINE guardRealloc #-}
+guardRealloc :: Int -> Needs p1 t1 %1 -> L.IO (Needs p1 t1)
+guardRealloc neededSpace needs =
+    if neededSpace L.> spaceLeft
+        then reallocNeeds needs1 neededSpace
+        else L.return needs1
+  where
+    !(# spaceLeft, needs1 #) = getSpaceLeft needs
+
+{-# INLINE reallocNeeds #-}
+reallocNeeds :: Needs p t %1 -> Int -> L.IO (Needs p t)
+reallocNeeds = toLinear reallocNeeds'
+
+reallocNeeds' :: Needs p t -> Int -> L.IO (Needs p t)
+reallocNeeds' (Needs origin cursor spaceLeft) additionalNeededSpace =
+    let !cursorOffset = I# $ cursor `minusAddr#` mutableByteArrayContents# origin
+        !oldBufferSize = spaceLeft + cursorOffset
+        !newBufferSize = 2 * (oldBufferSize `max` additionalNeededSpace)
+     in L.fromSystemIO
+            ( IO $ \s -> case resizeMutableByteArray# origin (unInt newBufferSize) s of
+                (# s', reallocedBA #) ->
+                    (#
+                        s'
+                        , Needs
+                            reallocedBA
+                            (mutableByteArrayContents# reallocedBA `plusAddr#` unInt cursorOffset)
+                            (newBufferSize - cursorOffset)
+                    #)
+            )
+
+{-# NOINLINE appendNeeds #-}
+appendNeeds :: Needs a b -> NeedsBuilder a' b' c d
+appendNeeds (Needs srcMa cursor _) dest = L.do
+    let !srcLen = cursor `minusAddr#` mutableByteArrayContents# srcMa
+    !reallocedDest <- guardRealloc (I# srcLen) dest
+    let %1 !(# destOg, reallocedDest1 #) = getOrigin reallocedDest
+        %1 !() = toLinear (\destAddr -> case runRW# $ copyAddrToAddr# (mutableByteArrayContents# srcMa) destAddr srcLen of !_ -> ()) destOg
+    L.return (unsafeCastNeeds reallocedDest1)
+
+-- Utils
+
+{-# INLINE unsafeWriteTag #-}
+unsafeWriteTag :: Int8 -> NeedsBuilder a b a' b
+unsafeWriteTag tag needs = writeStorable tag (unsafeCastNeeds needs)
+
+{-# INLINE unsafeShiftNeedsPtr #-}
+unsafeShiftNeedsPtr :: Int -> Needs a b %1 -> Needs a' b
+unsafeShiftNeedsPtr n (Needs og cursor spaceLeft) =
+    Needs og (toLinear2 plusAddr# cursor (unInt n)) (spaceLeft L.- n)
diff --git a/src/Data/Packed/Packable.hs b/src/Data/Packed/Packable.hs
--- a/src/Data/Packed/Packable.hs
+++ b/src/Data/Packed/Packable.hs
@@ -3,23 +3,22 @@
 
 module Data.Packed.Packable (Packable (..), pack) where
 
-import ByteString.StrictBuilder
 import Data.Packed.Needs (
-    Needs (..),
     NeedsWriter,
-    finish,
-    mkNeedsBuilder,
-    withEmptyNeeds,
+    runBuilder,
+    writeStorable,
  )
 import Data.Packed.Packed (Packed)
 import Foreign
 import Prelude hiding (length)
 
+-- | Typeclass for values that can be packed, i.e. written inside a 'Data.Packed.Needs.Needs'
 class Packable a where
     write :: a -> NeedsWriter a r t
 
 instance (Storable a) => Packable a where
-    write v = mkNeedsBuilder (\(Needs b) -> Needs (b <> storable v))
+    write = writeStorable
 
+-- | Shortcut to produce a 'Data.Packed.Packed' buffer from a single 'Packable' value
 pack :: (Packable a) => a -> Packed '[a]
-pack a = finish (withEmptyNeeds (write a))
+pack = runBuilder . write
diff --git a/src/Data/Packed/Packed.hs b/src/Data/Packed/Packed.hs
--- a/src/Data/Packed/Packed.hs
+++ b/src/Data/Packed/Packed.hs
@@ -1,20 +1,15 @@
 module Data.Packed.Packed (
     Packed (..),
     unsafeToPacked,
-    unsafeToPacked',
     fromPacked,
     unsafeCastPacked,
     duplicate,
-    getPtr,
 ) where
 
 import Control.DeepSeq
 import Data.ByteString (copy)
 import Data.ByteString.Internal
 import Data.Kind (Type)
-import Foreign.Ptr
-import GHC.Exts (Ptr (Ptr))
-import GHC.ForeignPtr
 
 -- | A buffer that contains one or more packed (i.e. serialised) values.
 -- The order of the values in the buffer is defined by the 'l' type list
@@ -44,9 +39,3 @@
 -- | UNSAFE: Casts a typed 'Packed' value into another 'Packed' value of another type
 unsafeCastPacked :: Packed a -> Packed b
 unsafeCastPacked = unsafeToPacked . fromPacked
-
-unsafeToPacked' :: Ptr a -> Int -> Packed b
-unsafeToPacked' (Ptr addr) l = Packed (BS (ForeignPtr addr FinalPtr) l)
-
-getPtr :: Packed a -> Ptr b
-getPtr p = let BS fptr _ = fromPacked p in castPtr $ unsafeForeignPtrToPtr fptr
diff --git a/src/Data/Packed/Reader.hs b/src/Data/Packed/Reader.hs
--- a/src/Data/Packed/Reader.hs
+++ b/src/Data/Packed/Reader.hs
@@ -1,7 +1,9 @@
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE MagicHash #-}
 {-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE UnboxedTuples #-}
 
 -- |
 -- It is recommended to import this module like so:
@@ -13,28 +15,42 @@
     PackedReader (..),
     mkPackedReader,
     runReader,
+
+    -- * Applicative
+    pure,
+    liftA,
+    liftA2,
+    (<*>),
+    (*>),
+    (<*),
+
+    -- * Monad
     (>>=),
     (>>),
-    lift,
     fail,
     return,
-    ReaderPtr,
-    finishReader,
+    lift,
+
+    -- * Application
+    with,
+    threadedWith,
+
+    -- * Fragments
+    PackedFragment (..),
+    castPackedFragment,
 ) where
 
+import Control.Monad.Identity
+import Data.Bifunctor
 import Data.ByteString.Internal
-import Data.Packed.Needs (Needs, finish)
+import Data.Kind
+import Data.Packed.Internal
 import Data.Packed.Packed
 import Data.Packed.Utils ((:++:))
-import Data.Word (Word8)
-import Foreign.ForeignPtr (newForeignPtr_)
-import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)
-import Foreign.Ptr
-import Prelude hiding (fail, return, (>>), (>>=))
+import Foreign hiding (with)
+import Prelude hiding (fail, liftA2, pure, return, (*>), (<*), (<*>), (>>), (>>=))
 import qualified Prelude
 
-type ReaderPtr r = Ptr Word8
-
 -- | Basically a function that reads/desrialises a value from a 'Data.Packed.Packed'
 --
 -- 'p' the types of the packed values to read
@@ -45,42 +61,86 @@
 --
 -- __Note:__ It is an indexed monad.
 newtype PackedReader p r v = PackedReader
-    { runPackedReader ::
-        ReaderPtr (p :++: r) ->
-        Int ->
-        IO (v, ReaderPtr r, Int)
+    { runReaderStep :: PackedFragment (p :++: r) -> Identity (v, PackedFragment r)
     }
 
+-- | Represents position of the cursor in the packed buffer to traverse
+data PackedFragment (p :: [Type])
+    = PF
+        -- | Pointer in the packed buffer
+        {-# UNPACK #-} !(Ptr Word8)
+        -- | Number of bytes between the cursor's position and the end of the buffer
+        {-# UNPACK #-} !Int
+
+{-# INLINE castPackedFragment #-}
+castPackedFragment :: PackedFragment p -> PackedFragment t
+castPackedFragment (PF p t) = PF p t
+
 {-# INLINE mkPackedReader #-}
 
--- | Builds a 'PackedReader'
+-- | Builds a 'Data.Packed.Reader.PackedReader'
 mkPackedReader ::
-    ( ReaderPtr (p :++: r) ->
-      Int ->
-      IO (v, ReaderPtr r, Int)
-    ) ->
+    (PackedFragment (p :++: r) -> Identity (v, PackedFragment r)) ->
     PackedReader p r v
 mkPackedReader = PackedReader
 
 instance Functor (PackedReader p r) where
     {-# INLINE fmap #-}
-    fmap f (PackedReader reader) = PackedReader $ \ptr l -> do
-        (!n, !rest, !l1) <- reader ptr l
-        Prelude.return (f n, rest, l1)
+    fmap f (PackedReader reader) = PackedReader $ fmap (first f) . reader
 
-{-# INLINE (>>=) #-}
+-------- Applicative
 
+-- | Similar to 'Control.Applicative.pure'
+{-# INLINE pure #-}
+pure :: v -> PackedReader '[] r v
+pure = return
+
+-- | Similar to 'Control.Applicative.liftA'
+{-# INLINE liftA #-}
+liftA :: (a -> b) -> PackedReader p t a -> PackedReader p t b
+liftA = fmap
+
+-- | Similar to 'Control.Applicative.liftA2'
+{-# INLINE liftA2 #-}
+liftA2 ::
+    (v1 -> v2 -> v3) ->
+    PackedReader p (r1 :++: r2) v1 ->
+    PackedReader r1 r2 v2 ->
+    PackedReader (p :++: r1) r2 v3
+liftA2 f m1 m2 = PackedReader $ \pf -> do
+    (!v1, !pf1) <- runReaderStep m1 (castPackedFragment pf)
+    (!v2, !pf2) <- runReaderStep m2 pf1
+    Prelude.return (f v1 v2, pf2)
+
+-- | Similar to 'Control.Applicative.<*>'
+{-# INLINE (<*>) #-}
+(<*>) :: PackedReader p (r1 :++: r2) (v1 -> v2) -> PackedReader r1 r2 v1 -> PackedReader (p :++: r1) r2 v2
+(<*>) = liftA2 id
+
+-- | Similar to 'Control.Applicative.*>'
+{-# INLINE (*>) #-}
+(*>) :: PackedReader p (r1 :++: r2) v -> PackedReader r1 r2 v' -> PackedReader (p :++: r1) r2 v'
+(*>) = (>>)
+
+-- | Similar to 'Control.Applicative.<*'
+{-# INLINE (<*) #-}
+(<*) :: PackedReader p (r1 :++: r2) v2 -> PackedReader r1 r2 v1 -> PackedReader (p :++: r1) r2 v2
+(<*) = liftA2 const
+
+-------- Monad
+
 -- | Allows bindings 'Data.Packed.Reader.PackedReader' together, in a monad-like manner.
 --
 -- Similar to 'Prelude.>>='
+{-# INLINE (>>=) #-}
 (>>=) ::
     PackedReader p (r1 :++: r2) v ->
     (v -> PackedReader r1 r2 v') ->
     PackedReader (p :++: r1) r2 v'
-(>>=) m1 m2 = PackedReader $ \packed l -> do
-    (!value, !packed1, !l1) <- runPackedReader m1 packed l
-    (!res, !rest, !l2) <- runPackedReader (m2 value) packed1 l1
-    Prelude.return (res, rest, l2)
+(>>=) pr1 next = PackedReader $ \pf ->
+    let Identity (!v1, !pf1) = runReaderStep pr1 (castPackedFragment pf)
+        PackedReader !pr2 = next v1
+     in pr2 pf1
 
 {-# INLINE (>>) #-}
 
@@ -89,68 +149,70 @@
     PackedReader p (r1 :++: r2) v ->
     PackedReader r1 r2 v' ->
     PackedReader (p :++: r1) r2 v'
-(>>) m1 m2 = PackedReader $ \packed l -> do
-    (!_, !packed1, !l1) <- runPackedReader m1 packed l
-    runPackedReader m2 packed1 l1
+(>>) pr1 (PackedReader pr2) = PackedReader $ \pf ->
+    let
+        Identity (!_, !pf1) = runReaderStep pr1 (castPackedFragment pf)
+     in
+        pr2 pf1
 
 {-# INLINE return #-}
 
--- | Like 'Prelude.return', wraps a value in a 'PackedReader' that will not consume its input.
+-- | Like 'Prelude.return', wraps a value in a 'Data.Packed.Reader.PackedReader' that will not consume its input.
 return :: v -> PackedReader '[] r v
-return value = PackedReader $ \(!packed) !l ->
-    Prelude.return (value, packed, l)
+return !value = PackedReader $ \(!pf) -> Identity (value, pf)
 
+-- | Interrupts a 'Data.Packed.Reader.PackedReader' computation
 {-# INLINE fail #-}
 fail :: String -> PackedReader '[] r v
-fail msg = mkPackedReader $ \_ _ -> Prelude.fail msg
+fail msg = mkPackedReader $ \_ -> error msg
 
--- | Allows reading another packed value in a do-notation.
+-- | Run the reading function using a 'Data.Packed.Packed'.
+{-# INLINE runReader #-}
+runReader ::
+    PackedReader p r v ->
+    Packed (p :++: r) ->
+    (v, Packed r)
+runReader pr (Packed (BS fptr l)) =
+    unsafeDupablePerformIO
+        ( withForeignPtr fptr $ \ptr -> do
+            let Identity (!v, !(PF ptr1 l1)) = runReaderStep pr (PF (castPtr ptr) l)
+            !fptr1 <- newForeignPtr_ ptr1
+            Prelude.return (v, Packed (BS fptr1 l1))
+        )
+
+-- | Consumes the input 'Data.Packed.Reader.PackedFragment'.
 --
--- The reading of the second stream does not consume anything from the first.
+-- To be used inside a 'Data.Packed.Reader.PackedReader' computation.
 --
--- __Example__:
+-- Example:
 --
 -- @
--- import qualified Data.Packed.Reader as R
--- data Tree a = Leaf | Node (Tree a) a (Tree a)
---
--- packedTreeToList :: 'PackedReader' '[Tree Int] '[] [Int]
--- packedTreeToList = go []
---     where
---         go l =
---             caseTree
---                 (R.return l)
---                 ( R.do
---                     packedLeft <- 'Data.Packed.isolate'
---                     n <- 'Data.Packed.readerWithFieldSize'
---                     packedRight <- 'Data.Packed.isolate'
---                     -- Using lift allows consuming the packedRight value
---                     rightList <- R.'lift' (go l) packedRight
---                     R.'lift' (go $ n : rightList) packedLeft
---                 )
+-- sumPacked :: PackedReader '[Tree Int] r Int
+-- sumPacked = PackedReader $ \case
+--     PackedLeaf l -> reader `with` l
+--     PackedNode n -> threadedWith n $ R.do
+--         !left <- sumPacked2
+--         !right <- sumPacked2
+--         let !res = left + right
+--         R.return res
 -- @
+{-# INLINE with #-}
+with :: PackedReader p r v -> PackedFragment (p :++: r) -> Identity (v, PackedFragment r)
+with = runReaderStep
+
+-- | Flipped version of 'with'
+{-# INLINE threadedWith #-}
+threadedWith :: PackedFragment (p :++: r) -> PackedReader p r v -> Identity (v, PackedFragment r)
+threadedWith = flip with
+
+-- | Allows running a 'Data.Packed.Reader.PackedReader' computation inside an other
 {-# INLINE lift #-}
 lift ::
     PackedReader a b v ->
-    Packed (a :++: b) ->
+    PackedFragment (a :++: b) ->
     PackedReader '[] r v
-lift r p = mkPackedReader $ \old l -> do
-    (!res, _) <- runReader r p
-    Prelude.return (res, old, l)
-
--- | Run the reading function using a ByteString.
-{-# INLINE runReader #-}
-runReader ::
-    PackedReader p r v ->
-    Packed (p :++: r) ->
-    IO (v, Packed r)
-runReader (PackedReader f) (Packed (BS fptr l)) = do
-    (!v, !ptr1, !l1) <- f (castPtr $ unsafeForeignPtrToPtr fptr) l
-    !fptr1 <- newForeignPtr_ ptr1
-    Prelude.return (v, Packed (BS fptr1 l1))
-
-{-# INLINE finishReader #-}
-
--- | Util function that calls 'Data.Packed.finish' on the value produced by the input 'PackedReader'
-finishReader :: PackedReader p r (Needs '[] a) -> PackedReader p r (Packed a)
-finishReader r = finish <$> r
+lift r p = mkPackedReader $ \pf ->
+    let
+        Identity !(!res, !_) = runReaderStep r p
+     in
+        Identity (res, pf)
diff --git a/src/Data/Packed/Skippable.hs b/src/Data/Packed/Skippable.hs
--- a/src/Data/Packed/Skippable.hs
+++ b/src/Data/Packed/Skippable.hs
@@ -6,7 +6,7 @@
 module Data.Packed.Skippable (Skippable (..), unsafeSkipN) where
 
 import Data.Kind
-import Data.Packed.Reader
+import Data.Packed.Reader hiding (return)
 import Foreign (plusPtr)
 import Foreign.Storable
 
@@ -23,4 +23,4 @@
 
 -- | UNSAFE: Shifts the cursor to n bytes to the right.
 unsafeSkipN :: forall (a :: [Type]) (r :: [Type]). Int -> PackedReader a r ()
-unsafeSkipN n = mkPackedReader $ \ptr l -> Prelude.return ((), ptr `plusPtr` n, l - n)
+unsafeSkipN n = mkPackedReader $ \(PF ptr l) -> return ((), PF (ptr `plusPtr` n) (l - n))
diff --git a/src/Data/Packed/TH.hs b/src/Data/Packed/TH.hs
--- a/src/Data/Packed/TH.hs
+++ b/src/Data/Packed/TH.hs
@@ -13,6 +13,9 @@
     -- * Generate Case function
     genCase,
 
+    -- * Generate Patterns
+    genPatterns,
+
     -- * Generate Packing function
     genPackableInstance,
     genConstructorPackers,
@@ -40,6 +43,7 @@
 import Data.Packed.TH.Flag
 import Data.Packed.TH.PackCon (genConstructorPackers)
 import Data.Packed.TH.Packable
+import Data.Packed.TH.Pattern
 import Data.Packed.TH.Read
 import Data.Packed.TH.RepackCon
 import Data.Packed.TH.Skip
@@ -75,6 +79,7 @@
     [PackingFlag] ->
     Q [Dec]
 mkPacked tyName flags = do
+    patterns <- genPatterns flags tyName
     caseFunction <- genCase flags tyName
     packableInstance <- genPackableInstance flags tyName
     unpackableInstance <- genUnpackableInstance flags tyName
@@ -83,7 +88,8 @@
     skipInstance <- genSkippableInstance flags tyName
     transformFunction <- genTransform flags tyName
     return $
-        caseFunction
+        patterns
+            ++ caseFunction
             ++ packableInstance
             ++ unpackableInstance
             ++ constructorPackers
diff --git a/src/Data/Packed/TH/Case.hs b/src/Data/Packed/TH/Case.hs
--- a/src/Data/Packed/TH/Case.hs
+++ b/src/Data/Packed/TH/Case.hs
@@ -1,15 +1,22 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE ExtendedLiterals #-}
+{-# LANGUAGE MagicHash #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE UnboxedTuples #-}
 
 module Data.Packed.TH.Case (caseFName, genCase) where
 
 import Data.Packed.Reader hiding (return)
 import Data.Packed.TH.Flag
-import Data.Packed.TH.Utils (Tag, getBranchesTyList, getNameAndBangTypesFromCon, resolveAppliedType, sanitizeConName)
+import Data.Packed.TH.Pattern (patternFName)
+import Data.Packed.TH.Utils (getBranchesTyList, getNameAndBangTypesFromCon, resolveAppliedType, sanitizeConName)
 import Language.Haskell.TH
 
 caseFName :: Name -> Name
 caseFName tyName = mkName $ "case" ++ sanitizeConName tyName
 
+-- TODO Use generated patterns
+
 -- | Generates a function to allow pattern matching a packed data type using the data constructors
 --
 --  __Example:__
@@ -21,12 +28,9 @@
 --     ('Data.Packed.PackedReader' '[a] r b) ->
 --     ('Data.Packed.PackedReader' '[Tree a, Tree a] r b) ->
 --     'Data.Packed.PackedReader' '[Tree a] r b
--- caseTree leafCase nodeCase = 'Data.Packed.Reader.mkPackedReader' $ \packed l -> do
---    (tag :: 'Tag', packed1, l1) <- 'Data.Packed.Unpackable.runReader' 'Data.Packed.reader' packed l
---    case tag of
---        0 -> 'Data.Packed.Reader.runReader' leafCase packed1 l1
---        1 -> 'Data.Packed.Reader.runReader' nodeCase packed1 l1
---        _ -> fail "Bad Tag"
+-- caseTree leafCase nodeCase = 'Data.Packed.Reader.mkPackedReader' $ \case
+--      PackedLeaf l -> 'runReaderStep' leafCase l
+--      PackedNode l -> 'runReaderStep' nodeCase l
 -- @
 genCase ::
     [PackingFlag] ->
@@ -35,49 +39,36 @@
     Q [Dec]
 genCase flags tyName = do
     (TyConI (DataD _ _ _ _ cs _)) <- reify tyName
-    packedName <- newName "packed"
     -- For each data constructor, we build names for the pattern for the case functions
     -- Example: leafCase, nodeCase, etc.
-    let casePatterns = buildCaseFunctionName <$> cs
-    body <- buildBody casePatterns packedName
+    let casePatterns = buildCaseCallbackNameAndPattern <$> cs
+    body <- [|PackedReader $ $(buildCaseExpression casePatterns)|]
     signature <- genCaseSignature flags tyName
     return
-        [ signature
+        [ PragmaD $ InlineP (caseFName tyName) Inline FunLike AllPhases
+        , signature
         , FunD
             (caseFName tyName)
-            [Clause (VarP <$> casePatterns) (NormalB body) []]
+            [Clause (VarP . snd <$> casePatterns) (NormalB body) []]
         ]
   where
-    -- Build the body (the do, binding and case expressions)
-    buildBody casePatterns packedName =
-        let bytes1VarName = mkName "b"
-            length1VarName = mkName "l"
-            flagVarName = mkName "flag"
-         in do
-                caseExpression <- buildCaseExpression flagVarName casePatterns bytes1VarName length1VarName
-                [|
-                    mkPackedReader $ \($(varP packedName)) l' -> do
-                        ($(varP flagVarName), $(varP bytes1VarName), $(varP length1VarName)) <- runPackedReader reader $(varE packedName) l'
-                        $(return caseExpression)
-                    |]
     -- for dataconstructor Leaf, will be 'leafCase'
-    buildCaseFunctionName = conNameToCaseFunctionName . fst . getNameAndBangTypesFromCon
+    buildCaseCallbackNameAndPattern = (\name -> (patternFName name, conNameToCaseFunctionName name)) . fst . getNameAndBangTypesFromCon
     conNameToCaseFunctionName conName = mkName $ 'c' : (sanitizeConName conName) ++ "Case"
 
     -- Build the case .. of ... expression using the list of available xxxCase, the flag and bytestring
-    buildCaseExpression :: Name -> [Name] -> Name -> Name -> Q Exp
-    buildCaseExpression e casePatterns bytesVarName lengthVarName =
+    buildCaseExpression :: [(Name, Name)] -> Q Exp
+    buildCaseExpression casePatterns =
         -- For each xxxCase, we build a branch for the case expression
         let matches =
-                ( \(conIndex, caseFuncName) -> do
-                    body <- [|runPackedReader $(varE caseFuncName) $(varE bytesVarName) $(varE lengthVarName)|]
-                    return $ Match (LitP $ IntegerL conIndex) (NormalB body) []
+                ( \(patternName, caseCallbackName) -> do
+                    let r = mkName "r"
+                    body <- [|runReaderStep $(varE caseCallbackName) $(varE r)|]
+                    let pat = ConP patternName [] [VarP r]
+                    return $ Match pat (NormalB body) []
                 )
-                    <$> zip [0 ..] casePatterns
-            fallbackMatch = do
-                fallbackBody <- [|Prelude.fail "Bad Tag"|]
-                return $ Match WildP (NormalB fallbackBody) []
-         in caseE [|$(varE e) :: Tag|] $ matches ++ [fallbackMatch]
+                    <$> casePatterns
+         in lamCaseE matches
 
 -- For a type 'Tree', generates the following signature
 -- caseTree ::
diff --git a/src/Data/Packed/TH/PackCon.hs b/src/Data/Packed/TH/PackCon.hs
--- a/src/Data/Packed/TH/PackCon.hs
+++ b/src/Data/Packed/TH/PackCon.hs
@@ -17,11 +17,11 @@
 -- For the 'Tree' data type, it generates the following functions
 --
 -- @
--- packLeaf :: ('Packable' a) => a -> 'Data.Packed' '[Tree a]
--- packLeaf n = 'finish' ('withEmptyNeeds' (writeLeaf n))
+-- packLeaf :: ('Packable' a) => a -> ('Data.Packed' '[Tree a])
+-- packLeaf n = 'runBuilder' (writeLeaf n)
 --
--- packNode :: ('Packable' a) => Tree a -> Tree a -> 'Data.Packed' '[Tree a]
--- packNode t1 t2 = 'finish' ('withEmptyNeeds' (writeNode t1 t2))
+-- packNode :: ('Packable' a) => Tree a -> Tree a -> ('Data.Packed' '[Tree a])
+-- packNode t1 t2 = 'runBuilder' (writeNode t1 t2)
 -- @
 genConstructorPackers :: [PackingFlag] -> Name -> Q [Dec]
 genConstructorPackers flags tyName = do
@@ -42,7 +42,7 @@
 genConstructorPacker flags conName argTypes = do
     varNames <- mapM (\_ -> newName "t") argTypes
     writeExp <- (foldl (\rest p -> appE rest (varE p)) (varE $ conWriteFName conName) varNames)
-    body <- [|finish (withEmptyNeeds $(return writeExp))|]
+    body <- [|runBuilder $(return writeExp)|]
     signature <- genConstructorPackerSig flags conName argTypes
     return
         [ signature
@@ -54,5 +54,5 @@
     (DataConI _ _ tyName) <- reify conName
     (ty, typeParameterNames) <- resolveAppliedType tyName
     constraints <- mapM (\tyVarName -> [t|Packable $(varT tyVarName)|]) typeParameterNames
-    signature <- foldr (\p rest -> [t|$(return p) -> $rest|]) [t|Packed '[$(return ty)]|] argTypes
+    signature <- foldr (\p rest -> [t|$(return p) -> $rest|]) [t|(Packed '[$(return ty)])|] argTypes
     return $ SigD (packConFName conName) $ ForallT [] constraints signature
diff --git a/src/Data/Packed/TH/Pattern.hs b/src/Data/Packed/TH/Pattern.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Packed/TH/Pattern.hs
@@ -0,0 +1,132 @@
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
+
+module Data.Packed.TH.Pattern (genPatterns, patternFName, tagReaderFName) where
+
+import Control.Monad (forM)
+import Data.Packed.Reader (PackedFragment (..))
+import Data.Packed.TH.Flag (PackingFlag (..))
+import Data.Packed.TH.Utils
+import GHC.Exts
+import GHC.Ptr
+import Language.Haskell.TH
+
+-- | Generates patterns for packed values of the given type
+--
+--  __Example:__
+--
+-- For the 'Tree' data type, it generates the following patterns:
+--
+-- @
+-- PackedLeaf :: (PackedFragment (a ': r)) -> PackedFragment (Tree a ': r)
+--
+-- PackedNode :: (PackedFragment (Tree A ': Tree a ': r)) -> PackedFragment (Tree a ': r)
+-- @
+--
+-- More specifically, it generates the following code:
+--
+-- @
+--
+-- {-# INLINE readTreeTag #-}
+-- readTreeTag :: PackedFragment (Tree a ': r) -> (# Word8#, PackedFragment n #)
+-- readTreeTag (PF ptr@(Ptr addr) i) = case readWord8OffAddr# addr 0# realWorld# of
+--     (# _, t #) -> case t of
+--         0 -> (# t, PF (ptr `plusPtr` 1) (i - 1) #)
+--         1 -> (# t, PF (ptr `plusPtr` 1) (i - 1) #)
+--         _ -> error $ "Bag tag: Got " ++ show (W8# t)
+--
+-- {-# INLINE PackedLeaf #-}
+-- pattern PackedLeaf :: PackedFragment (a ': r) -> 'PackedFragment' (Tree a ': r)
+-- pattern PackedLeaf pf <- (readTreeTag -> (# 0, pf #))
+--
+-- {-# INLINE PackedNode #-}
+-- pattern PackedNode :: 'PackedFragment' (Tree a ': Tree a ': r) -> 'PackedFragment' (Tree a ': r)
+-- pattern PackedNode pf <- (readTreeTag -> (# 1, pf #))
+--
+-- {-# COMPLETE PackedLeaf, PackedNode #-}
+-- @
+genPatterns :: [PackingFlag] -> Name -> Q [Dec]
+genPatterns flags tyName = do
+    (TyConI (DataD _ _ _ _ cs _)) <- reify tyName
+    patterns <- concat <$> forM (zip cs [0 ..]) (uncurry (genPattern flags tyName))
+    tagReader <- genTagReader flags tyName
+    let completePragma =
+            let
+                patternNames = patternFName . fst . getNameAndBangTypesFromCon <$> cs
+             in
+                CompleteP patternNames Nothing
+    return $ tagReader ++ patterns ++ [PragmaD completePragma]
+
+genPattern :: [PackingFlag] -> Name -> Con -> Integer -> Q [Dec]
+genPattern flags tyName con conIdx = do
+    let patternName = patternFName $ fst $ getNameAndBangTypesFromCon con
+    pfName <- newName "pf"
+    (ty, _) <- resolveAppliedType tyName
+    rVar <- newName "r"
+    conArgTypes <- getBranchTyList con flags
+    patternType <- do
+        patternFieldType <- foldr (\curr rest -> [t|$(return curr) ': $rest|]) (varT rVar) conArgTypes
+        fromType <- [t|$(return ty) ': $(varT rVar)|]
+        [t|PackedFragment ($(return patternFieldType)) -> PackedFragment ($(return fromType))|]
+    let patSynSig =
+            PatSynSigD
+                patternName
+                patternType
+    patSyn <- do
+        let viewPat = [p|(# $(litP $ WordPrimL conIdx), $(varP pfName) #)|]
+        patSynD
+            patternName
+            (prefixPatSyn [pfName])
+            unidir
+            (viewP (varE $ tagReaderFName tyName) viewPat)
+
+    return
+        [ PragmaD (InlineP patternName Inline FunLike AllPhases)
+        , patSynSig
+        , patSyn
+        ]
+
+patternFName :: Name -> Name
+patternFName name = mkName $ "Packed" ++ sanitizeConName name
+
+genTagReader :: [PackingFlag] -> Name -> Q [Dec]
+genTagReader flags tyName = do
+    rType <- newName "r"
+    (ty, _) <- resolveAppliedType tyName
+    conTypes <- getBranchesTyList tyName flags
+    let fName = tagReaderFName tyName
+    prototype <-
+        let
+            inType = [t|PackedFragment ($(return ty) ': $(varT rType))|]
+            outType = [t|(# Word#, PackedFragment $(varT $ mkName "n") #)|]
+         in
+            [t|$inType -> $outType|]
+    (pat, body) <- do
+        let addrName = mkName "addr"
+            ptrName = mkName "ptr"
+            lengthName = mkName "l"
+            tagVarName = mkName "t"
+        readWordExp <- [|readWord8OffAddr# $(varE addrName) 0# realWorld#|]
+        caseBranches <- forM (zip [0 ..] conTypes) $ \(conIdx, _) -> do
+            tName <- newName "t"
+            let pat = AsP tName (LitP $ WordPrimL conIdx)
+            branchExp <- [|(# $(varE tName), PF ($(varE ptrName) `plusPtr` 1) ($(varE lengthName) - 1) #)|]
+            return $ Match pat (NormalB branchExp) []
+        errorBranch <- do
+            tName <- newName "t"
+            match (asP tName wildP) (normalB [|error $ "Bad tag, got " ++ show (W# $(varE tName))|]) []
+        let caseExpr = caseE [|word8ToWord# $(varE tagVarName)|] (return <$> (caseBranches ++ [errorBranch]))
+        body <- [|case $(return readWordExp) of (# _, $(varP tagVarName) #) -> $caseExpr|]
+        pattern_ <- do
+            ptrPattern <- asP ptrName [p|Ptr $(varP addrName)|]
+            [p|(PF $(return ptrPattern) $(varP lengthName))|]
+        return (pattern_, body)
+
+    return
+        [ PragmaD (InlineP fName Inline FunLike AllPhases)
+        , SigD fName prototype
+        , FunD fName [Clause [pat] (NormalB body) []]
+        ]
+
+tagReaderFName :: Name -> Name
+tagReaderFName tyName = mkName $ "read" ++ sanitizeConName tyName ++ "Tag"
diff --git a/src/Data/Packed/TH/RepackCon.hs b/src/Data/Packed/TH/RepackCon.hs
--- a/src/Data/Packed/TH/RepackCon.hs
+++ b/src/Data/Packed/TH/RepackCon.hs
@@ -1,8 +1,9 @@
 module Data.Packed.TH.RepackCon (genConstructorRepackers) where
 
 import Data.Packed.FieldSize
-import Data.Packed.Needs (Needs, applyNeeds, withEmptyNeeds)
+import Data.Packed.Needs (Needs, applyNeeds)
 import qualified Data.Packed.Needs as N
+import Data.Packed.Packed (Packed)
 import Data.Packed.TH.Flag
 import Data.Packed.TH.Start (startFName)
 import Data.Packed.TH.Utils
@@ -15,11 +16,11 @@
 -- For the 'Tree' data type, it generates the following functions
 --
 -- @
--- repackLeaf :: 'Data.Packed.Needs' '[] a -> 'Data.Packed.Needs' '[] (Tree a)
+-- repackLeaf :: 'Data.Packed.Needs' '[] a -> ('Data.Packed.Packed' '[Tree a])
 -- repackLeaf pval = withEmptyNeeds (startLeaf N.>> 'Data.Packed.Needs.concatNeeds' pval)
 --
--- repackNode :: 'Data.Packed.Needs' '[] (Tree a) -> 'Data.Packed.Needs' '[] (Tree a) -> 'Data.Packed.Needs' '[] (Tree a)
--- repackNode lval rval = withEmptyNeeds (startNode N.>> 'concatNeeds' lval N.>> 'concatNeeds' rval)
+-- repackNode :: 'Data.Packed.Needs' '[] (Tree a) -> 'Data.Packed.Needs' '[] (Tree a) -> ('Data.Packed.Packed  '[Tree a])
+-- repackNode lval rval needs = N.runBuilder (startNode needs N.>>= 'Data.Packed.Needs.concatNeeds' lval N.>>= 'concatNeeds' rval)
 -- @
 genConstructorRepackers :: [PackingFlag] -> Name -> Q [Dec]
 genConstructorRepackers flags tyName = do
@@ -34,18 +35,19 @@
 genConstructorRepacker flags con = do
     let conName = fst $ getNameAndBangTypesFromCon con
         fieldTypes = getConFieldsIdxAndNeedsFS con flags
+        needsName = mkName "needs"
     varNames <- mapM (\_ -> newName "t") fieldTypes
     writeExp <-
         let concated =
                 foldl
                     ( \rest ((_, _, needsFieldSize), varName) ->
                         if needsFieldSize
-                            then [|($rest) N.>> applyNeedsWithFieldSize $(varE varName)|]
-                            else [|($rest) N.>> applyNeeds $(varE varName)|]
+                            then [|($rest) N.>>= applyNeedsWithFieldSize $(varE varName)|]
+                            else [|($rest) N.>>= applyNeeds $(varE varName)|]
                     )
-                    [|$(varE $ startFName conName)|]
+                    [|$(varE $ startFName conName) $(varE needsName)|]
                     (zip fieldTypes varNames)
-         in [|withEmptyNeeds $concated|]
+         in [|N.runBuilder $ \($(varP needsName)) -> $concated|]
     signature <- genConstructorPackerSig flags conName ((\(t, _, _) -> t) <$> fieldTypes)
     return
         [ signature
@@ -56,5 +58,5 @@
 genConstructorPackerSig _ conName argTypes = do
     (DataConI _ _ tyName) <- reify conName
     (ty, _) <- resolveAppliedType tyName
-    signature <- foldr (\p rest -> [t|Needs '[] '[$(return p)] -> $rest|]) [t|Needs '[] '[$(return ty)]|] argTypes
+    signature <- foldr (\p rest -> [t|Needs '[] '[$(return p)] -> $rest|]) [t|Packed '[$(return ty)]|] argTypes
     return $ SigD (repackConFName conName) $ ForallT [] [] signature
diff --git a/src/Data/Packed/TH/Start.hs b/src/Data/Packed/TH/Start.hs
--- a/src/Data/Packed/TH/Start.hs
+++ b/src/Data/Packed/TH/Start.hs
@@ -1,10 +1,8 @@
 module Data.Packed.TH.Start (startFName, genStart) where
 
 import Data.Packed.Needs
-import Data.Packed.Packable (write)
 import Data.Packed.TH.Flag (PackingFlag (..))
 import Data.Packed.TH.Utils
-import Data.Word (Word8)
 import Language.Haskell.TH
 
 -- | For a constructor 'Leaf', will generate the function name 'startLeaf'
@@ -19,10 +17,10 @@
 --
 -- @
 -- startLeaf :: NeedsBuilder (Tree a ': r) t (a ': r) t
--- startLeaf = 'mkNeedsBuilder' (\n -> runBuilder (write (0 :: Word8) ('unsafeCastNeeds' n)))
+-- startLeaf = 'unsafeWriteTag' 0
 --
 -- startNode :: NeedsBuilder (Tree a ': r) t (Tree a ': Tree a ': r) t
--- startNode = 'mkNeedsBuilder' (\n -> runBuilder (write (1 :: Word8) ('unsafeCastNeeds' n)))
+-- startNode = 'unsafeWriteTag' 1
 -- @
 genStart ::
     [PackingFlag] ->
@@ -42,7 +40,7 @@
             destNeedsTypeParams = foldr (\field rest -> [t|$(return field) ': $rest|]) r branchType
             parentType = getParentTypeFromConstructorType conType
          in [t|NeedsBuilder ($(return parentType) ': $r) $t $destNeedsTypeParams $t|]
-    expr <- [|mkNeedsBuilder (\n -> runBuilder (write (tag :: Word8)) (unsafeCastNeeds n))|]
+    expr <- [|unsafeWriteTag $(litE $ IntegerL $ fromIntegral tag)|]
     return
         [ SigD fName sig
         , FunD fName [Clause [] (NormalB expr) []]
diff --git a/src/Data/Packed/TH/Transform.hs b/src/Data/Packed/TH/Transform.hs
--- a/src/Data/Packed/TH/Transform.hs
+++ b/src/Data/Packed/TH/Transform.hs
@@ -1,8 +1,8 @@
 module Data.Packed.TH.Transform (transformFName, genTransform) where
 
+import Control.Monad
 import Data.Maybe (catMaybes)
 import Data.Packed.FieldSize (FieldSize)
-import Data.Packed.Needs (withEmptyNeeds)
 import qualified Data.Packed.Needs as N
 import Data.Packed.Reader (PackedReader)
 import qualified Data.Packed.Reader as R
@@ -19,13 +19,14 @@
 -- For a type 'Tree', generates the following function
 --
 -- transformTree ::
---     ('Data.Packed.Reader.PackedReader' '[a] r ('Data.Packed.Needs.NeedsBuilder' '[a] '[Tree a] '[] '[Tree a])) ->
 --
---     ('Data.Packed.Reader.PackedReader' '[Tree a, Tree a] r ('Data.Packed.Needs.NeedsBuilder' '[Tree a, Tree a] '[Tree a] '[] '[Tree a])) ->
---     'Data.Packed.PackedReader' '[Tree a] r ('Data.Packed.Needs' '[] '[Tree a])
+--     ('Data.Packed.Reader.PackedReader' '[a] r ('Data.Packed.Needs.NeedsBuilder' (a ': r1) '[Tree a] r1 '[Tree a])) ->
+--
+--     ('Data.Packed.Reader.PackedReader' '[Tree a, Tree a] r ('Data.Packed.Needs.NeedsBuilder' (Tree a ': Tree a ': r1) '[Tree a] r1 '[Tree a])) ->
+--     'Data.Packed.PackedReader' '[Tree a] r ('Data.Packed.NeedsBuilder' (Tree a ': r1) '[Tree a] r1 '[Tree a])
 -- transformTree leafCase nodeCase = caseTree
---      (leafCase R.>>= \l -> 'Data.Packed.Needs.finish' ('Data.Packed.Needs.withEmptyNeeds' (startLeaf 'Data.Packed.Needs.>>' l)))
---      (nodeCase R.>>= \n -> 'Data.Packed.Needs.finish' ('Data.Packed.Needs.withEmptyNeeds' (startNode 'Data.Packed.Needs.>>' n)))
+--      (leafCase R.>>= \l -> return (startLeaf 'Data.Packed.Needs.>=>' l))
+--      (nodeCase R.>>= \n -> return (startNode 'Data.Packed.Needs.>=>' n)))
 genTransform :: [PackingFlag] -> Name -> Q [Dec]
 genTransform flags tyName = do
     signature <- genTransformSignature flags tyName
@@ -35,10 +36,18 @@
             ( \rest curr ->
                 let caseName = buildCaseFunctionName curr
                  in if not $ conHasArguments curr
-                        then [|$rest (R.return (withEmptyNeeds $(varE (startFNameForCon curr))))|]
-                        else [|$rest ($(varE caseName) R.>>= \resWriter -> R.return (withEmptyNeeds ($(varE (startFNameForCon curr)) N.>> resWriter)))|]
+                        then [|$rest (R.return $(varE (startFNameForCon curr)))|]
+                        else
+                            [|
+                                $rest
+                                    ( $(varE caseName)
+                                        R.>>= \resWriter ->
+                                            R.return
+                                                (($(varE (startFNameForCon curr)) N.>=> resWriter))
+                                    )
+                                |]
             )
-            (varE $ caseFNameForType tyName)
+            (varE $ caseFName tyName)
             cs
     return
         [ signature
@@ -49,55 +58,56 @@
   where
     -- for dataconstructor Leaf, will be 'leafCase'
     buildCaseFunctionName = conNameToCaseFunctionName . fst . getNameAndBangTypesFromCon
-    conNameToCaseFunctionName conName = mkName $ "case" ++ (sanitizeConName conName)
+    conNameToCaseFunctionName conName = mkName $ "case_" ++ (sanitizeConName conName)
 
     startFNameForCon = startFName . fst . getNameAndBangTypesFromCon
-    caseFNameForType = caseFName
     conHasArguments = not . null . snd . getNameAndBangTypesFromCon
 
 -- For a type 'Tree', generates the following signature
 -- transformTree ::
---     ('Data.Packed.Reader.PackedReader' '[a] r ('Data.Packed.Needs.NeedsBuilder' '[a] '[Tree a] '[] '[Tree a])) ->
+--     ('Data.Packed.Reader.PackedReader' '[a] r ('Data.Packed.Needs.NeedsBuilder' (a ': r1) '[Tree a] r1 '[Tree a])) ->
 --
---     ('Data.Packed.Reader.PackedReader' '[Tree a, Tree a] r ('Data.Packed.Needs.NeedsBuilder' '[Tree a, Tree a] '[Tree a] '[] '[Tree a])) ->
---     'Data.Packed.PackedReader' '[Tree a] r ('Data.Packed.Needs' '[] '[Tree a])
+--     ('Data.Packed.Reader.PackedReader' '[Tree a, Tree a] r ('Data.Packed.Needs.NeedsBuilder' (Tree a ': Tree a ': r1) '[Tree a] r1 '[Tree a])) ->
+--     'Data.Packed.PackedReader' '[Tree a] r ('Data.Packed.NeedsBuilder' (Tree a ': r1) '[Tree a] r1 '[Tree a])
 genTransformSignature :: [PackingFlag] -> Name -> Q Dec
 genTransformSignature flags tyName = do
     (sourceType, _) <- resolveAppliedType tyName
     (TyConI (DataD _ _ _ _ cs _)) <- reify tyName
     rVar <- newName "r"
+    r1Var <- newName "r1"
     let
         rType = varT rVar
-        lambdaTypes = (\c -> buildLambdaType c sourceType rType) <$> cs
+        r1Type = varT r1Var
+        lambdaTypes = (\c -> buildLambdaType c sourceType rType r1Type) <$> cs
         outType =
             [t|
                 PackedReader
                     '[$(return sourceType)]
                     $rType
-                    (N.Needs '[] '[$(return sourceType)])
+                    (N.NeedsBuilder ($(return sourceType) ': $(r1Type)) '[$(return sourceType)] $(r1Type) '[$(return sourceType)])
                 |]
     signature <- foldr (\lambda out -> [t|$lambda -> $out|]) outType (catMaybes lambdaTypes)
     return $ SigD (transformFName tyName) signature
   where
     -- From a constructor (say Leaf a), build type PackedTransformer a r
-    buildLambdaType con ty restType =
+    buildLambdaType con ty restType rest1Type =
         if null fieldType
             then Nothing
             else return $ do
-                packedContentType <-
+                [readerType, builderType] <- forM [[t|'[]|], rest1Type] $ \r ->
                     foldr
                         ( \(fieldTy, _, needsFS) tys ->
                             if needsFS
                                 then [t|FieldSize ': $(return fieldTy) ': $tys|]
                                 else [t|$(return fieldTy) ': $tys|]
                         )
-                        [t|'[]|]
+                        r
                         fieldType
                 [t|
                     PackedReader
-                        $(return packedContentType)
+                        $(return readerType)
                         $restType
-                        (N.NeedsBuilder $(return packedContentType) '[$(return ty)] '[] '[$(return ty)])
+                        (N.NeedsBuilder $(return builderType) '[$(return ty)] $(rest1Type) '[$(return ty)])
                     |]
       where
         fieldType = getConFieldsIdxAndNeedsFS con flags
diff --git a/src/Data/Packed/TH/Write.hs b/src/Data/Packed/TH/Write.hs
--- a/src/Data/Packed/TH/Write.hs
+++ b/src/Data/Packed/TH/Write.hs
@@ -40,7 +40,7 @@
                 -- Generate names for each variable in the constructor
                 paramNames <- mapM (const $ newName "t") types
                 -- We apply each parameter of the constructor and the 'Needs' to the 'writeConXXX' function
-                body <- foldl (\f arg -> [|$f $(varE arg)|]) (varE $ conWriteFName conName) paramNames
+                body <- foldl (\f arg -> appE f (varE arg)) (varE $ conWriteFName conName) paramNames
                 return $ Clause [ConP conName [] (VarP <$> paramNames)] (NormalB body) []
             )
             cs
diff --git a/src/Data/Packed/TH/WriteCon.hs b/src/Data/Packed/TH/WriteCon.hs
--- a/src/Data/Packed/TH/WriteCon.hs
+++ b/src/Data/Packed/TH/WriteCon.hs
@@ -26,7 +26,7 @@
 --
 -- @
 -- writeConLeaf :: ('Packable' a) => a -> 'NeedsWriter (Tree a) r t'
--- writeConLeaf n  = startLeaf 'Data.Packed.Needs.>>' 'write' n
+-- writeConLeaf leafValue needs = startLeaf needs 'Data.Packed.Needs.>>=' 'write' n
 -- @
 genConWrite ::
     [PackingFlag] ->
@@ -44,6 +44,7 @@
         t = VarT $ mkName "t"
         fName = conWriteFName conName
         paramTypes = getConFieldsIdxAndNeedsFS con flags
+        srcNeedsName = mkName "needs"
     parentType <- do
         DataConI _ conTy _ <- reify conName
         return $ getParentTypeFromConstructorType conTy
@@ -55,18 +56,18 @@
             ( \rest ((_, _, needsFS), paramName) ->
                 -- We insert the size before
                 if needsFS
-                    then [|$rest N.>> writeWithFieldSize $(varE paramName)|]
-                    else [|$rest N.>> write $(varE paramName)|]
+                    then [|$rest N.>>= writeWithFieldSize $(varE paramName)|]
+                    else [|$rest N.>>= write $(varE paramName)|]
             )
-            [|$(varE $ startFName conName)|]
+            [|$(varE $ startFName conName) $(varE srcNeedsName)|]
             fieldTypeAndName
     -- The pattern (lhs of '=' in a function implementation) will be something like '\a needs' for constructor 'Leaf a'
-    let patt = VarP . snd <$> fieldTypeAndName
+    let patt = (VarP . snd <$> fieldTypeAndName) ++ [VarP srcNeedsName]
     start <- genStart flags con tag
     return $
         start
             ++ [ signature
-               , FunD fName [Clause [] (NormalB $ LamE patt body) []]
+               , FunD fName [Clause patt (NormalB body) []]
                ]
 
 -- Generates the function signature for functions like 'writeConLeaf'
diff --git a/src/Data/Packed/Unpackable.hs b/src/Data/Packed/Unpackable.hs
--- a/src/Data/Packed/Unpackable.hs
+++ b/src/Data/Packed/Unpackable.hs
@@ -1,7 +1,9 @@
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MagicHash #-}
 {-# LANGUAGE QualifiedDo #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE UnboxedTuples #-}
 {-# LANGUAGE UndecidableInstances #-}
 
 module Data.Packed.Unpackable (
@@ -13,32 +15,38 @@
     readerWithoutShift,
 ) where
 
+import Control.Monad.Identity
 import Data.Packed.Packed
-import Data.Packed.Reader
+import Data.Packed.Reader hiding (return)
 import Foreign (Storable (peek, sizeOf), castPtr, plusPtr)
-import GHC.IO (unsafePerformIO)
+import GHC.Exts
+import GHC.IO
 
 -- | An 'Unpackable' is a value that can be read (i.e. deserialised) from a 'Data.Packed' value
 class Unpackable a where
-    -- | The 'PackedReader' to unpack a value of that type
+    -- | The 'Data.Packed.Reader.PackedReader' to unpack a value of that type
     reader :: PackedReader '[a] r a
 
 instance (Storable a) => Unpackable a where
     {-# INLINE reader #-}
-    reader = mkPackedReader $ \ptr l -> do
-        !n <- Foreign.peek (castPtr ptr)
-        let !shiftedCount = sizeOf n
-            !l1 = l - shiftedCount
-            !ptr1 = ptr `plusPtr` shiftedCount
-        Prelude.return (n, ptr1, l1)
+    reader = PackedReader $ \(PF ptr int) -> case runRW# (unIO (peek $ castPtr ptr)) of
+        (# _, !n #) ->
+            let
+                !sizeOfN = sizeOf n
+                !shiftedPtr = ptr `plusPtr` sizeOfN
+                !shiftedSize = int - sizeOfN
+             in
+                return (n, PF shiftedPtr shiftedSize)
 
 {-# INLINE readerWithoutShift #-}
 
 -- | In a `PackedReader`, reads a value without moving the cursor
-readerWithoutShift :: (Unpackable a) => PackedReader (a ': r) (a ': r) a
-readerWithoutShift = mkPackedReader $ \ptr len -> do
-    (!a, _, _) <- runPackedReader reader ptr len
-    Prelude.return (a, ptr, len)
+readerWithoutShift :: (Unpackable a) => PackedReader '[] (a ': r) a
+readerWithoutShift = mkPackedReader $ \pf ->
+    let
+        Identity !(!a, !_) = runReaderStep reader pf
+     in
+        return (a, pf)
 
 {-# INLINE unpack #-}
 
@@ -46,7 +54,7 @@
 --
 -- Returns the unconsumed 'Data.Packed.Packed' portion
 unpack :: (Unpackable a) => Packed (a ': r) -> (a, Packed r)
-unpack = unsafePerformIO . runReader reader
+unpack = runReader reader
 
 {-# INLINE unpack' #-}
 
diff --git a/src/Tree.hs b/src/Tree.hs
deleted file mode 100644
--- a/src/Tree.hs
+++ /dev/null
@@ -1,9 +0,0 @@
-{-# OPTIONS_GHC -Wno-unused-top-binds #-}
-
-module Tree (Tree (..), caseTree, readTree) where
-
-import Data.Packed
-
-data Tree a = Leaf a | Node (Tree a) (Tree a)
-
-$(mkPacked ''Tree [InsertFieldSize, SkipLastFieldSize])
diff --git a/test/PackedTest/CaseTest.hs b/test/PackedTest/CaseTest.hs
--- a/test/PackedTest/CaseTest.hs
+++ b/test/PackedTest/CaseTest.hs
@@ -21,7 +21,7 @@
                         rightSum <- computeSum
                         R.return $ leftSum + rightSum
                     )
-        (res, _) <- runReader computeSum tree
+            (res, _) = runReader computeSum tree
         res `shouldBe` 55
   where
     buildTree 0 = Leaf1 0
diff --git a/test/PackedTest/IdentityTest.hs b/test/PackedTest/IdentityTest.hs
--- a/test/PackedTest/IdentityTest.hs
+++ b/test/PackedTest/IdentityTest.hs
@@ -1,9 +1,13 @@
+{-# LANGUAGE BangPatterns #-}
+
 module PackedTest.IdentityTest (specs) where
 
 import Data.Packed
 import PackedTest.Data
 import Test.Hspec
+import Prelude hiding (readList)
 
+$(mkPacked ''[] [])
 $(mkPacked ''Tree1 [])
 $(mkPacked ''Tree2 [])
 $(mkPacked ''Tree3 [])
@@ -15,10 +19,20 @@
     test "Tree 1" $ Node1 (Node1 (Leaf1 (1 :: Int)) (Leaf1 2)) (Leaf1 3)
     test "Tree 1 (with lists)" $ Node1 (Leaf1 [1 :: Int, 2]) (Node1 (Leaf1 []) (Leaf1 [3, 4]))
     test "Tree 1 (with custom ADT)" $ Node1 (Leaf1 (SmallData (1 :: Int))) (Node1 (Leaf1 $ BigData "Hello World") (Node1 (Leaf1 $ BigData "Goodbye") (Leaf1 $ SmallData 0)))
+    test "Tree 1, size 20" $ buildNativeTree 20
     test "Tree 2" $ Node2 (Node2 Leaf2 (1 :: Int) Leaf2) 2 (Node2 Leaf2 3 Leaf2)
     test "Tree 3" $ Node3 (Node3 Leaf3 Leaf3 (1 :: Int)) (Node3 Leaf3 Leaf3 3) 2
     test "Tree 4" $ Node4 (Node4 (Leaf4 (1 :: Int)) (Leaf4 2)) (Leaf4 3)
   where
-    test name tree = it name $ do
-        let ptree = pack tree
-        unpack' ptree `shouldBe` tree
+    test name tree =
+        it name $
+            let
+                !ptree = pack tree
+             in
+                unpack' ptree `shouldBe` tree
+
+buildNativeTree :: Int -> Tree1 Int
+buildNativeTree 0 = Leaf1 1
+buildNativeTree n = Node1 subTree subTree
+  where
+    !subTree = buildNativeTree (n - 1)
diff --git a/test/PackedTest/PackTest.hs b/test/PackedTest/PackTest.hs
--- a/test/PackedTest/PackTest.hs
+++ b/test/PackedTest/PackTest.hs
@@ -77,6 +77,6 @@
             )
   where
     test name tree bldr =
-        it name $ do
+        it name $
             let ptree = Data.Packed.pack tree
-            fromPacked ptree `shouldBe` builderBytes bldr
+             in fromPacked ptree `shouldBe` builderBytes bldr