diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown
--- a/CHANGELOG.markdown
+++ b/CHANGELOG.markdown
@@ -1,3 +1,13 @@
+## 0.1
+* Add compare-and-swap support for struct slots
+* Add `Data.Struct.TH`, which provides Template Haskell support for
+  generating structs
+* Remove unneeded proxy argument to `struct`
+* Add a type parameter to `Order`
+* Revamp `Setup.hs` to use `cabal-doctest`. This makes it build
+  with `Cabal-2.0`, and makes the `doctest`s work with `cabal new-build` and
+  sandboxes.
+
 ## 0
 * Repository initialized
 * Added structures for list labeling, order-maintenance, and link-cut trees.
diff --git a/HLint.hs b/HLint.hs
new file mode 100644
--- /dev/null
+++ b/HLint.hs
@@ -0,0 +1,8 @@
+import "hint" HLint.HLint
+
+ignore "Reduce duplication"
+ignore "Redundant lambda"
+ignore "Use >=>"
+ignore "Use const"
+ignore "Use module export list"
+ignore "Use newtype instead of data"
diff --git a/README.markdown b/README.markdown
--- a/README.markdown
+++ b/README.markdown
@@ -1,9 +1,9 @@
 structs
 ==========
 
-[![Build Status](https://secure.travis-ci.org/ekmett/structs.png?branch=master)](http://travis-ci.org/ekmett/structs)
+[![Hackage](https://img.shields.io/hackage/v/structs.svg)](https://hackage.haskell.org/package/structs) [![Build Status](https://secure.travis-ci.org/ekmett/structs.png?branch=master)](http://travis-ci.org/ekmett/structs)
 
-This package explores strict mutable data structures in Haskell. 
+This package explores strict mutable data structures in Haskell.
 
 In particular, pointer-based data structures are effectively 'half price' due to the encoding used.
 
diff --git a/Setup.lhs b/Setup.lhs
--- a/Setup.lhs
+++ b/Setup.lhs
@@ -1,46 +1,34 @@
-#!/usr/bin/runhaskell
 \begin{code}
+{-# LANGUAGE CPP #-}
 {-# OPTIONS_GHC -Wall #-}
 module Main (main) where
 
-import Data.List ( nub )
-import Data.Version ( showVersion )
-import Distribution.Package ( PackageName(PackageName), PackageId, InstalledPackageId, packageVersion, packageName )
-import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) )
-import Distribution.Simple ( defaultMainWithHooks, UserHooks(..), simpleUserHooks )
-import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose )
-import Distribution.Simple.BuildPaths ( autogenModulesDir )
-import Distribution.Simple.Setup ( BuildFlags(buildVerbosity), fromFlag)
-import Distribution.Simple.LocalBuildInfo ( withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps) )
-import Distribution.Verbosity ( Verbosity )
-import System.FilePath ( (</>) )
+#ifndef MIN_VERSION_cabal_doctest
+#define MIN_VERSION_cabal_doctest(x,y,z) 0
+#endif
 
+#if MIN_VERSION_cabal_doctest(1,0,0)
+
+import Distribution.Extra.Doctest ( defaultMainWithDoctests )
 main :: IO ()
-main = defaultMainWithHooks simpleUserHooks
-  { buildHook = \pkg lbi hooks flags -> do
-     generateBuildModule (fromFlag (buildVerbosity flags)) pkg lbi
-     buildHook simpleUserHooks pkg lbi hooks flags
-  , postHaddock = \args flags pkg lbi ->
-     postHaddock simpleUserHooks args flags pkg lbi
-  }
+main = defaultMainWithDoctests "doctests"
 
-generateBuildModule :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO ()
-generateBuildModule verbosity pkg lbi = do
-  let dir = autogenModulesDir lbi
-  createDirectoryIfMissingVerbose verbosity True dir
-  withLibLBI pkg lbi $ \_ libcfg -> do
-    withTestLBI pkg lbi $ \suite suitecfg -> do
-      rewriteFile (dir </> "Build_" ++ testName suite ++ ".hs") $ unlines
-        [ "module Build_" ++ testName suite ++ " where"
-        , "deps :: [String]"
-        , "deps = " ++ (show $ formatdeps (testDeps libcfg suitecfg))
-        ]
-  where
-    formatdeps = map (formatone . snd)
-    formatone p = case packageName p of
-      PackageName n -> n ++ "-" ++ showVersion (packageVersion p)
+#else
 
-testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)]
-testDeps xs ys = nub $ componentPackageDeps xs ++ componentPackageDeps ys
+#ifdef MIN_VERSION_Cabal
+-- If the macro is defined, we have new cabal-install,
+-- but for some reason we don't have cabal-doctest in package-db
+--
+-- Probably we are running cabal sdist, when otherwise using new-build
+-- workflow
+import Warning ()
+#endif
+
+import Distribution.Simple
+
+main :: IO ()
+main = defaultMain
+
+#endif
 
 \end{code}
diff --git a/Warning.hs b/Warning.hs
new file mode 100644
--- /dev/null
+++ b/Warning.hs
@@ -0,0 +1,5 @@
+module Warning
+  {-# WARNING ["You are configuring this package without cabal-doctest installed.",
+               "The doctests test-suite will not work as a result.",
+               "To fix this, install cabal-doctest before configuring."] #-}
+  () where
diff --git a/src/Data/Struct.hs b/src/Data/Struct.hs
--- a/src/Data/Struct.hs
+++ b/src/Data/Struct.hs
@@ -28,7 +28,7 @@
   , get, set
   , Field, field
   , unboxedField
-  , getField, setField
+  , getField, setField, modifyField, modifyField'
   , Precomposable(..)
   ) where
 
