diff --git a/library/TextBuilderDev.hs b/library/TextBuilderDev.hs
--- a/library/TextBuilderDev.hs
+++ b/library/TextBuilderDev.hs
@@ -77,15 +77,12 @@
 import qualified Data.ByteString as ByteString
 import qualified Data.List.Split as Split
 import qualified Data.Text as Text
-import qualified Data.Text.Array as TextArray
 import qualified Data.Text.IO as Text
-import qualified Data.Text.Internal as TextInternal
 import qualified Data.Text.Lazy as TextLazy
 import qualified Data.Text.Lazy.Builder as TextLazyBuilder
 import qualified DeferredFolds.Unfoldr as Unfoldr
+import qualified TextBuilderDev.Allocator as Allocator
 import TextBuilderDev.Prelude hiding (intercalate, length, null)
-import qualified TextBuilderDev.Utf16View as Utf16View
-import qualified TextBuilderDev.Utf8View as Utf8View
 
 -- * --
 
@@ -137,41 +134,25 @@
   toTextBuilder = text . TextLazy.toStrict . TextLazyBuilder.toLazyText
   fromTextBuilder = TextLazyBuilder.fromText . buildText
 
--- * Action
-
-newtype Action
-  = Action (forall s. TextArray.MArray s -> Int -> ST s Int)
-
-instance Semigroup Action where
-  {-# INLINE (<>) #-}
-  Action writeL <> Action writeR =
-    Action $ \array offset -> do
-      offsetAfter1 <- writeL array offset
-      writeR array offsetAfter1
-
-instance Monoid Action where
-  {-# INLINE mempty #-}
-  mempty = Action $ const $ return
-
 -- * --
 
 -- |
 -- Specification of how to efficiently construct strict 'Text'.
 -- Provides instances of 'Semigroup' and 'Monoid', which have complexity of /O(1)/.
 data TextBuilder
-  = TextBuilder !Action !Int !Int
+  = TextBuilder
+      {-# UNPACK #-} !Allocator.Allocator
+      {-# UNPACK #-} !Int
 
 instance Semigroup TextBuilder where
-  (<>) (TextBuilder action1 estimatedArraySize1 textLength1) (TextBuilder action2 estimatedArraySize2 textLength2) =
-    TextBuilder action estimatedArraySize textLength
-    where
-      action = action1 <> action2
-      estimatedArraySize = estimatedArraySize1 + estimatedArraySize2
-      textLength = textLength1 + textLength2
+  (<>) (TextBuilder allocator1 sizeInChars1) (TextBuilder allocator2 sizeInChars2) =
+    TextBuilder
+      (allocator1 <> allocator2)
+      (sizeInChars1 + sizeInChars2)
 
 instance Monoid TextBuilder where
   {-# INLINE mempty #-}
-  mempty = TextBuilder mempty 0 0
+  mempty = TextBuilder mempty 0
 
 instance IsString TextBuilder where
   fromString = string
@@ -214,7 +195,7 @@
 -- | Get the amount of characters.
 {-# INLINE length #-}
 length :: TextBuilder -> Int
-length (TextBuilder _ _ x) = x
+length (TextBuilder _ x) = x
 
 -- | Check whether the builder is empty.
 {-# INLINE null #-}
@@ -223,12 +204,8 @@
 
 -- | Execute a builder producing a strict text.
 buildText :: TextBuilder -> Text
-buildText (TextBuilder (Action action) sizeBound _) =
-  runST $ do
-    array <- TextArray.new sizeBound
-    offsetAfter <- action array 0
-    frozenArray <- TextArray.unsafeFreeze array
-    return $ TextInternal.text frozenArray 0 offsetAfter
+buildText (TextBuilder allocator _) =
+  Allocator.allocate allocator
 
 -- ** Output IO
 
@@ -265,118 +242,47 @@
 char :: Char -> TextBuilder
 char = unicodeCodePoint . ord
 
-#if MIN_VERSION_text(2,0,0)
-
 -- | Unicode code point.
 {-# INLINE unicodeCodePoint #-}
 unicodeCodePoint :: Int -> TextBuilder
-unicodeCodePoint x =
-  Utf8View.unicodeCodePoint x utf8CodeUnits1 utf8CodeUnits2 utf8CodeUnits3 utf8CodeUnits4
-
-{-# INLINEABLE utf8CodeUnits1 #-}
-utf8CodeUnits1 :: Word8 -> TextBuilder
-utf8CodeUnits1 unit1 = TextBuilder action 1 1
-  where
-    action = Action $ \array offset ->
-      TextArray.unsafeWrite array offset unit1
-        $> succ offset
-
-{-# INLINEABLE utf8CodeUnits2 #-}
-utf8CodeUnits2 :: Word8 -> Word8 -> TextBuilder
-utf8CodeUnits2 unit1 unit2 = TextBuilder action 2 1
-  where
-    action = Action $ \array offset -> do
-      TextArray.unsafeWrite array (offset + 0) unit1
-      TextArray.unsafeWrite array (offset + 1) unit2
-      return $ offset + 2
-
-{-# INLINEABLE utf8CodeUnits3 #-}
-utf8CodeUnits3 :: Word8 -> Word8 -> Word8 -> TextBuilder
-utf8CodeUnits3 unit1 unit2 unit3 = TextBuilder action 3 1
-  where
-    action = Action $ \array offset -> do
-      TextArray.unsafeWrite array (offset + 0) unit1
-      TextArray.unsafeWrite array (offset + 1) unit2
-      TextArray.unsafeWrite array (offset + 2) unit3
-      return $ offset + 3
-
-{-# INLINEABLE utf8CodeUnits4 #-}
-utf8CodeUnits4 :: Word8 -> Word8 -> Word8 -> Word8 -> TextBuilder
-utf8CodeUnits4 unit1 unit2 unit3 unit4 = TextBuilder action 4 1
-  where
-    action = Action $ \array offset -> do
-      TextArray.unsafeWrite array (offset + 0) unit1
-      TextArray.unsafeWrite array (offset + 1) unit2
-      TextArray.unsafeWrite array (offset + 2) unit3
-      TextArray.unsafeWrite array (offset + 3) unit4
-      return $ offset + 4
-
-{-# INLINE utf16CodeUnits1 #-}
-utf16CodeUnits1 :: Word16 -> TextBuilder
-utf16CodeUnits1 = unicodeCodePoint . fromIntegral
-
-{-# INLINE utf16CodeUnits2 #-}
-utf16CodeUnits2 :: Word16 -> Word16 -> TextBuilder
-utf16CodeUnits2 unit1 unit2 = unicodeCodePoint cp
-  where
-    cp = (((fromIntegral unit1 .&. 0x3FF) `shiftL` 10) .|. (fromIntegral unit2 .&. 0x3FF)) + 0x10000
-
-#else
-
--- | Unicode code point.
-{-# INLINE unicodeCodePoint #-}
-unicodeCodePoint :: Int -> TextBuilder
-unicodeCodePoint x =
-  Utf16View.unicodeCodePoint x utf16CodeUnits1 utf16CodeUnits2
+unicodeCodePoint a =
+  TextBuilder (Allocator.unicodeCodePoint a) 1
 
 -- | Single code-unit UTF-16 character.
 {-# INLINEABLE utf16CodeUnits1 #-}
 utf16CodeUnits1 :: Word16 -> TextBuilder
-utf16CodeUnits1 unit =
-  TextBuilder action 1 1
-  where
-    action =
-      Action $ \array offset ->
-        TextArray.unsafeWrite array offset unit
-          $> succ offset
+utf16CodeUnits1 a =
+  TextBuilder (Allocator.utf16CodeUnits1 a) 1
 
 -- | Double code-unit UTF-16 character.
 {-# INLINEABLE utf16CodeUnits2 #-}
 utf16CodeUnits2 :: Word16 -> Word16 -> TextBuilder
-utf16CodeUnits2 unit1 unit2 =
-  TextBuilder action 2 1
-  where
-    action =
-      Action $ \array offset -> do
-        TextArray.unsafeWrite array offset unit1
-        TextArray.unsafeWrite array (succ offset) unit2
-        return $ offset + 2
+utf16CodeUnits2 a b =
+  TextBuilder (Allocator.utf16CodeUnits2 a b) 1
 
 -- | Single code-unit UTF-8 character.
 {-# INLINE utf8CodeUnits1 #-}
 utf8CodeUnits1 :: Word8 -> TextBuilder
-utf8CodeUnits1 unit1 =
-  Utf16View.utf8CodeUnits1 unit1 utf16CodeUnits1 utf16CodeUnits2
+utf8CodeUnits1 a =
+  TextBuilder (Allocator.utf8CodeUnits1 a) 1
 
 -- | Double code-unit UTF-8 character.
 {-# INLINE utf8CodeUnits2 #-}
 utf8CodeUnits2 :: Word8 -> Word8 -> TextBuilder
-utf8CodeUnits2 unit1 unit2 =
-  Utf16View.utf8CodeUnits2 unit1 unit2 utf16CodeUnits1 utf16CodeUnits2
+utf8CodeUnits2 a b =
+  TextBuilder (Allocator.utf8CodeUnits2 a b) 1
 
 -- | Triple code-unit UTF-8 character.
 {-# INLINE utf8CodeUnits3 #-}
 utf8CodeUnits3 :: Word8 -> Word8 -> Word8 -> TextBuilder
-utf8CodeUnits3 unit1 unit2 unit3 =
-  Utf16View.utf8CodeUnits3 unit1 unit2 unit3 utf16CodeUnits1 utf16CodeUnits2
+utf8CodeUnits3 a b c =
+  TextBuilder (Allocator.utf8CodeUnits3 a b c) 1
 
 -- | UTF-8 character out of 4 code units.
 {-# INLINE utf8CodeUnits4 #-}
 utf8CodeUnits4 :: Word8 -> Word8 -> Word8 -> Word8 -> TextBuilder
-utf8CodeUnits4 unit1 unit2 unit3 unit4 =
-  Utf16View.utf8CodeUnits4 unit1 unit2 unit3 unit4 utf16CodeUnits1 utf16CodeUnits2
-
-#endif
+utf8CodeUnits4 a b c d =
+  TextBuilder (Allocator.utf8CodeUnits4 a b c d) 1
 
 -- | ASCII byte string.
 --
@@ -385,36 +291,15 @@
 {-# INLINEABLE asciiByteString #-}
 asciiByteString :: ByteString -> TextBuilder
 asciiByteString byteString =
-  TextBuilder action length length
-  where
-    length = ByteString.length byteString
-    action =
-      Action $ \array ->
-        let step byte next index = do
-              TextArray.unsafeWrite array index (fromIntegral byte)
-              next (succ index)
-         in ByteString.foldr step return byteString
+  TextBuilder
+    (Allocator.asciiByteString byteString)
+    (ByteString.length byteString)
 
 -- | Strict text.
 {-# INLINEABLE text #-}
 text :: Text -> TextBuilder
-#if MIN_VERSION_text(2,0,0)
-text text@(TextInternal.Text array offset length) =
-  TextBuilder action length (Text.length text)
-  where
-    action =
-      Action $ \builderArray builderOffset -> do
-        TextArray.copyI length builderArray builderOffset array offset
-        return $ builderOffset + length
-#else
-text text@(TextInternal.Text array offset length) =
-  TextBuilder action length (Text.length text)
-  where
-    action =
-      Action $ \builderArray builderOffset -> do
-        TextArray.copyI builderArray builderOffset array offset (builderOffset + length)
-        return $ builderOffset + length
-#endif
+text text =
+  TextBuilder (Allocator.text text) (Text.length text)
 
 -- | Lazy text.
 {-# INLINE lazyText #-}
diff --git a/library/TextBuilderDev/Allocator.hs b/library/TextBuilderDev/Allocator.hs
new file mode 100644
--- /dev/null
+++ b/library/TextBuilderDev/Allocator.hs
@@ -0,0 +1,245 @@
+{-# LANGUAGE CPP #-}
+
+module TextBuilderDev.Allocator
+  ( -- * Execution
+    allocate,
+
+    -- * Definition
+    Allocator,
+    force,
+    text,
+    asciiByteString,
+    char,
+    unicodeCodePoint,
+    utf8CodeUnits1,
+    utf8CodeUnits2,
+    utf8CodeUnits3,
+    utf8CodeUnits4,
+    utf16CodeUnits1,
+    utf16CodeUnits2,
+  )
+where
+
+import qualified Data.ByteString as ByteString
+import qualified Data.Text as Text
+import qualified Data.Text.Array as TextArray
+import qualified Data.Text.IO as Text
+import qualified Data.Text.Internal as TextInternal
+import qualified Data.Text.Lazy as TextLazy
+import qualified Data.Text.Lazy.Builder as TextLazyBuilder
+import TextBuilderDev.Prelude
+import qualified TextBuilderDev.Utf16View as Utf16View
+import qualified TextBuilderDev.Utf8View as Utf8View
+
+-- * ArrayWriter
+
+newtype ArrayWriter
+  = ArrayWriter (forall s. TextArray.MArray s -> Int -> ST s Int)
+
+instance Semigroup ArrayWriter where
+  {-# INLINE (<>) #-}
+  ArrayWriter writeL <> ArrayWriter writeR =
+    ArrayWriter $ \array offset -> do
+      offsetAfter1 <- writeL array offset
+      writeR array offsetAfter1
+
+instance Monoid ArrayWriter where
+  {-# INLINE mempty #-}
+  mempty = ArrayWriter $ const $ return
+
+-- * Allocator
+
+-- | Execute a builder producing a strict text.
+allocate :: Allocator -> Text
+allocate (Allocator (ArrayWriter write) sizeBound) =
+  runST $ do
+    array <- TextArray.new sizeBound
+    offsetAfter <- write array 0
+    frozenArray <- TextArray.unsafeFreeze array
+    return $ TextInternal.text frozenArray 0 offsetAfter
+
+-- |
+-- Specification of how to efficiently construct strict 'Text'.
+-- Provides instances of 'Semigroup' and 'Monoid', which have complexity of /O(1)/.
+data Allocator
+  = Allocator
+      !ArrayWriter
+      {-# UNPACK #-} !Int
+
+instance Semigroup Allocator where
+  {-# INLINE (<>) #-}
+  (<>) (Allocator writer1 estimatedArraySize1) (Allocator writer2 estimatedArraySize2) =
+    Allocator writer estimatedArraySize
+    where
+      writer = writer1 <> writer2
+      estimatedArraySize = estimatedArraySize1 + estimatedArraySize2
+
+instance Monoid Allocator where
+  {-# INLINE mempty #-}
+  mempty = Allocator mempty 0
+
+-- |
+-- Run the builder and pack the produced text into a new builder.
+--
+-- Useful to have around builders that you reuse,
+-- because a forced builder is much faster,
+-- since it's virtually a single call @memcopy@.
+{-# INLINE force #-}
+force :: Allocator -> Allocator
+force = text . allocate
+
+-- | Strict text.
+{-# INLINEABLE text #-}
+text :: Text -> Allocator
+#if MIN_VERSION_text(2,0,0)
+text text@(TextInternal.Text array offset length) =
+  Allocator writer length
+  where
+    writer =
+      ArrayWriter $ \builderArray builderOffset -> do
+        TextArray.copyI length builderArray builderOffset array offset
+        return $ builderOffset + length
+#else
+text text@(TextInternal.Text array offset length) =
+  Allocator writer length
+  where
+    writer =
+      ArrayWriter $ \builderArray builderOffset -> do
+        let builderOffsetAfter = builderOffset + length
+        TextArray.copyI builderArray builderOffset array offset builderOffsetAfter
+        return builderOffsetAfter
+#endif
+
+-- | ASCII byte string.
+--
+-- It's your responsibility to ensure that the bytes are in proper range,
+-- otherwise the produced text will be broken.
+{-# INLINEABLE asciiByteString #-}
+asciiByteString :: ByteString -> Allocator
+asciiByteString byteString =
+  Allocator action length
+  where
+    length = ByteString.length byteString
+    action =
+      ArrayWriter $ \array ->
+        let step byte next index = do
+              TextArray.unsafeWrite array index (fromIntegral byte)
+              next (succ index)
+         in ByteString.foldr step return byteString
+
+-- | Unicode character.
+{-# INLINE char #-}
+char :: Char -> Allocator
+char = unicodeCodePoint . ord
+
+-- | Unicode code point.
+{-# INLINE unicodeCodePoint #-}
+unicodeCodePoint :: Int -> Allocator
+#if MIN_VERSION_text(2,0,0)
+unicodeCodePoint x =
+  Utf8View.unicodeCodePoint x utf8CodeUnits1 utf8CodeUnits2 utf8CodeUnits3 utf8CodeUnits4
+#else
+unicodeCodePoint x =
+  Utf16View.unicodeCodePoint x utf16CodeUnits1 utf16CodeUnits2
+#endif
+
+-- | Single code-unit UTF-8 character.
+utf8CodeUnits1 :: Word8 -> Allocator
+#if MIN_VERSION_text(2,0,0)
+{-# INLINEABLE utf8CodeUnits1 #-}
+utf8CodeUnits1 unit1 = Allocator writer 1 
+  where
+    writer = ArrayWriter $ \array offset ->
+      TextArray.unsafeWrite array offset unit1
+        $> succ offset
+#else
+{-# INLINE utf8CodeUnits1 #-}
+utf8CodeUnits1 unit1 =
+  Utf16View.utf8CodeUnits1 unit1 utf16CodeUnits1 utf16CodeUnits2
+#endif
+
+-- | Double code-unit UTF-8 character.
+utf8CodeUnits2 :: Word8 -> Word8 -> Allocator
+#if MIN_VERSION_text(2,0,0)
+{-# INLINEABLE utf8CodeUnits2 #-}
+utf8CodeUnits2 unit1 unit2 = Allocator writer 2 
+  where
+    writer = ArrayWriter $ \array offset -> do
+      TextArray.unsafeWrite array offset unit1
+      TextArray.unsafeWrite array (offset + 1) unit2
+      return $ offset + 2
+#else
+{-# INLINE utf8CodeUnits2 #-}
+utf8CodeUnits2 unit1 unit2 =
+  Utf16View.utf8CodeUnits2 unit1 unit2 utf16CodeUnits1 utf16CodeUnits2
+#endif
+
+-- | Triple code-unit UTF-8 character.
+utf8CodeUnits3 :: Word8 -> Word8 -> Word8 -> Allocator
+#if MIN_VERSION_text(2,0,0)
+{-# INLINEABLE utf8CodeUnits3 #-}
+utf8CodeUnits3 unit1 unit2 unit3 = Allocator writer 3 
+  where
+    writer = ArrayWriter $ \array offset -> do
+      TextArray.unsafeWrite array offset unit1
+      TextArray.unsafeWrite array (offset + 1) unit2
+      TextArray.unsafeWrite array (offset + 2) unit3
+      return $ offset + 3
+#else
+{-# INLINE utf8CodeUnits3 #-}
+utf8CodeUnits3 unit1 unit2 unit3 =
+  Utf16View.utf8CodeUnits3 unit1 unit2 unit3 utf16CodeUnits1 utf16CodeUnits2
+#endif
+
+-- | UTF-8 character out of 4 code units.
+utf8CodeUnits4 :: Word8 -> Word8 -> Word8 -> Word8 -> Allocator
+#if MIN_VERSION_text(2,0,0)
+{-# INLINEABLE utf8CodeUnits4 #-}
+utf8CodeUnits4 unit1 unit2 unit3 unit4 = Allocator writer 4 
+  where
+    writer = ArrayWriter $ \array offset -> do
+      TextArray.unsafeWrite array offset unit1
+      TextArray.unsafeWrite array (offset + 1) unit2
+      TextArray.unsafeWrite array (offset + 2) unit3
+      TextArray.unsafeWrite array (offset + 3) unit4
+      return $ offset + 4
+#else
+{-# INLINE utf8CodeUnits4 #-}
+utf8CodeUnits4 unit1 unit2 unit3 unit4 =
+  Utf16View.utf8CodeUnits4 unit1 unit2 unit3 unit4 utf16CodeUnits1 utf16CodeUnits2
+#endif
+
+-- | Single code-unit UTF-16 character.
+utf16CodeUnits1 :: Word16 -> Allocator
+#if MIN_VERSION_text(2,0,0)
+{-# INLINE utf16CodeUnits1 #-}
+utf16CodeUnits1 = unicodeCodePoint . fromIntegral
+#else
+{-# INLINEABLE utf16CodeUnits1 #-}
+utf16CodeUnits1 unit =
+  Allocator writer 1
+  where
+    writer =
+      ArrayWriter $ \array offset ->
+        TextArray.unsafeWrite array offset unit
+          $> succ offset
+#endif
+
+-- | Double code-unit UTF-16 character.
+utf16CodeUnits2 :: Word16 -> Word16 -> Allocator
+#if MIN_VERSION_text(2,0,0)
+{-# INLINE utf16CodeUnits2 #-}
+utf16CodeUnits2 unit1 unit2 = unicodeCodePoint cp
+  where
+    cp = (((fromIntegral unit1 .&. 0x3FF) `shiftL` 10) .|. (fromIntegral unit2 .&. 0x3FF)) + 0x10000
+#else
+{-# INLINEABLE utf16CodeUnits2 #-}
+utf16CodeUnits2 unit1 unit2 =
+  Allocator writer 2
+  where
+    writer =
+      ArrayWriter $ \array offset -> do
+        TextArray.unsafeWrite array offset unit1
+        TextArray.unsafeWrite array (succ offset) unit2
+        return $ offset + 2
+#endif
diff --git a/text-builder-dev.cabal b/text-builder-dev.cabal
--- a/text-builder-dev.cabal
+++ b/text-builder-dev.cabal
@@ -1,7 +1,7 @@
 cabal-version: 3.0
 
 name: text-builder-dev
-version: 0.3.3.1
+version: 0.3.3.2
 category: Text
 synopsis: Edge of developments for "text-builder"
 description:
@@ -23,7 +23,7 @@
   location: git://github.com/nikita-volkov/text-builder-dev.git
 
 common base-settings
-  default-extensions: BangPatterns, ConstraintKinds, CPP, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, InstanceSigs, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeApplications, TypeFamilies, TypeOperators, ViewPatterns
+  default-extensions: BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, InstanceSigs, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeApplications, TypeFamilies, TypeOperators, ViewPatterns
   default-language: Haskell2010
 
 library
@@ -32,6 +32,7 @@
   exposed-modules:
     TextBuilderDev
   other-modules:
+    TextBuilderDev.Allocator
     TextBuilderDev.Unicode
     TextBuilderDev.Utf16View
     TextBuilderDev.Utf8View