diff --git a/binary-file.cabal b/binary-file.cabal
--- a/binary-file.cabal
+++ b/binary-file.cabal
@@ -2,7 +2,7 @@
 cabal-version:	>= 1.8
 
 name:		binary-file
-version:	0.14.3
+version:	0.15.0
 stability:	experimental
 author:		Yoshikuni Jujo <PAF01143@nifty.ne.jp>
 maintainer:	Yoshikuni Jujo <PAF01143@nifty.ne.jp>
@@ -74,9 +74,13 @@
 
 extra-source-files:
     examples/readPNG.hs,
+    examples/CRC.hs,
     examples/readBitmap.hs,
     examples/readHex.hs,
     examples/tiny.hs
+    examples/bits.hs
+    examples/bitsb.hs
+    examples/bitslb.hs
 
 source-repository	head
     type:	git
@@ -85,7 +89,7 @@
 source-repository	this
     type:	git
     location:	git://github.com/YoshikuniJujo/binary-file.git
-    tag:	0.14.3
+    tag:	0.15.0
 
 library
     hs-source-dirs:	src
diff --git a/examples/CRC.hs b/examples/CRC.hs
new file mode 100644
--- /dev/null
+++ b/examples/CRC.hs
@@ -0,0 +1,29 @@
+module CRC (crc, testCRC) where
+
+import Data.Array
+import Data.Bits
+import Data.Char
+import Data.Word
+import Numeric
+
+--------------------------------------------------------------------------------
+
+crc :: String -> Word32
+crc = xor 0xffffffff . foldl crc' 0xffffffff
+	where
+	crc' :: Word32 -> Char -> Word32
+	crc' c x = table ! i `xor` shiftR c 8
+		where
+		i = (c `xor` fromIntegral (ord x)) .&. 0xff
+	table :: Array Word32 Word32
+	table = listArray (0, 255) $ map (\n -> foldl table' n [0 .. 7]) [0 .. 255]
+	table' :: Word32 -> Int -> Word32
+	table' c _
+		| c .&. 1 == 0 = shiftR c 1
+		| otherwise = xor 0xedb88320 $ shiftR c 1
+
+testCRC :: IO ()
+testCRC = p . crc =<< getContents
+	where
+	p :: Word32 -> IO ()
+	p c = putStrLn $ "0x" ++ showHex c ""
diff --git a/examples/bits.hs b/examples/bits.hs
new file mode 100644
--- /dev/null
+++ b/examples/bits.hs
@@ -0,0 +1,32 @@
+{-# LANGUAGE QuasiQuotes, TypeFamilies, ScopedTypeVariables #-}
+
+import File.Binary (binary, Field(..))
+import File.Binary.Instances ()
+import File.Binary.Instances.LittleEndian (BitsInt)
+
+main :: IO ()
+main = do
+	let (bits :: Bits, "") = fromBinary () "hello"
+	print bits
+	print (toBinary () bits :: String)
+
+[binary|
+
+Bits deriving Show
+
+{Bool}: b0
+{Bool}: b1
+4{BitsInt}: b2345
+{Bool}: b6
+{Bool}: b7
+{Bool}: c0
+{Bool}: c1
+{Bool}: c2
+{Bool}: c3
+{Bool}: c4
+{Bool}: c5
+{Bool}: c6
+{Bool}: c7
+((), Nothing){[Bool]}: rests
+
+|]
diff --git a/examples/bitsb.hs b/examples/bitsb.hs
new file mode 100644
--- /dev/null
+++ b/examples/bitsb.hs
@@ -0,0 +1,32 @@
+{-# LANGUAGE QuasiQuotes, TypeFamilies, ScopedTypeVariables #-}
+
+import File.Binary (binary, Field(..))
+import File.Binary.Instances ()
+import File.Binary.Instances.BigEndian (BitsInt)
+
+main :: IO ()
+main = do
+	let (bits :: Bits, "") = fromBinary () "hello"
+	print bits
+	print (toBinary () bits :: String)
+
+[binary|
+
+Bits deriving Show
+
+{Bool}: b0
+{Bool}: b1
+4{BitsInt}: b2345
+{Bool}: b6
+{Bool}: b7
+{Bool}: c0
+{Bool}: c1
+{Bool}: c2
+{Bool}: c3
+{Bool}: c4
+{Bool}: c5
+{Bool}: c6
+{Bool}: c7
+((), Nothing){[Bool]}: rests
+
+|]
diff --git a/examples/bitslb.hs b/examples/bitslb.hs
new file mode 100644
--- /dev/null
+++ b/examples/bitslb.hs
@@ -0,0 +1,31 @@
+{-# LANGUAGE QuasiQuotes, ScopedTypeVariables, TypeFamilies #-}
+
+import File.Binary (binary, Field(..))
+import File.Binary.Instances ()
+import qualified File.Binary.Instances.LittleEndian as L (BitsInt)
+import qualified File.Binary.Instances.BigEndian as B (BitsInt)
+
+--------------------------------------------------------------------------------
+
+main :: IO ()
+main = do
+	let (bits :: Bits, "") = fromBinary () "he" -- "\x1b\xf0"
+	print bits
+	print (toBinary () bits :: String)
+
+[binary|
+
+Bits deriving Show
+
+2{L.BitsInt}: little1
+2{L.BitsInt}: little2
+2{B.BitsInt}: big1
+3{B.BitsInt}: big2
+3{B.BitsInt}: big3
+4{L.BitsInt} : little3
+-- {Bool}: bb0
+-- {Bool}: bb1
+-- {Bool}: bb2
+-- {Bool}: bb3
+
+|]
diff --git a/examples/readBitmap.hs b/examples/readBitmap.hs
--- a/examples/readBitmap.hs
+++ b/examples/readBitmap.hs
@@ -1,22 +1,31 @@
-{-# LANGUAGE QuasiQuotes, TypeFamilies, FlexibleInstances #-}
+{-# LANGUAGE QuasiQuotes, TypeFamilies, FlexibleInstances, ScopedTypeVariables #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
-import File.Binary
-import File.Binary.Instances.LittleEndian()
-import File.Binary.Instances()
-import System.Environment
-import qualified Data.ByteString.Lazy as BSL
-import Data.Monoid
+import File.Binary (binary, Field(..), Binary(..), readBinaryFile, writeBinaryFile)
+import File.Binary.Instances.LittleEndian ()
+import File.Binary.Instances ()
+import Data.ByteString.Lazy (singleton)
+import Data.Monoid (mconcat)
+import Control.Applicative ((<$>))
+import System.Environment (getArgs)
 
+--------------------------------------------------------------------------------
+
 main :: IO ()
 main = do
-	[inf] <- getArgs
-	cnt <- readBinaryFile inf
-	let (bmp, rest) = fromBinary () cnt :: (Bitmap, String)
-	print bmp
-	print $ colors bmp
-	print rest
+	[inf, outf] <- getArgs
+	bmp <- readBitmap inf
+	putStrLn $ take 1000 (show bmp) ++ "..."
+	writeBitmap outf bmp
 
+readBitmap :: FilePath -> IO Bitmap
+readBitmap fp = do
+	(bmp, "") <- fromBinary () <$> readBinaryFile fp
+	return bmp
+
+writeBitmap :: FilePath -> Bitmap -> IO ()
+writeBitmap fp = writeBinaryFile fp . toBinary ()
+
 instance Field (Int, Int, Int) where
 	type FieldArgument (Int, Int, Int) = ()
 	fromBinary _ s = let
@@ -28,7 +37,7 @@
 		toBinary 1 b,
 		toBinary 1 g,
 		toBinary 1 r,
-		makeBinary $ BSL.singleton 0
+		makeBinary $ singleton 0
 	 ]
 
 [binary|
diff --git a/examples/readHex.hs b/examples/readHex.hs
--- a/examples/readHex.hs
+++ b/examples/readHex.hs
@@ -1,20 +1,23 @@
 {-# LANGUAGE QuasiQuotes, TypeFamilies #-}
 
-import File.Binary
-import File.Binary.Instances
-import File.Binary.Instances.LittleEndian
-import System.Environment
-import Control.Applicative
-import Numeric
+import File.Binary (binary, Field(..), readBinaryFile)
+import File.Binary.Instances ()
+import File.Binary.Instances.LittleEndian ()
+import System.Environment (getArgs)
+import Numeric (showHex)
+import Data.List (intercalate)
+import Control.Applicative ((<$>))
 
+--------------------------------------------------------------------------------
+
+main :: IO ()
 main = do
-	cnt <- readBinaryFile . head =<< getArgs
-	putStrLn $ unlines $ map unwords $ groupN 16 $ map (two . flip showHex "") $
-		hex $ fst (fromBinary () cnt :: (Hex, String))
+	(h, "") <- fromBinary () <$> (readBinaryFile . head =<< getArgs)
+	putStr $ unlines $ map (intercalate "-" . map unwords) $ groupN 2 $
+		groupN 8 $ map (two . flip showHex "") $ hex h
 
-two s = replicate (2 - l) '0' ++ s
-	where
-	l = length s
+two :: String -> String
+two s = let l = length s in replicate (2 - l) '0' ++ s
 
 groupN :: Int -> [a] -> [[a]]
 groupN _ [] = []
diff --git a/examples/readPNG.hs b/examples/readPNG.hs
--- a/examples/readPNG.hs
+++ b/examples/readPNG.hs
@@ -1,67 +1,76 @@
-{-# LANGUAGE QuasiQuotes, TypeFamilies, FlexibleInstances #-}
+{-# LANGUAGE QuasiQuotes, TypeFamilies, FlexibleInstances, OverloadedStrings #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
-import File.Binary
-import File.Binary.Instances()
-import File.Binary.Instances.BigEndian
-import System.Environment
-import Data.Word
-import qualified Data.ByteString as BS
-import qualified Data.ByteString.Char8 as BSC
-import qualified Data.ByteString.Lazy as BSL
-import Codec.Compression.Zlib
+import Prelude hiding (concat)
+import File.Binary (binary, Field(..), Binary(..))
+import File.Binary.Instances ()
+import File.Binary.Instances.BigEndian ()
 import CRC (crc)
-import Control.Applicative
-import Data.Monoid
+import Codec.Compression.Zlib (
+	decompress, compressWith, defaultCompressParams, CompressParams(..),
+	bestCompression, WindowBits(..))
+import qualified Data.ByteString as BS (ByteString, length, readFile, writeFile)
+import qualified Data.ByteString.Char8 as BSC (unpack)
+import Data.ByteString.Lazy
+	(ByteString, pack, unpack, concat, toChunks, fromChunks)
+import Data.Word (Word8, Word32)
+import Data.Bits (Bits, (.&.), (.|.), shiftL, shiftR)
+import Data.Monoid (mconcat)
+import Control.Applicative ((<$>))
+import Control.Arrow(first)
+import System.Environment (getArgs)
 
+--------------------------------------------------------------------------------
+
 main :: IO ()
 main = do
 	[fin, fout] <- getArgs
-	cnt <- BS.readFile fin
-	let (png, _) = fromBinary () cnt
+	png <- readPNG fin
 
-	putStrLn $ take 1000 (show png) ++ "..."
+	putStrLn $ take 800 (show png) ++ "..."
 
-	let	dat = makeData png
+	let	dat = concatIDATs $ body png
 		decomp = decompress dat
 		recomp = compressWith defaultCompressParams {
 			compressLevel = bestCompression,
 			compressWindowBits = WindowBits 10
 		 } decomp
-		newData = makeDataChank recomp
-		newnew = png {
-			chanks = headerChanks png ++ newData ++
-				footerChanks png
-		 }
-	BS.writeFile fout $ toBinary () newnew
-	print $ dat == recomp
+		newIDAT = map makeIDAT $ toChunks recomp
+		new = png { chunks = header png ++ newIDAT ++ footer png }
+	writePNG fout new
 
-headerChanks :: PNG -> [Chank]
-headerChanks PNG{ chanks = cs } =
-	filter ((`notElem` ["IEND", "IDAT"]) . chankName) cs
+	putStrLn ""
+	putStrLn $ take 800 (show new) ++ "..."
 
-footerChanks :: PNG -> [Chank]
-footerChanks PNG{ chanks = cs } = filter ((== "IEND") . chankName) cs
+readPNG :: FilePath -> IO PNG
+readPNG fp = do
+	(png, "") <- fromBinary () <$> BS.readFile fp
+	return png
 
-makeData :: PNG -> BSL.ByteString
-makeData PNG{ chanks = cs } =
-	BSL.concat $ map (idat . cidat . chankData) $
-		filter ((== "IDAT") . chankName) cs
+writePNG :: FilePath -> PNG -> IO ()
+writePNG fout = BS.writeFile fout . toBinary ()
 
-makeDataChank :: BSL.ByteString -> [Chank]
-makeDataChank = map makeOneDataChank . BSL.toChunks
+header :: PNG -> [Chunk]
+header PNG{ chunks = cs } =
+	filter ((`notElem` ["IEND", "IDAT"]) . chunkName) cs
 
-makeOneDataChank :: BS.ByteString -> Chank
-makeOneDataChank bs = Chank {
-	chankSize = fromIntegral $ BS.length bs,
-	chankName = "IDAT",
-	chankData = ChankIDAT $ IDAT $ BSL.fromChunks [bs],
-	chankCRC = crc $ "IDAT" ++ BSC.unpack bs
- }
+body :: PNG -> [IDAT]
+body PNG { chunks = cs } =
+	map (cidat . chunkData) $ filter ((== "IDAT") . chunkName) cs
 
-test :: IO PNG
-test = fst . fromBinary () <$> readBinaryFile "tmp/sample.png"
+footer :: PNG -> [Chunk]
+footer PNG{ chunks = cs } = filter ((== "IEND") . chunkName) cs
 
+concatIDATs :: [IDAT] -> ByteString
+concatIDATs = concat . map idat
+
+makeIDAT :: BS.ByteString -> Chunk
+makeIDAT bs = Chunk {
+	chunkSize = fromIntegral $ BS.length bs,
+	chunkName = "IDAT",
+	chunkData = ChunkIDAT $ IDAT $ fromChunks [bs],
+	chunkCRC = crc $ "IDAT" ++ BSC.unpack bs }
+
 [binary|
 
 PNG deriving Show
@@ -71,80 +80,70 @@
 2: "\r\n"
 1: "\SUB"
 1: "\n"
-((), Nothing){[Chank]}: chanks
+((), Nothing){[Chunk]}: chunks
 
 |]
 
 [binary|
 
-Chank deriving Show
+Chunk deriving Show
 
-4: chankSize
-((), Just 4){String}: chankName
-(chankSize, chankName){ChankBody}: chankData
-4{Word32}:chankCRC
+4: chunkSize
+((), Just 4){String}: chunkName
+(chunkSize, chunkName){ChunkBody}: chunkData
+4{Word32}:chunkCRC
 
 |]
 
 instance Field Word32 where
 	type FieldArgument Word32 = Int
-	toBinary n = makeBinary . BSL.pack . intToWords n
-	fromBinary n s = (fromIntegral $ toIntgr $ BSL.reverse t, d)
-		where
-		(t, d) = getBytes n s
+	toBinary n = makeBinary . pack . intToWords n
+	fromBinary n = first (wordsToInt . unpack) . getBytes n
 
-toIntgr :: BSL.ByteString -> Integer
-toIntgr = mkNum . map fromIntegral . BSL.unpack
+intToWords :: (Bits i, Integral i) => Int -> i -> [Word8]
+intToWords = itw []
+	where
+	itw r 0 _ = r
+	itw r n i = itw (fromIntegral (i .&. 0xff) : r) (n - 1) (i `shiftR` 8)
 
-mkNum :: [Integer] -> Integer
-mkNum [] = 0
-mkNum (x : xs) = x + 2 ^ (8 :: Integer) * mkNum xs
+wordsToInt :: Bits i => [Word8] -> i
+wordsToInt = foldl (\r w -> r `shiftL` 8 .|. fromIntegral w) 0
 
-data ChankBody
-	= ChankIHDR IHDR
-	| ChankGAMA GAMA
-	| ChankSRGB SRGB
-	| ChankCHRM CHRM
-	| ChankPLTE PLTE
-	| ChankBKGD BKGD
-	| ChankIDAT { cidat :: IDAT }
-	| ChankTEXT TEXT
-	| ChankIEND IEND
+data ChunkBody
+	= ChunkIHDR IHDR
+	| ChunkGAMA GAMA
+	| ChunkSRGB SRGB
+	| ChunkCHRM CHRM
+	| ChunkPLTE PLTE
+	| ChunkBKGD BKGD
+	| ChunkIDAT { cidat :: IDAT }
+	| ChunkTEXT TEXT
+	| ChunkIEND IEND
 	| Others String
 	deriving Show
 
-instance Field ChankBody where
-	type FieldArgument ChankBody = (Int, String)
-	toBinary _ (ChankIHDR c) = toBinary () c
-	toBinary _ (ChankGAMA c) = toBinary () c
-	toBinary _ (ChankSRGB c) = toBinary () c
-	toBinary (n, _) (ChankCHRM chrm) = toBinary n chrm
-	toBinary (n, _) (ChankPLTE plte) = toBinary n plte
-	toBinary _ (ChankBKGD c) = toBinary () c
-	toBinary (n, _) (ChankIDAT c) = toBinary n c
-	toBinary (n, _) (ChankTEXT c) = toBinary n c
-	toBinary _ (ChankIEND c) = toBinary () c
+instance Field ChunkBody where
+	type FieldArgument ChunkBody = (Int, String)
+	toBinary _ (ChunkIHDR c) = toBinary () c
+	toBinary _ (ChunkGAMA c) = toBinary () c
+	toBinary _ (ChunkSRGB c) = toBinary () c
+	toBinary (n, _) (ChunkCHRM chrm) = toBinary n chrm
+	toBinary (n, _) (ChunkPLTE plte) = toBinary n plte
+	toBinary _ (ChunkBKGD c) = toBinary () c
+	toBinary (n, _) (ChunkIDAT c) = toBinary n c
+	toBinary (n, _) (ChunkTEXT c) = toBinary n c
+	toBinary _ (ChunkIEND c) = toBinary () c
 	toBinary (n, _) (Others str) = toBinary ((), Just n) str
-	fromBinary (_, "IHDR") str = let (ihdr, rest) = fromBinary () str in
-		(ChankIHDR ihdr, rest)
-	fromBinary (_, "gAMA") str = let (gama, rest) = fromBinary () str in
-		(ChankGAMA gama, rest)
-	fromBinary (_, "sRGB") str = let (c, rest) = fromBinary () str in
-		(ChankSRGB c, rest)
-	fromBinary (n, "cHRM") str = let (chrm, rest) = fromBinary n str in
-		(ChankCHRM chrm, rest)
-	fromBinary (n, "PLTE") str = let (plte, rest) = fromBinary n str in
-		(ChankPLTE plte, rest)
-	fromBinary (_, "bKGD") str = let (c, rest) = fromBinary () str in
-		(ChankBKGD c, rest)
-	fromBinary (n, "IDAT") str = let (c, rest) = fromBinary n str in
-		(ChankIDAT c, rest)
-	fromBinary (n, "tEXt") str = let (c, rest) = fromBinary n str in
-		(ChankTEXT c, rest)
-	fromBinary (_, "IEND") str = let (iend, rest) = fromBinary () str in
-		(ChankIEND iend, rest)
-	fromBinary (n, _) str = let (others, rest) = fromBinary ((), Just n) str in
-		(Others others, rest)
+	fromBinary (_, "IHDR") = first ChunkIHDR . fromBinary ()
+	fromBinary (_, "gAMA") = first ChunkGAMA . fromBinary ()
+	fromBinary (_, "sRGB") = first ChunkSRGB . fromBinary ()
+	fromBinary (n, "cHRM") = first ChunkCHRM . fromBinary n
+	fromBinary (n, "PLTE") = first ChunkPLTE . fromBinary n
+	fromBinary (_, "bKGD") = first ChunkBKGD . fromBinary ()
+	fromBinary (n, "IDAT") = first ChunkIDAT . fromBinary n
+	fromBinary (n, "tEXt") = first ChunkTEXT . fromBinary n
+	fromBinary (_, "IEND") = first ChunkIEND . fromBinary ()
+	fromBinary (n, _) = first Others . fromBinary ((), Just n)
 
 [binary|
 
@@ -153,7 +152,14 @@
 4: width
 4: height
 1: depth
-1: colorType
+: False
+: False
+: False
+: False
+: False
+{Bool}: alpha
+{Bool}: color
+{Bool}: palet
 1: compressionType
 1: filterType
 1: interlaceType
@@ -191,6 +197,7 @@
 [binary|
 
 PLTE deriving Show
+
 arg :: Int
 
 ((), Just (arg `div` 3)){[(Int, Int, Int)]}: colors
@@ -199,13 +206,12 @@
 
 instance Field (Int, Int, Int) where
 	type FieldArgument (Int, Int, Int) = ()
-	toBinary _ (b, g, r) =
-		mconcat [toBinary 1 b, toBinary 1 g, toBinary 1 r]
+	toBinary _ (b, g, r) = mconcat [toBinary 1 b, toBinary 1 g, toBinary 1 r]
 	fromBinary _ s = let
-		(b, rest) = fromBinary 1 s
+		(r, rest) = fromBinary 1 s
 		(g, rest') = fromBinary 1 rest
-		(r, rest'') = fromBinary 1 rest' in
-		((b, g, r), rest'')
+		(b, rest'') = fromBinary 1 rest' in
+		((r, g, b), rest'')
 
 [binary|
 
@@ -221,8 +227,7 @@
 
 arg :: Int
 
-arg{BSL.ByteString}: idat
---((), Just arg){String}: idat
+arg{ByteString}: idat
 
 |]
 
diff --git a/examples/tiny.hs b/examples/tiny.hs
--- a/examples/tiny.hs
+++ b/examples/tiny.hs
@@ -1,23 +1,25 @@
 {-# LANGUAGE QuasiQuotes, TypeFamilies, ScopedTypeVariables #-}
 
-import File.Binary
-import File.Binary.Instances
-import File.Binary.Instances.LittleEndian
-import System.Directory
-import System.IO
-import Control.Applicative
-import Numeric
-import System.Environment
+import File.Binary (binary, Field(..), readBinaryFile, writeBinaryFile)
+import File.Binary.Instances ()
+-- import File.Binary.Instances.LittleEndian ()
+import File.Binary.Instances.BigEndian ()
+import Control.Applicative ((<$>))
+import Numeric (showHex)
+import System.Environment (getArgs)
 
-size = 4
+--------------------------------------------------------------------------------
 
+size :: Int
+size = 2
+
+main :: IO ()
 main = do
 	n <- read . head <$> getArgs
 	writeBinaryFile "tmp/out/tiny.dat" $ toBinary n $ Tiny 0x0123456789abcdef
-	(t ::Tiny, rest) <- fromBinary n <$> readBinaryFile "tmp/out/tiny.dat"
+	(t ::Tiny, "") <- fromBinary n <$> readBinaryFile "tmp/out/tiny.dat"
 	print t
 	putStrLn $ flip showHex "" $ value t
-	print rest
 
 [binary|
 
@@ -26,6 +28,14 @@
 arg :: Int
 
 4: "tiny"
+: True
+: False
+: False
+: False
+: True
+: False
+: False
+: True
 Main.size * arg{Integer}: value
 
 |]
diff --git a/src/File/Binary.hs b/src/File/Binary.hs
--- a/src/File/Binary.hs
+++ b/src/File/Binary.hs
@@ -1,9 +1,6 @@
 module File.Binary (
-	Field(..),
-	Binary(..),
-	binary,
-	readBinaryFile,
-	writeBinaryFile
+	Field(..), Binary(..), binary,
+	readBinaryFile, writeBinaryFile
  ) where
 
 import File.Binary.Quote (Field(..), Binary(..), binary)
@@ -13,4 +10,4 @@
 readBinaryFile path = openBinaryFile path ReadMode >>= hGetContents
 
 writeBinaryFile :: FilePath -> String -> IO ()
-writeBinaryFile f txt = withBinaryFile f WriteMode $ \hdl -> hPutStr hdl txt
+writeBinaryFile f = withBinaryFile f WriteMode . flip hPutStr
diff --git a/src/File/Binary/Classes.hs b/src/File/Binary/Classes.hs
--- a/src/File/Binary/Classes.hs
+++ b/src/File/Binary/Classes.hs
@@ -1,14 +1,43 @@
-{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeFamilies, TupleSections #-}
 
-module File.Binary.Classes (Field(..), Binary(..)) where
+module File.Binary.Classes (Field(..), Binary(..), pop, push) where
 
-import Data.Monoid (Monoid)
-import Data.ByteString.Lazy (ByteString)
+import Data.ByteString.Lazy (ByteString, unpack, singleton)
+import Data.Bits ((.&.), (.|.), shiftL, shiftR)
+import Data.Monoid (Monoid, mappend, mempty)
+import Control.Arrow (first, second)
 
-class Field r where
-	type FieldArgument r
-	fromBinary :: Binary s => FieldArgument r -> s -> (r, s)
-	toBinary :: Binary s => FieldArgument r -> r -> s
+type AddBits b = ([Bool], b)
+
+class Field f where
+	type FieldArgument f
+	fromBinary :: Binary b => FieldArgument f -> b -> (f, b)
+	toBinary :: Binary b => FieldArgument f -> f -> b
+	fromBits :: Binary b => FieldArgument f -> AddBits b -> (f, AddBits b)
+	consToBits :: Binary b => FieldArgument f -> f -> AddBits b -> AddBits b
+
+	fromBits a ([], b) = second ([] ,) $ fromBinary a b
+	fromBits _ _ = error "fromBits: not bytes (1 byte = 8 bits)"
+	consToBits a f ([], b) = ([], toBinary a f `mappend` b)
+	consToBits _ _ _ = error "consToBits: not bytes (1 byte = 8 bits)"
+
+	fromBinary a b = case fromBits a ([], b) of
+		(f, ([], rest)) -> (f, rest)
+		_ -> error "fromBinary: not bytes (1 byte = 8 bits)"
+	toBinary a f = case consToBits a f ([], mempty) of
+		([], bin) -> bin
+		_ -> error "toBinary: not bytes (1 byte = 8 bits)"
+
+pop :: Binary b => b -> AddBits b
+pop = first (wtbs (8 :: Int) . head . unpack) . getBytes 1
+	where
+	wtbs 0 _ = []
+	wtbs n w = toEnum (fromIntegral $ 1 .&. w) : wtbs (n - 1) (w `shiftR` 1)
+
+push :: Binary b => AddBits b -> b
+push = uncurry $ mappend . makeBinary . singleton . bstw
+	where
+	bstw = foldr (\b w -> w `shiftL` 1 .|. fromIntegral (fromEnum b)) 0
 
 class (Eq b, Monoid b) => Binary b where
 	getBytes :: Int -> b -> (ByteString, b)
diff --git a/src/File/Binary/Instances.hs b/src/File/Binary/Instances.hs
--- a/src/File/Binary/Instances.hs
+++ b/src/File/Binary/Instances.hs
@@ -1,86 +1,62 @@
-{-# LANGUAGE
-	TypeFamilies,
-	TypeSynonymInstances,
-	FlexibleInstances #-}
+{-# LANGUAGE TypeFamilies, TypeSynonymInstances, FlexibleInstances, PackageImports #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module File.Binary.Instances () where
 
+import Prelude hiding (take, drop)
 import File.Binary.Classes (Field(..), Binary(..))
-import qualified Data.ByteString as BS
-	(ByteString, take, drop, concat)
-import qualified Data.ByteString.Lazy as BSL
-	(ByteString, take, drop, toChunks, fromChunks)
-import qualified Data.ByteString.Lazy.Char8 as BSLC (pack, unpack)
+import Data.ByteString.Lazy (ByteString, take, drop, toChunks, fromChunks)
+import Data.ByteString.Lazy.Char8 (pack, unpack)
+import qualified Data.ByteString as BS (ByteString, take, drop, concat)
+import Control.Monad (replicateM)
+import "monads-tf" Control.Monad.State (StateT(..), runState, gets)
+import "monads-tf" Control.Monad.Identity (Identity(..))
+import Control.Applicative ((<$>), (<*>))
 import Control.Arrow (first, (&&&))
-import Data.Monoid
+import Data.Monoid (mempty)
 
-instance Field BSL.ByteString where
-	type FieldArgument BSL.ByteString = Int
-	fromBinary n str = getBytes n str
+--------------------------------------------------------------------------------
+
+instance Field ByteString where
+	type FieldArgument ByteString = Int
+	fromBinary = getBytes
 	toBinary _ = makeBinary
 
 instance Field BS.ByteString where
 	type FieldArgument BS.ByteString = Int
-	fromBinary n str =
-		first (BS.concat . BSL.toChunks) $ getBytes n str
-	toBinary _ = makeBinary . BSL.fromChunks . (: [])
+	fromBinary n = first (BS.concat . toChunks) . getBytes n
+	toBinary _ = makeBinary . fromChunks . (: [])
 
 instance Field Char where
 	type FieldArgument Char = ()
-	fromBinary _ str = (head $ BSLC.unpack t, d)
-		where
-		(t, d) = getBytes 1 str
-	toBinary _ = makeBinary . BSLC.pack . (: [])
+	fromBinary _ = first (head . unpack) . getBytes 1
+	toBinary _ = makeBinary . pack . (: [])
 
 instance Field r => Field [r] where
 	type FieldArgument [r] = (FieldArgument r, Maybe Int)
-	fromBinary (a, Just b) s = (b `times` fromBinary a) s
-	fromBinary (a, Nothing) s = whole (fromBinary a) s
-	toBinary (a, _) rs = mconcat $ map (toBinary a) rs
+	fromBits (a, Just b) = b `times` fromBits a
+	fromBits (a, Nothing) = mempty `whole` fromBits a
+	consToBits (a, _) = flip $ foldr $ consToBits a
 
 times :: Int -> (s -> (ret, s)) -> s -> ([ret], s)
-times 0 _ s = ([], s)
-times n f s = let
-	(ret, rest) = f s
-	(rets, rest') = times (n - 1) f rest in
-	(ret : rets, rest')
+times n f = runState $ replicateM n (StateT $ Identity . f)
 
-whole :: Binary s => (s -> (ret, s)) -> s -> ([ret], s)
-whole f s
-	| s == mempty = ([], s)
-	| otherwise = let
-		(ret, rest) = f s
-		(rets, rest') = whole f rest in
-		(ret : rets, rest')
+whole :: Eq s => s -> (s -> (ret, s)) -> s -> ([ret], s)
+whole e f = runState $ do
+	emp <- gets (== e)
+	if emp then return [] else
+		(:) <$> (StateT $ Identity . f) <*> (StateT $ Identity . whole e f)
 
 --------------------------------------------------------------------------------
 
 instance Binary String where
-	getBytes n = BSLC.pack . take n &&& drop n
-	makeBinary = BSLC.unpack
-
-{-
-	appendBinary = (++)
-	emptyBinary = null
--}
+	getBytes n = first pack . splitAt n
+	makeBinary = unpack
 
-instance Binary BSL.ByteString where
-	getBytes n = BSL.take (fromIntegral n) &&& BSL.drop (fromIntegral n)
+instance Binary ByteString where
+	getBytes n = take (fromIntegral n) &&& drop (fromIntegral n)
 	makeBinary = id
 
-{-
-	appendBinary = BSL.append
-	concatBinary = BSL.concat
-	emptyBinary = (== 0) . BSL.length
--}
-
 instance Binary BS.ByteString where
-	getBytes n = BSL.fromChunks . (: []) . BS.take n &&& BS.drop n
-	makeBinary = BS.concat . BSL.toChunks
-
-{-
-	appendBinary = BS.append
-	concatBinary = BS.concat
-	emptyBinary = (== 0) . BS.length
--}
+	getBytes n = fromChunks . (: []) . BS.take n &&& BS.drop n
+	makeBinary = BS.concat . toChunks
diff --git a/src/File/Binary/Instances/BigEndian.hs b/src/File/Binary/Instances/BigEndian.hs
--- a/src/File/Binary/Instances/BigEndian.hs
+++ b/src/File/Binary/Instances/BigEndian.hs
@@ -1,38 +1,64 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
-module File.Binary.Instances.BigEndian (
-	intToWords
-) where
+module File.Binary.Instances.BigEndian (BitsInt) where
 
-import File.Binary.Classes
-import qualified Data.ByteString.Lazy as BSL
-import Data.Word
+import File.Binary.Classes (Field(..), Binary(..), pop, push)
+import Data.ByteString.Lazy (pack, unpack)
+import Data.Word (Word8)
+import Data.Bits (Bits, (.&.), (.|.), shiftL, shiftR)
+import Control.Arrow (first)
 
+--------------------------------------------------------------------------------
+
+instance Field Integer where
+	type FieldArgument Integer = Int
+	fromBinary n = first (wordsToInt . unpack) . getBytes n
+	toBinary n = makeBinary . pack . intToWords n
+
 instance Field Int where
 	type FieldArgument Int = Int
-	fromBinary n s = (
-		wordsToInt $ BSL.unpack $ fst $ getBytes n s,
-		snd $ getBytes n s
-	 )
---	toBinary n = makeBinary . BSLC.pack . reverse . lintToBin n . fromIntegral
-	toBinary n = makeBinary . BSL.pack . intToWords n
+	fromBinary n = first (wordsToInt . unpack) . getBytes n
+	toBinary n = makeBinary . pack . intToWords n
 
-wordsToInt :: Integral i => [Word8] -> i
-wordsToInt = foldl (\i w -> i * 256 + fromIntegral w) 0
+wordsToInt :: Bits i => [Word8] -> i
+wordsToInt = foldl (\i w -> i `shiftL` 8 .|. fromIntegral w) 0
 
-intToWords :: Integral i => Int -> i -> [Word8]
+intToWords :: (Bits i, Integral i) => Int -> i -> [Word8]
 intToWords = itw []
 	where
-	itw result 0 _ = result
-	itw result n i =
-		itw (fromIntegral (i `mod` 256) : result) (n - 1) (i `div` 256)
+	itw r 0 _ = r
+	itw r n i = itw (fromIntegral (i .&. 0xff) : r) (n - 1) (i `shiftR` 8)
 
-instance Field Integer where
-	type FieldArgument Integer = Int
-	fromBinary n s = (
-		wordsToInt $ BSL.unpack $ fst $ getBytes n s,
-		snd $ getBytes n s
-	 )
---	toBinary n = makeBinary . BSLC.pack . reverse . lintToBin n . fromIntegral
-	toBinary n = makeBinary . BSL.pack . intToWords n
+instance Field Bool where
+	type FieldArgument Bool = ()
+	fromBits () ([], bin) = fromBits () $ pop bin
+	fromBits () (bs, bin) = (last bs, (init bs, bin))
+	consToBits () b (bs, bin)
+		| length bs == 7 = ([], push (bs ++ [b], bin))
+		| otherwise = (bs ++ [b], bin)
+
+data BitsInt = BitsInt { bitsInt :: Int } deriving Show
+
+instance Field BitsInt where
+	type FieldArgument BitsInt = Int
+	fromBits n = first BitsInt . fb n 0
+	consToBits n = ctb n . bitsInt
+
+fromEnum' :: (Enum e, Num i) => e -> i
+fromEnum' = fromIntegral . fromEnum
+
+toEnum' :: (Enum e, Integral i) => i -> e
+toEnum' = toEnum . fromIntegral
+
+fb :: (Bits f, Binary b) => Int -> f -> ([Bool], b) -> (f, ([Bool], b))
+fb 0 r bb = (r, bb)
+fb n r ([], b) = fb n r $ pop b
+fb n r (bs, b) = fb (n - 1) (r `shiftL` 1 .|. (fromEnum' $ last bs)) (init bs, b)
+
+ctb :: (Bits f, Integral f, Binary b) => Int -> f -> ([Bool], b) -> ([Bool], b)
+ctb 0 _ r = r
+ctb n f (bs, b)
+	| length bs == 7 = ctb (n - 1) (f `shiftR` 1) ([], push (bs ++ [bit], b))
+	| otherwise = ctb (n - 1) (f `shiftR` 1) (bs ++ [bit], b)
+	where bit = toEnum' $ f .&. 1
diff --git a/src/File/Binary/Instances/LittleEndian.hs b/src/File/Binary/Instances/LittleEndian.hs
--- a/src/File/Binary/Instances/LittleEndian.hs
+++ b/src/File/Binary/Instances/LittleEndian.hs
@@ -1,26 +1,50 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
-module File.Binary.Instances.LittleEndian where
+module File.Binary.Instances.LittleEndian (BitsInt) where
 
-import File.Binary.Classes
-import qualified Data.ByteString.Lazy as BSL
-import Data.Word
-import Control.Arrow
+import File.Binary.Classes (Field(..), Binary(..), pop, push)
+import Data.ByteString.Lazy (pack, unpack)
+import Data.Word (Word8)
+import Data.Bits (Bits, (.&.), (.|.), shiftL, shiftR)
+import Control.Arrow (first)
 
 instance Field Int where
 	type FieldArgument Int = Int
-	fromBinary n = first (wordsToInt . BSL.unpack) . getBytes n
-	toBinary n = makeBinary . BSL.pack . intToWords n
+	fromBinary n = first (wordsToInt . unpack) . getBytes n
+	toBinary n = makeBinary . pack . intToWords n
 
 instance Field Integer where
 	type FieldArgument Integer = Int
-	fromBinary n = first (wordsToInt . BSL.unpack) . getBytes n
-	toBinary n = makeBinary . BSL.pack . intToWords n
+	fromBinary n = first (wordsToInt . unpack) . getBytes n
+	toBinary n = makeBinary . pack . intToWords n
 
-wordsToInt :: Integral i => [Word8] -> i
-wordsToInt = foldr (\w i -> fromIntegral w + 256 * i) 0
+wordsToInt :: Bits i => [Word8] -> i
+wordsToInt = foldr (\w i -> fromIntegral w .|. i `shiftL` 8) 0
 
-intToWords :: Integral i => Int -> i -> [Word8]
+intToWords :: (Bits i, Integral i) => Int -> i -> [Word8]
 intToWords 0 _ = []
-intToWords n i = fromIntegral (i `mod` 256) : intToWords (n - 1) (i `div` 256)
+intToWords n i = fromIntegral (i .&. 0xff) : intToWords (n - 1) (i `shiftR` 8)
+
+instance Field Bool where
+	type FieldArgument Bool = ()
+	fromBits () ([], bin) = fromBits () $ pop bin
+	fromBits () (b : bs, bin) = (b, (bs, bin))
+	consToBits () b (bs, bin)
+		| length bs == 7 = ([], push ((b : bs), bin))
+		| otherwise = (b : bs, bin)
+
+data BitsInt = BitsInt { bitsInt :: Int } deriving Show
+
+instance Field BitsInt where
+	type FieldArgument BitsInt = Int
+	fromBits 0 bb = (BitsInt 0, bb)
+	fromBits n ([], bin) = fromBits n $ pop bin
+	fromBits n (b : bs, bin) = flip first (fromBits (n - 1) (bs, bin)) $
+		BitsInt . (fromEnum b .|.) . (`shiftL` 1) . bitsInt
+	consToBits 0 _ bb = bb
+	consToBits n (BitsInt f) bb = let
+		(bs, bin) = consToBits (n - 1) (BitsInt $ f `shiftR` 1) bb in
+		if length bs == 7
+			then ([], push (toEnum (f .&. 1) : bs, bin))
+			else (toEnum (f .&. 1) : bs, bin)
diff --git a/src/File/Binary/Parse.hs b/src/File/Binary/Parse.hs
--- a/src/File/Binary/Parse.hs
+++ b/src/File/Binary/Parse.hs
@@ -7,55 +7,57 @@
 	-fno-warn-unused-do-bind #-}
 
 module File.Binary.Parse (
-	parse, BinaryStructure, bsName, bsDerive, bsArgName, bsArgType, bsItem,
-	BSItem, argOf, valueOf, Value(..), variables, Expression, expression,
+	parse, Structure, sName, sDerive, sArgName, sArgType, sItems,
+	SItem, argOf, valueOf, constant, Value, expression
 ) where
 
-import Control.Applicative ((<$>), (<*>))
-import "monads-tf" Control.Monad.Reader (Reader, runReader, ask)
-import Data.Maybe (catMaybes)
-import Numeric (readHex)
-
 import Text.Peggy (peggy, parseString, space, defaultDelimiter)
 import Language.Haskell.TH (
-	ExpQ, litE, varE, conE, appE, tupE, integerL, uInfixE, parensE,
-	TypeQ, appT, conT, listT, tupleT, Name, mkName)
+	ExpQ, integerL, litE, varE, conE, tupE, appE, uInfixE, parensE,
+	TypeQ, conT, listT, tupleT, appT, Name, mkName)
+import "monads-tf" Control.Monad.Reader (Reader, runReader, ask)
+import Control.Applicative ((<$>), (<*>))
+import Control.Arrow(second)
+import Data.Maybe (fromMaybe)
+import Numeric (readHex)
 
 --------------------------------------------------------------------------------
 
-parse :: String -> BinaryStructure
+parse :: String -> Structure
 parse = either (error . show) id . parseString top ""
 
-data BinaryStructure = BinaryStructure {
-	bsName :: Name,
-	bsDerive :: [Name],
-	bsArgName :: String,
-	bsArgType :: TypeQ,
-	bsItem :: [BSItem] }
+data Structure = Structure {
+	sName :: Name,
+	sDerive :: [Name],
+	sArgName :: String,
+	sArgType :: TypeQ,
+	sItems :: [SItem] }
 
-data BSItem = BSItem { argOf :: Expression, typeOf :: TypeQ, valueOf :: Value }
+data SItem = SItem { argOf :: Expression, valueOf :: Value }
 type Expression	= Reader (ExpQ, ExpQ, String) ExpQ
 
 expression :: ExpQ -> ExpQ -> String -> Expression -> ExpQ
 expression ret arg argn e = runReader e (ret, arg, argn)
 
-data Value = Constant (Either Integer String) | Variable Name
+type Value = Either Constant (Name, TypeQ)
 
-variables :: [BSItem] -> [(Name, TypeQ)]
-variables = catMaybes . map (\bsi -> case valueOf bsi of
-		Variable var -> Just (var, typeOf bsi); _ -> Nothing)
+data Constant = Integer Integer | String String | Bool Bool deriving Show
 
-varToExp :: String -> (ExpQ, ExpQ, String) -> ExpQ
-varToExp var (ret, arg, argn)
+constant :: (Integer -> a) -> (String -> a) -> (Bool -> a) -> Constant -> a
+constant f _ _ (Integer i) = f i
+constant _ f _ (String s) = f s
+constant _ _ f (Bool b) = f b
+
+identify :: String -> (ExpQ, ExpQ, String) -> ExpQ
+identify var (ret, arg, argn)
 	| var == argn = arg
 	| '.' `elem` var = varE $ mkName var
 	| otherwise = appE (varE $ mkName var) ret
 
 [peggy|
 
-top :: BinaryStructure
-	= emp lname der arg dat*
-				{ BinaryStructure $2 $3 (fst $4) (snd $4) $5 }
+top :: Structure
+	= emp lname der arg dat*	{ Structure $2 $3 (fst $4) (snd $4) $5 }
 
 der :: [Name]
 	= emp 'deriving' sp ln (sp ',' sp ln)*
@@ -66,17 +68,18 @@
 	= emp var sp '::' sp typ	{ ($2, $5) }
 	/ ''				{ ("_", conT $ mkName "()") }
 
-dat :: BSItem
-	= emp ex sp typS sp ':' sp val	{ BSItem $2 $4 $7 }
+dat :: SItem = emp ex? sp typS sp ':' sp val
+	{ SItem (fromMaybe (return $ conE $ mkName "()") $2) $
+		either Left (Right . second (const $4)) $7 }
 
-typS :: TypeQ
-	= '{' typ '}'			{ $1 }
-	/ ''				{ conT $ mkName "Int" }
+typS :: TypeQ = '{' typ '}' / ''	{ conT $ mkName "Int" }
 
 val :: Value
-	= var				{ Variable $ mkName $1 }
-	/ num				{ Constant $ Left $1 }
-	/ string			{ Constant $ Right $1 }
+	= var				{ Right $ (mkName $1, conT $ mkName "()") }
+	/ num				{ Left $ Integer $1 }
+	/ string			{ Left $ String $1 }
+	/ 'True'			{ Left $ Bool True }
+	/ 'False'			{ Left $ Bool False }
 
 ex :: Expression
 	= ex sp op sp exOp1		{ uInfixE <$> $1 <*> $3 <*> $5 }
@@ -87,37 +90,33 @@
 	/ ex1
 
 ex1 :: Expression
-	= '(' tupExp ')'
+	= '(' ex (sp ',' sp ex)+ ')'	{ (.) tupE . (:) <$> $1 <*>
+						mapM (\(_, _, e) -> e) $2 }
 	/ '(' ex ')'			{ parensE <$> $1 }
 	/ '()'				{ return $ conE $ mkName "()" }
 	/ num				{ return $ litE $ integerL $1 }
 	/ lname				{ return $ conE $1 }
-	/ var				{ flip fmap ask $ varToExp $1 }
+	/ var				{ identify $1 <$> ask }
 
 op :: Expression
 	= [!\\#$%&*+./<=>?@^|~-:]+	{ return $ varE $ mkName $1 }
 	/ '`' var '`'			{ return $ varE $ mkName $1 }
-tupExp :: Expression = ex (sp ',' sp ex)+
-	{ (.) tupE . (:) <$> $1 <*> mapM (\(_, _, e) -> e) $2 }
 
 typ :: TypeQ
 	= typ typ1			{ appT $1 $2 }
 	/ typ1
 
 typ1 :: TypeQ
-	= '(' tupType ')'		{ foldl appT (tupleT $ length $1) $1 }
+	= '(' typ sp (',' sp typ)+ ')'	{ foldl appT (tupleT $ length $3 + 1) $
+						$1 : map snd $3 }
 	/ '(' typ ')'
 	/ '()'				{ conT $ mkName "()" }
 	/ '[' typ ']'			{ appT listT $1 }
 	/ lname				{ conT $1 }
-tupType :: [TypeQ]
-	= typ sp (',' sp typ)+	{ $1 : map snd $3 }
 
-lname :: Name
-	= (ln '.')* ln			{ mkName $ concatMap (++ ".") $1 ++ $2 }
+lname :: Name = (ln '.')* ln		{ mkName $ concatMap (++ ".") $1 ++ $2 }
 
-var :: String
-	= (ln '.')* sn			{ concatMap (++ ".") $1 ++ $2 }
+var :: String = (ln '.')* sn		{ concatMap (++ ".") $1 ++ $2 }
 
 num :: Integer
 	= '0x' [0-9a-fA-F]+		{ fst $ head $ readHex $1 }
diff --git a/src/File/Binary/Quote.hs b/src/File/Binary/Quote.hs
--- a/src/File/Binary/Quote.hs
+++ b/src/File/Binary/Quote.hs
@@ -2,62 +2,58 @@
 
 module File.Binary.Quote (Field(..), Binary(..), binary) where
 
+import File.Binary.Parse (
+	parse, Structure, sName, sDerive, sArgName, sArgType, sItems,
+	SItem, argOf, valueOf, constant, Value, expression)
+import File.Binary.Classes (Field(..), Binary(..))
 import Language.Haskell.TH (
-	Q, DecsQ, ClauseQ, ExpQ, Dec, Exp(..), Name, FieldExp,
+	Q, DecsQ, ClauseQ, BodyQ, ExpQ, Dec, Exp(..), Name, FieldExp,
 	dataD, recC, varStrictType, strictType, notStrict,
 	instanceD, funD, clause, normalB, valD, tySynInstD, cxt,
 	conT, appT, sigE, varP, tupP, letE, condE, recConE, tupE, listE,
-	appE, appsE, infixApp, varE, litE, newName, integerL, stringL)
+	appE, appsE, infixApp, varE, conE, litE, newName, integerL, stringL)
 import Language.Haskell.TH.Quote (QuasiQuoter(..))
-import Data.Monoid (mconcat)
+import Data.ByteString.Lazy.Char8 (pack)
 import Control.Monad (zipWithM)
 import "monads-tf" Control.Monad.State (StateT, runStateT, get, put, lift)
 import "monads-tf" Control.Monad.Writer (WriterT, runWriterT, tell)
 import Control.Applicative ((<$>), (<*>))
-import qualified Data.ByteString.Lazy.Char8 as BSLC (ByteString, pack)
-
-import File.Binary.Parse (
-	parse, BinaryStructure, bsName, bsDerive, bsArgName, bsArgType, bsItem,
-	BSItem, argOf, valueOf, Value(..), variables, expression)
-import File.Binary.Classes (Field(..), Binary(..))
+import Data.Either (rights)
 
 --------------------------------------------------------------------------------
 
 binary :: QuasiQuoter
 binary = QuasiQuoter {
 	quoteExp = undefined, quotePat = undefined, quoteType = undefined,
-	quoteDec = top . parse
- }
+	quoteDec = top . parse }
 
-top :: BinaryStructure -> DecsQ
-top bs = let c = bsName bs in (\d i -> [d, i])
+top :: Structure -> DecsQ
+top bs = let c = sName bs in (\d i -> [d, i])
 	<$> dataD (cxt []) c [] [recC c $
 		map (varStrictType <$> fst <*> strictType notStrict . snd) $
-			variables $ bsItem bs] (bsDerive bs)
+			rights $ map valueOf $ sItems bs] (sDerive bs)
 	<*> instanceD (cxt []) (appT (conT ''Field) (conT c)) [
-		tySynInstD ''FieldArgument [conT c] $ bsArgType bs,
-		funD 'fromBinary $ (: []) $ reading c (bsArgName bs) (bsItem bs),
-		funD 'toBinary $ (: []) $ writing (bsArgName bs) (bsItem bs)
-	 ]
+		tySynInstD ''FieldArgument [conT c] $ sArgType bs,
+		funD 'fromBits $ (: []) $ reading c (sArgName bs) (sItems bs),
+		funD 'consToBits $ (: []) $ writing (sArgName bs) (sItems bs)]
 
-reading :: Name -> String -> [BSItem] -> ClauseQ
-reading con argn items = do
+reading :: Name -> String -> [SItem] -> ClauseQ
+reading c argn is = do
 	arg <- newName "_arg"
-	bin <- newName "bin"
-	flip (clause [varP arg, varP bin]) [] $
-		normalB $ letRec $ binToDat con items (varE bin) $ \ret ->
-			expression ret (varE arg) argn . argOf
+	b <- newName "bin"
+	flip (clause [varP arg, varP b]) [] $ letRec $ readfs c is (varE b) $
+		\ret -> expression ret (varE arg) argn . argOf
 
-letRec :: (ExpQ -> ExpQ) -> ExpQ
-letRec e = do
+letRec :: (ExpQ -> ExpQ) -> BodyQ
+letRec e = normalB $ do
 	(ret, rest) <- (,) <$> newName "ret" <*> newName "rest"
 	letE [valD (tupP [varP ret, varP rest]) (normalB $ e $ varE ret) []] $
 		tupE [varE ret, varE rest]
 
-binToDat :: Name -> [BSItem] -> ExpQ -> (ExpQ -> BSItem -> ExpQ) -> ExpQ -> ExpQ
-binToDat con items bin size ret = do
+readfs :: Name -> [SItem] -> ExpQ -> (ExpQ -> SItem -> ExpQ) -> ExpQ -> ExpQ
+readfs con items bin size ret = do
 	((binds, rest), rts) <- runWriterT $ (`runStateT` bin) $
-		(zipWithM binToField <$> map (size ret) <*> map valueOf) items
+		(zipWithM readf <$> map (size ret) <*> map valueOf) items
 	letE (return <$> binds) $ tupE $ (: [rest]) $ recConE con $ return <$> rts
 
 type FieldMonad = StateT ExpQ (WriterT [FieldExp] Q)
@@ -68,41 +64,43 @@
 liftW :: WriterT [FieldExp] Q a -> FieldMonad a
 liftW = lift
 
-binToField :: ExpQ -> Value -> FieldMonad Dec
-binToField size (Constant val) = do
+readf :: ExpQ -> Value -> FieldMonad Dec
+readf size (Left val) = do
 	bin <- get
 	[rv, rest, bin'] <- liftQ $ mapM newName ["rv", "rst", "bin'"]
 	put $ varE bin'
-	let lit = either
+	let lit = constant
 		((`sigE` conT ''Integer) . litE . integerL)
-		((`sigE` conT ''BSLC.ByteString) .
-			appE (varE 'BSLC.pack) . litE . stringL) val
+		(appE (varE 'pack) . litE . stringL)
+		(\b -> if b then conE 'True else conE 'False)
+		val
 	liftQ $ flip (valD $ varP bin') [] $ normalB $
 		letE [flip (valD $ tupP [varP rv, varP rest]) [] $ normalB $
-			appsE [varE 'fromBinary, size, bin]] $
+			appsE [varE 'fromBits, size, bin]] $
 		condE (infixApp (varE rv) (varE '(==)) lit) (varE rest)
 			[e| error "bad value" |]
-binToField size (Variable var) = do
+readf size (Right (var, _)) = do
 	bin <- get
 	[bin', tmp] <- liftQ $ mapM newName ["bin'", "tmp"]
 	put $ varE bin'
 	liftW $ tell [(var, VarE tmp)]
 	liftQ $ valD (tupP [varP tmp, varP bin'])
-		(normalB $ appsE [varE 'fromBinary, size, bin]) []
+		(normalB $ appsE [varE 'fromBits, size, bin]) []
 
-writing :: String -> [BSItem] -> ClauseQ
+writing :: String -> [SItem] -> ClauseQ
 writing argn items = do
-	arg <- newName "_arg"
-	dat <- newName "_dat"
-	flip (clause [varP arg, varP dat]) [] $ normalB $
-		appE (varE 'mconcat) $ listE $ (<$> items) $ fieldToBin dat
-			<$> expression (varE dat) (varE arg) argn . argOf
-			<*> valueOf
+	[arg, dat, bin0] <- mapM newName ["_arg", "_dat", "bin0"]
+	flip (clause [varP arg, varP dat, varP bin0]) [] $ normalB $
+		appE (appsE [varE 'foldr, varE '($), varE bin0]) $ listE $
+			(<$> items) $ writef dat
+				<$> expression (varE dat) (varE arg) argn . argOf
+				<*> valueOf
 
-fieldToBin :: Name -> ExpQ -> Value -> ExpQ
-fieldToBin _ size (Constant val) =  varE 'toBinary `appE` size `appE` either
+writef :: Name -> ExpQ -> Value -> ExpQ
+writef _ size (Left val) = varE 'consToBits `appE` size `appE` constant
 	((`sigE` conT ''Integer) . litE . integerL)
-	((`sigE` conT ''BSLC.ByteString) . appE (varE 'BSLC.pack) . litE . stringL)
+	(appE (varE 'pack) . litE . stringL)
+	(\b -> if b then conE 'True else conE 'False)
 	val
-fieldToBin dat size (Variable val) =
-	varE 'toBinary `appE` size `appE` (varE val `appE` varE dat)
+writef dat size (Right (rec, _)) =
+	varE 'consToBits `appE` size `appE` (varE rec `appE` varE dat)