diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2013, Galois, Inc.
+
+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 name of Galois, Inc. nor the names of other
+      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/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/examples/Example.hs b/examples/Example.hs
new file mode 100644
--- /dev/null
+++ b/examples/Example.hs
@@ -0,0 +1,122 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
+
+module Example where
+
+import Control.Monad
+
+import Ivory.Language
+-- import Ivory.Compile.C
+import Ivory.Compile.C.CmdlineFrontend
+
+import Ivory.BitData
+import ExampleTypes
+
+[bitdata|
+
+ bitdata SPI_CR1 :: Bits 16 = spi_cr1
+   { spi_cr1_bidimode :: Bit
+   , spi_cr1_bidioe   :: Bit
+   , spi_cr1_crcen    :: Bit
+   , spi_cr1_crcnext  :: Bit
+   , spi_cr1_dff      :: Bit
+   , spi_cr1_rxonly   :: Bit
+   , spi_cr1_ssm      :: Bit
+   , spi_cr1_ssi      :: Bit
+   , spi_cr1_lsbfirst :: Bit
+   , spi_cr1_spe      :: Bit
+   , spi_cr1_br       :: SPIBaud
+   , spi_cr1_mstr     :: Bit
+   , spi_cr1_cpol     :: Bit
+   , spi_cr1_cpha     :: Bit
+   }
+
+ -- The "SPI_CR2" register defined using a layout clause.
+ bitdata SPI_CR2 :: Bits 16 = spi_cr2
+   { spi_cr2_txeie    :: Bit
+   , spi_cr2_rxneie   :: Bit
+   , spi_cr2_errie    :: Bit
+   , spi_cr2_frf      :: Bit
+   , spi_cr2_ssoe     :: Bit
+   , spi_cr2_txdmaen  :: Bit
+   , spi_cr2_rxdmaen  :: Bit
+   } as 8b0 # spi_cr2_txeie # spi_cr2_rxneie # spi_cr2_errie # spi_cr2_frf
+      # 1b0 # spi_cr2_ssoe # spi_cr2_txdmaen # spi_cr2_rxdmaen
+
+ -- The "SPI_CR2" register defined using the default layout and
+ -- padding fields.
+ bitdata Alt_SPI_CR2 :: Bits 16 = alt_spi_cr2
+   { _                    :: Bits 8
+   , alt_spi_cr2_txeie    :: Bit
+   , alt_spi_cr2_rxneie   :: Bit
+   , alt_spi_cr2_errie    :: Bit
+   , alt_spi_cr2_frf      :: Bit
+   , _                    :: Bit
+   , alt_spi_cr2_ssoe     :: Bit
+   , alt_spi_cr2_txdmaen  :: Bit
+   , alt_spi_cr2_rxdmaen  :: Bit
+   }
+
+ -- The "NVIC_ISER" register is an array of 32 bits.
+ --
+ -- We will want to access the array both at Ivory run-time using an
+ -- "Ix 32" and at code generation time using a Haskell integer.
+ bitdata NVIC_ISER :: Bits 32 = nvic_iser
+   { nvic_iser_setena :: BitArray 32 Bit
+   }
+
+ -- A bit data type with an array of 4-bit integers.
+ bitdata ArrayTest :: Bits 32 = array_test
+   { at_4bits :: BitArray 8 (Bits 4)
+   }
+|]
+
+test1 :: Def ('[Uint16] :-> Uint16)
+test1 = proc "test1" $ \x -> body $ do
+  ret $ withBits x $ do
+        clearBit spi_cr1_cpha
+        setBit   spi_cr1_cpol
+        setField spi_cr1_br spi_baud_div_8
+
+test2 :: Def ('[Uint32] :-> Uint8)
+test2 = proc "test2" $ \x -> body $ do
+  let d = fromRep x :: NVIC_ISER
+  ret $ toRep (d #. nvic_iser_setena #! 0)
+
+-- | Iterate over the elements of a bit array.
+forBitArray_ arr f =
+  forM_ [0..bitLength arr] $ \i ->
+    f (arr #! i)
+
+-- | Test looping over the elements of a bit array:
+test3 :: Def ('[Uint32] :-> Uint32)
+test3 = proc "test3" $ \x -> body $ do
+  let d = fromRep x
+  total <- local (ival 0)
+  forBitArray_ (d #. at_4bits) $ \i -> do
+    x' <- deref total
+    let y = safeCast (toRep i)
+    store total (x' + y)
+  ret =<< deref total
+
+get_baud :: Def ('[Uint16] :-> Uint8)
+get_baud = proc "get_baud" $ \x -> body $ do
+  let d = fromRep x
+  ret (toRep (d #. spi_cr1_br))
+
+cmodule :: Module
+cmodule = package "hw" $ do
+  incl get_baud
+  incl test1
+  incl test2
+  incl test3
+
+main :: IO ()
+main = runCompiler [cmodule] (initialOpts {stdOut = True, constFold = True})
diff --git a/examples/ExampleTypes.hs b/examples/ExampleTypes.hs
new file mode 100644
--- /dev/null
+++ b/examples/ExampleTypes.hs
@@ -0,0 +1,20 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+module ExampleTypes where
+
+import Ivory.BitData
+
+[bitdata|
+ bitdata SPIBaud :: Bits 3
+   = spi_baud_div_2   as 0
+   | spi_baud_div_4   as 1
+   | spi_baud_div_8   as 2
+   | spi_baud_div_16  as 3
+   | spi_baud_div_32  as 4
+   | spi_baud_div_64  as 5
+   | spi_baud_div_128 as 6
+   | spi_baud_div_256 as 7
+|]
diff --git a/examples/Main.hs b/examples/Main.hs
new file mode 100644
--- /dev/null
+++ b/examples/Main.hs
@@ -0,0 +1,6 @@
+module Main where
+
+import qualified Example as E
+
+main :: IO ()
+main = E.main
diff --git a/ivory-bitdata.cabal b/ivory-bitdata.cabal
new file mode 100644
--- /dev/null
+++ b/ivory-bitdata.cabal
@@ -0,0 +1,61 @@
+-- Initial ivory-bitdata.cabal generated by cabal init.  For further
+-- documentation, see http://haskell.org/cabal/users-guide/
+
+name:                ivory-bitdata
+version:             0.2.0.0
+-- synopsis:
+-- description:
+license:             BSD3
+license-file:        LICENSE
+author:              Galois, Inc.
+maintainer:          jamesjb@galois.com
+copyright:           2013 Galois, Inc.
+category:            Language
+build-type:          Simple
+cabal-version:       >=1.10
+synopsis:            Ivory bit-data support.
+description:         See the paper http://yav.github.io/publications/bitdata.pdf
+homepage:            http://smaccmpilot.org/languages/ivory-introduction.html
+build-type:          Simple
+cabal-version:       >= 1.10
+license:             BSD3
+license-file:        LICENSE
+source-repository    this
+  type:     git
+  location: https://github.com/GaloisInc/ivory
+  tag:      hackage-bitdata-0200
+
+
+library
+  exposed-modules:     Ivory.BitData,
+                       Ivory.BitData.Bits,
+                       Ivory.BitData.BitData,
+                       Ivory.BitData.Array,
+                       Ivory.BitData.Monad,
+                       Ivory.BitData.Quote
+  other-modules:       Ivory.BitData.DefBitRep,
+                       Ivory.BitData.AST,
+                       Ivory.BitData.TokenParser,
+                       Ivory.BitData.Parser,
+                       Example,
+                       ExampleTypes
+  hs-source-dirs:      src, examples
+  build-depends:       base >= 4.6 && < 4.7,
+                       ivory,
+                       ivory-backend-c,
+                       monadLib,
+                       template-haskell,
+                       parsec
+  default-language:    Haskell2010
+  ghc-options:         -Wall
+
+executable ivory-bitdata-example
+  main-is:             Main.hs
+  other-modules:       Example,
+                       ExampleTypes
+  hs-source-dirs:      examples
+  default-language:    Haskell2010
+  build-depends:       base >= 4.6,
+                       ivory-bitdata,
+                       ivory,
+                       ivory-backend-c
diff --git a/src/Ivory/BitData.hs b/src/Ivory/BitData.hs
new file mode 100644
--- /dev/null
+++ b/src/Ivory/BitData.hs
@@ -0,0 +1,53 @@
+--
+-- BitData.hs --- Top-level module for ivory-bitdata.
+--
+-- Copyright (C) 2013, Galois, Inc.
+-- All Rights Reserved.
+--
+
+module Ivory.BitData (
+  -- * quasiquoter
+  bitdata
+
+  -- * bit types
+  , Bits(), Bit, BitArray(), BitRep()
+  , repToBits, bitsToRep, zeroBits
+  , bitLength, bitIx
+
+  -- * bit data
+  , BitData(), BitDataField(), BitDataRep
+
+  -- * bit data conversions
+  , toBits, fromBits
+  , toRep, fromRep
+
+  -- * bit data field operations
+  , setBitDataBit, clearBitDataBit, getBitDataField, setBitDataField
+
+  -- * bit data operators
+  , (#!) -- access nth element of BitArray
+  , (#.) -- flip getBitDataField
+  , (#>) -- BitDataField composition (like Control.Category.>>>)
+
+  -- * bit actions
+  , BitDataM(), runBits, withBits, withBitsRef
+  , clear, setBit, clearBit, setField
+  , bitToBool, boolToBit
+) where
+
+import Ivory.BitData.Bits
+import Ivory.BitData.BitData
+import Ivory.BitData.Array
+import Ivory.BitData.Quote
+import Ivory.BitData.Monad
+
+import Ivory.Language
+
+-- | Convert a single bit bitdata to an Ivory boolean.
+bitToBool :: Bit -> IBool
+bitToBool b = (toRep b ==? 0) ? (false, true)
+
+-- | Convert an Ivory boolean to a single bit.
+boolToBit :: IBool -> Bit
+boolToBit b = b ? (fromRep 1, fromRep 0)
+
diff --git a/src/Ivory/BitData/AST.hs b/src/Ivory/BitData/AST.hs
new file mode 100644
--- /dev/null
+++ b/src/Ivory/BitData/AST.hs
@@ -0,0 +1,48 @@
+--
+-- AST.hs --- HW quasiquoter AST.
+--
+-- Copyright (C) 2013, Galois, Inc.
+-- All Rights Reserved.
+--
+
+module Ivory.BitData.AST where
+
+-- | Basic type representation allowed in bit definitions.
+data BitTy = TyCon String
+           | TyNat Integer
+           | TyApp BitTy BitTy
+  deriving Show
+
+-- | A bit integer literal with a known or unknown size.
+data BitLiteral =
+    BitLitKnown   { bitLitLen :: Int , bitLitVal :: Int }
+  | BitLitUnknown { bitLitVal :: Int }
+ deriving Show
+
+-- | One element of a bit data constructor layout.
+data LayoutItem = LayoutConst BitLiteral
+                | LayoutField String
+  deriving Show
+
+-- | A constructor layout is a list of layout items.
+type Layout = [LayoutItem]
+
+-- | A "bitdata" definition.
+data Def = Def
+  { defName    :: String
+  , defType    :: BitTy
+  , defConstrs :: [Constr]
+  }
+
+-- | A constructor definition within a "bitdata".
+data Constr = Constr
+  { constrName   :: String
+  , constrFields :: [Field]
+  , constrLayout :: Layout
+  }
+
+-- | A record-like field defined within a "bitdata" constructor.
+data Field = Field
+  { fieldName :: String
+  , fieldType :: BitTy
+  }
diff --git a/src/Ivory/BitData/Array.hs b/src/Ivory/BitData/Array.hs
new file mode 100644
--- /dev/null
+++ b/src/Ivory/BitData/Array.hs
@@ -0,0 +1,77 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE UndecidableInstances #-}
+--
+-- Array.hs --- Bit data array types.
+--
+-- Copyright (C) 2013, Galois, Inc.
+-- All Rights Reserved.
+--
+
+module Ivory.BitData.Array where
+
+import GHC.TypeLits
+
+import Ivory.Language
+import Ivory.BitData.Bits
+import Ivory.BitData.BitData
+
+-- NOTE: This type family is used to calculate the total size of a bit
+-- array by multiplying "n" by the size of "a" in bits.  Once we have
+-- the type-nats solver in place, we should no longer need this.
+--
+-- The quasiquoter may generate multiple instances of "ArraySize" with
+-- the same "n", "a" and result, which is allowed by the type family
+-- overlapping rules.  It does seem like a bit of a hack though.
+type family ArraySize (n :: Nat) (a :: *) :: Nat
+
+-- | An array of "n" bit data elements of type "a".
+data BitArray (n :: Nat) a = BitArray { unArray :: Bits (ArraySize n a) }
+
+-- | Return the number of elements in a "BitArray".
+bitLength :: forall a n. SingI n => BitArray n a -> Int
+bitLength _ = fromIntegral (fromSing (sing :: Sing n))
+
+instance (SingI n,
+          SingI (ArraySize n a),
+          BitData a,
+          IvoryRep (BitRep (ArraySize n a)))
+    => BitData (BitArray n a) where
+  type BitType (BitArray n a) = Bits (ArraySize n a)
+  toBits = unArray
+  fromBits = BitArray
+
+-- | Return the "n"th element of a "BitArray".
+(#!) :: forall a n.
+        (BitData a,
+         SingI n,
+         SingI (BitSize a),
+         SingI (ArraySize n a),
+         BitCast (BitRep (ArraySize n a)) (BitDataRep a),
+         IvoryRep (BitRep (ArraySize n a)))
+     => BitArray n a -> Int -> a
+BitArray bits #! i =
+  if (i < 0) || (i >= n')
+    then error "bit array index out of bounds"
+    else bits #. field
+  where
+    n'       = fromIntegral (fromSing (sing :: Sing n)) :: Int
+    elemSize = fromIntegral (fromSing (sing :: Sing (BitSize a))) :: Int
+    field    = BitDataField (i * elemSize) elemSize
+
+-- | Return a "BitDataField" that accesses the "n"th element of a
+-- "BitArray".  This can be composed with other field accessors using
+-- "#>".
+bitIx :: forall a n.
+         (BitData a,
+          SingI n,
+          SingI (BitSize a),
+          SingI (ArraySize n a))
+      => Int -> BitDataField (BitArray n a) a
+bitIx i = BitDataField (i * elemSize) elemSize
+  where
+    elemSize = fromIntegral (fromSing (sing :: Sing (BitSize a))) :: Int
diff --git a/src/Ivory/BitData/BitData.hs b/src/Ivory/BitData/BitData.hs
new file mode 100644
--- /dev/null
+++ b/src/Ivory/BitData/BitData.hs
@@ -0,0 +1,119 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE UndecidableInstances #-}
+--
+-- BitData.hs --- Typed bit data types.
+--
+-- Copyright (C) 2013, Galois, Inc.
+-- All Rights Reserved.
+--
+
+module Ivory.BitData.BitData where
+
+import GHC.TypeLits
+import Ivory.Language
+
+import Ivory.BitData.Bits
+
+-- | Class of bit data types defined by the "bitdata" quasiquoter.
+class (SingI (BitSize (BitType a)),
+       IvoryRep (BitDataRep a),
+       BitType a ~ Bits (BitSize (BitType a))) => BitData a where
+  -- | Return the base "(Bits n)" type as defined in the "bitdata"
+  -- quasiquoter.
+  type BitType a :: *
+
+  -- | Convert a bit data type to its raw bit value.  This is always
+  -- well defined and should be exported.
+  toBits :: a -> BitType a
+
+  -- | Convert a raw bit value to a bit data type.  All values may not
+  -- be well defined with respect to the original set of bit data
+  -- constructors.  For now, we allow these "junk" values to be
+  -- created, but that may change in the future (perhaps by
+  -- implementing a checked, Ivory run-time conversion).
+  fromBits :: BitType a -> a
+
+-- | The Ivory type that stores the actual value for a bit data type.
+--
+-- This is a shorthand to simplify the constraints on functions that
+-- take arguments of the "BitData" class.
+type BitDataRep a = BitRep (BitSize (BitType a))
+
+-- | Convert a raw Ivory type to a bit data type.  If the input value
+-- is too large, the out of range upper bits will be masked off.
+fromRep :: BitData a => BitDataRep a -> a
+fromRep = fromBits . repToBits
+
+-- XXX do not export---used when unwrapping/rewrapping values when
+-- setting fields and the size has obviously not changed.
+unsafeFromRep :: BitData a => BitDataRep a -> a
+unsafeFromRep = fromBits . unsafeRepToBits
+
+-- | Convert a bit data value to its Ivory representation.
+toRep :: BitData a => a -> BitDataRep a
+toRep = unBits . toBits
+
+-- | Identity instance of "BitData" for the base "Bits n" type.
+instance (SingI n, IvoryRep (BitRep n)) => BitData (Bits n) where
+  type BitType (Bits n) = Bits n
+  toBits = id
+  fromBits = id
+
+-- | Description of a bit field defined by the "bitdata" quasiquoter.
+-- Each field defined in the record syntax will generate a top-level
+-- definition of "BitDataField".
+--
+-- This constructor must remain unexported so that only fields checked
+-- by the quasiquoter are created.
+data BitDataField a b = BitDataField
+  { bitDataFieldPos :: Int
+  , bitDataFieldLen :: Int
+  } deriving Show
+
+-- | Bit data field composition.  (like Control.Category.>>>)
+(#>) :: BitDataField a b -> BitDataField b c -> BitDataField a c
+(BitDataField p1 _) #> (BitDataField p2 l2) = BitDataField pos len
+  where
+    pos = p1 + p2
+    len = l2
+
+-- | Extract a field from a bit data definition.  Returns the value as
+-- the type defined on the right hand side of the field definition in
+-- the "bitdata" quasiquoter.
+getBitDataField :: (BitData a, BitData b,
+                    BitCast (BitDataRep a) (BitDataRep b))
+                => BitDataField a b -> a -> b
+getBitDataField f x = unsafeFromRep (bitCast ((toRep x `iShiftR` pos) .& mask))
+  where pos  = fromIntegral (bitDataFieldPos f)
+        mask = fromIntegral ((2 ^ bitDataFieldLen f) - 1 :: Integer)
+
+-- | Infix operator to read a bit data field.  (like Data.Lens.^.)
+(#.) :: (BitData a, BitData b,
+         BitCast (BitDataRep a) (BitDataRep b))
+     => a -> BitDataField a b -> b
+(#.) = flip getBitDataField
+
+-- | Set a field from a bit data definition.
+setBitDataField :: (BitData a, BitData b,
+                    SafeCast (BitDataRep b) (BitDataRep a))
+                => BitDataField a b -> a -> b -> a
+setBitDataField f x y = unsafeFromRep ((toRep x .& mask) .| val)
+  where val  = safeCast (toRep y) `iShiftL` pos
+        pos  = fromIntegral (bitDataFieldPos f)
+        fmax = fromIntegral ((2 ^ bitDataFieldLen f) - 1 :: Integer)
+        mask = iComplement (fmax `iShiftL` pos)
+
+-- | Set a single-bit field in a bit data value.
+setBitDataBit :: BitData a => BitDataField a Bit -> a -> a
+setBitDataBit f x = unsafeFromRep (toRep x .| (1 `iShiftL` pos))
+  where pos = fromIntegral (bitDataFieldPos f)
+
+-- | Clear a single-bit field in a bit data value.
+clearBitDataBit :: BitData a => BitDataField a Bit -> a -> a
+clearBitDataBit f x = unsafeFromRep (toRep x .& (iComplement (1 `iShiftL` pos)))
+  where pos = fromIntegral (bitDataFieldPos f)
diff --git a/src/Ivory/BitData/Bits.hs b/src/Ivory/BitData/Bits.hs
new file mode 100644
--- /dev/null
+++ b/src/Ivory/BitData/Bits.hs
@@ -0,0 +1,87 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+--
+-- Bits.hs --- Bit-sized unsigned integer types.
+--
+-- Copyright (C) 2013, Galois, Inc.
+-- All Rights Reserved.
+--
+
+module Ivory.BitData.Bits where
+
+import GHC.TypeLits
+import Ivory.Language
+
+import Ivory.BitData.DefBitRep
+
+----------------------------------------------------------------------
+-- Bit Representations
+
+-- | Type function: "BitRep (n :: Nat)" returns an Ivory type given a
+-- bit size as a type-level natural.  Instances of this type family
+-- for bits [1..64] are generated using Template Haskell.
+type family BitRep (n :: Nat) :: *
+
+defBitRep ''BitRep ''Uint8  [1..8]
+defBitRep ''BitRep ''Uint16 [9..16]
+defBitRep ''BitRep ''Uint32 [17..32]
+defBitRep ''BitRep ''Uint64 [33..64]
+
+-- | Set of constraints we require on a bit representation type.
+type IvoryRep a = (IvoryBits a, IvoryOrd a, IvoryInit a,
+                   IvoryStore a, IvoryType a)
+
+----------------------------------------------------------------------
+-- Bit Data Type
+
+-- | A wrapper for an Ivory type that can hold an "n" bit unsigned
+-- integer.
+newtype Bits (n :: Nat) = Bits { unBits :: BitRep n }
+
+deriving instance (IvoryRep (BitRep n)) => IvoryType (Bits n)
+deriving instance (IvoryRep (BitRep n)) => IvoryVar  (Bits n)
+deriving instance (IvoryRep (BitRep n)) => IvoryExpr (Bits n)
+deriving instance (IvoryRep (BitRep n)) => IvoryEq   (Bits n)
+
+-- | "Bit" is a type alias for "Bits 1".
+type Bit = Bits 1
+
+-- | Type function to extract the "n" from a "Bits n" type.
+type family BitSize a :: Nat
+type instance BitSize (Bits n) = n
+
+-- | Convert a Haskell integer to a bit data value without bounds
+-- checking.  This must not be exported, but is used by the
+-- quasiquoter when the values are constant at compile-time and
+-- already bounds checked.
+unsafeIntToBits :: (IvoryRep (BitRep n), Integral a) => a -> Bits n
+unsafeIntToBits = Bits . fromIntegral
+
+-- | Return a bit value of all zeros of the given size.
+zeroBits :: (IvoryRep (BitRep n)) => Bits n
+zeroBits = Bits 0
+
+-- XXX do not export, used when unwrapping/rewrapping values when
+-- setting fields and the size has obviously not changed.
+unsafeRepToBits :: BitRep n -> Bits n
+unsafeRepToBits = Bits
+
+-- | Convert an Ivory value to a bit value.  If the input value
+-- contains out of range bits, they will be ignored.
+repToBits :: forall n. (SingI n, IvoryRep (BitRep n))
+          => BitRep n -> Bits n
+repToBits x = Bits (x .& mask)
+  where mask = fromIntegral (2 ^ fromSing (sing :: Sing n) - 1 :: Integer)
+
+-- | Convert a bit value to an Ivory value.
+bitsToRep :: Bits n -> BitRep n
+bitsToRep = unBits
diff --git a/src/Ivory/BitData/DefBitRep.hs b/src/Ivory/BitData/DefBitRep.hs
new file mode 100644
--- /dev/null
+++ b/src/Ivory/BitData/DefBitRep.hs
@@ -0,0 +1,22 @@
+{-# LANGUAGE TemplateHaskell #-}
+--
+-- DefBitRep.hs --- Template Haskell utilities.
+--
+-- Copyright (C) 2013, Galois, Inc.
+-- All Rights Reserved.
+--
+
+module Ivory.BitData.DefBitRep where
+
+import Language.Haskell.TH
+
+-- | Define the type instance:
+--
+--   type instance <fname> <x> = <rname>
+--
+-- for each "n" in "xs".
+--
+-- Used to define the set of representation types for bit lengths.
+defBitRep :: Name -> Name -> [Integer] -> DecsQ
+defBitRep fname rname xs = return $ map go xs
+  where go n = TySynInstD fname [LitT (NumTyLit n)] (ConT rname)
diff --git a/src/Ivory/BitData/Monad.hs b/src/Ivory/BitData/Monad.hs
new file mode 100644
--- /dev/null
+++ b/src/Ivory/BitData/Monad.hs
@@ -0,0 +1,71 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE DataKinds #-}
+--
+-- Monad.hs --- Bit field modification Monad.
+--
+-- Copyright (C) 2013, Galois, Inc.
+-- All Rights Reserved.
+--
+
+module Ivory.BitData.Monad where
+
+import Ivory.Language
+
+import qualified MonadLib.Monads as M
+
+import Ivory.BitData.Bits
+import Ivory.BitData.BitData
+
+-- | An action that modifies a bit data value of type "d" and returns
+-- a "a" in the "Ivory s r" monad.  Values of this type are passed as
+-- the "body" argument to "withBits" etc.
+newtype BitDataM d a = BitDataM { runBitDataM :: M.State d a }
+  deriving (Functor, Monad)
+
+-- | Clear the value of the current bit data value.
+clear :: BitData d => BitDataM d ()
+clear = return () -- BitDataM $ M.set 0
+
+-- XXX add getField and getBit?  it might get confusing if they are in
+-- the monad.
+
+-- | Set a single bit field in the current bit data value.
+setBit :: BitData d => BitDataField d Bit -> BitDataM d ()
+setBit f = BitDataM $ M.sets_ (setBitDataBit f)
+
+-- | Clear a single bit.
+clearBit :: BitData d => BitDataField d Bit -> BitDataM d ()
+clearBit f = BitDataM $ M.sets_ (clearBitDataBit f)
+
+-- | Set a field to a value.
+setField :: (BitData d, BitData b,
+             SafeCast (BitDataRep b) (BitDataRep d))
+         => BitDataField d b -> b -> BitDataM d ()
+setField f x = BitDataM $ M.sets_ (\v -> setBitDataField f v x)
+
+-- | Execute a bitdata action given an initial value, returning the
+-- new bitdata value and the result of the action.
+runBits :: BitData d => BitDataRep d -> BitDataM d a -> (a, BitDataRep d)
+runBits rep mf = (result, toRep val)
+  where (result, val) = M.runState (fromRep rep) (runBitDataM mf)
+
+-- | Execute a bitdata action given an initial value, returning the
+-- new bitdata value.
+withBits :: BitData d => BitDataRep d -> BitDataM d () -> BitDataRep d
+withBits rep mf = snd (runBits rep mf)
+
+-- | Execute a bit data action given a reference to a value, writing
+-- the resulting value back to the reference upon completion and
+-- returning the result of the action.
+withBitsRef :: BitData d
+            => Ref s1 (Stored (BitDataRep d))
+            -> BitDataM d a
+            -> Ivory eff a
+withBitsRef ref mf = do
+  rep <- deref ref
+  let (result, rep') = runBits rep mf
+  store ref rep'
+  return result
diff --git a/src/Ivory/BitData/Parser.hs b/src/Ivory/BitData/Parser.hs
new file mode 100644
--- /dev/null
+++ b/src/Ivory/BitData/Parser.hs
@@ -0,0 +1,159 @@
+--
+-- Parser.hs --- HW quasiquoter parser.
+--
+-- Copyright (C) 2013, Galois, Inc.
+-- All Rights Reserved.
+--
+
+module Ivory.BitData.Parser (
+  parseDefs, parseBitLiteral
+) where
+
+import Control.Applicative
+import Control.Monad (when)
+import Data.Char (isUpper, isLower, toLower, digitToInt)
+import Data.Maybe (listToMaybe)
+import Numeric (readDec, readHex, readInt)
+import Text.Parsec ((<?>), chainl1, many1, sepBy, sepBy1, eof,
+                    oneOf, option, digit, hexDigit,
+                    unexpected, notFollowedBy, letter, alphaNum)
+import Text.Parsec.String (Parser)
+
+import Ivory.BitData.AST
+import Ivory.BitData.TokenParser
+
+--
+-- Bit Literal Syntax
+-- ------------------
+--
+-- We generalize the C syntax for hexadecimal numbers.
+--
+-- An n-bit binary natural number literal:
+--
+--   <n>[bB]{0,1}+
+--
+-- An n-bit decimal natural number literal:
+--
+--   <n>[dD]{0..9}+
+--
+-- An n-bit hexadecimal natural number literal:
+--
+--   <n>[xX]{0..9a..fA..F}+
+--
+
+-- | Convert a "ReadS" style parser to a Parsec parser.
+liftReadS :: ReadS a -> String -> Parser a
+liftReadS f = maybe (unexpected "no parse") (return . fst) .
+              listToMaybe . filter (null . snd) . f
+
+-- | Parse a binary digit.
+binDigit :: Parser Char
+binDigit = oneOf "01"
+
+-- | Convert a string containing a base 2 number to a number.
+readBin :: (Eq a, Num a) => ReadS a
+readBin = readInt 2 (`elem` "01") digitToInt
+
+-- | Parse a list of digits given the bit literal base character.
+digitParser :: Char -> Parser Int
+digitParser 'b' = many1 binDigit >>= liftReadS readBin
+digitParser 'd' = many1 digit    >>= liftReadS readDec
+digitParser 'x' = many1 hexDigit >>= liftReadS readHex
+digitParser _   = fail "invalid bit literal base character"
+
+-- | Parse the start of a bit literal (see description above).
+bitLiteral :: Parser BitLiteral
+bitLiteral = (lexeme $ do
+  size <- many1 digit >>= liftReadS readDec
+  (bitLiteralTail size <|> return (BitLitUnknown size))
+    <* notFollowedBy alphaNum) <?> "bit literal"
+
+-- | Parse the optional tail of a bit literal.
+bitLiteralTail :: Int -> Parser BitLiteral
+bitLiteralTail size = do
+  -- The use of "letter" rather than "oneOf" here is a little subtle.
+  --
+  -- We don't want the parser to fail without consuming input if there
+  -- is a bad base character, because then the "BitLitUnknown"
+  -- alternative in the caller will be used.  We want to make sure we
+  -- generate the right error in "digitParser", so accept any letter
+  -- even if we know it's wrong at this time.
+  baseChar <- toLower <$> letter -- oneOf "bBdDxX"
+  value    <- digitParser baseChar
+  if size == 0
+    then return $ BitLitUnknown value
+    else do
+      when (value >= 2 ^ size) $
+        fail "bit literal out of range"
+      return $ BitLitKnown size value
+
+-- | Standalone parser for a bit literal.
+parseBitLiteral :: Parser BitLiteral
+parseBitLiteral = whiteSpace *> bitLiteral <* eof
+
+-- | Parse a Haskell type or type constructor name.
+typeName :: Parser String
+typeName = do
+  x <- identifier
+  if not (isUpper (head x))
+    then fail "expecting type or type constructor name"
+    else return x
+
+-- | Parse a Haskell value name or "_".
+valueName :: Parser String
+valueName = valueIdentifier <|> (symbol "_")
+  where valueIdentifier = do
+          x <- identifier
+          if not (isLower (head x))
+             then fail "expecting value name"
+             else return x
+
+-- | Parse a type (except application).
+parseType1 :: Parser BitTy
+parseType1 = numTyLit <|> conT <|> parens parseType
+  where numTyLit = TyNat <$> natural
+        conT     = TyCon <$> typeName
+
+-- | Parse a type that can appear in a bitdata definition.
+parseType :: Parser BitTy
+parseType = parseType1 `chainl1` (whiteSpace >> return TyApp)
+
+-- | Parse a set of bit data definitions.  This is the top-level
+-- parser that is called from the quasiquoter.
+parseDefs :: Parser [Def]
+parseDefs = whiteSpace *> some parseDef <* eof
+
+-- | Parse a single bit data definition.
+parseDef :: Parser Def
+parseDef =
+  Def <$  symbol "bitdata"
+      <*> typeName
+      <*  reservedOp "::"
+      <*> parseType
+      <*  reservedOp "="
+      <*> sepBy1 parseConstr (reservedOp "|")
+
+-- | Parse one constructor of a bit data definition.
+parseConstr :: Parser Constr
+parseConstr =
+  Constr <$> valueName
+         <*> parseFields
+         <*> parseLayout
+
+-- | Parse zero or more fields in a bit data constructor.
+parseFields :: Parser [Field]
+parseFields = option [] (braces (sepBy parseField comma))
+
+-- | Parse an optional "as" clause for a bit data constructor.
+parseLayout :: Parser Layout
+parseLayout = option [] (symbol "as" *> body)
+  where body = sepBy1 item (reservedOp "#")
+        item =  LayoutConst <$> bitLiteral
+            <|> LayoutField <$> valueName
+
+-- | Parse one bit data field in a bit data constructor.
+parseField :: Parser Field
+parseField =
+  Field <$> valueName
+        <*  reservedOp "::"
+        <*> parseType
diff --git a/src/Ivory/BitData/Quote.hs b/src/Ivory/BitData/Quote.hs
new file mode 100644
--- /dev/null
+++ b/src/Ivory/BitData/Quote.hs
@@ -0,0 +1,494 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+--
+-- Quote.hs --- Bit data quasiquoter.
+--
+-- Copyright (C) 2013, Galois, Inc.
+-- All Rights Reserved.
+--
+
+module Ivory.BitData.Quote (bitdata) where
+
+import Control.Monad (MonadPlus, liftM, msum, when, unless, mzero)
+import Data.Foldable (find, foldl')
+import Data.List (sort)
+import Data.Maybe (mapMaybe)
+import Data.Traversable (mapAccumL)
+import MonadLib (ChoiceT, findOne, lift)
+import Text.Parsec (parse, setPosition, getPosition,
+                    setSourceLine, setSourceColumn)
+import Text.Parsec.String (Parser)
+
+import Language.Haskell.TH
+import Language.Haskell.TH.Quote
+
+import Ivory.Language ((.|), iShiftL, safeCast)
+import qualified Ivory.Language as I
+import Ivory.BitData.AST
+import Ivory.BitData.Parser (parseBitLiteral, parseDefs)
+
+import qualified Ivory.BitData.Bits    as B
+import qualified Ivory.BitData.BitData as B
+import qualified Ivory.BitData.Array   as B
+
+-- | Quasiquoter for defining Ivory bit value and bit data types.
+--
+-- Only the declaration and expression forms are implemented.
+bitdata :: QuasiQuoter
+bitdata = QuasiQuoter
+       { quoteDec  = bitdataQuoteDec
+       , quoteExp  = bitdataQuoteExp
+       , quotePat  = error "quotePat not implemented"
+       , quoteType = error "quoteType not implemented"
+       }
+
+-- | Run a parser on a string, setting the source position information
+-- from the location provided by the TH "Q" monad.
+qParse :: Parser a -> String -> Q a
+qParse parser str = do
+  loc <- location
+  case parse (body loc) (loc_filename loc) str of
+    Right defs -> return defs
+    Left err   -> fail (show err)
+  where
+    body loc = do
+      pos <- getPosition
+      let (line, col) = loc_start loc
+      setPosition (setSourceLine (setSourceColumn pos col) line)
+      parser
+
+-- | The 'concatMapM' function generalizes 'concatMap' to arbitrary
+-- monads.
+concatMapM :: (Monad m) => (a -> m [b]) -> [a] -> m [b]
+concatMapM f xs = liftM concat (mapM f xs)
+
+-- | Combine a list of items using a "MonadPlus" Monad.  This is used
+-- to lift a list of items into a "ChoiceT m a".
+anyOf :: MonadPlus m => [a] -> m a
+anyOf = msum . map return
+
+----------------------------------------------------------------------
+-- Expression Quasiquoter
+
+-- | Parse a bit data literal expression (see the parser module for a
+-- description of the syntax).
+bitdataQuoteExp :: String -> Q Exp
+bitdataQuoteExp str = do
+  lit <- qParse parseBitLiteral str
+  case lit of
+    BitLitKnown len val ->
+      let tylen = litT (numTyLit (fromIntegral len)) in
+      [| B.unsafeIntToBits (val :: Int) :: B.Bits $tylen |]
+    BitLitUnknown val ->
+      [| B.repToBits (fromIntegral (val :: Int)) |]
+
+----------------------------------------------------------------------
+-- Declaration Quasiquoter
+
+-- | Declaration quasiquoter for "bits".
+bitdataQuoteDec :: String -> Q [Dec]
+bitdataQuoteDec str = concatMapM mkDef =<< parseDefsQ str
+
+-- | Parse a set of bit data definitions from a string.
+parseDefsQ :: String -> Q [Def]
+parseDefsQ = qParse parseDefs
+
+----------------------------------------------------------------------
+-- AST Annotation
+
+-- | Convert a parser type to a Template Haskell type.
+convertType :: BitTy -> Q Type
+convertType (TyCon s) = do
+  m <- lookupTypeName s
+  case m of
+    Just ty -> return $ ConT ty
+    Nothing -> fail $ "undefined type: " ++ s
+convertType (TyNat n) = return $ LitT $ NumTyLit n
+convertType (TyApp t1 t2) = do
+  t1' <- convertType t1
+  t2' <- convertType t2
+  return $ AppT t1' t2'
+
+-- | Look up a type and return its size in bits.
+getTyBits :: Type -> ChoiceT Q Int
+getTyBits ty =
+  case ty of
+    ConT name
+      | name == ''B.Bit -> return 1
+      | otherwise       -> tyInsts ''B.BitType ty >>= decBits
+    AppT (AppT (ConT name) (LitT (NumTyLit n))) ty2
+      | name == ''B.BitArray -> do
+         m <- lift $ tyBits ty2
+         return (fromIntegral n * m)
+    AppT (ConT name) (LitT (NumTyLit n))
+      | name == ''B.Bits -> return $ fromIntegral n
+      | otherwise        -> mzero
+    _ -> mzero
+  where
+    tyInsts name t = lift (reifyInstances name [t]) >>= anyOf
+    decBits (TySynInstD _ _ t) = getTyBits t
+    decBits _ = mzero
+
+-- | Return the size in bits of a type that can appear in a bitdata
+-- definition.  The allowed forms are "Bit", "Bits n", "Array n t"
+-- where "t" is a valid bit data type, or a name defined by "bitdata".
+tyBits :: Type -> Q Int
+tyBits ty = do
+  r <- findOne (getTyBits ty)
+  case r of
+    Just x  -> return x
+    Nothing -> fail "invalid bit value base type"
+
+-- | Deconstruct a bit array type into its size and base type.
+-- Returns "Nothing" if the type is not a bit array type.
+getArrayType :: Type -> Maybe (Int, Type)
+getArrayType (AppT (AppT (ConT name) (LitT (NumTyLit n))) ty)
+  | name == ''B.BitArray = Just (fromIntegral n, ty)
+getArrayType _ = Nothing
+
+-- | A field definition annotated with its TH name, type, and bit
+-- size.
+data THField = THField
+  { thFieldName :: Name
+  , thFieldType :: Type
+  , thFieldLen  :: Int
+  } deriving Show
+
+-- | Annotate a field definition.
+annotateField :: Field -> Q THField
+annotateField (Field n t) = do
+  ty <- convertType t
+  len <- tyBits ty
+  return $ THField (mkName n) ty len
+
+-- | A annotated layout item containing a bit literal or a field
+-- definition, and the position of the item.
+data THLayoutItem =
+  THLayoutConst
+    { thLayoutValue :: BitLiteral
+    , thLayoutPos   :: Int }
+  | THLayoutField
+    { thLayoutField :: THField
+    , thLayoutPos   :: Int }
+  deriving Show
+
+-- | A list of annotated layout items.
+type THLayout = [THLayoutItem]
+
+-- | Return the default layout given the total bit data size and a
+-- list of fields.  If there are no fields, we'll initialize with a
+-- zero literal.
+defaultLayout :: Int -> [THField] -> THLayout
+defaultLayout len [] = [THLayoutConst (BitLitKnown len 0) 0]
+defaultLayout _ fs = snd $ mapAccumL go 0 fs
+  where
+    go pos f
+      | thFieldName f == mkName "_"
+      , len <- thFieldLen f
+        = (pos + len, THLayoutConst (BitLitKnown len 0) pos)
+      | otherwise
+        = (pos + thFieldLen f, THLayoutField f pos)
+
+-- | Annotate a layout by looking up names in a list of fields and
+-- assigning field positions.  If the layout is empty, create a
+-- default layout containing all the fields.
+--
+-- Note that we reverse the fields and layout, since they are in the
+-- AST in MSB-first order.  We assign them positions starting from bit
+-- 0.
+annotateLayout :: Int -> Layout -> [THField] -> THLayout
+annotateLayout len [] fs = defaultLayout len (reverse fs)
+annotateLayout _ ls fs = snd $ mapAccumL go 0 (reverse ls)
+  where
+    go pos l =
+      case l of
+        LayoutConst lit@(BitLitKnown len _)
+          -> (pos + len, THLayoutConst lit pos)
+        LayoutField name
+          | Just f <- find ((== mkName name) . thFieldName) fs
+            -> (pos + thFieldLen f, THLayoutField f pos)
+        _ -> error "invalid bitdata layout"
+
+-- | Return the size, in bits, of a layout item, given a list of
+-- fields with type information.
+layoutItemSize :: [THField] -> LayoutItem -> Int
+layoutItemSize _ (LayoutConst (BitLitKnown len _)) = len
+layoutItemSize _ (LayoutConst (BitLitUnknown _)) = 0
+layoutItemSize fs (LayoutField name) =
+  case find ((== (mkName name)) . thFieldName) fs of
+    Just field -> fromIntegral (thFieldLen field)
+    Nothing    -> error "undefined field"
+
+-- | Return the total size of a layout, not including fields with
+-- unknown sizes.
+layoutSize :: [THField] -> Layout -> Int
+layoutSize fs ls = sum (map (layoutItemSize fs) ls)
+
+-- | Return true if a layout item has an unknown size.
+hasUnknownSize :: LayoutItem -> Bool
+hasUnknownSize (LayoutConst (BitLitUnknown _)) = True
+hasUnknownSize _ = False
+
+-- | Update a layout item of unknown size to a known size.
+updateSizeL :: Int -> LayoutItem -> LayoutItem
+updateSizeL size l =
+  case l of
+    LayoutConst (BitLitUnknown x) -> LayoutConst (BitLitKnown size x)
+    _ -> l
+
+-- | Replace the first layout item with unknown size with the given
+-- size.
+updateFirstL :: Int -> Layout -> Layout
+updateFirstL _ [] = []
+updateFirstL size (l:ls)
+  | hasUnknownSize l = updateSizeL size l : ls
+  | otherwise        = l : updateFirstL size ls
+
+-- | Update bit literals in a constructor' layout, given the size of
+-- the bit data definition and the constructor.
+--
+-- There can be at most a single constant with an unknown size.  If
+-- there is more than one, raise an error.  Otherwise, assign it a
+-- size if there is one.
+updateLiterals :: Int -> [THField] -> Layout -> Q Layout
+updateLiterals defLen fs ls = do
+  let slop = defLen - layoutSize fs ls
+      ls'  = updateFirstL slop ls
+  when (any hasUnknownSize ls') $
+    fail "multiple unknown size bit fields"
+  return ls'
+
+-- | Fold a function over each layout item within a constructor.
+foldLayout :: (b -> THLayoutItem -> b) -> b -> THConstr -> b
+foldLayout f z c = foldl' f z (thConstrLayout c)
+
+-- | Map a function over each layout item and its position within a
+-- constructor.
+mapLayout :: (THLayoutItem -> a) -> THConstr -> [a]
+mapLayout f c = map f (thConstrLayout c)
+
+-- | Return the size in bits of an annotated layout item.  A constant
+-- layout item must be of known size.
+thLayoutItemSize :: THLayoutItem -> Int
+thLayoutItemSize (THLayoutConst (BitLitKnown len _) _) = len
+thLayoutItemSize (THLayoutConst _ _) = error "invalid layout item"
+thLayoutItemSize (THLayoutField f _) = thFieldLen f
+
+-- | Return the size of an annotated layout definition.  All constant
+-- values must have a known size.
+thLayoutSize :: THLayout -> Int
+thLayoutSize l = sum $ map thLayoutItemSize l
+
+-- | A constructor definition annotated with TH information.
+data THConstr = THConstr
+  { thConstrName   :: Name
+  , thConstrFields :: [THField]
+  , thConstrLayout :: THLayout
+  } deriving Show
+
+-- | Return a list of field names defined in a constructor.
+constrFieldNames :: THConstr -> [Name]
+constrFieldNames c = map thFieldName (thConstrFields c)
+
+-- | Annotate a constructor definition.
+annotateConstr :: Int -> Constr -> Q THConstr
+annotateConstr len (Constr n fs ls) = do
+  fs' <- mapM annotateField fs
+  ls' <- updateLiterals len fs' ls
+  return $ THConstr (mkName n) fs' (annotateLayout len ls' fs')
+
+-- | A bit data definition annotated with TH information.
+data THDef = THDef
+  { thDefName    :: Name
+  , thDefType    :: Type
+  , thDefConstrs :: [THConstr]
+  , thDefLen     :: Int
+  } deriving Show
+
+-- | Annotate a bitdata definition.
+annotateDef :: Def -> Q THDef
+annotateDef (Def n t cs) = do
+  ty  <- convertType t
+  len <- tyBits ty
+  cs' <- mapM (annotateConstr len) cs
+  return $ THDef (mkName n) ty cs' len
+
+----------------------------------------------------------------------
+-- Annotated AST Validation
+
+-- | Validate a bitdata definition.
+checkDef :: THDef -> Q ()
+checkDef def = do
+  mapM_ (checkConstr def) (thDefConstrs def)
+
+-- | Validate a bitdata constructor definition.  Make sure all the
+-- layouts are valid for the data size.
+checkConstr :: THDef -> THConstr -> Q ()
+checkConstr def constr = do
+  checkLayout def constr (thConstrLayout constr)
+
+-- | Return the field names mentioned in a layout.
+layoutFieldNames :: THLayout -> [Name]
+layoutFieldNames = mapMaybe go
+  where go (THLayoutField f _) = Just $ thFieldName f
+        go _ = Nothing
+
+-- | Validate a constructor layout.  We verify these properties:
+--
+-- * Each field that is not named "_" is mentioned exactly once in the
+--   layout.
+--
+-- * The total size of the layout does not exceed the size of the
+--   enclosing bit data definition.
+checkLayout :: THDef -> THConstr -> THLayout -> Q ()
+checkLayout def c l = do
+  let cnames = filter (/= (mkName "_")) (constrFieldNames c)
+      lnames = filter (/= (mkName "_")) (layoutFieldNames l)
+  unless (sort cnames == sort lnames) $
+    fail "layout does not mention each field exactly once"
+  when (thLayoutSize l > thDefLen def) $
+    fail "constructor layout is too large"
+
+----------------------------------------------------------------------
+-- Code Generation
+
+-- | Process and convert a bit data definition to a Template Haskell
+-- declaration to splice in.
+mkDef :: Def -> Q [Dec]
+mkDef d = do
+  def <- annotateDef d
+  checkDef def
+  sequence $ concat
+    [ mkDefNewtype def
+    , mkDefInstance def
+    , concatMap (mkConstr def) (thDefConstrs def)
+    , mkArraySizeTypeInsts def
+    ]
+
+-- | Generate a newtype definition for a bit data definition.
+mkDefNewtype :: THDef -> [DecQ]
+mkDefNewtype def = [newtypeD (cxt []) name []
+                    (normalC name [strictType notStrict (return ty)])
+                    [''I.IvoryType, ''I.IvoryVar, ''I.IvoryExpr, ''I.IvoryEq]]
+  where
+    name = thDefName def
+    ty   = thDefType def
+
+-- | Generate an instance of the "BitData" type class for a bit data
+-- definition.
+mkDefInstance :: THDef -> [DecQ]
+mkDefInstance def = [instanceD (cxt []) instTy body]
+  where
+    name    = thDefName def
+    baseTy  = thDefType def
+    instTy  = [t| B.BitData $(conT (thDefName def)) |]
+    body    = [tyDef, toFun, fromFun]
+    tyDef   = tySynInstD ''B.BitType [conT name] (return baseTy)
+    x       = mkName "x"
+    toFun   = funD 'B.toBits [clause [conP name [varP x]]
+                              (normalB (varE x)) []]
+    fromFun = valD (varP 'B.fromBits) (normalB (conE name)) []
+
+-- | Generate instances of the "ArraySize" type family for any fields
+-- with a bit array type.
+mkArraySizeTypeInsts :: THDef -> [DecQ]
+mkArraySizeTypeInsts def =
+ concatMap (uncurry mkArraySizeTypeInst)
+           (mapMaybe getArrayType
+                     (concatMap constrFieldTypes (thDefConstrs def)))
+
+-- | Generate an instance of the "ArraySize" type family for a bit
+-- array type.  We don't check to see if the instance already exists
+-- because duplicates are allowed by the overlapping rules when the
+-- result type is the same.
+mkArraySizeTypeInst :: Int -> Type -> [DecQ]
+mkArraySizeTypeInst n ty = [tySynInstD ''B.ArraySize args size]
+  where
+    size = tyBits ty >>= litT . numTyLit . fromIntegral . (* n)
+    args = [litT (numTyLit (fromIntegral n)), return ty]
+
+-- | Return a list of types for each field in a constructor.
+constrFieldTypes :: THConstr -> [Type]
+constrFieldTypes c = map thFieldType fields
+  where fields = filter ((/= (mkName "_")) . thFieldName) (thConstrFields c)
+
+-- | Create a Template Haskell function type for a bit data
+-- constructor.
+mkConstrType :: THDef -> THConstr -> Type
+mkConstrType d c = foldr (AppT . AppT ArrowT) (ConT (thDefName d)) fields
+  where fields = constrFieldTypes c
+
+-- | Return the Template Haskell name for the "n"th argument to a bit
+-- data constructor.
+argName :: Int -> Name
+argName n = mkName ("arg" ++ show n)
+
+-- | Create a Template Haskell pattern list for a bit data
+-- constructor.
+mkConstrArgs :: THConstr -> [PatQ]
+mkConstrArgs c = zipWith f [0..] names
+  where names = filter (/= (mkName "_")) (constrFieldNames c)
+        f x _ = varP (argName x)
+
+-- | Create an expression for a layout item in the constructor.  We
+-- maintain a count of the number of fields we've seen so that we can
+-- reconstruct the argument name based on the field number.  This
+-- isn't the most elegant solution but it will work for now.
+--
+-- This function can be folded over the layout with "foldLayout" given
+-- an initial expression.
+constrBodyExpr :: (Int, ExpQ) -> THLayoutItem -> (Int, ExpQ)
+constrBodyExpr (n, expr) l =
+  case l of
+    -- XXX I would love to use an expression quasiquoter here, but
+    -- there was a lot of arguing with the quasiquoter typechecker
+    -- that seemed unnecessary, so I punted and built the expression
+    -- by hand.
+    THLayoutField _ pos ->
+      (n + 1, infixApp expr (varE '(.|))
+               (infixApp (appE (varE 'safeCast) (appE (varE 'B.toRep)
+                                                 (varE (argName n))))
+                          (varE 'iShiftL) (litE (integerL
+                                                 (fromIntegral pos)))))
+    THLayoutConst val pos
+      | bitLitVal val /= 0 ->
+        (n, infixApp expr (varE '(.|))
+         (infixApp (litE (integerL (fromIntegral (bitLitVal val))))
+          (varE 'iShiftL) (litE (integerL (fromIntegral pos)))))
+      -- There's no need to OR in the zero value here:
+      | otherwise -> (n, expr)
+
+-- | Generate a value definition for a bit data constructor.
+--
+-- The generated constructor will take one argument for each field in
+-- the constructor.  The body of the constructor will assemble the
+-- arguments into a value using the layout.
+mkConstr :: THDef -> THConstr -> [DecQ]
+mkConstr def constr = [sig, fun] ++ mkConstrFields def constr
+  where
+    cname = thConstrName constr
+    sig   = sigD cname (return (mkConstrType def constr))
+    args  = mkConstrArgs constr
+    zexpr = litE (integerL 0)
+    expr  = snd (foldLayout constrBodyExpr (0, zexpr) constr)
+    body  = normalB (appE (varE 'B.unsafeFromRep) expr)
+    fun   = funD cname [clause args body []]
+
+-- | Generate fields for a constructor using its layout.
+mkConstrFields :: THDef -> THConstr -> [DecQ]
+mkConstrFields def c = concat $ mapLayout (mkField def) c
+
+-- | Generate a constructor field definition.
+mkField :: THDef -> THLayoutItem -> [DecQ]
+mkField def l@(THLayoutField f pos) =
+  [ sigD name ty
+  , valD (varP name) (normalB [| B.BitDataField $posE $lenE |]) []]
+  where
+    name = thFieldName f
+    lenE = litE (integerL (fromIntegral (thFieldLen f)))
+    posE = litE (integerL (fromIntegral pos))
+    fty = return (thFieldType f)
+    ty  = [t| B.BitDataField $(conT (thDefName def)) $fty |]
+mkField _ _ = []
diff --git a/src/Ivory/BitData/TokenParser.hs b/src/Ivory/BitData/TokenParser.hs
new file mode 100644
--- /dev/null
+++ b/src/Ivory/BitData/TokenParser.hs
@@ -0,0 +1,16 @@
+{-# LANGUAGE RecordWildCards #-}
+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
+--
+-- TokenParser.hs --- HW quasiquoter token parser.
+--
+-- Copyright (C) 2013, Galois, Inc.
+-- All Rights Reserved.
+--
+
+module Ivory.BitData.TokenParser where
+
+import Text.Parsec.Language (haskellDef)
+import qualified Text.Parsec.Token as T
+
+-- Import all the token parser definitions for our language.
+T.TokenParser{..} = T.makeTokenParser haskellDef