diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,27 @@
+Copyright (c) 2016 Mikhail Vorozhtsov
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+- Redistributions of source code must retain the above copyright notice,
+  this list of conditions and the following disclaimer.
+- Redistributions in binary form must reproduce the above copyright
+  notice, this list of conditions and the following disclaimer in the
+  documentation and/or other materials provided with the distribution.
+- Neither the names of the copyright owners nor the names of the
+  contributors may be used to endorse or promote products derived
+  from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,12 @@
+Data-SWord
+==========
+This package provides Template Haskell utilities for declaring short binary word
+data types built on top of longer binary word data types. Signed and unsigned
+2, 4, 7, 24, and 48-bit types are predefined.
+
+Installation
+------------
+The usual:
+
+	$ cabal install
+
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/data-sword.cabal b/data-sword.cabal
new file mode 100644
--- /dev/null
+++ b/data-sword.cabal
@@ -0,0 +1,53 @@
+Name: data-sword
+Version: 0.1
+Category: Data
+Stability: experimental
+Synopsis: Shorter binary words
+Description:
+  This package provides Template Haskell utilities for declaring short binary
+  word data types built on top of longer binary word data types. Signed and
+  unsigned 2, 4, 7, 24, and 48-bit types are predefined.
+
+Homepage: https://github.com/mvv/data-sword
+Bug-Reports: https://github.com/mvv/data-sword/issues
+
+Author: Mikhail Vorozhtsov <mikhail.vorozhtsov@gmail.com>
+Maintainer: Mikhail Vorozhtsov <mikhail.vorozhtsov@gmail.com>
+Copyright: 2016 Mikhail Vorozhtsov <mikhail.vorozhtsov@gmail.com>
+License: BSD3
+License-File: LICENSE
+
+Extra-Source-Files:
+  README.md
+
+Cabal-Version: >= 1.10.0
+Build-Type: Simple
+
+Source-Repository head
+  Type: git
+  Location: https://github.com/mvv/data-sword.git
+
+Library
+  Default-Language: Haskell2010
+  Build-Depends: base >= 4.6 && < 5
+               , template-haskell
+               , hashable >= 1.1
+               , data-bword >= 0.1
+  Hs-Source-Dirs: src
+  GHC-Options: -Wall
+  Exposed-Modules:
+    Data.ShortWord
+    Data.ShortWord.TH
+
+Test-Suite tests
+  Default-Language: Haskell2010
+  Type: exitcode-stdio-1.0
+  Build-Depends: base >= 4.6 && < 5
+               , tasty >= 0.8
+               , tasty-quickcheck >= 0.8
+               , data-sword
+  Hs-Source-Dirs: tests
+  GHC-Options: -Wall
+  Main-Is: Tests.hs
+  Other-Modules:
+    Types
diff --git a/src/Data/ShortWord.hs b/src/Data/ShortWord.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/ShortWord.hs
@@ -0,0 +1,30 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE UnicodeSyntax #-}
+{-# LANGUAGE TypeFamilies #-}
+
+-- | This module provides signed and unsigned binary word data types of sizes
+--   2, 4, 7, 24, and 48 bits.
+module Data.ShortWord
+  ( module Data.BinaryWord
+  , Word2
+  , Word4
+  , Word7
+  , Word24
+  , Word48
+  , Int2
+  , Int4
+  , Int7
+  , Int24
+  , Int48
+  ) where
+
+import Data.Typeable
+import Data.Word
+import Data.BinaryWord
+import Data.ShortWord.TH
+
+mkShortWord "Word2" "Word2" "Int2" "Int2" ''Word8 2 [''Typeable]
+mkShortWord "Word4" "Word4" "Int4" "Int4" ''Word8 4 [''Typeable]
+mkShortWord "Word7" "Word7" "Int7" "Int7" ''Word8 7 [''Typeable]
+mkShortWord "Word24" "Word24" "Int24" "Int24" ''Word32 24 [''Typeable]
+mkShortWord "Word48" "Word48" "Int48" "Int48" ''Word64 48 [''Typeable]
diff --git a/src/Data/ShortWord/TH.hs b/src/Data/ShortWord/TH.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/ShortWord/TH.hs
@@ -0,0 +1,617 @@
+{-# LANGUAGE UnicodeSyntax #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+-- | Template Haskell utilities for generating short words declarations
+module Data.ShortWord.TH
+  ( mkShortWord
+  ) where
+
+import GHC.Arr (Ix(..))
+import GHC.Enum (succError, predError, toEnumError)
+import Data.Ratio ((%))
+import Data.Bits (Bits(..))
+#if MIN_VERSION_base(4,7,0)
+import Data.Bits (FiniteBits(..))
+#endif
+#if MIN_VERSION_hashable(1,2,0)
+import Data.Hashable (Hashable(..), hashWithSalt)
+#else
+import Data.Hashable (Hashable(..), combine)
+#endif
+import Control.Applicative ((<$>), (<*>))
+import Language.Haskell.TH hiding (match)
+import Data.BinaryWord (BinaryWord(..))
+
+-- | Declare signed and unsigned binary word types that use a subset
+--   of the bits of the specified underlying type. For each data type
+--   the following instances are declared: 'Eq', 'Ord',
+--   'Bounded', 'Enum', 'Num', 'Real', 'Integral', 'Show', 'Read',
+--   'Hashable', 'Ix', 'Bits', 'BinaryWord'.
+mkShortWord ∷ String -- ^ Unsigned variant type name
+            → String -- ^ Unsigned variant constructor name
+            → String -- ^ Signed variant type name
+            → String -- ^ Signed variant constructor name
+            → Name   -- ^ The underlying (unsigned) type
+            → Int    -- ^ The bit length
+            → [Name] -- ^ List of instances for automatic derivation
+            → Q [Dec]
+mkShortWord un uc sn sc utp bl ad =
+    (++) <$> mkShortWord' False un' uc' sn' sc' utp bl ad
+         <*> mkShortWord' True  sn' sc' un' uc' utp bl ad
+  where un' = mkName un
+        uc' = mkName uc
+        sn' = mkName sn
+        sc' = mkName sc
+
+mkShortWord' ∷ Bool
+             → Name → Name
+             → Name → Name
+             → Name
+             → Int
+             → [Name]
+             → Q [Dec]
+mkShortWord' signed tp cn otp ocn utp bl ad = return $
+    [ NewtypeD [] tp []
+#if MIN_VERSION_template_haskell(2,11,0)
+               Nothing
+               (NormalC cn [(Bang NoSourceUnpackedness
+                                  NoSourceStrictness,
+                             uT)])
+               (ConT <$> ad)
+#else
+               (NormalC cn [(NotStrict, uT)])
+# if MIN_VERSION_template_haskell(2,10,0)
+               (ConT <$> ad)
+# else
+               ad
+# endif
+#endif
+    , inst ''Eq [tp] $
+        {- (W x) == (W y) = x == y -}
+        [ funUn2 '(==) $ appVN '(==) [x, y]
+        , inline '(==) ]
+    , inst ''Ord [tp]
+        {- compare (W x) (W y) = x `compare` y -}
+        [ funUn2 'compare $ appVN 'compare [x, y]
+        , inline 'compare ]
+    , inst ''Bounded [tp]
+        {- minBound = W (minBound .&. MASK) -}
+        [ fun 'minBound $ appW $ appV '(.&.) [VarE 'minBound, maskE]
+        , inline 'minBound
+        {- maxBound = W (maxBound .&. MASK) -}
+        , fun 'maxBound $ appW $ appV '(.&.) [VarE 'maxBound, maskE]
+        , inline 'maxBound ]
+    , inst ''Enum [tp]
+        {-
+          succ x@(W y) = if x == maxBound then succError "TYPE"
+                                          else W (y + shiftL 1 SHIFT)
+        -}
+        [ funUnAsX 'succ $
+            CondE (appVN '(==) [x, 'maxBound])
+                  (appV 'succError [litS (show tp)])
+                  (appW (appV '(+) [VarE y, appV 'shiftL [litI 1, shiftE]]))
+        , inlinable 'succ
+        {-
+          pred x@(W y) = if x == minBound then predError "TYPE"
+                                          else W (y - shiftL 1 SHIFT)
+        -}
+        , funUnAsX 'pred $
+            CondE (appVN '(==) [x, 'minBound])
+                  (appV 'predError [litS (show tp)])
+                  (appW (appV '(-) [VarE y, appV 'shiftL [litI 1, shiftE]]))
+        , inlinable 'pred
+        {-
+          toEnum x = if y < shiftR minBound SHIFT || y > shiftR maxBound SHIFT
+                     then toEnumError "TYPE" x [minBound ∷ TYPE, maxBound ∷ TYPE]
+                     else W (shiftL y SHIFT)
+            where y = toEnum x
+        -}
+        , funX' 'toEnum
+            (CondE (appV '(||) [ appV '(<) [ VarE y
+                                           , appV 'shiftR
+                                                  [VarE 'minBound, shiftE]
+                                           ]
+                               , appV '(>) [ VarE y
+                                           , appV 'shiftR
+                                                  [VarE 'maxBound, shiftE]
+                                           ]
+                               ])
+                   (appV 'toEnumError [ litS (show tp)
+                                      , VarE x
+                                      , TupE [ SigE (VarE 'minBound) tpT
+                                             , SigE (VarE 'maxBound) tpT
+                                             ]
+                                      ])
+                   (appW $ appV 'shiftL [VarE y, shiftE]))
+            [val y $ appVN 'toEnum [x]]
+        {- fromEnum (W x) = fromEnum (shiftR x SHIFT) -}
+        , funUn 'fromEnum $ appV 'fromEnum [appV 'shiftR [VarE x, shiftE]]
+        , inline 'fromEnum
+        {- enumFrom x = enumFromTo x maxBound -}
+        , funX 'enumFrom $ appVN 'enumFromTo [x, 'maxBound]
+        , inline 'enumFrom
+        {- 
+          enumFromThen x y =
+            enumFromThenTo x y $ if y >= x then maxBound else minBound 
+        -}
+        , funXY 'enumFromThen $
+            appV 'enumFromThenTo
+              [ VarE x
+              , VarE y
+              , CondE (appVN '(>=) [x, y]) (VarE 'maxBound) (VarE 'minBound)
+              ]
+        , inlinable 'enumFromThen
+        {-
+          enumFromTo x y = case y `compare` x of
+              LT → x : down y x
+              EQ → [x]
+              GT → x : up y x
+            where down to c = next : if next == to then [] else down to next
+                    where next = c - 1
+                  up to c = next : if next == to then [] else up to next
+                    where next = c + 1 
+        -}
+        , FunD 'enumFromTo $ return $
+            Clause
+              [VarP x, VarP y]
+              (NormalB $
+                 CaseE (appVN 'compare [y, x])
+                   [ Match
+                       (ConP 'LT [])
+                       (NormalB $ appC '(:) [VarE x, appVN down [y, x]])
+                       []
+                   , Match
+                       (ConP 'EQ [])
+                       (NormalB $ appC '(:) [VarE x, ConE '[]])
+                       []
+                   , Match
+                       (ConP 'GT [])
+                       (NormalB $ appC '(:) [VarE x, appVN up [y, x]])
+                       []
+                   ])
+              [ FunD down $ return $
+                  Clause [VarP to, VarP c]
+                    (NormalB $
+                       appC '(:)
+                         [ VarE next
+                         , CondE (appVN '(==) [next, to])
+                                 (ConE '[]) (appVN down [to, next])
+                         ])
+                    [ValD (VarP next)
+                          (NormalB $ appVN '(-) [c, 'lsb]) []]
+              , FunD up $ return $
+                  Clause [VarP to, VarP c]
+                    (NormalB $
+                       appC '(:)
+                         [ VarE next
+                         , CondE (appVN '(==) [next, to])
+                                 (ConE '[]) (appVN up [to, next])
+                         ])
+                    [ValD (VarP next)
+                          (NormalB $ appVN '(+) [c, 'lsb]) []]
+              ]
+        {-
+          enumFromThenTo x y z = case y `compare` x of 
+              LT → if z > x then [] else down (x - y) z x
+              EQ → repeat x
+              GT → if z < x then [] else up (y - x) z x
+            where down s to c = c : if next < to then [] else down s to next
+                    where next = c - s
+                  up s to c = c : if next > to then [] else up s to next
+                    where next = c + s 
+        -}
+        , FunD 'enumFromThenTo $ return $
+            Clause [VarP x, VarP y, VarP z]
+              (NormalB $
+                CaseE (appVN 'compare [y, x])
+                  [ Match
+                      (ConP 'LT [])
+                      (NormalB $
+                         CondE (appVN '(>) [z, x])
+                               (ConE '[])
+                               (appV down [appVN '(-) [x, y], VarE z, VarE x]))
+                      []
+                  , Match (ConP 'EQ []) (NormalB $ appVN 'repeat [x]) []
+                  , Match
+                      (ConP 'GT [])
+                      (NormalB $
+                         CondE (appVN '(<) [z, x]) (ConE '[])
+                               (appV up [appVN '(-) [y, x], VarE z, VarE x]))
+                      []
+                  ])
+              [ FunD down $ return $
+                  Clause [VarP step, VarP to, VarP c]
+                    (NormalB $
+                       appC '(:)
+                         [ VarE c
+                         , CondE (appVN '(<) [next, to])
+                                 (ConE '[]) (appVN down [step, to, next])
+                         ])
+                    [ValD (VarP next) (NormalB $ appVN '(-) [c, step]) []]
+              , FunD up $ return $
+                  Clause [VarP step, VarP to, VarP c]
+                    (NormalB $
+                       appC '(:)
+                         [ VarE c
+                         , CondE (appVN '(==) [next, to])
+                                 (ConE '[]) (appVN up [step, to, next])
+                         ])
+                    [ValD (VarP next) (NormalB $ appVN '(+) [c, step]) []]]
+        ]
+    , inst ''Num [tp]
+        {- negate (W x) = W (negate x) -}
+        [ funUn 'negate $ appW $ appVN 'negate [x]
+        , inline 'negate
+        {- 
+          abs x@(W y) = if SIGNED
+                        then if y < 0 then W (negate y) else x 
+                        else x
+        -}
+        , if signed
+          then funUnAsX 'abs $
+                 CondE (appVN '(<) [y, 'allZeroes])
+                       (appW $ appVN 'negate [y]) (VarE x)
+          else funX 'abs $ VarE x
+        , if signed then inlinable 'abs else inline 'abs
+        {- signum (W x) = W (shiftL (signum x) SHIFT) -}
+        , funUn 'signum $ appW $ appV 'shiftL [appVN 'signum [x], shiftE]
+        , inline 'signum
+        {- (W x) + (W y) = W (x + y) -}
+        , funUn2 '(+) $ appW $ appVN '(+) [x, y]
+        , inline '(+)
+        {- (W x) * (W y) = W (shiftR x SHIFT * y) -}
+        , funUn2 '(*) $
+            appW $ appV '(*) [appV 'shiftR [VarE x, shiftE], VarE y]
+        , inline '(*)
+        {- fromInteger x = W (shiftL (fromInteger x) SHIFT) -}
+        , funX 'fromInteger $
+            appW $ appV 'shiftL [appVN 'fromInteger [x], shiftE]
+        , inline 'fromInteger
+        ]
+    , inst ''Real [tp]
+        {- toRational x = toInteger x % 1 -}
+        [ funX 'toRational $ appV '(%) [appVN 'toInteger [x], litI 1]
+        , inline 'toRational ]
+    , inst ''Integral [tp] $
+        {- toInteger (W x) = toInteger (shiftR x SHIFT) -}
+        [ funUn 'toInteger $ appV 'toInteger [appV 'shiftR [VarE x, shiftE]]
+        , inline 'toInteger
+        {-
+           quotRem (W x) (W y) = (W (shiftL q SHIFT), W r)
+             where (q, r) = quotRem x y
+        -}
+        , funUn2' 'quotRem
+            (TupE [appW (appV 'shiftL [VarE q, shiftE]), appWN r])
+            [vals [q, r] $ appVN 'quotRem [x, y]]
+        , inline 'quotRem
+        {-
+           divMod (W x) (W y) = (W (shiftL q SHIFT), W r)
+             where (q, r) = divMod x y
+        -}
+        , funUn2' 'divMod
+            (TupE [appW (appV 'shiftL [VarE q, shiftE]), appWN r])
+            [vals [q, r] $ appVN 'divMod [x, y]]
+        , inline 'divMod
+        ]
+    , inst ''Show [tp]
+        [ {- show (W x) = show (shiftR x SHIFT) -}
+          funUn 'show $ appV 'show [appV 'shiftR [VarE x, shiftE]]
+        , inline 'show ]
+    , inst ''Read [tp]
+        {-
+          readsPrec x y = fmap (\(q, r) → (fromInteger q, r))
+                        $ readsPrec x y
+        -}
+        [ funXY 'readsPrec $
+            appV 'fmap [ LamE [TupP [VarP q, VarP r]]
+                              (TupE [appVN 'fromInteger [q], VarE r])
+                       , appVN 'readsPrec [x, y] ]
+        ]
+    , inst ''Hashable [tp]
+#if MIN_VERSION_hashable(1,2,0)
+        {- hashWithSalt x (W y) = x `hashWithSalt` y -}
+        [ funXUn 'hashWithSalt $ appVN 'hashWithSalt [x, y]
+#else
+        {- hash (W x) = hash x -}
+        [ funUn 'hash $ appVN 'hash [x]
+        , inline 'hash
+#endif
+        , inline 'hashWithSalt ]
+    , inst ''Ix [tp]
+        {- range (x, y) = enumFromTo x y -}
+        [ funTup 'range $ appVN 'enumFromTo [x, y]
+        , inline 'range
+        {- unsafeIndex (x, _) z = fromIntegral z - fromIntegral x -}
+        , funTupLZ 'unsafeIndex $
+            appV '(-) [appVN 'fromIntegral [z], appVN 'fromIntegral [x]]
+        , inline 'unsafeIndex
+        {- inRange (x, y) z = z >= x && z <= y -}
+        , funTupZ 'inRange $
+            appV '(&&) [appVN '(>=) [z, x], appVN '(<=) [z, y]]
+        , inline 'inRange ]
+    , inst ''Bits [tp] $
+        {- bitSize _ = SIZE -}
+        [ fun_ 'bitSize $ sizeE
+        , inline 'bitSize
+#if MIN_VERSION_base(4,7,0)
+        {- bitSizeMaybe _ = Just SIZE -}
+        , fun_ 'bitSizeMaybe $ app (ConE 'Just) [sizeE]
+        , inline 'bitSizeMaybe
+#endif
+        {- isSigned _ = SIGNED -}
+        , fun_ 'isSigned $ ConE $ if signed then 'True else 'False
+        , inline 'isSigned
+        {- complement (W x) = W (complement x .&. MASK) -}
+        , funUn 'complement $
+            appW $ appV '(.&.) [appVN 'complement [x], maskE]
+        , inline 'complement
+        {- xor (W x) (W y) = W (xor x y) -}
+        , funUn2 'xor $ appW $ appVN 'xor [x, y]
+        , inline 'xor
+        {- (W x) .&. (W y) = W (x .&. y) -}
+        , funUn2 '(.&.) $ appW $ appVN '(.&.) [x, y]
+        , inline '(.&.)
+        {- (W x) .|. (W y) = W (x .|. y) -}
+        , funUn2 '(.|.) $ appW $ appVN '(.|.) [x, y]
+        , inline '(.|.)
+        {- shiftL (W x) y = W (shiftL x y) -}
+        , funUnY 'shiftL $ appW $ appVN 'shiftL [x, y]
+        , inline 'shiftL
+        {- shiftR (W x) y = W (shiftR x y .&. MASK) -}
+        , funUnY 'shiftR $ appW $ appV '(.&.) [appVN 'shiftR [x, y], maskE]
+        , inline 'shiftR
+        {-
+           UNSIGNED:
+             rotateL (W x) y = W (shiftL x y .|.
+                                  (shiftR x (SIZE - y) .&. MASK))
+
+           SIGNED:
+             rotateL (W x) y =
+               W (shiftL x y .|.
+                  (signedWord (shiftR (unsignedWord x) (SIZE - y)) .&.
+                   MASK))
+        -}
+        , funUnY 'rotateL $ appW $ appV '(.|.) $ (appVN 'shiftL [x, y] :) $
+            return $ appV '(.&.) $
+              [ if signed
+                then appV 'signedWord [ appV 'shiftR
+                                             [ appVN 'unsignedWord [x]
+                                             , appV '(-) [sizeE, VarE y]
+                                             ]
+                                      ]
+                else appV 'shiftR [VarE x, appV '(-) [sizeE, VarE y]]
+              , maskE
+              ]
+        , inline 'rotateL
+        {- rotateR x y = rotateL x (SIZE - y) -}
+        , funXY 'rotateR $ appV 'rotateL [VarE x, appV '(-) [sizeE, VarE y]]
+        , inline 'rotateR
+        {- bit x = W (bit (x + SHIFT)) -}
+        , funX 'bit $ appW $ appV 'bit [appV '(+) [VarE x, shiftE]]
+        , inline 'bit
+        {- setBit (W x) y = W (setBit x (y + SHIFT)) -}
+        , funUnY 'setBit $
+            appW $ appV 'setBit [VarE x, appV '(+) [VarE y, shiftE]]
+        , inline 'setBit
+        {- clearBit (W x) y = W (clearBit x (y + SHIFT)) -}
+        , funUnY 'clearBit $
+            appW $ appV 'clearBit [VarE x, appV '(+) [VarE y, shiftE]]
+        , inline 'clearBit
+        {- complementBit (W x) y = W (complementBit x (y + SHIFT)) -}
+        , funUnY 'complementBit $
+            appW $ appV 'complementBit [VarE x, appV '(+) [VarE y, shiftE]]
+        , inline 'complementBit
+        {- testBit (W x) y = testBit x (y + SHIFT) -}
+        , funUnY 'testBit $ appV 'testBit [VarE x, appV '(+) [VarE y, shiftE]]
+        , inline 'testBit
+        {- popCount (W x) = popCount x -}
+        , funUn 'popCount $ appVN 'popCount [x]
+        , inline 'popCount
+        ]
+#if MIN_VERSION_base(4,7,0)
+    , inst ''FiniteBits [tp]
+        {- finiteBitSize _ = SIZE -}
+        [ fun_ 'finiteBitSize $ sizeE
+        , inline 'finiteBitSize
+# if MIN_VERSION_base(4,8,0)
+        {- countLeadingZeros = leadingZeroes -}
+        , fun 'countLeadingZeros $ VarE 'leadingZeroes
+        , inline 'countLeadingZeros
+        {- countTrailingZeros = trailingZeroes -}
+        , fun 'countTrailingZeros $ VarE 'trailingZeroes
+        , inline 'countTrailingZeros
+# endif
+        ]
+#endif
+    , inst ''BinaryWord [tp]
+        [ tySynInst ''UnsignedWord [tpT] $
+            ConT $ if signed then otp else tp
+        , tySynInst ''SignedWord [tpT] $
+            ConT $ if signed then tp else otp
+        {-
+          UNSIGNED:
+            unsignedWord = id
+          
+          SIGNED:
+            unsignedWord (W x) = U (unsignedWord x)
+        -}
+        , if signed
+          then funUn 'unsignedWord $ appC ocn [appVN 'unsignedWord [x]]
+          else fun 'unsignedWord $ VarE 'id
+        , inline 'unsignedWord
+        {-
+          UNSIGNED:
+            signedWord (W x) = S (signedWord hi)
+          
+          SIGNED:
+            signedWord = id
+        -}
+        , if signed
+          then fun 'signedWord $ VarE 'id
+          else funUn 'signedWord $ appC ocn [appVN 'signedWord [x]]
+        , inline 'signedWord
+        {-
+          unwrappedAdd (W x) (W y) = (W (shiftL t1 SHIFT),
+                                      U (unsignedWord t2))
+            where (t1, t2) = unwrappedAdd x y
+        -}
+        , funUn2' 'unwrappedAdd
+            (TupE [ appW (appV 'shiftL [VarE t1, shiftE])
+                  , appC (if signed then ocn else cn)
+                         [appVN 'unsignedWord [t2]]
+                  ])
+            [vals [t1, t2] $ appVN 'unwrappedAdd [x, y]]
+        , inline 'unwrappedAdd
+        {-
+          unwrappedMul (W x) (W y) = (W (shiftL t1 SHIFT),
+                                      U (unsignedWord t2))
+            where (t1, t2) = unwrappedMul (shiftR x SHIFT) y
+        -}
+        , funUn2' 'unwrappedMul
+            (TupE [ appW (appV 'shiftL [VarE t1, shiftE])
+                  , appC (if signed then ocn else cn)
+                         [appVN 'unsignedWord [t2]]
+                  ])
+            [vals [t1, t2] $
+               appV 'unwrappedMul [appV 'shiftR [VarE x, shiftE], VarE y]]
+        , inline 'unwrappedMul
+        {- leadingZeroes (W x) = leadingZeroes (x .|. complement MASK) -}
+        , funUn 'leadingZeroes $
+            appV 'leadingZeroes [appV '(.|.)
+                                      [VarE x, appV 'complement [maskE]]]
+        , inline 'leadingZeroes
+        {- trailingZeroes (W x) = trailingZeroes x - SHIFT -}
+        , funUn 'trailingZeroes $
+            appV '(-) [appVN 'trailingZeroes [x], shiftE]
+        , inline 'trailingZeroes
+        {- allZeroes = W allZeroes -}
+        , fun 'allZeroes $ appWN 'allZeroes
+        , inline 'allZeroes
+        {- allOnes = W (allOnes .&. MASK) -}
+        , fun 'allOnes $ appW $ appV '(.&.) [VarE 'allOnes, maskE]
+        , inline 'allOnes
+        {- msb = W msb -}
+        , fun 'msb $ appWN 'msb
+        , inline 'msb
+        {- lsb = W (shiftL lsb SHIFT) -}
+        , fun 'lsb $ appW $ appV 'shiftL [VarE 'lsb, shiftE]
+        , inline 'lsb
+        {- testMsb (W x) = testMsb x -}
+        , funUn 'testMsb $ appVN 'testMsb [x]
+        , inline 'testMsb
+        {- testLsb (W x) = testBit x SHIFT -}
+        , funUn 'testLsb $ appV 'testBit [VarE x, shiftE]
+        , inline 'testLsb
+        {- setMsb (W x) = W (setMsb x) -}
+        , funUn 'setMsb $ appW $ appVN 'setMsb [x]
+        , inline 'setMsb
+        {- setLsb (W x) = W (setBit x SHIFT) -}
+        , funUn 'setLsb $ appW $ appV 'setBit [VarE x, shiftE]
+        , inline 'setLsb
+        {- clearMsb (W x) = W (clearMsb x) -}
+        , funUn 'clearMsb $ appW $ appVN 'clearMsb [x]
+        , inline 'clearMsb
+        {- clearLsb (W x) = W (clearBit x SHIFT) -}
+        , funUn 'clearLsb $ appW $ appV 'clearBit [VarE x, shiftE]
+        , inline 'clearLsb
+        ]
+    , rule ("fromIntegral/" ++ show tp ++ "->" ++ show tp)
+           (VarE 'fromIntegral)
+           (SigE (VarE 'id) (AppT (AppT ArrowT tpT) tpT))
+    , rule ("fromIntegral/" ++ show tp ++ "->" ++ show otp)
+           (VarE 'fromIntegral)
+           (SigE (VarE $ if signed then 'unsignedWord else 'signedWord)
+                 (AppT (AppT ArrowT tpT) (ConT otp)))
+    , rule ("fromIntegral/" ++ show tp ++ "->a")
+           (VarE 'fromIntegral)
+           (LetE [funUn fn $ appV 'fromIntegral
+                                  [appV 'shiftR [VarE x, shiftE]]]
+                 (VarE fn))
+    , rule ("fromIntegral/a->" ++ show tp)
+           (VarE 'fromIntegral)
+           (appV '(.) [ appV '(.) [ ConE tp
+                                  , appV 'flip [VarE 'shiftL, shiftE] ]
+                      , VarE 'fromIntegral ])
+    ]
+  where
+    x    = mkName "x"
+    y    = mkName "y"
+    z    = mkName "z"
+    q    = mkName "q"
+    r    = mkName "r"
+    t1   = mkName "t1"
+    t2   = mkName "t2"
+    c    = mkName "c"
+    next = mkName "next_"
+    step = mkName "step_"
+    to   = mkName "to_"
+    down = mkName "down_"
+    up   = mkName "up_"
+    fn   = mkName "fn_"
+    uT   | signed    = AppT (ConT ''SignedWord) (ConT utp)
+         | otherwise = AppT (ConT ''UnsignedWord) (ConT utp)
+    tpT  = ConT tp
+    tySynInst n ps t =
+#if MIN_VERSION_template_haskell(2,9,0)
+      TySynInstD n (TySynEqn ps t)
+#else
+      TySynInstD n ps t
+#endif
+    inst cls params = InstanceD 
+#if MIN_VERSION_template_haskell(2,11,0)
+                                Nothing
+#endif
+                                [] (foldl AppT (ConT cls) (ConT <$> params))
+    fun n e        = FunD n [Clause [] (NormalB e) []]
+    fun_ n e       = FunD n [Clause [WildP] (NormalB e) []]
+    funUn' n e ds  =
+      FunD n [Clause [ConP cn [VarP x]] (NormalB e) ds]
+    funUn n e      = funUn' n e []
+    funUnAsX' n e ds = FunD n [Clause [AsP x (ConP cn [VarP y])]
+                                      (NormalB e) ds]
+    funUnAsX n e     = funUnAsX' n e []
+    funUn2' n e ds =
+      FunD n [Clause [ConP cn [VarP x], ConP cn [VarP y]] (NormalB e) ds]
+    funUn2 n e     = funUn2' n e []
+    funXUn' n e ds =
+      FunD n [Clause [VarP x, ConP cn [VarP y]] (NormalB e) ds]
+    funXUn n e     = funXUn' n e []
+    funUnY' n e ds =
+      FunD n [Clause [ConP cn [VarP x], VarP y] (NormalB e) ds]
+    funUnY n e     = funUnY' n e []
+    funX' n e ds   = FunD n [Clause [VarP x] (NormalB e) ds]
+    funX n e       = funX' n e []
+    funXY' n e ds  = FunD n [Clause [VarP x, VarP y] (NormalB e) ds]
+    funXY n e      = funXY' n e []
+    funTup n e     = FunD n [Clause [TupP [VarP x, VarP y]] (NormalB e) []]
+    funTupZ n e    =
+      FunD n [Clause [TupP [VarP x, VarP y], VarP z] (NormalB e) []]
+    funTupLZ n e   =
+      FunD n [Clause [TupP [VarP x, WildP], VarP z] (NormalB e) []]
+    inline n = PragmaD $ InlineP n Inline FunLike AllPhases
+    inlinable n = PragmaD $ InlineP n Inlinable FunLike AllPhases
+    rule n m e = PragmaD $ RuleP n [] m e AllPhases
+    val n e   = ValD (VarP n) (NormalB e) []
+    vals ns e = ValD (TupP (VarP <$> ns)) (NormalB e) []
+    app f   = foldl AppE f
+    appN f  = app f . fmap VarE
+    appV f  = app (VarE f)
+    appC f  = app (ConE f)
+    appW e  = appC cn [e]
+    appVN f = appN (VarE f)
+    appCN f = appN (ConE f)
+    appWN e = appCN cn [e]
+    litI = LitE . IntegerL
+    litS = LitE . StringL
+    sizeE = litI $ toInteger bl
+    shiftE = appV '(-)
+               [ appV
+#if MIN_VERSION_base(4,7,0)
+                      'finiteBitSize 
+#else
+                      'bitSize 
+#endif
+                      [SigE (VarE 'undefined) uT]
+               , sizeE ]
+    maskE = appV 'shiftL [VarE 'allOnes, shiftE]
diff --git a/tests/Tests.hs b/tests/Tests.hs
new file mode 100644
--- /dev/null
+++ b/tests/Tests.hs
@@ -0,0 +1,214 @@
+{-# LANGUAGE UnicodeSyntax #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
+
+import Test.Tasty (defaultMain, localOption, testGroup)
+import Test.Tasty.QuickCheck hiding ((.&.))
+
+import Data.Bits
+import Data.Word
+import Data.Int
+import Data.ShortWord (BinaryWord(..))
+import Types
+
+class Iso α τ | τ → α where
+  fromArbitrary ∷ α → τ 
+  toArbitrary ∷ τ → α
+  isValid ∷ τ → Bool
+
+instance Iso Word16 U16 where
+  fromArbitrary w = U16 $ fromIntegral w `shiftL` 48
+  toArbitrary (U16 w) = fromIntegral $ w `shiftR` 48
+  isValid (U16 w) = (w .&. 0xFFFFFFFFFF) == 0
+
+instance Iso Int16 I16 where
+  fromArbitrary w = I16 $ fromIntegral w `shiftL` 48
+  toArbitrary (I16 w) = fromIntegral $ w `shiftR` 48
+  isValid (I16 w) = (w .&. 0xFFFFFFFFFF) == 0
+
+main = defaultMain
+     $ localOption (QuickCheckTests 1000)
+     $ testGroup "Tests"
+         [ isoTestGroup "Word64/16" (0 ∷ U16)
+         , isoTestGroup "Int64/16" (0 ∷ I16) ]
+
+#if !MIN_VERSION_base(4,7,0)
+finiteBitSize = bitSize
+#endif
+
+isoTestGroup name t =
+  testGroup name
+    [ testProperty "Iso" $ prop_conv t
+    , testGroup "Eq" [ testProperty "(==)" $ prop_eq t ]
+    , testGroup "Ord" [ testProperty "compare" $ prop_compare t ]
+    , testGroup "Bounded"
+        [ testProperty "minBound" $ prop_minBound t
+        , testProperty "maxBound" $ prop_maxBound t ]
+    , testGroup "Enum"
+        [ testProperty "succ" $ prop_succ t
+        , testProperty "pred" $ prop_pred t ]
+    , testGroup "Num"
+        [ testProperty "negate" $ prop_negate t
+        , testProperty "abs" $ prop_abs t
+        , testProperty "signum" $ prop_signum t
+        , testProperty "(+)" $ prop_add t
+        , testProperty "(-)" $ prop_sub t
+        , testProperty "(*)" $ prop_mul t
+        , testProperty "fromInteger" $ prop_fromInteger t ]
+    , testGroup "Real"
+        [ testProperty "toRational" $ prop_toRational t ]
+    , testGroup "Integral"
+        [ testProperty "toInteger" $ prop_toInteger t
+        , testProperty "quotRem" $ prop_quotRem t
+        , testProperty "quot" $ prop_quot t
+        , testProperty "rem" $ prop_rem t
+        , testProperty "divMod" $ prop_divMod t
+        , testProperty "div" $ prop_div t
+        , testProperty "mod" $ prop_mod t ]
+    , testGroup "Bits"
+        [ testProperty "complement" $ prop_complement t
+        , testProperty "xor" $ prop_xor t
+        , testProperty "(.&.)" $ prop_and t
+        , testProperty "(.|.)" $ prop_or t
+        , testProperty "shiftL" $ prop_shiftL t
+        , testProperty "shiftR" $ prop_shiftR t
+        , testProperty "rotateL" $ prop_rotateL t
+        , testProperty "rotateR" $ prop_rotateR t
+        , testProperty "bit" $ prop_bit t
+        , testProperty "setBit" $ prop_setBit t
+        , testProperty "clearBit" $ prop_clearBit t
+        , testProperty "complementBit" $ prop_complementBit t
+        , testProperty "testBit" $ prop_testBit t
+        , testProperty "popCount" $ prop_popCount t
+        ]
+    , testGroup "BinaryWord"
+        [ testProperty "unwrappedAdd" $ prop_unwrappedAdd t
+        , testProperty "unwrappedMul" $ prop_unwrappedMul t
+        , testProperty "leadingZeroes" $ prop_leadingZeroes t
+        , testProperty "trailingZeroes" $ prop_trailingZeroes t
+        , testProperty "allZeroes" $ prop_allZeroes t
+        , testProperty "allOnes" $ prop_allOnes t
+        , testProperty "msb" $ prop_msb t
+        , testProperty "lsb" $ prop_lsb t
+        , testProperty "testMsb" $ prop_testMsb t
+        , testProperty "testLsb" $ prop_testLsb t
+        ]
+    ]
+
+toType ∷ Iso α τ ⇒ τ → α → τ 
+toType _ = fromArbitrary
+
+fromType ∷ Iso α τ ⇒ τ → τ → α 
+fromType _ = toArbitrary
+
+withUnary ∷ Iso α τ ⇒ τ → (τ → β) → α → β
+withUnary _ f = f . fromArbitrary
+
+withBinary ∷ Iso α τ ⇒ τ → (τ → τ → β) → α → α → β
+withBinary _ f x y = f (fromArbitrary x) (fromArbitrary y)
+
+propUnary f g t w = isValid r && toArbitrary r == f w
+  where r = withUnary t g w
+propUnary' f g t w = f w == withUnary t g w
+
+propBinary f g t w1 w2 = isValid r && f w1 w2 == toArbitrary r
+  where r = withBinary t g w1 w2
+propBinary' f g t w1 w2 = f w1 w2 == withBinary t g w1 w2
+
+prop_conv t w = toArbitrary (toType t w) == w
+
+prop_eq = propBinary' (==) (==)
+
+prop_compare = propBinary' compare compare
+
+prop_minBound t = minBound == fromType t minBound
+prop_maxBound t = maxBound == fromType t maxBound
+
+prop_succ t w = (w /= maxBound) ==> (isValid r && succ w == toArbitrary r)
+  where r = withUnary t succ w
+prop_pred t w = (w /= minBound) ==> (isValid r && pred w == toArbitrary r)
+  where r = withUnary t pred w
+
+prop_unwrappedAdd ∷ (Iso α τ, Iso (UnsignedWord α) (UnsignedWord τ),
+                     BinaryWord α, BinaryWord τ)
+                  ⇒ τ → α → α → Bool
+prop_unwrappedAdd t x y = h1 == toArbitrary h2 && l1 == toArbitrary l2
+  where (h1, l1) = unwrappedAdd x y
+        (h2, l2) = unwrappedAdd (toType t x) (toType t y)
+
+prop_unwrappedMul ∷ (Iso α τ, Iso (UnsignedWord α) (UnsignedWord τ),
+                     BinaryWord α, BinaryWord τ)
+                  ⇒ τ → α → α → Bool
+prop_unwrappedMul t x y = h1 == toArbitrary h2 && l1 == toArbitrary l2
+  where (h1, l1) = unwrappedMul x y
+        (h2, l2) = unwrappedMul (toType t x) (toType t y)
+
+prop_leadingZeroes = propUnary' leadingZeroes leadingZeroes
+prop_trailingZeroes = propUnary' trailingZeroes trailingZeroes
+prop_allZeroes t = allZeroes == fromType t allZeroes
+prop_allOnes t = allOnes == fromType t allOnes
+prop_msb t = msb == fromType t msb
+prop_lsb t = lsb == fromType t lsb
+prop_testMsb = propUnary' testMsb testMsb
+prop_testLsb = propUnary' testLsb testLsb
+
+prop_negate = propUnary negate negate
+prop_abs = propUnary abs abs
+prop_signum = propUnary signum signum
+prop_add = propBinary (+) (+)
+prop_sub = propBinary (-) (-)
+prop_mul = propBinary (*) (*)
+prop_fromInteger t i = fromInteger i == fromType t (fromInteger i) 
+
+prop_toRational = propUnary' toRational toRational
+
+prop_toInteger = propUnary' toInteger toInteger
+prop_quotRem t n d = (d /= 0) ==> (qr == (fromType t q1, fromType t r1))
+  where qr = quotRem n d
+        (q1, r1) = quotRem (fromArbitrary n) (fromArbitrary d)
+prop_quot t n d = (d /= 0) ==> (q == fromType t q1)
+  where q = quot n d
+        q1 = quot (fromArbitrary n) (fromArbitrary d)
+prop_rem t n d = (d /= 0) ==> (r == fromType t r1)
+  where r = rem n d
+        r1 = rem (fromArbitrary n) (fromArbitrary d)
+prop_divMod t n d = (d /= 0) ==> (qr == (fromType t q1, fromType t r1))
+  where qr = divMod n d
+        (q1, r1) = divMod (fromArbitrary n) (fromArbitrary d)
+prop_div t n d = (d /= 0) ==> (q == fromType t q1)
+  where q = div n d
+        q1 = div (fromArbitrary n) (fromArbitrary d)
+prop_mod t n d = (d /= 0) ==> (r == fromType t r1)
+  where r = mod n d
+        r1 = mod (fromArbitrary n) (fromArbitrary d)
+
+prop_complement = propUnary complement complement
+prop_xor = propBinary xor xor
+prop_and = propBinary (.&.) (.&.)
+prop_or = propBinary (.|.) (.|.)
+propOffsets f g t w =
+  all (\b → let r = withUnary t (`g` b) w in
+              isValid r && toArbitrary r == f w b)
+      [0 .. finiteBitSize t]
+prop_shiftL = propOffsets shiftL shiftL
+prop_shiftR = propOffsets shiftR shiftR
+prop_rotateL = propOffsets rotateL rotateL
+prop_rotateR = propOffsets rotateR rotateR
+prop_bit t = all (\b → bit b == fromType t (bit b))
+                 [0 .. finiteBitSize t - 1]
+propBits f g t w =
+  all (\b → let r = withUnary t (`g` b) w in
+              isValid r && toArbitrary r == f w b)
+      [0 .. finiteBitSize t - 1]
+prop_setBit = propBits setBit setBit
+prop_clearBit = propBits clearBit clearBit
+prop_complementBit = propBits complementBit complementBit
+prop_testBit t w =
+  all (\b → testBit w b == withUnary t (`testBit` b) w)
+      [0 .. finiteBitSize t - 1]
+prop_popCount = propUnary' popCount popCount
diff --git a/tests/Types.hs b/tests/Types.hs
new file mode 100644
--- /dev/null
+++ b/tests/Types.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Types where
+
+import Data.Word
+import Data.ShortWord.TH
+
+mkShortWord "U16" "U16" "I16" "I16" ''Word64 16 []