diff --git a/src/Data/Struct/Internal.hs b/src/Data/Struct/Internal.hs
--- a/src/Data/Struct/Internal.hs
+++ b/src/Data/Struct/Internal.hs
@@ -4,19 +4,17 @@
 {-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE MagicHash #-}
 {-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE MultiWayIf #-}
-{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE UnboxedTuples #-}
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE DefaultSignatures #-}
 {-# OPTIONS_HADDOCK not-home #-}
 -----------------------------------------------------------------------------
 -- |
--- Copyright   :  (C) 2015 Edward Kmett
+-- Copyright   :  (C) 2015-2017 Edward Kmett
 -- License     :  BSD-style (see the file LICENSE)
 -- Maintainer  :  Edward Kmett <ekmett@gmail.com>
 -- Stability   :  experimental
@@ -32,11 +30,15 @@
 import Data.Primitive
 import Data.Coerce
 import GHC.Exts
-import GHC.ST
 
+-- $setup
+-- >>> import Control.Monad.Primitive
+
 #ifdef HLINT
 {-# ANN module "HLint: ignore Eta reduce" #-}
 {-# ANN module "HLint: ignore Unused LANGUAGE pragma" #-}
+{-# ANN module "HLint: ignore Avoid lambda" #-}
+{-# ANN module "HLint: ignore Redundant lambda" #-}
 #endif
 
 data NullPointerException = NullPointerException deriving (Show, Exception)
@@ -47,48 +49,51 @@
 
 -- | Run an ST calculation inside of a PrimMonad. This lets us avoid dispatching everything through the 'PrimMonad' dictionary.
 st :: PrimMonad m => ST (PrimState m) a -> m a
-st (ST f) = primitive f
+st = primToPrim
 {-# INLINE[0] st #-}
 
-{-# RULES "st/id" st = id #-}
-
 -- | An instance for 'Struct' @t@ is a witness to the machine-level
---   equivalence of @t@ and @Object@.  The argument to 'struct' is
---   ignored and is only present to help type inference.
+--   equivalence of @t@ and @Object@.
 class Struct t where
-  struct :: proxy t -> Dict (Coercible (t s) (Object s))
+  struct :: Dict (Coercible (t s) (Object s))
+#ifndef HLINT
+  default struct :: Coercible (t s) (Object s) => Dict (Coercible (t s) (Object s))
+#endif
+  struct = Dict
+  {-# MINIMAL #-}
 
 data Object s = Object { runObject :: SmallMutableArray# s Any }
 
-instance Struct Object where
-  struct _ = Dict
+instance Struct Object
 
--- TODO: get these to dispatch fast through 'coerce' using struct as a witness
+coerceF :: Dict (Coercible a b) -> a -> b
+coerceF Dict = coerce
+{-# INLINE coerceF #-}
 
+coerceB :: Dict (Coercible a b) -> b -> a
+coerceB Dict = coerce
+{-# INLINE coerceB #-}
+
 destruct :: Struct t => t s -> SmallMutableArray# s Any
-destruct = unsafeCoerce# runObject
+destruct = \x -> runObject (coerceF struct x)
 {-# INLINE destruct #-}
 
 construct :: Struct t => SmallMutableArray# s Any -> t s
-construct = unsafeCoerce# Object
+construct = \x -> coerceB struct (Object x)
 {-# INLINE construct #-}
 
 unsafeCoerceStruct :: (Struct x, Struct y) => x s -> y s
-unsafeCoerceStruct x = unsafeCoerce# x
+unsafeCoerceStruct x = construct (destruct x)
 
 eqStruct :: Struct t => t s -> t s -> Bool
-eqStruct x y = isTrue# (destruct x `sameSmallMutableArray#` destruct y)
+eqStruct = \x y -> isTrue# (destruct x `sameSmallMutableArray#` destruct y)
 {-# INLINE eqStruct #-}
 
 instance Eq (Object s) where
   (==) = eqStruct
 
--- instance Struct Object s where
---  construct = Object
---  destruct = runObject
-
 #ifndef HLINT
-pattern Struct :: () => Struct t => SmallMutableArray# s Any -> t s
+pattern Struct :: Struct t => () => SmallMutableArray# s Any -> t s
 pattern Struct x <- (destruct -> x) where
   Struct x = construct x
 #endif
@@ -101,16 +106,27 @@
 -- * Tony Hoare's billion dollar mistake
 --------------------------------------------------------------------------------
 
-data Box = Box !Null
+-- | Box is designed to mirror object's single field but using the 'Null' type
+-- instead of a mutable array. This hack relies on GHC reusing the same 'Null'
+-- data constructor for all occurrences. Box's field must not be strict to
+-- prevent the compiler from making assumptions about its contents.
+data Box = Box Null
 data Null = Null
 
+-- | Predicate to check if a struct is 'Nil'.
+--
+-- >>> isNil (Nil :: Object (PrimState IO))
+-- True
+-- >>> o <- alloc 1 :: IO (Object (PrimState IO))
+-- >>> isNil o
+-- False
 isNil :: Struct t => t s -> Bool
 isNil t = isTrue# (unsafeCoerce# reallyUnsafePtrEquality# (destruct t) Null)
 {-# INLINE isNil #-}
 
 #ifndef HLINT
 -- | Truly imperative.
-pattern Nil :: forall t s. () => Struct t => t s
+pattern Nil :: Struct t => () => t s
 pattern Nil <- (isNil -> True) where
   Nil = unsafeCoerce# Box Null
 #endif
@@ -135,6 +151,10 @@
 readMutableByteArraySmallArray# m i s = unsafeCoerce# readSmallArray# m i s
 {-# INLINE readMutableByteArraySmallArray# #-}
 
+casSmallMutableArraySmallArray# :: SmallMutableArray# s Any -> Int# -> SmallMutableArray# s Any -> SmallMutableArray# s Any -> State# s -> (# State# s, Int#, SmallMutableArray# s Any #)
+casSmallMutableArraySmallArray# m i o n s = unsafeCoerce# casSmallArray# m i o n s
+{-# INLINE casSmallMutableArraySmallArray# #-}
+
 --------------------------------------------------------------------------------
 -- * Field Accessors
 --------------------------------------------------------------------------------
@@ -143,52 +163,60 @@
 data Slot x y = Slot
   (forall s. SmallMutableArray# s Any -> State# s -> (# State# s, SmallMutableArray# s Any #))
   (forall s. SmallMutableArray# s Any -> SmallMutableArray# s Any -> State# s -> State# s)
+  (forall s. SmallMutableArray# s Any -> SmallMutableArray# s Any -> SmallMutableArray# s Any -> State# s -> (# State# s, Int#, SmallMutableArray# s Any #))
 
 -- | We can compose slots to get a nested slot or field accessor
 class Precomposable t where
   ( # ) :: Slot x y -> t y z -> t x z
 
 instance Precomposable Slot where
-  Slot gxy _ # Slot gyz syz = Slot
+  Slot gxy _ _ # Slot gyz syz cyz = Slot
     (\x s -> case gxy x s of (# s', y #) -> gyz y s')
     (\x z s -> case gxy x s of (# s', y #) -> syz y z s')
+    (\x o n s -> case gxy x s of (# s', y #) -> cyz y o n s')
 
 -- | The 'Slot' at the given position in a 'Struct'
-slot :: Int -> Slot s t
+slot :: Int {- ^ slot -} -> Slot s t
 slot (I# i) = Slot
   (\m s -> readSmallMutableArraySmallArray# m i s)
   (\m a s -> writeSmallMutableArraySmallArray# m i a s)
+  (\m o n s -> casSmallMutableArraySmallArray# m i o n s)
 
 -- | Get the value from a 'Slot'
 get :: (PrimMonad m, Struct x, Struct y) => Slot x y -> x (PrimState m) -> m (y (PrimState m))
-get (Slot go _) x = primitive $ \s -> case go (destruct x) s of
-   (# s', y #) -> (# s', construct y #)
+get (Slot go _ _) = \x -> primitive $ \s -> case go (destruct x) s of
+                                            (# s', y #) -> (# s', construct y #)
 {-# INLINE get #-}
 
 -- | Set the value of a 'Slot'
 set :: (PrimMonad m, Struct x, Struct y) => Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
-set (Slot _ go) x y = primitive_ (go (destruct x) (destruct y))
+set (Slot _ go _) = \x y -> primitive_ (go (destruct x) (destruct y))
 {-# INLINE set #-}
 
+-- | Compare-and-swap the value of the slot. Takes the expected old value, the new value and returns if it succeeded and the value found.
+cas :: (PrimMonad m, Struct x, Struct y) => Slot x y -> x (PrimState m) -> y (PrimState m) -> y (PrimState m) -> m (Bool, y (PrimState m))
+cas (Slot _ _ go) = \m o n -> primitive $ \s -> case go (destruct m) (destruct o) (destruct n) s of
+  (# s', i, r #) -> (# s', (tagToEnum# i :: Bool, construct r) #)
+
 -- | A 'Field' is a reference from a struct to a normal Haskell data type.
 data Field x a = Field
-  (forall s. SmallMutableArray# s Any -> State# s -> (# State# s, a #))
-  (forall s. SmallMutableArray# s Any -> a -> State# s -> State# s)
+  (forall s. SmallMutableArray# s Any -> State# s -> (# State# s, a #)) -- get
+  (forall s. SmallMutableArray# s Any -> a -> State# s -> State# s) -- set
 
 instance Precomposable Field where
-  Slot gxy _ # Field gyz syz = Field
+  Slot gxy _ _ # Field gyz syz = Field
     (\x s -> case gxy x s of (# s', y #) -> gyz y s')
     (\x z s -> case gxy x s of (# s', y #) -> syz y z s')
 
 -- | Store the reference to the Haskell data type in a normal field
-field :: Int -> Field s a
+field :: Int {- ^ slot -} -> Field s a
 field (I# i) = Field
   (\m s -> unsafeCoerce# readSmallArray# m i s)
   (\m a s -> unsafeCoerce# writeSmallArray# m i a s)
 {-# INLINE field #-}
 
--- | Store the reference in the nth slot of the nth argument, treated as a MutableByteArray
-unboxedField :: Prim a => Int -> Int -> Field s a
+-- | Store the reference in the nth slot in the nth argument, treated as a MutableByteArray
+unboxedField :: Prim a => Int {- ^ slot -} -> Int {- ^ argument -} -> Field s a
 unboxedField (I# i) (I# j) = Field
   (\m s -> case readMutableByteArraySmallArray# m i s of
      (# s', mba #) -> readByteArray# mba j s')
@@ -196,12 +224,41 @@
      (# s', mba #) -> writeByteArray# mba j a s')
 {-# INLINE unboxedField #-}
 
+-- | Initialized the mutable array used by 'unboxedField'. Returns the array
+-- after storing it in the struct to help with initialization.
+initializeUnboxedField ::
+  (PrimMonad m, Struct x) =>
+  Int             {- ^ slot     -} ->
+  Int             {- ^ elements -} ->
+  Int             {- ^ element size -} ->
+  x (PrimState m) {- ^ struct   -} ->
+  m (MutableByteArray (PrimState m))
+initializeUnboxedField (I# i) (I# n) (I# z) m =
+  primitive $ \s ->
+    case newByteArray# (n *# z) s of
+      (# s1, mba #) ->
+        (# writeMutableByteArraySmallArray# (destruct m) i mba s1, MutableByteArray mba #)
+{-# INLINE initializeUnboxedField #-}
+
 -- | Get the value of a field in a struct
 getField :: (PrimMonad m, Struct x) => Field x a -> x (PrimState m) -> m a
-getField (Field go _) x = primitive (go (destruct x))
+getField (Field go _) = \x -> primitive (go (destruct x))
 {-# INLINE getField #-}
 
 -- | Set the value of a field in a struct
 setField :: (PrimMonad m, Struct x) => Field x a -> x (PrimState m) -> a -> m ()
-setField (Field _ go) x y = primitive_ (go (destruct x) y)
+setField (Field _ go) = \x y -> primitive_ (go (destruct x) y)
 {-# INLINE setField #-}
+
+
+--------------------------------------------------------------------------------
+-- * Modifiers
+--------------------------------------------------------------------------------
+
+modifyField :: (Struct x, PrimMonad m) => Field x a -> x (PrimState m) -> (a -> a) -> m ()
+modifyField s = \o f -> st (setField s o . f =<< getField s o)
+{-# INLINE modifyField #-}
+
+modifyField' :: (Struct x, PrimMonad m) => Field x a -> x (PrimState m) -> (a -> a) -> m ()
+modifyField' s = \o f -> st (setField s o =<< (\x -> return $! f x) =<< getField s o)
+{-# INLINE modifyField' #-}
diff --git a/src/Data/Struct/Internal/Label.hs b/src/Data/Struct/Internal/Label.hs
--- a/src/Data/Struct/Internal/Label.hs
+++ b/src/Data/Struct/Internal/Label.hs
@@ -21,6 +21,9 @@
 import Data.Struct.Internal
 import Data.Word
 
+-- $setup
+-- >>> import Data.Struct.Internal.Label
+
 #ifdef HLINT
 {-# ANN module "HLint: ignore Eta reduce" #-}
 #endif
@@ -54,8 +57,7 @@
 
 instance Eq (Label s) where (==) = eqStruct
 
-instance Struct Label where
-  struct _ = Dict
+instance Struct Label
 
 -- | Construct an explicit list labeling structure.
 --
diff --git a/src/Data/Struct/Internal/LinkCut.hs b/src/Data/Struct/Internal/LinkCut.hs
--- a/src/Data/Struct/Internal/LinkCut.hs
+++ b/src/Data/Struct/Internal/LinkCut.hs
@@ -1,8 +1,11 @@
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE RoleAnnotations #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# OPTIONS_HADDOCK not-home #-}
+{-# OPTIONS_GHC -fno-warn-monomorphism-restriction #-}
 -----------------------------------------------------------------------------
 -- |
--- Copyright   :  (C) 2015 Edward Kmett
+-- Copyright   :  (C) 2015-2017 Edward Kmett
 -- License     :  BSD-style (see the file LICENSE)
 -- Maintainer  :  Edward Kmett <ekmett@gmail.com>
 -- Stability   :  experimental
@@ -17,7 +20,11 @@
 import Control.Monad.Primitive
 import Control.Monad.ST
 import Data.Struct.Internal
+import Data.Struct.TH
 
+-- $setup
+-- >>> import Data.Struct.Internal.LinkCut
+
 #ifdef HLINT
 {-# ANN module "HLint: ignore Reduce duplication" #-}
 {-# ANN module "HLint: ignore Redundant do" #-}
@@ -73,35 +80,16 @@
 -- "zwu"
 -- >>> (z ==) <$> root v
 -- True
-newtype LinkCut a s = LinkCut (Object s)
-
-instance Struct (LinkCut a) where
-  struct _ = Dict
-
-instance Eq (LinkCut a s) where
-  (==) = eqStruct
-
-path, parent, left, right :: Slot (LinkCut a) (LinkCut a)
-path        = slot 0
-parent      = slot 1
-left        = slot 2
-right       = slot 3
-
-value, summary :: Field (LinkCut a) a
-value       = field 4
-summary     = field 5
+makeStruct [d|
+  data LinkCut a s = LinkCut
+    { path, parent, left, right :: !(LinkCut a s)
+    , value, summary :: a
+    }
+   |]
 
 -- | O(1). Allocate a new link-cut tree with a given monoidal summary.
-new :: (PrimMonad m, Monoid a) => a -> m (LinkCut a (PrimState m))
-new a = st $ do
-  this <- alloc 6
-  set path this Nil
-  set parent this Nil
-  set left this Nil
-  set right this Nil
-  setField value this a
-  setField summary this a
-  return this
+new :: PrimMonad m => a -> m (LinkCut a (PrimState m))
+new a = st (newLinkCut Nil Nil Nil Nil a a)
 {-# INLINE new #-}
 
 -- | O(log n). @'cut' v@ removes the linkage between @v@ upwards to whatever tree it was in, making @v@ a root node.
diff --git a/src/Data/Struct/Internal/Order.hs b/src/Data/Struct/Internal/Order.hs
--- a/src/Data/Struct/Internal/Order.hs
+++ b/src/Data/Struct/Internal/Order.hs
@@ -38,41 +38,45 @@
 --
 -- This means that inserts are O(1) amortized, while comparisons remain O(1) worst-case.
 
-newtype Order s = Order { runOrder :: Object s }
+newtype Order a s = Order { runOrder :: Object s }
 
-instance Eq (Order s) where (==) = eqStruct
+instance Eq (Order a s) where (==) = eqStruct
 
-instance Struct Order where
-  struct _ = Dict
+instance Struct (Order a)
 
-key :: Field Order Key
+key :: Field (Order a) Key
 key = field 0
 {-# INLINE key #-}
 
-next :: Slot Order Order
-next = slot 1
+value :: Field (Order a) a
+value = field 1
+{-# INLINE value #-}
+
+next :: Slot (Order a) (Order a)
+next = slot 2
 {-# INLINE next #-}
 
-prev :: Slot Order Order
-prev = slot 2
+prev :: Slot (Order a) (Order a)
+prev = slot 3
 {-# INLINE prev #-}
 
-parent :: Slot Order Label
-parent = slot 3
+parent :: Slot (Order a) Label 
+parent = slot 4
 {-# INLINE parent #-}
 
-makeOrder :: PrimMonad m => Label (PrimState m) -> Key -> Order (PrimState m) -> Order (PrimState m) -> m (Order (PrimState m))
-makeOrder mom a p n = st $ do
-  this <- alloc 4
+makeOrder :: PrimMonad m => Label (PrimState m) -> Key -> a -> Order a (PrimState m) -> Order a (PrimState m) -> m (Order a (PrimState m))
+makeOrder mom a v p n = st $ do
+  this <- alloc 5
   set parent this mom
   setField key this a
+  setField value this v
   set prev this p
   set next this n
   return this
 {-# INLINE makeOrder #-}
 
 -- | O(1) compareM, O(1) amortized insert
-compareM :: PrimMonad m => Order (PrimState m) -> Order (PrimState m) -> m Ordering
+compareM :: PrimMonad m => Order a (PrimState m) -> Order a (PrimState m) -> m Ordering
 compareM i j
   | isNil i || isNil j = throw NullPointerException
   | otherwise = st $ do
@@ -84,22 +88,22 @@
     x -> return x
 {-# INLINE compareM #-}
 
-insertAfter :: PrimMonad m => Order (PrimState m) -> m (Order (PrimState m))
-insertAfter n0 = st $ do
+insertAfter :: PrimMonad m => Order a (PrimState m) -> a -> m (Order a (PrimState m))
+insertAfter n0 a1 = st $ do
   when (isNil n0) $ throw NullPointerException
   mom <- get parent n0
   k0 <- getField key n0
   n2 <- get next n0
   k2 <- if isNil n2 then return maxBound else getField key n2
   let !k1 = k0 + unsafeShiftR (k2 - k0) 1
-  n1 <- makeOrder mom k1 n0 n2
+  n1 <- makeOrder mom k1 a1 n0 n2
   unless (isNil n2) $ set prev n2 n1
   set next n0 n1
   when (k0 + 1 == k2) $ rewind mom n0 -- we have a collision, rebalance
   return n1
  where
   -- find the smallest sibling
-  rewind :: Label s -> Order s -> ST s ()
+  rewind :: Label s -> Order a s -> ST s ()
   rewind mom this = do
     p <- get prev this
     if isNil p then rebalance mom mom this 0 64
@@ -109,7 +113,7 @@
       else rebalance mom mom p 0 64
 
   -- break up the family
-  rebalance :: Label s -> Label s -> Order s -> Word64 -> Int -> ST s ()
+  rebalance :: Label s -> Label s -> Order a s -> Word64 -> Int -> ST s ()
   rebalance mom dad this k j = unless (isNil this) $ do
     guardian <- get parent this
     when (mom == guardian) $ do
@@ -121,7 +125,7 @@
         stepdad <- Label.insertAfter dad
         rebalance mom stepdad n deltaU logU
 
-delete :: PrimMonad m => Order (PrimState m) -> m ()
+delete :: PrimMonad m => Order a (PrimState m) -> m ()
 delete this = st $ do
   when (isNil this) $ throw NullPointerException
   mom <- get parent this
@@ -156,25 +160,14 @@
 deltaU :: Key
 deltaU = unsafeShiftR maxBound loglogU -- U / log U
 
-new :: PrimMonad m => m (Order (PrimState m))
-new = st $ do
+new :: PrimMonad m => a -> m (Order a (PrimState m))
+new a = st $ do
   l <- Label.new
-  makeOrder l (unsafeShiftR maxBound 1) Nil Nil
+  makeOrder l (unsafeShiftR maxBound 1) a Nil Nil
 {-# INLINE new #-}
 
-value :: PrimMonad m => Order (PrimState m) -> m (Key, Key)
-value this = st $ do
+keys :: PrimMonad m => Order a (PrimState m) -> m (Key, Key)
+keys this = st $ do
   mom <- get parent this
   (,) <$> getField Label.key mom <*> getField key this
-{-# INLINE value #-}
-
--- O(n) sweep to the right from the current node, showing all values for debugging
-values :: PrimMonad m => Order (PrimState m) -> m [(Key, Key)]
-values xs0 = st (go xs0) where
-  go :: Order s -> ST s [(Key, Key)]
-  go this
-    | isNil this = return []
-    | otherwise  = do
-        n <- get next this
-        (:) <$> value this <*> go n
-{-# INLINE values #-}
+{-# INLINE keys #-}
diff --git a/src/Data/Struct/Order.hs b/src/Data/Struct/Order.hs
--- a/src/Data/Struct/Order.hs
+++ b/src/Data/Struct/Order.hs
@@ -11,6 +11,7 @@
 module Data.Struct.Order
   ( Order
   , new
+  , value
   , insertAfter
   , delete
   ) where
diff --git a/src/Data/Struct/TH.hs b/src/Data/Struct/TH.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Struct/TH.hs
@@ -0,0 +1,370 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Data.Struct.TH (makeStruct) where
+
+import           Control.Monad (when, zipWithM)
+import           Control.Monad.Primitive (PrimMonad, PrimState)
+import           Data.Either (partitionEithers)
+import           Data.Primitive
+import           Data.Struct
+import           Data.Struct.Internal (Dict(Dict), initializeUnboxedField, st)
+import           Data.List (groupBy, nub)
+import           Language.Haskell.TH
+import           Language.Haskell.TH.Syntax (VarStrictType)
+
+#ifdef HLINT
+{-# ANN module "HLint: ignore Use ." #-}
+#endif
+
+data StructRep = StructRep
+  { srState       :: Name
+  , srName        :: Name
+  , srTyVars      :: [TyVarBndr]
+#if MIN_VERSION_template_haskell(2,12,0)
+  , srDerived     :: [DerivClause]
+#else
+  , srDerived     :: Cxt
+#endif
+  , srCxt         :: Cxt
+  , srConstructor :: Name
+  , srMembers     :: [Member]
+  } deriving Show
+
+data Member = Member
+  { _memberRep :: Representation
+  , memberName :: Name
+  , _memberType :: Type
+  }
+  deriving Show
+
+data Representation = BoxedField | UnboxedField | Slot
+  deriving Show
+
+-- | Generate allocators, slots, fields, unboxed fields, Eq instances,
+-- and Struct instances for the given "data types".
+--
+-- Inputs are expected to be "data types" parameterized by a state
+-- type. Strict fields are considered to be slots, Non-strict fields
+-- are considered to be boxed types, Unpacked fields are considered
+-- to be unboxed primitives.
+--
+-- The data type should use record syntax and have a single constructor.
+-- The field names will be used to generate slot, field, and unboxedField
+-- values of the same name.
+--
+-- An allocator for the struct is generated by prefixing "alloc" to the
+-- data type name.
+makeStruct :: DecsQ -> DecsQ
+makeStruct dsq =
+  do ds   <- dsq
+     (passthrough, reps) <- partitionEithers <$> traverse computeRep ds
+     ds's <- traverse (generateCode passthrough) reps
+     return (passthrough ++ concat ds's)
+
+mkAllocName :: StructRep -> Name
+mkAllocName rep = mkName ("alloc" ++ nameBase (srName rep))
+
+mkInitName :: StructRep -> Name
+mkInitName rep = mkName ("new" ++ nameBase (srName rep))
+
+------------------------------------------------------------------------
+-- Input validation
+------------------------------------------------------------------------
+
+computeRep :: Dec -> Q (Either Dec StructRep)
+computeRep (DataD c n vs _ cs ds) =
+  do state <- validateStateType vs
+     (conname, confields) <- validateContructor cs
+     members <- traverse (validateMember state) confields
+
+     return $ Right StructRep
+       { srState = state
+       , srName  = n
+       , srTyVars = vs
+       , srConstructor = conname
+       , srMembers = members
+       , srDerived = ds
+       , srCxt = c
+       }
+computeRep d = return (Left d)
+
+-- | Check that only a single data constructor was provided and
+-- that it was a record constructor.
+validateContructor :: [Con] -> Q (Name,[VarStrictType])
+validateContructor [RecC name fields] = return (name,fields)
+validateContructor [_] = fail "Expected a record constructor"
+validateContructor xs = fail ("Expected 1 constructor, got " ++ show (length xs))
+
+-- A struct type's final type variable should be suitable for
+-- use as the ('PrimState' m) argument.
+validateStateType :: [TyVarBndr] -> Q Name
+validateStateType xs =
+  do when (null xs) (fail "state type expected but no type variables found")
+     case last xs of
+       PlainTV n -> return n
+       KindedTV n k
+         | k == starK -> return n
+         | otherwise  -> fail "state type should have kind *"
+
+
+-- | Figure out which record fields are Slots and which are
+-- Fields. Slots will have types ending in the state type
+validateMember :: Name -> VarStrictType -> Q Member
+validateMember s (fieldname,Bang NoSourceUnpackedness NoSourceStrictness,fieldtype) =
+  do when (occurs s fieldtype)
+       (fail ("state type may not occur in field `" ++ nameBase fieldname ++ "`"))
+     return (Member BoxedField fieldname fieldtype)
+validateMember s (fieldname,Bang NoSourceUnpackedness SourceStrict,fieldtype) =
+  do f <- unapplyType fieldtype s
+     when (occurs s f)
+       (fail ("state type may only occur in final position in slot `" ++ nameBase fieldname ++ "`"))
+     return (Member Slot fieldname f)
+validateMember s (fieldname,Bang SourceUnpack SourceStrict,fieldtype) =
+  do when (occurs s fieldtype)
+       (fail ("state type may not occur in unpacked field `" ++ nameBase fieldname ++ "`"))
+     return (Member UnboxedField fieldname fieldtype)
+validateMember _ _ = fail "validateMember: can't unpack nonstrict fields"
+
+unapplyType :: Type -> Name -> Q Type
+unapplyType (AppT f (VarT x)) y | x == y = return f
+unapplyType _ _ = fail "Unable to match state type of slot"
+
+------------------------------------------------------------------------
+-- Code generation
+------------------------------------------------------------------------
+
+generateCode :: [Dec] -> StructRep -> DecsQ
+generateCode ds rep = concat <$> sequence
+  [ generateDataType rep
+  , generateStructInstance rep
+  , generateMembers rep
+  , generateNew rep
+  , generateAlloc rep
+  , generateRoles ds rep
+  ]
+
+-- Generates: newtype TyCon a b c s = DataCon (Object s)
+generateDataType :: StructRep -> DecsQ
+generateDataType rep = sequence
+  [ newtypeD (return (srCxt rep)) (srName rep) (srTyVars rep)
+      Nothing
+      (normalC
+         (srConstructor rep)
+         [ bangType
+             (bang noSourceUnpackedness noSourceStrictness)
+             [t| Object $(varT (srState rep)) |]
+         ])
+#if MIN_VERSION_template_haskell(2,12,0)
+      (map return (srDerived rep))
+#else
+      (return (srDerived rep))
+#endif
+  ]
+
+generateRoles :: [Dec] -> StructRep -> DecsQ
+generateRoles ds rep
+  | hasRoleAnnotation = return []
+  | otherwise = sequence [ roleAnnotD (srName rep) (computeRoles rep) ]
+
+  where
+  hasRoleAnnotation = any isTargetRoleAnnot ds
+
+  isTargetRoleAnnot (RoleAnnotD n _) = n == srName rep
+  isTargetRoleAnnot _ = False
+
+-- Currently all roles are set to nominal. A more general solution
+-- should be able to infer some representional/phantom roles. To do
+-- this for arbitrary types we'll need a way to query the roles of
+-- existing type constructors to infer the correct roles.
+computeRoles :: StructRep -> [Role]
+computeRoles = map (const NominalR) . srTyVars
+
+-- | Type of the object not applied to a state type. This
+-- should have kind * -> *
+repType1 :: StructRep -> TypeQ
+repType1 rep = repTypeHelper (srName rep) (init (srTyVars rep))
+
+-- | Type of the object as originally declared, fully applied.
+repType :: StructRep -> TypeQ
+repType rep = repTypeHelper (srName rep) (srTyVars rep)
+
+repTypeHelper :: Name -> [TyVarBndr] -> TypeQ
+repTypeHelper c vs = foldl appT (conT c) (tyVarBndrT <$> vs)
+
+-- Construct a 'TypeQ' from a 'TyVarBndr'
+tyVarBndrT :: TyVarBndr -> TypeQ
+tyVarBndrT (PlainTV  n  ) = varT n
+tyVarBndrT (KindedTV n k) = sigT (varT n) k
+
+generateStructInstance :: StructRep -> DecsQ
+generateStructInstance rep =
+  [d| instance Struct $(repType1 rep) where struct = Dict
+      instance Eq     $(repType  rep) where (==)   = eqStruct
+    |]
+
+-- generates: allocDataCon = alloc <n>
+generateAlloc :: StructRep -> DecsQ
+generateAlloc rep =
+  do mName <- newName "m"
+     let m = varT mName
+         n = length (groupBy isNeighbor (srMembers rep))
+         allocName = mkAllocName rep
+
+     simpleDefinition rep allocName
+       (forallT [PlainTV mName] (cxt [])
+          [t| PrimMonad $m => $m ( $(repType1 rep) (PrimState $m) ) |])
+       [| alloc n |]
+
+
+-- generates:
+-- newDataCon a .. = do this <- alloc <n>; set field1 this a; ...; return this
+generateNew :: StructRep -> DecsQ
+generateNew rep =
+  do this <- newName "this"
+     let ms = groupBy isNeighbor (srMembers rep)
+
+         addName m = do n <- newName (nameBase (memberName m))
+                        return (n,m)
+
+     msWithArgs <- traverse (traverse addName) ms
+
+     let name = mkInitName rep
+         body = doE
+                -- allocate struct
+              $ bindS (varP this) (varE (mkAllocName rep))
+
+                -- initialize each member
+              : (noBindS <$> zipWith (assignN (varE this)) [0..] msWithArgs)
+
+                -- return initialized struct
+             ++ [ noBindS [| return $(varE this) |] ]
+
+     sequence
+       [ sigD name (newStructType rep)
+       , funD name [ clause (varP . fst <$> concat msWithArgs)
+                            (normalB [| st $body |] ) [] ]
+       ]
+
+
+assignN :: ExpQ -> Int -> [(Name,Member)] -> ExpQ
+
+assignN this _ [(arg,Member BoxedField n _)] =
+  [| setField $(varE n) $this $(varE arg) |]
+
+assignN this _ [(arg,Member Slot n _)] =
+  [| set      $(varE n) $this $(varE arg)|]
+
+assignN this i us =
+  do let n = length us
+     mba <- newName "mba"
+     let arg0 = fst (head us)
+     doE $ bindS (varP mba) [| initializeUnboxedField i n (sizeOf $(varE arg0)) $this |]
+         : [ noBindS [| writeByteArray $(varE mba) j $(varE arg) |]
+           | (j,(arg,_)) <- zip [0 :: Int ..] us ]
+
+-- | The type of the struct initializer is complicated enough to
+-- pull it out here.
+-- generates:
+-- PrimMonad m => field1 -> field2 -> ... -> m (TyName a b ... (PrimState m))
+newStructType :: StructRep -> TypeQ
+newStructType rep =
+  do mName <- newName "m"
+     let m = varT mName
+         s = [t| PrimState $m |]
+         obj = repType1 rep
+
+         buildType (Member BoxedField   _ t) = return t
+         buildType (Member UnboxedField _ t) = return t
+         buildType (Member Slot         _ f) = [t| $(return f) $s |]
+
+         r = foldr (-->)
+               [t| $m ($obj $s) |]
+               (buildType <$> srMembers rep)
+
+         primPreds = primPred <$> nub [ t | Member UnboxedField _ (VarT t) <- srMembers rep ]
+
+     forallRepT rep $ forallT [PlainTV mName] (cxt primPreds)
+       [t| PrimMonad $m => $r |]
+
+-- generates a slot, field, or unboxedField definition per member
+generateMembers :: StructRep -> DecsQ
+generateMembers rep
+  = concat <$>
+    zipWithM
+      (generateMember1 rep)
+      [0..]
+      (groupBy isNeighbor (srMembers rep))
+
+isNeighbor :: Member -> Member -> Bool
+isNeighbor (Member UnboxedField _ t) (Member UnboxedField _ u) = t == u
+isNeighbor _ _ = False
+
+------------------------------------------------------------------------
+
+generateMember1 :: StructRep -> Int -> [Member] -> DecsQ
+
+-- generates: fieldname = field <n>
+generateMember1 rep n [Member BoxedField fieldname fieldtype] =
+  simpleDefinition rep fieldname
+    [t| Field $(repType1 rep) $(return fieldtype) |]
+    [| field n |]
+
+-- generates: slotname = slot <n>
+generateMember1 rep n [Member Slot slotname slottype] =
+  simpleDefinition rep slotname
+    [t| Slot $(repType1 rep) $(return slottype) |]
+    [| slot n |]
+
+-- It the first type patterns didn't hit then we expect a list
+-- of unboxed fields due to the call to groupBy in generateMembers
+-- generates: fieldname = unboxedField <n> <i>
+generateMember1 rep n us =
+  concat <$> sequence
+    [ simpleDefinition rep fieldname
+          (addPrimCxt fieldtype
+             [t| Field $(repType1 rep) $(return fieldtype) |])
+          [| unboxedField n i |]
+
+    | (i,Member UnboxedField fieldname fieldtype) <- zip [0 :: Int ..] us
+    ]
+  where
+  addPrimCxt (VarT t) = forallT [] (cxt [primPred t])
+  addPrimCxt _        = id
+
+-- Generate code for definitions without arguments, with type variables
+-- quantified over those in the struct rep, including an inline pragma
+simpleDefinition :: StructRep -> Name -> TypeQ -> ExpQ -> DecsQ
+simpleDefinition rep name typ def =
+  sequence
+    [ sigD name (forallRepT rep typ)
+    , simpleValD name def
+    , pragInlD name Inline FunLike AllPhases
+    ]
+
+------------------------------------------------------------------------
+
+-- Simple use of 'valD' bind an expression to a name
+simpleValD :: Name -> ExpQ -> DecQ
+simpleValD var val = valD (varP var) (normalB val) []
+
+-- Quantifies over all of the type variables in a struct data type
+-- except the state variable which is likely to be ('PrimState' s)
+forallRepT :: StructRep -> TypeQ -> TypeQ
+forallRepT rep = forallT (init (srTyVars rep)) (cxt [])
+
+(-->) :: TypeQ -> TypeQ -> TypeQ
+f --> x = arrowT `appT` f `appT` x
+
+primPred :: Name -> PredQ
+primPred t = [t| Prim $(varT t) |]
+
+occurs :: Name -> Type -> Bool
+occurs n (AppT f x) = occurs n f || occurs n x
+occurs n (VarT m) = n == m
+occurs n (ForallT _ _ t) = occurs n t -- all names are fresh in quoted code, see below
+occurs n (SigT t _) = occurs n t
+occurs _ _ = False
+
+-- Prelude Language.Haskell.TH> runQ (stringE . show =<< [t| forall a. a -> (forall a. a) |])
+-- LitE (StringL "ForallT [PlainTV a_0] [] (AppT (AppT ArrowT (VarT a_0)) (ForallT [PlainTV a_1] [] (VarT a_1)))")
diff --git a/structs.cabal b/structs.cabal
--- a/structs.cabal
+++ b/structs.cabal
@@ -1,6 +1,6 @@
 name:          structs
 category:      Data
-version:       0
+version:       0.1
 license:       BSD3
 cabal-version: >= 1.22
 license-file:  LICENSE
@@ -9,17 +9,25 @@
 stability:     provisional
 homepage:      http://github.com/ekmett/structs/
 bug-reports:   http://github.com/ekmett/structs/issues
-copyright:     Copyright (C) 2015 Edward A. Kmett
+copyright:     Copyright (C) 2015-2017 Edward A. Kmett
 build-type:    Custom
-tested-with:   GHC == 7.10.1, GHC == 7.10.2
+tested-with:   GHC == 8.0.2, GHC == 8.2.1
 synopsis:      Strict GC'd imperative object-oriented programming with cheap pointers.
 description:
   This project is an experiment with a small GC'd strict mutable imperative universe with cheap pointers inside of the GHC runtime system.
 
 extra-source-files:
   CHANGELOG.markdown
+  HLint.hs
   README.markdown
+  Warning.hs
 
+custom-setup
+  setup-depends:
+    base          >= 4.9 && <5,
+    Cabal         >= 1.10,
+    cabal-doctest >= 1.0.1 && <1.1
+
 source-repository head
   type: git
   location: git://github.com/ekmett/structs.git
@@ -36,13 +44,15 @@
 
 library
   build-depends:
-    base >= 4.8 && < 5,
+    base >= 4.9 && < 5,
     deepseq,
+    template-haskell >= 2.11 && < 2.13,
     ghc-prim,
     primitive
 
   exposed-modules:
     Data.Struct
+    Data.Struct.TH
     Data.Struct.Internal
     Data.Struct.Internal.Label
     Data.Struct.Internal.LinkCut
@@ -61,6 +71,8 @@
   ghc-options:    -Wall -threaded
   hs-source-dirs: tests
   default-language: Haskell2010
+
+  x-doctest-options: -fobject-code
 
   if !flag(test-doctests)
     buildable: False
diff --git a/tests/doctests.hs b/tests/doctests.hs
new file mode 100644
--- /dev/null
+++ b/tests/doctests.hs
@@ -0,0 +1,25 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Main (doctests)
+-- Copyright   :  (C) 2012-14 Edward Kmett
+-- License     :  BSD-style (see the file LICENSE)
+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- This module provides doctests for a project based on the actual versions
+-- of the packages it was built with. It requires a corresponding Setup.lhs
+-- to be added to the project
+-----------------------------------------------------------------------------
+module Main where
+
+import Build_doctests (flags, pkgs, module_sources)
+import Data.Foldable (traverse_)
+import Test.DocTest
+
+main :: IO ()
+main = do
+    traverse_ putStrLn args
+    doctest args
+  where
+    args = flags ++ pkgs ++ module_sources
diff --git a/tests/doctests.hsc b/tests/doctests.hsc
deleted file mode 100644
--- a/tests/doctests.hsc
+++ /dev/null
@@ -1,78 +0,0 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE ForeignFunctionInterface #-}
------------------------------------------------------------------------------
--- |
--- Module      :  Main (doctests)
--- Copyright   :  (C) 2012-14 Edward Kmett
--- License     :  BSD-style (see the file LICENSE)
--- Maintainer  :  Edward Kmett <ekmett@gmail.com>
--- Stability   :  provisional
--- Portability :  portable
---
--- This module provides doctests for a project based on the actual versions
--- of the packages it was built with. It requires a corresponding Setup.lhs
--- to be added to the project
------------------------------------------------------------------------------
-module Main where
-
-import Build_doctests (deps)
-#if __GLASGOW_HASKELL__ < 710
-import Control.Applicative
-#endif
-import Control.Monad
-import Data.List
-import System.Directory
-import System.FilePath
-import Test.DocTest
-
-##if defined(mingw32_HOST_OS)
-##if defined(i386_HOST_ARCH)
-##define USE_CP
-import Control.Applicative
-import Control.Exception
-import Foreign.C.Types
-foreign import stdcall "windows.h SetConsoleCP" c_SetConsoleCP :: CUInt -> IO Bool
-foreign import stdcall "windows.h GetConsoleCP" c_GetConsoleCP :: IO CUInt
-##elif defined(x86_64_HOST_ARCH)
-##define USE_CP
-import Control.Applicative
-import Control.Exception
-import Foreign.C.Types
-foreign import ccall "windows.h SetConsoleCP" c_SetConsoleCP :: CUInt -> IO Bool
-foreign import ccall "windows.h GetConsoleCP" c_GetConsoleCP :: IO CUInt
-##endif
-##endif
-
--- | Run in a modified codepage where we can print UTF-8 values on Windows.
-withUnicode :: IO a -> IO a
-##ifdef USE_CP
-withUnicode m = do
-  cp <- c_GetConsoleCP
-  (c_SetConsoleCP 65001 >> m) `finally` c_SetConsoleCP cp
-##else
-withUnicode m = m
-##endif
-
-main :: IO ()
-main = withUnicode $ getSources >>= \sources -> doctest $
-    "-isrc"
-  : "-idist/build/autogen"
-  : "-optP-include"
-  : "-optPdist/build/autogen/cabal_macros.h"
-  : "-hide-all-packages"
-#ifdef TRUSTWORTHY
-  : "-DTRUSTWORTHY=1"
-#endif
-  : map ("-package="++) deps ++ sources
-
-getSources :: IO [FilePath]
-getSources = filter (isSuffixOf ".hs") <$> go "src"
-  where
-    go dir = do
-      (dirs, files) <- getFilesAndDirectories dir
-      (files ++) . concat <$> mapM go dirs
-
-getFilesAndDirectories :: FilePath -> IO ([FilePath], [FilePath])
-getFilesAndDirectories dir = do
-  c <- map (dir </>) . filter (`notElem` ["..", "."]) <$> getDirectoryContents dir
-  (,) <$> filterM doesDirectoryExist c <*> filterM doesFileExist c